summaryrefslogtreecommitdiff
path: root/rtl
diff options
context:
space:
mode:
Diffstat (limited to 'rtl')
-rw-r--r--rtl/COPYING504
-rw-r--r--rtl/COPYING.FPC25
-rw-r--r--rtl/Makefile2220
-rw-r--r--rtl/Makefile.fpc31
-rw-r--r--rtl/README34
-rw-r--r--rtl/amiga/Makefile1993
-rw-r--r--rtl/amiga/Makefile.fpc185
-rw-r--r--rtl/amiga/crt.pp938
-rw-r--r--rtl/amiga/dos.pp1488
-rw-r--r--rtl/amiga/graph.pp797
-rw-r--r--rtl/amiga/os.inc27
-rw-r--r--rtl/amiga/printer.pp35
-rw-r--r--rtl/amiga/prt0.as56
-rw-r--r--rtl/amiga/readme4
-rw-r--r--rtl/arm/arm.inc202
-rw-r--r--rtl/arm/int64p.inc56
-rw-r--r--rtl/arm/makefile.cpu13
-rw-r--r--rtl/arm/math.inc111
-rw-r--r--rtl/arm/mathu.inc20
-rw-r--r--rtl/arm/mathuh.inc20
-rw-r--r--rtl/arm/set.inc22
-rw-r--r--rtl/arm/setjump.inc44
-rw-r--r--rtl/arm/setjumph.inc33
-rw-r--r--rtl/arm/strings.inc24
-rw-r--r--rtl/arm/stringss.inc24
-rw-r--r--rtl/arm/sysutilp.inc58
-rw-r--r--rtl/atari/os.inc27
-rw-r--r--rtl/atari/prt0.as208
-rw-r--r--rtl/atari/readme4
-rw-r--r--rtl/atari/sysatari.pas1
-rw-r--r--rtl/atari/system.pas782
-rw-r--r--rtl/beos/Makefile1996
-rw-r--r--rtl/beos/Makefile.fpc167
-rw-r--r--rtl/beos/beos.inc550
-rw-r--r--rtl/beos/beos.pp384
-rw-r--r--rtl/beos/dos.pp827
-rw-r--r--rtl/beos/dos_beos.inc150
-rw-r--r--rtl/beos/errno.inc215
-rw-r--r--rtl/beos/i386/cprt0.as217
-rw-r--r--rtl/beos/i386/dllprt.as170
-rw-r--r--rtl/beos/i386/dllprt.cpp39
-rw-r--r--rtl/beos/i386/func.as161
-rw-r--r--rtl/beos/i386/prt0.as181
-rw-r--r--rtl/beos/objinc.inc96
-rw-r--r--rtl/beos/osposix.inc464
-rw-r--r--rtl/beos/osposixh.inc188
-rw-r--r--rtl/beos/posix.pp86
-rw-r--r--rtl/beos/syscall.inc92
-rw-r--r--rtl/beos/sysfiles.inc18
-rw-r--r--rtl/beos/system.pp563
-rw-r--r--rtl/beos/sysutils.pp333
-rw-r--r--rtl/beos/timezone.inc435
-rw-r--r--rtl/bsd/bunxfunch.inc68
-rw-r--r--rtl/bsd/bunxsysc.inc545
-rw-r--r--rtl/bsd/i386/syscall.inc209
-rw-r--r--rtl/bsd/i386/syscallh.inc61
-rw-r--r--rtl/bsd/ipcbsd.inc91
-rw-r--r--rtl/bsd/osdefs.inc38
-rw-r--r--rtl/bsd/osmacro.inc105
-rw-r--r--rtl/bsd/osmain.inc16
-rw-r--r--rtl/bsd/ossysc.inc556
-rw-r--r--rtl/bsd/ostypes.inc271
-rw-r--r--rtl/bsd/powerpc/syscall.inc176
-rw-r--r--rtl/bsd/powerpc/syscallh.inc51
-rw-r--r--rtl/bsd/readme.txt51
-rw-r--r--rtl/bsd/sysbsd.pp19
-rw-r--r--rtl/bsd/sysctl.pp160
-rw-r--r--rtl/bsd/sysos.inc190
-rw-r--r--rtl/bsd/sysosh.inc51
-rw-r--r--rtl/bsd/system.pp284
-rw-r--r--rtl/bsd/unxsysch.inc23
-rw-r--r--rtl/bsd/x86_64/syscall.inc265
-rw-r--r--rtl/bsd/x86_64/syscallh.inc53
-rw-r--r--rtl/darwin/Makefile1917
-rw-r--r--rtl/darwin/Makefile.fpc266
-rw-r--r--rtl/darwin/console.pp3475
-rw-r--r--rtl/darwin/errno.inc289
-rw-r--r--rtl/darwin/powerpc/sig_cpu.inc274
-rw-r--r--rtl/darwin/powerpc/sighnd.inc67
-rw-r--r--rtl/darwin/pthread.inc88
-rw-r--r--rtl/darwin/ptypes.inc184
-rw-r--r--rtl/darwin/signal.inc282
-rw-r--r--rtl/darwin/sysctlh.inc541
-rw-r--r--rtl/darwin/termio.pp49
-rw-r--r--rtl/darwin/termios.inc578
-rw-r--r--rtl/darwin/termiosproc.inc142
-rw-r--r--rtl/darwin/tthread.inc310
-rw-r--r--rtl/darwin/unxconst.inc119
-rw-r--r--rtl/darwin/unxfunc.inc77
-rw-r--r--rtl/darwin/unxsockh.inc79
-rw-r--r--rtl/emx/Makefile2028
-rw-r--r--rtl/emx/Makefile.fpc229
-rw-r--r--rtl/emx/crt.pas969
-rw-r--r--rtl/emx/dos.pas1086
-rw-r--r--rtl/emx/emx.imp9
-rw-r--r--rtl/emx/emx.pas73
-rw-r--r--rtl/emx/emxwrap.imp113
-rw-r--r--rtl/emx/ports.pas212
-rw-r--r--rtl/emx/prt0.as74
-rw-r--r--rtl/emx/prt1.as61
-rw-r--r--rtl/emx/sysdir.inc251
-rw-r--r--rtl/emx/sysemx.pas1
-rw-r--r--rtl/emx/sysfile.inc415
-rw-r--r--rtl/emx/sysheap.inc91
-rw-r--r--rtl/emx/sysos.inc105
-rw-r--r--rtl/emx/sysosh.inc55
-rw-r--r--rtl/emx/system.pas603
-rw-r--r--rtl/emx/systhrd.inc206
-rw-r--r--rtl/emx/sysutils.pp1232
-rw-r--r--rtl/freebsd/Makefile2055
-rw-r--r--rtl/freebsd/Makefile.fpc282
-rw-r--r--rtl/freebsd/bsdport.txt232
-rw-r--r--rtl/freebsd/console.pp3482
-rw-r--r--rtl/freebsd/errno.inc144
-rw-r--r--rtl/freebsd/i386/bsyscall.inc20
-rw-r--r--rtl/freebsd/i386/cprt0.as146
-rw-r--r--rtl/freebsd/i386/gprt0.as163
-rw-r--r--rtl/freebsd/i386/prt0.as130
-rw-r--r--rtl/freebsd/i386/sighnd.inc85
-rw-r--r--rtl/freebsd/i386/x86.inc84
-rw-r--r--rtl/freebsd/i386/x86h.inc31
-rw-r--r--rtl/freebsd/pthread.inc91
-rw-r--r--rtl/freebsd/ptypes.inc209
-rw-r--r--rtl/freebsd/signal.inc207
-rw-r--r--rtl/freebsd/sysctlh.inc886
-rw-r--r--rtl/freebsd/sysnr.inc325
-rw-r--r--rtl/freebsd/termio.pp49
-rw-r--r--rtl/freebsd/termios.inc371
-rw-r--r--rtl/freebsd/termiosproc.inc138
-rw-r--r--rtl/freebsd/tthread.inc607
-rw-r--r--rtl/freebsd/unixsock.inc117
-rw-r--r--rtl/freebsd/unxconst.inc126
-rw-r--r--rtl/freebsd/unxfunc.inc83
-rw-r--r--rtl/freebsd/unxsockh.inc79
-rw-r--r--rtl/freebsd/unxsysc.inc142
-rw-r--r--rtl/freebsd/x86_64/bsyscall.inc20
-rw-r--r--rtl/freebsd/x86_64/prt0.as142
-rw-r--r--rtl/go32v2/Makefile2025
-rw-r--r--rtl/go32v2/Makefile.fpc157
-rw-r--r--rtl/go32v2/classes.pp54
-rw-r--r--rtl/go32v2/crt.pp776
-rw-r--r--rtl/go32v2/dos.pp847
-rw-r--r--rtl/go32v2/dpmi.inc51
-rw-r--r--rtl/go32v2/dpmiexcp.pp1622
-rw-r--r--rtl/go32v2/dxeload.pp94
-rw-r--r--rtl/go32v2/dxetype.pp42
-rw-r--r--rtl/go32v2/emu387.pp223
-rw-r--r--rtl/go32v2/exceptn.as495
-rw-r--r--rtl/go32v2/exit16.ah1
-rw-r--r--rtl/go32v2/exit16.asm22
-rw-r--r--rtl/go32v2/fpu.as59
-rw-r--r--rtl/go32v2/go32.pp1193
-rw-r--r--rtl/go32v2/graph.pp2786
-rw-r--r--rtl/go32v2/initc.pp101
-rw-r--r--rtl/go32v2/keyboard.pp83
-rw-r--r--rtl/go32v2/mouse.pp808
-rw-r--r--rtl/go32v2/msmouse.pp369
-rw-r--r--rtl/go32v2/ports.pp110
-rw-r--r--rtl/go32v2/printer.pp36
-rw-r--r--rtl/go32v2/profile.pp334
-rw-r--r--rtl/go32v2/sbrk16.ah7
-rw-r--r--rtl/go32v2/sbrk16.asm7
-rw-r--r--rtl/go32v2/sysdir.inc160
-rw-r--r--rtl/go32v2/sysfile.inc460
-rw-r--r--rtl/go32v2/sysheap.inc70
-rw-r--r--rtl/go32v2/sysos.inc341
-rw-r--r--rtl/go32v2/sysosh.inc43
-rw-r--r--rtl/go32v2/system.pp679
-rw-r--r--rtl/go32v2/systhrd.inc39
-rw-r--r--rtl/go32v2/sysutils.pp842
-rw-r--r--rtl/go32v2/tthread.inc97
-rw-r--r--rtl/go32v2/v2prt0.as950
-rw-r--r--rtl/go32v2/varutils.pp47
-rw-r--r--rtl/go32v2/vesa.inc2752
-rw-r--r--rtl/go32v2/vesah.inc102
-rw-r--r--rtl/go32v2/vesamode.pp250
-rw-r--r--rtl/go32v2/video.pp329
-rw-r--r--rtl/i386/cpu.pp81
-rw-r--r--rtl/i386/fastmove.inc861
-rw-r--r--rtl/i386/i386.inc1593
-rw-r--r--rtl/i386/int64p.inc267
-rw-r--r--rtl/i386/makefile.cpu7
-rw-r--r--rtl/i386/math.inc290
-rw-r--r--rtl/i386/mathu.inc105
-rw-r--r--rtl/i386/mathuh.inc41
-rw-r--r--rtl/i386/mmx.pp253
-rw-r--r--rtl/i386/readme17
-rw-r--r--rtl/i386/set.inc692
-rw-r--r--rtl/i386/setjump.inc75
-rw-r--r--rtl/i386/setjumph.inc42
-rw-r--r--rtl/i386/strings.inc634
-rw-r--r--rtl/i386/stringss.inc53
-rw-r--r--rtl/i386/strlen.inc42
-rw-r--r--rtl/i386/strpas.inc116
-rw-r--r--rtl/i386/sysutilp.inc84
-rw-r--r--rtl/inc/aliases.inc39
-rw-r--r--rtl/inc/astrings.inc900
-rw-r--r--rtl/inc/cgeneric.inc156
-rw-r--r--rtl/inc/cgenmath.inc209
-rw-r--r--rtl/inc/cgenstr.inc137
-rw-r--r--rtl/inc/charset.pp258
-rw-r--r--rtl/inc/cmem.pp215
-rw-r--r--rtl/inc/compproc.inc384
-rw-r--r--rtl/inc/crt.inc420
-rw-r--r--rtl/inc/crth.inc108
-rw-r--r--rtl/inc/ctypes.pp117
-rw-r--r--rtl/inc/dos.inc316
-rw-r--r--rtl/inc/dosh.inc159
-rw-r--r--rtl/inc/dynarr.inc391
-rw-r--r--rtl/inc/dynarrh.inc28
-rw-r--r--rtl/inc/dynlibs.pp78
-rw-r--r--rtl/inc/except.inc366
-rw-r--r--rtl/inc/fexpand.inc584
-rw-r--r--rtl/inc/file.inc418
-rw-r--r--rtl/inc/filerec.inc48
-rw-r--r--rtl/inc/generic.inc1243
-rw-r--r--rtl/inc/genmath.inc1268
-rw-r--r--rtl/inc/genset.inc277
-rw-r--r--rtl/inc/genstr.inc274
-rw-r--r--rtl/inc/genstrs.inc43
-rw-r--r--rtl/inc/getopts.pp512
-rw-r--r--rtl/inc/graph/clip.inc148
-rw-r--r--rtl/inc/graph/fills.inc494
-rw-r--r--rtl/inc/graph/fontdata.inc2329
-rw-r--r--rtl/inc/graph/graph.inc2138
-rw-r--r--rtl/inc/graph/graph.tex1917
-rw-r--r--rtl/inc/graph/graphh.inc793
-rw-r--r--rtl/inc/graph/gtext.inc797
-rw-r--r--rtl/inc/graph/makefile.inc1
-rw-r--r--rtl/inc/graph/modes.inc594
-rw-r--r--rtl/inc/graph/palette.inc389
-rw-r--r--rtl/inc/heap.inc1418
-rw-r--r--rtl/inc/heaph.inc151
-rw-r--r--rtl/inc/heaptrc.pp1223
-rw-r--r--rtl/inc/innr.inc146
-rw-r--r--rtl/inc/int64.inc372
-rw-r--r--rtl/inc/keyboard.inc302
-rw-r--r--rtl/inc/keybrdh.inc204
-rw-r--r--rtl/inc/keyscan.inc144
-rw-r--r--rtl/inc/lineinfo.pp1051
-rw-r--r--rtl/inc/lstrings.pp541
-rw-r--r--rtl/inc/macpas.pp61
-rw-r--r--rtl/inc/makefile.inc22
-rw-r--r--rtl/inc/mathh.inc106
-rw-r--r--rtl/inc/matrix.pp836
-rw-r--r--rtl/inc/mmatimp.inc903
-rw-r--r--rtl/inc/mouse.inc216
-rw-r--r--rtl/inc/mouseh.inc113
-rw-r--r--rtl/inc/mvecimp.inc381
-rw-r--r--rtl/inc/objects.pp3011
-rw-r--r--rtl/inc/objpas.inc786
-rw-r--r--rtl/inc/objpash.inc329
-rw-r--r--rtl/inc/printer.inc63
-rw-r--r--rtl/inc/printerh.inc30
-rw-r--r--rtl/inc/readme36
-rw-r--r--rtl/inc/real2str.inc467
-rw-r--r--rtl/inc/rtti.inc265
-rw-r--r--rtl/inc/sockets.inc416
-rw-r--r--rtl/inc/socketsh.inc260
-rw-r--r--rtl/inc/sockovl.inc209
-rw-r--r--rtl/inc/softfpu.pp4667
-rw-r--r--rtl/inc/sstrings.inc903
-rw-r--r--rtl/inc/stdsock.inc120
-rw-r--r--rtl/inc/strings.pp152
-rw-r--r--rtl/inc/stringsi.inc72
-rw-r--r--rtl/inc/system.fpd53
-rw-r--r--rtl/inc/system.inc1076
-rw-r--r--rtl/inc/systemh.inc811
-rw-r--r--rtl/inc/text.inc1316
-rw-r--r--rtl/inc/textrec.inc66
-rw-r--r--rtl/inc/thread.inc545
-rw-r--r--rtl/inc/threadh.inc187
-rw-r--r--rtl/inc/threadvr.inc111
-rw-r--r--rtl/inc/typefile.inc100
-rw-r--r--rtl/inc/ucomplex.pp621
-rw-r--r--rtl/inc/variant.inc663
-rw-r--r--rtl/inc/varianth.inc350
-rw-r--r--rtl/inc/variants.pp3138
-rw-r--r--rtl/inc/video.inc270
-rw-r--r--rtl/inc/videoh.inc170
-rw-r--r--rtl/inc/wstringh.inc125
-rw-r--r--rtl/inc/wstrings.inc1524
-rw-r--r--rtl/linux/Makefile2264
-rw-r--r--rtl/linux/Makefile.fpc296
-rw-r--r--rtl/linux/arm/bsyscall.inc20
-rw-r--r--rtl/linux/arm/cprt0.as140
-rw-r--r--rtl/linux/arm/dllprt0.as0
-rw-r--r--rtl/linux/arm/gprt0.as0
-rw-r--r--rtl/linux/arm/prt0.as125
-rw-r--r--rtl/linux/arm/sighnd.inc58
-rw-r--r--rtl/linux/arm/sighndh.inc75
-rw-r--r--rtl/linux/arm/stat.inc65
-rw-r--r--rtl/linux/arm/syscall.inc257
-rw-r--r--rtl/linux/arm/syscallh.inc49
-rw-r--r--rtl/linux/arm/sysnr.inc279
-rw-r--r--rtl/linux/bunxsysc.inc554
-rw-r--r--rtl/linux/errno.inc297
-rw-r--r--rtl/linux/gpm.pp967
-rw-r--r--rtl/linux/i386/bsyscall.inc20
-rw-r--r--rtl/linux/i386/cprt0.as104
-rw-r--r--rtl/linux/i386/cprt21.as122
-rw-r--r--rtl/linux/i386/dllprt0.as67
-rw-r--r--rtl/linux/i386/gprt0.as87
-rw-r--r--rtl/linux/i386/gprt21.as138
-rw-r--r--rtl/linux/i386/prt0.as105
-rw-r--r--rtl/linux/i386/sighnd.inc95
-rw-r--r--rtl/linux/i386/sighndh.inc70
-rw-r--r--rtl/linux/i386/stat.inc123
-rw-r--r--rtl/linux/i386/syscall.inc368
-rw-r--r--rtl/linux/i386/syscallh.inc52
-rw-r--r--rtl/linux/i386/sysnr.inc267
-rw-r--r--rtl/linux/ipccall.inc125
-rw-r--r--rtl/linux/ipcsys.inc107
-rw-r--r--rtl/linux/m68k/bsyscall.inc20
-rw-r--r--rtl/linux/m68k/prt0.as26
-rw-r--r--rtl/linux/m68k/prt1.as39
-rw-r--r--rtl/linux/m68k/stat.inc68
-rw-r--r--rtl/linux/osdefs.inc49
-rw-r--r--rtl/linux/osmacro.inc103
-rw-r--r--rtl/linux/ossysc.inc497
-rw-r--r--rtl/linux/ostypes.inc313
-rw-r--r--rtl/linux/powerpc/bsyscall.inc20
-rw-r--r--rtl/linux/powerpc/cprt0.as105
-rw-r--r--rtl/linux/powerpc/dllprt0.as15
-rw-r--r--rtl/linux/powerpc/gprt0.as15
-rw-r--r--rtl/linux/powerpc/prt0.as117
-rw-r--r--rtl/linux/powerpc/sighnd.inc70
-rw-r--r--rtl/linux/powerpc/sighndh.inc91
-rw-r--r--rtl/linux/powerpc/stat.inc63
-rw-r--r--rtl/linux/powerpc/syscall.inc302
-rw-r--r--rtl/linux/powerpc/syscallh.inc50
-rw-r--r--rtl/linux/powerpc/sysnr.inc267
-rw-r--r--rtl/linux/pthread.inc334
-rw-r--r--rtl/linux/ptypes.inc253
-rw-r--r--rtl/linux/signal.inc222
-rw-r--r--rtl/linux/sparc/bsyscall.inc48
-rw-r--r--rtl/linux/sparc/cprt0.as93
-rw-r--r--rtl/linux/sparc/dllprt0.as9
-rw-r--r--rtl/linux/sparc/gprt0.as110
-rw-r--r--rtl/linux/sparc/prt0.as103
-rw-r--r--rtl/linux/sparc/sighnd.inc96
-rw-r--r--rtl/linux/sparc/sighndh.inc59
-rw-r--r--rtl/linux/sparc/stat.inc67
-rw-r--r--rtl/linux/sparc/syscall.inc329
-rw-r--r--rtl/linux/sparc/syscallh.inc49
-rw-r--r--rtl/linux/sparc/sysnr.inc285
-rw-r--r--rtl/linux/syslinux.pp1
-rw-r--r--rtl/linux/sysos.inc176
-rw-r--r--rtl/linux/sysosh.inc52
-rw-r--r--rtl/linux/system.pp274
-rw-r--r--rtl/linux/termio.pp49
-rw-r--r--rtl/linux/termios.inc1231
-rw-r--r--rtl/linux/termiosproc.inc157
-rw-r--r--rtl/linux/tthread.inc349
-rw-r--r--rtl/linux/unixsock.inc234
-rw-r--r--rtl/linux/unxconst.inc101
-rw-r--r--rtl/linux/unxfunc.inc74
-rw-r--r--rtl/linux/unxsockh.inc143
-rw-r--r--rtl/linux/unxsysc.inc81
-rw-r--r--rtl/linux/unxsysch.inc27
-rw-r--r--rtl/linux/x86_64/bsyscall.inc20
-rw-r--r--rtl/linux/x86_64/cprt0.as164
-rw-r--r--rtl/linux/x86_64/dllprt0.as13
-rw-r--r--rtl/linux/x86_64/gprt0.as167
-rw-r--r--rtl/linux/x86_64/prt0.as129
-rw-r--r--rtl/linux/x86_64/sighnd.inc93
-rw-r--r--rtl/linux/x86_64/sighndh.inc77
-rw-r--r--rtl/linux/x86_64/stat.inc75
-rw-r--r--rtl/linux/x86_64/syscall.inc233
-rw-r--r--rtl/linux/x86_64/syscallh.inc46
-rw-r--r--rtl/linux/x86_64/sysnr.inc308
-rw-r--r--rtl/m68k/lowmath.inc920
-rw-r--r--rtl/m68k/m68k.inc329
-rw-r--r--rtl/m68k/makefile.cpu7
-rw-r--r--rtl/m68k/math.inc949
-rw-r--r--rtl/m68k/readme7
-rw-r--r--rtl/m68k/set.inc428
-rw-r--r--rtl/m68k/setjump.inc34
-rw-r--r--rtl/m68k/setjumph.inc37
-rw-r--r--rtl/macos/MPWmake124
-rw-r--r--rtl/macos/Makefile1757
-rw-r--r--rtl/macos/Makefile.fpc155
-rw-r--r--rtl/macos/README5
-rw-r--r--rtl/macos/dos.pp985
-rw-r--r--rtl/macos/macos.pp181
-rw-r--r--rtl/macos/macostp.inc1390
-rw-r--r--rtl/macos/macostp.pp31
-rw-r--r--rtl/macos/macutils.inc566
-rw-r--r--rtl/macos/macutils.pp80
-rw-r--r--rtl/macos/sysdir.inc137
-rw-r--r--rtl/macos/sysfile.inc374
-rw-r--r--rtl/macos/sysheap.inc52
-rw-r--r--rtl/macos/sysos.inc181
-rw-r--r--rtl/macos/sysosh.inc50
-rw-r--r--rtl/macos/system.pp581
-rw-r--r--rtl/macos/systhrd.inc42
-rw-r--r--rtl/macos/sysutils.pp732
-rw-r--r--rtl/morphos/Makefile2006
-rw-r--r--rtl/morphos/Makefile.fpc199
-rw-r--r--rtl/morphos/ahi.pas634
-rw-r--r--rtl/morphos/asl.pas620
-rw-r--r--rtl/morphos/classes.pp57
-rw-r--r--rtl/morphos/clipboard.pas92
-rw-r--r--rtl/morphos/dos.pp1014
-rw-r--r--rtl/morphos/doslib.pp152
-rw-r--r--rtl/morphos/doslibd.inc1393
-rw-r--r--rtl/morphos/doslibf.inc699
-rw-r--r--rtl/morphos/emuld.inc35
-rw-r--r--rtl/morphos/exec.pp59
-rw-r--r--rtl/morphos/execd.inc1743
-rw-r--r--rtl/morphos/execf.inc598
-rw-r--r--rtl/morphos/get9.pas77
-rw-r--r--rtl/morphos/graphics.pas2844
-rw-r--r--rtl/morphos/hardware.pas590
-rw-r--r--rtl/morphos/inputevent.pas220
-rw-r--r--rtl/morphos/intuition.pas4699
-rw-r--r--rtl/morphos/layers.pas239
-rw-r--r--rtl/morphos/prt0.as227
-rw-r--r--rtl/morphos/sysdir.inc113
-rw-r--r--rtl/morphos/sysfile.inc337
-rw-r--r--rtl/morphos/sysheap.inc49
-rw-r--r--rtl/morphos/sysos.inc158
-rw-r--r--rtl/morphos/sysosh.inc50
-rw-r--r--rtl/morphos/system.pp357
-rw-r--r--rtl/morphos/systhrd.inc42
-rw-r--r--rtl/morphos/sysutils.pp587
-rw-r--r--rtl/morphos/timer.pp43
-rw-r--r--rtl/morphos/timerd.inc74
-rw-r--r--rtl/morphos/timerf.inc45
-rw-r--r--rtl/morphos/tthread.inc188
-rw-r--r--rtl/morphos/utild1.inc160
-rw-r--r--rtl/morphos/utild2.inc60
-rw-r--r--rtl/morphos/utilf.inc176
-rw-r--r--rtl/morphos/utility.pp45
-rw-r--r--rtl/morphos/varutils.pp47
-rw-r--r--rtl/netbsd/Makefile2029
-rw-r--r--rtl/netbsd/Makefile.fpc240
-rw-r--r--rtl/netbsd/classes.pp63
-rw-r--r--rtl/netbsd/errno.inc144
-rw-r--r--rtl/netbsd/i386/cprt0.as438
-rw-r--r--rtl/netbsd/i386/prt0.as204
-rw-r--r--rtl/netbsd/i386/prt0_10.as204
-rw-r--r--rtl/netbsd/i386/sighnd.inc86
-rw-r--r--rtl/netbsd/powerpc/cprt0.as443
-rw-r--r--rtl/netbsd/powerpc/prt0.as164
-rw-r--r--rtl/netbsd/powerpc/sighnd.inc52
-rw-r--r--rtl/netbsd/ptypes.inc153
-rw-r--r--rtl/netbsd/signal.inc170
-rw-r--r--rtl/netbsd/syscalls.inc23
-rw-r--r--rtl/netbsd/sysconst.inc110
-rw-r--r--rtl/netbsd/sysctlh.inc886
-rw-r--r--rtl/netbsd/sysnr.inc539
-rw-r--r--rtl/netbsd/sysofft.inc108
-rw-r--r--rtl/netbsd/systypes.inc43
-rw-r--r--rtl/netbsd/termio.pp49
-rw-r--r--rtl/netbsd/termios.inc371
-rw-r--r--rtl/netbsd/termiosproc.inc138
-rw-r--r--rtl/netbsd/tthread.inc604
-rw-r--r--rtl/netbsd/unixsock.inc218
-rw-r--r--rtl/netbsd/unixsysc.inc283
-rw-r--r--rtl/netware/Makefile2040
-rw-r--r--rtl/netware/Makefile.fpc263
-rw-r--r--rtl/netware/README179
-rw-r--r--rtl/netware/aio.imp41
-rw-r--r--rtl/netware/aio.pp512
-rw-r--r--rtl/netware/audnlm32.imp33
-rw-r--r--rtl/netware/calnlm32.imp470
-rw-r--r--rtl/netware/ccs-os.imp27
-rw-r--r--rtl/netware/ccs.imp78
-rw-r--r--rtl/netware/classes.pp59
-rw-r--r--rtl/netware/clib.imp1937
-rw-r--r--rtl/netware/clibaux.imp4
-rw-r--r--rtl/netware/clibctx.imp11
-rw-r--r--rtl/netware/clxnlm32.imp39
-rw-r--r--rtl/netware/convertimp50
-rw-r--r--rtl/netware/crt.pp655
-rw-r--r--rtl/netware/demos/Makefile25
-rw-r--r--rtl/netware/demos/check.pp53
-rw-r--r--rtl/netware/dos.pp529
-rw-r--r--rtl/netware/dplsv386.imp276
-rw-r--r--rtl/netware/dsapi.imp188
-rw-r--r--rtl/netware/dsevent.imp12
-rw-r--r--rtl/netware/errno.inc144
-rw-r--r--rtl/netware/initc.pp49
-rw-r--r--rtl/netware/keyboard.pp100
-rw-r--r--rtl/netware/lib0.imp2
-rw-r--r--rtl/netware/locnlm32.imp108
-rw-r--r--rtl/netware/mouse.pp121
-rw-r--r--rtl/netware/ndpsrpc.imp59
-rw-r--r--rtl/netware/netnlm32.imp188
-rw-r--r--rtl/netware/netware.pp173
-rw-r--r--rtl/netware/nit.imp2
-rw-r--r--rtl/netware/nlmlib.imp2
-rw-r--r--rtl/netware/npackoff.inc13
-rw-r--r--rtl/netware/npackon.inc12
-rw-r--r--rtl/netware/nwcalls.pp6075
-rw-r--r--rtl/netware/nwnit.pp3165
-rw-r--r--rtl/netware/nwpre.as142
-rw-r--r--rtl/netware/nwpre.pp158
-rw-r--r--rtl/netware/nwprot.pp1356
-rw-r--r--rtl/netware/nwpsrv.imp384
-rw-r--r--rtl/netware/nwpsrv3x.imp250
-rw-r--r--rtl/netware/nwserv.pp5395
-rw-r--r--rtl/netware/nwsnut.imp150
-rw-r--r--rtl/netware/nwsnut.pp1544
-rw-r--r--rtl/netware/nwsock.inc227
-rw-r--r--rtl/netware/nwsys.inc378
-rw-r--r--rtl/netware/prelude.as133
-rw-r--r--rtl/netware/qos.inc293
-rw-r--r--rtl/netware/requestr.imp2
-rw-r--r--rtl/netware/sockets.pp400
-rw-r--r--rtl/netware/socklib.imp48
-rw-r--r--rtl/netware/streams.imp135
-rw-r--r--rtl/netware/sysdir.inc101
-rw-r--r--rtl/netware/sysfile.inc290
-rw-r--r--rtl/netware/sysheap.inc150
-rw-r--r--rtl/netware/sysos.inc56
-rw-r--r--rtl/netware/sysosh.inc57
-rw-r--r--rtl/netware/system.pp504
-rw-r--r--rtl/netware/systhrd.inc509
-rw-r--r--rtl/netware/sysutils.pp593
-rw-r--r--rtl/netware/tests/Makefile28
-rw-r--r--rtl/netware/tests/test.pas604
-rw-r--r--rtl/netware/threads.imp2
-rw-r--r--rtl/netware/tli.imp32
-rw-r--r--rtl/netware/tthread.inc268
-rw-r--r--rtl/netware/unicode.imp56
-rw-r--r--rtl/netware/varutils.pp47
-rw-r--r--rtl/netware/video.pp198
-rw-r--r--rtl/netware/vollib.imp31
-rw-r--r--rtl/netware/winsock.pp2446
-rw-r--r--rtl/netware/ws2_32.imp345
-rw-r--r--rtl/netware/ws2nlm.imp87
-rw-r--r--rtl/netwlibc/Makefile2034
-rw-r--r--rtl/netwlibc/Makefile.fpc265
-rw-r--r--rtl/netwlibc/classes.pp60
-rw-r--r--rtl/netwlibc/crt.pp626
-rw-r--r--rtl/netwlibc/dos.pp699
-rw-r--r--rtl/netwlibc/dynlibs.inc62
-rw-r--r--rtl/netwlibc/errno.inc144
-rw-r--r--rtl/netwlibc/initc.pp54
-rw-r--r--rtl/netwlibc/keyboard.pp142
-rw-r--r--rtl/netwlibc/libc.imp1391
-rw-r--r--rtl/netwlibc/libc.pp9237
-rw-r--r--rtl/netwlibc/libcclib.imp2
-rw-r--r--rtl/netwlibc/mouse.pp122
-rw-r--r--rtl/netwlibc/netware.imp123
-rw-r--r--rtl/netwlibc/nwl_dlle.as6
-rw-r--r--rtl/netwlibc/nwl_main.as6
-rw-r--r--rtl/netwlibc/nwsnut.imp147
-rw-r--r--rtl/netwlibc/nwsnut.pp9
-rw-r--r--rtl/netwlibc/qos.inc1
-rw-r--r--rtl/netwlibc/sockets.pp399
-rw-r--r--rtl/netwlibc/sysdir.inc101
-rw-r--r--rtl/netwlibc/sysfile.inc417
-rw-r--r--rtl/netwlibc/sysheap.inc156
-rw-r--r--rtl/netwlibc/sysos.inc55
-rw-r--r--rtl/netwlibc/sysosh.inc45
-rw-r--r--rtl/netwlibc/system.pp578
-rw-r--r--rtl/netwlibc/systhrd.inc463
-rw-r--r--rtl/netwlibc/sysutils.pp712
-rw-r--r--rtl/netwlibc/tthread.inc410
-rw-r--r--rtl/netwlibc/varutils.pp47
-rw-r--r--rtl/netwlibc/video.pp196
-rw-r--r--rtl/netwlibc/winsock.pp11
-rw-r--r--rtl/netwlibc/ws2_32.imp345
-rw-r--r--rtl/netwlibc/ws2nlm.imp89
-rw-r--r--rtl/objpas/README23
-rw-r--r--rtl/objpas/classes/action.inc193
-rw-r--r--rtl/objpas/classes/bits.inc381
-rw-r--r--rtl/objpas/classes/classes.inc1587
-rw-r--r--rtl/objpas/classes/classesh.inc1842
-rw-r--r--rtl/objpas/classes/collect.inc380
-rw-r--r--rtl/objpas/classes/compon.inc607
-rw-r--r--rtl/objpas/classes/constsg.inc280
-rw-r--r--rtl/objpas/classes/constss.inc279
-rw-r--r--rtl/objpas/classes/cregist.inc231
-rw-r--r--rtl/objpas/classes/dm.inc173
-rw-r--r--rtl/objpas/classes/filer.inc29
-rw-r--r--rtl/objpas/classes/filerec.inc41
-rw-r--r--rtl/objpas/classes/intf.inc120
-rw-r--r--rtl/objpas/classes/lists.inc569
-rw-r--r--rtl/objpas/classes/parser.inc344
-rw-r--r--rtl/objpas/classes/persist.inc166
-rw-r--r--rtl/objpas/classes/reader.inc1410
-rw-r--r--rtl/objpas/classes/streams.inc835
-rw-r--r--rtl/objpas/classes/stringl.inc1231
-rw-r--r--rtl/objpas/classes/twriter.inc221
-rw-r--r--rtl/objpas/classes/util.inc88
-rw-r--r--rtl/objpas/classes/writer.inc892
-rw-r--r--rtl/objpas/convutil.inc658
-rw-r--r--rtl/objpas/convutil.pp1
-rw-r--r--rtl/objpas/convutils.pp1
-rw-r--r--rtl/objpas/cvarutil.inc653
-rw-r--r--rtl/objpas/dateutil.inc2032
-rw-r--r--rtl/objpas/dateutil.pp1
-rw-r--r--rtl/objpas/dateutils.pp1
-rw-r--r--rtl/objpas/freebidi.pp337
-rw-r--r--rtl/objpas/math.pp1415
-rw-r--r--rtl/objpas/objpas.pp400
-rw-r--r--rtl/objpas/rtlconst.inc542
-rw-r--r--rtl/objpas/rtlconst.pp1
-rw-r--r--rtl/objpas/rtlconsts.pp1
-rw-r--r--rtl/objpas/strutils.pp1702
-rw-r--r--rtl/objpas/sysconst.pp238
-rw-r--r--rtl/objpas/sysutils/dati.inc825
-rw-r--r--rtl/objpas/sysutils/datih.inc151
-rw-r--r--rtl/objpas/sysutils/diskh.inc33
-rw-r--r--rtl/objpas/sysutils/filutilh.inc105
-rw-r--r--rtl/objpas/sysutils/fina.inc255
-rw-r--r--rtl/objpas/sysutils/finah.inc52
-rw-r--r--rtl/objpas/sysutils/intfh.inc40
-rw-r--r--rtl/objpas/sysutils/osutil.inc213
-rw-r--r--rtl/objpas/sysutils/osutilsh.inc61
-rw-r--r--rtl/objpas/sysutils/stre.inc83
-rw-r--r--rtl/objpas/sysutils/strg.inc42
-rw-r--r--rtl/objpas/sysutils/sysansi.inc78
-rw-r--r--rtl/objpas/sysutils/sysansih.inc38
-rw-r--r--rtl/objpas/sysutils/sysformt.inc363
-rw-r--r--rtl/objpas/sysutils/sysint.inc50
-rw-r--r--rtl/objpas/sysutils/sysinth.inc152
-rw-r--r--rtl/objpas/sysutils/syspch.inc131
-rw-r--r--rtl/objpas/sysutils/syspchh.inc57
-rw-r--r--rtl/objpas/sysutils/sysstr.inc2156
-rw-r--r--rtl/objpas/sysutils/sysstrh.inc229
-rw-r--r--rtl/objpas/sysutils/systhrdh.inc41
-rw-r--r--rtl/objpas/sysutils/sysuintf.inc157
-rw-r--r--rtl/objpas/sysutils/sysutilh.inc257
-rw-r--r--rtl/objpas/sysutils/sysutils.inc534
-rw-r--r--rtl/objpas/sysutils/syswide.inc124
-rw-r--r--rtl/objpas/sysutils/syswideh.inc59
-rw-r--r--rtl/objpas/types.pp413
-rw-r--r--rtl/objpas/typinfo.pp1598
-rw-r--r--rtl/objpas/utf8bidi.pp473
-rw-r--r--rtl/objpas/varutilh.inc113
-rw-r--r--rtl/objpas/varutils.inc760
-rw-r--r--rtl/openbsd/Makefile2031
-rw-r--r--rtl/openbsd/Makefile.fpc244
-rw-r--r--rtl/openbsd/classes.pp63
-rw-r--r--rtl/openbsd/errno.inc144
-rw-r--r--rtl/openbsd/i386/cprt0.as170
-rw-r--r--rtl/openbsd/i386/prt0.as171
-rw-r--r--rtl/openbsd/i386/sighnd.inc86
-rw-r--r--rtl/openbsd/ptypes.inc154
-rw-r--r--rtl/openbsd/signal.inc170
-rw-r--r--rtl/openbsd/syscalls.inc23
-rw-r--r--rtl/openbsd/sysconst.inc110
-rw-r--r--rtl/openbsd/sysctlh.inc1167
-rw-r--r--rtl/openbsd/sysnr.inc215
-rw-r--r--rtl/openbsd/sysofft.inc108
-rw-r--r--rtl/openbsd/systypes.inc43
-rw-r--r--rtl/openbsd/termio.pp49
-rw-r--r--rtl/openbsd/termios.inc371
-rw-r--r--rtl/openbsd/termiosproc.inc138
-rw-r--r--rtl/openbsd/tthread.inc604
-rw-r--r--rtl/openbsd/unixsock.inc218
-rw-r--r--rtl/openbsd/unixsysc.inc283
-rw-r--r--rtl/os2/Makefile2028
-rw-r--r--rtl/os2/Makefile.fpc228
-rw-r--r--rtl/os2/classes.pp57
-rw-r--r--rtl/os2/crt.pas405
-rw-r--r--rtl/os2/dos.pas540
-rw-r--r--rtl/os2/doscalls.pas5320
-rw-r--r--rtl/os2/dynlibs.inc68
-rw-r--r--rtl/os2/exe.pas243
-rw-r--r--rtl/os2/kbdcalls.pas1738
-rw-r--r--rtl/os2/keyboard.pp136
-rw-r--r--rtl/os2/moncalls.pas281
-rw-r--r--rtl/os2/moucalls.pas1096
-rw-r--r--rtl/os2/mouse.pp416
-rw-r--r--rtl/os2/newexe.pas189
-rw-r--r--rtl/os2/os2def.pas3412
-rw-r--r--rtl/os2/pmbidi.pas601
-rw-r--r--rtl/os2/pmbitmap.pas224
-rw-r--r--rtl/os2/pmdev.pas1033
-rw-r--r--rtl/os2/pmgpi.pas2173
-rw-r--r--rtl/os2/pmhelp.pas506
-rw-r--r--rtl/os2/pmshl.pas385
-rw-r--r--rtl/os2/pmspl.pas777
-rw-r--r--rtl/os2/pmstddlg.pas1293
-rw-r--r--rtl/os2/pmwin.pas3789
-rw-r--r--rtl/os2/pmwp.pas242
-rw-r--r--rtl/os2/pmwsock.pas1064
-rw-r--r--rtl/os2/ports.pas214
-rw-r--r--rtl/os2/printer.pas35
-rw-r--r--rtl/os2/prt0.as87
-rw-r--r--rtl/os2/so32dll.pas1587
-rw-r--r--rtl/os2/sockets.pas314
-rw-r--r--rtl/os2/sysdir.inc160
-rw-r--r--rtl/os2/sysfile.inc273
-rw-r--r--rtl/os2/sysheap.inc175
-rw-r--r--rtl/os2/sysos.inc316
-rw-r--r--rtl/os2/sysos2.pas1
-rw-r--r--rtl/os2/sysosh.inc54
-rw-r--r--rtl/os2/system.pas800
-rw-r--r--rtl/os2/systhrd.inc562
-rw-r--r--rtl/os2/sysutils.pp1043
-rw-r--r--rtl/os2/tests/atx.pas15
-rw-r--r--rtl/os2/tests/basicpm.pas62
-rw-r--r--rtl/os2/tests/calc_e.pas15
-rw-r--r--rtl/os2/tests/generic.pas61
-rw-r--r--rtl/os2/tests/getctry.pas62
-rw-r--r--rtl/os2/tests/heapsize.pas25
-rw-r--r--rtl/os2/tests/helloos2.pas25
-rw-r--r--rtl/os2/tests/modeinfo.pas42
-rw-r--r--rtl/os2/tests/o2rtlb1.pas83
-rw-r--r--rtl/os2/tests/pmdemo1.def12
-rw-r--r--rtl/os2/tests/pmdemo1.h16
-rw-r--r--rtl/os2/tests/pmdemo1.mak5
-rw-r--r--rtl/os2/tests/pmdemo1.pp81
-rw-r--r--rtl/os2/tests/pmdemo1.rc23
-rw-r--r--rtl/os2/tests/testkbd.pas49
-rw-r--r--rtl/os2/todo-os2.txt177
-rw-r--r--rtl/os2/tthread.inc246
-rw-r--r--rtl/os2/varutils.pp47
-rw-r--r--rtl/os2/video.pp478
-rw-r--r--rtl/os2/viocalls.imp61
-rw-r--r--rtl/os2/viocalls.pas1156
-rw-r--r--rtl/os2/winsock.pas28
-rw-r--r--rtl/palmos/Makefile247
-rw-r--r--rtl/palmos/api/common.inc109
-rw-r--r--rtl/palmos/api/common.pp31
-rw-r--r--rtl/palmos/api/font.imn5
-rw-r--r--rtl/palmos/api/font.inc57
-rw-r--r--rtl/palmos/api/fontsel.inc6
-rw-r--r--rtl/palmos/api/init.inc7
-rw-r--r--rtl/palmos/api/readme6
-rw-r--r--rtl/palmos/api/rect.inc32
-rw-r--r--rtl/palmos/api/sysall.pp37
-rw-r--r--rtl/palmos/api/systraps.inc482
-rw-r--r--rtl/palmos/api/systraps.pp31
-rw-r--r--rtl/palmos/api/ui.pp36
-rw-r--r--rtl/palmos/os.inc28
-rw-r--r--rtl/palmos/pilot.pp694
-rw-r--r--rtl/palmos/readme7
-rw-r--r--rtl/palmos/syspalm.pp1
-rw-r--r--rtl/palmos/system.pp119
-rw-r--r--rtl/palmos/systraps.pp866
-rw-r--r--rtl/powerpc/int64p.inc215
-rw-r--r--rtl/powerpc/makefile.cpu16
-rw-r--r--rtl/powerpc/math.inc355
-rw-r--r--rtl/powerpc/mathu.inc20
-rw-r--r--rtl/powerpc/mathuh.inc20
-rw-r--r--rtl/powerpc/powerpc.inc1169
-rw-r--r--rtl/powerpc/set.inc529
-rw-r--r--rtl/powerpc/setjump.inc117
-rw-r--r--rtl/powerpc/setjumph.inc33
-rw-r--r--rtl/powerpc/strings.inc508
-rw-r--r--rtl/powerpc/stringss.inc47
-rw-r--r--rtl/powerpc/strlen.inc40
-rw-r--r--rtl/powerpc/strpas.inc61
-rw-r--r--rtl/powerpc/sysutilp.inc81
-rw-r--r--rtl/solaris/Makefile1907
-rw-r--r--rtl/solaris/Makefile.fpc256
-rw-r--r--rtl/solaris/errno.inc192
-rw-r--r--rtl/solaris/i386/sighnd.inc73
-rw-r--r--rtl/solaris/i386/sighndh.inc39
-rw-r--r--rtl/solaris/osdefs.inc37
-rw-r--r--rtl/solaris/osmacro.inc106
-rw-r--r--rtl/solaris/ostypes.inc208
-rw-r--r--rtl/solaris/ptypes.inc248
-rw-r--r--rtl/solaris/signal.inc173
-rw-r--r--rtl/solaris/sparc/sighnd.inc94
-rw-r--r--rtl/solaris/sparc/sighndh.inc39
-rw-r--r--rtl/solaris/sparc/start.inc126
-rw-r--r--rtl/solaris/sysos.inc125
-rw-r--r--rtl/solaris/sysosh.inc48
-rw-r--r--rtl/solaris/system.pp259
-rw-r--r--rtl/sparc/int64p.inc22
-rw-r--r--rtl/sparc/makefile.cpu17
-rw-r--r--rtl/sparc/math.inc71
-rw-r--r--rtl/sparc/mathu.inc128
-rw-r--r--rtl/sparc/mathuh.inc39
-rw-r--r--rtl/sparc/set.inc23
-rw-r--r--rtl/sparc/setjump.inc109
-rw-r--r--rtl/sparc/setjumph.inc66
-rw-r--r--rtl/sparc/sparc.inc380
-rw-r--r--rtl/sparc/strings.inc25
-rw-r--r--rtl/sparc/stringss.inc25
-rw-r--r--rtl/sparc/sysutilp.inc134
-rw-r--r--rtl/ucmaps/8859-1.txt303
-rw-r--r--rtl/ucmaps/8859-10.txt303
-rw-r--r--rtl/ucmaps/8859-13.txt299
-rw-r--r--rtl/ucmaps/8859-14.txt301
-rw-r--r--rtl/ucmaps/8859-15.txt303
-rw-r--r--rtl/ucmaps/8859-2.txt303
-rw-r--r--rtl/ucmaps/8859-3.txt296
-rw-r--r--rtl/ucmaps/8859-4.txt303
-rw-r--r--rtl/ucmaps/8859-5.txt303
-rw-r--r--rtl/ucmaps/8859-6.txt260
-rw-r--r--rtl/ucmaps/8859-7.txt302
-rw-r--r--rtl/ucmaps/8859-8.txt270
-rw-r--r--rtl/ucmaps/8859-9.txt307
-rw-r--r--rtl/ucmaps/cp1250.txt274
-rw-r--r--rtl/ucmaps/cp1251.txt274
-rw-r--r--rtl/ucmaps/cp1252.txt274
-rw-r--r--rtl/ucmaps/cp1253.txt274
-rw-r--r--rtl/ucmaps/cp1254.txt274
-rw-r--r--rtl/ucmaps/cp1255.txt274
-rw-r--r--rtl/ucmaps/cp1256.txt274
-rw-r--r--rtl/ucmaps/cp1257.txt274
-rw-r--r--rtl/ucmaps/cp1258.txt274
-rw-r--r--rtl/ucmaps/cp437.txt273
-rw-r--r--rtl/ucmaps/cp737.txt273
-rw-r--r--rtl/ucmaps/cp775.txt274
-rw-r--r--rtl/ucmaps/cp850.txt273
-rw-r--r--rtl/ucmaps/cp852.txt273
-rw-r--r--rtl/ucmaps/cp855.txt274
-rw-r--r--rtl/ucmaps/cp856.txt303
-rw-r--r--rtl/ucmaps/cp857.txt274
-rw-r--r--rtl/ucmaps/cp860.txt274
-rw-r--r--rtl/ucmaps/cp861.txt274
-rw-r--r--rtl/ucmaps/cp862.txt274
-rw-r--r--rtl/ucmaps/cp863.txt274
-rw-r--r--rtl/ucmaps/cp864.txt274
-rw-r--r--rtl/ucmaps/cp865.txt274
-rw-r--r--rtl/ucmaps/cp866.txt274
-rw-r--r--rtl/ucmaps/cp869.txt274
-rw-r--r--rtl/ucmaps/cp874.txt274
-rw-r--r--rtl/ucmaps/cp932.txt7998
-rw-r--r--rtl/unix/aliasctp.inc69
-rw-r--r--rtl/unix/aliasptp.inc88
-rw-r--r--rtl/unix/baseunix.pp108
-rw-r--r--rtl/unix/bunxh.inc113
-rw-r--r--rtl/unix/bunxovl.inc383
-rw-r--r--rtl/unix/bunxovlh.inc104
-rw-r--r--rtl/unix/classes.pp69
-rw-r--r--rtl/unix/crt.pp1638
-rw-r--r--rtl/unix/cthreads.pp697
-rw-r--r--rtl/unix/ctypes.inc96
-rw-r--r--rtl/unix/cwstring.pp269
-rw-r--r--rtl/unix/dl.pp26
-rw-r--r--rtl/unix/dos.pp904
-rw-r--r--rtl/unix/dynlibs.inc62
-rw-r--r--rtl/unix/errors.pp187
-rw-r--r--rtl/unix/genfdset.inc70
-rw-r--r--rtl/unix/genfuncs.inc124
-rw-r--r--rtl/unix/gensigset.inc79
-rw-r--r--rtl/unix/ggigraph.pp543
-rw-r--r--rtl/unix/graph.pp610
-rw-r--r--rtl/unix/graph16.inc434
-rw-r--r--rtl/unix/initc.pp93
-rw-r--r--rtl/unix/ipc.pp423
-rw-r--r--rtl/unix/ipccdecl.inc103
-rw-r--r--rtl/unix/keyboard.pp1542
-rw-r--r--rtl/unix/linux.pp32
-rw-r--r--rtl/unix/linuxnew.inc153
-rw-r--r--rtl/unix/linuxold.inc5920
-rw-r--r--rtl/unix/mouse.pp435
-rw-r--r--rtl/unix/oldlinux.pp1
-rw-r--r--rtl/unix/oscdeclh.inc102
-rw-r--r--rtl/unix/ports.pp109
-rw-r--r--rtl/unix/printer.pp248
-rw-r--r--rtl/unix/serial.pp221
-rw-r--r--rtl/unix/settimeo.inc46
-rw-r--r--rtl/unix/sockets.pp76
-rw-r--r--rtl/unix/syscall.pp11
-rw-r--r--rtl/unix/sysdir.inc169
-rw-r--r--rtl/unix/sysfile.inc237
-rw-r--r--rtl/unix/sysheap.inc50
-rw-r--r--rtl/unix/systhrd.inc36
-rw-r--r--rtl/unix/sysunixh.inc72
-rw-r--r--rtl/unix/sysutils.pp1249
-rw-r--r--rtl/unix/terminfo.pp751
-rw-r--r--rtl/unix/termiosh.inc38
-rw-r--r--rtl/unix/timezone.inc301
-rw-r--r--rtl/unix/ttyname.inc96
-rw-r--r--rtl/unix/unix.pp1248
-rw-r--r--rtl/unix/unixtype.pp33
-rw-r--r--rtl/unix/unixutil.pp417
-rw-r--r--rtl/unix/unxdeclh.inc30
-rw-r--r--rtl/unix/unxovl.inc35
-rw-r--r--rtl/unix/unxovlh.inc27
-rw-r--r--rtl/unix/varutils.pp47
-rw-r--r--rtl/unix/video.pp909
-rw-r--r--rtl/unix/x86.pp399
-rw-r--r--rtl/watcom/Makefile2010
-rw-r--r--rtl/watcom/Makefile.fpc207
-rw-r--r--rtl/watcom/classes.pp53
-rw-r--r--rtl/watcom/crt.pp762
-rw-r--r--rtl/watcom/dos.pp848
-rw-r--r--rtl/watcom/prt0.asm71
-rw-r--r--rtl/watcom/system.pp1556
-rw-r--r--rtl/watcom/sysutils.pp888
-rw-r--r--rtl/watcom/varutils.pp46
-rw-r--r--rtl/watcom/watcom.pp1162
-rw-r--r--rtl/win32/Makefile2036
-rw-r--r--rtl/win32/Makefile.fpc246
-rw-r--r--rtl/win32/classes.pp64
-rw-r--r--rtl/win32/crt.pp841
-rw-r--r--rtl/win32/dos.pp820
-rw-r--r--rtl/win32/dynlibs.inc63
-rw-r--r--rtl/win32/gprt0.as67
-rw-r--r--rtl/win32/graph.pp2238
-rw-r--r--rtl/win32/initc.pp40
-rw-r--r--rtl/win32/keyboard.pp885
-rw-r--r--rtl/win32/messages.pp15
-rw-r--r--rtl/win32/mouse.pp255
-rw-r--r--rtl/win32/objinc.inc191
-rw-r--r--rtl/win32/printer.pp35
-rw-r--r--rtl/win32/signals.pp466
-rw-r--r--rtl/win32/sockets.pp395
-rw-r--r--rtl/win32/sysdir.inc107
-rw-r--r--rtl/win32/sysfile.inc272
-rw-r--r--rtl/win32/sysheap.inc63
-rw-r--r--rtl/win32/sysos.inc292
-rw-r--r--rtl/win32/sysosh.inc54
-rw-r--r--rtl/win32/system.pp1138
-rw-r--r--rtl/win32/systhrd.inc490
-rw-r--r--rtl/win32/sysutils.pp1151
-rw-r--r--rtl/win32/syswin32.pp1
-rw-r--r--rtl/win32/tthread.inc230
-rw-r--r--rtl/win32/varutils.pp82
-rw-r--r--rtl/win32/video.pp456
-rw-r--r--rtl/win32/wcygprt0.as84
-rw-r--r--rtl/win32/wdllprt0.as84
-rw-r--r--rtl/win32/win32.inc27
-rw-r--r--rtl/win32/wincrt.pp231
-rw-r--r--rtl/win32/windows.pp72
-rw-r--r--rtl/win32/winevent.pp310
-rw-r--r--rtl/win32/wininc/Makefile164
-rw-r--r--rtl/win32/wininc/ascdef.inc496
-rw-r--r--rtl/win32/wininc/ascdef.sed21
-rw-r--r--rtl/win32/wininc/ascfun.inc500
-rw-r--r--rtl/win32/wininc/base.inc950
-rw-r--r--rtl/win32/wininc/defines.inc5953
-rw-r--r--rtl/win32/wininc/errors.inc1172
-rw-r--r--rtl/win32/wininc/func.inc2346
-rw-r--r--rtl/win32/wininc/makefile.inc3
-rw-r--r--rtl/win32/wininc/messages.inc1316
-rw-r--r--rtl/win32/wininc/redef.inc1071
-rw-r--r--rtl/win32/wininc/struct.inc7220
-rw-r--r--rtl/win32/wininc/unidef.inc499
-rw-r--r--rtl/win32/wininc/unidef.sed21
-rw-r--r--rtl/win32/wininc/unifun.inc501
-rw-r--r--rtl/win32/winmouse.pp205
-rw-r--r--rtl/win32/winsock.pp920
-rw-r--r--rtl/win32/winsysut.pp88
-rw-r--r--rtl/win32/wprt0.as68
-rw-r--r--rtl/win32/wprt0_10.as57
-rw-r--r--rtl/x86_64/int64p.inc18
-rw-r--r--rtl/x86_64/makefile.cpu13
-rw-r--r--rtl/x86_64/math.inc302
-rw-r--r--rtl/x86_64/mathu.inc104
-rw-r--r--rtl/x86_64/mathuh.inc41
-rw-r--r--rtl/x86_64/set.inc22
-rw-r--r--rtl/x86_64/setjump.inc59
-rw-r--r--rtl/x86_64/setjumph.inc32
-rw-r--r--rtl/x86_64/strings.inc174
-rw-r--r--rtl/x86_64/stringss.inc25
-rw-r--r--rtl/x86_64/strlen.inc139
-rw-r--r--rtl/x86_64/sysutilp.inc64
-rw-r--r--rtl/x86_64/x86_64.inc404
953 files changed, 402120 insertions, 0 deletions
diff --git a/rtl/COPYING b/rtl/COPYING
new file mode 100644
index 0000000000..b1e3f5a263
--- /dev/null
+++ b/rtl/COPYING
@@ -0,0 +1,504 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it. You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+
+ When we speak of free software, we are referring to freedom of use,
+not price. Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+ To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights. These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ To protect each distributor, we want to make it very clear that
+there is no warranty for the free library. Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+ Finally, software patents pose a constant threat to the existence of
+any free program. We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder. Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+ Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License. This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License. We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+ When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library. The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom. The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+ We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License. It also provides other free software developers Less
+of an advantage over competing non-free programs. These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries. However, the Lesser license provides advantages in certain
+special circumstances.
+
+ For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard. To achieve this, non-free programs must be
+allowed to use the library. A more frequent case is that a free
+library does the same job as widely used non-free libraries. In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+ In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software. For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+ Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+ GNU LESSER GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+ You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+ If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+ 6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+
+ c) Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ d) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ e) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+ 7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License. However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+ 9. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+ 11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded. In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation. If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission. For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this. Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+ NO WARRANTY
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library. It is
+safest to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
+
+
diff --git a/rtl/COPYING.FPC b/rtl/COPYING.FPC
new file mode 100644
index 0000000000..675669fa2c
--- /dev/null
+++ b/rtl/COPYING.FPC
@@ -0,0 +1,25 @@
+This is the file COPYING.FPC, it applies to the Free Pascal Run-Time Library
+(RTL) and packages (packages) distributed by members of the Free Pascal
+Development Team.
+
+The source code of the Free Pascal Runtime Libraries and packages are
+distributed under the Library GNU General Public License
+(see the file COPYING) with the following modification:
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent modules,
+and to copy and distribute the resulting executable under terms of your choice,
+provided that you also meet, for each linked independent module, the terms
+and conditions of the license of that module. An independent module is a module
+which is not derived from or based on this library. If you modify this
+library, you may extend this exception to your version of the library, but you are
+not obligated to do so. If you do not wish to do so, delete this exception
+statement from your version.
+
+If you didn't receive a copy of the file COPYING, contact:
+ Free Software Foundation
+ 675 Mass Ave
+ Cambridge, MA 02139
+ USA
+
diff --git a/rtl/Makefile b/rtl/Makefile
new file mode 100644
index 0000000000..bcde889aa7
--- /dev/null
+++ b/rtl/Makefile
@@ -0,0 +1,2220 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+override PACKAGE_VERSION=2.0.0
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_DIRS+=linux
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_DIRS+=go32v2
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_DIRS+=win32
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_DIRS+=os2
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_DIRS+=freebsd
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_DIRS+=beos
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_DIRS+=netbsd
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_DIRS+=netware
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_DIRS+=emx
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_DIRS+=netwlibc
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_DIRS+=linux
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_DIRS+=freebsd
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_DIRS+=netbsd
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_DIRS+=amiga
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_DIRS+=linux
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_DIRS+=netbsd
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_DIRS+=macos
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_DIRS+=darwin
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_DIRS+=morphos
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_DIRS+=linux
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_DIRS+=netbsd
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_DIRS+=linux
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_DIRS+=freebsd
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_DIRS+=linux
+endif
+override INSTALL_FPCPACKAGE=y
+override INSTALL_CREATEPACKAGEFPC=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+ $(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+ $(MKDIR) $(DIST_DESTDIR)
+ $(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+ $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+ $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+ $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+ echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+ echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+ echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+ /bin/sh $(ZIPWRAPPER)
+else
+ $(ZIPWRAPPER)
+endif
+ $(DEL) $(ZIPWRAPPER)
+else
+ $(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+ $(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+ $(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+ $(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+ $(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+ifeq ($(FULL_TARGET),i386-linux)
+TARGET_DIRS_LINUX=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+TARGET_DIRS_GO32V2=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+TARGET_DIRS_WIN32=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+TARGET_DIRS_OS2=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+TARGET_DIRS_FREEBSD=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+TARGET_DIRS_BEOS=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+TARGET_DIRS_NETBSD=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+TARGET_DIRS_NETWARE=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+TARGET_DIRS_EMX=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+TARGET_DIRS_NETWLIBC=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+TARGET_DIRS_LINUX=1
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+TARGET_DIRS_FREEBSD=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+TARGET_DIRS_NETBSD=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+TARGET_DIRS_AMIGA=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+TARGET_DIRS_LINUX=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+TARGET_DIRS_NETBSD=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+TARGET_DIRS_MACOS=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+TARGET_DIRS_DARWIN=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+TARGET_DIRS_MORPHOS=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+TARGET_DIRS_LINUX=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+TARGET_DIRS_NETBSD=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+TARGET_DIRS_LINUX=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+TARGET_DIRS_FREEBSD=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+TARGET_DIRS_LINUX=1
+endif
+ifdef TARGET_DIRS_LINUX
+linux_all:
+ $(MAKE) -C linux all
+linux_debug:
+ $(MAKE) -C linux debug
+linux_smart:
+ $(MAKE) -C linux smart
+linux_release:
+ $(MAKE) -C linux release
+linux_units:
+ $(MAKE) -C linux units
+linux_examples:
+ $(MAKE) -C linux examples
+linux_shared:
+ $(MAKE) -C linux shared
+linux_install:
+ $(MAKE) -C linux install
+linux_sourceinstall:
+ $(MAKE) -C linux sourceinstall
+linux_exampleinstall:
+ $(MAKE) -C linux exampleinstall
+linux_distinstall:
+ $(MAKE) -C linux distinstall
+linux_zipinstall:
+ $(MAKE) -C linux zipinstall
+linux_zipsourceinstall:
+ $(MAKE) -C linux zipsourceinstall
+linux_zipexampleinstall:
+ $(MAKE) -C linux zipexampleinstall
+linux_zipdistinstall:
+ $(MAKE) -C linux zipdistinstall
+linux_clean:
+ $(MAKE) -C linux clean
+linux_distclean:
+ $(MAKE) -C linux distclean
+linux_cleanall:
+ $(MAKE) -C linux cleanall
+linux_info:
+ $(MAKE) -C linux info
+linux_makefiles:
+ $(MAKE) -C linux makefiles
+linux:
+ $(MAKE) -C linux all
+.PHONY: linux_all linux_debug linux_smart linux_release linux_units linux_examples linux_shared linux_install linux_sourceinstall linux_exampleinstall linux_distinstall linux_zipinstall linux_zipsourceinstall linux_zipexampleinstall linux_zipdistinstall linux_clean linux_distclean linux_cleanall linux_info linux_makefiles linux
+endif
+ifdef TARGET_DIRS_GO32V2
+go32v2_all:
+ $(MAKE) -C go32v2 all
+go32v2_debug:
+ $(MAKE) -C go32v2 debug
+go32v2_smart:
+ $(MAKE) -C go32v2 smart
+go32v2_release:
+ $(MAKE) -C go32v2 release
+go32v2_units:
+ $(MAKE) -C go32v2 units
+go32v2_examples:
+ $(MAKE) -C go32v2 examples
+go32v2_shared:
+ $(MAKE) -C go32v2 shared
+go32v2_install:
+ $(MAKE) -C go32v2 install
+go32v2_sourceinstall:
+ $(MAKE) -C go32v2 sourceinstall
+go32v2_exampleinstall:
+ $(MAKE) -C go32v2 exampleinstall
+go32v2_distinstall:
+ $(MAKE) -C go32v2 distinstall
+go32v2_zipinstall:
+ $(MAKE) -C go32v2 zipinstall
+go32v2_zipsourceinstall:
+ $(MAKE) -C go32v2 zipsourceinstall
+go32v2_zipexampleinstall:
+ $(MAKE) -C go32v2 zipexampleinstall
+go32v2_zipdistinstall:
+ $(MAKE) -C go32v2 zipdistinstall
+go32v2_clean:
+ $(MAKE) -C go32v2 clean
+go32v2_distclean:
+ $(MAKE) -C go32v2 distclean
+go32v2_cleanall:
+ $(MAKE) -C go32v2 cleanall
+go32v2_info:
+ $(MAKE) -C go32v2 info
+go32v2_makefiles:
+ $(MAKE) -C go32v2 makefiles
+go32v2:
+ $(MAKE) -C go32v2 all
+.PHONY: go32v2_all go32v2_debug go32v2_smart go32v2_release go32v2_units go32v2_examples go32v2_shared go32v2_install go32v2_sourceinstall go32v2_exampleinstall go32v2_distinstall go32v2_zipinstall go32v2_zipsourceinstall go32v2_zipexampleinstall go32v2_zipdistinstall go32v2_clean go32v2_distclean go32v2_cleanall go32v2_info go32v2_makefiles go32v2
+endif
+ifdef TARGET_DIRS_WIN32
+win32_all:
+ $(MAKE) -C win32 all
+win32_debug:
+ $(MAKE) -C win32 debug
+win32_smart:
+ $(MAKE) -C win32 smart
+win32_release:
+ $(MAKE) -C win32 release
+win32_units:
+ $(MAKE) -C win32 units
+win32_examples:
+ $(MAKE) -C win32 examples
+win32_shared:
+ $(MAKE) -C win32 shared
+win32_install:
+ $(MAKE) -C win32 install
+win32_sourceinstall:
+ $(MAKE) -C win32 sourceinstall
+win32_exampleinstall:
+ $(MAKE) -C win32 exampleinstall
+win32_distinstall:
+ $(MAKE) -C win32 distinstall
+win32_zipinstall:
+ $(MAKE) -C win32 zipinstall
+win32_zipsourceinstall:
+ $(MAKE) -C win32 zipsourceinstall
+win32_zipexampleinstall:
+ $(MAKE) -C win32 zipexampleinstall
+win32_zipdistinstall:
+ $(MAKE) -C win32 zipdistinstall
+win32_clean:
+ $(MAKE) -C win32 clean
+win32_distclean:
+ $(MAKE) -C win32 distclean
+win32_cleanall:
+ $(MAKE) -C win32 cleanall
+win32_info:
+ $(MAKE) -C win32 info
+win32_makefiles:
+ $(MAKE) -C win32 makefiles
+win32:
+ $(MAKE) -C win32 all
+.PHONY: win32_all win32_debug win32_smart win32_release win32_units win32_examples win32_shared win32_install win32_sourceinstall win32_exampleinstall win32_distinstall win32_zipinstall win32_zipsourceinstall win32_zipexampleinstall win32_zipdistinstall win32_clean win32_distclean win32_cleanall win32_info win32_makefiles win32
+endif
+ifdef TARGET_DIRS_OS2
+os2_all:
+ $(MAKE) -C os2 all
+os2_debug:
+ $(MAKE) -C os2 debug
+os2_smart:
+ $(MAKE) -C os2 smart
+os2_release:
+ $(MAKE) -C os2 release
+os2_units:
+ $(MAKE) -C os2 units
+os2_examples:
+ $(MAKE) -C os2 examples
+os2_shared:
+ $(MAKE) -C os2 shared
+os2_install:
+ $(MAKE) -C os2 install
+os2_sourceinstall:
+ $(MAKE) -C os2 sourceinstall
+os2_exampleinstall:
+ $(MAKE) -C os2 exampleinstall
+os2_distinstall:
+ $(MAKE) -C os2 distinstall
+os2_zipinstall:
+ $(MAKE) -C os2 zipinstall
+os2_zipsourceinstall:
+ $(MAKE) -C os2 zipsourceinstall
+os2_zipexampleinstall:
+ $(MAKE) -C os2 zipexampleinstall
+os2_zipdistinstall:
+ $(MAKE) -C os2 zipdistinstall
+os2_clean:
+ $(MAKE) -C os2 clean
+os2_distclean:
+ $(MAKE) -C os2 distclean
+os2_cleanall:
+ $(MAKE) -C os2 cleanall
+os2_info:
+ $(MAKE) -C os2 info
+os2_makefiles:
+ $(MAKE) -C os2 makefiles
+os2:
+ $(MAKE) -C os2 all
+.PHONY: os2_all os2_debug os2_smart os2_release os2_units os2_examples os2_shared os2_install os2_sourceinstall os2_exampleinstall os2_distinstall os2_zipinstall os2_zipsourceinstall os2_zipexampleinstall os2_zipdistinstall os2_clean os2_distclean os2_cleanall os2_info os2_makefiles os2
+endif
+ifdef TARGET_DIRS_FREEBSD
+freebsd_all:
+ $(MAKE) -C freebsd all
+freebsd_debug:
+ $(MAKE) -C freebsd debug
+freebsd_smart:
+ $(MAKE) -C freebsd smart
+freebsd_release:
+ $(MAKE) -C freebsd release
+freebsd_units:
+ $(MAKE) -C freebsd units
+freebsd_examples:
+ $(MAKE) -C freebsd examples
+freebsd_shared:
+ $(MAKE) -C freebsd shared
+freebsd_install:
+ $(MAKE) -C freebsd install
+freebsd_sourceinstall:
+ $(MAKE) -C freebsd sourceinstall
+freebsd_exampleinstall:
+ $(MAKE) -C freebsd exampleinstall
+freebsd_distinstall:
+ $(MAKE) -C freebsd distinstall
+freebsd_zipinstall:
+ $(MAKE) -C freebsd zipinstall
+freebsd_zipsourceinstall:
+ $(MAKE) -C freebsd zipsourceinstall
+freebsd_zipexampleinstall:
+ $(MAKE) -C freebsd zipexampleinstall
+freebsd_zipdistinstall:
+ $(MAKE) -C freebsd zipdistinstall
+freebsd_clean:
+ $(MAKE) -C freebsd clean
+freebsd_distclean:
+ $(MAKE) -C freebsd distclean
+freebsd_cleanall:
+ $(MAKE) -C freebsd cleanall
+freebsd_info:
+ $(MAKE) -C freebsd info
+freebsd_makefiles:
+ $(MAKE) -C freebsd makefiles
+freebsd:
+ $(MAKE) -C freebsd all
+.PHONY: freebsd_all freebsd_debug freebsd_smart freebsd_release freebsd_units freebsd_examples freebsd_shared freebsd_install freebsd_sourceinstall freebsd_exampleinstall freebsd_distinstall freebsd_zipinstall freebsd_zipsourceinstall freebsd_zipexampleinstall freebsd_zipdistinstall freebsd_clean freebsd_distclean freebsd_cleanall freebsd_info freebsd_makefiles freebsd
+endif
+ifdef TARGET_DIRS_BEOS
+beos_all:
+ $(MAKE) -C beos all
+beos_debug:
+ $(MAKE) -C beos debug
+beos_smart:
+ $(MAKE) -C beos smart
+beos_release:
+ $(MAKE) -C beos release
+beos_units:
+ $(MAKE) -C beos units
+beos_examples:
+ $(MAKE) -C beos examples
+beos_shared:
+ $(MAKE) -C beos shared
+beos_install:
+ $(MAKE) -C beos install
+beos_sourceinstall:
+ $(MAKE) -C beos sourceinstall
+beos_exampleinstall:
+ $(MAKE) -C beos exampleinstall
+beos_distinstall:
+ $(MAKE) -C beos distinstall
+beos_zipinstall:
+ $(MAKE) -C beos zipinstall
+beos_zipsourceinstall:
+ $(MAKE) -C beos zipsourceinstall
+beos_zipexampleinstall:
+ $(MAKE) -C beos zipexampleinstall
+beos_zipdistinstall:
+ $(MAKE) -C beos zipdistinstall
+beos_clean:
+ $(MAKE) -C beos clean
+beos_distclean:
+ $(MAKE) -C beos distclean
+beos_cleanall:
+ $(MAKE) -C beos cleanall
+beos_info:
+ $(MAKE) -C beos info
+beos_makefiles:
+ $(MAKE) -C beos makefiles
+beos:
+ $(MAKE) -C beos all
+.PHONY: beos_all beos_debug beos_smart beos_release beos_units beos_examples beos_shared beos_install beos_sourceinstall beos_exampleinstall beos_distinstall beos_zipinstall beos_zipsourceinstall beos_zipexampleinstall beos_zipdistinstall beos_clean beos_distclean beos_cleanall beos_info beos_makefiles beos
+endif
+ifdef TARGET_DIRS_NETBSD
+netbsd_all:
+ $(MAKE) -C netbsd all
+netbsd_debug:
+ $(MAKE) -C netbsd debug
+netbsd_smart:
+ $(MAKE) -C netbsd smart
+netbsd_release:
+ $(MAKE) -C netbsd release
+netbsd_units:
+ $(MAKE) -C netbsd units
+netbsd_examples:
+ $(MAKE) -C netbsd examples
+netbsd_shared:
+ $(MAKE) -C netbsd shared
+netbsd_install:
+ $(MAKE) -C netbsd install
+netbsd_sourceinstall:
+ $(MAKE) -C netbsd sourceinstall
+netbsd_exampleinstall:
+ $(MAKE) -C netbsd exampleinstall
+netbsd_distinstall:
+ $(MAKE) -C netbsd distinstall
+netbsd_zipinstall:
+ $(MAKE) -C netbsd zipinstall
+netbsd_zipsourceinstall:
+ $(MAKE) -C netbsd zipsourceinstall
+netbsd_zipexampleinstall:
+ $(MAKE) -C netbsd zipexampleinstall
+netbsd_zipdistinstall:
+ $(MAKE) -C netbsd zipdistinstall
+netbsd_clean:
+ $(MAKE) -C netbsd clean
+netbsd_distclean:
+ $(MAKE) -C netbsd distclean
+netbsd_cleanall:
+ $(MAKE) -C netbsd cleanall
+netbsd_info:
+ $(MAKE) -C netbsd info
+netbsd_makefiles:
+ $(MAKE) -C netbsd makefiles
+netbsd:
+ $(MAKE) -C netbsd all
+.PHONY: netbsd_all netbsd_debug netbsd_smart netbsd_release netbsd_units netbsd_examples netbsd_shared netbsd_install netbsd_sourceinstall netbsd_exampleinstall netbsd_distinstall netbsd_zipinstall netbsd_zipsourceinstall netbsd_zipexampleinstall netbsd_zipdistinstall netbsd_clean netbsd_distclean netbsd_cleanall netbsd_info netbsd_makefiles netbsd
+endif
+ifdef TARGET_DIRS_NETWARE
+netware_all:
+ $(MAKE) -C netware all
+netware_debug:
+ $(MAKE) -C netware debug
+netware_smart:
+ $(MAKE) -C netware smart
+netware_release:
+ $(MAKE) -C netware release
+netware_units:
+ $(MAKE) -C netware units
+netware_examples:
+ $(MAKE) -C netware examples
+netware_shared:
+ $(MAKE) -C netware shared
+netware_install:
+ $(MAKE) -C netware install
+netware_sourceinstall:
+ $(MAKE) -C netware sourceinstall
+netware_exampleinstall:
+ $(MAKE) -C netware exampleinstall
+netware_distinstall:
+ $(MAKE) -C netware distinstall
+netware_zipinstall:
+ $(MAKE) -C netware zipinstall
+netware_zipsourceinstall:
+ $(MAKE) -C netware zipsourceinstall
+netware_zipexampleinstall:
+ $(MAKE) -C netware zipexampleinstall
+netware_zipdistinstall:
+ $(MAKE) -C netware zipdistinstall
+netware_clean:
+ $(MAKE) -C netware clean
+netware_distclean:
+ $(MAKE) -C netware distclean
+netware_cleanall:
+ $(MAKE) -C netware cleanall
+netware_info:
+ $(MAKE) -C netware info
+netware_makefiles:
+ $(MAKE) -C netware makefiles
+netware:
+ $(MAKE) -C netware all
+.PHONY: netware_all netware_debug netware_smart netware_release netware_units netware_examples netware_shared netware_install netware_sourceinstall netware_exampleinstall netware_distinstall netware_zipinstall netware_zipsourceinstall netware_zipexampleinstall netware_zipdistinstall netware_clean netware_distclean netware_cleanall netware_info netware_makefiles netware
+endif
+ifdef TARGET_DIRS_EMX
+emx_all:
+ $(MAKE) -C emx all
+emx_debug:
+ $(MAKE) -C emx debug
+emx_smart:
+ $(MAKE) -C emx smart
+emx_release:
+ $(MAKE) -C emx release
+emx_units:
+ $(MAKE) -C emx units
+emx_examples:
+ $(MAKE) -C emx examples
+emx_shared:
+ $(MAKE) -C emx shared
+emx_install:
+ $(MAKE) -C emx install
+emx_sourceinstall:
+ $(MAKE) -C emx sourceinstall
+emx_exampleinstall:
+ $(MAKE) -C emx exampleinstall
+emx_distinstall:
+ $(MAKE) -C emx distinstall
+emx_zipinstall:
+ $(MAKE) -C emx zipinstall
+emx_zipsourceinstall:
+ $(MAKE) -C emx zipsourceinstall
+emx_zipexampleinstall:
+ $(MAKE) -C emx zipexampleinstall
+emx_zipdistinstall:
+ $(MAKE) -C emx zipdistinstall
+emx_clean:
+ $(MAKE) -C emx clean
+emx_distclean:
+ $(MAKE) -C emx distclean
+emx_cleanall:
+ $(MAKE) -C emx cleanall
+emx_info:
+ $(MAKE) -C emx info
+emx_makefiles:
+ $(MAKE) -C emx makefiles
+emx:
+ $(MAKE) -C emx all
+.PHONY: emx_all emx_debug emx_smart emx_release emx_units emx_examples emx_shared emx_install emx_sourceinstall emx_exampleinstall emx_distinstall emx_zipinstall emx_zipsourceinstall emx_zipexampleinstall emx_zipdistinstall emx_clean emx_distclean emx_cleanall emx_info emx_makefiles emx
+endif
+ifdef TARGET_DIRS_NETWLIBC
+netwlibc_all:
+ $(MAKE) -C netwlibc all
+netwlibc_debug:
+ $(MAKE) -C netwlibc debug
+netwlibc_smart:
+ $(MAKE) -C netwlibc smart
+netwlibc_release:
+ $(MAKE) -C netwlibc release
+netwlibc_units:
+ $(MAKE) -C netwlibc units
+netwlibc_examples:
+ $(MAKE) -C netwlibc examples
+netwlibc_shared:
+ $(MAKE) -C netwlibc shared
+netwlibc_install:
+ $(MAKE) -C netwlibc install
+netwlibc_sourceinstall:
+ $(MAKE) -C netwlibc sourceinstall
+netwlibc_exampleinstall:
+ $(MAKE) -C netwlibc exampleinstall
+netwlibc_distinstall:
+ $(MAKE) -C netwlibc distinstall
+netwlibc_zipinstall:
+ $(MAKE) -C netwlibc zipinstall
+netwlibc_zipsourceinstall:
+ $(MAKE) -C netwlibc zipsourceinstall
+netwlibc_zipexampleinstall:
+ $(MAKE) -C netwlibc zipexampleinstall
+netwlibc_zipdistinstall:
+ $(MAKE) -C netwlibc zipdistinstall
+netwlibc_clean:
+ $(MAKE) -C netwlibc clean
+netwlibc_distclean:
+ $(MAKE) -C netwlibc distclean
+netwlibc_cleanall:
+ $(MAKE) -C netwlibc cleanall
+netwlibc_info:
+ $(MAKE) -C netwlibc info
+netwlibc_makefiles:
+ $(MAKE) -C netwlibc makefiles
+netwlibc:
+ $(MAKE) -C netwlibc all
+.PHONY: netwlibc_all netwlibc_debug netwlibc_smart netwlibc_release netwlibc_units netwlibc_examples netwlibc_shared netwlibc_install netwlibc_sourceinstall netwlibc_exampleinstall netwlibc_distinstall netwlibc_zipinstall netwlibc_zipsourceinstall netwlibc_zipexampleinstall netwlibc_zipdistinstall netwlibc_clean netwlibc_distclean netwlibc_cleanall netwlibc_info netwlibc_makefiles netwlibc
+endif
+ifdef TARGET_DIRS_AMIGA
+amiga_all:
+ $(MAKE) -C amiga all
+amiga_debug:
+ $(MAKE) -C amiga debug
+amiga_smart:
+ $(MAKE) -C amiga smart
+amiga_release:
+ $(MAKE) -C amiga release
+amiga_units:
+ $(MAKE) -C amiga units
+amiga_examples:
+ $(MAKE) -C amiga examples
+amiga_shared:
+ $(MAKE) -C amiga shared
+amiga_install:
+ $(MAKE) -C amiga install
+amiga_sourceinstall:
+ $(MAKE) -C amiga sourceinstall
+amiga_exampleinstall:
+ $(MAKE) -C amiga exampleinstall
+amiga_distinstall:
+ $(MAKE) -C amiga distinstall
+amiga_zipinstall:
+ $(MAKE) -C amiga zipinstall
+amiga_zipsourceinstall:
+ $(MAKE) -C amiga zipsourceinstall
+amiga_zipexampleinstall:
+ $(MAKE) -C amiga zipexampleinstall
+amiga_zipdistinstall:
+ $(MAKE) -C amiga zipdistinstall
+amiga_clean:
+ $(MAKE) -C amiga clean
+amiga_distclean:
+ $(MAKE) -C amiga distclean
+amiga_cleanall:
+ $(MAKE) -C amiga cleanall
+amiga_info:
+ $(MAKE) -C amiga info
+amiga_makefiles:
+ $(MAKE) -C amiga makefiles
+amiga:
+ $(MAKE) -C amiga all
+.PHONY: amiga_all amiga_debug amiga_smart amiga_release amiga_units amiga_examples amiga_shared amiga_install amiga_sourceinstall amiga_exampleinstall amiga_distinstall amiga_zipinstall amiga_zipsourceinstall amiga_zipexampleinstall amiga_zipdistinstall amiga_clean amiga_distclean amiga_cleanall amiga_info amiga_makefiles amiga
+endif
+ifdef TARGET_DIRS_MACOS
+macos_all:
+ $(MAKE) -C macos all
+macos_debug:
+ $(MAKE) -C macos debug
+macos_smart:
+ $(MAKE) -C macos smart
+macos_release:
+ $(MAKE) -C macos release
+macos_units:
+ $(MAKE) -C macos units
+macos_examples:
+ $(MAKE) -C macos examples
+macos_shared:
+ $(MAKE) -C macos shared
+macos_install:
+ $(MAKE) -C macos install
+macos_sourceinstall:
+ $(MAKE) -C macos sourceinstall
+macos_exampleinstall:
+ $(MAKE) -C macos exampleinstall
+macos_distinstall:
+ $(MAKE) -C macos distinstall
+macos_zipinstall:
+ $(MAKE) -C macos zipinstall
+macos_zipsourceinstall:
+ $(MAKE) -C macos zipsourceinstall
+macos_zipexampleinstall:
+ $(MAKE) -C macos zipexampleinstall
+macos_zipdistinstall:
+ $(MAKE) -C macos zipdistinstall
+macos_clean:
+ $(MAKE) -C macos clean
+macos_distclean:
+ $(MAKE) -C macos distclean
+macos_cleanall:
+ $(MAKE) -C macos cleanall
+macos_info:
+ $(MAKE) -C macos info
+macos_makefiles:
+ $(MAKE) -C macos makefiles
+macos:
+ $(MAKE) -C macos all
+.PHONY: macos_all macos_debug macos_smart macos_release macos_units macos_examples macos_shared macos_install macos_sourceinstall macos_exampleinstall macos_distinstall macos_zipinstall macos_zipsourceinstall macos_zipexampleinstall macos_zipdistinstall macos_clean macos_distclean macos_cleanall macos_info macos_makefiles macos
+endif
+ifdef TARGET_DIRS_DARWIN
+darwin_all:
+ $(MAKE) -C darwin all
+darwin_debug:
+ $(MAKE) -C darwin debug
+darwin_smart:
+ $(MAKE) -C darwin smart
+darwin_release:
+ $(MAKE) -C darwin release
+darwin_units:
+ $(MAKE) -C darwin units
+darwin_examples:
+ $(MAKE) -C darwin examples
+darwin_shared:
+ $(MAKE) -C darwin shared
+darwin_install:
+ $(MAKE) -C darwin install
+darwin_sourceinstall:
+ $(MAKE) -C darwin sourceinstall
+darwin_exampleinstall:
+ $(MAKE) -C darwin exampleinstall
+darwin_distinstall:
+ $(MAKE) -C darwin distinstall
+darwin_zipinstall:
+ $(MAKE) -C darwin zipinstall
+darwin_zipsourceinstall:
+ $(MAKE) -C darwin zipsourceinstall
+darwin_zipexampleinstall:
+ $(MAKE) -C darwin zipexampleinstall
+darwin_zipdistinstall:
+ $(MAKE) -C darwin zipdistinstall
+darwin_clean:
+ $(MAKE) -C darwin clean
+darwin_distclean:
+ $(MAKE) -C darwin distclean
+darwin_cleanall:
+ $(MAKE) -C darwin cleanall
+darwin_info:
+ $(MAKE) -C darwin info
+darwin_makefiles:
+ $(MAKE) -C darwin makefiles
+darwin:
+ $(MAKE) -C darwin all
+.PHONY: darwin_all darwin_debug darwin_smart darwin_release darwin_units darwin_examples darwin_shared darwin_install darwin_sourceinstall darwin_exampleinstall darwin_distinstall darwin_zipinstall darwin_zipsourceinstall darwin_zipexampleinstall darwin_zipdistinstall darwin_clean darwin_distclean darwin_cleanall darwin_info darwin_makefiles darwin
+endif
+ifdef TARGET_DIRS_MORPHOS
+morphos_all:
+ $(MAKE) -C morphos all
+morphos_debug:
+ $(MAKE) -C morphos debug
+morphos_smart:
+ $(MAKE) -C morphos smart
+morphos_release:
+ $(MAKE) -C morphos release
+morphos_units:
+ $(MAKE) -C morphos units
+morphos_examples:
+ $(MAKE) -C morphos examples
+morphos_shared:
+ $(MAKE) -C morphos shared
+morphos_install:
+ $(MAKE) -C morphos install
+morphos_sourceinstall:
+ $(MAKE) -C morphos sourceinstall
+morphos_exampleinstall:
+ $(MAKE) -C morphos exampleinstall
+morphos_distinstall:
+ $(MAKE) -C morphos distinstall
+morphos_zipinstall:
+ $(MAKE) -C morphos zipinstall
+morphos_zipsourceinstall:
+ $(MAKE) -C morphos zipsourceinstall
+morphos_zipexampleinstall:
+ $(MAKE) -C morphos zipexampleinstall
+morphos_zipdistinstall:
+ $(MAKE) -C morphos zipdistinstall
+morphos_clean:
+ $(MAKE) -C morphos clean
+morphos_distclean:
+ $(MAKE) -C morphos distclean
+morphos_cleanall:
+ $(MAKE) -C morphos cleanall
+morphos_info:
+ $(MAKE) -C morphos info
+morphos_makefiles:
+ $(MAKE) -C morphos makefiles
+morphos:
+ $(MAKE) -C morphos all
+.PHONY: morphos_all morphos_debug morphos_smart morphos_release morphos_units morphos_examples morphos_shared morphos_install morphos_sourceinstall morphos_exampleinstall morphos_distinstall morphos_zipinstall morphos_zipsourceinstall morphos_zipexampleinstall morphos_zipdistinstall morphos_clean morphos_distclean morphos_cleanall morphos_info morphos_makefiles morphos
+endif
+all: $(addsuffix _all,$(TARGET_DIRS))
+debug: $(addsuffix _debug,$(TARGET_DIRS))
+smart: $(addsuffix _smart,$(TARGET_DIRS))
+release: $(addsuffix _release,$(TARGET_DIRS))
+units: $(addsuffix _units,$(TARGET_DIRS))
+examples: $(addsuffix _examples,$(TARGET_DIRS))
+shared: $(addsuffix _shared,$(TARGET_DIRS))
+install: fpc_install $(addsuffix _install,$(TARGET_DIRS))
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall $(addsuffix _exampleinstall,$(TARGET_DIRS))
+distinstall: fpc_distinstall
+zipinstall: fpc_zipinstall
+zipsourceinstall: fpc_zipsourceinstall
+zipexampleinstall: fpc_zipexampleinstall $(addsuffix _zipexampleinstall,$(TARGET_DIRS))
+zipdistinstall: fpc_zipdistinstall
+clean: fpc_clean $(addsuffix _clean,$(TARGET_DIRS))
+distclean: fpc_distclean $(addsuffix _distclean,$(TARGET_DIRS))
+cleanall: fpc_cleanall $(addsuffix _cleanall,$(TARGET_DIRS))
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
diff --git a/rtl/Makefile.fpc b/rtl/Makefile.fpc
new file mode 100644
index 0000000000..a4da422daa
--- /dev/null
+++ b/rtl/Makefile.fpc
@@ -0,0 +1,31 @@
+#
+# Makefile.fpc for Free Pascal Runtime Library
+#
+
+[package]
+name=rtl
+version=2.0.0
+
+[target]
+dirs_linux=linux
+dirs_win32=win32
+dirs_go32v2=go32v2
+dirs_go32v1=go32v1
+dirs_os2=os2
+dirs_emx=emx
+dirs_freebsd=freebsd
+dirs_darwin=darwin
+dirs_beos=beos
+dirs_amiga=amiga
+dirs_netbsd=netbsd
+dirs_macos=macos
+dirs_morphos=morphos
+dirs_netware=netware
+dirs_netwlibc=netwlibc
+
+[install]
+fpcpackage=y
+createpackagefpc=y
+
+[default]
+fpcdir=..
diff --git a/rtl/README b/rtl/README
new file mode 100644
index 0000000000..969e75bdf9
--- /dev/null
+++ b/rtl/README
@@ -0,0 +1,34 @@
+This is the Run-Time Library (RTL) tree for Free Pascal.
+
+To recompile the RTL, edit the main makefile. The makefiles NEED a GNU make
+compatible make, they need unix-like 'rm' and 'mv' commands, as well as some
+others. You can find these in the gnuutils package on the ftp site.
+
+The main makefile is located ABOVE the RTL tree. It uses the FPC
+makefile.fpc to guess reasonable defaults for everything it needs.
+(these files can be found in base.zip on the FTP site)
+
+The only variable that you may want to set are
+FPC - What compiler to use. Use an absolute path.
+ (default is ppc386)
+INSTALL_UNITDIR - Where to install the RTL units
+OPT - any special options you want to set for the compiler.
+
+In principle, you can also descend into the subdirectory of your OS, and
+type 'make' there, that should also compile everything.
+
+The tree contains subdirectories for all the supported operating systems,
+as well as all processor architectures. The processor directories contain
+low-level routines which are required for the system unit (if they are not
+available in high-level language form), as well as optimized versions of
+the pascal generic routines (the generic routine source code is localed in
+the inc subdirectory).
+
+The following directories are not supported officially and may not work
+correctly with FreePascal v1.0:
+
+go32v1 - The DJGPP go32v1 DOS extender (no longer supported)
+palmos - The PalmOS directory for the Dragonball (incomplete)
+
+
+Enjoy.
diff --git a/rtl/amiga/Makefile b/rtl/amiga/Makefile
new file mode 100644
index 0000000000..9c265c7095
--- /dev/null
+++ b/rtl/amiga/Makefile
@@ -0,0 +1,1993 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=amiga
+override CPU_TARGET_DEFAULT=m68k
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+PPUEXT=ppa
+ASMEXT=.asm
+UNITPREFIX=rtl
+ifdef RELEASE
+ifeq ($(findstring 1.0.2,$(FPC_VERSION)),)
+ifeq ($(findstring 1.0.4,$(FPC_VERSION)),)
+override FPCOPT+=-Ur
+endif
+endif
+endif
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syslinux
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=system exec strings dos crt objects printer objpas macpas matrix heaptrc lineinfo getopts graph sysutils math typinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : prt0$(LOADEREXT)
+ -$(AS) prt0$(LOADEREXT) -o prt0$(OEXT)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSLINUXDEPS) $(SYSDEPS)
+ $(COMPILER) -ui386 -dm68k -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
+strings$(PPUEXT) : ../template/strings.pp system$(PPUEXT)
+ $(COMPILER) ../template/strings.pp $(REDIR)
+exec$(PPUEXT) : exec.pp exec.inc system$(PPUEXT)
+ $(COMPILER) exec $(REDIR)
+objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/objpas.pp .
+ $(COMPILER) objpas $(REDIR)
+ $(DEL) objpas.pp
+sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp objpas$(PPUEXT) system$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/sysutils.pp .
+ $(COMPILER) sysutils $(REDIR)
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+dos$(PPUEXT) : $(DOSDEPS) system$(PPUEXT)
+ $(COMPILER) dos $(REDIR)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc system$(PPUEXT)
+ $(COMPILER) crt $(REDIR)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
+ $(COMPILER) printer $(REDIR)
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/objects.pp $(REDIR)
+getopts$(PPUEXT) : $(INC)/getopts.pp strings$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(INC)/getopts.pp $(REDIR)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/heaptrc.pp $(REDIR)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/ctypes.pp $(REDIR)
diff --git a/rtl/amiga/Makefile.fpc b/rtl/amiga/Makefile.fpc
new file mode 100644
index 0000000000..eb99c4542e
--- /dev/null
+++ b/rtl/amiga/Makefile.fpc
@@ -0,0 +1,185 @@
+#
+# Makefile.fpc for Amiga RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0
+units=system exec strings \
+ dos crt objects printer \
+ objpas macpas matrix \
+ heaptrc lineinfo getopts graph \
+ sysutils math typinfo ctypes
+rsts=math
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=amiga
+cpu=m68k
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+PPUEXT=ppa
+ASMEXT=.asm
+
+UNITPREFIX=rtl
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+ifeq ($(findstring 1.0.2,$(FPC_VERSION)),)
+ifeq ($(findstring 1.0.4,$(FPC_VERSION)),)
+override FPCOPT+=-Ur
+endif
+endif
+endif
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syslinux
+endif
+
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : prt0$(LOADEREXT)
+ -$(AS) prt0$(LOADEREXT) -o prt0$(OEXT)
+
+#gprt0$(OEXT) : $(GLOADERAS)
+# -$(AS) $(GLOADERAS) -o gprt0$(OEXT)
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSLINUXDEPS) $(SYSDEPS)
+ $(COMPILER) -ui386 -dm68k -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
+
+strings$(PPUEXT) : ../template/strings.pp system$(PPUEXT)
+ $(COMPILER) ../template/strings.pp $(REDIR)
+
+exec$(PPUEXT) : exec.pp exec.inc system$(PPUEXT)
+ $(COMPILER) exec $(REDIR)
+
+#
+# Delphi Object Model
+#
+
+objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/objpas.pp .
+ $(COMPILER) objpas $(REDIR)
+ $(DEL) objpas.pp
+
+sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp objpas$(PPUEXT) system$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/sysutils.pp .
+ $(COMPILER) sysutils $(REDIR)
+#$(DEL) sysutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# System Dependent Units
+#
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(DOSDEPS) system$(PPUEXT)
+ $(COMPILER) dos $(REDIR)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc system$(PPUEXT)
+ $(COMPILER) crt $(REDIR)
+
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
+ $(COMPILER) printer $(REDIR)
+
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/objects.pp $(REDIR)
+
+#
+# Other RTL Units
+#
+
+getopts$(PPUEXT) : $(INC)/getopts.pp strings$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(INC)/getopts.pp $(REDIR)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/heaptrc.pp $(REDIR)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/ctypes.pp $(REDIR)
+
+#
+# $Log: Makefile.fpc,v $
+# Revision 1.11 2005/01/10 20:32:34 hajny
+# + ctypes added
+#
+# Revision 1.10 2004/10/30 12:36:48 peter
+# * units are now created in separate directory units/cpu-os/
+# * distclean uses cleanall rule and removes units dir
+# * cross compile support fixed, it is now possible to cycle a ppcsparc
+# without deleting ppc386
+# * bintutilsperfix defaults to cpu-os-
+#
+# Revision 1.9 2004/08/25 16:57:22 olle
+# * fix so that macpas.pp really is compiled
+#
+# Revision 1.8 2004/08/16 16:22:17 olle
+# + Added unit macpas
+#
+# Revision 1.7 2004/07/07 21:37:29 daniel
+# * Matrix unit included in build process
+#
+# Revision 1.6 2004/05/06 22:01:17 florian
+# * changed extensions
+#
+# Revision 1.5 2004/05/06 21:12:41 florian
+# * changed extensions
+#
+#
diff --git a/rtl/amiga/crt.pp b/rtl/amiga/crt.pp
new file mode 100644
index 0000000000..5f90c70cca
--- /dev/null
+++ b/rtl/amiga/crt.pp
@@ -0,0 +1,938 @@
+{
+ $Id: crt.pp,v 1.5 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Nils Sjoholm and Carl Eric Codere
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+unit Crt;
+
+{--------------------------------------------------------------------}
+{ LEFT TO DO: }
+{--------------------------------------------------------------------}
+{ o Write special characters are not recognized }
+{ o Write does not take care of window coordinates yet. }
+{ o Read does not recognize the special editing characters }
+{ o Read does not take care of window coordinates yet. }
+{ o Readkey extended scancode is not correct yet }
+{ o Color mapping only works for 4 colours }
+{ o ClrScr, DeleteLine, InsLine do not work with window coordinates }
+{--------------------------------------------------------------------}
+
+
+
+Interface
+
+Const
+{ Controlling consts }
+ Flushing=false; {if true then don't buffer output}
+ ScreenWidth = 80;
+ ScreenHeight = 25;
+
+{$i crth.inc}
+
+Implementation
+
+{
+ The definitions of TextRec and FileRec are in separate files.
+}
+{$i textrec.inc}
+{$i filerec.inc}
+
+var
+ maxcols,maxrows : longint;
+
+CONST
+ { This is used to make sure that readkey returns immediately }
+ { if keypressed was used beforehand. }
+ KeyPress : char = #0;
+ _LVODisplayBeep = -96;
+
+
+Type
+
+ pInfoData = ^tInfoData;
+ tInfoData = packed record
+ id_NumSoftErrors : Longint; { number of soft errors on disk }
+ id_UnitNumber : Longint; { Which unit disk is (was) mounted on }
+ id_DiskState : Longint; { See defines below }
+ id_NumBlocks : Longint; { Number of blocks on disk }
+ id_NumBlocksUsed : Longint; { Number of block in use }
+ id_BytesPerBlock : Longint;
+ id_DiskType : Longint; { Disk Type code }
+ id_VolumeNode : Longint; { BCPL pointer to volume node }
+ id_InUse : Longint; { Flag, zero if not in use }
+ end;
+
+{ * List Node Structure. Each member in a list starts with a Node * }
+
+ pNode = ^tNode;
+ tNode = packed Record
+ ln_Succ, { * Pointer to next (successor) * }
+ ln_Pred : pNode; { * Pointer to previous (predecessor) * }
+ ln_Type : Byte;
+ ln_Pri : Shortint; { * Priority, for sorting * }
+ ln_Name : PChar; { * ID string, null terminated * }
+ End; { * Note: Integer aligned * }
+
+{ normal, full featured list }
+
+ pList = ^tList;
+ tList = packed record
+ lh_Head : pNode;
+ lh_Tail : pNode;
+ lh_TailPred : pNode;
+ lh_Type : Byte;
+ l_pad : Byte;
+ end;
+
+ pMsgPort = ^tMsgPort;
+ tMsgPort = packed record
+ mp_Node : tNode;
+ mp_Flags : Byte;
+ mp_SigBit : Byte; { signal bit number }
+ mp_SigTask : Pointer; { task to be signalled (TaskPtr) }
+ mp_MsgList : tList; { message linked list }
+ end;
+
+ pMessage = ^tMessage;
+ tMessage = packed record
+ mn_Node : tNode;
+ mn_ReplyPort : pMsgPort; { message reply port }
+ mn_Length : Word; { message len in bytes }
+ end;
+
+ pIOStdReq = ^tIOStdReq;
+ tIOStdReq = packed record
+ io_Message : tMessage;
+ io_Device : Pointer; { device node pointer }
+ io_Unit : Pointer; { unit (driver private)}
+ io_Command : Word; { device command }
+ io_Flags : Byte;
+ io_Error : Shortint; { error or warning num }
+ io_Actual : Longint; { actual number of bytes transferred }
+ io_Length : Longint; { requested number bytes transferred}
+ io_Data : Pointer; { points to data area }
+ io_Offset : Longint; { offset for block structured devices }
+ end;
+
+ pIntuiMessage = ^tIntuiMessage;
+ tIntuiMessage = packed record
+ ExecMessage : tMessage;
+ IClass : Longint;
+ Code : Word;
+ Qualifier : Word;
+ IAddress : Pointer;
+ MouseX,
+ MouseY : Word;
+ Seconds,
+ Micros : Longint;
+ IDCMPWindow : Pointer;
+ SpecialLink : pIntuiMessage;
+ end;
+
+ pWindow = ^tWindow;
+ tWindow = packed record
+ NextWindow : pWindow; { for the linked list in a screen }
+ LeftEdge,
+ TopEdge : Integer; { screen dimensions of window }
+ Width,
+ Height : Integer; { screen dimensions of window }
+ MouseY,
+ MouseX : Integer; { relative to upper-left of window }
+ MinWidth,
+ MinHeight : Integer; { minimum sizes }
+ MaxWidth,
+ MaxHeight : Word; { maximum sizes }
+ Flags : Longint; { see below for defines }
+ MenuStrip : Pointer; { the strip of Menu headers }
+ Title : PChar; { the title text for this window }
+ FirstRequest : Pointer; { all active Requesters }
+ DMRequest : Pointer; { double-click Requester }
+ ReqCount : Integer; { count of reqs blocking Window }
+ WScreen : Pointer; { this Window's Screen }
+ RPort : Pointer; { this Window's very own RastPort }
+ BorderLeft,
+ BorderTop,
+ BorderRight,
+ BorderBottom : Shortint;
+ BorderRPort : Pointer;
+ FirstGadget : Pointer;
+ Parent,
+ Descendant : pWindow;
+ Pointer_ : Pointer; { sprite data }
+ PtrHeight : Shortint; { sprite height (not including sprite padding) }
+ PtrWidth : Shortint; { sprite width (must be less than or equal to 16) }
+ XOffset,
+ YOffset : Shortint; { sprite offsets }
+ IDCMPFlags : Longint; { User-selected flags }
+ UserPort,
+ WindowPort : pMsgPort;
+ MessageKey : pIntuiMessage;
+ DetailPen,
+ BlockPen : Byte; { for bar/border/gadget rendering }
+ CheckMark : Pointer;
+ ScreenTitle : PChar; { if non-null, Screen title when Window is active }
+ GZZMouseX : Integer;
+ GZZMouseY : Integer;
+ GZZWidth : Integer;
+ GZZHeight : Word;
+ ExtData : Pointer;
+ UserData : Pointer; { general-purpose pointer to User data extension }
+ WLayer : Pointer;
+ IFont : Pointer;
+ MoreFlags : Longint;
+ end;
+
+ const
+
+ M_LNM = 20; { linefeed newline mode }
+ PMB_ASM = M_LNM + 1; { internal storage bit for AS flag }
+ PMB_AWM = PMB_ASM + 1; { internal storage bit for AW flag }
+ MAXTABS = 80;
+ IECLASS_MAX = $15;
+
+type
+
+ pKeyMap = ^tKeyMap;
+ tKeyMap = packed record
+ km_LoKeyMapTypes : Pointer;
+ km_LoKeyMap : Pointer;
+ km_LoCapsable : Pointer;
+ km_LoRepeatable : Pointer;
+ km_HiKeyMapTypes : Pointer;
+ km_HiKeyMap : Pointer;
+ km_HiCapsable : Pointer;
+ km_HiRepeatable : Pointer;
+ end;
+
+
+
+ pConUnit = ^tConUnit;
+ tConUnit = packed record
+ cu_MP : tMsgPort;
+ { ---- read only variables }
+ cu_Window : Pointer; { (WindowPtr) intuition window bound to this unit }
+ cu_XCP : Integer; { character position }
+ cu_YCP : Integer;
+ cu_XMax : Integer; { max character position }
+ cu_YMax : Integer;
+ cu_XRSize : Integer; { character raster size }
+ cu_YRSize : Integer;
+ cu_XROrigin : Integer; { raster origin }
+ cu_YROrigin : Integer;
+ cu_XRExtant : Integer; { raster maxima }
+ cu_YRExtant : Integer;
+ cu_XMinShrink : Integer; { smallest area intact from resize process }
+ cu_YMinShrink : Integer;
+ cu_XCCP : Integer; { cursor position }
+ cu_YCCP : Integer;
+
+ { ---- read/write variables (writes must must be protected) }
+ { ---- storage for AskKeyMap and SetKeyMap }
+
+ cu_KeyMapStruct : tKeyMap;
+
+ { ---- tab stops }
+
+ cu_TabStops : Array [0..MAXTABS-1] of Word;
+ { 0 at start, -1 at end of list }
+
+ { ---- console rastport attributes }
+
+ cu_Mask : Shortint;
+ cu_FgPen : Shortint;
+ cu_BgPen : Shortint;
+ cu_AOLPen : Shortint;
+ cu_DrawMode : Shortint;
+ cu_AreaPtSz : Shortint;
+ cu_AreaPtrn : Pointer; { cursor area pattern }
+ cu_Minterms : Array [0..7] of Byte; { console minterms }
+ cu_Font : Pointer; { (TextFontPtr) }
+ cu_AlgoStyle : Byte;
+ cu_TxFlags : Byte;
+ cu_TxHeight : Word;
+ cu_TxWidth : Word;
+ cu_TxBaseline : Word;
+ cu_TxSpacing : Word;
+
+ { ---- console MODES and RAW EVENTS switches }
+
+ cu_Modes : Array [0..(PMB_AWM+7) div 8 - 1] of Byte;
+ { one bit per mode }
+ cu_RawEvents : Array [0..(IECLASS_MAX+7) div 8 - 1] of Byte;
+ end;
+
+const
+
+
+ CD_CURRX = 1;
+ CD_CURRY = 2;
+ CD_MAXX = 3;
+ CD_MAXY = 4;
+
+ CSI = chr($9b);
+
+ SIGBREAKF_CTRL_C = 4096;
+
+function AllocVec( size, reqm : Longint ): Pointer;
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L size,d0
+ MOVE.L reqm,d1
+ MOVE.L _ExecBase, A6
+ JSR -684(A6)
+ MOVE.L (A7)+,A6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+
+function DoPkt(ID : pMsgPort;
+ Action, Param1, Param2,
+ Param3, Param4, Param5 : Longint) : Longint;
+begin
+ asm
+ MOVEM.L d2/d3/d4/d5/d6/d7/a6,-(A7)
+ MOVE.L ID,d1
+ MOVE.L Action,d2
+ MOVE.L Param1,d3
+ MOVE.L Param2,d4
+ MOVE.L Param3,d5
+ MOVE.L Param4,d6
+ MOVE.L Param5,d7
+ MOVE.L _DOSBase,A6
+ JSR -240(A6)
+ MOVEM.L (A7)+,d2/d3/d4/d5/d6/d7/a6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+procedure FreeVec( memory : Pointer );
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L memory,a1
+ MOVE.L _ExecBase,A6
+ JSR -690(A6)
+ MOVE.L (A7)+,A6
+ end;
+end;
+
+
+function GetConsoleTask : pMsgPort;
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L _DOSBase,A6
+ JSR -510(A6)
+ MOVE.L (A7)+,A6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+
+function GetMsg(port : pMsgPort): pMessage;
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L port,a0
+ MOVE.L _ExecBase,A6
+ JSR -372(A6)
+ MOVE.L (A7)+,A6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+function ModifyIDCMP(window : pWindow;
+ IDCMPFlags : Longint) : Boolean;
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L window,a0
+ MOVE.L IDCMPFlags,d0
+ MOVE.L _IntuitionBase,A6
+ JSR -150(A6)
+ MOVE.L (A7)+,A6
+ TST.L d0
+ bne @success
+ bra @end
+ @success:
+ move.b #1,d0
+ @end:
+ move.b d0,@RESULT
+ end;
+end;
+
+procedure ReplyMsg(mess : pMessage);
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L mess,a1
+ MOVE.L _ExecBase,A6
+ JSR -378(A6)
+ MOVE.L (A7)+,A6
+ end;
+end;
+
+
+function WaitPort(port : pMsgPort): pMessage;
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L port,a0
+ MOVE.L _ExecBase,A6
+ JSR -384(A6)
+ MOVE.L (A7)+,A6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+procedure Delay_(ticks : Longint);
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L ticks,d1
+ MOVE.L _DOSBase,A6
+ JSR -198(A6)
+ MOVE.L (A7)+,A6
+ end;
+end;
+
+function SetSignal(newSignals, signalMask : Longint) : Longint;
+begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L newSignals,d0
+ MOVE.L signalMask,d1
+ MOVE.L _ExecBase,A6
+ JSR -306(A6)
+ MOVE.L (A7)+,A6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+function OpenInfo : pInfoData;
+var
+ port : pMsgPort;
+ info : pInfoData;
+ bptr, d4, d5, d6, d7 : Longint;
+begin
+ info := pInfoData(AllocVec(SizeOf(tInfoData), 1));
+
+ if info <> nil then begin
+ port := GetConsoleTask;
+ bptr := Longint(info) shr 2;
+
+ if port <> nil then begin
+ if DoPkt(port, $19, bptr, d4, d5, d6, d7) <> 0 then info := pInfoData(bptr shl 2)
+ else port := nil;
+ end;
+
+ if port = nil then begin
+ FreeVec(info);
+ info := nil;
+ end;
+ end;
+
+ OpenInfo := info;
+end;
+
+procedure CloseInfo(var info : pInfoData);
+begin
+ if info <> nil then begin
+ FreeVec(info);
+ info := nil;
+ end;
+end;
+
+function ConData(modus : byte) : integer;
+var
+ info : pInfoData;
+ theunit : pConUnit;
+ pos : Longint;
+begin
+ pos := 1;
+ info := OpenInfo;
+
+ if info <> nil then begin
+ theunit := pConUnit((pIoStdReq(info^.id_InUse))^.io_Unit);
+
+ case modus of
+ CD_CURRX : pos := theunit^.cu_XCP;
+ CD_CURRY : pos := theunit^.cu_YCP;
+ CD_MAXX : pos := theunit^.cu_XMax;
+ CD_MAXY : pos := theunit^.cu_YMax;
+ end;
+
+ CloseInfo(info);
+ end;
+
+ ConData := pos + 1;
+end;
+
+function WhereX : Byte;
+begin
+ WhereX := Byte(ConData(CD_CURRX))-lo(windmin);
+end;
+
+function realx: byte;
+begin
+ RealX := Byte(ConData(CD_CURRX));
+end;
+
+function realy: byte;
+begin
+ RealY := Byte(ConData(CD_CURRY));
+end;
+
+function WhereY : Byte;
+begin
+ WhereY := Byte(ConData(CD_CURRY))-hi(windmin);
+end;
+
+function screencols : integer;
+begin
+ screencols := ConData(CD_MAXX);
+end;
+
+function screenrows : integer;
+begin
+ screenrows := ConData(CD_MAXY);
+end;
+
+
+ procedure Realgotoxy(x,y : integer);
+ begin
+ Write(CSI, y, ';', x, 'H');
+ end;
+
+
+ procedure gotoxy(x,y : byte);
+ begin
+ if (x<1) then
+ x:=1;
+ if (y<1) then
+ y:=1;
+ if y+hi(windmin)-2>=hi(windmax) then
+ y:=hi(windmax)-hi(windmin)+1;
+ if x+lo(windmin)-2>=lo(windmax) then
+ x:=lo(windmax)-lo(windmin)+1;
+ Write(CSI, y+hi(windmin), ';', x+lo(windmin), 'H');
+ end;
+
+
+procedure CursorOff;
+begin
+ Write(CSI,'0 p');
+end;
+
+procedure CursorOn;
+begin
+ Write(CSI,'1 p');
+end;
+
+procedure ClrScr;
+begin
+ Write(Chr($0c));
+end;
+
+function ReadKey : char;
+const
+ IDCMP_VANILLAKEY = $00200000;
+ IDCMP_RAWKEY = $00000400;
+var
+ info : pInfoData;
+ win : pWindow;
+ imsg : pIntuiMessage;
+ msg : pMessage;
+ key : char;
+ idcmp, vanil : Longint;
+begin
+ key := #0;
+ if KeyPress <> #0 then
+ Begin
+ ReadKey:=KeyPress;
+ KeyPress:=#0;
+ exit;
+ end;
+ info := OpenInfo;
+
+ if info <> nil then begin
+ win := pWindow(pConUnit((pIoStdReq(info^.id_InUse))^.io_Unit)^.cu_Window);
+ idcmp := win^.IDCMPFlags;
+ vanil := IDCMP_VANILLAKEY or IDCMP_RAWKEY;
+
+ ModifyIDCMP(win, (idcmp or vanil));
+
+ repeat
+ msg := WaitPort(win^.UserPort);
+ imsg := pIntuiMessage(GetMsg(win^.UserPort));
+
+ if (imsg^.IClass = IDCMP_VANILLAKEY) then
+ key := char(imsg^.Code)
+ else
+ if (imsg^.IClass = IDCMP_RAWKEY) then
+ key := char(imsg^.Code);
+
+ ReplyMsg(pMessage(imsg));
+ until key <> #0;
+
+ repeat
+ msg := GetMsg(win^.UserPort);
+
+ if msg <> nil then ReplyMsg(msg);
+ until msg = nil;
+
+ ModifyIDCMP(win, idcmp);
+
+ CloseInfo(info);
+ end;
+
+ ReadKey := key;
+end;
+
+function KeyPressed : Boolean;
+const
+ IDCMP_VANILLAKEY = $00200000;
+ IDCMP_RAWKEY = $00000400;
+var
+ info : pInfoData;
+ win : pWindow;
+ imsg : pIntuiMessage;
+ msg : pMessage;
+ idcmp, vanil : Longint;
+ ispressed : Boolean;
+begin
+ KeyPress := #0;
+ ispressed := False;
+ info := OpenInfo;
+
+ if info <> nil then begin
+ win := pWindow(pConUnit((pIoStdReq(info^.id_InUse))^.io_Unit)^.cu_Window);
+ idcmp := win^.IDCMPFlags;
+ vanil := IDCMP_VANILLAKEY or IDCMP_RAWKEY;
+
+ ModifyIDCMP(win, (idcmp or vanil));
+
+ msg := WaitPort(win^.UserPort);
+ imsg := pIntuiMessage(GetMsg(win^.UserPort));
+
+ if (imsg^.IClass = IDCMP_VANILLAKEY) or (imsg^.IClass = IDCMP_RAWKEY) then
+ Begin
+ ispressed := true;
+ KeyPress := char(imsg^.Code)
+ end;
+
+ ReplyMsg(pMessage(imsg));
+
+ repeat
+ msg := GetMsg(win^.UserPort);
+
+ if msg <> nil then ReplyMsg(msg);
+ until msg = nil;
+
+ ModifyIDCMP(win, idcmp);
+
+ CloseInfo(info);
+ end;
+
+ KeyPressed := ispressed;
+end;
+
+procedure TextColor(color : byte);
+begin
+ TextAttr := (TextAttr and $70) or color;
+ Write(CSI, '3', color, 'm');
+end;
+
+procedure TextBackground(color : byte);
+begin
+ Textattr:=(textattr and $8f) or ((color and $7) shl 4);
+ Write(CSI, '4', color, 'm');
+end;
+
+procedure Window(X1,Y1,X2,Y2: Byte);
+ begin
+ if (x1<1) or (x2>screencols) or (y2>screenrows) or
+ (x1>x2) or (y1>y2) then
+ exit;
+ windmin:=(x1-1) or ((y1-1) shl 8);
+ windmax:=(x2-1) or ((y2-1) shl 8);
+ gotoxy(1,1);
+ end;
+
+
+
+
+
+procedure DelLine;
+begin
+ Write(CSI,'X');
+end;
+
+procedure ClrEol;
+begin
+ Write(CSI,'K');
+end;
+
+procedure InsLine;
+begin
+ Write(CSI,'1 L');
+end;
+
+procedure cursorbig;
+begin
+end;
+
+procedure lowvideo;
+begin
+end;
+
+procedure highvideo;
+begin
+end;
+
+procedure nosound;
+begin
+end;
+
+procedure sound(hz : word);
+begin
+end;
+
+procedure delay(DTime : Word);
+var
+ dummy : Longint;
+begin
+ dummy := trunc((real(DTime) / 1000.0) * 50.0);
+ Delay_(dummy);
+end;
+
+function CheckBreak : boolean;
+begin
+ if (SetSignal(0, 0) and SIGBREAKF_CTRL_C) = SIGBREAKF_CTRL_C then
+ CheckBreak := true
+ else
+ CheckBreak := false;
+end;
+
+procedure textmode(mode : integer);
+begin
+ lastmode:=mode;
+ mode:=mode and $ff;
+ windmin:=0;
+ windmax:=(screencols-1) or ((screenrows-1) shl 8);
+ maxcols:=screencols;
+ maxrows:=screenrows;
+end;
+
+procedure normvideo;
+begin
+end;
+
+function GetTextBackground : byte;
+var
+ info : pInfoData;
+ pen : byte;
+begin
+ pen := 1;
+ info := OpenInfo;
+
+ if info <> nil then begin
+ pen := pConUnit((pIoStdReq(info^.id_InUse))^.io_Unit)^.cu_BgPen;
+
+ CloseInfo(info);
+ end;
+
+ GetTextBackground := pen;
+end;
+
+function GetTextColor : byte;
+var
+ info : pInfoData;
+ pen : byte;
+begin
+ pen := 1;
+ info := OpenInfo;
+
+ if info <> nil then begin
+ pen := pConUnit((pIoStdReq(info^.id_InUse))^.io_Unit)^.cu_FgPen;
+
+ CloseInfo(info);
+ end;
+
+ GetTextColor := pen;
+end;
+
+
+{*****************************************************************************
+ Read and Write routines
+*****************************************************************************}
+{ Problem here: Currently all these routines are not implemented because of how }
+{ the console device works. Because w low level write is required to change the }
+{ position of the cursor, and since the CrtWrite is assigned as the standard }
+{ write routine, a recursive call will occur }
+
+{ How to fix this: }
+{ At startup make a copy of the Output handle, and then use this copy to make }
+{ low level positioning calls. This does not seem to work yet. }
+
+
+
+ Function CrtWrite(var f : textrec):integer;
+
+ var
+ i,col,row : longint;
+ c : char;
+ buf: array[0..1] of char;
+
+ begin
+ col:=realx;
+ row:=realy;
+ inc(row);
+ inc(col);
+ for i:=0 to f.bufpos-1 do
+ begin
+ c:=f.buffer[i];
+ case ord(c) of
+ 10 : begin
+ inc(row);
+ end;
+ 13 : begin
+ col:=lo(windmin)+1;
+ end;
+ 8 : if col>lo(windmin)+1 then
+ begin
+ dec(col);
+ end;
+ 7 : begin
+ { beep }
+ asm
+ move.l a6,d6 { save base pointer }
+ move.l _IntuitionBase,a6 { set library base }
+ sub.l a0,a0
+ jsr _LVODisplayBeep(a6)
+ move.l d6,a6 { restore base pointer }
+ end;
+ end;
+ else
+ begin
+ buf[0]:=c;
+ realgotoxy(row,col);
+ do_write(f.handle,longint(@buf[0]),1);
+ inc(col);
+ end;
+ end;
+ if col>lo(windmax)+1 then
+ begin
+ col:=lo(windmin)+1;
+ inc(row);
+ end;
+ while row>hi(windmax)+1 do
+ begin
+ delline;
+ dec(row);
+ end;
+ end;
+ f.bufpos:=0;
+ realgotoxy(row-1,col-1);
+ CrtWrite:=0;
+ end;
+
+ Function CrtClose(Var F: TextRec): Integer;
+ Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+ End;
+
+ Function CrtOpen(Var F: TextRec): Integer;
+ Begin
+ If F.Mode = fmOutput Then
+ CrtOpen:=0
+ Else
+ CrtOpen:=5;
+ End;
+
+ Function CrtRead(Var F: TextRec): Integer;
+ Begin
+ f.bufend:=do_read(f.handle,longint(f.bufptr),f.bufsize);
+ f.bufpos:=0;
+ CrtRead:=0;
+ End;
+
+ Function CrtInOut(Var F: TextRec): Integer;
+ Begin
+ Case F.Mode of
+ fmInput: CrtInOut:=CrtRead(F);
+ fmOutput: CrtInOut:=CrtWrite(F);
+ End;
+ End;
+
+ procedure assigncrt(var f : text);
+ begin
+ { TextRec(F).Mode:=fmClosed;
+ TextRec(F).BufSize:=SizeOf(TextBuf);
+ TextRec(F).BufPtr:=@TextRec(F).Buffer;
+ TextRec(F).BufPos:=0;
+ TextRec(F).OpenFunc:=@CrtOpen;
+ TextRec(F).InOutFunc:=@CrtInOut;
+ TextRec(F).FlushFunc:=@CrtInOut;
+ TextRec(F).CloseFunc:=@CrtClose;
+ TextRec(F).Name[0]:='.';
+ TextRec(F).Name[1]:=#0;}
+ end;
+
+
+var
+ old_exit : pointer;
+
+procedure crt_exit;
+begin
+ { Restore default colors }
+ write(CSI,'0m');
+ exitproc:=old_exit;
+end;
+
+
+Begin
+ old_exit:=exitproc;
+ exitproc:=@crt_exit;
+ { load system variables to temporary variables to save time }
+ maxcols:=screencols;
+ maxrows:=screenrows;
+ { Set the initial text attributes }
+ { Text background }
+ Textattr:=(textattr and $8f) or ((GetTextBackGround and $7) shl 4);
+ { Text foreground }
+ TextAttr := (TextAttr and $70) or GetTextColor;
+ { set output window }
+ windmax:=(maxcols-1) or (( maxrows-1) shl 8);
+
+
+ { Get a copy of the standard }
+ { output handle, and when using }
+ { direct console calls, use this }
+ { handle instead. }
+{ assigncrt(Output);
+ TextRec(Output).mode:=fmOutput;}
+end.
+
+
+
+
+
+ $Log: crt.pp,v $
+ Revision 1.5 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/amiga/dos.pp b/rtl/amiga/dos.pp
new file mode 100644
index 0000000000..52e9db89f5
--- /dev/null
+++ b/rtl/amiga/dos.pp
@@ -0,0 +1,1488 @@
+{
+ $Id: dos.pp,v 1.10 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1998-2001 by Nils Sjoholm and Carl Eric Codere
+ members of the Free Pascal development team
+ Date conversion routine taken from SWAG
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Unit Dos;
+
+
+{--------------------------------------------------------------------}
+{ LEFT TO DO: }
+{--------------------------------------------------------------------}
+{ o DiskFree / Disksize don't work as expected }
+{ o Implement SetDate and SetTime }
+{ o Implement EnvCount,EnvStr }
+{ o FindFirst should only work with correct attributes }
+{--------------------------------------------------------------------}
+
+
+
+
+Interface
+
+{$I os.inc}
+
+type
+ SearchRec = Packed Record
+ { watch out this is correctly aligned for all processors }
+ { don't modify. }
+ { Replacement for Fill }
+{0} AnchorPtr : Pointer; { Pointer to the Anchorpath structure }
+{4} Fill: Array[1..15] of Byte; {future use}
+ {End of replacement for fill}
+ Attr : BYTE; {attribute of found file}
+ Time : LongInt; {last modify date of found file}
+ Size : LongInt; {file size of found file}
+ Name : String[255]; {name of found file}
+ End;
+
+{$i dosh.inc}
+
+implementation
+
+{$DEFINE HAS_GETCBREAK}
+{$DEFINE HAS_SETCBREAK}
+
+{$DEFINE FPC_FEXPAND_VOLUMES} (* Full paths begin with drive specification *)
+{$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+
+{$I dos.inc}
+
+const
+ DaysPerMonth : Array[1..12] of ShortInt =
+(031,028,031,030,031,030,031,031,030,031,030,031);
+ DaysPerYear : Array[1..12] of Integer =
+(031,059,090,120,151,181,212,243,273,304,334,365);
+ DaysPerLeapYear : Array[1..12] of Integer =
+(031,060,091,121,152,182,213,244,274,305,335,366);
+ SecsPerYear : LongInt = 31536000;
+ SecsPerLeapYear : LongInt = 31622400;
+ SecsPerDay : LongInt = 86400;
+ SecsPerHour : Integer = 3600;
+ SecsPerMinute : ShortInt = 60;
+ TICKSPERSECOND = 50;
+
+
+
+Type
+ pClockData = ^tClockData;
+ tClockData = packed Record
+ sec : Word;
+ min : Word;
+ hour : Word;
+ mday : Word;
+ month : Word;
+ year : Word;
+ wday : Word;
+ END;
+
+ BPTR = Longint;
+ BSTR = Longint;
+
+ pMinNode = ^tMinNode;
+ tMinNode = Packed Record
+ mln_Succ,
+ mln_Pred : pMinNode;
+ End;
+
+
+ pMinList = ^tMinList;
+ tMinList = Packed record
+ mlh_Head : pMinNode;
+ mlh_Tail : pMinNode;
+ mlh_TailPred : pMinNode;
+ end;
+{ * List Node Structure. Each member in a list starts with a Node * }
+
+ pNode = ^tNode;
+ tNode = Packed Record
+ ln_Succ, { * Pointer to next (successor) * }
+ ln_Pred : pNode; { * Pointer to previous (predecessor) * }
+ ln_Type : Byte;
+ ln_Pri : Shortint; { * Priority, for sorting * }
+ ln_Name : PCHAR; { * ID string, null terminated * }
+ End; { * Note: Integer aligned * }
+
+
+
+ pList = ^tList;
+ tList = Packed record
+ lh_Head : pNode;
+ lh_Tail : pNode;
+ lh_TailPred : pNode;
+ lh_Type : Byte;
+ l_pad : Byte;
+ end;
+
+
+ pMsgPort = ^tMsgPort;
+ tMsgPort = Packed record
+ mp_Node : tNode;
+ mp_Flags : Byte;
+ mp_SigBit : Byte; { signal bit number }
+ mp_SigTask : Pointer; { task to be signalled (TaskPtr) }
+ mp_MsgList : tList; { message linked list }
+ end;
+
+
+ pTask = ^tTask;
+ tTask = Packed record
+ tc_Node : tNode;
+ tc_Flags : Byte;
+ tc_State : Byte;
+ tc_IDNestCnt : Shortint; { intr disabled nesting }
+ tc_TDNestCnt : Shortint; { task disabled nesting }
+ tc_SigAlloc : longint; { sigs allocated }
+ tc_SigWait : longint; { sigs we are waiting for }
+ tc_SigRecvd : longint; { sigs we have received }
+ tc_SigExcept : longint; { sigs we will take excepts for }
+ tc_TrapAlloc : Word; { traps allocated }
+ tc_TrapAble : Word; { traps enabled }
+ tc_ExceptData : Pointer; { points to except data }
+ tc_ExceptCode : Pointer; { points to except code }
+ tc_TrapData : Pointer; { points to trap data }
+ tc_TrapCode : Pointer; { points to trap code }
+ tc_SPReg : Pointer; { stack pointer }
+ tc_SPLower : Pointer; { stack lower bound }
+ tc_SPUpper : Pointer; { stack upper bound + 2 }
+ tc_Switch : Pointer; { task losing CPU }
+ tc_Launch : Pointer; { task getting CPU }
+ tc_MemEntry : tList; { allocated memory }
+ tc_UserData : Pointer; { per task data }
+ end;
+
+
+
+ TDateStamp = packed record
+ ds_Days : Longint; { Number of days since Jan. 1, 1978 }
+ ds_Minute : Longint; { Number of minutes past midnight }
+ ds_Tick : Longint; { Number of ticks past minute }
+ end;
+ PDateStamp = ^TDateStamp;
+
+
+
+{ Returned by Examine() and ExInfo(), must be on a 4 byte boundary }
+
+ PFileInfoBlock = ^TfileInfoBlock;
+ TFileInfoBlock = packed record
+ fib_DiskKey : Longint;
+ fib_DirEntryType : Longint;
+ { Type of Directory. If < 0, then a plain file.
+ If > 0 a directory }
+ fib_FileName : Array [0..107] of Char;
+ { Null terminated. Max 30 chars used for now }
+ fib_Protection : Longint;
+ { bit mask of protection, rwxd are 3-0. }
+ fib_EntryType : Longint;
+ fib_Size : Longint; { Number of bytes in file }
+ fib_NumBlocks : Longint; { Number of blocks in file }
+ fib_Date : TDateStamp; { Date file last changed }
+ fib_Comment : Array [0..79] of Char;
+ { Null terminated comment associated with file }
+ fib_Reserved : Array [0..35] of Char;
+ end;
+
+{ returned by Info(), must be on a 4 byte boundary }
+
+ pInfoData = ^tInfoData;
+ tInfoData = packed record
+ id_NumSoftErrors : Longint; { number of soft errors on disk }
+ id_UnitNumber : Longint; { Which unit disk is (was) mounted on }
+ id_DiskState : Longint; { See defines below }
+ id_NumBlocks : Longint; { Number of blocks on disk }
+ id_NumBlocksUsed : Longint; { Number of block in use }
+ id_BytesPerBlock : Longint;
+ id_DiskType : Longint; { Disk Type code }
+ id_VolumeNode : BPTR; { BCPL pointer to volume node }
+ id_InUse : Longint; { Flag, zero if not in use }
+ end;
+
+
+{ ------ Library Base Structure ---------------------------------- }
+{ Also used for Devices and some Resources }
+
+ pLibrary = ^tLibrary;
+ tLibrary = packed record
+ lib_Node : tNode;
+ lib_Flags,
+ lib_pad : Byte;
+ lib_NegSize, { number of bytes before library }
+ lib_PosSize, { number of bytes after library }
+ lib_Version, { major }
+ lib_Revision : Word; { minor }
+ lib_IdString : PCHAR; { ASCII identification }
+ lib_Sum : LONGINT; { the checksum itself }
+ lib_OpenCnt : Word; { number of current opens }
+ end; { * Warning: size is not a longword multiple ! * }
+
+ PChain = ^TChain;
+ TChain = packed record
+ an_Child : PChain;
+ an_Parent: PChain;
+ an_Lock : BPTR;
+ an_info : TFileInfoBlock;
+ an_Flags : shortint;
+ an_string: Array[0..0] of char;
+ end;
+
+
+ PAnchorPath = ^TAnchorPath;
+ TAnchorPath = packed record
+ ap_Base : PChain; {* pointer to first anchor *}
+ ap_First : PChain; {* pointer to last anchor *}
+ ap_BreakBits : LONGINT; {* Bits we want to break on *}
+ ap_FondBreak : LONGINT; {* Bits we broke on. Also returns ERROR_BREAK *}
+ ap_Flags : shortint; {* New use for extra word. *}
+ ap_reserved : BYTE;
+ ap_StrLen : WORD;
+ ap_Info : TFileInfoBlock;
+ ap_Buf : Array[0..0] of Char; {* Buffer for path name, allocated by user *}
+ END;
+
+ pCommandLineInterface = ^TCommandLineInterface;
+ TCommandLineInterface = packed record
+ cli_result2 : longint; {* Value of IoErr from last command *}
+ cli_SetName : BSTR; {* Name of current directory *}
+ cli_CommandDir : BPTR; {* Head of the path locklist *}
+ cli_ReturnCode : longint; {* Return code from last command *}
+ cli_CommandName : BSTR; {* Name of current command *}
+ cli_FailLevel : longint; {* Fail level (set by FAILAT) *}
+ cli_Prompt : BSTR; {* Current prompt (set by PROMPT) *}
+ cli_StandardInput: BPTR; {* Default (terminal) CLI input *}
+ cli_CurrentInput : BPTR; {* Current CLI input *}
+ cli_CommandFile : BSTR; {* Name of EXECUTE command file *}
+ cli_Interactive : longint; {* Boolean; True if prompts required *}
+ cli_Background : longint; {* Boolean; True if CLI created by RUN*}
+ cli_CurrentOutput: BPTR; {* Current CLI output *}
+ cli_DefautlStack : longint; {* Stack size to be obtained in long words *}
+ cli_StandardOutput : BPTR; {* Default (terminal) CLI output *}
+ cli_Module : BPTR; {* SegList of currently loaded command*}
+ END;
+
+ pDosList = ^tDosList;
+ tDosList = packed record
+ dol_Next : BPTR; { bptr to next device on list }
+ dol_Type : Longint; { see DLT below }
+ dol_Task : Pointer; { ptr to handler task }
+ dol_Lock : BPTR;
+ dol_Misc : Array[0..23] of Shortint;
+ dol_Name : BSTR; { bptr to bcpl name }
+ END;
+
+ TProcess = packed record
+ pr_Task : TTask;
+ pr_MsgPort : TMsgPort; { This is BPTR address from DOS functions }
+{126} pr_Pad : Word; { Remaining variables on 4 byte boundaries }
+{128} pr_SegList : Pointer; { Array of seg lists used by this process }
+{132} pr_StackSize : Longint; { Size of process stack in bytes }
+{136} pr_GlobVec : Pointer; { Global vector for this process (BCPL) }
+{140} pr_TaskNum : Longint; { CLI task number of zero if not a CLI }
+{144} pr_StackBase : BPTR; { Ptr to high memory end of process stack }
+{148} pr_Result2 : Longint; { Value of secondary result from last call }
+{152} pr_CurrentDir : BPTR; { Lock associated with current directory }
+{156} pr_CIS : BPTR; { Current CLI Input Stream }
+{160} pr_COS : BPTR; { Current CLI Output Stream }
+{164} pr_ConsoleTask : Pointer; { Console handler process for current window}
+{168} pr_FileSystemTask : Pointer; { File handler process for current drive }
+{172} pr_CLI : BPTR; { pointer to ConsoleLineInterpreter }
+ pr_ReturnAddr : Pointer; { pointer to previous stack frame }
+ pr_PktWait : Pointer; { Function to be called when awaiting msg }
+ pr_WindowPtr : Pointer; { Window for error printing }
+ { following definitions are new with 2.0 }
+ pr_HomeDir : BPTR; { Home directory of executing program }
+ pr_Flags : Longint; { flags telling dos about process }
+ pr_ExitCode : Pointer; { code to call on exit of program OR NULL }
+ pr_ExitData : Longint; { Passed as an argument to pr_ExitCode. }
+ pr_Arguments : PChar; { Arguments passed to the process at start }
+ pr_LocalVars : TMinList; { Local environment variables }
+ pr_ShellPrivate : Longint; { for the use of the current shell }
+ pr_CES : BPTR; { Error stream - IF NULL, use pr_COS }
+ end;
+ PProcess = ^TProcess;
+
+
+CONST
+ { DOS Lib Offsets }
+ _LVOMatchFirst = -822;
+ _LVOMatchNext = -828;
+ _LVOMatchEnd = -834;
+ _LVOCli = -492;
+ _LVOExecute = -222;
+ _LVOSystemTagList = -606;
+ _LVOSetFileDate = -396;
+
+ LDF_READ = 1;
+ LDF_DEVICES = 4;
+
+ ERROR_NO_MORE_ENTRIES = 232;
+ FIBF_SCRIPT = 64; { program is a script }
+ FIBF_PURE = 32; { program is reentrant }
+ FIBF_ARCHIVE = 16; { cleared whenever file is changed }
+ FIBF_READ = 8; { ignoed by old filesystem }
+ FIBF_WRITE = 4; { ignored by old filesystem }
+ FIBF_EXECUTE = 2; { ignored by system, used by shell }
+ FIBF_DELETE = 1; { prevent file from being deleted }
+
+ SHARED_LOCK = -2;
+
+{******************************************************************************
+ --- Internal routines ---
+******************************************************************************}
+
+
+procedure CurrentTime(var Seconds, Micros : Longint);
+Begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L Seconds,a0
+ MOVE.L Micros,a1
+ MOVE.L _IntuitionBase,A6
+ JSR -084(A6)
+ MOVE.L (A7)+,A6
+ end;
+end;
+
+
+function Date2Amiga(date : pClockData) : Longint;
+Begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L date,a0
+ MOVE.L _UtilityBase,A6
+ JSR -126(A6)
+ MOVE.L (A7)+,A6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+
+procedure Amiga2Date(amigatime : Longint;
+ resultat : pClockData);
+Begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L amigatime,d0
+ MOVE.L resultat,a0
+ MOVE.L _UtilityBase,A6
+ JSR -120(A6)
+ MOVE.L (A7)+,A6
+ end;
+end;
+
+FUNCTION Examine(lock : BPTR; fileInfoBlock : pFileInfoBlock) : BOOLEAN;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L lock,D1
+ MOVE.L fileInfoBlock,D2
+ MOVEA.L _DOSBase,A6
+ JSR -102(A6)
+ MOVEA.L (A7)+,A6
+ TST.L D0
+ BEQ.B @end
+ MOVE.B #1,D0
+ @end: MOVE.B D0,@RESULT
+ END;
+END;
+
+function Lock(const name : string;
+ accessmode : Longint) : BPTR;
+var
+ buffer: Array[0..255] of char;
+Begin
+ move(name[1],buffer,length(name));
+ buffer[length(name)]:=#0;
+ asm
+ MOVEM.L d2/a6,-(A7)
+ LEA buffer,a0
+ MOVE.L a0,d1
+ MOVE.L accessmode,d2
+ MOVE.L _DOSBase,A6
+ JSR -084(A6)
+ MOVEM.L (A7)+,d2/a6
+ MOVE.L d0,@RESULT
+ end;
+end;
+
+
+procedure UnLock(lock : BPTR);
+Begin
+ asm
+ MOVE.L A6,-(A7)
+ MOVE.L lock,d1
+ MOVE.L _DOSBase,A6
+ JSR -090(A6)
+ MOVE.L (A7)+,A6
+ end;
+end;
+
+FUNCTION Info(lock : BPTR; parameterBlock : pInfoData) : BOOLEAN;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L lock,D1
+ MOVE.L parameterBlock,D2
+ MOVEA.L _DOSBase,A6
+ JSR -114(A6)
+ MOVEA.L (A7)+,A6
+ TST.L D0
+ BEQ.B @end
+ MOVE.B #1,D0
+ @end:
+ MOVE.B D0,@RESULT
+ END;
+END;
+
+FUNCTION NameFromLock(lock : BPTR; buffer : pCHAR; len : LONGINT) : BOOLEAN;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L lock,D1
+ MOVE.L buffer,D2
+ MOVE.L len,D3
+ MOVEA.L _DOSBase,A6
+ JSR -402(A6)
+ MOVEA.L (A7)+,A6
+ TST.L D0
+ BEQ.B @end
+ MOVE.B #1,D0
+ @end: MOVE.B D0,@RESULT
+ END;
+END;
+
+FUNCTION GetVar(name : pCHAR; buffer : pCHAR; size : LONGINT; flags : LONGINT) : LONGINT;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L name,D1
+ MOVE.L buffer,D2
+ MOVE.L size,D3
+ MOVE.L flags,D4
+ MOVEA.L _DOSBase,A6
+ JSR -906(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+FUNCTION FindTask(name : pCHAR) : pTask;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVEA.L name,A1
+ MOVEA.L _ExecBase,A6
+ JSR -294(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+FUNCTION MatchFirst(pat : pCHAR; anchor : pAnchorPath) : LONGINT;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L pat,D1
+ MOVE.L anchor,D2
+ MOVEA.L _DOSBase,A6
+ JSR -822(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+FUNCTION MatchNext(anchor : pAnchorPath) : LONGINT;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L anchor,D1
+ MOVEA.L _DOSBase,A6
+ JSR -828(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+PROCEDURE MatchEnd(anchor : pAnchorPath);
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L anchor,D1
+ MOVEA.L _DOSBase,A6
+ JSR -834(A6)
+ MOVEA.L (A7)+,A6
+ END;
+END;
+
+FUNCTION Cli : pCommandLineInterface;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVEA.L _DOSBase,A6
+ JSR -492(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+Function _Execute(p: pchar): longint;
+ Begin
+ asm
+ move.l a6,d6 { save base pointer }
+ move.l d2,-(sp)
+ move.l p,d1 { command to execute }
+ clr.l d2 { No TagList for command }
+ move.l _DosBase,a6
+ jsr _LVOSystemTagList(a6)
+ move.l (sp)+,d2
+ move.l d6,a6 { restore base pointer }
+ move.l d0,@RESULT
+ end;
+end;
+
+FUNCTION LockDosList(flags : longint) : pDosList;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L flags,D1
+ MOVEA.L _DOSBase,A6
+ JSR -654(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+
+PROCEDURE UnLockDosList(flags : longint);
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L flags,D1
+ MOVEA.L _DOSBase,A6
+ JSR -660(A6)
+ MOVEA.L (A7)+,A6
+ END;
+END;
+
+
+FUNCTION NextDosEntry(dlist : pDosList; flags : longint) : pDosList;
+BEGIN
+ ASM
+ MOVE.L A6,-(A7)
+ MOVE.L dlist,D1
+ MOVE.L flags,D2
+ MOVEA.L _DOSBase,A6
+ JSR -690(A6)
+ MOVEA.L (A7)+,A6
+ MOVE.L D0,@RESULT
+ END;
+END;
+
+
+FUNCTION BADDR(bval : BPTR): POINTER;
+BEGIN
+ BADDR := POINTER( bval shl 2);
+END;
+
+function PasToC(var s: string): Pchar;
+var i: integer;
+begin
+ i := Length(s) + 1;
+ if i > 255 then
+ begin
+ Delete(s, 255, 1); { ensure there is a spare byte }
+ Dec(i)
+ end;
+ s[i] := #0;
+ PasToC := @s[1]
+end;
+
+
+Function SetProtection(const name: string; mask:longint): longint;
+ var
+ buffer : array[0..255] of char;
+ Begin
+ move(name[1],buffer,length(name));
+ buffer[length(name)]:=#0;
+ asm
+ move.l a6,d6
+ lea buffer,a0
+ move.l a0,d1
+ move.l mask,d2
+ move.l _DosBase,a6
+ jsr -186(a6)
+ move.l d6,a6
+ move.l d0,@RESULT
+ end;
+ end;
+
+
+Function IsLeapYear(Source : Word) : Boolean;
+Begin
+ If (Source mod 400 = 0) or ((Source mod 4 = 0) and (Source mod 100 <> 0))
+ Then
+ IsLeapYear := True
+ Else
+ IsLeapYear := False;
+End;
+
+
+Procedure Amiga2DateStamp(Date : LongInt; Var TotalDays,Minutes,Ticks: longint);
+{ Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
+{ Taken from SWAG and modified to work with the Amiga format - CEC }
+Var
+ LocalDate : LongInt; Done : Boolean; X : ShortInt; TotDays : Integer;
+ Y: Word;
+ M: Word;
+ D: Word;
+ H: Word;
+ Min: Word;
+ S : Word;
+Begin
+ Y := 1978; M := 1; D := 1; H := 0; Min := 0; S := 0;
+ TotalDays := 0;
+ Minutes := 0;
+ Ticks := 0;
+ LocalDate := Date;
+ Done := False;
+ While Not Done Do
+ Begin
+ If LocalDate >= SecsPerYear Then
+ Begin
+ Inc(Y,1);
+ Dec(LocalDate,SecsPerYear);
+ Inc(TotalDays,DaysPerYear[12]);
+ End
+ Else
+ Done := True;
+ If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) And
+ (Not Done) Then
+ Begin
+ Inc(Y,1);
+ Dec(LocalDate,SecsPerLeapYear);
+ Inc(TotalDays,DaysPerLeapYear[12]);
+ End;
+ End; { END WHILE }
+ M := 1; D := 1;
+ Done := False;
+ TotDays := LocalDate Div SecsPerDay;
+ { Total number of days }
+ TotalDays := TotalDays + TotDays;
+ Dec(LocalDate,TotDays*SecsPerDay);
+ { Absolute hours since start of day }
+ H := LocalDate Div SecsPerHour;
+ { Convert to minutes }
+ Minutes := H*60;
+ Dec(LocalDate,(H * SecsPerHour));
+ { Find the remaining minutes to add }
+ Min := LocalDate Div SecsPerMinute;
+ Dec(LocalDate,(Min * SecsPerMinute));
+ Minutes:=Minutes+Min;
+ { Find the number of seconds and convert to ticks }
+ S := LocalDate;
+ Ticks:=TICKSPERSECOND*S;
+End;
+
+
+ Function SetFileDate(name: string; p : pDateStamp): longint;
+ var
+ buffer : array[0..255] of char;
+ Begin
+ move(name[1],buffer,length(name));
+ buffer[length(name)]:=#0;
+ asm
+ move.l a6,d6 { save base pointer }
+ move.l d2,-(sp) { save reserved reg }
+ lea buffer,a0
+ move.l a0,d1
+ move.l p,d2
+ move.l _DosBase,a6
+ jsr _LVOSetFileDate(a6)
+ move.l (sp)+,d2 { restore reserved reg }
+ move.l d6,a6 { restore base pointer }
+ move.l d0,@Result
+ end;
+ end;
+
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+ Function DosVersion: Word;
+ var p: pLibrary;
+ Begin
+ p:=pLibrary(_DosBase);
+ DosVersion:= p^.lib_Version or (p^.lib_Revision shl 8);
+ End;
+
+Procedure GetDate(Var Year, Month, MDay, WDay: Word);
+Var
+ cd : pClockData;
+ mysec,
+ tick : Longint;
+begin
+ New(cd);
+ CurrentTime(mysec,tick);
+ Amiga2Date(mysec,cd);
+ Year := cd^.year;
+ Month := cd^.month;
+ MDay := cd^.mday;
+ WDay := cd^.wday;
+ Dispose(cd);
+end;
+
+Procedure SetDate(Year, Month, Day: Word);
+ Begin
+ { !! }
+ End;
+
+Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
+Var
+ mysec,
+ tick : Longint;
+ cd : pClockData;
+begin
+ New(cd);
+ CurrentTime(mysec,tick);
+ Amiga2Date(mysec,cd);
+ Hour := cd^.hour;
+ Minute := cd^.min;
+ Second := cd^.sec;
+ Sec100 := 0;
+ Dispose(cd);
+END;
+
+
+Procedure SetTime(Hour, Minute, Second, Sec100: Word);
+ Begin
+ { !! }
+ End;
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+ var
+ p : string;
+ buf: array[0..255] of char;
+ result : longint;
+ MyLock : longint;
+ i : Integer;
+ Begin
+ DosError := 0;
+ LastdosExitCode := 0;
+ p:=Path+' '+ComLine;
+ { allow backslash as slash }
+ for i:=1 to length(p) do
+ if p[i]='\' then p[i]:='/';
+ Move(p[1],buf,length(p));
+ buf[Length(p)]:=#0;
+ { Here we must first check if the command we wish to execute }
+ { actually exists, because this is NOT handled by the }
+ { _SystemTagList call (program will abort!!) }
+
+ { Try to open with shared lock }
+ MyLock:=Lock(path,SHARED_LOCK);
+ if MyLock <> 0 then
+ Begin
+ { File exists - therefore unlock it }
+ Unlock(MyLock);
+ result:=_Execute(buf);
+ { on return of -1 the shell could not be executed }
+ { probably because there was not enough memory }
+ if result = -1 then
+ DosError:=8
+ else
+ LastDosExitCode:=word(result);
+ end
+ else
+ DosError:=3;
+ End;
+
+
+ Procedure GetCBreak(Var BreakValue: Boolean);
+ Begin
+ breakvalue := system.BreakOn;
+ End;
+
+
+ Procedure SetCBreak(BreakValue: Boolean);
+ Begin
+ system.Breakon := BreakValue;
+ End;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+{ How to solve the problem with this: }
+{ We could walk through the device list }
+{ at startup to determine possible devices }
+
+const
+
+ not_to_use_devs : array[0..12] of string =(
+ 'DF0:',
+ 'DF1:',
+ 'DF2:',
+ 'DF3:',
+ 'PED:',
+ 'PRJ:',
+ 'PIPE:',
+ 'RAM:',
+ 'CON:',
+ 'RAW:',
+ 'SER:',
+ 'PAR:',
+ 'PRT:');
+
+var
+ deviceids : array[1..20] of byte;
+ devicenames : array[1..20] of string[20];
+ numberofdevices : Byte;
+
+Function DiskFree(Drive: Byte): Longint;
+Var
+ MyLock : BPTR;
+ Inf : pInfoData;
+ Free : Longint;
+ myproc : pProcess;
+ OldWinPtr : Pointer;
+Begin
+ Free := -1;
+ { Here we stop systemrequesters to appear }
+ myproc := pProcess(FindTask(nil));
+ OldWinPtr := myproc^.pr_WindowPtr;
+ myproc^.pr_WindowPtr := Pointer(-1);
+ { End of systemrequesterstop }
+ New(Inf);
+ MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
+ If MyLock <> 0 then begin
+ if Info(MyLock,Inf) then begin
+ Free := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock) -
+ (Inf^.id_NumBlocksUsed * Inf^.id_BytesPerBlock);
+ end;
+ Unlock(MyLock);
+ end;
+ Dispose(Inf);
+ { Restore systemrequesters }
+ myproc^.pr_WindowPtr := OldWinPtr;
+ diskfree := Free;
+end;
+
+
+
+Function DiskSize(Drive: Byte): Longint;
+Var
+ MyLock : BPTR;
+ Inf : pInfoData;
+ Size : Longint;
+ myproc : pProcess;
+ OldWinPtr : Pointer;
+Begin
+ Size := -1;
+ { Here we stop systemrequesters to appear }
+ myproc := pProcess(FindTask(nil));
+ OldWinPtr := myproc^.pr_WindowPtr;
+ myproc^.pr_WindowPtr := Pointer(-1);
+ { End of systemrequesterstop }
+ New(Inf);
+ MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
+ If MyLock <> 0 then begin
+ if Info(MyLock,Inf) then begin
+ Size := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock);
+ end;
+ Unlock(MyLock);
+ end;
+ Dispose(Inf);
+ { Restore systemrequesters }
+ myproc^.pr_WindowPtr := OldWinPtr;
+ disksize := Size;
+end;
+
+
+
+
+Procedure FindFirst(Path: PathStr; Attr: Word; Var f: SearchRec);
+var
+ buf: Array[0..255] of char;
+ Anchor : pAnchorPath;
+ Result : Longint;
+ index : Integer;
+ s : string;
+ j : integer;
+Begin
+ DosError:=0;
+ New(Anchor);
+ {----- allow backslash as slash -----}
+ for index:=1 to length(path) do
+ if path[index]='\' then path[index]:='/';
+ { remove any dot characters and replace by their current }
+ { directory equivalent. }
+ if pos('../',path) = 1 then
+ { look for parent directory }
+ Begin
+ delete(path,1,3);
+ getdir(0,s);
+ j:=length(s);
+ while (s[j] <> '/') AND (s[j] <> ':') AND (j > 0 ) do
+ dec(j);
+ if j > 0 then
+ s:=copy(s,1,j);
+ path:=s+path;
+ end
+ else
+ if pos('./',path) = 1 then
+ { look for current directory }
+ Begin
+ delete(path,1,2);
+ getdir(0,s);
+ if (s[length(s)] <> '/') and (s[length(s)] <> ':') then
+ s:=s+'/';
+ path:=s+path;
+ end;
+ {----- replace * by #? AmigaOs strings -----}
+ repeat
+ index:= pos('*',Path);
+ if index <> 0 then
+ Begin
+ delete(Path,index,1);
+ insert('#?',Path,index);
+ end;
+ until index =0;
+ {--------------------------------------------}
+ FillChar(Anchor^,sizeof(TAnchorPath),#0);
+ move(path[1],buf,length(path));
+ buf[length(path)]:=#0;
+
+ Result:=MatchFirst(@buf,Anchor);
+ f.AnchorPtr:=Anchor;
+ if Result = ERROR_NO_MORE_ENTRIES then
+ DosError:=18
+ else
+ if Result <> 0 then
+ DosError:=3;
+ { If there is an error, deallocate }
+ { the anchorpath structure }
+ if DosError <> 0 then
+ Begin
+ MatchEnd(Anchor);
+ if assigned(Anchor) then
+ Dispose(Anchor);
+ end
+ else
+ {-------------------------------------------------------------------}
+ { Here we fill up the SearchRec attribute, but we also do check }
+ { something else, if the it does not match the mask we are looking }
+ { for we should go to the next file or directory. }
+ {-------------------------------------------------------------------}
+ Begin
+ with Anchor^.ap_Info do
+ Begin
+ f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
+ fib_Date.ds_Minute * 60 +
+ fib_Date.ds_Tick div 50;
+ {*------------------------------------*}
+ {* Determine if is a file or a folder *}
+ {*------------------------------------*}
+ if fib_DirEntryType > 0 then
+ f.attr:=f.attr OR DIRECTORY;
+
+ {*------------------------------------*}
+ {* Determine if Read only *}
+ {* Readonly if R flag on and W flag *}
+ {* off. *}
+ {* Should we check also that EXEC *}
+ {* is zero? for read only? *}
+ {*------------------------------------*}
+ if ((fib_Protection and FIBF_READ) <> 0)
+ AND ((fib_Protection and FIBF_WRITE) = 0)
+ then
+ f.attr:=f.attr or READONLY;
+ f.Name := strpas(fib_FileName);
+ f.Size := fib_Size;
+ end; { end with }
+ end;
+End;
+
+
+Procedure FindNext(Var f: SearchRec);
+var
+ Result: longint;
+ Anchor : pAnchorPath;
+Begin
+ DosError:=0;
+ Result:=MatchNext(f.AnchorPtr);
+ if Result = ERROR_NO_MORE_ENTRIES then
+ DosError:=18
+ else
+ if Result <> 0 then
+ DosError:=3;
+ { If there is an error, deallocate }
+ { the anchorpath structure }
+ if DosError <> 0 then
+ Begin
+ MatchEnd(f.AnchorPtr);
+ if assigned(f.AnchorPtr) then
+ {Dispose}FreeMem(f.AnchorPtr);
+ end
+ else
+ { Fill up the Searchrec information }
+ { and also check if the files are with }
+ { the correct attributes }
+ Begin
+ Anchor:=pAnchorPath(f.AnchorPtr);
+ with Anchor^.ap_Info do
+ Begin
+ f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
+ fib_Date.ds_Minute * 60 +
+ fib_Date.ds_Tick div 50;
+ {*------------------------------------*}
+ {* Determine if is a file or a folder *}
+ {*------------------------------------*}
+ if fib_DirEntryType > 0 then
+ f.attr:=f.attr OR DIRECTORY;
+
+ {*------------------------------------*}
+ {* Determine if Read only *}
+ {* Readonly if R flag on and W flag *}
+ {* off. *}
+ {* Should we check also that EXEC *}
+ {* is zero? for read only? *}
+ {*------------------------------------*}
+ if ((fib_Protection and FIBF_READ) <> 0)
+ AND ((fib_Protection and FIBF_WRITE) = 0)
+ then
+ f.attr:=f.attr or READONLY;
+ f.Name := strpas(fib_FileName);
+ f.Size := fib_Size;
+ end; { end with }
+ end;
+End;
+
+ Procedure FindClose(Var f: SearchRec);
+ begin
+ end;
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+(*
+Function FExpand(Path: PathStr): PathStr;
+var
+ FLock : BPTR;
+ buffer : array[0..255] of char;
+ i :integer;
+ j :integer;
+ temp : string;
+begin
+
+ { allow backslash as slash }
+ for i:=1 to length(path) do
+ if path[i]='\' then path[i]:='/';
+
+ temp:=path;
+ if pos('../',temp) = 1 then
+ delete(temp,1,3);
+ if pos('./',temp) = 1 then
+ delete(temp,1,2);
+ {First remove all references to '/./'}
+ while pos('/./',temp)<>0 do
+ delete(temp,pos('/./',temp),3);
+ {Now remove also all references to '/../' + of course previous dirs..}
+ repeat
+ i:=pos('/../',temp);
+ {Find the pos of the previous dir}
+ if i>1 then
+ begin
+ j:=i-1;
+ while (j>1) and (temp[j]<>'/') do
+ dec (j);{temp[1] is always '/'}
+ delete(temp,j,i-j+4);
+ end
+ else
+ if i=1 then {i=1, so we have temp='/../something', just delete '/../'}
+ delete(temp,1,4);
+ until i=0;
+
+
+ FLock := Lock(temp,-2);
+ if FLock <> 0 then begin
+ if NameFromLock(FLock,buffer,255) then begin
+ Unlock(FLock);
+ FExpand := strpas(buffer);
+ end else begin
+ Unlock(FLock);
+ FExpand := '';
+ end;
+ end else FExpand := '';
+end;
+*)
+
+
+ Function fsearch(path : pathstr;dirlist : string) : pathstr;
+ var
+ i,p1 : longint;
+ s : searchrec;
+ newdir : pathstr;
+ begin
+ { No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow slash as backslash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='\' then dirlist[i]:='/';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
+ newdir:=newdir+'/';
+ findfirst(newdir+path,anyfile,s);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
+ end;
+ end;
+
+
+Procedure getftime (var f; var time : longint);
+{
+ This function returns a file's date and time as the number of
+ seconds after January 1, 1978 that the file was created.
+}
+var
+ FInfo : pFileInfoBlock;
+ FTime : Longint;
+ FLock : Longint;
+ Str : String;
+ i : integer;
+begin
+ DosError:=0;
+ FTime := 0;
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+ FLock := Lock(Str, SHARED_LOCK);
+ IF FLock <> 0 then begin
+ New(FInfo);
+ if Examine(FLock, FInfo) then begin
+ with FInfo^.fib_Date do
+ FTime := ds_Days * (24 * 60 * 60) +
+ ds_Minute * 60 +
+ ds_Tick div 50;
+ end else begin
+ FTime := 0;
+ end;
+ Unlock(FLock);
+ Dispose(FInfo);
+ end
+ else
+ DosError:=6;
+ time := FTime;
+end;
+
+
+ Procedure setftime(var f; time : longint);
+ var
+ DateStamp: pDateStamp;
+ Str: String;
+ i: Integer;
+ Days, Minutes,Ticks: longint;
+ FLock: longint;
+ Begin
+ new(DateStamp);
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+ { Check first of all, if file exists }
+ FLock := Lock(Str, SHARED_LOCK);
+ IF FLock <> 0 then
+ begin
+ Unlock(FLock);
+ Amiga2DateStamp(time,Days,Minutes,ticks);
+ DateStamp^.ds_Days:=Days;
+ DateStamp^.ds_Minute:=Minutes;
+ DateStamp^.ds_Tick:=Ticks;
+ if SetFileDate(Str,DateStamp) <> 0 then
+ DosError:=0
+ else
+ DosError:=6;
+ end
+ else
+ DosError:=2;
+ if assigned(DateStamp) then Dispose(DateStamp);
+ End;
+
+ Procedure getfattr(var f; var attr : word);
+ var
+ info : pFileInfoBlock;
+ MyLock : Longint;
+ flags: word;
+ Str: String;
+ i: integer;
+ Begin
+ DosError:=0;
+ flags:=0;
+ New(info);
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+ { open with shared lock to check if file exists }
+ MyLock:=Lock(Str,SHARED_LOCK);
+ if MyLock <> 0 then
+ Begin
+ Examine(MyLock,info);
+ {*------------------------------------*}
+ {* Determine if is a file or a folder *}
+ {*------------------------------------*}
+ if info^.fib_DirEntryType > 0 then
+ flags:=flags OR DIRECTORY;
+
+ {*------------------------------------*}
+ {* Determine if Read only *}
+ {* Readonly if R flag on and W flag *}
+ {* off. *}
+ {* Should we check also that EXEC *}
+ {* is zero? for read only? *}
+ {*------------------------------------*}
+ if ((info^.fib_Protection and FIBF_READ) <> 0)
+ AND ((info^.fib_Protection and FIBF_WRITE) = 0)
+ then
+ flags:=flags OR ReadOnly;
+ Unlock(mylock);
+ end
+ else
+ DosError:=3;
+ attr:=flags;
+ Dispose(info);
+ End;
+
+
+Procedure setfattr (var f;attr : word);
+ var
+ flags: longint;
+ MyLock : longint;
+ str: string;
+ i: integer;
+ Begin
+ DosError:=0;
+ flags:=FIBF_WRITE;
+ { open with shared lock }
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+
+ MyLock:=Lock(Str,SHARED_LOCK);
+
+ { By default files are read-write }
+ if attr AND ReadOnly <> 0 then
+ { Clear the Fibf_write flags }
+ flags:=FIBF_READ;
+
+
+ if MyLock <> 0 then
+ Begin
+ Unlock(MyLock);
+ if SetProtection(Str,flags) = 0 then
+ DosError:=5;
+ end
+ else
+ DosError:=3;
+ End;
+
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+var
+StrofPaths : string[255];
+
+function getpathstring: string;
+var
+ f : text;
+ s : string;
+ found : boolean;
+ temp : string[255];
+begin
+ found := true;
+ temp := '';
+ assign(f,'ram:makepathstr');
+ rewrite(f);
+ writeln(f,'path >ram:temp.lst');
+ close(f);
+ exec('c:protect','ram:makepathstr sarwed');
+ exec('C:execute','ram:makepathstr');
+ exec('c:delete','ram:makepathstr quiet');
+ assign(f,'ram:temp.lst');
+ reset(f);
+ { skip the first line, garbage }
+ if not eof(f) then readln(f,s);
+ while not eof(f) do begin
+ readln(f,s);
+ if found then begin
+ temp := s;
+ found := false;
+ end else begin;
+ if (length(s) + length(temp)) < 255 then
+ temp := temp + ';' + s;
+ end;
+ end;
+ close(f);
+ exec('C:delete','ram:temp.lst quiet');
+ getpathstring := temp;
+end;
+
+
+ Function EnvCount: Longint;
+ { HOW TO GET THIS VALUE: }
+ { Each time this function is called, we look at the }
+ { local variables in the Process structure (2.0+) }
+ { And we also read all files in the ENV: directory }
+ Begin
+ End;
+
+
+ Function EnvStr(Index: longint): String;
+ Begin
+ EnvStr:='';
+ End;
+
+
+
+function GetEnv(envvar : String): String;
+var
+ bufarr : array[0..255] of char;
+ strbuffer : array[0..255] of char;
+ temp : Longint;
+begin
+ if UpCase(envvar) = 'PATH' then begin
+ if StrOfpaths = '' then StrOfPaths := GetPathString;
+ GetEnv := StrofPaths;
+ end else begin
+ move(envvar,strbuffer,length(envvar));
+ strbuffer[length(envvar)] := #0;
+ temp := GetVar(strbuffer,bufarr,255,$100);
+ if temp = -1 then
+ GetEnv := ''
+ else GetEnv := StrPas(bufarr);
+ end;
+end;
+
+
+procedure AddDevice(str : String);
+begin
+ inc(numberofdevices);
+ deviceids[numberofdevices] := numberofdevices;
+ devicenames[numberofdevices] := str;
+end;
+
+function MakeDeviceName(str : pchar): string;
+var
+ temp : string[20];
+begin
+ temp := strpas(str);
+ temp := temp + ':';
+ MakeDeviceName := temp;
+end;
+
+function IsInDeviceList(str : string): boolean;
+var
+ i : byte;
+ theresult : boolean;
+begin
+ theresult := false;
+ for i := low(not_to_use_devs) to high(not_to_use_devs) do
+ begin
+ if str = not_to_use_devs[i] then begin
+ theresult := true;
+ break;
+ end;
+ end;
+ IsInDeviceList := theresult;
+end;
+
+
+function BSTR2STRING(s : BSTR): pchar;
+begin
+ BSTR2STRING := Pointer(Longint(BADDR(s))+1);
+end;
+
+procedure ReadInDevices;
+var
+ dl : pDosList;
+ temp : pchar;
+ str : string[20];
+begin
+ dl := LockDosList(LDF_DEVICES or LDF_READ );
+ repeat
+ dl := NextDosEntry(dl,LDF_DEVICES );
+ if dl <> nil then begin
+ temp := BSTR2STRING(dl^.dol_Name);
+ str := MakeDeviceName(temp);
+ if not IsInDeviceList(str) then
+ AddDevice(str);
+ end;
+ until dl = nil;
+ UnLockDosList(LDF_DEVICES or LDF_READ );
+end;
+
+Begin
+ DosError:=0;
+ numberofdevices := 0;
+ StrOfPaths := '';
+ AddDevice('DF0:');
+ AddDevice('DF1:');
+ AddDevice('DF2:');
+ AddDevice('DF3:');
+ ReadInDevices;
+End.
+
+{
+ $Log: dos.pp,v $
+ Revision 1.10 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
+
+
+
+
+
+
+
+
+
diff --git a/rtl/amiga/graph.pp b/rtl/amiga/graph.pp
new file mode 100644
index 0000000000..8262256a7c
--- /dev/null
+++ b/rtl/amiga/graph.pp
@@ -0,0 +1,797 @@
+unit Graph;
+
+{ *********************************************************************
+
+ Info:
+
+ This units mimics some parts of borland's graph unit for
+ Amiga.
+
+ You have to use crt for readln, readkey and stuff like
+ that for your programs. When the show is over you should
+ just press a key or hit return to close everything down.
+
+ If that doesn't work just flip the screens with left-Amiga n
+ and activate the shell you started from.
+
+ I have compiled and run mandel.pp without any problems.
+
+ This version requires Free Pascal 0.99.5c or higher.
+
+ It will also use some amigaunits, when the unit gets
+ better we can remove those units.
+
+ Large parts have not yet been implemented or tested.
+
+ nils.sjoholm@mailbox.swipnet.se (Nils Sjoholm)
+
+ History:
+
+ Date Version Who Comments
+ ---------- -------- ------- -------------------------------------
+ 27-Nov-98 0.1 nsjoholm Initial version.
+
+ License Conditions:
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free
+ Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+ *********************************************************************}
+
+
+interface
+
+uses Exec, Intuition, Graphics, Utility;
+
+{ ---------------------------------------------------------------------
+ Constants
+
+ ---------------------------------------------------------------------}
+
+const
+ NormalPut = 0;
+ CopyPut = 0;
+ XORPut = 1;
+ ORPut = 2;
+ ANDPut = 3;
+ NotPut = 4;
+ BackPut = 8;
+
+ Black = 0;
+ Blue = 1;
+ Green = 2;
+ Cyan = 3;
+ Red = 4;
+ Magenta = 5;
+ Brown = 6;
+ LightGray = 7;
+ DarkGray = 8;
+ LightBlue = 9;
+ LightGreen = 10;
+ LightCyan = 11;
+ LightRed = 12;
+ LightMagenta = 13;
+ Yellow = 14;
+ White = 15;
+ Border = 16;
+
+ SolidLn = 0;
+ DottedLn = 1;
+ CenterLn = 2;
+ DashedLn = 3;
+ UserBitLn = 4;
+
+ EmptyFill = 0;
+ SolidFill = 1;
+ LineFill = 2;
+ LtSlashFill = 3;
+ SlashFill = 4;
+ BkSlashFill = 5;
+ LtBkSlashFill = 6;
+ HatchFill = 7;
+ XHatchFill = 8;
+ InterleaveFill = 9;
+ WideDotFill = 10;
+ CloseDotFill = 11;
+ UserFill = 12;
+
+ NormWidth = 1;
+ ThickWidth = 3;
+
+const
+ LeftText = 0;
+ CenterText = 1;
+ RightText = 2;
+ BottomText = 0;
+ TopText = 2;
+ BaseLine = 3;
+ LeadLine = 4;
+
+const
+ { Error codes }
+ grOK = 0;
+ grNoInitGraph = -1;
+ grNotDetected = -2;
+ grFileNotFound = -3;
+ grInvalidDriver = -4;
+ grNoLOadMem = -5;
+ grNoScanMem = -6;
+ grNoFloodMem = -7;
+ grFontNotFound = -8;
+ grNoFontMem = -9;
+ grInvalidmode = -10;
+ grError = -11;
+ grIOerror = -12;
+ grInvalidFont = -13;
+ grInvalidFontNum = -14;
+
+Type
+ FillPatternType = array[1..8] of byte;
+
+ ArcCoordsType = record
+ x,y : integer;
+ xstart,ystart : integer;
+ xend,yend : integer;
+ end;
+
+ RGBColor = record
+ r,g,b,i : byte;
+ end;
+
+
+ PaletteType = record
+ Size : integer;
+ Colors : array[0..767]of Byte;
+ end;
+
+
+ LineSettingsType = record
+ linestyle : word;
+ pattern : word;
+ thickness : word;
+ end;
+
+ TextSettingsType = record
+ font : word;
+ direction : word;
+ charsize : word;
+ horiz : word;
+ vert : word;
+ end;
+
+ FillSettingsType = record
+ pattern : word;
+ color : longint;
+ end;
+
+ PointType = record
+ x,y : integer;
+ end;
+
+ ViewPortType = record
+ x1,y1,x2,y2 : integer;
+ Clip : boolean;
+ end;
+
+ const
+ fillpattern : array[0..12] of FillPatternType = (
+ ($00,$00,$00,$00,$00,$00,$00,$00), { Hintergrundfarbe }
+ ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { Vordergrundfarbe }
+ ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { === }
+ ($01,$02,$04,$08,$10,$20,$40,$80), { /// }
+ ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { /// als dicke Linien }
+ ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { \\\ als dicke Linien }
+ ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { \ \\ \ }
+ ($ff,$88,$88,$88,$ff,$88,$88,$88), { K„stchen }
+ ($18,$24,$42,$81,$81,$42,$24,$18), { Rauten }
+ ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { "Mauermuster" }
+ ($80,$00,$08,$00,$80,$00,$08,$00), { weit auseinanderliegende Punkte }
+ ($88,$00,$22,$00,$88,$00,$22,$00), { dichte Punkte}
+ (0,0,0,0,0,0,0,0) { benutzerdefiniert }
+ );
+
+
+
+
+
+{ ---------------------------------------------------------------------
+ Function Declarations
+
+ ---------------------------------------------------------------------}
+
+{ Retrieving coordinates }
+function GetX: Integer;
+function GetY: Integer;
+
+{ Pixel-oriented routines }
+procedure PutPixel(X, Y: Integer; Pixel: Word);
+function GetPixel(X, Y: Integer): Integer;
+
+{ Line-oriented primitives }
+procedure LineTo(X, Y: Integer);
+procedure LineRel(Dx, Dy: Integer);
+procedure MoveTo(X, Y: Integer);
+procedure MoveRel(Dx, Dy: Integer);
+procedure Line(x1, y1, x2, y2: Integer);
+
+{ Linearly bounded primitives }
+procedure Rectangle(x1, y1, x2, y2: Integer);
+procedure Bar(x1, y1, x2, y2: Integer);
+procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
+procedure FloodFill(X, Y: Integer; Border: Word);
+
+{ Nonlinearly bounded primitives }
+
+procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);
+procedure Circle(X, Y: Integer; Radius: Word);
+procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word);
+procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
+procedure SetAspectRatio(Xasp, Yasp: Word);
+procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
+procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
+
+{ Color routines }
+procedure SetBkColor(ColorNum: Word);
+procedure SetColor(Color: Word);
+Function GetBkColor : Word;
+Function GetColor : Word;
+function GetMaxColor : Word;
+
+function GetMaxX : Integer;
+function GetMAxY : Integer;
+function GetAspect: Real;
+procedure GetAspectRatio(var x,y : Word);
+
+{ Graph clipping method }
+Procedure ClearViewPort;
+
+function GraphResult: Integer;
+
+{ For compatibility }
+Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String);
+Procedure CloseGraph;
+
+const
+ NoGraphics: Boolean = false;
+
+ { VGA modes }
+ GTEXT = 0; { Compatible with VGAlib v1.2 }
+ G320x200x16 = 1;
+ G640x200x16 = 2;
+ G640x350x16 = 3;
+ G640x480x16 = 4;
+ G320x200x256 = 5;
+ G320x240x256 = 6;
+ G320x400x256 = 7;
+ G360x480x256 = 8;
+ G640x480x2 = 9;
+
+ G640x480x256 = 10;
+ G800x600x256 = 11;
+ G1024x768x256 = 12;
+
+ G1280x1024x256 = 13; { Additional modes. }
+
+ G320x200x32K = 14;
+ G320x200x64K = 15;
+ G320x200x16M = 16;
+ G640x480x32K = 17;
+ G640x480x64K = 18;
+ G640x480x16M = 19;
+ G800x600x32K = 20;
+ G800x600x64K = 21;
+ G800x600x16M = 22;
+ G1024x768x32K = 23;
+ G1024x768x64K = 24;
+ G1024x768x16M = 25;
+ G1280x1024x32K = 26;
+ G1280x1024x64K = 27;
+ G1280x1024x16M = 28;
+
+ G800x600x16 = 29;
+ G1024x768x16 = 30;
+ G1280x1024x16 = 31;
+
+ G720x348x2 = 32; { Hercules emulation mode }
+
+ G320x200x16M32 = 33; { 32-bit per pixel modes. }
+ G640x480x16M32 = 34;
+ G800x600x16M32 = 35;
+ G1024x768x16M32 = 36;
+ G1280x1024x16M32 = 37;
+
+ { additional resolutions }
+ G1152x864x16 = 38;
+ G1152x864x256 = 39;
+ G1152x864x32K = 40;
+ G1152x864x64K = 41;
+ G1152x864x16M = 42;
+ G1152x864x16M32 = 43;
+
+ G1600x1200x16 = 44;
+ G1600x1200x256 = 45;
+ G1600x1200x32K = 46;
+ G1600x1200x64K = 47;
+ G1600x1200x16M = 48;
+ G1600x1200x16M32 = 49;
+
+ GLASTMODE = 49;
+
+
+implementation
+
+{$I tagutils.inc}
+
+{ ---------------------------------------------------------------------
+ Types, constants and variables
+
+ ---------------------------------------------------------------------}
+VAR GraphScr :pScreen;
+ GraphWin :pWindow;
+ CurrentRastPort : pRastPort;
+ TheAspect : Real;
+ GraphResultCode : Integer;
+
+ Msg :pIntuiMessage;
+ Ende :Boolean;
+
+var
+ DrawDelta: TPoint;
+ CurX, CurY: Integer;
+ TheColor, TheFillColor: LongInt;
+ IsVirtual: Boolean;
+ ColorTable: array[0..15] of LongInt;
+ TheFillPattern : FillPatternType;
+ TheLineSettings : LineSettingsType;
+ ThePalette : PaletteType;
+ TheTextSettings : TextSettingsType;
+ TheFillSettings : FillSettingsType;
+
+const
+ BgiColors: array[0..15] of LongInt
+ = ($000000, $000080, $008000, $008080,
+ $800000, $800080, $808000, $C0C0C0,
+ $808080, $0000FF, $00FF00, $00FFFF,
+ $FF0000, $FF00FF, $FFFF00, $FFFFFF);
+
+const
+ DoUseMarker: Boolean = true;
+ TheMarker: Char = '~';
+ TextColor: LongInt = 15;
+ MarkColor: LongInt = 15;
+ BackColor: LongInt = 0;
+ FontWidth: Integer = 8;
+ FontHeight: Integer = 8;
+
+var
+ sHoriz, sVert: Word;
+
+{ initialisierte Variablen }
+const
+ SourcePage: Word = 0;
+ DestPage: Word = 0;
+
+{ Retrieves the capabilities for the current mode }
+const
+ vmcImage = 1;
+ vmcCopy = 2;
+ vmcSaveRestore = 4;
+ vmcBuffer = 8;
+ vmcBackPut = 16;
+
+{ ---------------------------------------------------------------------
+ Graphics Vision Layer
+ ---------------------------------------------------------------------}
+
+
+{ Types and constants }
+var
+ SizeX, SizeY: Word;
+
+{ Font attributes }
+const
+ ftNormal = 0;
+ ftBold = 1;
+ ftThin = 2;
+ ftItalic = 4;
+
+var
+ sFont, sColor:Word;
+ sCharSpace: Integer;
+{ Not used
+ sMarker: Char;
+ sAttr: Word; }
+
+{ Bitmap utilities }
+type
+ PBitmap = ^TBitmap;
+ TBitmap = record
+ Width, Height: Integer;
+ Data: record end;
+ end;
+
+
+const
+ pbNone = 0;
+ pbCopy = 1;
+ pbClear = 2;
+
+procedure SetColors;
+begin
+ SetRGB4(@GraphScr^.ViewPort, Black , 0,0,0);
+ SetRGB4(@GraphScr^.ViewPort, Blue , 0,0,15);
+ SetRGB4(@GraphScr^.ViewPort, Green , 0,15,0);
+ SetRGB4(@GraphScr^.ViewPort, Cyan , 0,15,15);
+ SetRGB4(@GraphScr^.ViewPort, Red , 15,0,0);
+ SetRGB4(@GraphScr^.ViewPort, Magenta , 15,0,15);
+ SetRGB4(@GraphScr^.ViewPort, Brown , 6,2,0);
+ SetRGB4(@GraphScr^.ViewPort, LightGray, 13,13,13);
+ SetRGB4(@GraphScr^.ViewPort, DarkGray , 4,4,4);
+ SetRGB4(@GraphScr^.ViewPort, LightBlue, 5,5,5);
+ SetRGB4(@GraphScr^.ViewPort, LightGreen ,9,15,1);
+ SetRGB4(@GraphScr^.ViewPort, LightRed ,14,5,0);
+ SetRGB4(@GraphScr^.ViewPort, LightMagenta ,0,15,8);
+ SetRGB4(@GraphScr^.ViewPort, Yellow ,15,15,0);
+ SetRGB4(@GraphScr^.ViewPort, White ,15,15,15);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Real graph implementation
+ ---------------------------------------------------------------------}
+
+function GraphResult: Integer;
+begin
+ GraphResult := GraphResultCode;
+end;
+
+Procedure ClearViewPort;
+begin
+ SetRast(CurrentRastPort,Black);
+end;
+
+function GetX: Integer;
+begin
+ GetX := CurX;
+end;
+
+function GetY: Integer;
+begin
+ GetY := CurY;
+end;
+
+function GetAspect: Real;
+begin
+ GetAspect := GetMaxY/GetMaxX;
+end;
+
+procedure GetAspectRatio(var x,y : Word);
+begin
+ x := GetMaxX;
+ y := GetMaxY;
+end;
+
+{ Pixel-oriented routines }
+procedure PutPixel(x,y : Integer; Pixel : Word);
+begin
+ SetAPen(CurrentRastPort,Pixel);
+ WritePixel(CurrentRastPort,x,y);
+ CurX := x;
+ CurY := y;
+end;
+
+function GetPixel(X, Y: Integer): Integer;
+begin
+ GetPixel := ReadPixel(CurrentRastPort,X,Y);
+end;
+
+{ Line-oriented primitives }
+
+procedure LineTo(X, Y: Integer);
+begin
+ Draw(CurrentRastPort,X,Y);
+ CurX := X;
+ CurY := Y;
+end;
+
+procedure LineRel(Dx, Dy: Integer);
+begin
+ CurX := CurX + Dx;
+ CurY := CurY + Dy;
+ Draw(CurrentRastPort, Curx, CurY);
+end;
+
+procedure MoveTo(X, Y: Integer);
+begin
+ Move(CurrentRastPort, X , Y);
+ CurX := X;
+ CurY := Y;
+end;
+
+procedure MoveRel(Dx, Dy: Integer);
+begin
+ CurX := CurX + Dx;
+ CurY := CurY + Dy;
+ Move(CurrentRastPort, Curx, CurY);
+end;
+
+procedure Line(x1,y1,x2,y2: Integer);
+begin
+ Move(CurrentRastPort,x1,y1);
+ Draw(CurrentRastPort,x2,y2);
+ Move(CurrentRastPort,CurX, CurY);
+end;
+
+procedure Rectangle(x1, y1, x2, y2: Integer);
+begin
+ Move(CurrentRastPort, x1, y1);
+ Draw(CurrentRastPort, x2, y1);
+ Draw(CurrentRastPort, x2, y2);
+ Draw(CurrentRastPort, x1, y2);
+ Draw(CurrentRastPort, x1, y1);
+ CurX := x1;
+ CurY := y1;
+end;
+
+procedure Bar(x1, y1, x2, y2: Integer);
+begin
+ RectFill(CurrentRastPort, x1, y1, x2, y2);
+ CurX := x1;
+ CurY := y1;
+end;
+
+procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
+begin
+ Bar(x1,y1,x2,y2);
+ Rectangle(x1,y1,x2,y2);
+ if top then begin
+ Moveto(x1,y1);
+ Lineto(x1+depth,y1-depth);
+ Lineto(x2+depth,y1-depth);
+ Lineto(x2,y1);
+ end;
+ Moveto(x2+depth,y1-depth);
+ Lineto(x2+depth,y2-depth);
+ Lineto(x2,y2);
+
+end;
+
+procedure FloodFill(X, Y: Integer; Border: Word);
+begin
+
+end;
+
+Var LastArcCoords : ArcCoordsType;
+
+
+procedure SetArcCoords (X,y,xradius,yradius,Stangle,endangle : integer);
+
+begin
+ LastArcCoords.X:=X;
+ LastArccOords.y:=y;
+ Lastarccoords.xstart:=x+round(xradius*cos(stangle*pi/180));
+ Lastarccoords.ystart:=y-round(yradius*sin(stangle*pi/180));
+ LastArccoords.xend:=x+round(xradius*cos(endangle*pi/180));
+ LastArccoords.yend:=y-round(yradius*sin(endangle*pi/180));
+end;
+
+
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);
+
+begin
+ ArcCoords:=LastArcCoords;
+end;
+
+procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
+
+begin
+ Ellipse (X,y,stangle,endangle,Radius,radius);
+end;
+
+procedure Circle(X, Y: Integer; Radius: Word);
+begin
+ DrawEllipse(CurrentRastPort, x, y, Round(Radius * TheAspect), Radius);
+end;
+
+procedure Ellipse(X, Y: Integer;
+ StAngle, EndAngle: Word; XRadius, YRadius : Word);
+
+Var I : longint;
+ tmpang : real;
+
+begin
+ SetArcCoords (X,Y,xradius,yradius,Stangle,EndAngle);
+ For i:= StAngle To EndAngle Do
+ Begin
+ tmpAng:= i*Pi/180;
+ curX:= X + Round (xRadius*Cos (tmpAng));
+ curY:= Y - Round (YRadius*Sin (tmpAng));
+ PutPixel (curX, curY, TheColor);
+ End;
+end;
+
+procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
+
+Var I,tmpcolor : longint;
+ tmpang : real;
+ tmpx,tmpy : Integer;
+
+begin
+ tmpcolor:=Thecolor;
+ SetColor(TheFillColor);
+ For i:= 0 to 180 Do
+ Begin
+ tmpAng:= i*Pi/180;
+ curX:= Round (xRadius*Cos (tmpAng));
+ curY:= Round (YRadius*Sin (tmpAng));
+ tmpX:= X - curx;
+ tmpy:= Y + cury;
+ curx:=x+curx;
+ cury:=y-cury;
+ Line (curX, curY,tmpx,tmpy);
+ PutPixel (curx,cury,tmpcolor);
+ PutPixel (tmpx,tmpy,tmpcolor);
+ End;
+ SetColor(tmpcolor);
+end;
+
+procedure SetAspectRatio(Xasp, Yasp: Word);
+begin
+ //!! Needs implementing.
+end;
+
+procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
+
+Begin
+ sector (x,y,stangle,endangle,radius,radius);
+end;
+
+procedure Sector(X, Y: Integer;
+ StAngle, EndAngle, XRadius, YRadius: Word);
+
+Var I,tmpcolor : longint;
+ tmpang : real;
+ ac : arccoordstype;
+
+begin
+ tmpcolor:=Thecolor;
+ SetColor(TheFillColor);
+ For i:= stangle to endangle Do
+ Begin
+ tmpAng:= i*Pi/180;
+ curX:= x+Round (xRadius*Cos (tmpAng));
+ curY:= y-Round (YRadius*Sin (tmpAng));
+ Line (x,y,curX, curY);
+ PutPixel (curx,cury,tmpcolor);
+ End;
+ SetColor(tmpcolor);
+ getarccoords(ac);
+ Line (x,y,ac.xstart,ac.ystart);
+ Line (x,y,ac.xend,ac.yend);
+end;
+
+{ Color routines
+}
+
+procedure SetBkColor(ColorNum: Word);
+begin
+ SetBPen(CurrentRastPort, ColorNum);
+ BackColor := ColorNum;
+end;
+
+Function GetBkColor : Word;
+
+begin
+ GetBkColor:=BackColor;
+end;
+
+Function GetColor : Word;
+
+begin
+ GetColor:=TheColor;
+end;
+
+procedure SetColor(color : Word);
+begin
+ SetAPen(CurrentRastPort,color);
+ TheColor := color;
+end;
+
+function GetMaxColor: word;
+begin
+ GetMaxColor := 15;
+end;
+
+function GetMaxX: Integer;
+begin
+ GetMaxX := GraphWin^.Width;
+end;
+
+function GetMaxY: Integer;
+begin
+ GetMaxY := GraphWin^.Height;
+end;
+
+Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String);
+var
+ thetags : array[0..3] of tTagItem;
+
+BEGIN
+ GraphResultCode := grOK;
+ GfxBase := OpenLibrary(GRAPHICSNAME,0);
+ if GfxBase = nil then begin
+ GraphResultCode := grNoInitGraph;
+ Exit;
+ end;
+
+ GraphScr:=Nil; GraphWin:=Nil;
+
+ { Will open an hires interlace screen, if you
+ want just an hires screen change HIRESLACE_KEY
+ to HIRES_KEY
+ }
+ thetags[0] := TagItem(SA_Depth, 4);
+ thetags[1] := TagItem(SA_DisplayID, HIRESLACE_KEY);
+ thetags[2].ti_Tag := TAG_END;
+
+ GraphScr := OpenScreenTagList(NIL,@thetags);
+ If GraphScr=Nil Then begin
+ GraphResultCode := grNoInitGraph;
+ Exit;
+ end;
+
+ thetags[0] := TagItem(WA_Flags, WFLG_BORDERLESS);
+ thetags[1] := TagItem(WA_IDCMP, IDCMP_MOUSEBUTTONS);
+ thetags[2] := TagItem(WA_CustomScreen, Longint(GraphScr));
+ thetags[3].ti_Tag := TAG_DONE;
+
+ GraphWin:=OpenWindowTagList(Nil, @thetags);
+ If GraphWin=Nil Then CloseGraph;
+
+ CurrentRastPort := GraphWin^.RPort;
+
+ SetColors;
+ TheAspect := GetAspect;
+END;
+
+PROCEDURE CloseGraph;
+BEGIN
+ { Ende:=false;
+ Repeat
+ Msg:=pIntuiMessage(GetMsg(GraphWin^.UserPort));
+ If Msg<>Nil Then Begin
+ ReplyMsg(Pointer(Msg));
+ Ende:=true;
+ End;
+ Until Ende;}
+ If GraphWin<>Nil Then
+ CloseWindow(GraphWin);
+ If (GraphScr<>Nil) then CloseScreen(GraphScr);
+ if GfxBase <> nil then CloseLibrary(GfxBase);
+ Halt;
+END;
+
+begin
+
+ CurX := 0;
+ CurY := 0;
+end.
+
+ $Log: graph.pp,v $
+ Revision 1.4 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/amiga/os.inc b/rtl/amiga/os.inc
new file mode 100644
index 0000000000..0d351d8603
--- /dev/null
+++ b/rtl/amiga/os.inc
@@ -0,0 +1,27 @@
+{
+ $Id: os.inc,v 1.4 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$define amiga}
+{$undef go32v2}
+{$undef os2}
+{$undef linux}
+{$undef win32}
+{$undef macos}
+{$undef atari}
+
+{
+ $Log: os.inc,v $
+ Revision 1.4 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/amiga/printer.pp b/rtl/amiga/printer.pp
new file mode 100644
index 0000000000..f45e81e072
--- /dev/null
+++ b/rtl/amiga/printer.pp
@@ -0,0 +1,35 @@
+{
+ $Id: printer.pp,v 1.5 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Printer unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit printer;
+interface
+
+{$I printerh.inc}
+
+implementation
+
+{$I printer.inc}
+
+begin
+ InitPrinter ('prt:');
+ SetPrinterExit;
+end.
+{
+ $Log: printer.pp,v $
+ Revision 1.5 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/amiga/prt0.as b/rtl/amiga/prt0.as
new file mode 100644
index 0000000000..7aaa04cc9c
--- /dev/null
+++ b/rtl/amiga/prt0.as
@@ -0,0 +1,56 @@
+
+ .text
+
+ .align 4
+
+ .globl _start
+ .globl start
+_start:
+start:
+| Save stack pointer for exit() routine
+
+ movel sp,STKPTR | save stack pointer
+| This was wrong compared to PCQ
+| addl #4,STKPTR | account for this jsr to get to original
+
+| Save the command line pointer to CommandLine
+
+ movel a0,__ARGS
+ beq .Ldont_nullit
+
+
+| Remove $0a character from end of string
+ movew d0,d1
+ subqw #1,d1
+ cmpb #0x0a,a0@(0,d1:w)
+ bne .Lcontt
+| Decrement count by one to remove the $0a character
+ movew d1,d0
+ .Lcontt:
+ moveb #0,a0@(0,d0:w) | null terminate it
+ movew d0,__ARGC
+ .Ldont_nullit:
+
+ jsr PASCALMAIN
+
+ movel STKPTR,sp
+ rts
+
+ .data
+
+ .align 4
+
+ .globl __ARGS
+ __ARGS: | pointer to the arguments
+ .long 0
+ .globl __ARGC
+ __ARGC: | number of arguments
+ .word 0
+ .globl STKPTR | Used to terminate the program, initial SP
+ STKPTR:
+ .long 0
+
+
+
+
+
diff --git a/rtl/amiga/readme b/rtl/amiga/readme
new file mode 100644
index 0000000000..aa0bd3f3e7
--- /dev/null
+++ b/rtl/amiga/readme
@@ -0,0 +1,4 @@
+For the moment there is no makefile for the amiga system unit, therefore
+to compile you must copy all files from the inc and m68k directories into
+the same directory as the files here.
+
diff --git a/rtl/arm/arm.inc b/rtl/arm/arm.inc
new file mode 100644
index 0000000000..527b6c2445
--- /dev/null
+++ b/rtl/arm/arm.inc
@@ -0,0 +1,202 @@
+{
+ $Id: arm.inc,v 1.12 2005/03/13 10:04:52 florian Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team.
+
+ Processor dependent implementation for the system unit for
+ ARM
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$asmmode gas}
+
+procedure fpc_cpuinit;
+begin
+ asm
+ rfs r0
+ and r0,r0,#0xffe0ffff
+ orr r0,r0,#0x00020000
+ wfs r0
+ end;
+end;
+
+{****************************************************************************
+ stack frame related stuff
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ mov r0,r11
+end ['R0'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ movs r0,r0
+ beq .Lg_a_null
+ ldr r0,[r0,#-4]
+.Lg_a_null:
+end ['R0'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ movs r0,r0
+ beq .Lgnf_null
+ ldr r0,[r0,#-12]
+.Lgnf_null:
+end ['R0'];
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ mov r0,sp
+end ['R0'];
+
+
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+Procedure FillChar(var x;count:longint;value:byte);assembler;nostackframe;
+asm
+ // less than 0?
+ cmp r1,#0
+ movlt pc,lr
+ mov r3,r0
+ cmp r1,#8 // at least 8 bytes to do?
+ blt .LFillchar2
+ orr r2,r2,r2,lsl #8
+ orr r2,r2,r2,lsl #16
+.LFillchar0:
+ tst r3,#3 // aligned yet?
+ strneb r2,[r3],#1
+ subne r1,r1,#1
+ bne .LFillchar0
+ mov ip,r2
+.LFillchar1:
+ cmp r1,#8 // 8 bytes still to do?
+ blt .LFillchar2
+ stmia r3!,{r2,ip}
+ sub r1,r1,#8
+ cmp r1,#8 // 8 bytes still to do?
+ blt .LFillchar2
+ stmia r3!,{r2,ip}
+ sub r1,r1,#8
+ cmp r1,#8 // 8 bytes still to do?
+ blt .LFillchar2
+ stmia r3!,{r2,ip}
+ sub r1,r1,#8
+ cmp r1,#8 // 8 bytes still to do?
+ stmgeia r3!,{r2,ip}
+ subge r1,r1,#8
+ bge .LFillchar1
+.LFillchar2:
+ movs r1,r1 // anything left?
+ moveq pc,lr
+ rsb r1,r1,#7
+ add pc,pc,r1,lsl #2
+ mov r0,r0
+ strb r2,[r3],#1
+ strb r2,[r3],#1
+ strb r2,[r3],#1
+ strb r2,[r3],#1
+ strb r2,[r3],#1
+ strb r2,[r3],#1
+ strb r2,[r3],#1
+ mov pc,lr
+end;
+
+
+(*
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
+asm
+ // count <=0 ?
+ cmp r2,#0
+ movle pc,lr
+ // overlap?
+ cmp r2,r1
+ bls .Lnoverlap
+ add r3,r0,r2
+ cmp r3,r2
+ bls .Lnooverlap
+ // overlap, copy backward
+.Loverlapped
+ subs r2,r2,#1
+ ldrb r3,[r0,r2]
+ strb r3,[r1,r2]
+ bne .Loverlapped
+ mov pc,lr
+.Lnooverlap:
+ // less then 16 bytes to copy?
+ cmp r2,#16
+ // yes, the forget about the whole optimizations
+ // and do a bytewise copy
+ blt .Lbyteloop
+
+ // both uneven aligned?
+ eor r3,r0,r1
+ tst r3,#1
+
+ bne .Ldifferentaligned
+ // yes, then align
+ // alignment to 4 byte boundries is enough
+ ldrb ip,[r0],#1
+ sub r2,r2,#1
+ stb ip,[r1],#1
+ tst r3,#2
+ bne .Ldifferentaligned
+ ldrh ip,[r0],#2
+ sub r2,r2,#2
+ sth ip,[r1],#2
+
+.Ldifferentaligned
+ // qword aligned?
+ orrs r3,r0,r1
+ tst r3,#7
+ bne .Ldwordloop
+.Lqwordloop:
+ sub r2,r2,#8
+ ldmia r0!,{r3,ip}
+ stmia r1!,{r3,ip}
+
+
+
+.Lbyteloop:
+ ldrb r3,[r0],#1
+ strb r3,[r1],#1
+ subs r2,r2,#1
+ bne .Lbyteloop
+ mov pc,lr
+end;
+*)
+
+{
+ $Log: arm.inc,v $
+ Revision 1.12 2005/03/13 10:04:52 florian
+ * move draft
+
+ Revision 1.11 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.10 2005/01/05 15:59:02 florian
+ + added nostackframe directive to get_frame
+
+ Revision 1.9 2005/01/05 15:21:14 florian
+ * fillchar fixed; it's used now
+
+ Revision 1.8 2005/01/04 16:46:38 florian
+ + correct setting of FPU exception mask
+
+}
+
diff --git a/rtl/arm/int64p.inc b/rtl/arm/int64p.inc
new file mode 100644
index 0000000000..3577f0d858
--- /dev/null
+++ b/rtl/arm/int64p.inc
@@ -0,0 +1,56 @@
+{
+ $Id: int64p.inc,v 1.5 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains some helper routines for int64 and qword
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define FPC_SYSTEM_HAS_MUL_QWORD}
+function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword;assembler;[public,alias: 'FPC_MUL_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+ mov r6,#0
+ // lo(f1)*lo(f2)
+ umull r4,r5,r0,r2
+ // lo(f1)*hi(f2)
+ umlal r5,r6,r0,r3
+ // overflow?
+ // hi(f1)*hi(f2)
+ mul r0,r1,r3
+ // hi(f1)*lo(f2)
+ umlal r5,r6,r1,r2
+ // check for overflow
+ orrs r6,r6,r0
+ mov r0,r4
+ mov r1,r5
+ // no overflow?
+ beq .Lexit
+
+ ldr r2,checkoverflow
+ cmp r2,#0
+ beq .Lexit
+
+ mov r0,#215
+ mov r1,fp
+ bl HandleErrorFrame
+.Lexit:
+end ['r4','r5','r6'];
+
+
+{
+ $Log: int64p.inc,v $
+ Revision 1.5 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.4 2005/01/04 12:57:52 florian
+ * fixed overflow checking for qword*qword
+
+}
diff --git a/rtl/arm/makefile.cpu b/rtl/arm/makefile.cpu
new file mode 100644
index 0000000000..0e94513f5a
--- /dev/null
+++ b/rtl/arm/makefile.cpu
@@ -0,0 +1,13 @@
+# $Id: makefile.cpu,v 1.1 2003/08/21 03:24:43 florian Exp $
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=arm math set
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
+#
+# $Log: makefile.cpu,v $
+# Revision 1.1 2003/08/21 03:24:43 florian
+# + basic makefile.cpu added
+#
+# \ No newline at end of file
diff --git a/rtl/arm/math.inc b/rtl/arm/math.inc
new file mode 100644
index 0000000000..85484efc9d
--- /dev/null
+++ b/rtl/arm/math.inc
@@ -0,0 +1,111 @@
+{
+ $Id: math.inc,v 1.7 2005/02/14 17:13:21 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team.
+
+ Implementation of mathematical Routines (only for real)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef INTERNCONSTINTF}
+ {$define FPC_SYSTEM_HAS_ABS}
+ function fpc_abs_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SQR}
+ function fpc_sqr_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function fpc_sqrt_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ { atn isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_ARCTAN}
+ function fpc_arctan_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ }
+ { lgn isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_LN}
+ function fpc_ln_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ }
+ { sind isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_SIN}
+ function fpc_sin_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ }
+ { cos isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_COS}
+ function fpc_cos_real(d : extended) : extended;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ }
+{$else INTERNCONSTINTF}
+ {$define FPC_SYSTEM_HAS_ABS}
+ function abs(d : extended) : extended;[internproc:in_abs_extended];
+ {$define FPC_SYSTEM_HAS_SQR}
+ function sqr(d : extended) : extended;[internproc:in_sqr_extended];
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function sqrt(d : extended) : extended;[internproc:in_sqrt_extended];
+ { atn isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_ARCTAN}
+ function arctan(d : extended) : extended;[internproc:in_arctan_extended];
+ }
+ { lgn isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_LN}
+ function ln(d : extended) : extended;[internproc:in_ln_extended];
+ }
+ { sind isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_SIN}
+ function sin(d : extended) : extended;[internproc:in_sin_extended];
+ }
+ { cos isn't supported by the linux fpe it seems
+ {$define FPC_SYSTEM_HAS_COS}
+ function cos(d : extended) : extended;[internproc:in_cos_extended];
+ }
+{$endif INTERNCONSTINTF}
+{
+ $Log: math.inc,v $
+ Revision 1.7 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.6 2005/01/06 13:02:03 florian
+ * arctan, sin and cos are done in software on the arm
+
+ Revision 1.5 2005/01/01 18:34:24 florian
+ * fixed building
+
+}
diff --git a/rtl/arm/mathu.inc b/rtl/arm/mathu.inc
new file mode 100644
index 0000000000..cc3d575906
--- /dev/null
+++ b/rtl/arm/mathu.inc
@@ -0,0 +1,20 @@
+{
+ $Id: mathu.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ $Log: mathu.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/arm/mathuh.inc b/rtl/arm/mathuh.inc
new file mode 100644
index 0000000000..735018e3ab
--- /dev/null
+++ b/rtl/arm/mathuh.inc
@@ -0,0 +1,20 @@
+{
+ $Id: mathuh.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ $Log: mathuh.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/arm/set.inc b/rtl/arm/set.inc
new file mode 100644
index 0000000000..41fd21c685
--- /dev/null
+++ b/rtl/arm/set.inc
@@ -0,0 +1,22 @@
+{
+ $Id: set.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team.
+
+ Include file with set operations called by the compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ $Log: set.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/arm/setjump.inc b/rtl/arm/setjump.inc
new file mode 100644
index 0000000000..c1097b094b
--- /dev/null
+++ b/rtl/arm/setjump.inc
@@ -0,0 +1,44 @@
+{
+ $Id: setjump.inc,v 1.6 2005/02/14 17:13:21 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team.
+
+ SetJmp and LongJmp implementation for exception handling
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;
+ label FPC_SETJMP;
+ asm
+ stmia r0,{v1-v6, sl, fp, sp, lr}
+ mov r0,#0
+ mov pc,lr
+ end;
+
+
+procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];
+ asm
+ mov ip, r0
+ movs r0, r1
+ moveq r0, #1
+ ldmia ip,{v1-v6, sl, fp, sp, pc}
+ end;
+
+
+{
+ $Log: setjump.inc,v $
+ Revision 1.6 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.5 2005/01/04 16:22:05 florian
+ + added nostackframe directive
+
+}
diff --git a/rtl/arm/setjumph.inc b/rtl/arm/setjumph.inc
new file mode 100644
index 0000000000..cc4aa80c86
--- /dev/null
+++ b/rtl/arm/setjumph.inc
@@ -0,0 +1,33 @@
+{
+ $Id: setjumph.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team.
+
+ SetJmp/Longjmp declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ jmp_buf = packed record
+ v1,v2,v3,v4,v5,v6,sl,fp,sp,pc : dword;
+ end;
+ pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : longint;
+procedure longjmp(var S : jmp_buf;value : longint);
+
+
+{
+ $Log: setjumph.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/arm/strings.inc b/rtl/arm/strings.inc
new file mode 100644
index 0000000000..adb9aa4827
--- /dev/null
+++ b/rtl/arm/strings.inc
@@ -0,0 +1,24 @@
+{
+ $Id: strings.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, that can be shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: strings.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/arm/stringss.inc b/rtl/arm/stringss.inc
new file mode 100644
index 0000000000..3969c254b9
--- /dev/null
+++ b/rtl/arm/stringss.inc
@@ -0,0 +1,24 @@
+{
+ $Id: stringss.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, not shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: stringss.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/arm/sysutilp.inc b/rtl/arm/sysutilp.inc
new file mode 100644
index 0000000000..66c9e4406d
--- /dev/null
+++ b/rtl/arm/sysutilp.inc
@@ -0,0 +1,58 @@
+{
+ $Id: sysutilp.inc,v 1.3 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 2001 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+ This include contains cpu-specific routines
+ ---------------------------------------------------------------------}
+
+
+{ the ARM doesn't know multiprocessor system which would require locking }
+
+
+function InterLockedDecrement (var Target: longint) : longint;
+ begin
+ dec(Target);
+ result:=target;
+ end;
+
+
+function InterLockedIncrement (var Target: longint) : longint;
+ begin
+ inc(Target);
+ result:=target;
+ end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint;
+ begin
+ Result:=Target;
+ Target:=Source;
+ end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
+ begin
+ Result:=Target;
+ inc(Target,Source);
+ end;
+
+
+{
+ $Log: sysutilp.inc,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/atari/os.inc b/rtl/atari/os.inc
new file mode 100644
index 0000000000..cd084d3ddb
--- /dev/null
+++ b/rtl/atari/os.inc
@@ -0,0 +1,27 @@
+{
+ $Id: os.inc,v 1.4 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$define atari}
+{$undef go32v2}
+{$undef os2}
+{$undef linux}
+{$undef win32}
+{$undef amiga}
+{$undef macos}
+
+{
+ $Log: os.inc,v $
+ Revision 1.4 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/atari/prt0.as b/rtl/atari/prt0.as
new file mode 100644
index 0000000000..b092a9f200
--- /dev/null
+++ b/rtl/atari/prt0.as
@@ -0,0 +1,208 @@
+|*************************************************************************
+|* *
+|* DSTART.S Startup module for Pascal programs using dLibs *
+|* *
+|*************************************************************************
+
+|*
+|* entry points
+|*
+.globl __base | basepage pointer
+.globl __start | startup entry point
+.globl _etext | end of text segment
+.globl _edata | end of data segment
+.globl _end | end of BSS segment (end of program)
+.globl __BREAK | location of stack/heap break
+.globl __ARGC | number of arguments
+.globl __ARGS | argument list pointer
+.globl __envp | environment string pointer
+.globl _errno | system error number
+
+|
+| external references
+|
+|.globl __stklen | Stack size value from C (unsigned long)
+
+|
+| useful constants
+|
+MINSTK = 16384 | Minimum 16K stack size
+MARGIN = 512 | Minimum memory to return to OS
+
+|
+| GEMDOS functions
+|
+Cconws = 0x09 | Console write string
+Pterm = 0x4C | Process terminate (with exit code)
+Mshrink = 0x4A | Shrink program space
+
+|
+| basepage offsets
+|
+p_hitpa = 0x04 | top of TPA
+p_tbase = 0x08 | base of text
+p_tlen = 0x0C | length of text
+p_dbase = 0x10 | base of data
+p_dlen = 0x14 | length of data
+p_bbase = 0x18 | base of BSS
+p_blen = 0x1C | length of BSS
+p_env = 0x2C | environment string
+p_cmdlin = 0x80 | command line image
+
+|
+| STARTUP ROUTINE (must be first object in link)
+|
+.text
+ .globl start
+ .globl _start
+
+__start:
+start:
+_start:
+|
+| save initial stack and basepage pointers
+|
+ movel sp,a5 | a5 = initial stack pointer
+ movel sp@(4),a4 | a4 = basepage address
+ movel a4,__base
+ movel a4@(p_tbase),d3
+ addl a4@(p_tlen),d3
+ movel d3,_etext | end of text segment
+ movel a4@(p_dbase),d3
+ addl a4@(p_dlen),d3
+ movel d3,_edata | end of data segment
+ movel a4@(p_bbase),d3
+ addl a4@(p_blen),d3
+ movel d3,_end | end of BSS (end of program)
+ movel d3,__BREAK; | set initial _break value
+ movel a4@(p_env),__envp | save environment pointer
+|
+| call C function to get command line arguments
+|
+ lea a4@(p_cmdlin),a0 | get pointer to command line image
+ moveb a0@+,d0
+ extw d0 | extract length
+| movew d0,sp@- | cmdlen
+| movel a0,sp@- | cmdline
+| jsr __initar | call _initargs(cmdline, cmdlen)
+| addql #6,sp
+ movew d0,__ARGC | save length
+ movel a0,__ARGS | save pointer to string
+|
+| calculate free space available to program
+|
+ movel __BREAK,d3
+ movel d3,a3 | a3 = base of free space
+ negl d3
+ addl a4@(p_hitpa),d3
+ subl #MARGIN,d3 | d3 = free space
+|
+| calculate new stack size (store in d2)
+|
+| ASSUME 8K STACK FOR THE MOMENT.
+ movel __stklen,d2 | d2 = _STKSIZ
+ tstl d2 | if __STKSIZ is zero
+ beq minimum | use MINSTK
+ bra setstk | use __STKSIZ
+minimum:
+ movel #MINSTK,d2 | use MINSTK
+|
+| check to see if there is enough room for requested stack
+|
+setstk:
+ cmpl d3,d2
+ blt shrink | if (available < requested)
+ movel #stkerr,sp@-
+ movew #Cconws,sp@-
+ trap #1 | report a stack error
+ addql #6,sp
+ movew #-39,sp@-
+ movew #Pterm,sp@-
+ trap #1 | and return error -39 (ENSMEM)
+|
+| set up new stack pointer and Mshrink
+|
+shrink:
+ addl a3,d2 | new stack = free base + stack size
+ movel d2,sp
+ subl a4,d2 | keep space = new stack - __base
+ movel d2,sp@-
+ movel a4,sp@-
+ clrw sp@-
+ movew #Mshrink,sp@-
+ trap #1 | Mshrink(0, _base, keep);
+ addl #12,sp
+|
+| call C entry point function _main()
+|
+ jsr PASCALMAIN | if _main returns
+
+ movew #0,sp@- | Terminate program normally
+ trap #1
+
+| movew d0,sp@(4) | insert return value and fall thru
+
+
+
+|
+| check for stack overflow (done after all OS traps)
+|
+chkstk:
+ cmpl __BREAK,sp
+ bgt nosweat | if (_break > sp)
+ movel #stkovf,sp@-
+ movew #Cconws,sp@-
+ trap #1 | report a stack overflow
+ addql #6,sp
+ movew #-1,sp@-
+ movew #Pterm,sp@-
+ trap #1 | and return error -1 (ERROR)
+nosweat:
+ movel traprtn,sp@- | else, restore return address
+ rts | and do a normal return.
+
+|
+| this call to _main ensures that it the user's main() function will be
+| linked, even if it is in a library.
+|
+ jsr PASCALMAIN | NO PATH TO THIS STATEMENT
+ movew d0,sp@-
+ movew #0x4c,sp@-
+ trap #1
+
+
+|
+| initialized data space
+|
+.data
+.even
+stkerr: | not enough memory for stack
+ .ascii "Not enough memory"
+ .byte 0x0d,0x0a,0x00
+stkovf: | impending stack overflow
+ .ascii "Stack overflow"
+ .byte 0x0d,0x0a,0x00
+_errno: | system error number
+ .word 0
+__ARGC: | number of command line args
+ .word 0
+__ARGS: | pointer to command line arg list
+ .long 0
+|
+| uninitialized data space
+|
+.even
+__base: | pointer to basepage
+ .long 0
+_etext: | pointer to end of text segment
+ .long 0
+_edata: | pointer to end of data segment
+ .long 0
+_end: | pointer to end of BSS (end of program)
+ .long 0
+__BREAK: | pointer to stack/heap break
+ .long 0
+__envp: | pointer to environment string
+ .long 0
+traprtn: | storage for return PC in trap hooks
+ .long 0
diff --git a/rtl/atari/readme b/rtl/atari/readme
new file mode 100644
index 0000000000..f6a1fa6622
--- /dev/null
+++ b/rtl/atari/readme
@@ -0,0 +1,4 @@
+For the moment there is no makefile for the atari system unit, therefore
+to compile you must copy all files from the inc and m68k directories into
+the same directory as the files here.
+
diff --git a/rtl/atari/sysatari.pas b/rtl/atari/sysatari.pas
new file mode 100644
index 0000000000..08777b8a3e
--- /dev/null
+++ b/rtl/atari/sysatari.pas
@@ -0,0 +1 @@
+{$i system.pas}
diff --git a/rtl/atari/system.pas b/rtl/atari/system.pas
new file mode 100644
index 0000000000..99845776b7
--- /dev/null
+++ b/rtl/atari/system.pas
@@ -0,0 +1,782 @@
+{
+ $Id: system.pas,v 1.14 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl Eric Codere
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$define ATARI}
+unit {$ifdef VER1_0}sysatari{$else}{$ifdef VER0_99}sysatari{$ELSE}system{$endif}{$ENDIF};
+
+{--------------------------------------------------------------------}
+{ LEFT TO DO: }
+{--------------------------------------------------------------------}
+{ o SBrk }
+{ o Implement truncate }
+{ o Implement paramstr(0) }
+{--------------------------------------------------------------------}
+
+
+{$I os.inc}
+
+ interface
+
+ {$I systemh.inc}
+
+type
+ THandle = longint;
+
+ {$I heaph.inc}
+
+{Platform specific information}
+const
+ LineEnding = #10;
+ LFNSupport = true;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+ FileNameCaseSensitive = false;
+ maxExitCode = 255;
+
+ sLineBreak: string [1] = LineEnding;
+ { used for single computations }
+ const BIAS4 = $7f-1;
+
+const
+ UnusedHandle = $ffff;
+ StdInputHandle = 0;
+ StdOutputHandle = 1;
+ StdErrorHandle = $ffff;
+
+
+
+ implementation
+
+ {$I system.inc}
+ {$I lowmath.inc}
+
+
+function GetProcessID:SizeUInt;
+begin
+{$WARNING To be checked by platform maintainer}
+ GetProcessID := 1;
+end;
+
+ const
+ argc : longint = 0;
+
+
+ var
+ errno : integer;
+
+{$S-}
+ procedure Stack_Check; assembler;
+ { Check for local variable allocation }
+ { On Entry -> d0 : size of local stack we are trying to allocate }
+ asm
+ XDEF STACKCHECK
+ move.l sp,d1 { get value of stack pointer }
+ sub.l d0,d1 { sp - stack_size }
+ sub.l #2048,d1
+ cmp.l __BREAK,d1
+ bgt @st1nosweat
+ move.l #202,d0
+ jsr HALT_ERROR
+ @st1nosweat:
+ end;
+
+
+ Procedure Error2InOut;
+ Begin
+ if (errno <= -2) and (errno >= -11) then
+ InOutRes:=150-errno { 150+errno }
+ else
+ Begin
+ case errno of
+ -32 : InOutRes:=1;
+ -33 : InOutRes:=2;
+ -34 : InOutRes:=3;
+ -35 : InOutRes:=4;
+ -36 : InOutRes:=5;
+ -37 : InOutRes:=8;
+ -39 : InOutRes:=8;
+ -40 : InOutRes:=9;
+ -46 : InOutRes:=15;
+ -67..-64 : InOutRes:=153;
+ -15 : InOutRes:=151;
+ -13 : InOutRes:=150;
+ else
+ InOutres := word(errno);
+ end;
+ end;
+ errno:=0;
+ end;
+
+
+
+ procedure halt(errnum : byte);
+
+ begin
+ do_exit;
+ flush(stderr);
+ asm
+ clr.l d0
+ move.b errnum,d0
+ move.w d0,-(sp)
+ move.w #$4c,-(sp)
+ trap #1
+ end;
+ end;
+
+
+ function args : pointer; assembler;
+ asm
+ move.l __ARGS,d0
+ end;
+
+
+
+
+ Function GetParamCount(const p: pchar): longint;
+ var
+ i: word;
+ count: word;
+ Begin
+ i:=0;
+ count:=0;
+ while p[count] <> #0 do
+ Begin
+ if (p[count] <> ' ') and (p[count] <> #9) and (p[count] <> #0) then
+ Begin
+ i:=i+1;
+ while (p[count] <> ' ') and (p[count] <> #9) and (p[count] <> #0) do
+ count:=count+1;
+ end;
+ if p[count] = #0 then break;
+ count:=count+1;
+ end;
+ GetParamCount:=longint(i);
+ end;
+
+
+ Function GetParam(index: word; const p : pchar): string;
+ { On Entry: index = string index to correct parameter }
+ { On exit: = correct character index into pchar array }
+ { Returns correct index to command line argument }
+ var
+ count: word;
+ localindex: word;
+ l: byte;
+ temp: string;
+ Begin
+ temp:='';
+ count := 0;
+ { first index is one }
+ localindex := 1;
+ l:=0;
+ While p[count] <> #0 do
+ Begin
+ if (p[count] <> ' ') and (p[count] <> #9) then
+ Begin
+ if localindex = index then
+ Begin
+ while (p[count] <> #0) and (p[count] <> ' ') and (p[count] <> #9) and (l < 256) do
+ Begin
+ temp:=temp+p[count];
+ l:=l+1;
+ count:=count+1;
+ end;
+ temp[0]:=char(l);
+ GetParam:=temp;
+ exit;
+ end;
+ { Point to next argument in list }
+ while (p[count] <> #0) and (p[count] <> ' ') and (p[count] <> #9) do
+ Begin
+ count:=count+1;
+ end;
+ localindex:=localindex+1;
+ end;
+ if p[count] = #0 then break;
+ count:=count+1;
+ end;
+ GetParam:=temp;
+ end;
+
+
+ function paramstr(l : longint) : string;
+ var
+ p : pchar;
+ s1 : string;
+ begin
+ if l = 0 then
+ Begin
+ s1 := '';
+ end
+ else
+ if (l>0) and (l<=paramcount) then
+ begin
+ p:=args;
+ paramstr:=GetParam(word(l),p);
+ end
+ else paramstr:='';
+ end;
+
+ function paramcount : longint;
+ Begin
+ paramcount := argc;
+ end;
+
+
+
+
+ procedure randomize;
+
+ var
+ hl : longint;
+
+ begin
+ asm
+ movem.l d2/d3/a2/a3, -(sp) { save OS registers }
+ move.w #17,-(sp)
+ trap #14 { call xbios - random number }
+ add.l #2,sp
+ movem.l (sp)+,d2/d3/a2/a3
+ move.l d0,hl { result in d0 }
+ end;
+ randseed:=hl;
+ end;
+
+function getheapstart:pointer;assembler;
+asm
+ lea.l HEAP,a0
+ move.l a0,d0
+end;
+
+
+function getheapsize:longint;assembler;
+asm
+ move.l HEAP_SIZE,d0
+end ['D0'];
+
+ { This routine is used to grow the heap. }
+ { But here we do a trick, we say that the }
+ { heap cannot be regrown! }
+ function sbrk( size: longint): pointer;
+ { on exit nil = if fails. }
+ Begin
+ sbrk:=nil;
+ end;
+
+{$I heap.inc}
+
+
+{****************************************************************************
+ Low Level File Routines
+ ****************************************************************************}
+
+procedure AllowSlash(p:pchar);
+var
+ i : longint;
+begin
+{ allow slash as backslash }
+ for i:=0 to strlen(p) do
+ if p[i]='/' then p[i]:='\';
+end;
+
+
+procedure do_close(h : longint);
+begin
+ asm
+ movem.l d2/d3/a2/a3,-(sp)
+ move.l h,d0
+ move.w d0,-(sp)
+ move.w #$3e,-(sp)
+ trap #1
+ add.l #4,sp { restore stack ... }
+ movem.l (sp)+,d2/d3/a2/a3
+ end;
+end;
+
+
+procedure do_erase(p : pchar);
+begin
+ AllowSlash(p);
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp) { save regs }
+ move.l p,-(sp)
+ move.w #$41,-(sp)
+ trap #1
+ add.l #6,sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ tst.w d0
+ beq @doserend
+ move.w d0,errno
+ @doserend:
+ end;
+ if errno <> 0 then
+ Error2InOut;
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+begin
+ AllowSlash(p1);
+ AllowSlash(p2);
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.l p1,-(sp)
+ move.l p2,-(sp)
+ clr.w -(sp)
+ move.w #$56,-(sp)
+ trap #1
+ lea 12(sp),sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ tst.w d0
+ beq @dosreend
+ move.w d0,errno { error ... }
+ @dosreend:
+ end;
+ if errno <> 0 then
+ Error2InOut;
+end;
+
+function do_isdevice(handle:word):boolean;
+begin
+ if (handle=stdoutputhandle) or (handle=stdinputhandle) or
+ (handle=stderrorhandle) then
+ do_isdevice:=FALSE
+ else
+ do_isdevice:=TRUE;
+end;
+
+
+function do_write(h,addr,len : longint) : longint;
+begin
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.l addr,-(sp)
+ move.l len,-(sp)
+ move.l h,d0
+ move.w d0,-(sp)
+ move.w #$40,-(sp)
+ trap #1
+ lea 12(sp),sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ tst.l d0
+ bpl @doswrend
+ move.w d0,errno { error ... }
+ @doswrend:
+ move.l d0,@RESULT
+ end;
+ if errno <> 0 then
+ Error2InOut;
+end;
+
+
+function do_read(h,addr,len : longint) : longint;
+begin
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.l addr,-(sp)
+ move.l len,-(sp)
+ move.l h,d0
+ move.w d0,-(sp)
+ move.w #$3f,-(sp)
+ trap #1
+ lea 12(sp),sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ tst.l d0
+ bpl @dosrdend
+ move.w d0,errno { error ... }
+ @dosrdend:
+ move.l d0,@Result
+ end;
+ if errno <> 0 then
+ Error2InOut;
+end;
+
+
+function do_filepos(handle : longint) : longint;
+begin
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.w #1,-(sp) { seek from current position }
+ move.l handle,d0
+ move.w d0,-(sp)
+ move.l #0,-(sp) { with a seek offset of zero }
+ move.w #$42,-(sp)
+ trap #1
+ lea 10(sp),sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ move.l d0,@Result
+ end;
+end;
+
+
+procedure do_seek(handle,pos : longint);
+begin
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.w #0,-(sp) { seek from start of file }
+ move.l handle,d0
+ move.w d0,-(sp)
+ move.l pos,-(sp)
+ move.w #$42,-(sp)
+ trap #1
+ lea 10(sp),sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ end;
+end;
+
+
+function do_seekend(handle:longint):longint;
+var
+ t: longint;
+begin
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.w #2,-(sp) { seek from end of file }
+ move.l handle,d0
+ move.w d0,-(sp)
+ move.l #0,-(sp) { with an offset of 0 from end }
+ move.w #$42,-(sp)
+ trap #1
+ lea 10(sp),sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ move.l d0,t
+ end;
+ do_seekend:=t;
+end;
+
+
+function do_filesize(handle : longint) : longint;
+var
+ aktfilepos : longint;
+begin
+ aktfilepos:=do_filepos(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,aktfilepos);
+end;
+
+
+procedure do_truncate (handle,pos:longint);
+begin
+ do_seek(handle,pos);
+ {!!!!!!!!!!!!}
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+ i : word;
+ oflags: longint;
+begin
+ AllowSlash(p);
+ { close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file handle }
+ filerec(f).handle:=UnusedHandle;
+ oflags:=$02; { read/write mode }
+{ convert filemode to filerec modes }
+ case (flags and 3) of
+ 0 : begin
+ filerec(f).mode:=fminput;
+ oflags:=$00; { read mode only }
+ end;
+ 1 : filerec(f).mode:=fmoutput;
+ 2 : filerec(f).mode:=fminout;
+ end;
+ if (flags and $1000)<>0 then
+ begin
+ filerec(f).mode:=fmoutput;
+ oflags:=$04; { read/write with create }
+ end
+ else
+ if (flags and $100)<>0 then
+ begin
+ filerec(f).mode:=fmoutput;
+ oflags:=$02; { read/write }
+ end;
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case filerec(f).mode of
+ fminput : filerec(f).handle:=StdInputHandle;
+ fmappend,
+ fmoutput : begin
+ filerec(f).handle:=StdOutputHandle;
+ filerec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+ asm
+ movem.l d2/d3/a2/a3,-(sp) { save used registers }
+
+ cmp.l #4,oflags { check if rewrite mode ... }
+ bne @opencont2
+ { rewrite mode - create new file }
+ move.w #0,-(sp)
+ move.l p,-(sp)
+ move.w #$3c,-(sp)
+ trap #1
+ add.l #8,sp { restore stack of os call }
+ bra @end
+ { reset - open existing files }
+ @opencont2:
+ move.l oflags,d0 { use flag as source ... }
+ @opencont1:
+ move.w d0,-(sp)
+ move.l p,-(sp)
+ move.w #$3d,-(sp)
+ trap #1
+ add.l #8,sp { restore stack of os call }
+ @end:
+ movem.l (sp)+,d2/d3/a2/a3
+
+ tst.w d0
+ bpl @opennoerr { if positive return values then ok }
+ cmp.w #-1,d0 { if handle is -1 CON: }
+ beq @opennoerr
+ cmp.w #-2,d0 { if handle is -2 AUX: }
+ beq @opennoerr
+ cmp.w #-3,d0 { if handle is -3 PRN: }
+ beq @opennoerr
+ move.w d0,errno { otherwise normal error }
+ @opennoerr:
+ move.w d0,i { get handle as SIGNED VALUE... }
+ end;
+ if errno <> 0 then
+ Error2InOut;
+ filerec(f).handle:=i;
+ if ((flags and $100) <> 0) and
+ (FileRec (F).Handle <> UnusedHandle) then
+ do_seekend(filerec(f).handle);
+end;
+
+{*****************************************************************************
+ UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+ Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+ Text File Handling
+*****************************************************************************}
+
+{$i text.inc}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+procedure DosDir(func:byte;const s:string);
+var
+ buffer : array[0..255] of char;
+ c : word;
+begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ AllowSlash(pchar(@buffer));
+ c:=word(func);
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ pea buffer
+ move.w c,-(sp)
+ trap #1
+ add.l #6,sp
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ tst.w d0
+ beq @dosdirend
+ move.w d0,errno
+ @dosdirend:
+ end;
+ if errno <> 0 then
+ Error2InOut;
+end;
+
+
+procedure mkdir(const s : string);[IOCheck];
+begin
+ If InOutRes <> 0 then exit;
+ DosDir($39,s);
+end;
+
+
+procedure rmdir(const s : string);[IOCheck];
+begin
+ If InOutRes <> 0 then exit;
+ DosDir($3a,s);
+end;
+
+
+procedure chdir(const s : string);[IOCheck];
+begin
+ If InOutRes <> 0 then exit;
+ DosDir($3b,s);
+end;
+
+
+function GetDirIO (DriveNr: byte; var Dir: ShortString): word;
+ [public, alias: 'FPC_GETDIRIO'];
+var
+ temp : array[0..255] of char;
+ i : longint;
+ j: byte;
+ drv: word;
+begin
+ GetDirIO := 0;
+ drv:=word(drivenr);
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+
+ { Get dir from drivenr : 0=default, 1=A etc... }
+ move.w drv,-(sp)
+
+ { put (previously saved) offset in si }
+{ move.l temp,-(sp)}
+ pea temp
+
+ { call attos function 47H : Get dir }
+ move.w #$47,-(sp)
+
+ { make the call }
+ trap #1
+ add.l #8,sp
+
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ end;
+ { conversion to pascal string }
+ i:=0;
+ while (temp[i]<>#0) do
+ begin
+ if temp[i]='/' then
+ temp[i]:='\';
+ dir[i+3]:=temp[i];
+ inc(i);
+ end;
+ dir[2]:=':';
+ dir[3]:='\';
+ dir[0]:=char(i+2);
+{ upcase the string (FPC Pascal function) }
+ dir:=upcase(dir);
+ if drivenr<>0 then { Drive was supplied. We know it }
+ dir[1]:=chr(65+drivenr-1)
+ else
+ begin
+ asm
+ move.l d2,d6 { save d2 }
+ movem.l d3/a2/a3,-(sp)
+ move.w #$19,-(sp)
+ trap #1
+ add.l #2,sp
+ move.w d0,drv
+ move.l d6,d2 { restore d2 }
+ movem.l (sp)+,d3/a2/a3
+ end;
+ dir[1]:=chr(byte(drv)+ord('A'));
+ end;
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+
+begin
+ InOutRes := GetDirIO (DriveNr, Dir);
+end;
+
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+Procedure system_exit;
+begin
+end;
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+
+begin
+{ Initialize ExitProc }
+ ExitProc:=Nil;
+{ Setup heap }
+ InitHeap;
+{ Setup stdin, stdout and stderr }
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Reset IO Error }
+ InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate. *)
+ ThreadID := 1;
+ errno := 0;
+{ Setup command line arguments }
+ argc:=GetParamCount(args);
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+end.
+
+{
+ $Log: system.pas,v $
+ Revision 1.14 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.13 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/Makefile b/rtl/beos/Makefile
new file mode 100644
index 0000000000..af48ebf469
--- /dev/null
+++ b/rtl/beos/Makefile
@@ -0,0 +1,1996 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=beos
+override CPU_TARGET_DEFAULT=i386
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=system posix objpas macpas strings beos dos matrix sysutils classes typinfo math varutils cpu mmx getopts heaptrc lineinfo variants types sysconst
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 cprt0 func dllprt
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo sysconst
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+func$(OEXT) : $(CPU_TARGET)/func.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)func$(OEXT) $(CPU_TARGET)/func.as
+dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
+system$(PPUEXT) : system.pp sysfiles.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ system$(PPUEXT)
+beos$(PPUEXT) : beos.pp system$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ beos$(PPUEXT) system$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) beos$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
diff --git a/rtl/beos/Makefile.fpc b/rtl/beos/Makefile.fpc
new file mode 100644
index 0000000000..bc37ca5f44
--- /dev/null
+++ b/rtl/beos/Makefile.fpc
@@ -0,0 +1,167 @@
+#
+# Makefile.fpc for Free Pascal BeOS RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0 cprt0 func dllprt
+units=system posix objpas macpas strings \
+ beos \
+ dos matrix \
+ sysutils classes typinfo math varutils \
+ cpu mmx getopts heaptrc lineinfo variants types sysconst
+rsts=math varutils typinfo sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=beos
+cpu=i386
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+
+UNITPREFIX=rtl
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+func$(OEXT) : $(CPU_TARGET)/func.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)func$(OEXT) $(CPU_TARGET)/func.as
+
+dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
+
+#
+# system Units (system, Objpas, Strings)
+#
+
+system$(PPUEXT) : system.pp sysfiles.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ system$(PPUEXT)
+
+#
+# system Dependent Units
+#
+
+beos$(PPUEXT) : beos.pp system$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ beos$(PPUEXT) system$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) beos$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+
+
+#
+# Other system-dependent RTL Units
+# \ No newline at end of file
diff --git a/rtl/beos/beos.inc b/rtl/beos/beos.inc
new file mode 100644
index 0000000000..5760a15c1a
--- /dev/null
+++ b/rtl/beos/beos.inc
@@ -0,0 +1,550 @@
+{
+ $Id: beos.inc,v 1.3 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 2001 by Carl Eric Codere
+
+
+ Implements BeOS system calls and types
+
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+ ****************************************************************************
+}
+const
+ { BeOS specific calls }
+ syscall_nr_create_area = $14;
+ syscall_nr_resize_area = $08;
+ syscall_nr_delete_area = $15;
+ syscall_nr_load_image = $34;
+ syscall_nr_wait_thread = $22;
+ syscall_nr_rstat = $30;
+ syscall_nr_statfs = $5F;
+ syscall_nr_get_team_info = $3b;
+ syscall_nr_kill_team = $3a;
+ syscall_nr_get_system_info = $56;
+ syscall_nr_kget_tzfilename = $AF;
+ syscall_nr_get_next_image_info = $3C;
+
+const
+{ -----
+ system-wide constants;
+----- *}
+ MAXPATHLEN = PATH_MAX;
+ B_FILE_NAME_LENGTH = NAME_MAX;
+ B_OS_NAME_LENGTH = 32;
+ B_PAGE_SIZE = 4096;
+
+
+
+
+(* -----
+ types
+----- *)
+
+
+type area_id = longint;
+type port_id = longint;
+type sem_id = longint;
+type thread_id = longint;
+type team_id = longint;
+type bigtime_t = int64;
+type status_t = longint;
+
+
+{*************************************************************}
+{*********************** KERNEL KIT **************************}
+{*************************************************************}
+{ ------------------------- Areas --------------------------- }
+const
+ { create_area constant definitions }
+ { lock type }
+ B_NO_LOCK = 0;
+ B_LAZY_LOCK = 1;
+ B_FULL_LOCK = 2;
+ B_CONTIGUOUS = 3;
+ B_LOMEM = 4;
+ { address type }
+ B_ANY_ADDRESS = 0;
+ B_EXACT_ADDRESS = 1;
+ B_BASE_ADDRESS = 2;
+ B_CLONE_ADDRESS = 3;
+ B_ANY_KERNEL_ADDRESS = 4;
+ { protection bits }
+ B_READ_AREA = 1;
+ B_WRITE_AREA = 2;
+
+
+type
+ area_info = packed record
+ area: area_id;
+ name: array[0..B_OS_NAME_LENGTH-1] of char;
+ size: size_t;
+ lock: cardinal;
+ protection: cardinal;
+ team: team_id;
+ ram_size: cardinal;
+ copy_count: cardinal;
+ in_count: cardinal;
+ out_count: cardinal;
+ address: pointer;
+ end;
+
+
+ function create_area(name : pchar; var addr : longint;
+ addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id;
+ var
+ args : SysCallArgs;
+ begin
+ args.param[1] := cint(name);
+ args.param[2] := cint(@addr);
+ args.param[3] := cint(addr_typ);
+ args.param[4] := cint(size);
+ args.param[5] := cint(lock_type);
+ args.param[6] := cint(protection);
+ create_area := SysCall(syscall_nr_create_area, args);
+ end;
+
+
+ function delete_area(area : area_id): status_t;
+ var
+ args: SysCallargs;
+ begin
+ args.param[1] := cint(area);
+ delete_area:= SysCall(syscall_nr_delete_area, args);
+ end;
+
+
+ function resize_area(area: area_id; new_size: size_t): status_t;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := cint(area);
+ args.param[2] := cint(new_size);
+ resize_area := SysCall(syscall_nr_resize_area, args);
+ end;
+
+ { the buffer should at least have MAXPATHLEN+1 bytes in size }
+ function kget_tzfilename(buffer:pchar): cint;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := cint(buffer);
+ kget_tzfilename := SysCall(syscall_nr_kget_tzfilename,args);
+ end;
+
+(*
+extern _IMPEXP_ROOT area_id clone_area(const char *name, void **dest_addr,
+ uint32 addr_spec, uint32 protection,
+ area_id source);
+
+
+extern _IMPEXP_ROOT area_id find_area(const char *name);
+extern _IMPEXP_ROOT area_id area_for(void *addr);
+extern _IMPEXP_ROOT status_t set_area_protection(area_id id,
+ uint32 new_protection);
+
+
+extern _IMPEXP_ROOT status_t _get_area_info(area_id id, area_info *ainfo,
+ size_t size);
+extern _IMPEXP_ROOT status_t _get_next_area_info(team_id team, int32 *cookie,
+ area_info *ainfo, size_t size);
+*)
+{ ------------------------- Threads --------------------------- }
+
+
+
+
+const
+ { thread state }
+ B_THREAD_RUNNING = 1;
+ B_THREAD_READY = 2;
+ B_THREAD_RECEIVING = 3;
+ B_THREAD_ASLEEP = 4;
+ B_THREAD_SUSPENDED = 5;
+ B_THREAD_WAITING = 6;
+ { thread priorities }
+ B_LOW_PRIORITY = 5;
+ B_NORMAL_PRIORITY = 10;
+ B_DISPLAY_PRIORITY = 15;
+ B_URGENT_DISPLAY_PRIORITY = 20;
+ B_REAL_TIME_DISPLAY_PRIORITY= 100;
+ B_URGENT_PRIORITY = 110;
+ B_REAL_TIME_PRIORITY = 120;
+
+
+type
+ thread_info = packed record
+ thread: thread_id;
+ team: team_id;
+ name: array[0..B_OS_NAME_LENGTH-1] of char;
+ state: longint; { thread_state enum }
+ priority:longint;
+ sem:sem_id;
+ user_time:bigtime_t;
+ kernel_time:bigtime_t;
+ stack_base:pointer;
+ stack_end:pointer;
+ end;
+
+
+{
+
+
+extern _IMPEXP_ROOT thread_id spawn_thread (
+ thread_func function_name,
+ const char *thread_name,
+ int32 priority,
+ void *arg
+);
+
+
+extern _IMPEXP_ROOT thread_id find_thread(const char *name);
+extern _IMPEXP_ROOT status_t kill_thread(thread_id thread);
+extern _IMPEXP_ROOT status_t resume_thread(thread_id thread);
+extern _IMPEXP_ROOT status_t suspend_thread(thread_id thread);
+extern _IMPEXP_ROOT status_t rename_thread(thread_id thread, const char *new_name);
+extern _IMPEXP_ROOT status_t set_thread_priority (thread_id thread, int32 new_priority);
+extern _IMPEXP_ROOT void exit_thread(status_t status);
+
+
+extern _IMPEXP_ROOT status_t _get_thread_info(thread_id thread, thread_info *info, size_t size);
+extern _IMPEXP_ROOT status_t _get_next_thread_info(team_id tmid, int32 *cookie, thread_info *info, size_t size);
+
+
+
+
+
+
+extern _IMPEXP_ROOT status_t send_data(thread_id thread,
+ int32 code,
+ const void *buf,
+ size_t buffer_size);
+
+
+extern _IMPEXP_ROOT status_t receive_data(thread_id *sender,
+ void *buf,
+ size_t buffer_size);
+
+
+extern _IMPEXP_ROOT bool has_data(thread_id thread);
+
+
+
+
+extern _IMPEXP_ROOT status_t snooze(bigtime_t microseconds);
+
+
+/*
+ Right now you can only snooze_until() on a single time base, the
+ system time base given by system_time(). The "time" argument is
+ the time (in the future) relative to the current system_time() that
+ you want to snooze until. Eventually there will be multiple time
+ bases (and a way to find out which ones exist) but for now just pass
+ the value B_SYSTEM_TIMEBASE.
+*/
+extern _IMPEXP_ROOT status_t snooze_until(bigtime_t time, int timebase);
+#define B_SYSTEM_TIMEBASE (0)
+
+
+}
+
+
+
+
+ function wait_for_thread(thread: thread_id; var status : status_t): status_t;
+ var
+ args: SysCallArgs;
+ i: longint;
+ begin
+ args.param[1] := cint(thread);
+ args.param[2] := cint(@status);
+ wait_for_thread := SysCall(syscall_nr_wait_thread, args);
+ end;
+
+
+{ ------------------------- Teams --------------------------- }
+
+
+const
+ B_SYSTEM_TEAM = 2;
+
+
+type
+ team_info = packed record
+ team: team_id;
+ image_count: longint;
+ thread_count: longint;
+ area_count: longint;
+ debugger_nub_thread: thread_id;
+ debugger_nub_port: port_id;
+ argc:longint; (* number of args on the command line *)
+ args: array[0..63] of char; {* abbreviated command line args *}
+ uid: uid_t;
+ gid: gid_t;
+ end;
+{
+extern _IMPEXP_ROOT status_t _get_next_team_info(int32 *cookie, team_info *info, size_t size);
+}
+
+
+ function get_team_info(team: team_id; var info : team_info): status_t;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := cint(team);
+ args.param[2] := cint(@info);
+ get_team_info := SysCall(syscall_nr_get_team_info, args);
+ end;
+
+
+ function kill_team(team: team_id): status_t;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := cint(team);
+ kill_team := SysCall(syscall_nr_kill_team, args);
+ end;
+
+
+{ ------------------------- Images --------------------------- }
+
+
+type image_id = longint;
+
+
+ { image types }
+const
+ B_APP_IMAGE = 1;
+ B_LIBRARY_IMAGE = 2;
+ B_ADD_ON_IMAGE = 3;
+ B_SYSTEM_IMAGE = 4;
+type
+ image_info = packed record
+ id : image_id;
+ _type : longint;
+ sequence: longint;
+ init_order: longint;
+ init_routine: pointer;
+ term_routine: pointer;
+ device: dev_t;
+ node: ino_t;
+ name: array[0..MAXPATHLEN-1] of char;
+ text: pointer;
+ data: pointer;
+ text_size: longint;
+ data_size: longint;
+ end;
+
+
+
+ function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := cint(team);
+ args.param[2] := cint(@cookie);
+ args.param[3] := cint(@info);
+ args.param[4] := cint(sizeof(image_info));
+ get_next_image_info := SysCall(syscall_nr_get_next_image_info, args);
+ end;
+
+{
+extern _IMPEXP_ROOT image_id load_add_on(const char *path);
+extern _IMPEXP_ROOT status_t unload_add_on(image_id imid);
+
+
+/* private; use the macros, below */
+extern _IMPEXP_ROOT status_t _get_image_info (image_id image,
+ image_info *info, size_t size);
+extern _IMPEXP_ROOT status_t _get_next_image_info (team_id team, int32 *cookie,
+ image_info *info, size_t size);
+
+
+}
+(*----- symbol types and functions ------------------------*)
+
+
+const B_SYMBOL_TYPE_DATA = $1;
+const B_SYMBOL_TYPE_TEXT = $2;
+const B_SYMBOL_TYPE_ANY = $5;
+{
+extern _IMPEXP_ROOT status_t get_image_symbol(image_id imid,
+ const char *name, int32 sclass, void **ptr);
+extern _IMPEXP_ROOT status_t get_nth_image_symbol(image_id imid, int32 index,
+ char *buf, int32 *bufsize, int32 *sclass,
+ void **ptr);
+}
+
+
+{*----- cache manipulation --------------------------------*}
+const
+ B_FLUSH_DCACHE =$0001; {* dcache = data cache *}
+ B_FLUSH_ICACHE =$0004; {* icache = instruction cache *}
+ B_INVALIDATE_DCACHE =$0002;
+ B_INVALIDATE_ICACHE =$0008;
+
+
+{
+extern _IMPEXP_ROOT void clear_caches(void *addr, size_t len, uint32 flags);
+}
+
+
+ function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id;
+ var
+ args: SysCallArgs;
+ i: longint;
+ begin
+ args.param[1] := cint(argc);
+ args.param[2] := cint(argv);
+ args.param[3] := cint(envp);
+ load_image := SysCall(syscall_nr_load_image, args);
+ end;
+
+
+{ ------------------------ System information --------------------------- }
+{ for both intel and ppc platforms }
+const B_MAX_CPU_COUNT = 8;
+
+
+type
+ system_info = packed record
+ id: array[0..1] of longint; {* unique machine ID *}
+ boot_time: bigtime_t; {* time of boot (# usec since 1/1/70) *}
+ cpu_count: longint; {* # of cpus *}
+ cpu_type: longint; {* type of cpu *}
+ cpu_revision:longint ; {* revision # of cpu *}
+ cpu_infos: array [0..B_MAX_CPU_COUNT-1] of bigtime_t; {* info about individual cpus *}
+ cpu_clock_speed:int64; {* processor clock speed (Hz) *}
+ bus_clock_speed:int64; {* bus clock speed (Hz) * }
+ platform_type:longint; {* type of machine we're on *}
+ max_pages:longint; {* total # physical pages *}
+ used_pages:longint; {* # physical pages in use *}
+ page_faults:longint; {* # of page faults *}
+ max_sems:longint; {* maximum # semaphores *}
+ used_sems:longint; {* # semaphores in use *}
+ max_ports:longint; {* maximum # ports *}
+ used_ports:longint; {* # ports in use *}
+ max_threads:longint; {* maximum # threads *}
+ used_threads:longint; {* # threads in use *}
+ max_teams:longint; {* maximum # teams *}
+ used_teams:longint; {* # teams in use *}
+
+ kernel_name: array[0..B_FILE_NAME_LENGTH-1] of char; {* name of kernel *}
+ kernel_build_date: array[0..B_OS_NAME_LENGTH-1] of char; {* date kernel built *}
+ kernel_build_time: array[0..B_OS_NAME_LENGTH-1] of char; {* time kernel built *}
+ kernel_version:int64; {* version of this kernel *}
+ _busy_wait_time:bigtime_t; {* reserved for Be *}
+ pad:array[1..4] of longint; {* just in case... *}
+ end;
+
+
+ function get_system_info(var info: system_info): status_t;
+ var
+ args: SysCallArgs;
+ i: longint;
+ begin
+ args.param[1] := cint(@info);
+ i := SysCall(syscall_nr_get_system_info, args);
+ get_system_info := i;
+ end;
+
+
+
+
+{*************************************************************}
+{*********************** STORAGE KIT *************************}
+{*************************************************************}
+const
+ { file system flags }
+ B_FS_IS_READONLY = $00000001;
+ B_FS_IS_REMOVABLE = $00000002;
+ B_FS_IS_PERSISTENT = $00000004;
+ B_FS_IS_SHARED = $00000008;
+ B_FS_HAS_MIME = $00010000;
+ B_FS_HAS_ATTR = $00020000;
+ B_FS_HAS_QUERY = $00040000;
+
+
+type
+ fs_info = packed record
+ dev : dev_t; { fs dev_t }
+ root : ino_t; { root ino_t }
+ flags : cardinal; { file system flags }
+ block_size:off_t; { fundamental block size }
+ io_size:off_t; { optimal io size }
+ total_blocks:off_t; { total number of blocks }
+ free_blocks:off_t; { number of free blocks }
+ total_nodes:off_t; { total number of nodes }
+ free_nodes:off_t; { number of free nodes }
+ device_name: array[0..127] of char; { device holding fs }
+ volume_name: array[0..B_FILE_NAME_LENGTH-1] of char;{ volume name }
+ fsh_name : array[0..B_OS_NAME_LENGTH-1] of char;{ name of fs handler }
+ end;
+
+
+ function dev_for_path(const pathname : pchar): dev_t;
+ var
+ args: SysCallArgs;
+ buffer: array[1..15] of longint;
+ i: cint;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(pathname);
+ args.param[3] := cint(@buffer);
+ args.param[4] := $01000000;
+ if SysCall(syscall_nr_rstat, args)=0 then
+ i:=buffer[1]
+ else
+ i:=-1;
+ dev_for_path := i;
+ end;
+
+
+ function fs_stat_dev(device: dev_t; var info: fs_info): dev_t;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := cint(device);
+ args.param[2] := 0;
+ args.param[3] := $FFFFFFFF;
+ args.param[4] := 0;
+ args.param[5] := cint(@info);
+ fs_stat_dev := SysCall(syscall_nr_statfs, args);
+ end;
+
+
+{
+_IMPEXP_ROOT dev_t next_dev(int32 *pos);
+}
+
+
+{*****************************************************************}
+
+
+
+
+
+
+
+
+{
+ $Log: beos.inc,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/beos.pp b/rtl/beos/beos.pp
new file mode 100644
index 0000000000..8e8bf31f67
--- /dev/null
+++ b/rtl/beos/beos.pp
@@ -0,0 +1,384 @@
+unit beos;
+
+interface
+
+type
+ Stat = packed record
+ dev:longint; {"device" that this file resides on}
+ ino:int64; {this file's inode #, unique per device}
+ mode:dword; {mode bits (rwx for user, group, etc)}
+ nlink:longint; {number of hard links to this file}
+ uid:dword; {user id of the owner of this file}
+ gid:dword; {group id of the owner of this file}
+ size:int64; {size of this file (in bytes)}
+ rdev:longint; {device type (not used)}
+ blksize:longint; {preferref block size for i/o}
+ atime:longint; {last access time}
+ mtime:longint; {last modification time}
+ ctime:longint; {last change time, not creation time}
+ crtime:longint; {creation time}
+ end;
+ PStat=^Stat;
+ TStat=Stat;
+
+ ComStr = String[255];
+ PathStr = String[255];
+ DirStr = String[255];
+ NameStr = String[255];
+ ExtStr = String[255];
+
+function FStat(Path:String;Var Info:stat):Boolean;
+function FStat(var f:File;Var Info:stat):Boolean;
+function GetEnv(P: string): pchar;
+
+function FExpand(Const Path: PathStr):PathStr;
+function FSearch(const path:pathstr;dirlist:string):pathstr;
+procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+function Dirname(Const path:pathstr):pathstr;
+function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+function FNMatch(const Pattern,Name:string):Boolean;
+{function StringToPPChar(Var S:STring):ppchar;}
+
+function PExists(path:string):boolean;
+function FExists(path:string):boolean;
+
+Function Shell(const Command:String):Longint;
+
+implementation
+
+uses strings;
+
+{$i filerec.inc}
+{$i textrec.inc}
+
+function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
+
+function FStat(Path:String;Var Info:stat):Boolean;
+{
+ Get all information on a file, and return it in Info.
+}
+var tmp:string;
+var p:pchar;
+begin
+ tmp:=path+#0;
+ p:=@tmp[1];
+ FStat:=(sys_stat($FF000000,p,@Info,0)=0);
+end;
+
+function FStat(var f:File;Var Info:stat):Boolean;
+{
+ Get all information on a file, and return it in Info.
+}
+begin
+ FStat:=(sys_stat($FF000000,PChar(@FileRec(f).Name),@Info,0)=0);
+end;
+
+
+
+Function GetEnv(P:string):Pchar;
+{
+ Searches the environment for a string with name p and
+ returns a pchar to it's value.
+ A pchar is used to accomodate for strings of length > 255
+}
+var
+ ep : ppchar;
+ found : boolean;
+Begin
+ p:=p+'='; {Else HOST will also find HOSTNAME, etc}
+ ep:=envp;
+ found:=false;
+ if ep<>nil then
+ begin
+ while (not found) and (ep^<>nil) do
+ begin
+ if strlcomp(@p[1],(ep^),length(p))=0 then
+ found:=true
+ else
+ inc(ep);
+ end;
+ end;
+ if found then
+ getenv:=ep^+length(p)
+ else
+ getenv:=nil;
+{ writeln ('GETENV (',P,') =',getenv);}
+end;
+
+
+
+Function StringToPPChar(Var S:String; Var nr:longint):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+}
+var
+ Buf : ^char;
+ p : ppchar;
+begin
+ s:=s+#0;
+ buf:=@s[1];
+ nr:=0;
+ while(buf^<>#0) do
+ begin
+ while (buf^ in [' ',#8,#10]) do
+ inc(buf);
+ inc(nr);
+ while not (buf^ in [' ',#0,#8,#10]) do
+ inc(buf);
+ end;
+ getmem(p,nr*4);
+ StringToPPChar:=p;
+ if p=nil then
+ begin
+{ LinuxError:=sys_enomem;}
+ exit;
+ end;
+ buf:=@s[1];
+ while (buf^<>#0) do
+ begin
+ while (buf^ in [' ',#8,#10]) do
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [' ',#0,#8,#10]) do
+ inc(buf);
+ end;
+end;
+
+
+
+{
+function FExpand (const Path: PathStr): PathStr;
+- declared in fexpand.inc
+}
+
+{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
+{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
+
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_GETENVPCHAR}
+{$UNDEF FPC_FEXPAND_TILDE}
+
+
+
+Function FSearch(const path:pathstr;dirlist:string):pathstr;
+{
+ Searches for a file 'path' in the list of direcories in 'dirlist'.
+ returns an empty string if not found. Wildcards are NOT allowed.
+ If dirlist is empty, it is set to '.'
+}
+Var
+ NewDir : PathStr;
+ p1 : Longint;
+ Info : Stat;
+Begin
+{Replace ':' with ';'}
+ for p1:=1to length(dirlist) do
+ if dirlist[p1]=':' then
+ dirlist[p1]:=';';
+{Check for WildCards}
+ If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
+ FSearch:='' {No wildcards allowed in these things.}
+ Else
+ Begin
+ Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
+ Repeat
+ p1:=Pos(';',DirList);
+ If p1=0 Then
+ p1:=255;
+ NewDir:=Copy(DirList,1,P1 - 1);
+ if NewDir[Length(NewDir)]<>'/' then
+ NewDir:=NewDir+'/';
+ NewDir:=NewDir+Path;
+ Delete(DirList,1,p1);
+ if FStat(NewDir,Info) then
+ Begin
+ If Pos('./',NewDir)=1 Then
+ Delete(NewDir,1,2);
+ {DOS strips off an initial .\}
+ End
+ Else
+ NewDir:='';
+ Until (DirList='') or (Length(NewDir) > 0);
+ FSearch:=NewDir;
+ End;
+End;
+
+
+
+Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+Var
+ DotPos,SlashPos,i : longint;
+Begin
+ SlashPos:=0;
+ DotPos:=256;
+ i:=Length(Path);
+ While (i>0) and (SlashPos=0) Do
+ Begin
+ If (DotPos=256) and (Path[i]='.') Then
+ DotPos:=i;
+ If (Path[i]='/') Then
+ SlashPos:=i;
+ Dec(i);
+ End;
+ Ext:=Copy(Path,DotPos,255);
+ Dir:=Copy(Path,1,SlashPos);
+ Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
+End;
+
+
+
+Function Dirname(Const path:pathstr):pathstr;
+{
+ This function returns the directory part of a complete path.
+ Unless the directory is root '/', The last character is not
+ a slash.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if length(Dir)>1 then
+ Delete(Dir,length(Dir),1);
+ DirName:=Dir;
+end;
+
+
+
+Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+{
+ This function returns the filename part of a complete path. If suf is
+ supplied, it is cut off the filename.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if Suf<>Ext then
+ Name:=Name+Ext;
+ BaseName:=Name;
+end;
+
+
+
+Function FNMatch(const Pattern,Name:string):Boolean;
+Var
+ LenPat,LenName : longint;
+
+ Function DoFNMatch(i,j:longint):Boolean;
+ Var
+ Found : boolean;
+ Begin
+ Found:=true;
+ While Found and (i<=LenPat) Do
+ Begin
+ Case Pattern[i] of
+ '?' : Found:=(j<=LenName);
+ '*' : Begin
+ {find the next character in pattern, different of ? and *}
+ while Found and (i<LenPat) do
+ begin
+ inc(i);
+ case Pattern[i] of
+ '*' : ;
+ '?' : begin
+ inc(j);
+ Found:=(j<=LenName);
+ end;
+ else
+ Found:=false;
+ end;
+ end;
+ {Now, find in name the character which i points to, if the * or ?
+ wasn't the last character in the pattern, else, use up all the
+ chars in name}
+ Found:=true;
+ if (i<=LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j<=LenName) and (name[j]<>pattern[i]) do
+ inc (j);
+ if (j<LenName) then
+ begin
+ if DoFnMatch(i+1,j+1) then
+ begin
+ i:=LenPat;
+ j:=LenName;{we can stop}
+ Found:=true;
+ end
+ else
+ inc(j);{We didn't find one, need to look further}
+ end;
+ until (j>=LenName);
+ end
+ else
+ j:=LenName;{we can stop}
+ end;
+ else {not a wildcard character in pattern}
+ Found:=(j<=LenName) and (pattern[i]=name[j]);
+ end;
+ inc(i);
+ inc(j);
+ end;
+ DoFnMatch:=Found and (j>LenName);
+ end;
+
+Begin {start FNMatch}
+ LenPat:=Length(Pattern);
+ LenName:=Length(Name);
+ FNMatch:=DoFNMatch(1,1);
+End;
+
+
+function PExists(path:string):boolean;
+begin
+ PExists:=FExists(path);
+end;
+
+function FExists(path:string):boolean;
+var
+ info:stat;
+begin
+ FExists:=Fstat(path,info);
+end;
+
+function sys_load_image(a:cardinal; argp:ppchar; envp:ppchar):longint; cdecl; external name 'sys_load_image';
+function sys_wait_for_thread (th:longint; var exitcode:longint):longint; cdecl; external name 'sys_wait_for_thread';
+
+Function Shell(const Command:String):Longint;
+var s:string;
+ argv:ppchar;
+ argc:longint;
+ th:longint;
+begin
+ s:=Command;
+ argv:=StringToPPChar(s,argc);
+ th:=0;
+{ writeln ('argc = ',argc);
+ while argv[th]<>Nil do begin
+ writeln ('argv[',th,'] = ',argv[th]);
+ th:=th+1;
+ end;
+}
+ th:=sys_load_image(argc,argv,system.envp);
+ if th<0 then begin
+ shell:=0;
+ exit;
+ end;
+ sys_wait_for_thread(th,Shell);
+end;
+
+
+
+end.
diff --git a/rtl/beos/dos.pp b/rtl/beos/dos.pp
new file mode 100644
index 0000000000..5a4e24f7d5
--- /dev/null
+++ b/rtl/beos/dos.pp
@@ -0,0 +1,827 @@
+{
+ $Id: dos.pp,v 1.13 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by members of the Free Pascal
+ development team
+
+ DOS unit template based on POSIX
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit Dos;
+
+Interface
+
+{$goto on}
+
+Const
+ FileNameLen = 255;
+
+Type
+ SearchRec = packed Record
+ {Fill : array[1..21] of byte; Fill replaced with below}
+ DirPtr : pointer; {directory pointer for reading directory}
+ SearchAttr : Byte; {attribute we are searching for}
+ Fill : Array[1..16] of Byte; {future use}
+ {End of fill}
+ Attr : Byte; {attribute of found file}
+ Time : LongInt; {last modify date of found file}
+ Size : LongInt; {file size of found file}
+ Reserved : Word; {future use}
+ Name : String[FileNameLen]; {name of found file}
+ SearchSpec : String[FileNameLen]; {search pattern}
+ SearchDir : String[FileNameLen]; { path we are searching in }
+ End;
+
+{$DEFINE HAS_FILENAMELEN}
+{$I dosh.inc}
+
+Procedure AddDisk(const path:string);
+
+Implementation
+
+Uses
+ strings,posix;
+
+(* Potentially needed FPC_FEXPAND_* defines should be defined here. *)
+{$I dos.inc}
+
+ { Used by AddDisk(), DiskFree() and DiskSize() }
+const
+ Drives : byte = 4;
+ MAX_DRIVES = 26;
+var
+ DriveStr : array[4..MAX_DRIVES] of pchar;
+
+
+Function StringToPPChar(Var S:STring; var count : longint):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+}
+var
+ nr : longint;
+ Buf : ^char;
+ p : ppchar;
+begin
+ s:=s+#0;
+ buf:=@s[1];
+ nr:=0;
+ while(buf^<>#0) do
+ begin
+ while (buf^ in [' ',#8,#10]) do
+ inc(buf);
+ inc(nr);
+ while not (buf^ in [' ',#0,#8,#10]) do
+ inc(buf);
+ end;
+ getmem(p,nr*4);
+ StringToPPChar:=p;
+ if p=nil then
+ begin
+ Errno:=sys_enomem;
+ count := 0;
+ exit;
+ end;
+ buf:=@s[1];
+ while (buf^<>#0) do
+ begin
+ while (buf^ in [' ',#8,#10]) do
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [' ',#0,#8,#10]) do
+ inc(buf);
+ end;
+ count := nr;
+end;
+
+
+{$i dos_beos.inc} { include OS specific stuff }
+
+
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+var
+ TZSeconds : longint; { offset to add/ subtract from Epoch to get local time }
+ tzdaylight : boolean;
+ tzname : array[boolean] of pchar;
+
+
+type
+ GTRec = packed Record
+ Year,
+ Month,
+ MDay,
+ WDay,
+ Hour,
+ Minute,
+ Second : Word;
+ End;
+Const
+{Date Calculation}
+ C1970 = 2440588;
+ D0 = 1461;
+ D1 = 146097;
+ D2 = 1721119;
+
+
+function WeekDay (y,m,d:longint):longint;
+{
+ Calculates th day of the week. returns -1 on error
+}
+var
+ u,v : longint;
+begin
+ if (m<1) or (m>12) or (y<1600) or (y>4000) or
+ (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
+ ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
+ WeekDay:=-1
+ else
+ begin
+ u:=m;
+ v:=y;
+ if m<3 then
+ begin
+ inc(u,12);
+ dec(v);
+ end;
+ WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
+ end;
+end;
+
+
+
+
+Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
+Var
+ YYear,XYear,Temp,TempMonth : LongInt;
+Begin
+ Temp:=((JulianDN-D2) shl 2)-1;
+ JulianDN:=Temp Div D1;
+ XYear:=(Temp Mod D1) or 3;
+ YYear:=(XYear Div D0);
+ Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
+ Day:=((Temp Mod 153)+5) Div 5;
+ TempMonth:=Temp Div 153;
+ If TempMonth>=10 Then
+ Begin
+ inc(YYear);
+ dec(TempMonth,12);
+ End;
+ inc(TempMonth,3);
+ Month := TempMonth;
+ Year:=YYear+(JulianDN*100);
+end;
+
+
+
+Procedure EpochToLocal(epoch:time_t;var year,month,day,hour,minute,second:Word);
+{
+ Transforms Epoch time into local time (hour, minute,seconds)
+}
+Var
+ DateNum: time_t;
+Begin
+ Epoch:=Epoch+TZSeconds;
+ Datenum:=(Epoch Div 86400) + c1970;
+ JulianToGregorian(DateNum,Year,Month,day);
+ Epoch:=Abs(Epoch Mod 86400);
+ Hour:=Epoch Div 3600;
+ Epoch:=Epoch Mod 3600;
+ Minute:=Epoch Div 60;
+ Second:=Epoch Mod 60;
+End;
+
+
+
+Procedure GetDate(Var Year, Month, MDay, WDay: Word);
+var
+ hour,minute,second : word;
+ timeval : time_t;
+Begin
+ timeval := sys_time(timeval);
+ { convert the GMT time to local time }
+ EpochToLocal(timeval,year,month,mday,hour,minute,second);
+ Wday:=weekday(Year,Month,MDay);
+end;
+
+
+
+Procedure SetDate(Year, Month, Day: Word);
+Begin
+ {!!}
+End;
+
+
+
+
+Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
+var
+ timeval : time_t;
+ year,month,day: word;
+Begin
+ timeval := sys_time(timeval);
+ EpochToLocal(timeval,year,month,day,hour,minute,second);
+ Sec100 := 0;
+end;
+
+
+
+Procedure SetTime(Hour, Minute, Second, Sec100: Word);
+Begin
+ {!!}
+End;
+
+
+Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
+Begin
+ EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
+End;
+
+
+{$ifndef DOS_HAS_EXEC}
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+Function InternalWaitProcess(Pid:pid_t):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+var r,s : cint;
+begin
+ repeat
+ s:=$7F00;
+ r:=sys_WaitPid(Pid,s,0);
+ until (r<>-1) or (Errno<>Sys_EINTR);
+ { When r = -1 or r = 0, no status is available, so there was an error. }
+ if (r=-1) or (r=0) then
+ InternalWaitProcess:=-1 { return -1 to indicate an error }
+ else
+ begin
+ { process terminated normally }
+ if wifexited(s)<>0 then
+ begin
+ { get status code }
+ InternalWaitProcess := wexitstatus(s);
+ exit;
+ end;
+ { process terminated due to a signal }
+ if wifsignaled(s)<>0 then
+ begin
+ { get signal number }
+ InternalWaitProcess := wstopsig(s);
+ exit;
+ end;
+ InternalWaitProcess:=-1;
+ end;
+end;
+
+
+
+
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+var
+ pid : pid_t;
+ tmp : string;
+ p : ppchar;
+ count: longint;
+ // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
+ F: File;
+Begin
+{$IFOPT I+}
+{$DEFINE IOCHECK}
+{$ENDIF}
+{$I-}
+ { verify if the file to execute exists }
+ Assign(F,Path);
+ Reset(F,1);
+ if IOResult <> 0 then
+ { file not found }
+ begin
+ DosError := 2;
+ exit;
+ end
+ else
+ Close(F);
+{$IFDEF IOCHECK}
+{$I+}
+{$UNDEF IOCHECK}
+{$ENDIF}
+ LastDosExitCode:=0;
+ { Fork the process }
+ pid:=sys_Fork;
+ if pid=0 then
+ begin
+ {The child does the actual execution, and then exits}
+ tmp := Path+' '+ComLine;
+ p:=StringToPPChar(tmp,count);
+ if (p<>nil) and (p^<>nil) then
+ begin
+ sys_Execve(p^,p,Envp);
+ end;
+ {If the execve fails, we return an exitvalue of 127, to let it be known}
+ sys_exit(127);
+ end
+ else
+ if pid=-1 then {Fork failed - parent only}
+ begin
+ DosError:=8;
+ exit
+ end;
+{We're in the parent, let's wait.}
+ LastDosExitCode:=InternalWaitProcess(pid); // WaitPid and result-convert
+ if (LastDosExitCode>=0) and (LastDosExitCode<>127) then DosError:=0 else
+ DosError:=8; // perhaps one time give an better error
+End;
+{$ENDIF}
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+
+Function FNMatch(const Pattern,Name:string):Boolean;
+Var
+ LenPat,LenName : longint;
+
+ Function DoFNMatch(i,j:longint):Boolean;
+ Var
+ Found : boolean;
+ Begin
+ Found:=true;
+ While Found and (i<=LenPat) Do
+ Begin
+ Case Pattern[i] of
+ '?' : Found:=(j<=LenName);
+ '*' : Begin
+ {find the next character in pattern, different of ? and *}
+ while Found and (i<LenPat) do
+ begin
+ inc(i);
+ case Pattern[i] of
+ '*' : ;
+ '?' : begin
+ inc(j);
+ Found:=(j<=LenName);
+ end;
+ else
+ Found:=false;
+ end;
+ end;
+ {Now, find in name the character which i points to, if the * or ?
+ wasn't the last character in the pattern, else, use up all the
+ chars in name}
+ Found:=true;
+ if (i<=LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j<=LenName) and (name[j]<>pattern[i]) do
+ inc (j);
+ if (j<LenName) then
+ begin
+ if DoFnMatch(i+1,j+1) then
+ begin
+ i:=LenPat;
+ j:=LenName;{we can stop}
+ Found:=true;
+ end
+ else
+ inc(j);{We didn't find one, need to look further}
+ end;
+ until (j>=LenName);
+ end
+ else
+ j:=LenName;{we can stop}
+ end;
+ else {not a wildcard character in pattern}
+ Found:=(j<=LenName) and (pattern[i]=name[j]);
+ end;
+ inc(i);
+ inc(j);
+ end;
+ DoFnMatch:=Found and (j>LenName);
+ end;
+
+Begin {start FNMatch}
+ LenPat:=Length(Pattern);
+ LenName:=Length(Name);
+ FNMatch:=DoFNMatch(1,1);
+End;
+
+
+Procedure FindClose(Var f: SearchRec);
+{
+ Closes dirptr if it is open
+}
+Begin
+ { could already have been closed }
+ if assigned(f.dirptr) then
+ sys_closedir(pdir(f.dirptr));
+ f.dirptr := nil;
+End;
+
+
+{ Returns a filled in searchRec structure }
+{ and TRUE if the specified file in s is }
+{ found. }
+Function FindGetFileInfo(s:string;var f:SearchRec):boolean;
+var
+ DT : DateTime;
+ st : stat;
+ Fmode : byte;
+ res: string; { overlaid variable }
+ Dir : DirsTr;
+ Name : NameStr;
+ Ext: ExtStr;
+begin
+ FindGetFileInfo:=false;
+ res := s + #0;
+ if sys_stat(@res[1],st)<>0 then
+ exit;
+ if S_ISDIR(st.st_mode) then
+ fmode:=directory
+ else
+ fmode:=0;
+ if (st.st_mode and S_IWUSR)=0 then
+ fmode:=fmode or readonly;
+ FSplit(s,Dir,Name,Ext);
+ if Name[1]='.' then
+ fmode:=fmode or hidden;
+ If ((FMode and Not(f.searchattr))=0) Then
+ Begin
+ if Ext <> '' then
+ res := Name + Ext
+ else
+ res := Name;
+ f.Name:=res;
+ f.Attr:=FMode;
+ f.Size:=longint(st.st_size);
+ UnixDateToDT(st.st_mtime, DT);
+ PackTime(DT,f.Time);
+ FindGetFileInfo:=true;
+ End;
+end;
+
+
+Procedure FindNext(Var f: SearchRec);
+{
+ re-opens dir if not already in array and calls FindWorkProc
+}
+Var
+ FName,
+ SName : string;
+ Found,
+ Finished : boolean;
+ p : PDirEnt;
+Begin
+{Main loop}
+ SName:=f.SearchSpec;
+ Found:=False;
+ Finished:=(f.dirptr=nil);
+ While Not Finished Do
+ Begin
+ p:=sys_readdir(pdir(f.dirptr));
+ if p=nil then
+ begin
+ FName:=''
+ end
+ else
+ FName:=Strpas(@p^.d_name);
+ If FName='' Then
+ Finished:=True
+ Else
+ Begin
+ If FNMatch(SName,FName) Then
+ Begin
+ Found:=FindGetFileInfo(f.SearchDir+FName,f);
+ if Found then
+ begin
+ Finished:=true;
+ end;
+ End;
+ End;
+ End;
+{Shutdown}
+ If Found Then
+ Begin
+ DosError:=0;
+ End
+ Else
+ Begin
+ FindClose(f);
+ { FindClose() might be called thereafter also... }
+ f.dirptr := nil;
+ DosError:=18;
+ End;
+End;
+
+
+Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
+{
+ opens dir
+}
+var
+ res: string;
+ Dir : DirsTr;
+ Name : NameStr;
+ Ext: ExtStr;
+Begin
+ { initialize f.dirptr because it is used }
+ { to see if we need to close the dir stream }
+ f.dirptr := nil;
+ if Path='' then
+ begin
+ DosError:=3;
+ exit;
+ end;
+ {We always also search for readonly and archive, regardless of Attr:}
+ f.SearchAttr := Attr or archive or readonly;
+{Wildcards?}
+ if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
+ begin
+ if FindGetFileInfo(Path,f) then
+ DosError:=0
+ else
+ begin
+ if ErrNo=Sys_ENOENT then
+ DosError:=3
+ else
+ DosError:=18;
+ end;
+ f.DirPtr:=nil;
+ end
+ else
+{Find Entry}
+ begin
+ FSplit(Path,Dir,Name,Ext);
+ if Ext <> '' then
+ res := Name + Ext
+ else
+ res := Name;
+ f.SearchSpec := res;
+ { if dir is an empty string }
+ { then this indicates that }
+ { use the current working }
+ { directory. }
+ if dir = '' then
+ dir := './';
+ f.SearchDir := Dir;
+ { add terminating null character }
+ Dir := Dir + #0;
+ f.dirptr := sys_opendir(@Dir[1]);
+ if not assigned(f.dirptr) then
+ begin
+ DosError := 8;
+ exit;
+ end;
+ FindNext(f);
+ end;
+End;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+
+Function FSearch(const path:pathstr;dirlist:string):pathstr;
+{
+ Searches for a file 'path' in the list of direcories in 'dirlist'.
+ returns an empty string if not found. Wildcards are NOT allowed.
+ If dirlist is empty, it is set to '.'
+}
+Var
+ NewDir : PathStr;
+ p1 : Longint;
+ Info : Stat;
+ buffer : array[0..FileNameLen+1] of char;
+Begin
+ Move(path[1], Buffer, Length(path));
+ Buffer[Length(path)]:=#0;
+ if (length(Path)>0) and (path[1]='/') and (sys_stat(pchar(@Buffer),info)=0) then
+ begin
+ FSearch:=path;
+ exit;
+ end;
+{Replace ':' with ';'}
+ for p1:=1to length(dirlist) do
+ if dirlist[p1]=':' then
+ dirlist[p1]:=';';
+{Check for WildCards}
+ If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
+ FSearch:='' {No wildcards allowed in these things.}
+ Else
+ Begin
+ Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
+ Repeat
+ p1:=Pos(';',DirList);
+ If p1=0 Then
+ p1:=255;
+ NewDir:=Copy(DirList,1,P1 - 1);
+ if NewDir[Length(NewDir)]<>'/' then
+ NewDir:=NewDir+'/';
+ NewDir:=NewDir+Path;
+ Delete(DirList,1,p1);
+ Move(NewDir[1], Buffer, Length(NewDir));
+ Buffer[Length(NewDir)]:=#0;
+ if sys_stat(pchar(@Buffer),Info)=0 then
+ Begin
+ If Pos('./',NewDir)=1 Then
+ Delete(NewDir,1,2);
+ {DOS strips off an initial .\}
+ End
+ Else
+ NewDir:='';
+ Until (DirList='') or (Length(NewDir) > 0);
+ FSearch:=NewDir;
+ End;
+End;
+
+
+
+Procedure GetFAttr(var f; var attr : word);
+Var
+ info : stat;
+ LinAttr : mode_t;
+Begin
+ DosError:=0;
+ if sys_stat(@textrec(f).name,info)<>0 then
+ begin
+ Attr:=0;
+ DosError:=3;
+ exit;
+ end
+ else
+ LinAttr:=Info.st_Mode;
+ if S_ISDIR(LinAttr) then
+ Attr:=directory
+ else
+ Attr:=0;
+ if sys_Access(@textrec(f).name,W_OK)<>0 then
+ Attr:=Attr or readonly;
+ if (filerec(f).name[0]='.') then
+ Attr:=Attr or hidden;
+end;
+
+
+
+Procedure getftime (var f; var time : longint);
+Var
+ Info: stat;
+ DT: DateTime;
+Begin
+ doserror:=0;
+ if sys_fstat(filerec(f).handle,info)<>0 then
+ begin
+ Time:=0;
+ doserror:=3;
+ exit
+ end
+ else
+ UnixDateToDT(Info.st_mtime,DT);
+ PackTime(DT,Time);
+End;
+
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+Function EnvCount: Longint;
+var
+ envcnt : longint;
+ p : ppchar;
+Begin
+ envcnt:=0;
+ p:=envp; {defined in syslinux}
+ while (p^<>nil) do
+ begin
+ inc(envcnt);
+ inc(p);
+ end;
+ EnvCount := envcnt
+End;
+
+
+
+Function EnvStr (Index: longint): String;
+Var
+ i : longint;
+ p : ppchar;
+Begin
+ p:=envp; {defined in syslinux}
+ i:=1;
+ envstr:='';
+ if (index < 1) or (index > EnvCount) then
+ exit;
+ while (i<Index) and (p^<>nil) do
+ begin
+ inc(i);
+ inc(p);
+ end;
+ if p<>nil then
+ envstr:=strpas(p^)
+End;
+
+
+Function GetEnv(EnvVar:string):string;
+{
+ Searches the environment for a string with name p and
+ returns a pchar to it's value.
+ A pchar is used to accomodate for strings of length > 255
+}
+var
+ ep : ppchar;
+ found : boolean;
+ p1 : pchar;
+Begin
+ EnvVar:=EnvVar+'='; {Else HOST will also find HOSTNAME, etc}
+ ep:=envp;
+ found:=false;
+ if ep<>nil then
+ begin
+ while (not found) and (ep^<>nil) do
+ begin
+ if strlcomp(@EnvVar[1],(ep^),length(EnvVar))=0 then
+ found:=true
+ else
+ inc(ep);
+ end;
+ end;
+ if found then
+ p1:=ep^+length(EnvVar)
+ else
+ p1:=nil;
+ if p1 = nil then
+ GetEnv := ''
+ else
+ GetEnv := StrPas(p1);
+end;
+
+
+
+Procedure setftime(var f; time : longint);
+Begin
+ {! No POSIX equivalent !}
+End;
+
+
+
+Procedure setfattr (var f;attr : word);
+Begin
+ {! No POSIX equivalent !}
+End;
+
+
+
+{ Include timezone routines }
+{$i timezone.inc}
+
+{******************************************************************************
+ --- Initialization ---
+******************************************************************************}
+
+Initialization
+ InitLocalTime;
+
+finalization
+ DoneLocalTime;
+end.
+{
+ $Log: dos.pp,v $
+ Revision 1.13 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/dos_beos.inc b/rtl/beos/dos_beos.inc
new file mode 100644
index 0000000000..f163794bd8
--- /dev/null
+++ b/rtl/beos/dos_beos.inc
@@ -0,0 +1,150 @@
+{
+ $Id: dos_beos.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by members of the Free Pascal
+ development team
+
+ Operating system specific calls for DOS unit (part of POSIX interface)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$i syscall.inc}
+{$i beos.inc}
+
+{$define DOS_HAS_EXEC}
+
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+ The drive names are OS specific
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.', { the current directory }
+ '/disk 0/.', { mounted floppy 1 }
+ '/disk 1/.', { mounted floppy 2 }
+ '/boot/.' { the boot up disk }
+ );
+
+
+Function DosVersion:Word;
+Begin
+ DosVersion := 0;
+End;
+
+
+
+Function DiskFree(Drive: Byte): int64;
+var
+ info: fs_info;
+ device : dev_t;
+Begin
+ device := 0;
+ DiskFree := -1;
+ if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
+ begin
+ device:= dev_for_path(FixDriveStr[Drive]);
+ end
+ else
+ if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
+ device := dev_for_path(driveStr[drive])
+ else
+ begin
+ exit;
+ end;
+ if fs_Stat_dev(device,info)=0 then
+ DiskFree := int64(info.block_size)*int64(info.free_blocks);
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+var
+ info: fs_info;
+ device : dev_t;
+Begin
+ device := 0;
+ DiskSize:= -1;
+ if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
+ begin
+ device:= dev_for_path(FixDriveStr[Drive]);
+ end
+ else
+ if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
+ device := dev_for_path(driveStr[drive])
+ else
+ begin
+ exit;
+ end;
+ if fs_Stat_dev(device,info)=0 then
+ DiskSize := int64(info.block_size)*int64(info.total_blocks);
+End;
+
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+Procedure Exec(const path: pathstr; const comline: comstr);
+var p:string;
+ argv:ppchar;
+ argc:longint;
+ th:thread_id;
+ status : status_t;
+begin
+ LastDosExitCode:=0;
+ DosError:= 0;
+ p:=path+' '+comline;
+ argv:=StringToPPChar(p,argc);
+ th:=load_image(argc,argv,system.envp);
+ if th<0 then begin
+ DosError:=5; { lets emulate an error }
+ exit;
+ end;
+ wait_for_thread(th,status);
+ LastDosExitCode:=status and $FF; { only keep the lower 8-bits }
+end;
+
+
+function GetTimeZoneString : string;
+begin
+ GetTimeZoneString:=getenv('TZ');
+end;
+
+function GetTimezoneFile:string;
+var
+ f,len : longint;
+ s : string;
+ info : stat;
+ buffer : array[0..MAXPATHLEN+1] of char;
+begin
+ GetTimezoneFile:='';
+
+ if kget_tzfilename(pchar(@buffer))=0 then
+ begin
+ GetTimeZoneFile := strpas(pchar(@buffer));
+ end;
+end;
+
+
+{
+ $Log: dos_beos.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/errno.inc b/rtl/beos/errno.inc
new file mode 100644
index 0000000000..db5df96267
--- /dev/null
+++ b/rtl/beos/errno.inc
@@ -0,0 +1,215 @@
+{
+ $Id: errno.inc,v 1.3 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ BeOS POSIX compliant error codes
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+{----- Error baselines ---------------------------------------}
+
+ B_GENERAL_ERROR_BASE = -2147483647-1;
+ B_OS_ERROR_BASE = B_GENERAL_ERROR_BASE + $1000;
+ B_APP_ERROR_BASE = B_GENERAL_ERROR_BASE + $2000;
+ B_INTERFACE_ERROR_BASE = B_GENERAL_ERROR_BASE + $3000;
+ B_MEDIA_ERROR_BASE = B_GENERAL_ERROR_BASE + $4000; {* - $41ff *}
+ B_TRANSLATION_ERROR_BASE = B_GENERAL_ERROR_BASE + $4800; {* - $48ff *}
+ B_MIDI_ERROR_BASE = B_GENERAL_ERROR_BASE + $5000;
+ B_STORAGE_ERROR_BASE = B_GENERAL_ERROR_BASE + $6000;
+ B_POSIX_ERROR_BASE = B_GENERAL_ERROR_BASE + $7000;
+ B_MAIL_ERROR_BASE = B_GENERAL_ERROR_BASE + $8000;
+ B_PRINT_ERROR_BASE = B_GENERAL_ERROR_BASE + $9000;
+ B_DEVICE_ERROR_BASE = B_GENERAL_ERROR_BASE + $a000;
+
+{--- Developer-defined errors start at (B_ERRORS_END+1)----}
+
+ B_ERRORS_END = (B_GENERAL_ERROR_BASE + $ffff);
+
+type
+{----- General Errors ----------------------------------------}
+tgeneralerrors= (
+ B_NO_MEMORY := B_GENERAL_ERROR_BASE,
+ B_IO_ERROR,
+ B_PERMISSION_DENIED,
+ B_BAD_INDEX,
+ B_BAD_TYPE,
+ B_BAD_VALUE,
+ B_MISMATCHED_VALUES,
+ B_NAME_NOT_FOUND,
+ B_NAME_IN_USE,
+ B_TIMED_OUT,
+ B_INTERRUPTED,
+ B_WOULD_BLOCK,
+ B_CANCELED,
+ B_NO_INIT,
+ B_BUSY,
+ B_NOT_ALLOWED,
+
+ B_ERROR := -1,
+ B_OK := 0,
+ B_NO_ERROR := 0
+);
+
+{----- Kernel Kit Errors -------------------------------------}
+tkernelerror = (
+ B_BAD_SEM_ID := B_OS_ERROR_BASE,
+ B_NO_MORE_SEMS,
+
+ B_BAD_THREAD_ID := B_OS_ERROR_BASE + $100,
+ B_NO_MORE_THREADS,
+ B_BAD_THREAD_STATE,
+ B_BAD_TEAM_ID,
+ B_NO_MORE_TEAMS,
+
+ B_BAD_PORT_ID := B_OS_ERROR_BASE + $200,
+ B_NO_MORE_PORTS,
+
+ B_BAD_IMAGE_ID := B_OS_ERROR_BASE + $300,
+ B_BAD_ADDRESS,
+ B_NOT_AN_EXECUTABLE,
+ B_MISSING_LIBRARY,
+ B_MISSING_SYMBOL,
+
+ B_DEBUGGER_ALREADY_INSTALLED := B_OS_ERROR_BASE + $400
+);
+
+
+{----- Application Kit Errors --------------------------------}
+tapperrors =
+(
+ B_BAD_REPLY := B_APP_ERROR_BASE,
+ B_DUPLICATE_REPLY,
+ B_MESSAGE_TO_SELF,
+ B_BAD_HANDLER,
+ B_ALREADY_RUNNING,
+ B_LAUNCH_FAILED,
+ B_AMBIGUOUS_APP_LAUNCH,
+ B_UNKNOWN_MIME_TYPE,
+ B_BAD_SCRIPT_SYNTAX,
+ B_LAUNCH_FAILED_NO_RESOLVE_LINK,
+ B_LAUNCH_FAILED_EXECUTABLE,
+ B_LAUNCH_FAILED_APP_NOT_FOUND,
+ B_LAUNCH_FAILED_APP_IN_TRASH,
+ B_LAUNCH_FAILED_NO_PREFERRED_APP,
+ B_LAUNCH_FAILED_FILES_APP_NOT_FOUND
+);
+
+
+{----- Storage Kit/File System Errors ------------------------}
+tfserrors= (
+ B_FILE_ERROR :=B_STORAGE_ERROR_BASE,
+ B_FILE_NOT_FOUND, { discouraged; use B_ENTRY_NOT_FOUND in new code }
+ B_FILE_EXISTS,
+ B_ENTRY_NOT_FOUND,
+ B_NAME_TOO_LONG,
+ B_NOT_A_DIRECTORY,
+ B_DIRECTORY_NOT_EMPTY,
+ B_DEVICE_FULL,
+ B_READ_ONLY_DEVICE,
+ B_IS_A_DIRECTORY,
+ B_NO_MORE_FDS,
+ B_CROSS_DEVICE_LINK,
+ B_LINK_LIMIT,
+ B_BUSTED_PIPE,
+ B_UNSUPPORTED,
+ B_PARTITION_TOO_SMALL
+);
+
+
+const
+
+{***********************************************************************}
+{ POSIX ERROR DEFINITIONS }
+{***********************************************************************}
+
+ { The following constants are system dependent but must all exist }
+ Sys_E2BIG = (B_POSIX_ERROR_BASE + 1);
+ Sys_EACCES = ord(B_PERMISSION_DENIED);
+ Sys_EAGAIN = ord(B_WOULD_BLOCK);
+ Sys_EBADF = ord(B_FILE_ERROR);
+ Sys_EBUSY = ord(B_BUSY);
+ Sys_ECHILD = (B_POSIX_ERROR_BASE + 2);
+ Sys_EDEADLK = (B_POSIX_ERROR_BASE + 3);
+ Sys_EDOM = (B_POSIX_ERROR_BASE + 16);
+ Sys_EEXIST = ord(B_FILE_EXISTS);
+ Sys_EFAULT = ord(B_BAD_ADDRESS);
+ Sys_EFBIG = (B_POSIX_ERROR_BASE + 4);
+ Sys_EINTR = ord(B_INTERRUPTED);
+ Sys_EINVAL = ord(B_BAD_VALUE);
+ Sys_EIO = ord(B_IO_ERROR);
+ Sys_EISDIR = ord(B_IS_A_DIRECTORY);
+ Sys_EMFILE = ord(B_NO_MORE_FDS);
+ Sys_EMLINK = (B_POSIX_ERROR_BASE + 5);
+ Sys_ENAMETOOLONG= ord(B_NAME_TOO_LONG);
+ Sys_ENFILE = (B_POSIX_ERROR_BASE + 6);
+ Sys_ENODEV = (B_POSIX_ERROR_BASE + 7);
+ Sys_ENOENT = ord(B_ENTRY_NOT_FOUND);
+ Sys_ENOEXEC = ord(B_NOT_AN_EXECUTABLE);
+ Sys_ENOLCK = (B_POSIX_ERROR_BASE + 8);
+ Sys_ENOMEM = ord(B_NO_MEMORY);
+ Sys_ENOSPC = ord(B_DEVICE_FULL);
+ Sys_ENOSYS = (B_POSIX_ERROR_BASE + 9);
+ Sys_ENOTDIR = ord(B_NOT_A_DIRECTORY);
+ Sys_ENOTEMPTY = ord(B_DIRECTORY_NOT_EMPTY);
+ Sys_ENOTTY = (B_POSIX_ERROR_BASE + 10);
+ Sys_ENXIO = (B_POSIX_ERROR_BASE + 11);
+ Sys_EPERM = ord(B_NOT_ALLOWED);
+ Sys_EPIPE = ord(B_BUSTED_PIPE);
+ Sys_ERANGE = (B_POSIX_ERROR_BASE + 17);
+ Sys_EROFS = ord(B_READ_ONLY_DEVICE);
+ Sys_ESPIPE = (B_POSIX_ERROR_BASE + 12);
+ Sys_ESRCH = (B_POSIX_ERROR_BASE + 13);
+ Sys_ETIMEDOUT = ord(B_TIMED_OUT);
+ Sys_EXDEV = ord(B_CROSS_DEVICE_LINK);
+
+ {Sys_EBADMSG = realtime extension POSIX only }
+ {Sys_ECANCELED = async. I/O extension POSIX only }
+ {Sys_EMSGSIZE = realtime extension POSIX only }
+ {Sys_EINPROGRESS = async. I/O extension POSIX only }
+
+{***********************************************************************}
+{ NON POSIX ERROR DEFINITIONS }
+{***********************************************************************}
+ sys_EFPOS = (B_POSIX_ERROR_BASE + 14);
+ sys_ESIGPARM = (B_POSIX_ERROR_BASE + 15);
+ sys_EPROTOTYPE = (B_POSIX_ERROR_BASE + 18);
+ sys_EPROTONOSUPPORT = (B_POSIX_ERROR_BASE + 19);
+ sys_EPFNOSUPPORT = (B_POSIX_ERROR_BASE + 20);
+ sys_EAFNOSUPPORT = (B_POSIX_ERROR_BASE + 21);
+ sys_EADDRINUSE = (B_POSIX_ERROR_BASE + 22);
+ sys_EADDRNOTAVAIL = (B_POSIX_ERROR_BASE + 23);
+ sys_ENETDOWN = (B_POSIX_ERROR_BASE + 24);
+ sys_ENETUNREACH = (B_POSIX_ERROR_BASE + 25);
+ sys_ENETRESET = (B_POSIX_ERROR_BASE + 26);
+ sys_ECONNABORTED = (B_POSIX_ERROR_BASE + 27);
+ sys_ECONNRESET = (B_POSIX_ERROR_BASE + 28);
+
+ sys_EISCONN = (B_POSIX_ERROR_BASE + 29);
+ sys_ENOTCONN = (B_POSIX_ERROR_BASE + 30);
+ sys_ESHUTDOWN = (B_POSIX_ERROR_BASE + 31);
+ sys_ECONNREFUSED = (B_POSIX_ERROR_BASE + 32);
+ sys_EHOSTUNREACH = (B_POSIX_ERROR_BASE + 33);
+ sys_ENOPROTOOPT = (B_POSIX_ERROR_BASE + 34);
+ sys_ENOBUFS = (B_POSIX_ERROR_BASE + 35);
+ sys_EINPROGRESS = (B_POSIX_ERROR_BASE + 36);
+ sys_EALREADY = (B_POSIX_ERROR_BASE + 37);
+
+ sys_EWOULDBLOCK = ord(B_WOULD_BLOCK); {* BSD compatibility *}
+ sys_ELOOP = ord(B_LINK_LIMIT);
+
+
+{
+ $Log: errno.inc,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/i386/cprt0.as b/rtl/beos/i386/cprt0.as
new file mode 100644
index 0000000000..8d43936c22
--- /dev/null
+++ b/rtl/beos/i386/cprt0.as
@@ -0,0 +1,217 @@
+ .file "cprt0.s"
+.data
+ .align 4
+default_environ:
+ .long 0
+.text
+.globl _start
+ .type _start,@function
+_start:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $4,%esp
+ pushl %ebx
+ call .L6
+.L6:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L6],%ebx
+ movl argv_save@GOT(%ebx),%eax
+ movl 12(%ebp),%edi
+ movl %edi,(%eax)
+ movl environ@GOT(%ebx),%eax
+ movl 16(%ebp),%esi
+ movl %esi,(%eax)
+ test %esi,%esi
+ jnz .L4
+ movl environ@GOT(%ebx),%eax
+ movl %ebx,%ecx
+ addl $default_environ@GOTOFF,%ecx
+ movl %ecx,%edx
+ movl %edx,(%eax)
+.L4:
+/* movl %fs:0x4,%eax this doesn't work on BeOS 4.0, let's use find_thread instead */
+ pushl $0x0
+ call find_thread
+ movl __main_thread_id@GOT(%ebx),%edx
+ movl %eax,(%edx)
+ pushl %esi
+ pushl %edi
+ movl 8(%ebp),%eax
+ pushl %eax
+ call _init_c_library_
+ call _call_init_routines_
+ movl 8(%ebp),%eax
+ movl %eax,U_SYSTEM_ARGC
+ movl %edi,U_SYSTEM_ARGV
+ movl %esi,U_SYSTEM_ENVP
+ xorl %ebp,%ebp
+ call PASCALMAIN
+
+.globl _haltproc
+.type _haltproc,@function
+_haltproc:
+ call _thread_do_exit_notification
+ xorl %ebx,%ebx
+ movw U_SYSTEM_EXITCODE,%bx
+ pushl %ebx
+ call exit
+
+
+/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
+.globl sys_open
+.type sys_open,@function
+sys_open:
+xorl %eax,%eax
+int $0x25
+ret
+
+/* int sys_close (int handle) */
+.globl sys_close
+.type sys_close,@function
+sys_close:
+mov $0x01,%eax
+int $0x25
+ret
+
+/* int sys_read (int handle, void * buffer, int length) */
+.globl sys_read
+.type sys_read,@function
+sys_read:
+movl $0x02,%eax
+int $0x25
+ret
+
+/* int sys_write (int handle, void * buffer, int length) */
+.globl sys_write
+.type sys_write,@function
+sys_write:
+movl $0x3,%eax
+int $0x25
+ret
+
+/* int sys_lseek (int handle, long long pos, int whence) */
+.globl sys_lseek
+.type sys_lseek,@function
+sys_lseek:
+movl $0x5,%eax
+int $0x25
+ret
+
+/* int sys_time(void) */
+.globl sys_time
+.type sys_time,@function
+sys_time:
+movl $0x7,%eax
+int $0x25
+ret
+
+/* int sys_resize_area */
+.globl sys_resize_area
+.type sys_resize_area,@function
+sys_resize_area:
+movl $0x8,%eax
+int $0x25
+ret
+
+/* int sys_opendir (0xFF000000, chra * name, 0) */
+.globl sys_opendir
+.type sys_opendir,@function
+sys_opendir:
+movl $0xC,%eax
+int $0x25
+ret
+
+
+/* int sys_create_area */
+.globl sys_create_area
+.type sys_create_area,@function
+sys_create_area:
+movl $0x14,%eax
+int $0x25
+ret
+
+/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
+.globl sys_readdir
+.type sys_readdir,@function
+sys_readdir:
+movl $0x1C,%eax
+int $0x25
+ret
+
+/* int sys_mkdir (char=0xFF, char * name, int mode) */
+.globl sys_mkdir
+.type sys_mkdir,@function
+sys_mkdir:
+movl $0x1E,%eax
+int $0x25
+ret
+
+/* int sys_wait_for_thread */
+.globl sys_wait_for_thread
+.type sys_wait_for_thread,@function
+sys_wait_for_thread:
+movl $0x22,%eax
+int $0x25
+ret
+
+/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
+.globl sys_rename
+.type sys_rename,@function
+sys_rename:
+movl $0x26,%eax
+int $0x25
+ret
+
+/* int sys_unlink (int=0xFF000000, char * name) */
+.globl sys_unlink
+.type sys_unlink,@function
+sys_unlink:
+movl $0x27,%eax
+int $0x25
+ret
+
+/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
+.globl sys_stat
+.type sys_stat,@function
+sys_stat:
+movl $0x30,%eax
+int $0x25
+ret
+
+/* int sys_load_image */
+.globl sys_load_image
+.type sys_load_image,@function
+sys_load_image:
+movl $0x34,%eax
+int $0x25
+ret
+
+/* void sys_exit (int exitcode) */
+.globl sys_exit
+.type sys_exit,@function
+sys_exit:
+movl $0x3F,%eax
+int $0x25
+
+/* void sys_chdir (char 0xFF, char * name) */
+.globl sys_chdir
+.type sys_chdir,@function
+sys_chdir:
+movl $0x57,%eax
+int $0x25
+ret
+
+/* void sys_rmdir (char 0xFF, char * name) */
+.globl sys_rmdir
+.type sys_rmdir,@function
+sys_rmdir:
+movl $0x60,%eax
+int $0x25
+ret
+
+/* actual syscall */
+.globl sys_call
+.type sys_call,@function
+sys_call:
+int $0x25
+ret
diff --git a/rtl/beos/i386/dllprt.as b/rtl/beos/i386/dllprt.as
new file mode 100644
index 0000000000..67f62219cf
--- /dev/null
+++ b/rtl/beos/i386/dllprt.as
@@ -0,0 +1,170 @@
+ .file "dllprt.cpp"
+.text
+ .p2align 2
+.globl _._7FPC_DLL
+ .type _._7FPC_DLL,@function
+_._7FPC_DLL:
+.LFB1:
+ pushl %ebp
+.LCFI0:
+ movl %esp,%ebp
+.LCFI1:
+ pushl %esi
+.LCFI2:
+ pushl %ebx
+.LCFI3:
+ call .L7
+.L7:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L7],%ebx
+ movl 8(%ebp),%esi
+.L3:
+ movl 12(%ebp),%eax
+ andl $1,%eax
+ testl %eax,%eax
+ je .L5
+ pushl %esi
+.LCFI4:
+ call __builtin_delete@PLT
+ addl $4,%esp
+ jmp .L5
+ .p2align 4,,7
+.L4:
+.L5:
+.L2:
+ leal -8(%ebp),%esp
+ popl %ebx
+ popl %esi
+ movl %ebp,%esp
+ popl %ebp
+ ret
+.LFE1:
+.Lfe1:
+ .size _._7FPC_DLL,.Lfe1-_._7FPC_DLL
+.section .rodata
+.LC0:
+ .string "dll"
+.data
+ .align 4
+ .type _argv,@object
+ .size _argv,8
+_argv:
+ .long .LC0
+ .long 0
+ .align 4
+ .type _envp,@object
+ .size _envp,4
+_envp:
+ .long 0
+.text
+ .p2align 2
+.globl __7FPC_DLL
+ .type __7FPC_DLL,@function
+__7FPC_DLL:
+.LFB2:
+ pushl %ebp
+.LCFI5:
+ movl %esp,%ebp
+.LCFI6:
+ pushl %ebx
+.LCFI7:
+ call .L11
+.L11:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L11],%ebx
+ movl U_SYSBEOS_ARGC@GOT(%ebx),%eax
+ movl $0,(%eax)
+ movl U_SYSBEOS_ARGV@GOT(%ebx),%eax
+ movl %ebx,%ecx
+ addl $_argv@GOTOFF,%ecx
+ movl %ecx,%edx
+ movl %edx,(%eax)
+ movl U_SYSBEOS_ENVP@GOT(%ebx),%eax
+ movl %ebx,%ecx
+ addl $_envp@GOTOFF,%ecx
+ movl %ecx,%edx
+ movl %edx,(%eax)
+ call PASCALMAIN__Fv@PLT
+.L9:
+ movl 8(%ebp),%eax
+ jmp .L8
+.L8:
+ movl -4(%ebp),%ebx
+ movl %ebp,%esp
+ popl %ebp
+ ret
+.LFE2:
+.Lfe2:
+ .size __7FPC_DLL,.Lfe2-__7FPC_DLL
+
+.section .eh_frame,"aw",@progbits
+__FRAME_BEGIN__:
+ .4byte .LLCIE1
+.LSCIE1:
+ .4byte 0x0
+ .byte 0x1
+ .byte 0x0
+ .byte 0x1
+ .byte 0x7c
+ .byte 0x8
+ .byte 0xc
+ .byte 0x4
+ .byte 0x4
+ .byte 0x88
+ .byte 0x1
+ .align 4
+.LECIE1:
+ .set .LLCIE1,.LECIE1-.LSCIE1
+ .4byte .LLFDE1
+.LSFDE1:
+ .4byte .LSFDE1-__FRAME_BEGIN__
+ .4byte .LFB1
+ .4byte .LFE1-.LFB1
+ .byte 0x4
+ .4byte .LCFI0-.LFB1
+ .byte 0xe
+ .byte 0x8
+ .byte 0x85
+ .byte 0x2
+ .byte 0x4
+ .4byte .LCFI1-.LCFI0
+ .byte 0xd
+ .byte 0x5
+ .byte 0x4
+ .4byte .LCFI2-.LCFI1
+ .byte 0x86
+ .byte 0x3
+ .byte 0x4
+ .4byte .LCFI3-.LCFI2
+ .byte 0x83
+ .byte 0x4
+ .byte 0x4
+ .4byte .LCFI4-.LCFI3
+ .byte 0x2e
+ .byte 0x4
+ .align 4
+.LEFDE1:
+ .set .LLFDE1,.LEFDE1-.LSFDE1
+ .4byte .LLFDE3
+.LSFDE3:
+ .4byte .LSFDE3-__FRAME_BEGIN__
+ .4byte .LFB2
+ .4byte .LFE2-.LFB2
+ .byte 0x4
+ .4byte .LCFI5-.LFB2
+ .byte 0xe
+ .byte 0x8
+ .byte 0x85
+ .byte 0x2
+ .byte 0x4
+ .4byte .LCFI6-.LCFI5
+ .byte 0xd
+ .byte 0x5
+ .byte 0x4
+ .4byte .LCFI7-.LCFI6
+ .byte 0x83
+ .byte 0x3
+ .align 4
+.LEFDE3:
+ .set .LLFDE3,.LEFDE3-.LSFDE3
+ .ident "GCC: (GNU) 2.9-beos-991026"
diff --git a/rtl/beos/i386/dllprt.cpp b/rtl/beos/i386/dllprt.cpp
new file mode 100644
index 0000000000..e6c5d368a5
--- /dev/null
+++ b/rtl/beos/i386/dllprt.cpp
@@ -0,0 +1,39 @@
+#include <stdio.h>
+
+class FPC_DLL
+{
+ public:
+ FPC_DLL();
+// ~FPC_DLL();
+};
+
+static FPC_DLL fpc_dll();
+
+//FPC_DLL::~FPC_DLL()
+//{
+// printf ("main thread ended.");
+//}
+
+
+extern "C" void PASCALMAIN(void);
+extern int U_SYSBEOS_ARGC;
+extern void * U_SYSBEOS_ARGV;
+extern void * U_SYSBEOS_ENVP;
+
+static char * _argv[] = {"dll",0};
+static char * _envp[] = {0};
+
+extern "C" void BEGIN()
+{
+ printf ("init\n");
+ U_SYSBEOS_ARGC=0;
+ U_SYSBEOS_ARGV = (void *)_argv;
+ U_SYSBEOS_ENVP = (void *)_envp;
+ PASCALMAIN();
+}
+
+FPC_DLL::FPC_DLL()
+{
+ BEGIN();
+}
+
diff --git a/rtl/beos/i386/func.as b/rtl/beos/i386/func.as
new file mode 100644
index 0000000000..a55746d21a
--- /dev/null
+++ b/rtl/beos/i386/func.as
@@ -0,0 +1,161 @@
+ .file "func.s"
+.text
+
+.globl _haltproc
+.type _haltproc,@function
+_haltproc:
+ xorl %ebx,%ebx
+ movw U_SYSBEOS_EXITCODE,%bx
+ pushl %ebx
+ call sys_exit
+
+/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
+.globl sys_open
+.type sys_open,@function
+sys_open:
+xorl %eax,%eax
+int $0x25
+ret
+
+/* int sys_close (int handle) */
+.globl sys_close
+.type sys_close,@function
+sys_close:
+mov $0x01,%eax
+int $0x25
+ret
+
+/* int sys_read (int handle, void * buffer, int length) */
+.globl sys_read
+.type sys_read,@function
+sys_read:
+movl $0x02,%eax
+int $0x25
+ret
+
+/* int sys_write (int handle, void * buffer, int length) */
+.globl sys_write
+.type sys_write,@function
+sys_write:
+movl $0x3,%eax
+int $0x25
+ret
+
+/* int sys_lseek (int handle, long long pos, int whence) */
+.globl sys_lseek
+.type sys_lseek,@function
+sys_lseek:
+movl $0x5,%eax
+int $0x25
+ret
+
+/* int sys_time(void) */
+.globl sys_time
+.type sys_time,@function
+sys_time:
+movl $0x7,%eax
+int $0x25
+ret
+
+/* int sys_resize_area */
+.globl sys_resize_area
+.type sys_resize_area,@function
+sys_resize_area:
+movl $0x8,%eax
+int $0x25
+ret
+
+/* int sys_opendir (0xFF000000, chra * name, 0) */
+.globl sys_opendir
+.type sys_opendir,@function
+sys_opendir:
+movl $0xC,%eax
+int $0x25
+ret
+
+/* int sys_create_area */
+.globl sys_create_area
+.type sys_create_area,@function
+sys_create_area:
+movl $0x14,%eax
+int $0x25
+ret
+
+/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
+.globl sys_readdir
+.type sys_readdir,@function
+sys_readdir:
+movl $0x1C,%eax
+int $0x25
+ret
+
+/* int sys_mkdir (char=0xFF, char * name, int mode) */
+.globl sys_mkdir
+.type sys_mkdir,@function
+sys_mkdir:
+movl $0x1E,%eax
+int $0x25
+ret
+
+/* int sys_wait_for_thread */
+.globl sys_wait_for_thread
+.type sys_wait_for_thread,@function
+sys_wait_for_thread:
+movl $0x22,%eax
+int $0x25
+ret
+
+/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
+.globl sys_rename
+.type sys_rename,@function
+sys_rename:
+movl $0x26,%eax
+int $0x25
+ret
+
+/* int sys_unlink (int=0xFF000000, char * name) */
+.globl sys_unlink
+.type sys_unlink,@function
+sys_unlink:
+movl $0x27,%eax
+int $0x25
+ret
+
+/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
+.globl sys_stat
+.type sys_stat,@function
+sys_stat:
+movl $0x30,%eax
+int $0x25
+ret
+
+/* int sys_load_image */
+.globl sys_load_image
+.type sys_load_image,@function
+sys_load_image:
+movl $0x34,%eax
+int $0x25
+ret
+
+/* void sys_exit (int exitcode) */
+.globl sys_exit
+.type sys_exit,@function
+sys_exit:
+movl $0x3F,%eax
+int $0x25
+
+/* void sys_chdir (char 0xFF, char * name) */
+.globl sys_chdir
+.type sys_chdir,@function
+sys_chdir:
+movl $0x57,%eax
+int $0x25
+ret
+
+/* void sys_rmdir (char 0xFF, char * name) */
+.globl sys_rmdir
+.type sys_rmdir,@function
+sys_rmdir:
+movl $0x60,%eax
+int $0x25
+ret
diff --git a/rtl/beos/i386/prt0.as b/rtl/beos/i386/prt0.as
new file mode 100644
index 0000000000..ecebd7f564
--- /dev/null
+++ b/rtl/beos/i386/prt0.as
@@ -0,0 +1,181 @@
+ .file "prt0.c"
+.text
+.globl start
+ .type start,@function
+start:
+ pushl %ebp
+ movl %esp,%ebp
+ movl 16(%ebp),%ecx
+ movl 12(%ebp),%ebx
+ movl 8(%ebp),%eax
+ movl %eax,U_SYSTEM_ARGC
+ movl %ebx,U_SYSTEM_ARGV
+ movl %ecx,U_SYSTEM_ENVP
+ xorl %ebp,%ebp
+ call PASCALMAIN
+
+.globl _haltproc
+.type _haltproc,@function
+_haltproc:
+ xorl %ebx,%ebx
+ movw U_SYSTEM_EXITCODE,%bx
+ pushl %ebx
+ call sys_exit
+
+/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
+.globl sys_open
+.type sys_open,@function
+sys_open:
+xorl %eax,%eax
+int $0x25
+ret
+
+/* int sys_close (int handle) */
+.globl sys_close
+.type sys_close,@function
+sys_close:
+mov $0x01,%eax
+int $0x25
+ret
+
+/* int sys_read (int handle, void * buffer, int length) */
+.globl sys_read
+.type sys_read,@function
+sys_read:
+movl $0x02,%eax
+int $0x25
+ret
+
+/* int sys_write (int handle, void * buffer, int length) */
+.globl sys_write
+.type sys_write,@function
+sys_write:
+movl $0x3,%eax
+int $0x25
+ret
+
+/* int sys_lseek (int handle, long long pos, int whence) */
+.globl sys_lseek
+.type sys_lseek,@function
+sys_lseek:
+movl $0x5,%eax
+int $0x25
+ret
+
+/* int sys_time(void) */
+.globl sys_time
+.type sys_time,@function
+sys_time:
+movl $0x7,%eax
+int $0x25
+ret
+
+/* int sys_resize_area */
+.globl sys_resize_area
+.type sys_resize_area,@function
+sys_resize_area:
+movl $0x8,%eax
+int $0x25
+ret
+
+/* int sys_opendir (0xFF000000, chra * name, 0) */
+.globl sys_opendir
+.type sys_opendir,@function
+sys_opendir:
+movl $0xC,%eax
+int $0x25
+ret
+
+/* int sys_create_area */
+.globl sys_create_area
+.type sys_create_area,@function
+sys_create_area:
+movl $0x14,%eax
+int $0x25
+ret
+
+/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
+.globl sys_readdir
+.type sys_readdir,@function
+sys_readdir:
+movl $0x1C,%eax
+int $0x25
+ret
+
+/* int sys_mkdir (char=0xFF, char * name, int mode) */
+.globl sys_mkdir
+.type sys_mkdir,@function
+sys_mkdir:
+movl $0x1E,%eax
+int $0x25
+ret
+
+/* int sys_wait_for_thread */
+.globl sys_wait_for_thread
+.type sys_wait_for_thread,@function
+sys_wait_for_thread:
+movl $0x22,%eax
+int $0x25
+ret
+
+/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
+.globl sys_rename
+.type sys_rename,@function
+sys_rename:
+movl $0x26,%eax
+int $0x25
+ret
+
+/* int sys_unlink (int=0xFF000000, char * name) */
+.globl sys_unlink
+.type sys_unlink,@function
+sys_unlink:
+movl $0x27,%eax
+int $0x25
+ret
+
+/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
+.globl sys_stat
+.type sys_stat,@function
+sys_stat:
+movl $0x30,%eax
+int $0x25
+ret
+
+/* int sys_load_image */
+.globl sys_load_image
+.type sys_load_image,@function
+sys_load_image:
+movl $0x34,%eax
+int $0x25
+ret
+
+/* void sys_exit (int exitcode) */
+.globl sys_exit
+.type sys_exit,@function
+sys_exit:
+movl $0x3F,%eax
+int $0x25
+
+/* void sys_chdir (char 0xFF, char * name) */
+.globl sys_chdir
+.type sys_chdir,@function
+sys_chdir:
+movl $0x57,%eax
+int $0x25
+ret
+
+/* void sys_rmdir (char 0xFF, char * name) */
+.globl sys_rmdir
+.type sys_rmdir,@function
+sys_rmdir:
+movl $0x60,%eax
+int $0x25
+ret
+
+/* actual syscall */
+.globl sys_call
+.type sys_call,@function
+sys_call:
+int $0x25
+ret
diff --git a/rtl/beos/objinc.inc b/rtl/beos/objinc.inc
new file mode 100644
index 0000000000..390abb9ded
--- /dev/null
+++ b/rtl/beos/objinc.inc
@@ -0,0 +1,96 @@
+{ For linux we 'steal' the following from system unit, this way
+ we don't need to change the system unit interface. }
+
+Var errno : Longint;
+
+{$i sysnr.inc}
+{$i errno.inc}
+{$i sysconst.inc}
+{$i systypes.inc}
+{$i syscalls.inc}
+
+FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+
+Var LinuxMode : longint;
+
+BEGIN
+ LinuxMode:=0;
+ if Mode=stCreate then
+ Begin
+ LinuxMode:=Open_Creat;
+ LinuxMode:=LinuxMode or Open_RdWr;
+ end
+ else
+ Begin
+ Case (Mode and 3) of
+ 0 : LinuxMode:=LinuxMode or Open_RdOnly;
+ 1 : LinuxMode:=LinuxMode or Open_WrOnly;
+ 2 : LinuxMode:=LinuxMode or Open_RdWr;
+ end;
+ end;
+ FileOpen:=SYS_Open (pchar(@FileName[0]),LinuxMode,438 {666 octal});
+ If FileOpen=-1 then FileOpen:=0;
+ DosStreamError:=Errno;
+END;
+
+FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
+Var BytesMoved: Sw_Word): Word;
+BEGIN
+ BytesMoved:=Sys_read (Handle,Pchar(@BufferArea),BufferLength);
+ DosStreamError:=Errno;
+ FileRead:=Errno;
+END;
+
+FUNCTION FileWrite (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
+Var BytesMoved: Sw_Word): Word;
+BEGIN
+ BytesMoved:=Sys_Write (Handle,Pchar(@BufferArea),BufferLength);
+ FileWrite:=Errno;
+ DosStreamError:=Errno;
+END;
+
+FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
+VAR NewPos: LongInt): Word;
+
+BEGIN
+ NewPos:=Sys_LSeek (Handle,Pos,MoveType);
+ SetFilePos:=Errno;
+END;
+
+FUNCTION FileClose (Handle: THandle): Word;
+BEGIN
+ Sys_Close (Handle);
+ DosStreamError:=Errno;
+ FileClose := Errno;
+END;
+
+FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
+
+{$IFNDEF BSD}
+Var sr : syscallregs;
+{$ENDIF}
+{$IFDEF DOSSETFILE1}
+ Actual, Buf: LongInt;
+{$ENDIF}
+
+BEGIN
+ {$IFDEF BSD}
+ Do_Syscall(Syscall_Nr_ftruncate,handle,filesize,0); {0 -> offset =64 bit}
+ {$ELSE}
+ sr.reg2:=Handle;
+ sr.reg3:=FileSize;
+ Syscall(syscall_nr_fTruncate,sr);
+ {$ENDIF}
+ If Errno=0 then
+ SetFileSize:=0
+ else
+ SetFileSize:=103;
+{$IFDEF DOSSETFILE1}
+ If (Actual = FileSize) Then Begin { No position error }
+ Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual); { Truncate the file }
+ If (Actual <> -1) Then SetFileSize := 0 Else { No truncate error }
+ SetFileSize := 103; { File truncate error }
+ End Else SetFileSize := 103; { File truncate error }
+{$ENDIF}
+END;
+
diff --git a/rtl/beos/osposix.inc b/rtl/beos/osposix.inc
new file mode 100644
index 0000000000..8a2a11102b
--- /dev/null
+++ b/rtl/beos/osposix.inc
@@ -0,0 +1,464 @@
+{
+ $Id: osposix.inc,v 1.3 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 2001 by Carl Eric Codere
+
+ Implements POSIX 1003.1 interface
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+
+const
+ syscall_nr_exit = $3F;
+ syscall_nr_chdir = $57;
+ syscall_nr_mkdir = $1E;
+ syscall_nr_unlink = $27;
+ syscall_nr_rmdir = $60;
+ syscall_nr_close = $01;
+ syscall_nr_read = $02;
+ syscall_nr_write = $03;
+ syscall_nr_stat = $30;
+ syscall_nr_fstat = $30;
+ syscall_nr_rename = $26;
+ syscall_nr_access = $58;
+ syscall_nr_opendir= $0C;
+ syscall_nr_closedir= $0F;
+ syscall_nr_sigaction= $70;
+ syscall_nr_time = $07;
+ syscall_nr_open = $00;
+ syscall_nr_readdir = $1C;
+ syscall_nr_lseek = $05;
+ syscall_nr_ftruncate = $4b;
+
+ S_IFDIR =$004000; { Directory. }
+ S_IFCHR =$002000; { Character device. }
+ S_IFBLK =$006000; { Block device. }
+ S_IFREG =$008000; { Regular file. }
+ S_IFIFO =$001000; { FIFO. }
+ S_IFLNK =$00A000; { Symbolic link. }
+
+type
+ { _kwstat_ kernel call structure }
+ pwstat = ^twstat;
+ twstat = packed record
+{00} filler : array[1..3] of longint;
+{12} newmode : mode_t; { chmod mode_t parameter }
+{16} unknown1 : longint;
+{20} newuser : uid_t; { chown uid_t parameter }
+{24} newgroup : gid_t; { chown gid_t parameter }
+{28} trunc_offset : off_t; { ftrucnate parameter }
+{36} unknown2 : array[1..2] of longint;
+{44} utime_param: int64;
+{52} unknown3 : array[1..2] of longint;
+ end;
+
+
+
+
+
+
+ { These routines are currently not required for BeOS }
+ function sys_fork : pid_t;
+ begin
+ end;
+
+ function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
+ begin
+ end;
+
+ function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
+ begin
+ end;
+
+
+ function sys_uname(var name: utsname): cint;
+ begin
+ FillChar(name, sizeof(utsname), #0);
+ name.machine := 'BePC'#0;
+
+ end;
+
+
+
+
+ function S_ISDIR(m : mode_t): boolean;
+ begin
+ if (m and S_IFDIR)= S_IFDIR then
+ S_ISDIR := true
+ else
+ S_ISDIR := false;
+ end;
+
+ function S_ISCHR(m : mode_t): boolean;
+ begin
+ if (m and S_IFCHR) = S_IFCHR then
+ S_ISCHR := true
+ else
+ S_ISCHR := false;
+ end;
+
+ function S_ISBLK(m : mode_t): boolean;
+ begin
+ if (m and S_IFBLK) = S_IFBLK then
+ S_ISBLK := true
+ else
+ S_ISBLK := false;
+ end;
+
+ function S_ISREG(m : mode_t): boolean;
+ begin
+ if (m and S_IFREG) = S_IFREG then
+ S_ISREG := true
+ else
+ S_ISREG := false;
+ end;
+
+ function S_ISFIFO(m : mode_t): boolean;
+ begin
+ if (m and S_IFIFO) = S_IFIFO then
+ S_ISFIFO := true
+ else
+ S_ISFIFO := false;
+ end;
+
+ function wifexited(status : cint): cint;
+ begin
+ wifexited := byte(boolean((status and not $FF) = 0));
+ end;
+
+ function wexitstatus(status : cint): cint;
+ begin
+ wexitstatus := status and $FF;
+ end;
+
+ function wstopsig(status : cint): cint;
+ begin
+ wstopsig:=(status shr 16) and $FF;
+ end;
+
+ function wifsignaled(status : cint): cint;
+ begin
+ if (((status) shr 8) and $ff) <> 0 then
+ wifsignaled := 1
+ else
+ wifsignaled := 0;
+ end;
+
+
+ {$i syscall.inc}
+
+ procedure sys_exit(status : cint); external name 'sys_exit';
+(*
+ procedure sys_exit(status : cint);
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := status;
+ SysCall(syscall_nr_exit,args);
+ end;
+*)
+
+ function sys_close(fd : cint): cint;
+ var
+ args : SysCallArgs;
+ begin
+ args.param[1] := fd;
+ sys_close:=SysCall(syscall_nr_close,args);
+ end;
+
+
+ function sys_time(var tloc:time_t): time_t;
+ var
+ args : SysCallArgs;
+ begin
+ { don't treat errno, since there is never any }
+ tloc := Do_Syscall(syscall_nr_time,args);
+ sys_time := tloc;
+ end;
+
+
+
+ function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
+ var
+ args : SysCallArgs;
+ begin
+ args.param[1] := sig;
+ args.param[2] := cint(@act);
+ args.param[3] := cint(@oact);
+ sys_sigaction := SysCall(syscall_nr_sigaction, args);
+ end;
+
+
+ function sys_closedir(dirp : pdir): cint;
+ var
+ args : SysCallArgs;
+ begin
+ if assigned(dirp) then
+ begin
+ args.param[1] := dirp^.fd;
+ sys_closedir := SysCall(syscall_nr_closedir,args);
+ Dispose(dirp);
+ dirp := nil;
+ exit;
+ end;
+ Errno := Sys_EBADF;
+ sys_closedir := -1;
+ end;
+
+
+ function sys_opendir(const dirname : pchar): pdir;
+ var
+ args : SysCallArgs;
+ dirp: pdir;
+ fd : cint;
+ begin
+ New(dirp);
+ { just in case }
+ FillChar(dirp^,sizeof(dir),#0);
+ if assigned(dirp) then
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(dirname);
+ args.param[3] := 0;
+ fd:=SysCall(syscall_nr_opendir,args);
+ if fd = -1 then
+ begin
+ Dispose(dirp);
+ sys_opendir := nil;
+ exit;
+ end;
+ dirp^.fd := fd;
+ sys_opendir := dirp;
+ exit;
+ end;
+ Errno := Sys_EMFILE;
+ sys_opendir := nil;
+ end;
+
+
+ function sys_access(const pathname : pchar; amode : cint): cint;
+ var
+ args : SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(pathname);
+ args.param[3] := amode;
+ sys_access := SysCall(syscall_nr_access,args);
+ end;
+
+
+ function sys_rename(const old : pchar; const newpath: pchar): cint;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(old);
+ args.param[3] := $FFFFFFFF;
+ args.param[4] := cint(newpath);
+ sys_rename := SysCall(syscall_nr_rename,args);
+ end;
+
+
+ function sys_rmdir(const path : pchar): cint;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(path);
+ sys_rmdir := SysCall(syscall_nr_rmdir,args);
+ end;
+
+
+ function sys_unlink(const path: pchar): cint;
+ var
+ args :SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(path);
+ sys_unlink := SysCall(syscall_nr_unlink,args);
+ end;
+
+
+
+ function sys_mkdir(const path : pchar; mode: mode_t):cint;
+ var
+ args :SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(path);
+ args.param[3] := cint(mode);
+ sys_mkdir := SysCall(syscall_nr_mkdir,args);
+ end;
+
+
+ function sys_fstat(fd : cint; var sb : stat): cint;
+ var
+ args : SysCallArgs;
+ begin
+ args.param[1] := fd;
+ args.param[2] := $00;
+ args.param[3] := cint(@sb);
+ args.param[4] := $00000001;
+ sys_fstat := SysCall(syscall_nr_fstat, args);
+ end;
+
+
+ function sys_stat(const path: pchar; var buf : stat): cint;
+ var
+ args : SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(path);
+ args.param[3] := cint(@buf);
+ args.param[4] := $01000000;
+ sys_stat := SysCall(syscall_nr_stat, args);
+ end;
+
+
+ function sys_read(fd: cint; buf:pchar; nbytes : size_t): ssize_t;
+ var
+ args : SysCallArgs;
+ funcresult: ssize_t;
+ errorcode : cint;
+ begin
+ args.param[1] := fd;
+ args.param[2] := cint(buf);
+ args.param[3] := cint(nbytes);
+ args.param[4] := cint(@errorcode);
+ funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
+ if funcresult >= 0 then
+ begin
+ sys_read := funcresult;
+ errno := 0;
+ end
+ else
+ begin
+ sys_read := -1;
+ errno := errorcode;
+ end;
+ end;
+
+
+ function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
+ var
+ args : SysCallArgs;
+ funcresult : ssize_t;
+ errorcode : cint;
+ begin
+ args.param[1] := fd;
+ args.param[2] := cint(buf);
+ args.param[3] := cint(nbytes);
+ args.param[4] := cint(@errorcode);
+ funcresult := Do_SysCall(syscall_nr_write,args);
+ if funcresult >= 0 then
+ begin
+ sys_write := funcresult;
+ errno := 0;
+ end
+ else
+ begin
+ sys_write := -1;
+ errno := errorcode;
+ end;
+ end;
+
+
+
+ function sys_chdir(const path : pchar): cint;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(path);
+ sys_chdir := SysCall(syscall_nr_chdir, args);
+ end;
+
+
+ function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
+ var
+ args: SysCallArgs;
+ begin
+ args.param[1] := $FFFFFFFF;
+ args.param[2] := cint(path);
+ args.param[3] := flags;
+ args.param[4] := cint(mode);
+ args.param[5] := 0; { close on execute flag }
+ sys_open:= SysCall(syscall_nr_open, args);
+ end;
+
+
+ function sys_readdir(dirp : pdir) : pdirent;
+ var
+ args : SysCallArgs;
+ funcresult : cint;
+ begin
+ args.param[1] := dirp^.fd;
+ args.param[2] := cint(@(dirp^.ent));
+ args.param[3] := $0000011C;
+ args.param[4] := $00000001;
+ { the error will be processed here }
+ funcresult := Do_SysCall(syscall_nr_readdir, args);
+ if funcresult <> 1 then
+ begin
+ if funcresult <> 0 then
+ errno := funcresult;
+ sys_readdir := nil;
+ exit;
+ end;
+ errno := 0;
+ sys_readdir := @dirp^.ent
+ end;
+
+
+ function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
+ var
+ args: SysCallArgs;
+
+ begin
+ args.param[1] := fd;
+ args.param[2] := cint(offset and $FFFFFFFF);
+ args.param[3] := cint((offset shr 32) and $FFFFFFFF);
+ args.param[4] := whence;
+ { we currently only support seeks upto 32-bit in length }
+ sys_lseek := off_t(SysCall(syscall_nr_lseek,args));
+ end;
+
+
+ function sys_ftruncate(fd : cint; flength : off_t): cint;
+ var
+ args: SysCallArgs;
+ wstat : pwstat;
+ begin
+ New(wstat);
+ FillChar(wstat^,sizeof(wstat),0);
+ wstat^.trunc_offset := flength;
+ args.param[1] := fd;
+ args.param[2] := $00000000;
+ args.param[3] := cint(wstat);
+ args.param[4] := $00000008;
+ args.param[5] := $00000001;
+ sys_ftruncate:=SysCall(syscall_nr_ftruncate, args);
+ Dispose(wstat);
+ end;
+
+{
+
+ $Log: osposix.inc,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/osposixh.inc b/rtl/beos/osposixh.inc
new file mode 100644
index 0000000000..419f556526
--- /dev/null
+++ b/rtl/beos/osposixh.inc
@@ -0,0 +1,188 @@
+{
+ $Id: osposixh.inc,v 1.3 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the types used in POSIX for BeOS
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+type
+ { the following type definitions are compiler dependant }
+ { and system dependant }
+
+ cint = longint; { minimum range is : 32-bit }
+ cuint = cardinal; { minimum range is : 32-bit }
+
+
+ dev_t = cint; { used for device numbers }
+ gid_t = cuint; { used for group IDs }
+ ino_t = int64; { used for file serial numbers }
+ mode_t = cuint; { used for file attributes }
+ nlink_t = cint; { used for link counts }
+ off_t = int64; { used for file sizes }
+ pid_t = cint; { used as process identifier }
+ size_t = cint; { as definied in the C standard }
+ ssize_t = cint; { used by function for returning number of bytes }
+ uid_t = cuint; { used for user ID type }
+ time_t = cint; { used for returning the time }
+ sigset_t = cuint; { used for additional signal }
+
+{***********************************************************************}
+{ POSIX STRUCTURES }
+{***********************************************************************}
+CONST
+ _UTSNAME_LENGTH = 32;
+ _UTSNAME_NODENAME_LENGTH = _UTSNAME_LENGTH;
+
+TYPE
+ { system information services }
+ utsname = packed record { don't forget to verify the alignment }
+ { Name of this implementation of the operating systems (POSIX) }
+ sysname : array[0.._UTSNAME_LENGTH+1] of char;
+ { Name of this node (POSIX) }
+ nodename : array[0.._UTSNAME_NODENAME_LENGTH+1] of char;
+ { Current release level of this implementation (POSIX) }
+ release : array[0.._UTSNAME_LENGTH+1] of char;
+ { Current version level of this release (POSX) }
+ version : array[0.._UTSNAME_LENGTH+1] of char;
+ { Name of the hardware type on which the system is running (POSIX) }
+ machine : array[0.._UTSNAME_LENGTH+1] of char;
+ end;
+
+ { file characteristics services }
+ stat = packed record { verify the alignment of the members }
+ st_dev : dev_t; { Device containing the file (POSIX) }
+ st_ino : ino_t; { File serial number (POSIX) }
+ st_mode: mode_t; { File mode (POSIX) }
+ st_nlink: nlink_t; { Link count (POSIX) }
+ st_uid: uid_t; { User ID of the file's owner. (POSIX)}
+ st_gid: gid_t; { Group ID of the file's group.(POSIX)}
+ st_size : off_t; { Size of file, in bytes. (POSIX)}
+ st_rdev : dev_t; { Device type (not used). }
+ st_blksize: cardinal;{ Preferred block size for I/O. }
+ st_atime: time_t; { Time of last access (POSIX) }
+ st_mtime: time_t; { Time of last modification (POSIX) }
+ st_ctime: time_t; { Time of last status change (POSIX) }
+ st_crtime: time_t; { Time of creation }
+ end;
+
+ { directory services }
+ pdirent = ^dirent;
+ dirent = packed record { directory entry record - verify alignment }
+ d_dev: dev_t;
+ d_pdev: dev_t;
+ d_fileno: ino_t;
+ d_pino: ino_t;
+ d_reclen:word;
+ d_name:array[0..255] of char; { Filename in DIRENT (POSIX) }
+ end;
+
+ pdir = ^dir;
+ dir = packed record
+ fd : cint; { file descriptor }
+ ent : dirent; { directory entry }
+ end;
+
+ sighandler_t = procedure (signo: cint); cdecl;
+
+ { signal services }
+ sigactionrec = packed record
+ sa_handler : sighandler_t; { pointer to a function (POSIX.1) }
+ sa_mask : sigset_t; { additional signal masks (POSIX.1) }
+ sa_flags : cint; { special flags for signals (POSIX.1) }
+ sa_userdata : pointer;
+ end;
+
+{***********************************************************************}
+{ POSIX CONSTANT ROUTINE DEFINITIONS }
+{***********************************************************************}
+CONST
+ { access routine - these maybe OR'ed together }
+ F_OK = 0; { test for existence of file }
+ R_OK = 4; { test for read permission on file }
+ W_OK = 2; { test for write permission on file }
+ X_OK = 1; { test for execute or search permission }
+ { seek routine }
+ SEEK_SET = 0; { seek from beginning of file }
+ SEEK_CUR = 1; { seek from current position }
+ SEEK_END = 2; { seek from end of file }
+ { open routine }
+ { File access modes for `open' and `fcntl'. }
+ O_RDONLY = 0; { Open read-only. }
+ O_WRONLY = 1; { Open write-only. }
+ O_RDWR = 2; { Open read/write. }
+ { Bits OR'd into the second argument to open. }
+ O_CREAT =$0200; { Create file if it doesn't exist. }
+ O_EXCL =$0100; { Fail if file already exists. }
+ O_TRUNC =$0400; { Truncate file to zero length. }
+ O_NOCTTY =$1000; { Don't assign a controlling terminal. }
+ { File status flags for `open' and `fcntl'. }
+ O_APPEND =$0800; { Writes append to the file. }
+ O_NONBLOCK =$0080; { Non-blocking I/O. }
+
+ { mode_t possible values }
+ S_IRUSR = $0100; { Read permission for owner }
+ S_IWUSR = $0080; { Write permission for owner }
+ S_IXUSR = $0040; { Exec permission for owner }
+ S_IRGRP = S_IRUSR shr 3; { Read permission for group }
+ S_IWGRP = S_IWUSR shr 3; { Write permission for group }
+ S_IXGRP = S_IWUSR shr 3; { Exec permission for group }
+ S_IROTH = S_IRGRP shr 3; { Read permission for world }
+ S_IWOTH = S_IWGRP shr 3; { Write permission for world }
+ S_IXOTH = S_IXGRP shr 3; { Exec permission for world }
+
+ { Used for waitpid }
+ WNOHANG = 1; { don't block waiting }
+ WUNTRACED = 2; { report status of stopped children }
+
+
+ {************************ signals *****************************}
+ { more can be provided. Herein are only included the required }
+ { values. }
+ {**************************************************************}
+ SIGABRT = 6; { abnormal termination }
+ SIGALRM = 14; { alarm clock (used with alarm() }
+ SIGFPE = 8; { illegal arithmetic operation }
+ SIGHUP = 1; { Hangup }
+ SIGILL = 4; { Illegal instruction }
+ SIGINT = 2; { Interactive attention signal }
+ SIGKILL = 9; { Kill, cannot be caught }
+ SIGPIPE = 7; { Broken pipe signal }
+ SIGQUIT = 3; { Interactive termination signal }
+ SIGSEGV = 11; { Detection of invalid memory reference }
+ SIGTERM = 15; { Termination request }
+ SIGUSR1 = 18; { Application defined signal 1 }
+ SIGUSR2 = 19; { Application defined signal 2 }
+ SIGCHLD = 5; { Child process terminated / stopped }
+ SIGCONT = 12; { Continue if stopped }
+ SIGSTOP = 10; { Stop signal. cannot be cuaght }
+ SIGSTP = 13; { Interactive stop signal }
+ SIGTTIN = 16; { Background read from TTY }
+ SIGTTOU = 17; { Background write to TTY }
+ SIGBUS = SIGSEGV; { Access to undefined memory }
+
+
+ { POSIX limits }
+ ARG_MAX = 128*1024; { Maximum number of arguments }
+ NAME_MAX = 256; { Maximum number of bytes in a filename }
+ PATH_MAX = 1024; { Maximum number of bytes in a pathname }
+
+
+{
+ $Log: osposixh.inc,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/posix.pp b/rtl/beos/posix.pp
new file mode 100644
index 0000000000..e67e6d4b0c
--- /dev/null
+++ b/rtl/beos/posix.pp
@@ -0,0 +1,86 @@
+{
+ $Id: posix.pp,v 1.3 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Carl Eric Codere
+ development team
+
+ POSIX Compliant interface unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit posix;
+
+interface
+
+{***********************************************************************}
+{ POSIX PUBLIC INTERFACE }
+{***********************************************************************}
+
+
+{$i errno.inc}
+{$i osposixh.inc}
+
+
+ function sys_fork : pid_t;
+ function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
+ function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
+ procedure sys_exit(status : cint);
+ { get system specific information }
+ function sys_uname(var name: utsname): cint;
+ function sys_opendir(const dirname : pchar): pdir;
+ function sys_readdir(dirp : pdir) : pdirent;
+ function sys_closedir(dirp : pdir): cint;
+ function sys_chdir(const path : pchar): cint;
+ function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
+ function sys_mkdir(const path : pchar; mode: mode_t):cint;
+ function sys_unlink(const path: pchar): cint;
+ function sys_rmdir(const path : pchar): cint;
+ function sys_rename(const old : pchar; const newpath: pchar): cint;
+ function sys_fstat(fd : cint; var sb : stat): cint;
+ function sys_stat(const path: pchar; var buf : stat): cint;
+ function sys_access(const pathname : pchar; amode : cint): cint;
+ function sys_close(fd : cint): cint;
+ function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
+ function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
+ function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
+ function sys_time(var tloc:time_t): time_t;
+
+
+ function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
+ function sys_ftruncate(fd : cint; flength : off_t): cint;
+
+ function S_ISDIR(m : mode_t): boolean;
+ function S_ISCHR(m : mode_t): boolean;
+ function S_ISBLK(m : mode_t): boolean;
+ function S_ISREG(m : mode_t): boolean;
+ function S_ISFIFO(m : mode_t): boolean;
+
+ function wifexited(status : cint): cint;
+ function wexitstatus(status : cint): cint;
+ function wstopsig(status : cint): cint;
+ function wifsignaled(status : cint): cint;
+
+
+
+
+implementation
+
+{$i osposix.inc}
+
+
+
+
+end.
+
+{
+ $Log: posix.pp,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/syscall.inc b/rtl/beos/syscall.inc
new file mode 100644
index 0000000000..5e51cd851d
--- /dev/null
+++ b/rtl/beos/syscall.inc
@@ -0,0 +1,92 @@
+{
+ $Id: syscall.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 1998-2000 by Florian Klaempfl
+
+ This include implements the actual system call for the
+ intel BeOS 80x86 platform.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+type
+ SysCallArgs = packed record
+ param: array[1..8] of cint;
+ End;
+
+
+procedure sys_call; external name 'sys_call';
+
+
+
+function Do_SysCall( callnr:longint;var regs : SysCallArgs ): longint;assembler;
+{
+ This routine sets up the parameters on the stack, all the parameters
+ are in reverse order on the stack (like C parameter passing).
+}
+asm
+ { load the parameters... }
+ movl regs,%eax
+ movl 24(%eax),%ebx
+ pushl %ebx
+ movl 20(%eax),%ebx
+ pushl %ebx
+ movl 16(%eax),%ebx
+ pushl %ebx
+ movl 12(%eax),%ebx
+ pushl %ebx
+ movl 8(%eax),%ebx
+ pushl %ebx
+ movl 4(%eax),%ebx
+ pushl %ebx
+ movl 0(%eax),%ebx
+ pushl %ebx
+ { set the call number }
+ movl callnr,%eax
+ call sys_call
+ addl $28,%esp
+end;
+
+
+Function SysCall( callnr:longint;var args : SysCallArgs ):longint;
+{
+ This function serves as an interface to do_SysCall.
+ If the SysCall returned a negative number, it returns -1, and puts the
+ SysCall result in errno. Otherwise, it returns the SysCall return value
+}
+var
+ funcresult : longint;
+begin
+ funcresult:=do_SysCall(callnr,args);
+ if funcresult<0 then
+ begin
+ ErrNo:=funcresult;
+ SysCall:=-1;
+ end
+ else
+ begin
+ SysCall:=funcresult;
+ errno:=0
+ end;
+end;
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/sysfiles.inc b/rtl/beos/sysfiles.inc
new file mode 100644
index 0000000000..07db164a94
--- /dev/null
+++ b/rtl/beos/sysfiles.inc
@@ -0,0 +1,18 @@
+
+const O_RDONLY=0;
+const O_WRONLY=1;
+const O_RDWR=2;
+const O_CREAT = $200;
+const O_TRUNC = $400;
+const O_APPEND = $800;
+{const O_TEXT = $4000;
+const O_BINARY = $8000;}
+
+
+function sys_open (a:cardinal;name:pchar;access:longint;b:longint;c:longint):longint; cdecl; external name 'sys_open';
+function sys_close (handle:longint):longint; cdecl; external name 'sys_close';
+function sys_read (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_read';
+function sys_write (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_write';
+function sys_lseek (handle:longint;pos:int64;whence:longint): int64; cdecl; external name 'sys_lseek';
+
+
diff --git a/rtl/beos/system.pp b/rtl/beos/system.pp
new file mode 100644
index 0000000000..a6229054bb
--- /dev/null
+++ b/rtl/beos/system.pp
@@ -0,0 +1,563 @@
+{
+ $Id: system.pp,v 1.23 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ This is a prototype file to show all function that need to be implemented
+ for a new operating system (provided the processor specific
+ function are already implemented !)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ no stack check in system }
+
+{$S-}
+unit System;
+
+interface
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+type
+ THandle = longint;
+ TThreadID = THandle;
+
+{ include heap support headers }
+
+{$I heaph.inc}
+
+{Platform specific information}
+const
+ LineEnding = #10;
+ LFNSupport = true;
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ':';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 255;
+
+const
+ FileNameCaseSensitive : boolean = true;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+
+ sLineBreak : string[1] = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+
+var
+ argc : longint;
+ argv : ppchar;
+ envp : ppchar;
+ errno : longint; // MvdV: yuckie
+
+ UnusedHandle:longint;
+ StdInputHandle:longint;
+ StdOutputHandle:longint;
+ StdErrorHandle:longint;
+
+implementation
+
+{$I sysfiles.inc}
+
+function sys_unlink (a:cardinal;name:pchar):longint; cdecl; external name 'sys_unlink';
+function sys_rename (a:cardinal;p1:pchar;b:cardinal;p2:pchar):longint; cdecl; external name 'sys_rename';
+function sys_create_area (name:pchar; var start:pointer; a,b,c,d:longint):longint; cdecl; external name 'sys_create_area';
+function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
+function sys_mkdir (a:cardinal; name:pchar; mode:cardinal):longint; cdecl; external name 'sys_mkdir';
+function sys_chdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_chdir';
+function sys_rmdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_rmdir';
+
+{$I system.inc}
+
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+procedure prthaltproc;external name '_haltproc';
+
+procedure system_exit;
+begin
+ asm
+ jmp prthaltproc
+ end;
+End;
+
+{*****************************************************************************
+ Stack check code
+*****************************************************************************}
+{ cheking the stack is done system independend in 1.1
+procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
+{
+ called when trying to get local stack if the compiler directive $S
+ is set this function must preserve esi !!!! because esi is set by
+ the calling proc for methods it must preserve all registers !!
+
+ With a 2048 byte safe area used to write to StdIo without crossing
+ the stack boundary
+}
+begin
+end;
+}
+
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l+1<=argc) then
+ paramstr:=strpas(argv[l])
+ else
+ paramstr:='';
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+begin
+ {regs.realeax:=$2c00;
+ sysrealintr($21,regs);
+ hl:=regs.realedx and $ffff;
+ randseed:=hl*$10000+ (regs.realecx and $ffff);}
+ randseed:=0;
+end;
+
+{*****************************************************************************
+ Heap Management
+*****************************************************************************}
+
+var myheapstart:pointer;
+ myheapsize:longint;
+ myheaprealsize:longint;
+ heap_handle:longint;
+ zero:longint;
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if fail }
+function Sbrk(size : longint):pointer;
+var newsize,newrealsize:longint;
+begin
+ if (myheapsize+size)<=myheaprealsize then begin
+ Sbrk:=myheapstart+myheapsize;
+ myheapsize:=myheapsize+size;
+ exit;
+ end;
+ newsize:=myheapsize+size;
+ newrealsize:=(newsize and $FFFFF000)+$1000;
+ if sys_resize_area(heap_handle,newrealsize)=0 then begin
+ Sbrk:=myheapstart+myheapsize;
+ myheapsize:=newsize;
+ myheaprealsize:=newrealsize;
+ exit;
+ end;
+ Sbrk:=nil;
+end;
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ result := sbrk(size);
+end;
+
+
+{ include standard heap management }
+{$I heap.inc}
+
+
+{****************************************************************************
+ Low level File Routines
+ All these functions can set InOutRes on errors
+ ****************************************************************************}
+
+
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+begin
+{ writeln ('CLOSE ',handle);}
+ if handle<=2 then exit;
+ InOutRes:=sys_close(handle);
+end;
+
+
+procedure do_erase(p : pchar);
+begin
+ if sys_unlink($FF000000,p)<>0 then InOutRes:=1
+ else InOutRes:=0;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+begin
+ InOutRes:=sys_rename($FF000000,p1,$FF000000,p2);
+end;
+
+function do_write(h:longint;addr:pointer;len : longint) : longint;
+begin
+{ if h>0 then begin
+ sys_write ('WRITE handle=%d ',h);
+ printf ('addr=%x ',addr);
+ printf ('len=%d',len);
+ printf ('%c',10);
+ end;}
+ do_write:=sys_write (h,addr,len,zero);
+ if (do_write<0) then begin
+ InOutRes:=do_write;
+ do_write:=0;
+ end else InOutRes:=0;
+end;
+
+function do_read(h:longint;addr:pointer;len : longint) : longint;
+begin
+{ if h>2 then begin
+ printf ('READ handle=%d ',h);
+ printf ('addr=%x ',addr);
+ printf ('len=%d',len);
+ end;}
+ do_read:=sys_read (h,addr,len,zero);
+ if (do_read<0) then begin
+ InOutRes:=do_read;
+ do_read:=0;
+ end else InOutRes:=0;
+end;
+
+function do_filepos(handle : longint) : longint;
+begin
+ do_filepos:=sys_lseek(handle,0,1); {1=SEEK_CUR}
+ if (do_filepos<0) then begin
+ InOutRes:=do_filepos;
+ do_filepos:=0;
+ end else InOutRes:=0;
+end;
+
+procedure do_seek(handle,pos : longint);
+begin
+ InOutRes:=sys_lseek(handle,pos,0);
+ if InOutRes>0 then InOutRes:=0;
+end;
+
+function do_seekend(handle:longint):longint;
+begin
+ do_seekend:=sys_lseek (handle,0,2); {2=SEEK_END}
+ if do_seekend<0 then begin
+ InOutRes:=do_seekend;
+ do_seekend:=0;
+ end else InOutRes:=0;
+end;
+
+function do_filesize(handle : longint) : longint;
+var cur:longint;
+begin
+ cur:=sys_lseek (handle,0,1); {1=SEEK_CUR}
+ if cur<0 then begin
+ InOutRes:=cur;
+ do_filesize:=0;
+ exit;
+ end;
+ do_filesize:=sys_lseek (handle,0,2); {2=SEEK_END}
+ if do_filesize<0 then begin
+ InOutRes:=do_filesize;
+ do_filesize:=0;
+ exit;
+ end;
+ cur:=sys_lseek (handle,cur,0); {0=SEEK_POS}
+ if cur<0 then begin
+ InOutRes:=cur;
+ do_filesize:=0;
+ exit;
+ end;
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+begin
+ InOutRes:=1;
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var m:longint;
+ mode,h:longint;
+begin
+{ printf ('OPEN %d ',longint(f));
+ printf (' %s',longint(p));
+ printf (' %x',flags);}
+
+ m:=0;
+ case (flags and $3) of
+ $0: begin m:=m or O_RDONLY; mode:=fminput; end;
+ $1: begin m:=m or O_WRONLY; mode:=fmoutput;end;
+ $2: begin m:=m or O_RDWR; mode:=fminout; end;
+ end;
+
+ if (flags and $100)<>0 then m:=m or O_APPEND;
+ if (flags and $1000)<>0 then m:=m or O_TRUNC or O_CREAT;
+
+{ if (flags and $10000)<>0 then m:=m or O_TEXT else m:=m or O_BINARY;}
+
+ h:=sys_open($FF000000,p,m,0,0);
+
+ if h<0 then InOutRes:=h
+ else InOutRes:=0;
+
+ if InOutRes=0 then begin
+ FileRec(f).handle:=h;
+ FileRec(f).mode:=mode;
+ end;
+end;
+
+function do_isdevice(handle:THandle):boolean;
+begin
+ do_isdevice:=false;
+ InOutRes:=0;
+end;
+
+
+{*****************************************************************************
+ UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+ Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+ Text File Handling
+*****************************************************************************}
+
+{$i text.inc}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+var t:string;
+begin
+ t:=s+#0;
+ InOutRes:=sys_mkdir ($FF000000,@t[1],493);
+end;
+
+procedure rmdir(const s : string);[IOCheck];
+var t:string;
+begin
+ t:=s+#0;
+ InOutRes:=sys_rmdir ($FF000000,@t[1]);
+end;
+
+procedure chdir(const s : string);[IOCheck];
+var t:string;
+begin
+ t:=s+#0;
+ InOutRes:=sys_chdir ($FF000000,@t[1]);
+end;
+
+{*****************************************************************************
+ getdir procedure
+*****************************************************************************}
+type dirent = packed record
+ d_dev:longint;
+ d_pdev:longint;
+ d_ino:int64;
+ d_pino:int64;
+ d_reclen:word;
+ d_name:array[0..255] of char;
+ end;
+
+ stat = packed record
+ dev:longint; {"device" that this file resides on}
+ ino:int64; {this file's inode #, unique per device}
+ mode:dword; {mode bits (rwx for user, group, etc)}
+ nlink:longint; {number of hard links to this file}
+ uid:dword; {user id of the owner of this file}
+ gid:dword; {group id of the owner of this file}
+ size:int64; {size of this file (in bytes)}
+ rdev:longint; {device type (not used)}
+ blksize:longint; {preferref block size for i/o}
+ atime:longint; {last access time}
+ mtime:longint; {last modification time}
+ ctime:longint; {last change time, not creation time}
+ crtime:longint; {creation time}
+ end;
+ pstat = ^stat;
+
+function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
+
+function FStat(Path:String;Var Info:stat):Boolean;
+{
+ Get all information on a file, and return it in Info.
+}
+var tmp:string;
+var p:pchar;
+begin
+ tmp:=path+#0;
+ p:=@tmp[1];
+ FStat:=(sys_stat($FF000000,p,@Info,0)=0);
+end;
+
+
+function sys_opendir (a:cardinal;path:pchar;b:longint):longint; cdecl; external name 'sys_opendir';
+function sys_readdir (fd:longint;var de:dirent;a:longint;b:byte):longint; cdecl; external name 'sys_readdir';
+
+function parentdir(fd:longint;dev:longint;ino:int64;var err:longint):string;
+var len:longint;
+ ent:dirent;
+ name:string;
+begin
+ err:=0;
+ parentdir:='';
+ if sys_readdir(fd,ent,$11C,1)=0 then begin
+ err:=1;
+ exit;
+ end;
+
+ len:=StrLen(@ent.d_name);
+ Move(ent.d_name,name[1],len);
+ name[0]:=chr(len);
+{ writeln ('NAME: "',name,'" = ',ent.d_dev,',',ent.d_ino);}
+ if (dev=ent.d_dev) and (ino=ent.d_ino) then begin
+ err:=0;
+ parentdir:='/'+name;
+ exit;
+ end;
+
+ err:=0;
+end;
+
+
+function getdir2:string;
+var tmp:string;
+ info:stat;
+ info2:stat;
+ fd:longint;
+ name:string;
+ cur:string;
+ res:string;
+ err:longint;
+begin
+ res:='';
+ cur:='';
+
+ repeat
+
+ FStat(cur+'.',info);
+ FStat(cur+'..',info2);
+{ writeln ('"." = ',info.dev,',',info.ino);}
+ if ((info.dev=info2.dev) and (info.ino=info2.ino)) then begin
+ if res='' then getdir2:='/' else getdir2:=res;
+ exit;
+ end;
+
+ tmp:=cur+'..'+#0;
+ fd:=sys_opendir ($FF000000,@tmp[1],0);
+ repeat
+ name:=parentdir(fd,info.dev,info.ino,err);
+ until (err<>0) or (name<>'');
+ if err<>0 then begin
+ getdir2:='';
+ exit;
+ end;
+ res:=name+res;
+{ writeln(res);}
+ cur:=cur+'../';
+ until false;
+end;
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+begin
+ drivenr:=0;
+ dir:=getdir2;
+end;
+
+
+function GetProcessID:SizeUInt;
+begin
+{$WARNING To be corrected by platform maintainer}
+ GetProcessID := 1;
+end;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+ { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+ displayed in and messagebox }
+ StdInputHandle:=0;
+ StdOutputHandle:=1;
+ StdErrorHandle:=2;
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+begin
+{ Setup heap }
+ zero:=0;
+ myheapsize:=$2000;
+ myheaprealsize:=$2000;
+ myheapstart:=nil;
+ heap_handle:=sys_create_area('fpcheap',myheapstart,0,myheaprealsize,0,3);//!!
+ if heap_handle>0 then begin
+ InitHeap;
+ end else system_exit;
+ SysInitExceptions;
+
+{ Setup IO }
+ SysInitStdIO;
+
+{ Reset IO Error }
+ InOutRes:=0;
+(* This should be changed to a real value during *)
+(* thread driver initialization if appropriate. *)
+ ThreadID := 1;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+end.
+{
+ $Log: system.pp,v $
+ Revision 1.23 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.22 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.21 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.20 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/beos/sysutils.pp b/rtl/beos/sysutils.pp
new file mode 100644
index 0000000000..2a1da6f336
--- /dev/null
+++ b/rtl/beos/sysutils.pp
@@ -0,0 +1,333 @@
+{
+ $Id: sysutils.pp,v 1.12 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for BeOS
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ beos,
+ dos;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+BEGIN
+end;
+
+
+Function FileCreate (Const FileName : String) : longint;
+begin
+end;
+
+Function FileCreate (Const FileName : String;Mode:longint) : longint;
+begin
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+begin
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+begin
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : longint) : longint;
+begin
+end;
+
+Function FileSeek (Handle:longint;FOffset,Origin : int64) : int64;
+begin
+end;
+
+
+Procedure FileClose (Handle : Longint);
+begin
+end;
+
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+begin
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+begin
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+begin
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+begin
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+begin
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+begin
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+begin
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+begin
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+begin
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+begin
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+begin
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+begin
+end;
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+Function DiskFree(Drive: Byte): int64;
+Begin
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+Begin
+End;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir(0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+function DirectoryExists (const Directory: string): boolean;
+begin
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+begin
+end ;
+
+
+Procedure InitAnsi;
+Var
+ i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Str(Errorcode,Result);
+ Result:='Error '+Result;
+end;
+
+{****************************************************************************
+ OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=StrPas(beos.Getenv(PChar(EnvVar)));
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ // Result:=FPCCountEnvVar(EnvP);
+ Result:=0;
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ // Result:=FPCGetEnvStrFromP(Envp,Index);
+ Result:='';
+end;
+
+
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+ integer;
+
+var
+ CommandLine: AnsiString;
+
+begin
+ { always surround the name of the application by quotes
+ so that long filenames will always be accepted. But don't
+ do it if there are already double quotes!
+ }
+ if pos('"',path)=0 then
+ CommandLine:='"'+path+'"'
+ else
+ CommandLine:=path;
+ if ComLine <> '' then
+ CommandLine := Commandline + ' ' + ComLine;
+ ExecuteProcess := beos.shell (CommandLine);
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+
+{$WARNING Should be probably changed according to the Unix version}
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+{
+ $Log: sysutils.pp,v $
+ Revision 1.12 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.11 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/beos/timezone.inc b/rtl/beos/timezone.inc
new file mode 100644
index 0000000000..19f202a295
--- /dev/null
+++ b/rtl/beos/timezone.inc
@@ -0,0 +1,435 @@
+{
+ $Id: timezone.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by the Free Pascal development team.
+
+ Timezone extraction routines
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ TZ_MAGIC = 'TZif';
+
+type
+ plongint=^longint;
+ pbyte=^byte;
+
+ ttzhead=packed record
+ tzh_magic : array[0..3] of char;
+ tzh_reserved : array[1..16] of byte;
+ tzh_ttisgmtcnt,
+ tzh_ttisstdcnt,
+ tzh_leapcnt,
+ tzh_timecnt,
+ tzh_typecnt,
+ tzh_charcnt : longint;
+ end;
+
+ pttinfo=^tttinfo;
+ tttinfo=packed record
+ offset : longint;
+ isdst : boolean;
+ idx : byte;
+ isstd : byte;
+ isgmt : byte;
+ end;
+
+ pleap=^tleap;
+ tleap=record
+ transition : longint;
+ change : longint;
+ end;
+
+var
+ num_transitions,
+ num_leaps,
+ num_types : longint;
+
+ transitions : plongint;
+ type_idxs : pbyte;
+ types : pttinfo;
+ zone_names : pchar;
+ leaps : pleap;
+
+function find_transition(timer:time_t):pttinfo;
+var
+ i : longint;
+begin
+ if (num_transitions=0) or (timer<time_t(transitions[0])) then
+ begin
+ i:=0;
+ while (i<num_types) and (types[i].isdst) do
+ inc(i);
+ if (i=num_types) then
+ i:=0;
+ end
+ else
+ begin
+ for i:=1 to num_transitions do
+ if (timer<transitions[i]) then
+ break;
+ i:=type_idxs[i-1];
+ end;
+ find_transition:=@types[i];
+end;
+
+
+procedure GetLocalTimezone(timer:time_t;var leap_correct,leap_hit:longint);
+var
+ info : pttinfo;
+ i : longint;
+begin
+{ reset }
+ TZDaylight:=false;
+ TZSeconds:=0;
+ TZName[false]:=nil;
+ TZName[true]:=nil;
+ leap_correct:=0;
+ leap_hit:=0;
+{ get info }
+ info:=find_transition(timer);
+ if not assigned(info) then
+ exit;
+ TZDaylight:=info^.isdst;
+ TZSeconds:=info^.offset;
+ i:=0;
+ while (i<num_types) do
+ begin
+ tzname[types[i].isdst]:=@zone_names[types[i].idx];
+ inc(i);
+ end;
+ tzname[info^.isdst]:=@zone_names[info^.idx];
+ i:=num_leaps;
+ repeat
+ if i=0 then
+ exit;
+ dec(i);
+ until (timer>leaps[i].transition);
+ leap_correct:=leaps[i].change;
+ if (timer=leaps[i].transition) and
+ (((i=0) and (leaps[i].change>0)) or
+ (leaps[i].change>leaps[i-1].change)) then
+ begin
+ leap_hit:=1;
+ while (i>0) and
+ (leaps[i].transition=leaps[i-1].transition+1) and
+ (leaps[i].change=leaps[i-1].change+1) do
+ begin
+ inc(leap_hit);
+ dec(i);
+ end;
+ end;
+end;
+
+
+procedure GetLocalTimezone(timer:longint);
+var
+ lc,lh : longint;
+begin
+ GetLocalTimezone(timer,lc,lh);
+end;
+
+
+procedure ReadTimezoneFile(fn:string);
+
+ procedure decode(var l:longint);
+ var
+ k : longint;
+ p : pbyte;
+ begin
+ p:=pbyte(@l);
+ if (p[0] and (1 shl 7))<>0 then
+ k:=not 0
+ else
+ k:=0;
+ k:=(k shl 8) or p[0];
+ k:=(k shl 8) or p[1];
+ k:=(k shl 8) or p[2];
+ k:=(k shl 8) or p[3];
+ l:=k;
+ end;
+
+var
+ f : File;
+ tzdir : string;
+ tzhead : ttzhead;
+ i : longint;
+ chars : longint;
+ buf : pbyte;
+ _result : longint;
+ label lose;
+begin
+ if fn = '' then
+ exit;
+{$IFOPT I+}
+{$DEFINE IOCHECK_ON}
+{$ENDIF}
+{$I-}
+ Assign(F, fn);
+ Reset(F,1);
+ If IOResult <> 0 then
+ exit;
+{$IFDEF IOCHECK_ON}
+{$I+}
+{$ENDIF}
+{$UNDEF IOCHECK_ON}
+ BlockRead(f,tzhead,sizeof(tzhead),i);
+ if i<>sizeof(tzhead) then
+ goto lose;
+ if tzhead.tzh_magic<>TZ_MAGIC then
+ begin
+ goto lose;
+ end;
+ decode(tzhead.tzh_timecnt);
+ decode(tzhead.tzh_typecnt);
+ decode(tzhead.tzh_charcnt);
+ decode(tzhead.tzh_leapcnt);
+ decode(tzhead.tzh_ttisstdcnt);
+ decode(tzhead.tzh_ttisgmtcnt);
+
+ num_transitions:=tzhead.tzh_timecnt;
+ num_types:=tzhead.tzh_typecnt;
+ chars:=tzhead.tzh_charcnt;
+
+ reallocmem(transitions,num_transitions*sizeof(longint));
+ reallocmem(type_idxs,num_transitions);
+ reallocmem(types,num_types*sizeof(tttinfo));
+ reallocmem(zone_names,chars);
+ reallocmem(leaps,num_leaps*sizeof(tleap));
+
+ BlockRead(f,transitions^,num_transitions*4,_result);
+ if _result <> num_transitions*4 then
+ begin
+ goto lose;
+ end;
+ BlockRead(f,type_idxs^,num_transitions,_result);
+ if _result <> num_transitions then
+ begin
+ goto lose;
+ end;
+ {* Check for bogus indices in the data file, so we can hereafter
+ safely use type_idxs[T] as indices into `types' and never crash. *}
+ for i := 0 to num_transitions-1 do
+ if (type_idxs[i] >= num_types) then
+ begin
+ goto lose;
+ end;
+
+
+ for i:=0 to num_transitions-1 do
+ decode(transitions[i]);
+
+ for i:=0 to num_types-1 do
+ begin
+ blockread(f,types[i].offset,4,_result);
+ if _result <> 4 then
+ begin
+ goto lose;
+ end;
+ blockread(f,types[i].isdst,1,_result);
+ if _result <> 1 then
+ begin
+ goto lose;
+ end;
+ blockread(f,types[i].idx,1,_result);
+ if _result <> 1 then
+ begin
+ goto lose;
+ end;
+ decode(types[i].offset);
+ types[i].isstd:=0;
+ types[i].isgmt:=0;
+ end;
+
+ blockread(f,zone_names^,chars,_result);
+ if _result<>chars then
+ begin
+ goto lose;
+ end;
+
+
+ for i:=0 to num_leaps-1 do
+ begin
+ blockread(f,leaps[i].transition,4);
+ if _result <> 4 then
+ begin
+ goto lose;
+ end;
+ blockread(f,leaps[i].change,4);
+ begin
+ goto lose;
+ end;
+ decode(leaps[i].transition);
+ decode(leaps[i].change);
+ end;
+
+ getmem(buf,tzhead.tzh_ttisstdcnt);
+ blockread(f,buf^,tzhead.tzh_ttisstdcnt,_result);
+ if _result<>tzhead.tzh_ttisstdcnt then
+ begin
+ goto lose;
+ end;
+ for i:=0 to tzhead.tzh_ttisstdcnt-1 do
+ types[i].isstd:=byte(buf[i]<>0);
+ freemem(buf);
+
+ getmem(buf,tzhead.tzh_ttisgmtcnt);
+ blockread(f,buf^,tzhead.tzh_ttisgmtcnt);
+ if _result<>tzhead.tzh_ttisgmtcnt then
+ begin
+ goto lose;
+ end;
+ for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
+ types[i].isgmt:=byte(buf[i]<>0);
+ freemem(buf);
+ close(f);
+ exit;
+lose:
+ close(f);
+end;
+
+
+{ help function to extract TZ variable data }
+function extractnumberend(tzstr: string; offset : integer): integer;
+var
+ j: integer;
+begin
+ j:=0;
+ extractnumberend := 0;
+ repeat
+ if (offset+j) > length(tzstr) then
+ begin
+ exit;
+ end;
+ inc(j);
+ until not (tzstr[offset+j] in ['0'..'9']);
+ extractnumberend := offset+j;
+end;
+
+function getoffsetseconds(tzstr: string): longint;
+{ extract GMT timezone information }
+{ Returns the number of minutes to }
+{ add or subtract to the GMT time }
+{ to get the local time. }
+{ Format of TZ variable (POSIX) }
+{ std offset dst }
+{ std = characters of timezone }
+{ offset = hh[:mm] to add to GMT }
+{ dst = daylight savings time }
+{ CURRENTLY DOES NOT TAKE CARE }
+{ OF SUMMER TIME DIFFERENCIAL }
+var
+ s: string;
+ i, j: integer;
+ code : integer;
+ hours : longint;
+ minutes : longint;
+ negative : boolean;
+begin
+ hours:=0;
+ minutes:=0;
+ getoffsetseconds := 0;
+ negative := FALSE;
+ i:=-1;
+ { get to offset field }
+ repeat
+ if i > length(tzstr) then
+ begin
+ exit;
+ end;
+ inc(i);
+ until (tzstr[i] = '-') or (tzstr[i] in ['0'..'9']);
+ if tzstr[i] = '-' then
+ begin
+ Inc(i);
+ negative := TRUE;
+ end;
+ j:=extractnumberend(tzstr,i);
+ s:=copy(tzstr,i,j-i);
+ val(s,hours,code);
+ if code <> 0 then
+ begin
+ exit;
+ end;
+ if tzstr[j] = ':' then
+ begin
+ i:=j;
+ Inc(i);
+ j:=extractnumberend(tzstr,i);
+ s:=copy(tzstr,i,j-i);
+ val(s,minutes,code);
+ if code <> 0 then
+ begin
+ exit;
+ end;
+ end;
+ if negative then
+ begin
+ minutes := -minutes;
+ hours := -hours;
+ end;
+ getoffsetseconds := minutes*60 + hours*3600;
+end;
+
+
+procedure InitLocalTime;
+var
+ tloc: time_t;
+ s : string;
+begin
+ TZSeconds:=0;
+ { try to get the POSIX version }
+ { of the local time offset }
+ { if '', then it does not exist }
+ { if ': ..', then non-POSIX }
+ s:=GetTimezoneString;
+ if (s<>'') and (s[1]<>':') then
+ begin
+ TZSeconds := getoffsetseconds(s);
+ end
+ else
+ begin
+ s:=GetTimeZoneFile;
+ { only read if there is something to read }
+ if s<>'' then
+ begin
+ ReadTimezoneFile(s);
+ tloc:=sys_time(tloc);
+ GetLocalTimezone(tloc);
+ end;
+ end;
+end;
+
+
+procedure DoneLocalTime;
+begin
+ if assigned(transitions) then
+ freemem(transitions);
+ if assigned(type_idxs) then
+ freemem(type_idxs);
+ if assigned(types) then
+ freemem(types);
+ if assigned(zone_names) then
+ freemem(zone_names);
+ if assigned(leaps) then
+ freemem(leaps);
+ num_transitions:=0;
+ num_leaps:=0;
+ num_types:=0;
+end;
+
+
+
+{
+ $Log: timezone.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/bunxfunch.inc b/rtl/bsd/bunxfunch.inc
new file mode 100644
index 0000000000..8a2e09c17a
--- /dev/null
+++ b/rtl/bsd/bunxfunch.inc
@@ -0,0 +1,68 @@
+{
+ $Id: bunxfunch.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ Headerfile of bunxfunc.inc (which should be calls needed for the
+ Baseunix unit, but not for system)
+
+ Some calls that can be used for both Linux and *BSD will be
+ moved to a /unix/ includedfile later.
+
+ Note: calls named in bunxh.inc aren't listed here.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+//Function FpSigProcMask(how : cInt; Const nset : TSigSet; var oset : TSigSet): cInt;
+//Function FPKill(Pid:pid_t;Sig:cint):cint;
+//function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint;
+//Function FPSigPending(var nset: sigset_t):cint;
+//function FPsigsuspend(const sigmask:sigset_t):cint;
+Function SetITimer(Which : Longint;Const value : ItimerVal; var VarOValue:ItimerVal):Longint;
+Function GetITimer(Which : Longint;Var value : ItimerVal):Longint;
+//Function FPalarm(Seconds: cuint):cuint;
+//function sigblock(mask:cuint):cint;
+//function sigpause(sigmask:cint):cint;
+//function FPpause:cint;
+//function FPsleep(seconds:cuint):cuint;
+//function FPuname(var name:utsname):cint;
+//function FPwait(var stat_loc:cint): pid_t;
+//function FPgetpid : pid_t;
+//function FPgetppid : pid_t;
+//function FPgetuid : uid_t;
+//function FPgeteuid : uid_t;
+//function FPgetgid : gid_t;
+//function FPgetegid : gid_t;
+//function FPsetuid(uid : uid_t): cint;
+//function FPsetgid(gid : gid_t): cint;
+//function FPgetgroups(gidsetsize : cint; var grouplist:tgrparr): cint;
+//function FPgetpgrp : pid_t;
+//function FPsetsid : pid_t;
+//Function FPumask(cmask:mode_t):mode_t;
+//Function FPlink(existing:pchar;newone:pchar):cint;
+//Function FPmkfifo(path:pchar;mode:mode_t):cint;
+//Function FPchmod(path:pchar;mode:mode_t):cint;
+//Function FPchown(path:pchar;owner:uid_t;group:gid_t):cint;
+//Function FPUtime(path:pchar;times:putimbuf):cint;
+//Function FPpipe(var fildes : tfildes):cint;
+//function FPfcntl(fildes:cint;Cmd:cint;Arg:cint):cint;
+//function FPfcntl(fildes:cint;Cmd:cint;var Arg:flock):cint;
+//function FPfcntl(fildes:cint;Cmd:cint):cint;
+//function FPexecve(path:pchar;argv:ppchar;envp:ppchar):cint;
+//function FPexecv(path:pchar;argv:ppchar):cint;
+function FPgetrusage(who:cint;var ru : rusage):cint;
+//function FPtimes(var buffer : tms):clock_t;
+
+{
+ $Log: bunxfunch.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/bunxsysc.inc b/rtl/bsd/bunxsysc.inc
new file mode 100644
index 0000000000..eb6b01f59f
--- /dev/null
+++ b/rtl/bsd/bunxsysc.inc
@@ -0,0 +1,545 @@
+{
+ $Id: bunxsysc.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ Calls needed for the POSIX unit, but not for system.
+ Some calls that can be used for both Linux and *BSD will be
+ moved to a /unix/ includedfile later.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function FPKill(Pid:pid_t;Sig:cint):cint;
+{
+ Send signal 'sig' to a process, or a group of processes.
+ If Pid > 0 then the signal is sent to pid
+ pid=-1 to all processes except process 1
+ pid < -1 to process group -pid
+ Return value is zero, except for case three, where the return value
+ is the number of processes to which the signal was sent.
+}
+
+begin
+ FPkill:=do_syscall(syscall_nr_kill,pid,sig);
+// if kill<0 THEN
+// Kill:=0;
+end;
+
+Function FPSigPending(var nset: sigset_t):cint;
+{
+ Allows examination of pending signals. The signal mask of pending
+ signals is set in SSet
+}
+begin
+ FPsigpending:=do_syscall(syscall_nr_sigpending,longint(@nset));
+end;
+
+function FPsigsuspend(const sigmask:sigset_t):cint;
+{
+ Set the signal mask with Mask, and suspend the program until a signal
+ is received.
+}
+
+begin
+ FPsigsuspend:= do_syscall(syscall_nr_sigsuspend,longint(@sigmask));
+end;
+
+Type // implementation side for now. Should move to BSD unit.
+ ITimerVal= Record
+ It_Interval,
+ It_Value : TimeVal;
+ end;
+
+Const ITimer_Real =0;
+ ITimer_Virtual =1;
+ ITimer_Prof =2;
+
+Function SetITimer(Which : Longint;Const value : ItimerVal; var VarOValue:ItimerVal):Longint;
+
+Begin
+ SetItimer:=Do_Syscall(syscall_nr_setitimer,Which,Longint(@Value),longint(@varovalue));
+End;
+
+Function GetITimer(Which : Longint;Var value : ItimerVal):Longint;
+
+Begin
+ GetItimer:=Do_Syscall(syscall_nr_getItimer,Which,Longint(@value));
+End;
+
+Function FPalarm(Seconds: cuint):cuint;
+
+Var it,oitv : Itimerval;
+
+Begin
+// register struct itimerval *itp = &it;
+
+ it.it_interval.tv_sec:=0;
+ it.it_interval.tv_usec:=0;
+ it.it_value.tv_sec:=seconds;
+ it.it_value.tv_usec:=0;
+ If SetITimer(ITIMER_REAL,it,oitv)<0 Then
+ Exit(-1);
+
+ if oitv.it_value.tv_usec<>0 Then
+ Inc(oitv.it_value.tv_sec);
+ FPAlarm:=oitv.it_value.tv_sec;
+End;
+
+function sigblock(mask:cuint):cint;
+{Depreciated, but used by pause.}
+
+var nset,oset: sigset_t;
+
+begin
+ FPsigemptyset(nset);
+ nset[0]:=mask;
+ sigblock:= FPsigprocmask(SIG_BLOCK,@nset,@oset); // SIG_BLOCK=1
+ if sigblock=0 Then
+ sigblock:=oset[0];
+end;
+
+function sigpause(sigmask:cint):cint;
+{Depreciated, but used by pause.}
+
+var nset: sigset_t;
+
+begin
+ FPsigemptyset(nset);
+ nset[0]:=sigmask;
+ sigpause:= FPsigsuspend(nset);
+end;
+
+function FPpause:cint;
+
+begin
+ FPpause:=sigpause(sigblock(cuint(0)));
+end;
+
+function FPsleep(seconds:cuint):cuint;
+
+var time_to_sleep,time_remaining : timespec;
+
+begin
+ {
+ * Avoid overflow when `seconds' is huge. This assumes that
+ * the maximum value for a time_t is >= INT_MAX.
+ }
+ if seconds > high(cint) Then
+ FPsleep:= (seconds - high(cint)) + FPsleep(HIGH(cint));
+
+ time_to_sleep.tv_sec := seconds;
+ time_to_sleep.tv_nsec := 0;
+ if (FPnanosleep(@time_to_sleep, @time_remaining) <> -1) Then
+ Exit(0);
+ if (fpgeterrno <> ESysEINTR) Then // EAGAIN?
+ Exit (seconds); { best guess }
+ FPsleep:= time_remaining.tv_sec;
+ if (time_remaining.tv_nsec <> 0) Then
+ inc(FPsleep);
+End;
+
+function FPuname(var name:utsname):cint; [public,alias:'FPC_SYSC_UNAME'];
+
+Var
+ mib : array[0..1] of cint;
+ rval : cint;
+ len : size_t;
+ i : longint;
+ oerrno : cint;
+
+procedure Doone(pz:pchar;pzsize:cint;val1,val2:cint);
+
+Begin
+ mib[0] := val1;
+ mib[1] := val2;
+ len := pzsize;
+ oerrno := fpgeterrno;
+
+ if (FPsysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
+ Begin
+ if (fpgeterrno = ESysENOMEM) Then
+ fpseterrno(oerrno)
+ else
+ rval := -1;
+ End;
+ pz[pzsize- 1] := #0;
+End;
+
+Begin
+ rval := 0;
+ DoOne(@name.sysname,sizeof(name.sysname),CTL_KERN,KERN_OSTYPE);
+ DoOne(@name.nodename,sizeof(name.nodename),CTL_KERN,KERN_HOSTNAME);
+ DoOne(@name.release,sizeof(name.release),CTL_KERN,KERN_OSRELEASE);
+ { The version may have newlines in it, turn them into spaces. }
+ DoOne(@name.version,sizeof(name.version),CTL_KERN,KERN_VERSION);
+
+ For I:=0 to sizeof(name.sysname)-2 Do
+ If (name.version[i]=#13) or (name.version[i]=#9) Then
+ name.version[i]:=' ';
+ DoOne(@name.machine,sizeof(name.machine),CTL_HW,HW_MACHINE);
+ FPUname:=rval;
+end;
+
+function GetDomainName(Name:PChar; NameLen:Cint):cint; [public,alias:'FPC_SYSC_GETDOMAINNAME'];
+
+Const Mib_GetDomainName : array[0..1] of cint=(CTL_KERN,{$ifdef OpenBSD}KERN_DOMAINNAME{$ELSE}KERN_NISDOMAINNAME{$endif});
+
+VAR
+ tsize : size_t;
+begin
+ tsize := namelen;
+ if (FPsysctl(@Mib_GetDomainname, 2, name, @tsize, NIL, 0) = -1) Then
+ GetDomainName:=-1
+ Else
+ GetDomainName:=0;
+end;
+
+function GetHostName(Name:PChar; NameLen:Cint):cint;[public,alias:'FPC_SYSC_GETHOSTNAME'];
+
+Const Mib_GetHostName : array[0..1] of cint=(CTL_KERN,KERN_HOSTNAME);
+
+Var
+ tsize : size_t;
+begin
+ tsize := namelen;
+ if (FPsysctl(@Mib_GetHostName, 2, name, @tsize, NIL, 0) = -1) Then
+ GetHostName:=-1
+ Else
+ GetHostName:=0;
+End;
+
+const WAIT_ANY = -1;
+
+function FPwait(var stat_loc:cint): pid_t;
+{
+ Waits until a child with PID Pid exits, or returns if it is exited already.
+ Any resources used by the child are freed.
+ The exit status is reported in the adress referred to by Status. It should
+ be a longint.
+}
+
+begin // actually a wait4() call with 4th arg 0.
+ FPWait:=do_syscall(syscall_nr_WaitPID,WAIT_ANY,longint(@Stat_loc),0,0);
+end;
+
+//function FPgetpid : pid_t;
+
+// begin
+// FPgetpid:=do_syscall(syscall_nr_getpid);
+// end;
+
+function FPgetppid : pid_t;
+
+begin
+ FPgetppid:=do_syscall(syscall_nr_getppid);
+end;
+
+function FPgetuid : uid_t;
+
+begin
+ FPgetuid:=do_syscall(syscall_nr_getuid);
+end;
+
+function FPgeteuid : uid_t;
+
+begin
+ FPgeteuid:=do_syscall(syscall_nr_geteuid);
+end;
+
+function FPgetgid : gid_t;
+
+begin
+ FPgetgid:=do_syscall(syscall_nr_getgid);
+end;
+
+function FPgetegid : gid_t;
+
+begin
+ FPgetegid:=do_syscall(syscall_nr_getegid);
+end;
+
+function FPsetuid(uid : uid_t): cint;
+
+begin
+ FPsetuid:=do_syscall(syscall_nr_setuid,uid);
+end;
+
+function FPsetgid(gid : gid_t): cint;
+
+begin
+ FPsetgid:=do_syscall(syscall_nr_setgid,gid);
+end;
+
+// type tgrparr=array[0..0] of gid_t;
+
+function FPgetgroups(gidsetsize : cint; var grouplist:tgrparr): cint;
+
+begin
+ FPgetgroups:=do_syscall(syscall_nr_getgroups,gidsetsize,longint(@grouplist));
+end;
+
+function FPgetpgrp : pid_t;
+
+begin
+ FPgetpgrp:=do_syscall(syscall_nr_getpgrp);
+end;
+
+function FPsetsid : pid_t;
+
+begin
+ FPsetsid:=do_syscall(syscall_nr_setsid);
+end;
+
+Function FPumask(cmask:mode_t):mode_t;
+{
+ Sets file creation mask to (Mask and 0777 (octal) ), and returns the
+ previous value.
+}
+begin
+ FPumask:=Do_syscall(syscall_nr_umask,cmask);
+end;
+
+Function FPlink(existing:pchar;newone:pchar):cint;
+{
+ Proceduces a hard link from new to old.
+ In effect, new will be the same file as old.
+}
+begin
+ FPLink:=Do_Syscall(syscall_nr_link,longint(existing),longint(newone));
+end;
+
+Function FPmkfifo(path:pchar;mode:mode_t):cint;
+
+begin
+ FPmkfifo:=do_syscall(syscall_nr_mkfifo,longint(path),longint(mode));
+end;
+
+Function FPchmod(path:pchar;mode:mode_t):cint;
+
+begin
+ FPchmod:=do_syscall(syscall_nr_chmod,longint(path),longint(mode));
+end;
+
+Function FPchown(path:pchar;owner:uid_t;group:gid_t):cint;
+
+begin
+ FPChOwn:=do_syscall(syscall_nr_chown,longint(path),longint(owner),longint(group));
+end;
+
+Function FPUtime(path:pchar;times:putimbuf):cint;
+
+var tv : array[0..1] of timeval;
+ tvp : ^timeval;
+
+begin
+ if times=nil Then
+ tvp:=nil
+ else
+ begin
+ tv[0].tv_sec :=times^.actime;
+ tv[1].tv_sec :=times^.modtime;
+ tv[0].tv_usec:=0;
+ tv[1].tv_usec:=0;
+ tvp:=@tv;
+ end;
+ FPutime:=do_syscall(syscall_nr_utimes,longint(path),longint(tvp));
+end;
+
+Function FPpipe(var fildes : tfildes):cint;
+
+begin
+ FPpipe:=do_syscall(syscall_nr_pipe,longint(@fildes));
+end;
+
+function FPfcntl(fildes:cint;Cmd:cint;Arg:cint):cint;
+
+begin
+ FPfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,arg);
+end;
+
+function FPfcntl(fildes:cint;Cmd:cint;var Arg:flock):cint;
+
+begin
+ FPfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,longint(@arg));
+end;
+
+function FPfcntl(fildes:cint;Cmd:cint):cint;
+
+begin
+ FPfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd);
+end;
+
+function FPexecve(path:pchar;argv:ppchar;envp:ppchar):cint;
+
+Begin
+ FPexecve:=do_syscall(syscall_nr_Execve,longint(path),longint(argv),longint(envp));
+End;
+
+function FPexecv(path:pchar;argv:ppchar):cint;
+
+Begin
+ FPexecv:=do_syscall(syscall_nr_Execve,longint(path),longint(argv),longint(envp));
+End;
+
+CONST RUSAGE_SELF = 0;
+ RUSAGE_CHILDREN = -1;
+
+function FPgetrusage(who:cint;var ru : rusage):cint;
+
+begin
+ FPgetrusage:=do_syscall(syscall_nr_getrusage,longint(who),longint(@ru));
+end;
+
+function FPtimes(var buffer : tms):clock_t;
+
+var ru : rusage;
+ t : timeval;
+
+CONST CLK_TCK=128;
+
+function CONVTCK(r:timeval):clock_t;
+{
+ * Convert usec to clock ticks; could do (usec * CLK_TCK) / 1000000,
+ * but this would overflow if we switch to nanosec.
+ }
+begin
+ CONVTCK:=(r.tv_sec * CLK_TCK + r.tv_usec DIV (1000000 DIV CLK_TCK));
+end;
+
+begin
+
+ if (FPgetrusage(RUSAGE_SELF, ru) < 0) Then
+ exit(clock_t(-1));
+ buffer.tms_utime := CONVTCK(ru.ru_utime);
+ buffer.tms_stime := CONVTCK(ru.ru_stime);
+ if (FPgetrusage(RUSAGE_CHILDREN, ru) < 0) Then
+ exit(clock_t(-1));
+ buffer.tms_cutime := CONVTCK(ru.ru_utime);
+ buffer.tms_cstime := CONVTCK(ru.ru_stime);
+ if do_syscall(syscall_nr_gettimeofday,longint(@t),0)<>0 Then
+ exit(clock_t(-1));
+ FPtimes:=clock_t(CONVTCK(t));
+end;
+
+Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint;
+{
+ Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+ have changed.
+}
+
+begin
+ fpSelect:=do_syscall(syscall_nr_select,n,longint(readfds),longint(writefds),longint(exceptfds),longint(timeout));
+end;
+
+Function fpLstat(path:pchar;Info:pstat):cint;
+{
+ Get all information on a link (the link itself), and return it in info.
+}
+
+begin
+ fpLStat:=do_syscall(syscall_nr_lstat,TSysParam(path),TSysParam(info));
+end;
+
+Function fpLstat(Filename: ansistring;Info:pstat):cint;
+{
+ Get all information on a link (the link itself), and return it in info.
+}
+
+begin
+ fpLStat:=do_syscall(syscall_nr_lstat,TSysParam(pchar(filename)),TSysParam(info));
+end;
+
+function fpNice(N:cint):cint;
+{
+ Set process priority. A positive N means a lower priority.
+ A negative N decreases priority.
+
+Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
+}
+
+var prio : cint;
+
+begin
+ fpseterrno(0);
+ prio:=fpgetpriority(PRIO_PROCESS,0);
+ if (prio=-1) and (fpgeterrno<>0) then
+ exit(-1);
+ fpNice:=fpSetPriority(Prio_Process,0,prio+N);
+end;
+
+Function fpGetPriority(Which,Who:cint):cint;
+{
+ Get Priority of process, process group, or user.
+ Which : selects what kind of priority is used.
+ can be one of the following predefined Constants :
+ Prio_User.
+ Prio_PGrp.
+ Prio_Process.
+ Who : depending on which, this is , respectively :
+ Uid
+ Pid
+ Process Group id
+ Errors are reported in linuxerror _only_. (priority can be negative)
+}
+begin
+ if (which<prio_process) or (which>prio_user) then
+ begin
+ { We can save an interrupt here }
+ fpgetpriority:=0;
+ fpseterrno(ESysEinval);
+ end
+ else
+ begin
+ fpGetPriority:=do_syscall(syscall_nr_GetPriority,which,who);
+ end;
+end;
+
+Function fpSetPriority(Which,Who,What:cint):cint;
+{
+ Set Priority of process, process group, or user.
+ Which : selects what kind of priority is used.
+ can be one of the following predefined Constants :
+ Prio_User.
+ Prio_PGrp.
+ Prio_Process.
+ Who : depending on value of which, this is, respectively :
+ Uid
+ Pid
+ Process Group id
+ what : A number between -20 and 20. -20 is most favorable, 20 least.
+ 0 is the default.
+}
+begin
+ if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
+ fpseterrno(ESyseinval) { We can save an interrupt here }
+ else
+ begin
+ fpSetPriority:=do_syscall(Syscall_nr_Setpriority,which,who,what);
+ end;
+end;
+
+Function fpSymlink(oldname,newname:pchar):cint;
+{
+ We need this for erase
+}
+
+begin
+ fpsymlink:=do_syscall(syscall_nr_symlink,TSysParam(oldname),TSysParam(newname));
+end;
+
+{
+ $Log: bunxsysc.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+}
diff --git a/rtl/bsd/i386/syscall.inc b/rtl/bsd/i386/syscall.inc
new file mode 100644
index 0000000000..32a33ae4f3
--- /dev/null
+++ b/rtl/bsd/i386/syscall.inc
@@ -0,0 +1,209 @@
+{
+ $Id: syscall.inc,v 1.13 2005/04/24 19:11:28 marco Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Syscall functions for i386 *BSD.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+These functions are the same over all three BSDs, except that some have a
+32-bit Errno, and some a 16-bit}
+
+{$ifdef FPC_USE_SYSCALL}
+
+{$ifdef NetBSD}
+ {$UNDEF ErrnoWord}
+{$endif}
+{$ifdef FreeBSD}
+ {$DEFINE ErrnoWord}
+{$endif}
+
+procedure actualsyscall; assembler; {inline requires a dummy push IIRC}
+ asm
+ int $0x80
+ jb .LErrorcode
+ ret
+.LErrorcode:
+{$ifdef VER1_0}
+ {$ifdef ErrnoWord}
+ movw %ax,Errno
+ {$else}
+ movl %eax,Errno
+ {$endif}
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ {$ifdef ErrnoWord}
+ movw %dx,(%eax)
+ {$else}
+ movl %edx,(%eax)
+ {$endif}
+.LNoThread:
+{$endif REGCALL}
+{$endif}
+ mov $-1,%eax
+end;
+
+function FpSysCall(sysnr:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} assembler; [public,alias:'FPC_DOSYS0'];
+
+asm
+ movl sysnr,%eax
+ call actualsyscall
+end;
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS1'];
+
+ asm
+ movl sysnr,%eax
+ pushl Param1
+ call actualsyscall
+ addl $4,%esp
+ end;
+
+function FpSysCall(sysnr,param1:integer):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}assembler;[public,alias:'FPC_DOSYS1w'];
+
+ asm
+ movl sysnr,%eax
+ pushw Param1
+ call actualsyscall
+ add $2,%esp
+ end;
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}assembler; [public,alias:'FPC_DOSYS2'];
+
+ asm
+ movl sysnr,%eax
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $8,%esp
+ end;
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}assembler;[public,alias:'FPC_DOSYS3'];
+
+ asm
+ movl sysnr,%eax
+ pushl param3
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $12,%esp
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS4'];
+
+asm
+ movl sysnr,%eax
+ pushl param4
+ pushl param3
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $16,%esp
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS5'];
+
+ asm
+ movl sysnr,%eax
+ pushl param5
+ pushl param4
+ pushl param3
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $20,%esp
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} assembler;[public,alias:'FPC_DOSYS6'];
+
+asm
+ movl sysnr,%eax
+ pushl param6
+ pushl param5
+ pushl param4
+ pushl param3
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $24,%esp
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} assembler; [public,alias:'FPC_DOSYS7'];
+
+asm
+ movl sysnr,%eax
+ pushl param7
+ pushl param6
+ pushl param5
+ pushl param4
+ pushl param3
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $28,%esp
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,param8:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} assembler; [public,alias:'FPC_DOSYS8'];
+
+asm
+ movl sysnr,%eax
+ pushl param8
+ pushl param7
+ pushl param6
+ pushl param5
+ pushl param4
+ pushl param3
+ pushl param2
+ pushl Param1
+ call actualsyscall
+ addl $32,%esp
+end;
+
+{$endif}
+{
+ $Log: syscall.inc,v $
+ Revision 1.13 2005/04/24 19:11:28 marco
+ * mmap had another, yet unknown 8th parameter which must be 0 and comes after the offset param
+
+ Revision 1.12 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/i386/syscallh.inc b/rtl/bsd/i386/syscallh.inc
new file mode 100644
index 0000000000..0fcab47afd
--- /dev/null
+++ b/rtl/bsd/i386/syscallh.inc
@@ -0,0 +1,61 @@
+{
+ $Id: syscallh.inc,v 1.11 2005/04/24 19:11:28 marco Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for i386 *BSD.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+{$ifdef FPC_USE_SYSCALL}
+
+Type
+
+ TSysResult = longint; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+ TSysParam = Longint;
+
+function do_sysCall(sysnr:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS0';
+function do_sysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}external name 'FPC_DOSYS1';
+//function do_sysCall(sysnr,param1:integer):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}external name 'FPC_DOSYS1w';
+function do_sysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS2';
+function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS3';
+function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS4';
+function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS5';
+function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS6';
+function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS7';
+function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,param8:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS8';
+
+
+{$endif}
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.11 2005/04/24 19:11:28 marco
+ * mmap had another, yet unknown 8th parameter which must be 0 and comes after the offset param
+
+ Revision 1.10 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/ipcbsd.inc b/rtl/bsd/ipcbsd.inc
new file mode 100644
index 0000000000..d9b6d0d72c
--- /dev/null
+++ b/rtl/bsd/ipcbsd.inc
@@ -0,0 +1,91 @@
+{
+ $Id: ipcbsd.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by Marco van de Voort
+ member of the Free Pascal development team
+
+ *BSD syscalls for ipc unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function ftok(path:Pchar; id:cint):key_t;
+
+var st:stat;
+
+begin
+ if fpstat(path,st)<0 then
+ ftok:=key_t(-1)
+ else
+ ftok:=key_t( byte(id) shl 24 + ((st.st_dev and 255) shl 16) + (st.st_ino and $ffff));
+end;
+
+function shmget(key:key_t;size:cint;flag:cint):cint;
+begin
+ shmget:=do_syscall(syscall_nr_shmsys,3, key, size, flag);
+end;
+
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+begin
+ shmat:=pointer(do_syscall(syscall_nr_shmsys,0, shmid, TSysParam(shmaddr), shmflg));
+end;
+
+Function shmdt (shmaddr:pointer):cint;
+
+begin
+ shmdt:=do_syscall(syscall_nr_shmsys,2, TSysParam(shmaddr));
+end;
+
+Function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+
+begin
+ shmctl:= do_syscall(syscall_nr_shmsys,4, shmid, cmd, TSysParam(buf));
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+ semget:=do_syscall(syscall_nr_semsys,1, key, nsems, semflg);
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops: cuint): cint;
+begin
+ semop:=do_syscall(syscall_nr_semsys,2, semid, TSysParam(sops), nsops, 0);
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+ semctl:=cint(do_syscall(syscall_nr_semsys, 0, semid, semnum, cmd,TSysParam(@arg)));
+end;
+
+Function msgget(key: TKey; msgflg:cint):cint;
+begin
+ msgget:=do_syscall(syscall_nr_msgsys,1, key, msgflg);
+end;
+
+Function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint): cint;
+begin
+ msgsnd:=do_syscall(syscall_nr_msgsys,2, msqid, TSysParam(msgp), TSysParam(msgsz), msgflg);
+end;
+
+Function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+begin
+ msgrcv:=(do_syscall(syscall_nr_msgsys,3, msqid, TSysParam(msgp), msgsz, msgtyp, msgflg));
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+ msgctl:= (do_syscall(syscall_nr_msgsys,0, msqid, cmd, tsysparam(buf)));
+end;
+
+{
+ $Log: ipcbsd.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/osdefs.inc b/rtl/bsd/osdefs.inc
new file mode 100644
index 0000000000..397dda6af5
--- /dev/null
+++ b/rtl/bsd/osdefs.inc
@@ -0,0 +1,38 @@
+{
+ $Id: osdefs.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 2000-2002 by Marco van de Voort
+
+ Target dependent defines used when compileing the baseunix unit
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+{$define usedomain} // Allow uname with "domain" entry.
+ // (which is a GNU extension)
+{$define hassysctl} // Use sysctl unit
+
+{
+ $Log: osdefs.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.1 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+}
diff --git a/rtl/bsd/osmacro.inc b/rtl/bsd/osmacro.inc
new file mode 100644
index 0000000000..118cd95460
--- /dev/null
+++ b/rtl/bsd/osmacro.inc
@@ -0,0 +1,105 @@
+{
+ $Id: osmacro.inc,v 1.3 2005/02/15 22:27:45 jonas Exp $
+ Copyright (c) 2000-2002 by Marco van de Voort
+
+ The *BSD POSIX macro's that are used both in the Baseunix unit as the
+ system unit. Not aliased via public names because I want these to be
+ inlined as much as possible in the future.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+function FPS_ISDIR(m : TMode): boolean;
+
+begin
+ FPS_ISDIR:=((m and S_IFMT) = S_IFDIR);
+end;
+
+function FPS_ISCHR(m : TMode): boolean;
+begin
+ FPS_ISCHR:=((m and S_IFMT) = S_IFCHR);
+end;
+
+function FPS_ISBLK(m : TMode): boolean;
+begin
+ FPS_ISBLK:=((m and S_IFMT) = S_IFBLK);
+end;
+
+function FPS_ISREG(m : TMode): boolean;
+begin
+ FPS_ISREG:=((m and S_IFMT) = S_IFREG);
+end;
+
+function FPS_ISFIFO(m : TMode): boolean;
+begin
+ FPS_ISFIFO:=((m and S_IFMT) = S_IFIFO);
+end;
+
+Function FPS_ISLNK(m:TMode):boolean;
+
+begin
+ FPS_ISLNK:=((m and S_IFMT) = S_IFLNK);
+end;
+
+Function FPS_ISSOCK(m:TMode):boolean;
+
+begin
+ FPS_ISSOCK:=((m and S_IFMT) = S_IFSOCK);
+end;
+
+function wifexited(status : cint): boolean;
+begin
+ wifexited:=(status AND 127) =0;
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=status shr 8;
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=status shr 8;
+end;
+
+const wstopped=127;
+
+function wifsignaled(status : cint): boolean;
+begin
+ wifsignaled:=((status and 127)<>wstopped) and ((status and 127)<>0);
+end;
+
+function wtermsig(status : cint):cint;
+
+begin
+ wtermsig:=cint(status and 127);
+end;
+
+{
+ $Log: osmacro.inc,v $
+ Revision 1.3 2005/02/15 22:27:45 jonas
+ * fixed wifexited and wstopsig
+
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.6 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+}
diff --git a/rtl/bsd/osmain.inc b/rtl/bsd/osmain.inc
new file mode 100644
index 0000000000..ca305e8e7a
--- /dev/null
+++ b/rtl/bsd/osmain.inc
@@ -0,0 +1,16 @@
+{
+ $Id: osmain.inc,v 1.18 2005/02/13 21:47:56 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Main OS dependant body of the system unit, loosely modelled
+ after POSIX. *BSD version (Linux version is near identical)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
diff --git a/rtl/bsd/ossysc.inc b/rtl/bsd/ossysc.inc
new file mode 100644
index 0000000000..d17f632b53
--- /dev/null
+++ b/rtl/bsd/ossysc.inc
@@ -0,0 +1,556 @@
+{
+ $Id: ossysc.inc,v 1.26 2005/04/24 19:11:28 marco Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ The base *BSD syscalls required to implement the system unit. These
+ are aliased for use in other units (to avoid poluting the system units
+ interface)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************
+}
+
+
+function Fptime( tloc:ptime): time_t; [public, alias : 'FPC_SYSC_TIME'];
+
+VAR tv : timeval;
+ tz : timezone;
+ retval : longint;
+
+begin
+ Retval:=do_syscall(syscall_nr_gettimeofday,TSysParam(@tv),TSysParam(@tz));
+ If retval=-1 then
+ Fptime:=-1
+ else
+ Begin
+ If Assigned(tloc) Then
+ TLoc^:=tv.tv_sec;
+ Fptime:=tv.tv_sec;
+ End;
+End;
+
+{*****************************************************************************
+ --- File:File handling related calls ---
+*****************************************************************************}
+
+function Fpopen(path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN'];
+
+Begin
+ Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode));
+End;
+
+function Fpclose(fd : cint): cint; [public, alias : 'FPC_SYSC_CLOSE'];
+
+begin
+ Fpclose:=do_syscall(syscall_nr_close,fd);
+end;
+
+{$ifdef netbsd}
+ {$ifdef cpupowerpc}
+ {$define netbsdmacppc}
+ {$endif}
+{$endif}
+
+{$ifdef netbsdmacppc}
+{$i sysofft.inc} // odd ball calling convention.
+{$else}
+ // generic versions.
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; [public, alias : 'FPC_SYSC_LSEEK'];
+
+{
+this one is special for the return value being 64-bit..
+hi/lo offset not yet tested.
+
+NetBSD: ok, but implicit return value in edx:eax
+FreeBSD: same implementation as NetBSD.
+}
+
+begin
+ Fplseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,TSysParam(fd),0,lo(Offset),{0} hi(offset),Whence);
+end;
+
+function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+
+begin
+ Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
+end;
+
+{$ifdef VER1_0}
+ {$DEFINE FPC_LITTLE_ENDIAN}
+{$endif}
+
+
+Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; [public, alias: 'FPC_SYSC_MMAP'];
+
+begin
+ Fpmmap:=pointer(longint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,
+ {$ifdef FPC_BIG_ENDIAN} hi(offst),lo(offst){$endif}
+ {$ifdef FPC_LITTLE_ENDIAN} lo(offst),hi(offst){$endif},0
+ )));
+end;
+
+{$endif}
+
+
+function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
+
+begin
+ Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes);
+end;
+
+function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
+
+begin
+ Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes);
+end;
+
+function Fpunlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
+
+begin
+ Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path));
+end;
+
+function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
+
+begin
+ Fprename:=do_syscall(syscall_nr_rename,TSysParam(old),TSysParam(newpath));
+end;
+
+function Fpstat(const path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT'];
+
+begin
+ Fpstat:=do_syscall(syscall_nr_stat,TSysParam(path),TSysParam(@buf));
+end;
+
+
+{*****************************************************************************
+ --- Directory:Directory related calls ---
+*****************************************************************************}
+
+function Fpchdir(path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR'];
+
+begin
+ Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path));
+end;
+
+function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
+
+begin {Mode is 16-bit on F-BSD 4!}
+ Fpmkdir:=do_syscall(syscall_nr_mkdir,TSysParam(path),mode);
+end;
+
+function Fprmdir(path : pchar): cint; [public, alias : 'FPC_SYSC_RMDIR'];
+
+begin
+ Fprmdir:=do_syscall(syscall_nr_rmdir,TSysParam(path));
+end;
+
+{$ifndef NewReaddir}
+
+const DIRBLKSIZ=1024;
+
+
+function Fpopendir(dirname : pchar): pdir; [public, alias : 'FPC_SYSC_OPENDIR'];
+
+var
+ fd:longint;
+ st:stat;
+ ptr:pdir;
+begin
+ Fpopendir:=nil;
+ if Fpstat(dirname,st)<0 then
+ exit;
+{ Is it a dir ? }
+ if not((st.st_mode and $f000)=$4000)then
+ begin
+ errno:=ESysENOTDIR;
+ exit
+ end;
+{ Open it}
+ fd:=Fpopen(dirname,O_RDONLY,438);
+ if fd<0 then
+ Begin
+ Errno:=-1;
+ exit;
+ End;
+ new(ptr);
+ if ptr=nil then
+ Begin
+ Errno:=1;
+ exit;
+ End;
+ Getmem(ptr^.dd_buf,2*DIRBLKSIZ);
+ if ptr^.dd_buf=nil then
+ exit;
+ ptr^.dd_fd:=fd;
+ ptr^.dd_loc:=-1;
+ ptr^.dd_rewind:=longint(ptr^.dd_buf);
+ ptr^.dd_size:=0;
+// ptr^.dd_max:=sizeof(ptr^.dd_buf^);
+ Fpopendir:=ptr;
+end;
+
+function Fpclosedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR'];
+
+begin
+ Fpclosedir:=Fpclose(dirp^.dd_fd);
+ Freemem(dirp^.dd_buf);
+ dispose(dirp);
+end;
+
+function Fpreaddir(dirp : pdir) : pdirent; [public, alias : 'FPC_SYSC_READDIR'];
+
+{Different from Linux, Readdir on BSD is based on Getdents, due to the
+missing of the readdir syscall.
+Getdents requires the buffer to be larger than the blocksize.
+This usually the sectorsize =512 bytes, but maybe tapedrives and harddisks
+with blockmode have this higher?}
+
+function readbuffer:longint;
+
+var retval :longint;
+
+begin
+ Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
+ dirp^.dd_rewind:=TSysParam(dirp^.dd_buf);
+ if retval=0 then
+ begin
+ dirp^.dd_rewind:=0;
+ dirp^.dd_loc:=0;
+ end
+ else
+ dirP^.dd_loc:=retval;
+ dirP^.dd_size:=retval;
+ readbuffer:=retval;
+end;
+
+var
+ FinalEntry : pdirent;
+ novalid : boolean;
+ Reclen : Longint;
+ CurEntry : PDirent;
+
+begin
+ if (dirp^.dd_buf=nil) or (dirp^.dd_loc=0) THEN
+ exit(nil);
+ if (dirp^.dd_loc=-1) OR {First readdir on this pdir. Initial fill of buffer}
+ (dirp^.dd_rewind>=(longint(dirp^.dd_buf)+dirp^.dd_size)) then {no more entries left?}
+ Begin
+ if readbuffer=0 then {succesful read?}
+ Exit(NIL); {No more data}
+ End;
+ FinalEntry:=NIL;
+ CurEntry:=nil;
+ repeat
+ novalid:=false;
+ CurEntry:=pdirent(dirp^.dd_rewind);
+ RecLen:=CurEntry^.d_reclen;
+ if RecLen<>0 Then
+ begin {valid direntry?}
+ if CurEntry^.d_fileno<>0 then
+ FinalEntry:=CurEntry;
+ inc(dirp^.dd_rewind,Reclen);
+ end
+ else
+ begin {block entirely searched or reclen=0}
+ Novalid:=True;
+ if dirp^.dd_loc<>0 THEN {blocks left?}
+ if readbuffer()<>0 then {succesful read?}
+ novalid:=false;
+ end;
+ until (FinalEntry<>nil) or novalid;
+ If novalid then
+ FinalEntry:=nil;
+ FpReadDir:=FinalEntry;
+end;
+{$endif}
+
+{*****************************************************************************
+ --- Process:Process & program handling - related calls ---
+*****************************************************************************}
+
+procedure Fpexit(status : cint); [public, alias : 'FPC_SYSC_EXIT'];
+
+begin
+ do_syscall(syscall_nr_exit,status);
+end;
+
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+
+function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
+
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+
+begin
+ do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
+end;
+
+(*=================== MOVED from sysunix.inc ========================*)
+
+
+function Fpfstat(fd : cint; var sb : stat): cint; [public, alias : 'FPC_SYSC_FSTAT'];
+
+begin
+ fpFStat:=do_SysCall(syscall_nr_fstat,fd,TSysParam(@sb));
+end;
+
+{$ifdef NewReaddir}
+{$I readdir.inc}
+{$endif}
+
+function Fpfork : pid_t; [public, alias : 'FPC_SYSC_FORK'];
+{
+ This function issues the 'fork' System call. the program is duplicated in memory
+ and Execution continues in parent and child process.
+ In the parent process, fork returns the PID of the child. In the child process,
+ zero is returned.
+ A negative value indicates that an error has occurred, the error is returned in
+ LinuxError.
+}
+
+Begin
+ Fpfork:=Do_syscall(SysCall_nr_fork);
+End;
+
+{
+function Fpexecve(const path : pathstr; const argv : ppchar; const envp: ppchar): cint;
+}
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ environment specified in ep is passed on.
+}
+
+{
+Begin
+ path:=path+#0;
+ do_syscall(syscall_nr_Execve,TSysParam(@path[1]),TSysParam(Argv),TSysParam(envp));
+End;
+}
+{
+function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; [public, alias : 'FPC_SYSC_EXECVE'];
+}
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ environment specified in ep is passed on.
+}
+{
+Begin
+ do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(Argv),TSysParam(envp));
+End;
+}
+function Fpwaitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; [public, alias : 'FPC_SYSC_WAITPID'];
+{
+ Waits until a child with PID Pid exits, or returns if it is exited already.
+ Any resources used by the child are freed.
+ The exit status is reported in the adress referred to by Status. It should
+ be a longint.
+}
+
+begin // actually a wait4() call with 4th arg 0.
+ FpWaitPID:=do_syscall(syscall_nr_WaitPID,PID,TSysParam(Stat_loc),options,0);
+end;
+
+function Fpaccess(const pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS'];
+{
+ Test users access rights on the specified file.
+ Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+ R,W,X stand for read,write and Execute access, simultaneously.
+ F_OK checks whether the test would be allowed on the file.
+ i.e. It checks the search permissions in all directory components
+ of the path.
+ The test is done with the real user-ID, instead of the effective.
+ If access is denied, or an error occurred, false is returned.
+ If access is granted, true is returned.
+ Errors other than no access,are reported in unixerror.
+}
+
+begin
+ FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode);
+end;
+{
+function Fpaccess(const pathname : pathstr; amode : cint): cint;
+
+{
+ Test users access rights on the specified file.
+ Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+ R,W,X stand for read,write and Execute access, simultaneously.
+ F_OK checks whether the test would be allowed on the file.
+ i.e. It checks the search permissions in all directory components
+ of the path.
+ The test is done with the real user-ID, instead of the effective.
+ If access is denied, or an error occurred, false is returned.
+ If access is granted, true is returned.
+ Errors other than no access,are reported in unixerror.
+}
+
+begin
+ pathname:=pathname+#0;
+ Access:=do_syscall(syscall_nr_access, TSysParam(@pathname[1]),mode)=0;
+end;
+}
+
+Function FpDup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP'];
+
+begin
+ Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes));
+end;
+
+Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
+
+begin
+ Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
+end;
+
+
+
+Function Fpmunmap(start:pointer;len:size_t):cint; [public, alias :'FPC_SYSC_MUNMAP'];
+begin
+ Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(start),Len);
+end;
+
+
+{
+ Interface to Unix ioctl call.
+ Performs various operations on the filedescriptor Handle.
+ Ndx describes the operation to perform.
+ Data points to data needed for the Ndx function. The structure of this
+ data is function-dependent.
+}
+
+Function FpIOCtl(Handle:cint;Ndx: culong;Data: Pointer):cint; [public, alias : 'FPC_SYSC_IOCTL'];
+// This was missing here, instead hardcoded in Do_IsDevice
+begin
+ FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data));
+end;
+
+
+Function FpGetPid:LongInt; [public, alias : 'FPC_SYSC_GETPID'];
+{
+ Get Process ID.
+}
+
+begin
+ FpGetPID:=do_syscall(syscall_nr_getpid);
+end;
+
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; [public, alias: 'FPC_SYSC_GETTIMEOFDAY'];
+
+begin
+ fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp));
+end;
+
+function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, alias : 'FPC_SYSC_SIGPROCMASK'];
+
+{
+ Change the list of currently blocked signals.
+ How determines which signals will be blocked :
+ SigBlock : Add SSet to the current list of blocked signals
+ SigUnBlock : Remove the signals in SSet from the list of blocked signals.
+ SigSetMask : Set the list of blocked signals to SSet
+ if OldSSet is non-null, the old set will be saved there.
+}
+
+begin
+ FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset));
+end;
+{$user BLA!}
+Function FpNanoSleep(req : ptimespec;rem : ptimespec) : cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
+begin
+ FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem));
+end;
+
+function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD'];
+const intpathmax = 1024-4; // didn't use POSIX data in libc
+ // implementation.
+var ept,bpt : pchar;
+ c : char;
+ ret : cint;
+
+begin
+ if pt=NIL Then
+ begin
+ // POSIX: undefined. (exit(nil) ?)
+ // BSD : allocate mem for path.
+ getmem(pt,intpathmax);
+ if pt=nil Then
+ exit(nil);
+ ept:=pt+intpathmax;
+ end
+ else
+ Begin
+ if (_size=0) Then
+ Begin
+ seterrno(ESysEINVAL);
+ exit(nil);
+ End;
+ if (_size=1) Then
+ Begin
+ seterrno(ESysERANGE);
+ exit(nil);
+ End;
+ ept:=pt+_size;
+ end;
+
+ ret := do_syscall(syscall_nr___getcwd,TSysParam(pt),TSysParam( ept - pt));
+ If (ret = 0) Then
+ If (pt[0] <> '/') Then
+ Begin
+ bpt := pt;
+ ept := pt + strlen(pt) - 1;
+ While (bpt < ept) Do
+ Begin
+ c := bpt^;
+ bpt^:=ept^;
+ inc(bpt);
+ ept^:=c;
+ dec(ept);
+ End;
+ End;
+ Fpgetcwd:=pt;
+end;
+
+Function fpReadLink(name,linkname:pchar;maxlen:size_t):cint; [public, alias : 'FPC_SYSC_READLINK'];
+
+begin
+ fpreadlink:=do_syscall(syscall_nr_readlink, TSysParam(name),TSysParam(linkname),maxlen);
+end;
+
+{
+ $Log: ossysc.inc,v $
+ Revision 1.26 2005/04/24 19:11:28 marco
+ * mmap had another, yet unknown 8th parameter which must be 0 and comes after the offset param
+
+ Revision 1.25 2005/03/13 14:11:06 marco
+ * fix from mischi
+
+ Revision 1.24 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.23 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.22 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+ Revision 1.21 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+}
diff --git a/rtl/bsd/ostypes.inc b/rtl/bsd/ostypes.inc
new file mode 100644
index 0000000000..2ad3e53304
--- /dev/null
+++ b/rtl/bsd/ostypes.inc
@@ -0,0 +1,271 @@
+{
+ $Id: ostypes.inc,v 1.9 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Types and structures for baseunix unit, also used in system.
+
+ This file implements all the types/constants which must
+ be defined to port FPC to a new POSIX compliant OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX STRUCTURES }
+{***********************************************************************}
+
+{$ifdef FPC_IS_SYSTEM}
+ {$i ptypes.inc}
+{$ENDIF}
+
+{$ifdef cpupowerpc}
+ {$ifdef netbsd}
+ {$define netbsdpowerpc}
+ {$endif}
+{$endif}
+
+// CONST SYS_NMLN=65;
+
+// Can't find these two in Posix and in FreeBSD
+//CONST
+// _UTSNAME_LENGTH = ;
+// _UTSNAME_NODENAME_LENGTH = ;
+
+CONST // OS specific parameters for general<fd,sig>set behaviour
+ BITSINWORD = 8*sizeof(longint);
+ FD_MAXFDSET = 1024;
+ ln2bitsinword = 5; { 32bit : ln(32)/ln(2)=5 }
+ ln2bitmask = 1 shl ln2bitsinword - 1;
+ wordsinfdset = FD_MAXFDSET DIV BITSINWORD; // words in fdset_t
+ wordsinsigset = SIG_MAXSIG DIV BITSINWORD;
+
+TYPE
+ { system information services }
+ utsname = record
+ sysname : Array[0..SYS_NMLN-1] OF Char; // Name of this OS
+ nodename: Array[0..SYS_NMLN-1] OF Char; // Name of this network node.
+ release : Array[0..SYS_NMLN-1] OF Char; // Release level.
+ version : Array[0..SYS_NMLN-1] OF Char; // Version level.
+ machine : Array[0..SYS_NMLN-1] OF Char; // Hardware type.
+ end;
+ TUtsName= utsname;
+ pUtsName= ^utsname;
+
+ { file characteristics services }
+ stat = record { the types are real}
+ st_dev : dev_t; // inode's device
+ st_ino : ino_t; // inode's number
+ st_mode : mode_t; // inode protection mode
+ st_nlink : nlink_t; // number of hard links
+ st_uid : uid_t; // user ID of the file's owner
+ st_gid : gid_t; // group ID of the file's group
+ st_rdev : dev_t; // device type
+ st_atime : time_t; // time of last access
+ st_atimensec : clong; // nsec of last access
+ st_mtime : time_t; // time of last data modification
+ st_mtimensec : clong; // nsec of last data modification
+ st_ctime : time_t; // time of last file status change
+ st_ctimensec : clong; // nsec of last file status change
+{$ifdef netbsdPowerpc}
+ st_padd1 : cint;
+{$endif}
+ st_size : off_t; // file size, in bytes
+ st_blocks : cint64; // blocks allocated for file
+ st_blksize : cuint32; // optimal blocksize for I/O
+ st_flags : cuint32; // user defined flags for file
+ st_gen : cuint32; // file generation number
+{$ifdef netbsdPowerpc}
+ st_padd2 : cint;
+{$endif}
+{$ifndef NetBSD}
+ st_lspare : cint32;
+{$endif}
+ st_qspare : array[0..1] Of cint64;
+ end;
+ TStat = stat;
+ pStat = ^stat;
+
+ { directory services }
+ dirent = record
+ d_fileno : cuint32; // file number of entry
+ d_reclen : cuint16; // length of this record
+ d_type : cuint8; // file type, see below
+ d_namlen : cuint8; // length of string in d_name
+ d_name : array[0..(255 + 1)-1] of char; // name must be no longer than this
+ end;
+ TDirent = dirent;
+ pDirent = ^dirent;
+
+ dir = packed record
+ dd_fd : cint; // file descriptor associated with directory
+ dd_loc : clong; // offset in current buffer
+ dd_size : clong; // amount of data returned by getdirentries
+ dd_buf : pchar; // data buffer
+ dd_len : cint; // size of data buffer
+{$ifdef netbsdpowerpc}
+ dd_pad1 : cint;
+ dd_seek : cint64; // magic cookie returned by getdirentries
+{$else}
+ dd_seek : clong; // magic cookie returned by getdirentries
+{$endif}
+ dd_rewind : clong; // magic cookie for rewinding
+ dd_flags : cint; // flags for readdir
+ end;
+ TDir = dir;
+ pDir = ^dir;
+
+ utimbuf = record
+ actime : time_t;
+ modtime : time_t;
+ end;
+ TUtimBuf = utimbuf;
+ putimbuf = ^utimbuf;
+
+ flock = record
+ l_start : off_t; { starting offset }
+ l_len : off_t; { len = 0 means until end of file }
+ l_pid : pid_t; { lock owner }
+ l_type : cshort; { lock type: read/write, etc. }
+ l_whence: cshort; { type of l_start }
+ end;
+ TFlock = flock;
+ pFlock = ^flock;
+
+ tms = packed record
+ tms_utime : clock_t; { User CPU time }
+ tms_stime : clock_t; { System CPU time }
+ tms_cutime : clock_t; { User CPU time of terminated child procs }
+ tms_cstime : clock_t; { System CPU time of terminated child procs }
+ end;
+ TTms= tms;
+ pTms= ^tms;
+
+ TFDSet = ARRAY[0..(FD_MAXFDSET div 32)-1] of Cardinal;
+ pFDSet = ^TFDSet;
+
+{***********************************************************************}
+{ POSIX CONSTANT ROUTINE DEFINITIONS }
+{***********************************************************************}
+CONST
+ { access routine - these maybe OR'ed together }
+ F_OK = 0; { test for existence of file }
+ R_OK = 4; { test for read permission on file }
+ W_OK = 2; { test for write permission on file }
+ X_OK = 1; { test for execute or search permission }
+ { seek routine }
+ SEEK_SET = 0; { seek from beginning of file }
+ SEEK_CUR = 1; { seek from current position }
+ SEEK_END = 2; { seek from end of file }
+ { open routine }
+ { File access modes for `open' and `fcntl'. }
+ O_RDONLY = 0; { Open read-only. }
+ O_WRONLY = 1; { Open write-only. }
+ O_RDWR = 2; { Open read/write. }
+ { Bits OR'd into the second argument to open. }
+ O_CREAT = $200; { Create file if it doesn't exist. }
+ O_EXCL = $800; { Fail if file already exists. }
+ O_TRUNC = $400; { Truncate file to zero length. }
+ O_NOCTTY = $8000; { Don't assign a controlling terminal. }
+ { File status flags for `open' and `fcntl'. }
+ O_APPEND = 8; { Writes append to the file. }
+ O_NONBLOCK = 4; { Non-blocking I/O. }
+
+ { mode_t possible values }
+ S_IRUSR = %0100000000; { Read permission for owner }
+ S_IWUSR = %0010000000; { Write permission for owner }
+ S_IXUSR = %0001000000; { Exec permission for owner }
+ S_IRGRP = %0000100000; { Read permission for group }
+ S_IWGRP = %0000010000; { Write permission for group }
+ S_IXGRP = %0000001000; { Exec permission for group }
+ S_IROTH = %0000000100; { Read permission for world }
+ S_IWOTH = %0000000010; { Write permission for world }
+ S_IXOTH = %0000000001; { Exec permission for world }
+
+ { Used for waitpid }
+ WNOHANG = 1; { don't block waiting }
+ WUNTRACED = 2; { report status of stopped children }
+
+
+ { For File control mechanism }
+ F_GetFd = 1;
+ F_SetFd = 2;
+ F_GetFl = 3;
+ F_SetFl = 4;
+ F_GetLk = 5;
+ F_SetLk = 6;
+ F_SetLkW = 7;
+ F_SetOwn = 8;
+ F_GetOwn = 9;
+
+
+type
+ timezone = packed record
+ tz_minuteswest,
+ tz_dsttime : cint;
+ end;
+ ptimezone =^timezone;
+ TTimeZone = timezone;
+
+ rusage = packed record
+ ru_utime : timeval; { user time used }
+ ru_stime : timeval; { system time used }
+ ru_maxrss : clong; { max resident set size }
+ ru_ixrss : clong; { integral shared memory size }
+ ru_idrss : clong; { integral unshared data " }
+ ru_isrss : clong; { integral unshared stack " }
+ ru_minflt : clong; { page reclaims }
+ ru_majflt : clong; { page faults }
+ ru_nswap : clong; { swaps }
+ ru_inblock : clong; { block input operations }
+ ru_oublock : clong; { block output operations }
+ ru_msgsnd : clong; { messages sent }
+ ru_msgrcv : clong; { messages received }
+ ru_nsignals : clong; { signals received }
+ ru_nvcsw : clong; { voluntary context switches }
+ ru_nivcsw : clong; { involuntary " }
+ end;
+// #define ru_last ru_nivcsw
+// #define ru_first ru_ixrss
+
+{ auto generated by a c prog, statmacr.c}
+
+Const
+ S_IFMT = 61440;
+ S_IFIFO = 4096;
+ S_IFCHR = 8192;
+ S_IFDIR = 16384;
+ S_IFBLK = 24576;
+ S_IFREG = 32768;
+ S_IFLNK = 40960;
+ S_IFSOCK= 49152;
+ S_IFWHT = 57344;
+ S_ISVTX = 512;
+
+CONST
+ { Constansts for MMAP }
+ MAP_PRIVATE =2;
+ MAP_ANONYMOUS =$1000;
+
+ {*************************************************************************}
+ { SIGNALS }
+ {*************************************************************************}
+
+{$i signal.inc}
+
+
+{
+ $Log: ostypes.inc,v $
+ Revision 1.9 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.8 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+}
diff --git a/rtl/bsd/powerpc/syscall.inc b/rtl/bsd/powerpc/syscall.inc
new file mode 100644
index 0000000000..b8874018e4
--- /dev/null
+++ b/rtl/bsd/powerpc/syscall.inc
@@ -0,0 +1,176 @@
+{
+ $Id: syscall.inc,v 1.6 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Syscalls for NetBSD/macppc. Merged from an initial version,
+ Jonas' linux version and some testing checking.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+end;
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+end;
+
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+end;
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ mr r7,r8
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ mr r7,r8
+ mr r8,r9
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ li r4,-1
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL7'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ mr r7,r8
+ mr r8,r9
+ mr r9,r10
+ sc
+ bnslr
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ li r4,-1
+end;
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.6 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
+
diff --git a/rtl/bsd/powerpc/syscallh.inc b/rtl/bsd/powerpc/syscallh.inc
new file mode 100644
index 0000000000..3382eb399b
--- /dev/null
+++ b/rtl/bsd/powerpc/syscallh.inc
@@ -0,0 +1,51 @@
+{
+ $Id: syscallh.inc,v 1.3 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for powerpc *nix.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+
+ TSysResult = longint; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+ TSysParam = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult; external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64; external name 'FPC_SYSCALL6';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64; external name 'FPC_SYSCALL7';
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.3 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/readme.txt b/rtl/bsd/readme.txt
new file mode 100644
index 0000000000..819df81036
--- /dev/null
+++ b/rtl/bsd/readme.txt
@@ -0,0 +1,51 @@
+{
+ $Id: readme.txt,v 1.2 2002/10/27 11:58:30 marco Exp $
+ This file is part of the Free Pascal run time librar~y.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ Filellist and some notes about the *BSD RTL architecture.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+*BSD commonly means FreeBSD, OpenBSD and NetBSD, but since Apple's Darwin
+ has a FreeBSD userland, I also add Darwin to it. At least Darwin's
+ userland seems to be compatible enough to be included, despite its
+ internal Mach architecture.
+
+Common *BSD files:
+
+bsdmacro.inc The POSIX mode_t (IS_DIR etc) and exit macro's.
+bsdsysc.inc The base syscalls for *BSD system unit.
+ including a few that are _not_ posix, but still
+ required in the system unit. All routines have
+ a public alias.
+bsdsysch.inc EXTERNAL declarations for the non-posix calls in
+ bsdsysc.inc (to import them into e.g. Unix)
+bsdtypes.inc some non POSIX BSD types required for the
+ syscalls and base functions.
+bsdfuncs.inc POSIX syscalls and functions that are not needed
+ for system.
+osposix.inc The implementation of unit posix, redirects to libc
+ or bsdtypes.inc (via aliases)
+osposixh.inc The headers of unit posix.
+sysctl.pp Some basic sysctl headers, needed for implementation
+ of POSIX functions.
+sysposix.inc BSD specific part of the implementation
+i386/syscall.inc The primitives for performing syscalls
+i386/syscallh.inc Headers to syscall.inc
+powerpc/syscall.inc likewise for PPC.
+
+{
+ $Log: readme.txt,v $
+ Revision 1.2 2002/10/27 11:58:30 marco
+ * Modifications from Saturday.
+
+}
diff --git a/rtl/bsd/sysbsd.pp b/rtl/bsd/sysbsd.pp
new file mode 100644
index 0000000000..1fbfae9a0d
--- /dev/null
+++ b/rtl/bsd/sysbsd.pp
@@ -0,0 +1,19 @@
+{
+ $Id: sysbsd.pp,v 1.3 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time librar~y.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ For bootstrapping with 1.0.x compilers (which still want sysbsd
+ as system unit name)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$i system.pp}
diff --git a/rtl/bsd/sysctl.pp b/rtl/bsd/sysctl.pp
new file mode 100644
index 0000000000..e6f7d95ac9
--- /dev/null
+++ b/rtl/bsd/sysctl.pp
@@ -0,0 +1,160 @@
+Unit sysctl;
+
+{ $Id: sysctl.pp,v 1.9 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2002 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ sysctl.h header conversion, taken from FreeBSD 4.6, mainly as base
+ to implement UNAME on.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+Interface
+
+{$ifndef FPC_USE_LIBC}
+{$define FPC_USE_SYSCALL}
+{$endif}
+
+{ I ptypes.inc}
+
+{$Packrecords C}
+// type psize_t=^size_t;
+Type size_t=dword;
+ psize_t=^dword;
+ cint = longint;
+ cuint = dword;
+
+{
+ * Copyright (c) 1989, 1993
+ * The Regents of the University of California. All rights reserved.
+ *
+ * This code is derived from software contributed to Berkeley by
+ * Mike Karels at Berkeley Software Design, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * @(#)sysctl.h 8.1 (Berkeley) 6/2/93
+ * $FreeBSD: src/sys/sys/sysctl.h,v 1.81.2.8 2002/03/17 11:08:38 alfred Exp $
+ }
+
+
+TYPE CtlNameRec = Record
+ Name: ansistring; {String[LongestStringInCtlNames]}
+ CtlType:cint;
+ end;
+
+
+{$I sysctlh.inc}
+
+// sysctl only one that is tested. user_definable part of the sysctl
+// function is not implemented
+//
+
+{$ifdef FPC_USE_LIBC}
+function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint; external name 'sysctl';
+function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint; external name 'sysctlbyname';
+function FPsysctlnametomib (Name: pchar;mibp:plongint;sizep:psize_t):cint; external name 'sysctltomib';
+{$else}
+function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function FPsysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
+{$endif}
+
+Implementation
+
+{$ifndef FPC_USE_LIBC}
+Uses Syscall;
+{$ENDIF}
+
+{$ifndef FPC_USE_LIBC}
+{$ifdef FreeBSD}
+CONST syscall_nr___sysctl = 202;
+{$endif}
+
+function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+
+Begin
+ if (name[0] <> chr(CTL_USER)) Then
+ exit(do_syscall(syscall_nr___sysctl,longint(name), namelen, longint(oldp), longint(oldlenp), longint(newp), longint(newlen)))
+ else
+ Exit(0);
+End;
+
+function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+Var
+ name2oid_oid : array[0..1] of cint;
+ real_oid : array[0..CTL_MAXNAME+1] of cint;
+ error : cint;
+ oidlen : size_t;
+Begin
+ name2oid_oid[0] := 0; {This is magic & undocumented! }
+ name2oid_oid[1] := 3;
+
+ oidlen := sizeof(real_oid);
+ error := FPsysctl(@name2oid_oid, 2, @real_oid, @oidlen, name,
+ strlen(name));
+ if (error < 0) Then
+ Exit(error);
+ oidlen := Oidlen DIV sizeof (cint);
+ error := FPsysctl(@real_oid, oidlen, oldp, oldlenp, newp, newlen);
+ exit(error);
+End;
+
+function FPsysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
+Var oid : array[0..1] OF cint;
+ error : cint;
+
+Begin
+ oid[0] := 0;
+ oid[1] := 3;
+ sizep^:=sizep^*sizeof(cint);
+ error := FPsysctl(@oid, 2, mibp, sizep, name, strlen(name));
+ sizep^ := sizep^ div sizeof (cint);
+
+ if (error < 0) Then
+ Exit (error);
+ FPsysctlnametomib:=0;
+End;
+{$endif}
+
+end.
+
+{
+ $Log: sysctl.pp,v $
+ Revision 1.9 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/sysos.inc b/rtl/bsd/sysos.inc
new file mode 100644
index 0000000000..c29e6e8cef
--- /dev/null
+++ b/rtl/bsd/sysos.inc
@@ -0,0 +1,190 @@
+{
+ $Id: sysos.inc,v 1.4 2005/02/13 21:47:56 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+
+const clib = 'c';
+
+type libcint=longint;
+ plibcint=^libcint;
+
+{$ifdef FreeBSD} // tested on x86
+function geterrnolocation: Plibcint; cdecl;external clib name '__error';
+{$else}
+{$ifdef NetBSD} // from a sparc dump.
+function geterrnolocation: Plibcint; cdecl;external clib name '__errno';
+{$else}
+{$ifdef Darwin}
+function geterrnolocation: Plibcint; cdecl;external clib name '__error';
+{$else}
+{$ifdef OpenBSD}
+
+var libcerrno : libcint; cvar;
+
+function geterrnolocation: Plibcint; cdecl;
+
+begin
+ geterrnolocation:=@libcerrno;
+end;
+
+{$else}
+{$endif}
+{$endif}
+{$endif}
+{$endif}
+
+function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ geterrno:=geterrnolocation^;
+end;
+
+procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
+begin
+ geterrnolocation^:=err;
+end;
+
+{$else}
+{$ifdef ver1_0}
+Var
+{$else}
+threadvar
+{$endif}
+ Errno : longint;
+
+function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ GetErrno:=Errno;
+end;
+
+procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
+
+begin
+ Errno:=err;
+end;
+{$endif}
+
+{ OS dependant parts }
+
+{$I errno.inc} // error numbers
+{$I ostypes.inc} // c-types, unix base types, unix base structures
+{$I osmacro.inc}
+
+{$ifdef FPC_USE_LIBC}
+ {$Linklib c}
+ {$i oscdeclh.inc}
+{$else}
+ {$I syscallh.inc}
+ {$I syscall.inc}
+ {$I sysnr.inc}
+ {$I ossysc.inc}
+{$endif}
+
+
+{*****************************************************************************
+ Error conversion
+*****************************************************************************}
+
+{
+ The lowlevel file functions should take care of setting the InOutRes to the
+ correct value if an error has occured, else leave it untouched
+}
+
+Function PosixToRunError (PosixErrno : longint) : longint;
+{
+ Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+ if PosixErrNo=0 then { Else it will go through all the cases }
+ exit(0);
+ case PosixErrNo of
+ ESysENFILE,
+ ESysEMFILE : Inoutres:=4;
+ ESysENOENT : Inoutres:=2;
+ ESysEBADF : Inoutres:=6;
+ ESysENOMEM,
+ ESysEFAULT : Inoutres:=217;
+ ESysEINVAL : Inoutres:=218;
+ ESysEPIPE,
+ ESysEINTR,
+ ESysEIO,
+ ESysEAGAIN,
+ ESysENOSPC : Inoutres:=101;
+ ESysENAMETOOLONG : Inoutres := 3;
+ ESysEROFS,
+ ESysEEXIST,
+ ESysENOTEMPTY,
+ ESysEACCES : Inoutres:=5;
+ ESysEISDIR : InOutRes:=5;
+ else
+ begin
+ InOutRes := Integer(PosixErrno);
+ end;
+ end;
+ PosixToRunError:=InOutRes;
+end;
+
+Function Errno2InoutRes : longint;
+
+begin
+ Errno2InoutRes:=PosixToRunError(getErrno);
+ InoutRes:=Errno2InoutRes;
+end;
+
+
+{*****************************************************************************
+ Low Level File Routines
+*****************************************************************************}
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+ Interface to Unix ioctl call.
+ Performs various operations on the filedescriptor Handle.
+ Ndx describes the operation to perform.
+ Data points to data needed for the Ndx function. The structure of this
+ data is function-dependent.
+}
+CONST
+ IOCtl_TCGETS=$5401;
+var
+ Data : array[0..255] of byte; {Large enough for termios info}
+begin
+ Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+end;
+
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.4 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.3 2005/02/07 22:04:55 peter
+ * moved to unix
+
+ Revision 1.2 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+}
+
diff --git a/rtl/bsd/sysosh.inc b/rtl/bsd/sysosh.inc
new file mode 100644
index 0000000000..08cfef1250
--- /dev/null
+++ b/rtl/bsd/sysosh.inc
@@ -0,0 +1,51 @@
+{
+ $Id: sysosh.inc,v 1.3 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+ { fd are int in C also for 64bit targets (x86_64) }
+ THandle = Longint;
+ TThreadID = THandle;
+
+ { pthread_mutex_t }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = record
+ __m_reserved: longint;
+ __m_count: longint;
+ __m_owner: pointer;
+ __m_kind: longint;
+ __m_lock: record
+ __status: sizeint;
+ __spinlock: longint;
+ end;
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.3 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+}
+
diff --git a/rtl/bsd/system.pp b/rtl/bsd/system.pp
new file mode 100644
index 0000000000..915b81d207
--- /dev/null
+++ b/rtl/bsd/system.pp
@@ -0,0 +1,284 @@
+{
+ $Id: system.pp,v 1.26 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time librar~y.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ System unit for the *BSD's.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ These things are set in the makefile, }
+{ But you can override them here.}
+
+{ If you use an aout system, set the conditional AOUT}
+{ $Define AOUT}
+
+Unit {$ifdef VER1_0}SysBSD{$else}System{$endif};
+
+Interface
+
+
+{$define FPC_USE_SIGPROCMASK}
+{$define FPC_USE_SIGALTSTACK}
+
+{$ifndef FPC_USE_LIBC}
+{$define FPC_USE_SYSCALL}
+{$endif}
+
+
+{$define FPC_IS_SYSTEM}
+
+{$I sysunixh.inc}
+
+{$ifdef Darwin}
+var argc:cardinal;
+ argv:PPchar;
+ envp:PPchar;
+{$endif}
+
+CONST SIGSTKSZ = 40960;
+
+Implementation
+
+{$I system.inc}
+
+{*****************************************************************************
+ Misc. System Dependent Functions
+*****************************************************************************}
+
+procedure System_exit;
+begin
+ Fpexit(cint(ExitCode));
+End;
+
+
+Function ParamCount: Longint;
+Begin
+ Paramcount:=argc-1
+End;
+
+
+function BackPos(c:char; const s: shortstring): integer;
+var
+ i: integer;
+Begin
+ for i:=length(s) downto 0 do
+ if s[i] = c then break;
+ if i=0 then
+ BackPos := 0
+ else
+ BackPos := i;
+end;
+
+
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit. }
+var
+ execpathstr : shortstring;
+
+function paramstr(l: longint) : string;
+ begin
+ { stricly conforming POSIX applications }
+ { have the executing filename as argv[0] }
+// if l=0 then
+// begin
+// paramstr := execpathstr;
+// end
+// else
+ paramstr:=strpas(argv[l]);
+ end;
+
+Procedure Randomize;
+Begin
+ randseed:=longint(Fptime(nil));
+End;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+function reenable_signal(sig : longint) : boolean;
+var
+ e,oe : TSigSet;
+ i,j : byte;
+begin
+ fillchar(e,sizeof(e),#0);
+ fillchar(oe,sizeof(oe),#0);
+ { set is 1 based PM }
+ dec(sig);
+ i:=sig mod 32;
+ j:=sig div 32;
+ e[j]:=1 shl i;
+ fpsigprocmask(SIG_UNBLOCK,@e,@oe);
+ reenable_signal:=geterrno=0;
+end;
+
+{$i sighnd.inc}
+
+var
+ act: SigActionRec;
+
+Procedure InstallSignals;
+var
+ oldact: SigActionRec;
+begin
+ { Initialize the sigaction structure }
+ { all flags and information set to zero }
+ FillChar(act, sizeof(SigActionRec),0);
+ { initialize handler }
+ act.sa_handler :=@SignalToRunError;
+ act.sa_flags:=SA_SIGINFO;
+ FpSigAction(SIGFPE,act,oldact);
+ FpSigAction(SIGSEGV,act,oldact);
+ FpSigAction(SIGBUS,act,oldact);
+ FpSigAction(SIGILL,act,oldact);
+end;
+
+
+procedure SetupCmdLine;
+var
+ bufsize,
+ len,j,
+ size,i : longint;
+ found : boolean;
+ buf : pchar;
+
+ procedure AddBuf;
+ begin
+ reallocmem(cmdline,size+bufsize);
+ move(buf^,cmdline[size],bufsize);
+ inc(size,bufsize);
+ bufsize:=0;
+ end;
+
+begin
+ GetMem(buf,ARG_MAX);
+ size:=0;
+ bufsize:=0;
+ i:=0;
+ while (i<argc) do
+ begin
+ len:=strlen(argv[i]);
+ if len>ARG_MAX-2 then
+ len:=ARG_MAX-2;
+ found:=false;
+ for j:=1 to len do
+ if argv[i][j]=' ' then
+ begin
+ found:=true;
+ break;
+ end;
+ if bufsize+len>=ARG_MAX-2 then
+ AddBuf;
+ if found then
+ begin
+ buf[bufsize]:='"';
+ inc(bufsize);
+ end;
+ move(argv[i]^,buf[bufsize],len);
+ inc(bufsize,len);
+ if found then
+ begin
+ buf[bufsize]:='"';
+ inc(bufsize);
+ end;
+ if i<argc then
+ buf[bufsize]:=' '
+ else
+ buf[bufsize]:=#0;
+ inc(bufsize);
+ inc(i);
+ end;
+ AddBuf;
+ FreeMem(buf,ARG_MAX);
+end;
+
+procedure SysInitStdIO;
+begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+
+{$ifdef FPC_USE_LIBC}
+
+{ can also be used with other BSD's if they use the system's crtX instead of prtX }
+
+{$ifdef Darwin}
+procedure pascalmain; external name 'PASCALMAIN';
+
+{ Main entry point in C style, needed to capture program parameters. }
+procedure main(argcparam: Longint; argvparam: ppchar; envpparam: ppchar); cdecl; [public];
+
+begin
+ argc:= argcparam;
+ argv:= argvparam;
+ envp:= envpparam;
+ pascalmain; {run the pascal main program}
+end;
+{$endif Darwin}
+{$endif FPC_USE_LIBC}
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := SizeUInt (fpGetPID);
+end;
+
+
+Begin
+ IsConsole := TRUE;
+ IsLibrary := FALSE;
+ StackLength := InitialStkLen;
+ StackBottom := Sptr - StackLength;
+ { Set up signals handlers }
+ InstallSignals;
+ { Setup heap }
+ InitHeap;
+ SysInitExceptions;
+ { Arguments }
+ SetupCmdLine;
+ { Setup stdin, stdout and stderr }
+ SysInitStdIO;
+ { Reset IO Error }
+ InOutRes:=0;
+ { threading }
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+
+{
+ $Log: system.pp,v $
+ Revision 1.26 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.25 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.24 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.23 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.22 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/bsd/unxsysch.inc b/rtl/bsd/unxsysch.inc
new file mode 100644
index 0000000000..68108b3c50
--- /dev/null
+++ b/rtl/bsd/unxsysch.inc
@@ -0,0 +1,23 @@
+{
+ $Id: unxsysch.inc,v 1.8 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; external name 'FPC_SYSC_GETTIMEOFDAY';
+
+{
+ $Log: unxsysch.inc,v $
+ Revision 1.8 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/x86_64/syscall.inc b/rtl/bsd/x86_64/syscall.inc
new file mode 100644
index 0000000000..7839e3380a
--- /dev/null
+++ b/rtl/bsd/x86_64/syscall.inc
@@ -0,0 +1,265 @@
+{
+ $Id: syscall.inc,v 1.4 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 Marco van de Voort
+ member of the Free Pascal development team.
+
+ The syscalls for the *BSD AMD64 rtl
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ Origin of this file: copied from linux/x86_64 dir, blended with the
+ freebsd x86 changes and checked against objdump of a
+ x86_64/freebsdprog
+- jge directly behind the syscall to branch on non-error
+- rcx is used as scratch reg (fpc/Linux-x86_64 uses edx)
+- More 6 and 7 param dosyscall because of the __syscall problem
+}
+
+{$ASMMODE GAS}
+
+function do_sysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+function do_sysCall(sysnr,param1 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg1. }
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+function do_sysCall(sysnr,param1,param2 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg2. }
+ movq param2, %rsi
+ mov %rcx,%r10
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg3. }
+ movq param2, %rsi
+ movq param3, %rdx
+ mov %rcx,%r10
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ movq param3, %rdx
+ movq param4, %r10
+ mov %rcx,%r10
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+function do_sysCall(sysnr,param1,param2,param3,param4,param5 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ movq param3, %rdx
+ movq param4, %r10
+ movq param5, %r8
+ mov %rcx,%r10
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+
+function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg6. }
+ movq param2, %rsi
+ movq param3, %rdx
+ movq param4, %r10
+ movq param5, %r8
+ movq param6, %r9
+ mov %rcx,%r10
+ syscall { Do the system call. }
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+.LSyscOK:
+end;
+
+procedure actualsyscall; assembler; {inline requires a dummy push IIRC}
+ asm
+ syscall
+ jge .LSyscOK { branch to exit if ok, errorhandler otherwise}
+ movq %rax,%rcx
+ movq FPC_THREADVAR_RELOCATE,%rax
+ testq %rax,%rax
+ jne .LThread
+ movq %rcx,Errno+8
+ jmp .LNoThread
+ .LThread:
+ pushq %rcx
+ pushq Errno
+ call *%rax
+ popq %rcx
+ movq %rcx,(%rax)
+ .LNoThread:
+ movq $-1,%rax
+ movq rax,%rdx
+ .LSyscOK:
+end;
+
+function do__sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,Param8:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS8';
+// Hmm, we have to do something different :)
+
+asm
+ movq param8,%rax
+ push %rax
+ movq param7,%rax
+ push %rax
+ movq $syscall_nr__syscall, %rax
+ mov %rcx,%r10
+ call actualsyscall
+ add $16,%rsp
+end;
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.4 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/bsd/x86_64/syscallh.inc b/rtl/bsd/x86_64/syscallh.inc
new file mode 100644
index 0000000000..000d6677e7
--- /dev/null
+++ b/rtl/bsd/x86_64/syscallh.inc
@@ -0,0 +1,53 @@
+{
+ $Id: syscallh.inc,v 1.2 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for i386 *BSD.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+{$ifdef FPC_USE_SYSCALL}
+
+Type
+
+ TSysResult = int64; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+ TSysParam = int64;
+
+function do_sysCall(sysnr:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS0';
+function do_sysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif}external name 'FPC_DOSYS1';
+function do_sysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS2';
+function do_sysCall(sysnr,param1,param2,param3:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS3';
+function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS4';
+function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS5';
+function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS6';
+
+// special
+function do__sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7,Param8:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS8';
+{$endif}
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.2 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/Makefile b/rtl/darwin/Makefile
new file mode 100644
index 0000000000..69c7d07698
--- /dev/null
+++ b/rtl/darwin/Makefile
@@ -0,0 +1,1917 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=darwin
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+OSPROCINC=$(RTL)/darwin/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+override FPCOPT+=-dNOMOUSE
+else
+SYSTEMUNIT="Error: Darwin is not supported for 1.0"
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+override FPCOPT+=-dFPC_USE_LIBC
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil unix initc cmem matrix dynlibs dos dl objects printer sockets sysutils typinfo classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst rtlconsts
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+dateutils$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) sysutils$(PPUEXT) math$(PPUEXT) types$(PPUEXT) sysconst$(PPUEXT) $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+strings$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : unixtype$(PPUEXT) sysctl$(PPUEXT) errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc \
+ $(BSDINC)/bunxsysc.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+unixtype$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(PPUEXT) $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc \
+ unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+dynlibs$(PPUEXT) : dl$(PPUEXT)
+ctypes$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
+dos$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unix$(PPUEXT) termio$(PPUEXT) $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : dos$(PPUEXT) $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : unix$(PPUEXT) strings$(PPUEXT) baseunix$(PPUEXT) $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+classes$(PPUEXT) : sysutils$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT) typinfo$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+typinfo$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : sysutils$(PPUEXT) $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+video$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/video.inc $(INC)/videoh.inc $(UNIXINC)/video.pp baseunix$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT)
+keyboard$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/keyboard.inc $(INC)/keybrdh.inc $(UNIXINC)/keyboard.pp mouse$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT) baseunix$(PPUEXT)
+matrix$(PPUEXT) : $(INC)/matrix.pp $(SYSTEMUNIT)$(PPUEXT)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) math$(PPUEXT)
+termio$(PPUEXT) : baseunix$(PPUEXT)
+mouse$(PPUEXT) : baseunix$(PPUEXT) video$(PPUEXT)
+dl$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT) baseunix$(PPUEXT) initc$(PPUEXT)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT) syscall$(PPUEXT)
+terminfo$(PPUEXT) : terminfo.pp baseunix$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp unix$(PPUEXT) sysutils$(PPUEXT)
+initc$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+console$(PPUEXT) : baseunix$(PPUEXT) termio$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
diff --git a/rtl/darwin/Makefile.fpc b/rtl/darwin/Makefile.fpc
new file mode 100644
index 0000000000..f00ec3f393
--- /dev/null
+++ b/rtl/darwin/Makefile.fpc
@@ -0,0 +1,266 @@
+#
+# Makefile.fpc for Free Pascal Darwin RTL
+#
+
+[package]
+main=rtl
+
+# disabled units: serial ipc
+[target]
+loaders=
+units=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings sysctl baseunix unixutil \
+ unix initc cmem matrix dynlibs \
+ dos dl objects printer sockets \
+ sysutils typinfo classes math varutils \
+ charset ucomplex getopts heaptrc lineinfo \
+ errors terminfo termio video crt mouse keyboard console \
+ variants types sysctl dateutils \
+ sysconst cthreads strutils rtlconsts
+
+rsts=math varutils typinfo classes variants dateutils sysconst rtlconsts
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=darwin
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+ unix \
+ dos crt objects printer \
+ sysutils typinfo math \
+ cpu mmx getopts heaptrc \
+ errors sockets ipc
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+OSPROCINC=$(RTL)/darwin/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+override FPCOPT+=-dNOMOUSE
+else
+SYSTEMUNIT="Error: Darwin is not supported for 1.0"
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Darwin requires libc, no syscalls
+override FPCOPT+=-dFPC_USE_LIBC
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+
+dateutils$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) sysutils$(PPUEXT) math$(PPUEXT) types$(PPUEXT) sysconst$(PPUEXT) $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+
+strings$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+baseunix$(PPUEXT) : unixtype$(PPUEXT) sysctl$(PPUEXT) errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc \
+ $(BSDINC)/bunxsysc.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+unixtype$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+
+unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(PPUEXT) $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc \
+ unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : dl$(PPUEXT)
+
+ctypes$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
+
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unix$(PPUEXT) termio$(PPUEXT) $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : dos$(PPUEXT) $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : unix$(PPUEXT) strings$(PPUEXT) baseunix$(PPUEXT) $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : sysutils$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT) typinfo$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+
+typinfo$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : sysutils$(PPUEXT) $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+video$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/video.inc $(INC)/videoh.inc $(UNIXINC)/video.pp baseunix$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT)
+
+keyboard$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/keyboard.inc $(INC)/keybrdh.inc $(UNIXINC)/keyboard.pp mouse$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT) baseunix$(PPUEXT)
+
+matrix$(PPUEXT) : $(INC)/matrix.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) math$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+termio$(PPUEXT) : baseunix$(PPUEXT)
+
+mouse$(PPUEXT) : baseunix$(PPUEXT) video$(PPUEXT)
+
+dl$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT) baseunix$(PPUEXT) initc$(PPUEXT)
+
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT) syscall$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp baseunix$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp unix$(PPUEXT) sysutils$(PPUEXT)
+
+initc$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+console$(PPUEXT) : baseunix$(PPUEXT) termio$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
diff --git a/rtl/darwin/console.pp b/rtl/darwin/console.pp
new file mode 100644
index 0000000000..d5364827bd
--- /dev/null
+++ b/rtl/darwin/console.pp
@@ -0,0 +1,3475 @@
+{ $Id: console.pp,v 1.2 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Header conversions (with FpIoctl macro expansion) for FreeBSD 4.2's
+ sys/fbio.h sys/consio.h sys/kbdio.h (together these three form
+ machine/console.h) and
+ machine/mouse.h
+
+ Converted to use in a future FreeBSD API to get the IDE running on
+ the physical console with mousesupport.
+
+ As soon as cross unit inlining is ready, all functions should be made
+ inline. (so the FpIoctl and the other very small macro's)
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+unit console;
+
+{$packrecords C}
+
+interface
+
+{I tried to keep original types as much as possible, only "int" is converted
+to longint because INT is a standard function in TP/FPC}
+
+TYPE
+ uchar = char;
+ uint = dword;
+ u_int = uint;
+ ushort= word;
+ short = integer;
+ long = dword; {?}
+ size_t= longint; {Dunno sure, but it is 32-bit}
+ caddr_t= longint; {idem}
+ vm_offset_t=dword; {idem}
+
+{----------------------------- sys/fbio.h ----------------------------------}
+
+{
+ * Copyright (c) 1992, 1993
+ * The Regents of the University of California. All rights reserved.
+ *
+ * This code is derived from software developed by the Computer Systems
+ * Engineering group at Lawrence Berkeley Laboratory under DARPA
+ * contract BG 91-66 and contributed to Berkeley.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * @(#)fbio.h 8.2 (Berkeley) 10/30/93
+ *
+ * $FreeBSD: src/sys/sys/fbio.h,v 1.9.2.1 2000/05/05 09:16:16 nyan Exp $
+ }
+
+{
+ * Frame buffer FpIoctls (from Sprite, trimmed to essentials for X11).
+ }
+
+{
+ * Frame buffer type codes.
+ }
+
+CONST
+
+ FBTYPE_SUN1BW =0; { multibus mono }
+ FBTYPE_SUN1COLOR =1; { multibus color }
+ FBTYPE_SUN2BW =2; { memory mono }
+ FBTYPE_SUN2COLOR =3; { color w/rasterop chips }
+ FBTYPE_SUN2GP =4; { GP1/GP2 }
+ FBTYPE_SUN5COLOR =5; { RoadRunner accelerator }
+ FBTYPE_SUN3COLOR =6; { memory color }
+ FBTYPE_MEMCOLOR =7; { memory 24-bit }
+ FBTYPE_SUN4COLOR =8; { memory color w/overlay }
+
+ FBTYPE_NOTSUN1 =9; { reserved for customer }
+ FBTYPE_NOTSUN2 =10; { reserved for customer }
+ FBTYPE_NOTSUN3 =11; { reserved for customer }
+
+ FBTYPE_SUNFAST_COLOR =12; { accelerated 8bit }
+ FBTYPE_SUNROP_COLOR =13; { MEMCOLOR with rop h/w }
+ FBTYPE_SUNFB_VIDEO =14; { Simple video mixing }
+ FBTYPE_RESERVED5 =15; { reserved, do not use }
+ FBTYPE_RESERVED4 =16; { reserved, do not use }
+ FBTYPE_RESERVED3 =17; { reserved, do not use }
+ FBTYPE_RESERVED2 =18; { reserved, do not use }
+ FBTYPE_RESERVED1 =19; { reserved, do not use }
+
+ FBTYPE_MDA =20;
+ FBTYPE_HERCULES =21;
+ FBTYPE_CGA =22;
+ FBTYPE_EGA =23;
+ FBTYPE_VGA =24;
+ FBTYPE_PC98 =25;
+ FBTYPE_TGA =26;
+
+ FBTYPE_LASTPLUSONE =27; { max number of fbs (change as add) }
+
+{
+ * Frame buffer descriptor as returned by FBIOGTYPE.
+ }
+
+type fbtype = record
+ fb_type : longint; { as defined above }
+ fb_height : longint; { in pixels }
+ fb_width : longint; { in pixels }
+ fb_depth : longint; { bits per pixel }
+ fb_cmsize : longint; { size of color map (entries) }
+ fb_size : longint; { total size in bytes }
+ end;
+
+Function FBIOGTYPE(fd:longint;var param1 : fbtype):boolean;
+
+{
+ * General purpose structure for passing info in and out of frame buffers
+ * (used for gp1) -- unsupported.
+ }
+type fbinfo = record
+ fb_physaddr : longint; { physical frame buffer address }
+ fb_hwwidth : longint; { fb board width }
+ fb_hwheight : longint; { fb board height }
+ fb_addrdelta : longint; { phys addr diff between boards }
+ fb_ropaddr : ^uchar; { fb virtual addr }
+ fb_unit : longint; { minor devnum of fb }
+ end;
+
+Function FBIOGINFO(fd:longint;var param1 : fbinfo):boolean;
+
+type
+{
+ * Color map I/O.
+ }
+ fbcmap = record
+ index : longint; { first element (0 origin) }
+ count : longint; { number of elements }
+ red : ^uchar; { red color map elements }
+ green : ^uchar; { green color map elements }
+ blue : ^uchar; { blue color map elements }
+ end;
+
+Function FBIOPUTCMAP(fd:longint;var param1 : fbcmap):boolean;
+Function FBIOGETCMAP(fd:longint;var param1 : fbcmap):boolean;
+
+{
+ * Set/get attributes.
+ }
+const
+ FB_ATTR_NDEVSPECIFIC =8; { no. of device specific values }
+ FB_ATTR_NEMUTYPES =4; { no. of emulation types }
+
+type fbsattr = record
+ flags:longint; { flags; see below }
+ emu_type : longint; { emulation type (-1 if unused) }
+ dev_specific : array[0..FB_ATTR_NDEVSPECIFIC-1] of longint; { catchall }
+ end;
+const
+ FB_ATTR_AUTOINIT =1; { emulation auto init flag }
+ FB_ATTR_DEVSPECIFIC =2; { dev. specific stuff valid flag }
+
+type fbgattr = record
+ real_type : longint; { real device type }
+ owner : longint; { PID of owner, 0 if myself }
+ _fbtype : fbtype; { fbtype info for real device }
+ sattr : fbsattr; { see above }
+ emu_types : array [0..FB_ATTR_NEMUTYPES-1] OF Longint; { possible emulations }
+ { (-1 if unused) }
+ end;
+
+{ FBIOSATTR _IOW('F', 5, struct fbsattr) -- unsupported }
+
+Function FBIOGATTR(fd:longint;var param1 : fbgattr):boolean;
+
+{
+ * Video control.
+ }
+
+const
+ FBVIDEO_OFF =0;
+ FBVIDEO_ON =1;
+
+Function FBIOSVIDEO(fd:longint;var param1 : longint):boolean;
+Function FBIOGVIDEO(fd:longint;var param1 : longint):boolean;
+
+{
+ * Hardware cursor control (for, e.g., CG6). A rather complex and icky
+ * interface that smells like VMS, but there it is....
+ }
+type fbcurpos = record
+ x : short;
+ y : short;
+ end;
+
+
+
+ fbcursor = record
+ _set : short; { flags; see below }
+ enable : short; { nonzero => cursor on, 0 => cursor off }
+ _pos : fbcurpos; { position on display }
+ hot : fbcurpos; { hot-spot within cursor }
+ cmap : fbcmap; { cursor color map }
+ _size : fbcurpos; { number of valid bits in image & mask }
+ image : caddr_t; { cursor image bits }
+ mask : caddr_t; { cursor mask bits }
+ end;
+
+const
+ FB_CUR_SETCUR =$01; { set on/off (i.e., obey fbcursor.enable) }
+ FB_CUR_SETPOS =$02; { set position }
+ FB_CUR_SETHOT =$04; { set hot-spot }
+ FB_CUR_SETCMAP =$08; { set cursor color map }
+ FB_CUR_SETSHAPE =$10; { set size & bits }
+ FB_CUR_SETALL =(FB_CUR_SETCUR OR FB_CUR_SETPOS OR FB_CUR_SETHOT OR
+ FB_CUR_SETCMAP OR FB_CUR_SETSHAPE);
+
+{ controls for cursor attributes & shape (including position) }
+Function FBIOSCURSOR(fd:longint;var param1 : fbcursor):boolean;
+Function FBIOGCURSOR(fd:longint;var param1 : fbcursor):boolean;
+
+{ controls for cursor position only }
+Function FBIOSCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+Function FBIOGCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+
+{ get maximum cursor size }
+Function FBIOGCURMAX(fd:longint;var param1 : fbcurpos):boolean;
+
+{ The new style frame buffer FpIoctls. }
+
+CONST
+ V_INFO_COLOR =(1 SHL 0);
+ V_INFO_GRAPHICS =(1 SHL 1);
+ V_INFO_LINEAR =(1 SHL 2);
+ V_INFO_VESA =(1 SHL 3);
+ V_INFO_MM_OTHER =(-1);
+ V_INFO_MM_TEXT =0;
+ V_INFO_MM_PLANAR =1;
+ V_INFO_MM_PACKED =2;
+ V_INFO_MM_DIRECT =3;
+ V_INFO_MM_CGA =100;
+ V_INFO_MM_HGC =101;
+ V_INFO_MM_VGAX =102;
+
+TYPE
+{ video mode information block }
+ video_info = record
+ vi_mode : longint; { mode number, see below }
+ vi_flags : longint;
+ vi_width : longint;
+ vi_height : longint;
+ vi_cwidth : longint;
+ vi_cheight : longint;
+ vi_depth : longint;
+ vi_planes : longint;
+ vi_window : uint; { physical address }
+ vi_window_size : size_t;
+ vi_window_gran : size_t;
+ vi_buffer : uint; { physical address }
+ vi_buffer_size : size_t;
+ vi_mem_model : longint;
+ { for MM_PACKED and MM_DIRECT only }
+ vi_pixel_size : longint; { in bytes }
+ { for MM_DIRECT only }
+ vi_pixel_fields : array[0..3] of longint; { RGB and reserved fields }
+ vi_pixel_fsizes : array[0..3] of longint;
+ { reserved }
+ vi_reserved : array[0..63] of uchar;
+ end;
+
+ video_info_t = video_info;
+const
+ KD_OTHER =0; { unknown }
+ KD_MONO =1; { monochrome adapter }
+ KD_HERCULES =2; { hercules adapter }
+ KD_CGA =3; { color graphics adapter }
+ KD_EGA =4; { enhanced graphics adapter }
+ KD_VGA =5; { video graphics adapter }
+ KD_PC98 =6; { PC-98 display }
+ KD_TGA =7; { TGA }
+ V_ADP_COLOR =(1 SHL 0);
+ V_ADP_MODECHANGE=(1 SHL 1);
+ V_ADP_STATESAVE =(1 SHL 2);
+ V_ADP_STATELOAD =(1 SHL 3);
+ V_ADP_FONT =(1 SHL 4);
+ V_ADP_PALETTE =(1 SHL 5);
+ V_ADP_BORDER =(1 SHL 6);
+ V_ADP_VESA =(1 SHL 7);
+ V_ADP_PROBED =(1 SHL 16);
+ V_ADP_INITIALIZED=(1 SHL 17);
+ V_ADP_REGISTERED =(1 SHL 18);
+
+{ adapter infromation block }
+type video_adapter = record
+ va_index : longint;
+ va_type : longint;
+ va_name : pchar;
+ va_unit : longint;
+ va_minor : longint;
+ va_flags : longint;
+ va_io_base : longint;
+ va_io_size : longint;
+ va_crtc_addr : longint;
+ va_mem_base : longint;
+ va_mem_size : longint;
+ va_window : vm_offset_t; { virtual address }
+ va_window_size : size_t;
+ va_window_gran : size_t;
+ va_window_orig : uint;
+ va_buffer : vm_offset_t; { virtual address }
+ va_buffer_size : size_t;
+ va_initial_mode : longint;
+ va_initial_bios_mode : longint;
+ va_mode : longint;
+ va_info : video_info;
+ va_line_width : longint;
+ va_disp_start : record
+ x : longint;
+ y : longint;
+ end;
+ va_token : pointer;
+ end;
+
+ video_adapter_t = video_adapter;
+
+ video_adapter_info = record
+ va_index : longint;
+ va_type : longint;
+ va_name : array[0..15] of char;
+ va_unit : longint;
+ va_flags : longint;
+ va_io_base : longint;
+ va_io_size : longint;
+ va_crtc_addr : longint;
+ va_mem_base : longint;
+ va_mem_size : longint;
+ va_window : uint; { virtual address }
+ va_window_size : size_t;
+ va_window_gran : size_t;
+ va_unused0 : uint;
+ va_buffer_size : size_t;
+ va_initial_mode : longint;
+ va_initial_bios_mode : longint;
+ va_mode : longint;
+ va_line_width : longint;
+ va_disp_start : record
+ x : longint;
+ y : longint;
+ end;
+ va_window_orig : uint;
+ { reserved }
+ va_reserved : array[0..63] OF uchar;
+ end;
+ video_adapter_info_t = video_adapter_info;
+
+CONST
+{ some useful video adapter index }
+ V_ADP_PRIMARY =0;
+ V_ADP_SECONDARY =1;
+
+{ video mode numbers }
+
+ M_B40x25 =0; { black & white 40 columns }
+ M_C40x25 =1; { color 40 columns }
+ M_B80x25 =2; { black & white 80 columns }
+ M_C80x25 =3; { color 80 columns }
+ M_BG320 =4; { black & white graphics 320x200 }
+ M_CG320 =5; { color graphics 320x200 }
+ M_BG640 =6; { black & white graphics 640x200 hi-res }
+ M_EGAMONO80x25 =7; { ega-mono 80x25 }
+ M_CG320_D =13; { ega mode D }
+ M_CG640_E =14; { ega mode E }
+ M_EGAMONOAPA =15; { ega mode F }
+ M_CG640x350 =16; { ega mode 10 }
+ M_ENHMONOAPA2 =17; { ega mode F with extended memory }
+ M_ENH_CG640 =18; { ega mode 10* }
+ M_ENH_B40x25 =19; { ega enhanced black & white 40 columns }
+ M_ENH_C40x25 =20; { ega enhanced color 40 columns }
+ M_ENH_B80x25 =21; { ega enhanced black & white 80 columns }
+ M_ENH_C80x25 =22; { ega enhanced color 80 columns }
+ M_VGA_C40x25 =23; { vga 8x16 font on color }
+ M_VGA_C80x25 =24; { vga 8x16 font on color }
+ M_VGA_M80x25 =25; { vga 8x16 font on mono }
+
+ M_VGA11 =26; { vga 640x480 2 colors }
+ M_BG640x480 =26;
+ M_VGA12 =27; { vga 640x480 16 colors }
+ M_CG640x480 =27;
+ M_VGA13 =28; { vga 320x200 256 colors }
+ M_VGA_CG320 =28;
+
+ M_VGA_C80x50 =30; { vga 8x8 font on color }
+ M_VGA_M80x50 =31; { vga 8x8 font on color }
+ M_VGA_C80x30 =32; { vga 8x16 font on color }
+ M_VGA_M80x30 =33; { vga 8x16 font on color }
+ M_VGA_C80x60 =34; { vga 8x8 font on color }
+ M_VGA_M80x60 =35; { vga 8x8 font on color }
+ M_VGA_CG640 =36; { vga 640x400 256 color }
+ M_VGA_MODEX =37; { vga 320x240 256 color }
+
+ M_VGA_C90x25 =40; { vga 8x16 font on color }
+ M_VGA_M90x25 =41; { vga 8x16 font on mono }
+ M_VGA_C90x30 =42; { vga 8x16 font on color }
+ M_VGA_M90x30 =43; { vga 8x16 font on mono }
+ M_VGA_C90x43 =44; { vga 8x8 font on color }
+ M_VGA_M90x43 =45; { vga 8x8 font on mono }
+ M_VGA_C90x50 =46; { vga 8x8 font on color }
+ M_VGA_M90x50 =47; { vga 8x8 font on mono }
+ M_VGA_C90x60 =48; { vga 8x8 font on color }
+ M_VGA_M90x60 =49; { vga 8x8 font on mono }
+
+ M_ENH_B80x43 =$70; { ega black & white 80x43 }
+ M_ENH_C80x43 =$71; { ega color 80x43 }
+
+ M_PC98_80x25 =98; { PC98 text 80x25 }
+ M_PC98_80x30 =99; { PC98 text 80x30 }
+ M_PC98_EGC640x400 =100; { PC98 graphic 640x400 16 colors }
+ M_PC98_PEGC640x400 =101; { PC98 graphic 640x400 256 colors }
+ M_PC98_PEGC640x480 =102; { PC98 graphic 640x480 256 colors }
+
+ M_HGC_P0 =$e0; { hercules graphics - page 0 @ B0000 }
+ M_HGC_P1 =$e1; { hercules graphics - page 1 @ B8000 }
+ M_MCA_MODE =$ff; { monochrome adapter mode }
+
+ M_TEXT_80x25 =200; { generic text modes }
+ M_TEXT_80x30 =201;
+ M_TEXT_80x43 =202;
+ M_TEXT_80x50 =203;
+ M_TEXT_80x60 =204;
+ M_TEXT_132x25 =205;
+ M_TEXT_132x30 =206;
+ M_TEXT_132x43 =207;
+ M_TEXT_132x50 =208;
+ M_TEXT_132x60 =209;
+
+ M_VESA_BASE =$100; { VESA mode number base }
+ M_VESA_CG640x400 =$100; { 640x400, 256 color }
+ M_VESA_CG640x480 =$101; { 640x480, 256 color }
+ M_VESA_800x600 =$102; { 800x600, 16 color }
+ M_VESA_CG800x600 =$103; { 800x600, 256 color }
+ M_VESA_1024x768 =$104; { 1024x768, 16 color }
+ M_VESA_CG1024x768 =$105; { 1024x768, 256 color }
+ M_VESA_1280x1024 =$106; { 1280x1024, 16 color }
+ M_VESA_CG1280x1024 =$107; { 1280x1024, 256 color }
+ M_VESA_C80x60 =$108; { 8x8 font }
+ M_VESA_C132x25 =$109; { 8x16 font }
+ M_VESA_C132x43 =$10a; { 8x14 font }
+ M_VESA_C132x50 =$10b; { 8x8 font }
+ M_VESA_C132x60 =$10c; { 8x8 font }
+ M_VESA_32K_320 =$10d; { 320x200, 5:5:5 }
+ M_VESA_64K_320 =$10e; { 320x200, 5:6:5 }
+ M_VESA_FULL_320 =$10f; { 320x200, 8:8:8 }
+ M_VESA_32K_640 =$110; { 640x480, 5:5:5 }
+ M_VESA_64K_640 =$111; { 640x480, 5:6:5 }
+ M_VESA_FULL_640 =$112; { 640x480, 8:8:8 }
+ M_VESA_32K_800 =$113; { 800x600, 5:5:5 }
+ M_VESA_64K_800 =$114; { 800x600, 5:6:5 }
+ M_VESA_FULL_800 =$115; { 800x600, 8:8:8 }
+ M_VESA_32K_1024 =$116; { 1024x768, 5:5:5 }
+ M_VESA_64K_1024 =$117; { 1024x768, 5:6:5 }
+ M_VESA_FULL_1024 =$118; { 1024x768, 8:8:8 }
+ M_VESA_32K_1280 =$119; { 1280x1024, 5:5:5 }
+ M_VESA_64K_1280 =$11a; { 1280x1024, 5:6:5 }
+ M_VESA_FULL_1280 =$11b; { 1280x1024, 8:8:8 }
+ M_VESA_MODE_MAX =$1ff;
+
+type
+ video_display_start = record
+ x :longint;
+ y : longint;
+ end;
+
+ video_display_start_t= video_display_start;
+
+ video_color_palette = record
+ index : longint; { first element (zero-based) }
+ count : longint; { number of elements }
+ red : ^uchar; { red }
+ green : ^uchar; { green }
+ blue : ^uchar; { blue }
+ transparent : ^uchar; { may be NULL }
+ end;
+
+ video_color_palette_t = video_color_palette;
+
+{ adapter info. }
+Function FBIO_ADAPTER(fd:longint;var param1 : longint):boolean;
+Function FBIO_ADPTYPE(fd:longint;var param1 : longint):boolean;
+Function FBIO_ADPINFO(fd:longint;var param1 : video_adapter_info):boolean;
+
+{ video mode control }
+Function FBIO_MODEINFO(fd:longint;var param1 : video_info):boolean;
+Function FBIO_FINDMODE(fd:longint;var param1 : video_info):boolean;
+Function FBIO_GETMODE(fd:longint;var param1 : longint):boolean;
+Function FBIO_SETMODE(fd:longint;var param1 : longint):boolean;
+
+{ get/set frame buffer window origin }
+Function FBIO_GETWINORG(fd:longint;var param1 : u_int):boolean;
+Function FBIO_SETWINORG(fd:longint;var param1 : u_int):boolean;
+
+{ get/set display start address }
+Function FBIO_GETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+Function FBIO_SETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+
+{ get/set scan line width }
+Function FBIO_GETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+Function FBIO_SETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+
+{ color palette control }
+Function FBIO_GETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+Function FBIO_SETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+
+{----------------------------- sys/consio.h ----------------------------------}
+
+{ version packaged with FreeBSD 4.2-RELEASE
+Translation to FreePascal by Marco van de Voort. (2000-2001), original
+copyright follows:
+
+ * Copyright (c) 1991-1996 Søren Schmidt
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer
+ * in this position and unchanged.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. The name of the author may not be used to endorse or promote products
+ * derived from this software without specific prior written permission
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $FreeBSD: src/sys/sys/consio.h,v 1.5.2.1 2000/05/05 09:16:15 nyan Exp $
+
+}
+
+{$define definconsole}
+
+{
+ * Console FpIoctl commands. Some commands are named as KDXXXX, GIO_XXX, and
+ * PIO_XXX, rather than CONS_XXX, for historical and compatibility reasons.
+ * Some other CONS_XXX commands are works as wrapper around frame buffer
+ * FpIoctl commands FBIO_XXX. Do not try to change all these commands,
+ * otherwise we shall have compatibility problems.
+ }
+
+const
+
+{ get/set video mode }
+ KD_TEXT =0; { set text mode restore fonts }
+ KD_TEXT0 =0; { ditto }
+ KD_GRAPHICS =1; { set graphics mode }
+ KD_TEXT1 =2; { set text mode !restore fonts }
+ KD_PIXEL =3; { set pixel mode }
+
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+
+{ set border color }
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+
+{ set up raster(pixel) text mode }
+type
+ scr_size = record
+ _scrsize : array[0..2] of longint;
+ end;
+ scr_size_t = scr_size;
+
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+
+type
+
+{ get/set screen char map }
+
+ scrmap = record
+ _scrmap : array[0..255] of char;
+ end;
+ scrmap_t = scrmap;
+
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+
+{ get the current text attribute }
+Function GIO_ATTR(fd:longint;var param1 : longint):boolean;
+
+{ get the current text color }
+Function GIO_COLOR(fd:longint;var param1 : longint):boolean;
+
+{ get the adapter type (equivalent to FBIO_ADPTYPE) }
+Function CONS_CURRENT(fd:longint;var param1 : longint):boolean;
+
+{ get the current video mode (equivalent to FBIO_GETMODE) }
+Function CONS_GET(fd:longint;var param1 : longint):boolean;
+
+{ not supported? }
+Function CONS_IO(fd:longint):boolean;
+
+{ set blank time interval }
+Function CONS_BLANKTIME(fd:longint;var param1 : longint):boolean;
+
+{ set/get the screen saver (these FpIoctls are current noop) }
+CONST maxsaver=16;
+
+type ssaver =record
+ name : array[0..maxsaver-1] of char;
+ num : Longint;
+ time : Long;
+ end;
+ ssaver_t = ssaver;
+
+Function CONS_SSAVER(fd:longint;var param1 : ssaver_t):boolean;
+Function CONS_GSAVER(fd:longint;var param1 : ssaver_t):boolean;
+
+{ set the text cursor shape }
+
+CONST
+ CONS_BLINK_CURSOR = (1 shl 0);
+ CONS_CHAR_CURSOR = (1 shl 1);
+
+Function CONS_CURSORTYPE(fd:longint;var param1 : longint):boolean;
+
+{ set the bell type to audible or visual }
+CONST
+ CONS_VISUAL_BELL =(1 shl 0);
+ CONS_QUIET_BELL =(1 shl 1);
+
+Function CONS_BELLTYPE(fd:longint;var param1 : longint):boolean;
+
+{ set the history (scroll back) buffer size (in lines) }
+Function CONS_HISTORY(fd:longint;var param1 : longint):boolean;
+
+{ mouse cursor FpIoctl }
+type
+ mouse_data = record
+ x : longint;
+ y : Longint;
+ z : longint;
+ buttons : longint;
+ end;
+
+ mouse_data_t = mouse_data;
+
+ mouse_mode = record
+ mode : longint;
+ signal : longint;
+ end;
+
+ mouse_mode_t = mouse_mode;
+
+ mouse_event = record
+ id : Longint; { one based }
+ value : longint;
+ end;
+
+ mouse_event_t = mouse_event;
+
+CONST
+ MOUSE_SHOW =$01;
+ MOUSE_HIDE =$02;
+ MOUSE_MOVEABS =$03;
+ MOUSE_MOVEREL =$04;
+ MOUSE_GETINFO =$05;
+ _MOUSE_MODE =$06;
+ MOUSE_ACTION =$07;
+ MOUSE_MOTION_EVENT =$08;
+ MOUSE_BUTTON_EVENT =$09;
+ MOUSE_MOUSECHAR =$0a;
+
+TYPE
+ mouse_info = record
+ operation : longint;
+ u : record
+ case integer of
+ 0: (data : mouse_data_t);
+ 1: (mode : mouse_mode_t);
+ 2: (event: mouse_event_t);
+ 3: (mouse_char : longint);
+ end;
+ end;
+ mouse_info_t = mouse_info;
+
+Function CONS_MOUSECTL(fd:longint;var param1 : mouse_info_t):boolean;
+
+{ see if the vty has been idle }
+Function CONS_IDLE(fd:longint;var param1 : longint):boolean;
+
+{ set the screen saver mode }
+CONST
+ CONS_LKM_SAVER = 0;
+ CONS_USR_SAVER = 1;
+
+Function CONS_SAVERMODE(fd:longint;var param1 : longint):boolean;
+
+{ start the screen saver }
+Function CONS_SAVERSTART(fd:longint;var param1 : longint):boolean;
+
+TYPE
+{ set/get font data }
+ fnt8 = record
+ fnt8x8 : array[0..8*256-1] of char;
+ end;
+
+ fnt8_t = fnt8;
+
+ fnt14 = record
+ fnt8x14: array[0..14*256-1] of char;
+ end;
+
+ fnt14_t = fnt14;
+
+ fnt16 = record
+ fnt8x16: array[0..16*256-1] of char;
+ end;
+ fnt16_t = fnt16;
+
+Function PIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+Function GIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+Function PIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+Function GIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+Function PIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+Function GIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+
+
+{ get video mode information }
+type colors = record
+ fore : char;
+ back : char;
+ end;
+
+ vid_info = record
+ _size : short;
+ m_num : short;
+ mv_row,
+ mv_col : ushort;
+ mv_rsz,
+ mv_csz : ushort;
+ mv_norm,
+ mv_rev,
+ mv_grfc : colors;
+ mv_ovscan : uchar;
+ mk_keylock : uchar;
+ end;
+ vid_info_t = vid_info;
+
+Function CONS_GETINFO(fd:longint;var param1 : vid_info_t):boolean;
+
+{ get version }
+
+Function CONS_GETVERS(fd:longint;var param1 : longint):boolean;
+
+{ get the video adapter index (equivalent to FBIO_ADAPTER) }
+Function CONS_CURRENTADP(fd:longint;var param1 : longint):boolean;
+
+{ get the video adapter information (equivalent to FBIO_ADPINFO) }
+Function CONS_ADPINFO(fd:longint;var param1 : video_adapter_info_t):boolean;
+
+{ get the video mode information (equivalent to FBIO_MODEINFO) }
+Function CONS_MODEINFO(fd:longint;var param1 : video_info_t):boolean;
+
+{ find a video mode (equivalent to FBIO_FINDMODE) }
+Function CONS_FINDMODE(fd:longint;var param1 : video_info_t):boolean;
+
+{ set the frame buffer window origin (equivalent to FBIO_SETWINORG) }
+Function CONS_SETWINORG(fd:longint;param1 : longint):boolean;
+
+{ use the specified keyboard }
+Function CONS_SETKBD(fd:longint;param1 : longint):boolean;
+
+{ release the current keyboard }
+Function CONS_RELKBD(fd:longint):boolean;
+
+{ get/set the current terminal emulator info. }
+CONST
+ TI_NAME_LEN = 32;
+ TI_DESC_LEN = 64;
+
+TYPE
+ term_info = record
+ ti_index : Longint;
+ ti_flags : longint;
+ ti_name : array[0..TI_NAME_LEN-1] of uchar;
+ ti_desc : array[0..TI_DESC_LEN-1] of uchar;
+ end;
+ term_info_t = term_info;
+
+Function CONS_GETTERM(fd:longint;var param1 : term_info_t):boolean;
+Function CONS_SETTERM(fd:longint;var param1 : term_info_t):boolean;
+
+{$ifdef PC98}
+Function ADJUST_CLOCK(fd:longint):boolean;
+{$endif}
+
+{
+* Vty switching FpIoctl commands.
+}
+
+{ get the next available vty }
+Function VT_OPENQRY(fd:longint;var param1 : longint):boolean;
+
+{ set/get vty switching mode }
+const
+ VT_AUTO =0; { switching is automatic }
+ VT_PROCESS =1; { switching controlled by prog }
+ VT_KERNEL =255; { switching controlled in kernel }
+
+TYPE
+ vt_mode = record
+ mode : Char;
+ waitv : char; { not implemented yet SOS }
+ relsig : short;
+ acqsig : short;
+ frsig : short; { not implemented yet SOS }
+ end;
+
+ vtmode_t = vt_mode;
+
+
+Function VT_SETMODE(fd:longint;var param1 : vtmode_t):boolean;
+Function VT_GETMODE(fd:longint;var param1 : vtmode_t):boolean;
+
+
+{ acknowledge release or acquisition of a vty }
+const
+ VT_FALSE = 0;
+ VT_TRUE = 1;
+ VT_ACKACQ = 2;
+
+Function VT_RELDISP(fd:longint;param1 : longint):boolean;
+
+{ activate the specified vty }
+Function VT_ACTIVATE(fd:longint;param1 : longint):boolean;
+
+{ wait until the specified vty is activate }
+Function VT_WAITACTIVE(fd:longint;param1 : longint):boolean;
+
+{ get the currently active vty }
+Function VT_GETACTIVE(fd:longint;var param1 : longint):boolean;
+
+{ get the index of the vty }
+Function VT_GETINDEX(fd:longint;var param1 : longint):boolean;
+
+{
+* Video mode switching FpIoctl. See sys/fbio.h for mode numbers.
+}
+
+Function SW_B40x25(fd:longint):boolean;
+Function SW_C40x25(fd:longint):boolean;
+Function SW_B80x25(fd:longint):boolean;
+Function SW_C80x25(fd:longint):boolean;
+Function SW_BG320(fd:longint):boolean;
+Function SW_CG320(fd:longint):boolean;
+Function SW_BG640(fd:longint):boolean;
+Function SW_EGAMONO80x25(fd:longint):boolean;
+Function SW_CG320_D(fd:longint):boolean;
+Function SW_CG640_E(fd:longint):boolean;
+Function SW_EGAMONOAPA(fd:longint):boolean;
+Function SW_CG640x350(fd:longint):boolean;
+Function SW_ENH_MONOAPA2(fd:longint):boolean;
+Function SW_ENH_CG640(fd:longint):boolean;
+Function SW_ENH_B40x25(fd:longint):boolean;
+Function SW_ENH_C40x25(fd:longint):boolean;
+Function SW_ENH_B80x25(fd:longint):boolean;
+Function SW_ENH_C80x25(fd:longint):boolean;
+Function SW_ENH_B80x43(fd:longint):boolean;
+Function SW_ENH_C80x43(fd:longint):boolean;
+Function SW_MCAMODE(fd:longint):boolean;
+Function SW_VGA_C40x25(fd:longint):boolean;
+Function SW_VGA_C80x25(fd:longint):boolean;
+Function SW_VGA_C80x30(fd:longint):boolean;
+Function SW_VGA_C80x50(fd:longint):boolean;
+Function SW_VGA_C80x60(fd:longint):boolean;
+Function SW_VGA_M80x25(fd:longint):boolean;
+Function SW_VGA_M80x30(fd:longint):boolean;
+Function SW_VGA_M80x50(fd:longint):boolean;
+Function SW_VGA_M80x60(fd:longint):boolean;
+Function SW_VGA11(fd:longint):boolean;
+Function SW_BG640x480(fd:longint):boolean;
+Function SW_VGA12(fd:longint):boolean;
+Function SW_CG640x480(fd:longint):boolean;
+Function SW_VGA13(fd:longint):boolean;
+Function SW_VGA_CG320(fd:longint):boolean;
+Function SW_VGA_CG640(fd:longint):boolean;
+Function SW_VGA_MODEX(fd:longint):boolean;
+Function SW_PC98_80x25(fd:longint):boolean;
+Function SW_PC98_80x30(fd:longint):boolean;
+Function SW_PC98_EGC640x400(fd:longint):boolean;
+Function SW_PC98_PEGC640x400(fd:longint):boolean;
+Function SW_PC98_PEGC640x480(fd:longint):boolean;
+Function SW_VGA_C90x25(fd:longint):boolean;
+Function SW_VGA_M90x25(fd:longint):boolean;
+Function SW_VGA_C90x30(fd:longint):boolean;
+Function SW_VGA_M90x30(fd:longint):boolean;
+Function SW_VGA_C90x43(fd:longint):boolean;
+Function SW_VGA_M90x43(fd:longint):boolean;
+Function SW_VGA_C90x50(fd:longint):boolean;
+Function SW_VGA_M90x50(fd:longint):boolean;
+Function SW_VGA_C90x60(fd:longint):boolean;
+Function SW_VGA_M90x60(fd:longint):boolean;
+Function SW_TEXT_80x25(fd:longint):boolean;
+Function SW_TEXT_80x30(fd:longint):boolean;
+Function SW_TEXT_80x43(fd:longint):boolean;
+Function SW_TEXT_80x50(fd:longint):boolean;
+Function SW_TEXT_80x60(fd:longint):boolean;
+Function SW_TEXT_132x25(fd:longint):boolean;
+Function SW_TEXT_132x30(fd:longint):boolean;
+Function SW_TEXT_132x43(fd:longint):boolean;
+Function SW_TEXT_132x50(fd:longint):boolean;
+Function SW_TEXT_132x60(fd:longint):boolean;
+Function SW_VESA_CG640x400(fd:longint):boolean;
+Function SW_VESA_CG640x480(fd:longint):boolean;
+Function SW_VESA_800x600(fd:longint):boolean;
+Function SW_VESA_CG800x600(fd:longint):boolean;
+Function SW_VESA_1024x768(fd:longint):boolean;
+Function SW_VESA_CG1024x768(fd:longint):boolean;
+Function SW_VESA_1280x1024(fd:longint):boolean;
+Function SW_VESA_CG1280x1024(fd:longint):boolean;
+Function SW_VESA_C80x60(fd:longint):boolean;
+Function SW_VESA_C132x25(fd:longint):boolean;
+Function SW_VESA_C132x43(fd:longint):boolean;
+Function SW_VESA_C132x50(fd:longint):boolean;
+Function SW_VESA_C132x60(fd:longint):boolean;
+Function SW_VESA_32K_320(fd:longint):boolean;
+Function SW_VESA_64K_320(fd:longint):boolean;
+Function SW_VESA_FULL_320(fd:longint):boolean;
+Function SW_VESA_32K_640(fd:longint):boolean;
+Function SW_VESA_64K_640(fd:longint):boolean;
+Function SW_VESA_FULL_640(fd:longint):boolean;
+Function SW_VESA_32K_800(fd:longint):boolean;
+Function SW_VESA_64K_800(fd:longint):boolean;
+Function SW_VESA_FULL_800(fd:longint):boolean;
+Function SW_VESA_32K_1024(fd:longint):boolean;
+Function SW_VESA_64K_1024(fd:longint):boolean;
+Function SW_VESA_FULL_1024(fd:longint):boolean;
+Function SW_VESA_32K_1280(fd:longint):boolean;
+Function SW_VESA_64K_1280(fd:longint):boolean;
+Function SW_VESA_FULL_1280(fd:longint):boolean;
+
+{----------------------------- sys/kbio.h ----------------------------------}
+
+{ version packaged with FreeBSD 4.2-RELEASE
+Translation to FreePascal by Marco van de Voort. (2000-2001), original
+copyright follows: ( I assume BSD licensed)
+
+Based on
+ * $FreeBSD: src/sys/sys/kbio.h,v 1.5.2.1 2000/10/29 16:59:32 dwmalone Exp $
+}
+
+{ get/set keyboard I/O mode}
+const K_RAW =0; { keyboard returns scancodes}
+ K_XLATE =1; { keyboard returns ascii}
+ K_CODE =2; { keyboard returns keycodes}
+
+{After each FpIoctl value, I've put the type of the parameters to be passed:
+ @int -> pass a pointer to an int.
+ int -> pass pointer(int)
+ - -> nothing
+@keymap_t -> pass a pointer to a keymap_t
+ etc.
+}
+
+Function KDGKBMODE(fd:longint;var param1 : longint):boolean;
+Function KDSKBMODE(fd:longint;param1 : longint):boolean;
+
+
+{ make tone}
+Function KDMKTONE(fd:longint;param1 : longint):boolean;
+
+{ see console.h for the definitions of the following FpIoctls}
+{$ifndef definconsole}
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+
+{$endif}
+const
+{ get/set keyboard lock state}
+ CLKED =1; { Caps locked}
+ NLKED =2; { Num locked}
+ SLKED =4; { Scroll locked}
+ ALKED =8; { AltGr locked}
+ LOCK_MASK =CLKED or NLKED or SLKED or ALKED;
+
+Function KDGKBSTATE(fd:longint;var param1 : longint):boolean;
+Function KDSKBSTATE(fd:longint;param1 : longint):boolean;
+
+{ enable/disable I/O access}
+Function KDENABIO(fd:longint):boolean;
+Function KDDISABIO(fd:longint):boolean;
+
+{ make sound}
+Function KIOCSOUND(fd:longint;param1 : longint):boolean;
+
+Const
+{ get keyboard model}
+ KB_OTHER =0; { keyboard not known}
+ KB_84 =1; { 'old' 84 key AT-keyboard}
+ KB_101 =2; { MF-101 or MF-102 keyboard}
+Function KDGKBTYPE(fd:longint;var param1 : longint):boolean;
+
+const
+{ get/set keyboard LED state}
+ LED_CAP =1; { Caps lock LED}
+ LED_NUM =2; { Num lock LED}
+ LED_SCR =4; { Scroll lock LED}
+ LED_MASK =LED_CAP or LED_NUM or LED_SCR;
+Function KDGETLED(fd:longint;var param1 : longint):boolean;
+Function KDSETLED(fd:longint;param1 : longint):boolean;
+
+{ set keyboard repeat rate (obsolete, use KDSETREPEAT below)}
+Function KDSETRAD(fd:longint;param1 : longint):boolean;
+
+{ see console.h for the definition of the following FpIoctl}
+{$ifndef definconsole}
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+
+{$endif}
+
+TYPE
+{ get keyboard information}
+ keyboard_info = Record
+ kb_index : longint; { kbdio index#}
+ kb_name : array[0..15] of char; { driver name}
+ kb_unit : longint; { unit#}
+ kb_type : longint; { KB_84, KB_101, KB_OTHER,...}
+ kb_config: longint; { device configuration flags}
+ kb_flags : longint; { internal flags}
+ end;
+ keyboard_info_t=keyboard_info;
+
+Function KDGKBINFO(fd:longint;var param1 : keyboard_info_t):boolean;
+
+Type
+{ set/get keyboard repeat rate (new interface)}
+ keyboard_repeat = record
+ kb_repeat: array[0..1] of longint;
+ end;
+
+keyboard_repeat_t = keyboard_repeat;
+
+Function KDSETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+Function KDGETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+
+{ get/set key map/accent map/function key strings}
+
+const
+ NUM_KEYS =256; { number of keys in table}
+ NUM_STATES =8; { states per key}
+ ALTGR_OFFSET =128; { offset for altlock keys}
+
+ NUM_DEADKEYS =15; { number of accent keys}
+ NUM_ACCENTCHARS =52; { max number of accent chars}
+
+ NUM_FKEYS =96; { max number of function keys}
+ MAXFK =16; { max length of a function key str}
+
+type
+ keyent_t = record
+ map : array[0..NUM_STATES-1] of uchar;
+ spcl : uchar;
+ flgs : uchar;
+ end;
+
+const
+ FLAG_LOCK_O =0;
+ FLAG_LOCK_C =1;
+ FLAG_LOCK_N =2;
+
+type keymap = record
+ n_keys : ushort;
+ key : array[0..NUM_KEYS-1] OF keyent_t;
+ end;
+
+ keymap_t= keymap;
+
+CONST
+{ defines for "special" keys (spcl bit set in keymap)}
+ NOP =$00; { nothing (dead key)}
+ LSH =$02; { left shift key}
+ RSH =$03; { right shift key}
+ CLK =$04; { caps lock key}
+ NLK =$05; { num lock key}
+ SLK =$06; { scroll lock key}
+ LALT =$07; { left alt key}
+ BTAB =$08; { backwards tab}
+ LCTR =$09; { left control key}
+ NEXT =$0a; { switch to next screen}
+ F_SCR =$0b; { switch to first screen}
+ L_SCR =$1a; { switch to last screen}
+ F_FN =$1b; { first function key}
+ L_FN =$7a; { last function key}
+{ $7b-$7f reserved do not use !}
+ RCTR =$80; { right control key}
+ RALT =$81; { right alt (altgr) key}
+ ALK =$82; { alt lock key}
+ ASH =$83; { alt shift key}
+ META =$84; { meta key}
+ RBT =$85; { boot machine}
+ DBG =$86; { call debugger}
+ SUSP =$87; { suspend power (APM)}
+ SPSC =$88; { toggle splash/text screen}
+
+ DGRA =$89; { grave}
+ F_ACC =DGRA; { first accent key}
+
+ DACU =$8a; { acute}
+ DCIR =$8b; { circumflex}
+ DTIL =$8c; { tilde}
+ DMAC =$8d; { macron}
+ DBRE =$8e; { breve}
+ DDOT =$8f; { dot}
+ DUML =$90; { umlaut/diaresis}
+ DDIA =$90; { diaresis}
+ DSLA =$91; { slash}
+ DRIN =$92; { ring}
+ DCED =$93; { cedilla}
+ DAPO =$94; { apostrophe}
+ DDAC =$95; { double acute}
+ DOGO =$96; { ogonek}
+ DCAR =$97; { caron}
+ L_ACC =DCAR; { last accent key}
+
+ STBY =$98; { Go into standby mode (apm)}
+ PREV =$99; { switch to previous screen}
+ PNC =$9a; { force system panic}
+ LSHA =$9b; { left shift key / alt lock}
+ RSHA =$9c; { right shift key / alt lock}
+ LCTRA =$9d; { left ctrl key / alt lock}
+ RCTRA =$9e; { right ctrl key / alt lock}
+ LALTA =$9f; { left alt key / alt lock}
+ RALTA =$a0; { right alt key / alt lock}
+ HALT =$a1; { halt machine}
+ PDWN =$a2; { halt machine and power down}
+
+function kbio_F(x:longint):longint;
+function kbio_S(x:longint):longint;
+function kbio_ACC(x:longint):longint;
+
+type acc_t = record
+ accchar : uchar;
+ map : array[0..NUM_ACCENTCHARS-1,0..1] of uchar;
+ end;
+
+ accentmap = record
+ n_accs : ushort;
+ acc : array[0..NUM_DEADKEYS-1] of acc_t
+ end;
+
+ accentmap_t = accentmap ;
+
+ keyarg = record
+ keynum : ushort;
+ key : keyent_t;
+ end;
+
+ keyarg_t = keyarg;
+
+ fkeytab = record
+ str : array [0..MAXFK-1] of uchar;
+ len : uchar;
+ end;
+ fkeytab_t = fkeytab;
+
+ fkeyarg =record
+ keynum : ushort;
+ keydef : array[0..MAXFK-1] of char;
+ flen :char;
+ end;
+
+ fkeyarg_t = fkeyarg;
+
+Function GETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+Function SETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+
+{$ifndef definconsole}
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{$endif}
+Function GIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+Function PIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+Function GIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+Function PIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+Function GIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+Function PIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+
+{ flags set to the return value in the KD_XLATE mode}
+Const
+ NOKEY =$100; { no key pressed marker}
+ FKEY =$200; { function key marker}
+ MKEY =$400; { meta key marker (prepend ESC)}
+ BKEY =$800; { backtab (ESC [ Z)}
+
+ SPCLKEY =$8000; { special key}
+ RELKEY =$4000; { key released}
+ ERRKEY =$2000; { error}
+
+
+function KEYCHAR(c:longint):longint;
+
+function KEYFLAGS(c:longint):longint;
+
+{----------------------------- machine/mouse.h -------------------------------}
+
+{ Based on machine/mouse.h from FreeBSD release 4.2
+
+ * Copyright (c) 1992, 1993 Erik Forsberg.
+ * Copyright (c) 1996, 1997 Kazutaka YOKOTA
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * THIS SOFTWARE IS PROVIDED BY ``AS IS'' AND ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+ * NO EVENT SHALL I BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $FreeBSD: src/sys/i386/include/mouse.h,v 1.15.2.1 2000/03/21 14:44:10 yokota Exp $
+ }
+
+
+{ FpIoctls }
+
+
+{ mouse status block }
+
+type
+ mousestatus = record
+ flags : longint; { state change flags }
+ button : longint; { button status }
+ obutton : longint; { previous button status }
+ dx : longint; { x movement }
+ dy : longint; { y movement }
+ dz : longint; { z movement }
+ end;
+
+ mousestatus_t = mousestatus;
+
+CONST
+
+{ button }
+ MOUSE_BUTTON1DOWN =$0001; { left }
+ MOUSE_BUTTON2DOWN =$0002; { middle }
+ MOUSE_BUTTON3DOWN =$0004; { right }
+ MOUSE_BUTTON4DOWN =$0008;
+ MOUSE_BUTTON5DOWN =$0010;
+ MOUSE_BUTTON6DOWN =$0020;
+ MOUSE_BUTTON7DOWN =$0040;
+ MOUSE_BUTTON8DOWN =$0080;
+ MOUSE_MAXBUTTON =31;
+ MOUSE_STDBUTTONS =$0007; { buttons 1-3 }
+ MOUSE_EXTBUTTONS =$7ffffff8; { the others (28 of them!) }
+ MOUSE_BUTTONS =(MOUSE_STDBUTTONS or MOUSE_EXTBUTTONS);
+
+{ flags }
+ MOUSE_STDBUTTONSCHANGED =MOUSE_STDBUTTONS;
+ MOUSE_EXTBUTTONSCHANGED =MOUSE_EXTBUTTONS;
+ MOUSE_BUTTONSCHANGED =MOUSE_BUTTONS;
+ MOUSE_POSCHANGED =$80000000;
+
+type
+ mousehw =record
+ buttons : longint; { -1 if unknown }
+ iftype : longint; { MOUSE_IF_XXX }
+ _type : longint; { mouse/track ball/pad... }
+ model : longint; { I/F dependent model ID: MOUSE_MODEL_XXX }
+ hwid : longint; { I/F dependent hardware ID}
+ { for the PS/2 mouse, it will be PSM_XXX_ID }
+ end;
+
+ mousehw_t = mousehw;
+
+const
+
+{ iftype }
+ MOUSE_IF_UNKNOWN =(-1);
+ MOUSE_IF_SERIAL =0;
+ MOUSE_IF_BUS =1;
+ MOUSE_IF_INPORT =2;
+ MOUSE_IF_PS2 =3;
+ MOUSE_IF_SYSMOUSE =4;
+ MOUSE_IF_USB =5;
+
+{ type }
+ MOUSE_UNKNOWN =(-1); { should be treated as a mouse }
+ MOUSE_MOUSE =0;
+ MOUSE_TRACKBALL =1;
+ MOUSE_STICK =2;
+ MOUSE_PAD =3;
+
+{ model }
+ MOUSE_MODEL_UNKNOWN =(-1);
+ MOUSE_MODEL_GENERIC =0;
+ MOUSE_MODEL_GLIDEPOINT =1;
+ MOUSE_MODEL_NETSCROLL =2;
+ MOUSE_MODEL_NET =3;
+ MOUSE_MODEL_INTELLI =4;
+ MOUSE_MODEL_THINK =5;
+ MOUSE_MODEL_EASYSCROLL =6;
+ MOUSE_MODEL_MOUSEMANPLUS =7;
+ MOUSE_MODEL_KIDSPAD =8;
+ MOUSE_MODEL_VERSAPAD =9;
+ MOUSE_MODEL_EXPLORER =10;
+ MOUSE_MODEL_4D =11;
+ MOUSE_MODEL_4DPLUS =12;
+
+type mousemode = record
+ protocol : longint; { MOUSE_PROTO_XXX }
+ rate : longint; { report rate (per sec), -1 if unknown }
+ resolution : longint; { MOUSE_RES_XXX, -1 if unknown }
+ accelfactor : longint; { accelation factor (must be 1 or greater) }
+ level : longint; { driver operation level }
+ packetsize : longint; { the length of the data packet }
+ syncmask : array[0..1] of uchar; { sync. data bits in the header byte }
+ end;
+
+type mousemode_t = mousemode;
+
+{ protocol }
+{
+ * Serial protocols:
+ * Microsoft, MouseSystems, Logitech, MM series, MouseMan, Hitachi Tablet,
+ * GlidePoint, IntelliMouse, Thinking Mouse, MouseRemote, Kidspad,
+ * VersaPad
+ * Bus mouse protocols:
+ * bus, InPort
+ * PS/2 mouse protocol:
+ * PS/2
+ }
+ const
+
+ MOUSE_PROTO_UNKNOWN =(-1);
+ MOUSE_PROTO_MS =0; { Microsoft Serial, 3 bytes }
+ MOUSE_PROTO_MSC =1; { Mouse Systems, 5 bytes }
+ MOUSE_PROTO_LOGI =2; { Logitech, 3 bytes }
+ MOUSE_PROTO_MM =3; { MM series, 3 bytes }
+ MOUSE_PROTO_LOGIMOUSEMAN =4; { Logitech MouseMan 3/4 bytes }
+ MOUSE_PROTO_BUS =5; { MS/Logitech bus mouse }
+ MOUSE_PROTO_INPORT =6; { MS/ATI InPort mouse }
+ MOUSE_PROTO_PS2 =7; { PS/2 mouse, 3 bytes }
+ MOUSE_PROTO_HITTAB =8; { Hitachi Tablet 3 bytes }
+ MOUSE_PROTO_GLIDEPOINT =9; { ALPS GlidePoint, 3/4 bytes }
+ MOUSE_PROTO_INTELLI =10; { MS IntelliMouse, 4 bytes }
+ MOUSE_PROTO_THINK =11; { Kensignton Thinking Mouse, 3/4 bytes }
+ MOUSE_PROTO_SYSMOUSE =12; { /dev/sysmouse }
+ MOUSE_PROTO_X10MOUSEREM =13; { X10 MouseRemote, 3 bytes }
+ MOUSE_PROTO_KIDSPAD =14; { Genius Kidspad }
+ MOUSE_PROTO_VERSAPAD =15; { Interlink VersaPad, 6 bytes }
+
+ MOUSE_RES_UNKNOWN =(-1);
+ MOUSE_RES_DEFAULT =0;
+ MOUSE_RES_LOW =(-2);
+ MOUSE_RES_MEDIUMLOW =(-3);
+ MOUSE_RES_MEDIUMHIGH =(-4);
+ MOUSE_RES_HIGH =(-5);
+
+type mousedata = record
+ len : longint; { # of data in the buffer }
+ buf : array [0..15] of longint; { data buffer }
+ end;
+
+ mousedata_t=mousedata;
+
+ mousevar = record
+ _var : array[0..15] of longint;
+ end;
+
+type mousevar_t = mousevar;
+
+Function MOUSE_GETSTATUS(fd:longint;var param1 : mousestatus_t):boolean;
+Function MOUSE_GETHWINFO(fd:longint;var param1 : mousehw_t):boolean;
+Function MOUSE_GETMODE(fd:longint;var param1 : mousemode_t):boolean;
+Function MOUSE_SETMODE(fd:longint;var param1 : mousemode_t):boolean;
+Function MOUSE_GETLEVEL(fd:longint;var param1 : longint):boolean;
+Function MOUSE_SETLEVEL(fd:longint;var param1 : longint):boolean;
+Function MOUSE_GETVARS(fd:longint;var param1 : mousevar_t):boolean;
+Function MOUSE_SETVARS(fd:longint;var param1 : mousevar_t):boolean;
+Function MOUSE_READSTATE(fd:longint;var param1 : mousedata_t):boolean;
+Function MOUSE_READDATA(fd:longint;var param1 : mousedata_t):boolean;
+
+Function MOUSE_SETRESOLUTION(fd:longint;var param1 : longint):boolean;
+Function MOUSE_SETSCALING(fd:longint;var param1 : longint):boolean;
+Function MOUSE_SETRATE(fd:longint;var param1 : longint):boolean;
+Function MOUSE_GETHWID(fd:longint;var param1 : longint):boolean;
+
+
+
+const
+
+{ magic numbers in var[0] }
+ MOUSE_VARS_PS2_SIG = $00325350; { 'PS2' }
+ MOUSE_VARS_BUS_SIG = $00535542; { 'BUS' }
+ MOUSE_VARS_INPORT_SIG = $00504e49; { 'INP' }
+
+{ Microsoft Serial mouse data packet }
+ MOUSE_MSS_PACKETSIZE = 3;
+ MOUSE_MSS_SYNCMASK = $40;
+ MOUSE_MSS_SYNC = $40;
+ MOUSE_MSS_BUTTONS = $30;
+ MOUSE_MSS_BUTTON1DOWN = $20; { left }
+ MOUSE_MSS_BUTTON2DOWN = $00; { no middle button }
+ MOUSE_MSS_BUTTON3DOWN = $10; { right }
+
+{ Logitech MouseMan data packet (M+ protocol) }
+ MOUSE_LMAN_BUTTON2DOWN = $20; { middle button, the 4th byte }
+
+{ ALPS GlidePoint extention (variant of M+ protocol) }
+ MOUSE_ALPS_BUTTON2DOWN = $20; { middle button, the 4th byte }
+ MOUSE_ALPS_TAP = $10; { `tapping' action, the 4th byte }
+
+{ Kinsington Thinking Mouse extention (variant of M+ protocol) }
+ MOUSE_THINK_BUTTON2DOWN = $20; { lower-left button, the 4th byte }
+ MOUSE_THINK_BUTTON4DOWN = $10; { lower-right button, the 4th byte }
+
+{ MS IntelliMouse (variant of MS Serial) }
+ MOUSE_INTELLI_PACKETSIZE = 4;
+ MOUSE_INTELLI_BUTTON2DOWN = $10; { middle button in the 4th byte }
+
+{ Mouse Systems Corp. mouse data packet }
+ MOUSE_MSC_PACKETSIZE = 5;
+ MOUSE_MSC_SYNCMASK = $f8;
+ MOUSE_MSC_SYNC = $80;
+ MOUSE_MSC_BUTTONS = $07;
+ MOUSE_MSC_BUTTON1UP = $04; { left }
+ MOUSE_MSC_BUTTON2UP = $02; { middle }
+ MOUSE_MSC_BUTTON3UP = $01; { right }
+ MOUSE_MSC_MAXBUTTON = 3;
+
+{ MM series mouse data packet }
+ MOUSE_MM_PACKETSIZE = 3;
+ MOUSE_MM_SYNCMASK = $e0;
+ MOUSE_MM_SYNC = $80;
+ MOUSE_MM_BUTTONS = $07;
+ MOUSE_MM_BUTTON1DOWN = $04; { left }
+ MOUSE_MM_BUTTON2DOWN = $02; { middle }
+ MOUSE_MM_BUTTON3DOWN = $01; { right }
+ MOUSE_MM_XPOSITIVE = $10;
+ MOUSE_MM_YPOSITIVE = $08;
+
+{ PS/2 mouse data packet }
+ MOUSE_PS2_PACKETSIZE = 3;
+ MOUSE_PS2_SYNCMASK = $c8;
+ MOUSE_PS2_SYNC = $08;
+ MOUSE_PS2_BUTTONS = $07; { = $03 for 2 button mouse }
+ MOUSE_PS2_BUTTON1DOWN = $01; { left }
+ MOUSE_PS2_BUTTON2DOWN = $04; { middle }
+ MOUSE_PS2_BUTTON3DOWN = $02; { right }
+ MOUSE_PS2_TAP = MOUSE_PS2_SYNC; { GlidePoint (PS/2) `tapping'
+ * Yes! this is the same bit
+ * as SYNC!
+ }
+
+ MOUSE_PS2_XNEG = $10;
+ MOUSE_PS2_YNEG = $20;
+ MOUSE_PS2_XOVERFLOW = $40;
+ MOUSE_PS2_YOVERFLOW = $80;
+
+{ Logitech MouseMan+ (PS/2) data packet (PS/2++ protocol) }
+ MOUSE_PS2PLUS_SYNCMASK = $48;
+ MOUSE_PS2PLUS_SYNC = $48;
+ MOUSE_PS2PLUS_ZNEG = $08; { sign bit }
+ MOUSE_PS2PLUS_BUTTON4DOWN = $10; { 4th button on MouseMan+ }
+ MOUSE_PS2PLUS_BUTTON5DOWN = $20;
+
+{ IBM ScrollPoint (PS/2) also uses PS/2++ protocol }
+ MOUSE_SPOINT_ZNEG = $80; { sign bits }
+ MOUSE_SPOINT_WNEG = $08;
+
+{ MS IntelliMouse (PS/2) data packet }
+ MOUSE_PS2INTELLI_PACKETSIZE = 4;
+{ some compatible mice have additional buttons }
+ MOUSE_PS2INTELLI_BUTTON4DOWN = $40;
+ MOUSE_PS2INTELLI_BUTTON5DOWN = $80;
+
+{ MS IntelliMouse Explorer (PS/2) data packet (variation of IntelliMouse) }
+ MOUSE_EXPLORER_ZNEG = $08; { sign bit }
+{ IntelliMouse Explorer has additional button data in the fourth byte }
+ MOUSE_EXPLORER_BUTTON4DOWN = $10;
+ MOUSE_EXPLORER_BUTTON5DOWN = $20;
+
+{ Interlink VersaPad (serial I/F) data packet }
+ MOUSE_VERSA_PACKETSIZE = 6;
+ MOUSE_VERSA_IN_USE = $04;
+ MOUSE_VERSA_SYNCMASK = $c3;
+ MOUSE_VERSA_SYNC = $c0;
+ MOUSE_VERSA_BUTTONS = $30;
+ MOUSE_VERSA_BUTTON1DOWN = $20; { left }
+ MOUSE_VERSA_BUTTON2DOWN = $00; { middle }
+ MOUSE_VERSA_BUTTON3DOWN = $10; { right }
+ MOUSE_VERSA_TAP = $08;
+
+{ Interlink VersaPad (PS/2 I/F) data packet }
+ MOUSE_PS2VERSA_PACKETSIZE = 6;
+ MOUSE_PS2VERSA_IN_USE = $10;
+ MOUSE_PS2VERSA_SYNCMASK = $e8;
+ MOUSE_PS2VERSA_SYNC = $c8;
+ MOUSE_PS2VERSA_BUTTONS = $05;
+ MOUSE_PS2VERSA_BUTTON1DOWN = $04; { left }
+ MOUSE_PS2VERSA_BUTTON2DOWN = $00; { middle }
+ MOUSE_PS2VERSA_BUTTON3DOWN = $01; { right }
+ MOUSE_PS2VERSA_TAP = $02;
+
+{ A4 Tech 4D Mouse (PS/2) data packet }
+ MOUSE_4D_PACKETSIZE = 3;
+ MOUSE_4D_WHEELBITS = $f0;
+
+{ A4 Tech 4D+ Mouse (PS/2) data packet }
+ MOUSE_4DPLUS_PACKETSIZE = 3;
+ MOUSE_4DPLUS_ZNEG = $04; { sign bit }
+ MOUSE_4DPLUS_BUTTON4DOWN = $08;
+
+{ sysmouse extended data packet }
+{
+ * /dev/sysmouse sends data in two formats, depending on the protocol
+ * level. At the level 0, format is exactly the same as MousSystems'
+ * five byte packet. At the level 1, the first five bytes are the same
+ * as at the level 0. There are additional three bytes which shows
+ * `dz' and the states of additional buttons. `dz' is expressed as the
+ * sum of the byte 5 and 6 which contain signed seven bit values.
+ * The states of the button 4 though 10 are in the bit 0 though 6 in
+ * the byte 7 respectively: 1 indicates the button is up.
+ }
+ MOUSE_SYS_PACKETSIZE = 8;
+ MOUSE_SYS_SYNCMASK = $f8;
+ MOUSE_SYS_SYNC = $80;
+ MOUSE_SYS_BUTTON1UP = $04; { left, 1st byte }
+ MOUSE_SYS_BUTTON2UP = $02; { middle, 1st byte }
+ MOUSE_SYS_BUTTON3UP = $01; { right, 1st byte }
+ MOUSE_SYS_BUTTON4UP = $0001; { 7th byte }
+ MOUSE_SYS_BUTTON5UP = $0002;
+ MOUSE_SYS_BUTTON6UP = $0004;
+ MOUSE_SYS_BUTTON7UP = $0008;
+ MOUSE_SYS_BUTTON8UP = $0010;
+ MOUSE_SYS_BUTTON9UP = $0020;
+ MOUSE_SYS_BUTTON10UP = $0040;
+ MOUSE_SYS_MAXBUTTON = 10;
+ MOUSE_SYS_STDBUTTONS = $07;
+ MOUSE_SYS_EXTBUTTONS = $7f; { the others }
+
+{ Mouse remote socket }
+ _PATH_MOUSEREMOTE ='/var/run/MouseRemote';
+
+
+{fbio FpIoctl numbers}
+ nr_FBIOGTYPE =$40184600;
+ nr_FBIOGINFO =$40184602;
+ nr_FBIOPUTCMAP =$80144603;
+ nr_FBIOGETCMAP =$80144604;
+ nr_FBIOGATTR =$40584606;
+ nr_FBIOSVIDEO =$80044607;
+ nr_FBIOGVIDEO =$40044608;
+ nr_FBIOSCURSOR =$802c4618;
+ nr_FBIOGCURSOR =$c02c4619;
+ nr_FBIOSCURPOS =$8004461a;
+ nr_FBIOGCURPOS =$8004461b;
+ nr_FBIOGCURMAX =$4004461c;
+ nr_FBIO_ADAPTER =$40044664;
+ nr_FBIO_ADPTYPE =$40044665;
+ nr_FBIO_ADPINFO =$40a44666;
+ nr_FBIO_MODEINFO =$c09c4667;
+ nr_FBIO_FINDMODE =$c09c4668;
+ nr_FBIO_GETMODE =$40044669;
+ nr_FBIO_SETMODE =$8004466a;
+ nr_FBIO_GETWINORG =$4004466b;
+ nr_FBIO_SETWINORG =$8004466c;
+ nr_FBIO_GETDISPSTART =$4008466d;
+ nr_FBIO_SETDISPSTART =$8008466e;
+ nr_FBIO_GETLINEWIDTH =$4004466f;
+ nr_FBIO_SETLINEWIDTH =$80044670;
+ nr_FBIO_GETPALETTE =$80184671;
+ nr_FBIO_SETPALETTE =$80184672;
+
+{consio FpIoctl numbers}
+
+ nr_KDGETMODE =$40044b09;
+ nr_KDSETMODE =$20004b0a;
+ nr_KDSBORDER =$20004b0d;
+ nr_KDRASTER =$800c4b64;
+ nr_GIO_SCRNMAP =$41006b02;
+ nr_PIO_SCRNMAP =$81006b03;
+ nr_GIO_ATTR =$40046100;
+ nr_GIO_COLOR =$40046300;
+ nr_CONS_CURRENT =$40046301;
+ nr_CONS_GET =$40046302;
+ nr_CONS_IO =$20006303;
+ nr_CONS_BLANKTIME =$80046304;
+ nr_CONS_SSAVER =$80186305;
+ nr_CONS_GSAVER =$c0186306;
+ nr_CONS_CURSORTYPE =$80046307;
+ nr_CONS_BELLTYPE =$80046308;
+ nr_CONS_HISTORY =$80046309;
+ nr_CONS_MOUSECTL =$c014630a;
+ nr_CONS_IDLE =$4004630b;
+ nr_CONS_SAVERMODE =$8004630c;
+ nr_CONS_SAVERSTART =$8004630d;
+ nr_PIO_FONT8x8 =$88006340;
+ nr_GIO_FONT8x8 =$48006341;
+ nr_PIO_FONT8x14 =$8e006342;
+ nr_GIO_FONT8x14 =$4e006343;
+ nr_PIO_FONT8x16 =$90006344;
+ nr_GIO_FONT8x16 =$50006345;
+ nr_CONS_GETINFO =$c0146349;
+ nr_CONS_GETVERS =$4004634a;
+ nr_CONS_CURRENTADP =$40046364;
+ nr_CONS_ADPINFO =$c0a46365;
+ nr_CONS_MODEINFO =$c09c6366;
+ nr_CONS_FINDMODE =$c09c6367;
+ nr_CONS_SETWINORG =$20006368;
+ nr_CONS_SETKBD =$2000636e;
+ nr_CONS_RELKBD =$2000636f;
+ nr_CONS_GETTERM =$c0686370;
+ nr_CONS_SETTERM =$80686371;
+ nr_ADJUST_CLOCK =$20007464;
+ nr_VT_OPENQRY =$40047601;
+ nr_VT_SETMODE =$80087602;
+ nr_VT_GETMODE =$40087603;
+ nr_VT_RELDISP =$20007604;
+ nr_VT_ACTIVATE =$20007605;
+ nr_VT_WAITACTIVE =$20007606;
+ nr_VT_GETACTIVE =$40047607;
+ nr_VT_GETINDEX =$40047608;
+ nr_SW_B40x25 =$20005300;
+ nr_SW_C40x25 =$20005301;
+ nr_SW_B80x25 =$20005302;
+ nr_SW_C80x25 =$20005303;
+ nr_SW_BG320 =$20005304;
+ nr_SW_CG320 =$20005305;
+ nr_SW_BG640 =$20005306;
+ nr_SW_EGAMONO80x25 =$20005307;
+ nr_SW_CG320_D =$2000530d;
+ nr_SW_CG640_E =$2000530e;
+ nr_SW_EGAMONOAPA =$2000530f;
+ nr_SW_CG640x350 =$20005310;
+ nr_SW_ENH_MONOAPA2 =$20005311;
+ nr_SW_ENH_CG640 =$20005312;
+ nr_SW_ENH_B40x25 =$20005313;
+ nr_SW_ENH_C40x25 =$20005314;
+ nr_SW_ENH_B80x25 =$20005315;
+ nr_SW_ENH_C80x25 =$20005316;
+ nr_SW_ENH_B80x43 =$20005370;
+ nr_SW_ENH_C80x43 =$20005371;
+ nr_SW_MCAMODE =$200053ff;
+ nr_SW_VGA_C40x25 =$20005317;
+ nr_SW_VGA_C80x25 =$20005318;
+ nr_SW_VGA_C80x30 =$20005320;
+ nr_SW_VGA_C80x50 =$2000531e;
+ nr_SW_VGA_C80x60 =$20005322;
+ nr_SW_VGA_M80x25 =$20005319;
+ nr_SW_VGA_M80x30 =$20005321;
+ nr_SW_VGA_M80x50 =$2000531f;
+ nr_SW_VGA_M80x60 =$20005323;
+ nr_SW_VGA11 =$2000531a;
+ nr_SW_BG640x480 =$2000531a;
+ nr_SW_VGA12 =$2000531b;
+ nr_SW_CG640x480 =$2000531b;
+ nr_SW_VGA13 =$2000531c;
+ nr_SW_VGA_CG320 =$2000531c;
+ nr_SW_VGA_CG640 =$20005324;
+ nr_SW_VGA_MODEX =$20005325;
+ nr_SW_PC98_80x25 =$20005362;
+ nr_SW_PC98_80x30 =$20005363;
+ nr_SW_PC98_EGC640x400 =$20005364;
+ nr_SW_PC98_PEGC640x400 =$20005365;
+ nr_SW_PC98_PEGC640x480 =$20005366;
+ nr_SW_VGA_C90x25 =$20005328;
+ nr_SW_VGA_M90x25 =$20005329;
+ nr_SW_VGA_C90x30 =$2000532a;
+ nr_SW_VGA_M90x30 =$2000532b;
+ nr_SW_VGA_C90x43 =$2000532c;
+ nr_SW_VGA_M90x43 =$2000532d;
+ nr_SW_VGA_C90x50 =$2000532e;
+ nr_SW_VGA_M90x50 =$2000532f;
+ nr_SW_VGA_C90x60 =$20005330;
+ nr_SW_VGA_M90x60 =$20005331;
+ nr_SW_TEXT_80x25 =$200053c8;
+ nr_SW_TEXT_80x30 =$200053c9;
+ nr_SW_TEXT_80x43 =$200053ca;
+ nr_SW_TEXT_80x50 =$200053cb;
+ nr_SW_TEXT_80x60 =$200053cc;
+ nr_SW_TEXT_132x25 =$200053cd;
+ nr_SW_TEXT_132x30 =$200053ce;
+ nr_SW_TEXT_132x43 =$200053cf;
+ nr_SW_TEXT_132x50 =$200053d0;
+ nr_SW_TEXT_132x60 =$200053d1;
+ nr_SW_VESA_CG640x400 =$20005600;
+ nr_SW_VESA_CG640x480 =$20005601;
+ nr_SW_VESA_800x600 =$20005602;
+ nr_SW_VESA_CG800x600 =$20005603;
+ nr_SW_VESA_1024x768 =$20005604;
+ nr_SW_VESA_CG1024x768 =$20005605;
+ nr_SW_VESA_1280x1024 =$20005606;
+ nr_SW_VESA_CG1280x1024 =$20005607;
+ nr_SW_VESA_C80x60 =$20005608;
+ nr_SW_VESA_C132x25 =$20005609;
+ nr_SW_VESA_C132x43 =$2000560a;
+ nr_SW_VESA_C132x50 =$2000560b;
+ nr_SW_VESA_C132x60 =$2000560c;
+ nr_SW_VESA_32K_320 =$2000560d;
+ nr_SW_VESA_64K_320 =$2000560e;
+ nr_SW_VESA_FULL_320 =$2000560f;
+ nr_SW_VESA_32K_640 =$20005610;
+ nr_SW_VESA_64K_640 =$20005611;
+ nr_SW_VESA_FULL_640 =$20005612;
+ nr_SW_VESA_32K_800 =$20005613;
+ nr_SW_VESA_64K_800 =$20005614;
+ nr_SW_VESA_FULL_800 =$20005615;
+ nr_SW_VESA_32K_1024 =$20005616;
+ nr_SW_VESA_64K_1024 =$20005617;
+ nr_SW_VESA_FULL_1024 =$20005618;
+ nr_SW_VESA_32K_1280 =$20005619;
+ nr_SW_VESA_64K_1280 =$2000561a;
+ nr_SW_VESA_FULL_1280 =$2000561b;
+
+{kbdsio FpIoctl numbers}
+
+ nr_KDGKBMODE =$40044b06;
+ nr_KDSKBMODE =$20004b07;
+ nr_KDMKTONE =$20004b08;
+{$ifndef definconsole}
+ nr_KDGETMODE =$40044b09;
+ nr_KDSETMODE =$20004b0a;
+ nr_KDSBORDER =$20004b0d;
+{$endif}
+ nr_KDGKBSTATE =$40044b13;
+ nr_KDSKBSTATE =$20004b14;
+ nr_KDENABIO =$20004b3c;
+ nr_KDDISABIO =$20004b3d;
+ nr_KIOCSOUND =$20004b3f;
+ nr_KDGKBTYPE =$40044b40;
+ nr_KDGETLED =$40044b41;
+ nr_KDSETLED =$20004b42;
+ nr_KDSETRAD =$20004b43;
+{$ifndef definconsole}
+ nr_KDRASTER =$800c4b64;
+{$endif}
+ nr_KDGKBINFO =$40244b65;
+ nr_KDSETREPEAT =$80084b66;
+ nr_KDGETREPEAT =$40084b67;
+ nr_GETFKEY =$c0146b00;
+ nr_SETFKEY =$c0146b01;
+{$ifndef definconsole}
+ nr_GIO_SCRNMAP =$41006b02;
+ nr_PIO_SCRNMAP =$81006b03;
+{$endif}
+ nr_GIO_KEYMAP =$4a026b06;
+ nr_PIO_KEYMAP =$8a026b07;
+ nr_GIO_DEADKEYMAP =$462a6b08;
+ nr_PIO_DEADKEYMAP =$862a6b09;
+ nr_GIO_KEYMAPENT =$c00c6b0a;
+ nr_PIO_KEYMAPENT =$800c6b0b;
+
+
+
+{mouse FpIoctl numbers}
+ nr_MOUSE_GETSTATUS =$40184d00;
+ nr_MOUSE_GETHWINFO =$40144d01;
+ nr_MOUSE_GETMODE =$401c4d02;
+ nr_MOUSE_SETMODE =$801c4d03;
+ nr_MOUSE_GETLEVEL =$40044d04;
+ nr_MOUSE_SETLEVEL =$80044d05;
+ nr_MOUSE_GETVARS =$40404d06;
+ nr_MOUSE_SETVARS =$80404d07;
+ nr_MOUSE_READSTATE =$c0444d08;
+ nr_MOUSE_READDATA =$c0444d09;
+ nr_MOUSE_SETRESOLUTION =$80044d0a;
+ nr_MOUSE_SETSCALING =$80044d0b;
+ nr_MOUSE_SETRATE =$80044d0c;
+ nr_MOUSE_GETHWID =$40044d0d;
+
+{------------- Added procedures ---------------}
+
+function physicalconsole(fd:longint) : boolean;
+
+IMPLEMENTATION
+
+Uses BaseUnix,termio;
+
+function physicalconsole(fd:longint) : boolean;
+
+var name:string;
+
+begin
+ if (isatty(fd)<>-1) then
+ begin
+ name:=ttyname(fd);
+ if Copy(name,1,8)<>'/dev/tty' then
+ physicalconsole:=false {isatty is true, but not /dev/tty.
+ Could be /dev/pts support, but
+ I reserve the case}
+ else
+ begin
+ if name[9]='v' then {ttyv is phys console. see /etc/ttys}
+ physicalconsole:=true
+ else
+ physicalconsole:=false;
+ end;
+ end
+ else
+ physicalconsole:=false; {Not a tty, then I don't know what it is}
+end;
+
+{other macros (not FpIoctl)}
+
+function KEYCHAR(c:longint):longint;
+
+begin
+ keychar:=c and $FF;
+end;
+
+function KEYFLAGS(c:longint):longint;
+
+begin
+ keyflags:=c and NOT $FF;
+end;
+
+function kbio_F(x:longint):longint;
+begin
+ kbio_f:=x+F_FN-1;
+end;
+
+function kbio_S(x:longint):longint;
+begin
+ kbio_S:=x+F_SCR-1;
+end;
+
+function kbio_ACC(x:longint):longint;
+begin
+ kbio_ACC:=x+F_ACC;
+end;
+
+{fbio.h FpIoctl's}
+
+Function FBIOGTYPE(fd:longint;var param1 : fbtype):boolean;
+{IOR('F',0,sizeof(struct fbtype) }
+
+Begin
+ FBIOGTYPE:=FpIoctl(fd,nr_FBIOGTYPE,@param1)=0;
+end;
+
+Function FBIOGINFO(fd:longint;var param1 : fbinfo):boolean;
+{IOR('F',2,sizeof(struct fbinfo) }
+
+Begin
+ FBIOGINFO:=FpIoctl(fd,nr_FBIOGINFO,@param1)=0;
+end;
+
+Function FBIOPUTCMAP(fd:longint;var param1 : fbcmap):boolean;
+{IOW('F',3,sizeof(struct fbcmap) }
+
+Begin
+ FBIOPUTCMAP:=FpIoctl(fd,nr_FBIOPUTCMAP,@param1)=0;
+end;
+
+Function FBIOGETCMAP(fd:longint;var param1 : fbcmap):boolean;
+{IOW('F',4,sizeof(struct fbcmap) }
+
+Begin
+ FBIOGETCMAP:=FpIoctl(fd,nr_FBIOGETCMAP,@param1)=0;
+end;
+
+Function FBIOGATTR(fd:longint;var param1 : fbgattr):boolean;
+{IOR('F',6,sizeof(struct fbgattr) }
+
+Begin
+ FBIOGATTR:=FpIoctl(fd,nr_FBIOGATTR,@param1)=0;
+end;
+
+Function FBIOSVIDEO(fd:longint;var param1 : longint):boolean;
+{IOW('F',7,sizeof(int) }
+
+Begin
+ FBIOSVIDEO:=FpIoctl(fd,nr_FBIOSVIDEO,@param1)=0;
+end;
+
+Function FBIOGVIDEO(fd:longint;var param1 : longint):boolean;
+{IOR('F',8,sizeof(int) }
+
+Begin
+ FBIOGVIDEO:=FpIoctl(fd,nr_FBIOGVIDEO,@param1)=0;
+end;
+
+Function FBIOSCURSOR(fd:longint;var param1 : fbcursor):boolean;
+{IOW('F',24,sizeof(struct fbcursor) }
+
+Begin
+ FBIOSCURSOR:=FpIoctl(fd,nr_FBIOSCURSOR,@param1)=0;
+end;
+
+Function FBIOGCURSOR(fd:longint;var param1 : fbcursor):boolean;
+{IOWR('F',25,sizeof(struct fbcursor) }
+
+Begin
+ FBIOGCURSOR:=FpIoctl(fd,nr_FBIOGCURSOR,@param1)=0;
+end;
+
+Function FBIOSCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+{IOW('F',26,sizeof(struct fbcurpos) }
+
+Begin
+ FBIOSCURPOS:=FpIoctl(fd,nr_FBIOSCURPOS,@param1)=0;
+end;
+
+Function FBIOGCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+{IOW('F',27,sizeof(struct fbcurpos) }
+
+Begin
+ FBIOGCURPOS:=FpIoctl(fd,nr_FBIOGCURPOS,@param1)=0;
+end;
+
+Function FBIOGCURMAX(fd:longint;var param1 : fbcurpos):boolean;
+{IOR('F',28,sizeof(struct fbcurpos) }
+
+Begin
+ FBIOGCURMAX:=FpIoctl(fd,nr_FBIOGCURMAX,@param1)=0;
+end;
+
+Function FBIO_ADAPTER(fd:longint;var param1 : longint):boolean;
+{IOR('F',100,sizeof(int) }
+
+Begin
+ FBIO_ADAPTER:=FpIoctl(fd,nr_FBIO_ADAPTER,@param1)=0;
+end;
+
+Function FBIO_ADPTYPE(fd:longint;var param1 : longint):boolean;
+{IOR('F',101,sizeof(int) }
+
+Begin
+ FBIO_ADPTYPE:=FpIoctl(fd,nr_FBIO_ADPTYPE,@param1)=0;
+end;
+
+Function FBIO_ADPINFO(fd:longint;var param1 : video_adapter_info):boolean;
+{IOR('F',102,sizeof(struct video_adapter_info) }
+
+Begin
+ FBIO_ADPINFO:=FpIoctl(fd,nr_FBIO_ADPINFO,@param1)=0;
+end;
+
+Function FBIO_MODEINFO(fd:longint;var param1 : video_info):boolean;
+{IOWR('F',103,sizeof(struct video_info) }
+
+Begin
+ FBIO_MODEINFO:=FpIoctl(fd,nr_FBIO_MODEINFO,@param1)=0;
+end;
+
+Function FBIO_FINDMODE(fd:longint;var param1 : video_info):boolean;
+{IOWR('F',104,sizeof(struct video_info) }
+
+Begin
+ FBIO_FINDMODE:=FpIoctl(fd,nr_FBIO_FINDMODE,@param1)=0;
+end;
+
+Function FBIO_GETMODE(fd:longint;var param1 : longint):boolean;
+{IOR('F',105,sizeof(int) }
+
+Begin
+ FBIO_GETMODE:=FpIoctl(fd,nr_FBIO_GETMODE,@param1)=0;
+end;
+
+Function FBIO_SETMODE(fd:longint;var param1 : longint):boolean;
+{IOW('F',106,sizeof(int) }
+
+Begin
+ FBIO_SETMODE:=FpIoctl(fd,nr_FBIO_SETMODE,@param1)=0;
+end;
+
+Function FBIO_GETWINORG(fd:longint;var param1 : u_int):boolean;
+{IOR('F',107,sizeof(u_int) }
+
+Begin
+ FBIO_GETWINORG:=FpIoctl(fd,nr_FBIO_GETWINORG,@param1)=0;
+end;
+
+Function FBIO_SETWINORG(fd:longint;var param1 : u_int):boolean;
+{IOW('F',108,sizeof(u_int) }
+
+Begin
+ FBIO_SETWINORG:=FpIoctl(fd,nr_FBIO_SETWINORG,@param1)=0;
+end;
+
+Function FBIO_GETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+{IOR('F',109,sizeof(video_display_start_t) }
+
+Begin
+ FBIO_GETDISPSTART:=FpIoctl(fd,nr_FBIO_GETDISPSTART,@param1)=0;
+end;
+
+Function FBIO_SETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+{IOW('F',110,sizeof(video_display_start_t) }
+
+Begin
+ FBIO_SETDISPSTART:=FpIoctl(fd,nr_FBIO_SETDISPSTART,@param1)=0;
+end;
+
+Function FBIO_GETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+{IOR('F',111,sizeof(u_int) }
+
+Begin
+ FBIO_GETLINEWIDTH:=FpIoctl(fd,nr_FBIO_GETLINEWIDTH,@param1)=0;
+end;
+
+Function FBIO_SETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+{IOW('F',112,sizeof(u_int) }
+
+Begin
+ FBIO_SETLINEWIDTH:=FpIoctl(fd,nr_FBIO_SETLINEWIDTH,@param1)=0;
+end;
+
+Function FBIO_GETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+{IOW('F',113,sizeof(video_color_palette_t) }
+
+Begin
+ FBIO_GETPALETTE:=FpIoctl(fd,nr_FBIO_GETPALETTE,@param1)=0;
+end;
+
+Function FBIO_SETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+{IOW('F',114,sizeof(video_color_palette_t) }
+
+Begin
+ FBIO_SETPALETTE:=FpIoctl(fd,nr_FBIO_SETPALETTE,@param1)=0;
+end;
+
+
+{consio.h FpIoctl's}
+
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+{IOR('K',9,sizeof(int) }
+
+Begin
+ KDGETMODE:=FpIoctl(fd,nr_KDGETMODE,@param1)=0;
+end;
+
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+{IO('K',10 /* int */));
+ }
+
+Begin
+ KDSETMODE:=FpIoctl(fd,nr_KDSETMODE,pointer(param1))=0;
+end;
+
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+{IO('K',13 /* int */));
+ }
+
+Begin
+ KDSBORDER:=FpIoctl(fd,nr_KDSBORDER,pointer(param1))=0;
+end;
+
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+{IOW('K',100,sizeof(scr_size_t) }
+
+Begin
+ KDRASTER:=FpIoctl(fd,nr_KDRASTER,@param1)=0;
+end;
+
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOR('k',2,sizeof(scrmap_t) }
+
+Begin
+ GIO_SCRNMAP:=FpIoctl(fd,nr_GIO_SCRNMAP,@param1)=0;
+end;
+
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOW('k',3,sizeof(scrmap_t) }
+
+Begin
+ PIO_SCRNMAP:=FpIoctl(fd,nr_PIO_SCRNMAP,@param1)=0;
+end;
+
+Function GIO_ATTR(fd:longint;var param1 : longint):boolean;
+{IOR('a',0,sizeof(int) }
+
+Begin
+ GIO_ATTR:=FpIoctl(fd,nr_GIO_ATTR,@param1)=0;
+end;
+
+Function GIO_COLOR(fd:longint;var param1 : longint):boolean;
+{IOR('c',0,sizeof(int) }
+
+Begin
+ GIO_COLOR:=FpIoctl(fd,nr_GIO_COLOR,@param1)=0;
+end;
+
+Function CONS_CURRENT(fd:longint;var param1 : longint):boolean;
+{IOR('c',1,sizeof(int) }
+
+Begin
+ CONS_CURRENT:=FpIoctl(fd,nr_CONS_CURRENT,@param1)=0;
+end;
+
+Function CONS_GET(fd:longint;var param1 : longint):boolean;
+{IOR('c',2,sizeof(int) }
+
+Begin
+ CONS_GET:=FpIoctl(fd,nr_CONS_GET,@param1)=0;
+end;
+
+Function CONS_IO(fd:longint):boolean;
+{IO('c',3));
+ }
+
+Begin
+ CONS_IO:=FpIoctl(fd,nr_CONS_IO,nil)=0;
+end;
+
+Function CONS_BLANKTIME(fd:longint;var param1 : longint):boolean;
+{IOW('c',4,sizeof(int) }
+
+Begin
+ CONS_BLANKTIME:=FpIoctl(fd,nr_CONS_BLANKTIME,@param1)=0;
+end;
+
+Function CONS_SSAVER(fd:longint;var param1 : ssaver_t):boolean;
+{IOW('c',5,sizeof(ssaver_t) }
+
+Begin
+ CONS_SSAVER:=FpIoctl(fd,nr_CONS_SSAVER,@param1)=0;
+end;
+
+Function CONS_GSAVER(fd:longint;var param1 : ssaver_t):boolean;
+{IOWR('c',6,sizeof(ssaver_t) }
+
+Begin
+ CONS_GSAVER:=FpIoctl(fd,nr_CONS_GSAVER,@param1)=0;
+end;
+
+Function CONS_CURSORTYPE(fd:longint;var param1 : longint):boolean;
+{IOW('c',7,sizeof(int) }
+
+Begin
+ CONS_CURSORTYPE:=FpIoctl(fd,nr_CONS_CURSORTYPE,@param1)=0;
+end;
+
+Function CONS_BELLTYPE(fd:longint;var param1 : longint):boolean;
+{IOW('c',8,sizeof(int) }
+
+Begin
+ CONS_BELLTYPE:=FpIoctl(fd,nr_CONS_BELLTYPE,@param1)=0;
+end;
+
+Function CONS_HISTORY(fd:longint;var param1 : longint):boolean;
+{IOW('c',9,sizeof(int) }
+
+Begin
+ CONS_HISTORY:=FpIoctl(fd,nr_CONS_HISTORY,@param1)=0;
+end;
+
+Function CONS_MOUSECTL(fd:longint;var param1 : mouse_info_t):boolean;
+{IOWR('c',10,sizeof(mouse_info_t) }
+
+Begin
+ CONS_MOUSECTL:=FpIoctl(fd,nr_CONS_MOUSECTL,@param1)=0;
+end;
+
+Function CONS_IDLE(fd:longint;var param1 : longint):boolean;
+{IOR('c',11,sizeof(int) }
+
+Begin
+ CONS_IDLE:=FpIoctl(fd,nr_CONS_IDLE,@param1)=0;
+end;
+
+Function CONS_SAVERMODE(fd:longint;var param1 : longint):boolean;
+{IOW('c',12,sizeof(int) }
+
+Begin
+ CONS_SAVERMODE:=FpIoctl(fd,nr_CONS_SAVERMODE,@param1)=0;
+end;
+
+Function CONS_SAVERSTART(fd:longint;var param1 : longint):boolean;
+{IOW('c',13,sizeof(int) }
+
+Begin
+ CONS_SAVERSTART:=FpIoctl(fd,nr_CONS_SAVERSTART,@param1)=0;
+end;
+
+Function PIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+{IOW('c',64,sizeof(fnt8_t) }
+
+Begin
+ PIO_FONT8x8:=FpIoctl(fd,nr_PIO_FONT8x8,@param1)=0;
+end;
+
+Function GIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+{IOR('c',65,sizeof(fnt8_t) }
+
+Begin
+ GIO_FONT8x8:=FpIoctl(fd,nr_GIO_FONT8x8,@param1)=0;
+end;
+
+Function PIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+{IOW('c',66,sizeof(fnt14_t) }
+
+Begin
+ PIO_FONT8x14:=FpIoctl(fd,nr_PIO_FONT8x14,@param1)=0;
+end;
+
+Function GIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+{IOR('c',67,sizeof(fnt14_t) }
+
+Begin
+ GIO_FONT8x14:=FpIoctl(fd,nr_GIO_FONT8x14,@param1)=0;
+end;
+
+Function PIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+{IOW('c',68,sizeof(fnt16_t) }
+
+Begin
+ PIO_FONT8x16:=FpIoctl(fd,nr_PIO_FONT8x16,@param1)=0;
+end;
+
+Function GIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+{IOR('c',69,sizeof(fnt16_t) }
+
+Begin
+ GIO_FONT8x16:=FpIoctl(fd,nr_GIO_FONT8x16,@param1)=0;
+end;
+
+Function CONS_GETINFO(fd:longint;var param1 : vid_info_t):boolean;
+{IOWR('c',73,sizeof(vid_info_t) }
+
+Begin
+ CONS_GETINFO:=FpIoctl(fd,nr_CONS_GETINFO,@param1)=0;
+end;
+
+Function CONS_GETVERS(fd:longint;var param1 : longint):boolean;
+{IOR('c',74,sizeof(int) }
+
+Begin
+ CONS_GETVERS:=FpIoctl(fd,nr_CONS_GETVERS,@param1)=0;
+end;
+
+Function CONS_CURRENTADP(fd:longint;var param1 : longint):boolean;
+{IOR('c',100,sizeof(int) }
+
+Begin
+ CONS_CURRENTADP:=FpIoctl(fd,nr_CONS_CURRENTADP,@param1)=0;
+end;
+
+Function CONS_ADPINFO(fd:longint;var param1 : video_adapter_info_t):boolean;
+{IOWR('c',101,sizeof(video_adapter_info_t) }
+
+Begin
+ CONS_ADPINFO:=FpIoctl(fd,nr_CONS_ADPINFO,@param1)=0;
+end;
+
+Function CONS_MODEINFO(fd:longint;var param1 : video_info_t):boolean;
+{IOWR('c',102,sizeof(video_info_t) }
+
+Begin
+ CONS_MODEINFO:=FpIoctl(fd,nr_CONS_MODEINFO,@param1)=0;
+end;
+
+Function CONS_FINDMODE(fd:longint;var param1 : video_info_t):boolean;
+{IOWR('c',103,sizeof(video_info_t) }
+
+Begin
+ CONS_FINDMODE:=FpIoctl(fd,nr_CONS_FINDMODE,@param1)=0;
+end;
+
+Function CONS_SETWINORG(fd:longint;param1 : longint):boolean;
+{IO('c',104 /* int */));
+ }
+
+Begin
+ CONS_SETWINORG:=FpIoctl(fd,nr_CONS_SETWINORG,pointer(param1))=0;
+end;
+
+Function CONS_SETKBD(fd:longint;param1 : longint):boolean;
+{IO('c',110 /* int */));
+ }
+
+Begin
+ CONS_SETKBD:=FpIoctl(fd,nr_CONS_SETKBD,pointer(param1))=0;
+end;
+
+Function CONS_RELKBD(fd:longint):boolean;
+{IO('c',111));
+ }
+
+Begin
+ CONS_RELKBD:=FpIoctl(fd,nr_CONS_RELKBD,nil)=0;
+end;
+
+Function CONS_GETTERM(fd:longint;var param1 : term_info_t):boolean;
+{IOWR('c',112,sizeof(term_info_t) }
+
+Begin
+ CONS_GETTERM:=FpIoctl(fd,nr_CONS_GETTERM,@param1)=0;
+end;
+
+Function CONS_SETTERM(fd:longint;var param1 : term_info_t):boolean;
+{IOW('c',113,sizeof(term_info_t) }
+
+Begin
+ CONS_SETTERM:=FpIoctl(fd,nr_CONS_SETTERM,@param1)=0;
+end;
+
+Function ADJUST_CLOCK(fd:longint):boolean;
+{IO('t',100));
+ }
+
+Begin
+ ADJUST_CLOCK:=FpIoctl(fd,nr_ADJUST_CLOCK,nil)=0;
+end;
+
+Function VT_OPENQRY(fd:longint;var param1 : longint):boolean;
+{IOR('v',1,sizeof(int) }
+
+Begin
+ VT_OPENQRY:=FpIoctl(fd,nr_VT_OPENQRY,@param1)=0;
+end;
+
+Function VT_SETMODE(fd:longint;var param1 : vtmode_t):boolean;
+{IOW('v',2,sizeof(vtmode_t) }
+
+Begin
+ VT_SETMODE:=FpIoctl(fd,nr_VT_SETMODE,@param1)=0;
+end;
+
+Function VT_GETMODE(fd:longint;var param1 : vtmode_t):boolean;
+{IOR('v',3,sizeof(vtmode_t) }
+
+Begin
+ VT_GETMODE:=FpIoctl(fd,nr_VT_GETMODE,@param1)=0;
+end;
+
+Function VT_RELDISP(fd:longint;param1 : longint):boolean;
+{IO('v',4 /* int */));
+ }
+
+Begin
+ VT_RELDISP:=FpIoctl(fd,nr_VT_RELDISP,pointer(param1))=0;
+end;
+
+Function VT_ACTIVATE(fd:longint;param1 : longint):boolean;
+{IO('v',5 /* int */));
+ }
+
+Begin
+ VT_ACTIVATE:=FpIoctl(fd,nr_VT_ACTIVATE,pointer(param1))=0;
+end;
+
+Function VT_WAITACTIVE(fd:longint;param1 : longint):boolean;
+{IO('v',6 /* int */));
+ }
+
+Begin
+ VT_WAITACTIVE:=FpIoctl(fd,nr_VT_WAITACTIVE,pointer(param1))=0;
+end;
+
+Function VT_GETACTIVE(fd:longint;var param1 : longint):boolean;
+{IOR('v',7,sizeof(int) }
+
+Begin
+ VT_GETACTIVE:=FpIoctl(fd,nr_VT_GETACTIVE,@param1)=0;
+end;
+
+Function VT_GETINDEX(fd:longint;var param1 : longint):boolean;
+{IOR('v',8,sizeof(int) }
+
+Begin
+ VT_GETINDEX:=FpIoctl(fd,nr_VT_GETINDEX,@param1)=0;
+end;
+
+Function SW_B40x25(fd:longint):boolean;
+{IO('S',M_B40x25));
+ }
+
+Begin
+ SW_B40x25:=FpIoctl(fd,nr_SW_B40x25,nil)=0;
+end;
+
+Function SW_C40x25(fd:longint):boolean;
+{IO('S',M_C40x25));
+ }
+
+Begin
+ SW_C40x25:=FpIoctl(fd,nr_SW_C40x25,nil)=0;
+end;
+
+Function SW_B80x25(fd:longint):boolean;
+{IO('S',M_B80x25));
+ }
+
+Begin
+ SW_B80x25:=FpIoctl(fd,nr_SW_B80x25,nil)=0;
+end;
+
+Function SW_C80x25(fd:longint):boolean;
+{IO('S',M_C80x25));
+ }
+
+Begin
+ SW_C80x25:=FpIoctl(fd,nr_SW_C80x25,nil)=0;
+end;
+
+Function SW_BG320(fd:longint):boolean;
+{IO('S',M_BG320));
+ }
+
+Begin
+ SW_BG320:=FpIoctl(fd,nr_SW_BG320,nil)=0;
+end;
+
+Function SW_CG320(fd:longint):boolean;
+{IO('S',M_CG320));
+ }
+
+Begin
+ SW_CG320:=FpIoctl(fd,nr_SW_CG320,nil)=0;
+end;
+
+Function SW_BG640(fd:longint):boolean;
+{IO('S',M_BG640));
+ }
+
+Begin
+ SW_BG640:=FpIoctl(fd,nr_SW_BG640,nil)=0;
+end;
+
+Function SW_EGAMONO80x25(fd:longint):boolean;
+{IO('S',M_EGAMONO80x25));
+ }
+
+Begin
+ SW_EGAMONO80x25:=FpIoctl(fd,nr_SW_EGAMONO80x25,nil)=0;
+end;
+
+Function SW_CG320_D(fd:longint):boolean;
+{IO('S',M_CG320_D));
+ }
+
+Begin
+ SW_CG320_D:=FpIoctl(fd,nr_SW_CG320_D,nil)=0;
+end;
+
+Function SW_CG640_E(fd:longint):boolean;
+{IO('S',M_CG640_E));
+ }
+
+Begin
+ SW_CG640_E:=FpIoctl(fd,nr_SW_CG640_E,nil)=0;
+end;
+
+Function SW_EGAMONOAPA(fd:longint):boolean;
+{IO('S',M_EGAMONOAPA));
+ }
+
+Begin
+ SW_EGAMONOAPA:=FpIoctl(fd,nr_SW_EGAMONOAPA,nil)=0;
+end;
+
+Function SW_CG640x350(fd:longint):boolean;
+{IO('S',M_CG640x350));
+ }
+
+Begin
+ SW_CG640x350:=FpIoctl(fd,nr_SW_CG640x350,nil)=0;
+end;
+
+Function SW_ENH_MONOAPA2(fd:longint):boolean;
+{IO('S',M_ENHMONOAPA2));
+ }
+
+Begin
+ SW_ENH_MONOAPA2:=FpIoctl(fd,nr_SW_ENH_MONOAPA2,nil)=0;
+end;
+
+Function SW_ENH_CG640(fd:longint):boolean;
+{IO('S',M_ENH_CG640));
+ }
+
+Begin
+ SW_ENH_CG640:=FpIoctl(fd,nr_SW_ENH_CG640,nil)=0;
+end;
+
+Function SW_ENH_B40x25(fd:longint):boolean;
+{IO('S',M_ENH_B40x25));
+ }
+
+Begin
+ SW_ENH_B40x25:=FpIoctl(fd,nr_SW_ENH_B40x25,nil)=0;
+end;
+
+Function SW_ENH_C40x25(fd:longint):boolean;
+{IO('S',M_ENH_C40x25));
+ }
+
+Begin
+ SW_ENH_C40x25:=FpIoctl(fd,nr_SW_ENH_C40x25,nil)=0;
+end;
+
+Function SW_ENH_B80x25(fd:longint):boolean;
+{IO('S',M_ENH_B80x25));
+ }
+
+Begin
+ SW_ENH_B80x25:=FpIoctl(fd,nr_SW_ENH_B80x25,nil)=0;
+end;
+
+Function SW_ENH_C80x25(fd:longint):boolean;
+{IO('S',M_ENH_C80x25));
+ }
+
+Begin
+ SW_ENH_C80x25:=FpIoctl(fd,nr_SW_ENH_C80x25,nil)=0;
+end;
+
+Function SW_ENH_B80x43(fd:longint):boolean;
+{IO('S',M_ENH_B80x43));
+ }
+
+Begin
+ SW_ENH_B80x43:=FpIoctl(fd,nr_SW_ENH_B80x43,nil)=0;
+end;
+
+Function SW_ENH_C80x43(fd:longint):boolean;
+{IO('S',M_ENH_C80x43));
+ }
+
+Begin
+ SW_ENH_C80x43:=FpIoctl(fd,nr_SW_ENH_C80x43,nil)=0;
+end;
+
+Function SW_MCAMODE(fd:longint):boolean;
+{IO('S',M_MCA_MODE));
+ }
+
+Begin
+ SW_MCAMODE:=FpIoctl(fd,nr_SW_MCAMODE,nil)=0;
+end;
+
+Function SW_VGA_C40x25(fd:longint):boolean;
+{IO('S',M_VGA_C40x25));
+ }
+
+Begin
+ SW_VGA_C40x25:=FpIoctl(fd,nr_SW_VGA_C40x25,nil)=0;
+end;
+
+Function SW_VGA_C80x25(fd:longint):boolean;
+{IO('S',M_VGA_C80x25));
+ }
+
+Begin
+ SW_VGA_C80x25:=FpIoctl(fd,nr_SW_VGA_C80x25,nil)=0;
+end;
+
+Function SW_VGA_C80x30(fd:longint):boolean;
+{IO('S',M_VGA_C80x30));
+ }
+
+Begin
+ SW_VGA_C80x30:=FpIoctl(fd,nr_SW_VGA_C80x30,nil)=0;
+end;
+
+Function SW_VGA_C80x50(fd:longint):boolean;
+{IO('S',M_VGA_C80x50));
+ }
+
+Begin
+ SW_VGA_C80x50:=FpIoctl(fd,nr_SW_VGA_C80x50,nil)=0;
+end;
+
+Function SW_VGA_C80x60(fd:longint):boolean;
+{IO('S',M_VGA_C80x60));
+ }
+
+Begin
+ SW_VGA_C80x60:=FpIoctl(fd,nr_SW_VGA_C80x60,nil)=0;
+end;
+
+Function SW_VGA_M80x25(fd:longint):boolean;
+{IO('S',M_VGA_M80x25));
+ }
+
+Begin
+ SW_VGA_M80x25:=FpIoctl(fd,nr_SW_VGA_M80x25,nil)=0;
+end;
+
+Function SW_VGA_M80x30(fd:longint):boolean;
+{IO('S',M_VGA_M80x30));
+ }
+
+Begin
+ SW_VGA_M80x30:=FpIoctl(fd,nr_SW_VGA_M80x30,nil)=0;
+end;
+
+Function SW_VGA_M80x50(fd:longint):boolean;
+{IO('S',M_VGA_M80x50));
+ }
+
+Begin
+ SW_VGA_M80x50:=FpIoctl(fd,nr_SW_VGA_M80x50,nil)=0;
+end;
+
+Function SW_VGA_M80x60(fd:longint):boolean;
+{IO('S',M_VGA_M80x60));
+ }
+
+Begin
+ SW_VGA_M80x60:=FpIoctl(fd,nr_SW_VGA_M80x60,nil)=0;
+end;
+
+Function SW_VGA11(fd:longint):boolean;
+{IO('S',M_VGA11));
+ }
+
+Begin
+ SW_VGA11:=FpIoctl(fd,nr_SW_VGA11,nil)=0;
+end;
+
+Function SW_BG640x480(fd:longint):boolean;
+{IO('S',M_VGA11));
+ }
+
+Begin
+ SW_BG640x480:=FpIoctl(fd,nr_SW_BG640x480,nil)=0;
+end;
+
+Function SW_VGA12(fd:longint):boolean;
+{IO('S',M_VGA12));
+ }
+
+Begin
+ SW_VGA12:=FpIoctl(fd,nr_SW_VGA12,nil)=0;
+end;
+
+Function SW_CG640x480(fd:longint):boolean;
+{IO('S',M_VGA12));
+ }
+
+Begin
+ SW_CG640x480:=FpIoctl(fd,nr_SW_CG640x480,nil)=0;
+end;
+
+Function SW_VGA13(fd:longint):boolean;
+{IO('S',M_VGA13));
+ }
+
+Begin
+ SW_VGA13:=FpIoctl(fd,nr_SW_VGA13,nil)=0;
+end;
+
+Function SW_VGA_CG320(fd:longint):boolean;
+{IO('S',M_VGA13));
+ }
+
+Begin
+ SW_VGA_CG320:=FpIoctl(fd,nr_SW_VGA_CG320,nil)=0;
+end;
+
+Function SW_VGA_CG640(fd:longint):boolean;
+{IO('S',M_VGA_CG640));
+ }
+
+Begin
+ SW_VGA_CG640:=FpIoctl(fd,nr_SW_VGA_CG640,nil)=0;
+end;
+
+Function SW_VGA_MODEX(fd:longint):boolean;
+{IO('S',M_VGA_MODEX));
+ }
+
+Begin
+ SW_VGA_MODEX:=FpIoctl(fd,nr_SW_VGA_MODEX,nil)=0;
+end;
+
+Function SW_PC98_80x25(fd:longint):boolean;
+{IO('S',M_PC98_80x25));
+ }
+
+Begin
+ SW_PC98_80x25:=FpIoctl(fd,nr_SW_PC98_80x25,nil)=0;
+end;
+
+Function SW_PC98_80x30(fd:longint):boolean;
+{IO('S',M_PC98_80x30));
+ }
+
+Begin
+ SW_PC98_80x30:=FpIoctl(fd,nr_SW_PC98_80x30,nil)=0;
+end;
+
+Function SW_PC98_EGC640x400(fd:longint):boolean;
+{IO('S',M_PC98_EGC640x400));
+ }
+
+Begin
+ SW_PC98_EGC640x400:=FpIoctl(fd,nr_SW_PC98_EGC640x400,nil)=0;
+end;
+
+Function SW_PC98_PEGC640x400(fd:longint):boolean;
+{IO('S',M_PC98_PEGC640x400));
+ }
+
+Begin
+ SW_PC98_PEGC640x400:=FpIoctl(fd,nr_SW_PC98_PEGC640x400,nil)=0;
+end;
+
+Function SW_PC98_PEGC640x480(fd:longint):boolean;
+{IO('S',M_PC98_PEGC640x480));
+ }
+
+Begin
+ SW_PC98_PEGC640x480:=FpIoctl(fd,nr_SW_PC98_PEGC640x480,nil)=0;
+end;
+
+Function SW_VGA_C90x25(fd:longint):boolean;
+{IO('S',M_VGA_C90x25));
+ }
+
+Begin
+ SW_VGA_C90x25:=FpIoctl(fd,nr_SW_VGA_C90x25,nil)=0;
+end;
+
+Function SW_VGA_M90x25(fd:longint):boolean;
+{IO('S',M_VGA_M90x25));
+ }
+
+Begin
+ SW_VGA_M90x25:=FpIoctl(fd,nr_SW_VGA_M90x25,nil)=0;
+end;
+
+Function SW_VGA_C90x30(fd:longint):boolean;
+{IO('S',M_VGA_C90x30));
+ }
+
+Begin
+ SW_VGA_C90x30:=FpIoctl(fd,nr_SW_VGA_C90x30,nil)=0;
+end;
+
+Function SW_VGA_M90x30(fd:longint):boolean;
+{IO('S',M_VGA_M90x30));
+ }
+
+Begin
+ SW_VGA_M90x30:=FpIoctl(fd,nr_SW_VGA_M90x30,nil)=0;
+end;
+
+Function SW_VGA_C90x43(fd:longint):boolean;
+{IO('S',M_VGA_C90x43));
+ }
+
+Begin
+ SW_VGA_C90x43:=FpIoctl(fd,nr_SW_VGA_C90x43,nil)=0;
+end;
+
+Function SW_VGA_M90x43(fd:longint):boolean;
+{IO('S',M_VGA_M90x43));
+ }
+
+Begin
+ SW_VGA_M90x43:=FpIoctl(fd,nr_SW_VGA_M90x43,nil)=0;
+end;
+
+Function SW_VGA_C90x50(fd:longint):boolean;
+{IO('S',M_VGA_C90x50));
+ }
+
+Begin
+ SW_VGA_C90x50:=FpIoctl(fd,nr_SW_VGA_C90x50,nil)=0;
+end;
+
+Function SW_VGA_M90x50(fd:longint):boolean;
+{IO('S',M_VGA_M90x50));
+ }
+
+Begin
+ SW_VGA_M90x50:=FpIoctl(fd,nr_SW_VGA_M90x50,nil)=0;
+end;
+
+Function SW_VGA_C90x60(fd:longint):boolean;
+{IO('S',M_VGA_C90x60));
+ }
+
+Begin
+ SW_VGA_C90x60:=FpIoctl(fd,nr_SW_VGA_C90x60,nil)=0;
+end;
+
+Function SW_VGA_M90x60(fd:longint):boolean;
+{IO('S',M_VGA_M90x60));
+ }
+
+Begin
+ SW_VGA_M90x60:=FpIoctl(fd,nr_SW_VGA_M90x60,nil)=0;
+end;
+
+Function SW_TEXT_80x25(fd:longint):boolean;
+{IO('S',M_TEXT_80x25));
+ }
+
+Begin
+ SW_TEXT_80x25:=FpIoctl(fd,nr_SW_TEXT_80x25,nil)=0;
+end;
+
+Function SW_TEXT_80x30(fd:longint):boolean;
+{IO('S',M_TEXT_80x30));
+ }
+
+Begin
+ SW_TEXT_80x30:=FpIoctl(fd,nr_SW_TEXT_80x30,nil)=0;
+end;
+
+Function SW_TEXT_80x43(fd:longint):boolean;
+{IO('S',M_TEXT_80x43));
+ }
+
+Begin
+ SW_TEXT_80x43:=FpIoctl(fd,nr_SW_TEXT_80x43,nil)=0;
+end;
+
+Function SW_TEXT_80x50(fd:longint):boolean;
+{IO('S',M_TEXT_80x50));
+ }
+
+Begin
+ SW_TEXT_80x50:=FpIoctl(fd,nr_SW_TEXT_80x50,nil)=0;
+end;
+
+Function SW_TEXT_80x60(fd:longint):boolean;
+{IO('S',M_TEXT_80x60));
+ }
+
+Begin
+ SW_TEXT_80x60:=FpIoctl(fd,nr_SW_TEXT_80x60,nil)=0;
+end;
+
+Function SW_TEXT_132x25(fd:longint):boolean;
+{IO('S',M_TEXT_132x25));
+ }
+
+Begin
+ SW_TEXT_132x25:=FpIoctl(fd,nr_SW_TEXT_132x25,nil)=0;
+end;
+
+Function SW_TEXT_132x30(fd:longint):boolean;
+{IO('S',M_TEXT_132x30));
+ }
+
+Begin
+ SW_TEXT_132x30:=FpIoctl(fd,nr_SW_TEXT_132x30,nil)=0;
+end;
+
+Function SW_TEXT_132x43(fd:longint):boolean;
+{IO('S',M_TEXT_132x43));
+ }
+
+Begin
+ SW_TEXT_132x43:=FpIoctl(fd,nr_SW_TEXT_132x43,nil)=0;
+end;
+
+Function SW_TEXT_132x50(fd:longint):boolean;
+{IO('S',M_TEXT_132x50));
+ }
+
+Begin
+ SW_TEXT_132x50:=FpIoctl(fd,nr_SW_TEXT_132x50,nil)=0;
+end;
+
+Function SW_TEXT_132x60(fd:longint):boolean;
+{IO('S',M_TEXT_132x60));
+ }
+
+Begin
+ SW_TEXT_132x60:=FpIoctl(fd,nr_SW_TEXT_132x60,nil)=0;
+end;
+
+Function SW_VESA_CG640x400(fd:longint):boolean;
+{IO('V',M_VESA_CG640x400 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_CG640x400:=FpIoctl(fd,nr_SW_VESA_CG640x400,nil)=0;
+end;
+
+Function SW_VESA_CG640x480(fd:longint):boolean;
+{IO('V',M_VESA_CG640x480 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_CG640x480:=FpIoctl(fd,nr_SW_VESA_CG640x480,nil)=0;
+end;
+
+Function SW_VESA_800x600(fd:longint):boolean;
+{IO('V',M_VESA_800x600 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_800x600:=FpIoctl(fd,nr_SW_VESA_800x600,nil)=0;
+end;
+
+Function SW_VESA_CG800x600(fd:longint):boolean;
+{IO('V',M_VESA_CG800x600 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_CG800x600:=FpIoctl(fd,nr_SW_VESA_CG800x600,nil)=0;
+end;
+
+Function SW_VESA_1024x768(fd:longint):boolean;
+{IO('V',M_VESA_1024x768 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_1024x768:=FpIoctl(fd,nr_SW_VESA_1024x768,nil)=0;
+end;
+
+Function SW_VESA_CG1024x768(fd:longint):boolean;
+{IO('V',M_VESA_CG1024x768 - M_VESA_BAS));
+ }
+
+Begin
+ SW_VESA_CG1024x768:=FpIoctl(fd,nr_SW_VESA_CG1024x768,nil)=0;
+end;
+
+Function SW_VESA_1280x1024(fd:longint):boolean;
+{IO('V',M_VESA_1280x1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_1280x1024:=FpIoctl(fd,nr_SW_VESA_1280x1024,nil)=0;
+end;
+
+Function SW_VESA_CG1280x1024(fd:longint):boolean;
+{IO('V',M_VESA_CG1280x1024 - M_VESA_BA));
+ }
+
+Begin
+ SW_VESA_CG1280x1024:=FpIoctl(fd,nr_SW_VESA_CG1280x1024,nil)=0;
+end;
+
+Function SW_VESA_C80x60(fd:longint):boolean;
+{IO('V',M_VESA_C80x60 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C80x60:=FpIoctl(fd,nr_SW_VESA_C80x60,nil)=0;
+end;
+
+Function SW_VESA_C132x25(fd:longint):boolean;
+{IO('V',M_VESA_C132x25 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x25:=FpIoctl(fd,nr_SW_VESA_C132x25,nil)=0;
+end;
+
+Function SW_VESA_C132x43(fd:longint):boolean;
+{IO('V',M_VESA_C132x43 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x43:=FpIoctl(fd,nr_SW_VESA_C132x43,nil)=0;
+end;
+
+Function SW_VESA_C132x50(fd:longint):boolean;
+{IO('V',M_VESA_C132x50 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x50:=FpIoctl(fd,nr_SW_VESA_C132x50,nil)=0;
+end;
+
+Function SW_VESA_C132x60(fd:longint):boolean;
+{IO('V',M_VESA_C132x60 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x60:=FpIoctl(fd,nr_SW_VESA_C132x60,nil)=0;
+end;
+
+Function SW_VESA_32K_320(fd:longint):boolean;
+{IO('V',M_VESA_32K_320 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_320:=FpIoctl(fd,nr_SW_VESA_32K_320,nil)=0;
+end;
+
+Function SW_VESA_64K_320(fd:longint):boolean;
+{IO('V',M_VESA_64K_320 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_320:=FpIoctl(fd,nr_SW_VESA_64K_320,nil)=0;
+end;
+
+Function SW_VESA_FULL_320(fd:longint):boolean;
+{IO('V',M_VESA_FULL_320 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_320:=FpIoctl(fd,nr_SW_VESA_FULL_320,nil)=0;
+end;
+
+Function SW_VESA_32K_640(fd:longint):boolean;
+{IO('V',M_VESA_32K_640 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_640:=FpIoctl(fd,nr_SW_VESA_32K_640,nil)=0;
+end;
+
+Function SW_VESA_64K_640(fd:longint):boolean;
+{IO('V',M_VESA_64K_640 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_640:=FpIoctl(fd,nr_SW_VESA_64K_640,nil)=0;
+end;
+
+Function SW_VESA_FULL_640(fd:longint):boolean;
+{IO('V',M_VESA_FULL_640 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_640:=FpIoctl(fd,nr_SW_VESA_FULL_640,nil)=0;
+end;
+
+Function SW_VESA_32K_800(fd:longint):boolean;
+{IO('V',M_VESA_32K_800 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_800:=FpIoctl(fd,nr_SW_VESA_32K_800,nil)=0;
+end;
+
+Function SW_VESA_64K_800(fd:longint):boolean;
+{IO('V',M_VESA_64K_800 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_800:=FpIoctl(fd,nr_SW_VESA_64K_800,nil)=0;
+end;
+
+Function SW_VESA_FULL_800(fd:longint):boolean;
+{IO('V',M_VESA_FULL_800 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_800:=FpIoctl(fd,nr_SW_VESA_FULL_800,nil)=0;
+end;
+
+Function SW_VESA_32K_1024(fd:longint):boolean;
+{IO('V',M_VESA_32K_1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_1024:=FpIoctl(fd,nr_SW_VESA_32K_1024,nil)=0;
+end;
+
+Function SW_VESA_64K_1024(fd:longint):boolean;
+{IO('V',M_VESA_64K_1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_1024:=FpIoctl(fd,nr_SW_VESA_64K_1024,nil)=0;
+end;
+
+Function SW_VESA_FULL_1024(fd:longint):boolean;
+{IO('V',M_VESA_FULL_1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_1024:=FpIoctl(fd,nr_SW_VESA_FULL_1024,nil)=0;
+end;
+
+Function SW_VESA_32K_1280(fd:longint):boolean;
+{IO('V',M_VESA_32K_1280 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_1280:=FpIoctl(fd,nr_SW_VESA_32K_1280,nil)=0;
+end;
+
+Function SW_VESA_64K_1280(fd:longint):boolean;
+{IO('V',M_VESA_64K_1280 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_1280:=FpIoctl(fd,nr_SW_VESA_64K_1280,nil)=0;
+end;
+
+Function SW_VESA_FULL_1280(fd:longint):boolean;
+{IO('V',M_VESA_FULL_1280 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_1280:=FpIoctl(fd,nr_SW_VESA_FULL_1280,nil)=0;
+end;
+
+{----------------------------- kbio.h FpIoctl's ---------------------------}
+
+Function KDGKBMODE(fd:longint;var param1 : longint):boolean;
+{IOR('K',6,sizeof(int) }
+
+Begin
+ KDGKBMODE:=FpIoctl(fd,nr_KDGKBMODE,@param1)=0;
+end;
+
+Function KDSKBMODE(fd:longint;param1 : longint):boolean;
+{IO('K',7 /* int */));
+ }
+
+Begin
+ KDSKBMODE:=FpIoctl(fd,nr_KDSKBMODE,pointer(param1))=0;
+end;
+
+Function KDMKTONE(fd:longint;param1 : longint):boolean;
+{IO('K',8 /* int */));
+ }
+
+Begin
+ KDMKTONE:=FpIoctl(fd,nr_KDMKTONE,pointer(param1))=0;
+end;
+
+{$ifndef definconsole}
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+{IOR('K',9,sizeof(int) }
+
+Begin
+ KDGETMODE:=FpIoctl(fd,nr_KDGETMODE,@param1)=0;
+end;
+
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+{IO('K',10 /* int */));
+ }
+
+Begin
+ KDSETMODE:=FpIoctl(fd,nr_KDSETMODE,pointer(param1))=0;
+end;
+
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+{IO('K',13 /* int */));
+ }
+
+Begin
+ KDSBORDER:=FpIoctl(fd,nr_KDSBORDER,pointer(param1))=0;
+end;
+{$endif}
+Function KDGKBSTATE(fd:longint;var param1 : longint):boolean;
+{IOR('K',19,sizeof(int) }
+
+Begin
+ KDGKBSTATE:=FpIoctl(fd,nr_KDGKBSTATE,@param1)=0;
+end;
+
+Function KDSKBSTATE(fd:longint;param1 : longint):boolean;
+{IO('K',20 /* int */));
+ }
+
+Begin
+ KDSKBSTATE:=FpIoctl(fd,nr_KDSKBSTATE,pointer(param1))=0;
+end;
+
+Function KDENABIO(fd:longint):boolean;
+{IO('K',60));
+ }
+
+Begin
+ KDENABIO:=FpIoctl(fd,nr_KDENABIO,nil)=0;
+end;
+
+Function KDDISABIO(fd:longint):boolean;
+{IO('K',61));
+ }
+
+Begin
+ KDDISABIO:=FpIoctl(fd,nr_KDDISABIO,nil)=0;
+end;
+
+Function KIOCSOUND(fd:longint;param1 : longint):boolean;
+{IO('K',63 /* int */));
+ }
+
+Begin
+ KIOCSOUND:=FpIoctl(fd,nr_KIOCSOUND,pointer(param1))=0;
+end;
+
+Function KDGKBTYPE(fd:longint;var param1 : longint):boolean;
+{IOR('K',64,sizeof(int) }
+
+Begin
+ KDGKBTYPE:=FpIoctl(fd,nr_KDGKBTYPE,@param1)=0;
+end;
+
+Function KDGETLED(fd:longint;var param1 : longint):boolean;
+{IOR('K',65,sizeof(int) }
+
+Begin
+ KDGETLED:=FpIoctl(fd,nr_KDGETLED,@param1)=0;
+end;
+
+Function KDSETLED(fd:longint;param1 : longint):boolean;
+{IO('K',66 /* int */));
+ }
+
+Begin
+ KDSETLED:=FpIoctl(fd,nr_KDSETLED,pointer(param1))=0;
+end;
+
+Function KDSETRAD(fd:longint;param1 : longint):boolean;
+{IO('K',67 /* int */));
+ }
+
+Begin
+ KDSETRAD:=FpIoctl(fd,nr_KDSETRAD,pointer(param1))=0;
+end;
+{$ifndef definconsole}
+
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+{IOW('K',100,sizeof(scr_size_t) }
+
+Begin
+ KDRASTER:=FpIoctl(fd,nr_KDRASTER,@param1)=0;
+end;
+{$endif}
+Function KDGKBINFO(fd:longint;var param1 : keyboard_info_t):boolean;
+{IOR('K',101,sizeof(keyboard_info_t) }
+
+Begin
+ KDGKBINFO:=FpIoctl(fd,nr_KDGKBINFO,@param1)=0;
+end;
+
+Function KDSETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+{IOW('K',102,sizeof(keyboard_repeat_t) }
+
+Begin
+ KDSETREPEAT:=FpIoctl(fd,nr_KDSETREPEAT,@param1)=0;
+end;
+
+Function KDGETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+{IOR('K',103,sizeof(keyboard_repeat_t) }
+
+Begin
+ KDGETREPEAT:=FpIoctl(fd,nr_KDGETREPEAT,@param1)=0;
+end;
+
+Function GETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+{IOWR('k',0,sizeof(fkeyarg_t) }
+
+Begin
+ GETFKEY:=FpIoctl(fd,nr_GETFKEY,@param1)=0;
+end;
+
+Function SETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+{IOWR('k',1,sizeof(fkeyarg_t) }
+
+Begin
+ SETFKEY:=FpIoctl(fd,nr_SETFKEY,@param1)=0;
+end;
+{$ifndef definconsole}
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOR('k',2,sizeof(scrmap_t) }
+
+Begin
+ GIO_SCRNMAP:=FpIoctl(fd,nr_GIO_SCRNMAP,@param1)=0;
+end;
+
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOW('k',3,sizeof(scrmap_t) }
+
+Begin
+ PIO_SCRNMAP:=FpIoctl(fd,nr_PIO_SCRNMAP,@param1)=0;
+end;
+{$endif}
+Function GIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+{IOR('k',6,sizeof(keymap_t) }
+
+Begin
+ GIO_KEYMAP:=FpIoctl(fd,nr_GIO_KEYMAP,@param1)=0;
+end;
+
+Function PIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+{IOW('k',7,sizeof(keymap_t) }
+
+Begin
+ PIO_KEYMAP:=FpIoctl(fd,nr_PIO_KEYMAP,@param1)=0;
+end;
+
+Function GIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+{IOR('k',8,sizeof(accentmap_t) }
+
+Begin
+ GIO_DEADKEYMAP:=FpIoctl(fd,nr_GIO_DEADKEYMAP,@param1)=0;
+end;
+
+Function PIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+{IOW('k',9,sizeof(accentmap_t) }
+
+Begin
+ PIO_DEADKEYMAP:=FpIoctl(fd,nr_PIO_DEADKEYMAP,@param1)=0;
+end;
+
+Function GIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+{IOWR('k',10,sizeof(keyarg_t) }
+
+Begin
+ GIO_KEYMAPENT:=FpIoctl(fd,nr_GIO_KEYMAPENT,@param1)=0;
+end;
+
+Function PIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+{IOW('k',11,sizeof(keyarg_t) }
+
+Begin
+ PIO_KEYMAPENT:=FpIoctl(fd,nr_PIO_KEYMAPENT,@param1)=0;
+end;
+
+
+
+{----------------------------- mouse.h FpIoctl's ---------------------------}
+
+Function MOUSE_GETSTATUS(fd:longint;var param1 : mousestatus_t):boolean;
+{IOR('M',0,sizeof(mousestatus_t)));
+}
+
+Begin
+ MOUSE_GETSTATUS:=FpIoctl(fd,nr_MOUSE_GETSTATUS,@param1)=0;
+end;
+
+Function MOUSE_GETHWINFO(fd:longint;var param1 : mousehw_t):boolean;
+{IOR('M',1,sizeof(mousehw_t)));
+}
+
+Begin
+ MOUSE_GETHWINFO:=FpIoctl(fd,nr_MOUSE_GETHWINFO,@param1)=0;
+end;
+
+Function MOUSE_GETMODE(fd:longint;var param1 : mousemode_t):boolean;
+{IOR('M',2,sizeof(mousemode_t)));
+}
+
+Begin
+ MOUSE_GETMODE:=FpIoctl(fd,nr_MOUSE_GETMODE,@param1)=0;
+end;
+
+Function MOUSE_SETMODE(fd:longint;var param1 : mousemode_t):boolean;
+{IOW('M',3,sizeof(mousemode_t)));
+}
+
+Begin
+ MOUSE_SETMODE:=FpIoctl(fd,nr_MOUSE_SETMODE,@param1)=0;
+end;
+
+Function MOUSE_GETLEVEL(fd:longint;var param1 : longint):boolean;
+{IOR('M',4,sizeof(int)));
+}
+
+Begin
+ MOUSE_GETLEVEL:=FpIoctl(fd,nr_MOUSE_GETLEVEL,@param1)=0;
+end;
+
+Function MOUSE_SETLEVEL(fd:longint;var param1 : longint):boolean;
+{IOW('M',5,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETLEVEL:=FpIoctl(fd,nr_MOUSE_SETLEVEL,@param1)=0;
+end;
+
+Function MOUSE_GETVARS(fd:longint;var param1 : mousevar_t):boolean;
+{IOR('M',6,sizeof(mousevar_t)));
+}
+
+Begin
+ MOUSE_GETVARS:=FpIoctl(fd,nr_MOUSE_GETVARS,@param1)=0;
+end;
+
+Function MOUSE_SETVARS(fd:longint;var param1 : mousevar_t):boolean;
+{IOW('M',7,sizeof(mousevar_t)));
+}
+
+Begin
+ MOUSE_SETVARS:=FpIoctl(fd,nr_MOUSE_SETVARS,@param1)=0;
+end;
+
+Function MOUSE_READSTATE(fd:longint;var param1 : mousedata_t):boolean;
+{IOWR('M',8,sizeof(mousedata_t)));
+}
+
+Begin
+ MOUSE_READSTATE:=FpIoctl(fd,nr_MOUSE_READSTATE,@param1)=0;
+end;
+
+Function MOUSE_READDATA(fd:longint;var param1 : mousedata_t):boolean;
+{IOWR('M',9,sizeof(mousedata_t)));
+}
+
+Begin
+ MOUSE_READDATA:=FpIoctl(fd,nr_MOUSE_READDATA,@param1)=0;
+end;
+
+Function MOUSE_SETRESOLUTION(fd:longint;var param1 : longint):boolean;
+{IOW('M',10,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETRESOLUTION:=FpIoctl(fd,nr_MOUSE_SETRESOLUTION,@param1)=0;
+end;
+
+Function MOUSE_SETSCALING(fd:longint;var param1 : longint):boolean;
+{IOW('M',11,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETSCALING:=FpIoctl(fd,nr_MOUSE_SETSCALING,@param1)=0;
+end;
+
+Function MOUSE_SETRATE(fd:longint;var param1 : longint):boolean;
+{IOW('M',12,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETRATE:=FpIoctl(fd,nr_MOUSE_SETRATE,@param1)=0;
+end;
+
+Function MOUSE_GETHWID(fd:longint;var param1 : longint):boolean;
+{IOR('M',13,sizeof(int)));
+}
+
+Begin
+ MOUSE_GETHWID:=FpIoctl(fd,nr_MOUSE_GETHWID,@param1)=0;
+end;
+
+
+end.
diff --git a/rtl/darwin/errno.inc b/rtl/darwin/errno.inc
new file mode 100644
index 0000000000..b8a8328cc9
--- /dev/null
+++ b/rtl/darwin/errno.inc
@@ -0,0 +1,289 @@
+ {
+ $Id: errno.inc,v 1.4 2005/02/14 17:13:21 peter Exp $
+
+ Copyright (c) 2000 Apple Computer, Inc. All rights reserved.
+
+ @APPLE_LICENSE_HEADER_START@
+
+ The contents of this file constitute Original Code as defined in and
+ are subject to the Apple Public Source License Version 1.1 (the
+ "License"). You may not use this file except in compliance with the
+ License. Please obtain a copy of the License at
+ http://www.apple.com/publicsource and read it before using this file.
+
+ This Original Code and all software distributed under the License are
+ distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
+ INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ @APPLE_LICENSE_HEADER_END@
+ }
+ { Copyright (c) 1995 NeXT Computer, Inc. All Rights Reserved }
+ {
+ Copyright (c) 1982, 1986, 1989, 1993
+ The Regents of the University of California. All rights reserved.
+ (c) UNIX System Laboratories, Inc.
+ All or some portions of this file are derived from material licensed
+ to the University of California by American Telephone and Telegraph
+ Co. or Unix System Laboratories, Inc. and are reproduced herein with
+ the permission of UNIX System Laboratories, Inc.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. All advertising materials mentioning features or use of this software
+ must display the following acknowledgement:
+ This product includes software developed by the University of
+ California, Berkeley and its contributors.
+ 4. Neither the name of the University nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+
+ @(#)errno.h 8.5 (Berkeley) 1/21/94
+ }
+
+ const
+ { Operation not permitted }
+ ESysEPERM = 1;
+ { No such file or directory }
+ ESysENOENT = 2;
+ { No such process }
+ ESysESRCH = 3;
+ { Interrupted system call }
+ ESysEINTR = 4;
+ { Input/output error }
+ ESysEIO = 5;
+ { Device not configured }
+ ESysENXIO = 6;
+ { Argument list too long }
+ ESysE2BIG = 7;
+ { Exec format error }
+ ESysENOEXEC = 8;
+ { Bad file descriptor }
+ ESysEBADF = 9;
+ { No child processes }
+ ESysECHILD = 10;
+ { Resource deadlock avoided }
+ ESysEDEADLK = 11;
+ { 11 was EAGAIN }
+ { Cannot allocate memory }
+ ESysENOMEM = 12;
+ { Permission denied }
+ ESysEACCES = 13;
+ { Bad address }
+ ESysEFAULT = 14;
+{$ifndef _POSIX_SOURCE}
+ { Block device required }
+ ESysENOTBLK = 15;
+{$endif}
+ { Device busy }
+ ESysEBUSY = 16;
+ { File exists }
+ ESysEEXIST = 17;
+ { Cross-device link }
+ ESysEXDEV = 18;
+ { Operation not supported by device }
+ ESysENODEV = 19;
+ { Not a directory }
+ ESysENOTDIR = 20;
+ { Is a directory }
+ ESysEISDIR = 21;
+ { Invalid argument }
+ ESysEINVAL = 22;
+ { Too many open files in system }
+ ESysENFILE = 23;
+ { Too many open files }
+ ESysEMFILE = 24;
+ { Inappropriate ioctl for device }
+ ESysENOTTY = 25;
+{$ifndef _POSIX_SOURCE}
+ { Text file busy. The new process was a pure procedure (shared text) file
+ which was open for writing by another process, or file which was open for
+ writing by another process, or while the pure procedure file was being
+ executed an open(2) call requested write access requested write access.}
+ ESysETXTBSY = 26;
+{$endif}
+ { File too large }
+ ESysEFBIG = 27;
+ { No space left on device }
+ ESysENOSPC = 28;
+ { Illegal seek }
+ ESysESPIPE = 29;
+ { Read-only file system }
+ ESysEROFS = 30;
+ { Too many links }
+ ESysEMLINK = 31;
+ { Broken pipe }
+ ESysEPIPE = 32;
+ { math software }
+ { Numerical argument out of domain }
+ ESysEDOM = 33;
+ { Result too large }
+ ESysERANGE = 34;
+ { non-blocking and interrupt i/o }
+ { Resource temporarily unavailable }
+ ESysEAGAIN = 35;
+{$ifndef _POSIX_SOURCE}
+ { Operation would block }
+ ESysEWOULDBLOCK = ESysEAGAIN;
+ { Operation now in progress }
+ ESysEINPROGRESS = 36;
+ { Operation already in progress }
+ ESysEALREADY = 37;
+ { ipc/network software -- argument errors }
+ { Socket operation on non-socket }
+ ESysENOTSOCK = 38;
+ { Destination address required }
+ ESysEDESTADDRREQ = 39;
+ { Message too long }
+ ESysEMSGSIZE = 40;
+ { Protocol wrong type for socket }
+ ESysEPROTOTYPE = 41;
+ { Protocol not available }
+ ESysENOPROTOOPT = 42;
+ { Protocol not supported }
+ ESysEPROTONOSUPPORT = 43;
+ { Socket type not supported }
+ ESysESOCKTNOSUPPORT = 44;
+{$endif}
+ { ! _POSIX_SOURCE }
+ { Operation not supported }
+ ESysENOTSUP = 45;
+{$ifndef _POSIX_SOURCE}
+ { Operation not supported }
+ ESysEOPNOTSUPP = ESysENOTSUP;
+ { Protocol family not supported }
+ ESysEPFNOSUPPORT = 46;
+ { Address family not supported by protocol family }
+ ESysEAFNOSUPPORT = 47;
+ { Address already in use }
+ ESysEADDRINUSE = 48;
+ { Can't assign requested address }
+ ESysEADDRNOTAVAIL = 49;
+ { ipc/network software -- operational errors }
+ { Network is down }
+ ESysENETDOWN = 50;
+ { Network is unreachable }
+ ESysENETUNREACH = 51;
+ { Network dropped connection on reset }
+ ESysENETRESET = 52;
+ { Software caused connection abort }
+ ESysECONNABORTED = 53;
+ { Connection reset by peer }
+ ESysECONNRESET = 54;
+ { No buffer space available }
+ ESysENOBUFS = 55;
+ { Socket is already connected }
+ ESysEISCONN = 56;
+ { Socket is not connected }
+ ESysENOTCONN = 57;
+ { Can't send after socket shutdown }
+ ESysESHUTDOWN = 58;
+ { Too many references: can't splice }
+ ESysETOOMANYREFS = 59;
+ { Operation timed out }
+ ESysETIMEDOUT = 60;
+ { Connection refused }
+ ESysECONNREFUSED = 61;
+ { Too many levels of symbolic links }
+ ESysELOOP = 62;
+{$endif}
+ { _POSIX_SOURCE }
+ { File name too long }
+ ESysENAMETOOLONG = 63;
+ { should be rearranged }
+{$ifndef _POSIX_SOURCE}
+ { Host is down }
+ ESysEHOSTDOWN = 64;
+ { No route to host }
+ ESysEHOSTUNREACH = 65;
+{$endif}
+ { _POSIX_SOURCE }
+ { Directory not empty }
+ ESysENOTEMPTY = 66;
+ { quotas & mush }
+{$ifndef _POSIX_SOURCE}
+ { Too many processes }
+ ESysEPROCLIM = 67;
+ { Too many users }
+ ESysEUSERS = 68;
+ { Disc quota exceeded }
+ ESysEDQUOT = 69;
+ { Network File System }
+ { Stale NFS file handle }
+ ESysESTALE = 70;
+ { Too many levels of remote in path }
+ ESysEREMOTE = 71;
+ { RPC struct is bad }
+ ESysEBADRPC = 72;
+ { RPC version wrong }
+ ESysERPCMISMATCH = 73;
+ { RPC prog. not avail }
+ ESysEPROGUNAVAIL = 74;
+ { Program version wrong }
+ ESysEPROGMISMATCH = 75;
+ { Bad procedure for program }
+ ESysEPROCUNAVAIL = 76;
+{$endif}
+ { _POSIX_SOURCE }
+ { No locks available }
+ ESysENOLCK = 77;
+ { Function not implemented }
+ ESysENOSYS = 78;
+{$ifndef _POSIX_SOURCE}
+ { Inappropriate file type or format }
+ ESysEFTYPE = 79;
+ { Authentication error }
+ ESysEAUTH = 80;
+ { Need authenticator }
+ ESysENEEDAUTH = 81;
+{$endif}
+ { _POSIX_SOURCE }
+ { Intelligent device errors }
+ { Device power is off }
+ ESysEPWROFF = 82;
+ { Device error, e.g. paper out }
+ ESysEDEVERR = 83;
+{$ifndef _POSIX_SOURCE}
+ { Value too large to be stored in data type }
+ ESysEOVERFLOW = 84;
+ { Program loading errors }
+ { Bad executable }
+ ESysEBADEXEC = 85;
+ { Bad CPU type in executable }
+ ESysEBADARCH = 86;
+ { Shared library version mismatch }
+ ESysESHLIBVERS = 87;
+ { Malformed Macho file }
+ ESysEBADMACHO = 88;
+ { Must be equal largest errno }
+ ESysELAST = 88;
+{$endif}
+ { _POSIX_SOURCE }
+
+{
+ $Log: errno.inc,v $
+ Revision 1.4 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/powerpc/sig_cpu.inc b/rtl/darwin/powerpc/sig_cpu.inc
new file mode 100644
index 0000000000..a75218a77f
--- /dev/null
+++ b/rtl/darwin/powerpc/sig_cpu.inc
@@ -0,0 +1,274 @@
+ {
+ $Id: sig_cpu.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ Copyright (c) 2000 Apple Computer, Inc. All rights reserved.
+
+ @APPLE_LICENSE_HEADER_START@
+
+ The contents of this file constitute Original Code as defined in and
+ are subject to the Apple Public Source License Version 1.1 (the
+ "License"). You may not use this file except in compliance with the
+ License. Please obtain a copy of the License at
+ http://www.apple.com/publicsource and read it before using this file.
+
+ This Original Code and all software distributed under the License are
+ distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
+ INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ @APPLE_LICENSE_HEADER_END@
+ }
+ {
+ Copyright (c) 1992, 1993 NeXT Computer, Inc.
+
+ HISTORY
+
+ Machine specific signal information.
+
+ HISTORY
+ 25-MAR-97 Umesh Vaishampayan (umeshv@NeXT.com)
+ Ported from m98k and hppa.
+
+ 13-Jan-92 Peter King (king) at NeXT Computer, Inc.
+ Filled out struct sigcontext to hold all registers.
+ Added regs_saved_t to specify which regs stored in the
+ sigcontext are valid.
+
+ 09-Nov-92 Ben Fathi (benf) at NeXT, Inc.
+ Ported to m98k.
+
+ 09-May-91 Mike DeMoney (mike) at NeXT, Inc.
+ Ported to m88k.
+ }
+
+{$packrecords C}
+
+ const
+ _PPC_SIGNAL_ = 1;
+
+ type
+
+ sig_atomic_t = longint;
+ {
+ Machine-dependant flags used in sigvec call.
+ }
+ { Save all regs in sigcontext }
+
+ const
+ SV_SAVE_REGS = $1000;
+ {
+ regs_saved_t -- Describes which registers beyond what the kernel cares
+ about are saved to and restored from this sigcontext.
+
+ The default is REGS_SAVED_CALLER, only the caller saved registers
+ are saved. If the SV_SAVE_REGS flag was set when the signal
+ handler was registered with sigvec() then all the registers will be
+ saved in the sigcontext, and REGS_SAVED_ALL will be set. The C
+ library uses REGS_SAVED_NONE in order to quickly restore kernel
+ state during a longjmp().
+ }
+ { Only kernel managed regs restored }
+ { "Caller saved" regs: rpc, a0-a7,
+ t0-t4, at, lk0-lk1, xt1-xt20,
+ xr0-xr1 }
+ { All registers }
+
+ type
+
+ { Structure used in sigstack call. }
+ tdarwin_stack_t = record
+ ss_sp : pchar; { signal stack base }
+ ss_size : cint; { signal stack length }
+ ss_flags : cint; { SA_DISABLE and/or SA_ONSTACK }
+ end;
+
+ ppc_thread_state = record
+ { Instruction address register (PC) }
+ srr0 : dword;
+ { Machine state register (supervisor) }
+ srr1 : dword;
+ r0 : dword;
+ r1 : dword;
+ r2 : dword;
+ r3 : dword;
+ r4 : dword;
+ r5 : dword;
+ r6 : dword;
+ r7 : dword;
+ r8 : dword;
+ r9 : dword;
+ r10 : dword;
+ r11 : dword;
+ r12 : dword;
+ r13 : dword;
+ r14 : dword;
+ r15 : dword;
+ r16 : dword;
+ r17 : dword;
+ r18 : dword;
+ r19 : dword;
+ r20 : dword;
+ r21 : dword;
+ r22 : dword;
+ r23 : dword;
+ r24 : dword;
+ r25 : dword;
+ r26 : dword;
+ r27 : dword;
+ r28 : dword;
+ r29 : dword;
+ r30 : dword;
+ r31 : dword;
+ { Condition register }
+ cr : dword;
+ { User's integer exception register }
+ xer : dword;
+ { Link register }
+ lr : dword;
+ { Count register }
+ ctr : dword;
+ { MQ register (601 only) }
+ mq : dword;
+ { Vector Save Register }
+ vrsave : dword;
+ end;
+ ppc_thread_state_t = ppc_thread_state;
+
+{$packrecords 4}
+ ppc_thread_state64 = record
+ srr0 : qword;
+ srr1 : qword;
+ r0 : qword;
+ r1 : qword;
+ r2 : qword;
+ r3 : qword;
+ r4 : qword;
+ r5 : qword;
+ r6 : qword;
+ r7 : qword;
+ r8 : qword;
+ r9 : qword;
+ r10 : qword;
+ r11 : qword;
+ r12 : qword;
+ r13 : qword;
+ r14 : qword;
+ r15 : qword;
+ r16 : qword;
+ r17 : qword;
+ r18 : qword;
+ r19 : qword;
+ r20 : qword;
+ r21 : qword;
+ r22 : qword;
+ r23 : qword;
+ r24 : qword;
+ r25 : qword;
+ r26 : qword;
+ r27 : qword;
+ r28 : qword;
+ r29 : qword;
+ r30 : qword;
+ r31 : qword;
+ cr : dword;
+ xer : qword;
+ lr : qword;
+ ctr : qword;
+ vrsave : dword;
+ end;
+ ppc_thread_state64_t = ppc_thread_state64;
+
+{$packrecords C}
+
+ { This structure should be double-word aligned for performance }
+ type
+
+ ppc_float_state = record
+ fpregs : array[0..31] of double;
+ { fpscr is 64 bits, 32 bits of rubbish }
+ fpscr_pad : dword;
+ { floating point status register }
+ fpscr : dword;
+ end;
+ ppc_float_state_t = ppc_float_state;
+
+ { VRs that have been saved }
+ ppc_vector_state = record
+ save_vr : array[0..31] of array[0..3] of dword;
+ save_vscr : array[0..3] of dword;
+ save_pad5 : array[0..3] of dword;
+ save_vrvalid : dword;
+ save_pad6 : array[0..6] of dword;
+ end;
+ ppc_vector_state_t = ppc_vector_state;
+
+ {
+ ppc_exception_state
+
+ This structure corresponds to some additional state of the user
+ registers as saved in the PCB upon kernel entry. They are only
+ available if an exception is passed out of the kernel, and even
+ then not all are guaranteed to be updated.
+
+ Some padding is included in this structure which allows space for
+ servers to store temporary values if need be, to maintain binary
+ compatiblity.
+ }
+
+ type
+
+ ppc_exception_state = record
+ { Fault registers for coredump }
+ dar : dword;
+ dsisr : dword;
+ { number of powerpc exception taken }
+ exception : dword;
+ { align to 16 bytes }
+ pad0 : dword;
+ { space in PCB "just in case" }
+ pad1 : array[0..3] of dword;
+ end;
+ ppc_exception_state_t = ppc_exception_state;
+
+{$packrecords 4}
+
+ type
+
+ ppc_exception_state64 = record
+ { Fault registers for coredump }
+ dar : qword;
+ dsisr : dword;
+ { number of powerpc exception taken }
+ exception : dword;
+ { space in PCB "just in case" }
+ pad1 : array[0..3] of dword;
+ end;
+ ppc_exception_state64_t = ppc_exception_state64;
+
+{$packrecords C}
+
+ mcontext_t = record
+ es: ppc_exception_state_t;
+ ss: ppc_thread_state_t;
+ fs: ppc_float_state_t;
+ vs: ppc_vector_state_t;
+ end;
+
+ psigcontextrec = ^sigcontextrec;
+ sigcontextrec = record
+ uc_onstack : cint;
+ uc_sigmask : sigset_t; { signal mask used by this context }
+ uc_stack : tdarwin_stack_t; { stack used by this context }
+ uc_link : psigcontextrec; { pointer to resuming context }
+ uc_mcsize : size_t; { size of the machine context passed in }
+ uc_mcontext: ^mcontext_t; { machine specific context }
+ end;
+
+{
+ $Log: sig_cpu.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/powerpc/sighnd.inc b/rtl/darwin/powerpc/sighnd.inc
new file mode 100644
index 0000000000..ca87a7ef4e
--- /dev/null
+++ b/rtl/darwin/powerpc/sighnd.inc
@@ -0,0 +1,67 @@
+{
+ $Id: sighnd.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Signalhandler for FreeBSD/i386
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+procedure SignalToRunerror(Sig: cint; var info : tsiginfo_t;Var SigContext:SigContextRec); cdecl;
+
+var
+ res : word;
+
+begin
+ res:=0;
+ case sig of
+ SIGFPE :
+ begin
+ Case Info.si_code Of
+ FPE_INTDIV : Res:=200; {integer divide fault. Div0?}
+ FPE_FLTOVF : Res:=205; {Overflow trap}
+ FPE_FLTUND : Res:=206; {Stack over/underflow}
+ FPE_FLTRES : Res:=208; {Device not available}
+ FPE_FLTINV : Res:=207; {Invalid floating point operation}
+ Else
+ Res:=208; {coprocessor error}
+ end;
+ { FPU exceptions are completely disabled by the kernel if one occurred, it }
+ { seems this is necessary to be able to return to user mode. They can be }
+ { enabled by executing a sigreturn, however then the exception is triggered }
+ { triggered again immediately if we don't turn off the "exception occurred" }
+ { flags in fpscr }
+ SigContext.uc_mcontext^.fs.fpscr := SigContext.uc_mcontext^.fs.fpscr and not($fffe0700);
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ {$ifdef FPC_USE_SIGPROCMASK}
+ reenable_signal(sig);
+ {$endif }
+
+ { return to trampoline }
+ if res <> 0 then
+ begin
+ SigContext.uc_mcontext^.ss.r3 := res;
+ SigContext.uc_mcontext^.ss.r4 := SigContext.uc_mcontext^.ss.srr0;
+ SigContext.uc_mcontext^.ss.r5 := SigContext.uc_mcontext^.ss.r1;
+ pointer(SigContext.uc_mcontext^.ss.srr0) := @HandleErrorAddrFrame;
+ end;
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/pthread.inc b/rtl/darwin/pthread.inc
new file mode 100644
index 0000000000..36a6bccf39
--- /dev/null
+++ b/rtl/darwin/pthread.inc
@@ -0,0 +1,88 @@
+{
+ $Id: pthread.inc,v 1.8 2005/04/09 20:29:15 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains a pthread.h headerconversion,
+ and should contain an interface to the threading library to be
+ used by systhrd, preferably in a somewhat compatible notation
+ (compared to the other OSes).
+
+ As a start, I simply used libc_r
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+CONST PTHREAD_EXPLICIT_SCHED = 0;
+ PTHREAD_CREATE_DETACHED = 1;
+ PTHREAD_SCOPE_PROCESS = 0;
+
+ TYPE
+ ppthread_t = ^pthread_t;
+ ppthread_key_t = ^pthread_key_t;
+ ppthread_mutex_t = ^pthread_mutex_t;
+ ppthread_attr_t = ^pthread_attr_t;
+ __destr_func_t = procedure (p :pointer);cdecl;
+ __startroutine_t = function (p :pointer):pointer;cdecl;
+ ppthread_mutexattr_t = ^pthread_mutexattr_t;
+ ppthread_cond_t = ^pthread_cond_t;
+ ppthread_condattr_t = ^pthread_condattr_t;
+
+ sem_t = cint;
+ psem_t = ^sem_t;
+ TSemaphore = sem_t;
+ PSemaphore = ^TSemaphore;
+
+function pthread_getspecific (t : pthread_key_t):pointer; cdecl; external 'c';
+function pthread_setspecific (t : pthread_key_t;p:pointer):cint; cdecl; external 'c';
+function pthread_key_create (p : ppthread_key_t;f: __destr_func_t):cint; cdecl;external 'c';
+function pthread_attr_init (p : ppthread_key_t):cint; cdecl; external 'c';
+function pthread_attr_setinheritsched(p : ppthread_attr_t;i:cint):cint; cdecl; external 'c';
+function pthread_attr_setscope (p : ppthread_attr_t;i:cint):cint;cdecl;external 'c';
+function pthread_attr_setdetachstate (p : ppthread_attr_t;i:cint):cint;cdecl;external 'c';
+function pthread_create ( p: ppthread_t;attr : ppthread_attr_t;f:__startroutine_t;arg:pointer):cint;cdecl;external 'c';
+procedure pthread_exit ( p: pointer); cdecl;external 'c';
+function pthread_self:cint; cdecl;external 'c';
+function pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutexattr_t):cint; cdecl;external 'c';
+function pthread_mutex_destroy (p:ppthread_mutexattr_t):cint; cdecl;external 'c';
+function pthread_mutex_lock (p:ppthread_mutexattr_t):cint; cdecl;external 'c';
+function pthread_mutex_unlock (p:ppthread_mutexattr_t):cint; cdecl;external 'c';
+function pthread_cancel(_para1:pthread_t):cint;cdecl;external 'c';
+function pthread_detach(_para1:pthread_t):cint;cdecl;external 'c';
+function pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external 'c';
+function pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_destroy';
+function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external 'c' name 'pthread_cond_init';
+function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_signal';
+function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external 'c' name 'pthread_cond_wait';
+
+function sem_init(__sem:Psem_t; __pshared:cint;__value:cuint):cint;cdecl; external 'c' name 'sem_init';
+function sem_destroy(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_destroy';
+function sem_close(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_close';
+function sem_unlink(__name:Pchar):cint;cdecl;external 'c' name 'sem_unlink';
+function sem_wait(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_wait';
+function sem_trywait(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_trywait';
+function sem_post(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_post';
+function sem_getvalue(__sem:Psem_t; __sval:Pcint):cint;cdecl;external 'c' name 'sem_getvalue';
+
+function pthread_mutexattr_init(_para1:Ppthread_mutexattr_t):cint;cdecl;external 'c' name 'pthread_mutexattr_init';
+function pthread_mutexattr_destroy(_para1:Ppthread_mutexattr_t):cint;cdecl;external 'c' name 'pthread_mutexattr_destroy';
+function pthread_mutexattr_gettype(_para1:Ppthread_mutexattr_t; _para2:Pcint):cint;cdecl;external 'c' name 'pthread_mutexattr_gettype';
+function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cint;cdecl;external 'c' name 'pthread_mutexattr_settype';
+function pthread_cond_timedwait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):cint; cdecl;external 'c' name 'pthread_cond_timedwait';
+
+{
+ $Log: pthread.inc,v $
+ Revision 1.8 2005/04/09 20:29:15 marco
+ * added condtimedwait
+
+ Revision 1.7 2005/02/14 17:13:21 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/ptypes.inc b/rtl/darwin/ptypes.inc
new file mode 100644
index 0000000000..096d6caac4
--- /dev/null
+++ b/rtl/darwin/ptypes.inc
@@ -0,0 +1,184 @@
+{
+ $Id: ptypes.inc,v 1.11 2005/02/14 17:13:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+{$i ctypes.inc}
+{$packrecords c}
+
+type
+ { the following type definitions are compiler dependant }
+ { and system dependant }
+
+ dev_t = cuint32; { used for device numbers }
+ TDev = dev_t;
+ pDev = ^dev_t;
+
+ gid_t = cuint32; { used for group IDs }
+ TGid = gid_t;
+ pGid = ^gid_t;
+
+ ino_t = clong; { used for file serial numbers }
+ TIno = ino_t;
+ pIno = ^ino_t;
+
+ mode_t = cuint16; { used for file attributes }
+ TMode = mode_t;
+ pMode = ^mode_t;
+
+ nlink_t = cuint16; { used for link counts }
+ TnLink = nlink_t;
+ pnLink = ^nlink_t;
+
+ off_t = cint64; { used for file sizes }
+ TOff = off_t;
+ pOff = ^off_t;
+
+ pid_t = cint32; { used as process identifier }
+ TPid = pid_t;
+ pPid = ^pid_t;
+
+ size_t = cuint32; { as definied in the C standard}
+ TSize = size_t;
+ pSize = ^size_t;
+
+ ssize_t = cint32; { used by function for returning number of bytes }
+ TsSize = ssize_t;
+ psSize = ^ssize_t;
+
+ uid_t = cuint32; { used for user ID type }
+ TUid = Uid_t;
+ pUid = ^Uid_t;
+
+ clock_t = culong;
+ TClock = clock_t;
+ pClock = ^clock_t;
+
+ time_t = clong; { used for returning the time }
+ TTime = time_t;
+ pTime = ^time_t;
+ ptime_t = ^time_t;
+
+ socklen_t= cuint32;
+ TSocklen = socklen_t;
+ pSocklen = ^socklen_t;
+
+ timeval = record
+ tv_sec: cint;
+ tv_usec: cint;
+ end;
+ ptimeval = ^timeval;
+ TTimeVal = timeval;
+
+ timespec = packed record
+ tv_sec : time_t;
+ tv_nsec : clong;
+ end;
+ ptimespec= ^timespec;
+ Ttimespec= timespec;
+
+
+
+CONST
+ { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+ ARG_MAX = 65536; {4096} { Maximum number of argument size }
+ NAME_MAX = 255; {14} { Maximum number of bytes in filename }
+ PATH_MAX = 1024; {255} { Maximum number of bytes in pathname }
+
+ SYS_NMLN = 256; {BSD utsname struct limit}
+
+ SIG_MAXSIG = 32; // highest signal version
+
+ MFSNAMELEN = 15;
+ MNAMELEN = 90;
+
+
+type
+ pthread_mutextype = (
+ _PTHREAD_MUTEX_NORMAL := 0,
+ _PTHREAD_MUTEX_ERRORCHECK := 1,
+ _PTHREAD_MUTEX_RECURSIVE := 2
+ );
+
+
+ const
+ _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_NORMAL;
+ _MUTEX_TYPE_FAST = _PTHREAD_MUTEX_NORMAL;
+ _MUTEX_TYPE_COUNTING_FAST = _PTHREAD_MUTEX_RECURSIVE;
+
+ _PTHREAD_KEYS_MAX = 128;
+ _PTHREAD_STACK_MIN = 8192;
+
+ type
+ fsid_t = record
+ val: array[0..1] of cint32;
+ end;
+
+ tstatfs = record
+ otype : cint16;
+ oflags : cint16;
+ bsize : cint32;
+ iosize : cint32;
+ blocks : cint32;
+ bfree : cint32;
+ bavail : cint32;
+ files : cint32;
+ ffree : cint32;
+ fsid : fsid_t;
+ fowner : uid_t;
+ reserved1 : cint16;
+ ftype : cint16;
+ fflags : cint32;
+ reserved2 : array[0..1] of cint32;
+ fstypename : array[0..(MFSNAMELEN)-1] of char;
+ mountpoint : array[0..(MNAMELEN)-1] of char;
+ mntfromname : array[0..(MNAMELEN)-1] of char;
+ end;
+ pstatfs = ^tstatfs;
+
+ pthread_t = pointer;
+ pthread_attr_t = record sig: clong; opaque: array[0..36-1] of byte; end;
+ pthread_mutex_t = record sig: clong; opaque: array[0..40-1] of byte; end;
+ pthread_mutexattr_t = record sig: clong; opaque: array[0..8-1] of byte; end;
+ pthread_cond_t = record sig: clong; opaque: array[0..24-1] of byte; end;
+ pthread_condattr_t = record sig: clong; opaque: array[0..4-1] of byte; end;
+ pthread_key_t = clong;
+ pthread_rwlock_t = record sig: clong; opaque: array[0..124-1] of byte; end;
+ pthread_rwlockattr_t = record sig: clong; opaque: array[0..12-1] of byte; end;
+
+ sem_t = cint;
+
+// for get/setpriority
+Const
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+
+{
+ $Log: ptypes.inc,v $
+ Revision 1.11 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.10 2005/02/11 13:07:05 jonas
+ * fixed SYS_NMLN constant
+
+}
diff --git a/rtl/darwin/signal.inc b/rtl/darwin/signal.inc
new file mode 100644
index 0000000000..66fc92875d
--- /dev/null
+++ b/rtl/darwin/signal.inc
@@ -0,0 +1,282 @@
+{$PACKRECORDS C}
+
+ {
+ $Id: signal.inc,v 1.7 2005/02/14 17:13:21 peter Exp $
+ Copyright (c) 2000 Apple Computer, Inc. All rights reserved.
+
+ @APPLE_LICENSE_HEADER_START@
+
+ The contents of this file constitute Original Code as defined in and
+ are subject to the Apple Public Source License Version 1.1 (the
+ "License"). You may not use this file except in compliance with the
+ License. Please obtain a copy of the License at
+ http://www.apple.com/publicsource and read it before using this file.
+
+ This Original Code and all software distributed under the License are
+ distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
+ INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ @APPLE_LICENSE_HEADER_END@
+ }
+ { Copyright (c) 1995 NeXT Computer, Inc. All Rights Reserved }
+ {
+ Copyright (c) 1982, 1986, 1989, 1991, 1993
+ The Regents of the University of California. All rights reserved.
+ (c) UNIX System Laboratories, Inc.
+ All or some portions of this file are derived from material licensed
+ to the University of California by American Telephone and Telegraph
+ Co. or Unix System Laboratories, Inc. and are reproduced herein with
+ the permission of UNIX System Laboratories, Inc.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. All advertising materials mentioning features or use of this software
+ must display the following acknowledgement:
+ This product includes software developed by the University of
+ California, Berkeley and its contributors.
+ 4. Neither the name of the University nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+
+ @(#)signal.h 8.2 (Berkeley) 1/21/94
+ }
+
+ const
+ SA_NOCLDSTOP = 8;
+ SA_ONSTACK = $001; { take signal on signal stack }
+ SA_RESTART = $002; { restart system call on signal return }
+ SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
+ SA_NODEFER = $010; { don't mask the signal we're delivering }
+ SA_NOCLDWAIT = $020; { don't keep zombies around }
+ SA_SIGINFO = $040; { signal handler with SA_SIGINFO args }
+ SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
+
+ { hangup }
+ SIGHUP = 1;
+ { interrupt }
+ SIGINT = 2;
+ { quit }
+ SIGQUIT = 3;
+ { illegal instruction (not reset when caught) }
+ SIGILL = 4;
+ { trace trap (not reset when caught) }
+ SIGTRAP = 5;
+ { abort() }
+ SIGABRT = 6;
+ { compatibility }
+ SIGIOT = SIGABRT;
+ { EMT instruction }
+ SIGEMT = 7;
+ { floating point exception }
+ SIGFPE = 8;
+ { kill (cannot be caught or ignored) }
+ SIGKILL = 9;
+ { bus error }
+ SIGBUS = 10;
+ { segmentation violation }
+ SIGSEGV = 11;
+ { bad argument to system call }
+ SIGSYS = 12;
+ { write on a pipe with no one to read it }
+ SIGPIPE = 13;
+ { alarm clock }
+ SIGALRM = 14;
+ { software termination signal from kill }
+ SIGTERM = 15;
+ { urgent condition on IO channel }
+ SIGURG = 16;
+ { sendable stop signal not from tty }
+ SIGSTOP = 17;
+ { stop signal from tty }
+ SIGTSTP = 18;
+ { continue a stopped process }
+ SIGCONT = 19;
+ { to parent on child stop or exit }
+ SIGCHLD = 20;
+ { to readers pgrp upon background tty read }
+ SIGTTIN = 21;
+ { like TTIN for output if (tp->t_local&LTOSTOP) }
+ SIGTTOU = 22;
+ { input/output possible signal }
+ SIGIO = 23;
+ { exceeded CPU time limit }
+ SIGXCPU = 24;
+ { exceeded file size limit }
+ SIGXFSZ = 25;
+ { virtual time alarm }
+ SIGVTALRM = 26;
+ { profiling time alarm }
+ SIGPROF = 27;
+ { window size changes }
+ SIGWINCH = 28;
+ { information request }
+ SIGINFO = 29;
+ { user defined signal 1 }
+ SIGUSR1 = 30;
+ { user defined signal 2 }
+ SIGUSR2 = 31;
+ SIG_DFL = 0;
+ SIG_IGN = 1;
+ SIG_ERR = -1;
+
+ type
+ sigset_t = array[0..0] of cuint;
+
+ Sigval = Record
+ Case Boolean OF
+ { Members as suggested by Annex C of POSIX 1003.1b. }
+ false : (sigval_int : cint);
+ True : (sigval_ptr : Pointer);
+ End;
+
+ TSigInfo_t = record
+ si_signo, { signal number }
+ si_errno, { errno association }
+ {
+ * Cause of signal, one of the SI_ macros or signal-specific
+ * values, i.e. one of the FPE_... values for SIGFPE. This
+ * value is equivalent to the second argument to an old-style
+ * FreeBSD signal handler.
+ }
+ si_code, { signal code }
+ si_pid : cint; { sending process }
+ si_uid : cuint; { sender's ruid }
+ si_status : cint; { exit value }
+ si_addr : Pointer; { faulting instruction }
+ si_value : SigVal; { signal value }
+ si_band : cuint; { band event for SIGPOLL }
+ pad : array[0..6] of cint; { Reserved for Future Use }
+ end;
+
+ TSigset=sigset_t;
+ Sigset=sigset_t;
+ PSigSet = ^TSigSet;
+
+{$ifdef cpupowerpc}
+ {$include powerpc/sig_cpu.inc} { SigContextRec }
+{$else cpupowerpc}
+{$ifdef cpui386}
+ {$include i386/sig_cpu.inc} { SigContextRec }
+{$else cpui386}
+ {$error Unsupported cpu type!}
+{$endif cpui386}
+{$endif cpupowerpc}
+
+
+
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+ SigActionHandler = procedure (Sig: cint; var info : tsiginfo_t;Var SigContext:SigContextRec); cdecl;
+
+
+ SigActionRec = packed record
+{
+ case byte of
+ 0: (Sh: SignalHandler; Sa_Flags: longint; Sa_Mask: SigSet);
+ 1: (sa_handler: TSigAction);
+}
+ Sa_Handler: SigActionHandler;
+ Sa_Mask: sigset_t;
+ Sa_Flags: cint;
+ end;
+ PSigActionRec = ^SigActionRec;
+
+ {
+ Flags for sigprocmask:
+ }
+const
+ { block specified signal set }
+ SIG_BLOCK = 1;
+ { unblock specified signal set }
+ SIG_UNBLOCK = 2;
+ { set specified signal set }
+ SIG_SETMASK = 3;
+ { type of signal function }
+ {
+ Structure used in sigaltstack call.
+ }
+
+ type
+ sigaltstack = record
+ { signal stack base }
+ ss_sp : ^char;
+ { signal stack length }
+ ss_size : longint;
+ { SA_DISABLE and/or SA_ONSTACK }
+ ss_flags : longint;
+ end;
+
+ { minimum allowable stack }
+
+ const
+ MINSIGSTKSZ = 8192;
+ { recommended stack size }
+ { already defined in another BSD include file }
+// SIGSTKSZ = MINSIGSTKSZ + 32768;
+ {
+ 4.3 compatibility:
+ Signal vector "template" used in sigvec call.
+ }
+
+ type
+ sigvec = record
+ { signal handler }
+ sv_handler : procedure ;
+ { signal mask to apply }
+ sv_mask : longint;
+ { see signal options below }
+ sv_flags : longint;
+ end;
+
+
+ const
+ SV_ONSTACK = SA_ONSTACK;
+ { same bit, opposite sense }
+ SV_INTERRUPT = SA_RESTART;
+
+{ Codes for SIGFPE }
+ FPE_NOOP = 0; { if only I knew... }
+ FPE_FLTDIV = 1; { floating point divide by zero }
+ FPE_INTDIV = FPE_FLTDIV;
+ FPE_FLTOVF = 2; { floating point overflow }
+ FPE_FLTUND = 3; { floating point underflow }
+ FPE_FLTRES = 4; { floating point inexact result }
+ FPE_FLTINV = 5; { invalid floating point operation }
+
+
+
+{
+ $Log: signal.inc,v $
+ Revision 1.7 2005/02/14 17:13:21 peter
+ * truncate log
+
+ Revision 1.6 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/darwin/sysctlh.inc b/rtl/darwin/sysctlh.inc
new file mode 100644
index 0000000000..1c94fd934d
--- /dev/null
+++ b/rtl/darwin/sysctlh.inc
@@ -0,0 +1,541 @@
+{
+ $Id: sysctlh.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+}
+
+{$PACKRECORDS C}
+
+ {
+ Copyright (c) 2000-2003 Apple Computer, Inc. All rights reserved.
+
+ @APPLE_LICENSE_HEADER_START@
+
+ The contents of this file constitute Original Code as defined in and
+ are subject to the Apple Public Source License Version 1.1 (the
+ "License"). You may not use this file except in compliance with the
+ License. Please obtain a copy of the License at
+ http://www.apple.com/publicsource and read it before using this file.
+
+ This Original Code and all software distributed under the License are
+ distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
+ INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ @APPLE_LICENSE_HEADER_END@
+ }
+ { Copyright (c) 1995 NeXT Computer, Inc. All Rights Reserved }
+ {
+ Copyright (c) 1989, 1993
+ The Regents of the University of California. All rights reserved.
+
+ This code is derived from software contributed to Berkeley by
+ Mike Karels at Berkeley Software Design, Inc.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. All advertising materials mentioning features or use of this software
+ must display the following acknowledgement:
+ This product includes software developed by the University of
+ California, Berkeley and its contributors.
+ 4. Neither the name of the University nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+
+ @(#)sysctl.h 8.1 (Berkeley) 6/2/93
+ }
+ {
+ These are for the eproc structure defined below.
+ }
+ {
+ Definitions for sysctl call. The sysctl call uses a hierarchical name
+ for objects that can be examined or modified. The name is expressed as
+ a sequence of integers. Like a file path name, the meaning of each
+ component depends on its place in the hierarchy. The top-level and kern
+ identifiers are defined here, and other identifiers are defined in the
+ respective subsystem header files.
+ }
+ { largest number of components supported }
+
+ const
+ CTL_MAXNAME = 12;
+ {
+ Each subsystem defined by sysctl defines a list of variables
+ for that subsystem. Each name is either a node with further
+ levels defined below it, or it is a leaf of some particular
+ type given below. Each sysctl level defines a set of name/type
+ pairs to be used by sysctl(1) in manipulating the subsystem.
+ }
+ { subsystem name }
+ { type of name }
+
+ type
+ ctlname = record
+ ctl_name : ^char;
+ ctl_type : longint;
+ end;
+
+ { Mask for the type }
+
+ const
+ CTLTYPE = $f;
+ { name is a node }
+ CTLTYPE_NODE = 1;
+ { name describes an integer }
+ CTLTYPE_INT = 2;
+ { name describes a string }
+ CTLTYPE_STRING = 3;
+ { name describes a 64-bit number }
+ CTLTYPE_QUAD = 4;
+ { name describes a structure }
+ CTLTYPE_OPAQUE = 5;
+ { name describes a structure }
+ CTLTYPE_STRUCT = CTLTYPE_OPAQUE;
+ { Allow reads of variable }
+ CTLFLAG_RD = $80000000;
+ { Allow writes to the variable }
+ CTLFLAG_WR = $40000000;
+ CTLFLAG_RW = CTLFLAG_RD or CTLFLAG_WR;
+ { XXX Don't Lock }
+ CTLFLAG_NOLOCK = $20000000;
+ { All users can set this var }
+ CTLFLAG_ANYBODY = $10000000;
+ { Permit set only if securelevel<=0 }
+ CTLFLAG_SECURE = $08000000;
+ { deprecated variable, do not display }
+ CTLFLAG_MASKED = $04000000;
+ { do not auto-register }
+ CTLFLAG_NOAUTO = $02000000;
+ { valid inside the kernel }
+ CTLFLAG_KERN = $01000000;
+ {
+ USE THIS instead of a hardwired number from the categories below
+ to get dynamically assigned sysctl entries using the linker-set
+ technology. This is the way nearly all new sysctl variables should
+ be implemented.
+ e.g. SYSCTL_INT(_parent, OID_AUTO, name, CTLFLAG_RW, &variable, 0, "");
+ }
+ OID_AUTO = -(1);
+ {
+ Top-level identifiers
+ }
+ { unused }
+ CTL_UNSPEC = 0;
+ { "high kernel": proc, limits }
+ CTL_KERN = 1;
+ { virtual memory }
+ CTL_VM = 2;
+ { file system, mount type is next }
+ CTL_VFS = 3;
+ { network, see socket.h }
+ CTL_NET = 4;
+ { debugging parameters }
+ CTL_DEBUG = 5;
+ { generic cpu/io }
+ CTL_HW = 6;
+ { machine dependent }
+ CTL_MACHDEP = 7;
+ { user-level }
+ CTL_USER = 8;
+ { number of valid top-level ids }
+ CTL_MAXID = 9;
+ {
+ CTL_KERN identifiers
+ }
+ { string: system version }
+ KERN_OSTYPE = 1;
+ { string: system release }
+ KERN_OSRELEASE = 2;
+ { int: system revision }
+ KERN_OSREV = 3;
+ { string: compile time info }
+ KERN_VERSION = 4;
+ { int: max vnodes }
+ KERN_MAXVNODES = 5;
+ { int: max processes }
+ KERN_MAXPROC = 6;
+ { int: max open files }
+ KERN_MAXFILES = 7;
+ { int: max arguments to exec }
+ KERN_ARGMAX = 8;
+ { int: system security level }
+ KERN_SECURELVL = 9;
+ { string: hostname }
+ KERN_HOSTNAME = 10;
+ { int: host identifier }
+ KERN_HOSTID = 11;
+ { struct: struct clockrate }
+ KERN_CLOCKRATE = 12;
+ { struct: vnode structures }
+ KERN_VNODE = 13;
+ { struct: process entries }
+ KERN_PROC = 14;
+ { struct: file entries }
+ KERN_FILE = 15;
+ { node: kernel profiling info }
+ KERN_PROF = 16;
+ { int: POSIX.1 version }
+ KERN_POSIX1 = 17;
+ { int: # of supplemental group ids }
+ KERN_NGROUPS = 18;
+ { int: is job control available }
+ KERN_JOB_CONTROL = 19;
+ { int: saved set-user/group-ID }
+ KERN_SAVED_IDS = 20;
+ { struct: time kernel was booted }
+ KERN_BOOTTIME = 21;
+ { string: YP domain name }
+ KERN_NISDOMAINNAME = 22;
+ KERN_DOMAINNAME = KERN_NISDOMAINNAME;
+ { int: number of partitions/disk }
+ KERN_MAXPARTITIONS = 23;
+ { int: kernel trace points }
+ KERN_KDEBUG = 24;
+ { int: update process sleep time }
+ KERN_UPDATEINTERVAL = 25;
+ { int: OS release date }
+ KERN_OSRELDATE = 26;
+ { node: NTP PLL control }
+ KERN_NTP_PLL = 27;
+ { string: name of booted kernel }
+ KERN_BOOTFILE = 28;
+ { int: max open files per proc }
+ KERN_MAXFILESPERPROC = 29;
+ { int: max processes per uid }
+ KERN_MAXPROCPERUID = 30;
+ { dev_t: device to dump on }
+ KERN_DUMPDEV = 31;
+ { node: anything related to IPC }
+ KERN_IPC = 32;
+ { unused }
+ KERN_DUMMY = 33;
+ { int: address of PS_STRINGS }
+ KERN_PS_STRINGS = 34;
+ { int: address of USRSTACK }
+ KERN_USRSTACK = 35;
+ { int: do we log sigexit procs? }
+ KERN_LOGSIGEXIT = 36;
+ { string: kernel symbol filename }
+ KERN_SYMFILE = 37;
+ KERN_PROCARGS = 38;
+ { node: pc sampling }
+ KERN_PCSAMPLES = 39;
+ { int: are we netbooted? 1=yes,0=no }
+ KERN_NETBOOT = 40;
+ { node: panic UI information }
+ KERN_PANICINFO = 41;
+ { node: panic UI information }
+ KERN_SYSV = 42;
+ { xxx }
+ KERN_AFFINITY = 43;
+ { xxx }
+ KERN_CLASSIC = 44;
+ { xxx }
+ KERN_CLASSICHANDLER = 45;
+ { int: max aio requests }
+ KERN_AIOMAX = 46;
+ { int: max aio requests per process }
+ KERN_AIOPROCMAX = 47;
+ { int: max aio worker threads }
+ KERN_AIOTHREADS = 48;
+ { __APPLE_API_UNSTABLE }
+ { number of valid kern ids }
+
+ const
+ KERN_MAXID = 50;
+ { KERN_KDEBUG types }
+ KERN_KDEFLAGS = 1;
+ KERN_KDDFLAGS = 2;
+ KERN_KDENABLE = 3;
+ KERN_KDSETBUF = 4;
+ KERN_KDGETBUF = 5;
+ KERN_KDSETUP = 6;
+ KERN_KDREMOVE = 7;
+ KERN_KDSETREG = 8;
+ KERN_KDGETREG = 9;
+ KERN_KDREADTR = 10;
+ KERN_KDPIDTR = 11;
+ KERN_KDTHRMAP = 12;
+ { Don't use 13 as it is overloaded with KERN_VNODE }
+ KERN_KDPIDEX = 14;
+ KERN_KDSETRTCDEC = 15;
+ KERN_KDGETENTROPY = 16;
+ { KERN_PCSAMPLES types }
+ KERN_PCDISABLE = 1;
+ KERN_PCSETBUF = 2;
+ KERN_PCGETBUF = 3;
+ KERN_PCSETUP = 4;
+ KERN_PCREMOVE = 5;
+ KERN_PCREADBUF = 6;
+ KERN_PCSETREG = 7;
+ KERN_PCCOMM = 8;
+ { KERN_PANICINFO types }
+ { quad: panic UI image size limit }
+ KERN_PANICINFO_MAXSIZE = 1;
+ { string: path to the panic UI (16 bit) }
+ KERN_PANICINFO_IMAGE16 = 2;
+ { string: path to the panic UI (32 bit) }
+ KERN_PANICINFO_IMAGE32 = 3;
+ {
+ KERN_SYSV identifiers
+ }
+ { int: max shared memory segment size (bytes) }
+ KSYSV_SHMMAX = 1;
+ { int: min shared memory segment size (bytes) }
+ KSYSV_SHMMIN = 2;
+ { int: max number of shared memory identifiers }
+ KSYSV_SHMMNI = 3;
+ { int: max shared memory segments per process }
+ KSYSV_SHMSEG = 4;
+ { int: max amount of shared memory (pages) }
+ KSYSV_SHMALL = 5;
+ { int: max num of semaphore identifiers }
+ KSYSV_SEMMNI = 6;
+ { int: max num of semaphores in system }
+ KSYSV_SEMMNS = 7;
+ { int: max num of undo structures in system }
+ KSYSV_SEMMNU = 8;
+ { int: max num of semaphores per id }
+ KSYSV_SEMMSL = 9;
+ { int: max num of undo entries per process }
+ KSYSV_SEMUNE = 10;
+ error1 = 1;
+ {
+ KERN_PROC subtypes
+ }
+ { everything }
+ KERN_PROC_ALL = 0;
+ { by process id }
+ KERN_PROC_PID = 1;
+ { by process group id }
+ KERN_PROC_PGRP = 2;
+ { by session of pid }
+ KERN_PROC_SESSION = 3;
+ { by controlling tty }
+ KERN_PROC_TTY = 4;
+ { by effective uid }
+ KERN_PROC_UID = 5;
+ { by real uid }
+ KERN_PROC_RUID = 6;
+ {
+ KERN_PROC subtype ops return arrays of augmented proc structures:
+ }
+ {
+ KERN_IPC identifiers
+ }
+ { int: max size of a socket buffer }
+
+ const
+ KIPC_MAXSOCKBUF = 1;
+ { int: wastage factor in sockbuf }
+ KIPC_SOCKBUF_WASTE = 2;
+ { int: max length of connection q }
+ KIPC_SOMAXCONN = 3;
+ { int: max length of link header }
+ KIPC_MAX_LINKHDR = 4;
+ { int: max length of network header }
+ KIPC_MAX_PROTOHDR = 5;
+ { int: max total length of headers }
+ KIPC_MAX_HDR = 6;
+ { int: max length of data? }
+ KIPC_MAX_DATALEN = 7;
+ { struct: mbuf usage statistics }
+ KIPC_MBSTAT = 8;
+ { int: maximum mbuf clusters }
+ KIPC_NMBCLUSTERS = 9;
+ {
+ CTL_VM identifiers
+ }
+ { struct vmmeter }
+ VM_METER = 1;
+ { struct loadavg }
+ VM_LOADAVG = 2;
+ { number of valid vm ids }
+ VM_MAXID = 3;
+ { struct loadavg with mach factor }
+ VM_MACHFACTOR = 4;
+ {
+ CTL_HW identifiers
+ }
+ { string: machine class }
+ HW_MACHINE = 1;
+ { string: specific machine model }
+ HW_MODEL = 2;
+ { int: number of cpus }
+ HW_NCPU = 3;
+ { int: machine byte order }
+ HW_BYTEORDER = 4;
+ { int: total memory }
+ HW_PHYSMEM = 5;
+ { int: non-kernel memory }
+ HW_USERMEM = 6;
+ { int: software page size }
+ HW_PAGESIZE = 7;
+ { strings: disk drive names }
+ HW_DISKNAMES = 8;
+ { struct: diskstats[] }
+ HW_DISKSTATS = 9;
+ { int: 0 for Legacy, else NewWorld }
+ HW_EPOCH = 10;
+ { int: has HW floating point? }
+ HW_FLOATINGPT = 11;
+ { string: machine architecture }
+ HW_MACHINE_ARCH = 12;
+ { int: has HW vector unit? }
+ HW_VECTORUNIT = 13;
+ { int: Bus Frequency }
+ HW_BUS_FREQ = 14;
+ { int: CPU Frequency }
+ HW_CPU_FREQ = 15;
+ { int: Cache Line Size in Bytes }
+ HW_CACHELINE = 16;
+ { int: L1 I Cache Size in Bytes }
+ HW_L1ICACHESIZE = 17;
+ { int: L1 D Cache Size in Bytes }
+ HW_L1DCACHESIZE = 18;
+ { int: L2 Cache Settings }
+ HW_L2SETTINGS = 19;
+ { int: L2 Cache Size in Bytes }
+ HW_L2CACHESIZE = 20;
+ { int: L3 Cache Settings }
+ HW_L3SETTINGS = 21;
+ { int: L3 Cache Size in Bytes }
+ HW_L3CACHESIZE = 22;
+ { int: Bus Frequency }
+ HW_TB_FREQ = 23;
+ { uint64_t: physical ram size }
+ HW_MEMSIZE = 24;
+ { int: number of available CPUs }
+ HW_AVAILCPU = 25;
+ { number of valid hw ids }
+ HW_MAXID = 26;
+
+ {
+ These are the support HW selectors for sysctlbyname. Parameters that are byte count or frequencies are 64 bit numbers.
+ All other parameters are 32 bit numbers.
+
+ hw.memsize - The number of bytes of physical memory in the system.
+
+ hw.ncpu - The number maximum number of processor that could be available this boot.
+ Use this value for sizing of static per processor arrays; i.e. processor load statistics.
+
+ hw.activecpu - The number of cpus currently available for executing threads.
+ Use this number to determine the number threads to create in SMP aware applications.
+ This number can change when power management modes are changed.
+
+ hw.tbfrequency - This gives the time base frequency used by the OS and is the basis of all timing services.
+ In general is is better to use mach's or higher level timing services, but this value
+ is needed to convert the PPC Time Base registers to real time.
+
+ hw.cpufrequency - These values provide the current, min and max cpu frequency. The min and max are for
+ hw.cpufrequency_max - all power management modes. The current frequency is the max frequency in the current mode.
+ hw.cpufrequency_min - All frequencies are in Hz.
+
+ hw.busfrequency - These values provide the current, min and max bus frequency. The min and max are for
+ hw.busfrequency_max - all power management modes. The current frequency is the max frequency in the current mode.
+ hw.busfrequency_min - All frequencies are in Hz.
+
+ hw.cputype - These values provide the mach-o cpu type and subtype. A complete list is in <mach/machine.h>
+ hw.cpusubtype - These values should be used to determine what processor family the running cpu is from so that
+ the best binary can be chosen, or the best dynamic code generated. They should not be used
+ to determine if a given processor feature is available.
+
+ hw.byteorder - Gives the byte order of the processor. 4321 for big endian, 1234 for little.
+
+ hw.pagesize - Gives the size in bytes of the pages used by the processor and VM system.
+
+ hw.cachelinesize - Gives the size in bytes of the processor's cache lines.
+ This value should be use to control the strides of loops that use cache control instructions
+ like dcbz, dcbt or dcbst.
+
+ hw.l1dcachesize - These values provide the size in bytes of the L1, L2 and L3 caches. If a cache is not present
+ hw.l1icachesize - then the selector will return and error.
+ hw.l2cachesize -
+ hw.l3cachesize -
+
+
+ These are the selectors for optional processor features. Selectors that return errors are not support on the system.
+ Supported features will return 1 if they are recommended or 0 if they are supported but are not expected to help performance.
+ Future versions of these selectors may return larger values as necessary so it is best to test for non zero.
+
+ hw.optional.floatingpoint - Floating Point Instructions
+ hw.optional.altivec - AltiVec Instructions
+ hw.optional.graphicsops - Graphics Operations
+ hw.optional.64bitops - 64-bit Instructions
+ hw.optional.fsqrt - HW Floating Point Square Root Instruction
+ hw.optional.stfiwx - Store Floating Point as Integer Word Indexed Instructions
+ hw.optional.dcba - Data Cache Block Allocate Instruction
+ hw.optional.datastreams - Data Streams Instructions
+ hw.optional.dcbtstreams - Data Cache Block Touch Steams Instruction Form
+
+ }
+ {
+ CTL_USER definitions
+ }
+ { string: _CS_PATH }
+ { int: BC_BASE_MAX }
+ USER_BC_BASE_MAX = 2;
+ { int: BC_DIM_MAX }
+ USER_BC_DIM_MAX = 3;
+ { int: BC_SCALE_MAX }
+ USER_BC_SCALE_MAX = 4;
+ { int: BC_STRING_MAX }
+ USER_BC_STRING_MAX = 5;
+ { int: COLL_WEIGHTS_MAX }
+ USER_COLL_WEIGHTS_MAX = 6;
+ { int: EXPR_NEST_MAX }
+ USER_EXPR_NEST_MAX = 7;
+ { int: LINE_MAX }
+ USER_LINE_MAX = 8;
+ { int: RE_DUP_MAX }
+ USER_RE_DUP_MAX = 9;
+ { int: POSIX2_VERSION }
+ USER_POSIX2_VERSION = 10;
+ { int: POSIX2_C_BIND }
+ USER_POSIX2_C_BIND = 11;
+ { int: POSIX2_C_DEV }
+ USER_POSIX2_C_DEV = 12;
+ { int: POSIX2_CHAR_TERM }
+ USER_POSIX2_CHAR_TERM = 13;
+ { int: POSIX2_FORT_DEV }
+ USER_POSIX2_FORT_DEV = 14;
+ { int: POSIX2_FORT_RUN }
+ USER_POSIX2_FORT_RUN = 15;
+ { int: POSIX2_LOCALEDEF }
+ USER_POSIX2_LOCALEDEF = 16;
+ { int: POSIX2_SW_DEV }
+ USER_POSIX2_SW_DEV = 17;
+ { int: POSIX2_UPE }
+ USER_POSIX2_UPE = 18;
+ { int: POSIX2_STREAM_MAX }
+ USER_STREAM_MAX = 19;
+ { int: POSIX2_TZNAME_MAX }
+ USER_TZNAME_MAX = 20;
+ { number of valid user ids }
+ USER_MAXID = 21;
+
+{
+ $Log: sysctlh.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/termio.pp b/rtl/darwin/termio.pp
new file mode 100644
index 0000000000..45050d0f36
--- /dev/null
+++ b/rtl/darwin/termio.pp
@@ -0,0 +1,49 @@
+{
+ $Id: termio.pp,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains the termios interface.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit termio;
+
+interface
+
+Uses BaseUnix; // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.
+
+{
+ $Log: termio.pp,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/termios.inc b/rtl/darwin/termios.inc
new file mode 100644
index 0000000000..46d215b432
--- /dev/null
+++ b/rtl/darwin/termios.inc
@@ -0,0 +1,578 @@
+{
+ $Id: termios.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+}
+
+
+{$PACKRECORDS C}
+
+ {
+ Copyright (c) 2000 Apple Computer, Inc. All rights reserved.
+
+ @APPLE_LICENSE_HEADER_START@
+
+ The contents of this file constitute Original Code as defined in and
+ are subject to the Apple Public Source License Version 1.1 (the
+ "License"). You may not use this file except in compliance with the
+ License. Please obtain a copy of the License at
+ http://www.apple.com/publicsource and read it before using this file.
+
+ This Original Code and all software distributed under the License are
+ distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
+ INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ @APPLE_LICENSE_HEADER_END@
+ }
+ { Copyright (c) 1997 Apple Computer, Inc. All Rights Reserved }
+ {
+ Copyright (c) 1988, 1989, 1993, 1994
+ The Regents of the University of California. All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. All advertising materials mentioning features or use of this software
+ must display the following acknowledgement:
+ This product includes software developed by the University of
+ California, Berkeley and its contributors.
+ 4. Neither the name of the University nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ SUCH DAMAGE.
+
+ @(#)termios.h 8.3 (Berkeley) 3/28/94
+ }
+{$ifndef _SYS_TERMIOS_H_}
+{$define _SYS_TERMIOS_H_}
+ {
+ Special Control Characters
+
+ Index into c_cc[] character array.
+
+ Name Subscript Enabled by
+ }
+ { ICANON }
+
+ const
+ VEOF = 0;
+ { ICANON }
+ VEOL = 1;
+{$ifndef _POSIX_SOURCE}
+ { ICANON together with IEXTEN }
+
+ const
+ VEOL2 = 2;
+{$endif}
+ { ICANON }
+
+ const
+ VERASE = 3;
+{$ifndef _POSIX_SOURCE}
+ { ICANON together with IEXTEN }
+
+ const
+ VWERASE = 4;
+{$endif}
+ { ICANON }
+
+ const
+ VKILL = 5;
+{$ifndef _POSIX_SOURCE}
+ { ICANON together with IEXTEN }
+
+ const
+ VREPRINT = 6;
+{$endif}
+ { 7 spare 1 }
+ { ISIG }
+
+ const
+ VINTR = 8;
+ { ISIG }
+ VQUIT = 9;
+ { ISIG }
+ VSUSP = 10;
+{$ifndef _POSIX_SOURCE}
+ { ISIG together with IEXTEN }
+
+ const
+ VDSUSP = 11;
+{$endif}
+ { IXON, IXOFF }
+
+ const
+ VSTART = 12;
+ { IXON, IXOFF }
+ VSTOP = 13;
+{$ifndef _POSIX_SOURCE}
+ { IEXTEN }
+
+ const
+ VLNEXT = 14;
+ { IEXTEN }
+ VDISCARD = 15;
+{$endif}
+ { !ICANON }
+
+ const
+ VMIN = 16;
+ { !ICANON }
+ VTIME = 17;
+{$ifndef _POSIX_SOURCE}
+ { ICANON together with IEXTEN }
+
+ const
+ VSTATUS = 18;
+ { 19 spare 2 }
+{$endif}
+
+ const
+ NCCS = 20;
+{$ifndef _POSIX_VDISABLE}
+
+// as in linux freebsd netbsd and openbsd
+// Start
+Type
+ winsize = packed record
+ ws_row,
+ ws_col,
+ ws_xpixel,
+ ws_ypixel : word;
+ end;
+ TWinSize=winsize;
+//End
+
+ const
+ _POSIX_VDISABLE = $ff;
+{$endif}
+{$ifndef _POSIX_SOURCE}
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+// function CCEQ(val,c : longint) : longint;
+// as in freebsd netbsd and openbsd and in /usr/include/sys/termios.h
+{
+
+ #define CCEQ(val, c) ((c) == (val) ? (val) != _POSIX_VDISABLE : 0)
+}
+{$endif}
+ {
+ Input flags - software input processing
+ }
+ { ignore BREAK condition }
+
+ const
+ IGNBRK = $00000001;
+ { map BREAK to SIGINTR }
+ BRKINT = $00000002;
+ { ignore (discard) parity errors }
+ IGNPAR = $00000004;
+ { mark parity and framing errors }
+ PARMRK = $00000008;
+ { enable checking of parity errors }
+ INPCK = $00000010;
+ { strip 8th bit off chars }
+ ISTRIP = $00000020;
+ { map NL into CR }
+ INLCR = $00000040;
+ { ignore CR }
+ IGNCR = $00000080;
+ { map CR to NL (ala CRMOD) }
+ ICRNL = $00000100;
+ { enable output flow control }
+ IXON = $00000200;
+ { enable input flow control }
+ IXOFF = $00000400;
+{$ifndef _POSIX_SOURCE}
+ { any char will restart after stop }
+
+ const
+ IXANY = $00000800;
+ { ring bell on input queue full }
+ IMAXBEL = $00002000;
+{$endif}
+ {_POSIX_SOURCE }
+ {
+ Output flags - software output processing
+ }
+ { enable following output processing }
+
+ const
+ OPOST = $00000001;
+{$ifndef _POSIX_SOURCE}
+ { map NL to CR-NL (ala CRMOD) }
+
+ const
+ ONLCR = $00000002;
+ { expand tabs to spaces }
+ OXTABS = $00000004;
+ { discard EOT's (^D) on output) }
+ ONOEOT = $00000008;
+{$endif}
+ {_POSIX_SOURCE }
+ {
+ Control flags - hardware control of terminal
+ }
+{$ifndef _POSIX_SOURCE}
+ { ignore control flags }
+
+ const
+ CIGNORE = $00000001;
+{$endif}
+ { character size mask }
+
+ const
+ CSIZE = $00000300;
+ { 5 bits (pseudo) }
+ CS5 = $00000000;
+ { 6 bits }
+ CS6 = $00000100;
+ { 7 bits }
+ CS7 = $00000200;
+ { 8 bits }
+ CS8 = $00000300;
+ { send 2 stop bits }
+ CSTOPB = $00000400;
+ { enable receiver }
+ CREAD = $00000800;
+ { parity enable }
+ PARENB = $00001000;
+ { odd parity, else even }
+ PARODD = $00002000;
+ { hang up on last close }
+ HUPCL = $00004000;
+ { ignore modem status lines }
+ CLOCAL = $00008000;
+{$ifndef _POSIX_SOURCE}
+ { CTS flow control of output }
+
+ const
+ CCTS_OFLOW = $00010000;
+ { RTS flow control of input }
+ CRTS_IFLOW = $00020000;
+ CRTSCTS = CCTS_OFLOW or CRTS_IFLOW;
+ { DTR flow control of input }
+ CDTR_IFLOW = $00040000;
+ { DSR flow control of output }
+ CDSR_OFLOW = $00080000;
+ { DCD flow control of output }
+ CCAR_OFLOW = $00100000;
+ { old name for CCAR_OFLOW }
+ MDMBUF = $00100000;
+{$endif}
+ {
+ "Local" flags - dumping ground for other state
+
+ Warning: some flags in this structure begin with
+ the letter "I" and look like they belong in the
+ input flag.
+ }
+{$ifndef _POSIX_SOURCE}
+ { visual erase for line kill }
+
+ const
+ ECHOKE = $00000001;
+{$endif}
+ {_POSIX_SOURCE }
+ { visually erase chars }
+
+ const
+ ECHOE = $00000002;
+ { echo NL after line kill }
+ ECHOK = $00000004;
+ { enable echoing }
+ ECHO = $00000008;
+ { echo NL even if ECHO is off }
+ ECHONL = $00000010;
+{$ifndef _POSIX_SOURCE}
+ { visual erase mode for hardcopy }
+
+ const
+ ECHOPRT = $00000020;
+ { echo control chars as ^(Char) }
+ ECHOCTL = $00000040;
+{$endif}
+ {_POSIX_SOURCE }
+ { enable signals INTR, QUIT, [D]SUSP }
+
+ const
+ ISIG = $00000080;
+ { canonicalize input lines }
+ ICANON = $00000100;
+{$ifndef _POSIX_SOURCE}
+ { use alternate WERASE algorithm }
+
+ const
+ ALTWERASE = $00000200;
+{$endif}
+ {_POSIX_SOURCE }
+ { enable DISCARD and LNEXT }
+
+ const
+ IEXTEN = $00000400;
+ { external processing }
+ EXTPROC = $00000800;
+ { stop background jobs from output }
+ TOSTOP = $00400000;
+{$ifndef _POSIX_SOURCE}
+ { output being flushed (state) }
+
+ const
+ FLUSHO = $00800000;
+ { no kernel output from VSTATUS }
+ NOKERNINFO = $02000000;
+ { XXX retype pending input (state) }
+ PENDIN = $20000000;
+{$endif}
+ {_POSIX_SOURCE }
+ { don't flush after interrupt }
+
+ const
+ NOFLSH = $80000000;
+
+ type
+
+ tcflag_t = dword;
+
+ cc_t = byte;
+
+ speed_t = longint;
+ { XXX should be unsigned long }
+ { input flags }
+ { output flags }
+ { control flags }
+ { local flags }
+ { control chars }
+ { input speed }
+ { output speed }
+ termios = record
+ c_iflag : tcflag_t;
+ c_oflag : tcflag_t;
+ c_cflag : tcflag_t;
+ c_lflag : tcflag_t;
+ c_cc : array[0..(NCCS)-1] of cc_t;
+ c_ispeed : speed_t;
+ c_ospeed : speed_t;
+ end;
+
+ {
+ Commands passed to tcsetattr() for setting the termios structure.
+ }
+ { make change immediate }
+
+ const
+ TCSANOW = 0;
+ { drain output, then change }
+ TCSADRAIN = 1;
+ { drain output, flush input }
+ TCSAFLUSH = 2;
+{$ifndef _POSIX_SOURCE}
+ { flag - don't alter h.w. state }
+
+ const
+ TCSASOFT = $10;
+{$endif}
+ {
+ Standard speeds
+ }
+
+ const
+ B0 = 0;
+ B50 = 50;
+ B75 = 75;
+ B110 = 110;
+ B134 = 134;
+ B150 = 150;
+ B200 = 200;
+ B300 = 300;
+ B600 = 600;
+ B1200 = 1200;
+ B1800 = 1800;
+ B2400 = 2400;
+ B4800 = 4800;
+ B9600 = 9600;
+ B19200 = 19200;
+ B38400 = 38400;
+{$ifndef _POSIX_SOURCE}
+
+ const
+ B7200 = 7200;
+ B14400 = 14400;
+ B28800 = 28800;
+ B57600 = 57600;
+ B76800 = 76800;
+ B115200 = 115200;
+ B230400 = 230400;
+ EXTA = 19200;
+ EXTB = 38400;
+{$endif}
+ { !_POSIX_SOURCE }
+
+ const
+ TCIFLUSH = 1;
+ TCOFLUSH = 2;
+ TCIOFLUSH = 3;
+ TCOOFF = 1;
+ TCOON = 2;
+ TCIOFF = 3;
+ TCION = 4;
+
+// as in freebsd netbsd and openbsd and in
+// /usr/include/sys/ttycom.h und ioccom.h
+
+ IOCTLREAD = $40000000;
+ IOCTLWRITE = $80000000;
+ IOCTLVOID = $20000000;
+
+ TIOCMODG = IOCTLREAD+$47400+ 3; { get modem control state }
+ TIOCMODS = IOCTLWRITE+$47400+ 4; { set modem control state }
+ TIOCM_LE =$0001; { line enable }
+ TIOCM_DTR =$0002; { data terminal ready }
+ TIOCM_RTS =$0004; { request to send }
+ TIOCM_ST =$0010; { secondary transmit }
+ TIOCM_SR =$0020; { secondary receive }
+ TIOCM_CTS =$0040; { clear to send }
+ TIOCM_CAR =$0100; { carrier detect }
+ TIOCM_CD =TIOCM_CAR;
+ TIOCM_RNG =$0200; { ring }
+ TIOCM_RI =TIOCM_RNG;
+ TIOCM_DSR =$0400; { data set ready }
+ { 8-10 compat }
+ TIOCEXCL =IOCTLVOID+$7400+ 13; { set exclusive use of tty }
+ TIOCNXCL =IOCTLVOID+$7400+ 14; { reset exclusive use of tty }
+ { 15 unused }
+ TIOCFLUSH =IOCTLWRITE+$47400+ 16; { flush buffers }
+ { 17-18 compat }
+ TIOCGETA =IOCTLREAD+$2C7400+ 19; { get termios struct }
+ TIOCSETA =IOCTLWRITE+$2C7400+ 20; { set termios struct }
+ TIOCSETAW =IOCTLWRITE+$2C7400+ 21; { drain output, set }
+ TIOCSETAF =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
+ TIOCGETD =IOCTLREAD+$47400+ 26; { get line discipline }
+ TIOCSETD =IOCTLWRITE+$47400+ 27; { set line discipline }
+ { 127-124 compat }
+ TIOCSBRK =IOCTLVOID+$7400+ 123; { set break bit }
+ TIOCCBRK =IOCTLVOID+$7400+ 122; { clear break bit }
+ TIOCSDTR =IOCTLVOID+$7400+ 121; { set data terminal ready }
+ TIOCCDTR =IOCTLVOID+$7400+ 120; { clear data terminal ready }
+ TIOCGPGRP =IOCTLREAD+$47400+ 119; { get pgrp of tty }
+ TIOCSPGRP =IOCTLWRITE+$47400+ 118; { set pgrp of tty }
+ { 117-116 compat }
+ TIOCOUTQ =IOCTLREAD+$47400+ 115; { output queue size }
+ TIOCSTI =IOCTLWRITE+$17400+ 114; { simulate terminal input }
+ TIOCNOTTY =IOCTLVOID+$7400+ 113; { void tty association }
+ TIOCPKT =IOCTLWRITE+$47400+ 112; { pty: set/clear packet mode }
+ TIOCPKT_DATA =$00; { data packet }
+ TIOCPKT_FLUSHREAD =$01; { flush packet }
+ TIOCPKT_FLUSHWRITE =$02; { flush packet }
+ TIOCPKT_STOP =$04; { stop output }
+ TIOCPKT_START =$08; { start output }
+ TIOCPKT_NOSTOP =$10; { no more ^S, ^Q }
+ TIOCPKT_DOSTOP =$20; { now do ^S ^Q }
+ TIOCPKT_IOCTL =$40; { state change of pty driver }
+ TIOCSTOP =IOCTLVOID+$7400+ 111; { stop output, like ^S }
+ TIOCSTART =IOCTLVOID+$7400+ 110; { start output, like ^Q }
+ TIOCMSET =IOCTLWRITE+$47400+ 109; { set all modem bits }
+ TIOCMBIS =IOCTLWRITE+$47400+ 108; { bis modem bits }
+ TIOCMBIC =IOCTLWRITE+$47400+ 107; { bic modem bits }
+ TIOCMGET =IOCTLREAD+$47400+ 106; { get all modem bits }
+ TIOCREMOTE =IOCTLWRITE+$47400+ 105; { remote input editing }
+ TIOCGWINSZ =IOCTLREAD+$87400+ 104; { get window size }
+ TIOCSWINSZ =IOCTLWRITE+$87400+ 103; { set window size }
+ TIOCUCNTL =IOCTLWRITE+$47400+ 102; { pty: set/clr usr cntl mode }
+ TIOCSTAT =IOCTLVOID+$7400+ 101; { simulate ^T status message }
+ // UIOCCMD(n) _IO('u', n) { usr cntl op "n" }
+ TIOCSCONS =IOCTLWRITE+$47400+ 99; { 4.2 compatibility } // added from ttycom.h
+ TIOCCONS =IOCTLWRITE+$47400+ 98; { become virtual console }
+ TIOCSCTTY =IOCTLVOID+$7400+ 97; { become controlling tty }
+ TIOCEXT =IOCTLWRITE+$47400+ 96; { pty: external processing }
+ TIOCSIG =IOCTLVOID+$7400+ 95; { pty: generate signal }
+ TIOCDRAIN =IOCTLVOID+$7400+ 94; { wait till output drained }
+ TIOCMSDTRWAIT =IOCTLWRITE+$47400+ 91; { modem: set wait on close }
+ TIOCMGDTRWAIT =IOCTLREAD+$47400+ 90; { modem: get wait on close }
+ TIOCTIMESTAMP =IOCTLREAD+$87400+ 89; { enable/get timestamp
+ * of last input event }
+ TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
+ * of last DCd rise }
+ TIOCSDRAINWAIT =IOCTLWRITE+$47400+ 87; { set ttywait timeout }
+ TIOCGDRAINWAIT =IOCTLREAD+$47400+ 86; { get ttywait timeout }
+ TIOCDSIMICROCODE =IOCTLREAD+$47400+ 85; { download microcode to DSI Softmodem } // added from ttycom.h
+
+ TTYDISC =0; { termios tty line discipline }
+ TABLDISC =3; { tablet discipline } // added from ttycom.h
+ SLIPDISC =4; { serial IP discipline }
+ PPPDISC =5; { PPP discipline }
+ NETGRAPHDISC =6; { Netgraph tty node discipline }
+
+
+{
+ * Defaults on "first" open.
+ }
+ TTYDEF_IFLAG =(BRKINT or ICRNL or IMAXBEL or IXON or IXANY);
+ TTYDEF_OFLAG =(OPOST or ONLCR);
+ TTYDEF_LFLAG =(ECHO or ICANON or ISIG or IEXTEN or ECHOE or ECHOKE or ECHOCTL);
+ TTYDEF_CFLAG =(CREAD or CS8 or HUPCL);
+ TTYDEF_SPEED =(B9600);
+
+{
+ * Control Character Defaults
+ }
+ CtrlMask = $1f; {\037}
+ CEOF =chr( ORD('d') and CtrlMask);
+ CEOL =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
+ CERASE =chr( $7F and CtrlMask);
+ CINTR =chr(ORD('c') and CtrlMask);
+ CSTATUS =chr(ORD('t') and CtrlMask);
+ CKILL =chr(ORD('u') and CtrlMask);
+ CMIN =chr(1);
+ CQUIT =chr(034 and CtrlMask); { FS, ^\ }
+ CSUSP =chr(ORD('z') and CtrlMask);
+ CTIME =chr(0);
+ CDSUSP =chr(ORD('y') and CtrlMask);
+ CSTART =chr(ORD('q') and CtrlMask);
+ CSTOP =chr(ORD('s') and CtrlMask);
+ CLNEXT =chr(ORD('v') and CtrlMask);
+ CDISCARD =chr(ORD('o') and CtrlMask);
+ CWERASE =chr(ORD('w') and CtrlMask);
+ CREPRINT =chr(ORD('r') and CtrlMask);
+ CEOT =CEOF;
+{ compat }
+ CBRK =CEOL;
+ CRPRNT =CREPRINT;
+ CFLUSH =CDISCARD;
+
+
+{
+ * TTYDEFCHARS to include an array of default control characters.
+}
+ ttydefchars : array[0..NCCS-1] OF char =(
+ CEOF, CEOL, CEOL, CERASE, CWERASE, CKILL, CREPRINT,
+ chr(_POSIX_VDISABLE), CINTR, CQUIT, CSUSP, CDSUSP, CSTART, CSTOP, CLNEXT,
+ CDISCARD, CMIN, CTIME, CSTATUS, chr(_POSIX_VDISABLE));
+
+{$endif}
+
+{
+ $Log: termios.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/termiosproc.inc b/rtl/darwin/termiosproc.inc
new file mode 100644
index 0000000000..dd4393910a
--- /dev/null
+++ b/rtl/darwin/termiosproc.inc
@@ -0,0 +1,142 @@
+{
+ $Id: termiosproc.inc,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains the implementation of several termio(s) functions
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{******************************************************************************
+ IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+ TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+end;
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+ nr:cint;
+begin
+ case OptAct of
+ TCSANOW : nr:=TIOCSETA;
+ TCSADRAIN : nr:=TIOCSETAW;
+ TCSAFLUSH : nr:=TIOCSETAF;
+ else
+ begin
+ fpsetErrNo(ESysEINVAL);
+ TCSetAttr:=-1;
+ exit;
+ end;
+ end;
+ TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ospeed:=speed;
+end;
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+ with tios do
+ begin
+ c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
+ PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+ IGNPAR));
+ c_iflag:=c_iflag OR IGNBRK;
+ c_oflag:=c_oflag and (not OPOST);
+ c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+ ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
+ c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+end;
+
+//Function TCGetAttr(fd:cint;var tios:TermIOS):cint; cdecl; external 'c' name 'tcgetattr';
+//Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint; cdecl; external 'c' name 'tcsetattr';
+//Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal); cdecl; external 'c' name 'cfsetispeed';
+//Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal); cdecl; external 'c' name 'cfsetospeed';
+//Procedure CFMakeRaw(var tios:TermIOS); cdecl; external 'c' name 'cfmakeraw';
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+ TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+end;
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+ TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+ TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+ TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+ case act OF
+ TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
+ TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,nil);
+ TCIOFF : {N/I}
+ end;
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+ TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
+end;
+
+Function IsATTY (Handle:cint):cint;
+{
+ Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+var
+ t : Termios;
+begin
+ IsAtty:=TCGetAttr(Handle,t);
+end;
+
+
+Function IsATTY(var f: text):cint;
+{
+ Idem as previous, only now for text variables.
+}
+begin
+ IsATTY:=IsaTTY(textrec(f).handle);
+end;
+
+{
+ $Log: termiosproc.inc,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/tthread.inc b/rtl/darwin/tthread.inc
new file mode 100644
index 0000000000..8803251e54
--- /dev/null
+++ b/rtl/darwin/tthread.inc
@@ -0,0 +1,310 @@
+{
+ $Id: tthread.inc,v 1.7 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Peter Vreman
+
+ Darwin TThread implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+ What follows, is a short description on my implementation of TThread.
+ Most information can also be found by reading the source and accompanying
+ comments.
+
+ A thread is created using BeginThread, which in turn calls
+ pthread_create. So the threads here are always posix threads.
+ Posix doesn't define anything for suspending threads as this is
+ inherintly unsafe. Just don't suspend threads at points they cannot
+ control. Therefore, I didn't implement .Suspend() if its called from
+ outside the threads execution flow (except on Linux _without_ NPTL).
+
+ The implementation for .suspend uses a semaphore, which is initialized
+ at thread creation. If the thread tries to suspend itself, we simply
+ let it wait on the semaphore until it is unblocked by someone else
+ who calls .Resume.
+
+ If a thread is supposed to be suspended (from outside its own path of
+ execution) on a system where the symbol LINUX is defined, two things
+ are possible.
+ 1) the system has the LinuxThreads pthread implementation
+ 2) the system has NPTL as the pthread implementation.
+
+ In the first case, each thread is a process on its own, which as far as
+ know actually violates posix with respect to signal handling.
+ But we can detect this case, because getpid(2) will
+ return a different PID for each thread. In that case, sending SIGSTOP
+ to the PID associated with a thread will actually stop that thread
+ only.
+ In the second case, this is not possible. But getpid(2) returns the same
+ PID across all threads, which is detected, and TThread.Suspend() does
+ nothing in that case. This should probably be changed, but I know of
+ no way to suspend a thread when using NPTL.
+
+ If the symbol LINUX is not defined, then the unimplemented
+ function SuspendThread is called.
+
+ Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+ I don't like this. It eats up 2 filedescriptors for each thread,
+ and those are a limited resource. If you have a server programm
+ handling client connections (one per thread) it will not be able
+ to handle many if we use 2 fds already for internal structures.
+ However, right now I don't see a better option unless some sem_*
+ functions are added to systhrds.
+ I encapsulated all used functions here to make it easier to
+ change them completely.
+}
+
+function SemaphoreInit: Pointer;
+begin
+ SemaphoreInit := GetMem(SizeOf(TFilDes));
+ fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+ b: byte;
+begin
+ fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+ fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+ fpclose(PFilDes(FSem)^[0]);
+ fpclose(PFilDes(FSem)^[1]);
+ FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+ ThreadsInited: boolean = false;
+const
+ // stupid, considering its not even implemented...
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+ if not ThreadsInited then begin
+ ThreadsInited := true;
+ end;
+end;
+
+procedure DoneThreads;
+begin
+ ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt;
+var
+ LThread: TThread;
+begin
+ WRITE_DEBUG('ThreadFunc is here...');
+ LThread := TThread(parameter);
+ WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+ try
+ if LThread.FInitialSuspended then begin
+ SemaphoreWait(LThread.FSem);
+ if not LThread.FSuspended then begin
+ LThread.FInitialSuspended := false;
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ end else begin
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ except
+ on e: exception do begin
+ WRITE_DEBUG('got exception: ',e.message);
+ LThread.FFatalException := TObject(AcquireExceptionObject);
+ // not sure if we should really do this...
+ // but .Destroy was called, so why not try FreeOnTerminate?
+ if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+ end;
+ end;
+ WRITE_DEBUG('thread done running');
+ Result := LThread.FReturnValue;
+ WRITE_DEBUG('Result is ',Result);
+ LThread.FFinished := True;
+ LThread.DoTerminate;
+ if LThread.FreeOnTerminate then begin
+ WRITE_DEBUG('Thread should be freed');
+ LThread.Free;
+ WRITE_DEBUG('Thread freed');
+ end;
+ WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+ // lets just hope that the user doesn't create a thread
+ // via BeginThread and creates the first TThread Object in there!
+ InitThreads;
+ inherited Create;
+ FSem := SemaphoreInit;
+ FSuspended := CreateSuspended;
+ FSuspendedExternal := false;
+ FInitialSuspended := CreateSuspended;
+ FFatalException := nil;
+ WRITE_DEBUG('creating thread, self = ',longint(self));
+ FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+ WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if FThreadID = GetCurrentThreadID then begin
+ raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+ end;
+ // if someone calls .Free on a thread with
+ // FreeOnTerminate, then don't crash!
+ FFreeOnTerminate := false;
+ if not FFinished and not FSuspended then begin
+ Terminate;
+ WaitFor;
+ end;
+ if (FInitialSuspended) then begin
+ // thread was created suspended but never woken up.
+ SemaphorePost(FSem);
+ WaitFor;
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ SemaphoreDestroy(FSem);
+ inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ if not FSuspended then begin
+ if FThreadID = GetCurrentThreadID then begin
+ FSuspended := true;
+ SemaphoreWait(FSem);
+ end else begin
+ FSuspendedExternal := true;
+ SuspendThread(FHandle);
+ end;
+ end;
+end;
+
+
+procedure TThread.Resume;
+begin
+ if (not FSuspendedExternal) then begin
+ if FSuspended then begin
+ FSuspended := False;
+ SemaphorePost(FSem);
+ end;
+ end else begin
+ FSuspendedExternal := false;
+ ResumeThread(FHandle);
+ end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+ WRITE_DEBUG('waiting for thread ',FHandle);
+ WaitFor := WaitForThreadTerminate(FHandle, 0);
+ WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ // no need to check if FOnTerminate <> nil, because
+ // thats already done in DoTerminate
+ FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.7 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.6 2005/03/01 20:38:49 jonas
+ * fixed web bug 3387: if one called resume right after creating a
+ suspended thread, it was possible that resume was executed before
+ that thread had completed its initialisation in BeginThread ->
+ FInitialSuspended was set to false in resume and nevertheless a
+ semafore was posted
+ * second problem fixed: set FSuspended to false before waking up the
+ thread, so that it doesn't get FSuspended = true right after waking
+ up. This should be done atomically to be completely correct though.
+
+ Revision 1.5 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/darwin/unxconst.inc b/rtl/darwin/unxconst.inc
new file mode 100644
index 0000000000..cf129fe432
--- /dev/null
+++ b/rtl/darwin/unxconst.inc
@@ -0,0 +1,119 @@
+{
+ $Id: unxconst.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{BSD version, only the blocks with BSD in the comment are updated}
+
+Const
+ { Things for LSEEK call, same in linux and BSD }
+ Seek_set = 0;
+ Seek_Cur = 1;
+ Seek_End = 2;
+ { Things for OPEN call - after include/sys/fcntl.h, BSD updated.
+ BSD specifies these constants in hex }
+ Open_Accmode = 3;
+ Open_RdOnly = 0;
+ Open_WrOnly = 1;
+ Open_RdWr = 2;
+ Open_NonBlock = 4;
+ Open_Append = 8;
+ Open_ShLock = $10;
+ Open_ExLock = $20;
+ Open_ASync = $40;
+ Open_FSync = $80;
+ Open_NoFollow = $100;
+ Open_Create = $200; {BSD convention}
+ Open_Creat = $200; {Linux convention}
+ Open_Trunc = $400;
+ Open_Excl = $800;
+ Open_NoCTTY = $8000;
+
+ { The waitpid uses the following options:}
+ Wait_NoHang = 1;
+ Wait_UnTraced = 2;
+ Wait_Any = -1;
+ Wait_MyPGRP = 0;
+ { Constants to check stat.mode - checked all STAT constants with BSD}
+ STAT_IFMT = $f000; {00170000 }
+ STAT_IFSOCK = $c000; {0140000 }
+ STAT_IFLNK = $a000; {0120000 }
+ STAT_IFREG = $8000; {0100000 }
+ STAT_IFBLK = $6000; {0060000 }
+ STAT_IFDIR = $4000; {0040000 }
+ STAT_IFCHR = $2000; {0020000 }
+ STAT_IFIFO = $1000; {0010000 }
+ STAT_ISUID = $0800; {0004000 }
+ STAT_ISGID = $0400; {0002000 }
+ STAT_ISVTX = $0200; {0001000}
+ { Constants to check permissions all }
+ STAT_IRWXO = $7;
+ STAT_IROTH = $4;
+ STAT_IWOTH = $2;
+ STAT_IXOTH = $1;
+
+ STAT_IRWXG = STAT_IRWXO shl 3;
+ STAT_IRGRP = STAT_IROTH shl 3;
+ STAT_IWGRP = STAT_IWOTH shl 3;
+ STAT_IXGRP = STAT_IXOTH shl 3;
+
+ STAT_IRWXU = STAT_IRWXO shl 6;
+ STAT_IRUSR = STAT_IROTH shl 6;
+ STAT_IWUSR = STAT_IWOTH shl 6;
+ STAT_IXUSR = STAT_IXOTH shl 6;
+
+ { Constants to test the type of filesystem }
+ fs_old_ext2 = $ef51;
+ fs_ext2 = $ef53;
+ fs_ext = $137d;
+ fs_iso = $9660;
+ fs_minix = $137f;
+ fs_minix_30 = $138f;
+ fs_minux_V2 = $2468;
+ fs_msdos = $4d44;
+ fs_nfs = $6969;
+ fs_proc = $9fa0;
+ fs_xia = $012FD16D;
+
+ {Constansts Termios/Ioctl (used in Do_IsDevice) }
+ IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+ {Checked for BSD using Linuxthreads port}
+ { cloning flags }
+ CSIGNAL = $000000ff; // signal mask to be sent at exit
+ CLONE_VM = $00000100; // set if VM shared between processes
+ CLONE_FS = $00000200; // set if fs info shared between processes
+ CLONE_FILES = $00000400; // set if open files shared between processes
+ CLONE_SIGHAND = $00000800; // set if signal handlers shared
+ CLONE_PID = $00001000; // set if pid shared
+
+ ITimer_Real =0;
+ ITimer_Virtual =1;
+ ITimer_Prof =2;
+
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+
+
+{
+ $Log: unxconst.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.2 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+}
diff --git a/rtl/darwin/unxfunc.inc b/rtl/darwin/unxfunc.inc
new file mode 100644
index 0000000000..6d98d50d86
--- /dev/null
+++ b/rtl/darwin/unxfunc.inc
@@ -0,0 +1,77 @@
+{
+ $Id: unxfunc.inc,v 1.3 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Peter Vreman
+
+ Darwin temporary pclose/assignpipe implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+
+begin
+ fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ pclose := WaitProcess(pl^);
+end;
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^longint;
+
+begin
+ fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ pclose:= WaitProcess(pl^);
+end;
+
+
+// can't have oldfpccall here, linux doesn't need it.
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ ret : longint;
+ fdis : array[0..1] of cint;
+begin
+ fdis[0]:=pipe_in;
+ fdis[1]:=pipe_out;
+ ret:=pipe(fdis);
+ pipe_in:=fdis[0];
+ pipe_out:=fdis[1];
+ AssignPipe:=ret;
+end;
+
+
+{
+ $Log: unxfunc.inc,v $
+ Revision 1.3 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.1 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+}
diff --git a/rtl/darwin/unxsockh.inc b/rtl/darwin/unxsockh.inc
new file mode 100644
index 0000000000..387f983da8
--- /dev/null
+++ b/rtl/darwin/unxsockh.inc
@@ -0,0 +1,79 @@
+{
+ $Id: unxsockh.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ OS dependant part of the header.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+Const
+ AF_AX25 = 3; { Amateur Radio AX.25 }
+ AF_IPX = 4; { Novell IPX }
+ AF_APPLETALK = 5; { Appletalk DDP }
+ AF_NETROM = 6; { Amateur radio NetROM }
+ AF_BRIDGE = 7; { Multiprotocol bridge }
+ AF_AAL5 = 8; { Reserved for Werner's ATM }
+ AF_X25 = 9; { Reserved for X.25 project }
+ AF_INET6 = 10; { IP version 6 }
+ AF_MAX = 12;
+
+ SOCK_PACKET = 10;
+
+ PF_AX25 = AF_AX25;
+ PF_IPX = AF_IPX;
+ PF_APPLETALK = AF_APPLETALK;
+ PF_NETROM = AF_NETROM;
+ PF_BRIDGE = AF_BRIDGE;
+ PF_AAL5 = AF_AAL5;
+ PF_X25 = AF_X25;
+ PF_INET6 = AF_INET6;
+
+ PF_MAX = AF_MAX;
+
+ SOL_SOCKET = $FFFF;
+ SO_DEBUG =$0001; { turn on debugging info recording }
+ SO_ACCEPTCONN =$0002; { socket has had listen() }
+ SO_REUSEADDR =$0004; { allow local address reuse }
+ SO_KEEPALIVE =$0008; { keep connections alive }
+ SO_DONTROUTE =$0010; { just use interface addresses }
+ SO_BROADCAST =$0020; { permit sending of broadcast msgs }
+ SO_USELOOPBACK =$0040; { bypass hardware when possible }
+ SO_LINGER =$0080; { linger on close if data present }
+ SO_OOBINLINE =$0100; { leave received OOB data in line }
+ SO_REUSEPORT =$0200; { allow local address & port reuse }
+ SO_TIMESTAMP =$0400; { timestamp received dgram traffic }
+
+{
+ * Additional options, not kept in so_options.
+ }
+ SO_SNDBUF =$1001; { send buffer size }
+ SO_RCVBUF =$1002; { receive buffer size }
+ SO_SNDLOWAT =$1003; { send low-water mark }
+ SO_RCVLOWAT =$1004; { receive low-water mark }
+ SO_SNDTIMEO =$1005; { send timeout }
+ SO_RCVTIMEO =$1006; { receive timeout }
+ SO_ERROR =$1007; { get error status and clear }
+ SO_TYPE =$1008; { get socket type }
+
+
+ SHUT_RD =0; { shut down the reading side }
+ SHUT_WR =1; { shut down the writing side }
+ SHUT_RDWR =2; { shut down both sides }
+
+
+{
+ $Log: unxsockh.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
+
+
diff --git a/rtl/emx/Makefile b/rtl/emx/Makefile
new file mode 100644
index 0000000000..3df7bf8c1e
--- /dev/null
+++ b/rtl/emx/Makefile
@@ -0,0 +1,2028 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=emx
+override CPU_TARGET_DEFAULT=i386
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+OS2INC=$(RTL)/os2
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysemx
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil ctypes
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 prt1
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(OS2INC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+%$(OEXT) : %.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)$*$(OEXT) $*.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pas
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ $(SYSTEMUNIT)$(PPUEXT)
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+doscalls$(PPUEXT) : $(OS2INC)/doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+kbdcalls$(PPUEXT) : $(OS2INC)/kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moucalls$(PPUEXT) : $(OS2INC)/moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moncalls$(PPUEXT) : $(OS2INC)/moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+os2def$(PPUEXT) : $(OS2INC)/os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+pmwin$(PPUEXT) : $(OS2INC)/pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmbitmap$(PPUEXT) : $(OS2INC)/pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+pmgpi$(PPUEXT) : $(OS2INC)/pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmstddlg$(PPUEXT) : $(OS2INC)/pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmhelp$(PPUEXT) : $(OS2INC)/pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmdev$(PPUEXT) : $(OS2INC)/pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmspl$(PPUEXT) : $(OS2INC)/pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmshl$(PPUEXT) : $(OS2INC)/pmshl.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmwp$(PPUEXT) : $(OS2INC)/pmwp.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmwsock$(PPUEXT) : $(OS2INC)/pmwsock.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+winsock$(PPUEXT) : $(OS2INC)/winsock.pas pmwsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmbidi$(PPUEXT) : $(OS2INC)/pmbidi.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : $(OS2INC)/printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : $(OS2INC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(OS2INC)/classes.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OS2INC)/varutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
diff --git a/rtl/emx/Makefile.fpc b/rtl/emx/Makefile.fpc
new file mode 100644
index 0000000000..44edeb22cd
--- /dev/null
+++ b/rtl/emx/Makefile.fpc
@@ -0,0 +1,229 @@
+#
+# Makefile.fpc for Free Pascal EMX RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0 prt1
+units=$(SYSTEMUNIT) objpas macpas strings \
+ ports os2def doscalls moncalls kbdcalls moucalls viocalls \
+ pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi \
+ dos crt objects printer matrix \
+ sysutils classes math typinfo varutils winsock \
+ charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs \
+ video mouse keyboard variants types rtlconst sysconst dateutil \
+ strutils convutil ctypes
+rsts=math varutils typinfo variants pmhelp classes sysconst dateutil
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=emx
+cpu=i386
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(OS2INC)
+sourcedir=$(INC) $(PROCINC) $(OS2INC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+OS2INC=$(RTL)/os2
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysemx
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+%$(OEXT) : %.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)$*$(OEXT) $*.as
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pas
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+doscalls$(PPUEXT) : $(OS2INC)/doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+kbdcalls$(PPUEXT) : $(OS2INC)/kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+
+moucalls$(PPUEXT) : $(OS2INC)/moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+
+moncalls$(PPUEXT) : $(OS2INC)/moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+os2def$(PPUEXT) : $(OS2INC)/os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+
+pmwin$(PPUEXT) : $(OS2INC)/pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmbitmap$(PPUEXT) : $(OS2INC)/pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+
+pmgpi$(PPUEXT) : $(OS2INC)/pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmstddlg$(PPUEXT) : $(OS2INC)/pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmhelp$(PPUEXT) : $(OS2INC)/pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmdev$(PPUEXT) : $(OS2INC)/pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmspl$(PPUEXT) : $(OS2INC)/pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmshl$(PPUEXT) : $(OS2INC)/pmshl.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmwp$(PPUEXT) : $(OS2INC)/pmwp.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmwsock$(PPUEXT) : $(OS2INC)/pmwsock.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+winsock$(PPUEXT) : $(OS2INC)/winsock.pas pmwsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmbidi$(PPUEXT) : $(OS2INC)/pmbidi.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : $(OS2INC)/printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+#graph$(PPUEXT) : graph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : $(OS2INC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(OS2INC)/classes.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OS2INC)/varutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+
+convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+# \ No newline at end of file
diff --git a/rtl/emx/crt.pas b/rtl/emx/crt.pas
new file mode 100644
index 0000000000..39dcad0365
--- /dev/null
+++ b/rtl/emx/crt.pas
@@ -0,0 +1,969 @@
+{****************************************************************************
+
+ $Id: crt.pas,v 1.6 2005/03/30 23:11:35 hajny Exp $
+
+ Standard CRT unit.
+ Free Pascal runtime library for EMX.
+ Copyright (c) 1997 Daniel Mantione.
+
+ This file may be reproduced and modified under the same conditions
+ as all other Free Pascal source code.
+
+****************************************************************************}
+
+unit crt;
+
+{$ASMMODE ATT}
+
+interface
+
+{$i crth.inc}
+
+{cemodeset means that the procedure textmode has failed to set up a mode.}
+
+type
+ cexxxx=(cenoerror,cemodeset);
+
+var
+ crt_error:cexxxx; {Crt-status. RW}
+
+{***************************************************************************}
+
+implementation
+
+{$i textrec.inc}
+
+const extkeycode:char=#0;
+
+var maxrows,maxcols:word;
+ calibration:longint;
+
+type Tkbdkeyinfo=record
+ charcode,scancode:char;
+ fbstatus,bnlsshift:byte;
+ fsstate:word;
+ time:longint;
+ end;
+
+ {if you have information on the folowing datastructure, please
+ send them to me at d.s.p.mantione@twi.tudelft.nl}
+
+ {This datastructure is needed when we ask in what video mode we are,
+ or we want to set up a new mode.}
+
+ viomodeinfo=record
+ cb:word; { length of the entire data
+ structure }
+ fbtype, { bit mask of mode being set}
+ color: byte; { number of colors (power of 2) }
+ col, { number of text columns }
+ row, { number of text rows }
+ hres, { horizontal resolution }
+ vres: word; { vertical resolution }
+ fmt_ID, { attribute format
+ ! more info wanted !}
+ attrib: byte; { number of attributes }
+ buf_addr, { physical address of
+ videobuffer, e.g. $0b800}
+ buf_length, { length of a videopage (bytes)}
+ full_length, { total video-memory on video-
+ card (bytes)}
+ partial_length:longint; { ????? info wanted !}
+ ext_data_addr:pointer; { ????? info wanted !}
+ end;
+ Pviomodeinfo=^viomodeinfo;
+
+ TVioCursorInfo=record
+ case boolean of
+ false:(
+ yStart:word; {Cursor start (top) scan line (0-based)}
+ cEnd:word; {Cursor end (bottom) scan line}
+ cx:word; {Cursor width (0=default width)}
+ Attr:word); {Cursor colour attribute (-1=hidden)}
+ true:(
+ yStartInt: integer; {integer variants can be used to specify negative}
+ cEndInt:integer; {negative values (interpreted as percentage by OS/2)}
+ cxInt:integer;
+ AttrInt:integer);
+ end;
+ PVioCursorInfo=^TVioCursorInfo;
+
+{EMXWRAP.DLL has strange calling conventions: All parameters must have
+ a 4 byte size.}
+
+function kbdcharin(var Akeyrec:Tkbdkeyinfo;wait,kbdhandle:longint):word; cdecl;
+ external 'EMXWRAP' index 204;
+function kbdpeek(var Akeyrec:TkbdkeyInfo;kbdhandle:word):word; cdecl;
+ external 'EMXWRAP' index 222;
+
+function dossleep(time:cardinal):cardinal; cdecl;
+ external 'DOSCALLS' index 229;
+function vioscrollup(top,left,bottom,right,lines:longint;
+ var screl:word;viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 107;
+function vioscrolldn(top,left,bottom,right,lines:longint;
+ var screl:word;viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 147;
+function viogetcurpos(var row,column:word;viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 109;
+function viosetcurpos(row,column,viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 115;
+function viowrtTTY(s:Pchar;len,viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 119;
+function viowrtcharstratt(s:Pchar;len,row,col:longint;var attr:byte;
+ viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 148;
+function viogetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 121;
+function viosetmode(var Amodeinfo:viomodeinfo;viohandle:longint):word; cdecl;
+ external 'EMXWRAP' index 122;
+function VioSetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 132;
+{external 'VIOCALLS' index 32;}
+function VioGetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 127;
+{external 'VIOCALLS' index 27;}
+
+procedure syscall;external name '___SYSCALL';
+
+
+procedure setscreenmode(mode:word);
+
+{ This procedure sets a new videomode. Note that the constants passes to
+ this procedure are different than in the dos mode.}
+
+const modecols:array[0..2] of word=(40,80,132);
+ moderows:array[0..3] of word=(25,28,43,50);
+
+var newmode:viomodeinfo;
+
+begin
+ if os_mode=osOS2 then
+ begin
+ newmode.cb:=8;
+ newmode.fbtype:=1; {Non graphics colour mode.}
+ newmode.color:=4; {We want 16 colours, 2^4=16.}
+ newmode.col:=modecols[mode and 15];
+ newmode.row:=moderows[mode shr 4];
+ if viosetmode(newmode,0)=0 then
+ crt_error:=cenoerror
+ else
+ crt_error:=cemodeset;
+ maxcols:=newmode.col;
+ maxrows:=newmode.row;
+ end
+ else
+ begin
+ maxcols:=modecols[mode and 15];
+ maxrows:=moderows[mode shr 4];
+ crt_error:=cenoerror;
+ {Set correct vertical resolution.}
+ asm
+ movw $0x1202,%ax
+ movw 8(%ebp),%bx
+ shrw $4,%bx
+ cmpb $2,%bl
+ jne .L_crtsetmode_a1
+ decw %ax
+ .L_crtsetmode_a1:
+ mov $0x30,%bl
+ int $0x10
+ end;
+ {132 column mode in DOS is videocard dependend.}
+ if mode and 15=2 then
+ begin
+ crt_error:=cemodeset;
+ exit;
+ end;
+ {Switch to correct mode.}
+ asm
+ mov 8(%ebp),%bx
+ and $15,%bl
+ mov $1,%ax
+ cmp $1,%bl
+ jne .L_crtsetmode_b1
+ mov $3,%al
+ .L_crtsetmode_b1:
+ int $0x10
+ {Use alternate print-screen function.}
+ mov $0x12,%ah
+ mov $0x20,%bl
+ int $0x10
+ end;
+ {Set correct font.}
+ case mode shr 4 of
+ 1:
+ {Set 8x14 font.}
+ asm
+ mov $0x1111,%ax
+ mov $0,%bl
+ int $0x10
+ end;
+ 2,3:
+ {Set 8x8 font.}
+ asm
+ mov $0x1112,%ax
+ mov $0,%bl
+ int $0x10
+ end;
+ end;
+ end;
+end;
+
+procedure getcursor(var y,x:word);
+
+{Get the cursor position.}
+
+begin
+ if os_mode=osOS2 then
+ viogetcurpos(y,x,0)
+ else
+ asm
+ movb $3,%ah
+ movb $0,%bh
+ int $0x10
+ movl y,%eax
+ movl x,%ebx
+ movzbl %dh,%edi
+ andw $255,%dx
+ movw %di,(%eax)
+ movw %dx,(%ebx)
+ end;
+end;
+
+{$ASMMODE INTEL}
+procedure setcursor(y,x:word);
+
+{Set the cursor position.}
+
+begin
+ if os_mode=osOS2 then
+ viosetcurpos(y,x,0)
+ else
+ asm
+ mov ah, 2
+ mov bh, 0
+ mov dh, byte ptr y
+ mov dl, byte ptr x
+ int 10h
+ end;
+end;
+
+procedure scroll_up(top,left,bottom,right,lines:word;var screl:word);
+
+begin
+ if os_mode=osOS2 then
+ vioscrollup(top,left,bottom,right,lines,screl,0)
+ else
+ asm
+ mov ah, 6
+ mov al, byte ptr lines
+ mov edi, screl
+ mov bh, [edi + 1]
+ mov ch, byte ptr top
+ mov cl, byte ptr left
+ mov dh, byte ptr bottom
+ mov dl, byte ptr right
+ int 10h
+ end;
+end;
+
+procedure scroll_dn(top,left,bottom,right,lines:word;var screl:word);
+
+begin
+ if os_mode=osOS2 then
+ vioscrolldn(top,left,bottom,right,lines,screl,0)
+ else
+ asm
+ mov ah, 7
+ mov al, byte ptr lines
+ mov edi, screl
+ mov bh, [edi + 1]
+ mov ch, byte ptr top
+ mov cl, byte ptr left
+ mov dh, byte ptr bottom
+ mov dl, byte ptr right
+ int 10h
+ end;
+end;
+
+{$ASMMODE ATT}
+function keypressed:boolean;
+
+{Checks if a key is pressed.}
+
+var Akeyrec:Tkbdkeyinfo;
+
+begin
+ if os_mode=osOS2 then
+ begin
+ kbdpeek(Akeyrec,0);
+ keypressed:=(extkeycode<>#0) or ((Akeyrec.fbstatus and $40)<>0);
+ end
+ else
+ begin
+ if extkeycode<>#0 then
+ begin
+ keypressed:=true;
+ exit
+ end
+ else
+ asm
+ movb $1,%ah
+ int $0x16
+ setnz %al
+ movb %al,__RESULT
+ end;
+ end;
+end;
+
+function readkey:char;
+
+{Reads the next character from the keyboard.}
+
+var Akeyrec:Tkbdkeyinfo;
+ c,s:char;
+
+begin
+ if extkeycode<>#0 then
+ begin
+ readkey:=extkeycode;
+ extkeycode:=#0
+ end
+ else
+ begin
+ if os_mode=osOS2 then
+ begin
+ kbdcharin(Akeyrec,0,0);
+ c:=Akeyrec.charcode;
+ s:=Akeyrec.scancode;
+ if (c=#224) and (s<>#0) then
+ c:=#0;
+ end
+ else
+ begin
+ asm
+ movb $0,%ah
+ int $0x16
+ movb %al,c
+ movb %ah,s
+ end;
+ end;
+ if c=#0 then
+ extkeycode:=s;
+ readkey:=c;
+ end;
+end;
+
+procedure clrscr;
+
+{Clears the current window.}
+
+var screl:word;
+
+begin
+ screl:=$20+textattr shl 8;
+ scroll_up(hi(windmin),lo(windmin),
+ hi(windmax),lo(windmax),
+ hi(windmax)-hi(windmin)+1,
+ screl);
+ gotoXY(1,1);
+end;
+
+procedure gotoXY(x,y:byte);
+
+{Positions the cursor on (x,y) relative to the window origin.}
+
+begin
+ if x<1 then
+ x:=1;
+ if y<1 then
+ y:=1;
+ if y+hi(windmin)-2>=hi(windmax) then
+ y:=hi(windmax)-hi(windmin)+1;
+ if x+lo(windmin)-2>=lo(windmax) then
+ x:=lo(windmax)-lo(windmin)+1;
+ setcursor(y+hi(windmin)-1,x+lo(windmin)-1);
+end;
+
+function whereX:byte;
+
+{Returns the x position of the cursor.}
+
+var x,y:word;
+
+begin
+ getcursor(y,x);
+ whereX:=x-lo(windmin)+1;
+end;
+
+function whereY:byte;
+
+{Returns the y position of the cursor.}
+
+var x,y:word;
+
+begin
+ getcursor(y,x);
+ whereY:=y-hi(windmin)+1;
+end;
+
+procedure clreol;
+{Clear from current position to end of line.
+Contributed by Michail A. Baikov}
+
+var i:byte;
+
+begin
+ {not fastest, but compatible}
+ for i:=wherex to lo(windmax) do write(' ');
+ gotoxy(1,wherey); {may be not}
+end;
+
+
+procedure delline;
+
+{Deletes the line at the cursor.}
+
+var row,left,right,bot:longint;
+ fil:word;
+
+begin
+ row:=whereY;
+ left:=lo(windmin);
+ right:=lo(windmax);
+ bot:=hi(windmax)+1;
+ fil:=$20 or (textattr shl 8);
+ scroll_up(row+1,left,bot,right,1,fil);
+end;
+
+procedure insline;
+
+{Inserts a line at the cursor position.}
+
+var row,left,right,bot:longint;
+ fil:word;
+
+begin
+ row:=whereY;
+ left:=lo(windmin);
+ right:=lo(windmax);
+ bot:=hi(windmax);
+ fil:=$20 or (textattr shl 8);
+ scroll_dn(row,left,bot,right,1,fil);
+end;
+
+procedure textmode(mode:integer);
+
+{ Use this procedure to set-up a specific text-mode.}
+
+begin
+ textattr:=$07;
+ lastmode:=mode;
+ mode:=mode and $ff;
+ setscreenmode(mode);
+ windmin:=0;
+ windmax:=(maxcols-1) or ((maxrows-1) shl 8);
+ clrscr;
+end;
+
+procedure textcolor(color:byte);
+
+{All text written after calling this will have color as foreground colour.}
+
+begin
+ textattr:=(textattr and $70) or (color and $f)+color and 128;
+end;
+
+procedure textbackground(color:byte);
+
+{All text written after calling this will have colour as background colour.}
+
+begin
+ textattr:=(textattr and $8f) or ((color and $7) shl 4);
+end;
+
+procedure normvideo;
+
+{Changes the text-background to black and the foreground to white.}
+
+begin
+ textattr:=$7;
+end;
+
+procedure lowvideo;
+
+{All text written after this will have low intensity.}
+
+begin
+ textattr:=textattr and $f7;
+end;
+
+procedure highvideo;
+
+{All text written after this will have high intensity.}
+
+begin
+ textattr:=textattr or $8;
+end;
+
+procedure delay(ms:word);
+
+var i,j:longint;
+
+{Waits ms microseconds. The DOS code is copied from the DOS rtl.}
+
+begin
+ {Under OS/2 we could also calibrate like under DOS. But this is
+ unreliable, because OS/2 can hold our programs while calibrating,
+ if it needs the processor for other things.}
+ if os_mode=osOS2 then
+ dossleep(ms)
+ else
+ begin
+ for i:=1 to ms do
+ for j:=1 to calibration do
+ begin
+ end;
+ end;
+end;
+
+procedure window(X1,Y1,X2,Y2:byte);
+
+{Change the write window to the given coordinates.}
+
+begin
+ if (X1<1) or
+ (Y1<1) or
+ (X2>maxcols) or
+ (Y2>maxrows) or
+ (X1>X2) or
+ (Y1>Y2) then
+ exit;
+ windmin:=(X1-1) or ((Y1-1) shl 8);
+ windmax:=(X2-1) or ((Y2-1) shl 8);
+ gotoXY(1,1);
+end;
+
+{$ASMMODE INTEL}
+procedure writePchar(s:Pchar;len:word);
+
+{Write a series of characters to the screen.
+
+ Not very fast, but is just text-mode isn't it?}
+
+var x,y:word;
+ c:char;
+ i,n:integer;
+ screl:word;
+ ca:Pchar;
+
+begin
+ i:=0;
+ getcursor(y,x);
+ while i<=len-1 do
+ begin
+ case s[i] of
+ #7: asm
+ mov dl, 7
+ mov ah, 2
+ call syscall
+ end;
+ #8: if X > Succ (Lo (WindMin)) then Dec (X);
+ { #9: x:=(x-lo(windmin)) and $fff8+8+lo(windmin);}
+ #10: inc(y);
+ #13: x:=lo(windmin);
+ else
+ begin
+ ca:=@s[i];
+ n:=1;
+ while not(s[i+1] in [#7,#8,#10,#13]) and
+{ (x+n<=lo(windmax)+1) and (i<len-1) do}
+ (x+n<=lo(windmax)) and (i<len-1) do
+ begin
+ inc(n);
+ inc(i);
+ end;
+ if os_mode=osOS2 then
+ viowrtcharstratt(ca,n,y,x,textattr,0)
+ else
+ asm
+ mov ax, 1300h
+ mov bh, 0
+ mov bl, TEXTATTR
+ mov dh, byte ptr y
+ mov dl, byte ptr x
+ mov cx, n
+ push ebp
+ mov ebp, ca
+ int 10h
+ pop ebp
+ end;
+ x:=x+n;
+ end;
+ end;
+ if x>lo(windmax) then
+ begin
+ x:=lo(windmin);
+ inc(y);
+ end;
+ if y>hi(windmax) then
+ begin
+ screl:=$20+textattr shl 8;
+ scroll_up(hi(windmin),lo(windmin),
+ hi(windmax),lo(windmax),
+ 1,screl);
+ y:=hi(windmax);
+ end;
+{ writeln(stderr,x,' ',y);}
+ inc(i);
+ end;
+ setcursor(y,x);
+end;
+
+{$ASMMODE ATT}
+function crtread(var f:textrec):word;
+
+{Read a series of characters from the console.}
+
+var max,curpos:integer;
+ c:char;
+ clist:array[0..2] of char;
+
+begin
+ max:=f.bufsize-2;
+ curpos:=0;
+ repeat
+ c:=readkey;
+ case c of
+ #0:
+ readkey;
+ #8:
+ if curpos>0 then
+ begin
+ clist:=#8' '#8;
+ writePchar(@clist,3);
+ dec(curpos);
+ end;
+ #13:
+ begin
+ f.bufptr^[curpos]:=#13;
+ inc(curpos);
+ f.bufptr^[curpos]:=#10;
+ inc(curpos);
+ f.bufpos:=0;
+ f.bufend:=curpos;
+ clist[0]:=#13;
+ writePchar(@clist,1);
+ break;
+ end;
+ #32..#255:
+ if curpos<max then
+ begin
+ f.bufptr^[curpos]:=c;
+ inc(curpos);
+ writePchar(@c,1);
+ end;
+ end;
+ until false;
+ crtread:=0;
+end;
+
+function crtwrite(var f:textrec):word;
+
+{Write a series of characters to the console.}
+
+begin
+ writePchar(Pchar(f.bufptr),f.bufpos);
+ f.bufpos:=0;
+ crtwrite:=0;
+end;
+
+
+function crtopen(var f:textrec):integer;
+
+begin
+ if f.mode=fmoutput then
+ crtopen:=0
+ else
+ crtopen:=5;
+end;
+
+function crtinout(var f:textrec):integer;
+
+begin
+ case f.mode of
+ fminput:
+ crtinout:=crtread(f);
+ fmoutput:
+ crtinout:=crtwrite(f);
+ end;
+end;
+
+function crtclose(var f:textrec):integer;
+
+begin
+ f.mode:=fmclosed;
+ crtclose:=0;
+end;
+
+procedure assigncrt(var f:text);
+
+{Assigns a file to the crt console.}
+
+begin
+ textrec(f).mode:=fmclosed;
+ textrec(f).bufsize:=128;
+ textrec(f).bufptr:=@textrec(f).buffer;
+ textrec(f).bufpos:=0;
+ textrec(f).openfunc:=@crtopen;
+ textrec(f).inoutfunc:=@crtinout;
+ textrec(f).flushfunc:=@crtinout;
+ textrec(f).closefunc:=@crtclose;
+ textrec(f).name[0]:='.';
+ textrec(f).name[0]:=#0;
+end;
+
+procedure sound(hz:word);
+
+{sound and nosound are not implemented because the OS/2 API supports a freq/
+ duration procedure instead of start/stop procedures.}
+
+begin
+end;
+
+procedure nosound;
+
+begin
+end;
+
+function get_ticks:word;
+
+type Pword=^word;
+
+begin
+ get_ticks:=Pword(longint(first_meg)+$46c)^;
+end;
+
+procedure initdelay;
+
+{Calibrate the delay procedure. Copied from DOS rtl.}
+
+var first:word;
+
+begin
+ calibration:=0;
+
+ { wait for new tick }
+ first:=get_ticks;
+ while get_ticks=first do
+ begin
+ end;
+ first:=get_ticks;
+
+ { this estimates calibration }
+ while get_ticks=first do
+ inc(calibration);
+
+ { calculate this to ms }
+ calibration:=calibration div 70;
+ while true do
+ begin
+ first:=get_ticks;
+ while get_ticks=first do
+ begin
+ end;
+ first:=get_ticks;
+ delay(55);
+ if first=get_ticks then
+ exit
+ else
+ begin
+ { decrement calibration two percent }
+ calibration:=calibration-calibration div 50;
+ dec(calibration);
+ end;
+ end;
+end;
+
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+
+{$ASMMODE INTEL}
+procedure CursorOn;
+var
+ I: TVioCursorInfo;
+begin
+ if Os_Mode = osOS2 then
+ begin
+ VioGetCurType (I, 0);
+ with I do
+ begin
+ yStartInt := -90;
+ cEndInt := -100;
+ Attr := 15;
+ end;
+ VioSetCurType (I, 0);
+ end
+ else
+ asm
+ push es
+ push bp
+ mov ax, 1130h
+ mov bh, 0
+ mov ecx, 0
+ int 10h
+ pop bp
+ pop es
+ or ecx, ecx
+ jnz @COnOld
+ mov cx, 0707h
+ jmp @COnAll
+@COnOld:
+ dec cx
+ mov ch, cl
+ dec ch
+@COnAll:
+ mov ah, 1
+ int 10h
+ end;
+end;
+
+
+procedure CursorOff;
+var
+ I: TVioCursorInfo;
+begin
+ if Os_Mode = osOS2 then
+ begin
+ VioGetCurType (I, 0);
+ I.AttrInt := -1;
+ VioSetCurType (I, 0);
+ end
+ else
+ asm
+ mov ah, 1
+ mov cx, 0FFFFh
+ int 10h
+ end;
+end;
+
+
+procedure CursorBig;
+var
+ I: TVioCursorInfo;
+begin
+ if Os_Mode = osOS2 then
+ begin
+ VioGetCurType (I, 0);
+ with I do
+ begin
+ yStart := 0;
+ cEndInt := -100;
+ Attr := 15;
+ end;
+ VioSetCurType (I, 0);
+ end
+ else
+ asm
+ mov ah, 1
+ mov cx, 1Fh
+ int 10h
+ end;
+end;
+
+{$ASMMODE DEFAULT}
+
+
+
+{Initialization.}
+
+type Pbyte=^byte;
+
+var curmode:viomodeinfo;
+ mode:byte;
+
+begin
+ textattr:=lightgray;
+ if os_mode=osOS2 then
+ begin
+ curmode.cb:=sizeof(curmode);
+ viogetmode(curmode,0);
+ maxcols:=curmode.col;
+ maxrows:=curmode.row;
+ lastmode:=0;
+ case maxcols of
+ 40:
+ lastmode:=0;
+ 80:
+ lastmode:=1;
+ 132:
+ lastmode:=2;
+ end;
+ case maxrows of
+ 25:;
+ 28:
+ lastmode:=lastmode+16;
+ 43:
+ lastmode:=lastmode+32;
+ 50:
+ lastmode:=lastmode+48;
+ end
+ end
+ else
+ begin
+ {Request video mode to determine columns.}
+ asm
+ mov $0x0f,%ah
+ int $0x10
+{ mov %al,_MODE }
+ mov %al,MODE
+ end;
+ case mode of
+ 0,1:
+ begin
+ lastmode:=0;
+ maxcols:=40;
+ end;
+ else
+ begin
+ lastmode:=1;
+ maxcols:=80;
+ end;
+ end;
+ {Get number of rows from realmode $0040:$0084.}
+ maxrows:=Pbyte(longint(first_meg)+$484)^;
+ case maxrows of
+ 25:;
+ 28:
+ lastmode:=lastmode+16;
+ 43:
+ lastmode:=lastmode+32;
+ 50:
+ lastmode:=lastmode+48;
+ end
+ end;
+ windmin:=0;
+ windmax:=((maxrows-1) shl 8) or (maxcols-1);
+ if os_mode <> osOS2 then
+ initdelay;
+ crt_error:=cenoerror;
+ assigncrt(input);
+ textrec(input).mode:=fminput;
+ assigncrt(output);
+ textrec(output).mode:=fmoutput;
+end.
+
+{
+ $Log: crt.pas,v $
+ Revision 1.6 2005/03/30 23:11:35 hajny
+ * OS/2 fixes merged to EMX
+
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/emx/dos.pas b/rtl/emx/dos.pas
new file mode 100644
index 0000000000..ed74fcf354
--- /dev/null
+++ b/rtl/emx/dos.pas
@@ -0,0 +1,1086 @@
+{****************************************************************************
+
+ $Id: dos.pas,v 1.17 2005/02/14 17:13:22 peter Exp $
+
+ Free Pascal Runtime-Library
+ DOS unit for EMX
+ Copyright (c) 1997,1999-2000 by Daniel Mantione,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+
+unit dos;
+
+{$ASMMODE ATT}
+
+{***************************************************************************}
+
+interface
+
+{***************************************************************************}
+
+{$PACKRECORDS 1}
+
+uses Strings, DosCalls;
+
+Type
+ {Search record which is used by findfirst and findnext:}
+ searchrec=record
+ case boolean of
+ false: (handle:THandle; {Used in os_OS2 mode}
+ FStat:PFileFindBuf3;
+ fill2:array[1..21-SizeOf(THandle)-SizeOf(pointer)] of byte;
+ attr2:byte;
+ time2:longint;
+ size2:longint;
+ name2:string); {Filenames can be long in OS/2!}
+ true: (fill:array[1..21] of byte;
+ attr:byte;
+ time:longint;
+ size:longint;
+ name:string); {Filenames can be long in OS/2!}
+ end;
+
+{$i dosh.inc}
+
+ {Flags for the exec procedure:
+
+ Starting the program:
+ efwait: Wait until program terminates.
+ efno_wait: Don't wait until the program terminates. Does not work
+ in dos, as DOS cannot multitask.
+ efoverlay: Terminate this program, then execute the requested
+ program. WARNING: Exit-procedures are not called!
+ efdebug: Debug program. Details are unknown.
+ efsession: Do not execute as child of this program. Use a seperate
+ session instead.
+ efdetach: Detached. Function unknown. Info wanted!
+ efpm: Run as presentation manager program.
+
+ Not found info about execwinflags
+
+ Determining the window state of the program:
+ efdefault: Run the pm program in it's default situation.
+ efminimize: Run the pm program minimized.
+ efmaximize: Run the pm program maximized.
+ effullscreen: Run the non-pm program fullscreen.
+ efwindowed: Run the non-pm program in a window.
+
+}
+const
+ efWait = 0; (* Spawn child, wait until terminated *)
+ efNo_Wait = 1; (* Not implemented according to EMX documentation! *)
+ efOverlay = 2; (* Exec child, kill current process *)
+ efDebug = 3; (* Debug child - use with ptrace syscall *)
+ efSession = 4; (* Run in a separate session *)
+ efDetach = 5; (* Run detached *)
+ efPM = 6; (* Run as a PM program *)
+
+ efDefault = 0;
+ efMinimize = $100;
+ efMaximize = $200;
+ efFullScreen = $300;
+ efWindowed = $400;
+ efBackground = $1000;
+ efNoClose = $2000;
+ efNoSession = $4000;
+ efMoreFlags = $8000; (* Needed if any flags > $FFFF are supplied *)
+ efQuote = $10000;
+ efTilde = $20000;
+ efDebugDesc = $40000;
+
+
+{OS/2 specific functions}
+
+function GetEnvPChar (EnvVar: string): PChar;
+
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+(* For compatibility with VP/2, used for runflags in Exec procedure. *)
+ ExecFlags: cardinal;
+
+
+
+implementation
+
+{$DEFINE HAS_INTR}
+{$DEFINE HAS_SETVERIFY}
+{$DEFINE HAS_GETVERIFY}
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+const
+ LFNSupport = true;
+
+{$I dos.inc}
+
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ LastSR: SearchRec;
+
+var
+ EnvC: longint; external name '_envc';
+ EnvP: ppchar; external name '_environ';
+
+type
+ TBA = array [1..SizeOf (SearchRec)] of byte;
+ PBA = ^TBA;
+
+const
+ FindResvdMask = $00003737; {Allowed bits in attribute
+ specification for DosFindFirst call.}
+
+
+{Import syscall to call it nicely from assembler procedures.}
+
+procedure syscall;external name '___SYSCALL';
+
+
+function fsearch(path:pathstr;dirlist:string):pathstr;
+
+var i,p1:longint;
+ newdir:pathstr;
+
+{$ASMMODE INTEL}
+function CheckFile (FN: ShortString):boolean; assembler;
+asm
+{$IFDEF REGCALL}
+ mov edx, eax
+{$ELSE REGCALL}
+ mov edx, FN { get pointer to string }
+{$ENDIF REGCALL}
+ inc edx { avoid length byte }
+ mov ax, 4300h
+ call syscall
+ mov ax, 0
+ jc @LCFstop
+ test cx, 18h
+ jnz @LCFstop
+ inc ax
+@LCFstop:
+end ['eax', 'ecx', 'edx'];
+{$ASMMODE ATT}
+
+begin
+{ check if the file specified exists }
+ if CheckFile (Path + #0) then
+ FSearch := Path
+ else
+ begin
+ {No wildcards allowed in these things:}
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow slash as backslash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='/' then dirlist[i]:='\';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and
+ not (newdir[length(newdir)] in ['\',':']) then
+ newdir:=newdir+'\';
+ if CheckFile (NewDir + Path + #0) then
+ NewDir := NewDir + Path
+ else
+ NewDir := '';
+ until (DirList = '') or (NewDir <> '');
+ FSearch := NewDir;
+ end;
+ end;
+end;
+
+
+procedure GetFTime (var F; var Time: longint); assembler;
+asm
+ pushl %ebx
+ {Load handle}
+{$IFDEF REGCALL}
+ movl %eax,%ebx
+ pushl %edx
+{$ELSE REGCALL}
+ movl F,%ebx
+{$ENDIF REGCALL}
+ movl (%ebx),%ebx
+ {Get date}
+ movw $0x5700,%ax
+ call syscall
+ shll $16,%edx
+ movw %cx,%dx
+{$IFDEF REGCALL}
+ popl %ebx
+{$ELSE REGCALL}
+ movl Time,%ebx
+{$ENDIF REGCALL}
+ movl %edx,(%ebx)
+ movw %ax,DosError
+ popl %ebx
+end {['eax', 'ecx', 'edx']};
+
+
+procedure SetFTime (var F; Time: longint);
+
+var FStat: TFileStatus3;
+ RC: cardinal;
+
+begin
+ if os_mode = osOS2 then
+ begin
+ RC := DosQueryFileInfo (FileRec (F).Handle, ilStandard, @FStat,
+ SizeOf (FStat));
+ if RC = 0 then
+ begin
+ FStat.DateLastAccess := Hi (Time);
+ FStat.DateLastWrite := Hi (Time);
+ FStat.TimeLastAccess := Lo (Time);
+ FStat.TimeLastWrite := Lo (Time);
+ RC := DosSetFileInfo (FileRec (F).Handle, ilStandard,
+ @FStat, SizeOf (FStat));
+ end;
+ DosError := integer (RC);
+ end
+ else
+ asm
+ pushl %ebx
+ {Load handle}
+ movl f,%ebx
+ movl (%ebx),%ebx
+ movl time,%ecx
+ shldl $16,%ecx,%edx
+ {Set date}
+ movw $0x5701,%ax
+ call syscall
+ movw %ax,doserror
+ popl %ebx
+ end ['eax', 'ecx', 'edx'];
+end;
+
+
+procedure Intr (IntNo: byte; var Regs: Registers);
+
+{Not recommended for EMX. Only works in DOS mode, not in OS/2 mode.}
+
+begin
+ if os_mode = osos2 then exit;
+ asm
+ jmp .Lstart
+{ .data}
+.Lint86:
+ .byte 0xcd
+.Lint86_vec:
+ .byte 0x03
+ jmp .Lint86_retjmp
+
+{ .text}
+.Lstart:
+ movb intno,%al
+ movb %al,.Lint86_vec
+
+{
+ movl 10(%ebp),%eax
+ incl %eax
+ incl %eax
+}
+ movl regs,%eax
+ {Do not use first int}
+ movl 4(%eax),%ebx
+ movl 8(%eax),%ecx
+ movl 12(%eax),%edx
+ movl 16(%eax),%ebp
+ movl 20(%eax),%esi
+ movl 24(%eax),%edi
+ movl (%eax),%eax
+
+ jmp .Lint86
+.Lint86_retjmp:
+ pushf
+ pushl %ebp
+ pushl %eax
+ movl %esp,%ebp
+ {Calc EBP new}
+ addl $12,%ebp
+{
+ movl 10(%ebp),%eax
+ incl %eax
+ incl %eax
+}
+ {Do not use first int}
+ movl regs,%eax
+
+ popl (%eax)
+ movl %ebx,4(%eax)
+ movl %ecx,8(%eax)
+ movl %edx,12(%eax)
+ {Restore EBP}
+ popl %edx
+ movl %edx,16(%eax)
+ movl %esi,20(%eax)
+ movl %edi,24(%eax)
+ {Ignore ES and DS}
+ popl %ebx {Flags.}
+ movl %ebx,32(%eax)
+ {FS and GS too}
+ end ['eax','ebx','ecx','edx','esi','edi'];
+end;
+
+
+procedure exec(const path:pathstr;const comline:comstr);
+
+{Execute a program.}
+
+type bytearray=array[0..8191] of byte;
+ Pbytearray=^bytearray;
+
+ execstruc=packed record
+ argofs : pointer; { pointer to arguments (offset) }
+ envofs : pointer; { pointer to environment (offset) }
+ nameofs: pointer; { pointer to file name (offset) }
+ argseg : word; { pointer to arguments (selector) }
+ envseg : word; { pointer to environment (selector}
+ nameseg: word; { pointer to file name (selector) }
+ numarg : word; { number of arguments }
+ sizearg : word; { size of arguments }
+ numenv : word; { number of env strings }
+ sizeenv:word; { size of environment }
+ mode:word; { mode word }
+ end;
+
+var args:Pbytearray;
+ env:Pbytearray;
+ Path2:PByteArray;
+ i,argsize:word;
+ es:execstruc;
+ esadr:pointer;
+ d:dirstr;
+ n:namestr;
+ e:extstr;
+ p : ppchar;
+ j : integer;
+const
+ ArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
+
+begin
+ getmem(args,ArgsSize);
+ GetMem(env, envc*sizeof(pchar)+16384);
+ GetMem (Path2, 260);
+ {Now setup the arguments. The first argument should be the program
+ name without directory and extension.}
+ fsplit(path,d,n,e);
+ es.numarg:=1;
+ args^[0]:=$80;
+ argsize:=1;
+ for i:=1 to length(n) do
+ begin
+ args^[argsize]:=byte(n[i]);
+ inc(argsize);
+ end;
+ args^[argsize]:=0;
+ inc(argsize);
+ {Now do the real arguments.}
+ i:=1;
+ while i<=length(comline) do
+ begin
+ if comline[i]<>' ' then
+ begin
+ {Commandline argument found. Copy it.}
+ inc(es.numarg);
+ args^[argsize]:=$80;
+ inc(argsize);
+ while (i<=length(comline)) and (comline[i]<>' ') do
+ begin
+ args^[argsize]:=byte(comline[i]);
+ inc(argsize);
+ inc(i);
+ end;
+ args^[argsize]:=0;
+ inc(argsize);
+ end;
+ inc(i);
+ end;
+ args^[argsize]:=0;
+ inc(argsize);
+
+ {Commandline ready, now build the environment.
+
+ Oh boy, I always had the opinion that executing a program under Dos
+ was a hard job!}
+
+ asm
+ movl env,%edi {Setup destination pointer.}
+ movl envc,%ecx {Load number of arguments in edx.}
+ movl envp,%esi {Load env. strings.}
+ xorl %edx,%edx {Count environment size.}
+.Lexa1:
+ lodsl {Load a Pchar.}
+ xchgl %eax,%ebx
+.Lexa2:
+ movb (%ebx),%al {Load a byte.}
+ incl %ebx {Point to next byte.}
+ stosb {Store it.}
+ incl %edx {Increase counter.}
+ cmpb $0,%al {Ready ?.}
+ jne .Lexa2
+ loop .Lexa1 {Next argument.}
+ stosb {Store an extra 0 to finish. (AL is now 0).}
+ incl %edx
+ movw %dx,ES.SizeEnv {Store environment size.}
+ end ['eax','ebx','ecx','edx','esi','edi'];
+
+ {Environment ready, now set-up exec structure.}
+ es.argofs:=args;
+ es.envofs:=env;
+ es.numenv:=envc;
+ Move (Path [1], Path2^, Length (Path));
+ Path2^ [Length (Path)] := 0;
+ es.nameofs := Path2;
+ asm
+ movw %ss,es.argseg
+ movw %ss,es.envseg
+ movw %ss,es.nameseg
+ end;
+ es.sizearg:=argsize;
+ es.mode := word (ExecFlags);
+
+ {Now exec the program.}
+ asm
+ leal es,%edx
+ movw $0x7f06,%ax
+ call syscall
+ movl $0,%edi
+ jnc .Lexprg1
+ xchgl %eax,%edi
+ xorl %eax,%eax
+ .Lexprg1:
+ movw %di,doserror
+ movl %eax, LastDosExitCode
+ end ['eax', 'ebx', 'ecx', 'edx', 'esi', 'edi'];
+
+ FreeMem (Path2, 260);
+ FreeMem(env, envc*sizeof(pchar)+16384);
+ freemem(args,ArgsSize);
+ {Phew! That's it. This was the most sophisticated procedure to call
+ a system function I ever wrote!}
+end;
+
+
+function dosversion:word;assembler;
+
+{Returns DOS version in DOS and OS/2 version in OS/2}
+asm
+ movb $0x30,%ah
+ call syscall
+end ['eax'];
+
+
+procedure GetDate (var Year, Month, MDay, WDay: word);
+
+begin
+ asm
+ movb $0x2a, %ah
+ call syscall
+ xorb %ah, %ah
+ movl WDay, %edi
+ stosw
+ movl MDay, %edi
+ movb %dl, %al
+ stosw
+ movl Month, %edi
+ movb %dh, %al
+ stosw
+ movl Year, %edi
+ xchgw %ecx, %eax
+ stosw
+ end ['eax', 'ecx', 'edx'];
+end;
+
+
+{$asmmode intel}
+procedure SetDate (Year, Month, Day: word);
+var DT: TDateTime;
+begin
+ if os_mode = osOS2 then
+ begin
+ DosGetDateTime (DT);
+ DT.Year := Year;
+ DT.Month := byte (Month);
+ DT.Day := byte (Day);
+ DosSetDateTime (DT);
+ end
+ else
+ asm
+ mov cx, Year
+ mov dh, byte ptr Month
+ mov dl, byte ptr Day
+ mov ah, 2Bh
+ call syscall
+ end ['eax', 'ecx', 'edx'];
+end;
+{$asmmode att}
+
+
+procedure GetTime (var Hour, Minute, Second, Sec100: word);
+{$IFDEF REGCALL}
+begin
+{$ELSE REGCALL}
+ assembler;
+{$ENDIF REGCALL}
+asm
+ movb $0x2c, %ah
+ call syscall
+ xorb %ah, %ah
+ movl Sec100, %edi
+ movb %dl, %al
+ stosw
+ movl Second, %edi
+ movb %dh,%al
+ stosw
+ movl Minute, %edi
+ movb %cl,%al
+ stosw
+ movl Hour, %edi
+ movb %ch,%al
+ stosw
+{$IFDEF REGCALL}
+ end ['eax', 'ecx', 'edx'];
+end;
+{$ELSE REGCALL}
+end {['eax', 'ecx', 'edx']};
+{$ENDIF REGCALL}
+
+
+{$asmmode intel}
+procedure SetTime (Hour, Minute, Second, Sec100: word);
+var DT: TDateTime;
+begin
+ if os_mode = osOS2 then
+begin
+ DosGetDateTime (DT);
+ DT.Hour := byte (Hour);
+ DT.Minute := byte (Minute);
+ DT.Second := byte (Second);
+ DT.Sec100 := byte (Sec100);
+ DosSetDateTime (DT);
+ end
+ else
+ asm
+ mov ch, byte ptr Hour
+ mov cl, byte ptr Minute
+ mov dh, byte ptr Second
+ mov dl, byte ptr Sec100
+ mov ah, 2Dh
+ call syscall
+ end ['eax', 'ecx', 'edx'];
+end;
+
+{$asmmode att}
+
+
+procedure getverify(var verify:boolean);
+
+begin
+ {! Do not use in OS/2.}
+ if os_mode in [osDOS,osDPMI] then
+ asm
+ movb $0x54,%ah
+ call syscall
+ movl verify,%edi
+ stosb
+ end ['eax', 'edi']
+ else
+ verify := true;
+end;
+
+procedure setverify(verify:boolean);
+
+begin
+ {! Do not use in OS/2!}
+ if os_mode in [osDOS,osDPMI] then
+ asm
+ movb verify,%al
+ movb $0x2e,%ah
+ call syscall
+ end ['eax'];
+ end;
+
+
+function DiskFree (Drive: byte): int64;
+
+var FI: TFSinfo;
+ RC: cardinal;
+
+begin
+ if (os_mode = osDOS) or (os_mode = osDPMI) then
+ {Function 36 is not supported in OS/2.}
+ asm
+ pushl %ebx
+ movb Drive,%dl
+ movb $0x36,%ah
+ call syscall
+ cmpw $-1,%ax
+ je .LDISKFREE1
+ mulw %cx
+ mulw %bx
+ shll $16,%edx
+ movw %ax,%dx
+ movl $0,%eax
+ xchgl %edx,%eax
+ jmp .LDISKFREE2
+ .LDISKFREE1:
+ cltd
+ .LDISKFREE2:
+ popl %ebx
+ leave
+ ret
+ end ['eax', 'ecx', 'edx']
+ else
+ {In OS/2, we use the filesystem information.}
+ begin
+ RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskFree := int64 (FI.Free_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskFree := -1;
+end;
+end;
+
+function DiskSize (Drive: byte): int64;
+
+var FI: TFSinfo;
+ RC: cardinal;
+
+begin
+ if (os_mode = osDOS) or (os_mode = osDPMI) then
+ {Function 36 is not supported in OS/2.}
+ asm
+ pushl %ebx
+ movb Drive,%dl
+ movb $0x36,%ah
+ call syscall
+ movw %dx,%bx
+ cmpw $-1,%ax
+ je .LDISKSIZE1
+ mulw %cx
+ mulw %bx
+ shll $16,%edx
+ movw %ax,%dx
+ movl $0,%eax
+ xchgl %edx,%eax
+ jmp .LDISKSIZE2
+ .LDISKSIZE1:
+ cltd
+ .LDISKSIZE2:
+ popl %ebx
+ leave
+ ret
+ end ['eax', 'ecx', 'edx']
+ else
+ {In OS/2, we use the filesystem information.}
+begin
+ RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskSize := int64 (FI.Total_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskSize := -1;
+end;
+end;
+
+
+procedure SearchRec2DosSearchRec (var F: SearchRec);
+
+const NameSize = 255;
+
+var L, I: longint;
+
+begin
+ if os_mode <> osOS2 then
+ begin
+ I := 1;
+ while (I <= SizeOf (LastSR))
+ and (PBA (@F)^ [I] = PBA (@LastSR)^ [I]) do Inc (I);
+{ Raise "Invalid file handle" RTE if nested FindFirst calls were used. }
+ if I <= SizeOf (LastSR) then RunError (6);
+ l:=length(f.name);
+ for i:=1 to namesize do
+ f.name[i-1]:=f.name[i];
+ f.name[l]:=#0;
+ end;
+end;
+
+procedure DosSearchRec2SearchRec (var F: SearchRec);
+
+const NameSize=255;
+
+var L, I: longint;
+
+type TRec = record
+ T, D: word;
+ end;
+
+begin
+ if os_mode = osOS2 then with F do
+ begin
+ Name := FStat^.Name;
+ Size := FStat^.FileSize;
+ Attr := byte(FStat^.AttrFile and $FF);
+ TRec (Time).T := FStat^.TimeLastWrite;
+ TRec (Time).D := FStat^.DateLastWrite;
+ end else
+ begin
+ for i:=0 to namesize do
+ if f.name[i]=#0 then
+ begin
+ l:=i;
+ break;
+ end;
+ for i:=namesize-1 downto 0 do
+ f.name[i+1]:=f.name[i];
+ f.name[0]:=char(l);
+ Move (F, LastSR, SizeOf (LastSR));
+ end;
+end;
+
+
+ procedure _findfirst(path:pchar;attr:word;var f:searchrec);
+
+ begin
+ asm
+ pushl %esi
+ movl path,%edx
+ movw attr,%cx
+ {No need to set DTA in EMX. Just give a pointer in ESI.}
+ movl f,%esi
+ movb $0x4e,%ah
+ call syscall
+ jnc .LFF
+ movw %ax,doserror
+ .LFF:
+ popl %esi
+ end ['eax', 'ecx', 'edx'];
+ end;
+
+
+procedure FindFirst (const Path: PathStr; Attr: word; var F: SearchRec);
+
+
+var path0: array[0..255] of char;
+ Count: cardinal;
+
+begin
+ {No error.}
+ DosError := 0;
+ if os_mode = osOS2 then
+ begin
+ New (F.FStat);
+ F.Handle := THandle ($FFFFFFFF);
+ Count := 1;
+ DosError := integer (DosFindFirst (Path, F.Handle,
+ Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
+ Count, ilStandard));
+ if (DosError = 0) and (Count = 0) then DosError := 18;
+ end else
+ begin
+ strPcopy(path0,path);
+ _findfirst(path0,attr,f);
+ end;
+ DosSearchRec2SearchRec (F);
+end;
+
+ procedure _findnext(var f : searchrec);
+
+ begin
+ asm
+ pushl %esi
+ movl f,%esi
+ movb $0x4f,%ah
+ call syscall
+ jnc .LFN
+ movw %ax,doserror
+ .LFN:
+ popl %esi
+ end ['eax'];
+ end;
+
+
+procedure FindNext (var F: SearchRec);
+var Count: cardinal;
+
+begin
+ {No error}
+ DosError := 0;
+ SearchRec2DosSearchRec (F);
+ if os_mode = osOS2 then
+ begin
+ Count := 1;
+ DosError := integer (DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^),
+ Count));
+ if (DosError = 0) and (Count = 0) then DosError := 18;
+ end else _findnext (F);
+ DosSearchRec2SearchRec (F);
+end;
+
+
+procedure FindClose (var F: SearchRec);
+begin
+ if os_mode = osOS2 then
+ begin
+ if F.Handle <> THandle ($FFFFFFFF) then DosError := DosFindClose (F.Handle);
+ Dispose (F.FStat);
+end;
+end;
+
+
+function envcount:longint;assembler;
+asm
+ movl envc,%eax
+end ['EAX'];
+
+
+function envstr(index : longint) : string;
+
+var hp:Pchar;
+
+begin
+ if (index<=0) or (index>envcount) then
+ begin
+ envstr:='';
+ exit;
+ end;
+ hp:=EnvP[index-1];
+ envstr:=strpas(hp);
+end;
+
+
+function GetEnvPChar (EnvVar: string): PChar;
+(* The assembler version is more than three times as fast as Pascal. *)
+var
+ P: PChar;
+begin
+ EnvVar := UpCase (EnvVar);
+{$ASMMODE INTEL}
+ asm
+ cld
+ mov edi, Environment
+ lea esi, EnvVar
+ xor eax, eax
+ lodsb
+@NewVar:
+ cmp byte ptr [edi], 0
+ jz @Stop
+ push eax { eax contains length of searched variable name }
+ push esi { esi points to the beginning of the variable name }
+ mov ecx, -1 { our character ('=' - see below) _must_ be found }
+ mov edx, edi { pointer to beginning of variable name saved in edx }
+ mov al, '=' { searching until '=' (end of variable name) }
+ repne
+ scasb { scan until '=' not found }
+ neg ecx { what was the name length? }
+ dec ecx { corrected }
+ dec ecx { exclude the '=' character }
+ pop esi { restore pointer to beginning of variable name }
+ pop eax { restore length of searched variable name }
+ push eax { and save both of them again for later use }
+ push esi
+ cmp ecx, eax { compare length of searched variable name with name }
+ jnz @NotEqual { ... of currently found variable, jump if different }
+ xchg edx, edi { pointer to current variable name restored in edi }
+ repe
+ cmpsb { compare till the end of variable name }
+ xchg edx, edi { pointer to beginning of variable contents in edi }
+ jz @Equal { finish if they're equal }
+@NotEqual:
+ xor eax, eax { look for 00h }
+ mov ecx, -1 { it _must_ be found }
+ repne
+ scasb { scan until found }
+ pop esi { restore pointer to beginning of variable name }
+ pop eax { restore length of searched variable name }
+ jmp @NewVar { ... or continue with new variable otherwise }
+@Stop:
+ xor eax, eax
+ mov P, eax { Not found - return nil }
+ jmp @End
+@Equal:
+ pop esi { restore the stack position }
+ pop eax
+ mov P, edi { place pointer to variable contents in P }
+@End:
+ end ['eax','ecx','edx','esi','edi'];
+ GetEnvPChar := P;
+end;
+{$ASMMODE ATT}
+
+
+function GetEnv (EnvVar: string): string;
+begin
+ GetEnv := StrPas (GetEnvPChar (EnvVar));
+end;
+
+
+procedure getfattr(var f;var attr : word);
+ { Under EMX, this routine requires }
+ { the expanded path specification }
+ { otherwise it will not function }
+ { properly (CEC) }
+var
+ path: pathstr;
+ buffer:array[0..255] of char;
+begin
+ DosError := 0;
+ path:='';
+ path := StrPas(filerec(f).Name);
+ { Takes care of slash and backslash support }
+ path:=FExpand(path);
+ move(path[1],buffer,length(path));
+ buffer[length(path)]:=#0;
+ asm
+ pushl %ebx
+ movw $0x4300,%ax
+ leal buffer,%edx
+ call syscall
+ jnc .Lnoerror { is there an error ? }
+ movw %ax,doserror
+ .Lnoerror:
+ movl attr,%ebx
+ movw %cx,(%ebx)
+ popl %ebx
+ end ['eax', 'ecx', 'edx'];
+end;
+
+
+procedure setfattr(var f;attr : word);
+ { Under EMX, this routine requires }
+ { the expanded path specification }
+ { otherwise it will not function }
+ { properly (CEC) }
+var
+ path: pathstr;
+ buffer:array[0..255] of char;
+begin
+ path:='';
+ DosError := 0;
+ path := StrPas(filerec(f).Name);
+ { Takes care of slash and backslash support }
+ path:=FExpand(path);
+ move(path[1],buffer,length(path));
+ buffer[length(path)]:=#0;
+ asm
+ movw $0x4301,%ax
+ leal buffer,%edx
+ movw attr,%cx
+ call syscall
+ jnc .Lnoerror
+ movw %ax,doserror
+ .Lnoerror:
+ end ['eax', 'ecx', 'edx'];
+end;
+
+
+
+procedure InitEnvironment;
+var
+ cnt : integer;
+ ptr : pchar;
+ base : pchar;
+ i: integer;
+ PIB: PProcessInfoBlock;
+ TIB: PThreadInfoBlock;
+begin
+ { We need to setup the environment }
+ { only in the case of OS/2 }
+ { otherwise everything is in the stack }
+ if os_Mode in [OsDOS,osDPMI] then
+ exit;
+ cnt := 0;
+ { count number of environment pointers }
+ DosGetInfoBlocks (PPThreadInfoBlock (@TIB), PPProcessInfoBlock (@PIB));
+ ptr := pchar(PIB^.env);
+ { stringz,stringz...,#0 }
+ i := 0;
+ repeat
+ repeat
+ (inc(i));
+ until (ptr[i] = #0);
+ inc(i);
+ { here, it may be a double null, end of environment }
+ if ptr[i] <> #0 then
+ inc(cnt);
+ until (ptr[i] = #0);
+ { save environment count }
+ envc := cnt;
+ { got count of environment strings }
+ GetMem(envp, cnt*sizeof(pchar)+16384);
+ cnt := 0;
+ ptr := pchar(PIB^.env);
+ i:=0;
+ repeat
+ envp[cnt] := ptr;
+ Inc(cnt);
+ { go to next string ... }
+ repeat
+ inc(ptr);
+ until (ptr^ = #0);
+ inc(ptr);
+ until ptr^ = #0;
+ envp[cnt] := #0;
+end;
+
+
+procedure DoneEnvironment;
+begin
+ { it is allocated on the stack for DOS/DPMI }
+ if os_mode = osOs2 then
+ FreeMem(envp, envc*sizeof(pchar)+16384);
+end;
+
+var
+ oldexit : pointer;
+
+
+{******************************************************************************
+ --- Not Supported ---
+******************************************************************************}
+
+
+
+begin
+ oldexit:=exitproc;
+ exitproc:=@doneenvironment;
+ InitEnvironment;
+ LastDosExitCode := 0;
+ ExecFlags := 0;
+end.
+
+{
+ $Log: dos.pas,v $
+ Revision 1.17 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/emx/emx.imp b/rtl/emx/emx.imp
new file mode 100644
index 0000000000..bc1bffa388
--- /dev/null
+++ b/rtl/emx/emx.imp
@@ -0,0 +1,9 @@
+;
+; emx.imp
+;
+_emx_init emx 1 R
+_emx_syscall emx 2 R
+_emx_16to32 emx 3 1
+_emx_32to16 emx 4 1
+_emx_thunk1 emx 5 2
+_emx_exception emx 6 4
diff --git a/rtl/emx/emx.pas b/rtl/emx/emx.pas
new file mode 100644
index 0000000000..6df503f1b8
--- /dev/null
+++ b/rtl/emx/emx.pas
@@ -0,0 +1,73 @@
+{****************************************************************************
+
+EMX - Interface unit for the EMX dynamic runtime library.
+
+Part of Free Pascal runtime library for OS/2
+
+
+History:
+ 2 June 1997 : Creation.
+
+This unit is Copyright (c) 1999-2000 by Daniel Mantione.
+Free Pascal is Copyright (c) -1999-2000 by Florian Klaempfl.
+EMX.DLL is Copyright (c) -1999-2000 by Eberhard Mattes.
+
+Modifying this unit is allowed, under the following conditions:
+
+- You will not make anyone beleive that you or someone else wrote this.
+- Unless you are developing on the official version of FPC, you will make a
+ note in this file that it is not the original one.
+
+****************************************************************************}
+
+Unit emx;
+
+Interface
+
+{$Mode ObjFpc}
+
+{16:16 far pointer}
+type
+ Far16Ptr=record
+ Segment, Offset: Word;
+ end;
+
+{! Don't call this one. It is used by the startup code.}
+//procedure emxinit; cdecl;
+// external 'emx' index 1;
+
+{! Calling this is not recommended. Use ___syscall instead.}
+//procedure emx_syscall; cdecl;
+// external 'emx' index 2;
+
+{This one converts 16:16 far pointers to 32 bit flat ones.}
+function emx_16to32(APtr: Far16Ptr): pointer; cdecl;
+ external 'emx' index 3;
+
+{This one converts 32 bit flat pointers to 16:16 far ones.}
+function emx_32to16(APtr: pointer): Far16Ptr; cdecl;
+ external 'emx' index 4;
+
+{This one should be called to call 16-bit procedures and functions.}
+function emx_thunk1(Args: Pointer; Fun: Pointer): cardinal; cdecl;
+ external 'emx' index 5;
+
+procedure emx_exception; cdecl;
+ external 'emx' index 6;
+
+// REXX function
+//ULONG emx_revision (PCSZ name, LONG argc, const RXSTRING *argv,
+// PCSZ queuename, PRXSTRING retstr)
+procedure emx_revision; cdecl;
+ external 'emx' index 128;
+
+Implementation
+
+End.
+
+{
+$Log: emx.pas,v $
+Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/emx/emxwrap.imp b/rtl/emx/emxwrap.imp
new file mode 100644
index 0000000000..9d272efaf2
--- /dev/null
+++ b/rtl/emx/emxwrap.imp
@@ -0,0 +1,113 @@
+;
+; wrap.imp (created by emximp)
+;
+; -------- emxwrap.def --------
+EMX_REVISION EMXWRAP 1 ?
+WinDefAVioWindowProc EMXWRAP 30 ?
+VioEndPopUp EMXWRAP 101 ?
+VioGetPhysBuf EMXWRAP 102 ?
+VioGetAnsi EMXWRAP 103 ?
+VioSetAnsi EMXWRAP 105 ?
+VioDeRegister EMXWRAP 106 ?
+VioScrollUp EMXWRAP 107 ?
+VioPrtSc EMXWRAP 108 ?
+VioGetCurPos EMXWRAP 109 ?
+VioWrtCellStr EMXWRAP 110 ?
+VioPopUp EMXWRAP 111 ?
+VioScrollRt EMXWRAP 112 ?
+VioWrtCharStr EMXWRAP 113 ?
+VioSetCurPos EMXWRAP 115 ?
+VioScrUnLock EMXWRAP 118 ?
+VioWrtTTY EMXWRAP 119 ?
+VioGetMode EMXWRAP 121 ?
+VioSetMode EMXWRAP 122 ?
+VioScrLock EMXWRAP 123 ?
+VioReadCellStr EMXWRAP 124 ?
+VioSavRedrawWait EMXWRAP 125 ?
+VioWrtNAttr EMXWRAP 126 ?
+VioGetCurType EMXWRAP 127 ?
+VioSavRedrawUndo EMXWRAP 128 ?
+VioGetFont EMXWRAP 129 ?
+VioReadCharStr EMXWRAP 130 ?
+VioGetBuf EMXWRAP 131 ?
+VioSetCurType EMXWRAP 132 ?
+VioSetFont EMXWRAP 133 ?
+VioModeUndo EMXWRAP 135 ?
+VioModeWait EMXWRAP 137 ?
+VioGetCp EMXWRAP 140 ?
+VioSetCp EMXWRAP 142 ?
+VioShowBuf EMXWRAP 143 ?
+VioScrollLf EMXWRAP 144 ?
+VioRegister EMXWRAP 145 ?
+VioGetConfig EMXWRAP 146 ?
+VioScrollDn EMXWRAP 147 ?
+VioWrtCharStrAtt EMXWRAP 148 4
+VioGetState EMXWRAP 149 ?
+VioPrtScToggle EMXWRAP 150 ?
+VioSetState EMXWRAP 151 ?
+VioWrtNCell EMXWRAP 152 ?
+VioWrtNChar EMXWRAP 153 ?
+VioAssociate EMXWRAP 155 ?
+VioCreatePS EMXWRAP 156 ?
+VioDeleteSetId EMXWRAP 157 ?
+VioGetDeviceCellSize EMXWRAP 158 ?
+VioGetOrg EMXWRAP 159 ?
+VioCreateLogFont EMXWRAP 160 ?
+VioDestroyPS EMXWRAP 161 ?
+VioQuerySetIds EMXWRAP 162 ?
+VioSetOrg EMXWRAP 163 ?
+VioQueryFonts EMXWRAP 164 ?
+VioSetDeviceCellSize EMXWRAP 165 ?
+VioShowPS EMXWRAP 166 ?
+VioGlobalReg EMXWRAP 170 ?
+VioCheckCharType EMXWRAP 175 ?
+KbdSetCustXt EMXWRAP 201 ?
+KbdGetCp EMXWRAP 203 ?
+KbdCharIn EMXWRAP 204 ?
+KbdSetCp EMXWRAP 205 ?
+KbdSynch EMXWRAP 207 ?
+KbdRegister EMXWRAP 208 ?
+KbdStringIn EMXWRAP 209 ?
+KbdGetStatus EMXWRAP 210 ?
+KbdSetStatus EMXWRAP 211 ?
+KbdGetFocus EMXWRAP 212 ?
+KbdFlushBuffer EMXWRAP 213 ?
+KbdXlate EMXWRAP 214 ?
+KbdClose EMXWRAP 217 ?
+KbdFreeFocus EMXWRAP 218 ?
+KbdDeRegister EMXWRAP 220 ?
+KbdSetFgnd EMXWRAP 221 ?
+KbdPeek EMXWRAP 222 ?
+KbdOpen EMXWRAP 223 ?
+KbdGetHWID EMXWRAP 224 ?
+KbdSetHWID EMXWRAP 225 ?
+MouGetPtrShape EMXWRAP 301 ?
+MouSetPtrShape EMXWRAP 302 ?
+MouGetNumMickeys EMXWRAP 303 ?
+MouGetScaleFact EMXWRAP 306 ?
+MouFlushQue EMXWRAP 307 ?
+MouGetNumButtons EMXWRAP 308 ?
+MouClose EMXWRAP 309 ?
+MouSetScaleFact EMXWRAP 311 ?
+MouGetNumQueEl EMXWRAP 313 ?
+MouDeRegister EMXWRAP 314 ?
+MouGetEventMask EMXWRAP 315 ?
+MouSetEventMask EMXWRAP 316 ?
+MouOpen EMXWRAP 317 ?
+MouRemovePtr EMXWRAP 318 ?
+MouGetPtrPos EMXWRAP 319 ?
+MouReadEventQue EMXWRAP 320 ?
+MouSetPtrPos EMXWRAP 321 ?
+MouGetDevStatus EMXWRAP 322 ?
+MouSynch EMXWRAP 323 ?
+MouRegister EMXWRAP 324 ?
+MouSetDevStatus EMXWRAP 325 ?
+MouDrawPtr EMXWRAP 326 ?
+MouInitReal EMXWRAP 327 ?
+MouSetThreshold EMXWRAP 329 ?
+MouGetThreshold EMXWRAP 330 ?
+DosMonWrite EMXWRAP 401 ?
+DosMonRead EMXWRAP 402 ?
+DosMonClose EMXWRAP 403 ?
+DosMonOpen EMXWRAP 404 ?
+DosMonReg EMXWRAP 405 ?
diff --git a/rtl/emx/ports.pas b/rtl/emx/ports.pas
new file mode 100644
index 0000000000..69e3ad8ced
--- /dev/null
+++ b/rtl/emx/ports.pas
@@ -0,0 +1,212 @@
+{
+ $Id: ports.pas,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ These files adds support for TP styled port accesses (port[],
+ portw[] and portl[] constructs) using Delphi classes.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+(*
+ Warning:
+ 1) You have to enable port access in your CONFIG.SYS (IOPL directive),
+ either globally (IOPL=YES), or just for particular application/-s with
+ a need for port access (IOPL=app_name1, appname2, ...).
+ 2) Once you access some port, access to this port is enabled all the time
+ for all EMX applications until EMX.DLL is unloaded from memory (i.e.
+ all applications using this library finish).
+*)
+
+unit Ports;
+
+{ This unit uses classes so ObjFpc mode is required. }
+{$Mode ObjFpc}
+
+interface
+
+type
+ TPort = class
+ protected
+ procedure WritePort (P: word; Data: byte);
+ function ReadPort (P: word): byte;
+ public
+ property PP [W: word]: byte read readport write writeport; default;
+ end;
+
+ TPortW = class
+ protected
+ procedure WritePort (P: word; Data: word);
+ function ReadPort (P: word): word;
+ public
+ property PP [W: word]: word read readport write writeport; default;
+ end;
+
+ TPortL = class
+ protected
+ procedure WritePort (P: word; Data: longint);
+ function ReadPort (P: word): longint;
+ public
+ property PP [W: word]: longint read readport write writeport; default;
+ end;
+
+ { Non-instantiated vars. As yet, they don't have to be instantiated,
+ because neither member variables nor virtual methods are accessed }
+
+var
+ Port, PortB: TPort;
+ PortW: TPortW;
+ PortL: TPortL;
+
+implementation
+
+{Import syscall to call it nicely from assembler procedures.}
+
+procedure syscall; external name '___SYSCALL';
+
+{$AsmMode ATT}
+
+procedure TPort.WritePort (P: word; Data: byte); assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %edx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+ popl %eax
+{$ELSE REGCALL}
+ movw P, %dx
+ movb Data, %al
+{$ENDIF REGCALL}
+ outb %al, %dx
+end {['eax', 'ecx', 'edx']};
+
+function TPort.ReadPort (P: word): byte; assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+{$ELSE REGCALL}
+ movw P, %cx
+ pushl %ecx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+{$ELSE REGCALL}
+ movw P, %dx
+{$ENDIF REGCALL}
+ inb %dx, %al
+end {['eax', 'ecx', 'edx']};
+
+procedure TPortW.WritePort (P: word; Data : word); assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %edx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+ popl %eax
+{$ELSE REGCALL}
+ movw P, %dx
+ movw Data, %ax
+{$ENDIF REGCALL}
+ outw %ax, %dx
+end {['eax', 'ecx', 'edx']};
+
+function TPortW.ReadPort (P: word): word; assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+{$ELSE REGCALL}
+ movw P, %dx
+{$ENDIF REGCALL}
+ inw %dx, %ax
+end {['eax', 'ecx', 'edx']};
+
+procedure TPortL.WritePort (P: word; Data: longint); assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %edx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+ popl %eax
+{$ELSE REGCALL}
+ movw P, %dx
+ movl Data, %eax
+{$ENDIF REGCALL}
+ outl %eax, %dx
+end {['eax', 'ecx', 'edx']};
+
+function TPortL.ReadPort (P: word): longint; assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+{$ELSE REGCALL}
+ movw P, %dx
+{$ENDIF REGCALL}
+ inl %dx, %eax
+end {['eax', 'ecx', 'edx']};
+
+end.
+
+{
+ $Log: ports.pas,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/emx/prt0.as b/rtl/emx/prt0.as
new file mode 100644
index 0000000000..db12128d93
--- /dev/null
+++ b/rtl/emx/prt0.as
@@ -0,0 +1,74 @@
+/ prt0.s (emx+fpc) -- Made from crt0.s,
+/ Copyright (c) 1990-1999-2001 by Eberhard Mattes.
+/ Changed for Free Pascal in 1997 Daniel Mantione.
+/ This code is _not_ under the Library GNU Public
+/ License, because the original is not. See copying.emx
+/ for details. You should have received it with this
+/ product, write the author if you haven't.
+
+ .globl __text
+ .globl ___SYSCALL
+ .globl __data
+ .globl __heap_base
+ .globl __heap_brk
+ .globl __heap_end
+ .globl __init
+
+ .text
+
+__text:
+ push $__data
+ call __dos_init
+ jmp __init
+
+___SYSCALL:
+ call __dos_syscall
+ ret
+
+ .space 6, 0x90
+
+__init: cld
+ call __entry1
+
+ call _main
+ movb $0x4c,%ah
+ call ___SYSCALL
+2: jmp 2b
+
+ .data
+
+/ The data segment starts with a table containing the start and end
+/ addresses of the text, data and bss segments
+
+__data:
+ .long __text
+ .long __etext
+ .long __data
+ .long __edata
+ .long __edata
+ .long __end
+__heap_base:
+ .long 0
+__heap_end:
+ .long 0
+__heap_brk:
+ .long 0
+ .long 0
+ .long __os2dll
+ .long 0
+ .long 0
+ .long 0x02000000
+ .long 0
+ .long 0
+ .byte 0
+ .space 63, 0
+
+/ Don't touch this. It's EMX vodoo. In short, this causes the __os2dll symbol
+/ point to table of DLL data that the linker includes in the executable.
+
+ .stabs "__os2dll", 21, 0, 0, 0xffffffff
+ .stabs "___CTOR_LIST__", 21, 0, 0, 0xffffffff
+ .stabs "___DTOR_LIST__", 21, 0, 0, 0xffffffff
+ .stabs "___crtinit1__", 21, 0, 0, 0xffffffff
+ .stabs "___crtexit1__", 21, 0, 0, 0xffffffff
+ .stabs "___eh_frame__", 21, 0, 0, 0xffffffff
diff --git a/rtl/emx/prt1.as b/rtl/emx/prt1.as
new file mode 100644
index 0000000000..1f55cb341f
--- /dev/null
+++ b/rtl/emx/prt1.as
@@ -0,0 +1,61 @@
+/ prt1.s (emx+fpk) -- Made from crt2.s and dos.s,
+/ Copyright (c) 1990-1999-2000 by Eberhard Mattes.
+/ Changed for Free Pascal in 1997 Daniel Mantione.
+/ This code is _not_ under the Library GNU Public
+/ License, because the original is not. See copying.emx
+/ for details. You should have received it with this
+/ product, write the author if you haven't.
+
+ .globl __entry1
+ .globl _environ
+ .globl _envc
+ .globl _argv
+ .globl _argc
+
+ .text
+
+__entry1:
+ popl %esi
+ cld
+ xorl %ebp, %ebp
+ leal (%esp), %edi /* argv[] */
+ movl %edi,_environ
+ call L_ptr_tbl
+ movl %ecx,_envc
+ movl %edi,_argv
+ call L_ptr_tbl
+ movl %ecx,_argc
+ jmp *%esi
+
+L_ptr_tbl:
+ xorl %eax, %eax
+ movl $-1, %ecx
+1: incl %ecx
+ scasl
+ jne 1b
+ ret
+
+/ In executables created with emxbind, the call to _dos_init will
+/ be fixed up at load time to _emx_init of emx.dll. Under DOS,
+/ this dummy is called instead as there is no fixup. This module
+/ must be linked statically to avoid having two fixups for the
+/ same location.
+
+ .globl __dos_init
+ .globl __dos_syscall
+
+__dos_init:
+ ret $4
+
+ .align 2, 0x90
+
+__dos_syscall:
+ int $0x21
+ ret
+
+ .data
+
+ .comm _environ, 4
+ .comm _envc, 4
+ .comm _argv, 4
+ .comm _argc, 4
diff --git a/rtl/emx/sysdir.inc b/rtl/emx/sysdir.inc
new file mode 100644
index 0000000000..d52f9f34ab
--- /dev/null
+++ b/rtl/emx/sysdir.inc
@@ -0,0 +1,251 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+
+procedure dosdir(func:byte;const s:string);
+
+var buffer:array[0..255] of char;
+
+begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ allowslash(Pchar(@buffer));
+ asm
+ leal buffer,%edx
+ movb func,%ah
+ call syscall
+ jnc .LDOS_DIRS1
+ movw %ax,inoutres
+ .LDOS_DIRS1:
+ end ['eax', 'edx'];
+end;
+
+
+procedure MkDir (const S: string);[IOCHECK];
+
+var buffer:array[0..255] of char;
+ Rc : word;
+
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ if os_mode = osOs2 then
+ begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ allowslash(Pchar(@buffer));
+ Rc := DosCreateDir(buffer,nil);
+ if Rc <> 0 then
+ begin
+ InOutRes := Rc;
+ Errno2Inoutres;
+ end;
+ end
+ else
+ begin
+ { Under EMX 0.9d DOS this routine call may sometimes fail }
+ { The syscall documentation indicates clearly that this }
+ { routine was NOT tested. }
+ DosDir ($39, S);
+end;
+end;
+
+
+procedure rmdir(const s : string);[IOCHECK];
+var buffer:array[0..255] of char;
+ Rc : word;
+begin
+ if (s = '.' ) then
+ InOutRes := 16;
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ if os_mode = osOs2 then
+ begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ allowslash(Pchar(@buffer));
+ Rc := DosDeleteDir(buffer);
+ if Rc <> 0 then
+ begin
+ InOutRes := Rc;
+ Errno2Inoutres;
+ end;
+ end
+ else
+ begin
+ { Under EMX 0.9d DOS this routine call may sometimes fail }
+ { The syscall documentation indicates clearly that this }
+ { routine was NOT tested. }
+ DosDir ($3A, S);
+end;
+end;
+
+{$ASMMODE INTEL}
+
+procedure ChDir (const S: string);[IOCheck];
+
+var RC: cardinal;
+ Buffer: array [0..255] of char;
+
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+(* According to EMX documentation, EMX has only one current directory
+ for all processes, so we'll use native calls under OS/2. *)
+ if os_Mode = osOS2 then
+ begin
+ if (Length (S) >= 2) and (S [2] = ':') then
+ begin
+ RC := DosSetDefaultDisk ((Ord (S [1]) and
+ not ($20)) - $40);
+ if RC <> 0 then
+ InOutRes := RC
+ else
+ if Length (S) > 2 then
+ begin
+ Move (S [1], Buffer, Length (S));
+ Buffer [Length (S)] := #0;
+ AllowSlash (PChar (@Buffer));
+ RC := DosSetCurrentDir (@Buffer);
+ if RC <> 0 then
+ begin
+ InOutRes := RC;
+ Errno2InOutRes;
+ end;
+ end;
+ end
+ else
+ begin
+ Move (S [1], Buffer, Length (S));
+ Buffer [Length (S)] := #0;
+ AllowSlash (PChar (@Buffer));
+ RC := DosSetCurrentDir (@Buffer);
+ if RC <> 0 then
+ begin
+ InOutRes:= RC;
+ Errno2InOutRes;
+ end;
+ end;
+ end
+ else
+ if (Length (S) >= 2) and (S [2] = ':') then
+ begin
+ asm
+ mov esi, S
+ mov al, [esi + 1]
+ and al, not (20h)
+ sub al, 41h
+ mov edx, eax
+ mov ah, 0Eh
+ call syscall
+ mov ah, 19h
+ call syscall
+ cmp al, dl
+ jz @LCHDIR
+ mov InOutRes, 15
+@LCHDIR:
+ end ['eax','edx','esi'];
+ if (Length (S) > 2) and (InOutRes <> 0) then
+ { Under EMX 0.9d DOS this routine may sometime }
+ { fail or crash the system. }
+ DosDir ($3B, S);
+ end
+ else
+ { Under EMX 0.9d DOS this routine may sometime }
+ { fail or crash the system. }
+ DosDir ($3B, S);
+end;
+
+{$ASMMODE ATT}
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+
+{Written by Michael Van Canneyt.}
+
+var sof:Pchar;
+ i:byte;
+
+begin
+ Dir [4] := #0;
+ { Used in case the specified drive isn't available }
+ sof:=pchar(@dir[4]);
+ { dir[1..3] will contain '[drivenr]:\', but is not }
+ { supplied by DOS, so we let dos string start at }
+ { dir[4] }
+ { Get dir from drivenr : 0=default, 1=A etc... }
+ asm
+ movb drivenr,%dl
+ movl sof,%esi
+ mov $0x47,%ah
+ call syscall
+ jnc .LGetDir
+ movw %ax, InOutRes
+.LGetDir:
+ end [ 'eax','edx','esi'];
+ { Now Dir should be filled with directory in ASCIIZ, }
+ { starting from dir[4] }
+ dir[0]:=#3;
+ dir[2]:=':';
+ dir[3]:='\';
+ i:=4;
+ {Conversion to Pascal string }
+ while (dir[i]<>#0) do
+ begin
+ { convert path name to DOS }
+ if dir[i]='/' then
+ dir[i]:='\';
+ dir[0]:=char(i);
+ inc(i);
+ end;
+ { upcase the string (FPC function) }
+ if drivenr<>0 then { Drive was supplied. We know it }
+ dir[1]:=chr(64+drivenr)
+ else
+ begin
+ { We need to get the current drive from DOS function 19H }
+ { because the drive was the default, which can be unknown }
+ asm
+ movb $0x19,%ah
+ call syscall
+ addb $65,%al
+ movb %al,i
+ end ['eax'];
+ dir[1]:=char(i);
+ end;
+ if not (FileNameCaseSensitive) then dir:=upcase(dir);
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/emx/sysemx.pas b/rtl/emx/sysemx.pas
new file mode 100644
index 0000000000..08777b8a3e
--- /dev/null
+++ b/rtl/emx/sysemx.pas
@@ -0,0 +1 @@
+{$i system.pas}
diff --git a/rtl/emx/sysfile.inc b/rtl/emx/sysfile.inc
new file mode 100644
index 0000000000..0113542001
--- /dev/null
+++ b/rtl/emx/sysfile.inc
@@ -0,0 +1,415 @@
+{
+ $Id: sysfile.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+
+ Low Level File Routines
+
+****************************************************************************}
+
+procedure allowslash(p:Pchar);
+
+{Allow slash as backslash.}
+
+var i:longint;
+
+begin
+ for i:=0 to strlen(p) do
+ if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close (H: THandle);
+
+begin
+{ Only three standard handles under real OS/2 }
+ if (h > 4) or
+ ((os_MODE = osOS2) and (h > 2)) then
+ begin
+ asm
+ pushl %ebx
+ movb $0x3e,%ah
+ movl h,%ebx
+ call syscall
+ jnc .Lnoerror { error code? }
+ movw %ax, InOutRes { yes, then set InOutRes }
+ .Lnoerror:
+ popl %ebx
+ end ['eax'];
+ end;
+end;
+
+procedure do_erase(p:Pchar);
+
+begin
+ allowslash(p);
+ asm
+ movl P,%edx
+ movb $0x41,%ah
+ call syscall
+ jnc .LERASE1
+ movw %ax,inoutres
+ .LERASE1:
+ end ['eax', 'edx'];
+end;
+
+procedure do_rename(p1,p2:Pchar);
+
+begin
+ allowslash(p1);
+ allowslash(p2);
+ asm
+ movl P1, %edx
+ movl P2, %edi
+ movb $0x56,%ah
+ call syscall
+ jnc .LRENAME1
+ movw %ax,inoutres
+ .LRENAME1:
+ end ['eax', 'edx', 'edi'];
+end;
+
+function do_read (H: THandle; Addr: pointer; Len: longint): longint; assembler;
+asm
+ pushl %ebx
+{$IFNDEF REGCALL}
+ movl len,%ecx
+ movl addr,%edx
+ movl %eax,%ebx
+{$ELSE REGCALL}
+ movl h,%ebx
+{$ENDIF REGCALL}
+ movb $0x3f,%ah
+ call syscall
+ jnc .LDOSREAD1
+ movw %ax,inoutres
+ xorl %eax,%eax
+.LDOSREAD1:
+ popl %ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+function do_write (H: THandle; Addr: pointer; Len: longint): longint;
+ assembler;
+asm
+ pushl %ebx
+{$IFDEF REGCALL}
+ movl %eax,%ebx
+{$ENDIF REGCALL}
+ xorl %eax,%eax
+ cmpl $0,len { 0 bytes to write is undefined behavior }
+ jz .LDOSWRITE1
+{$IFNDEF REGCALL}
+ movl len,%ecx
+ movl addr,%edx
+ movl h,%ebx
+{$ENDIF REGCALL}
+ movb $0x40,%ah
+ call syscall
+ jnc .LDOSWRITE1
+ movw %ax,inoutres
+.LDOSWRITE1:
+ popl %ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+function do_filepos (Handle: THandle): longint; assembler;
+asm
+ pushl %ebx
+{$IFDEF REGCALL}
+ movl %eax,%ebx
+{$ELSE REGCALL}
+ movl handle,%ebx
+{$ENDIF REGCALL}
+ movw $0x4201,%ax
+ xorl %edx,%edx
+ call syscall
+ jnc .LDOSFILEPOS
+ movw %ax,inoutres
+ xorl %eax,%eax
+.LDOSFILEPOS:
+ popl %ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+procedure do_seek (Handle: THandle; Pos: longint); assembler;
+asm
+ pushl %ebx
+{$IFDEF REGCALL}
+ movl %eax,%ebx
+{$ELSE REGCALL}
+ movl handle,%ebx
+ movl pos,%edx
+{$ENDIF REGCALL}
+ movw $0x4200,%ax
+ call syscall
+ jnc .LDOSSEEK1
+ movw %ax,inoutres
+.LDOSSEEK1:
+ popl %ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+function do_seekend (Handle: THandle): longint; assembler;
+asm
+ pushl %ebx
+{$IFDEF REGCALL}
+ movl %eax,%ebx
+{$ELSE REGCALL}
+ movl handle,%ebx
+{$ENDIF REGCALL}
+ movw $0x4202,%ax
+ xorl %edx,%edx
+ call syscall
+ jnc .Lset_at_end1
+ movw %ax,inoutres;
+ xorl %eax,%eax
+.Lset_at_end1:
+ popl %ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+function do_filesize (Handle: THandle): longint;
+
+var aktfilepos:longint;
+
+begin
+ aktfilepos:=do_filepos(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,aktfilepos);
+end;
+
+procedure do_truncate (Handle: THandle; Pos: longint); assembler;
+asm
+ pushl %ebx
+(* DOS function 40h isn't safe for this according to EMX documentation *)
+{$IFDEF REGCALL}
+ movl %eax,%ebx
+ pushl %eax
+{$ELSE REGCALL}
+ movl Handle,%ebx
+ movl Pos,%edx
+{$ENDIF REGCALL}
+ movl $0x7F25,%eax
+ call syscall
+ incl %eax
+ movl %ecx, %eax
+{$IFDEF REGCALL}
+ popl %ebx
+{$ENDIF REGCALL}
+ jnz .LTruncate1 { compare the value of EAX to verify error }
+(* File position is undefined after truncation, move to the end. *)
+ movl $0x4202,%eax
+{$IFNDEF REGCALL}
+ movl Handle,%ebx
+{$ENDIF REGCALL}
+ movl $0,%edx
+ call syscall
+ jnc .LTruncate2
+.LTruncate1:
+ movw %ax,inoutres
+.LTruncate2:
+ popl %ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+const
+ FileHandleCount: cardinal = 20;
+
+function Increase_File_Handle_Count: boolean;
+var Err: word;
+ L1: longint;
+ L2: cardinal;
+begin
+ if os_mode = osOS2 then
+ begin
+ L1 := 10;
+ if DosSetRelMaxFH (L1, L2) <> 0 then
+ Increase_File_Handle_Count := false
+ else
+ if L2 > FileHandleCount then
+ begin
+ FileHandleCount := L2;
+ Increase_File_Handle_Count := true;
+ end
+ else
+ Increase_File_Handle_Count := false;
+ end
+ else
+ begin
+ Inc (FileHandleCount, 10);
+ Err := 0;
+ asm
+ pushl %ebx
+ movl $0x6700, %eax
+ movl FileHandleCount, %ebx
+ call syscall
+ jnc .LIncFHandles
+ movw %ax, Err
+.LIncFHandles:
+ popl %ebx
+ end ['eax'];
+ if Err <> 0 then
+ begin
+ Increase_File_Handle_Count := false;
+ Dec (FileHandleCount, 10);
+ end
+ else
+ Increase_File_Handle_Count := true;
+ end;
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+
+var Action: cardinal;
+
+begin
+ allowslash(p);
+ { close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed:;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+ { reset file handle }
+ filerec(f).handle := UnusedHandle;
+ Action := 0;
+ { convert filemode to filerec modes }
+ case (flags and 3) of
+ 0 : filerec(f).mode:=fminput;
+ 1 : filerec(f).mode:=fmoutput;
+ 2 : filerec(f).mode:=fminout;
+ end;
+ if (flags and $1000)<>0 then
+ Action := $50000; (* Create / replace *)
+ { empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+ Action := Action or (Flags and $FF);
+(* DenyNone if sharing not specified. *)
+ if Flags and 112 = 0 then
+ Action := Action or 64;
+ asm
+ pushl %ebx
+ movl $0x7f2b, %eax
+ movl Action, %ecx
+ movl p, %edx
+ call syscall
+ cmpl $0xffffffff, %eax
+ jnz .LOPEN1
+ movw %cx, InOutRes
+ movl UnusedHandle, %eax
+.LOPEN1:
+ movl f,%edx { Warning : This assumes Handle is first }
+ movl %eax,(%edx) { field of FileRec }
+ popl %ebx
+ end ['eax', 'ecx', 'edx'];
+ if (InOutRes = 4) and Increase_File_Handle_Count then
+(* Trying again after increasing amount of file handles *)
+ asm
+ pushl %ebx
+ movl $0x7f2b, %eax
+ movl Action, %ecx
+ movl p, %edx
+ call syscall
+ cmpl $0xffffffff, %eax
+ jnz .LOPEN2
+ movw %cx, InOutRes
+ movl UnusedHandle, %eax
+.LOPEN2:
+ movl f,%edx
+ movl %eax,(%edx)
+ popl %ebx
+ end ['eax', 'ecx', 'edx'];
+ { for systems that have more handles }
+ if (FileRec (F).Handle <> UnusedHandle) then
+ begin
+ if (FileRec (F).Handle > FileHandleCount) then
+ FileHandleCount := FileRec (F).Handle;
+ if ((Flags and $100) <> 0) then
+ begin
+ do_seekend (FileRec (F).Handle);
+ FileRec (F).Mode := fmOutput; {fool fmappend}
+ end;
+ end;
+end;
+
+{$ASMMODE INTEL}
+function do_isdevice (Handle: THandle): boolean; assembler;
+(*
+var HT, Attr: longint;
+begin
+ if os_mode = osOS2 then
+ begin
+ if DosQueryHType (Handle, HT, Attr) <> 0 then HT := 1;
+ end
+ else
+*)
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ebx, eax
+{$ELSE REGCALL}
+ mov ebx, Handle
+{$ENDIF REGCALL}
+ mov eax, 4400h
+ call syscall
+ mov eax, 1
+ jc @IsDevEnd
+ test edx, 80h { verify if it is a file }
+ jnz @IsDevEnd
+ dec eax { nope, so result is zero }
+@IsDevEnd:
+ pop ebx
+end {['eax', 'ebx', 'edx']};
+{$ASMMODE ATT}
+
+
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/emx/sysheap.inc b/rtl/emx/sysheap.inc
new file mode 100644
index 0000000000..7907ae8526
--- /dev/null
+++ b/rtl/emx/sysheap.inc
@@ -0,0 +1,91 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+
+ Heap management releated routines.
+
+****************************************************************************}
+
+
+{ this function allows to extend the heap by calling
+syscall $7f00 resizes the brk area}
+
+function sbrk(size:longint):pointer;
+{$IFDEF DUMPGROW}
+var
+ L: longword;
+begin
+ WriteLn ('Trying to grow heap by ', Size);
+{$IFDEF CONTHEAP}
+ WriteLn ('BrkLimit is ', BrkLimit);
+{$ENDIF CONTHEAP}
+ asm
+ movl size,%edx
+ movw $0x7f00,%ax
+ call syscall { result directly in EAX }
+ inc %eax { Result in EAX, -1 = error (has to be transformed to 0) }
+ jz .LSbrk_End
+ dec %eax { No error - back to previous value }
+.LSbrk_End:
+ mov %eax,L
+ end ['eax', 'edx'];
+ WriteLn ('New heap at ', L);
+ Sbrk := pointer (L);
+end;
+{$ELSE DUMPGROW}
+ assembler;
+asm
+{$IFDEF REGCALL}
+ movl %eax,%edx
+{$ELSE REGCALL}
+ movl size,%edx
+{$ENDIF REGCALL}
+ movw $0x7f00,%ax
+ call syscall
+ inc %eax { Result in EAX, -1 = error (has to be transformed to 0) }
+ jz .LSbrk_End
+ dec %eax { No error - back to previous value }
+.LSbrk_End:
+end {['eax', 'edx']};
+{$ENDIF DUMPGROW}
+
+function SysOSAlloc (Size: ptrint): pointer;
+begin
+ SysOSAlloc := Sbrk (Size);
+end;
+
+{.$define HAS_SYSOSFREE}
+
+procedure SysOSFree (P: pointer; Size: ptrint);
+begin
+end;
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/emx/sysos.inc b/rtl/emx/sysos.inc
new file mode 100644
index 0000000000..2ac1b24616
--- /dev/null
+++ b/rtl/emx/sysos.inc
@@ -0,0 +1,105 @@
+{
+ $Id: sysos.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+var
+ ProcessID: SizeUInt;
+
+function GetProcessID:SizeUInt;
+begin
+ GetProcessID := ProcessID;
+end;
+
+
+procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
+ PAPIB: PPProcessInfoBlock); cdecl;
+ external 'DOSCALLS' index 312;
+
+function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
+ var Handle: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 318;
+
+function DosQueryProcAddr (Handle, Ordinal: cardinal; ProcName: PChar;
+ var Address: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 321;
+
+function DosSetRelMaxFH (var ReqCount: longint; var CurMaxFH: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 382;
+
+function DosSetCurrentDir (Name:PChar): cardinal; cdecl;
+external 'DOSCALLS' index 255;
+
+function DosSetDefaultDisk (DiskNum:cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 220;
+
+{ This is not real prototype, but is close enough }
+{ for us (the 2nd parameter is actually a pointer }
+{ to a structure). }
+function DosCreateDir (Name: PChar; P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 270;
+
+function DosDeleteDir (Name: PChar): cardinal; cdecl;
+external 'DOSCALLS' index 226;
+
+{This is the correct way to call external assembler procedures.}
+procedure syscall; external name '___SYSCALL';
+
+{
+procedure syscall; external 'EMX' index 2;
+
+procedure emx_init; external 'EMX' index 1;
+}
+
+
+
+ { converts an OS/2 error code to a TP compatible error }
+ { code. Same thing exists under most other supported }
+ { systems. }
+ { Only call for OS/2 DLL imported routines }
+ Procedure Errno2InOutRes;
+ Begin
+ { errors 1..18 are the same as in DOS }
+ case InOutRes of
+ { simple offset to convert these error codes }
+ { exactly like the error codes in Win32 }
+ 19..31 : InOutRes := InOutRes + 131;
+ { gets a bit more complicated ... }
+ 32..33 : InOutRes := 5;
+ 38 : InOutRes := 100;
+ 39 : InOutRes := 101;
+ 112 : InOutRes := 101;
+ 110 : InOutRes := 5;
+ 114 : InOutRes := 6;
+ 290 : InOutRes := 290;
+ end;
+ { all other cases ... we keep the same error code }
+ end;
+
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/emx/sysosh.inc b/rtl/emx/sysosh.inc
new file mode 100644
index 0000000000..5bcaeed2ec
--- /dev/null
+++ b/rtl/emx/sysosh.inc
@@ -0,0 +1,55 @@
+{
+ $Id: sysosh.inc,v 1.3 2005/04/14 21:17:51 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+ THandle = Longint;
+
+ TThreadID = cardinal;
+
+ { the fields of this record are os dependent }
+ { and they shouldn't be used in a program }
+ { only the type TCriticalSection is important }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = packed record
+ DebugInfo : pointer;
+ LockCount : longint;
+ RecursionCount : longint;
+ OwningThread : DWord;
+ LockSemaphore : DWord;
+ Reserved : DWord;
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.3 2005/04/14 21:17:51 hajny
+ * TThreadID changed to cardinal
+
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/emx/system.pas b/rtl/emx/system.pas
new file mode 100644
index 0000000000..2ed1c52899
--- /dev/null
+++ b/rtl/emx/system.pas
@@ -0,0 +1,603 @@
+{
+ $Id: system.pas,v 1.35 2005/04/03 21:10:59 hajny Exp $
+ ****************************************************************************
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2002 by Free Pascal development team
+
+ Free Pascal - EMX runtime library
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+****************************************************************************}
+
+unit {$ifdef VER1_0}sysemx{$else}System{$endif};
+
+interface
+
+{Link the startup code.}
+{$ifdef VER1_0}
+ {$l prt1.oo2}
+{$else}
+ {$l prt1.o}
+{$endif}
+
+{$I systemh.inc}
+
+const
+ LineEnding = #13#10;
+{ LFNSupport is defined separately below!!! }
+ DirectorySeparator = '\';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 255;
+
+type Tos=(osDOS,osOS2,osDPMI);
+
+var os_mode:Tos;
+ first_meg:pointer;
+
+type TByteArray = array [0..$ffff] of byte;
+ PByteArray = ^TByteArray;
+
+ TSysThreadIB = record
+ TID,
+ Priority,
+ Version: cardinal;
+ MCCount,
+ MCForceFlag: word;
+ end;
+ PSysThreadIB = ^TSysThreadIB;
+
+ TThreadInfoBlock = record
+ PExChain,
+ Stack,
+ StackLimit: pointer;
+ TIB2: PSysThreadIB;
+ Version,
+ Ordinal: cardinal;
+ end;
+ PThreadInfoBlock = ^TThreadInfoBlock;
+ PPThreadInfoBlock = ^PThreadInfoBlock;
+
+ TProcessInfoBlock = record
+ PID,
+ ParentPid,
+ Handle: cardinal;
+ Cmd,
+ Env: PByteArray;
+ Status,
+ ProcType: cardinal;
+ end;
+ PProcessInfoBlock = ^TProcessInfoBlock;
+ PPProcessInfoBlock = ^PProcessInfoBlock;
+
+const UnusedHandle=-1;
+ StdInputHandle=0;
+ StdOutputHandle=1;
+ StdErrorHandle=2;
+
+ LFNSupport: boolean = true;
+ FileNameCaseSensitive: boolean = false;
+ CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+var
+{ C-compatible arguments and environment }
+ argc : longint;external name '_argc';
+ argv : ppchar;external name '_argv';
+ envp : ppchar;external name '_environ';
+ EnvC: cardinal; external name '_envc';
+
+(* Pointer to the block of environment variables - used e.g. in unit Dos. *)
+ Environment: PChar;
+
+var
+(* Type / run mode of the current process: *)
+(* 0 .. full screen OS/2 session *)
+(* 1 .. DOS session *)
+(* 2 .. VIO windowable OS/2 session *)
+(* 3 .. Presentation Manager OS/2 session *)
+(* 4 .. detached (background) OS/2 process *)
+ ApplicationType: cardinal;
+
+
+procedure SetDefaultOS2FileType (FType: ShortString);
+
+procedure SetDefaultOS2Creator (Creator: ShortString);
+
+
+
+implementation
+
+{$I system.inc}
+
+var
+ heap_base: pointer; external name '__heap_base';
+ heap_brk: pointer; external name '__heap_brk';
+ heap_end: pointer; external name '__heap_end';
+
+(* Maximum heap size - only used if heap is allocated as continuous block. *)
+{$IFDEF CONTHEAP}
+ BrkLimit: cardinal;
+{$ENDIF CONTHEAP}
+
+
+{****************************************************************************
+
+ Miscellaneous related routines.
+
+****************************************************************************}
+
+{$asmmode intel}
+procedure system_exit; assembler;
+asm
+ mov ah, 04ch
+ mov al, byte ptr exitcode
+ call syscall
+end {['EAX']};
+
+{$ASMMODE ATT}
+
+function paramcount:longint;assembler;
+
+asm
+ movl argc,%eax
+ decl %eax
+end {['EAX']};
+
+ function args:pointer;assembler;
+
+ asm
+ movl argv,%eax
+end {['EAX']};
+
+
+function paramstr(l:longint):string;
+
+var p:^Pchar;
+
+begin
+ { There seems to be a problem with EMX for DOS when trying to }
+ { access paramstr(0), and to avoid problems between DOS and }
+ { OS/2 they have been separated. }
+ if os_Mode = OsOs2 then
+ begin
+ if L = 0 then
+ begin
+ GetMem (P, 260);
+ p[0] := #0; { in case of error, initialize to empty string }
+{$ASMMODE INTEL}
+ asm
+ mov edx, P
+ mov ecx, 260
+ mov eax, 7F33h
+ call syscall { error handle already with empty string }
+ end ['eax', 'ecx', 'edx'];
+ ParamStr := StrPas (PChar (P));
+ FreeMem (P, 260);
+ end
+ else
+ if (l>0) and (l<=paramcount) then
+ begin
+ p:=args;
+ paramstr:=strpas(p[l]);
+ end
+ else paramstr:='';
+ end
+ else
+ begin
+ p:=args;
+ paramstr:=strpas(p[l]);
+ end;
+end;
+
+
+procedure randomize; assembler;
+asm
+ mov ah, 2Ch
+ call syscall
+ mov word ptr [randseed], cx
+ mov word ptr [randseed + 2], dx
+end {['eax', 'ecx', 'edx']};
+
+{$ASMMODE ATT}
+
+
+{*****************************************************************************
+
+ System unit initialization.
+
+****************************************************************************}
+
+{****************************************************************************
+ Error Message writing using messageboxes
+****************************************************************************}
+
+type
+ TWinMessageBox = function (Parent, Owner: cardinal;
+ BoxText, BoxTitle: PChar; Identity, Style: cardinal): cardinal; cdecl;
+ TWinInitialize = function (Options: cardinal): cardinal; cdecl;
+ TWinCreateMsgQueue = function (Handle: cardinal; cmsg: longint): cardinal;
+ cdecl;
+
+const
+ ErrorBufferLength = 1024;
+ mb_OK = $0000;
+ mb_Error = $0040;
+ mb_Moveable = $4000;
+ MBStyle = mb_OK or mb_Error or mb_Moveable;
+ WinInitialize: TWinInitialize = nil;
+ WinCreateMsgQueue: TWinCreateMsgQueue = nil;
+ WinMessageBox: TWinMessageBox = nil;
+ EnvSize: cardinal = 0;
+
+var
+ ErrorBuf: array [0..ErrorBufferLength] of char;
+ ErrorLen: longint;
+ PMWinHandle: cardinal;
+
+function ErrorWrite (var F: TextRec): integer;
+{
+ An error message should always end with #13#10#13#10
+}
+var
+ P: PChar;
+ I: longint;
+begin
+ if F.BufPos > 0 then
+ begin
+ if F.BufPos + ErrorLen > ErrorBufferLength then
+ I := ErrorBufferLength - ErrorLen
+ else
+ I := F.BufPos;
+ Move (F.BufPtr^, ErrorBuf [ErrorLen], I);
+ Inc (ErrorLen, I);
+ ErrorBuf [ErrorLen] := #0;
+ end;
+ if ErrorLen > 3 then
+ begin
+ P := @ErrorBuf [ErrorLen];
+ for I := 1 to 4 do
+ begin
+ Dec (P);
+ if not (P^ in [#10, #13]) then
+ break;
+ end;
+ end;
+ if ErrorLen = ErrorBufferLength then
+ I := 4;
+ if (I = 4) then
+ begin
+ WinMessageBox (0, 0, @ErrorBuf, PChar ('Error'), 0, MBStyle);
+ ErrorLen := 0;
+ end;
+ F.BufPos := 0;
+ ErrorWrite := 0;
+end;
+
+function ErrorClose (var F: TextRec): integer;
+begin
+ if ErrorLen > 0 then
+ begin
+ WinMessageBox (0, 0, @ErrorBuf, PChar ('Error'), 0, MBStyle);
+ ErrorLen := 0;
+ end;
+ ErrorLen := 0;
+ ErrorClose := 0;
+end;
+
+function ErrorOpen (var F: TextRec): integer;
+begin
+ TextRec(F).InOutFunc := @ErrorWrite;
+ TextRec(F).FlushFunc := @ErrorWrite;
+ TextRec(F).CloseFunc := @ErrorClose;
+ ErrorOpen := 0;
+end;
+
+
+procedure AssignError (var T: Text);
+begin
+ Assign (T, '');
+ TextRec (T).OpenFunc := @ErrorOpen;
+ Rewrite (T);
+end;
+
+
+procedure DosEnvInit;
+var
+ Q: PPChar;
+ I: cardinal;
+begin
+(* It's a hack, in fact - DOS stores the environment the same way as OS/2 does,
+ but I don't know how to find Program Segment Prefix and thus the environment
+ address under EMX, so I'm recreating this structure using EnvP pointer. *)
+{$ASMMODE INTEL}
+ asm
+ cld
+ mov ecx, EnvC
+ mov esi, EnvP
+ xor eax, eax
+ xor edx, edx
+@L1:
+ xchg eax, edx
+ push ecx
+ mov ecx, -1
+ mov edi, [esi]
+ repne
+ scasb
+ neg ecx
+ dec ecx
+ xchg eax, edx
+ add eax, ecx
+ pop ecx
+ dec ecx
+ jecxz @Stop
+ inc esi
+ inc esi
+ inc esi
+ inc esi
+ jmp @L1
+@Stop:
+ inc eax
+ mov EnvSize, eax
+ end ['eax','ecx','edx','esi','edi'];
+ Environment := GetMem (EnvSize);
+ asm
+ cld
+ mov ecx, EnvC
+ mov edx, EnvP
+ mov edi, Environment
+@L2:
+ mov esi, [edx]
+@Copying:
+ lodsb
+ stosb
+ or al, al
+ jnz @Copying
+ dec ecx
+ jecxz @Stop2
+ inc edx
+ inc edx
+ inc edx
+ inc edx
+ jmp @L2
+@Stop2:
+ stosb
+ end ['eax','ecx','edx','esi','edi'];
+end;
+
+
+procedure SysInitStdIO;
+begin
+ { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+ displayed in a messagebox }
+(*
+ StdInputHandle := longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
+ StdOutputHandle := longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
+ StdErrorHandle := longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
+
+ if not IsConsole then
+ begin
+ if (DosLoadModule (nil, 0, 'PMWIN', PMWinHandle) = 0) and
+ (DosQueryProcAddr (PMWinHandle, 789, nil, pointer (WinMessageBox)) = 0)
+ and
+ (DosQueryProcAddr (PMWinHandle, 763, nil, pointer (WinInitialize)) = 0)
+ and
+ (DosQueryProcAddr (PMWinHandle, 716, nil, pointer (WinCreateMsgQueue))
+ = 0)
+ then
+ begin
+ WinInitialize (0);
+ WinCreateMsgQueue (0, 0);
+ end
+ else
+ HandleError (2);
+ AssignError (StdErr);
+ AssignError (StdOut);
+ Assign (Output, '');
+ Assign (Input, '');
+ end
+ else
+ begin
+*)
+ OpenStdIO (Input, fmInput, StdInputHandle);
+ OpenStdIO (Output, fmOutput, StdOutputHandle);
+ OpenStdIO (ErrOutput, fmOutput, StdErrorHandle);
+ OpenStdIO (StdOut, fmOutput, StdOutputHandle);
+ OpenStdIO (StdErr, fmOutput, StdErrorHandle);
+(*
+ end;
+*)
+end;
+
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ DefaultCreator: ShortString;
+ DefaultFileType: ShortString;
+
+
+procedure SetDefaultOS2FileType (FType: ShortString);
+begin
+{$WARNING Not implemented yet!}
+ DefaultFileType := FType;
+end;
+
+
+procedure SetDefaultOS2Creator (Creator: ShortString);
+begin
+{$WARNING Not implemented yet!}
+ DefaultCreator := Creator;
+end;
+
+
+function GetFileHandleCount: longint;
+var L1: longint;
+ L2: cardinal;
+begin
+ L1 := 0; (* Don't change the amount, just check. *)
+ if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
+ else GetFileHandleCount := L2;
+end;
+
+var TIB: PThreadInfoBlock;
+ PIB: PProcessInfoBlock;
+
+const
+ FatalHeap: array [0..33] of char = 'FATAL: Cannot initialize heap!!'#13#10'$';
+
+begin
+ IsLibrary := FALSE;
+ {Determine the operating system we are running on.}
+{$ASMMODE INTEL}
+ asm
+ push ebx
+ mov os_mode, 0
+ mov eax, 7F0Ah
+ call syscall
+ test bx, 512 {Bit 9 is OS/2 flag.}
+ setne byte ptr os_mode
+ test bx, 4096
+ jz @noRSX
+ mov os_mode, 2
+ @noRSX:
+ {Enable the brk area by initializing it with the initial heap size.}
+ mov eax, 7F01h
+ mov edx, heap_brk
+ add edx, heap_base
+ call syscall
+ cmp eax, -1
+ jnz @heapok
+ lea edx, FatalHeap
+ mov eax, 900h
+ call syscall
+ pop ebx
+ push dword 204
+ call HandleError
+ @heapok:
+{$IFDEF CONTHEAP}
+{ Find out brk limit }
+ mov eax, 7F02h
+ mov ecx, 3
+ call syscall
+ jcxz @heaplimitknown
+ mov eax, 0
+ @heaplimitknown:
+ mov BrkLimit, eax
+{$ELSE CONTHEAP}
+{ Change sbrk behaviour to allocate arbitrary (non-contiguous) memory blocks }
+ mov eax, 7F0Fh
+ mov ecx, 0Ch
+ mov edx, 8
+ call syscall
+{$ENDIF CONTHEAP}
+ pop ebx
+ end ['eax', 'ecx', 'edx'];
+ { in OS/2 this will always be nil, but in DOS mode }
+ { this can be changed. }
+ first_meg := nil;
+ {Now request, if we are running under DOS,
+ read-access to the first meg. of memory.}
+ if os_mode in [osDOS,osDPMI] then
+ asm
+ push ebx
+ mov eax, 7F13h
+ xor ebx, ebx
+ mov ecx, 0FFFh
+ xor edx, edx
+ call syscall
+ jc @endmem
+ mov first_meg, eax
+ @endmem:
+ pop ebx
+ end ['eax', 'ecx', 'edx']
+ else
+ begin
+ (* Initialize the amount of file handles *)
+ FileHandleCount := GetFileHandleCount;
+ end;
+ {At 0.9.2, case for enumeration does not work.}
+ case os_mode of
+ osDOS:
+ begin
+ stackbottom:=pointer(heap_brk); {In DOS mode, heap_brk is
+ also the stack bottom.}
+ ApplicationType := 1; (* Running under DOS. *)
+ IsConsole := true;
+ ProcessID := 1;
+ ThreadID := 1;
+ end;
+ osOS2:
+ begin
+ DosGetInfoBlocks (@TIB, @PIB);
+ StackBottom := pointer (TIB^.Stack);
+ Environment := pointer (PIB^.Env);
+ ApplicationType := PIB^.ProcType;
+ ProcessID := PIB^.PID;
+ ThreadID := TIB^.TIB2^.TID;
+ IsConsole := ApplicationType <> 3;
+ end;
+ osDPMI:
+ begin
+ stackbottom:=nil; {Not sure how to get it, but seems to be
+ always zero.}
+ ApplicationType := 1; (* Running under DOS. *)
+ IsConsole := true;
+ ProcessID := 1;
+ ThreadID := 1;
+ end;
+ end;
+ exitproc:=nil;
+
+ {Initialize the heap.}
+ initheap;
+
+ { ... and exceptions }
+ SysInitExceptions;
+
+ { ... and I/O }
+ SysInitStdIO;
+
+ { no I/O-Error }
+ inoutres:=0;
+
+ InitSystemThreads;
+
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+
+ if os_Mode in [osDOS,osDPMI] then
+ DosEnvInit;
+
+{$IFDEF DUMPGROW}
+ {$IFDEF CONTHEAP}
+ WriteLn ('Initial brk size is ', GetHeapSize);
+ WriteLn ('Brk limit is ', BrkLimit);
+ {$ENDIF CONTHEAP}
+{$ENDIF DUMPGROW}
+end.
+{
+ $Log: system.pas,v $
+ Revision 1.35 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.34 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.33 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+}
diff --git a/rtl/emx/systhrd.inc b/rtl/emx/systhrd.inc
new file mode 100644
index 0000000000..efdba854d5
--- /dev/null
+++ b/rtl/emx/systhrd.inc
@@ -0,0 +1,206 @@
+{
+ $Id: systhrd.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Local Api imports
+*****************************************************************************}
+
+const
+ pag_Read = 1;
+ pag_Write = 2;
+ pag_Execute = 4;
+ pag_Guard = 8;
+ pag_Commit = $10;
+ obj_Tile = $40;
+ sem_Indefinite_Wait = -1;
+ dtSuspended = 1;
+ dtStack_Commited = 2;
+
+{ import the necessary stuff from the OS }
+function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): cardinal;
+ cdecl; external 'DOSCALLS' index 454;
+
+function DosFreeThreadLocalMemory (P: pointer): cardinal; cdecl;
+ external 'DOSCALLS' index 455;
+
+function DosCreateThread (var TID: cardinal; Address: pointer;
+(* TThreadFunc *)
+ aParam: pointer; Flags: cardinal; StackSize: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 311;
+
+procedure DosExit (Action, Result: cardinal); cdecl;
+ external 'DOSCALLS' index 234;
+
+function DosCreateMutExSem (Name: PChar; var Handle: longint; Attr: cardinal;
+ State: boolean): cardinal; cdecl; external 'DOSCALLS' index 331;
+
+function DosCloseMutExSem (Handle: longint): cardinal; cdecl;
+ external 'DOSCALLS' index 333;
+
+function DosQueryMutExSem (Handle: longint; var PID, TID, Count: cardinal):
+ cardinal; cdecl; external 'DOSCALLS' index 336;
+
+function DosRequestMutExSem (Handle:longint; Timeout: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 334;
+
+function DosReleaseMutExSem (Handle: longint): cardinal; cdecl;
+ external 'DOSCALLS' index 335;
+
+function DosAllocMem (var P: pointer; Size, Flag: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 299;
+
+function DosFreeMem (P: pointer): cardinal; cdecl;
+ external 'DOSCALLS' index 304;
+
+function DosEnterCritSec:cardinal; cdecl; external 'DOSCALLS' index 232;
+
+function DosExitCritSec:cardinal; cdecl; external 'DOSCALLS' index 233;
+
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+const
+ ThreadVarBlockSize: dword = 0;
+
+var
+(* Pointer to an allocated dword space within the local thread *)
+(* memory area. Pointer to the real memory block allocated for *)
+(* thread vars in this block is then stored in this dword. *)
+ DataIndex: PPointer;
+
+procedure SysInitThreadvar (var Offset: dword; Size: dword);
+begin
+ Offset := ThreadVarBlockSize;
+ Inc (ThreadVarBlockSize, Size);
+end;
+
+function SysRelocateThreadVar (Offset: dword): pointer;
+begin
+ SysRelocateThreadVar := DataIndex^ + Offset;
+end;
+
+procedure SysAllocateThreadVars;
+begin
+ { we've to allocate the memory from the OS }
+ { because the FPC heap management uses }
+ { exceptions which use threadvars but }
+ { these aren't allocated yet ... }
+ { allocate room on the heap for the thread vars }
+ if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
+ or pag_Commit) <> 0 then HandleError (8);
+end;
+
+procedure SysReleaseThreadVars;
+begin
+ { release thread vars }
+ DosFreeMem (DataIndex^);
+end;
+
+
+ procedure InitThreadVars;
+ begin
+ { allocate one ThreadVar entry from the OS, we use this entry }
+ { for a pointer to our threadvars }
+ if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then HandleError (8);
+ { initialize threadvars }
+ init_all_unit_threadvars;
+ { allocate mem for main thread threadvars }
+ SysAllocateThreadVars;
+ { copy main thread threadvars }
+ copy_all_unit_threadvars;
+ { install threadvar handler }
+ fpc_threadvar_relocate_proc := @SysRelocateThreadvar;
+ end;
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+ Delphi/Win32 compatibility
+*****************************************************************************}
+
+{ we implement these procedures for win32 by importing them }
+{ directly from windows }
+procedure SysInitCriticalSection(var cs : TRTLCriticalSection);
+ external 'kernel32' name 'InitializeCriticalSection';
+
+procedure SysDoneCriticalSection(var cs : TRTLCriticalSection);
+ external 'kernel32' name 'DeleteCriticalSection';
+
+procedure SysEnterCriticalSection(var cs : TRTLCriticalSection);
+ external 'kernel32' name 'EnterCriticalSection';
+
+procedure SysLeaveCriticalSection(var cs : TRTLCriticalSection);
+ external 'kernel32' name 'LeaveCriticalSection';
+
+
+{*****************************************************************************
+ Heap Mutex Protection
+*****************************************************************************}
+
+ var
+ HeapMutex : TRTLCriticalSection;
+
+ procedure OS2HeapMutexInit;
+ begin
+ SysInitCriticalSection(heapmutex);
+ end;
+
+ procedure OS2HeapMutexDone;
+ begin
+ SysDoneCriticalSection(heapmutex);
+ end;
+
+ procedure OS2HeapMutexLock;
+ begin
+ SysEnterCriticalSection(heapmutex);
+ end;
+
+ procedure OS2HeapMutexUnlock;
+ begin
+ SysLeaveCriticalSection(heapmutex);
+ end;
+
+ const
+ OS2MemoryMutexManager : TMemoryMutexManager = (
+ MutexInit : @OS2HeapMutexInit;
+ MutexDone : @OS2HeapMutexDone;
+ MutexLock : @OS2HeapMutexLock;
+ MutexUnlock : @OS2HeapMutexUnlock;
+ );
+
+ procedure InitSystemThreads;
+ begin
+ SetNoThreadManager;
+ SetMemoryMutexManager(OS2MemoryMutexManager);
+ end;
+
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/emx/sysutils.pp b/rtl/emx/sysutils.pp
new file mode 100644
index 0000000000..a07d45fd53
--- /dev/null
+++ b/rtl/emx/sysutils.pp
@@ -0,0 +1,1232 @@
+{
+ $Id: sysutils.pp,v 1.20 2005/02/26 14:38:14 florian Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for EMX
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ Dos;
+
+{$DEFINE HAS_SLEEP}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ System (imported) calls
+****************************************************************************}
+
+(* "uses DosCalls" could not be used here due to type *)
+(* conflicts, so needed parts had to be redefined here). *)
+
+type
+ TFileStatus = object
+ end;
+ PFileStatus = ^TFileStatus;
+
+ TFileStatus3 = object (TFileStatus)
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ end;
+ PFileStatus3=^TFileStatus3;
+
+ TFileStatus4=object(TFileStatus3)
+ cbList:cardinal; {Length of entire EA set.}
+ end;
+ PFileStatus4=^TFileStatus4;
+
+ TFileFindBuf3=object(TFileStatus)
+ NextEntryOffset: cardinal; {Offset of next entry}
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ Name:shortstring; {Also possible to use as ASCIIZ.
+ The byte following the last string
+ character is always zero.}
+ end;
+ PFileFindBuf3=^TFileFindBuf3;
+
+ TFileFindBuf4=object(TFileStatus)
+ NextEntryOffset: cardinal; {Offset of next entry}
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ cbList:longint; {Size of the file's extended attributes.}
+ Name:shortstring; {Also possible to use as ASCIIZ.
+ The byte following the last string
+ character is always zero.}
+ end;
+ PFileFindBuf4=^TFileFindBuf4;
+
+ TFSInfo = record
+ case word of
+ 1:
+ (File_Sys_ID,
+ Sectors_Per_Cluster,
+ Total_Clusters,
+ Free_Clusters: cardinal;
+ Bytes_Per_Sector: word);
+ 2: {For date/time description,
+ see file searching realted
+ routines.}
+ (Label_Date, {Date when volume label was created.}
+ Label_Time: word; {Time when volume label was created.}
+ VolumeLabel: ShortString); {Volume label. Can also be used
+ as ASCIIZ, because the byte
+ following the last character of
+ the string is always zero.}
+ end;
+ PFSInfo = ^TFSInfo;
+
+ TCountryCode=record
+ Country, {Country to query info about (0=current).}
+ CodePage: cardinal; {Code page to query info about (0=current).}
+ end;
+ PCountryCode=^TCountryCode;
+
+ TTimeFmt = (Clock12, Clock24);
+
+ TCountryInfo=record
+ Country, CodePage: cardinal; {Country and codepage requested.}
+ case byte of
+ 0:
+ (DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
+ CurrencyUnit: array [0..4] of char;
+ ThousandSeparator: char; {Thousands separator.}
+ Zero1: byte; {Always zero.}
+ DecimalSeparator: char; {Decimals separator,}
+ Zero2: byte;
+ DateSeparator: char; {Date separator.}
+ Zero3: byte;
+ TimeSeparator: char; {Time separator.}
+ Zero4: byte;
+ CurrencyFormat, {Bit field:
+ Bit 0: 0=indicator before value
+ 1=indicator after value
+ Bit 1: 1=insert space after
+ indicator.
+ Bit 2: 1=Ignore bit 0&1, replace
+ decimal separator with
+ indicator.}
+ DecimalPlace: byte; {Number of decimal places used in
+ currency indication.}
+ TimeFormat: TTimeFmt; {12/24 hour.}
+ Reserve1: array [0..1] of word;
+ DataSeparator: char; {Data list separator}
+ Zero5: byte;
+ Reserve2: array [0..4] of word);
+ 1:
+ (fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
+ szCurrency: array [0..4] of char;
+ {null terminated currency symbol}
+ szThousandsSeparator: array [0..1] of char;
+ {Thousands separator + #0}
+ szDecimal: array [0..1] of char;
+ {Decimals separator + #0}
+ szDateSeparator: array [0..1] of char;
+ {Date separator + #0}
+ szTimeSeparator: array [0..1] of char;
+ {Time separator + #0}
+ fsCurrencyFmt, {Bit field:
+ Bit 0: 0=indicator before value
+ 1=indicator after value
+ Bit 1: 1=insert space after
+ indicator.
+ Bit 2: 1=Ignore bit 0&1, replace
+ decimal separator with
+ indicator}
+ cDecimalPlace: byte; {Number of decimal places used in
+ currency indication}
+ fsTimeFmt: byte; {0=12,1=24 hours}
+ abReserved1: array [0..1] of word;
+ szDataSeparator: array [0..1] of char;
+ {Data list separator + #0}
+ abReserved2: array [0..4] of word);
+ end;
+ PCountryInfo=^TCountryInfo;
+
+ TRequestData=record
+ PID, {ID of process that wrote element.}
+ Data: cardinal; {Information from process writing the data.}
+ end;
+ PRequestData=^TRequestData;
+
+{Queue data structure for synchronously started sessions.}
+ TChildInfo = record
+ case boolean of
+ false:
+ (SessionID,
+ Return: word); {Return code from the child process.}
+ true:
+ (usSessionID,
+ usReturn: word); {Return code from the child process.}
+ end;
+ PChildInfo = ^TChildInfo;
+
+ TStartData=record
+ {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
+ Length:word; {Length, in bytes, of datastructure
+ (24/30/32/50/60).}
+ Related:word; {Independent/child session (0/1).}
+ FgBg:word; {Foreground/background (0/1).}
+ TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
+ PgmTitle:PChar; {Program title.}
+ PgmName:PChar; {Filename to program.}
+ PgmInputs:PChar; {Command parameters (nil allowed).}
+ TermQ:PChar; {System queue. (nil allowed).}
+ Environment:PChar; {Environment to pass (nil allowed).}
+ InheritOpt:word; {Inherit enviroment from shell/
+ inherit environment from parent (0/1).}
+ SessionType:word; {Auto/full screen/window/presentation
+ manager/full screen Dos/windowed Dos
+ (0/1/2/3/4/5/6/7).}
+ Iconfile:PChar; {Icon file to use (nil allowed).}
+ PgmHandle:cardinal; {0 or the program handle.}
+ PgmControl:word; {Bitfield describing initial state
+ of windowed sessions.}
+ InitXPos,InitYPos:word; {Initial top coordinates.}
+ InitXSize,InitYSize:word; {Initial size.}
+ Reserved:word;
+ ObjectBuffer:PChar; {If a module cannot be loaded, its
+ name will be returned here.}
+ ObjectBuffLen:cardinal; {Size of your buffer.}
+ end;
+ PStartData=^TStartData;
+
+const
+ ilStandard = 1;
+ ilQueryEAsize = 2;
+ ilQueryEAs = 3;
+ ilQueryFullName = 5;
+
+ quFIFO = 0;
+ quLIFO = 1;
+ quPriority = 2;
+
+ quNoConvert_Address = 0;
+ quConvert_Address = 4;
+
+{Start the new session independent or as a child.}
+ ssf_Related_Independent = 0; {Start new session independent
+ of the calling session.}
+ ssf_Related_Child = 1; {Start new session as a child
+ session to the calling session.}
+
+{Start the new session in the foreground or in the background.}
+ ssf_FgBg_Fore = 0; {Start new session in foreground.}
+ ssf_FgBg_Back = 1; {Start new session in background.}
+
+{Should the program started in the new session
+ be executed under conditions for tracing?}
+ ssf_TraceOpt_None = 0; {No trace.}
+ ssf_TraceOpt_Trace = 1; {Trace with no notification
+ of descendants.}
+ ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
+ A termination queue must be
+ supplied and Related must be
+ ssf_Related_Child (=1).}
+
+{Will the new session inherit open file handles
+ and environment from the calling process.}
+ ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
+ ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
+
+{Specifies the type of session to start.}
+ ssf_Type_Default = 0; {Use program's type.}
+ ssf_Type_FullScreen = 1; {OS/2 full screen.}
+ ssf_Type_WindowableVIO = 2; {OS/2 window.}
+ ssf_Type_PM = 3; {Presentation Manager.}
+ ssf_Type_VDM = 4; {DOS full screen.}
+ ssf_Type_WindowedVDM = 7; {DOS window.}
+{Additional values for Windows programs}
+ Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
+ own windowed session.}
+ Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
+ common windowed session.}
+ Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
+ compatibility mode in its own
+ windowed session.}
+ Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
+ compatibility mode in a common
+ windowed session.}
+ Prog_31_Enh = 19; {Windows 3.1 program in enhanced
+ compatibility mode in a full
+ screen session.}
+ Prog_31_Std = 20; {Windows 3.1 program in a full
+ screen session.}
+
+{Specifies the initial attributes for a OS/2 window or DOS window session.}
+ ssf_Control_Visible = 0; {Window is visible.}
+ ssf_Control_Invisible = 1; {Window is invisible.}
+ ssf_Control_Maximize = 2; {Window is maximized.}
+ ssf_Control_Minimize = 4; {Window is minimized.}
+ ssf_Control_NoAutoClose = 8; {Window will not close after
+ the program has ended.}
+ ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
+ InitXSize, and InitYSize for
+ the size and placement.}
+
+
+{This is the correct way to call external assembler procedures.}
+procedure syscall;external name '___SYSCALL';
+
+function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
+
+function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
+ BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
+
+function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 279;
+
+function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
+ external 'DOSCALLS' index 227;
+
+function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 264;
+
+function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 265;
+
+function DosFindClose (Handle: THandle): cardinal; cdecl;
+ external 'DOSCALLS' index 263;
+
+function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
+ var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
+ external 'NLS' index 5;
+
+function DosMapCase (Size: cardinal; var Country: TCountryCode;
+ AString: PChar): cardinal; cdecl; external 'NLS' index 7;
+
+procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
+
+function DosCreateQueue (var Handle: THandle; Priority:longint;
+ Name: PChar): cardinal; cdecl;
+ external 'QUECALLS' index 16;
+
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ Element, Wait: cardinal; var Priority: byte;
+ ASem: THandle): cardinal; cdecl;
+ external 'QUECALLS' index 9;
+
+function DosCloseQueue (Handle: THandle): cardinal; cdecl;
+ external 'QUECALLS' index 11;
+
+function DosStartSession (var AStartData: TStartData;
+ var SesID, PID: cardinal): cardinal; cdecl;
+ external 'SESMGR' index 37;
+
+function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+const
+ ofRead = $0000; {Open for reading}
+ ofWrite = $0001; {Open for writing}
+ ofReadWrite = $0002; {Open for reading/writing}
+ doDenyRW = $0010; {DenyAll (no sharing)}
+ faCreateNew = $00010000; {Create if file does not exist}
+ faOpenReplace = $00040000; {Truncate if file exists}
+ faCreate = $00050000; {Create if file does not exist, truncate otherwise}
+
+ FindResvdMask = $00003737; {Allowed bits in attribute
+ specification for DosFindFirst call.}
+
+{$ASMMODE INTEL}
+function FileOpen (const FileName: string; Mode: integer): longint; assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ecx, edx
+ mov edx, eax
+{$ELSE REGCALL}
+ mov ecx, Mode
+ mov edx, FileName
+{$ENDIF REGCALL}
+(* DenyAll if sharing not specified. *)
+ test ecx, 112
+ jnz @FOpen1
+ or ecx, 16
+@FOpen1:
+ mov eax, 7F2Bh
+ call syscall
+ pop ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+
+function FileCreate (const FileName: string): longint; assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov edx, eax
+{$ELSE REGCALL}
+ mov edx, FileName
+{$ENDIF REGCALL}
+ mov eax, 7F2Bh
+ mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
+ call syscall
+ pop ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+
+function FileCreate (const FileName: string; Mode: integer): longint;
+begin
+ FileCreate:=FileCreate(FileName);
+end;
+
+
+function FileRead (Handle: longint; var Buffer; Count: longint): longint;
+ assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ebx, eax
+{$ELSE REGCALL}
+ mov ebx, Handle
+ mov ecx, Count
+ mov edx, Buffer
+{$ENDIF REGCALL}
+ mov eax, 3F00h
+ call syscall
+ jnc @FReadEnd
+ mov eax, -1
+@FReadEnd:
+ pop ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+
+function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
+ assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ebx, eax
+{$ELSE REGCALL}
+ mov ebx, Handle
+ mov ecx, Count
+ mov edx, Buffer
+{$ENDIF REGCALL}
+ mov eax, 4000h
+ call syscall
+ jnc @FWriteEnd
+ mov eax, -1
+@FWriteEnd:
+ pop ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+
+function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ebx, eax
+ mov eax, ecx
+{$ELSE REGCALL}
+ mov ebx, Handle
+ mov eax, Origin
+ mov edx, FOffset
+{$ENDIF REGCALL}
+ mov ah, 42h
+ call syscall
+ jnc @FSeekEnd
+ mov eax, -1
+@FSeekEnd:
+ pop ebx
+end {['eax', 'ebx', 'edx']};
+
+function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
+begin
+ {$warning need to add 64bit call }
+ Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
+end;
+
+procedure FileClose (Handle: longint);
+begin
+ if (Handle > 4) or ((os_mode = osOS2) and (Handle > 2)) then
+ asm
+ push ebx
+ mov eax, 3E00h
+ mov ebx, Handle
+ call syscall
+ pop ebx
+ end ['eax'];
+end;
+
+
+function FileTruncate (Handle, Size: longint): boolean; assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ebx, eax
+{$ELSE REGCALL}
+ mov ebx, Handle
+ mov edx, Size
+{$ENDIF REGCALL}
+ mov eax, 7F25h
+ push ebx
+ call syscall
+ pop ebx
+ jc @FTruncEnd
+ mov eax, 4202h
+ mov edx, 0
+ call syscall
+ mov eax, 0
+ jnc @FTruncEnd
+ dec eax
+@FTruncEnd:
+ pop ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+
+function FileAge (const FileName: string): longint;
+var Handle: longint;
+begin
+ Handle := FileOpen (FileName, 0);
+ if Handle <> -1 then
+ begin
+ Result := FileGetDate (Handle);
+ FileClose (Handle);
+ end
+ else
+ Result := -1;
+end;
+
+
+function FileExists (const FileName: string): boolean; assembler;
+asm
+{$IFDEF REGCALL}
+ mov edx, eax
+{$ELSE REGCALL}
+ mov edx, FileName
+{$ENDIF REGCALL}
+ mov ax, 4300h
+ call syscall
+ mov eax, 0
+ jc @FExistsEnd
+ test cx, 18h
+ jnz @FExistsEnd
+ inc eax
+@FExistsEnd:
+end {['eax', 'ecx', 'edx']};
+
+
+type TRec = record
+ T, D: word;
+ end;
+ PSearchRec = ^SearchRec;
+
+function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
+
+var SR: PSearchRec;
+ FStat: PFileFindBuf3;
+ Count: cardinal;
+ Err: cardinal;
+
+begin
+ if os_mode = osOS2 then
+ begin
+ New (FStat);
+ Rslt.FindHandle := $FFFFFFFF;
+ Count := 1;
+ Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
+ Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
+ ilStandard);
+ if (Err = 0) and (Count = 0) then Err := 18;
+ FindFirst := -Err;
+ if Err = 0 then
+ begin
+ Rslt.Name := FStat^.Name;
+ Rslt.Size := FStat^.FileSize;
+ Rslt.Attr := FStat^.AttrFile;
+ Rslt.ExcludeAttr := 0;
+ TRec (Rslt.Time).T := FStat^.TimeLastWrite;
+ TRec (Rslt.Time).D := FStat^.DateLastWrite;
+ end;
+ Dispose (FStat);
+ end
+ else
+ begin
+ Err := DOS.DosError;
+ GetMem (SR, SizeOf (SearchRec));
+ Rslt.FindHandle := longint(SR);
+ DOS.FindFirst (Path, Attr, SR^);
+ FindFirst := -DOS.DosError;
+ if DosError = 0 then
+ begin
+ Rslt.Time := SR^.Time;
+ Rslt.Size := SR^.Size;
+ Rslt.Attr := SR^.Attr;
+ Rslt.ExcludeAttr := 0;
+ Rslt.Name := SR^.Name;
+ end;
+ DOS.DosError := Err;
+ end;
+end;
+
+
+function FindNext (var Rslt: TSearchRec): longint;
+
+var SR: PSearchRec;
+ FStat: PFileFindBuf3;
+ Count: cardinal;
+ Err: cardinal;
+
+begin
+ if os_mode = osOS2 then
+ begin
+ New (FStat);
+ Count := 1;
+ Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
+ Count);
+ if (Err = 0) and (Count = 0) then Err := 18;
+ FindNext := -Err;
+ if Err = 0 then
+ begin
+ Rslt.Name := FStat^.Name;
+ Rslt.Size := FStat^.FileSize;
+ Rslt.Attr := FStat^.AttrFile;
+ Rslt.ExcludeAttr := 0;
+ TRec (Rslt.Time).T := FStat^.TimeLastWrite;
+ TRec (Rslt.Time).D := FStat^.DateLastWrite;
+ end;
+ Dispose (FStat);
+ end
+ else
+ begin
+ SR := PSearchRec (Rslt.FindHandle);
+ if SR <> nil then
+ begin
+ DOS.FindNext (SR^);
+ FindNext := -DosError;
+ if DosError = 0 then
+ begin
+ Rslt.Time := SR^.Time;
+ Rslt.Size := SR^.Size;
+ Rslt.Attr := SR^.Attr;
+ Rslt.ExcludeAttr := 0;
+ Rslt.Name := SR^.Name;
+ end;
+ end;
+ end;
+end;
+
+
+procedure FindClose (var F: TSearchrec);
+
+var SR: PSearchRec;
+
+begin
+ if os_mode = osOS2 then
+ begin
+ DosFindClose (F.FindHandle);
+ end
+ else
+ begin
+ SR := PSearchRec (F.FindHandle);
+ DOS.FindClose (SR^);
+ FreeMem (SR, SizeOf (SearchRec));
+ end;
+ F.FindHandle := 0;
+end;
+
+
+function FileGetDate (Handle: longint): longint; assembler;
+asm
+ push ebx
+{$IFDEF REGCALL}
+ mov ebx, eax
+{$ELSE REGCALL}
+ mov ebx, Handle
+{$ENDIF REGCALL}
+ mov ax, 5700h
+ call syscall
+ mov eax, -1
+ jc @FGetDateEnd
+ mov ax, dx
+ shld eax, ecx, 16
+@FGetDateEnd:
+ pop ebx
+end {['eax', 'ebx', 'ecx', 'edx']};
+
+
+function FileSetDate (Handle, Age: longint): longint;
+var FStat: PFileStatus3;
+ RC: cardinal;
+begin
+ if os_mode = osOS2 then
+begin
+ New (FStat);
+ RC := DosQueryFileInfo (Handle, ilStandard, FStat,
+ SizeOf (FStat^));
+ if RC <> 0 then
+ FileSetDate := -1
+ else
+ begin
+ FStat^.DateLastAccess := Hi (Age);
+ FStat^.DateLastWrite := Hi (Age);
+ FStat^.TimeLastAccess := Lo (Age);
+ FStat^.TimeLastWrite := Lo (Age);
+ RC := DosSetFileInfo (Handle, ilStandard, FStat,
+ SizeOf (FStat^));
+ if RC <> 0 then
+ FileSetDate := -1
+ else
+ FileSetDate := 0;
+ end;
+ Dispose (FStat);
+ end
+ else
+ asm
+ push ebx
+ mov ax, 5701h
+ mov ebx, Handle
+ mov cx, word ptr [Age]
+ mov dx, word ptr [Age + 2]
+ call syscall
+ jnc @FSetDateEnd
+ mov eax, -1
+@FSetDateEnd:
+ mov Result, eax
+ pop ebx
+ end ['eax', 'ecx', 'edx'];
+end;
+
+
+function FileGetAttr (const FileName: string): longint; assembler;
+asm
+{$IFDEF REGCALL}
+ mov edx, eax
+{$ELSE REGCALL}
+ mov edx, FileName
+{$ENDIF REGCALL}
+ mov ax, 4300h
+ call syscall
+ jnc @FGetAttrEnd
+ mov eax, -1
+@FGetAttrEnd:
+end {['eax', 'edx']};
+
+
+function FileSetAttr (const Filename: string; Attr: longint): longint; assembler;
+asm
+{$IFDEF REGCALL}
+ mov ecx, edx
+ mov edx, eax
+{$ELSE REGCALL}
+ mov ecx, Attr
+ mov edx, FileName
+{$ENDIF REGCALL}
+ mov ax, 4301h
+ call syscall
+ mov eax, 0
+ jnc @FSetAttrEnd
+ mov eax, -1
+@FSetAttrEnd:
+end {['eax', 'ecx', 'edx']};
+
+
+function DeleteFile (const FileName: string): boolean; assembler;
+asm
+{$IFDEF REGCALL}
+ mov edx, eax
+{$ELSE REGCALL}
+ mov edx, FileName
+{$ENDIF REGCALL}
+ mov ax, 4100h
+ call syscall
+ mov eax, 0
+ jc @FDeleteEnd
+ inc eax
+@FDeleteEnd:
+end {['eax', 'edx']};
+
+
+function RenameFile (const OldName, NewName: string): boolean; assembler;
+asm
+ push edi
+{$IFDEF REGCALL}
+ mov edx, eax
+ mov edi, edx
+{$ELSE REGCALL}
+ mov edx, OldName
+ mov edi, NewName
+{$ENDIF REGCALL}
+ mov ax, 5600h
+ call syscall
+ mov eax, 0
+ jc @FRenameEnd
+ inc eax
+@FRenameEnd:
+ pop edi
+end {['eax', 'edx', 'edi']};
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+{$ASMMODE ATT}
+
+function DiskFree (Drive: byte): int64;
+
+var FI: TFSinfo;
+ RC: cardinal;
+
+begin
+ if (os_mode = osDOS) or (os_mode = osDPMI) then
+ {Function 36 is not supported in OS/2.}
+ asm
+ pushl %ebx
+ movb Drive,%dl
+ movb $0x36,%ah
+ call syscall
+ cmpw $-1,%ax
+ je .LDISKFREE1
+ mulw %cx
+ mulw %bx
+ shll $16,%edx
+ movw %ax,%dx
+ movl $0,%eax
+ xchgl %edx,%eax
+ jmp .LDISKFREE2
+ .LDISKFREE1:
+ cltd
+ .LDISKFREE2:
+ popl %ebx
+ leave
+ ret
+ end
+ else
+ {In OS/2, we use the filesystem information.}
+ begin
+ RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskFree := int64 (FI.Free_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskFree := -1;
+ end;
+end;
+
+function DiskSize (Drive: byte): int64;
+
+var FI: TFSinfo;
+ RC: cardinal;
+
+begin
+ if (os_mode = osDOS) or (os_mode = osDPMI) then
+ {Function 36 is not supported in OS/2.}
+ asm
+ pushl %ebx
+ movb Drive,%dl
+ movb $0x36,%ah
+ call syscall
+ movw %dx,%bx
+ cmpw $-1,%ax
+ je .LDISKSIZE1
+ mulw %cx
+ mulw %bx
+ shll $16,%edx
+ movw %ax,%dx
+ movl $0,%eax
+ xchgl %edx,%eax
+ jmp .LDISKSIZE2
+ .LDISKSIZE1:
+ cltd
+ .LDISKSIZE2:
+ popl %ebx
+ leave
+ ret
+ end
+ else
+ {In OS/2, we use the filesystem information.}
+ begin
+ RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskSize := int64 (FI.Total_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskSize := -1;
+ end;
+end;
+
+
+function GetCurrentDir: string;
+begin
+ GetDir (0, Result);
+end;
+
+
+function SetCurrentDir (const NewDir: string): boolean;
+begin
+{$I-}
+ ChDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function CreateDir (const NewDir: string): boolean;
+begin
+{$I-}
+ MkDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function RemoveDir (const Dir: string): boolean;
+begin
+{$I-}
+ RmDir (Dir);
+ Result := (IOResult = 0);
+ {$I+}
+end;
+
+
+{$ASMMODE INTEL}
+function DirectoryExists (const Directory: string): boolean; assembler;
+asm
+{$IFDEF REGCALL}
+ mov edx, eax
+{$ELSE REGCALL}
+ mov edx, Directory
+{$ENDIF REGCALL}
+ mov ax, 4300h
+ call syscall
+ mov eax, 0
+ jc @FExistsEnd
+ test cx, 10h
+ jz @FExistsEnd
+ inc eax
+@FExistsEnd:
+end {['eax', 'ecx', 'edx']};
+
+
+{****************************************************************************
+ Time Functions
+****************************************************************************}
+
+procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
+asm
+(* Expects the default record alignment (word)!!! *)
+ push edi
+{$IFDEF REGCALL}
+ push eax
+{$ENDIF REGCALL}
+ mov ah, 2Ah
+ call syscall
+{$IFDEF REGCALL}
+ pop eax
+{$ELSE REGCALL}
+ mov edi, SystemTime
+{$ENDIF REGCALL}
+ mov ax, cx
+ stosw
+ xor eax, eax
+ mov al, 10
+ mul dl
+ shl eax, 16
+ mov al, dh
+ stosd
+ push edi
+ mov ah, 2Ch
+ call syscall
+ pop edi
+ xor eax, eax
+ mov al, cl
+ shl eax, 16
+ mov al, ch
+ stosd
+ mov al, dl
+ shl eax, 16
+ mov al, dh
+ stosd
+ pop edi
+end {['eax', 'ecx', 'edx', 'edi']};
+{$asmmode default}
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+procedure InitAnsi;
+var I: byte;
+ Country: TCountryCode;
+begin
+ for I := 0 to 255 do
+ UpperCaseTable [I] := Chr (I);
+ Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
+ if os_mode = osOS2 then
+ begin
+ FillChar (Country, SizeOf (Country), 0);
+ DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
+ end
+ else
+ begin
+(* !!! TODO: DOS/DPMI mode support!!! *)
+ end;
+ for I := 0 to 255 do
+ if UpperCaseTable [I] <> Chr (I) then
+ LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
+end;
+
+
+procedure InitInternational;
+var Country: TCountryCode;
+ CtryInfo: TCountryInfo;
+ Size: cardinal;
+ RC: cardinal;
+begin
+ Size := 0;
+ FillChar (Country, SizeOf (Country), 0);
+ FillChar (CtryInfo, SizeOf (CtryInfo), 0);
+ RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
+ if RC = 0 then
+ begin
+ DateSeparator := CtryInfo.DateSeparator;
+ case CtryInfo.DateFormat of
+ 1: begin
+ ShortDateFormat := 'd/m/y';
+ LongDateFormat := 'dd" "mmmm" "yyyy';
+ end;
+ 2: begin
+ ShortDateFormat := 'y/m/d';
+ LongDateFormat := 'yyyy" "mmmm" "dd';
+ end;
+ 3: begin
+ ShortDateFormat := 'm/d/y';
+ LongDateFormat := 'mmmm" "dd" "yyyy';
+ end;
+ end;
+ TimeSeparator := CtryInfo.TimeSeparator;
+ DecimalSeparator := CtryInfo.DecimalSeparator;
+ ThousandSeparator := CtryInfo.ThousandSeparator;
+ CurrencyFormat := CtryInfo.CurrencyFormat;
+ CurrencyString := PChar (CtryInfo.CurrencyUnit);
+ end;
+ InitAnsi;
+ InitInternationalGeneric;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+
+{****************************************************************************
+ OS Utils
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
+end;
+
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+(* Result:=FPCCountEnvVar(EnvP); - the amount is already known... *)
+ GetEnvironmentVariableCount := EnvC;
+end;
+
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ Result:=FPCGetEnvStrFromP (EnvP, Index);
+end;
+
+
+{$ASMMODE INTEL}
+procedure Sleep (Milliseconds: cardinal);
+
+begin
+ if os_mode = osOS2 then DosSleep (Milliseconds) else
+ asm
+ mov edx, Milliseconds
+ mov eax, 7F30h
+ call syscall
+ end ['eax', 'edx'];
+end;
+{$ASMMODE DEFAULT}
+
+
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+ integer;
+var
+ HQ: THandle;
+ SPID, STID, QName: shortstring;
+ SD: TStartData;
+ SID, PID: cardinal;
+ RD: TRequestData;
+ PCI: PChildInfo;
+ CISize: cardinal;
+ Prio: byte;
+ E: EOSError;
+ CommandLine: ansistring;
+
+begin
+ if os_Mode = osOS2 then
+ begin
+ FillChar (SD, SizeOf (SD), 0);
+ SD.Length := 24;
+ SD.Related := ssf_Related_Child;
+ SD.PgmName := PChar (Path);
+ SD.PgmInputs := PChar (ComLine);
+ Str (GetProcessID, SPID);
+ Str (ThreadID, STID);
+ QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
+ SD.TermQ := @QName [1];
+ Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
+ if Result = 0 then
+ begin
+ Result := DosStartSession (SD, SID, PID);
+ if (Result = 0) or (Result = 457) then
+ begin
+ Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
+ if Result = 0 then
+ begin
+ Result := PCI^.Return;
+ DosCloseQueue (HQ);
+ DosFreeMem (PCI);
+ Exit;
+ end;
+ end;
+ DosCloseQueue (HQ);
+ end;
+ if ComLine = '' then
+ CommandLine := Path
+ else
+ CommandLine := Path + ' ' + ComLine;
+ E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]);
+ E.ErrorCode := Result;
+ raise E;
+ end else
+ begin
+ Dos.Exec (Path, ComLine);
+ if DosError <> 0 then
+ begin
+ if ComLine = '' then
+ CommandLine := Path
+ else
+ CommandLine := Path + ' ' + ComLine;
+ E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, DosError]);
+ E.ErrorCode := DosError;
+ raise E;
+ end;
+ ExecuteProcess := DosExitCode;
+ end;
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+
+{
+ $Log: sysutils.pp,v $
+ Revision 1.20 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.19 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/Makefile b/rtl/freebsd/Makefile
new file mode 100644
index 0000000000..1c77ec95d6
--- /dev/null
+++ b/rtl/freebsd/Makefile
@@ -0,0 +1,2055 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=freebsd
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+OSPROCINC=$(RTL)/freebsd/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+override FPCOPT+=-dNOMOUSE
+loaders+=gprt0
+else
+SYSTEMUNIT=sysbsd
+override FPCOPT+=-dUNIX -dNOMOUSE
+endif
+ifeq ($(CPU_TARGET),i386)
+CPU_UNITS=x86 ports cpu mmx graph
+else
+CPU_UNITS=
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil unix rtlconsts initc cmem matrix dl termio printer sysutils varutils variants typinfo types classes math dynlibs $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo errors sockets ipc terminfo video mouse keyboard console serial dateutils sysconst cthreads strutils convutils dos objects
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 cprt0 gprt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
+endif
+override INSTALL_FPCPACKAGE=y y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp unxconst.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+unixtype$(PPUEXT): $(UNIXINC)/unixtype.pp $(UNIXINC)/ctypes.inc ptypes.inc $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc \
+ $(BSDINC)/bunxsysc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc \
+ unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
+ $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER): $(OBJPASDIR)/rtlconsts.pp
+classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/convutils.pp
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
diff --git a/rtl/freebsd/Makefile.fpc b/rtl/freebsd/Makefile.fpc
new file mode 100644
index 0000000000..90b57ae2fd
--- /dev/null
+++ b/rtl/freebsd/Makefile.fpc
@@ -0,0 +1,282 @@
+#
+# Makefile.fpc for Free Pascal FreeBSD RTL
+#
+
+[package]
+main=rtl
+
+[install]
+fpcpackage=y
+
+[target]
+loaders=prt0 cprt0 gprt0
+units=$(SYSTEMUNIT) unixtype ctypes objpas macpas strings syscall sysctl baseunix unixutil \
+ unix rtlconsts initc cmem matrix \
+ dl termio printer \
+ sysutils varutils variants typinfo types classes math dynlibs \
+ $(CPU_UNITS) charset ucomplex crt getopts heaptrc lineinfo \
+ errors sockets ipc terminfo \
+ video mouse keyboard console serial dateutils \
+ sysconst cthreads strutils convutils dos objects
+
+rsts=math varutils typinfo classes variants dateutils sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=freebsd
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+ unix \
+ dos crt objects printer \
+ sysutils typinfo math \
+ $(CPU_UNITS) getopts heaptrc \
+ errors sockets ipc dynlibs
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+OSPROCINC=$(RTL)/freebsd/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+override FPCOPT+=-dNOMOUSE
+loaders+=gprt0
+else
+SYSTEMUNIT=sysbsd
+override FPCOPT+=-dUNIX -dNOMOUSE
+endif
+
+ifeq ($(CPU_TARGET),i386)
+CPU_UNITS=x86 ports cpu mmx graph
+else
+CPU_UNITS=
+endif
+
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp unxconst.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+unixtype$(PPUEXT): $(UNIXINC)/unixtype.pp $(UNIXINC)/ctypes.inc ptypes.inc $(SYSTEMUNIT)$(PPUEXT)
+
+baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc \
+ $(BSDINC)/bunxsysc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc \
+ unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+
+graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
+ $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER): $(OBJPASDIR)/rtlconsts.pp
+
+classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/convutils.pp
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
diff --git a/rtl/freebsd/bsdport.txt b/rtl/freebsd/bsdport.txt
new file mode 100644
index 0000000000..6dd960897f
--- /dev/null
+++ b/rtl/freebsd/bsdport.txt
@@ -0,0 +1,232 @@
+$Id: bsdport.txt,v 1.5 2003/11/18 21:47:19 marco Exp $
+
+The Free Pascal *BSD port.
+
+Comments, mistakes and suggestions to Marco@freepascal.org
+
+Since the last update to this document, I added the Net and OpenBSD ports,
+so now it is a *BSD port. I don't own BSDi or a Mac OS X, or even accounts
+on an intel system so that'll have to wait. (the Mac OS X/Darwin port
+will definitely take off if the PPC codegenerator is fully working)
+
+In 1.1.x branch, the tree RTLs will be merged into one, for easier
+maintaining, this will hopefully increase the Open and NetBSD ports
+somewhat.
+
+I'm actively searching for test accounts on Open and NetBSD/i386 (and
+in the future also for other processors).
+Requirements: minimal: some MBs account, permanent connection, 100 MHz+
+ (speed not that important)
+ cool : 100 MB + 100MB tempspace, low latency connection
+ fast machine that allows swift cycling.
+
+1 *BSD status and notes. (kept on CVS because I work on several places)
+-----------------------------------------------------------------------------
+
+Please read these before running a *BSD snapshot/release
+
+1.1 Supported OS versions.
+---
+
+ FREEBSD
+ 4.x : Used to develop and maintain port. Should work, all
+ versions. Best *BSD platform.
+
+ 3.x : _not_ supported, (3.2, 3.4, 3.6 would probably work
+ with some very minor changes to the signalhandling. The
+ syscall numbers changed)
+
+ (NON-ELF) 2.x : _not_ supported, but it might be doable. (the
+ OpenBSD port works on a.out)
+
+ 5.0DP1 : simple testing seemed to work without changes. Nearly
+ no package tests tried though.
+
+ NetBSD 1.5.x : Most stuff should work.
+ Rest : status unknown, though some NetBSD developper said
+ he didn't expect problems for 1.6.x
+
+ OpenBSD 3.1 : This version should work somewhat. Needs an assembler
+ from the ports tree (devel/binutils) to function
+ properly. Linker of the ports tree is easier,
+ but that one doesn't want to make shared files.
+
+The IDE also is starting to work quite nicely on FreeBSD, so it is included
+in the releases since 1.0.6. I didn't check the fixes for *BSD on the other
+two OSes yet.
+
+1.2 Known bugs
+---
+
+The FreeBSD/FPC port is now more or less a tested distro. There are several
+ known bugs, but I can now only remember one:
+
+- Recover from Delphi exceptions that originate as processor exceptions
+ will go wrong. (see texception4 in the test suite)
+
+ (recovering from several processor
+ exceptions in one proc will have unpredictable results (breakable hang
+ probably))
+
+1.3 Possible issues.
+
+Some things are not really bugs, but status is unknown, or there is
+something dodgy about the implementation:
+
+- The NetBSD and OpenBSD ports are barely tested, they build on the stable
+ FreeBSD base though. Most packages (and the FCL) have been tested with
+ FreeBSD, quite some with NetBSD, nearly none with OpenBSD.
+
+- IMPORTANT:
+ !!! An explicite warning: Not all procedures and structures in Linux are
+ checked, so even if they are not commented out, they can be not implemented!!!
+ This specially applies to linux specific stuff. In case of doubt, use a
+ scratch system, view the source, or mail the maintainer.
+ I fixed a bug in truncate just a few months ago, that had gone unnoticed
+ for the near two years that the port works now.!!!
+
+- The absence of kernel READDIR support has been fixed with a "hack", which
+ means that searchpath (-Fx) and FindFirst/FindNext are more or less
+ working. This "hacked" readdir implementation is now 1 1/2 year
+ bugfree now (and no anomolies detected), and works on the other two BSDs
+ too. Be careful with usage on "special" filesystems and files though.
+ (devfs, tmpfs hardlinks)
+ Together with Sebastian I developped a port of the libc routines, but
+ they don't work yet (NOTE to self: retest, am a lot better with debugger
+ now)
+
+3 How to build a *BSD compiler/RTL ?
+-----------------------------------------------------------------------------
+
+To rebuild the compiler, you need a starting compiler which is either the
+last releaseversion, or the release you are building itself (but e.g. on
+other OS)
+
+Preparation:
+- make sure your tree is up to date and cleaned of stale object and unit files.
+- I assume ppc386 is the name of your compiler. Append PP=<compilername> and
+ replace ppc386 with your compilername if it is different on your system.
+- I'll assume we are building openbsd on one of the other systems.
+
+- Start compiler on other OS? (tested is Linux) -> check 3.1
+ (crosscompiling)
+- Already a suitable 1.0.x startcompiler on *BSD -> 3.2 is much
+ easier.
+
+Trying to build with snapshot compiler binaries is no problem mosttimes, but
+release compilers _ought_ to work.
+
+3.1 How to build a *BSD system starting on (another *BSD, Linux, or Linux
+ emu on any of them).
+---
+
+The procedure here is verbose, and for the most akward case. If you have
+linux support on on your FreeBSD machine, or operate on NFS or Samba share
+(so that copying and using the sources in two systems is easier) some steps
+can be omitted or simplified. Just play with it.
+
+create the RTL:
+
+1. go to the target RTL directory. (if you want to build for OpenBSD, to
+ rtl/openbsd).
+2. If your binary format is the same (both are ELF), simply run
+ (g)make OS_TARGET=openbsd
+
+ this will be called "case A" from now on.
+ Otherwise we need to build via assembler files; (CASE B) and you'll
+ need to execute:
+
+ (g)make OS_TARGET=openbsd OPT='-a'
+
+compile the compiler:
+
+3. Go to the compiler/ directory
+ Case A:
+
+ make OS_TARGET=openbsd OPT='-Fu../rtl/openbsd -kdontlink'
+
+ Case B:
+
+ make OS_TARGET=openbsd OPT='-Fu../rtl/openbsd -kdontlink -a'
+
+4 Collect all necessary files, put them in one directory on the target
+ computer.
+
+ Case A: - all *.o and *.ppu files in compiler/ and rtl/openbsd/
+ - compiler/link.res and
+ - compiler/ppas.sh
+
+ Case B: - All *.s and *.ppu files in compiler/ and rtl/openbsd/
+ - the prt0.as file in rtl/openbsd/i386, rename this file to prt0.s
+ - compiler/link.res and compiler/ppas.sh
+
+Creating the final compiler:
+
+5 edit link.res, and fix all paths (it will include ../rtl/openbsd, simply
+ remove all paths in the INPUT() section, so filenames only)
+ Remove "dontlink" from the commandline of the linker in the ppas.sh file,
+ and make the ppas.sh file executable with chmod.
+
+6 Make sure you are in the right dir.
+ Case A: run ppas.sh
+ Case B: run the do_s script in the appendix (which will assembler all *.s
+ files to *.o on the target system), THEN run ppas.sh
+
+7 Test your compiler with pp -?, brandelf if necessary. (NetBSD ident code is
+ already in the prt0.s file. Will be for ELF OpenBSD too)
+
+Rebuild everything (compiler+RTL+FCL+pkgs) on the host system:
+
+8 Go to the toplevel directory fpc/
+
+9 Enter:
+ gmake all
+
+Install the system
+
+10 gmake install
+ (will install into $PREFIX=/usr/local)
+
+
+
+3.2 How to build a *BSD system if you have a suitable compiler on the
+targetsystem.
+---
+
+Rebuild everything (compiler+RTL+FCL+pkgs) on the host system:
+
+1 Go to the toplevel directory fpc/
+
+2 Enter:
+ gmake all
+
+Install the system
+
+3 gmake install
+ (will install into $PREFIX=/usr/local)
+
+
+------------------
+Appendix A: The DO_S script. (C) El Znorro
+------------------
+#!/bin/sh
+
+for i in *.s; do
+ flup=`basename $i .s`
+ as $i -o $flup.o
+ echo $i
+ echo $flup
+ done
+
+{
+$Log: bsdport.txt,v $
+Revision 1.5 2003/11/18 21:47:19 marco
+ * minor updates
+
+Revision 1.4 2002/09/07 16:01:17 peter
+ * old logs removed and tabs fixed
+
+Revision 1.3 2002/08/08 20:39:26 marco
+ * Practically rewritten in first update in 2 years or so.
+
+}
diff --git a/rtl/freebsd/console.pp b/rtl/freebsd/console.pp
new file mode 100644
index 0000000000..b537ecec7b
--- /dev/null
+++ b/rtl/freebsd/console.pp
@@ -0,0 +1,3482 @@
+{
+ $Id: console.pp,v 1.11 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Header conversions (with FpIoctl macro expansion) for FreeBSD 4.2's
+ sys/fbio.h sys/consio.h sys/kbdio.h (together these three form
+ machine/console.h) and
+ machine/mouse.h
+
+ Converted to use in a future FreeBSD API to get the IDE running on
+ the physical console with mousesupport.
+
+ As soon as cross unit inlining is ready, all functions should be made
+ inline. (so the FpIoctl and the other very small macro's)
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+UNIT Console;
+
+{$packrecords C}
+
+interface
+
+{I tried to keep original types as much as possible, only "int" is converted
+to longint because INT is a standard function in TP/FPC}
+
+TYPE
+ uchar = char;
+ uint = dword;
+ u_int = uint;
+ ushort= word;
+ short = integer;
+ long = dword; {?}
+ size_t= longint; {Dunno sure, but it is 32-bit}
+ caddr_t= longint; {idem}
+ vm_offset_t=dword; {idem}
+
+{----------------------------- sys/fbio.h ----------------------------------}
+
+{
+ * Copyright (c) 1992, 1993
+ * The Regents of the University of California. All rights reserved.
+ *
+ * This code is derived from software developed by the Computer Systems
+ * Engineering group at Lawrence Berkeley Laboratory under DARPA
+ * contract BG 91-66 and contributed to Berkeley.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * @(#)fbio.h 8.2 (Berkeley) 10/30/93
+ *
+ * $FreeBSD: src/sys/sys/fbio.h,v 1.9.2.1 2000/05/05 09:16:16 nyan Exp $
+ }
+
+{
+ * Frame buffer FpIoctls (from Sprite, trimmed to essentials for X11).
+ }
+
+{
+ * Frame buffer type codes.
+ }
+
+CONST
+
+ FBTYPE_SUN1BW =0; { multibus mono }
+ FBTYPE_SUN1COLOR =1; { multibus color }
+ FBTYPE_SUN2BW =2; { memory mono }
+ FBTYPE_SUN2COLOR =3; { color w/rasterop chips }
+ FBTYPE_SUN2GP =4; { GP1/GP2 }
+ FBTYPE_SUN5COLOR =5; { RoadRunner accelerator }
+ FBTYPE_SUN3COLOR =6; { memory color }
+ FBTYPE_MEMCOLOR =7; { memory 24-bit }
+ FBTYPE_SUN4COLOR =8; { memory color w/overlay }
+
+ FBTYPE_NOTSUN1 =9; { reserved for customer }
+ FBTYPE_NOTSUN2 =10; { reserved for customer }
+ FBTYPE_NOTSUN3 =11; { reserved for customer }
+
+ FBTYPE_SUNFAST_COLOR =12; { accelerated 8bit }
+ FBTYPE_SUNROP_COLOR =13; { MEMCOLOR with rop h/w }
+ FBTYPE_SUNFB_VIDEO =14; { Simple video mixing }
+ FBTYPE_RESERVED5 =15; { reserved, do not use }
+ FBTYPE_RESERVED4 =16; { reserved, do not use }
+ FBTYPE_RESERVED3 =17; { reserved, do not use }
+ FBTYPE_RESERVED2 =18; { reserved, do not use }
+ FBTYPE_RESERVED1 =19; { reserved, do not use }
+
+ FBTYPE_MDA =20;
+ FBTYPE_HERCULES =21;
+ FBTYPE_CGA =22;
+ FBTYPE_EGA =23;
+ FBTYPE_VGA =24;
+ FBTYPE_PC98 =25;
+ FBTYPE_TGA =26;
+
+ FBTYPE_LASTPLUSONE =27; { max number of fbs (change as add) }
+
+{
+ * Frame buffer descriptor as returned by FBIOGTYPE.
+ }
+
+type fbtype = record
+ fb_type : longint; { as defined above }
+ fb_height : longint; { in pixels }
+ fb_width : longint; { in pixels }
+ fb_depth : longint; { bits per pixel }
+ fb_cmsize : longint; { size of color map (entries) }
+ fb_size : longint; { total size in bytes }
+ end;
+
+Function FBIOGTYPE(fd:longint;var param1 : fbtype):boolean;
+
+{
+ * General purpose structure for passing info in and out of frame buffers
+ * (used for gp1) -- unsupported.
+ }
+type fbinfo = record
+ fb_physaddr : longint; { physical frame buffer address }
+ fb_hwwidth : longint; { fb board width }
+ fb_hwheight : longint; { fb board height }
+ fb_addrdelta : longint; { phys addr diff between boards }
+ fb_ropaddr : ^uchar; { fb virtual addr }
+ fb_unit : longint; { minor devnum of fb }
+ end;
+
+Function FBIOGINFO(fd:longint;var param1 : fbinfo):boolean;
+
+type
+{
+ * Color map I/O.
+ }
+ fbcmap = record
+ index : longint; { first element (0 origin) }
+ count : longint; { number of elements }
+ red : ^uchar; { red color map elements }
+ green : ^uchar; { green color map elements }
+ blue : ^uchar; { blue color map elements }
+ end;
+
+Function FBIOPUTCMAP(fd:longint;var param1 : fbcmap):boolean;
+Function FBIOGETCMAP(fd:longint;var param1 : fbcmap):boolean;
+
+{
+ * Set/get attributes.
+ }
+const
+ FB_ATTR_NDEVSPECIFIC =8; { no. of device specific values }
+ FB_ATTR_NEMUTYPES =4; { no. of emulation types }
+
+type fbsattr = record
+ flags:longint; { flags; see below }
+ emu_type : longint; { emulation type (-1 if unused) }
+ dev_specific : array[0..FB_ATTR_NDEVSPECIFIC-1] of longint; { catchall }
+ end;
+const
+ FB_ATTR_AUTOINIT =1; { emulation auto init flag }
+ FB_ATTR_DEVSPECIFIC =2; { dev. specific stuff valid flag }
+
+type fbgattr = record
+ real_type : longint; { real device type }
+ owner : longint; { PID of owner, 0 if myself }
+ _fbtype : fbtype; { fbtype info for real device }
+ sattr : fbsattr; { see above }
+ emu_types : array [0..FB_ATTR_NEMUTYPES-1] OF Longint; { possible emulations }
+ { (-1 if unused) }
+ end;
+
+{ FBIOSATTR _IOW('F', 5, struct fbsattr) -- unsupported }
+
+Function FBIOGATTR(fd:longint;var param1 : fbgattr):boolean;
+
+{
+ * Video control.
+ }
+
+const
+ FBVIDEO_OFF =0;
+ FBVIDEO_ON =1;
+
+Function FBIOSVIDEO(fd:longint;var param1 : longint):boolean;
+Function FBIOGVIDEO(fd:longint;var param1 : longint):boolean;
+
+{
+ * Hardware cursor control (for, e.g., CG6). A rather complex and icky
+ * interface that smells like VMS, but there it is....
+ }
+type fbcurpos = record
+ x : short;
+ y : short;
+ end;
+
+
+
+ fbcursor = record
+ _set : short; { flags; see below }
+ enable : short; { nonzero => cursor on, 0 => cursor off }
+ _pos : fbcurpos; { position on display }
+ hot : fbcurpos; { hot-spot within cursor }
+ cmap : fbcmap; { cursor color map }
+ _size : fbcurpos; { number of valid bits in image & mask }
+ image : caddr_t; { cursor image bits }
+ mask : caddr_t; { cursor mask bits }
+ end;
+
+const
+ FB_CUR_SETCUR =$01; { set on/off (i.e., obey fbcursor.enable) }
+ FB_CUR_SETPOS =$02; { set position }
+ FB_CUR_SETHOT =$04; { set hot-spot }
+ FB_CUR_SETCMAP =$08; { set cursor color map }
+ FB_CUR_SETSHAPE =$10; { set size & bits }
+ FB_CUR_SETALL =(FB_CUR_SETCUR OR FB_CUR_SETPOS OR FB_CUR_SETHOT OR
+ FB_CUR_SETCMAP OR FB_CUR_SETSHAPE);
+
+{ controls for cursor attributes & shape (including position) }
+Function FBIOSCURSOR(fd:longint;var param1 : fbcursor):boolean;
+Function FBIOGCURSOR(fd:longint;var param1 : fbcursor):boolean;
+
+{ controls for cursor position only }
+Function FBIOSCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+Function FBIOGCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+
+{ get maximum cursor size }
+Function FBIOGCURMAX(fd:longint;var param1 : fbcurpos):boolean;
+
+{ The new style frame buffer FpIoctls. }
+
+CONST
+ V_INFO_COLOR =(1 SHL 0);
+ V_INFO_GRAPHICS =(1 SHL 1);
+ V_INFO_LINEAR =(1 SHL 2);
+ V_INFO_VESA =(1 SHL 3);
+ V_INFO_MM_OTHER =(-1);
+ V_INFO_MM_TEXT =0;
+ V_INFO_MM_PLANAR =1;
+ V_INFO_MM_PACKED =2;
+ V_INFO_MM_DIRECT =3;
+ V_INFO_MM_CGA =100;
+ V_INFO_MM_HGC =101;
+ V_INFO_MM_VGAX =102;
+
+TYPE
+{ video mode information block }
+ video_info = record
+ vi_mode : longint; { mode number, see below }
+ vi_flags : longint;
+ vi_width : longint;
+ vi_height : longint;
+ vi_cwidth : longint;
+ vi_cheight : longint;
+ vi_depth : longint;
+ vi_planes : longint;
+ vi_window : uint; { physical address }
+ vi_window_size : size_t;
+ vi_window_gran : size_t;
+ vi_buffer : uint; { physical address }
+ vi_buffer_size : size_t;
+ vi_mem_model : longint;
+ { for MM_PACKED and MM_DIRECT only }
+ vi_pixel_size : longint; { in bytes }
+ { for MM_DIRECT only }
+ vi_pixel_fields : array[0..3] of longint; { RGB and reserved fields }
+ vi_pixel_fsizes : array[0..3] of longint;
+ { reserved }
+ vi_reserved : array[0..63] of uchar;
+ end;
+
+ video_info_t = video_info;
+const
+ KD_OTHER =0; { unknown }
+ KD_MONO =1; { monochrome adapter }
+ KD_HERCULES =2; { hercules adapter }
+ KD_CGA =3; { color graphics adapter }
+ KD_EGA =4; { enhanced graphics adapter }
+ KD_VGA =5; { video graphics adapter }
+ KD_PC98 =6; { PC-98 display }
+ KD_TGA =7; { TGA }
+ V_ADP_COLOR =(1 SHL 0);
+ V_ADP_MODECHANGE=(1 SHL 1);
+ V_ADP_STATESAVE =(1 SHL 2);
+ V_ADP_STATELOAD =(1 SHL 3);
+ V_ADP_FONT =(1 SHL 4);
+ V_ADP_PALETTE =(1 SHL 5);
+ V_ADP_BORDER =(1 SHL 6);
+ V_ADP_VESA =(1 SHL 7);
+ V_ADP_PROBED =(1 SHL 16);
+ V_ADP_INITIALIZED=(1 SHL 17);
+ V_ADP_REGISTERED =(1 SHL 18);
+
+{ adapter infromation block }
+type video_adapter = record
+ va_index : longint;
+ va_type : longint;
+ va_name : pchar;
+ va_unit : longint;
+ va_minor : longint;
+ va_flags : longint;
+ va_io_base : longint;
+ va_io_size : longint;
+ va_crtc_addr : longint;
+ va_mem_base : longint;
+ va_mem_size : longint;
+ va_window : vm_offset_t; { virtual address }
+ va_window_size : size_t;
+ va_window_gran : size_t;
+ va_window_orig : uint;
+ va_buffer : vm_offset_t; { virtual address }
+ va_buffer_size : size_t;
+ va_initial_mode : longint;
+ va_initial_bios_mode : longint;
+ va_mode : longint;
+ va_info : video_info;
+ va_line_width : longint;
+ va_disp_start : record
+ x : longint;
+ y : longint;
+ end;
+ va_token : pointer;
+ end;
+
+ video_adapter_t = video_adapter;
+
+ video_adapter_info = record
+ va_index : longint;
+ va_type : longint;
+ va_name : array[0..15] of char;
+ va_unit : longint;
+ va_flags : longint;
+ va_io_base : longint;
+ va_io_size : longint;
+ va_crtc_addr : longint;
+ va_mem_base : longint;
+ va_mem_size : longint;
+ va_window : uint; { virtual address }
+ va_window_size : size_t;
+ va_window_gran : size_t;
+ va_unused0 : uint;
+ va_buffer_size : size_t;
+ va_initial_mode : longint;
+ va_initial_bios_mode : longint;
+ va_mode : longint;
+ va_line_width : longint;
+ va_disp_start : record
+ x : longint;
+ y : longint;
+ end;
+ va_window_orig : uint;
+ { reserved }
+ va_reserved : array[0..63] OF uchar;
+ end;
+ video_adapter_info_t = video_adapter_info;
+
+CONST
+{ some useful video adapter index }
+ V_ADP_PRIMARY =0;
+ V_ADP_SECONDARY =1;
+
+{ video mode numbers }
+
+ M_B40x25 =0; { black & white 40 columns }
+ M_C40x25 =1; { color 40 columns }
+ M_B80x25 =2; { black & white 80 columns }
+ M_C80x25 =3; { color 80 columns }
+ M_BG320 =4; { black & white graphics 320x200 }
+ M_CG320 =5; { color graphics 320x200 }
+ M_BG640 =6; { black & white graphics 640x200 hi-res }
+ M_EGAMONO80x25 =7; { ega-mono 80x25 }
+ M_CG320_D =13; { ega mode D }
+ M_CG640_E =14; { ega mode E }
+ M_EGAMONOAPA =15; { ega mode F }
+ M_CG640x350 =16; { ega mode 10 }
+ M_ENHMONOAPA2 =17; { ega mode F with extended memory }
+ M_ENH_CG640 =18; { ega mode 10* }
+ M_ENH_B40x25 =19; { ega enhanced black & white 40 columns }
+ M_ENH_C40x25 =20; { ega enhanced color 40 columns }
+ M_ENH_B80x25 =21; { ega enhanced black & white 80 columns }
+ M_ENH_C80x25 =22; { ega enhanced color 80 columns }
+ M_VGA_C40x25 =23; { vga 8x16 font on color }
+ M_VGA_C80x25 =24; { vga 8x16 font on color }
+ M_VGA_M80x25 =25; { vga 8x16 font on mono }
+
+ M_VGA11 =26; { vga 640x480 2 colors }
+ M_BG640x480 =26;
+ M_VGA12 =27; { vga 640x480 16 colors }
+ M_CG640x480 =27;
+ M_VGA13 =28; { vga 320x200 256 colors }
+ M_VGA_CG320 =28;
+
+ M_VGA_C80x50 =30; { vga 8x8 font on color }
+ M_VGA_M80x50 =31; { vga 8x8 font on color }
+ M_VGA_C80x30 =32; { vga 8x16 font on color }
+ M_VGA_M80x30 =33; { vga 8x16 font on color }
+ M_VGA_C80x60 =34; { vga 8x8 font on color }
+ M_VGA_M80x60 =35; { vga 8x8 font on color }
+ M_VGA_CG640 =36; { vga 640x400 256 color }
+ M_VGA_MODEX =37; { vga 320x240 256 color }
+
+ M_VGA_C90x25 =40; { vga 8x16 font on color }
+ M_VGA_M90x25 =41; { vga 8x16 font on mono }
+ M_VGA_C90x30 =42; { vga 8x16 font on color }
+ M_VGA_M90x30 =43; { vga 8x16 font on mono }
+ M_VGA_C90x43 =44; { vga 8x8 font on color }
+ M_VGA_M90x43 =45; { vga 8x8 font on mono }
+ M_VGA_C90x50 =46; { vga 8x8 font on color }
+ M_VGA_M90x50 =47; { vga 8x8 font on mono }
+ M_VGA_C90x60 =48; { vga 8x8 font on color }
+ M_VGA_M90x60 =49; { vga 8x8 font on mono }
+
+ M_ENH_B80x43 =$70; { ega black & white 80x43 }
+ M_ENH_C80x43 =$71; { ega color 80x43 }
+
+ M_PC98_80x25 =98; { PC98 text 80x25 }
+ M_PC98_80x30 =99; { PC98 text 80x30 }
+ M_PC98_EGC640x400 =100; { PC98 graphic 640x400 16 colors }
+ M_PC98_PEGC640x400 =101; { PC98 graphic 640x400 256 colors }
+ M_PC98_PEGC640x480 =102; { PC98 graphic 640x480 256 colors }
+
+ M_HGC_P0 =$e0; { hercules graphics - page 0 @ B0000 }
+ M_HGC_P1 =$e1; { hercules graphics - page 1 @ B8000 }
+ M_MCA_MODE =$ff; { monochrome adapter mode }
+
+ M_TEXT_80x25 =200; { generic text modes }
+ M_TEXT_80x30 =201;
+ M_TEXT_80x43 =202;
+ M_TEXT_80x50 =203;
+ M_TEXT_80x60 =204;
+ M_TEXT_132x25 =205;
+ M_TEXT_132x30 =206;
+ M_TEXT_132x43 =207;
+ M_TEXT_132x50 =208;
+ M_TEXT_132x60 =209;
+
+ M_VESA_BASE =$100; { VESA mode number base }
+ M_VESA_CG640x400 =$100; { 640x400, 256 color }
+ M_VESA_CG640x480 =$101; { 640x480, 256 color }
+ M_VESA_800x600 =$102; { 800x600, 16 color }
+ M_VESA_CG800x600 =$103; { 800x600, 256 color }
+ M_VESA_1024x768 =$104; { 1024x768, 16 color }
+ M_VESA_CG1024x768 =$105; { 1024x768, 256 color }
+ M_VESA_1280x1024 =$106; { 1280x1024, 16 color }
+ M_VESA_CG1280x1024 =$107; { 1280x1024, 256 color }
+ M_VESA_C80x60 =$108; { 8x8 font }
+ M_VESA_C132x25 =$109; { 8x16 font }
+ M_VESA_C132x43 =$10a; { 8x14 font }
+ M_VESA_C132x50 =$10b; { 8x8 font }
+ M_VESA_C132x60 =$10c; { 8x8 font }
+ M_VESA_32K_320 =$10d; { 320x200, 5:5:5 }
+ M_VESA_64K_320 =$10e; { 320x200, 5:6:5 }
+ M_VESA_FULL_320 =$10f; { 320x200, 8:8:8 }
+ M_VESA_32K_640 =$110; { 640x480, 5:5:5 }
+ M_VESA_64K_640 =$111; { 640x480, 5:6:5 }
+ M_VESA_FULL_640 =$112; { 640x480, 8:8:8 }
+ M_VESA_32K_800 =$113; { 800x600, 5:5:5 }
+ M_VESA_64K_800 =$114; { 800x600, 5:6:5 }
+ M_VESA_FULL_800 =$115; { 800x600, 8:8:8 }
+ M_VESA_32K_1024 =$116; { 1024x768, 5:5:5 }
+ M_VESA_64K_1024 =$117; { 1024x768, 5:6:5 }
+ M_VESA_FULL_1024 =$118; { 1024x768, 8:8:8 }
+ M_VESA_32K_1280 =$119; { 1280x1024, 5:5:5 }
+ M_VESA_64K_1280 =$11a; { 1280x1024, 5:6:5 }
+ M_VESA_FULL_1280 =$11b; { 1280x1024, 8:8:8 }
+ M_VESA_MODE_MAX =$1ff;
+
+type
+ video_display_start = record
+ x :longint;
+ y : longint;
+ end;
+
+ video_display_start_t= video_display_start;
+
+ video_color_palette = record
+ index : longint; { first element (zero-based) }
+ count : longint; { number of elements }
+ red : ^uchar; { red }
+ green : ^uchar; { green }
+ blue : ^uchar; { blue }
+ transparent : ^uchar; { may be NULL }
+ end;
+
+ video_color_palette_t = video_color_palette;
+
+{ adapter info. }
+Function FBIO_ADAPTER(fd:longint;var param1 : longint):boolean;
+Function FBIO_ADPTYPE(fd:longint;var param1 : longint):boolean;
+Function FBIO_ADPINFO(fd:longint;var param1 : video_adapter_info):boolean;
+
+{ video mode control }
+Function FBIO_MODEINFO(fd:longint;var param1 : video_info):boolean;
+Function FBIO_FINDMODE(fd:longint;var param1 : video_info):boolean;
+Function FBIO_GETMODE(fd:longint;var param1 : longint):boolean;
+Function FBIO_SETMODE(fd:longint;var param1 : longint):boolean;
+
+{ get/set frame buffer window origin }
+Function FBIO_GETWINORG(fd:longint;var param1 : u_int):boolean;
+Function FBIO_SETWINORG(fd:longint;var param1 : u_int):boolean;
+
+{ get/set display start address }
+Function FBIO_GETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+Function FBIO_SETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+
+{ get/set scan line width }
+Function FBIO_GETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+Function FBIO_SETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+
+{ color palette control }
+Function FBIO_GETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+Function FBIO_SETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+
+{----------------------------- sys/consio.h ----------------------------------}
+
+{ version packaged with FreeBSD 4.2-RELEASE
+Translation to FreePascal by Marco van de Voort. (2000-2001), original
+copyright follows:
+
+ * Copyright (c) 1991-1996 Søren Schmidt
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer
+ * in this position and unchanged.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. The name of the author may not be used to endorse or promote products
+ * derived from this software without specific prior written permission
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $FreeBSD: src/sys/sys/consio.h,v 1.5.2.1 2000/05/05 09:16:15 nyan Exp $
+
+}
+
+{$define definconsole}
+
+{
+ * Console FpIoctl commands. Some commands are named as KDXXXX, GIO_XXX, and
+ * PIO_XXX, rather than CONS_XXX, for historical and compatibility reasons.
+ * Some other CONS_XXX commands are works as wrapper around frame buffer
+ * FpIoctl commands FBIO_XXX. Do not try to change all these commands,
+ * otherwise we shall have compatibility problems.
+ }
+
+const
+
+{ get/set video mode }
+ KD_TEXT =0; { set text mode restore fonts }
+ KD_TEXT0 =0; { ditto }
+ KD_GRAPHICS =1; { set graphics mode }
+ KD_TEXT1 =2; { set text mode !restore fonts }
+ KD_PIXEL =3; { set pixel mode }
+
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+
+{ set border color }
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+
+{ set up raster(pixel) text mode }
+type
+ scr_size = record
+ _scrsize : array[0..2] of longint;
+ end;
+ scr_size_t = scr_size;
+
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+
+type
+
+{ get/set screen char map }
+
+ scrmap = record
+ _scrmap : array[0..255] of char;
+ end;
+ scrmap_t = scrmap;
+
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+
+{ get the current text attribute }
+Function GIO_ATTR(fd:longint;var param1 : longint):boolean;
+
+{ get the current text color }
+Function GIO_COLOR(fd:longint;var param1 : longint):boolean;
+
+{ get the adapter type (equivalent to FBIO_ADPTYPE) }
+Function CONS_CURRENT(fd:longint;var param1 : longint):boolean;
+
+{ get the current video mode (equivalent to FBIO_GETMODE) }
+Function CONS_GET(fd:longint;var param1 : longint):boolean;
+
+{ not supported? }
+Function CONS_IO(fd:longint):boolean;
+
+{ set blank time interval }
+Function CONS_BLANKTIME(fd:longint;var param1 : longint):boolean;
+
+{ set/get the screen saver (these FpIoctls are current noop) }
+CONST maxsaver=16;
+
+type ssaver =record
+ name : array[0..maxsaver-1] of char;
+ num : Longint;
+ time : Long;
+ end;
+ ssaver_t = ssaver;
+
+Function CONS_SSAVER(fd:longint;var param1 : ssaver_t):boolean;
+Function CONS_GSAVER(fd:longint;var param1 : ssaver_t):boolean;
+
+{ set the text cursor shape }
+
+CONST
+ CONS_BLINK_CURSOR = (1 shl 0);
+ CONS_CHAR_CURSOR = (1 shl 1);
+
+Function CONS_CURSORTYPE(fd:longint;var param1 : longint):boolean;
+
+{ set the bell type to audible or visual }
+CONST
+ CONS_VISUAL_BELL =(1 shl 0);
+ CONS_QUIET_BELL =(1 shl 1);
+
+Function CONS_BELLTYPE(fd:longint;var param1 : longint):boolean;
+
+{ set the history (scroll back) buffer size (in lines) }
+Function CONS_HISTORY(fd:longint;var param1 : longint):boolean;
+
+{ mouse cursor FpIoctl }
+type
+ mouse_data = record
+ x : longint;
+ y : Longint;
+ z : longint;
+ buttons : longint;
+ end;
+
+ mouse_data_t = mouse_data;
+
+ mouse_mode = record
+ mode : longint;
+ signal : longint;
+ end;
+
+ mouse_mode_t = mouse_mode;
+
+ mouse_event = record
+ id : Longint; { one based }
+ value : longint;
+ end;
+
+ mouse_event_t = mouse_event;
+
+CONST
+ MOUSE_SHOW =$01;
+ MOUSE_HIDE =$02;
+ MOUSE_MOVEABS =$03;
+ MOUSE_MOVEREL =$04;
+ MOUSE_GETINFO =$05;
+ _MOUSE_MODE =$06;
+ MOUSE_ACTION =$07;
+ MOUSE_MOTION_EVENT =$08;
+ MOUSE_BUTTON_EVENT =$09;
+ MOUSE_MOUSECHAR =$0a;
+
+TYPE
+ mouse_info = record
+ operation : longint;
+ u : record
+ case integer of
+ 0: (data : mouse_data_t);
+ 1: (mode : mouse_mode_t);
+ 2: (event: mouse_event_t);
+ 3: (mouse_char : longint);
+ end;
+ end;
+ mouse_info_t = mouse_info;
+
+Function CONS_MOUSECTL(fd:longint;var param1 : mouse_info_t):boolean;
+
+{ see if the vty has been idle }
+Function CONS_IDLE(fd:longint;var param1 : longint):boolean;
+
+{ set the screen saver mode }
+CONST
+ CONS_LKM_SAVER = 0;
+ CONS_USR_SAVER = 1;
+
+Function CONS_SAVERMODE(fd:longint;var param1 : longint):boolean;
+
+{ start the screen saver }
+Function CONS_SAVERSTART(fd:longint;var param1 : longint):boolean;
+
+TYPE
+{ set/get font data }
+ fnt8 = record
+ fnt8x8 : array[0..8*256-1] of char;
+ end;
+
+ fnt8_t = fnt8;
+
+ fnt14 = record
+ fnt8x14: array[0..14*256-1] of char;
+ end;
+
+ fnt14_t = fnt14;
+
+ fnt16 = record
+ fnt8x16: array[0..16*256-1] of char;
+ end;
+ fnt16_t = fnt16;
+
+Function PIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+Function GIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+Function PIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+Function GIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+Function PIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+Function GIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+
+
+{ get video mode information }
+type colors = record
+ fore : char;
+ back : char;
+ end;
+
+ vid_info = record
+ _size : short;
+ m_num : short;
+ mv_row,
+ mv_col : ushort;
+ mv_rsz,
+ mv_csz : ushort;
+ mv_norm,
+ mv_rev,
+ mv_grfc : colors;
+ mv_ovscan : uchar;
+ mk_keylock : uchar;
+ end;
+ vid_info_t = vid_info;
+
+Function CONS_GETINFO(fd:longint;var param1 : vid_info_t):boolean;
+
+{ get version }
+
+Function CONS_GETVERS(fd:longint;var param1 : longint):boolean;
+
+{ get the video adapter index (equivalent to FBIO_ADAPTER) }
+Function CONS_CURRENTADP(fd:longint;var param1 : longint):boolean;
+
+{ get the video adapter information (equivalent to FBIO_ADPINFO) }
+Function CONS_ADPINFO(fd:longint;var param1 : video_adapter_info_t):boolean;
+
+{ get the video mode information (equivalent to FBIO_MODEINFO) }
+Function CONS_MODEINFO(fd:longint;var param1 : video_info_t):boolean;
+
+{ find a video mode (equivalent to FBIO_FINDMODE) }
+Function CONS_FINDMODE(fd:longint;var param1 : video_info_t):boolean;
+
+{ set the frame buffer window origin (equivalent to FBIO_SETWINORG) }
+Function CONS_SETWINORG(fd:longint;param1 : longint):boolean;
+
+{ use the specified keyboard }
+Function CONS_SETKBD(fd:longint;param1 : longint):boolean;
+
+{ release the current keyboard }
+Function CONS_RELKBD(fd:longint):boolean;
+
+{ get/set the current terminal emulator info. }
+CONST
+ TI_NAME_LEN = 32;
+ TI_DESC_LEN = 64;
+
+TYPE
+ term_info = record
+ ti_index : Longint;
+ ti_flags : longint;
+ ti_name : array[0..TI_NAME_LEN-1] of uchar;
+ ti_desc : array[0..TI_DESC_LEN-1] of uchar;
+ end;
+ term_info_t = term_info;
+
+Function CONS_GETTERM(fd:longint;var param1 : term_info_t):boolean;
+Function CONS_SETTERM(fd:longint;var param1 : term_info_t):boolean;
+
+{$ifdef PC98}
+Function ADJUST_CLOCK(fd:longint):boolean;
+{$endif}
+
+{
+* Vty switching FpIoctl commands.
+}
+
+{ get the next available vty }
+Function VT_OPENQRY(fd:longint;var param1 : longint):boolean;
+
+{ set/get vty switching mode }
+const
+ VT_AUTO =0; { switching is automatic }
+ VT_PROCESS =1; { switching controlled by prog }
+ VT_KERNEL =255; { switching controlled in kernel }
+
+TYPE
+ vt_mode = record
+ mode : Char;
+ waitv : char; { not implemented yet SOS }
+ relsig : short;
+ acqsig : short;
+ frsig : short; { not implemented yet SOS }
+ end;
+
+ vtmode_t = vt_mode;
+
+
+Function VT_SETMODE(fd:longint;var param1 : vtmode_t):boolean;
+Function VT_GETMODE(fd:longint;var param1 : vtmode_t):boolean;
+
+
+{ acknowledge release or acquisition of a vty }
+const
+ VT_FALSE = 0;
+ VT_TRUE = 1;
+ VT_ACKACQ = 2;
+
+Function VT_RELDISP(fd:longint;param1 : longint):boolean;
+
+{ activate the specified vty }
+Function VT_ACTIVATE(fd:longint;param1 : longint):boolean;
+
+{ wait until the specified vty is activate }
+Function VT_WAITACTIVE(fd:longint;param1 : longint):boolean;
+
+{ get the currently active vty }
+Function VT_GETACTIVE(fd:longint;var param1 : longint):boolean;
+
+{ get the index of the vty }
+Function VT_GETINDEX(fd:longint;var param1 : longint):boolean;
+
+{
+* Video mode switching FpIoctl. See sys/fbio.h for mode numbers.
+}
+
+Function SW_B40x25(fd:longint):boolean;
+Function SW_C40x25(fd:longint):boolean;
+Function SW_B80x25(fd:longint):boolean;
+Function SW_C80x25(fd:longint):boolean;
+Function SW_BG320(fd:longint):boolean;
+Function SW_CG320(fd:longint):boolean;
+Function SW_BG640(fd:longint):boolean;
+Function SW_EGAMONO80x25(fd:longint):boolean;
+Function SW_CG320_D(fd:longint):boolean;
+Function SW_CG640_E(fd:longint):boolean;
+Function SW_EGAMONOAPA(fd:longint):boolean;
+Function SW_CG640x350(fd:longint):boolean;
+Function SW_ENH_MONOAPA2(fd:longint):boolean;
+Function SW_ENH_CG640(fd:longint):boolean;
+Function SW_ENH_B40x25(fd:longint):boolean;
+Function SW_ENH_C40x25(fd:longint):boolean;
+Function SW_ENH_B80x25(fd:longint):boolean;
+Function SW_ENH_C80x25(fd:longint):boolean;
+Function SW_ENH_B80x43(fd:longint):boolean;
+Function SW_ENH_C80x43(fd:longint):boolean;
+Function SW_MCAMODE(fd:longint):boolean;
+Function SW_VGA_C40x25(fd:longint):boolean;
+Function SW_VGA_C80x25(fd:longint):boolean;
+Function SW_VGA_C80x30(fd:longint):boolean;
+Function SW_VGA_C80x50(fd:longint):boolean;
+Function SW_VGA_C80x60(fd:longint):boolean;
+Function SW_VGA_M80x25(fd:longint):boolean;
+Function SW_VGA_M80x30(fd:longint):boolean;
+Function SW_VGA_M80x50(fd:longint):boolean;
+Function SW_VGA_M80x60(fd:longint):boolean;
+Function SW_VGA11(fd:longint):boolean;
+Function SW_BG640x480(fd:longint):boolean;
+Function SW_VGA12(fd:longint):boolean;
+Function SW_CG640x480(fd:longint):boolean;
+Function SW_VGA13(fd:longint):boolean;
+Function SW_VGA_CG320(fd:longint):boolean;
+Function SW_VGA_CG640(fd:longint):boolean;
+Function SW_VGA_MODEX(fd:longint):boolean;
+Function SW_PC98_80x25(fd:longint):boolean;
+Function SW_PC98_80x30(fd:longint):boolean;
+Function SW_PC98_EGC640x400(fd:longint):boolean;
+Function SW_PC98_PEGC640x400(fd:longint):boolean;
+Function SW_PC98_PEGC640x480(fd:longint):boolean;
+Function SW_VGA_C90x25(fd:longint):boolean;
+Function SW_VGA_M90x25(fd:longint):boolean;
+Function SW_VGA_C90x30(fd:longint):boolean;
+Function SW_VGA_M90x30(fd:longint):boolean;
+Function SW_VGA_C90x43(fd:longint):boolean;
+Function SW_VGA_M90x43(fd:longint):boolean;
+Function SW_VGA_C90x50(fd:longint):boolean;
+Function SW_VGA_M90x50(fd:longint):boolean;
+Function SW_VGA_C90x60(fd:longint):boolean;
+Function SW_VGA_M90x60(fd:longint):boolean;
+Function SW_TEXT_80x25(fd:longint):boolean;
+Function SW_TEXT_80x30(fd:longint):boolean;
+Function SW_TEXT_80x43(fd:longint):boolean;
+Function SW_TEXT_80x50(fd:longint):boolean;
+Function SW_TEXT_80x60(fd:longint):boolean;
+Function SW_TEXT_132x25(fd:longint):boolean;
+Function SW_TEXT_132x30(fd:longint):boolean;
+Function SW_TEXT_132x43(fd:longint):boolean;
+Function SW_TEXT_132x50(fd:longint):boolean;
+Function SW_TEXT_132x60(fd:longint):boolean;
+Function SW_VESA_CG640x400(fd:longint):boolean;
+Function SW_VESA_CG640x480(fd:longint):boolean;
+Function SW_VESA_800x600(fd:longint):boolean;
+Function SW_VESA_CG800x600(fd:longint):boolean;
+Function SW_VESA_1024x768(fd:longint):boolean;
+Function SW_VESA_CG1024x768(fd:longint):boolean;
+Function SW_VESA_1280x1024(fd:longint):boolean;
+Function SW_VESA_CG1280x1024(fd:longint):boolean;
+Function SW_VESA_C80x60(fd:longint):boolean;
+Function SW_VESA_C132x25(fd:longint):boolean;
+Function SW_VESA_C132x43(fd:longint):boolean;
+Function SW_VESA_C132x50(fd:longint):boolean;
+Function SW_VESA_C132x60(fd:longint):boolean;
+Function SW_VESA_32K_320(fd:longint):boolean;
+Function SW_VESA_64K_320(fd:longint):boolean;
+Function SW_VESA_FULL_320(fd:longint):boolean;
+Function SW_VESA_32K_640(fd:longint):boolean;
+Function SW_VESA_64K_640(fd:longint):boolean;
+Function SW_VESA_FULL_640(fd:longint):boolean;
+Function SW_VESA_32K_800(fd:longint):boolean;
+Function SW_VESA_64K_800(fd:longint):boolean;
+Function SW_VESA_FULL_800(fd:longint):boolean;
+Function SW_VESA_32K_1024(fd:longint):boolean;
+Function SW_VESA_64K_1024(fd:longint):boolean;
+Function SW_VESA_FULL_1024(fd:longint):boolean;
+Function SW_VESA_32K_1280(fd:longint):boolean;
+Function SW_VESA_64K_1280(fd:longint):boolean;
+Function SW_VESA_FULL_1280(fd:longint):boolean;
+
+{----------------------------- sys/kbio.h ----------------------------------}
+
+{ version packaged with FreeBSD 4.2-RELEASE
+Translation to FreePascal by Marco van de Voort. (2000-2001), original
+copyright follows: ( I assume BSD licensed)
+
+Based on
+ * $FreeBSD: src/sys/sys/kbio.h,v 1.5.2.1 2000/10/29 16:59:32 dwmalone Exp $
+}
+
+{ get/set keyboard I/O mode}
+const K_RAW =0; { keyboard returns scancodes}
+ K_XLATE =1; { keyboard returns ascii}
+ K_CODE =2; { keyboard returns keycodes}
+
+{After each FpIoctl value, I've put the type of the parameters to be passed:
+ @int -> pass a pointer to an int.
+ int -> pass pointer(int)
+ - -> nothing
+@keymap_t -> pass a pointer to a keymap_t
+ etc.
+}
+
+Function KDGKBMODE(fd:longint;var param1 : longint):boolean;
+Function KDSKBMODE(fd:longint;param1 : longint):boolean;
+
+
+{ make tone}
+Function KDMKTONE(fd:longint;param1 : longint):boolean;
+
+{ see console.h for the definitions of the following FpIoctls}
+{$ifndef definconsole}
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+
+{$endif}
+const
+{ get/set keyboard lock state}
+ CLKED =1; { Caps locked}
+ NLKED =2; { Num locked}
+ SLKED =4; { Scroll locked}
+ ALKED =8; { AltGr locked}
+ LOCK_MASK =CLKED or NLKED or SLKED or ALKED;
+
+Function KDGKBSTATE(fd:longint;var param1 : longint):boolean;
+Function KDSKBSTATE(fd:longint;param1 : longint):boolean;
+
+{ enable/disable I/O access}
+Function KDENABIO(fd:longint):boolean;
+Function KDDISABIO(fd:longint):boolean;
+
+{ make sound}
+Function KIOCSOUND(fd:longint;param1 : longint):boolean;
+
+Const
+{ get keyboard model}
+ KB_OTHER =0; { keyboard not known}
+ KB_84 =1; { 'old' 84 key AT-keyboard}
+ KB_101 =2; { MF-101 or MF-102 keyboard}
+Function KDGKBTYPE(fd:longint;var param1 : longint):boolean;
+
+const
+{ get/set keyboard LED state}
+ LED_CAP =1; { Caps lock LED}
+ LED_NUM =2; { Num lock LED}
+ LED_SCR =4; { Scroll lock LED}
+ LED_MASK =LED_CAP or LED_NUM or LED_SCR;
+Function KDGETLED(fd:longint;var param1 : longint):boolean;
+Function KDSETLED(fd:longint;param1 : longint):boolean;
+
+{ set keyboard repeat rate (obsolete, use KDSETREPEAT below)}
+Function KDSETRAD(fd:longint;param1 : longint):boolean;
+
+{ see console.h for the definition of the following FpIoctl}
+{$ifndef definconsole}
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+
+{$endif}
+
+TYPE
+{ get keyboard information}
+ keyboard_info = Record
+ kb_index : longint; { kbdio index#}
+ kb_name : array[0..15] of char; { driver name}
+ kb_unit : longint; { unit#}
+ kb_type : longint; { KB_84, KB_101, KB_OTHER,...}
+ kb_config: longint; { device configuration flags}
+ kb_flags : longint; { internal flags}
+ end;
+ keyboard_info_t=keyboard_info;
+
+Function KDGKBINFO(fd:longint;var param1 : keyboard_info_t):boolean;
+
+Type
+{ set/get keyboard repeat rate (new interface)}
+ keyboard_repeat = record
+ kb_repeat: array[0..1] of longint;
+ end;
+
+keyboard_repeat_t = keyboard_repeat;
+
+Function KDSETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+Function KDGETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+
+{ get/set key map/accent map/function key strings}
+
+const
+ NUM_KEYS =256; { number of keys in table}
+ NUM_STATES =8; { states per key}
+ ALTGR_OFFSET =128; { offset for altlock keys}
+
+ NUM_DEADKEYS =15; { number of accent keys}
+ NUM_ACCENTCHARS =52; { max number of accent chars}
+
+ NUM_FKEYS =96; { max number of function keys}
+ MAXFK =16; { max length of a function key str}
+
+type
+ keyent_t = record
+ map : array[0..NUM_STATES-1] of uchar;
+ spcl : uchar;
+ flgs : uchar;
+ end;
+
+const
+ FLAG_LOCK_O =0;
+ FLAG_LOCK_C =1;
+ FLAG_LOCK_N =2;
+
+type keymap = record
+ n_keys : ushort;
+ key : array[0..NUM_KEYS-1] OF keyent_t;
+ end;
+
+ keymap_t= keymap;
+
+CONST
+{ defines for "special" keys (spcl bit set in keymap)}
+ NOP =$00; { nothing (dead key)}
+ LSH =$02; { left shift key}
+ RSH =$03; { right shift key}
+ CLK =$04; { caps lock key}
+ NLK =$05; { num lock key}
+ SLK =$06; { scroll lock key}
+ LALT =$07; { left alt key}
+ BTAB =$08; { backwards tab}
+ LCTR =$09; { left control key}
+ NEXT =$0a; { switch to next screen}
+ F_SCR =$0b; { switch to first screen}
+ L_SCR =$1a; { switch to last screen}
+ F_FN =$1b; { first function key}
+ L_FN =$7a; { last function key}
+{ $7b-$7f reserved do not use !}
+ RCTR =$80; { right control key}
+ RALT =$81; { right alt (altgr) key}
+ ALK =$82; { alt lock key}
+ ASH =$83; { alt shift key}
+ META =$84; { meta key}
+ RBT =$85; { boot machine}
+ DBG =$86; { call debugger}
+ SUSP =$87; { suspend power (APM)}
+ SPSC =$88; { toggle splash/text screen}
+
+ DGRA =$89; { grave}
+ F_ACC =DGRA; { first accent key}
+
+ DACU =$8a; { acute}
+ DCIR =$8b; { circumflex}
+ DTIL =$8c; { tilde}
+ DMAC =$8d; { macron}
+ DBRE =$8e; { breve}
+ DDOT =$8f; { dot}
+ DUML =$90; { umlaut/diaresis}
+ DDIA =$90; { diaresis}
+ DSLA =$91; { slash}
+ DRIN =$92; { ring}
+ DCED =$93; { cedilla}
+ DAPO =$94; { apostrophe}
+ DDAC =$95; { double acute}
+ DOGO =$96; { ogonek}
+ DCAR =$97; { caron}
+ L_ACC =DCAR; { last accent key}
+
+ STBY =$98; { Go into standby mode (apm)}
+ PREV =$99; { switch to previous screen}
+ PNC =$9a; { force system panic}
+ LSHA =$9b; { left shift key / alt lock}
+ RSHA =$9c; { right shift key / alt lock}
+ LCTRA =$9d; { left ctrl key / alt lock}
+ RCTRA =$9e; { right ctrl key / alt lock}
+ LALTA =$9f; { left alt key / alt lock}
+ RALTA =$a0; { right alt key / alt lock}
+ HALT =$a1; { halt machine}
+ PDWN =$a2; { halt machine and power down}
+
+function kbio_F(x:longint):longint;
+function kbio_S(x:longint):longint;
+function kbio_ACC(x:longint):longint;
+
+type acc_t = record
+ accchar : uchar;
+ map : array[0..NUM_ACCENTCHARS-1,0..1] of uchar;
+ end;
+
+ accentmap = record
+ n_accs : ushort;
+ acc : array[0..NUM_DEADKEYS-1] of acc_t
+ end;
+
+ accentmap_t = accentmap ;
+
+ keyarg = record
+ keynum : ushort;
+ key : keyent_t;
+ end;
+
+ keyarg_t = keyarg;
+
+ fkeytab = record
+ str : array [0..MAXFK-1] of uchar;
+ len : uchar;
+ end;
+ fkeytab_t = fkeytab;
+
+ fkeyarg =record
+ keynum : ushort;
+ keydef : array[0..MAXFK-1] of char;
+ flen :char;
+ end;
+
+ fkeyarg_t = fkeyarg;
+
+Function GETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+Function SETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+
+{$ifndef definconsole}
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{$endif}
+Function GIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+Function PIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+Function GIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+Function PIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+Function GIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+Function PIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+
+{ flags set to the return value in the KD_XLATE mode}
+Const
+ NOKEY =$100; { no key pressed marker}
+ FKEY =$200; { function key marker}
+ MKEY =$400; { meta key marker (prepend ESC)}
+ BKEY =$800; { backtab (ESC [ Z)}
+
+ SPCLKEY =$8000; { special key}
+ RELKEY =$4000; { key released}
+ ERRKEY =$2000; { error}
+
+
+function KEYCHAR(c:longint):longint;
+
+function KEYFLAGS(c:longint):longint;
+
+{----------------------------- machine/mouse.h -------------------------------}
+
+{ Based on machine/mouse.h from FreeBSD release 4.2
+
+ * Copyright (c) 1992, 1993 Erik Forsberg.
+ * Copyright (c) 1996, 1997 Kazutaka YOKOTA
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * THIS SOFTWARE IS PROVIDED BY ``AS IS'' AND ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
+ * NO EVENT SHALL I BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $FreeBSD: src/sys/i386/include/mouse.h,v 1.15.2.1 2000/03/21 14:44:10 yokota Exp $
+ }
+
+
+{ FpIoctls }
+
+
+{ mouse status block }
+
+type
+ mousestatus = record
+ flags : longint; { state change flags }
+ button : longint; { button status }
+ obutton : longint; { previous button status }
+ dx : longint; { x movement }
+ dy : longint; { y movement }
+ dz : longint; { z movement }
+ end;
+
+ mousestatus_t = mousestatus;
+
+CONST
+
+{ button }
+ MOUSE_BUTTON1DOWN =$0001; { left }
+ MOUSE_BUTTON2DOWN =$0002; { middle }
+ MOUSE_BUTTON3DOWN =$0004; { right }
+ MOUSE_BUTTON4DOWN =$0008;
+ MOUSE_BUTTON5DOWN =$0010;
+ MOUSE_BUTTON6DOWN =$0020;
+ MOUSE_BUTTON7DOWN =$0040;
+ MOUSE_BUTTON8DOWN =$0080;
+ MOUSE_MAXBUTTON =31;
+ MOUSE_STDBUTTONS =$0007; { buttons 1-3 }
+ MOUSE_EXTBUTTONS =$7ffffff8; { the others (28 of them!) }
+ MOUSE_BUTTONS =(MOUSE_STDBUTTONS or MOUSE_EXTBUTTONS);
+
+{ flags }
+ MOUSE_STDBUTTONSCHANGED =MOUSE_STDBUTTONS;
+ MOUSE_EXTBUTTONSCHANGED =MOUSE_EXTBUTTONS;
+ MOUSE_BUTTONSCHANGED =MOUSE_BUTTONS;
+ MOUSE_POSCHANGED =$80000000;
+
+type
+ mousehw =record
+ buttons : longint; { -1 if unknown }
+ iftype : longint; { MOUSE_IF_XXX }
+ _type : longint; { mouse/track ball/pad... }
+ model : longint; { I/F dependent model ID: MOUSE_MODEL_XXX }
+ hwid : longint; { I/F dependent hardware ID}
+ { for the PS/2 mouse, it will be PSM_XXX_ID }
+ end;
+
+ mousehw_t = mousehw;
+
+const
+
+{ iftype }
+ MOUSE_IF_UNKNOWN =(-1);
+ MOUSE_IF_SERIAL =0;
+ MOUSE_IF_BUS =1;
+ MOUSE_IF_INPORT =2;
+ MOUSE_IF_PS2 =3;
+ MOUSE_IF_SYSMOUSE =4;
+ MOUSE_IF_USB =5;
+
+{ type }
+ MOUSE_UNKNOWN =(-1); { should be treated as a mouse }
+ MOUSE_MOUSE =0;
+ MOUSE_TRACKBALL =1;
+ MOUSE_STICK =2;
+ MOUSE_PAD =3;
+
+{ model }
+ MOUSE_MODEL_UNKNOWN =(-1);
+ MOUSE_MODEL_GENERIC =0;
+ MOUSE_MODEL_GLIDEPOINT =1;
+ MOUSE_MODEL_NETSCROLL =2;
+ MOUSE_MODEL_NET =3;
+ MOUSE_MODEL_INTELLI =4;
+ MOUSE_MODEL_THINK =5;
+ MOUSE_MODEL_EASYSCROLL =6;
+ MOUSE_MODEL_MOUSEMANPLUS =7;
+ MOUSE_MODEL_KIDSPAD =8;
+ MOUSE_MODEL_VERSAPAD =9;
+ MOUSE_MODEL_EXPLORER =10;
+ MOUSE_MODEL_4D =11;
+ MOUSE_MODEL_4DPLUS =12;
+
+type mousemode = record
+ protocol : longint; { MOUSE_PROTO_XXX }
+ rate : longint; { report rate (per sec), -1 if unknown }
+ resolution : longint; { MOUSE_RES_XXX, -1 if unknown }
+ accelfactor : longint; { accelation factor (must be 1 or greater) }
+ level : longint; { driver operation level }
+ packetsize : longint; { the length of the data packet }
+ syncmask : array[0..1] of uchar; { sync. data bits in the header byte }
+ end;
+
+type mousemode_t = mousemode;
+
+{ protocol }
+{
+ * Serial protocols:
+ * Microsoft, MouseSystems, Logitech, MM series, MouseMan, Hitachi Tablet,
+ * GlidePoint, IntelliMouse, Thinking Mouse, MouseRemote, Kidspad,
+ * VersaPad
+ * Bus mouse protocols:
+ * bus, InPort
+ * PS/2 mouse protocol:
+ * PS/2
+ }
+ const
+
+ MOUSE_PROTO_UNKNOWN =(-1);
+ MOUSE_PROTO_MS =0; { Microsoft Serial, 3 bytes }
+ MOUSE_PROTO_MSC =1; { Mouse Systems, 5 bytes }
+ MOUSE_PROTO_LOGI =2; { Logitech, 3 bytes }
+ MOUSE_PROTO_MM =3; { MM series, 3 bytes }
+ MOUSE_PROTO_LOGIMOUSEMAN =4; { Logitech MouseMan 3/4 bytes }
+ MOUSE_PROTO_BUS =5; { MS/Logitech bus mouse }
+ MOUSE_PROTO_INPORT =6; { MS/ATI InPort mouse }
+ MOUSE_PROTO_PS2 =7; { PS/2 mouse, 3 bytes }
+ MOUSE_PROTO_HITTAB =8; { Hitachi Tablet 3 bytes }
+ MOUSE_PROTO_GLIDEPOINT =9; { ALPS GlidePoint, 3/4 bytes }
+ MOUSE_PROTO_INTELLI =10; { MS IntelliMouse, 4 bytes }
+ MOUSE_PROTO_THINK =11; { Kensignton Thinking Mouse, 3/4 bytes }
+ MOUSE_PROTO_SYSMOUSE =12; { /dev/sysmouse }
+ MOUSE_PROTO_X10MOUSEREM =13; { X10 MouseRemote, 3 bytes }
+ MOUSE_PROTO_KIDSPAD =14; { Genius Kidspad }
+ MOUSE_PROTO_VERSAPAD =15; { Interlink VersaPad, 6 bytes }
+
+ MOUSE_RES_UNKNOWN =(-1);
+ MOUSE_RES_DEFAULT =0;
+ MOUSE_RES_LOW =(-2);
+ MOUSE_RES_MEDIUMLOW =(-3);
+ MOUSE_RES_MEDIUMHIGH =(-4);
+ MOUSE_RES_HIGH =(-5);
+
+type mousedata = record
+ len : longint; { # of data in the buffer }
+ buf : array [0..15] of longint; { data buffer }
+ end;
+
+ mousedata_t=mousedata;
+
+ mousevar = record
+ _var : array[0..15] of longint;
+ end;
+
+type mousevar_t = mousevar;
+
+Function MOUSE_GETSTATUS(fd:longint;var param1 : mousestatus_t):boolean;
+Function MOUSE_GETHWINFO(fd:longint;var param1 : mousehw_t):boolean;
+Function MOUSE_GETMODE(fd:longint;var param1 : mousemode_t):boolean;
+Function MOUSE_SETMODE(fd:longint;var param1 : mousemode_t):boolean;
+Function MOUSE_GETLEVEL(fd:longint;var param1 : longint):boolean;
+Function MOUSE_SETLEVEL(fd:longint;var param1 : longint):boolean;
+Function MOUSE_GETVARS(fd:longint;var param1 : mousevar_t):boolean;
+Function MOUSE_SETVARS(fd:longint;var param1 : mousevar_t):boolean;
+Function MOUSE_READSTATE(fd:longint;var param1 : mousedata_t):boolean;
+Function MOUSE_READDATA(fd:longint;var param1 : mousedata_t):boolean;
+
+Function MOUSE_SETRESOLUTION(fd:longint;var param1 : longint):boolean;
+Function MOUSE_SETSCALING(fd:longint;var param1 : longint):boolean;
+Function MOUSE_SETRATE(fd:longint;var param1 : longint):boolean;
+Function MOUSE_GETHWID(fd:longint;var param1 : longint):boolean;
+
+
+
+const
+
+{ magic numbers in var[0] }
+ MOUSE_VARS_PS2_SIG = $00325350; { 'PS2' }
+ MOUSE_VARS_BUS_SIG = $00535542; { 'BUS' }
+ MOUSE_VARS_INPORT_SIG = $00504e49; { 'INP' }
+
+{ Microsoft Serial mouse data packet }
+ MOUSE_MSS_PACKETSIZE = 3;
+ MOUSE_MSS_SYNCMASK = $40;
+ MOUSE_MSS_SYNC = $40;
+ MOUSE_MSS_BUTTONS = $30;
+ MOUSE_MSS_BUTTON1DOWN = $20; { left }
+ MOUSE_MSS_BUTTON2DOWN = $00; { no middle button }
+ MOUSE_MSS_BUTTON3DOWN = $10; { right }
+
+{ Logitech MouseMan data packet (M+ protocol) }
+ MOUSE_LMAN_BUTTON2DOWN = $20; { middle button, the 4th byte }
+
+{ ALPS GlidePoint extention (variant of M+ protocol) }
+ MOUSE_ALPS_BUTTON2DOWN = $20; { middle button, the 4th byte }
+ MOUSE_ALPS_TAP = $10; { `tapping' action, the 4th byte }
+
+{ Kinsington Thinking Mouse extention (variant of M+ protocol) }
+ MOUSE_THINK_BUTTON2DOWN = $20; { lower-left button, the 4th byte }
+ MOUSE_THINK_BUTTON4DOWN = $10; { lower-right button, the 4th byte }
+
+{ MS IntelliMouse (variant of MS Serial) }
+ MOUSE_INTELLI_PACKETSIZE = 4;
+ MOUSE_INTELLI_BUTTON2DOWN = $10; { middle button in the 4th byte }
+
+{ Mouse Systems Corp. mouse data packet }
+ MOUSE_MSC_PACKETSIZE = 5;
+ MOUSE_MSC_SYNCMASK = $f8;
+ MOUSE_MSC_SYNC = $80;
+ MOUSE_MSC_BUTTONS = $07;
+ MOUSE_MSC_BUTTON1UP = $04; { left }
+ MOUSE_MSC_BUTTON2UP = $02; { middle }
+ MOUSE_MSC_BUTTON3UP = $01; { right }
+ MOUSE_MSC_MAXBUTTON = 3;
+
+{ MM series mouse data packet }
+ MOUSE_MM_PACKETSIZE = 3;
+ MOUSE_MM_SYNCMASK = $e0;
+ MOUSE_MM_SYNC = $80;
+ MOUSE_MM_BUTTONS = $07;
+ MOUSE_MM_BUTTON1DOWN = $04; { left }
+ MOUSE_MM_BUTTON2DOWN = $02; { middle }
+ MOUSE_MM_BUTTON3DOWN = $01; { right }
+ MOUSE_MM_XPOSITIVE = $10;
+ MOUSE_MM_YPOSITIVE = $08;
+
+{ PS/2 mouse data packet }
+ MOUSE_PS2_PACKETSIZE = 3;
+ MOUSE_PS2_SYNCMASK = $c8;
+ MOUSE_PS2_SYNC = $08;
+ MOUSE_PS2_BUTTONS = $07; { = $03 for 2 button mouse }
+ MOUSE_PS2_BUTTON1DOWN = $01; { left }
+ MOUSE_PS2_BUTTON2DOWN = $04; { middle }
+ MOUSE_PS2_BUTTON3DOWN = $02; { right }
+ MOUSE_PS2_TAP = MOUSE_PS2_SYNC; { GlidePoint (PS/2) `tapping'
+ * Yes! this is the same bit
+ * as SYNC!
+ }
+
+ MOUSE_PS2_XNEG = $10;
+ MOUSE_PS2_YNEG = $20;
+ MOUSE_PS2_XOVERFLOW = $40;
+ MOUSE_PS2_YOVERFLOW = $80;
+
+{ Logitech MouseMan+ (PS/2) data packet (PS/2++ protocol) }
+ MOUSE_PS2PLUS_SYNCMASK = $48;
+ MOUSE_PS2PLUS_SYNC = $48;
+ MOUSE_PS2PLUS_ZNEG = $08; { sign bit }
+ MOUSE_PS2PLUS_BUTTON4DOWN = $10; { 4th button on MouseMan+ }
+ MOUSE_PS2PLUS_BUTTON5DOWN = $20;
+
+{ IBM ScrollPoint (PS/2) also uses PS/2++ protocol }
+ MOUSE_SPOINT_ZNEG = $80; { sign bits }
+ MOUSE_SPOINT_WNEG = $08;
+
+{ MS IntelliMouse (PS/2) data packet }
+ MOUSE_PS2INTELLI_PACKETSIZE = 4;
+{ some compatible mice have additional buttons }
+ MOUSE_PS2INTELLI_BUTTON4DOWN = $40;
+ MOUSE_PS2INTELLI_BUTTON5DOWN = $80;
+
+{ MS IntelliMouse Explorer (PS/2) data packet (variation of IntelliMouse) }
+ MOUSE_EXPLORER_ZNEG = $08; { sign bit }
+{ IntelliMouse Explorer has additional button data in the fourth byte }
+ MOUSE_EXPLORER_BUTTON4DOWN = $10;
+ MOUSE_EXPLORER_BUTTON5DOWN = $20;
+
+{ Interlink VersaPad (serial I/F) data packet }
+ MOUSE_VERSA_PACKETSIZE = 6;
+ MOUSE_VERSA_IN_USE = $04;
+ MOUSE_VERSA_SYNCMASK = $c3;
+ MOUSE_VERSA_SYNC = $c0;
+ MOUSE_VERSA_BUTTONS = $30;
+ MOUSE_VERSA_BUTTON1DOWN = $20; { left }
+ MOUSE_VERSA_BUTTON2DOWN = $00; { middle }
+ MOUSE_VERSA_BUTTON3DOWN = $10; { right }
+ MOUSE_VERSA_TAP = $08;
+
+{ Interlink VersaPad (PS/2 I/F) data packet }
+ MOUSE_PS2VERSA_PACKETSIZE = 6;
+ MOUSE_PS2VERSA_IN_USE = $10;
+ MOUSE_PS2VERSA_SYNCMASK = $e8;
+ MOUSE_PS2VERSA_SYNC = $c8;
+ MOUSE_PS2VERSA_BUTTONS = $05;
+ MOUSE_PS2VERSA_BUTTON1DOWN = $04; { left }
+ MOUSE_PS2VERSA_BUTTON2DOWN = $00; { middle }
+ MOUSE_PS2VERSA_BUTTON3DOWN = $01; { right }
+ MOUSE_PS2VERSA_TAP = $02;
+
+{ A4 Tech 4D Mouse (PS/2) data packet }
+ MOUSE_4D_PACKETSIZE = 3;
+ MOUSE_4D_WHEELBITS = $f0;
+
+{ A4 Tech 4D+ Mouse (PS/2) data packet }
+ MOUSE_4DPLUS_PACKETSIZE = 3;
+ MOUSE_4DPLUS_ZNEG = $04; { sign bit }
+ MOUSE_4DPLUS_BUTTON4DOWN = $08;
+
+{ sysmouse extended data packet }
+{
+ * /dev/sysmouse sends data in two formats, depending on the protocol
+ * level. At the level 0, format is exactly the same as MousSystems'
+ * five byte packet. At the level 1, the first five bytes are the same
+ * as at the level 0. There are additional three bytes which shows
+ * `dz' and the states of additional buttons. `dz' is expressed as the
+ * sum of the byte 5 and 6 which contain signed seven bit values.
+ * The states of the button 4 though 10 are in the bit 0 though 6 in
+ * the byte 7 respectively: 1 indicates the button is up.
+ }
+ MOUSE_SYS_PACKETSIZE = 8;
+ MOUSE_SYS_SYNCMASK = $f8;
+ MOUSE_SYS_SYNC = $80;
+ MOUSE_SYS_BUTTON1UP = $04; { left, 1st byte }
+ MOUSE_SYS_BUTTON2UP = $02; { middle, 1st byte }
+ MOUSE_SYS_BUTTON3UP = $01; { right, 1st byte }
+ MOUSE_SYS_BUTTON4UP = $0001; { 7th byte }
+ MOUSE_SYS_BUTTON5UP = $0002;
+ MOUSE_SYS_BUTTON6UP = $0004;
+ MOUSE_SYS_BUTTON7UP = $0008;
+ MOUSE_SYS_BUTTON8UP = $0010;
+ MOUSE_SYS_BUTTON9UP = $0020;
+ MOUSE_SYS_BUTTON10UP = $0040;
+ MOUSE_SYS_MAXBUTTON = 10;
+ MOUSE_SYS_STDBUTTONS = $07;
+ MOUSE_SYS_EXTBUTTONS = $7f; { the others }
+
+{ Mouse remote socket }
+ _PATH_MOUSEREMOTE ='/var/run/MouseRemote';
+
+
+{fbio FpIoctl numbers}
+ nr_FBIOGTYPE =$40184600;
+ nr_FBIOGINFO =$40184602;
+ nr_FBIOPUTCMAP =$80144603;
+ nr_FBIOGETCMAP =$80144604;
+ nr_FBIOGATTR =$40584606;
+ nr_FBIOSVIDEO =$80044607;
+ nr_FBIOGVIDEO =$40044608;
+ nr_FBIOSCURSOR =$802c4618;
+ nr_FBIOGCURSOR =$c02c4619;
+ nr_FBIOSCURPOS =$8004461a;
+ nr_FBIOGCURPOS =$8004461b;
+ nr_FBIOGCURMAX =$4004461c;
+ nr_FBIO_ADAPTER =$40044664;
+ nr_FBIO_ADPTYPE =$40044665;
+ nr_FBIO_ADPINFO =$40a44666;
+ nr_FBIO_MODEINFO =$c09c4667;
+ nr_FBIO_FINDMODE =$c09c4668;
+ nr_FBIO_GETMODE =$40044669;
+ nr_FBIO_SETMODE =$8004466a;
+ nr_FBIO_GETWINORG =$4004466b;
+ nr_FBIO_SETWINORG =$8004466c;
+ nr_FBIO_GETDISPSTART =$4008466d;
+ nr_FBIO_SETDISPSTART =$8008466e;
+ nr_FBIO_GETLINEWIDTH =$4004466f;
+ nr_FBIO_SETLINEWIDTH =$80044670;
+ nr_FBIO_GETPALETTE =$80184671;
+ nr_FBIO_SETPALETTE =$80184672;
+
+{consio FpIoctl numbers}
+
+ nr_KDGETMODE =$40044b09;
+ nr_KDSETMODE =$20004b0a;
+ nr_KDSBORDER =$20004b0d;
+ nr_KDRASTER =$800c4b64;
+ nr_GIO_SCRNMAP =$41006b02;
+ nr_PIO_SCRNMAP =$81006b03;
+ nr_GIO_ATTR =$40046100;
+ nr_GIO_COLOR =$40046300;
+ nr_CONS_CURRENT =$40046301;
+ nr_CONS_GET =$40046302;
+ nr_CONS_IO =$20006303;
+ nr_CONS_BLANKTIME =$80046304;
+ nr_CONS_SSAVER =$80186305;
+ nr_CONS_GSAVER =$c0186306;
+ nr_CONS_CURSORTYPE =$80046307;
+ nr_CONS_BELLTYPE =$80046308;
+ nr_CONS_HISTORY =$80046309;
+ nr_CONS_MOUSECTL =$c014630a;
+ nr_CONS_IDLE =$4004630b;
+ nr_CONS_SAVERMODE =$8004630c;
+ nr_CONS_SAVERSTART =$8004630d;
+ nr_PIO_FONT8x8 =$88006340;
+ nr_GIO_FONT8x8 =$48006341;
+ nr_PIO_FONT8x14 =$8e006342;
+ nr_GIO_FONT8x14 =$4e006343;
+ nr_PIO_FONT8x16 =$90006344;
+ nr_GIO_FONT8x16 =$50006345;
+ nr_CONS_GETINFO =$c0146349;
+ nr_CONS_GETVERS =$4004634a;
+ nr_CONS_CURRENTADP =$40046364;
+ nr_CONS_ADPINFO =$c0a46365;
+ nr_CONS_MODEINFO =$c09c6366;
+ nr_CONS_FINDMODE =$c09c6367;
+ nr_CONS_SETWINORG =$20006368;
+ nr_CONS_SETKBD =$2000636e;
+ nr_CONS_RELKBD =$2000636f;
+ nr_CONS_GETTERM =$c0686370;
+ nr_CONS_SETTERM =$80686371;
+ nr_ADJUST_CLOCK =$20007464;
+ nr_VT_OPENQRY =$40047601;
+ nr_VT_SETMODE =$80087602;
+ nr_VT_GETMODE =$40087603;
+ nr_VT_RELDISP =$20007604;
+ nr_VT_ACTIVATE =$20007605;
+ nr_VT_WAITACTIVE =$20007606;
+ nr_VT_GETACTIVE =$40047607;
+ nr_VT_GETINDEX =$40047608;
+ nr_SW_B40x25 =$20005300;
+ nr_SW_C40x25 =$20005301;
+ nr_SW_B80x25 =$20005302;
+ nr_SW_C80x25 =$20005303;
+ nr_SW_BG320 =$20005304;
+ nr_SW_CG320 =$20005305;
+ nr_SW_BG640 =$20005306;
+ nr_SW_EGAMONO80x25 =$20005307;
+ nr_SW_CG320_D =$2000530d;
+ nr_SW_CG640_E =$2000530e;
+ nr_SW_EGAMONOAPA =$2000530f;
+ nr_SW_CG640x350 =$20005310;
+ nr_SW_ENH_MONOAPA2 =$20005311;
+ nr_SW_ENH_CG640 =$20005312;
+ nr_SW_ENH_B40x25 =$20005313;
+ nr_SW_ENH_C40x25 =$20005314;
+ nr_SW_ENH_B80x25 =$20005315;
+ nr_SW_ENH_C80x25 =$20005316;
+ nr_SW_ENH_B80x43 =$20005370;
+ nr_SW_ENH_C80x43 =$20005371;
+ nr_SW_MCAMODE =$200053ff;
+ nr_SW_VGA_C40x25 =$20005317;
+ nr_SW_VGA_C80x25 =$20005318;
+ nr_SW_VGA_C80x30 =$20005320;
+ nr_SW_VGA_C80x50 =$2000531e;
+ nr_SW_VGA_C80x60 =$20005322;
+ nr_SW_VGA_M80x25 =$20005319;
+ nr_SW_VGA_M80x30 =$20005321;
+ nr_SW_VGA_M80x50 =$2000531f;
+ nr_SW_VGA_M80x60 =$20005323;
+ nr_SW_VGA11 =$2000531a;
+ nr_SW_BG640x480 =$2000531a;
+ nr_SW_VGA12 =$2000531b;
+ nr_SW_CG640x480 =$2000531b;
+ nr_SW_VGA13 =$2000531c;
+ nr_SW_VGA_CG320 =$2000531c;
+ nr_SW_VGA_CG640 =$20005324;
+ nr_SW_VGA_MODEX =$20005325;
+ nr_SW_PC98_80x25 =$20005362;
+ nr_SW_PC98_80x30 =$20005363;
+ nr_SW_PC98_EGC640x400 =$20005364;
+ nr_SW_PC98_PEGC640x400 =$20005365;
+ nr_SW_PC98_PEGC640x480 =$20005366;
+ nr_SW_VGA_C90x25 =$20005328;
+ nr_SW_VGA_M90x25 =$20005329;
+ nr_SW_VGA_C90x30 =$2000532a;
+ nr_SW_VGA_M90x30 =$2000532b;
+ nr_SW_VGA_C90x43 =$2000532c;
+ nr_SW_VGA_M90x43 =$2000532d;
+ nr_SW_VGA_C90x50 =$2000532e;
+ nr_SW_VGA_M90x50 =$2000532f;
+ nr_SW_VGA_C90x60 =$20005330;
+ nr_SW_VGA_M90x60 =$20005331;
+ nr_SW_TEXT_80x25 =$200053c8;
+ nr_SW_TEXT_80x30 =$200053c9;
+ nr_SW_TEXT_80x43 =$200053ca;
+ nr_SW_TEXT_80x50 =$200053cb;
+ nr_SW_TEXT_80x60 =$200053cc;
+ nr_SW_TEXT_132x25 =$200053cd;
+ nr_SW_TEXT_132x30 =$200053ce;
+ nr_SW_TEXT_132x43 =$200053cf;
+ nr_SW_TEXT_132x50 =$200053d0;
+ nr_SW_TEXT_132x60 =$200053d1;
+ nr_SW_VESA_CG640x400 =$20005600;
+ nr_SW_VESA_CG640x480 =$20005601;
+ nr_SW_VESA_800x600 =$20005602;
+ nr_SW_VESA_CG800x600 =$20005603;
+ nr_SW_VESA_1024x768 =$20005604;
+ nr_SW_VESA_CG1024x768 =$20005605;
+ nr_SW_VESA_1280x1024 =$20005606;
+ nr_SW_VESA_CG1280x1024 =$20005607;
+ nr_SW_VESA_C80x60 =$20005608;
+ nr_SW_VESA_C132x25 =$20005609;
+ nr_SW_VESA_C132x43 =$2000560a;
+ nr_SW_VESA_C132x50 =$2000560b;
+ nr_SW_VESA_C132x60 =$2000560c;
+ nr_SW_VESA_32K_320 =$2000560d;
+ nr_SW_VESA_64K_320 =$2000560e;
+ nr_SW_VESA_FULL_320 =$2000560f;
+ nr_SW_VESA_32K_640 =$20005610;
+ nr_SW_VESA_64K_640 =$20005611;
+ nr_SW_VESA_FULL_640 =$20005612;
+ nr_SW_VESA_32K_800 =$20005613;
+ nr_SW_VESA_64K_800 =$20005614;
+ nr_SW_VESA_FULL_800 =$20005615;
+ nr_SW_VESA_32K_1024 =$20005616;
+ nr_SW_VESA_64K_1024 =$20005617;
+ nr_SW_VESA_FULL_1024 =$20005618;
+ nr_SW_VESA_32K_1280 =$20005619;
+ nr_SW_VESA_64K_1280 =$2000561a;
+ nr_SW_VESA_FULL_1280 =$2000561b;
+
+{kbdsio FpIoctl numbers}
+
+ nr_KDGKBMODE =$40044b06;
+ nr_KDSKBMODE =$20004b07;
+ nr_KDMKTONE =$20004b08;
+{$ifndef definconsole}
+ nr_KDGETMODE =$40044b09;
+ nr_KDSETMODE =$20004b0a;
+ nr_KDSBORDER =$20004b0d;
+{$endif}
+ nr_KDGKBSTATE =$40044b13;
+ nr_KDSKBSTATE =$20004b14;
+ nr_KDENABIO =$20004b3c;
+ nr_KDDISABIO =$20004b3d;
+ nr_KIOCSOUND =$20004b3f;
+ nr_KDGKBTYPE =$40044b40;
+ nr_KDGETLED =$40044b41;
+ nr_KDSETLED =$20004b42;
+ nr_KDSETRAD =$20004b43;
+{$ifndef definconsole}
+ nr_KDRASTER =$800c4b64;
+{$endif}
+ nr_KDGKBINFO =$40244b65;
+ nr_KDSETREPEAT =$80084b66;
+ nr_KDGETREPEAT =$40084b67;
+ nr_GETFKEY =$c0146b00;
+ nr_SETFKEY =$c0146b01;
+{$ifndef definconsole}
+ nr_GIO_SCRNMAP =$41006b02;
+ nr_PIO_SCRNMAP =$81006b03;
+{$endif}
+ nr_GIO_KEYMAP =$4a026b06;
+ nr_PIO_KEYMAP =$8a026b07;
+ nr_GIO_DEADKEYMAP =$462a6b08;
+ nr_PIO_DEADKEYMAP =$862a6b09;
+ nr_GIO_KEYMAPENT =$c00c6b0a;
+ nr_PIO_KEYMAPENT =$800c6b0b;
+
+
+
+{mouse FpIoctl numbers}
+ nr_MOUSE_GETSTATUS =$40184d00;
+ nr_MOUSE_GETHWINFO =$40144d01;
+ nr_MOUSE_GETMODE =$401c4d02;
+ nr_MOUSE_SETMODE =$801c4d03;
+ nr_MOUSE_GETLEVEL =$40044d04;
+ nr_MOUSE_SETLEVEL =$80044d05;
+ nr_MOUSE_GETVARS =$40404d06;
+ nr_MOUSE_SETVARS =$80404d07;
+ nr_MOUSE_READSTATE =$c0444d08;
+ nr_MOUSE_READDATA =$c0444d09;
+ nr_MOUSE_SETRESOLUTION =$80044d0a;
+ nr_MOUSE_SETSCALING =$80044d0b;
+ nr_MOUSE_SETRATE =$80044d0c;
+ nr_MOUSE_GETHWID =$40044d0d;
+
+{------------- Added procedures ---------------}
+
+function physicalconsole(fd:longint) : boolean;
+
+IMPLEMENTATION
+
+Uses BaseUnix,termio;
+
+function physicalconsole(fd:longint) : boolean;
+
+var name:string;
+
+begin
+ if (isatty(fd)<>-1) then
+ begin
+ name:=ttyname(fd);
+ if Copy(name,1,8)<>'/dev/tty' then
+ physicalconsole:=false {isatty is true, but not /dev/tty.
+ Could be /dev/pts support, but
+ I reserve the case}
+ else
+ begin
+ if name[9]='v' then {ttyv is phys console. see /etc/ttys}
+ physicalconsole:=true
+ else
+ physicalconsole:=false;
+ end;
+ end
+ else
+ physicalconsole:=false; {Not a tty, then I don't know what it is}
+end;
+
+{other macros (not FpIoctl)}
+
+function KEYCHAR(c:longint):longint;
+
+begin
+ c:=c and $FF;
+end;
+
+function KEYFLAGS(c:longint):longint;
+
+begin
+ c:=c and NOT $FF;
+end;
+
+function kbio_F(x:longint):longint;
+begin
+ kbio_f:=x+F_FN-1;
+end;
+
+function kbio_S(x:longint):longint;
+begin
+ kbio_S:=x+F_SCR-1;
+end;
+
+function kbio_ACC(x:longint):longint;
+begin
+ kbio_ACC:=x+F_ACC;
+end;
+
+{fbio.h FpIoctl's}
+
+Function FBIOGTYPE(fd:longint;var param1 : fbtype):boolean;
+{IOR('F',0,sizeof(struct fbtype) }
+
+Begin
+ FBIOGTYPE:=FpIoctl(fd,nr_FBIOGTYPE,@param1)=0;
+end;
+
+Function FBIOGINFO(fd:longint;var param1 : fbinfo):boolean;
+{IOR('F',2,sizeof(struct fbinfo) }
+
+Begin
+ FBIOGINFO:=FpIoctl(fd,nr_FBIOGINFO,@param1)=0;
+end;
+
+Function FBIOPUTCMAP(fd:longint;var param1 : fbcmap):boolean;
+{IOW('F',3,sizeof(struct fbcmap) }
+
+Begin
+ FBIOPUTCMAP:=FpIoctl(fd,nr_FBIOPUTCMAP,@param1)=0;
+end;
+
+Function FBIOGETCMAP(fd:longint;var param1 : fbcmap):boolean;
+{IOW('F',4,sizeof(struct fbcmap) }
+
+Begin
+ FBIOGETCMAP:=FpIoctl(fd,nr_FBIOGETCMAP,@param1)=0;
+end;
+
+Function FBIOGATTR(fd:longint;var param1 : fbgattr):boolean;
+{IOR('F',6,sizeof(struct fbgattr) }
+
+Begin
+ FBIOGATTR:=FpIoctl(fd,nr_FBIOGATTR,@param1)=0;
+end;
+
+Function FBIOSVIDEO(fd:longint;var param1 : longint):boolean;
+{IOW('F',7,sizeof(int) }
+
+Begin
+ FBIOSVIDEO:=FpIoctl(fd,nr_FBIOSVIDEO,@param1)=0;
+end;
+
+Function FBIOGVIDEO(fd:longint;var param1 : longint):boolean;
+{IOR('F',8,sizeof(int) }
+
+Begin
+ FBIOGVIDEO:=FpIoctl(fd,nr_FBIOGVIDEO,@param1)=0;
+end;
+
+Function FBIOSCURSOR(fd:longint;var param1 : fbcursor):boolean;
+{IOW('F',24,sizeof(struct fbcursor) }
+
+Begin
+ FBIOSCURSOR:=FpIoctl(fd,nr_FBIOSCURSOR,@param1)=0;
+end;
+
+Function FBIOGCURSOR(fd:longint;var param1 : fbcursor):boolean;
+{IOWR('F',25,sizeof(struct fbcursor) }
+
+Begin
+ FBIOGCURSOR:=FpIoctl(fd,nr_FBIOGCURSOR,@param1)=0;
+end;
+
+Function FBIOSCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+{IOW('F',26,sizeof(struct fbcurpos) }
+
+Begin
+ FBIOSCURPOS:=FpIoctl(fd,nr_FBIOSCURPOS,@param1)=0;
+end;
+
+Function FBIOGCURPOS(fd:longint;var param1 : fbcurpos):boolean;
+{IOW('F',27,sizeof(struct fbcurpos) }
+
+Begin
+ FBIOGCURPOS:=FpIoctl(fd,nr_FBIOGCURPOS,@param1)=0;
+end;
+
+Function FBIOGCURMAX(fd:longint;var param1 : fbcurpos):boolean;
+{IOR('F',28,sizeof(struct fbcurpos) }
+
+Begin
+ FBIOGCURMAX:=FpIoctl(fd,nr_FBIOGCURMAX,@param1)=0;
+end;
+
+Function FBIO_ADAPTER(fd:longint;var param1 : longint):boolean;
+{IOR('F',100,sizeof(int) }
+
+Begin
+ FBIO_ADAPTER:=FpIoctl(fd,nr_FBIO_ADAPTER,@param1)=0;
+end;
+
+Function FBIO_ADPTYPE(fd:longint;var param1 : longint):boolean;
+{IOR('F',101,sizeof(int) }
+
+Begin
+ FBIO_ADPTYPE:=FpIoctl(fd,nr_FBIO_ADPTYPE,@param1)=0;
+end;
+
+Function FBIO_ADPINFO(fd:longint;var param1 : video_adapter_info):boolean;
+{IOR('F',102,sizeof(struct video_adapter_info) }
+
+Begin
+ FBIO_ADPINFO:=FpIoctl(fd,nr_FBIO_ADPINFO,@param1)=0;
+end;
+
+Function FBIO_MODEINFO(fd:longint;var param1 : video_info):boolean;
+{IOWR('F',103,sizeof(struct video_info) }
+
+Begin
+ FBIO_MODEINFO:=FpIoctl(fd,nr_FBIO_MODEINFO,@param1)=0;
+end;
+
+Function FBIO_FINDMODE(fd:longint;var param1 : video_info):boolean;
+{IOWR('F',104,sizeof(struct video_info) }
+
+Begin
+ FBIO_FINDMODE:=FpIoctl(fd,nr_FBIO_FINDMODE,@param1)=0;
+end;
+
+Function FBIO_GETMODE(fd:longint;var param1 : longint):boolean;
+{IOR('F',105,sizeof(int) }
+
+Begin
+ FBIO_GETMODE:=FpIoctl(fd,nr_FBIO_GETMODE,@param1)=0;
+end;
+
+Function FBIO_SETMODE(fd:longint;var param1 : longint):boolean;
+{IOW('F',106,sizeof(int) }
+
+Begin
+ FBIO_SETMODE:=FpIoctl(fd,nr_FBIO_SETMODE,@param1)=0;
+end;
+
+Function FBIO_GETWINORG(fd:longint;var param1 : u_int):boolean;
+{IOR('F',107,sizeof(u_int) }
+
+Begin
+ FBIO_GETWINORG:=FpIoctl(fd,nr_FBIO_GETWINORG,@param1)=0;
+end;
+
+Function FBIO_SETWINORG(fd:longint;var param1 : u_int):boolean;
+{IOW('F',108,sizeof(u_int) }
+
+Begin
+ FBIO_SETWINORG:=FpIoctl(fd,nr_FBIO_SETWINORG,@param1)=0;
+end;
+
+Function FBIO_GETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+{IOR('F',109,sizeof(video_display_start_t) }
+
+Begin
+ FBIO_GETDISPSTART:=FpIoctl(fd,nr_FBIO_GETDISPSTART,@param1)=0;
+end;
+
+Function FBIO_SETDISPSTART(fd:longint;var param1 : video_display_start_t):boolean;
+{IOW('F',110,sizeof(video_display_start_t) }
+
+Begin
+ FBIO_SETDISPSTART:=FpIoctl(fd,nr_FBIO_SETDISPSTART,@param1)=0;
+end;
+
+Function FBIO_GETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+{IOR('F',111,sizeof(u_int) }
+
+Begin
+ FBIO_GETLINEWIDTH:=FpIoctl(fd,nr_FBIO_GETLINEWIDTH,@param1)=0;
+end;
+
+Function FBIO_SETLINEWIDTH(fd:longint;var param1 : u_int):boolean;
+{IOW('F',112,sizeof(u_int) }
+
+Begin
+ FBIO_SETLINEWIDTH:=FpIoctl(fd,nr_FBIO_SETLINEWIDTH,@param1)=0;
+end;
+
+Function FBIO_GETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+{IOW('F',113,sizeof(video_color_palette_t) }
+
+Begin
+ FBIO_GETPALETTE:=FpIoctl(fd,nr_FBIO_GETPALETTE,@param1)=0;
+end;
+
+Function FBIO_SETPALETTE(fd:longint;var param1 : video_color_palette_t):boolean;
+{IOW('F',114,sizeof(video_color_palette_t) }
+
+Begin
+ FBIO_SETPALETTE:=FpIoctl(fd,nr_FBIO_SETPALETTE,@param1)=0;
+end;
+
+
+{consio.h FpIoctl's}
+
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+{IOR('K',9,sizeof(int) }
+
+Begin
+ KDGETMODE:=FpIoctl(fd,nr_KDGETMODE,@param1)=0;
+end;
+
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+{IO('K',10 /* int */));
+ }
+
+Begin
+ KDSETMODE:=FpIoctl(fd,nr_KDSETMODE,pointer(param1))=0;
+end;
+
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+{IO('K',13 /* int */));
+ }
+
+Begin
+ KDSBORDER:=FpIoctl(fd,nr_KDSBORDER,pointer(param1))=0;
+end;
+
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+{IOW('K',100,sizeof(scr_size_t) }
+
+Begin
+ KDRASTER:=FpIoctl(fd,nr_KDRASTER,@param1)=0;
+end;
+
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOR('k',2,sizeof(scrmap_t) }
+
+Begin
+ GIO_SCRNMAP:=FpIoctl(fd,nr_GIO_SCRNMAP,@param1)=0;
+end;
+
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOW('k',3,sizeof(scrmap_t) }
+
+Begin
+ PIO_SCRNMAP:=FpIoctl(fd,nr_PIO_SCRNMAP,@param1)=0;
+end;
+
+Function GIO_ATTR(fd:longint;var param1 : longint):boolean;
+{IOR('a',0,sizeof(int) }
+
+Begin
+ GIO_ATTR:=FpIoctl(fd,nr_GIO_ATTR,@param1)=0;
+end;
+
+Function GIO_COLOR(fd:longint;var param1 : longint):boolean;
+{IOR('c',0,sizeof(int) }
+
+Begin
+ GIO_COLOR:=FpIoctl(fd,nr_GIO_COLOR,@param1)=0;
+end;
+
+Function CONS_CURRENT(fd:longint;var param1 : longint):boolean;
+{IOR('c',1,sizeof(int) }
+
+Begin
+ CONS_CURRENT:=FpIoctl(fd,nr_CONS_CURRENT,@param1)=0;
+end;
+
+Function CONS_GET(fd:longint;var param1 : longint):boolean;
+{IOR('c',2,sizeof(int) }
+
+Begin
+ CONS_GET:=FpIoctl(fd,nr_CONS_GET,@param1)=0;
+end;
+
+Function CONS_IO(fd:longint):boolean;
+{IO('c',3));
+ }
+
+Begin
+ CONS_IO:=FpIoctl(fd,nr_CONS_IO,nil)=0;
+end;
+
+Function CONS_BLANKTIME(fd:longint;var param1 : longint):boolean;
+{IOW('c',4,sizeof(int) }
+
+Begin
+ CONS_BLANKTIME:=FpIoctl(fd,nr_CONS_BLANKTIME,@param1)=0;
+end;
+
+Function CONS_SSAVER(fd:longint;var param1 : ssaver_t):boolean;
+{IOW('c',5,sizeof(ssaver_t) }
+
+Begin
+ CONS_SSAVER:=FpIoctl(fd,nr_CONS_SSAVER,@param1)=0;
+end;
+
+Function CONS_GSAVER(fd:longint;var param1 : ssaver_t):boolean;
+{IOWR('c',6,sizeof(ssaver_t) }
+
+Begin
+ CONS_GSAVER:=FpIoctl(fd,nr_CONS_GSAVER,@param1)=0;
+end;
+
+Function CONS_CURSORTYPE(fd:longint;var param1 : longint):boolean;
+{IOW('c',7,sizeof(int) }
+
+Begin
+ CONS_CURSORTYPE:=FpIoctl(fd,nr_CONS_CURSORTYPE,@param1)=0;
+end;
+
+Function CONS_BELLTYPE(fd:longint;var param1 : longint):boolean;
+{IOW('c',8,sizeof(int) }
+
+Begin
+ CONS_BELLTYPE:=FpIoctl(fd,nr_CONS_BELLTYPE,@param1)=0;
+end;
+
+Function CONS_HISTORY(fd:longint;var param1 : longint):boolean;
+{IOW('c',9,sizeof(int) }
+
+Begin
+ CONS_HISTORY:=FpIoctl(fd,nr_CONS_HISTORY,@param1)=0;
+end;
+
+Function CONS_MOUSECTL(fd:longint;var param1 : mouse_info_t):boolean;
+{IOWR('c',10,sizeof(mouse_info_t) }
+
+Begin
+ CONS_MOUSECTL:=FpIoctl(fd,nr_CONS_MOUSECTL,@param1)=0;
+end;
+
+Function CONS_IDLE(fd:longint;var param1 : longint):boolean;
+{IOR('c',11,sizeof(int) }
+
+Begin
+ CONS_IDLE:=FpIoctl(fd,nr_CONS_IDLE,@param1)=0;
+end;
+
+Function CONS_SAVERMODE(fd:longint;var param1 : longint):boolean;
+{IOW('c',12,sizeof(int) }
+
+Begin
+ CONS_SAVERMODE:=FpIoctl(fd,nr_CONS_SAVERMODE,@param1)=0;
+end;
+
+Function CONS_SAVERSTART(fd:longint;var param1 : longint):boolean;
+{IOW('c',13,sizeof(int) }
+
+Begin
+ CONS_SAVERSTART:=FpIoctl(fd,nr_CONS_SAVERSTART,@param1)=0;
+end;
+
+Function PIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+{IOW('c',64,sizeof(fnt8_t) }
+
+Begin
+ PIO_FONT8x8:=FpIoctl(fd,nr_PIO_FONT8x8,@param1)=0;
+end;
+
+Function GIO_FONT8x8(fd:longint;var param1 : fnt8_t):boolean;
+{IOR('c',65,sizeof(fnt8_t) }
+
+Begin
+ GIO_FONT8x8:=FpIoctl(fd,nr_GIO_FONT8x8,@param1)=0;
+end;
+
+Function PIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+{IOW('c',66,sizeof(fnt14_t) }
+
+Begin
+ PIO_FONT8x14:=FpIoctl(fd,nr_PIO_FONT8x14,@param1)=0;
+end;
+
+Function GIO_FONT8x14(fd:longint;var param1 : fnt14_t):boolean;
+{IOR('c',67,sizeof(fnt14_t) }
+
+Begin
+ GIO_FONT8x14:=FpIoctl(fd,nr_GIO_FONT8x14,@param1)=0;
+end;
+
+Function PIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+{IOW('c',68,sizeof(fnt16_t) }
+
+Begin
+ PIO_FONT8x16:=FpIoctl(fd,nr_PIO_FONT8x16,@param1)=0;
+end;
+
+Function GIO_FONT8x16(fd:longint;var param1 : fnt16_t):boolean;
+{IOR('c',69,sizeof(fnt16_t) }
+
+Begin
+ GIO_FONT8x16:=FpIoctl(fd,nr_GIO_FONT8x16,@param1)=0;
+end;
+
+Function CONS_GETINFO(fd:longint;var param1 : vid_info_t):boolean;
+{IOWR('c',73,sizeof(vid_info_t) }
+
+Begin
+ CONS_GETINFO:=FpIoctl(fd,nr_CONS_GETINFO,@param1)=0;
+end;
+
+Function CONS_GETVERS(fd:longint;var param1 : longint):boolean;
+{IOR('c',74,sizeof(int) }
+
+Begin
+ CONS_GETVERS:=FpIoctl(fd,nr_CONS_GETVERS,@param1)=0;
+end;
+
+Function CONS_CURRENTADP(fd:longint;var param1 : longint):boolean;
+{IOR('c',100,sizeof(int) }
+
+Begin
+ CONS_CURRENTADP:=FpIoctl(fd,nr_CONS_CURRENTADP,@param1)=0;
+end;
+
+Function CONS_ADPINFO(fd:longint;var param1 : video_adapter_info_t):boolean;
+{IOWR('c',101,sizeof(video_adapter_info_t) }
+
+Begin
+ CONS_ADPINFO:=FpIoctl(fd,nr_CONS_ADPINFO,@param1)=0;
+end;
+
+Function CONS_MODEINFO(fd:longint;var param1 : video_info_t):boolean;
+{IOWR('c',102,sizeof(video_info_t) }
+
+Begin
+ CONS_MODEINFO:=FpIoctl(fd,nr_CONS_MODEINFO,@param1)=0;
+end;
+
+Function CONS_FINDMODE(fd:longint;var param1 : video_info_t):boolean;
+{IOWR('c',103,sizeof(video_info_t) }
+
+Begin
+ CONS_FINDMODE:=FpIoctl(fd,nr_CONS_FINDMODE,@param1)=0;
+end;
+
+Function CONS_SETWINORG(fd:longint;param1 : longint):boolean;
+{IO('c',104 /* int */));
+ }
+
+Begin
+ CONS_SETWINORG:=FpIoctl(fd,nr_CONS_SETWINORG,pointer(param1))=0;
+end;
+
+Function CONS_SETKBD(fd:longint;param1 : longint):boolean;
+{IO('c',110 /* int */));
+ }
+
+Begin
+ CONS_SETKBD:=FpIoctl(fd,nr_CONS_SETKBD,pointer(param1))=0;
+end;
+
+Function CONS_RELKBD(fd:longint):boolean;
+{IO('c',111));
+ }
+
+Begin
+ CONS_RELKBD:=FpIoctl(fd,nr_CONS_RELKBD,nil)=0;
+end;
+
+Function CONS_GETTERM(fd:longint;var param1 : term_info_t):boolean;
+{IOWR('c',112,sizeof(term_info_t) }
+
+Begin
+ CONS_GETTERM:=FpIoctl(fd,nr_CONS_GETTERM,@param1)=0;
+end;
+
+Function CONS_SETTERM(fd:longint;var param1 : term_info_t):boolean;
+{IOW('c',113,sizeof(term_info_t) }
+
+Begin
+ CONS_SETTERM:=FpIoctl(fd,nr_CONS_SETTERM,@param1)=0;
+end;
+
+Function ADJUST_CLOCK(fd:longint):boolean;
+{IO('t',100));
+ }
+
+Begin
+ ADJUST_CLOCK:=FpIoctl(fd,nr_ADJUST_CLOCK,nil)=0;
+end;
+
+Function VT_OPENQRY(fd:longint;var param1 : longint):boolean;
+{IOR('v',1,sizeof(int) }
+
+Begin
+ VT_OPENQRY:=FpIoctl(fd,nr_VT_OPENQRY,@param1)=0;
+end;
+
+Function VT_SETMODE(fd:longint;var param1 : vtmode_t):boolean;
+{IOW('v',2,sizeof(vtmode_t) }
+
+Begin
+ VT_SETMODE:=FpIoctl(fd,nr_VT_SETMODE,@param1)=0;
+end;
+
+Function VT_GETMODE(fd:longint;var param1 : vtmode_t):boolean;
+{IOR('v',3,sizeof(vtmode_t) }
+
+Begin
+ VT_GETMODE:=FpIoctl(fd,nr_VT_GETMODE,@param1)=0;
+end;
+
+Function VT_RELDISP(fd:longint;param1 : longint):boolean;
+{IO('v',4 /* int */));
+ }
+
+Begin
+ VT_RELDISP:=FpIoctl(fd,nr_VT_RELDISP,pointer(param1))=0;
+end;
+
+Function VT_ACTIVATE(fd:longint;param1 : longint):boolean;
+{IO('v',5 /* int */));
+ }
+
+Begin
+ VT_ACTIVATE:=FpIoctl(fd,nr_VT_ACTIVATE,pointer(param1))=0;
+end;
+
+Function VT_WAITACTIVE(fd:longint;param1 : longint):boolean;
+{IO('v',6 /* int */));
+ }
+
+Begin
+ VT_WAITACTIVE:=FpIoctl(fd,nr_VT_WAITACTIVE,pointer(param1))=0;
+end;
+
+Function VT_GETACTIVE(fd:longint;var param1 : longint):boolean;
+{IOR('v',7,sizeof(int) }
+
+Begin
+ VT_GETACTIVE:=FpIoctl(fd,nr_VT_GETACTIVE,@param1)=0;
+end;
+
+Function VT_GETINDEX(fd:longint;var param1 : longint):boolean;
+{IOR('v',8,sizeof(int) }
+
+Begin
+ VT_GETINDEX:=FpIoctl(fd,nr_VT_GETINDEX,@param1)=0;
+end;
+
+Function SW_B40x25(fd:longint):boolean;
+{IO('S',M_B40x25));
+ }
+
+Begin
+ SW_B40x25:=FpIoctl(fd,nr_SW_B40x25,nil)=0;
+end;
+
+Function SW_C40x25(fd:longint):boolean;
+{IO('S',M_C40x25));
+ }
+
+Begin
+ SW_C40x25:=FpIoctl(fd,nr_SW_C40x25,nil)=0;
+end;
+
+Function SW_B80x25(fd:longint):boolean;
+{IO('S',M_B80x25));
+ }
+
+Begin
+ SW_B80x25:=FpIoctl(fd,nr_SW_B80x25,nil)=0;
+end;
+
+Function SW_C80x25(fd:longint):boolean;
+{IO('S',M_C80x25));
+ }
+
+Begin
+ SW_C80x25:=FpIoctl(fd,nr_SW_C80x25,nil)=0;
+end;
+
+Function SW_BG320(fd:longint):boolean;
+{IO('S',M_BG320));
+ }
+
+Begin
+ SW_BG320:=FpIoctl(fd,nr_SW_BG320,nil)=0;
+end;
+
+Function SW_CG320(fd:longint):boolean;
+{IO('S',M_CG320));
+ }
+
+Begin
+ SW_CG320:=FpIoctl(fd,nr_SW_CG320,nil)=0;
+end;
+
+Function SW_BG640(fd:longint):boolean;
+{IO('S',M_BG640));
+ }
+
+Begin
+ SW_BG640:=FpIoctl(fd,nr_SW_BG640,nil)=0;
+end;
+
+Function SW_EGAMONO80x25(fd:longint):boolean;
+{IO('S',M_EGAMONO80x25));
+ }
+
+Begin
+ SW_EGAMONO80x25:=FpIoctl(fd,nr_SW_EGAMONO80x25,nil)=0;
+end;
+
+Function SW_CG320_D(fd:longint):boolean;
+{IO('S',M_CG320_D));
+ }
+
+Begin
+ SW_CG320_D:=FpIoctl(fd,nr_SW_CG320_D,nil)=0;
+end;
+
+Function SW_CG640_E(fd:longint):boolean;
+{IO('S',M_CG640_E));
+ }
+
+Begin
+ SW_CG640_E:=FpIoctl(fd,nr_SW_CG640_E,nil)=0;
+end;
+
+Function SW_EGAMONOAPA(fd:longint):boolean;
+{IO('S',M_EGAMONOAPA));
+ }
+
+Begin
+ SW_EGAMONOAPA:=FpIoctl(fd,nr_SW_EGAMONOAPA,nil)=0;
+end;
+
+Function SW_CG640x350(fd:longint):boolean;
+{IO('S',M_CG640x350));
+ }
+
+Begin
+ SW_CG640x350:=FpIoctl(fd,nr_SW_CG640x350,nil)=0;
+end;
+
+Function SW_ENH_MONOAPA2(fd:longint):boolean;
+{IO('S',M_ENHMONOAPA2));
+ }
+
+Begin
+ SW_ENH_MONOAPA2:=FpIoctl(fd,nr_SW_ENH_MONOAPA2,nil)=0;
+end;
+
+Function SW_ENH_CG640(fd:longint):boolean;
+{IO('S',M_ENH_CG640));
+ }
+
+Begin
+ SW_ENH_CG640:=FpIoctl(fd,nr_SW_ENH_CG640,nil)=0;
+end;
+
+Function SW_ENH_B40x25(fd:longint):boolean;
+{IO('S',M_ENH_B40x25));
+ }
+
+Begin
+ SW_ENH_B40x25:=FpIoctl(fd,nr_SW_ENH_B40x25,nil)=0;
+end;
+
+Function SW_ENH_C40x25(fd:longint):boolean;
+{IO('S',M_ENH_C40x25));
+ }
+
+Begin
+ SW_ENH_C40x25:=FpIoctl(fd,nr_SW_ENH_C40x25,nil)=0;
+end;
+
+Function SW_ENH_B80x25(fd:longint):boolean;
+{IO('S',M_ENH_B80x25));
+ }
+
+Begin
+ SW_ENH_B80x25:=FpIoctl(fd,nr_SW_ENH_B80x25,nil)=0;
+end;
+
+Function SW_ENH_C80x25(fd:longint):boolean;
+{IO('S',M_ENH_C80x25));
+ }
+
+Begin
+ SW_ENH_C80x25:=FpIoctl(fd,nr_SW_ENH_C80x25,nil)=0;
+end;
+
+Function SW_ENH_B80x43(fd:longint):boolean;
+{IO('S',M_ENH_B80x43));
+ }
+
+Begin
+ SW_ENH_B80x43:=FpIoctl(fd,nr_SW_ENH_B80x43,nil)=0;
+end;
+
+Function SW_ENH_C80x43(fd:longint):boolean;
+{IO('S',M_ENH_C80x43));
+ }
+
+Begin
+ SW_ENH_C80x43:=FpIoctl(fd,nr_SW_ENH_C80x43,nil)=0;
+end;
+
+Function SW_MCAMODE(fd:longint):boolean;
+{IO('S',M_MCA_MODE));
+ }
+
+Begin
+ SW_MCAMODE:=FpIoctl(fd,nr_SW_MCAMODE,nil)=0;
+end;
+
+Function SW_VGA_C40x25(fd:longint):boolean;
+{IO('S',M_VGA_C40x25));
+ }
+
+Begin
+ SW_VGA_C40x25:=FpIoctl(fd,nr_SW_VGA_C40x25,nil)=0;
+end;
+
+Function SW_VGA_C80x25(fd:longint):boolean;
+{IO('S',M_VGA_C80x25));
+ }
+
+Begin
+ SW_VGA_C80x25:=FpIoctl(fd,nr_SW_VGA_C80x25,nil)=0;
+end;
+
+Function SW_VGA_C80x30(fd:longint):boolean;
+{IO('S',M_VGA_C80x30));
+ }
+
+Begin
+ SW_VGA_C80x30:=FpIoctl(fd,nr_SW_VGA_C80x30,nil)=0;
+end;
+
+Function SW_VGA_C80x50(fd:longint):boolean;
+{IO('S',M_VGA_C80x50));
+ }
+
+Begin
+ SW_VGA_C80x50:=FpIoctl(fd,nr_SW_VGA_C80x50,nil)=0;
+end;
+
+Function SW_VGA_C80x60(fd:longint):boolean;
+{IO('S',M_VGA_C80x60));
+ }
+
+Begin
+ SW_VGA_C80x60:=FpIoctl(fd,nr_SW_VGA_C80x60,nil)=0;
+end;
+
+Function SW_VGA_M80x25(fd:longint):boolean;
+{IO('S',M_VGA_M80x25));
+ }
+
+Begin
+ SW_VGA_M80x25:=FpIoctl(fd,nr_SW_VGA_M80x25,nil)=0;
+end;
+
+Function SW_VGA_M80x30(fd:longint):boolean;
+{IO('S',M_VGA_M80x30));
+ }
+
+Begin
+ SW_VGA_M80x30:=FpIoctl(fd,nr_SW_VGA_M80x30,nil)=0;
+end;
+
+Function SW_VGA_M80x50(fd:longint):boolean;
+{IO('S',M_VGA_M80x50));
+ }
+
+Begin
+ SW_VGA_M80x50:=FpIoctl(fd,nr_SW_VGA_M80x50,nil)=0;
+end;
+
+Function SW_VGA_M80x60(fd:longint):boolean;
+{IO('S',M_VGA_M80x60));
+ }
+
+Begin
+ SW_VGA_M80x60:=FpIoctl(fd,nr_SW_VGA_M80x60,nil)=0;
+end;
+
+Function SW_VGA11(fd:longint):boolean;
+{IO('S',M_VGA11));
+ }
+
+Begin
+ SW_VGA11:=FpIoctl(fd,nr_SW_VGA11,nil)=0;
+end;
+
+Function SW_BG640x480(fd:longint):boolean;
+{IO('S',M_VGA11));
+ }
+
+Begin
+ SW_BG640x480:=FpIoctl(fd,nr_SW_BG640x480,nil)=0;
+end;
+
+Function SW_VGA12(fd:longint):boolean;
+{IO('S',M_VGA12));
+ }
+
+Begin
+ SW_VGA12:=FpIoctl(fd,nr_SW_VGA12,nil)=0;
+end;
+
+Function SW_CG640x480(fd:longint):boolean;
+{IO('S',M_VGA12));
+ }
+
+Begin
+ SW_CG640x480:=FpIoctl(fd,nr_SW_CG640x480,nil)=0;
+end;
+
+Function SW_VGA13(fd:longint):boolean;
+{IO('S',M_VGA13));
+ }
+
+Begin
+ SW_VGA13:=FpIoctl(fd,nr_SW_VGA13,nil)=0;
+end;
+
+Function SW_VGA_CG320(fd:longint):boolean;
+{IO('S',M_VGA13));
+ }
+
+Begin
+ SW_VGA_CG320:=FpIoctl(fd,nr_SW_VGA_CG320,nil)=0;
+end;
+
+Function SW_VGA_CG640(fd:longint):boolean;
+{IO('S',M_VGA_CG640));
+ }
+
+Begin
+ SW_VGA_CG640:=FpIoctl(fd,nr_SW_VGA_CG640,nil)=0;
+end;
+
+Function SW_VGA_MODEX(fd:longint):boolean;
+{IO('S',M_VGA_MODEX));
+ }
+
+Begin
+ SW_VGA_MODEX:=FpIoctl(fd,nr_SW_VGA_MODEX,nil)=0;
+end;
+
+Function SW_PC98_80x25(fd:longint):boolean;
+{IO('S',M_PC98_80x25));
+ }
+
+Begin
+ SW_PC98_80x25:=FpIoctl(fd,nr_SW_PC98_80x25,nil)=0;
+end;
+
+Function SW_PC98_80x30(fd:longint):boolean;
+{IO('S',M_PC98_80x30));
+ }
+
+Begin
+ SW_PC98_80x30:=FpIoctl(fd,nr_SW_PC98_80x30,nil)=0;
+end;
+
+Function SW_PC98_EGC640x400(fd:longint):boolean;
+{IO('S',M_PC98_EGC640x400));
+ }
+
+Begin
+ SW_PC98_EGC640x400:=FpIoctl(fd,nr_SW_PC98_EGC640x400,nil)=0;
+end;
+
+Function SW_PC98_PEGC640x400(fd:longint):boolean;
+{IO('S',M_PC98_PEGC640x400));
+ }
+
+Begin
+ SW_PC98_PEGC640x400:=FpIoctl(fd,nr_SW_PC98_PEGC640x400,nil)=0;
+end;
+
+Function SW_PC98_PEGC640x480(fd:longint):boolean;
+{IO('S',M_PC98_PEGC640x480));
+ }
+
+Begin
+ SW_PC98_PEGC640x480:=FpIoctl(fd,nr_SW_PC98_PEGC640x480,nil)=0;
+end;
+
+Function SW_VGA_C90x25(fd:longint):boolean;
+{IO('S',M_VGA_C90x25));
+ }
+
+Begin
+ SW_VGA_C90x25:=FpIoctl(fd,nr_SW_VGA_C90x25,nil)=0;
+end;
+
+Function SW_VGA_M90x25(fd:longint):boolean;
+{IO('S',M_VGA_M90x25));
+ }
+
+Begin
+ SW_VGA_M90x25:=FpIoctl(fd,nr_SW_VGA_M90x25,nil)=0;
+end;
+
+Function SW_VGA_C90x30(fd:longint):boolean;
+{IO('S',M_VGA_C90x30));
+ }
+
+Begin
+ SW_VGA_C90x30:=FpIoctl(fd,nr_SW_VGA_C90x30,nil)=0;
+end;
+
+Function SW_VGA_M90x30(fd:longint):boolean;
+{IO('S',M_VGA_M90x30));
+ }
+
+Begin
+ SW_VGA_M90x30:=FpIoctl(fd,nr_SW_VGA_M90x30,nil)=0;
+end;
+
+Function SW_VGA_C90x43(fd:longint):boolean;
+{IO('S',M_VGA_C90x43));
+ }
+
+Begin
+ SW_VGA_C90x43:=FpIoctl(fd,nr_SW_VGA_C90x43,nil)=0;
+end;
+
+Function SW_VGA_M90x43(fd:longint):boolean;
+{IO('S',M_VGA_M90x43));
+ }
+
+Begin
+ SW_VGA_M90x43:=FpIoctl(fd,nr_SW_VGA_M90x43,nil)=0;
+end;
+
+Function SW_VGA_C90x50(fd:longint):boolean;
+{IO('S',M_VGA_C90x50));
+ }
+
+Begin
+ SW_VGA_C90x50:=FpIoctl(fd,nr_SW_VGA_C90x50,nil)=0;
+end;
+
+Function SW_VGA_M90x50(fd:longint):boolean;
+{IO('S',M_VGA_M90x50));
+ }
+
+Begin
+ SW_VGA_M90x50:=FpIoctl(fd,nr_SW_VGA_M90x50,nil)=0;
+end;
+
+Function SW_VGA_C90x60(fd:longint):boolean;
+{IO('S',M_VGA_C90x60));
+ }
+
+Begin
+ SW_VGA_C90x60:=FpIoctl(fd,nr_SW_VGA_C90x60,nil)=0;
+end;
+
+Function SW_VGA_M90x60(fd:longint):boolean;
+{IO('S',M_VGA_M90x60));
+ }
+
+Begin
+ SW_VGA_M90x60:=FpIoctl(fd,nr_SW_VGA_M90x60,nil)=0;
+end;
+
+Function SW_TEXT_80x25(fd:longint):boolean;
+{IO('S',M_TEXT_80x25));
+ }
+
+Begin
+ SW_TEXT_80x25:=FpIoctl(fd,nr_SW_TEXT_80x25,nil)=0;
+end;
+
+Function SW_TEXT_80x30(fd:longint):boolean;
+{IO('S',M_TEXT_80x30));
+ }
+
+Begin
+ SW_TEXT_80x30:=FpIoctl(fd,nr_SW_TEXT_80x30,nil)=0;
+end;
+
+Function SW_TEXT_80x43(fd:longint):boolean;
+{IO('S',M_TEXT_80x43));
+ }
+
+Begin
+ SW_TEXT_80x43:=FpIoctl(fd,nr_SW_TEXT_80x43,nil)=0;
+end;
+
+Function SW_TEXT_80x50(fd:longint):boolean;
+{IO('S',M_TEXT_80x50));
+ }
+
+Begin
+ SW_TEXT_80x50:=FpIoctl(fd,nr_SW_TEXT_80x50,nil)=0;
+end;
+
+Function SW_TEXT_80x60(fd:longint):boolean;
+{IO('S',M_TEXT_80x60));
+ }
+
+Begin
+ SW_TEXT_80x60:=FpIoctl(fd,nr_SW_TEXT_80x60,nil)=0;
+end;
+
+Function SW_TEXT_132x25(fd:longint):boolean;
+{IO('S',M_TEXT_132x25));
+ }
+
+Begin
+ SW_TEXT_132x25:=FpIoctl(fd,nr_SW_TEXT_132x25,nil)=0;
+end;
+
+Function SW_TEXT_132x30(fd:longint):boolean;
+{IO('S',M_TEXT_132x30));
+ }
+
+Begin
+ SW_TEXT_132x30:=FpIoctl(fd,nr_SW_TEXT_132x30,nil)=0;
+end;
+
+Function SW_TEXT_132x43(fd:longint):boolean;
+{IO('S',M_TEXT_132x43));
+ }
+
+Begin
+ SW_TEXT_132x43:=FpIoctl(fd,nr_SW_TEXT_132x43,nil)=0;
+end;
+
+Function SW_TEXT_132x50(fd:longint):boolean;
+{IO('S',M_TEXT_132x50));
+ }
+
+Begin
+ SW_TEXT_132x50:=FpIoctl(fd,nr_SW_TEXT_132x50,nil)=0;
+end;
+
+Function SW_TEXT_132x60(fd:longint):boolean;
+{IO('S',M_TEXT_132x60));
+ }
+
+Begin
+ SW_TEXT_132x60:=FpIoctl(fd,nr_SW_TEXT_132x60,nil)=0;
+end;
+
+Function SW_VESA_CG640x400(fd:longint):boolean;
+{IO('V',M_VESA_CG640x400 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_CG640x400:=FpIoctl(fd,nr_SW_VESA_CG640x400,nil)=0;
+end;
+
+Function SW_VESA_CG640x480(fd:longint):boolean;
+{IO('V',M_VESA_CG640x480 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_CG640x480:=FpIoctl(fd,nr_SW_VESA_CG640x480,nil)=0;
+end;
+
+Function SW_VESA_800x600(fd:longint):boolean;
+{IO('V',M_VESA_800x600 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_800x600:=FpIoctl(fd,nr_SW_VESA_800x600,nil)=0;
+end;
+
+Function SW_VESA_CG800x600(fd:longint):boolean;
+{IO('V',M_VESA_CG800x600 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_CG800x600:=FpIoctl(fd,nr_SW_VESA_CG800x600,nil)=0;
+end;
+
+Function SW_VESA_1024x768(fd:longint):boolean;
+{IO('V',M_VESA_1024x768 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_1024x768:=FpIoctl(fd,nr_SW_VESA_1024x768,nil)=0;
+end;
+
+Function SW_VESA_CG1024x768(fd:longint):boolean;
+{IO('V',M_VESA_CG1024x768 - M_VESA_BAS));
+ }
+
+Begin
+ SW_VESA_CG1024x768:=FpIoctl(fd,nr_SW_VESA_CG1024x768,nil)=0;
+end;
+
+Function SW_VESA_1280x1024(fd:longint):boolean;
+{IO('V',M_VESA_1280x1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_1280x1024:=FpIoctl(fd,nr_SW_VESA_1280x1024,nil)=0;
+end;
+
+Function SW_VESA_CG1280x1024(fd:longint):boolean;
+{IO('V',M_VESA_CG1280x1024 - M_VESA_BA));
+ }
+
+Begin
+ SW_VESA_CG1280x1024:=FpIoctl(fd,nr_SW_VESA_CG1280x1024,nil)=0;
+end;
+
+Function SW_VESA_C80x60(fd:longint):boolean;
+{IO('V',M_VESA_C80x60 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C80x60:=FpIoctl(fd,nr_SW_VESA_C80x60,nil)=0;
+end;
+
+Function SW_VESA_C132x25(fd:longint):boolean;
+{IO('V',M_VESA_C132x25 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x25:=FpIoctl(fd,nr_SW_VESA_C132x25,nil)=0;
+end;
+
+Function SW_VESA_C132x43(fd:longint):boolean;
+{IO('V',M_VESA_C132x43 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x43:=FpIoctl(fd,nr_SW_VESA_C132x43,nil)=0;
+end;
+
+Function SW_VESA_C132x50(fd:longint):boolean;
+{IO('V',M_VESA_C132x50 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x50:=FpIoctl(fd,nr_SW_VESA_C132x50,nil)=0;
+end;
+
+Function SW_VESA_C132x60(fd:longint):boolean;
+{IO('V',M_VESA_C132x60 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_C132x60:=FpIoctl(fd,nr_SW_VESA_C132x60,nil)=0;
+end;
+
+Function SW_VESA_32K_320(fd:longint):boolean;
+{IO('V',M_VESA_32K_320 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_320:=FpIoctl(fd,nr_SW_VESA_32K_320,nil)=0;
+end;
+
+Function SW_VESA_64K_320(fd:longint):boolean;
+{IO('V',M_VESA_64K_320 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_320:=FpIoctl(fd,nr_SW_VESA_64K_320,nil)=0;
+end;
+
+Function SW_VESA_FULL_320(fd:longint):boolean;
+{IO('V',M_VESA_FULL_320 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_320:=FpIoctl(fd,nr_SW_VESA_FULL_320,nil)=0;
+end;
+
+Function SW_VESA_32K_640(fd:longint):boolean;
+{IO('V',M_VESA_32K_640 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_640:=FpIoctl(fd,nr_SW_VESA_32K_640,nil)=0;
+end;
+
+Function SW_VESA_64K_640(fd:longint):boolean;
+{IO('V',M_VESA_64K_640 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_640:=FpIoctl(fd,nr_SW_VESA_64K_640,nil)=0;
+end;
+
+Function SW_VESA_FULL_640(fd:longint):boolean;
+{IO('V',M_VESA_FULL_640 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_640:=FpIoctl(fd,nr_SW_VESA_FULL_640,nil)=0;
+end;
+
+Function SW_VESA_32K_800(fd:longint):boolean;
+{IO('V',M_VESA_32K_800 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_800:=FpIoctl(fd,nr_SW_VESA_32K_800,nil)=0;
+end;
+
+Function SW_VESA_64K_800(fd:longint):boolean;
+{IO('V',M_VESA_64K_800 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_800:=FpIoctl(fd,nr_SW_VESA_64K_800,nil)=0;
+end;
+
+Function SW_VESA_FULL_800(fd:longint):boolean;
+{IO('V',M_VESA_FULL_800 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_800:=FpIoctl(fd,nr_SW_VESA_FULL_800,nil)=0;
+end;
+
+Function SW_VESA_32K_1024(fd:longint):boolean;
+{IO('V',M_VESA_32K_1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_1024:=FpIoctl(fd,nr_SW_VESA_32K_1024,nil)=0;
+end;
+
+Function SW_VESA_64K_1024(fd:longint):boolean;
+{IO('V',M_VESA_64K_1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_1024:=FpIoctl(fd,nr_SW_VESA_64K_1024,nil)=0;
+end;
+
+Function SW_VESA_FULL_1024(fd:longint):boolean;
+{IO('V',M_VESA_FULL_1024 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_1024:=FpIoctl(fd,nr_SW_VESA_FULL_1024,nil)=0;
+end;
+
+Function SW_VESA_32K_1280(fd:longint):boolean;
+{IO('V',M_VESA_32K_1280 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_32K_1280:=FpIoctl(fd,nr_SW_VESA_32K_1280,nil)=0;
+end;
+
+Function SW_VESA_64K_1280(fd:longint):boolean;
+{IO('V',M_VESA_64K_1280 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_64K_1280:=FpIoctl(fd,nr_SW_VESA_64K_1280,nil)=0;
+end;
+
+Function SW_VESA_FULL_1280(fd:longint):boolean;
+{IO('V',M_VESA_FULL_1280 - M_VESA_BASE));
+ }
+
+Begin
+ SW_VESA_FULL_1280:=FpIoctl(fd,nr_SW_VESA_FULL_1280,nil)=0;
+end;
+
+{----------------------------- kbio.h FpIoctl's ---------------------------}
+
+Function KDGKBMODE(fd:longint;var param1 : longint):boolean;
+{IOR('K',6,sizeof(int) }
+
+Begin
+ KDGKBMODE:=FpIoctl(fd,nr_KDGKBMODE,@param1)=0;
+end;
+
+Function KDSKBMODE(fd:longint;param1 : longint):boolean;
+{IO('K',7 /* int */));
+ }
+
+Begin
+ KDSKBMODE:=FpIoctl(fd,nr_KDSKBMODE,pointer(param1))=0;
+end;
+
+Function KDMKTONE(fd:longint;param1 : longint):boolean;
+{IO('K',8 /* int */));
+ }
+
+Begin
+ KDMKTONE:=FpIoctl(fd,nr_KDMKTONE,pointer(param1))=0;
+end;
+
+{$ifndef definconsole}
+Function KDGETMODE(fd:longint;var param1 : longint):boolean;
+{IOR('K',9,sizeof(int) }
+
+Begin
+ KDGETMODE:=FpIoctl(fd,nr_KDGETMODE,@param1)=0;
+end;
+
+Function KDSETMODE(fd:longint;param1 : longint):boolean;
+{IO('K',10 /* int */));
+ }
+
+Begin
+ KDSETMODE:=FpIoctl(fd,nr_KDSETMODE,pointer(param1))=0;
+end;
+
+Function KDSBORDER(fd:longint;param1 : longint):boolean;
+{IO('K',13 /* int */));
+ }
+
+Begin
+ KDSBORDER:=FpIoctl(fd,nr_KDSBORDER,pointer(param1))=0;
+end;
+{$endif}
+Function KDGKBSTATE(fd:longint;var param1 : longint):boolean;
+{IOR('K',19,sizeof(int) }
+
+Begin
+ KDGKBSTATE:=FpIoctl(fd,nr_KDGKBSTATE,@param1)=0;
+end;
+
+Function KDSKBSTATE(fd:longint;param1 : longint):boolean;
+{IO('K',20 /* int */));
+ }
+
+Begin
+ KDSKBSTATE:=FpIoctl(fd,nr_KDSKBSTATE,pointer(param1))=0;
+end;
+
+Function KDENABIO(fd:longint):boolean;
+{IO('K',60));
+ }
+
+Begin
+ KDENABIO:=FpIoctl(fd,nr_KDENABIO,nil)=0;
+end;
+
+Function KDDISABIO(fd:longint):boolean;
+{IO('K',61));
+ }
+
+Begin
+ KDDISABIO:=FpIoctl(fd,nr_KDDISABIO,nil)=0;
+end;
+
+Function KIOCSOUND(fd:longint;param1 : longint):boolean;
+{IO('K',63 /* int */));
+ }
+
+Begin
+ KIOCSOUND:=FpIoctl(fd,nr_KIOCSOUND,pointer(param1))=0;
+end;
+
+Function KDGKBTYPE(fd:longint;var param1 : longint):boolean;
+{IOR('K',64,sizeof(int) }
+
+Begin
+ KDGKBTYPE:=FpIoctl(fd,nr_KDGKBTYPE,@param1)=0;
+end;
+
+Function KDGETLED(fd:longint;var param1 : longint):boolean;
+{IOR('K',65,sizeof(int) }
+
+Begin
+ KDGETLED:=FpIoctl(fd,nr_KDGETLED,@param1)=0;
+end;
+
+Function KDSETLED(fd:longint;param1 : longint):boolean;
+{IO('K',66 /* int */));
+ }
+
+Begin
+ KDSETLED:=FpIoctl(fd,nr_KDSETLED,pointer(param1))=0;
+end;
+
+Function KDSETRAD(fd:longint;param1 : longint):boolean;
+{IO('K',67 /* int */));
+ }
+
+Begin
+ KDSETRAD:=FpIoctl(fd,nr_KDSETRAD,pointer(param1))=0;
+end;
+{$ifndef definconsole}
+
+Function KDRASTER(fd:longint;var param1 : scr_size_t):boolean;
+{IOW('K',100,sizeof(scr_size_t) }
+
+Begin
+ KDRASTER:=FpIoctl(fd,nr_KDRASTER,@param1)=0;
+end;
+{$endif}
+Function KDGKBINFO(fd:longint;var param1 : keyboard_info_t):boolean;
+{IOR('K',101,sizeof(keyboard_info_t) }
+
+Begin
+ KDGKBINFO:=FpIoctl(fd,nr_KDGKBINFO,@param1)=0;
+end;
+
+Function KDSETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+{IOW('K',102,sizeof(keyboard_repeat_t) }
+
+Begin
+ KDSETREPEAT:=FpIoctl(fd,nr_KDSETREPEAT,@param1)=0;
+end;
+
+Function KDGETREPEAT(fd:longint;var param1 : keyboard_repeat_t):boolean;
+{IOR('K',103,sizeof(keyboard_repeat_t) }
+
+Begin
+ KDGETREPEAT:=FpIoctl(fd,nr_KDGETREPEAT,@param1)=0;
+end;
+
+Function GETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+{IOWR('k',0,sizeof(fkeyarg_t) }
+
+Begin
+ GETFKEY:=FpIoctl(fd,nr_GETFKEY,@param1)=0;
+end;
+
+Function SETFKEY(fd:longint;var param1 : fkeyarg_t):boolean;
+{IOWR('k',1,sizeof(fkeyarg_t) }
+
+Begin
+ SETFKEY:=FpIoctl(fd,nr_SETFKEY,@param1)=0;
+end;
+{$ifndef definconsole}
+Function GIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOR('k',2,sizeof(scrmap_t) }
+
+Begin
+ GIO_SCRNMAP:=FpIoctl(fd,nr_GIO_SCRNMAP,@param1)=0;
+end;
+
+Function PIO_SCRNMAP(fd:longint;var param1 : scrmap_t):boolean;
+{IOW('k',3,sizeof(scrmap_t) }
+
+Begin
+ PIO_SCRNMAP:=FpIoctl(fd,nr_PIO_SCRNMAP,@param1)=0;
+end;
+{$endif}
+Function GIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+{IOR('k',6,sizeof(keymap_t) }
+
+Begin
+ GIO_KEYMAP:=FpIoctl(fd,nr_GIO_KEYMAP,@param1)=0;
+end;
+
+Function PIO_KEYMAP(fd:longint;var param1 : keymap_t):boolean;
+{IOW('k',7,sizeof(keymap_t) }
+
+Begin
+ PIO_KEYMAP:=FpIoctl(fd,nr_PIO_KEYMAP,@param1)=0;
+end;
+
+Function GIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+{IOR('k',8,sizeof(accentmap_t) }
+
+Begin
+ GIO_DEADKEYMAP:=FpIoctl(fd,nr_GIO_DEADKEYMAP,@param1)=0;
+end;
+
+Function PIO_DEADKEYMAP(fd:longint;var param1 : accentmap_t):boolean;
+{IOW('k',9,sizeof(accentmap_t) }
+
+Begin
+ PIO_DEADKEYMAP:=FpIoctl(fd,nr_PIO_DEADKEYMAP,@param1)=0;
+end;
+
+Function GIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+{IOWR('k',10,sizeof(keyarg_t) }
+
+Begin
+ GIO_KEYMAPENT:=FpIoctl(fd,nr_GIO_KEYMAPENT,@param1)=0;
+end;
+
+Function PIO_KEYMAPENT(fd:longint;var param1 : keyarg_t):boolean;
+{IOW('k',11,sizeof(keyarg_t) }
+
+Begin
+ PIO_KEYMAPENT:=FpIoctl(fd,nr_PIO_KEYMAPENT,@param1)=0;
+end;
+
+
+
+{----------------------------- mouse.h FpIoctl's ---------------------------}
+
+Function MOUSE_GETSTATUS(fd:longint;var param1 : mousestatus_t):boolean;
+{IOR('M',0,sizeof(mousestatus_t)));
+}
+
+Begin
+ MOUSE_GETSTATUS:=FpIoctl(fd,nr_MOUSE_GETSTATUS,@param1)=0;
+end;
+
+Function MOUSE_GETHWINFO(fd:longint;var param1 : mousehw_t):boolean;
+{IOR('M',1,sizeof(mousehw_t)));
+}
+
+Begin
+ MOUSE_GETHWINFO:=FpIoctl(fd,nr_MOUSE_GETHWINFO,@param1)=0;
+end;
+
+Function MOUSE_GETMODE(fd:longint;var param1 : mousemode_t):boolean;
+{IOR('M',2,sizeof(mousemode_t)));
+}
+
+Begin
+ MOUSE_GETMODE:=FpIoctl(fd,nr_MOUSE_GETMODE,@param1)=0;
+end;
+
+Function MOUSE_SETMODE(fd:longint;var param1 : mousemode_t):boolean;
+{IOW('M',3,sizeof(mousemode_t)));
+}
+
+Begin
+ MOUSE_SETMODE:=FpIoctl(fd,nr_MOUSE_SETMODE,@param1)=0;
+end;
+
+Function MOUSE_GETLEVEL(fd:longint;var param1 : longint):boolean;
+{IOR('M',4,sizeof(int)));
+}
+
+Begin
+ MOUSE_GETLEVEL:=FpIoctl(fd,nr_MOUSE_GETLEVEL,@param1)=0;
+end;
+
+Function MOUSE_SETLEVEL(fd:longint;var param1 : longint):boolean;
+{IOW('M',5,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETLEVEL:=FpIoctl(fd,nr_MOUSE_SETLEVEL,@param1)=0;
+end;
+
+Function MOUSE_GETVARS(fd:longint;var param1 : mousevar_t):boolean;
+{IOR('M',6,sizeof(mousevar_t)));
+}
+
+Begin
+ MOUSE_GETVARS:=FpIoctl(fd,nr_MOUSE_GETVARS,@param1)=0;
+end;
+
+Function MOUSE_SETVARS(fd:longint;var param1 : mousevar_t):boolean;
+{IOW('M',7,sizeof(mousevar_t)));
+}
+
+Begin
+ MOUSE_SETVARS:=FpIoctl(fd,nr_MOUSE_SETVARS,@param1)=0;
+end;
+
+Function MOUSE_READSTATE(fd:longint;var param1 : mousedata_t):boolean;
+{IOWR('M',8,sizeof(mousedata_t)));
+}
+
+Begin
+ MOUSE_READSTATE:=FpIoctl(fd,nr_MOUSE_READSTATE,@param1)=0;
+end;
+
+Function MOUSE_READDATA(fd:longint;var param1 : mousedata_t):boolean;
+{IOWR('M',9,sizeof(mousedata_t)));
+}
+
+Begin
+ MOUSE_READDATA:=FpIoctl(fd,nr_MOUSE_READDATA,@param1)=0;
+end;
+
+Function MOUSE_SETRESOLUTION(fd:longint;var param1 : longint):boolean;
+{IOW('M',10,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETRESOLUTION:=FpIoctl(fd,nr_MOUSE_SETRESOLUTION,@param1)=0;
+end;
+
+Function MOUSE_SETSCALING(fd:longint;var param1 : longint):boolean;
+{IOW('M',11,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETSCALING:=FpIoctl(fd,nr_MOUSE_SETSCALING,@param1)=0;
+end;
+
+Function MOUSE_SETRATE(fd:longint;var param1 : longint):boolean;
+{IOW('M',12,sizeof(int)));
+}
+
+Begin
+ MOUSE_SETRATE:=FpIoctl(fd,nr_MOUSE_SETRATE,@param1)=0;
+end;
+
+Function MOUSE_GETHWID(fd:longint;var param1 : longint):boolean;
+{IOR('M',13,sizeof(int)));
+}
+
+Begin
+ MOUSE_GETHWID:=FpIoctl(fd,nr_MOUSE_GETHWID,@param1)=0;
+end;
+
+end.
+
+{
+ $Log: console.pp,v $
+ Revision 1.11 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/errno.inc b/rtl/freebsd/errno.inc
new file mode 100644
index 0000000000..9ee2636374
--- /dev/null
+++ b/rtl/freebsd/errno.inc
@@ -0,0 +1,144 @@
+{
+ $Id: errno.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+
+ Errno.inc : define all error numbers, kernel version 1.2.13
+
+}
+Const
+
+
+ ESysEPERM = 1; { Operation not permitted }
+ ESysENOENT = 2; { No such file or directory }
+ ESysESRCH = 3; { No such process }
+ ESysEINTR = 4; { Interrupted system call }
+ ESysEIO = 5; { Input/output error }
+ ESysENXIO = 6; { Device not configured }
+ ESysE2BIG = 7; { Argument list too long }
+ ESysENOEXEC = 8; { Exec format error }
+ ESysEBADF = 9; { Bad file descriptor }
+ ESysECHILD = 10; { No child processes }
+ ESysEDEADLK = 11; { Resource deadlock avoided }
+ { 11 was EAGAIN }
+ ESysENOMEM = 12; { Cannot allocate memory }
+ ESysEACCES = 13; { Permission denied }
+ ESysEFAULT = 14; { Bad address }
+ ESysENOTBLK = 15; { Block device required }
+ ESysEBUSY = 16; { Device busy }
+ ESysEEXIST = 17; { File exists }
+ ESysEXDEV = 18; { Cross-device link }
+ ESysENODEV = 19; { Operation not supported by device }
+ ESysENOTDIR = 20; { Not a directory }
+ ESysEISDIR = 21; { Is a directory }
+ ESysEINVAL = 22; { Invalid argument }
+ ESysENFILE = 23; { Too many open files in system }
+ ESysEMFILE = 24; { Too many open files }
+ ESysENOTTY = 25; { Inappropriate ioctl for device }
+ ESysETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+ ESysEFBIG = 27; { File too large }
+ ESysENOSPC = 28; { No space left on device }
+ ESysESPIPE = 29; { Illegal seek }
+ ESysEROFS = 30; { Read-only file system }
+ ESysEMLINK = 31; { Too many links }
+ ESysEPIPE = 32; { Broken pipe }
+
+{ math software }
+ ESysEDOM = 33; { Numerical argument out of domain }
+ ESysERANGE = 34; { Result too large }
+
+{ non-blocking and interrupt i/o }
+ ESysEAGAIN = 35; { Resource temporarily unavailable }
+ ESysEWOULDBLOCK = ESysEAGAIN; { Operation would block }
+ ESysEINPROGRESS = 36; { Operation now in progress }
+ ESysEALREADY = 37; { Operation already in progress }
+
+{ ipc/network software - - argument errors }
+ ESysENOTSOCK = 38; { Socket operation on non-socket }
+ ESysEDESTADDRREQ = 39; { Destination address required }
+ ESysEMSGSIZE = 40; { Message too long }
+ ESysEPROTOTYPE = 41; { Protocol wrong type for socket }
+ ESysENOPROTOOPT = 42; { Protocol not available }
+ ESysEPROTONOSUPPORT = 43; { Protocol not supported }
+ ESysESOCKTNOSUPPORT = 44; { Socket type not supported }
+ ESysEOPNOTSUPP = 45; { Operation not supported }
+ ESysENOTSUP = ESysEOPNOTSUPP; { Operation not supported }
+ ESysEPFNOSUPPORT = 46; { Protocol family not supported }
+ ESysEAFNOSUPPORT = 47; { Address family not supported by protocol family }
+ ESysEADDRINUSE = 48; { Address already in use }
+ ESysEADDRNOTAVAIL = 49; { Can't assign requested address }
+
+{ ipc/network software - - operational errors }
+ ESysENETDOWN = 50; { Network is down }
+ ESysENETUNREACH = 51; { Network is unreachable }
+ ESysENETRESET = 52; { Network dropped connection on reset }
+ ESysECONNABORTED = 53; { Software caused connection abort }
+ ESysECONNRESET = 54; { Connection reset by peer }
+ ESysENOBUFS = 55; { No buffer space available }
+ ESysEISCONN = 56; { Socket is already connected }
+ ESysENOTCONN = 57; { Socket is not connected }
+ ESysESHUTDOWN = 58; { Can't send after socket shutdown }
+ ESysETOOMANYREFS = 59; { Too many references: can't splice }
+ ESysETIMEDOUT = 60; { Operation timed out }
+ ESysECONNREFUSED = 61; { Connection refused }
+
+ ESysELOOP = 62; { Too many levels of symbolic links }
+ ESysENAMETOOLONG = 63; { File name too long }
+
+{ should be rearranged }
+ ESysEHOSTDOWN = 64; { Host is down }
+ ESysEHOSTUNREACH = 65; { No route to host }
+ ESysENOTEMPTY = 66; { Directory not empty }
+
+{ quotas & mush }
+ ESysEPROCLIM = 67; { Too many processes }
+ ESysEUSERS = 68; { Too many users }
+ ESysEDQUOT = 69; { Disc quota exceeded }
+
+{ Network File System }
+ ESysESTALE = 70; { Stale NFS file handle }
+ ESysEREMOTE = 71; { Too many levels of remote in path }
+ ESysEBADRPC = 72; { RPC struct is bad }
+ ESysERPCMISMATCH = 73; { RPC version wrong }
+ ESysEPROGUNAVAIL = 74; { RPC prog. not avail }
+ ESysEPROGMISMATCH = 75; { Program version wrong }
+ ESysEPROCUNAVAIL = 76; { Bad procedure for program }
+
+ ESysENOLCK = 77; { No locks available }
+ ESysENOSYS = 78; { Function not implemented }
+
+ ESysEFTYPE = 79; { Inappropriate file type or format }
+ ESysEAUTH = 80; { Authentication error }
+ ESysENEEDAUTH = 81; { Need authenticator }
+ ESysEIDRM = 82; { Identifier removed }
+ ESysENOMSG = 83; { No message of desired type }
+ ESysEOVERFLOW = 84; { Value too large to be stored in data type }
+ ESysECANCELED = 85; { Operation canceled }
+ ESysEILSEQ = 86; { Illegal byte sequence }
+ ESysELAST = 86; { Must be equal largest errno }
+
+
+
+{
+ $Log: errno.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/i386/bsyscall.inc b/rtl/freebsd/i386/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/freebsd/i386/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/freebsd/i386/cprt0.as b/rtl/freebsd/i386/cprt0.as
new file mode 100644
index 0000000000..696b419ff4
--- /dev/null
+++ b/rtl/freebsd/i386/cprt0.as
@@ -0,0 +1,146 @@
+#
+# $Id: cprt0.as,v 1.4 2004/07/03 21:50:30 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Marco van de Voort, Michael Van Canneyt
+# and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# FreeBSD ELF startup code for Free Pascal for dynamical linking to libc.
+#
+
+ .file "cprt0.as"
+ .version "01.01"
+gcc2_compiled.:
+.globl __progname
+.section .rodata
+.LC0:
+ .ascii "\0"
+.data
+ .p2align 2
+ .type __progname,@object
+ .size __progname,4
+__progname:
+ .long .LC0
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+
+.text
+ .p2align 2
+.globl _start
+ .type _start,@function
+_start:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %edi
+ pushl %esi
+ pushl %ebx
+#APP
+ movl %edx,%edx
+#NO_APP
+ leal 8(%ebp),%edi
+ movl %edi,operatingsystem_parameter_argv
+ mov -4(%edi),%eax
+ movl %eax,operatingsystem_parameter_argc
+ movl 4(%ebp),%ebx
+ leal 12(%ebp,%ebx,4),%esi
+ movl %esi,operatingsystem_parameter_envp
+ movl %esi,environ
+ testl %ebx,%ebx
+ jle .L2
+ movl 8(%ebp),%eax
+ testl %eax,%eax
+ je .L2
+ movl %eax,__progname
+ cmpb $0,(%eax)
+ je .L2
+ .p2align 2,0x90
+.L6:
+ cmpb $47,(%eax)
+ jne .L5
+ leal 1(%eax),%ecx
+ movl %ecx,__progname
+.L5:
+ incl %eax
+ cmpb $0,(%eax)
+ jne .L6
+.L2:
+ movl $_DYNAMIC,%eax
+ testl %eax,%eax
+ je .L9
+ pushl %edx
+ call atexit
+ addl $4,%esp
+.L9:
+ pushl $_fini
+ call atexit
+ call _init
+# pushl %esi
+# pushl %edi
+# pushl %ebx
+# call main
+# pushl %eax
+# call exit
+
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+ xorl %ebp,%ebp
+
+ call main
+ pushl %eax
+ jmp _haltproc
+
+ .p2align 2,0x90
+
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl operatingsystem_result,%ebx
+ pushl %ebx
+ call .Lactualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+.Lactualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+.Lfe1:
+
+
+ .size _start,.Lfe1-_start
+ .comm environ,4,4
+ .weak _DYNAMIC
+ .ident "GCC: (GNU) 2.7.2.1"
+
+.bss
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
diff --git a/rtl/freebsd/i386/gprt0.as b/rtl/freebsd/i386/gprt0.as
new file mode 100644
index 0000000000..ad7605a043
--- /dev/null
+++ b/rtl/freebsd/i386/gprt0.as
@@ -0,0 +1,163 @@
+#
+# $Id: gprt0.as,v 1.3 2004/07/03 21:50:30 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Marco van de Voort, Michael Van Canneyt
+# and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# FreeBSD ELF startup code for Free Pascal for dynamical linking to libc
+# with profiling support.
+#
+
+ .file "gpcrt1.c"
+ .version "01.01"
+gcc2_compiled.:
+.section .note.ABI-tag,"a",@progbits
+ .p2align 2
+ .type abitag,@object
+ .size abitag,24
+abitag:
+ .long 8
+ .long 4
+ .long 1
+ .byte 0x46,0x72,0x65,0x65,0x42,0x53,0x44,0x0
+ .long 470000
+.globl __progname
+ .section .rodata
+.LC0:
+ .byte 0x0
+.data
+ .p2align 2
+ .type __progname,@object
+ .size __progname,4
+__progname:
+ .long .LC0
+
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+.text
+ .p2align 2,0x90
+.globl _start
+ .type _start,@function
+_start:
+#APP
+ movl %edx,%edx
+#NO_APP
+ pushl %ebp
+ movl %esp,%ebp
+ subl $12,%esp
+ pushl %edi
+ pushl %esi
+ pushl %ebx
+ movl 4(%ebp),%ebx
+ movl %ebx,operatingsystem_parameter_argc
+ leal 12(%ebp,%ebx,4),%esi
+ leal 8(%ebp),%eax
+ movl %eax,operatingsystem_parameter_argv
+ movl %eax,-4(%ebp)
+ movl %esi,operatingsystem_parameter_envp
+ movl %esi,environ
+ movl $_DYNAMIC,%ecx
+ testl %ebx,%ebx
+ jle .L3
+ movl 8(%ebp),%eax
+ testl %eax,%eax
+ je .L3
+ movl %eax,__progname
+ cmpb $0,(%eax)
+ je .L3
+ .p2align 2,0x90
+.L7:
+ cmpb $47,(%eax)
+ jne .L6
+ leal 1(%eax),%edi
+ movl %edi,__progname
+.L6:
+ incl %eax
+ cmpb $0,(%eax)
+ jne .L7
+.L3:
+ testl %ecx,%ecx
+ je .L10
+ addl $-12,%esp
+ pushl %edx
+ call atexit
+ addl $16,%esp
+.L10:
+ addl $-12,%esp
+ pushl $_mcleanup
+ call atexit
+ addl $-12,%esp
+ pushl $_fini
+ call atexit
+ addl $32,%esp
+ addl $-8,%esp
+ pushl $etext
+ pushl $eprol
+ call monstartup
+ call _init
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+ xorl %ebp,%ebp
+ call main
+ pushl %eax
+ jmp _haltproc
+
+.globl _haltproc
+.type _haltproc,@function
+_haltproc:
+ movzwl operatingsystem_result,%ebx
+ pushl %ebx
+ call exit
+ mov $1,%eax
+ movzwl operatingsystem_result,%ebx
+ pushl %ebx
+ call .Lactualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+.Lactualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+.Lfe1:
+ .size _start,.Lfe1-_start
+#APP
+ .text
+ eprol:
+ .previous
+#NO_APP
+ .comm environ,4,4
+ .globl _DYNAMIC
+ .weak _DYNAMIC
+ .ident "GCC: (GNU) c 2.95.4 20020320 [FreeBSD]"
+
+.bss
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
diff --git a/rtl/freebsd/i386/prt0.as b/rtl/freebsd/i386/prt0.as
new file mode 100644
index 0000000000..7b4ccb5295
--- /dev/null
+++ b/rtl/freebsd/i386/prt0.as
@@ -0,0 +1,130 @@
+#
+# $Id: prt0.as,v 1.4 2004/07/03 21:50:30 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Marco van de Voort, Michael Van Canneyt
+# and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# FreeBSD standard (static) ELF startup code for Free Pascal
+#
+
+ .file "prt1.as"
+ .version "01.01"
+gcc2_compiled.:
+.globl __progname
+.section .rodata
+.LC0:
+ .ascii "\0"
+.data
+ .p2align 2
+ .type __progname,@object
+ .size __progname,4
+__progname:
+ .long .LC0
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+
+.text
+ .p2align 2
+.globl _start
+ .type _start,@function
+_start:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %edi
+ pushl %esi
+ pushl %ebx
+#APP
+ movl %edx,%edx
+#NO_APP
+ leal 8(%ebp),%edi
+ movl %edi,operatingsystem_parameter_argv
+ mov -4(%edi),%eax
+ movl %eax,operatingsystem_parameter_argc
+ movl 4(%ebp),%ebx
+ leal 12(%ebp,%ebx,4),%esi
+ movl %esi,operatingsystem_parameter_envp
+ movl %esi,environ
+ testl %ebx,%ebx
+ jle .L2
+ movl 8(%ebp),%eax
+ testl %eax,%eax
+ je .L2
+ movl %eax,__progname
+ cmpb $0,(%eax)
+ je .L2
+ .p2align 2,0x90
+.L6:
+ cmpb $47,(%eax)
+ jne .L5
+ leal 1(%eax),%ecx
+ movl %ecx,__progname
+.L5:
+ incl %eax
+ cmpb $0,(%eax)
+ jne .L6
+.L2:
+.L9:
+
+# copied from linux
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+ xorl %ebp,%ebp
+
+ call main
+ pushl %eax
+ jmp _haltproc
+
+.p2align 2,0x90
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl operatingsystem_result,%ebx
+ pushl %ebx
+ call _actualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+_actualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+.Lfe1:
+ .size _start,.Lfe1-_start
+ .comm environ,4,4
+ .weak _DYNAMIC
+ .ident "GCC: (GNU) 2.7.2.1"
+
+.bss
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
diff --git a/rtl/freebsd/i386/sighnd.inc b/rtl/freebsd/i386/sighnd.inc
new file mode 100644
index 0000000000..cbb1a38d84
--- /dev/null
+++ b/rtl/freebsd/i386/sighnd.inc
@@ -0,0 +1,85 @@
+{
+ $Id: sighnd.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Signalhandler for FreeBSD/i386
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+procedure SignalToRunerror(Sig: cint; var info : tsiginfo_t;Var SigContext:SigContextRec); cdecl;
+
+var
+ res : word;
+
+begin
+ res:=0;
+ case sig of
+ SIGFPE :
+ begin
+ Case Info.si_code Of
+ FPE_INTDIV : Res:=200; {integer divide fault. Div0?}
+ FPE_FLTOVF : Res:=205; {Overflow trap}
+ FPE_FLTUND : Res:=206; {Stack over/underflow}
+ FPE_FLTRES : Res:=216; {Device not available}
+ FPE_FLTINV : Res:=216; {Invalid floating point operation}
+ Else
+ Res:=208; {coprocessor error}
+ End;
+ sysResetFPU;
+ End;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ {$ifdef FPC_USE_SIGPROCMASK}
+ reenable_signal(sig);
+ {$endif }
+{ give runtime error at the position where the signal was raised }
+ if res<>0 then
+ begin
+{$ifdef cpui386}
+ HandleErrorAddrFrame(res,Pointer(SigContext.sc_eip),pointer(SigContext.sc_ebp));
+{$else}
+ HandleError(res);
+{$endif}
+ end;
+end;
+{
+procedure SignalToRunerror(signo: cint); cdecl;
+var
+ res : word;
+begin
+ res:=0;
+
+ if signo = SIGFPE then
+ begin
+ res := 200;
+ end
+ else
+ if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
+ begin
+ res := 216;
+ end;
+ { give runtime error at the position where the signal was raised }
+ if res<>0 then
+ begin
+ HandleError(res);
+ end;
+end;
+}
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/i386/x86.inc b/rtl/freebsd/i386/x86.inc
new file mode 100644
index 0000000000..eea46d3541
--- /dev/null
+++ b/rtl/freebsd/i386/x86.inc
@@ -0,0 +1,84 @@
+{
+ $Id: x86.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ implementation for FreeBSD/i386 specific functions
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+{$packrecords C}
+
+TYPE uint=CARDINAL;
+
+CONST
+ I386_GET_LDT =0;
+ I386_SET_LDT =1;
+ { I386_IOPL }
+ I386_GET_IOPERM =3;
+ I386_SET_IOPERM =4;
+ { xxxxx }
+ I386_VM86 =6;
+
+{
+type i386_ldt_args = record
+ int start : longint;
+ union descriptor *descs;
+ int num;
+ end;
+}
+type
+ i386_ioperm_args = record
+ start : uint;
+ length : uint;
+ enable : longint;
+ end;
+
+
+ i386_vm86_args = record
+ sub_op : longint; { sub-operation to perform }
+ sub_args : pchar; { args }
+ end;
+
+ sysarch_args = record
+ op : longint;
+ parms : pchar;
+ end;
+
+{
+int i386_get_ldt __P((int, union descriptor *, int));
+int i386_set_ldt __P((int, union descriptor *, int));
+int i386_get_ioperm __P((unsigned int, unsigned int *, int *));
+int i386_set_ioperm __P((unsigned int, unsigned int, int));
+int i386_vm86 __P((int, void *));
+int i386_set_watch __P((int watchnum, unsigned int watchaddr, int size,
+ int access, struct dbreg * d));
+int i386_clr_watch __P((int watchnum, struct dbreg * d));
+}
+
+Function IOPerm(From,Num:CARDINAL;Value:Longint):cint;
+
+var sg : i386_ioperm_args;
+ sa : sysarch_args;
+
+begin
+ sg.start:=From;
+ sg.length:=Num;
+ sg.enable:=value;
+ sa.op:=i386_SET_IOPERM;
+ sa.parms:=@sg;
+ IOPerm:=do_syscall(syscall_nr_sysarch,longint(@sa));
+end;
+
+{
+ $Log: x86.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/i386/x86h.inc b/rtl/freebsd/i386/x86h.inc
new file mode 100644
index 0000000000..890b2def55
--- /dev/null
+++ b/rtl/freebsd/i386/x86h.inc
@@ -0,0 +1,31 @@
+{
+ $Id: x86h.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Headers for i386 specific functions on FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+{**************************
+ Port IO functions
+***************************}
+
+Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
+{$ifndef BSD}
+Function IoPL(Level : longint) : Boolean;
+{$endif}
+
+{
+ $Log: x86h.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/pthread.inc b/rtl/freebsd/pthread.inc
new file mode 100644
index 0000000000..acdfa43d98
--- /dev/null
+++ b/rtl/freebsd/pthread.inc
@@ -0,0 +1,91 @@
+{
+ $Id: pthread.inc,v 1.8 2005/04/09 20:28:04 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains a pthread.h headerconversion,
+ and should contain an interface to the threading library to be
+ used by systhrd, preferably in a somewhat compatible notation
+ (compared to the other OSes).
+
+ As a start, I simply used libc_r
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+CONST PTHREAD_EXPLICIT_SCHED = 0;
+ PTHREAD_CREATE_DETACHED = 1;
+ PTHREAD_SCOPE_PROCESS = 0;
+
+ TYPE
+ ppthread_t = ^pthread_t;
+ ppthread_key_t = ^pthread_key_t;
+ ppthread_mutex_t= ^pthread_mutex_t;
+ ppthread_attr_t = ^pthread_attr_t;
+ ppthread_cond_t = ^pthread_cond_t;
+ ppthread_condattr_t = ^pthread_condattr_t;
+
+ __destr_func_t = procedure (p :pointer);cdecl;
+ __startroutine_t= function (p :pointer):pointer;cdecl;
+ ppthread_mutexattr_t = ^pthread_mutexattr_t;
+ ppthread_mutex_attr_t = ^pthread_mutexattr_t;
+
+ sem_t = cint;
+ psem_t = ^sem_t;
+ TSemaphore = sem_t;
+ PSemaphore = ^TSemaphore;
+
+function pthread_getspecific (t : pthread_key_t):pointer; cdecl; external;
+function pthread_setspecific (t : pthread_key_t;p:pointer):cint; cdecl; external;
+function pthread_key_create (p : ppthread_key_t;f: __destr_func_t):cint; cdecl;external;
+function pthread_attr_init (p : ppthread_key_t):cint; cdecl; external;
+function pthread_attr_setinheritsched(p : ppthread_attr_t;i:cint):cint; cdecl; external;
+function pthread_attr_setscope (p : ppthread_attr_t;i:cint):cint;cdecl;external;
+function pthread_attr_setdetachstate (p : ppthread_attr_t;i:cint):cint;cdecl;external;
+function pthread_create ( p: ppthread_t;attr : ppthread_attr_t;f:__startroutine_t;arg:pointer):cint;cdecl;external;
+procedure pthread_exit ( p: pointer); cdecl;external;
+function pthread_self:cint; cdecl;external;
+function pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint; cdecl;external;
+function pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function pthread_mutex_lock (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function pthread_mutex_unlock (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function pthread_cancel(_para1:pthread_t):cint;cdecl;external;
+function pthread_detach(_para1:pthread_t):cint;cdecl;external;
+function pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external;
+function pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external;
+function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external;
+function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external;
+function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external;
+
+function sem_init(__sem:Psem_t; __pshared:cint;__value:dword):cint;cdecl; external;
+function sem_destroy(__sem:Psem_t):cint;cdecl;external ;
+function sem_close(__sem:Psem_t):cint;cdecl;external ;
+function sem_unlink(__name:Pchar):cint;cdecl;external ;
+function sem_wait(__sem:Psem_t):cint;cdecl;external ;
+function sem_trywait(__sem:Psem_t):cint;cdecl;external ;
+function sem_post(__sem:Psem_t):cint;cdecl;external ;
+function sem_getvalue(__sem:Psem_t; __sval:Pcint):cint;cdecl;external;
+function pthread_mutexattr_init(_para1:Ppthread_mutexattr_t):cint;cdecl;external;
+function pthread_mutexattr_destroy(_para1:Ppthread_mutexattr_t):cint;cdecl;external;
+function pthread_mutexattr_gettype(_para1:Ppthread_mutexattr_t; _para2:Pcint):cint;cdecl;external;
+function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cint;cdecl;external;
+function pthread_cond_timedwait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):longint;cdecl;external;
+
+
+
+{
+ $Log: pthread.inc,v $
+ Revision 1.8 2005/04/09 20:28:04 marco
+ * added condtimedwait
+
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/ptypes.inc b/rtl/freebsd/ptypes.inc
new file mode 100644
index 0000000000..5a2f5c1948
--- /dev/null
+++ b/rtl/freebsd/ptypes.inc
@@ -0,0 +1,209 @@
+{
+ $Id: ptypes.inc,v 1.17 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+{$I ctypes.inc}
+{$packrecords c}
+
+type
+
+ dev_t = cuint32; { used for device numbers }
+ TDev = dev_t;
+ pDev = ^dev_t;
+
+ gid_t = cuint32; { used for group IDs }
+ TGid = gid_t;
+ pGid = ^gid_t;
+
+ ino_t = clong; { used for file serial numbers }
+ TIno = ino_t;
+ pIno = ^ino_t;
+
+ mode_t = cuint16; { used for file attributes }
+ TMode = mode_t;
+ pMode = ^mode_t;
+
+ nlink_t = cuint16; { used for link counts }
+ TnLink = nlink_t;
+ pnLink = ^nlink_t;
+
+ off_t = cint64; { used for file sizes }
+ TOff = off_t;
+ pOff = ^off_t;
+
+ pid_t = cint32; { used as process identifier }
+ TPid = pid_t;
+ pPid = ^pid_t;
+
+{$ifdef CPU64}
+ size_t = cuint64;
+{$else}
+ size_t = cuint32; { as definied in the C standard}
+{$endif}
+ TSize = size_t;
+ pSize = ^size_t;
+
+{$ifdef CPU64}
+ ssize_t = cint64; { used by function for returning number of bytes }
+{$else}
+ ssize_t = cint32; { used by function for returning number of bytes}
+{$endif}
+ TsSize = ssize_t;
+ psSize = ^ssize_t;
+
+ uid_t = cuint32; { used for user ID type }
+ TUid = Uid_t;
+ pUid = ^Uid_t;
+
+{$ifdef CPU64}
+ clock_t = cuint32; // 32-bit even on Athlon64
+{$else}
+ clock_t = culong;
+{$endif}
+ TClock = clock_t;
+ pClock = ^clock_t;
+
+ time_t = clong; { used for returning the time, clong
+ is 64-bit on AMD64}
+ TTime = time_t;
+ pTime = ^time_t;
+ ptime_t = ^time_t;
+
+ socklen_t= cuint32;
+ TSocklen = socklen_t;
+ pSocklen = ^socklen_t;
+
+ timeval = packed record
+ tv_sec,tv_usec:clong;
+ end;
+ ptimeval = ^timeval;
+ TTimeVal = timeval;
+
+ timespec = packed record
+ tv_sec : time_t; // should be time_t, bug compability
+ tv_nsec : clong;
+ end;
+ ptimespec= ^timespec;
+ Ttimespec= timespec;
+
+ pthread_t = pointer;
+ pthread_attr_t = pointer;
+ pthread_mutex_t = pointer;
+ pthread_mutexattr_t = pointer;
+ pthread_cond_t = pointer;
+ pthread_condattr_t = pointer;
+ pthread_key_t = cint;
+ pthread_rwlock_t = pointer;
+ pthread_rwlockattr_t = pointer;
+
+ sem_t = pointer;
+
+ {
+ Mutex types (Single UNIX Specification, Version 2, 1997).
+
+ Note that a mutex attribute with one of the following types:
+
+ PTHREAD_MUTEX_NORMAL
+ PTHREAD_MUTEX_RECURSIVE
+ MUTEX_TYPE_FAST (deprecated)
+ MUTEX_TYPE_COUNTING_FAST (deprecated)
+
+ will deviate from POSIX specified semantics.
+ }
+
+ pthread_mutextype = (
+ { Default POSIX mutex }
+ _PTHREAD_MUTEX_ERRORCHECK := 1,
+ { Recursive mutex }
+ _PTHREAD_MUTEX_RECURSIVE := 2,
+ { No error checking }
+ _PTHREAD_MUTEX_NORMAL := 3,
+ _MUTEX_TYPE_MAX
+ );
+
+
+Const
+ MNAMLEN = 80; // slightly machine specific.
+
+type
+
+ TStatfs = packed record
+ spare2, { place holder}
+ bsize, { fundamental block size}
+ iosize, { optimal block size }
+ blocks, { total blocks}
+ bfree, { blocks free}
+ bavail, { block available for mortal users}
+ files, { Total file nodes}
+ ffree : clong ; { file nodes free}
+ fsid : array[0..1] of longint; // fsid_t
+ fowner : tuid; {mounter uid}
+ ftype : cint;
+ fflags : cint; {copy of mount flags}
+ fsyncwrites,
+ fasyncwrites : cint;
+ fstypename : array[0..15] of char;
+ mountpoint : array[0..MNAMLEN-1] of char;
+ fsyncreads, { count of sync reads since mount }
+ fasyncreads : clong;
+ fspares1 : cshort;
+ mnfromname : array[0..MNAMLEN-1] of char;
+ fspares2 : cshort;
+ fspare3 : array[0..1] of clong;
+ end;
+ PStatFS=^TStatFS;
+
+ ITimerVal= Record
+ It_Interval,
+ It_Value : TimeVal;
+ end;
+
+
+const
+ _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_ERRORCHECK;
+ _MUTEX_TYPE_FAST = _PTHREAD_MUTEX_NORMAL;
+ _MUTEX_TYPE_COUNTING_FAST = _PTHREAD_MUTEX_RECURSIVE;
+
+ _PTHREAD_KEYS_MAX = 256;
+ _PTHREAD_STACK_MIN = 1024;
+
+ { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+ ARG_MAX = 65536; {4096} { Maximum number of argument size }
+ NAME_MAX = 255; {14} { Maximum number of bytes in filename }
+ PATH_MAX = 1024; {255} { Maximum number of bytes in pathname }
+
+ SYS_NMLN = 32; {BSD utsname struct limit, kernel mode}
+
+ SIG_MAXSIG = 128; // highest signal version
+// wordsinsigset = 4; // words in sigset_t
+
+
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+{
+ $Log: ptypes.inc,v $
+ Revision 1.17 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/signal.inc b/rtl/freebsd/signal.inc
new file mode 100644
index 0000000000..17fcf43142
--- /dev/null
+++ b/rtl/freebsd/signal.inc
@@ -0,0 +1,207 @@
+{
+ $Id: signal.inc,v 1.11 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+Const { For sending a signal }
+
+ SA_NOCLDSTOP = 8;
+ SA_ONSTACK = $001; { take signal on signal stack }
+ SA_RESTART = $002; { restart system call on signal return }
+ SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
+ SA_NODEFER = $010; { don't mask the signal we're delivering }
+ SA_NOCLDWAIT = $020; { don't keep zombies around }
+ SA_SIGINFO = $040; { signal handler with SA_SIGINFO args }
+ SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
+
+ SIG_BLOCK = 1;
+ SIG_UNBLOCK = 2;
+ SIG_SETMASK = 3;
+
+{BSD Checked}
+ SIG_DFL = 0 ;
+ SIG_IGN = 1 ;
+ SIG_ERR = -1 ;
+
+ SIGHUP = 1;
+ SIGINT = 2;
+ SIGQUIT = 3;
+ SIGILL = 4;
+ SIGTRAP = 5;
+ SIGABRT = 6;
+ SIGIOT = 6;
+ SIGEMT = 7;
+ SIGFPE = 8;
+ SIGKILL = 9;
+ SIGBUS = 10;
+ SIGSEGV = 11;
+ SIGSYS = 12;
+ SIGPIPE = 13;
+ SIGALRM = 14;
+ SIGTERM = 15;
+ SIGURG = 16;
+ SIGSTOP = 17;
+ SIGTSTP = 18;
+ SIGCONT = 19;
+ SIGCHLD = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGIO = 23;
+ SIGXCPU = 24;
+ SIGXFSZ = 25;
+ SIGVTALRM = 26;
+ SIGPROF = 27;
+ SIGWINCH = 28;
+ SIGINFO = 29;
+ SIGUSR1 = 30;
+ SIGUSR2 = 31;
+
+
+{$packrecords C}
+const
+ SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
+
+{
+ * The sequence of the fields/registers in struct sigcontext should match
+ * those in mcontext_t.
+ }
+
+type sigset_t = array[0..3] of Longint;
+
+ PSigContextRec = ^SigContextRec;
+ SigContextRec = record
+ sc_mask : sigset_t; { signal mask to restore }
+ sc_onstack : longint; { sigstack state to restore }
+
+ sc_gs : longint; { machine state (struct trapframe): }
+ sc_fs : longint;
+ sc_es : longint;
+ sc_ds : longint;
+ sc_edi : longint;
+ sc_esi : longint;
+ sc_ebp : longint;
+ sc_isp : longint;
+ sc_ebx : longint;
+ sc_edx : longint;
+ sc_ecx : longint;
+ sc_eax : longint;
+ sc_trapno : longint;
+ sc_err : longint;
+ sc_eip : longint;
+ sc_cs : longint;
+ sc_efl : longint;
+ sc_esp : longint;
+ sc_ss : longint;
+ {
+ * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
+ * needed here), or that + 16 * 4 bytes for emulators (probably all
+ * needed here). The "spare" bytes are mostly not spare.
+ }
+ en_cw : cardinal; { control word (16bits used) }
+ en_sw : cardinal; { status word (16bits) }
+ en_tw : cardinal; { tag word (16bits) }
+ en_fip : cardinal; { floating point instruction pointer }
+ en_fcs : word; { floating code segment selector }
+ en_opcode : word; { opcode last executed (11 bits ) }
+ en_foo : cardinal; { floating operand offset }
+ en_fos : cardinal; { floating operand segment selector }
+ fpr_acc : array[0..79] of char;
+ fpr_ex_sw : cardinal;
+ fpr_pad : array[0..63] of char;
+ end;
+
+
+
+ Sigval = Record
+ Case Boolean OF
+ { Members as suggested by Annex C of POSIX 1003.1b. }
+ false : (sigval_int : Longint);
+ True : (sigval_ptr : Pointer);
+ End;
+
+
+ TSigInfo_t = record
+ si_signo, { signal number }
+ si_errno, { errno association }
+ {
+ * Cause of signal, one of the SI_ macros or signal-specific
+ * values, i.e. one of the FPE_... values for SIGFPE. This
+ * value is equivalent to the second argument to an old-style
+ * FreeBSD signal handler.
+ }
+ si_code, { signal code }
+ si_pid : Longint; { sending process }
+ si_uid : Cardinal; { sender's ruid }
+ si_status : Longint; { exit value }
+ si_addr : Pointer; { faulting instruction }
+ si_value : SigVal; { signal value }
+ si_band : Cardinal; { band event for SIGPOLL }
+ __spare : array[0..6] of Longint; { gimme some slack
+}
+ end;
+
+
+
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ TSignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+ sigActionHandler = procedure(Sig: Longint; var sininfo:tsiginfo_t;var SigContext: SigContextRec);cdecl;
+
+ TSigset=sigset_t;
+ sigset=tsigset;
+ PSigSet = ^TSigSet;
+
+ SigActionRec = packed record
+{ Handler : record
+ case byte of
+ 0: (Sh: SignalHandler);
+ 1: (Sa: TSigAction);
+ end;}
+ sa_handler : sigActionHandler;
+ Sa_Flags : Longint;
+ Sa_Mask : TSigSet;
+ end;
+ PSigActionRec = ^SigActionRec;
+
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+const
+ FPE_INTOVF =1; { integer overflow }
+ FPE_INTDIV =2; { integer divide by zero }
+ FPE_FLTDIV =3; { floating point divide by zero }
+ FPE_FLTOVF =4; { floating point overflow }
+ FPE_FLTUND =5; { floating point underflow }
+ FPE_FLTRES =6; { floating point inexact result }
+ FPE_FLTINV =7; { invalid floating point operation }
+ FPE_FLTSUB =8; { subscript out of range }
+
+
+
+{
+ $Log: signal.inc,v $
+ Revision 1.11 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.10 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/freebsd/sysctlh.inc b/rtl/freebsd/sysctlh.inc
new file mode 100644
index 0000000000..477c98080d
--- /dev/null
+++ b/rtl/freebsd/sysctlh.inc
@@ -0,0 +1,886 @@
+{
+ $Id: sysctlh.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Marco van de Voort
+
+ The OS dependant sysctl constants.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+CONST
+
+{
+ * Definitions for sysctl call. The sysctl call uses a hierarchical name
+ * for objects that can be examined or modified. The name is expressed as
+ * a sequence of integers. Like a file path name, the meaning of each
+ * component depends on its place in the hierarchy. The top-level and kern
+ * identifiers are defined here, and other identifiers are defined in the
+ * respective subsystem header files.
+}
+
+ CTL_MAXNAME = 12; { largest number of components supported }
+
+{
+ * Each subsystem defined by sysctl defines a list of variables
+ * for that subsystem. Each name is either a node with further
+ * levels defined below it, or it is a leaf of some particular
+ * type given below. Each sysctl level defines a set of name/type
+ * pairs to be used by sysctl(1) in manipulating the subsystem.
+}
+
+Type
+ ctlname = record
+ ctl_name : pchar; { subsystem name }
+ ctl_type : cint { type of name }
+ End;
+
+Const
+ CTLTYPE = $f; { Mask for the type }
+ CTLTYPE_NODE = 1; { name is a node }
+ CTLTYPE_INT = 2; { name describes an integer }
+ CTLTYPE_STRING = 3; { name describes a string }
+ CTLTYPE_QUAD = 4; { name describes a 64-bit number }
+ CTLTYPE_OPAQUE = 5; { name describes a structure }
+ CTLTYPE_STRUCT = CTLTYPE_OPAQUE; { name describes a structure }
+ CTLTYPE_UINT = 6; { name describes an unsigned integer }
+ CTLTYPE_LONG = 7; { name describes a long }
+ CTLTYPE_ULONG = 8; { name describes an unsigned long }
+
+ CTLFLAG_RD = $80000000; { Allow reads of variable }
+ CTLFLAG_WR = $40000000; { Allow writes to the variable }
+ CTLFLAG_RW = (CTLFLAG_RD OR CTLFLAG_WR);
+ CTLFLAG_NOLOCK = $20000000; { XXX Don't Lock }
+ CTLFLAG_ANYBODY = $10000000; { All users can set this var }
+ CTLFLAG_SECURE = $8000000; { Permit set only if securelevel<=0 }
+ CTLFLAG_PRISON = $4000000; { Prisoned roots can fiddle }
+ CTLFLAG_DYN = $2000000; { Dynamic oid - can be freed }
+
+{
+ * USE THIS instead of a hardwired number from the categories below
+ * to get dynamically assigned sysctl entries using the linker-set
+ * technology. This is the way nearly all new sysctl variables should
+ * be implemented.
+ * e.g. SYSCTL_INT(_parent, OID_AUTO, name, CTLFLAG_RW, &variable, 0, "");
+ }
+ OID_AUTO = (-1);
+
+{
+ * Top-level identifiers
+ }
+ CTL_UNSPEC = 0;
+ CTL_KERN = 1; { "high kernel": proc, limits }
+ CTL_VM = 2; { virtual memory }
+ CTL_VFS = 3; { file system, mount type is next }
+ CTL_NET = 4; { network, see socket.h }
+ CTL_DEBUG = 5; { debugging parameters }
+ CTL_HW = 6; { generic cpu/io }
+ CTL_MACHDEP = 7; { machine dependent }
+ CTL_USER = 8; { user-level }
+ CTL_P1003_1B = 9; { POSIX 1003.1B }
+ CTL_MAXID = 10; { number of valid top-level ids }
+
+
+{
+ * CTL_KERN identifiers
+ }
+ KERN_OSTYPE = 1; { string: system version }
+ KERN_OSRELEASE = 2; { string: system release }
+ KERN_OSREV = 3; { int: system revision }
+ KERN_VERSION = 4; { string: compile time info }
+ KERN_MAXVNODES = 5; { int: max vnodes }
+ KERN_MAXPROC = 6; { int: max processes }
+ KERN_MAXFILES = 7; { int: max open files }
+ KERN_ARGMAX = 8; { int: max arguments to exec }
+ KERN_SECURELVL = 9; { int: system security level }
+ KERN_HOSTNAME = 10; { string: hostname }
+ KERN_HOSTID = 11; { int: host identifier }
+ KERN_CLOCKRATE = 12; { struct: struct clockrate }
+ KERN_VNODE = 13; { struct: vnode structures }
+ KERN_PROC = 14; { struct: process entries }
+ KERN_FILE = 15; { struct: file entries }
+ KERN_PROF = 16; { node: kernel profiling info }
+ KERN_POSIX1 = 17; { int: POSIX.1 version }
+ KERN_NGROUPS = 18; { int: # of supplemental group ids }
+ KERN_JOB_CONTROL = 19; { int: is job control available }
+ KERN_SAVED_IDS = 20; { int: saved set-user/group-ID }
+ KERN_BOOTTIME = 21; { struct: time kernel was booted }
+ KERN_NISDOMAINNAME = 22; { string: YP domain name }
+ KERN_UPDATEINTERVAL = 23; { int: update process sleep time }
+ KERN_OSRELDATE = 24; { int: OS release date }
+ KERN_NTP_PLL = 25; { node: NTP PLL control }
+ KERN_BOOTFILE = 26; { string: name of booted kernel }
+ KERN_MAXFILESPERPROC = 27; { int: max open files per proc }
+ KERN_MAXPROCPERUID = 28; { int: max processes per uid }
+ KERN_DUMPDEV = 29; { dev_t: device to dump on }
+ KERN_IPC = 30; { node: anything related to IPC }
+ KERN_DUMMY = 31; { unused }
+ KERN_PS_STRINGS = 32; { int: address of PS_STRINGS }
+ KERN_USRSTACK = 33; { int: address of USRSTACK }
+ KERN_LOGSIGEXIT = 34; { int: do we log sigexit procs? }
+ KERN_MAXID = 35; { number of valid kern ids }
+
+
+
+{
+ * KERN_PROC subtypes
+ }
+ KERN_PROC_ALL = 0; { everything }
+ KERN_PROC_PID = 1; { by process id }
+ KERN_PROC_PGRP = 2; { by process group id }
+ KERN_PROC_SESSION = 3; { by session of pid }
+ KERN_PROC_TTY = 4; { by controlling tty }
+ KERN_PROC_UID = 5; { by effective uid }
+ KERN_PROC_RUID = 6; { by real uid }
+ KERN_PROC_ARGS = 7; { get/set arguments/proctitle }
+
+{
+ * KERN_IPC identifiers
+ }
+ KIPC_MAXSOCKBUF = 1; { int: max size of a socket buffer }
+ KIPC_SOCKBUF_WASTE = 2; { int: wastage factor in sockbuf }
+ KIPC_SOMAXCONN = 3; { int: max length of connection q }
+ KIPC_MAX_LINKHDR = 4; { int: max length of link header }
+ KIPC_MAX_PROTOHDR = 5; { int: max length of network header }
+ KIPC_MAX_HDR = 6; { int: max total length of headers }
+ KIPC_MAX_DATALEN = 7; { int: max length of data? }
+ KIPC_MBSTAT = 8; { struct: mbuf usage statistics }
+ KIPC_NMBCLUSTERS = 9; { int: maximum mbuf clusters }
+
+{
+ * CTL_HW identifiers
+ }
+ HW_MACHINE = 1; { string: machine class }
+ HW_MODEL = 2; { string: specific machine model }
+ HW_NCPU = 3; { int: number of cpus }
+ HW_BYTEORDER = 4; { int: machine byte order }
+ HW_PHYSMEM = 5; { int: total memory }
+ HW_USERMEM = 6; { int: non-kernel memory }
+ HW_PAGESIZE = 7; { int: software page size }
+ HW_DISKNAMES = 8; { strings: disk drive names }
+ HW_DISKSTATS = 9; { struct: diskstats[] }
+ HW_FLOATINGPT = 10; { int: has HW floating point? }
+ HW_MACHINE_ARCH = 11; { string: machine architecture }
+ HW_MAXID = 12; { number of valid hw ids }
+
+
+{
+ * CTL_USER definitions
+ }
+ USER_CS_PATH = 1; { string: _CS_PATH }
+ USER_BC_BASE_MAX = 2; { int: BC_BASE_MAX }
+ USER_BC_DIM_MAX = 3; { int: BC_DIM_MAX }
+ USER_BC_SCALE_MAX = 4; { int: BC_SCALE_MAX }
+ USER_BC_STRING_MAX = 5; { int: BC_STRING_MAX }
+ USER_COLL_WEIGHTS_MAX = 6; { int: COLL_WEIGHTS_MAX }
+ USER_EXPR_NEST_MAX = 7; { int: EXPR_NEST_MAX }
+ USER_LINE_MAX = 8; { int: LINE_MAX }
+ USER_RE_DUP_MAX = 9; { int: RE_DUP_MAX }
+ USER_POSIX2_VERSION = 10; { int: POSIX2_VERSION }
+ USER_POSIX2_C_BIND = 11; { int: POSIX2_C_BIND }
+ USER_POSIX2_C_DEV = 12; { int: POSIX2_C_DEV }
+ USER_POSIX2_CHAR_TERM = 13; { int: POSIX2_CHAR_TERM }
+ USER_POSIX2_FORT_DEV = 14; { int: POSIX2_FORT_DEV }
+ USER_POSIX2_FORT_RUN = 15; { int: POSIX2_FORT_RUN }
+ USER_POSIX2_LOCALEDEF = 16; { int: POSIX2_LOCALEDEF }
+ USER_POSIX2_SW_DEV = 17; { int: POSIX2_SW_DEV }
+ USER_POSIX2_UPE = 18; { int: POSIX2_UPE }
+ USER_STREAM_MAX = 19; { int: POSIX2_STREAM_MAX }
+ USER_TZNAME_MAX = 20; { int: POSIX2_TZNAME_MAX }
+ USER_MAXID = 21; { number of valid user ids }
+
+
+ CTL_P1003_1B_ASYNCHRONOUS_IO = 1 ; { boolean }
+ CTL_P1003_1B_MAPPED_FILES = 2 ; { boolean }
+ CTL_P1003_1B_MEMLOCK = 3 ; { boolean }
+ CTL_P1003_1B_MEMLOCK_RANGE = 4 ; { boolean }
+ CTL_P1003_1B_MEMORY_PROTECTION = 5 ; { boolean }
+ CTL_P1003_1B_MESSAGE_PASSING = 6 ; { boolean }
+ CTL_P1003_1B_PRIORITIZED_IO = 7 ; { boolean }
+ CTL_P1003_1B_PRIORITY_SCHEDULING = 8 ; { boolean }
+ CTL_P1003_1B_REALTIME_SIGNALS = 9 ; { boolean }
+ CTL_P1003_1B_SEMAPHORES = 10; { boolean }
+ CTL_P1003_1B_FSYNC = 11; { boolean }
+ CTL_P1003_1B_SHARED_MEMORY_OBJECTS = 12; { boolean }
+ CTL_P1003_1B_SYNCHRONIZED_IO = 13; { boolean }
+ CTL_P1003_1B_TIMERS = 14; { boolean }
+ CTL_P1003_1B_AIO_LISTIO_MAX = 15; { int }
+ CTL_P1003_1B_AIO_MAX = 16; { int }
+ CTL_P1003_1B_AIO_PRIO_DELTA_MAX = 17; { int }
+ CTL_P1003_1B_DELAYTIMER_MAX = 18; { int }
+ CTL_P1003_1B_MQ_OPEN_MAX = 19; { int }
+ CTL_P1003_1B_PAGESIZE = 20; { int }
+ CTL_P1003_1B_RTSIG_MAX = 21; { int }
+ CTL_P1003_1B_SEM_NSEMS_MAX = 22; { int }
+ CTL_P1003_1B_SEM_VALUE_MAX = 23; { int }
+ CTL_P1003_1B_SIGQUEUE_MAX = 24; { int }
+ CTL_P1003_1B_TIMER_MAX = 25; { int }
+
+ CTL_P1003_1B_MAXID = 26;
+
+{ LongestStringInCtlNames = 21;}
+
+
+Const
+
+ CTL_NAMES : Array[0..9] OF CtlNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'kern'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'vm'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'vfs'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'net'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'debug'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'hw'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'machdep'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'user'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'p1003_1b'; CtlType : CTLTYPE_NODE ));
+
+ CTL_KERN_NAME : Array[0..34] OF CtlNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'ostype'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'osrelease'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'osrevision'; CtlType : CTLTYPE_INT ),
+ ( Name: 'version'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'maxvnodes'; CtlType : CTLTYPE_INT ),
+ ( Name: 'maxproc'; CtlType : CTLTYPE_INT ),
+ ( Name: 'maxfiles'; CtlType : CTLTYPE_INT ),
+ ( Name: 'argmax'; CtlType : CTLTYPE_INT ),
+ ( Name: 'securelevel'; CtlType : CTLTYPE_INT ),
+ ( Name: 'hostname'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'hostid'; CtlType : CTLTYPE_UINT ),
+ ( Name: 'clockrate'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'vnode'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'proc'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'file'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'profiling'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'posix1version'; CtlType : CTLTYPE_INT ),
+ ( Name: 'ngroups'; CtlType : CTLTYPE_INT ),
+ ( Name: 'job_control'; CtlType : CTLTYPE_INT ),
+ ( Name: 'saved_ids'; CtlType : CTLTYPE_INT ),
+ ( Name: 'boottime'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'nisdomainname'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'update'; CtlType : CTLTYPE_INT ),
+ ( Name: 'osreldate'; CtlType : CTLTYPE_INT ),
+ ( Name: 'ntp_pll'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'bootfile'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'maxfilesperproc'; CtlType : CTLTYPE_INT ),
+ ( Name: 'maxprocperuid'; CtlType : CTLTYPE_INT ),
+ ( Name: 'dumpdev'; CtlType : CTLTYPE_STRUCT ), { we lie; don't print as int }
+ ( Name: 'ipc'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'dummy'; CtlType : CTLTYPE_INT ),
+ ( Name: 'ps_strings'; CtlType : CTLTYPE_INT ),
+ ( Name: 'usrstack'; CtlType : CTLTYPE_INT ),
+ ( Name: 'logsigexit'; CtlType : CTLTYPE_INT ));
+
+{
+ * CTL_VFS identifiers
+}
+ CTL_VFS_NAMES : array[0..0] of CTLNameRec = (
+ ( Name: 'vfsconf'; CtlType : CTLTYPE_STRUCT ));
+
+
+ CTL_HW_NAMES : array[0..10] of CTLNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'machine'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'model'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'ncpu'; CtlType : CTLTYPE_INT ),
+ ( Name: 'byteorder'; CtlType : CTLTYPE_INT ),
+ ( Name: 'physmem'; CtlType : CTLTYPE_UINT ),
+ ( Name: 'usermem'; CtlType : CTLTYPE_UINT ),
+ ( Name: 'pagesize'; CtlType : CTLTYPE_INT ),
+ ( Name: 'disknames'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'diskstats'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'floatingpoint'; CtlType : CTLTYPE_INT ));
+
+
+ CTL_USER_NAMES : array[0..20] of CTLNameRec = (
+ ( Name :''; CtlType: 0 ),
+ ( Name: 'cs_path'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'bc_base_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'bc_dim_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'bc_scale_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'bc_string_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'coll_weights_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'expr_nest_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'line_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 're_dup_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_version'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_c_bind'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_c_dev'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_char_term'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_fort_dev'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_fort_run'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_localedef'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_sw_dev'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_upe'; CtlType : CTLTYPE_INT ),
+ ( Name: 'stream_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'tzname_max'; CtlType : CTLTYPE_INT ));
+
+ CTL_P1003_1B_NAMES : array[0..25] of CTLNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'asynchronous_io'; CtlType : CTLTYPE_INT ),
+ ( Name: 'mapped_files'; CtlType : CTLTYPE_INT ),
+ ( Name: 'memlock'; CtlType : CTLTYPE_INT ),
+ ( Name: 'memlock_range'; CtlType : CTLTYPE_INT ),
+ ( Name: 'memory_protection'; CtlType : CTLTYPE_INT ),
+ ( Name: 'message_passing'; CtlType : CTLTYPE_INT ),
+ ( Name: 'prioritized_io'; CtlType : CTLTYPE_INT ),
+ ( Name: 'priority_scheduling'; CtlType : CTLTYPE_INT ),
+ ( Name: 'realtime_signals'; CtlType : CTLTYPE_INT ),
+ ( Name: 'semaphores'; CtlType : CTLTYPE_INT ),
+ ( Name: 'fsync'; CtlType : CTLTYPE_INT ),
+ ( Name: 'shared_memory_objects'; CtlType : CTLTYPE_INT ),
+ ( Name: 'synchronized_io'; CtlType : CTLTYPE_INT ),
+ ( Name: 'timers'; CtlType : CTLTYPE_INT ),
+ ( Name: 'aio_listio_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'aio_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'aio_prio_delta_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'delaytimer_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'mq_open_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'pagesize'; CtlType : CTLTYPE_INT ),
+ ( Name: 'rtsig_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'nsems_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'sem_value_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'sigqueue_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'timer_max'; CtlType : CTLTYPE_INT ));
+
+
+const
+{
+ * Types
+}
+ SOCK_STREAM = 1; { stream socket }
+ SOCK_DGRAM = 2; { datagram socket }
+ SOCK_RAW = 3; { raw-protocol interface }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequenced packet stream }
+
+{
+ * Address families.
+}
+ AF_UNSPEC = 0; { unspecified }
+ AF_LOCAL = 1; { local to host (Name:pipes;CtlType: portals) }
+ AF_UNIX = AF_LOCAL; { backward compatibility }
+ AF_INET = 2; { internetwork: UDP, TCP, etc. }
+ AF_IMPLINK = 3; { arpanet imp addresses }
+ AF_PUP = 4; { pup protocols: e.g. BSP }
+ AF_CHAOS = 5; { mit CHAOS protocols }
+ AF_NS = 6; { XEROX NS protocols }
+ AF_ISO = 7; { ISO protocols }
+ AF_OSI = AF_ISO;
+ AF_ECMA = 8; { European computer manufacturers }
+ AF_DATAKIT = 9; { datakit protocols }
+ AF_CCITT = 10; { CCITT protocols, X.25 etc }
+ AF_SNA = 11; { IBM SNA }
+ AF_DECnet = 12; { DECnet }
+ AF_DLI = 13; { DEC Direct data link interface }
+ AF_LAT = 14; { LAT }
+ AF_HYLINK = 15; { NSC Hyperchannel }
+ AF_APPLETALK = 16; { Apple Talk }
+ AF_ROUTE = 17; { Internal Routing Protocol }
+ AF_LINK = 18; { Link layer interface }
+ pseudo_AF_XTP = 19; { eXpress Transfer Protocol (Name:no AF) }
+ AF_COIP = 20; { connection-oriented IP, aka ST II }
+ AF_CNT = 21; { Computer Network Technology }
+ pseudo_AF_RTIP = 22; { Help Identify RTIP packets }
+ AF_IPX = 23; { Novell Internet Protocol }
+ AF_SIP = 24; { Simple Internet Protocol }
+ pseudo_AF_PIP = 25; { Help Identify PIP packets }
+ AF_ISDN = 26; { Integrated Services Digital Network}
+ AF_E164 = AF_ISDN; { CCITT E.164 recommendation }
+ pseudo_AF_KEY = 27; { Internal key-management function }
+ AF_INET6 = 28; { IPv6 }
+ AF_NATM = 29; { native ATM access }
+ AF_ATM = 30; { ATM }
+ pseudo_AF_HDRCMPLT = 31; { Used by BPF to not rewrite headers
+ * in interface output routine
+ }
+ AF_NETGRAPH = 32; { Netgraph sockets }
+
+ AF_MAX = 33;
+
+{
+ * Protocol families, same as address families for now.
+}
+
+{
+ * Definitions for network related sysctl, CTL_NET.
+ *
+ * Second level is protocol family.
+ * Third level is protocol number.
+ *
+ * Further levels are defined by the individual families below.
+}
+ NET_MAXID = AF_MAX;
+
+ CTL_NET_NAMES : Array[0..32] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'unix';CtlType: CTLTYPE_NODE ),
+ (Name: 'inet';CtlType: CTLTYPE_NODE ),
+ (Name: 'implink';CtlType: CTLTYPE_NODE ),
+ (Name: 'pup';CtlType: CTLTYPE_NODE ),
+ (Name: 'chaos';CtlType: CTLTYPE_NODE ),
+ (Name: 'xerox_ns';CtlType: CTLTYPE_NODE ),
+ (Name: 'iso';CtlType: CTLTYPE_NODE ),
+ (Name: 'emca';CtlType: CTLTYPE_NODE ),
+ (Name: 'datakit';CtlType: CTLTYPE_NODE ),
+ (Name: 'ccitt';CtlType: CTLTYPE_NODE ),
+ (Name: 'ibm_sna';CtlType: CTLTYPE_NODE ),
+ (Name: 'decnet';CtlType: CTLTYPE_NODE ),
+ (Name: 'dec_dli';CtlType: CTLTYPE_NODE ),
+ (Name: 'lat';CtlType: CTLTYPE_NODE ),
+ (Name: 'hylink';CtlType: CTLTYPE_NODE ),
+ (Name: 'appletalk';CtlType: CTLTYPE_NODE ),
+ (Name: 'route';CtlType: CTLTYPE_NODE ),
+ (Name: 'link_layer';CtlType: CTLTYPE_NODE ),
+ (Name: 'xtp';CtlType: CTLTYPE_NODE ),
+ (Name: 'coip';CtlType: CTLTYPE_NODE ),
+ (Name: 'cnt';CtlType: CTLTYPE_NODE ),
+ (Name: 'rtip';CtlType: CTLTYPE_NODE ),
+ (Name: 'ipx';CtlType: CTLTYPE_NODE ),
+ (Name: 'sip';CtlType: CTLTYPE_NODE ),
+ (Name: 'pip';CtlType: CTLTYPE_NODE ),
+ (Name: 'isdn';CtlType: CTLTYPE_NODE ),
+ (Name: 'key';CtlType: CTLTYPE_NODE ),
+ (Name: 'inet6';CtlType: CTLTYPE_NODE ),
+ (Name: 'natm';CtlType: CTLTYPE_NODE ),
+ (Name: 'atm';CtlType: CTLTYPE_NODE ),
+ (Name: 'hdrcomplete';CtlType: CTLTYPE_NODE ),
+ (Name: 'netgraph';CtlType: CTLTYPE_NODE ));
+
+{
+ * PF_ROUTE - Routing table
+ *
+ * Three additional levels are defined:
+ * Fourth: address family, 0 is wildcard
+ * Fifth: type of info, defined below
+ * Sixth: flag(Name:s) to mask with for NET_RT_FLAGS
+}
+ NET_RT_DUMP = 1; { dump; may limit to a.f. }
+ NET_RT_FLAGS = 2; { by flags, e.g. RESOLVING }
+ NET_RT_IFLIST = 3; { survey interface list }
+ NET_RT_MAXID = 4;
+
+ CTL_NET_RT_NAMES : Array[0..3] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'dump';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'flags';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'iflist';CtlType: CTLTYPE_STRUCT ));
+
+{
+ * Possible states of profiling.
+}
+ GMON_PROF_ON = 0;
+ GMON_PROF_BUSY = 1;
+ GMON_PROF_ERROR = 2;
+ GMON_PROF_OFF = 3;
+ GMON_PROF_HIRES = 4;
+
+{
+ * Sysctl definitions for extracting profiling information from the kernel.
+}
+ GPROF_STATE = 0; { int: profiling enabling variable }
+ GPROF_COUNT = 1; { struct: profile tick count buffer }
+ GPROF_FROMS = 2; { struct: from location hash bucket }
+ GPROF_TOS = 3; { struct: destination/count structure }
+ GPROF_GMONPARAM = 4; { struct: profiling parameters (Name:see above) }
+
+{
+ * CTL_VM identifiers
+}
+ VM_METER = 1; { struct vmmeter }
+ VM_LOADAVG = 2; { struct loadavg }
+ VM_V_FREE_MIN = 3; { cnt.v_free_min }
+ VM_V_FREE_TARGET = 4; { cnt.v_free_target }
+ VM_V_FREE_RESERVED = 5; { cnt.v_free_reserved }
+ VM_V_INACTIVE_TARGET = 6; { cnt.v_inactive_target }
+ VM_V_CACHE_MIN = 7; { cnt.v_cache_max }
+ VM_V_CACHE_MAX = 8; { cnt.v_cache_min }
+ VM_V_PAGEOUT_FREE_MIN = 9; { cnt.v_pageout_free_min }
+ VM_PAGEOUT_ALGORITHM = 10; { pageout algorithm }
+ VM_SWAPPING_ENABLED = 11; { swapping enabled }
+ VM_MAXID = 12; { number of valid vm ids }
+
+ CTL_VM_NAMES : Array[0..11] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'vmmeter';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'loadavg';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'v_free_min';CtlType: CTLTYPE_INT ),
+ (Name: 'v_free_target';CtlType: CTLTYPE_INT ),
+ (Name: 'v_free_reserved';CtlType: CTLTYPE_INT ),
+ (Name: 'v_inactive_target';CtlType: CTLTYPE_INT ),
+ (Name: 'v_cache_min';CtlType: CTLTYPE_INT ),
+ (Name: 'v_cache_max';CtlType: CTLTYPE_INT ),
+ (Name: 'v_pageout_free_min';CtlType: CTLTYPE_INT),
+ (Name: 'pageout_algorithm';CtlType: CTLTYPE_INT),
+ (Name: 'swapping_enabled';CtlType: CTLTYPE_INT));
+
+{
+ * Protocols (Name:RFC 1700)
+}
+ IPPROTO_IP = 0; { dummy for IP }
+ IPPROTO_HOPOPTS = 0; { IP6 hop-by-hop options }
+ IPPROTO_ICMP = 1; { control message protocol }
+ IPPROTO_IGMP = 2; { group mgmt protocol }
+ IPPROTO_GGP = 3; { gateway^2 (Name:deprecated) }
+ IPPROTO_IPV4 = 4; { IPv4 encapsulation }
+ IPPROTO_IPIP = IPPROTO_IPV4; { for compatibility }
+ IPPROTO_TCP = 6; { tcp }
+ IPPROTO_ST = 7; { Stream protocol II }
+ IPPROTO_EGP = 8; { exterior gateway protocol }
+ IPPROTO_PIGP = 9; { private interior gateway }
+ IPPROTO_RCCMON = 10; { BBN RCC Monitoring }
+ IPPROTO_NVPII = 11; { network voice protocol}
+ IPPROTO_PUP = 12; { pup }
+ IPPROTO_ARGUS = 13; { Argus }
+ IPPROTO_EMCON = 14; { EMCON }
+ IPPROTO_XNET = 15; { Cross Net Debugger }
+ IPPROTO_CHAOS = 16; { Chaos}
+ IPPROTO_UDP = 17; { user datagram protocol }
+ IPPROTO_MUX = 18; { Multiplexing }
+ IPPROTO_MEAS = 19; { DCN Measurement Subsystems }
+ IPPROTO_HMP = 20; { Host Monitoring }
+ IPPROTO_PRM = 21; { Packet Radio Measurement }
+ IPPROTO_IDP = 22; { xns idp }
+ IPPROTO_TRUNK1 = 23; { Trunk-1 }
+ IPPROTO_TRUNK2 = 24; { Trunk-2 }
+ IPPROTO_LEAF1 = 25; { Leaf-1 }
+ IPPROTO_LEAF2 = 26; { Leaf-2 }
+ IPPROTO_RDP = 27; { Reliable Data }
+ IPPROTO_IRTP = 28; { Reliable Transaction }
+ IPPROTO_TP = 29; { tp-4 w/ class negotiation }
+ IPPROTO_BLT = 30; { Bulk Data Transfer }
+ IPPROTO_NSP = 31; { Network Services }
+ IPPROTO_INP = 32; { Merit Internodal }
+ IPPROTO_SEP = 33; { Sequential Exchange }
+ IPPROTO_3PC = 34; { Third Party Connect }
+ IPPROTO_IDPR = 35; { InterDomain Policy Routing }
+ IPPROTO_XTP = 36; { XTP }
+ IPPROTO_DDP = 37; { Datagram Delivery }
+ IPPROTO_CMTP = 38; { Control Message Transport }
+ IPPROTO_TPXX = 39; { TP++ Transport }
+ IPPROTO_IL = 40; { IL transport protocol }
+ IPPROTO_IPV6 = 41; { IP6 header }
+ IPPROTO_SDRP = 42; { Source Demand Routing }
+ IPPROTO_ROUTING = 43; { IP6 routing header }
+ IPPROTO_FRAGMENT = 44; { IP6 fragmentation header }
+ IPPROTO_IDRP = 45; { InterDomain Routing}
+ IPPROTO_RSVP = 46; { resource reservation }
+ IPPROTO_GRE = 47; { General Routing Encap. }
+ IPPROTO_MHRP = 48; { Mobile Host Routing }
+ IPPROTO_BHA = 49; { BHA }
+ IPPROTO_ESP = 50; { IP6 Encap Sec. Payload }
+ IPPROTO_AH = 51; { IP6 Auth Header }
+ IPPROTO_INLSP = 52; { Integ. Net Layer Security }
+ IPPROTO_SWIPE = 53; { IP with encryption }
+ IPPROTO_NHRP = 54; { Next Hop Resolution }
+{ 55-57: Unassigned }
+ IPPROTO_ICMPV6 = 58; { ICMP6 }
+ IPPROTO_NONE = 59; { IP6 no next header }
+ IPPROTO_DSTOPTS = 60; { IP6 destination option }
+ IPPROTO_AHIP = 61; { any host internal protocol }
+ IPPROTO_CFTP = 62; { CFTP }
+ IPPROTO_HELLO = 63; { 'hello' routing protocol }
+ IPPROTO_SATEXPAK = 64; { SATNET/Backroom EXPAK }
+ IPPROTO_KRYPTOLAN = 65; { Kryptolan }
+ IPPROTO_RVD = 66; { Remote Virtual Disk }
+ IPPROTO_IPPC = 67; { Pluribus Packet Core }
+ IPPROTO_ADFS = 68; { Any distributed FS }
+ IPPROTO_SATMON = 69; { Satnet Monitoring }
+ IPPROTO_VISA = 70; { VISA Protocol }
+ IPPROTO_IPCV = 71; { Packet Core Utility }
+ IPPROTO_CPNX = 72; { Comp. Prot. Net. Executive }
+ IPPROTO_CPHB = 73; { Comp. Prot. HeartBeat }
+ IPPROTO_WSN = 74; { Wang Span Network }
+ IPPROTO_PVP = 75; { Packet Video Protocol }
+ IPPROTO_BRSATMON = 76; { BackRoom SATNET Monitoring }
+ IPPROTO_ND = 77; { Sun net disk proto (Name:temp.) }
+ IPPROTO_WBMON = 78; { WIDEBAND Monitoring }
+ IPPROTO_WBEXPAK = 79; { WIDEBAND EXPAK }
+ IPPROTO_EON = 80; { ISO cnlp }
+ IPPROTO_VMTP = 81; { VMTP }
+ IPPROTO_SVMTP = 82; { Secure VMTP }
+ IPPROTO_VINES = 83; { Banyon VINES }
+ IPPROTO_TTP = 84; { TTP }
+ IPPROTO_IGP = 85; { NSFNET-IGP }
+ IPPROTO_DGP = 86; { dissimilar gateway prot. }
+ IPPROTO_TCF = 87; { TCF }
+ IPPROTO_IGRP = 88; { Cisco/GXS IGRP }
+ IPPROTO_OSPFIGP = 89; { OSPFIGP }
+ IPPROTO_SRPC = 90; { Strite RPC protocol }
+ IPPROTO_LARP = 91; { Locus Address Resoloution }
+ IPPROTO_MTP = 92; { Multicast Transport }
+ IPPROTO_AX25 = 93; { AX.25 Frames }
+ IPPROTO_IPEIP = 94; { IP encapsulated in IP }
+ IPPROTO_MICP = 95; { Mobile Int.ing control }
+ IPPROTO_SCCSP = 96; { Semaphore Comm. security }
+ IPPROTO_ETHERIP = 97; { Ethernet IP encapsulation }
+ IPPROTO_ENCAP = 98; { encapsulation header }
+ IPPROTO_APES = 99; { any private encr. scheme }
+ IPPROTO_GMTP = 100; { GMTP}
+ IPPROTO_IPCOMP = 108; { payload compression (Name:IPComp) }
+{ 101-254: Partly Unassigned }
+ IPPROTO_PIM = 103; { Protocol Independent Mcast }
+ IPPROTO_PGM = 113; { PGM }
+{ 255: Reserved }
+{ BSD Private, local use, namespace incursion }
+ IPPROTO_DIVERT = 254; { divert pseudo-protocol }
+ IPPROTO_RAW = 255; { raw IP packet }
+ IPPROTO_MAX = 256;
+
+{ last return value of *_input(Name:);CtlType: meaning 'all job for this pkt is done'. }
+ IPPROTO_DONE = 257;
+
+
+{
+ * Options for use with [gs]etsockopt at the IP level.
+ * First word of comment is data type; bool is stored in int.
+}
+ IP_OPTIONS = 1; { buf/ip_opts; set/get IP options }
+ IP_HDRINCL = 2; { int; header is included with data }
+ IP_TOS = 3; { int; IP type of service and preced. }
+ IP_TTL = 4; { int; IP time to live }
+ IP_RECVOPTS = 5; { bool; receive all IP opts w/dgram }
+ IP_RECVRETOPTS = 6; { bool; receive IP opts for response }
+ IP_RECVDSTADDR = 7; { bool; receive IP dst addr w/dgram }
+ IP_RETOPTS = 8; { ip_opts; set/get IP options }
+ IP_MULTICAST_IF = 9; { u_char; set/get IP multicast i/f }
+ IP_MULTICAST_TTL = 10; { u_char; set/get IP multicast ttl }
+ IP_MULTICAST_LOOP = 11; { u_char; set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = 12; { ip_mreq; add an IP group membership }
+ IP_DROP_MEMBERSHIP = 13; { ip_mreq; drop an IP group membership }
+ IP_MULTICAST_VIF = 14; { set/get IP mcast virt. iface }
+ IP_RSVP_ON = 15; { enable RSVP in kernel }
+ IP_RSVP_OFF = 16; { disable RSVP in kernel }
+ IP_RSVP_VIF_ON = 17; { set RSVP per-vif socket }
+ IP_RSVP_VIF_OFF = 18; { unset RSVP per-vif socket }
+ IP_PORTRANGE = 19; { int; range to choose for unspec port }
+ IP_RECVIF = 20; { bool; receive reception if w/dgram }
+{ for IPSEC }
+ IP_IPSEC_POLICY = 21; { int; set/get security policy }
+ IP_FAITH = 22; { bool; accept FAITH'ed connections }
+
+ IP_FW_ADD = 50; { add a firewall rule to chain }
+ IP_FW_DEL = 51; { delete a firewall rule from chain }
+ IP_FW_FLUSH = 52; { flush firewall rule chain }
+ IP_FW_ZERO = 53; { clear single/all firewall counter(Name:s) }
+ IP_FW_GET = 54; { get entire firewall rule chain }
+ IP_FW_RESETLOG = 55; { reset logging counters }
+
+ IP_DUMMYNET_CONFIGURE = 60; { add/configure a dummynet pipe }
+ IP_DUMMYNET_DEL = 61; { delete a dummynet pipe from chain }
+ IP_DUMMYNET_FLUSH = 62; { flush dummynet }
+ IP_DUMMYNET_GET = 64; { get entire dummynet pipes }
+
+{
+ * Defaults and limits for options
+}
+ IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
+ IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member }
+ IP_MAX_MEMBERSHIPS = 20; { per socket }
+
+{
+ * Argument for IP_PORTRANGE:
+ * - which range to search when port is unspecified at bind(Name:) or connect()
+}
+ IP_PORTRANGE_DEFAULT = 0; { default range }
+ IP_PORTRANGE_HIGH = 1; { 'high' - request firewall bypass }
+ IP_PORTRANGE_LOW = 2; { 'low' - vouchsafe security }
+
+{
+ * Definitions for inet sysctl operations.
+ *
+ * Third level is protocol number.
+ * Fourth level is desired variable within that protocol.
+}
+ IPPROTO_MAXID = (IPPROTO_AH + 1); { don't list to IPPROTO_MAX }
+
+ CTL_IPPROTO_NAMES : Array[0..51] OF CtlNameRec = (
+ (Name: 'ip';CtlType: CTLTYPE_NODE ),
+ (Name: 'icmp';CtlType: CTLTYPE_NODE ),
+ (Name: 'igmp';CtlType: CTLTYPE_NODE ),
+ (Name: 'ggp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'tcp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'egp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'pup';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'udp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'idp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'ipsec';CtlType: CTLTYPE_NODE ));
+
+{
+ * Names for IP sysctl objects
+}
+ IPCTL_FORWARDING = 1; { act as router }
+ IPCTL_SENDREDIRECTS = 2; { may send redirects when forwarding }
+ IPCTL_DEFTTL = 3; { default TTL }
+{$ifdef notyettunable}
+ IPCTL_DEFMTU = 4; { default MTU }
+{$endif}
+ IPCTL_RTEXPIRE = 5; { cloned route expiration time }
+ IPCTL_RTMINEXPIRE = 6; { min value for expiration time }
+ IPCTL_RTMAXCACHE = 7; { trigger level for dynamic expire }
+ IPCTL_SOURCEROUTE = 8; { may perform source routes }
+ IPCTL_DIRECTEDBROADCAST = 9; { may re-broadcast received packets }
+ IPCTL_INTRQMAXLEN = 10; { max length of netisr queue }
+ IPCTL_INTRQDROPS = 11; { number of netisr q drops }
+ IPCTL_STATS = 12; { ipstat structure }
+ IPCTL_ACCEPTSOURCEROUTE = 13; { may accept source routed packets }
+ IPCTL_FASTFORWARDING = 14; { use fast IP forwarding code }
+ IPCTL_KEEPFAITH = 15; { FAITH IPv4->IPv6 translater ctl }
+ IPCTL_GIF_TTL = 16; { default TTL for gif encap packet }
+ IPCTL_MAXID = 17;
+
+ IPCTL_NAMES : Array[0..14] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'forwarding';CtlType: CTLTYPE_INT ),
+ (Name: 'redirect';CtlType: CTLTYPE_INT ),
+ (Name: 'ttl';CtlType: CTLTYPE_INT ),
+ (Name: 'mtu';CtlType: CTLTYPE_INT ),
+ (Name: 'rtexpire';CtlType: CTLTYPE_INT ),
+ (Name: 'rtminexpire';CtlType: CTLTYPE_INT ),
+ (Name: 'rtmaxcache';CtlType: CTLTYPE_INT ),
+ (Name: 'sourceroute';CtlType: CTLTYPE_INT ),
+ (Name: 'directed-broadcast';CtlType: CTLTYPE_INT ),
+ (Name: 'intr-queue-maxlen';CtlType: CTLTYPE_INT ),
+ (Name: 'intr-queue-drops';CtlType: CTLTYPE_INT ),
+ (Name: 'stats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'accept_sourceroute';CtlType: CTLTYPE_INT ),
+ (Name: 'fastforwarding';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for ICMP sysctl objects
+}
+ ICMPCTL_MASKREPL = 1; { allow replies to netmask requests }
+ ICMPCTL_STATS = 2; { statistics (Name:read-only) }
+ ICMPCTL_ICMPLIM = 3;
+ ICMPCTL_MAXID = 4;
+
+ ICMPCTL_NAMES : Array[0..3] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'maskrepl';CtlType: CTLTYPE_INT ),
+ (Name: 'stats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'icmplim';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for ICMP sysctl objects
+}
+ ICMPV6CTL_STATS = 1;
+ ICMPV6CTL_REDIRACCEPT = 2; { accept/process redirects }
+ ICMPV6CTL_REDIRTIMEOUT = 3; { redirect cache time }
+{$ifdef obsolete} {obsoleted}
+ ICMPV6CTL_ERRRATELIMIT = 5; { ICMPv6 error rate limitation }
+{$endif}
+ ICMPV6CTL_ND6_PRUNE = 6;
+ ICMPV6CTL_ND6_DELAY = 8;
+ ICMPV6CTL_ND6_UMAXTRIES = 9;
+ ICMPV6CTL_ND6_MMAXTRIES = 10;
+ ICMPV6CTL_ND6_USELOOPBACK = 11;
+//define ICMPV6CTL_ND6_PROXYALL = 12; obsoleted, do not reuse here
+ ICMPV6CTL_NODEINFO = 13;
+ ICMPV6CTL_ERRPPSLIMIT = 14; { ICMPv6 error pps limitation }
+ ICMPV6CTL_ND6_MAXNUDHINT= 15;
+ ICMPV6CTL_MTUDISC_HIWAT = 16;
+ ICMPV6CTL_MTUDISC_LOWAT = 17;
+ ICMPV6CTL_ND6_DEBUG = 18;
+ ICMPV6CTL_ND6_DRLIST = 19;
+ ICMPV6CTL_ND6_PRLIST = 20;
+ ICMPV6CTL_MAXID = 21;
+
+ ICMPV6CTL_NAMES : Array[0..20] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'rediraccept';CtlType: CTLTYPE_INT ),
+ (Name: 'redirtimeout';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nd6_prune';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nd6_delay';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_umaxtries';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_mmaxtries';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_useloopback';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nodeinfo';CtlType: CTLTYPE_INT ),
+ (Name: 'errppslimit';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_maxnudhint';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisc_hiwat';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisc_lowat';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_debug';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ));
+
+
+{
+ * Names for UDP sysctl objects
+}
+ UDPCTL_CHECKSUM = 1; { checksum UDP packets }
+ UDPCTL_STATS = 2; { statistics (Name:read-only) }
+ UDPCTL_MAXDGRAM = 3; { max datagram size }
+ UDPCTL_RECVSPACE = 4; { default receive buffer space }
+ UDPCTL_PCBLIST = 5; { list of PCBs for UDP sockets }
+ UDPCTL_MAXID = 6;
+
+ UDPCTL_NAMES : Array[0..5] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'checksum';CtlType: CTLTYPE_INT ),
+ (Name: 'stats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'maxdgram';CtlType: CTLTYPE_INT ),
+ (Name: 'recvspace';CtlType: CTLTYPE_INT ),
+ (Name: 'pcblist';CtlType: CTLTYPE_STRUCT ));
+
+{
+
+ $Log: sysctlh.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/sysnr.inc b/rtl/freebsd/sysnr.inc
new file mode 100644
index 0000000000..cb77347fc1
--- /dev/null
+++ b/rtl/freebsd/sysnr.inc
@@ -0,0 +1,325 @@
+{
+ $Id: sysnr.inc,v 1.12 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+{ Crude converted FreeBSD 4.0-release syscall.h. Copy and paste if you
+ checked the function.
+ syscall_nr_syscall = 0;
+ syscall_nr_exit = 1;
+ syscall_nr_fork = 2;
+ syscall_nr_read = 3;
+ syscall_nr_write = 4;
+ syscall_nr_open = 5;
+ syscall_nr_close = 6;
+ syscall_nr_wait4 = 7;
+ syscall_nr_link = 9;
+ syscall_nr_unlink = 10;
+ syscall_nr_chdir = 12;
+ syscall_nr_fchdir = 13;
+ syscall_nr_mknod = 14;
+ syscall_nr_chmod = 15;
+ syscall_nr_chown = 16;
+ syscall_nr_break = 17;
+ syscall_nr_getfsstat = 18;
+ syscall_nr_getpid = 20;
+ syscall_nr_mount = 21;
+ syscall_nr_unmount = 22;
+ syscall_nr_getuid = 24;
+ syscall_nr_geteuid = 25;
+ syscall_nr_ptrace = 26;
+ syscall_nr_recvmsg = 27;
+ syscall_nr_sendmsg = 28;
+ syscall_nr_getpeername = 31;
+ syscall_nr_getsockname = 32;
+ syscall_nr_access = 33;
+ syscall_nr_chflags = 34;
+ syscall_nr_fchflags = 35;
+ syscall_nr_sync = 36;
+ syscall_nr_kill = 37;
+ syscall_nr_getppid = 39;
+ syscall_nr_dup = 41;
+ syscall_nr_pipe = 42;
+ syscall_nr_getegid = 43;
+ syscall_nr_profil = 44;
+ syscall_nr_ktrace = 45;
+ syscall_nr_getgid = 47;
+ syscall_nr_getlogin = 49;
+ syscall_nr_setlogin = 50;
+ syscall_nr_acct = 51;
+ syscall_nr_sigaltstack = 53;
+ syscall_nr_ioctl = 54;
+ syscall_nr_reboot = 55;
+ syscall_nr_revoke = 56;
+ syscall_nr_symlink = 57;
+ syscall_nr_readlink = 58;
+ syscall_nr_execve = 59;
+ syscall_nr_umask = 60;
+ syscall_nr_chroot = 61;
+ syscall_nr_msync = 65;
+ syscall_nr_vfork = 66;
+ syscall_nr_sbrk = 69;
+ syscall_nr_sstk = 70;
+ syscall_nr_vadvise = 72;
+ syscall_nr_mprotect = 74;
+ syscall_nr_madvise = 75;
+ syscall_nr_mincore = 78;
+ syscall_nr_setgroups = 80;
+ syscall_nr_setpgid = 82;
+ syscall_nr_swapon = 85;
+
+ syscall_nr_getdtablesize = 89;
+ syscall_nr_dup2 = 90;
+ syscall_nr_fcntl = 92;
+ syscall_nr_select = 93;
+ syscall_nr_fsync = 95;
+ syscall_nr_setpriority = 96;
+ syscall_nr_connect = 98;
+ syscall_nr_getpriority =100;
+ syscall_nr_setsockopt =105;
+ syscall_nr_gettimeofday =116;
+ syscall_nr_readv =120;
+ syscall_nr_writev =121;
+
+ syscall_nr_fchown =123;
+ syscall_nr_fchmod =124;
+ syscall_nr_setreuid =126;
+ syscall_nr_setregid =127;
+ syscall_nr_rename =128;
+ syscall_nr_flock =131;
+ syscall_nr_mkdir =136;
+ syscall_nr_rmdir =137;
+ syscall_nr_utimes =138;
+ syscall_nr_adjtime =140;
+
+ syscall_nr_quotactl =148;
+ syscall_nr_nfssvc =155;
+ syscall_nr_statfs =157;
+ syscall_nr_fstatfs =158;
+ syscall_nr_getfh =161;
+ syscall_nr_getdomainname =162;
+ syscall_nr_setdomainname =163;
+ syscall_nr_uname =164;
+
+ syscall_nr_rtprio =166;
+ syscall_nr_pread =173;
+ syscall_nr_pwrite =174;
+ syscall_nr_ntp_adjtime =176;
+ syscall_nr_setegid =182;
+ syscall_nr_seteuid =183;
+ syscall_nr_stat =188;
+ syscall_nr_fstat =189;
+ syscall_nr_lstat =190;
+ syscall_nr_pathconf =191;
+ syscall_nr_fpathconf =192;
+ syscall_nr_getrlimit =194;
+ syscall_nr_setrlimit =195;
+syscall_nr_getdirentries =196;
+ syscall_nr_mmap =197;
+ syscall_nr_lseek =199;
+ syscall_nr_truncate =200;
+ syscall_nr_ftruncate =201;
+ syscall_nr___sysctl =202;
+ syscall_nr_mlock =203;
+ syscall_nr_munlock =204;
+ syscall_nr_undelete =205;
+ syscall_nr_futimes =206;
+ syscall_nr_getpgid =207;
+ syscall_nr_poll =209;
+ syscall_nr___semctl =220;
+ syscall_nr_semget =221;
+ syscall_nr_semop =222;
+ syscall_nr_semconfig =223;
+ syscall_nr_msgctl =224;
+ syscall_nr_msgget =225;
+ syscall_nr_msgsnd =226;
+ syscall_nr_msgrcv =227;
+ syscall_nr_shmat =228;
+ syscall_nr_shmctl =229;
+ syscall_nr_shmdt =230;
+ syscall_nr_shmget =231;
+ syscall_nr_clock_gettime =232;
+ syscall_nr_clock_settime =233;
+ syscall_nr_clock_getres =234;
+ syscall_nr_nanosleep =240;
+ syscall_nr_minherit =250;
+ syscall_nr_openbsd_poll =252;
+ syscall_nr_issetugid =253;
+ syscall_nr_lchown =254;
+ syscall_nr_getdents =272;
+ syscall_nr_lchmod =274;
+ syscall_nr_netbsd_lchown =275;
+ syscall_nr_lutimes =276;
+ syscall_nr_netbsd_msync =277;
+ syscall_nr_nstat =278;
+ syscall_nr_nfstat =279;
+ syscall_nr_nlstat =280;
+ syscall_nr_fhstatfs =297;
+ syscall_nr_fhopen =298;
+ syscall_nr_fhstat =299;
+ syscall_nr_modnext =300;
+ syscall_nr_modstat =301;
+ syscall_nr_modfnext =302;
+ syscall_nr_modfind =303;
+ syscall_nr_kldload =304;
+ syscall_nr_kldunload =305;
+ syscall_nr_kldfind =306;
+ syscall_nr_kldnext =307;
+ syscall_nr_kldstat =308;
+ syscall_nr_kldfirstmod =309;
+ syscall_nr_getsid =310;
+ syscall_nr_setresuid =311;
+ syscall_nr_setresgid =312;
+ syscall_nr_aio_return =314;
+ syscall_nr_aio_suspend =315;
+ syscall_nr_aio_cancel =316;
+ syscall_nr_aio_error =317;
+ syscall_nr_aio_read =318;
+ syscall_nr_aio_write =319;
+ syscall_nr_lio_listio =320;
+ syscall_nr_yield =321;
+ syscall_nr_thr_sleep =322;
+ syscall_nr_thr_wakeup =323;
+ syscall_nr_mlockall =324;
+ syscall_nr_munlockall =325;
+ syscall_nr_sched_setparam =327;
+ syscall_nr_sched_getparam =328;
+ syscall_nr_sched_setscheduler =329;
+ syscall_nr_sched_getscheduler =330;
+ syscall_nr_sched_yield =331;
+ syscall_nr_sched_get_priority_max =332;
+ syscall_nr_sched_get_priority_min =333;
+ syscall_nr_sched_rr_get_interval =334;
+ syscall_nr_utrace =335;
+ syscall_nr_sendfile =336;
+ syscall_nr_kldsym =337;
+ syscall_nr_jail =338;
+ syscall_nr_sigprocmask =340;
+ syscall_nr_sigsuspend =341;
+ syscall_nr_sigaction =342;
+ syscall_nr_sigpending =343;
+ syscall_nr_sigreturn =344;
+ syscall_nr___acl_get_file =347;
+ syscall_nr___acl_set_file =348;
+ syscall_nr___acl_get_fd =349;
+ syscall_nr___acl_set_fd =350;
+ syscall_nr___acl_delete_file =351;
+ syscall_nr___acl_delete_fd =352;
+ syscall_nr___acl_aclcheck_file =353;
+ syscall_nr___acl_aclcheck_fd =354;
+ syscall_nr_extattrctl =355;
+ syscall_nr_extattr_set_file =356;
+ syscall_nr_extattr_get_file =357;
+ syscall_nr_extattr_delete_file =358;
+ syscall_nr_aio_waitcomplete =359;
+ syscall_nr_getresuid =360;
+ syscall_nr_getresgid =361;
+ syscall_nr_MAXSYSCALL =362;
+
+}
+
+{More or less checked BSD syscalls}
+ syscall_nr_semsys =169;
+ syscall_nr_msgsys =170;
+ syscall_nr_shmsys =171;
+ syscall_nr_mkfifo =132;
+ syscall_nr___getcwd =326;
+ syscall_nr_settimeofday =122;
+ syscall_nr_getitimer = 86;
+ syscall_nr_setitimer = 83;
+ syscall_nr___syscall =198;
+ syscall_nr_setsid =147;
+ syscall_nr_getpgrp = 81;
+ syscall_nr_setuid = 23;
+ syscall_nr_setgid =181;
+ syscall_nr_getgroups = 79;
+ syscall_nr_sysarch = 165;
+ syscall_nr_accept = 30;
+ syscall_nr_access = 33;
+ syscall_nr_bind = 104;
+ syscall_nr_chdir = 12;
+ syscall_nr_chmod = 15;
+ syscall_nr_chown = 16;
+ syscall_nr_close = 6;
+ syscall_nr_connect = 98;
+ syscall_nr_dup = 41;
+ syscall_nr_dup2 = 90;
+ syscall_nr_execve = 59;
+ syscall_nr_exit = 1;
+ syscall_nr_fcntl = 92;
+ syscall_nr_flock = 131;
+ syscall_nr_fork = 2;
+ syscall_nr_fstat = 189;
+ syscall_nr_fstatfs = 158;
+ syscall_nr_fsync = 95;
+ syscall_nr_ftruncate = 201;
+ syscall_nr_getdents = 272;
+ syscall_nr_getegid = 43;
+ syscall_nr_geteuid = 25;
+ syscall_nr_getgid = 47;
+ syscall_nr_getpeername = 31;
+ syscall_nr_getpid = 20;
+ syscall_nr_getppid = 39;
+ syscall_nr_getpriority = 100;
+ syscall_nr_getsockname = 32;
+ syscall_nr_gettimeofday = 116;
+ syscall_nr_getuid = 24;
+ syscall_nr_ioctl = 54;
+ syscall_nr_kill = 37;
+ syscall_nr_link = 9;
+ syscall_nr_listen = 106;
+ syscall_nr_lseek = 199;
+ syscall_nr_lstat = 190;
+ syscall_nr_mkdir = 136;
+ syscall_nr_mknod = 14;
+ syscall_nr_mmap = 197;
+ syscall_nr_open = 5;
+ syscall_nr_pipe = 42;
+ syscall_nr_read = 3;
+ syscall_nr_readlink = 58;
+ syscall_nr_recvfrom = 29;
+ syscall_nr_rename = 128;
+ syscall_nr_rmdir = 137;
+ syscall_nr_select = 93;
+ syscall_nr_sendto = 133;
+ syscall_nr_setpriority = 96;
+ syscall_nr_setsockopt = 105;
+ syscall_nr_shutdown = 134;
+ syscall_nr_sigaction = 342;
+ syscall_nr_sigpending = 343;
+ syscall_nr_sigprocmask = 340;
+ syscall_nr_sigsuspend = 341;
+ syscall_nr_socket = 97;
+ syscall_nr_socketpair = 135;
+ syscall_nr_stat = 188;
+ syscall_nr_statfs = 157;
+ syscall_nr_symlink = 57;
+ syscall_nr_umask = 60;
+ syscall_nr_unlink = 10;
+ syscall_nr_utimes = 138;
+ syscall_nr_waitpid = 7;
+ syscall_nr_write = 4;
+ syscall_nr_munmap = 73;
+ syscall_nr_getsockopt = 118;
+ syscall_nr_rfork = 251;
+ syscall_nr_nanosleep = 240;
+ syscall_nr_getrusage =117;
+
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.12 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/termio.pp b/rtl/freebsd/termio.pp
new file mode 100644
index 0000000000..45050d0f36
--- /dev/null
+++ b/rtl/freebsd/termio.pp
@@ -0,0 +1,49 @@
+{
+ $Id: termio.pp,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains the termios interface.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit termio;
+
+interface
+
+Uses BaseUnix; // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.
+
+{
+ $Log: termio.pp,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/termios.inc b/rtl/freebsd/termios.inc
new file mode 100644
index 0000000000..58956e722a
--- /dev/null
+++ b/rtl/freebsd/termios.inc
@@ -0,0 +1,371 @@
+{
+ $Id: termios.inc,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Termios header for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+CONST
+
+{
+ * Special Control Characters
+ *
+ * Index into c_cc[] character array.
+ *
+ * Name Subscript Enabled by
+ }
+ VEOF =0;
+ VEOL =1;
+ VEOL2 =2;
+ VERASE =3;
+ VWERASE =4;
+ VKILL =5;
+ VREPRINT =6;
+{ =7; spare 1 }
+ VINTR =8;
+ VQUIT =9;
+ VSUSP =10;
+ VDSUSP =11;
+ VSTART =12;
+ VSTOP =13;
+ VLNEXT =14;
+ VDISCARD =15;
+ VMIN =16;
+ VTIME =17;
+ VSTATUS =18;
+{ =19 spare 2 }
+ NCCS =20;
+
+Type
+ winsize = packed record
+ ws_row,
+ ws_col,
+ ws_xpixel,
+ ws_ypixel : word;
+ end;
+ TWinSize=winsize;
+
+
+type
+ Termios = packed record
+ c_iflag,
+ c_oflag,
+ c_cflag,
+ c_lflag : longint;
+ c_line : char;
+ c_cc : array[0..NCCS-1] of byte;
+ {$IFDEF BSD}
+ c_ispeed,
+ c_ospeed : longint;
+ {$endif}
+ end;
+ TTermios=Termios;
+
+CONST
+
+
+ POSIX_VDISABLE=Chr($ff);
+{
+
+#define CCEQ(val, c) ((c) == (val) ? (val) != _POSIX_VDISABLE : 0)
+}
+
+{ * Input flags - software input processing}
+
+ IGNBRK = $1; { ignore BREAK condition }
+ BRKINT = $2; { map BREAK to SIGINTR }
+ IGNPAR = $4; { ignore (discard) parity errors }
+ PARMRK = $8; { mark parity and framing errors }
+ INPCK = $10; { enable checking of parity errors }
+ ISTRIP = $20; { strip 8th bit off chars }
+ INLCR = $40; { map NL into CR }
+ IGNCR = $80; { ignore CR }
+ ICRNL = $100; { map CR to NL (ala CRMOD) }
+ IXON = $200; { enable output flow control }
+ IXOFF = $400; { enable input flow control }
+ IXANY = $800; { any char will restart after stop }
+ IMAXBEL = $2000; { ring bell on input queue full }
+
+{
+ * Output flags - software output processing
+}
+ OPOST = $1; { enable following output processing }
+ ONLCR = $2; { map NL to CR-NL (ala CRMOD) }
+ OXTABS = $4; { expand tabs to spaces }
+ ONOEOT = $8; { discard EOT's (^D) on output) }
+
+{
+ * Control flags - hardware control of terminal
+}
+ CIGNORE = $1; { ignore control flags }
+ CSIZE = $300; { character size mask }
+ CS5 = $0; { 5 bits (pseudo) }
+ CS6 = $100; { 6 bits }
+ CS7 = $200; { 7 bits }
+ CS8 = $300; { 8 bits }
+ CSTOPB = $400; { send 2 stop bits }
+ CREAD = $800; { enable receiver }
+ PARENB = $1000; { parity enable }
+ PARODD = $2000; { odd parity, else even }
+ HUPCL = $4000; { hang up on last close }
+ CLOCAL = $8000; { ignore modem status lines }
+ CCTS_OFLOW = $10000; { CTS flow control of output }
+ CRTS_IFLOW = $20000; { RTS flow control of input }
+ CRTSCTS = (CCTS_OFLOW or CRTS_IFLOW);
+ CDTR_IFLOW = $40000; { DTR flow control of input }
+ CDSR_OFLOW = $80000; { DSR flow control of output }
+ CCAR_OFLOW = $100000; { DCD flow control of output }
+ MDMBUF = $100000; { old name for CCAR_OFLOW }
+
+{
+ * "Local" flags - dumping ground for other state
+ *
+ * Warning: some flags in this structure begin with
+ * the letter "I" and look like they belong in the
+ * input flag.
+ }
+
+ ECHOKE = $1; { visual erase for line kill }
+ ECHOE = $2; { visually erase chars }
+ ECHOK = $4; { echo NL after line kill }
+ ECHO = $8; { enable echoing }
+ ECHONL = $10; { echo NL even if ECHO is off }
+ ECHOPRT = $20; { visual erase mode for hardcopy }
+ ECHOCTL = $40; { echo control chars as ^(Char) }
+ ISIG = $80; { enable signals INTR, QUIT, [D]SUSP }
+ ICANON = $100; { canonicalize input lines }
+ ALTWERASE = $200; { use alternate WERASE algorithm }
+ IEXTEN = $400; { enable DISCARD and LNEXT }
+ EXTPROC = $800; { external processing }
+ TOSTOP = $400000; { stop background jobs from output }
+ FLUSHO = $800000; { output being flushed (state) }
+ NOKERNINFO = $2000000; { no kernel output from VSTATUS }
+ PENDIN =$20000000; { XXX retype pending input (state) }
+ NOFLSH =$80000000; { don't flush after interrupt }
+
+
+
+{
+ * Commands passed to tcsetattr() for setting the termios structure.
+}
+
+CONST
+
+ TCSANOW =0; { make change immediate }
+ TCSADRAIN =1; { drain output, then change }
+ TCSAFLUSH =2; { drain output, flush input }
+ TCSASOFT =$10; { flag - don't alter h.w. state }
+
+{
+ * Standard speeds
+}
+ B0 = 0;
+ B50 = 50;
+ B75 = 75;
+ B110 = 110;
+ B134 = 134;
+ B150 = 150;
+ B200 = 200;
+ B300 = 300;
+ B600 = 600;
+ B1200 = 1200;
+ B1800 = 1800;
+ B2400 = 2400;
+ B4800 = 4800;
+ B9600 = 9600;
+ B19200 = 19200;
+ B38400 = 38400;
+ B7200 = 7200;
+ B14400 = 14400;
+ B28800 = 28800;
+ B57600 = 57600;
+ B76800 = 76800;
+ B115200 =115200;
+ B230400 =230400;
+ EXTA = 19200;
+ EXTB = 38400;
+
+ TCIFLUSH =1;
+ TCOFLUSH =2;
+ TCIOFLUSH =3;
+ TCOOFF =1;
+ TCOON =2;
+ TCIOFF =3;
+ TCION =4;
+
+{
+#include <sys/cdefs.h>
+
+__BEGIN_DECLS
+speed_t cfgetispeed __P((const struct termios *));
+speed_t cfgetospeed __P((const struct termios *));
+int cfsetispeed __P((struct termios *, speed_t));
+int cfsetospeed __P((struct termios *, speed_t));
+int tcgetattr __P((int, struct termios *));
+int tcsetattr __P((int, int, const struct termios *));
+int tcdrain __P((int));
+int tcflow __P((int, int));
+int tcflush __P((int, int));
+int tcsendbreak __P((int, int));
+
+#ifndef _POSIX_SOURCE
+void cfmakeraw __P((struct termios *));
+int cfsetspeed __P((struct termios *, speed_t));
+#endif { !_POSIX_SOURCE }
+__END_DECLS
+
+#endif { !_KERNEL }
+
+
+
+struct winsize {
+ unsigned short ws_row; { rows, in characters }
+ unsigned short ws_col; { columns, in characters }
+ unsigned short ws_xpixel; { horizontal size, pixels }
+ unsigned short ws_ypixel; { vertical size, pixels }
+};
+
+}
+ IOCTLREAD = $40000000;
+ IOCTLWRITE = $80000000;
+ IOCTLVOID = $20000000;
+
+ TIOCMODG = IOCTLREAD+$47400+ 3; { get modem control state }
+ TIOCMODS = IOCTLWRITE+$47400+ 4; { set modem control state }
+ TIOCM_LE =$0001; { line enable }
+ TIOCM_DTR =$0002; { data terminal ready }
+ TIOCM_RTS =$0004; { request to send }
+ TIOCM_ST =$0010; { secondary transmit }
+ TIOCM_SR =$0020; { secondary receive }
+ TIOCM_CTS =$0040; { clear to send }
+ TIOCM_CAR =$0100; { carrier detect }
+ TIOCM_CD =TIOCM_CAR;
+ TIOCM_RNG =$0200; { ring }
+ TIOCM_RI =TIOCM_RNG;
+ TIOCM_DSR =$0400; { data set ready }
+ { 8-10 compat }
+ TIOCEXCL =IOCTLVOID+$7400+ 13; { set exclusive use of tty }
+ TIOCNXCL =IOCTLVOID+$7400+ 14; { reset exclusive use of tty }
+ { 15 unused }
+ TIOCFLUSH =IOCTLWRITE+$47400+ 16; { flush buffers }
+ { 17-18 compat }
+ TIOCGETA =IOCTLREAD+$2C7400+ 19; { get termios struct }
+ TIOCSETA =IOCTLWRITE+$2C7400+ 20; { set termios struct }
+ TIOCSETAW =IOCTLWRITE+$2C7400+ 21; { drain output, set }
+ TIOCSETAF =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
+ TIOCGETD =IOCTLREAD+$47400+ 26; { get line discipline }
+ TIOCSETD =IOCTLWRITE+$47400+ 27; { set line discipline }
+ { 127-124 compat }
+ TIOCSBRK =IOCTLVOID+$7400+ 123; { set break bit }
+ TIOCCBRK =IOCTLVOID+$7400+ 122; { clear break bit }
+ TIOCSDTR =IOCTLVOID+$7400+ 121; { set data terminal ready }
+ TIOCCDTR =IOCTLVOID+$7400+ 120; { clear data terminal ready }
+ TIOCGPGRP =IOCTLREAD+$47400+ 119; { get pgrp of tty }
+ TIOCSPGRP =IOCTLWRITE+$47400+ 118; { set pgrp of tty }
+ { 117-116 compat }
+ TIOCOUTQ =IOCTLREAD+$47400+ 115; { output queue size }
+ TIOCSTI =IOCTLWRITE+$17400+ 114; { simulate terminal input }
+ TIOCNOTTY =IOCTLVOID+$7400+ 113; { void tty association }
+ TIOCPKT =IOCTLWRITE+$47400+ 112; { pty: set/clear packet mode }
+ TIOCPKT_DATA =$00; { data packet }
+ TIOCPKT_FLUSHREAD =$01; { flush packet }
+ TIOCPKT_FLUSHWRITE =$02; { flush packet }
+ TIOCPKT_STOP =$04; { stop output }
+ TIOCPKT_START =$08; { start output }
+ TIOCPKT_NOSTOP =$10; { no more ^S, ^Q }
+ TIOCPKT_DOSTOP =$20; { now do ^S ^Q }
+ TIOCPKT_IOCTL =$40; { state change of pty driver }
+ TIOCSTOP =IOCTLVOID+$7400+ 111; { stop output, like ^S }
+ TIOCSTART =IOCTLVOID+$7400+ 110; { start output, like ^Q }
+ TIOCMSET =IOCTLWRITE+$47400+ 109; { set all modem bits }
+ TIOCMBIS =IOCTLWRITE+$47400+ 108; { bis modem bits }
+ TIOCMBIC =IOCTLWRITE+$47400+ 107; { bic modem bits }
+ TIOCMGET =IOCTLREAD+$47400+ 106; { get all modem bits }
+ TIOCREMOTE =IOCTLWRITE+$47400+ 105; { remote input editing }
+ TIOCGWINSZ =IOCTLREAD+$87400+ 104; { get window size }
+ TIOCSWINSZ =IOCTLWRITE+$87400+ 103; { set window size }
+ TIOCUCNTL =IOCTLWRITE+$47400+ 102; { pty: set/clr usr cntl mode }
+ TIOCSTAT =IOCTLVOID+$7400+ 101; { simulate ^T status message }
+ // UIOCCMD(n) _IO('u', n) { usr cntl op "n" }
+ TIOCCONS =IOCTLWRITE+$47400+ 98; { become virtual console }
+ TIOCSCTTY =IOCTLVOID+$7400+ 97; { become controlling tty }
+ TIOCEXT =IOCTLWRITE+$47400+ 96; { pty: external processing }
+ TIOCSIG =IOCTLVOID+$7400+ 95; { pty: generate signal }
+ TIOCDRAIN =IOCTLVOID+$7400+ 94; { wait till output drained }
+ TIOCMSDTRWAIT =IOCTLWRITE+$47400+ 91; { modem: set wait on close }
+ TIOCMGDTRWAIT =IOCTLREAD+$47400+ 90; { modem: get wait on close }
+ TIOCTIMESTAMP =IOCTLREAD+$87400+ 89; { enable/get timestamp
+ * of last input event }
+ TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
+ * of last DCd rise }
+ TIOCSDRAINWAIT =IOCTLWRITE+$47400+ 87; { set ttywait timeout }
+ TIOCGDRAINWAIT =IOCTLREAD+$47400+ 86; { get ttywait timeout }
+
+ TTYDISC =0; { termios tty line discipline }
+ SLIPDISC =4; { serial IP discipline }
+ PPPDISC =5; { PPP discipline }
+ NETGRAPHDISC =6; { Netgraph tty node discipline }
+
+
+{
+ * Defaults on "first" open.
+ }
+ TTYDEF_IFLAG =(BRKINT or ICRNL or IMAXBEL or IXON or IXANY);
+ TTYDEF_OFLAG =(OPOST or ONLCR);
+ TTYDEF_LFLAG =(ECHO or ICANON or ISIG or IEXTEN or ECHOE or ECHOKE or ECHOCTL);
+ TTYDEF_CFLAG =(CREAD or CS8 or HUPCL);
+ TTYDEF_SPEED =(B9600);
+
+
+
+{
+ * Control Character Defaults
+ }
+ CtrlMask = $1f; {\037}
+ CEOF =chr( ORD('d') and CtrlMask);
+ CEOL =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
+ CERASE =chr( $7F and CtrlMask);
+ CINTR =chr(ORD('c') and CtrlMask);
+ CSTATUS =chr(ORD('t') and CtrlMask);
+ CKILL =chr(ORD('u') and CtrlMask);
+ CMIN =chr(1);
+ CQUIT =chr(034 and CtrlMask); { FS, ^\ }
+ CSUSP =chr(ORD('z') and CtrlMask);
+ CTIME =chr(0);
+ CDSUSP =chr(ORD('y') and CtrlMask);
+ CSTART =chr(ORD('q') and CtrlMask);
+ CSTOP =chr(ORD('s') and CtrlMask);
+ CLNEXT =chr(ORD('v') and CtrlMask);
+ CDISCARD =chr(ORD('o') and CtrlMask);
+ CWERASE =chr(ORD('w') and CtrlMask);
+ CREPRINT =chr(ORD('r') and CtrlMask);
+ CEOT =CEOF;
+{ compat }
+ CBRK =CEOL;
+ CRPRNT =CREPRINT;
+ CFLUSH =CDISCARD;
+
+
+{
+ * TTYDEFCHARS to include an array of default control characters.
+}
+ ttydefchars : array[0..NCCS-1] OF char =(
+ CEOF, CEOL, CEOL, CERASE, CWERASE, CKILL, CREPRINT,
+ POSIX_VDISABLE, CINTR, CQUIT, CSUSP, CDSUSP, CSTART, CSTOP, CLNEXT,
+ CDISCARD, CMIN, CTIME, CSTATUS, POSIX_VDISABLE);
+
+{
+ $Log: termios.inc,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/termiosproc.inc b/rtl/freebsd/termiosproc.inc
new file mode 100644
index 0000000000..e4c9d75ac1
--- /dev/null
+++ b/rtl/freebsd/termiosproc.inc
@@ -0,0 +1,138 @@
+{
+ $Id: termiosproc.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Termios implementation for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{******************************************************************************
+ IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+ TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+end;
+
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+ nr:cint;
+begin
+ case OptAct of
+ TCSANOW : nr:=TIOCSETA;
+ TCSADRAIN : nr:=TIOCSETAW;
+ TCSAFLUSH : nr:=TIOCSETAF;
+ else
+ begin
+ fpsetErrNo(ESysEINVAL);
+ TCSetAttr:=-1;
+ exit;
+ end;
+ end;
+ TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ospeed:=speed;
+end;
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+ with tios do
+ begin
+ c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
+ PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+ IGNPAR));
+ c_iflag:=c_iflag OR IGNBRK;
+ c_oflag:=c_oflag and (not OPOST);
+ c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+ ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
+ c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+end;
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+ TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+end;
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+ TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+ TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+ TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+ case act OF
+ TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
+ TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,nil);
+ TCIOFF : {N/I}
+ end;
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+ TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
+end;
+
+Function IsATTY (Handle:cint):cint;
+{
+ Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+var
+ t : Termios;
+begin
+ IsAtty:=TCGetAttr(Handle,t);
+end;
+
+
+Function IsATTY(var f: text):cint;
+{
+ Idem as previous, only now for text variables.
+}
+begin
+ IsATTY:=IsaTTY(textrec(f).handle);
+end;
+
+{
+ $Log: termiosproc.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/tthread.inc b/rtl/freebsd/tthread.inc
new file mode 100644
index 0000000000..5826f1d519
--- /dev/null
+++ b/rtl/freebsd/tthread.inc
@@ -0,0 +1,607 @@
+{
+ $Id: tthread.inc,v 1.15 2005/03/01 20:38:49 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ TThread implementation old (1.0) and new (pthreads) style
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{$IFDEF VER1_0} // leaving the old implementation in for now...
+type
+ PThreadRec=^TThreadRec;
+ TThreadRec=record
+ thread : TThread;
+ next : PThreadRec;
+ end;
+
+var
+ ThreadRoot : PThreadRec;
+ ThreadsInited : boolean;
+// MainThreadID: longint;
+
+Const
+ ThreadCount: longint = 0;
+
+function ThreadSelf:TThread;
+var
+ hp : PThreadRec;
+ sp : Pointer;
+begin
+ sp:=SPtr;
+ hp:=ThreadRoot;
+ while assigned(hp) do
+ begin
+ if (sp<=hp^.Thread.FStackPointer) and
+ (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+ begin
+ Result:=hp^.Thread;
+ exit;
+ end;
+ hp:=hp^.next;
+ end;
+ Result:=nil;
+end;
+
+
+//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
+procedure SIGCHLDHandler(Sig: longint); cdecl;
+
+begin
+ fpwaitpid(-1, nil, WNOHANG);
+end;
+
+procedure InitThreads;
+var
+ Act, OldAct: Baseunix.PSigActionRec;
+begin
+ ThreadRoot:=nil;
+ ThreadsInited:=true;
+
+
+// This will install SIGCHLD signal handler
+// signal() installs "one-shot" handler,
+// so it is better to install and set up handler with sigaction()
+
+ GetMem(Act, SizeOf(SigActionRec));
+ GetMem(OldAct, SizeOf(SigActionRec));
+
+ Act^.sa_handler := TSigAction(@SIGCHLDHandler);
+ Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
+ Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
+ FpSigAction(SIGCHLD, Act, OldAct);
+
+ FreeMem(Act, SizeOf(SigActionRec));
+ FreeMem(OldAct, SizeOf(SigActionRec));
+end;
+
+
+procedure DoneThreads;
+var
+ hp : PThreadRec;
+begin
+ while assigned(ThreadRoot) do
+ begin
+ ThreadRoot^.Thread.Destroy;
+ hp:=ThreadRoot;
+ ThreadRoot:=ThreadRoot^.Next;
+ dispose(hp);
+ end;
+ ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+ hp : PThreadRec;
+begin
+ { Need to initialize threads ? }
+ if not ThreadsInited then
+ InitThreads;
+
+ { Put thread in the linked list }
+ new(hp);
+ hp^.Thread:=t;
+ hp^.next:=ThreadRoot;
+ ThreadRoot:=hp;
+
+ inc(ThreadCount, 1);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+ lasthp,hp : PThreadRec;
+begin
+ hp:=ThreadRoot;
+ lasthp:=nil;
+ while assigned(hp) do
+ begin
+ if hp^.Thread=t then
+ begin
+ if assigned(lasthp) then
+ lasthp^.next:=hp^.next
+ else
+ ThreadRoot:=hp^.next;
+ dispose(hp);
+ exit;
+ end;
+ lasthp:=hp;
+ hp:=hp^.next;
+ end;
+
+ Dec(ThreadCount, 1);
+ if ThreadCount = 0 then DoneThreads;
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;cdecl;
+var
+ FreeThread: Boolean;
+ Thread : TThread absolute args;
+begin
+ while Thread.FHandle = 0 do fpsleep(1);
+ if Thread.FSuspended then Thread.suspend();
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ Result := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then
+ Thread.Free;
+ fpexit(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: Integer;
+begin
+ inherited Create;
+ AddThread(self);
+ FSuspended := CreateSuspended;
+ Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
+ { Setup 16k of stack }
+ FStackSize:=16384;
+ Getmem(FStackPointer,FStackSize);
+ inc(FStackPointer,FStackSize);
+ FCallExitProcess:=false;
+ { Clone }
+ FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
+// if FSuspended then Suspend;
+ FThreadID := FHandle;
+ IsMultiThread := TRUE;
+ FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished and not Suspended then
+ begin
+ Terminate;
+ WaitFor;
+ end;
+ if FHandle <> -1 then
+ fpkill(FHandle, SIGKILL);
+ dec(FStackPointer,FStackSize);
+ Freemem(FStackPointer);
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread(self);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+
+const
+{ I Don't know idle or timecritical, value is also 20, so the largest other
+ possibility is 19 (PFV) }
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,9,10,19,20);
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := fpGetPriority(Prio_Process,FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+ FSuspended := true;
+ fpKill(FHandle, SIGSTOP);
+end;
+
+
+procedure TThread.Resume;
+begin
+ fpKill(FHandle, SIGCONT);
+ FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+ status : longint;
+begin
+ if FThreadID = MainThreadID then
+ fpwaitpid(0,@status,0)
+ else
+ fpwaitpid(FHandle,@status,0);
+ Result:=status;
+end;
+{$ELSE}
+
+{
+ What follows, is a short description on my implementation of TThread.
+ Most information can also be found by reading the source and accompanying
+ comments.
+
+ A thread is created using BeginThread, which in turn calls
+ pthread_create. So the threads here are always posix threads.
+ Posix doesn't define anything for suspending threads as this is
+ inherintly unsafe. Just don't suspend threads at points they cannot
+ control. Therefore, I didn't implement .Suspend() if its called from
+ outside the threads execution flow (except on Linux _without_ NPTL).
+
+ The implementation for .suspend uses a semaphore, which is initialized
+ at thread creation. If the thread tries to suspend itself, we simply
+ let it wait on the semaphore until it is unblocked by someone else
+ who calls .Resume.
+
+ If a thread is supposed to be suspended (from outside its own path of
+ execution) on a system where the symbol LINUX is defined, two things
+ are possible.
+ 1) the system has the LinuxThreads pthread implementation
+ 2) the system has NPTL as the pthread implementation.
+
+ In the first case, each thread is a process on its own, which as far as
+ know actually violates posix with respect to signal handling.
+ But we can detect this case, because getpid(2) will
+ return a different PID for each thread. In that case, sending SIGSTOP
+ to the PID associated with a thread will actually stop that thread
+ only.
+ In the second case, this is not possible. But getpid(2) returns the same
+ PID across all threads, which is detected, and TThread.Suspend() does
+ nothing in that case. This should probably be changed, but I know of
+ no way to suspend a thread when using NPTL.
+
+ If the symbol LINUX is not defined, then the unimplemented
+ function SuspendThread is called.
+
+ Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+ I don't like this. It eats up 2 filedescriptors for each thread,
+ and those are a limited resource. If you have a server programm
+ handling client connections (one per thread) it will not be able
+ to handle many if we use 2 fds already for internal structures.
+ However, right now I don't see a better option unless some sem_*
+ functions are added to systhrds.
+ I encapsulated all used functions here to make it easier to
+ change them completely.
+}
+
+function SemaphoreInit: Pointer;
+begin
+ SemaphoreInit := GetMem(SizeOf(TFilDes));
+ fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+ b: byte;
+begin
+ fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+ fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+ fpclose(PFilDes(FSem)^[0]);
+ fpclose(PFilDes(FSem)^[1]);
+ FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+ ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+ GMainPID: LongInt = 0;
+{$ENDIF}
+const
+ // stupid, considering its not even implemented...
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+ if not ThreadsInited then begin
+ ThreadsInited := true;
+ {$IFDEF LINUX}
+ GMainPid := fpgetpid();
+ {$ENDIF}
+ end;
+end;
+
+procedure DoneThreads;
+begin
+ ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt;
+var
+ LThread: TThread;
+ c: char;
+begin
+ WRITE_DEBUG('ThreadFunc is here...');
+ LThread := TThread(parameter);
+ {$IFDEF LINUX}
+ // save the PID of the "thread"
+ // this is different from the PID of the main thread if
+ // the LinuxThreads implementation is used
+ LThread.FPid := fpgetpid();
+ {$ENDIF}
+ WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+ try
+ if LThread.FInitialSuspended then begin
+ SemaphoreWait(LThread.FSem);
+ if not LThread.FSuspended then begin
+ LThread.FInitialSuspended := false;
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ end else begin
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ except
+ on e: exception do begin
+ WRITE_DEBUG('got exception: ',e.message);
+ LThread.FFatalException := TObject(AcquireExceptionObject);
+ // not sure if we should really do this...
+ // but .Destroy was called, so why not try FreeOnTerminate?
+ if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+ end;
+ end;
+ WRITE_DEBUG('thread done running');
+ Result := LThread.FReturnValue;
+ WRITE_DEBUG('Result is ',Result);
+ LThread.FFinished := True;
+ LThread.DoTerminate;
+ if LThread.FreeOnTerminate then begin
+ WRITE_DEBUG('Thread should be freed');
+ LThread.Free;
+ WRITE_DEBUG('Thread freed');
+ end;
+ WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+ // lets just hope that the user doesn't create a thread
+ // via BeginThread and creates the first TThread Object in there!
+ InitThreads;
+ inherited Create;
+ FSem := SemaphoreInit;
+ FSuspended := CreateSuspended;
+ FSuspendedExternal := false;
+ FInitialSuspended := CreateSuspended;
+ FFatalException := nil;
+ WRITE_DEBUG('creating thread, self = ',longint(self));
+ FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+ WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if FThreadID = GetCurrentThreadID then begin
+ raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+ end;
+ // if someone calls .Free on a thread with
+ // FreeOnTerminate, then don't crash!
+ FFreeOnTerminate := false;
+ if not FFinished and not FSuspended then begin
+ Terminate;
+ WaitFor;
+ end;
+ if (FInitialSuspended) then begin
+ // thread was created suspended but never woken up.
+ SemaphorePost(FSem);
+ WaitFor;
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ SemaphoreDestroy(FSem);
+ inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ if not FSuspended then begin
+ if FThreadID = GetCurrentThreadID then begin
+ FSuspended := true;
+ SemaphoreWait(FSem);
+ end else begin
+ FSuspendedExternal := true;
+{$IFDEF LINUX}
+ // naughty hack if the user doesn't have Linux with NPTL...
+ // in that case, the PID of threads will not be identical
+ // to the other threads, which means that our thread is a normal
+ // process that we can suspend via SIGSTOP...
+ // this violates POSIX, but is the way it works on the
+ // LinuxThreads pthread implementation. Not with NPTL, but in that case
+ // getpid(2) also behaves properly and returns the same PID for
+ // all threads. Thats actually (FINALLY!) native thread support :-)
+ if FPid <> GMainPID then begin
+ FSuspended := true;
+ fpkill(FPid, SIGSTOP);
+ end;
+{$ELSE}
+ SuspendThread(FHandle);
+{$ENDIF}
+ end;
+ end;
+end;
+
+
+procedure TThread.Resume;
+begin
+ if (not FSuspendedExternal) then begin
+ if FSuspended then begin
+ FSuspended := False;
+ SemaphorePost(FSem);
+ end;
+ end else begin
+ FSuspendedExternal := false;
+ ResumeThread(FHandle);
+ end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+ WRITE_DEBUG('waiting for thread ',FHandle);
+ WaitFor := WaitForThreadTerminate(FHandle, 0);
+ WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ // no need to check if FOnTerminate <> nil, because
+ // thats already done in DoTerminate
+ FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+{$ENDIF}
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.15 2005/03/01 20:38:49 jonas
+ * fixed web bug 3387: if one called resume right after creating a
+ suspended thread, it was possible that resume was executed before
+ that thread had completed its initialisation in BeginThread ->
+ FInitialSuspended was set to false in resume and nevertheless a
+ semafore was posted
+ * second problem fixed: set FSuspended to false before waking up the
+ thread, so that it doesn't get FSuspended = true right after waking
+ up. This should be done atomically to be completely correct though.
+
+ Revision 1.14 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.13 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.12 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+}
diff --git a/rtl/freebsd/unixsock.inc b/rtl/freebsd/unixsock.inc
new file mode 100644
index 0000000000..236808a5b8
--- /dev/null
+++ b/rtl/freebsd/unixsock.inc
@@ -0,0 +1,117 @@
+{
+ $Id: unixsock.inc,v 1.11 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ socket call implementations for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+Begin
+ fpSocket:=Do_Syscall(syscall_nr_socket,Domain,xtype,Protocol);
+ socketerror:=fpgeterrno;
+End;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,0,0);
+ socketerror:=fpgeterrno;
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
+ socketerror:=fpgeterrno;
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+ fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags,0,0);
+ socketerror:=fpgeterrno;
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+ fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
+ socketerror:=fpgeterrno;
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+ fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
+ socketerror:=fpgeterrno;
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+begin
+ fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
+ socketerror:=fpgeterrno;
+end;
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+ fpAccept:=do_syscall(syscall_nr_accept,S,TSysParam(addrx),TSysParam(addrlen));
+ socketerror:=fpgeterrno;
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+begin
+ fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
+ socketerror:=fpgeterrno;
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
+ socketerror:=fpgeterrno;
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
+ socketerror:=fpgeterrno;
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
+ socketerror:=fpgeterrno;
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
+begin
+ fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,optname,TSysParam(optval),optlen);
+ socketerror:=fpgeterrno;
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
+ socketerror:=fpgeterrno;
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+
+begin
+ fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
+ socketerror:=fpgeterrno;
+end;
+
+{
+ $Log: unixsock.inc,v $
+ Revision 1.11 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/freebsd/unxconst.inc b/rtl/freebsd/unxconst.inc
new file mode 100644
index 0000000000..b69d56f276
--- /dev/null
+++ b/rtl/freebsd/unxconst.inc
@@ -0,0 +1,126 @@
+{
+ $Id: unxconst.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Constants for Unix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+const
+
+ { Things for LSEEK call}
+ Seek_set = 0;
+ Seek_Cur = 1;
+ Seek_End = 2;
+
+ { Things for OPEN call - after include/sys/fcntl.h,
+ BSD specifies these constants in hex }
+ Open_Accmode = 3;
+ Open_RdOnly = 0;
+ Open_WrOnly = 1;
+ Open_RdWr = 2;
+ Open_NonBlock = 4;
+ Open_Append = 8;
+ Open_ShLock = $10;
+ Open_ExLock = $20;
+ Open_ASync = $40;
+ Open_FSync = $80;
+ Open_NoFollow = $100;
+ Open_Create = $200; {BSD convention}
+ Open_Creat = $200; {Linux convention}
+ Open_Trunc = $400;
+ Open_Excl = $800;
+ Open_NoCTTY = $8000;
+
+ { The waitpid uses the following options:}
+ Wait_NoHang = 1;
+ Wait_UnTraced = 2;
+ Wait_Any = -1;
+ Wait_MyPGRP = 0;
+
+
+ { Constants to check stat.mode - checked all STAT constants with BSD}
+ STAT_IFMT = $f000; {00170000 }
+ STAT_IFSOCK = $c000; {0140000 }
+ STAT_IFLNK = $a000; {0120000 }
+ STAT_IFREG = $8000; {0100000 }
+ STAT_IFBLK = $6000; {0060000 }
+ STAT_IFDIR = $4000; {0040000 }
+ STAT_IFCHR = $2000; {0020000 }
+ STAT_IFIFO = $1000; {0010000 }
+ STAT_ISUID = $0800; {0004000 }
+ STAT_ISGID = $0400; {0002000 }
+ STAT_ISVTX = $0200; {0001000}
+ { Constants to check permissions all }
+ STAT_IRWXO = $7;
+ STAT_IROTH = $4;
+ STAT_IWOTH = $2;
+ STAT_IXOTH = $1;
+
+ STAT_IRWXG = STAT_IRWXO shl 3;
+ STAT_IRGRP = STAT_IROTH shl 3;
+ STAT_IWGRP = STAT_IWOTH shl 3;
+ STAT_IXGRP = STAT_IXOTH shl 3;
+
+ STAT_IRWXU = STAT_IRWXO shl 6;
+ STAT_IRUSR = STAT_IROTH shl 6;
+ STAT_IWUSR = STAT_IWOTH shl 6;
+ STAT_IXUSR = STAT_IXOTH shl 6;
+
+ { Constants to test the type of filesystem }
+ fs_old_ext2 = $ef51;
+ fs_ext2 = $ef53;
+ fs_ext = $137d;
+ fs_iso = $9660;
+ fs_minix = $137f;
+ fs_minix_30 = $138f;
+ fs_minux_V2 = $2468;
+ fs_msdos = $4d44;
+ fs_nfs = $6969;
+ fs_proc = $9fa0;
+ fs_xia = $012FD16D;
+
+ {Constansts Termios/Ioctl (used in Do_IsDevice) }
+ IOCtl_TCGETS= $40000000+$2C7400+ 19; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+ ITimer_Real =0;
+ ITimer_Virtual =1;
+ ITimer_Prof =2;
+
+{
+ {Checked for BSD using Linuxthreads port}
+ { cloning flags }
+ CSIGNAL = $000000ff; // signal mask to be sent at exit
+ CLONE_VM = $00000100; // set if VM shared between processes
+ CLONE_FS = $00000200; // set if fs info shared between processes
+ CLONE_FILES = $00000400; // set if open files shared between processes
+ CLONE_SIGHAND = $00000800; // set if signal handlers shared
+ CLONE_PID = $00001000; // set if pid shared
+
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+}
+
+{
+ $Log: unxconst.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.11 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/freebsd/unxfunc.inc b/rtl/freebsd/unxfunc.inc
new file mode 100644
index 0000000000..69a983f01a
--- /dev/null
+++ b/rtl/freebsd/unxfunc.inc
@@ -0,0 +1,83 @@
+{
+ $Id: unxfunc.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$ifndef HAS_LIBC_PIPING}
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+ res : cint;
+
+begin
+ fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^longint;
+ res : longint;
+
+begin
+ fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+{$ENDIF}
+
+
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ ret : longint;
+ errn : cint;
+ {$ifdef FPC_USE_LIBC}
+ fdis : array[0..1] of cint;
+ {$endif}
+begin
+{$ifndef FPC_USE_LIBC}
+ ret:=intAssignPipe(pipe_in,pipe_out,errn);
+ if ret=-1 Then
+ fpseterrno(errn);
+{$ELSE}
+ fdis[0]:=pipe_in;
+ fdis[1]:=pipe_out;
+ ret:=pipe(fdis);
+ pipe_in:=fdis[0];
+ pipe_out:=fdis[1];
+{$ENDIF}
+ AssignPipe:=ret;
+end;
+
+{
+ $Log: unxfunc.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.1 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+}
diff --git a/rtl/freebsd/unxsockh.inc b/rtl/freebsd/unxsockh.inc
new file mode 100644
index 0000000000..f172416d4b
--- /dev/null
+++ b/rtl/freebsd/unxsockh.inc
@@ -0,0 +1,79 @@
+{
+ $Id: unxsockh.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ OS dependant part of the header.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+Const
+ AF_AX25 = 3; { Amateur Radio AX.25 }
+ AF_IPX = 4; { Novell IPX }
+ AF_APPLETALK = 5; { Appletalk DDP }
+ AF_NETROM = 6; { Amateur radio NetROM }
+ AF_BRIDGE = 7; { Multiprotocol bridge }
+ AF_AAL5 = 8; { Reserved for Werner's ATM }
+ AF_X25 = 9; { Reserved for X.25 project }
+ AF_INET6 = 10; { IP version 6 }
+ AF_MAX = 12;
+
+ SOCK_PACKET = 10;
+
+ PF_AX25 = AF_AX25;
+ PF_IPX = AF_IPX;
+ PF_APPLETALK = AF_APPLETALK;
+ PF_NETROM = AF_NETROM;
+ PF_BRIDGE = AF_BRIDGE;
+ PF_AAL5 = AF_AAL5;
+ PF_X25 = AF_X25;
+ PF_INET6 = AF_INET6;
+
+ PF_MAX = AF_MAX;
+
+ SOL_SOCKET = $FFFF;
+ SO_DEBUG =$0001; { turn on debugging info recording }
+ SO_ACCEPTCONN =$0002; { socket has had listen() }
+ SO_REUSEADDR =$0004; { allow local address reuse }
+ SO_KEEPALIVE =$0008; { keep connections alive }
+ SO_DONTROUTE =$0010; { just use interface addresses }
+ SO_BROADCAST =$0020; { permit sending of broadcast msgs }
+ SO_USELOOPBACK =$0040; { bypass hardware when possible }
+ SO_LINGER =$0080; { linger on close if data present }
+ SO_OOBINLINE =$0100; { leave received OOB data in line }
+ SO_REUSEPORT =$0200; { allow local address & port reuse }
+ SO_TIMESTAMP =$0400; { timestamp received dgram traffic }
+
+{
+ * Additional options, not kept in so_options.
+ }
+ SO_SNDBUF =$1001; { send buffer size }
+ SO_RCVBUF =$1002; { receive buffer size }
+ SO_SNDLOWAT =$1003; { send low-water mark }
+ SO_RCVLOWAT =$1004; { receive low-water mark }
+ SO_SNDTIMEO =$1005; { send timeout }
+ SO_RCVTIMEO =$1006; { receive timeout }
+ SO_ERROR =$1007; { get error status and clear }
+ SO_TYPE =$1008; { get socket type }
+
+
+ SHUT_RD =0; { shut down the reading side }
+ SHUT_WR =1; { shut down the writing side }
+ SHUT_RDWR =2; { shut down both sides }
+
+
+{
+ $Log: unxsockh.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
+
+
diff --git a/rtl/freebsd/unxsysc.inc b/rtl/freebsd/unxsysc.inc
new file mode 100644
index 0000000000..f42cabdca2
--- /dev/null
+++ b/rtl/freebsd/unxsysc.inc
@@ -0,0 +1,142 @@
+{
+ $Id: unxsysc.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+(*
+function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+{NOT IMPLEMENTED YET UNDER BSD}
+begin // perhaps it is better to implement the hack from solaris then this msg
+ HALT;
+END;
+
+ if (pointer(func)=nil) or (sp=nil) then
+ begin
+ Lfpseterrno(EsysEInval);
+ exit(-1);
+ end;
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ pushl %ebx
+ // movl flags,%ebx
+ movl $251,%eax
+ int $0x80
+ popl %ebx
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+end;
+*)
+
+Function fsync (fd : cint) : cint;
+
+begin
+ fsync:=do_syscall(syscall_nr_fsync,fd);
+end;
+
+Function fpFlock (fd,mode : longint) : cint;
+
+begin
+ fpFlock:=do_syscall(syscall_nr_flock,fd,mode);
+end;
+
+Function fStatFS(Fd:Longint;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+
+begin
+ fStatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info));
+end;
+
+Function StatFS(path:pchar;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+
+begin
+ StatFS:=do_syscall(syscall_nr_statfs,longint(path),longint(@info));
+end;
+
+// needs oldfpccall;
+Function intAssignPipe(var pipe_in,pipe_out:longint;var errn:cint):cint; {$ifndef ver1_0} oldfpccall;{$endif}
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+
+begin
+ asm
+ mov $42,%eax
+ int $0x80
+ jb .Lerror
+ mov pipe_in,%ebx
+ mov %eax,(%ebx)
+ mov pipe_out,%ebx
+ mov $0,%eax
+ mov %edx,(%ebx)
+ mov %eax,%ebx
+ jmp .Lexit
+.Lerror:
+ mov %eax,%ebx
+ mov $-1,%eax
+.Lexit:
+ mov Errn,%edx
+ mov %ebx,(%edx)
+ end;
+end;
+
+
+function MUnMap (P : Pointer; Size : size_t) : cint;
+begin
+ MUnMap:=do_syscall(syscall_nr_munmap,longint(P),Size);
+end;
+
+{
+ $Log: unxsysc.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+}
diff --git a/rtl/freebsd/x86_64/bsyscall.inc b/rtl/freebsd/x86_64/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/freebsd/x86_64/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/freebsd/x86_64/prt0.as b/rtl/freebsd/x86_64/prt0.as
new file mode 100644
index 0000000000..4d6dfd2c7a
--- /dev/null
+++ b/rtl/freebsd/x86_64/prt0.as
@@ -0,0 +1,142 @@
+ .file "crt1.c"
+#APP
+ .ident "$FreeBSD: src/lib/csu/common/crtbrand.c,v 1.4 2003/10/17 15:43:13 peter Exp $"
+#NO_APP
+ .section .note.ABI-tag,"a",@progbits
+ .p2align 2
+ .type abitag, @object
+ .size abitag, 24
+abitag:
+ .long 8
+ .long 4
+ .long 1
+ .string "FreeBSD"
+ .long 502110
+ .section .rodata
+.LC0:
+ .string ""
+.globl __progname
+ .data
+ .p2align 3
+ .type __progname, @object
+ .size __progname, 8
+__progname:
+ .quad .LC0
+ .text
+ .p2align 2,,3
+.globl _start
+ .type _start, @function
+_start:
+.LFB9:
+ pushq %rbp
+.LCFI0:
+ movq %rsp, %rbp
+.LCFI1:
+ subq $48, %rsp
+.LCFI2:
+ movq %rdi, -8(%rbp)
+ movq %rsi, -16(%rbp)
+ movq -8(%rbp), %rax
+ movl (%rax), %eax
+ movl %eax, -20(%rbp)
+ movl %eax, operatingsystem_parameter_argc
+ movq -8(%rbp), %rax
+ addq $8, %rax
+ movq %rax, -32(%rbp)
+ movq %rax, operatingsystem_parameter_argv
+ movl -20(%rbp), %eax
+ cltq
+ salq $3, %rax
+ addq -8(%rbp), %rax
+ addq $16, %rax
+ movq %rax, -40(%rbp)
+ movq %rax, operatingsystem_parameter_envp
+ movq -40(%rbp), %rax
+ movq %rax, environ(%rip)
+ movq %rax,environ
+ cmpl $0, -20(%rbp)
+ jle .L5
+ movq -32(%rbp), %rax
+ cmpq $0, (%rax)
+ je .L5
+ movq -32(%rbp), %rax
+ movq (%rax), %rax
+ movq %rax, __progname(%rip)
+ movq __progname(%rip), %rax
+ movq %rax, -48(%rbp)
+.L6:
+ movq -48(%rbp), %rax
+ cmpb $0, (%rax)
+ jne .L9
+ jmp .L5
+.L9:
+ movq -48(%rbp), %rax
+ cmpb $47, (%rax)
+ jne .L8
+ movq -48(%rbp), %rax
+ incq %rax
+ movq %rax, __progname(%rip)
+.L8:
+ leaq -48(%rbp), %rax
+ incq (%rax)
+ jmp .L6
+.L5:
+# movl $_DYNAMIC, %eax
+# testq %rax, %rax
+# je .L11
+# movq -16(%rbp), %rdi
+# call atexit
+.L11:
+# movl $_fini, %edi
+# call atexit
+# call _init
+# movq -40(%rbp), %rdx #env
+# movq -32(%rbp), %rsi #argv
+# movl -20(%rbp), %edi # argc
+ xorq %rbp,%rbp
+ call main
+ movl %eax, %edi
+ call exit
+.LFE9:
+ .size _start, .-_start
+#APP
+ .ident "$FreeBSD: src/lib/csu/amd64/crt1.c,v 1.13 2003/04/30 19:27:07 peter Exp $"
+#NO_APP
+ .comm environ,8,8
+ .weak _DYNAMIC
+ .section .eh_frame,"a",@progbits
+.Lframe1:
+ .long .LECIE1-.LSCIE1
+.LSCIE1:
+ .long 0x0
+ .byte 0x1
+ .string ""
+ .uleb128 0x1
+ .sleb128 -8
+ .byte 0x10
+ .byte 0xc
+ .uleb128 0x7
+ .uleb128 0x8
+ .byte 0x90
+ .uleb128 0x1
+ .p2align 3
+.LECIE1:
+.LSFDE1:
+ .long .LEFDE1-.LASFDE1
+.LASFDE1:
+ .long .LASFDE1-.Lframe1
+ .quad .LFB9
+ .quad .LFE9-.LFB9
+ .byte 0x4
+ .long .LCFI0-.LFB9
+ .byte 0xe
+ .uleb128 0x10
+ .byte 0x86
+ .uleb128 0x2
+ .byte 0x4
+ .long .LCFI1-.LCFI0
+ .byte 0xd
+ .uleb128 0x6
+ .p2align 3
+.LEFDE1:
+ .ident "GCC: (GNU) 3.3.3 [FreeBSD] 20031106"
diff --git a/rtl/go32v2/Makefile b/rtl/go32v2/Makefile
new file mode 100644
index 0000000000..6b813b16f1
--- /dev/null
+++ b/rtl/go32v2/Makefile
@@ -0,0 +1,2025 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=go32v2
+override CPU_TARGET_DEFAULT=i386
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+UNITPREFIX=rtl
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifdef EXCEPTIONS_IN_SYSTEM
+override FPCOPT+=-dEXCEPTIONS_IN_SYSTEM
+endif
+ifdef NO_EXCEPTIONS_IN_SYSTEM
+override FPCOPT+=-dNO_EXCEPTIONS_IN_SYSTEM
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=system objpas macpas strings go32 dpmiexcp initc ports profile dxetype dxeload emu387 dos crt objects printer graph sysutils classes math typinfo matrix cpu mmx ucomplex getopts heaptrc lineinfo msmouse charset varutils video mouse keyboard variants vesamode types sysconst rtlconst dateutil convutil strutils
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 exceptn fpu
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutil sysconst
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : v2prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) v2prt0.as
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ system$(PPUEXT)
+go32$(PPUEXT) : go32.pp system$(PPUEXT)
+dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
+ $(COMPILER) -Sg dpmiexcp.pp
+initc$(PPUEXT) : initc.pp system$(PPUEXT)
+profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
+dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT)
+dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT)
+emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
+ dpmiexcp$(PPUEXT)
+ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
+ go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) system$(PPUEXT) \
+ $(GRAPHINCDEPS) vesa.inc vesah.inc dpmi.inc
+ $(COMPILER) -Fi$(GRAPHDIR) graph.pp
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Sg -Fi$(OBJPASDIR) $(OBJPASDIR)/typinfo.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
diff --git a/rtl/go32v2/Makefile.fpc b/rtl/go32v2/Makefile.fpc
new file mode 100644
index 0000000000..2fb4b7f63a
--- /dev/null
+++ b/rtl/go32v2/Makefile.fpc
@@ -0,0 +1,157 @@
+#
+# Makefile.fpc for Go32v2 RTL
+#
+[package]
+main=rtl
+[target]
+loaders=prt0 exceptn fpu
+units=system objpas macpas strings \
+ go32 dpmiexcp initc ports profile dxetype dxeload emu387 \
+ dos crt objects printer graph \
+ sysutils classes math typinfo matrix \
+ cpu mmx ucomplex getopts heaptrc lineinfo \
+ msmouse charset varutils \
+ video mouse keyboard variants vesamode types \
+ sysconst rtlconst dateutil convutil strutils
+rsts=math varutils typinfo classes variants dateutil sysconst
+[require]
+nortl=y
+[install]
+fpcpackage=y
+[default]
+fpcdir=../..
+target=go32v2
+cpu=i386
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+[prerules]
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+UNITPREFIX=rtl
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+# Insert exception handler in system unit
+ifdef EXCEPTIONS_IN_SYSTEM
+override FPCOPT+=-dEXCEPTIONS_IN_SYSTEM
+endif
+# Insert exception handler in system unit
+ifdef NO_EXCEPTIONS_IN_SYSTEM
+override FPCOPT+=-dNO_EXCEPTIONS_IN_SYSTEM
+endif
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+#
+# Loaders
+#
+prt0$(OEXT) : v2prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) v2prt0.as
+#
+# System Units (System, Objpas, Strings)
+#
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ system$(PPUEXT)
+#
+# System Dependent Units
+#
+go32$(PPUEXT) : go32.pp system$(PPUEXT)
+dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
+ $(COMPILER) -Sg dpmiexcp.pp
+initc$(PPUEXT) : initc.pp system$(PPUEXT)
+profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
+dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT)
+dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT)
+emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
+ dpmiexcp$(PPUEXT)
+ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+#
+# TP7 Compatible RTL Units
+#
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
+ go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
+#
+# Graph
+#
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) system$(PPUEXT) \
+ $(GRAPHINCDEPS) vesa.inc vesah.inc dpmi.inc
+ $(COMPILER) -Fi$(GRAPHDIR) graph.pp
+#
+# Delphi Compatible Units
+#
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Sg -Fi$(OBJPASDIR) $(OBJPASDIR)/typinfo.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+#
+# Mac Pascal Model
+#
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+#
+# Other system-independent RTL Units
+#
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+#
+# Other system-dependent RTL Units
+#
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
diff --git a/rtl/go32v2/classes.pp b/rtl/go32v2/classes.pp
new file mode 100644
index 0000000000..f5689f4cc6
--- /dev/null
+++ b/rtl/go32v2/classes.pp
@@ -0,0 +1,54 @@
+{
+ $Id: classes.pp,v 1.5 2005/04/17 17:33:40 hajny Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for win32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ typinfo,
+ rtlconsts,
+ types,
+ sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.5 2005/04/17 17:33:40 hajny
+ * more rtlconst/s fixes
+
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/crt.pp b/rtl/go32v2/crt.pp
new file mode 100644
index 0000000000..508b51588a
--- /dev/null
+++ b/rtl/go32v2/crt.pp
@@ -0,0 +1,776 @@
+{
+ $Id: crt.pp,v 1.12 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Borland Pascal 7 Compatible CRT Unit - Go32V2 implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit crt;
+
+interface
+
+{$i crth.inc}
+
+Var
+ ScreenWidth,
+ ScreenHeight : longint;
+
+implementation
+
+uses
+ go32;
+
+{$ASMMODE ATT}
+
+var
+ DelayCnt : Longint;
+ VidSeg : Word;
+
+{
+ definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
+
+
+{****************************************************************************
+ Low level Routines
+****************************************************************************}
+
+procedure setscreenmode(mode : byte);
+var
+ regs : trealregs;
+begin
+ regs.realeax:=mode;
+ realintr($10,regs);
+end;
+
+
+function GetScreenHeight : longint;
+begin
+ getscreenheight:=mem[$40:$84]+1;
+ If mem[$40:$84]=0 then
+ getscreenheight := 25;
+end;
+
+
+function GetScreenWidth : longint;
+begin
+ getscreenwidth:=memw[$40:$4a];
+end;
+
+
+procedure SetScreenCursor(x,y : longint);
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0200;
+ regs.realebx:=0;
+ regs.realedx:=(y-1) shl 8+(x-1);
+ realintr($10,regs);
+end;
+
+
+procedure GetScreenCursor(var x,y : longint);
+begin
+ x:=mem[$40:$50]+1;
+ y:=mem[$40:$51]+1;
+end;
+
+
+{****************************************************************************
+ Helper Routines
+****************************************************************************}
+
+Function WinMinX: Byte;
+{
+ Current Minimum X coordinate
+}
+Begin
+ WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Byte;
+{
+ Current Minimum Y Coordinate
+}
+Begin
+ WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Byte;
+{
+ Current Maximum X coordinate
+}
+Begin
+ WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Byte;
+{
+ Current Maximum Y coordinate;
+}
+Begin
+ WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+
+Function FullWin:boolean;
+{
+ Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+ FullWin:=(WinMinX=1) and (WinMinY=1) and
+ (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
+end;
+
+
+{****************************************************************************
+ Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+
+var
+ regs : trealregs;
+
+begin
+ lastmode:=mode;
+ mode:=mode and $ff;
+ setscreenmode(mode);
+
+ { set 8x8 font }
+ if (lastmode and $100)<>0 then
+ begin
+ regs.realeax:=$1112;
+ regs.realebx:=$0;
+ realintr($10,regs);
+ end;
+
+ screenwidth:=getscreenwidth;
+ screenheight:=getscreenheight;
+ windmin:=0;
+ windmax:=(screenwidth-1) or ((screenheight-1) shl 8);
+end;
+
+
+Procedure TextColor(Color: Byte);
+{
+ Switch foregroundcolor
+}
+Begin
+ TextAttr:=(Color and $f) or (TextAttr and $70);
+ If (Color>15) Then TextAttr:=TextAttr Or Blink;
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+ Switch backgroundcolor
+}
+Begin
+ TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+End;
+
+
+
+Procedure HighVideo;
+{
+ Set highlighted output.
+}
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+ Set normal output
+}
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+ Set normal back and foregroundcolors.
+}
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+ Go to coordinates X,Y in the current window.
+}
+Begin
+ If (X>0) and (X<=WinMaxX- WinMinX+1) and
+ (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+ Begin
+ Inc(X,WinMinX-1);
+ Inc(Y,WinMinY-1);
+ SetScreenCursor(x,y);
+ End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+ Set screen window to the specified coordinates.
+}
+Begin
+ if (X1>X2) or (X2>ScreenWidth) or
+ (Y1>Y2) or (Y2>ScreenHeight) then
+ exit;
+ WindMin:=((Y1-1) Shl 8)+(X1-1);
+ WindMax:=((Y2-1) Shl 8)+(X2-1);
+ GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+ Clear the current window, and set the cursor on 1,1
+}
+var
+ fil : word;
+ y : longint;
+begin
+ fil:=32 or (textattr shl 8);
+ if FullWin then
+ DosmemFillWord(VidSeg,0,ScreenHeight*ScreenWidth,fil)
+ else
+ begin
+ for y:=WinMinY to WinMaxY do
+ DosmemFillWord(VidSeg,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil);
+ end;
+ Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+ Clear from current position to end of line.
+}
+var
+ x,y : longint;
+ fil : word;
+Begin
+ GetScreenCursor(x,y);
+ fil:=32 or (textattr shl 8);
+ if x<=WinMaxX then
+ DosmemFillword(VidSeg,((y-1)*ScreenWidth+(x-1))*2,WinMaxX-x+1,fil);
+End;
+
+
+
+Function WhereX: Byte;
+{
+ Return current X-position of cursor.
+}
+var
+ x,y : longint;
+Begin
+ GetScreenCursor(x,y);
+ WhereX:=x-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+ Return current Y-position of cursor.
+}
+var
+ x,y : longint;
+Begin
+ GetScreenCursor(x,y);
+ WhereY:=y-WinMinY+1;
+End;
+
+
+{*************************************************************************
+ KeyBoard
+*************************************************************************}
+
+var
+ is_last : boolean;
+ last : char;
+
+function readkey : char;
+var
+ char2 : char;
+ char1 : char;
+ regs : trealregs;
+begin
+ if is_last then
+ begin
+ is_last:=false;
+ readkey:=last;
+ end
+ else
+ begin
+ regs.ah:=$10;
+ realintr($16,regs);
+ if (regs.al=$e0) and (regs.ah<>0) then
+ regs.al:=0;
+ char1:=chr(regs.al);
+ char2:=chr(regs.ah);
+ if char1=#0 then
+ begin
+ is_last:=true;
+ last:=char2;
+ end;
+ readkey:=char1;
+ end;
+end;
+
+
+function keypressed : boolean;
+var
+ regs : trealregs;
+begin
+ if is_last then
+ begin
+ keypressed:=true;
+ exit;
+ end
+ else
+ begin
+ regs.ah:=$11;
+ realintr($16,regs);
+ keypressed:=((regs.realflags and zeroflag) = 0);
+ end;
+end;
+
+
+{*************************************************************************
+ Delay
+*************************************************************************}
+
+procedure Delayloop;assembler;
+asm
+.LDelayLoop1:
+ subl $1,%eax
+ jc .LDelayLoop2
+ cmpl %fs:(%edi),%ebx
+ je .LDelayLoop1
+.LDelayLoop2:
+end;
+
+
+procedure initdelay;assembler;
+asm
+ pushl %ebx
+ pushl %edi
+ { for some reason, using int $31/ax=$901 doesn't work here }
+ { and interrupts are always disabled at this point when }
+ { running a program inside gdb(pas). Web bug 1345 (JM) }
+ sti
+ movl $0x46c,%edi
+ movl $-28,%edx
+ movl %fs:(%edi),%ebx
+.LInitDel1:
+ cmpl %fs:(%edi),%ebx
+ je .LInitDel1
+ movl %fs:(%edi),%ebx
+ movl %edx,%eax
+ call DelayLoop
+
+ notl %eax
+ xorl %edx,%edx
+ movl $55,%ecx
+ divl %ecx
+ movl %eax,DelayCnt
+ popl %edi
+ popl %ebx
+end;
+
+
+procedure Delay(MS: Word);assembler;
+asm
+ pushl %ebx
+ pushl %edi
+ movzwl MS,%ecx
+ jecxz .LDelay2
+ movl $0x400,%edi
+ movl DelayCnt,%edx
+ movl %fs:(%edi),%ebx
+.LDelay1:
+ movl %edx,%eax
+ call DelayLoop
+ loop .LDelay1
+.LDelay2:
+ popl %edi
+ popl %ebx
+end;
+
+
+procedure sound(hz : word);
+begin
+ if hz=0 then
+ begin
+ nosound;
+ exit;
+ end;
+ asm
+ movzwl hz,%ecx
+ movl $1193046,%eax
+ cltd
+ divl %ecx
+ movl %eax,%ecx
+ inb $0x61,%al
+ testb $0x3,%al
+ jnz .Lsound_next
+ orb $0x3,%al
+ outb %al,$0x61
+ movb $0xb6,%al
+ outb %al,$0x43
+ .Lsound_next:
+ movb %cl,%al
+ outb %al,$0x42
+ movb %ch,%al
+ outb %al,$0x42
+ end ['EAX','ECX','EDX'];
+end;
+
+
+procedure nosound;
+begin
+ asm
+ inb $0x61,%al
+ andb $0xfc,%al
+ outb %al,$0x61
+ end ['EAX'];
+end;
+
+
+
+{****************************************************************************
+ HighLevel Crt Functions
+****************************************************************************}
+
+procedure removeline(y : longint);
+var
+ fil : word;
+begin
+ fil:=32 or (textattr shl 8);
+ y:=WinMinY+y-1;
+ While (y<WinMaxY) do
+ begin
+ dosmemmove(VidSeg,(y*ScreenWidth+(WinMinX-1))*2,
+ VidSeg,((y-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+ inc(y);
+ end;
+ dosmemfillword(VidSeg,((WinMaxY-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+procedure delline;
+begin
+ removeline(wherey);
+end;
+
+
+procedure insline;
+var
+ my,y : longint;
+ fil : word;
+begin
+ fil:=32 or (textattr shl 8);
+ y:=WhereY;
+ my:=WinMaxY-WinMinY;
+ while (my>=y) do
+ begin
+ dosmemmove(VidSeg,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2,
+ VidSeg,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+ dec(my);
+ end;
+ dosmemfillword(VidSeg,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0100;
+ regs.realecx:=$90A;
+ If VidSeg=$b800 then
+ regs.realecx:=$90A
+ else
+ regs.realecx:=$b0d;
+ realintr($10,regs);
+end;
+
+
+procedure cursoroff;
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0100;
+ regs.realecx:=$ffff;
+ realintr($10,regs);
+end;
+
+
+procedure cursorbig;
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0100;
+ regs.realecx:=$10A;
+ realintr($10,regs);
+end;
+
+
+{*****************************************************************************
+ Read and Write routines
+*****************************************************************************}
+
+var
+ CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var
+ regs : trealregs;
+begin
+ case c of
+ #10 : inc(CurrY);
+ #13 : CurrX:=WinMinX;
+ #8 : begin
+ if CurrX>WinMinX then
+ dec(CurrX);
+ end;
+ #7 : begin { beep }
+ regs.dl:=7;
+ regs.ah:=2;
+ realintr($21,regs);
+ end;
+ else
+ begin
+ memw[VidSeg:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c);
+ inc(CurrX);
+ end;
+ end;
+ if CurrX>WinMaxX then
+ begin
+ CurrX:=WinMinX;
+ inc(CurrY);
+ end;
+ while CurrY>WinMaxY do
+ begin
+ removeline(1);
+ dec(CurrY);
+ end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+ i : longint;
+begin
+ GetScreenCursor(CurrX,CurrY);
+ for i:=0 to f.bufpos-1 do
+ WriteChar(f.buffer[i]);
+ SetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+ procedure BackSpace;
+ begin
+ if (f.bufpos>0) and (f.bufpos=f.bufend) then
+ begin
+ WriteChar(#8);
+ WriteChar(' ');
+ WriteChar(#8);
+ dec(f.bufpos);
+ dec(f.bufend);
+ end;
+ end;
+
+var
+ ch : Char;
+Begin
+ GetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ f.bufend:=0;
+ repeat
+ if f.bufpos>f.bufend then
+ f.bufend:=f.bufpos;
+ SetScreenCursor(CurrX,CurrY);
+ ch:=readkey;
+ case ch of
+ #0 : case readkey of
+ #71 : while f.bufpos>0 do
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #75 : if f.bufpos>0 then
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #77 : if f.bufpos<f.bufend then
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #79 : while f.bufpos<f.bufend do
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ end;
+ ^S,
+ #8 : BackSpace;
+ ^Y,
+ #27 : begin
+ while f.bufpos<f.bufend do begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ while f.bufend>0 do
+ BackSpace;
+ end;
+ #13 : begin
+ WriteChar(#13);
+ WriteChar(#10);
+ f.bufptr^[f.bufend]:=#13;
+ f.bufptr^[f.bufend+1]:=#10;
+ inc(f.bufend,2);
+ break;
+ end;
+ #26 : if CheckEOF then
+ begin
+ f.bufptr^[f.bufend]:=#26;
+ inc(f.bufend);
+ break;
+ end;
+ else
+ begin
+ if f.bufpos<f.bufsize-2 then
+ begin
+ f.buffer[f.bufpos]:=ch;
+ inc(f.bufpos);
+ WriteChar(ch);
+ end;
+ end;
+ end;
+ until false;
+ f.bufpos:=0;
+ SetScreenCursor(CurrX,CurrY);
+ CrtRead:=0;
+End;
+
+
+Function CrtReturn(Var F: TextRec): Integer;
+Begin
+ CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+ If F.Mode=fmOutput Then
+ begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end
+ Else
+ begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+{ use the C version to avoid using dpmiexcp unit
+ which makes sysutils and exceptions working incorrectly PM }
+
+function __djgpp_set_ctrl_c(enable : longint) : boolean;cdecl;external;
+
+var
+ x,y : longint;
+begin
+{ Load startup values }
+ ScreenWidth:=GetScreenWidth;
+ ScreenHeight:=GetScreenHeight;
+ WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
+{ Load TextAttr }
+ GetScreenCursor(x,y);
+ lastmode := mem[$40:$49];
+ if screenheight>25 then
+ lastmode:=lastmode or $100;
+ If not(lastmode=Mono) then
+ VidSeg := $b800
+ else
+ VidSeg := $b000;
+ TextAttr:=mem[VidSeg:((y-1)*ScreenWidth+(x-1))*2+1];
+{ Redirect the standard output }
+ assigncrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:=StdOutputHandle;
+ assigncrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:=StdInputHandle;
+{ Calculates delay calibration }
+ initdelay;
+{ Enable ctrl-c input (JM) }
+ __djgpp_set_ctrl_c(0);
+end.
+
+{
+ $Log: crt.pp,v $
+ Revision 1.12 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/dos.pp b/rtl/go32v2/dos.pp
new file mode 100644
index 0000000000..2eb24e7074
--- /dev/null
+++ b/rtl/go32v2/dos.pp
@@ -0,0 +1,847 @@
+{
+ $Id: dos.pp,v 1.23 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Dos unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+
+interface
+
+Uses
+ Go32;
+
+Type
+ searchrec = packed record
+ fill : array[1..21] of byte;
+ attr : byte;
+ time : longint;
+ { reserved : word; not in DJGPP V2 }
+ size : longint;
+ name : string[255]; { LFN Name, DJGPP uses only [12] but more can't hurt (PFV) }
+ end;
+
+{$DEFINE HAS_REGISTERS}
+ Registers = Go32.Registers;
+
+{$i dosh.inc}
+
+implementation
+
+uses
+ strings;
+
+{$DEFINE HAS_GETMSCOUNT}
+{$DEFINE HAS_INTR}
+{$DEFINE HAS_SETCBREAK}
+{$DEFINE HAS_GETCBREAK}
+{$DEFINE HAS_SETVERIFY}
+{$DEFINE HAS_GETVERIFY}
+{$DEFINE HAS_SWAPVECTORS}
+{$DEFINE HAS_GETSHORTNAME}
+{$DEFINE HAS_GETLONGNAME}
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+{$I dos.inc}
+
+{******************************************************************************
+ --- Dos Interrupt ---
+******************************************************************************}
+
+var
+ dosregs : registers;
+
+procedure LoadDosError;
+var
+ r : registers;
+ SimpleDosError : word;
+begin
+ if (dosregs.flags and fcarry) <> 0 then
+ begin
+ { I got a extended error = 0
+ while CarryFlag was set from Exec function }
+ SimpleDosError:=dosregs.ax;
+ r.eax:=$5900;
+ r.ebx:=$0;
+ realintr($21,r);
+ { conversion from word to integer !!
+ gave a Bound check error if ax is $FFFF !! PM }
+ doserror:=integer(r.ax);
+ case doserror of
+ 0 : DosError:=integer(SimpleDosError);
+ 19 : DosError:=150;
+ 21 : DosError:=152;
+ end;
+ end
+ else
+ doserror:=0;
+end;
+
+
+procedure intr(intno : byte;var regs : registers);
+begin
+ realintr(intno,regs);
+end;
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+function dosversion : word;
+begin
+ dosregs.ax:=$3000;
+ msdos(dosregs);
+ dosversion:=dosregs.ax;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+begin
+ dosregs.ax:=$2a00;
+ msdos(dosregs);
+ wday:=dosregs.al;
+ year:=dosregs.cx;
+ month:=dosregs.dh;
+ mday:=dosregs.dl;
+end;
+
+
+procedure setdate(year,month,day : word);
+begin
+ dosregs.cx:=year;
+ dosregs.dh:=month;
+ dosregs.dl:=day;
+ dosregs.ah:=$2b;
+ msdos(dosregs);
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+begin
+ dosregs.ah:=$2c;
+ msdos(dosregs);
+ hour:=dosregs.ch;
+ minute:=dosregs.cl;
+ second:=dosregs.dh;
+ sec100:=dosregs.dl;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+begin
+ dosregs.ch:=hour;
+ dosregs.cl:=minute;
+ dosregs.dh:=second;
+ dosregs.dl:=sec100;
+ dosregs.ah:=$2d;
+ msdos(dosregs);
+end;
+
+
+function GetMsCount: int64;
+begin
+ GetMsCount := MemL [$40:$6c] * 55;
+end;
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+procedure exec(const path : pathstr;const comline : comstr);
+type
+ realptr = packed record
+ ofs,seg : word;
+ end;
+ texecblock = packed record
+ envseg : word;
+ comtail : realptr;
+ firstFCB : realptr;
+ secondFCB : realptr;
+ iniStack : realptr;
+ iniCSIP : realptr;
+ end;
+var
+ current_dos_buffer_pos,
+ arg_ofs,
+ i,la_env,
+ la_p,la_c,la_e,
+ fcb1_la,fcb2_la : longint;
+ execblock : texecblock;
+ c,p : string;
+
+ function paste_to_dos(src : string) : boolean;
+ var
+ c : array[0..255] of char;
+ begin
+ paste_to_dos:=false;
+ if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
+ RunError(217);
+ move(src[1],c[0],length(src));
+ c[length(src)]:=#0;
+ seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
+ current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
+ paste_to_dos:=true;
+ end;
+
+begin
+{ create command line }
+ move(comline[0],c[1],length(comline)+1);
+ c[length(comline)+2]:=#13;
+ c[0]:=char(length(comline)+2);
+{ create path }
+ p:=path;
+ for i:=1 to length(p) do
+ if p[i]='/' then
+ p[i]:='\';
+ if LFNSupport then
+ GetShortName(p);
+{ create buffer }
+ la_env:=transfer_buffer;
+ while (la_env and 15)<>0 do
+ inc(la_env);
+ current_dos_buffer_pos:=la_env;
+{ copy environment }
+ for i:=1 to envcount do
+ paste_to_dos(envstr(i));
+ paste_to_dos(''); { adds a double zero at the end }
+{ allow slash as backslash }
+ la_p:=current_dos_buffer_pos;
+ paste_to_dos(p);
+ la_c:=current_dos_buffer_pos;
+ paste_to_dos(c);
+ la_e:=current_dos_buffer_pos;
+ fcb1_la:=la_e;
+ la_e:=la_e+16;
+ fcb2_la:=la_e;
+ la_e:=la_e+16;
+{ allocate FCB see dosexec code }
+ arg_ofs:=1;
+ while (c[arg_ofs] in [' ',#9]) do
+ inc(arg_ofs);
+ dosregs.ax:=$2901;
+ dosregs.ds:=(la_c+arg_ofs) shr 4;
+ dosregs.esi:=(la_c+arg_ofs) and 15;
+ dosregs.es:=fcb1_la shr 4;
+ dosregs.edi:=fcb1_la and 15;
+ msdos(dosregs);
+{ allocate second FCB see dosexec code }
+ repeat
+ inc(arg_ofs);
+ until (c[arg_ofs] in [' ',#9,#13]);
+ if c[arg_ofs]<>#13 then
+ begin
+ repeat
+ inc(arg_ofs);
+ until not (c[arg_ofs] in [' ',#9]);
+ end;
+ dosregs.ax:=$2901;
+ dosregs.ds:=(la_c+arg_ofs) shr 4;
+ dosregs.si:=(la_c+arg_ofs) and 15;
+ dosregs.es:=fcb2_la shr 4;
+ dosregs.di:=fcb2_la and 15;
+ msdos(dosregs);
+ with execblock do
+ begin
+ envseg:=la_env shr 4;
+ comtail.seg:=la_c shr 4;
+ comtail.ofs:=la_c and 15;
+ firstFCB.seg:=fcb1_la shr 4;
+ firstFCB.ofs:=fcb1_la and 15;
+ secondFCB.seg:=fcb2_la shr 4;
+ secondFCB.ofs:=fcb2_la and 15;
+ end;
+ seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
+ dosregs.edx:=la_p and 15;
+ dosregs.ds:=la_p shr 4;
+ dosregs.ebx:=la_e and 15;
+ dosregs.es:=la_e shr 4;
+ dosregs.ax:=$4b00;
+ msdos(dosregs);
+ LoadDosError;
+ if DosError=0 then
+ begin
+ dosregs.ax:=$4d00;
+ msdos(dosregs);
+ LastDosExitCode:=DosRegs.al
+ end
+ else
+ LastDosExitCode:=0;
+end;
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+ dosregs.ax:=$3300;
+ msdos(dosregs);
+ breakvalue:=dosregs.dl<>0;
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+ dosregs.ax:=$3301;
+ dosregs.dl:=ord(breakvalue);
+ msdos(dosregs);
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+ dosregs.ah:=$54;
+ msdos(dosregs);
+ verify:=dosregs.al<>0;
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+ dosregs.ah:=$2e;
+ dosregs.al:=ord(verify);
+ msdos(dosregs);
+end;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+
+TYPE ExtendedFat32FreeSpaceRec=packed Record
+ RetSize : WORD; { (ret) size of returned structure}
+ Strucversion : WORD; {(call) structure version (0000h)
+ (ret) actual structure version (0000h)}
+ SecPerClus, {number of sectors per cluster}
+ BytePerSec, {number of bytes per sector}
+ AvailClusters, {number of available clusters}
+ TotalClusters, {total number of clusters on the drive}
+ AvailPhysSect, {physical sectors available on the drive}
+ TotalPhysSect, {total physical sectors on the drive}
+ AvailAllocUnits, {Available allocation units}
+ TotalAllocUnits : DWORD; {Total allocation units}
+ Dummy,Dummy2 : DWORD; {8 bytes reserved}
+ END;
+
+function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
+VAR
+ S : String;
+ Rec : ExtendedFat32FreeSpaceRec;
+BEGIN
+ if (swap(dosversion)>=$070A) AND LFNSupport then
+ begin
+ S:='C:\'#0;
+ if Drive=0 then
+ begin
+ GetDir(Drive,S);
+ Setlength(S,4);
+ S[4]:=#0;
+ end
+ else
+ S[1]:=chr(Drive+64);
+ Rec.Strucversion:=0;
+ dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
+ dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
+ dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
+ dosregs.ds:=tb_segment;
+ dosregs.di:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
+ dosregs.ax:=$7303;
+ msdos(dosregs);
+ if (dosregs.flags and fcarry) = 0 then {No error clausule in int except cf}
+ begin
+ copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
+ if Free then
+ Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
+ else
+ Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
+ end
+ else
+ Do_DiskData:=-1;
+ end
+ else
+ begin
+ dosregs.dl:=drive;
+ dosregs.ah:=$36;
+ msdos(dosregs);
+ if dosregs.ax<>$FFFF then
+ begin
+ if Free then
+ Do_DiskData:=int64(dosregs.ax)*dosregs.bx*dosregs.cx
+ else
+ Do_DiskData:=int64(dosregs.ax)*dosregs.cx*dosregs.dx;
+ end
+ else
+ do_diskdata:=-1;
+ end;
+end;
+
+function diskfree(drive : byte) : int64;
+begin
+ diskfree:=Do_DiskData(drive,TRUE);
+end;
+
+
+function disksize(drive : byte) : int64;
+begin
+ disksize:=Do_DiskData(drive,false);
+end;
+
+
+{******************************************************************************
+ --- LFNFindfirst LFNFindNext ---
+******************************************************************************}
+
+type
+ LFNSearchRec=packed record
+ attr,
+ crtime,
+ crtimehi,
+ actime,
+ actimehi,
+ lmtime,
+ lmtimehi,
+ sizehi,
+ size : longint;
+ reserved : array[0..7] of byte;
+ name : array[0..259] of byte;
+ shortname : array[0..13] of byte;
+ end;
+
+procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec;from_findfirst : boolean);
+var
+ Len : longint;
+begin
+ With w do
+ begin
+ FillChar(d,sizeof(SearchRec),0);
+ if DosError=0 then
+ len:=StrLen(@Name)
+ else
+ len:=0;
+ d.Name[0]:=chr(len);
+ Move(Name[0],d.Name[1],Len);
+ d.Time:=lmTime;
+ d.Size:=Size;
+ d.Attr:=Attr and $FF;
+ if (DosError<>0) and from_findfirst then
+ hdl:=-1;
+ Move(hdl,d.Fill,4);
+ end;
+end;
+
+
+procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
+var
+ i : longint;
+ w : LFNSearchRec;
+begin
+ { allow slash as backslash }
+ for i:=0 to strlen(path) do
+ if path[i]='/' then path[i]:='\';
+ dosregs.si:=1; { use ms-dos time }
+ { don't include the label if not asked for it, needed for network drives }
+ if attr=$8 then
+ dosregs.ecx:=8
+ else
+ dosregs.ecx:=attr and (not 8);
+ dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
+ dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
+ dosregs.ds:=tb_segment;
+ dosregs.edi:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.ax:=$714e;
+ msdos(dosregs);
+ LoadDosError;
+ copyfromdos(w,sizeof(LFNSearchRec));
+ LFNSearchRec2Dos(w,dosregs.ax,s,true);
+end;
+
+
+procedure LFNFindNext(var s:searchrec);
+var
+ hdl : longint;
+ w : LFNSearchRec;
+begin
+ Move(s.Fill,hdl,4);
+ dosregs.si:=1; { use ms-dos time }
+ dosregs.edi:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.ebx:=hdl;
+ dosregs.ax:=$714f;
+ msdos(dosregs);
+ LoadDosError;
+ copyfromdos(w,sizeof(LFNSearchRec));
+ LFNSearchRec2Dos(w,hdl,s,false);
+end;
+
+
+procedure LFNFindClose(var s:searchrec);
+var
+ hdl : longint;
+begin
+ Move(s.Fill,hdl,4);
+ { Do not call MsDos if FindFirst returned with an error }
+ if hdl=-1 then
+ begin
+ DosError:=0;
+ exit;
+ end;
+ dosregs.ebx:=hdl;
+ dosregs.ax:=$71a1;
+ msdos(dosregs);
+ LoadDosError;
+end;
+
+
+{******************************************************************************
+ --- DosFindfirst DosFindNext ---
+******************************************************************************}
+
+procedure dossearchrec2searchrec(var f : searchrec);
+var
+ len : longint;
+begin
+ { Check is necessary!! OS/2's VDM doesn't clear the name with #0 if the }
+ { file doesn't exist! (JM) }
+ if dosError = 0 then
+ len:=StrLen(@f.Name)
+ else len := 0;
+ Move(f.Name[0],f.Name[1],Len);
+ f.Name[0]:=chr(len);
+end;
+
+
+procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
+var
+ i : longint;
+begin
+ { allow slash as backslash }
+ for i:=0 to strlen(path) do
+ if path[i]='/' then path[i]:='\';
+ copytodos(f,sizeof(searchrec));
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ dosregs.ah:=$1a;
+ msdos(dosregs);
+ dosregs.ecx:=attr;
+ dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
+ dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
+ dosregs.ds:=tb_segment;
+ dosregs.ah:=$4e;
+ msdos(dosregs);
+ copyfromdos(f,sizeof(searchrec));
+ LoadDosError;
+ dossearchrec2searchrec(f);
+end;
+
+
+procedure Dosfindnext(var f : searchrec);
+begin
+ copytodos(f,sizeof(searchrec));
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ dosregs.ah:=$1a;
+ msdos(dosregs);
+ dosregs.ah:=$4f;
+ msdos(dosregs);
+ copyfromdos(f,sizeof(searchrec));
+ LoadDosError;
+ dossearchrec2searchrec(f);
+end;
+
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+ path0 : array[0..256] of char;
+begin
+ doserror:=0;
+ strpcopy(path0,path);
+ if LFNSupport then
+ LFNFindFirst(path0,attr,f)
+ else
+ Dosfindfirst(path0,attr,f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+ doserror:=0;
+ if LFNSupport then
+ LFNFindnext(f)
+ else
+ Dosfindnext(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+ DosError:=0;
+ if LFNSupport then
+ LFNFindClose(f);
+end;
+
+
+type swap_proc = procedure;
+
+var
+ _swap_in : swap_proc;external name '_swap_in';
+ _swap_out : swap_proc;external name '_swap_out';
+ _exception_exit : pointer;external name '_exception_exit';
+ _v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
+
+procedure swapvectors;
+begin
+ if _exception_exit<>nil then
+ if _v2prt0_exceptions_on then
+ _swap_out()
+ else
+ _swap_in();
+end;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+ i,p1 : longint;
+ s : searchrec;
+ newdir : pathstr;
+begin
+{ check if the file specified exists }
+ findfirst(path,anyfile and not(directory),s);
+ if doserror=0 then
+ begin
+ findclose(s);
+ fsearch:=path;
+ exit;
+ end;
+{ No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow slash as backslash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='/' then dirlist[i]:='\';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+ newdir:=newdir+'\';
+ findfirst(newdir+path,anyfile and not(directory),s);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
+ end;
+ findclose(s);
+end;
+
+
+{ change to short filename if successful DOS call PM }
+function GetShortName(var p : String) : boolean;
+var
+ c : array[0..255] of char;
+begin
+ move(p[1],c[0],length(p));
+ c[length(p)]:=#0;
+ copytodos(c,length(p)+1);
+ dosregs.ax:=$7160;
+ dosregs.cx:=1;
+ dosregs.ds:=tb_segment;
+ dosregs.si:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.di:=tb_offset;
+ msdos(dosregs);
+ LoadDosError;
+ if DosError=0 then
+ begin
+ copyfromdos(c,255);
+ move(c[0],p[1],strlen(c));
+ p[0]:=char(strlen(c));
+ GetShortName:=true;
+ end
+ else
+ GetShortName:=false;
+end;
+
+
+{ change to long filename if successful DOS call PM }
+function GetLongName(var p : String) : boolean;
+var
+ c : array[0..255] of char;
+begin
+ move(p[1],c[0],length(p));
+ c[length(p)]:=#0;
+ copytodos(c,length(p)+1);
+ dosregs.ax:=$7160;
+ dosregs.cx:=2;
+ dosregs.ds:=tb_segment;
+ dosregs.si:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.di:=tb_offset;
+ msdos(dosregs);
+ LoadDosError;
+ if DosError=0 then
+ begin
+ copyfromdos(c,255);
+ move(c[0],p[1],strlen(c));
+ p[0]:=char(strlen(c));
+ GetLongName:=true;
+ end
+ else
+ GetLongName:=false;
+end;
+
+
+{******************************************************************************
+ --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+begin
+ dosregs.bx:=textrec(f).handle;
+ dosregs.ax:=$5700;
+ msdos(dosregs);
+ loaddoserror;
+ time:=(dosregs.dx shl 16)+dosregs.cx;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+ dosregs.bx:=textrec(f).handle;
+ dosregs.cx:=time and $ffff;
+ dosregs.dx:=time shr 16;
+ dosregs.ax:=$5701;
+ msdos(dosregs);
+ loaddoserror;
+end;
+
+
+procedure getfattr(var f;var attr : word);
+begin
+ copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ if LFNSupport then
+ begin
+ dosregs.ax:=$7143;
+ dosregs.bx:=0;
+ end
+ else
+ dosregs.ax:=$4300;
+ msdos(dosregs);
+ LoadDosError;
+ Attr:=dosregs.cx;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+ copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ if LFNSupport then
+ begin
+ dosregs.ax:=$7143;
+ dosregs.bx:=1;
+ end
+ else
+ dosregs.ax:=$4301;
+ dosregs.cx:=attr;
+ msdos(dosregs);
+ LoadDosError;
+end;
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+function envcount : longint;
+var
+ hp : ppchar;
+begin
+ hp:=envp;
+ envcount:=0;
+ while assigned(hp^) do
+ begin
+ inc(envcount);
+ inc(hp);
+ end;
+end;
+
+
+function envstr (Index: longint): string;
+begin
+ if (index<=0) or (index>envcount) then
+ begin
+ envstr:='';
+ exit;
+ end;
+ envstr:=strpas(ppchar(pointer(envp)+4*(index-1))^);
+end;
+
+
+Function GetEnv(envvar: string): string;
+var
+ hp : ppchar;
+ hs : string;
+ eqpos : longint;
+begin
+ envvar:=upcase(envvar);
+ hp:=envp;
+ getenv:='';
+ while assigned(hp^) do
+ begin
+ hs:=strpas(hp^);
+ eqpos:=pos('=',hs);
+ if upcase(copy(hs,1,eqpos-1))=envvar then
+ begin
+ getenv:=copy(hs,eqpos+1,255);
+ exit;
+ end;
+ inc(hp);
+ end;
+end;
+
+
+end.
+{
+ $Log: dos.pp,v $
+ Revision 1.23 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/dpmi.inc b/rtl/go32v2/dpmi.inc
new file mode 100644
index 0000000000..80174a00aa
--- /dev/null
+++ b/rtl/go32v2/dpmi.inc
@@ -0,0 +1,51 @@
+{
+ $Id: dpmi.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+TYPE
+ TDPMIRegisters = record
+ EDI, ESI, EBP, Reserved, EBX, EDX, ECX, EAX : longint;
+ Flags, ES, DS, FS, GS, IP, CS, SP, SS : word;
+ end;
+
+
+
+Procedure RealIntr(IntNo : word; var Regs:TDPMIRegisters); assembler;
+(*********************************************************************)
+(* PROCEDURE RealModeInt(IntNo: word; Var Regs: TDPMIRegisters) *)
+(* Calls the DPMI server to switch to real mode and call the *)
+(* real mode interrupt. ALL MEMORY REGISTERS (if used) SHOULD *)
+(* contain REAL MODE ADRESSES! *)
+(* IntNo -> Real mode interrupt to call (0-255) *)
+(* Regs -> Registers to pass on to interrupt. *)
+(* (ALL UNUSED REGISTERS SHOULD BE SET TO 0 ON ENTRY!) *)
+(*********************************************************************)
+asm
+ PUSH BP { Save BP, just in case }
+ MOV BX,IntNo { Move the Interrupt number into BX }
+ XOR CX,CX { Clear CX }
+ LES DI,Regs { Load the registers into ES:DI }
+ MOV AX,$300 { Set function number to 300h }
+ INT $31 { Call Interrupt 31h - DPMI Services }
+ JC @Exit { Jump to exit on carry }
+ XOR AX,AX { Clear AX }
+ @Exit: { Exit label }
+ POP BP { Restore BP }
+ end;
+
+{
+ $Log: dpmi.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/dpmiexcp.pp b/rtl/go32v2/dpmiexcp.pp
new file mode 100644
index 0000000000..d02cd0d772
--- /dev/null
+++ b/rtl/go32v2/dpmiexcp.pp
@@ -0,0 +1,1622 @@
+{
+ $Id: dpmiexcp.pp,v 1.18 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller
+
+ DPMI Exception routines for Go32V2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef IN_SYSTEM}
+{$GOTO ON}
+{$define IN_DPMIEXCP_UNIT}
+{$ifndef NO_EXCEPTIONS_IN_SYSTEM}
+{$define EXCEPTIONS_IN_SYSTEM}
+{$endif NO_EXCEPTIONS_IN_SYSTEM}
+
+Unit DpmiExcp;
+
+{ If linking to C code we must avoid loading of the dpmiexcp.o
+ in libc.a from the equivalent C code
+ => all global functions from dpmiexcp.c must be aliased PM
+
+ Problem this is only valid for DJGPP v2.01 }
+
+
+interface
+
+{$ifdef NO_EXCEPTIONS_IN_SYSTEM}
+uses
+ go32;
+{$endif NO_EXCEPTIONS_IN_SYSTEM}
+
+{$endif ndef IN_SYSTEM}
+{ No stack checking ! }
+{$S-}
+
+
+{ Decide if we want to create the C functions or not }
+
+{$ifdef EXCEPTIONS_IN_SYSTEM}
+{ If exceptions are in system the C functions must be
+ inserted in the system unit }
+{$ifdef IN_DPMIEXCP_UNIT}
+{$undef CREATE_C_FUNCTIONS}
+{$else not IN_DPMIEXCP_UNIT}
+{$define CREATE_C_FUNCTIONS}
+{$endif ndef IN_DPMIEXCP_UNIT}
+{$else not EXCEPTIONS_IN_SYSTEM}
+{$define CREATE_C_FUNCTIONS}
+{$endif not EXCEPTIONS_IN_SYSTEM}
+{ Error Messages }
+function do_faulting_finish_message(fake : boolean) : integer;cdecl;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external;
+{$endif CREATE_C_FUNCTIONS}
+
+{ SetJmp/LongJmp }
+type
+ { must also contain exception_state !! }
+ pdpmi_jmp_buf = ^dpmi_jmp_buf;
+ dpmi_jmp_buf = packed record
+ eax,ebx,ecx,edx,esi,edi,ebp,esp,eip,flags : longint;
+ cs,ds,es,fs,gs,ss : word;
+ sigmask : longint; { for POSIX signals only }
+ signum : longint; { for expansion ie 386 exception number }
+ exception_ptr : pdpmi_jmp_buf; { pointer to previous exception if exists }
+ end;
+function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name 'FPC_setjmp';
+{$endif CREATE_C_FUNCTIONS}
+
+procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name 'FPC_longjmp';
+{$endif CREATE_C_FUNCTIONS}
+
+{ Signals }
+const
+ SIGABRT = 288;
+ SIGFPE = 289;
+ SIGILL = 290;
+ SIGSEGV = 291;
+ SIGTERM = 292;
+ SIGALRM = 293;
+ SIGHUP = 294;
+ SIGINT = 295;
+ SIGKILL = 296;
+ SIGPIPE = 297;
+ SIGQUIT = 298;
+ SIGUSR1 = 299;
+ SIGUSR2 = 300;
+ SIGNOFP = 301;
+ SIGTRAP = 302;
+ SIGTIMR = 303; { Internal for setitimer (SIGALRM, SIGPROF) }
+ SIGPROF = 304;
+ SIGMAX = 320;
+
+ SIG_BLOCK = 1;
+ SIG_SETMASK = 2;
+ SIG_UNBLOCK = 3;
+
+function SIG_DFL( x: longint) : longint;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name '___djgpp_SIG_DFL';
+{$endif CREATE_C_FUNCTIONS}
+
+function SIG_ERR( x: longint) : longint;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name '___djgpp_SIG_ERR';
+{$endif CREATE_C_FUNCTIONS}
+
+function SIG_IGN( x: longint) : longint;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name '___djgpp_SIG_IGN';
+{$endif CREATE_C_FUNCTIONS}
+
+type
+ SignalHandler = function (v : longint) : longint;
+ PSignalHandler = ^SignalHandler; { to be compatible with linux.pp }
+
+function signal(sig : longint;func : SignalHandler) : SignalHandler;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+function _raise(sig : longint) : longint;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+
+{ Exceptions }
+type
+ pexception_state = ^texception_state;
+ texception_state = record
+ __eax, __ebx, __ecx, __edx, __esi : longint;
+ __edi, __ebp, __esp, __eip, __eflags : longint;
+ __cs, __ds, __es, __fs, __gs, __ss : word;
+ __sigmask : longint; { for POSIX signals only }
+ __signum : longint; { for expansion }
+ __exception_ptr : pexception_state; { pointer to previous exception }
+ __fpu_state : array [0..108-1] of byte; { for future use }
+ end;
+
+procedure djgpp_exception_toggle;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name '___djgpp_exception_toggle';
+{$endif CREATE_C_FUNCTIONS}
+
+procedure djgpp_exception_setup;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external name '___djgpp_exception_setup';
+{$endif CREATE_C_FUNCTIONS}
+
+function djgpp_exception_state : pexception_state;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+
+function djgpp_set_ctrl_c(enable : boolean) : boolean;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+
+{ Other }
+function dpmi_set_coprocessor_emulation(flag : longint) : longint;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+
+function __djgpp_set_sigint_key(new_key : longint) : longint;cdecl;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external;
+{$endif CREATE_C_FUNCTIONS}
+
+function __djgpp_set_sigquit_key(new_key : longint) : longint;cdecl;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external;
+{$endif CREATE_C_FUNCTIONS}
+
+function __djgpp__traceback_exit(sig : longint) : longint;cdecl;
+{$ifdef IN_SYSTEM}forward;{$endif IN_SYSTEM}
+{$ifndef CREATE_C_FUNCTIONS}
+external;
+{$endif CREATE_C_FUNCTIONS}
+
+{$ifndef IN_SYSTEM}
+implementation
+{$endif IN_SYSTEM}
+
+{$asmmode ATT}
+
+{$ifdef CREATE_C_FUNCTIONS}
+{$L exceptn.o}
+
+var
+ v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
+ djgpp_ds_alias : word;external name '___djgpp_ds_alias';
+ djgpp_old_kbd : tseginfo;external name '___djgpp_old_kbd';
+ djgpp_hw_lock_start : longint;external name '___djgpp_hw_lock_start';
+ djgpp_hw_lock_end : longint;external name '___djgpp_hw_lock_end';
+ djgpp_dos_sel : word;external name '___djgpp_dos_sel';
+ djgpp_exception_table : array[0..0] of pointer;external name '___djgpp_exception_table';
+ dosmemselector : word;external name '_core_selector';
+
+procedure djgpp_i24;external name '___djgpp_i24';
+procedure djgpp_iret;external name '___djgpp_iret';
+procedure djgpp_npx_hdlr;external name '___djgpp_npx_hdlr';
+procedure djgpp_kbd_hdlr;external name '___djgpp_kbd_hdlr';
+procedure djgpp_kbd_hdlr_pc98;external name '___djgpp_kbd_hdlr_pc98';
+procedure djgpp_cbrk_hdlr;external name '___djgpp_cbrk_hdlr';
+
+var
+ exceptions_on : boolean;
+{ old_int00 : tseginfo;cvar;external;
+ old_int75 : tseginfo;cvar;external; }
+
+const
+ cbrk_vect : byte = $1b;
+ exception_level : longint = 0;
+{$endif CREATE_C_FUNCTIONS}
+
+var
+ endtext : longint;external name '_etext';
+ starttext : longint;external name 'start';
+ djgpp_exception_state_ptr : pexception_state;external name '___djgpp_exception_state_ptr';
+ djgpp_hwint_flags : longint;external name '___djgpp_hwint_flags';
+
+
+{$ifndef IN_DPMIEXCP_UNIT}
+{****************************************************************************
+ DPMI functions copied from go32 unit
+****************************************************************************}
+
+const
+ int31error : word = 0;
+
+ procedure test_int31(flag : longint);
+ begin
+ asm
+ pushl %ebx
+ movw $0,INT31ERROR
+ movl flag,%ebx
+ testb $1,%bl
+ jz .Lti31_1
+ movw %ax,INT31ERROR
+ xorl %eax,%eax
+ jmp .Lti31_2
+ .Lti31_1:
+ movl $1,%eax
+ .Lti31_2:
+ popl %ebx
+ end;
+ end;
+
+ function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x212,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ end;
+ end;
+
+ function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x203,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ end;
+ end;
+
+ function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ movl $0x210,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ end;
+ end;
+
+ function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl $0x202,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_segment_base_address(d : word) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movl $6,%eax
+ int $0x31
+ xorl %eax,%eax
+ movw %dx,%ax
+ shll $16,%ecx
+ orl %ecx,%eax
+ movl %eax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_segment_limit(d : word) : longint;
+
+ begin
+ asm
+ movzwl d,%eax
+ lsl %eax,%eax
+ jz .L_ok2
+ xorl %eax,%eax
+ .L_ok2:
+ movl %eax,__RESULT
+ end;
+ end;
+
+ function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movw (%eax),%dx
+ movw 4(%eax),%cx
+ movl $0x201,%eax
+ movb vector,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x200,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movzwl %dx,%edx
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+
+ function free_rm_callback(var intaddr : tseginfo) : boolean;
+ begin
+ asm
+ movl intaddr,%eax
+ movw (%eax),%dx
+ movw 4(%eax),%cx
+ movl $0x304,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ end;
+ end;
+
+ function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl pm_func,%esi
+ movl reg,%edi
+ pushw %es
+ movw v2prt0_ds_alias,%ax
+ movw %ax,%es
+ pushw %ds
+ movw %cs,%ax
+ movw %ax,%ds
+ movl $0x303,%eax
+ int $0x31
+ popw %ds
+ popw %es
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl rmcb,%eax
+ movzwl %dx,%edx
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function lock_linear_region(linearaddr, size : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ pushl %esi
+ pushl %edi
+ movl $0x600,%eax
+ movl linearaddr,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %edi
+ popl %esi
+ popl %ebx
+ end;
+ end;
+
+ function lock_code(functionaddr : pointer;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+
+ begin
+ linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+ lock_code:=lock_linear_region(linearaddr,size);
+ end;
+{$endif ndef IN_DPMIEXCP_UNIT}
+
+{****************************************************************************
+ Helpers
+****************************************************************************}
+
+procedure err(const x : string);
+begin
+ write(stderr, x);
+end;
+
+procedure errln(const x : string);
+begin
+ writeln(stderr, x);
+end;
+
+
+procedure itox(v,len : longint);
+var
+ st : string;
+begin
+ st:=hexstr(v,len);
+ err(st);
+end;
+
+
+{****************************************************************************
+ SetJmp/LongJmp
+****************************************************************************}
+
+{$ifdef CREATE_C_FUNCTIONS}
+function c_setjmp(var rec : dpmi_jmp_buf) : longint;[public, alias : '_setjmp'];
+ begin
+ { here we need to be subtle :
+ - we need to return with the arg still on the stack
+ - but we also need to jmp to FPC_setjmp and not to call it
+ because otherwise the return address is wrong !!
+
+ For this we shift the return address down and
+ duplicate the rec on stack }
+ asm
+ movl %ebp,%esp
+ popl %ebp
+ subl $8,%esp
+ movl %eax,(%esp)
+ movl 8(%esp),%eax
+ movl %eax,4(%esp)
+ movl 12(%esp),%eax
+ movl %eax,8(%esp)
+ popl %eax
+ jmp dpmi_setjmp
+ end;
+ end;
+{$endif CREATE_C_FUNCTIONS}
+
+{$ifdef CREATE_C_FUNCTIONS}
+function dpmi_setjmp(var rec : dpmi_jmp_buf) : longint;
+[public, alias : 'FPC_setjmp'];
+begin
+ asm
+ pushl %edi
+ movl rec,%edi
+ movl %eax,(%edi)
+ movl %ebx,4(%edi)
+ movl %ecx,8(%edi)
+ movl %edx,12(%edi)
+ movl %esi,16(%edi)
+ { load edi }
+ movl -4(%ebp),%eax
+ { ... and store it }
+ movl %eax,20(%edi)
+ { ebp ... }
+ movl (%ebp),%eax
+ movl %eax,24(%edi)
+ { esp ... }
+ movl %esp,%eax
+ addl $12,%eax
+ movl %eax,28(%edi)
+ { the return address }
+ movl 4(%ebp),%eax
+ movl %eax,32(%edi)
+ { flags ... }
+ pushfl
+ popl 36(%edi)
+ { !!!!! the segment registers, not yet needed }
+ { you need them if the exception comes from
+ an interrupt or a seg_move }
+ movw %cs,40(%edi)
+ movw %ds,42(%edi)
+ movw %es,44(%edi)
+ movw %fs,46(%edi)
+ movw %gs,48(%edi)
+ movw %ss,50(%edi)
+ movl djgpp_exception_state_ptr, %eax
+ movl %eax, 60(%edi)
+ { restore EDI }
+ pop %edi
+ { we come from the initial call }
+ xorl %eax,%eax
+ movl %eax,__RESULT
+ { leave USING RET inside CDECL functions is risky as
+ some registers are pushed at entry
+ ret $4 not anymore since cdecl !! }
+ end;
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+procedure c_longjmp(var rec : dpmi_jmp_buf;return_value : longint);[public, alias : '_longjmp'];
+ begin
+ dpmi_longjmp(rec,return_value);
+ { never gets here !! so pascal stack convention is no problem }
+ end;
+{$endif CREATE_C_FUNCTIONS}
+
+{$ifdef CREATE_C_FUNCTIONS}
+procedure dpmi_longjmp(var rec : dpmi_jmp_buf;return_value : longint);
+[public, alias : 'FPC_longjmp'];
+begin
+ if (exception_level>0) then
+ dec(exception_level);
+ asm
+ { restore compiler shit }
+ popl %ebp
+ { copy from longjmp.S }
+ movl 4(%esp),%edi { get dpmi_jmp_buf }
+ movl 8(%esp),%eax { store retval in j->eax }
+ movl %eax,0(%edi)
+
+ movw 46(%edi),%fs
+ movw 48(%edi),%gs
+ movl 4(%edi),%ebx
+ movl 8(%edi),%ecx
+ movl 12(%edi),%edx
+ movl 24(%edi),%ebp
+ { Now for some uglyness. The dpmi_jmp_buf structure may be ABOVE the
+ point on the new SS:ESP we are moving to. We don't allow overlap,
+ but do force that it always be valid. We will use ES:ESI for
+ our new stack before swapping to it. }
+ movw 50(%edi),%es
+ movl 28(%edi),%esi
+ subl $28,%esi { We need 7 working longwords on stack }
+ movl 60(%edi),%eax
+ movl %eax,%es:(%esi) { Exception pointer }
+ movzwl 42(%edi),%eax
+ movl %eax,%es:4(%esi) { DS }
+ movl 20(%edi),%eax
+ movl %eax,%es:8(%esi) { EDI }
+ movl 16(%edi),%eax
+ movl %eax,%es:12(%esi) { ESI }
+ movl 32(%edi),%eax
+ movl %eax,%es:16(%esi) { EIP - start of IRET frame }
+ movl 40(%edi),%eax
+ movl %eax,%es:20(%esi) { CS }
+ movl 36(%edi),%eax
+ movl %eax,%es:24(%esi) { EFLAGS }
+ movl 0(%edi),%eax
+ movw 44(%edi),%es
+ movw 50(%edi),%ss
+ movl %esi,%esp
+ popl djgpp_exception_state_ptr
+ popl %ds
+ popl %edi
+ popl %esi
+ iret { actually jump to new cs:eip loading flags }
+ end;
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+
+{****************************************************************************
+ Signals
+****************************************************************************}
+
+var
+ signal_list : Array[0..SIGMAX] of SignalHandler;cvar;
+ {$ifndef CREATE_C_FUNCTIONS}external;{$endif}
+
+{$ifdef CREATE_C_FUNCTIONS}
+function SIG_ERR(x:longint):longint;[public,alias : '___djgpp_SIG_ERR'];
+begin
+ SIG_ERR:=-1;
+end;
+
+
+function SIG_IGN(x:longint):longint;[public,alias : '___djgpp_SIG_IGN'];
+begin
+ SIG_IGN:=-1;
+end;
+
+
+function SIG_DFL(x:longint):longint;[public,alias : '___djgpp_SIG_DFL'];
+begin
+ SIG_DFL:=0;
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+function signal(sig : longint;func : SignalHandler) : SignalHandler;
+var
+ temp : SignalHandler;
+begin
+ if ((sig < 0) or (sig > SIGMAX) or (sig = SIGKILL)) then
+ begin
+ signal:=@SIG_ERR;
+ runerror(201);
+ end;
+ temp := signal_list[sig];
+ signal_list[sig] := func;
+ signal:=temp;
+end;
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+{ C counter part }
+function c_signal(sig : longint;func : SignalHandler) : SignalHandler;cdecl;[public,alias : '_signal'];
+var
+ temp : SignalHandler;
+begin
+ temp:=signal(sig,func);
+ c_signal:=temp;
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+
+const
+ signames : array [0..14] of string[4] = (
+ 'ABRT','FPE ','ILL ','SEGV','TERM','ALRM','HUP ',
+ 'INT ','KILL','PIPE','QUIT','USR1','USR2','NOFP','TRAP');
+
+procedure print_signal_name(sig : longint);
+begin
+ if ((sig >= SIGABRT) and (sig <= SIGTRAP)) then
+ begin
+ err('Exiting due to signal SIG');
+ err(signames[sig-sigabrt]);
+ end
+ else
+ begin
+ err('Exiting due to signal $');
+ itox(sig, 4);
+ end;
+ errln('');
+end;
+
+function _raise(sig : longint) : longint;
+var
+ temp : SignalHandler;
+begin
+ if(sig < 0) or (sig > SIGMAX) then
+ exit(-1);
+ temp:=signal_list[sig];
+ if (temp = SignalHandler(@SIG_IGN)) then
+ exit(0);
+ if (temp = SignalHandler(@SIG_DFL)) then
+ begin
+ print_signal_name(sig);
+ do_faulting_finish_message(djgpp_exception_state<>nil); { Exits, does not return }
+ exit(-1);
+ end;
+ { this is incompatible with dxegen-dxeload stuff PM }
+ if ((cardinal(temp) < cardinal(@starttext)) or
+ (cardinal(temp) > cardinal(@endtext))) then
+ begin
+ errln('Bad signal handler, ');
+ print_signal_name(sig);
+ do_faulting_finish_message(djgpp_exception_state<>nil); { Exits, does not return }
+ exit(-1);
+ end;
+ { WARNING !!! temp can be a pascal or a C
+ function... thus %esp can be modified here !!!
+ This might be dangerous for some optimizations ?? PM }
+ temp(sig);
+ exit(0);
+end;
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+function c_raise(sig : longint) : longint;cdecl;[public,alias : '_raise'];
+begin
+ c_raise:=_raise(sig);
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+
+{****************************************************************************
+ Exceptions
+****************************************************************************}
+
+var
+ ___djgpp_selector_limit: cardinal; external name '___djgpp_selector_limit';
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+
+{$ifdef IN_DPMIEXCP_UNIT}
+procedure __exit(c:longint);cdecl;external;
+{$endif}
+
+function except_to_sig(excep : longint) : longint;
+begin
+ case excep of
+ 5,8,9,11,12,13,14,
+ 18, 19 : exit(SIGSEGV);
+ 0,4,16 : exit(SIGFPE);
+ 1,3 : exit(SIGTRAP);
+ 7 : exit(SIGNOFP);
+ else
+ begin
+ case excep of
+ $75 : exit(SIGFPE);
+ $78 : exit(SIGTIMR);
+ $1b,
+ $79 : exit(SIGINT);
+ $7a : exit(SIGQUIT);
+ else
+ exit(SIGILL);
+ end;
+ end;
+ end;
+end;
+
+
+procedure show_call_frame(djgpp_exception_state : pexception_state);
+begin
+ errln('Call frame traceback EIPs:');
+ errln(BackTraceStrFunc(Pointer(djgpp_exception_state^.__eip)));
+ dump_stack(stderr,Pointer(djgpp_exception_state^.__ebp));
+end;
+
+
+const
+ EXCEPTIONCOUNT = 20;
+ exception_names : array[0..EXCEPTIONCOUNT-1] of pchar = (
+ 'Division by Zero',
+ 'Debug',
+ 'NMI',
+ 'Breakpoint',
+ 'Overflow',
+ 'Bounds Check',
+ 'Invalid Opcode',
+ 'Coprocessor not available',
+ 'Double Fault',
+ 'Coprocessor overrun',
+ 'Invalid TSS',
+ 'Segment Not Present',
+ 'Stack Fault',
+ 'General Protection Fault',
+ 'Page fault',
+ ' ',
+ 'Coprocessor Error',
+ 'Alignment Check',
+ 'Machine check',
+ 'SIMD FP Error');
+
+ has_error : array [0..EXCEPTIONCOUNT-1] of byte =
+ (0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,0,0,1,0,0);
+
+ cbrk_hooked : boolean = false;
+ old_video_mode : byte = 3;
+
+
+procedure dump_selector(const name : string; sel : word);
+var
+ base,limit : longint;
+begin
+ err(name);
+ err(': sel=');
+ itox(sel, 4);
+ if (sel<>0) then
+ begin
+ base:=get_segment_base_address(sel);
+ err(' base='); itox(base, 8);
+ limit:=get_segment_limit(sel);
+ err(' limit='); itox(limit, 8);
+ end;
+ errln('');
+end;
+
+
+function farpeekb(sel : word;offset : longint) : byte;
+var
+ b : byte;
+begin
+{$ifdef IN_DPMIEXCP_UNIT}
+ seg_move(sel,offset,get_ds,longint(@b),1);
+{$else not IN_DPMIEXCP_UNIT}
+ sysseg_move(sel,offset,get_ds,longint(@b),1);
+{$endif IN_DPMIEXCP_UNIT}
+ farpeekb:=b;
+end;
+
+
+const message_level : byte = 0;
+
+function do_faulting_finish_message(fake : boolean) : integer;cdecl;
+public;
+var
+ en : pchar;
+ signum,i : longint;
+ old_vid : byte;
+label
+ simple_exit;
+
+ function _my_cs: word; assembler;
+ asm
+ movw %cs,%ax
+ end;
+
+begin
+ inc(message_level);
+ if message_level>2 then
+ goto simple_exit;
+ do_faulting_finish_message:=0;
+ signum:=djgpp_exception_state_ptr^.__signum;
+ { check video mode for original here and reset (not if PC98) }
+ if ((go32_info_block.linear_address_of_primary_screen <> $a0000) and
+ (farpeekb(dosmemselector, $449) <> old_video_mode)) then
+ begin
+ old_vid:=old_video_mode;
+ asm
+ pusha
+ movzbl old_vid,%eax
+ int $0x10
+ popa
+ nop
+ end;
+ end;
+
+ if (signum >= EXCEPTIONCOUNT) then
+ begin
+ case signum of
+ $75 : en:='Floating Point exception';
+ $1b : en:='Control-Break Pressed';
+ $79 : en:='Control-C Pressed';
+ $7a : en:='QUIT key Pressed'
+ else
+ en:=nil;
+ end;
+ end
+ else
+ en:=exception_names[signum];
+
+ if (en = nil) then
+ begin
+ if fake then
+ err('Raised ')
+ else
+ err('Exception ');
+ itox(signum, 2);
+ err(' at eip=');
+ (* For fake exceptions like SIGABRT report where `raise' was called. *)
+ if fake and (djgpp_exception_state_ptr^.__cs = _my_cs)
+ and (djgpp_exception_state_ptr^.__ebp >= djgpp_exception_state_ptr^.__esp)
+ and (djgpp_exception_state_ptr^.__ebp >= endtext)
+ and (djgpp_exception_state_ptr^.__ebp < ___djgpp_selector_limit) then
+ itox(djgpp_exception_state_ptr^.__ebp + 1, 8)
+ else
+ itox(djgpp_exception_state_ptr^.__eip, 8);
+ end
+ else
+ begin
+ write(stderr, 'FPC ',en);
+ err(' at eip=');
+ itox(djgpp_exception_state_ptr^.__eip, 8);
+ end;
+ { Control-C should stop the program also !}
+ {if (signum = $79) then
+ begin
+ errln('');
+ exit(-1);
+ end;}
+ if ((signum < EXCEPTIONCOUNT) and (has_error[signum]=1)) then
+ begin
+ errorcode := djgpp_exception_state_ptr^.__sigmask and $ffff;
+ if(errorcode<>0) then
+ begin
+ err(', error=');
+ itox(errorcode, 4);
+ end;
+ end;
+ errln('');
+ err('eax=');
+ itox(djgpp_exception_state_ptr^.__eax, 8);
+ err(' ebx='); itox(djgpp_exception_state_ptr^.__ebx, 8);
+ err(' ecx='); itox(djgpp_exception_state_ptr^.__ecx, 8);
+ err(' edx='); itox(djgpp_exception_state_ptr^.__edx, 8);
+ err(' esi='); itox(djgpp_exception_state_ptr^.__esi, 8);
+ err(' edi='); itox(djgpp_exception_state_ptr^.__edi, 8);
+ errln('');
+ err('ebp='); itox(djgpp_exception_state_ptr^.__ebp, 8);
+ err(' esp='); itox(djgpp_exception_state_ptr^.__esp, 8);
+ err(' program=');
+ errln(paramstr(0));
+ dump_selector('cs', djgpp_exception_state_ptr^.__cs);
+ dump_selector('ds', djgpp_exception_state_ptr^.__ds);
+ dump_selector('es', djgpp_exception_state_ptr^.__es);
+ dump_selector('fs', djgpp_exception_state_ptr^.__fs);
+ dump_selector('gs', djgpp_exception_state_ptr^.__gs);
+ dump_selector('ss', djgpp_exception_state_ptr^.__ss);
+ errln('');
+ if (djgpp_exception_state_ptr^.__cs = get_cs) then
+ show_call_frame(djgpp_exception_state_ptr)
+{$ifdef DPMIEXCP_DEBUG}
+ else
+ errln('Exception occured in another context');
+{$endif def DPMIEXCP_DEBUG}
+ ;
+ if assigned(djgpp_exception_state_ptr^.__exception_ptr) then
+ if (djgpp_exception_state_ptr^.__exception_ptr^.__cs = get_cs) then
+ begin
+ Errln('First exception level stack');
+ show_call_frame(djgpp_exception_state_ptr^.__exception_ptr);
+ end
+{$ifdef DPMIEXCP_DEBUG}
+ else
+ begin
+ errln('First exception occured in another context');
+ djgpp_exception_state_ptr:=djgpp_exception_state_ptr^.__exception_ptr;
+ do_faulting_finish_message(false);
+ end;
+{$endif def DPMIEXCP_DEBUG}
+ ;
+ { must not return !! }
+simple_exit:
+ if exceptions_on then
+ djgpp_exception_toggle;
+ __exit(-1);
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+function djgpp_exception_state:pexception_state;assembler;
+asm
+ movl djgpp_exception_state_ptr,%eax
+end;
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+var
+ _os_trueversion : word;external name '__os_trueversion';
+
+procedure djgpp_exception_processor;[public,alias : '___djgpp_exception_processor'];
+var
+ sig : longint;
+begin
+ if not assigned(djgpp_exception_state_ptr^.__exception_ptr) then
+ exception_level:=1
+ else
+ inc(exception_level);
+
+ sig:=djgpp_exception_state_ptr^.__signum;
+
+ if (exception_level=1) or (sig=$78) then
+ begin
+ sig := except_to_sig(sig);
+ if signal_list[djgpp_exception_state_ptr^.__signum]
+ <>SignalHandler(@SIG_DFL) then
+ _raise(djgpp_exception_state_ptr^.__signum)
+ else
+ _raise(sig);
+ if (djgpp_exception_state_ptr^.__signum >= EXCEPTIONCOUNT) then
+ { Not exception so continue OK }
+ dpmi_longjmp(pdpmi_jmp_buf(djgpp_exception_state_ptr)^, djgpp_exception_state_ptr^.__eax);
+ { User handler did not exit or longjmp, we must exit }
+ err('FPC cannot continue from exception, exiting due to signal ');
+ itox(sig, 4);
+ errln('');
+ end
+ else
+ begin
+ if exception_level>2 then
+ begin
+ if exception_level=3 then
+ errln('FPC triple exception, exiting !!! ');
+ if (exceptions_on) then
+ djgpp_exception_toggle;
+ __exit(1);
+ end;
+ err('FPC double exception, exiting due to signal ');
+ itox(sig, 4);
+ errln('');
+ end;
+ do_faulting_finish_message(djgpp_exception_state<>nil);
+end;
+
+
+type
+ trealseginfo = tseginfo;
+ pseginfo = ^tseginfo;
+var
+ except_ori : array [0..EXCEPTIONCOUNT-1] of tseginfo;
+{$ifdef DPMIEXCP_DEBUG}
+ export name '_ori_exceptions';
+{$endif def DPMIEXCP_DEBUG}
+ kbd_ori : tseginfo;
+ int0_ori,
+ npx_ori : tseginfo;
+ cbrk_ori,
+ cbrk_rmcb : trealseginfo;
+ cbrk_regs : trealregs;
+ v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
+
+
+procedure djgpp_exception_toggle;
+[public,alias : '___djgpp_exception_toggle'];
+var
+ _except : tseginfo;
+ i : longint;
+begin
+{$ifdef DPMIEXCP_DEBUG}
+ if exceptions_on then
+ errln('Disabling FPC exceptions')
+ else
+ errln('Enabling FPC exceptions');
+{$endif DPMIEXCP_DEBUG}
+ { toggle here to avoid infinite recursion }
+ { if a subfunction calls runerror !! }
+ exceptions_on:=not exceptions_on;
+ v2prt0_exceptions_on:=exceptions_on;
+ { Exceptions 18 and 19 settings generates a bug in
+ the DJGPP debug code PM }
+
+ for i:=0 to 17{EXCEPTIONCOUNT-1} do
+ begin
+{$ifdef DPMIEXCP_DEBUG}
+ errln('new exception '+hexstr(i,2)+' '+hexstr(except_ori[i].segment,4)+':'+hexstr(longint(except_ori[i].offset),8));
+{$endif DPMIEXCP_DEBUG}
+ { Windows 2000 seems to not set carryflag on func 0x210 :( PM }
+ if (_os_trueversion <> $532) and get_pm_exception_handler(i,_except) then
+ begin
+ if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then
+ begin
+{$ifdef DPMIEXCP_DEBUG}
+ errln('Using DPMI 1.0 functions');
+{$endif DPMIEXCP_DEBUG}
+ if not set_pm_exception_handler(i,except_ori[i]) then
+ errln('error setting exception nø'+hexstr(i,2));
+ end;
+ except_ori[i]:=_except;
+ end
+ else
+ begin
+ if get_exception_handler(i,_except) then
+ begin
+{$ifdef DPMIEXCP_DEBUG}
+ errln('Using DPMI 0.9 functions');
+{$endif DPMIEXCP_DEBUG}
+ if (i <> 2) {or (_crt0_startup_flags & _CRT0_FLAG_NMI_SIGNAL))} then
+ begin
+ if not set_exception_handler(i,except_ori[i]) then
+ errln('error setting exception nø'+hexstr(i,2));
+ end;
+ except_ori[i]:=_except;
+ end;
+ end;
+{$ifdef DPMIEXCP_DEBUG}
+ errln('prev exception '+hexstr(i,2)+' '+hexstr(_except.segment,4)+':'+hexstr(longint(_except.offset),8));
+{$endif DPMIEXCP_DEBUG}
+ end;
+ get_pm_interrupt($75,_except);
+ set_pm_interrupt($75,npx_ori);
+ npx_ori:=_except;
+ get_pm_interrupt($0,_except);
+ set_pm_interrupt($0,int0_ori);
+ int0_ori:=_except;
+ get_pm_interrupt(9,_except);
+ set_pm_interrupt(9,kbd_ori);
+ kbd_ori:=_except;
+ if (cbrk_hooked) then
+ begin
+ set_rm_interrupt(cbrk_vect,cbrk_ori);
+ free_rm_callback(cbrk_rmcb);
+ cbrk_hooked := false;
+{$ifdef DPMIEXCP_DEBUG}
+ errln('back to ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
+{$endif DPMIEXCP_DEBUG}
+ end
+ else
+ begin
+ get_rm_interrupt(cbrk_vect, cbrk_ori);
+{$ifdef DPMIEXCP_DEBUG}
+ errln('ori rm cbrk '+hexstr(cbrk_ori.segment,4)+':'+hexstr(longint(cbrk_ori.offset),4));
+{$endif DPMIEXCP_DEBUG}
+ get_rm_callback(@djgpp_cbrk_hdlr, cbrk_regs, cbrk_rmcb);
+ set_rm_interrupt(cbrk_vect, cbrk_rmcb);
+{$ifdef DPMIEXCP_DEBUG}
+ errln('now rm cbrk '+hexstr(cbrk_rmcb.segment,4)+':'+hexstr(longint(cbrk_rmcb.offset),4));
+{$endif DPMIEXCP_DEBUG}
+ cbrk_hooked := true;
+ end;
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+function dpmi_set_coprocessor_emulation(flag : longint) : longint;
+var
+ res : longint;
+begin
+ asm
+ pushl %ebx
+ movl flag,%ebx
+ movl $0xe01,%eax
+ int $0x31
+ jc .L_coproc_error
+ xorl %eax,%eax
+.L_coproc_error:
+ movl %eax,res
+ popl %ebx
+ end;
+ dpmi_set_coprocessor_emulation:=res;
+end;
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+var
+ _swap_in : pointer;external name '_swap_in';
+ _swap_out : pointer;external name '_swap_out';
+ _exception_exit : pointer;external name '_exception_exit';
+
+const
+ STUBINFO_END = $54;
+
+procedure __maybe_fix_w2k_ntvdm_bug;[public,alias : '___maybe_fix_w2k_ntvdm_bug'];
+var
+ psp_sel : word;
+begin
+ if _os_trueversion = $532 then
+ begin
+ { avoid NTVDM bug on NT,2000 or XP }
+ { see dpmiexcp.c source of DJGPP PM }
+ if stub_info^.size < STUBINFO_END then
+ begin
+ asm
+ movb $0x51,%ah
+ int $0x21
+ movb $0x50,%ah
+ int $0x21
+ end;
+ end
+ else
+ begin
+ psp_sel:=stub_info^.psp_selector;
+ asm
+ pushl %ebx
+ movw psp_sel,%bx
+ movb $0x50,%ah
+ int $0x21
+ popl %ebx
+ end;
+ end;
+ end;
+end;
+
+
+procedure dpmiexcp_exit{(status : longint)};[public,alias : 'excep_exit'];
+{ We need to restore hardware interrupt handlers even if somebody calls
+ `_exit' directly, or else we crash the machine in nested programs.
+ We only toggle the handlers if the original keyboard handler is intact
+ (otherwise, they might have already toggled them). }
+begin
+{
+void __maybe_fix_w2k_ntvdm_bug(void)
+ if (_osmajor == 5 && _get_dos_version(1) == 0x532) /* Windows NT, 2000 or XP? */
+ {
+ if(_stubinfo->size < STUBINFO_END) /* V2load'ed image, stubinfo PSP bad */
+
+ /* Protected mode call to SetPSP - uses BX from GetPSP (0x51) */
+ asm volatile("movb $0x51, %%ah \n\
+ int $0x21 \n\
+ movb $0x50, %%ah \n\
+ int $0x21 "
+ : : : "ax", "bx" ); /* output, input, regs */
+ else
+
+ /* Protected mode call to SetPSP - may destroy RM PSP if not extended */
+ asm volatile("movw %0, %%bx \n\
+ movb $0x50, %%ah \n\
+ int $0x21 "
+ : /* output */
+ : "g" (_stubinfo->psp_selector) /* input */
+ : "ax", "bx" ); /* regs */
+ }
+}
+ if (exceptions_on) then
+ djgpp_exception_toggle;
+ _exception_exit:=nil;
+ _swap_in:=nil;
+ _swap_out:=nil;
+ __maybe_fix_w2k_ntvdm_bug;
+ { restore the FPU state }
+ dpmi_set_coprocessor_emulation(1);
+end;
+
+{ _exit in dpmiexcp.c
+ is already present in v2prt0.as PM}
+
+{ used by dos.pp for swap vectors }
+procedure dpmi_swap_in;[public,alias : 'swap_in'];
+begin
+ if not (exceptions_on) then
+ djgpp_exception_toggle;
+end;
+
+
+procedure dpmi_swap_out;[public,alias : 'swap_out'];
+begin
+ if (exceptions_on) then
+ djgpp_exception_toggle;
+end;
+
+var
+ ___djgpp_app_DS : word;external name '___djgpp_app_DS';
+ ___djgpp_our_DS : word;external name '___djgpp_our_DS';
+ __djgpp_sigint_mask : word;external name '___djgpp_sigint_mask';
+ __djgpp_sigint_key : word;external name '___djgpp_sigint_key';
+ __djgpp_sigquit_mask : word;external name '___djgpp_sigquit_mask';
+ __djgpp_sigquit_key : word;external name '___djgpp_sigquit_key';
+{ to avoid loading of C lib version of dpmiexcp
+ I need to have all exported assembler labels
+ of dpmiexcp.c in this unit.
+ DJGPP v2.03 add to new functions:
+ __djgpp_set_sigint_key
+ __djgpp_set_sigquit_key
+ that I implement here simply translating C code PM }
+Const
+ LSHIFT = 1;
+ RSHIFT = 2;
+ CTRL = 4;
+ ALT = 8;
+ DEFAULT_SIGINT = $042e; { Ctrl-C: scan code 2Eh, kb status 04h }
+ DEFAULT_SIGQUIT = $042b; { Ctrl-\: scan code 2Bh, kb status 04h }
+ DEFAULT_SIGINT_98 = $042b; { Ctrl-C: scan code 2Bh, kb status 04h }
+ DEFAULT_SIGQUIT_98 = $040d; { Ctrl-\: scan code 0Dh, kb status 04h }
+
+{ Make it so the key NEW_KEY will generate the signal SIG.
+ NEW_KEY must include the keyboard status byte in bits 8-15 and the
+ scan code in bits 0-7. }
+function set_signal_key(sig,new_key : longint) : longint;
+ type
+ pword = ^word;
+ var
+ old_key : longint;
+ mask,key : pword;
+ kb_status : word;
+
+ begin
+ if (sig = SIGINT) then
+ begin
+ mask := @__djgpp_sigint_mask;
+ key := @__djgpp_sigint_key;
+ end
+ else if (sig = SIGQUIT) then
+ begin
+ mask := @__djgpp_sigquit_mask;
+ key := @__djgpp_sigquit_key;
+ end
+ else
+ exit(-1);
+
+ old_key := key^;
+ key^ := new_key and $ffff;
+ kb_status := key^ shr 8;
+ mask^ := $f; { Alt, Ctrl and Shift bits only }
+ { Mask off the RShift bit unless they explicitly asked for it.
+ Our keyboard handler pretends that LShift is pressed when they
+ press RShift. }
+ if ((kb_status and RSHIFT) = 0) then
+ mask^ :=mask^ and not RSHIFT;
+ { Mask off the LShift bit if any of the Ctrl or Alt are set
+ since Shift doesn't matter when Ctrl and/or Alt are pressed. }
+ if (kb_status and (CTRL or ALT))<>0 then
+ mask^:= mask^ and not LSHIFT;
+
+ exit(old_key);
+ end;
+
+function __djgpp_set_sigint_key(new_key : longint) : longint;cdecl;
+begin
+ __djgpp_set_sigint_key:=set_signal_key(SIGINT, new_key);
+end;
+
+function __djgpp_set_sigquit_key(new_key : longint) : longint;cdecl;
+begin
+ __djgpp_set_sigquit_key:=set_signal_key(SIGQUIT, new_key);
+end;
+
+function __djgpp__traceback_exit(sig : longint) : longint;cdecl;
+var
+ fake_exception : texception_state;
+begin
+ if (sig >= SIGABRT) and (sig <= SIGTRAP) then
+ begin
+ if djgpp_exception_state_ptr=nil then
+ begin
+ { This is a software signal, like SIGABRT or SIGKILL.
+ Fill the exception structure, so we get the traceback. }
+ djgpp_exception_state_ptr:=@fake_exception;
+ if (dpmi_setjmp(pdpmi_jmp_buf(djgpp_exception_state_ptr)^)<>0) then
+ begin
+ errln('Bad longjmp to __djgpp_exception_state--aborting');
+ do_faulting_finish_message(true); { does not return }
+ end
+ else
+ { Fake the exception number. 7Ah is the last one hardwired
+ inside exceptn.S, for SIGQUIT. }
+ djgpp_exception_state_ptr^.__signum:=$7a + 1 + sig - SIGABRT;
+ end;
+ end;
+ print_signal_name(sig);
+ if assigned(djgpp_exception_state_ptr) then
+ { This exits, does not return. }
+ do_faulting_finish_message(djgpp_exception_state_ptr=@fake_exception);
+ __exit(-1);
+ __djgpp__traceback_exit:=0;
+end;
+
+procedure djgpp_int0;
+begin
+ HandleError(200);
+end;
+
+
+procedure djgpp_exception_setup;
+[public,alias : '___djgpp_exception_setup'];
+var
+ temp_kbd,
+ temp_npx : pointer;
+ _except,
+ old_kbd : tseginfo;
+ locksize : longint;
+ i : longint;
+begin
+ if assigned(_exception_exit) then
+ exit;
+ if (go32_info_block.linear_address_of_primary_screen <> $a0000) then
+ begin
+ __djgpp_set_sigint_key(DEFAULT_SIGINT);
+ __djgpp_set_sigquit_key(DEFAULT_SIGQUIT);
+ end
+ else
+ begin { for PC98 }
+ __djgpp_set_sigint_key(DEFAULT_SIGINT_98);
+ __djgpp_set_sigquit_key(DEFAULT_SIGQUIT_98);
+ end;
+ _exception_exit:=@dpmiexcp_exit;
+ _swap_in:=@dpmi_swap_in;
+ _swap_out:=@dpmi_swap_out;
+{ reset signals }
+ for i := 0 to SIGMAX do
+ signal_list[i] := SignalHandler(@SIG_DFL);
+{ app_DS only used when converting HW interrupts to exceptions }
+ asm
+ movw %ds,___djgpp_app_DS
+ movw %ds,___djgpp_our_DS
+ end;
+ djgpp_dos_sel:=dosmemselector;
+{ lock addresses which may see HW interrupts }
+ lock_code(@djgpp_hw_lock_start,@djgpp_hw_lock_end-@djgpp_hw_lock_start);
+ _except.segment:=get_cs;
+ { the first 18 exceptions start at offset +8 since exception
+ #18 and #19 had to be put in front of the table. }
+ _except.offset:=@djgpp_exception_table + 8;
+ for i:=0 to 17 do
+ begin
+ except_ori[i] := _except; { New value to set }
+ inc(_except.offset,4); { This is the size of push n, jmp }
+ end;
+ except_ori[18].segment := _except.segment;
+ except_ori[19].segment := _except.segment;
+ except_ori[18].offset := @djgpp_exception_table;
+ except_ori[19].offset := @djgpp_exception_table + 4;
+
+ kbd_ori.segment:=_except.segment;
+ npx_ori.segment:=_except.segment;
+ npx_ori.offset:=@djgpp_npx_hdlr;
+ int0_ori.segment:=_except.segment;
+ int0_ori.offset:=@djgpp_int0;
+ if (go32_info_block.linear_address_of_primary_screen <> $a0000) then
+ kbd_ori.offset:=@djgpp_kbd_hdlr
+ else
+ begin
+ kbd_ori.offset:=@djgpp_kbd_hdlr_pc98;
+ cbrk_vect := $06;
+ _except.offset:=@djgpp_iret;
+ set_pm_interrupt($23,_except);
+ end;
+ _except.offset:=@djgpp_i24;
+ set_pm_interrupt($24, _except);
+ get_pm_interrupt(9,djgpp_old_kbd);
+ djgpp_exception_toggle; { Set new values & save old values }
+{ get original video mode and save }
+ old_video_mode := farpeekb(dosmemselector, $449);
+end;
+{$endif CREATE_C_FUNCTIONS}
+
+
+function djgpp_set_ctrl_c(enable : boolean) : boolean;
+begin
+ djgpp_set_ctrl_c:=(djgpp_hwint_flags and 1)=0;
+ if enable then
+ djgpp_hwint_flags:=djgpp_hwint_flags and (not 1)
+ else
+ djgpp_hwint_flags:=djgpp_hwint_flags or 1;
+end;
+
+
+{$ifdef CREATE_C_FUNCTIONS}
+function c_djgpp_set_ctrl_c(enable : longint) : boolean;cdecl;[public,alias : '___djgpp_set_ctrl_c'];
+begin
+ c_djgpp_set_ctrl_c:=djgpp_set_ctrl_c(boolean(enable));
+end;
+{$endif def CREATE_C_FUNCTIONS}
+
+
+{$ifdef IN_DPMIEXCP_UNIT}
+procedure ResetDefaultHandlers;
+begin
+ Signal(SIGSEGV,@SIG_DFL);
+ Signal(SIGFPE,@SIG_DFL);
+ Signal(SIGNOFP,@SIG_DFL);
+ Signal(SIGTRAP,@SIG_DFL);
+ Signal(SIGTIMR,@SIG_DFL);
+ Signal(SIGINT,@SIG_DFL);
+ Signal(SIGQUIT,@SIG_DFL);
+ Signal(SIGILL,@SIG_DFL);
+end;
+{$endif IN_DPMIEXCP_UNIT}
+
+procedure InitDPMIExcp;
+begin
+{$ifdef CREATE_C_FUNCTIONS}
+ djgpp_ds_alias:=v2prt0_ds_alias;
+ djgpp_exception_setup;
+{$endif CREATE_C_FUNCTIONS}
+end;
+
+{$ifndef IN_SYSTEM}
+
+begin
+{$ifdef CREATE_C_FUNCTIONS}
+ InitDPMIExcp;
+{$else not CREATE_C_FUNCTIONS}
+ ResetDefaultHandlers;
+{$endif CREATE_C_FUNCTIONS}
+end.
+{$else IN_SYSTEM}
+
+const
+ FPU_ControlWord : word = $1332;
+
+
+function HandleException(sig : longint) : longint;
+var
+ truesig : longint;
+ ErrorOfSig : longint;
+ FpuStatus,FPUControl : word;
+ eip,ebp : longint;
+begin
+ if assigned(djgpp_exception_state_ptr) then
+ truesig:=djgpp_exception_state_ptr^.__signum
+ else
+ truesig:=sig;
+ ErrorOfSig:=0;
+ case truesig of
+ {exception_names : array[0..EXCEPTIONCOUNT-1] of pchar = (}
+ 0 : ErrorOfSig:=200; {'Division by Zero'}
+ 5 : ErrorOfSig:=201; {'Bounds Check'}
+ 12 : ErrorOfSig:=202; {'Stack Fault'}
+ 7, {'Coprocessor not available'}
+ 9, {'Coprocessor overrun'}
+ SIGNOFP : ErrorOfSig:=207;
+ 16,SIGFPE,$75 : begin
+ { This needs special handling }
+ { to discriminate between 205,206 and 207 }
+
+ if truesig=$75 then
+ fpustatus:=djgpp_exception_state_ptr^.__sigmask and $ffff
+ else
+ asm
+ fnstsw %ax
+ fnclex
+ movw %ax,fpustatus
+ end;
+ if (FpuStatus and FPU_Invalid)<>0 then
+ ErrorOfSig:=216
+ else if (FpuStatus and FPU_Denormal)<>0 then
+ ErrorOfSig:=216
+ else if (FpuStatus and FPU_DivisionByZero)<>0 then
+ ErrorOfSig:=200
+ else if (FpuStatus and FPU_Overflow)<>0 then
+ ErrorOfSig:=205
+ else if (FpuStatus and FPU_Underflow)<>0 then
+ ErrorOfSig:=206
+ else
+ ErrorOfSig:=207; {'Coprocessor Error'}
+ { if exceptions then Reset FPU and reload control word }
+ if (FPUStatus and FPU_ExceptionMask)<>0 then
+ asm
+ fninit
+ fldcw FPU_ControlWord
+ end;
+ end;
+ 4 : ErrorOfSig:=215; {'Overflow'}
+ 1, {'Debug'}
+ 2, {'NMI'}
+ 3, {'Breakpoint'}
+ 6, {'Invalid Opcode'}
+ 8, {'Double Fault'}
+ 10, {'Invalid TSS'}
+ 11, {'Segment Not Present'}
+ 13, {'General Protection Fault'}
+ 14, {'Page fault'}
+ 15, {' ',}
+ 17, {'Alignment Check',}
+ 18, {'Machine Check',}
+ 19, {'SSE FP error'}
+ SIGSEGV,SIGTRAP,SIGTIMR,SIGINT,SIGQUIT
+ : ErrorOfSig:=216;
+ end;
+ if assigned(djgpp_exception_state_ptr) then
+ Begin
+ if exception_level>0 then
+ dec(exception_level);
+ eip:=djgpp_exception_state_ptr^.__eip;
+ ebp:=djgpp_exception_state_ptr^.__ebp;
+ djgpp_exception_state_ptr:=djgpp_exception_state_ptr^.__exception_ptr;
+ HandleErrorAddrFrame(ErrorOfSig,pointer(eip),pointer(ebp));
+ End
+ else
+ { probably higher level is required }
+ HandleErrorFrame(ErrorOfSig,get_caller_frame(get_frame));
+ HandleException:=0;
+end;
+
+procedure InstallDefaultHandlers;
+begin
+ Signal(SIGSEGV,@HandleException);
+ Signal(SIGFPE,@HandleException);
+ Signal(SIGNOFP,@HandleException);
+ Signal(SIGTRAP,@HandleException);
+ Signal(SIGTIMR,@HandleException);
+ Signal(SIGINT,@HandleException);
+ Signal(SIGQUIT,@HandleException);
+ Signal(SIGILL,@HandleException);
+end;
+{$endif IN_SYSTEM}
+{
+ $Log: dpmiexcp.pp,v $
+ Revision 1.18 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/dxeload.pp b/rtl/go32v2/dxeload.pp
new file mode 100644
index 0000000000..80efc47e2c
--- /dev/null
+++ b/rtl/go32v2/dxeload.pp
@@ -0,0 +1,94 @@
+{
+ $Id: dxeload.pp,v 1.9 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller,
+ member of the Free Pascal development team.
+
+ Unit to Load DXE files for Go32V2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+
+Unit dxeload;
+interface
+
+function dxe_load(filename : string) : pointer;
+
+implementation
+
+uses
+ dxetype;
+
+function dxe_load(filename : string) : pointer;
+{
+ Copyright (C) 1995 Charles Sandmann (sandmann@clio.rice.edu)
+ translated to Free Pascal by Pierre Muller
+}
+type
+ { to avoid range check problems }
+ pointer_array = array[0..maxlongint div sizeof(pointer)-1] of pointer;
+ tpa = ^pointer_array;
+var
+ dh : dxe_header;
+ data : pchar;
+ f : file;
+ relocs : tpa;
+ i : longint;
+ addr : pcardinal;
+begin
+ dxe_load:=nil;
+{ open the file }
+ assign(f,filename);
+{$I-}
+ reset(f,1);
+{$I+}
+ { quit if no file !! }
+ if ioresult<>0 then
+ exit;
+{ load the header }
+ blockread(f,dh,sizeof(dxe_header),i);
+ if (i<>sizeof(dxe_header)) or (dh.magic<>DXE_MAGIC) then
+ begin
+ close(f);
+ exit;
+ end;
+{ get memory for code }
+ getmem(data,dh.element_size);
+ if data=nil then
+ exit;
+{ get memory for relocations }
+ getmem(relocs,dh.nrelocs*sizeof(pointer));
+ if relocs=nil then
+ begin
+ freemem(data,dh.element_size);
+ exit;
+ end;
+{ copy code }
+ blockread(f,data^,dh.element_size);
+ blockread(f,relocs^,dh.nrelocs*sizeof(pointer));
+ close(f);
+{ relocate internal references }
+ for i:=0 to dh.nrelocs-1 do
+ begin
+ cardinal(addr):=cardinal(data)+cardinal(relocs^[i]);
+ addr^:=addr^+cardinal(data);
+ end;
+ FreeMem(relocs,dh.nrelocs*sizeof(pointer));
+ dxe_load:=pointer( dh.symbol_offset + cardinal(data));
+end;
+
+end.
+{
+ $Log: dxeload.pp,v $
+ Revision 1.9 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/dxetype.pp b/rtl/go32v2/dxetype.pp
new file mode 100644
index 0000000000..6c715d6ea6
--- /dev/null
+++ b/rtl/go32v2/dxetype.pp
@@ -0,0 +1,42 @@
+{
+ $Id: dxetype.pp,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller,
+ member of the Free Pascal development team.
+
+ Support unit for working with DXE files for Go32V2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+unit dxetype;
+
+interface
+
+const
+ DXE_MAGIC = $31455844;
+
+type
+ dxe_header = record
+ magic,
+ symbol_offset,
+ element_size,
+ nrelocs : cardinal;
+ end;
+
+implementation
+
+end.
+{
+ $Log: dxetype.pp,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/emu387.pp b/rtl/go32v2/emu387.pp
new file mode 100644
index 0000000000..e582c3fb23
--- /dev/null
+++ b/rtl/go32v2/emu387.pp
@@ -0,0 +1,223 @@
+{
+ $Id: emu387.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller
+
+ FPU Emulator support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit emu387;
+interface
+
+procedure npxsetup(prog_name : string);
+
+
+implementation
+
+{$asmmode ATT}
+
+uses
+ dxeload,dpmiexcp,strings;
+
+type
+ emu_entry_type = function(exc : pexception_state) : longint;
+
+var
+ _emu_entry : emu_entry_type;
+
+
+procedure _control87(mask1,mask2 : longint);
+begin
+{ Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details }
+{ from file cntrl87.s in src/libc/pc_hw/fpu }
+ asm
+ { make room on stack }
+ pushl %eax
+ fstcw (%esp)
+ fwait
+ popl %eax
+ andl $0xffff, %eax
+ { OK; we have the old value ready }
+
+ movl mask2, %ecx
+ notl %ecx
+ andl %eax, %ecx { the bits we want to keep }
+
+ movl mask2, %edx
+ andl mask1, %edx { the bits we want to change }
+
+ orl %ecx, %edx { the new value }
+ pushl %edx
+ fldcw (%esp)
+ popl %edx
+ end;
+end;
+
+
+{ the problem with the stack that is not cleared }
+function emu_entry(exc : pexception_state) : longint;
+begin
+ emu_entry:=_emu_entry(exc);
+end;
+
+
+function nofpsig( sig : longint) : longint;
+const
+ last_eip : longint = 0;
+var
+ res : longint;
+begin
+ {if last_eip=djgpp_exception_state^.__eip then
+ begin
+ writeln('emu call two times at same address');
+ dpmi_set_coprocessor_emulation(1);
+ _raise(SIGFPE);
+ exit(0);
+ end; }
+ last_eip:=djgpp_exception_state^.__eip;
+ res:=emu_entry(djgpp_exception_state);
+ if res<>0 then
+ begin
+ writeln('emu call failed. res = ',res);
+ dpmi_set_coprocessor_emulation(1);
+ _raise(SIGFPE);
+ exit(0);
+ end;
+ dpmi_longjmp(pdpmi_jmp_buf(djgpp_exception_state)^, djgpp_exception_state^.__eax);
+ nofpsig:=0;
+end;
+
+
+var
+ prev_exit : pointer;
+
+procedure restore_DPMI_fpu_state;
+begin
+ exitproc:=prev_exit;
+ { Enable Coprocessor, no exceptions }
+ dpmi_set_coprocessor_emulation(1);
+{$ifdef SYSTEMDEBUG}
+ writeln(stderr,'Coprocessor restored ');
+{$endif}
+end;
+
+{ function _detect_80387 : boolean;
+ not used because of the underscore problem }
+
+{$L fpu.o }
+
+
+function getenv(const envvar:string):string;
+{ Copied here, preserves uses Dos (PFV) }
+var
+ hp : ppchar;
+ hs,
+ _envvar : string;
+ eqpos : longint;
+begin
+ _envvar:=upcase(envvar);
+ hp:=envp;
+ getenv:='';
+ while assigned(hp^) do
+ begin
+ hs:=strpas(hp^);
+ eqpos:=pos('=',hs);
+ if copy(hs,1,eqpos-1)=_envvar then
+ begin
+ getenv:=copy(hs,eqpos+1,255);
+ exit;
+ end;
+ inc(hp);
+ end;
+end;
+
+
+function __detect_80387:byte;external name '__detect_80387';
+
+procedure npxsetup(prog_name : string);
+var
+ cp : string;
+ i : byte;
+ have_80387 : boolean;
+ emu_p : pointer;
+const
+ veryfirst : boolean = True;
+begin
+ cp:=getenv('387');
+ if (length(cp)>0) and (upcase(cp[1])='N') then
+ have_80387:=False
+ else
+ begin
+ dpmi_set_coprocessor_emulation(1);
+ asm
+ call __detect_80387
+ movb %al,have_80387
+ end;
+ end;
+ if (length(cp)>0) and (upcase(cp[1])='Q') then
+ begin
+ if not have_80387 then
+ write(stderr,'No ');
+ writeln(stderr,'80387 detected.');
+ end;
+
+ if have_80387 then
+ begin
+ { mask all exceptions, except invalid operation }
+ { change to same value as in v2prt0.as (PM) }
+ _control87($0332, $ffff)
+ end
+ else
+ begin
+ { Flags value 3 means coprocessor emulation, exceptions to us }
+ if (dpmi_set_coprocessor_emulation(3)<>0) then
+ begin
+ writeln(stderr,'Warning: Coprocessor not present and DPMI setup failed!');
+ writeln(stderr,' If application attempts floating operations system may hang!');
+ end
+ else
+ begin
+ cp:=getenv('EMU387');
+ if length(cp)=0 then
+ begin
+ for i:=length(prog_name) downto 1 do
+ if (prog_name[i]='\') or (prog_name[i]='/') then
+ break;
+ if i>1 then
+ cp:=copy(prog_name,1,i);
+ cp:=cp+'wmemu387.dxe';
+ end;
+ emu_p:=dxe_load(cp);
+ _emu_entry:=emu_entry_type(emu_p);
+ if (emu_p=nil) then
+ begin
+ writeln(cp+' load failed !');
+ halt;
+ end;
+ if veryfirst then
+ begin
+ veryfirst:=false;
+ prev_exit:=exitproc;
+ exitproc:=@restore_DPMI_fpu_state;
+ end;
+ signal(SIGNOFP,@nofpsig);
+ end;
+ end;
+end;
+
+begin
+ npxsetup(paramstr(0));
+end.
+{
+ $Log: emu387.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/exceptn.as b/rtl/go32v2/exceptn.as
new file mode 100644
index 0000000000..545656ed4b
--- /dev/null
+++ b/rtl/go32v2/exceptn.as
@@ -0,0 +1,495 @@
+/* Copyright (C) 1994, 1995 Charles Sandmann (sandmann@clio.rice.edu)
+ * This file maybe freely distributed and modified as long as copyright remains.
+ */
+
+ EAX = 0
+ EBX = 4
+ ECX = 8
+ EDX = 12
+ ESI = 16
+ EDI = 20
+ EBP = 24
+ ESP = 28
+ EIP = 32
+ EFLAGS = 36
+ CS = 40
+ DS = 42
+ ES = 44
+ FS = 46
+ GS = 48
+ SS = 50
+ ERRCODE = 52
+ EXCEPNO = 56
+ PREVEXC = 60
+/* Length 64 bytes plus non-used FPU */
+ .data
+ .balign 8
+ .comm exception_stack, 8000
+
+ .text
+ .balign 16,,7
+ .macro EXCEPTION_ENTRY number
+ pushl \number
+ jmp exception_handler
+ .endm
+
+ .global ___djgpp_exception_table
+___djgpp_exception_table:
+EXCEPTION_ENTRY $18
+EXCEPTION_ENTRY $19
+EXCEPTION_ENTRY $0
+EXCEPTION_ENTRY $1
+EXCEPTION_ENTRY $2
+EXCEPTION_ENTRY $3
+EXCEPTION_ENTRY $4
+EXCEPTION_ENTRY $5
+EXCEPTION_ENTRY $6
+EXCEPTION_ENTRY $7
+EXCEPTION_ENTRY $8
+EXCEPTION_ENTRY $9
+EXCEPTION_ENTRY $10
+EXCEPTION_ENTRY $11
+EXCEPTION_ENTRY $12
+EXCEPTION_ENTRY $13
+EXCEPTION_ENTRY $14
+EXCEPTION_ENTRY $15
+EXCEPTION_ENTRY $16
+EXCEPTION_ENTRY $17
+
+/* This code is called any time an exception occurs in the 32 bit protected
+;* mode code. The exception number is pushed on the stack. This is called
+;* on a locked stack with interrupts disabled. Don't try to terminate.
+;*
+;* [ * | SS ] * Don't modify
+;* [ ESP ]
+;* [ EFLAGS ]
+;* [ * | CS ] * Don't modify
+;* [ EIP ]
+;* [ ERR CODE ]
+;* [ * |RET CS*] * Don't modify
+;* [ RET EIP* ] * Don't modify
+;* [ EXCEPTION # ] (And later EBP)
+;*/
+/* ;WARNING WARNING WARNING
+ ;The mechanism for passing signals between the debugger
+ ;and the debuggee relies on the *exact* instructions between
+ ;EXCEPTION_ENTRY($13) above and "cmpb $0, forced" instruction
+ ;below! These instructions are stored in forced_test[] buffer
+ ;in src/debug/common/dbgcom.c. Do NOT change anything between
+ ;these two instructions, or you will break signal support in
+ ;the debuggers!! */
+exception_handler:
+ pushl %ebx
+ pushl %ds
+ .byte 0x2e /* CS: */
+ cmpb $0, forced
+ je not_forced
+ call limitFix
+ .byte 0x2e /* CS: */
+ movzbl forced,%ebx
+ movl %ebx,8(%esp) /* replace EXCEPNO */
+ cmpb $0x75, %bl
+ jne not_forced
+ movzwl ___djgpp_fpu_state,%ebx
+ movl %ebx,20(%esp) /* set ERRCODE to FPU state */
+not_forced:
+ movw %cs:___djgpp_our_DS, %ds
+ movl $0x10000, forced /* its zero now, flag inuse */
+ movl $exception_state, %ebx
+ popl DS(%ebx)
+ popl EBX(%ebx)
+ popl EXCEPNO(%ebx)
+ movl %esi, ESI(%ebx)
+ movl %edi, EDI(%ebx)
+ movl %ebp, EBP(%ebx)
+ movl %eax, EAX(%ebx)
+ movl %ecx, ECX(%ebx)
+ movl %edx, EDX(%ebx)
+ movw %es, ES(%ebx)
+ movw %fs, FS(%ebx)
+ movw %gs, GS(%ebx)
+ movl ___djgpp_exception_state_ptr, %eax
+ movl %eax, PREVEXC(%ebx)
+
+/* Stack clean at this point, DS:[EBX] points to exception_state, all
+ register information saved. Now get the info on stack. */
+
+ pushl %ebp
+ movl %esp, %ebp /* load ebp with stack for easy access */
+
+ movl 12(%ebp), %eax
+ movl %eax, ERRCODE(%ebx)
+ movl 16(%ebp), %eax
+ movl %eax, EIP(%ebx)
+ movl 20(%ebp), %eax
+ movw %ax, CS(%ebx)
+ movl 24(%ebp), %eax
+ movl %eax, EFLAGS(%ebx)
+ andb $0xfe, %ah /* Clear trace flag */
+ movl %eax, 24(%ebp) /* and restore on stack */
+
+ movl 28(%ebp), %eax
+ movl %eax, ESP(%ebx)
+ movl 32(%ebp), %eax
+ movw %ax, SS(%ebx)
+
+ movl $dpmi_exception_proc1, 16(%ebp) /* where to return */
+ movw %cs, 20(%ebp)
+
+/* Change to our local stack on return from exception (maybe stack exception) */
+ movw %ds, %ax
+ cmpb $12,EXCEPNO(%ebx) /* Stack fault ? */
+ je 1f
+ cmpw %ax,32(%ebp)
+ je stack_ok
+ .byte 0x2e /* CS: */
+ movw ___djgpp_ds_alias,%di
+ cmpw %di,32(%ebp) /* if it's DS alias, switch to normal DS */
+ jne 1f
+ movw %ax,32(%ebp)
+ jmp stack_ok
+1: movl $exception_stack+8000, 28(%ebp)
+ movw %ax, 32(%ebp)
+stack_ok:
+/* Now copy the exception structure to the new stack before returning */
+ movw %ax, %es
+ movl %ebx,%esi
+ movl 28(%ebp), %edi
+ subl $92, %edi /* 64 plus extra for longjmp */
+ movl %edi, 28(%ebp)
+ movl %edi, ___djgpp_exception_state_ptr
+ movl $16, %ecx
+ cld
+ rep
+ movsl
+
+ movl EAX(%ebx), %eax /* restore regs */
+ movl ESI(%ebx), %esi
+ movl EDI(%ebx), %edi
+ movl ECX(%ebx), %ecx
+ movw ES(%ebx), %es
+ popl %ebp
+ pushl EBX(%ebx)
+ pushl DS(%ebx)
+ movb $0, forced+2 /* flag non-use */
+ popl %ds
+ popl %ebx
+ lret
+
+/* Code to fix fake exception, EBX destroyed. Note, app_DS may == our_DS! */
+ .balign 16,,7
+limitFix:
+ pushl %eax
+ pushl %ecx
+ pushl %edx
+ .byte 0x2e /* CS: */
+ movl ___djgpp_app_DS, %ebx /* avoid size prefix */
+ .byte 0x2e /* CS: */
+ movl ds_limit, %edx
+ movl %edx, %ecx
+ shrl $16, %ecx
+ movw $0x0008, %ax
+ int $0x31 /* Set segment limit */
+ popl %edx
+ popl %ecx
+ popl %eax
+ ret
+
+/* This local routine preprocesses a return request to the C code. It checks
+ to make sure the DS & SS are set OK for C code. If not, it sets them up */
+ .balign 16,,7
+dpmi_exception_proc1:
+ cld
+ .byte 0x2e /* CS: !!! */
+ movw ___djgpp_our_DS, %bx /* to be sure */
+ movw %bx, %ds
+ movw %bx, %es
+ /* Note: SS:ESP should be set properly by exception routine */
+ jmp ___djgpp_exception_processor
+
+/* This code is called by a user routine wishing to save an interrupt
+;* state. It will return with a clean stack, our DS,ES,SS.
+;* Minor bug: uses static exception_state for a short window without
+;* interrupts guaranteed disabled.
+;*
+;* [ EFLAGS ]
+;* [ * | CS ]
+;* [ EIP ]
+;* [ CALLING EIP ]
+;*/
+
+ .balign 16,,7
+ .globl ___djgpp_save_interrupt_regs
+___djgpp_save_interrupt_regs:
+ pushl %esi
+ pushl %ds
+ movw %cs:___djgpp_our_DS, %ds
+ movl $exception_state, %esi
+ popl DS(%esi) /* Trashes ES but OK */
+ popl ESI(%esi)
+ movl %edi, EDI(%esi)
+ movl %ebp, EBP(%esi)
+ movl %eax, EAX(%esi)
+ movl %ebx, EBX(%esi)
+ movl %ecx, ECX(%esi)
+ movl %edx, EDX(%esi)
+ popl %edx /* Save calling EIP */
+ popl EIP(%esi)
+ popl %eax
+ movw %ax,CS(%esi) /* Don't pop, nukes DS */
+ popl EFLAGS(%esi)
+ movl %esp, ESP(%esi)
+ movw %es, ES(%esi)
+ movw %fs, FS(%esi)
+ movw %gs, GS(%esi)
+ movw %ss, SS(%esi)
+ movl ___djgpp_exception_state_ptr, %eax
+ movl %eax, PREVEXC(%esi)
+ cld
+ movw %ds, %ax
+ movw %ax, %es
+ movw %ss, %bx
+ cmpw %ax, %bx /* is SS = DS ? */
+ je Lss_ok
+ movw %ax, %ss /* set new SS:ESP */
+ movl $exception_stack+8000, %esp
+Lss_ok: subl $92, %esp /* 64 plus extra for longjmp */
+ movl %esp, %edi
+ movl $16, %ecx
+ movl %edi, ___djgpp_exception_state_ptr
+ rep
+ movsl /* Copy structure to stack */
+ jmp *%edx /* A "return" */
+
+ .balign 8 /* We will touch this; it must be locked */
+ .global ___djgpp_hw_lock_start
+___djgpp_hw_lock_start:
+ /* src/debug/common/dbgcom.c knows that `ds_limit' is stored
+ 4 bytes before `forced' and relies on that. Do NOT change that! */
+ds_limit: .long 0
+forced: .long 0
+ .global ___djgpp_cbrk_count
+___djgpp_cbrk_count: .long 0
+ .global ___djgpp_timer_countdown
+___djgpp_timer_countdown: .long 0
+ .global ___djgpp_our_DS
+___djgpp_our_DS: .word 0
+ .global ___djgpp_app_DS
+___djgpp_app_DS: .word 0
+ .global ___djgpp_dos_sel
+___djgpp_dos_sel: .word 0
+ .global ___djgpp_hwint_flags
+___djgpp_hwint_flags: .word 0
+ .global ___djgpp_sigint_key
+___djgpp_sigint_key: .word 0 /* scan code and kb status */
+ .global ___djgpp_sigint_mask
+___djgpp_sigint_mask: .word 0 /* kb status mask */
+ .global ___djgpp_sigquit_key
+___djgpp_sigquit_key: .word 0
+ .global ___djgpp_sigquit_mask
+___djgpp_sigquit_mask: .word 0
+ .global ___djgpp_old_kbd
+___djgpp_old_kbd: .long 0,0
+ .global ___djgpp_old_timer
+___djgpp_old_timer: .long 0,0
+ .global ___djgpp_exception_state_ptr
+___djgpp_exception_state_ptr: .long 0
+exception_state: .space 64
+ .global ___djgpp_ds_alias
+___djgpp_ds_alias: .word 0 /* used in dpmi/api/d0303.s (alloc rmcb) */
+
+ .global ___djgpp_fpu_state
+___djgpp_fpu_state: .word 0
+ .balign 16,,7
+ .global ___djgpp_npx_hdlr
+___djgpp_npx_hdlr:
+ fnstsw ___djgpp_fpu_state
+ fnclex
+ pushl %eax
+ xorl %eax,%eax
+ outb %al,$0x0f0
+ movb $0x20,%al
+ outb %al,$0x0a0
+ outb %al,$0x020
+ movb $0x75,%al
+hw_to_excp:
+ call ___djgpp_hw_exception
+ popl %eax
+ sti
+ iret
+
+ .balign 16,,7
+ .global ___djgpp_kbd_hdlr
+___djgpp_kbd_hdlr:
+ pushl %eax
+ pushl %ebx
+ pushl %ds
+ .byte 0x2e /* CS: */
+ testb $1, ___djgpp_hwint_flags /* Disable? */
+ jne Lkbd_chain
+ movw %cs:___djgpp_dos_sel, %ds /* Conventional mem selector */
+/* movw $0x7021,0xb0f00 */ /* Test code - write to mono */
+/* Check Keyboard status bits */
+ movb 0x417,%ah /* Get KB status byte */
+ testb $1,%ah
+ je 6f
+ orb $2,%ah /* If RShift is set, set LShift as well */
+6:
+ inb $0x60,%al /* Read the scan code */
+99:
+ movb %ah,%bh /* Save KB status */
+ andb %cs:___djgpp_sigint_mask, %ah /* Mask off irrelevant bits */
+ cmpw %cs:___djgpp_sigint_key, %ax /* Test for SIGINT */
+ jne 7f
+ movb $0x79,%bh /* SIGINT */
+ jmp 98f
+7:
+ movb %bh,%ah /* Restore KB status */
+ andb %cs:___djgpp_sigquit_mask, %ah /* Mask off irrelevant bits */
+ cmpw %cs:___djgpp_sigquit_key, %ax /* Test for SIGQUIT*/
+ jne Lkbd_chain
+ movb $0x7a,%bh /* SIGQUIT */
+/* Clear interrupt, (later: remove byte from controller?)
+ movb $0x20,%al
+ outb %al,$0x020 */
+98:
+ movb %bh,%al
+ call ___djgpp_hw_exception
+Lkbd_chain:
+ popl %ds
+ popl %ebx
+ popl %eax
+ ljmp %cs:___djgpp_old_kbd
+
+ .balign 16,,7
+ .global ___djgpp_kbd_hdlr_pc98
+___djgpp_kbd_hdlr_pc98:
+ pushl %eax
+ pushl %ebx
+ pushl %ds
+ .byte 0x2e /* CS: */
+ testb $1, ___djgpp_hwint_flags /* Disable? */
+ jne Lkbd_chain
+/* Check CTRL state */
+ movw %cs:___djgpp_dos_sel, %ds /* Conventional mem selector */
+ movb 0x053a,%al /* Get KB status byte */
+ /* Convert PC98 style status byte to PC/AT style */
+ movb %al,%ah
+ andb $0x09,%ah /* GRPH(=ALT), SHIFT(=R-Shift) */
+ testb $0x02,%al
+ je 981f
+ orb $0x40,%ah /* CAPS(=Caps Lock) */
+981: testb $0x10,%al
+ je 982f
+ orb $0x04,%ah /* CTRL(=Ctrl) */
+982: testb $0x01,%al
+ je 983f
+ orb $0x02,%ah /* SHIFT(=L-Shift) */
+983: testb $0x04,%al
+ je 984f
+ orb $0x20,%ah /* KANA(=NUM Lock) */
+984: inb $0x41,%al /* Read the scan code */
+ jmp 99b
+
+ .balign 16,,7
+ .global ___djgpp_timer_hdlr
+___djgpp_timer_hdlr:
+ .byte 0x2e /* CS: */
+ cmpl $0,___djgpp_timer_countdown
+ je 4f
+ pushl %ds
+ movw %cs:___djgpp_ds_alias, %ds
+ decl ___djgpp_timer_countdown
+ popl %ds
+ jmp 3f
+4:
+ pushl %eax
+ movb $0x78,%al
+ call ___djgpp_hw_exception
+ popl %eax
+3:
+ .byte 0x2e /* CS: */
+ testb $4, ___djgpp_hwint_flags /* IRET or chain? */
+ jne 2f
+ ljmp %cs:___djgpp_old_timer
+2:
+ pushl %eax
+ movb $0x20,%al /* EOI the interrupt */
+ outb %al,$0x020
+ popl %eax
+ iret
+
+ /* On entry ES is the DS alias selector */
+ .balign 16,,7
+ .global ___djgpp_cbrk_hdlr /* A RMCB handler for 0x1b */
+___djgpp_cbrk_hdlr:
+ cld
+ lodsl /* EAX = DS:[esi] CS:IP */
+ movl %eax, %es:0x2a(%edi) /* store in structure */
+ lodsl /* AX = FLAGS */
+ movw %ax, %es:0x20(%edi)
+ addw $6, %es:0x2e(%edi) /* Adjust RM SP */
+ movb $0x1b,%al
+
+ .byte 0x2e /* CS: */
+ testb $2, ___djgpp_hwint_flags /* Count, don't kill */
+ jne 1f
+
+ call ___djgpp_hw_exception
+ iret
+1:
+ incl %es:___djgpp_cbrk_count
+ iret
+
+ .global ___djgpp_i24 /* Int 24 handler if needed */
+ .global ___djgpp_iret /* Int 23 handler if needed */
+___djgpp_i24:
+ movb $3,%al
+___djgpp_iret:
+ iret
+
+/* Code to stop execution ASAP, EAX destroyed. Make DS/ES/SS invalid.
+ Fake exception value is passed in AL and moved into the "forced" variable.
+ This is used to convert a HW interrupt into something we can transfer
+ control away from via longjmp or exit(), common with SIGINT, SIGFPE, or
+ if we want EIP information on timers. */
+
+ .balign 16,,7
+ .global ___djgpp_hw_exception
+___djgpp_hw_exception:
+ .byte 0x2e /* CS: */
+ cmpl $0, forced /* Already flagged? */
+ jne already_forced
+ pushl %ebx
+ pushl %ecx
+ pushl %edx
+ pushl %ds
+ movw %cs:___djgpp_our_DS, %ds
+ movl ___djgpp_app_DS, %ebx /* avoid size prefix */
+ lsl %ebx, %ecx
+ movl %ecx, ds_limit /* Save current limit */
+ movb %al, forced /* Indicate a fake exception */
+ xorl %ecx, %ecx
+ movw $0xfff, %dx /* 4K limit is null page ! */
+ movw $0x0008, %ax
+ int $0x31 /* Set segment limit */
+5: popl %ds
+ popl %edx
+ popl %ecx
+ popl %ebx
+already_forced:
+ ret
+
+ .global ___djgpp_hw_lock_end
+___djgpp_hw_lock_end:
+ ret /* LD does weird things */
+
+/*
+ $Log: exceptn.as,v $
+ Revision 1.6 2002/09/08 09:16:15 jonas
+ * added closing of comment for logs to avoid warning
+
+ Revision 1.5 2002/09/07 16:01:18 peter
+ * old logs removed and tabs fixed
+
+*/ \ No newline at end of file
diff --git a/rtl/go32v2/exit16.ah b/rtl/go32v2/exit16.ah
new file mode 100644
index 0000000000..899e5762f5
--- /dev/null
+++ b/rtl/go32v2/exit16.ah
@@ -0,0 +1 @@
+ .byte 0xb8,0x01,0x00,0xcd,0x31,0xb8,0x02,0x05,0xcd,0x31,0x88,0xd0,0xb4,0x4c,0xcd,0x21
diff --git a/rtl/go32v2/exit16.asm b/rtl/go32v2/exit16.asm
new file mode 100644
index 0000000000..cf96c14547
--- /dev/null
+++ b/rtl/go32v2/exit16.asm
@@ -0,0 +1,22 @@
+; Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details
+;-----------------------------------------------------------------------------
+; exit 16-bit helper
+;
+; Used to clean up 32-bit arena on exit, so as to release as many
+; selectors and as much memory as possible.
+;
+; Call with: BX = 32-bit CS to free
+; SI:DI = 32-bit memory handle to free
+; DL = exit status
+
+ .type "bin"
+
+ mov ax, 0x0001
+ int 0x31
+
+ mov ax, 0x0502
+ int 0x31
+
+ mov al, dl
+ mov ah, 0x4c
+ int 0x21
diff --git a/rtl/go32v2/fpu.as b/rtl/go32v2/fpu.as
new file mode 100644
index 0000000000..9caa4751d2
--- /dev/null
+++ b/rtl/go32v2/fpu.as
@@ -0,0 +1,59 @@
+/* $Id: fpu.as,v 1.4 2002/09/08 09:16:15 jonas Exp $ */
+/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
+/* Translated from tasm to GAS by C. Sandmann */
+/* One comment displaced to get it compiled by as.exe directly !!! */
+/* by Pierre Muller */
+
+/* This routine assumes DS == SS since [ESI] coding shorter than [EBP] coding */
+
+ .global __detect_80387 /* direct from the Intel manual */
+__detect_80387: /* returns 1 if 387 (or more), else 0 */
+ pushl %esi
+ pushl %eax /* Dummy work area on stack */
+ movl %esp,%esi
+ fninit
+ movw $0x5a5a,(%esi)
+ fnstsw (%esi)
+ cmpb $0,(%esi)
+ jne Lno_387
+
+ fnstcw (%esi)
+ movl (%esi),%eax /* Only ax significant */
+ andl $0x103f,%eax
+ cmpl $0x3f,%eax
+ jne Lno_387
+
+ fld1
+ fldz
+/* fdiv GAS encodes this as 0xdcf1 !! BUG */
+ .byte 0xde,0xf9
+ fld %st
+ fchs
+ fcompp
+ fstsw (%esi)
+ movzwl (%esi),%eax /* Clears upper %eax */
+ sahf
+ je Lno_387
+ fninit /* 387 present, initialize. */
+ fnstcw (%esi)
+ wait
+ andw $0x0fffa,(%esi)
+/* enable invalid operation exception */
+ fldcw (%esi)
+ movw $1,%ax
+ jmp Lexit
+Lno_387:
+ xorl %eax,%eax
+Lexit:
+ popl %esi /* Fix stack first */
+ popl %esi
+ ret
+/*
+ $Log: fpu.as,v $
+ Revision 1.4 2002/09/08 09:16:15 jonas
+ * added closing of comment for logs to avoid warning
+
+ Revision 1.3 2002/09/07 16:01:18 peter
+ * old logs removed and tabs fixed
+
+*/
diff --git a/rtl/go32v2/go32.pp b/rtl/go32v2/go32.pp
new file mode 100644
index 0000000000..57e4fa7197
--- /dev/null
+++ b/rtl/go32v2/go32.pp
@@ -0,0 +1,1193 @@
+{
+ $Id: go32.pp,v 1.8 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ and implements some stuff for protected mode programming
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit go32;
+
+{$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! }
+
+interface
+
+ const
+ { contants for the run modes returned by get_run_mode }
+ rm_unknown = 0;
+ rm_raw = 1; { raw (without HIMEM) }
+ rm_xms = 2; { XMS (for example with HIMEM, without EMM386) }
+ rm_vcpi = 3; { VCPI (for example HIMEM and EMM386) }
+ rm_dpmi = 4; { DPMI (for example DOS box or 386Max) }
+
+ { flags }
+ carryflag = $001;
+ parityflag = $004;
+ auxcarryflag = $010;
+ zeroflag = $040;
+ signflag = $080;
+ trapflag = $100;
+ interruptflag = $200;
+ directionflag = $400;
+ overflowflag = $800;
+
+ type
+ tmeminfo = record
+ available_memory,
+ available_pages,
+ available_lockable_pages,
+ linear_space,
+ unlocked_pages,
+ available_physical_pages,
+ total_physical_pages,
+ free_linear_space,
+ max_pages_in_paging_file,
+ reserved0,
+ reserved1,
+ reserved2 : longint;
+ end;
+
+ tseginfo = record
+ offset : pointer;
+ segment : word;
+ end;
+
+ trealregs = record
+ case integer of
+ 1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint;
+ Flags, ES, DS, FS, GS, IP, CS, SP, SS: word);
+ 2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word;
+ BX, BX2, DX, DX2, CX, CX2, AX, AX2: word);
+ 3: { 8-bit } (stuff: array[1..4] of longint;
+ BL, BH, BL2, BH2, DL, DH, DL2, DH2,
+ CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte);
+ 4: { Compat } (RealEDI, RealESI, RealEBP, RealRES,
+ RealEBX, RealEDX, RealECX, RealEAX: longint;
+ RealFlags,
+ RealES, RealDS, RealFS, RealGS,
+ RealIP, RealCS, RealSP, RealSS: word);
+ end;
+
+ registers = trealregs;
+
+ { this works only with real DPMI }
+ function allocate_ldt_descriptors(count : word) : word;
+ function free_ldt_descriptor(d : word) : boolean;
+ function segment_to_descriptor(seg : word) : word;
+ function get_next_selector_increment_value : word;
+ function get_segment_base_address(d : word) : longint;
+ function set_segment_base_address(d : word;s : longint) : boolean;
+ function set_segment_limit(d : word;s : longint) : boolean;
+ function set_descriptor_access_right(d : word;w : word) : longint;
+ function create_code_segment_alias_descriptor(seg : word) : word;
+ function get_linear_addr(phys_addr : longint;size : longint) : longint;
+ function get_segment_limit(d : word) : longint;
+ function get_descriptor_access_right(d : word) : longint;
+ function get_page_size:longint;
+ function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+ function realintr(intnr : word;var regs : trealregs) : boolean;
+
+ { is needed for functions which need a real mode buffer }
+ function global_dos_alloc(bytes : longint) : longint;
+ function global_dos_free(selector : word) : boolean;
+
+ var
+ { selector for the DOS memory (only usable if in DPMI mode) }
+ dosmemselector : word;
+ { result of dpmi call }
+ int31error : word;
+
+ { this procedure copies data where the source and destination }
+ { are specified by 48 bit pointers }
+ { Note: the procedure checks only for overlapping if }
+ { source selector=destination selector }
+ procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+ { fills a memory area specified by a 48 bit pointer with c }
+ procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char);
+ procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word);
+
+ {************************************}
+ { this works with all PM interfaces: }
+ {************************************}
+
+ function get_meminfo(var meminfo : tmeminfo) : boolean;
+ function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+ function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+ function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+ function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+ function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+ function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+ function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+ function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+ function free_rm_callback(var intaddr : tseginfo) : boolean;
+ function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+ function get_cs : word;
+ function get_ds : word;
+ function get_ss : word;
+
+ { locking functions }
+ function allocate_memory_block(size:longint):longint;
+ function free_memory_block(blockhandle : longint) : boolean;
+ function request_linear_region(linearaddr, size : longint;
+ var blockhandle : longint) : boolean;
+ function lock_linear_region(linearaddr, size : longint) : boolean;
+ function lock_data(var data;size : longint) : boolean;
+ function lock_code(functionaddr : pointer;size : longint) : boolean;
+ function unlock_linear_region(linearaddr, size : longint) : boolean;
+ function unlock_data(var data;size : longint) : boolean;
+ function unlock_code(functionaddr : pointer;size : longint) : boolean;
+
+ { disables and enables interrupts }
+ procedure disable;
+ procedure enable;
+
+ function inportb(port : word) : byte;
+ function inportw(port : word) : word;
+ function inportl(port : word) : longint;
+
+ procedure outportb(port : word;data : byte);
+ procedure outportw(port : word;data : word);
+ procedure outportl(port : word;data : longint);
+ function get_run_mode : word;
+
+ function transfer_buffer : longint;
+ function tb_segment : longint;
+ function tb_offset : longint;
+ function tb_size : longint;
+ procedure copytodos(var addr; len : longint);
+ procedure copyfromdos(var addr; len : longint);
+
+ procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
+ procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
+ procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint);
+ procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char);
+ procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
+
+
+
+ const
+ { this procedures are assigned to the procedure which are needed }
+ { for the current mode to access DOS memory }
+ { It's strongly recommended to use this procedures! }
+ dosmemput : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemput;
+ dosmemget : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemget;
+ dosmemmove : procedure(sseg,sofs,dseg,dofs : word;count : longint)=@dpmi_dosmemmove;
+ dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=@dpmi_dosmemfillchar;
+ dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=@dpmi_dosmemfillword;
+
+ implementation
+
+{$asmmode ATT}
+
+
+ { the following procedures copy from and to DOS memory using DPMI }
+ procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
+
+ begin
+ seg_move(get_ds,longint(@data),dosmemselector,seg*16+ofs,count);
+ end;
+
+ procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
+
+ begin
+ seg_move(dosmemselector,seg*16+ofs,get_ds,longint(@data),count);
+ end;
+
+ procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint);
+
+ begin
+ seg_move(dosmemselector,sseg*16+sofs,dosmemselector,dseg*16+dofs,count);
+ end;
+
+ procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char);
+
+ begin
+ seg_fillchar(dosmemselector,seg*16+ofs,count,c);
+ end;
+
+ procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
+
+ begin
+ seg_fillword(dosmemselector,seg*16+ofs,count,w);
+ end;
+
+
+ procedure test_int31(flag : longint);
+ begin
+ asm
+ pushl %ebx
+ movw $0,INT31ERROR
+ movl flag,%ebx
+ testb $1,%bl
+ jz .Lti31_1
+ movw %ax,INT31ERROR
+ xorl %eax,%eax
+ jmp .Lti31_2
+ .Lti31_1:
+ movl $1,%eax
+ .Lti31_2:
+ popl %ebx
+ end;
+ end;
+
+ function global_dos_alloc(bytes : longint) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movl bytes,%ebx
+ addl $0xf,%ebx // round up
+ shrl $0x4,%ebx // convert to Paragraphs
+ movl $0x100,%eax // function 0x100
+ int $0x31
+ jnc .LDos_OK
+ movw %ax,INT31ERROR
+ xorl %eax,%eax
+ jmp .LDos_end
+ .LDos_OK:
+ shll $0x10,%eax // return Segment in hi(Result)
+ movw %dx,%ax // return Selector in lo(Result)
+ .LDos_end:
+ movl %eax,__result
+ popl %ebx
+ end;
+ end;
+
+ function global_dos_free(selector : word) : boolean;
+
+ begin
+ asm
+ movw Selector,%dx
+ movl $0x101,%eax
+ int $0x31
+ setnc %al
+ movb %al,__RESULT
+ end;
+ end;
+
+ function realintr(intnr : word;var regs : trealregs) : boolean;
+
+ begin
+ regs.realsp:=0;
+ regs.realss:=0;
+ asm
+ { save all used registers to avoid crash under NTVDM }
+ { when spawning a 32-bit DPMI application }
+ pushl %edi
+ pushl %ebx
+ pushw %fs
+ movw intnr,%bx
+ xorl %ecx,%ecx
+ movl regs,%edi
+ { es is always equal ds }
+ movl $0x300,%eax
+ int $0x31
+ popw %fs
+ setnc %al
+ movb %al,__RESULT
+ popl %ebx
+ popl %edi
+ end;
+ end;
+
+ procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char);
+
+ begin
+ asm
+ pushl %edi
+ movl ofs,%edi
+ movl count,%ecx
+ movb c,%dl
+ { load es with selector }
+ pushw %es
+ movw seg,%ax
+ movw %ax,%es
+ { fill eax with duplicated c }
+ { so we can use stosl }
+ movb %dl,%dh
+ movw %dx,%ax
+ shll $16,%eax
+ movw %dx,%ax
+ movl %ecx,%edx
+ shrl $2,%ecx
+ cld
+ rep
+ stosl
+ movl %edx,%ecx
+ andl $3,%ecx
+ rep
+ stosb
+ popw %es
+ popl %edi
+ end;
+ end;
+
+ procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word);
+
+ begin
+ asm
+ pushl %edi
+ movl ofs,%edi
+ movl count,%ecx
+ movw w,%dx
+ { load segment }
+ pushw %es
+ movw seg,%ax
+ movw %ax,%es
+ { fill eax }
+ movw %dx,%ax
+ shll $16,%eax
+ movw %dx,%ax
+ movl %ecx,%edx
+ shrl $1,%ecx
+ cld
+ rep
+ stosl
+ movl %edx,%ecx
+ andl $1,%ecx
+ rep
+ stosw
+ popw %es
+ popl %edi
+ end;
+ end;
+
+ procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+ begin
+ if count=0 then
+ exit;
+ if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
+ asm
+ pushl %esi
+ pushl %edi
+ pushw %es
+ pushw %ds
+ cld
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ movl %ecx,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+ movl %eax,%ecx
+ andl $3,%ecx
+ rep
+ movsb
+ popw %ds
+ popw %es
+ popl %edi
+ popl %esi
+ end ['ECX','EAX']
+ else if (source<dest) then
+ { copy backward for overlapping }
+ asm
+ pushl %esi
+ pushl %edi
+ pushw %es
+ pushw %ds
+ std
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ addl %ecx,%esi
+ addl %ecx,%edi
+ movl %ecx,%eax
+ andl $3,%ecx
+ orl %ecx,%ecx
+ jz .LSEG_MOVE1
+
+ { calculate esi and edi}
+ decl %esi
+ decl %edi
+ rep
+ movsb
+ incl %esi
+ incl %edi
+ .LSEG_MOVE1:
+ subl $4,%esi
+ subl $4,%edi
+ movl %eax,%ecx
+ shrl $2,%ecx
+ rep
+ movsl
+ cld
+ popw %ds
+ popw %es
+ popl %edi
+ popl %esi
+ end ['ESI','EDI','ECX'];
+ end;
+
+ procedure outportb(port : word;data : byte);
+
+ begin
+ asm
+ movw port,%dx
+ movb data,%al
+ outb %al,%dx
+ end ['EAX','EDX'];
+ end;
+
+ procedure outportw(port : word;data : word);
+
+ begin
+ asm
+ movw port,%dx
+ movw data,%ax
+ outw %ax,%dx
+ end ['EAX','EDX'];
+ end;
+
+ procedure outportl(port : word;data : longint);
+
+ begin
+ asm
+ movw port,%dx
+ movl data,%eax
+ outl %eax,%dx
+ end ['EAX','EDX'];
+ end;
+
+ function inportb(port : word) : byte;
+
+ begin
+ asm
+ movw port,%dx
+ inb %dx,%al
+ movb %al,__RESULT
+ end ['EAX','EDX'];
+ end;
+
+ function inportw(port : word) : word;
+
+ begin
+ asm
+ movw port,%dx
+ inw %dx,%ax
+ movw %ax,__RESULT
+ end ['EAX','EDX'];
+ end;
+
+ function inportl(port : word) : longint;
+
+ begin
+ asm
+ movw port,%dx
+ inl %dx,%eax
+ movl %eax,__RESULT
+ end ['EAX','EDX'];
+ end;
+
+
+
+ function get_cs : word;assembler;
+ asm
+ movw %cs,%ax
+ end;
+
+
+ function get_ss : word;assembler;
+ asm
+ movw %ss,%ax
+ end;
+
+
+ function get_ds : word;assembler;
+ asm
+ movw %ds,%ax
+ end;
+
+
+ function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x205,%eax
+ movb vector,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movw (%eax),%dx
+ movw 4(%eax),%cx
+ movl $0x201,%eax
+ movb vector,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x212,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x203,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl $0x210,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl $0x202,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x204,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x200,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movzwl %dx,%edx
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function free_rm_callback(var intaddr : tseginfo) : boolean;
+ begin
+ asm
+ movl intaddr,%eax
+ movw (%eax),%dx
+ movw 4(%eax),%cx
+ movl $0x304,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ end;
+ end;
+
+ { here we must use ___v2prt0_ds_alias instead of from v2prt0.s
+ because the exception processor sets the ds limit to $fff
+ at hardware exceptions }
+
+ var
+ ___v2prt0_ds_alias : word; external name '___v2prt0_ds_alias';
+
+ function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl pm_func,%esi
+ movl reg,%edi
+ pushw %es
+ movw ___v2prt0_ds_alias,%ax
+ movw %ax,%es
+ pushw %ds
+ movw %cs,%ax
+ movw %ax,%ds
+ movl $0x303,%eax
+ int $0x31
+ popw %ds
+ popw %es
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl rmcb,%eax
+ movzwl %dx,%edx
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function allocate_ldt_descriptors(count : word) : word;
+
+ begin
+ asm
+ movw count,%cx
+ xorl %eax,%eax
+ int $0x31
+ movw %ax,__RESULT
+ end;
+ end;
+
+ function free_ldt_descriptor(d : word) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movl $1,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function segment_to_descriptor(seg : word) : word;
+
+ begin
+ asm
+ pushl %ebx
+ movw seg,%bx
+ movl $2,%eax
+ int $0x31
+ movw %ax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_next_selector_increment_value : word;
+
+ begin
+ asm
+ movl $3,%eax
+ int $0x31
+ movw %ax,__RESULT
+ end;
+ end;
+
+ function get_segment_base_address(d : word) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movl $6,%eax
+ int $0x31
+ xorl %eax,%eax
+ movw %dx,%ax
+ shll $16,%ecx
+ orl %ecx,%eax
+ movl %eax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_page_size:longint;
+ begin
+ asm
+ pushl %ebx
+ movl $0x604,%eax
+ int $0x31
+ shll $16,%ebx
+ movw %cx,%bx
+ movl %ebx,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function request_linear_region(linearaddr, size : longint;
+ var blockhandle : longint) : boolean;
+ var
+ pageofs : longint;
+
+ begin
+ pageofs:=linearaddr and $3ff;
+ linearaddr:=linearaddr-pageofs;
+ size:=size+pageofs;
+ asm
+ pushl %ebx
+ pushl %esi
+ movl $0x504,%eax
+ movl linearaddr,%ebx
+ movl size,%ecx
+ movl $1,%edx
+ xorl %esi,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl blockhandle,%eax
+ movl %esi,(%eax)
+ movl %ebx,pageofs
+ popl %esi
+ popl %ebx
+ end;
+ if pageofs<>linearaddr then
+ request_linear_region:=false;
+ end;
+
+ function allocate_memory_block(size:longint):longint;
+ begin
+ asm
+ pushl %ebx
+ pushl %esi
+ movl $0x501,%eax
+ movl size,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ andl $65535,%ecx
+ int $0x31
+ jnc .Lallocate_mem_block_err
+ xorl %ebx,%ebx
+ xorl %ecx,%ecx
+ .Lallocate_mem_block_err:
+ shll $16,%ebx
+ movw %cx,%bx
+ shll $16,%esi
+ movw %di,%si
+ movl %ebx,__RESULT
+ popl %esi
+ popl %ebx
+ end;
+ end;
+
+ function free_memory_block(blockhandle : longint) : boolean;
+ begin
+ asm
+ pushl %esi
+ movl blockhandle,%esi
+ movl %esi,%edi
+ shll $16,%esi
+ movl $0x502,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %esi
+ end;
+ end;
+
+ function lock_linear_region(linearaddr, size : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ pushl %edi
+ pushl %esi
+ movl $0x600,%eax
+ movl linearaddr,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %esi
+ popl %edi
+ popl %ebx
+ end;
+ end;
+
+ function lock_data(var data;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(@data)+get_segment_base_address(get_ds);
+ lock_data:=lock_linear_region(linearaddr,size);
+ end;
+
+ function lock_code(functionaddr : pointer;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+ lock_code:=lock_linear_region(linearaddr,size);
+ end;
+
+ function unlock_linear_region(linearaddr,size : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ pushl %edi
+ pushl %esi
+ movl $0x601,%eax
+ movl linearaddr,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %esi
+ popl %edi
+ popl %ebx
+ end;
+ end;
+
+ function unlock_data(var data;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(@data)+get_segment_base_address(get_ds);
+ unlock_data:=unlock_linear_region(linearaddr,size);
+ end;
+
+ function unlock_code(functionaddr : pointer;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+ unlock_code:=unlock_linear_region(linearaddr,size);
+ end;
+
+ function set_segment_base_address(d : word;s : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ leal s,%eax
+ movw (%eax),%dx
+ movw 2(%eax),%cx
+ movl $7,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_descriptor_access_right(d : word;w : word) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movw w,%cx
+ movl $9,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movw %ax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_segment_limit(d : word;s : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ leal s,%eax
+ movw (%eax),%dx
+ movw 2(%eax),%cx
+ movl $8,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_descriptor_access_right(d : word) : longint;
+
+ begin
+ asm
+ movzwl d,%eax
+ lar %eax,%eax
+ jz .L_ok
+ xorl %eax,%eax
+ .L_ok:
+ movl %eax,__RESULT
+ end;
+ end;
+ function get_segment_limit(d : word) : longint;
+
+ begin
+ asm
+ movzwl d,%eax
+ lsl %eax,%eax
+ jz .L_ok2
+ xorl %eax,%eax
+ .L_ok2:
+ movl %eax,__RESULT
+ end;
+ end;
+
+ function create_code_segment_alias_descriptor(seg : word) : word;
+
+ begin
+ asm
+ pushl %ebx
+ movw seg,%bx
+ movl $0xa,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movw %ax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_meminfo(var meminfo : tmeminfo) : boolean;
+
+ begin
+ asm
+ pushl %edi
+ movl meminfo,%edi
+ movl $0x500,%eax
+ int $0x31
+ pushf
+ movb %al,__RESULT
+ call test_int31
+ popl %edi
+ end;
+ end;
+
+ function get_linear_addr(phys_addr : longint;size : longint) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ pushl %edi
+ pushl %esi
+ movl phys_addr,%ebx
+ movl %ebx,%ecx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ movl $0x800,%eax
+ int $0x31
+ pushf
+ call test_int31
+ shll $16,%ebx
+ movw %cx,%bx
+ movl %ebx,__RESULT
+ popl %esi
+ popl %edi
+ popl %ebx
+ end;
+ end;
+
+ procedure disable;assembler;
+
+ asm
+ cli
+ end;
+
+ procedure enable;assembler;
+
+ asm
+ sti
+ end;
+
+
+ var
+ _run_mode : word;external name '_run_mode';
+
+ function get_run_mode : word;
+
+ begin
+ get_run_mode:=_run_mode;
+ end;
+
+ function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+ begin
+ asm
+ pushl %ebx
+ pushl %edi
+ pushl %esi
+ movl device,%edx
+ movl handle,%esi
+ movl offset,%ebx
+ movl pagecount,%ecx
+ movl $0x0508,%eax
+ int $0x31
+ pushf
+ setnc %al
+ movb %al,__RESULT
+ call test_int31
+ popl %esi
+ popl %edi
+ popl %ebx
+ end;
+ end;
+
+{*****************************************************************************
+ Transfer Buffer
+*****************************************************************************}
+
+ function transfer_buffer : longint;
+ begin
+ transfer_buffer := go32_info_block.linear_address_of_transfer_buffer;
+ end;
+
+
+ function tb_segment : longint;
+ begin
+ tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
+ end;
+
+
+ function tb_offset : longint;
+ begin
+ tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
+ end;
+
+
+ function tb_size : longint;
+ begin
+ tb_size := go32_info_block.size_of_transfer_buffer;
+ end;
+
+
+ procedure copytodos(var addr; len : longint);
+ begin
+ if len>tb_size then
+ runerror(217);
+ seg_move(get_ds,longint(@addr),dosmemselector,transfer_buffer,len);
+ end;
+
+
+ procedure copyfromdos(var addr; len : longint);
+ begin
+ if len>tb_size then
+ runerror(217);
+ seg_move(dosmemselector,transfer_buffer,get_ds,longint(@addr),len);
+ end;
+
+
+ var
+ _core_selector : word;external name '_core_selector';
+
+begin
+ int31error:=0;
+ dosmemselector:=_core_selector;
+end.
+
+{
+ $Log: go32.pp,v $
+ Revision 1.8 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/graph.pp b/rtl/go32v2/graph.pp
new file mode 100644
index 0000000000..5162b03db8
--- /dev/null
+++ b/rtl/go32v2/graph.pp
@@ -0,0 +1,2786 @@
+{
+ $Id: graph.pp,v 1.13 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+
+ This file implements the go32v2 support for the graph unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Graph;
+interface
+
+{$i graphh.inc}
+{$i vesah.inc}
+
+CONST
+ m640x200x16 = VGALo;
+ m640x400x16 = VGAMed;
+ m640x480x16 = VGAHi;
+
+ { VESA Specific video modes. }
+ m320x200x32k = $10D;
+ m320x200x64k = $10E;
+
+ m640x400x256 = $100;
+
+ m640x480x256 = $101;
+ m640x480x32k = $110;
+ m640x480x64k = $111;
+
+ m800x600x16 = $102;
+ m800x600x256 = $103;
+ m800x600x32k = $113;
+ m800x600x64k = $114;
+
+ m1024x768x16 = $104;
+ m1024x768x256 = $105;
+ m1024x768x32k = $116;
+ m1024x768x64k = $117;
+
+ m1280x1024x16 = $106;
+ m1280x1024x256 = $107;
+ m1280x1024x32k = $119;
+ m1280x1024x64k = $11A;
+
+const
+ UseLFB : boolean = false;
+ UseNoSelector : boolean = false;
+ LFBPointer : pointer = nil;
+
+
+implementation
+
+uses
+ go32,ports;
+
+const
+ InternalDriverName = 'DOSGX';
+
+{$i graph.inc}
+
+
+Type
+ TDPMIRegisters = go32.registers;
+
+{$asmmode intel}
+
+{ How to access real mode memory }
+{ using 32-bit DPMI memory }
+{ 1. Allocate a descriptor }
+{ 2. Set segment limit }
+{ 3. Set base linear address }
+const
+{$ifdef fpc}
+ VideoOfs : longint = 0; { Segment to draw to }
+{$else fpc}
+ VideoOfs : word = 0; { Segment to draw to }
+{$endif fpc}
+ FirstPlane = $0102; (* 02 = Index to Color plane Select, *)
+ (* 01 = Enable color plane 1 *)
+
+{ ; ===== VGA Register Values ===== }
+
+ SCREEN_WIDTH = 80 ; { MODE-X 320 SCREEN WIDTH }
+ { CHANGE THE VALUE IF OTHER MODES }
+ { OTHER THEN 320 ARE USED. }
+ ATTRIB_Ctrl = $03C0 ; { VGA Attribute Controller }
+ GC_Index = $03CE ; { VGA Graphics Controller }
+ SC_Index = $03C4 ; { VGA Sequencer Controller }
+ SC_Data = $03C5 ; { VGA Sequencer Data Port }
+ CRTC_Index = $03D4 ; { VGA CRT Controller }
+ CRTC_Data = $03D5 ; { VGA CRT Controller Data }
+ MISC_OUTPUT = $03C2 ; { VGA Misc Register }
+ INPUT_1 = $03DA ; { Input Status #1 Register }
+
+ DAC_WRITE_ADDR = $03C8 ; { VGA DAC Write Addr Register }
+ DAC_READ_ADDR = $03C7 ; { VGA DAC Read Addr Register }
+ PEL_DATA_REG = $03C9 ; { VGA DAC/PEL data Register R/W }
+
+ PIXEL_PAN_REG = $033 ; { Attrib Index: Pixel Pan Reg }
+ MAP_MASK = $002 ; { S= $Index: Write Map Mask reg }
+ READ_MAP = $004 ; { GC Index: Read Map Register }
+ START_DISP_HI = $00C ; { CRTC Index: Display Start Hi }
+ START_DISP_LO = $00D ; { CRTC Index: Display Start Lo }
+
+ MAP_MASK_PLANE1 = $00102 ; { Map Register + Plane 1 }
+ MAP_MASK_PLANE2 = $01102 ; { Map Register + Plane 1 }
+ ALL_PLANES_ON = $00F02 ; { Map Register + All Bit Planes }
+
+ CHAIN4_OFF = $00604 ; { Chain 4 mode Off }
+ ASYNC_RESET = $00100 ; { (A)synchronous Reset }
+ SEQU_RESTART = $00300 ; { Sequencer Restart }
+
+ LATCHES_ON = $00008 ; { Bit Mask + Data from Latches }
+ LATCHES_OFF = $0FF08 ; { Bit Mask + Data from CPU }
+
+ VERT_RETRACE = $08 ; { INPUT_1: Vertical Retrace Bit }
+ PLANE_BITS = $03 ; { Bits 0-1 of Xpos = Plane # }
+ ALL_PLANES = $0F ; { All Bit Planes Selected }
+ CHAR_BITS = $0F ; { Bits 0-3 of Character Data }
+
+ GET_CHAR_PTR = $01130 ; { VGA BIOS Func: Get Char Set }
+ ROM_8x8_Lo = $03 ; { ROM 8x8 Char Set Lo Pointer }
+ ROM_8x8_Hi = $04 ; { ROM 8x8 Char Set Hi Pointer }
+
+ { Constants Specific for these routines }
+
+ NUM_MODES = $8 ; { # of Mode X Variations }
+
+ { in 16 color modes, the actual colors used are not 0..15, but: }
+ ToRealCols16: Array[0..15] of word =
+ (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
+
+ var
+ ScrWidth : word absolute $40:$4a;
+ inWindows: boolean;
+
+{$ifndef tp}
+ procedure seg_bytemove(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+ begin
+ asm
+ push edi
+ push esi
+ push es
+ push ds
+ cld
+ mov ecx,count
+ mov esi,source
+ mov edi,dest
+ mov ax,dseg
+ mov es,ax
+ mov ax,sseg
+ mov ds,ax
+ rep movsb
+ pop ds
+ pop es
+ pop esi
+ pop edi
+ end ['ESI','EDI','ECX','EAX']
+ end;
+
+{$endif tp}
+
+ {************************************************************************}
+ {* 4-bit planar VGA mode routines *}
+ {************************************************************************}
+
+ Procedure Init640x200x16; {$ifndef fpc}far;{$endif fpc} assembler;
+ { must also clear the screen...}
+ asm
+ mov ax,000Eh
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+
+
+ Procedure Init640x350x16; {$ifndef fpc}far;{$endif fpc} assembler;
+ { must also clear the screen...}
+ asm
+ mov ax,0010h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+
+ procedure Init640x480x16; {$ifndef fpc}far;{$endif fpc} assembler;
+ { must also clear the screen...}
+ asm
+ mov ax,0012h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+
+ Procedure PutPixel16(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ var offset: word;
+ dummy: byte;
+{$endif asmgraph}
+ Begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+{$ifndef asmgraph}
+ offset := y * 80 + (x shr 3) + VideoOfs;
+ PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
+ PortW[$3ce] := (Pixel and $ff) shl 8; { Index 00 : Enable correct plane and write color }
+
+ Port[$3ce] := 8;
+ Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
+ dummy := Mem[SegA000: offset]; { Latch the data into host space. }
+ Mem[Sega000: offset] := dummy; { Write the data into video memory }
+ PortW[$3ce] := $ff08; { Enable all bit planes. }
+ PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
+{$else asmgraph}
+ asm
+ push ebx
+ push edi
+ {$ifndef fpc}
+ mov es, [SegA000]
+ {$endif fpc}
+ { enable the set / reset function and load the color }
+ mov dx, 3ceh
+ mov ax, 0f01h
+ out dx, ax
+ { setup set/reset register }
+ mov ax, [Pixel]
+ shl ax, 8
+ out dx, ax
+ { setup the bit mask register }
+ mov al, 8
+ out dx, al
+ inc dx
+ { load the bitmask register }
+ mov cx, [X]
+ and cx, 0007h
+ mov al, 80h
+ shr al, cl
+ out dx, ax
+ {$ifndef fpc}
+ { get the x index and divide by 8 for 16-color }
+ mov ax,[X]
+ shr ax,3
+ push ax
+ { determine the address }
+ mov ax,80
+ mov bx,[Y]
+ mul bx
+ pop cx
+ add ax,cx
+ mov di,ax
+ add di, [VideoOfs]
+ { send the data through the display memory through set/reset }
+ mov bl,es:[di]
+ mov es:[di],bl
+
+ { reset for formal vga operation }
+ mov dx,3ceh
+ mov ax,0ff08h
+ out dx,ax
+
+ { restore enable set/reset register }
+ mov ax,0001h
+ out dx,ax
+ {$else fpc}
+ { get the x index and divide by 8 for 16-color }
+ movzx eax,[X]
+ shr eax,3
+ push eax
+ { determine the address }
+ mov eax,80
+ mov bx,[Y]
+ mul bx
+ pop ecx
+ add eax,ecx
+ mov edi,eax
+ add edi, [VideoOfs]
+ { send the data through the display memory through set/reset }
+ mov bl,fs:[edi+$a0000]
+ mov fs:[edi+$a0000],bl
+
+ { reset for formal vga operation }
+ mov dx,3ceh
+ mov ax,0ff08h
+ out dx,ax
+
+ { restore enable set/reset register }
+ mov ax,0001h
+ out dx,ax
+ pop edi
+ pop ebx
+ {$endif fpc}
+ end;
+{$endif asmgraph}
+ end;
+
+
+ Function GetPixel16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ Var dummy, offset: Word;
+ shift: byte;
+{$endif asmgraph}
+ Begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+{$ifndef asmgraph}
+ offset := Y * 80 + (x shr 3) + VideoOfs;
+ Port[$3ce] := 4;
+ shift := 7 - (X and 7);
+ Port[$3cf] := 0;
+ dummy := (Mem[Sega000:offset] shr shift) and 1;
+ Port[$3cf] := 1;
+ dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 1);
+ Port[$3cf] := 2;
+ dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 2);
+ Port[$3cf] := 3;
+ dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 3);
+ GetPixel16 := dummy;
+{$else asmgraph}
+ asm
+ {$ifndef fpc}
+ push esi
+ push edi
+ push ebx
+ mov ax, [X] { Get X address }
+ push ax
+ shr ax, 3
+ push ax
+
+ mov ax,80
+ mov bx,[Y]
+ mul bx
+ pop cx
+ add ax,cx
+ mov si,ax { SI = correct offset into video segment }
+
+ mov es,[SegA000]
+ add si,[VideoOfs] { Point to correct page offset... }
+
+ mov dx,03ceh
+ mov ax,4
+ out dx,al
+ inc dx
+
+ pop ax
+ and ax,0007h
+ mov cl,07
+ sub cl,al
+ mov bl,cl
+
+ { read plane 0 }
+ mov al,0 { Select plane to read }
+ out dx,al
+ mov al,es:[si] { read display memory }
+ shr al,cl
+ and al,01h
+ mov ah,al { save bit in AH }
+
+ { read plane 1 }
+ mov al,1 { Select plane to read }
+ out dx,al
+ mov al,es:[si]
+ shr al,cl
+ and al,01h
+ shl al,1
+ or ah,al { save bit in AH }
+
+ { read plane 2 }
+ mov al,2 { Select plane to read }
+ out dx,al
+ mov al,es:[si]
+ shr al,cl
+ and al,01h
+ shl al,2
+ or ah,al { save bit in AH }
+
+ { read plane 3 }
+ mov al,3 { Select plane to read }
+ out dx,al
+ mov al,es:[si]
+ shr al,cl
+ and al,01h
+ shl al,3
+ or ah,al { save bit in AH }
+
+ mov al,ah { 16-bit pixel in AX }
+ xor ah,ah
+ mov @Result, ax
+ {$else fpc}
+ movzx eax, [X] { Get X address }
+ push eax
+ shr eax, 3
+ push eax
+
+ mov eax,80
+ mov bx,[Y]
+ mul bx
+ pop ecx
+ add eax,ecx
+ mov esi,eax { SI = correct offset into video segment }
+
+ add esi,[VideoOfs] { Point to correct page offset... }
+
+ mov dx,03ceh
+ mov ax,4
+ out dx,al
+ inc dx
+
+ pop eax
+ and eax,0007h
+ mov cl,07
+ sub cl,al
+ mov bl,cl
+
+ { read plane 0 }
+ mov al,0 { Select plane to read }
+ out dx,al
+ mov al,fs:[esi+$a0000] { read display memory }
+ shr al,cl
+ and al,01h
+ mov ah,al { save bit in AH }
+
+ { read plane 1 }
+ mov al,1 { Select plane to read }
+ out dx,al
+ mov al,fs:[esi+$a0000]
+ shr al,cl
+ and al,01h
+ shl al,1
+ or ah,al { save bit in AH }
+
+ { read plane 2 }
+ mov al,2 { Select plane to read }
+ out dx,al
+ mov al,fs:[esi+$a0000]
+ shr al,cl
+ and al,01h
+ shl al,2
+ or ah,al { save bit in AH }
+
+ { read plane 3 }
+ mov al,3 { Select plane to read }
+ out dx,al
+ mov al,fs:[esi+$a0000]
+ shr al,cl
+ and al,01h
+ shl al,3
+ or ah,al { save bit in AH }
+
+ mov al,ah { 16-bit pixel in AX }
+ xor ah,ah
+ mov @Result, ax
+ pop ebx
+ pop edi
+ pop esi
+ {$endif fpc}
+ end;
+{$endif asmgraph}
+ end;
+
+Procedure GetScanLine16(x1, x2, y: integer; var data);
+
+var dummylong: longint;
+ Offset, count, count2, amount, index: word;
+ plane: byte;
+Begin
+ inc(x1,StartXViewPort);
+ inc(x2,StartXViewPort);
+{$ifdef logging}
+ LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
+{$Endif logging}
+ offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
+{$ifdef logging}
+ LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
+{$Endif logging}
+ { first get enough pixels so offset is 32bit aligned }
+ amount := 0;
+ index := 0;
+ If ((x1 and 31) <> 0) Or
+ ((x2-x1+1) < 32) Then
+ Begin
+ If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
+ amount := 32-(x1 and 31)
+ Else amount := x2-x1+1;
+{$ifdef logging}
+ LogLn('amount to align to 32bits or to get all: ' + strf(amount));
+{$Endif logging}
+ For count := 0 to amount-1 do
+ WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
+ index := amount;
+ Inc(Offset,(amount+7) shr 3);
+{$ifdef logging}
+ LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
+ LogLn('index now: '+strf(index));
+{$Endif logging}
+ End;
+ amount := x2-x1+1 - amount;
+{$ifdef logging}
+ LogLn('amount left: ' + strf(amount));
+{$Endif logging}
+ If amount = 0 Then Exit;
+ Port[$3ce] := 4;
+ { first get everything from plane 3 (4th plane) }
+ Port[$3cf] := 3;
+ Count := 0;
+ For Count := 1 to (amount shr 5) Do
+ Begin
+ dummylong := MemL[SegA000:offset+(Count-1)*4];
+ dummylong :=
+ ((dummylong and $ff) shl 24) or
+ ((dummylong and $ff00) shl 8) or
+ ((dummylong and $ff0000) shr 8) or
+ ((dummylong and $ff000000) shr 24);
+ For Count2 := 31 downto 0 Do
+ Begin
+ WordArray(Data)[index+Count2] := DummyLong and 1;
+ DummyLong := DummyLong shr 1;
+ End;
+ Inc(Index, 32);
+ End;
+{ Now get the data from the 3 other planes }
+ plane := 3;
+ Repeat
+ Dec(Index,Count*32);
+ Dec(plane);
+ Port[$3cf] := plane;
+ Count := 0;
+ For Count := 1 to (amount shr 5) Do
+ Begin
+ dummylong := MemL[SegA000:offset+(Count-1)*4];
+ dummylong :=
+ ((dummylong and $ff) shl 24) or
+ ((dummylong and $ff00) shl 8) or
+ ((dummylong and $ff0000) shr 8) or
+ ((dummylong and $ff000000) shr 24);
+ For Count2 := 31 downto 0 Do
+ Begin
+ WordArray(Data)[index+Count2] :=
+ (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
+ DummyLong := DummyLong shr 1;
+ End;
+ Inc(Index, 32);
+ End;
+ Until plane = 0;
+ amount := amount and 31;
+ Dec(index);
+{$ifdef Logging}
+ LogLn('Last array index written to: '+strf(index));
+ LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
+{$Endif logging}
+ dec(x1,startXViewPort);
+ For Count := 1 to amount Do
+ WordArray(Data)[index+Count] := getpixel16(x1+index+Count,y);
+{$ifdef logging}
+ inc(x1,startXViewPort);
+ LogLn('First 32 bytes gotten with getscanline16: ');
+ If x2-x1+1 >= 32 Then
+ Count2 := 32
+ Else Count2 := x2-x1+1;
+ For Count := 0 to Count2-1 Do
+ Log(strf(WordArray(Data)[Count])+' ');
+ LogLn('');
+ If x2-x1+1 >= 32 Then
+ Begin
+ LogLn('Last 32 bytes gotten with getscanline16: ');
+ For Count := 31 downto 0 Do
+ Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+ End;
+ LogLn('');
+ GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
+ LogLn('First 32 bytes gotten with getscanlinedef: ');
+ If x2-x1+1 >= 32 Then
+ Count2 := 32
+ Else Count2 := x2-x1+1;
+ For Count := 0 to Count2-1 Do
+ Log(strf(WordArray(Data)[Count])+' ');
+ LogLn('');
+ If x2-x1+1 >= 32 Then
+ Begin
+ LogLn('Last 32 bytes gotten with getscanlinedef: ');
+ For Count := 31 downto 0 Do
+ Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+ End;
+ LogLn('');
+ LogLn('GetScanLine16 end');
+{$Endif logging}
+End;
+
+ Procedure DirectPutPixel16(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+ var
+ color: word;
+{$ifndef asmgraph}
+ offset: word;
+ dummy: byte;
+{$endif asmgraph}
+ begin
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor Xor Color;
+ end;
+ OrPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor Or Color;
+ end;
+ AndPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor And Color;
+ end;
+ NotPut:
+ begin
+ Color := Not Color;
+ end
+ else
+ Color := CurrentColor;
+ end;
+{$ifndef asmgraph}
+ offset := Y * 80 + (X shr 3) + VideoOfs;
+ PortW[$3ce] := $f01;
+ PortW[$3ce] := Color shl 8;
+ Port[$3ce] := 8;
+ Port[$3cf] := $80 shr (X and 7);
+ dummy := Mem[SegA000: offset];
+ Mem[Sega000: offset] := dummy;
+ PortW[$3ce] := $ff08;
+ PortW[$3ce] := $0001;
+{$else asmgraph}
+{ note: still needs xor/or/and/notput support !!!!! (JM) }
+ asm
+ push esi
+ push edi
+ push ebx
+ {$ifndef fpc}
+ mov es, [SegA000]
+ { enable the set / reset function and load the color }
+ mov dx, 3ceh
+ mov ax, 0f01h
+ out dx, ax
+ { setup set/reset register }
+ mov ax, [Color]
+ shl ax, 8
+ out dx, ax
+ { setup the bit mask register }
+ mov al, 8
+ out dx, al
+ inc dx
+ { load the bitmask register }
+ mov cx, [X]
+ and cx, 0007h
+ mov al, 80h
+ shr al, cl
+ out dx, ax
+ { get the x index and divide by 8 for 16-color }
+ mov ax,[X]
+ shr ax,3
+ push ax
+ { determine the address }
+ mov ax,80
+ mov bx,[Y]
+ mul bx
+ pop cx
+ add ax,cx
+ mov di,ax
+ { send the data through the display memory through set/reset }
+ add di,[VideoOfs] { add correct page }
+ mov bl,es:[di]
+ mov es:[di],bl
+
+ { reset for formal vga operation }
+ mov dx,3ceh
+ mov ax,0ff08h
+ out dx,ax
+
+ { restore enable set/reset register }
+ mov ax,0001h
+ out dx,ax
+ {$else fpc}
+ { enable the set / reset function and load the color }
+ mov dx, 3ceh
+ mov ax, 0f01h
+ out dx, ax
+ { setup set/reset register }
+ mov ax, [Color]
+ shl ax, 8
+ out dx, ax
+ { setup the bit mask register }
+ mov al, 8
+ out dx, al
+ inc dx
+ { load the bitmask register }
+ mov cx, [X]
+ and cx, 0007h
+ mov al, 80h
+ shr al, cl
+ out dx, ax
+ { get the x index and divide by 8 for 16-color }
+ movzx eax,[X]
+ shr eax,3
+ push eax
+ { determine the address }
+ mov eax,80
+ mov bx,[Y]
+ mul bx
+ pop ecx
+ add eax,ecx
+ mov edi,eax
+ { send the data through the display memory through set/reset }
+ add edi,[VideoOfs] { add correct page }
+ mov bl,fs:[edi+$a0000]
+ mov fs:[edi+$a0000],bl
+
+ { reset for formal vga operation }
+ mov dx,3ceh
+ mov ax,0ff08h
+ out dx,ax
+
+ { restore enable set/reset register }
+ mov ax,0001h
+ out dx,ax
+ pop ebx
+ pop edi
+ pop esi
+ {$endif fpc}
+ end;
+{$endif asmgraph}
+ end;
+
+
+ procedure HLine16(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
+
+ var
+ xtmp: integer;
+ ScrOfs,HLength : word;
+ LMask,RMask : byte;
+
+ Begin
+
+ { must we swap the values? }
+ if x > x2 then
+ Begin
+ xtmp := x2;
+ x2 := x;
+ x:= xtmp;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ X2 := X2 + StartXViewPort;
+ Y := Y + StartYViewPort;
+ if ClipPixels then
+ Begin
+ if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ ScrOfs:=y*ScrWidth+x div 8;
+ HLength:=x2 div 8-x div 8;
+ LMask:=$ff shr (x and 7);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ RMask:=$ff shl (7-(x2 and 7));
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ if HLength=0 then
+ LMask:=LMask and RMask;
+ Port[$3ce]:=0;
+ If CurrentWriteMode <> NotPut Then
+ Port[$3cf]:= CurrentColor
+ else Port[$3cf]:= not CurrentColor;
+ Port[$3ce]:=1;
+ Port[$3cf]:=$f;
+ Port[$3ce]:=3;
+ case CurrentWriteMode of
+ XORPut:
+ Port[$3cf]:=3 shl 3;
+ ANDPut:
+ Port[$3cf]:=1 shl 3;
+ ORPut:
+ Port[$3cf]:=2 shl 3;
+ NormalPut, NotPut:
+ Port[$3cf]:=0
+ else
+ Port[$3cf]:=0
+ end;
+
+ Port[$3ce]:=8;
+ Port[$3cf]:=LMask;
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ Mem[SegA000:ScrOfs]:=Mem[SegA000:ScrOfs]+1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ Port[$3ce]:=8;
+ if HLength>0 then
+ begin
+ dec(HLength);
+ inc(ScrOfs);
+ if HLength>0 then
+ begin
+ Port[$3cf]:=$ff;
+{$ifndef tp}
+ seg_bytemove(dosmemselector,$a0000+ScrOfs,dosmemselector,$a0000+ScrOfs,HLength);
+{$else}
+ move(Ptr(SegA000,ScrOfs)^, Ptr(SegA000,ScrOfs)^, HLength);
+{$endif}
+ ScrOfs:=ScrOfs+HLength;
+ end;
+ Port[$3cf]:=RMask;
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ Mem[Sega000:ScrOfs]:=Mem[SegA000:ScrOfs]+1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ end;
+ { clean up }
+ Port[$3cf]:=0;
+ Port[$3ce]:=8;
+ Port[$3cf]:=$ff;
+ Port[$3ce]:=1;
+ Port[$3cf]:=0;
+ Port[$3ce]:=3;
+ Port[$3cf]:=0;
+ end;
+
+ procedure VLine16(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
+
+ var
+ ytmp: integer;
+ ScrOfs,i : longint;
+ BitMask : byte;
+
+ Begin
+ { must we swap the values? }
+ if y > y2 then
+ Begin
+ ytmp := y2;
+ y2 := y;
+ y:= ytmp;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ Y2 := Y2 + StartYViewPort;
+ Y := Y + StartYViewPort;
+ if ClipPixels then
+ Begin
+ if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ ScrOfs:=y*ScrWidth+x div 8;
+ BitMask:=$80 shr (x and 7);
+ Port[$3ce]:=0;
+ If CurrentWriteMode <> NotPut Then
+ Port[$3cf]:= CurrentColor
+ else Port[$3cf]:= not CurrentColor;
+ Port[$3ce]:=1;
+ Port[$3cf]:=$f;
+ Port[$3ce]:=8;
+ Port[$3cf]:=BitMask;
+ Port[$3ce]:=3;
+ case CurrentWriteMode of
+ XORPut:
+ Port[$3cf]:=3 shl 3;
+ ANDPut:
+ Port[$3cf]:=1 shl 3;
+ ORPut:
+ Port[$3cf]:=2 shl 3;
+ NormalPut, NotPut:
+ Port[$3cf]:=0
+ else
+ Port[$3cf]:=0
+ end;
+ for i:=y to y2 do
+ begin
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ Mem[SegA000:ScrOfs]:=Mem[Sega000:ScrOfs]+1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ ScrOfs:=ScrOfs+ScrWidth;
+ end;
+ { clean up }
+ Port[$3cf]:=0;
+ Port[$3ce]:=8;
+ Port[$3cf]:=$ff;
+ Port[$3ce]:=1;
+ Port[$3cf]:=0;
+ Port[$3ce]:=3;
+ Port[$3cf]:=0;
+ End;
+
+
+ procedure SetVisual480(page: word); {$ifndef fpc}far;{$endif fpc}
+ { no page flipping supPort in 640x480 mode }
+ begin
+ VideoOfs := 0;
+ end;
+
+ procedure SetActive480(page: word); {$ifndef fpc}far;{$endif fpc}
+ { no page flipping supPort in 640x480 mode }
+ begin
+ VideoOfs := 0;
+ end;
+
+
+ procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
+ { two page supPort... }
+ begin
+ if page > HardwarePages then exit;
+ asm
+ mov ax,[page] { only lower byte is supPorted. }
+ mov ah,05h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+
+ { read start address }
+ mov dx,3d4h
+ mov al,0ch
+ out dx,al
+ inc dx
+ in al,dx
+ mov ah,al
+ dec dx
+ mov al,0dh
+ out dx,al
+ in al,dx
+ end;
+ end;
+
+ procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
+ { two page supPort... }
+ begin
+ case page of
+ 0 : VideoOfs := 0;
+ 1 : VideoOfs := 16384;
+ 2 : VideoOfs := 32768;
+ else
+ VideoOfs := 0;
+ end;
+ end;
+
+ procedure SetVisual350(page: word); {$ifndef fpc}far;{$endif fpc}
+ { one page supPort... }
+ begin
+ if page > HardwarePages then exit;
+ asm
+ mov ax,[page] { only lower byte is supPorted. }
+ mov ah,05h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+ end;
+
+ procedure SetActive350(page: word); {$ifndef fpc}far;{$endif fpc}
+ { one page supPort... }
+ begin
+ case page of
+ 0 : VideoOfs := 0;
+ 1 : VideoOfs := 32768;
+ else
+ VideoOfs := 0;
+ end;
+ end;
+
+
+
+
+
+ {************************************************************************}
+ {* 320x200x256c Routines *}
+ {************************************************************************}
+
+ Procedure Init320; {$ifndef fpc}far;{$endif fpc} assembler;
+ asm
+ mov ax,0013h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+
+ Procedure PutPixel320(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in local coordinates. Clipping if required. }
+ {$ifndef fpc}
+ Begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ asm
+ mov es, [SegA000]
+ mov ax, [Y]
+ mov di, [X]
+ xchg ah, al { The value of Y must be in AH }
+ add di, ax
+ shr ax, 2
+ add di, ax
+ add di, [VideoOfs] { point to correct page.. }
+ mov ax, [Pixel]
+ mov es:[di], al
+ end;
+ {$else fpc}
+ assembler;
+ asm
+ push edi
+ push ebx
+{$IFDEF REGCALL}
+ movsx edi, ax
+ movsx ebx, dx
+ mov al, cl
+{$ELSE REGCALL}
+ movsx edi, x
+ movsx ebx, y
+{$ENDIF REGCALL}
+ cmp clippixels, 0
+ je @putpix320noclip
+ test edi, edi
+ jl @putpix320done
+ test ebx, ebx
+ jl @putpix320done
+ cmp di, ViewWidth
+ jg @putpix320done
+ cmp bx, ViewHeight
+ jg @putpix320done
+@putpix320noclip:
+ movsx ecx, StartYViewPort
+ movsx edx, StartXViewPort
+ add ebx, ecx
+ add edi, edx
+{ add edi, [VideoOfs] no multiple pages in 320*200*256 }
+{$IFNDEF REGCALL}
+ mov ax, [pixel]
+{$ENDIF REGCALL}
+ shl ebx, 6
+ add edi, ebx
+ mov fs:[edi+ebx*4+$a0000], al
+@putpix320done:
+ pop ebx
+ pop edi
+{$endif fpc}
+ end;
+
+
+ Function GetPixel320(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
+ {$ifndef fpc}
+ Begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ asm
+ mov es, [SegA000]
+ mov ax, [Y]
+ mov di, [X]
+ xchg ah, al { The value of Y must be in AH }
+ add di, ax
+ shr ax, 2
+ add di, ax
+ xor ax, ax
+ add di, [VideoOfs] { point to correct gfx page ... }
+ mov al,es:[di]
+ mov @Result,ax
+ end;
+ {$else fpc}
+ assembler;
+ asm
+ push edi
+ push ebx
+{$IFDEF REGCALL}
+ movsx edi, ax
+ movsx ebx, dx
+{$ELSE REGCALL}
+ movsx edi, x
+ movsx ebx, y
+{$ENDIF REGCALL}
+ movsx ecx, StartYViewPort
+ movsx edx, StartXViewPort
+ add ebx, ecx
+ add edi, edx
+ { add edi, [VideoOfs] no multiple pages in 320*200*256 }
+ shl ebx, 6
+ add edi, ebx
+ movzx ax, byte ptr fs:[edi+ebx*4+$a0000]
+ pop ebx
+ pop edi
+ {$endif fpc}
+ end;
+
+
+ Procedure DirectPutPixel320(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+{$ifndef asmgraph}
+ var offset: word;
+ dummy: Byte;
+ begin
+ dummy := CurrentColor;
+ offset := y * 320 + x + VideoOfs;
+ case CurrentWriteMode of
+ XorPut: dummy := dummy xor Mem[Sega000:offset];
+ OrPut: dummy := dummy or Mem[Sega000:offset];
+ AndPut: dummy := dummy and Mem[SegA000:offset];
+ NotPut: dummy := Not dummy;
+ end;
+ Mem[SegA000:offset] := dummy;
+ end;
+{$else asmgraph}
+{ note: still needs or/and/notput support !!!!! (JM) }
+ assembler;
+ asm
+ {$ifndef fpc}
+ mov es, [SegA000]
+ mov ax, [Y]
+ mov di, [X]
+ xchg ah, al { The value of Y must be in AH }
+ add di, ax
+ shr ax, 2
+ add di, ax
+{ add di, [VideoOfs] no multiple pages support in 320*200*256 }
+ mov ax, [CurrentColor]
+ cmp [CurrentWriteMode],XORPut { check write mode }
+ jne @MOVMode
+ mov ah,es:[di] { read the byte... }
+ xor al,ah { xor it and return value into AL }
+ @MovMode:
+ mov es:[di], al
+ {$else fpc}
+ push edi
+ push ebx
+{$IFDEF REGCALL}
+ movzx edi, ax
+ movzx ebx, dx
+{$ELSE REGCALL}
+ movzx edi, x
+ movzx ebx, y
+{$ENDIF REGCALL}
+ { add edi, [VideoOfs] no multiple pages in 320*200*256 }
+ shl ebx, 6
+ add edi, ebx
+ mov ax, [CurrentColor]
+ cmp [CurrentWriteMode],XORPut { check write mode }
+ jne @MOVMode
+ xor al, fs:[edi+ebx*4+$a0000]
+ @MovMode:
+ mov fs:[edi+ebx*4+$a0000], al
+ pop ebx
+ pop edi
+{$endif fpc}
+ end;
+{$endif asmgraph}
+
+
+ procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc}
+ { no page supPort... }
+ begin
+ VideoOfs := 0;
+ end;
+
+ procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc}
+ { no page supPort... }
+ begin
+ VideoOfs := 0;
+ end;
+
+ {************************************************************************}
+ {* Mode-X related routines *}
+ {************************************************************************}
+const CrtAddress: word = 0;
+
+ procedure InitModeX; {$ifndef fpc}far;{$endif fpc}
+ begin
+ asm
+ {see if we are using color-/monochorme display}
+ MOV DX,3CCh {use output register: }
+ IN AL,DX
+ TEST AL,1 {is it a color display? }
+ MOV DX,3D4h
+ JNZ @L1 {yes }
+ MOV DX,3B4h {no }
+ @L1: {DX = 3B4h / 3D4h = CRTAddress-register for monochrome/color}
+ MOV CRTAddress,DX
+
+ MOV AX, 0013h
+{$ifdef fpc}
+ push ebp
+{$EndIf fpc}
+ INT 10h
+{$ifdef fpc}
+ pop ebp
+{$EndIf fpc}
+ MOV DX,03C4h {select memory-mode-register at sequencer Port }
+ MOV AL,04
+ OUT DX,AL
+ INC DX {read in data via the according data register }
+ IN AL,DX
+ AND AL,0F7h {bit 3 := 0: don't chain the 4 planes}
+ OR AL,04 {bit 2 := 1: no odd/even mechanism }
+ OUT DX,AL {activate new settings }
+ MOV DX,03C4h {s.a.: address sequencer reg. 2 (=map-mask),... }
+ MOV AL,02
+ OUT DX,AL
+ INC DX
+ MOV AL,0Fh {...and allow access to all 4 bit maps }
+ OUT DX,AL
+{$ifndef fpc}
+ MOV AX,[SegA000] {starting with segment A000h, set 8000h logical }
+ MOV ES,AX {words = 4*8000h physical words (because of 4 }
+ XOR DI,DI {bitplanes) to 0 }
+ XOR AX,AX
+ MOV CX,8000h
+ CLD
+ REP STOSW
+{$else fpc}
+ push edi
+ push es
+ push fs
+ mov edi, $a0000
+ pop es
+ xor eax, eax
+ mov ecx, 4000h
+ cld
+ rep stosd
+ pop es
+ pop edi
+{$EndIf fpc}
+ MOV DX,CRTAddress {address the underline-location-register at }
+ MOV AL,14h {the CRT-controller Port, read out the according }
+ OUT DX,AL {data register: }
+ INC DX
+ IN AL,DX
+ AND AL,0BFh {bit 6:=0: no double word addressing scheme in}
+ OUT DX,AL {video RAM }
+ DEC DX
+ MOV AL,17h {select mode control register }
+ OUT DX,AL
+ INC DX
+ IN AL,DX
+ OR AL,40h {bit 6 := 1: memory access scheme=linear bit array }
+ OUT DX,AL
+ end;
+ end;
+
+
+ Function GetPixelX(X,Y: Integer): word; {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ var offset: word;
+{$endif asmgraph}
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+{$ifndef asmgraph}
+ offset := y * 80 + x shr 2 + VideoOfs;
+ PortW[$3ce] := ((x and 3) shl 8) + 4;
+ GetPixelX := Mem[SegA000:offset];
+{$else asmgraph}
+ asm
+ {$ifndef fpc}
+ mov di,[Y] ; (* DI = Y coordinate *)
+ (* Multiply by 80 start *)
+ mov bx, di
+ shl di, 6 ; (* Faster on 286/386/486 machines *)
+ shl bx, 4
+ add di, bx ; (* Multiply Value by 80 *)
+ (* End multiply by 80 *)
+ mov cx, [X]
+ mov ax, cx
+ {DI = Y * LINESIZE, BX = X, coordinates admissible}
+ shr ax, 1 ; (* Faster on 286/86 machines *)
+ shr ax, 1
+ add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
+ add di, [VideoOfs] ; (* Pointing at start of Active page *)
+ (* Select plane to use *)
+ mov dx, 03c4h
+ mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
+ and cl, 03h ; (* Get Plane Bits *)
+ shl ah, cl ; (* Get Plane Select Value *)
+ out dx, ax
+ (* End selection of plane *)
+ mov es,[SegA000]
+ mov al, ES:[DI]
+ xor ah, ah
+ mov @Result, ax
+ {$else fpc}
+ push edi
+ push ebx
+ movzx edi,[Y] ; (* DI = Y coordinate *)
+ (* Multiply by 80 start *)
+ mov ebx, edi
+ shl edi, 6 ; (* Faster on 286/386/486 machines *)
+ shl ebx, 4
+ add edi, ebx ; (* Multiply Value by 80 *)
+ (* End multiply by 80 *)
+ movzx ecx, [X]
+ movzx eax, [Y]
+ {DI = Y * LINESIZE, BX = X, coordinates admissible}
+ shr eax, 2
+ add edi, eax ; {DI = Y * LINESIZE + (X SHR 2) }
+ add edi, [VideoOfs] ; (* Pointing at start of Active page *)
+ (* Select plane to use *)
+ mov dx, 03c4h
+ mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
+ and cl, 03h ; (* Get Plane Bits *)
+ shl ah, cl ; (* Get Plane Select Value *)
+ out dx, ax
+ (* End selection of plane *)
+ mov ax, fs:[edi+$a0000]
+ mov @Result, ax
+ pop ebx
+ pop edi
+ {$endif fpc}
+ end;
+{$endif asmgraph}
+ end;
+
+ procedure SetVisualX(page: word); {$ifndef fpc}far;{$endif fpc}
+ { 4 page supPort... }
+
+ Procedure SetVisibleStart(AOffset: word); Assembler;
+ (* Select where the left corner of the screen will be *)
+ { By Matt Pritchard }
+ asm
+{$IFDEF REGCALL}
+ mov cx, ax
+{$ENDIF REGCALL}
+ { Wait if we are currently in a Vertical Retrace }
+ MOV DX, INPUT_1 { Input Status #1 Register }
+ @DP_WAIT0:
+ IN AL, DX { Get VGA status }
+ AND AL, VERT_RETRACE { In Display mode yet? }
+ JNZ @DP_WAIT0 { If Not, wait for it }
+
+ { Set the Start Display Address to the new page }
+
+ MOV DX, CRTC_Index { We Change the VGA Sequencer }
+ MOV AL, START_DISP_LO { Display Start Low Register }
+{$ifndef fpc}
+ MOV AH, BYTE PTR [AOffset] { Low 8 Bits of Start Addr }
+ OUT DX, AX { Set Display Addr Low }
+ MOV AL, START_DISP_HI { Display Start High Register }
+ MOV AH, BYTE PTR [AOffset+1] { High 8 Bits of Start Addr }
+{$else fpc}
+{$IFDEF REGCALL}
+ mov ah, cl
+{$ELSE REGCALL}
+ mov ah, byte [AOffset]
+{$ENDIF REGCALL}
+ out dx, ax
+ mov AL, START_DISP_HI
+{$IFDEF REGCALL}
+ mov ah, ch
+{$ELSE REGCALL}
+ mov ah, byte [AOffset+1]
+{$ENDIF REGCALL}
+{$endif fpc}
+ OUT DX, AX { Set Display Addr High }
+ { Wait for a Vertical Retrace to smooth out things }
+
+ MOV DX, INPUT_1 { Input Status #1 Register }
+
+ @DP_WAIT1:
+ IN AL, DX { Get VGA status }
+ AND AL, VERT_RETRACE { Vertical Retrace Start? }
+ JZ @DP_WAIT1 { If Not, wait for it }
+ { Now Set Display Starting Address }
+ end;
+
+{$ifdef fpc}
+ {$undef asmgraph}
+{$endif fpc}
+
+ begin
+ Case page of
+ 0: SetVisibleStart(0);
+ 1: SetVisibleStart(16000);
+ 2: SetVisibleStart(32000);
+ 3: SetVisibleStart(48000);
+ else
+ SetVisibleStart(0);
+ end;
+ end;
+
+ procedure SetActiveX(page: word); {$ifndef fpc}far;{$endif fpc}
+ { 4 page supPort... }
+ begin
+ case page of
+ 0: VideoOfs := 0;
+ 1: VideoOfs := 16000;
+ 2: VideoOfs := 32000;
+ 3: VideoOfs := 48000;
+ else
+ VideoOfs:=0;
+ end;
+ end;
+
+ Procedure PutPixelX(X,Y: Integer; color:word); {$ifndef fpc}far;{$endif fpc}
+{$ifndef asmgraph}
+ var offset: word;
+{$endif asmgraph}
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+{$ifndef asmgraph}
+ offset := y * 80 + x shr 2 + VideoOfs;
+ PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
+ Mem[SegA000:offset] := color;
+{$else asmgraph}
+ asm
+ mov di,[Y] ; (* DI = Y coordinate *)
+ (* Multiply by 80 start *)
+ mov bx, di
+ shl di, 6 ; (* Faster on 286/386/486 machines *)
+ shl bx, 4
+ add di, bx ; (* Multiply Value by 80 *)
+ (* End multiply by 80 *)
+ mov cx, [X]
+ mov ax, cx
+ {DI = Y * LINESIZE, BX = X, coordinates admissible}
+ shr ax, 2
+ add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
+ add di, [VideoOfs] ; (* Pointing at start of Active page *)
+ (* Select plane to use *)
+ mov dx, 03c4h
+ mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
+ and cl, 03h ; (* Get Plane Bits *)
+ shl ah, cl ; (* Get Plane Select Value *)
+ out dx, ax
+ (* End selection of plane *)
+ mov es,[SegA000]
+ mov ax,[Color] ; { only lower byte is used. }
+ cmp [CurrentWriteMode],XORPut { check write mode }
+ jne @MOVMode
+ mov ah,es:[di] { read the byte... }
+ xor al,ah { xor it and return value into AL }
+ @MovMode:
+ mov es:[di], al
+ end;
+{$endif asmgraph}
+ end;
+
+
+ Procedure DirectPutPixelX(X,Y: Integer); {$ifndef fpc}far;{$endif fpc}
+ { x,y -> must be in global coordinates. No clipping. }
+{$ifndef asmgraph}
+ Var offset: Word;
+ dummy: Byte;
+ begin
+ offset := y * 80 + x shr 2 + VideoOfs;
+ case CurrentWriteMode of
+ XorPut:
+ begin
+ PortW[$3ce] := ((x and 3) shl 8) + 4;
+ dummy := CurrentColor xor Mem[Sega000: offset];
+ end;
+ OrPut:
+ begin
+ PortW[$3ce] := ((x and 3) shl 8) + 4;
+ dummy := CurrentColor or Mem[Sega000: offset];
+ end;
+ AndPut:
+ begin
+ PortW[$3ce] := ((x and 3) shl 8) + 4;
+ dummy := CurrentColor and Mem[Sega000: offset];
+ end;
+ NotPut: dummy := Not CurrentColor;
+ else dummy := CurrentColor;
+ end;
+ PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
+ Mem[Sega000: offset] := Dummy;
+ end;
+{$else asmgraph}
+{ note: still needs or/and/notput support !!!!! (JM) }
+ Assembler;
+ asm
+{$IFDEF REGCALL}
+ mov cl, al
+ mov di, dx
+{$ELSE REGCALL}
+ mov cx, [X]
+ mov ax, cx
+ mov di, [Y] ; (* DI = Y coordinate *)
+{$ENDIF REGCALL}
+ (* Multiply by 80 start *)
+ mov bx, di
+ shl di, 6 ; (* Faster on 286/386/486 machines *)
+ shl bx, 4
+ add di, bx ; (* Multiply Value by 80 *)
+ (* End multiply by 80 *)
+ {DI = Y * LINESIZE, BX = X, coordinates admissible}
+ shr ax, 2
+ add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
+ add di, [VideoOfs] ; (* Pointing at start of Active page *)
+ (* Select plane to use *)
+ mov dx, 03c4h
+ mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
+ and cl, 03h ; (* Get Plane Bits *)
+ shl ah, cl ; (* Get Plane Select Value *)
+ out dx, ax
+ (* End selection of plane *)
+ mov es,[SegA000]
+ mov ax,[CurrentColor] ; { only lower byte is used. }
+ cmp [CurrentWriteMode],XORPut { check write mode }
+ jne @MOVMode
+ mov ah,es:[di] { read the byte... }
+ xor al,ah { xor it and return value into AL }
+ @MovMode:
+ mov es:[di], al
+ end;
+{$endif asmgraph}
+
+
+
+ {************************************************************************}
+ {* General routines *}
+ {************************************************************************}
+ var
+ SavePtr : pointer; { pointer to video state }
+{ CrtSavePtr: pointer;} { pointer to video state when CrtMode gets called }
+ StateSize: word; { size in 64 byte blocks for video state }
+ VideoMode: byte; { old video mode before graph mode }
+ SaveSupPorted : Boolean; { Save/Restore video state supPorted? }
+
+
+ {**************************************************************}
+ {* DPMI Routines *}
+ {**************************************************************}
+
+{$IFDEF DPMI}
+ RealStateSeg: word; { Real segment of saved video state }
+
+ Procedure SaveStateVGA; {$ifndef fpc}far;{$endif fpc}
+ var
+ PtrLong: longint;
+ regs: TDPMIRegisters;
+ begin
+ SaveSupPorted := FALSE;
+ SavePtr := nil;
+ { Get the video mode }
+ asm
+ mov ah,0fh
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ mov [VideoMode], al
+ end;
+ { saving/restoring video state screws up Windows (JM) }
+ if inWindows then
+ exit;
+ { Prepare to save video state...}
+ asm
+ mov ax, 1C00h { get buffer size to save state }
+ mov cx, 00000111b { Save DAC / Data areas / Hardware states }
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ mov [StateSize], bx
+ cmp al,01ch
+ jnz @notok
+ mov [SaveSupPorted],TRUE
+ @notok:
+ end;
+ if SaveSupPorted then
+ begin
+
+{$ifndef fpc}
+ PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
+{$else fpc}
+ PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
+{$endif fpc}
+ if PtrLong = 0 then
+ RunError(203);
+ SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
+{$ifndef fpc}
+ { In FPC mode, we can't do anything with this (no far pointers) }
+ { However, we still need to keep it to be able to free the }
+ { memory afterwards. Since this data is not accessed in PM code, }
+ { there's no need to save it in a seperate buffer (JM) }
+ if not assigned(SavePtr) then
+ RunError(203);
+{$endif fpc}
+ RealStateSeg := word(PtrLong shr 16);
+ FillChar(regs, sizeof(regs), #0);
+ { call the real mode interrupt ... }
+ regs.eax := $1C01; { save the state buffer }
+ regs.ecx := $07; { Save DAC / Data areas / Hardware states }
+ regs.es := RealStateSeg;
+ regs.ebx := 0;
+ RealIntr($10,regs);
+ FillChar(regs, sizeof(regs), #0);
+ { restore state, according to Ralph Brown Interrupt list }
+ { some BIOS corrupt the hardware after a save... }
+ regs.eax := $1C02; { restore the state buffer }
+ regs.ecx := $07; { rest DAC / Data areas / Hardware states }
+ regs.es := RealStateSeg;
+ regs.ebx := 0;
+ RealIntr($10,regs);
+ end;
+ end;
+
+ procedure RestoreStateVGA; {$ifndef fpc}far;{$endif fpc}
+ var
+ regs:TDPMIRegisters;
+ begin
+ { go back to the old video mode...}
+ asm
+ mov ah,00
+ mov al,[VideoMode]
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+ { then restore all state information }
+{$ifndef fpc}
+ if assigned(SavePtr) and (SaveSupPorted=TRUE) then
+{$else fpc}
+ { No far pointer supPort, so it's possible that that assigned(SavePtr) }
+ { would return false under FPC. Just check if it's different from nil. }
+ if (SavePtr <> nil) and (SaveSupPorted=TRUE) then
+{$endif fpc}
+ begin
+ FillChar(regs, sizeof(regs), #0);
+ { restore state, according to Ralph Brown Interrupt list }
+ { some BIOS corrupt the hardware after a save... }
+ regs.eax := $1C02; { restore the state buffer }
+ regs.ecx := $07; { rest DAC / Data areas / Hardware states }
+ regs.es := RealStateSeg;
+ regs.ebx := 0;
+ RealIntr($10,regs);
+(*
+{$ifndef fpc}
+ if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
+{$else fpc}
+ if Not Global_Dos_Free(longint(SavePtr) shr 16) then
+{$endif fpc}
+ RunError(216);
+
+ SavePtr := nil;
+*)
+ end;
+ end;
+
+{$ELSE}
+
+ {**************************************************************}
+ {* Real mode routines *}
+ {**************************************************************}
+
+
+ Procedure SaveStateVGA; far;
+ begin
+ SavePtr := nil;
+ SaveSupPorted := FALSE;
+ { Get the video mode }
+ asm
+ mov ah,0fh
+ int 10h
+ mov [VideoMode], al
+ end;
+ { Prepare to save video state...}
+ asm
+ mov ax, 1C00h { get buffer size to save state }
+ mov cx, 00000111b { Save DAC / Data areas / Hardware states }
+ int 10h
+ mov [StateSize], bx
+ cmp al,01ch
+ jnz @notok
+ mov [SaveSupPorted],TRUE
+ @notok:
+ end;
+ if SaveSupPorted then
+ Begin
+ GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
+ if not assigned(SavePtr) then
+ RunError(203);
+ asm
+ mov ax, 1C01h { save the state buffer }
+ mov cx, 00000111b { Save DAC / Data areas / Hardware states }
+ mov es, WORD PTR [SavePtr+2]
+ mov bx, WORD PTR [SavePtr]
+ int 10h
+ end;
+ { restore state, according to Ralph Brown Interrupt list }
+ { some BIOS corrupt the hardware after a save... }
+ asm
+ mov ax, 1C02h { save the state buffer }
+ mov cx, 00000111b { Save DAC / Data areas / Hardware states }
+ mov es, WORD PTR [SavePtr+2]
+ mov bx, WORD PTR [SavePtr]
+ int 10h
+ end;
+ end;
+ end;
+
+ procedure RestoreStateVGA; far;
+ begin
+ { go back to the old video mode...}
+ asm
+ mov ah,00
+ mov al,[VideoMode]
+ int 10h
+ end;
+
+ { then restore all state information }
+ if assigned(SavePtr) and (SaveSupPorted=TRUE) then
+ begin
+ { restore state, according to Ralph Brown Interrupt list }
+ asm
+ mov ax, 1C02h { save the state buffer }
+ mov cx, 00000111b { Save DAC / Data areas / Hardware states }
+ mov es, WORD PTR [SavePtr+2]
+ mov bx, WORD PTR [SavePtr]
+ int 10h
+ end;
+{ done in exitproc (JM)
+ FreeMem(SavePtr, 64*StateSize);}
+ SavePtr := nil;
+ end;
+ end;
+{$ENDIF DPMI}
+
+ Procedure SetVGARGBAllPalette(const Palette:PaletteType); {$ifndef fpc}far;{$endif fpc}
+ var
+ c: byte;
+ begin
+ { wait for vertical retrace start/end}
+ while (port[$3da] and $8) <> 0 do;
+ while (port[$3da] and $8) = 0 do;
+ If MaxColor = 16 Then
+ begin
+ for c := 0 to 15 do
+ begin
+ { translate the color number for 16 color mode }
+ portb[$3c8] := toRealCols16[c];
+ portb[$3c9] := palette.colors[c].red shr 2;
+ portb[$3c9] := palette.colors[c].green shr 2;
+ portb[$3c9] := palette.colors[c].blue shr 2;
+ end
+ end
+ else
+ begin
+ portb[$3c8] := 0;
+ for c := 0 to 255 do
+ begin
+ { no need to set port[$3c8] every time if you set the entries }
+ { for successive colornumbers (JM) }
+ portb[$3c9] := palette.colors[c].red shr 2;
+ portb[$3c9] := palette.colors[c].green shr 2;
+ portb[$3c9] := palette.colors[c].blue shr 2;
+ end
+ end;
+ End;
+
+
+ { VGA is never a direct color mode, so no need to check ... }
+ Procedure SetVGARGBPalette(ColorNum, RedValue, GreenValue,
+ BlueValue : Integer); {$ifndef fpc}far;{$endif fpc}
+ begin
+ { translate the color number for 16 color mode }
+ If MaxColor = 16 Then
+ ColorNum := ToRealCols16[ColorNum];
+ asm
+ { on some hardware - there is a snow like effect }
+ { when changing the palette register directly }
+ { so we wait for a vertical retrace start period. }
+ mov dx, $03da
+ @1:
+ in al, dx { Get input status register }
+ test al, $08 { check if in vertical retrace }
+ jnz @1 { yes, complete it }
+ { we have to wait for the next }
+ { retrace to assure ourselves }
+ { that we have time to complete }
+ { the DAC operation within }
+ { the vertical retrace period }
+ @2:
+ in al, dx
+ test al, $08
+ jz @2 { repeat until vertical retrace start }
+
+ mov dx, $03c8 { Set color register address to use }
+ mov ax, [ColorNum]
+ out dx, al
+ inc dx { Point to DAC registers }
+ mov ax, [RedValue] { Get RedValue }
+ shr ax, 2
+ out dx, al
+ mov ax, [GreenValue]{ Get RedValue }
+ shr ax, 2
+ out dx, al
+ mov ax, [BlueValue] { Get RedValue }
+ shr ax, 2
+ out dx, al
+ end
+ End;
+
+
+ { VGA is never a direct color mode, so no need to check ... }
+ Procedure GetVGARGBPalette(ColorNum: integer; Var
+ RedValue, GreenValue, BlueValue : integer); {$ifndef fpc}far;{$endif fpc}
+ begin
+ If MaxColor = 16 Then
+ ColorNum := ToRealCols16[ColorNum];
+ Port[$03C7] := ColorNum;
+ { we must convert to lsb values... because the vga uses the 6 msb bits }
+ { which is not compatible with anything. }
+ RedValue := Integer(Port[$3C9]) shl 2;
+ GreenValue := Integer(Port[$3C9]) shl 2;
+ BlueValue := Integer(Port[$3C9]) shl 2;
+ end;
+
+
+ {************************************************************************}
+ {* VESA related routines *}
+ {************************************************************************}
+{$I vesa.inc}
+
+ {************************************************************************}
+ {* General routines *}
+ {************************************************************************}
+ procedure CloseGraph;
+ Begin
+ If not isgraphmode then
+ begin
+ _graphresult := grnoinitgraph;
+ exit
+ end;
+ if not assigned(RestoreVideoState) then
+ RunError(216);
+ RestoreVideoState;
+ isgraphmode := false;
+ end;
+(*
+ procedure LoadFont8x8;
+
+ var
+ r : registers;
+ x,y,c : longint;
+ data : array[0..127,0..7] of byte;
+
+ begin
+ r.ah:=$11;
+ r.al:=$30;
+ r.bh:=1;
+ RealIntr($10,r);
+ dosmemget(r.es,r.bp,data,sizeof(data));
+ for c:=0 to 127 do
+ for y:=0 to 7 do
+ for x:=0 to 7 do
+ if (data[c,y] and ($80 shr x))<>0 then
+ DefaultFontData[chr(c),y,x]:=1
+ else
+ DefaultFontData[chr(c),y,x]:=0;
+ { second part }
+ r.ah:=$11;
+ r.al:=$30;
+ r.bh:=0;
+ RealIntr($10,r);
+ dosmemget(r.es,r.bp,data,sizeof(data));
+ for c:=0 to 127 do
+ for y:=0 to 7 do
+ for x:=0 to 7 do
+ if (data[c,y] and ($80 shr x))<>0 then
+ DefaultFontData[chr(c+128),y,x]:=1
+ else
+ DefaultFontData[chr(c+128),y,x]:=0;
+ end;
+*)
+ function QueryAdapterInfo:PModeInfo;
+ { This routine returns the head pointer to the list }
+ { of supPorted graphics modes. }
+ { Returns nil if no graphics mode supported. }
+ { This list is READ ONLY! }
+ var
+ EGADetected : Boolean;
+ VGADetected : Boolean;
+ mode: TModeInfo;
+ begin
+ QueryAdapterInfo := ModeList;
+ { If the mode listing already exists... }
+ { simply return it, without changing }
+ { anything... }
+ if assigned(ModeList) then
+ exit;
+
+
+ EGADetected := FALSE;
+ VGADetected := FALSE;
+ { check if Hercules adapter supPorted ... }
+ { check if EGA adapter supPorted... }
+ asm
+ mov ah,12h
+ mov bx,0FF10h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h { get EGA information }
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ cmp bh,0ffh
+ jz @noega
+ mov [EGADetected],TRUE
+ @noega:
+ end;
+{$ifdef logging}
+ LogLn('EGA detected: '+strf(Longint(EGADetected)));
+{$endif logging}
+ { check if VGA adapter supPorted... }
+ if EGADetected then
+ begin
+ asm
+ mov ax,1a00h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h { get display combination code...}
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ cmp al,1ah { check if supPorted... }
+ jne @novga
+ { now check if this is the ATI EGA }
+ mov ax,1c00h { get state size for save... }
+ { ... all imPortant data }
+ mov cx,07h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ cmp al,1ch { success? }
+ jne @novga
+ mov [VGADetected],TRUE
+ @novga:
+ end;
+ end;
+{$ifdef logging}
+ LogLn('VGA detected: '+strf(Longint(VGADetected)));
+{$endif logging}
+ if VGADetected then
+ begin
+ SaveVideoState := @SaveStateVGA;
+{$ifdef logging}
+ LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
+{$endif logging}
+ RestoreVideoState := @RestoreStateVGA;
+{$ifdef logging}
+ LogLn('Setting VGA RestoreVideoState to '+strf(longint(RestoreVideoState)));
+{$endif logging}
+
+ InitMode(mode);
+ { now add all standard VGA modes... }
+ mode.DriverNumber:= LowRes;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=0;
+ mode.ModeName:='320 x 200 VGA';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 319;
+ mode.MaxY := 199;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel320;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel320;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel320;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+ mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual320;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init320;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+
+ { now add all standard VGA modes... }
+ InitMode(mode);
+ mode.DriverNumber:= LowRes;
+ mode.ModeNumber:=1;
+ mode.HardwarePages := 3; { 0..3 }
+ mode.ModeName:='320 x 200 ModeX';
+ mode.MaxColor := 256;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 319;
+ mode.MaxY := 199;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelX;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelX;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelX;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+ mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualX;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveX;
+ mode.InitMode := {$ifdef fpc}@{$endif}InitModeX;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+
+ InitMode(mode);
+ mode.ModeNumber:=VGALo;
+ mode.DriverNumber := VGA;
+ mode.ModeName:='640 x 200 VGA';
+ mode.MaxColor := 16;
+ mode.HardwarePages := 2;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 639;
+ mode.MaxY := 199;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+ mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
+ mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+ mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+
+ InitMode(mode);
+ mode.ModeNumber:=VGAMed;
+ mode.DriverNumber := VGA;
+ mode.ModeName:='640 x 350 VGA';
+ mode.HardwarePages := 1;
+ mode.MaxColor := 16;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 639;
+ mode.MaxY := 349;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x350x16;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+ mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual350;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive350;
+ mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+ mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+
+ InitMode(mode);
+ mode.ModeNumber:=VGAHi;
+ mode.DriverNumber := VGA;
+ mode.HardwarePages := 0;
+ mode.ModeName:='640 x 480 VGA';
+ mode.MaxColor := 16;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 639;
+ mode.MaxY := 479;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
+ mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x16;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual480;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive480;
+ mode.HLine := {$ifdef fpc}@{$endif}HLine16;
+ mode.VLine := {$ifdef fpc}@{$endif}VLine16;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+
+ { check if VESA adapter supPorted... }
+{$ifndef noSupPortVESA}
+ hasVesa := getVesaInfo(VESAInfo);
+ { VBE Version v1.00 is unstable, therefore }
+ { only VBE v1.1 and later are supported. }
+ if (hasVESA=TRUE) and (VESAInfo.Version <= $0100) then
+ hasVESA := False;
+{$else noSupPortVESA}
+ hasVESA := false;
+{$endif noSupPortVESA}
+ if hasVesa then
+ begin
+ { We have to set and restore the entire VESA state }
+ { otherwise, if we use the VGA BIOS only function }
+ { there might be a crash under DPMI, such as in the}
+ { ATI Mach64 }
+ SaveVideoState := @SaveStateVESA;
+{$ifdef logging}
+ LogLn('Setting SaveVideoState to '+strf(longint(SaveVideoState)));
+{$endif logging}
+ RestoreVideoState := @RestoreStateVESA;
+{$ifdef logging}
+ LogLn('Setting RestoreVideoState to '+strf(longint(RestoreVideoState)));
+{$endif logging}
+ { now check all supported modes...}
+ if SearchVESAModes(m320x200x32k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m320x200x32k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='320 x 200 VESA';
+ mode.MaxColor := 32768;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 319;
+ mode.MaxY := 199;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init320x200x32k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m320x200x64k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m320x200x64k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='320 x 200 VESA';
+ mode.MaxColor := 65536;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 319;
+ mode.MaxY := 199;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init320x200x64k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m640x400x256) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m640x400x256;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='640 x 400 VESA';
+ mode.MaxColor := 256;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 639;
+ mode.MaxY := 399;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x400x256;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+ mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m640x480x256) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m640x480x256;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='640 x 480 VESA';
+ mode.MaxColor := 256;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 639;
+ mode.MaxY := 479;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x256;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+ mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+ mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m640x480x32k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m640x480x32k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='640 x 480 VESA';
+ mode.MaxColor := 32768;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 639;
+ mode.MaxY := 479;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x32k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m640x480x64k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m640x480x64k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='640 x 480 VESA';
+ mode.MaxColor := 65536;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 639;
+ mode.MaxY := 479;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x64k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m800x600x16) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m800x600x16;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='800 x 600 VESA';
+ mode.MaxColor := 16;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 799;
+ mode.MaxY := 599;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x16;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m800x600x256) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m800x600x256;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='800 x 600 VESA';
+ mode.MaxColor := 256;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 799;
+ mode.MaxY := 599;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x256;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+ mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+ mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m800x600x32k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m800x600x32k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='800 x 600 VESA';
+ mode.MaxColor := 32768;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 799;
+ mode.MaxY := 599;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x32k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m800x600x64k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m800x600x64k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='800 x 600 VESA';
+ mode.MaxColor := 65536;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 799;
+ mode.MaxY := 599;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x64k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1024x768x16) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1024x768x16;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1024 x 768 VESA';
+ mode.MaxColor := 16;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 1023;
+ mode.MaxY := 767;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x16;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1024x768x256) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1024x768x256;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1024 x 768 VESA';
+ mode.MaxColor := 256;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 1023;
+ mode.MaxY := 767;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x256;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+ mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+ mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1024x768x32k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1024x768x32k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1024 x 768 VESA';
+ mode.MaxColor := 32768;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := TRUE;
+ mode.MaxX := 1023;
+ mode.MaxY := 767;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x32k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1024x768x64k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1024x768x64k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1024 x 768 VESA';
+ mode.MaxColor := 65536;
+ mode.DirectColor := TRUE;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 1023;
+ mode.MaxY := 767;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x64k;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1280x1024x16) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1280x1024x16;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1280 x 1024 VESA';
+ mode.MaxColor := 16;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 1279;
+ mode.MaxY := 1023;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x16;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1280x1024x256) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1280x1024x256;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1280 x 1024 VESA';
+ mode.MaxColor := 256;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.DirectColor := FALSE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 1279;
+ mode.MaxY := 1023;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x256;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+{$ifdef fpc}
+ mode.SetAllPalette := @SetVESARGBAllPalette;
+{$endif fpc}
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
+ mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
+ mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
+ mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1280x1024x32k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1280x1024x32k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1280 x 1024 VESA';
+ mode.MaxColor := 32768;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.DirectColor := TRUE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 1279;
+ mode.MaxY := 1023;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x32k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if SearchVESAModes(m1280x1024x64k) then
+ begin
+ InitMode(mode);
+ mode.ModeNumber:=m1280x1024x64k;
+ mode.DriverNumber := VESA;
+ mode.ModeName:='1280 x 1024 VESA';
+ mode.MaxColor := 65536;
+ { the ModeInfo is automatically set if the mode is supPorted }
+ { by the call to SearchVESAMode. }
+ mode.HardwarePages := VESAModeInfo.NumberOfPages;
+ mode.DirectColor := TRUE;
+ mode.PaletteSize := mode.MaxColor;
+ mode.MaxX := 1279;
+ mode.MaxY := 1023;
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
+ mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x64k;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ end;
+ end;
+
+var
+ go32exitsave: pointer;
+
+procedure freeSaveStateBuffer; {$ifndef fpc}far; {$endif}
+begin
+ if savePtr <> nil then
+ begin
+{$ifdef dpmi}
+{$ifndef fpc}
+ if GlobalDosFree(longint(SavePtr) shr 16)<>0 then;
+{$else fpc}
+ if Not Global_Dos_Free(longint(SavePtr) shr 16) then;
+{$endif fpc}
+{$else dpmi}
+ FreeMem(SavePtr, 64*StateSize);
+{$endif dpmi}
+ SavePtr := nil;
+ end;
+ exitproc := go32exitsave;
+end;
+
+begin
+ { must be done *before* initialize graph is called, because the save }
+ { buffer can be used in the normal exit_proc (which is hooked in }
+ { initializegraph and as such executed first) (JM) }
+ go32exitsave := exitproc;
+ exitproc := @freeSaveStateBuffer;
+ { windows screws up the display if the savestate/restore state }
+ { stuff is used (or uses an abnormal amount of cpu time after }
+ { such a problem has exited), so detect its presense and do not }
+ { use those functions if it's running. I'm really tired of }
+ { working around Windows bugs :( (JM) }
+ asm
+ mov ax,$160a
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int $2f
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ test ax,ax
+ sete al
+ mov inWindows,al
+ end;
+ InitializeGraph;
+end.
+{
+ $Log: graph.pp,v $
+ Revision 1.13 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/initc.pp b/rtl/go32v2/initc.pp
new file mode 100644
index 0000000000..f1401fc3c0
--- /dev/null
+++ b/rtl/go32v2/initc.pp
@@ -0,0 +1,101 @@
+{
+ $Id: initc.pp,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller
+
+ Code to generate execution of all c functions
+ with constructors attributes
+
+ Based on .ctor and .dtor sections of DJGPP gcc compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit InitC;
+
+interface
+
+implementation
+
+ { we need to include dpmiexcp unit
+ to avoid getting troubles with _exit found both
+ in libc and in v2prt0.as PM }
+ uses
+ dpmiexcp;
+
+ type
+ simple_proc = procedure;
+ var
+ first_ctor : longint;external name 'djgpp_first_ctor';
+ ctor : array [0..maxlongint div sizeof(simple_proc)-1] of simple_proc;external name 'djgpp_first_ctor';
+ last_ctor : longint;external name 'djgpp_last_ctor';
+ first_dtor : longint;external name 'djgpp_first_dtor';
+ dtor : array [0..maxlongint div sizeof(simple_proc)-1] of simple_proc;external name 'djgpp_first_dtor';
+ last_dtor : longint;external name 'djgpp_last_dtor';
+ bss_count : longint;external name '___bss_count';
+ const
+ save_exit : pointer = nil;
+
+procedure run_c_constructors;
+
+ const
+ already_done : longint = -1;
+ var
+ f : simple_proc;
+ i,nb : longint;
+ begin
+ if already_done=bss_count then
+ exit;
+ already_done:=bss_count;
+ f:=ctor[0];
+ nb:=((cardinal(@last_ctor)-cardinal(@first_ctor)) div sizeof(pointer));
+ for i:=1 to nb do
+ begin
+ f();
+ f:=ctor[i];
+ end;
+ end;
+
+procedure run_c_destructors;
+ const
+ already_done : longint = -1;
+ var
+ f : simple_proc;
+ i,nb : longint;
+ begin
+ exitproc:=save_exit;
+ if already_done=bss_count then
+ exit;
+ already_done:=bss_count;
+ f:=dtor[0];
+ nb:=((cardinal(last_dtor)-cardinal(first_dtor)) div sizeof(pointer));
+ for i:=1 to nb do
+ begin
+ f();
+ f:=dtor[i];
+ end;
+ end;
+
+begin
+ run_c_constructors;
+ If cardinal(@first_dtor)<>cardinal(@last_dtor) then
+ begin
+ { can exitproc be allready non nil here ?
+ you have to make really weird things to achieve
+ that be lets suppose it is possible !! (PM) }
+ save_exit:=exitproc;
+ exitproc:=@run_c_destructors;
+ end;
+end.
+
+{
+ $Log: initc.pp,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/keyboard.pp b/rtl/go32v2/keyboard.pp
new file mode 100644
index 0000000000..5766d1cdc0
--- /dev/null
+++ b/rtl/go32v2/keyboard.pp
@@ -0,0 +1,83 @@
+{
+ $Id: keyboard.pp,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Keyboard unit for go32v2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Keyboard;
+interface
+
+{$i keybrdh.inc}
+
+implementation
+
+uses
+ go32;
+
+{$i keyboard.inc}
+
+
+function SysGetKeyEvent: TKeyEvent;
+
+var
+ regs : trealregs;
+begin
+ regs.ah:=$10;
+ realintr($16,regs);
+ if (regs.al=$e0) and (regs.ah<>0) then
+ regs.al:=0;
+ SysGetKeyEvent:=(kbPhys shl 24) or regs.ax or ((mem[$40:$17] and $f) shl 16);
+end;
+
+
+function SysPollKeyEvent: TKeyEvent;
+var
+ regs : trealregs;
+begin
+ regs.ah:=$11;
+ realintr($16,regs);
+ if (regs.realflags and zeroflag<>0) then
+ exit(0);
+ if (regs.al=$e0) and (regs.ah<>0) then
+ regs.al:=0;
+ SysPollKeyEvent:=(kbPhys shl 24) or regs.ax or ((mem[$40:$17] and $f) shl 16);
+end;
+
+
+function SysGetShiftState: Byte;
+begin
+ SysGetShiftState:=(mem[$40:$17] and $f);
+end;
+
+
+Const
+ SysKeyboardDriver : TKeyboardDriver = (
+ InitDriver : Nil;
+ DoneDriver : Nil;
+ GetKeyevent : @SysGetKeyEvent;
+ PollKeyEvent : @SysPollKeyEvent;
+ GetShiftState : @SysGetShiftState;
+ TranslateKeyEvent : Nil;
+ TranslateKeyEventUnicode : Nil;
+ );
+
+begin
+ SetKeyBoardDriver(SysKeyBoardDriver);
+end.
+
+{
+ $Log: keyboard.pp,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/mouse.pp b/rtl/go32v2/mouse.pp
new file mode 100644
index 0000000000..aa89472dba
--- /dev/null
+++ b/rtl/go32v2/mouse.pp
@@ -0,0 +1,808 @@
+{
+ $Id: mouse.pp,v 1.12 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Mouse unit for Go32v2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Mouse;
+interface
+
+{$i mouseh.inc}
+
+{ tells the mouse unit to draw the mouse cursor itself }
+procedure DoCustomMouse(b : boolean);
+
+
+implementation
+
+uses
+ video,go32;
+
+{$i mouse.inc}
+
+
+var
+ RealSeg : Word; { Real mode segment }
+ RealOfs : Word; { Real mode offset }
+ CurrentMask : word;
+ MouseCallback : Pointer; { Mouse call back ptr }
+ UnderNT: boolean;
+{$ifdef DEBUG}
+ EntryEDI,EntryESI : longint;
+ EntryDS,EntryES : word;
+{$endif DEBUG}
+ { Real mode registers in text segment below $ffff limit
+ for Windows NT
+ NOTE this might cause problem if someone want to
+ protect text section against writing (would be possible
+ with CWSDPMI under raw dos, not implemented yet !) }
+ ActionRegs : TRealRegs;external name '___v2prt0_rmcb_regs';
+ v2prt0_ds_alias : word;external name '___v2prt0_ds_alias';
+const
+ MousePresent : boolean = false;
+ First_try : boolean = true;
+{$ifdef DEBUG}
+ MouseError : longint = 0;
+ CallCounter : longint = 0;
+{$endif DEBUG}
+ drawmousecursor : boolean = false;
+ mouseisvisible : boolean = false;
+ { position where the mouse was drawn the last time }
+ oldmousex : longint = -1;
+ oldmousey : longint = -1;
+ mouselock : boolean = false;
+
+{ if the cursor is drawn by this the unit, we must be careful }
+{ when drawing while the interrupt handler is called }
+procedure lockmouse;assembler;
+
+ asm
+ .Ltrylockagain:
+ movb $1,%al
+ xchgb mouselock,%al
+ orb %al,%al
+ jne .Ltrylockagain
+ end;
+
+procedure unlockmouse;
+
+ begin
+ mouselock:=false;
+ end;
+
+
+{$ASMMODE ATT}
+procedure MouseInt;assembler;
+asm
+ pushl %edi
+ pushl %ebx
+ movb %bl,mousebuttons
+ movw %cx,mousewherex
+ movw %dx,mousewherey
+ shrw $3,%cx
+ shrw $3,%dx
+ { should we draw the mouse cursor? }
+ cmpb $0,drawmousecursor
+ je .Lmouse_nocursor
+ cmpb $0,mouseisvisible
+ je .Lmouse_nocursor
+ pushw %fs
+ pushl %eax
+ pushl %edi
+ { check lock }
+ movb $1,%al
+ xchgb mouselock,%al
+ orb %al,%al
+ { don't update the cursor yet, because hide/showcursor is called }
+ jne .Ldont_draw
+
+ { load start of video buffer }
+ movzwl videoseg,%edi
+ shll $4,%edi
+ movw dosmemselector,%fs
+
+ { calculate address of old mouse cursor }
+ movl oldmousey,%eax
+ imulw screenwidth,%ax
+ addl oldmousex,%eax
+ leal 1(%edi,%eax,2),%eax
+ { remove old cursor }
+ xorb $0x7f,%fs:(%eax)
+
+ { store position of old cursor }
+ movzwl %cx,%ecx
+ movl %ecx,oldmousex
+ movzwl %dx,%edx
+ movl %edx,oldmousey
+
+ { calculate address of new cursor }
+ movl %edx,%eax
+ imulw screenwidth,%ax
+ addl %ecx,%eax
+ leal 1(%edi,%eax,2),%eax
+ { draw new cursor }
+ xorb $0x7f,%fs:(%eax)
+
+ { unlock mouse }
+ movb $0,mouselock
+
+.Ldont_draw:
+ popl %edi
+ popl %eax
+ popw %fs
+.Lmouse_nocursor:
+ cmpb MouseEventBufSize,PendingMouseEvents
+ je .Lmouse_exit
+ movl PendingMouseTail,%edi
+ movw %bx,(%edi)
+ movw %cx,2(%edi)
+ movw %dx,4(%edi)
+ movw $0,6(%edi)
+ addl $8,%edi
+ leal PendingMouseEvent,%eax
+ addl MouseEventBufSize*8,%eax
+ cmpl %eax,%edi
+ jne .Lmouse_nowrap
+ leal PendingMouseEvent,%edi
+.Lmouse_nowrap:
+ movl %edi,PendingMouseTail
+ incb PendingMouseEvents
+.Lmouse_exit:
+ popl %ebx
+ popl %edi
+end;
+
+
+
+PROCEDURE Mouse_Trap; ASSEMBLER;
+ASM
+ PUSH %ES; { Save ES register }
+ PUSH %DS; { Save DS register }
+ PUSHL %EDI; { Save register }
+ PUSHL %ESI; { Save register }
+ { ; caution : ds is not the selector for our data !! }
+{$ifdef DEBUG}
+ MOVL %EDI,%ES:EntryEDI
+ MOVL %ESI,%ES:EntryESI
+ MOVW %DS,%AX
+ MOVW %AX,%ES:EntryDS
+ MOVW %ES,%AX
+ MOVW %AX,%ES:EntryES
+{$endif DEBUG}
+ { movw %cs:v2prt0_ds_alias,%ax v2prt0 is not locked !!
+ movw %ax,%ds
+ movw %ax,%es }
+ PUSH %ES; { Push data seg }
+ POP %DS; { Load data seg }
+{$ifdef DEBUG}
+ incl callcounter
+ CMPL $ACTIONREGS,%edi
+ JE .L_ActionRegsOK
+ INCL MouseError
+ JMP .L_NoCallBack
+.L_ActionRegsOK:
+{$endif DEBUG}
+ MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
+ CMPL $0, %EAX; { Check for nil ptr }
+ JZ .L_NoCallBack; { Ignore if nil }
+ MOVL %EDI,%EAX; { %EAX = @actionregs }
+ MOVL (%EAX), %EDI; { EDI from actionregs }
+ MOVL 4(%EAX), %ESI; { ESI from actionregs }
+ MOVL 16(%EAX), %EBX; { EBX from actionregs }
+ MOVL 20(%EAX), %EDX; { EDX from actionregs }
+ MOVL 24(%EAX), %ECX; { ECX from actionregs }
+ MOVL 28(%EAX), %EAX; { EAX from actionregs }
+ CALL *MOUSECALLBACK; { Call callback proc }
+.L_NoCallBack:
+ POPL %ESI; { Recover register }
+ POPL %EDI; { Recover register }
+ POP %DS; { Restore DS register }
+ POP %ES; { Restore ES register }
+ { This works for WinNT
+ movzwl %si,%eax
+ but CWSDPMI need this }
+ movl %esi,%eax
+ MOVL %ds:(%Eax), %EAX;
+ MOVL %EAX, %ES:42(%EDI); { Set as return addr }
+ ADDW $4, %ES:46(%EDI); { adjust stack }
+ IRET; { Interrupt return }
+END;
+
+PROCEDURE Mouse_Trap_NT; ASSEMBLER;
+ASM
+ pushl %eax;
+ PUSH %ES; { Save ES register }
+ PUSH %DS; { Save DS register }
+ PUSH %FS; { Save FS register }
+ PUSHL %EDI; { Save register }
+ PUSHL %ESI; { Save register }
+ pushl %ebx;
+ pushl %ecx;
+ pushl %edx;
+ { ; caution : ds is not the selector for our data !! }
+ MOVW %cs:v2prt0_ds_alias,%ax
+ movw %ax,%es
+ { ES now has dataseg alias that is never invalid }
+{$ifdef DEBUG}
+ MOVL %EDI,%ES:EntryEDI
+ MOVL %ESI,%ES:EntryESI
+ MOVW %DS,%AX
+ MOVW %AX,%ES:EntryDS
+ MOVW %ES,%AX
+ MOVW %AX,%ES:EntryES
+{$endif DEBUG}
+ { movw %cs:v2prt0_ds_alias,%ax v2prt0 is not locked !!
+ movw %ax,%ds
+ movw %ax,%es }
+ PUSH %ES; { Push data seg }
+ POP %DS; { Load data seg }
+{$ifdef DEBUG}
+ incl callcounter
+ CMPL $ACTIONREGS,%edi
+ JE .L_ActionRegsOK
+ INCL MouseError
+ JMP .L_NoCallBack
+.L_ActionRegsOK:
+{$endif DEBUG}
+ MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
+ CMPL $0, %EAX; { Check for nil ptr }
+ JZ .L_NoCallBack; { Ignore if nil }
+ MOVL %EDI,%EAX; { %EAX = @actionregs }
+ MOVL (%EAX), %EDI; { EDI from actionregs }
+ MOVL 4(%EAX), %ESI; { ESI from actionregs }
+ MOVL 16(%EAX), %EBX; { EBX from actionregs }
+ MOVL 20(%EAX), %EDX; { EDX from actionregs }
+ MOVL 24(%EAX), %ECX; { ECX from actionregs }
+ MOVL 28(%EAX), %EAX; { EAX from actionregs }
+ CALL *MOUSECALLBACK; { Call callback proc }
+.L_NoCallBack:
+ popl %edx;
+ popl %ecx;
+ popl %ebx;
+ POPL %ESI; { Recover register }
+ POPL %EDI; { Recover register }
+ POP %FS; { Restore FS register }
+ POP %DS; { Restore DS register }
+ POP %ES; { Restore ES register }
+ movw %es,%ax
+ cmpw $0,%ax
+ jne .Lesisok
+ { ; caution : ds is not the selector for our data !! }
+ MOVW %cs:v2prt0_ds_alias,%ax
+ movw %ax,%es
+.Lesisok:
+ lsl %eax,%eax
+ cmpl %edi,%eax
+ ja .Ldontzeroedi
+ movzwl %di,%edi
+.Ldontzeroedi:
+ movw %ds,%ax
+ lsl %eax,%eax
+ cmpl %esi,%eax
+ ja .Lsimplecopy
+ movzwl %si,%eax
+ jmp .Lcopyend
+.Lsimplecopy:
+ movl %esi,%eax
+.Lcopyend:
+ MOVL %ds:(%Eax), %EAX
+ MOVL %EAX, %ES:42(%EDI) { Set as return addr }
+ ADDW $4, %ES:46(%EDI) { adjust stack }
+ popl %eax
+ IRET { Interrupt return }
+END;
+
+Function Allocate_mouse_bridge : boolean;
+var
+ error : word;
+begin
+ ASM
+ pushl %edi
+ pushl %esi
+ LEAL ACTIONREGS, %EDI; { Addr of actionregs }
+ LEAL MOUSE_TRAP, %ESI; { Procedure address }
+ CMPB $0, UnderNT
+ JZ .LGo32
+ LEAL MOUSE_TRAP_NT, %ESI; { Procedure address }
+ .LGo32:
+ PUSH %DS; { Save DS segment }
+ PUSH %ES; { Save ES segment }
+ MOVW v2prt0_ds_alias,%ES; { ES now has dataseg alias that is never invalid }
+ PUSH %CS;
+ POP %DS; { DS now has codeseg }
+ MOVW $0x303, %AX; { Function id }
+ INT $0x31; { Call DPMI bridge }
+ JNC .L_call_ok; { Branch if ok }
+ POP %ES; { Restore ES segment }
+ POP %DS; { Restore DS segment }
+ MOVW $0,REALSEG;
+ MOVW $0,REALOFS;
+ JMP .L_exit
+ .L_call_ok:
+ POP %ES; { Restore ES segment }
+ POP %DS; { Restore DS segment }
+ MOVW %CX,REALSEG; { Transfer real seg }
+ MOVW %DX,REALOFS; { Transfer real ofs }
+ MOVW $0, %AX; { Force error to zero }
+ .L_exit:
+ MOVW %AX, ERROR; { Return error state }
+ popl %esi
+ popl %edi
+ END;
+ Allocate_mouse_bridge:=error=0;
+end;
+
+Procedure Release_mouse_bridge;
+begin
+ ASM
+ MOVW $0x304, %AX; { Set function id }
+ MOVW REALSEG, %CX; { Bridged real seg }
+ MOVW REALOFS, %DX; { Bridged real ofs }
+ INT $0x31; { Release bridge }
+ MOVW $0,REALSEG;
+ MOVW $0,REALOFS;
+ END;
+end;
+
+PROCEDURE Mouse_Action (Mask : Word; P : Pointer);
+VAR
+ Error : Word;
+ Rg : TRealRegs;
+BEGIN
+ Error := 0; { Preset no error }
+ If (P <> MouseCallBack) or (Mask<>CurrentMask) Then { Check func different }
+ Begin
+ { Remove old calback }
+ If (CurrentMask <> 0) Then
+ Begin
+ Rg.AX := 12; { Function id }
+ Rg.CX := 0; { Zero mask register }
+ Rg.ES := 0; { Zero proc seg }
+ Rg.DX := 0; { Zero proc ofs }
+ RealIntr($33, Rg); { Stop INT 33 callback }
+ End;
+ if RealSeg=0 then
+ error:=1;
+ { test addresses for Windows NT }
+ if (longint(@actionregs)>$ffff) {or
+ (longint(@mouse_trap)>$ffff)} then
+ begin
+ error:=1;
+ end
+ else If (P = Nil) Then
+ Begin
+ Mask := 0; { Zero mask register }
+ End;
+ If (Error = 0) Then
+ Begin
+ MouseCallback := P; { Set call back addr }
+ if Mask<>0 then
+ begin
+ Rg.AX := 12; { Set function id }
+ Rg.CX := Mask; { Set mask register }
+ If Mask<>0 then
+ begin
+ Rg.ES := RealSeg; { Real mode segment }
+ Rg.DX := RealOfs; { Real mode offset }
+ end
+ else
+ begin
+ Rg.ES:=0;
+ Rg.DX:=0;
+ end;
+ RealIntr($33, Rg); { Set interrupt 33 }
+ end;
+ CurrentMask:=Mask;
+ End;
+ End;
+ If (Error <> 0) Then
+ Begin
+ Writeln('GO32V2 mouse handler set failed !!');
+ ReadLn; { Wait for user to see }
+ End;
+END;
+
+
+{ We need to remove the mouse callback before exiting !! PM }
+
+const StoredExit : Pointer = Nil;
+ FirstMouseInitDone : boolean = false;
+
+procedure MouseSafeExit;
+begin
+ ExitProc:=StoredExit;
+ if MouseCallBack<>Nil then
+ Mouse_Action(0, Nil);
+ if not FirstMouseInitDone then
+ exit;
+ FirstMouseInitDone:=false;
+ Unlock_Code(Pointer(@Mouse_Trap), 400); { Release trap code }
+ Unlock_Code(Pointer(@Mouse_Trap_NT), 400); { Release trap code }
+ Unlock_Code(Pointer(@MouseInt), 400); { Lock MouseInt code }
+ Unlock_Data(ActionRegs, SizeOf(TRealRegs)); { Release registers }
+ UnLock_Data(MouseCallBack,SizeOf(Pointer));
+ { unlock Mouse Queue and related stuff ! }
+ Unlock_Data(PendingMouseEvent,
+ MouseEventBufSize*Sizeof(TMouseEvent));
+ Unlock_Data(PendingMouseTail,SizeOf(longint));
+ Unlock_Data(PendingMouseEvents,sizeof(byte));
+ Unlock_Data(MouseButtons,SizeOf(byte));
+ Unlock_Data(MouseWhereX,SizeOf(word));
+ Unlock_Data(MouseWhereY,SizeOf(word));
+ Unlock_Data(drawmousecursor,SizeOf(boolean));
+ Unlock_Data(mouseisvisible,SizeOf(boolean));
+ Unlock_Data(mouselock,SizeOf(boolean));
+ Unlock_Data(videoseg,SizeOf(word));
+ Unlock_Data(dosmemselector,SizeOf(word));
+ Unlock_Data(screenwidth,SizeOf(word));
+ Unlock_Data(OldMouseX,SizeOf(longint));
+ Unlock_Data(OldMouseY,SizeOf(longint));
+{$ifdef DEBUG}
+ Unlock_Data(EntryEDI, SizeOf(longint));
+ Unlock_Data(EntryESI, SizeOf(longint));
+ Unlock_Data(EntryDS, SizeOf(word));
+ Unlock_Data(EntryES, SizeOf(word));
+ Unlock_Data(MouseError, SizeOf(longint));
+ Unlock_Data(callcounter, SizeOf(longint));
+{$endif DEBUG}
+ Release_mouse_bridge;
+end;
+
+function RunningUnderWINNT: boolean;
+var r: trealregs;
+begin
+ fillchar(r,sizeof(r),0);
+ r.ax:=$3306;
+ realintr($21,r);
+ RunningUnderWINNT:=(r.bx=$3205);
+end;
+
+procedure SysInitMouse;
+begin
+ UnderNT:=RunningUnderWINNT;
+ if not MousePresent then
+ begin
+ if DetectMouse=0 then
+ begin
+ if First_try then
+ begin
+ Writeln('No mouse driver found ');
+ First_try:=false;
+ end;
+ exit;
+ end
+ else
+ MousePresent:=true;
+ end;
+ { don't do this twice !! PM }
+
+ If not FirstMouseInitDone then
+ begin
+ StoredExit:=ExitProc;
+ ExitProc:=@MouseSafeExit;
+ Lock_Code(Pointer(@Mouse_Trap), 400); { Lock trap code }
+ Lock_Code(Pointer(@Mouse_Trap_NT), 400); { Lock trap code }
+ Lock_Code(Pointer(@MouseInt), 400); { Lock MouseInt code }
+ Lock_Data(ActionRegs, SizeOf(TRealRegs)); { Lock registers }
+ Lock_Data(MouseCallBack, SizeOf(pointer));
+ { lock Mouse Queue and related stuff ! }
+ Lock_Data(PendingMouseEvent,
+ MouseEventBufSize*Sizeof(TMouseEvent));
+ Lock_Data(PendingMouseTail,SizeOf(longint));
+ Lock_Data(PendingMouseEvents,sizeof(byte));
+ Lock_Data(MouseButtons,SizeOf(byte));
+ Lock_Data(MouseWhereX,SizeOf(word));
+ Lock_Data(MouseWhereY,SizeOf(word));
+ Lock_Data(drawmousecursor,SizeOf(boolean));
+ Lock_Data(mouseisvisible,SizeOf(boolean));
+ Lock_Data(mouselock,SizeOf(boolean));
+ Lock_Data(videoseg,SizeOf(word));
+ Lock_Data(dosmemselector,SizeOf(word));
+ Lock_Data(screenwidth,SizeOf(word));
+ Lock_Data(OldMouseX,SizeOf(longint));
+ Lock_Data(OldMouseY,SizeOf(longint));
+{$ifdef DEBUG}
+ Lock_Data(EntryEDI, SizeOf(longint));
+ Lock_Data(EntryESI, SizeOf(longint));
+ Lock_Data(EntryDS, SizeOf(word));
+ Lock_Data(EntryES, SizeOf(word));
+ Lock_Data(MouseError, SizeOf(longint));
+ Lock_Data(callcounter, SizeOf(longint));
+{$endif DEBUG}
+ Allocate_mouse_bridge;
+ FirstMouseInitDone:=true;
+ end;
+ If MouseCallBack=Nil then
+ Mouse_Action($ffff, @MouseInt); { Set masks/interrupt }
+ drawmousecursor:=false;
+ mouseisvisible:=false;
+ if (screenwidth>80) or (screenheight>50) then
+ DoCustomMouse(true);
+ ShowMouse;
+end;
+
+
+procedure SysDoneMouse;
+begin
+ HideMouse;
+ If (MouseCallBack <> Nil) Then
+ Mouse_Action(0, Nil); { Clear mask/interrupt }
+end;
+
+
+function SysDetectMouse:byte;assembler;
+asm
+ pushl %ebx
+ movl $0x200,%eax
+ movl $0x33,%ebx
+ int $0x31
+ movw %cx,%ax
+ orw %ax,%dx
+ jz .Lno_mouse
+ xorl %eax,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ orw %ax,%ax
+ jz .Lno_mouse
+ movl %ebx,%eax
+.Lno_mouse:
+ popl %ebx
+end;
+
+
+procedure SysShowMouse;
+
+begin
+ if drawmousecursor then
+ begin
+ lockmouse;
+ if not(mouseisvisible) then
+ begin
+ oldmousex:=getmousex-1;
+ oldmousey:=getmousey-1;
+ mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
+ mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
+ mouseisvisible:=true;
+ end;
+ unlockmouse;
+ end
+ else
+ asm
+ cmpb $1,MousePresent
+ jne .LShowMouseExit
+ movl $1,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ .LShowMouseExit:
+ end;
+end;
+
+
+procedure SysHideMouse;
+
+begin
+ if drawmousecursor then
+ begin
+ lockmouse;
+ if mouseisvisible then
+ begin
+ mouseisvisible:=false;
+ mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1]:=
+ mem[videoseg:(((screenwidth*oldmousey)+oldmousex)*2)+1] xor $7f;
+ oldmousex:=-1;
+ oldmousey:=-1;
+ end;
+ unlockmouse;
+ end
+ else
+ asm
+ cmpb $1,MousePresent
+ jne .LHideMouseExit
+ movl $2,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ .LHideMouseExit:
+ end;
+end;
+
+
+function SysGetMouseX:word;assembler;
+asm
+ pushl %ebx
+ cmpb $1,MousePresent
+ jne .LGetMouseXError
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ movzwl %cx,%eax
+ shrl $3,%eax
+ incl %eax
+ jmp .Lexit
+.LGetMouseXError:
+ xorl %eax,%eax
+.Lexit:
+ popl %ebx
+end;
+
+
+function SysGetMouseY:word;assembler;
+asm
+ pushl %ebx
+ cmpb $1,MousePresent
+ jne .LGetMouseYError
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ movzwl %dx,%eax
+ shrl $3,%eax
+ incl %eax
+ jmp .Lexit
+.LGetMouseYError:
+ xorl %eax,%eax
+.Lexit:
+ popl %ebx
+end;
+
+
+function SysGetMouseButtons:word;assembler;
+asm
+ pushl %ebx
+ cmpb $1,MousePresent
+ jne .LGetMouseButtonsError
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ movw %bx,%ax
+ jmp .Lexit
+.LGetMouseButtonsError:
+ xorl %eax,%eax
+.Lexit:
+ popl %ebx
+end;
+
+
+procedure SysSetMouseXY(x,y:word);assembler;
+asm
+ pushl %ebx
+ cmpb $1,MousePresent
+ jne .LSetMouseXYExit
+ movw x,%cx
+ movw y,%dx
+ movl $4,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+.LSetMouseXYExit:
+ popl %ebx
+end;
+
+Procedure SetMouseXRange (Min,Max:Longint);
+begin
+ If Not(MousePresent) Then Exit;
+ asm
+ movl $7,%eax
+ movl min,%ecx
+ movl max,%edx
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+end;
+
+Procedure SetMouseYRange (min,max:Longint);
+begin
+ If Not(MousePresent) Then Exit;
+ asm
+ movl $8,%eax
+ movl min,%ecx
+ movl max,%edx
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+end;
+
+procedure DoCustomMouse(b : boolean);
+
+ begin
+ HideMouse;
+ lockmouse;
+ oldmousex:=-1;
+ oldmousey:=-1;
+ SetMouseXRange(0,(screenwidth-1)*8);
+ SetMouseYRange(0,(screenheight-1)*8);
+ if b then
+ begin
+ mouseisvisible:=false;
+ drawmousecursor:=true;
+ end
+ else
+ drawmousecursor:=false;
+ unlockmouse;
+ end;
+
+const
+ LastCallcounter : longint = 0;
+
+procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
+begin
+ if not MousePresent then
+ begin
+ Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+ end;
+{$ifdef DEBUG}
+ if mouseError>0 then
+ Writeln('Errors in mouse Handler ',MouseError);
+{$ifdef EXTMOUSEDEBUG}
+ if callcounter>LastCallcounter then
+ Writeln('Number of calls in mouse Handler ',Callcounter);
+{$endif EXTMOUSEDEBUG}
+ LastCallcounter:=Callcounter;
+{$endif DEBUG}
+ repeat until PendingMouseEvents>0;
+ MouseEvent:=PendingMouseHead^;
+ inc(PendingMouseHead);
+ if longint(PendingMouseHead)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+ PendingMouseHead:=@PendingMouseEvent;
+ dec(PendingMouseEvents);
+ if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
+ MouseEvent.Action:=MouseActionMove;
+ if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
+ begin
+ if (LastMouseEvent.Buttons and MouseEvent.buttons<>LastMouseEvent.Buttons) then
+ MouseEvent.Action:=MouseActionUp
+ else
+ MouseEvent.Action:=MouseActionDown;
+ end;
+ LastMouseEvent:=MouseEvent;
+end;
+
+
+Const
+ SysMouseDriver : TMouseDriver = (
+ useDefaultQueue : true;
+ InitDriver : @SysInitMouse;
+ DoneDriver : @SysDoneMouse;
+ DetectMouse : @SysDetectMouse;
+ ShowMouse : @SysShowMouse;
+ HideMouse : @SysHideMouse;
+ GetMouseX : @SysGetMouseX;
+ GetMouseY : @SysGetMouseY;
+ GetMouseButtons : @SysGetMouseButtons;
+ SetMouseXY : @SysSetMouseXY;
+ GetMouseEvent : @SysGetMouseEvent;
+ PollMouseEvent : Nil;
+ PutMouseEvent : Nil;
+ );
+
+Begin
+ SetMouseDriver(SysMouseDriver);
+end.
+{
+ $Log: mouse.pp,v $
+ Revision 1.12 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.11 2005/01/12 10:25:48 armin
+ * Patch for bug 3548 from Peter
+
+ Revision 1.10 2005/01/03 18:15:34 peter
+ save ebx in assembler procs
+
+}
diff --git a/rtl/go32v2/msmouse.pp b/rtl/go32v2/msmouse.pp
new file mode 100644
index 0000000000..5348e31382
--- /dev/null
+++ b/rtl/go32v2/msmouse.pp
@@ -0,0 +1,369 @@
+{
+ $Id: msmouse.pp,v 1.7 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Mouse unit for microsoft mouse compatible drivers
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+Unit MSMouse;
+Interface
+
+{$calling oldfpccall}
+
+{
+ Mouse support functions and procedures, with error checking: if mouse
+ isn't present then the routine ends. If you want to remove error checking,
+ remove the next define.
+}
+
+
+{initializes the mouse with the default values for the current screen mode}
+ Function InitMouse:Boolean;
+
+{shows mouse pointer,text+graphics screen support}
+ Procedure ShowMouse;
+
+{hides mouse pointer}
+ Procedure HideMouse;
+
+{reads mouse position in pixels (divide by 8 to get text position in standard
+ text mode) and reads the buttons state:
+ bit 1 set -> left button pressed
+ bit 2 set -> right button pressed
+ bit 3 set -> middle button pressed
+ Have a look at the example program in the manual to see how you can use this}
+ Procedure GetMouseState(var x,y, buttons :Longint);
+
+{returns true if the left button is pressed}
+ Function LPressed:Boolean;
+
+{returns true if the right button is pressed}
+ Function RPressed:Boolean;
+
+{returns true if the middle button is pressed}
+ Function MPressed:Boolean;
+
+{positions the mouse pointer}
+ Procedure SetMousePos(x,y:Longint);
+
+{returns at which position "button" was last pressed in x,y and returns the
+ number of times this button has been pressed since the last time this
+ function was called with "button" as parameter. For button you can use the
+ LButton, RButton and MButton constants for resp. the left, right and middle
+ button}
+ Function GetLastButtonPress(button:Longint;var x,y:Longint): Longint;
+
+{returns at which position "button" was last released in x,y and returns the
+ number of times this button has been re since the last time. For button
+ you can use the LButton, RButton and MButton constants for resp. the left,
+ right and middle button}
+Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
+
+{sets mouse's x range, with Min and Max resp. the higest and the lowest
+ column (in pixels) in between which the mouse cursor can move}
+ Procedure SetMouseXRange (Min,Max:Longint);
+
+{sets mouse's y range, with Min and Max resp. the higest and the lowest
+ row (in pixels) in between which the mouse cursor can move}
+ Procedure SetMouseYRange (Min,Max:Longint);
+
+{set the window coordinates in which the mouse cursor can move}
+ Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
+
+{sets the mouse shape in text mode: background and foreground color and the
+ Ascii value with which the character on screen is XOR'ed when the cursor
+ moves over it. Set to 0 for a "transparent" cursor}
+ Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
+
+{sets the mouse ascii in text mode. The difference between this one and
+ SetMouseShape, is that the foreground and background colors stay the same
+ and that the Ascii code you enter is the character that you will get on
+ screen; there's no XOR'ing}
+ Procedure SetMouseAscii(Ascii:Byte);
+
+{set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16}
+ Procedure SetMouseSpeed(Horizontal ,Vertical:Longint);
+
+{set a rectangle on screen that mouse will disappear if it is moved into}
+ Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
+
+Const LButton = 1; {left button}
+ RButton = 2; {right button}
+ MButton = 4; {middle button}
+
+Var
+ MouseFound: Boolean;
+
+Implementation
+
+{$asmmode ATT}
+
+Function InitMouse: Boolean;
+begin
+ asm
+ xorl %eax,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ cmpw $0xffff,%ax
+ setz %al
+ movb %al,__RESULT
+ end;
+end;
+
+
+Procedure ShowMouse;
+begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $1,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+end;
+
+Procedure HideMouse;
+begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $2,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+end;
+
+Procedure GetMouseState(var x,y,buttons:Longint);
+begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ andl $0xffff,%ecx
+ andl $0xffff,%edx
+ movl x,%eax
+ movl %ecx,(%eax)
+ movl y,%eax
+ movl %edx,(%eax)
+ movl buttons,%eax
+ movw %bx,(%eax)
+ end;
+end;
+
+Function LPressed:Boolean;
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ movl %ebx,%eax
+ andl $1,%eax
+ movb %al,__RESULT
+ end;
+end;
+
+Function RPressed:Boolean;
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ movl %ebx,%eax
+ shrl $1,%eax
+ andl $1,%eax
+ movb %al,__RESULT
+ end;
+end;
+
+Function MPressed:Boolean;
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $3,%eax
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ movl %ebx,%eax
+ shrl $2,%eax
+ andl $1,%eax
+ movb %al,__RESULT
+ end;
+end;
+
+Procedure SetMousePos(x,y:Longint);
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $4,%eax
+ movl x,%ecx
+ movl y,%edx
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ End;
+End;
+
+Function GetLastButtonPress(Button: Longint;var x,y:Longint):Longint;
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $5,%eax
+ movl button,%ebx
+ shrl $1, %ebx {0 = left, 1 = right, 2 = middle}
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ andl $0xffff,%ebx
+ andl $0xffff,%edx
+ andl $0xffff,%ecx
+ movl %ebx, __RESULT
+ movl x,%eax
+ movl %ecx,(%eax)
+ movl y,%eax
+ movl %edx,(%eax)
+ end;
+end;
+
+Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
+begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $6,%eax
+ movl button,%ebx
+ shrl $1, %ebx {0 = left, 1 = right, 2 = middle}
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ andl $0xffff,%ebx
+ andl $0xffff,%ecx
+ andl $0xffff,%edx
+ movl %ebx,__RESULT
+ movl x,%eax
+ movl %ecx,(%eax)
+ movl y,%eax
+ movl %edx,(%eax)
+ end;
+end;
+
+Procedure SetMouseXRange (Min,Max:Longint);
+begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $7,%eax
+ movl min,%ecx
+ movl max,%edx
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+end;
+
+Procedure SetMouseYRange (min,max:Longint);
+begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $8,%eax
+ movl min,%ecx
+ movl max,%edx
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+end;
+
+Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
+Begin
+ If (Not MouseFound) Then Exit;
+ SetMouseXRange(x1,x2);
+ SetMouseYRange(y1,y2);
+End;
+
+Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ xorl %ebx,%ebx
+ movl $0xa,%eax
+ movl $0xffff,%ecx
+ xorl %edx,%edx
+ movb BackColor,%dh
+ shlb $4,%dh
+ addb ForeColor,%dh
+ movb Ascii,%dl
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ End;
+End;
+
+Procedure SetMouseAscii(Ascii:byte);
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ xorl %ebx,%ebx
+ movl $0xa,%eax
+ movl $0xff00,%ecx
+ xorl %edx,%edx
+ movb Ascii,%dl
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ End;
+End;
+
+Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $0x0010,%eax
+ movl x1,%ecx
+ movl y1,%edx
+ movl x2,%esi
+ movl y2,%edi
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+End;
+
+Procedure SetMouseSpeed(Horizontal,Vertical:Longint);
+Begin
+ If (Not MouseFound) Then Exit;
+ asm
+ movl $0x0f,%eax
+ movl Horizontal,%ecx
+ movl Vertical,%edx
+ pushl %ebp
+ int $0x33
+ popl %ebp
+ end;
+End;
+
+Begin
+ MouseFound := InitMouse;
+End.
+{
+ $Log: msmouse.pp,v $
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.6 2005/02/07 17:28:09 peter
+ moved $calling to interface
+
+}
diff --git a/rtl/go32v2/ports.pp b/rtl/go32v2/ports.pp
new file mode 100644
index 0000000000..3f7cf62571
--- /dev/null
+++ b/rtl/go32v2/ports.pp
@@ -0,0 +1,110 @@
+{
+ $Id: ports.pp,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ and implements some stuff for protected mode programming
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ These files adds support for TP styled port accesses
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit ports;
+
+{ this unit uses classes so
+ ObjFpc mode is required PM }
+{$Mode ObjFpc}
+{$Calling StdCall}
+
+interface
+
+type
+ tport = class
+ procedure writeport(p : word;data : byte);
+ function readport(p : word) : byte;
+ property pp[w : word] : byte read readport write writeport;default;
+ end;
+
+ tportw = class
+ procedure writeport(p : word;data : word);
+ function readport(p : word) : word;
+ property pp[w : word] : word read readport write writeport;default;
+ end;
+
+ tportl = class
+ procedure writeport(p : word;data : longint);
+ function readport(p : word) : longint;
+ property pp[w : word] : longint read readport write writeport;default;
+ end;
+var
+{ we don't need to initialize port, because neither member
+ variables nor virtual methods are accessed }
+ port,
+ portb : tport;
+ portw : tportw;
+ portl : tportl;
+
+ implementation
+
+{$asmmode ATT}
+
+{ to give easy port access like tp with port[] }
+
+procedure tport.writeport(p : word;data : byte);assembler;
+asm
+ movw p,%dx
+ movb data,%al
+ outb %al,%dx
+end ['EAX','EDX'];
+
+
+function tport.readport(p : word) : byte;assembler;
+asm
+ movw p,%dx
+ inb %dx,%al
+end ['EAX','EDX'];
+
+
+procedure tportw.writeport(p : word;data : word);assembler;
+asm
+ movw p,%dx
+ movw data,%ax
+ outw %ax,%dx
+end ['EAX','EDX'];
+
+
+function tportw.readport(p : word) : word;assembler;
+asm
+ movw p,%dx
+ inw %dx,%ax
+end ['EAX','EDX'];
+
+
+procedure tportl.writeport(p : word;data : longint);assembler;
+asm
+ movw p,%dx
+ movl data,%eax
+ outl %eax,%dx
+end ['EAX','EDX'];
+
+
+function tportl.readport(p : word) : longint;assembler;
+asm
+ movw p,%dx
+ inl %dx,%eax
+end ['EAX','EDX'];
+
+end.
+
+{
+ $Log: ports.pp,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/printer.pp b/rtl/go32v2/printer.pp
new file mode 100644
index 0000000000..04927ce7dc
--- /dev/null
+++ b/rtl/go32v2/printer.pp
@@ -0,0 +1,36 @@
+{
+ $Id: printer.pp,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Printer unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit printer;
+
+interface
+
+{$I printerh.inc}
+
+implementation
+
+{$I printer.inc}
+
+begin
+ InitPrinter ('PRN');
+ SetPrinterExit;
+end.
+{
+ $Log: printer.pp,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/profile.pp b/rtl/go32v2/profile.pp
new file mode 100644
index 0000000000..a03cf4adc7
--- /dev/null
+++ b/rtl/go32v2/profile.pp
@@ -0,0 +1,334 @@
+{
+ $Id: profile.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller,
+ member of the Free Pascal development team.
+
+ Profiling support for Go32V2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+{$S- do not use stackcheck here .. PM }
+{$ifdef FPC_PROFILE}
+{$error }
+{$message you can not compile profile unit with profiling}
+{$endif FPC_PROFILE}
+
+Unit profile;
+
+interface
+
+type
+ header = record
+ low,high,nbytes : longint;
+ end;
+
+{ entry of a GPROF type file }
+ ppMTABE = ^pMTABE;
+ pMTABE = ^MTABE;
+ MTABE = record
+ from,_to,count : longint;
+ end;
+
+{ internal form - sizeof(MTAB) is 4096 for efficiency }
+ PMTAB = ^M_TAB;
+ M_TAB = record
+ calls : array [0..340] of MTABE;
+ prev : PMTAB;
+ end;
+
+const
+ mcount_skip : longint = 1;
+ mtab : PMTAB = nil;
+var
+ h : header;
+ histogram : ^integer;
+ histlen : longint;
+ oldexitproc : pointer;
+
+{ called by functions. Use the pointer it provides to cache the last used
+ MTABE, so that repeated calls to/from the same pair works quickly -
+ no lookup. }
+procedure mcount;
+
+implementation
+
+{$asmmode ATT}
+
+uses
+ go32,dpmiexcp;
+
+type
+ plongint = ^longint;
+const
+ cache : pMTABE = nil;
+
+var
+ djgpp_old_timer : tseginfo;external name '___djgpp_old_timer';
+ start : longint;external name 'start';
+ _etext : longint;external name '_etext';
+ starttext : longint;
+ endtext : longint;
+
+procedure djgpp_timer_hdlr;external name '___djgpp_timer_hdlr';
+
+procedure sbrk_getmem(var p : pointer;size : longint);
+
+ begin
+ system.getmem(p,size);
+ end;
+
+
+{ problem how to avoid mcount calling itself !! }
+procedure mcount; [public, alias : 'MCOUNT'];
+{
+ ebp contains the frame of mcount (ebp) the frame of calling (to_)
+ ((ebp)) the frame of from
+}
+var
+ m : pmtab;
+ i,to_,ebp,from,mtabi : longint;
+begin
+ { optimisation !! }
+ asm
+ pushal
+ movl 4(%ebp),%eax
+ movl %eax,to_
+ movl (%ebp),%eax
+ movl 4(%eax),%eax
+ movl %eax,from
+ end;
+ if endtext=0 then
+ asm
+ popal
+ leave
+ ret
+ end;
+ mcount_skip := 1;
+ if (to_ > endtext) or (from > endtext) then
+ runerror(255);
+ if ((cache<>nil) and (cache^.from=from) and (cache^._to=to_)) then
+ begin
+ { cache paid off - works quickly }
+ inc(cache^.count);
+ mcount_skip:=0;
+ asm
+ popal
+ leave
+ ret
+ end;
+ end;
+{ no cache hit - search all mtab tables for a match, or an empty slot }
+ mtabi := -1;
+ m:=mtab;
+ while m<>nil do
+ begin
+ for i:=0 to 340 do
+ begin
+ if m^.calls[i].from=0 then
+ begin
+ { empty slot - end of table }
+ mtabi := i;
+ break;
+ end;
+ if ((m^.calls[i].from = from) and (m^.calls[i]._to = to_)) then
+ begin
+ { found a match - bump count and return }
+ inc(m^.calls[i].count);
+ cache:=@(m^.calls[i]);
+ mcount_skip:=0;
+ asm
+ popal
+ leave
+ ret
+ end;
+ end;
+ end;
+ m:=m^.prev;
+ end;
+ if (mtabi<>-1) then
+ begin
+ { found an empty - fill it in }
+ mtab^.calls[mtabi].from := from;
+ mtab^.calls[mtabi]._to := to_;
+ mtab^.calls[mtabi].count := 1;
+ cache := @(mtab^.calls[mtabi]);
+ mcount_skip := 0;
+ asm
+ popal
+ leave
+ ret
+ end;
+ end;
+{ lob off another page of memory and initialize the new table }
+ { problem here : getmem is not reentrant yet !! PM }
+ { lets hope that a direct call to sbrk correct this }
+ sbrk_getmem(m,sizeof(M_TAB));
+ fillchar(m^, sizeof(M_TAB),#0);
+ m^.prev := mtab;
+ mtab := m;
+ m^.calls[0].from := from;
+ m^.calls[0]._to := to_;
+ m^.calls[0].count := 1;
+ cache := @(m^.calls[0]);
+ mcount_skip := 0;
+ asm
+ popal
+ leave
+ ret
+ end;
+end;
+
+
+var
+ new_timer,
+ old_timer : tseginfo;
+ invalid_mcount_call,
+ mcount_nb,
+ doublecall,
+ reload : longint; {=0}
+
+function mcount_tick(x : longint) : longint;
+var
+ bin : longint;
+begin
+ if mcount_skip=0 then
+ begin
+ bin := djgpp_exception_state^.__eip;
+ if (djgpp_exception_state^.__cs=get_cs) and (bin >= starttext) and (bin <= endtext) then
+ begin
+ bin := (bin - starttext) div 16;
+ inc(histogram[bin]);
+ end
+ else
+ inc(invalid_mcount_call);
+ inc(mcount_nb);
+ end
+ else
+ inc(doublecall);
+ mcount_tick:=0;
+end;
+
+
+var
+ ___djgpp_timer_countdown:longint;external name '___djgpp_timer_countdown';
+
+function timer(x : longint) : longint;
+begin
+ if reload>0 then
+ ___djgpp_timer_countdown:=RELOAD;
+ timer:=mcount_tick(x);
+ { _raise(SIGPROF); }
+end;
+
+
+procedure mcount_write;
+{
+ this is called during program exit
+}
+var
+ m : PMTAB;
+ i : longint;
+ f : file;
+begin
+ mcount_skip:=1;
+ signal(SIGTIMR,@SIG_IGN);
+ signal(SIGPROF,@SIG_IGN);
+ set_pm_interrupt($8,old_timer);
+ reload:=0;
+ exitproc:=oldexitproc;
+ writeln(stderr,'Writing profile output');
+ writeln(stderr,'histogram length = ',histlen);
+ writeln(stderr,'Nb of double calls = ',doublecall);
+ if invalid_mcount_call>0 then
+ writeln(stderr,'nb of invalid mcount : ',invalid_mcount_call,'/',mcount_nb)
+ else
+ writeln(stderr,'nb of mcount : ',mcount_nb);
+ assign(f,'gmon.out');
+ rewrite(f,1);
+ blockwrite(f, h, sizeof(header));
+ blockwrite(f, histogram^, histlen);
+ m:=mtab;
+ while m<>nil do
+ begin
+ for i:=0 to 340 do
+ begin
+ if (m^.calls[i].from = 0) then
+ break;
+ blockwrite(f, m^.calls[i],sizeof(MTABE));
+{$ifdef DEBUG}
+ if m^.calls[i].count>0 then
+ writeln(stderr,' 0x',hexstr(m^.calls[i]._to,8),' called from ',hexstr(m^.calls[i].from,8),
+ ' ',m^.calls[i].count,' times');
+{$endif DEBUG}
+ end;
+ m:=m^.prev;
+ end;
+ close(f);
+end;
+
+
+procedure mcount_init;
+{
+ this is called to initialize profiling before the program starts
+}
+
+ procedure set_old_timer_handler;
+ begin
+ djgpp_old_timer:=Old_Timer;
+ end;
+
+begin
+ starttext:=longint(@start);
+ endtext:=longint(@_etext);
+ h.low := starttext;
+ h.high := endtext;
+ histlen := ((h.high-h.low) div 16) * 2; { must be even }
+ h.nbytes := sizeof(header) + histlen;
+ getmem(histogram,histlen);
+ fillchar(histogram^, histlen,#0);
+
+ oldexitproc:=exitproc;
+ exitproc:=@mcount_write;
+
+{ here, do whatever it takes to initialize the timer interrupt }
+ signal(SIGPROF,@mcount_tick);
+ signal(SIGTIMR,@timer);
+
+ get_pm_interrupt($8,old_timer);
+ set_old_timer_handler;
+{$ifdef DEBUG}
+ writeln(stderr,'ori pm int8 '+hexstr(old_timer.segment,4)+':'+hexstr(longint(old_timer.offset),8));
+ flush(stderr);
+{$endif DEBUG}
+ new_timer.segment:=get_cs;
+ new_timer.offset:=@djgpp_timer_hdlr;
+ reload:=3;
+{$ifdef DEBUG}
+ writeln(stderr,'new pm int8 '+hexstr(new_timer.segment,4)+':'+hexstr(longint(new_timer.offset),8));
+ flush(stderr);
+{$endif DEBUG}
+ set_pm_interrupt($8,new_timer);
+ reload:=1;
+ ___djgpp_timer_countdown:=RELOAD;
+ mcount_skip := 0;
+end;
+
+
+begin
+ mcount_init;
+end.
+{
+ $Log: profile.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/sbrk16.ah b/rtl/go32v2/sbrk16.ah
new file mode 100644
index 0000000000..8af7e82b11
--- /dev/null
+++ b/rtl/go32v2/sbrk16.ah
@@ -0,0 +1,7 @@
+ .byte 0x12,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x02,0x00,0x00,0x00,0x00,0x00,0x00
+ .byte 0x00,0x00,0x8c,0xd8,0x2e,0x8e,0x1e,0x06,0x00,0xa3,0x10,0x00,0x8c,0x16,0x0a,0x00
+ .byte 0x66,0x89,0x26,0x0c,0x00,0x8e,0x16,0x06,0x00,0x66,0xbc,0x70,0x02,0x00,0x00,0xb8
+ .byte 0x03,0x05,0xcd,0x31,0x72,0x24,0x89,0xca,0x89,0xd9,0x8b,0x1e,0x02,0x00,0xb8,0x07
+ .byte 0x00,0xcd,0x31,0x8b,0x1e,0x04,0x00,0xb8,0x07,0x00,0xcd,0x31,0x06,0x07,0x0f,0xa0
+ .byte 0x0f,0xa1,0x0f,0xa8,0x0f,0xa9,0x89,0xcb,0x89,0xd1,0x8e,0x16,0x0a,0x00,0x66,0x8b
+ .byte 0x26,0x0c,0x00,0x8e,0x1e,0x10,0x00,0x66,0xcb,0x90,0x90,0x90
diff --git a/rtl/go32v2/sbrk16.asm b/rtl/go32v2/sbrk16.asm
new file mode 100644
index 0000000000..f0084edfba
--- /dev/null
+++ b/rtl/go32v2/sbrk16.asm
@@ -0,0 +1,7 @@
+; Copyright (C) 1994 DJ Delorie, see COPYING.DJ for details
+;
+; $Id: sbrk16.asm,v 1.2 2002/09/07 16:01:19 peter Exp $
+; $Log: sbrk16.asm,v $
+; Revision 1.2 2002/09/07 16:01:19 peter
+; * old logs removed and tabs fixed
+;
diff --git a/rtl/go32v2/sysdir.inc b/rtl/go32v2/sysdir.inc
new file mode 100644
index 0000000000..e25a30d555
--- /dev/null
+++ b/rtl/go32v2/sysdir.inc
@@ -0,0 +1,160 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+procedure DosDir(func:byte;const s:string);
+var
+ buffer : array[0..255] of char;
+ regs : trealregs;
+begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ AllowSlash(pchar(@buffer));
+ { True DOS does not like backslashes at end
+ Win95 DOS accepts this !!
+ but "\" and "c:\" should still be kept and accepted hopefully PM }
+ if (length(s)>0) and (buffer[length(s)-1]='\') and
+ Not ((length(s)=1) or ((length(s)=3) and (s[2]=':'))) then
+ buffer[length(s)-1]:=#0;
+ syscopytodos(longint(@buffer),length(s)+1);
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7100+func
+ else
+ regs.realeax:=func shl 8;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+procedure mkdir(const s : string);[IOCheck];
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ DosDir($39,s);
+end;
+
+
+procedure rmdir(const s : string);[IOCheck];
+begin
+ if (s = '.' ) then
+ InOutRes := 16;
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ DosDir($3a,s);
+end;
+
+
+procedure chdir(const s : string);[IOCheck];
+var
+ regs : trealregs;
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+{ First handle Drive changes }
+ if (length(s)>=2) and (s[2]=':') then
+ begin
+ regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
+ regs.realeax:=$0e00;
+ sysrealintr($21,regs);
+ regs.realeax:=$1900;
+ sysrealintr($21,regs);
+ if byte(regs.realeax)<>byte(regs.realedx) then
+ begin
+ Inoutres:=15;
+ exit;
+ end;
+ { DosDir($3b,'c:') give Path not found error on
+ pure DOS PM }
+ if length(s)=2 then
+ exit;
+ end;
+{ do the normal dos chdir }
+ DosDir($3b,s);
+end;
+
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+var
+ temp : array[0..255] of char;
+ i : longint;
+ regs : trealregs;
+begin
+ regs.realedx:=drivenr;
+ regs.realesi:=tb_offset;
+ regs.realds:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7147
+ else
+ regs.realeax:=$4700;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ Begin
+ GetInOutRes (lo(regs.realeax));
+ Dir := char (DriveNr + 64) + ':\';
+ exit;
+ end
+ else
+ syscopyfromdos(longint(@temp),251);
+{ conversion to Pascal string including slash conversion }
+ i:=0;
+ while (temp[i]<>#0) do
+ begin
+ if temp[i]='/' then
+ temp[i]:='\';
+ dir[i+4]:=temp[i];
+ inc(i);
+ end;
+ dir[2]:=':';
+ dir[3]:='\';
+ dir[0]:=char(i+3);
+{ upcase the string }
+ if not FileNameCaseSensitive then
+ dir:=upcase(dir);
+ if drivenr<>0 then { Drive was supplied. We know it }
+ dir[1]:=char(65+drivenr-1)
+ else
+ begin
+ { We need to get the current drive from DOS function 19H }
+ { because the drive was the default, which can be unknown }
+ regs.realeax:=$1900;
+ sysrealintr($21,regs);
+ i:= (regs.realeax and $ff) + ord('A');
+ dir[1]:=chr(i);
+ end;
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/go32v2/sysfile.inc b/rtl/go32v2/sysfile.inc
new file mode 100644
index 0000000000..ca9b66db98
--- /dev/null
+++ b/rtl/go32v2/sysfile.inc
@@ -0,0 +1,460 @@
+{
+ $Id: sysfile.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ { Keep Track of open files }
+ const
+ max_files = 50;
+ var
+ openfiles : array [0..max_files-1] of boolean;
+{$ifdef SYSTEMDEBUG}
+ opennames : array [0..max_files-1] of pchar;
+ const
+ free_closed_names : boolean = true;
+{$endif SYSTEMDEBUG}
+
+
+{****************************************************************************
+ Low level File Routines
+ ****************************************************************************}
+
+procedure AllowSlash(p:pchar);
+var
+ i : longint;
+begin
+{ allow slash as backslash }
+ for i:=0 to strlen(p) do
+ if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close(handle : thandle);
+var
+ regs : trealregs;
+begin
+ if Handle<=4 then
+ exit;
+ regs.realebx:=handle;
+ if handle<max_files then
+ begin
+ openfiles[handle]:=false;
+{$ifdef SYSTEMDEBUG}
+ if assigned(opennames[handle]) and free_closed_names then
+ begin
+ sysfreememsize(opennames[handle],strlen(opennames[handle])+1);
+ opennames[handle]:=nil;
+ end;
+{$endif SYSTEMDEBUG}
+ end;
+ regs.realeax:=$3e00;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+procedure do_erase(p : pchar);
+var
+ regs : trealregs;
+begin
+ AllowSlash(p);
+ syscopytodos(longint(p),strlen(p)+1);
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7141
+ else
+ regs.realeax:=$4100;
+ regs.realesi:=0;
+ regs.realecx:=0;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+var
+ regs : trealregs;
+begin
+ AllowSlash(p1);
+ AllowSlash(p2);
+ if strlen(p1)+strlen(p2)+3>tb_size then
+ HandleError(217);
+ sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
+ sysseg_move(get_ds,longint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1);
+ regs.realedi:=tb_offset;
+ regs.realedx:=tb_offset + strlen(p2)+2;
+ regs.realds:=tb_segment;
+ regs.reales:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7156
+ else
+ regs.realeax:=$5600;
+ regs.realecx:=$ff; { attribute problem here ! }
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+var
+ regs : trealregs;
+ size,
+ writesize : longint;
+begin
+ writesize:=0;
+ while len > 0 do
+ begin
+ if len>tb_size then
+ size:=tb_size
+ else
+ size:=len;
+ syscopytodos(ptrint(addr)+writesize,size);
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=h;
+ regs.realeax:=$4000;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ GetInOutRes(lo(regs.realeax));
+ exit(writesize);
+ end;
+ inc(writesize,lo(regs.realeax));
+ dec(len,lo(regs.realeax));
+ { stop when not the specified size is written }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ Do_Write:=WriteSize;
+end;
+
+
+function do_read(h:thandle;addr:pointer;len : longint) : longint;
+var
+ regs : trealregs;
+ size,
+ readsize : longint;
+begin
+ readsize:=0;
+ while len > 0 do
+ begin
+ if len>tb_size then
+ size:=tb_size
+ else
+ size:=len;
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=h;
+ regs.realeax:=$3f00;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ GetInOutRes(lo(regs.realeax));
+ do_read:=0;
+ exit;
+ end;
+ syscopyfromdos(ptrint(addr)+readsize,lo(regs.realeax));
+ inc(readsize,lo(regs.realeax));
+ dec(len,lo(regs.realeax));
+ { stop when not the specified size is read }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ do_read:=readsize;
+end;
+
+
+function do_filepos(handle : thandle) : longint;
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realecx:=0;
+ regs.realedx:=0;
+ regs.realeax:=$4201;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ Begin
+ GetInOutRes(lo(regs.realeax));
+ do_filepos:=0;
+ end
+ else
+ do_filepos:=lo(regs.realedx) shl 16+lo(regs.realeax);
+end;
+
+
+procedure do_seek(handle:thandle;pos : longint);
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realecx:=pos shr 16;
+ regs.realedx:=pos and $ffff;
+ regs.realeax:=$4200;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+
+function do_seekend(handle:thandle):longint;
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realecx:=0;
+ regs.realedx:=0;
+ regs.realeax:=$4202;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ Begin
+ GetInOutRes(lo(regs.realeax));
+ do_seekend:=0;
+ end
+ else
+ do_seekend:=lo(regs.realedx) shl 16+lo(regs.realeax);
+end;
+
+
+function do_filesize(handle : thandle) : longint;
+var
+ aktfilepos : longint;
+begin
+ aktfilepos:=do_filepos(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,aktfilepos);
+end;
+
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;pos:longint);
+var
+ regs : trealregs;
+begin
+ do_seek(handle,pos);
+ regs.realecx:=0;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=handle;
+ regs.realeax:=$4000;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+const
+ FileHandleCount : longint = 20;
+
+function Increase_file_handle_count : boolean;
+var
+ regs : trealregs;
+begin
+ Inc(FileHandleCount,10);
+ regs.realebx:=FileHandleCount;
+ regs.realeax:=$6700;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ Increase_file_handle_count:=false;
+ Dec (FileHandleCount, 10);
+ end
+ else
+ Increase_file_handle_count:=true;
+end;
+
+
+function dos_version : word;
+var
+ regs : trealregs;
+begin
+ regs.realeax := $3000;
+ sysrealintr($21,regs);
+ dos_version := regs.realeax
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+ regs : trealregs;
+ action : longint;
+begin
+ AllowSlash(p);
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file handle }
+ filerec(f).handle:=UnusedHandle;
+ action:=$1;
+{ convert filemode to filerec modes }
+ case (flags and 3) of
+ 0 : filerec(f).mode:=fminput;
+ 1 : filerec(f).mode:=fmoutput;
+ 2 : filerec(f).mode:=fminout;
+ end;
+ if (flags and $1000)<>0 then
+ action:=$12; {create file function}
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+{ real dos call }
+ syscopytodos(longint(p),strlen(p)+1);
+{$ifndef RTLLITE}
+ if LFNSupport then
+ begin
+ regs.realeax := $716c; { Use LFN Open/Create API }
+ regs.realedx := action; { action if file does/doesn't exist }
+ regs.realesi := tb_offset;
+ regs.realebx := $2000 + (flags and $ff); { file open mode }
+ end
+ else
+{$endif RTLLITE}
+ begin
+ if (action and $00f0) <> 0 then
+ regs.realeax := $3c00 { Map to Create/Replace API }
+ else
+ regs.realeax := $3d00 + (flags and $ff); { Map to Open_Existing API }
+ regs.realedx := tb_offset;
+ end;
+ regs.realds := tb_segment;
+ regs.realecx := $20; { file attributes }
+ sysrealintr($21,regs);
+{$ifndef RTLLITE}
+ if (regs.realflags and carryflag) <> 0 then
+ if lo(regs.realeax)=4 then
+ if Increase_file_handle_count then
+ begin
+ { Try again }
+ if LFNSupport then
+ begin
+ regs.realeax := $716c; {Use LFN Open/Create API}
+ regs.realedx := action; {action if file does/doesn't exist}
+ regs.realesi := tb_offset;
+ regs.realebx := $2000 + (flags and $ff); {file open mode}
+ end
+ else
+ begin
+ if (action and $00f0) <> 0 then
+ regs.realeax := $3c00 {Map to Create/Replace API}
+ else
+ regs.realeax := $3d00 + (flags and $ff); {Map to Open API}
+ regs.realedx := tb_offset;
+ end;
+ regs.realds := tb_segment;
+ regs.realecx := $20; {file attributes}
+ sysrealintr($21,regs);
+ end;
+{$endif RTLLITE}
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ GetInOutRes(lo(regs.realeax));
+ exit;
+ end
+ else
+ begin
+ filerec(f).handle:=lo(regs.realeax);
+{$ifndef RTLLITE}
+ { for systems that have more then 20 by default ! }
+ if lo(regs.realeax)>FileHandleCount then
+ FileHandleCount:=lo(regs.realeax);
+{$endif RTLLITE}
+ end;
+ if lo(regs.realeax)<max_files then
+ begin
+{$ifdef SYSTEMDEBUG}
+ if openfiles[lo(regs.realeax)] and
+ assigned(opennames[lo(regs.realeax)]) then
+ begin
+ Writeln(stderr,'file ',opennames[lo(regs.realeax)],'(',lo(regs.realeax),') not closed but handle reused!');
+ sysfreememsize(opennames[lo(regs.realeax)],strlen(opennames[lo(regs.realeax)])+1);
+ end;
+{$endif SYSTEMDEBUG}
+ openfiles[lo(regs.realeax)]:=true;
+{$ifdef SYSTEMDEBUG}
+ opennames[lo(regs.realeax)] := sysgetmem(strlen(p)+1);
+ move(p^,opennames[lo(regs.realeax)]^,strlen(p)+1);
+{$endif SYSTEMDEBUG}
+ end;
+{ append mode }
+ if ((flags and $100) <> 0) and
+ (FileRec (F).Handle <> UnusedHandle) then
+ begin
+ do_seekend(filerec(f).handle);
+ filerec(f).mode:=fmoutput; {fool fmappend}
+ end;
+end;
+
+
+function do_isdevice(handle:THandle):boolean;
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realeax:=$4400;
+ sysrealintr($21,regs);
+ do_isdevice:=(regs.realedx and $80)<>0;
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/go32v2/sysheap.inc b/rtl/go32v2/sysheap.inc
new file mode 100644
index 0000000000..b2b71cd94f
--- /dev/null
+++ b/rtl/go32v2/sysheap.inc
@@ -0,0 +1,70 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Heap Management
+*****************************************************************************}
+
+function __sbrk(size:longint):longint;cdecl;external;
+
+function SysOSAlloc (size: PtrInt): pointer; assembler;
+asm
+{$ifdef SYSTEMDEBUG}
+ cmpb $1,accept_sbrk
+ je .Lsbrk
+ movl $0,%eax
+ jmp .Lsbrk_fail
+ .Lsbrk:
+{$endif}
+ movl size,%eax
+ pushl %eax
+ call __sbrk
+ addl $4,%esp
+{$ifdef SYSTEMDEBUG}
+ .Lsbrk_fail:
+{$endif}
+end;
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+{function SysOSAlloc(size: ptrint): pointer;
+begin
+ result := sbrk(size);
+end;
+}
+{.$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+end;
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/go32v2/sysos.inc b/rtl/go32v2/sysos.inc
new file mode 100644
index 0000000000..687a90565d
--- /dev/null
+++ b/rtl/go32v2/sysos.inc
@@ -0,0 +1,341 @@
+{
+ $Id: sysos.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ carryflag = 1;
+
+type
+ tseginfo=packed record
+ offset : pointer;
+ segment : word;
+ end;
+
+var
+ old_int00 : tseginfo;cvar;
+ old_int75 : tseginfo;cvar;
+
+{$asmmode ATT}
+
+{*****************************************************************************
+ Go32 Helpers
+*****************************************************************************}
+
+function far_strlen(selector : word;linear_address : longint) : longint;assembler;
+asm
+ movl linear_address,%edx
+ movl %edx,%ecx
+ movw selector,%gs
+.Larg19:
+ movb %gs:(%edx),%al
+ testb %al,%al
+ je .Larg20
+ incl %edx
+ jmp .Larg19
+.Larg20:
+ movl %edx,%eax
+ subl %ecx,%eax
+end;
+
+
+function tb : longint;
+begin
+ tb:=go32_info_block.linear_address_of_transfer_buffer;
+end;
+
+
+function tb_segment : longint;
+begin
+ tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
+end;
+
+
+function tb_offset : longint;
+begin
+ tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
+end;
+
+
+function tb_size : longint;
+begin
+ tb_size:=go32_info_block.size_of_transfer_buffer;
+end;
+
+
+function dos_selector : word;
+begin
+ dos_selector:=go32_info_block.selector_for_linear_memory;
+end;
+
+
+function get_ds : word;assembler;
+asm
+ movw %ds,%ax
+end;
+
+
+function get_cs : word;assembler;
+asm
+ movw %cs,%ax
+end;
+
+
+procedure sysseg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+begin
+ if count=0 then
+ exit;
+ if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
+ asm
+ pushl %esi
+ pushl %edi
+ pushw %es
+ pushw %ds
+ cld
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ movl %ecx,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+ movl %eax,%ecx
+ andl $3,%ecx
+ rep
+ movsb
+ popw %ds
+ popw %es
+ popl %edi
+ popl %esi
+ end
+ else if (source<dest) then
+ { copy backward for overlapping }
+ asm
+ pushl %esi
+ pushl %edi
+ pushw %es
+ pushw %ds
+ std
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ addl %ecx,%esi
+ addl %ecx,%edi
+ movl %ecx,%eax
+ andl $3,%ecx
+ orl %ecx,%ecx
+ jz .LSEG_MOVE1
+
+ { calculate esi and edi}
+ decl %esi
+ decl %edi
+ rep
+ movsb
+ incl %esi
+ incl %edi
+ .LSEG_MOVE1:
+ subl $4,%esi
+ subl $4,%edi
+ movl %eax,%ecx
+ shrl $2,%ecx
+ rep
+ movsl
+ cld
+ popw %ds
+ popw %es
+ popl %edi
+ popl %esi
+ end;
+end;
+
+
+function strcopy(dest,source : pchar) : pchar;assembler;
+var
+ saveeax,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,%edi
+{$else}
+ movl source,%edi
+{$endif}
+ testl %edi,%edi
+ jz .LStrCopyDone
+ leal 3(%edi),%ecx
+ andl $-4,%ecx
+ movl %edi,%esi
+ subl %edi,%ecx
+{$ifdef REGCALL}
+ movl %eax,%edi
+{$else}
+ movl dest,%edi
+{$endif}
+ jz .LStrCopyAligned
+.LStrCopyAlignLoop:
+ movb (%esi),%al
+ incl %edi
+ incl %esi
+ testb %al,%al
+ movb %al,-1(%edi)
+ jz .LStrCopyDone
+ decl %ecx
+ jnz .LStrCopyAlignLoop
+ .balign 16
+.LStrCopyAligned:
+ movl (%esi),%eax
+ movl %eax,%edx
+ leal 0x0fefefeff(%eax),%ecx
+ notl %edx
+ addl $4,%esi
+ andl %edx,%ecx
+ andl $0x080808080,%ecx
+ jnz .LStrCopyEndFound
+ movl %eax,(%edi)
+ addl $4,%edi
+ jmp .LStrCopyAligned
+.LStrCopyEndFound:
+ testl $0x0ff,%eax
+ jz .LStrCopyByte
+ testl $0x0ff00,%eax
+ jz .LStrCopyWord
+ testl $0x0ff0000,%eax
+ jz .LStrCopy3Bytes
+ movl %eax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopy3Bytes:
+ xorb %dl,%dl
+ movw %ax,(%edi)
+ movb %dl,2(%edi)
+ jmp .LStrCopyDone
+.LStrCopyWord:
+ movw %ax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopyByte:
+ movb %al,(%edi)
+.LStrCopyDone:
+{$ifdef REGCALL}
+ movl saveeax,%eax
+{$else}
+ movl dest,%eax
+{$endif}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+procedure syscopytodos(addr : longint; len : longint);
+begin
+ if len > tb_size then
+ HandleError(217);
+ sysseg_move(get_ds,addr,dos_selector,tb,len);
+end;
+
+
+procedure syscopyfromdos(addr : longint; len : longint);
+begin
+ if len > tb_size then
+ HandleError(217);
+ sysseg_move(dos_selector,tb,get_ds,addr,len);
+end;
+
+
+procedure sysrealintr(intnr : word;var regs : trealregs);
+begin
+ regs.realsp:=0;
+ regs.realss:=0;
+ asm
+ pushl %ebx
+ pushl %edi
+ movw intnr,%bx
+ xorl %ecx,%ecx
+ movl regs,%edi
+ movw $0x300,%ax
+ int $0x31
+ popl %edi
+ popl %ebx
+ end;
+end;
+
+
+procedure set_pm_interrupt(vector : byte;const intaddr : tseginfo);
+begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x205,%eax
+ movb vector,%bl
+ int $0x31
+ popl %ebx
+ end;
+end;
+
+
+procedure get_pm_interrupt(vector : byte;var intaddr : tseginfo);
+begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x204,%eax
+ int $0x31
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+end;
+
+
+procedure getinoutres(def : word);
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$5900;
+ regs.realebx:=$0;
+ sysrealintr($21,regs);
+ InOutRes:=lo(regs.realeax);
+ case InOutRes of
+ 19 : InOutRes:=150;
+ 21 : InOutRes:=152;
+ 32 : InOutRes:=5;
+ end;
+ if InOutRes=0 then
+ InOutRes:=Def;
+end;
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/go32v2/sysosh.inc b/rtl/go32v2/sysosh.inc
new file mode 100644
index 0000000000..0d78235e7f
--- /dev/null
+++ b/rtl/go32v2/sysosh.inc
@@ -0,0 +1,43 @@
+{
+ $Id: sysosh.inc,v 1.2 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+ THandle = Longint;
+ TThreadID = THandle;
+
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = record
+ Locked: boolean
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/go32v2/system.pp b/rtl/go32v2/system.pp
new file mode 100644
index 0000000000..3105694ad1
--- /dev/null
+++ b/rtl/go32v2/system.pp
@@ -0,0 +1,679 @@
+{
+ $Id: system.pp,v 1.52 2005/05/05 11:40:23 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit system;
+
+interface
+
+{ two debug conditionnals can be used
+ - SYSTEMDEBUG
+ -for STACK checks
+ -for non closed files at exit (or at any time with GDB)
+ - SYSTEM_DEBUG_STARTUP
+ specifically for
+ - proxy command line (DJGPP feature)
+ - list of args
+ - list of env variables (PM) }
+
+{$ifndef NO_EXCEPTIONS_IN_SYSTEM}
+{$define EXCEPTIONS_IN_SYSTEM}
+{$endif NO_EXCEPTIONS_IN_SYSTEM}
+
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+
+const
+ LineEnding = #13#10;
+{ LFNSupport is a variable here, defined below!!! }
+ DirectorySeparator = '\';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 255;
+
+
+const
+{ Default filehandles }
+ UnusedHandle = -1;
+ StdInputHandle = 0;
+ StdOutputHandle = 1;
+ StdErrorHandle = 2;
+
+ FileNameCaseSensitive : boolean = false;
+ CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+{ Default memory segments (Tp7 compatibility) }
+ seg0040 = $0040;
+ segA000 = $A000;
+ segB000 = $B000;
+ segB800 = $B800;
+
+var
+{ Mem[] support }
+ mem : array[0..$7fffffff-1] of byte absolute $0:$0;
+ memw : array[0..($7fffffff div sizeof(word))-1] of word absolute $0:$0;
+ meml : array[0..($7fffffff div sizeof(longint))-1] of longint absolute $0:$0;
+{ C-compatible arguments and environment }
+ argc : longint;
+ argv : ppchar;
+ envp : ppchar;
+ dos_argv0 : pchar;
+
+{$ifndef RTLLITE}
+{ System info }
+ LFNSupport : boolean;
+{$ELSE RTLLITE}
+const
+ LFNSupport = false;
+{$endif RTLLITE}
+
+type
+{ Dos Extender info }
+ p_stub_info = ^t_stub_info;
+ t_stub_info = packed record
+ magic : array[0..15] of char;
+ size : longint;
+ minstack : longint;
+ memory_handle : longint;
+ initial_size : longint;
+ minkeep : word;
+ ds_selector : word;
+ ds_segment : word;
+ psp_selector : word;
+ cs_selector : word;
+ env_size : word;
+ basename : array[0..7] of char;
+ argv0 : array [0..15] of char;
+ dpmi_server : array [0..15] of char;
+ end;
+
+ p_go32_info_block = ^t_go32_info_block;
+ t_go32_info_block = packed record
+ size_of_this_structure_in_bytes : longint; {offset 0}
+ linear_address_of_primary_screen : longint; {offset 4}
+ linear_address_of_secondary_screen : longint; {offset 8}
+ linear_address_of_transfer_buffer : longint; {offset 12}
+ size_of_transfer_buffer : longint; {offset 16}
+ pid : longint; {offset 20}
+ master_interrupt_controller_base : byte; {offset 24}
+ slave_interrupt_controller_base : byte; {offset 25}
+ selector_for_linear_memory : word; {offset 26}
+ linear_address_of_stub_info_structure : longint; {offset 28}
+ linear_address_of_original_psp : longint; {offset 32}
+ run_mode : word; {offset 36}
+ run_mode_info : word; {offset 38}
+ end;
+
+var
+ stub_info : p_stub_info;
+ go32_info_block : t_go32_info_block;
+{$ifdef SYSTEMDEBUG}
+const
+ accept_sbrk : boolean = true;
+{$endif}
+
+{
+ necessary for objects.pas, should be removed (at least from the interface
+ to the implementation)
+}
+ type
+ trealregs=record
+ realedi,realesi,realebp,realres,
+ realebx,realedx,realecx,realeax : longint;
+ realflags,
+ reales,realds,realfs,realgs,
+ realip,realcs,realsp,realss : word;
+ end;
+ function do_write(h:longint;addr:pointer;len : longint) : longint;
+ function do_read(h:longint;addr:pointer;len : longint) : longint;
+ procedure syscopyfromdos(addr : longint; len : longint);
+ procedure syscopytodos(addr : longint; len : longint);
+ procedure sysrealintr(intnr : word;var regs : trealregs);
+ function tb : longint;
+
+implementation
+
+{ include system independent routines }
+
+{$I system.inc}
+
+
+var
+ _args : ppchar;external name '_args';
+ __stubinfo : p_stub_info;external name '__stubinfo';
+ ___dos_argv0 : pchar;external name '___dos_argv0';
+
+
+procedure setup_arguments;
+type
+ arrayword = array [0..255] of word;
+var
+ psp : word;
+ proxy_s : string[50];
+ proxy_argc,proxy_seg,proxy_ofs,lin : longint;
+ rm_argv : ^arrayword;
+ argv0len : longint;
+ useproxy : boolean;
+ hp : ppchar;
+ doscmd : string[129]; { Dos commandline copied from PSP, max is 128 chars +1 for terminating zero }
+ arglen,
+ count : longint;
+ argstart,
+ pc,arg : pchar;
+ quote : char;
+ argvlen : longint;
+
+ function atohex(s : pchar) : longint;
+ var
+ rv : longint;
+ v : byte;
+ begin
+ rv:=0;
+ while (s^<>#0) do
+ begin
+ v:=byte(s^)-byte('0');
+ if (v > 9) then
+ dec(v,7);
+ v:=v and 15; { in case it's lower case }
+ rv:=(rv shl 4) or v;
+ inc(longint(s));
+ end;
+ atohex:=rv;
+ end;
+
+ procedure allocarg(idx,len:longint);
+ var
+ oldargvlen : longint;
+ begin
+ if idx>=argvlen then
+ begin
+ oldargvlen:=argvlen;
+ argvlen:=(idx+8) and (not 7);
+ sysreallocmem(argv,argvlen*sizeof(pointer));
+ fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
+ end;
+ { use realloc to reuse already existing memory }
+ { always allocate, even if length is zero, since }
+ { the arg. is still present! }
+ sysreallocmem(argv[idx],len+1);
+ end;
+
+begin
+ count:=0;
+ argc:=1;
+ argv:=nil;
+ argvlen:=0;
+ { load commandline from psp }
+ psp:=stub_info^.psp_selector;
+ sysseg_move(psp, 128, get_ds, longint(@doscmd), 128);
+ doscmd[length(doscmd)+1]:=#0;
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'Dos command line is #',doscmd,'# size = ',length(doscmd));
+{$EndIf }
+ { create argv[0] }
+ argv0len:=strlen(dos_argv0);
+ allocarg(count,argv0len);
+ move(dos_argv0^,argv[count]^,argv0len);
+ inc(count);
+ { setup cmdline variable }
+ cmdline:=Getmem(argv0len+length(doscmd)+2);
+ move(dos_argv0^,cmdline^,argv0len);
+ cmdline[argv0len]:=' ';
+ inc(argv0len);
+ move(doscmd[1],cmdline[argv0len],length(doscmd));
+ cmdline[argv0len+length(doscmd)+1]:=#0;
+ { parse dos commandline }
+ pc:=@doscmd[1];
+ while pc^<>#0 do
+ begin
+ { skip leading spaces }
+ while pc^ in [#1..#32] do
+ inc(pc);
+ if pc^=#0 then
+ break;
+ { calc argument length }
+ quote:=' ';
+ argstart:=pc;
+ arglen:=0;
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ inc(arglen)
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ else
+ inc(arglen);
+ end;
+ inc(pc);
+ end;
+ { copy argument }
+ allocarg(count,arglen);
+ quote:=' ';
+ pc:=argstart;
+ arg:=argv[count];
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ inc(pc);
+ end;
+ arg^:=#0;
+ {$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
+ {$EndIf SYSTEM_DEBUG_STARTUP}
+ inc(count);
+ end;
+ argc:=count;
+ { check for !proxy for long commandlines passed using environment }
+ hp:=envp;
+ useproxy:=false;
+ while assigned(hp^) do
+ begin
+ if (hp^[0]=' ') then
+ begin
+ proxy_s:=strpas(hp^);
+ if Copy(proxy_s,1,7)=' !proxy' then
+ begin
+ proxy_s[13]:=#0;
+ proxy_s[18]:=#0;
+ proxy_s[23]:=#0;
+ argv[2]:=@proxy_s[9];
+ argv[3]:=@proxy_s[14];
+ argv[4]:=@proxy_s[19];
+ useproxy:=true;
+ break;
+ end;
+ end;
+ inc(hp);
+ end;
+ { check for !proxy for long commandlines passed using commandline }
+ if (not useproxy) and
+ (argc > 1) and (far_strlen(get_ds,longint(argv[1])) = 6) then
+ begin
+ move(argv[1]^,proxy_s[1],6);
+ proxy_s[0] := #6;
+ if (proxy_s = '!proxy') then
+ useproxy:=true;
+ end;
+ { use proxy when found }
+ if useproxy then
+ begin
+ proxy_argc:=atohex(argv[2]);
+ proxy_seg:=atohex(argv[3]);
+ proxy_ofs:=atohex(argv[4]);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'proxy command line found');
+ writeln(stderr,'argc: ',proxy_argc,' seg: ',proxy_seg,' ofs: ',proxy_ofs);
+{$EndIf SYSTEM_DEBUG_STARTUP}
+ rm_argv:=SysGetmem(proxy_argc*sizeof(word));
+ sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
+ for count:=0 to proxy_argc - 1 do
+ begin
+ lin:=proxy_seg*16+rm_argv^[count];
+ arglen:=far_strlen(dos_selector,lin);
+ allocarg(count,arglen);
+ sysseg_move(dos_selector,lin,get_ds,longint(argv[count]),arglen+1);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'arg ',count,' #',rm_argv^[count],'#',arglen,'#',argv[count],'#');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+ end;
+ SysFreemem(rm_argv);
+ argc:=proxy_argc;
+ end;
+ { create an nil entry }
+ allocarg(argc,0);
+ { free unused memory }
+ sysreallocmem(argv,(argc+1)*sizeof(pointer));
+ _args:=argv;
+end;
+
+
+procedure setup_environment;
+var env_selector : word;
+ env_count : longint;
+ dos_env,cp : pchar;
+begin
+ stub_info:=__stubinfo;
+ dos_env := sysgetmem(stub_info^.env_size);
+ env_count:=0;
+ sysseg_move(stub_info^.psp_selector,$2c, get_ds, longint(@env_selector), 2);
+ sysseg_move(env_selector, 0, get_ds, longint(dos_env), stub_info^.env_size);
+ cp:=dos_env;
+ while cp ^ <> #0 do
+ begin
+ inc(env_count);
+ while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
+ inc(longint(cp)); { skip to next character }
+ end;
+ envp := sysgetmem((env_count+1) * sizeof(pchar));
+ if (envp = nil) then exit;
+ cp:=dos_env;
+ env_count:=0;
+ while cp^ <> #0 do
+ begin
+ envp[env_count] := sysgetmem(strlen(cp)+1);
+ strcopy(envp[env_count], cp);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+ inc(env_count);
+ while (cp^ <> #0) do
+ inc(longint(cp)); { skip to NUL }
+ inc(longint(cp)); { skip to next character }
+ end;
+ envp[env_count]:=nil;
+ longint(cp):=longint(cp)+3;
+ dos_argv0 := sysgetmem(strlen(cp)+1);
+ if (dos_argv0 = nil) then halt;
+ strcopy(dos_argv0, cp);
+ { update ___dos_argv0 also }
+ ___dos_argv0:=dos_argv0
+end;
+
+
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+procedure __exit(exitcode:longint);cdecl;external;
+
+Procedure system_exit;
+var
+ h : byte;
+begin
+ for h:=0 to max_files-1 do
+ if openfiles[h] then
+ begin
+{$ifdef SYSTEMDEBUG}
+ writeln(stderr,'file ',opennames[h],' not closed at exit');
+{$endif SYSTEMDEBUG}
+ if h>=5 then
+ do_close(h);
+ end;
+ { halt is not allways called !! }
+ { not on normal exit !! PM }
+ set_pm_interrupt($00,old_int00);
+{$ifndef EXCEPTIONS_IN_SYSTEM}
+ set_pm_interrupt($75,old_int75);
+{$endif EXCEPTIONS_IN_SYSTEM}
+ __exit(exitcode);
+end;
+
+
+procedure new_int00;
+begin
+ HandleError(200);
+end;
+
+
+{$ifndef EXCEPTIONS_IN_SYSTEM}
+procedure new_int75;
+begin
+ asm
+ xorl %eax,%eax
+ outb %al,$0x0f0
+ movb $0x20,%al
+ outb %al,$0x0a0
+ outb %al,$0x020
+ end;
+ HandleError(200);
+end;
+{$endif EXCEPTIONS_IN_SYSTEM}
+
+
+var
+ __stkbottom : pointer;external name '__stkbottom';
+
+
+
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+end;
+
+
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l+1<=argc) then
+ paramstr:=strpas(argv[l])
+ else
+ paramstr:='';
+end;
+
+
+procedure randomize;
+var
+ hl : longint;
+ regs : trealregs;
+begin
+ regs.realeax:=$2c00;
+ sysrealintr($21,regs);
+ hl:=lo(regs.realedx);
+ randseed:=hl*$10000+ lo(regs.realecx);
+end;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+function CheckLFN:boolean;
+var
+ regs : TRealRegs;
+ RootName : pchar;
+begin
+{ Check LFN API on drive c:\ }
+ RootName:='C:\';
+ syscopytodos(longint(RootName),strlen(RootName)+1);
+{ Call 'Get Volume Information' ($71A0) }
+ regs.realeax:=$71a0;
+ regs.reales:=tb_segment;
+ regs.realedi:=tb_offset;
+ regs.realecx:=32;
+ regs.realds:=tb_segment;
+ regs.realedx:=tb_offset;
+ regs.realflags:=carryflag;
+ sysrealintr($21,regs);
+{ If carryflag=0 and LFN API bit in ebx is set then use Long file names }
+ CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
+end;
+
+{$ifdef EXCEPTIONS_IN_SYSTEM}
+{$define IN_SYSTEM}
+{$i dpmiexcp.pp}
+{$endif EXCEPTIONS_IN_SYSTEM}
+
+procedure SysInitStdIO;
+begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := SizeUInt (Go32_info_block.pid);
+end;
+
+var
+ temp_int : tseginfo;
+Begin
+ StackLength := InitialStkLen;
+ StackBottom := __stkbottom;
+ { To be set if this is a GUI or console application }
+ IsConsole := TRUE;
+ { To be set if this is a library and not a program }
+ IsLibrary := FALSE;
+{ save old int 0 and 75 }
+ get_pm_interrupt($00,old_int00);
+ get_pm_interrupt($75,old_int75);
+ temp_int.segment:=get_cs;
+ temp_int.offset:=@new_int00;
+ set_pm_interrupt($00,temp_int);
+{$ifndef EXCEPTIONS_IN_SYSTEM}
+ temp_int.offset:=@new_int75;
+ set_pm_interrupt($75,temp_int);
+{$endif EXCEPTIONS_IN_SYSTEM}
+{ Setup heap }
+ InitHeap;
+ SysInitExceptions;
+{ Setup stdin, stdout and stderr }
+ SysInitStdIO;
+{ Setup environment and arguments }
+ Setup_Environment;
+ Setup_Arguments;
+{ Use LFNSupport LFN }
+ LFNSupport:=CheckLFN;
+ if LFNSupport then
+ FileNameCaseSensitive:=true;
+{ Reset IO Error }
+ InOutRes:=0;
+ InitSystemThreads;
+{$ifdef EXCEPTIONS_IN_SYSTEM}
+ InitDPMIExcp;
+ InstallDefaultHandlers;
+{$endif EXCEPTIONS_IN_SYSTEM}
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+{
+ $Log: system.pp,v $
+ Revision 1.52 2005/05/05 11:40:23 peter
+ Call InitSystemThreads
+
+ Revision 1.51 2005/05/01 13:00:53 peter
+ use fillchar after reallocmem, fix taken from win32
+
+ Revision 1.50 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.49 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.48 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.47 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/go32v2/systhrd.inc b/rtl/go32v2/systhrd.inc
new file mode 100644
index 0000000000..3538818902
--- /dev/null
+++ b/rtl/go32v2/systhrd.inc
@@ -0,0 +1,39 @@
+{
+ $Id: systhrd.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure InitSystemThreads;
+begin
+ { This should be changed to a real value during
+ thread driver initialization if appropriate. }
+ ThreadID := 1;
+ SetNoThreadManager;
+end;
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/go32v2/sysutils.pp b/rtl/go32v2/sysutils.pp
new file mode 100644
index 0000000000..5ba383a122
--- /dev/null
+++ b/rtl/go32v2/sysutils.pp
@@ -0,0 +1,842 @@
+{
+ $Id: sysutils.pp,v 1.28 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for Go32v2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ go32,dos;
+
+{$DEFINE HAS_SLEEP}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+{ some internal constants }
+
+const
+ ofRead = $0000; { Open for reading }
+ ofWrite = $0001; { Open for writing }
+ ofReadWrite = $0002; { Open for reading/writing }
+ faFail = $0000; { Fail if file does not exist }
+ faCreate = $0010; { Create if file does not exist }
+ faOpen = $0001; { Open if file exists }
+ faOpenReplace = $0002; { Clear if file exists }
+
+Type
+ PSearchrec = ^Searchrec;
+
+{ converts S to a pchar and copies it to the transfer-buffer. }
+
+procedure StringToTB(const S: string);
+var
+ P: pchar;
+ Len: integer;
+begin
+ Len := Length(S) + 1;
+ P := StrPCopy(StrAlloc(Len), S);
+ SysCopyToDos(longint(P), Len);
+ StrDispose(P);
+end ;
+
+
+{ Native OpenFile function.
+ if return value <> 0 call failed. }
+function OpenFile(const FileName: string; var Handle: longint; Mode, Action: word): longint;
+var
+ Regs: registers;
+begin
+ result := 0;
+ Handle := UnusedHandle;
+ StringToTB(FileName);
+ if LFNSupport then
+ begin
+ Regs.Eax := $716c; { Use LFN Open/Create API }
+ Regs.Edx := Action; { Action if file does/doesn't exist }
+ Regs.Esi := tb_offset;
+ Regs.Ebx := $2000 + (Mode and $ff); { File open mode }
+ end
+ else
+ begin
+ if (Action and $00f0) <> 0 then
+ Regs.Eax := $3c00 { Map to Create/Replace API }
+ else
+ Regs.Eax := $3d00 + (Mode and $ff); { Map to Open_Existing API }
+ Regs.Edx := tb_offset;
+ end;
+ Regs.Ds := tb_segment;
+ Regs.Ecx := $20; { Attributes }
+ RealIntr($21, Regs);
+ if (Regs.Flags and CarryFlag) <> 0 then
+ result := Regs.Ax
+ else
+ Handle := Regs.Ax;
+end;
+
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+var
+ e: integer;
+Begin
+ e := OpenFile(FileName, result, Mode, faOpen);
+ if e <> 0 then
+ result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+var
+ e: integer;
+begin
+ e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace);
+ if e <> 0 then
+ result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String; Mode:longint) : Longint;
+begin
+ FileCreate:=FileCreate(FileName);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+var
+ regs : registers;
+ size,
+ readsize : longint;
+begin
+ readsize:=0;
+ while Count > 0 do
+ begin
+ if Count>tb_size then
+ size:=tb_size
+ else
+ size:=Count;
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=Handle;
+ regs.realeax:=$3f00;
+ RealIntr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ Result:=-1;
+ exit;
+ end;
+ syscopyfromdos(Longint(@Buffer)+readsize,lo(regs.realeax));
+ inc(readsize,lo(regs.realeax));
+ dec(Count,lo(regs.realeax));
+ { stop when not the specified size is read }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ Result:=readsize;
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+var
+ regs : registers;
+ size,
+ writesize : longint;
+begin
+ writesize:=0;
+ while Count > 0 do
+ begin
+ if Count>tb_size then
+ size:=tb_size
+ else
+ size:=Count;
+ syscopytodos(Longint(@Buffer)+writesize,size);
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=Handle;
+ regs.realeax:=$4000;
+ RealIntr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ Result:=-1;
+ exit;
+ end;
+ inc(writesize,lo(regs.realeax));
+ dec(Count,lo(regs.realeax));
+ { stop when not the specified size is written }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ Result:=WriteSize;
+end;
+
+
+Function FileSeek (Handle, FOffset, Origin : Longint) : Longint;
+var
+ Regs: registers;
+begin
+ Regs.Eax := $4200;
+ Regs.Al := Origin;
+ Regs.Edx := Lo(FOffset);
+ Regs.Ecx := Hi(FOffset);
+ Regs.Ebx := Handle;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -1
+ else begin
+ LongRec(result).Lo := Regs.Ax;
+ LongRec(result).Hi := Regs.Dx;
+ end ;
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+begin
+ {$warning need to add 64bit call }
+ FileSeek:=FileSeek(Handle,Longint(FOffset),Longint(Origin));
+end;
+
+
+Procedure FileClose (Handle : Longint);
+var
+ Regs: registers;
+begin
+ if Handle<=4 then
+ exit;
+ Regs.Eax := $3e00;
+ Regs.Ebx := Handle;
+ RealIntr($21, Regs);
+end;
+
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+var
+ regs : trealregs;
+begin
+ FileSeek(Handle,Size,0);
+ Regs.realecx := 0;
+ Regs.realedx := tb_offset;
+ Regs.ds := tb_segment;
+ Regs.ebx := Handle;
+ Regs.eax:=$4000;
+ RealIntr($21, Regs);
+ FileTruncate:=(regs.realflags and carryflag)=0;
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+var Handle: longint;
+begin
+ Handle := FileOpen(FileName, 0);
+ if Handle <> -1 then
+ begin
+ result := FileGetDate(Handle);
+ FileClose(Handle);
+ end
+ else
+ result := -1;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+Var
+ Sr : Searchrec;
+begin
+ DOS.FindFirst(FileName,$3f,sr);
+ if DosError = 0 then
+ begin
+ { No volumeid,directory }
+ Result:=(sr.attr and $18)=0;
+ Dos.FindClose(sr);
+ end
+ else
+ Result:=false;
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+Var
+ Sr : Searchrec;
+begin
+ DOS.FindFirst(Directory,$3f,sr);
+ if DosError = 0 then
+ begin
+ Result:=(sr.attr and $10)=$10;
+ Dos.FindClose(sr);
+ end
+ else
+ Result:=false;
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+
+Var Sr : PSearchrec;
+
+begin
+ //!! Sr := New(PSearchRec);
+ getmem(sr,sizeof(searchrec));
+ Rslt.FindHandle := longint(Sr);
+ DOS.FindFirst(Path, Attr, Sr^);
+ result := -DosError;
+ if result = 0 then
+ begin
+ Rslt.Time := Sr^.Time;
+ Rslt.Size := Sr^.Size;
+ Rslt.Attr := Sr^.Attr;
+ Rslt.ExcludeAttr := 0;
+ Rslt.Name := Sr^.Name;
+ end ;
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+var
+ Sr: PSearchRec;
+begin
+ Sr := PSearchRec(Rslt.FindHandle);
+ if Sr <> nil then
+ begin
+ DOS.FindNext(Sr^);
+ result := -DosError;
+ if result = 0 then
+ begin
+ Rslt.Time := Sr^.Time;
+ Rslt.Size := Sr^.Size;
+ Rslt.Attr := Sr^.Attr;
+ Rslt.ExcludeAttr := 0;
+ Rslt.Name := Sr^.Name;
+ end;
+ end;
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+var
+ Sr: PSearchRec;
+begin
+ Sr := PSearchRec(F.FindHandle);
+ if Sr <> nil then
+ begin
+ //!! Dispose(Sr);
+ // This call is non dummy if LFNSupport is true PM
+ DOS.FindClose(SR^);
+ freemem(sr,sizeof(searchrec));
+ end;
+ F.FindHandle := 0;
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+var
+ Regs: registers;
+begin
+ //!! for win95 an alternative function is available.
+ Regs.Ebx := Handle;
+ Regs.Eax := $5700;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -1
+ else
+ begin
+ LongRec(result).Lo := Regs.cx;
+ LongRec(result).Hi := Regs.dx;
+ end ;
+end;
+
+
+Function FileSetDate (Handle, Age : Longint) : Longint;
+var
+ Regs: registers;
+begin
+ Regs.Ebx := Handle;
+ Regs.Eax := $5701;
+ Regs.Ecx := Lo(Age);
+ Regs.Edx := Hi(Age);
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -Regs.Ax
+ else
+ result := 0;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+var
+ Regs: registers;
+begin
+ StringToTB(FileName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ if LFNSupport then
+ begin
+ Regs.Ax := $7143;
+ Regs.Bx := 0;
+ end
+ else
+ Regs.Ax := $4300;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -1
+ else
+ result := Regs.Cx;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+ Regs: registers;
+begin
+ StringToTB(FileName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ if LFNSupport then
+ begin
+ Regs.Ax := $7143;
+ Regs.Bx := 1;
+ end
+ else
+ Regs.Ax := $4301;
+ Regs.Cx := Attr;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -Regs.Ax
+ else
+ result := 0;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+var
+ Regs: registers;
+begin
+ StringToTB(FileName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ if LFNSupport then
+ Regs.Eax := $7141
+ else
+ Regs.Eax := $4100;
+ Regs.Esi := 0;
+ Regs.Ecx := 0;
+ RealIntr($21, Regs);
+ result := (Regs.Flags and CarryFlag = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+var
+ Regs: registers;
+begin
+ StringToTB(OldName + #0 + NewName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ Regs.Edi := tb_offset + Length(OldName) + 1;
+ Regs.Es := tb_segment;
+ if LFNSupport then
+ Regs.Eax := $7156
+ else
+ Regs.Eax := $5600;
+ Regs.Ecx := $ff;
+ RealIntr($21, Regs);
+ result := (Regs.Flags and CarryFlag = 0);
+end;
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+TYPE ExtendedFat32FreeSpaceRec=packed Record
+ RetSize : WORD; { (ret) size of returned structure}
+ Strucversion : WORD; {(call) structure version (0000h)
+ (ret) actual structure version (0000h)}
+ SecPerClus, {number of sectors per cluster}
+ BytePerSec, {number of bytes per sector}
+ AvailClusters, {number of available clusters}
+ TotalClusters, {total number of clusters on the drive}
+ AvailPhysSect, {physical sectors available on the drive}
+ TotalPhysSect, {total physical sectors on the drive}
+ AvailAllocUnits, {Available allocation units}
+ TotalAllocUnits : DWORD; {Total allocation units}
+ Dummy,Dummy2 : DWORD; {8 bytes reserved}
+ END;
+
+function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
+VAR S : String;
+ Rec : ExtendedFat32FreeSpaceRec;
+ regs : registers;
+BEGIN
+ if (swap(dosversion)>=$070A) AND LFNSupport then
+ begin
+ DosError:=0;
+ S:='C:\'#0;
+ if Drive=0 then
+ begin
+ GetDir(Drive,S);
+ Setlength(S,4);
+ S[4]:=#0;
+ end
+ else
+ S[1]:=chr(Drive+64);
+ Rec.Strucversion:=0;
+ dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
+ dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
+ regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
+ regs.ds:=tb_segment;
+ regs.di:=tb_offset;
+ regs.es:=tb_segment;
+ regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
+ regs.ax:=$7303;
+ msdos(regs);
+ if regs.ax<>$ffff then
+ begin
+ copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
+ if Free then
+ Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
+ else
+ Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
+ end
+ else
+ Do_DiskData:=-1;
+ end
+ else
+ begin
+ DosError:=0;
+ regs.dl:=drive;
+ regs.ah:=$36;
+ msdos(regs);
+ if regs.ax<>$FFFF then
+ begin
+ if Free then
+ Do_DiskData:=int64(regs.ax)*regs.bx*regs.cx
+ else
+ Do_DiskData:=int64(regs.ax)*regs.cx*regs.dx;
+ end
+ else
+ do_diskdata:=-1;
+ end;
+end;
+
+
+function diskfree(drive : byte) : int64;
+begin
+ diskfree:=Do_DiskData(drive,TRUE);
+end;
+
+
+function disksize(drive : byte) : int64;
+begin
+ disksize:=Do_DiskData(drive,false);
+end;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir(0, result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+ Time Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var
+ Regs: Registers;
+begin
+ Regs.ah := $2C;
+ RealIntr($21, Regs);
+ SystemTime.Hour := Regs.Ch;
+ SystemTime.Minute := Regs.Cl;
+ SystemTime.Second := Regs.Dh;
+ SystemTime.MilliSecond := Regs.Dl*10;
+ Regs.ah := $2A;
+ RealIntr($21, Regs);
+ SystemTime.Year := Regs.Cx;
+ SystemTime.Month := Regs.Dh;
+ SystemTime.Day := Regs.Dl;
+end ;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+{ Codepage constants }
+const
+ CP_US = 437;
+ CP_MultiLingual = 850;
+ CP_SlavicLatin2 = 852;
+ CP_Turkish = 857;
+ CP_Portugal = 860;
+ CP_IceLand = 861;
+ CP_Canada = 863;
+ CP_NorwayDenmark = 865;
+
+{ CountryInfo }
+type
+ TCountryInfo = packed record
+ InfoId: byte;
+ case integer of
+ 1: ( Size: word;
+ CountryId: word;
+ CodePage: word;
+ CountryInfo: array[0..33] of byte );
+ 2: ( UpperCaseTable: longint );
+ 4: ( FilenameUpperCaseTable: longint );
+ 5: ( FilecharacterTable: longint );
+ 6: ( CollatingTable: longint );
+ 7: ( DBCSLeadByteTable: longint );
+ end ;
+
+
+procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo);
+
+Var Regs: Registers;
+
+begin
+ Regs.AH := $65;
+ Regs.AL := InfoId;
+ Regs.BX := CodePage;
+ Regs.DX := CountryId;
+ Regs.ES := transfer_buffer div 16;
+ Regs.DI := transfer_buffer and 15;
+ Regs.CX := SizeOf(TCountryInfo);
+ RealIntr($21, Regs);
+ DosMemGet(transfer_buffer div 16,
+ transfer_buffer and 15,
+ CountryInfo, Regs.CX );
+end;
+
+
+procedure InitAnsi;
+var
+ CountryInfo: TCountryInfo; i: integer;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 127 do
+ UpperCaseTable[i] := chr(i);
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 255 do
+ LowerCaseTable[i] := chr(i);
+
+ { Get country and codepage info }
+ GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo);
+ if CountryInfo.CodePage = 850 then
+ begin
+ { Special, known case }
+ Move(CP850UCT, UpperCaseTable[128], 128);
+ Move(CP850LCT, LowerCaseTable[128], 128);
+ end
+ else
+ begin
+ { this needs to be checked !!
+ this is correct only if UpperCaseTable is
+ and Offset:Segment word record (PM) }
+ { get the uppercase table from dosmemory }
+ GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo);
+ DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128);
+ for i := 128 to 255 do
+ begin
+ if UpperCaseTable[i] <> chr(i) then
+ LowerCaseTable[ord(UpperCaseTable[i])] := chr(i);
+ end;
+ end;
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+{****************************************************************************
+ Os utils
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=FPCGetEnvVarFromP(envp,EnvVar);
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ Result:=FPCCountEnvVar(EnvP);
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ Result:=FPCGetEnvStrFromP(Envp,Index);
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+var
+ e : EOSError;
+ CommandLine: AnsiString;
+
+begin
+ dos.exec(path,comline);
+
+ if (Dos.DosError <> 0) then
+ begin
+ if ComLine <> '' then
+ CommandLine := Path + ' ' + ComLine
+ else
+ CommandLine := Path;
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+ e.ErrorCode:=Dos.DosError;
+ raise e;
+ end;
+ Result := DosExitCode;
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+{*************************************************************************
+ Sleep
+*************************************************************************}
+
+procedure Sleep (MilliSeconds: Cardinal);
+var
+ R: Registers;
+ T0, T1, T2: int64;
+ DayOver: boolean;
+begin
+(* Sleep is supposed to give up time slice - DOS Idle Interrupt chosen
+ because it should be supported in all DOS versions. Not precise at all,
+ though - the smallest step is 10 ms even in the best case. *)
+ R.AH := $2C;
+ RealIntr($21, R);
+ T0 := R.CH * 3600000 + R.CL * 60000 + R.DH * 1000 + R.DL * 10;
+ T2 := T0 + MilliSeconds;
+ DayOver := T2 > (24 * 3600000);
+ repeat
+ Intr ($28, R);
+(* R.AH := $2C; - should be preserved. *)
+ RealIntr($21, R);
+ T1 := R.CH * 3600000 + R.CL * 60000 + R.DH * 1000 + R.DL * 10;
+ if DayOver and (T1 < T0) then
+ Inc (T1, 24 * 3600000);
+ until T1 >= T2;
+end;
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+{
+ $Log: sysutils.pp,v $
+ Revision 1.28 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.27 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/tthread.inc b/rtl/go32v2/tthread.inc
new file mode 100644
index 0000000000..44bb90dc94
--- /dev/null
+++ b/rtl/go32v2/tthread.inc
@@ -0,0 +1,97 @@
+{
+ $Id: tthread.inc,v 1.3 2005/02/25 21:41:09 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TThread *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+ GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+
+begin
+ {IsMultiThread := TRUE; }
+end;
+
+
+destructor TThread.Destroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+procedure TThread.Terminate;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+ WaitFor:=0;
+end;
+
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.3 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.2 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/v2prt0.as b/rtl/go32v2/v2prt0.as
new file mode 100644
index 0000000000..4131e846b5
--- /dev/null
+++ b/rtl/go32v2/v2prt0.as
@@ -0,0 +1,950 @@
+/*
+ $Id: v2prt0.as,v 1.7 2003/09/27 11:52:35 peter Exp $
+*/
+/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
+/*****************************************************************************\
+ * Interface to 32-bit executable (from stub.asm)
+ *
+ * cs:eip according to COFF header
+ * ds 32-bit data segment for COFF program
+ * fs selector for our data segment (fs:0 is stubinfo)
+ * ss:sp our stack (ss to be freed)
+ * <others> All unspecified registers have unspecified values in them.
+\*****************************************************************************/
+/* modified by Pierre Muller to become the prt0.s for FPC Pascal */
+
+ .file "v2prt0.as"
+
+/* #include "stubinfo.h" */
+ STUBINFO = 0
+ STUBINFO_MAGIC = 0
+ STUBINFO_SIZE = 0x10
+ STUBINFO_MINSTACK = 0x14
+ STUBINFO_MEMORY_HANDLE = 0x18
+ STUBINFO_INITIAL_SIZE = 0x1c
+ STUBINFO_MINKEEP = 0x20
+ STUBINFO_DS_SELECTOR = 0x22
+ STUBINFO_DS_SEGMENT = 0x24
+ STUBINFO_PSP_SELECTOR = 0x26
+ STUBINFO_CS_SELECTOR = 0x28
+ STUBINFO_ENV_SIZE = 0x2a
+ STUBINFO_BASENAME = 0x2c
+ STUBINFO_ARGV0 = 0x34
+ STUBINFO_DPMI_SERVER = 0x44
+ STUBINFO_END = 0x54
+
+
+/* .comm __stklen, 4
+ this is added to the compiler so that we can specify
+ the stack size */
+ .comm __stkbottom,4
+ .comm __stubinfo, 4
+ .comm ___djgpp_base_address, 4
+ .comm ___djgpp_selector_limit, 4
+ .comm ___djgpp_stack_limit, 4
+ .lcomm sel_buf, 8
+
+/* ___djgpp_ds_alias defined in go32/exceptn.s */
+/* inserted at the end of this file */
+/* we use a local copy that will be copied to exceptn.s */
+ .globl ___v2prt0_ds_alias
+___v2prt0_ds_alias:
+ .long 0
+/* allocate 32*4 bytes for RMCB under the $ffff limit for Windows NT */
+ .globl ___v2prt0_rmcb_regs
+___v2prt0_rmcb_regs:
+ .long 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+ .long 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+.data
+
+___djgpp_memory_handle_pointer:
+ .long ___djgpp_memory_handle_list+8 /* Next free, first for stub */
+ .comm ___djgpp_memory_handle_list, 2048 /* Enough for 256 handles */
+
+ /* simply get current state */
+___sbrk_interrupt_state:
+ .long 0x902
+
+sbrk16_first_byte:
+.include "sbrk16.ah"
+sbrk16_last_byte:
+
+sbrk16_api_ofs:
+ .long 0
+sbrk16_api_seg:
+ .word 0
+zero:
+ .long 0
+
+exit16_first_byte:
+.include "exit16.ah"
+exit16_last_byte:
+
+/* hook_387_emulator:
+ .long ___emu387_load_hook */
+
+/* this is for when main comes from a library */
+ .long _main
+
+
+.text
+ .globl start
+start:
+ pushl %ds /* set %es same as %ds */
+ popl %es /* push/pop 4 bytes shorter than ax */
+
+/* Enable NULL pointer protection if DPMI supports it */
+ testb $0x1, __crt0_startup_flags+1 /* include/crt0.h */
+ jnz 1f
+ movl $start, %eax
+ cmpl $0x1000, %eax
+ jl 1f
+ movw $0x507, %ax
+ .byte 0x64 /* fs: */
+ movl STUBINFO_MEMORY_HANDLE, %esi
+ xorl %ebx, %ebx /* Offset 0 in mem block */
+ movl $1, %ecx /* Set one page */
+ movl $zero, %edx
+ int $0x31 /* Make null page uncommitted */
+ jnc 1f
+ call v2prt0_windows
+1:
+/* Create an alias for DS to be used by real-mode callbacks (exception handler messes with DS itself) */
+
+ movw %ds, %bx
+ movw $0x000a, %ax
+ int $0x31
+ jnc ds_alias_ok
+ movb $0x4c, %ah
+ int $0x21
+
+ds_alias_ok:
+ movw %ax, ___v2prt0_ds_alias
+ movl %eax, %ebx
+ movw $0x0009, %ax
+ movw %cs, %cx /* get CPL from %cs */
+ andl $3, %ecx
+ shll $5, %ecx /* move it into place */
+ orw $0xc093, %cx
+ int $0x31 /* set access rights for alias */
+
+/* Maybe set our DS limit to 4Gb in size if flag set */
+ testb $0x80, __crt0_startup_flags /* include/crt0.h */
+ jz 2f
+ movw $0xffff, %cx
+ movl %ecx, %edx
+ movw $0x0008, %ax /* reset alias limit to -1 */
+ int $0x31
+ movw %cs, %bx
+ movw $0x0008, %ax /* reset DS limit to -1 */
+ int $0x31
+ movw %ds, %bx
+ movw $0x0008, %ax /* reset DS limit to -1 */
+ int $0x31
+ lsl %ebx, %ebx /* Should be -1 */
+ incl %ebx
+ jz 2f
+ andb $0x7f, __crt0_startup_flags /* clear it if failure */
+2:
+/* Allocate some DOS memory and copy our sbrk helper into it. */
+ movl $sbrk16_first_byte, %esi
+ movzwl 8(%esi), %ebx
+ shrl $4, %ebx
+ movw $0x0100, %ax
+ int $0x31
+ jnc dos_alloc_ok
+ movb $0x4c, %ah
+ int $0x21
+
+dos_alloc_ok:
+ movw %cs, 2(%esi)
+/* store API information */
+ movw %ds, 4(%esi)
+ movw %dx, 6(%esi)
+/* selector for allocated block */
+
+ movzwl (%esi), %eax /* calculate API address */
+ movl %eax, sbrk16_api_ofs
+
+ pushl %es /* move the data */
+ movw %dx, %es
+ movl $(sbrk16_last_byte - sbrk16_first_byte), %ecx
+ shrl $2,%ecx
+ xorl %edi, %edi
+ cld
+ rep
+ movsl
+ popl %es
+
+ movl %edx, %ebx /* dos memory selector */
+ movw $0x000b, %ax /* get descriptor */
+ movl $sel_buf, %edi
+ int $0x31
+
+ andb $0xbf, sel_buf+6 /* make 16-bit */
+ andb $0xf0, sel_buf+5 /* remove old type */
+ orb $0x0a, sel_buf+5 /* set new type to code/read */
+
+ xorl %eax, %eax /* allocate new selector */
+ movw $0x0001, %cx
+ int $0x31
+ movw %ax, sbrk16_api_seg
+
+ movl %eax, %ebx
+ movw $0x000c, %ax /* set descriptor */
+ movl $sel_buf, %edi
+ int $0x31
+
+/* Initialize the brk/sbrk variables */
+
+/* movl $end, __what_size_app_thinks_it_is */
+ .byte 0x64 /* fs: */
+ movl STUBINFO_INITIAL_SIZE, %eax
+ movl %eax, __what_size_dpmi_thinks_we_are
+
+/* Maybe lock the initial block, expects BX:CX */
+ movl %ecx,%ebx
+ movl %edx,%ecx
+ addw $4096,%cx /* Skip null page */
+ adcl $0,%ebx
+ subl $4096,%eax
+ pushl %eax
+ call lock_memory
+
+ .byte 0x64 /* fs: */
+ movl STUBINFO_MEMORY_HANDLE, %eax
+ movl %eax, ___djgpp_memory_handle_list
+
+ .byte 0x64 /* fs: */ /* copy stubinfo into local memory */
+ movl STUBINFO_SIZE, %eax
+ pushl %eax
+ call ___sbrk
+ movl %eax, __stubinfo
+ movl %eax,U_SYSTEM_STUB_INFO
+ movl %eax, %edi
+ .byte 0x64 /* fs: */
+ movl STUBINFO_SIZE, %ecx
+ shrl $2, %ecx
+ xorl %esi, %esi /* Zero */
+ pushl %ds
+ pushl %fs
+ popl %ds
+ cld
+ rep
+ movsl
+ popl %ds
+ movl __stklen, %eax /* get program-requested stack size */
+ .byte 0x64 /* fs: */
+ movl STUBINFO_MINSTACK, %ecx /* get stub-requested stack size */
+ cmpl %ecx, %eax
+ jge use_stubinfo_stack_size /* use the larger of the two */
+ movl %ecx, %eax
+ movl %eax, __stklen /* store the actual stack length */
+use_stubinfo_stack_size:
+ pushl %eax
+ call ___sbrk /* allocate the memory */
+ cmpl $-1, %eax
+ je no_memory
+ movl %eax, ___djgpp_stack_limit /* Bottom of stack */
+ addl $256,%eax
+ movl %eax,__stkbottom /* for stack checks */
+ movl %eax,U_SYSTEM_STACKBOTTOM
+
+ movl ___djgpp_stack_limit,%eax /* Bottom of stack */
+ addl __stklen, %eax
+ movw %ds, %dx /* set stack */
+ movw %dx, %ss
+ andl $0xfffffffc,%eax
+ movl %eax, %esp
+
+ xorl %ebp, %ebp
+ call ___prt1_startup /* run program */
+ jmp exit
+
+no_memory:
+ movb $0xff, %al
+ jmp exit
+
+/*-----------------------------------------------------------------------------*/
+
+/* #define FREESEL(x) movw x, %bx; movw $0x0001, %ax; int $0x31 */
+ .macro FREESEL x
+ movw \x,%bx
+ movw $0x0001,%ax
+ int $0x31
+ .endm
+
+ .global ___exit
+ .align 2
+___exit:
+/* special exit from dpmiexcp.c */
+ .global __exit
+__exit:
+ movl 4(%esp),%eax
+exit:
+ movl %eax,%ecx
+ xorl %eax,%eax
+ movw %ax,%fs
+ movw %ax,%gs
+ cmpl $0,_exception_exit
+ jz no_exception
+ pushl %ecx
+ call *_exception_exit
+ popl %ecx
+no_exception:
+ cli /* Just in case they didn't unhook ints */
+ FREESEL U_SYSTEM_GO32_INFO_BLOCK+26 /* selector for linear memory */
+ FREESEL ___v2prt0_ds_alias /* DS alias for rmcb exceptions */
+ FREESEL sbrk16_api_seg /* sbrk cs */
+ movw sbrk16_first_byte+6,%dx /* selector for allocated DOS mem */
+ movw $0x101, %ax
+ int $0x31 /* Free block and selector */
+9:
+ movl __stubinfo, %edx
+ movl STUBINFO_CS_SELECTOR(%edx), %eax
+ movw %ax, sbrk16_api_seg
+ xorl %edi, %edi
+ movl %edi, sbrk16_api_ofs /* Offset is zero */
+
+ movw STUBINFO_DS_SELECTOR(%edx), %es
+ movb %cl, %dl /* Exit status */
+ movl $exit16_first_byte, %esi
+ movl $(exit16_last_byte - exit16_first_byte), %ecx
+ cld
+ rep
+ movsb
+
+ movw %es,%ax /* We will free stack! */
+ movw %ax,%ss
+ movl $0x400,%esp /* Transfer buffer >= 1024 bytes */
+
+ xorl %ebp, %ebp /* V1.10 bug fix */
+ movl ___djgpp_memory_handle_list, %edi
+ movl ___djgpp_memory_handle_list+2, %esi /* Skip word prefixes */
+
+ FREESEL %ds
+ movw %cs, %bx
+/* Call exit procedure with BX=32-bit CS; SI+DI=32-bit handle; DL=exit status */
+ .byte 0x2e
+ ljmp sbrk16_api_ofs
+
+/*-----------------------------------------------------------------------------*/
+
+/* .lcomm __what_size_app_thinks_it_is, 4 */
+__what_size_app_thinks_it_is:
+ .long end
+ .lcomm __what_we_return_to_app_as_old_size, 4
+ .lcomm __what_size_dpmi_thinks_we_are, 4
+
+lock_memory:
+ /* BX:CX should be linear address; size is pushed on stack */
+ testb $0x10, __crt0_startup_flags+1 /* include/crt0.h */
+ jz 13f
+ pushl %esi
+ pushl %edi
+ pushl %eax
+ movl 16(%esp),%edi
+ movw 18(%esp),%si
+ movw $0x600,%ax
+ int $0x31
+ popl %eax
+ popl %edi
+ popl %esi
+13: ret $4 /* Pop the argument */
+
+
+ .global ___sbrk
+ .align 2
+___sbrk:
+ movl __what_size_app_thinks_it_is, %eax
+ movl 4(%esp), %ecx /* Increment size */
+ addl %ecx, %eax
+ jnc brk_common
+ /* Carry is only set if a negative increment or wrap happens. Negative
+ increment is semi-OK, wrap (only for multiple zone sbrk) isn't. */
+ test $0x80000000, %ecx /* Clears carry */
+ jnz brk_common
+ stc /* Put carry back */
+ jmp brk_common
+
+ .globl ___brk
+ .align 2
+___brk:
+ movl 4(%esp), %eax
+ clc
+
+brk_common:
+ pushl %esi
+ pushl %edi
+ pushl %ebx
+
+ movl __what_size_app_thinks_it_is, %edx /* save info */
+ movl %edx, __what_we_return_to_app_as_old_size
+ movl %eax, __what_size_app_thinks_it_is
+
+ /* multi code is not present */
+ /* jc 10f Wrap for multi-zone */
+ cmpl __what_size_dpmi_thinks_we_are, %eax /* don't bother shrinking */
+ jbe brk_nochange
+
+ addl $0x0000ffff, %eax /* round up to 64K block */
+ andl $0xffff0000, %eax
+ push %eax /* size - save for later */
+
+ movl ___djgpp_memory_handle_list, %edi /* request new size */
+ movw ___djgpp_memory_handle_list+2, %si
+ movl %eax, %ecx /* size not limit */
+ movl %eax, %ebx /* size not limit */
+ shrl $16, %ebx /* BX:CX size */
+
+ movw $0x0900, %ax /* disable interrupts */
+ int $0x31
+ movl %eax,___sbrk_interrupt_state
+ lcall sbrk16_api_ofs
+ setc %dl /* Save carry */
+
+ /* popl %eax restore interrupts
+ int $0x31 postponed after ds alias is set correctly */
+
+ test %dl,%dl
+ popl %edx
+ jne brk_error
+
+ movl %edi, ___djgpp_memory_handle_list /* store new handle */
+ movw %si, ___djgpp_memory_handle_list+2
+ movl %ecx, ___djgpp_base_address /* store new base address */
+ movw %bx, ___djgpp_base_address+2
+
+ movl %edx, %eax
+ movl __what_size_dpmi_thinks_we_are, %ecx
+ subl %ecx, %eax
+
+ addl ___djgpp_base_address, %ecx
+ movl %ecx, %ebx
+ shrl $16, %ebx /* BX:CX addr */
+ pushl %eax /* Size */
+ call lock_memory
+
+ decl %edx /* limit now, not size */
+5: movl %edx, ___djgpp_selector_limit
+ orw $0x0fff, %dx /* low bits set */
+ movw $0x0008, %ax /* reset CS limit */
+ movw %cs, %bx
+ movl %edx, %ecx
+ shrl $16, %ecx
+ int $0x31 /* CX:DX is limit */
+
+ testb $0x80, __crt0_startup_flags /* include/crt0.h */
+ jnz 3f
+ movw $0x0008, %ax /* reset DS limit */
+ movw %ds, %bx
+ int $0x31
+
+ movw $0x0008, %ax /* reset DS alias limit */
+ movl ___v2prt0_ds_alias, %ebx
+ int $0x31
+3:
+ movw $0x0007, %ax /* reset DS alias base */
+ movl ___v2prt0_ds_alias, %ebx
+ movl ___djgpp_base_address, %edx
+ movw ___djgpp_base_address+2, %cx
+ int $0x31
+
+ movl ___sbrk_interrupt_state,%eax /* restore interrupts */
+ int $0x31
+ movl ___djgpp_selector_limit, %edx
+12: incl %edx /* Size not limit */
+ testb $0x60, __crt0_startup_flags /* include/crt0.h */
+ jz no_fill_sbrk_memory
+ pushl %ds
+ popl %es
+
+ movl __what_size_dpmi_thinks_we_are, %edi /* set all newly resized bytes zero */
+ movl %edx, %ecx /* Limit */
+ subl %edi, %ecx /* Adjust count for base */
+ xorl %eax, %eax
+ testb $0x40, __crt0_startup_flags
+ jz no_deadbeef
+ movl $0xdeadbeef, %eax /* something really easy to spot */
+no_deadbeef:
+ shrl $2, %ecx /* div 4 Longwords not bytes */
+ cld
+ rep
+ stosl
+no_fill_sbrk_memory:
+ movl %edx, __what_size_dpmi_thinks_we_are
+
+brk_nochange: /* successful return */
+ movl __what_we_return_to_app_as_old_size, %eax
+ jmp brk_return
+
+brk_error: /* error return */
+ movl __what_we_return_to_app_as_old_size, %eax
+ movl %eax, __what_size_app_thinks_it_is
+ movl $0, %eax
+
+brk_return:
+ popl %ebx
+ popl %edi
+ popl %esi
+ ret
+
+/* From here on this are parts of crt1.c converted to assembler
+and without any call to libc, so that it works without anything else
+additions made by Pierre Muller*/
+/* from dpmidefs.h * /
+/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
+/* from include <libc/asmdefs.h> */
+/* all macros removed here */
+/* #define FUNC(x) .globl x; x: */
+
+/* #define ENTER pushl %ebp; movl %esp,%ebp */
+
+/* #define LEAVE(x) movl %ebp,%esp; popl %ebp; ret $(x) */
+/* #define ARG1 8(%ebp)
+#define ARG1h 10(%ebp)
+#define ARG2 12(%ebp)
+#define ARG2h 14(%ebp)
+#define ARG3 16(%ebp)
+#define ARG4 20(%ebp)
+#define ARG5 24(%ebp)
+#define ARG6 28(%ebp)
+#define ARG7 32(%ebp)
+#define ARG8 36(%ebp) */
+
+ .comm ___dpmi_error,2
+
+/* from dpmi0000.s */
+/* .globl ___dpmi_allocate_ldt_descriptors */
+/* using pascal convention => not usabel by C code */
+___dpmi_allocate_ldt_descriptors:
+ pushl %ebp; movl %esp,%ebp
+
+ movl 8(%ebp), %ecx
+ movl $0x0000, %eax
+ int $0x31
+ jnc .L_noerror0000
+ movw %ax,___dpmi_error
+ movl $-1,%eax
+ jmp .L_leave0000
+.L_noerror0000:
+ movzwl %ax,%eax
+.L_leave0000:
+ movl %ebp,%esp
+ popl %ebp
+ ret $4
+
+/* from file dpmi0008.s */
+/* .globl ___dpmi_set_segment_limit */
+___dpmi_set_segment_limit:
+ pushl %ebp; movl %esp,%ebp
+
+ movl 8(%ebp), %ebx
+ movzwl 12(%ebp), %edx
+ movzwl 14(%ebp),%ecx
+
+ movl $0x0008,%eax
+ int $0x31
+ jnc .L_noerror0008
+ movw %ax,___dpmi_error
+ movl $-1,%eax
+ jmp .L_leave0008
+.L_noerror0008:
+ xorl %eax,%eax
+.L_leave0008:
+ movl %ebp,%esp
+ popl %ebp
+ ret $8
+
+/* .globl ___dpmi_get_version */
+___dpmi_get_version:
+ pushl %ebp; movl %esp,%ebp
+
+ movl $0x0400,%eax
+ int $0x31
+ jnc .L_noerror0400
+ movw %ax,___dpmi_error
+ movl $-1,%eax
+ jmp .L_leave0400
+.L_noerror0400:
+ movl 8(%ebp), %esi
+ movb %ah, (%esi)
+ movb %al, 1(%esi)
+ movw %bx, 2(%esi)
+ movb %cl, 4(%esi)
+ movb %dh, 5(%esi)
+ movb %dl, 6(%esi)
+
+ xorl %eax,%eax
+.L_leave0400:
+
+ movl %ebp,%esp
+ popl %ebp
+ ret $4
+
+_set_os_trueversion:
+ pushl %ebp
+ movl %esp,%ebp
+ movl $0x3306,%eax
+ xorl %ebx,%ebx
+ int $0x21
+ movzbl %bl,%eax
+ shll $8,%eax
+ shrl $8,%ebx
+ andl $0xff,%ebx
+ addl %ebx,%eax
+ movw %ax,__os_trueversion
+ popl %ebp
+ ret
+/* .globl ___dpmi_get_segment_base_address*/
+___dpmi_get_segment_base_address:
+ pushl %ebp; movl %esp,%ebp
+
+ movl 8(%ebp), %ebx
+ movl $0x0006,%eax
+ int $0x31
+ jnc .L_noerror0006
+ movw %ax,___dpmi_error
+ movl $-1,%eax
+ jmp .L_leave0006
+.L_noerror0006:
+
+ movl 12(%ebp), %ebx
+ movl %edx, (%ebx)
+ movw %cx, 2(%ebx)
+
+ xorl %eax,%eax
+.L_leave0006:
+ movl %ebp,%esp
+ popl %ebp
+ ret $8
+
+.globl ___bss_count
+.data
+ .align 2
+___bss_count:
+ .long 1
+.text
+ .align 2
+ .globl _setup_core_selector
+_setup_core_selector:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl $1
+ call ___dpmi_allocate_ldt_descriptors
+ /* addl $4,%esp */
+ cmpl $-1,%eax
+ jne .L24
+ movw $0,U_SYSTEM_GO32_INFO_BLOCK+26
+ leave
+ ret
+ .align 2,0x90
+.L24:
+ movw %ax,U_SYSTEM_GO32_INFO_BLOCK+26
+ movw %ax,_core_selector
+ pushl $0x10ffff
+ andl $0xffff,%eax
+ pushl %eax
+ call ___dpmi_set_segment_limit
+ leave
+ ret
+ .align 2
+ .globl _setup_screens
+_setup_screens:
+ pushl %ebp
+ movl %esp,%ebp
+ movw U_SYSTEM_GO32_INFO_BLOCK+26,%dx
+ movl $1048563,%ecx
+/APP
+ movw %dx, %gs
+ .byte 0x65
+ movw (%ecx),%ax
+/NO_APP
+ cmpw $64896,%ax
+ jne .L26
+ movl $655360,U_SYSTEM_GO32_INFO_BLOCK+8
+ movl $655360,U_SYSTEM_GO32_INFO_BLOCK+4
+ leave
+ ret
+ .align 2,0x90
+.L26:
+ movl $1097,%ecx
+/APP
+ movw %dx,%gs
+ .byte 0x65
+ movb (%ecx),%al
+/NO_APP
+ cmpb $7,%al
+ jne .L29
+ movl $720896,U_SYSTEM_GO32_INFO_BLOCK+4
+ movl $753664,U_SYSTEM_GO32_INFO_BLOCK+8
+ leave
+ ret
+ .align 2,0x90
+.L29:
+ movl $753664,U_SYSTEM_GO32_INFO_BLOCK+4
+ movl $720896,U_SYSTEM_GO32_INFO_BLOCK+8
+ leave
+ ret
+
+ .align 2
+ .globl _setup_go32_info_block
+_setup_go32_info_block:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $8,%esp
+ leal -8(%ebp),%eax
+ pushl %eax
+ call ___dpmi_get_version
+ movl $40,U_SYSTEM_GO32_INFO_BLOCK
+ movl __stubinfo,%edx
+ movzwl 36(%edx),%eax
+ sall $4,%eax
+ movl %eax,U_SYSTEM_GO32_INFO_BLOCK+12
+ movzwl 32(%edx),%ecx
+ movl %ecx,U_SYSTEM_GO32_INFO_BLOCK+16
+ movzwl 38(%edx),%ecx
+ movl %ecx,U_SYSTEM_GO32_INFO_BLOCK+20
+ movb -3(%ebp),%al
+ movb %al,U_SYSTEM_GO32_INFO_BLOCK+24
+ movb -2(%ebp),%al
+ movb %al,U_SYSTEM_GO32_INFO_BLOCK+25
+ movl $-1,U_SYSTEM_GO32_INFO_BLOCK+28
+ pushl $U_SYSTEM_GO32_INFO_BLOCK+32
+ movzwl 38(%edx),%eax
+ pushl %eax
+ call ___dpmi_get_segment_base_address
+ movw $4,U_SYSTEM_GO32_INFO_BLOCK+36
+ movb -8(%ebp),%dl
+ salw $8,%dx
+ movzbw -7(%ebp),%ax
+ orw %ax,%dx
+ movw %dx,U_SYSTEM_GO32_INFO_BLOCK+38
+ call copy_to_c_go32_info_block
+ leave
+ ret
+
+copy_to_c_go32_info_block:
+ leal U_SYSTEM_GO32_INFO_BLOCK,%esi
+ leal __go32_info_block,%edi
+ movl $10,%ecx
+ rep
+ movsl
+ ret
+
+.data
+ /* fpu codeword */
+___fpucw:
+ .long 0x1332
+ /* __go32_info_block for C programs */
+ .align 2
+ .globl __go32_info_block
+.comm __go32_info_block,40
+
+/*
+ -- prt1_startup --
+*/
+.text
+ .align 2
+ .globl ___prt1_startup
+___prt1_startup:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ incl ___bss_count
+ movl $0,___crt0_argv
+ call _set_os_trueversion
+ call _setup_core_selector
+ call _setup_screens
+ call _setup_go32_info_block
+ incl ___environ_changed
+ /* call set_processor emulation */
+ /* neede to avoid FPU exception if calling from anothe DPMI program */
+ movl $0xe01,%eax
+ movl $1,%ebx
+ int $0x31
+ fninit /* initialize fpu */
+ push %eax /* Dummy for status store check */
+ movl %esp,%esi
+ movw $0x5a5a,(%esi)
+ /* fwait maybe this one is responsible of exceptions */
+ fnstsw (%esi)
+ cmpb $0,(%esi)
+ jne .Lno_387
+ fldcw ___fpucw
+.Lno_387:
+ popl %eax
+ pushl U_SYSTEM_ENVP
+ pushl ___crt0_argv
+ pushl ___crt0_argc
+ call _pascal_start
+ pushl %eax
+/* call _exit changed to */
+ call exit
+ .align 2,0x90
+/* .comm U_SYSTEM_DOS_ARGV0,4 */
+ .comm ___dos_argv0,4
+ .comm ___crt0_argc,4
+ .comm ___crt0_argv,4
+ .comm ___environ_changed,4
+/* ___environ_changed: not in data because it is defined in putenv.c */
+/* .long 0 */
+ .globl _exception_exit
+_exception_exit:
+ .long 0
+ .globl _swap_in
+_swap_in:
+ .long 0
+ .globl _swap_out
+_swap_out:
+ .long 0
+ .global _v2prt0_exceptions_on
+_v2prt0_exceptions_on:
+ .long 0
+
+// Fill null page with NOPs
+// and a jmp windows_error at the end
+ .globl v2prt0_windows
+v2prt0_windows:
+ movl $0x90909090,%eax
+ xorl %edi,%edi
+ movl $0x400,%ecx
+ cld
+ rep
+ stosl
+ movl $0xffB,%edi
+ movb $0xe9,%al
+ stosb
+ movl $_fpc_windows_error-4,%eax
+ subl %edi,%eax
+ stosl
+ ret
+
+// Raise SIGILL with UD2 opcode
+
+ .globl _fpc_windows_error
+_fpc_windows_error:
+ cmpl $0,_exception_exit
+ je .L_error_216
+ .byte 0x0f,0x0b
+.L_error_216:
+ pushl $216
+ call __exit
+ jmp exit
+#enif
+
+/* this was the prt0.s from the go32v1 version */
+//
+// call as start(argc, argv, envp) (C-calling convention)
+//
+ .globl _pascal_start
+_pascal_start:
+ /* %ebx doesn't contain ScreenPrimary */
+ movl U_SYSTEM_GO32_INFO_BLOCK+4,%ebx
+ movl %ebx,_ScreenPrimary
+ /* core selector in %fs */
+ /* keep original fs for debuggers !!!!! (PM) */
+ movw %fs,%ax
+ movw %ax,___v2prt0_start_fs
+
+ movw _core_selector,%ax
+ movw %ax,%fs
+
+// Top of frame
+ movl $0x0,%ebp
+ movl %esp,%ebx
+ movl 12(%ebx),%eax
+ movl %eax,U_SYSTEM_ENVP
+ movl %eax,_environ
+ movl 8(%ebx),%eax
+ movl %eax,_args
+ movl 4(%ebx),%eax
+ movl %eax,_argc
+
+ call PASCALMAIN
+ movl $0,%eax
+ /* no error if passing here */
+/* movl $0x4c00,%eax
+ int $0x21 */
+
+ ret
+
+ .data
+
+/* .comm U_SYSTEM_ENVP,4 */
+ .globl _ScreenPrimary
+_ScreenPrimary:
+ .long 0
+ .globl _argc
+_argc:
+ .long 0
+ .globl _args
+_args:
+ .long 0
+ .globl _run_mode
+_run_mode:
+ .word 4
+ .globl _core_selector
+_core_selector:
+ .word 0
+ .globl ___v2prt0_start_fs
+___v2prt0_start_fs:
+ .word 0
+ .globl _environ
+_environ:
+ .long 0
+
+/* Here Pierre Muller added all what was in crt1.c */
+/* in assembler */
+/* Copyright (C) 1996 DJ Delorie, see COPYING.DJ for details */
+/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
+/* adapted to assembler for FPC by Pierre Muller */
+
+/* Global variables */
+
+
+/* This gets incremented each time the program is started.
+ Programs (such as Emacs) which dump their code to create
+ a new executable, cause this to be larger than 2. Library
+ functions that cache info in static variables should check
+ the value of `__bss_count' if they need to reinitialize
+ the static storage. */
+ .data
+ .globl ___bss_count
+___bs_count:
+ .long 1
+
+ .globl __crt0_startup_flags
+__crt0_startup_flags:
+ .long 0
+
+ .globl __dos_ds
+__dos_ds:
+ .long 0
+
+ .globl ___PROXY
+___PROXY:
+ .ascii " !proxy"
+ .byte 0
+
+ .globl ___PROXY_LEN
+___PROXY_LEN:
+ .long 7
+
+ .comm __os_trueversion,2
+
+/*
+ $Log: v2prt0.as,v $
+ Revision 1.7 2003/09/27 11:52:35 peter
+ * sbrk returns pointer
+
+ Revision 1.6 2002/09/08 09:16:15 jonas
+ * added closing of comment for logs to avoid warning
+
+ Revision 1.5 2002/09/07 16:01:19 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.4 2002/02/03 09:51:41 peter
+ * merged winxp fixes
+
+*/
diff --git a/rtl/go32v2/varutils.pp b/rtl/go32v2/varutils.pp
new file mode 100644
index 0000000000..03eef8c5d2
--- /dev/null
+++ b/rtl/go32v2/varutils.pp
@@ -0,0 +1,47 @@
+{
+ $Id: varutils.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
+
diff --git a/rtl/go32v2/vesa.inc b/rtl/go32v2/vesa.inc
new file mode 100644
index 0000000000..f5d9179715
--- /dev/null
+++ b/rtl/go32v2/vesa.inc
@@ -0,0 +1,2752 @@
+{
+ $Id: vesa.inc,v 1.12 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl Eric Codere
+
+ This include implements VESA basic access.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+type
+
+ palrec = packed record { record used for set/get DAC palette }
+ blue, green, red, align: byte;
+ end;
+
+const
+ { VESA attributes }
+ attrSwitchDAC = $01; { DAC is switchable (1.2) }
+ attrNotVGACompatible = $02; { Video is NOT VGA compatible (2.0) }
+ attrSnowCheck = $04; { Video must use snow checking(2.0) }
+
+ { mode attribute bits }
+ modeAvail = $01; { Hardware supports this mode (1.0) }
+ modeExtendInfo = $02; { Extended information (1.0) }
+ modeBIOSSupport = $04; { TTY BIOS Support (1.0) }
+ modeColor = $08; { This is a color mode (1.0) }
+ modeGraphics = $10; { This is a graphics mode (1.0) }
+ modeNotVGACompatible = $20; { this mode is NOT I/O VGA compatible (2.0)}
+ modeNoWindowed = $40; { This mode does not support Windows (2.0) }
+ modeLinearBuffer = $80; { This mode supports linear buffers (2.0) }
+
+ { window attributes }
+ winSupported = $01;
+ winReadable = $02;
+ winWritable = $04;
+
+ { memory model }
+ modelText = $00;
+ modelCGA = $01;
+ modelHerc = $02;
+ model4plane = $03;
+ modelPacked = $04;
+ modelModeX = $05;
+ modelRGB = $06;
+ modelYUV = $07;
+
+{$ifndef dpmi}
+{$i vesah.inc}
+{ otherwise it's already included in graph.pp }
+{$endif dpmi}
+
+var
+
+ BytesPerLine: word; { Number of bytes per scanline }
+ YOffset : word; { Pixel offset for VESA page flipping }
+
+ { window management }
+ ReadWindow : byte; { Window number for reading. }
+ WriteWindow: byte; { Window number for writing. }
+ winReadSeg : word; { Address of segment for read }
+ winWriteSeg: word; { Address of segment for writes}
+ CurrentReadBank : integer; { active read bank }
+ CurrentWriteBank: integer; { active write bank }
+
+ BankShift : word; { address to shift by when switching banks. }
+
+ { linear mode specific stuff }
+ InLinear : boolean; { true if in linear mode }
+ LinearPageOfs : longint; { offset used to set active page }
+ FrameBufferLinearAddress : longint;
+
+ ScanLines: word; { maximum number of scan lines for mode }
+
+function hexstr(val : longint;cnt : byte) : string;
+const
+ HexTbl : array[0..15] of char='0123456789ABCDEF';
+var
+ i : longint;
+begin
+ hexstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ hexstr[i]:=hextbl[val and $f];
+ val:=val shr 4;
+ end;
+end;
+
+
+{$IFDEF DPMI}
+
+ function getVESAInfo(var VESAInfo: TVESAInfo) : boolean;
+ var
+ ptrlong : longint;
+ VESAPtr : ^TVESAInfo;
+ st : string[4];
+ regs : TDPMIRegisters;
+{$ifndef fpc}
+ ModeSel: word;
+ offs: longint;
+{$endif fpc}
+ { added... }
+ modelist: PmodeList;
+ i: longint;
+ RealSeg : word;
+ begin
+ { Allocate real mode buffer }
+{$ifndef fpc}
+ Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
+ { Get selector value }
+ VESAPtr := pointer(Ptrlong shl 16);
+{$else fpc}
+ Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
+ New(VESAPtr);
+{$endif fpc}
+ { Get segment value }
+ RealSeg := word(Ptrlong shr 16);
+ if not assigned(VESAPtr) then
+ RunError(203);
+ FillChar(regs, sizeof(regs), #0);
+
+ { Get VESA Mode information ... }
+ regs.eax := $4f00;
+ regs.es := RealSeg;
+ regs.edi := $00;
+ RealIntr($10, regs);
+{$ifdef fpc}
+ { no far pointer support in FPC yet, so move the vesa info into a memory }
+ { block in the DS slector space (JM) }
+ dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
+{$endif fpc}
+ St:=Vesaptr^.signature;
+ if st<>'VESA' then
+ begin
+{$ifdef logging}
+ LogLn('No VESA detected.');
+{$endif logging}
+ getVesaInfo := FALSE;
+{$ifndef fpc}
+ GlobalDosFree(word(PtrLong and $ffff));
+{$else fpc}
+ If not Global_Dos_Free(word(PtrLong and $ffff)) then
+ RunError(216);
+ { also free the extra allocated buffer }
+ Dispose(VESAPtr);
+{$endif fpc}
+ exit;
+ end
+ else
+ getVesaInfo := TRUE;
+
+{$ifndef fpc}
+ { The mode pointer buffer points to a real mode memory }
+ { Therefore steps to get the modes: }
+ { 1. Allocate Selector and SetLimit to max number of }
+ { of possible modes. }
+ ModeSel := AllocSelector(0);
+ SetSelectorLimit(ModeSel, 256*sizeof(word));
+
+ { 2. Set Selector linear address to the real mode pointer }
+ { returned. }
+ offs := longint(longint(VESAPtr^.ModeList) shr 16) shl 4;
+ {shouldn't the OR in the next line be a + ?? (JM)}
+ offs := offs OR (Longint(VESAPtr^.ModeList) and $ffff);
+ SetSelectorBase(ModeSel, offs);
+
+ { copy VESA mode information to a protected mode buffer and }
+ { then free the real mode buffer... }
+ Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
+ GlobalDosFree(word(PtrLong and $ffff));
+
+ { ModeList points to the mode list }
+ { We must copy it somewhere... }
+ ModeList := Ptr(ModeSel, 0);
+
+{$else fpc}
+ { No far pointer support, so the Ptr(ModeSel, 0) doesn't work. }
+ { Immediately copy everything to a buffer in the DS selector space }
+ New(ModeList);
+ { The following may copy data from outside the VESA buffer, but it }
+ { shouldn't get past the 1MB limit, since that would mean the buffer }
+ { has been allocated in the BIOS or high memory region, which seems }
+ { impossible to me (JM)}
+ DosMemGet(word(longint(VESAPtr^.ModeList) shr 16),
+ word(longint(VESAPtr^.ModeList) and $ffff), ModeList^,256*sizeof(word));
+
+ { copy VESA mode information to a protected mode buffer and }
+ { then free the real mode buffer... }
+ Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
+ If not Global_Dos_Free(word(PtrLong and $ffff)) then
+ RunError(216);
+ Dispose(VESAPtr);
+{$endif fpc}
+
+ i:=0;
+ new(VESAInfo.ModeList);
+ while ModeList^[i]<> $ffff do
+ begin
+{$ifdef logging}
+ LogLn('Found mode $'+hexstr(ModeList^[i],4));
+{$endif loggin}
+ VESAInfo.ModeList^[i] := ModeList^[i];
+ Inc(i);
+ end;
+ VESAInfo.ModeList^[i]:=$ffff;
+ { Free the temporary selector used to get mode information }
+{$ifdef logging}
+ LogLn(strf(i) + ' modes found.');
+{$endif logging}
+{$ifndef fpc}
+ FreeSelector(ModeSel);
+{$else fpc}
+ Dispose(ModeList);
+{$endif fpc}
+ end;
+
+ function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
+ var
+ Ptr: longint;
+{$ifndef fpc}
+ VESAPtr : ^TVESAModeInfo;
+{$endif fpc}
+ regs : TDPMIRegisters;
+ RealSeg: word;
+ begin
+ { Alllocate real mode buffer }
+{$ifndef fpc}
+ Ptr:=GlobalDosAlloc(sizeof(TVESAModeInfo));
+ { get the selector value }
+ VESAPtr := pointer(longint(Ptr shl 16));
+ if not assigned(VESAPtr) then
+ RunError(203);
+{$else fpc}
+ Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
+{$endif fpc}
+ { get the segment value }
+ RealSeg := word(Ptr shr 16);
+ { setup interrupt registers }
+ FillChar(regs, sizeof(regs), #0);
+ { call VESA mode information...}
+ regs.eax := $4f01;
+ regs.es := RealSeg;
+ regs.edi := $00;
+ regs.ecx := mode;
+ RealIntr($10, regs);
+ if word(regs.eax) <> $4f then
+ getVESAModeInfo := FALSE
+ else
+ getVESAModeInfo := TRUE;
+ { copy to protected mode buffer ... }
+{$ifndef fpc}
+ Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
+{$else fpc}
+ DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
+{$endif fpc}
+ { free real mode memory }
+{$ifndef fpc}
+ GlobalDosFree(Word(Ptr and $ffff));
+{$else fpc}
+ If not Global_Dos_Free(Word(Ptr and $ffff)) then
+ RunError(216);
+{$endif fpc}
+ end;
+
+{$ELSE}
+ function getVESAInfo(var VESAInfo: TVESAInfo) : boolean; assembler;
+ asm
+ mov ax,4F00h
+ les di,VESAInfo
+ int 10h
+ sub ax,004Fh {make sure we got 004Fh back}
+ cmp ax,1
+ sbb al,al
+ cmp word ptr es:[di],'V'or('E'shl 8) {signature should be 'VESA'}
+ jne @@ERR
+ cmp word ptr es:[di+2],'S'or('A'shl 8)
+ je @@X
+ @@ERR:
+ mov al,0
+ @@X:
+ end;
+
+
+ function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;assembler;
+ asm
+ mov ax,4F01h
+ mov cx,mode
+ les di,ModeInfo
+ int 10h
+ sub ax,004Fh {make sure it's 004Fh}
+ cmp ax,1
+ sbb al,al
+ end;
+
+{$ENDIF}
+
+ function SearchVESAModes(mode: Word): boolean;
+ {********************************************************}
+ { Searches for a specific DEFINED vesa mode. If the mode }
+ { is not available for some reason, then returns FALSE }
+ { otherwise returns TRUE. }
+ {********************************************************}
+ var
+ i: word;
+ ModeSupported : Boolean;
+ begin
+ i:=0;
+ { let's assume it's not available ... }
+ ModeSupported := FALSE;
+ { This is a STUB VESA implementation }
+ if VESAInfo.ModeList^[0] = $FFFF then exit;
+ repeat
+ if VESAInfo.ModeList^[i] = mode then
+ begin
+ { we found it, the card supports this mode... }
+ ModeSupported := TRUE;
+ break;
+ end;
+ Inc(i);
+ until VESAInfo.ModeList^[i] = $ffff;
+ { now check if the hardware supports it... }
+ If ModeSupported then
+ begin
+ { we have to init everything to zero, since VBE < 1.1 }
+ { may not setup fields correctly. }
+ FillChar(VESAModeInfo, sizeof(VESAModeInfo), #0);
+ If GetVESAModeInfo(VESAModeInfo, Mode) And
+ ((VESAModeInfo.attr and modeAvail) <> 0) then
+ ModeSupported := TRUE
+ else
+ ModeSupported := FALSE;
+ end;
+ SearchVESAModes := ModeSupported;
+ end;
+
+
+
+ procedure SetBankIndex(win: byte; BankNr: Integer); assembler;
+ asm
+{$IFDEF REGCALL}
+ mov bl, al
+{$ELSE REGCALL}
+ mov bl,[Win]
+{$ENDIF REGCALL}
+ mov ax,4f05h
+ mov bh,00h
+{$IFNDEF REGCALL}
+ mov dx,[BankNr]
+{$ENDIF REGCALL}
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+
+ {********************************************************}
+ { There are two routines for setting banks. This may in }
+ { in some cases optimize a bit some operations, if the }
+ { hardware supports it, because one window is used for }
+ { reading and one window is used for writing. }
+ {********************************************************}
+ procedure SetReadBank(BankNr: Integer);
+ begin
+ { check if this is the current bank... if so do nothing. }
+ if BankNr = CurrentReadBank then exit;
+{$ifdef logging}
+{ LogLn('Setting read bank to '+strf(BankNr));}
+{$endif logging}
+ CurrentReadBank := BankNr; { save current bank number }
+ BankNr := BankNr shl BankShift; { adjust to window granularity }
+ { we set both banks, since one may read only }
+ SetBankIndex(ReadWindow, BankNr);
+ { if the hardware supports only one window }
+ { then there is only one single bank, so }
+ { update both bank numbers. }
+ if ReadWindow = WriteWindow then
+ CurrentWriteBank := CurrentReadBank;
+ end;
+
+ procedure SetWriteBank(BankNr: Integer);
+ begin
+ { check if this is the current bank... if so do nothing. }
+ if BankNr = CurrentWriteBank then exit;
+{$ifdef logging}
+{ LogLn('Setting write bank to '+strf(BankNr));}
+{$endif logging}
+ CurrentWriteBank := BankNr; { save current bank number }
+ BankNr := BankNr shl BankShift; { adjust to window granularity }
+ { we set both banks, since one may read only }
+ SetBankIndex(WriteWindow, BankNr);
+ { if the hardware supports only one window }
+ { then there is only one single bank, so }
+ { update both bank numbers. }
+ if ReadWindow = WriteWindow then
+ CurrentReadBank := CurrentWriteBank;
+ end;
+
+ {************************************************************************}
+ {* 8-bit pixels VESA mode routines *}
+ {************************************************************************}
+
+ procedure PutPixVESA256(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ Y := Y + YOffset; { adjust pixel for correct virtual page }
+ offs := longint(y) * BytesPerLine + x;
+ begin
+ SetWriteBank(integer(offs shr 16));
+ mem[WinWriteSeg : word(offs)] := byte(color);
+ end;
+ end;
+
+ procedure DirectPutPixVESA256(x, y : integer); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ col : byte;
+ begin
+ offs := (longint(y) + YOffset) * BytesPerLine + x;
+ Case CurrentWriteMode of
+ XorPut:
+ Begin
+ SetReadBank(integer(offs shr 16));
+ col := mem[WinReadSeg : word(offs)] xor byte(CurrentColor);
+ End;
+ AndPut:
+ Begin
+ SetReadBank(integer(offs shr 16));
+ col := mem[WinReadSeg : word(offs)] And byte(CurrentColor);
+ End;
+ OrPut:
+ Begin
+ SetReadBank(integer(offs shr 16));
+ col := mem[WinReadSeg : word(offs)] or byte(currentcolor);
+ End
+ else
+ Begin
+ If CurrentWriteMode <> NotPut then
+ col := Byte(CurrentColor)
+ else col := Not(Byte(CurrentColor));
+ End
+ End;
+ SetWriteBank(integer(offs shr 16));
+ mem[WinWriteSeg : word(offs)] := Col;
+ end;
+
+ function GetPixVESA256(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort + YOffset;
+ offs := longint(y) * BytesPerLine + x;
+ SetReadBank(integer(offs shr 16));
+ GetPixVESA256:=mem[WinReadSeg : word(offs)];
+ end;
+
+ Procedure GetScanLineVESA256(x1, x2, y: integer; var data); {$ifndef fpc}far;{$endif}
+ var offs: Longint;
+ l, amount, bankrest, index, pixels: longint;
+ curbank: integer;
+ begin
+ inc(x1,StartXViewPort);
+ inc(x2,StartXViewPort);
+ {$ifdef logging}
+ LogLn('getscanline256 '+strf(x1)+' - '+strf(x2)+' at '+strf(y+StartYViewPort));
+ {$endif logging}
+ index := 0;
+ amount := x2-x1+1;
+ Offs:=(Longint(y)+StartYViewPort+YOffset)*bytesperline+x1;
+ Repeat
+ curbank := integer(offs shr 16);
+ SetReadBank(curbank);
+ {$ifdef logging}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If ((amount >= 4) and
+ ((offs and 3) = 0)) or
+ (amount >= 4+4-(offs and 3)) Then
+ { allign target }
+ Begin
+ If (offs and 3) <> 0 then
+ { this cannot go past a window boundary bacause the }
+ { size of a window is always a multiple of 4 }
+ Begin
+ {$ifdef logging}
+ LogLn('Alligning by reading '+strf(4-(offs and 3))+' pixels');
+ {$endif logging}
+ for l := 1 to 4-(offs and 3) do
+ WordArray(Data)[index+l-1] :=
+ Mem[WinReadSeg:word(offs)+l-1];
+ inc(index, l);
+ inc(offs, l);
+ dec(amount, l);
+ End;
+ {$ifdef logging}
+ LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
+ {$endif logging}
+ { offs is now 4-bytes alligned }
+ If amount <= ($10000-(Offs and $ffff)) Then
+ bankrest := amount
+ else {the rest won't fit anymore in the current window }
+ bankrest := $10000 - (Offs and $ffff);
+ { it is possible that by aligning, we ended up in a new }
+ { bank, so set the correct bank again to make sure }
+ setreadbank(offs shr 16);
+ {$ifdef logging}
+ LogLn('Rest to be read from this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to (Bankrest div 4)-1 Do
+ begin
+ pixels := MemL[WinWriteSeg:word(offs)+l*4];
+ WordArray(Data)[index+l*4] := pixels and $ff;
+ pixels := pixels shr 8;
+ WordArray(Data)[index+l*4+1] := pixels and $ff;
+ pixels := pixels shr 8;
+ WordArray(Data)[index+l*4+2] := pixels and $ff;
+ pixels := pixels shr 8;
+ WordArray(Data)[index+l*4+3] := pixels{ and $ff};
+ end;
+ inc(index,l*4+4);
+ inc(offs,l*4+4);
+ dec(amount,l*4+4);
+ {$ifdef logging}
+ LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
+ {$endif logging}
+ End
+ Else
+ Begin
+ {$ifdef logging}
+ LogLn('Leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
+ {$endif logging}
+ For l := 0 to amount - 1 do
+ begin
+ { this may cross a bank at any time, so adjust }
+ { because this loop alwys runs for very little pixels, }
+ { there's little gained by splitting it up }
+ setreadbank(offs shr 16);
+ WordArray(Data)[index+l] := mem[WinReadSeg:word(offs)];
+ inc(offs);
+ end;
+ amount := 0
+ End
+ Until amount = 0;
+ end;
+
+ procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
+
+ var Offs: Longint;
+ mask, l, bankrest: longint;
+ curbank, hlength: integer;
+ Begin
+ { must we swap the values? }
+ if x > x2 then
+ Begin
+ x := x xor x2;
+ x2 := x xor x2;
+ x:= x xor x2;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ X2 := X2 + StartXViewPort;
+ Y := Y + StartYViewPort;
+ if ClipPixels then
+ Begin
+ if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ {$ifdef logging2}
+ LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
+ {$endif logging2}
+ HLength := x2 - x + 1;
+ {$ifdef logging2}
+ LogLn('length: '+strf(hlength));
+ {$endif logging2}
+ if HLength>0 then
+ begin
+ Offs:=(Longint(y)+YOffset)*bytesperline+x;
+ {$ifdef logging2}
+ LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+ {$endif logging2}
+ Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
+ Mask := Mask + Mask shl 16;
+ Case CurrentWriteMode of
+ AndPut:
+ Begin
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ SetReadBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging2}
+ If ((HLength >= 4) and
+ ((offs and 3) = 0)) or
+ (HLength >= 4+4-(offs and 3)) Then
+ { align target }
+ Begin
+ l := 0;
+ If (offs and 3) <> 0 then
+ { this cannot go past a window boundary bacause the }
+ { size of a window is always a multiple of 4 }
+ Begin
+ {$ifdef logging2}
+ LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+ {$endif logging2}
+ for l := 1 to 4-(offs and 3) do
+ Mem[WinWriteSeg:word(offs)+l-1] :=
+ Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
+ End;
+ Dec(HLength, l);
+ inc(offs, l);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ { offs is now 4-bytes alligned }
+ If HLength <= ($10000-(Offs and $ffff)) Then
+ bankrest := HLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := $10000 - (Offs and $ffff);
+ { it is possible that by aligningm we ended up in a new }
+ { bank, so set the correct bank again to make sure }
+ setwritebank(offs shr 16);
+ setreadbank(offs shr 16);
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to (Bankrest div 4)-1 Do
+ MemL[WinWriteSeg:word(offs)+l*4] :=
+ MemL[WinReadSeg:word(offs)+l*4] And Mask;
+ inc(offs,l*4+4);
+ dec(hlength,l*4+4);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ End
+ Else
+ Begin
+ {$ifdef logging2}
+ LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+ {$endif logging}
+ For l := 0 to HLength - 1 do
+ begin
+ { this may cross a bank at any time, so adjust }
+ { becauese this loop alwys runs for very little pixels, }
+ { there's little gained by splitting it up }
+ setreadbank(offs shr 16);
+ setwritebank(offs shr 16);
+ Mem[WinWriteSeg:word(offs)] :=
+ Mem[WinReadSeg:word(offs)] And byte(currentColor);
+ inc(offs);
+ end;
+ HLength := 0
+ End
+ Until HLength = 0;
+ End;
+ XorPut:
+ Begin
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ SetReadBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If ((HLength >= 4) and
+ ((offs and 3) = 0)) or
+ (HLength >= 4+4-(offs and 3)) Then
+ { allign target }
+ Begin
+ l := 0;
+ If (offs and 3) <> 0 then
+ { this cannot go past a window boundary bacause the }
+ { size of a window is always a multiple of 4 }
+ Begin
+ {$ifdef logging2}
+ LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+ {$endif logging}
+ for l := 1 to 4-(offs and 3) do
+ Mem[WinWriteSeg:word(offs)+l-1] :=
+ Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
+ End;
+ Dec(HLength, l);
+ inc(offs, l);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ { offs is now 4-bytes alligned }
+ If HLength <= ($10000-(Offs and $ffff)) Then
+ bankrest := HLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := $10000 - (Offs and $ffff);
+ { it is possible that by aligningm we ended up in a new }
+ { bank, so set the correct bank again to make sure }
+ setwritebank(offs shr 16);
+ setreadbank(offs shr 16);
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to (Bankrest div 4)-1 Do
+ MemL[WinWriteSeg:word(offs)+l*4] :=
+ MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
+ inc(offs,l*4+4);
+ dec(hlength,l*4+4);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ End
+ Else
+ Begin
+ {$ifdef logging2}
+ LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+ {$endif logging}
+ For l := 0 to HLength - 1 do
+ begin
+ { this may cross a bank at any time, so adjust }
+ { because this loop alwys runs for very little pixels, }
+ { there's little gained by splitting it up }
+ setreadbank(offs shr 16);
+ setwritebank(offs shr 16);
+ Mem[WinWriteSeg:word(offs)] :=
+ Mem[WinReadSeg:word(offs)] xor byte(currentColor);
+ inc(offs);
+ end;
+ HLength := 0
+ End
+ Until HLength = 0;
+ End;
+ OrPut:
+ Begin
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ SetReadBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If ((HLength >= 4) and
+ ((offs and 3) = 0)) or
+ (HLength >= 4+4-(offs and 3)) Then
+ { allign target }
+ Begin
+ l := 0;
+ If (offs and 3) <> 0 then
+ { this cannot go past a window boundary bacause the }
+ { size of a window is always a multiple of 4 }
+ Begin
+ {$ifdef logging2}
+ LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+ {$endif logging}
+ for l := 1 to 4-(offs and 3) do
+ Mem[WinWriteSeg:word(offs)+l-1] :=
+ Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
+ End;
+ Dec(HLength, l);
+ inc(offs, l);
+ { it is possible that by aligningm we ended up in a new }
+ { bank, so set the correct bank again to make sure }
+ setwritebank(offs shr 16);
+ setreadbank(offs shr 16);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ { offs is now 4-bytes alligned }
+ If HLength <= ($10000-(Offs and $ffff)) Then
+ bankrest := HLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := $10000 - (Offs and $ffff);
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to (Bankrest div 4)-1 Do
+ MemL[WinWriteSeg:offs+l*4] :=
+ MemL[WinReadSeg:word(offs)+l*4] Or Mask;
+ inc(offs,l*4+4);
+ dec(hlength,l*4+4);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ End
+ Else
+ Begin
+ {$ifdef logging2}
+ LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+ {$endif logging}
+ For l := 0 to HLength - 1 do
+ begin
+ { this may cross a bank at any time, so adjust }
+ { because this loop alwys runs for very little pixels, }
+ { there's little gained by splitting it up }
+ setreadbank(offs shr 16);
+ setwritebank(offs shr 16);
+ Mem[WinWriteSeg:word(offs)] :=
+ Mem[WinReadSeg:word(offs)] And byte(currentColor);
+ inc(offs);
+ end;
+ HLength := 0
+ End
+ Until HLength = 0;
+ End
+ Else
+ Begin
+ If CurrentWriteMode = NotPut Then
+ Mask := Not(Mask);
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
+ {$endif logging}
+ If ((HLength >= 4) and
+ ((offs and 3) = 0)) or
+ (HLength >= 4+4-(offs and 3)) Then
+ { allign target }
+ Begin
+ l := 0;
+ If (offs and 3) <> 0 then
+ { this cannot go past a window boundary bacause the }
+ { size of a window is always a multiple of 4 }
+ Begin
+ {$ifdef logging2}
+ LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
+ {$endif logging}
+ for l := 1 to 4-(offs and 3) do
+ Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
+ End;
+ Dec(HLength, l);
+ inc(offs, l);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ { offs is now 4-bytes alligned }
+ If HLength <= ($10000-(Offs and $ffff)) Then
+ bankrest := HLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := $10000 - (Offs and $ffff);
+ { it is possible that by aligningm we ended up in a new }
+ { bank, so set the correct bank again to make sure }
+ setwritebank(offs shr 16);
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
+ {$endif logging}
+ For l := 0 to (Bankrest div 4)-1 Do
+ MemL[WinWriteSeg:word(offs)+l*4] := Mask;
+ inc(offs,l*4+4);
+ dec(hlength,l*4+4);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
+ {$endif logging}
+ End
+ Else
+ Begin
+ {$ifdef logging2}
+ LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
+ {$endif logging}
+ For l := 0 to HLength - 1 do
+ begin
+ { this may cross a bank at any time, so adjust }
+ { because this loop alwys runs for very little pixels, }
+ { there's little gained by splitting it up }
+ setwritebank(offs shr 16);
+ Mem[WinWriteSeg:word(offs)] := byte(mask);
+ inc(offs);
+ end;
+ HLength := 0
+ End
+ Until HLength = 0;
+ End;
+ End;
+ end;
+ end;
+
+ procedure VLineVESA256(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
+
+ var Offs: Longint;
+ l, bankrest: longint;
+ curbank, vlength: integer;
+ col: byte;
+ Begin
+ { must we swap the values? }
+ if y > y2 then
+ Begin
+ y := y xor y2;
+ y2 := y xor y2;
+ y:= y xor y2;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ Y := Y + StartYViewPort;
+ Y2 := Y2 + StartYViewPort;
+ if ClipPixels then
+ Begin
+ if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ Col := Byte(CurrentColor);
+ {$ifdef logging2}
+ LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
+ {$endif logging}
+ VLength := y2 - y + 1;
+ {$ifdef logging2}
+ LogLn('length: '+strf(vlength));
+ {$endif logging}
+ if VLength>0 then
+ begin
+ Offs:=(Longint(y)+YOffset)*bytesperline+x;
+ {$ifdef logging2}
+ LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+ {$endif logging}
+ Case CurrentWriteMode of
+ AndPut:
+ Begin
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ SetReadBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+ bankrest := VLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to Bankrest-1 Do
+ begin
+ Mem[WinWriteSeg:word(offs)] :=
+ Mem[WinReadSeg:word(offs)] And Col;
+ inc(offs,bytesperline);
+ end;
+ dec(VLength,l+1);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+ {$endif logging}
+ Until VLength = 0;
+ End;
+ XorPut:
+ Begin
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ SetReadBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+ bankrest := VLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to Bankrest-1 Do
+ begin
+ Mem[WinWriteSeg:word(offs)] :=
+ Mem[WinReadSeg:word(offs)] Xor Col;
+ inc(offs,bytesperline);
+ end;
+ dec(VLength,l+1);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+ {$endif logging}
+ Until VLength = 0;
+ End;
+ OrPut:
+ Begin
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ SetReadBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+ bankrest := VLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to Bankrest-1 Do
+ begin
+ Mem[WinWriteSeg:word(offs)] :=
+ Mem[WinReadSeg:word(offs)] Or Col;
+ inc(offs,bytesperline);
+ end;
+ dec(VLength,l+1);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+ {$endif logging}
+ Until VLength = 0;
+ End;
+ Else
+ Begin
+ If CurrentWriteMode = NotPut Then
+ Col := Not(Col);
+ Repeat
+ curbank := integer(offs shr 16);
+ SetWriteBank(curbank);
+ {$ifdef logging2}
+ LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
+ {$endif logging}
+ If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
+ bankrest := VLength
+ else {the rest won't fit anymore in the current window }
+ bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging}
+ For l := 0 to Bankrest-1 Do
+ begin
+ Mem[WinWriteSeg:word(offs)] := Col;
+ inc(offs,bytesperline);
+ end;
+ dec(VLength,l+1);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
+ {$endif logging}
+ Until VLength = 0;
+ End;
+ End;
+ end;
+ end;
+
+ procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+ {********************************************************}
+ { Draws a horizontal patterned line according to the }
+ { current Fill Settings. }
+ {********************************************************}
+ { Important notes: }
+ { - CurrentColor must be set correctly before entering }
+ { this routine. }
+ {********************************************************}
+ type
+ TVESA256Fill = Record
+ case byte of
+ 0: (data1, data2: longint);
+ 1: (pat: array[0..7] of byte);
+ end;
+
+ var
+ fill: TVESA256Fill;
+ bankrest, l : longint;
+ offs, amount: longint;
+ i : smallint;
+ j : smallint;
+ OldWriteMode : word;
+ TmpFillPattern, patternPos : byte;
+ begin
+ { convert to global coordinates ... }
+ x1 := x1 + StartXViewPort;
+ x2 := x2 + StartXViewPort;
+ y := y + StartYViewPort;
+ { if line was fully clipped then exit...}
+ if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ OldWriteMode := CurrentWriteMode;
+ CurrentWriteMode := NormalPut;
+ { Get the current pattern }
+ TmpFillPattern := FillPatternTable
+ [FillSettings.Pattern][((y + startYViewPort) and $7)+1];
+ {$ifdef logging2}
+ LogLn('patternline '+strf(x1)+' - '+strf(x2)+' on '+strf(y));
+ {$endif logging2}
+ { how long is the line }
+ amount := x2 - x1 + 1;
+ { offset to start at }
+ offs := (longint(y)+yoffset)*bytesperline+x1;
+ { convert the pattern data into the actual color sequence }
+ j := 1;
+ FillChar(fill,sizeOf(fill),byte(currentBkColor));
+ for i := 0 to 7 do
+ begin
+ if TmpFillPattern and j <> 0 then
+ fill.pat[7-i] := currentColor;
+{$ifopt q+}
+{$q-}
+{$define overflowOn}
+{$endif}
+ j := j shl 1;
+{$ifdef overflowOn}
+{$q+}
+{$undef overflowOn}
+{$endif}
+ end;
+ Repeat
+ SetWriteBank(integer(offs shr 16));
+ If (amount > 7) and
+ (((offs and 7) = 0) or
+ (amount > 7+8-(offs and 7))) Then
+ Begin
+ { align target }
+ l := 0;
+ If (offs and 7) <> 0 then
+ { this cannot go past a window boundary bacause the }
+ { size of a window is always a multiple of 8 }
+ Begin
+ { position in the pattern where to start }
+ patternPos := offs and 7;
+ {$ifdef logging2}
+ LogLn('Aligning by drawing '+strf(8-(offs and 7))+' pixels');
+ {$endif logging2}
+ for l := 1 to 8-(offs and 7) do
+ begin
+ Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
+ inc(patternPos)
+ end;
+ End;
+ Dec(amount, l);
+ inc(offs, l);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
+ {$endif logging2}
+ { offs is now 8-bytes alligned }
+ If amount <= ($10000-(Offs and $ffff)) Then
+ bankrest := amount
+ else {the rest won't fit anymore in the current window }
+ bankrest := $10000 - (Offs and $ffff);
+ { it is possible that by aligningm we ended up in a new }
+ { bank, so set the correct bank again to make sure }
+ setwritebank(offs shr 16);
+ {$ifdef logging2}
+ LogLn('Rest to be drawn in this window: '+strf(bankrest));
+ {$endif logging2}
+ for l := 0 to (bankrest div 8)-1 Do
+ begin
+ MemL[WinWriteSeg:word(offs)+l*8] := fill.data1;
+ MemL[WinWriteSeg:word(offs)+l*8+4] := fill.data2;
+ end;
+ inc(offs,l*8+8);
+ dec(amount,l*8+8);
+ {$ifdef logging2}
+ LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
+ {$endif logging2}
+ End
+ Else
+ Begin
+ {$ifdef logging2}
+ LogLn('Drawing leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
+ {$endif logging2}
+ patternPos := offs and 7;
+ For l := 0 to amount - 1 do
+ begin
+ { this may cross a bank at any time, so adjust }
+ { because this loop alwys runs for very little pixels, }
+ { there's little gained by splitting it up }
+ setwritebank(offs shr 16);
+ Mem[WinWriteSeg:word(offs)] := fill.pat[patternPos and 7];
+ inc(offs);
+ inc(patternPos);
+ end;
+ amount := 0;
+ End
+ Until amount = 0;
+ currentWriteMode := oldWriteMode;
+ end;
+
+
+ {************************************************************************}
+ {* 256 colors VESA mode routines Linear mode *}
+ {************************************************************************}
+{$ifdef FPC}
+type
+ pbyte = ^byte;
+ pword = ^word;
+
+ procedure DirectPutPixVESA256Linear(x, y : integer); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ col : byte;
+ begin
+ offs := longint(y) * BytesPerLine + x;
+ Case CurrentWriteMode of
+ XorPut:
+ Begin
+ if UseNoSelector then
+ col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+ col := col xor byte(CurrentColor);
+ End;
+ AndPut:
+ Begin
+ if UseNoSelector then
+ col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+ col := col and byte(CurrentColor);
+ End;
+ OrPut:
+ Begin
+ if UseNoSelector then
+ col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+ col := col or byte(CurrentColor);
+ End
+ else
+ Begin
+ If CurrentWriteMode <> NotPut then
+ col := Byte(CurrentColor)
+ else col := Not(Byte(CurrentColor));
+ End
+ End;
+ if UseNoSelector then
+ pbyte(LFBPointer+offs+LinearPageOfs)^:=col
+ else
+ seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
+ end;
+
+ procedure PutPixVESA256Linear(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ offs := longint(y) * BytesPerLine + x;
+ {$ifdef logging}
+ logln('putpix offset: '+hexstr(offs,8)+', color: '+strf(color)+', lpo: $'+
+ hexstr(LinearPageOfs,8));
+ {$endif logging}
+ if UseNoSelector then
+ pbyte(LFBPointer+offs+LinearPageOfs)^:=byte(color)
+ else
+ seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
+ end;
+
+ function GetPixVESA256Linear(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ col : byte;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ offs := longint(y) * BytesPerLine + x;
+ {$ifdef logging}
+ logln('getpix offset: '+hexstr(offs,8)+', lpo: $'+
+ hexstr(LinearPageOfs,8));
+ {$endif logging}
+ if UseNoSelector then
+ col:=pbyte(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
+ GetPixVESA256Linear:=col;
+ end;
+(*
+function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
+var
+ dregs : registers;
+begin
+ if PageNum>VesaModeInfo.NumberOfPages then
+ PageNum:=0;
+{$ifdef DEBUG}
+ if PageNum>0 then
+ writeln(stderr,'Setting Display Page ',PageNum);
+{$endif DEBUG}
+ dregs.RealEBX:=0{ $80 for Wait for retrace };
+ dregs.RealECX:=x;
+ dregs.RealEDX:=y+PageNum*maxy;
+ dregs.RealSP:=0;
+ dregs.RealSS:=0;
+ dregs.RealEAX:=$4F07; RealIntr($10,dregs);
+ { idem as above !!! }
+ if (dregs.RealEAX and $1FF) <> $4F then
+ begin
+{$ifdef DEBUG}
+ writeln(stderr,'Set Display start error');
+{$endif DEBUG}
+ SetVESADisplayStart:=false;
+ end
+ else
+ SetVESADisplayStart:=true;
+end;
+*)
+{$endif FPC}
+
+
+ {************************************************************************}
+ {* 15/16bit pixels VESA mode routines *}
+ {************************************************************************}
+
+ procedure PutPixVESA32kOr64k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ begin
+{$ifdef logging}
+ logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
+{$endif logging}
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ Y := Y + YOffset; { adjust pixel for correct virtual page }
+ offs := longint(y) * BytesPerLine + 2*x;
+ SetWriteBank(integer(offs shr 16));
+{$ifdef logging}
+ logln('putpixvesa32kor64k offset: '+strf(word(offs)));
+{$endif logging}
+ memW[WinWriteSeg : word(offs)] := color;
+ end;
+
+ function GetPixVESA32kOr64k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort + YOffset;
+ offs := longint(y) * BytesPerLine + 2*x;
+ SetReadBank(integer(offs shr 16));
+ GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
+ end;
+
+ procedure DirectPutPixVESA32kOr64k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ col : word;
+ begin
+{$ifdef logging}
+ logln('directputpixvesa32kor64k('+strf(x)+','+strf(y)+')');
+{$endif logging}
+ y:= Y + YOffset;
+ offs := longint(y) * BytesPerLine + 2*x;
+ SetWriteBank(integer((offs shr 16) and $ff));
+ Case CurrentWriteMode of
+ XorPut:
+ Begin
+ SetReadBank(integer(offs shr 16));
+ memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
+ End;
+ AndPut:
+ Begin
+ SetReadBank(integer(offs shr 16));
+ memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
+ End;
+ OrPut:
+ Begin
+ SetReadBank(integer(offs shr 16));
+ memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
+ End
+ else
+ Begin
+ If CurrentWriteMode <> NotPut Then
+ col := CurrentColor
+ Else col := Not(CurrentColor);
+{$ifdef logging}
+ logln('directputpixvesa32kor64k offset: '+strf(word(offs)));
+{$endif logging}
+ memW[WinWriteSeg : word(offs)] := Col;
+ End
+ End;
+ end;
+
+{$ifdef FPC}
+ {************************************************************************}
+ {* 15/16bit pixels VESA mode routines Linear mode *}
+ {************************************************************************}
+
+ procedure PutPixVESA32kor64kLinear(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ offs := longint(y) * BytesPerLine + 2*x;
+ if UseNoSelector then
+ pword(LFBPointer+offs+LinearPageOfs)^:=color
+ else
+ seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
+ end;
+
+ function GetPixVESA32kor64kLinear(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ color : word;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ offs := longint(y) * BytesPerLine + 2*x;
+ if UseNoSelector then
+ color:=pword(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@color),2);
+ GetPixVESA32kor64kLinear:=color;
+ end;
+
+ procedure DirectPutPixVESA32kor64kLinear(x, y : integer); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ col : word;
+ begin
+ offs := longint(y) * BytesPerLine + 2*x;
+ Case CurrentWriteMode of
+ XorPut:
+ Begin
+ if UseNoSelector then
+ col:=pword(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
+ col := col xor currentcolor;
+ End;
+ AndPut:
+ Begin
+ if UseNoSelector then
+ col:=pword(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
+ col := col and currentcolor;
+ End;
+ OrPut:
+ Begin
+ if UseNoSelector then
+ col:=pword(LFBPointer+offs+LinearPageOfs)^
+ else
+ seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
+ col := col or currentcolor;
+ End
+ else
+ Begin
+ If CurrentWriteMode <> NotPut Then
+ col := CurrentColor
+ Else col := Not(CurrentColor);
+ End
+ End;
+ if UseNoSelector then
+ pword(LFBPointer+offs+LinearPageOfs)^:=col
+ else
+ seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
+ end;
+
+{$endif FPC}
+
+ {************************************************************************}
+ {* 4-bit pixels VESA mode routines *}
+ {************************************************************************}
+
+ procedure PutPixVESA16(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ dummy : byte;
+ begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ Begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ Y := Y + YOffset; { adjust pixel for correct virtual page }
+ { }
+ offs := longint(y) * BytesPerLine + (x div 8);
+ SetWriteBank(integer(offs shr 16));
+
+ PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
+ PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
+
+ Port[$3ce] := 8; { Index 08 : Bitmask register. }
+ Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
+
+ dummy := Mem[WinWriteSeg: offs]; { Latch the data into host space. }
+ Mem[WinWriteSeg: offs] := dummy; { Write the data into video memory }
+ PortW[$3ce] := $ff08; { Enable all bit planes. }
+ PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
+ { }
+ end;
+
+
+ Function GetPixVESA16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
+ Var dummy, offset: Word;
+ shift: byte;
+ Begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort + YOffset;
+ offset := longint(Y) * BytesPerLine + (x div 8);
+ SetReadBank(integer(offset shr 16));
+ Port[$3ce] := 4;
+ shift := 7 - (X and 7);
+ Port[$3cf] := 0;
+ dummy := (Mem[WinReadSeg:offset] shr shift) and 1;
+ Port[$3cf] := 1;
+ dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 1);
+ Port[$3cf] := 2;
+ dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 2);
+ Port[$3cf] := 3;
+ dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 3);
+ GetPixVESA16 := dummy;
+ end;
+
+
+ procedure DirectPutPixVESA16(x, y : integer); {$ifndef fpc}far;{$endif fpc}
+ var
+ offs : longint;
+ dummy : byte;
+ Color : word;
+ begin
+ y:= Y + YOffset;
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor Xor Color;
+ end;
+ OrPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor Or Color;
+ end;
+ AndPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor And Color;
+ end;
+ NotPut:
+ begin
+ Color := Not Color;
+ end
+ else
+ Color := CurrentColor;
+ end;
+ offs := longint(y) * BytesPerLine + (x div 8);
+ SetWriteBank(integer(offs shr 16));
+ PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
+ PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
+
+ Port[$3ce] := 8; { Index 08 : Bitmask register. }
+ Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
+
+ dummy := Mem[WinWriteSeg: offs]; { Latch the data into host space. }
+ Mem[WinWriteSeg: offs] := dummy; { Write the data into video memory }
+ PortW[$3ce] := $ff08; { Enable all bit planes. }
+ PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
+ end;
+
+
+
+
+ {************************************************************************}
+ {* VESA Palette entries *}
+ {************************************************************************}
+
+
+{$IFDEF DPMI}
+{$ifdef fpc}
+ Procedure SetVESARGBAllPalette(const Palette:PaletteType);
+ var
+ pal: array[0..255] of palrec;
+ regs: TDPMIRegisters;
+ c, Ptr: longint;
+ RealSeg: word;
+ FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
+ begin
+ if DirectColor then
+ Begin
+ _GraphResult := grError;
+ exit;
+ end;
+ { use the set/get palette function }
+ if VESAInfo.Version >= $0200 then
+ Begin
+ { check if blanking bit must be set when programming }
+ { the RAMDAC. }
+ if (VESAInfo.caps and attrSnowCheck) <> 0 then
+ FunctionNr := $80
+ else
+ FunctionNr := $00;
+
+ fillChar(pal,sizeof(pal),0);
+ { Convert to vesa format }
+ for c := 0 to 255 do
+ begin
+ pal[c].red := byte(palette.colors[c].red);
+ pal[c].green := byte(palette.colors[c].green);
+ pal[c].blue := byte(palette.colors[c].blue);
+ end;
+
+ { Alllocate real mode buffer }
+ Ptr:=Global_Dos_Alloc(sizeof(pal));
+ {get the segment value}
+ RealSeg := word(Ptr shr 16);
+ { setup interrupt registers }
+ FillChar(regs, sizeof(regs), #0);
+ { copy palette values to real mode buffer }
+ DosMemPut(RealSeg,0,pal,sizeof(pal));
+ regs.eax := $4F09;
+ regs.ebx := FunctionNr;
+ regs.ecx := 256;
+ regs.edx := 0;
+ regs.es := RealSeg;
+ regs.edi := 0; { offset is always zero }
+ RealIntr($10, regs);
+
+ { free real mode memory }
+ If not Global_Dos_Free(word(Ptr and $ffff)) then
+ RunError(216);
+
+ if word(regs.eax) <> $004F then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ end
+ else
+ { assume it's fully VGA compatible palette-wise. }
+ Begin
+ SetVGARGBAllPalette(palette);
+ end;
+ setallpalettedefault(palette);
+ end;
+{$endif fpc}
+
+ Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
+ BlueValue : Integer);
+ var
+ pal: palrec;
+ regs: TDPMIRegisters;
+ Ptr: longint;
+{$ifndef fpc}
+ PalPtr : ^PalRec;
+{$endif fpc}
+ RealSeg: word;
+ FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
+ begin
+ if DirectColor then
+ Begin
+{$ifdef logging}
+ logln('setvesargbpalette called with directcolor = true');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+ pal.align := 0;
+ pal.red := byte(RedValue) shr 2;
+ pal.green := byte(GreenValue) shr 2;
+ pal.blue := byte(BlueValue) shr 2;
+ { use the set/get palette function }
+ if VESAInfo.Version >= $0200 then
+ Begin
+ { check if blanking bit must be set when programming }
+ { the RAMDAC. }
+ if (VESAInfo.caps and attrSnowCheck) <> 0 then
+ FunctionNr := $80
+ else
+ FunctionNr := $00;
+
+ { Alllocate real mode buffer }
+{$ifndef fpc}
+ Ptr:=GlobalDosAlloc(sizeof(palrec));
+ { get the selector values }
+ PalPtr := pointer(Ptr shl 16);
+ if not assigned(PalPtr) then
+ RunError(203);
+{$else fpc}
+ Ptr:=Global_Dos_Alloc(sizeof(palrec));
+{$endif fpc}
+ {get the segment value}
+ RealSeg := word(Ptr shr 16);
+ { setup interrupt registers }
+ FillChar(regs, sizeof(regs), #0);
+ { copy palette values to real mode buffer }
+{$ifndef fpc}
+ move(pal, palptr^, sizeof(pal));
+{$else fpc}
+ DosMemPut(RealSeg,0,pal,sizeof(pal));
+{$endif fpc}
+ regs.eax := $4F09;
+ regs.ebx := FunctionNr;
+ regs.ecx := $01;
+ regs.edx := ColorNum;
+ regs.es := RealSeg;
+ regs.edi := 0; { offset is always zero }
+ RealIntr($10, regs);
+
+ { free real mode memory }
+{$ifndef fpc}
+ GlobalDosFree(word(Ptr and $ffff));
+{$else fpc}
+ If not Global_Dos_Free(word(Ptr and $ffff)) then
+ RunError(216);
+{$endif fpc}
+
+ if word(regs.eax) <> $004F then
+ begin
+{$ifdef logging}
+ logln('setvesargbpalette failed while directcolor = false!');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+ end
+ else
+ { assume it's fully VGA compatible palette-wise. }
+ Begin
+ SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+ end;
+ end;
+
+
+ Procedure GetVESARGBPalette(ColorNum: integer; Var
+ RedValue, GreenValue, BlueValue : integer);
+ var
+ pal: PalRec;
+{$ifndef fpc}
+ palptr : ^PalRec;
+{$endif fpc}
+ regs : TDPMIRegisters;
+ RealSeg: word;
+ ptr: longint;
+ begin
+ if DirectColor then
+ Begin
+{$ifdef logging}
+ logln('getvesargbpalette called with directcolor = true');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+ { use the set/get palette function }
+ if VESAInfo.Version >= $0200 then
+ Begin
+ { Alllocate real mode buffer }
+{$ifndef fpc}
+ Ptr:=GlobalDosAlloc(sizeof(palrec));
+ { get the selector value }
+ PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
+ if not assigned(PalPtr) then
+ RunError(203);
+{$else fpc}
+ Ptr:=Global_Dos_Alloc(sizeof(palrec));
+{$endif fpc}
+ { get the segment value }
+ RealSeg := word(Ptr shr 16);
+ { setup interrupt registers }
+ FillChar(regs, sizeof(regs), #0);
+
+ regs.eax := $4F09;
+ regs.ebx := $01; { get palette data }
+ regs.ecx := $01;
+ regs.edx := ColorNum;
+ regs.es := RealSeg;
+ regs.edi := 0; { offset is always zero }
+ RealIntr($10, regs);
+
+ { copy to protected mode buffer ... }
+{$ifndef fpc}
+ Move(PalPtr^, Pal, sizeof(pal));
+{$else fpc}
+ DosMemGet(RealSeg,0,Pal,sizeof(pal));
+{$endif fpc}
+ { free real mode memory }
+{$ifndef fpc}
+ GlobalDosFree(word(Ptr and $ffff));
+{$else fpc}
+ If not Global_Dos_Free(word(Ptr and $ffff)) then
+ RunError(216);
+{$endif fpc}
+
+ if word(regs.eax) <> $004F then
+ begin
+{$ifdef logging}
+ logln('getvesargbpalette failed while directcolor = false!');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end
+ else
+ begin
+ RedValue := Integer(pal.Red);
+ GreenValue := Integer(pal.Green);
+ BlueValue := Integer(pal.Blue);
+ end;
+ end
+ else
+ GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+ end;
+{$ELSE}
+
+ Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
+ BlueValue : Integer); far;
+ var
+ FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
+ pal: ^palrec;
+ Error : boolean; { VBE call error }
+ begin
+ if DirectColor then
+ Begin
+ _GraphResult := grError;
+ exit;
+ end;
+ Error := FALSE;
+ new(pal);
+ if not assigned(pal) then RunError(203);
+ pal^.align := 0;
+ pal^.red := byte(RedValue);
+ pal^.green := byte(GreenValue);
+ pal^.blue := byte(BlueValue);
+ { use the set/get palette function }
+ if VESAInfo.Version >= $0200 then
+ Begin
+ { check if blanking bit must be set when programming }
+ { the RAMDAC. }
+ if (VESAInfo.caps and attrSnowCheck) <> 0 then
+ FunctionNr := $80
+ else
+ FunctionNr := $00;
+ asm
+ mov ax, 4F09h { Set/Get Palette data }
+ mov bl, [FunctionNr] { Set palette data }
+ mov cx, 01h { update one palette reg. }
+ mov dx, [ColorNum] { register number to update }
+ les di, [pal] { get palette address }
+ int 10h
+ cmp ax, 004Fh { check if success }
+ jz @noerror
+ mov [Error], TRUE
+ @noerror:
+ end;
+ if not Error then
+ Dispose(pal)
+ else
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ end
+ else
+ { assume it's fully VGA compatible palette-wise. }
+ Begin
+ SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+ end;
+ end;
+
+
+
+
+ Procedure GetVESARGBPalette(ColorNum: integer; Var RedValue, GreenValue,
+ BlueValue : integer); far;
+ var
+ Error: boolean;
+ pal: ^palrec;
+ begin
+ if DirectColor then
+ Begin
+ _GraphResult := grError;
+ exit;
+ end;
+ Error := FALSE;
+ new(pal);
+ if not assigned(pal) then RunError(203);
+ FillChar(pal^, sizeof(palrec), #0);
+ { use the set/get palette function }
+ if VESAInfo.Version >= $0200 then
+ Begin
+ asm
+ mov ax, 4F09h { Set/Get Palette data }
+ mov bl, 01h { Set palette data }
+ mov cx, 01h { update one palette reg. }
+ mov dx, [ColorNum] { register number to update }
+ les di, [pal] { get palette address }
+ int 10h
+ cmp ax, 004Fh { check if success }
+ jz @noerror
+ mov [Error], TRUE
+ @noerror:
+ end;
+ if not Error then
+ begin
+ RedValue := Integer(pal^.Red);
+ GreenValue := Integer(pal^.Green);
+ BlueValue := Integer(pal^.Blue);
+ Dispose(pal);
+ end
+ else
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ end
+ else
+ GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
+
+ end;
+{$ENDIF}
+
+
+(*
+type
+ heaperrorproc=function(size:longint):integer;
+
+Const
+ HeapErrorIsHooked : boolean = false;
+ OldHeapError : HeapErrorProc = nil;
+ DsLimit : dword = 0;
+
+ function NewHeapError(size : longint) : integer;
+ begin
+ set_segment_limit(get_ds,DsLimit);
+ NewHeapError:=OldHeapError(size);
+ DsLimit:=get_segment_limit(get_ds);
+ { The base of ds can be changed
+ we need to compute the address again PM }
+ LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
+ if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > DsLimit then
+ set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
+ end;
+
+ procedure HookHeapError;
+ begin
+ if HeapErrorIsHooked then
+ exit;
+ DsLimit:=get_segment_limit(get_ds);
+ OldHeapError:=HeapErrorProc(HeapError);
+ HeapError:=@NewHeapError;
+ HeapErrorIsHooked:=true;
+ end;
+
+ procedure UnHookHeapError;
+ begin
+ if not HeapErrorIsHooked then
+ exit;
+ LFBPointer:=nil;
+ set_segment_limit(get_ds,DsLimit);
+ HeapError:=OldHeapError;
+ HeapErrorIsHooked:=false;
+ end;
+*)
+
+ function SetupLinear(var ModeInfo: TVESAModeInfo;mode : word) : boolean;
+ begin
+ SetUpLinear:=false;
+{$ifdef FPC}
+ case mode of
+ m320x200x32k,
+ m320x200x64k,
+ m640x480x32k,
+ m640x480x64k,
+ m800x600x32k,
+ m800x600x64k,
+ m1024x768x32k,
+ m1024x768x64k,
+ m1280x1024x32k,
+ m1280x1024x64k :
+ begin
+ DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
+ PutPixel:=@PutPixVESA32kor64kLinear;
+ GetPixel:=@GetPixVESA32kor64kLinear;
+ { linear mode for lines not yet implemented PM }
+ HLine:=@HLineDefault;
+ VLine:=@VLineDefault;
+ GetScanLine := @GetScanLineDefault;
+ PatternLine := @PatternLineDefault;
+ end;
+ m640x400x256,
+ m640x480x256,
+ m800x600x256,
+ m1024x768x256,
+ m1280x1024x256:
+ begin
+ DirectPutPixel:=@DirectPutPixVESA256Linear;
+ PutPixel:=@PutPixVESA256Linear;
+ GetPixel:=@GetPixVESA256Linear;
+ { linear mode for lines not yet implemented PM }
+ HLine:=@HLineDefault;
+ VLine:=@VLineDefault;
+ GetScanLine := @GetScanLineDefault;
+ PatternLine := @PatternLineDefault;
+ end;
+ else
+ exit;
+ end;
+ FrameBufferLinearAddress:=Get_linear_addr(VESAModeInfo.PhysAddress and $FFFF0000,
+ VESAInfo.TotalMem shl 16);
+{$ifdef logging}
+ logln('framebuffer linear address: '+hexstr(FrameBufferLinearAddress div (1024*1024),8));
+ logln('total mem shl 16: '+strf(vesainfo.totalmem shl 16));
+{$endif logging}
+ if int31error<>0 then
+ begin
+{$ifdef logging}
+ logln('Unable to get linear address for '+hexstr(VESAModeInfo.PhysAddress,8));
+{$endif logging}
+ writeln(stderr,'Unable to get linear address for ',hexstr(VESAModeInfo.PhysAddress,8));
+ exit;
+ end;
+ if UseNoSelector then
+ begin
+{ HookHeapError; }
+ LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
+ if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > dword(get_segment_limit(get_ds)) then
+ set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
+ end
+ else
+ begin
+ WinWriteSeg:=allocate_ldt_descriptors(1);
+{$ifdef logging}
+ logln('writeseg1: '+hexstr(winwriteseg,8));
+{$endif logging}
+ set_segment_base_address(WinWriteSeg,FrameBufferLinearAddress);
+ set_segment_limit(WinWriteSeg,(VESAInfo.TotalMem shl 16)-1);
+ lock_linear_region(FrameBufferLinearAddress,(VESAInfo.TotalMem shl 16));
+ if int31error<>0 then
+ begin
+{$ifdef logging}
+ logln('Error in linear memory selectors creation');
+{$endif logging}
+ writeln(stderr,'Error in linear memory selectors creation');
+ exit;
+ end;
+ end;
+ LinearPageOfs := 0;
+ InLinear:=true;
+ SetUpLinear:=true;
+ { WinSize:=(VGAInfo.TotalMem shl 16);
+ WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
+ WinShift:=15;
+ Temp:=VGAInfo.TotalMem;
+ while Temp>0 do
+ begin
+ inc(WinShift);
+ Temp:=Temp shr 1;
+ end; }
+{$endif FPC}
+ end;
+
+ procedure SetupWindows(var ModeInfo: TVESAModeInfo);
+ begin
+ InLinear:=false;
+ { now we check the windowing scheme ...}
+ if (ModeInfo.WinAAttr and WinSupported) <> 0 then
+ { is this window supported ... }
+ begin
+ { now check if the window is R/W }
+ if (ModeInfo.WinAAttr and WinReadable) <> 0 then
+ begin
+ ReadWindow := 0;
+ WinReadSeg := ModeInfo.WinASeg;
+ end;
+ if (ModeInfo.WinAAttr and WinWritable) <> 0 then
+ begin
+ WriteWindow := 0;
+ WinWriteSeg := ModeInfo.WinASeg;
+ end;
+ end;
+ if (ModeInfo.WinBAttr and WinSupported) <> 0 then
+ { is this window supported ... }
+ begin
+
+ { OPTIMIZATION ... }
+ { if window A supports both read/write, then we try to optimize }
+ { everything, by using a different window for Read and/or write.}
+ if (WinReadSeg <> 0) and (WinWriteSeg <> 0) then
+ begin
+ { check if winB supports read }
+ if (ModeInfo.WinBAttr and winReadable) <> 0 then
+ begin
+ WinReadSeg := ModeInfo.WinBSeg;
+ ReadWindow := 1;
+ end
+ else
+ { check if WinB supports write }
+ if (ModeInfo.WinBAttr and WinWritable) <> 0 then
+ begin
+ WinWriteSeg := ModeInfo.WinBSeg;
+ WriteWindow := 1;
+ end;
+ end
+ else
+ { Window A only supported Read OR Write, no we have to make }
+ { sure that window B supports the other mode. }
+ if (WinReadSeg = 0) and (WinWriteSeg<>0) then
+ begin
+ if (ModeInfo.WinBAttr and WinReadable <> 0) then
+ begin
+ ReadWindow := 1;
+ WinReadSeg := ModeInfo.WinBSeg;
+ end
+ else
+ { impossible, this VESA mode is WRITE only! }
+ begin
+ WriteLn('Invalid VESA Window attribute.');
+ Halt(255);
+ end;
+ end
+ else
+ if (winWriteSeg = 0) and (WinReadSeg<>0) then
+ begin
+ if (ModeInfo.WinBAttr and WinWritable) <> 0 then
+ begin
+ WriteWindow := 1;
+ WinWriteSeg := ModeInfo.WinBSeg;
+ end
+ else
+ { impossible, this VESA mode is READ only! }
+ begin
+ WriteLn('Invalid VESA Window attribute.');
+ Halt(255);
+ end;
+ end
+ else
+ if (winReadSeg = 0) and (winWriteSeg = 0) then
+ { no read/write in this mode! }
+ begin
+ WriteLn('Invalid VESA Window attribute.');
+ Halt(255);
+ end;
+ YOffset := 0;
+ end;
+
+ { if both windows are not supported, then we can assume }
+ { that there is ONE single NON relocatable window. }
+ if (WinWriteSeg = 0) and (WinReadSeg = 0) then
+ begin
+ WinWriteSeg := ModeInfo.WinASeg;
+ WinReadSeg := ModeInfo.WinASeg;
+ end;
+
+ { 16-bit Protected mode checking code... }
+ { change segment values to protected mode }
+ { selectors. }
+ if WinReadSeg = $A000 then
+ WinReadSeg := SegA000
+ else
+ if WinReadSeg = $B000 then
+ WinReadSeg := SegB000
+ else
+ if WinReadSeg = $B800 then
+ WinReadSeg := SegB800
+ else
+ begin
+ WriteLn('Invalid segment address.');
+ Halt(255);
+ end;
+ if WinWriteSeg = $A000 then
+ WinWriteSeg := SegA000
+ else
+ if WinWriteSeg = $B000 then
+ WinWriteSeg := SegB000
+ else
+ if WinWriteSeg = $B800 then
+ WinWriteSeg := SegB800
+ else
+ begin
+ WriteLn('Invalid segment address.');
+ Halt(255);
+ end;
+
+ end;
+
+
+
+ function setVESAMode(mode:word):boolean;
+ var i:word;
+ res: boolean;
+ begin
+ { Init mode information, for compatibility with VBE < 1.1 }
+ FillChar(VESAModeInfo, sizeof(TVESAModeInfo), #0);
+ { get the video mode information }
+ if getVESAModeInfo(VESAmodeinfo, mode) then
+ begin
+ { checks if the hardware supports the video mode. }
+ if (VESAModeInfo.attr and modeAvail) = 0 then
+ begin
+ SetVESAmode := FALSE;
+{$ifdef logging}
+ logln(' vesa mode '+strf(mode)+' not supported!!!');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+
+ SetVESAMode := TRUE;
+ BankShift := 0;
+ while (64 shr BankShift) <> VESAModeInfo.WinGranularity do
+ Inc(BankShift);
+ CurrentWriteBank := -1;
+ CurrentReadBank := -1;
+ BytesPerLine := VESAModeInfo.BytesPerScanLine;
+
+ { These are the window adresses ... }
+ WinWriteSeg := 0; { This is the segment to use for writes }
+ WinReadSeg := 0; { This is the segment to use for reads }
+ ReadWindow := 0;
+ WriteWindow := 0;
+
+ { VBE 2.0 and higher supports >= non VGA linear buffer types...}
+ { this is backward compatible. }
+ if (((VESAModeInfo.Attr and ModeNoWindowed) <> 0) or UseLFB) and
+ ((VESAModeInfo.Attr and ModeLinearBuffer) <> 0) then
+ begin
+ if not SetupLinear(VESAModeInfo,mode) then
+ SetUpWindows(VESAModeInfo);
+ end
+ else
+ { if linear and windowed is supported, then use windowed }
+ { method. }
+ SetUpWindows(VESAModeInfo);
+
+{$ifdef logging}
+ LogLn('Entering vesa mode '+strf(mode));
+ LogLn('Read segment: $'+hexstr(winreadseg,4));
+ LogLn('Write segment: $'+hexstr(winwriteseg,4));
+ LogLn('Window granularity: '+strf(VESAModeInfo.WinGranularity)+'kb');
+ LogLn('Window size: '+strf(VESAModeInfo.winSize)+'kb');
+ LogLn('Bytes per line: '+strf(bytesperline));
+{$endif logging}
+ { Select the correct mode number if we're going to use linear access! }
+ if InLinear then
+ inc(mode,$4000);
+
+ asm
+ mov ax,4F02h
+ mov bx,mode
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ sub ax,004Fh
+ cmp ax,1
+ sbb al,al
+ mov res,al
+ end;
+ if not res then
+ _GraphResult := GrNotDetected
+ else _GraphResult := grOk;
+ end;
+ end;
+
+(*
+ function getVESAMode:word;assembler;
+ asm {return -1 if error}
+ mov ax,4F03h
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ cmp ax,004Fh
+ je @@OK
+ mov ax,-1
+ jmp @@X
+ @@OK:
+ mov ax,bx
+ @@X:
+ end;
+*)
+
+
+
+ {************************************************************************}
+ {* VESA Modes inits *}
+ {************************************************************************}
+
+{$IFDEF DPMI}
+
+ {******************************************************** }
+ { Function GetMaxScanLines() }
+ {-------------------------------------------------------- }
+ { This routine returns the maximum number of scan lines }
+ { possible for this mode. This is done using the Get }
+ { Scan Line length VBE function. }
+ {******************************************************** }
+ function GetMaxScanLines: word;
+ var
+ regs : TDPMIRegisters;
+ begin
+ FillChar(regs, sizeof(regs), #0);
+ { play it safe, call the real mode int, the 32-bit entry point }
+ { may not be defined as stated in VBE v3.0 }
+ regs.eax := $4f06; {_ setup function }
+ regs.ebx := $0001; { get scan line length }
+ RealIntr($10, regs);
+ GetMaxScanLines := (regs.edx and $0000ffff);
+ end;
+
+{$ELSE}
+
+ function GetMaxScanLines: word; assembler;
+ asm
+ mov ax, 4f06h
+ mov bx, 0001h
+ int 10h
+ mov ax, dx
+ end;
+
+{$ENDIF}
+
+ procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVesaMode(m1280x1024x64k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m1280x1024x32k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m1280x1024x256);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+
+ procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m1280x1024x16);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m1024x768x64k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m640x480x32k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m1024x768x256);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m1024x768x16);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m800x600x64k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m800x600x32k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m800x600x256);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVesaMode(m800x600x16);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m640x480x64k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+
+ procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m640x480x256);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m640x400x256);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m320x200x64k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+ procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
+ begin
+ SetVESAMode(m320x200x32k);
+ { Get maximum number of scanlines for page flipping }
+ ScanLines := GetMaxScanLines;
+ end;
+
+
+{$IFDEF DPMI}
+
+ Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
+ var
+ PtrLong: longint;
+ regs: TDPMIRegisters;
+ begin
+ SaveSupported := FALSE;
+ SavePtr := nil;
+{$ifdef logging}
+ LogLn('Get the video mode...');
+{$endif logging}
+ { Get the video mode }
+ asm
+ mov ah,0fh
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ mov [VideoMode], al
+ end;
+ { saving/restoring video state screws up Windows (JM) }
+ if inWindows then
+ exit;
+{$ifdef logging}
+ LogLn('Prepare to save VESA video state');
+{$endif logging}
+ { Prepare to save video state...}
+ asm
+ mov ax, 4F04h { get buffer size to save state }
+ mov dx, 00h
+ mov cx, 00001111b { Save DAC / Data areas / Hardware states }
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ mov [StateSize], bx
+ cmp al,04fh
+ jnz @notok
+ mov [SaveSupported],TRUE
+ @notok:
+ end;
+ regs.eax := $4f04;
+ regs.edx := $0000;
+ regs.ecx := $000F;
+ RealIntr($10, regs);
+ StateSize := word(regs.ebx);
+ if byte(regs.eax) = $4f then
+ SaveSupported := TRUE;
+ if SaveSupported then
+ begin
+{$ifdef logging}
+ LogLn('allocating VESA save buffer of '+strf(64*StateSize));
+{$endif logging}
+{$ifndef fpc}
+ PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
+{$else fpc}
+ PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
+{$endif fpc}
+ if PtrLong = 0 then
+ RunError(203);
+ SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
+{$ifndef fpc}
+ { In FPC mode, we can't do anything with this (no far pointers) }
+ { However, we still need to keep it to be able to free the }
+ { memory afterwards. Since this data is not accessed in PM code, }
+ { there's no need to save it in a seperate buffer (JM) }
+ if not assigned(SavePtr) then
+ RunError(203);
+{$endif fpc}
+ RealStateSeg := word(PtrLong shr 16);
+
+ FillChar(regs, sizeof(regs), #0);
+ { call the real mode interrupt ... }
+ regs.eax := $4F04; { save the state buffer }
+ regs.ecx := $0F; { Save DAC / Data areas / Hardware states }
+ regs.edx := $01; { save state }
+ regs.es := RealStateSeg;
+ regs.ebx := 0;
+ RealIntr($10,regs);
+ FillChar(regs, sizeof(regs), #0);
+ { restore state, according to Ralph Brown Interrupt list }
+ { some BIOS corrupt the hardware after a save... }
+ regs.eax := $4F04; { restore the state buffer }
+ regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
+ regs.edx := $02;
+ regs.es := RealStateSeg;
+ regs.ebx := 0;
+ RealIntr($10,regs);
+ end;
+ end;
+
+ procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
+ var
+ regs:TDPMIRegisters;
+ begin
+ { go back to the old video mode...}
+ asm
+ mov ah,00
+ mov al,[VideoMode]
+{$ifdef fpc}
+ push ebp
+{$endif fpc}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif fpc}
+ end;
+ { then restore all state information }
+{$ifndef fpc}
+ if assigned(SavePtr) and (SaveSupported=TRUE) then
+{$else fpc}
+ { No far pointer support, so it's possible that that assigned(SavePtr) }
+ { would return false under FPC. Just check if it's different from nil. }
+ if (SavePtr <> nil) and (SaveSupported=TRUE) then
+{$endif fpc}
+ begin
+ FillChar(regs, sizeof(regs), #0);
+ { restore state, according to Ralph Brown Interrupt list }
+ { some BIOS corrupt the hardware after a save... }
+ regs.eax := $4F04; { restore the state buffer }
+ regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
+ regs.edx := $02; { restore state }
+ regs.es := RealStateSeg;
+ regs.ebx := 0;
+ RealIntr($10,regs);
+{$ifndef fpc}
+ if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
+{$else fpc}
+ if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
+{$endif fpc}
+ RunError(216);
+ SavePtr := nil;
+ end;
+ end;
+
+{$ELSE}
+
+ {**************************************************************}
+ {* Real mode routines *}
+ {**************************************************************}
+
+ Procedure SaveStateVESA; far;
+ begin
+ SavePtr := nil;
+ SaveSupported := FALSE;
+ { Get the video mode }
+ asm
+ mov ah,0fh
+ int 10h
+ mov [VideoMode], al
+ end;
+ { Prepare to save video state...}
+ asm
+ mov ax, 4f04h { get buffer size to save state }
+ mov cx, 00001111b { Save DAC / Data areas / Hardware states }
+ mov dx, 00h
+ int 10h
+ mov [StateSize], bx
+ cmp al,04fh
+ jnz @notok
+ mov [SaveSupported],TRUE
+ @notok:
+ end;
+ if SaveSupported then
+ Begin
+ GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
+ if not assigned(SavePtr) then
+ RunError(203);
+ asm
+ mov ax, 4F04h { save the state buffer }
+ mov cx, 00001111b { Save DAC / Data areas / Hardware states }
+ mov dx, 01h
+ mov es, WORD PTR [SavePtr+2]
+ mov bx, WORD PTR [SavePtr]
+ int 10h
+ end;
+ { restore state, according to Ralph Brown Interrupt list }
+ { some BIOS corrupt the hardware after a save... }
+ asm
+ mov ax, 4F04h { save the state buffer }
+ mov cx, 00001111b { Save DAC / Data areas / Hardware states }
+ mov dx, 02h
+ mov es, WORD PTR [SavePtr+2]
+ mov bx, WORD PTR [SavePtr]
+ int 10h
+ end;
+ end;
+ end;
+
+ procedure RestoreStateVESA; far;
+ begin
+ { go back to the old video mode...}
+ asm
+ mov ah,00
+ mov al,[VideoMode]
+ int 10h
+ end;
+
+ { then restore all state information }
+ if assigned(SavePtr) and (SaveSupported=TRUE) then
+ begin
+ { restore state, according to Ralph Brown Interrupt list }
+ asm
+ mov ax, 4F04h { save the state buffer }
+ mov cx, 00001111b { Save DAC / Data areas / Hardware states }
+ mov dx, 02h { restore state }
+ mov es, WORD PTR [SavePtr+2]
+ mov bx, WORD PTR [SavePtr]
+ int 10h
+ end;
+ FreeMem(SavePtr, 64*StateSize);
+ SavePtr := nil;
+ end;
+ end;
+{$ENDIF DPMI}
+
+ {************************************************************************}
+ {* VESA Page flipping routines *}
+ {************************************************************************}
+ { Note: These routines, according to the VBE3 specification, will NOT }
+ { work with the 24 bpp modes, because of the alignment. }
+ {************************************************************************}
+
+ {******************************************************** }
+ { Procedure SetVisualVESA() }
+ {-------------------------------------------------------- }
+ { This routine changes the page which will be displayed }
+ { on the screen, since the method has changed somewhat }
+ { between VBE versions , we will use the old method where }
+ { the new pixel offset is used to display different pages }
+ {******************************************************** }
+ procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+ var
+ newStartVisible : word;
+ begin
+ if page > HardwarePages then
+ begin
+ _graphresult := grError;
+ exit;
+ end;
+ newStartVisible := (MaxY+1)*page;
+ if newStartVisible > ScanLines then
+ begin
+ _graphresult := grError;
+ exit;
+ end;
+ asm
+ mov ax, 4f07h
+ mov bx, 0000h { set display start }
+ mov cx, 0000h { pixel zero ! }
+ mov dx, [NewStartVisible] { new scanline }
+{$ifdef fpc}
+ push ebp
+{$endif}
+ int 10h
+{$ifdef fpc}
+ pop ebp
+{$endif}
+ end;
+ end;
+
+ procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+ begin
+ { video offset is in pixels under VESA VBE! }
+ { This value is reset after a mode set to page ZERO = YOffset = 0 ) }
+ if page > HardwarePages then
+ begin
+ _graphresult := grError;
+ exit;
+ end;
+ YOffset := (MaxY+1)*page;
+ LinearPageOfs := YOffset*(MaxX+1);
+ end;
+
+{
+ $Log: vesa.inc,v $
+ Revision 1.12 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.11 2005/02/02 11:57:19 jonas
+ * fix from Tomas for calling conventions
+
+}
diff --git a/rtl/go32v2/vesah.inc b/rtl/go32v2/vesah.inc
new file mode 100644
index 0000000000..504a3fa3b1
--- /dev/null
+++ b/rtl/go32v2/vesah.inc
@@ -0,0 +1,102 @@
+{
+
+ $Id: vesah.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl Eric Codere
+
+ This include implements VESA basic access.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+TYPE
+
+ pModeList = ^tModeList;
+ tModeList = Array [0..255] of word; {list of modes terminated by -1}
+ {VESA modes are >=100h}
+
+ TVESAinfo = packed record { VESA Information request }
+ signature : array [1..4] of char; { This should be VESA }
+ version : word; { VESA revision }
+ str : pChar; { pointer to OEM string }
+ caps : longint; { video capabilities }
+ modeList : pModeList; { pointer to SVGA modes }
+(* pad : array [18..260] of byte; { extra padding more then }
+ end; { VESA standard because of bugs on }
+ { some video cards. }
+ *)
+ TotalMem : word;
+ { VESA 2.0 }
+ OEMversion : word;
+ VendorPtr : longint;
+ ProductPtr : longint;
+ RevisionPtr : longint;
+ filler : Array[1..478]of Byte;
+ end;
+
+ TVESAModeInfo = packed record
+ attr : word; { mode attributes (1.0) }
+ winAAttr,
+ winBAttr : byte; { window attributes (1.0) }
+ winGranularity : word; {in K} { Window granularity (1.0) }
+ winSize : word; {in K} { window size (1.0) }
+ winASeg, { Window A Segment address (1.0) }
+ winBSeg : word; { Window B Segment address (1.0) }
+ winFunct : procedure; { Function to swtich bank }
+ BytesPerScanLine: word; {bytes per scan line (1.0) }
+ { extended information }
+ xRes, yRes : word; {pixels}
+ xCharSize,
+ yCharSize : byte;
+ planes : byte;
+ bitsPixel : byte;
+ banks : byte;
+ memModel : byte;
+ bankSize : byte; {in K}
+ NumberOfPages: byte;
+(*
+ pad : array [29..260] of byte; { always put some more space then required}
+ end; *)
+ reserved : byte; { pos $1E }
+ rm_size : byte; { pos $1F }
+ rf_pos : byte; { pos $20 }
+ gm_size : byte; { pos $21 }
+ gf_pos : byte; { pos $22 }
+ bm_size : byte; { pos $23 }
+ bf_pos : byte; { pos $24 }
+ (* res_mask : word; { pos $25 }
+ here there was an alignment problem !!
+ with default alignment
+ res_mask was shifted to $26
+ and after PhysAddress to $2A !!! PM *)
+ res_size : byte;
+ res_pos : byte;
+ DirectColorInfo: byte; { pos $27 }
+ { VESA 2.0 }
+ PhysAddress : longint; { pos $28 }
+ OffscreenPtr : longint; { pos $2C }
+ OffscreenMem : word; { pos $30 }
+ reserved2 : Array[1..458]of Byte; { pos $32 }
+ end;
+
+
+
+
+var
+ VESAInfo : TVESAInfo; { VESA Driver information }
+ VESAModeInfo : TVESAModeInfo; { Current Mode information }
+ hasVesa: Boolean; { true if we have a VESA compatible graphics card}
+ { initialized in QueryAdapterInfo in graph.inc }
+{
+ $Log: vesah.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/vesamode.pp b/rtl/go32v2/vesamode.pp
new file mode 100644
index 0000000000..8f4f0157db
--- /dev/null
+++ b/rtl/go32v2/vesamode.pp
@@ -0,0 +1,250 @@
+{
+ $Id: vesamode.pp,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Video unit extension for VESA Modes for go32v2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit vesamode;
+
+ interface
+
+ implementation
+
+ uses
+ dos,go32,dpmiexcp,video,mouse;
+
+ type
+ twordarray = array[0..0] of word;
+
+ pwordarray = ^twordarray;
+ TVESAInfoBlock = record
+ VESASignature : ARRAY[0..3] OF CHAR;
+ VESAVersion : WORD;
+ OEMStringPtr : PChar;
+ Capabilities : LONGINT;
+ VideoModePtr : pwordarray;
+ TotalMemory : WORD;
+ Reserved : ARRAY[1..242] OF BYTE;
+ end;
+
+ TVesaVideoMode = record
+ {Col,Row : word;
+ Color : boolean;}
+ V : TVideoMode;
+ Mode : word;
+ end;
+
+Const
+ VesaVideoModeCount = 5;
+ VesaVMD : Array[264..268] of TVesaVideoMode = (
+ (V : (Col: 80; Row : 60; Color : True); Mode : 264),
+ (V : (Col: 132; Row : 25; Color : True); Mode : 265),
+ (V : (Col: 132; Row : 43; Color : True); Mode : 266),
+ (V : (Col: 132; Row : 50; Color : True); Mode : 267),
+ (V : (Col: 132; Row : 60; Color : True); Mode : 268)
+ );
+
+var
+ infoblock : TVESAInfoBLock;
+ SupportedVesaVMD : Array[0..VesaVideoModeCount-1] of TVesaVideoMode;
+ i : longint;
+ m : word;
+Var
+ SysGetVideoModeCount : function : word;
+ SysSetVideoMode : function (Const VideoMode : TVideoMode) : boolean;
+ SysGetVideoModeData : Function (Index : Word; Var Data : TVideoMode) : boolean;
+
+
+const
+ VesaRegisteredModes : word = 0;
+
+ function ReturnSuperVGAInfo(var ib : TVESAInfoBLock) : Word;
+
+ var
+ regs : registers;
+
+ begin
+ regs.ah:=$4f;
+ regs.al:=0;
+ regs.es:=tb_segment;
+ regs.di:=tb_offset;
+ intr($10,regs);
+ dosmemget(tb_segment,tb_offset,ib,sizeof(ib));
+ ReturnSuperVGAInfo:=regs.ax;
+ end;
+
+ function SetSuperVGAMode(m : word) : word;
+
+ var
+ regs : registers;
+
+ begin
+ regs.ah:=$4f;
+ regs.al:=2;
+ regs.bx:=m;
+ intr($10,regs);
+ SetSuperVGAMode:=regs.ax;
+ end;
+
+ function SetVESAMode(const VideoMode: TVideoMode): Boolean;
+
+ var
+ w : word;
+
+ begin
+ SetVESAMode:=false;
+ for w:=VesaRegisteredModes-1 downto 0 do
+ begin
+ if (VideoMode.col=SupportedVesaVMD[w].v.col) and
+ (VideoMode.row=SupportedVesaVMD[w].v.row) and
+ (VideoMode.color=SupportedVesaVMD[w].v.color) then
+ begin
+ if SetSuperVGAMode(SupportedVesaVMD[w].mode) <> $4f then
+ SetVESAMode:=false
+ else
+ begin
+ SetVESAMode:=true;
+ ScreenWidth:=VideoMode.Col;
+ ScreenHeight:=VideoMode.Row;
+ ScreenColor:=VideoMode.Color;
+ // cheat to get a correct mouse
+ {
+ mem[$40:$84]:=ScreenHeight-1;
+ mem[$40:$4a]:=ScreenWidth;
+ memw[$40:$4c]:=ScreenHeight*((ScreenWidth shl 1)-1);
+ }
+ DoCustomMouse(true);
+ end;
+ end;
+ if SetVESAMode then
+ exit;
+ end;
+ SetVESAMode:=SysSetVideoMode(VideoMode);
+ end;
+
+procedure InitializeVesaModes;
+begin
+ ReturnSuperVGAInfo(infoblock);
+ if not((infoblock.VESASignature[0]<>'V') or
+ (infoblock.VESASignature[1]<>'E') or
+ (infoblock.VESASignature[2]<>'S') or
+ (infoblock.VESASignature[3]<>'A')) then
+ begin
+{$R-}
+ i:=0;
+ while true do
+ begin
+ dosmemget(hi(dword(infoblock.VideoModePtr)),lo(dword(infoblock.VideoModePtr))+i*2,m,2);
+ case m of
+ 264:
+ Begin
+ {RegisterVideoMode(80,60,true,@SetVESAMode,264);}
+ SupportedVesaVMD[VesaRegisteredModes]:=VesaVMD[m];
+ Inc(VesaRegisteredModes);
+ End;
+ 265:
+ Begin
+ {RegisterVideoMode(132,25,true,@SetVESAMode,265);}
+ SupportedVesaVMD[VesaRegisteredModes]:=VesaVMD[m];
+ Inc(VesaRegisteredModes);
+ End;
+ 266:
+ Begin
+ {RegisterVideoMode(132,43,true,@SetVESAMode,266);}
+ SupportedVesaVMD[VesaRegisteredModes]:=VesaVMD[m];
+ Inc(VesaRegisteredModes);
+ End;
+ 267:
+ Begin
+ {RegisterVideoMode(132,50,true,@SetVESAMode,267);}
+ SupportedVesaVMD[VesaRegisteredModes]:=VesaVMD[m];
+ Inc(VesaRegisteredModes);
+ End;
+ 268:
+ Begin
+ {RegisterVideoMode(132,60,true,@SetVESAMode,268);}
+ SupportedVesaVMD[VesaRegisteredModes]:=VesaVMD[m];
+ Inc(VesaRegisteredModes);
+ End;
+ $ffff:
+ break;
+ end;
+ inc(i);
+ end;
+ end;
+end;
+
+
+Function VesaGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+Var
+ PrevCount : word;
+
+begin
+ PrevCount:=SysGetVideoModeCount();
+ VesaGetVideoModeData:=(Index<=PrevCount);
+ If VesaGetVideoModeData then
+ begin
+ SysGetVideoModeData(Index,Data);
+ exit;
+ end;
+ VesaGetVideoModeData:=(Index-PrevCount)<=VesaRegisteredModes;
+ If VesaGetVideoModeData then
+ Data:=SupportedVesaVMD[Index-PrevCount-1].V;
+end;
+
+Function VesaGetVideoModeCount : Word;
+
+begin
+ VesaGetVideoModeCount:=SysGetVideoModeCount()+VesaRegisteredModes;
+end;
+
+
+Var
+ Driver : TVideoDriver;
+(*
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities
+ );
+*)
+initialization
+
+{ Get the videodriver to be used }
+ GetVideoDriver (Driver);
+ InitializeVesaModes;
+{ Change needed functions }
+ SysGetVideoModeCount:=Driver.GetVideoModeCount;
+ Driver.GetVideoModeCount:=@VesaGetVideoModeCount;
+ SysGetVideoModeData:=Driver.GetVideoModeData;
+ Driver.GetVideoModeData:=@VesaGetVideoModeData;
+ SysSetVideoMode:=Driver.SetVideoMode;
+ Driver.SetVideoMode:=@SetVESAMode;
+
+ SetVideoDriver (Driver);
+end.
+{
+ $Log: vesamode.pp,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/go32v2/video.pp b/rtl/go32v2/video.pp
new file mode 100644
index 0000000000..10b15c3b3e
--- /dev/null
+++ b/rtl/go32v2/video.pp
@@ -0,0 +1,329 @@
+{
+ $Id: video.pp,v 1.8 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Video unit for DOS
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+
+interface
+
+{$i videoh.inc}
+
+var
+ VideoSeg : word;
+
+
+implementation
+
+uses
+ mouse,
+ go32;
+
+{$i video.inc}
+
+{$ASMMODE ATT}
+
+ { used to know if LastCursorType is valid }
+const
+ LastCursorType : word = crUnderline;
+
+{ allways set blink state again }
+
+procedure SetHighBitBlink;
+var
+ regs : trealregs;
+begin
+ regs.ax:=$1003;
+ regs.bx:=$0001;
+ realintr($10,regs);
+end;
+
+function BIOSGetScreenMode(var Cols,Rows: word; var Color: boolean): boolean;
+var r: trealregs;
+ L: longint;
+ LSel,LSeg: word;
+ B: array[0..63] of byte;
+type
+ TWord = word;
+ PWord = ^TWord;
+var
+ OK: boolean;
+begin
+ L:=global_dos_alloc(64);
+ LSeg:=(L shr 16);
+ LSel:=(L and $ffff);
+
+ r.ah:=$1b; r.bx:=0;
+ r.es:=LSeg; r.di:=0;
+ realintr($10,r);
+ OK:=(r.al=$1b);
+ if OK then
+ begin
+ dpmi_dosmemget(LSeg,0,B,64);
+ Cols:=PWord(@B[5])^; Rows:=B[$22];
+ Color:=PWord(@B[$27])^<>0;
+ end;
+ global_dos_free(LSel);
+ BIOSGetScreenMode:=OK;
+end;
+
+procedure SysInitVideo;
+var
+ regs : trealregs;
+begin
+ VideoSeg:=$b800;
+ if (ScreenWidth=$ffff) or (ScreenHeight=$ffff) or
+ (ScreenWidth=0) or (ScreenHeight=0) then
+ begin
+ ScreenColor:=true;
+ regs.ah:=$0f;
+ realintr($10,regs);
+ if (regs.al and 1)=0 then
+ ScreenColor:=false;
+ if regs.al=7 then
+ begin
+ ScreenColor:=false;
+ VideoSeg:=$b000;
+ end
+ else
+ VideoSeg:=$b800;
+ ScreenWidth:=regs.ah;
+ regs.ax:=$1130;
+ regs.bx:=0;
+ realintr($10,regs);
+ ScreenHeight:=regs.dl+1;
+ BIOSGetScreenMode(ScreenWidth,ScreenHeight,ScreenColor);
+ end;
+ regs.ah:=$03;
+ regs.bh:=0;
+ realintr($10,regs);
+ CursorLines:=regs.cl;
+ CursorX:=regs.dl;
+ CursorY:=regs.dh;
+ SetHighBitBlink;
+ SetCursorType(LastCursorType);
+end;
+
+
+procedure SysDoneVideo;
+begin
+ LastCursorType:=GetCursorType;
+ ClearScreen;
+ SetCursorType(crUnderLine);
+ SetCursorPos(0,0);
+end;
+
+
+function SysGetCapabilities: Word;
+begin
+ SysGetCapabilities := $3F;
+end;
+
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+var
+ regs : trealregs;
+begin
+ regs.ah:=$02;
+ regs.bh:=0;
+ regs.dh:=NewCursorY;
+ regs.dl:=NewCursorX;
+ realintr($10,regs);
+ CursorY:=regs.dh;
+ CursorX:=regs.dl;
+end;
+
+{ I don't know the maximum value for the scan line
+ probably 7 or 15 depending on resolution !!
+ }
+function SysGetCursorType: Word;
+var
+ regs : trealregs;
+begin
+ regs.ah:=$03;
+ regs.bh:=0;
+ realintr($10,regs);
+ SysGetCursorType:=crHidden;
+ if (regs.ch and $60)=0 then
+ begin
+ SysGetCursorType:=crBlock;
+ if (regs.ch and $1f)<>0 then
+ begin
+ SysGetCursorType:=crHalfBlock;
+ if regs.cl-1=(regs.ch and $1F) then
+ SysGetCursorType:=crUnderline;
+ end;
+ end;
+end;
+
+
+procedure SysSetCursorType(NewType: Word);
+var
+ regs : trealregs;
+const
+ MaxCursorLines = 7;
+begin
+ regs.ah:=$01;
+ regs.bx:=NewType;
+ case NewType of
+ crHidden : regs.cx:=$2000;
+ crHalfBlock : begin
+ regs.ch:=MaxCursorLines shr 1;
+ regs.cl:=MaxCursorLines;
+ end;
+ crBlock : begin
+ regs.ch:=0;
+ regs.cl:=MaxCursorLines;
+ end;
+ else begin
+ regs.ch:=MaxCursorLines-1;
+ regs.cl:=MaxCursorLines;
+ end;
+ end;
+ realintr($10,regs);
+end;
+
+procedure SysUpdateScreen(Force: Boolean);
+begin
+ if not force then
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl VideoBuf,%esi
+ movl OldVideoBuf,%edi
+ movl VideoBufSize,%ecx
+ shrl $2,%ecx
+ repe
+ cmpsl
+ setne force
+ popl %edi
+ popl %esi
+ end;
+ end;
+ if Force then
+ begin
+ dosmemput(videoseg,0,videobuf^,VideoBufSize);
+ move(videobuf^,oldvideobuf^,VideoBufSize);
+ end;
+end;
+
+Procedure DoSetVideoMode(Params: Longint);
+
+type
+ wordrec=packed record
+ lo,hi : word;
+ end;
+var
+ regs : trealregs;
+begin
+ regs.ax:=wordrec(Params).lo;
+ regs.bx:=wordrec(Params).hi;
+ realintr($10,regs);
+end;
+
+Procedure SetVideo8x8;
+
+type
+ wordrec=packed record
+ lo,hi : word;
+ end;
+var
+ regs : trealregs;
+begin
+ regs.ax:=3;
+ regs.bx:=0;
+ realintr($10,regs);
+ regs.ax:=$1112;
+ regs.bx:=$0;
+ realintr($10,regs);
+end;
+
+Const
+ SysVideoModeCount = 5;
+ SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+ (Col: 40; Row : 25; Color : False),
+ (Col: 40; Row : 25; Color : True),
+ (Col: 80; Row : 25; Color : False),
+ (Col: 80; Row : 25; Color : True),
+ (Col: 80; Row : 50; Color : True)
+ );
+
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
+
+Var
+ I : Integer;
+
+begin
+ I:=SysVideoModeCount-1;
+ SysSetVideoMode:=False;
+ While (I>=0) and Not SysSetVideoMode do
+ If (Mode.col=SysVMD[i].col) and
+ (Mode.Row=SysVMD[i].Row) and
+ (Mode.Color=SysVMD[i].Color) then
+ SysSetVideoMode:=True
+ else
+ Dec(I);
+ If SysSetVideoMode then
+ begin
+ If (I<SysVideoModeCount-1) then
+ DoSetVideoMode(I)
+ else
+ SetVideo8x8;
+ ScreenWidth:=SysVMD[I].Col;
+ ScreenHeight:=SysVMD[I].Row;
+ ScreenColor:=SysVMD[I].Color;
+ DoCustomMouse(false);
+ end;
+end;
+
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+
+begin
+ SysGetVideoModeData:=(Index<=SysVideoModeCount);
+ If SysGetVideoModeData then
+ Data:=SysVMD[Index];
+end;
+
+Function SysGetVideoModeCount : Word;
+
+begin
+ SysGetVideoModeCount:=SysVideoModeCount;
+end;
+
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities
+ );
+
+initialization
+ SetVideoDriver(SysVideoDriver);
+end.
+{
+ $Log: video.pp,v $
+ Revision 1.8 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
+
diff --git a/rtl/i386/cpu.pp b/rtl/i386/cpu.pp
new file mode 100644
index 0000000000..d45bc71edf
--- /dev/null
+++ b/rtl/i386/cpu.pp
@@ -0,0 +1,81 @@
+{
+ $Id: cpu.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+
+ This unit contains some routines to get informations about the
+ processor
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit cpu;
+ interface
+
+ { returns true, if the processor supports the cpuid instruction }
+ function cpuid_support : boolean;
+
+ { returns true, if floating point is done by an emulator }
+ function floating_point_emulation : boolean;
+
+ { returns the contents of the cr0 register }
+ function cr0 : longint;
+
+
+ implementation
+
+{$ASMMODE INTEL}
+
+
+ function cpuid_support : boolean;assembler;
+ {
+ Check if the ID-flag can be changed, if changed then CpuID is supported.
+ Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (PFV)
+ }
+ asm
+ pushf
+ pushf
+ pop eax
+ mov ebx,eax
+ xor eax,200000h
+ push eax
+ popf
+ pushf
+ pop eax
+ popf
+ and eax,200000h
+ and ebx,200000h
+ cmp eax,ebx
+ setnz al
+ end;
+
+
+ function cr0 : longint;assembler;
+ asm
+ DB 0Fh,20h,0C0h
+ { mov eax,cr0
+ special registers are not allowed in the assembler
+ parsers }
+ end;
+
+
+ function floating_point_emulation : boolean;
+ begin
+ {!!!! I don't know currently the position of the EM flag }
+ { $4 after Ralf Brown's list }
+ floating_point_emulation:=(cr0 and $4)<>0;
+ end;
+
+end.
+
+{
+ $Log: cpu.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/fastmove.inc b/rtl/i386/fastmove.inc
new file mode 100644
index 0000000000..b34fc8ef4b
--- /dev/null
+++ b/rtl/i386/fastmove.inc
@@ -0,0 +1,861 @@
+{
+ $Id: fastmove.inc,v 1.5 2005/01/26 20:58:10 florian Exp $
+ Copyright (c) 2004, John O'Harrow (john@almcrest.demon.co.uk)
+
+This software is provided 'as-is', without any express or implied warranty.
+In no event will the authors be held liable for any damages arising from the
+use of this software.
+
+Permission is granted to anyone to use this software for any purpose, including
+commercial applications, and to alter it and redistribute it freely, subject to
+the following restrictions:
+
+1. The origin of this software must not be misrepresented; you must not claim
+ that you wrote the original software. If you use this software in a product,
+ an acknowledgment in the product documentation would be appreciated but is
+ not required.
+
+2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+
+3. This notice may not be removed or altered from any source distribution.
+
+-------------------------------------------------------------------------------
+
+Version: 1.40 - 16-SEP-2004
+}
+
+{$ifndef VER1_0}
+ {$if (FPC_VERSION>1) or ((FPC_RELEASE>=9) and (FPC_PATCH>6))}
+ { $define USE_FASTMOVE}
+ {$endif}
+{$endif}
+
+{$ifdef USE_FASTMOVE}
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+
+{$asmmode intel}
+
+{-------------------------------------------------------------------------}
+(*
+{Just to show that a good Pascal algorithm can beat the default BASM}
+procedure MoveJOH_PAS_3(const Source; var Dest; Count : Integer);
+var
+ S, D : PtrUInt;
+ Temp, C, I : PtrInt;
+ L : PPtrInt;
+begin
+ S := Cardinal(@Source);
+ D := Cardinal(@Dest);
+ if S = D then
+ Exit;
+ if Count <= 4 then
+ case Count of
+ 1 : PByte(@Dest)^ := PByte(S)^;
+ 2 : PWord(@Dest)^ := PWord(S)^;
+ 3 : if D > S then
+ begin
+ PByte(Integer(@Dest)+2)^ := PByte(S+2)^;
+ PWord(@Dest)^ := PWord(S)^;
+ end
+ else
+ begin
+ PWord(@Dest)^ := PWord(S)^;
+ PByte(Integer(@Dest)+2)^ := PByte(S+2)^;
+ end;
+ 4 : PInteger(@Dest)^ := PInteger(S)^
+ else Exit; {Count <= 0}
+ end
+ else
+ if D > S then
+ begin
+ Temp := PInteger(S)^;
+ I := Integer(@Dest);
+ C := Count - 4;
+ L := PInteger(Integer(@Dest) + C);
+ Inc(S, C);
+ repeat
+ L^ := PInteger(S)^;
+ if Count <= 8 then
+ Break;
+ Dec(Count, 4);
+ Dec(S, 4);
+ Dec(L);
+ until False;
+ PInteger(I)^ := Temp;
+ end
+ else
+ begin
+ C := Count - 4;
+ Temp := PInteger(S + Cardinal(C))^;
+ I := Integer(@Dest) + C;
+ L := @Dest;
+ repeat
+ L^ := PInteger(S)^;
+ if Count <= 8 then
+ Break;
+ Dec(Count, 4);
+ Inc(S, 4);
+ Inc(L);
+ until False;
+ PInteger(I)^ := Temp;
+ end;
+end; {MoveJOH_PAS}
+*)
+
+const
+ SMALLMOVESIZE = 36;
+
+{-------------------------------------------------------------------------}
+{Perform Forward Move of 0..36 Bytes}
+{On Entry, ECX = Count, EAX = Source+Count, EDX = Dest+Count. Destroys ECX}
+procedure SmallForwardMove_3;assembler;nostackframe;
+asm
+ jmp dword ptr @@FwdJumpTable[ecx*4]
+ align 16
+@@FwdJumpTable:
+ dd @@Done {Removes need to test for zero size move}
+ dd @@Fwd01,@@Fwd02,@@Fwd03,@@Fwd04,@@Fwd05,@@Fwd06,@@Fwd07,@@Fwd08
+ dd @@Fwd09,@@Fwd10,@@Fwd11,@@Fwd12,@@Fwd13,@@Fwd14,@@Fwd15,@@Fwd16
+ dd @@Fwd17,@@Fwd18,@@Fwd19,@@Fwd20,@@Fwd21,@@Fwd22,@@Fwd23,@@Fwd24
+ dd @@Fwd25,@@Fwd26,@@Fwd27,@@Fwd28,@@Fwd29,@@Fwd30,@@Fwd31,@@Fwd32
+ dd @@Fwd33,@@Fwd34,@@Fwd35,@@Fwd36
+@@Fwd36:
+ mov ecx,[eax-36]
+ mov [edx-36],ecx
+@@Fwd32:
+ mov ecx,[eax-32]
+ mov [edx-32],ecx
+@@Fwd28:
+ mov ecx,[eax-28]
+ mov [edx-28],ecx
+@@Fwd24:
+ mov ecx,[eax-24]
+ mov [edx-24],ecx
+@@Fwd20:
+ mov ecx,[eax-20]
+ mov [edx-20],ecx
+@@Fwd16:
+ mov ecx,[eax-16]
+ mov [edx-16],ecx
+@@Fwd12:
+ mov ecx,[eax-12]
+ mov [edx-12],ecx
+@@Fwd08:
+ mov ecx,[eax-8]
+ mov [edx-8],ecx
+@@Fwd04:
+ mov ecx,[eax-4]
+ mov [edx-4],ecx
+ ret
+@@Fwd35:
+ mov ecx,[eax-35]
+ mov [edx-35],ecx
+@@Fwd31:
+ mov ecx,[eax-31]
+ mov [edx-31],ecx
+@@Fwd27:
+ mov ecx,[eax-27]
+ mov [edx-27],ecx
+@@Fwd23:
+ mov ecx,[eax-23]
+ mov [edx-23],ecx
+@@Fwd19:
+ mov ecx,[eax-19]
+ mov [edx-19],ecx
+@@Fwd15:
+ mov ecx,[eax-15]
+ mov [edx-15],ecx
+@@Fwd11:
+ mov ecx,[eax-11]
+ mov [edx-11],ecx
+@@Fwd07:
+ mov ecx,[eax-7]
+ mov [edx-7],ecx
+ mov ecx,[eax-4]
+ mov [edx-4],ecx
+ ret
+@@Fwd03:
+ movzx ecx, word ptr [eax-3]
+ mov [edx-3],cx
+ movzx ecx, byte ptr [eax-1]
+ mov [edx-1],cl
+ ret
+@@Fwd34:
+ mov ecx,[eax-34]
+ mov [edx-34],ecx
+@@Fwd30:
+ mov ecx,[eax-30]
+ mov [edx-30],ecx
+@@Fwd26:
+ mov ecx,[eax-26]
+ mov [edx-26],ecx
+@@Fwd22:
+ mov ecx,[eax-22]
+ mov [edx-22],ecx
+@@Fwd18:
+ mov ecx,[eax-18]
+ mov [edx-18],ecx
+@@Fwd14:
+ mov ecx,[eax-14]
+ mov [edx-14],ecx
+@@Fwd10:
+ mov ecx,[eax-10]
+ mov [edx-10],ecx
+@@Fwd06:
+ mov ecx,[eax-6]
+ mov [edx-6],ecx
+@@Fwd02:
+ movzx ecx, word ptr [eax-2]
+ mov [edx-2],cx
+ ret
+@@Fwd33:
+ mov ecx,[eax-33]
+ mov [edx-33],ecx
+@@Fwd29:
+ mov ecx,[eax-29]
+ mov [edx-29],ecx
+@@Fwd25:
+ mov ecx,[eax-25]
+ mov [edx-25],ecx
+@@Fwd21:
+ mov ecx,[eax-21]
+ mov [edx-21],ecx
+@@Fwd17:
+ mov ecx,[eax-17]
+ mov [edx-17],ecx
+@@Fwd13:
+ mov ecx,[eax-13]
+ mov [edx-13],ecx
+@@Fwd09:
+ mov ecx,[eax-9]
+ mov [edx-9],ecx
+@@Fwd05:
+ mov ecx,[eax-5]
+ mov [edx-5],ecx
+@@Fwd01:
+ movzx ecx, byte ptr [eax-1]
+ mov [edx-1],cl
+@@Done:
+end; {SmallForwardMove}
+
+{-------------------------------------------------------------------------}
+{Perform Backward Move of 0..36 Bytes}
+{On Entry, ECX = Count, EAX = Source, EDX = Dest. Destroys ECX}
+procedure SmallBackwardMove_3;assembler;nostackframe;
+asm
+ jmp dword ptr @@BwdJumpTable[ecx*4]
+ align 16
+@@BwdJumpTable:
+ dd @@Done {Removes need to test for zero size move}
+ dd @@Bwd01,@@Bwd02,@@Bwd03,@@Bwd04,@@Bwd05,@@Bwd06,@@Bwd07,@@Bwd08
+ dd @@Bwd09,@@Bwd10,@@Bwd11,@@Bwd12,@@Bwd13,@@Bwd14,@@Bwd15,@@Bwd16
+ dd @@Bwd17,@@Bwd18,@@Bwd19,@@Bwd20,@@Bwd21,@@Bwd22,@@Bwd23,@@Bwd24
+ dd @@Bwd25,@@Bwd26,@@Bwd27,@@Bwd28,@@Bwd29,@@Bwd30,@@Bwd31,@@Bwd32
+ dd @@Bwd33,@@Bwd34,@@Bwd35,@@Bwd36
+@@Bwd36:
+ mov ecx,[eax+32]
+ mov [edx+32],ecx
+@@Bwd32:
+ mov ecx,[eax+28]
+ mov [edx+28],ecx
+@@Bwd28:
+ mov ecx,[eax+24]
+ mov [edx+24],ecx
+@@Bwd24:
+ mov ecx,[eax+20]
+ mov [edx+20],ecx
+@@Bwd20:
+ mov ecx,[eax+16]
+ mov [edx+16],ecx
+@@Bwd16:
+ mov ecx,[eax+12]
+ mov [edx+12],ecx
+@@Bwd12:
+ mov ecx,[eax+8]
+ mov [edx+8],ecx
+@@Bwd08:
+ mov ecx,[eax+4]
+ mov [edx+4],ecx
+@@Bwd04:
+ mov ecx,[eax]
+ mov [edx],ecx
+ ret
+@@Bwd35:
+ mov ecx,[eax+31]
+ mov [edx+31],ecx
+@@Bwd31:
+ mov ecx,[eax+27]
+ mov [edx+27],ecx
+@@Bwd27:
+ mov ecx,[eax+23]
+ mov [edx+23],ecx
+@@Bwd23:
+ mov ecx,[eax+19]
+ mov [edx+19],ecx
+@@Bwd19:
+ mov ecx,[eax+15]
+ mov [edx+15],ecx
+@@Bwd15:
+ mov ecx,[eax+11]
+ mov [edx+11],ecx
+@@Bwd11:
+ mov ecx,[eax+7]
+ mov [edx+7],ecx
+@@Bwd07:
+ mov ecx,[eax+3]
+ mov [edx+3],ecx
+ mov ecx,[eax]
+ mov [edx],ecx
+ ret
+@@Bwd03:
+ movzx ecx, word ptr [eax+1]
+ mov [edx+1],cx
+ movzx ecx, byte ptr [eax]
+ mov [edx],cl
+ ret
+@@Bwd34:
+ mov ecx,[eax+30]
+ mov [edx+30],ecx
+@@Bwd30:
+ mov ecx,[eax+26]
+ mov [edx+26],ecx
+@@Bwd26:
+ mov ecx,[eax+22]
+ mov [edx+22],ecx
+@@Bwd22:
+ mov ecx,[eax+18]
+ mov [edx+18],ecx
+@@Bwd18:
+ mov ecx,[eax+14]
+ mov [edx+14],ecx
+@@Bwd14:
+ mov ecx,[eax+10]
+ mov [edx+10],ecx
+@@Bwd10:
+ mov ecx,[eax+6]
+ mov [edx+6],ecx
+@@Bwd06:
+ mov ecx,[eax+2]
+ mov [edx+2],ecx
+@@Bwd02:
+ movzx ecx, word ptr [eax]
+ mov [edx],cx
+ ret
+@@Bwd33:
+ mov ecx,[eax+29]
+ mov [edx+29],ecx
+@@Bwd29:
+ mov ecx,[eax+25]
+ mov [edx+25],ecx
+@@Bwd25:
+ mov ecx,[eax+21]
+ mov [edx+21],ecx
+@@Bwd21:
+ mov ecx,[eax+17]
+ mov [edx+17],ecx
+@@Bwd17:
+ mov ecx,[eax+13]
+ mov [edx+13],ecx
+@@Bwd13:
+ mov ecx,[eax+9]
+ mov [edx+9],ecx
+@@Bwd09:
+ mov ecx,[eax+5]
+ mov [edx+5],ecx
+@@Bwd05:
+ mov ecx,[eax+1]
+ mov [edx+1],ecx
+@@Bwd01:
+ movzx ecx, byte ptr[eax]
+ mov [edx],cl
+@@Done:
+end; {SmallBackwardMove}
+
+{-------------------------------------------------------------------------}
+{Move ECX Bytes from EAX to EDX, where EAX > EDX and ECX > 36 (SMALLMOVESIZE)}
+procedure Forwards_IA32_3;assembler;nostackframe;
+asm
+ push ebx
+ mov ebx,edx
+ fild qword ptr [eax]
+ add eax,ecx {QWORD Align Writes}
+ add ecx,edx
+ add edx,7
+ and edx,-8
+ sub ecx,edx
+ add edx,ecx {Now QWORD Aligned}
+ sub ecx,16
+ neg ecx
+@FwdLoop:
+ fild qword ptr [eax+ecx-16]
+ fistp qword ptr [edx+ecx-16]
+ fild qword ptr [eax+ecx-8]
+ fistp qword ptr [edx+ecx-8]
+ add ecx,16
+ jle @FwdLoop
+ fistp qword ptr [ebx]
+ neg ecx
+ add ecx,16
+ pop ebx
+ jmp SmallForwardMove_3
+end; {Forwards_IA32}
+
+{-------------------------------------------------------------------------}
+{Move ECX Bytes from EAX to EDX, where EAX < EDX and ECX > 36 (SMALLMOVESIZE)}
+procedure Backwards_IA32_3;assembler;nostackframe;
+asm
+ push ebx
+ fild qword ptr [eax+ecx-8]
+ lea ebx,[edx+ecx] {QWORD Align Writes}
+ and ebx,7
+ sub ecx,ebx
+ add ebx,ecx {Now QWORD Aligned, EBX = Original Length}
+ sub ecx,16
+@BwdLoop:
+ fild qword ptr [eax+ecx]
+ fild qword ptr [eax+ecx+8]
+ fistp qword ptr [edx+ecx+8]
+ fistp qword ptr [edx+ecx]
+ sub ecx,16
+ jge @BwdLoop
+ fistp qword ptr [edx+ebx-8]
+ add ecx,16
+ pop ebx
+ jmp SmallBackwardMove_3
+end; {Backwards_IA32}
+
+{-------------------------------------------------------------------------}
+{Move ECX Bytes from EAX to EDX, where EAX > EDX and ECX > 36 (SMALLMOVESIZE)}
+procedure Forwards_MMX_3;assembler;nostackframe;
+const
+ LARGESIZE = 1024;
+asm
+ cmp ecx,LARGESIZE
+ jge @FwdLargeMove
+ cmp ecx,72 {Size at which using MMX becomes worthwhile}
+ jl Forwards_IA32_3
+ push ebx
+ mov ebx,edx
+ movq mm0,[eax] {First 8 Characters}
+ {QWORD Align Writes}
+ add eax,ecx
+ add ecx,edx
+ add edx,7
+ and edx,-8
+ sub ecx,edx
+ add edx,ecx
+ {Now QWORD Aligned}
+ sub ecx,32
+ neg ecx
+@FwdLoopMMX:
+ movq mm1,[eax+ecx-32]
+ movq mm2,[eax+ecx-24]
+ movq mm3,[eax+ecx-16]
+ movq mm4,[eax+ecx- 8]
+ movq [edx+ecx-32],mm1
+ movq [edx+ecx-24],mm2
+ movq [edx+ecx-16],mm3
+ movq [edx+ecx- 8],mm4
+ add ecx,32
+ jle @FwdLoopMMX
+ movq [ebx],mm0 {First 8 Characters}
+ emms
+ pop ebx
+ neg ecx
+ add ecx,32
+ jmp SmallForwardMove_3
+@FwdLargeMove:
+ push ebx
+ mov ebx,ecx
+ test edx,15
+ jz @FwdAligned
+ {16 byte Align Destination}
+ mov ecx,edx
+ add ecx,15
+ and ecx,-16
+ sub ecx,edx
+ add eax,ecx
+ add edx,ecx
+ sub ebx,ecx
+ {Destination now 16 Byte Aligned}
+ call SmallForwardMove_3
+@FwdAligned:
+ mov ecx,ebx
+ and ecx,-16
+ sub ebx,ecx {EBX = Remainder}
+ push esi
+ push edi
+ mov esi,eax {ESI = Source}
+ mov edi,edx {EDI = Dest}
+ mov eax,ecx {EAX = Count}
+ and eax,-64 {EAX = No of Bytes to Blocks Moves}
+ and ecx,$3F {ECX = Remaining Bytes to Move (0..63)}
+ add esi,eax
+ add edi,eax
+ shr eax,3 {EAX = No of QWORD's to Block Move}
+ neg eax
+@MMXcopyloop:
+ movq mm0,[esi+eax*8 ]
+ movq mm1,[esi+eax*8+ 8]
+ movq mm2,[esi+eax*8+16]
+ movq mm3,[esi+eax*8+24]
+ movq mm4,[esi+eax*8+32]
+ movq mm5,[esi+eax*8+40]
+ movq mm6,[esi+eax*8+48]
+ movq mm7,[esi+eax*8+56]
+ movq [edi+eax*8 ],mm0
+ movq [edi+eax*8+ 8],mm1
+ movq [edi+eax*8+16],mm2
+ movq [edi+eax*8+24],mm3
+ movq [edi+eax*8+32],mm4
+ movq [edi+eax*8+40],mm5
+ movq [edi+eax*8+48],mm6
+ movq [edi+eax*8+56],mm7
+ add eax,8
+ jnz @MMXcopyloop
+ emms {Empty MMX State}
+ add ecx,ebx
+ shr ecx,2
+ rep movsd
+ mov ecx,ebx
+ and ecx,3
+ rep movsb
+ pop edi
+ pop esi
+ pop ebx
+end; {Forwards_MMX}
+
+{-------------------------------------------------------------------------}
+{Move ECX Bytes from EAX to EDX, where EAX < EDX and ECX > 36 (SMALLMOVESIZE)}
+procedure Backwards_MMX_3;assembler;nostackframe;
+asm
+ cmp ecx,72 {Size at which using MMX becomes worthwhile}
+ jl Backwards_IA32_3
+ push ebx
+ movq mm0,[eax+ecx-8] {Get Last QWORD}
+ {QWORD Align Writes}
+ lea ebx,[edx+ecx]
+ and ebx,7
+ sub ecx,ebx
+ add ebx,ecx
+ {Now QWORD Aligned}
+ sub ecx,32
+@BwdLoopMMX:
+ movq mm1,[eax+ecx ]
+ movq mm2,[eax+ecx+ 8]
+ movq mm3,[eax+ecx+16]
+ movq mm4,[eax+ecx+24]
+ movq [edx+ecx+24],mm4
+ movq [edx+ecx+16],mm3
+ movq [edx+ecx+ 8],mm2
+ movq [edx+ecx ],mm1
+ sub ecx,32
+ jge @BwdLoopMMX
+ movq [edx+ebx-8], mm0 {Last QWORD}
+ emms
+ add ecx,32
+ pop ebx
+ jmp SmallBackwardMove_3
+end; {Backwards_MMX}
+
+{-------------------------------------------------------------------------}
+{Dest MUST be 16-Byes Aligned, Count MUST be multiple of 16 }
+procedure AlignedFwdMoveSSE_3(const Source; var Dest; Count: Integer);assembler;nostackframe;
+const
+ Prefetch = 512;
+asm
+ push esi
+ mov esi,eax {ESI = Source}
+ mov eax,ecx {EAX = Count}
+ and eax,-128 {EAX = No of Bytes to Block Move}
+ add esi,eax
+ add edx,eax
+ shr eax,3 {EAX = No of QWORD's to Block Move}
+ neg eax
+ cmp eax, -(32*1024) {Count > 256K}
+ jl @Large
+@Small: {Count<=256K}
+ test esi,15 {Check if Both Source/Dest Aligned}
+ jnz @SmallUnaligned
+@SmallAligned: {Both Source and Dest 16-Byte Aligned}
+@SmallAlignedLoop:
+ movaps xmm0,[esi+8*eax]
+ movaps xmm1,[esi+8*eax+16]
+ movaps xmm2,[esi+8*eax+32]
+ movaps xmm3,[esi+8*eax+48]
+ movaps [edx+8*eax],xmm0
+ movaps [edx+8*eax+16],xmm1
+ movaps [edx+8*eax+32],xmm2
+ movaps [edx+8*eax+48],xmm3
+ movaps xmm4,[esi+8*eax+64]
+ movaps xmm5,[esi+8*eax+80]
+ movaps xmm6,[esi+8*eax+96]
+ movaps xmm7,[esi+8*eax+112]
+ movaps [edx+8*eax+64],xmm4
+ movaps [edx+8*eax+80],xmm5
+ movaps [edx+8*eax+96],xmm6
+ movaps [edx+8*eax+112],xmm7
+ add eax,16
+ js @SmallAlignedLoop
+ jmp @Remainder
+@SmallUnaligned: {Source Not 16-Byte Aligned}
+@SmallUnalignedLoop:
+ movups xmm0,[esi+8*eax]
+ movups xmm1,[esi+8*eax+16]
+ movups xmm2,[esi+8*eax+32]
+ movups xmm3,[esi+8*eax+48]
+ movaps [edx+8*eax],xmm0
+ movaps [edx+8*eax+16],xmm1
+ movaps [edx+8*eax+32],xmm2
+ movaps [edx+8*eax+48],xmm3
+ movups xmm4,[esi+8*eax+64]
+ movups xmm5,[esi+8*eax+80]
+ movups xmm6,[esi+8*eax+96]
+ movups xmm7,[esi+8*eax+112]
+ movaps [edx+8*eax+64],xmm4
+ movaps [edx+8*eax+80],xmm5
+ movaps [edx+8*eax+96],xmm6
+ movaps [edx+8*eax+112],xmm7
+ add eax,16
+ js @SmallUnalignedLoop
+ jmp @Remainder
+@Large: {Count>256K}
+ test esi,15 {Check if Both Source/Dest Aligned}
+ jnz @LargeUnaligned
+@LargeAligned: {Both Source and Dest 16-Byte Aligned}
+@LargeAlignedLoop:
+ prefetchnta [esi+8*eax+Prefetch]
+ prefetchnta [esi+8*eax+Prefetch+64]
+ movaps xmm0,[esi+8*eax]
+ movaps xmm1,[esi+8*eax+16]
+ movaps xmm2,[esi+8*eax+32]
+ movaps xmm3,[esi+8*eax+48]
+ movntps [edx+8*eax],xmm0
+ movntps [edx+8*eax+16],xmm1
+ movntps [edx+8*eax+32],xmm2
+ movntps [edx+8*eax+48],xmm3
+ movaps xmm4,[esi+8*eax+64]
+ movaps xmm5,[esi+8*eax+80]
+ movaps xmm6,[esi+8*eax+96]
+ movaps xmm7,[esi+8*eax+112]
+ movntps [edx+8*eax+64],xmm4
+ movntps [edx+8*eax+80],xmm5
+ movntps [edx+8*eax+96],xmm6
+ movntps [edx+8*eax+112],xmm7
+ add eax,16
+ js @LargeAlignedLoop
+ sfence
+ jmp @Remainder
+@LargeUnaligned: {Source Not 16-Byte Aligned}
+@LargeUnalignedLoop:
+ prefetchnta [esi+8*eax+Prefetch]
+ prefetchnta [esi+8*eax+Prefetch+64]
+ movups xmm0,[esi+8*eax]
+ movups xmm1,[esi+8*eax+16]
+ movups xmm2,[esi+8*eax+32]
+ movups xmm3,[esi+8*eax+48]
+ movntps [edx+8*eax],xmm0
+ movntps [edx+8*eax+16],xmm1
+ movntps [edx+8*eax+32],xmm2
+ movntps [edx+8*eax+48],xmm3
+ movups xmm4,[esi+8*eax+64]
+ movups xmm5,[esi+8*eax+80]
+ movups xmm6,[esi+8*eax+96]
+ movups xmm7,[esi+8*eax+112]
+ movntps [edx+8*eax+64],xmm4
+ movntps [edx+8*eax+80],xmm5
+ movntps [edx+8*eax+96],xmm6
+ movntps [edx+8*eax+112],xmm7
+ add eax,16
+ js @LargeUnalignedLoop
+ sfence
+@Remainder:
+ and ecx,$7F {ECX = Remainder (0..112 - Multiple of 16)}
+ jz @Done
+ add esi,ecx
+ add edx,ecx
+ neg ecx
+@RemainderLoop:
+ movups xmm0,[esi+ecx]
+ movaps [edx+ecx],xmm0
+ add ecx,16
+ jnz @RemainderLoop
+@Done:
+ pop esi
+end; {AlignedFwdMoveSSE}
+
+{-------------------------------------------------------------------------}
+{Move ECX Bytes from EAX to EDX, where EAX > EDX and ECX > 36 (SMALLMOVESIZE)}
+procedure Forwards_SSE_3;assembler;nostackframe;
+const
+ LARGESIZE = 2048;
+asm
+ cmp ecx,LARGESIZE
+ jge @FwdLargeMove
+ cmp ecx,SMALLMOVESIZE+32
+ movups xmm0,[eax]
+ jg @FwdMoveSSE
+ movups xmm1,[eax+16]
+ movups [edx],xmm0
+ movups [edx+16],xmm1
+ add eax,ecx
+ add edx,ecx
+ sub ecx,32
+ jmp SmallForwardMove_3
+@FwdMoveSSE:
+ push ebx
+ mov ebx,edx
+ {Align Writes}
+ add eax,ecx
+ add ecx,edx
+ add edx,15
+ and edx,-16
+ sub ecx,edx
+ add edx,ecx
+ {Now Aligned}
+ sub ecx,32
+ neg ecx
+@FwdLoopSSE:
+ movups xmm1,[eax+ecx-32]
+ movups xmm2,[eax+ecx-16]
+ movaps [edx+ecx-32],xmm1
+ movaps [edx+ecx-16],xmm2
+ add ecx,32
+ jle @FwdLoopSSE
+ movups [ebx],xmm0 {First 16 Bytes}
+ neg ecx
+ add ecx,32
+ pop ebx
+ jmp SmallForwardMove_3
+@FwdLargeMove:
+ push ebx
+ mov ebx,ecx
+ test edx,15
+ jz @FwdLargeAligned
+ {16 byte Align Destination}
+ mov ecx,edx
+ add ecx,15
+ and ecx,-16
+ sub ecx,edx
+ add eax,ecx
+ add edx,ecx
+ sub ebx,ecx
+ {Destination now 16 Byte Aligned}
+ call SmallForwardMove_3
+ mov ecx,ebx
+@FwdLargeAligned:
+ and ecx,-16
+ sub ebx,ecx {EBX = Remainder}
+ push edx
+ push eax
+ push ecx
+ call AlignedFwdMoveSSE_3
+ pop ecx
+ pop eax
+ pop edx
+ add ecx,ebx
+ add eax,ecx
+ add edx,ecx
+ mov ecx,ebx
+ pop ebx
+ jmp SmallForwardMove_3
+end; {Forwards_SSE}
+
+{-------------------------------------------------------------------------}
+{Move ECX Bytes from EAX to EDX, where EAX < EDX and ECX > 36 (SMALLMOVESIZE)}
+procedure Backwards_SSE_3;assembler;nostackframe;
+asm
+ cmp ecx,SMALLMOVESIZE+32
+ jg @BwdMoveSSE
+ sub ecx,32
+ movups xmm1,[eax+ecx]
+ movups xmm2,[eax+ecx+16]
+ movups [edx+ecx],xmm1
+ movups [edx+ecx+16],xmm2
+ jmp SmallBackwardMove_3
+@BwdMoveSSE:
+ push ebx
+ movups xmm0,[eax+ecx-16] {Last 16 Bytes}
+ {Align Writes}
+ lea ebx,[edx+ecx]
+ and ebx,15
+ sub ecx,ebx
+ add ebx,ecx
+ {Now Aligned}
+ sub ecx,32
+@BwdLoop:
+ movups xmm1,[eax+ecx]
+ movups xmm2,[eax+ecx+16]
+ movaps [edx+ecx],xmm1
+ movaps [edx+ecx+16],xmm2
+ sub ecx,32
+ jge @BwdLoop
+ movups [edx+ebx-16],xmm0 {Last 16 Bytes}
+ add ecx,32
+ pop ebx
+ jmp SmallBackwardMove_3
+end; {Backwards_SSE}
+
+const
+ fastmoveproc_forward : pointer = @Forwards_IA32_3;
+ fastmoveproc_backward : pointer = @Backwards_IA32_3;
+
+procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
+asm
+ cmp ecx,SMALLMOVESIZE
+ ja @Large
+ cmp eax,edx
+ lea eax,[eax+ecx]
+ jle @SmallCheck
+@SmallForward:
+ add edx,ecx
+ jmp SmallForwardMove_3
+@SmallCheck:
+ je @Done {For Compatibility with Delphi's move for Source = Dest}
+ sub eax,ecx
+ jmp SmallBackwardMove_3
+@Large:
+ jng @Done {For Compatibility with Delphi's move for Count < 0}
+ cmp eax,edx
+ jg @moveforward
+ je @Done {For Compatibility with Delphi's move for Source = Dest}
+ push eax
+ add eax,ecx
+ cmp eax,edx
+ pop eax
+ jg @movebackward
+@moveforward:
+ jmp dword ptr fastmoveproc_forward
+@movebackward:
+ jmp dword ptr fastmoveproc_backward {Source/Dest Overlap}
+@Done:
+end;
+
+{$asmmode att}
+
+procedure setup_fastmove;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ if has_sse_support then
+ begin
+ fastmoveproc_forward:=@Forwards_SSE_3;
+ fastmoveproc_backward:=@Backwards_SSE_3;
+ end
+ else if has_mmx_support then
+ begin
+ fastmoveproc_forward:=@Forwards_MMX_3;
+ fastmoveproc_backward:=@Backwards_MMX_3;
+ end;
+ end;
+
+{$endif FPC_SYSTEM_HAS_MOVE}
+
+{$else}
+
+procedure setup_fastmove;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ end;
+
+{$endif}
diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc
new file mode 100644
index 0000000000..761344dafe
--- /dev/null
+++ b/rtl/i386/i386.inc
@@ -0,0 +1,1593 @@
+{
+ $Id: i386.inc,v 1.69 2005/03/14 21:09:04 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Processor dependent implementation for the system unit for
+ intel i386+
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ Primitives
+****************************************************************************}
+var
+ has_sse_support,has_mmx_support : boolean;
+
+{$asmmode intel}
+
+function cpuid_support : boolean;assembler;
+ {
+ Check if the ID-flag can be changed, if changed then CpuID is supported.
+ Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (PFV)
+ }
+ asm
+ pushf
+ pushf
+ pop eax
+ mov ebx,eax
+ xor eax,200000h
+ push eax
+ popf
+ pushf
+ pop eax
+ popf
+ and eax,200000h
+ and ebx,200000h
+ cmp eax,ebx
+ setnz al
+ end;
+
+{$asmmode ATT}
+
+function sse_support : boolean;
+ var
+ _edx : longint;
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $1,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ sse_support:=(_edx and $2000000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never sse }
+ sse_support:=false;
+ end;
+
+
+{ returns true, if the processor supports the mmx instructions }
+function mmx_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $1,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ mmx_support:=(_edx and $800000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never mmx }
+ mmx_support:=false;
+ end;
+
+{$i fastmove.inc}
+
+procedure fpc_cpuinit;
+begin
+ has_sse_support:=sse_support;
+ has_mmx_support:=mmx_support;
+ setup_fastmove;
+end;
+
+
+function geteipasebx : pointer;assembler;[public,alias:'FPC_GETEIPINEBX'];
+asm
+ movl (%esp),%ebx
+ ret
+end;
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler;
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,%esi
+ movl %edx,%edi
+ movl %ecx,%edx
+{$else}
+ movl dest,%edi
+ movl source,%esi
+ movl count,%edx
+{$endif}
+ movl %edi,%eax
+{ check for zero or negative count }
+ cmpl $0,%edx
+ jle .LMoveEnd
+{ Check for back or forward }
+ sub %esi,%eax
+ jz .LMoveEnd { Do nothing when source=dest }
+ jc .LFMove { Do forward, dest<source }
+ cmp %edx,%eax
+ jb .LBMove { Dest is in range of move, do backward }
+{ Forward Copy }
+.LFMove:
+ cld
+ cmpl $15,%edx
+ jl .LFMove1
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%edx
+ rep
+ movsb
+ movl %edx,%ecx
+ andl $3,%edx
+ shrl $2,%ecx
+ rep
+ movsl
+.LFMove1:
+ movl %edx,%ecx
+ rep
+ movsb
+ jmp .LMoveEnd
+{ Backward Copy }
+.LBMove:
+ std
+ addl %edx,%esi
+ addl %edx,%edi
+ movl %edi,%ecx
+ decl %esi
+ decl %edi
+ cmpl $15,%edx
+ jl .LBMove1
+ negl %ecx { Align on 32bits }
+ andl $3,%ecx
+ subl %ecx,%edx
+ rep
+ movsb
+ movl %edx,%ecx
+ andl $3,%edx
+ shrl $2,%ecx
+ subl $3,%esi
+ subl $3,%edi
+ rep
+ movsl
+ addl $3,%esi
+ addl $3,%edi
+.LBMove1:
+ movl %edx,%ecx
+ rep
+ movsb
+ cld
+.LMoveEnd:
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_SYSTEM_HAS_MOVE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+Procedure FillChar(var x;count:SizeInt;value:byte);assembler;
+
+asm
+ {A push is prefered over a local variable because a local
+ variable causes the compiler to generate a stackframe.}
+ cld
+{$ifdef REGCALL}
+ push %edi
+ movl %eax,%edi
+ movzbl %cl,%eax
+ movl %edx,%ecx
+{$else}
+ movl x,%edi
+ movl count,%ecx
+ movzbl value,%eax
+ movl %ecx,%edx
+{$endif}
+{ check for zero or negative count }
+ or %ecx,%ecx
+ jle .LFillEnd
+ cmpl $7,%ecx
+ jl .LFill1
+ imul $0x01010101,%eax { Expand al into a 4 subbytes of eax}
+ shrl $2,%ecx
+ andl $3,%edx
+ rep
+ stosl
+ movl %edx,%ecx
+.LFill1:
+ rep
+ stosb
+.LFillEnd:
+{$ifdef REGCALL}
+ pop %edi
+{$endif}
+end;
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLWORD}
+{$define FPC_SYSTEM_HAS_FILLWORD}
+procedure fillword(var x;count : SizeInt;value : word);assembler;
+var
+ saveedi : longint;
+asm
+ movl %edi,saveedi
+{$ifdef REGCALL}
+ movl %eax,%edi
+ movzwl %cx,%eax
+ movl %edx,%ecx
+{$else}
+ movl x,%edi
+ movl count,%ecx
+ movzwl value,%eax
+{$endif}
+{ check for zero or negative count }
+ cmpl $0,%ecx
+ jle .LFillWordEnd
+ movl %eax,%edx
+ shll $16,%eax
+ orl %edx,%eax
+ movl %ecx,%edx
+ shrl $1,%ecx
+ cld
+ rep
+ stosl
+ movl %edx,%ecx
+ andl $1,%ecx
+ rep
+ stosw
+.LFillWordEnd:
+ movl saveedi,%edi
+end;
+{$endif FPC_SYSTEM_HAS_FILLWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
+{$define FPC_SYSTEM_HAS_FILLDWORD}
+procedure filldword(var x;count : SizeInt;value : dword);assembler;
+var
+ saveedi : longint;
+asm
+ movl %edi,saveedi
+{$ifdef REGCALL}
+ movl %eax,%edi
+ movl %ecx,%eax
+ movl %edx,%ecx
+{$else}
+ movl x,%edi
+ movl count,%ecx
+ movl value,%eax
+{$endif}
+{ check for zero or negative count }
+ cmpl $0,%ecx
+ jle .LFillDWordEnd
+ cld
+ rep
+ stosl
+.LFillDWordEnd:
+ movl saveedi,%edi
+end;
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt; assembler;
+var
+ saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %ebx,saveebx
+ movl buf,%edi // Load String
+ movb b,%bl
+ movl len,%ecx // Load len
+ xorl %eax,%eax
+ testl %ecx,%ecx
+ jz .Lcharposnotfound
+ cld
+ movl %ecx,%edx // Copy for easy manipulation
+ movb %bl,%al
+ repne
+ scasb
+ jne .Lcharposnotfound
+ incl %ecx
+ subl %ecx,%edx
+ movl %edx,%eax
+ jmp .Lready
+.Lcharposnotfound:
+ movl $-1,%eax
+.Lready:
+ movl saveedi,%edi
+ movl saveebx,%ebx
+end;
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
+{$define FPC_SYSTEM_HAS_INDEXWORD}
+function Indexword(Const buf;len:SizeInt;b:word):SizeInt; assembler;
+var
+ saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %ebx,saveebx
+ movl Buf,%edi // Load String
+ movw b,%bx
+ movl Len,%ecx // Load len
+ xorl %eax,%eax
+ testl %ecx,%ecx
+ jz .Lcharposnotfound
+ cld
+ movl %ecx,%edx // Copy for easy manipulation
+ movw %bx,%ax
+ repne
+ scasw
+ jne .Lcharposnotfound
+ incl %ecx
+ subl %ecx,%edx
+ movl %edx,%eax
+ jmp .Lready
+.Lcharposnotfound:
+ movl $-1,%eax
+.Lready:
+ movl saveedi,%edi
+ movl saveebx,%ebx
+end;
+{$endif FPC_SYSTEM_HAS_INDEXWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
+{$define FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt; assembler;
+var
+ saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %ebx,saveebx
+{$ifdef REGCALL}
+ movl %eax,%edi
+ movl %ecx,%ebx
+ movl %edx,%ecx
+{$else}
+ movl Len,%ecx // Load len
+ movl Buf,%edi // Load String
+ movl b,%ebx
+{$endif}
+ xorl %eax,%eax
+ testl %ecx,%ecx
+ jz .Lcharposnotfound
+ cld
+ movl %ecx,%edx // Copy for easy manipulation
+ movl %ebx,%eax
+ repne
+ scasl
+ jne .Lcharposnotfound
+ incl %ecx
+ subl %ecx,%edx
+ movl %edx,%eax
+ jmp .Lready
+.Lcharposnotfound:
+ movl $-1,%eax
+.Lready:
+ movl saveedi,%edi
+ movl saveebx,%ebx
+end;
+{$endif FPC_SYSTEM_HAS_INDEXDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt; assembler;
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ cld
+{$ifdef REGCALL}
+ movl %eax,%edi
+ movl %edx,%esi
+ movl %ecx,%eax
+{$else}
+ movl len,%eax
+ movl buf2,%esi { Load params}
+ movl buf1,%edi
+{$endif}
+ testl %eax,%eax {We address -1(%esi), so we have to deal with len=0}
+ je .LCmpbyteExit
+ cmpl $7,%eax {<7 not worth aligning and go through all trouble}
+ jl .LCmpbyte2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx { calc bytes to align (%edi and 3) xor 3= -%edi and 3}
+ andl $3,%ecx
+ subl %ecx,%eax { Subtract from number of bytes to go}
+ orl %ecx,%ecx
+ rep
+ cmpsb {The actual 32-bit Aligning}
+ jne .LCmpbyte3
+ movl %eax,%ecx {bytes to do, divide by 4}
+ andl $3,%eax {remainder}
+ shrl $2,%ecx {The actual division}
+ orl %ecx,%ecx {Sets zero flag if ecx=0 -> no cmp}
+ rep
+ cmpsl
+ je .LCmpbyte2 { All equal? then to the left over bytes}
+ movl $4,%eax { Not equal. Rescan the last 4 bytes bytewise}
+ subl %eax,%esi
+ subl %eax,%edi
+.LCmpbyte2:
+ movl %eax,%ecx {bytes still to (re)scan}
+ orl %eax,%eax {prevent disaster in case %eax=0}
+ rep
+ cmpsb
+.LCmpbyte3:
+ movzbl -1(%esi),%ecx
+ movzbl -1(%edi),%eax // Compare failing (or equal) position
+ subl %ecx,%eax
+.LCmpbyteExit:
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
+{$define FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler;
+var
+ saveesi,saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl %ebx,saveebx
+ cld
+{$ifdef REGCALL}
+ movl %eax,%edi
+ movl %edx,%esi
+ movl %ecx,%eax
+{$else}
+ movl len,%eax
+ movl buf2,%esi { Load params}
+ movl buf1,%edi
+{$endif}
+ testl %eax,%eax {We address -2(%esi), so we have to deal with len=0}
+ je .LCmpwordExit
+ cmpl $5,%eax {<5 (3 bytes align + 4 bytes cmpsl = 4 words}
+ jl .LCmpword2 { not worth aligning and go through all trouble}
+ movl (%edi),%ebx // Compare alignment bytes.
+ cmpl (%esi),%ebx
+ jne .LCmpword2 // Aligning will go wrong already. Max 2 words will be scanned Branch NOW
+ shll $1,%eax {Convert word count to bytes}
+ movl %edi,%edx { Align comparing is already done, so simply add}
+ negl %edx { calc bytes to align -%edi and 3}
+ andl $3,%edx
+ addl %edx,%esi { Skip max 3 bytes alignment}
+ addl %edx,%edi
+ subl %edx,%eax { Subtract from number of bytes to go}
+ movl %eax,%ecx { Make copy of bytes to go}
+ andl $3,%eax { Calc remainder (mod 4) }
+ andl $1,%edx { %edx is 1 if array not 2-aligned, 0 otherwise}
+ shrl $2,%ecx { divide bytes to go by 4, DWords to go}
+ orl %ecx,%ecx { Sets zero flag if ecx=0 -> no cmp}
+ rep { Compare entire DWords}
+ cmpsl
+ je .LCmpword2a { All equal? then to the left over bytes}
+ movl $4,%eax { Not equal. Rescan the last 4 bytes bytewise}
+ subl %eax,%esi { Go back one DWord}
+ subl %eax,%edi
+ incl %eax {if not odd then this does nothing, else it makes
+ sure that adding %edx increases from 2 to 3 words}
+.LCmpword2a:
+ subl %edx,%esi { Subtract alignment}
+ subl %edx,%edi
+ addl %edx,%eax
+ shrl $1,%eax
+.LCmpword2:
+ movl %eax,%ecx {words still to (re)scan}
+ orl %eax,%eax {prevent disaster in case %eax=0}
+ rep
+ cmpsw
+.LCmpword3:
+ movzwl -2(%esi),%ecx
+ movzwl -2(%edi),%eax // Compare failing (or equal) position
+ subl %ecx,%eax // calculate end result.
+.LCmpwordExit:
+ movl saveedi,%edi
+ movl saveesi,%esi
+ movl saveebx,%ebx
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
+{$define FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler;
+var
+ saveesi,saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl %ebx,saveebx
+ cld
+{$ifdef REGCALL}
+ movl %eax,%edi
+ movl %edx,%esi
+ movl %ecx,%eax
+{$else}
+ movl len,%eax
+ movl buf2,%esi { Load params}
+ movl buf1,%edi
+{$endif}
+ testl %eax,%eax {We address -2(%esi), so we have to deal with len=0}
+ je .LCmpDwordExit
+ cmpl $3,%eax {<3 (3 bytes align + 4 bytes cmpsl) = 2 DWords}
+ jl .LCmpDword2 { not worth aligning and go through all trouble}
+ movl (%edi),%ebx // Compare alignment bytes.
+ cmpl (%esi),%ebx
+ jne .LCmpDword2 // Aligning will go wrong already. Max 2 words will be scanned Branch NOW
+ shll $2,%eax {Convert word count to bytes}
+ movl %edi,%edx { Align comparing is already done, so simply add}
+ negl %edx { calc bytes to align -%edi and 3}
+ andl $3,%edx
+ addl %edx,%esi { Skip max 3 bytes alignment}
+ addl %edx,%edi
+ subl %edx,%eax { Subtract from number of bytes to go}
+ movl %eax,%ecx { Make copy of bytes to go}
+ andl $3,%eax { Calc remainder (mod 4) }
+ shrl $2,%ecx { divide bytes to go by 4, DWords to go}
+ orl %ecx,%ecx { Sets zero flag if ecx=0 -> no cmp}
+ rep { Compare entire DWords}
+ cmpsl
+ je .LCmpDword2a { All equal? then to the left over bytes}
+ movl $4,%eax { Not equal. Rescan the last 4 bytes bytewise}
+ subl %eax,%esi { Go back one DWord}
+ subl %eax,%edi
+ addl $3,%eax {if align<>0 this causes repcount to be 2}
+.LCmpDword2a:
+ subl %edx,%esi { Subtract alignment}
+ subl %edx,%edi
+ addl %edx,%eax
+ shrl $2,%eax
+.LCmpDword2:
+ movl %eax,%ecx {words still to (re)scan}
+ orl %eax,%eax {prevent disaster in case %eax=0}
+ rep
+ cmpsl
+.LCmpDword3:
+ movzwl -4(%esi),%ecx
+ movzwl -4(%edi),%eax // Compare failing (or equal) position
+ subl %ecx,%eax // calculate end result.
+.LCmpDwordExit:
+ movl saveedi,%edi
+ movl saveesi,%esi
+ movl saveebx,%ebx
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
+{$define FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(Const buf;len:SizeInt;b:Char):SizeInt; assembler;
+var
+ saveesi,saveebx : longint;
+asm
+ movl %esi,saveesi
+ movl %ebx,saveebx
+// Can't use scasb, or will have to do it twice, think this
+// is faster for small "len"
+{$ifdef REGCALL}
+ movl %eax,%esi // Load address
+ movzbl %cl,%ebx // Load searchpattern
+{$else}
+ movl Buf,%esi // Load address
+ movl len,%edx // load maximal searchdistance
+ movzbl b,%ebx // Load searchpattern
+{$endif}
+ testl %edx,%edx
+ je .LFound
+ xorl %ecx,%ecx // zero index in Buf
+ xorl %eax,%eax // To make DWord compares possible
+.LLoop:
+ movb (%esi),%al // Load byte
+ cmpb %al,%bl
+ je .LFound // byte the same?
+ incl %ecx
+ incl %esi
+ cmpl %edx,%ecx // Maximal distance reached?
+ je .LNotFound
+ testl %eax,%eax // Nullchar = end of search?
+ jne .LLoop
+.LNotFound:
+ movl $-1,%ecx // Not found return -1
+.LFound:
+ movl %ecx,%eax
+ movl saveesi,%esi
+ movl saveebx,%ebx
+end;
+{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
+
+
+{****************************************************************************
+ Object Helpers
+****************************************************************************}
+{$ifndef HAS_GENERICCONSTRUCTOR}
+{$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+procedure fpc_help_constructor; assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+{ Entry without preamble, since we need the ESP of the constructor
+ Stack (relative to %ebp):
+ 12 Self
+ 8 VMT-Address
+ 4 main programm-Addr
+ 0 %ebp
+ edi contains the vmt position
+}
+ { eax isn't touched anywhere, so it doesn't have to reloaded }
+ movl 8(%ebp),%eax
+ { initialise self ? }
+ orl %esi,%esi
+ jne .LHC_4
+ { get memory, but save register first temporary variable }
+ subl $4,%esp
+ movl %esp,%esi
+ { Save Register}
+ pushal
+{$ifdef valuegetmem}
+ { esi can be destroyed in fpc_getmem!!! (JM) }
+ pushl %esi
+{$endif valuegetmem}
+ { Memory size }
+ pushl (%eax)
+{$ifdef valuegetmem}
+ call fpc_getmem
+ popl %esi
+ movl %eax,(%esi)
+{$else valuegetmem}
+ pushl %esi
+ call AsmGetMem
+{$endif valuegetmem}
+ movl $-1,8(%ebp)
+ popal
+ { Avoid 80386DX bug }
+ nop
+ { Memory position to %esi }
+ movl (%esi),%esi
+ addl $4,%esp
+ { If no memory available : fail() }
+ orl %esi,%esi
+ jz .LHC_5
+ { init self for the constructor }
+ movl %esi,12(%ebp)
+ { jmp not necessary anymore because next instruction is disabled (JM)
+ jmp .LHC_6 }
+ { Why was the VMT reset to zero here ????
+ I need it fail to know if I should
+ zero the VMT field in static objects PM }
+.LHC_4:
+ { movl $0,8(%ebp) }
+.LHC_6:
+ { is there a VMT address ? }
+ orl %eax,%eax
+ jnz .LHC_7
+ { In case the constructor doesn't do anything, the Zero-Flag }
+ { can't be put, because this calls Fail() }
+ incl %eax
+ ret
+.LHC_7:
+ { set zero inside the object }
+ pushal
+ cld
+ movl (%eax),%ecx
+ movl %esi,%edi
+ movl %ecx,%ebx
+ xorl %eax,%eax
+ shrl $2,%ecx
+ andl $3,%ebx
+ rep
+ stosl
+ movl %ebx,%ecx
+ rep
+ stosb
+ popal
+ { avoid the 80386DX bug }
+ nop
+ { set the VMT address for the new created object }
+ { the offset is in %edi since the calling and has not been changed !! }
+ movl %eax,(%esi,%edi,1)
+ testl %eax,%eax
+.LHC_5:
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
+procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{ should be called with a object that needs to be
+ freed if VMT field is at -1
+ %edi contains VMT offset in object again }
+asm
+ testl %esi,%esi
+ je .LHF_1
+ cmpl $-1,8(%ebp)
+ je .LHF_2
+ { reset vmt field to zero for static instances }
+ cmpl $0,8(%ebp)
+ je .LHF_3
+ { main constructor, we can zero the VMT field now }
+ movl $0,(%esi,%edi,1)
+.LHF_3:
+ { we zero esi to indicate failure }
+ xorl %esi,%esi
+ jmp .LHF_1
+.LHF_2:
+ { get vmt address in eax }
+ movl (%esi,%edi,1),%eax
+ movl %esi,12(%ebp)
+ { push object position }
+{$ifdef valuefreemem}
+ pushl %esi
+ call fpc_freemem
+{$else valuefreemem}
+ leal 12(%ebp),%eax
+ pushl %eax
+ call AsmFreeMem
+{$endif valuefreemem}
+ { set both object places to zero }
+ xorl %esi,%esi
+ movl %esi,12(%ebp)
+.LHF_1:
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
+procedure fpc_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+{ Stack (relative to %ebp):
+ 12 Self
+ 8 VMT-Address
+ 4 Main program-Addr
+ 0 %ebp
+ edi contains the vmt position
+}
+ pushal
+ { Should the object be resolved ? }
+ movl 8(%ebp),%eax
+ orl %eax,%eax
+ jz .LHD_3
+ { Yes, get size from SELF! }
+ movl 12(%ebp),%eax
+ { get VMT-pointer (from Self) to %ebx }
+ { the offset is in %edi since the calling and has not been changed !! }
+ movl (%eax,%edi,1),%ebx
+ { I think for precaution }
+ { that we should clear the VMT here }
+ movl $0,(%eax,%edi,1)
+{$ifdef valuefreemem}
+ { Freemem }
+ pushl %eax
+ call fpc_freemem
+{$else valuefreemem}
+ { temporary Variable }
+ subl $4,%esp
+ movl %esp,%edi
+ { SELF }
+ movl %eax,(%edi)
+ pushl %edi
+ call AsmFreeMem
+ addl $4,%esp
+{$endif valuefreemem}
+.LHD_3:
+ popal
+ { avoid the 80386DX bug }
+ nop
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
+procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+ { to be sure in the future, we save also edit }
+ pushl %edi
+ { create class ? }
+ movl 8(%ebp),%edi
+ { if we test eax later without calling newinstance }
+ { it must have a value <>0 }
+ movl $1,%eax
+ testl %edi,%edi
+ jz .LNEW_CLASS1
+ { save registers !! }
+ pushl %ebx
+ pushl %ecx
+ pushl %edx
+ { esi contains the vmt }
+ pushl %esi
+ { call newinstance (class method!) }
+ call *52{vmtNewInstance}(%esi)
+ popl %edx
+ popl %ecx
+ popl %ebx
+ { newinstance returns a pointer to the new created }
+ { instance in eax }
+ { load esi and insert self }
+ movl %eax,%esi
+.LNEW_CLASS1:
+ movl %esi,8(%ebp)
+ testl %eax,%eax
+ popl %edi
+end;
+
+
+{ Internal alias that can be reference from asm code }
+procedure int_dispose_class;external name 'FPC_DISPOSE_CLASS';
+
+{$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
+procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+ { to be sure in the future, we save also edit }
+ pushl %edi
+ { destroy class ? }
+ movl 12(%ebp),%edi
+ testl %edi,%edi
+ jz .LDISPOSE_CLASS1
+ { no inherited call }
+ movl (%esi),%edi
+ { save registers !! }
+ pushl %eax
+ pushl %ebx
+ pushl %ecx
+ pushl %edx
+ { push self }
+ pushl %esi
+ { call freeinstance }
+ call *56{vmtFreeInstance}(%edi)
+ popl %edx
+ popl %ecx
+ popl %ebx
+ popl %eax
+.LDISPOSE_CLASS1:
+ popl %edi
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
+procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{ a non zero class must allways be disposed
+ VMT is allways at pos 0 }
+asm
+ testl %esi,%esi
+ je .LHFC_1
+ { can't use the compilerproc version as that will generate a
+ reference instead of a symbol }
+ call int_dispose_class
+ { set both object places to zero }
+ xorl %esi,%esi
+ movl %esi,8(%ebp)
+.LHFC_1:
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
+{ we want the stack for debugging !! PM }
+procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+asm
+ pushl %edi
+ movl obj,%edi
+ pushl %eax
+ { Here we must check if the VMT pointer is nil before }
+ { accessing it... }
+ testl %edi,%edi
+ jz .Lco_re
+ movl (%edi),%eax
+ addl 4(%edi),%eax
+ jz .Lco_ok
+.Lco_re:
+ pushl $210
+ call HandleError
+.Lco_ok:
+ popl %eax
+ popl %edi
+ { the adress is pushed : it needs to be removed from stack !! PM }
+end;{ of asm }
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
+procedure fpc_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{ checks for a correct vmt pointer }
+{ deeper check to see if the current object is }
+{ really related to the true }
+asm
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %edi
+ movl 8(%ebp),%edi
+ pushl %ebx
+ movl 12(%ebp),%ebx
+ pushl %eax
+ { Here we must check if the VMT pointer is nil before }
+ { accessing it... }
+.Lcoext_obj:
+ testl %edi,%edi
+ jz .Lcoext_re
+ movl (%edi),%eax
+ addl 4(%edi),%eax
+ jnz .Lcoext_re
+ cmpl %edi,%ebx
+ je .Lcoext_ok
+.Lcoext_vmt:
+ movl 8(%edi),%eax
+ cmpl %ebx,%eax
+ je .Lcoext_ok
+ movl %eax,%edi
+ jmp .Lcoext_obj
+.Lcoext_re:
+ pushl $219
+ call HandleError
+.Lcoext_ok:
+ popl %eax
+ popl %ebx
+ popl %edi
+ { the adress and vmt were pushed : it needs to be removed from stack !! PM }
+ popl %ebp
+ ret $8
+end;
+
+{$endif HAS_GENERICCONSTRUCTOR}
+
+
+{****************************************************************************
+ String
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ asm
+ cld
+ movl __RESULT,%edi
+ movl sstr,%esi
+ xorl %eax,%eax
+ movl len,%ecx
+ lodsb
+ cmpl %ecx,%eax
+ jbe .LStrCopy1
+ movl %ecx,%eax
+.LStrCopy1:
+ stosb
+ cmpl $7,%eax
+ jl .LStrCopy2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ rep
+ movsb
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+.LStrCopy2:
+ movl %eax,%ecx
+ rep
+ movsb
+ end ['ESI','EDI','EAX','ECX'];
+end;
+
+
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
+{$else}
+procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+{$endif}
+begin
+ asm
+ pushl %eax
+ pushl %ecx
+ cld
+ movl dstr,%edi
+ movl sstr,%esi
+ xorl %eax,%eax
+ movl len,%ecx
+ lodsb
+ cmpl %ecx,%eax
+ jbe .LStrCopy1
+ movl %ecx,%eax
+.LStrCopy1:
+ stosb
+ cmpl $7,%eax
+ jl .LStrCopy2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ rep
+ movsb
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+.LStrCopy2:
+ movl %eax,%ecx
+ rep
+ movsb
+ popl %ecx
+ popl %eax
+ end ['ESI','EDI'];
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+function fpc_shortstr_concat(const s1,s2:shortstring):shortstring;{$ifdef hascompilerproc}compilerproc;{$endif}
+begin
+ asm
+ movl __RESULT,%edi
+ movl %edi,%ebx
+ movl s1,%esi { first string }
+ lodsb
+ andl $0x0ff,%eax
+ stosb
+ cmpl $7,%eax
+ jl .LStrConcat1
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ rep
+ movsb
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+.LStrConcat1:
+ movl %eax,%ecx
+ rep
+ movsb
+ movl s2,%esi { second string }
+ movzbl (%ebx),%ecx
+ negl %ecx
+ addl $0x0ff,%ecx
+ lodsb
+ cmpl %ecx,%eax
+ jbe .LStrConcat2
+ movl %ecx,%eax
+.LStrConcat2:
+ addb %al,(%ebx)
+ cmpl $7,%eax
+ jl .LStrConcat3
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ rep
+ movsb
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+.LStrConcat3:
+ movl %eax,%ecx
+ rep
+ movsb
+ end ['EBX','ECX','EAX','ESI','EDI'];
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+{$ifdef hascompilerproc}
+procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring);compilerproc;
+ [public,alias:'FPC_SHORTSTR_APPEND_SHORTSTR'];
+begin
+ asm
+ movl s1,%edi
+ movl s2,%esi
+ movl %edi,%ebx
+ movzbl (%edi),%ecx
+ movl __HIGH(s1),%eax
+ lea 1(%edi,%ecx),%edi
+ negl %ecx
+ addl %eax,%ecx
+ // no need to zero eax, high(s1) <= 255
+ lodsb
+ cmpl %ecx,%eax
+ jbe .LStrConcat1
+ movl %ecx,%eax
+.LStrConcat1:
+ addb %al,(%ebx)
+ cmpl $7,%eax
+ jl .LStrConcat2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ rep
+ movsb
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+.LStrConcat2:
+ movl %eax,%ecx
+ rep
+ movsb
+ end ['EBX','ECX','EAX','ESI','EDI'];
+end;
+{$else hascompilerproc}
+procedure fpc_shortstr_concat_int(const s1,s2:shortstring);[public,alias:'FPC_SHORTSTR_CONCAT'];
+begin
+ asm
+ movl s1,%esi
+ movl s2,%edi
+ movl %edi,%ebx
+ movzbl (%edi),%ecx
+ xor %eax,%eax
+ lea 1(%edi,%ecx),%edi
+ negl %ecx
+ addl $0x0ff,%ecx
+ lodsb
+ cmpl %ecx,%eax
+ jbe .LStrConcat1
+ movl %ecx,%eax
+.LStrConcat1:
+ addb %al,(%ebx)
+ cmpl $7,%eax
+ jl .LStrConcat2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ rep
+ movsb
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+.LStrConcat2:
+ movl %eax,%ecx
+ rep
+ movsb
+ end ['EBX','ECX','EAX','ESI','EDI'];
+end;
+{$endif hascompilerproc}
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+
+{$ifdef SHORTSTRCOMPAREINREG}
+function fpc_shortstr_compare(const left,right:shortstring): longint;assembler; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
+var
+ saveesi,saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl %ebx,saveebx
+ cld
+ movl right,%esi
+ movl left,%edi
+ movzbl (%esi),%eax
+ movzbl (%edi),%ebx
+ movl %eax,%edx
+ incl %esi
+ incl %edi
+ cmpl %ebx,%eax
+ jbe .LStrCmp1
+ movl %ebx,%eax
+.LStrCmp1:
+ cmpl $7,%eax
+ jl .LStrCmp2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ orl %ecx,%ecx
+ rep
+ cmpsb
+ jne .LStrCmp3
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ orl %ecx,%ecx
+ rep
+ cmpsl
+ je .LStrCmp2
+ movl $4,%eax
+ subl %eax,%esi
+ subl %eax,%edi
+.LStrCmp2:
+ movl %eax,%ecx
+ orl %eax,%eax
+ rep
+ cmpsb
+ je .LStrCmp4
+.LStrCmp3:
+ movzbl -1(%esi),%edx // Compare failing (or equal) position
+ movzbl -1(%edi),%ebx
+.LStrCmp4:
+ movl %ebx,%eax // Compare length or position
+ subl %edx,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+ movl saveebx,%ebx
+end;
+{$else SHORTSTRCOMPAREINREG}
+function fpc_shortstr_compare(const left,right:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ asm
+ cld
+ xorl %ebx,%ebx
+ xorl %eax,%eax
+ movl right,%esi
+ movl left,%edi
+ movb (%esi),%al
+ movb (%edi),%bl
+ movl %eax,%edx
+ incl %esi
+ incl %edi
+ cmpl %ebx,%eax
+ jbe .LStrCmp1
+ movl %ebx,%eax
+.LStrCmp1:
+ cmpl $7,%eax
+ jl .LStrCmp2
+ movl %edi,%ecx { Align on 32bits }
+ negl %ecx
+ andl $3,%ecx
+ subl %ecx,%eax
+ orl %ecx,%ecx
+ rep
+ cmpsb
+ jne .LStrCmp3
+ movl %eax,%ecx
+ andl $3,%eax
+ shrl $2,%ecx
+ orl %ecx,%ecx
+ rep
+ cmpsl
+ je .LStrCmp2
+ movl $4,%eax
+ sub %eax,%esi
+ sub %eax,%edi
+.LStrCmp2:
+ movl %eax,%ecx
+ orl %eax,%eax
+ rep
+ cmpsb
+ jne .LStrCmp3
+ cmp %ebx,%edx
+.LStrCmp3:
+ end ['EDX','ECX','EBX','EAX','ESI','EDI'];
+end;
+{$endif SHORTSTRCOMPAREINREG}
+
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$include strpas.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$include strlen.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ movl %ebp,%eax
+end ['EAX'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+{$ifndef REGCALL}
+ movl framebp,%eax
+{$endif}
+ orl %eax,%eax
+ jz .Lg_a_null
+ movl 4(%eax),%eax
+.Lg_a_null:
+end ['EAX'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+{$ifndef REGCALL}
+ movl framebp,%eax
+{$endif}
+ orl %eax,%eax
+ jz .Lgnf_null
+ movl (%eax),%eax
+.Lgnf_null:
+end ['EAX'];
+
+
+{****************************************************************************
+ Math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}
+asm
+{$ifndef REGCALL}
+ movl l,%eax
+{$endif}
+ cltd
+ xorl %edx,%eax
+ subl %edx,%eax
+end ['EAX','EDX'];
+
+
+{$define FPC_SYSTEM_HAS_ODD_LONGINT}
+function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}
+asm
+{$ifdef SYSTEMINLINE}
+ movl l,%eax
+{$else}
+{$ifndef REGCALL}
+ movl l,%eax
+{$endif}
+{$endif}
+ andl $1,%eax
+ setnz %al
+end ['EAX'];
+
+
+{$define FPC_SYSTEM_HAS_SQR_LONGINT}
+function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}
+asm
+{$ifdef SYSTEMINLINE}
+ movl l,%eax
+{$else}
+{$ifndef REGCALL}
+ movl l,%eax
+{$endif}
+{$endif}
+ imull %eax,%eax
+end ['EAX'];
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ movl %esp,%eax
+end;
+
+
+{****************************************************************************
+ Str()
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_INT_STR_LONGINT}
+procedure int_str(l : longint;var s : string);
+var
+ buffer : array[0..15] of byte;
+ isneg : byte;
+begin
+ { Workaround: }
+ if l=longint($80000000) then
+ begin
+ s:='-2147483648';
+ exit;
+ end;
+ asm
+ movl l,%eax // load Integer
+ xorl %ecx,%ecx // String length=0
+ leal buffer,%ebx
+ movl $0x0a,%esi // load 10 as dividing constant.
+ movb $0,isneg
+ orl %eax,%eax // Sign ?
+ jns .LM2
+ movb $1,isneg
+ negl %eax
+.LM2:
+ cltd
+ idivl %esi
+ addb $0x30,%dl // convert Rest to ASCII.
+ movb %dl,(%ebx)
+ incl %ecx
+ incl %ebx
+ cmpl $0,%eax
+ jnz .LM2
+ { now copy the string }
+ movl s,%edi // Load String address
+ cmpb $0,isneg
+ je .LM3
+ movb $0x2d,(%ebx)
+ incl %ecx
+ incl %ebx
+.LM3:
+ movb %cl,(%edi) // Copy String length
+ incl %edi
+.LM4:
+ decl %ebx
+ movb (%ebx),%al
+ stosb
+ decl %ecx
+ jnz .LM4
+ end ['eax','ecx','edx','ebx','esi','edi'];
+end;
+
+
+{$define FPC_SYSTEM_HAS_INT_STR_LONGWORD}
+procedure int_str(c : longword;var s : string);
+var
+ buffer : array[0..15] of byte;
+begin
+ asm
+ movl c,%eax // load CARDINAL
+ xorl %ecx,%ecx // String length=0
+ leal buffer,%ebx
+ movl $0x0a,%esi // load 10 as dividing constant.
+.LM4:
+ xorl %edx,%edx
+ divl %esi
+ addb $0x30,%dl // convert Rest to ASCII.
+ movb %dl,(%ebx)
+ incl %ecx
+ incl %ebx
+ cmpl $0,%eax
+ jnz .LM4
+ { now copy the string }
+ movl s,%edi // Load String address
+ movb %cl,(%edi) // Copy String length
+ incl %edi
+.LM5:
+ decl %ebx
+ movb (%ebx),%al
+ stosb
+ decl %ecx
+ jnz .LM5
+ end ['eax','ecx','edx','ebx','esi','edi'];
+end;
+
+
+{****************************************************************************
+ Bounds Check
+****************************************************************************}
+
+{$ifndef NOBOUNDCHECK}
+
+procedure int_boundcheck;assembler;[public,alias: 'FPC_BOUNDCHECK'];
+var dummy_to_force_stackframe_generation_for_trace: Longint;
+{
+ called with:
+ %ecx - value
+ %edi - pointer to the ranges
+}
+asm
+ cmpl (%edi),%ecx
+ jl .Lbc_err
+ cmpl 4(%edi),%ecx
+ jle .Lbc_ok
+.Lbc_err:
+ pushl %ebp
+ pushl $201
+ call HandleErrorFrame
+.Lbc_ok:
+end;
+
+{$endif NOBOUNDCHECK}
+
+{ do a thread save inc/dec }
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+function declocked(var l : longint) : boolean;assembler;
+
+ asm
+{$ifndef REGCALL}
+ movl l,%eax
+{$endif}
+ { this check should be done because a lock takes a lot }
+ { of time! }
+ cmpb $0,IsMultithread
+ jz .Ldeclockednolock
+ lock
+ decl (%eax)
+ jmp .Ldeclockedend
+.Ldeclockednolock:
+ decl (%eax);
+.Ldeclockedend:
+ setzb %al
+ end;
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l : longint);assembler;
+
+ asm
+{$ifndef REGCALL}
+ movl l,%eax
+{$endif}
+ { this check should be done because a lock takes a lot }
+ { of time! }
+ cmpb $0,IsMultithread
+ jz .Linclockednolock
+ lock
+ incl (%eax)
+ jmp .Linclockedend
+.Linclockednolock:
+ incl (%eax)
+.Linclockedend:
+ end;
+
+{****************************************************************************
+ FPU
+****************************************************************************}
+
+const
+ fpucw : word = $1332;
+ { Internal constants for use in system unit }
+ FPU_Invalid = 1;
+ FPU_Denormal = 2;
+ FPU_DivisionByZero = 4;
+ FPU_Overflow = 8;
+ FPU_Underflow = $10;
+ FPU_StackUnderflow = $20;
+ FPU_StackOverflow = $40;
+ FPU_ExceptionMask = $ff;
+
+{$define FPC_SYSTEM_HAS_SYSRESETFPU}
+Procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ fninit
+ fldcw fpucw
+ fwait
+end;
+
+
+
+{
+ $Log: i386.inc,v $
+ Revision 1.69 2005/03/14 21:09:04 florian
+ * widestring manager can handle now ansi<->wide string conversions even if the lens don't match
+
+ Revision 1.68 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.67 2005/01/23 20:03:23 florian
+ + fastmove from John O'Harrow integrated
+
+}
diff --git a/rtl/i386/int64p.inc b/rtl/i386/int64p.inc
new file mode 100644
index 0000000000..e8970abd97
--- /dev/null
+++ b/rtl/i386/int64p.inc
@@ -0,0 +1,267 @@
+{
+ $Id: int64p.inc,v 1.7 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains some helper routines for int64 and qword
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$Q- no overflow checking }
+{$R- no range checking }
+
+{$define FPC_SYSTEM_HAS_DIV_QWORD}
+ function fpc_div_qword(n,z : qword) : qword;assembler;[public,alias: 'FPC_DIV_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ shift,lzz,lzn : longint;
+ saveebx,saveedi : longint;
+ asm
+ movl %ebx,saveebx
+ movl %edi,saveedi
+ { the following piece of code is taken from the }
+ { AMD Athlon Processor x86 Code Optimization manual }
+ movl n+4,%ecx
+ movl n,%ebx
+ movl %ecx,%eax
+ orl %ebx,%eax
+ jnz .Lnodivzero
+{$ifdef REGCALL}
+ movl %ebp,%edx
+ movl $200,%eax
+{$else}
+ pushl %ebp
+ pushl $200
+{$endif}
+ call HandleErrorFrame
+ jmp .Lexit
+.Lnodivzero:
+ movl z+4,%edx
+ movl z,%eax
+ testl %ecx,%ecx
+ jnz .Lqworddivbigdivisor
+ cmpl %ebx,%edx
+ jae .Lqworddivtwo_divs
+ divl %ebx
+ movl %ecx,%edx
+ jmp .Lexit
+
+ .Lqworddivtwo_divs:
+ movl %eax,%ecx
+ movl %edx,%eax
+ xorl %edx,%edx
+ divl %ebx
+ xchgl %ecx,%eax
+ divl %ebx
+ movl %ecx,%edx
+ jmp .Lexit
+
+ .Lqworddivbigdivisor:
+ movl %ecx,%edi
+ shrl $1,%edx
+ rcrl $1,%eax
+ rorl $1,%edi
+ rcrl $1,%ebx
+ bsrl %ecx,%ecx
+ shrdl %cl,%edi,%ebx
+ shrdl %cl,%edx,%eax
+ shrl %cl,%edx
+ roll $1,%edi
+ divl %ebx
+ movl z,%ebx
+ movl %eax,%ecx
+ imull %eax,%edi
+ mull n
+ addl %edi,%edx
+ subl %eax,%ebx
+ movl %ecx,%eax
+ movl z+4,%ecx
+ sbbl %edx,%ecx
+ sbbl $0,%eax
+ xorl %edx,%edx
+.Lexit:
+ movl saveebx,%ebx
+ movl saveedi,%edi
+ end;
+
+
+{$define FPC_SYSTEM_HAS_MOD_QWORD}
+ function fpc_mod_qword(n,z : qword) : qword;assembler;[public,alias: 'FPC_MOD_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ shift,lzz,lzn : longint;
+ saveebx,saveedi : longint;
+ asm
+ movl %ebx,saveebx
+ movl %edi,saveedi
+ { the following piece of code is taken from the }
+ { AMD Athlon Processor x86 Code Optimization manual }
+ movl n+4,%ecx
+ movl n,%ebx
+ movl %ecx,%eax
+ orl %ebx,%eax
+ jnz .Lnodivzero
+{$ifdef REGCALL}
+ movl %ebp,%edx
+ movl $200,%eax
+{$else}
+ pushl %ebp
+ pushl $200
+{$endif}
+ call HandleErrorFrame
+ jmp .Lexit
+.Lnodivzero:
+ movl z+4,%edx
+ movl z,%eax
+ testl %ecx,%ecx
+ jnz .Lqwordmodr_big_divisior
+ cmpl %ebx,%edx
+ jae .Lqwordmodr_two_divs
+ divl %ebx
+ movl %edx,%eax
+ movl %ecx,%edx
+ jmp .Lexit
+
+ .Lqwordmodr_two_divs:
+ movl %eax,%ecx
+ movl %edx,%eax
+ xorl %edx,%edx
+ divl %ebx
+ movl %ecx,%eax
+ divl %ebx
+ movl %edx,%eax
+ xorl %edx,%edx
+ jmp .Lexit
+
+ .Lqwordmodr_big_divisior:
+ movl %ecx,%edi
+ shrl $1,%edx
+ rcrl $1,%eax
+ rorl $1,%edi
+ rcrl $1,%ebx
+ bsrl %ecx,%ecx
+ shrdl %cl,%edi,%ebx
+ shrdl %cl,%edx,%eax
+ shrl %cl,%edx
+ roll $1,%edi
+ divl %ebx
+ movl z,%ebx
+ movl %eax,%ecx
+ imull %eax,%edi
+ mull n
+ addl %edi,%edx
+ subl %eax,%ebx
+ movl z+4,%ecx
+ movl n,%eax
+ sbbl %edx,%ecx
+ sbbl %edx,%edx
+ andl %edx,%eax
+ andl n+4,%edx
+ addl %ebx,%eax
+ adcl %ecx,%edx
+.Lexit:
+ movl saveebx,%ebx
+ movl saveedi,%edi
+ end;
+
+{$define FPC_SYSTEM_HAS_MUL_QWORD}
+ { multiplies two qwords
+ the longbool for checkoverflow avoids a misaligned stack
+ }
+ function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword;[public,alias: 'FPC_MUL_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ r : qword;
+ overflowed : boolean;
+ begin
+ overflowed:=false;
+ { the following piece of code is taken from the
+ AMD Athlon Processor x86 Code Optimization manual }
+ asm
+ movl f1+4,%edx
+ movl f2+4,%ecx
+ cmpl $0,checkoverflow
+ jnz .Loverflowchecked
+
+ orl %ecx,%edx
+ movl f2,%edx
+ movl f1,%eax
+ jnz .Lqwordmultwomul
+ mull %edx
+ jmp .Lqwordmulready
+ .Lqwordmultwomul:
+ imul f1+4,%edx
+ imul %eax,%ecx
+ addl %edx,%ecx
+ mull f2
+ add %ecx,%edx
+ .Lqwordmulready:
+ movl %eax,r
+ movl %edx,r+4
+ jmp .Lend
+
+ .Loverflowchecked:
+ { if both upper dwords are <>0 then it overflows always }
+ or %ecx,%ecx
+ jz .Loverok1
+ or %edx,%edx
+ jnz .Loverflowed
+ .Loverok1:
+ { overflow checked code }
+ orl %ecx,%edx
+ movl f2,%edi
+ movl f1,%esi
+ jnz .Lqwordmultwomul2
+ movl %edi,%eax
+ mull %esi
+ movl %eax,%esi
+ movl %edx,%edi
+ jmp .Lqwordmulready2
+
+ .Lqwordmultwomul2:
+ movl f1+4,%eax
+ mull %edi
+ movl %eax,%edi
+ jc .Loverflowed
+
+ movl %esi,%eax
+ mull %ecx
+ movl %eax,%ecx
+ jc .Loverflowed
+
+ addl %edi,%ecx
+ jc .Loverflowed
+
+ movl f2,%eax
+ mull %esi
+ movl %eax,%esi
+ movl %edx,%edi
+
+ addl %ecx,%edi
+ jc .Loverflowed
+
+ .Lqwordmulready2:
+ movl %esi,r
+ movl %edi,r+4
+ jmp .Lend
+
+ .Loverflowed:
+ movb $1,overflowed
+
+ .Lend:
+ end [ 'eax','edx','ecx','edi','esi' ];
+ fpc_mul_qword:=r;
+
+ if overflowed then
+ HandleErrorFrame(215,get_frame);
+ end;
+
+{
+ $Log: int64p.inc,v $
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/makefile.cpu b/rtl/i386/makefile.cpu
new file mode 100644
index 0000000000..76c3d74488
--- /dev/null
+++ b/rtl/i386/makefile.cpu
@@ -0,0 +1,7 @@
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=i386 math set setjump setjumph
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
+
diff --git a/rtl/i386/math.inc b/rtl/i386/math.inc
new file mode 100644
index 0000000000..eaebacdbc6
--- /dev/null
+++ b/rtl/i386/math.inc
@@ -0,0 +1,290 @@
+{
+ $Id: math.inc,v 1.24 2005/03/13 17:14:46 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team
+
+ Implementation of mathematical routines (for extended type)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ FPU Control word
+ ****************************************************************************}
+
+ procedure Set8087CW(cw:word);assembler;
+ asm
+{$ifndef REGCALL}
+ movw cw,%ax
+{$endif}
+ movw %ax,default8087cw
+ fnclex
+ fldcw default8087cw
+ end;
+
+ function Get8087CW:word;assembler;
+ asm
+ pushl $0
+ fnstcw (%esp)
+ popl %eax
+ end;
+
+{****************************************************************************
+ EXTENDED data type routines
+ ****************************************************************************}
+
+{$ifdef INTERNCONSTINTF}
+ {$define FPC_SYSTEM_HAS_PI}
+ function fpc_pi_real : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_ABS}
+ function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SQR}
+ function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_ARCTAN}
+ function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_LN}
+ function fpc_ln_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SIN}
+ function fpc_sin_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_COS}
+ function fpc_cos_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+{$else}
+ {$define FPC_SYSTEM_HAS_PI}
+ function pi : ValReal;[internproc:fpc_in_pi];
+ {$define FPC_SYSTEM_HAS_ABS}
+ function abs(d : ValReal) : ValReal;[internproc:fpc_in_abs_real];
+ {$define FPC_SYSTEM_HAS_SQR}
+ function sqr(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function sqrt(d : ValReal) : ValReal;[internproc:fpc_in_sqrt_real];
+ {$define FPC_SYSTEM_HAS_ARCTAN}
+ function arctan(d : ValReal) : ValReal;[internproc:fpc_in_arctan_real];
+ {$define FPC_SYSTEM_HAS_LN}
+ function ln(d : ValReal) : ValReal;[internproc:fpc_in_ln_real];
+ {$define FPC_SYSTEM_HAS_SIN}
+ function sin(d : ValReal) : ValReal;[internproc:fpc_in_sin_real];
+ {$define FPC_SYSTEM_HAS_COS}
+ function cos(d : ValReal) : ValReal;[internproc:fpc_in_cos_real];
+{$endif}
+
+ {$define FPC_SYSTEM_HAS_EXP}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc;
+ {$else}
+ function exp(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_exp];
+ {$endif}
+ asm
+ // comes from DJ GPP
+ fldt d
+ fldl2e
+ fmulp %st,%st(1)
+ fstcw .LCW1
+ fstcw .LCW2
+ fwait
+ andw $0xf3ff,.LCW2
+ orw $0x0400,.LCW2
+ fldcw .LCW2
+ fld %st(0)
+ frndint
+ fldcw .LCW1
+ fxch %st(1)
+ fsub %st(1),%st
+ f2xm1
+ fld1
+ faddp %st,%st(1)
+ fscale
+ fstp %st(1)
+ fclex
+ jmp .LCW3
+ // store some help data in the data segment
+ .data
+ .LCW1:
+ .word 0
+ .LCW2:
+ .word 0
+ .text
+ .LCW3:
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_FRAC}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_frac_real(d : ValReal) : ValReal;assembler;compilerproc;
+ {$else}
+ function frac(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_frac];
+ {$endif}
+ asm
+ subl $16,%esp
+ fnstcw -4(%ebp)
+ fwait
+ movw -4(%ebp),%cx
+ orw $0x0f00,%cx
+ movw %cx,-8(%ebp)
+ fldcw -8(%ebp)
+ fldt d
+ frndint
+ fldt d
+ fsub %st(1),%st
+ fstp %st(1)
+ fldcw -4(%ebp)
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_INT}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_int_real(d : ValReal) : ValReal;assembler;compilerproc;
+ {$else}
+ function int(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_int];
+ {$endif}
+ asm
+ subl $16,%esp
+ fnstcw -4(%ebp)
+ fwait
+ movw -4(%ebp),%cx
+ orw $0x0f00,%cx
+ movw %cx,-8(%ebp)
+ fldcw -8(%ebp)
+ fwait
+ fldt d
+ frndint
+ fwait
+ fldcw -4(%ebp)
+ end;
+
+
+
+ {$define FPC_SYSTEM_HAS_TRUNC}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_trunc_real(d : ValReal) : int64;assembler;compilerproc;
+ {$else}
+ function trunc(d : ValReal) : int64;assembler;[internconst:fpc_in_const_trunc];
+ {$endif}
+ var
+ oldcw,
+ newcw : word;
+ res : int64;
+ asm
+ fnstcw oldcw
+ fwait
+ movw oldcw,%cx
+ orw $0x0f00,%cx
+ movw %cx,newcw
+ fldcw newcw
+ fldt d
+ fistpq res
+ fwait
+ movl res,%eax
+ movl res+4,%edx
+ fldcw oldcw
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_ROUND}
+ {$ifdef internconstintf}
+ function fpc_round_real(d : ValReal) : int64;assembler;compilerproc;
+ {$else}
+ {$ifdef hascompilerproc}
+ function round(d : ValReal) : int64;[internconst:fpc_in_const_round, external name 'FPC_ROUND'];
+ function fpc_round(d : ValReal) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+ {$else}
+ function round(d : ValReal) : int64;assembler;[internconst:fpc_in_const_round];
+ {$endif hascompilerproc}
+ {$endif}
+ var
+ res : int64;
+ asm
+ fldt d
+ fistpq res
+ fwait
+ movl res,%eax
+ movl res+4,%edx
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_POWER}
+ function power(bas,expo : ValReal) : ValReal;
+ begin
+ if bas=0 then
+ begin
+ if expo<>0 then
+ power:=0.0
+ else
+ HandleError(207);
+ end
+ else if expo=0 then
+ power:=1
+ else
+ { bas < 0 is not allowed when doing roots }
+ if (bas<0) and (frac(expo) <> 0) then
+ handleerror(207)
+ else
+ begin
+ power:=exp(ln(abs(bas))*expo);
+ if (bas < 0) and
+ odd(trunc(expo)) then
+ begin
+ power := -power;
+ end;
+ end;
+ end;
+
+{
+ $Log: math.inc,v $
+ Revision 1.24 2005/03/13 17:14:46 florian
+ * some floating point routines improved
+
+ Revision 1.23 2005/03/09 20:50:11 florian
+ * C. Western: utf-8 reading from resource files
+
+ Revision 1.22 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/mathu.inc b/rtl/i386/mathu.inc
new file mode 100644
index 0000000000..e64464d40f
--- /dev/null
+++ b/rtl/i386/mathu.inc
@@ -0,0 +1,105 @@
+{
+ $Id: mathu.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2003 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$ASMMODE ATT}
+{$define FPC_MATH_HAS_ARCTAN2}
+function arctan2(y,x : float) : float;assembler;
+ asm
+ fldt y
+ fldt x
+ fpatan
+ fwait
+ end;
+
+
+procedure SetSSECSR(w : dword);
+ var
+ _w : dword;
+ begin
+ _w:=w;
+ asm
+ ldmxcsr _w
+ end;
+ end;
+
+
+function GetSSECSR : dword;
+ var
+ _w : dword;
+ begin
+ asm
+ stmxcsr _w
+ end;
+ result:=_w;
+ end;
+
+
+function GetRoundMode: TFPURoundingMode;
+begin
+ Result := TFPURoundingMode((Get8087CW shr 10) and 3);
+end;
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+var
+ CtlWord: Word;
+begin
+ CtlWord := Get8087CW;
+ Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
+ Result := TFPURoundingMode((CtlWord shr 10) and 3);
+end;
+
+function GetPrecisionMode: TFPUPrecisionMode;
+begin
+ Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
+end;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+var
+ CtlWord: Word;
+begin
+ CtlWord := Get8087CW;
+ Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
+ Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
+end;
+
+function GetExceptionMask: TFPUExceptionMask;
+begin
+ Result := TFPUExceptionMask(Longint(Get8087CW and $3F));
+end;
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+var
+ CtlWord: Word;
+begin
+ CtlWord := Get8087CW;
+ Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
+ Result := TFPUExceptionMask(Longint(CtlWord and $3F));
+end;
+
+procedure ClearExceptions(RaisePending: Boolean);assembler;
+asm
+ cmpb $0,RaisePending
+ je .Lclear
+ fwait
+.Lclear:
+ fnclex
+end;
+
+{
+ $Log: mathu.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/mathuh.inc b/rtl/i386/mathuh.inc
new file mode 100644
index 0000000000..0c9196ba00
--- /dev/null
+++ b/rtl/i386/mathuh.inc
@@ -0,0 +1,41 @@
+{
+ $Id: mathuh.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2003 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ i386 fpu control word }
+type
+ TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
+ TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
+ TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
+ exOverflow, exUnderflow, exPrecision);
+ TFPUExceptionMask = set of TFPUException;
+
+function GetRoundMode: TFPURoundingMode;
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+function GetPrecisionMode: TFPUPrecisionMode;
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+function GetExceptionMask: TFPUExceptionMask;
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
+
+procedure SetSSECSR(w : dword);
+function GetSSECSR : dword;
+
+
+{
+ $Log: mathuh.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/mmx.pp b/rtl/i386/mmx.pp
new file mode 100644
index 0000000000..b92f4a595a
--- /dev/null
+++ b/rtl/i386/mmx.pp
@@ -0,0 +1,253 @@
+{
+ $Id: mmx.pp,v 1.11 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ This unit contains some helpful stuff to deal with the mmx extensions }
+unit mmx;
+
+ interface
+
+ type
+ tmmxshortint = array[0..7] of shortint;
+ tmmxbyte = array[0..7] of byte;
+ tmmxword = array[0..3] of word;
+ tmmxinteger = array[0..3] of integer;
+ tmmxlongint = array[0..1] of longint;
+ tmmxcardinal = array[0..1] of cardinal;
+ { for the AMD 3D }
+ tmmxsingle = array[0..1] of single;
+
+ pmmxshortint = ^tmmxshortint;
+ pmmxbyte = ^tmmxbyte;
+ pmmxword = ^tmmxword;
+ pmmxinteger = ^tmmxinteger;
+{$ifdef HASFIXED}
+ pmmxfixed = ^tmmxfixed;
+{$endif HASFIXED}
+ pmmxlongint = ^tmmxlongint;
+ pmmxcardinal = ^tmmxcardinal;
+ { for the AMD 3D }
+ pmmxsingle = ^tmmxsingle;
+
+ const
+ is_mmx_cpu : boolean = false;
+ is_sse_cpu : boolean = false;
+ is_sse2_cpu : boolean = false;
+ is_amd_3d_cpu : boolean = false;
+ is_amd_3d_dsp_cpu : boolean = false;
+ is_amd_3d_mmx_cpu : boolean = false;
+
+ { sets all floating point registers to empty
+ (use this after mmx usage)
+ }
+ procedure emms;
+ procedure femms;
+
+ implementation
+
+ uses
+ cpu;
+
+ {$ASMMODE ATT}
+
+ { return base type of processor: 0 - is Unknown, 10 - is AMD (AuthenticAMD), }
+ { 20 - is Intel (GenuineIntel) }
+ function getdevel:byte;
+
+ var
+ _ebx,_ecx,_edx : longint;
+ begin
+ getdevel:=0;
+ if cpuid_support then
+ begin
+ asm
+ movl $0,%eax
+ cpuid
+ movl %ebx,_ebx
+ movl %ecx,_ecx
+ movl %edx,_edx
+ end;
+ if ((_ebx=$68747541) and (_ecx=$444D4163) and (_edx=$69746E65)) then getdevel:=10;
+ if ((_ebx=$756E6547) and (_ecx=$6C65746E) and (_edx=$49656E69)) then getdevel:=20;
+ end
+ end;
+
+
+ { returns true, if the processor supports the mmx instructions }
+ function mmx_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $1,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ mmx_support:=(_edx and $800000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never mmx }
+ mmx_support:=false;
+ end;
+
+ function amd_3d_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $0x80000001,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ amd_3d_support:=(_edx and $80000000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never mmx }
+ amd_3d_support:=false;
+ end;
+
+ function amd_3d_dsp_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $0x80000001,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ amd_3d_dsp_support:=(_edx and $40000000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never mmx }
+ amd_3d_dsp_support:=false;
+ end;
+
+ function amd_3d_mmx_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $0x80000001,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ amd_3d_mmx_support:=(_edx and $400000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never mmx }
+ amd_3d_mmx_support:=false;
+ end;
+
+ function sse_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $1,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ sse_support:=(_edx and $2000000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never sse }
+ sse_support:=false;
+ end;
+
+ function sse2_support : boolean;
+
+ var
+ _edx : longint;
+
+ begin
+ if cpuid_support then
+ begin
+ asm
+ movl $1,%eax
+ cpuid
+ movl %edx,_edx
+ end;
+ sse2_support:=(_edx and $4000000)<>0;
+ end
+ else
+ { a cpu with without cpuid instruction supports never sse2 }
+ sse2_support:=false;
+ end;
+
+ procedure emms;assembler;
+
+ asm
+ emms
+ end;
+
+ procedure femms;assembler;
+
+ asm
+ .byte 0x0f, 0x0e
+{ femms instruction not supported with older as versions }
+ end;
+
+
+ var
+ oldexitproc : pointer;
+
+ procedure mmxexitproc;
+
+ begin
+ exitproc:=oldexitproc;
+ if is_amd_3d_cpu then femms else emms;
+ end;
+
+begin
+ if mmx_support then
+ begin
+ is_mmx_cpu:=true;
+ if amd_3d_support then
+ begin
+ is_amd_3d_cpu:=true;
+ is_amd_3d_dsp_cpu:=amd_3d_dsp_support;
+ is_amd_3d_mmx_cpu:=amd_3d_mmx_support;
+ end;
+ is_sse_cpu:=sse_support;
+ is_sse2_cpu:=sse2_support;
+ { the exit code sets the fpu stack to empty }
+ oldexitproc:=exitproc;
+ exitproc:=@mmxexitproc;
+ end;
+end.
+{
+ $Log: mmx.pp,v $
+ Revision 1.11 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/readme b/rtl/i386/readme
new file mode 100644
index 0000000000..b7a8acb731
--- /dev/null
+++ b/rtl/i386/readme
@@ -0,0 +1,17 @@
+This directory contains only RTL parts specific to the processor I386 family.
+
+(They are specific because they contain assembler instructions)
+
+Include files for system are :
+ heap.inc (heap handling)
+ set.inc (sets operations)
+ math.inc (mathematic operations using the coprocessor)
+ i386.inc (several functions/procedures containing assembler parts)
+ setjump.inc (setjmp/longjmp implementation for exceptions)
+ rttip.inc (rtti handling, for speed reasons)
+
+Units are :
+ strings.pp (written in assembler for speed)
+ cpu.pp (routines to access cpu info)
+ mmx.pp (special mmx routines)
+
diff --git a/rtl/i386/set.inc b/rtl/i386/set.inc
new file mode 100644
index 0000000000..e89eace060
--- /dev/null
+++ b/rtl/i386/set.inc
@@ -0,0 +1,692 @@
+{
+ $Id: set.inc,v 1.19 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Include file with set operations called by the compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ load a normal set p from a smallset l
+}
+var
+ saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl __RESULT,%edi
+ movl l,%eax
+ stosl
+ xorl %eax,%eax
+ movl $7,%ecx
+ rep
+ stosl
+ movl saveedi,%edi
+end;
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+
+function fpc_set_create_element(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ create a new set in p from an element b
+}
+var
+ saveedi : longint;
+asm
+{$ifndef hascompilerproc}
+ pushl %eax
+ pushl %ecx
+{$endif not hascompilerproc}
+ movl %edi,saveedi
+ movl __RESULT,%edi
+ movzbl b,%edx
+ xorl %eax,%eax
+ movl $8,%ecx
+ rep
+ stosl
+ leal -32(%edi),%eax
+ btsl %edx,(%eax)
+ movl saveedi,%edi
+{$ifndef hascompilerproc}
+ popl %ecx
+ popl %eax
+{$endif hascompilerproc}
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+{$ifdef hascompilerproc}
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+ add the element b to the set pointed by source
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl source,%esi
+ movl __RESULT,%edi
+ movzbl b,%edx
+ movl $8,%ecx
+ rep
+ movsl
+ leal -32(%edi),%eax
+ btsl %edx,(%eax)
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$else hascompilerproc}
+function fpc_set_set_byte(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_SET_BYTE'];
+{
+ add the element b to the set pointed by p
+}
+asm
+ pushl %eax
+ movl __RESULT,%edi
+ movb b,%al
+ andl $0xf8,%eax
+ shrl $3,%eax
+ addl %eax,%edi
+ movb b,%al
+ andl $7,%eax
+ btsl %eax,(%edi)
+ popl %eax
+end;
+{$endif hascompilerproc}
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+{$ifdef hascompilerproc}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+ add the element b to the set pointed by source
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl source,%esi
+ movl __RESULT,%edi
+ movzbl b,%edx
+ movl $8,%ecx
+ rep
+ movsl
+ leal -32(%edi),%eax
+ btrl %edx,(%eax)
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$else hascompilerproc}
+function fpc_set_unset_byte(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_UNSET_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ suppresses the element b to the set pointed by p
+ used for exclude(set,element)
+}
+asm
+ pushl %eax
+ movl __RESULT,%edi
+ movb b,%al
+ andl $0xf8,%eax
+ shrl $3,%eax
+ addl %eax,%edi
+ movb b,%al
+ andl $7,%eax
+ btrl %eax,(%edi)
+ popl %eax
+end;
+{$endif hascompilerproc}
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+
+{$ifdef hascompilerproc}
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set;assembler; compilerproc;
+{
+ adds the range [l..h] to the set pointed to by p
+}
+var
+ saveh : byte;
+ saveesi,saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl %ebx,saveebx
+ movl __RESULT,%edi // target set address in edi
+ movl orgset, %esi // source set address in esi
+ movzbl l,%eax // lowest bit to be set in eax
+ movzbl h,%ebx // highest in ebx
+ movb %bl,saveh
+ movl $8,%ecx // we have to copy 32 bytes
+ cmpl %eax,%ebx // high < low?
+ rep // copy source to dest (it's possible to do the range
+ movsl // setting and copying simultanuously of course, but
+ // that would result in many more jumps and code)
+ movl %eax,%ecx // lowest also in ecx
+ jb .Lset_range_done // if high > low, then dest := source
+ shrl $3,%eax // divide by 8 to get starting and ending byte
+ shrl $3,%ebx // address
+ andb $31,%cl // low five bits of lo determine start of bit mask
+ andl $0x0fffffffc,%eax // clear two lowest bits to get start/end longint
+ subl $32,%edi // get back to start of dest
+ andl $0x0fffffffc,%ebx // address * 4
+ movl $0x0ffffffff,%edx // edx = bitmask to be inserted
+ shll %cl,%edx // shift bitmask to clear bits below lo
+ addl %eax,%edi // go to starting pos in set
+ subl %eax,%ebx // are bit lo and hi in the same longint?
+ jz .Lset_range_hi // yes, keep current mask and adjust for hi bit
+ orl %edx,(%edi) // no, store current mask
+ movl $0x0ffffffff,%edx // new mask
+ addl $4,%edi // next longint of set
+ subl $4,%ebx // bit hi in this longint?
+ jz .Lset_range_hi // yes, keep full mask and adjust for hi bit
+.Lset_range_loop:
+ movl %edx,(%edi) // no, fill longints in between with full mask
+ addl $4,%edi
+ subl $4,%ebx
+ jnz .Lset_range_loop
+.Lset_range_hi:
+ movb saveh,%cl // this is ok, h is on the stack
+ movl %edx,%ebx // save current bitmask
+ andb $31,%cl
+ subb $31,%cl // cl := (31 - (hi and 31)) = shift count to
+ negb %cl // adjust bitmask for hi bit
+ shrl %cl,%edx // shift bitmask to clear bits higher than hi
+ andl %edx,%ebx // combine both bitmasks
+ orl %ebx,(%edi) // store to set
+.Lset_range_done:
+ movl saveedi,%edi
+ movl saveesi,%esi
+ movl saveebx,%ebx
+end;
+
+{$else hascompilerproc}
+
+function fpc_set_set_range(l,h : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_SET_RANGE'];
+{
+ adds the range [l..h] to the set pointed to by p
+}
+asm
+ movl __RESULT,%edi // set address in edi
+ movzbl l,%eax // lowest bit to be set in eax
+ movzbl h,%ebx // highest in ebx
+ cmpl %eax,%ebx
+ jb .Lset_range_done
+ movl %eax,%ecx // lowest also in ecx
+ shrl $3,%eax // divide by 8 to get starting and ending byte
+ shrl $3,%ebx // address
+ andb $31,%cl // low five bits of lo determine start of bit mask
+ movl $0x0ffffffff,%edx // edx = bitmask to be inserted
+ andl $0x0fffffffc,%eax // clear two lowest bits to get start/end longint
+ andl $0x0fffffffc,%ebx // address * 4
+ shll %cl,%edx // shift bitmask to clear bits below lo
+ addl %eax,%edi // go to starting pos in set
+ subl %eax,%ebx // are bit lo and hi in the same longint?
+ jz .Lset_range_hi // yes, keep current mask and adjust for hi bit
+ orl %edx,(%edi) // no, store current mask
+ movl $0x0ffffffff,%edx // new mask
+ addl $4,%edi // next longint of set
+ subl $4,%ebx // bit hi in this longint?
+ jz .Lset_range_hi // yes, keep full mask and adjust for hi bit
+.Lset_range_loop:
+ movl %edx,(%edi) // no, fill longints in between with full mask
+ addl $4,%edi
+ subl $4,%ebx
+ jnz .Lset_range_loop
+.Lset_range_hi:
+ movb h,%cl
+ movl %edx,%ebx // save current bitmask
+ andb $31,%cl
+ subb $31,%cl // cl := (31 - (hi and 31)) = shift count to
+ negb %cl // adjust bitmask for hi bit
+ shrl %cl,%edx // shift bitmask to clear bits higher than hi
+ andl %edx,%ebx // combine both bitmasks
+ orl %ebx,(%edi) // store to set
+.Lset_range_done:
+end;
+{$endif hascompilerproc}
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
+
+function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; assembler; [public,alias:'FPC_SET_IN_BYTE']; {$ifdef hascompilerproc} compilerproc; {$else} {$ifndef NOSAVEREGISTERS}saveregisters;{$endif} {$endif}
+{
+ tests if the element b is in the set p the carryflag is set if it present
+}
+asm
+{$ifdef hascompilerproc}
+{$ifdef REGCALL}
+ xchgl %edx,%eax
+ andl $0xff,%eax
+{$else}
+ movl p,%edx
+ movzbl b,%eax
+{$endif}
+ btl %eax,(%edx)
+{$else hascompilerproc}
+ pushl %eax
+ movl p,%edi
+ movzbl b,%eax
+ btl %eax,(%edi)
+ popl %eax
+{$endif hascompilerproc}
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
+
+{$ifdef hascompilerproc}
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS'];
+{$endif hascompilerproc}
+{
+ adds set1 and set2 into set dest
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl set1,%esi
+ movl __RESULT,%edi
+ movl set2,%edx
+{$else}
+ movl set1,%esi
+ movl set2,%edx
+{$ifdef hascompilerproc}
+ movl __RESULT,%edi
+{$else hascompilerproc}
+ movl dest,%edi
+{$endif hascompilerproc}
+{$endif}
+ movl $8,%ecx
+ .LMADDSETS1:
+ lodsl
+ orl (%edx),%eax
+ stosl
+ addl $4,%edx
+ decl %ecx
+ jnz .LMADDSETS1
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
+
+{$ifdef hascompilerproc}
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS'];
+{$endif hascompilerproc}
+{
+ multiplies (takes common elements of) set1 and set2 result put in dest
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl set1,%esi
+ movl __RESULT,%edi
+ movl set2,%edx
+{$else}
+ movl set1,%esi
+ movl set2,%edx
+{$ifdef hascompilerproc}
+ movl __RESULT,%edi
+{$else hascompilerproc}
+ movl dest,%edi
+{$endif hascompilerproc}
+{$endif}
+ movl $8,%ecx
+ .LMMULSETS1:
+ lodsl
+ andl (%edx),%eax
+ stosl
+ addl $4,%edx
+ decl %ecx
+ jnz .LMMULSETS1
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
+
+{$ifdef hascompilerproc}
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS'];
+{$endif hascompilerproc}
+{
+ computes the diff from set1 to set2 result in dest
+}
+var
+ saveesi,saveedi,saveebx : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl %ebx,saveebx
+{$ifdef REGCALL}
+ movl set1,%esi
+ movl __RESULT,%edi
+ movl set2,%ebx
+{$else}
+ movl set1,%esi
+ movl set2,%ebx
+{$ifdef hascompilerproc}
+ movl __RESULT,%edi
+{$else hascompilerproc}
+ movl dest,%edi
+{$endif hascompilerproc}
+{$endif}
+ movl $8,%ecx
+ .LMSUBSETS1:
+ lodsl
+ movl (%ebx),%edx
+ notl %edx
+ andl %edx,%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMSUBSETS1
+ movl saveedi,%edi
+ movl saveesi,%esi
+ movl saveebx,%ebx
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
+
+{$ifdef hascompilerproc}
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+{$else hascompilerproc}
+procedure fpc_set_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS'];
+{$endif hascompilerproc}
+{
+ computes the symetric diff from set1 to set2 result in dest
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl set1,%esi
+ movl __RESULT,%edi
+ movl set2,%edx
+{$else}
+ movl set1,%esi
+ movl set2,%edx
+{$ifdef hascompilerproc}
+ movl __RESULT,%edi
+{$else hascompilerproc}
+ movl dest,%edi
+{$endif hascompilerproc}
+{$endif}
+ movl $8,%ecx
+ .LMSYMDIFSETS1:
+ lodsl
+ xorl (%edx),%eax
+ stosl
+ addl $4,%edx
+ decl %ecx
+ jnz .LMSYMDIFSETS1
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
+
+function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_COMP_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ compares set1 and set2 zeroflag is set if they are equal
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl set1,%esi
+ movl set2,%edi
+ movl $8,%ecx
+ .LMCOMPSETS1:
+ movl (%esi),%eax
+ movl (%edi),%edx
+ cmpl %edx,%eax
+ jne .LMCOMPSETEND
+ addl $4,%esi
+ addl $4,%edi
+ decl %ecx
+ jnz .LMCOMPSETS1
+ { we are here only if the two sets are equal
+ we have zero flag set, and that what is expected }
+ .LMCOMPSETEND:
+{$ifdef hascompilerproc}
+ seteb %al
+{$endif hascompilerproc}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
+
+function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+}
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl set1,%esi
+ movl set2,%edi
+ movl $8,%ecx
+ .LMCONTAINSSETS1:
+ movl (%esi),%eax
+ movl (%edi),%edx
+ andl %eax,%edx
+ cmpl %edx,%eax {set1 and set2 = set1?}
+ jne .LMCONTAINSSETEND
+ addl $4,%esi
+ addl $4,%edi
+ decl %ecx
+ jnz .LMCONTAINSSETS1
+ { we are here only if set2 contains set1
+ we have zero flag set, and that what is expected }
+ .LMCONTAINSSETEND:
+{$ifdef hascompilerproc}
+ seteb %al
+{$endif hascompilerproc}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+{$ifdef LARGESETS}
+
+{$error Needs to be fixed for register calling first!}
+
+procedure fpc_largeset_set_word(p : pointer;b : word);assembler;[public,alias:'FPC_LARGESET_SET_WORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ sets the element b in set p works for sets larger than 256 elements
+ not yet use by the compiler so
+}
+asm
+ pushl %eax
+ movl p,%edi
+ movw b,%ax
+ andl $0xfff8,%eax
+ shrl $3,%eax
+ addl %eax,%edi
+ movb 12(%ebp),%al
+ andl $7,%eax
+ btsl %eax,(%edi)
+ popl %eax
+end;
+
+
+procedure fpc_largeset_in_word(p : pointer;b : word);assembler;[public,alias:'FPC_LARGESET_IN_WORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ tests if the element b is in the set p the carryflag is set if it present
+ works for sets larger than 256 elements
+}
+asm
+ pushl %eax
+ movl p,%edi
+ movw b,%ax
+ andl $0xfff8,%eax
+ shrl $3,%eax
+ addl %eax,%edi
+ movb 12(%ebp),%al
+ andl $7,%eax
+ btl %eax,(%edi)
+ popl %eax
+end;
+
+
+procedure fpc_largeset_add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_ADD_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ adds set1 and set2 into set dest size is the number of bytes in the set
+}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMADDSETSIZES1:
+ lodsl
+ orl (%ebx),%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMADDSETSIZES1
+end;
+
+
+procedure fpc_largeset_mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_MUL_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ multiplies (i.E. takes common elements of) set1 and set2 result put in
+ dest size is the number of bytes in the set
+}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMMULSETSIZES1:
+ lodsl
+ andl (%ebx),%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMMULSETSIZES1
+end;
+
+
+procedure fpc_largeset_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_SUB_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMSUBSETSIZES1:
+ lodsl
+ movl (%ebx),%edx
+ notl %edx
+ andl %edx,%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMSUBSETSIZES1
+end;
+
+
+procedure fpc_largeset_symdif_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_SYMDIF_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ computes the symetric diff from set1 to set2 result in dest
+}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMSYMDIFSETSIZE1:
+ lodsl
+ movl (%ebx),%edx
+ xorl %edx,%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMSYMDIFSETSIZE1
+end;
+
+
+procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_COMP_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+asm
+ movl set1,%esi
+ movl set2,%edi
+ movl size,%ecx
+ .LMCOMPSETSIZES1:
+ lodsl
+ movl (%edi),%edx
+ cmpl %edx,%eax
+ jne .LMCOMPSETSIZEEND
+ addl $4,%edi
+ decl %ecx
+ jnz .LMCOMPSETSIZES1
+ { we are here only if the two sets are equal
+ we have zero flag set, and that what is expected }
+ .LMCOMPSETSIZEEND:
+end;
+
+procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint);assembler;[public,alias:'FPC_LARGESET_CONTAINS_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+}
+asm
+ movl set1,%esi
+ movl set2,%edi
+ movl size,%ecx
+ .LMCONTAINSSETS2:
+ movl (%esi),%eax
+ movl (%edi),%edx
+ andl %eax,%edx
+ cmpl %edx,%eax {set1 and set2 = set1?}
+ jne .LMCONTAINSSETEND2
+ addl $4,%esi
+ addl $4,%edi
+ decl %ecx
+ jnz .LMCONTAINSSETS2
+ { we are here only if set2 contains set1
+ we have zero flag set, and that what is expected }
+ .LMCONTAINSSETEND2:
+end;
+
+
+{$endif LARGESET}
+
+{
+ $Log: set.inc,v $
+ Revision 1.19 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/setjump.inc b/rtl/i386/setjump.inc
new file mode 100644
index 0000000000..1ace5f6dc3
--- /dev/null
+++ b/rtl/i386/setjump.inc
@@ -0,0 +1,75 @@
+{
+ $Id: setjump.inc,v 1.9 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ SetJmp and LongJmp implementation for exception handling
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
+asm
+{$ifndef REGCALL}
+ movl 8(%ebp),%eax
+{$endif}
+ movl %ebx,(%eax)
+ movl %esi,4(%eax)
+ movl %edi,8(%eax)
+ movl 4(%ebp),%edi
+ movl %edi,20(%eax)
+ movl (%ebp),%edi
+ movl %edi,12(%eax)
+{$ifdef REGCALL}
+ leal 8(%ebp),%edi
+{$else}
+ leal 12(%ebp),%edi
+{$endif}
+ movl %edi,16(%eax)
+ movl 8(%eax),%edi
+ xorl %eax,%eax
+end['EAX'];
+
+
+Procedure longJmp (Var S : Jmp_buf; value : longint); assembler;[Public, alias : 'FPC_LONGJMP'];
+asm
+{$ifdef REGCALL}
+ xchgl %edx,%eax
+{$else}
+ movl 8(%ebp),%edx
+ movl 12(%ebp),%eax
+{$endif}
+
+ movl (%edx),%ebx
+ movl 4(%edx),%esi
+ movl 8(%edx),%edi
+ movl 12(%edx),%ebp
+ movl 16(%edx),%esp
+ // we should also clear the fpu
+ // fninit no must be done elsewhere PM
+ // or we should reset the control word also
+ jmp 20(%edx)
+end;
+
+{
+ $Log: setjump.inc,v $
+ Revision 1.9 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.8 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.7 2005/02/13 20:01:37 peter
+ * include file cleanup
+
+ Revision 1.6 2005/01/20 16:38:28 peter
+ * restore sigprocmask for linux
+
+}
diff --git a/rtl/i386/setjumph.inc b/rtl/i386/setjumph.inc
new file mode 100644
index 0000000000..dceb58ad19
--- /dev/null
+++ b/rtl/i386/setjumph.inc
@@ -0,0 +1,42 @@
+{
+ $Id: setjumph.inc,v 1.8 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1998 the Free Pascal development team
+
+ SetJmp/Longjmp declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Type
+ jmp_buf = packed record
+ ebx,esi,edi : Longint;
+ bp,sp,pc : Pointer;
+ end;
+ PJmp_buf = ^jmp_buf;
+
+Function Setjmp (Var S : Jmp_buf) : longint;
+Procedure longjmp (Var S : Jmp_buf; value : longint);
+
+{
+ $Log: setjumph.inc,v $
+ Revision 1.8 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.6 2005/01/24 16:54:16 peter
+ * no sigprocmask for 1.0.x bootstrapping
+
+ Revision 1.5 2005/01/20 16:38:28 peter
+ * restore sigprocmask for linux
+
+}
diff --git a/rtl/i386/strings.inc b/rtl/i386/strings.inc
new file mode 100644
index 0000000000..3d0fa357d4
--- /dev/null
+++ b/rtl/i386/strings.inc
@@ -0,0 +1,634 @@
+{
+ $Id: strings.inc,v 1.18 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor dependent part of strings.pp, that can be shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ASMMODE ATT}
+
+{$ifndef FPC_UNIT_HAS_STRCOPY}
+{$define FPC_UNIT_HAS_STRCOPY}
+function strcopy(dest,source : pchar) : pchar;assembler;
+var
+ saveeax,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,%edi
+{$else}
+ movl source,%edi
+{$endif}
+ testl %edi,%edi
+ jz .LStrCopyDone
+ leal 3(%edi),%ecx
+ andl $-4,%ecx
+ movl %edi,%esi
+ subl %edi,%ecx
+{$ifdef REGCALL}
+ movl %eax,%edi
+{$else}
+ movl dest,%edi
+{$endif}
+ jz .LStrCopyAligned
+.LStrCopyAlignLoop:
+ movb (%esi),%al
+ incl %edi
+ incl %esi
+ testb %al,%al
+ movb %al,-1(%edi)
+ jz .LStrCopyDone
+ decl %ecx
+ jnz .LStrCopyAlignLoop
+ .balign 16
+.LStrCopyAligned:
+ movl (%esi),%eax
+ movl %eax,%edx
+ leal 0x0fefefeff(%eax),%ecx
+ notl %edx
+ addl $4,%esi
+ andl %edx,%ecx
+ andl $0x080808080,%ecx
+ jnz .LStrCopyEndFound
+ movl %eax,(%edi)
+ addl $4,%edi
+ jmp .LStrCopyAligned
+.LStrCopyEndFound:
+ testl $0x0ff,%eax
+ jz .LStrCopyByte
+ testl $0x0ff00,%eax
+ jz .LStrCopyWord
+ testl $0x0ff0000,%eax
+ jz .LStrCopy3Bytes
+ movl %eax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopy3Bytes:
+ xorb %dl,%dl
+ movw %ax,(%edi)
+ movb %dl,2(%edi)
+ jmp .LStrCopyDone
+.LStrCopyWord:
+ movw %ax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopyByte:
+ movb %al,(%edi)
+.LStrCopyDone:
+{$ifdef REGCALL}
+ movl saveeax,%eax
+{$else}
+ movl dest,%eax
+{$endif}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRECOPY}
+{$define FPC_UNIT_HAS_STRECOPY}
+function strecopy(dest,source : pchar) : pchar;assembler;
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ cld
+ movl dest,%esi
+ movl source,%edi
+ movl $0xffffffff,%ecx
+ xorl %eax,%eax
+ repne
+ scasb
+ not %ecx
+ movl %esi,%edi
+ movl source,%esi
+ movl %ecx,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+ movl %eax,%ecx
+ andl $3,%ecx
+ rep
+ movsb
+ decl %edi
+ movl %edi,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRECOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOPY}
+{$define FPC_UNIT_HAS_STRLCOPY}
+function strlcopy(dest,source : pchar;maxlen : sizeint) : pchar;assembler;
+var
+ savedest,
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ movl source,%esi
+ movl maxlen,%ecx
+ movl dest,%edi
+ movl %edi,savedest
+ orl %ecx,%ecx
+ jz .LSTRLCOPY2
+ cld
+.LSTRLCOPY1:
+ lodsb
+ stosb
+ decl %ecx // Lower maximum
+ jz .LSTRLCOPY2 // 0 reached ends
+ orb %al,%al
+ jnz .LSTRLCOPY1
+ jmp .LSTRLCOPY3
+.LSTRLCOPY2:
+ xorb %al,%al // If cutted
+ stosb // add a #0
+.LSTRLCOPY3:
+ movl savedest,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRLCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STREND}
+{$define FPC_UNIT_HAS_STREND}
+function strend(p : pchar) : pchar;assembler;
+var
+ saveedi : longint;
+asm
+ movl %edi,saveedi
+ cld
+ movl p,%edi
+ xorl %eax,%eax
+ orl %edi,%edi
+ jz .LStrEndNil
+ movl $0xffffffff,%ecx
+ xorl %eax,%eax
+ repne
+ scasb
+ movl %edi,%eax
+ decl %eax
+.LStrEndNil:
+ movl saveedi,%edi
+end;
+{$endif FPC_UNIT_HAS_STREND}
+
+
+
+{$ifndef FPC_UNIT_HAS_STREND}
+{$define FPC_UNIT_HAS_STRCOMP}
+function strcomp(str1,str2 : pchar) : longint;assembler;
+var
+ saveeax,saveedx,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,saveedx
+{$endif}
+ movl str2,%edi
+ movl $0xffffffff,%ecx
+ cld
+ xorl %eax,%eax
+ repne
+ scasb
+ not %ecx
+{$ifdef REGCALL}
+ movl saveedx,%edi
+ movl saveeax,%esi
+{$else}
+ movl str2,%edi
+ movl str1,%esi
+{$endif}
+ repe
+ cmpsb
+ movb -1(%esi),%al
+ movzbl -1(%edi),%ecx
+ subl %ecx,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STREND}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOMP}
+{$define FPC_UNIT_HAS_STRLCOMP}
+function strlcomp(str1,str2 : pchar;l : sizeint) : longint;assembler;
+var
+ saveeax,saveedx,saveecx,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,saveedx
+ movl %ecx,saveecx
+{$endif}
+ movl str2,%edi
+ movl $0xffffffff,%ecx
+ cld
+ xorl %eax,%eax
+ repne
+ scasb
+ not %ecx
+{$ifdef REGCALL}
+ cmpl saveecx,%ecx
+ jl .LSTRLCOMP1
+ movl saveecx,%ecx
+.LSTRLCOMP1:
+ movl saveedx,%edi
+ movl saveeax,%esi
+{$else}
+ cmpl l,%ecx
+ jl .LSTRLCOMP1
+ movl l,%ecx
+.LSTRLCOMP1:
+ movl str2,%edi
+ movl str1,%esi
+{$endif}
+ repe
+ cmpsb
+ movb -1(%esi),%al
+ movzbl -1(%edi),%ecx
+ subl %ecx,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRLCOMP}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRICOMP}
+{$define FPC_UNIT_HAS_STRICOMP}
+function stricomp(str1,str2 : pchar) : longint;assembler;
+var
+ saveeax,saveedx,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,saveedx
+{$endif}
+ movl str2,%edi
+ movl $0xffffffff,%ecx
+ cld
+ xorl %eax,%eax
+ repne
+ scasb
+ not %ecx
+{$ifdef REGCALL}
+ movl saveedx,%edi
+ movl saveeax,%esi
+{$else}
+ movl str2,%edi
+ movl str1,%esi
+{$endif}
+.LSTRICOMP2:
+ repe
+ cmpsb
+ jz .LSTRICOMP3 // If last reached then exit
+ movzbl -1(%esi),%eax
+ movzbl -1(%edi),%edx
+ cmpb $97,%al
+ jb .LSTRICOMP1
+ cmpb $122,%al
+ ja .LSTRICOMP1
+ subb $0x20,%al
+.LSTRICOMP1:
+ cmpb $97,%dl
+ jb .LSTRICOMP4
+ cmpb $122,%dl
+ ja .LSTRICOMP4
+ subb $0x20,%dl
+.LSTRICOMP4:
+ subl %edx,%eax
+ jz .LSTRICOMP2 // If still equal, compare again
+.LSTRICOMP3:
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRICOMP}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRLICOMP}
+{$define FPC_UNIT_HAS_STRLICOMP}
+function strlicomp(str1,str2 : pchar;l : sizeint) : longint;assembler;
+var
+ saveeax,saveedx,saveecx,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,saveedx
+ movl %ecx,saveecx
+{$endif}
+ movl str2,%edi
+ movl $0xffffffff,%ecx
+ cld
+ xorl %eax,%eax
+ repne
+ scasb
+ not %ecx
+{$ifdef REGCALL}
+ cmpl saveecx,%ecx
+ jl .LSTRLICOMP5
+ movl saveecx,%ecx
+.LSTRLICOMP5:
+ movl saveedx,%edi
+ movl saveeax,%esi
+{$else}
+ cmpl l,%ecx
+ jl .LSTRLICOMP5
+ movl l,%ecx
+.LSTRLICOMP5:
+ movl str2,%edi
+ movl str1,%esi
+{$endif}
+.LSTRLICOMP2:
+ repe
+ cmpsb
+ jz .LSTRLICOMP3 // If last reached, exit
+ movzbl -1(%esi),%eax
+ movzbl -1(%edi),%edx
+ cmpb $97,%al
+ jb .LSTRLICOMP1
+ cmpb $122,%al
+ ja .LSTRLICOMP1
+ subb $0x20,%al
+.LSTRLICOMP1:
+ cmpb $97,%dl
+ jb .LSTRLICOMP4
+ cmpb $122,%dl
+ ja .LSTRLICOMP4
+ subb $0x20,%dl
+.LSTRLICOMP4:
+ subl %edx,%eax
+ jz .LSTRLICOMP2
+.LSTRLICOMP3:
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRLICOMP}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRSCAN}
+{$define FPC_UNIT_HAS_STRSCAN}
+function strscan(p : pchar;c : char) : pchar;assembler;
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifndef REGCALL}
+ movl p,%eax
+{$endif}
+ xorl %ecx,%ecx
+ testl %eax,%eax
+ jz .LSTRSCAN
+// align
+ movb c,%cl
+ leal 3(%eax),%esi
+ andl $-4,%esi
+ movl %eax,%edi
+ subl %eax,%esi
+ jz .LSTRSCANALIGNED
+ xorl %eax,%eax
+.LSTRSCANALIGNLOOP:
+ movb (%edi),%al
+// at .LSTRSCANFOUND, one is substracted from edi to calculate the position,
+// so add 1 here already (not after .LSTRSCAN, because then the test/jz and
+// cmp/je can't be paired)
+ incl %edi
+ testb %al,%al
+ jz .LSTRSCAN
+ cmpb %cl,%al
+ je .LSTRSCANFOUND
+ decl %esi
+ jnz .LSTRSCANALIGNLOOP
+.LSTRSCANALIGNED:
+// fill ecx with cccc
+ movl %ecx,%eax
+ shll $8,%eax
+ orl %eax,%ecx
+ movl %ecx,%eax
+ shll $16,%eax
+ orl %eax,%ecx
+ .balign 16
+.LSTRSCANLOOP:
+// load new 4 bytes
+ movl (%edi),%edx
+// in eax, we will check if "c" appear in the loaded dword
+ movl %edx,%eax
+// esi will be used to calculate the mask
+ movl %edx,%esi
+ notl %esi
+// in edx we will check for the end of the string
+ addl $0x0fefefeff,%edx
+ xorl %ecx,%eax
+ andl $0x080808080,%esi
+ addl $4,%edi
+ andl %esi,%edx
+ movl %eax,%esi
+ notl %esi
+ jnz .LSTRSCANLONGCHECK
+ addl $0x0fefefeff,%eax
+ andl $0x080808080,%esi
+ andl %esi,%eax
+ jz .LSTRSCANLOOP
+
+// the position in %eax where the char was found is now $80, so keep on
+// shifting 8 bits out of %eax until we find a non-zero bit.
+// first char
+ shrl $8,%eax
+ jc .LSTRSCANFOUND1
+// second char
+ shrl $8,%eax
+ jc .LSTRSCANFOUND2
+// third char
+ shrl $8,%eax
+ jc .LSTRSCANFOUND3
+// fourth char
+ jmp .LSTRSCANFOUND
+.LSTRSCANLONGCHECK:
+// there's a null somewhere, but we still have to check whether there isn't
+// a 'c' before it.
+ addl $0x0fefefeff,%eax
+ andl $0x080808080,%esi
+ andl %esi,%eax
+// Now, in eax we have $80 on the positions where there were c-chars and in
+// edx we have $80 on the positions where there were #0's. On all other
+// positions, there is now #0
+// first char
+ shrl $8,%eax
+ jc .LSTRSCANFOUND1
+ shrl $8,%edx
+ jc .LSTRSCANNOTFOUND
+// second char
+ shrl $8,%eax
+ jc .LSTRSCANFOUND2
+ shrl $8,%edx
+ jc .LSTRSCANNOTFOUND
+// third char
+ shrl $8,%eax
+ jc .LSTRSCANFOUND3
+ shrl $8,%edx
+ jc .LSTRSCANNOTFOUND
+// we know the fourth char is now #0 (since we only jump to the long check if
+// there is a #0 char somewhere), but it's possible c = #0, and than we have
+// to return the end of the string and not nil!
+ shrl $8,%eax
+ jc .LSTRSCANFOUND
+ jmp .LSTRSCANNOTFOUND
+.LSTRSCANFOUND3:
+ leal -2(%edi),%eax
+ jmp .LSTRSCAN
+.LSTRSCANFOUND2:
+ leal -3(%edi),%eax
+ jmp .LSTRSCAN
+.LSTRSCANFOUND1:
+ leal -4(%edi),%eax
+ jmp .LSTRSCAN
+.LSTRSCANFOUND:
+ leal -1(%edi),%eax
+ jmp .LSTRSCAN
+.LSTRSCANNOTFOUND:
+ xorl %eax,%eax
+.LSTRSCAN:
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRRSCAN}
+{$define FPC_UNIT_HAS_STRRSCAN}
+function strrscan(p : pchar;c : char) : pchar;assembler;
+var
+ saveeax,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %eax,saveeax
+ movl p,%edi
+ xorl %eax,%eax
+ orl %edi,%edi
+ jz .LSTRRSCAN
+ movl $0xffffffff,%ecx
+ cld
+ xorb %al,%al
+ repne
+ scasb
+ not %ecx
+ movb c,%al
+ movl saveeax,%edi
+ addl %ecx,%edi
+ decl %edi
+ std
+ repne
+ scasb
+ cld
+ movl $0,%eax
+ jnz .LSTRRSCAN
+ movl %edi,%eax
+ incl %eax
+.LSTRRSCAN:
+ movl saveedi,%edi
+end;
+{$endif FPC_UNIT_HAS_STRRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRUPPER}
+{$define FPC_UNIT_HAS_STRUPPER}
+function strupper(p : pchar) : pchar;assembler;
+var
+ saveeax,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifndef REGCALL}
+ movl p,%eax
+{$endif}
+ movl %eax,saveeax
+ movl p,%esi
+ orl %esi,%esi
+ jz .LStrUpperNil
+ movl %esi,%edi
+.LSTRUPPER1:
+ lodsb
+ cmpb $97,%al
+ jb .LSTRUPPER3
+ cmpb $122,%al
+ ja .LSTRUPPER3
+ subb $0x20,%al
+.LSTRUPPER3:
+ stosb
+ orb %al,%al
+ jnz .LSTRUPPER1
+.LStrUpperNil:
+ movl saveeax,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRUPPER}
+
+
+{$ifndef FPC_UNIT_HAS_STRLOWER}
+{$define FPC_UNIT_HAS_STRLOWER}
+function strlower(p : pchar) : pchar;assembler;
+var
+ saveeax,saveesi,saveedi : longint;
+asm
+ movl %esi,saveesi
+ movl %edi,saveedi
+{$ifndef REGCALL}
+ movl p,%eax
+{$endif}
+ movl %eax,saveeax
+ movl p,%esi
+ orl %esi,%esi
+ jz .LStrLowerNil
+ movl %esi,%edi
+.LSTRLOWER1:
+ lodsb
+ cmpb $65,%al
+ jb .LSTRLOWER3
+ cmpb $90,%al
+ ja .LSTRLOWER3
+ addb $0x20,%al
+.LSTRLOWER3:
+ stosb
+ orb %al,%al
+ jnz .LSTRLOWER1
+.LStrLowerNil:
+ movl saveeax,%eax
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRLOWER}
+
+{
+ $Log: strings.inc,v $
+ Revision 1.18 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/stringss.inc b/rtl/i386/stringss.inc
new file mode 100644
index 0000000000..276af93df1
--- /dev/null
+++ b/rtl/i386/stringss.inc
@@ -0,0 +1,53 @@
+{
+ $Id: stringss.inc,v 1.14 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor dependent part of strings.pp, not shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$ifndef FPC_UNIT_HAS_STRPCOPY}
+{$define FPC_UNIT_HAS_STRPCOPY}
+function strpcopy(d : pchar;const s : string) : pchar;assembler;
+var
+ saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+ cld
+{$ifdef REGCALL}
+ movl %eax,%edi // load destination address
+ movl %edx,%esi // Load Source adress
+{$else}
+ movl s,%esi // Load Source adress
+ movl d,%edi // load destination address
+{$endif}
+ movzbl (%esi),%ecx // load length in ECX
+ incl %esi
+ rep
+ movsb
+ movb $0,(%edi)
+{$ifndef REGCALL}
+ movl d,%eax // return value to EAX
+{$endif}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+{$endif FPC_UNIT_HAS_STRPCOPY}
+
+{
+ $Log: stringss.inc,v $
+ Revision 1.14 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/strlen.inc b/rtl/i386/strlen.inc
new file mode 100644
index 0000000000..7c5aaade07
--- /dev/null
+++ b/rtl/i386/strlen.inc
@@ -0,0 +1,42 @@
+{
+ $Id: strlen.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor specific implementation of strlen
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+var
+ saveedi : longint;
+asm
+ movl %edi,saveedi
+{$ifdef REGCALL}
+ movl %eax,%edi
+{$else}
+ movl p,%edi
+{$endif}
+ movl $0xffffffff,%ecx
+ xorl %eax,%eax
+ cld
+ repne
+ scasb
+ movl $0xfffffffe,%eax
+ subl %ecx,%eax
+ movl saveedi,%edi
+end;
+
+
+{
+ $Log: strlen.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/strpas.inc b/rtl/i386/strpas.inc
new file mode 100644
index 0000000000..1885e608a9
--- /dev/null
+++ b/rtl/i386/strpas.inc
@@ -0,0 +1,116 @@
+{
+ $Id: strpas.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor specific implementation of strpas
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+var
+ saveres,saveebx,saveesi,saveedi : longint;
+asm
+ movl %ebx,saveebx
+ movl %esi,saveesi
+ movl %edi,saveedi
+{$ifdef regcall}
+ movl p,%esi
+ movl __RESULT,%edi
+ movl %edi,saveres
+{$else}
+ movl p,%esi
+{$endif}
+ movl $1,%ecx
+ testl %esi,%esi
+ movl %esi,%eax
+ jz .LStrPasDone
+{$ifndef REGCALL}
+ movl __RESULT,%edi
+{$endif}
+ leal 3(%esi),%edx
+ andl $-4,%edx
+ // skip length byte
+ incl %edi
+ subl %esi,%edx
+ jz .LStrPasAligned
+ // align source to multiple of 4 (not dest, because we can't read past
+ // the end of the source, since that may be past the end of the heap
+ // -> sigsegv!!)
+.LStrPasAlignLoop:
+ movb (%esi),%al
+ incl %esi
+ testb %al,%al
+ jz .LStrPasDone
+ incl %edi
+ incb %cl
+ decb %dl
+ movb %al,-1(%edi)
+ jne .LStrPasAlignLoop
+ .balign 16
+.LStrPasAligned:
+ movl (%esi),%ebx
+ addl $4,%edi
+ leal 0x0fefefeff(%ebx),%eax
+ movl %ebx,%edx
+ addl $4,%esi
+ notl %edx
+ andl %edx,%eax
+ addl $4,%ecx
+ andl $0x080808080,%eax
+ movl %ebx,-4(%edi)
+ jnz .LStrPasEndFound
+ cmpl $252,%ecx
+ ja .LStrPasPreEndLoop
+ jmp .LStrPasAligned
+.LStrPasEndFound:
+ subl $4,%ecx
+ // this won't overwrite data since the result = 255 char string
+ // and we never process more than the first 255 chars of p
+ shrl $8,%eax
+ jc .LStrPasDone
+ incl %ecx
+ shrl $8,%eax
+ jc .LStrPasDone
+ incl %ecx
+ shrl $8,%eax
+ jc .LStrPasDone
+ incl %ecx
+ jmp .LStrPasDone
+.LStrPasPreEndLoop:
+ testb %cl,%cl
+ jz .LStrPasDone
+ movl (%esi),%eax
+.LStrPasEndLoop:
+ testb %al,%al
+ jz .LStrPasDone
+ movb %al,(%edi)
+ shrl $8,%eax
+ incl %edi
+ incb %cl
+ jnz .LStrPasEndLoop
+.LStrPasDone:
+{$ifdef REGCALL}
+ movl saveres,%edi
+{$else}
+ movl __RESULT,%edi
+{$endif}
+ addb $255,%cl
+ movb %cl,(%edi)
+ movl saveesi,%esi
+ movl saveedi,%edi
+ movl saveebx,%ebx
+end;
+
+
+{
+ $Log: strpas.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/i386/sysutilp.inc b/rtl/i386/sysutilp.inc
new file mode 100644
index 0000000000..6fd0687cc2
--- /dev/null
+++ b/rtl/i386/sysutilp.inc
@@ -0,0 +1,84 @@
+{
+ $Id: sysutilp.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 2001 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+ This include contains cpu-specific routines
+ ---------------------------------------------------------------------}
+
+{$ASMMODE ATT}
+
+function InterLockedDecrement (var Target: longint) : longint; assembler;
+asm
+{$ifdef REGCALL}
+ movl $-1,%edx
+ xchgl %edx,%eax
+{$else}
+ movl Target, %edx
+ movl $-1, %eax
+{$endif}
+ lock
+ xaddl %eax, (%edx)
+ decl %eax
+end;
+
+
+function InterLockedIncrement (var Target: longint) : longint; assembler;
+asm
+{$ifdef REGCALL}
+ movl $1,%edx
+ xchgl %edx,%eax
+{$else}
+ movl Target, %edx
+ movl $1, %eax
+{$endif}
+ lock
+ xaddl %eax, (%edx)
+ incl %eax
+end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
+asm
+{$ifdef REGCALL}
+ xchgl (%eax),%edx
+ movl %edx,%eax
+{$else}
+ movl Target,%ecx
+ movl Source,%eax
+ xchgl (%ecx),%eax
+{$endif}
+end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
+asm
+{$ifdef REGCALL}
+ xchgl %eax,%edx
+{$else}
+ movl Target,%edx
+ movl Source,%eax
+{$endif}
+ lock
+ xaddl %eax, (%edx)
+end;
+
+
+{
+ $Log: sysutilp.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/aliases.inc b/rtl/inc/aliases.inc
new file mode 100644
index 0000000000..83bbb244c0
--- /dev/null
+++ b/rtl/inc/aliases.inc
@@ -0,0 +1,39 @@
+{
+ $Id: aliases.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Florian Klaempfl
+ member of the Free Pascal development team.
+
+ This file contains external definitions (which map to aliases
+ of functions which are later implemented) so that they can
+ be called before their implementation is known. We can't use
+ forward definitions, because there's a bug which causes all
+ sorts of trouble if you you first declare a procedure as
+ forward, then call it and then implement it using an
+ "external name 'bla'" where 'bla' is a public alias of a
+ procedure defined after the call to the forward defined
+ procedure.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+{ export for internal usage }
+Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE'];
+Procedure int_Addref (Data,TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_ADDREF'];
+Procedure int_DecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_DECREF'];
+Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
+procedure int_FinalizeArray(data,typeinfo : pointer;count,size : longint); [external name 'FPC_FINALIZEARRAY'];
+
+{
+ $Log: aliases.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc
new file mode 100644
index 0000000000..5c2ebbde23
--- /dev/null
+++ b/rtl/inc/astrings.inc
@@ -0,0 +1,900 @@
+{
+ $Id: astrings.inc,v 1.57 2005/04/06 07:45:14 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ This file implements AnsiStrings for FPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ This will release some functions for special shortstring support }
+{ define EXTRAANSISHORT}
+
+{
+ This file contains the implementation of the AnsiString type,
+ and all things that are needed for it.
+ AnsiString is defined as a 'silent' pchar :
+ a pchar that points to :
+
+ @-8 : SizeInt for reference count;
+ @-4 : SizeInt for size;
+ @ : String + Terminating #0;
+ Pchar(Ansistring) is a valid typecast.
+ So AS[i] is converted to the address @AS+i-1.
+
+ Constants should be assigned a reference count of -1
+ Meaning that they can't be disposed of.
+}
+
+Type
+ PAnsiRec = ^TAnsiRec;
+ TAnsiRec = Packed Record
+{$ifndef hascompilerproc}
+ Maxlen,
+ len,
+ ref : Longint;
+ First : Char;
+{$else}
+ Ref,
+ Len : SizeInt;
+ First : Char;
+{$endif}
+ end;
+
+Const
+ AnsiRecLen = SizeOf(TAnsiRec);
+ FirstOff = SizeOf(TAnsiRec)-1;
+
+
+{****************************************************************************
+ Internal functions, not in interface.
+****************************************************************************}
+
+
+
+Function NewAnsiString(Len : SizeInt) : Pointer;
+{
+ Allocate a new AnsiString on the heap.
+ initialize it to zero length and reference count 1.
+}
+Var
+ P : Pointer;
+begin
+ { request a multiple of 16 because the heap manager alloctes anyways chunks of 16 bytes }
+ GetMem(P,Len+AnsiRecLen);
+ If P<>Nil then
+ begin
+ PAnsiRec(P)^.Ref:=1; { Set reference count }
+ PAnsiRec(P)^.Len:=0; { Initial length }
+ PAnsiRec(P)^.First:=#0; { Terminating #0 }
+ inc(p,firstoff); { Points to string now }
+ end;
+ NewAnsiString:=P;
+end;
+
+
+Procedure DisposeAnsiString(Var S : Pointer);
+{
+ Deallocates a AnsiString From the heap.
+}
+begin
+ If S=Nil then
+ exit;
+ Dec (S,FirstOff);
+ FreeMem (S);
+ S:=Nil;
+end;
+
+
+Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_ANSISTR_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Decreases the ReferenceCount of a non constant ansistring;
+ If the reference count is zero, deallocate the string;
+}
+Type
+ pSizeInt = ^SizeInt;
+Var
+ l : pSizeInt;
+Begin
+ { Zero string }
+ If S=Nil then exit;
+ { check for constant strings ...}
+ l:=@PANSIREC(S-FirstOff)^.Ref;
+ If l^<0 then exit;
+
+ { declocked does a MT safe dec and returns true, if the counter is 0 }
+ If declocked(l^) then
+ { Ref count dropped to zero }
+ DisposeAnsiString (S); { Remove...}
+{$ifndef decrrefnotnil}
+ s:=nil;
+{$endif}
+end;
+
+{$ifdef hascompilerproc}
+{ also define alias for internal use in the system unit }
+Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_ANSISTR_DECR_REF'];
+{$endif hascompilerproc}
+
+{$ifdef hascompilerproc}
+Procedure fpc_AnsiStr_Incr_Ref (S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_ANSISTR_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_AnsiStr_Incr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_ANSISTR_INCR_REF'];
+{$endif}
+Begin
+ If S=Nil then
+ exit;
+ { Let's be paranoid : Constant string ??}
+ If PAnsiRec(S-FirstOff)^.Ref<0 then exit;
+ inclocked(PAnsiRec(S-FirstOff)^.Ref);
+end;
+
+{$ifdef hascompilerproc}
+{ also define alias which can be used inside the system unit }
+Procedure fpc_AnsiStr_Incr_Ref (S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_ANSISTR_INCR_REF'];
+{$endif hascompilerproc}
+
+Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_ANSISTR_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Assigns S2 to S1 (S1:=S2), taking in account reference counts.
+}
+begin
+ If S2<>nil then
+ If PAnsiRec(S2-FirstOff)^.Ref>0 then
+ inclocked(PAnsiRec(S2-FirstOff)^.ref);
+ { Decrease the reference count on the old S1 }
+ fpc_ansistr_decr_ref (S1);
+ { And finally, have S1 pointing to S2 (or its copy) }
+ S1:=S2;
+end;
+
+{$ifdef hascompilerproc}
+{ alias for internal use }
+Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_ANSISTR_ASSIGN'];
+{$endif hascompilerproc}
+
+{$ifdef hascompilerproc}
+function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): ansistring; compilerproc;
+var
+ S3: ansistring absolute result;
+{$else hascompilerproc}
+Procedure fpc_AnsiStr_Concat (const S1,S2 : ansistring;var S3 : ansistring);[Public, alias: 'FPC_ANSISTR_CONCAT'];
+{$endif hascompilerproc}
+{
+ Concatenates 2 AnsiStrings : S1+S2.
+ Result Goes to S3;
+}
+Var
+ Size,Location : SizeInt;
+begin
+ { only assign if s1 or s2 is empty }
+ if (S1='') then
+ s3 := s2
+ else if (S2='') then
+ s3 := s1
+ else
+ begin
+ Size:=length(S2);
+ Location:=Length(S1);
+ SetLength (S3,Size+Location);
+ { the cast to a pointer avoids the unique call }
+ { and we don't need an unique call }
+ { because of the SetLength S3 is unique }
+ Move (S1[1],pointer(S3)^,Location);
+ Move (S2[1],pointer(pointer(S3)+location)^,Size+1);
+ end;
+end;
+
+
+{$ifdef EXTRAANSISHORT}
+Procedure AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString);
+{
+ Concatenates a Ansi with a short string; : S2 + S2
+}
+Var
+ Size,Location : SizeInt;
+begin
+ Size:=Length(S2);
+ Location:=Length(S1);
+ If Size=0 then
+ exit;
+ { Setlength takes case of uniqueness
+ and alllocated memory. We need to use length,
+ to take into account possibility of S1=Nil }
+ SetLength (S1,Size+Length(S1));
+ Move (S2[1],Pointer(Pointer(S1)+Location)^,Size);
+ PByte( Pointer(S1)+length(S1) )^:=0; { Terminating Zero }
+end;
+{$endif EXTRAANSISHORT}
+
+
+{ the following declaration has exactly the same effect as }
+{ procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer); }
+{ which is what the old helper was, so we don't need an extra implementation }
+{ of the old helper (JM) }
+function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring;[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a AnsiString to a ShortString;
+}
+Var
+ Size : SizeInt;
+begin
+ if S2='' then
+ fpc_AnsiStr_To_ShortStr:=''
+ else
+ begin
+ Size:=Length(S2);
+ If Size>high_of_res then
+ Size:=high_of_res;
+ Move (S2[1],fpc_AnsiStr_To_ShortStr[1],Size);
+ byte(fpc_AnsiStr_To_ShortStr[0]):=byte(Size);
+ end;
+end;
+
+
+Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a ShortString to a AnsiString;
+}
+Var
+ Size : SizeInt;
+begin
+ Size:=Length(S2);
+ Setlength (fpc_ShortStr_To_AnsiStr,Size);
+ if Size>0 then
+ Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_ShortStr_To_AnsiStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_ANSISTR'];
+Var
+ Size : SizeInt;
+begin
+ Size:=Length(S2);
+ Setlength (ansistring(s1),Size);
+ if Size>0 then
+ Move(S2[1],s1^,Size);
+end;
+{$endif hascompilerproc}
+
+Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a Char to a AnsiString;
+}
+begin
+ Setlength (fpc_Char_To_AnsiStr,1);
+ PByte(Pointer(fpc_Char_To_AnsiStr))^:=byte(c);
+ { Terminating Zero }
+ PByte(Pointer(fpc_Char_To_AnsiStr)+1)^:=0;
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_Char_To_AnsiStr(var S1 : Pointer; c : Char);[Public, alias: 'FPC_CHAR_TO_ANSISTR'];
+begin
+ s1 := pointer(fpc_Char_To_AnsiStr(c));
+end;
+{$endif hascompilerproc}
+
+
+Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ L : SizeInt;
+begin
+ if (not assigned(p)) or (p[0]=#0) Then
+ { result is automatically set to '' }
+ exit;
+ l:=IndexChar(p^,-1,#0);
+ SetLength(fpc_PChar_To_AnsiStr,L);
+ Move (P[0],Pointer(fpc_PChar_To_AnsiStr)^,L)
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_PChar_To_AnsiStr(var a : ansistring;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ pointer(a) := pointer(fpc_PChar_To_AnsiStr(p));
+end;
+{$endif hascompilerproc}
+
+
+Function fpc_CharArray_To_AnsiStr(const arr: array of char): ansistring; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ i : SizeInt;
+begin
+ if arr[0]=#0 Then
+ { result is automatically set to '' }
+ exit;
+ i:=IndexChar(arr,high(arr)+1,#0);
+ if i = -1 then
+ i := high(arr)+1;
+ SetLength(fpc_CharArray_To_AnsiStr,i);
+ Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+{ the declaration below is the same as }
+{ which is what the old helper was (we need the parameter as "array of char" type }
+{ so we can pass it to the new style helper (JM) }
+Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; p: pointer; len: SizeInt);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ src: pchar;
+ i: SizeInt;
+begin
+ src := pchar(p);
+ if src[0]=#0 Then
+ { result is automatically set to '' }
+ begin
+ pointer(a) := nil;
+ exit;
+ end;
+ i:=IndexChar(src^,len,#0);
+ if i = -1 then
+ i := len;
+ pointer(a) := NewAnsiString(i);
+ Move (src^,a[1],i);
+end;
+{$endif not hascompilerproc}
+
+
+{$ifdef hascompilerproc}
+
+{ note: inside the compiler, the resulttype is modified to be the length }
+{ of the actual chararray to which we convert (JM) }
+function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; [public, alias: 'FPC_ANSISTR_TO_CHARARRAY']; compilerproc;
+var
+ len: SizeInt;
+begin
+ len := length(src);
+ if len > arraysize then
+ len := arraysize;
+ { make sure we don't try to access element 1 of the ansistring if it's nil }
+ if len > 0 then
+ move(src[1],fpc_ansistr_to_chararray[0],len);
+ fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
+end;
+
+{$endif hascompilerproc}
+
+
+Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Compares 2 AnsiStrings;
+ The result is
+ <0 if S1<S2
+ 0 if S1=S2
+ >0 if S1>S2
+}
+Var
+ MaxI,Temp : SizeInt;
+begin
+ if pointer(S1)=pointer(S2) then
+ begin
+ result:=0;
+ exit;
+ end;
+ Maxi:=Length(S1);
+ temp:=Length(S2);
+ If MaxI>Temp then
+ MaxI:=Temp;
+ if MaxI>0 then
+ begin
+ result:=CompareByte(S1[1],S2[1],MaxI);
+ if result=0 then
+ result:=Length(S1)-Length(S2);
+ end
+ else
+ result:=Length(S1)-Length(S2);
+end;
+
+
+Procedure fpc_AnsiStr_CheckZero(p : pointer);[Public,Alias : 'FPC_ANSISTR_CHECKZERO']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if p=nil then
+ HandleErrorFrame(201,get_frame);
+end;
+
+
+Procedure fpc_AnsiStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_ANSISTR_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if (index>len) or (Index<1) then
+ HandleErrorFrame(201,get_frame);
+end;
+
+{$ifndef INTERNSETLENGTH}
+Procedure SetLength (Var S : AnsiString; l : SizeInt);
+{$else INTERNSETLENGTH}
+Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt);[Public,Alias : 'FPC_ANSISTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif INTERNSETLENGTH}
+{
+ Sets The length of string S to L.
+ Makes sure S is unique, and contains enough room.
+}
+Var
+ Temp : Pointer;
+ movelen : SizeInt;
+begin
+ if (l>0) then
+ begin
+ if Pointer(S)=nil then
+ begin
+ { Need a complete new string...}
+ Pointer(s):=NewAnsiString(l);
+ end
+ else if (PAnsiRec(Pointer(S)-FirstOff)^.Ref = 1) then
+ begin
+ Dec(Pointer(S),FirstOff);
+ if AnsiRecLen+L>MemSize(Pointer(s)) then
+ reallocmem(pointer(S),AnsiRecLen+L);
+ Inc(Pointer(S),FirstOff);
+ end
+ else
+ begin
+ { Reallocation is needed... }
+ Temp:=Pointer(NewAnsiString(L));
+ if Length(S)>0 then
+ begin
+ if l < succ(length(s)) then
+ movelen := l
+ { also move terminating null }
+ else movelen := succ(length(s));
+ Move(Pointer(S)^,Temp^,movelen);
+ end;
+ fpc_ansistr_decr_ref(Pointer(S));
+ Pointer(S):=Temp;
+ end;
+ { Force nil termination in case it gets shorter }
+ PByte(Pointer(S)+l)^:=0;
+ PAnsiRec(Pointer(S)-FirstOff)^.Len:=l;
+ end
+ else
+ begin
+ { Length=0 }
+ if Pointer(S)<>nil then
+ fpc_ansistr_decr_ref (Pointer(S));
+ Pointer(S):=Nil;
+ end;
+end;
+
+{$ifdef EXTRAANSISHORT}
+Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Compares a AnsiString with a ShortString;
+ The result is
+ <0 if S1<S2
+ 0 if S1=S2
+ >0 if S1>S2
+}
+Var
+ i,MaxI,Temp : SizeInt;
+begin
+ Temp:=0;
+ i:=0;
+ MaxI:=Length(AnsiString(S1));
+ if MaxI>byte(S2[0]) then
+ MaxI:=Byte(S2[0]);
+ While (i<MaxI) and (Temp=0) do
+ begin
+ Temp:= PByte(S1+I)^ - Byte(S2[i+1]);
+ inc(i);
+ end;
+ AnsiStr_ShortStr_Compare:=Temp;
+end;
+{$endif EXTRAANSISHORT}
+
+
+{*****************************************************************************
+ Public functions, In interface.
+*****************************************************************************}
+
+{$ifndef INTERNLENGTH}
+Function Length (Const S : AnsiString) : SizeInt;
+{
+ Returns the length of an AnsiString.
+ Takes in acount that zero strings are NIL;
+}
+begin
+ If Pointer(S)=Nil then
+ Length:=0
+ else
+ Length:=PAnsiRec(Pointer(S)-FirstOff)^.Len;
+end;
+{$endif INTERNLENGTH}
+
+
+{$ifdef HASCOMPILERPROC}
+Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_ansistr_Unique(Var S : AnsiString); [Public,Alias : 'FPC_ANSISTR_UNIQUE'];
+{$endif}
+{
+ Make sure reference count of S is 1,
+ using copy-on-write semantics.
+}
+Var
+ SNew : Pointer;
+ L : SizeInt;
+begin
+{$ifdef HASCOMPILERPROC}
+ pointer(result) := pointer(s);
+{$endif}
+ If Pointer(S)=Nil then
+ exit;
+ if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
+ begin
+ L:=PAnsiRec(Pointer(S)-FirstOff)^.len;
+ SNew:=NewAnsiString (L);
+ Move (Pointer(S)^,SNew^,L+1);
+ PAnsiRec(SNew-FirstOff)^.len:=L;
+ fpc_ansistr_decr_ref (Pointer(S)); { Thread safe }
+ pointer(S):=SNew;
+{$ifdef HASCOMPILERPROC}
+ pointer(result):=SNew;
+{$endif}
+ end;
+end;
+
+Procedure fpc_ansistr_append_char(Var S : AnsiString;c : char); [Public,Alias : 'FPC_ANSISTR_APPEND_CHAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ SetLength(S,length(S)+1);
+ S[length(S)]:=c;
+ PByte(Pointer(S)+length(S))^:=0; { Terminating Zero }
+end;
+
+Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;Str : ShortString); [Public,Alias : 'FPC_ANSISTR_APPEND_SHORTSTRING']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ofs : SizeInt;
+begin
+ if Str='' then
+ exit;
+ ofs:=Length(S);
+ SetLength(S,ofs+length(Str));
+ move(Str[1],S[ofs+1],length(Str));
+ PByte(Pointer(S)+length(S))^:=0; { Terminating Zero }
+end;
+
+Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;Str : AnsiString); [Public,Alias : 'FPC_ANSISTR_APPEND_ANSISTRING']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ofs : SizeInt;
+begin
+ if Str='' then
+ exit;
+ ofs:=Length(S);
+ SetLength(S,ofs+length(Str));
+ move(Str[1],S[ofs+1],length(Str)+1);
+end;
+
+{$ifdef interncopy}
+Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
+{$else}
+Function Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;
+{$endif}
+var
+ ResultAddress : Pointer;
+begin
+ ResultAddress:=Nil;
+ dec(index);
+ if Index < 0 then
+ Index := 0;
+ { Check Size. Accounts for Zero-length S, the double check is needed because
+ Size can be maxint and will get <0 when adding index }
+ if (Size>Length(S)) or
+ (Index+Size>Length(S)) then
+ Size:=Length(S)-Index;
+ If Size>0 then
+ begin
+ If Index<0 Then
+ Index:=0;
+ ResultAddress:=Pointer(NewAnsiString (Size));
+ if ResultAddress<>Nil then
+ begin
+ Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size);
+ PAnsiRec(ResultAddress-FirstOff)^.Len:=Size;
+ PByte(ResultAddress+Size)^:=0;
+ end;
+ end;
+{$ifdef interncopy}
+ Pointer(fpc_ansistr_Copy):=ResultAddress;
+{$else}
+ Pointer(Copy):=ResultAddress;
+{$endif}
+end;
+
+
+Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt;
+var
+ i,MaxLen : SizeInt;
+ pc : pchar;
+begin
+ Pos:=0;
+ if Length(SubStr)>0 then
+ begin
+ MaxLen:=Length(source)-Length(SubStr);
+ i:=0;
+ pc:=@source[1];
+ while (i<=MaxLen) do
+ begin
+ inc(i);
+ if (SubStr[1]=pc^) and
+ (CompareByte(Substr[1],pc^,Length(SubStr))=0) then
+ begin
+ Pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ end;
+end;
+
+
+{ Faster version for a char alone. Must be implemented because }
+{ pos(c: char; const s: shortstring) also exists, so otherwise }
+{ using pos(char,pchar) will always call the shortstring version }
+{ (exact match for first argument), also with $h+ (JM) }
+Function Pos (c : Char; Const s : AnsiString) : SizeInt;
+var
+ i: SizeInt;
+ pc : pchar;
+begin
+ pc:=@s[1];
+ for i:=1 to length(s) do
+ begin
+ if pc^=c then
+ begin
+ pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ pos:=0;
+end;
+
+
+Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : String;
+begin
+ fpc_Val_Real_AnsiStr := 0;
+ if length(S) > 255 then
+ code := 256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_Real_AnsiStr,code);
+ end;
+end;
+
+
+Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_UInt_AnsiStr := 0;
+ if length(S) > 255 then
+ code := 256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_UInt_AnsiStr,code);
+ end;
+end;
+
+
+Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_SInt_AnsiStr:=0;
+ if length(S)>255 then
+ code:=256
+ else
+ begin
+ SS := S;
+ fpc_Val_SInt_AnsiStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
+ end;
+end;
+
+
+{$ifndef CPU64}
+
+Function fpc_Val_qword_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_qword_AnsiStr:=0;
+ if length(S)>255 then
+ code:=256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_qword_AnsiStr,Code);
+ end;
+end;
+
+
+Function fpc_Val_int64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_int64_AnsiStr:=0;
+ if length(S)>255 then
+ code:=256
+ else
+ begin
+ SS := s;
+ Val(SS,fpc_Val_int64_AnsiStr,Code);
+ end;
+end;
+
+{$endif CPU64}
+
+
+procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ss: ShortString;
+begin
+ str_real(len,fr,d,treal_type(rt),ss);
+ s:=ss;
+end;
+
+
+{$ifdef STR_USES_VALINT}
+Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_AnsiStr_Longword(v : Longword;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_CARDINAL']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+Var
+ SS : ShortString;
+begin
+ str(v:Len,SS);
+ S:=SS;
+end;
+
+
+
+{$ifdef STR_USES_VALINT}
+Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALSINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_AnsiStr_Longint(v : Longint; Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+Var
+ SS : ShortString;
+begin
+ str (v:Len,SS);
+ S:=SS;
+end;
+
+
+{$ifndef CPU64}
+
+Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ str(v:Len,SS);
+ S:=SS;
+end;
+
+
+
+Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ str (v:Len,SS);
+ S:=SS;
+end;
+
+{$endif CPU64}
+
+
+Procedure Delete (Var S : AnsiString; Index,Size: SizeInt);
+Var
+ LS : SizeInt;
+begin
+ ls:=Length(S);
+ If (Index>LS) or (Index<=0) or (Size<=0) then
+ exit;
+ UniqueString (S);
+ If (Size>LS-Index) then // Size+Index gives overflow ??
+ Size:=LS-Index+1;
+ If (Size<=LS-Index) then
+ begin
+ Dec(Index);
+ Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index-Size+1);
+ end;
+ Setlength(S,LS-Size);
+end;
+
+
+Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : SizeInt);
+var
+ Temp : AnsiString;
+ LS : SizeInt;
+begin
+ If Length(Source)=0 then
+ exit;
+ if index <= 0 then
+ index := 1;
+ Ls:=Length(S);
+ if index > LS then
+ index := LS+1;
+ Dec(Index);
+ Pointer(Temp) := NewAnsiString(Length(Source)+LS);
+ SetLength(Temp,Length(Source)+LS);
+ If Index>0 then
+ move (Pointer(S)^,Pointer(Temp)^,Index);
+ Move (Pointer(Source)^,PByte(Temp)[Index],Length(Source));
+ If (LS-Index)>0 then
+ Move(PByte(Pointer(S))[Index],PByte(temp)[Length(Source)+index],LS-Index);
+ S:=Temp;
+end;
+
+
+Function StringOfChar(c : char;l : SizeInt) : AnsiString;
+begin
+ SetLength(StringOfChar,l);
+ FillChar(Pointer(StringOfChar)^,Length(StringOfChar),c);
+end;
+
+Procedure SetString (Var S : AnsiString; Buf : PChar; Len : SizeInt);
+begin
+ SetLength(S,Len);
+ If (Buf<>Nil) then
+ begin
+ Move (Buf[0],S[1],Len);
+ end;
+end;
+
+
+function upcase(const s : ansistring) : ansistring;
+var
+ i : SizeInt;
+begin
+ Setlength(result,length(s));
+ for i := 1 to length (s) do
+ result[i] := upcase(s[i]);
+end;
+
+
+function lowercase(const s : ansistring) : ansistring;
+var
+ i : SizeInt;
+begin
+ Setlength(result,length(s));
+ for i := 1 to length (s) do
+ result[i] := lowercase(s[i]);
+end;
+
+
+{
+ $Log: astrings.inc,v $
+ Revision 1.57 2005/04/06 07:45:14 michael
+ + Removed erroneously committed debug statement
+
+ Revision 1.56 2005/04/06 07:43:02 michael
+ + Variant type conversion rules
+
+ Revision 1.55 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.54 2005/01/28 19:50:51 peter
+ 1.0.x fixes
+
+ Revision 1.53 2005/01/25 18:50:45 peter
+ * 1.0.x fix
+
+ Revision 1.52 2005/01/09 10:38:59 florian
+ * replaced CompareChar by CompareByte, saves one redirection
+
+} \ No newline at end of file
diff --git a/rtl/inc/cgeneric.inc b/rtl/inc/cgeneric.inc
new file mode 100644
index 0000000000..7fcbe11812
--- /dev/null
+++ b/rtl/inc/cgeneric.inc
@@ -0,0 +1,156 @@
+{
+ $Id: cgeneric.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Processor independent implementation for the system unit
+ (based on libc)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ Primitives
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure bcopy(const source;var dest;count:cardinal); cdecl; external 'c' name 'bcopy';
+
+{ we need this separate move declaration because we can't add a "public, alias" to the above }
+procedure Move(const source;var dest;count:longint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ if count <= 0 then
+ exit;
+ bcopy(source,dest,count);
+end;
+{$endif not FPC_SYSTEM_HAS_MOVE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+procedure memset(var x; value: byte; count: cardinal); cdecl; external 'c';
+
+Procedure FillChar(var x;count: longint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ if count <= 0 then
+ exit;
+ memset(x,value,count);
+end;
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLBYTE}
+{$define FPC_SYSTEM_HAS_FILLBYTE}
+procedure FillByte (var x;count : longint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ if count <= 0 then
+ exit;
+ FillChar (X,Count,value);
+end;
+{$endif not FPC_SYSTEM_HAS_FILLBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
+{$define FPC_SYSTEM_HAS_INDEXCHAR}
+
+function memchr(const buf; b: longint; len: cardinal): pointer; cdecl; external 'c';
+
+function IndexChar(Const buf;len:longint;b:char):longint;
+var
+ res: pointer;
+begin
+ if len = 0 then
+ exit(-1);
+ { simulate assembler implementations behaviour, which is expected }
+ { fpc_pchar_to_ansistr in astrings.inc (interpret values < 0 as }
+ { unsigned) }
+ res := memchr(buf,longint(b),cardinal(len));
+ if (res <> nil) then
+ IndexChar := longint(res-@buf)
+ else
+ IndexChar := -1;
+end;
+{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(Const buf;len:longint;b:byte):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ IndexByte:=IndexChar(buf,len,char(b));
+end;
+{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
+{$define FPC_SYSTEM_HAS_COMPARECHAR}
+function memcmp_comparechar(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'memcmp';
+
+function CompareChar(Const buf1,buf2;len:longint):longint;
+var
+ res: longint;
+begin
+ if len <= 0 then
+ exit(0);
+ res := memcmp_comparechar(buf1,buf2,len);
+ if res < 0 then
+ CompareChar := -1
+ else if res > 0 then
+ CompareChar := 1
+ else
+ CompareChar := 0;
+end;
+{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ CompareByte := CompareChar(buf1,buf2,len);
+end;
+{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
+{$define FPC_SYSTEM_HAS_COMPARECHAR0}
+function strncmp_comparechar0(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'strncmp';
+
+function CompareChar0(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ if len <= 0 then
+ exit(0);
+ strncmp_comparechar0(buf1,buf2,len);
+end;
+
+{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+function libc_pchar_length(p:pchar):cardinal; cdecl; external 'c' name 'strlen';
+
+function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ fpc_pchar_length:=libc_pchar_length(p);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+
+{
+ $Log: cgeneric.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/cgenmath.inc b/rtl/inc/cgenmath.inc
new file mode 100644
index 0000000000..f4f5b68b65
--- /dev/null
+++ b/rtl/inc/cgenmath.inc
@@ -0,0 +1,209 @@
+{
+ $Id: cgenmath.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by Several contributors
+
+ Generic mathemtical routines in libc
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ for 80x86, we can easily write the optimal inline code }
+{$ifndef cpui386}
+
+{$ifndef FPC_SYSTEM_HAS_INT}
+{$define FPC_SYSTEM_HAS_INT}
+
+{$ifdef SUPPORT_DOUBLE}
+ function c_trunc(d: double): double; cdecl; external 'c' name 'trunc';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_int_real(d: double): double;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function int(d: double): double; {$ifdef MATHINLINE}inline;{$endif}[internconst:fpc_in_const_int];
+ {$endif}
+ begin
+ result := c_trunc(d);
+ end;
+
+
+{$else SUPPORT_DOUBLE}
+
+ function c_truncf(d: real): double; cdecl; external 'c' name 'truncf';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_int_real(d: real): real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function int(d: real) : real;[internconst:fpc_in_const_int];
+ {$endif}
+ begin
+ { this will be correct since real = single in the case of }
+ { the motorola version of the compiler... }
+ int:=c_truncf(d);
+ end;
+{$endif SUPPORT_DOUBLE}
+
+{$endif}
+
+
+{$ifndef SYSTEM_HAS_FREXP}
+{$define SYSTEM_HAS_FREXP}
+ function c_frexp(x: double; var e: longint): double; cdecl; external 'c' name 'frexp';
+
+ function frexp(x:Real; var e:Integer ):Real; {$ifdef MATHINLINE}inline;{$endif}
+ var
+ l: longint;
+ begin
+ frexp := c_frexp(x,l);
+ e := l;
+ end;
+{$endif not SYSTEM_HAS_FREXP}
+
+
+{$ifndef SYSTEM_HAS_LDEXP}
+{$define SYSTEM_HAS_LDEXP}
+ function c_ldexp(x: double; n: longint): double; cdecl; external 'c' name 'ldexp';
+
+ function ldexp( x: Real; N: Integer):Real;{$ifdef MATHINLINE}inline;{$endif}
+ begin
+ ldexp := c_ldexp(x,n);
+ end;
+{$endif not SYSTEM_HAS_LDEXP}
+
+
+{$ifndef FPC_SYSTEM_HAS_SQRT}
+{$define FPC_SYSTEM_HAS_SQRT}
+
+ function c_sqrt(d: double): double; cdecl; external 'c' name 'sqrt';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_sqrt_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ {$ifdef hascompilerproc}
+ function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
+ {$endif hascompilerproc}
+ function sqrt(d:Real):Real;[internconst:fpc_in_const_sqrt];[public, alias: 'FPC_SQRT_REAL']; {$ifdef MATHINLINE}inline;{$endif}
+ {$endif}
+ begin
+ result := c_sqrt(d);
+ end;
+
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_EXP}
+{$define FPC_SYSTEM_HAS_EXP}
+ function c_exp(d: double): double; cdecl; external 'c' name 'exp';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_Exp_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function Exp(d:Real):Real;[internconst:fpc_in_const_exp]; {$ifdef MATHINLINE}inline;{$endif}
+ {$endif}
+ begin
+ result := c_exp(d);
+ end;
+{$endif}
+
+(*
+
+Not supported on Mac OS X 10.1
+
+{$ifndef FPC_SYSTEM_HAS_ROUND}
+{$define FPC_SYSTEM_HAS_ROUND}
+
+ function c_llround(d: double): int64; cdecl; external 'c' name 'llround';
+
+{$ifdef hascompilerproc}
+ function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif} external name 'FPC_ROUND';
+
+ function fpc_round(d : Real) : int64;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+ begin
+ fpc_round := c_llround(d);
+ end;
+{$else}
+ function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
+ begin
+ round := c_llround(d);
+ end;
+{$endif hascompilerproc}
+{$endif}
+*)
+
+
+{$ifndef FPC_SYSTEM_HAS_LN}
+{$define FPC_SYSTEM_HAS_LN}
+
+ function c_log(d: double): double; cdecl; external 'c' name 'log';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_Ln_real(d:Real):Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function Ln(d:Real):Real;[internconst:fpc_in_const_ln];{$ifdef MATHINLINE}inline;{$endif}
+ {$endif}
+ begin
+ result := c_log(d);
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_SIN}
+{$define FPC_SYSTEM_HAS_SIN}
+ function c_sin(d: double): double; cdecl; external 'c' name 'sin';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_Sin_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function Sin(d:Real):Real;[internconst:fpc_in_const_sin]; {$ifdef MATHINLINE}inline;{$endif}
+ {$endif}
+ begin
+ result := c_sin(d);
+ end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_COS}
+{$define FPC_SYSTEM_HAS_COS}
+ function c_cos(d: double): double; cdecl; external 'c' name 'cos';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_Cos_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function Cos(d:Real):Real;[internconst:fpc_in_const_cos];{$ifdef MATHINLINE}inline;{$endif}
+ {$endif}
+ begin
+ result := c_cos(d);
+ end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_ARCTAN}
+{$define FPC_SYSTEM_HAS_ARCTAN}
+ function c_atan(d: double): double; cdecl; external 'c' name 'atan';
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_ArcTan_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+ {$else}
+ function ArcTan(d:Real):Real;[internconst:fpc_in_const_arctan];{$ifdef MATHINLINE}inline;{$endif}
+ {$endif}
+ begin
+ result := c_atan(d);
+ end;
+{$endif}
+
+{$endif not i386}
+
+{
+ $Log: cgenmath.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/cgenstr.inc b/rtl/inc/cgenstr.inc
new file mode 100644
index 0000000000..8155c77fe2
--- /dev/null
+++ b/rtl/inc/cgenstr.inc
@@ -0,0 +1,137 @@
+{
+ $Id: cgenstr.inc,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl-Eric Codere,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ we have to call the libc routines, because simply declaring our routines }
+{ as cdecl and external in libc cause problems because the calling }
+{ convention the interface is different }
+
+{$ifndef FPC_UNIT_HAS_STREND}
+{$define FPC_UNIT_HAS_STREND}
+
+ function StrEnd(P: PChar): PChar;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ strend := p+strlen(p);
+ end;
+{$endif FPC_UNIT_HAS_STREND}
+
+
+{$ifndef FPC_UNIT_HAS_STRCOPY}
+{$define FPC_UNIT_HAS_STRCOPY}
+ function libc_strcpy(dest: pchar; const src: pchar): pchar; cdecl; external 'c' name 'strcpy';
+
+ Function StrCopy(Dest, Source:PChar): PChar;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ StrCopy := libc_strcpy(dest,source);
+ end;
+{$endif FPC_UNIT_HAS_STRCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRSCAN}
+{$define FPC_UNIT_HAS_STRSCAN}
+ function libc_strchr(const p: pchar; c: longint): pchar; cdecl; external 'c' name 'strchr';
+
+ function StrScan(P: PChar; C: Char): PChar;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ StrScan := libc_strchr(p,longint(c));
+ end;
+{$endif FPC_UNIT_HAS_STRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRRSCAN}
+{$define FPC_UNIT_HAS_STRRSCAN}
+ function libc_strrchr(const p: pchar; c: longint): pchar; cdecl; external 'c' name 'strrchr';
+
+ function StrRScan(P: PChar; C: Char): PChar;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ StrRScan := libc_strrchr(p,longint(c));
+ end;
+{$endif FPC_UNIT_HAS_STRRSCAN}
+
+(*
+{$ifndef FPC_UNIT_HAS_STRECOPY}
+{$define FPC_UNIT_HAS_STRECOPY}
+ function libc_stpcpy(dest: pchar; const src: pchar): pchar; cdecl; external 'c' name 'stpcpy';
+
+ Function StrECopy(Dest, Source: PChar): PChar;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ StrECopy := libc_stpcpy(dest,source);
+ end;
+{$endif FPC_UNIT_HAS_STRECOPY}
+*)
+
+(*
+{$ifndef FPC_UNIT_HAS_STRLCOPY}
+{$define FPC_UNIT_HAS_STRLCOPY}
+
+ function libc_strlcpy(dest: pchar; const src: pchar; maxlen: SizeInt): SizeInt; cdecl; external 'c' name 'strlcpy';
+
+ Function StrLCopy(Dest,Source: PChar; MaxLen: SizeInt): PChar;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ libc_strlcpy(dest,source,maxlen);
+ StrLCopy := Dest;
+ end;
+{$endif FPC_UNIT_HAS_STRLCOPY}
+*)
+
+{$ifndef FPC_UNIT_HAS_STRCOMP}
+{$define FPC_UNIT_HAS_STRCOMP}
+ function libc_strcmp(const str1,str2: pchar): longint; cdecl; external 'c' name 'strcmp';
+
+ function StrComp(Str1, Str2 : PChar): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ strcomp := libc_strcmp(str1,str2);
+ end;
+{$endif FPC_UNIT_HAS_STRCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRICOMP}
+{$define FPC_UNIT_HAS_STRICOMP}
+ function libc_strcasecmp(const str1,str2: pchar): longint; cdecl; external 'c' name 'strcasecmp';
+
+ function StrIComp(Str1, Str2 : PChar): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ stricomp := libc_strcasecmp(str1,str2);
+ end;
+{$endif FPC_UNIT_HAS_STRICOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOMP}
+{$define FPC_UNIT_HAS_STRLCOMP}
+ function libc_strncmp(const str1,str2: pchar; l: Cardinal): longint; cdecl; external 'c' name 'strncmp';
+
+ function StrLComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ strlcomp := libc_strncmp(str1,str2,l);
+ end;
+{$endif FPC_UNIT_HAS_STRLCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLICOMP}
+{$define FPC_UNIT_HAS_STRLICOMP}
+ function libc_strncasecmp(const str1,str2: pchar; l: Cardinal): longint; cdecl; external 'c' name 'strncasecmp';
+
+ function StrLIComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ Begin
+ strlicomp := libc_strncasecmp(str1,str2,l);
+ end;
+{$endif FPC_UNIT_HAS_STRLICOMP}
+
+
+{
+ $Log: cgenstr.inc,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/charset.pp b/rtl/inc/charset.pp
new file mode 100644
index 0000000000..d1b9f77975
--- /dev/null
+++ b/rtl/inc/charset.pp
@@ -0,0 +1,258 @@
+{
+ $Id: charset.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Florian Klaempfl
+ member of the Free Pascal development team.
+
+ This unit implements several classes for charset conversions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+unit charset;
+
+ interface
+
+ type
+ tunicodechar = word;
+ tunicodestring = ^tunicodechar;
+
+ tcsconvert = class
+ // !!!!!!1constructor create;
+ end;
+
+ tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
+ umf_unused);
+
+ punicodecharmapping = ^tunicodecharmapping;
+ tunicodecharmapping = record
+ unicode : tunicodechar;
+ flag : tunicodecharmappingflag;
+ reserved : byte;
+ end;
+
+ punicodemap = ^tunicodemap;
+ tunicodemap = record
+ cpname : string[20];
+ map : punicodecharmapping;
+ lastchar : longint;
+ next : punicodemap;
+ internalmap : boolean;
+ end;
+
+ tcp2unicode = class(tcsconvert)
+ end;
+
+ function loadunicodemapping(const cpname,f : string) : punicodemap;
+ procedure registermapping(p : punicodemap);
+ function getmap(const s : string) : punicodemap;
+ function mappingavailable(const s : string) : boolean;
+ function getunicode(c : char;p : punicodemap) : tunicodechar;
+ function getascii(c : tunicodechar;p : punicodemap) : string;
+
+ implementation
+
+ var
+ mappings : punicodemap;
+
+ function loadunicodemapping(const cpname,f : string) : punicodemap;
+
+ var
+ data : punicodecharmapping;
+ datasize : longint;
+ t : text;
+ s,hs : string;
+ scanpos,charpos,unicodevalue : longint;
+ code : word;
+ flag : tunicodecharmappingflag;
+ p : punicodemap;
+ lastchar : longint;
+
+ begin
+ lastchar:=-1;
+ loadunicodemapping:=nil;
+ datasize:=256;
+ getmem(data,sizeof(tunicodecharmapping)*datasize);
+ assign(t,f);
+ {$I-}
+ reset(t);
+ {$I+}
+ if ioresult<>0 then
+ begin
+ freemem(data,sizeof(tunicodecharmapping)*datasize);
+ exit;
+ end;
+ while not(eof(t)) do
+ begin
+ readln(t,s);
+ if (s[1]='0') and (s[2]='x') then
+ begin
+ flag:=umf_unused;
+ scanpos:=3;
+ hs:='$';
+ while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
+ begin
+ hs:=hs+s[scanpos];
+ inc(scanpos);
+ end;
+ val(hs,charpos,code);
+ if code<>0 then
+ begin
+ freemem(data,sizeof(tunicodecharmapping)*datasize);
+ close(t);
+ exit;
+ end;
+ while not(s[scanpos] in ['0','#']) do
+ inc(scanpos);
+ if s[scanpos]='#' then
+ begin
+ { special char }
+ unicodevalue:=$ffff;
+ hs:=copy(s,scanpos,length(s)-scanpos+1);
+ if hs='#DBCS LEAD BYTE' then
+ flag:=umf_leadbyte;
+ end
+ else
+ begin
+ { C hex prefix }
+ inc(scanpos,2);
+ hs:='$';
+ while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
+ begin
+ hs:=hs+s[scanpos];
+ inc(scanpos);
+ end;
+ val(hs,unicodevalue,code);
+ if code<>0 then
+ begin
+ freemem(data,sizeof(tunicodecharmapping)*datasize);
+ close(t);
+ exit;
+ end;
+ if charpos>datasize then
+ begin
+ { allocate 1024 bytes more because }
+ { if we need more than 256 entries it's }
+ { probably a mbcs with a lot of }
+ { entries }
+ datasize:=charpos+1024;
+ reallocmem(data,sizeof(tunicodecharmapping)*datasize);
+ end;
+ flag:=umf_noinfo;
+ end;
+ data[charpos].flag:=flag;
+ data[charpos].unicode:=unicodevalue;
+ if charpos>lastchar then
+ lastchar:=charpos;
+ end;
+ end;
+ close(t);
+ new(p);
+ p^.lastchar:=lastchar;
+ p^.cpname:=cpname;
+ p^.internalmap:=false;
+ p^.next:=nil;
+ p^.map:=data;
+ loadunicodemapping:=p;
+ end;
+
+ procedure registermapping(p : punicodemap);
+
+ begin
+ p^.next:=mappings;
+ mappings:=p;
+ end;
+
+ function getmap(const s : string) : punicodemap;
+
+ var
+ hp : punicodemap;
+
+ const
+ mapcache : string = '';
+ mapcachep : punicodemap = nil;
+
+ begin
+ if (mapcache=s) and (mapcachep^.cpname=s) then
+ begin
+ getmap:=mapcachep;
+ exit;
+ end;
+ hp:=mappings;
+ while assigned(hp) do
+ begin
+ if hp^.cpname=s then
+ begin
+ getmap:=hp;
+ mapcache:=s;
+ mapcachep:=hp;
+ exit;
+ end;
+ hp:=hp^.next;
+ end;
+ getmap:=nil;
+ end;
+
+ function mappingavailable(const s : string) : boolean;
+
+ begin
+ mappingavailable:=getmap(s)<>nil;
+ end;
+
+ function getunicode(c : char;p : punicodemap) : tunicodechar;
+
+ begin
+ if ord(c)<=p^.lastchar then
+ getunicode:=p^.map[ord(c)].unicode
+ else
+ getunicode:=0;
+ end;
+
+ function getascii(c : tunicodechar;p : punicodemap) : string;
+
+ var
+ i : longint;
+
+ begin
+ { at least map to space }
+ getascii:=#32;
+ for i:=0 to p^.lastchar do
+ if p^.map[i].unicode=c then
+ begin
+ if i<256 then
+ getascii:=chr(i)
+ else
+ getascii:=chr(i div 256)+chr(i mod 256);
+ exit;
+ end;
+ end;
+
+ var
+ hp : punicodemap;
+
+initialization
+ mappings:=nil;
+finalization
+ while assigned(mappings) do
+ begin
+ hp:=mappings^.next;
+ if not(mappings^.internalmap) then
+ begin
+ freemem(mappings^.map);
+ dispose(mappings);
+ end;
+ mappings:=hp;
+ end;
+end.
+{
+ $Log: charset.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/cmem.pp b/rtl/inc/cmem.pp
new file mode 100644
index 0000000000..bfd6e1ce21
--- /dev/null
+++ b/rtl/inc/cmem.pp
@@ -0,0 +1,215 @@
+{
+ $Id: cmem.pp,v 1.14 2005/03/04 16:49:34 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999 by Michael Van Canneyt, member of the
+ Free Pascal development team
+
+ Implements a memory manager that uses the C memory management.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit cmem;
+
+interface
+
+Const
+{$ifndef ver1_0}
+
+{$if defined(win32)}
+ LibName = 'msvcrt';
+{$elseif defined(netware)}
+ LibName = 'clib';
+{$elseif defined(netwlibc)}
+ LibName = 'libc';
+{$elseif defined(macos)}
+ LibName = 'StdCLib';
+{$else}
+ LibName = 'c';
+{$endif}
+
+{$else}
+
+{$ifndef win32}
+ {$ifdef netware}
+ LibName = 'clib';
+ {$else}
+ {$ifdef netwlibc}
+ LibName = 'libc';
+ {$else}
+ {$ifdef macos}
+ LibName = 'StdCLib';
+ {$else}
+ LibName = 'c';
+ {$endif macos}
+ {$endif netwlibc}
+ {$endif}
+{$else}
+ LibName = 'msvcrt';
+{$endif}
+
+{$endif}
+
+Function Malloc (Size : ptrint) : Pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'malloc';
+Procedure Free (P : pointer); {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'free';
+function ReAlloc (P : Pointer; Size : ptrint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'realloc';
+Function CAlloc (unitSize,UnitCount : ptrint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'calloc';
+
+implementation
+
+type
+ pptrint = ^ptrint;
+
+Function CGetMem (Size : ptrint) : Pointer;
+
+begin
+ CGetMem:=Malloc(Size+sizeof(ptrint));
+ if (CGetMem <> nil) then
+ begin
+ pptrint(CGetMem)^ := size;
+ inc(CGetMem,sizeof(ptrint));
+ end;
+end;
+
+Function CFreeMem (P : pointer) : ptrint;
+
+begin
+ if (p <> nil) then
+ dec(p,sizeof(ptrint));
+ Free(P);
+ CFreeMem:=0;
+end;
+
+Function CFreeMemSize(p:pointer;Size:ptrint):ptrint;
+
+begin
+ if size<=0 then
+ begin
+ if size<0 then
+ runerror(204);
+ exit;
+ end;
+ if (p <> nil) then
+ begin
+ if (size <> pptrint(p-sizeof(ptrint))^) then
+ runerror(204);
+ end;
+ CFreeMemSize:=CFreeMem(P);
+end;
+
+Function CAllocMem(Size : ptrint) : Pointer;
+
+begin
+ CAllocMem:=calloc(Size+sizeof(ptrint),1);
+ if (CAllocMem <> nil) then
+ begin
+ pptrint(CAllocMem)^ := size;
+ inc(CAllocMem,sizeof(ptrint));
+ end;
+end;
+
+Function CReAllocMem (var p:pointer;Size:ptrint):Pointer;
+
+begin
+ if size=0 then
+ begin
+ if p<>nil then
+ begin
+ dec(p,sizeof(ptrint));
+ free(p);
+ p:=nil;
+ end;
+ end
+ else
+ begin
+ inc(size,sizeof(ptrint));
+ if p=nil then
+ p:=malloc(Size)
+ else
+ begin
+ dec(p,sizeof(ptrint));
+ p:=realloc(p,size);
+ end;
+ if (p <> nil) then
+ begin
+ pptrint(p)^ := size-sizeof(ptrint);
+ inc(p,sizeof(ptrint));
+ end;
+ end;
+ CReAllocMem:=p;
+end;
+
+Function CMemSize (p:pointer): ptrint;
+
+begin
+ CMemSize:=pptrint(p-sizeof(ptrint))^;
+end;
+
+{$ifdef HASGETFPCHEAPSTATUS}
+function CGetHeapStatus:THeapStatus;
+
+var res: THeapStatus;
+
+begin
+ fillchar(res,sizeof(res),0);
+ CGetHeapStatus:=res;
+end;
+
+function CGetFPCHeapStatus:TFPCHeapStatus;
+
+begin
+ fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
+end;
+{$else HASGETFPCHEAPSTATUS}
+Procedure CGetHeapStatus(var status:THeapStatus);
+
+begin
+ fillchar(status,sizeof(status),0);
+end;
+{$endif HASGETFPCHEAPSTATUS}
+
+
+Const
+ CMemoryManager : TMemoryManager =
+ (
+ NeedLock : false;
+ GetMem : @CGetmem;
+ FreeMem : @CFreeMem;
+ FreememSize : @CFreememSize;
+ AllocMem : @CAllocMem;
+ ReallocMem : @CReAllocMem;
+ MemSize : @CMemSize;
+ GetHeapStatus : @CGetHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}
+ GetFPCHeapStatus: @CGetFPCHeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
+ );
+
+Var
+ OldMemoryManager : TMemoryManager;
+
+Initialization
+ GetMemoryManager (OldMemoryManager);
+ SetMemoryManager (CmemoryManager);
+
+Finalization
+ SetMemoryManager (OldMemoryManager);
+end.
+
+{
+ $Log: cmem.pp,v $
+ Revision 1.14 2005/03/04 16:49:34 peter
+ * fix getheapstatus bootstrapping
+
+ Revision 1.13 2005/02/28 15:38:38 marco
+ * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
+
+ Revision 1.12 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc
new file mode 100644
index 0000000000..f5519f3034
--- /dev/null
+++ b/rtl/inc/compproc.inc
@@ -0,0 +1,384 @@
+{
+ $Id: compproc.inc,v 1.67 2005/03/28 13:38:05 florian Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains the declarations of internal compiler helper
+ routines. That means you can *NOT* call these directly, as they may
+ be changed or even removed at any time. The only reason they are
+ included in the interface of the system unit, is so that the
+ compiler doesn't need special code to access their parameter
+ list information etc.
+
+ Note that due to the "compilerproc" directive, it isn't even possible
+ to use these routines in your programs.
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ some dummy types necessary to have generic resulttypes for certain compilerprocs }
+type
+ { normally the array shall be maxlongint big, but that will confuse
+ the debugger }
+ fpc_big_chararray = array[0..1023] of char;
+ fpc_big_widechararray = array[0..1023] of widechar;
+ fpc_small_set = longint;
+ fpc_normal_set = array[0..7] of longint;
+
+{$ifdef hascompilerproc}
+
+{ Needed to solve overloading problem with call from assembler (PFV) }
+{$ifdef valuegetmem}
+Function fpc_getmem(size:ptrint):pointer;compilerproc;
+{$endif}
+{$ifdef valuefreemem}
+Procedure fpc_freemem(p:pointer);compilerproc;
+{$endif valuefreemem}
+
+procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
+function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
+procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
+function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
+
+function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
+function fpc_pchar_length(p:pchar):longint; compilerproc;
+function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
+
+function fpc_chararray_to_shortstr(const arr: array of char):shortstring; compilerproc;
+function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
+
+Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
+Function fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
+Function fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
+function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
+{$ifdef HASFUNCTIONCOPYDYNARR}
+function fpc_dynarray_copy(psrc : pointer;ti : pointer;
+ lowidx,count:tdynarrayindex) : pointer;compilerproc;
+{$else HASFUNCTIONCOPYDYNARR}
+procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;lowidx,count:tdynarrayindex);compilerproc;
+{$endif HASFUNCTIONCOPYDYNARR}
+
+function fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
+function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
+procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;
+procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); compilerproc;
+procedure fpc_dynarray_incr_ref(p : pointer); compilerproc;
+procedure fpc_dynarray_setlength(var p : pointer;pti : pointer; dimcount : dword;dims : pdynarrayindex); compilerproc;
+
+{ Str() support }
+{$ifdef STR_USES_VALINT}
+procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;var s : shortstring); compilerproc;
+procedure fpc_shortstr_uint(v : valuint;len : SizeInt;var s : shortstring); compilerproc;
+procedure fpc_chararray_sint(v : valsint;len : SizeInt;var a : array of char); compilerproc;
+procedure fpc_chararray_uint(v : valuint;len : SizeInt;var a : array of char); compilerproc;
+procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; Var S : AnsiString); compilerproc;
+procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; Var S : AnsiString); compilerproc;
+procedure fpc_WideStr_sint(v : valsint; Len : SizeInt; Var S : WideString); compilerproc;
+procedure fpc_WideStr_uint(v : valuint;Len : SizeInt; Var S : WideString); compilerproc;
+{$else}
+procedure fpc_ShortStr_Longint(v : longint;len : longint;var s : shortstring); compilerproc;
+procedure fpc_shortstr_longword(v : longword;len : longint;var s : shortstring); compilerproc;
+procedure fpc_chararray_Longint(v : longint;len : longint;var a : array of char); compilerproc;
+procedure fpc_chararray_longword(v : longword;len : longint;var a : array of char); compilerproc;
+procedure fpc_AnsiStr_Longint(v : Longint; Len : Longint; Var S : AnsiString); compilerproc;
+procedure fpc_AnsiStr_Longword(v : Longword;Len : Longint; Var S : AnsiString); compilerproc;
+procedure fpc_WideStr_Longint(v : Longint; Len : Longint; Var S : WideString); compilerproc;
+procedure fpc_WideStr_Longword(v : Longword;Len : Longint; Var S : WideString); compilerproc;
+{$endif}
+{$ifndef CPU64}
+procedure fpc_shortstr_qword(v : qword;len : SizeInt;var s : shortstring); compilerproc;
+procedure fpc_shortstr_int64(v : int64;len : SizeInt;var s : shortstring); compilerproc;
+procedure fpc_chararray_qword(v : qword;len : SizeInt;var a : array of char); compilerproc;
+procedure fpc_chararray_int64(v : int64;len : SizeInt;var a : array of char); compilerproc;
+procedure fpc_ansistr_qword(v : qword;len : SizeInt;var s : ansistring); compilerproc;
+procedure fpc_ansistr_int64(v : int64;len : SizeInt;var s : ansistring); compilerproc;
+procedure fpc_widestr_qword(v : qword;len : SizeInt;var s : widestring); compilerproc;
+procedure fpc_widestr_int64(v : int64;len : SizeInt;var s : widestring); compilerproc;
+{$endif CPU64}
+procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : shortstring); compilerproc;
+procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;var a : array of char); compilerproc;
+procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : ansistring); compilerproc;
+procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : WideString); compilerproc;
+
+{ Val() support }
+Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValReal; compilerproc;
+Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; compilerproc;
+Function fpc_Val_Real_WideStr(Const S : WideString; Var Code : ValSInt): ValReal; compilerproc;
+Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; var Code: ValSInt): ValSInt; compilerproc;
+Function fpc_Val_UInt_Shortstr(Const S: ShortString; var Code: ValSInt): ValUInt; compilerproc;
+Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; compilerproc;
+Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; Var Code : ValSInt): ValSInt; compilerproc;
+Function fpc_Val_UInt_WideStr (Const S : WideString; Var Code : ValSInt): ValUInt; compilerproc;
+Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; Var Code : ValSInt): ValSInt; compilerproc;
+{$ifndef CPU64}
+Function fpc_val_int64_shortstr(Const S: ShortString; var Code: ValSInt): Int64; compilerproc;
+Function fpc_val_qword_shortstr(Const S: ShortString; var Code: ValSInt): QWord; compilerproc;
+Function fpc_Val_qword_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword;compilerproc;
+Function fpc_Val_int64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; compilerproc;
+Function fpc_Val_qword_WideStr (Const S : WideString; Var Code : ValSInt): qword; compilerproc;
+Function fpc_Val_int64_WideStr (Const S : WideString; Var Code : ValSInt): Int64; compilerproc;
+{$endif CPU64}
+
+Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); compilerproc;
+Procedure fpc_AnsiStr_Incr_Ref (S : Pointer); compilerproc;
+Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
+function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
+Procedure fpc_ansistr_append_char(Var S : AnsiString;c : char); compilerproc;
+Procedure fpc_ansistr_append_shortstring(Var S : AnsiString;Str : ShortString); compilerproc;
+Procedure fpc_ansistr_append_ansistring(Var S : AnsiString;Str : AnsiString); compilerproc;
+{$ifdef EXTRAANSISHORT}
+Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
+{$endif EXTRAANSISHORT}
+function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; compilerproc;
+Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
+Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
+Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
+Function fpc_CharArray_To_AnsiStr(const arr: array of char): ansistring; compilerproc;
+function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
+Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
+Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
+Procedure fpc_AnsiStr_CheckRange(len,index : SizeInt); compilerproc;
+Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt); compilerproc;
+{$ifdef EXTRAANSISHORT}
+Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc;
+{$endif EXTRAANSISHORT}
+{ pointer argument because otherwise when calling this, we get }
+{ an endless loop since a 'var s: ansistring' must be made }
+{ unique as well }
+Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
+
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
+Procedure fpc_WideStr_Incr_Ref (S : Pointer); compilerproc;
+function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring; compilerproc;
+Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
+Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
+Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
+Function fpc_WideStr_Concat (const S1,S2 : WideString) : WideString; compilerproc;
+Function fpc_Char_To_WideStr(const c : WideChar): WideString; compilerproc;
+Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
+Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; compilerproc;
+function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
+Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar): shortstring; compilerproc;
+Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar): AnsiString; compilerproc;
+Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar): WideString; compilerproc;
+Function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray; compilerproc;
+Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
+Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
+Procedure fpc_WideStr_CheckRange(len,index : SizeInt); compilerproc;
+Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt); compilerproc;
+function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
+
+{$ifdef HASWIDECHAR}
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
+Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
+Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
+{$endif HASWIDECHAR}
+
+{ from text.inc }
+Function fpc_get_input:PText;{$ifdef hascompilerproc}compilerproc;{$endif}
+Function fpc_get_output:PText;{$ifdef hascompilerproc}compilerproc;{$endif}
+Procedure fpc_Write_End(var f:Text); compilerproc;
+Procedure fpc_Writeln_End(var f:Text); compilerproc;
+Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); compilerproc;
+Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char); compilerproc;
+Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); compilerproc;
+Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; S : AnsiString); compilerproc;
+{$ifdef HASWIDESTRING}
+Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; S : WideString); compilerproc;
+{$endif HASWIDESTRING}
+Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); compilerproc;
+Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); compilerproc;
+{$ifndef CPU64}
+procedure fpc_write_text_qword(len : longint;var t : text;q : qword); compilerproc;
+procedure fpc_write_text_int64(len : longint;var t : text;i : int64); compilerproc;
+{$endif CPU64}
+Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
+Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); compilerproc;
+Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); compilerproc;
+{$ifdef HASWIDECHAR}
+Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); compilerproc;
+{$endif HASWIDECHAR}
+
+{$ifdef HASVARIANT}
+procedure fpc_variant_copy(d,s : pointer);compilerproc;
+procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); compilerproc;
+function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
+function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;
+function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
+function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
+procedure fpc_vararray_get(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+{$endif HASVARIANT}
+
+Procedure fpc_Read_End(var f:Text); compilerproc;
+Procedure fpc_ReadLn_End(var f : Text); compilerproc;
+Procedure fpc_Read_Text_ShortStr(var f : Text;var s : String); compilerproc;
+Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text;var s : PChar); compilerproc;
+Procedure fpc_Read_Text_PChar_As_Array(var f : Text;var s : array of char); compilerproc;
+Procedure fpc_Read_Text_AnsiStr(var f : Text;var s : AnsiString); compilerproc;
+Procedure fpc_Read_Text_Char(var f : Text; var c : char); compilerproc;
+Procedure fpc_Read_Text_SInt(var f : Text; var l :ValSInt); compilerproc;
+Procedure fpc_Read_Text_UInt(var f : Text; var u :ValUInt); compilerproc;
+Procedure fpc_Read_Text_Float(var f : Text; var v :ValReal); compilerproc;
+{$ifndef CPU64}
+Procedure fpc_Read_Text_QWord(var f : text; var q : qword); compilerproc;
+Procedure fpc_Read_Text_Int64(var f : text; var i : int64); compilerproc;
+{$endif CPU64}
+
+{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
+function fpc_div_dword(n,z : dword) : dword; compilerproc;
+function fpc_mod_dword(n,z : dword) : dword; compilerproc;
+function fpc_div_longint(n,z : longint) : longint; compilerproc;
+function fpc_mod_longint(n,z : longint) : longint; compilerproc;
+{$endif FPC_INCLUDE_SOFTWARE_MOD_DIV}
+
+{ from int64.inc }
+function fpc_div_qword(n,z : qword) : qword; compilerproc;
+function fpc_mod_qword(n,z : qword) : qword; compilerproc;
+function fpc_div_int64(n,z : int64) : int64; compilerproc;
+function fpc_mod_int64(n,z : int64) : int64; compilerproc;
+function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword; compilerproc;
+function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64; compilerproc;
+
+{$ifdef FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+function fpc_shl_qword(value,shift : qword) : qword; compilerproc;
+function fpc_shr_qword(value,shift : qword) : qword; compilerproc;
+function fpc_shl_int64(value,shift : int64) : int64; compilerproc;
+function fpc_shr_int64(value,shift : int64) : int64; compilerproc;
+{$endif FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+
+{$ifdef INTERNCONSTINTF}
+function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
+function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_exp_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_frac_real(d : ValReal) : ValReal;compilerproc;
+function fpc_int_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_ln_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_pi_real : ValReal;compilerproc;
+function fpc_sin_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;
+function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_round_real(d : ValReal) : int64;compilerproc;
+function fpc_trunc_real(d : ValReal) : int64;compilerproc;
+{$else INTERNCONSTINTF}
+function fpc_round(d : ValReal) : int64;compilerproc;
+{$endif INTERNCONSTINTF}
+
+function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
+function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
+procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
+procedure fpc_intf_incr_ref(i: pointer); compilerproc;
+procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
+function fpc_intf_as(const S: pointer; const iid: TGUID): pointer; compilerproc;
+function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer; compilerproc;
+
+Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
+Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
+Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc;
+Procedure fpc_PopAddrStack; compilerproc;
+function fpc_PopObjectStack : TObject; compilerproc;
+function fpc_PopSecondObjectStack : TObject; compilerproc;
+Procedure fpc_ReRaise; compilerproc;
+Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
+
+function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;compilerproc;
+procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);compilerproc;
+procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);compilerproc;
+
+{$ifdef dummy}
+Procedure fpc_DestroyException(o : TObject); compilerproc;
+procedure fpc_check_object(obj:pointer); compilerproc;
+procedure fpc_check_object_ext(vmt,expvmt:pointer);compilerproc;
+{$endif dummy}
+
+Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc;
+Procedure fpc_finalize (Data,TypeInfo: Pointer); compilerproc;
+Procedure fpc_Addref (Data,TypeInfo : Pointer); compilerproc;
+Procedure fpc_DecRef (Data,TypeInfo : Pointer); compilerproc;
+procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); compilerproc;
+
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; compilerproc;
+function fpc_set_create_element(b : byte): fpc_normal_set; compilerproc;
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
+function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; compilerproc;
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
+function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
+function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
+
+{$ifdef LARGESETS}
+procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc;
+procedure fpc_largeset_in_word(p : pointer;b : word); compilerproc;
+procedure fpc_largeset_add_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_sub_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_symdif_sets(set1,set2,dest : pointer;size : longint); compilerproc;
+procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint); compilerproc;
+procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint); compilerproc;
+{$endif LARGESETS}
+
+procedure fpc_rangeerror; compilerproc;
+procedure fpc_divbyzero; compilerproc;
+procedure fpc_overflow; compilerproc;
+//procedure fpc_iocheck(addr : longint); compilerproc;
+procedure fpc_iocheck; compilerproc;
+
+procedure fpc_InitializeUnits; compilerproc;
+// not generated by compiler, called directly in system unit
+// procedure fpc_FinalizeUnits; compilerproc;
+
+{
+Procedure fpc_do_exit; compilerproc;
+Procedure fpc_lib_exit; compilerproc;
+Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
+Procedure fpc_HandleError (Errno : longint); compilerproc;
+}
+
+procedure fpc_AbstractErrorIntern;compilerproc;
+procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); compilerproc;
+
+Procedure fpc_reset_typed(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_rewrite_typed(var f : TypedFile;Size : Longint); compilerproc;
+Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf); compilerproc;
+Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compilerproc;
+
+{$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+function fpc_int64_to_double(i: int64): double; compilerproc;
+function fpc_qword_to_double(q: qword): double; compilerproc;
+{$endif FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+
+{$endif hascompilerproc}
+
+{
+ $Log: compproc.inc,v $
+ Revision 1.67 2005/03/28 13:38:05 florian
+ + a lot of vararray stuff
+
+ Revision 1.66 2005/03/05 16:37:28 florian
+ * fixed copy(dyn. array,...);
+
+ Revision 1.65 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.64 2005/01/07 21:15:46 florian
+ + basic rtl support for variant <-> interface implemented
+
+ Revision 1.63 2005/01/06 13:39:59 florian
+ * widecharray patch from Peter
+
+}
diff --git a/rtl/inc/crt.inc b/rtl/inc/crt.inc
new file mode 100644
index 0000000000..8259b2b46b
--- /dev/null
+++ b/rtl/inc/crt.inc
@@ -0,0 +1,420 @@
+{
+ $Id: crt.inc,v 1.2 2005/05/14 14:58:41 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1998 - 2005 by the Free Pascal development team.
+
+ This file implements platform independent routines for Crt.
+ It should be modified later to use routines from Keyboard and
+ Video instead of code in platform-specific crt.pas.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+procedure GotoXY (X: byte; Y: byte);
+begin
+ GotoXY32 (X, Y);
+end;
+
+procedure Window (X1, Y1, X2, Y2: byte);
+begin
+ Window32 (X1, Y1, X2, Y2);
+end;
+
+function WhereX: byte;
+var
+ X1: dword;
+begin
+ X1 := WhereX32;
+ if X1 > 255 then
+ WhereX := 255
+ else
+ WhereX := X1;
+end;
+
+function WhereY: byte;
+var
+ Y1: dword;
+begin
+ Y1 := WhereY32;
+ if Y1 > 255 then
+ WhereY := 255
+ else
+ WhereY := Y1;
+end;
+
+
+procedure ClrScr;
+{Clears the current window.}
+begin
+ RemoveLines (0, Succ (WindMaxY - WindMinY));
+ GotoXY32 (1, 1);
+end;
+
+
+procedure GotoXY32 (X, Y: dword);
+(* Positions cursor on (X, Y) (1-based) relative to window origin; for TP/BP
+ compatibility call completely ignored in case of incorrect parameters. *)
+begin
+ if (X > 0) and (Y > 0) then
+ begin
+ Dec (X);
+ Dec (Y);
+ if (X <= WindMaxX - WindMinX) and (Y <= WindMaxY - WindMinY) then
+ SetScreenCursor (X + WindMinX, Y + WindMinY);
+ end;
+end;
+
+
+function WhereX32: dword;
+(* Returns the X position of the cursor (1-based). *)
+var
+ X, Y: dword;
+begin
+ GetScreenCursor (X, Y);
+ WhereX32 := Succ (X - WindMinX);
+end;
+
+
+function WhereY32: dword;
+(* Returns the Y position of the cursor (1-based). *)
+var
+ X, Y: dword;
+begin
+ GetScreenCursor (X, Y);
+ WhereY32 := Succ (Y - WindMinY);
+end;
+
+
+procedure ClrEol;
+(* Clears the line where cursor is located from current position up to end. *)
+var
+ X, Y: dword;
+begin
+ GetScreenCursor (X, Y);
+ ClearCells (X, Y, Succ (WindMaxX - X));
+end;
+
+
+procedure DelLine;
+(* Deletes the line at cursor. *)
+begin
+ RemoveLines (Pred (WhereY32), 1);
+end;
+
+
+procedure TextMode (Mode: integer);
+{ Use this procedure to set-up a specific text-mode.}
+begin
+ TextAttr := $07;
+ LastMode := Mode;
+ SetScreenMode (word (Mode));
+ WindMin := 0;
+ WindMaxX := Pred (ScreenWidth);
+ WindMaxY := Pred (ScreenHeight);
+ if WindMaxX >= 255 then
+ WindMax := 255
+ else
+ WindMax := WindMaxX;
+ if WindMaxY >= 255 then
+ WindMax := WindMax or $FF00
+ else
+ WindMax := WindMax or (WindMaxY shl 8);
+ ClrScr;
+end;
+
+
+procedure TextColor (Color: byte);
+{All text written after calling this will have Color as foreground colour.}
+begin
+ TextAttr := (TextAttr and $70) or (Color and $f);
+ if Color > 15 then
+ TextAttr := TextAttr or 128;
+end;
+
+
+procedure TextBackground (Color: byte);
+{All text written after calling this will have Color as background colour.}
+begin
+ TextAttr := (TextAttr and $8F) or ((Color and $7) shl 4);
+end;
+
+
+procedure NormVideo;
+{Changes the text-background to black and the foreground to white.}
+begin
+ TextAttr := $7;
+end;
+
+
+procedure LowVideo;
+{All text written after this will have low intensity.}
+begin
+ TextAttr := TextAttr and $F7;
+end;
+
+
+procedure HighVideo;
+{All text written after this will have high intensity.}
+begin
+ TextAttr := TextAttr or $8;
+end;
+
+
+procedure Window32 (X1, Y1, X2, Y2: dword);
+{Change the write window to the given coordinates.}
+begin
+ if (X1 > 0) and (Y1 > 0) and (X2 <= ScreenWidth) and (Y2 <= ScreenHeight)
+ and (X1 <= X2) and (Y1 <= Y2) then
+ begin
+ WindMinX := Pred (X1);
+ WindMinY := Pred (Y1);
+ if WindMinX >= 255 then
+ WindMin := 255
+ else
+ WindMin := WindMinX;
+ if WindMinY >= 255 then
+ WindMin := WindMin or $FF00
+ else
+ WindMin := WindMin or (WindMinY shl 8);
+ WindMaxX := Pred (X2);
+ WindMaxY := Pred (Y2);
+ if WindMaxX >= 255 then
+ WindMax := 255
+ else
+ WindMax := WindMaxX;
+ if WindMaxY >= 255 then
+ WindMax := WindMax or $FF00
+ else
+ WindMax := WindMaxX or (WindMaxY shl 8);
+ GotoXY32 (1, 1);
+ end;
+end;
+
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ CurrX, CurrY: dword;
+
+
+procedure WriteChar (C: char);
+begin
+ case C of
+ #7: WriteBell;
+ #8: if CurrX >= WindMinX then
+ Dec (CurrX);
+{ #9: x:=(x-lo(windmin)) and $fff8+8+lo(windmin);}
+ #10: Inc (CurrY);
+ #13: CurrX := WindMinX;
+ else
+ begin
+ WriteNormal (C, CurrX, CurrY);
+ Inc (CurrX);
+ end;
+ end;
+ if CurrX > WindMaxX then
+ begin
+ CurrX := WindMinX;
+ Inc (CurrY);
+ end;
+ if CurrY > WindMaxY then
+ begin
+ RemoveLines (0, 1);
+ CurrY := WindMaxY;
+ end;
+end;
+
+
+function CrtWrite (var F: TextRec): integer;
+var
+ I: dword;
+{Write a series of characters to the console.}
+begin
+ if F.BufPos > 0 then
+ begin
+ GetScreenCursor (CurrX, CurrY);
+ for I := 0 to Pred (F.BufPos) do
+ WriteChar ((PChar (F.BufPtr) + I)^);
+ SetScreenCursor (CurrX, CurrY);
+ F.BufPos := 0;
+ end;
+ CrtWrite := 0;
+end;
+
+
+function CrtRead (var F: TextRec): integer;
+{Read a series of characters from the console.}
+var
+ C: char;
+begin
+ GetScreenCursor (CurrX, CurrY);
+ F.BufPos := 0;
+ F.BufEnd := 0;
+ repeat
+ if F.BufPos > F.BufEnd then
+ F.BufEnd := F.BufPos;
+ SetScreenCursor (CurrX, CurrY);
+ C := ReadKey;
+ case C of
+ #0: ReadKey;
+(* The following code to support input editing is incomplete anyway
+ - no handling of line breaks, no possibility to insert characters
+ or delete characters inside the string, etc.
+
+ #0 : case readkey of
+ #71 : while f.bufpos>0 do
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #75 : if f.bufpos>0 then
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #77 : if f.bufpos<f.bufend then
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #79 : while f.bufpos<f.bufend do
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ end;
+*)
+
+ #8: if (F.BufPos > 0) and (F.BufPos = F.BufEnd) then
+ begin
+{$WARNING CrtRead doesn't handle line breaks correctly (same bug as TP/BP)!}
+ WriteChar (#8);
+ WriteChar (' ');
+ WriteChar (#8);
+ Dec (F.BufPos);
+ Dec (F.BufEnd);
+ end;
+ #13: begin
+ WriteChar(#13);
+ WriteChar(#10);
+ F.BufPtr^ [F.BufEnd] := #13;
+ Inc (F.BufEnd);
+ F.BufPtr^ [F.BufEnd] := #10;
+ Inc (F.BufEnd);
+ break;
+ end;
+ #26: if CheckEOF then
+ begin
+ F.BufPtr^ [F.BufEnd] := #26;
+ Inc (F.BufEnd);
+ break;
+ end;
+ #32..#255: if F.BufPos < F.BufSize - 2 then
+ begin
+ F.BufPtr^ [F.BufPos] := C;
+ Inc (F.BufPos);
+ WriteChar (C);
+ end;
+ end
+ until false;
+ CrtRead := 0;
+end;
+
+
+function CrtReturn (var F: TextRec): integer;
+begin
+ CrtReturn:=0;
+end;
+
+
+function CrtClose (var F: TextRec): integer;
+begin
+ F.Mode := fmClosed;
+ CrtClose := 0;
+end;
+
+
+function CrtOpen (var F: TextRec): integer;
+begin
+ if F.Mode = fmOutput then
+ begin
+ TextRec(F).InOutFunc := @CrtWrite;
+ TextRec(F).FlushFunc := @CrtWrite;
+ end
+ else
+ begin
+ F.Mode := fmInput;
+ TextRec(F).InOutFunc := @CrtRead;
+ TextRec(F).FlushFunc := @CrtReturn;
+ end;
+ TextRec(F).CloseFunc := @CrtClose;
+ CrtOpen := 0;
+end;
+
+
+procedure AssignCrt (var F: text);
+{Assigns a file to the crt console.}
+begin
+ Assign (F, '');
+ TextRec (F).OpenFunc := @CrtOpen;
+end;
+
+
+{$IFNDEF HAS_SOUND}
+procedure Sound (Hz: word);
+(* Dummy Sound implementation - for platforms requiring both frequence
+ and duration at the beginning instead of start and stop procedures. *)
+begin
+end;
+{$ENDIF HAS_SOUND}
+
+
+{$IFNDEF HAS_NOSOUND}
+procedure NoSound;
+(* Dummy NoSound implementation - for platforms requiring both frequence
+ and duration at the beginning instead of start and stop procedures. *)
+begin
+end;
+{$ENDIF HAS_NOSOUND}
+
+
+procedure CrtInit;
+(* Common part of unit initialization. *)
+begin
+ TextAttr := LightGray;
+ WindMin := 0;
+ WindMaxX := Pred (ScreenWidth);
+ WindMaxY := Pred (ScreenHeight);
+ if WindMaxX >= 255 then
+ WindMax := 255
+ else
+ WindMax := WindMaxX;
+ if WindMaxY >= 255 then
+ WindMax := WindMax or $FF00
+ else
+ WindMax := WindMax or (WindMaxY shl 8);
+ ExtKeyCode := #0;
+ AssignCrt (Input);
+ Reset (Input);
+ AssignCrt (Output);
+ Rewrite (Output);
+end;
+
+{
+ $Log: crt.inc,v $
+ Revision 1.2 2005/05/14 14:58:41 hajny
+ * TextMode parameter type changed temporarily not to break other platforms
+
+ Revision 1.1 2005/05/14 14:32:55 hajny
+ + basis for common platform independent implementation of Crt
+
+
+}
diff --git a/rtl/inc/crth.inc b/rtl/inc/crth.inc
new file mode 100644
index 0000000000..636bf695fa
--- /dev/null
+++ b/rtl/inc/crth.inc
@@ -0,0 +1,108 @@
+{
+ $Id: crth.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Borland Pascal 7 Compatible CRT Unit - Interface section
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Const
+{ CRT modes }
+ BW40 = 0; { 40x25 B/W on Color Adapter }
+ CO40 = 1; { 40x25 Color on Color Adapter }
+ BW80 = 2; { 80x25 B/W on Color Adapter }
+ CO80 = 3; { 80x25 Color on Color Adapter }
+ Mono = 7; { 80x25 on Monochrome Adapter }
+ Font8x8 = 256; { Add-in for ROM font }
+
+{ Mode constants for 3.0 compatibility }
+ C40 = CO40;
+ C80 = CO80;
+
+{ Foreground and background color constants }
+ Black = 0;
+ Blue = 1;
+ Green = 2;
+ Cyan = 3;
+ Red = 4;
+ Magenta = 5;
+ Brown = 6;
+ LightGray = 7;
+
+{ Foreground color constants }
+ DarkGray = 8;
+ LightBlue = 9;
+ LightGreen = 10;
+ LightCyan = 11;
+ LightRed = 12;
+ LightMagenta = 13;
+ Yellow = 14;
+ White = 15;
+
+{ Add-in for blinking }
+ Blink = 128;
+
+var
+
+{ Interface variables }
+ CheckBreak: Boolean; { Enable Ctrl-Break }
+ CheckEOF: Boolean; { Enable Ctrl-Z }
+ DirectVideo: Boolean; { Enable direct video addressing }
+ CheckSnow: Boolean; { Enable snow filtering }
+{$ifdef ver1_0}
+const
+{$endif}
+ LastMode: Word = 3; { Current text mode }
+ TextAttr: Byte = $07; { Current text attribute }
+ WindMin: Word = $0; { Window upper left coordinates }
+ WindMax: Word = $184f; { Window lower right coordinates }
+{$ifdef ver1_0}
+var
+{$endif}
+ { FPC Specific for large screen support }
+ WindMinX : DWord;
+ WindMaxX : DWord;
+ WindMinY : DWord;
+ WindMaxY : DWord ;
+
+{ Interface procedures }
+procedure AssignCrt(var F: Text);
+function KeyPressed: Boolean;
+function ReadKey: Char;
+procedure TextMode(Mode: Integer);
+procedure Window(X1,Y1,X2,Y2: Byte);
+procedure GotoXY(X,Y: Byte);
+function WhereX: Byte;
+function WhereY: Byte;
+procedure ClrScr;
+procedure ClrEol;
+procedure InsLine;
+procedure DelLine;
+procedure TextColor(Color: Byte);
+procedure TextBackground(Color: Byte);
+procedure LowVideo;
+procedure HighVideo;
+procedure NormVideo;
+procedure Delay(MS: Word);
+procedure Sound(Hz: Word);
+procedure NoSound;
+
+{Extra Functions}
+procedure cursoron;
+procedure cursoroff;
+procedure cursorbig;
+
+{
+ $Log: crth.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/ctypes.pp b/rtl/inc/ctypes.pp
new file mode 100644
index 0000000000..7b776c54f5
--- /dev/null
+++ b/rtl/inc/ctypes.pp
@@ -0,0 +1,117 @@
+{
+ $Id: ctypes.pp,v 1.5 2005/03/13 10:05:13 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Marco van de Voort, member of the
+ Free Pascal development team
+
+ Implements C types for in header conversions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+
+ **********************************************************************}
+
+unit ctypes;
+
+interface
+
+{$ifdef unix}
+uses unixtype;
+{$i aliasctp.inc}
+{$else}
+
+Type
+ { the following type definitions are compiler dependant }
+ { and system dependant }
+
+ cInt8 = shortint;
+ cUInt8 = byte;
+ cUInt16= word;
+ cInt16 = smallint;
+ cInt32 = longint;
+ cUInt32= cardinal;
+ cInt64 = int64;
+{$ifndef VER1_0}
+ cUInt64= qword;
+{$else}
+ cUInt64= int64;
+{$endif}
+
+ cuchar = byte;
+ cchar = shortint;
+ cInt = longint; { minimum range is : 32-bit }
+ cUInt = Cardinal; { minimum range is : 32-bit }
+{$ifdef cpu64}
+ cLong = int64;
+ {$ifdef VER1_0}
+ cuLong = int64;
+ {$else}
+ cuLong = qword;
+ {$endif}
+{$else}
+ cLong = longint;
+ cuLong = Cardinal;
+{$endif}
+ clonglong = int64;
+{$ifndef VER1_0}
+ culonglong = qword;
+{$else VER1_0}
+ culonglong = int64;
+{$endif VER1_0}
+ cshort = smallint;
+ cushort = word;
+
+ pcInt = ^cInt;
+ pcUInt = ^cUInt;
+ pcLong = ^cLong;
+ pculong = ^cuLong;
+ pcshort = ^cshort;
+ pcushort = ^cushort;
+ pcchar = ^cchar;
+ pcuchar = ^cuchar;
+
+ cunsigned = cuint;
+ pcunsigned = ^cunsigned;
+
+ { Floating point }
+ cFloat = Single;
+ cDouble = Double;
+ clDouble = Extended;
+ pcFloat = ^cFloat;
+ pcDouble = ^cDouble;
+ pclDouble = ^clDouble;
+{$endif}
+
+// Kylix compat types
+ u_long = culong;
+ u_short = cushort;
+
+implementation
+
+
+end.
+
+{
+ $Log: ctypes.pp,v $
+ Revision 1.5 2005/03/13 10:05:13 florian
+ + floating point c types added
+
+ Revision 1.4 2005/03/01 22:45:09 hajny
+ * Florian's changes from ctypes.inc merged in to make xlib compilable under non-Unix again
+
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.2 2005/02/12 17:35:18 marco
+ * some kylix stuf
+
+ Revision 1.1 2005/01/10 10:32:50 marco
+ * initial version
+
+
+}
diff --git a/rtl/inc/dos.inc b/rtl/inc/dos.inc
new file mode 100644
index 0000000000..0b45958408
--- /dev/null
+++ b/rtl/inc/dos.inc
@@ -0,0 +1,316 @@
+{
+ $Id: dos.inc,v 1.8 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Tomas Hajny,
+ member of the Free Pascal development team.
+
+ Common implementations of functions for unit Dos
+ (including dummy implementation of some functions for platforms
+ missing real implementation).
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+(* Everywhere the same now, but prepared for potential difference. *)
+const
+ ExtensionSeparator = '.';
+
+{$IFNDEF HAS_DOSEXITCODE}
+ {$IFDEF HASTHREADVAR}
+threadvar
+ {$ELSE HASTHREADVAR}
+var
+ {$ENDIF HASTHREADVAR}
+ LastDosExitCode: longint;
+
+function DosExitCode: word;
+begin
+ if LastDosExitCode > high (word) then
+ DosExitCode := high (word)
+ else
+ DosExitCode := LastDosExitCode and $FFFF;
+end;
+{$ENDIF HAS_DOSEXITCODE}
+
+
+{$IFNDEF HAS_GETMSCOUNT}
+ {$WARNING Real GetMsCount implementation missing, dummy version used}
+{Dummy implementation of GetMsCount for platforms missing anything better.}
+function GetMsCount: int64;
+var
+ Y, Mo, D, WD, H, Mi, S, S100: word;
+const
+ DayTable: array[Boolean, 1..12] of longint =
+ ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
+ (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
+
+ function Leap: boolean;
+ begin
+ if (Y mod 400) = 0 then
+ Leap := true
+ else
+ if ((Y mod 100) = 0) or ((Y mod 4) <> 0) then
+ Leap := false
+ else
+ Leap := true;
+ end;
+
+ {$IFDEF VER1_0}
+{ Necessary to avoid internal error 10... :-( }
+var
+ DC: cardinal;
+ I64: int64;
+ {$ENDIF VER1_0}
+begin
+ GetDate (Y, Mo, D, WD);
+ GetTime (H, Mi, S, S100);
+ {$IFDEF VER1_0}
+ DC := D + DayTable [Leap, Mo] + (Y div 400) * 97;
+ DC := DC + ((Y mod 400) div 100) * 24 + (Y mod 100) div 4;
+ I64 := S100 * 10 + S * 1000;
+ I64 := I64 + cardinal (Mi) * 60*1000;
+ I64 := I64 + int64 (H) * 60*60*1000;
+ I64 := I64 + int64 (DC) * 24*60*60*1000;
+ I64 := I64 + int64 (Y) * 365*24*60*60*1000;
+ GetMsCount := I64;
+ {$ELSE VER1_0}
+ GetMsCount := S100 * 10 + S * 1000 + cardinal (Mi) * 60*1000
+ + int64 (H) * 60*60*1000
+ + int64 (D + DayTable [Leap, Mo]
+ + (Y div 400) * 97 + ((Y mod 400) div 100) * 24 + (Y mod 100) div 4)
+ * 24*60*60*1000
+ + int64 (Y) * 365*24*60*60*1000;
+ {$ENDIF VER1_0}
+end;
+{$ENDIF HAS_GETMSCOUNT}
+
+
+{$IFNDEF HAS_GETCBREAK}
+procedure GetCBreak (var BreakValue: boolean);
+begin
+ BreakValue := true;
+end;
+{$ENDIF HAS_GETCBREAK}
+
+
+{$IFNDEF HAS_SETCBREAK}
+procedure SetCBreak (BreakValue: boolean);
+begin
+end;
+{$ENDIF HAS_SETCBREAK}
+
+
+{$IFNDEF HAS_GETVERIFY}
+var
+ VerifyValue: boolean;
+
+procedure GetVerify (var Verify: boolean);
+begin
+ Verify := VerifyValue;
+end;
+{$ENDIF HAS_GETVERIFY}
+
+
+{$IFNDEF HAS_SETVERIFY}
+ {$IFDEF HAS_GETVERIFY}
+var
+ VerifyValue: boolean;
+ {$ENDIF HAS_GETVERIFY}
+
+procedure SetVerify (Verify: boolean);
+begin
+ VerifyValue := Verify;
+end;
+{$ENDIF HAS_SETVERIFY}
+
+
+{$IFDEF CPUI386}
+ {$IFNDEF HAS_INTR}
+procedure Intr (IntNo: byte; var Regs: Registers);
+begin
+end;
+ {$ENDIF HAS_INTR}
+
+
+ {$IFNDEF HAS_MSDOS}
+procedure MSDos (var Regs: Registers);
+begin
+ Intr ($21, Regs);
+end;
+ {$ENDIF HAS_MSDOS}
+{$ENDIF CPUI386}
+
+
+{$IFNDEF HAS_SWAPVECTORS}
+procedure SwapVectors;
+begin
+end;
+{$ENDIF HAS_SWAPVECTORS}
+
+
+{$IFNDEF HAS_GETINTVEC}
+procedure GetIntVec (IntNo: byte; var Vector: pointer);
+begin
+ Vector := nil;
+end;
+{$ENDIF HAS_GETINTVEC}
+
+
+{$IFNDEF HAS_SETINTVEC}
+procedure SetIntVec (IntNo: byte; Vector: pointer);
+begin
+end;
+{$ENDIF HAS_SETINTVEC}
+
+
+{$IFNDEF HAS_KEEP}
+procedure Keep (ExitCode: word);
+begin
+end;
+{$ENDIF HAS_KEEP}
+
+
+{$IFNDEF HAS_GETSHORTNAME}
+function GetShortName (var P: String): boolean;
+begin
+ GetShortName := true;
+end;
+{$ENDIF HAS_GETSHORTNAME}
+
+
+{$IFNDEF HAS_GETLONGNAME}
+function GetLongName (var P: String): boolean;
+begin
+ GetLongName := true;
+end;
+{$ENDIF HAS_GETLONGNAME}
+
+
+{PackTime is platform independent}
+procedure PackTime (var T: DateTime; var P: longint);
+
+var zs:longint;
+
+begin
+ p:=-1980;
+ p:=p+t.year and 127;
+ p:=p shl 4;
+ p:=p+t.month;
+ p:=p shl 5;
+ p:=p+t.day;
+ p:=p shl 16;
+ zs:=t.hour;
+ zs:=zs shl 6;
+ zs:=zs+t.min;
+ zs:=zs shl 5;
+ zs:=zs+t.sec div 2;
+ p:=p+(zs and $ffff);
+end;
+
+{UnpackTime is platform-independent}
+procedure UnpackTime (P: longint; var T: DateTime);
+
+begin
+ t.sec:=(p and 31) * 2;
+ p:=p shr 5;
+ t.min:=p and 63;
+ p:=p shr 6;
+ t.hour:=p and 31;
+ p:=p shr 5;
+ t.day:=p and 31;
+ p:=p shr 5;
+ t.month:=p and 15;
+ p:=p shr 4;
+ t.year:=p+1980;
+end;
+
+
+{****************************************************************************
+ A platform independent implementation of FSplit
+****************************************************************************}
+
+{$IFNDEF HAS_FSPLIT}
+Procedure FSplit (Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: ExtStr);
+var
+ DirEnd, ExtStart: Longint;
+begin
+ if DirectorySeparator = '/' then
+ { allow backslash as slash }
+ for DirEnd := 1 to Length (Path) do
+ begin
+ if Path [DirEnd] = '\' then Path [DirEnd] := DirectorySeparator
+ end
+ else
+ if DirectorySeparator = '\' then
+ { allow slash as backslash }
+ for DirEnd := 1 to Length (Path) do
+ if Path [DirEnd] = '/' then Path [DirEnd] := DirectorySeparator;
+
+{ Find the first DirectorySeparator or DriveSeparator from the end. }
+ DirEnd := Length (Path);
+{ Avoid problems with platforms having DriveSeparator = DirectorySeparator. }
+ if DirectorySeparator = DriveSeparator then
+ while (DirEnd > 0) and (Path [DirEnd] <> DirectorySeparator) do
+ Dec (DirEnd)
+ else
+ while (DirEnd > 0) and
+ (Path [DirEnd] <> DirectorySeparator) and
+ (Path [DirEnd] <> DriveSeparator) do
+ Dec (DirEnd);
+
+{ The first "extension" should be returned if LFN }
+{ support not available, the last one otherwise. }
+ if LFNSupport then
+ begin
+ ExtStart := Length (Path);
+ while (ExtStart > DirEnd) and (Path [ExtStart] <> ExtensionSeparator) do
+ Dec (ExtStart);
+ if ExtStart = 0 then
+ ExtStart := Length (Path) + 1
+ else
+ if Path [ExtStart] <> ExtensionSeparator then
+ ExtStart := Length (Path) + 1;
+ end
+ else
+ begin
+ ExtStart := DirEnd + 1;
+ while (ExtStart <= Length (Path)) and (Path [ExtStart] <> ExtensionSeparator) do
+ Inc (ExtStart);
+ end;
+
+ Dir := Copy (Path, 1, DirEnd);
+ Name := Copy (Path, DirEnd + 1, ExtStart - DirEnd - 1);
+ Ext := Copy (Path, ExtStart, Length (Path) - ExtStart + 1);
+end;
+{$ENDIF HAS_FSPLIT}
+
+
+{****************************************************************************
+ A platform independent implementation of FExpand
+****************************************************************************}
+
+{$IFNDEF HAS_FEXPAND}
+
+(* FExpand maintained in standalone include file for easier maintenance. *)
+{$I fexpand.inc}
+
+{$ENDIF HAS_FEXPAND}
+
+{
+ $Log: dos.inc,v $
+ Revision 1.8 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.7 2005/01/23 09:50:59 hajny
+ * yet another attempt to make Mac OS accept dos.inc without hacks ;-)
+
+ Revision 1.6 2005/01/01 20:31:02 olle
+ + hack again to make macos compile
+
+}
diff --git a/rtl/inc/dosh.inc b/rtl/inc/dosh.inc
new file mode 100644
index 0000000000..78c266a596
--- /dev/null
+++ b/rtl/inc/dosh.inc
@@ -0,0 +1,159 @@
+{
+ $Id: dosh.inc,v 1.6 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Dos unit for BP7 compatible RTL - Interface declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$IFNDEF HAS_FILENAMELEN}
+Const
+ FileNameLen = 255;
+{$ENDIF HAS_FILENAMELEN}
+
+{$IFDEF CPUI386}
+ {$IFNDEF HAS_REGISTERS}
+type
+ Registers = packed record
+ case i : integer of
+ 0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
+ 1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
+ 2 : (eax, ebx, ecx, edx, ebp, esi, edi : longint);
+ End;
+ {$ENDIF HAS_REGISTERS}
+{$ENDIF CPUI386}
+
+Const
+ {Bitmasks for CPU Flags}
+ fcarry = $0001;
+ fparity = $0004;
+ fauxiliary = $0010;
+ fzero = $0040;
+ fsign = $0080;
+ foverflow = $0800;
+
+ {Bitmasks for file attribute}
+ readonly = $01;
+ hidden = $02;
+ sysfile = $04;
+ volumeid = $08;
+ directory = $10;
+ archive = $20;
+ anyfile = $3F;
+
+ {File Status}
+ fmclosed = $D7B0;
+ fminput = $D7B1;
+ fmoutput = $D7B2;
+ fminout = $D7B3;
+
+
+Type
+{ Needed for LFN Support }
+ ComStr = String[FileNameLen];
+ PathStr = String[FileNameLen];
+ DirStr = String[FileNameLen];
+ NameStr = String[FileNameLen];
+ ExtStr = String[FileNameLen];
+
+{
+ filerec.inc contains the definition of the filerec.
+ textrec.inc contains the definition of the textrec.
+ It is in a separate file to make it available in other units without
+ having to use the DOS unit for it.
+}
+{$i filerec.inc}
+{$i textrec.inc}
+
+ DateTime = packed record
+ Year,
+ Month,
+ Day,
+ Hour,
+ Min,
+ Sec : word;
+ End;
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ DosError : integer;
+
+{$ifdef cpui386}
+{Interrupt}
+Procedure Intr(intno: byte; var regs: registers);
+Procedure MSDos(var regs: registers);
+{$endif cpui386}
+
+{Info/Date/Time}
+Function DosVersion: Word;
+Procedure GetDate(var year, month, mday, wday: word);
+Procedure GetTime(var hour, minute, second, sec100: word);
+procedure SetDate(year,month,day: word);
+Procedure SetTime(hour,minute,second,sec100: word);
+Procedure UnpackTime(p: longint; var t: datetime);
+Procedure PackTime(var t: datetime; var p: longint);
+
+{Exec}
+Procedure Exec(const path: pathstr; const comline: comstr);
+Function DosExitCode: word;
+
+{Disk}
+Function DiskFree(drive: byte) : int64;
+Function DiskSize(drive: byte) : int64;
+Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
+Procedure FindNext(var f: searchRec);
+Procedure FindClose(Var f: SearchRec);
+
+{File}
+Procedure GetFAttr(var f; var attr: word);
+Procedure GetFTime(var f; var time: longint);
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+Function FExpand(const path: pathstr): pathstr;
+Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
+function GetShortName(var p : String) : boolean;
+function GetLongName(var p : String) : boolean;
+
+{Environment}
+Function EnvCount: longint;
+Function EnvStr (Index: longint): string;
+Function GetEnv(envvar: string): string;
+
+{Misc}
+Procedure SetFAttr(var f; attr: word);
+Procedure SetFTime(var f; time: longint);
+Procedure GetCBreak(var breakvalue: boolean);
+Procedure SetCBreak(breakvalue: boolean);
+Procedure GetVerify(var verify: boolean);
+Procedure SetVerify(verify: boolean);
+
+{Do Nothing Functions}
+Procedure SwapVectors;
+Procedure GetIntVec(intno: byte; var vector: pointer);
+Procedure SetIntVec(intno: byte; vector: pointer);
+Procedure Keep(exitcode: word);
+
+{Additional (non-TP) function for quick access to system timer - for FV etc.}
+Function GetMsCount: int64;
+{Offset between two return values corresponds to amount of milliseconds
+ between the two calls, however the exact value is not guaranteed to have
+ particular meaning - it can be e.g. amount of milliseconds since computer
+ startup on DOS-like x86 platforms, derived from Unix time on Unix etc.}
+
+
+{
+ $Log: dosh.inc,v $
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc
new file mode 100644
index 0000000000..1968c0f7f0
--- /dev/null
+++ b/rtl/inc/dynarr.inc
@@ -0,0 +1,391 @@
+{
+ $Id: dynarr.inc,v 1.38 2005/03/27 14:56:34 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Florian Klaempfl
+ member of the Free Pascal development team.
+
+ This file implements the helper routines for dyn. Arrays in FPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+type
+ { don't add new fields, the size is used }
+ { to calculate memory requirements }
+ pdynarray = ^tdynarray;
+ tdynarray = packed record
+ refcount : longint;
+ high : tdynarrayindex;
+ end;
+
+ pdynarraytypeinfo = ^tdynarraytypeinfo;
+ tdynarraytypeinfo = packed record
+ kind : byte;
+ namelen : byte;
+ { here the chars follow, we've to skip them }
+ elesize : sizeint;
+ eletype : pdynarraytypeinfo;
+ end;
+
+function aligntoptr(p : pointer) : pointer;
+ begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ if (ptrint(p) mod sizeof(ptrint))<>0 then
+ inc(ptrint(p),sizeof(ptrint)-ptrint(p) mod sizeof(ptrint));
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ result:=p;
+ end;
+
+
+procedure fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex);[Public,Alias:'FPC_DYNARRAY_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if not(assigned(p)) or (i<0) or (i>pdynarray(p-sizeof(tdynarray))^.high) then
+ HandleErrorFrame(201,get_frame);
+ end;
+
+
+function fpc_dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if assigned(p) then
+ fpc_dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1
+ else
+ fpc_dynarray_length:=0;
+ end;
+
+
+function fpc_dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if assigned(p) then
+ fpc_dynarray_high:=pdynarray(p-sizeof(tdynarray))^.high
+ else
+ fpc_dynarray_high:=-1;
+ end;
+
+
+{ releases and finalizes the data of a dyn. array and sets p to nil }
+procedure fpc_dynarray_clear_internal(p : pointer;ti : pointer);
+ var
+ elesize : sizeint;
+ eletype : pdynarraytypeinfo;
+ begin
+ if p=nil then
+ exit;
+
+ { skip kind and name }
+ inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
+
+{$ifdef FPC_ALIGNSRTTI}
+ ti:=aligntoptr(ti);
+{$endif FPC_ALIGNSRTTI}
+
+ elesize:=psizeint(ti)^;
+ eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
+
+ { finalize all data }
+ int_finalizearray(p+sizeof(tdynarray),eletype,pdynarray(p)^.high+1,
+ elesize);
+
+ { release the data }
+ freemem(p);
+ end;
+
+
+procedure fpc_dynarray_clear(var p : pointer;ti : pointer); [Public,Alias:'FPC_DYNARRAY_CLEAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ realp : pdynarray;
+ begin
+ if (P=Nil) then
+ exit;
+ realp:=pdynarray(p-sizeof(tdynarray));
+ if declocked(realp^.refcount) then
+ fpc_dynarray_clear_internal(p-sizeof(tdynarray),ti);
+ p:=nil;
+ end;
+
+{$ifdef hascompilerproc}
+{ alias for internal use }
+Procedure fpc_dynarray_clear (var p : pointer;ti : pointer);[external name 'FPC_DYNARRAY_CLEAR'];
+{$endif hascompilerproc}
+
+
+procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_DYNARRAY_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ realp : pdynarray;
+ begin
+ if p=nil then
+ exit;
+
+ realp:=pdynarray(p-sizeof(tdynarray));
+ if realp^.refcount=0 then
+ HandleErrorFrame(204,get_frame);
+
+ { decr. ref. count }
+ { should we remove the array? }
+ if declocked(realp^.refcount) then
+ fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(ti));
+ p := nil;
+ end;
+
+{$ifdef hascompilerproc}
+{ provide local access to dynarr_decr_ref for dynarr_setlength }
+procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_DYNARRAY_DECR_REF'];
+{$endif}
+
+procedure fpc_dynarray_incr_ref(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_DYNARRAY_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ realp : pdynarray;
+ begin
+ if p=nil then
+ exit;
+
+ realp:=pdynarray(p-sizeof(tdynarray));
+ if realp^.refcount=0 then
+ HandleErrorFrame(204,get_frame);
+
+ inclocked(realp^.refcount);
+ end;
+
+{$ifdef hascompilerproc}
+{ provide local access to dynarr_decr_ref for dynarr_setlength }
+procedure fpc_dynarray_incr_ref(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_DYNARRAY_INCR_REF'];
+{$endif}
+
+{ provide local access to dynarr_setlength }
+procedure int_dynarray_setlength(var p : pointer;pti : pointer;
+ dimcount : dword;dims : pdynarrayindex);[external name 'FPC_DYNARR_SETLENGTH'];
+
+procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
+ dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ i : tdynarrayindex;
+ movelen,
+ size : sizeint;
+ { contains the "fixed" pointers where the refcount }
+ { and high are at positive offsets }
+ realp,newp : pdynarray;
+ ti : pdynarraytypeinfo;
+ updatep: boolean;
+ elesize : sizeint;
+ eletype : pdynarraytypeinfo;
+
+ begin
+ ti:=pdynarraytypeinfo(pti);
+
+ { skip kind and name }
+ inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
+
+{$ifdef FPC_ALIGNSRTTI}
+ ti:=aligntoptr(ti);
+{$endif FPC_ALIGNSRTTI}
+
+ elesize:=psizeint(ti)^;
+ eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
+
+ { determine new memory size }
+ { dims[dimcount-1] because the dimensions are in reverse order! (JM) }
+ size:=elesize*dims[dimcount-1]+sizeof(tdynarray);
+ updatep := false;
+
+ { not assigned yet? }
+ if not(assigned(p)) then
+ begin
+ { do we have to allocate memory? }
+ if dims[dimcount-1] = 0 then
+ exit;
+ getmem(newp,size);
+ fillchar(newp^,size,0);
+ updatep := true;
+ end
+ else
+ begin
+ realp:=pdynarray(p-sizeof(tdynarray));
+ newp := realp;
+
+ { if the new dimension is 0, we've to release all data }
+ if dims[dimcount-1]<=0 then
+ begin
+ if dims[dimcount-1]<0 then
+ HandleErrorFrame(201,get_frame);
+ if declocked(realp^.refcount) then
+ fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(pti));
+ p:=nil;
+ exit;
+ end;
+
+ if realp^.refcount<>1 then
+ begin
+ updatep := true;
+ { make an unique copy }
+ getmem(newp,size);
+ fillchar(newp^,size,0);
+ if realp^.high < dims[dimcount-1] then
+ movelen := realp^.high+1
+ else
+ movelen := dims[dimcount-1];
+ move(p^,(pointer(newp)+sizeof(tdynarray))^,elesize*movelen);
+
+ { increment ref. count of members }
+ for i:= 0 to movelen-1 do
+ int_addref(pointer(newp)+sizeof(tdynarray)+elesize*i,eletype);
+
+ { a declock(ref. count) isn't enough here }
+ { it could be that the in MT enviroments }
+ { in the mean time the refcount was }
+ { decremented }
+
+ { it is, because it doesn't really matter }
+ { if the array is now removed }
+ { fpc_dynarray_decr_ref(p,ti); }
+ if declocked(realp^.refcount) then
+ fpc_dynarray_clear_internal(realp,pdynarraytypeinfo(ti));
+ end
+ else if dims[dimcount-1]<>realp^.high+1 then
+ begin
+ { range checking is quite difficult ... }
+ { if size overflows then it is less than }
+ { the values it was calculated from }
+ if (size<sizeof(tdynarray)) or
+ ((elesize>0) and (size<elesize)) then
+ HandleErrorFrame(201,get_frame);
+
+ { resize? }
+ { here, realp^.refcount has to be one, otherwise the previous }
+ { if-statement would have been taken. Or is this also for MT }
+ { code? (JM) }
+ if realp^.refcount=1 then
+ begin
+ { shrink the array? }
+ if dims[dimcount-1]<realp^.high+1 then
+ begin
+ int_finalizearray(pointer(realp)+sizeof(tdynarray)+
+ elesize*dims[dimcount-1],
+ eletype,realp^.high-dims[dimcount-1]+1,elesize);
+ reallocmem(realp,size);
+ end
+ else if dims[dimcount-1]>realp^.high+1 then
+ begin
+ reallocmem(realp,size);
+ fillchar((pointer(realp)+sizeof(tdynarray)+elesize*(realp^.high+1))^,
+ (dims[dimcount-1]-realp^.high-1)*elesize,0);
+ end;
+ newp := realp;
+ updatep := true;
+ end;
+ end;
+ end;
+ { handle nested arrays }
+ if dimcount>1 then
+ begin
+ for i:=0 to dims[dimcount-1]-1 do
+ int_dynarray_setlength(pointer((pointer(newp)+sizeof(tdynarray)+i*elesize)^),
+ eletype,dimcount-1,dims);
+ end;
+ if updatep then
+ begin
+ p:=pointer(newp)+sizeof(tdynarray);
+ newp^.refcount:=1;
+ newp^.high:=dims[dimcount-1]-1;
+ end;
+ end;
+
+
+{$ifdef HASFUNCTIONCOPYDYNARR}
+{ provide local access to dynarr_copy }
+function int_dynarray_copy(psrc : pointer;ti : pointer;
+ lowidx,count:tdynarrayindex) : pointer;[external name 'FPC_DYNARR_COPY'];
+
+function fpc_dynarray_copy(psrc : pointer;ti : pointer;
+ lowidx,count:tdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARR_COPY'];{$ifdef hascompilerproc} compilerproc; {$endif}
+{$else HASFUNCTIONCOPYDYNARR}
+procedure int_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
+ lowidx,count:tdynarrayindex);[external name 'FPC_DYNARR_COPY'];
+
+procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer;
+ lowidx,count:tdynarrayindex);[Public,Alias:'FPC_DYNARR_COPY'];{$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif HASFUNCTIONCOPYDYNARR}
+ var
+ realpdest,
+ realpsrc : pdynarray;
+ cnt,
+ i,size : longint;
+ highidx : tdynarrayindex;
+ elesize : sizeint;
+ eletype : pdynarraytypeinfo;
+{$ifdef HASFUNCTIONCOPYDYNARR}
+ pdest : pointer;
+{$endif HASFUNCTIONCOPYDYNARR}
+ begin
+ highidx:=lowidx+count-1;
+ pdest:=nil;
+{$ifdef HASFUNCTIONCOPYDYNARR}
+ result:=pdest;
+{$endif HASFUNCTIONCOPYDYNARR}
+ if psrc=nil then
+ exit;
+ realpsrc:=pdynarray(psrc-sizeof(tdynarray));
+ { skip kind and name }
+ inc(pointer(ti),ord(pdynarraytypeinfo(ti)^.namelen)+2);
+
+{$ifdef FPC_ALIGNSRTTI}
+ ti:=aligntoptr(ti);
+{$endif FPC_ALIGNSRTTI}
+
+ elesize:=psizeint(ti)^;
+ eletype:=pdynarraytypeinfo(pointer(pdynarraytypeinfo(pointer(ti)+sizeof(sizeint)))^);
+
+ { -1, -1 (highidx=lowidx-1-1=-3) is used to copy the whole array like a:=copy(b);, so
+ update the lowidx and highidx with the values from psrc }
+ if (lowidx=-1) and (highidx=-3) then
+ begin
+ lowidx:=0;
+ highidx:=realpsrc^.high;
+ end;
+ { get number of elements and check for invalid values }
+ if (lowidx<0) or (highidx<0) or (lowidx > realpsrc^.high) then
+ HandleErrorFrame(201,get_frame);
+ cnt:=highidx-lowidx+1;
+ if (cnt > realpsrc^.high - lowidx + 1) then
+ cnt := realpsrc^.high - lowidx + 1;
+ { create new array }
+ size:=elesize*cnt;
+ getmem(realpdest,size+sizeof(tdynarray));
+ pdest:=pointer(realpdest)+sizeof(tdynarray);
+ { copy data }
+ move(pointer(psrc+elesize*lowidx)^,pdest^,size);
+ { fill new refcount }
+ realpdest^.refcount:=1;
+ realpdest^.high:=cnt-1;
+ { increment ref. count of members }
+ for i:= 0 to cnt-1 do
+ int_addref(pointer(pdest+elesize*i),eletype);
+{$ifdef HASFUNCTIONCOPYDYNARR}
+ result:=pdest;
+{$endif HASFUNCTIONCOPYDYNARR}
+ end;
+
+
+{
+ $Log: dynarr.inc,v $
+ Revision 1.38 2005/03/27 14:56:34 jonas
+ * fixed web bug 3805
+ * extra range check in fpc_dynarray_copy (also error if lowidx >
+ high(source))
+
+ Revision 1.37 2005/03/05 16:37:28 florian
+ * fixed copy(dyn. array,...);
+
+ Revision 1.36 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.35 2005/01/24 21:32:48 florian
+ * fixed copy(dyn. array of ansistring)
+
+}
diff --git a/rtl/inc/dynarrh.inc b/rtl/inc/dynarrh.inc
new file mode 100644
index 0000000000..91e0b2f5af
--- /dev/null
+++ b/rtl/inc/dynarrh.inc
@@ -0,0 +1,28 @@
+{
+ $Id: dynarrh.inc,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains type declarations necessary for the dynamic
+ array routine helpers in syshelp.inc
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+
+**********************************************************************}
+
+type
+ tdynarrayindex = sizeint;
+ pdynarrayindex = ^tdynarrayindex;
+
+{
+ $Log: dynarrh.inc,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/dynlibs.pp b/rtl/inc/dynlibs.pp
new file mode 100644
index 0000000000..b3a6d90e8d
--- /dev/null
+++ b/rtl/inc/dynlibs.pp
@@ -0,0 +1,78 @@
+{
+ $Id: dynlibs.pp,v 1.7 2005/05/04 09:04:58 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Implements OS-independent loading of dynamic libraries.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE OBJFPC}
+
+unit dynlibs;
+
+interface
+
+{ ---------------------------------------------------------------------
+ Read OS-dependent interface declarations.
+ ---------------------------------------------------------------------}
+
+{$define readinterface}
+{$i dynlibs.inc}
+{$undef readinterface}
+
+{ ---------------------------------------------------------------------
+ OS - Independent declarations.
+ ---------------------------------------------------------------------}
+
+
+Function LoadLibrary(Name : AnsiString) : TLibHandle;
+Function GetProcedureAddress(Lib : TlibHandle; ProcName : AnsiString) : Pointer;
+Function UnloadLibrary(Lib : TLibHandle) : Boolean;
+
+// Kylix/Delphi compability
+
+Function FreeLibrary(Lib : TLibHandle) : Boolean;
+Function GetProcAddress(Lib : TlibHandle; ProcName : AnsiString) : Pointer;
+
+Type
+ HModule = TLibHandle;
+
+Implementation
+
+{ ---------------------------------------------------------------------
+ OS - Independent declarations.
+ ---------------------------------------------------------------------}
+
+{$i dynlibs.inc}
+
+Function FreeLibrary(Lib : TLibHandle) : Boolean;
+
+begin
+ Result:=UnloadLibrary(lib);
+end;
+
+Function GetProcAddress(Lib : TlibHandle; ProcName : AnsiString) : Pointer;
+
+begin
+ Result:=GetProcedureAddress(Lib,Procname);
+end;
+
+end.
+
+{
+ $Log: dynlibs.pp,v $
+ Revision 1.7 2005/05/04 09:04:58 michael
+ + Added HModule compatibility
+
+ Revision 1.6 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/except.inc b/rtl/inc/except.inc
new file mode 100644
index 0000000000..897358dedf
--- /dev/null
+++ b/rtl/inc/except.inc
@@ -0,0 +1,366 @@
+{
+ $Id: except.inc,v 1.21 2005/05/08 21:20:26 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ Exception support
+****************************************************************************}
+
+
+Const
+ { Type of exception. Currently only one. }
+ FPC_EXCEPTION = 1;
+
+ { types of frames for the exception address stack }
+ cExceptionFrame = 1;
+ cFinalizeFrame = 2;
+
+Type
+ PExceptAddr = ^TExceptAddr;
+ TExceptAddr = record
+ buf : pjmp_buf;
+ next : PExceptAddr;
+ frametype : Longint;
+ end;
+
+ TExceptObjectClass = Class of TObject;
+
+Const
+ CatchAllExceptions : PtrInt = -1;
+{$ifdef SUPPORT_THREADVAR}
+ThreadVar
+{$else SUPPORT_THREADVAR}
+Var
+{$endif SUPPORT_THREADVAR}
+ ExceptAddrStack : PExceptAddr;
+ ExceptObjectStack : PExceptObject;
+
+{$IFNDEF VIRTUALPASCAL}
+Function RaiseList : PExceptObject;
+
+begin
+ RaiseList:=ExceptObjectStack;
+end;
+{$ENDIF}
+
+function AcquireExceptionObject: Pointer;
+begin
+ If ExceptObjectStack=nil then begin
+ AcquireExceptionObject := nil
+ end else begin
+ Inc(ExceptObjectStack^.refcount);
+ AcquireExceptionObject := ExceptObjectStack^.FObject;
+ end;
+end;
+
+procedure ReleaseExceptionObject;
+begin
+ If ExceptObjectStack <> nil then begin
+ if ExceptObjectStack^.refcount > 0 then begin
+ Dec(ExceptObjectStack^.refcount);
+ end;
+end;
+end;
+
+{$ifndef HAS_ADDR_STACK_ON_STACK}
+Function fpc_PushExceptAddr (Ft: Longint): PJmp_buf ;
+ [Public, Alias : 'FPC_PUSHEXCEPTADDR'];{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}
+{$else HAS_ADDR_STACK_ON_STACK}
+Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ;
+ [Public, Alias : 'FPC_PUSHEXCEPTADDR'];{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}{$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif HAS_ADDR_STACK_ON_STACK}
+
+var
+ Buf : PJmp_buf;
+ NewAddr : PExceptAddr;
+begin
+{$ifdef excdebug}
+ writeln ('In PushExceptAddr');
+{$endif}
+ If ExceptAddrstack=Nil then
+ begin
+{$ifndef HAS_ADDR_STACK_ON_STACK}
+ New(ExceptAddrStack);
+{$else HAS_ADDR_STACK_ON_STACK}
+ ExceptAddrStack:=PExceptAddr(_newaddr);
+{$endif HAS_ADDR_STACK_ON_STACK}
+ ExceptAddrStack^.Next:=Nil;
+ end
+ else
+ begin
+{$ifndef HAS_ADDR_STACK_ON_STACK}
+ New(NewAddr);
+{$else HAS_ADDR_STACK_ON_STACK}
+ NewAddr:=PExceptAddr(_newaddr);
+{$endif HAS_ADDR_STACK_ON_STACK}
+ NewAddr^.Next:=ExceptAddrStack;
+ ExceptAddrStack:=NewAddr;
+ end;
+{$ifndef HAS_ADDR_STACK_ON_STACK}
+ new(buf);
+{$else HAS_ADDR_STACK_ON_STACK}
+ buf:=PJmp_Buf(_buf);
+{$endif HAS_ADDR_STACK_ON_STACK}
+ ExceptAddrStack^.Buf:=Buf;
+ ExceptAddrStack^.FrameType:=ft;
+ fpc_PushExceptAddr:=Buf;
+end;
+
+
+Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer);
+ [Public, Alias : 'FPC_PUSHEXCEPTOBJECT'];{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}{$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ Newobj : PExceptObject;
+ framebufsize,
+ framecount : longint;
+ frames : PPointer;
+ prev_frame,
+ curr_frame,
+ caller_frame,
+ caller_addr : Pointer;
+begin
+{$ifdef excdebug}
+ writeln ('In PushExceptObject');
+{$endif}
+ If ExceptObjectStack=Nil then
+ begin
+ New(ExceptObjectStack);
+ ExceptObjectStack^.Next:=Nil;
+ end
+ else
+ begin
+ New(NewObj);
+ NewObj^.Next:=ExceptObjectStack;
+ ExceptObjectStack:=NewObj;
+ end;
+ ExceptObjectStack^.FObject:=Obj;
+ ExceptObjectStack^.Addr:=AnAddr;
+ ExceptObjectStack^.refcount:=0;
+ { Backtrace }
+ curr_frame:=AFrame;
+ prev_frame:=get_frame;
+ frames:=nil;
+ framebufsize:=0;
+ framecount:=0;
+ while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) Do
+ Begin
+ caller_addr := get_caller_addr(curr_frame);
+ caller_frame := get_caller_frame(curr_frame);
+ if (caller_addr=nil) or
+ (caller_frame=nil) then
+ break;
+ if (framecount>=framebufsize) then
+ begin
+ inc(framebufsize,16);
+ reallocmem(frames,framebufsize*sizeof(pointer));
+ end;
+ frames[framecount]:=caller_addr;
+ inc(framecount);
+ prev_frame:=curr_frame;
+ curr_frame:=caller_frame;
+ End;
+ ExceptObjectStack^.framecount:=framecount;
+ ExceptObjectStack^.frames:=frames;
+end;
+
+{$ifdef hascompilerproc}
+{ make it avalable for local use }
+Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); [external name 'FPC_PUSHEXCEPTOBJECT'];
+{$endif}
+
+
+Procedure DoUnHandledException;
+begin
+ If (ExceptProc<>Nil) and (ExceptObjectStack<>Nil) then
+ with ExceptObjectStack^ do
+ TExceptProc(ExceptProc)(FObject,Addr,FrameCount,Frames);
+ RunError(217);
+end;
+
+
+Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+{$ifdef excdebug}
+ writeln ('In RaiseException');
+{$endif}
+ fpc_Raiseexception:=nil;
+ fpc_PushExceptObj(Obj,AnAddr,AFrame);
+ If ExceptAddrStack=Nil then
+ DoUnhandledException;
+ if (RaiseProc <> nil) and (ExceptObjectStack <> nil) then
+ with ExceptObjectStack^ do
+ RaiseProc(FObject,Addr,FrameCount,Frames);
+ longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
+end;
+
+
+Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$ifndef HAS_ADDR_STACK_ON_STACK}
+var
+ hp : PExceptAddr;
+{$endif HAS_ADDR_STACK_ON_STACK}
+begin
+{$ifdef excdebug}
+ writeln ('In Popaddrstack');
+{$endif}
+ If ExceptAddrStack=nil then
+ begin
+ writeln ('At end of ExceptionAddresStack');
+ halt (255);
+ end
+ else
+ begin
+{$ifndef HAS_ADDR_STACK_ON_STACK}
+ hp:=ExceptAddrStack;
+ ExceptAddrStack:=ExceptAddrStack^.Next;
+ dispose(hp^.buf);
+ dispose(hp);
+{$else HAS_ADDR_STACK_ON_STACK}
+ ExceptAddrStack:=ExceptAddrStack^.Next;
+{$endif HAS_ADDR_STACK_ON_STACK}
+ end;
+end;
+
+
+function fpc_PopObjectStack : TObject;[Public, Alias : 'FPC_POPOBJECTSTACK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ hp : PExceptObject;
+begin
+{$ifdef excdebug}
+ writeln ('In PopObjectstack');
+{$endif}
+ If ExceptObjectStack=nil then
+ begin
+ writeln ('At end of ExceptionObjectStack');
+ halt (1);
+ end
+ else
+ begin
+ { we need to return the exception object to dispose it }
+ if ExceptObjectStack^.refcount = 0 then begin
+ fpc_PopObjectStack:=ExceptObjectStack^.FObject;
+ end else begin
+ fpc_PopObjectStack:=nil;
+ end;
+ hp:=ExceptObjectStack;
+ ExceptObjectStack:=ExceptObjectStack^.next;
+ if assigned(hp^.frames) then
+ freemem(hp^.frames);
+ dispose(hp);
+ end;
+end;
+
+{ this is for popping exception objects when a second exception is risen }
+{ in an except/on }
+function fpc_PopSecondObjectStack : TObject;[Public, Alias : 'FPC_POPSECONDOBJECTSTACK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ hp : PExceptObject;
+begin
+{$ifdef excdebug}
+ writeln ('In PopObjectstack');
+{$endif}
+ If not(assigned(ExceptObjectStack)) or
+ not(assigned(ExceptObjectStack^.next)) then
+ begin
+ writeln ('At end of ExceptionObjectStack');
+ halt (1);
+ end
+ else
+ begin
+ if ExceptObjectStack^.next^.refcount=0 then
+ { we need to return the exception object to dispose it if refcount=0 }
+ fpc_PopSecondObjectStack:=ExceptObjectStack^.next^.FObject
+ else
+ fpc_PopSecondObjectStack:=nil;
+ hp:=ExceptObjectStack^.next;
+ ExceptObjectStack^.next:=hp^.next;
+ if assigned(hp^.frames) then
+ freemem(hp^.frames);
+ dispose(hp);
+ end;
+end;
+
+Procedure fpc_ReRaise;[Public, Alias : 'FPC_RERAISE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+{$ifdef excdebug}
+ writeln ('In reraise');
+{$endif}
+ If ExceptAddrStack=Nil then
+ DoUnHandledException;
+ ExceptObjectStack^.refcount := 0;
+ longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
+end;
+
+
+Function fpc_Catches(Objtype : TClass) : TObject;[Public, Alias : 'FPC_CATCHES']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ _Objtype : TExceptObjectClass;
+begin
+ If ExceptObjectStack=Nil then
+ begin
+ Writeln ('Internal error.');
+ halt (255);
+ end;
+ _Objtype := TExceptObjectClass(Objtype);
+ if Not ((_Objtype = TExceptObjectClass(CatchAllExceptions)) or
+ (ExceptObjectStack^.FObject is _ObjType)) then
+ fpc_Catches:=Nil
+ else
+ begin
+ // catch !
+ fpc_Catches:=ExceptObjectStack^.FObject;
+ { this can't be done, because there could be a reraise (PFV)
+ PopObjectStack;
+
+ Also the PopAddrStack shouldn't be done, we do it now
+ immediatly in the exception handler (FK)
+ PopAddrStack; }
+ end;
+end;
+
+Procedure fpc_DestroyException(o : TObject);[Public, Alias : 'FPC_DESTROYEXCEPTION']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ { with free we're on the really save side }
+ o.Free;
+end;
+
+
+Procedure SysInitExceptions;
+{
+ Initialize exceptionsupport
+}
+begin
+ ExceptObjectstack:=Nil;
+ ExceptAddrStack:=Nil;
+end;
+{
+ $Log: except.inc,v $
+ Revision 1.21 2005/05/08 21:20:26 michael
+ + Patch to return nil if there is no exception object (as in Delphi)
+
+ Revision 1.20 2005/04/03 11:32:05 florian
+ * ref. counting for popping second exceptiono object fixed
+
+ Revision 1.19 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.18 2005/01/29 17:01:18 peter
+ * fix crash with backtrace if invalid frame is passed
+
+ Revision 1.17 2005/01/26 17:07:10 peter
+ * retrieve backtrace when exception is raised
+ * RaiseMaxFrameCount added to limit the number of backtraces, setting
+ it to 0 disables backtraces. Default is 16
+
+}
diff --git a/rtl/inc/fexpand.inc b/rtl/inc/fexpand.inc
new file mode 100644
index 0000000000..e0159b72a2
--- /dev/null
+++ b/rtl/inc/fexpand.inc
@@ -0,0 +1,584 @@
+{
+ $Id: fexpand.inc,v 1.18 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1997-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ A platform independent FExpand implementation
+****************************************************************************}
+
+{$IFDEF FPC_FEXPAND_VOLUMES}
+ {$IFNDEF FPC_FEXPAND_DRIVES}
+ (* Volumes are just a special case of drives. *)
+ {$DEFINE FPC_FEXPAND_DRIVES}
+ {$ENDIF FPC_FEXPAND_DRIVES}
+{$ENDIF FPC_FEXPAND_VOLUMES}
+
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ {$IFNDEF FPC_FEXPAND_DRIVES}
+ (* If DirectorySeparator at the beginning marks a relative path, *)
+ (* an absolute path must always begin with a drive or volume. *)
+ {$DEFINE FPC_FEXPAND_DRIVES}
+ {$ENDIF FPC_FEXPAND_DRIVES}
+ {$IFNDEF FPC_FEXPAND_MULTIPLE_UPDIR}
+ (* Traversing multiple levels at once explicitely allowed. *)
+ {$DEFINE FPC_FEXPAND_MULTIPLE_UPDIR}
+ {$ENDIF FPC_FEXPAND_MULTIPLE_UPDIR}
+ (* Helper define used to support common features of FPC_FEXPAND_DIRSEP_IS_* *)
+ {$DEFINE FPC_FEXPAND_UPDIR_HELPER}
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ {$IFNDEF FPC_FEXPAND_DRIVES}
+ (* If DirectorySeparator at the beginning marks a relative path, *)
+ (* an absolute path must always begin with a drive or volume. *)
+ {$DEFINE FPC_FEXPAND_DRIVES}
+ {$ENDIF FPC_FEXPAND_DRIVES}
+ {$IFNDEF FPC_FEXPAND_MULTIPLE_UPDIR}
+ (* Traversing multiple levels at once explicitely allowed. *)
+ {$DEFINE FPC_FEXPAND_MULTIPLE_UPDIR}
+ {$ENDIF FPC_FEXPAND_MULTIPLE_UPDIR}
+ (* Helper define used to support common features of FPC_FEXPAND_DIRSEP_IS_* *)
+ {$DEFINE FPC_FEXPAND_UPDIR_HELPER}
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+
+procedure GetDirIO (DriveNr: byte; var Dir: OpenString);
+
+(* GetDirIO is supposed to return the root of the given drive *)
+(* in case of an error for compatibility of FExpand with TP/BP. *)
+
+var
+ OldInOutRes: word;
+begin
+ OldInOutRes := InOutRes;
+ InOutRes := 0;
+ GetDir (DriveNr, Dir);
+ InOutRes := OldInOutRes;
+end;
+
+
+{$IFDEF FPC_FEXPAND_VOLUMES}
+ {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+procedure GetDirIO (const VolumeName: OpenString; var Dir: OpenString);
+
+var
+ OldInOutRes: word;
+begin
+ OldInOutRes := InOutRes;
+ InOutRes := 0;
+ GetDir (VolumeName, Dir);
+ InOutRes := OldInOutRes;
+end;
+ {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$ENDIF FPC_FEXPAND_VOLUMES}
+
+
+function FExpand (const Path: PathStr): PathStr;
+
+(* LFNSupport boolean constant, variable or function must be declared for all
+ the platforms, at least locally in the Dos unit implementation part.
+ In addition, FPC_FEXPAND_UNC, FPC_FEXPAND_DRIVES, FPC_FEXPAND_GETENV_PCHAR,
+ FPC_FEXPAND_TILDE, FPC_FEXPAND_VOLUMES, FPC_FEXPAND_NO_DEFAULT_PATHS,
+ FPC_FEXPAND_DRIVESEP_IS_ROOT, FPC_FEXPAND_NO_CURDIR,
+ FPC_FEXPAND_NO_DOTS_UPDIR, FPC_FEXPAND_DIRSEP_IS_UPDIR,
+ FPC_FEXPAND_DIRSEP_IS_CURDIR and FPC_FEXPAND_MULTIPLE_UPDIR conditionals
+ might be defined to specify FExpand behaviour - see end of this file for
+ individual descriptions.
+*)
+
+{$IFDEF FPC_FEXPAND_DRIVES}
+var
+ PathStart: longint;
+{$ELSE FPC_FEXPAND_DRIVES}
+const
+ PathStart = 1;
+{$ENDIF FPC_FEXPAND_DRIVES}
+{$IFDEF FPC_FEXPAND_UNC}
+var
+ RootNotNeeded: boolean;
+{$ELSE FPC_FEXPAND_UNC}
+const
+ RootNotNeeded = false;
+{$ENDIF FPC_FEXPAND_UNC}
+
+var S, Pa, Dirs: PathStr;
+ I, J: longint;
+
+begin
+{$IFDEF FPC_FEXPAND_UNC}
+ RootNotNeeded := false;
+{$ENDIF FPC_FEXPAND_UNC}
+
+(* First convert the path to uppercase if appropriate for current platform. *)
+ if FileNameCaseSensitive then
+ Pa := Path
+ else
+ Pa := UpCase (Path);
+
+(* Allow both '/' and '\' as directory separators *)
+(* by converting all to the native one. *)
+ if DirectorySeparator = '\' then
+ {Allow slash as backslash}
+ begin
+ for I := 1 to Length (Pa) do
+ if Pa [I] = '/' then
+ Pa [I] := DirectorySeparator
+ end
+ else
+ if DirectorySeparator = '\' then
+ {Allow backslash as slash}
+ begin
+ for I := 1 to Length (Pa) do
+ if Pa [I] = '\' then
+ Pa [I] := DirectorySeparator;
+ end;
+
+(* PathStart is amount of characters to strip to get beginning *)
+(* of path without volume/drive specification. *)
+{$IFDEF FPC_FEXPAND_DRIVES}
+ {$IFDEF FPC_FEXPAND_VOLUMES}
+ {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ PathStart := Pos (DriveSeparator, Pa);
+ {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ PathStart := Succ (Pos (DriveSeparator, Pa));
+ {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ {$ELSE FPC_FEXPAND_VOLUMES}
+ PathStart := 3;
+ {$ENDIF FPC_FEXPAND_VOLUMES}
+{$ENDIF FPC_FEXPAND_DRIVES}
+
+(* Expand tilde to home directory if appropriate. *)
+{$IFDEF FPC_FEXPAND_TILDE}
+ {Replace ~/ with $HOME/}
+ if (Length (Pa) >= 1) and (Pa [1] = '~') and
+ ((Pa [2] = DirectorySeparator) or (Length (Pa) = 1)) then
+ begin
+ {$IFDEF FPC_FEXPAND_GETENV_PCHAR}
+ S := StrPas (GetEnv ('HOME'));
+ {$ELSE FPC_FEXPAND_GETENV_PCHAR}
+ S := GetEnv ('HOME');
+ {$ENDIF FPC_FEXPAND_GETENV_PCHAR}
+ if (S = '') or (Length (S) = 1)
+ and (S [1] = DirectorySeparator) then
+ Delete (Pa, 1, 1)
+ else
+ if S [Length (S)] = DirectorySeparator then
+ Pa := S + Copy (Pa, 3, Length (Pa) - 2)
+ else
+ Pa := S + Copy (Pa, 2, Pred (Length (Pa)));
+ end;
+{$ENDIF FPC_FEXPAND_TILDE}
+
+(* Do we have a drive/volume specification? *)
+{$IFDEF FPC_FEXPAND_VOLUMES}
+ if PathStart > 1 then
+{$ELSE FPC_FEXPAND_VOLUMES}
+ if (Length (Pa) > 1) and (Pa [1] in ['A'..'Z', 'a'..'z']) and
+ (Pa [2] = DriveSeparator) then
+{$ENDIF FPC_FEXPAND_VOLUMES}
+ begin
+
+(* We need to know current directory on given *)
+(* volume/drive _if_ such a thing is defined. *)
+{$IFDEF FPC_FEXPAND_DRIVES}
+ {$IFNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+ {$IFDEF FPC_FEXPAND_VOLUMES}
+ GetDirIO (Copy (Pa, 1, PathStart - 2), S);
+ {$ELSE FPC_FEXPAND_VOLUMES}
+ { Always uppercase driveletter }
+ if (Pa [1] in ['a'..'z']) then
+ Pa [1] := Chr (Ord (Pa [1]) and not ($20));
+ GetDirIO (Ord (Pa [1]) - Ord ('A') + 1, S);
+ {$ENDIF FPC_FEXPAND_VOLUMES}
+
+(* Do we have more than just drive/volume specification? *)
+ if Length (Pa) = Pred (PathStart) then
+
+(* If not, just use the current directory for that drive/volume. *)
+ Pa := S
+ else
+
+(* If yes, find out whether the following path is relative or absolute. *)
+ if Pa [PathStart] <> DirectorySeparator then
+ {$IFDEF FPC_FEXPAND_VOLUMES}
+ if Copy (Pa, 1, PathStart - 2) = Copy (S, 1, PathStart - 2)
+ then
+ {$ELSE FPC_FEXPAND_VOLUMES}
+ if Pa [1] = S [1] then
+ {$ENDIF FPC_FEXPAND_VOLUMES}
+ begin
+ { remove ending slash if it already exists }
+ if S [Length (S)] = DirectorySeparator then
+ Dec (S [0]);
+ Pa := S + DirectorySeparator +
+ Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
+ end
+ else
+ {$IFDEF FPC_FEXPAND_VOLUMES}
+ Pa := Copy (Pa, 1, PathStart - 2) + DriveSeparator
+ + DirectorySeparator +
+ Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
+ {$ELSE FPC_FEXPAND_VOLUMES}
+ Pa := Pa [1] + DriveSeparator + DirectorySeparator +
+ Copy (Pa, PathStart, Length (Pa) - PathStart + 1)
+ {$ENDIF FPC_FEXPAND_VOLUMES}
+ {$ENDIF FPC_FEXPAND_NO_DEFAULT_PATHS}
+ end
+ else
+{$ELSE FPC_FEXPAND_DRIVES}
+
+(* If drives are not supported, but a drive *)
+(* was supplied anyway, ignore (remove) it. *)
+ Delete (Pa, 1, 2);
+ end;
+ {Check whether we don't have an absolute path already}
+ if (Length (Pa) >= PathStart) and (Pa [PathStart] <> DirectorySeparator) or
+ (Length (Pa) < PathStart) then
+{$ENDIF FPC_FEXPAND_DRIVES}
+ begin
+
+(* Get current directory on selected drive/volume. *)
+ GetDirIO (0, S);
+{$IFDEF FPC_FEXPAND_VOLUMES}
+ {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ PathStart := Pos (DriveSeparator, S);
+ {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ PathStart := Succ (Pos (DriveSeparator, S));
+ {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$ENDIF FPC_FEXPAND_VOLUMES}
+
+(* Do we have an absolute path without drive or volume? *)
+{$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ {$IFDEF FPC_FEXPAND_DRIVES}
+ if (Length (Pa) > 0)
+ {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ and (Pa [1] = DriveSeparator)
+ {$ELSE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ and (Pa [1] = DirectorySeparator)
+ {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ then
+ begin
+ {$IFDEF FPC_FEXPAND_UNC}
+ {Do not touch network drive names}
+ if (Length (Pa) > 1) and (Pa [2] = DirectorySeparator)
+ and LFNSupport then
+ begin
+ PathStart := 3;
+ {Find the start of the string of directories}
+ while (PathStart <= Length (Pa)) and
+ (Pa [PathStart] <> DirectorySeparator) do
+ Inc (PathStart);
+ if PathStart > Length (Pa) then
+ {We have just a machine name...}
+ if Length (Pa) = 2 then
+ {...or not even that one}
+ PathStart := 2
+ else
+ Pa := Pa + DirectorySeparator else
+ if PathStart < Length (Pa) then
+ {We have a resource name as well}
+ begin
+ RootNotNeeded := true;
+ {Let's continue in searching}
+ repeat
+ Inc (PathStart);
+ until (PathStart > Length (Pa)) or
+ (Pa [PathStart] = DirectorySeparator);
+ end;
+ end
+ else
+ {$ENDIF FPC_FEXPAND_UNC}
+ {$IFDEF FPC_FEXPAND_VOLUMES}
+ begin
+ I := Pos (DriveSeparator, S);
+ {$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ {$IFDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ if (Pa [1] = DriveSeparator) then
+ Delete (Pa, 1, 1);
+ {$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ Pa := Copy (S, 1, I) + Pa;
+ PathStart := I;
+ {$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ Pa := Copy (S, 1, Pred (I)) + DriveSeparator + Pa;
+ PathStart := Succ (I);
+ {$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ end;
+ {$ELSE FPC_FEXPAND_VOLUMES}
+ Pa := S [1] + DriveSeparator + Pa;
+ {$ENDIF FPC_FEXPAND_VOLUMES}
+ end
+ else
+ {$ENDIF FPC_FEXPAND_DRIVES}
+
+ (* We already have a slash if root is the curent directory. *)
+ if Length (S) = PathStart then
+ Pa := S + Pa
+{$ELSE FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ (* More complex with DirectorySeparator as current directory *)
+ if (S [Length (S)] = DriveSeparator)
+ and (Pa [1] = DirectorySeparator) then
+ Pa := S + Copy (Pa, 2, Pred (Length (Pa)))
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ else
+
+ (* We need an ending slash if FExpand was called *)
+ (* with an empty string for compatibility, except *)
+ (* for platforms where this is invalid. *)
+ if Length (Pa) = 0 then
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ Pa := S
+{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ Pa := S + DirectorySeparator
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ else
+{$IFDEF FPC_FEXPAND_UPDIR_HELPER}
+ if Pa [1] = DirectorySeparator then
+ Pa := S + Pa
+ else
+{$ENDIF FPC_FEXPAND_UPDIR_HELPER}
+ Pa := S + DirectorySeparator + Pa;
+ end;
+
+ {Get string of directories to only process relative references on this one}
+ Dirs := Copy (Pa, Succ (PathStart), Length (Pa) - PathStart);
+
+{$IFNDEF FPC_FEXPAND_NO_CURDIR}
+ {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ {First remove all references to '\.\'}
+ I := Pos (DirectorySeparator + '.' + DirectorySeparator, Dirs);
+ while I <> 0 do
+ begin
+ Delete (Dirs, I, 2);
+ I := Pos (DirectorySeparator + '.' + DirectorySeparator, Dirs);
+ end;
+ {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+{$ENDIF FPC_FEXPAND_NO_CURDIR}
+
+{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
+ {$IFDEF FPC_FEXPAND_MULTIPLE_UPDIR}
+ {Now replace all references to '\...' with '\..\..'}
+ I := Pos (DirectorySeparator + '...', Dirs);
+ while I <> 0 do
+ begin
+ Insert (DirectorySeparator + '.', Dirs, I + 3);
+ I := Pos (DirectorySeparator + '...', Dirs);
+ end;
+ {$ENDIF FPC_FEXPAND_MULTIPLE_UPDIR}
+
+ {Now remove also all references to '\..\' + of course previous dirs..}
+ I := Pos (DirectorySeparator + '..' + DirectorySeparator, Dirs);
+ while I <> 0 do
+ begin
+ J := Pred (I);
+ while (J > 0) and (Dirs [J] <> DirectorySeparator) do
+ Dec (J);
+ Delete (Dirs, Succ (J), I - J + 3);
+ I := Pos (DirectorySeparator + '..' + DirectorySeparator, Dirs);
+ end;
+{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
+
+{$IFDEF FPC_FEXPAND_UPDIR_HELPER}
+ (* Now remove all references to '//' plus previous directories... *)
+ I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
+ while I <> 0 do
+ begin
+ J := Pred (I);
+ while (J > 0) and (Dirs [J] <> DirectorySeparator) do
+ Dec (J);
+ Delete (Dirs, Succ (J), Succ (I - J));
+ I := Pos (DirectorySeparator + DirectorySeparator, Dirs);
+ end;
+{$ENDIF FPC_FEXPAND_UPDIR_HELPER}
+
+{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
+ {Then remove also a reference to '\..' at the end of line
+ + the previous directory, of course,...}
+ I := Pos (DirectorySeparator + '..', Dirs);
+ if (I <> 0) and (I = Length (Dirs) - 2) then
+ begin
+ J := Pred (I);
+ while (J > 0) and (Dirs [J] <> DirectorySeparator) do
+ Dec (J);
+ if (J = 0) then
+ Dirs := ''
+ else
+ Delete (Dirs, Succ (J), I - J + 2);
+ end;
+{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
+
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ (* Remove a possible reference to '/' at the *)
+ (* end of line plus the previous directory. *)
+ I := Length (Dirs);
+ if (I > 0) and (Dirs [I] = DirectorySeparator) then
+ begin
+ J := Pred (I);
+ while (J > 0) and (Dirs [J] <> DirectorySeparator) do
+ Dec (J);
+ if (J = 0) then
+ Dirs := ''
+ else
+ Delete (Dirs, J, Succ (I - J));
+ end;
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+
+{$IFNDEF FPC_FEXPAND_NO_CURDIR}
+ {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ {...and also a possible reference to '\.'}
+ if (Length (Dirs) = 1) then
+ begin
+ if (Dirs [1] = '.') then
+ {A special case}
+ Dirs := ''
+ end
+ else
+ if (Length (Dirs) <> 0) and (Dirs [Length (Dirs)] = '.') and
+ (Dirs [Pred (Length (Dirs))] = DirectorySeparator) then
+ Dec (Dirs [0], 2);
+
+ {Finally remove '.\' at the beginning of the string of directories...}
+ while (Length (Dirs) >= 2) and (Dirs [1] = '.')
+ and (Dirs [2] = DirectorySeparator) do
+ Delete (Dirs, 1, 2);
+ {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+{$ENDIF FPC_FEXPAND_NO_CURDIR}
+
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ (* Remove possible (invalid) references to '/' at the beginning. *)
+ while (Length (Dirs) >= 1) and (Dirs [1] = '/') do
+ Delete (Dirs, 1, 1);
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+
+{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
+ {...and possible (invalid) references to '..\' as well}
+ while (Length (Dirs) >= 3) and (Dirs [1] = '.') and (Dirs [2] = '.') and
+ (Dirs [3] = DirectorySeparator) do
+ Delete (Dirs, 1, 3);
+{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
+
+ {Two special cases - '.' and '..' alone}
+{$IFNDEF FPC_FEXPAND_NO_CURDIR}
+ {$IFNDEF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ if (Length (Dirs) = 1) and (Dirs [1] = '.') then
+ Dirs := '';
+ {$ENDIF FPC_FEXPAND_DIRSEP_IS_CURDIR}
+{$ENDIF FPC_FEXPAND_NO_CURDIR}
+{$IFNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
+ if (Length (Dirs) = 2) and (Dirs [1] = '.') and (Dirs [2] = '.') then
+ Dirs := '';
+{$ENDIF FPC_FEXPAND_NO_DOTS_UPDIR}
+
+ {Join the parts back to create the complete path}
+ if Length (Dirs) = 0 then
+ begin
+ Pa := Copy (Pa, 1, PathStart);
+{$IFNDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ if Pa [PathStart] <> DirectorySeparator then
+ Pa := Pa + DirectorySeparator;
+{$ENDIF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ end
+ else
+ Pa := Copy (Pa, 1, PathStart) + Dirs;
+
+{$IFNDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ {Remove ending \ if not supplied originally, the original string
+ wasn't empty (to stay compatible) and if not really needed}
+ if (Pa [Length (Pa)] = DirectorySeparator)
+ and ((Length (Pa) > PathStart) or
+{A special case with UNC paths}
+ (RootNotNeeded and (Length (Pa) = PathStart)))
+ {Reference to current directory at the end should be removed}
+ and (Length (Path) <> 0)
+ and (Path [Length (Path)] <> DirectorySeparator)
+ then
+ Dec (Pa [0]);
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+
+ FExpand := Pa;
+end;
+
+(* Description of individual conditional defines supported for FExpand
+ (disregard the used directory separators in examples, constant
+ System.DirectorySeparator is used in the real implemenation, of course):
+
+ FPC_FEXPAND_UNC - UNC ("Universal Naming Convention") paths are
+ supported (usually used for networking, used in DOS (with
+ networking support installed), OS/2, Win32 and at least some
+ Netware versions as far as I remember. An example of such a path
+ is '\\servername\sharename\some\path'.
+
+ FPC_FEXPAND_DRIVES - drive letters are supported (DOS-like
+ environments - DOS, OS/2, Win32). Example is 'C:\TEST'.
+
+ FPC_FEXPAND_GETENV_PCHAR - an implementation of GetEnv returning
+ PChar instead of a shortstring is available (Unix) to support
+ long values of environment variables.
+
+ FPC_FEXPAND_TILDE - expansion of '~/' to GetEnv('HOME') - Unix.
+ Example: '~/some/path'.
+
+ FPC_FEXPAND_VOLUMES - volumes are supported (similar to drives,
+ but the name can be longer; used under Netware, Amiga and
+ probably MacOS as far as I understand it correctly). Example:
+ 'VolumeName:Some:Path' or 'ServerName/Volume:Some\Path'
+ (Netware).
+
+ FPC_FEXPAND_NO_DEFAULT_PATHS - Dos keeps information about the
+ current directory for every drive. If some platform supports
+ drives or volumes, but keeps no track of current directories for
+ them (i.e. there's no support for "GetDir(DriveNumber, Dir)" or
+ "GetDir(Volume, Dir)", but only for "GetDir (0, Dir)" (i.e. the
+ overall current directory), you should define this. Otherwise
+ constructs like 'C:Some\Path' refer a path relative to the
+ current directory on the C: drive.
+
+ FPC_FEXPAND_DRIVESEP_IS_ROOT - this means that DriveSeparator
+ should be used as beginning of the "real" path for a particular
+ drive or volume instead of the DirectorySeparator. This would be
+ used in case that there is only one character (DriveSeparator)
+ delimitting the drive letter or volume name from the remaining
+ path _and_ the DriveSeparator marks the root of an absolute path
+ in that case. Example - 'Volume:This/Is/Absolute/Path'.
+
+ FPC_FEXPAND_NO_CURDIR - there is no support to refer to current
+ directory explicitely (like '.' used under both Unix and DOS-like
+ environments).
+
+ FPC_FEXPAND_NO_DOTS_UPDIR - '..' cannot be used to refer to the
+ upper directory.
+
+ FPC_FEXPAND_DIRSEP_IS_UPDIR - DirectorySeparator at the beginning of
+ a path (or doubled DirectorySeparator inside the path) refer to the
+ parent directory, one more DirectorySeparator to parent directory of
+ parent directory and so on (Amiga). Please, note that you can decide
+ to support both '..' and DirectorySeparator as references to the parent
+ directory at the same time for compatibility reasons - however this
+ support makes it impossible to use an otherwise possibly valid name
+ of '..'.
+
+ FPC_FEXPAND_DIRSEP_IS_CURDIR - DirectorySeparator at the beginning of
+ a path refers to the current directory (i.e. path beginning with
+ DirectorySeparator is always a relative path). Two DirectorySeparator
+ characters refer to the parent directory, three refer to parent
+ directory of the parent directory and so on (MacOS).
+
+ FPC_FEXPAND_MULTIPLE_UPDIR - grouping of more characters specifying
+ upper directory references higher directory levels. Example: '...'
+ (Netware).
+*)
+
+{
+ $Log: fexpand.inc,v $
+ Revision 1.18 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/file.inc b/rtl/inc/file.inc
new file mode 100644
index 0000000000..07e5e863ed
--- /dev/null
+++ b/rtl/inc/file.inc
@@ -0,0 +1,418 @@
+{
+ $Id: file.inc,v 1.9 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WithOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ subroutines For UnTyped File handling
+****************************************************************************}
+
+type
+ UnTypedFile=File;
+
+Procedure Assign(var f:File;const Name:string);
+{
+ Assign Name to file f so it can be used with the file routines
+}
+Begin
+ FillChar(f,SizeOf(FileRec),0);
+ FileRec(f).Handle:=UnusedHandle;
+ FileRec(f).mode:=fmClosed;
+ Move(Name[1],FileRec(f).Name,Length(Name));
+End;
+
+
+Procedure assign(var f:File;p:pchar);
+{
+ Assign Name to file f so it can be used with the file routines
+}
+begin
+ Assign(f,StrPas(p));
+end;
+
+
+Procedure assign(var f:File;c:char);
+{
+ Assign Name to file f so it can be used with the file routines
+}
+begin
+ Assign(f,string(c));
+end;
+
+
+Procedure Rewrite(var f:File;l:Longint);[IOCheck];
+{
+ Create file f with recordsize of l
+}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Case FileRec(f).mode Of
+ fmInOut,fmInput,fmOutput : Close(f);
+ fmClosed : ;
+ else
+ Begin
+ InOutRes:=102;
+ exit;
+ End;
+ End;
+ If l=0 Then
+ InOutRes:=2
+ else
+ Begin
+ { Reopen with filemode 2, to be Tp compatible (PFV) }
+ Do_Open(f,PChar(@FileRec(f).Name),$1002);
+ FileRec(f).RecSize:=l;
+ End;
+End;
+
+
+Procedure Reset(var f:File;l:Longint);[IOCheck];
+{
+ Open file f with recordsize of l and filemode
+}
+Begin
+ If InOutRes <> 0 then
+ Exit;
+ Case FileRec(f).mode Of
+ fmInOut,fmInput,fmOutput : Close(f);
+ fmClosed : ;
+ else
+ Begin
+ InOutRes:=102;
+ exit;
+ End;
+ End;
+ If l=0 Then
+ InOutRes:=2
+ else
+ Begin
+ Do_Open(f,PChar(@FileRec(f).Name),Filemode);
+ FileRec(f).RecSize:=l;
+ End;
+End;
+
+
+Procedure Rewrite(Var f:File);[IOCheck];
+{
+ Create file with (default) 128 byte records
+}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Rewrite(f,128);
+End;
+
+
+Procedure Reset(Var f:File);[IOCheck];
+{
+ Open file with (default) 128 byte records
+}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Reset(f,128);
+End;
+
+
+Procedure BlockWrite(Var f:File;Const Buf;Count:Longint;var Result:Longint);[IOCheck];
+{
+ Write Count records from Buf to file f, return written records in result
+}
+Begin
+ Result:=0;
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmOutput :
+ Result:=Do_Write(FileRec(f).Handle,@Buf,Count*FileRec(f).RecSize)
+ div FileRec(f).RecSize;
+ fmInPut: inOutRes := 105;
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure BlockWrite(Var f:File;Const Buf;Count:Word;var Result:Word);[IOCheck];
+{
+ Write Count records from Buf to file f, return written records in Result
+}
+var
+ l : longint;
+Begin
+ BlockWrite(f,Buf,Count,l);
+ Result:=word(l);
+End;
+
+
+Procedure BlockWrite(Var f:File;Const Buf;Count:Cardinal;var Result:Cardinal);[IOCheck];
+{
+ Write Count records from Buf to file f, return written records in Result
+}
+var
+ l : longint;
+Begin
+ BlockWrite(f,Buf,Count,l);
+ Result:=l;
+End;
+
+
+Procedure BlockWrite(Var f:File;Const Buf;Count:Word;var Result:Integer);[IOCheck];
+{
+ Write Count records from Buf to file f, return written records in Result
+}
+var
+ l : longint;
+Begin
+ BlockWrite(f,Buf,Count,l);
+ Result:=integer(l);
+End;
+
+
+Procedure BlockWrite(Var f:File;Const Buf;Count:Longint);[IOCheck];
+{
+ Write Count records from Buf to file f, if none a Read and Count>0 then
+ InOutRes is set
+}
+var
+ Result : Longint;
+Begin
+ BlockWrite(f,Buf,Count,Result);
+ If (InOutRes=0) and (Result<Count) and (Count>0) Then
+ InOutRes:=101;
+End;
+
+
+Procedure BlockRead(var f:File;var Buf;Count:Longint;var Result:Longint);[IOCheck];
+{
+ Read Count records from file f ro Buf, return number of read records in
+ Result
+}
+Begin
+ Result:=0;
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmInput :
+ Result:=Do_Read(FileRec(f).Handle,@Buf,count*FileRec(f).RecSize)
+ div FileRec(f).RecSize;
+ fmOutput: inOutRes := 104;
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);[IOCheck];
+{
+ Read Count records from file f to Buf, return number of read records in
+ Result
+}
+var
+ l : longint;
+Begin
+ BlockRead(f,Buf,Count,l);
+ Result:=word(l);
+End;
+
+
+Procedure BlockRead(var f:File;var Buf;count:Cardinal;var Result:Cardinal);[IOCheck];
+{
+ Read Count records from file f to Buf, return number of read records in
+ Result
+}
+var
+ l : longint;
+Begin
+ BlockRead(f,Buf,Count,l);
+ Result:=l;
+End;
+
+
+Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);[IOCheck];
+{
+ Read Count records from file f to Buf, return number of read records in
+ Result
+}
+var
+ l : longint;
+Begin
+ BlockRead(f,Buf,Count,l);
+ Result:=integer(l);
+End;
+
+
+Procedure BlockRead(Var f:File;Var Buf;Count:Longint);[IOCheck];
+{
+ Read Count records from file f to Buf, if none are read and Count>0 then
+ InOutRes is set
+}
+var
+ Result : Longint;
+Begin
+ BlockRead(f,Buf,Count,Result);
+ If (InOutRes=0) and (Result<Count) and (Count>0) Then
+ InOutRes:=100;
+End;
+
+
+Function FilePos(var f:File):Longint;[IOCheck];
+{
+ Return current Position In file f in records
+}
+Begin
+ FilePos:=0;
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmInput,fmOutput :
+ FilePos:=Do_FilePos(FileRec(f).Handle) div FileRec(f).RecSize;
+ else
+ InOutRes:=103;
+ end;
+End;
+
+
+Function FileSize(var f:File):Longint;[IOCheck];
+{
+ Return the size of file f in records
+}
+Begin
+ FileSize:=0;
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmInput,fmOutput :
+ begin
+ if (FileRec(f).RecSize>0) then
+ FileSize:=Do_FileSize(FileRec(f).Handle) div FileRec(f).RecSize;
+ end;
+ else InOutRes:=103;
+ end;
+End;
+
+
+Function Eof(var f:File):Boolean;[IOCheck];
+{
+ Return True if we're at the end of the file f, else False is returned
+}
+Begin
+ Eof:=false;
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ {Can't use do_ routines because we need record support}
+ fmInOut,fmInput,fmOutput : Eof:=(FileSize(f)<=FilePos(f));
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure Seek(var f:File;Pos:Longint);[IOCheck];
+{
+ Goto record Pos in file f
+}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmInput,fmOutput :
+ Do_Seek(FileRec(f).Handle,Pos*FileRec(f).RecSize);
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure Truncate(Var f:File);[IOCheck];
+{
+ Truncate/Cut file f at the current record Position
+}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmOutput :
+ Do_Truncate(FileRec(f).Handle,FilePos(f)*FileRec(f).RecSize);
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure Close(var f:File);[IOCheck];
+{
+ Close file f
+}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).Mode of
+ fmInOut,fmInput,fmOutput :
+ begin
+ Do_Close(FileRec(f).Handle);
+ FileRec(f).mode:=fmClosed;
+ end
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure Erase(var f : File);[IOCheck];
+Begin
+ If InOutRes <> 0 then
+ exit;
+ If FileRec(f).mode=fmClosed Then
+ Do_Erase(PChar(@FileRec(f).Name));
+End;
+
+
+Procedure Rename(var f : File;p:pchar);[IOCheck];
+Begin
+ If InOutRes <> 0 then
+ exit;
+ If FileRec(f).mode=fmClosed Then
+ Begin
+ Do_Rename(PChar(@FileRec(f).Name),p);
+ { check error code of do_rename }
+ If InOutRes = 0 then
+ Move(p^,FileRec(f).Name,StrLen(p)+1);
+ End;
+End;
+
+
+Procedure Rename(var f : File;const s : string);[IOCheck];
+var
+ p : array[0..255] Of Char;
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Move(s[1],p,Length(s));
+ p[Length(s)]:=#0;
+ Rename(f,Pchar(@p));
+End;
+
+
+Procedure Rename(var f : File;c : char);[IOCheck];
+var
+ p : array[0..1] Of Char;
+Begin
+ If InOutRes <> 0 then
+ exit;
+ p[0]:=c;
+ p[1]:=#0;
+ Rename(f,Pchar(@p));
+End;
+
+{
+ $Log: file.inc,v $
+ Revision 1.9 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/filerec.inc b/rtl/inc/filerec.inc
new file mode 100644
index 0000000000..605702238d
--- /dev/null
+++ b/rtl/inc/filerec.inc
@@ -0,0 +1,48 @@
+{
+ $Id: filerec.inc,v 1.8 2005/02/26 15:42:45 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ FileRec record definition
+
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ This file contains the definition of the filerec record.
+ It is put separately, so it is available outside the system
+ unit without sacrificing TP compatibility.
+}
+
+const
+ filerecnamelength = 255;
+type
+ FileRec = Packed Record
+ Handle : THandle;
+ Mode : longint;
+ RecSize : SizeInt;
+ _private : array[1..3 * SizeOf(SizeInt) + 5 * SizeOf (pointer)] of byte;
+{$ifndef FPC_HASUSERDATA32}
+ UserData : array[1..16] of byte;
+{$else FPC_HASUSERDATA32}
+ UserData : array[1..32] of byte;
+{$endif FPC_HASUSERDATA32}
+ name : array[0..filerecnamelength] of char;
+ End;
+
+{
+ $Log: filerec.inc,v $
+ Revision 1.8 2005/02/26 15:42:45 florian
+ * userdata in file/textrecs now 32 bytes
+
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc
new file mode 100644
index 0000000000..7071dca606
--- /dev/null
+++ b/rtl/inc/generic.inc
@@ -0,0 +1,1243 @@
+{
+ $Id: generic.inc,v 1.90 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Processor independent implementation for the system unit
+ (adapted for intel i386.inc file)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ Primitives
+****************************************************************************}
+type
+ pstring = ^shortstring;
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
+type
+ bytearray = array [0..high(sizeint)-1] of byte;
+var
+ i:longint;
+begin
+ if count <= 0 then exit;
+ Dec(count);
+ if @source<@dest then
+ begin
+ for i:=count downto 0 do
+ bytearray(dest)[i]:=bytearray(source)[i];
+ end
+ else
+ begin
+ for i:=0 to count do
+ bytearray(dest)[i]:=bytearray(source)[i];
+ end;
+end;
+{$endif not FPC_SYSTEM_HAS_MOVE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
+Procedure FillChar(var x;count:SizeInt;value:byte);
+type
+ longintarray = array [0..high(sizeint) div 4-1] of longint;
+ bytearray = array [0..high(sizeint)-1] of byte;
+var
+ i,v : longint;
+begin
+ if count <= 0 then exit;
+ v := 0;
+ { aligned? }
+ if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
+ begin
+ for i:=0 to count-1 do
+ bytearray(x)[i]:=value;
+ end
+ else
+ begin
+ v:=(value shl 8) or (value and $FF);
+ v:=(v shl 16) or (v and $ffff);
+ for i:=0 to (count div 4)-1 do
+ longintarray(x)[i]:=v;
+ for i:=(count div 4)*4 to count-1 do
+ bytearray(x)[i]:=value;
+ end;
+end;
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLBYTE}
+procedure FillByte (var x;count : SizeInt;value : byte );
+begin
+ FillChar (X,Count,CHR(VALUE));
+end;
+{$endif not FPC_SYSTEM_HAS_FILLBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLWORD}
+procedure fillword(var x;count : SizeInt;value : word);
+type
+ longintarray = array [0..high(sizeint) div 4-1] of longint;
+ wordarray = array [0..high(sizeint) div 2-1] of word;
+var
+ i,v : longint;
+begin
+ if Count <= 0 then exit;
+ { aligned? }
+ if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
+ begin
+ for i:=0 to count-1 do
+ wordarray(x)[i]:=value;
+ end
+ else
+ begin
+ v:=value*$10000+value;
+ for i:=0 to (count div 2) -1 do
+ longintarray(x)[i]:=v;
+ for i:=(count div 2)*2 to count-1 do
+ wordarray(x)[i]:=value;
+ end;
+end;
+{$endif not FPC_SYSTEM_HAS_FILLWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
+procedure FillDWord(var x;count : SizeInt;value : DWord);
+type
+ longintarray = array [0..high(sizeint) div 4-1] of longint;
+begin
+ if count <= 0 then exit;
+ while Count<>0 do
+ begin
+ { range checking must be disabled here }
+ longintarray(x)[count-1]:=longint(value);
+ Dec(count);
+ end;
+end;
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
+function IndexChar(Const buf;len:SizeInt;b:char):SizeInt;
+begin
+ IndexChar:=IndexByte(Buf,Len,byte(B));
+end;
+{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt;
+type
+ bytearray = array [0..high(sizeint)-1] of byte;
+var
+ I : longint;
+begin
+ I:=0;
+ { simulate assembler implementations behaviour, which is expected }
+ { fpc_pchar_to_ansistr in astrings.inc }
+ if (len < 0) then
+ len := high(longint);
+ while (I<Len) and (bytearray(buf)[I]<>b) do
+ inc(I);
+ if (i=Len) then
+ i:=-1; {Can't use 0, since it is a possible value}
+ IndexByte:=I;
+end;
+{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
+function Indexword(Const buf;len:SizeInt;b:word):SizeInt;
+type
+ wordarray = array [0..high(sizeint) div 2-1] of word;
+var
+ I : longint;
+begin
+ I:=0;
+ if (len < 0) then
+ len := high(longint);
+ while (I<Len) and (wordarray(buf)[I]<>b) do
+ inc(I);
+ if (i=Len) then
+ i:=-1; {Can't use 0, since it is a possible value for index}
+ Indexword:=I;
+end;
+{$endif not FPC_SYSTEM_HAS_INDEXWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt;
+type
+ dwordarray = array [0..high(sizeint) div 4-1] of dword;
+var
+ I : longint;
+begin
+ I:=0;
+ if (len < 0) then
+ len := high(longint);
+ while (I<Len) and (dwordarray(buf)[I]<>b) do
+ inc(I);
+ if (i=Len) then
+ i:=-1; {Can't use 0, since it is a possible value for index}
+ IndexDWord:=I;
+end;
+{$endif not FPC_SYSTEM_HAS_INDEXDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
+function CompareChar(Const buf1,buf2;len:SizeInt):SizeInt;
+begin
+ CompareChar:=CompareByte(buf1,buf2,len);
+end;
+{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt;
+type
+ bytearray = array [0..high(sizeint)-1] of byte;
+var
+ I : longint;
+begin
+ I:=0;
+ if (Len<>0) and (@Buf1<>@Buf2) then
+ begin
+ while (bytearray(Buf1)[I]=bytearray(Buf2)[I]) and (I<Len) do
+ inc(I);
+ if I=Len then {No difference}
+ I:=0
+ else
+ begin
+ I:=bytearray(Buf1)[I]-bytearray(Buf2)[I];
+ if I>0 then
+ I:=1
+ else
+ if I<0 then
+ I:=-1;
+ end;
+ end;
+ CompareByte:=I;
+end;
+{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt;
+type
+ wordarray = array [0..high(sizeint) div 2-1] of word;
+var
+ I : longint;
+begin
+ I:=0;
+ if (Len<>0) and (@Buf1<>@Buf2) then
+ begin
+ while (wordarray(Buf1)[I]=wordarray(Buf2)[I]) and (I<Len) do
+ inc(I);
+ if I=Len then {No difference}
+ I:=0
+ else
+ begin
+ I:=wordarray(Buf1)[I]-wordarray(Buf2)[I];
+ if I>0 then
+ I:=1
+ else
+ if I<0 then
+ I:=-1;
+ end;
+ end;
+ CompareWord:=I;
+end;
+{$endif not FPC_SYSTEM_HAS_COMPAREWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt;
+type
+ longintarray = array [0..high(sizeint) div 4-1] of longint;
+var
+ I : longint;
+begin
+ I:=0;
+ if (Len<>0) and (@Buf1<>@Buf2) then
+ begin
+ while (longintarray(Buf1)[I]=longintarray(Buf2)[I]) and (I<Len) do
+ inc(I);
+ if I=Len then {No difference}
+ I:=0
+ else
+ begin
+ I:=longintarray(Buf1)[I]-longintarray(Buf2)[I];
+ if I>0 then
+ I:=1
+ else
+ if I<0 then
+ I:=-1;
+ end;
+ end;
+ CompareDWord:=I;
+end;
+{$endif ndef FPC_SYSTEM_HAS_COMPAREDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_MOVECHAR0}
+procedure MoveChar0(Const buf1;var buf2;len:SizeInt);
+var
+ I : longint;
+begin
+ if Len = 0 then exit;
+ I:=IndexByte(Buf1,Len,0);
+ if I<>-1 then
+ Move(Buf1,Buf2,I)
+ else
+ Move(Buf1,Buf2,len);
+end;
+{$endif ndef FPC_SYSTEM_HAS_MOVECHAR0}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(Const buf;len:SizeInt;b:Char):SizeInt;
+var
+ I : longint;
+begin
+ if Len<>0 then
+ begin
+ I:=IndexByte(Buf,Len,0);
+ If (I=-1) then
+ I:=Len;
+ IndexChar0:=IndexByte(Buf,I,byte(b));
+ end
+ else
+ IndexChar0:=0;
+end;
+{$endif ndef FPC_SYSTEM_HAS_INDEXCHAR0}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
+function CompareChar0(Const buf1,buf2;len:SizeInt):SizeInt;
+type
+ bytearray = array [0..high(sizeint)-1] of byte;
+var
+ i : longint;
+begin
+ I:=0;
+ if (Len<>0) and (@Buf1<>@Buf2) then
+ begin
+ while (I<Len) And
+ ((Pbyte(@Buf1)[i]<>0) and (PByte(@buf2)[i]<>0)) and
+ (pbyte(@Buf1)[I]=pbyte(@Buf2)[I]) do
+ inc(I);
+ if (I=Len) or
+ (PByte(@Buf1)[i]=0) or
+ (PByte(@buf2)[I]=0) then {No difference or 0 reached }
+ I:=0
+ else
+ begin
+ I:=bytearray(Buf1)[I]-bytearray(Buf2)[I];
+ if I>0 then
+ I:=1
+ else
+ if I<0 then
+ I:=-1;
+ end;
+ end;
+ CompareChar0:=I;
+end;
+{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
+
+
+{****************************************************************************
+ Object Helpers
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+{ Note: _vmt will be reset to -1 when memory is allocated,
+ this is needed for fpc_help_fail }
+function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;[public,alias:'FPC_HELP_CONSTRUCTOR'];{$ifdef hascompilerproc}compilerproc;{$endif}
+type
+ ppointer = ^pointer;
+ pvmt = ^tvmt;
+ tvmt=packed record
+ size,msize:ptrint;
+ parent:pointer;
+ end;
+var
+ vmtcopy : pointer;
+begin
+ { Inherited call? }
+ if _vmt=nil then
+ begin
+ fpc_help_constructor:=_self;
+ exit;
+ end;
+ vmtcopy:=_vmt;
+
+ if (_self=nil) and
+ (pvmt(_vmt)^.size>0) then
+ begin
+ getmem(_self,pvmt(_vmt)^.size);
+ { reset vmt needed for fail }
+ _vmt:=pointer(-1);
+ end;
+ if _self<>nil then
+ begin
+ fillchar(_self^,pvmt(vmtcopy)^.size,#0);
+ ppointer(_self+_vmt_pos)^:=vmtcopy;
+ end;
+ fpc_help_constructor:=_self;
+end;
+{$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
+{ Note: _self will not be reset, the compiler has to generate the reset }
+procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+type
+ ppointer = ^pointer;
+ pvmt = ^tvmt;
+ tvmt = packed record
+ size,msize : ptrint;
+ parent : pointer;
+ end;
+begin
+ { already released? }
+ if (_self=nil) or
+ (_vmt=nil) or
+ (ppointer(_self+vmt_pos)^=nil) then
+ exit;
+ if (pvmt(ppointer(_self+vmt_pos)^)^.size=0) or
+ (pvmt(ppointer(_self+vmt_pos)^)^.size+pvmt(ppointer(_self+vmt_pos)^)^.msize<>0) then
+ RunError(210);
+ { reset vmt to nil for protection }
+ ppointer(_self+vmt_pos)^:=nil;
+ freemem(_self);
+end;
+{$endif FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_HELP_FAIL}
+{ Note: _self will not be reset, the compiler has to generate the reset }
+procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_FAIL'];compilerproc;
+type
+ ppointer = ^pointer;
+ pvmt = ^tvmt;
+ tvmt = packed record
+ size,msize : ptrint;
+ parent : pointer;
+ end;
+begin
+ if (_self=nil) or (_vmt=nil) then
+ exit;
+ { vmt=-1 when memory was allocated }
+ if ptrint(_vmt)=-1 then
+ begin
+ if (_self=nil) or (ppointer(_self+vmt_pos)^=nil) then
+ HandleError(210)
+ else
+ begin
+ ppointer(_self+vmt_pos)^:=nil;
+ freemem(_self);
+ { reset _vmt to nil so it will not be freed a
+ second time }
+ _vmt:=nil;
+ end;
+ end
+ else
+ ppointer(_self+vmt_pos)^:=nil;
+end;
+{$endif FPC_SYSTEM_HAS_FPC_HELP_FAIL}
+
+
+{$ifndef NOCLASSHELPERS}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_NEW_CLASS}
+function fpc_new_class(_self,_vmt:pointer):pointer;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ { Inherited call? }
+ if _vmt=nil then
+ begin
+ fpc_new_class:=_self;
+ exit;
+ end;
+
+ fpc_new_class := tclass(_vmt).NewInstance
+end;
+{$endif FPC_SYSTEM_HAS_FPC_NEW_CLASS}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
+procedure fpc_dispose_class(_self: pointer; flag : longint);[public,alias:'FPC_DISPOSE_CLASS'];compilerproc;
+begin
+ { inherited -> flag = 0 -> no destroy }
+ { normal -> flag = 1 -> destroy }
+ if (_self <> nil) and (flag = 1) then
+ tobject(_self).FreeInstance;
+end;
+{$endif ndef FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
+
+{$endif NOCLASSHELPERS}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
+procedure fpc_check_object(_vmt : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+type
+ pvmt = ^tvmt;
+ tvmt = packed record
+ size,msize : ptrint;
+ parent : pointer;
+ end;
+begin
+ if (_vmt=nil) or
+ (pvmt(_vmt)^.size=0) or
+ (pvmt(_vmt)^.size+pvmt(_vmt)^.msize<>0) then
+ RunError(210);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
+{ checks for a correct vmt pointer }
+{ deeper check to see if the current object is }
+{ really related to the true }
+procedure fpc_check_object_ext(vmt, expvmt : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+type
+ pvmt = ^tvmt;
+ tvmt = packed record
+ size,msize : ptrint;
+ parent : pointer;
+ end;
+begin
+ if (vmt=nil) or
+ (pvmt(vmt)^.size=0) or
+ (pvmt(vmt)^.size+pvmt(vmt)^.msize<>0) then
+ RunError(210);
+ while assigned(vmt) do
+ if vmt=expvmt then
+ exit
+ else
+ vmt:=pvmt(vmt)^.parent;
+ RunError(219);
+end;
+{$endif not FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
+
+
+{****************************************************************************
+ String
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+
+function fpc_shortstr_to_shortstr(len:longint;const sstr:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ slen : byte;
+begin
+ slen:=length(sstr);
+ if slen<len then
+ len:=slen;
+ move(sstr[0],result[0],len+1);
+ if slen>len then
+ result[0]:=chr(len);
+end;
+
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
+{$else}
+procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
+{$endif}
+var
+ slen : byte;
+type
+ pstring = ^string;
+begin
+ slen:=length(pstring(sstr)^);
+ if slen<len then
+ len:=slen;
+ move(sstr^,dstr^,len+1);
+ if slen>len then
+ pchar(dstr)^:=chr(len);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+function fpc_shortstr_concat(const s1,s2:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s1l, s2l : byte;
+begin
+ s1l:=length(s1);
+ s2l:=length(s2);
+ if s1l+s2l>255 then
+ s2l:=255-s1l;
+ move(s1[1],fpc_shortstr_concat[1],s1l);
+ move(s2[1],fpc_shortstr_concat[s1l+1],s2l);
+ fpc_shortstr_concat[0]:=chr(s1l+s2l);
+end;
+{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring);{$ifdef hascompilerproc} compilerproc; {$endif}
+ [public,alias:'FPC_SHORTSTR_APPEND_SHORTSTR'];
+var
+ s1l, s2l : byte;
+begin
+ s1l:=length(s1);
+ s2l:=length(s2);
+ if s1l+s2l>high(s1) then
+ s2l:=high(s1)-s1l;
+ move(s2[1],s1[s1l+1],s2l);
+ s1[0]:=chr(s1l+s2l);
+end;
+{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+function fpc_shortstr_compare(const left,right:shortstring) : longint;[public,alias:'FPC_SHORTSTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s1,s2,max,i : byte;
+ d : longint;
+begin
+ s1:=length(left);
+ s2:=length(right);
+ if s1<s2 then
+ max:=s1
+ else
+ max:=s2;
+ for i:=1 to max do
+ begin
+ d:=byte(left[i])-byte(right[i]);
+ if d>0 then
+ exit(1)
+ else if d<0 then
+ exit(-1);
+ end;
+ if s1>s2 then
+ exit(1)
+ else if s1<s2 then
+ exit(-1)
+ else
+ exit(0);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ l : longint;
+ s: shortstring;
+begin
+ if p=nil then
+ l:=0
+ else
+ l:=strlen(p);
+ if l>255 then
+ l:=255;
+ if l>0 then
+ move(p^,s[1],l);
+ s[0]:=chr(l);
+ fpc_pchar_to_shortstr := s;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
+
+{$ifdef hascompilerproc}
+function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
+var
+ l: longint;
+{$else hascompilerproc}
+function fpc_chararray_to_shortstr(arr:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
+var
+{$endif hascompilerproc}
+ index: longint;
+ len: byte;
+begin
+{$ifdef hascompilerproc}
+ l := high(arr)+1;
+{$endif hascompilerproc}
+ if l>=256 then
+ l:=255
+ else if l<0 then
+ l:=0;
+ index:=IndexByte(arr[0],l,0);
+ if (index < 0) then
+ len := l
+ else
+ len := index;
+ move(arr[0],fpc_chararray_to_shortstr[1],len);
+ fpc_chararray_to_shortstr[0]:=chr(len);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
+
+{$ifdef hascompilerproc}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
+
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM) }
+function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray;[public,alias: 'FPC_SHORTSTR_TO_CHARARRAY']; compilerproc;
+var
+ len: longint;
+begin
+ len := length(src);
+ if len > arraysize then
+ len := arraysize;
+ { make sure we don't access char 1 if length is 0 (JM) }
+ if len > 0 then
+ move(src[1],fpc_shortstr_to_chararray[0],len);
+ fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
+end;
+
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
+
+{$else hascompilerproc}
+
+{$ifopt r+}
+{$define rangeon}
+{$r-}
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_STR_TO_CHARARRAY}
+procedure fpc_str_to_chararray(strtyp, arraysize: longint; src,dest: pchar);[public,alias:'FPC_STR_TO_CHARARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
+type
+ plongint = ^longint;
+var
+ len: longint;
+begin
+ case strtyp of
+ { shortstring }
+ 0:
+ begin
+ len := byte(src[0]);
+ inc(src);
+ end;
+{$ifdef SUPPORT_ANSISTRING}
+ { ansistring}
+ 1: len := length(ansistring(pointer(src)));
+{$endif SUPPORT_ANSISTRING}
+ { longstring }
+ 2:;
+ { widestring }
+ 3: ;
+ end;
+ if len > arraysize then
+ len := arraysize;
+ { make sure we don't dereference src if it can be nil (JM) }
+ if len > 0 then
+ move(src^,dest^,len);
+ fillchar(dest[len],arraysize-len,0);
+end;
+
+{$endif FPC_SYSTEM_HAS_FPC_STR_TO_CHARARRAY}
+
+{$ifdef rangeon}
+{$r+}
+{undef rangeon}
+{$endif rangeon}
+
+{$endif hascompilerproc}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var i : longint;
+begin
+ i:=0;
+ while p[i]<>#0 do inc(i);
+ exit(i);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+{$ifdef HASWIDESTRING}
+{$ifndef FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
+
+function fpc_pwidechar_length(p:pwidechar):longint;[public,alias:'FPC_PWIDECHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var i : longint;
+begin
+ i:=0;
+ while p[i]<>#0 do inc(i);
+ exit(i);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
+{$endif HASWIDESTRING}
+
+{****************************************************************************
+ Caller/StackFrame Helpers
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_GET_FRAME}
+{_$error Get_frame must be defined for each processor }
+{$endif ndef FPC_SYSTEM_HAS_GET_FRAME}
+
+{$ifndef FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+{_$error Get_caller_addr must be defined for each processor }
+{$endif ndef FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+
+{$ifndef FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+{_$error Get_caller_frame must be defined for each processor }
+{$endif ndef FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+
+{****************************************************************************
+ Math
+****************************************************************************}
+
+{****************************************************************************
+ Software longint/dword division
+****************************************************************************}
+{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}
+
+function count_leading_zeros_32bit(l : longint) : longint;
+ var
+ i : longint;
+ begin
+ for i:=0 to 31 do
+ begin
+ if (l and (longint($80000000) shr i))<>0 then
+ begin
+ result:=i;
+ exit;
+ end;
+ end;
+ result:=i;
+ end;
+
+
+{$ifndef FPC_SYSTEM_HAS_DIV_DWORD}
+function fpc_div_dword(n,z : dword) : dword; [public,alias: 'FPC_DIV_DWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ shift,lzz,lzn : longint;
+ begin
+ result:=0;
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ lzz:=count_leading_zeros_32bit(z);
+ lzn:=count_leading_zeros_32bit(n);
+ { if the denominator contains less zeros
+ then the numerator
+ the d is greater than the n }
+ if lzn<lzz then
+ exit;
+ shift:=lzn-lzz;
+ n:=n shl shift;
+ repeat
+ if z>=n then
+ begin
+ z:=z-n;
+ result:=result+dword(1 shl shift);
+ end;
+ dec(shift);
+ n:=n shr 1;
+ until shift<0;
+ end;
+{$endif FPC_SYSTEM_HAS_DIV_DWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_MOD_DWORD}
+function fpc_mod_dword(n,z : dword) : dword; [public,alias: 'FPC_MOD_DWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ shift,lzz,lzn : longint;
+ begin
+ result:=0;
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ lzz:=count_leading_zeros_32bit(z);
+ lzn:=count_leading_zeros_32bit(n);
+ { if the denominator contains less zeros
+ then the numerator
+ the d is greater than the n }
+ if lzn<lzz then
+ begin
+ result:=z;
+ exit;
+ end;
+ shift:=lzn-lzz;
+ n:=n shl shift;
+ repeat
+ if z>=n then
+ z:=z-n;
+ dec(shift);
+ n:=n shr 1;
+ until shift<0;
+ result:=z;
+ end;
+{$endif FPC_SYSTEM_HAS_MOD_DWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_DIV_LONGINT}
+function fpc_div_longint(n,z : longint) : longint; [public,alias: 'FPC_DIV_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ sign : boolean;
+ d1,d2 : dword;
+ begin
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ sign:=false;
+ if z<0 then
+ begin
+ sign:=not(sign);
+ d1:=dword(-z);
+ end
+ else
+ d1:=z;
+ if n<0 then
+ begin
+ sign:=not(sign);
+ d2:=dword(-n);
+ end
+ else
+ d2:=n;
+
+ { the div is coded by the compiler as call to divdword }
+ if sign then
+ result:=-(d1 div d2)
+ else
+ result:=d1 div d2;
+ end;
+{$endif FPC_SYSTEM_HAS_DIV_LONGINT}
+
+
+{$ifndef FPC_SYSTEM_HAS_MOD_LONGINT}
+function fpc_mod_longint(n,z : longint) : longint; [public,alias: 'FPC_MOD_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ signed : boolean;
+ r,nq,zq : dword;
+ begin
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ nq:=abs(n);
+
+ if z<0 then
+ begin
+ zq:=dword(-z);
+ signed:=true;
+ end
+ else
+ begin
+ zq:=z;
+ signed:=false;
+ end;
+
+ r:=zq mod nq;
+ if signed then
+ result:=-longint(r)
+ else
+ result:=r;
+ end;
+{$endif FPC_SYSTEM_HAS_MOD_LONGINT}
+
+{$endif FPC_INCLUDE_SOFTWARE_MOD_DIV}
+
+
+{****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}
+begin
+ if l<0 then
+ abs:=-l
+ else
+ abs:=l;
+end;
+
+{$endif not FPC_SYSTEM_HAS_ABS_LONGINT}
+
+{$ifndef FPC_SYSTEM_HAS_ODD_LONGINT}
+
+function odd(l:longint):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}
+begin
+ odd:=boolean(l and 1);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_ODD_LONGINT}
+
+{$ifndef FPC_SYSTEM_HAS_ODD_LONGWORD}
+
+function odd(l:longword):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}
+begin
+ odd:=boolean(l and 1);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_ODD_LONGWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_ODD_INT64}
+
+function odd(l:int64):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}
+begin
+ odd:=boolean(longint(l) and 1);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_ODD_INT64}
+
+{$ifndef FPC_SYSTEM_HAS_ODD_QWORD}
+
+function odd(l:qword):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}
+begin
+ odd:=boolean(longint(l) and 1);
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_ODD_QWORD}
+
+{$ifndef FPC_SYSTEM_HAS_SQR_LONGINT}
+
+function sqr(l:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}
+begin
+ sqr:=l*l;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_SQR_LONGINT}
+
+
+{$ifndef FPC_SYSTEM_HAS_ABS_INT64}
+
+function abs(l: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}
+begin
+ if l < 0 then
+ abs := -l
+ else
+ abs := l;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_ABS_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_SQR_INT64}
+
+function sqr(l: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}
+begin
+ sqr := l*l;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_SQR_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_SQR_QWORD}
+
+function sqr(l: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}
+begin
+ sqr := l*l;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_SQR_INT64}
+
+{$ifndef FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+function declocked(var l:longint):boolean;
+ begin
+ Dec(l);
+ declocked:=(l=0);
+ end;
+{$endif FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+
+
+{$ifndef FPC_SYSTEM_HAS_DECLOCKED_INT64}
+function declocked(var l:int64):boolean;
+ begin
+ Dec(l);
+ declocked:=(l=0);
+ end;
+{$endif FPC_SYSTEM_HAS_DECLOCKED_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l:longint);
+ begin
+ Inc(l);
+ end;
+{$endif FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+
+
+{$ifndef FPC_SYSTEM_HAS_INCLOCKED_INT64}
+procedure inclocked(var l:int64);
+ begin
+ Inc(l);
+ end;
+{$endif FPC_SYSTEM_HAS_INCLOCKED_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_SPTR}
+{_$error Sptr must be defined for each processor }
+{$endif ndef FPC_SYSTEM_HAS_SPTR}
+
+
+{$ifndef INTERNCONSTINTF}
+procedure prefetch(const mem);[internproc:fpc_in_prefetch_var];
+{$endif}
+
+
+function align(addr : PtrInt;alignment : PtrInt) : PtrInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ if addr mod alignment<>0 then
+ result:=addr+(alignment-(addr mod alignment))
+ else
+ result:=addr;
+ end;
+
+
+function align(addr : Pointer;alignment : PtrInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ if PtrInt(addr) mod alignment<>0 then
+ result:=pointer(addr+(alignment-(PtrInt(addr) mod alignment)))
+ else
+ result:=addr;
+ end;
+
+
+{****************************************************************************
+ Str()
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_INT_STR_LONGINT}
+
+procedure int_str(l : longint;var s : string);
+var
+ value: longint;
+ negative: boolean;
+
+ begin
+ negative := false;
+ s:='';
+ { Workaround: }
+ if l=longint($80000000) then
+ begin
+ s:='-2147483648';
+ exit;
+ end;
+ { handle case where l = 0 }
+ if l = 0 then
+ begin
+ s:='0';
+ exit;
+ end;
+ If l < 0 then
+ begin
+ negative := true;
+ value:=abs(l);
+ end
+ else
+ value:=l;
+ { handle non-zero case }
+ while value>0 do
+ begin
+ s:=char((value mod 10)+ord('0'))+s;
+ value := value div 10;
+ end;
+ if negative then
+ s := '-' + s;
+ end;
+
+{$endif ndef FPC_SYSTEM_HAS_INT_STR_LONGINT}
+
+{$ifndef FPC_SYSTEM_HAS_INT_STR_LONGWORD}
+
+procedure int_str(l : longword;var s : string);
+begin
+ s:='';
+ if l = 0 then
+ begin
+ s := '0';
+ exit;
+ end;
+ while l>0 do
+ begin
+ s:=char(ord('0')+(l mod 10))+s;
+ l:=l div 10;
+ end;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_INT_STR_LONGWORD}
+
+{$ifndef FPC_SYSTEM_HAS_INT_STR_INT64}
+
+procedure int_str(l : int64;var s : string);
+var
+ value: int64;
+ negative: boolean;
+
+ begin
+ negative := false;
+ s:='';
+ { Workaround: }
+{$ifdef ver1_0}
+ if (l shr 32=$80000000) and ((l and $ffffffff)=0) then
+{$else}
+ if l=int64($8000000000000000) then
+{$endif}
+ begin
+ s:='-9223372036854775808';
+ exit;
+ end;
+ { handle case where l = 0 }
+ if l = 0 then
+ begin
+ s:='0';
+ exit;
+ end;
+ If l < 0 then
+ begin
+ negative := true;
+ value:=abs(l);
+ end
+ else
+ value:=l;
+ { handle non-zero case }
+ while value>0 do
+ begin
+ s:=char((value mod 10)+ord('0'))+s;
+ value := value div 10;
+ end;
+ if negative then
+ s := '-' + s;
+ end;
+
+{$endif ndef FPC_SYSTEM_HAS_INT_STR_INT64}
+
+{$ifndef FPC_SYSTEM_HAS_INT_STR_QWORD}
+
+procedure int_str(l : qword;var s : string);
+begin
+ s:='';
+ if l = 0 then
+ begin
+ s := '0';
+ exit;
+ end;
+ while l>0 do
+ begin
+ s:=char(ord('0')+(l mod 10))+s;
+ l:=l div 10;
+ end;
+end;
+
+{$endif ndef FPC_SYSTEM_HAS_INT_STR_QWORD}
+
+{$ifndef FPC_SYSTEM_HAS_SYSRESETFPU}
+
+procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ { nothing todo }
+end;
+
+{$endif FPC_SYSTEM_HAS_SYSRESETFPU}
+
+{
+ $Log: generic.inc,v $
+ Revision 1.90 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc
new file mode 100644
index 0000000000..aeb091bf90
--- /dev/null
+++ b/rtl/inc/genmath.inc
@@ -0,0 +1,1268 @@
+{
+ $Id: genmath.inc,v 1.32 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by Several contributors
+
+ Generic mathemtical routines (on type real)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{*************************************************************************}
+{ Credits }
+{*************************************************************************}
+{ Copyright Abandoned, 1987, Fred Fish }
+{ }
+{ This previously copyrighted work has been placed into the }
+{ public domain by the author (Fred Fish) and may be freely used }
+{ for any purpose, private or commercial. I would appreciate }
+{ it, as a courtesy, if this notice is left in all copies and }
+{ derivative works. Thank you, and enjoy... }
+{ }
+{ The author makes no warranty of any kind with respect to this }
+{ product and explicitly disclaims any implied warranties of }
+{ merchantability or fitness for any particular purpose. }
+{-------------------------------------------------------------------------}
+{ Copyright (c) 1992 Odent Jean Philippe }
+{ }
+{ The source can be modified as long as my name appears and some }
+{ notes explaining the modifications done are included in the file. }
+{-------------------------------------------------------------------------}
+{ Copyright (c) 1997 Carl Eric Codere }
+{-------------------------------------------------------------------------}
+
+{$goto on}
+
+type
+ TabCoef = array[0..6] of Real;
+
+
+const
+ PIO2 = 1.57079632679489661923; { pi/2 }
+ PIO4 = 7.85398163397448309616E-1; { pi/4 }
+ SQRT2 = 1.41421356237309504880; { sqrt(2) }
+ SQRTH = 7.07106781186547524401E-1; { sqrt(2)/2 }
+ LOG2E = 1.4426950408889634073599; { 1/log(2) }
+ SQ2OPI = 7.9788456080286535587989E-1; { sqrt( 2/pi )}
+ LOGE2 = 6.93147180559945309417E-1; { log(2) }
+ LOGSQ2 = 3.46573590279972654709E-1; { log(2)/2 }
+ THPIO4 = 2.35619449019234492885; { 3*pi/4 }
+ TWOOPI = 6.36619772367581343075535E-1; { 2/pi }
+ lossth = 1.073741824e9;
+ MAXLOG = 8.8029691931113054295988E1; { log(2**127) }
+ MINLOG = -8.872283911167299960540E1; { log(2**-128) }
+
+ DP1 = 7.85398125648498535156E-1;
+ DP2 = 3.77489470793079817668E-8;
+ DP3 = 2.69515142907905952645E-15;
+
+const sincof : TabCoef = (
+ 1.58962301576546568060E-10,
+ -2.50507477628578072866E-8,
+ 2.75573136213857245213E-6,
+ -1.98412698295895385996E-4,
+ 8.33333333332211858878E-3,
+ -1.66666666666666307295E-1, 0);
+ coscof : TabCoef = (
+ -1.13585365213876817300E-11,
+ 2.08757008419747316778E-9,
+ -2.75573141792967388112E-7,
+ 2.48015872888517045348E-5,
+ -1.38888888888730564116E-3,
+ 4.16666666666665929218E-2, 0);
+
+
+
+{ also necessary for Int() on systems with 64bit floats (JM) }
+type
+{$ifdef ENDIAN_LITTLE}
+ float64 = packed record
+ low: longint;
+ high: longint;
+ end;
+{$else}
+ float64 = packed record
+ high: longint;
+ low: longint;
+ end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_TRUNC}
+type
+ float32 = longint;
+ flag = byte;
+
+ Function extractFloat64Frac0(const a: float64): longint;
+ Begin
+ extractFloat64Frac0 := a.high and $000FFFFF;
+ End;
+
+
+ Function extractFloat64Frac1(const a: float64): longint;
+ Begin
+ extractFloat64Frac1 := a.low;
+ End;
+
+
+ Function extractFloat64Exp(const a: float64): smallint;
+ Begin
+ extractFloat64Exp:= ( a.high shr 20 ) AND $7FF;
+ End;
+
+
+ Function extractFloat64Frac(const a: float64): int64;
+ Begin
+ extractFloat64Frac:=int64(a) and $000FFFFFFFFFFFFF;
+ End;
+
+
+ Function extractFloat64Sign(const a: float64) : flag;
+ Begin
+ extractFloat64Sign := a.high shr 31;
+ End;
+
+
+ Procedure shortShift64Left(a0:longint; a1:longint; count:smallint; VAR z0Ptr:longint; VAR z1Ptr:longint );
+ Begin
+ z1Ptr := a1 shl count;
+ if count = 0 then
+ z0Ptr := a0
+ else
+ z0Ptr := ( a0 shl count ) OR ( a1 shr ( ( - count ) AND 31 ) );
+ End;
+
+ function float64_to_int32_round_to_zero(a: float64 ): longint;
+ Var
+ aSign: flag;
+ aExp, shiftCount: smallint;
+ aSig0, aSig1, absZ, aSigExtra: longint;
+ z: longint;
+ Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ shiftCount := aExp - $413;
+ if 0<=shiftCount then
+ Begin
+ if (aExp=$7FF) and ((aSig0 or aSig1)<>0) then
+ HandleError(207);
+ shortShift64Left(aSig0 OR $00100000, aSig1, shiftCount, absZ, aSigExtra );
+ End
+ else
+ Begin
+ if aExp<$3FF then
+ begin
+ float64_to_int32_round_to_zero := 0;
+ exit;
+ end;
+ aSig0 := aSig0 or $00100000;
+ aSigExtra := ( aSig0 shl ( shiftCount and 31 ) ) OR aSig1;
+ absZ := aSig0 shr ( - shiftCount );
+ End;
+ if aSign<>0 then
+ z:=-absZ
+ else
+ z:=absZ;
+ if ((aSign<>0) xor (z<0)) AND (z<>0) then
+ HandleError(207);
+ float64_to_int32_round_to_zero := z;
+ End;
+
+
+{$ifndef VER1_0}
+ function float64_to_int64_round_to_zero(a : float64) : int64;
+ var
+ aSign : flag;
+ aExp, shiftCount : smallint;
+ aSig : int64;
+ z : int64;
+ begin
+ aSig:=extractFloat64Frac(a);
+ aExp:=extractFloat64Exp(a);
+ aSign:=extractFloat64Sign(a);
+ if aExp<>0 then
+ aSig:=aSig or $0010000000000000;
+ shiftCount:= aExp-$433;
+ if 0<=shiftCount then
+ begin
+ if aExp>=$43e then
+ begin
+ if int64(a)<>$C3E0000000000000 then
+ HandleError(207);
+ { pascal doesn't know Inf for int64 }
+ HandleError(207);
+ end;
+ z:=aSig shl shiftCount;
+ end
+ else
+ begin
+ if aExp<$3fe then
+ begin
+ result:=0;
+ exit;
+ end;
+ z:=aSig shr -shiftCount;
+ {
+ if (aSig shl (shiftCount and 63))<>0 then
+ float_exception_flags |= float_flag_inexact;
+ }
+ end;
+ if aSign<>0 then
+ z:=-z;
+ result:=z;
+ end;
+{$endif VER1_0}
+
+ Function ExtractFloat32Frac(a : Float32) : longint;
+ Begin
+ ExtractFloat32Frac := A AND $007FFFFF;
+ End;
+
+
+ Function extractFloat32Exp( a: float32 ): smallint;
+ Begin
+ extractFloat32Exp := (a shr 23) AND $FF;
+ End;
+
+
+ Function extractFloat32Sign( a: float32 ): Flag;
+ Begin
+ extractFloat32Sign := a shr 31;
+ End;
+
+
+ Function float32_to_int32_round_to_zero( a: Float32 ): longint;
+ Var
+ aSign : flag;
+ aExp, shiftCount : smallint;
+ aSig : longint;
+ z : longint;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ shiftCount := aExp - $9E;
+ if ( 0 <= shiftCount ) then
+ Begin
+ if ( a <> Float32($CF000000) ) then
+ Begin
+ if ( (aSign=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then
+ Begin
+ HandleError(207);
+ exit;
+ end;
+ End;
+ HandleError(207);
+ exit;
+ End
+ else
+ if ( aExp <= $7E ) then
+ Begin
+ float32_to_int32_round_to_zero := 0;
+ exit;
+ End;
+ aSig := ( aSig or $00800000 ) shl 8;
+ z := aSig shr ( - shiftCount );
+ if ( aSign<>0 ) then z := - z;
+ float32_to_int32_round_to_zero := z;
+ End;
+
+
+{$ifdef INTERNCONSTINTF}
+ function fpc_trunc_real(d : real) : int64;compilerproc;
+{$else}
+ function trunc(d : real) : int64;[internconst:fpc_in_const_trunc];
+{$endif}
+ var
+{$ifdef cpuarm}
+ l: longint;
+{$endif cpuarm}
+ f32 : float32;
+ f64 : float64;
+ Begin
+ { in emulation mode the real is equal to a single }
+ { otherwise in fpu mode, it is equal to a double }
+ { extended is not supported yet. }
+ if sizeof(D) > 8 then
+ HandleError(255);
+ if sizeof(D)=8 then
+ begin
+ move(d,f64,sizeof(f64));
+{$ifdef cpuarm}
+ { the arm fpu has a strange opinion how a double has to be stored }
+ l:=f64.low;
+ f64.low:=f64.high;
+ f64.high:=l;
+{$endif cpuarm}
+{$ifdef VER1_0}
+ result:=float64_to_int32_round_to_zero(f64);
+{$else VER1_0}
+ result:=float64_to_int64_round_to_zero(f64);
+{$endif VER1_0}
+ end
+ else
+ begin
+ move(d,f32,sizeof(f32));
+ result:=float32_to_int32_round_to_zero(f32);
+ end;
+ end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_INT}
+
+{$ifdef SUPPORT_DOUBLE}
+
+ { straight Pascal translation of the code for __trunc() in }
+ { the file sysdeps/libm-ieee754/s_trunc.c of glibc (JM) }
+{$ifdef INTERNCONSTINTF}
+ function fpc_int_real(d: double): double;compilerproc;
+{$else}
+ function int(d: double): double;[internconst:fpc_in_const_int];
+{$endif}
+ var
+ i0, j0: longint;
+ i1: cardinal;
+ sx: longint;
+ f64 : float64;
+ begin
+ f64:=float64(d);
+{$ifdef cpuarm}
+ { the arm fpu has a strange opinion how a double has to be stored }
+ i0:=f64.low;
+ f64.low:=f64.high;
+ f64.high:=i0;
+{$endif cpuarm}
+ i0 := f64.high;
+ i1 := cardinal(f64.low);
+ sx := i0 and $80000000;
+ j0 := ((i0 shr 20) and $7ff) - $3ff;
+ if (j0 < 20) then
+ begin
+ if (j0 < 0) then
+ begin
+ { the magnitude of the number is < 1 so the result is +-0. }
+ f64.high := sx;
+ f64.low := 0;
+ end
+ else
+ begin
+ f64.high := sx or (i0 and not($fffff shr j0));
+ f64.low := 0;
+ end
+ end
+ else if (j0 > 51) then
+ begin
+ if (j0 = $400) then
+ { d is inf or NaN }
+ exit(d + d); { don't know why they do this (JM) }
+ end
+ else
+ begin
+ f64.high := i0;
+ f64.low := longint(i1 and not(cardinal($ffffffff) shr (j0 - 20)));
+ end;
+{$ifdef cpuarm}
+ { the arm fpu has a strange opinion how a double has to be stored }
+ i0:=f64.low;
+ f64.low:=f64.high;
+ f64.high:=i0;
+{$endif cpuarm}
+ result:=double(f64);
+ end;
+
+{$else SUPPORT_DOUBLE}
+
+{$ifdef INTERNCONSTINTF}
+ function fpc_int_real(d : real) : real;compilerproc;
+{$else}
+ function int(d : real) : real;[internconst:fpc_in_const_int];
+{$endif}
+ begin
+ { this will be correct since real = single in the case of }
+ { the motorola version of the compiler... }
+ result:=real(trunc(d));
+ end;
+{$endif SUPPORT_DOUBLE}
+
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_ABS}
+
+{$ifdef SUPPORT_DOUBLE}
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_abs_real(d : Double) : Double;compilerproc;
+ {$else}
+ function abs(d : Double) : Double;[public,alias:'FPC_ABS_REAL'];
+ {$endif}
+ begin
+ if (d<0.0) then
+ result := -d
+ else
+ result := d ;
+ end;
+
+{$else}
+
+ {$ifdef INTERNCONSTINTF}
+ function fpc_abs_real(d : Double) : Double;compilerproc;
+ {$else}
+ function abs(d : Real) : Real;[public,alias:'FPC_ABS_REAL'];
+ {$endif}
+ begin
+ if (d<0.0) then
+ result := -d
+ else
+ result := d ;
+ end;
+
+{$endif}
+
+{$ifndef INTERNCONSTINTF}
+ {$ifdef hascompilerproc}
+ function fpc_abs_real(d:Real):Real;compilerproc; external name 'FPC_ABS_REAL';
+ {$endif hascompilerproc}
+{$endif}
+
+{$endif not FPC_SYSTEM_HAS_ABS}
+
+
+{$ifndef SYSTEM_HAS_FREXP}
+ function frexp(x:Real; var e:Integer ):Real;
+ {* frexp() extracts the exponent from x. It returns an integer *}
+ {* power of two to expnt and the significand between 0.5 and 1 *}
+ {* to y. Thus x = y * 2**expn. *}
+ begin
+ e :=0;
+ if (abs(x)<0.5) then
+ While (abs(x)<0.5) do
+ begin
+ x := x*2;
+ Dec(e);
+ end
+ else
+ While (abs(x)>1) do
+ begin
+ x := x/2;
+ Inc(e);
+ end;
+ frexp := x;
+ end;
+{$endif not SYSTEM_HAS_FREXP}
+
+
+{$ifndef SYSTEM_HAS_LDEXP}
+ function ldexp( x: Real; N: Integer):Real;
+ {* ldexp() multiplies x by 2**n. *}
+ var r : Real;
+ begin
+ R := 1;
+ if N>0 then
+ while N>0 do
+ begin
+ R:=R*2;
+ Dec(N);
+ end
+ else
+ while N<0 do
+ begin
+ R:=R/2;
+ Inc(N);
+ end;
+ ldexp := x * R;
+ end;
+{$endif not SYSTEM_HAS_LDEXP}
+
+
+ function polevl(var x:Real; var Coef:TabCoef; N:Integer):Real;
+ {*****************************************************************}
+ { Evaluate polynomial }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { int N; }
+ { double x, y, coef[N+1], polevl[]; }
+ { }
+ { y = polevl( x, coef, N ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Evaluates polynomial of degree N: }
+ { }
+ { 2 N }
+ { y = C + C x + C x +...+ C x }
+ { 0 1 2 N }
+ { }
+ { Coefficients are stored in reverse order: }
+ { }
+ { coef[0] = C , ..., coef[N] = C . }
+ { N 0 }
+ { }
+ { The function p1evl() assumes that coef[N] = 1.0 and is }
+ { omitted from the array. Its calling arguments are }
+ { otherwise the same as polevl(). }
+ { }
+ { SPEED: }
+ { }
+ { In the interest of speed, there are no checks for out }
+ { of bounds arithmetic. This routine is used by most of }
+ { the functions in the library. Depending on available }
+ { equipment features, the user may wish to rewrite the }
+ { program in microcode or assembly language. }
+ {*****************************************************************}
+ var ans : Real;
+ i : Integer;
+
+ begin
+ ans := Coef[0];
+ for i:=1 to N do
+ ans := ans * x + Coef[i];
+ polevl:=ans;
+ end;
+
+
+ function p1evl(var x:Real; var Coef:TabCoef; N:Integer):Real;
+ { }
+ { Evaluate polynomial when coefficient of x is 1.0. }
+ { Otherwise same as polevl. }
+ { }
+ var
+ ans : Real;
+ i : Integer;
+ begin
+ ans := x + Coef[0];
+ for i:=1 to N-1 do
+ ans := ans * x + Coef[i];
+ p1evl := ans;
+ end;
+
+
+{$ifndef FPC_SYSTEM_HAS_SQR}
+{$ifdef INTERNCONSTINTF}
+ function fpc_sqr_real(d : Real) : Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+{$else}
+ function sqr(d : Real) : Real;[internconst:fpc_in_const_sqr];
+{$endif}
+ begin
+ result := d*d;
+ end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_PI}
+{$ifdef INTERNCONSTINTF}
+ function fpc_pi_real : Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+{$else}
+ function pi : Real;[internconst:fpc_in_const_pi];
+{$endif}
+ begin
+ result := 3.1415926535897932385;
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_SQRT}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_sqrt_real(d:Real):Real;compilerproc;
+ {$else}
+ {$ifdef hascompilerproc}
+ function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
+ {$endif hascompilerproc}
+ function sqrt(d:Real):Real;[internconst:fpc_in_const_sqrt];[public, alias: 'FPC_SQRT_REAL'];
+ {$endif}
+ {*****************************************************************}
+ { Square root }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, sqrt(); }
+ { }
+ { y = sqrt( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns the square root of x. }
+ { }
+ { Range reduction involves isolating the power of two of the }
+ { argument and using a polynomial approximation to obtain }
+ { a rough value for the square root. Then Heron's iteration }
+ { is used three times to converge to an accurate value. }
+ {*****************************************************************}
+ var e : Integer;
+ w,z : Real;
+ begin
+ if( d <= 0.0 ) then
+ begin
+ if( d < 0.0 ) then
+ HandleError(207);
+ result := 0.0;
+ end
+ else
+ begin
+ w := d;
+ { separate exponent and significand }
+ z := frexp( d, e );
+
+ { approximate square root of number between 0.5 and 1 }
+ { relative error of approximation = 7.47e-3 }
+ d := 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z;
+
+ { adjust for odd powers of 2 }
+ if odd(e) then
+ d := d*SQRT2;
+
+ { re-insert exponent }
+ d := ldexp( d, (e div 2) );
+
+ { Newton iterations: }
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ result := d;
+ end;
+ end;
+
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_EXP}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_exp_real(d:Real):Real;compilerproc;
+ {$else}
+ function Exp(d:Real):Real;[internconst:fpc_in_const_exp];
+ {$endif}
+ {*****************************************************************}
+ { Exponential Function }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, exp(); }
+ { }
+ { y = exp( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns e (2.71828...) raised to the x power. }
+ { }
+ { Range reduction is accomplished by separating the argument }
+ { into an integer k and fraction f such that }
+ { }
+ { x k f }
+ { e = 2 e. }
+ { }
+ { A Pade' form of degree 2/3 is used to approximate exp(f)- 1 }
+ { in the basic range [-0.5 ln 2, 0.5 ln 2]. }
+ {*****************************************************************}
+ const P : TabCoef = (
+ 1.26183092834458542160E-4,
+ 3.02996887658430129200E-2,
+ 1.00000000000000000000E0, 0, 0, 0, 0);
+ Q : TabCoef = (
+ 3.00227947279887615146E-6,
+ 2.52453653553222894311E-3,
+ 2.27266044198352679519E-1,
+ 2.00000000000000000005E0, 0 ,0 ,0);
+
+ C1 = 6.9335937500000000000E-1;
+ C2 = 2.1219444005469058277E-4;
+ var n : Integer;
+ px, qx, xx : Real;
+ begin
+ if( d > MAXLOG) then
+ HandleError(205)
+ else
+ if( d < MINLOG ) then
+ begin
+ HandleError(205);
+ end
+ else
+ begin
+
+ { Express e**x = e**g 2**n }
+ { = e**g e**( n loge(2) ) }
+ { = e**( g + n loge(2) ) }
+
+ px := d * LOG2E;
+ qx := Trunc( px + 0.5 ); { Trunc() truncates toward -infinity. }
+ n := Trunc(qx);
+ d := d - qx * C1;
+ d := d + qx * C2;
+
+ { rational approximation for exponential }
+ { of the fractional part: }
+ { e**x - 1 = 2x P(x**2)/( Q(x**2) - P(x**2) ) }
+ xx := d * d;
+ px := d * polevl( xx, P, 2 );
+ d := px/( polevl( xx, Q, 3 ) - px );
+ d := ldexp( d, 1 );
+ d := d + 1.0;
+ d := ldexp( d, n );
+ result := d;
+ end;
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_ROUND}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_round_real(d : Real) : int64;compilerproc;
+ {$else}
+ {$ifdef hascompilerproc}
+ function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif} external name 'FPC_ROUND';
+ function fpc_round(d : Real) : int64;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+ {$else}
+ function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
+ {$endif hascompilerproc}
+ {$endif}
+ var
+ fr: Real;
+ tr: Int64;
+ Begin
+ fr := abs(Frac(d));
+ tr := Trunc(d);
+ if fr > 0.5 then
+ if d >= 0 then
+ result:=tr+1
+ else
+ result:=tr-1
+ else
+ if fr < 0.5 then
+ result:=tr
+ else { fr = 0.5 }
+ { check sign to decide ... }
+ { as in Turbo Pascal... }
+ if d >= 0.0 then
+ result:=tr+1
+ else
+ result:=tr;
+ end;
+{$endif}
+
+
+{$ifdef FPC_CURRENCY_IS_INT64}
+
+ function trunc(c : currency) : int64;
+ type
+ tmyrec = record
+ i: int64;
+ end;
+ begin
+ result := int64(tmyrec(c)) div 10000
+ end;
+
+
+ function trunc(c : comp) : int64;
+ begin
+ result := c
+ end;
+
+
+ function round(c : currency) : int64;
+ type
+ tmyrec = record
+ i: int64;
+ end;
+ var
+ rem, absrem: longint;
+ begin
+ { (int64(tmyrec(c))(+/-)5000) div 10000 can overflow }
+ result := int64(tmyrec(c)) div 10000;
+ rem := int64(tmyrec(c)) - result * 10000;
+ absrem := abs(rem);
+ if (absrem > 5000) or
+ ((absrem = 5000) and
+ (rem > 0)) then
+ if (rem > 0) then
+ inc(result)
+ else
+ dec(result);
+ end;
+
+
+ function round(c : comp) : int64;
+ begin
+ result := c
+ end;
+
+{$endif FPC_CURRENCY_IS_INT64}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_LN}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_ln_real(d:Real):Real;compilerproc;
+ {$else}
+ function Ln(d:Real):Real;[internconst:fpc_in_const_ln];
+ {$endif}
+ {*****************************************************************}
+ { Natural Logarithm }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, log(); }
+ { }
+ { y = ln( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns the base e (2.718...) logarithm of x. }
+ { }
+ { The argument is separated into its exponent and fractional }
+ { parts. If the exponent is between -1 and +1, the logarithm }
+ { of the fraction is approximated by }
+ { }
+ { log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). }
+ { }
+ { Otherwise, setting z = 2(x-1)/x+1), }
+ { }
+ { log(x) = z + z**3 P(z)/Q(z). }
+ { }
+ {*****************************************************************}
+ const P : TabCoef = (
+ { Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ 1/sqrt(2) <= x < sqrt(2) }
+
+ 4.58482948458143443514E-5,
+ 4.98531067254050724270E-1,
+ 6.56312093769992875930E0,
+ 2.97877425097986925891E1,
+ 6.06127134467767258030E1,
+ 5.67349287391754285487E1,
+ 1.98892446572874072159E1);
+ Q : TabCoef = (
+ 1.50314182634250003249E1,
+ 8.27410449222435217021E1,
+ 2.20664384982121929218E2,
+ 3.07254189979530058263E2,
+ 2.14955586696422947765E2,
+ 5.96677339718622216300E1, 0);
+
+ { Coefficients for log(x) = z + z**3 P(z)/Q(z),
+ where z = 2(x-1)/(x+1)
+ 1/sqrt(2) <= x < sqrt(2) }
+
+ R : TabCoef = (
+ -7.89580278884799154124E-1,
+ 1.63866645699558079767E1,
+ -6.41409952958715622951E1, 0, 0, 0, 0);
+ S : TabCoef = (
+ -3.56722798256324312549E1,
+ 3.12093766372244180303E2,
+ -7.69691943550460008604E2, 0, 0, 0, 0);
+
+ var e : Integer;
+ z, y : Real;
+
+ Label Ldone;
+ begin
+ if( d <= 0.0 ) then
+ HandleError(207);
+ d := frexp( d, e );
+
+ { logarithm using log(x) = z + z**3 P(z)/Q(z),
+ where z = 2(x-1)/x+1) }
+
+ if( (e > 2) or (e < -2) ) then
+ begin
+ if( d < SQRTH ) then
+ begin
+ { 2( 2x-1 )/( 2x+1 ) }
+ Dec(e, 1);
+ z := d - 0.5;
+ y := 0.5 * z + 0.5;
+ end
+ else
+ begin
+ { 2 (x-1)/(x+1) }
+ z := d - 0.5;
+ z := z - 0.5;
+ y := 0.5 * d + 0.5;
+ end;
+ d := z / y;
+ { /* rational form */ }
+ z := d*d;
+ z := d + d * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) );
+ goto ldone;
+ end;
+
+ { logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) }
+
+ if( d < SQRTH ) then
+ begin
+ Dec(e, 1);
+ d := ldexp( d, 1 ) - 1.0; { 2x - 1 }
+ end
+ else
+ d := d - 1.0;
+
+ { rational form }
+ z := d*d;
+ y := d * ( z * polevl( d, P, 6 ) / p1evl( d, Q, 6 ) );
+ y := y - ldexp( z, -1 ); { y - 0.5 * z }
+ z := d + y;
+
+ ldone:
+ { recombine with exponent term }
+ if( e <> 0 ) then
+ begin
+ y := e;
+ z := z - y * 2.121944400546905827679e-4;
+ z := z + y * 0.693359375;
+ end;
+
+ result:= z;
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_SIN}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_Sin_real(d:Real):Real;compilerproc;
+ {$else}
+ function Sin(d:Real):Real;[internconst:fpc_in_const_sin];
+ {$endif}
+ {*****************************************************************}
+ { Circular Sine }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, sin(); }
+ { }
+ { y = sin( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Range reduction is into intervals of pi/4. The reduction }
+ { error is nearly eliminated by contriving an extended }
+ { precision modular arithmetic. }
+ { }
+ { Two polynomial approximating functions are employed. }
+ { Between 0 and pi/4 the sine is approximated by }
+ { x + x**3 P(x**2). }
+ { Between pi/4 and pi/2 the cosine is represented as }
+ { 1 - x**2 Q(x**2). }
+ {*****************************************************************}
+ var y, z, zz : Real;
+ j, sign : Integer;
+
+ begin
+ { make argument positive but save the sign }
+ sign := 1;
+ if( d < 0 ) then
+ begin
+ d := -d;
+ sign := -1;
+ end;
+
+ { above this value, approximate towards 0 }
+ if( d > lossth ) then
+ begin
+ result := 0.0;
+ exit;
+ end;
+
+ y := Trunc( d/PIO4 ); { integer part of x/PIO4 }
+
+ { strip high bits of integer part to prevent integer overflow }
+ z := ldexp( y, -4 );
+ z := Trunc(z); { integer part of y/8 }
+ z := y - ldexp( z, 4 ); { y - 16 * (y/16) }
+
+ j := Trunc(z); { convert to integer for tests on the phase angle }
+ { map zeros to origin }
+ { typecast is to avoid "can't determine which overloaded function }
+ { to call" }
+ if odd( longint(j) ) then
+ begin
+ inc(j);
+ y := y + 1.0;
+ end;
+ j := j and 7; { octant modulo 360 degrees }
+ { reflect in x axis }
+ if( j > 3) then
+ begin
+ sign := -sign;
+ dec(j, 4);
+ end;
+
+ { Extended precision modular arithmetic }
+ z := ((d - y * DP1) - y * DP2) - y * DP3;
+
+ zz := z * z;
+
+ if( (j=1) or (j=2) ) then
+ y := 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 )
+ else
+ { y = z + z * (zz * polevl( zz, sincof, 5 )); }
+ y := z + z * z * z * polevl( zz, sincof, 5 );
+
+ if(sign < 0) then
+ y := -y;
+ result := y;
+ end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_COS}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_Cos_real(d:Real):Real;compilerproc;
+ {$else}
+ function Cos(d:Real):Real;[internconst:fpc_in_const_cos];
+ {$endif}
+ {*****************************************************************}
+ { Circular cosine }
+ {*****************************************************************}
+ { }
+ { Circular cosine }
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, cos(); }
+ { }
+ { y = cos( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Range reduction is into intervals of pi/4. The reduction }
+ { error is nearly eliminated by contriving an extended }
+ { precision modular arithmetic. }
+ { }
+ { Two polynomial approximating functions are employed. }
+ { Between 0 and pi/4 the cosine is approximated by }
+ { 1 - x**2 Q(x**2). }
+ { Between pi/4 and pi/2 the sine is represented as }
+ { x + x**3 P(x**2). }
+ {*****************************************************************}
+ var y, z, zz : Real;
+ j, sign : Integer;
+ i : LongInt;
+ begin
+ { make argument positive }
+ sign := 1;
+ if( d < 0 ) then
+ d := -d;
+
+ { above this value, round towards zero }
+ if( d > lossth ) then
+ begin
+ result := 0.0;
+ exit;
+ end;
+
+ y := Trunc( d/PIO4 );
+ z := ldexp( y, -4 );
+ z := Trunc(z); { integer part of y/8 }
+ z := y - ldexp( z, 4 ); { y - 16 * (y/16) }
+
+ { integer and fractional part modulo one octant }
+ i := Trunc(z);
+ if odd( i ) then { map zeros to origin }
+ begin
+ inc(i);
+ y := y + 1.0;
+ end;
+ j := i and 07;
+ if( j > 3) then
+ begin
+ dec(j,4);
+ sign := -sign;
+ end;
+ if( j > 1 ) then
+ sign := -sign;
+
+ { Extended precision modular arithmetic }
+ z := ((d - y * DP1) - y * DP2) - y * DP3;
+
+ zz := z * z;
+
+ if( (j=1) or (j=2) ) then
+ { y = z + z * (zz * polevl( zz, sincof, 5 )); }
+ y := z + z * z * z * polevl( zz, sincof, 5 )
+ else
+ y := 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 );
+
+ if(sign < 0) then
+ y := -y;
+
+ result := y ;
+ end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_ARCTAN}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_ArcTan_real(d:Real):Real;compilerproc;
+ {$else}
+ function ArcTan(d:Real):Real;[internconst:fpc_in_const_arctan];
+ {$endif}
+ {*****************************************************************}
+ { Inverse circular tangent (arctangent) }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, atan(); }
+ { }
+ { y = atan( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns radian angle between -pi/2 and +pi/2 whose tangent }
+ { is x. }
+ { }
+ { Range reduction is from four intervals into the interval }
+ { from zero to tan( pi/8 ). The approximant uses a rational }
+ { function of degree 3/4 of the form x + x**3 P(x)/Q(x). }
+ {*****************************************************************}
+ const P : TabCoef = (
+ -8.40980878064499716001E-1,
+ -8.83860837023772394279E0,
+ -2.18476213081316705724E1,
+ -1.48307050340438946993E1, 0, 0, 0);
+ Q : TabCoef = (
+ 1.54974124675307267552E1,
+ 6.27906555762653017263E1,
+ 9.22381329856214406485E1,
+ 4.44921151021319438465E1, 0, 0, 0);
+
+ { tan( 3*pi/8 ) }
+ T3P8 = 2.41421356237309504880;
+ { tan( pi/8 ) }
+ TP8 = 0.41421356237309504880;
+
+ var y,z : Real;
+ Sign : Integer;
+
+ begin
+ { make argument positive and save the sign }
+ sign := 1;
+ if( d < 0.0 ) then
+ begin
+ sign := -1;
+ d := -d;
+ end;
+
+ { range reduction }
+ if( d > T3P8 ) then
+ begin
+ y := PIO2;
+ d := -( 1.0/d );
+ end
+ else if( d > TP8 ) then
+ begin
+ y := PIO4;
+ d := (d-1.0)/(d+1.0);
+ end
+ else
+ y := 0.0;
+
+ { rational form in x**2 }
+
+ z := d * d;
+ y := y + ( polevl( z, P, 3 ) / p1evl( z, Q, 4 ) ) * z * d + d;
+
+ if( sign < 0 ) then
+ y := -y;
+ result := y;
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FRAC}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_frac_real(d : Real) : Real;compilerproc;
+ {$else}
+ function frac(d : Real) : Real;[internconst:fpc_in_const_frac];
+ {$endif}
+ begin
+ result := d - Int(d);
+ end;
+{$endif}
+
+
+{$ifdef FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+
+{$ifndef FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
+function fpc_qword_to_double(q : qword): double; compilerproc;
+ begin
+ result:=dword(q and $ffffffff)+dword(q shr 32)*4294967296.0;
+ end;
+{$endif FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
+
+
+{$ifndef FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
+function fpc_int64_to_double(i : int64): double; compilerproc;
+ begin
+ if i<0 then
+ result:=-double(qword(-i))
+ else
+ result:=qword(i);
+ end;
+{$endif FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
+
+{$endif FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+
+
+{$ifdef SUPPORT_DOUBLE}
+{****************************************************************************
+ Helper routines to support old TP styled reals
+ ****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_REAL2DOUBLE}
+ function real2double(r : real48) : double;
+
+ var
+ res : array[0..7] of byte;
+ exponent : word;
+
+ begin
+ { copy mantissa }
+ res[0]:=0;
+ res[1]:=r[1] shl 5;
+ res[2]:=(r[1] shr 3) or (r[2] shl 5);
+ res[3]:=(r[2] shr 3) or (r[3] shl 5);
+ res[4]:=(r[3] shr 3) or (r[4] shl 5);
+ res[5]:=(r[4] shr 3) or (r[5] and $7f) shl 5;
+ res[6]:=(r[5] and $7f) shr 3;
+
+ { copy exponent }
+ { correct exponent: }
+ exponent:=(word(r[0])+(1023-129));
+ res[6]:=res[6] or ((exponent and $f) shl 4);
+ res[7]:=exponent shr 4;
+
+ { set sign }
+ res[7]:=res[7] or (r[5] and $80);
+ real2double:=double(res);
+ end;
+{$endif FPC_SYSTEM_HAS_REAL2DOUBLE}
+{$endif SUPPORT_DOUBLE}
+
+{
+ $Log: genmath.inc,v $
+ Revision 1.32 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.31 2005/02/08 20:25:28 florian
+ - killed power from system unit
+ * move operator ** to math unit
+
+}
diff --git a/rtl/inc/genset.inc b/rtl/inc/genset.inc
new file mode 100644
index 0000000000..07dfeb9da4
--- /dev/null
+++ b/rtl/inc/genset.inc
@@ -0,0 +1,277 @@
+{
+ $Id: genset.inc,v 1.9 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team
+
+ Include file with set operations called by the compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
+{ Error No pascal version of FPC_SET_LOAD_SMALL}
+ { THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE!
+ Not anymore PM}
+
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; [public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ {
+ load a normal set p from a smallset l
+ }
+ begin
+ fpc_set_load_small[0] := l;
+ FillDWord(fpc_set_load_small[1],7,0);
+ end;
+{$endif FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+function fpc_set_create_element(b : byte): fpc_normal_set;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ {
+ create a new set in p from an element b
+ }
+ begin
+ FillDWord(fpc_set_create_element,SizeOf(fpc_set_create_element) div 4,0);
+ fpc_set_create_element[b div 32] := 1 shl (b mod 32);
+ end;
+{$endif FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+
+{$ifdef hascompilerproc}
+ function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+ {
+ add the element b to the set "source"
+ }
+ var
+ c: longint;
+ begin
+ move(source,fpc_set_set_byte,sizeof(source));
+ c := fpc_set_set_byte[b div 32];
+ c := (1 shl (b mod 32)) or c;
+ fpc_set_set_byte[b div 32] := c;
+ end;
+{$else hascompilerproc}
+ procedure do_set_byte(p : pointer;b : byte);[public,alias:'FPC_SET_SET_BYTE'];
+ {
+ add the element b to the set pointed by p
+ }
+ var
+ c: longint;
+ begin
+ c := fpc_normal_set(p^)[b div 32];
+ c := (1 shl (b mod 32)) or c;
+ fpc_normal_set(p^)[b div 32] := c;
+ end;
+{$endif hascompilerproc}
+{$endif FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+
+{$ifdef hascompilerproc}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
+ {
+ suppresses the element b to the set pointed by p
+ used for exclude(set,element)
+ }
+ var
+ c: longint;
+ begin
+ move(source,fpc_set_unset_byte,sizeof(source));
+ c := fpc_set_unset_byte[b div 32];
+ c := c and not (1 shl (b mod 32));
+ fpc_set_unset_byte[b div 32] := c;
+ end;
+{$else hascompilerproc}
+procedure do_unset_byte(p : pointer;b : byte);[public,alias:'FPC_SET_UNSET_BYTE'];
+ {
+ suppresses the element b to the set pointed by p
+ used for exclude(set,element)
+ }
+ var
+ c: longint;
+ begin
+ c := fpc_normal_set(p^)[b div 32];
+ c := c and not (1 shl (b mod 32));
+ fpc_normal_set(p^)[b div 32] := c;
+ end;
+{$endif hascompilerproc}
+{$endif FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+{$ifdef hascompilerproc}
+ function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
+ {
+ adds the range [l..h] to the set orgset
+ }
+ var
+ i: integer;
+ c: longint;
+ begin
+ move(orgset,fpc_set_set_range,sizeof(orgset));
+ for i:=l to h do
+ begin
+ c := fpc_set_set_range[i div 32];
+ c := (1 shl (i mod 32)) or c;
+ fpc_set_set_range[i div 32] := c;
+ end;
+ end;
+{$else hascompilerproc}
+ procedure do_set_range(p : pointer;l,h : byte);[public,alias:'FPC_SET_SET_RANGE'];
+ {
+ bad implementation, but it's very seldom used
+ }
+ var
+ i: integer;
+ c: longint;
+ begin
+ for i:=l to h do
+ begin
+ c := fpc_normal_set(p^)[i div 32];
+ c := (1 shl (i mod 32)) or c;
+ fpc_normal_set(p^)[i div 32] := c;
+ end;
+ end;
+{$endif hascompilerproc}
+{$endif ndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
+
+ function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; [public,alias:'FPC_SET_IN_BYTE']; {$ifdef hascompilerproc} compilerproc; {$else} {$ifndef NOSAVEREGISTERS}saveregisters;{$endif} {$endif}
+ {
+ tests if the element b is in the set p the carryflag is set if it present
+ }
+ begin
+ fpc_set_in_byte := (p[b div 32] and (1 shl (b mod 32))) <> 0;
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
+{$ifdef hascompilerproc}
+ function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+ var
+ dest: fpc_normal_set absolute fpc_set_add_sets;
+{$else hascompilerproc}
+ procedure do_add_sets(const set1,set2: fpc_normal_Set; var dest : fpc_normal_set);[public,alias:'FPC_SET_ADD_SETS'];
+{$endif hascompilerproc}
+ {
+ adds set1 and set2 into set dest
+ }
+ var
+ i: integer;
+ begin
+ for i:=0 to 7 do
+ dest[i] := set1[i] or set2[i];
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
+{$ifdef hascompilerproc}
+ function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+ var
+ dest: fpc_normal_set absolute fpc_set_mul_sets;
+{$else hascompilerproc}
+ procedure do_mul_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_MUL_SETS'];
+{$endif hascompilerproc}
+ {
+ multiplies (takes common elements of) set1 and set2 result put in dest
+ }
+ var
+ i: integer;
+ begin
+ for i:=0 to 7 do
+ dest[i] := set1[i] and set2[i];
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
+{$ifdef hascompilerproc}
+ function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+ var
+ dest: fpc_normal_set absolute fpc_set_sub_sets;
+{$else hascompilerproc}
+ procedure do_sub_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_SUB_SETS'];
+{$endif hascompilerproc}
+ {
+ computes the diff from set1 to set2 result in dest
+ }
+ var
+ i: integer;
+ begin
+ for i:=0 to 7 do
+ dest[i] := set1[i] and not set2[i];
+ end;
+{$endif}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
+{$ifdef hascompilerproc}
+ function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+ var
+ dest: fpc_normal_set absolute fpc_set_symdif_sets;
+{$else hascompilerproc}
+ procedure do_symdif_sets(const set1,set2: fpc_normal_set; var dest: fpc_normal_set);[public,alias:'FPC_SET_SYMDIF_SETS'];
+{$endif hascompilerproc}
+ {
+ computes the symetric diff from set1 to set2 result in dest
+ }
+ var
+ i: integer;
+ begin
+ for i:=0 to 7 do
+ dest[i] := set1[i] xor set2[i];
+ end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
+ function fpc_set_comp_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'FPC_SET_COMP_SETS'];{$ifdef hascompilerproc} compilerproc; {$else} {$ifndef NOSAVEREGISTERS}saveregisters;{$endif} {$endif}
+ {
+ compares set1 and set2 zeroflag is set if they are equal
+ }
+ var
+ i: integer;
+ begin
+ fpc_set_comp_sets:= false;
+ for i:=0 to 7 do
+ if set1[i] <> set2[i] then
+ exit;
+ fpc_set_comp_sets:= true;
+ end;
+{$endif}
+
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
+ function fpc_set_contains_sets(const set1,set2 : fpc_normal_set):boolean;[public,alias:'FPC_SET_CONTAINS_SETS'];{$ifdef hascompilerproc} compilerproc; {$else} saveregisters; {$endif}
+ {
+ on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+ }
+ var
+ i : integer;
+ begin
+ fpc_set_contains_sets:= false;
+ for i:=0 to 7 do
+ if (set1[i] and not set2[i]) <> 0 then
+ exit;
+ fpc_set_contains_sets:= true;
+ end;
+{$endif}
+
+{
+ $Log: genset.inc,v $
+ Revision 1.9 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
+
diff --git a/rtl/inc/genstr.inc b/rtl/inc/genstr.inc
new file mode 100644
index 0000000000..4d252325b6
--- /dev/null
+++ b/rtl/inc/genstr.inc
@@ -0,0 +1,274 @@
+{
+ $Id: genstr.inc,v 1.5 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl-Eric Codere,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef FPC_UNIT_HAS_STREND}
+ Function StrEnd(P: PChar): PChar;
+ var
+ counter: SizeInt;
+ begin
+ counter := 0;
+ while P[counter] <> #0 do
+ Inc(counter);
+ StrEnd := @(P[Counter]);
+ end;
+{$endif FPC_UNIT_HAS_STREND}
+
+
+{$ifndef FPC_UNIT_HAS_STRCOPY}
+ Function StrCopy(Dest, Source:PChar): PChar;
+ var
+ counter : SizeInt;
+ Begin
+ counter := 0;
+ while Source[counter] <> #0 do
+ begin
+ Dest[counter] := char(Source[counter]);
+ Inc(counter);
+ end;
+ { terminate the string }
+ Dest[counter] := #0;
+ StrCopy := Dest;
+ end;
+{$endif FPC_UNIT_HAS_STRCOPY}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRUPPER}
+ function StrUpper(P: PChar): PChar;
+ var
+ counter: SizeInt;
+ begin
+ counter := 0;
+ while (P[counter] <> #0) do
+ begin
+ if P[Counter] in [#97..#122,#128..#255] then
+ P[counter] := Upcase(P[counter]);
+ Inc(counter);
+ end;
+ StrUpper := P;
+ end;
+{$endif FPC_UNIT_HAS_STRUPPER}
+
+
+{$ifndef FPC_UNIT_HAS_STRLOWER}
+ function StrLower(P: PChar): PChar;
+ var
+ counter: SizeInt;
+ begin
+ counter := 0;
+ while (P[counter] <> #0) do
+ begin
+ if P[counter] in [#65..#90] then
+ P[Counter] := chr(ord(P[Counter]) + 32);
+ Inc(counter);
+ end;
+ StrLower := P;
+ end;
+{$endif FPC_UNIT_HAS_STRLOWER}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRSCAN}
+ function StrScan(P: PChar; C: Char): PChar;
+ Var
+ count: SizeInt;
+ Begin
+
+ count := 0;
+ { As in Borland Pascal , if looking for NULL return null }
+ if C = #0 then
+ begin
+ StrScan := @(P[StrLen(P)]);
+ exit;
+ end;
+ { Find first matching character of Ch in Str }
+ while P[count] <> #0 do
+ begin
+ if C = P[count] then
+ begin
+ StrScan := @(P[count]);
+ exit;
+ end;
+ Inc(count);
+ end;
+ { nothing found. }
+ StrScan := nil;
+ end;
+{$endif FPC_UNIT_HAS_STRSCAN}
+
+
+
+{$ifndef FPC_UNIT_HAS_STRRSCAN}
+ function StrRScan(P: PChar; C: Char): PChar;
+ Var
+ count: SizeInt;
+ index: SizeInt;
+ Begin
+ count := Strlen(P);
+ { As in Borland Pascal , if looking for NULL return null }
+ if C = #0 then
+ begin
+ StrRScan := @(P[count]);
+ exit;
+ end;
+ Dec(count);
+ for index := count downto 0 do
+ begin
+ if C = P[index] then
+ begin
+ StrRScan := @(P[index]);
+ exit;
+ end;
+ end;
+ { nothing found. }
+ StrRScan := nil;
+ end;
+{$endif FPC_UNIT_HAS_STRRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRECOPY}
+ Function StrECopy(Dest, Source: PChar): PChar;
+ { Equivalent to the following: }
+ { strcopy(Dest,Source); }
+ { StrECopy := StrEnd(Dest); }
+ var
+ counter : SizeInt;
+ Begin
+ counter := 0;
+ while Source[counter] <> #0 do
+ begin
+ Dest[counter] := char(Source[counter]);
+ Inc(counter);
+ end;
+ { terminate the string }
+ Dest[counter] := #0;
+ StrECopy:=@(Dest[counter]);
+ end;
+{$endif FPC_UNIT_HAS_STRECOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOPY}
+ Function StrLCopy(Dest,Source: PChar; MaxLen: SizeInt): PChar;
+ var
+ counter: SizeInt;
+ Begin
+ counter := 0;
+ { To be compatible with BP, on a null string, put two nulls }
+ If Source[0] = #0 then
+ Begin
+ Dest[0]:=Source[0];
+ Inc(counter);
+ end;
+ while (Source[counter] <> #0) and (counter < MaxLen) do
+ Begin
+ Dest[counter] := char(Source[counter]);
+ Inc(counter);
+ end;
+ { terminate the string }
+ Dest[counter] := #0;
+ StrLCopy := Dest;
+ end;
+{$endif FPC_UNIT_HAS_STRLCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRCOMP}
+ function StrComp(Str1, Str2 : PChar): SizeInt;
+ var
+ counter: SizeInt;
+ Begin
+ counter := 0;
+ While str1[counter] = str2[counter] do
+ Begin
+ if (str2[counter] = #0) or (str1[counter] = #0) then
+ break;
+ Inc(counter);
+ end;
+ StrComp := ord(str1[counter]) - ord(str2[counter]);
+ end;
+{$endif FPC_UNIT_HAS_STRCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRICOMP}
+ function StrIComp(Str1, Str2 : PChar): SizeInt;
+ var
+ counter: SizeInt;
+ c1, c2: char;
+ Begin
+ counter := 0;
+ c1 := upcase(str1[counter]);
+ c2 := upcase(str2[counter]);
+ While c1 = c2 do
+ Begin
+ if (c1 = #0) or (c2 = #0) then break;
+ Inc(counter);
+ c1 := upcase(str1[counter]);
+ c2 := upcase(str2[counter]);
+ end;
+ StrIComp := ord(c1) - ord(c2);
+ end;
+{$endif FPC_UNIT_HAS_STRICOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOMP}
+ function StrLComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;
+ var
+ counter: SizeInt;
+ c1, c2: char;
+ Begin
+ counter := 0;
+ if L = 0 then
+ begin
+ StrLComp := 0;
+ exit;
+ end;
+ Repeat
+ c1 := str1[counter];
+ c2 := str2[counter];
+ if (c1 = #0) or (c2 = #0) then break;
+ Inc(counter);
+ Until (c1 <> c2) or (counter >= L);
+ StrLComp := ord(c1) - ord(c2);
+ end;
+{$endif FPC_UNIT_HAS_STRLCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLICOMP}
+ function StrLIComp(Str1, Str2 : PChar; L: SizeInt): SizeInt;
+ var
+ counter: SizeInt;
+ c1, c2: char;
+ Begin
+ counter := 0;
+ if L = 0 then
+ begin
+ StrLIComp := 0;
+ exit;
+ end;
+ Repeat
+ c1 := upcase(str1[counter]);
+ c2 := upcase(str2[counter]);
+ if (c1 = #0) or (c2 = #0) then break;
+ Inc(counter);
+ Until (c1 <> c2) or (counter >= L);
+ StrLIComp := ord(c1) - ord(c2);
+ end;
+{$endif FPC_UNIT_HAS_STRLICOMP}
+
+{
+ $Log: genstr.inc,v $
+ Revision 1.5 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/genstrs.inc b/rtl/inc/genstrs.inc
new file mode 100644
index 0000000000..fbd64bfc9c
--- /dev/null
+++ b/rtl/inc/genstrs.inc
@@ -0,0 +1,43 @@
+{
+ $Id: genstrs.inc,v 1.3 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl-Eric Codere,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef FPC_UNIT_HAS_STRPCOPY}
+ function strpcopy(d : pchar;const s : string) : pchar;
+ var
+ counter : byte;
+ Begin
+ counter := 0;
+ { if empty pascal string }
+ { then setup and exit now }
+ if s = '' then
+ Begin
+ D[0] := #0;
+ StrPCopy := D;
+ exit;
+ end;
+ for counter:=1 to length(S) do
+ D[counter-1] := S[counter];
+ { terminate the string }
+ D[counter] := #0;
+ StrPCopy:=D;
+ end;
+{$endif FPC_UNIT_HAS_STRPCOPY}
+
+{
+ $Log: genstrs.inc,v $
+ Revision 1.3 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/getopts.pp b/rtl/inc/getopts.pp
new file mode 100644
index 0000000000..77144cee69
--- /dev/null
+++ b/rtl/inc/getopts.pp
@@ -0,0 +1,512 @@
+{
+ $Id: getopts.pp,v 1.7 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Getopt implementation for Free Pascal, modeled after GNU getopt
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit getopts;
+Interface
+
+Const
+ No_Argument = 0;
+ Required_Argument = 1;
+ Optional_Argument = 2;
+ EndOfOptions = #255;
+
+Type
+ POption = ^TOption;
+ TOption = Record
+ Name : String;
+ Has_arg : Integer;
+ Flag : PChar;
+ Value : Char;
+ end;
+
+ Orderings = (require_order,permute,return_in_order);
+
+Const
+ OptSpecifier : set of char=['-'];
+
+Var
+ OptArg : String;
+ OptInd : Longint;
+ OptErr : Boolean;
+ OptOpt : Char;
+
+Function GetOpt (ShortOpts : String) : char;
+Function GetLongOpts (ShortOpts : String;LongOpts : POption;var Longind : Longint) : char;
+
+
+Implementation
+
+{$ifdef TP}
+uses
+ strings;
+{$endif}
+
+
+{***************************************************************************
+ Create an ArgV
+***************************************************************************}
+
+{$ifdef TP}
+
+
+
+type
+ ppchar = ^pchar;
+ apchar = array[0..127] of pchar;
+var
+ argc : longint;
+ argv : apchar;
+
+procedure setup_arguments;
+var
+ arglen,
+ count : longint;
+ argstart,
+ cmdline : pchar;
+ quote : set of char;
+ argsbuf : array[0..127] of pchar;
+ s : string;
+ i : integer;
+begin
+{ create argv[0] which is the started filename }
+ s:=paramstr(0);
+ arglen:=length(s);
+ getmem(argsbuf[0],arglen + 1);
+ strpcopy(argsbuf[0],s);
+{ create commandline }
+ s:='';
+ for i:=1 to paramcount do
+ begin
+ s:=s+paramstr(i)+' ';
+ end;
+ s:=s+#0;
+ cmdline:=@s[1];
+ count:=1;
+ repeat
+ { skip leading spaces }
+ while cmdline^ in [' ',#9,#13] do
+ inc(longint(cmdline));
+ case cmdline^ of
+ #0 : break;
+ '"' : begin
+ quote:=['"'];
+ inc(longint(cmdline));
+ end;
+ '''' : begin
+ quote:=[''''];
+ inc(longint(cmdline));
+ end;
+ else
+ quote:=[' ',#9,#13];
+ end;
+ { scan until the end of the argument }
+ argstart:=cmdline;
+ while (cmdline^<>#0) and not(cmdline^ in quote) do
+ inc(longint(cmdline));
+ { reserve some memory }
+ arglen:=cmdline-argstart;
+ getmem(argsbuf[count],arglen+1);
+ move(argstart^,argsbuf[count]^,arglen);
+ argsbuf[count][arglen]:=#0;
+ { skip quote }
+ if cmdline^ in quote then
+ inc(longint(cmdline));
+ inc(count);
+ until false;
+{ create argc }
+ argc:=count;
+{ create an nil entry }
+ argsbuf[count]:=nil;
+ inc(count);
+{ create the argv }
+ move(argsbuf,argv,count shl 2);
+end;
+
+{$endif TP}
+
+{***************************************************************************
+ Real Getopts
+***************************************************************************}
+
+Var
+ NextChar,
+ Nrargs,
+ first_nonopt,
+ last_nonopt : Longint;
+ Ordering : Orderings;
+
+Procedure Exchange;
+var
+ bottom,
+ middle,
+ top,i,len : longint;
+ temp : pchar;
+begin
+ bottom:=first_nonopt;
+ middle:=last_nonopt;
+ top:=optind;
+ while (top>middle) and (middle>bottom) do
+ begin
+ if (top-middle>middle-bottom) then
+ begin
+ len:=middle-bottom;
+ for i:=1 to len-1 do
+ begin
+ temp:=argv[bottom+i];
+ argv[bottom+i]:=argv[top-(middle-bottom)+i];
+ argv[top-(middle-bottom)+i]:=temp;
+ end;
+ top:=top-len;
+ end
+ else
+ begin
+ len:=top-middle;
+ for i:=0 to len-1 do
+ begin
+ temp:=argv[bottom+i];
+ argv[bottom+i]:=argv[middle+i];
+ argv[middle+i]:=temp;
+ end;
+ bottom:=bottom+len;
+ end;
+ end;
+ first_nonopt:=first_nonopt + optind-last_nonopt;
+ last_nonopt:=optind;
+end; { exchange }
+
+
+procedure getopt_init (var opts : string);
+begin
+{ Initialize some defaults. }
+ Optarg:='';
+ Optind:=1;
+ First_nonopt:=1;
+ Last_nonopt:=1;
+ OptOpt:='?';
+ Nextchar:=0;
+ case opts[1] of
+ '-' : begin
+ ordering:=return_in_order;
+ delete(opts,1,1);
+ end;
+ '+' : begin
+ ordering:=require_order;
+ delete(opts,1,1);
+ end;
+ else
+ ordering:=permute;
+ end;
+end;
+
+
+
+Function Internal_getopt (Var Optstring : string;LongOpts : POption;
+ LongInd : pointer;Long_only : boolean ) : char;
+type
+ pinteger=^integer;
+var
+ temp,endopt,
+ option_index : byte;
+ indfound : integer;
+ currentarg,
+ optname : string;
+ p,pfound : POption;
+ exact,ambig : boolean;
+ c : char;
+begin
+ optarg:='';
+ if optind=0 then
+ getopt_init(optstring);
+{ Check if We need the next argument. }
+ if (optind<nrargs) then
+ currentarg:=strpas(argv[optind])
+ else
+ currentarg:='';
+ if (nextchar=0) then
+ begin
+ if ordering=permute then
+ begin
+ { If we processed options following non-options : exchange }
+ if (first_nonopt<>last_nonopt) and (last_nonopt<>optind) then
+ exchange
+ else
+ if last_nonopt<>optind then
+ first_nonopt:=optind;
+ while (optind<nrargs) and (not(argv[optind][0] in OptSpecifier) or
+ (length(strpas(argv[optind]))=1)) do
+ inc(optind);
+ last_nonopt:=optind;
+ end;
+ { Check for '--' argument }
+ if optind<nrargs then
+ currentarg:=strpas(argv[optind])
+ else
+ currentarg:='';
+ if (optind<>nrargs) and (currentarg='--') then
+ begin
+ inc(optind);
+ if (first_nonopt<>last_nonopt) and (last_nonopt<>optind) then
+ exchange
+ else
+ if first_nonopt=last_nonopt then
+ first_nonopt:=optind;
+ last_nonopt:=nrargs;
+ optind:=nrargs;
+ end;
+ { Are we at the end of all arguments ? }
+ if optind>=nrargs then
+ begin
+ if first_nonopt<>last_nonopt then
+ optind:=first_nonopt;
+ Internal_getopt:=EndOfOptions;
+ exit;
+ end;
+ if optind<nrargs then
+ currentarg:=strpas(argv[optind])
+ else
+ currentarg:='';
+ { Are we at a non-option ? }
+ if not(currentarg[1] in OptSpecifier) or (length(currentarg)=1) then
+ begin
+ if ordering=require_order then
+ begin
+ Internal_getopt:=EndOfOptions;
+ exit;
+ end
+ else
+ begin
+ optarg:=strpas(argv[optind]);
+ inc(optind);
+ Internal_getopt:=#1;
+ exit;
+ end;
+ end;
+ { At this point we're at an option ...}
+ nextchar:=2;
+ if (longopts<>nil) and ((currentarg[2]='-') and
+ (currentArg[1]='-')) then
+ inc(nextchar);
+ { So, now nextchar points at the first character of an option }
+ end;
+{ Check if we have a long option }
+ if longopts<>nil then
+ if length(currentarg)>1 then
+ if ((currentarg[2]='-') and (currentArg[1]='-'))
+ or
+ ((not long_only) and (pos(currentarg[2],optstring)<>0)) then
+ begin
+ { Get option name }
+ endopt:=pos('=',currentarg);
+ if endopt=0 then
+ endopt:=length(currentarg)+1;
+ optname:=copy(currentarg,nextchar,endopt-nextchar);
+ { Match partial or full }
+ p:=longopts;
+ pfound:=nil;
+ exact:=false;
+ ambig:=false;
+ option_index:=0;
+ indfound:=0;
+ while (p^.name<>'') and (not exact) do
+ begin
+ if pos(optname,p^.name)<>0 then
+ begin
+ if length(optname)=length(p^.name) then
+ begin
+ exact:=true;
+ pfound:=p;
+ indfound:=option_index;
+ end
+ else
+ if pfound=nil then
+ begin
+ indfound:=option_index;
+ pfound:=p
+ end
+ else
+ ambig:=true;
+ end;
+ inc(pointer(p),sizeof(toption));
+ inc(option_index);
+ end;
+ if ambig and not exact then
+ begin
+ if opterr then
+ writeln(argv[0],': option "',optname,'" is ambiguous');
+ nextchar:=0;
+ inc(optind);
+ Internal_getopt:='?';
+ end;
+ if pfound<>nil then
+ begin
+ inc(optind);
+ if endopt<=length(currentarg) then
+ begin
+ if pfound^.has_arg>0 then
+ optarg:=copy(currentarg,endopt+1,length(currentarg)-endopt)
+ else
+ begin
+ if opterr then
+ if currentarg[2]='-' then
+ writeln(argv[0],': option "--',pfound^.name,'" doesn''t allow an argument')
+ else
+ writeln(argv[0],': option "',currentarg[1],pfound^.name,'" doesn''t allow an argument');
+ nextchar:=0;
+ internal_getopt:='?';
+ exit;
+ end;
+ end
+ else { argument in next paramstr... }
+ begin
+ if pfound^.has_arg=1 then
+ begin
+ if optind<nrargs then
+ begin
+ optarg:=strpas(argv[optind]);
+ inc(optind);
+ end { required argument }
+ else
+ begin { no req argument}
+ if opterr then
+ writeln(argv[0],': option ',pfound^.name,' requires an argument');
+ nextchar:=0;
+ if optstring[1]=':' then
+ Internal_getopt:=':'
+ else
+ Internal_getopt:='?';
+ exit;
+ end;
+ end;
+ end; { argument in next parameter end;}
+ nextchar:=0;
+ if longind<>nil then
+ pinteger(longind)^:=indfound+1;
+ if pfound^.flag<>nil then
+ begin
+ pfound^.flag^:=pfound^.value;
+ internal_getopt:=#0;
+ exit;
+ end;
+ internal_getopt:=pfound^.value;
+ exit;
+ end; { pfound<>nil }
+ { We didn't find it as an option }
+ if (not long_only) or
+ ((currentarg[2]='-') or (pos(CurrentArg[nextchar],optstring)=0)) then
+ begin
+ if opterr then
+ if currentarg[2]='-' then
+ writeln(argv[0],' unrecognized option "--',optname,'"')
+ else
+ writeln(argv[0],' unrecognized option "',currentarg[1],optname,'"');
+ nextchar:=0;
+ inc(optind);
+ Internal_getopt:='?';
+ exit;
+ end;
+ end; { Of long options.}
+{ We check for a short option. }
+ temp:=pos(currentarg[nextchar],optstring);
+ c:=currentarg[nextchar];
+ inc(nextchar);
+ if nextchar>length(currentarg) then
+ begin
+ inc(optind);
+ nextchar:=0;
+ end;
+ if (temp=0) or (c=':') then
+ begin
+ if opterr then
+ writeln(argv[0],': illegal option -- ',c);
+ optopt:=c;
+ internal_getopt:='?';
+ exit;
+ end;
+ Internal_getopt:=optstring[temp];
+ if optstring[temp+1]=':' then
+ if optstring[temp+2]=':' then
+ begin { optional argument }
+ if nextchar>0 then
+ begin
+ optarg:=copy (currentarg,nextchar,length(currentarg)-nextchar+1);
+ inc(optind);
+ nextchar:=0;
+ end else if (optind<>nrargs) then
+ begin
+ optarg:=strpas(argv[optind]);
+ if optarg[1]='-' then
+ optarg:=''
+ else
+ inc(optind);
+ nextchar:=0;
+ end;
+ end
+ else
+ begin { required argument }
+ if nextchar>0 then
+ begin
+ optarg:=copy (currentarg,nextchar,length(currentarg)-nextchar+1);
+ inc(optind);
+ end
+ else
+ if (optind=nrargs) then
+ begin
+ if opterr then
+ writeln (argv[0],': option requires an argument -- ',optstring[temp]);
+ optopt:=optstring[temp];
+ if optstring[1]=':' then
+ Internal_getopt:=':'
+ else
+ Internal_Getopt:='?';
+ end
+ else
+ begin
+ optarg:=strpas(argv[optind]);
+ inc(optind)
+ end;
+ nextchar:=0;
+ end; { End of required argument}
+end; { End of internal getopt...}
+
+
+Function GetOpt(ShortOpts : String) : char;
+begin
+ getopt:=internal_getopt(shortopts,nil,nil,false);
+end;
+
+
+Function GetLongOpts(ShortOpts : String;LongOpts : POption;var Longind : Longint) : char;
+begin
+ getlongopts:=internal_getopt(shortopts,longopts,@longind,true);
+end;
+
+
+begin
+{ create argv if running under TP }
+{$ifdef TP}
+ setup_arguments;
+{$endif}
+{ Needed to detect startup }
+ Opterr:=true;
+ Optind:=0;
+ nrargs:=argc;
+end.
+{
+ $Log: getopts.pp,v $
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/clip.inc b/rtl/inc/graph/clip.inc
new file mode 100644
index 0000000000..ed7b4d59a1
--- /dev/null
+++ b/rtl/inc/graph/clip.inc
@@ -0,0 +1,148 @@
+{
+ $Id: clip.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This include implements the different clipping algorithms
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+const
+ LEFT = 1; { Left window }
+ RIGHT = 2; { Right window }
+ BOTTOM = 4; { Bottom window }
+ TOP = 8; { Top window }
+ { 0 = in window }
+
+
+
+
+
+
+
+ function LineClipped(var x1, y1,x2,y2: smallint; xmin, ymin,
+ xmax, ymax:smallint): boolean;
+ {********************************************************}
+ { Function LineClipped() }
+ {--------------------------------------------------------}
+ { This routine clips the line coordinates to the }
+ { min. and max. values of the window. Returns TRUE if }
+ { the ENTIRE line was clipped. Updated }
+ { clipped line endpoints are also returned. }
+ { This algorithm is the classic Cohen-Sutherland line }
+ { clipping algorithm. }
+ {--------------------------------------------------------}
+ var
+ code1, code2: longint;
+ code: longint;
+ newx,newy: smallint;
+ done:boolean;
+
+
+ function outcode(x,y:smallint): longint;
+ {********************************************************}
+ { Function OutCode() }
+ {--------------------------------------------------------}
+ { This routine determines if the specified end point }
+ { of a line lies within the visible window, if not it }
+ { determines in which window the point is. }
+ {--------------------------------------------------------}
+
+ var
+ code: longint;
+ begin
+ code := 0;
+ if (x<xmin) then
+ code:=code or LEFT
+ else if (x>xmax) then
+ code:=code or RIGHT;
+ if (y>ymax) then
+ code:=code or BOTTOM
+ else if (y<ymin) then
+ code:=code or TOP;
+
+ outcode:=code;
+ end;
+
+ begin
+ done:=false;
+ code1:= OutCode(x1,y1);
+ code2:= OutCode(x2,y2);
+
+ while not done do
+ begin
+ { Accept trivially }
+ { both points are in window }
+ if ((code1=0) and (code2=0)) then
+ begin
+ done:=TRUE;
+ LineClipped:=FALSE;
+ exit;
+ end
+ else
+ { Reject trivially }
+ { Neither points are in window }
+ if (code1 and code2) <> 0 then
+ begin
+ done:=true;
+ LineClipped:=TRUE;
+ exit;
+ end
+ else
+ begin
+ { Some points are partially out of the window }
+ { find the new end point of the lines... }
+ if code1 = 0 then
+ code:=code2
+ else
+ code:=code1;
+ if (code and LEFT) <> 0 then
+ begin
+ newy:=y1+((y2-y1)*(xmin-x1)) div (x2-x1);
+ newx:=xmin;
+ end
+ else
+ if (code and RIGHT) <> 0 then
+ begin
+ newy:=y1+((y2-y1)*(xmax-x1)) div (x2-x1);
+ newx:=xmax;
+ end
+ else
+ if (code and BOTTOM) <> 0 then
+ begin
+ newx:=x1+((x2-x1)*(ymax-y1)) div (y2-y1);
+ newy:=ymax;
+ end
+ else
+ if (code and TOP) <> 0 then
+ begin
+ newx:=x1+((x2-x1)*(ymin-y1)) div (y2-y1);
+ newy:=ymin;
+ end;
+ if (code1 = code) then
+ begin
+ x1 := newx; y1:= newy;
+ code1:=outcode(x1,y1)
+ end
+ else
+ begin
+ x2:= newx; y2:= newy;
+ code2:=outcode(x2,y2);
+ end
+ end;
+ end;
+ LineClipped:=FALSE;
+end;
+
+{
+ $Log: clip.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/fills.inc b/rtl/inc/graph/fills.inc
new file mode 100644
index 0000000000..a9b52194bc
--- /dev/null
+++ b/rtl/inc/graph/fills.inc
@@ -0,0 +1,494 @@
+{
+ $Id: fills.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Thomas Schatzl and Carl Eric Codere
+
+ This include implements polygon filling and flood filling.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ simple descriptive name }
+function max(a, b : Longint) : Longint;
+begin
+ max := b;
+ if (a > b) then max := a;
+end;
+
+{ here too }
+function min(a, b : Longint) : Longint;
+begin
+ min := b;
+ if (a < b) then min := a;
+end;
+
+procedure fillpoly(numpoints : Word; var polypoints);
+
+{ disable range check mode }
+{$ifopt R+}
+{$define OPT_R_WAS_ON}
+{$R-}
+{$endif}
+type
+ pedge = ^tedge;
+ tedge = packed record
+ yMin, yMax, x, dX, dY, frac : Longint;
+ end;
+
+ pedgearray = ^tedgearray;
+ tedgearray = array[0..0] of tedge;
+
+ ppedgearray = ^tpedgearray;
+ tpedgearray = array[0..0] of pedge;
+
+var
+ nActive, nNextEdge : Longint;
+ p0, p1 : pointtype;
+ i, j, gap, x0, x1, y, nEdges : Longint;
+ ET : pedgearray;
+ GET, AET : ppedgearray;
+ t : pedge;
+
+ ptable : ^pointtype;
+
+
+begin
+{ /********************************************************************
+ * Add entries to the global edge table. The global edge table has a
+ * bucket for each scan line in the polygon. Each bucket contains all
+ * the edges whose yMin == yScanline. Each bucket contains the yMax,
+ * the x coordinate at yMax, and the denominator of the slope (dX)
+*/}
+ getmem(et, sizeof(tedge) * numpoints);
+ getmem(get, sizeof(pedge) * numpoints);
+ getmem(aet, sizeof(pedge) * numpoints);
+
+ ptable := @polypoints;
+
+ { check for getmem success }
+
+ nEdges := 0;
+ for i := 0 to (numpoints-1) do begin
+ p0 := ptable[i];
+ if (i+1) >= numpoints then p1 := ptable[0]
+ else p1 := ptable[i+1];
+ { ignore if this is a horizontal edge}
+ if (p0.y = p1.y) then continue;
+ {swap ptable if necessary to ensure p0 contains yMin}
+ if (p0.y > p1.y) then begin
+ p0 := p1;
+ p1 := ptable[i];
+ end;
+ { create the new edge }
+ et^[nEdges].ymin := p0.y;
+ et^[nEdges].ymax := p1.y;
+ et^[nEdges].x := p0.x;
+ et^[nEdges].dX := p1.x-p0.x;
+ et^[nEdges].dy := p1.y-p0.y;
+ et^[nEdges].frac := 0;
+ get^[nEdges] := @et^[nEdges];
+ inc(nEdges);
+ end;
+ { sort the GET on ymin }
+ gap := 1;
+ while (gap < nEdges) do gap := 3*gap+1;
+ gap := gap div 3;
+ while (gap > 0) do begin
+ for i := gap to (nEdges-1) do begin
+ j := i - gap;
+ while (j >= 0) do begin
+ if (GET^[j]^.ymin <= GET^[j+gap]^.yMin) then break;
+ t := GET^[j];
+ GET^[j] := GET^[j+gap];
+ GET^[j+gap] := t;
+ dec(j, gap);
+ end;
+ end;
+ gap := gap div 3;
+ end;
+ { initialize the active edge table, and set y to first entering edge}
+ nActive := 0;
+ nNextEdge := 0;
+
+ y := GET^[nNextEdge]^.ymin;
+ { Now process the edges using the scan line algorithm. Active edges
+ will be added to the Active Edge Table (AET), and inactive edges will
+ be deleted. X coordinates will be updated with incremental integer
+ arithmetic using the slope (dY / dX) of the edges. }
+ while (nNextEdge < nEdges) or (nActive <> 0) do begin
+ {Move from the ET bucket y to the AET those edges whose yMin == y
+ (entering edges) }
+ while (nNextEdge < nEdges) and (GET^[nNextEdge]^.ymin = y) do begin
+ AET^[nActive] := GET^[nNextEdge];
+ inc(nActive);
+ inc(nNextEdge);
+ end;
+ { Remove from the AET those entries for which yMax == y (leaving
+ edges) }
+ i := 0;
+ while (i < nActive) do begin
+ if (AET^[i]^.yMax = y) then begin
+ dec(nActive);
+ move(AET^[i+1], AET^[i], (nActive-i)*sizeof(pedge));
+ end else
+ inc(i);
+ end;
+
+ if (y >= 0) then begin
+ {Now sort the AET on x. Since the list is usually quite small,
+ the sort is implemented as a simple non-recursive shell sort }
+
+ gap := 1;
+ while (gap < nActive) do gap := 3*gap+1;
+
+ gap := gap div 3;
+ while (gap > 0) do begin
+ for i := gap to (nActive-1) do begin
+ j := i - gap;
+ while (j >= 0) do begin
+ if (AET^[j]^.x <= AET^[j+gap]^.x) then break;
+ t := AET^[j];
+ AET^[j] := AET^[j+gap];
+ AET^[j+gap] := t;
+ dec(j, gap);
+ end;
+ end;
+ gap := gap div 3;
+ end;
+
+ { Fill in desired pixels values on scan line y by using pairs of x
+ coordinates from the AET }
+ i := 0;
+ while (i < nActive) do begin
+ x0 := AET^[i]^.x;
+ x1 := AET^[i+1]^.x;
+ {Left edge adjustment for positive fraction. 0 is interior. }
+ if (AET^[i]^.frac > 0) then inc(x0);
+ {Right edge adjustment for negative fraction. 0 is exterior. }
+ if (AET^[i+1]^.frac <= 0) then dec(x1);
+
+ x0 := max(x0, 0);
+ x1 := min(x1, viewWidth);
+ { Draw interior spans}
+ if (x1 >= x0) then begin
+ PatternLine(x0, x1, y);
+ end;
+
+ inc(i, 2);
+ end;
+
+ end;
+
+ { Update all the x coordinates. Edges are scan converted using a
+ modified midpoint algorithm (Bresenham's algorithm reduces to the
+ midpoint algorithm for two dimensional lines) }
+ for i := 0 to (nActive-1) do begin
+ t := AET^[i];
+ { update the fraction by dX}
+ inc(t^.frac, t^.dX);
+
+ if (t^.dX < 0) then
+ while ( -(t^.frac) >= t^.dY) do begin
+ inc(t^.frac, t^.dY);
+ dec(t^.x);
+ end
+ else
+ while (t^.frac >= t^.dY) do begin
+ dec(t^.frac, t^.dY);
+ inc(t^.x);
+ end;
+ end;
+ inc(y);
+ if (y >= ViewHeight) then break;
+ end;
+ freemem(et, sizeof(tedge) * numpoints);
+ freemem(get, sizeof(pedge) * numpoints);
+ freemem(aet, sizeof(pedge) * numpoints);
+end;
+
+
+{ maximum supported Y resultion }
+const
+ MaxYRes = 2048;
+ { changing this to 1 or 2 doesn't improve performance noticably }
+ YResDiv = 4;
+
+type
+ PFloodLine = ^TFloodLine;
+ TFloodLine = record
+ next: PFloodLine;
+ x1 : smallint;
+ x2 : smallint;
+ y : smallint;
+ end;
+
+ TDrawnList = Array[0..(MaxYRes - 1) div YResDiv] of PFloodLine;
+
+var
+ DrawnList : TDrawnList;
+ Buffer : Record { Union for byte and word addressing of buffer }
+ ByteIndex : Word;
+ WordIndex : Word;
+ Case Boolean Of
+ False : (Bytes : Array [0..StdBufferSize-1] Of Byte);
+ True : (Words : Array [0..(StdBufferSize DIV 2)-1] Of Word);
+ End;
+
+ s1, s2, s3 : PWordArray; { Three buffers for scanlines }
+
+
+ Procedure PushPoint (x, y : smallint);
+ {********************************************************}
+ { Adds a point to the list of points to check if we }
+ { need to draw. Doesn't add the point if there is a }
+ { buffer overflow. }
+ {********************************************************}
+ Begin
+ If Buffer.WordIndex<(StdBufferSize DIV 2)-3 then
+ Begin
+ Buffer.Words[Buffer.WordIndex]:=x;
+ Buffer.Words[Buffer.WordIndex+1]:=y;
+ Inc (Buffer.WordIndex,2);
+ End
+ End;
+
+ Procedure PopPoint (Var x, y : smallint);
+ {********************************************************}
+ { Removes a point from the list of points to check, if }
+ { we try to access an illegal point, then the routine }
+ { returns -1,-1 as a coordinate pair. }
+ {********************************************************}
+ Begin
+ If Buffer.WordIndex>1 then
+ Begin
+ x:=Buffer.Words[Buffer.WordIndex-2];
+ y:=Buffer.Words[Buffer.WordIndex-1];
+ Dec (Buffer.WordIndex,2);
+ End
+ Else
+ Begin
+ x:=-1;
+ y:=-1;
+ End;
+ End;
+
+
+
+
+
+
+ {********************************************************}
+ { Procedure AddLinePoints() }
+ {--------------------------------------------------------}
+ { Adds a line segment to the list of lines which will be }
+ { drawn to the screen. The line added is on the specified}
+ { Y axis, from the x1 to x2 coordinates. }
+ {********************************************************}
+ Procedure AddLinePoints(x1,x2,y: smallint);
+ var temp: PFloodLine;
+ begin
+ new(temp);
+ temp^.x1 := x1;
+ temp^.x2 := x2;
+ temp^.y := y;
+ temp^.next := DrawnList[y div YResDiv];
+ DrawnList[y div YResDiv] := temp;
+ end;
+
+ {********************************************************}
+ { Procedure AlreadyDrawn() }
+ {--------------------------------------------------------}
+ { This routine searches through the list of segments }
+ { which will be drawn to the screen, and determines if }
+ { the specified point (x,y) will already be drawn. }
+ { i.e : Checks if the x,y point lies within a known }
+ { segment which will be drawn to the screen. This makes }
+ { sure that we don't draw some segments two times. }
+ { Return TRUE if the point is already in the segment list}
+ { to draw, otherwise returns FALSE. }
+ {********************************************************}
+ Function AlreadyDrawn(x, y: smallint): boolean;
+ var
+ temp : PFloodLine;
+ begin
+ AlreadyDrawn := false;
+ temp := DrawnList[y div YResDiv];
+ while assigned(temp) do
+ begin
+ if (temp^.y = y) and
+ (temp^.x1 <= x) and
+ (temp^.x2 >= x) then
+ begin
+ AlreadyDrawn := true;
+ exit;
+ end;
+ temp := temp^.next;
+ end;
+ end;
+
+ {********************************************************}
+ { Procedure CleanUpDrawnList }
+ {--------------------------------------------------------}
+ { removes all elements from the DrawnList. Doesn't init }
+ { elements of it with NILL }
+ {********************************************************}
+ Procedure CleanUpDrawnList;
+ var
+ l: longint;
+ temp1, temp2: PFloodLine;
+ begin
+ for l := 0 to high(DrawnList) do
+ begin
+ temp1 := DrawnList[l];
+ while assigned(temp1) do
+ begin
+ temp2 := temp1;
+ temp1 := temp1^.next;
+ dispose(temp2);
+ end;
+ end;
+ end;
+
+
+ Procedure FloodFill (x, y : smallint; Border: word);
+ {********************************************************}
+ { Procedure FloodFill() }
+ {--------------------------------------------------------}
+ { This routine fills a region of the screen bounded by }
+ { the <Border> color. It uses the current fillsettings }
+ { for the flood filling. Clipping is supported, and }
+ { coordinates are local/viewport relative. }
+ {********************************************************}
+ Var
+ stemp: PWordArray;
+ Beginx : smallint;
+ d, e : Byte;
+ Cont : Boolean;
+ BackupColor : Word;
+ x1, x2, prevy: smallint;
+ Begin
+ FillChar(DrawnList,sizeof(DrawnList),0);
+ { init prevy }
+ prevy := 32767;
+ { Save current drawing color }
+ BackupColor := CurrentColor;
+ CurrentColor := FillSettings.Color;
+ { MaxX is based on zero index }
+ GetMem (s1,(ViewWidth+1)*2); { A pixel color represents a word }
+ GetMem (s2,(ViewWidth+1)*2); { A pixel color represents a word }
+ GetMem (s3,(ViewWidth+1)*2); { A pixel color represents a word }
+ if (not assigned(s1)) or (not assigned(s2)) or (not assigned(s3)) then
+ begin
+ _GraphResult := grNoFloodMem;
+ exit;
+ end;
+ If (x<0) Or (y<0) Or
+ (x>ViewWidth) Or (y>ViewHeight) then Exit;
+ { Index of points to check }
+ Buffer.WordIndex:=0;
+ PushPoint (x,y);
+ While Buffer.WordIndex>0 Do
+ Begin
+ PopPoint (x,y);
+ { Get the complete lines for the following }
+ If y <> prevy then
+ begin
+ If (prevy - y = 1) then
+ { previous line was one below the new one, so the previous s2 }
+ { = new s1 }
+ Begin
+ stemp := s3;
+ s3 := s1;
+ s1 := s2;
+ s2 := stemp;
+ GetScanline(0,ViewWidth,y-1,s2^);
+ End
+ Else If (y - prevy = 1) then
+ { previous line was one above the new one, so the previous s3 }
+ { = new s1 }
+ Begin
+ stemp := s2;
+ s2 := s1;
+ s1 := s3;
+ s3 := stemp;
+ GetScanline(0,ViewWidth,y+1,s3^);
+ End
+ Else
+ begin
+ GetScanline(0,ViewWidth,y-1,s2^);
+ GetScanline(0,ViewWidth,y,s1^);
+ GetScanline(0,ViewWidth,y+1,s3^);
+ end;
+ end;
+ prevy := y;
+ { check the current scan line }
+ While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
+ d:=0;
+ e:=0;
+ dec(x);
+ Beginx:=x;
+ REPEAT
+ { check the above line }
+ If y<ViewHeight then
+ Begin
+ Cont:=(s3^[x]<>Border) and (not AlreadyDrawn(x,y+1));
+ If (e=0) And Cont then
+ Begin
+ PushPoint (x,y+1);
+ e:=1;
+ End
+ Else
+ If (e=1) And Not Cont then e:=0;
+ End;
+ { check the line below }
+ If (y>0) then
+ Begin
+ Cont:=(s2^[x]<>Border) and (not AlreadyDrawn(x,y-1));
+ If (d=0) And Cont then
+ Begin
+ PushPoint (x,y-1);
+ d:=1;
+ End
+ Else
+ If (d=1) And Not Cont then d:=0;
+ End;
+ Dec (x);
+ Until (x<0) Or (s1^[x]=Border);
+ { swap the values }
+ x1:=x+1;
+ x2:=BeginX;
+ if x1 > x2 then
+ Begin
+ x:=x1;
+ x1:=x2;
+ x2:=x;
+ end;
+ { Add to the list of drawn lines }
+ AddLinePoints(x1,x2,y);
+ PatternLine (x1,x2,y);
+ End; { end while }
+
+ FreeMem (s1,(ViewWidth+1)*2);
+ FreeMem (s2,(ViewWidth+1)*2);
+ FreeMem (s3,(ViewWidth+1)*2);
+ CleanUpDrawnList;
+ CurrentColor := BackUpColor;
+ End;
+
+{ restore previous range check mode }
+{$ifdef OPT_R_WAS_ON}
+{$R+}
+{$endif}
+{
+ $Log: fills.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/fontdata.inc b/rtl/inc/graph/fontdata.inc
new file mode 100644
index 0000000000..238e089a02
--- /dev/null
+++ b/rtl/inc/graph/fontdata.inc
@@ -0,0 +1,2329 @@
+{
+$Id: fontdata.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+}
+
+{******************************************}
+{ Bitmapped font data - unrolled for }
+{ faster access. Each character is an }
+{ 8x8 byte array representing the full }
+{ bitmap. 0 = nothing, 1 = color }
+{******************************************}
+
+
+TYPE
+ TBitMapChar = array[0..7,0..7] of byte;
+
+CONST
+ DefaultFontData: Array[#0..#255] of TBitmapChar = (
+(
+(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),
+(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)),
+(
+(0,1,1,1,1,1,1,0),
+(1,0,0,0,0,0,0,1),
+(1,0,1,0,0,1,0,1),
+(1,0,0,0,0,0,0,1),
+(1,0,1,1,1,1,0,1),
+(1,0,0,1,1,0,0,1),
+(1,0,0,0,0,0,0,1),
+(0,1,1,1,1,1,1,0)),
+(
+(0,1,1,1,1,1,1,0),
+(1,1,1,1,1,1,1,1),
+(1,1,0,1,1,0,1,1),
+(1,1,1,1,1,1,1,1),
+(1,1,0,0,0,0,1,1),
+(1,1,1,0,0,1,1,1),
+(1,1,1,1,1,1,1,1),
+(0,1,1,1,1,1,1,0)),
+(
+(0,1,1,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(1,1,1,1,1,1,1,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,1,1,1,0,0)),
+(
+(0,0,0,1,0,0,0,0),
+(0,0,0,1,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,1,1,1,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,1,1),
+(1,1,1,1,1,1,1,1),
+(1,1,1,0,0,1,1,1),
+(1,1,0,0,0,0,1,1),
+(1,1,0,0,0,0,1,1),
+(1,1,1,0,0,1,1,1),
+(1,1,1,1,1,1,1,1),
+(1,1,1,1,1,1,1,1)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,0,1,1,0),
+(0,1,0,0,0,0,1,0),
+(0,1,0,0,0,0,1,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,1,1),
+(1,1,0,0,0,0,1,1),
+(1,0,0,1,1,0,0,1),
+(1,0,1,1,1,1,0,1),
+(1,0,1,1,1,1,0,1),
+(1,0,0,1,1,0,0,1),
+(1,1,0,0,0,0,1,1),
+(1,1,1,1,1,1,1,1)),
+(
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,0,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,1,1,1,1,1,0,1),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0)),
+(
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,1,1,1,1,1,1),
+(0,0,1,1,0,0,1,1),
+(0,0,1,1,1,1,1,1),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,1,1),
+(0,1,1,0,0,0,1,1),
+(0,1,1,1,1,1,1,1),
+(0,1,1,0,0,0,1,1),
+(0,1,1,0,0,0,1,1),
+(0,1,1,0,0,1,1,1),
+(1,1,1,0,0,1,1,0),
+(1,1,0,0,0,0,0,0)),
+(
+(1,0,0,1,1,0,0,1),
+(0,1,0,1,1,0,1,0),
+(0,0,1,1,1,1,0,0),
+(1,1,1,0,0,1,1,1),
+(1,1,1,0,0,1,1,1),
+(0,0,1,1,1,1,0,0),
+(0,1,0,1,1,0,1,0),
+(1,0,0,1,1,0,0,1)),
+(
+(1,0,0,0,0,0,0,0),
+(1,1,1,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(1,1,1,1,1,1,1,0),
+(1,1,1,1,1,0,0,0),
+(1,1,1,0,0,0,0,0),
+(1,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,1,0),
+(0,0,0,0,1,1,1,0),
+(0,0,1,1,1,1,1,0),
+(1,1,1,1,1,1,1,0),
+(0,0,1,1,1,1,1,0),
+(0,0,0,0,1,1,1,0),
+(0,0,0,0,0,0,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,1,1),
+(1,1,0,1,1,0,1,1),
+(1,1,0,1,1,0,1,1),
+(0,1,1,1,1,0,1,1),
+(0,0,0,1,1,0,1,1),
+(0,0,0,1,1,0,1,1),
+(0,0,0,1,1,0,1,1),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,1,1,0),
+(0,1,1,0,0,0,1,1),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,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,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,1,1,1,1,1,1,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,1,1,1)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,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,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,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,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,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,1,0,0,1,0,0),
+(0,1,1,0,0,1,1,0),
+(1,1,1,1,1,1,1,1),
+(0,1,1,0,0,1,1,0),
+(0,0,1,0,0,1,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,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(1,1,1,1,1,1,1,1),
+(1,1,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(1,1,1,1,1,1,1,1),
+(0,1,1,1,1,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,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,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,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,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,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,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,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,1,1,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,0,1,1,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,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,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,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,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,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),
+(1,1,1,1,1,1,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,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,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,1,1,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,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),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,1,1,1,1,0),
+(1,1,0,1,1,1,1,0),
+(1,1,0,1,1,1,1,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,1,0),
+(0,0,0,0,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,1,1,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,0,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,1,0,1,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,1,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,1,0,0,1,1,0),
+(1,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,1,0),
+(1,1,0,0,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,1,1,0)),
+(
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,1,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,1,0,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,0,1,1),
+(1,1,0,0,0,0,1,1),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,0,1,1,0),
+(0,0,0,0,0,0,1,1),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,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,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,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),
+(1,1,1,1,1,1,1,1)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,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,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,1,1,1,1,1,0,0),
+(0,0,0,0,0,1,1,0),
+(0,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,0,0,1,1,0),
+(1,1,0,1,1,1,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,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(0,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,1,0),
+(0,1,1,1,0,1,1,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,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,1,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,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,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,1,0),
+(0,1,1,1,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0)),
+(
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,0,0,0,0)),
+(
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,1,1,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,0,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,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),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,1,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,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),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,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,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,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),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,0,0,1,1,0),
+(1,1,0,1,1,1,0,0),
+(1,1,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,1,0),
+(0,1,1,1,0,1,1,0),
+(0,0,0,0,0,1,1,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,0,1,1,1,0),
+(0,1,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,1,1,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,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,1,1,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,1,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),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,1,1,1,1,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),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,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),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,1,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,0,1,1,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),
+(1,1,0,0,0,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,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),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,1,0),
+(0,1,1,1,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(0,1,1,1,1,1,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,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,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,1,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,1,0),
+(1,1,0,0,0,0,1,1),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,1,1,0),
+(0,0,1,1,1,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,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,1,1,1,1,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,1,1,1,0,0,0)),
+(
+(0,1,1,1,1,1,1,0),
+(1,1,0,0,0,0,1,1),
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,1,1,1,1,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,1,1,0),
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,1,1,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,1,1,1,1,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,1,1,1,1,1,1,1),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,1),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,1,1,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(1,1,1,1,1,0,0,0)),
+(
+(1,1,0,0,0,0,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,1,1,1,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,0,1,0,0),
+(1,1,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,1,0,0,1,1,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0)),
+(
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,0,1,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,1,1),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,1)),
+(
+(0,0,0,0,1,1,1,0),
+(0,0,0,1,1,0,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,0,1,1,0,0,0),
+(0,1,1,1,0,0,0,0)),
+(
+(0,0,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,0,1,1,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,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,0,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,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,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,0,0,0,0,1,1),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,1,1,1,1,0),
+(0,0,1,1,0,0,1,1),
+(0,1,1,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,1,1,1,1)),
+(
+(1,1,0,0,0,0,1,1),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,1,1,0,1,1),
+(0,0,1,1,0,1,1,1),
+(0,1,1,0,1,1,1,1),
+(1,1,0,0,1,1,1,1),
+(0,0,0,0,0,0,1,1)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,1,1),
+(0,1,1,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,0,0,1,1),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,0,0,1,1,0),
+(0,0,1,1,0,0,1,1),
+(0,1,1,0,0,1,1,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,0,0,0,1,0),
+(1,0,0,0,1,0,0,0),
+(0,0,1,0,0,0,1,0),
+(1,0,0,0,1,0,0,0),
+(0,0,1,0,0,0,1,0),
+(1,0,0,0,1,0,0,0),
+(0,0,1,0,0,0,1,0),
+(1,0,0,0,1,0,0,0)),
+(
+(0,1,0,1,0,1,0,1),
+(1,0,1,0,1,0,1,0),
+(0,1,0,1,0,1,0,1),
+(1,0,1,0,1,0,1,0),
+(0,1,0,1,0,1,0,1),
+(1,0,1,0,1,0,1,0),
+(0,1,0,1,0,1,0,1),
+(1,0,1,0,1,0,1,0)),
+(
+(1,1,0,1,1,0,1,1),
+(0,1,1,1,0,1,1,1),
+(1,1,0,1,1,0,1,1),
+(1,1,1,0,1,1,1,0),
+(1,1,0,1,1,0,1,1),
+(0,1,1,1,0,1,1,1),
+(1,1,0,1,1,0,1,1),
+(1,1,1,0,1,1,1,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,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,0),
+(1,1,1,1,1,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(1,1,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,0),
+(0,0,0,0,0,1,1,0),
+(1,1,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,0,1,1,0),
+(0,0,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,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,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,1,1,1,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,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,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,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),
+(1,1,1,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(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,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,1,1,1),
+(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),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,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,0,0,0),
+(1,1,1,1,1,1,1,1),
+(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,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,1),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,1,1,1,1),
+(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),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,1,1,1,1),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,0,1,1,1),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(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),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,0,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,1),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(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,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,0,1,1,1),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,0,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(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,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,1,1,1,1),
+(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),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,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,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,1,1,1,1),
+(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,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(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),
+(0,0,0,0,0,0,0,0),
+(0,0,0,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,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,0,0,0),
+(0,0,1,1,1,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(1,1,1,1,1,1,1,1),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0),
+(0,0,1,1,0,1,1,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,1,1,1,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,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,1,1,1,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(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),
+(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)),
+(
+(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),
+(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)),
+(
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0),
+(1,1,1,1,0,0,0,0)),
+(
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,1,1,1,1),
+(0,0,0,0,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,1,1,1,1),
+(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)),
+(
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,0,0),
+(1,1,0,0,1,0,0,0),
+(1,1,0,1,1,1,0,0),
+(0,1,1,1,0,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,1,1,1,1,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,1,1,1,1,1,1,0),
+(1,1,0,1,1,0,0,0),
+(1,1,0,1,1,0,0,0),
+(1,1,0,1,1,0,0,0),
+(0,1,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,0,0,1,1,0),
+(0,1,1,1,1,1,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(1,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,1,1,1,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,1,1,1,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,0,0,0,1,1,0),
+(1,1,0,0,0,1,1,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(1,1,1,0,1,1,1,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,1,1,1,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,1,1,1,1,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,1,1,1,1,1,1,0),
+(1,1,0,1,1,0,1,1),
+(1,1,0,1,1,0,1,1),
+(0,1,1,1,1,1,1,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,1,1,0),
+(0,0,0,0,1,1,0,0),
+(0,1,1,1,1,1,1,0),
+(1,1,0,1,1,0,1,1),
+(1,1,0,1,1,0,1,1),
+(0,1,1,1,1,1,1,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,0,0,0,0),
+(1,1,0,0,0,0,0,0),
+(1,1,1,1,1,0,0,0),
+(1,1,0,0,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,1,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(1,1,0,0,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,1,1,1,0),
+(0,0,0,1,1,0,1,1),
+(0,0,0,1,1,0,1,1),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0)),
+(
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,0,1,1,0,0,0),
+(1,1,0,1,1,0,0,0),
+(1,1,0,1,1,0,0,0),
+(0,1,1,1,0,0,0,0)),
+(
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0),
+(1,1,1,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,1,1,1,0,1,1,0),
+(1,1,0,1,1,1,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0)),
+(
+(0,0,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,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,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,1,1,0,0,0),
+(0,0,0,1,1,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,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,1,1,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,1,1,1,1),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(0,0,0,0,1,1,0,0),
+(1,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,0,1,1,1,0,0)),
+(
+(0,1,1,1,1,0,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,0,0),
+(0,1,1,0,1,1,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,1,1,1,0,0,0,0),
+(0,0,0,1,1,0,0,0),
+(0,0,1,1,0,0,0,0),
+(0,1,1,0,0,0,0,0),
+(0,1,1,1,1,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,0,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,1,1,1,1,0,0),
+(0,0,1,1,1,1,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,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,0,0),
+(0,0,0,0,0,0,0,0),
+(0,0,0,0,0,0,0,0))
+);
+
+{
+ $Log: fontdata.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/graph.inc b/rtl/inc/graph/graph.inc
new file mode 100644
index 0000000000..f479b56954
--- /dev/null
+++ b/rtl/inc/graph/graph.inc
@@ -0,0 +1,2138 @@
+{
+ $Id: graph.inc,v 1.10 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Graph unit implementation part
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+var
+ ExitSave: pointer;
+
+const
+ firstCallOfInitGraph: boolean = true;
+
+
+{$ifdef logging}
+var debuglog: text;
+
+function strf(l: longint): string;
+begin
+ str(l, strf)
+end;
+
+Procedure Log(Const s: String);
+Begin
+ Append(debuglog);
+ Write(debuglog, s);
+ Close(debuglog);
+End;
+
+Procedure LogLn(Const s: string);
+Begin
+ Append(debuglog);
+ Writeln(debuglog,s);
+ Close(debuglog);
+End;
+{$endif logging}
+
+const
+ StdBufferSize = 4096; { Buffer size for FloodFill }
+
+type
+
+
+ tinttable = array[0..16383] of smallint;
+ pinttable = ^tinttable;
+
+ WordArray = Array [0..StdbufferSize] Of word;
+ PWordArray = ^WordArray;
+
+
+const
+ { Mask for each bit in byte used to determine pattern }
+ BitArray: Array[0..7] of byte =
+ ($01,$02,$04,$08,$10,$20,$40,$80);
+ RevbitArray: Array[0..7] of byte =
+ ($80,$40,$20,$10,$08,$04,$02,$01);
+
+ { pre expanded line patterns }
+ { 0 = LSB of byte pattern }
+ { 15 = MSB of byte pattern }
+ LinePatterns: Array[0..15] of BOOLEAN =
+ (TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,
+ TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE);
+
+const
+ BGIPath : string = '.';
+
+
+ { Default font 8x8 system from IBM PC }
+ {$i fontdata.inc}
+
+
+
+var
+ CurrentColor: Word;
+ CurrentBkColor: Word;
+ CurrentX : smallint; { viewport relative }
+ CurrentY : smallint; { viewport relative }
+
+ ClipPixels: Boolean; { Should cliiping be enabled }
+
+
+ CurrentWriteMode: smallint;
+
+
+ _GraphResult : smallint;
+
+
+ LineInfo : LineSettingsType;
+ FillSettings: FillSettingsType;
+
+ { information for Text Output routines }
+ CurrentTextInfo : TextSettingsType;
+ CurrentXRatio, CurrentYRatio: graph_float;
+ installedfonts: longint; { Number of installed fonts }
+
+
+ StartXViewPort: smallint; { absolute }
+ StartYViewPort: smallint; { absolute }
+ ViewWidth : smallint;
+ ViewHeight: smallint;
+
+
+ IsGraphMode : Boolean; { Indicates if we are in graph mode or not }
+
+
+ ArcCall: ArcCoordsType; { Information on the last call to Arc or Ellipse }
+
+
+var
+
+ { ******************** HARDWARE INFORMATION ********************* }
+ { Should be set in InitGraph once only. }
+ IntCurrentMode : smallint;
+ IntCurrentDriver : smallint; { Currently loaded driver }
+ IntCurrentNewDriver: smallint;
+ XAspect : word;
+ YAspect : word;
+ MaxX : smallint; { Maximum resolution - ABSOLUTE }
+ MaxY : smallint; { Maximum resolution - ABSOLUTE }
+ MaxColor : Longint;
+ PaletteSize : longint; { Maximum palette entry we can set, usually equal}
+ { maxcolor. }
+ HardwarePages : byte; { maximum number of hardware visual pages }
+ DriverName: String;
+ DirectColor : Boolean ; { Is it a direct color mode? }
+ ModeList : PModeInfo;
+ newModeList: TNewModeInfo;
+ DirectVideo : Boolean; { Direct access to video memory? }
+
+
+
+
+{--------------------------------------------------------------------------}
+{ }
+{ LINE AND LINE RELATED ROUTINES }
+{ }
+{--------------------------------------------------------------------------}
+
+ {$i clip.inc}
+
+ procedure HLineDefault(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+
+ var
+ xtmp: smallint;
+ Begin
+
+ { must we swap the values? }
+ if x >= x2 then
+ Begin
+ xtmp := x2;
+ x2 := x;
+ x:= xtmp;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ X2 := X2 + StartXViewPort;
+ Y := Y + StartYViewPort;
+ if ClipPixels then
+ Begin
+ if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ for x:= x to x2 do
+ DirectPutPixel(X,Y);
+ end;
+
+
+ procedure VLineDefault(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
+
+ var
+ ytmp: smallint;
+ Begin
+ { must we swap the values? }
+ if y >= y2 then
+ Begin
+ ytmp := y2;
+ y2 := y;
+ y:= ytmp;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ Y2 := Y2 + StartYViewPort;
+ Y := Y + StartYViewPort;
+ if ClipPixels then
+ Begin
+ if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ for y := y to y2 do Directputpixel(x,y)
+ End;
+
+ Procedure DirectPutPixelClip(x,y: smallint);
+ { for thickwidth lines, because they may call DirectPutPixel for coords }
+ { outside the current viewport (bug found by CEC) }
+ Begin
+ If (Not ClipPixels) Or
+ ((X >= StartXViewPort) And (X <= (StartXViewPort + ViewWidth)) And
+ (Y >= StartYViewPort) And (Y <= (StartYViewPort + ViewHeight))) then
+ Begin
+ DirectPutPixel(x,y)
+ End
+ End;
+
+ procedure LineDefault(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
+
+ var X, Y : smallint;
+ deltax, deltay : smallint;
+ d, dinc1, dinc2: smallint;
+ xinc1 : smallint;
+ xinc2 : smallint;
+ yinc1 : smallint;
+ yinc2 : smallint;
+ i : smallint;
+ Flag : Boolean; { determines pixel direction in thick lines }
+ NumPixels : smallint;
+ PixelCount : smallint;
+ OldCurrentColor: Word;
+ swtmp : smallint;
+ TmpNumPixels : smallint;
+ begin
+{******************************************}
+{ SOLID LINES }
+{******************************************}
+ if lineinfo.LineStyle = SolidLn then
+ Begin
+ { we separate normal and thick width for speed }
+ { and because it would not be 100% compatible }
+ { with the TP graph unit otherwise }
+ if y1 = y2 then
+ Begin
+ {******************************************}
+ { SOLID LINES HORIZONTAL }
+ {******************************************}
+ if lineinfo.Thickness=NormWidth then
+ hline(x1,x2,y2)
+ else
+ begin
+ { thick width }
+ hline(x1,x2,y2-1);
+ hline(x1,x2,y2);
+ hline(x2,x2,y2+1);
+ end;
+ end
+ else
+ if x1 = x2 then
+ Begin
+ {******************************************}
+ { SOLID LINES VERTICAL }
+ {******************************************}
+ if lineinfo.Thickness=NormWidth then
+ vline(x1,y1,y2)
+ else
+ begin
+ { thick width }
+ vline(x1-1,y1,y2);
+ vline(x1,y1,y2);
+ vline(x1+1,y1,y2);
+ end;
+ end
+ else
+ begin
+ { Convert to global coordinates. }
+ x1 := x1 + StartXViewPort;
+ x2 := x2 + StartXViewPort;
+ y1 := y1 + StartYViewPort;
+ y2 := y2 + StartYViewPort;
+ { if fully clipped then exit... }
+ if ClipPixels then
+ begin
+ if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+ {******************************************}
+ { SLOPED SOLID LINES }
+ {******************************************}
+ oldCurrentColor :=
+ CurrentColor;
+ { Calculate deltax and deltay for initialisation }
+ deltax := abs(x2 - x1);
+ deltay := abs(y2 - y1);
+
+ { Initialize all vars based on which is the independent variable }
+ if deltax >= deltay then
+ begin
+
+ Flag := FALSE;
+ { x is independent variable }
+ numpixels := deltax + 1;
+ d := (2 * deltay) - deltax;
+ dinc1 := deltay Shl 1;
+ dinc2 := (deltay - deltax) shl 1;
+ xinc1 := 1;
+ xinc2 := 1;
+ yinc1 := 0;
+ yinc2 := 1;
+ end
+ else
+ begin
+
+ Flag := TRUE;
+ { y is independent variable }
+ numpixels := deltay + 1;
+ d := (2 * deltax) - deltay;
+ dinc1 := deltax Shl 1;
+ dinc2 := (deltax - deltay) shl 1;
+ xinc1 := 0;
+ xinc2 := 1;
+ yinc1 := 1;
+ yinc2 := 1;
+ end;
+
+ { Make sure x and y move in the right directions }
+ if x1 > x2 then
+ begin
+ xinc1 := - xinc1;
+ xinc2 := - xinc2;
+ end;
+ if y1 > y2 then
+ begin
+ yinc1 := - yinc1;
+ yinc2 := - yinc2;
+ end;
+
+ { Start drawing at <x1, y1> }
+ x := x1;
+ y := y1;
+
+
+ If LineInfo.Thickness=NormWidth then
+
+ Begin
+
+ { Draw the pixels }
+ for i := 1 to numpixels do
+ begin
+ DirectPutPixel(x, y);
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ CurrentColor := OldCurrentColor;
+ end;
+ end
+ else
+ { Thick width lines }
+ begin
+ { Draw the pixels }
+ for i := 1 to numpixels do
+ begin
+ { all depending on the slope, we can determine }
+ { in what direction the extra width pixels will be put }
+ If Flag then
+ Begin
+ DirectPutPixelClip(x-1,y);
+ DirectPutPixelClip(x,y);
+ DirectPutPixelClip(x+1,y);
+ end
+ else
+ Begin
+ DirectPutPixelClip(x, y-1);
+ DirectPutPixelClip(x, y);
+ DirectPutPixelClip(x, y+1);
+ end;
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ CurrentColor := OldCurrentColor;
+ end;
+ end;
+ end;
+ end
+ else
+{******************************************}
+{ begin patterned lines }
+{******************************************}
+ Begin
+ { Convert to global coordinates. }
+ x1 := x1 + StartXViewPort;
+ x2 := x2 + StartXViewPort;
+ y1 := y1 + StartYViewPort;
+ y2 := y2 + StartYViewPort;
+ { if fully clipped then exit... }
+ if ClipPixels then
+ begin
+ if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+
+ OldCurrentColor := CurrentColor;
+ PixelCount:=0;
+ if y1 = y2 then
+ Begin
+ { Check if we must swap }
+ if x1 >= x2 then
+ Begin
+ swtmp := x1;
+ x1 := x2;
+ x2 := swtmp;
+ end;
+ if LineInfo.Thickness = NormWidth then
+ Begin
+ for PixelCount:=x1 to x2 do
+ { optimization: PixelCount mod 16 }
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixel(PixelCount,y2);
+ end;
+ end
+ else
+ Begin
+ for i:=-1 to 1 do
+ Begin
+ for PixelCount:=x1 to x2 do
+ { Optimization from Thomas - mod 16 = and 15 }
+ {this optimization has been performed by the compiler
+ for while as well (JM)}
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixelClip(PixelCount,y2+i);
+ end;
+ end;
+ end;
+ end
+ else
+ if x1 = x2 then
+ Begin
+ { Check if we must swap }
+ if y1 >= y2 then
+ Begin
+ swtmp := y1;
+ y1 := y2;
+ y2 := swtmp;
+ end;
+ if LineInfo.Thickness = NormWidth then
+ Begin
+ for PixelCount:=y1 to y2 do
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixel(x1,PixelCount);
+ end;
+ end
+ else
+ Begin
+ for i:=-1 to 1 do
+ Begin
+ for PixelCount:=y1 to y2 do
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixelClip(x1+i,PixelCount);
+ end;
+ end;
+ end;
+ end
+ else
+ Begin
+ oldCurrentColor := CurrentColor;
+ { Calculate deltax and deltay for initialisation }
+ deltax := abs(x2 - x1);
+ deltay := abs(y2 - y1);
+
+ { Initialize all vars based on which is the independent variable }
+ if deltax >= deltay then
+ begin
+
+ Flag := FALSE;
+ { x is independent variable }
+ numpixels := deltax + 1;
+ d := (2 * deltay) - deltax;
+ dinc1 := deltay Shl 1;
+ dinc2 := (deltay - deltax) shl 1;
+ xinc1 := 1;
+ xinc2 := 1;
+ yinc1 := 0;
+ yinc2 := 1;
+ end
+ else
+ begin
+
+ Flag := TRUE;
+ { y is independent variable }
+ numpixels := deltay + 1;
+ d := (2 * deltax) - deltay;
+ dinc1 := deltax Shl 1;
+ dinc2 := (deltax - deltay) shl 1;
+ xinc1 := 0;
+ xinc2 := 1;
+ yinc1 := 1;
+ yinc2 := 1;
+ end;
+
+ { Make sure x and y move in the right directions }
+ if x1 > x2 then
+ begin
+ xinc1 := - xinc1;
+ xinc2 := - xinc2;
+ end;
+ if y1 > y2 then
+ begin
+ yinc1 := - yinc1;
+ yinc2 := - yinc2;
+ end;
+
+ { Start drawing at <x1, y1> }
+ x := x1;
+ y := y1;
+
+ If LineInfo.Thickness=ThickWidth then
+
+ Begin
+ TmpNumPixels := NumPixels-1;
+ { Draw the pixels }
+ for i := 0 to TmpNumPixels do
+ begin
+ { all depending on the slope, we can determine }
+ { in what direction the extra width pixels will be put }
+ If Flag then
+ Begin
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[i and 15] = TRUE then
+ begin
+ DirectPutPixelClip(x-1,y);
+ DirectPutPixelClip(x,y);
+ DirectPutPixelClip(x+1,y);
+ end;
+ end
+ else
+ Begin
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[i and 15] = TRUE then
+ begin
+ DirectPutPixelClip(x,y-1);
+ DirectPutPixelClip(x,y);
+ DirectPutPixelClip(x,y+1);
+ end;
+ end;
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ end;
+ end
+ else
+ Begin
+ { instead of putting in loop , substract by one now }
+ TmpNumPixels := NumPixels-1;
+ { NormWidth }
+ for i := 0 to TmpNumPixels do
+ begin
+ if LinePatterns[i and 15] = TRUE then
+ begin
+ DirectPutPixel(x,y);
+ end;
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ end;
+ end
+ end;
+{******************************************}
+{ end patterned lines }
+{******************************************}
+ { restore color }
+ CurrentColor:=OldCurrentColor;
+ end;
+ end; { Line }
+
+
+ {********************************************************}
+ { Procedure DummyPatternLine() }
+ {--------------------------------------------------------}
+ { This is suimply an procedure that does nothing which }
+ { can be passed as a patternlineproc for non-filled }
+ { ellipses }
+ {********************************************************}
+ Procedure DummyPatternLine(x1, x2, y: smallint); {$ifdef tp} far; {$endif tp}
+ begin
+ end;
+
+
+ {********************************************************}
+ { Procedure InternalEllipse() }
+ {--------------------------------------------------------}
+ { This routine first calculates all points required to }
+ { draw a circle to the screen, and stores the points }
+ { to display in a buffer before plotting them. The }
+ { aspect ratio of the screen is taken into account when }
+ { calculating the values. }
+ {--------------------------------------------------------}
+ { INPUTS: X,Y : Center coordinates of Ellipse. }
+ { XRadius - X-Axis radius of ellipse. }
+ { YRadius - Y-Axis radius of ellipse. }
+ { stAngle, EndAngle: Start angle and end angles of the }
+ { ellipse (used for partial ellipses and circles) }
+ { pl: procedure which either draws a patternline (for }
+ { FillEllipse) or does nothing (arc etc) }
+ {--------------------------------------------------------}
+ { NOTE: - }
+ { - }
+ {********************************************************}
+
+ Procedure InternalEllipseDefault(X,Y: smallint;XRadius: word;
+ YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); {$ifndef fpc}far;{$endif fpc}
+ Const ConvFac = Pi/180.0;
+
+ var
+ j, Delta, DeltaEnd: graph_float;
+ NumOfPixels: longint;
+ TempTerm: graph_float;
+ xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
+ plxpyp, plxmyp, plxpym, plxmym: smallint;
+ BackupColor, TmpAngle, OldLineWidth: word;
+ Begin
+ If LineInfo.ThickNess = ThickWidth Then
+ { first draw the two outer ellipses using normwidth and no filling (JM) }
+ Begin
+ OldLineWidth := LineInfo.Thickness;
+ LineInfo.Thickness := NormWidth;
+ InternalEllipseDefault(x,y,XRadius,YRadius,StAngle,EndAngle,
+ {$ifdef fpc}@{$endif fpc}DummyPatternLine);
+ InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
+ {$ifdef fpc}@{$endif fpc}DummyPatternLine);
+ If (XRadius > 0) and (YRadius > 0) Then
+ { draw the smallest ellipse last, since that one will use the }
+ { original pl, so it could possibly draw patternlines (JM) }
+ Begin
+ Dec(XRadius);
+ Dec(YRadius);
+ End
+ Else Exit;
+ { restore line thickness }
+ LineInfo.Thickness := OldLineWidth;
+ End;
+ { Adjust for screen aspect ratio }
+ XRadius:=(longint(XRadius)*10000) div XAspect;
+ YRadius:=(longint(YRadius)*10000) div YAspect;
+ If xradius = 0 then inc(xradius);
+ if yradius = 0 then inc(yradius);
+ { check for an ellipse with negligable x and y radius }
+ If (xradius <= 1) and (yradius <= 1) then
+ begin
+ putpixel(x,y,CurrentColor);
+ ArcCall.X := X;
+ ArcCall.Y := Y;
+ ArcCall.XStart := X;
+ ArcCall.YStart := Y;
+ ArcCall.XEnd := X;
+ ArcCall.YEnd := Y;
+ exit;
+ end;
+ { check if valid angles }
+ stangle := stAngle mod 361;
+ EndAngle := EndAngle mod 361;
+ { if impossible angles then swap them! }
+ if Endangle < StAngle then
+ Begin
+ TmpAngle:=EndAngle;
+ EndAngle:=StAngle;
+ Stangle:=TmpAngle;
+ end;
+ { approximate the number of pixels required by using the circumference }
+ { equation of an ellipse. }
+ { Changed this formula a it (trial and error), but the net result is that }
+ { less pixels have to be calculated now }
+ NumOfPixels:=Round(Sqrt(3)*sqrt(sqr(XRadius)+sqr(YRadius)));
+ { Calculate the angle precision required }
+ Delta := 90.0 / NumOfPixels;
+ { for restoring after PatternLine }
+ BackupColor := CurrentColor;
+ { removed from inner loop to make faster }
+ { store some arccall info }
+ ArcCall.X := X;
+ ArcCall.Y := Y;
+ TempTerm := (StAngle)*ConvFac;
+ ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
+ ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
+ TempTerm := (EndAngle)*ConvFac;
+ ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
+ ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
+ { Always just go over the first 90 degrees. Could be optimized a }
+ { bit if StAngle and EndAngle lie in the same quadrant, left as an }
+ { exercise for the reader :) (JM) }
+ j := 0;
+ { calculate stop position, go 1 further than 90 because otherwise }
+ { 1 pixel is sometimes not drawn (JM) }
+ DeltaEnd := 91;
+ { Calculate points }
+ xnext := XRadius;
+ ynext := 0;
+ Repeat
+ xtemp := xnext;
+ ytemp := ynext;
+ { this is used by both sin and cos }
+ TempTerm := (j+Delta)*ConvFac;
+ { Calculate points }
+ xnext := round(XRadius*Cos(TempTerm));
+ ynext := round(YRadius*Sin(TempTerm+Pi));
+
+ xp := x + xtemp;
+ xm := x - xtemp;
+ yp := y + ytemp;
+ ym := y - ytemp;
+ plxpyp := maxsmallint;
+ plxmyp := -maxsmallint-1;
+ plxpym := maxsmallint;
+ plxmym := -maxsmallint-1;
+ If (j >= StAngle) and (j <= EndAngle) then
+ begin
+ plxpyp := xp;
+ PutPixel(xp,yp,CurrentColor);
+ end;
+ If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
+ begin
+ plxmyp := xm;
+ PutPixel(xm,yp,CurrentColor);
+ end;
+ If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
+ begin
+ plxmym := xm;
+ PutPixel(xm,ym,CurrentColor);
+ end;
+ If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
+ begin
+ plxpym := xp;
+ PutPixel(xp,ym,CurrentColor);
+ end;
+ If (ynext <> ytemp) and
+ (xp - xm >= 1) then
+ begin
+ CurrentColor := FillSettings.Color;
+ pl(plxmyp+1,plxpyp-1,yp);
+ pl(plxmym+1,plxpym-1,ym);
+ CurrentColor := BackupColor;
+ end;
+ j:=j+Delta;
+ Until j > (DeltaEnd);
+ end;
+
+
+ procedure PatternLineDefault(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+ {********************************************************}
+ { Draws a horizontal patterned line according to the }
+ { current Fill Settings. }
+ {********************************************************}
+ { Important notes: }
+ { - CurrentColor must be set correctly before entering }
+ { this routine. }
+ {********************************************************}
+ var
+ NrIterations: smallint;
+ i : smallint;
+ j : smallint;
+ TmpFillPattern : byte;
+ OldWriteMode : word;
+ OldCurrentColor : word;
+ begin
+ { convert to global coordinates ... }
+ x1 := x1 + StartXViewPort;
+ x2 := x2 + StartXViewPort;
+ y := y + StartYViewPort;
+ { if line was fully clipped then exit...}
+ if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+
+ OldWriteMode := CurrentWriteMode;
+ CurrentWriteMode := NormalPut;
+
+
+ { Get the current pattern }
+ TmpFillPattern := FillPatternTable
+ [FillSettings.Pattern][(y and $7)+1];
+
+ Case TmpFillPattern Of
+ 0:
+ begin
+ OldCurrentColor := CurrentColor;
+ CurrentColor := CurrentBkColor;
+ { hline converts the coordinates to global ones, but that has been done }
+ { already here!!! Convert them back to local ones... (JM) }
+ HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
+ CurrentColor := OldCurrentColor;
+ end;
+ $ff:
+ begin
+ HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
+ end;
+ else
+ begin
+ { number of times to go throuh the 8x8 pattern }
+ NrIterations := abs(x2 - x1+8) div 8;
+ For i:= 0 to NrIterations do
+ Begin
+ for j:=0 to 7 do
+ Begin
+ { x1 mod 8 }
+ if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
+ DirectPutpixel(x1,y)
+ else
+ begin
+ { According to the TP graph manual, we overwrite everything }
+ { which is filled up - checked against VGA and CGA drivers }
+ { of TP. }
+ OldCurrentColor := CurrentColor;
+ CurrentColor := CurrentBkColor;
+ DirectPutPixel(x1,y);
+ CurrentColor := OldCurrentColor;
+ end;
+ Inc(x1);
+ if x1 > x2 then
+ begin
+ CurrentWriteMode := OldWriteMode;
+ exit;
+ end;
+ end;
+ end;
+ end;
+ End;
+ CurrentWriteMode := OldWriteMode;
+ end;
+
+
+
+
+ procedure LineRel(Dx, Dy: smallint);
+
+ Begin
+ Line(CurrentX, CurrentY, CurrentX + Dx, CurrentY + Dy);
+ CurrentX := CurrentX + Dx;
+ CurrentY := CurrentY + Dy;
+ end;
+
+
+ procedure LineTo(x,y : smallint);
+
+ Begin
+ Line(CurrentX, CurrentY, X, Y);
+ CurrentX := X;
+ CurrentY := Y;
+ end;
+
+
+
+
+ procedure Rectangle(x1,y1,x2,y2:smallint);
+
+ begin
+ { Do not draw the end points }
+ Line(x1,y1,x2-1,y1);
+ Line(x1,y1+1,x1,y2);
+ Line(x2,y1,x2,y2-1);
+ Line(x1+1,y2,x2,y2);
+ end;
+
+
+ procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
+
+ begin
+ Activelineinfo:=Lineinfo;
+ end;
+
+
+ procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
+
+ var
+ i: byte;
+ j: byte;
+
+ Begin
+ if (LineStyle > UserBitLn) or ((Thickness <> Normwidth) and (Thickness <> ThickWidth)) then
+ _GraphResult := grError
+ else
+ begin
+ LineInfo.Thickness := Thickness;
+ LineInfo.LineStyle := LineStyle;
+ case LineStyle of
+ UserBitLn: Lineinfo.Pattern := pattern;
+ SolidLn: Lineinfo.Pattern := $ffff; { ------- }
+ DashedLn : Lineinfo.Pattern := $F8F8; { -- -- --}
+ DottedLn: LineInfo.Pattern := $CCCC; { - - - - }
+ CenterLn: LineInfo.Pattern := $FC78; { -- - -- }
+ end; { end case }
+ { setup pattern styles }
+ j:=16;
+ for i:=0 to 15 do
+ Begin
+ dec(j);
+ { bitwise mask for each bit in the word }
+ if (word($01 shl i) AND LineInfo.Pattern) <> 0 then
+ LinePatterns[j]:=TRUE
+ else
+ LinePatterns[j]:=FALSE;
+ end;
+ end;
+ end;
+
+
+
+
+{--------------------------------------------------------------------------}
+{ }
+{ VIEWPORT RELATED ROUTINES }
+{ }
+{--------------------------------------------------------------------------}
+
+
+Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
+var
+ j: smallint;
+ OldWriteMode, OldCurColor: word;
+ LineSets : LineSettingsType;
+Begin
+ { CP is always RELATIVE coordinates }
+ CurrentX := 0;
+ CurrentY := 0;
+
+ { Save all old settings }
+ OldCurColor := CurrentColor;
+ CurrentColor:=CurrentBkColor;
+ OldWriteMode:=CurrentWriteMode;
+ CurrentWriteMode:=NormalPut;
+ GetLineSettings(LineSets);
+ { reset to normal line style...}
+ SetLineStyle(SolidLn, 0, NormWidth);
+ { routines are relative here...}
+ { ViewHeight is Height-1 ! }
+ for J:=0 to ViewHeight do
+ HLine(0, ViewWidth , J);
+
+ { restore old settings...}
+ SetLineStyle(LineSets.LineStyle, LineSets.Pattern, LineSets.Thickness);
+ CurrentColor := OldCurColor;
+ CurrentWriteMode := OldWriteMode;
+end;
+
+
+Procedure SetViewPort(X1, Y1, X2, Y2: smallint; Clip: Boolean);
+Begin
+ if (X1 > GetMaxX) or (X2 > GetMaxX) or (X1 > X2) or (X1 < 0) then
+ Begin
+{$ifdef logging}
+ logln('invalid setviewport parameters: ('
+ +strf(x1)+','+strf(y1)+'), ('+strf(x2)+','+strf(y2)+')');
+ logln('maxx = '+strf(getmaxx)+', maxy = '+strf(getmaxy));
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+ if (Y1 > GetMaxY) or (Y2 > GetMaxY) or (Y1 > Y2) or (Y1 < 0) then
+ Begin
+{$ifdef logging}
+ logln('invalid setviewport parameters: ('
+ +strf(x1)+','+strf(y1)+'), ('+strf(x2)+','+strf(y2)+')');
+ logln('maxx = '+strf(getmaxx)+', maxy = '+strf(getmaxy));
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+ { CP is always RELATIVE coordinates }
+ CurrentX := 0;
+ CurrentY := 0;
+ StartXViewPort := X1;
+ StartYViewPort := Y1;
+ ViewWidth := X2-X1;
+ ViewHeight:= Y2-Y1;
+ ClipPixels := Clip;
+end;
+
+
+procedure GetViewSettings(var viewport : ViewPortType);
+begin
+ ViewPort.X1 := StartXViewPort;
+ ViewPort.Y1 := StartYViewPort;
+ ViewPort.X2 := ViewWidth + StartXViewPort;
+ ViewPort.Y2 := ViewHeight + StartYViewPort;
+ ViewPort.Clip := ClipPixels;
+end;
+
+procedure ClearDevice;
+var
+ ViewPort: ViewPortType;
+begin
+ { Reset the CP }
+ CurrentX := 0;
+ CurrentY := 0;
+ { save viewport }
+ ViewPort.X1 := StartXviewPort;
+ ViewPort.X2 := ViewWidth - StartXViewPort;
+ ViewPort.Y1 := StartYViewPort;
+ ViewPort.Y2 := ViewHeight - StartYViewPort;
+ ViewPort.Clip := ClipPixels;
+ { put viewport to full screen }
+ StartXViewPort := 0;
+ ViewHeight := MaxY;
+ StartYViewPort := 0;
+ ViewWidth := MaxX;
+ ClipPixels := TRUE;
+ ClearViewPort;
+ { restore old viewport }
+ StartXViewPort := ViewPort.X1;
+ ViewWidth := ViewPort.X2-ViewPort.X1;
+ StartYViewPort := ViewPort.Y1;
+ ViewHeight := ViewPort.Y2-ViewPort.Y1;
+ ClipPixels := ViewPort.Clip;
+end;
+
+
+
+{--------------------------------------------------------------------------}
+{ }
+{ BITMAP PUT/GET ROUTINES }
+{ }
+{--------------------------------------------------------------------------}
+
+
+ Procedure GetScanlineDefault (X1, X2, Y : smallint; Var Data); {$ifndef fpc}far;{$endif fpc}
+ {**********************************************************}
+ { Procedure GetScanLine() }
+ {----------------------------------------------------------}
+ { Returns the full scanline of the video line of the Y }
+ { coordinate. The values are returned in a WORD array }
+ { each WORD representing a pixel of the specified scanline }
+ { note: we only need the pixels inside the ViewPort! (JM) }
+ { note2: extended so you can specify start and end X coord }
+ { so it is usable for GetImage too (JM) }
+ {**********************************************************}
+
+
+ Var
+ x : smallint;
+ Begin
+ For x:=X1 to X2 Do
+ WordArray(Data)[x-x1]:=GetPixel(x, y);
+ End;
+
+
+
+Function DefaultImageSize(X1,Y1,X2,Y2: smallint): longint; {$ifndef fpc}far;{$endif fpc}
+Begin
+ { each pixel uses two bytes, to enable modes with colors up to 64K }
+ { to work. }
+ DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*2);
+end;
+
+Procedure DefaultPutImage(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
+type
+ pt = array[0..$fffffff] of word;
+ ptw = array[0..2] of longint;
+var
+ k: longint;
+ oldCurrentColor: word;
+ oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
+Begin
+{$ifdef logging}
+ LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
+ ' and height '+strf(ptw(Bitmap)[1]));
+ deltaY := 0;
+{$endif logging}
+ inc(x,startXViewPort);
+ inc(y,startYViewPort);
+ { width/height are 1-based, coordinates are zero based }
+ x1 := ptw(Bitmap)[0]+x-1; { get width and adjust end coordinate accordingly }
+ y1 := ptw(Bitmap)[1]+y-1; { get height and adjust end coordinate accordingly }
+
+ deltaX := 0;
+ deltaX1 := 0;
+ k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
+ { check which part of the image is in the viewport }
+ if clipPixels then
+ begin
+ if y < startYViewPort then
+ begin
+ deltaY := startYViewPort - y;
+ inc(k,(x1-x+1)*deltaY);
+ y := startYViewPort;
+ end;
+ if y1 > startYViewPort+viewHeight then
+ y1 := startYViewPort+viewHeight;
+ if x < startXViewPort then
+ begin
+ deltaX := startXViewPort-x;
+ x := startXViewPort;
+ end;
+ if x1 > startXViewPort + viewWidth then
+ begin
+ deltaX1 := x1 - (startXViewPort + viewWidth);
+ x1 := startXViewPort + viewWidth;
+ end;
+ end;
+{$ifdef logging}
+ LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
+{$endif logging}
+ oldCurrentColor := currentColor;
+ oldCurrentWriteMode := currentWriteMode;
+ currentWriteMode := bitBlt;
+ for j:=Y to Y1 do
+ Begin
+ inc(k,deltaX);
+ for i:=X to X1 do
+ begin
+ currentColor := pt(bitmap)[k];
+ directPutPixel(i,j);
+ inc(k);
+ end;
+ inc(k,deltaX1);
+ end;
+ currentWriteMode := oldCurrentWriteMode;
+ currentColor := oldCurrentColor;
+end;
+
+Procedure DefaultGetImage(X1,Y1,X2,Y2: smallint; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
+type
+ pt = array[0..$fffffff] of word;
+ ptw = array[0..2] of longint;
+var
+ i,j: smallint;
+ k: longint;
+Begin
+ k:= 3 * Sizeof(longint) div sizeof(word); { Three reserved longs at start of bitmap }
+ i := x2 - x1 + 1;
+ for j:=Y1 to Y2 do
+ Begin
+ GetScanLine(x1,x2,j,pt(Bitmap)[k]);
+ inc(k,i);
+ end;
+ ptw(Bitmap)[0] := X2-X1+1; { First longint is width }
+ ptw(Bitmap)[1] := Y2-Y1+1; { Second longint is height }
+ ptw(bitmap)[2] := 0; { Third longint is reserved}
+end;
+
+
+
+
+
+
+ Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
+ Begin
+ ArcCoords.X := ArcCall.X;
+ ArcCoords.Y := ArcCall.Y;
+ ArcCoords.XStart := ArcCall.XStart;
+ ArcCoords.YStart := ArcCall.YStart;
+ ArcCoords.XEnd := ArcCall.XEnd;
+ ArcCoords.YEnd := ArcCall.YEnd;
+ end;
+
+
+ procedure SetVisualPageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
+ begin
+ end;
+
+
+ procedure SetActivePageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
+ begin
+ end;
+
+ procedure DirectPutPixelDefault(X,Y: smallint);
+ begin
+ Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
+ Halt(1);
+ end;
+
+ function GetPixelDefault(X,Y: smallint): word;
+ begin
+ Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
+ Halt(1);
+ exit(0); { avoid warning }
+ end;
+
+ procedure PutPixelDefault(X,Y: smallint; Color: Word);
+ begin
+ Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
+ Halt(1);
+ end;
+
+ procedure SetRGBPaletteDefault(ColorNum, RedValue, GreenValue, BlueValue: smallint);
+ begin
+ Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
+ Halt(1);
+ end;
+
+ procedure GetRGBPaletteDefault(ColorNum: smallint; var
+ RedValue, GreenValue, BlueValue: smallint);
+ begin
+ Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
+ Halt(1);
+ end;
+
+
+ procedure OutTextXYDefault(x,y : smallint;const TextString : string);forward;
+ procedure CircleDefault(X, Y: smallint; Radius:Word);forward;
+
+{$i palette.inc}
+
+ Procedure DefaultHooks;
+ {********************************************************}
+ { Procedure DefaultHooks() }
+ {--------------------------------------------------------}
+ { Resets all hookable routine either to nil for those }
+ { which need overrides, and others to defaults. }
+ { This is called each time SetGraphMode() is called. }
+ {********************************************************}
+ Begin
+ { All default hooks procedures }
+
+ { required...}
+ DirectPutPixel := {$ifdef fpc}@{$endif}DirectPutPixelDefault;
+ PutPixel := {$ifdef fpc}@{$endif}PutPixelDefault;
+ GetPixel := {$ifdef fpc}@{$endif}GetPixelDefault;
+ SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteDefault;
+ GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteDefault;
+ { optional...}
+ SetAllPalette := {$ifdef fpc}@{$endif}SetAllPaletteDefault;
+ SetActivePage := {$ifdef fpc}@{$endif}SetActivePageDefault;
+ SetVisualPage := {$ifdef fpc}@{$endif}SetVisualPageDefault;
+ ClearViewPort := {$ifdef fpc}@{$endif}ClearViewportDefault;
+ PutImage := {$ifdef fpc}@{$endif}DefaultPutImage;
+ GetImage := {$ifdef fpc}@{$endif}DefaultGetImage;
+ ImageSize := {$ifdef fpc}@{$endif}DefaultImageSize;
+ GraphFreeMemPtr := nil;
+ GraphGetMemPtr := nil;
+ GetScanLine := {$ifdef fpc}@{$endif}GetScanLineDefault;
+ Line := {$ifdef fpc}@{$endif}LineDefault;
+ InternalEllipse := {$ifdef fpc}@{$endif}InternalEllipseDefault;
+ PatternLine := {$ifdef fpc}@{$endif}PatternLineDefault;
+ HLine := {$ifdef fpc}@{$endif}HLineDefault;
+ VLine := {$ifdef fpc}@{$endif}VLineDefault;
+ OuttextXY := {$ifdef fpc}@{$endif}OuttextXYDefault;
+ Circle := {$ifdef fpc}@{$endif}CircleDefault;
+ end;
+
+ Procedure InitVars;
+ {********************************************************}
+ { Procedure InitVars() }
+ {--------------------------------------------------------}
+ { Resets all internal variables, and resets all }
+ { overridable routines. }
+ {********************************************************}
+ Begin
+ DirectVideo := TRUE; { By default use fastest access possible }
+ ArcCall.X := 0;
+ ArcCall.Y := 0;
+ ArcCall.XStart := 0;
+ ArcCall.YStart := 0;
+ ArcCall.XEnd := 0;
+ ArcCall.YEnd := 0;
+ { Reset to default values }
+ IntCurrentMode := 0;
+ IntCurrentDriver := 0;
+ IntCurrentNewDriver := 0;
+ XAspect := 0;
+ YAspect := 0;
+ MaxX := 0;
+ MaxY := 0;
+ MaxColor := 0;
+ PaletteSize := 0;
+ DirectColor := FALSE;
+ HardwarePages := 0;
+ if hardwarepages=0 then; { remove note }
+ DefaultHooks;
+ end;
+
+{$i modes.inc}
+
+ function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
+ begin
+ _graphResult := grError;
+ InstallUserDriver:=grError;
+ end;
+
+ function RegisterBGIDriver(driver: pointer): smallint;
+
+ begin
+ _graphResult := grError;
+ RegisterBGIDriver:=grError;
+ end;
+
+
+
+{ ----------------------------------------------------------------- }
+
+
+ Procedure Arc(X,Y : smallint; StAngle,EndAngle,Radius: word);
+
+{ var
+ OldWriteMode: word;}
+
+ Begin
+ { Only if we are using thickwidths lines do we accept }
+ { XORput write modes. }
+{ OldWriteMode := CurrentWriteMode;
+ if (LineInfo.Thickness = NormWidth) then
+ CurrentWriteMode := NormalPut;}
+ InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
+{ CurrentWriteMode := OldWriteMode;}
+ end;
+
+
+ procedure Ellipse(X,Y : smallint; stAngle, EndAngle: word; XRadius,YRadius: word);
+ Begin
+ InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
+ end;
+
+
+ procedure FillEllipse(X, Y: smallint; XRadius, YRadius: Word);
+ {********************************************************}
+ { Procedure FillEllipse() }
+ {--------------------------------------------------------}
+ { Draws a filled ellipse using (X,Y) as a center point }
+ { and XRadius and YRadius as the horizontal and vertical }
+ { axes. The ellipse is filled with the current fill color}
+ { and fill style, and is bordered with the current color.}
+ {********************************************************}
+ begin
+ InternalEllipse(X,Y,XRadius,YRadius,0,360,PatternLine)
+ end;
+
+
+
+ procedure CircleDefault(X, Y: smallint; Radius:Word);
+ {********************************************************}
+ { Draws a circle centered at X,Y with the given Radius. }
+ {********************************************************}
+ { Important notes: }
+ { - Thickwidth circles use the current write mode, while}
+ { normal width circles ALWAYS use CopyPut/NormalPut }
+ { mode. (Tested against VGA BGI driver -CEC 13/Aug/99 }
+ {********************************************************}
+ var OriginalArcInfo: ArcCoordsType;
+ OldWriteMode: word;
+
+ begin
+ if (Radius = 0) then
+ Exit;
+
+ if (Radius = 1) then
+ begin
+ { only normal put mode is supported by a call to PutPixel }
+ PutPixel(X, Y, CurrentColor);
+ Exit;
+ end;
+
+ { save state of arc information }
+ { because it is not needed for }
+ { a circle call. }
+ move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
+ if LineInfo.Thickness = Normwidth then
+ begin
+ OldWriteMode := CurrentWriteMode;
+ CurrentWriteMode := CopyPut;
+ end;
+ InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
+ if LineInfo.Thickness = Normwidth then
+ CurrentWriteMode := OldWriteMode;
+ { restore arc information }
+ move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
+ end;
+
+ procedure SectorPL(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+ var plx1, plx2: smallint;
+ begin
+ If (x1 = -maxsmallint) Then
+ If (x2 = maxsmallint-1) Then
+ { no ellipse points drawn on this line }
+ If (((Y < ArcCall.Y) and (Y > ArcCall.YStart)) or
+ ((Y > ArcCall.Y) and (Y < ArcCall.YStart))) Then
+ { there is a part of the sector at this y coordinate, but no }
+ { ellips points are plotted on this line, so draw a patternline }
+ { between the lines connecting (arccall.x,arccall.y) with }
+ { the start and the end of the arc (JM) }
+ { use: y-y1=(y2-y1)/(x2-x1)*(x-x1) => }
+ { x = (y-y1)/(y2-y1)*(x2-x1)+x1 }
+ Begin
+ plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
+ div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
+ plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
+ div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
+ If plx1 > plx2 then
+ begin
+ plx1 := plx1 xor plx2;
+ plx2 := plx1 xor plx2;
+ plx1 := plx1 xor plx2;
+ end;
+ End
+ { otherwise two points which have nothing to do with the sector }
+ Else exit
+ Else
+ { the arc is plotted at the right side, but not at the left side, }
+ { fill till the line between (ArcCall.X,ArcCall.Y) and }
+ { (ArcCall.XStart,ArcCall.YStart) }
+ Begin
+ If (y < ArcCall.Y) then
+ begin
+ plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
+ div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
+ end
+ else if (y > ArcCall.Y) then
+ begin
+ plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
+ div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
+ end
+ else plx1 := ArcCall.X;
+ plx2 := x2;
+ End
+ Else
+ If (x2 = maxsmallint-1) Then
+ { the arc is plotted at the left side, but not at the rigth side. }
+ { the right limit can be either the first or second line. Just take }
+ { the closest one, but watch out for division by zero! }
+ Begin
+ If (y < ArcCall.Y) then
+ begin
+ plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
+ div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
+ end
+ else if (y > ArcCall.Y) then
+ begin
+ plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
+ div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
+ end
+ else plx2 := ArcCall.X;
+ plx1 := x1;
+ End
+ Else
+ { the arc is plotted at both sides }
+ Begin
+ plx1 := x1;
+ plx2 := x2;
+ End;
+ If plx2 > plx1 then
+ Begin
+ PatternLine(plx1,plx2,y);
+ end;
+ end;
+
+ procedure Sector(x, y: smallint; StAngle,EndAngle, XRadius, YRadius: Word);
+ begin
+ internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, {$ifdef fpc}@{$endif}SectorPL);
+ Line(ArcCall.XStart, ArcCall.YStart, x,y);
+ Line(x,y,ArcCall.Xend,ArcCall.YEnd);
+ end;
+
+
+
+ procedure SetFillStyle(Pattern : word; Color: word);
+
+ begin
+ { on invalid input, the current fill setting will be }
+ { unchanged. }
+ if (Pattern > UserFill) or (Color > GetMaxColor) then
+ begin
+{$ifdef logging}
+ logln('invalid fillstyle parameters');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+ FillSettings.Color := Color;
+ FillSettings.Pattern := Pattern;
+ end;
+
+
+ procedure SetFillPattern(Pattern: FillPatternType; Color: word);
+ {********************************************************}
+ { Changes the Current FillPattern to a user defined }
+ { pattern and changes also the current fill color. }
+ { The FillPattern is saved in the FillPattern array so }
+ { it can still be used with SetFillStyle(UserFill,Color) }
+ {********************************************************}
+ var
+ i: smallint;
+
+ begin
+ if Color > GetMaxColor then
+ begin
+{$ifdef logging}
+ logln('invalid fillpattern parameters');
+{$endif logging}
+ _GraphResult := grError;
+ exit;
+ end;
+
+ FillSettings.Color := Color;
+ FillSettings.Pattern := UserFill;
+
+ { Save the pattern in the buffer }
+ For i:=1 to 8 do
+ FillPatternTable[UserFill][i] := Pattern[i];
+
+ end;
+
+ procedure Bar(x1,y1,x2,y2:smallint);
+ {********************************************************}
+ { Important notes for compatibility with BP: }
+ { - WriteMode is always CopyPut }
+ { - No contour is drawn for the lines }
+ {********************************************************}
+ var y : smallint;
+ origcolor : longint;
+ origlinesettings: Linesettingstype;
+ origwritemode : smallint;
+ begin
+ origlinesettings:=lineinfo;
+ origcolor:=CurrentColor;
+ if y1>y2 then
+ begin
+ y:=y1;
+ y1:=y2;
+ y2:=y;
+ end;
+
+ { Always copy mode for Bars }
+ origwritemode := CurrentWriteMode;
+ CurrentWriteMode := CopyPut;
+
+ { All lines used are of this style }
+ Lineinfo.linestyle:=solidln;
+ Lineinfo.thickness:=normwidth;
+
+ case Fillsettings.pattern of
+ EmptyFill :
+ begin
+ Currentcolor:=CurrentBkColor;
+ for y:=y1 to y2 do
+ Hline(x1,x2,y);
+ end;
+ SolidFill :
+ begin
+ CurrentColor:=FillSettings.color;
+ for y:=y1 to y2 do
+ Hline(x1,x2,y);
+ end;
+ else
+ Begin
+ CurrentColor:=FillSettings.color;
+ for y:=y1 to y2 do
+ patternline(x1,x2,y);
+ end;
+ end;
+ CurrentColor:= Origcolor;
+ LineInfo := OrigLineSettings;
+ CurrentWriteMode := OrigWritemode;
+ end;
+
+
+
+
+procedure bar3D(x1, y1, x2, y2 : smallint;depth : word;top : boolean);
+var
+ origwritemode : smallint;
+ OldX, OldY : smallint;
+begin
+ origwritemode := CurrentWriteMode;
+ CurrentWriteMode := CopyPut;
+ Bar(x1,y1,x2,y2);
+ Rectangle(x1,y1,x2,y2);
+
+ { Current CP should not be updated in Bar3D }
+ { therefore save it and then restore it on }
+ { exit. }
+ OldX := CurrentX;
+ OldY := CurrentY;
+
+ if top then begin
+ Moveto(x1,y1);
+ Lineto(x1+depth,y1-depth);
+ Lineto(x2+depth,y1-depth);
+ Lineto(x2,y1);
+ end;
+ if Depth <> 0 then
+ Begin
+ Moveto(x2+depth,y1-depth);
+ Lineto(x2+depth,y2-depth);
+ Lineto(x2,y2);
+ end;
+ { restore CP }
+ CurrentX := OldX;
+ CurrentY := OldY;
+ CurrentWriteMode := origwritemode;
+end;
+
+
+
+{--------------------------------------------------------------------------}
+{ }
+{ COLOR AND PALETTE ROUTINES }
+{ }
+{--------------------------------------------------------------------------}
+
+
+ procedure SetColor(Color: Word);
+
+ Begin
+ CurrentColor := Color;
+ end;
+
+
+ function GetColor: Word;
+
+ Begin
+ GetColor := CurrentColor;
+ end;
+
+ function GetBkColor: Word;
+
+ Begin
+ GetBkColor := CurrentBkColor;
+ end;
+
+
+ procedure SetBkColor(ColorNum: Word);
+ { Background color means background screen color in this case, and it is }
+ { INDEPENDANT of the viewport settings, so we must clear the whole screen }
+ { with the color. }
+ var
+ ViewPort: ViewportType;
+ Begin
+ GetViewSettings(Viewport);
+{$ifdef logging}
+ logln('calling setviewport from setbkcolor');
+{$endif logging}
+ SetViewPort(0,0,MaxX,MaxY,FALSE);
+{$ifdef logging}
+ logln('calling setviewport from setbkcolor done');
+{$endif logging}
+ CurrentBkColor := ColorNum;
+ {ClearViewPort;}
+ if not DirectColor and (ColorNum<256) then
+ SetRGBPalette(0,
+ DefaultColors[ColorNum].Red,
+ DefaultColors[ColorNum].Green,
+ DefaultColors[ColorNum].Blue);
+ SetViewport(ViewPort.X1,Viewport.Y1,Viewport.X2,Viewport.Y2,Viewport.Clip);
+ end;
+
+
+ function GetMaxColor: word;
+ { Checked against TP VGA driver - CEC }
+
+ begin
+ GetMaxColor:=MaxColor-1; { based on an index of zero so subtract one }
+ end;
+
+
+
+
+
+
+ Procedure MoveRel(Dx, Dy: smallint);
+ Begin
+ CurrentX := CurrentX + Dx;
+ CurrentY := CurrentY + Dy;
+ end;
+
+ Procedure MoveTo(X,Y: smallint);
+ {********************************************************}
+ { Procedure MoveTo() }
+ {--------------------------------------------------------}
+ { Moves the current pointer in VIEWPORT relative }
+ { coordinates to the specified X,Y coordinate. }
+ {********************************************************}
+ Begin
+ CurrentX := X;
+ CurrentY := Y;
+ end;
+
+
+function GraphErrorMsg(ErrorCode: smallint): string;
+Begin
+ GraphErrorMsg:='';
+ case ErrorCode of
+ grOk,grFileNotFound,grInvalidDriver: exit;
+ grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
+ grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
+ grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
+ grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
+ grFontNotFound: GraphErrorMsg:= 'Font file not found';
+ grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
+ grError: GraphErrorMsg:='Graphics error';
+ grIoError: GraphErrorMsg:='Graphics I/O error';
+ grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
+ grInvalidVersion: GraphErrorMsg:='Invalid driver version';
+ end;
+end;
+
+
+
+
+ Function GetMaxX: smallint;
+ { Routine checked against VGA driver - CEC }
+ Begin
+ GetMaxX := MaxX;
+ end;
+
+ Function GetMaxY: smallint;
+ { Routine checked against VGA driver - CEC }
+ Begin
+ GetMaxY := MaxY;
+ end;
+
+
+
+
+Function GraphResult: smallint;
+Begin
+ GraphResult := _GraphResult;
+ _GraphResult := grOk;
+end;
+
+
+ Function GetX: smallint;
+ Begin
+ GetX := CurrentX;
+ end;
+
+
+ Function GetY: smallint;
+ Begin
+ GetY := CurrentY;
+ end;
+
+ Function GetDriverName: string;
+ begin
+ GetDriverName:=DriverName;
+ end;
+
+
+ procedure graphdefaults;
+ { PS: GraphDefaults does not ZERO the ArcCall structure }
+ { so a call to GetArcCoords will not change even the }
+ { returned values even if GraphDefaults is called in }
+ { between. }
+ var
+ i: smallint;
+ begin
+ lineinfo.linestyle:=solidln;
+ lineinfo.thickness:=normwidth;
+ { reset line style pattern }
+ for i:=0 to 15 do
+ LinePatterns[i] := TRUE;
+
+ { By default, according to the TP prog's reference }
+ { the default pattern is solid, and the default }
+ { color is the maximum color in the palette. }
+ fillsettings.color:=GetMaxColor;
+ fillsettings.pattern:=solidfill;
+ { GraphDefaults resets the User Fill pattern to $ff }
+ { checked with VGA BGI driver - CEC }
+ for i:=1 to 8 do
+ FillPatternTable[UserFill][i] := $ff;
+
+
+ CurrentColor:=white;
+
+
+ ClipPixels := TRUE;
+ { Reset the viewport }
+ StartXViewPort := 0;
+ StartYViewPort := 0;
+ ViewWidth := MaxX;
+ ViewHeight := MaxY;
+
+ { Reset CP }
+ CurrentX := 0;
+ CurrentY := 0;
+
+ SetBkColor(Black);
+
+ { normal write mode }
+ CurrentWriteMode := CopyPut;
+
+ { Schriftart einstellen }
+ CurrentTextInfo.font := DefaultFont;
+ CurrentTextInfo.direction:=HorizDir;
+ CurrentTextInfo.charsize:=1;
+ CurrentTextInfo.horiz:=LeftText;
+ CurrentTextInfo.vert:=TopText;
+
+ XAspect:=10000; YAspect:=10000;
+ end;
+
+
+ procedure GetAspectRatio(var Xasp,Yasp : word);
+ begin
+ XAsp:=XAspect;
+ YAsp:=YAspect;
+ end;
+
+ procedure SetAspectRatio(Xasp, Yasp : word);
+ begin
+ Xaspect:= XAsp;
+ YAspect:= YAsp;
+ end;
+
+
+ procedure SetWriteMode(WriteMode : smallint);
+ { TP sets the writemodes according to the following scheme (JM) }
+ begin
+ Case writemode of
+ xorput, andput: CurrentWriteMode := XorPut;
+ notput, orput, copyput: CurrentWriteMode := CopyPut;
+ End;
+ end;
+
+
+ procedure GetFillSettings(var Fillinfo:Fillsettingstype);
+ begin
+ Fillinfo:=Fillsettings;
+ end;
+
+ procedure GetFillPattern(var FillPattern:FillPatternType);
+ begin
+ FillPattern:=FillpatternTable[UserFill];
+ end;
+
+
+
+
+
+
+ procedure DrawPoly(numpoints : word;var polypoints);
+
+ type
+ ppointtype = ^pointtype;
+ pt = array[0..16000] of pointtype;
+
+ var
+ i : longint;
+
+ begin
+ if numpoints < 2 then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ for i:=0 to numpoints-2 do
+ line(pt(polypoints)[i].x,
+ pt(polypoints)[i].y,
+ pt(polypoints)[i+1].x,
+ pt(polypoints)[i+1].y);
+ end;
+
+
+ procedure PieSlice(X,Y,stangle,endAngle:smallint;Radius: Word);
+ begin
+ Sector(x,y,stangle,endangle,radius,radius);
+ end;
+
+{$i fills.inc}
+{$i gtext.inc}
+
+ procedure internDetectGraph(var GraphDriver, GraphMode:smallint;
+ calledFromInitGraph: boolean);
+ var LoMode, HiMode: smallint;
+ CpyMode: smallint;
+ CpyDriver: smallint;
+ begin
+ HiMode := -1;
+ LoMode := -1;
+ if not calledFromInitGraph or
+ (graphDriver < lowNewDriver) or
+ (graphDriver > highNewDriver) then
+ begin
+ { Search lowest supported bitDepth }
+ graphdriver := D1bit;
+ while (graphDriver <= highNewDriver) and
+ (hiMode = -1) do
+ begin
+ getModeRange(graphDriver,loMode,hiMode);
+ inc(graphDriver);
+ end;
+ dec(graphdriver);
+ if hiMode = -1 then
+ begin
+ _GraphResult := grNotDetected;
+ exit;
+ end;
+ CpyMode := 0;
+ repeat
+ GetModeRange(GraphDriver,LoMode,HiMode);
+ { save the highest mode possible...}
+ {$ifdef logging}
+ logln('Found driver '+strf(graphdriver)+' with modes '+
+ strf(lomode)+' - '+strf(himode));
+ {$endif logging}
+ if HiMode <> -1 then
+ begin
+ CpyMode:=HiMode;
+ CpyDriver:=GraphDriver;
+ end;
+ { go to next driver if it exists...}
+ Inc(graphDriver);
+ until (graphDriver > highNewDriver);
+ end
+ else
+ begin
+ cpyMode := 0;
+ getModeRange(graphDriver,loMode,hiMode);
+ if hiMode <> -1 then
+ begin
+ cpyDriver := graphDriver;
+ cpyMode := hiMode;
+ end;
+ end;
+ if cpyMode = 0 then
+ begin
+ _GraphResult := grNotDetected;
+ exit;
+ end;
+ _GraphResult := grOK;
+ GraphDriver := CpyDriver;
+ GraphMode := CpyMode;
+ end;
+
+ procedure detectGraph(var GraphDriver: smallint; var GraphMode:smallint);
+ begin
+ internDetectGraph(graphDriver,graphMode,false);
+ end;
+
+ procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;
+ const PathToDriver:String);
+ const
+ dirchar = System.DirectorySeparator;
+ begin
+ InitVars;
+ { path to the fonts (where they will be searched)...}
+ bgipath:=PathToDriver;
+ if (Length(bgipath) > 0) and (bgipath[length(bgipath)]<>dirchar) then
+ bgipath:=bgipath+dirchar;
+
+ if not assigned(SaveVideoState) then
+ RunError(216);
+ DriverName:=InternalDriverName; { DOS Graphics driver }
+
+ if (Graphdriver=Detect)
+ or (GraphMode = detectMode)
+ then
+ begin
+ internDetectGraph(GraphDriver,GraphMode,true);
+ If _GraphResult = grNotDetected then Exit;
+
+ { _GraphResult is now already set to grOK by DetectGraph }
+ IntCurrentDriver := GraphDriver;
+
+ if (graphDriver >= lowNewDriver) and
+ (graphDriver <= highNewDriver) then
+ IntCurrentNewDriver := GraphDriver
+ else IntCurrentNewDriver := -1;
+
+ { Actually set the graph mode...}
+ if firstCallOfInitgraph then
+ begin
+ SaveVideoState;
+ firstCallOfInitgraph := false;
+ end;
+ SetGraphMode(GraphMode);
+ end
+ else
+ begin
+ { Search if that graphics modec actually exists...}
+ if SearchMode(GraphDriver,GraphMode) = nil then
+ begin
+ _GraphResult := grInvalidMode;
+ exit;
+ end
+ else
+ begin
+ _GraphResult := grOK;
+ IntCurrentDriver := GraphDriver;
+
+ if (graphDriver >= lowNewDriver) and
+ (graphDriver <= highNewDriver) then
+ IntCurrentNewDriver := GraphDriver
+ else IntCurrentNewDriver := -1;
+
+ if firstCallOfInitgraph then
+ begin
+ SaveVideoState;
+ firstCallOfInitgraph := false;
+ end;
+ SetGraphMode(GraphMode);
+ end;
+ end;
+ end;
+
+
+ procedure SetDirectVideo(DirectAccess: boolean);
+ begin
+ DirectVideo := DirectAccess;
+ end;
+
+ function GetDirectVideo: boolean;
+ begin
+ GetDirectVideo := DirectVideo;
+ end;
+
+ procedure GraphExitProc; {$ifndef fpc} far; {$endif fpc}
+ { deallocates all memory allocated by the graph unit }
+ var
+ list: PModeInfo;
+ tmp : PModeInfo;
+ c: longint;
+ begin
+ { restore old exitproc! }
+ exitproc := exitsave;
+ if IsGraphMode and ((errorcode<>0) or (erroraddr<>nil)) then
+ CloseGraph;
+ { release memory allocated for fonts }
+ for c := 1 to installedfonts do
+ with fonts[c] Do
+ If assigned(instr) Then
+ Freemem(instr,instrlength);
+ { release memory allocated for modelist }
+ list := ModeList;
+ while assigned(list) do
+ begin
+ tmp := list;
+ list:=list^.next;
+ dispose(tmp);
+ end;
+ for c := lowNewDriver to highNewDriver do
+ begin
+ list := newModeList.modeinfo[c];
+ while assigned(list) do
+ begin
+ tmp := list;
+ list:=list^.next;
+ dispose(tmp);
+ end;
+ end;
+{$IFDEF DPMI}
+ { We had copied the buffer of mode information }
+ { and allocated it dynamically... now free it }
+ { Warning: if GetVESAInfo returned false, this buffer is not allocated! (JM)}
+ If hasVesa then
+ Dispose(VESAInfo.ModeList);
+{$ENDIF}
+ end;
+
+
+procedure InitializeGraph;
+begin
+{$ifdef logging}
+ assign(debuglog,'grlog.txt');
+ rewrite(debuglog);
+ close(debuglog);
+{$endif logging}
+ isgraphmode := false;
+ ModeList := nil;
+ fillChar(newModeList.modeinfo,sizeof(newModeList.modeinfo),#0);
+ { lo and hi modenumber are -1 currently (no modes supported) }
+ fillChar(newModeList.loHiModeNr,sizeof(newModeList.loHiModeNr),#255);
+ SaveVideoState := nil;
+ RestoreVideoState := nil;
+ { This must be called at startup... because GetGraphMode may }
+ { be called even when not in graph mode. }
+{$ifdef logging}
+ LogLn('Calling QueryAdapterInfo...');
+{$endif logging}
+ QueryAdapterInfo;
+ { Install standard fonts }
+ { This is done BEFORE startup... }
+ InstalledFonts := 0;
+ InstallUserFont('TRIP');
+ InstallUserFont('LITT');
+ InstallUserFont('SANS');
+ InstallUserFont('GOTH');
+ InstallUserFont('SCRI');
+ InstallUserFont('SIMP');
+ InstallUserFont('TSCR');
+ InstallUserFont('LCOM');
+ InstallUserFont('EURO');
+ InstallUserFont('BOLD');
+ { This installs an exit procedure which cleans up the mode list...}
+ ExitSave := ExitProc;
+ ExitProc := @GraphExitProc;
+{$ifdef win32}
+ charmessagehandler:=nil;
+{$endif win32}
+end;
+{
+ $Log: graph.inc,v $
+ Revision 1.10 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/graph.tex b/rtl/inc/graph/graph.tex
new file mode 100644
index 0000000000..f3b557533c
--- /dev/null
+++ b/rtl/inc/graph/graph.tex
@@ -0,0 +1,1917 @@
+%
+% $Id: graph.tex,v 1.1 2000/07/13 06:30:51 michael Exp $
+% This file is part of the FPC documentation.
+% Copyright (C) 1997,1999-2000 by the Free Pascal Development team
+%
+% The FPC documentation is free text; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public License as
+% published by the Free Software Foundation; either version 2 of the
+% License, or (at your option) any later version.
+%
+% The FPC Documentation is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with the FPC documentation; see the file COPYING.LIB. If not,
+% write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+% Boston, MA 02111-1307, USA.
+%
+% Documentation for the 'Graph' unit of Free Pascal.
+% Michael Van Canneyt, July 1997
+% Carl Eric Codere, April 1999
+\chapter{The GRAPH unit.}
+This document describes the \textbf{GRAPH} unit for Free Pascal. This unit includes
+more then 50 graphics routines, that range from low-level calls such as putpixel
+to high level calls like Circle and Bar3D. Different fill styles and line
+patterns are supported in most of the routines.
+
+\section{Overview}
+\label{se:Overview}
+
+\subsection{Compatibility}
+Since the graph unit included with \var{fpc} is a portable implementation of
+the Turbo Pascal unit, there are some slight differences between the video
+modes and features.
+
+\subsubsection{Initialization}
+
+Each graph unit implementation, will have a 320x200 resolution refered to
+\textit{LowResolution}. If the hardware for the specific platform does
+not support that resolution, then it will have to be emulated. Apart
+from that requirement, all other resolutions will be dependant on the
+target platform.
+
+The correct way and portable way to initialize to graphics subsystem, is
+to first query the hardware, and then from that, decide which mode you
+wish to support. The routine which does this is called \textit{QueryAdapterInfo}.
+This routine returns a linked list of modes availables, and their
+mode number as well as driver numbers. It is to note that this list is
+initialized only once during the lifetime of the application (that is,
+even if CloseGraph is called, the list will still be valid). The memory
+allocated for this list is automatically freed as part as the graph
+unit's exit procedure.
+
+You can always use Detect as a parameter to \textit{InitGraph}
+which will initialize the graphics to the highest resolution possible.
+
+The following constants are also defined for compatiblity with older
+applications written with Turbo Pascal, they should no longer be used:
+
+\begin{tabular}{|c|c|c|}
+\hline
+ Driver Name & Constant Name & Column x Row & Colors \\ \hline
+ VGA & VGAHi & 640x480 & 16 \\
+ VGA & VGALo & 640x200 & 16 \\
+ VGA & VGAMed & 640x350 & 16 \\
+ VGA & VGA256 & 320x200 & 256 \\
+\hline
+\end{tabular}
+
+\subsubsection{Other differences}
+
+Some notable differences with the Turbo Pascal graph unit are noted
+below:
+
+\begin{itemize}
+\item \textit{Rectangle} do not write
+ the end points twice, which permits the XORPut write mode to be used
+ effectively for erasing these forms on the screen.
+\item \textit{RegisterBGIDriver} and \textit{InstallUserDriver} always
+ return errors, as they are not directly supported.
+\item \textit{DrawPoly} XORPut write mode does not have the same behaviour
+ as the one in the Turbo Pascal graph unit.
+\item XORPut write mode is not supported by \textit{Bar3d}.
+\item Passing invalid parameters to \textit{SetTextStyle} will not
+ result in the same visual appearance. Make sure your input is valid.
+\item All routines using sines/cosines (e.g: \textit{circle}), don't
+ exactly have the same radii, because the aspect ratio correction is
+ different.
+\item PutImage supports clipping.
+\item \textit{SetRGBPalette} use the LSB's of the RGB components to
+set the color values of the palette. This makes the unit more portable.
+\item \textit{PaletteType} is different then the Turbo Pascal version,
+ it uses RGB Values for the palettes.
+\item \textit{SetAllPalette} is different then the Turbo Pascal version,
+ it uses the PaletteType as a parameter.
+\item \textit{GetDefaultPalette} only returns only at most the 256 first
+ default entries of a palette, even if the mode supports more then
+ 256 colors.
+\end{itemize}
+
+\subsection{Coordinate system}
+The upper left of the graphics screen is located at position (0,0). The x
+value, which represents the column, increments to the right. The y values,
+or rows, increment downward. The maximum value which can be set for an x
+value, for the graphics screen is given by the \textit{GetMaxX} routine.
+The same is true for the y coordinate, except a call to \textit{GetMaxY}
+is required.
+
+\subsection{Current pointer}
+Some graphics routines support the concept of the current pointer (CP). The
+current pointer is similar in concept to a text cursor, except that it is
+invisible.
+
+When you write in text mode, the text cursor is automatically incremented
+by the number of characters written. The same is true with the graphics
+current pointer, which is instead incremented on a pixel basis.
+
+For example, the following:
+\begin{verbatim}
+
+ MoveTo(0,0);
+ LineTo(100,100);
+
+\end{verbatim}
+
+will leave the current pointer to the (100,100) coordinate pair. The
+pixels might not be drawn depending on your clipping settings, but the
+CP is never clipped to clipping boundaries.
+
+The following routines set the CP to the new position:
+
+\begin{itemize}
+\item \textit{ClearDevice}
+\item \textit{ClearViewPort}
+\item \textit{GraphDefaults}
+\item \textit{InitGraph}
+\item \textit{LineRel}
+\item \textit{LineTo}
+\item \textit{MoveRel}
+\item \textit{MoveTo}
+\item \textit{OutText}
+\item \textit{SetGraphMode}
+\item \textit{SetViewPort}
+\end{itemize}
+
+\subsection{Error handling}
+
+There is only basic error checking in the graph unit. To get the value of
+the last error returned by a graphics driver call, call the
+\textit{GraphResult} routine. The following routines can set error codes,
+others don't :
+
+\begin{itemize}
+\item \textit{Bar} --- ok
+\item \textit{Bar3D} --- ok
+\item \textit{ClearViewPort}
+\item \textit{CloseGraph} --- ok
+\item \textit{DetectGraph} --- ok
+\item \textit{DrawPoly} --- ok
+\item \textit{FillPoly} --- ok
+\item \textit{FloodFill} --- ok
+\item \textit{GetModeName} --- ok
+\item \textit{GetRGBPalette} --- ok
+\item \textit{InitGraph} --- ok
+\item \textit{InstallUserDriver} --- ok
+\item \textit{InstallUserFont} --- ok
+\item \textit{PieSlice}
+\item \textit{RegisterBGIDriver} --- ok
+\item \textit{RegisterBGIFont} --- ok
+\item \textit{SetAllPalette} --- ok
+\item \textit{SetFillPattern} --- ok
+\item \textit{SetFillStyle} --- ok
+\item \textit{SetGraphBufSize}
+\item \textit{SetGraphMode}
+\item \textit{SetLineStyle} --- ok
+\item \textit{SetPalette} --- ok
+\item \textit{SetRGBPalette} --- ok
+\item \textit{SetTextJustify} --- ok
+\item \textit{SetTextStyle} --- ok
+\item \textit{SetViewPort} --- ok
+\end{itemize}
+
+\textit{GraphResult} is reset to zero after it has been called. Therefore
+the user should store the value returned by this function into a temporary
+variable and then use it.
+
+\subsection{Write modes}
+
+Write modes permits combining colors with already existing on-screen colors,
+\textit{PutImage} supports several write modes, while most other routines
+support only CopyPut/NormalPut and XORPut modes.
+
+The following routines support XORPut write modes (all routines support
+CopyPut modes):
+
+\begin{itemize}
+\item \textit{FillEllipse}
+\item \textit{FillPoly}
+\item \textit{Arc} with ThickWidth line styles only
+\item \textit{Circle} with ThickWidth line styles only
+\item \textit{Line}
+\item \textit{LineRel}
+\item \textit{LineTo}
+\item \textit{Rectangle}
+\item \textit{DrawPoly}
+\end{itemize}
+
+\subsection{Text}
+An internal bitmap font is included with this implementation of the graph
+unit. It also possible to load and use standard Borland CHR external
+vectorized font files. A bitmapped font is defined in this case by
+a matrix of 8x8 pixels. A vector font (also referred to as a stroked font)
+is defined by a series of vectors that tell the graphics system how to draw
+the font.
+
+\subsection{Clipping and Viewports}
+
+\textit{SetViewPort} makes all output commands operate in a rectangular
+region of the screen. Most output routines are viewport relative until
+the viewport is changed. If clipping is active, all graphics is output
+is clipped to the current region.
+
+There is always clipping to the screen boundaries, whatever the clipping
+setting is.
+
+\subsection{Internals}
+
+To make porting to a new platform easier, some of the graph unit routines
+have been designed using procedural variables. Some of the routines have
+default hooks, while others must absolutely be implemented for every new
+platform to make the graph unit work.
+
+The following routines must be created for every new platform supported:
+
+\begin{itemize}
+\item \textit{CloseGraph}
+\item \textit{DirectPutPixel}
+\item \textit{PutPixel}
+\item \textit{GetPixel}
+\item \textit{InitMode}
+\item \textit{SaveVideoState}
+\item \textit{RestoreVideoState}
+\item \textit{QueryAdapterInfo}
+\item \textit{SetRGBPalette}
+\item \textit{GetRGBPalette}
+\end{itemize}
+
+The following global variables must be setup for every new platform
+supported:
+ InternalDriverName
+
+\var{InternalDriverName}
+
+This variable should be set to a string describing the platform driver
+name. It is returned by the user function GetDriverName. Some examples
+of driver names are 'DosGX', 'DirectX', 'QuickDrw','CyberGFX', 'Dive'.
+
+
+
+
+\var{CloseGraph}
+
+The CloseGraph routine is called directly by the user and must
+do the necessary cleanup by freeing up all platform specific
+memory allocations, and by calling RestoreVideoState.
+
+\var{DirectPutPixel}
+
+This routine is one of the most important callback routines with
+PutPixel, it is called by most of the routines in the graph unit. It
+is about the same as PutPixel except that the coordinates passed to
+it are already in global (screen) coordinates, and that clipping has
+already been performed. Note that the current WriteMode has to be taken
+into account in this procedure.
+
+\var{InitMode}
+
+This callback routine is called by SetGraphMode to actualliy change to
+the correct video mode. (SetGraphMode is called by InitGraph).
+
+\var{SaveVideoState}
+
+This routine is called by InitGraph before changing to the graphics video
+mode, it should save the old video mode, save any internal video state
+such as the palette entries.
+
+\var{RestoreVideoState}
+
+This routine should be called by CloseGraph, it should restore the video
+mode to the one saved in SaveVideoState, and restore all appropriate video
+information, so that the video is in the same state as it was when
+SaveVideoState was called.
+
+\var{QueryAdapterInfo}
+
+This routine might be called by the user BEFORE we are in graphics
+mode. It is called by the initialization code of the graph unit. It
+creates a linked list of video capabilities and procedural hooks for
+all supported video modes on the platform. Look at the DOS version,
+to see how it works. This linked list can be read by the user before a
+call to InitGraph to determine which mode to use.
+
+The linked list is composed of mode information, as well to pointers
+to the callback routines cited above. Some additional optional hooks
+are also possible for those who wish to optimize the speed of the unit.
+
+
+-------------------------------------------------------------
+\begin{function}{GetModeName}
+\Declaration
+Function GetModeName (ModeNumber : smallint) : String;
+
+\Description
+
+Returns a string with the name of the specified graphics mode. The
+return values are in the form, XRes x YRes NAME. This function is
+useful for building menus, display status, and so forth.
+
+\Errors
+If the specified \var{ModeNumber} is invalid, the function returns an
+empty string and sets GraphResult to grInvalidMode.
+\SeeAlso
+\seef{GetDriverName}, \seep{GetModeRange}, \seep{GetMaxMode}
+\end{function}
+------------------------
+\begin{procedure}{SetAllPalette}
+\Declaration
+Procedure SetAllPalette(var Palette: PaletteType) ;
+\Description
+\var{Palette} is of type PaletteType. The first field in Palette
+contains the length of the palette. The next \textit{n} fields of
+type \var{RGBRec} contains the Red-Green-Blue components to replace
+that specific color with. A value of -1 will not change the previous
+entry's value.
+
+Note that valid colors depend on the current graphics mode.
+
+If the number of palette entries to replace is greater then the
+number of colors possible on the screen, \var{GraphResult} returns
+a value of \var{grError} and no changes to the palette settings will
+occur.
+
+Changes to the palette take effect immediately on the screen. Each time
+a palette color is changed, that color will be changed to the new color
+value.
+
+This routine returns \var{grError} if called in a direct color mode.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetRGBPalette}, \seep{SetPalette}
+\end{procedure}
+------------------------
+
+------------------------
+\begin{procedure}{GetDefaultPalette}
+\Declaration
+Procedure GetDefaultPalette (Var Palette : PaletteType);
+
+\Description
+Returns a \var{PaletteType} record containing the default RGB color
+values when the graphics mode is initialized. These values are based
+on the IBM-PC VGA hardware adapter, but do not change from platform
+to platform.
+
+On other platforms the colors may not exactly match those
+on the IBM-PC, but the match should be close enough for most uses. This
+value is static and does never change.
+
+Even if the modes can support more then 256 color entries, only the
+256 first colors can be considered as having default values. Therefore,
+at most this function will return 256 entries. To query all colors over
+256 yourself, use \var{GetRGBPalette} for the entire palette range.
+
+\Errors
+None.
+\SeeAlso
+\seef{GetColor}, \seef{GetBkColor}, \seep{GetRGBPalette}
+\end{procedure}
+
+
+------------------------
+\begin{procedure}{GetPalette}
+\Declaration
+Procedure GetPalette (Var Palette : PaletteType);
+
+\Description
+\var{GetPalette} returns in \var{Palette} the current palette. The palette
+is in LSB RGB format.
+
+This routine returns \var{grError} if called in a direct color mode.
+
+\Errors
+None.
+\SeeAlso
+\seef{GetPaletteSize}, \seep{SetPalette}
+\end{procedure}
+---------------------------
+---------------------------
+\begin{function}{GetBkColor}
+\Declaration
+Function GetBkColor : Word;
+
+\Description
+\var{GetBkColor} returns the current background color. If in non direct color
+mode, this returns the palette entry, otherwise it returns the direct
+RGB value of the current drawing color.
+\Errors
+None.
+\SeeAlso
+\seef{GetColor},\seep{SetBkColor}
+\end{function}
+---------------------------
+\begin{function}{GetColor}
+\Declaration
+Function GetColor : Word;
+
+\Description
+\var{GetColor} returns the current drawing color. If in non direct color
+mode, this returns the palette entry, otherwise it returns the direct
+RGB value of the current drawing color.
+\Errors
+None.
+\SeeAlso
+\seef{GetColor},\seep{SetBkColor}
+\end{function}
+---------------------------
+\begin{procedure}{GetRGBPalette}
+\Declaration
+Procedure GetRGBPalette (ColorNum: intege; var Red,Green,Blue : smallint);
+
+\Description
+\var{GetRGBPalette} gets the \var{ColorNum}-th entry in the palette.
+The Red , Green and Blue values returned arein LSB format.
+If the palette entry could not be read for a reason,
+the routine returns \var{grError}.
+
+This routine returns \var{grError} if called in a direct color mode.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetAllPallette},
+\seep{SetPalette}
+\seep{SetRGBPalette}
+\end{procedure}
+
+----------------------------
+----------------------------
+\begin{procedure}{SetDirectVideo}
+\Declaration
+Procedure SetDirectVideo (DirectAccess : boolean);
+
+\Description
+Determines how the video access should be done, if DirectAccess
+is set to TRUE then access will be done directly to video memory, if
+it is supported, otherwise Operating systems calls will be done to
+access the video memory.
+
+The behaviour of this routine depends on the platform, and is required
+for example to use the graph unit under older multitaskers such as
+Desqview (DOS platform). Certain modes re simply not supported
+via Operating system calls, while others are only supported by the
+operating system. In those cases this routine is simply ignored.
+
+Using operating system calls to plot pixels is much slower then using
+the direct mode, but it provides more compatibility.
+
+\textbf{Platform specific}
+Windows NT, OS/2, Windows '9x, Windows 3.x, Linux DOSEMU support
+all \textit{standard} video DOS modes, even in DirectVideo mode.
+Others, like Desqview, Topview, DoubleDOS and MultiDOS might not.
+In that case, \vaR{SetDirectVideo} should be called and set to FALSE.
+
+VESA modes are not considered as standard DOS video modes,
+and should simply not be used under such multitaskers/emulators.
+
+Mode-X is not considered a standard DOS mode, but is supported in
+most modern operating systems, since it uses only standard VGA
+I/O ports and memory. (Exception: older multitaskers such as Desqview).
+
+NOT IMPLEMENTED YET.
+
+
+\Errors
+None.
+\SeeAlso
+\seef{GetDirectVideo}
+\end{procedure}
+
+----------------------------
+\begin{function}{GetDirectVideo}
+\Declaration
+Function GetDirectVideo : boolean;
+
+\Description
+Returns the state of the of DirectAccess flag. If this value returns
+TRUE, then in the case where it is possible, the video memory is directly
+accessed to plot graphics points, otherwise operating system calls
+are used.
+
+
+\Errors
+None.
+\SeeAlso
+\seep{SetDirectVideo}
+\end{procedure}
+
+
+----------------------------
+
+
+\section{Reference}
+
+
+
+
+\section{Constants, Types and Variables}
+\subsection{Types}
+\begin{verbatim}
+ArcCoordsType = record
+ X,Y,Xstart,Ystart,Xend,Yend : smallint;
+end;
+FillPatternType = Array [1..8] of Byte;
+FillSettingsType = Record
+ Pattern,Color : Word
+end;
+LineSettingsType = Record
+ LineStyle,Pattern, Width : Word;
+end;
+
+
+
+PointType = Record
+ X,Y : smallint;
+end;
+TextSettingsType = Record
+ Font,Direction, CharSize, Horiz, Vert : Word
+end;
+ViewPortType = Record
+ X1,Y1,X2,Y2 : smallint;
+ Clip : Boolean
+end;
+\end{verbatim}
+
+\begin{verbatim}
+PaletteType = Record
+ Size : longint;
+ Colors : array[0..MaxColors] of RGBRec;
+end;
+\end{verbatim}
+
+This record is used by \textit{SetAllPalette} , \textit{GetPalette} and
+\textit{GetDefaultPalette}. \textit{Size} indicated the number of RGB
+entries in this record, followed by the RGB records for each color. It
+is to note, that contrary to Turbo Pascal, the RGB components are in
+the LSB's of the RGB component records. This makes easier compatibility
+across different hardware platforms.
+
+
+\section{Functions and procedures}
+
+
+\begin{procedure}{Arc}
+\Declaration
+Procedure Arc (X,Y : smallint; stAngle,Endangle, radius : Word);
+
+\Description
+ \var{Arc} draws part of a circle with center at \var{(X,Y)}, radius
+\var{radius}, starting from angle \var{stAngle}, stopping at angle \var{EndAngle}.
+These angles are measured counterclockwise. Information about the last call
+to \var{Arc} can be retrieved by \var{GetArcCoords}.
+\Errors
+None.
+\SeeAlso
+\seep{Circle},\seep{Ellipse}
+\seep{GetArcCoords},\seep{PieSlice}, \seep{Sector}
+\end{procedure}
+
+\begin{procedure}{Bar}
+\Declaration
+Procedure Bar (X1,Y1,X2,Y2 : smallint);
+
+\Description
+Draws a rectangle with corners at \var{(X1,Y1)} and \var{(X2,Y2)}
+and fills it with the current color and fill-style.
+\Errors
+None.
+\SeeAlso
+\seep{Bar3D},
+\seep{Rectangle}
+\end{procedure}
+
+\begin{procedure}{Bar3D}
+\Declaration
+Procedure Bar3D (X1,Y1,X2,Y2 : smallint; depth : Word; Top : Boolean);
+
+\Description
+Draws a 3-dimensional Bar with corners at \var{(X1,Y1)} and \var{(X2,Y2)}
+and fills it with the current color and fill-style.
+\var{Depth} specifies the number of pixels used to show the depth of the
+bar.
+If \var{Top} is true; then a 3-dimensional top is drawn.
+\Errors
+None.
+\SeeAlso
+\seep{Bar}, \seep{Rectangle}
+\end{procedure}
+
+\begin{procedure}{Circle}
+\Declaration
+Procedure Circle (X,Y : smallint; Radius : Word);
+
+\Description
+ \var{Circle} draws part of a circle with center at \var{(X,Y)}, radius
+\var{radius} in the current color. Each graphics driver contains an
+aspect ratio used by \var{Circle}, \var{Arc} and \var{PieSlice}.
+\Errors
+None.
+\SeeAlso
+\seep{Ellipse},\seep{Arc}
+\seep{GetArcCoords},\seep{PieSlice}, \seep{Sector}
+\end{procedure}
+
+\begin{procedure}{ClearDevice}
+\Declaration
+Procedure ClearDevice ;
+
+\Description
+Clears the graphical screen (with the current
+background color), and sets the pointer at \var{(0,0)}
+\Errors
+None.
+\SeeAlso
+\seep{ClearViewPort}, \seep{SetBkColor}
+\end{procedure}
+
+\begin{procedure}{ClearViewPort}
+\Declaration
+Procedure ClearViewPort ;
+
+\Description
+Clears the current viewport. The current background color is used as filling
+color. The pointer is set at \var{(0,0)}
+\Errors
+None.
+\SeeAlso
+\seep{ClearDevice},\seep{SetViewPort}, \seep{SetBkColor}
+\end{procedure}
+
+\begin{procedure}{CloseGraph}
+\Declaration
+Procedure CloseGraph ;
+
+\Description
+Closes the graphical system, restores the
+screen mode which was active before the graphical mode was
+activated and frees up any memory allocated in InitGraph.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}
+\end{procedure}
+
+\begin{procedure}{DetectGraph}
+\Declaration
+Procedure DetectGraph (Var Driver, Modus : smallint);
+
+\Description
+ Checks the hardware in the PC and determines the driver and screen-modus to
+be used. These are returned in \var{Driver} and \var{Modus}, and can be fed
+to \var{InitGraph}.
+See the \var{InitGraph} for a list of drivers and modi.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}
+\end{procedure}
+
+
+\begin{procedure}{DrawPoly}
+\Declaration
+Procedure DrawPoly (NumPoints : Word; Var PolyPoints);
+
+\Description
+
+Draws a polygon with \var{NumPoints} corner points, using the
+current color and linestyle. PolyPoints is an array of type \var{PointType}.
+
+If there are less the two points in \var{PolyPoints}, this routine
+returns \var{grError}.
+
+\Errors
+None.
+\SeeAlso
+\seep{Bar}, seep{Bar3D}, \seep{Rectangle}
+\end{procedure}
+
+\begin{procedure}{Ellipse}
+\Declaration
+Procedure Ellipse (X,Y : smallint; StAngle,EndAngle,XRadius,YRadius : Word);
+
+\Description
+ \var{Ellipse} draws part of an ellipse with center at \var{(X,Y)}.
+\var{XRadius} and \var{Yradius} are the horizontal and vertical radii of the
+ellipse. \var{StAngle} and \var{EndAngle} are the starting and stopping angles of
+the part of the ellipse. They are measured counterclockwise from the X-axis.
+
+Information about the last call to \var{Ellipse} can be retrieved by
+\var{GetArcCoords}.
+
+\Errors
+None.
+\SeeAlso
+\seep{Arc} \seep{Circle}, \seep{FillEllipse}
+\end{procedure}
+\begin{procedure}{FillEllipse}
+\Declaration
+Procedure FillEllipse (X,Y : smallint; Xradius,YRadius: Word);
+
+\Description
+ \var{Ellipse} draws an ellipse with center at \var{(X,Y)}.
+\var{XRadius} and \var{Yradius} are the horizontal and vertical radii of the
+ellipse. The ellipse is filled with the current color and fill style.
+\Errors
+None.
+\SeeAlso
+\seep{Arc} \seep{Circle},
+\seep{GetArcCoords},\seep{PieSlice}, \seep{Sector}
+\end{procedure}
+
+\begin{procedure}{FillPoly}
+\Declaration
+Procedure FillPoly (NumberPoints : Word; Var PolyPoints);
+
+\Description
+
+Draws a polygon with \var{NumPoints} corner points and fills it
+using the current color and fill style. The outline of the polygon
+is drawn in the current line style and color as set by \var{SetLineStyle}.
+PolyPoints is an array of type \var{PointType}.
+
+\Errors
+None.
+\SeeAlso
+\seep{Bar}, seep{Bar3D}, \seep{Rectangle}
+\end{procedure}
+\begin{procedure}{FloodFill}
+\Declaration
+Procedure FloodFill (X,Y : smallint; BorderColor : Word);
+
+\Description
+
+Fills the area containing the point \var{(X,Y)}, bounded by the color
+\var{BorderColor}. The flooding is done using the current fill style
+and fill color, as set by \var{SetFillStyle} or \var{SetFillPattern}.
+
+This routine is here for compatibility only, \var{FillPoly} should be
+used instead, since it is much faster.
+
+\Errors
+None
+\SeeAlso
+\seep{FillPoly},
+\end{procedure}
+
+\begin{procedure}{GetArcCoords}
+\Declaration
+Procedure GetArcCoords (Var ArcCoords : ArcCoordsType);
+
+\Description
+\var{GetArcCoords} returns the coordinates of the last \var{Arc} or
+\var{Ellipse} call. The values are useful for connecting a line to
+the end of an ellipse.
+\Errors
+None.
+\SeeAlso
+\seep{Arc}, \seep{Ellipse}
+\end{procedure}
+
+\begin{procedure}{GetAspectRatio}
+\Declaration
+Procedure GetAspectRatio (Var Xasp,Yasp : Word);
+
+\Description
+\var{GetAspectRatio} determines the effective resolution of the screen. The aspect ration can
+the be calculated as \var{Xasp/Yasp}.
+
+Each graphics driver uses this aspect ratio to make circles and any circular
+shape look round on the screen.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph},\seep{SetAspectRatio}
+\end{procedure}
+
+
+\begin{function}{GetDriverName}
+\Declaration
+Function GetDriverName : String;
+
+\Description
+\var{GetDriverName} returns a string containing the name of the
+current driver. This name can be anything under FPC, but it is
+usually indicative of the API and/or platform used to perform the
+graphics call.
+\Errors
+None.
+\SeeAlso
+\seef{GetModeName}, \seep{InitGraph}
+\end{function}
+
+\begin{procedure}{GetFillPattern}
+\Declaration
+Procedure GetFillPattern (Var FillPattern : FillPatternType);
+
+\Description
+\var{GetFillPattern} returns an array with the current fill pattern in \var{FillPattern}.
+If no user call has been made to \var{SetFillPattern}, the pattern will be
+filled with \var{$FF}.
+
+It is to note that the user fill pattern is reset to \var{$FF} each time
+\var{GraphDefaults} is called.
+
+\Errors
+None
+\SeeAlso
+\seep{SetFillPattern}, \seep{GraphDefaults}
+\end{procedure}
+
+\begin{procedure}{GetFillSettings}
+\Declaration
+Procedure GetFillSettings (Var FillInfo : FillSettingsType);
+
+\Description
+\var{GetFillSettings} returns the current fill-settings in
+\var{FillInfo}
+\Errors
+None.
+\SeeAlso
+\seep{SetFillPattern}
+\end{procedure}
+
+\begin{function}{GetGraphMode}
+\Declaration
+Function GetGraphMode : smallint;
+
+\Description
+\var{GetGraphMode} returns the current graphical mode. This value is
+entirely dependant on the hardware platform. To look up what this
+mode number represents from a capabilities standpoint, you should
+call either \var{QueryAdapterInfo} or \var{GetModeName} with the
+value returned by this function.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}, \seep{QueryAdapterInfo}, \seep{GetModeName}
+\end{function}
+
+\begin{procedure}{GetImage}
+\Declaration
+Procedure GetImage (X1,Y1,X2,Y2 : smallint, Var Bitmap);
+
+\Description
+\var{GetImage}
+Places a copy of the screen area \var{(X1,Y1)} to \var{X2,Y2} in \var{BitMap}.
+\var{Bitmap} is an untyped parameter that must be equal to 12 plus the size
+of the screen area to save. The first two longints of \var{Bitmap} store
+the width and height of the region. The third longint is reserved and should
+not be modified.
+
+To make access to the screen faster, it is recommended that the starting
+points and ending point coordinates be modulo 4 and that the width to
+save be also modulo 4.
+
+To get the size of the bitmap required to save the area, you should call
+\var{ImageSize}.
+
+\Errors
+Bitmap must have enough room to contain the image.
+\SeeAlso
+\seef{ImageSize},
+\seep{PutImage}
+\end{procedure}
+
+\begin{procedure}{GetLineSettings}
+\Declaration
+Procedure GetLineSettings (Var LineInfo : LineSettingsType);
+
+\Description
+\var{GetLineSettings} returns the current Line settings in
+\var{LineInfo}
+\Errors
+None.
+\SeeAlso
+\seep{SetLineStyle}
+\end{procedure}
+\begin{function}{GetMaxColor}
+\Declaration
+Function GetMaxColor : Word;
+
+\Description
+\var{GetMaxColor} returns the maximum color-number which can
+be set with \var{SetColor}. This value is zero based, so a screen
+which supports 16 colors, would return 15.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetColor},
+\seef{GetPaletteSize}
+\end{function}
+\begin{function}{GetMaxMode}
+\Declaration
+Function GetMaxMode : Word;
+
+\Description
+\var{GetMaxMode} returns the highest mode for the current driver. Normally
+the higher the mode number, the resolution it will be, but this might not
+always be the case.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}
+\end{function}
+
+\begin{function}{GetMaxX}
+\Declaration
+Function GetMaxX : Word;
+
+\Description
+\var{GetMaxX} returns the maximum horizontal screen
+length (zero based from 0..\var{MaxX}).
+\Errors
+None.
+\SeeAlso
+\seef{GetMaxY}
+\end{function}
+\begin{function}{GetMaxY}
+\Declaration
+Function GetMaxY : Word;
+
+\Description
+\var{GetMaxY} returns the maximum number of screen
+lines. (zero based from 0..\var{MaxY}).
+\Errors
+None.
+\SeeAlso
+\seef{GetMaxY}
+\end{function}
+
+\begin{procedure}{GetModeRange}
+\Declaration
+Procedure GetModeRange (GraphDriver : smallint; var LoMode, HiMode: smallint);
+
+\Description
+\var{GetModeRange} returns the Lowest and Highest mode of the currently
+installed driver. If the value of \var{GraphDriver} is invalid, \var{LoMode}
+and var{HiMode} are set to -1.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}, \seep{GetModeName}
+\end{procedure}
+\begin{function}{GetPaletteSize}
+\Declaration
+Function GetPaletteSize : Word;
+
+\Description
+\var{GetPaletteSize} returns the maximum number of entries which
+can be set in the current palette. In direct color mode, this simply
+returns the maximum possible of colors on screen.
+
+Usually this has the value \var{GetMaxColor} + 1.
+
+\Errors
+None.
+\SeeAlso
+\seep{GetPalette},
+\seep{SetPalette}
+\seep{GetMaxColor}
+\end{function}
+\begin{function}{GetPixel}
+\Declaration
+Function GetPixel (X,Y : smallint) : Word;
+
+\Description
+\var{GetPixel} returns the color
+of the point at \var{(X,Y)} The coordinates, as all coordinates
+are viewport relative.
+
+In direct color mode, the value returned is the direct RGB components of
+the color. In palette based modes, this indicates the palette entry number.
+
+\Errors
+None.
+\SeeAlso
+
+\end{function}
+\begin{procedure}{GetTextSettings}
+\Declaration
+Procedure GetTextSettings (Var TextInfo : TextSettingsType);
+
+\Description
+\var{GetTextSettings} returns the current text style settings : The font,
+direction, size and placement as set with \var{SetTextStyle} and
+\var{SetTextJustify}.
+\Errors
+None.
+\SeeAlso
+\seep{SetTextStyle}, \seep{SetTextJustify}
+
+\end{procedure}
+\begin{procedure}{GetViewSettings}
+\Declaration
+Procedure GetViewSettings (Var ViewPort : ViewPortType);
+
+\Description
+\var{GetViewSettings} returns the current view-port and clipping settings in
+\var{ViewPort}.
+\Errors
+None.
+\SeeAlso
+\seep{SetViewPort}
+\end{procedure}
+
+\begin{function}{GetX}
+\Declaration
+Function GetX : smallint;
+
+\Description
+\var{GetX} returns the X-coordinate of the current pointer. This value is
+viewport relative.
+\Errors
+None.
+\SeeAlso
+\seef{GetY}
+\end{function}
+\begin{function}{GetY}
+\Declaration
+Function GetY : smallint;
+
+\Description
+\var{GetY} returns the Y-coordinate of the current pointer. This value is
+viewport relative.
+\Errors
+None.
+\SeeAlso
+\seef{GetX}
+\end{function}
+\begin{procedure}{GraphDefaults}
+\Declaration
+Procedure GraphDefaults ;
+
+\Description
+\var{GraphDefaults} homes the current pointer, and resets the graphics
+system to the default values for:
+
+\begin{itemize}
+ \item Active Line style is reset to normal width and filled line.
+ \item The current fill color is set to the maximum palette color.
+ \item The current fill style is set to \var{solidfill}.
+ \item The user fill pattern is reset to \var{$FF}.
+ \item The current drawing color is set to white.
+ \item The current background color is reset to black.
+ \item The viewport is reset to (0,0,\var{GetMaxX},\var{GetMaxY}).
+ \item Clipping is enabled.
+ \item The active write mode is set to normalput.
+ \item Text settings are reset to : default font, \var{HorizDir},
+ \var{LeftText} and \var{TopText}.
+\end{itemize}
+
+This routine is called by \var{SetGraphMode}.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetViewPort}, \seep{SetFillStyle}, \seep{SetColor},
+\seep{SetBkColor}, \seep{SetLineStyle}, \seep{SetGraphMode}
+\end{procedure}
+
+\begin{function}{GraphErrorMsg}
+\Declaration
+Function GraphErrorMsg (ErrorCode : smallint) : String;
+
+\Description
+\var{GraphErrorMsg}
+returns a string describing the error \var{Errorcode}. This string can be
+used to let the user know what went wrong.
+\Errors
+None.
+\SeeAlso
+\seef{GraphResult}
+\end{function}
+\begin{function}{GraphResult}
+\Declaration
+Function GraphResult : smallint;
+
+\Description
+\var{GraphResult} returns an error-code for
+the last graphical operation. If the returned value is zero, all went well.
+A value different from zero means an error has occurred.
+
+Note that \var{GraphResult} is reset to zero after it has been called.
+Therefore the value should be saved into a temporary location if you wish
+to use it later.
+
+To see which routine might return errors, see the introduction section at
+the start of this reference.
+
+\Errors
+None.
+\SeeAlso
+\seef{GraphErrorMsg}
+\end{function}
+
+\begin{function}{ImageSize}
+\Declaration
+Function ImageSize (X1,Y1,X2,Y2 : smallint) : longint;
+
+\Description
+\var{ImageSize} returns the number of bytes needed to store the image
+by \var{GetImage} in the rectangle defined by \var{(X1,Y1)} and \var{(X2,Y2)}.
+The image size includes space for several words. The first three longints
+are reserved for use by \var{GetImage}, the first longint containing the
+width of the region, the second containing the height, and the third being
+reserved,the following words contains the bitmap itself.
+
+\textit{Compatibility:}
+ The value returned by this function is a 32-bit value,
+ and not a 16-bit value.
+
+\Errors
+None.
+\SeeAlso
+\seep{GetImage}
+\end{function}
+
+\begin{procedure}{InitGraph}
+\Declaration
+Procedure InitGraph (var GraphDriver,GraphModus : smallint;\\
+const PathToDriver : string);
+
+\Description
+
+\var{InitGraph} initializes the \var{graph} package.
+
+\var{GraphDriver} has two valid values: \var{GraphDriver=Detect} which
+performs an auto detect and initializes the highest possible mode with the most
+colors. This is dependant on the platform, and many of the non-standard
+modes amy not be detected automatically. \var{graphMode} is the mode you
+wish to use.
+
+\var{PathToDriver} is only needed, if you use the BGI fonts from
+Borland, which are fully supported under FPC.
+
+The exact rundown of \var{InitGraph} is as follows: First it calls
+\var{QueryAdapterInfo} to get the possible modes supported by the hardware.
+It then saves the video state, initalizes some global variables, then if
+auto-detection was requested, calls \var{GetModeRange} to get the highest
+possible mode available and supported, otherwise it searches if the requested
+mode is available in the database. Finally , in either case it calls
+\var{SetGraphMode}.
+
+If the requested driver or mode is invalid, this function returns either
+\var{grError} or \var{grInvalidMode}.
+
+Before calling this function, you should call QueryAdapterInfo, and
+go through the list of supported modes to determine which mode suites
+your needs. As stated in the introduction, each graph unit implementation
+should support a 320x200 color mode.
+
+\Errors
+None.
+\SeeAlso
+Introduction, (page \pageref{se:Introduction}),
+\seep{DetectGraph}, \seep{CloseGraph}, \seef{GraphResult},
+\seef{QueryAdapterInfo}
+\end{procedure}
+Example:
+\begin{verbatim}
+var
+ gd,gm : smallint;
+ PathToDriver : string;
+begin
+ gd:=detect; { highest possible resolution }
+ gm:=0; { not needed, auto detection }
+ PathToDriver:='C:\PP\BGI'; { path to BGI fonts,
+ drivers aren't needed }
+ InitGraph(gd,gm,PathToDriver);
+ if GraphResult<>grok then
+ halt; ..... { whatever you need }
+ CloseGraph; { restores the old graphics mode }
+end.
+\end{verbatim}
+
+\begin{function}{InstallUserDriver}
+\Declaration
+Function InstallUserDriver (DriverPath : String; AutoDetectPtr: Pointer) : smallint;
+
+\Description
+This routine is not supported in FPC, it is here only for compatiblity and
+always returns \var{grError}.
+
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}, \seef{InstallUserFont}
+\end{function}
+\begin{function}{InstallUserFont}
+\Declaration
+Function InstallUserFont (FontPath : String) : smallint;
+
+\Description
+\var{InstallUserFont} adds the font in \var{FontPath} to the list of fonts
+available to the text system. If the maximum number of allocated fonts has
+been reached, this routine sets \var{GraphResult} to \var{grError}.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}, \seef{InstallUserDriver}
+\end{function}
+\begin{procedure}{Line}
+\Declaration
+Procedure Line (X1,Y1,X2,Y2 : smallint);
+
+\Description
+\var{Line} draws a line starting from
+\var{(X1,Y1} to \var{(X2,Y2)}, in the current line style and color.
+The current pointer is not updated after this call.
+
+This is the base routine which is called by several other routines
+in this unit. This routine is somewhat faster then the other
+LineXXX routines contained herein.
+
+
+\Errors
+None.
+\SeeAlso
+\seep{LineRel},\seep{LineTo}
+\end{procedure}
+\begin{procedure}{LineRel}
+\Declaration
+Procedure LineRel (DX,DY : smallint);
+
+\Description
+\var{LineRel} draws a line starting from
+the current pointer position to the point\var{(DX,DY}, \textbf{relative} to the
+current position, in the current line style and color. The Current Position
+is set to the endpoint of the line.
+\Errors
+None.
+\SeeAlso
+\seep{Line}, \seep{LineTo}
+\end{procedure}
+\begin{procedure}{LineTo}
+\Declaration
+Procedure LineTo (DX,DY : smallint);
+
+\Description
+\var{LineTo} draws a line starting from
+the current pointer position to the point\var{(DX,DY}, \textbf{relative} to the
+current position, in the current line style and color. The Current position
+is set to the end of the line.
+\Errors
+None.
+\SeeAlso
+\seep{LineRel},\seep{Line}
+\end{procedure}
+\begin{procedure}{MoveRel}
+\Declaration
+Procedure MoveRel (DX,DY : smallint;
+
+\Description
+\var{MoveRel} moves the current pointer to the
+point \var{(DX,DY)}, relative to the current pointer
+position
+\Errors
+None.
+\SeeAlso
+\seep{MoveTo}
+\end{procedure}
+\begin{procedure}{MoveTo}
+\Declaration
+Procedure MoveTo (X,Y : smallint);
+
+\Description
+\var{MoveTo} moves the current pointer to the
+point \var{(X,Y)}.
+\Errors
+None.
+\SeeAlso
+\seep{MoveRel}
+\end{procedure}
+\begin{procedure}{OutText}
+\Declaration
+Procedure OutText (Const TextString : String);
+
+\Description
+\var{OutText} puts \var{TextString} on the screen, at the current pointer
+position, using the current font and text settings. The current pointer is
+updated only if the text justification is set to left and is horizontal.
+
+The text is truncated according to the current viewport settings if it
+cannot fit.
+
+In order to maintain compatibility when using several fonts, use \var{TextWidth}
+and \var{TextHeight} calls to determine the dimensions of the string.
+
+\Errors
+None.
+\SeeAlso
+\seep{OutTextXY}
+\end{procedure}
+\begin{procedure}{OutTextXY}
+\Declaration
+Procedure OutTextXY (X,Y : smallint; Const TextString : String);
+
+\Description
+\var{OutText} puts \var{TextString} on the screen, at position \var{(X,Y)},
+using the current font and text settings.
+
+Contrary to \var{OutText} , this routine does not update the current pointer.
+
+In order to maintain compatibility when using several fonts, use \var{TextWidth}
+and \var{TextHeight} calls to determine the dimensions of the string.
+
+\Errors
+None.
+\SeeAlso
+\seep{OutText}
+\end{procedure}
+\begin{procedure}{PieSlice}
+\Declaration
+Procedure PieSlice (X,Y,stangle,endAngle:smallint;Radius: Word);
+
+\Description
+\var{PieSlice}
+draws and fills a sector of a circle with center \var{(X,Y)} and radius
+\var{Radius}, starting at angle \var{StAngle} and ending at angle \var{EndAngle}
+using the current fill style and fill pattern. The pie slice is outlined
+with the current line style and current active color.
+\Errors
+None.
+\SeeAlso
+\seep{Arc}, \seep{Circle}, \seep{Sector}
+\end{procedure}
+\begin{procedure}{PutImage}
+\Declaration
+Procedure PutImage (X,Y: smallint; var Bitmap; BitBlt: Word);
+
+\Description
+\var{PutImage}
+Places the bitmap in \var{Bitmap} on the screen at upper left
+corner \var{(X, Y)}. \var{BitBlt} determines how the bitmap
+will be placed on the screen. Possible values are :
+\begin{itemize}
+\item CopyPut
+\item XORPut
+\item ORPut
+\item AndPut
+\item NotPut
+\end{itemize}
+
+\textit{Compatibility}
+
+Contrary to the Borland graph unit, putimage \textit{is} clipped to the
+viewport boundaries.
+
+\Errors
+None
+\SeeAlso
+\seef{ImageSize},\seep{GetImage}
+\end{procedure}
+\begin{procedure}{PutPixel}
+\Declaration
+Procedure PutPixel (X,Y : smallint; Color : Word);
+
+\Description
+Puts a point at
+\var{(X,Y)} using color \var{Color}. This routine is viewport
+relative.
+\Errors
+None.
+\SeeAlso
+\seef{GetPixel}
+\end{procedure}
+\begin{procedure}{Rectangle}
+\Declaration
+Procedure Rectangle (X1,Y1,X2,Y2 : smallint);
+
+\Description
+Draws a rectangle with
+corners at \var{(X1,Y1)} and \var{(X2,Y2)}, using the current color and
+the current line style.
+\Errors
+None.
+\SeeAlso
+\seep{Bar}, \seep{Bar3D}
+\end{procedure}
+\begin{function}{RegisterBGIDriver}
+\Declaration
+Function RegisterBGIDriver (Driver : Pointer) : smallint;
+
+\Description
+This routine is not supported in FPC. It is here for compatibility and it
+always returns \var{grError}.
+\Errors
+None.
+\SeeAlso
+\seef{InstallUserDriver},
+\seef{RegisterBGIFont}
+\end{function}
+\begin{function}{RegisterBGIFont}
+\Declaration
+Function RegisterBGIFont (Font : Pointer) : smallint;
+
+\Description
+This routine permits the user to add a font to the list of known fonts
+by the graph unit. \var{Font} is a pointer to image of the loaded font.
+
+The value returned is either a negative error number (\var{grInvalidFont}),
+or the font number you need to use when accessing it via \var{SetTextStyle}.
+
+This routine may be called before \var{InitGraph}.
+
+
+\textit{Compatibility}
+Watch out for the byte endian when using this routine. This might work
+on little endian machines, and not on big endian machines and vice-versa.
+
+
+\Errors
+None.
+\SeeAlso
+\seef{InstallUserFont},
+\seef{RegisterBGIDriver}
+\end{function}
+\begin{procedure}{RestoreCRTMode}
+\Declaration
+Procedure RestoreCRTMode ;
+
+\Description
+Restores the screen mode which was active before
+the graphical mode was started. Can be used to switch back and forth
+between text and graphics mode.
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}
+
+
+\end{procedure}
+
+Example:
+\begin{verbatim}
+uses Graph;
+
+var
+ Gd, Gm: smallint;
+ Mode: smallint;
+begin
+ Gd := Detect;
+ InitGraph(Gd, Gm, ' ');
+ if GraphResult <> grOk then
+ Halt(1);
+ OutText('<ENTER> to leave graphics:');
+ Readln;
+ RestoreCrtMode;
+ Writeln('Now in text mode');
+ Write('<ENTER> to enter graphics mode:');
+ Readln;
+ SetGraphMode(GetGraphMode);
+ OutTextXY(0, 0, 'Back in graphics mode');
+ OutTextXY(0, TextHeight('H'), '<ENTER> to quit:');
+ Readln;
+ CloseGraph;
+end.
+\end{verbatim}
+\begin{procedure}{Sector}
+\Declaration
+Procedure Sector (X,Y : smallint; StAngle,EndAngle,XRadius,YRadius : Word);
+
+\Description
+\var{Sector}
+draws and fills a sector of an ellipse with center \var{(X,Y)} and radii
+\var{XRadius} and \var{YRadius}, starting at angle \var{StAngle} and ending at angle
+\var{EndAngle}. The sector is outlined in the current color and filled with
+the pattern and color defined by \var{SetFillStyle} or \var{SetFillPattern}.
+\Errors
+None.
+\SeeAlso
+\seep{Arc}, \seep{Circle}, \seep{PieSlice}
+\end{procedure}
+\begin{procedure}{SetActivePage}
+\Declaration
+Procedure SetActivePage (Page : Word);
+
+\Description
+Sets \var{Page} as the active page
+for all graphical output. This means that all drawing will be done on this
+graphics, be it visible or not.
+
+The usual way to make fast animation, is to draw to a non visible active page
+and the simply call make that active page the visible page by calling
+\var{SetVisualPage}.
+
+\textit{Compatibility}:
+Not all systems and graphics mode support multiple graphics pages, to
+determine how many pages are available see \var{QueryAdapterInfo}.
+
+Multiple pages are currently not supported with DOS VESA modes.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetVisualPage}, \seep{QueryAdapterInfo}
+
+\end{procedure}
+\begin{procedure}{SetAllPallette}
+\Declaration
+Procedure SetAllPallette (Var Palette);
+
+\Description
+Sets the current palette to
+\var{Palette}. \var{Palette} is an untyped variable, usually pointing to a
+record of type \var{PaletteType} which contains the Red, Green and Blue
+components of the RGB components to change for each color entry. If
+the Red, Green and Blue components are equal to -1 for a specific color
+entry, then that palette entry will not be changed. The size should
+contain the size of the palette to change (indexed at zero).
+
+\textit{Compatibility}:
+
+This call is not the same as in Turbo Pascal. RGB components should be
+set in LSB if each of the components has less then 16-bits resolution.
+
+This call is not supported in direct color modes.
+
+\Errors
+None.
+\SeeAlso
+\seep{GetPalette}
+\end{procedure}
+\begin{procedure}{SetAspectRatio}
+\Declaration
+Procedure SetAspectRatio (Xasp,Yasp : Word);
+
+\Description
+Sets the aspect ratio of the
+current screen to \var{Xasp/Yasp}. The value of the aspect ratio is used
+by certain routines herein to draw circles which will actually appear round
+depending on the screen mode.
+\Errors
+None
+\SeeAlso
+\seep{InitGraph}, \seep{GetAspectRatio}
+\end{procedure}
+\begin{procedure}{SetBkColor}
+\Declaration
+Procedure SetBkColor (Color : Word);
+
+\Description
+Sets the background color to
+\var{Color}.
+
+The behaviour of this routine depends if we are in a direct color
+mode or not. In direct color mode, this value represents the direct
+RGB values to plot to the screen. In non direct color mode, the value
+represents an index to the color palette entry on the hardware.
+
+\Errors
+None.
+\SeeAlso
+\seef{GetBkColor}, \seep{SetColor}
+\end{procedure}
+\begin{procedure}{SetColor}
+\Declaration
+Procedure SetColor (Color : Word);
+
+\Description
+Sets the foreground color to
+\var{Color}.
+
+The behaviour of this routine depends if we are in a direct color
+mode or not. In direct color mode, this value represents the direct
+RGB values to plot to the screen. In non direct color mode, the value
+represents an index to the color palette entry on the hardware.
+
+\Errors
+None.
+\SeeAlso
+\seef{GetColor}, \seep{SetBkColor}
+\end{procedure}
+\begin{procedure}{SetFillPattern}
+\Declaration
+Procedure SetFillPattern (Pattern : FillPatternType, Color : Word);
+
+\Description
+\var{SetFillPattern} sets the current fill-pattern to \var{Pattern}, and
+the filling color to \var{Color}. If invalid input is passed to
+\var{SetFillPattern}, \var{GraphResult} will return \var{grError}.
+
+The pattern is an 8x8 raster, corresponding to the 64 bits in
+\var{FillPattern}. Whenever a bit in a pattern byte is valued at 1,
+a pixel will be plotted. The pattern and color is used by \var{Bar},
+\var{FillPoly}, \var{FloodFill}, \var{bar3d}, \var{FillEllipse},
+\var{Sector}, and \var{PieSlice}.
+
+
+\Errors
+None
+\SeeAlso
+\seep{GetFillPattern}, \seep{SetFillStyle}
+\end{procedure}
+\begin{procedure}{SetFillStyle}
+\Declaration
+Procedure SetFillStyle (Pattern, Color : word);
+
+\Description
+\var{SetFillStyle} sets the filling pattern and color to one of the
+predefined filling patterns. \var{Pattern} can be one of the following predefined
+constants :
+\begin{itemize}
+\item \var{EmptyFill } Uses backgroundcolor.
+\item \var{SolidFill } Uses filling color
+\item \var{LineFill } Fills with horizontal lines.
+\item \var{ltSlashFill} Fills with lines from left-under to top-right.
+\item \var{SlashFill } Idem as previous, thick lines.
+\item \var{BkSlashFill} Fills with thick lines from left-Top to bottom-right.
+\item \var{LtBkSlashFill} Idem as previous, normal lines.
+\item \var{HatchFill} Fills with a hatch-like pattern.
+\item \var{XHatchFill} Fills with a hatch pattern, rotated 45 degrees.
+\item \var{InterLeaveFill}
+\item \var{WideDotFill} Fills with dots, wide spacing.
+\item \var{CloseDotFill} Fills with dots, narrow spacing.
+\item \var{UserFill} Fills with a user-defined pattern.
+\end{itemize}
+
+If invalid input is passed to \var{SetFillStyle},
+\var{GraphResult} will return \var{grError}.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetFillPattern}
+\end{procedure}
+\begin{procedure}{SetGraphBufSize}
+\Declaration
+Procedure SetGraphBufSize (BufSize : Word);
+
+\Description
+This routine does nothing in FPC, and is here for compatibility.
+\Errors
+None.
+\SeeAlso
+
+\end{procedure}
+\begin{procedure}{SetGraphMode}
+\Declaration
+Procedure SetGraphMode (Mode : smallint);
+
+\Description
+\var{SetGraphMode} sets the
+graphical mode and clears the screen. \var{Mode} must be a valid mode,
+which can be queried by \var{QueryAdapterInfo}.
+
+If invalid input is passed to \var{SetGraphMode}, or if the mode cannot
+be set for a reason, \var{GraphResult} returns \var{grInvalidMode}.
+
+\var{SetGraphMode} resets all graphics variables to their default
+settings (such as if \var{GraphDefaults} was called, the active page
+is reset to page zero, the visual page is reset to page zero, and the viewport
+is set to the entire screen.
+
+\Errors
+None.
+\SeeAlso
+\seep{InitGraph}, \seep{QueryAdapterInfo}
+\end{procedure}
+\begin{procedure}{SetLineStyle}
+\Declaration
+Procedure SetLineStyle (LineStyle, Pattern, Thickness : Word);
+
+\Description
+\var{SetLineStyle}
+sets the drawing style for lines. You can specify a \var{LineStyle} which is
+one of the following pre-defined constants:
+\begin{itemize}
+\item \var{Solidln=0;} draws a solid line.
+\item \var{Dottedln=1;} Draws a dotted line.
+\item \var{Centerln=2;} draws a non-broken centered line.
+\item \var{Dashedln=3;} draws a dashed line.
+\item \var{UserBitln=4;} Draws a User-defined bit pattern.
+\end{itemize}
+If \var{UserBitln} is specified then \var{Pattern} contains the bit pattern to
+use for drawing the line. A bit of 1 specified a pixel which is on.
+
+In all another cases, \var{Pattern} is ignored. The parameter \var{Thickness}
+indicates how thick the line should be. You can specify one of the following
+pre-defined constants:
+\begin{itemize}
+\item \var{NormWidth=1}
+\item \var{ThickWidth=3}
+\end{itemize}
+
+If invalid input is passed to \var{SetLineStyle} , \var{GraphResult} will
+return \var{grError}.
+
+\Errors
+None.
+\SeeAlso
+\seep{GetLineSettings}
+\end{procedure}
+\begin{procedure}{SetPalette}
+\Declaration
+Procedure SetPalette (ColorNum : Word; Color : Shortint);
+
+\Description
+\var{SetPalette} changes the \var{ColorNum}-th entry in the palette to
+\var{Color}. For examples, \var{SetPalette(0, LightCyan)} makes the first
+color in the palette light cyan. \var{Color} only accepts certain default
+colors, as specified in the \var{Color constants} section. If invalid
+input is passed to \var{SetPalette}, \var{GraphResult} returns a value
+of \var{grError} and the palette remains intact.
+
+Changes made to the palette are immediately visible on the screen.
+
+This routine returns \var{grError} if called in a direct color mode.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetAllPallette},\seep{SetRGBPalette}
+\end{procedure}
+\begin{procedure}{SetRGBPalette}
+\Declaration
+Procedure SetRGBPalette (ColorNum,Red,Green,Blue : smallint);
+
+\Description
+\var{SetRGBPalette} sets the \var{ColorNum}-th entry in the palette to the
+color with RGB values \var{Red, Green Blue}. The Red , Green and Blue values
+must be in LSB format. If the palette entry could not be changed for a
+reason, the routine returns \var{grError}.
+
+This routine returns \var{grError} if called in a direct color mode.
+
+\Errors
+None.
+\SeeAlso
+\seep{SetAllPallette},
+\seep{SetPalette}
+\seep{GetRGBPalette}
+\end{procedure}
+\begin{procedure}{SetTextJustify}
+\Declaration
+Procedure SetTextJustify (Horiz, Vert : Word);
+
+\Description
+\var{SetTextJustify} controls the placement of new text, relative to the
+(graphical) cursor position. \var{Horiz} controls horizontal placement, and can be
+one of the following pre-defined constants:
+\begin{itemize}
+\item \var{LeftText=0;} Text is set left of the current pointer.
+\item \var{CenterText=1;} Text is set centered horizontally on the current pointer.
+\item \var{RightText=2;} Text is set to the right of the current pointer.
+\end{itemize}
+\var{Vertical} controls the vertical placement of the text, relative to the
+(graphical) cursor position. Its value can be one of the following
+pre-defined constants :
+\begin{itemize}
+\item \var{BottomText=0;} Text is placed under the current pointer.
+\item \var{CenterText=1;} Text is placed centered vertically on the current pointer.
+\item \var{TopText=2;}Text is placed above the current pointer.
+\end{itemize}
+
+If invalid input is passed \var{SetTextJustify} , \var{GraphResult} returns
+\var{grError}.
+
+\Errors
+None.
+\SeeAlso
+\seep{OutText}, \seep{OutTextXY}
+\end{procedure}
+\begin{procedure}{SetTextStyle}
+\Declaration
+Procedure SetTextStyle (Font,Direction,Magnitude : Word);
+
+\Description
+\var{SetTextStyle} controls the style of text to be put on the screen.
+pre-defined constants for \var{Font} are:
+\begin{itemize}
+\item \var{DefaultFont=0;}
+\item \var{TriplexFont=2;}
+\item \var{SmallFont=2;}
+\item \var{SansSerifFont=3;}
+\item \var{GothicFont=4;}
+\end{itemize}
+
+
+Pre-defined constants for \var{Direction} are :
+\begin{itemize}
+\item \var{HorizDir=0;}
+\item \var{VertDir=1;}
+\end{itemize}
+
+Charsize indicated the magnification factor to use when drawing the fonts
+to the screen. When using the default internal font, this value can be
+any value equal or greater to one. In the case of stroked fonts, the
+value should always be equal or greater then 4.
+
+Stroked fonts are usually loaded from disk once onto the heap when a call
+is made to \var{SetTextStyle}.
+
+If there is an error when using this routine, \var{GraphResult} might return
+\var{grFontNotFound}, \var{grNoFontMem}, \var{grError}, \var{grIoError},
+\var{grInvalidFont}, or \var{grInvalidFontNum}.
+
+\Errors
+None.
+\SeeAlso
+\seep{GetTextSettings}
+\end{procedure}
+\begin{procedure}{SetUserCharSize}
+\Declaration
+Procedure SetUserCharSize (Xasp1,Xasp2,Yasp1,Yasp2 : Word);
+
+\Description
+Sets the width and height of vector-fonts. The horizontal size is given
+by \var{Xasp1/Xasp2}, and the vertical size by \var{Yasp1/Yasp2}.
+\Errors
+None.
+\SeeAlso
+\seep{SetTextStyle}
+\end{procedure}
+\begin{procedure}{SetViewPort}
+\Declaration
+Procedure SetViewPort (X1,Y1,X2,Y2 : smallint; Clip : Boolean);
+
+\Description
+Sets the current graphical view-port (window) to the rectangle defined by
+the top-left corner \var{(X1,Y1)} and the bottom-right corner \var{(X2,Y2)}.
+If \var{Clip} is true, anything drawn outside the view-port (window) will be
+clipped (i.e. not drawn). Coordinates specified after this call are relative
+to the top-left corner of the view-port.
+\Errors
+None.
+\SeeAlso
+\seep{GetViewSettings}
+\end{procedure}
+\begin{procedure}{SetVisualPage}
+\Declaration
+Procedure SetVisualPage (Page : Word);
+
+\Description
+\var{SetVisualPage} sets the video page to page number \var{Page}.
+\Errors
+None
+\SeeAlso
+\seep{SetActivePage}
+\end{procedure}
+\begin{procedure}{SetWriteMode}
+\Declaration
+Procedure SetWriteMode (Mode : smallint);
+
+\Description
+\var{SetWriteMode} controls the drawing of lines on the screen. It controls
+the binary operation used when drawing lines on the screen. \var{Mode} can
+be one of the following pre-defined constants:
+\begin{itemize}
+\item CopyPut=0;
+\item XORPut=1;
+\end{itemize}
+
+If you specify another mode, it is mapped to one of the above acoording to
+the following table (for TP compatibility, may be changed in the future):
+\begin{itemize}
+\item Notput, Orput: CopyPut
+\item AndPut: XorPut
+\end{itemize}
+
+\Errors
+None.
+\SeeAlso
+
+\end{procedure}
+\begin{function}{TextHeight}
+\Declaration
+Function TextHeight (S : String) : Word;
+
+\Description
+\var{TextHeight} returns the height (in pixels) of the string \var{S} in
+the current font and text-size.
+
+\Errors
+None.
+\SeeAlso
+\seef{TextWidth}
+\end{function}
+\begin{function}{TextWidth}
+\Declaration
+Function TextWidth (S : String) : Word;
+
+\Description
+\var{TextHeight} returns the width (in pixels) of the string \var{S} in
+the current font and text-size.
+
+\Errors
+None.
+\SeeAlso
+\seef{TextHeight}
+\end{function}
+
+
diff --git a/rtl/inc/graph/graphh.inc b/rtl/inc/graph/graphh.inc
new file mode 100644
index 0000000000..b835daf8ec
--- /dev/null
+++ b/rtl/inc/graph/graphh.inc
@@ -0,0 +1,793 @@
+{
+ $Id: graphh.inc,v 1.9 2005/02/14 17:13:30 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface include file for graph unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{-------------------------------------------------------}
+{ Differences with TP Graph unit: }
+{ - default putimage and getimage only support a max. }
+{ of 64K colors on screen, because all pixels are }
+{ saved as words. }
+{ - Set RGB Palette is not used, SetPalette must be }
+{ used instead. }
+{ - In the TP graph unit, Clipping is always performed }
+{ on strings written with OutText, and this clipping }
+{ is done on a character per character basis (for }
+{ example, if ONE part of a character is outside the }
+{ viewport , then that character is not written at }
+{ all to the screen. In FPC Pascal, clipping is done }
+{ on a PIXEL basis, not a character basis, so part of }
+{ characters which are not entirely in the viewport }
+{ may appear on the screen. }
+{ - SetTextStyle only conforms to the TP version when }
+{ the correct (and expected) values are used for }
+{ CharSize for stroked fonts (4 = stroked fonts) }
+{ - InstallUserDriver is not supported, so always }
+{ returns an error. }
+{ - RegisterBGIDriver is not supported, so always }
+{ returns an error. }
+{ - DrawPoly XORPut mode is not exactly the same as in }
+{ the TP graph unit. }
+{ - Imagesize returns a longint instead of a word }
+{ - ImageSize cannot return an error value }
+{-------------------------------------------------------}
+{ AUTHORS: }
+{ Gernot Tenchio - original version }
+{ Florian Klaempfl - major updates }
+{ Pierre Mueller - major bugfixes }
+{ Carl Eric Codere - complete rewrite }
+{ Thomas Schatzl - optimizations,routines and }
+{ suggestions. }
+{ Jonas Maebe - bugfixes and optimizations }
+{ Credits (external): }
+{ - Original FloodFill code by }
+{ Menno Victor van der star }
+{ (the code has been heavily modified) }
+{-------------------------------------------------------}
+{-------------------------------------------------------}
+{ For significant speed improvements , is is recommended }
+{ that these routines be hooked (otherwise the default, }
+{ slower routines will be used) : }
+{ HLine() }
+{ VLine() }
+{ PatternLine() }
+{ ClearViewPort() }
+{ PutImage() }
+{ GetImage() - ImageSize() should also be changed }
+{ InternalEllipse() }
+{ Line() }
+{ GetScanLine() }
+{--------------------------------------------------------}
+{ FPC unit requirements: }
+{ All modes should at least have 1 graphics page to }
+{ make it possible to create animation on all supported }
+{ systems , this can be done either by double-buffering }
+{ yourself in the heap if no hardware is available to do}
+{ it. }
+{--------------------------------------------------------}
+{ COMPATIBILITY WARNING: Some of the compatibility tests }
+{ were done using the CGA and other the VGA drivers. }
+{ Within the BGI drivers themselves the BEHAVIOUR is not }
+{ the same, so be warned!!! }
+{--------------------------------------------------------}
+{ History log: }
+{ 15th February 1999: }
+{ + Added support for system font in vertical mode }
+{ + system font is now available for all platforms }
+{ * font support routines now compile }
+{ * textHeight would not return correct size for system }
+{ font }
+{ * Alignment of fonts partly fixed }
+{ 17th Feb. 1999: }
+{ + First support for stroked fonts }
+{ 18th Feb. 1999: }
+{ * bugfix of line drawing which fixes stroked font }
+{ displays. }
+{ 23rd Feb. 1999: }
+{ + Applied Pierre's patches to font }
+{ + Added scaling of bitmapped fonts }
+{ + Vertical stroked fonts }
+{ 24th Feb. 1999: }
+{ * Scaling of stroked fonts must be done using FPs }
+{ to be 100% compatible with turbo pascal }
+{ + Sped up by 40% stroked font scaling calculations }
+{ + RegisterBGIFont }
+{ 9th march 1999: }
+{ + Starting implementing Fillpoly() }
+{ 15th march 1999: }
+{ + SetFillStyle() }
+{ + patternLine() }
+{ + Bar() }
+{ * GraphDefaults would not make the Default color }
+{ of the fill pattern to the Max. Palette entry. }
+{ + SetFillPattern() }
+{ 20th march 1999: }
+{ * GraphDefaults would not reset to the text system }
+{ * DefaultFont would write one character too much to }
+{ the screen }
+{ + Sloped thick lines in Line() }
+{ + Sloped patterned lines in Line() }
+{ * GraphDefaults would not reset the User Fill pattern}
+{ to $ff }
+{ + DirectPutPixel takes care of XOR mode writes }
+{ improves speed by about 30% over old method of }
+{ GetPixel XOR CurrentColor }
+{ * Dashed LineStyle exactly like BP version now }
+{ + Center LineStyle (checked against CGA driver) }
+{ * GraphDefaults() now resets linepattern array }
+{ 1st april 1999: }
+{ + First implementation of FillPoly (incomplete) }
+{ 2nd april 1999: }
+{ * FillPoly did not Reset PatternLine index }
+{ * FillPoly did not use correct color }
+{ * PatternLine was writing modes in reverse direction }
+{ * PatternLine would not work with non-rectangular }
+{ shapes. }
+{ * PatternLine must fill up the ENTIRE pattern, }
+{ with either the foreground or background color. }
+{ * GraphDefaults() would not call SetBkColor() }
+{ * Fixed some memory leaks in FillPoly() }
+{ 11th April 1999: }
+{ * PatternLine() was drawing one pixel less then }
+{ requested }
+{ 12th April 1999: }
+{ + FloodFill - first working implementation }
+{ Horrbly slow even on very fast cpu's }
+{ + Some suggestions of Thomas implemented }
+{ 13th April 1999: }
+{ * FloodFill() vertical index was off by one pixel }
+{ * FloodFill() would never draw the last line in the }
+{ list }
+{ - Removed ClearViewPort320 which was wrong anyways, }
+{ will need to be implemented later. }
+{ * PatternLine() would not always restore write mode }
+{ + Circle() uses NormalPut always with NormWidth lines}
+{ + FillEllipse() initial version }
+{ * InternalEllipse() - 0 to 360 now supported as }
+{ angles. }
+{ 14th April 1999: }
+{ * mod x = and (x-1)(from Thomas Schatzl) gives a }
+{ significant speed improvement. }
+{ 15th april 1999: }
+{ + Arc() ok except for Aspect Ratio, which does not }
+{ give us the correct ratio on a 320x200 screen. }
+{ + Added FillPoly() from Thomas Schatzl }
+{ + More hookable routines }
+{ 16th april 1999: }
+{ + Line() checked ok. }
+{ 17th april 1999: }
+{ * GraphDefaults() would not reset CP }
+{ + GetX(), GetY(), MoveTo() checked for viewports }
+{ * OutTextXY() should not update the CP }
+{ * ClearViewPort() would not update the CP }
+{ * ClearDevice() would not update the CP }
+{ * Sector() would update the CP by calling LineTo }
+{ * Bar3D() would update the CP }
+{ * PieSlice() would update the CP }
+{ 18th april 1999: }
+{ + Clipping algorithm }
+{ 19th april 1999: }
+{ + Adapterinfo structure }
+{ 20th april 1999: }
+{ + GetModeName }
+{ + GetGraphMode }
+{ + GetModeRange }
+{--------------------------------------------------------}
+
+
+type
+ smallint = -32768..32767;
+
+ TResolutionRec = record
+ x,y: longint;
+ end;
+
+ const
+ maxsmallint = high(smallint);
+ { error codes }
+ grOk = 0;
+ grNoInitGraph = -1;
+ grNotDetected = -2;
+ grFileNotFound = -3;
+ grInvalidDriver = -4;
+ grNoLoadMem = -5;
+ grNoScanMem = -6;
+ grNoFloodMem = -7;
+ grFontNotFound = -8;
+ grNoFontMem = -9;
+ grInvalidMode = -10;
+ grError = -11;
+ grIOerror = -12;
+ grInvalidFont = -13;
+ grInvalidFontNum = -14;
+ grInvalidVersion = -18;
+
+
+ { Color constants for setpalette }
+ black = 0;
+ blue = 1;
+ green = 2;
+ cyan = 3;
+ red = 4;
+ magenta = 5;
+ brown = 6;
+ lightgray = 7;
+ darkgray = 8;
+ lightblue = 9;
+ lightgreen = 10;
+ lightcyan = 11;
+ lightred = 12;
+ lightmagenta = 13;
+ yellow = 14;
+ white = 15;
+
+ EGABlack = 0;
+ EGABlue = 1;
+ EGAGreen = 2;
+ EGACyan = 3;
+ EGARed = 4;
+ EGAMagenta = 5;
+ EGALightgray= 7;
+ EGABrown = 20;
+ EGADarkgray = 56;
+ EGALightblue = 57;
+ EGALightgreen = 58;
+ EGALightcyan = 59;
+ EGALightred = 60;
+ EGALightmagenta=61;
+ EGAYellow = 62;
+ EGAWhite = 63;
+
+
+
+ { Line styles for GetLineStyle/SetLineStyle }
+ SolidLn = 0;
+ DottedLn = 1;
+ CenterLn = 2;
+ DashedLn = 3;
+ UserBitLn = 4;
+
+ NormWidth = 1;
+ ThickWidth = 3;
+
+ { Set/GetTextStyle Konstanten: }
+ DefaultFont = 0;
+ TriplexFont = 1;
+ SmallFont = 2;
+ SansSerifFont = 3;
+ GothicFont = 4;
+ ScriptFont = 5;
+ SimpleFont = 6;
+ TSCRFont = 7;
+ LCOMFont = 8;
+ EuroFont = 9;
+ BoldFont = 10;
+
+ HorizDir = 0;
+ VertDir = 1;
+
+ UserCharSize = 0;
+
+ ClipOn = true;
+ ClipOff = false;
+
+ { Bar3D constants }
+ TopOn = true;
+ TopOff = false;
+
+ { fill pattern for Get/SetFillStyle: }
+ EmptyFill = 0;
+ SolidFill = 1;
+ LineFill = 2;
+ LtSlashFill = 3;
+ SlashFill = 4;
+ BkSlashFill = 5;
+ LtBkSlashFill = 6;
+ HatchFill = 7;
+ XHatchFill = 8;
+ InterleaveFill = 9;
+ WideDotFill = 10;
+ CloseDotFill = 11;
+ UserFill = 12;
+
+ { bitblt operators }
+ NormalPut = 0;
+ CopyPut = 0;
+ XORPut = 1;
+ OrPut = 2;
+ AndPut = 3;
+ NotPut = 4;
+
+ { SetTextJustify constants }
+ LeftText = 0;
+ CenterText = 1;
+ RightText = 2;
+
+ BottomText = 0;
+ TopText = 2;
+
+ { graphic drivers }
+ CurrentDriver = -128;
+ Detect = 0;
+ LowRes = 1;
+ HercMono = 7;
+ VGA = 9;
+ VESA = 10;
+
+
+ D1bit = 11;
+ D2bit = 12;
+ D4bit = 13;
+ D6bit = 14; { 64 colors Half-brite mode - Amiga }
+ D8bit = 15;
+ D12bit = 16; { 4096 color modes HAM mode - Amiga }
+ D15bit = 17;
+ D16bit = 18;
+ D24bit = 19; { not yet supported }
+ D32bit = 20; { not yet supported }
+ D64bit = 21; { not yet supported }
+
+ lowNewDriver = 11;
+ highNewDriver = 21;
+
+
+ { graph modes }
+ Default = 0;
+
+ { VGA Driver modes }
+ VGALo = 0;
+ VGAMed = 1;
+ VGAHi = 2;
+
+ { They start at such a high number to make sure they don't clash }
+ { with the mode numbers returned by getmoderange (those mode numbers }
+ { are about the same modes, but all supported modes must have a }
+ { consecutive mode number for that, so they are generated on-the-fly }
+ { starting from 1) }
+
+ detectMode = 30000;
+ m320x200 = 30001;
+ m320x256 = 30002; { amiga resolution (PAL) }
+ m320x400 = 30003; { amiga/atari resolution }
+ m512x384 = 30004; { mac resolution }
+ m640x200 = 30005; { vga resolution }
+ m640x256 = 30006; { amiga resolution (PAL) }
+ m640x350 = 30007; { vga resolution }
+ m640x400 = 30008;
+ m640x480 = 30009;
+ m800x600 = 30010;
+ m832x624 = 30011; { mac resolution }
+ m1024x768 = 30012;
+ m1280x1024 = 30013;
+ m1600x1200 = 30014;
+ m2048x1536 = 30015;
+
+ lowNewMode = 30001;
+ highNewMode = 30015;
+
+ resolutions: array[lowNewMode..highNewMode] of TResolutionRec =
+ ((x:320;y:200),
+ (x:320;y:256),
+ (x:320;y:400),
+ (x:512;y:384),
+ (x:640;y:200),
+ (x:640;y:256),
+ (x:640;y:350),
+ (x:640;y:400),
+ (x:640;y:480),
+ (x:800;y:600),
+ (x:832;y:624),
+ (x:1024;y:768),
+ (x:1280;y:1024),
+ (x:1600;y:1200),
+ (x:2048;y:1536));
+
+
+ { Hercules mono card }
+ HercMonoHi = 0;
+
+ MaxColors = 255; { Maximum possible colors using a palette }
+ { otherwise, direct color encoding }
+
+
+ type
+ RGBRec = packed record
+ Red: smallint;
+ Green: smallint;
+ Blue : smallint;
+ end;
+
+ PaletteType = record
+ Size : longint;
+ Colors : array[0..MaxColors] of RGBRec;
+ end;
+
+ LineSettingsType = record
+ linestyle : word;
+ pattern : word;
+ thickness : word;
+ end;
+
+ TextSettingsType = record
+ font : word;
+ direction : word;
+ charsize : word;
+ horiz : word;
+ vert : word;
+ end;
+
+ FillSettingsType = record
+ pattern : word;
+ color : word;
+ end;
+
+ FillPatternType = array[1..8] of byte;
+
+ PointType = record
+ x,y : smallint;
+ end;
+
+ ViewPortType = record
+ x1,y1,x2,y2 : smallint;
+ Clip : boolean;
+ end;
+
+ ArcCoordsType = record
+ x,y : smallint;
+ xstart,ystart : smallint;
+ xend,yend : smallint;
+ end;
+
+ graph_float = single; { the platform's preferred floating point size }
+
+ const
+ fillpatternTable : array[0..12] of FillPatternType = (
+ ($00,$00,$00,$00,$00,$00,$00,$00), { background color }
+ ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { foreground color }
+ ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { horizontal lines }
+ ($01,$02,$04,$08,$10,$20,$40,$80), { slashes }
+ ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { thick slashes }
+ ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { thick backslashes }
+ ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { backslashes }
+ ($ff,$88,$88,$88,$ff,$88,$88,$88), { small boxes }
+ ($18,$24,$42,$81,$81,$42,$24,$18), { rhombus }
+ ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { wall pattern }
+ ($80,$00,$08,$00,$80,$00,$08,$00), { wide points }
+ ($88,$00,$22,$00,$88,$00,$22,$00), { dense points }
+ (0,0,0,0,0,0,0,0) { user defined line style }
+ );
+
+
+
+ { ******************** PROCEDURAL VARIABLES ********************* }
+ { * These are hooks which have device specific stuff in them, * }
+ { * therefore to add new modes or to redirect these routines * }
+ { * then declare variables of these types as shown below. * }
+ {-----------------------------------------------------------------}
+
+TYPE
+
+
+ { This is the standard putpixel routine used by all function }
+ { drawing routines, it will use the viewport settings, as }
+ { well as clip, and use the current foreground color to plot }
+ { the desired pixel. }
+ defpixelproc = procedure(X,Y: smallint);
+
+ { standard plot and get pixel }
+ getpixelproc = function(X,Y: smallint): word;
+ putpixelproc = procedure(X,Y: smallint; Color: Word);
+
+ { clears the viewport, also used to clear the device }
+ clrviewproc = procedure;
+
+ { putimage procedure, can be hooked to accomplish transparency }
+ putimageproc = procedure (X,Y: smallint; var Bitmap; BitBlt: Word);
+ getimageproc = procedure(X1,Y1,X2,Y2: smallint; Var Bitmap);
+ imagesizeproc= function (X1,Y1,X2,Y2: smallint): longint;
+
+ graphfreememprc = procedure (var P: Pointer; size: word);
+ graphgetmemprc = procedure (var P: pointer; size: word);
+
+ { internal routines -- can be hooked for much faster drawing }
+
+ { draw filled horizontal lines using current color }
+ { on entry coordinates are already clipped. }
+ hlineproc = procedure (x, x2,y : smallint);
+ { on entry coordinates are already clipped. }
+ { draw filled vertical line using current color }
+ vlineproc = procedure (x,y,y2: smallint);
+
+ { this routine is used to draw filled patterns for all routines }
+ { that require it. (FillPoly, FloodFill, Sector, etc... }
+ { clipping is verified, uses current Fill settings for drawing }
+ patternlineproc = procedure (x1,x2,y: smallint);
+
+ { this routine is used to draw all circles/ellipses/sectors }
+ { more info... on this later... }
+ ellipseproc = procedure (X,Y: smallint;XRadius: word;
+ YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
+
+ { Line routine - draws lines thick/norm widths with current }
+ { color and line style - LINE must be clipped here. }
+ lineproc = procedure (X1, Y1, X2, Y2 : smallint);
+
+ { this routine is used for FloodFill - it returns an entire }
+ { screen scan line with a word for each pixel in the scanline. }
+ { Also handy for GetImage, so I added x coords as well (JM) }
+ getscanlineproc = procedure (X1, X2, Y : smallint; var data);
+
+ { changes the active display screen where we draw to... }
+ setactivepageproc = procedure (page: word);
+
+ { changes the active display screen which we see ... }
+ setvisualpageproc = procedure (page: word);
+
+ { this routine actually switches to the desired video mode. }
+ initmodeproc = procedure;
+
+ { this routine is called to save the sate just before a mode set }
+ savestateproc = procedure;
+ { this routine is called in closegraph to cleanup... }
+ restorestateproc = procedure;
+
+ { This routine is a hook for SetRGBPalette }
+ setrgbpaletteproc =
+ procedure(ColorNum, RedValue, GreenValue, BlueValue: smallint);
+
+ { This routine is a hook for GetRGBPalette }
+ getrgbpaletteproc =
+ procedure(ColorNum: smallint; var
+ RedValue, GreenValue, BlueValue: smallint);
+
+ SetAllPaletteProc = procedure(const Palette:PaletteType);
+
+ OutTextXYProc = procedure(x,y : SmallInt;const TextString : string);
+
+ CircleProc = procedure(X, Y: smallint; Radius:Word);
+
+
+TYPE
+ {-----------------------------------}
+ { Linked list for mode information }
+ { This list is set up by one of the }
+ { following routines: }
+ { It lists all available resolutions}
+ { on this display adapter. }
+ {-----------------------------------}
+ { QueryAdapter() }
+ { DetectGraph() }
+ { InitGraph() }
+ {-----------------------------------}
+ PModeInfo = ^TModeInfo;
+ TModeInfo = record
+ DriverNumber: smallint;
+ ModeNumber: smallint;
+ internModeNumber: smallint;
+ MaxColor: Longint; { Maximum colors on screen }
+ PaletteSize : Longint; { Maximum palette entry we can change }
+ XAspect : word; { XAspect ratio correction factor }
+ YAspect : word; { YAspect ratio correction factor }
+ MaxX: word; { Max-X row }
+ MaxY: word; { Max. column. }
+ DirectColor: boolean; { Is this a direct color mode?? }
+ Hardwarepages: byte; { total number of image pages - 1 }
+ ModeName: String[18];
+ { necessary hooks ... }
+ DirectPutPixel : DefPixelProc;
+ GetPixel : GetPixelProc;
+ PutPixel : PutPixelProc;
+ SetRGBPalette : SetRGBPaletteProc;
+ GetRGBPalette : GetRGBPaletteProc;
+ SetAllPalette : SetAllPaletteProc;
+ { defaults possible ... }
+ SetVisualPage : SetVisualPageProc;
+ SetActivePage : SetActivePageProc;
+ ClearViewPort : ClrViewProc;
+ PutImage : PutImageProc;
+ GetImage : GetImageProc;
+ ImageSize : ImageSizeProc;
+ GetScanLine : GetScanLineProc;
+ Line : LineProc;
+ InternalEllipse: EllipseProc;
+ PatternLine : PatternLineProc;
+ HLine : HLineProc;
+ VLine : VLineProc;
+ Circle : CircleProc;
+ InitMode : InitModeProc;
+ OutTextXY : OutTextXYProc;
+ next: PModeInfo;
+ end;
+
+ TNewModeInfo = record
+ modeInfo: array[lowNewDriver..highNewDriver] of PModeInfo;
+ loHiModeNr: array[lowNewDriver..highNewDriver] of record
+ lo,hi: smallint;
+ end;
+ end;
+
+
+
+VAR
+ DirectPutPixel : DefPixelProc;
+ ClearViewPort : ClrViewProc;
+ PutPixel : PutPixelProc;
+ PutImage : PutImageProc;
+ GetImage : GetImageProc;
+ ImageSize : ImageSizeProc;
+ GetPixel : GetPixelProc;
+ SetVisualPage : SetVisualPageProc;
+ SetActivePage : SetActivePageProc;
+ SetRGBPalette : SetRGBPaletteProc;
+ GetRGBPalette : GetRGBPaletteProc;
+ SetAllPalette : SetAllPaletteProc;
+ OutTextXY : OutTextXYProc;
+
+ GraphFreeMemPtr: graphfreememprc;
+ GraphGetMemPtr : graphgetmemprc;
+
+ GetScanLine : GetScanLineProc;
+ Line : LineProc;
+ InternalEllipse: EllipseProc;
+ PatternLine : PatternLineProc;
+ HLine : HLineProc;
+ VLine : VLineProc;
+ Circle : CircleProc;
+
+ SaveVideoState : SaveStateProc;
+ RestoreVideoState: RestoreStateProc;
+
+
+type
+ TCharsetTransTable = array[Char] of Char;
+ PCharsetTransTable = ^TCharsetTransTable;
+
+const
+
+ { The following table can be used for translating characters from the
+ Ansi charset (ISO8859-1) to the DOS ASCII charset (CP437).
+ To use this table, add the following line of code to your program:
+ GraphStringTransTable := @AnsiToASCIITransTable;
+ }
+
+ AnsiToASCIITransTable: TCharsetTransTable =
+ (#$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07, { $00 - $07 }
+ #$08, #$09, #$0a, #$0b, #$0c, #$0d, #$0e, #$0f, { $08 - $0f }
+ #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17, { $10 - $17 }
+ #$18, #$19, #$1a, #$1b, #$1c, #$1d, #$1e, #$1f, { $18 - $1f }
+ #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27, { $20 - $27 }
+ #$28, #$29, #$2a, #$2b, #$2c, #$2d, #$2e, #$2f, { $28 - $2f }
+ #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37, { $30 - $37 }
+ #$38, #$39, #$3a, #$3b, #$3c, #$3d, #$3e, #$3f, { $38 - $3f }
+ #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47, { $40 - $47 }
+ #$48, #$49, #$4a, #$4b, #$4c, #$4d, #$4e, #$4f, { $48 - $4f }
+ #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57, { $50 - $57 }
+ #$58, #$59, #$5a, #$5b, #$5c, #$5d, #$5e, #$5f, { $58 - $5f }
+ #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67, { $60 - $67 }
+ #$68, #$69, #$6a, #$6b, #$6c, #$6d, #$6e, #$6f, { $68 - $6f }
+ #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77, { $70 - $77 }
+ #$78, #$79, #$7a, #$7b, #$7c, #$7d, #$7e, #$7f, { $78 - $7f }
+ '?' , '?' , '?' , '?' , '?' , '?' , '?' , '?' , { $80 - $87 }
+ '?' , '?' , '?' , '?' , '?' , '?' , '?' , '?' , { $88 - $8f }
+ '?' , '?' , '?' , '?' , '?' , '?' , '?' , '?' , { $90 - $97 }
+ '?' , '?' , '?' , '?' , '?' , '?' , '?' , '?' , { $98 - $9f }
+ #$ff, #$ad, #$9b, #$9c, '?' , #$9d, '?' , '?' , { $a0 - $a7 }
+ '?' , '?' , #$a6, #$ae, #$aa, '?' , '?' , '?' , { $a8 - $af }
+ #$f8, #$f1, #$fd, '?' , '?' , #$e6, '?' , #$fa, { $b0 - $b7 }
+ '?' , '?' , #$a7, #$af, #$ac, #$ab, '?' , #$a8, { $b8 - $bf }
+ '?' , '?' , '?' , '?' , #$8e, #$8f, #$92, #$80, { $c0 - $c7 }
+ '?' , #$90, '?' , '?' , '?' , '?' , '?' , '?' , { $c8 - $cf }
+ '?' , #$a5, '?' , '?' , '?' , '?' , #$99, '?' , { $d0 - $d7 }
+ '?' , '?' , '?' , '?' , #$9a, '?' , '?' , #$e1, { $d8 - $df }
+ #$85, #$a0, #$83, '?' , #$84, #$86, #$91, #$87, { $e0 - $e7 }
+ #$8a, #$82, #$88, #$89, #$8d, #$a1, #$8c, #$8b, { $e8 - $ef }
+ '?' , #$a4, #$95, #$a2, #$93, '?' , #$94, #$f6, { $f0 - $f7 }
+ '?' , #$97, #$a3, #$96, #$81, '?' , '?' , #$98); { $f8 - $ff }
+
+
+ GraphStringTransTable: PCharsetTransTable = nil;
+ DrawTextBackground : boolean = false;
+
+function queryadapterinfo : pmodeinfo;
+
+Procedure Closegraph;
+procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
+function GraphErrorMsg(ErrorCode: smallint): string;
+Function GetMaxX: smallint;
+Function GetMaxY: smallint;
+Procedure SetViewPort(X1, Y1, X2, Y2: smallint; Clip: Boolean);
+Function GraphResult: smallint;
+function GetModeName(ModeNumber: smallint): string;
+procedure SetGraphMode(Mode: smallint);
+function GetGraphMode: smallint;
+function GetMaxMode: smallint;
+procedure RestoreCrtMode;
+procedure GetModeRange(GraphDriver: smallint; var LoMode, HiMode: smallint);
+Function GetX: smallint;
+Function GetY: smallint;
+procedure GraphDefaults;
+procedure ClearDevice;
+procedure GetViewSettings(var viewport : ViewPortType);
+procedure SetWriteMode(WriteMode : smallint);
+procedure GetFillSettings(var Fillinfo:Fillsettingstype);
+procedure GetFillPattern(var FillPattern:FillPatternType);
+procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
+procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;const PathToDriver:String);
+procedure DetectGraph(var GraphDriver:smallint;var GraphMode:smallint);
+function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
+function RegisterBGIDriver(driver: pointer): smallint;
+procedure SetFillStyle(Pattern : word; Color: word);
+procedure SetFillPattern(Pattern: FillPatternType; Color: word);
+Function GetDriverName: string;
+ procedure MoveRel(Dx, Dy: smallint);
+ procedure MoveTo(X,Y: smallint);
+
+ procedure SetDirectVideo(DirectAccess: boolean);
+ function GetDirectVideo: boolean;
+
+ { -------------------- Color/Palette ------------------------------- }
+ procedure SetBkColor(ColorNum: Word);
+ function GetColor: Word;
+ function GetBkColor: Word;
+ procedure SetColor(Color: Word);
+ function GetMaxColor: word;
+
+ procedure SetPalette(ColorNum: word; Color: shortint);
+ procedure GetPalette(var Palette: PaletteType);
+ function GetPaletteSize: smallint;
+ procedure GetDefaultPalette(var Palette: PaletteType);
+
+
+ { -------------------- Shapes/Lines -------------------------------- }
+ procedure Rectangle(x1,y1,x2,y2:smallint);
+ procedure Bar(x1,y1,x2,y2:smallint);
+ procedure Bar3D(x1, y1, x2, y2 : smallint;depth : word;top : boolean);
+ procedure FillPoly(NumPoints: word; Var PolyPoints);
+ procedure DrawPoly(NumPoints : word;var polypoints);
+ procedure LineRel(Dx, Dy: smallint);
+ procedure LineTo(X,Y : smallint);
+ procedure FloodFill(x : smallint; y : smallint; Border: word);
+
+ { -------------------- Circle related routines --------------------- }
+ procedure GetAspectRatio(var Xasp,Yasp : word);
+ procedure SetAspectRatio(Xasp, Yasp : word);
+ procedure GetArcCoords(var ArcCoords: ArcCoordsType);
+
+
+ procedure Arc(X,Y : smallint; StAngle,EndAngle,Radius: word);
+ procedure PieSlice(X,Y,stangle,endAngle:smallint;Radius: Word);
+ procedure FillEllipse(X, Y: smallint; XRadius, YRadius: Word);
+ procedure Sector(x, y: smallint; StAngle,EndAngle, XRadius, YRadius: Word);
+ procedure Ellipse(X,Y : smallint; stAngle, EndAngle: word; XRadius,
+ YRadius: word);
+
+ { --------------------- Text related routines --------------------- }
+ function InstallUserFont(const FontFileName : string) : smallint;
+ function RegisterBGIfont(font : pointer) : smallint;
+ procedure GetTextSettings(var TextInfo : TextSettingsType);
+ function TextHeight(const TextString : string) : word;
+ function TextWidth(const TextString : string) : word;
+ procedure SetTextJustify(horiz,vert : word);
+ procedure SetTextStyle(font,direction : word;charsize : word);
+ procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
+
+ procedure OutText(const TextString : string);
+
+
+{
+ $Log: graphh.inc,v $
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/gtext.inc b/rtl/inc/graph/gtext.inc
new file mode 100644
index 0000000000..ef897844aa
--- /dev/null
+++ b/rtl/inc/graph/gtext.inc
@@ -0,0 +1,797 @@
+{
+ $Id: gtext.inc,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***************************************************************************}
+{ Text output routines }
+{***************************************************************************}
+
+ const
+ maxfonts = 16; { maximum possible fonts }
+ MaxChars = 255; { Maximum nr. of characters in a file }
+ Prefix_Size = $80; { prefix size to skip }
+ SIGNATURE = '+'; { Signature of CHR file }
+
+ type
+ { Prefix header of Font file }
+{ PFHeader = ^TFHeader;}
+ TFHeader = packed record
+ header_size: word; {* Version 2.0 Header Format *}
+ font_name: array[1..4] of char;
+ font_size: word; {* Size in byte of file *}
+ font_major: byte; {* Driver Version Information *}
+ font_minor: byte;
+ min_major: byte; {* BGI Revision Information *}
+ min_minor: byte;
+ end;
+
+
+ { Font record information }
+{ PHeader = ^THeader;}
+ THeader = packed record
+ Signature: char; { signature byte }
+ Nr_chars: smallint; { number of characters in file }
+ Reserved: byte;
+ First_char: byte; { first character in file }
+ cdefs : smallint; { offset to character definitions }
+ scan_flag: byte; { TRUE if char is scanable }
+ org_to_cap: shortint; { Height from origin to top of capitol }
+ org_to_base:shortint; { Height from origin to baseline }
+ org_to_dec: shortint; { Height from origin to bot of decender }
+ _reserved: array[1..4] of char;
+ Unused: byte;
+ end;
+
+
+ TOffsetTable =array[0..MaxChars] of smallint;
+ TWidthTable =array[0..MaxChars] of byte;
+
+ tfontrec = packed record
+ name : string[8];
+ header : THeader; { font header }
+ pheader : TFHeader; { prefix header }
+ offsets : TOffsetTable;
+ widths : TWidthTable;
+ instrlength: longint; { length of instr, because instr can }
+ instr : pchar; { contain null characters }
+ end;
+
+
+
+{ pStroke = ^TStroke;}
+ TStroke = packed record
+ opcode: byte;
+ x: smallint; { relative x offset character }
+ y: smallint; { relative y offset character }
+ end;
+
+
+ TStrokes = Array[0..1000] of TStroke;
+
+ opcodes = (_END_OF_CHAR, _DO_SCAN, _MOVE, _DRAW);
+
+
+ var
+ fonts : array[1..maxfonts] of tfontrec;
+ Strokes: TStrokes; {* Stroke Data Base *}
+{ Stroke_count: Array[0..MaxChars] of smallint;} {* Stroke Count Table *}
+
+{***************************************************************************}
+{ Internal support routines }
+{***************************************************************************}
+
+
+function ConvertString(const OrigString: String): String;
+var
+ i: Integer;
+ ConvResult: String;
+begin
+ if GraphStringTransTable = nil then
+ ConvertString := OrigString
+ else
+ begin
+ SetLength(ConvResult, Length(OrigString));
+ for i := 1 to Length(OrigString) do
+ ConvResult[i] := GraphStringTransTable^[OrigString[i]];
+ ConvertString := ConvResult;
+ end;
+end;
+
+
+ function testfont(p : pchar) : boolean;
+
+ begin
+ testfont:=(p[0]='P') and
+ (p[1]='K') and
+ (p[2]=#8) and
+ (p[3]=#8);
+ end;
+
+
+ function InstallUserFont(const FontFileName : string) : smallint;
+
+ begin
+ _graphresult:=grOk;
+ { first check if we do not allocate too many fonts! }
+ if installedfonts=maxfonts then
+ begin
+ _graphresult:=grError;
+ InstallUserFont := DefaultFont;
+ exit;
+ end;
+ inc(installedfonts);
+ fonts[installedfonts].name:=FontFileName;
+ fonts[installedfonts].instr := nil;
+ fonts[installedfonts].instrlength := 0;
+ InstallUserFont:=installedfonts;
+ end;
+
+
+ function Decode(byte1,byte2: char; var x,y: smallint): smallint;
+ { This routines decoes a signle word in a font opcode section }
+ { to a stroke record. }
+ var
+ b1,b2: shortint;
+ Begin
+ b1:=shortint(byte1);
+ b2:=shortint(byte2);
+ { Decode the CHR OPCODE }
+ Decode:=smallint(((b1 and $80) shr 6)+((b2 and $80) shr 7));
+ { Now get the X,Y coordinates }
+ { bit 0..7 only which are considered }
+ { signed values. }
+{ disable range check mode }
+{$ifopt R+}
+{$define OPT_R_WAS_ON}
+{$R-}
+{$endif}
+ b1:=b1 and $7f;
+ b2:=b2 and $7f;
+ { Now if the MSB of these values are set }
+ { then the value is signed, therefore we }
+ { sign extend it... }
+ if (b1 and $40)<>0 then b1:=b1 or $80;
+ if (b2 and $40)<>0 then b2:=b2 or $80;
+ x:=smallint(b1);
+ y:=smallint(b2);
+{ restore previous range check mode }
+{$ifdef OPT_R_WAS_ON}
+{$R+}
+{$endif}
+ end;
+
+
+ function unpack(buf: pchar; index: smallint; var Stroke: TStrokes): smallint;
+
+ var
+ po: TStrokes;
+ num_ops: smallint;
+ opcode, i, opc: word;
+ counter: smallint;
+ lindex: smallint;
+ jx, jy: smallint;
+ begin
+ num_ops := 0;
+ counter := index;
+ lindex :=0;
+
+
+ while TRUE do {* For each byte in buffer *}
+ Begin
+ Inc(num_ops); {* Count the operation *}
+ opcode := decode( buf[counter], buf[counter+1] ,jx, jy );
+ Inc(counter,2);
+ if( opcode = ord(_END_OF_CHAR) ) then break; {* Exit loop at end of char *}
+ end;
+
+ counter:=index;
+
+ for i:=0 to num_ops-1 do { /* For each opcode in buffer */ }
+ Begin
+ opc := decode(buf[counter], buf[counter+1], po[lindex].x, po[lindex].y); {* Decode the data field *}
+ inc(counter,2);
+ po[lindex].opcode := opc; {* Save the opcode *}
+ Inc(lindex);
+ end;
+ Stroke:=po;
+ unpack := num_ops; {* return OPS count *}
+ end;
+
+
+
+ procedure GetTextPosition(var xpos,ypos: longint; const TextString: string);
+ begin
+ if CurrentTextInfo.Font = DefaultFont then
+ begin
+ if Currenttextinfo.direction=horizdir then
+ begin
+ case Currenttextinfo.horiz of
+ centertext : XPos:=(textwidth(textstring) shr 1);
+ lefttext : XPos:=0;
+ righttext : XPos:=textwidth(textstring);
+ end;
+ case Currenttextinfo.vert of
+ centertext : YPos:=-(textheight(textstring) shr 1);
+ bottomtext : YPos:=-textheight(textstring);
+ toptext : YPos:=0;
+ end;
+ end else
+ begin
+ case Currenttextinfo.horiz of
+ centertext : XPos:=(textheight(textstring) shr 1);
+ lefttext : XPos:=textheight(textstring);
+ righttext : XPos:=textheight(textstring);
+ end;
+ case Currenttextinfo.vert of
+ centertext : YPos:=(textwidth(textstring) shr 1);
+ bottomtext : YPos:=0;
+ toptext : YPos:=textwidth(textstring);
+ end;
+ end;
+ end
+ else
+ begin
+ if Currenttextinfo.direction=horizdir then
+ begin
+ case CurrentTextInfo.horiz of
+ centertext : XPos:=(textwidth(textstring) shr 1);
+ lefttext : XPos:=0;
+ righttext : XPos:=textwidth(textstring);
+ end;
+ case CurrentTextInfo.vert of
+ centertext : YPos:=(textheight(textstring) shr 1);
+ bottomtext : YPos:=0;
+ toptext : YPos:=textheight(textstring);
+ end;
+ end else
+ begin
+ case CurrentTextInfo.horiz of
+ centertext : XPos:=(textheight(textstring) shr 1);
+ lefttext : XPos:=0;
+ righttext : XPos:=textheight(textstring);
+ end;
+ case CurrentTextInfo.vert of
+ centertext : YPos:=(textwidth(textstring) shr 1);
+ bottomtext : YPos:=0;
+ toptext : YPos:=textwidth(textstring);
+ end;
+ end;
+ end;
+ end;
+
+{***************************************************************************}
+{ Exported routines }
+{***************************************************************************}
+
+
+ function RegisterBGIfont(font : pointer) : smallint;
+
+ var
+ hp : pchar;
+ b : word;
+ i: longint;
+ Header: THeader;
+ counter: longint;
+ FontData: pchar;
+ FHeader: TFHeader;
+ begin
+ RegisterBGIfont:=grInvalidFontNum;
+ i:=0;
+ { Check if the font header is valid first of all }
+ if testfont(font) then
+ begin
+ hp:=pchar(font);
+ { Move to EOF in prefix header }
+ while (hp[i] <> chr($1a)) do Inc(i);
+ move(hp[i+1],FHeader,sizeof(FHeader));
+ move(hp[Prefix_Size],header,sizeof(Header));
+ { check if the font name is already allocated? }
+ i:=Prefix_Size+sizeof(Header);
+ for b:=1 to installedfonts do
+ begin
+ if fonts[b].name=FHeader.Font_name then
+ begin
+ move(FHeader,fonts[b].PHeader,sizeof(FHeader));
+ move(Header,fonts[b].Header,sizeof(Header));
+ move(hp[i],Fonts[b].Offsets[Fonts[b].Header.First_Char],Fonts[b].Header.Nr_chars*sizeof(smallint));
+ Inc(i,Fonts[b].Header.Nr_chars*sizeof(smallint));
+ move(hp[i],Fonts[b].Widths[Fonts[b].Header.First_Char],Fonts[b].Header.Nr_chars*sizeof(byte));
+ Inc(i,Fonts[b].Header.Nr_chars*sizeof(byte));
+ counter:=Fonts[b].PHeader.font_size+PREFIX_SIZE-i;
+ { allocate also space for null }
+ GetMem(FontData,Counter+1);
+ move(hp[i],FontData^,Counter);
+ { Null terminate the string }
+ FontData[counter+1] := #0;
+ if fonts[b].header.Signature<> SIGNATURE then
+ begin
+ _graphResult:=grInvalidFont;
+ Freemem(FontData, Counter+1);
+ exit;
+ end;
+ fonts[b].instr:=FontData;
+ fonts[b].instrlength:=Counter+1;
+ RegisterBGIfont:=b;
+ end;
+ end;
+ end
+ else
+ RegisterBGIFont:=grInvalidFont;
+ end;
+
+
+
+ procedure GetTextSettings(var TextInfo : TextSettingsType);
+
+ begin
+ textinfo:=currenttextinfo;
+ end;
+
+
+
+ function TextHeight(const TextString : string) : word;
+
+ begin
+ if Currenttextinfo.font=DefaultFont
+ then TextHeight:=8*CurrentTextInfo.CharSize
+ else
+ TextHeight:=Trunc((fonts[Currenttextinfo.font].header.org_to_cap-
+ fonts[Currenttextinfo.font].header.org_to_dec) * CurrentYRatio);
+ end;
+
+ function TextWidth(const TextString : string) : word;
+ var i,x : smallint;
+ c : byte;
+ s : String;
+ begin
+ x := 0;
+ { if this is the default font ... }
+ if Currenttextinfo.font = Defaultfont then
+ TextWidth:=length(TextString)*8*CurrentTextInfo.CharSize
+ { This is a stroked font ... }
+ else begin
+ s := ConvertString(TextString);
+ for i:=1 to length(s) do
+ begin
+ c:=byte(s[i]);
+{ dec(c,fonts[Currenttextinfo.font].header.first_char);}
+ if (c-fonts[Currenttextinfo.font].header.first_char>=
+ fonts[Currenttextinfo.font].header.nr_chars) then
+ continue;
+ x:=x+byte(fonts[Currenttextinfo.font].widths[c]);
+ end;
+ TextWidth:=round(x * CurrentXRatio) ;
+ end;
+ end;
+
+ procedure OutTextXYDefault(x,y : smallint;const TextString : string);
+
+ type
+ Tpoint = record
+ X,Y: smallint;
+ end;
+ var
+ ConvString : String;
+ i,j,k,c : longint;
+ xpos,ypos : longint;
+ counter : longint;
+ cnt1,cnt2 : smallint;
+ cnt3,cnt4 : smallint;
+ charsize : word;
+ WriteMode : word;
+ curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
+ oldvalues : linesettingstype;
+ fontbitmap : TBitmapChar;
+ chr : char;
+ curx2i,cury2i,
+ xpos2i,ypos2i : longint;
+
+ begin
+ { save current write mode }
+ WriteMode := CurrentWriteMode;
+ CurrentWriteMode := NormalPut;
+ GetTextPosition(xpos,ypos,textstring);
+ X:=X-XPos; Y:=Y+YPos;
+ XPos:=X; YPos:=Y;
+
+ ConvString := ConvertString(TextString);
+ CharSize := CurrentTextInfo.Charsize;
+ if Currenttextinfo.font=DefaultFont then
+ begin
+ c:=length(ConvString);
+ if CurrentTextInfo.direction=HorizDir then
+ { Horizontal direction }
+ begin
+ for i:=0 to c-1 do
+ begin
+ xpos:=x+(i*8)*Charsize;
+ { we copy the character bitmap before accessing it }
+ { this improves speed on non optimizing compilers }
+ { since it is one less address calculation. }
+ Fontbitmap:=TBitmapChar(DefaultFontData[ConvString[i+1]]);
+ { no scaling }
+ if CharSize = 1 then
+ Begin
+ for j:=0 to 7 do
+ for k:=0 to 7 do
+ if Fontbitmap[j,k]<>0 then
+ PutPixel(xpos+k,j+y,CurrentColor)
+ else if DrawTextBackground then
+ PutPixel(xpos+k,j+y,CurrentBkColor);
+ end
+ else
+ { perform scaling of bitmap font }
+ Begin
+ j:=0;
+ cnt3:=0;
+
+ while j <= 7 do
+ begin
+ { X-axis scaling }
+ for cnt4 := 0 to charsize-1 do
+ begin
+ k:=0;
+ cnt2 := 0;
+ while k <= 7 do
+ begin
+ for cnt1 := 0 to charsize-1 do
+ begin
+ If FontBitmap[j,k] <> 0 then
+ PutPixel(xpos+cnt1+cnt2,y+cnt3+cnt4,CurrentColor)
+ else if DrawTextBackground then
+ PutPixel(xpos+cnt1+cnt2,y+cnt3+cnt4,CurrentBkColor);
+ end;
+ Inc(k);
+ Inc(cnt2,charsize);
+ end;
+ end;
+ Inc(j);
+ Inc(cnt3,charsize);
+ end;
+ end;
+ end;
+ end
+ else
+ { Vertical direction }
+ begin
+ for i:=0 to c-1 do
+ begin
+
+ chr := ConvString[i+1];
+ Fontbitmap:=TBitmapChar(DefaultFontData[chr]);
+ ypos := y-(i shl 3)*CharSize;
+
+ { no scaling }
+ if CharSize = 1 then
+ Begin
+ for j:=0 to 7 do
+ for k:=0 to 7 do
+ if Fontbitmap[j,k] <> 0 then
+ PutPixel(xpos+j,ypos-k,CurrentColor)
+ else if DrawTextBackground then
+ PutPixel(xpos+j,ypos-k,CurrentBkColor);
+ end
+ else
+ { perform scaling of bitmap font }
+ Begin
+ j:=0;
+ cnt3:=0;
+
+ while j<=7 do
+ begin
+ { X-axis scaling }
+ for cnt4 := 0 to charsize-1 do
+ begin
+ k:=0;
+ cnt2 := 0;
+ while k<=7 do
+ begin
+ for cnt1 := 0 to charsize-1 do
+ begin
+ If FontBitmap[j,k] <> 0 then
+ PutPixel(xpos+cnt3-cnt4,ypos+cnt1-cnt2,CurrentColor)
+ else if DrawTextBackground then
+ PutPixel(xpos+cnt3-cnt4,ypos+cnt1-cnt2,CurrentBkColor);
+ end;
+ Inc(k);
+ Inc(cnt2,charsize);
+ end;
+ end;
+ Inc(j);
+ Inc(cnt3,charsize);
+ end;
+ end;
+ end;
+ end;
+ end else
+ { This is a stroked font which is already loaded into memory }
+ begin
+ getlinesettings(oldvalues);
+ { reset line style to defaults }
+ setlinestyle(solidln,oldvalues.pattern,normwidth);
+ if Currenttextinfo.direction=vertdir then
+ xpos:=xpos + Textheight(ConvString);
+ CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
+ CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
+{ x:=xpos; y:=ypos;}
+
+ for i:=1 to length(ConvString) do
+ begin
+ c:=byte(ConvString[i]);
+{ Stroke_Count[c] := }
+ unpack( fonts[CurrentTextInfo.font].instr,
+ fonts[CurrentTextInfo.font].Offsets[c], Strokes );
+ counter:=0;
+ while true do
+ begin
+ if CurrentTextInfo.direction=VertDir then
+ begin
+ xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
+ ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
+ end
+ else
+ begin
+ xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
+ ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
+ end;
+ case opcodes(Strokes[counter].opcode) of
+ _END_OF_CHAR: break;
+ _DO_SCAN: begin
+ { Currently unsupported };
+ end;
+ _MOVE : Begin
+ CurX2 := XPos2;
+ CurY2 := YPos2;
+ end;
+ _DRAW: Begin
+ curx2i:=trunc(CurX2);
+ cury2i:=trunc(CurY2);
+ xpos2i:=trunc(xpos2);
+ ypos2i:=trunc(ypos2);
+ { this optimization doesn't matter that much
+ if (curx2i=xpos2i) then
+ begin
+ if (cury2i=ypos2i) then
+ putpixel(curx2i,cury2i,currentcolor)
+ else if (cury2i+1=ypos2i) or
+ (cury2i=ypos2i+1) then
+ begin
+ putpixel(curx2i,cury2i,currentcolor);
+ putpixel(curx2i,ypos2i,currentcolor);
+ end
+ else
+ Line(curx2i,cury2i,xpos2i,ypos2i);
+ end
+ else if (cury2i=ypos2i) then
+ begin
+ if (curx2i+1=xpos2i) or
+ (curx2i=xpos2i+1) then
+ begin
+ putpixel(curx2i,cury2i,currentcolor);
+ putpixel(xpos2i,cury2i,currentcolor);
+ end
+ else
+ Line(curx2i,cury2i,xpos2i,ypos2i);
+ end
+ else
+ }
+ Line(curx2i,cury2i,xpos2i,ypos2i);
+ CurX2:=xpos2;
+ CurY2:=ypos2;
+ end;
+ else
+ Begin
+ end;
+ end;
+ Inc(counter);
+ end; { end while }
+ if Currenttextinfo.direction=VertDir then
+ y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
+ else
+ x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
+ end;
+ setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
+ end;
+ { restore write mode }
+ CurrentWriteMode := WriteMode;
+ end;
+
+
+ procedure OutText(const TextString : string);
+ var x,y:smallint;
+ begin
+ { Save CP }
+ x:=CurrentX;
+ y:=CurrentY;
+ OutTextXY(CurrentX,CurrentY,TextString);
+ { If the direction is Horizontal and the justification left }
+ { then and only then do we update the CP }
+ if (Currenttextinfo.direction=HorizDir) and
+ (Currenttextinfo.horiz=LeftText) then
+ inc(x,textwidth(TextString));
+ { Update the CP }
+ CurrentX := X;
+ CurrentY := Y;
+ end;
+
+
+
+
+
+ procedure SetTextJustify(horiz,vert : word);
+
+ begin
+ if (horiz<0) or (horiz>2) or
+ (vert<0) or (vert>2) then
+ begin
+ _graphresult:=grError;
+ exit;
+ end;
+ Currenttextinfo.horiz:=horiz;
+ Currenttextinfo.vert:=vert;
+ end;
+
+
+ procedure SetTextStyle(font,direction : word;charsize : word);
+
+ var
+ f : file;
+ Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder *}
+ Length, Current: longint;
+ FontData: Pchar;
+ hp : pchar;
+ i : longint;
+ begin
+ if font>installedfonts then
+ begin
+ _graphresult:=grInvalidFontNum;
+ exit;
+ end;
+
+ Currenttextinfo.font:=font;
+ if (direction<>HorizDir) and (direction<>VertDir) then
+ direction:=HorizDir;
+ Currenttextinfo.direction:=direction;
+ { According to the Turbo Pascal programmer's reference }
+ { maximum charsize for bitmapped font is 10 }
+ if (CurrentTextInfo.Font = DefaultFont) and (Charsize > 10) then
+ Currenttextinfo.charsize:=10
+ else if charsize<1 then
+ Currenttextinfo.charsize:=1
+ else
+ Currenttextinfo.charsize:=charsize;
+
+ { This is only valid for stroked fonts }
+{$ifdef logging}
+ LogLn('(org_to_cap - org_to_dec): ' + strf(
+ fonts[Currenttextinfo.font].header.org_to_cap-
+ fonts[Currenttextinfo.font].header.org_to_dec));
+{$endif logging}
+ if (charsize <> usercharsize) then
+ Case CharSize of
+ 1: Begin
+ CurrentXRatio := 0.55;
+ CurrentYRatio := 0.55;
+ End;
+ 2: Begin
+ CurrentXRatio := 0.65;
+ CurrentYRatio := 0.65;
+ End;
+ 3: Begin
+ CurrentXRatio := 0.75;
+ CurrentYRatio := 0.75;
+ End;
+ 4: Begin
+ CurrentXRatio := 1.0;
+ CurrentYRatio := 1.0;
+ End;
+ 5: Begin
+ CurrentXRatio := 1.3;
+ CurrentYRatio := 1.3;
+ End;
+ 6: Begin
+ CurrentXRatio := 1.65;
+ CurrentYRatio := 1.65
+ End;
+ 7: Begin
+ CurrentXRatio := 2.0;
+ CurrentYRatio := 2.0;
+ End;
+ 8: Begin
+ CurrentXRatio := 2.5;
+ CurrentYRatio := 2.5;
+ End;
+ 9: Begin
+ CurrentXRatio := 3.0;
+ CurrentYRatio := 3.0;
+ End;
+ 10: Begin
+ CurrentXRatio := 4.0;
+ CurrentYRatio := 4.0;
+ End
+ End;
+ { if this is a stroked font then load it if not already loaded }
+ { into memory... }
+ if (font>DefaultFont) and not assigned(fonts[font].instr) then
+ begin
+ assign(f,bgipath+fonts[font].name+'.CHR');
+{$ifopt I+}
+{$define IOCHECK_WAS_ON}
+{$i-}
+{$endif}
+ reset(f,1);
+{$ifdef IOCHECK_WAS_ON}
+{$i+}
+{$endif}
+ if ioresult<>0 then
+ begin
+ _graphresult:=grFontNotFound;
+ Currenttextinfo.font:=DefaultFont;
+ exit;
+ end;
+ {* Read in the file prefix *}
+ BlockRead(F, Prefix, Prefix_Size);
+ hp:=Prefix;
+ i:=0;
+ while (hp[i] <> chr($1a)) do Inc(i);
+ move(hp[i+1],fonts[font].PHeader,sizeof(TFHeader));
+ (* Read in the Header file *)
+ BlockRead(F,fonts[font].Header,Sizeof(THeader));
+ BlockRead(F,Fonts[font].Offsets[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(smallint));
+ {* Load the character width table into memory. *}
+ BlockRead(F,Fonts[font].Widths[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(byte));
+ {* Determine the length of the stroke database. *}
+ current := FilePos( f ); {* Current file location *}
+ Seek( f, FileSize(F)); {* Go to the end of the file *}
+ length := FilePos( f ); {* Get the file length *}
+ Seek( f, current); {* Restore old file location *}
+ {* Load the stroke database. *}
+ { also allocate space for Null character }
+ Getmem(FontData, Length+1); {* Create space for font data *}
+
+ BlockRead(F, FontData^, length-current); {* Load the stroke data *}
+ FontData[length-current+1] := #0;
+
+ if fonts[font].header.Signature<> SIGNATURE then
+ begin
+ _graphResult:=grInvalidFont;
+ Currenttextinfo.font:=DefaultFont;
+ Freemem(FontData, Length+1);
+ exit;
+ end;
+ fonts[font].instr:=FontData;
+ fonts[font].instrLength:=Length+1;
+
+
+ if not testfont(Prefix) then
+ begin
+ _graphresult:=grInvalidFont;
+ Currenttextinfo.font:=DefaultFont;
+ Freemem(FontData, Length+1);
+ end;
+ close(f);
+ end;
+ end;
+
+ procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
+ begin
+ CurrentXRatio := MultX / DivX;
+ CurrentYRatio := MultY / DivY;
+ end;
+
+{
+ $Log: gtext.inc,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/makefile.inc b/rtl/inc/graph/makefile.inc
new file mode 100644
index 0000000000..598a70ca07
--- /dev/null
+++ b/rtl/inc/graph/makefile.inc
@@ -0,0 +1 @@
+GRAPHINCNAMES=graph.inc graphh.inc fontdata.inc clip.inc fills.inc gtext.inc palette.inc modes.inc
diff --git a/rtl/inc/graph/modes.inc b/rtl/inc/graph/modes.inc
new file mode 100644
index 0000000000..955ff25a91
--- /dev/null
+++ b/rtl/inc/graph/modes.inc
@@ -0,0 +1,594 @@
+ {
+ $Id: modes.inc,v 1.10 2005/02/14 17:13:30 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This include implements video mode management.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{-----------------------------------------------------------------------}
+{ Internal routines }
+{-----------------------------------------------------------------------}
+
+ procedure res2Mode(x, y, maxColor: longint; var driver,mode: smallInt);
+ var
+ l: longint;
+ begin
+ case maxColor of
+ 2: driver := D1bit;
+ 4: driver := D2bit;
+ 16: driver := D4bit;
+ 64: driver := D6bit;
+ 256: driver := D8bit;
+ 4096: driver := D12bit;
+ 32768: driver := D15bit;
+ 65536: driver := D16bit;
+{ not yet supported
+ 65536*256: driver := D24bit;
+ 65536*65536: driver := D32bit;}
+ else
+ begin
+ driver := maxsmallint;
+ exit;
+ end;
+ end;
+ { Check whether this is known/predefined mode }
+ for l := lowNewMode to highNewMode do
+ if (resolutions[l].x = x) and
+ (resolutions[l].y = y) then
+ begin
+ { Found! }
+ mode := l;
+ exit;
+ end;
+ { Not Found }
+ mode := maxsmallint;
+ end;
+
+function mode2res(modeNr: smallInt; var x,y: longint): boolean;
+begin
+ if (modeNr < lowNewMode) or
+ (modeNr > highNewMode) then
+ begin
+ mode2res := false;
+ exit;
+ end;
+ mode2res := true;
+ x := resolutions[modeNr].x;
+ y := resolutions[modeNr].y;
+end;
+
+
+ procedure addmode(const mode: TModeInfo);
+ {********************************************************}
+ { Procedure AddMode() }
+ {--------------------------------------------------------}
+ { This routine adds <mode> to the list of recognized }
+ { modes. Duplicates are allowed. }
+ {********************************************************}
+ var
+ i,driverNr, modeNr: smallint;
+ prev: PModeInfo;
+ list: PModeInfo;
+ newlst : PModeInfo;
+ begin
+ res2Mode(mode.maxx+1,mode.maxy+1,mode.maxColor,driverNr,ModeNr);
+ { bitdepth supported? }
+ if (driverNr <> maxsmallint) then
+ begin
+ { Yes, add the mode }
+ if not assigned(newModeList.modeinfo[driverNr]) then
+ begin
+{$ifdef logging}
+ logln('Adding resolution '+strf(modenr)+' for drivernr '+strf(drivernr)+
+ ' ('+strf(mode.maxx)+'x'+strf(mode.maxy)+')');
+{$endif logging}
+ new(newModeList.modeinfo[driverNr]);
+ newModeList.modeinfo[driverNr]^ := mode;
+ newModeList.modeinfo[driverNr]^.next:=nil;
+ end
+ else
+ begin
+ prev := nil;
+ list := newModeList.modeinfo[driverNr];
+ { sort first by x resolution, then by yresolution }
+ while assigned(list) and
+ ((list^.maxx < mode.maxx) or
+ ((list^.maxx = mode.maxx) and
+ (list^.maxy < mode.maxy))) do
+ begin
+ prev := list;
+ list := list^.next;
+ end;
+ { mode already exists? -> replace (assume later added modes are }
+ { better) }
+ if assigned(list) and
+ (list^.maxx = mode.maxx) and
+ (list^.maxy = mode.maxy) then
+ begin
+{$ifdef logging}
+ logln('replacing resolution '+strf(modenr)+' for drivernr '+strf(drivernr)+
+ ' ('+strf(mode.maxx)+'x'+strf(mode.maxy)+')');
+{$endif logging}
+ { save/restore next, drivernr and drivermode in list }
+ prev := list^.next;
+ list^ := mode;
+ list^.next := prev;
+ end
+ else
+ begin
+ new(newLst);
+ { Increase the number of modes for this driver }
+ newLst^ := mode;
+{$ifdef logging}
+ logln('Adding resolution '+strf(modenr)+' for drivernr '+strf(drivernr)+
+ ' ('+strf(mode.maxx)+'x'+strf(mode.maxy)+')');
+{$endif logging}
+ if assigned(list) then
+ newLst^.next := list^.next
+ else
+ newLst^.next := nil;
+ if assigned(prev) then
+ prev^.next := newLst
+ else
+ newModeList.modeinfo[driverNr] := newLst;
+ end;
+ end;
+ { renumber internmodenumber }
+ list := newModeList.modeinfo[driverNr];
+ i:=0;
+ while assigned(list) do
+ begin
+ inc(i);
+ list^.internmodenumber:=i;
+ list:=list^.next;
+ end;
+ newModeList.loHiModeNr[driverNr].lo:=1;
+ newModeList.loHiModeNr[driverNr].hi:=i;
+ end;
+ { TP-like mode stuff }
+ if not assigned(ModeList) then
+ begin
+ new(ModeList);
+ move(mode, ModeList^, sizeof(Mode));
+ end
+ else
+ begin
+ list := ModeList;
+ { go to the end of the list }
+ while assigned(list^.next) do
+ list:=list^.next;
+ new(NewLst);
+ list^.next := NewLst;
+ move(mode, NewLst^, sizeof(Mode));
+ end;
+
+ end;
+
+
+ procedure initmode(var mode: TModeInfo);
+ {********************************************************}
+ { Procedure InitMode() }
+ {--------------------------------------------------------}
+ { This routine initialized the mode to default values. }
+ {********************************************************}
+ begin
+ FillChar(mode,sizeof(Mode),#0);
+ end;
+
+
+ function searchmode(ReqDriver : smallint; var reqmode: smallint): PModeInfo;
+ {********************************************************}
+ { Procedure SearchMode() }
+ {--------------------------------------------------------}
+ { This routine searches the list of recognized modes, }
+ { and tries to find the <reqmode> in the <reqdriver> }
+ { return nil if not found, otherwise returns the found }
+ { structure. }
+ { note: if reqmode = -32768, the first mode available }
+ { for reqdriver is returned (JM) }
+ { if reqmode = -32767, the last mode available }
+ { for reqdriver is returned (JM) }
+ {********************************************************}
+ var
+ list, lastModeInfo: PModeInfo;
+ x,y: longint;
+ begin
+{$ifdef logging}
+ LogLn('Searching for driver '+strf(reqdriver)+' and mode '+strf(reqmode));
+{$endif logging}
+ if (reqDriver >= lowNewDriver) and
+ (reqDriver <= highNewDriver) then
+ begin
+ case reqMode of
+ -32768:
+ begin
+ reqMode := newModeList.loHiModeNr[reqDriver].lo;
+ searchMode := newModeList.modeinfo[reqDriver];
+ end;
+ -32767:
+ begin
+ reqMode := newModeList.loHiModeNr[reqDriver].hi;
+ searchMode := nil;
+ { Are there any modes available for this driver? }
+ if reqMode <> -1 then
+ begin
+ list := newModeList.modeinfo[reqDriver];
+ while assigned(list^.next) do
+ list := list^.next;
+ searchMode := list;
+ end;
+ end;
+ else
+ begin
+ list := newModeList.modeinfo[reqDriver];
+ searchMode := nil;
+ if not assigned(list) then
+ exit;
+ if mode2res(reqMode,x,y) then
+ begin
+ x := pred(x);
+ y := pred(y);
+ while assigned(list) and
+ ((list^.maxx < x) or
+ ((list^.maxx = x) and
+ (list^.maxy < y))) do
+ list := list^.next;
+ if not assigned(list) or
+ (list^.maxx <> x) or
+ (list^.maxy <> y) then
+ list := nil;
+ searchmode := list;
+ end
+ else
+ begin
+ while assigned(list) and
+ (list^.internModeNumber <> reqMode) do
+ list := list^.next;
+ searchMode := list;
+ end;
+
+ end;
+ end;
+ exit;
+ end;
+ searchmode := nil;
+ list := ModeList;
+ If assigned(list) then
+ lastModeInfo := list;
+ { go to the end of the list }
+ while assigned(list) do
+ begin
+{$ifdef logging}
+ Log('Found driver '+strf(list^.DriverNumber)+
+ ' and mode $'+hexstr(list^.ModeNumber,4)+'...');
+{$endif logging}
+ if ((list^.DriverNumber = ReqDriver) and
+ ((list^.ModeNumber = ReqMode) or
+ { search for lowest mode }
+ (reqMode = -32768))) or
+ { search for highest mode }
+ ((reqMode = -32767) and
+ (lastModeInfo^.driverNumber = reqDriver) and
+ ((list^.driverNumber <> lastModeInfo^.driverNumber) or
+ not(assigned(list^.next)))) then
+ begin
+{$ifdef logging}
+ LogLn('Accepted!');
+{$endif logging}
+ searchmode := list;
+ If reqMode = -32768 then
+ reqMode := list^.ModeNumber
+ else if reqMode = -32767 then
+ begin
+ reqMode := lastModeInfo^.ModeNumber;
+ searchMode := lastModeInfo;
+ end;
+ exit;
+ end;
+{$ifdef logging}
+ LogLn('Rejected.');
+{$endif logging}
+ lastModeInfo := list;
+ list:=list^.next;
+ end;
+ end;
+
+
+{-----------------------------------------------------------------------}
+{ External routines }
+{-----------------------------------------------------------------------}
+
+ function GetModeName(ModeNumber: smallint): string;
+ {********************************************************}
+ { Function GetModeName() }
+ {--------------------------------------------------------}
+ { Checks the known video list, and returns ModeName }
+ { string. On error returns an empty string. }
+ {********************************************************}
+ var
+ mode: PModeInfo;
+ begin
+ mode:=nil;
+ GetModeName:='';
+ { only search in the current driver modes ... }
+ mode:=SearchMode(IntCurrentNewDriver,ModeNumber);
+ if assigned(mode) then
+ GetModeName:=Mode^.ModeName
+ else
+ _GraphResult := grInvalidMode;
+ end;
+
+ function GetGraphMode: smallint;
+ begin
+ GetGraphMode := IntCurrentMode;
+ end;
+
+ function GetMaxMode: smallint;
+ { I know , i know, this routine is very slow, and it would }
+ { be much easier to sort the linked list of possible modes }
+ { instead of doing this, but I'm lazy!! And anyways, the }
+ { speed of the routine here is not that important.... }
+ var
+ i: smallint;
+ mode: PModeInfo;
+ begin
+ mode:=nil;
+ i:=0;
+ repeat
+ inc(i);
+ { mode 0 always exists... }
+ { start search at 1.. }
+ mode:=SearchMode(IntCurrentNewDriver,i);
+ until not assigned(mode);
+ GetMaxMode:=i;
+ end;
+
+
+ procedure GetModeRange(GraphDriver: smallint; var LoMode,
+ HiMode: smallint);
+ var
+ mode : PModeInfo;
+ begin
+ {$ifdef logging}
+ LogLn('GetModeRange : Enter ('+strf(GraphDriver)+')');
+ {$endif}
+ HiMode:=-1;
+ mode := nil;
+ { First search if the graphics driver is supported .. }
+ { since mode zero is always supported.. if that driver }
+ { is supported it should return something... }
+
+ { not true, e.g. VESA doesn't have a mode 0. Changed so}
+ { -32768 means "return lowest mode in second parameter }
+ { also, under VESA some modes may not be supported }
+ { (e.g. $108 here) while some with a higher number can }
+ { be supported ($112 and onward), so I also added that }
+ { -32767 means "return highest mode in second parameter}
+ { This whole system should be overhauled though to work}
+ { without such hacks (JM) }
+ loMode := -32768;
+ mode := SearchMode(GraphDriver, loMode);
+ { driver not supported...}
+ if not assigned(mode) then
+ begin
+ loMode := -1;
+ exit;
+ end;
+ {$ifdef logging}
+ LogLn('GetModeRange : Mode '+strf(lomode)+' found');
+ {$endif}
+ { now it exists... find highest available mode... }
+ hiMode := -32767;
+ mode:=SearchMode(GraphDriver,hiMode);
+ end;
+
+
+ procedure SetGraphMode(mode: smallint);
+ var
+ modeinfo: PModeInfo;
+ usedDriver: Integer;
+ begin
+ { check if the mode exists... }
+ { Depending on the modenumber, we search using the old or new }
+ { graphdriver number (because once we entered graphmode, }
+ { getgraphmode() returns the old mode number and }
+ { both setgraphmode(getgraphmode) and setgraphmode(mAAAxBBB) }
+ { have to work (JM) }
+ case mode of
+ detectMode:
+ begin
+ mode := -32767;
+ usedDriver := IntcurrentNewDriver;
+ modeInfo := searchmode(IntcurrentNewDriver,mode);
+ end;
+ lowNewMode..highNewMode:
+ begin
+ usedDriver := IntcurrentNewDriver;
+ modeInfo := searchmode(IntcurrentNewDriver,mode);
+ end;
+ else
+ begin
+ usedDriver := IntcurrentDriver;
+ modeinfo := searchmode(IntcurrentDriver,mode);
+ end;
+ end;
+ if not assigned(modeinfo) then
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 1');
+{$endif logging}
+ _GraphResult := grInvalidMode;
+ exit;
+ end;
+ { reset all hooks...}
+ DefaultHooks;
+
+ { required hooks - returns error if no hooks to these }
+ { routines. }
+ if assigned(modeinfo^.DirectPutPixel) then
+ DirectPutPixel := modeinfo^.DirectPutPixel
+ else
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 2');
+{$endif logging}
+ DefaultHooks;
+ _Graphresult := grInvalidMode;
+ exit;
+ end;
+
+ if assigned(modeinfo^.PutPixel) then
+ PutPixel := modeinfo^.PutPixel
+ else
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 3');
+{$endif logging}
+ DefaultHooks;
+ _Graphresult := grInvalidMode;
+ exit;
+ end;
+
+ if assigned(modeinfo^.GetPixel) then
+ GetPixel := modeinfo^.GetPixel
+ else
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 4');
+{$endif logging}
+ DefaultHooks;
+ _Graphresult := grInvalidMode;
+ exit;
+ end;
+
+ if assigned(modeinfo^.SetRGBPalette) then
+ SetRGBPalette := modeinfo^.SetRGBPalette
+ else
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 5');
+{$endif logging}
+ DefaultHooks;
+ _Graphresult := grInvalidMode;
+ exit;
+ end;
+
+ if assigned(modeinfo^.GetRGBPalette) then
+ GetRGBPalette := modeinfo^.GetRGBPalette
+ else
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 6');
+{$endif logging}
+ DefaultHooks;
+ _Graphresult := grInvalidMode;
+ exit;
+ end;
+
+ { optional hooks. }
+ if assigned(modeinfo^.SetAllPalette) then
+ SetAllPalette := modeinfo^.SetAllPalette;
+
+ if assigned(modeinfo^.ClearViewPort) then
+ ClearViewPort := modeinfo^.ClearViewPort;
+ if assigned(modeinfo^.PutImage) then
+ PutImage := modeinfo^.PutImage;
+ if assigned(modeinfo^.GetImage) then
+ GetImage := modeinfo^.GetImage;
+ if assigned(modeinfo^.ImageSize) then
+ ImageSize := modeinfo^.ImageSize;
+ if assigned(modeinfo^.GetScanLine) then
+ GetScanLine := modeinfo^.GetScanLine;
+ if assigned(modeinfo^.Line) then
+ Line := modeinfo^.Line;
+ if assigned(modeinfo^.InternalEllipse) then
+ InternalEllipse := modeinfo^.InternalEllipse;
+ if assigned(modeinfo^.PatternLine) then
+ PatternLine := modeinfo^.PatternLine;
+ if assigned(modeinfo^.HLine) then
+ Hline := modeinfo^.Hline;
+ if assigned(modeinfo^.Vline) then
+ VLine := modeinfo^.VLine;
+ if assigned(modeInfo^.SetVisualPage) then
+ SetVisualPage := modeInfo^.SetVisualPage;
+ if assigned(modeInfo^.SetActivePage) then
+ SetActivePage := modeInfo^.SetActivePage;
+ if assigned(modeInfo^.OutTextXY) then
+ OutTextXY:=modeInfo^.OutTextXY;
+
+ IntCurrentMode := modeinfo^.ModeNumber;
+ IntCurrentDriver := usedDriver;
+{$ifdef logging}
+ logln('Entering mode '+strf(intCurrentMode)+' of driver '+strf(intCurrentDriver));
+{$endif logging}
+ XAspect := modeinfo^.XAspect;
+ YAspect := modeinfo^.YAspect;
+ MaxX := modeinfo^.MaxX;
+ MaxY := modeinfo^.MaxY;
+{$ifdef logging}
+ logln('maxx = '+strf(maxx)+', maxy = '+strf(maxy));
+{$endif logging}
+ HardwarePages := modeInfo^.HardwarePages;
+ MaxColor := modeinfo^.MaxColor;
+ PaletteSize := modeinfo^.PaletteSize;
+ { is this a direct color mode? }
+ DirectColor := modeinfo^.DirectColor;
+ { now actually initialize the video mode...}
+ { check first if the routine exists }
+ if not assigned(modeinfo^.InitMode) then
+ begin
+{$ifdef logging}
+ LogLn('Mode setting failed in setgraphmode pos 7');
+{$endif logging}
+ DefaultHooks;
+ _GraphResult := grInvalidMode;
+ exit;
+ end;
+ modeinfo^.InitMode;
+ if _GraphResult <> grOk then
+ begin
+ DefaultHooks;
+ exit;
+ end;
+ isgraphmode := true;
+ { It is very important that this call be made }
+ { AFTER the other variables have been setup. }
+ { Since it calls some routines which rely on }
+ { those variables. }
+ SetActivePage(0);
+ SetVisualPage(0);
+ SetViewPort(0,0,MaxX,MaxY,TRUE);
+ GraphDefaults;
+ end;
+
+ procedure RestoreCrtMode;
+ {********************************************************}
+ { Procedure RestoreCRTMode() }
+ {--------------------------------------------------------}
+ { Returns to the video mode which was set before the }
+ { InitGraph. Hardware state is set to the old values. }
+ {--------------------------------------------------------}
+ { NOTE: - }
+ { - }
+ {********************************************************}
+ begin
+ isgraphmode := false;
+ RestoreVideoState;
+ end;
+
+{
+ $Log: modes.inc,v $
+ Revision 1.10 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/graph/palette.inc b/rtl/inc/graph/palette.inc
new file mode 100644
index 0000000000..f512008e74
--- /dev/null
+++ b/rtl/inc/graph/palette.inc
@@ -0,0 +1,389 @@
+{
+ $Id: palette.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This include implements the different palette manipulation
+ routines.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+CONST
+ { This is the standard VGA palette for the first 256 colors }
+ { at 6 bpp for each RG and B component. }
+ DefaultColors: Array[0..255] of RGBRec = (
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 168),
+ (Red: 0;Green: 168;Blue: 0),
+ (Red: 0;Green: 168;Blue: 168),
+ (Red: 168;Green: 0;Blue: 0),
+ (Red: 168;Green: 0;Blue: 168),
+ (Red: 168;Green: 84;Blue: 0),
+ (Red: 168;Green: 168;Blue: 168),
+ (Red: 84;Green: 84;Blue: 84),
+ (Red: 84;Green: 84;Blue: 252),
+ (Red: 84;Green: 252;Blue: 84),
+ (Red: 84;Green: 252;Blue: 252),
+ (Red: 252;Green: 84;Blue: 84),
+ (Red: 252;Green: 84;Blue: 252),
+ (Red: 252;Green: 252;Blue: 84),
+ (Red: 252;Green: 252;Blue: 252),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 20;Green: 20;Blue: 20),
+ (Red: 32;Green: 32;Blue: 32),
+ (Red: 44;Green: 44;Blue: 44),
+ (Red: 56;Green: 56;Blue: 56),
+ (Red: 68;Green: 68;Blue: 68),
+ (Red: 80;Green: 80;Blue: 80),
+ (Red: 96;Green: 96;Blue: 96),
+ (Red: 112;Green: 112;Blue: 112),
+ (Red: 128;Green: 128;Blue: 128),
+ (Red: 144;Green: 144;Blue: 144),
+ (Red: 160;Green: 160;Blue: 160),
+ (Red: 180;Green: 180;Blue: 180),
+ (Red: 200;Green: 200;Blue: 200),
+ (Red: 224;Green: 224;Blue: 224),
+ (Red: 252;Green: 252;Blue: 252),
+ (Red: 0;Green: 0;Blue: 252),
+ (Red: 64;Green: 0;Blue: 252),
+ (Red: 124;Green: 0;Blue: 252),
+ (Red: 188;Green: 0;Blue: 252),
+ (Red: 252;Green: 0;Blue: 252),
+ (Red: 252;Green: 0;Blue: 188),
+ (Red: 252;Green: 0;Blue: 124),
+ (Red: 252;Green: 0;Blue: 64),
+ (Red: 252;Green: 0;Blue: 0),
+ (Red: 252;Green: 64;Blue: 0),
+ (Red: 252;Green: 124;Blue: 0),
+ (Red: 252;Green: 188;Blue: 0),
+ (Red: 252;Green: 252;Blue: 0),
+ (Red: 188;Green: 252;Blue: 0),
+ (Red: 124;Green: 252;Blue: 0),
+ (Red: 64;Green: 252;Blue: 0),
+ (Red: 0;Green: 252;Blue: 0),
+ (Red: 0;Green: 252;Blue: 64),
+ (Red: 0;Green: 252;Blue: 124),
+ (Red: 0;Green: 252;Blue: 188),
+ (Red: 0;Green: 252;Blue: 252),
+ (Red: 0;Green: 188;Blue: 252),
+ (Red: 0;Green: 124;Blue: 252),
+ (Red: 0;Green: 64;Blue: 252),
+ (Red: 124;Green: 124;Blue: 252),
+ (Red: 156;Green: 124;Blue: 252),
+ (Red: 188;Green: 124;Blue: 252),
+ (Red: 220;Green: 124;Blue: 252),
+ (Red: 252;Green: 124;Blue: 252),
+ (Red: 252;Green: 124;Blue: 220),
+ (Red: 252;Green: 124;Blue: 188),
+ (Red: 252;Green: 124;Blue: 156),
+ (Red: 252;Green: 124;Blue: 124),
+ (Red: 252;Green: 156;Blue: 124),
+ (Red: 252;Green: 188;Blue: 124),
+ (Red: 252;Green: 220;Blue: 124),
+ (Red: 252;Green: 252;Blue: 124),
+ (Red: 220;Green: 252;Blue: 124),
+ (Red: 188;Green: 252;Blue: 124),
+ (Red: 156;Green: 252;Blue: 124),
+ (Red: 124;Green: 252;Blue: 124),
+ (Red: 124;Green: 252;Blue: 156),
+ (Red: 124;Green: 252;Blue: 188),
+ (Red: 124;Green: 252;Blue: 220),
+ (Red: 124;Green: 252;Blue: 252),
+ (Red: 124;Green: 220;Blue: 252),
+ (Red: 124;Green: 188;Blue: 252),
+ (Red: 124;Green: 156;Blue: 252),
+ (Red: 180;Green: 180;Blue: 252),
+ (Red: 196;Green: 180;Blue: 252),
+ (Red: 216;Green: 180;Blue: 252),
+ (Red: 232;Green: 180;Blue: 252),
+ (Red: 252;Green: 180;Blue: 252),
+ (Red: 252;Green: 180;Blue: 232),
+ (Red: 252;Green: 180;Blue: 216),
+ (Red: 252;Green: 180;Blue: 196),
+ (Red: 252;Green: 180;Blue: 180),
+ (Red: 252;Green: 196;Blue: 180),
+ (Red: 252;Green: 216;Blue: 180),
+ (Red: 252;Green: 232;Blue: 180),
+ (Red: 252;Green: 252;Blue: 180),
+ (Red: 232;Green: 252;Blue: 180),
+ (Red: 216;Green: 252;Blue: 180),
+ (Red: 196;Green: 252;Blue: 180),
+ (Red: 180;Green: 252;Blue: 180),
+ (Red: 180;Green: 252;Blue: 196),
+ (Red: 180;Green: 252;Blue: 216),
+ (Red: 180;Green: 252;Blue: 232),
+ (Red: 180;Green: 252;Blue: 252),
+ (Red: 180;Green: 232;Blue: 252),
+ (Red: 180;Green: 216;Blue: 252),
+ (Red: 180;Green: 196;Blue: 252),
+ (Red: 0;Green: 0;Blue: 112),
+ (Red: 28;Green: 0;Blue: 112),
+ (Red: 56;Green: 0;Blue: 112),
+ (Red: 84;Green: 0;Blue: 112),
+ (Red: 112;Green: 0;Blue: 112),
+ (Red: 112;Green: 0;Blue: 84),
+ (Red: 112;Green: 0;Blue: 56),
+ (Red: 112;Green: 0;Blue: 28),
+ (Red: 112;Green: 0;Blue: 0),
+ (Red: 112;Green: 28;Blue: 0),
+ (Red: 112;Green: 56;Blue: 0),
+ (Red: 112;Green: 84;Blue: 0),
+ (Red: 112;Green: 112;Blue: 0),
+ (Red: 84;Green: 112;Blue: 0),
+ (Red: 56;Green: 112;Blue: 0),
+ (Red: 28;Green: 112;Blue: 0),
+ (Red: 0;Green: 112;Blue: 0),
+ (Red: 0;Green: 112;Blue: 28),
+ (Red: 0;Green: 112;Blue: 56),
+ (Red: 0;Green: 112;Blue: 84),
+ (Red: 0;Green: 112;Blue: 112),
+ (Red: 0;Green: 84;Blue: 112),
+ (Red: 0;Green: 56;Blue: 112),
+ (Red: 0;Green: 28;Blue: 112),
+ (Red: 56;Green: 56;Blue: 112),
+ (Red: 68;Green: 56;Blue: 112),
+ (Red: 84;Green: 56;Blue: 112),
+ (Red: 96;Green: 56;Blue: 112),
+ (Red: 112;Green: 56;Blue: 112),
+ (Red: 112;Green: 56;Blue: 96),
+ (Red: 112;Green: 56;Blue: 84),
+ (Red: 112;Green: 56;Blue: 68),
+ (Red: 112;Green: 56;Blue: 56),
+ (Red: 112;Green: 68;Blue: 56),
+ (Red: 112;Green: 84;Blue: 56),
+ (Red: 112;Green: 96;Blue: 56),
+ (Red: 112;Green: 112;Blue: 56),
+ (Red: 96;Green: 112;Blue: 56),
+ (Red: 84;Green: 112;Blue: 56),
+ (Red: 68;Green: 112;Blue: 56),
+ (Red: 56;Green: 112;Blue: 56),
+ (Red: 56;Green: 112;Blue: 68),
+ (Red: 56;Green: 112;Blue: 84),
+ (Red: 56;Green: 112;Blue: 96),
+ (Red: 56;Green: 112;Blue: 112),
+ (Red: 56;Green: 96;Blue: 112),
+ (Red: 56;Green: 84;Blue: 112),
+ (Red: 56;Green: 68;Blue: 112),
+ (Red: 80;Green: 80;Blue: 112),
+ (Red: 88;Green: 80;Blue: 112),
+ (Red: 96;Green: 80;Blue: 112),
+ (Red: 104;Green: 80;Blue: 112),
+ (Red: 112;Green: 80;Blue: 112),
+ (Red: 112;Green: 80;Blue: 104),
+ (Red: 112;Green: 80;Blue: 96),
+ (Red: 112;Green: 80;Blue: 88),
+ (Red: 112;Green: 80;Blue: 80),
+ (Red: 112;Green: 88;Blue: 80),
+ (Red: 112;Green: 96;Blue: 80),
+ (Red: 112;Green: 104;Blue: 80),
+ (Red: 112;Green: 112;Blue: 80),
+ (Red: 104;Green: 112;Blue: 80),
+ (Red: 96;Green: 112;Blue: 80),
+ (Red: 88;Green: 112;Blue: 80),
+ (Red: 80;Green: 112;Blue: 80),
+ (Red: 80;Green: 112;Blue: 88),
+ (Red: 80;Green: 112;Blue: 96),
+ (Red: 80;Green: 112;Blue: 104),
+ (Red: 80;Green: 112;Blue: 112),
+ (Red: 80;Green: 104;Blue: 112),
+ (Red: 80;Green: 96;Blue: 112),
+ (Red: 80;Green: 88;Blue: 112),
+ (Red: 0;Green: 0;Blue: 64),
+ (Red: 16;Green: 0;Blue: 64),
+ (Red: 32;Green: 0;Blue: 64),
+ (Red: 48;Green: 0;Blue: 64),
+ (Red: 64;Green: 0;Blue: 64),
+ (Red: 64;Green: 0;Blue: 48),
+ (Red: 64;Green: 0;Blue: 32),
+ (Red: 64;Green: 0;Blue: 16),
+ (Red: 64;Green: 0;Blue: 0),
+ (Red: 64;Green: 16;Blue: 0),
+ (Red: 64;Green: 32;Blue: 0),
+ (Red: 64;Green: 48;Blue: 0),
+ (Red: 64;Green: 64;Blue: 0),
+ (Red: 48;Green: 64;Blue: 0),
+ (Red: 32;Green: 64;Blue: 0),
+ (Red: 16;Green: 64;Blue: 0),
+ (Red: 0;Green: 64;Blue: 0),
+ (Red: 0;Green: 64;Blue: 16),
+ (Red: 0;Green: 64;Blue: 32),
+ (Red: 0;Green: 64;Blue: 48),
+ (Red: 0;Green: 64;Blue: 64),
+ (Red: 0;Green: 48;Blue: 64),
+ (Red: 0;Green: 32;Blue: 64),
+ (Red: 0;Green: 16;Blue: 64),
+ (Red: 32;Green: 32;Blue: 64),
+ (Red: 40;Green: 32;Blue: 64),
+ (Red: 48;Green: 32;Blue: 64),
+ (Red: 56;Green: 32;Blue: 64),
+ (Red: 64;Green: 32;Blue: 64),
+ (Red: 64;Green: 32;Blue: 56),
+ (Red: 64;Green: 32;Blue: 48),
+ (Red: 64;Green: 32;Blue: 40),
+ (Red: 64;Green: 32;Blue: 32),
+ (Red: 64;Green: 40;Blue: 32),
+ (Red: 64;Green: 48;Blue: 32),
+ (Red: 64;Green: 56;Blue: 32),
+ (Red: 64;Green: 64;Blue: 32),
+ (Red: 56;Green: 64;Blue: 32),
+ (Red: 48;Green: 64;Blue: 32),
+ (Red: 40;Green: 64;Blue: 32),
+ (Red: 32;Green: 64;Blue: 32),
+ (Red: 32;Green: 64;Blue: 40),
+ (Red: 32;Green: 64;Blue: 48),
+ (Red: 32;Green: 64;Blue: 56),
+ (Red: 32;Green: 64;Blue: 64),
+ (Red: 32;Green: 56;Blue: 64),
+ (Red: 32;Green: 48;Blue: 64),
+ (Red: 32;Green: 40;Blue: 64),
+ (Red: 44;Green: 44;Blue: 64),
+ (Red: 48;Green: 44;Blue: 64),
+ (Red: 52;Green: 44;Blue: 64),
+ (Red: 60;Green: 44;Blue: 64),
+ (Red: 64;Green: 44;Blue: 64),
+ (Red: 64;Green: 44;Blue: 60),
+ (Red: 64;Green: 44;Blue: 52),
+ (Red: 64;Green: 44;Blue: 48),
+ (Red: 64;Green: 44;Blue: 44),
+ (Red: 64;Green: 48;Blue: 44),
+ (Red: 64;Green: 52;Blue: 44),
+ (Red: 64;Green: 60;Blue: 44),
+ (Red: 64;Green: 64;Blue: 44),
+ (Red: 60;Green: 64;Blue: 44),
+ (Red: 52;Green: 64;Blue: 44),
+ (Red: 48;Green: 64;Blue: 44),
+ (Red: 44;Green: 64;Blue: 44),
+ (Red: 44;Green: 64;Blue: 48),
+ (Red: 44;Green: 64;Blue: 52),
+ (Red: 44;Green: 64;Blue: 60),
+ (Red: 44;Green: 64;Blue: 64),
+ (Red: 44;Green: 60;Blue: 64),
+ (Red: 44;Green: 52;Blue: 64),
+ (Red: 44;Green: 48;Blue: 64),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0),
+ (Red: 0;Green: 0;Blue: 0));
+
+ procedure SetAllPaletteDefault(const Palette:PaletteType);
+ var
+ i: longint;
+ Size: longint;
+ begin
+ { palette routines do not work in DirectColor mode }
+ if DirectColor then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ Size:=Palette.Size; { number of entries...}
+ { first determine if we are not trying to }
+ { change too much colors... }
+ if Palette.Size > PaletteSize then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ Dec(Size); { Color arrays are indexed according to zero }
+ for i:=0 to Size do
+ begin
+ { skip if RGB values are -1 , as stated in the TP manual }
+ if (Palette.Colors[i].Red <> -1) and (Palette.Colors[i].Green <> -1)
+ and (Palette.Colors[i].Blue <> -1) then
+ SetRGBPalette(i,
+ Palette.Colors[i].Red,
+ Palette.Colors[i].Green,
+ Palette.Colors[i].Blue);
+ end;
+ end;
+
+ {********************************************************}
+ { Procedure SetPalette() }
+ {--------------------------------------------------------}
+ { This routine changes the colorNum to the default }
+ { palette entry specified in the second parameter. }
+ { For example, SetPalette(0, Lightcyan) makes the }
+ { 0th palette entry to the default Light Cyan Color . }
+ {********************************************************}
+ Procedure SetPalette(ColorNum: word; Color: shortint);
+ begin
+ { palette routines do not work in DirectColor mode }
+ if DirectColor then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ { Check if we can actually change that palette color }
+ if ColorNum > PaletteSize then
+ Begin
+ _GraphResult := grError;
+ exit;
+ end
+ else
+ { Check if the max. default color is reached...}
+ { no, this disables palette setting for 256 color modes! (JM) }
+{ if Color > EGAWhite then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;}
+ SetRGBPalette(ColorNum,
+ DefaultColors[Color].Red,
+ DefaultColors[Color].Green,
+ DefaultColors[Color].Blue);
+ end;
+
+
+ procedure GetPalette(var Palette: PaletteType);
+ var
+ i: longint;
+ size : longint;
+ begin
+ { palette routines do not work in DirectColor mode }
+ if DirectColor then
+ begin
+ _GraphResult := grError;
+ exit;
+ end;
+ Palette.Size := PaletteSize;
+ { index at zero }
+ size := PaletteSize - 1;
+ for i:=0 to size do
+ GetRGBPalette(i,
+ Palette.Colors[i].Red,
+ Palette.Colors[i].Green,
+ Palette.Colors[i].Blue);
+ end;
+
+ function GetPaletteSize: smallint;
+ begin
+ GetPaletteSize := PaletteSize;
+ end;
+
+ procedure GetDefaultPalette(var Palette: PaletteType);
+ begin
+ move(DefaultColors, Palette.Colors, sizeof(DefaultColors));
+ { The default palette always has 256 entries, but in reality }
+ { it depends on the number of colors possible. }
+ Palette.Size := PaletteSize;
+ if PaletteSize > 256 then Palette.Size := 256;
+ end;
+
+{
+ $Log: palette.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/heap.inc b/rtl/inc/heap.inc
new file mode 100644
index 0000000000..b428d3ec81
--- /dev/null
+++ b/rtl/inc/heap.inc
@@ -0,0 +1,1418 @@
+{
+ $Id: heap.inc,v 1.51 2005/04/04 15:40:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ functions for heap management in the data segment
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************}
+
+{ Try to find the best matching block in general freelist }
+{ define BESTMATCH}
+
+{ DEBUG: Dump info when the heap needs to grow }
+{ define DUMPGROW}
+
+{ DEBUG: Test the FreeList on correctness }
+
+{$ifdef SYSTEMDEBUG}
+{$define TestFreeLists}
+{$endif SYSTEMDEBUG}
+
+const
+{$ifdef CPU64}
+ blocksize = 32; { at least size of freerecord }
+ blockshr = 5; { shr value for blocksize=2^blockshr}
+ maxblocksize = 512+blocksize; { 1024+8 needed for heaprecord }
+{$else}
+ blocksize = 16; { at least size of freerecord }
+ blockshr = 4; { shr value for blocksize=2^blockshr}
+ maxblocksize = 512+blocksize; { 1024+8 needed for heaprecord }
+{$endif}
+ maxblockindex = maxblocksize div blocksize; { highest index in array of lists of memchunks }
+ maxreusebigger = 8; { max reuse bigger tries }
+
+ usedflag = 1; { flag if the block is used or not }
+ lastblockflag = 2; { flag if the block is the last in os chunk }
+ firstblockflag = 4; { flag if the block is the first in os chunk }
+ fixedsizeflag = 8; { flag if the block is of fixed size }
+ sizemask = not(blocksize-1);
+ fixedsizemask = sizemask and $ffff;
+
+{****************************************************************************}
+
+{$ifdef DUMPGROW}
+ {$define DUMPBLOCKS}
+{$endif}
+
+{ Forward defines }
+procedure SysHeapMutexInit;forward;
+procedure SysHeapMutexDone;forward;
+procedure SysHeapMutexLock;forward;
+procedure SysHeapMutexUnlock;forward;
+
+{ Memory manager }
+const
+ MemoryManager: TMemoryManager = (
+ NeedLock: true;
+ GetMem: @SysGetMem;
+ FreeMem: @SysFreeMem;
+ FreeMemSize: @SysFreeMemSize;
+ AllocMem: @SysAllocMem;
+ ReAllocMem: @SysReAllocMem;
+ MemSize: @SysMemSize;
+ GetHeapStatus: @SysGetHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}
+ GetFPCHeapStatus: @SysGetFPCHeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
+ );
+
+ MemoryMutexManager: TMemoryMutexManager = (
+ MutexInit: @SysHeapMutexInit;
+ MutexDone: @SysHeapMutexDone;
+ MutexLock: @SysHeapMutexLock;
+ MutexUnlock: @SysHeapMutexUnlock;
+ );
+
+type
+ pmemchunk_fixed = ^tmemchunk_fixed;
+ tmemchunk_fixed = record
+{$ifdef cpusparc}
+ { Sparc needs to alloc aligned on 8 bytes, to allow doubles }
+ _dummy : ptrint;
+{$endif cpusparc}
+ size : ptrint;
+ next_fixed,
+ prev_fixed : pmemchunk_fixed;
+ end;
+
+ pmemchunk_var = ^tmemchunk_var;
+ tmemchunk_var = record
+ prevsize : ptrint;
+ size : ptrint;
+ next_var,
+ prev_var : pmemchunk_var;
+ end;
+
+ { ``header'', ie. size of structure valid when chunk is in use }
+ { should correspond to tmemchunk_var_hdr structure starting with the
+ last field. Reason is that the overlap is starting from the end of the
+ record. }
+ tmemchunk_fixed_hdr = record
+{$ifdef cpusparc}
+ { Sparc needs to alloc aligned on 8 bytes, to allow doubles }
+ _dummy : ptrint;
+{$endif cpusparc}
+ size : ptrint;
+ end;
+ tmemchunk_var_hdr = record
+ prevsize : ptrint;
+ size : ptrint;
+ end;
+
+ poschunk = ^toschunk;
+ toschunk = record
+ size : ptrint;
+ next,
+ prev : poschunk;
+ used : ptrint;
+ end;
+
+ tfreelists = array[1..maxblockindex] of pmemchunk_fixed;
+ pfreelists = ^tfreelists;
+
+var
+{$ifdef HASGETFPCHEAPSTATUS}
+ internal_status : TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ internal_status : THeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
+
+ freelists_fixed : tfreelists;
+ freelist_var : pmemchunk_var;
+ freeoslist : poschunk;
+ freeoslistcount : dword;
+
+{$ifdef TestFreeLists}
+{ this can be turned on by debugger }
+const
+ test_each : boolean = false;
+{$endif TestFreeLists}
+
+{*****************************************************************************
+ Memory Manager
+*****************************************************************************}
+
+procedure SetMemoryMutexManager(var MutexMgr: TMemoryMutexManager);
+begin
+ { Release old mutexmanager, the default manager does nothing so
+ calling this without initializing is safe }
+ MemoryMutexManager.MutexDone;
+ { Copy new mutexmanager }
+ MemoryMutexManager := MutexMgr;
+ { Init new mutexmanager }
+ MemoryMutexManager.MutexInit;
+end;
+
+
+procedure GetMemoryManager(var MemMgr:TMemoryManager);
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ MemMgr := MemoryManager;
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ MemMgr := MemoryManager;
+ end;
+end;
+
+
+procedure SetMemoryManager(const MemMgr:TMemoryManager);
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ MemoryManager := MemMgr;
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ MemoryManager := MemMgr;
+ end;
+end;
+
+
+function IsMemoryManagerSet:Boolean;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ IsMemoryManagerSet := (MemoryManager.GetMem<>@SysGetMem) or
+ (MemoryManager.FreeMem<>@SysFreeMem);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ IsMemoryManagerSet := (MemoryManager.GetMem<>@SysGetMem) or
+ (MemoryManager.FreeMem<>@SysFreeMem);
+ end;
+end;
+
+
+procedure GetMem(Var p:pointer;Size:ptrint);
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ p := MemoryManager.GetMem(Size);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ p := MemoryManager.GetMem(Size);
+ end;
+end;
+
+procedure GetMemory(Var p:pointer;Size:ptrint);
+begin
+ GetMem(p,size);
+end;
+
+procedure FreeMem(p:pointer;Size:ptrint);
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ MemoryManager.FreeMemSize(p,Size);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ MemoryManager.FreeMemSize(p,Size);
+ end;
+end;
+
+
+procedure FreeMemory(p:pointer;Size:ptrint);
+begin
+ FreeMem(p,size);
+end;
+
+
+{$ifdef HASGETFPCHEAPSTATUS}
+function GetHeapStatus:THeapStatus;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ result:=MemoryManager.GetHeapStatus();
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ result:=MemoryManager.GetHeapStatus();
+ end;
+end;
+
+
+function GetFPCHeapStatus:TFPCHeapStatus;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ result:=MemoryManager.GetFPCHeapStatus();
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ Result:=MemoryManager.GetFPCHeapStatus();
+ end;
+end;
+{$else HASGETFPCHEAPSTATUS}
+procedure GetHeapStatus(var status:THeapStatus);
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ MemoryManager.GetHeapStatus(status);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ MemoryManager.GetHeapStatus(status);
+ end;
+end;
+{$endif HASGETFPCHEAPSTATUS}
+
+
+
+function MemSize(p:pointer):ptrint;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ MemSize := MemoryManager.MemSize(p);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ MemSize := MemoryManager.MemSize(p);
+ end;
+end;
+
+
+{ Delphi style }
+function FreeMem(p:pointer):ptrint;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ Freemem := MemoryManager.FreeMem(p);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ Freemem := MemoryManager.FreeMem(p);
+ end;
+end;
+
+function FreeMemory(p:pointer):ptrint;
+
+begin
+ FreeMemory := FreeMem(p);
+end;
+
+function GetMem(size:ptrint):pointer;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ GetMem := MemoryManager.GetMem(Size);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ GetMem := MemoryManager.GetMem(Size);
+ end;
+end;
+
+function GetMemory(size:ptrint):pointer;
+
+begin
+ GetMemory := Getmem(size);
+end;
+
+function AllocMem(Size:ptrint):pointer;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ AllocMem := MemoryManager.AllocMem(size);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ AllocMem := MemoryManager.AllocMem(size);
+ end;
+end;
+
+
+function ReAllocMem(var p:pointer;Size:ptrint):pointer;
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ ReAllocMem := MemoryManager.ReAllocMem(p,size);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ ReAllocMem := MemoryManager.ReAllocMem(p,size);
+ end;
+end;
+
+
+function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
+
+begin
+ ReAllocMemory := ReAllocMem(p,size);
+end;
+
+{$ifdef ValueGetmem}
+
+{ Needed for calls from Assembler }
+function fpc_getmem(size:ptrint):pointer;compilerproc;[public,alias:'FPC_GETMEM'];
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ fpc_GetMem := MemoryManager.GetMem(size);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ fpc_GetMem := MemoryManager.GetMem(size);
+ end;
+end;
+
+{$else ValueGetmem}
+
+{ Needed for calls from Assembler }
+procedure AsmGetMem(var p:pointer;size:ptrint);[public,alias:'FPC_GETMEM'];
+begin
+ p := MemoryManager.GetMem(size);
+end;
+
+{$endif ValueGetmem}
+
+{$ifdef ValueFreemem}
+
+procedure fpc_freemem(p:pointer);compilerproc;[public,alias:'FPC_FREEMEM'];
+begin
+ if IsMultiThread and MemoryManager.NeedLock then
+ begin
+ try
+ MemoryMutexManager.MutexLock;
+ if p <> nil then
+ MemoryManager.FreeMem(p);
+ finally
+ MemoryMutexManager.MutexUnlock;
+ end;
+ end
+ else
+ begin
+ if p <> nil then
+ MemoryManager.FreeMem(p);
+ end;
+end;
+
+{$else ValueFreemem}
+
+procedure AsmFreeMem(var p:pointer);[public,alias:'FPC_FREEMEM'];
+begin
+ if p <> nil then
+ MemoryManager.FreeMem(p);
+end;
+
+{$endif ValueFreemem}
+
+
+{ Bootstrapping }
+{$ifndef HASGETHEAPSTATUS}
+Function Memavail:ptrint;
+begin
+ result:=0;
+end;
+Function Maxavail:ptrint;
+begin
+ result:=0;
+end;
+Function Heapsize:ptrint;
+begin
+ result:=0;
+end;
+{$endif HASGETHEAPSTATUS}
+
+{*****************************************************************************
+ GetHeapStatus
+*****************************************************************************}
+
+{$ifdef HASGETFPCHEAPSTATUS}
+function SysGetFPCHeapStatus:TFPCHeapStatus;
+begin
+ internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
+ result:=internal_status;
+end;
+
+function SysGetHeapStatus :THeapStatus;
+
+begin
+ internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
+ result.TotalAllocated :=internal_status.CurrHeapUsed;
+ result.TotalFree :=internal_status.CurrHeapFree;
+ result.TotalAddrSpace :=0;
+ result.TotalUncommitted :=0;
+ result.TotalCommitted :=0;
+ result.FreeSmall :=0;
+ result.FreeBig :=0;
+ result.Unused :=0;
+ result.Overhead :=0;
+ result.HeapErrorCode :=0;
+end;
+{$else}
+procedure SysGetHeapStatus(var status:THeapStatus);
+begin
+ internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
+ status:=internal_status;
+end;
+{$endif HASGETFPCHEAPSTATUS}
+
+
+
+{$ifdef DUMPBLOCKS} // TODO
+procedure DumpBlocks;
+var
+ s,i,j : ptrint;
+ hp : pfreerecord;
+begin
+ for i := 1 to maxblock do
+ begin
+ hp := freelists[i];
+ j := 0;
+ while assigned(hp) do
+ begin
+ inc(j);
+ hp := hp^.next;
+ end;
+ writeln('Block ',i*blocksize,': ',j);
+ end;
+{ freelist 0 }
+ hp := freelists[0];
+ j := 0;
+ s := 0;
+ while assigned(hp) do
+ begin
+ inc(j);
+ if hp^.size>s then
+ s := hp^.size;
+ hp := hp^.next;
+ end;
+ writeln('Main: ',j,' maxsize: ',s);
+end;
+{$endif}
+
+
+{$ifdef TestFreeLists}
+procedure TestFreeLists;
+var
+ i,j : ptrint;
+ mc : pmemchunk_fixed;
+begin
+ for i := 1 to maxblockindex do
+ begin
+ j := 0;
+ mc := freelists_fixed[i];
+ while assigned(mc) do
+ begin
+ inc(j);
+ if ((mc^.size and fixedsizemask) <> i * blocksize) then
+ RunError(204);
+ mc := mc^.next_fixed;
+ end;
+ end;
+end;
+{$endif TestFreeLists}
+
+{*****************************************************************************
+ List adding/removal
+*****************************************************************************}
+
+procedure append_to_list_fixed(blockindex: ptrint; pmc: pmemchunk_fixed);
+begin
+ pmc^.prev_fixed := nil;
+ pmc^.next_fixed := freelists_fixed[blockindex];
+ if freelists_fixed[blockindex]<>nil then
+ freelists_fixed[blockindex]^.prev_fixed := pmc;
+ freelists_fixed[blockindex] := pmc;
+end;
+
+procedure append_to_list_var(pmc: pmemchunk_var);
+begin
+ pmc^.prev_var := nil;
+ pmc^.next_var := freelist_var;
+ if freelist_var<>nil then
+ freelist_var^.prev_var := pmc;
+ freelist_var := pmc;
+end;
+
+procedure remove_from_list_fixed(blockindex: ptrint; pmc: pmemchunk_fixed);
+begin
+ if assigned(pmc^.next_fixed) then
+ pmc^.next_fixed^.prev_fixed := pmc^.prev_fixed;
+ if assigned(pmc^.prev_fixed) then
+ pmc^.prev_fixed^.next_fixed := pmc^.next_fixed
+ else
+ freelists_fixed[blockindex] := pmc^.next_fixed;
+end;
+
+procedure remove_from_list_var(pmc: pmemchunk_var);
+begin
+ if assigned(pmc^.next_var) then
+ pmc^.next_var^.prev_var := pmc^.prev_var;
+ if assigned(pmc^.prev_var) then
+ pmc^.prev_var^.next_var := pmc^.next_var
+ else
+ freelist_var := pmc^.next_var;
+end;
+
+procedure append_to_oslist(poc: poschunk);
+begin
+ { decide whether to free block or add to list }
+{$ifdef HAS_SYSOSFREE}
+ if freeoslistcount >= 3 then
+ begin
+ dec(internal_status.currheapsize, poc^.size);
+ SysOSFree(poc, poc^.size);
+ end
+ else
+ begin
+{$endif}
+ poc^.prev := nil;
+ poc^.next := freeoslist;
+ if freeoslist <> nil then
+ freeoslist^.prev := poc;
+ freeoslist := poc;
+ inc(freeoslistcount);
+{$ifdef HAS_SYSOSFREE}
+ end;
+{$endif}
+end;
+
+procedure remove_from_oslist(poc: poschunk);
+begin
+ if assigned(poc^.next) then
+ poc^.next^.prev := poc^.prev;
+ if assigned(poc^.prev) then
+ poc^.prev^.next := poc^.next
+ else
+ freeoslist := poc^.next;
+ dec(freeoslistcount);
+end;
+
+procedure append_to_oslist_var(pmc: pmemchunk_var);
+var
+ poc: poschunk;
+begin
+ // block eligable for freeing
+ poc := pointer(pmc)-sizeof(toschunk);
+ remove_from_list_var(pmc);
+ append_to_oslist(poc);
+end;
+
+procedure append_to_oslist_fixed(blockindex, chunksize: ptrint; poc: poschunk);
+var
+ pmc: pmemchunk_fixed;
+ i, count: ptrint;
+begin
+ count := (poc^.size - sizeof(toschunk)) div chunksize;
+ pmc := pmemchunk_fixed(pointer(poc)+sizeof(toschunk));
+ for i := 0 to count - 1 do
+ begin
+ remove_from_list_fixed(blockindex, pmc);
+ pmc := pointer(pmc)+chunksize;
+ end;
+ append_to_oslist(poc);
+end;
+
+{*****************************************************************************
+ Split block
+*****************************************************************************}
+
+procedure split_block(pcurr: pmemchunk_var; size: ptrint);
+var
+ pcurr_tmp : pmemchunk_var;
+ sizeleft: ptrint;
+begin
+ sizeleft := (pcurr^.size and sizemask)-size;
+ if sizeleft>=blocksize then
+ begin
+ pcurr_tmp := pmemchunk_var(pointer(pcurr)+size);
+ { update prevsize of block to the right }
+ if (pcurr^.size and lastblockflag) = 0 then
+ pmemchunk_var(pointer(pcurr)+(pcurr^.size and sizemask))^.prevsize := sizeleft;
+ { inherit the lastblockflag }
+ pcurr_tmp^.size := sizeleft or (pcurr^.size and lastblockflag);
+ pcurr_tmp^.prevsize := size;
+ { the block we return is not the last one anymore (there's now a block after it) }
+ { decrease size of block to new size }
+ pcurr^.size := size or (pcurr^.size and (not sizemask and not lastblockflag));
+ { insert the block in the freelist }
+ append_to_list_var(pcurr_tmp);
+ end;
+end;
+
+{*****************************************************************************
+ Try concat freerecords
+*****************************************************************************}
+
+procedure concat_two_blocks(mc_left, mc_right: pmemchunk_var);
+var
+ mc_tmp : pmemchunk_var;
+ size_right : ptrint;
+begin
+ // mc_right can't be a fixed size block
+ if mc_right^.size and fixedsizeflag<>0 then
+ HandleError(204);
+ // left block free, concat with right-block
+ size_right := mc_right^.size and sizemask;
+ inc(mc_left^.size, size_right);
+ // if right-block was last block, copy flag
+ if (mc_right^.size and lastblockflag) <> 0 then
+ begin
+ mc_left^.size := mc_left^.size or lastblockflag;
+ end
+ else
+ begin
+ // there is a block to the right of the right-block, adjust it's prevsize
+ mc_tmp := pmemchunk_var(pointer(mc_right)+size_right);
+ mc_tmp^.prevsize := mc_left^.size and sizemask;
+ end;
+ // remove right-block from doubly linked list
+ remove_from_list_var(mc_right);
+end;
+
+procedure try_concat_free_chunk_forward(mc: pmemchunk_var);
+var
+ mc_tmp : pmemchunk_var;
+begin
+ { try concat forward }
+ if (mc^.size and lastblockflag) = 0 then
+ begin
+ mc_tmp := pmemchunk_var(pointer(mc)+(mc^.size and sizemask));
+ if (mc_tmp^.size and usedflag) = 0 then
+ begin
+ // next block free: concat
+ concat_two_blocks(mc, mc_tmp);
+ end;
+ end;
+end;
+
+function try_concat_free_chunk(mc: pmemchunk_var): pmemchunk_var;
+var
+ mc_tmp : pmemchunk_var;
+begin
+ try_concat_free_chunk_forward(mc);
+
+ { try concat backward }
+ if (mc^.size and firstblockflag) = 0 then
+ begin
+ mc_tmp := pmemchunk_var(pointer(mc)-mc^.prevsize);
+ if (mc_tmp^.size and usedflag) = 0 then
+ begin
+ // prior block free: concat
+ concat_two_blocks(mc_tmp, mc);
+ mc := mc_tmp;
+ end;
+ end;
+
+ result := mc;
+end;
+
+
+function check_concat_free_chunk_forward(mc: pmemchunk_var;reqsize:ptrint):boolean;
+var
+ mc_tmp : pmemchunk_var;
+ freesize : ptrint;
+begin
+ check_concat_free_chunk_forward:=false;
+ freesize:=0;
+ mc_tmp:=mc;
+ repeat
+ inc(freesize,mc_tmp^.size and sizemask);
+ if freesize>=reqsize then
+ begin
+ check_concat_free_chunk_forward:=true;
+ exit;
+ end;
+ if (mc_tmp^.size and lastblockflag) <> 0 then
+ break;
+ mc_tmp := pmemchunk_var(pointer(mc_tmp)+(mc_tmp^.size and sizemask));
+ if (mc_tmp^.size and usedflag) <> 0 then
+ break;
+ until false;
+end;
+
+
+{*****************************************************************************
+ Grow Heap
+*****************************************************************************}
+
+function alloc_oschunk(blockindex, size: ptrint): pointer;
+var
+ pmc : pmemchunk_fixed;
+ pmcv : pmemchunk_var;
+ minsize,
+ maxsize,
+ i, count : ptrint;
+ chunksize : ptrint;
+begin
+ { increase size by size needed for os block header }
+ minsize := size + sizeof(toschunk);
+ if blockindex<>0 then
+ maxsize := (size * $ffff) + sizeof(toschunk)
+ else
+ maxsize := high(ptrint);
+ { blocks available in freelist? }
+ result := freeoslist;
+ while result <> nil do
+ begin
+ if (poschunk(result)^.size >= minsize) and
+ (poschunk(result)^.size <= maxsize) then
+ begin
+ size := poschunk(result)^.size;
+ remove_from_oslist(poschunk(result));
+ break;
+ end;
+ result := poschunk(result)^.next;
+ end;
+ if result = nil then
+ begin
+{$ifdef DUMPGROW}
+ writeln('growheap(',size,') allocating ',(size+sizeof(toschunk)+$ffff) and $ffff0000);
+ DumpBlocks;
+{$endif}
+ { allocate by 64K size }
+ size := (size+sizeof(toschunk)+$ffff) and not $ffff;
+ { allocate smaller blocks for fixed-size chunks }
+ if blockindex<>0 then
+ begin
+ result := SysOSAlloc(GrowHeapSizeSmall);
+ if result<>nil then
+ size := GrowHeapSizeSmall;
+ end
+ { first try 256K (default) }
+ else if size<=GrowHeapSize1 then
+ begin
+ result := SysOSAlloc(GrowHeapSize1);
+ if result<>nil then
+ size := GrowHeapSize1;
+ end
+ { second try 1024K (default) }
+ else if size<=GrowHeapSize2 then
+ begin
+ result := SysOSAlloc(GrowHeapSize2);
+ if result<>nil then
+ size := GrowHeapSize2;
+ end
+ { else allocate the needed bytes }
+ else
+ result := SysOSAlloc(size);
+ { try again }
+ if result=nil then
+ begin
+ result := SysOSAlloc(size);
+ if (result=nil) then
+ begin
+ if ReturnNilIfGrowHeapFails then
+ exit
+ else
+ HandleError(203);
+ end;
+ end;
+ { set the total new heap size }
+ inc(internal_status.currheapsize,size);
+ if internal_status.currheapsize>internal_status.maxheapsize then
+ internal_status.maxheapsize:=internal_status.currheapsize;
+ end;
+ { initialize os-block }
+ poschunk(result)^.used := 0;
+ poschunk(result)^.size := size;
+ inc(result, sizeof(toschunk));
+ if blockindex<>0 then
+ begin
+ { chop os chunk in fixedsize parts,
+ maximum of $ffff elements are allowed, otherwise
+ there will be an overflow }
+ chunksize := blockindex shl blockshr;
+ count := (size-sizeof(toschunk)) div chunksize;
+ if count>$ffff then
+ HandleError(204);
+ pmc := pmemchunk_fixed(result);
+ pmc^.prev_fixed := nil;
+ i := 0;
+ repeat
+ pmc^.size := fixedsizeflag or chunksize or (i shl 16);
+ pmc^.next_fixed := pointer(pmc)+chunksize;
+ inc(i);
+ if i < count then
+ begin
+ pmc := pmemchunk_fixed(pointer(pmc)+chunksize);
+ pmc^.prev_fixed := pointer(pmc)-chunksize;
+ end
+ else
+ begin
+ break;
+ end;
+ until false;
+ append_to_list_fixed(blockindex, pmc);
+ pmc^.prev_fixed := pointer(pmc)-chunksize;
+ freelists_fixed[blockindex] := pmemchunk_fixed(result);
+ end
+ else
+ begin
+ pmcv := pmemchunk_var(result);
+ append_to_list_var(pmcv);
+ pmcv^.size := ((size-sizeof(toschunk)) and sizemask) or (firstblockflag or lastblockflag);
+ pmcv^.prevsize := 0;
+ end;
+{$ifdef TestFreeLists}
+ TestFreeLists;
+{$endif TestFreeLists}
+end;
+
+{*****************************************************************************
+ SysGetMem
+*****************************************************************************}
+
+function SysGetMem_Fixed(size: ptrint): pointer;
+var
+ pcurr: pmemchunk_fixed;
+ poc: poschunk;
+ s: ptrint;
+begin
+ result:=nil;
+ { try to find a block in one of the freelists per size }
+ s := size shr blockshr;
+ pcurr := freelists_fixed[s];
+ { no free blocks ? }
+ if not assigned(pcurr) then
+ begin
+ pcurr := alloc_oschunk(s, size);
+ if not assigned(pcurr) then
+ exit;
+ end;
+ { get a pointer to the block we should return }
+ result := pointer(pcurr)+sizeof(tmemchunk_fixed_hdr);
+ { flag as in-use }
+ pcurr^.size := pcurr^.size or usedflag;
+ { update freelist }
+ freelists_fixed[s] := pcurr^.next_fixed;
+ if assigned(freelists_fixed[s]) then
+ freelists_fixed[s]^.prev_fixed := nil;
+ poc := poschunk(pointer(pcurr)-((pcurr^.size shr 16)*(pcurr^.size and fixedsizemask)+sizeof(toschunk)));
+ inc(poc^.used);
+ { statistics }
+ inc(internal_status.currheapused,size);
+ if internal_status.currheapused>internal_status.maxheapused then
+ internal_status.maxheapused:=internal_status.currheapused;
+{$ifdef TestFreeLists}
+ if test_each then
+ TestFreeLists;
+{$endif TestFreeLists}
+end;
+
+function SysGetMem_Var(size: ptrint): pointer;
+var
+ pcurr : pmemchunk_var;
+{$ifdef BESTMATCH}
+ pbest : pmemchunk_var;
+{$endif}
+begin
+ result:=nil;
+{$ifdef BESTMATCH}
+ pbest := nil;
+{$endif}
+ pcurr := freelist_var;
+ while assigned(pcurr) do
+ begin
+{$ifdef BESTMATCH}
+ if pcurr^.size=size then
+ begin
+ break;
+ end
+ else
+ begin
+ if (pcurr^.size>size) then
+ begin
+ if (not assigned(pbest)) or
+ (pcurr^.size<pbest^.size) then
+ pbest := pcurr;
+ end;
+ end;
+{$else BESTMATCH}
+ if pcurr^.size>=size then
+ break;
+{$endif BESTMATCH}
+ pcurr := pcurr^.next_var;
+ end;
+{$ifdef BESTMATCH}
+ if not assigned(pcurr) then
+ pcurr := pbest;
+{$endif}
+
+ if not assigned(pcurr) then
+ begin
+ // all os-chunks full, allocate a new one
+ pcurr := alloc_oschunk(0, size);
+ if not assigned(pcurr) then
+ exit;
+ end;
+
+ { get pointer of the block we should return }
+ result := pointer(pcurr)+sizeof(tmemchunk_var_hdr);
+ { remove the current block from the freelist }
+ remove_from_list_var(pcurr);
+ { create the left over freelist block, if at least 16 bytes are free }
+ split_block(pcurr, size);
+ { flag block as used }
+ pcurr^.size := pcurr^.size or usedflag;
+ { statistics }
+ inc(internal_status.currheapused,size);
+ if internal_status.currheapused>internal_status.maxheapused then
+ internal_status.maxheapused:=internal_status.currheapused;
+{$ifdef TestFreeLists}
+ if test_each then
+ TestFreeLists;
+{$endif TestFreeLists}
+end;
+
+function SysGetMem(size : ptrint):pointer;
+begin
+{ Something to allocate ? }
+ if size<=0 then
+ begin
+ { give an error for < 0 }
+ if size<0 then
+ HandleError(204);
+ { we always need to allocate something, using heapend is not possible,
+ because heappend can be changed by growheap (PFV) }
+ size := 1;
+ end;
+{ calc to multiple of 16 after adding the needed bytes for memchunk header }
+ if size <= (maxblocksize - sizeof(tmemchunk_fixed_hdr)) then
+ begin
+ size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
+ sysgetmem := sysgetmem_fixed(size);
+ end
+ else
+ begin
+ size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
+ sysgetmem := sysgetmem_var(size);
+ end;
+end;
+
+
+{*****************************************************************************
+ SysFreeMem
+*****************************************************************************}
+
+function SysFreeMem_Fixed(pcurr: pmemchunk_fixed; size: ptrint): ptrint;
+var
+ pcurrsize: ptrint;
+ blockindex: ptrint;
+ poc: poschunk;
+begin
+ pcurrsize := pcurr^.size and fixedsizemask;
+ if size<>pcurrsize then
+ HandleError(204);
+ dec(internal_status.currheapused,pcurrsize);
+ { insert the block in it's freelist }
+ pcurr^.size := pcurr^.size and (not usedflag);
+ blockindex := pcurrsize shr blockshr;
+ append_to_list_fixed(blockindex, pcurr);
+ { decrease used blocks count }
+ poc := poschunk(pointer(pcurr)-(pcurr^.size shr 16)*pcurrsize-sizeof(toschunk));
+ if poc^.used = 0 then
+ HandleError(204);
+ dec(poc^.used);
+ if poc^.used = 0 then
+ begin
+ // block eligable for freeing
+ append_to_oslist_fixed(blockindex, pcurrsize, poc);
+ end;
+ SysFreeMem_Fixed := pcurrsize;
+{$ifdef TestFreeLists}
+ if test_each then
+ TestFreeLists;
+{$endif TestFreeLists}
+end;
+
+function SysFreeMem_Var(pcurr: pmemchunk_var; size: ptrint): ptrint;
+var
+ pcurrsize: ptrint;
+begin
+ pcurrsize := pcurr^.size and sizemask;
+ if size<>pcurrsize then
+ HandleError(204);
+ dec(internal_status.currheapused,pcurrsize);
+ { insert the block in it's freelist }
+ pcurr^.size := pcurr^.size and (not usedflag);
+ append_to_list_var(pcurr);
+ SysFreeMem_Var := pcurrsize;
+ pcurr := try_concat_free_chunk(pcurr);
+ if (pcurr^.size and (firstblockflag or lastblockflag)) = (firstblockflag or lastblockflag) then
+ begin
+ append_to_oslist_var(pcurr);
+ end;
+{$ifdef TestFreeLists}
+ if test_each then
+ TestFreeLists;
+{$endif TestFreeLists}
+end;
+
+
+function SysFreeMem(p: pointer): ptrint;
+var
+ pcurrsize: ptrint;
+begin
+ if p=nil then
+ exit;
+ pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
+ { check if this is a fixed- or var-sized chunk }
+ if (pcurrsize and fixedsizeflag) = 0 then
+ begin
+ result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr)), pcurrsize and sizemask);
+ end
+ else
+ begin
+ result := sysfreemem_fixed(pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)), pcurrsize and fixedsizemask);
+ end;
+end;
+
+{*****************************************************************************
+ SysFreeMemSize
+*****************************************************************************}
+
+Function SysFreeMemSize(p: pointer; size: ptrint):ptrint;
+var
+ pcurrsize: ptrint;
+begin
+ SysFreeMemSize := 0;
+ if size<=0 then
+ begin
+ if size<0 then
+ HandleError(204);
+ exit;
+ end;
+ if p=nil then
+ HandleError(204);
+
+ pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
+ { check if this is a fixed- or var-sized chunk }
+ if (pcurrsize and fixedsizeflag) = 0 then
+ begin
+ size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
+ result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr)), size);
+ end
+ else
+ begin
+ size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
+ result := sysfreemem_fixed(pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)), size);
+ end;
+end;
+
+
+{*****************************************************************************
+ SysMemSize
+*****************************************************************************}
+
+function SysMemSize(p: pointer): ptrint;
+begin
+ SysMemSize := pmemchunk_fixed(pointer(p)-sizeof(tmemchunk_fixed_hdr))^.size;
+ if (SysMemSize and fixedsizeflag) = 0 then
+ begin
+ SysMemSize := SysMemSize and sizemask;
+ dec(SysMemSize, sizeof(tmemchunk_var_hdr));
+ end
+ else
+ begin
+ SysMemSize := SysMemSize and fixedsizemask;
+ dec(SysMemSize, sizeof(tmemchunk_fixed_hdr));
+ end;
+end;
+
+
+{*****************************************************************************
+ SysAllocMem
+*****************************************************************************}
+
+function SysAllocMem(size: ptrint): pointer;
+begin
+ sysallocmem := MemoryManager.GetMem(size);
+ if sysallocmem<>nil then
+ FillChar(sysallocmem^,MemoryManager.MemSize(sysallocmem),0);
+end;
+
+
+{*****************************************************************************
+ SysResizeMem
+*****************************************************************************}
+
+function SysTryResizeMem(var p: pointer; size: ptrint): boolean;
+var
+ pcurrsize,
+ oldsize,
+ currsize : ptrint;
+ pcurr : pmemchunk_var;
+begin
+ SysTryResizeMem := false;
+
+ { fix p to point to the heaprecord }
+ pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
+ if (pcurrsize and fixedsizeflag) = 0 then
+ begin
+ currsize := pcurrsize and sizemask;
+ size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
+ end
+ else
+ begin
+ currsize := pcurrsize and fixedsizemask;
+ size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
+ end;
+
+ { is the allocated block still correct? }
+ if (currsize>=size) and (size>(currsize-blocksize)) then
+ begin
+ SysTryResizeMem := true;
+{$ifdef TestFreeLists}
+ if test_each then
+ TestFreeLists;
+{$endif TestFreeLists}
+ exit;
+ end;
+
+ { don't do resizes on fixed-size blocks }
+ if (pcurrsize and fixedsizeflag) <> 0 then
+ exit;
+
+ { get pointer to block }
+ pcurr := pmemchunk_var(pointer(p)-sizeof(tmemchunk_var_hdr));
+ oldsize := currsize;
+
+ { do we need to allocate more memory ? }
+ if size>currsize then
+ begin
+ { the size is bigger than the previous size, we need to allocated more mem.
+ We first check if the blocks after the current block are free. If not we
+ simply call getmem/freemem to get the new block }
+ if check_concat_free_chunk_forward(pcurr,size) then
+ begin
+ try_concat_free_chunk_forward(pcurr);
+ currsize := (pcurr^.size and sizemask);
+ end;
+ end;
+
+ { not enough space? }
+ if size>currsize then
+ exit;
+
+ { is the size smaller then we can adjust the block to that size and insert
+ the other part into the freelist }
+ if currsize>size then
+ split_block(pcurr, size);
+
+ inc(internal_status.currheapused,size-oldsize);
+ SysTryResizeMem := true;
+
+{$ifdef TestFreeLists}
+ if test_each then
+ TestFreeLists;
+{$endif TestFreeLists}
+end;
+
+
+{*****************************************************************************
+ SysResizeMem
+*****************************************************************************}
+
+function SysReAllocMem(var p: pointer; size: ptrint):pointer;
+var
+ minsize : ptrint;
+ p2 : pointer;
+begin
+ { Free block? }
+ if size=0 then
+ begin
+ if p<>nil then
+ begin
+ MemoryManager.FreeMem(p);
+ p := nil;
+ end;
+ end
+ else
+ { Allocate a new block? }
+ if p=nil then
+ begin
+ p := MemoryManager.GetMem(size);
+ end
+ else
+ { Resize block }
+ if not SysTryResizeMem(p,size) then
+ begin
+ minsize := MemoryManager.MemSize(p);
+ if size < minsize then
+ minsize := size;
+ p2 := MemoryManager.GetMem(size);
+ if p2<>nil then
+ Move(p^,p2^,minsize);
+ MemoryManager.FreeMem(p);
+ p := p2;
+ end;
+ SysReAllocMem := p;
+end;
+
+
+{*****************************************************************************
+ MemoryMutexManager default hooks
+*****************************************************************************}
+
+procedure SysHeapMutexInit;
+begin
+ { nothing todo }
+end;
+
+procedure SysHeapMutexDone;
+begin
+ { nothing todo }
+end;
+
+procedure SysHeapMutexLock;
+begin
+ { give an runtime error. the program is running multithreaded without
+ any heap protection. this will result in unpredictable errors so
+ stopping here with an error is more safe (PFV) }
+ runerror(244);
+end;
+
+procedure SysHeapMutexUnLock;
+begin
+ { see SysHeapMutexLock for comment }
+ runerror(244);
+end;
+
+
+{*****************************************************************************
+ InitHeap
+*****************************************************************************}
+
+{ This function will initialize the Heap manager and need to be called from
+ the initialization of the system unit }
+procedure InitHeap;
+begin
+ FillChar(freelists_fixed,sizeof(tfreelists),0);
+ freelist_var := nil;
+ freeoslist := nil;
+ freeoslistcount := 0;
+ fillchar(internal_status,sizeof(internal_status),0);
+end;
+
+{
+ $Log: heap.inc,v $
+ Revision 1.51 2005/04/04 15:40:30 peter
+ * check if there is enough room before concatting blocks in
+ systryresizemem()
+
+ Revision 1.50 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.49 2005/03/21 16:31:33 peter
+ * fix crash under win32 with previous reallocmem fix
+
+ Revision 1.48 2005/03/20 18:57:29 peter
+ * fixed tryresizemem
+
+ Revision 1.47 2005/03/04 16:49:34 peter
+ * fix getheapstatus bootstrapping
+
+ Revision 1.46 2005/03/02 14:25:19 marco
+ * small typo fix on last commit
+
+ Revision 1.45 2005/03/02 10:46:10 marco
+ * getfpcheapstatus now also on memmgr
+
+ Revision 1.44 2005/02/28 15:38:38 marco
+ * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
+
+ Revision 1.43 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.42 2005/01/30 11:56:29 peter
+ * allow Freemem(nil)
+
+}
+
diff --git a/rtl/inc/heaph.inc b/rtl/inc/heaph.inc
new file mode 100644
index 0000000000..c11e6c1b45
--- /dev/null
+++ b/rtl/inc/heaph.inc
@@ -0,0 +1,151 @@
+{
+ $Id: heaph.inc,v 1.15 2005/03/04 16:49:34 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Heap manager interface section
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ Memorymanager }
+type
+{$ifdef HASGETFPCHEAPSTATUS}
+ TFPCHeapStatus = record
+ MaxHeapSize,
+ MaxHeapUsed,
+ CurrHeapSize,
+ CurrHeapUsed,
+ CurrHeapFree : ptrint;
+ end;
+ THeapStatus = record
+ TotalAddrSpace: Cardinal;
+ TotalUncommitted: Cardinal;
+ TotalCommitted: Cardinal;
+ TotalAllocated: Cardinal;
+ TotalFree: Cardinal;
+ FreeSmall: Cardinal;
+ FreeBig: Cardinal;
+ Unused: Cardinal;
+ Overhead: Cardinal;
+ HeapErrorCode: Cardinal;
+ end;
+{$else HASGETFPCHEAPSTATUS}
+ THeapStatus = record
+ MaxHeapSize,
+ MaxHeapUsed,
+ CurrHeapSize,
+ CurrHeapUsed,
+ CurrHeapFree : ptrint;
+ end;
+{$endif HASGETFPCHEAPSTATUS}
+
+ PMemoryManager = ^TMemoryManager;
+ TMemoryManager = record
+ NeedLock : boolean;
+ Getmem : Function(Size:ptrint):Pointer;
+ Freemem : Function(p:pointer):ptrint;
+ FreememSize : Function(p:pointer;Size:ptrint):ptrint;
+ AllocMem : Function(Size:ptrint):Pointer;
+ ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer;
+ MemSize : function(p:pointer):ptrint;
+{$ifdef HASGETFPCHEAPSTATUS}
+ GetHeapStatus : function :THeapStatus;
+ GetFPCHeapStatus : function :TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ GetHeapStatus : procedure(var status:THeapStatus);
+{$endif HASGETFPCHEAPSTATUS}
+ end;
+
+ TMemoryMutexManager = record
+ MutexInit : procedure;
+ MutexDone : procedure;
+ MutexLock : procedure;
+ MutexUnlock : procedure;
+ end;
+
+procedure GetMemoryManager(var MemMgr: TMemoryManager);
+procedure SetMemoryManager(const MemMgr: TMemoryManager);
+function IsMemoryManagerSet: Boolean;
+procedure SetMemoryMutexManager(var MutexMgr: TMemoryMutexManager);
+
+{ Variables }
+const
+ growheapsizesmall : ptrint=32*1024; { fixed-size small blocks will grow with 32k }
+ growheapsize1 : ptrint=256*1024; { < 256k will grow with 256k }
+ growheapsize2 : ptrint=1024*1024; { > 256k will grow with 1m }
+var
+ ReturnNilIfGrowHeapFails : boolean;
+
+{ Default MemoryManager functions }
+Function SysGetmem(Size:ptrint):Pointer;
+Function SysFreemem(p:pointer):ptrint;
+Function SysFreememSize(p:pointer;Size:ptrint):ptrint;
+Function SysMemSize(p:pointer):ptrint;
+Function SysAllocMem(size:ptrint):Pointer;
+function SysTryResizeMem(var p:pointer;size : ptrint):boolean;
+Function SysReAllocMem(var p:pointer;size:ptrint):Pointer;
+{$ifdef HASGETFPCHEAPSTATUS}
+function SysGetHeapStatus:THeapStatus;
+function SysGetFPCHeapStatus:TFPCHeapStatus;
+{$else}
+procedure SysGetHeapStatus(var status:THeapStatus);
+{$endif HASGETFPCHEAPSTATUS}
+
+{ Tp7 functions }
+Procedure Getmem(Var p:pointer;Size:ptrint);
+Procedure Getmemory(Var p:pointer;Size:ptrint);
+Procedure Freemem(p:pointer;Size:ptrint);
+Procedure Freememory(p:pointer;Size:ptrint);
+
+{ FPC additions }
+Function MemSize(p:pointer):ptrint;
+
+{ Delphi functions }
+function GetMem(size:ptrint):pointer;
+function GetMemory(size:ptrint):pointer;
+function Freemem(p:pointer):ptrint;
+function Freememory(p:pointer):ptrint;
+function AllocMem(Size:ptrint):pointer;
+function ReAllocMem(var p:pointer;Size:ptrint):pointer;
+function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
+{$ifdef HASGETFPCHEAPSTATUS}
+function GetHeapStatus:THeapStatus;
+function GetFPCHeapStatus:TFPCHeapStatus;
+{$else}
+procedure GetHeapStatus(var status:THeapStatus);
+{$endif HASGETFPCHEAPSTATUS}
+
+{$ifndef ValueGetmem}
+{ Needed to solve overloading problem with call from assembler (PFV) }
+Procedure AsmGetmem(var p:pointer;size:ptrint);
+{$endif ValueGetmem}
+{$ifndef ValueFreemem}
+Procedure AsmFreemem(var p:pointer);
+{$endif ValueFreemem}
+
+{ Bootstrapping }
+{$ifndef HASGETHEAPSTATUS}
+Function Memavail:ptrint;
+Function Maxavail:ptrint;
+Function Heapsize:ptrint;
+{$endif HASGETHEAPSTATUS}
+
+{
+ $Log: heaph.inc,v $
+ Revision 1.15 2005/03/04 16:49:34 peter
+ * fix getheapstatus bootstrapping
+
+ Revision 1.14 2005/02/28 15:38:38 marco
+ * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
+
+ Revision 1.13 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp
new file mode 100644
index 0000000000..47ada78d2f
--- /dev/null
+++ b/rtl/inc/heaptrc.pp
@@ -0,0 +1,1223 @@
+{
+ $Id: heaptrc.pp,v 1.44 2005/04/04 15:16:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Heap tracer
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit heaptrc;
+interface
+
+{ 1.0.x doesn't have good rangechecking for cardinals }
+{$ifdef VER1_0}
+ {$R-}
+{$endif}
+
+{$goto on}
+
+Procedure DumpHeap;
+Procedure MarkHeap;
+
+{ define EXTRA to add more
+ tests :
+ - keep all memory after release and
+ check by CRC value if not changed after release
+ WARNING this needs extremely much memory (PM) }
+
+type
+ tFillExtraInfoProc = procedure(p : pointer);
+ tdisplayextrainfoProc = procedure (var ptext : text;p : pointer);
+
+{ Allows to add info pre memory block, see ppheap.pas of the compiler
+ for example source }
+procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
+
+{ Redirection of the output to a file }
+procedure SetHeapTraceOutput(const name : string);
+
+const
+ { tracing level
+ splitted in two if memory is released !! }
+{$ifdef EXTRA}
+ tracesize = 16;
+{$else EXTRA}
+ tracesize = 8;
+{$endif EXTRA}
+ { install heaptrc memorymanager }
+ useheaptrace : boolean=true;
+ { less checking }
+ quicktrace : boolean=true;
+ { calls halt() on error by default !! }
+ HaltOnError : boolean = true;
+ { set this to true if you suspect that memory
+ is freed several times }
+{$ifdef EXTRA}
+ keepreleased : boolean=true;
+{$else EXTRA}
+ keepreleased : boolean=false;
+{$endif EXTRA}
+ { add a small footprint at the end of memory blocks, this
+ can check for memory overwrites at the end of a block }
+ add_tail : boolean = true;
+ { put crc in sig
+ this allows to test for writing into that part }
+ usecrc : boolean = true;
+
+
+implementation
+
+type
+ pptrint = ^ptrint;
+
+const
+ { allows to add custom info in heap_mem_info, this is the size that will
+ be allocated for this information }
+ extra_info_size : ptrint = 0;
+ exact_info_size : ptrint = 0;
+ EntryMemUsed : ptrint = 0;
+ { function to fill this info up }
+ fill_extra_info_proc : TFillExtraInfoProc = nil;
+ display_extra_info_proc : TDisplayExtraInfoProc = nil;
+ error_in_heap : boolean = false;
+ inside_trace_getmem : boolean = false;
+ { indicates where the output will be redirected }
+ { only set using environment variables }
+ outputstr : shortstring = '';
+
+type
+ pheap_extra_info = ^theap_extra_info;
+ theap_extra_info = record
+ check : cardinal; { used to check if the procvar is still valid }
+ fillproc : tfillextrainfoProc;
+ displayproc : tdisplayextrainfoProc;
+ data : record
+ end;
+ end;
+
+ { warning the size of theap_mem_info
+ must be a multiple of 8
+ because otherwise you will get
+ problems when releasing the usual memory part !!
+ sizeof(theap_mem_info = 16+tracesize*4 so
+ tracesize must be even !! PM }
+ pheap_mem_info = ^theap_mem_info;
+ theap_mem_info = record
+ previous,
+ next : pheap_mem_info;
+ size : ptrint;
+ sig : longword;
+{$ifdef EXTRA}
+ release_sig : longword;
+ prev_valid : pheap_mem_info;
+{$endif EXTRA}
+ calls : array [1..tracesize] of pointer;
+ exact_info_size : word;
+ extra_info_size : word;
+ extra_info : pheap_extra_info;
+ end;
+
+var
+ ptext : ^text;
+ ownfile : text;
+{$ifdef EXTRA}
+ error_file : text;
+ heap_valid_first,
+ heap_valid_last : pheap_mem_info;
+{$endif EXTRA}
+ heap_mem_root : pheap_mem_info;
+ getmem_cnt,
+ freemem_cnt : ptrint;
+ getmem_size,
+ freemem_size : ptrint;
+ getmem8_size,
+ freemem8_size : ptrint;
+
+
+{*****************************************************************************
+ Crc 32
+*****************************************************************************}
+
+var
+ Crc32Tbl : array[0..255] of longword;
+
+procedure MakeCRC32Tbl;
+var
+ crc : longword;
+ i,n : byte;
+begin
+ for i:=0 to 255 do
+ begin
+ crc:=i;
+ for n:=1 to 8 do
+ if odd(crc) then
+ crc:=(crc shr 1) xor $edb88320
+ else
+ crc:=crc shr 1;
+ Crc32Tbl[i]:=crc;
+ end;
+end;
+
+
+Function UpdateCrc32(InitCrc:longword;var InBuf;InLen:ptrint):longword;
+var
+ i : ptrint;
+ p : pchar;
+begin
+ p:=@InBuf;
+ for i:=1 to InLen do
+ begin
+ InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
+ inc(p);
+ end;
+ UpdateCrc32:=InitCrc;
+end;
+
+Function calculate_sig(p : pheap_mem_info) : longword;
+var
+ crc : longword;
+ pl : pptrint;
+begin
+ crc:=cardinal($ffffffff);
+ crc:=UpdateCrc32(crc,p^.size,sizeof(ptrint));
+ crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptrint));
+ if p^.extra_info_size>0 then
+ crc:=UpdateCrc32(crc,p^.extra_info^,p^.exact_info_size);
+ if add_tail then
+ begin
+ { Check also 4 bytes just after allocation !! }
+ pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size;
+ crc:=UpdateCrc32(crc,pl^,sizeof(ptrint));
+ end;
+ calculate_sig:=crc;
+end;
+
+{$ifdef EXTRA}
+Function calculate_release_sig(p : pheap_mem_info) : longword;
+var
+ crc : longword;
+ pl : pptrint;
+begin
+ crc:=$ffffffff;
+ crc:=UpdateCrc32(crc,p^.size,sizeof(ptrint));
+ crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptrint));
+ if p^.extra_info_size>0 then
+ crc:=UpdateCrc32(crc,p^.extra_info^,p^.exact_info_size);
+ { Check the whole of the whole allocation }
+ pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info);
+ crc:=UpdateCrc32(crc,pl^,p^.size);
+ { Check also 4 bytes just after allocation !! }
+ if add_tail then
+ begin
+ { Check also 4 bytes just after allocation !! }
+ pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size;
+ crc:=UpdateCrc32(crc,pl^,sizeof(ptrint));
+ end;
+ calculate_release_sig:=crc;
+end;
+{$endif EXTRA}
+
+
+{*****************************************************************************
+ Helpers
+*****************************************************************************}
+
+procedure call_stack(pp : pheap_mem_info;var ptext : text);
+var
+ i : ptrint;
+begin
+ writeln(ptext,'Call trace for block $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
+ for i:=1 to tracesize do
+ if pp^.calls[i]<>nil then
+ writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
+ { the check is done to be sure that the procvar is not overwritten }
+ if assigned(pp^.extra_info) and
+ (pp^.extra_info^.check=$12345678) and
+ assigned(pp^.extra_info^.displayproc) then
+ pp^.extra_info^.displayproc(ptext,@pp^.extra_info^.data);
+end;
+
+
+procedure call_free_stack(pp : pheap_mem_info;var ptext : text);
+var
+ i : ptrint;
+begin
+ writeln(ptext,'Call trace for block at $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
+ for i:=1 to tracesize div 2 do
+ if pp^.calls[i]<>nil then
+ writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
+ writeln(ptext,' was released at ');
+ for i:=(tracesize div 2)+1 to tracesize do
+ if pp^.calls[i]<>nil then
+ writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
+ { the check is done to be sure that the procvar is not overwritten }
+ if assigned(pp^.extra_info) and
+ (pp^.extra_info^.check=$12345678) and
+ assigned(pp^.extra_info^.displayproc) then
+ pp^.extra_info^.displayproc(ptext,@pp^.extra_info^.data);
+end;
+
+
+procedure dump_already_free(p : pheap_mem_info;var ptext : text);
+begin
+ Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' released');
+ call_free_stack(p,ptext);
+ Writeln(ptext,'freed again at');
+ dump_stack(ptext,get_caller_frame(get_frame));
+end;
+
+procedure dump_error(p : pheap_mem_info;var ptext : text);
+begin
+ Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
+ Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
+ dump_stack(ptext,get_caller_frame(get_frame));
+end;
+
+{$ifdef EXTRA}
+procedure dump_change_after(p : pheap_mem_info;var ptext : text);
+ var pp : pchar;
+ i : ptrint;
+begin
+ Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
+ Writeln(ptext,'Wrong release CRC $',hexstr(p^.release_sig,8),' instead of ',hexstr(calculate_release_sig(p),8));
+ Writeln(ptext,'This memory was changed after call to freemem !');
+ call_free_stack(p,ptext);
+ pp:=pointer(p)+sizeof(theap_mem_info);
+ for i:=0 to p^.size-1 do
+ if byte(pp[i])<>$F0 then
+ Writeln(ptext,'offset',i,':$',hexstr(i,8),'"',pp[i],'"');
+end;
+{$endif EXTRA}
+
+procedure dump_wrong_size(p : pheap_mem_info;size : ptrint;var ptext : text);
+begin
+ Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
+ Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
+ dump_stack(ptext,get_caller_frame(get_frame));
+ { the check is done to be sure that the procvar is not overwritten }
+ if assigned(p^.extra_info) and
+ (p^.extra_info^.check=$12345678) and
+ assigned(p^.extra_info^.displayproc) then
+ p^.extra_info^.displayproc(ptext,@p^.extra_info^.data);
+ call_stack(p,ptext);
+end;
+
+
+function is_in_getmem_list (p : pheap_mem_info) : boolean;
+var
+ i : ptrint;
+ pp : pheap_mem_info;
+begin
+ is_in_getmem_list:=false;
+ pp:=heap_mem_root;
+ i:=0;
+ while pp<>nil do
+ begin
+ if ((pp^.sig<>$DEADBEEF) or usecrc) and
+ ((pp^.sig<>calculate_sig(pp)) or not usecrc) and
+ (pp^.sig <>$AAAAAAAA) then
+ begin
+ writeln(ptext^,'error in linked list of heap_mem_info');
+ RunError(204);
+ end;
+ if pp=p then
+ is_in_getmem_list:=true;
+ pp:=pp^.previous;
+ inc(i);
+ if i>getmem_cnt-freemem_cnt then
+ writeln(ptext^,'error in linked list of heap_mem_info');
+ end;
+end;
+
+
+{*****************************************************************************
+ TraceGetMem
+*****************************************************************************}
+
+Function TraceGetMem(size:ptrint):pointer;
+var
+ allocsize,i : ptrint;
+ oldbp,
+ bp : pointer;
+ pl : pdword;
+ p : pointer;
+ pp : pheap_mem_info;
+begin
+ inc(getmem_size,size);
+ inc(getmem8_size,((size+7) div 8)*8);
+{ Do the real GetMem, but alloc also for the info block }
+ allocsize:=size+sizeof(theap_mem_info)+extra_info_size;
+ if add_tail then
+ inc(allocsize,sizeof(ptrint));
+ p:=SysGetMem(allocsize);
+ pp:=pheap_mem_info(p);
+ inc(p,sizeof(theap_mem_info));
+{ Create the info block }
+ pp^.sig:=$DEADBEEF;
+ pp^.size:=size;
+ pp^.extra_info_size:=extra_info_size;
+ pp^.exact_info_size:=exact_info_size;
+ {
+ the end of the block contains:
+ <tail> 4 bytes
+ <extra_info> X bytes
+ }
+ if extra_info_size>0 then
+ begin
+ pp^.extra_info:=pointer(pp)+allocsize-extra_info_size;
+ fillchar(pp^.extra_info^,extra_info_size,0);
+ pp^.extra_info^.check:=$12345678;
+ pp^.extra_info^.fillproc:=fill_extra_info_proc;
+ pp^.extra_info^.displayproc:=display_extra_info_proc;
+ if assigned(fill_extra_info_proc) then
+ begin
+ inside_trace_getmem:=true;
+ fill_extra_info_proc(@pp^.extra_info^.data);
+ inside_trace_getmem:=false;
+ end;
+ end
+ else
+ pp^.extra_info:=nil;
+ if add_tail then
+ begin
+ pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptrint);
+ pl^:=$DEADBEEF;
+ end;
+ { clear the memory }
+ fillchar(p^,size,#255);
+ { retrieve backtrace info }
+ bp:=get_caller_frame(get_frame);
+ for i:=1 to tracesize do
+ begin
+ pp^.calls[i]:=get_caller_addr(bp);
+ oldbp:=bp;
+ bp:=get_caller_frame(bp);
+ if (bp<oldbp) or (bp>(StackBottom + StackLength)) then
+ bp:=nil;
+ end;
+ { insert in the linked list }
+ if heap_mem_root<>nil then
+ heap_mem_root^.next:=pp;
+ pp^.previous:=heap_mem_root;
+ pp^.next:=nil;
+{$ifdef EXTRA}
+ pp^.prev_valid:=heap_valid_last;
+ heap_valid_last:=pp;
+ if not assigned(heap_valid_first) then
+ heap_valid_first:=pp;
+{$endif EXTRA}
+ heap_mem_root:=pp;
+ { must be changed before fill_extra_info is called
+ because checkpointer can be called from within
+ fill_extra_info PM }
+ inc(getmem_cnt);
+ { update the signature }
+ if usecrc then
+ pp^.sig:=calculate_sig(pp);
+ TraceGetmem:=p;
+end;
+
+
+{*****************************************************************************
+ TraceFreeMem
+*****************************************************************************}
+
+function TraceFreeMemSize(p:pointer;size:ptrint):ptrint;
+var
+ i,ppsize : ptrint;
+ bp : pointer;
+ pp : pheap_mem_info;
+{$ifdef EXTRA}
+ pp2 : pheap_mem_info;
+{$endif}
+ extra_size : ptrint;
+begin
+ inc(freemem_size,size);
+ inc(freemem8_size,((size+7) div 8)*8);
+ pp:=pheap_mem_info(p-sizeof(theap_mem_info));
+ ppsize:= size + sizeof(theap_mem_info)+pp^.extra_info_size;
+ if add_tail then
+ inc(ppsize,sizeof(ptrint));
+ if not quicktrace then
+ begin
+ if not(is_in_getmem_list(pp)) then
+ RunError(204);
+ end;
+ if (pp^.sig=$AAAAAAAA) and not usecrc then
+ begin
+ error_in_heap:=true;
+ dump_already_free(pp,ptext^);
+ if haltonerror then halt(1);
+ end
+ else if ((pp^.sig<>$DEADBEEF) or usecrc) and
+ ((pp^.sig<>calculate_sig(pp)) or not usecrc) then
+ begin
+ error_in_heap:=true;
+ dump_error(pp,ptext^);
+{$ifdef EXTRA}
+ dump_error(pp,error_file);
+{$endif EXTRA}
+ { don't release anything in this case !! }
+ if haltonerror then halt(1);
+ exit;
+ end
+ else if pp^.size<>size then
+ begin
+ error_in_heap:=true;
+ dump_wrong_size(pp,size,ptext^);
+{$ifdef EXTRA}
+ dump_wrong_size(pp,size,error_file);
+{$endif EXTRA}
+ if haltonerror then halt(1);
+ { don't release anything in this case !! }
+ exit;
+ end;
+ { save old values }
+ extra_size:=pp^.extra_info_size;
+ { now it is released !! }
+ pp^.sig:=$AAAAAAAA;
+ if not keepreleased then
+ begin
+ if pp^.next<>nil then
+ pp^.next^.previous:=pp^.previous;
+ if pp^.previous<>nil then
+ pp^.previous^.next:=pp^.next;
+ if pp=heap_mem_root then
+ heap_mem_root:=heap_mem_root^.previous;
+ end
+ else
+ begin
+ bp:=get_caller_frame(get_frame);
+ for i:=(tracesize div 2)+1 to tracesize do
+ begin
+ pp^.calls[i]:=get_caller_addr(bp);
+ bp:=get_caller_frame(bp);
+ end;
+ end;
+ inc(freemem_cnt);
+ { clear the memory }
+ fillchar(p^,size,#240); { $F0 will lead to GFP if used as pointer ! }
+ { this way we keep all info about all released memory !! }
+ if keepreleased then
+ begin
+{$ifdef EXTRA}
+ { We want to check if the memory was changed after release !! }
+ pp^.release_sig:=calculate_release_sig(pp);
+ if pp=heap_valid_last then
+ begin
+ heap_valid_last:=pp^.prev_valid;
+ if pp=heap_valid_first then
+ heap_valid_first:=nil;
+ TraceFreememsize:=size;
+ exit;
+ end;
+ pp2:=heap_valid_last;
+ while assigned(pp2) do
+ begin
+ if pp2^.prev_valid=pp then
+ begin
+ pp2^.prev_valid:=pp^.prev_valid;
+ if pp=heap_valid_first then
+ heap_valid_first:=pp2;
+ TraceFreememsize:=size;
+ exit;
+ end
+ else
+ pp2:=pp2^.prev_valid;
+ end;
+{$endif EXTRA}
+ TraceFreememsize:=size;
+ exit;
+ end;
+ { release the normal memory at least }
+ i:=SysFreeMemSize(pp,ppsize);
+ { return the correct size }
+ dec(i,sizeof(theap_mem_info)+extra_size);
+ if add_tail then
+ dec(i,sizeof(ptrint));
+ TraceFreeMemSize:=i;
+end;
+
+
+function TraceMemSize(p:pointer):ptrint;
+var
+ pp : pheap_mem_info;
+begin
+ pp:=pheap_mem_info(p-sizeof(theap_mem_info));
+ TraceMemSize:=pp^.size;
+end;
+
+
+function TraceFreeMem(p:pointer):ptrint;
+var
+ l : ptrint;
+ pp : pheap_mem_info;
+begin
+ pp:=pheap_mem_info(p-sizeof(theap_mem_info));
+ l:=SysMemSize(pp);
+ dec(l,sizeof(theap_mem_info)+pp^.extra_info_size);
+ if add_tail then
+ dec(l,sizeof(ptrint));
+ { this can never happend normaly }
+ if pp^.size>l then
+ begin
+ dump_wrong_size(pp,l,ptext^);
+{$ifdef EXTRA}
+ dump_wrong_size(pp,l,error_file);
+{$endif EXTRA}
+ end;
+ TraceFreeMem:=TraceFreeMemSize(p,pp^.size);
+end;
+
+
+{*****************************************************************************
+ ReAllocMem
+*****************************************************************************}
+
+function TraceReAllocMem(var p:pointer;size:ptrint):Pointer;
+var
+ newP: pointer;
+ allocsize,
+ movesize,
+ i : ptrint;
+ bp : pointer;
+ pl : pdword;
+ pp : pheap_mem_info;
+ oldsize,
+ oldextrasize,
+ oldexactsize : ptrint;
+ old_fill_extra_info_proc : tfillextrainfoproc;
+ old_display_extra_info_proc : tdisplayextrainfoproc;
+begin
+{ Free block? }
+ if size=0 then
+ begin
+ if p<>nil then
+ TraceFreeMem(p);
+ p:=nil;
+ TraceReallocMem:=P;
+ exit;
+ end;
+{ Allocate a new block? }
+ if p=nil then
+ begin
+ p:=TraceGetMem(size);
+ TraceReallocMem:=P;
+ exit;
+ end;
+{ Resize block }
+ pp:=pheap_mem_info(p-sizeof(theap_mem_info));
+ { test block }
+ if ((pp^.sig<>$DEADBEEF) or usecrc) and
+ ((pp^.sig<>calculate_sig(pp)) or not usecrc) then
+ begin
+ error_in_heap:=true;
+ dump_error(pp,ptext^);
+{$ifdef EXTRA}
+ dump_error(pp,error_file);
+{$endif EXTRA}
+ { don't release anything in this case !! }
+ if haltonerror then halt(1);
+ exit;
+ end;
+ { save info }
+ oldsize:=pp^.size;
+ oldextrasize:=pp^.extra_info_size;
+ oldexactsize:=pp^.exact_info_size;
+ if pp^.extra_info_size>0 then
+ begin
+ old_fill_extra_info_proc:=pp^.extra_info^.fillproc;
+ old_display_extra_info_proc:=pp^.extra_info^.displayproc;
+ end;
+ { Do the real ReAllocMem, but alloc also for the info block }
+ allocsize:=size+sizeof(theap_mem_info)+pp^.extra_info_size;
+ if add_tail then
+ inc(allocsize,sizeof(ptrint));
+ { Try to resize the block, if not possible we need to do a
+ getmem, move data, freemem }
+ if not SysTryResizeMem(pp,allocsize) then
+ begin
+ { get a new block }
+ newP := TraceGetMem(size);
+ { move the data }
+ if newP <> nil then
+ begin
+ movesize:=TraceMemSize(p);
+ {if the old size is larger than the new size,
+ move only the new size}
+ if movesize>size then
+ movesize:=size;
+ move(p^,newP^,movesize);
+ end;
+ { release p }
+ traceFreeMem(p);
+ { return the new pointer }
+ p:=newp;
+ traceReAllocMem := newp;
+ exit;
+ end;
+{ Recreate the info block }
+ pp^.sig:=$DEADBEEF;
+ pp^.size:=size;
+ pp^.extra_info_size:=oldextrasize;
+ pp^.exact_info_size:=oldexactsize;
+ { add the new extra_info and tail }
+ if pp^.extra_info_size>0 then
+ begin
+ pp^.extra_info:=pointer(pp)+allocsize-pp^.extra_info_size;
+ fillchar(pp^.extra_info^,extra_info_size,0);
+ pp^.extra_info^.check:=$12345678;
+ pp^.extra_info^.fillproc:=old_fill_extra_info_proc;
+ pp^.extra_info^.displayproc:=old_display_extra_info_proc;
+ if assigned(pp^.extra_info^.fillproc) then
+ pp^.extra_info^.fillproc(@pp^.extra_info^.data);
+ end
+ else
+ pp^.extra_info:=nil;
+ if add_tail then
+ begin
+ pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptrint);
+ pl^:=$DEADBEEF;
+ end;
+ { adjust like a freemem and then a getmem, so you get correct
+ results in the summary display }
+ inc(freemem_size,oldsize);
+ inc(freemem8_size,((oldsize+7) div 8)*8);
+ inc(getmem_size,size);
+ inc(getmem8_size,((size+7) div 8)*8);
+ { generate new backtrace }
+ bp:=get_caller_frame(get_frame);
+ for i:=1 to tracesize do
+ begin
+ pp^.calls[i]:=get_caller_addr(bp);
+ bp:=get_caller_frame(bp);
+ end;
+ { regenerate signature }
+ if usecrc then
+ pp^.sig:=calculate_sig(pp);
+ { return the pointer }
+ p:=pointer(pp)+sizeof(theap_mem_info);
+ TraceReAllocmem:=p;
+end;
+
+
+
+{*****************************************************************************
+ Check pointer
+*****************************************************************************}
+
+{$ifndef Unix}
+ {$S-}
+{$endif}
+
+{$ifdef go32v2}
+var
+ __stklen : longword;external name '__stklen';
+ __stkbottom : longword;external name '__stkbottom';
+ edata : longword; external name 'edata';
+{$endif go32v2}
+
+{$ifdef linux}
+var
+ etext: ptruint; external name '_etext';
+ edata : ptruint; external name '_edata';
+ eend : ptruint; external name '_end';
+{$endif}
+
+{$ifdef win32}
+var
+ sdata : ptruint; external name '__data_start__';
+ edata : ptruint; external name '__data_end__';
+ sbss : ptruint; external name '__bss_start__';
+ ebss : ptruint; external name '__bss_end__';
+{$endif}
+
+
+procedure CheckPointer(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public, alias : 'FPC_CHECKPOINTER'];
+var
+ i : ptrint;
+ pp : pheap_mem_info;
+{$ifdef go32v2}
+ get_ebp,stack_top : longword;
+ data_end : longword;
+{$endif go32v2}
+label
+ _exit;
+begin
+ if p=nil then
+ runerror(204);
+
+ i:=0;
+
+{$ifdef go32v2}
+ if ptruint(p)<$1000 then
+ runerror(216);
+ asm
+ movl %ebp,get_ebp
+ leal edata,%eax
+ movl %eax,data_end
+ end;
+ stack_top:=__stkbottom+__stklen;
+ { allow all between start of code and end of data }
+ if ptruint(p)<=data_end then
+ goto _exit;
+ { stack can be above heap !! }
+
+ if (ptruint(p)>=get_ebp) and (ptruint(p)<=stack_top) then
+ goto _exit;
+{$endif go32v2}
+
+ { I don't know where the stack is in other OS !! }
+{$ifdef win32}
+ { inside stack ? }
+ if (ptruint(p)>ptruint(get_frame)) and
+ (ptruint(p)<Win32StackTop) then
+ goto _exit;
+ { inside data ? }
+ if (ptruint(p)>=ptruint(@sdata)) and (ptruint(p)<ptruint(@edata)) then
+ goto _exit;
+
+ { inside bss ? }
+ if (ptruint(p)>=ptruint(@sbss)) and (ptruint(p)<ptruint(@ebss)) then
+ goto _exit;
+{$endif win32}
+
+{$ifdef linux}
+ { inside stack ? }
+ if (ptruint(p)>ptruint(get_frame)) and
+ (ptruint(p)<$c0000000) then //todo: 64bit!
+ goto _exit;
+ { inside data or bss ? }
+ if (ptruint(p)>=ptruint(@etext)) and (ptruint(p)<ptruint(@eend)) then
+ goto _exit;
+{$endif linux}
+
+ { first try valid list faster }
+
+{$ifdef EXTRA}
+ pp:=heap_valid_last;
+ while pp<>nil do
+ begin
+ { inside this valid block ! }
+ { we can be changing the extrainfo !! }
+ if (ptruint(p)>=ptruint(pp)+sizeof(theap_mem_info){+extra_info_size}) and
+ (ptruint(p)<=ptruint(pp)+sizeof(theap_mem_info)+extra_info_size+pp^.size) then
+ begin
+ { check allocated block }
+ if ((pp^.sig=$DEADBEEF) and not usecrc) or
+ ((pp^.sig=calculate_sig(pp)) and usecrc) or
+ { special case of the fill_extra_info call }
+ ((pp=heap_valid_last) and usecrc and (pp^.sig=$DEADBEEF)
+ and inside_trace_getmem) then
+ goto _exit
+ else
+ begin
+ writeln(ptext^,'corrupted heap_mem_info');
+ dump_error(pp,ptext^);
+ halt(1);
+ end;
+ end
+ else
+ pp:=pp^.prev_valid;
+ inc(i);
+ if i>getmem_cnt-freemem_cnt then
+ begin
+ writeln(ptext^,'error in linked list of heap_mem_info');
+ halt(1);
+ end;
+ end;
+ i:=0;
+{$endif EXTRA}
+ pp:=heap_mem_root;
+ while pp<>nil do
+ begin
+ { inside this block ! }
+ if (ptruint(p)>=ptruint(pp)+sizeof(theap_mem_info)+ptruint(extra_info_size)) and
+ (ptruint(p)<=ptruint(pp)+sizeof(theap_mem_info)+ptruint(extra_info_size)+ptruint(pp^.size)) then
+ { allocated block }
+ if ((pp^.sig=$DEADBEEF) and not usecrc) or
+ ((pp^.sig=calculate_sig(pp)) and usecrc) then
+ goto _exit
+ else
+ begin
+ writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' points into invalid memory block');
+ dump_error(pp,ptext^);
+ runerror(204);
+ end;
+ pp:=pp^.previous;
+ inc(i);
+ if i>getmem_cnt then
+ begin
+ writeln(ptext^,'error in linked list of heap_mem_info');
+ halt(1);
+ end;
+ end;
+ writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' does not point to valid memory block');
+ runerror(204);
+_exit:
+end;
+
+{*****************************************************************************
+ Dump Heap
+*****************************************************************************}
+
+procedure dumpheap;
+var
+ pp : pheap_mem_info;
+ i : ptrint;
+ ExpectedHeapFree : ptrint;
+{$ifdef HASGETFPCHEAPSTATUS}
+ status : TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ status : THeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
+begin
+ pp:=heap_mem_root;
+ Writeln(ptext^,'Heap dump by heaptrc unit');
+ Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size);
+ Writeln(ptext^,freemem_cnt,' memory blocks freed : ',freemem_size,'/',freemem8_size);
+ Writeln(ptext^,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size);
+{$ifdef HASGETFPCHEAPSTATUS}
+ status:=SysGetFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ SysGetHeapStatus(status);
+{$endif HASGETFPCHEAPSTATUS}
+ Write(ptext^,'True heap size : ',status.CurrHeapSize);
+ if EntryMemUsed > 0 then
+ Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
+ else
+ Writeln(ptext^);
+ Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
+ ExpectedHeapFree:=status.CurrHeapSize-(getmem8_size-freemem8_size)-
+ (getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed;
+ If ExpectedHeapFree<>status.CurrHeapFree then
+ Writeln(ptext^,'Should be : ',ExpectedHeapFree);
+ i:=getmem_cnt-freemem_cnt;
+ while pp<>nil do
+ begin
+ if i<0 then
+ begin
+ Writeln(ptext^,'Error in heap memory list');
+ Writeln(ptext^,'More memory blocks than expected');
+ exit;
+ end;
+ if ((pp^.sig=$DEADBEEF) and not usecrc) or
+ ((pp^.sig=calculate_sig(pp)) and usecrc) then
+ begin
+ { this one was not released !! }
+ if exitcode<>203 then
+ call_stack(pp,ptext^);
+ dec(i);
+ end
+ else if pp^.sig<>$AAAAAAAA then
+ begin
+ dump_error(pp,ptext^);
+{$ifdef EXTRA}
+ dump_error(pp,error_file);
+{$endif EXTRA}
+ error_in_heap:=true;
+ end
+{$ifdef EXTRA}
+ else if pp^.release_sig<>calculate_release_sig(pp) then
+ begin
+ dump_change_after(pp,ptext^);
+ dump_change_after(pp,error_file);
+ error_in_heap:=true;
+ end
+{$endif EXTRA}
+ ;
+ pp:=pp^.previous;
+ end;
+end;
+
+
+procedure markheap;
+var
+ pp : pheap_mem_info;
+begin
+ pp:=heap_mem_root;
+ while pp<>nil do
+ begin
+ pp^.sig:=$AAAAAAAA;
+ pp:=pp^.previous;
+ end;
+end;
+
+
+{*****************************************************************************
+ AllocMem
+*****************************************************************************}
+
+function TraceAllocMem(size:ptrint):Pointer;
+begin
+ TraceAllocMem:=SysAllocMem(size);
+end;
+
+
+{*****************************************************************************
+ No specific tracing calls
+*****************************************************************************}
+
+{$ifdef HASGETFPCHEAPSTATUS}
+function TraceGetHeapStatus:THeapStatus;
+begin
+ TraceGetHeapStatus:=SysGetHeapStatus;
+end;
+
+function TraceGetFPCHeapStatus:TFPCHeapStatus;
+begin
+ TraceGetFPCHeapStatus:=SysGetFPCHeapStatus;
+end;
+{$else HASGETFPCHEAPSTATUS}
+procedure TraceGetHeapStatus(var status:THeapStatus);
+begin
+ SysGetHeapStatus(status);
+end;
+{$endif HASGETFPCHEAPSTATUS}
+
+
+{*****************************************************************************
+ Program Hooks
+*****************************************************************************}
+
+Procedure SetHeapTraceOutput(const name : string);
+var i : ptrint;
+begin
+ if ptext<>@stderr then
+ begin
+ ptext:=@stderr;
+ close(ownfile);
+ end;
+ assign(ownfile,name);
+{$I-}
+ append(ownfile);
+ if IOResult<>0 then
+ Rewrite(ownfile);
+{$I+}
+ ptext:=@ownfile;
+ for i:=0 to Paramcount do
+ write(ptext^,paramstr(i),' ');
+ writeln(ptext^);
+end;
+
+procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
+begin
+ { the total size must stay multiple of 8, also allocate 2 pointers for
+ the fill and display procvars }
+ exact_info_size:=size + sizeof(theap_extra_info);
+ extra_info_size:=((exact_info_size+7) div 8)*8;
+ fill_extra_info_proc:=fillproc;
+ display_extra_info_proc:=displayproc;
+end;
+
+
+{*****************************************************************************
+ Install MemoryManager
+*****************************************************************************}
+
+const
+ TraceManager:TMemoryManager=(
+ NeedLock : true;
+ Getmem : @TraceGetMem;
+ Freemem : @TraceFreeMem;
+ FreememSize : @TraceFreeMemSize;
+ AllocMem : @TraceAllocMem;
+ ReAllocMem : @TraceReAllocMem;
+ MemSize : @TraceMemSize;
+{$ifdef HASGETFPCHEAPSTATUS}
+ GetHeapStatus : @TraceGetHeapStatus;
+ GetFPCHeapStatus : @TraceGetFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ GetHeapStatus : @TraceGetHeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
+ );
+
+
+procedure TraceInit;
+var
+{$ifdef HASGETFPCHEAPSTATUS}
+ initheapstatus : TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ initheapstatus : THeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
+begin
+{$ifdef HASGETFPCHEAPSTATUS}
+ initheapstatus:=SysGetFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+ SysGetHeapStatus(initheapstatus);
+{$endif HASGETFPCHEAPSTATUS}
+ EntryMemUsed:=initheapstatus.CurrHeapUsed;
+ MakeCRC32Tbl;
+ SetMemoryManager(TraceManager);
+ ptext:=@stderr;
+ if outputstr <> '' then
+ SetHeapTraceOutput(outputstr);
+{$ifdef EXTRA}
+ Assign(error_file,'heap.err');
+ Rewrite(error_file);
+{$endif EXTRA}
+end;
+
+
+procedure TraceExit;
+begin
+ { no dump if error
+ because this gives long long listings }
+ { clear inoutres, in case the program that quit didn't }
+ ioresult;
+ if (exitcode<>0) and (erroraddr<>nil) then
+ begin
+ Writeln(ptext^,'No heap dump by heaptrc unit');
+ Writeln(ptext^,'Exitcode = ',exitcode);
+ if ptext<>@stderr then
+ begin
+ ptext:=@stderr;
+ close(ownfile);
+ end;
+ exit;
+ end;
+ if not error_in_heap then
+ Dumpheap;
+ if error_in_heap and (exitcode=0) then
+ exitcode:=203;
+{$ifdef EXTRA}
+ Close(error_file);
+{$endif EXTRA}
+ if ptext<>@stderr then
+ begin
+ ptext:=@stderr;
+ close(ownfile);
+ end;
+end;
+
+{$ifdef win32}
+ function GetEnvironmentStrings : pchar; stdcall;
+ external 'kernel32' name 'GetEnvironmentStringsA';
+ function FreeEnvironmentStrings(p : pchar) : longbool; stdcall;
+ external 'kernel32' name 'FreeEnvironmentStringsA';
+Function GetEnv(envvar: string): string;
+var
+ s : string;
+ i : ptrint;
+ hp,p : pchar;
+begin
+ getenv:='';
+ p:=GetEnvironmentStrings;
+ hp:=p;
+ while hp^<>#0 do
+ begin
+ s:=strpas(hp);
+ i:=pos('=',s);
+ if upcase(copy(s,1,i-1))=upcase(envvar) then
+ begin
+ getenv:=copy(s,i+1,length(s)-i);
+ break;
+ end;
+ { next string entry}
+ hp:=hp+strlen(hp)+1;
+ end;
+ FreeEnvironmentStrings(p);
+end;
+{$else}
+Function GetEnv(P:string):Pchar;
+{
+ Searches the environment for a string with name p and
+ returns a pchar to it's value.
+ A pchar is used to accomodate for strings of length > 255
+}
+var
+ ep : ppchar;
+ i : ptrint;
+ found : boolean;
+Begin
+ p:=p+'='; {Else HOST will also find HOSTNAME, etc}
+ ep:=envp;
+ found:=false;
+ if ep<>nil then
+ begin
+ while (not found) and (ep^<>nil) do
+ begin
+ found:=true;
+ for i:=1 to length(p) do
+ if p[i]<>ep^[i-1] then
+ begin
+ found:=false;
+ break;
+ end;
+ if not found then
+ inc(ep);
+ end;
+ end;
+ if found then
+ getenv:=ep^+length(p)
+ else
+ getenv:=nil;
+end;
+{$endif}
+
+procedure LoadEnvironment;
+var
+ i,j : ptrint;
+ s : string;
+begin
+ s:=Getenv('HEAPTRC');
+ if pos('keepreleased',s)>0 then
+ keepreleased:=true;
+ if pos('disabled',s)>0 then
+ useheaptrace:=false;
+ if pos('nohalt',s)>0 then
+ haltonerror:=false;
+ i:=pos('log=',s);
+ if i>0 then
+ begin
+ outputstr:=copy(s,i+4,255);
+ j:=pos(' ',outputstr);
+ if j=0 then
+ j:=length(outputstr)+1;
+ delete(outputstr,j,255);
+ end;
+end;
+
+
+Initialization
+ LoadEnvironment;
+ { heaptrc can be disabled from the environment }
+ if useheaptrace then
+ TraceInit;
+finalization
+ if useheaptrace then
+ TraceExit;
+end.
+{
+ $Log: heaptrc.pp,v $
+ Revision 1.44 2005/04/04 15:16:26 peter
+ * fixed crash in tracereallocmem statictics
+
+ Revision 1.43 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.42 2005/03/10 20:36:31 florian
+ * fixed pointer checking for win32, thx to Martin Schreiber for the patch
+
+ Revision 1.41 2005/03/04 16:49:34 peter
+ * fix getheapstatus bootstrapping
+
+ Revision 1.40 2005/02/28 15:38:38 marco
+ * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
+
+ Revision 1.39 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.38 2005/01/21 15:56:32 peter
+ * uses _eend instead of _edata in checkpointer, patch by
+ Martin Schreiber
+
+}
diff --git a/rtl/inc/innr.inc b/rtl/inc/innr.inc
new file mode 100644
index 0000000000..eb2ec92c73
--- /dev/null
+++ b/rtl/inc/innr.inc
@@ -0,0 +1,146 @@
+{
+ $Id: innr.inc,v 1.10 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library and compiler.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Internal Function/Constant Evaluator numbers
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+{ Internal functions }
+ fpc_in_lo_word = 1;
+ fpc_in_hi_word = 2;
+ fpc_in_lo_long = 3;
+ fpc_in_hi_long = 4;
+ fpc_in_ord_x = 5;
+ fpc_in_length_string = 6;
+ fpc_in_chr_byte = 7;
+ fpc_in_write_x = 14;
+ fpc_in_writeln_x = 15;
+ fpc_in_read_x = 16;
+ fpc_in_readln_x = 17;
+ fpc_in_concat_x = 18;
+ fpc_in_assigned_x = 19;
+ fpc_in_str_x_string = 20;
+ fpc_in_ofs_x = 21;
+ fpc_in_sizeof_x = 22;
+ fpc_in_typeof_x = 23;
+ fpc_in_val_x = 24;
+ fpc_in_reset_x = 25;
+ fpc_in_rewrite_x = 26;
+ fpc_in_low_x = 27;
+ fpc_in_high_x = 28;
+ fpc_in_seg_x = 29;
+ fpc_in_pred_x = 30;
+ fpc_in_succ_x = 31;
+ fpc_in_reset_typedfile = 32;
+ fpc_in_rewrite_typedfile = 33;
+ fpc_in_settextbuf_file_x = 34;
+ fpc_in_inc_x = 35;
+ fpc_in_dec_x = 36;
+ fpc_in_include_x_y = 37;
+ fpc_in_exclude_x_y = 38;
+ fpc_in_break = 39;
+ fpc_in_continue = 40;
+ fpc_in_assert_x_y = 41;
+ fpc_in_addr_x = 42;
+ fpc_in_typeinfo_x = 43;
+ fpc_in_setlength_x = 44;
+ fpc_in_finalize_x = 45;
+ fpc_in_new_x = 46;
+ fpc_in_dispose_x = 47;
+ fpc_in_exit = 48;
+ fpc_in_copy_x = 49;
+ fpc_in_initialize_x = 50;
+ fpc_in_leave = 51; {macpas}
+ fpc_in_cycle = 52; {macpas}
+
+{$ifdef INTERNCONSTINTF}
+{ Internal constant functions }
+ fpc_in_const_sqr = 100;
+ fpc_in_const_abs = 101;
+ fpc_in_const_odd = 102;
+ fpc_in_const_ptr = 103;
+ fpc_in_const_swap_word = 104;
+ fpc_in_const_swap_long = 105;
+ fpc_in_lo_qword = 106;
+ fpc_in_hi_qword = 107;
+ fpc_in_const_swap_qword = 108;
+ fpc_in_prefetch_var = 109;
+
+{ FPU functions }
+ fpc_in_trunc_real = 120;
+ fpc_in_round_real = 121;
+ fpc_in_frac_real = 122;
+ fpc_in_int_real = 123;
+ fpc_in_exp_real = 124;
+ fpc_in_cos_real = 125;
+ fpc_in_pi_real = 126;
+ fpc_in_abs_real = 127;
+ fpc_in_sqr_real = 128;
+ fpc_in_sqrt_real = 129;
+ fpc_in_arctan_real = 130;
+ fpc_in_ln_real = 131;
+ fpc_in_sin_real = 132;
+{$else}
+{ Internal constant functions }
+ fpc_in_const_trunc = 100;
+ fpc_in_const_round = 101;
+ fpc_in_const_frac = 102;
+ fpc_in_const_abs = 103;
+ fpc_in_const_int = 104;
+ fpc_in_const_sqr = 105;
+ fpc_in_const_odd = 106;
+ fpc_in_const_ptr = 107;
+ fpc_in_const_swap_word = 108;
+ fpc_in_const_swap_long = 109;
+ fpc_in_const_pi = 110;
+ fpc_in_const_sqrt = 111;
+ fpc_in_const_arctan = 112;
+ fpc_in_const_cos = 113;
+ fpc_in_const_exp = 114;
+ fpc_in_const_ln = 115;
+ fpc_in_const_sin = 116;
+ fpc_in_lo_qword = 117;
+ fpc_in_hi_qword = 118;
+ fpc_in_cos_real = 119;
+ fpc_in_pi = 121;
+ fpc_in_abs_real = 122;
+ fpc_in_sqr_real = 123;
+ fpc_in_sqrt_real = 124;
+ fpc_in_arctan_real = 125;
+ fpc_in_ln_real = 126;
+ fpc_in_sin_real = 127;
+ fpc_in_const_swap_qword = 128;
+ fpc_in_prefetch_var = 129;
+{$endif}
+
+{ MMX functions }
+{ these contants are used by the mmx unit }
+
+ { MMX }
+ fpc_in_mmx_pcmpeqb = 200;
+ fpc_in_mmx_pcmpeqw = 201;
+ fpc_in_mmx_pcmpeqd = 202;
+ fpc_in_mmx_pcmpgtb = 203;
+ fpc_in_mmx_pcmpgtw = 204;
+ fpc_in_mmx_pcmpgtd = 205;
+
+ { 3DNow }
+
+ { SSE }
+
+{
+ $Log: innr.inc,v $
+ Revision 1.10 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/int64.inc b/rtl/inc/int64.inc
new file mode 100644
index 0000000000..274c7b44be
--- /dev/null
+++ b/rtl/inc/int64.inc
@@ -0,0 +1,372 @@
+{
+ $Id: int64.inc,v 1.29 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains some helper routines for int64 and qword
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$Q- no overflow checking }
+{$R- no range checking }
+
+ type
+{$ifdef ENDIAN_LITTLE}
+ tqwordrec = packed record
+ low : dword;
+ high : dword;
+ end;
+{$endif ENDIAN_LITTLE}
+{$ifdef ENDIAN_BIG}
+ tqwordrec = packed record
+ high : dword;
+ low : dword;
+ end;
+{$endif ENDIAN_BIG}
+
+
+{$ifdef FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+
+{$ifndef FPC_SYSTEM_HAS_SHL_QWORD}
+ function fpc_shl_qword(value,shift : qword) : qword; [public,alias: 'FPC_SHL_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ shift:=shift and 63;
+ if shift=0 then
+ result:=value
+ else if shift>31 then
+ begin
+ tqwordrec(result).low:=0;
+ tqwordrec(result).high:=tqwordrec(value).low shl (shift-32);
+ end
+ else
+ begin
+ tqwordrec(result).low:=tqwordrec(value).low shl shift;
+ tqwordrec(result).high:=(tqwordrec(value).high shl shift) or (tqwordrec(value).low shr (32-shift));
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_SHL_QWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_SHR_QWORD}
+ function fpc_shr_qword(value,shift : qword) : qword; [public,alias: 'FPC_SHR_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ shift:=shift and 63;
+ if shift=0 then
+ result:=value
+ else if shift>31 then
+ begin
+ tqwordrec(result).high:=0;
+ tqwordrec(result).low:=tqwordrec(value).high shr (shift-32);
+ end
+ else
+ begin
+ tqwordrec(result).high:=tqwordrec(value).high shr shift;
+ tqwordrec(result).low:=(tqwordrec(value).low shr shift) or (tqwordrec(value).high shl (32-shift));
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_SHR_QWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_SHL_INT64}
+ function fpc_shl_int64(value,shift : int64) : int64; [public,alias: 'FPC_SHL_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ shift:=shift and 63;
+ if shift=0 then
+ result:=value
+ else if shift>31 then
+ begin
+ tqwordrec(result).low:=0;
+ tqwordrec(result).high:=tqwordrec(value).low shl (shift-32);
+ end
+ else
+ begin
+ tqwordrec(result).low:=tqwordrec(value).low shl shift;
+ tqwordrec(result).high:=(tqwordrec(value).high shl shift) or (tqwordrec(value).low shr (32-shift));
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_SHL_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_SHR_INT64}
+ function fpc_shr_int64(value,shift : int64) : int64; [public,alias: 'FPC_SHR_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ shift:=shift and 63;
+ if shift=0 then
+ result:=value
+ else if shift>31 then
+ begin
+ tqwordrec(result).high:=0;
+ tqwordrec(result).low:=tqwordrec(value).high shr (shift-32);
+ end
+ else
+ begin
+ tqwordrec(result).high:=tqwordrec(value).high shr shift;
+ tqwordrec(result).low:=(tqwordrec(value).low shr shift) or (tqwordrec(value).high shl (32-shift));
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_SHR_INT64}
+
+
+{$endif FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+
+
+ function count_leading_zeros(q : qword) : longint;
+
+ var
+ r,i : longint;
+
+ begin
+ r:=0;
+ for i:=0 to 31 do
+ begin
+ if (tqwordrec(q).high and (dword($80000000) shr i))<>0 then
+ begin
+ count_leading_zeros:=r;
+ exit;
+ end;
+ inc(r);
+ end;
+ for i:=0 to 31 do
+ begin
+ if (tqwordrec(q).low and (dword($80000000) shr i))<>0 then
+ begin
+ count_leading_zeros:=r;
+ exit;
+ end;
+ inc(r);
+ end;
+ count_leading_zeros:=r;
+ end;
+
+
+{$ifndef FPC_SYSTEM_HAS_DIV_QWORD}
+ function fpc_div_qword(n,z : qword) : qword;[public,alias: 'FPC_DIV_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ shift,lzz,lzn : longint;
+
+ begin
+ fpc_div_qword:=0;
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ lzz:=count_leading_zeros(z);
+ lzn:=count_leading_zeros(n);
+ { if the denominator contains less zeros }
+ { then the numerator }
+ { the d is greater than the n }
+ if lzn<lzz then
+ exit;
+ shift:=lzn-lzz;
+ n:=n shl shift;
+ repeat
+ if z>=n then
+ begin
+ z:=z-n;
+ fpc_div_qword:=fpc_div_qword+(qword(1) shl shift);
+ end;
+ dec(shift);
+ n:=n shr 1;
+ until shift<0;
+ end;
+{$endif FPC_SYSTEM_HAS_DIV_QWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_MOD_QWORD}
+ function fpc_mod_qword(n,z : qword) : qword;[public,alias: 'FPC_MOD_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ shift,lzz,lzn : longint;
+
+ begin
+ fpc_mod_qword:=0;
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ lzz:=count_leading_zeros(z);
+ lzn:=count_leading_zeros(n);
+ { if the denominator contains less zeros }
+ { then the numerator }
+ { the d is greater than the n }
+ if lzn<lzz then
+ begin
+ fpc_mod_qword:=z;
+ exit;
+ end;
+ shift:=lzn-lzz;
+ n:=n shl shift;
+ repeat
+ if z>=n then
+ z:=z-n;
+ dec(shift);
+ n:=n shr 1;
+ until shift<0;
+ fpc_mod_qword:=z;
+ end;
+{$endif FPC_SYSTEM_HAS_MOD_QWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_DIV_INT64}
+ function fpc_div_int64(n,z : int64) : int64;[public,alias: 'FPC_DIV_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ sign : boolean;
+ q1,q2 : qword;
+
+ begin
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ { can the fpu do the work? }
+ begin
+ sign:=false;
+ if z<0 then
+ begin
+ sign:=not(sign);
+ q1:=qword(-z);
+ end
+ else
+ q1:=z;
+ if n<0 then
+ begin
+ sign:=not(sign);
+ q2:=qword(-n);
+ end
+ else
+ q2:=n;
+
+ { the div is coded by the compiler as call to divqword }
+ if sign then
+ fpc_div_int64:=-(q1 div q2)
+ else
+ fpc_div_int64:=q1 div q2;
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_DIV_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_MOD_INT64}
+ function fpc_mod_int64(n,z : int64) : int64;[public,alias: 'FPC_MOD_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ signed : boolean;
+ r,nq,zq : qword;
+
+ begin
+ if n=0 then
+ HandleErrorFrame(200,get_frame);
+ if n<0 then
+ nq:=-n
+ else
+ nq:=n;
+ if z<0 then
+ begin
+ signed:=true;
+ zq:=qword(-z)
+ end
+ else
+ begin
+ signed:=false;
+ zq:=z;
+ end;
+ r:=zq mod nq;
+ if signed then
+ fpc_mod_int64:=-int64(r)
+ else
+ fpc_mod_int64:=r;
+ end;
+{$endif FPC_SYSTEM_HAS_MOD_INT64}
+
+
+{$ifndef FPC_SYSTEM_HAS_MUL_QWORD}
+ { multiplies two qwords
+ the longbool for checkoverflow avoids a misaligned stack
+ }
+ function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword;[public,alias: 'FPC_MUL_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ _f1,bitpos : qword;
+ l : longint;
+ f1overflowed : boolean;
+ begin
+ fpc_mul_qword:=0;
+ bitpos:=1;
+ f1overflowed:=false;
+
+ for l:=0 to 63 do
+ begin
+ if (f2 and bitpos)<>0 then
+ begin
+ _f1:=fpc_mul_qword;
+ fpc_mul_qword:=fpc_mul_qword+f1;
+
+ { if one of the operands is greater than the result an
+ overflow occurs }
+ if checkoverflow and (f1overflowed or ((_f1<>0) and (f1<>0) and
+ ((_f1>fpc_mul_qword) or (f1>fpc_mul_qword)))) then
+ HandleErrorFrame(215,get_frame);
+ end;
+{$ifndef VER1_0}
+ { when bootstrapping, we forget about overflow checking for qword :) }
+ f1overflowed:=f1overflowed or ((f1 and (1 shl 63))<>0);
+{$endif VER1_0}
+ f1:=f1 shl 1;
+ bitpos:=bitpos shl 1;
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_MUL_QWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_MUL_INT64}
+ function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64;[public,alias: 'FPC_MUL_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ sign : boolean;
+ q1,q2,q3 : qword;
+
+ begin
+ begin
+ sign:=false;
+ if f1<0 then
+ begin
+ sign:=not(sign);
+ q1:=qword(-f1);
+ end
+ else
+ q1:=f1;
+ if f2<0 then
+ begin
+ sign:=not(sign);
+ q2:=qword(-f2);
+ end
+ else
+ q2:=f2;
+ { the q1*q2 is coded as call to mulqword }
+ q3:=q1*q2;
+
+ if checkoverflow and (q1 <> 0) and (q2 <>0) and
+ ((q1>q3) or (q2>q3) or
+ { the bit 63 can be only set if we have $80000000 00000000 }
+ { and sign is true }
+ ((tqwordrec(q3).high and dword($80000000))<>0) and
+ ((q3<>(qword(1) shl 63)) or not(sign))
+ ) then
+ HandleErrorFrame(215,get_frame);
+
+ if sign then
+ fpc_mul_int64:=-q3
+ else
+ fpc_mul_int64:=q3;
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_MUL_INT64}
+
+{
+ $Log: int64.inc,v $
+ Revision 1.29 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/keyboard.inc b/rtl/inc/keyboard.inc
new file mode 100644
index 0000000000..bef1a1b5f1
--- /dev/null
+++ b/rtl/inc/keyboard.inc
@@ -0,0 +1,302 @@
+{
+ $Id: keyboard.inc,v 1.9 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+var
+ PendingKeyEvent : TKeyEvent;
+
+procedure PutKeyEvent(KeyEvent: TKeyEvent);
+begin
+ PendingKeyEvent := KeyEvent;
+end;
+
+function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
+begin
+ GetKeyEventFlags := (KeyEvent and $FF000000) shr 24;
+end;
+
+function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
+begin
+ if KeyEvent and $03000000 = $00000000 then
+ GetKeyEventChar := Chr(KeyEvent and $000000FF)
+ else
+ GetKeyEventChar := #0;
+end;
+
+function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
+begin
+ if KeyEvent and $03000000 = $01000000 then
+ GetKeyEventUniCode := KeyEvent and $0000FFFF
+ else
+ GetKeyEventUniCode := 0;
+end;
+
+function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
+begin
+ GetKeyEventCode := KeyEvent and $0000FFFF
+end;
+
+function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
+begin
+ GetKeyEventShiftState := (KeyEvent and $00FF0000) shr 16;
+end;
+
+function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
+begin
+ IsFunctionKey := KeyEvent and $03000000 = $02000000;
+end;
+
+Var
+ KeyBoardInitialized : Boolean;
+ CurrentKeyboardDriver : TKeyboardDriver;
+
+procedure InitKeyboard;
+
+begin
+ If Not KeyboardInitialized then
+ begin
+ If Assigned(CurrentKeyBoardDriver.InitDriver) Then
+ CurrentKeyBoardDriver.InitDriver();
+ KeyboardInitialized:=True;
+ end;
+end;
+
+procedure DoneKeyboard;
+
+begin
+ If KeyboardInitialized then
+ begin
+ If Assigned(CurrentKeyBoardDriver.DoneDriver) Then
+ CurrentKeyBoardDriver.DoneDriver();
+ KeyboardInitialized:=False;
+ end;
+end;
+
+
+function GetKeyEvent: TKeyEvent;
+
+begin
+ if PendingKeyEvent<>0 then
+ begin
+ GetKeyEvent:=PendingKeyEvent;
+ PendingKeyEvent:=0;
+ exit;
+ end;
+ If Assigned(CurrentKeyBoardDriver.GetKeyEvent) Then
+ GetKeyEvent:=CurrentKeyBoardDriver.GetKeyEvent()
+ else
+ GetKeyEvent:=0;
+end;
+
+function PollKeyEvent: TKeyEvent;
+
+begin
+ if PendingKeyEvent<>0 then
+ exit(PendingKeyEvent);
+ If Assigned(CurrentKeyBoardDriver.PollKeyEvent) Then
+ begin
+ PollKeyEvent:=CurrentKeyBoardDriver.PollKeyEvent();
+ // PollKeyEvent:=PendingKeyEvent;
+ // Must be done inside every keyboard specific
+ // PollKeyEvent procedure
+ // to avoid problems if that procedure is called directly PM
+ end
+ else
+ PollKeyEvent:=0;
+end;
+
+Function SetKeyboardDriver (Const Driver : TKeyboardDriver) : Boolean;
+
+begin
+ If Not KeyBoardInitialized then
+ CurrentKeyBoardDriver:=Driver;
+ SetKeyboardDriver:=Not KeyBoardInitialized;
+end;
+
+Procedure GetKeyboardDriver (Var Driver : TKeyboardDriver);
+
+begin
+ Driver:=CurrentKeyBoardDriver;
+end;
+
+function PollShiftStateEvent: TKeyEvent;
+
+begin
+ If Assigned(CurrentKeyBoardDriver.GetShiftState) then
+ PollShiftStateEvent:=CurrentKeyBoardDriver.GetShiftState() shl 16
+ else
+ PollShiftStateEvent:=0;
+end;
+
+function DefaultTranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
+
+begin
+ DefaultTranslateKeyEventUniCode:=KeyEvent;
+ ErrorCode:=errKbdNotImplemented;
+end;
+
+
+function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
+
+begin
+ if Assigned(CurrentKeyBoardDriver.TranslateKeyEventUnicode) then
+ TranslateKeyEventUnicode:=CurrentKeyBoardDriver.TranslateKeyEventUnicode(KeyEvent)
+ else
+ TranslateKeyEventUnicode:=DefaultTranslateKeyEventUnicode(KeyEvent);
+end;
+
+type
+ TTranslationEntry = packed record
+ Min, Max: Byte;
+ Offset: Word;
+ end;
+const
+ TranslationTableEntries = 12;
+ TranslationTable: array [1..TranslationTableEntries] of TTranslationEntry =
+ ((Min: $3B; Max: $44; Offset: kbdF1), { function keys F1-F10 }
+ (Min: $54; Max: $5D; Offset: kbdF1), { Shift fn keys F1-F10 }
+ (Min: $5E; Max: $67; Offset: kbdF1), { Ctrl fn keys F1-F10 }
+ (Min: $68; Max: $71; Offset: kbdF1), { Alt fn keys F1-F10 }
+ (Min: $85; Max: $86; Offset: kbdF11), { function keys F11-F12 }
+ (Min: $87; Max: $88; Offset: kbdF11), { Shift+function keys F11-F12 }
+ (Min: $89; Max: $8A; Offset: kbdF11), { Ctrl+function keys F11-F12 }
+ (Min: $8B; Max: $8C; Offset: kbdF11), { Alt+function keys F11-F12 }
+ (Min: $47; Max: $49; Offset: kbdHome), { Keypad keys kbdHome-kbdPgUp }
+ (Min: $4B; Max: $4D; Offset: kbdLeft), { Keypad keys kbdLeft-kbdRight }
+ (Min: $4F; Max: $51; Offset: kbdEnd), { Keypad keys kbdEnd-kbdPgDn }
+ (Min: $52; Max: $53; Offset: kbdInsert));
+
+
+function DefaultTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+
+var
+ I: Integer;
+ ScanCode: Byte;
+begin
+ if KeyEvent and $03000000 = $03000000 then
+ begin
+ if KeyEvent and $000000FF <> 0 then
+ begin
+ DefaultTranslateKeyEvent := KeyEvent and $00FFFFFF;
+ exit;
+ end
+ else
+ begin
+ { This is a function key }
+ ScanCode := (KeyEvent and $0000FF00) shr 8;
+ for I := 1 to TranslationTableEntries do
+ begin
+ if (TranslationTable[I].Min <= ScanCode) and (ScanCode <= TranslationTable[I].Max) then
+ begin
+ DefaultTranslateKeyEvent := $02000000 + (KeyEvent and $00FF0000) +
+ Byte(ScanCode - TranslationTable[I].Min) + TranslationTable[I].Offset;
+ exit;
+ end;
+ end;
+ end;
+ end;
+ DefaultTranslateKeyEvent := KeyEvent;
+end;
+
+function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+
+begin
+ if Assigned(CurrentKeyBoardDriver.TranslateKeyEvent) then
+ TranslateKeyEvent:=CurrentKeyBoardDriver.TranslateKeyEvent(KeyEvent)
+ else
+ TranslateKeyEvent:=DefaultTranslateKeyEvent(KeyEvent);
+end;
+
+{ ---------------------------------------------------------------------
+ KeyEvent to String representation section.
+ ---------------------------------------------------------------------}
+
+Procedure AddToString (Var S : String; Const A : String);
+
+begin
+ If Length(S)=0 then
+ S:=A
+ else
+ S:=S+' '+A;
+end;
+
+Function IntToStr(Int : Longint) : String;
+
+begin
+ Str(Int,IntToStr);
+end;
+
+Function ShiftStateToString(KeyEvent : TKeyEvent; UseLeftRight : Boolean) : String;
+
+Var
+ S : Integer;
+ T : String;
+
+begin
+ S:=GetKeyEventShiftState(KeyEvent);
+ T:='';
+ If (S and kbShift)<>0 then
+ begin
+ if UseLeftRight then
+ case (S and kbShift) of
+ kbShift : AddToString(T,SLeftRight[1]+' '+SAnd+' '+SLeftRight[2]);
+ kbLeftShift : AddToString(T,SLeftRight[1]);
+ kbRightShift : AddToString(T,SLeftRight[2]);
+ end;
+ AddToString(T,SShift[1]);
+ end;
+ If (S and kbCtrl)<>0 Then
+ AddToString(T,SShift[2]);
+ If (S and kbAlt)<>0 Then
+ AddToString(T,SShift[3]);
+ ShiftStateToString:=T;
+end;
+
+Function FunctionKeyName (KeyCode : Word) : String;
+
+begin
+ If ((KeyCode-KbdF1)<$1F) Then
+ FunctionKeyName:='F'+IntToStr((KeyCode-KbdF1+1))
+ else
+ begin
+ If (KeyCode-kbdHome)<($2F-$1F) then
+ FunctionKeyName:=SKeyPad[(KeyCode-kbdHome)]
+ else
+ FunctionKeyName:=SUnknownFunctionKey + IntToStr(KeyCode);
+ end;
+end;
+
+Function KeyEventToString(KeyEvent : TKeyEvent) : String;
+
+Var
+ T : String;
+
+begin
+ T:=ShiftStateToString(KeyEvent,False);
+ Case GetKeyEventFlags(KeyEvent) of
+ kbASCII : AddToString(T,GetKeyEventChar(KeyEvent));
+ kbUniCode : AddToString(T,SUniCodeChar+IntToStr(GetKeyEventUniCode(Keyevent)));
+ kbFnKey : AddToString(T,FunctionKeyName(GetKeyEventCode(KeyEvent)));
+ // Not good, we need a GetKeyEventScanCode function !!
+ kbPhys : AddToString(T,SScanCode+IntToStr(KeyEvent and $ffff));
+ end;
+ KeyEventToString:=T;
+end;
+
+{
+ $Log: keyboard.inc,v $
+ Revision 1.9 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
+
diff --git a/rtl/inc/keybrdh.inc b/rtl/inc/keybrdh.inc
new file mode 100644
index 0000000000..9dab0ca8b4
--- /dev/null
+++ b/rtl/inc/keybrdh.inc
@@ -0,0 +1,204 @@
+{
+ $Id: keybrdh.inc,v 1.7 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ { We have an errorcode base of 1010 }
+ errKbdBase = 1010;
+ errKbdInitError = errKbdBase + 0;
+ errKbdNotImplemented = errKbdBase + 1;
+
+type
+ TKeyEvent = Cardinal;
+ TKeyRecord = packed record
+ KeyCode : Word;
+ ShiftState, Flags : Byte;
+ end;
+
+{ The structure of a TKeyEvent follows in LSB-MSB order:
+ 2 bytes: depending on flags either the physical representation of a key
+ (under DOS scancode, ascii code pair), or the translated
+ ASCII/unicode character
+ 1 byte: shift-state when this key was pressed (or shortly after)
+ 1 byte: flags, the following flags are defined:
+ bit0-1
+ 0: the lowest two bytes is the translated ASCII value
+ 1: the lowest two bytes is the translated Unicode value
+ (wide-char)
+ 2: the lowest two bytes is a function key, and the lowest
+ two bytes contains its platform independent code
+ 3: the lowest two bytes is the physical representation
+ bit2
+ 0: the key is pressed
+ 1: the key is released (This event is not guaranteed to occur on all platforms)
+ bit3-7 undefined, should be 0
+
+
+ If there are two keys returning the same char-code, there's no way to find
+ out which one was pressed (Gray+ and Simple+). If you need to know which
+ was pressed, you'll need to use the untranslated keycodes, which is system
+ dependent. System dependent constants may be defined to cover those, with
+ possibily having the same name (but different value). }
+
+{ System independent function key codes }
+const
+ kbdF1 = $FF01;
+ kbdF2 = $FF02;
+ kbdF3 = $FF03;
+ kbdF4 = $FF04;
+ kbdF5 = $FF05;
+ kbdF6 = $FF06;
+ kbdF7 = $FF07;
+ kbdF8 = $FF08;
+ kbdF9 = $FF09;
+ kbdF10 = $FF0A;
+ kbdF11 = $FF0B;
+ kbdF12 = $FF0C;
+ kbdF13 = $FF0D;
+ kbdF14 = $FF0E;
+ kbdF15 = $FF0F;
+ kbdF16 = $FF10;
+ kbdF17 = $FF11;
+ kbdF18 = $FF12;
+ kbdF19 = $FF13;
+ kbdF20 = $FF14;
+
+ kbdLWin = $FF15;
+ kbdRWin = $FF16;
+ kbdApps = $FF17;
+
+ { $15 - $1F reserved for future Fxx keys }
+ kbdHome = $FF20;
+ kbdUp = $FF21;
+ kbdPgUp = $FF22;
+ kbdLeft = $FF23;
+ kbdMiddle = $FF24;
+ kbdRight = $FF25;
+ kbdEnd = $FF26;
+ kbdDown = $FF27;
+ kbdPgDn = $FF28;
+
+ kbdInsert = $FF29;
+ kbdDelete = $FF2A;
+ { $2B - $2F reserved for future keypad keys }
+
+ { possible flag values }
+ kbASCII = $00;
+ kbUniCode = $01;
+ kbFnKey = $02;
+ kbPhys = $03;
+
+ kbReleased = $04;
+
+ { shiftstate flags }
+ kbLeftShift = 1;
+ kbRightShift = 2;
+ kbShift = kbLeftShift or kbRightShift;
+ kbCtrl = 4;
+ kbAlt = 8;
+
+{ ---------------------------------------------------------------------
+ Key names. Can be localized if needed.
+ ---------------------------------------------------------------------}
+ SShift : Array [1..3] of string[5] = ('SHIFT','CTRL','ALT');
+ SLeftRight : Array [1..2] of string[5] = ('LEFT','RIGHT');
+ SUnicodeChar : String = 'Unicode character ';
+ SScanCode : String = 'Key with scancode ';
+ SUnknownFunctionKey : String = 'Unknown function key : ';
+ SAnd : String = 'AND';
+ SKeyPad : Array [0..($FF2F-kbdHome)] of string[6] =
+ ('Home','Up','PgUp','Left',
+ 'Middle','Right','End','Down',
+ 'PgDn','Insert','Delete','',
+ '','','','');
+
+Type
+ TKeyboardDriver = Record
+ InitDriver : Procedure;
+ DoneDriver : Procedure;
+ GetKeyEvent : Function : TKeyEvent;
+ PollKeyEvent : Function : TKeyEvent;
+ GetShiftState : Function : Byte;
+ TranslateKeyEvent : Function (KeyEvent: TKeyEvent): TKeyEvent;
+ TranslateKeyEventUniCode : Function (KeyEvent: TKeyEvent): TKeyEvent;
+ end;
+
+procedure InitKeyboard;
+{ Initializes the keyboard interface, additional platform specific parameters
+ can be passed by global variables (RawMode etc.) for the first implementation
+ under DOS it does nothing }
+
+procedure DoneKeyboard;
+{ Deinitializes the keyboard interface }
+
+function GetKeyEvent: TKeyEvent;
+{ Returns the last keyevent, and waits for one if not available }
+
+procedure PutKeyEvent(KeyEvent: TKeyEvent);
+{ Adds the given KeyEvent to the input queue. Please note that depending on
+ the implementation this can hold only one value (NO FIFOs etc) }
+
+function PollKeyEvent: TKeyEvent;
+{ Checks if a keyevent is available, and returns it if one is found. If no
+ event is pending, it returns 0 }
+
+function PollShiftStateEvent: TKeyEvent;
+{ Return the current shiftstate in a keyevent }
+
+function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+{ Performs ASCII translation of the KeyEvent }
+
+function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
+{ Performs Unicode translation of the KeyEvent }
+
+function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
+{ Returns the flags part of the given KeyEvent }
+
+function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
+{ Returns the charcode part of the given KeyEvent, if it contains a translated
+ keycode }
+
+function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
+{ Returns the unicode part of the given KeyEvent, if it contains a translated
+ unicode character }
+
+function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
+{ Returns the translated function keycode part of the given KeyEvent, if it
+ contains a translated function keycode }
+
+function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
+{ Returns the shift-state values of the given KeyEvent }
+
+function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
+{ Returns true if the given key was a function key or not }
+
+Function SetKeyboardDriver (Const Driver : TKeyboardDriver) : Boolean;
+{ Sets the keyboard driver to use }
+
+Procedure GetKeyboardDriver (Var Driver : TKeyboardDriver);
+{ Returns the currently active keyboard driver }
+
+Function ShiftStateToString(KeyEvent : TKeyEvent; UseLeftRight : Boolean) : String;
+{ Returns a string representation of a shift state as returned by
+ pollshiftstate }
+Function FunctionKeyName (KeyCode : Word) : String;
+{ Returns the name of a function key if the key is one of the special keys . }
+Function KeyEventToString(KeyEvent : TKeyEvent) : String;
+{ Returns a string representation of the pressed key }
+
+{
+ $Log: keybrdh.inc,v $
+ Revision 1.7 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/keyscan.inc b/rtl/inc/keyscan.inc
new file mode 100644
index 0000000000..856736d2bc
--- /dev/null
+++ b/rtl/inc/keyscan.inc
@@ -0,0 +1,144 @@
+{ list of all dos scancode for key giving 0 as char }
+Const
+ kbNoKey = $00;
+ kbAltEsc = $01;
+ kbAltSpace = $02;
+ kbCtrlIns = $04;
+ kbShiftIns = $05;
+ kbCtrlDel = $06;
+ kbShiftDel = $07;
+ kbAltBack = $08;
+ kbAltShiftBack= $09;
+ kbShiftTab = $0F;
+ kbAltQ = $10;
+ kbAltW = $11;
+ kbAltE = $12;
+ kbAltR = $13;
+ kbAltT = $14;
+ kbAltY = $15;
+ kbAltU = $16;
+ kbAltI = $17;
+ kbAltO = $18;
+ kbAltP = $19;
+ kbAltLftBrack = $1A;
+ kbAltRgtBrack = $1B;
+ kbAltA = $1E;
+ kbAltS = $1F;
+ kbAltD = $20;
+ kbAltF = $21;
+ kbAltG = $22;
+ kbAltH = $23;
+ kbAltJ = $24;
+ kbAltK = $25;
+ kbAltL = $26;
+ kbAltSemiCol = $27;
+ kbAltQuote = $28;
+ kbAltOpQuote = $29;
+ kbAltBkSlash = $2B;
+ kbAltZ = $2C;
+ kbAltX = $2D;
+ kbAltC = $2E;
+ kbAltV = $2F;
+ kbAltB = $30;
+ kbAltN = $31;
+ kbAltM = $32;
+ kbAltComma = $33;
+ kbAltPeriod = $34;
+ kbAltSlash = $35;
+ kbAltGreyAst = $37;
+ kbF1 = $3B;
+ kbF2 = $3C;
+ kbF3 = $3D;
+ kbF4 = $3E;
+ kbF5 = $3F;
+ kbF6 = $40;
+ kbF7 = $41;
+ kbF8 = $42;
+ kbF9 = $43;
+ kbF10 = $44;
+ kbHome = $47;
+ kbUp = $48;
+ kbPgUp = $49;
+ kbLeft = $4B;
+ kbCenter = $4C;
+ kbRight = $4D;
+ kbAltGrayPlus = $4E;
+ kbend = $4F;
+ kbDown = $50;
+ kbPgDn = $51;
+ kbIns = $52;
+ kbDel = $53;
+ kbShiftF1 = $54;
+ kbShiftF2 = $55;
+ kbShiftF3 = $56;
+ kbShiftF4 = $57;
+ kbShiftF5 = $58;
+ kbShiftF6 = $59;
+ kbShiftF7 = $5A;
+ kbShiftF8 = $5B;
+ kbShiftF9 = $5C;
+ kbShiftF10 = $5D;
+ kbCtrlF1 = $5E;
+ kbCtrlF2 = $5F;
+ kbCtrlF3 = $60;
+ kbCtrlF4 = $61;
+ kbCtrlF5 = $62;
+ kbCtrlF6 = $63;
+ kbCtrlF7 = $64;
+ kbCtrlF8 = $65;
+ kbCtrlF9 = $66;
+ kbCtrlF10 = $67;
+ kbAltF1 = $68;
+ kbAltF2 = $69;
+ kbAltF3 = $6A;
+ kbAltF4 = $6B;
+ kbAltF5 = $6C;
+ kbAltF6 = $6D;
+ kbAltF7 = $6E;
+ kbAltF8 = $6F;
+ kbAltF9 = $70;
+ kbAltF10 = $71;
+ kbCtrlPrtSc = $72;
+ kbCtrlLeft = $73;
+ kbCtrlRight = $74;
+ kbCtrlend = $75;
+ kbCtrlPgDn = $76;
+ kbCtrlHome = $77;
+ kbAlt1 = $78;
+ kbAlt2 = $79;
+ kbAlt3 = $7A;
+ kbAlt4 = $7B;
+ kbAlt5 = $7C;
+ kbAlt6 = $7D;
+ kbAlt7 = $7E;
+ kbAlt8 = $7F;
+ kbAlt9 = $80;
+ kbAlt0 = $81;
+ kbAltMinus = $82;
+ kbAltEqual = $83;
+ kbCtrlPgUp = $84;
+ kbF11 = $85;
+ kbF12 = $86;
+ kbShiftF11 = $87;
+ kbShiftF12 = $88;
+ kbCtrlF11 = $89;
+ kbCtrlF12 = $8A;
+ kbAltF11 = $8B;
+ kbAltF12 = $8C;
+ kbCtrlUp = $8D;
+ kbCtrlMinus = $8E;
+ kbCtrlCenter = $8F;
+ kbCtrlGreyPlus= $90;
+ kbCtrlDown = $91;
+ kbCtrlTab = $94;
+ kbAltHome = $97;
+ kbAltUp = $98;
+ kbAltPgUp = $99;
+ kbAltLeft = $9B;
+ kbAltRight = $9D;
+ kbAltend = $9F;
+ kbAltDown = $A0;
+ kbAltPgDn = $A1;
+ kbAltIns = $A2;
+ kbAltDel = $A3;
+ kbAltTab = $A5;
diff --git a/rtl/inc/lineinfo.pp b/rtl/inc/lineinfo.pp
new file mode 100644
index 0000000000..8457095ae8
--- /dev/null
+++ b/rtl/inc/lineinfo.pp
@@ -0,0 +1,1051 @@
+{
+ $Id: lineinfo.pp,v 1.25 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Peter Vreman
+
+ Stabs Line Info Retriever
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit lineinfo;
+interface
+
+{$IFDEF OS2}
+ {$DEFINE EMX} (* EMX is the only possibility under OS/2 at the moment *)
+{$ENDIF OS2}
+
+{$S-}
+
+procedure GetLineInfo(addr:ptruint;var func,source:string;var line:longint);
+
+
+implementation
+
+uses
+ strings;
+
+const
+ N_Function = $24;
+ N_TextLine = $44;
+ N_DataLine = $46;
+ N_BssLine = $48;
+ N_SourceFile = $64;
+ N_IncludeFile = $84;
+
+ maxstabs = 40; { size of the stabs buffer }
+ { GDB after 4.18 uses offset to function begin
+ in text section but OS/2 version still uses 4.16 PM }
+ StabsFunctionRelative : boolean = true;
+
+type
+ pstab=^tstab;
+ tstab=packed record
+ strpos : longint;
+ ntype : byte;
+ nother : byte;
+ ndesc : word;
+ nvalue : dword;
+ end;
+
+{ We use static variable so almost no stack is required, and is thus
+ more safe when an error has occured in the program }
+var
+ opened : boolean; { set if the file is already open }
+ f : file; { current file }
+ stabcnt, { amount of stabs }
+ stabofs, { absolute stab section offset in executable }
+ stabstrofs : longint; { absolute stabstr section offset in executable }
+ dirlength : longint; { length of the dirctory part of the source file }
+ stabs : array[0..maxstabs-1] of tstab; { buffer }
+ funcstab, { stab with current function info }
+ linestab, { stab with current line info }
+ dirstab, { stab with current directory info }
+ filestab : tstab; { stab with current file info }
+ { value to subtract to addr parameter to get correct address on file }
+ { this should be equal to the process start address in memory }
+ processaddress : cardinal;
+
+
+
+{****************************************************************************
+ Executable Loaders
+****************************************************************************}
+
+{$if defined(netbsd) or defined(freebsd) or defined(linux) or defined(sunos)}
+ {$ifdef cpu64}
+ {$define ELF64}
+ {$else}
+ {$define ELF32}
+ {$endif}
+{$endif}
+
+{$ifdef netwlibc}
+{$define netware}
+{$endif}
+{$ifdef netware}
+
+const SIZE_OF_NLM_INTERNAL_FIXED_HEADER = 130;
+ SIZE_OF_NLM_INTERNAL_VERSION_HEADER = 32;
+ SIZE_OF_NLM_INTERNAL_EXTENDED_HEADER = 124;
+
+function loadNetwareNLM:boolean;
+var valid : boolean;
+ name : string;
+ StabLength,
+ StabStrLength,
+ alignAmount,
+ hdrLength,
+ dataOffset,
+ dataLength : longint;
+
+ function getByte:byte;
+ begin
+ BlockRead (f,getByte,1);
+ end;
+
+ procedure Skip (bytes : longint);
+ var i : longint;
+ begin
+ for i := 1 to bytes do getbyte;
+ end;
+
+ function getLString : String;
+ var Res:string;
+ begin
+ blockread (F, res, 1);
+ if length (res) > 0 THEN
+ blockread (F, res[1], length (res));
+ getbyte;
+ getLString := res;
+ end;
+
+ function getFixString (Len : byte) : string;
+ var i : byte;
+ begin
+ getFixString := '';
+ for I := 1 to Len do
+ getFixString := getFixString + char (getbyte);
+ end;
+
+ function get0String : string;
+ var c : char;
+ begin
+ get0String := '';
+ c := char (getbyte);
+ while (c <> #0) do
+ begin
+ get0String := get0String + c;
+ c := char (getbyte);
+ end;
+ end;
+
+ function getword : word;
+ begin
+ blockread (F, getword, 2);
+ end;
+
+ function getint32 : longint;
+ begin
+ blockread (F, getint32, 4);
+ end;
+
+begin
+ processaddress := 0;
+ LoadNetwareNLM:=false;
+ stabofs:=-1;
+ stabstrofs:=-1;
+ { read and check header }
+ Skip (SIZE_OF_NLM_INTERNAL_FIXED_HEADER);
+ getLString; // NLM Description
+ getInt32; // Stacksize
+ getInt32; // Reserved
+ skip(5); // old Thread Name
+ getLString; // Screen Name
+ getLString; // Thread Name
+ hdrLength := -1;
+ dataOffset := -1;
+ dataLength := -1;
+ valid := true;
+ repeat
+ name := getFixString (8);
+ if (name = 'VeRsIoN#') then
+ begin
+ Skip (SIZE_OF_NLM_INTERNAL_VERSION_HEADER-8);
+ end else
+ if (name = 'CoPyRiGh') then
+ begin
+ getword; // T=
+ getLString; // Copyright String
+ end else
+ if (name = 'MeSsAgEs') then
+ begin
+ skip (SIZE_OF_NLM_INTERNAL_EXTENDED_HEADER - 8);
+ end else
+ if (name = 'CuStHeAd') then
+ begin
+ hdrLength := getInt32;
+ dataOffset := getInt32;
+ dataLength := getInt32;
+ Skip (8); // dataStamp
+ Valid := false;
+ end else
+ Valid := false;
+ until not valid;
+ if (hdrLength = -1) or (dataOffset = -1) or (dataLength = -1) then
+ exit;
+ (* The format of the section information is:
+ null terminated section name
+ zeroes to adjust to 4 byte boundary
+ 4 byte section data file pointer
+ 4 byte section size *)
+ Seek (F, dataOffset);
+ stabOfs := 0;
+ stabStrOfs := 0;
+ Repeat
+ Name := Get0String;
+ alignAmount := 4 - ((length (Name) + 1) MOD 4);
+ Skip (alignAmount);
+ if (Name = '.stab') then
+ begin
+ stabOfs := getInt32;
+ stabLength := getInt32;
+ stabcnt:=stabLength div sizeof(tstab);
+ end else
+ if (Name = '.stabstr') then
+ begin
+ stabStrOfs := getInt32;
+ stabStrLength := getInt32;
+ end else
+ Skip (8);
+ until (Name = '') or ((StabOfs <> 0) and (stabStrOfs <> 0));
+ Seek (F,stabOfs);
+ //if (StabOfs = 0) then __ConsolePrintf ('StabOfs = 0');
+ //if (StabStrOfs = 0) then __ConsolePrintf ('StabStrOfs = 0');
+ LoadNetwareNLM := ((stabOfs > 0) and (stabStrOfs > 0));
+end;
+{$endif}
+
+{$ifdef go32v2}
+function LoadGo32Coff:boolean;
+type
+ tcoffheader=packed record
+ mach : word;
+ nsects : word;
+ time : longint;
+ sympos : longint;
+ syms : longint;
+ opthdr : word;
+ flag : word;
+ other : array[0..27] of byte;
+ end;
+ tcoffsechdr=packed record
+ name : array[0..7] of char;
+ vsize : longint;
+ rvaofs : longint;
+ datalen : longint;
+ datapos : longint;
+ relocpos : longint;
+ lineno1 : longint;
+ nrelocs : word;
+ lineno2 : word;
+ flags : longint;
+ end;
+var
+ coffheader : tcoffheader;
+ coffsec : tcoffsechdr;
+ i : longint;
+begin
+ processaddress := 0;
+ LoadGo32Coff:=false;
+ stabofs:=-1;
+ stabstrofs:=-1;
+ { read and check header }
+ if filesize(f)<2048+sizeof(tcoffheader) then
+ exit;
+ seek(f,2048);
+ blockread(f,coffheader,sizeof(tcoffheader));
+ if coffheader.mach<>$14c then
+ exit;
+ { read section info }
+ for i:=1to coffheader.nSects do
+ begin
+ blockread(f,coffsec,sizeof(tcoffsechdr));
+ if (coffsec.name[4]='b') and
+ (coffsec.name[1]='s') and
+ (coffsec.name[2]='t') then
+ begin
+ if (coffsec.name[5]='s') and
+ (coffsec.name[6]='t') then
+ stabstrofs:=coffsec.datapos+2048
+ else
+ begin
+ stabofs:=coffsec.datapos+2048;
+ stabcnt:=coffsec.datalen div sizeof(tstab);
+ end;
+ end;
+ end;
+ LoadGo32Coff:=(stabofs<>-1) and (stabstrofs<>-1);
+end;
+{$endif Go32v2}
+
+
+{$ifdef win32}
+function LoadPeCoff:boolean;
+type
+ tdosheader = packed record
+ e_magic : word;
+ e_cblp : word;
+ e_cp : word;
+ e_crlc : word;
+ e_cparhdr : word;
+ e_minalloc : word;
+ e_maxalloc : word;
+ e_ss : word;
+ e_sp : word;
+ e_csum : word;
+ e_ip : word;
+ e_cs : word;
+ e_lfarlc : word;
+ e_ovno : word;
+ e_res : array[0..3] of word;
+ e_oemid : word;
+ e_oeminfo : word;
+ e_res2 : array[0..9] of word;
+ e_lfanew : longint;
+ end;
+ tpeheader = packed record
+ PEMagic : longint;
+ Machine : word;
+ NumberOfSections : word;
+ TimeDateStamp : longint;
+ PointerToSymbolTable : longint;
+ NumberOfSymbols : longint;
+ SizeOfOptionalHeader : word;
+ Characteristics : word;
+ Magic : word;
+ MajorLinkerVersion : byte;
+ MinorLinkerVersion : byte;
+ SizeOfCode : longint;
+ SizeOfInitializedData : longint;
+ SizeOfUninitializedData : longint;
+ AddressOfEntryPoint : longint;
+ BaseOfCode : longint;
+ BaseOfData : longint;
+ ImageBase : longint;
+ SectionAlignment : longint;
+ FileAlignment : longint;
+ MajorOperatingSystemVersion : word;
+ MinorOperatingSystemVersion : word;
+ MajorImageVersion : word;
+ MinorImageVersion : word;
+ MajorSubsystemVersion : word;
+ MinorSubsystemVersion : word;
+ Reserved1 : longint;
+ SizeOfImage : longint;
+ SizeOfHeaders : longint;
+ CheckSum : longint;
+ Subsystem : word;
+ DllCharacteristics : word;
+ SizeOfStackReserve : longint;
+ SizeOfStackCommit : longint;
+ SizeOfHeapReserve : longint;
+ SizeOfHeapCommit : longint;
+ LoaderFlags : longint;
+ NumberOfRvaAndSizes : longint;
+ DataDirectory : array[1..$80] of byte;
+ end;
+ tcoffsechdr=packed record
+ name : array[0..7] of char;
+ vsize : longint;
+ rvaofs : longint;
+ datalen : longint;
+ datapos : longint;
+ relocpos : longint;
+ lineno1 : longint;
+ nrelocs : word;
+ lineno2 : word;
+ flags : longint;
+ end;
+var
+ dosheader : tdosheader;
+ peheader : tpeheader;
+ coffsec : tcoffsechdr;
+ i : longint;
+begin
+ processaddress := 0;
+ LoadPeCoff:=false;
+ stabofs:=-1;
+ stabstrofs:=-1;
+ { read and check header }
+ if filesize(f)<sizeof(dosheader) then
+ exit;
+ blockread(f,dosheader,sizeof(tdosheader));
+ seek(f,dosheader.e_lfanew);
+ blockread(f,peheader,sizeof(tpeheader));
+ if peheader.pemagic<>$4550 then
+ exit;
+ { read section info }
+ for i:=1to peheader.NumberOfSections do
+ begin
+ blockread(f,coffsec,sizeof(tcoffsechdr));
+ if (coffsec.name[4]='b') and
+ (coffsec.name[1]='s') and
+ (coffsec.name[2]='t') then
+ begin
+ if (coffsec.name[5]='s') and
+ (coffsec.name[6]='t') then
+ stabstrofs:=coffsec.datapos
+ else
+ begin
+ stabofs:=coffsec.datapos;
+ stabcnt:=coffsec.datalen div sizeof(tstab);
+ end;
+ end;
+ end;
+ LoadPeCoff:=(stabofs<>-1) and (stabstrofs<>-1);
+end;
+{$endif Win32}
+
+
+{$IFDEF EMX}
+function LoadEMXaout: boolean;
+type
+ TDosHeader = packed record
+ e_magic : word;
+ e_cblp : word;
+ e_cp : word;
+ e_crlc : word;
+ e_cparhdr : word;
+ e_minalloc : word;
+ e_maxalloc : word;
+ e_ss : word;
+ e_sp : word;
+ e_csum : word;
+ e_ip : word;
+ e_cs : word;
+ e_lfarlc : word;
+ e_ovno : word;
+ e_res : array[0..3] of word;
+ e_oemid : word;
+ e_oeminfo : word;
+ e_res2 : array[0..9] of word;
+ e_lfanew : longint;
+ end;
+ TEmxHeader = packed record
+ Version: array [1..16] of char;
+ Bound: word;
+ AoutOfs: longint;
+ Options: array [1..42] of char;
+ end;
+ TAoutHeader = packed record
+ Magic: word;
+ Machine: byte;
+ Flags: byte;
+ TextSize: longint;
+ DataSize: longint;
+ BssSize: longint;
+ SymbSize: longint;
+ EntryPoint: longint;
+ TextRelocSize: longint;
+ DataRelocSize: longint;
+ end;
+const
+ StartPageSize = $1000;
+var
+ DosHeader: TDosHeader;
+ EmxHeader: TEmxHeader;
+ AoutHeader: TAoutHeader;
+ S4: string [4];
+begin
+ processaddress := 0;
+ LoadEMXaout := false;
+ StabOfs := -1;
+ StabStrOfs := -1;
+{ read and check header }
+ if FileSize (F) > SizeOf (DosHeader) then
+ begin
+ BlockRead (F, DosHeader, SizeOf (TDosHeader));
+ Seek (F, DosHeader.e_cparhdr shl 4);
+ BlockRead (F, EmxHeader, SizeOf (TEmxHeader));
+ S4 [0] := #4;
+ Move (EmxHeader.Version, S4 [1], 4);
+ if S4 = 'emx ' then
+ begin
+ Seek (F, EmxHeader.AoutOfs);
+ BlockRead (F, AoutHeader, SizeOf (TAoutHeader));
+
+ if AOutHeader.Magic=$10B then
+ StabOfs := StartPageSize
+ else
+ StabOfs :=EmxHeader.AoutOfs + SizeOf (TAoutHeader);
+ StabOfs := StabOfs
+ + AoutHeader.TextSize
+ + AoutHeader.DataSize
+ + AoutHeader.TextRelocSize
+ + AoutHeader.DataRelocSize;
+ StabCnt := AoutHeader.SymbSize div SizeOf (TStab);
+ StabStrOfs := StabOfs + AoutHeader.SymbSize;
+ StabsFunctionRelative:=false;
+ LoadEMXaout := (StabOfs <> -1) and (StabStrOfs <> -1);
+ end;
+ end;
+end;
+{$ENDIF EMX}
+
+
+{$ifdef ELF32}
+function LoadElf32:boolean;
+type
+ telf32header=packed record
+ magic0123 : longint;
+ file_class : byte;
+ data_encoding : byte;
+ file_version : byte;
+ padding : array[$07..$0f] of byte;
+ e_type : word;
+ e_machine : word;
+ e_version : longword;
+ e_entry : longword; // entrypoint
+ e_phoff : longword; // program header offset
+ e_shoff : longword; // sections header offset
+ e_flags : longword;
+ e_ehsize : word; // elf header size in bytes
+ e_phentsize : word; // size of an entry in the program header array
+ e_phnum : word; // 0..e_phnum-1 of entrys
+ e_shentsize : word; // size of an entry in sections header array
+ e_shnum : word; // 0..e_shnum-1 of entrys
+ e_shstrndx : word; // index of string section header
+ end;
+ telf32sechdr=packed record
+ sh_name : longword;
+ sh_type : longword;
+ sh_flags : longword;
+ sh_addr : longword;
+ sh_offset : longword;
+ sh_size : longword;
+ sh_link : longword;
+ sh_info : longword;
+ sh_addralign : longword;
+ sh_entsize : longword;
+ end;
+var
+ elfheader : telf32header;
+ elfsec : telf32sechdr;
+ secnames : array[0..255] of char;
+ pname : pchar;
+ i : longint;
+begin
+ processaddress := 0;
+ LoadElf32:=false;
+ stabofs:=-1;
+ stabstrofs:=-1;
+ { read and check header }
+ if filesize(f)<sizeof(telf32header) then
+ exit;
+ blockread(f,elfheader,sizeof(telf32header));
+{$ifdef ENDIAN_LITTLE}
+ if elfheader.magic0123<>$464c457f then
+ exit;
+{$endif ENDIAN_LITTLE}
+{$ifdef ENDIAN_BIG}
+ if elfheader.magic0123<>$7f454c46 then
+ exit;
+ { this seems to be at least the case for m68k cpu PM }
+{$ifdef cpum68k}
+ {StabsFunctionRelative:=false;}
+{$endif cpum68k}
+{$endif ENDIAN_BIG}
+ if elfheader.e_shentsize<>sizeof(telf32sechdr) then
+ exit;
+ { read section names }
+ seek(f,elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telf32sechdr)));
+ blockread(f,elfsec,sizeof(telf32sechdr));
+ seek(f,elfsec.sh_offset);
+ blockread(f,secnames,sizeof(secnames));
+ { read section info }
+ seek(f,elfheader.e_shoff);
+ for i:=1to elfheader.e_shnum do
+ begin
+ blockread(f,elfsec,sizeof(telf32sechdr));
+ pname:=@secnames[elfsec.sh_name];
+ if (pname[4]='b') and
+ (pname[1]='s') and
+ (pname[2]='t') then
+ begin
+ if (pname[5]='s') and
+ (pname[6]='t') then
+ stabstrofs:=elfsec.sh_offset
+ else
+ begin
+ stabofs:=elfsec.sh_offset;
+ stabcnt:=elfsec.sh_size div sizeof(tstab);
+ end;
+ end;
+ end;
+ LoadElf32:=(stabofs<>-1) and (stabstrofs<>-1);
+end;
+{$endif ELF32}
+
+
+{$ifdef ELF64}
+function LoadElf64:boolean;
+type
+ telf64header=packed record
+ magic0123 : longint;
+ file_class : byte;
+ data_encoding : byte;
+ file_version : byte;
+ padding : array[$07..$0f] of byte;
+ e_type : word;
+ e_machine : word;
+ e_version : longword;
+ e_entry : int64; // entrypoint
+ e_phoff : int64; // program header offset
+ e_shoff : int64; // sections header offset
+ e_flags : longword;
+ e_ehsize : word; // elf header size in bytes
+ e_phentsize : word; // size of an entry in the program header array
+ e_phnum : word; // 0..e_phnum-1 of entrys
+ e_shentsize : word; // size of an entry in sections header array
+ e_shnum : word; // 0..e_shnum-1 of entrys
+ e_shstrndx : word; // index of string section header
+ end;
+ telf64sechdr=packed record
+ sh_name : longword;
+ sh_type : longword;
+ sh_flags : int64;
+ sh_addr : int64;
+ sh_offset : int64;
+ sh_size : int64;
+ sh_link : longword;
+ sh_info : longword;
+ sh_addralign : int64;
+ sh_entsize : int64;
+ end;
+var
+ elfheader : telf64header;
+ elfsec : telf64sechdr;
+ secnames : array[0..255] of char;
+ pname : pchar;
+ i : longint;
+begin
+ processaddress := 0;
+ LoadElf64:=false;
+ stabofs:=-1;
+ stabstrofs:=-1;
+ { read and check header }
+ if filesize(f)<sizeof(telf64header) then
+ exit;
+ blockread(f,elfheader,sizeof(telf64header));
+{$ifdef ENDIAN_LITTLE}
+ if elfheader.magic0123<>$464c457f then
+ exit;
+{$endif ENDIAN_LITTLE}
+{$ifdef ENDIAN_BIG}
+ if elfheader.magic0123<>$7f454c46 then
+ exit;
+ { this seems to be at least the case for m68k cpu PM }
+{$ifdef cpum68k}
+ {StabsFunctionRelative:=false;}
+{$endif cpum68k}
+{$endif ENDIAN_BIG}
+ if elfheader.e_shentsize<>sizeof(telf64sechdr) then
+ exit;
+ { read section names }
+ seek(f,elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telf64sechdr)));
+ blockread(f,elfsec,sizeof(telf64sechdr));
+ seek(f,elfsec.sh_offset);
+ blockread(f,secnames,sizeof(secnames));
+ { read section info }
+ seek(f,elfheader.e_shoff);
+ for i:=1to elfheader.e_shnum do
+ begin
+ blockread(f,elfsec,sizeof(telf64sechdr));
+ pname:=@secnames[elfsec.sh_name];
+ if (pname[4]='b') and
+ (pname[1]='s') and
+ (pname[2]='t') then
+ begin
+ if (pname[5]='s') and
+ (pname[6]='t') then
+ stabstrofs:=elfsec.sh_offset
+ else
+ begin
+ stabofs:=elfsec.sh_offset;
+ stabcnt:=elfsec.sh_size div sizeof(tstab);
+ end;
+ end;
+ end;
+ LoadElf64:=(stabofs<>-1) and (stabstrofs<>-1);
+end;
+{$endif ELF64}
+
+
+{$ifdef beos}
+
+{$i osposixh.inc}
+{$i syscall.inc}
+{$i beos.inc}
+function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info';
+
+function LoadElf32Beos:boolean;
+type
+ telf32header=packed record
+ magic0123 : longint;
+ file_class : byte;
+ data_encoding : byte;
+ file_version : byte;
+ padding : array[$07..$0f] of byte;
+ e_type : word;
+ e_machine : word;
+ e_version : longword;
+ e_entry : longword; // entrypoint
+ e_phoff : longword; // program header offset
+ e_shoff : longword; // sections header offset
+ e_flags : longword;
+ e_ehsize : word; // elf header size in bytes
+ e_phentsize : word; // size of an entry in the program header array
+ e_phnum : word; // 0..e_phnum-1 of entrys
+ e_shentsize : word; // size of an entry in sections header array
+ e_shnum : word; // 0..e_shnum-1 of entrys
+ e_shstrndx : word; // index of string section header
+ end;
+ telf32sechdr=packed record
+ sh_name : longword;
+ sh_type : longword;
+ sh_flags : longword;
+ sh_addr : longword;
+ sh_offset : longword;
+ sh_size : longword;
+ sh_link : longword;
+ sh_info : longword;
+ sh_addralign : longword;
+ sh_entsize : longword;
+ end;
+var
+ elfheader : telf32header;
+ elfsec : telf32sechdr;
+ secnames : array[0..255] of char;
+ pname : pchar;
+ i : longint;
+ cookie : longint;
+ info : image_info;
+ result : status_t;
+begin
+ cookie := 0;
+ fillchar(info, sizeof(image_info), 0);
+ get_next_image_info(0,cookie,info,sizeof(info));
+ if (info._type = B_APP_IMAGE) then
+ processaddress := cardinal(info.text)
+ else
+ processaddress := 0;
+ LoadElf32Beos:=false;
+ stabofs:=-1;
+ stabstrofs:=-1;
+ { read and check header }
+ if filesize(f)<sizeof(telf32header) then
+ exit;
+ blockread(f,elfheader,sizeof(telf32header));
+{$ifdef ENDIAN_LITTLE}
+ if elfheader.magic0123<>$464c457f then
+ exit;
+{$endif ENDIAN_LITTLE}
+{$ifdef ENDIAN_BIG}
+ if elfheader.magic0123<>$7f454c46 then
+ exit;
+{$endif ENDIAN_BIG}
+ if elfheader.e_shentsize<>sizeof(telf32sechdr) then
+ exit;
+ { read section names }
+ seek(f,elfheader.e_shoff+elfheader.e_shstrndx*cardinal(sizeof(telf32sechdr)));
+ blockread(f,elfsec,sizeof(telf32sechdr));
+ seek(f,elfsec.sh_offset);
+ blockread(f,secnames,sizeof(secnames));
+ { read section info }
+ seek(f,elfheader.e_shoff);
+ for i:=1to elfheader.e_shnum do
+ begin
+ blockread(f,elfsec,sizeof(telf32sechdr));
+ pname:=@secnames[elfsec.sh_name];
+ if (pname[4]='b') and
+ (pname[1]='s') and
+ (pname[2]='t') then
+ begin
+ if (pname[5]='s') and
+ (pname[6]='t') then
+ stabstrofs:=elfsec.sh_offset
+ else
+ begin
+ stabofs:=elfsec.sh_offset;
+ stabcnt:=elfsec.sh_size div sizeof(tstab);
+ end;
+ end;
+ end;
+ LoadElf32Beos:=(stabofs<>-1) and (stabstrofs<>-1);
+end;
+{$endif beos}
+
+
+{****************************************************************************
+ Executable Open/Close
+****************************************************************************}
+
+procedure CloseStabs;
+begin
+ close(f);
+ opened:=false;
+end;
+
+
+function OpenStabs:boolean;
+var
+ ofm : word;
+begin
+ OpenStabs:=false;
+ assign(f,paramstr(0));
+ {$I-}
+ ofm:=filemode;
+ filemode:=$40;
+ reset(f,1);
+ filemode:=ofm;
+ {$I+}
+ if ioresult<>0 then
+ exit;
+ opened:=true;
+{$ifdef go32v2}
+ if LoadGo32Coff then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$endif}
+{$IFDEF EMX}
+ if LoadEMXaout then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$ENDIF EMX}
+{$ifdef win32}
+ if LoadPECoff then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$endif}
+{$ifdef ELF32}
+ if LoadElf32 then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$endif}
+{$ifdef ELF64}
+ if LoadElf64 then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$endif}
+{$ifdef Beos}
+ if LoadElf32Beos then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$endif}
+{$ifdef netware}
+ if LoadNetwareNLM then
+ begin
+ OpenStabs:=true;
+ exit;
+ end;
+{$endif}
+ CloseStabs;
+end;
+
+
+{$Q-}
+{ this avoids problems with some targets PM }
+
+procedure GetLineInfo(addr:ptruint;var func,source:string;var line:longint);
+var
+ res : {$ifdef tp}integer{$else}longint{$endif};
+ stabsleft,
+ stabscnt,i : longint;
+ found : boolean;
+ lastfunc : tstab;
+begin
+ fillchar(func,high(func)+1,0);
+ fillchar(source,high(source)+1,0);
+ line:=0;
+ if not opened then
+ begin
+ if not OpenStabs then
+ exit;
+ end;
+ { correct the value to the correct address in the file }
+ { processaddress is set in OpenStabs }
+ addr := addr - processaddress;
+ //ScreenPrintfL1 (NWLoggerScreen,'addr: %x\n',addr);
+
+ fillchar(funcstab,sizeof(tstab),0);
+ fillchar(filestab,sizeof(tstab),0);
+ fillchar(dirstab,sizeof(tstab),0);
+ fillchar(linestab,sizeof(tstab),0);
+ fillchar(lastfunc,sizeof(tstab),0);
+ found:=false;
+ seek(f,stabofs);
+ stabsleft:=stabcnt;
+ repeat
+ if stabsleft>maxstabs then
+ stabscnt:=maxstabs
+ else
+ stabscnt:=stabsleft;
+ blockread(f,stabs,stabscnt*sizeof(tstab),res);
+ stabscnt:=res div sizeof(tstab);
+ for i:=0 to stabscnt-1 do
+ begin
+ case stabs[i].ntype of
+ N_BssLine,
+ N_DataLine,
+ N_TextLine :
+ begin
+ if (stabs[i].ntype=N_TextLine) and StabsFunctionRelative then
+ inc(stabs[i].nvalue,lastfunc.nvalue);
+ if (stabs[i].nvalue<=addr) and
+ (stabs[i].nvalue>linestab.nvalue) then
+ begin
+ { if it's equal we can stop and take the last info }
+ if stabs[i].nvalue=addr then
+ found:=true
+ else
+ linestab:=stabs[i];
+ end;
+ end;
+ N_Function :
+ begin
+ lastfunc:=stabs[i];
+ if (stabs[i].nvalue<=addr) and
+ (stabs[i].nvalue>funcstab.nvalue) then
+ begin
+ funcstab:=stabs[i];
+ fillchar(linestab,sizeof(tstab),0);
+ end;
+ end;
+ N_SourceFile,
+ N_IncludeFile :
+ begin
+ if (stabs[i].nvalue<=addr) and
+ (stabs[i].nvalue>=filestab.nvalue) then
+ begin
+ { if same value and type then the first one
+ contained the directory PM }
+ if (stabs[i].nvalue=filestab.nvalue) and
+ (stabs[i].ntype=filestab.ntype) then
+ dirstab:=filestab
+ else
+ fillchar(dirstab,sizeof(tstab),0);
+ filestab:=stabs[i];
+ fillchar(linestab,sizeof(tstab),0);
+ { if new file then func is not valid anymore PM }
+ if stabs[i].ntype=N_SourceFile then
+ begin
+ fillchar(funcstab,sizeof(tstab),0);
+ fillchar(lastfunc,sizeof(tstab),0);
+ end;
+ end;
+ end;
+ end;
+ end;
+ dec(stabsleft,stabscnt);
+ until found or (stabsleft=0);
+
+{ get the line,source,function info }
+ line:=linestab.ndesc;
+ if dirstab.ntype<>0 then
+ begin
+ seek(f,stabstrofs+dirstab.strpos);
+ blockread(f,source[1],high(source)-1,res);
+ dirlength:=strlen(@source[1]);
+ source[0]:=chr(dirlength);
+ end
+ else
+ dirlength:=0;
+ if filestab.ntype<>0 then
+ begin
+ seek(f,stabstrofs+filestab.strpos);
+ blockread(f,source[dirlength+1],high(source)-(dirlength+1),res);
+ source[0]:=chr(strlen(@source[1]));
+ end;
+ if funcstab.ntype<>0 then
+ begin
+ seek(f,stabstrofs+funcstab.strpos);
+ blockread(f,func[1],high(func)-1,res);
+ func[0]:=chr(strlen(@func[1]));
+ i:=pos(':',func);
+ if i>0 then
+ Delete(func,i,255);
+ end;
+end;
+
+
+function StabBackTraceStr(addr:Pointer):shortstring;
+var
+ func,
+ source : string;
+ hs : string[32];
+ line : longint;
+ Store : TBackTraceStrFunc;
+begin
+ { reset to prevent infinite recursion if problems inside the code PM }
+ {$ifdef netware}
+ dec(addr,system.NWGetCodeStart); {we need addr relative to code start on netware}
+ {$endif}
+ Store:=BackTraceStrFunc;
+ BackTraceStrFunc:=@SysBackTraceStr;
+ GetLineInfo(ptruint(addr),func,source,line);
+{ create string }
+ {$ifdef netware}
+ StabBackTraceStr:=' CodeStart + $'+HexStr(ptrint(addr),sizeof(ptrint)*2);
+ {$else}
+ StabBackTraceStr:=' $'+HexStr(ptrint(addr),sizeof(ptrint)*2);
+ {$endif}
+ if func<>'' then
+ StabBackTraceStr:=StabBackTraceStr+' '+func;
+ if source<>'' then
+ begin
+ if func<>'' then
+ StabBackTraceStr:=StabBackTraceStr+', ';
+ if line<>0 then
+ begin
+ str(line,hs);
+ StabBackTraceStr:=StabBackTraceStr+' line '+hs;
+ end;
+ StabBackTraceStr:=StabBackTraceStr+' of '+source;
+ end;
+ if Opened then
+ BackTraceStrFunc:=Store;
+end;
+
+
+initialization
+ BackTraceStrFunc:=@StabBackTraceStr;
+
+finalization
+ if opened then
+ CloseStabs;
+
+end.
+{
+ $Log: lineinfo.pp,v $
+ Revision 1.25 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/lstrings.pp b/rtl/inc/lstrings.pp
new file mode 100644
index 0000000000..41504fc253
--- /dev/null
+++ b/rtl/inc/lstrings.pp
@@ -0,0 +1,541 @@
+{
+ $Id: lstrings.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ This file contains the implementation of the LongString type,
+ and all things that are needed for it.
+ LongSTring is defined as a 'silent' pchar :
+ a pchar that points to :
+
+ @ : Longint for size
+ @+4 : Unused byte;
+ @+5 : String;
+ So LS[i] is converted to the address @LS+4+i.
+
+ pchar[0]-pchar[3] : Longint Size
+ pchar [4] : Unused
+ pchar[5] : String;
+
+}
+
+{$ifdef lstrings_unit}
+{ Compile as a separate unit - development only}
+unit lstrings;
+
+Interface
+
+Type longstring = pchar;
+ ShortString = string;
+
+{$i textrec.inc}
+
+{ Internal functions, will not appear in systemh.inc }
+
+Function NewLongString (Len : Longint) : LongString;
+Procedure DisposeLongString (Var S : LongString; Len : Longint);
+Procedure Long_String_Concat (Var S1 : LongString; Const S2 : LongString; maxlen : Longint);
+Procedure Long_ShortString_Concat (Var S1: LongString; Const S2 : ShortString; maxlen : Longint);
+Procedure Long_To_ShortString (Var S1 : ShortString; Const S2 : LongString; Maxlen : Longint);
+Procedure Short_To_LongString (Var S1 : LongString; Const S2 : ShortString; Maxlen : Longint);
+Function LongCompare (Const S1,S2 : Longstring): Longint;
+Function LongCompare (Const S1 : LongString; Const S2 : ShortString): Longint;
+
+{ Public functions, Will end up in systemh.inc }
+
+Procedure SetLength (Var S : LongString; l : Longint);
+Procedure Write_Text_LongString (Len : Longint; T : Textrec; Var S : LongString);
+Function Length (Const S : LongString) : Longint;
+Function Copy (Const S : LongString; Index,Size : Longint) : LongString;
+Function Pos (Const Substr : LongString; Const Source : Longstring) : Longint;
+Procedure Insert (Const Source : LongString; Var S : LongString; Index : Longint);
+Procedure Delete (Var S : LongString; Index,Size: Longint);
+Procedure Val (Const S : LongString; var R : real; Var Code : Integer);
+{Procedure Val (Const S : LongString; var D : Double; Var Code : Integer);}
+Procedure Val (Const S : LongString; var E : Extended; Code : Integer);
+Procedure Val (Const S : LongString; var C : Cardinal; Code : Integer);
+Procedure Val (Const S : LongString; var L : Longint; Var Code : Integer);
+Procedure Val (Const S : LongString; var W : Word; Var Code : Integer);
+Procedure Val (Const S : LongString; var I : Integer; Var Code : Integer);
+Procedure Val (Const S : LongString; var B : Byte; Var Code : Integer);
+Procedure Val (Const S : LongString; var SI : ShortInt; Var Code : Integer);
+Procedure Str (Const R : Real;Len, fr : longint; Var S : LongString);
+{Procedure Str (Const D : Double;Len,fr : longint; Var S : LongString);}
+Procedure Str (Const E : Extended;Len,fr : longint; Var S : LongString);
+Procedure Str (Const C : Cardinal;len : Longint; Var S : LongString);
+Procedure Str (Const L : LongInt;len : longint; Var S : LongString);
+Procedure Str (Const W : Word;len : longint; Var S : LongString);
+Procedure Str (Const I : Integer;len : Longint; Var S : LongString);
+Procedure Str (Const B : Byte; Len : longint; Var S : LongString);
+Procedure Str (Const SI : ShortInt; Len : longint; Var S : LongString);
+
+Implementation
+
+{$endif}
+
+Type PLongint = ^Longint;
+
+{ ---------------------------------------------------------------------
+ Internal functions, not in interface.
+ ---------------------------------------------------------------------}
+
+Function NewLongString (Len : Longint) : LongString;
+{
+ Allocate a new string on the heap.
+ initialize it to zero length
+}
+Var P : Pointer;
+
+begin
+ GetMem(P,Len+5);
+ If P<>Nil then
+ begin
+ PLongint(P)^:=0;
+ pchar(P+4)^:=#0;
+ end;
+ NewLongString:=P;
+end;
+
+
+
+Procedure DisposeLongString (Var S : LongString; Len : Longint);
+{
+ DeAllocates a LongString From the heap.
+}
+begin
+ FreeMem (Pointer(S),Len+5);
+end;
+
+
+
+Procedure Long_String_Concat (Var S1 : LongString; Const S2 : LongString; maxlen : Longint);
+{
+ Concatenates 2 LongStrings : S1+S2
+ If maxlen<>-1 then the result has maximal length maxlen.
+}
+Var Size : Longint;
+
+begin
+ Size:=PLongint(S2)^;
+ If maxlen<>-1 then
+ if Size+PLongint(S1)^>MaxLen then
+ Size:=Maxlen-PLongint(S1)^;
+ If Size<=0 then exit;
+ Move (pchar(S2)[5],pchar(S1)[PLongint(S1)^+5],Size);
+ PLongint(S1)^:=PLongint(S1)^+Size;
+end;
+
+
+
+Procedure Long_ShortString_Concat (Var S1: LongString; Const S2 : ShortString; maxlen : Longint);
+{
+ Concatenates a long with a short string; : S2 + S2
+ If maxlen<>-1 then the result has maximal length maxlen.
+}
+Var Size : Longint;
+
+begin
+ Size:=Byte(S2[0]);
+ if MaxLen<>-1 then
+ if Size+PLongint(S1)^>Maxlen then
+ Size:=Maxlen-PLongint(S1)^;
+ If Size<=0 then exit;
+ Move (S2[1],Pchar(S1)[PLongint(S1)^+5],Size);
+ PLongint(S1)^:=PLongint(S1)^+Size;
+end;
+
+
+
+Procedure Long_To_ShortString (Var S1 : ShortString; Const S2 : LongString; Maxlen : Longint);
+{
+ Converts a LongString to a longstring;
+ if maxlen<>-1, the resulting string has maximal length maxlen
+ else a default length of 255 is taken.
+}
+Var Size : Longint;
+
+begin
+ Size:=PLongint(S2)^;
+ if maxlen=-1 then maxlen:=255;
+ If Size>maxlen then Size:=maxlen;
+ Move (Pchar(S2)[5],S1[1],Size);
+ S1[0]:=chr(Size);
+end;
+
+
+
+Procedure Short_To_LongString (Var S1 : LongString; Const S2 : ShortString; Maxlen : Longint);
+{
+ Converts a ShortString to a LongString;
+ if maxlen<>-1 then the resulting string has length maxlen.
+}
+Var Size : Longint;
+
+begin
+ Size:=Byte(S2[0]);
+ if maxlen=-1 then maxlen:=255;
+ If Size>maxlen then Size:=maxlen;
+ Move (S2[1],pchar(S1)[5],Size);
+ PLongint(S1)^:=Size;
+end;
+
+
+
+Function LongCompare (Const S1,S2 : Longstring): Longint;
+{
+ Compares 2 longStrings;
+ The result is
+ <0 if S1<S2
+ 0 if S1=S2
+ >0 if S1>S2
+}
+Var i,MaxI,Temp : Longint;
+
+begin
+ Temp:=0;
+ i:=1;
+ MaxI:=PLongint(S1)^;
+ if MaxI>PLOngint(S2)^ then MaxI:=PLongint(S2)^;
+ While (i<=MaxI) and (Temp=0) do
+ begin
+ Temp:= Byte( Pchar(S1)[i+4] ) - Byte( Pchar(S2)[I+4] );
+ inc(i);
+ end;
+ if temp=0 then temp:=Plongint(S1)^-PLongint(S2)^;
+ LongCompare:=Temp;
+end;
+
+
+
+Function LongCompare (Const S1 : LongString; Const S2 : ShortString): Longint;
+{
+ Compares a longString with a ShortString;
+ The result is
+ <0 if S1<S2
+ 0 if S1=S2
+ >0 if S1>S2
+}
+Var i,MaxI,Temp : Longint;
+
+begin
+ Temp:=0;
+ i:=1;
+ MaxI:=PLongint(S1)^;
+ if MaxI>byte(S2[0]) then MaxI:=Byte(S2[0]);
+ While (i<=MaxI) and (Temp=0) do
+ begin
+ Temp:=(Byte(Pchar(S1)[i+4])-Byte(S2[I]));
+ inc(i);
+ end;
+ LongCompare:=Temp;
+end;
+
+
+
+Procedure Write_Text_LongString (Len : Longint; T : TextRec; Var S : LongString);
+{
+ Writes a LongString to the Text file T
+}
+begin
+end;
+
+
+{ ---------------------------------------------------------------------
+ Public functions, In interface.
+ ---------------------------------------------------------------------}
+
+Function Length (Const S : LongString) : Longint;
+
+begin
+ Length:=PLongint(S)^;
+end;
+
+
+
+Procedure SetLength (Var S : LongString; l : Longint);
+
+begin
+ PLongint(S)^:=l;
+end;
+
+Function Copy (Const S : LongString; Index,Size : Longint) : LongString;
+
+var ResultAddress : pchar;
+
+begin
+ ResultAddress:=NewLongString (Size);
+ if ResultAddress=Nil then
+ {We're in deep shit here !!}
+ exit;
+ dec(index);
+ if PLongint(S)^<Index+Size then
+ Size:=PLongint(S)^-Index;
+ if Size>0 then
+ Move (Pchar(S)[Index+5],ResultAddress[5],Size)
+ Else
+ Size:=0;
+ PLongint(ResultAddress)^:=Size;
+ Copy:=ResultAddress
+end;
+
+
+
+Function Pos (Const Substr : LongString; Const Source : Longstring) : Longint;
+
+var i,j : longint;
+ e : boolean;
+ s : longstring;
+
+begin
+ i := 0;
+ j := 0;
+ e := true;
+ if Plongint(substr)^=0 then e := false;
+ while (e) and (i <= length (Source) - length (substr)) do
+ begin
+ inc (i);
+ s :=copy(Source,i,length(Substr));
+ if LongCompare(substr,s)=0 then
+ begin
+ j := i;
+ e := false;
+ end;
+ DisposeLongString(s,length(Substr));
+ end;
+ pos := j;
+end;
+
+
+
+Procedure Val (Const S : LongString; var R : real; Var Code : Integer);
+
+Var SS : String;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,R,Code);
+end;
+
+
+{
+Procedure Val (Const S : LongString; var D : Double; Var Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ Val(SS,D,Code);
+end;
+}
+
+
+Procedure Val (Const S : LongString; var E : Extended; Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,E,Code);
+end;
+
+
+
+Procedure Val (Const S : LongString; var C : Cardinal; Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,C,Code);
+end;
+
+
+
+Procedure Val (Const S : LongString; var L : Longint; Var Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,L,Code);
+end;
+
+
+
+Procedure Val (Const S : LongString; var W : Word; Var Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,W,Code);
+end;
+
+
+
+Procedure Val (Const S : LongString; var I : Integer; Var Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,I,Code);
+end;
+
+
+
+Procedure Val (Const S : LongString; var B : Byte; Var Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,B,Code);
+end;
+
+
+
+Procedure Val (Const S : LongString; var SI : ShortInt; Var Code : Integer);
+
+Var SS : ShortString;
+
+begin
+ Long_To_ShortString (SS,S,255);
+ System.Val(SS,SI,Code);
+end;
+
+
+Procedure Str (Const R : Real;Len,fr : Longint; Var S : LongString);
+
+Var SS : ShortString;
+
+begin
+ {int_Str_Real (R,Len,fr,SS);}
+ Short_To_LongString (S,SS,255);
+end;
+
+
+{
+Procedure Str (Const D : Double;Len,fr: Longint; Var S : LongString);
+
+Var SS : ShortString;
+
+begin
+ {int_Str_Double (D,Len,fr,SS);}
+ Short_To_LongString (S,SS,255);
+end;
+}
+
+
+Procedure Str (Const E : Extended;Lenf,Fr: Longint; Var S : LongString);
+
+Var SS : ShortString;
+
+begin
+ {int_Str_Extended (E,Len,fr,SS);}
+ Short_To_LongString (S,SS,255);
+end;
+
+
+
+Procedure Str (Const C : Cardinal;Len : Longint; Var S : LongString);
+
+begin
+end;
+
+
+
+Procedure Str (Const L : Longint; Len : Longint; Var S : LongString);
+
+Var SS : ShortString;
+
+begin
+ {int_Str_Longint (L,Len,fr,SS);}
+ Short_To_LongString (S,SS,255);
+end;
+
+
+
+Procedure Str (Const W : Word;Len : Longint; Var S : LongString);
+
+begin
+end;
+
+
+
+Procedure Str (Const I : Integer;Len : Longint; Var S : LongString);
+
+begin
+end;
+
+
+
+Procedure Str (Const B : Byte; Len : Longint; Var S : LongString);
+
+begin
+end;
+
+
+
+Procedure Str (Const SI : ShortInt; Len : Longint; Var S : LongString);
+
+begin
+end;
+
+
+
+Procedure Delete (Var S : LongString; Index,Size: Longint);
+
+begin
+ if index<=0 then
+ begin
+ Size:=Size+index-1;
+ index:=1;
+ end;
+ if (Index<=PLongint(s)^) and (Size>0) then
+ begin
+ if Size+Index>PLongint(s)^ then
+ Size:=PLongint(s)^-Index+1;
+ PLongint(s)^:=PLongint(s)^-Size;
+ if Index<=Length(s) then
+ Move(pchar(s)[Index+Size+4],pchar(s)[Index+4],Length(s)-Index+1);
+ end;
+end;
+
+Procedure Insert (Const Source : LongString; Var S : LongString; Index : Longint);
+
+var s3,s4 : pchar;
+
+begin
+ if index <= 0 then index := 1;
+ s3 := longString(copy (s, index, length(s)));
+ if index > PLongint(s)^ then index := PLongint(S)^+1;
+ PLongint(s)^ := index - 1;
+ s4 :=Pchar ( NewLongString (Plongint(Source)^) );
+ Long_String_Concat(LongString(s4),Source,-1);
+ Long_String_Concat(LongString(S4),LongString(s3),-1);
+ Long_String_Concat(S,LongString(S4),-1);
+ DisposeLongstring(LongString(S3),PLongint(S3)^);
+ DisposeLongString(LongString(S4),PLongint(S4)^);
+end;
+
+{$ifdef lstrings_unit}
+end.
+{$endif}
+
+{
+ $Log: lstrings.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/macpas.pp b/rtl/inc/macpas.pp
new file mode 100644
index 0000000000..e9f844708b
--- /dev/null
+++ b/rtl/inc/macpas.pp
@@ -0,0 +1,61 @@
+{
+ $Id: macpas.pp,v 1.4 2005/04/04 16:14:09 peter Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 2004 by Olle Raab
+
+ This unit contain procedures specific for mode MacPas.
+ It should be platform independant.
+
+ See the file COPYING.FPC, included in this distribution,
+ For details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit MacPas;
+
+interface
+
+{ Using inlining for small system functions/wrappers }
+{$ifdef HASINLINE}
+ {$inline on}
+ {$define SYSTEMINLINE}
+{$endif}
+
+type
+ LongDouble = ValReal;
+
+{FourCharCode coercion
+This routine coreces string literals to a FourCharCode.}
+function FCC(literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
+
+{Same as FCC, to be compatible with GPC}
+function FOUR_CHAR_CODE(literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
+
+{This makes casts from ShortString to FourCharCode automatically,
+ to emulate the behaviour of mac pascal compilers}
+operator := (s: ShortString) res: LongWord; {$ifdef systeminline}inline;{$endif}
+
+
+implementation
+
+
+function FCC(literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
+begin
+ FCC := PLongWord(@literal[1])^;
+end;
+
+function FOUR_CHAR_CODE(literal: string): LongWord; {$ifdef systeminline}inline;{$endif}
+begin
+ FOUR_CHAR_CODE := PLongWord(@literal[1])^;
+end;
+
+operator := (s: ShortString) res: LongWord; {$ifdef systeminline}inline;{$endif}
+begin
+ res := PLongWord(@s[1])^;
+end;
+
+end.
diff --git a/rtl/inc/makefile.inc b/rtl/inc/makefile.inc
new file mode 100644
index 0000000000..15bcd89d3e
--- /dev/null
+++ b/rtl/inc/makefile.inc
@@ -0,0 +1,22 @@
+#
+# Here we set some variables, needed by all OSes.
+#
+# System unit include files. These are composed from header and
+# implementation files.
+
+SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
+ file typefile text rtti heap astrings objpas objpash except int64 \
+ generic dynarr varianth variant wstrings
+
+SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
+
+# Other unit names which can be used for all systems
+#
+#UNITNAMES=getops
+#UNITPPNAMES=$(addsuffix .pp,$(UNITNAMES))
+
+# Other files...
+#astrings.pp
+#complex.pp
+#cpne.pp
+#lstrings.pp
diff --git a/rtl/inc/mathh.inc b/rtl/inc/mathh.inc
new file mode 100644
index 0000000000..a5b5c3e017
--- /dev/null
+++ b/rtl/inc/mathh.inc
@@ -0,0 +1,106 @@
+{
+ $Id: mathh.inc,v 1.22 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ { i386 FPU Controlword }
+
+{$ifdef cpui386}
+ const
+ Default8087CW : word = $1332;
+
+ procedure Set8087CW(cw:word);
+ function Get8087CW:word;
+{$endif cpui386}
+
+{$ifdef cpux86_64}
+ const
+ Default8087CW : word = $1332;
+
+ procedure Set8087CW(cw:word);
+ function Get8087CW:word;
+{$endif cpux86_64}
+
+ { declarations of the math routines }
+
+{$ifdef cpui386}
+ {$define INTERNMATH}
+{$endif}
+
+{$ifndef INTERNMATH}
+ {$ifdef FPC_USE_LIBC}
+ {$ifdef SYSTEMINLINE}
+ {$define MATHINLINE}
+ {$endif}
+ {$endif}
+{$endif}
+
+{$ifdef internconstintf}
+ function pi : ValReal;[internproc:fpc_in_pi_real];
+ function abs(d : ValReal) : ValReal;[internproc:fpc_in_abs_real];
+ function sqr(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
+ function sqrt(d : ValReal) : ValReal;[internproc:fpc_in_sqrt_real];
+ function arctan(d : ValReal) : ValReal;[internproc:fpc_in_arctan_real];
+ function ln(d : ValReal) : ValReal;[internproc:fpc_in_ln_real];
+ function sin(d : ValReal) : ValReal;[internproc:fpc_in_sin_real];
+ function cos(d : ValReal) : ValReal;[internproc:fpc_in_cos_real];
+ function exp(d : ValReal) : ValReal;[internproc:fpc_in_exp_real];
+ function round(d : ValReal) : int64;[internproc:fpc_in_round_real];
+ function frac(d : ValReal) : ValReal;[internproc:fpc_in_frac_real];
+ function int(d : ValReal) : ValReal;[internproc:fpc_in_int_real];
+ function trunc(d : ValReal) : int64;[internproc:fpc_in_trunc_real];
+{$else}
+ function abs(d : ValReal) : ValReal;
+ function arctan(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function cos(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function exp(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function frac(d : ValReal) : ValReal;
+ function int(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function ln(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function pi : ValReal;
+ function sin(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function sqr(d : ValReal) : ValReal;
+ function sqrt(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+ function round(d : ValReal) : int64;
+ function trunc(d : ValReal) : int64;
+{$endif internconstintf}
+
+{$ifdef FPC_CURRENCY_IS_INT64}
+ function trunc(c : currency) : int64;
+ function trunc(c : comp) : int64;
+ function round(c : currency) : int64;
+ function round(c : comp) : int64;
+{$endif FPC_CURRENCY_IS_INT64}
+
+
+ type
+ real48 = array[0..5] of byte;
+
+{$ifdef SUPPORT_DOUBLE}
+ function Real2Double(r : real48) : double;
+ operator := (b:real48) d:double;
+{$endif}
+{$ifdef SUPPORT_EXTENDED}
+ operator := (b:real48) e:extended;
+{$endif SUPPORT_EXTENDED}
+
+{
+ $Log: mathh.inc,v $
+ Revision 1.22 2005/02/14 17:13:22 peter
+ * truncate log
+
+ Revision 1.21 2005/02/08 20:25:28 florian
+ - killed power from system unit
+ * move operator ** to math unit
+
+}
diff --git a/rtl/inc/matrix.pp b/rtl/inc/matrix.pp
new file mode 100644
index 0000000000..e1504fdee2
--- /dev/null
+++ b/rtl/inc/matrix.pp
@@ -0,0 +1,836 @@
+unit matrix;
+{
+ $Id: matrix.pp,v 1.4 2005/02/14 17:13:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Daniel Mantione
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{This unit provides some common matrix and vector operations on vectors and
+ matrixes with dimensions of 2, 3 and 4 which are the most common ones in
+ computer graphics, and all routines provided in variations with single,
+ double and extended precision.
+
+ The goal of this unit is also to invite some standardisation
+ between libraries, i.e. a vector from library x can be passed to library y
+ without conversion routines in between.
+
+ It would be nice to have some diehard assembler optimized versions of
+ these routines, however the Free Pascal team wishes to concentrate on the
+ compiler. Contributions from the community are very welcome.}
+
+{*****************************************************************************}
+
+{$ifdef VER1_0}
+{1.0 has too much macro bugs :( }
+interface implementation end.
+{$else}
+
+interface
+
+{*****************************************************************************}
+
+{$MACRO on}
+
+type Tvector2_single_data=array[0..1] of single;
+ Tvector2_double_data=array[0..1] of double;
+ Tvector2_extended_data=array[0..1] of extended;
+
+ Tvector3_single_data=array[0..2] of single;
+ Tvector3_double_data=array[0..2] of double;
+ Tvector3_extended_data=array[0..2] of extended;
+
+ Tvector4_single_data=array[0..3] of single;
+ Tvector4_double_data=array[0..3] of double;
+ Tvector4_extended_data=array[0..3] of extended;
+
+ Tmatrix2_single_data=array[0..1,0..1] of single;
+ Tmatrix2_double_data=array[0..1,0..1] of double;
+ Tmatrix2_extended_data=array[0..1,0..1] of extended;
+
+ Tmatrix3_single_data=array[0..2,0..2] of single;
+ Tmatrix3_double_data=array[0..2,0..2] of double;
+ Tmatrix3_extended_data=array[0..2,0..2] of extended;
+
+ Tmatrix4_single_data=array[0..3,0..3] of single;
+ Tmatrix4_double_data=array[0..3,0..3] of double;
+ Tmatrix4_extended_data=array[0..3,0..3] of extended;
+
+ Tvector2_single=object
+ data:Tvector2_single_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b:single);
+ function length:single;
+ function squared_length:single;
+ end;
+
+ Tvector2_double=object
+ data:Tvector2_double_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b:double);
+ function length:double;
+ function squared_length:double;
+ end;
+
+ Tvector2_extended=object
+ data:Tvector2_extended_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b:extended);
+ function length:extended;
+ function squared_length:extended;
+ end;
+
+ Tvector3_single=object
+ data:Tvector3_single_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b,c:single);
+ function length:single;
+ function squared_length:single;
+ end;
+
+ Tvector3_double=object
+ data:Tvector3_double_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b,c:double);
+ function length:double;
+ function squared_length:double;
+ end;
+
+ Tvector3_extended=object
+ data:Tvector3_extended_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b,c:extended);
+ function length:extended;
+ function squared_length:extended;
+ end;
+
+ Tvector4_single=object
+ data:Tvector4_single_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b,c,d:single);
+ function length:single;
+ function squared_length:single;
+ end;
+
+ Tvector4_double=object
+ data:Tvector4_double_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b,c,d:double);
+ function length:double;
+ function squared_length:double;
+ end;
+
+ Tvector4_extended=object
+ data:Tvector4_extended_data;
+ constructor init_zero;
+ constructor init_one;
+ constructor init(a,b,c,d:extended);
+ function length:extended;
+ function squared_length:extended;
+ end;
+
+ Tmatrix2_single=object
+ data:Tmatrix2_single_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ba,bb:single);
+ function get_column(c:byte):Tvector2_single;
+ function get_row(r:byte):Tvector2_single;
+ procedure set_column(c:byte;const v:Tvector2_single);
+ procedure set_row(r:byte;const v:Tvector2_single);
+ function determinant:single;
+ function inverse(Adeterminant:single):Tmatrix2_single;
+ function transpose:Tmatrix2_single;
+ end;
+
+ Tmatrix2_double=object
+ data:Tmatrix2_double_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ba,bb:double);
+ function get_column(c:byte):Tvector2_double;
+ function get_row(r:byte):Tvector2_double;
+ procedure set_column(c:byte;const v:Tvector2_double);
+ procedure set_row(r:byte;const v:Tvector2_double);
+ function determinant:double;
+ function inverse(Adeterminant:double):Tmatrix2_double;
+ function transpose:Tmatrix2_double;
+ end;
+
+ Tmatrix2_extended=object
+ data:Tmatrix2_extended_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ba,bb:extended);
+ function get_column(c:byte):Tvector2_extended;
+ function get_row(r:byte):Tvector2_extended;
+ procedure set_column(c:byte;const v:Tvector2_extended);
+ procedure set_row(r:byte;const v:Tvector2_extended);
+ function determinant:extended;
+ function inverse(Adeterminant:extended):Tmatrix2_extended;
+ function transpose:Tmatrix2_extended;
+ end;
+
+ Tmatrix3_single=object
+ data:Tmatrix3_single_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ac,ba,bb,bc,ca,cb,cc:single);
+ function get_column(c:byte):Tvector3_single;
+ function get_row(r:byte):Tvector3_single;
+ procedure set_column(c:byte;const v:Tvector3_single);
+ procedure set_row(r:byte;const v:Tvector3_single);
+ function determinant:single;
+ function inverse(Adeterminant:single):Tmatrix3_single;
+ function transpose:Tmatrix3_single;
+ end;
+
+ Tmatrix3_double=object
+ data:Tmatrix3_double_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ac,ba,bb,bc,ca,cb,cc:double);
+ function get_column(c:byte):Tvector3_double;
+ function get_row(r:byte):Tvector3_double;
+ procedure set_column(c:byte;const v:Tvector3_double);
+ procedure set_row(r:byte;const v:Tvector3_double);
+ function determinant:double;
+ function inverse(Adeterminant:double):Tmatrix3_double;
+ function transpose:Tmatrix3_double;
+ end;
+
+ Tmatrix3_extended=object
+ data:Tmatrix3_extended_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ac,ba,bb,bc,ca,cb,cc:extended);
+ function get_column(c:byte):Tvector3_extended;
+ function get_row(r:byte):Tvector3_extended;
+ procedure set_column(c:byte;const v:Tvector3_extended);
+ procedure set_row(r:byte;const v:Tvector3_extended);
+ function determinant:extended;
+ function inverse(Adeterminant:extended):Tmatrix3_extended;
+ function transpose:Tmatrix3_extended;
+ end;
+
+ Tmatrix4_single=object
+ data:Tmatrix4_single_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ac,ad,ba,bb,bc,bd,ca,cb,cc,cd,da,db,dc,dd:single);
+ function get_column(c:byte):Tvector4_single;
+ function get_row(r:byte):Tvector4_single;
+ procedure set_column(c:byte;const v:Tvector4_single);
+ procedure set_row(r:byte;const v:Tvector4_single);
+ function determinant:single;
+ function inverse(Adeterminant:single):Tmatrix4_single;
+ function transpose:Tmatrix4_single;
+ end;
+
+ Tmatrix4_double=object
+ data:Tmatrix4_double_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ac,ad,ba,bb,bc,bd,ca,cb,cc,cd,da,db,dc,dd:double);
+ function get_column(c:byte):Tvector4_double;
+ function get_row(r:byte):Tvector4_double;
+ procedure set_column(c:byte;const v:Tvector4_double);
+ procedure set_row(r:byte;const v:Tvector4_double);
+ function determinant:double;
+ function inverse(Adeterminant:double):Tmatrix4_double;
+ function transpose:Tmatrix4_double;
+ end;
+
+ Tmatrix4_extended=object
+ data:Tmatrix4_extended_data;
+ constructor init_zero;
+ constructor init_identity;
+ constructor init(aa,ab,ac,ad,ba,bb,bc,bd,ca,cb,cc,cd,da,db,dc,dd:extended);
+ function get_column(c:byte):Tvector4_extended;
+ function get_row(r:byte):Tvector4_extended;
+ procedure set_column(c:byte;const v:Tvector4_extended);
+ procedure set_row(r:byte;const v:Tvector4_extended);
+ function determinant:extended;
+ function inverse(Adeterminant:extended):Tmatrix4_extended;
+ function transpose:Tmatrix4_extended;
+ end;
+
+
+{Operators to make different vectors assignable to each other}
+operator := (const v:Tvector2_single) result:Tvector2_double;
+operator := (const v:Tvector2_single) result:Tvector2_extended;
+operator := (const v:Tvector2_double) result:Tvector2_single;
+operator := (const v:Tvector2_double) result:Tvector2_extended;
+operator := (const v:Tvector2_extended) result:Tvector2_single;
+operator := (const v:Tvector2_extended) result:Tvector2_double;
+
+operator := (const v:Tvector2_single) result:Tvector3_single;
+operator := (const v:Tvector2_single) result:Tvector3_double;
+operator := (const v:Tvector2_single) result:Tvector3_extended;
+operator := (const v:Tvector2_double) result:Tvector3_single;
+operator := (const v:Tvector2_double) result:Tvector3_double;
+operator := (const v:Tvector2_double) result:Tvector3_extended;
+operator := (const v:Tvector2_extended) result:Tvector3_single;
+operator := (const v:Tvector2_extended) result:Tvector3_double;
+operator := (const v:Tvector2_extended) result:Tvector3_extended;
+
+operator := (const v:Tvector2_single) result:Tvector4_single;
+operator := (const v:Tvector2_single) result:Tvector4_double;
+operator := (const v:Tvector2_single) result:Tvector4_extended;
+operator := (const v:Tvector2_double) result:Tvector4_single;
+operator := (const v:Tvector2_double) result:Tvector4_double;
+operator := (const v:Tvector2_double) result:Tvector4_extended;
+operator := (const v:Tvector2_extended) result:Tvector4_single;
+operator := (const v:Tvector2_extended) result:Tvector4_double;
+operator := (const v:Tvector2_extended) result:Tvector4_extended;
+
+operator := (const v:Tvector3_single) result:Tvector2_single;
+operator := (const v:Tvector3_single) result:Tvector2_double;
+operator := (const v:Tvector3_single) result:Tvector2_extended;
+operator := (const v:Tvector3_double) result:Tvector2_single;
+operator := (const v:Tvector3_double) result:Tvector2_double;
+operator := (const v:Tvector3_double) result:Tvector2_extended;
+operator := (const v:Tvector3_extended) result:Tvector2_single;
+operator := (const v:Tvector3_extended) result:Tvector2_double;
+operator := (const v:Tvector3_extended) result:Tvector2_extended;
+
+operator := (const v:Tvector3_single) result:Tvector3_double;
+operator := (const v:Tvector3_single) result:Tvector3_extended;
+operator := (const v:Tvector3_double) result:Tvector3_single;
+operator := (const v:Tvector3_double) result:Tvector3_extended;
+operator := (const v:Tvector3_extended) result:Tvector3_single;
+operator := (const v:Tvector3_extended) result:Tvector3_double;
+
+operator := (const v:Tvector3_single) result:Tvector4_single;
+operator := (const v:Tvector3_single) result:Tvector4_double;
+operator := (const v:Tvector3_single) result:Tvector4_extended;
+operator := (const v:Tvector3_double) result:Tvector4_single;
+operator := (const v:Tvector3_double) result:Tvector4_double;
+operator := (const v:Tvector3_double) result:Tvector4_extended;
+operator := (const v:Tvector3_extended) result:Tvector4_single;
+operator := (const v:Tvector3_extended) result:Tvector4_double;
+operator := (const v:Tvector3_extended) result:Tvector4_extended;
+
+operator := (const v:Tvector4_single) result:Tvector2_single;
+operator := (const v:Tvector4_single) result:Tvector2_double;
+operator := (const v:Tvector4_single) result:Tvector2_extended;
+operator := (const v:Tvector4_double) result:Tvector2_single;
+operator := (const v:Tvector4_double) result:Tvector2_double;
+operator := (const v:Tvector4_double) result:Tvector2_extended;
+operator := (const v:Tvector4_extended) result:Tvector2_single;
+operator := (const v:Tvector4_extended) result:Tvector2_double;
+operator := (const v:Tvector4_extended) result:Tvector2_extended;
+
+operator := (const v:Tvector4_single) result:Tvector3_single;
+operator := (const v:Tvector4_single) result:Tvector3_double;
+operator := (const v:Tvector4_single) result:Tvector3_extended;
+operator := (const v:Tvector4_double) result:Tvector3_single;
+operator := (const v:Tvector4_double) result:Tvector3_double;
+operator := (const v:Tvector4_double) result:Tvector3_extended;
+operator := (const v:Tvector4_extended) result:Tvector3_single;
+operator := (const v:Tvector4_extended) result:Tvector3_double;
+operator := (const v:Tvector4_extended) result:Tvector3_extended;
+
+operator := (const v:Tvector4_single) result:Tvector4_double;
+operator := (const v:Tvector4_single) result:Tvector4_extended;
+operator := (const v:Tvector4_double) result:Tvector4_single;
+operator := (const v:Tvector4_double) result:Tvector4_extended;
+operator := (const v:Tvector4_extended) result:Tvector4_single;
+operator := (const v:Tvector4_extended) result:Tvector4_double;
+
+{Vector to vector operations.}
+operator + (const x,y:Tvector2_single) result:Tvector2_single;
+operator + (const x,y:Tvector2_double) result:Tvector2_double;
+operator + (const x,y:Tvector2_extended) result:Tvector2_extended;
+operator + (const x,y:Tvector3_single) result:Tvector3_single;
+operator + (const x,y:Tvector3_double) result:Tvector3_double;
+operator + (const x,y:Tvector3_extended) result:Tvector3_extended;
+operator + (const x,y:Tvector4_single) result:Tvector4_single;
+operator + (const x,y:Tvector4_double) result:Tvector4_double;
+operator + (const x,y:Tvector4_extended) result:Tvector4_extended;
+
+operator - (const x,y:Tvector2_single) result:Tvector2_single;
+operator - (const x,y:Tvector2_double) result:Tvector2_double;
+operator - (const x,y:Tvector2_extended) result:Tvector2_extended;
+operator - (const x,y:Tvector3_single) result:Tvector3_single;
+operator - (const x,y:Tvector3_double) result:Tvector3_double;
+operator - (const x,y:Tvector3_extended) result:Tvector3_extended;
+operator - (const x,y:Tvector4_single) result:Tvector4_single;
+operator - (const x,y:Tvector4_double) result:Tvector4_double;
+operator - (const x,y:Tvector4_extended) result:Tvector4_extended;
+
+operator - (const x:Tvector2_single) result:Tvector2_single;
+operator - (const x:Tvector2_double) result:Tvector2_double;
+operator - (const x:Tvector2_extended) result:Tvector2_extended;
+operator - (const x:Tvector3_single) result:Tvector3_single;
+operator - (const x:Tvector3_double) result:Tvector3_double;
+operator - (const x:Tvector3_extended) result:Tvector3_extended;
+operator - (const x:Tvector4_single) result:Tvector4_single;
+operator - (const x:Tvector4_double) result:Tvector4_double;
+operator - (const x:Tvector4_extended) result:Tvector4_extended;
+
+operator * (const x,y:Tvector2_single) result:Tvector2_single;
+operator * (const x,y:Tvector2_double) result:Tvector2_double;
+operator * (const x,y:Tvector2_extended) result:Tvector2_extended;
+operator * (const x,y:Tvector3_single) result:Tvector3_single;
+operator * (const x,y:Tvector3_double) result:Tvector3_double;
+operator * (const x,y:Tvector3_extended) result:Tvector3_extended;
+operator * (const x,y:Tvector4_single) result:Tvector4_single;
+operator * (const x,y:Tvector4_double) result:Tvector4_double;
+operator * (const x,y:Tvector4_extended) result:Tvector4_extended;
+
+operator ** (const x,y:Tvector2_single) result:single;
+operator ** (const x,y:Tvector2_double) result:double;
+operator ** (const x,y:Tvector2_extended) result:extended;
+operator ** (const x,y:Tvector3_single) result:single;
+operator ** (const x,y:Tvector3_double) result:double;
+operator ** (const x,y:Tvector3_extended) result:extended;
+operator ** (const x,y:Tvector4_single) result:single;
+operator ** (const x,y:Tvector4_double) result:double;
+operator ** (const x,y:Tvector4_extended) result:extended;
+
+operator >< (const x,y:Tvector3_single) result:Tvector3_single;
+operator >< (const x,y:Tvector3_double) result:Tvector3_double;
+operator >< (const x,y:Tvector3_extended) result:Tvector3_extended;
+
+{Vector/scalar operations.}
+operator + (const x:Tvector2_single;y:single) result:Tvector2_single;
+operator + (const x:Tvector2_double;y:double) result:Tvector2_double;
+operator + (const x:Tvector2_extended;y:extended) result:Tvector2_extended;
+operator + (const x:Tvector3_single;y:single) result:Tvector3_single;
+operator + (const x:Tvector3_double;y:double) result:Tvector3_double;
+operator + (const x:Tvector3_extended;y:extended) result:Tvector3_extended;
+operator + (const x:Tvector4_single;y:single) result:Tvector4_single;
+operator + (const x:Tvector4_double;y:double) result:Tvector4_double;
+operator + (const x:Tvector4_extended;y:extended) result:Tvector4_extended;
+
+operator - (const x:Tvector2_single;y:single) result:Tvector2_single;
+operator - (const x:Tvector2_double;y:double) result:Tvector2_double;
+operator - (const x:Tvector2_extended;y:extended) result:Tvector2_extended;
+operator - (const x:Tvector3_single;y:single) result:Tvector3_single;
+operator - (const x:Tvector3_double;y:double) result:Tvector3_double;
+operator - (const x:Tvector3_extended;y:extended) result:Tvector3_extended;
+operator - (const x:Tvector4_single;y:single) result:Tvector4_single;
+operator - (const x:Tvector4_double;y:double) result:Tvector4_double;
+operator - (const x:Tvector4_extended;y:extended) result:Tvector4_extended;
+
+operator * (const x:Tvector2_single;y:single) result:Tvector2_single;
+operator * (const x:Tvector2_double;y:double) result:Tvector2_double;
+operator * (const x:Tvector2_extended;y:extended) result:Tvector2_extended;
+operator * (const x:Tvector3_single;y:single) result:Tvector3_single;
+operator * (const x:Tvector3_double;y:double) result:Tvector3_double;
+operator * (const x:Tvector3_extended;y:extended) result:Tvector3_extended;
+operator * (const x:Tvector4_single;y:single) result:Tvector4_single;
+operator * (const x:Tvector4_double;y:double) result:Tvector4_double;
+operator * (const x:Tvector4_extended;y:extended) result:Tvector4_extended;
+
+operator / (const x:Tvector2_single;y:single) result:Tvector2_single;
+operator / (const x:Tvector2_double;y:double) result:Tvector2_double;
+operator / (const x:Tvector2_extended;y:extended) result:Tvector2_extended;
+operator / (const x:Tvector3_single;y:single) result:Tvector3_single;
+operator / (const x:Tvector3_double;y:double) result:Tvector3_double;
+operator / (const x:Tvector3_extended;y:extended) result:Tvector3_extended;
+operator / (const x:Tvector4_single;y:single) result:Tvector4_single;
+operator / (const x:Tvector4_double;y:double) result:Tvector4_double;
+operator / (const x:Tvector4_extended;y:extended) result:Tvector4_extended;
+
+{Operators to make different matrixes assignable to each other}
+operator := (const v:Tmatrix2_single) result:Tmatrix2_double;
+operator := (const v:Tmatrix2_single) result:Tmatrix2_extended;
+operator := (const v:Tmatrix2_double) result:Tmatrix2_single;
+operator := (const v:Tmatrix2_double) result:Tmatrix2_extended;
+operator := (const v:Tmatrix2_extended) result:Tmatrix2_single;
+operator := (const v:Tmatrix2_extended) result:Tmatrix2_double;
+
+operator := (const v:Tmatrix2_single) result:Tmatrix3_single;
+operator := (const v:Tmatrix2_single) result:Tmatrix3_double;
+operator := (const v:Tmatrix2_single) result:Tmatrix3_extended;
+operator := (const v:Tmatrix2_double) result:Tmatrix3_single;
+operator := (const v:Tmatrix2_double) result:Tmatrix3_double;
+operator := (const v:Tmatrix2_double) result:Tmatrix3_extended;
+operator := (const v:Tmatrix2_extended) result:Tmatrix3_single;
+operator := (const v:Tmatrix2_extended) result:Tmatrix3_double;
+operator := (const v:Tmatrix2_extended) result:Tmatrix3_extended;
+
+operator := (const v:Tmatrix2_single) result:Tmatrix4_single;
+operator := (const v:Tmatrix2_single) result:Tmatrix4_double;
+operator := (const v:Tmatrix2_single) result:Tmatrix4_extended;
+operator := (const v:Tmatrix2_double) result:Tmatrix4_single;
+operator := (const v:Tmatrix2_double) result:Tmatrix4_double;
+operator := (const v:Tmatrix2_double) result:Tmatrix4_extended;
+operator := (const v:Tmatrix2_extended) result:Tmatrix4_single;
+operator := (const v:Tmatrix2_extended) result:Tmatrix4_double;
+operator := (const v:Tmatrix2_extended) result:Tmatrix4_extended;
+
+operator := (const v:Tmatrix3_single) result:Tmatrix2_single;
+operator := (const v:Tmatrix3_single) result:Tmatrix2_double;
+operator := (const v:Tmatrix3_single) result:Tmatrix2_extended;
+operator := (const v:Tmatrix3_double) result:Tmatrix2_single;
+operator := (const v:Tmatrix3_double) result:Tmatrix2_double;
+operator := (const v:Tmatrix3_double) result:Tmatrix2_extended;
+operator := (const v:Tmatrix3_extended) result:Tmatrix2_single;
+operator := (const v:Tmatrix3_extended) result:Tmatrix2_double;
+operator := (const v:Tmatrix3_extended) result:Tmatrix2_extended;
+
+operator := (const v:Tmatrix3_single) result:Tmatrix3_double;
+operator := (const v:Tmatrix3_single) result:Tmatrix3_extended;
+operator := (const v:Tmatrix3_double) result:Tmatrix3_single;
+operator := (const v:Tmatrix3_double) result:Tmatrix3_extended;
+operator := (const v:Tmatrix3_extended) result:Tmatrix3_single;
+operator := (const v:Tmatrix3_extended) result:Tmatrix3_double;
+
+operator := (const v:Tmatrix3_single) result:Tmatrix4_single;
+operator := (const v:Tmatrix3_single) result:Tmatrix4_double;
+operator := (const v:Tmatrix3_single) result:Tmatrix4_extended;
+operator := (const v:Tmatrix3_double) result:Tmatrix4_single;
+operator := (const v:Tmatrix3_double) result:Tmatrix4_double;
+operator := (const v:Tmatrix3_double) result:Tmatrix4_extended;
+operator := (const v:Tmatrix3_extended) result:Tmatrix4_single;
+operator := (const v:Tmatrix3_extended) result:Tmatrix4_double;
+operator := (const v:Tmatrix3_extended) result:Tmatrix4_extended;
+
+operator := (const v:Tmatrix4_single) result:Tmatrix2_single;
+operator := (const v:Tmatrix4_single) result:Tmatrix2_double;
+operator := (const v:Tmatrix4_single) result:Tmatrix2_extended;
+operator := (const v:Tmatrix4_double) result:Tmatrix2_single;
+operator := (const v:Tmatrix4_double) result:Tmatrix2_double;
+operator := (const v:Tmatrix4_double) result:Tmatrix2_extended;
+operator := (const v:Tmatrix4_extended) result:Tmatrix2_single;
+operator := (const v:Tmatrix4_extended) result:Tmatrix2_double;
+operator := (const v:Tmatrix4_extended) result:Tmatrix2_extended;
+
+operator := (const v:Tmatrix4_single) result:Tmatrix3_single;
+operator := (const v:Tmatrix4_single) result:Tmatrix3_double;
+operator := (const v:Tmatrix4_single) result:Tmatrix3_extended;
+operator := (const v:Tmatrix4_double) result:Tmatrix3_single;
+operator := (const v:Tmatrix4_double) result:Tmatrix3_double;
+operator := (const v:Tmatrix4_double) result:Tmatrix3_extended;
+operator := (const v:Tmatrix4_extended) result:Tmatrix3_single;
+operator := (const v:Tmatrix4_extended) result:Tmatrix3_double;
+operator := (const v:Tmatrix4_extended) result:Tmatrix3_extended;
+
+operator := (const v:Tmatrix4_single) result:Tmatrix4_double;
+operator := (const v:Tmatrix4_single) result:Tmatrix4_extended;
+operator := (const v:Tmatrix4_double) result:Tmatrix4_single;
+operator := (const v:Tmatrix4_double) result:Tmatrix4_extended;
+operator := (const v:Tmatrix4_extended) result:Tmatrix4_single;
+operator := (const v:Tmatrix4_extended) result:Tmatrix4_double;
+
+{Matrix to matrix operatons.}
+operator + (const m1,m2:Tmatrix2_single) result:Tmatrix2_single;
+operator + (const m1,m2:Tmatrix2_double) result:Tmatrix2_double;
+operator + (const m1,m2:Tmatrix2_extended) result:Tmatrix2_extended;
+operator + (const m1,m2:Tmatrix3_single) result:Tmatrix3_single;
+operator + (const m1,m2:Tmatrix3_double) result:Tmatrix3_double;
+operator + (const m1,m2:Tmatrix3_extended) result:Tmatrix3_extended;
+operator + (const m1,m2:Tmatrix4_single) result:Tmatrix4_single;
+operator + (const m1,m2:Tmatrix4_double) result:Tmatrix4_double;
+operator + (const m1,m2:Tmatrix4_extended) result:Tmatrix4_extended;
+
+operator - (const m1,m2:Tmatrix2_single) result:Tmatrix2_single;
+operator - (const m1,m2:Tmatrix2_double) result:Tmatrix2_double;
+operator - (const m1,m2:Tmatrix2_extended) result:Tmatrix2_extended;
+operator - (const m1,m2:Tmatrix3_single) result:Tmatrix3_single;
+operator - (const m1,m2:Tmatrix3_double) result:Tmatrix3_double;
+operator - (const m1,m2:Tmatrix3_extended) result:Tmatrix3_extended;
+operator - (const m1,m2:Tmatrix4_single) result:Tmatrix4_single;
+operator - (const m1,m2:Tmatrix4_double) result:Tmatrix4_double;
+operator - (const m1,m2:Tmatrix4_extended) result:Tmatrix4_extended;
+
+operator - (const m1:Tmatrix2_single) result:Tmatrix2_single;
+operator - (const m1:Tmatrix2_double) result:Tmatrix2_double;
+operator - (const m1:Tmatrix2_extended) result:Tmatrix2_extended;
+operator - (const m1:Tmatrix3_single) result:Tmatrix3_single;
+operator - (const m1:Tmatrix3_double) result:Tmatrix3_double;
+operator - (const m1:Tmatrix3_extended) result:Tmatrix3_extended;
+operator - (const m1:Tmatrix4_single) result:Tmatrix4_single;
+operator - (const m1:Tmatrix4_double) result:Tmatrix4_double;
+operator - (const m1:Tmatrix4_extended) result:Tmatrix4_extended;
+
+operator * (const m1,m2:Tmatrix2_single) result:Tmatrix2_single;
+operator * (const m1,m2:Tmatrix2_double) result:Tmatrix2_double;
+operator * (const m1,m2:Tmatrix2_extended) result:Tmatrix2_extended;
+operator * (const m1,m2:Tmatrix3_single) result:Tmatrix3_single;
+operator * (const m1,m2:Tmatrix3_double) result:Tmatrix3_double;
+operator * (const m1,m2:Tmatrix3_extended) result:Tmatrix3_extended;
+operator * (const m1,m2:Tmatrix4_single) result:Tmatrix4_single;
+operator * (const m1,m2:Tmatrix4_double) result:Tmatrix4_double;
+operator * (const m1,m2:Tmatrix4_extended) result:Tmatrix4_extended;
+
+{Matrix/vector operations}
+operator * (const m:Tmatrix2_single;const v:Tvector2_single) result:Tvector2_single;
+operator * (const m:Tmatrix2_double;const v:Tvector2_double) result:Tvector2_double;
+operator * (const m:Tmatrix2_extended;const v:Tvector2_extended) result:Tvector2_extended;
+operator * (const m:Tmatrix3_single;const v:Tvector3_single) result:Tvector3_single;
+operator * (const m:Tmatrix3_double;const v:Tvector3_double) result:Tvector3_double;
+operator * (const m:Tmatrix3_extended;const v:Tvector3_extended) result:Tvector3_extended;
+operator * (const m:Tmatrix4_single;const v:Tvector4_single) result:Tvector4_single;
+operator * (const m:Tmatrix4_double;const v:Tvector4_double) result:Tvector4_double;
+operator * (const m:Tmatrix4_extended;const v:Tvector4_extended) result:Tvector4_extended;
+
+{Matrix/scalar operations}
+operator + (const m:Tmatrix2_single;const x:single) result:Tmatrix2_single;
+operator + (const m:Tmatrix2_double;const x:double) result:Tmatrix2_double;
+operator + (const m:Tmatrix2_extended;const x:extended) result:Tmatrix2_extended;
+operator + (const m:Tmatrix3_single;const x:single) result:Tmatrix3_single;
+operator + (const m:Tmatrix3_double;const x:double) result:Tmatrix3_double;
+operator + (const m:Tmatrix3_extended;const x:extended) result:Tmatrix3_extended;
+operator + (const m:Tmatrix4_single;const x:single) result:Tmatrix4_single;
+operator + (const m:Tmatrix4_double;const x:double) result:Tmatrix4_double;
+operator + (const m:Tmatrix4_extended;const x:extended) result:Tmatrix4_extended;
+
+operator - (const m:Tmatrix2_single;const x:single) result:Tmatrix2_single;
+operator - (const m:Tmatrix2_double;const x:double) result:Tmatrix2_double;
+operator - (const m:Tmatrix2_extended;const x:extended) result:Tmatrix2_extended;
+operator - (const m:Tmatrix3_single;const x:single) result:Tmatrix3_single;
+operator - (const m:Tmatrix3_double;const x:double) result:Tmatrix3_double;
+operator - (const m:Tmatrix3_extended;const x:extended) result:Tmatrix3_extended;
+operator - (const m:Tmatrix4_single;const x:single) result:Tmatrix4_single;
+operator - (const m:Tmatrix4_double;const x:double) result:Tmatrix4_double;
+operator - (const m:Tmatrix4_extended;const x:extended) result:Tmatrix4_extended;
+
+operator * (const m:Tmatrix2_single;const x:single) result:Tmatrix2_single;
+operator * (const m:Tmatrix2_double;const x:double) result:Tmatrix2_double;
+operator * (const m:Tmatrix2_extended;const x:extended) result:Tmatrix2_extended;
+operator * (const m:Tmatrix3_single;const x:single) result:Tmatrix3_single;
+operator * (const m:Tmatrix3_double;const x:double) result:Tmatrix3_double;
+operator * (const m:Tmatrix3_extended;const x:extended) result:Tmatrix3_extended;
+operator * (const m:Tmatrix4_single;const x:single) result:Tmatrix4_single;
+operator * (const m:Tmatrix4_double;const x:double) result:Tmatrix4_double;
+operator * (const m:Tmatrix4_extended;const x:extended) result:Tmatrix4_extended;
+
+operator / (const m:Tmatrix2_single;const x:single) result:Tmatrix2_single;
+operator / (const m:Tmatrix2_double;const x:double) result:Tmatrix2_double;
+operator / (const m:Tmatrix2_extended;const x:extended) result:Tmatrix2_extended;
+operator / (const m:Tmatrix3_single;const x:single) result:Tmatrix3_single;
+operator / (const m:Tmatrix3_double;const x:double) result:Tmatrix3_double;
+operator / (const m:Tmatrix3_extended;const x:extended) result:Tmatrix3_extended;
+operator / (const m:Tmatrix4_single;const x:single) result:Tmatrix4_single;
+operator / (const m:Tmatrix4_double;const x:double) result:Tmatrix4_double;
+operator / (const m:Tmatrix4_extended;const x:extended) result:Tmatrix4_extended;
+
+{*****************************************************************************}
+
+implementation
+
+{*****************************************************************************}
+
+{******************************************************************************
+ Tvector2_single
+******************************************************************************}
+
+{Need to use capitals due to bug in FPC. Bug was fixed in FPC 1.9.3 on
+ 10 Feb. 2004}
+{$DEFINE datatype:=SINGLE}
+{$DEFINE objectname:=Tvector2_single}
+{$DEFINE vecsize:=2}
+{$INFO Compile mvecimp.inc for Tvector2_single}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector2_double
+******************************************************************************}
+
+{$DEFINE datatype:=DOUBLE}
+{$DEFINE objectname:=Tvector2_double}
+{$DEFINE vecsize:=2}
+{$INFO Compile mvecimp.inc for Tvector2_double}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector2_extended
+******************************************************************************}
+
+{$DEFINE datatype:=EXTENDED}
+{$DEFINE objectname:=Tvector2_extended}
+{$DEFINE vecsize:=2}
+{$INFO Compile mvecimp.inc for Tvector2_extended}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector3_single
+******************************************************************************}
+
+{Need to use capitals due to bug in FPC. Bug was fixed in FPC 1.9.3 on
+ 10 Feb. 2004}
+{$DEFINE datatype:=SINGLE}
+{$DEFINE objectname:=Tvector3_single}
+{$DEFINE vecsize:=3}
+{$INFO Compile mvecimp.inc for Tvector3_single}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector3_double
+******************************************************************************}
+
+{$DEFINE datatype:=DOUBLE}
+{$DEFINE objectname:=Tvector3_double}
+{$DEFINE vecsize:=3}
+{$INFO Compile mvecimp.inc for Tvector3_double}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector3_extended
+******************************************************************************}
+
+{$DEFINE datatype:=EXTENDED}
+{$DEFINE objectname:=Tvector3_extended}
+{$DEFINE vecsize:=3}
+{$INFO Compile mvecimp.inc for Tvector3_extended}
+{$i mvecimp.inc}
+
+
+{******************************************************************************
+ Tvector4_single
+******************************************************************************}
+
+{Need to use capitals due to bug in FPC. Bug was fixed in FPC 1.9.3 on
+ 10 Feb. 2004}
+{$DEFINE datatype:=SINGLE}
+{$DEFINE objectname:=Tvector4_single}
+{$DEFINE vecsize:=4}
+{$INFO Compile mvecimp.inc for Tvector4_single}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector4_double
+******************************************************************************}
+
+{$DEFINE datatype:=DOUBLE}
+{$DEFINE objectname:=Tvector4_double}
+{$DEFINE vecsize:=4}
+{$INFO Compile mvecimp.inc for Tvector4_double}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tvector4_extended
+******************************************************************************}
+
+{$DEFINE datatype:=EXTENDED}
+{$DEFINE objectname:=Tvector4_extended}
+{$DEFINE vecsize:=4}
+{$INFO Compile mvecimp.inc for Tvector4_extended}
+{$i mvecimp.inc}
+
+{******************************************************************************
+ Tmatrix2_single
+******************************************************************************}
+
+{$DEFINE datatype:=SINGLE}
+{$DEFINE objectname:=Tmatrix2_single}
+{$DEFINE vectorcompanion:=Tvector2_single}
+{$DEFINE matsize:=2}
+{$INFO Compile mmatimp.inc for Tmatrix2_single}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix2_double
+******************************************************************************}
+
+{$DEFINE datatype:=DOUBLE}
+{$DEFINE objectname:=Tmatrix2_double}
+{$DEFINE vectorcompanion:=Tvector2_double}
+{$DEFINE matsize:=2}
+{$INFO Compile mmatimp.inc for Tmatrix2_double}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix2_extended
+******************************************************************************}
+
+{$DEFINE datatype:=EXTENDED}
+{$DEFINE objectname:=Tmatrix2_extended}
+{$DEFINE vectorcompanion:=Tvector2_extended}
+{$DEFINE matsize:=2}
+{$INFO Compile mmatimp.inc for Tmatrix2_extended}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix3_single
+******************************************************************************}
+
+{$DEFINE datatype:=SINGLE}
+{$DEFINE objectname:=Tmatrix3_single}
+{$DEFINE vectorcompanion:=Tvector3_single}
+{$DEFINE matsize:=3}
+{$INFO Compile mmatimp.inc for Tmatrix3_single}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix3_double
+******************************************************************************}
+
+{$DEFINE datatype:=DOUBLE}
+{$DEFINE objectname:=Tmatrix3_double}
+{$DEFINE vectorcompanion:=Tvector3_double}
+{$DEFINE matsize:=3}
+{$INFO Compile mmatimp.inc for Tmatrix3_double}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix3_extended
+******************************************************************************}
+
+{$DEFINE datatype:=EXTENDED}
+{$DEFINE objectname:=Tmatrix3_extended}
+{$DEFINE vectorcompanion:=Tvector3_extended}
+{$DEFINE matsize:=3}
+{$INFO Compile mmatimp.inc for Tmatrix3_extended}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix4_single
+******************************************************************************}
+
+{$DEFINE datatype:=SINGLE}
+{$DEFINE objectname:=Tmatrix4_single}
+{$DEFINE vectorcompanion:=Tvector4_single}
+{$DEFINE matsize:=4}
+{$INFO Compile mmatimp.inc for Tmatrix4_single}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix4_double
+******************************************************************************}
+
+{$DEFINE datatype:=DOUBLE}
+{$DEFINE objectname:=Tmatrix4_double}
+{$DEFINE vectorcompanion:=Tvector4_double}
+{$DEFINE matsize:=4}
+{$INFO Compile mmatimp.inc for Tmatrix4_double}
+{$i mmatimp.inc}
+
+{******************************************************************************
+ Tmatrix4_extended
+******************************************************************************}
+
+{$DEFINE datatype:=EXTENDED}
+{$DEFINE objectname:=Tmatrix4_extended}
+{$DEFINE vectorcompanion:=Tvector4_extended}
+{$DEFINE matsize:=4}
+{$INFO Compile mmatimp.inc for Tmatrix4_extended}
+{$i mmatimp.inc}
+
+end.
+{$endif VER1_0}
+{
+ $Log: matrix.pp,v $
+ Revision 1.4 2005/02/14 17:13:22 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/mmatimp.inc b/rtl/inc/mmatimp.inc
new file mode 100644
index 0000000000..156c356385
--- /dev/null
+++ b/rtl/inc/mmatimp.inc
@@ -0,0 +1,903 @@
+{*****************************************************************************
+ Methods of the matrix object
+*****************************************************************************}
+constructor objectname.init_zero;
+
+begin
+ fillchar(data,sizeof(data),0);
+end;
+
+constructor objectname.init_identity;
+
+begin
+ fillchar(data,sizeof(data),0);
+ data[0,0]:=1;
+ data[1,1]:=1;
+{$if matsize>=3}
+ data[2,2]:=1;
+{$endif}
+{$if matsize>=4}
+ data[3,3]:=1;
+{$endif}
+end;
+
+constructor objectname.init(aa
+ ,ab
+ {$if matsize>=3},ac{$endif}
+ {$if matsize>=4},ad{$endif}
+ ,ba
+ ,bb
+ {$if matsize>=3},bc{$endif}
+ {$if matsize>=4},bd{$endif}
+{$if matsize>=3}
+ ,ca
+ ,cb
+ ,cc
+ {$if matsize>=4},cd{$endif}
+{$endif}
+{$if matsize>=4}
+ ,da
+ ,db
+ ,dc
+ ,dd
+{$endif}:datatype);
+
+begin
+ data[0,0]:=aa;
+ data[0,1]:=ab;
+ {$if matsize>=3}data[0,2]:=ac;{$endif}
+ {$if matsize>=4}data[0,3]:=ad;{$endif}
+ data[1,0]:=ba;
+ data[1,1]:=bb;
+ {$if matsize>=3}data[1,2]:=bc;{$endif}
+ {$if matsize>=4}data[1,3]:=bd;{$endif}
+{$if matsize>=3}
+ data[2,0]:=ca;
+ data[2,1]:=cb;
+ data[2,2]:=cc;
+ {$if matsize>=4}data[2,3]:=cd;{$endif}
+{$endif}
+{$if matsize>=4}
+ data[3,0]:=da;
+ data[3,1]:=db;
+ data[3,2]:=dc;
+ data[3,3]:=dd;
+{$endif}
+end;
+
+function objectname.get_column(c:byte):vectorcompanion;
+
+begin
+ get_column.data[0]:=data[0,c];
+ get_column.data[1]:=data[1,c];
+{$if matsize>=3}
+ get_column.data[2]:=data[2,c];
+{$endif}
+{$if matsize>=4}
+ get_column.data[3]:=data[3,c];
+{$endif}
+end;
+
+function objectname.get_row(r:byte):vectorcompanion;
+
+begin
+ get_row.data:=data[r];
+end;
+
+procedure objectname.set_column(c:byte;const v:vectorcompanion);
+
+begin
+ data[0,c]:=v.data[0];
+ data[1,c]:=v.data[1];
+{$if matsize>=3}
+ data[2,c]:=v.data[2];
+{$endif}
+{$if matsize>=4}
+ data[3,c]:=v.data[3];
+{$endif}
+end;
+
+procedure objectname.set_row(r:byte;const v:vectorcompanion);
+
+begin
+ data[r]:=v.data;
+end;
+
+function objectname.transpose:objectname;
+
+begin
+ transpose.data[0,0]:=data[0,0];
+ transpose.data[0,1]:=data[1,0];
+{$if matsize>=3}
+ transpose.data[0,2]:=data[2,0];
+{$endif}
+{$if matsize>=4}
+ transpose.data[0,3]:=data[3,0];
+{$endif}
+ transpose.data[1,0]:=data[0,1];
+ transpose.data[1,1]:=data[1,1];
+{$if matsize>=3}
+ transpose.data[1,2]:=data[2,1];
+{$endif}
+{$if matsize>=4}
+ transpose.data[1,3]:=data[3,1];
+{$endif}
+{$if matsize>=3}
+ transpose.data[2,0]:=data[0,2];
+ transpose.data[2,1]:=data[1,2];
+ transpose.data[2,2]:=data[2,2];
+{$endif}
+{$if matsize>=4}
+ transpose.data[2,3]:=data[3,2];
+ transpose.data[3,0]:=data[0,3];
+ transpose.data[3,1]:=data[1,3];
+ transpose.data[3,2]:=data[2,3];
+ transpose.data[3,3]:=data[3,3];
+{$endif}
+end;
+
+{$if matsize=2}
+function objectname.determinant:datatype;
+
+begin
+ determinant:=data[0,0]*data[1,1]-data[0,1]*data[1,0];
+end;
+{$endif}
+
+{$if matsize=3}
+function objectname.determinant:datatype;
+
+begin
+ determinant:=data[0,0]*(data[1,1]*data[2,2]-data[1,2]*data[2,1])-
+ data[0,1]*(data[1,0]*data[2,2]-data[1,2]*data[2,0])+
+ data[0,2]*(data[1,0]*data[2,1]-data[1,1]*data[2,0]);
+end;
+{$endif}
+
+{$if matsize=4}
+function objectname.determinant:datatype;
+
+begin
+ determinant:=(data[0,0]*data[1,1]-data[0,1]*data[1,0])*(data[2,2]*data[3,3]-data[2,3]*data[3,2])-
+ (data[0,0]*data[1,2]-data[0,2]*data[1,0])*(data[2,1]*data[3,3]-data[2,3]*data[3,1])+
+ (data[0,0]*data[1,3]-data[0,3]*data[1,0])*(data[2,1]*data[3,2]-data[2,2]*data[3,1])+
+ (data[0,1]*data[1,2]-data[0,2]*data[1,1])*(data[2,0]*data[3,3]-data[2,3]*data[3,0])-
+ (data[0,1]*data[1,3]-data[0,3]*data[1,1])*(data[2,0]*data[3,2]-data[2,2]*data[3,0])+
+ (data[0,2]*data[1,3]-data[0,3]*data[1,2])*(data[2,0]*data[3,1]-data[2,1]*data[3,0]);
+end;
+{$endif}
+
+{$if matsize=2}
+function objectname.inverse(Adeterminant:datatype):objectname;
+
+begin
+ Adeterminant:=1/Adeterminant;
+ inverse.data[0,0]:=data[1,1]*Adeterminant;
+ inverse.data[0,1]:=-data[0,1]*Adeterminant;
+ inverse.data[1,0]:=-data[1,0]*Adeterminant;
+ inverse.data[1,1]:=data[0,0]*Adeterminant;
+end;
+{$endif}
+
+{$if matsize=3}
+function objectname.inverse(Adeterminant:datatype):objectname;
+
+begin
+ Adeterminant:=1/Adeterminant;
+ inverse.data[0,0]:=(data[1,1]*data[2,2]-data[2,1]*data[1,2])*Adeterminant;
+ inverse.data[0,1]:=-(data[1,0]*data[2,2]-data[2,0]*data[1,2])*Adeterminant;
+ inverse.data[0,2]:=(data[1,0]*data[2,1]-data[2,0]*data[1,1])*Adeterminant;
+ inverse.data[1,0]:=-(data[0,1]*data[2,2]-data[2,1]*data[0,2])*Adeterminant;
+ inverse.data[1,1]:=(data[0,0]*data[2,2]-data[2,0]*data[0,2])*Adeterminant;
+ inverse.data[1,2]:=-(data[0,0]*data[2,1]-data[2,0]*data[0,1])*Adeterminant;
+ inverse.data[2,0]:=(data[0,1]*data[1,2]-data[1,1]*data[0,2])*Adeterminant;
+ inverse.data[2,1]:=-(data[0,0]*data[1,2]-data[1,0]*data[0,2])*Adeterminant;
+ inverse.data[2,2]:=(data[0,0]*data[1,1]-data[1,0]*data[0,1])*Adeterminant;
+end;
+{$endif}
+
+{$if matsize=4}
+function objectname.inverse(Adeterminant:datatype):objectname;
+
+begin
+ Adeterminant:=1/Adeterminant;
+ inverse.data[0,0]:=Adeterminant*(data[1,1]*(data[2,2]*data[3,3]-data[2,3]*data[3,2])+
+ data[1,2]*(data[2,3]*data[3,1]-data[2,1]*data[3,3])+
+ data[1,3]*(data[2,1]*data[3,2]-data[2,2]*data[3,1]));
+ inverse.data[0,1]:=Adeterminant*(data[2,1]*(data[0,2]*data[3,3]-data[0,3]*data[3,2])+
+ data[2,2]*(data[0,3]*data[3,1]-data[0,1]*data[3,3])+
+ data[2,3]*(data[0,1]*data[3,2]-data[0,2]*data[3,1]));
+ inverse.data[0,2]:=Adeterminant*(data[3,1]*(data[0,2]*data[1,3]-data[0,3]*data[1,2])+
+ data[3,2]*(data[0,3]*data[1,1]-data[0,1]*data[1,3])+
+ data[3,3]*(data[0,1]*data[1,2]-data[0,2]*data[1,1]));
+ inverse.data[0,3]:=Adeterminant*(data[0,1]*(data[1,3]*data[2,2]-data[1,2]*data[2,3])+
+ data[0,2]*(data[1,1]*data[2,3]-data[1,3]*data[2,1])+
+ data[0,3]*(data[1,2]*data[2,1]-data[1,1]*data[2,2]));
+ inverse.data[1,0]:=Adeterminant*(data[1,2]*(data[2,0]*data[3,3]-data[2,3]*data[3,0])+
+ data[1,3]*(data[2,2]*data[3,0]-data[2,0]*data[3,2])+
+ data[1,0]*(data[2,3]*data[3,2]-data[2,2]*data[3,3]));
+ inverse.data[1,1]:=Adeterminant*(data[2,2]*(data[0,0]*data[3,3]-data[0,3]*data[3,0])+
+ data[2,3]*(data[0,2]*data[3,0]-data[0,0]*data[3,2])+
+ data[2,0]*(data[0,3]*data[3,2]-data[0,2]*data[3,3]));
+ inverse.data[1,2]:=Adeterminant*(data[3,2]*(data[0,0]*data[1,3]-data[0,3]*data[1,0])+
+ data[3,3]*(data[0,2]*data[1,0]-data[0,0]*data[1,2])+
+ data[3,0]*(data[0,3]*data[1,2]-data[0,2]*data[1,3]));
+ inverse.data[1,3]:=Adeterminant*(data[0,2]*(data[1,3]*data[2,0]-data[1,0]*data[2,3])+
+ data[0,3]*(data[1,0]*data[2,2]-data[1,2]*data[2,0])+
+ data[0,0]*(data[1,2]*data[2,3]-data[1,3]*data[2,2]));
+ inverse.data[2,0]:=Adeterminant*(data[1,3]*(data[2,0]*data[3,1]-data[2,1]*data[3,0])+
+ data[1,0]*(data[2,1]*data[3,3]-data[2,3]*data[3,1])+
+ data[1,1]*(data[2,3]*data[3,0]-data[2,0]*data[3,3]));
+ inverse.data[2,1]:=Adeterminant*(data[2,3]*(data[0,0]*data[3,1]-data[0,1]*data[3,0])+
+ data[2,0]*(data[0,1]*data[3,3]-data[0,3]*data[3,1])+
+ data[2,1]*(data[0,3]*data[3,0]-data[0,0]*data[3,3]));
+ inverse.data[2,2]:=Adeterminant*(data[3,3]*(data[0,0]*data[1,1]-data[0,1]*data[1,0])+
+ data[3,0]*(data[0,1]*data[1,3]-data[0,3]*data[1,1])+
+ data[3,1]*(data[0,3]*data[1,0]-data[0,0]*data[1,3]));
+ inverse.data[2,3]:=Adeterminant*(data[0,3]*(data[1,1]*data[2,0]-data[1,0]*data[2,1])+
+ data[0,0]*(data[1,3]*data[2,1]-data[1,1]*data[2,3])+
+ data[0,1]*(data[1,0]*data[2,3]-data[1,3]*data[2,0]));
+ inverse.data[3,0]:=Adeterminant*(data[1,0]*(data[2,2]*data[3,1]-data[2,1]*data[3,2])+
+ data[1,1]*(data[2,0]*data[3,2]-data[2,2]*data[3,0])+
+ data[1,2]*(data[2,1]*data[3,0]-data[2,0]*data[3,1]));
+ inverse.data[3,1]:=Adeterminant*(data[2,0]*(data[0,2]*data[3,1]-data[0,1]*data[3,2])+
+ data[2,1]*(data[0,0]*data[3,2]-data[0,2]*data[3,0])+
+ data[2,2]*(data[0,1]*data[3,0]-data[0,0]*data[3,1]));
+ inverse.data[3,2]:=Adeterminant*(data[3,0]*(data[0,2]*data[1,1]-data[0,1]*data[1,2])+
+ data[3,1]*(data[0,0]*data[1,2]-data[0,2]*data[1,0])+
+ data[3,2]*(data[0,1]*data[1,0]-data[0,0]*data[1,1]));
+ inverse.data[3,3]:=Adeterminant*(data[0,0]*(data[1,1]*data[2,2]-data[1,2]*data[2,1])+
+ data[0,1]*(data[1,2]*data[2,0]-data[1,0]*data[2,2])+
+ data[0,2]*(data[1,0]*data[2,1]-data[1,1]*data[2,0]));
+end;
+{$endif}
+
+{*****************************************************************************
+ Conversion from matrix2
+*****************************************************************************}
+
+
+{$if (matsize<>2) or (datatype<>single)}
+operator := (const v:Tmatrix2_single) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=0;
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=0;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=0;
+ result.data[2,1]:=0;
+ result.data[2,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=0;
+ result.data[3,0]:=0;
+ result.data[3,1]:=0;
+ result.data[3,2]:=0;
+ result.data[3,3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (matsize<>2) or (datatype<>double)}
+operator := (const v:Tmatrix2_double) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=0;
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=0;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=0;
+ result.data[2,1]:=0;
+ result.data[2,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=0;
+ result.data[3,0]:=0;
+ result.data[3,1]:=0;
+ result.data[3,2]:=0;
+ result.data[3,3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (matsize<>2) or (datatype<>extended)}
+operator := (const v:Tmatrix2_extended) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=0;
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=0;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=0;
+ result.data[2,1]:=0;
+ result.data[2,2]:=0;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=0;
+ result.data[3,0]:=0;
+ result.data[3,1]:=0;
+ result.data[3,2]:=0;
+ result.data[3,3]:=0;
+{$endif}
+end;
+{$endif}
+
+{*****************************************************************************
+ Conversion from matrix3
+*****************************************************************************}
+
+{$if (matsize<>3) or (datatype<>single)}
+operator := (const v:Tmatrix3_single) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=v.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=0;
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=v.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=0;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=v.data[2,0];
+ result.data[2,1]:=v.data[2,1];
+ result.data[2,2]:=v.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=0;
+ result.data[3,0]:=0;
+ result.data[3,1]:=0;
+ result.data[3,2]:=0;
+ result.data[3,3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (matsize<>3) or (datatype<>double)}
+operator := (const v:Tmatrix3_double) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=v.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=0;
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=v.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=0;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=v.data[2,0];
+ result.data[2,1]:=v.data[2,1];
+ result.data[2,2]:=v.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=0;
+ result.data[3,0]:=0;
+ result.data[3,1]:=0;
+ result.data[3,2]:=0;
+ result.data[3,3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (matsize<>3) or (datatype<>extended)}
+operator := (const v:Tmatrix3_extended) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=v.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=0;
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=v.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=0;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=v.data[2,0];
+ result.data[2,1]:=v.data[2,1];
+ result.data[2,2]:=v.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=0;
+ result.data[3,0]:=0;
+ result.data[3,1]:=0;
+ result.data[3,2]:=0;
+ result.data[3,3]:=0;
+{$endif}
+end;
+{$endif}
+
+{*****************************************************************************
+ Conversion from matrix4
+*****************************************************************************}
+
+{$if (matsize<>4) or (datatype<>single)}
+operator := (const v:Tmatrix4_single) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=v.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=v.data[0,3];
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=v.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=v.data[1,3];
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=v.data[2,0];
+ result.data[2,1]:=v.data[2,1];
+ result.data[2,2]:=v.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=v.data[2,3];
+ result.data[3,0]:=v.data[3,0];
+ result.data[3,1]:=v.data[3,1];
+ result.data[3,2]:=v.data[3,2];
+ result.data[3,3]:=v.data[3,3];
+{$endif}
+end;
+{$endif}
+
+{$if (matsize<>4) or (datatype<>double)}
+operator := (const v:Tmatrix4_double) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=v.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=v.data[0,3];
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=v.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=v.data[1,3];
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=v.data[2,0];
+ result.data[2,1]:=v.data[2,1];
+ result.data[2,2]:=v.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=v.data[2,3];
+ result.data[3,0]:=v.data[3,0];
+ result.data[3,1]:=v.data[3,1];
+ result.data[3,2]:=v.data[3,2];
+ result.data[3,3]:=v.data[3,3];
+{$endif}
+end;
+{$endif}
+
+{$if (matsize<>4) or (datatype<>extended)}
+operator := (const v:Tmatrix4_extended) result:objectname;
+
+begin
+ result.data[0,0]:=v.data[0,0];
+ result.data[0,1]:=v.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=v.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=v.data[0,3];
+{$endif}
+ result.data[1,0]:=v.data[1,0];
+ result.data[1,1]:=v.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=v.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=v.data[1,3];
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=v.data[2,0];
+ result.data[2,1]:=v.data[2,1];
+ result.data[2,2]:=v.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=v.data[2,3];
+ result.data[3,0]:=v.data[3,0];
+ result.data[3,1]:=v.data[3,1];
+ result.data[3,2]:=v.data[3,2];
+ result.data[3,3]:=v.data[3,3];
+{$endif}
+end;
+{$endif}
+
+{*****************************************************************************
+ Matrix to matrix operations
+*****************************************************************************}
+
+operator + (const m1,m2:objectname) result:objectname;
+
+{Add the elements of a matrix to each other.}
+
+begin
+ result.data[0,0]:=m1.data[0,0]+m2.data[0,0];
+ result.data[0,1]:=m1.data[0,1]+m2.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=m1.data[0,2]+m2.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=m1.data[0,3]+m2.data[0,3];
+{$endif}
+ result.data[1,0]:=m1.data[1,0]+m2.data[1,0];
+ result.data[1,1]:=m1.data[1,1]+m2.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=m1.data[1,2]+m2.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=m1.data[1,3]+m2.data[1,3];
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=m1.data[2,0]+m2.data[2,0];
+ result.data[2,1]:=m1.data[2,1]+m2.data[2,1];
+ result.data[2,2]:=m1.data[2,2]+m2.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=m1.data[2,3]+m2.data[2,3];
+ result.data[3,0]:=m1.data[3,0]+m2.data[3,0];
+ result.data[3,1]:=m1.data[3,1]+m2.data[3,1];
+ result.data[3,2]:=m1.data[3,2]+m2.data[3,2];
+ result.data[3,3]:=m1.data[3,3]+m2.data[3,3];
+{$endif}
+end;
+
+operator - (const m1,m2:objectname) result:objectname;
+
+{Subtract the elements of two matrixes from each other.}
+
+begin
+ result.data[0,0]:=m1.data[0,0]-m2.data[0,0];
+ result.data[0,1]:=m1.data[0,1]-m2.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=m1.data[0,2]-m2.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=m1.data[0,3]-m2.data[0,3];
+{$endif}
+ result.data[1,0]:=m1.data[1,0]-m2.data[1,0];
+ result.data[1,1]:=m1.data[1,1]-m2.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=m1.data[1,2]-m2.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=m1.data[1,3]-m2.data[1,3];
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=m1.data[2,0]-m2.data[2,0];
+ result.data[2,1]:=m1.data[2,1]-m2.data[2,1];
+ result.data[2,2]:=m1.data[2,2]-m2.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=m1.data[2,3]-m2.data[2,3];
+ result.data[3,0]:=m1.data[3,0]-m2.data[3,0];
+ result.data[3,1]:=m1.data[3,1]-m2.data[3,1];
+ result.data[3,2]:=m1.data[3,2]-m2.data[3,2];
+ result.data[3,3]:=m1.data[3,3]-m2.data[3,3];
+{$endif}
+end;
+
+operator - (const m1:objectname) result:objectname;
+
+{Negate the elements of a matrix.}
+
+begin
+ result.data[0,0]:=-m1.data[0,0];
+ result.data[0,1]:=-m1.data[0,1];
+{$if matsize>=3}
+ result.data[0,2]:=-m1.data[0,2];
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=-m1.data[0,3];
+{$endif}
+ result.data[1,0]:=-m1.data[1,0];
+ result.data[1,1]:=-m1.data[1,1];
+{$if matsize>=3}
+ result.data[1,2]:=-m1.data[1,2];
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=-m1.data[1,3];
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=-m1.data[2,0];
+ result.data[2,1]:=-m1.data[2,1];
+ result.data[2,2]:=-m1.data[2,2];
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=-m1.data[2,3];
+ result.data[3,0]:=-m1.data[3,0];
+ result.data[3,1]:=-m1.data[3,1];
+ result.data[3,2]:=-m1.data[3,2];
+ result.data[3,3]:=-m1.data[3,3];
+{$endif}
+end;
+
+operator * (const m1,m2:objectname) result:objectname;
+
+{Multiply two matrixes.}
+
+var r:array[0..matsize-1] of datatype;
+ i:byte;
+
+begin
+ for i:=0 to matsize-1 do
+ begin
+ r:=m1.data[i];
+ result.data[i,0]:=r[0]*m2.data[0,0]
+ +r[1]*m2.data[1,0]
+ {$if matsize>=3}+r[2]*m2.data[2,0]{$endif}
+ {$if matsize>=4}+r[3]*m2.data[3,0]{$endif};
+ result.data[i,1]:=r[0]*m2.data[0,1]
+ +r[1]*m2.data[1,1]
+ {$if matsize>=3}+r[2]*m2.data[2,1]{$endif}
+ {$if matsize>=4}+r[3]*m2.data[3,1]{$endif};
+ {$if matsize>=3}
+ result.data[i,2]:=r[0]*m2.data[0,2]
+ +r[1]*m2.data[1,2]
+ +r[2]*m2.data[2,2]
+ {$if matsize>=4}+r[3]*m2.data[3,2]{$endif};
+ {$endif}
+ {$if matsize>=4}
+ result.data[i,3]:=r[0]*m2.data[0,3]
+ +r[1]*m2.data[1,3]
+ +r[2]*m2.data[2,3]
+ +r[3]*m2.data[3,3];
+ {$endif}
+ end;
+end;
+
+{*****************************************************************************
+ Vector/matrix operations
+*****************************************************************************}
+
+operator * (const m:objectname;const v:vectorcompanion) result:vectorcompanion;
+
+{Multiplies a matrix with a vector.}
+
+begin
+ result.data[0]:=m.data[0,0]*v.data[0]
+ +m.data[1,0]*v.data[1]
+ {$if matsize>=3}+m.data[2,0]*v.data[2]{$endif}
+ {$if matsize>=4}+m.data[3,0]*v.data[3]{$endif};
+ result.data[1]:=m.data[0,1]*v.data[0]
+ +m.data[1,1]*v.data[1]
+ {$if matsize>=3}+m.data[2,1]*v.data[2]{$endif}
+ {$if matsize>=4}+m.data[3,1]*v.data[3]{$endif};
+{$if matsize>=3}
+ result.data[2]:=m.data[0,2]*v.data[0]
+ +m.data[1,2]*v.data[1]
+ +m.data[2,2]*v.data[2]
+ {$if matsize>=4}+m.data[3,2]*v.data[3]{$endif};
+{$endif}
+{$if matsize>=4}
+ result.data[3]:=m.data[0,3]*v.data[0]
+ +m.data[1,3]*v.data[1]
+ +m.data[2,3]*v.data[2]
+ +m.data[3,3]*v.data[3];
+{$endif}
+end;
+
+{*****************************************************************************
+ Matrix/scalar operations
+*****************************************************************************}
+
+operator + (const m:objectname;const x:datatype) result:objectname;
+
+{Adds to the elements of a matrix.}
+
+begin
+ result.data[0,0]:=m.data[0,0]+x;
+ result.data[0,1]:=m.data[0,1]+x;
+{$if matsize>=3}
+ result.data[0,2]:=m.data[0,2]+x;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=m.data[0,3]+x;
+{$endif}
+ result.data[1,0]:=m.data[1,0]+x;
+ result.data[1,1]:=m.data[1,1]+x;
+{$if matsize>=3}
+ result.data[1,2]:=m.data[1,2]+x;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=m.data[1,3]+x;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=m.data[2,0]+x;
+ result.data[2,1]:=m.data[2,1]+x;
+ result.data[2,2]:=m.data[2,2]+x;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=m.data[2,3]+x;
+ result.data[3,0]:=m.data[3,0]+x;
+ result.data[3,1]:=m.data[3,1]+x;
+ result.data[3,2]:=m.data[3,2]+x;
+ result.data[3,3]:=m.data[3,3]+x;
+{$endif}
+end;
+
+operator - (const m:objectname;const x:datatype) result:objectname;
+
+{Subtracts from the elements of a matrix.}
+
+begin
+ result.data[0,0]:=m.data[0,0]-x;
+ result.data[0,1]:=m.data[0,1]-x;
+{$if matsize>=3}
+ result.data[0,2]:=m.data[0,2]-x;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=m.data[0,3]-x;
+{$endif}
+ result.data[1,0]:=m.data[1,0]-x;
+ result.data[1,1]:=m.data[1,1]-x;
+{$if matsize>=3}
+ result.data[1,2]:=m.data[1,2]-x;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=m.data[1,3]-x;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=m.data[2,0]-x;
+ result.data[2,1]:=m.data[2,1]-x;
+ result.data[2,2]:=m.data[2,2]-x;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=m.data[2,3]-x;
+ result.data[3,0]:=m.data[3,0]-x;
+ result.data[3,1]:=m.data[3,1]-x;
+ result.data[3,2]:=m.data[3,2]-x;
+ result.data[3,3]:=m.data[3,3]-x;
+{$endif}
+end;
+
+operator * (const m:objectname;const x:datatype) result:objectname;
+
+{Multiplies the elements of a matrix.}
+
+begin
+ result.data[0,0]:=m.data[0,0]*x;
+ result.data[0,1]:=m.data[0,1]*x;
+{$if matsize>=3}
+ result.data[0,2]:=m.data[0,2]*x;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=m.data[0,3]*x;
+{$endif}
+ result.data[1,0]:=m.data[1,0]*x;
+ result.data[1,1]:=m.data[1,1]*x;
+{$if matsize>=3}
+ result.data[1,2]:=m.data[1,2]*x;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=m.data[1,3]*x;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=m.data[2,0]*x;
+ result.data[2,1]:=m.data[2,1]*x;
+ result.data[2,2]:=m.data[2,2]*x;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=m.data[2,3]*x;
+ result.data[3,0]:=m.data[3,0]*x;
+ result.data[3,1]:=m.data[3,1]*x;
+ result.data[3,2]:=m.data[3,2]*x;
+ result.data[3,3]:=m.data[3,3]*x;
+{$endif}
+end;
+
+operator / (const m:objectname;const x:datatype) result:objectname;
+
+{Divides the elements of a matrix.
+
+ In most cases, you will want to avoid this and multiply by the inverse.
+ In case you need to preserve accuracy, dividing might be better though.}
+
+begin
+ result.data[0,0]:=m.data[0,0]/x;
+ result.data[0,1]:=m.data[0,1]/x;
+{$if matsize>=3}
+ result.data[0,2]:=m.data[0,2]/x;
+{$endif}
+{$if matsize>=4}
+ result.data[0,3]:=m.data[0,3]/x;
+{$endif}
+ result.data[1,0]:=m.data[1,0]/x;
+ result.data[1,1]:=m.data[1,1]/x;
+{$if matsize>=3}
+ result.data[1,2]:=m.data[1,2]/x;
+{$endif}
+{$if matsize>=4}
+ result.data[1,3]:=m.data[1,3]/x;
+{$endif}
+{$if matsize>=3}
+ result.data[2,0]:=m.data[2,0]/x;
+ result.data[2,1]:=m.data[2,1]/x;
+ result.data[2,2]:=m.data[2,2]/x;
+{$endif}
+{$if matsize>=4}
+ result.data[2,3]:=m.data[2,3]/x;
+ result.data[3,0]:=m.data[3,0]/x;
+ result.data[3,1]:=m.data[3,1]/x;
+ result.data[3,2]:=m.data[3,2]/x;
+ result.data[3,3]:=m.data[3,3]/x;
+{$endif}
+end;
+
diff --git a/rtl/inc/mouse.inc b/rtl/inc/mouse.inc
new file mode 100644
index 0000000000..21aecf5d27
--- /dev/null
+++ b/rtl/inc/mouse.inc
@@ -0,0 +1,216 @@
+{
+ $Id: mouse.inc,v 1.7 2005/02/14 17:13:25 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Var
+ CurrentMouseDriver : TMouseDriver;
+ MouseInitialized : Boolean;
+
+ // Mouse queue event mechanism
+ PendingMouseEvent : array[0..MouseEventBufSize-1] of TMouseEvent;
+ PendingMouseHead,
+ PendingMouseTail : PMouseEvent;
+ PendingMouseEvents : byte;
+ LastMouseEvent : TMouseEvent;
+
+Procedure ClearMouseEventQueue;
+
+begin
+ PendingMouseHead:=@PendingMouseEvent;
+ PendingMouseTail:=@PendingMouseEvent;
+ PendingMouseEvents:=0;
+ FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
+end;
+
+
+procedure InitMouse;
+
+begin
+ If Not MouseInitialized then
+ begin
+ If Assigned(CurrentMouseDriver.InitDriver) Then
+ CurrentMouseDriver.InitDriver();
+ ClearMouseEventQueue;
+ MouseInitialized:=True;
+ end;
+end;
+
+procedure DoneMouse;
+
+begin
+ If MouseInitialized then
+ begin
+ If Assigned(CurrentMouseDriver.DoneDriver) Then
+ CurrentMouseDriver.DoneDriver();
+ ClearMouseEventQueue;
+ MouseInitialized:=False;
+ end;
+end;
+
+function DetectMouse:byte;
+
+begin
+ If Assigned(CurrentMouseDriver.DetectMouse) Then
+ DetectMouse:=CurrentMouseDriver.DetectMouse()
+ else
+ DetectMouse:=0;
+end;
+
+procedure ShowMouse;
+
+begin
+ If Assigned(CurrentMouseDriver.ShowMouse) Then
+ CurrentMouseDriver.ShowMouse();
+end;
+
+procedure HideMouse;
+
+begin
+ If Assigned(CurrentMouseDriver.HideMouse) Then
+ CurrentMouseDriver.HideMouse();
+end;
+
+function GetMouseX:word;
+
+begin
+ If Assigned(CurrentMouseDriver.GetMouseX) Then
+ GetMouseX:=CurrentMouseDriver.GetMouseX()
+ else
+ GetMouseX:=0;
+end;
+
+function GetMouseY:word;
+
+begin
+ If Assigned(CurrentMouseDriver.GetMouseY) Then
+ GetMouseY:=CurrentMouseDriver.GetMouseY()
+ else
+ GetMouseY:=0;
+end;
+
+function GetMouseButtons:word;
+
+begin
+ If Assigned(CurrentMouseDriver.GetMouseButtons) Then
+ GetMouseButtons:=CurrentMouseDriver.GetMouseButtons()
+ else
+ GetMouseButtons:=0;
+end;
+
+procedure SetMouseXY(x,y:word);
+
+begin
+ If Assigned(CurrentMouseDriver.SetMouseXY) Then
+ CurrentMouseDriver.SetMouseXY(X,Y)
+end;
+
+Procedure GetPendingEvent(Var MouseEvent:TMouseEvent);
+
+begin
+ MouseEvent:=PendingMouseHead^;
+ inc(PendingMouseHead);
+ if PtrInt(PendingMouseHead)=Ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+ PendingMouseHead:=@PendingMouseEvent;
+ dec(PendingMouseEvents);
+ if (LastMouseEvent.x<>MouseEvent.x) or
+ (LastMouseEvent.y<>MouseEvent.y) then
+ MouseEvent.Action:=MouseActionMove;
+ if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
+ begin
+ if (LastMouseEvent.Buttons=0) then
+ MouseEvent.Action:=MouseActionDown
+ else
+ MouseEvent.Action:=MouseActionUp;
+ end;
+ LastMouseEvent:=MouseEvent;
+end;
+
+procedure GetMouseEvent(var MouseEvent:TMouseEvent);
+
+begin
+ if CurrentMouseDriver.UseDefaultQueue then
+ begin
+ if (PendingMouseEvents>0) then
+ GetPendingEvent(MouseEvent)
+ else
+ FillChar(MouseEvent,sizeof(MouseEvent),0);
+ end
+ else
+ If Assigned(CurrentMouseDriver.GetMouseEvent) Then
+ begin
+ CurrentMouseDriver.GetMouseEvent(MouseEvent);
+ LastMouseEvent:=MouseEvent;
+ end
+ else
+ FillChar(MouseEvent,sizeof(TMouseEvent),0);
+end;
+
+procedure PutMouseEvent(const MouseEvent: TMouseEvent);
+begin
+ if CurrentMouseDriver.UseDefaultQueue then
+ begin
+ PendingMouseTail^:=MouseEvent;
+ inc(PendingMouseTail);
+ if PtrInt(PendingMouseTail)=Ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+ PendingMouseTail:=@PendingMouseEvent;
+ inc(PendingMouseEvents);
+ end
+ else
+ If Assigned(CurrentMouseDriver.PutMouseEvent) then
+ CurrentMouseDriver.PutMouseEvent(MouseEvent);
+end;
+
+function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+
+begin
+ if (CurrentMouseDriver.UseDefaultQueue) and
+ (PendingMouseEvents>0) then
+ begin
+ MouseEvent:=PendingMouseHead^;
+ PollMouseEvent:=true;
+ end
+ else
+ If Assigned(CurrentMouseDriver.PollMouseEvent) Then
+ begin
+ PollMouseEvent:=CurrentMouseDriver.PollMouseEvent(MouseEvent);
+ // Put it in queue, so next poll/get will be faster.
+ // Only if an event was found PM
+ // If PollMouseEvent then
+ // PutMouseEvent(MouseEvent);
+ // This is all wrong, because the Event might already
+ // have been pushed in the Event Array.
+ end
+ else
+ PollMouseEvent:=false;
+end;
+
+Procedure SetMouseDriver(Const Driver : TMouseDriver);
+
+begin
+ If Not MouseInitialized then
+ CurrentMouseDriver:=Driver;
+end;
+
+
+Procedure GetMouseDriver(Var Driver : TMouseDriver);
+
+begin
+ Driver:=CurrentMouseDriver;
+end;
+
+{
+ $Log: mouse.inc,v $
+ Revision 1.7 2005/02/14 17:13:25 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/mouseh.inc b/rtl/inc/mouseh.inc
new file mode 100644
index 0000000000..3de8f53fb0
--- /dev/null
+++ b/rtl/inc/mouseh.inc
@@ -0,0 +1,113 @@
+{
+ $Id: mouseh.inc,v 1.4 2005/02/14 17:13:25 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ { We have an errorcode base of 1030 }
+ errMouseBase = 1030;
+ errMouseInitError = errMouseBase + 0;
+ errMouseNotImplemented = errMouseBase + 1;
+
+type
+ PMouseEvent=^TMouseEvent;
+ TMouseEvent=packed record { 8 bytes }
+ buttons : word;
+ x,y : word;
+ Action : word;
+ end;
+
+const
+ MouseActionDown = $0001; { Mouse down event }
+ MouseActionUp = $0002; { Mouse up event }
+ MouseActionMove = $0004; { Mouse move event }
+
+ MouseLeftButton = $01; { Left mouse button }
+ MouseRightButton = $02; { Right mouse button }
+ MouseMiddleButton = $04; { Middle mouse button }
+
+ MouseEventBufSize = 16; { Size of event queue }
+
+var
+ MouseIntFlag : Byte; { Mouse in int flag }
+ MouseButtons : Byte; { Mouse button state }
+ MouseWhereX,
+ MouseWhereY : Word; { Mouse position }
+
+Type
+ TMouseDriver = Record
+ UseDefaultQueue : Boolean;
+ InitDriver : Procedure;
+ DoneDriver : Procedure;
+ DetectMouse : Function : Byte;
+ ShowMouse : Procedure;
+ HideMouse : Procedure;
+ GetMouseX : Function : Word;
+ GetMouseY : Function : Word;
+ GetMouseButtons : Function : Word;
+ SetMouseXY : procedure (x,y:word);
+ GetMouseEvent : procedure (var MouseEvent:TMouseEvent);
+ PollMouseEvent : function (var MouseEvent: TMouseEvent):boolean;
+ PutMouseEvent : procedure (Const MouseEvent:TMouseEvent);
+ end;
+
+procedure InitMouse;
+{ Initialize the mouse interface }
+
+procedure DoneMouse;
+{ Deinitialize the mouse interface }
+
+function DetectMouse:byte;
+{ Detect if a mouse is present, returns the amount of buttons or 0
+ if no mouse is found }
+
+procedure ShowMouse;
+{ Show the mouse cursor }
+
+procedure HideMouse;
+{ Hide the mouse cursor }
+
+function GetMouseX:word;
+{ Return the current X position of the mouse }
+
+function GetMouseY:word;
+{ Return the current Y position of the mouse }
+
+function GetMouseButtons:word;
+{ Return the current button state of the mouse }
+
+procedure SetMouseXY(x,y:word);
+{ Place the mouse cursor on x,y }
+
+procedure GetMouseEvent(var MouseEvent:TMouseEvent);
+{ Returns the last Mouseevent, and waits for one if not available }
+
+procedure PutMouseEvent(const MouseEvent: TMouseEvent);
+{ Adds the given MouseEvent to the input queue. Please note that depending on
+ the implementation this can hold only one value (NO FIFOs etc) }
+
+function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+{ Checks if a Mouseevent is available, and returns it if one is found. If no
+ event is pending, it returns 0 }
+
+Procedure SetMouseDriver(Const Driver : TMouseDriver);
+{ Sets the mouse driver. }
+
+Procedure GetMouseDriver(Var Driver : TMouseDriver);
+{ Returns the currently active mouse driver }
+
+{
+ $Log: mouseh.inc,v $
+ Revision 1.4 2005/02/14 17:13:25 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/mvecimp.inc b/rtl/inc/mvecimp.inc
new file mode 100644
index 0000000000..1ba774af54
--- /dev/null
+++ b/rtl/inc/mvecimp.inc
@@ -0,0 +1,381 @@
+{*****************************************************************************
+ Methods of the vector object
+*****************************************************************************}
+constructor objectname.init_zero;
+
+begin
+ data[0]:=0;
+ data[1]:=0;
+{$if vecsize>=3}
+ data[2]:=0;
+{$endif}
+{$if vecsize>=4}
+ data[3]:=0;
+{$endif}
+end;
+
+constructor objectname.init_one;
+
+begin
+ data[0]:=1;
+ data[1]:=1;
+{$if vecsize>=3}
+ data[2]:=1;
+{$endif}
+{$if vecsize>=4}
+ data[3]:=1;
+{$endif}
+end;
+
+constructor objectname.init(a,b
+ {$if vecsize>=3},c{$endif}
+ {$if vecsize>=4},d{$endif}:datatype);
+
+begin
+ data[0]:=a;
+ data[1]:=b;
+{$if vecsize>=3}
+ data[2]:=c;
+{$endif}
+{$if vecsize>=4}
+ data[3]:=d;
+{$endif}
+end;
+
+function objectname.length:datatype;
+
+begin
+ length:=sqrt(data[0]*data[0]
+ +data[1]*data[1]
+ {$if vecsize>=3}+data[2]*data[2]{$endif}
+ {$if vecsize>=4}+data[3]*data[3]{$endif});
+end;
+
+function objectname.squared_length:datatype;
+
+begin
+ squared_length:=data[0]*data[0]
+ +data[1]*data[1]
+ {$if vecsize>=3}+data[2]*data[2]{$endif}
+ {$if vecsize>=4}+data[3]*data[3]{$endif};
+end;
+
+{*****************************************************************************
+ Conversion from vector2
+*****************************************************************************}
+
+
+{$if (vecsize<>2) or (datatype<>single)}
+operator := (const v:Tvector2_single) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=0;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (vecsize<>2) or (datatype<>double)}
+operator := (const v:Tvector2_double) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=0;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (vecsize<>2) or (datatype<>extended)}
+operator := (const v:Tvector2_extended) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=0;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=0;
+{$endif}
+end;
+{$endif}
+
+{*****************************************************************************
+ Conversion from vector3
+*****************************************************************************}
+
+
+{$if (vecsize<>3) or (datatype<>single)}
+operator := (const v:Tvector3_single) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=v.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (vecsize<>3) or (datatype<>double)}
+operator := (const v:Tvector3_double) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=v.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=0;
+{$endif}
+end;
+{$endif}
+
+{$if (vecsize<>3) or (datatype<>extended)}
+operator := (const v:Tvector3_extended) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=v.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=0;
+{$endif}
+end;
+{$endif}
+
+{*****************************************************************************
+ Conversion from vector4
+*****************************************************************************}
+
+
+{$if (vecsize<>4) or (datatype<>single)}
+operator := (const v:Tvector4_single) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=v.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=v.data[3];
+{$endif}
+end;
+{$endif}
+
+{$if (vecsize<>4) or (datatype<>double)}
+operator := (const v:Tvector4_double) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=v.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=v.data[3];
+{$endif}
+end;
+{$endif}
+
+{$if (vecsize<>4) or (datatype<>extended)}
+operator := (const v:Tvector4_extended) result:objectname;
+
+begin
+ result.data[0]:=v.data[0];
+ result.data[1]:=v.data[1];
+{$if vecsize>=3}
+ result.data[2]:=v.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=v.data[3];
+{$endif}
+end;
+{$endif}
+
+{*****************************************************************************
+ Vector to vector operations
+*****************************************************************************}
+
+operator + (const x,y:objectname) result:objectname;
+
+{Adds the elements of both vectors together.}
+
+begin
+ result.data[0]:=x.data[0]+y.data[0];
+ result.data[1]:=x.data[1]+y.data[1];
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]+y.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]+y.data[3];
+{$endif}
+end;
+
+operator - (const x:objectname) result:objectname;
+
+{Negates the elements of a vector.}
+
+begin
+ result.data[0]:=-x.data[0];
+ result.data[1]:=-x.data[1];
+{$if vecsize>=3}
+ result.data[2]:=-x.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=-x.data[3];
+{$endif}
+end;
+
+operator - (const x,y:objectname) result:objectname;
+
+{Subtracts the elements of both vectors together.}
+
+begin
+ result.data[0]:=x.data[0]-y.data[0];
+ result.data[1]:=x.data[1]-y.data[1];
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]-y.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]-y.data[3];
+{$endif}
+end;
+
+operator * (const x,y:objectname) result:objectname;
+
+{Multiplies the elements of two vectors.}
+
+begin
+ result.data[0]:=x.data[0]*y.data[0];
+ result.data[1]:=x.data[1]*y.data[1];
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]*y.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]*y.data[3];
+{$endif}
+end;
+
+operator / (const x,y:objectname) result:objectname;
+
+{Divides the elements of two vectors.
+
+ In most cases, you will want to avoid this and multiply by the inverse.
+ In case you need to preserve accuracy, dividing might be better though.}
+
+begin
+ result.data[0]:=x.data[0]/y.data[0];
+ result.data[1]:=x.data[1]/y.data[1];
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]/y.data[2];
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]/y.data[3];
+{$endif}
+end;
+
+operator ** (const x,y:objectname) result:datatype;
+
+{Calculates the inproduct of two vectors.}
+
+begin
+ result:=x.data[0]*y.data[0]
+ +x.data[1]*y.data[1]
+ {$if vecsize>=3}+x.data[2]*y.data[2]{$endif}
+ {$if vecsize>=4}+x.data[3]*y.data[3]{$endif};
+end;
+
+{$if vecsize=3}
+operator >< (const x,y:objectname) result:objectname;
+
+{Calculates the exproduct of two vectors. The exproduct exists only for
+ 3-dimensional vectors}
+
+begin
+ result.data[0]:=x.data[1]*y.data[2]-x.data[2]*y.data[1];
+ result.data[1]:=x.data[2]*y.data[0]-x.data[0]*y.data[2];
+ result.data[2]:=x.data[0]*y.data[1]-x.data[1]*y.data[0];
+end;
+{$endif}
+
+{*****************************************************************************
+ Vector/scalar operations
+*****************************************************************************}
+
+operator + (const x:objectname;y:datatype) result:objectname;
+
+{Adds a scalar to all vector elements.}
+
+begin
+ result.data[0]:=x.data[0]+y;
+ result.data[1]:=x.data[1]+y;
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]+y;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]+y;
+{$endif}
+end;
+
+operator - (const x:objectname;y:datatype) result:objectname;
+
+{Subtracts a scalar to all vector elements.}
+
+begin
+ result.data[0]:=x.data[0]-y;
+ result.data[1]:=x.data[1]-y;
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]-y;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]-y;
+{$endif}
+end;
+
+operator * (const x:objectname;y:datatype) result:objectname;
+
+{Multiplies all vector elements by a scalar.}
+
+begin
+ result.data[0]:=x.data[0]*y;
+ result.data[1]:=x.data[1]*y;
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]*y;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]*y;
+{$endif}
+end;
+
+operator / (const x:objectname;y:datatype) result:objectname;
+
+{Divides all vector elements by a scalar.}
+
+begin
+ result.data[0]:=x.data[0]/y;
+ result.data[1]:=x.data[1]/y;
+{$if vecsize>=3}
+ result.data[2]:=x.data[2]/y;
+{$endif}
+{$if vecsize>=4}
+ result.data[3]:=x.data[3]/y;
+{$endif}
+end;
diff --git a/rtl/inc/objects.pp b/rtl/inc/objects.pp
new file mode 100644
index 0000000000..ea55ef4729
--- /dev/null
+++ b/rtl/inc/objects.pp
@@ -0,0 +1,3011 @@
+{
+ $Id: objects.pp,v 1.37 2005/02/14 17:13:25 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Objects.pas clone for Free Pascal
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{************[ SOURCE FILE OF FREE VISION ]****************}
+{ }
+{ System independent clone of objects.pas }
+{ }
+{ Interface Copyright (c) 1992 Borland International }
+{ }
+{ Parts Copyright (c) 1999-2000 by Florian Klaempfl }
+{ fnklaemp@cip.ft.uni-erlangen.de }
+{ }
+{ Parts Copyright (c) 1999-2000 by Frank ZAGO }
+{ zago@ecoledoc.ipc.fr }
+{ }
+{ Parts Copyright (c) 1999-2000 by MH Spiegel }
+{ }
+{ Parts Copyright (c) 1996, 1999-2000 by Leon de Boer }
+{ ldeboer@ibm.net }
+{ }
+{ Free Vision project coordinator Balazs Scheidler }
+{ bazsi@tas.vein.hu }
+{ }
+UNIT Objects;
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+ INTERFACE
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+{==== Select assembler ==============================================}
+{$IFDEF CPU86}
+ {$ASMMODE ATT}
+{$ENDIF}
+
+
+{==== Compiler directives ===========================================}
+{$H-} { No ansistrings }
+{$E+} { Emulation is on }
+{$X+} { Extended syntax is ok }
+{$R-} { Disable range checking }
+{$ifndef Unix}
+ {$S-} { Disable Stack Checking }
+{$endif}
+{$I-} { Disable IO Checking }
+{$Q-} { Disable Overflow Checking }
+{$V-} { Turn off strict VAR strings }
+{====================================================================}
+
+{$ifdef win32}
+ uses
+ Windows;
+{$endif}
+
+{***************************************************************************}
+{ PUBLIC CONSTANTS }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{ STREAM ERROR STATE MASKS }
+{---------------------------------------------------------------------------}
+CONST
+ stOk = 0; { No stream error }
+ stError = -1; { Access error }
+ stInitError = -2; { Initialize error }
+ stReadError = -3; { Stream read error }
+ stWriteError = -4; { Stream write error }
+ stGetError = -5; { Get object error }
+ stPutError = -6; { Put object error }
+ stSeekError = -7; { Seek error in stream }
+ stOpenError = -8; { Error opening stream }
+
+{---------------------------------------------------------------------------}
+{ STREAM ACCESS MODE CONSTANTS }
+{---------------------------------------------------------------------------}
+CONST
+ stCreate = $3C00; { Create new file }
+ stOpenRead = $3D00; { Read access only }
+ stOpenWrite = $3D01; { Write access only }
+ stOpen = $3D02; { Read/write access }
+
+{---------------------------------------------------------------------------}
+{ TCollection ERROR CODES }
+{---------------------------------------------------------------------------}
+CONST
+ coIndexError = -1; { Index out of range }
+ coOverflow = -2; { Overflow }
+
+{---------------------------------------------------------------------------}
+{ VMT HEADER CONSTANT - HOPEFULLY WE CAN DROP THIS LATER }
+{---------------------------------------------------------------------------}
+CONST
+ vmtHeaderSize = 8; { VMT header size }
+
+CONST
+{---------------------------------------------------------------------------}
+{ MAXIUM DATA SIZES }
+{---------------------------------------------------------------------------}
+{$IFDEF FPC}
+ MaxBytes = 128*1024*128; { Maximum data size }
+{$ELSE}
+ MaxBytes = 16384;
+{$ENDIF}
+ MaxWords = MaxBytes DIV SizeOf(Word); { Max word data size }
+ MaxPtrs = MaxBytes DIV SizeOf(Pointer); { Max ptr data size }
+ MaxCollectionSize = MaxBytes DIV SizeOf(Pointer); { Max collection size }
+ MaxTPCompatibleCollectionSize = 65520 div 4;
+
+{***************************************************************************}
+{ PUBLIC TYPE DEFINITIONS }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{ CHARACTER SET }
+{---------------------------------------------------------------------------}
+TYPE
+ TCharSet = SET Of Char; { Character set }
+ PCharSet = ^TCharSet; { Character set ptr }
+
+{---------------------------------------------------------------------------}
+{ GENERAL ARRAYS }
+{---------------------------------------------------------------------------}
+TYPE
+ TByteArray = ARRAY [0..MaxBytes-1] Of Byte; { Byte array }
+ PByteArray = ^TByteArray; { Byte array pointer }
+
+ TWordArray = ARRAY [0..MaxWords-1] Of Word; { Word array }
+ PWordArray = ^TWordArray; { Word array pointer }
+
+ TPointerArray = Array [0..MaxPtrs-1] Of Pointer; { Pointer array }
+ PPointerArray = ^TPointerArray; { Pointer array ptr }
+
+{---------------------------------------------------------------------------}
+{ POINTER TO STRING }
+{---------------------------------------------------------------------------}
+TYPE
+ PString = PShortString; { String pointer }
+
+{---------------------------------------------------------------------------}
+{ OS dependent File type / consts }
+{---------------------------------------------------------------------------}
+type
+ FNameStr = String;
+const
+ MaxReadBytes = $7fffffff;
+
+var
+ invalidhandle : THandle;
+
+
+{---------------------------------------------------------------------------}
+{ DOS ASCIIZ FILENAME }
+{---------------------------------------------------------------------------}
+TYPE
+ AsciiZ = Array [0..255] Of Char; { Filename array }
+
+{---------------------------------------------------------------------------}
+{ BIT SWITCHED TYPE CONSTANTS }
+{---------------------------------------------------------------------------}
+TYPE
+ Sw_Word = Cardinal; { Long Word now }
+ Sw_Integer = LongInt; { Long integer now }
+
+{***************************************************************************}
+{ PUBLIC RECORD DEFINITIONS }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{ TYPE CONVERSION RECORDS }
+{---------------------------------------------------------------------------}
+TYPE
+ WordRec = packed RECORD
+{$ifdef ENDIAN_LITTLE}
+ Lo, Hi: Byte; { Word to bytes }
+{$else}
+ Hi,Lo: Byte;
+{$endif}
+ END;
+
+ LongRec = packed RECORD
+{$ifdef ENDIAN_LITTLE}
+ Lo, Hi: Word; { LongInt to words }
+{$else}
+ Hi,Lo: Word; { LongInt to words }
+{$endif}
+ END;
+
+ PtrRec = packed RECORD
+ Ofs, Seg: Word; { Pointer to words }
+ END;
+
+{---------------------------------------------------------------------------}
+{ TStreamRec RECORD - STREAM OBJECT RECORD }
+{---------------------------------------------------------------------------}
+TYPE
+ PStreamRec = ^TStreamRec; { Stream record ptr }
+ TStreamRec = Packed RECORD
+ ObjType: Sw_Word; { Object type id }
+ VmtLink: pointer; { VMT link }
+ Load : Pointer; { Object load code }
+ Store: Pointer; { Object store code }
+ Next : PStreamRec; { Next stream record }
+ END;
+
+{***************************************************************************}
+{ PUBLIC OBJECT DEFINITIONS }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{ TPoint OBJECT - POINT OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ PPoint = ^TPoint;
+ TPoint = OBJECT
+ X, Y: Sw_Integer;
+ END;
+
+{---------------------------------------------------------------------------}
+{ TRect OBJECT - RECTANGLE OBJECT }
+{---------------------------------------------------------------------------}
+ PRect = ^TRect;
+ TRect = OBJECT
+ A, B: TPoint; { Corner points }
+ FUNCTION Empty: Boolean;
+ FUNCTION Equals (R: TRect): Boolean;
+ FUNCTION Contains (P: TPoint): Boolean;
+ PROCEDURE Copy (R: TRect);
+ PROCEDURE Union (R: TRect);
+ PROCEDURE Intersect (R: TRect);
+ PROCEDURE Move (ADX, ADY: Sw_Integer);
+ PROCEDURE Grow (ADX, ADY: Sw_Integer);
+ PROCEDURE Assign (XA, YA, XB, YB: Sw_Integer);
+ END;
+
+{---------------------------------------------------------------------------}
+{ TObject OBJECT - BASE ANCESTOR OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TObject = OBJECT
+ CONSTRUCTOR Init;
+ PROCEDURE Free;
+ FUNCTION Is_Object(P:Pointer):Boolean;
+ DESTRUCTOR Done; Virtual;
+ END;
+ PObject = ^TObject;
+
+{ ******************************* REMARK ****************************** }
+{ Two new virtual methods have been added to the object in the form of }
+{ Close and Open. The main use here is in the Disk Based Descendants }
+{ the calls open and close the given file so these objects can be }
+{ used like standard files. Two new fields have also been added to }
+{ speed up seeks on descendants. All existing code will compile and }
+{ work completely normally oblivious to these new methods and fields. }
+{ ****************************** END REMARK *** Leon de Boer, 15May96 * }
+
+{---------------------------------------------------------------------------}
+{ TStream OBJECT - STREAM ANCESTOR OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TStream = OBJECT (TObject)
+ Status : Integer; { Stream status }
+ ErrorInfo : Integer; { Stream error info }
+ StreamSize: LongInt; { Stream current size }
+ Position : LongInt; { Current position }
+ TPCompatible : Boolean;
+ CONSTRUCTOR Init;
+ FUNCTION Get: PObject;
+ FUNCTION StrRead: PChar;
+ FUNCTION GetPos: Longint; Virtual;
+ FUNCTION GetSize: Longint; Virtual;
+ FUNCTION ReadStr: PString;
+ PROCEDURE Open (OpenMode: Word); Virtual;
+ PROCEDURE Close; Virtual;
+ PROCEDURE Reset;
+ PROCEDURE Flush; Virtual;
+ PROCEDURE Truncate; Virtual;
+ PROCEDURE Put (P: PObject);
+ PROCEDURE StrWrite (P: PChar);
+ PROCEDURE WriteStr (P: PString);
+ PROCEDURE Seek (Pos: LongInt); Virtual;
+ PROCEDURE Error (Code, Info: Integer); Virtual;
+ PROCEDURE Read (Var Buf; Count: LongInt); Virtual;
+ PROCEDURE Write (Var Buf; Count: LongInt); Virtual;
+ PROCEDURE CopyFrom (Var S: TStream; Count: Longint);
+ END;
+ PStream = ^TStream;
+
+{ ******************************* REMARK ****************************** }
+{ A few minor changes to this object and an extra field added called }
+{ FName which holds an AsciiZ array of the filename this allows the }
+{ streams file to be opened and closed like a normal text file. All }
+{ existing code should work without any changes. }
+{ ****************************** END REMARK *** Leon de Boer, 19May96 * }
+
+{---------------------------------------------------------------------------}
+{ TDosStream OBJECT - DOS FILE STREAM OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TDosStream = OBJECT (TStream)
+ Handle: THandle; { DOS file handle }
+ FName : AsciiZ; { AsciiZ filename }
+ CONSTRUCTOR Init (FileName: FNameStr; Mode: Word);
+ DESTRUCTOR Done; Virtual;
+ PROCEDURE Close; Virtual;
+ PROCEDURE Truncate; Virtual;
+ PROCEDURE Seek (Pos: LongInt); Virtual;
+ PROCEDURE Open (OpenMode: Word); Virtual;
+ PROCEDURE Read (Var Buf; Count: Longint); Virtual;
+ PROCEDURE Write (Var Buf; Count: Longint); Virtual;
+ private
+ FileInfo : File;
+ END;
+ PDosStream = ^TDosStream;
+
+{ ******************************* REMARK ****************************** }
+{ A few minor changes to this object and an extra field added called }
+{ lastmode which holds the read or write condition last using the }
+{ speed up buffer which helps speed up the flush, position and size }
+{ functions. All existing code should work without any changes. }
+{ ****************************** END REMARK *** Leon de Boer, 19May96 * }
+
+{---------------------------------------------------------------------------}
+{ TBufStream OBJECT - BUFFERED DOS FILE STREAM }
+{---------------------------------------------------------------------------}
+TYPE
+ TBufStream = OBJECT (TDosStream)
+ LastMode: Byte; { Last buffer mode }
+ BufSize : Longint; { Buffer size }
+ BufPtr : Longint; { Buffer start }
+ BufEnd : Longint; { Buffer end }
+ Buffer : PByteArray; { Buffer allocated }
+ CONSTRUCTOR Init (FileName: FNameStr; Mode, Size: Word);
+ DESTRUCTOR Done; Virtual;
+ PROCEDURE Close; Virtual;
+ PROCEDURE Flush; Virtual;
+ PROCEDURE Truncate; Virtual;
+ PROCEDURE Seek (Pos: LongInt); Virtual;
+ PROCEDURE Open (OpenMode: Word); Virtual;
+ PROCEDURE Read (Var Buf; Count: Longint); Virtual;
+ PROCEDURE Write (Var Buf; Count: Longint); Virtual;
+ END;
+ PBufStream = ^TBufStream;
+
+{ ******************************* REMARK ****************************** }
+{ All the changes here should be completely transparent to existing }
+{ code. Basically the memory blocks do not have to be base segments }
+{ but this means our list becomes memory blocks rather than segments. }
+{ The stream will also expand like the other standard streams!! }
+{ ****************************** END REMARK *** Leon de Boer, 19May96 * }
+
+{---------------------------------------------------------------------------}
+{ TMemoryStream OBJECT - MEMORY STREAM OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TMemoryStream = OBJECT (TStream)
+ BlkCount: Longint; { Number of segments }
+ BlkSize : Word; { Memory block size }
+ MemSize : LongInt; { Memory alloc size }
+ BlkList : PPointerArray; { Memory block list }
+ CONSTRUCTOR Init (ALimit: Longint; ABlockSize: Word);
+ DESTRUCTOR Done; Virtual;
+ PROCEDURE Truncate; Virtual;
+ PROCEDURE Read (Var Buf; Count: Longint); Virtual;
+ PROCEDURE Write (Var Buf; Count: Longint); Virtual;
+ PRIVATE
+ FUNCTION ChangeListSize (ALimit: Longint): Boolean;
+ END;
+ PMemoryStream = ^TMemoryStream;
+
+
+TYPE
+ TItemList = Array [0..MaxCollectionSize - 1] Of Pointer;
+ PItemList = ^TItemList;
+
+{ ******************************* REMARK ****************************** }
+{ The changes here look worse than they are. The Sw_Integer simply }
+{ switches between Integers and LongInts if switched between 16 and 32 }
+{ bit code. All existing code will compile without any changes. }
+{ ****************************** END REMARK *** Leon de Boer, 10May96 * }
+
+{---------------------------------------------------------------------------}
+{ TCollection OBJECT - COLLECTION ANCESTOR OBJECT }
+{---------------------------------------------------------------------------}
+ TCollection = OBJECT (TObject)
+ Items: PItemList; { Item list pointer }
+ Count: Sw_Integer; { Item count }
+ Limit: Sw_Integer; { Item limit count }
+ Delta: Sw_Integer; { Inc delta size }
+ CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
+ CONSTRUCTOR Load (Var S: TStream);
+ DESTRUCTOR Done; Virtual;
+ FUNCTION At (Index: Sw_Integer): Pointer;
+ FUNCTION IndexOf (Item: Pointer): Sw_Integer; Virtual;
+ FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
+ FUNCTION LastThat (Test: Pointer): Pointer;
+ FUNCTION FirstThat (Test: Pointer): Pointer;
+ PROCEDURE Pack;
+ PROCEDURE FreeAll;
+ PROCEDURE DeleteAll;
+ PROCEDURE Free (Item: Pointer);
+ PROCEDURE Insert (Item: Pointer); Virtual;
+ PROCEDURE Delete (Item: Pointer);
+ PROCEDURE AtFree (Index: Sw_Integer);
+ PROCEDURE FreeItem (Item: Pointer); Virtual;
+ PROCEDURE AtDelete (Index: Sw_Integer);
+ PROCEDURE ForEach (Action: Pointer);
+ PROCEDURE SetLimit (ALimit: Sw_Integer); Virtual;
+ PROCEDURE Error (Code, Info: Integer); Virtual;
+ PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
+ PROCEDURE AtInsert (Index: Sw_Integer; Item: Pointer);
+ PROCEDURE Store (Var S: TStream);
+ PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
+ END;
+ PCollection = ^TCollection;
+
+{---------------------------------------------------------------------------}
+{ TSortedCollection OBJECT - SORTED COLLECTION ANCESTOR }
+{---------------------------------------------------------------------------}
+TYPE
+ TSortedCollection = OBJECT (TCollection)
+ Duplicates: Boolean; { Duplicates flag }
+ CONSTRUCTOR Init (ALimit, ADelta: Sw_Integer);
+ CONSTRUCTOR Load (Var S: TStream);
+ FUNCTION KeyOf (Item: Pointer): Pointer; Virtual;
+ FUNCTION IndexOf (Item: Pointer): Sw_Integer; Virtual;
+ FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
+ FUNCTION Search (Key: Pointer; Var Index: Sw_Integer): Boolean;Virtual;
+ PROCEDURE Insert (Item: Pointer); Virtual;
+ PROCEDURE Store (Var S: TStream);
+ END;
+ PSortedCollection = ^TSortedCollection;
+
+{---------------------------------------------------------------------------}
+{ TStringCollection OBJECT - STRING COLLECTION OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TStringCollection = OBJECT (TSortedCollection)
+ FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
+ FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
+ PROCEDURE FreeItem (Item: Pointer); Virtual;
+ PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
+ END;
+ PStringCollection = ^TStringCollection;
+
+{---------------------------------------------------------------------------}
+{ TStrCollection OBJECT - STRING COLLECTION OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TStrCollection = OBJECT (TSortedCollection)
+ FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
+ FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
+ PROCEDURE FreeItem (Item: Pointer); Virtual;
+ PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
+ END;
+ PStrCollection = ^TStrCollection;
+
+{ ******************************* REMARK ****************************** }
+{ This is a completely >> NEW << object which holds a collection of }
+{ strings but does not alphabetically sort them. It is a very useful }
+{ object for insert ordered list boxes! }
+{ ****************************** END REMARK *** Leon de Boer, 15May96 * }
+
+{---------------------------------------------------------------------------}
+{ TUnSortedStrCollection - UNSORTED STRING COLLECTION OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TUnSortedStrCollection = OBJECT (TStringCollection)
+ PROCEDURE Insert (Item: Pointer); Virtual;
+ END;
+ PUnSortedStrCollection = ^TUnSortedStrCollection;
+
+{---------------------------------------------------------------------------}
+{ TResourceCollection OBJECT - RESOURCE COLLECTION OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TResourceCollection = OBJECT (TStringCollection)
+ FUNCTION KeyOf (Item: Pointer): Pointer; Virtual;
+ FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
+ PROCEDURE FreeItem (Item: Pointer); Virtual;
+ PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
+ END;
+ PResourceCollection = ^TResourceCollection;
+
+{---------------------------------------------------------------------------}
+{ TResourceFile OBJECT - RESOURCE FILE OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TResourceFile = OBJECT (TObject)
+ Stream : PStream; { File as a stream }
+ Modified: Boolean; { Modified flag }
+ CONSTRUCTOR Init (AStream: PStream);
+ DESTRUCTOR Done; Virtual;
+ FUNCTION Count: Sw_Integer;
+ FUNCTION KeyAt (I: Sw_Integer): String;
+ FUNCTION Get (Key: String): PObject;
+ FUNCTION SwitchTo (AStream: PStream; Pack: Boolean): PStream;
+ PROCEDURE Flush;
+ PROCEDURE Delete (Key: String);
+ PROCEDURE Put (Item: PObject; Key: String);
+ PRIVATE
+ BasePos: LongInt; { Base position }
+ IndexPos: LongInt; { Index position }
+ Index: TResourceCollection; { Index collection }
+ END;
+ PResourceFile = ^TResourceFile;
+
+TYPE
+ TStrIndexRec = Packed RECORD
+ Key : Sw_word;
+ Count, Offset: Word;
+ END;
+
+ TStrIndex = Array [0..9999] Of TStrIndexRec;
+ PStrIndex = ^TStrIndex;
+
+{---------------------------------------------------------------------------}
+{ TStringList OBJECT - STRING LIST OBJECT }
+{---------------------------------------------------------------------------}
+ TStringList = OBJECT (TObject)
+ CONSTRUCTOR Load (Var S: TStream);
+ DESTRUCTOR Done; Virtual;
+ FUNCTION Get (Key: Sw_Word): String;
+ PRIVATE
+ Stream : PStream;
+ BasePos : Longint;
+ IndexSize: Longint;
+ Index : PStrIndex;
+ PROCEDURE ReadStr (Var S: String; Offset, Skip: Longint);
+ END;
+ PStringList = ^TStringList;
+
+{---------------------------------------------------------------------------}
+{ TStrListMaker OBJECT - RESOURCE FILE OBJECT }
+{---------------------------------------------------------------------------}
+TYPE
+ TStrListMaker = OBJECT (TObject)
+ CONSTRUCTOR Init (AStrSize, AIndexSize: Sw_Word);
+ DESTRUCTOR Done; Virtual;
+ PROCEDURE Put (Key: Sw_Word; S: String);
+ PROCEDURE Store (Var S: TStream);
+ PRIVATE
+ StrPos : Sw_Word;
+ StrSize : Sw_Word;
+ Strings : PByteArray;
+ IndexPos : Sw_Word;
+ IndexSize: Sw_Word;
+ Index : PStrIndex;
+ Cur : TStrIndexRec;
+ PROCEDURE CloseCurrent;
+ END;
+ PStrListMaker = ^TStrListMaker;
+
+{***************************************************************************}
+{ INTERFACE ROUTINES }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ CALL HELPERS INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{ Constructor calls.
+
+ Ctor Pointer to the constructor.
+ Obj Pointer to the instance. NIL if new instance to be allocated.
+ VMT Pointer to the VMT (obtained by TypeOf()).
+ returns Pointer to the instance.
+}
+function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer;
+function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer;
+
+{ Method calls.
+
+ Method Pointer to the method.
+ Obj Pointer to the instance. NIL if new instance to be allocated.
+ returns Pointer to the instance.
+}
+function CallVoidMethod(Method: pointer; Obj: pointer): pointer;
+function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer;
+
+{ Local-function/procedure calls.
+
+ Func Pointer to the local function (which must be far-coded).
+ Frame Frame pointer of the wrapping function.
+}
+
+function CallVoidLocal(Func: pointer; Frame: Pointer): pointer;
+function CallPointerLocal(Func: pointer; Frame: Pointer; Param1: pointer): pointer;
+
+{ Calls of functions/procedures local to methods.
+
+ Func Pointer to the local function (which must be far-coded).
+ Frame Frame pointer of the wrapping method.
+ Obj Pointer to the object that the method belongs to.
+}
+function CallVoidMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer): pointer;
+function CallPointerMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;
+
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ DYNAMIC STRING INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{-NewStr-------------------------------------------------------------
+Allocates a dynamic string into memory. If S is nil, NewStr returns
+a nil pointer, otherwise NewStr allocates Length(S)+1 bytes of memory
+containing a copy of S, and returns a pointer to the string.
+12Jun96 LdB
+---------------------------------------------------------------------}
+FUNCTION NewStr (Const S: String): PString;
+
+{-DisposeStr---------------------------------------------------------
+Disposes of a PString allocated by the function NewStr.
+12Jun96 LdB
+---------------------------------------------------------------------}
+PROCEDURE DisposeStr (P: PString);
+
+PROCEDURE SetStr(VAR p:pString; CONST s:STRING);
+
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ STREAM INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{-Abstract-----------------------------------------------------------
+Terminates program with a run-time error 211. When implementing
+an abstract object type, call Abstract in those virtual methods that
+must be overridden in descendant types. This ensures that any
+attempt to use instances of the abstract object type will fail.
+12Jun96 LdB
+---------------------------------------------------------------------}
+PROCEDURE Abstract;
+
+{-RegisterObjects----------------------------------------------------
+Registers the three standard objects TCollection, TStringCollection
+and TStrCollection.
+02Sep97 LdB
+---------------------------------------------------------------------}
+PROCEDURE RegisterObjects;
+
+{-RegisterType-------------------------------------------------------
+Registers the given object type with Free Vision's streams, creating
+a list of known objects. Streams can only store and return these known
+object types. Each registered object needs a unique stream registration
+record, of type TStreamRec.
+02Sep97 LdB
+---------------------------------------------------------------------}
+PROCEDURE RegisterType (Var S: TStreamRec);
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ GENERAL FUNCTION INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{-LongMul------------------------------------------------------------
+Returns the long integer value of X * Y integer values.
+04Sep97 LdB
+---------------------------------------------------------------------}
+FUNCTION LongMul (X, Y: Integer): LongInt;
+
+{-LongDiv------------------------------------------------------------
+Returns the integer value of long integer X divided by integer Y.
+04Sep97 LdB
+---------------------------------------------------------------------}
+FUNCTION LongDiv (X: Longint; Y: Integer): Integer;
+
+
+{***************************************************************************}
+{ PUBLIC INITIALIZED VARIABLES }
+{***************************************************************************}
+
+
+CONST
+{---------------------------------------------------------------------------}
+{ INITIALIZED DOS/DPMI/WIN/OS2 PUBLIC VARIABLES }
+{---------------------------------------------------------------------------}
+ StreamError: Pointer = Nil; { Stream error ptr }
+ DefaultTPCompatible: Boolean = false;
+
+{---------------------------------------------------------------------------}
+{ STREAM REGISTRATION RECORDS }
+{---------------------------------------------------------------------------}
+
+CONST
+ RCollection: TStreamRec = (
+ ObjType: 50;
+ VmtLink: Ofs(TypeOf(TCollection)^);
+ Load: @TCollection.Load;
+ Store: @TCollection.Store;
+ Next: Nil);
+
+ RStringCollection: TStreamRec = (
+ ObjType: 51;
+ VmtLink: Ofs(TypeOf(TStringCollection)^);
+ Load: @TStringCollection.Load;
+ Store: @TStringCollection.Store;
+ Next: Nil);
+
+ RStrCollection: TStreamRec = (
+ ObjType: 69;
+ VmtLink: Ofs(TypeOf(TStrCollection)^);
+ Load: @TStrCollection.Load;
+ Store: @TStrCollection.Store;
+ Next: Nil);
+
+ RStringList: TStreamRec = (
+ ObjType: 52;
+ VmtLink: Ofs(TypeOf(TStringList)^);
+ Load: @TStringList.Load;
+ Store: Nil;
+ Next: Nil);
+
+ RStrListMaker: TStreamRec = (
+ ObjType: 52;
+ VmtLink: Ofs(TypeOf(TStrListMaker)^);
+ Load: Nil;
+ Store: @TStrListMaker.Store;
+ Next: Nil);
+
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+ IMPLEMENTATION
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
+
+Uses dos;
+
+{***************************************************************************}
+{ HELPER ROUTINES FOR CALLING }
+{***************************************************************************}
+
+type
+ VoidLocal = function(_EBP: Pointer): pointer;
+ PointerLocal = function(_EBP: Pointer; Param1: pointer): pointer;
+ VoidMethodLocal = function(_EBP: Pointer): pointer;
+ PointerMethodLocal = function(_EBP: Pointer; Param1: pointer): pointer;
+ VoidConstructor = function(VMT: pointer; Obj: pointer): pointer;
+ PointerConstructor = function(VMT: pointer; Obj: pointer; Param1: pointer): pointer;
+ VoidMethod = function(Obj: pointer): pointer;
+ PointerMethod = function(Obj: pointer; Param1: pointer): pointer;
+
+
+function CallVoidConstructor(Ctor: pointer; Obj: pointer; VMT: pointer): pointer;
+begin
+{$ifdef VER1_0}
+ asm
+{$ifdef cpui386}
+ movl Obj, %esi
+{$endif}
+{$ifdef cpum68k}
+ move.l Obj, a5
+{$endif}
+ end;
+ CallVoidConstructor := VoidConstructor(Ctor)(VMT, Obj);
+{$else}
+ CallVoidConstructor := VoidConstructor(Ctor)(Obj, VMT);
+{$endif}
+end;
+
+
+function CallPointerConstructor(Ctor: pointer; Obj: pointer; VMT: pointer; Param1: pointer): pointer;
+{$undef FPC_CallPointerConstructor_Implemented}
+begin
+{$ifdef VER1_0}
+ asm
+{$ifdef cpui386}
+{$define FPC_CallPointerConstructor_Implemented}
+ movl Obj, %esi
+{$endif}
+{$ifdef cpum68k}
+{$define FPC_CallPointerConstructor_Implemented}
+ move.l Obj, a5
+{$endif}
+ end;
+ CallPointerConstructor := PointerConstructor(Ctor)(VMT, Obj, Param1)
+{$else}
+ { 1.1 does not esi to be loaded }
+ {$define FPC_CallPointerConstructor_Implemented}
+ CallPointerConstructor := PointerConstructor(Ctor)(Obj, VMT, Param1)
+{$endif}
+end;
+{$ifndef FPC_CallPointerConstructor_Implemented}
+{$error CallPointerConstructor function not implemented}
+{$endif not FPC_CallPointerConstructor_Implemented}
+
+
+function CallVoidMethod(Method: pointer; Obj: pointer): pointer;
+begin
+{$ifdef VER1_0}
+ { load the object pointer }
+{$ifdef CPUI386}
+ asm
+ movl Obj, %esi
+ end;
+{$endif CPUI386}
+{$ifdef CPU68K}
+ asm
+ move.l Obj, a5
+ end;
+{$endif CPU68K}
+{$endif VER1_0}
+ CallVoidMethod := VoidMethod(Method)(Obj)
+end;
+
+
+function CallPointerMethod(Method: pointer; Obj: pointer; Param1: pointer): pointer;
+{$undef FPC_CallPointerMethod_Implemented}
+begin
+{$ifdef VER1_0}
+ asm
+{$ifdef cpui386}
+{$define FPC_CallPointerMethod_Implemented}
+ movl Obj, %esi
+{$endif}
+{$ifdef cpum68k}
+{$define FPC_CallPointerMethod_Implemented}
+ move.l Obj, a5
+{$endif}
+{$ifdef cpupowerpc}
+{$define FPC_CallPointerMethod_Implemented}
+{ for the powerpc, we don't need to load self, because we use standard calling conventions
+ so self should be in a register anyways }
+{$endif}
+ end;
+{$else}
+{ 1.1 does not esi to be loaded }
+{$define FPC_CallPointerMethod_Implemented}
+{$endif}
+ CallPointerMethod := PointerMethod(Method)(Obj, Param1)
+end;
+{$ifndef FPC_CallPointerMethod_Implemented}
+{$error CallPointerMethod function not implemented}
+{$endif not FPC_CallPointerMethod_Implemented}
+
+
+function CallVoidLocal(Func: pointer; Frame: Pointer): pointer;
+begin
+ CallVoidLocal := VoidLocal(Func)(Frame)
+end;
+
+
+function CallPointerLocal(Func: pointer; Frame: Pointer; Param1: pointer): pointer;
+begin
+ CallPointerLocal := PointerLocal(Func)(Frame, Param1)
+end;
+
+
+function CallVoidMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer): pointer;
+begin
+{$ifdef VER1_0}
+ { load the object pointer }
+{$ifdef CPUI386}
+ asm
+ movl Obj, %esi
+ end;
+{$endif CPUI386}
+{$ifdef CPU68K}
+ asm
+ move.l Obj, a5
+ end;
+{$endif CPU68K}
+{$endif VER1_0}
+ CallVoidMethodLocal := VoidMethodLocal(Func)(Frame)
+end;
+
+
+function CallPointerMethodLocal(Func: pointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;
+begin
+{$ifdef VER1_0}
+ { load the object pointer }
+{$ifdef CPUI386}
+ asm
+ movl Obj, %esi
+ end;
+{$endif CPUI386}
+{$ifdef CPU68K}
+ asm
+ move.l Obj, a5
+ end;
+{$endif CPU68K}
+{$endif VER1_0}
+ CallPointerMethodLocal := PointerMethodLocal(Func)(Frame, Param1)
+end;
+
+
+
+
+{***************************************************************************}
+{ PRIVATE INITIALIZED VARIABLES }
+{***************************************************************************}
+
+{---------------------------------------------------------------------------}
+{ INITIALIZED DOS/DPMI/WIN/OS2 PRIVATE VARIABLES }
+{---------------------------------------------------------------------------}
+CONST
+ StreamTypes: PStreamRec = Nil; { Stream types reg }
+
+{***************************************************************************}
+{ PRIVATE INTERNAL ROUTINES }
+{***************************************************************************}
+{---------------------------------------------------------------------------}
+{ RegisterError -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE RegisterError;
+BEGIN
+ RunError(212); { Register error }
+END;
+
+
+{***************************************************************************}
+{ OBJECT METHODS }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TRect OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+PROCEDURE CheckEmpty (Var Rect: TRect);
+BEGIN
+ With Rect Do Begin
+ If (A.X >= B.X) OR (A.Y >= B.Y) Then Begin { Zero or reversed }
+ A.X := 0; { Clear a.x }
+ A.Y := 0; { Clear a.y }
+ B.X := 0; { Clear b.x }
+ B.Y := 0; { Clear b.y }
+ End;
+ End;
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Empty -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TRect.Empty: Boolean;
+BEGIN
+ Empty := (A.X >= B.X) OR (A.Y >= B.Y); { Empty result }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Equals -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TRect.Equals (R: TRect): Boolean;
+BEGIN
+ Equals := (A.X = R.A.X) AND (A.Y = R.A.Y) AND
+ (B.X = R.B.X) AND (B.Y = R.B.Y); { Equals result }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Contains -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TRect.Contains (P: TPoint): Boolean;
+BEGIN
+ Contains := (P.X >= A.X) AND (P.X < B.X) AND
+ (P.Y >= A.Y) AND (P.Y < B.Y); { Contains result }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Copy -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TRect.Copy (R: TRect);
+BEGIN
+ A := R.A; { Copy point a }
+ B := R.B; { Copy point b }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Union -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TRect.Union (R: TRect);
+BEGIN
+ If (R.A.X < A.X) Then A.X := R.A.X; { Take if smaller }
+ If (R.A.Y < A.Y) Then A.Y := R.A.Y; { Take if smaller }
+ If (R.B.X > B.X) Then B.X := R.B.X; { Take if larger }
+ If (R.B.Y > B.Y) Then B.Y := R.B.Y; { Take if larger }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Intersect -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TRect.Intersect (R: TRect);
+BEGIN
+ If (R.A.X > A.X) Then A.X := R.A.X; { Take if larger }
+ If (R.A.Y > A.Y) Then A.Y := R.A.Y; { Take if larger }
+ If (R.B.X < B.X) Then B.X := R.B.X; { Take if smaller }
+ If (R.B.Y < B.Y) Then B.Y := R.B.Y; { Take if smaller }
+ CheckEmpty(Self); { Check if empty }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Move -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TRect.Move (ADX, ADY: Sw_Integer);
+BEGIN
+ Inc(A.X, ADX); { Adjust A.X }
+ Inc(A.Y, ADY); { Adjust A.Y }
+ Inc(B.X, ADX); { Adjust B.X }
+ Inc(B.Y, ADY); { Adjust B.Y }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Grow -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TRect.Grow (ADX, ADY: Sw_Integer);
+BEGIN
+ Dec(A.X, ADX); { Adjust A.X }
+ Dec(A.Y, ADY); { Adjust A.Y }
+ Inc(B.X, ADX); { Adjust B.X }
+ Inc(B.Y, ADY); { Adjust B.Y }
+ CheckEmpty(Self); { Check if empty }
+END;
+
+{--TRect--------------------------------------------------------------------}
+{ Assign -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TRect.Assign (XA, YA, XB, YB: Sw_Integer);
+BEGIN
+ A.X := XA; { Hold A.X value }
+ A.Y := YA; { Hold A.Y value }
+ B.X := XB; { Hold B.X value }
+ B.Y := YB; { Hold B.Y value }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TObject OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+TYPE
+ DummyObject = OBJECT (TObject) { Internal object }
+ Data: RECORD END; { Helps size VMT link }
+ END;
+
+{ ******************************* REMARK ****************************** }
+{ I Prefer this code because it self sizes VMT link rather than using a }
+{ fixed record structure thus it should work on all compilers without a }
+{ specific record to match each compiler. }
+{ ****************************** END REMARK *** Leon de Boer, 10May96 * }
+
+{--TObject------------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TObject.Init;
+VAR LinkSize: LongInt; Dummy: DummyObject;
+BEGIN
+ LinkSize := PtrInt(@Dummy.Data)-PtrInt(@Dummy); { Calc VMT link size }
+ FillChar(Pointer(PtrInt(@Self)+LinkSize)^,
+ SizeOf(Self)-LinkSize, #0); { Clear data fields }
+END;
+
+{--TObject------------------------------------------------------------------}
+{ Free -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TObject.Free;
+BEGIN
+ Dispose(PObject(@Self), Done); { Dispose of self }
+END;
+
+{--TObject------------------------------------------------------------------}
+{ Is_Object -> Platforms DOS/DPMI/WIN/OS2 - Checked 5Mar00 DM }
+{---------------------------------------------------------------------------}
+FUNCTION TObject.Is_Object(P:Pointer):Boolean;
+TYPE
+ PVMT=^VMT;
+ VMT=RECORD
+ Size,NegSize:Longint;
+ ParentLink:PVMT;
+ END;
+VAR SP:^PVMT; Q:PVMT;
+BEGIN
+ SP:=@SELF;
+ Q:=SP^;
+ Is_Object:=False;
+ While Q<>Nil Do Begin
+ IF Q=P THEN Begin
+ Is_Object:=True;
+ Break;
+ End;
+ Q:=Q^.Parentlink;
+ End;
+END;
+
+{--TObject------------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TObject.Done;
+BEGIN { Abstract method }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TStream OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+CONSTRUCTOR TStream.Init;
+BEGIN
+ Status := StOK;
+ ErrorInfo := 0;
+ StreamSize := 0;
+ Position := 0;
+ TPCompatible := DefaultTPCompatible;
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 02Sep97 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStream.Get: PObject;
+VAR ObjType: Sw_Word; P: PStreamRec; ObjTypeWord: Word;
+BEGIN
+ If TPCompatible Then Begin
+ { Read 16-bit word for TP compatibility. }
+ Read(ObjTypeWord, SizeOf(ObjTypeWord));
+ ObjType := ObjTypeWord
+ End
+ else
+ Read(ObjType, SizeOf(ObjType)); { Read object type }
+ If (ObjType<>0) Then Begin { Object registered }
+ P := StreamTypes; { Current reg list }
+ While (P <> Nil) AND (P^.ObjType <> ObjType) { Find object type OR }
+ Do P := P^.Next; { Find end of chain }
+ If (P=Nil) Then Begin { Not registered }
+ Error(stGetError, ObjType); { Obj not registered }
+ Get := Nil; { Return nil pointer }
+ End Else
+ Get :=PObject(
+ CallPointerConstructor(P^.Load,Nil,P^.VMTLink, @Self)) { Call constructor }
+ End Else Get := Nil; { Return nil pointer }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ StrRead -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStream.StrRead: PChar;
+VAR L: Word; P: PChar;
+BEGIN
+ Read(L, SizeOf(L)); { Read length }
+ If (L = 0) Then StrRead := Nil Else Begin { Check for empty }
+ GetMem(P, L + 1); { Allocate memory }
+ If (P <> Nil) Then Begin { Check allocate okay }
+ Read(P[0], L); { Read the data }
+ P[L] := #0; { Terminate with #0 }
+ End;
+ StrRead := P; { Return PChar }
+ End;
+END;
+
+{--TStream------------------------------------------------------------------}
+{ ReadStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStream.ReadStr: PString;
+VAR L: Byte; P: PString;
+BEGIN
+ Read(L, 1); { Read string length }
+ If (L > 0) Then Begin
+ GetMem(P, L + 1); { Allocate memory }
+ If (P <> Nil) Then Begin { Check allocate okay }
+ P^[0] := Char(L); { Hold length }
+ Read(P^[1], L); { Read string data }
+ End;
+ ReadStr := P; { Return string ptr }
+ End Else ReadStr := Nil;
+END;
+
+{--TStream------------------------------------------------------------------}
+{ GetPos -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStream.GetPos: LongInt;
+BEGIN
+ If (Status=stOk) Then GetPos := Position { Return position }
+ Else GetPos := -1; { Stream in error }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ GetSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStream.GetSize: LongInt;
+BEGIN
+ If (Status=stOk) Then GetSize := StreamSize { Return stream size }
+ Else GetSize := -1; { Stream in error }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Close;
+BEGIN { Abstract method }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Reset -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Reset;
+BEGIN
+ Status := stOK; { Clear status }
+ ErrorInfo := 0; { Clear error info }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Flush;
+BEGIN { Abstract method }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Truncate;
+BEGIN
+ Abstract; { Abstract error }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Put -> Platforms DOS/DPMI/WIN/OS2 - Checked 02Sep97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Put (P: PObject);
+VAR ObjType: Sw_Word; Link: pointer; Q: PStreamRec; VmtPtr: ^pointer;
+ ObjTypeWord: Word;
+BEGIN
+ VmtPtr := Pointer(P); { Xfer object to ptr }
+ if assigned(vmtptr) then
+ Link := VmtPtr^ { VMT link }
+ else
+ Link:=nil;
+ ObjType := 0; { Set objtype to zero }
+ If (P<>Nil) AND (Link<>Nil) Then Begin { We have a VMT link }
+ Q := StreamTypes; { Current reg list }
+ While (Q <> Nil) AND (Q^.VMTLink <> Link) { Find link match OR }
+ Do Q := Q^.Next; { Find end of chain }
+ If (Q=Nil) Then Begin { End of chain found }
+ Error(stPutError, 0); { Not registered error }
+ Exit; { Now exit }
+ End Else ObjType := Q^.ObjType; { Update object type }
+ End;
+ If TPCompatible Then Begin
+ ObjTypeWord := word(ObjType);
+ Write(ObjTypeWord, SizeOf(ObjTypeWord))
+ end
+ else
+ Write(ObjType, SizeOf(ObjType)); { Write object type }
+ If (ObjType<>0) Then { Registered object }
+ CallPointerMethod(Q^.Store, P, @Self);
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Seek (Pos: LongInt);
+BEGIN
+ If (Status = stOk) Then Begin { Check status }
+ If (Pos < 0) Then Pos := 0; { Remove negatives }
+ If (Pos <= StreamSize) Then Position := Pos { If valid set pos }
+ Else Error(stSeekError, Pos); { Position error }
+ End;
+END;
+
+{--TStream------------------------------------------------------------------}
+{ StrWrite -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.StrWrite (P: PChar);
+VAR L: Word; Q: PByteArray;
+BEGIN
+ L := 0; { Preset zero size }
+ Q := PByteArray(P); { Transfer type }
+ If (Q <> Nil) Then While (Q^[L] <> 0) Do Inc(L); { PChar length }
+ Write(L, SizeOf(L)); { Store length }
+ If (P <> Nil) Then Write(P[0], L); { Write data }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ WriteStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.WriteStr (P: PString);
+CONST Empty: String[1] = '';
+BEGIN
+ If (P <> Nil) Then Write(P^, Length(P^) + 1) { Write string }
+ Else Write(Empty, 1); { Write empty string }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Open (OpenMode: Word);
+BEGIN { Abstract method }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Error -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Error (Code, Info: Integer);
+TYPE TErrorProc = Procedure(Var S: TStream);
+BEGIN
+ Status := Code; { Hold error code }
+ ErrorInfo := Info; { Hold error info }
+ If (StreamError <> Nil) Then
+ TErrorProc(StreamError)(Self); { Call error ptr }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Read (Var Buf; Count: Longint);
+BEGIN
+ Abstract; { Abstract error }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.Write (Var Buf; Count: Longint);
+BEGIN
+ Abstract; { Abstract error }
+END;
+
+{--TStream------------------------------------------------------------------}
+{ CopyFrom -> Platforms DOS/DPMI/WIN/OS2 - Checked 10May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStream.CopyFrom (Var S: TStream; Count: Longint);
+VAR W: Word; Buffer: Array[0..1023] of Byte;
+BEGIN
+ While (Count > 0) Do Begin
+ If (Count > SizeOf(Buffer)) Then { To much data }
+ W := SizeOf(Buffer) Else W := Count; { Size to transfer }
+ S.Read(Buffer, W); { Read from stream }
+ Write(Buffer, W); { Write to stream }
+ Dec(Count, W); { Dec write count }
+ End;
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TDosStream OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{$IFOPT I+}
+{$DEFINE IO_CHECK_ON}
+{$I-}
+{$ENDIF}
+
+{--TDosStream---------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TDosStream.Init (FileName: FNameStr; Mode: Word);
+VAR OldFileMode : Byte;
+ DosStreamError : Word;
+BEGIN
+ Inherited Init; { Call ancestor }
+ FileName := FileName+#0; { Make asciiz }
+ Move(FileName[1], FName, Length(FileName)); { Create asciiz name }
+ Handle := InvalidHandle;
+ Assign(FileInfo,FileName);
+ { Handle the mode }
+ if Mode =stCreate then
+ Begin
+ Rewrite(FileInfo,1);
+ end
+ else
+ Begin
+ OldFileMode := FileMode;
+ { Keep sharing modes! }
+ FileMode := Mode and $FF;
+ System.Reset(FileInfo,1);
+ FileMode := OldFileMode;
+ { To use the correct mode we must reclose the file
+ and open it again
+ }
+ end;
+ Handle := FileRec(FileInfo).Handle; { Set handle value }
+ DosStreamError := IOResult;
+ If DosStreamError = 0 then
+ Begin
+ StreamSize := System.FileSize(FileInfo);
+ end;
+ If DosStreamError = 0 then
+ DosStreamError := IOResult;
+ If (DosStreamError <> 0) Then
+ Error(stInitError, DosStreamError) { Call stream error }
+ else
+ Status := StOK;
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TDosStream.Done;
+var
+ DosStreamError : Word;
+BEGIN
+ if Handle <> InvalidHandle then
+ Begin
+ System.Close(FileInfo);
+ DosStreamError := IOResult;
+ If DosStreamError = 0 then
+ Status := stOk
+ else
+ Error(stError, DosStreamError);
+ end;
+ Position := 0; { Zero the position }
+ Handle := InvalidHandle;
+ Inherited Done; { Call ancestor }
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TDosStream.Close;
+var
+ DosStreamError : Word;
+BEGIN
+ if Handle <> InvalidHandle then { Is file closed ? }
+ Begin
+ System.Close(FileInfo); { Close file }
+ DosStreamError := IOResult; { Check for error }
+ If DosStreamError = 0 then
+ Status := stOk
+ else
+ Error(stError, DosStreamError); { Call error routine }
+ end;
+ Position := 0; { Zero the position }
+ Handle := InvalidHandle; { Handle invalid }
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TDosStream.Truncate;
+ var
+ DosStreamError : Word;
+BEGIN
+ If Status = stOk then
+ Begin
+ System.Truncate(FileInfo);
+ DosStreamError := IOResult;
+ If DosStreamError = 0 then
+ { Status is already = stOK }
+ StreamSize := Position
+ else
+ Error(stError, DosStreamError);
+ end;
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TDosStream.Seek (Pos: Longint);
+var
+ DosStreamError : Word;
+BEGIN
+ If (Status=stOk) Then
+ Begin { Check status okay }
+ If (Pos < 0) Then
+ Pos := 0; { Negatives removed }
+ System.Seek(FileInfo, Pos);
+ DosStreamError := IOResult;
+ if DosStreamError <> 0 then
+ Error(stSeekError, DosStreamError){ Specific seek error }
+ Else Position := Pos; { Adjust position }
+ { Status is already = stOK }
+ End;
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TDosStream.Open (OpenMode: Word);
+VAR OldFileMode : Byte;
+ DosStreamError : Word;
+BEGIN
+ If (Status=stOk) Then
+ Begin { Check status okay }
+ If (Handle = InvalidHandle) Then
+ Begin { File not open }
+ Assign(FileInfo,FName);
+ { Handle the mode }
+ if OpenMode =stCreate then
+ Begin
+ System.Rewrite(FileInfo,1);
+ end
+ else
+ Begin
+ OldFileMode := FileMode;
+ FileMode := OpenMode and 3;
+ System.Reset(FileInfo,1);
+ FileMode := OldFileMode;
+ { To use the correct mode we must reclose the file
+ and open it again
+ }
+ end;
+ Handle := FileRec(FileInfo).Handle; { Set handle value }
+ DosStreamError := IOResult;
+ If DosStreamError = 0 then
+ StreamSize := System.FileSize(FileInfo);
+ If DosStreamError = 0 then
+ DosStreamError := IOResult;
+ If (DosStreamError <> 0) Then
+ Error(stOpenError, DosStreamError) { Call stream error }
+ else
+ Status := StOK;
+ Position := 0;
+ end
+ Else
+ Error(stOpenError, 104); { File already open }
+ End;
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TDosStream.Read (Var Buf; Count: Longint);
+VAR BytesMoved: Longint;
+ DosStreamError : Word;
+BEGIN
+ If Status = StOK then
+ Begin
+ If (Position + Count > StreamSize) Then { Insufficient data }
+ Error(stReadError, 0); { Read beyond end!!! }
+ If (Handle = InvalidHandle) Then
+ Error(stReadError, 103); { File not open }
+ BlockRead(FileInfo, Buf, Count, BytesMoved); { Read from file }
+ DosStreamError := IOResult;
+ If ((DosStreamError<>0) OR (BytesMoved<>Count)) Then
+ Begin { Error was detected }
+ BytesMoved := 0; { Clear bytes moved }
+ If (DosStreamError <> 0) Then
+ Error(stReadError, DosStreamError) { Specific read error }
+ Else
+ Error(stReadError, 0); { Non specific error }
+ End;
+ Inc(Position, BytesMoved); { Adjust position }
+ End;
+ { If there was already an error, or an error was just
+ generated, fill the vuffer with NULL
+ }
+ If Status <> StOK then
+ FillChar(Buf, Count, #0); { Error clear buffer }
+END;
+
+{--TDosStream---------------------------------------------------------------}
+{ Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TDosStream.Write (Var Buf; Count: Longint);
+VAR BytesMoved: Longint;
+ DosStreamError : Word;
+BEGIN
+ { If status is not OK, simply exit }
+ if Status <> StOK then
+ exit;
+ If (Handle = InvalidHandle) Then
+ Error(stWriteError, 103); { File not open }
+ BlockWrite(FileInfo, Buf, Count, BytesMoved); { Write to file }
+ DosStreamError := IOResult;
+ If ((DosStreamError<>0) OR (BytesMoved<>Count)) Then
+ Begin { Error was detected }
+ BytesMoved := 0; { Clear bytes moved }
+ If (DosStreamError<>0) Then
+ Error(stWriteError, DOSStreamError) { Specific write error }
+ Else
+ Error(stWriteError, 0); { Non specific error }
+ End;
+ Inc(Position, BytesMoved); { Adjust position }
+ If (Position > StreamSize) Then { File expanded }
+ StreamSize := Position; { Adjust stream size }
+END;
+
+
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TBufStream OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TBufStream---------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TBufStream.Init (FileName: FNameStr; Mode, Size: Word);
+BEGIN
+ Inherited Init(FileName, Mode); { Call ancestor }
+ BufSize := Size; { Hold buffer size }
+ If (Size<>0) Then GetMem(Buffer, Size); { Allocate buffer }
+ If (Buffer=Nil) Then Error(stInitError, 0); { Buffer allocate fail }
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TBufStream.Done;
+BEGIN
+ Flush; { Flush the file }
+ Inherited Done; { Call ancestor }
+ If (Buffer<>Nil) Then FreeMem(Buffer, BufSize); { Release buffer }
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Close -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Close;
+BEGIN
+ Flush; { Flush the buffer }
+ Inherited Close; { Call ancestor }
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Flush;
+VAR W: Longint;
+ DosStreamError : Word;
+BEGIN
+ If Status <> StOK then
+ exit;
+ If (LastMode=2) AND (BufPtr<>0) Then Begin { Must update file }
+ If (Handle = InvalidHandle) Then DosStreamError := 103 { File is not open }
+ Else
+ Begin
+ BlockWrite(FileInfo, Buffer^,BufPtr, W); { Write to file }
+ DosStreamError := IOResult;
+ End;
+ If (DosStreamError<>0) OR (W<>BufPtr) Then { We have an error }
+ If (DosStreamError=0) Then Error(stWriteError, 0){ Unknown write error }
+ Else Error(stError, DosStreamError); { Specific write error }
+ End;
+ BufPtr := 0; { Reset buffer ptr }
+ BufEnd := 0; { Reset buffer end }
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Truncate;
+BEGIN
+ Flush; { Flush buffer }
+ Inherited Truncate; { Truncate file }
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Seek -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Seek (Pos: LongInt);
+BEGIN
+ If (Status=stOk) Then Begin { Check status okay }
+ If (Position<>Pos) Then Begin { Move required }
+ Flush; { Flush the buffer }
+ Inherited Seek(Pos); { Call ancestor }
+ End;
+ End;
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Open -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Open (OpenMode: Word);
+BEGIN
+ If (Status=stOk) Then Begin { Check status okay }
+ BufPtr := 0; { Clear buffer start }
+ BufEnd := 0; { Clear buffer end }
+ Inherited Open(OpenMode); { Call ancestor }
+ End;
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Read (Var Buf; Count: Longint);
+VAR W, Bw: Longint; P: PByte;
+ DosStreamError : Word;
+BEGIN
+ If Status <> StOk then
+ begin
+ FillChar(Buf, Count, #0); { Error clear buffer }
+ exit;
+ end;
+ If (Position + Count > StreamSize) Then { Read pas stream end }
+ Error(stReadError, 0); { Call stream error }
+ If (Handle = InvalidHandle) Then Error(stReadError, 103); { File not open }
+ P := @Buf; { Transfer address }
+ If (LastMode=2) Then Flush; { Flush write buffer }
+ LastMode := 1; { Now set read mode }
+ While (Count>0) AND (Status=stOk) Do Begin { Check status & count }
+ If (BufPtr=BufEnd) Then Begin { Buffer is empty }
+ If (Position + BufSize > StreamSize) Then
+ Bw := StreamSize - Position { Amount of file left }
+ Else Bw := BufSize; { Full buffer size }
+ BlockRead(FileInfo, Buffer^, Bw, W);
+ DosStreamError := IOResult; { Read from file }
+ If ((DosStreamError<>0) OR (Bw<>W)) Then Begin { Error was detected }
+ If (DosStreamError<>0) Then
+ Error(stReadError, DosStreamError) { Specific read error }
+ Else Error(stReadError, 0); { Non specific error }
+ End Else Begin
+ BufPtr := 0; { Reset BufPtr }
+ BufEnd := W; { End of buffer }
+ End;
+ End;
+ If (Status=stOk) Then Begin { Status still okay }
+ W := BufEnd - BufPtr; { Space in buffer }
+ If (Count < W) Then W := Count; { Set transfer size }
+ Move(Buffer^[BufPtr], P^, W); { Data from buffer }
+ Dec(Count, W); { Reduce count }
+ Inc(BufPtr, W); { Advance buffer ptr }
+ Inc(P, W); { Transfer address }
+ Inc(Position, W); { Advance position }
+ End;
+ End;
+ If (Status<>stOk) AND (Count>0) Then
+ FillChar(P^, Count, #0); { Error clear buffer }
+END;
+
+{--TBufStream---------------------------------------------------------------}
+{ Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 17May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TBufStream.Write (Var Buf; Count: Longint);
+VAR W: Longint;
+ P: PByte;
+ DosStreamError : Word;
+BEGIN
+ if Status <> StOK then exit; { Exit if error }
+ If (Handle = InvalidHandle) Then Error(stWriteError, 103); { File not open }
+ If (LastMode=1) Then Flush; { Flush read buffer }
+ LastMode := 2; { Now set write mode }
+ P := @Buf; { Transfer address }
+ While (Count>0) AND (Status=stOk) Do Begin { Check status & count }
+ If (BufPtr=BufSize) Then Begin { Buffer is full }
+ BlockWrite(FileInfo, Buffer^, BufSize,W); { Write to file }
+ DosStreamError := IOResult;
+ If (DosStreamError<>0) OR (W<>BufSize) Then { We have an error }
+ If (DosStreamError=0) Then Error(stWriteError, 0) { Unknown write error }
+ Else Error(stError, DosStreamError); { Specific write error }
+ BufPtr := 0; { Reset BufPtr }
+ End;
+ If (Status=stOk) Then Begin { Status still okay }
+ W := BufSize - BufPtr; { Space in buffer }
+ If (Count < W) Then W := Count; { Transfer size }
+ Move(P^, Buffer^[BufPtr], W); { Data to buffer }
+ Dec(Count, W); { Reduce count }
+ Inc(BufPtr, W); { Advance buffer ptr }
+ Inc(P,W); { Transfer address }
+ Inc(Position, W); { Advance position }
+ If (Position > StreamSize) Then { File has expanded }
+ StreamSize := Position; { Update new size }
+ End;
+ End;
+END;
+
+{$IFDEF IO_CHECK_ON}
+{$UNDEF IO_CHECK_ON}
+{$I+}
+{$ENDIF}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TMemoryStream OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TMemoryStream------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TMemoryStream.Init (ALimit: LongInt; ABlockSize: Word);
+VAR W: Word;
+BEGIN
+ Inherited Init; { Call ancestor }
+ If (ABlockSize=0) Then BlkSize := 8192 Else { Default blocksize }
+ BlkSize := ABlockSize; { Set blocksize }
+ If (ALimit = 0) Then W := 1 Else { At least 1 block }
+ W := (ALimit + BlkSize - 1) DIV BlkSize; { Blocks needed }
+ If NOT ChangeListSize(W) Then { Try allocate blocks }
+ Error(stInitError, 0); { Initialize error }
+END;
+
+{--TMemoryStream------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TMemoryStream.Done;
+BEGIN
+ ChangeListSize(0); { Release all memory }
+ Inherited Done; { Call ancestor }
+END;
+
+{--TMemoryStream------------------------------------------------------------}
+{ Truncate -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TMemoryStream.Truncate;
+VAR W: Word;
+BEGIN
+ If (Status=stOk) Then Begin { Check status okay }
+ If (Position = 0) Then W := 1 Else { At least one block }
+ W := (Position + BlkSize - 1) DIV BlkSize; { Blocks needed }
+ If ChangeListSize(W) Then StreamSize := Position { Set stream size }
+ Else Error(stError, 0); { Error truncating }
+ End;
+END;
+
+{--TMemoryStream------------------------------------------------------------}
+{ Read -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TMemoryStream.Read (Var Buf; Count: Longint);
+VAR W, CurBlock, BlockPos: Word; Li: LongInt; P, Q: PByte;
+BEGIN
+ If (Position + Count > StreamSize) Then { Insufficient data }
+ Error(stReadError, 0); { Read beyond end!!! }
+ P := @Buf; { Transfer address }
+ While (Count>0) AND (Status=stOk) Do Begin { Check status & count }
+ CurBlock := Position DIV BlkSize; { Current block }
+ { * REMARK * - Do not shorten this, result can be > 64K }
+ Li := CurBlock; { Transfer current block }
+ Li := Li * BlkSize; { Current position }
+ { * REMARK END * - Leon de Boer }
+ BlockPos := Position - Li; { Current position }
+ W := BlkSize - BlockPos; { Current block space }
+ If (W > Count) Then W := Count; { Adjust read size }
+ Q := BlkList^[CurBlock] + BlockPos; { Calc pointer }
+ Move(Q^, P^, W); { Move data to buffer }
+ Inc(Position, W); { Adjust position }
+ Inc(P, W);
+ Dec(Count, W); { Adjust count left }
+ End;
+ If (Count<>0) Then FillChar(P^, Count, #0); { Error clear buffer }
+END;
+
+{--TMemoryStream------------------------------------------------------------}
+{ Write -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TMemoryStream.Write (Var Buf; Count: Longint);
+VAR
+ W, CurBlock, BlockPos: Word;
+ Li: LongInt;
+ P, Q: PByte;
+BEGIN
+ If (Position + Count > MemSize) Then Begin { Expansion needed }
+ If (Position + Count = 0) Then W := 1 Else { At least 1 block }
+ W := (Position+Count+BlkSize-1) DIV BlkSize; { Blocks needed }
+ If NOT ChangeListSize(W) Then
+ Error(stWriteError, 0); { Expansion failed!!! }
+ End;
+ P := @Buf; { Transfer address }
+ While (Count>0) AND (Status=stOk) Do Begin { Check status & count }
+ CurBlock := Position DIV BlkSize; { Current segment }
+ { * REMARK * - Do not shorten this, result can be > 64K }
+ Li := CurBlock; { Transfer current block }
+ Li := Li * BlkSize; { Current position }
+ { * REMARK END * - Leon de Boer }
+ BlockPos := Position - Li; { Current position }
+ W := BlkSize - BlockPos; { Current block space }
+ If (W > Count) Then W := Count; { Adjust write size }
+ Q := BlkList^[CurBlock] + BlockPos; { Calc pointer }
+ Move(P^, Q^, W); { Transfer data }
+ Inc(Position, W); { Adjust position }
+ Inc(P, W);
+ Dec(Count, W); { Adjust count left }
+ If (Position > StreamSize) Then { File expanded }
+ StreamSize := Position; { Adjust stream size }
+ End;
+END;
+
+{***************************************************************************}
+{ TMemoryStream PRIVATE METHODS }
+{***************************************************************************}
+
+{--TMemoryStream------------------------------------------------------------}
+{ ChangeListSize -> Platforms DOS/DPMI/WIN/OS2 - Checked 19May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TMemoryStream.ChangeListSize (ALimit: Longint): Boolean;
+VAR
+ W: Longint;
+ Li: LongInt;
+ P: PPointerArray;
+BEGIN
+ If (ALimit <> BlkCount) Then Begin { Change is needed }
+ ChangeListSize := False; { Preset failure }
+ If (ALimit > MaxPtrs) Then Exit; { To many blocks req }
+ If (ALimit <> 0) Then Begin { Create segment list }
+ Li := ALimit * SizeOf(Pointer); { Block array size }
+ GetMem(P, Li); { Allocate memory }
+ FillChar(P^, Li, #0); { Clear the memory }
+ If (BlkCount <> 0) AND (BlkList <> Nil) Then { Current list valid }
+ If (BlkCount <= ALimit) Then Move(BlkList^,
+ P^, BlkCount * SizeOf(Pointer)) Else { Move whole old list }
+ Move(BlkList^, P^, Li); { Move partial list }
+ End Else P := Nil; { No new block list }
+ If (ALimit < BlkCount) Then { Shrink stream size }
+ For W := BlkCount-1 DownTo ALimit Do
+ FreeMem(BlkList^[W], BlkSize); { Release memory block }
+ If (P <> Nil) AND (ALimit > BlkCount) Then Begin { Expand stream size }
+ For W := BlkCount To ALimit-1 Do Begin
+ GetMem(P^[W], BlkSize); { Allocate memory }
+ End;
+ End;
+ If (BlkCount <> 0) AND (BlkList<>Nil) Then
+ FreeMem(BlkList, BlkCount * SizeOf(Pointer)); { Release old list }
+ BlkList := P; { Hold new block list }
+ BlkCount := ALimit; { Hold new count }
+ { * REMARK * - Do not shorten this, result can be > 64K }
+ MemSize := BlkCount; { Block count }
+ MemSize := MemSize * BlkSize; { Current position }
+ { * REMARK END * - Leon de Boer }
+ End;
+ ChangeListSize := True; { Successful }
+END;
+
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TCollection OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TCollection--------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TCollection.Init (ALimit, ADelta: Sw_Integer);
+BEGIN
+ Inherited Init; { Call ancestor }
+ Delta := ADelta; { Set increment }
+ SetLimit(ALimit); { Set limit }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Load -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TCollection.Load (Var S: TStream);
+VAR C, I: Sw_Integer;
+BEGIN
+ If S.TPCompatible Then Begin
+ { I ignore endianness issues here. If endianness is different,
+ you can't expect binary compatible resources anyway. }
+ Count := 0; S.Read(Count, Sizeof(Word));
+ Limit := 0; S.Read(Limit, Sizeof(Word));
+ Delta := 0; S.Read(Delta, Sizeof(Word))
+ End
+ Else Begin
+ S.Read(Count, Sizeof(Count)); { Read count }
+ S.Read(Limit, Sizeof(Limit)); { Read limit }
+ S.Read(Delta, Sizeof(Delta)); { Read delta }
+ End;
+ Items := Nil; { Clear item pointer }
+ C := Count; { Hold count }
+ I := Limit; { Hold limit }
+ Count := 0; { Clear count }
+ Limit := 0; { Clear limit }
+ SetLimit(I); { Set requested limit }
+ Count := C; { Set count }
+ For I := 0 To C-1 Do AtPut(I, GetItem(S)); { Get each item }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TCollection.Done;
+BEGIN
+ FreeAll; { Free all items }
+ SetLimit(0); { Release all memory }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ At -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TCollection.At (Index: Sw_Integer): Pointer;
+BEGIN
+ If (Index < 0) OR (Index >= Count) Then Begin { Invalid index }
+ Error(coIndexError, Index); { Call error }
+ At := Nil; { Return nil }
+ End Else At := Items^[Index]; { Return item }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ IndexOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TCollection.IndexOf (Item: Pointer): Sw_Integer;
+VAR I: Sw_Integer;
+BEGIN
+ If (Count>0) Then Begin { Count is positive }
+ For I := 0 To Count-1 Do { For each item }
+ If (Items^[I]=Item) Then Begin { Look for match }
+ IndexOf := I; { Return index }
+ Exit; { Now exit }
+ End;
+ End;
+ IndexOf := -1; { Return index }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TCollection.GetItem (Var S: TStream): Pointer;
+BEGIN
+ GetItem := S.Get; { Item off stream }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ LastThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TCollection.LastThat (Test: Pointer): Pointer;
+VAR I: LongInt;
+
+BEGIN
+ For I := Count DownTo 1 Do
+ Begin { Down from last item }
+ IF Boolean(Byte(ptrint(CallPointerLocal(Test,get_caller_frame(get_frame),Items^[I-1])))) THEN
+ Begin { Test each item }
+ LastThat := Items^[I-1]; { Return item }
+ Exit; { Now exit }
+ End;
+ End;
+ LastThat := Nil; { None passed test }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ FirstThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
+VAR I: LongInt;
+BEGIN
+ For I := 1 To Count Do Begin { Up from first item }
+ IF Boolean(Byte(ptrint(CallPointerLocal(Test,get_caller_frame(get_frame),Items^[I-1])))) THEN
+ Begin { Test each item }
+ FirstThat := Items^[I-1]; { Return item }
+ Exit; { Now exit }
+ End;
+ End;
+ FirstThat := Nil; { None passed test }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Pack -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.Pack;
+VAR I, J: Sw_Integer;
+BEGIN
+ I := 0; { Initialize dest }
+ J := 0; { Intialize test }
+ While (I<Count) AND (J<Limit) Do Begin { Check fully packed }
+ If (Items^[J]<>Nil) Then Begin { Found a valid item }
+ If (I<>J) Then Begin
+ Items^[I] := Items^[J]; { Transfer item }
+ Items^[J] := Nil; { Now clear old item }
+ End;
+ Inc(I); { One item packed }
+ End;
+ Inc(J); { Next item to test }
+ End;
+ If (I<Count) Then Count := I; { New packed count }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ FreeAll -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.FreeAll;
+VAR I: Sw_Integer;
+BEGIN
+ for I := Count-1 downto 0 do
+ FreeItem(At(I));
+ Count := 0; { Clear item count }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ DeleteAll -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.DeleteAll;
+BEGIN
+ Count := 0; { Clear item count }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Free -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.Free (Item: Pointer);
+BEGIN
+ Delete(Item); { Delete from list }
+ FreeItem(Item); { Free the item }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Insert -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.Insert (Item: Pointer);
+BEGIN
+ AtInsert(Count, Item); { Insert item }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Delete -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.Delete (Item: Pointer);
+BEGIN
+ AtDelete(IndexOf(Item)); { Delete from list }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ AtFree -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.AtFree (Index: Sw_Integer);
+VAR Item: Pointer;
+BEGIN
+ Item := At(Index); { Retreive item ptr }
+ AtDelete(Index); { Delete item }
+ FreeItem(Item); { Free the item }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.FreeItem (Item: Pointer);
+VAR P: PObject;
+BEGIN
+ P := PObject(Item); { Convert pointer }
+ If (P<>Nil) Then Dispose(P, Done); { Dispose of object }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ AtDelete -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.AtDelete (Index: Sw_Integer);
+BEGIN
+ If (Index >= 0) AND (Index < Count) Then Begin { Valid index }
+ Dec(Count); { One less item }
+ If (Count>Index) Then Move(Items^[Index+1],
+ Items^[Index], (Count-Index)*Sizeof(Pointer)); { Shuffle items down }
+ End Else Error(coIndexError, Index); { Index error }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ ForEach -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.ForEach (Action: Pointer);
+VAR I: LongInt;
+BEGIN
+ For I := 1 To Count Do { Up from first item }
+ CallPointerLocal(Action,get_caller_frame(get_frame),Items^[I-1]); { Call with each item }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ SetLimit -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.SetLimit (ALimit: Sw_Integer);
+VAR
+ AItems: PItemList;
+BEGIN
+ If (ALimit < Count) Then
+ ALimit := Count;
+ If (ALimit > MaxCollectionSize) Then
+ ALimit := MaxCollectionSize;
+ If (ALimit <> Limit) Then
+ Begin
+ If (ALimit = 0) Then
+ AItems := Nil
+ Else
+ Begin
+ GetMem(AItems, ALimit * SizeOf(Pointer));
+ If (AItems<>Nil) Then
+ FillChar(AItems^,ALimit * SizeOf(Pointer), #0);
+ End;
+ If (AItems<>Nil) OR (ALimit=0) Then
+ Begin
+ If (AItems <>Nil) AND (Items <> Nil) Then
+ Move(Items^, AItems^, Count*SizeOf(Pointer));
+ If (Limit <> 0) AND (Items <> Nil) Then
+ FreeMem(Items, Limit * SizeOf(Pointer));
+ end;
+ Items := AItems;
+ Limit := ALimit;
+ End;
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Error -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.Error (Code, Info: Integer);
+BEGIN
+ RunError(212 - Code); { Run error }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ AtPut -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.AtPut (Index: Sw_Integer; Item: Pointer);
+BEGIN
+ If (Index >= 0) AND (Index < Count) Then { Index valid }
+ Items^[Index] := Item { Put item in index }
+ Else Error(coIndexError, Index); { Index error }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ AtInsert -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.AtInsert (Index: Sw_Integer; Item: Pointer);
+VAR I: Sw_Integer;
+BEGIN
+ If (Index >= 0) AND (Index <= Count) Then Begin { Valid index }
+ If (Count=Limit) Then SetLimit(Limit+Delta); { Expand size if able }
+ If (Limit>Count) Then Begin
+ If (Index < Count) Then Begin { Not last item }
+ For I := Count-1 DownTo Index Do { Start from back }
+ Items^[I+1] := Items^[I]; { Move each item }
+ End;
+ Items^[Index] := Item; { Put item in list }
+ Inc(Count); { Inc count }
+ End Else Error(coOverflow, Index); { Expand failed }
+ End Else Error(coIndexError, Index); { Index error }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ Store -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.Store (Var S: TStream);
+var
+ LimitWord, DeltaWord: Word;
+
+ PROCEDURE DoPutItem (P: Pointer);{$IFNDEF FPC}FAR;{$ENDIF}
+ BEGIN
+ PutItem(S, P); { Put item on stream }
+ END;
+
+BEGIN
+ If S.TPCompatible Then Begin
+ { Check if it is safe to write in TP-compatible stream.
+ If Count is too big, signal an error.
+ If Limit or Delta are too big, write smaller values. }
+ If (Count > MaxTPCompatibleCollectionSize)
+ Then S.Error(stWriteError, 0)
+ Else Begin
+ S.Write(Count, Sizeof(Word));
+ if Limit > MaxTPCompatibleCollectionSize
+ then LimitWord := MaxTPCompatibleCollectionSize
+ else LimitWord := Limit;
+ S.Write(LimitWord, Sizeof(Word));
+ if Delta > MaxTPCompatibleCollectionSize
+ then DeltaWord := MaxTPCompatibleCollectionSize
+ else DeltaWord := Delta;
+ S.Write(DeltaWord, Sizeof(Word));
+ End
+ End
+ Else Begin
+ S.Write(Count, Sizeof(Count)); { Write count }
+ S.Write(Limit, Sizeof(Limit)); { Write limit }
+ S.Write(Delta, Sizeof(Delta)); { Write delta }
+ End;
+ ForEach(@DoPutItem); { Each item to stream }
+END;
+
+{--TCollection--------------------------------------------------------------}
+{ PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TCollection.PutItem (Var S: TStream; Item: Pointer);
+BEGIN
+ S.Put(Item); { Put item on stream }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TSortedCollection OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TSortedCollection--------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TSortedCollection.Init (ALimit, ADelta: Sw_Integer);
+BEGIN
+ Inherited Init(ALimit, ADelta); { Call ancestor }
+ Duplicates := False; { Clear flag }
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ Load -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TSortedCollection.Load (Var S: TStream);
+BEGIN
+ Inherited Load(S); { Call ancestor }
+ S.Read(Duplicates, SizeOf(Duplicates)); { Read duplicate flag }
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ KeyOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TSortedCollection.KeyOf (Item: Pointer): Pointer;
+BEGIN
+ KeyOf := Item; { Return item as key }
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ IndexOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TSortedCollection.IndexOf (Item: Pointer): Sw_Integer;
+VAR I, J: Sw_Integer;
+BEGIN
+ J := -1; { Preset result }
+ If Search(KeyOf(Item), I) Then Begin { Search for item }
+ If Duplicates Then { Duplicates allowed }
+ While (I < Count) AND (Item <> Items^[I]) Do
+ Inc(I); { Count duplicates }
+ If (I < Count) Then J := I; { Index result }
+ End;
+ IndexOf := J; { Return result }
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TSortedCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
+BEGIN
+ Abstract; { Abstract method }
+ Compare:=0;
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ Search -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TSortedCollection.Search (Key: Pointer; Var Index: Sw_Integer): Boolean;
+VAR L, H, I, C: Sw_Integer;
+BEGIN
+ Search := False; { Preset failure }
+ L := 0; { Start count }
+ H := Count - 1; { End count }
+ While (L <= H) Do Begin
+ I := (L + H) SHR 1; { Mid point }
+ C := Compare(KeyOf(Items^[I]), Key); { Compare with key }
+ If (C < 0) Then L := I + 1 Else Begin { Item to left }
+ H := I - 1; { Item to right }
+ If C = 0 Then Begin { Item match found }
+ Search := True; { Result true }
+ If NOT Duplicates Then L := I; { Force kick out }
+ End;
+ End;
+ End;
+ Index := L; { Return result }
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ Insert -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TSortedCollection.Insert (Item: Pointer);
+VAR I: Sw_Integer;
+BEGIN
+ If NOT Search(KeyOf(Item), I) OR Duplicates Then { Item valid }
+ AtInsert(I, Item); { Insert the item }
+END;
+
+{--TSortedCollection--------------------------------------------------------}
+{ Store -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TSortedCollection.Store (Var S: TStream);
+BEGIN
+ TCollection.Store(S); { Call ancestor }
+ S.Write(Duplicates, SizeOf(Duplicates)); { Write duplicate flag }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TStringCollection OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TStringCollection--------------------------------------------------------}
+{ GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStringCollection.GetItem (Var S: TStream): Pointer;
+BEGIN
+ GetItem := S.ReadStr; { Get new item }
+END;
+
+{--TStringCollection--------------------------------------------------------}
+{ Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 21Aug97 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStringCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
+VAR I, J: Sw_Integer; P1, P2: PString;
+BEGIN
+ P1 := PString(Key1); { String 1 pointer }
+ P2 := PString(Key2); { String 2 pointer }
+ If (Length(P1^)<Length(P2^)) Then J := Length(P1^)
+ Else J := Length(P2^); { Shortest length }
+ I := 1; { First character }
+ While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I); { Scan till fail }
+ If (I=J) Then Begin { Possible match }
+ { * REMARK * - Bug fix 21 August 1997 }
+ If (P1^[I]<P2^[I]) Then Compare := -1 Else { String1 < String2 }
+ If (P1^[I]>P2^[I]) Then Compare := 1 Else { String1 > String2 }
+ If (Length(P1^)>Length(P2^)) Then Compare := 1 { String1 > String2 }
+ Else If (Length(P1^)<Length(P2^)) Then { String1 < String2 }
+ Compare := -1 Else Compare := 0; { String1 = String2 }
+ { * REMARK END * - Leon de Boer }
+ End Else If (P1^[I]<P2^[I]) Then Compare := -1 { String1 < String2 }
+ Else Compare := 1; { String1 > String2 }
+END;
+
+{--TStringCollection--------------------------------------------------------}
+{ FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStringCollection.FreeItem (Item: Pointer);
+BEGIN
+ DisposeStr(Item); { Dispose item }
+END;
+
+{--TStringCollection--------------------------------------------------------}
+{ PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStringCollection.PutItem (Var S: TStream; Item: Pointer);
+BEGIN
+ S.WriteStr(Item); { Write string }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TStrCollection OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TStrCollection-----------------------------------------------------------}
+{ Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStrCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
+VAR I, J: Sw_Integer; P1, P2: PByteArray;
+BEGIN
+ P1 := PByteArray(Key1); { PChar 1 pointer }
+ P2 := PByteArray(Key2); { PChar 2 pointer }
+ I := 0; { Preset no size }
+ If (P1<>Nil) Then While (P1^[I]<>0) Do Inc(I); { PChar 1 length }
+ J := 0; { Preset no size }
+ If (P2<>Nil) Then While (P2^[J]<>0) Do Inc(J); { PChar 2 length }
+ If (I < J) Then J := I; { Shortest length }
+ I := 0; { First character }
+ While (I<J) AND (P1^[I]=P2^[I]) Do Inc(I); { Scan till fail }
+ If (P1^[I]=P2^[I]) Then Compare := 0 Else { Strings matched }
+ If (P1^[I]<P2^[I]) Then Compare := -1 Else { String1 < String2 }
+ Compare := 1; { String1 > String2 }
+END;
+
+{--TStrCollection-----------------------------------------------------------}
+{ GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStrCollection.GetItem (Var S: TStream): Pointer;
+BEGIN
+ GetItem := S.StrRead; { Get string item }
+END;
+
+{--TStrCollection-----------------------------------------------------------}
+{ FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStrCollection.FreeItem (Item: Pointer);
+VAR I: Sw_Integer; P: PByteArray;
+BEGIN
+ If (Item<>Nil) Then Begin { Item is valid }
+ P := PByteArray(Item); { Create byte pointer }
+ I := 0; { Preset no size }
+ While (P^[I]<>0) Do Inc(I); { Find PChar end }
+ FreeMem(Item, I+1); { Release memory }
+ End;
+END;
+
+{--TStrCollection-----------------------------------------------------------}
+{ PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStrCollection.PutItem (Var S: TStream; Item: Pointer);
+BEGIN
+ S.StrWrite(Item); { Write the string }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TUnSortedStrCollection OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TUnSortedCollection------------------------------------------------------}
+{ Insert -> Platforms DOS/DPMI/WIN/OS2 - Checked 23May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TUnSortedStrCollection.Insert (Item: Pointer);
+BEGIN
+ AtInsert(Count, Item); { Insert - NO sorting }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TResourceItem RECORD }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+TYPE
+ TResourceItem = packed RECORD
+ Posn: LongInt; { Resource position }
+ Size: LongInt; { Resource size }
+ Key : String; { Resource key }
+ End;
+ PResourceItem = ^TResourceItem;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TResourceCollection OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TResourceCollection------------------------------------------------------}
+{ KeyOf -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TResourceCollection.KeyOf (Item: Pointer): Pointer;
+BEGIN
+ KeyOf := @PResourceItem(Item)^.Key; { Pointer to key }
+END;
+
+{--TResourceCollection------------------------------------------------------}
+{ GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TResourceCollection.GetItem (Var S: TStream): Pointer;
+VAR B: Byte; Pos: Longint; Size: Longint; Ts: String; P: PResourceItem;
+BEGIN
+ S.Read(Pos, SizeOf(Pos)); { Read position }
+ S.Read(Size, SizeOf(Size)); { Read size }
+ S.Read(B, 1); { Read key length }
+ GetMem(P, B + (SizeOf(TResourceItem) -
+ SizeOf(Ts) + 1)); { Allocate min memory }
+ If (P<>Nil) Then Begin { If allocate works }
+ P^.Posn := Pos; { Xfer position }
+ P^.Size := Size; { Xfer size }
+ P^.Key[0] := Char(B); { Xfer string length }
+ S.Read(P^.Key[1], B); { Xfer string data }
+ End;
+ GetItem := P; { Return pointer }
+END;
+
+{--TResourceCollection------------------------------------------------------}
+{ FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TResourceCollection.FreeItem (Item: Pointer);
+VAR Ts: String;
+BEGIN
+ If (Item<>Nil) Then FreeMem(Item,
+ SizeOf(TResourceItem) - SizeOf(Ts) +
+ Length(PResourceItem(Item)^.Key) + 1); { Release memory }
+END;
+
+{--TResourceCollection------------------------------------------------------}
+{ PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 24May96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TResourceCollection.PutItem (Var S: TStream; Item: Pointer);
+VAR Ts: String;
+BEGIN
+ If (Item<>Nil) Then S.Write(PResourceItem(Item)^,
+ SizeOf(TResourceItem) - SizeOf(Ts) +
+ Length(PResourceItem(Item)^.Key) + 1); { Write to stream }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ PRIVATE RESOURCE MANAGER CONSTANTS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+CONST
+ RStreamMagic: LongInt = $52504246; { 'FBPR' }
+ RStreamBackLink: LongInt = $4C424246; { 'FBBL' }
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ PRIVATE RESOURCE MANAGER TYPES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+TYPE
+{$IFDEF NewExeFormat} { New EXE format }
+ TExeHeader = packed RECORD
+ eHdrSize: Word;
+ eMinAbove: Word;
+ eMaxAbove: Word;
+ eInitSS: Word;
+ eInitSP: Word;
+ eCheckSum: Word;
+ eInitPC: Word;
+ eInitCS: Word;
+ eRelocOfs: Word;
+ eOvlyNum: Word;
+ eRelocTab: Word;
+ eSpace: Array[1..30] of Byte;
+ eNewHeader: Word;
+ END;
+{$ENDIF}
+
+ THeader = packed RECORD
+ Signature: Word;
+ Case Integer Of
+ 0: (
+ LastCount: Word;
+ PageCount: Word;
+ ReloCount: Word);
+ 1: (
+ InfoType: Word;
+ InfoSize: Longint);
+ End;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TResourceFile OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TResourceFile------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TResourceFile.Init(AStream: PStream);
+VAR Found, Stop: Boolean; Header: THeader;
+ {$IFDEF NewExeFormat} ExeHeader: TExeHeader; {$ENDIF}
+BEGIN
+ TObject.Init; { Initialize object }
+ Found := False; { Preset false }
+ If (AStream<>Nil) Then Begin
+ Stream := AStream; { Hold stream }
+ BasePos := Stream^.GetPos; { Get position }
+ Repeat
+ Stop := True; { Preset stop }
+ If (BasePos <= Stream^.GetSize-SizeOf(THeader))
+ Then Begin { Valid file header }
+ Stream^.Seek(BasePos); { Seek to position }
+ Stream^.Read(Header, SizeOf(THeader)); { Read header }
+ Case Header.Signature Of
+ {$IFDEF NewExeFormat} { New format file }
+ $5A4D: Begin
+ Stream^.Read(ExeHeader, SizeOf(TExeHeader));
+ BasePos := ExeHeader.eNewHeader; { Hold position }
+ Stop := False; { Clear stop flag }
+ End;
+ $454E: Begin
+ BasePos := Stream^.GetSize - 8; { Hold position }
+ Stop := False; { Clear stop flag }
+ End;
+ $4246: Begin
+ Stop := False; { Clear stop flag }
+ Case Header.Infotype Of
+ $5250: Begin { Found Resource }
+ Found := True; { Found flag is true }
+ Stop := True; { Set stop flag }
+ End;
+ $4C42: Dec(BasePos, Header.InfoSize-8);{ Found BackLink }
+ $4648: Dec(BasePos, SizeOf(THeader)*2);{ Found HelpFile }
+ Else Stop := True; { Set stop flag }
+ End;
+ End;
+ $424E: If Header.InfoType = $3230 { Found Debug Info }
+ Then Begin
+ Dec(BasePos, Header.InfoSize); { Adjust position }
+ Stop := False; { Clear stop flag }
+ End;
+ {$ELSE}
+ $5A4D: Begin
+ Inc(BasePos, LongInt(Header.PageCount)*512
+ - (-Header.LastCount AND 511)); { Calc position }
+ Stop := False; { Clear stop flag }
+ End;
+ $4246: If Header.InfoType = $5250 Then { Header was found }
+ Found := True Else Begin
+ Inc(BasePos, Header.InfoSize + 8); { Adjust position }
+ Stop := False; { Clear stop flag }
+ End;
+ {$ENDIF}
+ End;
+ End;
+ Until Stop; { Until flag is set }
+ End;
+ If Found Then Begin { Resource was found }
+ Stream^.Seek(BasePos + SizeOf(LongInt) * 2); { Seek to position }
+ Stream^.Read(IndexPos, SizeOf(LongInt)); { Read index position }
+ Stream^.Seek(BasePos + IndexPos); { Seek to resource }
+ Index.Load(Stream^); { Load resource }
+ End Else Begin
+ IndexPos := SizeOf(LongInt) * 3; { Set index position }
+ Index.Init(0, 8); { Set index }
+ End;
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TResourceFile.Done;
+BEGIN
+ Flush; { Flush the file }
+ Index.Done; { Dispose of index }
+ If (Stream<>Nil) Then Dispose(Stream, Done); { Dispose of stream }
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ Count -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TResourceFile.Count: Sw_Integer;
+BEGIN
+ Count := Index.Count; { Return index count }
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ KeyAt -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TResourceFile.KeyAt (I: Sw_Integer): String;
+BEGIN
+ KeyAt := PResourceItem(Index.At(I))^.Key; { Return key }
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TResourceFile.Get (Key: String): PObject;
+VAR I: Sw_Integer;
+BEGIN
+ If (Stream = Nil) OR (NOT Index.Search(@Key, I)) { No match on key }
+ Then Get := Nil Else Begin
+ Stream^.Seek(BasePos +
+ PResourceItem(Index.At(I))^.Posn); { Seek to position }
+ Get := Stream^.Get; { Get item }
+ End;
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ SwitchTo -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TResourceFile.SwitchTo (AStream: PStream; Pack: Boolean): PStream;
+VAR NewBasePos: LongInt;
+
+ PROCEDURE DoCopyResource (Item: PResourceItem);{$IFNDEF FPC}FAR;{$ENDIF}
+ BEGIN
+ Stream^.Seek(BasePos + Item^.Posn); { Move stream position }
+ Item^.Posn := AStream^.GetPos - NewBasePos; { Hold new position }
+ AStream^.CopyFrom(Stream^, Item^.Size); { Copy the item }
+ END;
+
+BEGIN
+ SwitchTo := Stream; { Preset return }
+ If (AStream<>Nil) AND (Stream<>Nil) Then Begin { Both streams valid }
+ NewBasePos := AStream^.GetPos; { Get position }
+ If Pack Then Begin
+ AStream^.Seek(NewBasePos + SizeOf(LongInt)*3); { Seek to position }
+ Index.ForEach(@DoCopyResource); { Copy each resource }
+ IndexPos := AStream^.GetPos - NewBasePos; { Hold index position }
+ End Else Begin
+ Stream^.Seek(BasePos); { Seek to position }
+ AStream^.CopyFrom(Stream^, IndexPos); { Copy the resource }
+ End;
+ Stream := AStream; { Hold new stream }
+ BasePos := NewBasePos; { New base position }
+ Modified := True; { Set modified flag }
+ End;
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ Flush -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TResourceFile.Flush;
+VAR ResSize: LongInt; LinkSize: LongInt;
+BEGIN
+ If (Modified) AND (Stream<>Nil) Then Begin { We have modification }
+ Stream^.Seek(BasePos + IndexPos); { Seek to position }
+ Index.Store(Stream^); { Store the item }
+ ResSize := Stream^.GetPos - BasePos; { Hold position }
+ LinkSize := ResSize + SizeOf(LongInt) * 2; { Hold link size }
+ Stream^.Write(RStreamBackLink, SizeOf(LongInt)); { Write link back }
+ Stream^.Write(LinkSize, SizeOf(LongInt)); { Write link size }
+ Stream^.Seek(BasePos); { Move stream position }
+ Stream^.Write(RStreamMagic, SizeOf(LongInt)); { Write number }
+ Stream^.Write(ResSize, SizeOf(LongInt)); { Write record size }
+ Stream^.Write(IndexPos, SizeOf(LongInt)); { Write index position }
+ Stream^.Flush; { Flush the stream }
+ End;
+ Modified := False; { Clear modified flag }
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ Delete -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TResourceFile.Delete (Key: String);
+VAR I: Sw_Integer;
+BEGIN
+ If Index.Search(@Key, I) Then Begin { Search for key }
+ Index.Free(Index.At(I)); { Delete from index }
+ Modified := True; { Set modified flag }
+ End;
+END;
+
+{--TResourceFile------------------------------------------------------------}
+{ Put -> Platforms DOS/DPMI/WIN/OS2 - Checked 18Jun96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TResourceFile.Put (Item: PObject; Key: String);
+VAR I: Sw_Integer; Ts: String; P: PResourceItem;
+BEGIN
+ If (Stream=Nil) Then Exit; { Stream not valid }
+ If Index.Search(@Key, I) Then P := Index.At(I) { Search for item }
+ Else Begin
+ GetMem(P, Length(Key) + (SizeOf(TResourceItem) -
+ SizeOf(Ts) + 1)); { Allocate memory }
+ If (P<>Nil) Then Begin
+ P^.Key := Key; { Store key }
+ Index.AtInsert(I, P); { Insert item }
+ End;
+ End;
+ If (P<>Nil) Then Begin
+ P^.Posn := IndexPos; { Set index position }
+ Stream^.Seek(BasePos + IndexPos); { Seek file position }
+ Stream^.Put(Item); { Put item on stream }
+ IndexPos := Stream^.GetPos - BasePos; { Hold index position }
+ P^.Size := IndexPos - P^.Posn; { Calc size }
+ Modified := True; { Set modified flag }
+ End;
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TStringList OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TStringList--------------------------------------------------------------}
+{ Load -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TStringList.Load (Var S: TStream);
+VAR Size: Word;
+BEGIN
+ Stream := @S; { Hold stream pointer }
+ S.Read(Size, SizeOf(Word)); { Read size }
+ BasePos := S.GetPos; { Hold position }
+ S.Seek(BasePos + Size); { Seek to position }
+ S.Read(IndexSize, SizeOf(Integer)); { Read index size }
+ GetMem(Index, IndexSize * SizeOf(TStrIndexRec)); { Allocate memory }
+ S.Read(Index^, IndexSize * SizeOf(TStrIndexRec)); { Read indexes }
+END;
+
+{--TStringList--------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TStringList.Done;
+BEGIN
+ FreeMem(Index, IndexSize * SizeOf(TStrIndexRec)); { Release memory }
+END;
+
+{--TStringList--------------------------------------------------------------}
+{ Get -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION TStringList.Get (Key: Sw_Word): String;
+VAR I: Word; S: String;
+BEGIN
+ S := ''; { Preset empty string }
+ If (IndexSize>0) Then Begin { We must have strings }
+ I := 0; { First entry }
+ While (I<IndexSize) AND (S='') Do Begin
+ If ((Key - Index^[I].Key)<Index^[I].Count) { Diff less than count }
+ Then ReadStr(S, Index^[I].Offset,
+ Key-Index^[I].Key); { Read the string }
+ Inc(I); { Next entry }
+ End;
+ End;
+ Get := S; { Return empty string }
+END;
+
+{***************************************************************************}
+{ TStringList PRIVATE METHODS }
+{***************************************************************************}
+
+{--TStringLis---------------------------------------------------------------}
+{ ReadStr -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStringList.ReadStr (Var S: String; Offset, Skip: Longint);
+BEGIN
+ Stream^.Seek(BasePos + Offset); { Seek to position }
+ Inc(Skip); { Adjust skip }
+ Repeat
+ Stream^.Read(S[0], 1); { Read string size }
+ Stream^.Read(S[1], Ord(S[0])); { Read string data }
+ Dec(Skip); { One string read }
+ Until (Skip = 0);
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ TStrListMaker OBJECT METHODS }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{--TStrListMaker------------------------------------------------------------}
+{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+CONSTRUCTOR TStrListMaker.Init (AStrSize, AIndexSize: Sw_Word);
+BEGIN
+ Inherited Init; { Call ancestor }
+ StrSize := AStrSize; { Hold size }
+ IndexSize := AIndexSize; { Hold index size }
+ GetMem(Strings, AStrSize); { Allocate memory }
+ GetMem(Index, AIndexSize * SizeOf(TStrIndexRec)); { Allocate memory }
+END;
+
+{--TStrListMaker------------------------------------------------------------}
+{ Done -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+DESTRUCTOR TStrListMaker.Done;
+BEGIN
+ FreeMem(Index, IndexSize * SizeOf(TStrIndexRec)); { Free index memory }
+ FreeMem(Strings, StrSize); { Free data memory }
+END;
+
+{--TStrListMaker------------------------------------------------------------}
+{ Put -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStrListMaker.Put (Key: Sw_Word; S: String);
+BEGIN
+ If (Cur.Count = 16) OR (Key <> Cur.Key + Cur.Count)
+ Then CloseCurrent; { Close current }
+ If (Cur.Count = 0) Then Begin
+ Cur.Key := Key; { Set key }
+ Cur.Offset := StrPos; { Set offset }
+ End;
+ Inc(Cur.Count); { Inc count }
+ Move(S, Strings^[StrPos], Length(S) + 1); { Move string data }
+ Inc(StrPos, Length(S) + 1); { Adjust position }
+END;
+
+{--TStrListMaker------------------------------------------------------------}
+{ Store -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStrListMaker.Store (Var S: TStream);
+BEGIN
+ CloseCurrent; { Close all current }
+ S.Write(StrPos, SizeOf(Word)); { Write position }
+ S.Write(Strings^, StrPos); { Write string data }
+ S.Write(IndexPos, SizeOf(Word)); { Write index position }
+ S.Write(Index^, IndexPos * SizeOf(TStrIndexRec)); { Write indexes }
+END;
+
+{***************************************************************************}
+{ TStrListMaker PRIVATE METHODS }
+{***************************************************************************}
+
+{--TStrListMaker------------------------------------------------------------}
+{ CloseCurrent -> Platforms DOS/DPMI/WIN/OS2 - Checked 30Jun97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE TStrListMaker.CloseCurrent;
+BEGIN
+ If (Cur.Count <> 0) Then Begin
+ Index^[IndexPos] := Cur; { Hold index position }
+ Inc(IndexPos); { Next index }
+ Cur.Count := 0; { Adjust count }
+ End;
+END;
+
+{***************************************************************************}
+{ INTERFACE ROUTINES }
+{***************************************************************************}
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ DYNAMIC STRING INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{ NewStr -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION NewStr (Const S: String): PString;
+VAR P: PString;
+BEGIN
+ If (S = '') Then P := Nil Else Begin { Return nil }
+ GetMem(P, Length(S) + 1); { Allocate memory }
+ If (P<>Nil) Then P^ := S; { Hold string }
+ End;
+ NewStr := P; { Return result }
+END;
+
+{---------------------------------------------------------------------------}
+{ DisposeStr -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE DisposeStr (P: PString);
+BEGIN
+ If (P <> Nil) Then FreeMem(P, Length(P^) + 1); { Release memory }
+END;
+
+
+PROCEDURE SetStr(VAR p:pString; CONST s:STRING);
+BEGIN
+ IF p<>NIL THEN
+ FreeMem(P, Length(P^) + 1);
+ GetMem(p,LENGTH(s)+1);
+ pSTRING(p)^ := s
+END;
+
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ STREAM INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{ Abstract -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 12Jun96 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE Abstract;
+BEGIN
+ RunError(211); { Abstract error }
+END;
+
+{---------------------------------------------------------------------------}
+{ RegisterObjects -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 02Sep97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE RegisterObjects;
+BEGIN
+ RegisterType(RCollection); { Register object }
+ RegisterType(RStringCollection); { Register object }
+ RegisterType(RStrCollection); { Register object }
+END;
+
+{---------------------------------------------------------------------------}
+{ RegisterType -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 02Sep97 LdB }
+{---------------------------------------------------------------------------}
+PROCEDURE RegisterType (Var S: TStreamRec);
+VAR P: PStreamRec;
+BEGIN
+ P := StreamTypes; { Current reg list }
+ While (P <> Nil) AND (P^.ObjType <> S.ObjType)
+ Do P := P^.Next; { Find end of chain }
+ If (P = Nil) AND (S.ObjType <> 0) Then Begin { Valid end found }
+ S.Next := StreamTypes; { Chain the list }
+ StreamTypes := @S; { We are now first }
+ End Else RegisterError; { Register the error }
+END;
+
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+{ GENERAL FUNCTION INTERFACE ROUTINES }
+{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
+
+{---------------------------------------------------------------------------}
+{ LongMul -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 04Sep97 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION LongMul (X, Y: Integer): LongInt;
+ BEGIN
+ LongMul:=Longint(X*Y);
+ END;
+{---------------------------------------------------------------------------}
+{ LongDiv -> Platforms DOS/DPMI/WINDOWS/OS2 - Checked 04Sep97 LdB }
+{---------------------------------------------------------------------------}
+FUNCTION LongDiv (X: LongInt; Y: Integer): Integer;
+BEGIN
+ LongDiv := Integer(X DIV Y);
+END;
+
+
+BEGIN
+ invalidhandle:=UnusedHandle;
+END.
+{
+ $Log: objects.pp,v $
+ Revision 1.37 2005/02/14 17:13:25 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
new file mode 100644
index 0000000000..43ec972faf
--- /dev/null
+++ b/rtl/inc/objpas.inc
@@ -0,0 +1,786 @@
+{
+ $Id: objpas.inc,v 1.50 2005/05/04 08:56:03 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This unit makes Free Pascal as much as possible Delphi compatible
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ Internal Routines called from the Compiler
+****************************************************************************}
+
+ { the reverse order of the parameters make code generation easier }
+ function fpc_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ fpc_do_is:=assigned(aobject) and assigned(aclass) and
+ aobject.inheritsfrom(aclass);
+ end;
+
+
+ { the reverse order of the parameters make code generation easier }
+ function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
+ handleerrorframe(219,get_frame);
+ result := aobject;
+ end;
+
+{$ifndef HASINTF}
+ { dummies for make cycle with 1.0.x }
+ procedure fpc_intf_decr_ref(var i: pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ end;
+
+ procedure fpc_intf_incr_ref(i: pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ end;
+
+ procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ end;
+
+ function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ end;
+
+ function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ end;
+
+{$else HASINTF}
+
+ { interface helpers }
+ procedure fpc_intf_decr_ref(var i: pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if assigned(i) then
+ IUnknown(i)._Release;
+ i:=nil;
+ end;
+
+ {$ifdef hascompilerproc}
+ { local declaration for intf_decr_ref for local access }
+ procedure intf_decr_ref(var i: pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_INTF_DECR_REF'];
+ {$endif hascompilerproc}
+
+
+ procedure fpc_intf_incr_ref(i: pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if assigned(i) then
+ IUnknown(i)._AddRef;
+ end;
+
+ {$ifdef hascompilerproc}
+ { local declaration of intf_incr_ref for local access }
+ procedure intf_incr_ref(i: pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [external name 'FPC_INTF_INCR_REF'];
+ {$endif hascompilerproc}
+
+ procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ if assigned(S) then
+ IUnknown(S)._AddRef;
+ if assigned(D) then
+ IUnknown(D)._Release;
+ D:=S;
+ end;
+
+ function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ tmpi: pointer; // _AddRef before _Release
+ begin
+ if assigned(S) then
+ begin
+ if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
+ handleerror(219);
+ fpc_intf_as:=tmpi;
+ end
+ else
+ fpc_intf_as:=nil;
+ end;
+
+
+ function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+ var
+ tmpi: pointer; // _AddRef before _Release
+ begin
+ if assigned(S) then
+ begin
+ if not TObject(S).GetInterface(iid,tmpi) then
+ handleerror(219);
+ fpc_class_as_intf:=tmpi;
+ end
+ else
+ fpc_class_as_intf:=nil;
+ end;
+{$endif HASINTF}
+
+{****************************************************************************
+ TOBJECT
+****************************************************************************}
+
+ constructor TObject.Create;
+
+ begin
+ end;
+
+ destructor TObject.Destroy;
+
+ begin
+ end;
+
+ procedure TObject.Free;
+
+ begin
+ // the call via self avoids a warning
+ if self<>nil then
+ self.destroy;
+ end;
+
+ class function TObject.InstanceSize : LongInt;
+
+ begin
+ InstanceSize:=plongint(pointer(self)+vmtInstanceSize)^;
+ end;
+
+ procedure InitInterfacePointers(objclass: tclass;instance : pointer);
+
+{$ifdef HASINTF}
+ var
+ intftable : pinterfacetable;
+ i : longint;
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ IOffset : longint;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ begin
+ while assigned(objclass) do
+ begin
+ intftable:=pinterfacetable((pointer(objclass)+vmtIntfTable)^);
+ if assigned(intftable) then
+ for i:=0 to intftable^.EntryCount-1 do
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ begin
+ move(intftable^.Entries[i].IOffset,IOffset,sizeof(longint));
+ move(pointer(intftable^.Entries[i].VTable),ppointer(@(PChar(instance)[IOffset]))^,sizeof(pointer));
+ end;
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+ ppointer(@(PChar(instance)[intftable^.Entries[i].IOffset]))^:=
+ pointer(intftable^.Entries[i].VTable);
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ objclass:=pclass(pointer(objclass)+vmtParent)^;
+ end;
+ end;
+{$else HASINTF}
+ begin
+ end;
+{$endif HASINTF}
+
+ class function TObject.InitInstance(instance : pointer) : tobject;
+
+ begin
+ { the size is saved at offset 0 }
+ fillchar(instance^,plongint(pointer(self)+vmtInstanceSize)^,0);
+ { insert VMT pointer into the new created memory area }
+ { (in class methods self contains the VMT!) }
+ ppointer(instance)^:=pointer(self);
+{$ifdef HASINTF}
+ InitInterfacePointers(self,instance);
+{$endif HASINTF}
+ InitInstance:=TObject(Instance);
+ end;
+
+ class function TObject.ClassParent : tclass;
+
+ begin
+ { type of self is class of tobject => it points to the vmt }
+ { the parent vmt is saved at offset vmtParent }
+ classparent:=pclass(pointer(self)+vmtParent)^;
+ end;
+
+ class function TObject.NewInstance : tobject;
+
+ var
+ p : pointer;
+
+ begin
+ getmem(p,plongint(pointer(self)+vmtInstanceSize)^);
+ if p <> nil then
+ InitInstance(p);
+ NewInstance:=TObject(p);
+ end;
+
+ procedure TObject.FreeInstance;
+
+ begin
+ CleanupInstance;
+ FreeMem(Pointer(Self));
+ end;
+
+ class function TObject.ClassType : TClass;
+
+ begin
+ ClassType:=TClass(Pointer(Self))
+ end;
+
+ type
+ tmethodnamerec = packed record
+ name : pshortstring;
+ addr : pointer;
+ end;
+
+ tmethodnametable = packed record
+ count : dword;
+ entries : packed array[0..0] of tmethodnamerec;
+ end;
+
+ pmethodnametable = ^tmethodnametable;
+
+ class function TObject.MethodAddress(const name : shortstring) : pointer;
+
+ var
+ UName : ShortString;
+ methodtable : pmethodnametable;
+ i : dword;
+ vmt : tclass;
+
+ begin
+ UName := UpCase(name);
+ vmt:=self;
+ while assigned(vmt) do
+ begin
+ methodtable:=pmethodnametable((Pointer(vmt)+vmtMethodTable)^);
+ if assigned(methodtable) then
+ begin
+ for i:=0 to methodtable^.count-1 do
+ if UpCase(methodtable^.entries[i].name^)=UName then
+ begin
+ MethodAddress:=methodtable^.entries[i].addr;
+ exit;
+ end;
+ end;
+ vmt:=pclass(pointer(vmt)+vmtParent)^;
+ end;
+ MethodAddress:=nil;
+ end;
+
+
+ class function TObject.MethodName(address : pointer) : shortstring;
+ var
+ methodtable : pmethodnametable;
+ i : dword;
+ vmt : tclass;
+ begin
+ vmt:=self;
+ while assigned(vmt) do
+ begin
+ methodtable:=pmethodnametable((Pointer(vmt)+vmtMethodTable)^);
+ if assigned(methodtable) then
+ begin
+ for i:=0 to methodtable^.count-1 do
+ if methodtable^.entries[i].addr=address then
+ begin
+ MethodName:=methodtable^.entries[i].name^;
+ exit;
+ end;
+ end;
+ vmt:=pclass(pointer(vmt)+vmtParent)^;
+ end;
+ MethodName:='';
+ end;
+
+
+ function TObject.FieldAddress(const name : shortstring) : pointer;
+ type
+ PFieldInfo = ^TFieldInfo;
+ TFieldInfo =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ FieldOffset: PtrUInt;
+ ClassTypeIndex: Word;
+ Name: ShortString;
+ end;
+
+ PFieldTable = ^TFieldTable;
+ TFieldTable =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ FieldCount: Word;
+ ClassTable: Pointer;
+ { should be array[Word] of TFieldInfo; but
+ Elements have variant size! force at least proper alignment }
+ Fields: array[0..0] of TFieldInfo
+ end;
+
+ var
+ UName: ShortString;
+ CurClassType: TClass;
+ FieldTable: PFieldTable;
+ FieldInfo: PFieldInfo;
+ i: Integer;
+
+ begin
+ if Length(name) > 0 then
+ begin
+ UName := UpCase(name);
+ CurClassType := ClassType;
+ while CurClassType <> nil do
+ begin
+ FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
+ if FieldTable <> nil then
+ begin
+ FieldInfo := @FieldTable^.Fields;
+ for i := 0 to FieldTable^.FieldCount - 1 do
+ begin
+ if UpCase(FieldInfo^.Name) = UName then
+ begin
+ fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
+ exit;
+ end;
+ FieldInfo := @FieldInfo^.Name + 1 + Length(FieldInfo^.Name);
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ { align to largest field of TFieldInfo }
+ FieldInfo := Align(FieldInfo, SizeOf(PtrUInt));
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ end;
+ end;
+ { Try again with the parent class type }
+ CurClassType:=pclass(pointer(CurClassType)+vmtParent)^;
+ end;
+ end;
+
+ fieldaddress:=nil;
+ end;
+
+ function TObject.SafeCallException(exceptobject : tobject;
+ exceptaddr : pointer) : longint;
+
+ begin
+ safecallexception:=0;
+ end;
+
+ class function TObject.ClassInfo : pointer;
+
+ begin
+ ClassInfo:=ppointer(Pointer(self)+vmtTypeInfo)^;
+ end;
+
+ class function TObject.ClassName : ShortString;
+
+ begin
+ ClassName:=PShortString((Pointer(Self)+vmtClassName)^)^;
+ end;
+
+ class function TObject.ClassNameIs(const name : string) : boolean;
+
+ begin
+ ClassNameIs:=Upcase(ClassName)=Upcase(name);
+ end;
+
+ class function TObject.InheritsFrom(aclass : TClass) : Boolean;
+
+ var
+ vmt : tclass;
+
+ begin
+ vmt:=self;
+ while assigned(vmt) do
+ begin
+ if vmt=aclass then
+ begin
+ InheritsFrom:=true;
+ exit;
+ end;
+ vmt:=pclass(pointer(vmt)+vmtParent)^;
+ end;
+ InheritsFrom:=false;
+ end;
+
+ class function TObject.stringmessagetable : pstringmessagetable;
+
+ type
+ pdword = ^dword;
+
+ begin
+ stringmessagetable:=pstringmessagetable((pointer(Self)+vmtMsgStrPtr)^);
+ end;
+
+ type
+ tmessagehandler = procedure(var msg) of object;
+ tmessagehandlerrec = packed record
+ proc : pointer;
+ obj : pointer;
+ end;
+
+
+ procedure TObject.Dispatch(var message);
+
+ type
+ tmsgtable = packed record
+ index : dword;
+ method : pointer;
+ end;
+
+ pmsgtable = ^tmsgtable;
+
+ var
+ index : dword;
+ count,i : longint;
+ msgtable : pmsgtable;
+ p : pointer;
+ vmt : tclass;
+ msghandler : tmessagehandler;
+
+ begin
+ index:=dword(message);
+ vmt:=ClassType;
+ while assigned(vmt) do
+ begin
+ // See if we have messages at all in this class.
+ p:=pointer(vmt)+vmtDynamicTable;
+ If Assigned(p) and (Pdword(p)^<>0) then
+ begin
+ msgtable:=pmsgtable(PtrInt(p^)+4);
+ count:=pdword(p^)^;
+ end
+ else
+ Count:=0;
+ { later, we can implement a binary search here }
+ for i:=0 to count-1 do
+ begin
+ if index=msgtable[i].index then
+ begin
+ p:=msgtable[i].method;
+ tmessagehandlerrec(msghandler).proc:=p;
+ tmessagehandlerrec(msghandler).obj:=self;
+ msghandler(message);
+ exit;
+ end;
+ end;
+ vmt:=pclass(pointer(vmt)+vmtParent)^;
+ end;
+ DefaultHandler(message);
+ end;
+
+ procedure TObject.DispatchStr(var message);
+
+ type
+ PSizeUInt = ^SizeUInt;
+
+ var
+ name : shortstring;
+ count,i : longint;
+ msgstrtable : pmsgstrtable;
+ p : pointer;
+ vmt : tclass;
+ msghandler : tmessagehandler;
+
+ begin
+ name:=pshortstring(@message)^;
+ vmt:=ClassType;
+ while assigned(vmt) do
+ begin
+ p:=(pointer(vmt)+vmtMsgStrPtr);
+ If (P<>Nil) and (PDWord(P)^<>0) then
+ begin
+ count:=pdword(PSizeUInt(p)^)^;
+ msgstrtable:=pmsgstrtable(PSizeUInt(P)^+4);
+ end
+ else
+ Count:=0;
+ { later, we can implement a binary search here }
+ for i:=0 to count-1 do
+ begin
+ if name=msgstrtable[i].name^ then
+ begin
+ p:=msgstrtable[i].method;
+ tmessagehandlerrec(msghandler).proc:=p;
+ tmessagehandlerrec(msghandler).obj:=self;
+ msghandler(message);
+ exit;
+ end;
+ end;
+ vmt:=pclass(pointer(vmt)+vmtParent)^;
+ end;
+ DefaultHandlerStr(message);
+ end;
+
+ procedure TObject.DefaultHandler(var message);
+
+ begin
+ end;
+
+ procedure TObject.DefaultHandlerStr(var message);
+
+ begin
+ end;
+
+ procedure TObject.CleanupInstance;
+
+ Type
+ TRecElem = packed Record
+ Info : Pointer;
+ Offset : Longint;
+ end;
+
+ TRecElemArray = packed array[1..Maxint] of TRecElem;
+
+ PRecRec = ^TRecRec;
+ TRecRec = record
+ Size,Count : Longint;
+ Elements : TRecElemArray;
+ end;
+
+ var
+ vmt : tclass;
+ temp : pbyte;
+ count,
+ i : longint;
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ recelem : TRecElem;
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ begin
+ vmt:=ClassType;
+ while vmt<>nil do
+ begin
+ { This need to be included here, because Finalize()
+ has should support for tkClass }
+ Temp:=Pointer((Pointer(vmt)+vmtInitTable)^);
+ if Assigned(Temp) then
+ begin
+ inc(Temp);
+ I:=Temp^;
+ inc(temp,I+1); // skip name string;
+{$ifdef FPC_ALIGNSRTTI}
+ temp:=aligntoptr(temp);
+{$endif FPC_ALIGNSRTTI}
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ move(PRecRec(Temp)^.Count,Count,sizeof(Count));
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+ Count:=PRecRec(Temp)^.Count; // get element Count
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ For I:=1 to count do
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ begin
+ move(PRecRec(Temp)^.elements[I],RecElem,sizeof(RecElem));
+ With RecElem do
+ int_Finalize (pointer(self)+Offset,Info);
+ end;
+{$else FPC_REQUIRES_PROPER_ALIGNMENT}
+ With PRecRec(Temp)^.elements[I] do
+ int_Finalize (pointer(self)+Offset,Info);
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ end;
+ vmt:=pclass(pointer(vmt)+vmtParent)^;
+ end;
+ end;
+
+ procedure TObject.AfterConstruction;
+
+ begin
+ end;
+
+ procedure TObject.BeforeDestruction;
+
+ begin
+ end;
+
+{$ifdef HASINTF}
+ function IsGUIDEqual(const guid1, guid2: tguid): boolean;
+ begin
+ IsGUIDEqual:=
+ (guid1.D1=guid2.D1) and
+ (PDWORD(@guid1.D2)^=PDWORD(@guid2.D2)^) and
+ (PDWORD(@guid1.D4[0])^=PDWORD(@guid2.D4[0])^) and
+ (PDWORD(@guid1.D4[4])^=PDWORD(@guid2.D4[4])^);
+ end;
+
+ function TObject.getinterface(const iid : tguid;out obj) : boolean;
+ var
+ IEntry: pinterfaceentry;
+ begin
+ IEntry:=getinterfaceentry(iid);
+ if Assigned(IEntry) then
+ begin
+ Pointer(obj):=Pointer(Self)+IEntry^.IOffset;
+ if assigned(pointer(obj)) then
+ iinterface(obj)._AddRef;
+ getinterface:=True;
+ end
+ else
+ begin
+ PPointer(@Obj)^:=nil;
+ getinterface:=False;
+ end;
+ end;
+
+ function TObject.getinterfacebystr(const iidstr : string;out obj) : boolean;
+ var
+ IEntry: pinterfaceentry;
+ begin
+ IEntry:=getinterfaceentrybystr(iidstr);
+ if Assigned(IEntry) then
+ begin
+ Pointer(obj):=Pointer(Self)+IEntry^.IOffset;
+ if assigned(pointer(obj)) then
+ iinterface(obj)._AddRef;
+ getinterfacebystr:=True;
+ end
+ else
+ begin
+ PPointer(@Obj)^:=nil;
+ getinterfacebystr:=False;
+ end;
+ end;
+
+ class function TObject.getinterfaceentry(const iid : tguid) : pinterfaceentry;
+ var
+ i: integer;
+ intftable: pinterfacetable;
+ Res: pinterfaceentry;
+ begin
+ getinterfaceentry:=nil;
+ intftable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
+ if assigned(intftable) then begin
+ i:=intftable^.EntryCount;
+ Res:=@intftable^.Entries[0];
+ while (i>0) and
+ not (assigned(Res^.iid) and IsGUIDEqual(Res^.iid^,iid)) do begin
+ inc(Res);
+ dec(i);
+ end;
+ if (i>0) then
+ getinterfaceentry:=Res;
+ end;
+ if (getinterfaceentry=nil)and not(classparent=nil) then
+ getinterfaceentry:=classparent.getinterfaceentry(iid)
+ end;
+
+ class function TObject.getinterfaceentrybystr(const iidstr : string) : pinterfaceentry;
+ var
+ i: integer;
+ intftable: pinterfacetable;
+ Res: pinterfaceentry;
+ begin
+ getinterfaceentrybystr:=nil;
+ intftable:=getinterfacetable;
+ if assigned(intftable) then begin
+ i:=intftable^.EntryCount;
+ Res:=@intftable^.Entries[0];
+ while (i>0) and (Res^.iidstr^<>iidstr) do begin
+ inc(Res);
+ dec(i);
+ end;
+ if (i>0) then
+ getinterfaceentrybystr:=Res;
+ end;
+ if (getinterfaceentrybystr=nil)and not(classparent=nil) then
+ getinterfaceentrybystr:=classparent.getinterfaceentrybystr(iidstr)
+ end;
+
+ class function TObject.getinterfacetable : pinterfacetable;
+ begin
+ getinterfacetable:=pinterfacetable((pointer(Self)+vmtIntfTable)^);
+ end;
+
+{****************************************************************************
+ TINTERFACEDOBJECT
+****************************************************************************}
+
+ function TInterfacedObject.QueryInterface(
+ const iid : tguid;out obj) : longint;stdcall;
+
+ begin
+ if getinterface(iid,obj) then
+ result:=0
+ else
+ result:=longint($80004002);
+ end;
+
+ function TInterfacedObject._AddRef : longint;stdcall;
+
+ begin
+ inclocked(frefcount);
+ _addref:=frefcount;
+ end;
+
+ function TInterfacedObject._Release : longint;stdcall;
+
+ begin
+ if declocked(frefcount) then
+ begin
+ self.destroy;
+ _Release:=0;
+ end
+ else
+ _Release:=frefcount;
+ end;
+
+ procedure TInterfacedObject.AfterConstruction;
+
+ begin
+ { we need to fix the refcount we forced in newinstance }
+ { further, it must be done in a thread safe way }
+ declocked(frefcount);
+ end;
+
+ procedure TInterfacedObject.BeforeDestruction;
+
+ begin
+ if frefcount<>0 then
+ HandleError(204);
+ end;
+
+ class function TInterfacedObject.NewInstance : TObject;
+
+ begin
+ NewInstance:=inherited NewInstance;
+ TInterfacedObject(NewInstance).frefcount:=1;
+ end;
+
+{$endif HASINTF}
+
+{****************************************************************************
+ Exception Support
+****************************************************************************}
+
+{$i except.inc}
+
+{****************************************************************************
+ Initialize
+****************************************************************************}
+
+{
+ $Log: objpas.inc,v $
+ Revision 1.50 2005/05/04 08:56:03 michael
+ + Removed S_OK declarations, they are in objpash.inc
+
+ Revision 1.49 2005/04/28 17:58:18 florian
+ * getinterface fixed
+
+ Revision 1.48 2005/04/05 21:05:31 peter
+ * call initspecialchars if one of the specialchars is configured
+ for the first time
+
+ Revision 1.47 2005/03/13 08:34:58 florian
+ * fixed FieldAddress for 64 bit and CPUs requiring proper alignment
+
+ Revision 1.46 2005/02/14 17:13:26 peter
+ * truncate log
+
+}
+
+
+
diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc
new file mode 100644
index 0000000000..2c71a82245
--- /dev/null
+++ b/rtl/inc/objpash.inc
@@ -0,0 +1,329 @@
+{
+ $Id: objpash.inc,v 1.28 2005/02/14 17:13:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This unit makes Free Pascal as much as possible Delphi compatible
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Basic Types/constants
+*****************************************************************************}
+
+ const
+ vmtInstanceSize = 0;
+ vmtParent = sizeof(ptrint)*2;
+ { These were negative value's, but are now positive, else classes
+ couldn't be used with shared linking which copies only all data from
+ the .global directive and not the data before the directive (PFV) }
+ vmtClassName = vmtParent+sizeof(pointer);
+ vmtDynamicTable = vmtParent+sizeof(pointer)*2;
+ vmtMethodTable = vmtParent+sizeof(pointer)*3;
+ vmtFieldTable = vmtParent+sizeof(pointer)*4;
+ vmtTypeInfo = vmtParent+sizeof(pointer)*5;
+ vmtInitTable = vmtParent+sizeof(pointer)*6;
+ vmtAutoTable = vmtParent+sizeof(pointer)*7;
+ vmtIntfTable = vmtParent+sizeof(pointer)*8;
+ vmtMsgStrPtr = vmtParent+sizeof(pointer)*9;
+ { methods }
+ vmtMethodStart = vmtParent+sizeof(pointer)*10;
+ vmtDestroy = vmtMethodStart;
+ vmtNewInstance = vmtMethodStart+sizeof(pointer);
+ vmtFreeInstance = vmtMethodStart+sizeof(pointer)*2;
+ vmtSafeCallException = vmtMethodStart+sizeof(pointer)*3;
+ vmtDefaultHandler = vmtMethodStart+sizeof(pointer)*4;
+ vmtAfterConstruction = vmtMethodStart+sizeof(pointer)*5;
+ vmtBeforeDestruction = vmtMethodStart+sizeof(pointer)*6;
+ vmtDefaultHandlerStr = vmtMethodStart+sizeof(pointer)*7;
+
+ { IInterface }
+ S_OK = 0;
+ S_FALSE = 1;
+ E_NOINTERFACE = hresult($80004002);
+ E_UNEXPECTED = hresult($8000FFFF);
+ E_NOTIMPL = hresult($80004001);
+
+ type
+ TextFile = Text;
+
+ { now the let's declare the base classes for the class object }
+ { model }
+ TObject = class;
+ TClass = class of tobject;
+ PClass = ^tclass;
+
+
+ { to access the message table from outside }
+ TMsgStrTable = record
+ name : pshortstring;
+ method : pointer;
+ end;
+
+ PMsgStrTable = ^TMsgStrTable;
+
+ TStringMessageTable = record
+ count : dword;
+ msgstrtable : array[0..0] of tmsgstrtable;
+ end;
+
+ pstringmessagetable = ^tstringmessagetable;
+
+ PGuid = ^TGuid;
+ TGuid = packed record
+ case integer of
+ 1 : (
+ Data1 : DWord;
+ Data2 : word;
+ Data3 : word;
+ Data4 : array[0..7] of byte;
+ );
+ 2 : (
+ D1 : DWord;
+ D2 : word;
+ D3 : word;
+ D4 : array[0..7] of byte;
+ );
+ end;
+
+ pinterfaceentry = ^tinterfaceentry;
+ tinterfaceentry = packed record
+ IID: pguid; { if assigned(IID) then Com else Corba}
+ VTable: Pointer;
+ IOffset: DWord;
+ IIDStr: pshortstring; { never nil. Com: upper(GuidToString(IID^)) }
+ end;
+
+ pinterfacetable = ^tinterfacetable;
+ tinterfacetable = packed record
+ EntryCount: Word;
+ Entries: array[0..0] of tinterfaceentry;
+ end;
+
+ TMethod = record
+ Code, Data : Pointer;
+ end;
+
+ TObject = class
+ public
+ { please don't change the order of virtual methods, because
+ their vmt offsets are used by some assembler code which uses
+ hard coded addresses (FK) }
+ constructor Create;
+ { the virtual procedures must be in THAT order }
+ destructor Destroy;virtual;
+ class function newinstance : tobject;virtual;
+ procedure FreeInstance;virtual;
+ function SafeCallException(exceptobject : tobject;
+ exceptaddr : pointer) : longint;virtual;
+ procedure DefaultHandler(var message);virtual;
+
+ procedure Free;
+ class function InitInstance(instance : pointer) : tobject;
+ procedure CleanupInstance;
+ class function ClassType : tclass;
+ class function ClassInfo : pointer;
+ class function ClassName : shortstring;
+ class function ClassNameIs(const name : string) : boolean;
+ class function ClassParent : tclass;
+ class function InstanceSize : longint;
+ class function InheritsFrom(aclass : tclass) : boolean;
+ class function StringMessageTable : pstringmessagetable;
+ { message handling routines }
+ procedure Dispatch(var message);
+ procedure DispatchStr(var message);
+
+ class function MethodAddress(const name : shortstring) : pointer;
+ class function MethodName(address : pointer) : shortstring;
+ function FieldAddress(const name : shortstring) : pointer;
+
+ { new since Delphi 4 }
+ procedure AfterConstruction;virtual;
+ procedure BeforeDestruction;virtual;
+
+ { new for gtk, default handler for text based messages }
+ procedure DefaultHandlerStr(var message);virtual;
+
+{$ifdef HASINTF}
+ { interface functions }
+ function GetInterface(const iid : tguid; out obj) : boolean;
+ function GetInterfaceByStr(const iidstr : string; out obj) : boolean;
+ class function GetInterfaceEntry(const iid : tguid) : pinterfaceentry;
+ class function GetInterfaceEntryByStr(const iidstr : string) : pinterfaceentry;
+ class function GetInterfaceTable : pinterfacetable;
+{$endif HASINTF}
+ end;
+
+{$ifdef HASINTF}
+ IUnknown = interface
+ ['{00000000-0000-0000-C000-000000000046}']
+ function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
+ function _AddRef : longint;stdcall;
+ function _Release : longint;stdcall;
+ end;
+ IInterface = IUnknown;
+
+ {$M+}
+ IInvokable = interface(IInterface)
+ end;
+ {$M-}
+
+ { for native dispinterface support }
+ IDispatch = interface(IUnknown)
+ ['{00020400-0000-0000-C000-000000000046}']
+ function GetTypeInfoCount(out count : longint) : longint;stdcall;
+ function GetTypeInfo(Index,LocaleID : longint;
+ out TypeInfo): LongInt;stdcall;
+ function GetIDsOfNames(const iid: TGUID; names: Pointer;
+ NameCount, LocaleID: LongInt; DispIDs: Pointer) : longint;stdcall;
+ function Invoke(DispID: LongInt;const iid : TGUID;
+ LocaleID : longint; Flags: Word;var params;
+ VarResult,ExcepInfo,ArgErr : pointer) : longint;stdcall;
+ end;
+
+ TInterfacedObject = class(TObject,IUnknown)
+ protected
+ frefcount : longint;
+ { implement methods of IUnknown }
+ function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
+ function _AddRef : longint;stdcall;
+ function _Release : longint;stdcall;
+ public
+ procedure AfterConstruction;override;
+ procedure BeforeDestruction;override;
+ class function NewInstance : TObject;override;
+ property RefCount : longint read frefcount;
+ end;
+ TInterfacedClass = class of TInterfacedObject;
+
+ { some pointer definitions }
+ PUnknown = ^IUnknown;
+ PPUnknown = ^PUnknown;
+ PDispatch = ^IDispatch;
+ PPDispatch = ^PDispatch;
+
+{$endif HASINTF}
+
+ TExceptProc = Procedure (Obj : TObject; Addr : Pointer; FrameCount:Longint; Frame: PPointer);
+
+ { Exception object stack }
+ PExceptObject = ^TExceptObject;
+ TExceptObject = record
+ FObject : TObject;
+ Addr : pointer;
+ Next : PExceptObject;
+ refcount : Longint;
+ Framecount : Longint;
+ Frames : PPointer;
+ end;
+
+ Const
+ ExceptProc : TExceptProc = Nil;
+ RaiseProc : TExceptProc = Nil;
+ RaiseMaxFrameCount : Longint = 16;
+
+ Function RaiseList : PExceptObject;
+
+ { @abstract(increase exception reference count)
+ When leaving an except block, the exception object is normally
+ freed automatically. To avoid this, call this function.
+ If within the exception object you decide that you don't need
+ the exception after all, call @link(ReleaseExceptionObject).
+ Otherwise, if the reference count is > 0, the exception object
+ goes into your "property" and you need to free it manually.
+ The effect of this function is countered by re-raising an exception
+ via "raise;", this zeroes the reference count again.
+ Calling this method is only valid within an except block.
+ @return(pointer to the exception object) }
+ function AcquireExceptionObject: Pointer;
+
+ { @abstract(decrease exception reference count)
+ After calling @link(AcquireExceptionObject) you can call this method
+ to decrease the exception reference count again.
+ If the reference count is > 0, the exception object
+ goes into your "property" and you need to free it manually.
+ Calling this method is only valid within an except block. }
+ procedure ReleaseExceptionObject;
+
+{*****************************************************************************
+ Array of const support
+*****************************************************************************}
+
+ const
+ vtInteger = 0;
+ vtBoolean = 1;
+ vtChar = 2;
+ vtExtended = 3;
+ vtString = 4;
+ vtPointer = 5;
+ vtPChar = 6;
+ vtObject = 7;
+ vtClass = 8;
+ vtWideChar = 9;
+ vtPWideChar = 10;
+ vtAnsiString = 11;
+ vtCurrency = 12;
+ vtVariant = 13;
+ vtInterface = 14;
+ vtWideString = 15;
+ vtInt64 = 16;
+ vtQWord = 17;
+
+ type
+ PVarRec = ^TVarRec;
+ TVarRec = record
+ case VType : Ptrint of
+ vtInteger : (VInteger: Longint);
+{$ifdef ENDIAN_BIG}
+ vtBoolean : (booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean);
+ vtChar : (chardummy1,chardummy2,chardummy3: byte; VChar: Char);
+ vtWideChar : (wchardummy1,VWideChar: WideChar);
+{$else ENDIAN_BIG}
+ vtBoolean : (VBoolean: Boolean);
+ vtChar : (VChar: Char);
+ vtWideChar : (VWideChar: WideChar);
+{$endif ENDIAN_BIG}
+ vtExtended : (VExtended: PExtended);
+ vtString : (VString: PShortString);
+ vtPointer : (VPointer: Pointer);
+ vtPChar : (VPChar: PChar);
+ vtObject : (VObject: TObject);
+ vtClass : (VClass: TClass);
+ vtPWideChar : (VPWideChar: PWideChar);
+ vtAnsiString : (VAnsiString: Pointer);
+{$ifdef HASCURRENCY}
+ vtCurrency : (VCurrency: PCurrency);
+{$endif HASCURRENCY}
+{$ifdef HASVARIANT}
+ vtVariant : (VVariant: PVariant);
+{$endif HASVARIANT}
+ vtInterface : (VInterface: Pointer);
+ vtWideString : (VWideString: Pointer);
+ vtInt64 : (VInt64: PInt64);
+ vtQWord : (VQWord: PQWord);
+ end;
+
+{
+ $Log: objpash.inc,v $
+ Revision 1.28 2005/02/14 17:13:26 peter
+ * truncate log
+
+ Revision 1.27 2005/02/01 19:32:14 florian
+ + tmethod
+
+ Revision 1.26 2005/01/31 19:41:39 peter
+ * interface additions
+
+ Revision 1.25 2005/01/26 17:07:10 peter
+ * retrieve backtrace when exception is raised
+ * RaiseMaxFrameCount added to limit the number of backtraces, setting
+ it to 0 disables backtraces. Default is 16
+
+}
diff --git a/rtl/inc/printer.inc b/rtl/inc/printer.inc
new file mode 100644
index 0000000000..5bbaa6ea68
--- /dev/null
+++ b/rtl/inc/printer.inc
@@ -0,0 +1,63 @@
+{
+ $Id: printer.inc,v 1.2 2005/02/14 17:13:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+
+ Common part of implementation for unit Printer.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$I-}
+
+var
+ Old_Exit: pointer;
+ LstAvailable: boolean;
+
+function IsLstAvailable: boolean;
+begin
+ IsLstAvailable := LstAvailable;
+end;
+
+procedure Printer_Exit;
+begin
+ if LstAvailable then
+ Close (Lst);
+ ExitProc := Old_Exit;
+end;
+
+procedure InitPrinter (const PrinterName: string);
+var
+ OldInOutRes: word;
+begin
+(* Avoid potential problems with previous InOutRes value... *)
+ OldInOutRes := InOutRes;
+ InOutRes := 0;
+ Assign (Lst, PrinterName);
+ Rewrite (Lst);
+ LstAvailable := InOutRes = 0;
+ InOutRes := OldInOutRes;
+end;
+
+procedure SetPrinterExit;
+begin
+ Old_Exit := ExitProc;
+ ExitProc := @Printer_Exit;
+end;
+
+(* The default $I state is left for potential
+ platform-specific part of implementation. *)
+{$I+}
+
+{
+ $Log: printer.inc,v $
+ Revision 1.2 2005/02/14 17:13:26 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/printerh.inc b/rtl/inc/printerh.inc
new file mode 100644
index 0000000000..2f5961dd72
--- /dev/null
+++ b/rtl/inc/printerh.inc
@@ -0,0 +1,30 @@
+{
+ $Id: printerh.inc,v 1.2 2005/02/14 17:13:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+
+ Common header for unit Printer.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+var
+ Lst: text;
+
+(* Check whether opening of Lst was successful. *)
+function IsLstAvailable: boolean;
+
+(* Allow to initialize printer with different name. *)
+procedure InitPrinter (const PrinterName: string);
+
+{
+ $Log: printerh.inc,v $
+ Revision 1.2 2005/02/14 17:13:26 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/readme b/rtl/inc/readme
new file mode 100644
index 0000000000..a2f4f2705e
--- /dev/null
+++ b/rtl/inc/readme
@@ -0,0 +1,36 @@
+This directory contains only RTL parts independent
+of the processor and of the operating system.
+
+The include files contain the following:
+
+astrings.pp AnsiStrings implementation.
+except.inc Delphi styled exception support.
+file.inc Untyped file support routines.
+filerec.inc Untyped file record definition.
+heap.inc Runtime heap manager .
+heaph.inc Declarations of Heap functions.
+innr.inc Internal function delcarations.
+int64.inc Support for 64-bit integer arithmetic.
+lstrings.pp LongStrings routine implementation.
+mathh.inc Declarations of mathematical functions.
+real2str.inc Routine to convert floating point numbers to strings.
+rtti.inc Delphi like runtime type information
+sstrings.inc ShortStrings (TP/BP pascal like strings) implementation.
+system.inc OS and Processor independent implementation part of system unit.
+systemh.inc Interface part of the system unit.
+text.inc Text file support routines.
+textrec.inc Definition of Textrec record.
+typefile.inc Text file record definition.
+generic.inc Processor independant implementation of assembler procs on i386
+ (to allow easy porting to new processors).
+genset.inc Processor independant implementation of set handling
+genmath.inc Processor independant implementation of mathematical routines
+genrrti.inc Processor independant implementation of runtime type information routines
+
+The unit files are:
+
+ucomplex.pp Complex functions using operator overloading
+getopts.pp Pascal implementation of the GNU Getops
+objects.pp Turbo Pascal like implementation of objects unit
+heaptrc.pp Runtime memory leak tracer and tests for memory integrity.
+
diff --git a/rtl/inc/real2str.inc b/rtl/inc/real2str.inc
new file mode 100644
index 0000000000..5faa102e3b
--- /dev/null
+++ b/rtl/inc/real2str.inc
@@ -0,0 +1,467 @@
+{
+ $Id: real2str.inc,v 1.17 2005/02/14 17:13:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ { See symconst.pas tfloattype }
+ treal_type = (
+ rt_s32real,rt_s64real,rt_s80real,
+ rt_c64bit,rt_currency,rt_s128real
+ );
+ { corresponding to single double extended fixed comp for i386 }
+
+Procedure str_real (len,f : longint; d : ValReal; real_type :treal_type; var s : string);
+{$ifdef SUPPORT_EXTENDED}
+type
+ TSplitExtended = packed record
+ case byte of
+ 0: (bytes: Array[0..9] of byte);
+ 1: (words: Array[0..4] of word);
+ 2: (cards: Array[0..1] of cardinal; w: word);
+ end;
+const
+ maxDigits = 17;
+{$else}
+{$ifdef SUPPORT_DOUBLE}
+type
+ TSplitDouble = packed record
+ case byte of
+ 0: (bytes: Array[0..7] of byte);
+ 1: (words: Array[0..3] of word);
+ 2: (cards: Array[0..1] of cardinal);
+ end;
+const
+ maxDigits = 14;
+{$else}
+{$ifdef SUPPORT_SINGLE}
+type
+ TSplitSingle = packed record
+ case byte of
+ 0: (bytes: Array[0..3] of byte);
+ 1: (words: Array[0..1] of word);
+ 2: (cards: Array[0..0] of cardinal);
+ end;
+const
+ maxDigits = 9;
+{$endif SUPPORT_SINGLE}
+{$endif SUPPORT_DOUBLE}
+{$endif SUPPORT_EXTENDED}
+
+type
+ { the value in the last position is used for rounding }
+ TIntPartStack = array[1..maxDigits+1] of valReal;
+
+var
+ roundCorr, corrVal, factor : valReal;
+ spos, endpos, fracCount: longint;
+ correct, currprec: longint;
+ temp : string;
+ power : string[10];
+ sign : boolean;
+ dot : byte;
+ fraczero, expMaximal: boolean;
+
+
+ maxlen : longint; { Maximal length of string for float }
+ minlen : longint; { Minimal length of string for float }
+ explen : longint; { Length of exponent, including E and sign.
+ Must be strictly larger than 2 }
+const
+ maxexp = 1e+35; { Maximum value for decimal expressions }
+ minexp = 1e-35; { Minimum value for decimal expressions }
+ zero = '0000000000000000000000000000000000000000';
+
+ procedure RoundStr(var s: string; lastPos: byte);
+ var carry: longint;
+ begin
+ carry := 1;
+ repeat
+ s[lastPos] := chr(ord(s[lastPos])+carry);
+ carry := 0;
+ if s[lastPos] > '9' then
+ begin
+ s[lastPos] := '0';
+ carry := 1;
+ end;
+ dec(lastPos);
+ until carry = 0;
+ end;
+
+ procedure getIntPart(d: valreal);
+ var
+ intPartStack: TIntPartStack;
+ intPart, stackPtr, endStackPtr, digits: longint;
+ overflow: boolean;
+ begin
+{$ifdef DEBUG_NASM}
+ writeln(stderr,'getintpart(d) entry');
+{$endif DEBUG_NASM}
+ { position in the stack (gets increased before first write) }
+ stackPtr := 0;
+ { number of digits processed }
+ digits := 0;
+ { did we wrap around in the stack? Necessary to know whether we should round }
+ overflow :=false;
+ { generate a list consisting of d, d/10, d/100, ... until d < 1.0 }
+ while d > 1.0-roundCorr do
+ begin
+ inc(stackPtr);
+ inc(digits);
+ if stackPtr > maxDigits+1 then
+ begin
+ stackPtr := 1;
+ overflow := true;
+ end;
+ intPartStack[stackPtr] := d;
+ d := d / 10.0;
+ end;
+ { if no integer part, exit }
+ if digits = 0 then
+ exit;
+ endStackPtr := stackPtr+1;
+ if endStackPtr > maxDigits + 1 then
+ endStackPtr := 1;
+ { now, all digits are calculated using trunc(d*10^(-n)-int(d*10^(-n-1))*10) }
+ corrVal := 0.0;
+ { the power of 10 with which the resulting string has to be "multiplied" }
+ { if the decimal point is placed after the first significant digit }
+ correct := digits-1;
+{$ifdef DEBUG_NASM}
+ writeln(stderr,'endStackPtr = ',endStackPtr);
+{$endif DEBUG_NASM}
+ repeat
+ if (currprec > 0) then
+ begin
+ intPart:= trunc(intPartStack[stackPtr]-corrVal);
+ dec(currPrec);
+ inc(spos);
+ temp[spos] := chr(intPart+ord('0'));
+{$ifdef DEBUG_NASM}
+ writeln(stderr,'stackptr =',stackptr,' intpart = ',intpart);
+{$endif DEBUG_NASM}
+ if temp[spos] > '9' then
+ begin
+ temp[spos] := chr(ord(temp[spos])-10);
+ roundStr(temp,spos-1);
+ end;
+ end;
+ corrVal := int(intPartStack[stackPtr]) * 10.0;
+{$ifdef DEBUG_NASM}
+ writeln(stderr,'trunc(corrval) = ',trunc(corrval));
+{$endif DEBUG_NASM}
+ dec(stackPtr);
+ if stackPtr = 0 then
+ stackPtr := maxDigits+1;
+ until (overflow and (stackPtr = endStackPtr)) or
+ (not overflow and (stackPtr = maxDigits+1)) or (currPrec = 0);
+ { round if we didn't use all available digits yet and if the }
+ { remainder is > 5 }
+ if (overflow or
+ (stackPtr < maxDigits+1)) then
+ begin
+ { we didn't use all available digits of the whole part -> make sure }
+ { the fractional part is not used for rounding later }
+ currprec := -1;
+ { instead, round based on the next whole digit }
+ if (trunc(intPartStack[stackPtr]-corrVal) > 5.0 - roundCorr) then
+ roundStr(temp,spos);
+ end;
+{$ifdef DEBUG_NASM}
+ writeln(stderr,'temp at getintpart exit is = ',temp);
+{$endif DEBUG_NASM}
+ end;
+
+begin
+ case real_type of
+ rt_s32real :
+ begin
+ maxlen:=16;
+ minlen:=8;
+ explen:=4;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((16-4-3)*ln(10)));
+ end;
+ rt_s64real :
+ begin
+{ if the maximum suppported type is double, we can print out one digit }
+{ less, because otherwise we can't round properly and 1e-400 becomes }
+{ 0.99999999999e-400 (JM) }
+{$ifdef support_extended}
+ maxlen:=23;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((23-5-3)*ln(10)));
+{$else support_extended}
+{$ifdef support_double}
+ maxlen := 22;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((22-4-3)*ln(10)));
+{$endif support_double}
+{$endif support_extended}
+ minlen:=9;
+ explen:=5;
+ end;
+ rt_s80real :
+ begin
+ { Different in TP help, but this way the output is the same (JM) }
+ maxlen:=25;
+ minlen:=10;
+ explen:=6;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((25-6-3)*ln(10)));
+ end;
+ rt_c64bit :
+ begin
+ maxlen:=23;
+ minlen:=10;
+ { according to TP (was 5) (FK) }
+ explen:=6;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((23-6-3)*ln(10)));
+ end;
+ rt_currency :
+ begin
+ { Different in TP help, but this way the output is the same (JM) }
+ maxlen:=25;
+ minlen:=10;
+ explen:=0;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((25-6-3)*ln(10)));
+ end;
+ rt_s128real :
+ begin
+ { Different in TP help, but this way the output is the same (JM) }
+ maxlen:=25;
+ minlen:=10;
+ explen:=6;
+ { correction used with comparing to avoid rounding/precision errors }
+ roundCorr := (1/exp((25-6-3)*ln(10)));
+ end;
+ end;
+ { check parameters }
+ { default value for length is -32767 }
+ if len=-32767 then
+ len:=maxlen;
+ { determine sign. before precision, needs 2 less calls to abs() }
+{$ifndef endian_big}
+{$ifdef SUPPORT_EXTENDED}
+ { extended, format (MSB): 1 Sign bit, 15 bit exponent, 64 bit mantissa }
+ sign := (TSplitExtended(d).w and $8000) <> 0;
+ expMaximal := (TSplitExtended(d).w and $7fff) = 32767;
+ fraczero := (TSplitExtended(d).cards[0] = 0) and
+ ((TSplitExtended(d).cards[1] and $7fffffff) = 0);
+{$else SUPPORT_EXTENDED}
+{$ifdef SUPPORT_DOUBLE}
+{$ifdef CPUARM}
+ { double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
+ { high and low dword are swapped when using the arm fpa }
+ sign := ((TSplitDouble(d).cards[0] shr 20) and $800) <> 0;
+ expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
+ fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
+ (TSplitDouble(d).cards[1] = 0);
+{$else CPUARM}
+ { double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
+ sign := ((TSplitDouble(d).cards[1] shr 20) and $800) <> 0;
+ expMaximal := ((TSplitDouble(d).cards[1] shr 20) and $7ff) = 2047;
+ fraczero := (TSplitDouble(d).cards[1] and $fffff = 0) and
+ (TSplitDouble(d).cards[0] = 0);
+{$endif CPUARM}
+{$else SUPPORT_DOUBLE}
+{$ifdef SUPPORT_SINGLE}
+ { single, format (MSB): 1 Sign bit, 8 bit exponent, 23 bit mantissa }
+ sign := ((TSplitSingle(d).words[1] shr 7) and $100) <> 0;
+ expMaximal := ((TSplitSingle(d).words[1] shr 7) and $ff) = 255;
+ fraczero := (TSplitSingle(d).cards[0] and $7fffff = 0);
+{$else SUPPORT_SINGLE}
+ {$error No little endian floating type supported yet in real2str}
+{$endif SUPPORT_SINGLE}
+{$endif SUPPORT_DOUBLE}
+{$endif SUPPORT_EXTENDED}
+{$else endian_big}
+{$ifdef SUPPORT_EXTENDED}
+ {$error sign/NaN/Inf not yet supported for big endian CPU's in str_real}
+{$else SUPPORT_EXTENDED}
+{$ifdef SUPPORT_DOUBLE}
+ { double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
+ sign := ((TSplitDouble(d).cards[0] shr 20) and $800) <> 0;
+ expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
+ fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
+ (TSplitDouble(d).cards[1] = 0);
+{$else SUPPORT_DOUBLE}
+{$ifdef SUPPORT_SINGLE}
+ { single, format (MSB): 1 Sign bit, 8 bit exponent, 23 bit mantissa }
+ sign := ((TSplitSingle(d).bytes[0] and $80)) <> 0;
+ expMaximal := ((TSplitSingle(d).words[0] shr 7) and $ff) = 255;
+ fraczero:= (TSplitSingle(d).cards[0] and $7fffff = 0);
+{$else SUPPORT_SINGLE}
+ {$error No big endian floating type supported yet in real2str}
+{$endif SUPPORT_SINGLE}
+{$endif SUPPORT_DOUBLE}
+{$endif SUPPORT_EXTENDED}
+{$endif endian}
+ if expMaximal then
+ if fraczero then
+ if sign then
+ temp := '-Inf'
+ else temp := '+Inf'
+ else temp := 'Nan'
+ else
+ begin
+ { d:=abs(d); this converts d to double so we loose precision }
+ { for the same reason I converted d:=frac(d) to d:=d-int(d); (PM) }
+ if sign then
+ d:=-d;
+ { determine precision : maximal precision is : }
+ currPrec := maxlen-explen-2;
+ { this is also the maximal number of decimals !!}
+ if f>currprec then
+ f:=currprec;
+ { when doing a fixed-point, we need less characters.}
+ if (f<0) {or ((d<>0) and ((d>maxexp) and (d>minexp)))} then
+ begin
+ { determine maximal number of decimals }
+ if (len>=0) and (len<minlen) then
+ len:=minlen;
+ if (len>0) and (len<maxlen) then
+ currprec:=len-explen-2;
+ end;
+
+ { leading zero, may be necessary for things like str(9.999:0:2) to }
+ { be able to insert an extra character at the start of the string }
+ temp := ' 0';
+ { position in the temporary output string }
+ spos := 2;
+ { get the integer part }
+ correct := 0;
+ GetIntPart(d);
+ { now process the fractional part }
+ if d > 1.0- roundCorr then
+ d := frac(d);
+ { if we have to round earlier than the amount of available precision, }
+ { only calculate digits up to that point }
+ if (f >= 0) and (currPrec > f) then
+ currPrec := f;
+ { if integer part was zero, go to the first significant digit of the }
+ { fractional part }
+ { make sure we don't get an endless loop if d = 0 }
+ if (spos = 2) and (d <> 0.0) then
+ begin
+ { take rounding errors into account }
+ while d < 0.1-roundCorr do
+ begin
+ d := d * 10.0;
+ dec(correct);
+ { adjust the precision depending on how many digits we }
+ { already "processed" by multiplying by 10, but only if }
+ { the amount of precision is specified }
+ if f >= 0 then
+ dec(currPrec);
+ end;
+ dec(correct);
+ end;
+ { current length of the output string in endPos }
+ endPos := spos;
+ { always calculate at least 1 fractional digit for rounding }
+ if (currPrec >= 0) then
+ begin
+ corrVal := 0.5;
+ factor := 1;
+ for fracCount := 1 to currPrec do
+ factor := factor * 10.0;
+ corrval := corrval / factor;
+ if d >= corrVal then
+ d := d + corrVal;
+ if int(d) = 1 then
+ begin
+ roundStr(temp,spos);
+ d := frac(d);
+ end;
+ { calculate the necessary fractional digits }
+ for fracCount := 1 to currPrec do
+ begin
+ if d > 1.0- roundCorr then
+ d := frac(d) * 10.0
+ else d := d * 10.0;
+ inc(spos);
+ temp[spos] := chr(trunc(d)+ord('0'));
+ if temp[spos] > '9' then
+ { possible because trunc and the "*10.0" aren't exact :( }
+ begin
+ temp[spos] := chr(ord(temp[spos]) - 10);
+ roundStr(temp,spos-1);
+ end;
+ end;
+ { new length of string }
+ endPos := spos;
+ end;
+ setLength(temp,endPos);
+ { delete leading zero if we didn't need it while rounding at the }
+ { string level }
+ if temp[2] = '0' then
+ delete(temp,2,1)
+ { the rounding caused an overflow to the next power of 10 }
+ else inc(correct);
+ if sign then
+ temp[1] := '-';
+ if (f<0) or (correct>(round(ln(maxexp)/ln(10)))) then
+ begin
+ insert ('.',temp,3);
+ str(abs(correct),power);
+ if length(power)<explen-2 then
+ power:=copy(zero,1,explen-2-length(power))+power;
+ if correct<0 then
+ power:='-'+power
+ else
+ power:='+'+power;
+ temp:=temp+'E'+power;
+ end
+ else
+ begin
+ if not sign then
+ begin
+ delete(temp,1,1);
+ dot := 2
+ end
+ else
+ dot := 3;
+ { set zeroes and dot }
+ if correct>=0 then
+ begin
+ if length(temp)<correct+dot+f-1 then
+ temp:=temp+copy(zero,1,correct+dot+f-length(temp));
+ insert ('.',temp,correct+dot);
+ end
+ else
+ begin
+ correct:=abs(correct);
+ insert(copy(zero,1,correct),temp,dot-1);
+ insert ('.',temp,dot);
+ end;
+ { correct length to fit precision }
+ if f>0 then
+ setlength(temp,pos('.',temp)+f)
+ else
+ setLength(temp,pos('.',temp)-1);
+ end;
+ end;
+ if length(temp)<len then
+ s:=space(len-length(temp))+temp
+ else s:=temp;
+end;
+
+{
+ $Log: real2str.inc,v $
+ Revision 1.17 2005/02/14 17:13:26 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc
new file mode 100644
index 0000000000..83dd61f93d
--- /dev/null
+++ b/rtl/inc/rtti.inc
@@ -0,0 +1,265 @@
+{
+ $Id: rtti.inc,v 1.22 2005/02/14 17:13:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ Run-Time type information routines }
+
+{ The RTTI is implemented through a series of constants : }
+
+Const
+ tkUnknown = 0;
+ tkInteger = 1;
+ tkChar = 2;
+ tkEnumeration = 3;
+ tkFloat = 4;
+ tkSet = 5;
+ tkMethod = 6;
+ tkSString = 7;
+ tkString = tkSString;
+ tkLString = 8;
+ tkAString = 9;
+ tkWString = 10;
+ tkVariant = 11;
+ tkArray = 12;
+ tkRecord = 13;
+ tkInterface = 14;
+ tkClass = 15;
+ tkObject = 16;
+ tkWChar = 17;
+ tkBool = 18;
+ tkInt64 = 19;
+ tkQWord = 20;
+ tkDynArray = 21;
+
+
+type
+ TRTTIProc=procedure(Data,TypeInfo:Pointer);
+
+procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
+{
+ A record is designed as follows :
+ 1 : tkrecord
+ 2 : Length of name string (n);
+ 3 : name string;
+ 3+n : record size;
+ 7+n : number of elements (N)
+ 11+n : N times : Pointer to type info
+ Offset in record
+}
+var
+ Temp : pbyte;
+ namelen : byte;
+ count,
+ offset,
+ i : longint;
+ info : pointer;
+begin
+ Temp:=PByte(TypeInfo);
+ inc(Temp);
+ { Skip Name }
+ namelen:=Temp^;
+ inc(temp,namelen+1);
+ temp:=aligntoptr(temp);
+ { Skip size }
+ inc(Temp,4);
+ { Element count }
+ Count:=PLongint(Temp)^;
+ inc(Temp,sizeof(Count));
+ { Process elements }
+ for i:=1 to count Do
+ begin
+ Info:=PPointer(Temp)^;
+ inc(Temp,sizeof(Info));
+ Offset:=PLongint(Temp)^;
+ inc(Temp,sizeof(Offset));
+ rttiproc (Data+Offset,Info);
+ end;
+end;
+
+
+procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
+{
+ An array is designed as follows :
+ 1 : tkArray;
+ 2 : length of name string (n);
+ 3 : NAme string
+ 3+n : Element Size
+ 7+n : Number of elements
+ 11+n : Pointer to type of elements
+}
+var
+ Temp : pbyte;
+ namelen : byte;
+ count,
+ size,
+ i : SizeInt;
+ info : pointer;
+begin
+ Temp:=PByte(TypeInfo);
+ inc(Temp);
+ { Skip Name }
+ namelen:=Temp^;
+ inc(temp,namelen+1);
+ temp:=aligntoptr(temp);
+ { Element size }
+ size:=PSizeInt(Temp)^;
+ inc(Temp,sizeof(Size));
+ { Element count }
+ Count:=PSizeInt(Temp)^;
+ inc(Temp,sizeof(Count));
+ Info:=PPointer(Temp)^;
+ inc(Temp,sizeof(Info));
+ { Process elements }
+ for I:=0 to Count-1 do
+ rttiproc(Data+(I*size),Info);
+end;
+
+
+
+Procedure fpc_Initialize (Data,TypeInfo : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ case PByte(TypeInfo)^ of
+ tkAstring,tkWstring,tkInterface,tkDynArray:
+ PPchar(Data)^:=Nil;
+ tkArray:
+ arrayrtti(data,typeinfo,@int_initialize);
+ tkObject,
+ tkRecord:
+ recordrtti(data,typeinfo,@int_initialize);
+{$ifdef HASVARIANT}
+ tkVariant:
+ variant_init(PVarData(Data)^);
+{$endif HASVARIANT}
+ end;
+end;
+
+
+Procedure fpc_finalize (Data,TypeInfo: Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ case PByte(TypeInfo)^ of
+ tkAstring :
+ begin
+ fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
+ PPointer(Data)^:=nil;
+ end;
+{$ifdef HASWIDESTRING}
+ tkWstring :
+ begin
+ fpc_WideStr_Decr_Ref(PPointer(Data)^);
+ PPointer(Data)^:=nil;
+ end;
+{$endif HASWIDESTRING}
+ tkArray :
+ arrayrtti(data,typeinfo,@int_finalize);
+ tkObject,
+ tkRecord:
+ recordrtti(data,typeinfo,@int_finalize);
+{$ifdef HASINTF}
+ tkInterface:
+ begin
+ Intf_Decr_Ref(PPointer(Data)^);
+ PPointer(Data)^:=nil;
+ end;
+{$endif HASINTF}
+ tkDynArray:
+ fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
+{$ifdef HASVARIANT}
+ tkVariant:
+ variant_clear(PVarData(Data)^);
+{$endif HASVARIANT}
+ end;
+end;
+
+
+Procedure fpc_Addref (Data,TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ case PByte(TypeInfo)^ of
+ tkAstring :
+ fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
+{$ifdef HASWIDESTRING}
+ tkWstring :
+ fpc_WideStr_Incr_Ref(PPointer(Data)^);
+{$endif HASWIDESTRING}
+ tkArray :
+ arrayrtti(data,typeinfo,@int_addref);
+ tkobject,
+ tkrecord :
+ recordrtti(data,typeinfo,@int_addref);
+ tkDynArray:
+ fpc_dynarray_incr_ref(PPointer(Data)^);
+{$ifdef HASINTF}
+ tkInterface:
+ Intf_Incr_Ref(PPointer(Data)^);
+{$endif HASINTF}
+{$ifdef HASVARIANT}
+ tkVariant:
+ variant_addref(pvardata(Data)^);
+{$endif HASVARIANT}
+ end;
+end;
+
+
+{ alias for internal use }
+{ we use another name else the compiler gets puzzled because of the wrong forward def }
+procedure fpc_systemDecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_DECREF'];
+
+Procedure fpc_DecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ case PByte(TypeInfo)^ of
+ { see AddRef for comment about below construct (JM) }
+ tkAstring:
+ fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
+{$ifdef HASWIDESTRING}
+ tkWstring:
+ fpc_WideStr_Decr_Ref(PPointer(Data)^);
+{$endif HASWIDESTRING}
+ tkArray:
+ arrayrtti(data,typeinfo,@fpc_systemDecRef);
+ tkobject,
+ tkrecord:
+ recordrtti(data,typeinfo,@fpc_systemDecRef);
+ tkDynArray:
+ fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
+{$ifdef HASINTF}
+ tkInterface:
+ Intf_Decr_Ref(PPointer(Data)^);
+{$endif HASINTF}
+{$ifdef HASVARIANT}
+ tkVariant:
+ variant_clear(pvardata(data)^);
+{$endif HASVARIANT}
+ end;
+end;
+
+
+procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ var
+ i : longint;
+ begin
+ for i:=0 to count-1 do
+ int_finalize(data+size*i,typeinfo);
+ end;
+
+{
+ $Log: rtti.inc,v $
+ Revision 1.22 2005/02/14 17:13:26 peter
+ * truncate log
+
+ Revision 1.21 2005/01/15 18:47:26 florian
+ * several variant init./final. stuff fixed
+
+ Revision 1.20 2005/01/08 20:43:44 florian
+ + init/cleaning code for variants added
+
+}
diff --git a/rtl/inc/sockets.inc b/rtl/inc/sockets.inc
new file mode 100644
index 0000000000..d43aa6d936
--- /dev/null
+++ b/rtl/inc/sockets.inc
@@ -0,0 +1,416 @@
+{
+ $Id: sockets.inc,v 1.18 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{******************************************************************************
+ Text File Writeln/ReadLn Support
+******************************************************************************}
+
+
+Procedure OpenSock(var F:Text);
+begin
+ if textrec(f).handle=UnusedHandle then
+ textrec(f).mode:=fmclosed
+ else
+ case textrec(f).userdata[1] of
+ S_OUT : textrec(f).mode:=fmoutput;
+ S_IN : textrec(f).mode:=fminput;
+ else
+ textrec(f).mode:=fmclosed;
+ end;
+end;
+
+
+
+Procedure IOSock(var F:text);
+begin
+ case textrec(f).mode of
+ fmoutput : {$ifdef unix}fpWrite{$else}fdwrite{$endif}(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
+ fminput : textrec(f).BufEnd:={$ifdef Unix}fpRead{$else}fdread{$endif}(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufsize);
+ end;
+ textrec(f).bufpos:=0;
+end;
+
+
+
+Procedure FlushSock(var F:Text);
+begin
+ if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
+ begin
+ IOSock(f);
+ textrec(f).bufpos:=0;
+ end;
+end;
+
+
+
+Procedure CloseSock(var F:text);
+begin
+ { Nothing special has to be done here }
+end;
+
+
+
+Procedure Sock2Text(Sock:Longint;Var SockIn,SockOut:Text);
+{
+ Set up two Pascal Text file descriptors for reading and writing)
+}
+begin
+{ First the reading part.}
+ Assign(SockIn,'.');
+ Textrec(SockIn).Handle:=Sock;
+ Textrec(Sockin).userdata[1]:=S_IN;
+ TextRec(SockIn).OpenFunc:=@OpenSock;
+ TextRec(SockIn).InOutFunc:=@IOSock;
+ TextRec(SockIn).FlushFunc:=@FlushSock;
+ TextRec(SockIn).CloseFunc:=@CloseSock;
+ TextRec(SockIn).Mode := fmInput;
+{ Now the writing part. }
+ Assign(SockOut,'.');
+ Textrec(SockOut).Handle:=Sock;
+ Textrec(SockOut).userdata[1]:=S_OUT;
+ TextRec(SockOut).OpenFunc:=@OpenSock;
+ TextRec(SockOut).InOutFunc:=@IOSock;
+ TextRec(SockOut).FlushFunc:=@FlushSock;
+ TextRec(SockOut).CloseFunc:=@CloseSock;
+ TextRec(SockOut).Mode := fmOutput;
+end;
+
+
+{******************************************************************************
+ Untyped File
+******************************************************************************}
+
+Procedure Sock2File(Sock:Longint;Var SockIn,SockOut:File);
+begin
+{Input}
+ Assign(SockIn,'.');
+ FileRec(SockIn).Handle:=Sock;
+ FileRec(SockIn).RecSize:=1;
+ FileRec(Sockin).userdata[1]:=S_IN;
+ FileRec(SockIn).Mode := fmInput;
+
+{Output}
+ Assign(SockOut,'.');
+ FileRec(SockOut).Handle:=Sock;
+ FileRec(SockOut).RecSize:=1;
+ FileRec(SockOut).userdata[1]:=S_OUT;
+ FileRec(SockOut).Mode := fmOutput;
+end;
+
+{******************************************************************************
+ InetSock
+******************************************************************************}
+
+Function DoAccept(Sock:longint;Var addr:TInetSockAddr):longint;
+
+Var AddrLen : Longint;
+
+begin
+ AddrLEn:=SizeOf(Addr);
+ DoAccept:=Accept(Sock,Addr,AddrLen);
+end;
+
+Function DoConnect(Sock:longint;const addr: TInetSockAddr): Boolean;
+
+begin
+ DoConnect:=Connect(Sock,Addr,SizeOF(TInetSockAddr));
+end;
+
+Function Connect(Sock:longint;const addr: TInetSockAddr;var SockIn,SockOut:text):Boolean;
+
+begin
+ Connect:=DoConnect(Sock,addr);
+ If Connect then
+ Sock2Text(Sock,SockIn,SockOut);
+end;
+
+Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
+
+begin
+ Connect:=DoConnect(Sock,addr);
+ If Connect then
+ Sock2File(Sock,SockIn,SockOut);
+end;
+
+Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2Text(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2File(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+type thostaddr= packed array[1..4] of byte;
+
+function htonl( host : longint):longint; {$ifdef HASINLINE} inline; {$ENDIF}
+
+begin
+{$ifdef FPC_BIG_ENDIAN}
+ htonl:=host;
+{$else}
+ htonl:=THostAddr(host)[4];
+ htonl:=htonl or ( (THostAddr(host)[3]) shl 8);
+ htonl:=htonl or ( (THostAddr(host)[2]) shl 16);
+ htonl:=htonl or ( (THostAddr(host)[1]) shl 24);
+{$endif}
+end;
+
+Function NToHl (Net : Longint) : Longint; {$ifdef HASINLINE} inline; {$ENDIF}
+
+begin
+{$ifdef FPC_BIG_ENDIAN}
+ ntohl:=net;
+{$else}
+ ntohl:=THostAddr(Net)[4];
+ ntohl:=ntohl or ( (THostAddr(Net)[3]) shl 8);
+ ntohl:=ntohl or ( (THostAddr(Net)[2]) shl 16);
+ ntohl:=ntohl or ( (THostAddr(Net)[1]) shl 24);
+{$endif}
+end;
+
+function htons( host : word):word; {$ifdef HASINLINE} inline; {$ENDIF}
+
+begin
+{$ifdef FPC_BIG_ENDIAN}
+ htons:=host;
+{$else}
+ htons:=swap(host);
+{$endif}
+end;
+
+Function NToHs (Net : word):word;{$ifdef HASINLINE} inline; {$ENDIF}
+
+begin
+{$ifdef FPC_BIG_ENDIAN}
+ ntohs:=net;
+{$else}
+ ntohs:=swap(net);
+{$endif}
+end;
+
+Type array4int = array[1..4] of byte;
+
+function NetAddrToStr (Entry : in_addr) : AnsiString;
+
+Var Dummy : Ansistring;
+ i,j : Longint;
+
+begin
+ NetAddrToStr:='';
+ j:=entry.s_addr;
+ For I:=1 to 4 do
+ begin
+ Str(array4int(j)[i],Dummy);
+ NetAddrToStr:=NetAddrToStr+Dummy;
+ If I<4 Then
+ NetAddrToStr:=NetAddrToStr+'.';
+ end;
+end;
+
+function HostAddrToStr (Entry : in_addr) : AnsiString;
+
+Var x: in_addr;
+
+begin
+ x.s_addr:=htonl(entry.s_addr);
+ HostAddrToStr:=NetAddrToStr(x);
+end;
+
+function StrToHostAddr(IP : AnsiString) : in_addr ;
+
+Var
+ Dummy : AnsiString;
+ I,j,k : Longint;
+ Temp : in_addr;
+
+begin
+ strtohostaddr.s_addr:=0; //:=NoAddress;
+ For I:=1 to 4 do
+ begin
+ If I<4 Then
+ begin
+ J:=Pos('.',IP);
+ If J=0 then
+ exit;
+ Dummy:=Copy(IP,1,J-1);
+ Delete (IP,1,J);
+ end
+ else
+ Dummy:=IP;
+ Val (Dummy,k,J);
+ array4int(temp.s_addr)[i]:=k;
+ If J<>0 then Exit;
+ end;
+ strtohostaddr.s_addr:=ntohl(Temp.s_addr);
+end;
+
+function StrToNetAddr(IP : AnsiString) : in_addr;
+
+begin
+ StrToNetAddr.s_addr:=htonl(StrToHostAddr(IP).s_addr);
+end;
+
+Function HostToNet (Host : in_addr):in_addr;
+
+begin
+ HostToNet.s_addr:=htonl(host.s_addr);
+end;
+
+Function NetToHost (Net : in_addr) : in_addr;
+
+begin
+ NetToHost.s_addr:=ntohl(net.s_addr);
+end;
+
+Function HostToNet (Host : Longint) : Longint;
+
+begin
+ HostToNet:=htonl(host);
+end;
+
+Function NetToHost (Net : Longint) : Longint;
+
+begin
+ NetToHost:=ntohl(net);
+end;
+
+Function ShortHostToNet (Host : Word) : Word;
+
+begin
+ ShortHostToNet:=htons(host);
+end;
+
+Function ShortNetToHost (Net : Word) : Word;
+
+begin
+ ShortNEtToHost:=ntohs(net);
+end;
+
+const digittab : shortstring = ('0123456789ABCDEF');
+
+function lclinttohex (i:integer;digits:longint): ansistring;
+
+begin
+ SetLength(lclinttohex,4);
+ lclinttohex[4]:=digittab[1+(i and 15)];
+ lclinttohex[3]:=digittab[1+((i shr 4) and 15)];
+ lclinttohex[2]:=digittab[1+((i shr 8) and 15)];
+ lclinttohex[1]:=digittab[1+((i shr 12) and 15)];;
+end;
+
+function HostAddrToStr6 (Entry : TIn6_Addr) :ansiString;
+var
+ i: byte;
+ zr1,zr2: set of byte;
+ zc1,zc2: byte;
+ have_skipped: boolean;
+begin
+ zr1 := [];
+ zr2 := [];
+ zc1 := 0;
+ zc2 := 0;
+ for i := 0 to 7 do begin
+ if Entry.u6_addr16[i] = 0 then begin
+ include(zr2, i);
+ inc(zc2);
+ end else begin
+ if zc1 < zc2 then begin
+ zc1 := zc2;
+ zr1 := zr2;
+ zc2 := 0; zr2 := [];
+ end;
+ end;
+ end;
+ if zc1 < zc2 then begin
+ zc1 := zc2;
+ zr1 := zr2;
+ end;
+ SetLength(HostAddrToStr6, 8*5-1);
+ SetLength(HostAddrToStr6, 0);
+ have_skipped := false;
+ for i := 0 to 7 do begin
+ if not (i in zr1) then begin
+ if have_skipped then begin
+ if HostAddrToStr6 = ''
+ then HostAddrToStr6 := '::'
+ else HostAddrToStr6 := HostAddrToStr6 + ':';
+ have_skipped := false;
+ end;
+ // FIXME: is that shortnettohost really proper there? I wouldn't be too sure...
+ HostAddrToStr6 := HostAddrToStr6 +lclIntToHex(ShortNetToHost(Entry.u6_addr16[i]), 1) + ':';
+ end else begin
+ have_skipped := true;
+ end;
+ end;
+ if have_skipped then
+ if HostAddrToStr6 = ''
+ then HostAddrToStr6 := '::'
+ else HostAddrToStr6 := HostAddrToStr6 + ':';
+
+ if HostAddrToStr6 = '' then HostAddrToStr6 := '::';
+ if not (7 in zr1) then
+ SetLength(HostAddrToStr6, Length(HostAddrToStr6)-1);
+end;
+
+function StrToHostAddr6(IP : String) : TIn6_addr;
+begin
+end;
+
+function NetAddrToStr6 (Entry : TIn6_Addr) : ansiString;
+begin
+ netaddrtostr6 := HostAddrToStr6((Entry));
+end;
+
+function StrToNetAddr6(IP : ansiString) : TIn6_Addr;
+begin
+ StrToNetAddr6 := StrToHostAddr6(IP);
+end;
+
+
+{
+ $Log: sockets.inc,v $
+ Revision 1.18 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.17 2005/03/18 10:04:31 marco
+ * cosmetic fix in netaddrtostr
+
+ Revision 1.16 2005/02/14 17:13:26 peter
+ * truncate log
+
+ Revision 1.15 2005/02/13 19:59:57 marco
+ * More htons like functionality. IPV6 string support still missing
+
+}
diff --git a/rtl/inc/socketsh.inc b/rtl/inc/socketsh.inc
new file mode 100644
index 0000000000..e880b3e36d
--- /dev/null
+++ b/rtl/inc/socketsh.inc
@@ -0,0 +1,260 @@
+{
+ $Id: socketsh.inc,v 1.27 2005/03/28 11:10:51 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$IFNDEF ver1_0}
+ {$IFNDEF ver1_9_4}
+ {$INLINE ON}
+ {$define HASINLINE}
+ {$endif}
+{$ENDIF}
+
+Type
+{$ifdef SOCK_HAS_SINLEN}
+ sa_family_t=cuchar;
+{$else}
+ sa_family_t=cushort;
+{$endif}
+
+Const
+ { Socket types }
+ SOCK_STREAM = 1; { stream (connection) socket }
+ SOCK_DGRAM = 2; { datagram (conn.less) socket }
+ SOCK_RAW = 3; { raw socket }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequential packet socket }
+
+ { Protocol families }
+ PF_UNSPEC = 0; { Unspecified }
+ PF_LOCAL = 1; { Local to host (pipes and file-domain) }
+ PF_UNIX = PF_LOCAL; { Old BSD name for PF_LOCAL }
+ PF_FILE = PF_LOCAL; { Another non-standard name for PF_LOCAL }
+ PF_INET = 2; { IP protocol family }
+
+ { Address families }
+ AF_UNSPEC = PF_UNSPEC;
+ AF_LOCAL = PF_LOCAL;
+ AF_UNIX = PF_UNIX;
+ AF_FILE = PF_FILE;
+ AF_INET = PF_INET;
+
+ { Flags for send, recv etc. }
+ MSG_OOB = $0001; { Process out-of-band data}
+ MSG_PEEK = $0002; { Peek at incoming messages }
+ MSG_DONTROUTE= $0004; { Don't use local routing }
+ MSG_TRYHARD = MSG_DONTROUTE;
+ MSG_CTRUNC = $0008; { Control data lost before delivery }
+ MSG_PROXY = $0010; { Supply or ask second address }
+ MSG_TRUNC = $0020;
+ MSG_DONTWAIT = $0040; { Non-blocking I/O }
+ MSG_EOR = $0080; { End of record }
+ MSG_WAITALL = $0100; { Wait for a full request }
+ MSG_FIN = $0200;
+ MSG_SYN = $0400;
+ MSG_CONFIRM = $0800; { Confirm path validity }
+ MSG_RST = $1000;
+ MSG_ERRQUERE = $2000; { Fetch message from error queue }
+ MSG_NOSIGNAL = $4000; { Do not generate SIGPIPE }
+ MSG_MORE = $8000; { Sender will send more }
+
+const
+ { Two constants to determine whether part of soket is for in or output }
+ S_IN = 0;
+ S_OUT = 1;
+
+Type
+ in_addr = packed record
+ case boolean of
+ true: (s_addr : cuint32); // inaddr_t=cuint32
+ false: (s_bytes : packed array[1..4] of byte);
+ end;
+
+ TIn_addr = in_addr;
+ pin_addr = ^in_addr;
+ TInAddr = in_addr;
+
+ in_addrbytes = packed array [1..4] of byte;
+
+ TSockAddr = packed Record // if sa_len is defined, sa_family_t is smaller
+ {$ifdef SOCK_HAS_SINLEN}
+ sa_len : cuchar;
+ {$endif}
+ case integer of
+ 0: (sa_family: sa_family_t;
+ sa_data: packed array[0..13] of Byte);
+ 1: (sin_family: sa_family_t;
+ sin_port: cushort;
+ sin_addr: in_addr;
+ sin_zero: packed array[0..7] of Byte);
+ end;
+
+ PSockAddr = ^TSockAddr;
+ Sockaddr = TSockAddr; // Kylix compat
+
+ TInetSockAddr = packed Record
+ case boolean of
+ false : (
+ {$ifdef SOCK_HAS_SINLEN}
+ sin_len : cuchar;
+ {$endif}
+ sin_family : sa_family_t;
+ sin_port : cushort;
+ sin_addr : in_addr;
+ xpad : array [0..7] of char; { to get to the size of sockaddr... }
+ );
+ true: (
+ {$ifdef SOCK_HAS_SINLEN}
+ len : cuchar;
+ {$endif}
+ family : sa_family_t;
+ port : cushort;
+ addr : cardinal;
+ pad : array [0..7] of char; { to get to the size of sockaddr... }
+ );
+ end;
+ pInetSockAddr = ^TInetSockAddr;
+
+ Tin6_addr = packed record
+ case byte of
+ 0: (u6_addr8 : array[0..15] of byte);
+ 1: (u6_addr16 : array[0..7] of Word);
+ 2: (u6_addr32 : array[0..3] of Cardinal);
+ 3: (s6_addr8 : array[0..15] of shortint);
+ 4: (s6_addr : array[0..15] of shortint);
+ 5: (s6_addr16 : array[0..7] of smallint);
+ 6: (s6_addr32 : array[0..3] of LongInt);
+ end;
+ pIn6_Addr=^TIn6_addr;
+
+ TInetSockAddr6 = packed Record
+ {$ifdef SOCKET_HAS_SINLEN} // as per RFC 2553
+ sin6_len : byte;
+ {$endif}
+ sin6_family : sa_family_t;
+ sin6_port : cuint16;
+ sin6_flowinfo : cuint32;
+ sin6_addr : Tin6_addr;
+ sin6_scope_id : cuint32;
+ end;
+
+ sockaddr_in6 = TInetSockAddr6;
+
+ psockaddr_in6 = ^sockaddr_in6;
+
+ TSockPairArray = Array[0..1] of Longint;
+ TSockArray = Array[1..2] of Longint; //legacy
+
+
+Var
+ SocketError:cint;
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+function fprecv (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t;
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+function fplisten (s:cint; backlog : cint):cint;
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+function fpshutdown (s:cint; how:cint):cint;
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+
+{Basic Socket Functions}
+Function Socket(Domain,SocketType,Protocol:Longint):Longint;
+Function CloseSocket(Sock:Longint):Longint;
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; var AddrLen : longInt) : longint;
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+Function Listen (Sock,MaxConnect:Longint):Boolean;
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):boolean;
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+Function SetSocketOptions(Sock,Level,OptName:Longint;const OptVal;optlen:longint):Longint;
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+
+{Text Support}
+Procedure Sock2Text(Sock:Longint;Var SockIn,SockOut:Text);
+
+{Untyped File Support}
+Procedure Sock2File(Sock:Longint;Var SockIn,SockOut:File);
+
+{Better Pascal Calling, Overloaded Functions!}
+Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
+Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
+Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
+Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
+
+
+{ Utility routines}
+function htonl( host : longint):longint; {$ifdef HASINLINE} inline; {$endif}
+Function NToHl( Net : Longint) : Longint; {$ifdef HASINLINE} inline; {$endif}
+function htons( host : word):word; {$ifdef HASINLINE} inline; {$endif}
+Function NToHs( Net : word):word; {$ifdef HASINLINE} inline; {$endif}
+
+function NetAddrToStr (Entry : in_addr) : AnsiString;
+function HostAddrToStr(Entry : in_addr) : AnsiString;
+function StrToHostAddr(IP : AnsiString) : in_addr ;
+function StrToNetAddr (IP : AnsiString) : in_addr;
+
+{ these for are for netdb legacy compat}
+Function HostToNet (Host : in_addr) : in_addr;
+Function NetToHost (Net : in_addr) : in_addr;
+Function HostToNet (Host : Longint) : Longint;
+Function NetToHost (Net : Longint) : Longint;
+Function ShortHostToNet(Host : Word) : Word;
+Function ShortNetToHost(Net : Word) : Word;
+
+// ipv6
+function HostAddrToStr6(Entry : Tin6_addr) : AnsiString;
+function StrToHostAddr6(IP : String) : Tin6_addr; // not implemented?!?
+function NetAddrToStr6 (Entry: Tin6_addr) : AnsiString;
+function StrToNetAddr6 (IP : AnsiString) : TIn6_Addr;
+
+CONST
+ NoAddress : in_addr = (s_addr:0);
+ NoNet : in_addr = (s_addr:0);
+ NoAddress6: Tin6_addr = (u6_addr16:(0,0,0,0,0,0,0,0));
+ NoNet6 : Tin6_addr = (u6_addr16:(0,0,0,0,0,0,0,0));
+
+{
+ $Log: socketsh.inc,v $
+ Revision 1.27 2005/03/28 11:10:51 marco
+ * more netdb and Kylix related minor fixes. At the last minute, commented
+ out TSockAddrIn since I found that relied on TScokAddrIn=TSockAddr
+
+ Revision 1.26 2005/02/18 13:10:10 marco
+ * noadress and friend, ipv4 changed to an enum.
+
+ Revision 1.25 2005/02/14 17:13:26 peter
+ * truncate log
+
+ Revision 1.24 2005/02/13 21:10:31 marco
+ * in_addr_bytes to easily put an array over the byte type
+
+ Revision 1.23 2005/02/13 19:59:57 marco
+ * More htons like functionality. IPV6 string support still missing
+
+ Revision 1.22 2005/02/12 17:34:56 marco
+ * some kylix stuf
+
+}
diff --git a/rtl/inc/sockovl.inc b/rtl/inc/sockovl.inc
new file mode 100644
index 0000000000..c599e5be2f
--- /dev/null
+++ b/rtl/inc/sockovl.inc
@@ -0,0 +1,209 @@
+{
+ $Id: sockovl.inc,v 1.2 2005/02/14 17:13:26 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ socket call implementations for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ Socket:=fpsocket(domain,sockettype,protocol);
+end;
+
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+begin
+ Send:=fpsend(sock,@buf,buflen,flags);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+begin
+ Sendto:=fpsendto(sock,@buf,buflen,flags,@addr,addrlen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=fprecv(sock,@buf,buflen,flags);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr ; var AddrLen :longint) : longint;
+
+begin
+ RecvFrom:=fprecvfrom(Sock,@buf,buflen,flags,@Addr,@AddrLen);
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+begin
+ Bind:=fpbind(Sock,@Addr,AddrLen)=0;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+begin
+ Listen:=fplisten(sock,maxconnect)=0;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ Accept:=fpaccept(sock,@addr,@addrlen);
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint): boolean;
+
+begin
+ Connect:=fpConnect(sock,@addr,addrlen)=0;
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+ ShutDown:=fpshutdown(sock,how);
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=fpgetsockname(sock,@addr,@addrlen);
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=fpgetPeerName(sock,@addr,@addrlen);
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;const OptVal;optlen:longint):Longint;
+begin
+ SetSocketOptions:=fpsetsockopt(Sock,Level,OptName,pointer(@OptVal),optlen);
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=fpgetsockopt(Sock,Level,OptName,@OptVal,@OptLen);
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ SocketPair:=fpsocketpair(domain,sockettype,protocol,@pair);
+end;
+
+{******************************************************************************
+ UnixSock
+******************************************************************************}
+
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+begin
+ Move(Addr[1],t.Path,length(Addr));
+ t.Family:=AF_UNIX;
+ t.Path[length(Addr)]:=#0;
+ Len:=Length(Addr)+3;
+end;
+
+
+Function Bind(Sock:longint;const addr:string):boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ Bind(Sock,UnixAddr,AddrLen);
+ Bind:=(SocketError=0);
+end;
+
+
+
+Function DoAccept(Sock:longint;var addr:string):longint;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ AddrLen:=length(addr)+3;
+ DoAccept:=Accept(Sock,UnixAddr,AddrLen);
+ Move(UnixAddr.Path,Addr[1],AddrLen);
+ SetLength(Addr,AddrLen);
+end;
+
+
+
+Function DoConnect(Sock:longint;const addr:string):Boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ DoConnect:=Connect(Sock,UnixAddr,AddrLen);
+end;
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2Text(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2File(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ If Connect then
+ Sock2Text(Sock,SockIn,SockOut);
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ if Connect then
+ Sock2File(Sock,SockIn,SockOut);
+end;
+
+
+Function CloseSocket (Sock:Longint):Longint;
+begin
+ if fpclose(Sock)=0 then
+ CloseSocket := 0 else
+ CloseSocket := -1;
+end;
+
+
+{
+ $Log: sockovl.inc,v $
+ Revision 1.2 2005/02/14 17:13:26 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/softfpu.pp b/rtl/inc/softfpu.pp
new file mode 100644
index 0000000000..fa43ed4673
--- /dev/null
+++ b/rtl/inc/softfpu.pp
@@ -0,0 +1,4667 @@
+
+{*
+===============================================================================
+The original notice of the softfloat package is shown below. The conversion
+to pascal was done by Carl Eric Codere in 2002 (ccodere@ieee.org).
+===============================================================================
+
+This C source file is part of the SoftFloat IEC/IEEE Floating-Point
+Arithmetic Package, Release 2a.
+
+Written by John R. Hauser. This work was made possible in part by the
+International Computer Science Institute, located at Suite 600, 1947 Center
+Street, Berkeley, California 94704. Funding was partially provided by the
+National Science Foundation under grant MIP-9311980. The original version
+of this code was written as part of a project to build a fixed-point vector
+processor in collaboration with the University of California at Berkeley,
+overseen by Profs. Nelson Morgan and John Wawrzynek. More information
+is available through the Web page
+`http://HTTP.CS.Berkeley.EDU/~jhauser/arithmetic/SoftFloat.html'.
+
+THIS SOFTWARE IS DISTRIBUTED AS IS, FOR FREE. Although reasonable effort
+has been made to avoid it, THIS SOFTWARE MAY CONTAIN FAULTS THAT WILL AT
+TIMES RESULT IN INCORRECT BEHAVIOR. USE OF THIS SOFTWARE IS RESTRICTED TO
+PERSONS AND ORGANIZATIONS WHO CAN AND WILL TAKE FULL RESPONSIBILITY FOR ANY
+AND ALL LOSSES, COSTS, OR OTHER PROBLEMS ARISING FROM ITS USE.
+
+Derivative works are acceptable, even for commercial purposes, so long as
+(1) they include prominent notice that the work is derivative, and (2) they
+include prominent notice akin to these four paragraphs for those parts of
+this code that are retained.
+
+===============================================================================
+*}
+
+unit softfpu;
+{ Overflow checking must be disabled,
+ since some operations expect overflow!
+}
+{$Q-}
+
+{$ifndef ver1_0}
+{$ifdef fpc}
+{$define hascompilerproc}
+{$endif}
+{$endif}
+
+{$ifdef fpc}
+{$goto on}
+{$endif}
+
+interface
+
+
+{
+-------------------------------------------------------------------------------
+Software IEC/IEEE floating-point types.
+-------------------------------------------------------------------------------
+}
+TYPE
+ float32 = longword;
+
+ flag = byte;
+ uint8 = byte;
+ int8 = shortint;
+ uint16 = word;
+ int16 = integer;
+ uint32 = longword;
+ int32 = longint;
+
+ bits8 = byte;
+ sbits8 = shortint;
+ bits16 = word;
+ sbits16 = integer;
+ sbits32 = longint;
+ bits32 = longword;
+{$ifndef fpc}
+ qword = int64;
+{$endif}
+ uint64 = qword;
+ bits64 = qword;
+ sbits64 = int64;
+
+{$ifdef ENDIAN_LITTLE}
+ float64 = packed record
+ low: bits32;
+ high: bits32;
+ end;
+
+ int64rec = packed record
+ low: bits32;
+ high: bits32;
+ end;
+{$else}
+ float64 = packed record
+ high,low : bits32;
+ end;
+
+ int64rec = packed record
+ high,low : bits32;
+ end;
+
+{$endif}
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is less than
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_lt(a: float64;b: float64): flag; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is less than
+or equal to the corresponding value `b', and 0 otherwise. The comparison
+is performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_le(a: float64;b: float64): flag; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is equal to
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_eq(a: float64;b: float64): flag; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the square root of the double-precision floating-point value `a'.
+The operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_sqrt( a: float64; var out: float64 ); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the remainder of the double-precision floating-point value `a'
+with respect to the corresponding value `b'. The operation is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_rem(a: float64; b : float64; var out: float64); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of dividing the double-precision floating-point value `a'
+by the corresponding value `b'. The operation is performed according to the
+IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_div(a: float64; b : float64 ; var out: float64 ); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of multiplying the double-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_mul( a: float64; b:float64; Var out: float64); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of subtracting the double-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_sub(a: float64; b : float64; var out: float64); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of adding the double-precision floating-point values `a'
+and `b'. The operation is performed according to the IEC/IEEE Standard for
+Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_add( a: float64; b : float64; Var out : float64); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Rounds the double-precision floating-point value `a' to an integer,
+and returns the result as a double-precision floating-point value. The
+operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_round_to_int(a: float64; var out: float64 ); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point value
+`a' to the single-precision floating-point format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_to_float32(a: float64 ): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic, except that the conversion is always rounded toward zero.
+If `a' is a NaN, the largest positive integer is returned. Otherwise, if
+the conversion overflows, the largest integer with the same sign as `a' is
+returned.
+-------------------------------------------------------------------------------
+*}
+Function float64_to_int32_round_to_zero(a: float64 ): int32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic---which means in particular that the conversion is rounded
+according to the current rounding mode. If `a' is a NaN, the largest
+positive integer is returned. Otherwise, if the conversion overflows, the
+largest integer with the same sign as `a' is returned.
+-------------------------------------------------------------------------------
+*}
+Function float64_to_int32(a: float64): int32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is less than
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_lt( a:float32 ; b : float32): flag; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is less than
+or equal to the corresponding value `b', and 0 otherwise. The comparison
+is performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_le( a: float32; b : float32 ):flag; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is equal to
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_eq( a:float32; b:float32): flag; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the square root of the single-precision floating-point value `a'.
+The operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_sqrt(a: float32 ): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the remainder of the single-precision floating-point value `a'
+with respect to the corresponding value `b'. The operation is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_rem(a: float32; b: float32 ):float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of dividing the single-precision floating-point value `a'
+by the corresponding value `b'. The operation is performed according to the
+IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_div(a: float32;b: float32 ): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of multiplying the single-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_mul(a: float32; b: float32 ) : float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of subtracting the single-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_sub( a: float32 ; b:float32 ): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of adding the single-precision floating-point values `a'
+and `b'. The operation is performed according to the IEC/IEEE Standard for
+Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_add( a: float32; b:float32 ): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Rounds the single-precision floating-point value `a' to an integer,
+and returns the result as a single-precision floating-point value. The
+operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_round_to_int( a: float32): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point value
+`a' to the double-precision floating-point format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float32_to_float64( a : float32; var out: Float64); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic, except that the conversion is always rounded toward zero.
+If `a' is a NaN, the largest positive integer is returned. Otherwise, if
+the conversion overflows, the largest integer with the same sign as `a' is
+returned.
+-------------------------------------------------------------------------------
+*}
+Function float32_to_int32_round_to_zero( a: Float32 ): int32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic---which means in particular that the conversion is rounded
+according to the current rounding mode. If `a' is a NaN, the largest
+positive integer is returned. Otherwise, if the conversion overflows, the
+largest integer with the same sign as `a' is returned.
+-------------------------------------------------------------------------------
+*}
+Function float32_to_int32( a : float32) : int32; {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the 32-bit two's complement integer `a' to
+the double-precision floating-point format. The conversion is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure int32_to_float64( a: int32; var c: float64 ); {$ifdef hascompilerproc} compilerproc; {$endif}
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the 32-bit two's complement integer `a' to
+the single-precision floating-point format. The conversion is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function int32_to_float32( a: int32): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{*----------------------------------------------------------------------------
+| Returns the result of converting the 64-bit two's complement integer `a'
+| to the double-precision floating-point format. The conversion is performed
+| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+*----------------------------------------------------------------------------*}
+function int64_to_float64( a: int64 ): float64; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+{*----------------------------------------------------------------------------
+| Returns the result of converting the 64-bit two's complement integer `a'
+| to the single-precision floating-point format. The conversion is performed
+| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+*----------------------------------------------------------------------------*}
+function int64_to_float32( a: int64 ): float32; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+
+CONST
+{-------------------------------------------------------------------------------
+Software IEC/IEEE floating-point underflow tininess-detection mode.
+-------------------------------------------------------------------------------
+*}
+ float_tininess_after_rounding = 0;
+ float_tininess_before_rounding = 1;
+
+{*
+-------------------------------------------------------------------------------
+Software IEC/IEEE floating-point rounding mode.
+-------------------------------------------------------------------------------
+*}
+{
+Round to nearest.
+This is the default mode. It should be used unless there is a specific
+need for one of the others. In this mode results are rounded to the
+nearest representable value. If the result is midway between two
+representable values, the even representable is chosen. Even here
+means the lowest-order bit is zero. This rounding mode prevents
+statistical bias and guarantees numeric stability: round-off errors
+in a lengthy calculation will remain smaller than half of FLT_EPSILON.
+
+Round toward plus Infinity.
+All results are rounded to the smallest representable value which is
+greater than the result.
+
+Round toward minus Infinity.
+All results are rounded to the largest representable value which is
+less than the result.
+
+Round toward zero.
+All results are rounded to the largest representable value whose
+magnitude is less than that of the result. In other words, if the
+result is negative it is rounded up; if it is positive, it is
+rounded down.
+}
+ float_round_nearest_even = 0;
+ float_round_down = 1;
+ float_round_up = 2;
+ float_round_to_zero = 3;
+
+{*
+-------------------------------------------------------------------------------
+Software IEC/IEEE floating-point exception flags.
+-------------------------------------------------------------------------------
+*}
+ float_flag_invalid = 1;
+ float_flag_divbyzero = 4;
+ float_flag_overflow = 8;
+ float_flag_underflow = 16;
+ float_flag_inexact = 32;
+
+{*
+-------------------------------------------------------------------------------
+Floating-point rounding mode and exception flags.
+-------------------------------------------------------------------------------
+*}
+const
+ float_rounding_mode : Byte = float_round_nearest_even;
+ float_exception_flags : Byte = 0;
+
+{*
+-------------------------------------------------------------------------------
+Underflow tininess-detection mode, statically initialized to default value.
+(The declaration in `softfloat.h' must match the `int8' type here.)
+-------------------------------------------------------------------------------
+*}
+
+const float_detect_tininess: int8 = float_tininess_after_rounding;
+
+
+
+
+implementation
+
+
+{*
+-------------------------------------------------------------------------------
+Raises the exceptions specified by `flags'. Floating-point traps can be
+defined here if desired. It is currently not possible for such a trap
+to substitute a result value. If traps are not implemented, this routine
+should be simply `float_exception_flags |= flags;'.
+-------------------------------------------------------------------------------
+*}
+procedure float_raise( i: shortint );
+Begin
+ float_exception_flags := float_exception_flags or i;
+ if (float_exception_flags and float_flag_invalid) <> 0 then
+ RunError(207)
+ else
+ if (float_exception_flags and float_flag_divbyzero) <> 0 then
+ RunError(200)
+ else
+ if (float_exception_flags and float_flag_overflow) <> 0 then
+ RunError(205)
+ else
+ if (float_exception_flags and float_flag_underflow) <> 0 then
+ RunError(206);
+end;
+
+
+(*****************************************************************************)
+(*----------------------------------------------------------------------------*)
+(* Primitive arithmetic functions, including multi-word arithmetic, and *)
+(* division and square root approximations. (Can be specialized to target if *)
+(* desired.) *)
+(* ---------------------------------------------------------------------------*)
+(*****************************************************************************)
+
+{*
+-------------------------------------------------------------------------------
+Shifts `a' right by the number of bits given in `count'. If any nonzero
+bits are shifted off, they are ``jammed'' into the least significant bit of
+the result by setting the least significant bit to 1. The value of `count'
+can be arbitrarily large; in particular, if `count' is greater than 32, the
+result will be either 0 or 1, depending on whether `a' is zero or nonzero.
+The result is stored in the location pointed to by `zPtr'.
+-------------------------------------------------------------------------------
+*}
+Procedure shift32RightJamming( a: bits32 ; count: int16 ; VAR zPtr :bits32);
+var
+ z: Bits32;
+Begin
+ if ( count = 0 ) then
+ z := a
+ else
+ if ( count < 32 ) then
+ Begin
+ z := ( a shr count ) or bits32( (( a shl ( ( - count ) AND 31 )) ) <> 0);
+ End
+ else
+ Begin
+ z := bits32( a <> 0 );
+ End;
+ zPtr := z;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Shifts the 64-bit value formed by concatenating `a0' and `a1' right by the
+number of bits given in `count'. Any bits shifted off are lost. The value
+of `count' can be arbitrarily large; in particular, if `count' is greater
+than 64, the result will be 0. The result is broken into two 32-bit pieces
+which are stored at the locations pointed to by `z0Ptr' and `z1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ shift64Right(
+ a0 :bits32; a1: bits32; count:int16; VAR z0Ptr:bits32; VAR z1Ptr:bits32);
+Var
+ z0, z1: bits32;
+ negCount : int8;
+Begin
+ negCount := ( - count ) AND 31;
+
+ if ( count = 0 ) then
+ Begin
+ z1 := a1;
+ z0 := a0;
+ End
+ else if ( count < 32 ) then
+ Begin
+ z1 := ( a0 shl negCount ) OR ( a1 shr count );
+ z0 := a0 shr count;
+ End
+ else
+ Begin
+ if (count < 64) then
+ z1 := ( a0 shr ( count AND 31 ) )
+ else
+ z1 := 0;
+ z0 := 0;
+ End;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Shifts the 64-bit value formed by concatenating `a0' and `a1' right by the
+number of bits given in `count'. If any nonzero bits are shifted off, they
+are ``jammed'' into the least significant bit of the result by setting the
+least significant bit to 1. The value of `count' can be arbitrarily large;
+in particular, if `count' is greater than 64, the result will be either 0
+or 1, depending on whether the concatenation of `a0' and `a1' is zero or
+nonzero. The result is broken into two 32-bit pieces which are stored at
+the locations pointed to by `z0Ptr' and `z1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ shift64RightJamming(
+ a0:bits32; a1: bits32; count:int16; VAR Z0Ptr :bits32;VAR z1Ptr: bits32 );
+VAR
+ z0, z1 : bits32;
+ negCount : int8;
+Begin
+ negCount := ( - count ) AND 31;
+
+ if ( count = 0 ) then
+ Begin
+ z1 := a1;
+ z0 := a0;
+ End
+ else
+ if ( count < 32 ) then
+ Begin
+ z1 := ( a0 shl negCount ) OR ( a1 shr count ) OR bits32( ( a1 shl negCount ) <> 0 );
+ z0 := a0 shr count;
+ End
+ else
+ Begin
+ if ( count = 32 ) then
+ Begin
+ z1 := a0 OR bits32( a1 <> 0 );
+ End
+ else
+ if ( count < 64 ) Then
+ Begin
+ z1 := ( a0 shr ( count AND 31 ) ) OR bits32( ( ( a0 shl negCount ) OR a1 ) <> 0 );
+ End
+ else
+ Begin
+ z1 := bits32( ( a0 OR a1 ) <> 0 );
+ End;
+ z0 := 0;
+ End;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+
+
+
+{*
+-------------------------------------------------------------------------------
+Shifts the 96-bit value formed by concatenating `a0', `a1', and `a2' right
+by 32 _plus_ the number of bits given in `count'. The shifted result is
+at most 64 nonzero bits; these are broken into two 32-bit pieces which are
+stored at the locations pointed to by `z0Ptr' and `z1Ptr'. The bits shifted
+off form a third 32-bit result as follows: The _last_ bit shifted off is
+the most-significant bit of the extra result, and the other 31 bits of the
+extra result are all zero if and only if _all_but_the_last_ bits shifted off
+were all zero. This extra result is stored in the location pointed to by
+`z2Ptr'. The value of `count' can be arbitrarily large.
+ (This routine makes more sense if `a0', `a1', and `a2' are considered
+to form a fixed-point value with binary point between `a1' and `a2'. This
+fixed-point value is shifted right by the number of bits given in `count',
+and the integer part of the result is returned at the locations pointed to
+by `z0Ptr' and `z1Ptr'. The fractional part of the result may be slightly
+corrupted as described above, and is returned at the location pointed to by
+`z2Ptr'.)
+-------------------------------------------------------------------------------
+}
+Procedure
+ shift64ExtraRightJamming(
+ a0: bits32;
+ a1: bits32;
+ a2: bits32;
+ count: int16;
+ VAR z0Ptr: bits32;
+ VAR z1Ptr: bits32;
+ VAR z2Ptr: bits32
+ );
+Var
+ z0, z1, z2: bits32;
+ negCount : int8;
+Begin
+ negCount := ( - count ) AND 31;
+
+ if ( count = 0 ) then
+ Begin
+ z2 := a2;
+ z1 := a1;
+ z0 := a0;
+ End
+ else
+ Begin
+ if ( count < 32 ) Then
+ Begin
+ z2 := a1 shl negCount;
+ z1 := ( a0 shl negCount ) OR ( a1 shr count );
+ z0 := a0 shr count;
+ End
+ else
+ Begin
+ if ( count = 32 ) then
+ Begin
+ z2 := a1;
+ z1 := a0;
+ End
+ else
+ Begin
+ a2 := a2 or a1;
+ if ( count < 64 ) then
+ Begin
+ z2 := a0 shl negCount;
+ z1 := a0 shr ( count AND 31 );
+ End
+ else
+ Begin
+ if count = 64 then
+ z2 := a0
+ else
+ z2 := bits32(a0 <> 0);
+ z1 := 0;
+ End;
+ End;
+ z0 := 0;
+ End;
+ z2 := z2 or bits32( a2 <> 0 );
+ End;
+ z2Ptr := z2;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Shifts the 64-bit value formed by concatenating `a0' and `a1' left by the
+number of bits given in `count'. Any bits shifted off are lost. The value
+of `count' must be less than 32. The result is broken into two 32-bit
+pieces which are stored at the locations pointed to by `z0Ptr' and `z1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ shortShift64Left(
+ a0:bits32; a1:bits32; count:int16; VAR z0Ptr:bits32; VAR z1Ptr:bits32 );
+Begin
+
+ z1Ptr := a1 shl count;
+ if count = 0 then
+ z0Ptr := a0
+ else
+ z0Ptr := ( a0 shl count ) OR ( a1 shr ( ( - count ) AND 31 ) );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Shifts the 96-bit value formed by concatenating `a0', `a1', and `a2' left
+by the number of bits given in `count'. Any bits shifted off are lost.
+The value of `count' must be less than 32. The result is broken into three
+32-bit pieces which are stored at the locations pointed to by `z0Ptr',
+`z1Ptr', and `z2Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ shortShift96Left(
+ a0: bits32;
+ a1: bits32;
+ a2: bits32;
+ count: int16;
+ VAR z0Ptr: bits32;
+ VAR z1Ptr: bits32;
+ VAR z2Ptr: bits32
+ );
+Var
+ z0, z1, z2: bits32;
+ negCount: int8;
+Begin
+ z2 := a2 shl count;
+ z1 := a1 shl count;
+ z0 := a0 shl count;
+ if ( 0 < count ) then
+ Begin
+ negCount := ( ( - count ) AND 31 );
+ z1 := z1 or (a2 shr negCount);
+ z0 := z0 or (a1 shr negCount);
+ End;
+ z2Ptr := z2;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Adds the 64-bit value formed by concatenating `a0' and `a1' to the 64-bit
+value formed by concatenating `b0' and `b1'. Addition is modulo 2^64, so
+any carry out is lost. The result is broken into two 32-bit pieces which
+are stored at the locations pointed to by `z0Ptr' and `z1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ add64(
+ a0:bits32; a1:bits32; b0:bits32; b1:bits32; VAR z0Ptr:bits32; VAR z1Ptr:bits32 );
+Var
+ z1: bits32;
+Begin
+ z1 := a1 + b1;
+ z1Ptr := z1;
+ z0Ptr := a0 + b0 + bits32( z1 < a1 );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Adds the 96-bit value formed by concatenating `a0', `a1', and `a2' to the
+96-bit value formed by concatenating `b0', `b1', and `b2'. Addition is
+modulo 2^96, so any carry out is lost. The result is broken into three
+32-bit pieces which are stored at the locations pointed to by `z0Ptr',
+`z1Ptr', and `z2Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ add96(
+ a0: bits32;
+ a1: bits32;
+ a2: bits32;
+ b0: bits32;
+ b1: bits32;
+ b2: bits32;
+ VAR z0Ptr: bits32;
+ VAR z1Ptr: bits32;
+ VAR z2Ptr: bits32
+ );
+var
+ z0, z1, z2: bits32;
+ carry0, carry1: int8;
+Begin
+ z2 := a2 + b2;
+ carry1 := int8( z2 < a2 );
+ z1 := a1 + b1;
+ carry0 := int8( z1 < a1 );
+ z0 := a0 + b0;
+ z1 := z1 + carry1;
+ z0 := z0 + bits32( z1 < carry1 );
+ z0 := z0 + carry0;
+ z2Ptr := z2;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Subtracts the 64-bit value formed by concatenating `b0' and `b1' from the
+64-bit value formed by concatenating `a0' and `a1'. Subtraction is modulo
+2^64, so any borrow out (carry out) is lost. The result is broken into two
+32-bit pieces which are stored at the locations pointed to by `z0Ptr' and
+`z1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ sub64(
+ a0: bits32; a1 : bits32; b0 :bits32; b1: bits32; VAR z0Ptr:bits32; VAR z1Ptr: bits32 );
+Begin
+ z1Ptr := a1 - b1;
+ z0Ptr := a0 - b0 - bits32( a1 < b1 );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Subtracts the 96-bit value formed by concatenating `b0', `b1', and `b2' from
+the 96-bit value formed by concatenating `a0', `a1', and `a2'. Subtraction
+is modulo 2^96, so any borrow out (carry out) is lost. The result is broken
+into three 32-bit pieces which are stored at the locations pointed to by
+`z0Ptr', `z1Ptr', and `z2Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ sub96(
+ a0:bits32;
+ a1:bits32;
+ a2:bits32;
+ b0:bits32;
+ b1:bits32;
+ b2:bits32;
+ VAR z0Ptr:bits32;
+ VAR z1Ptr:bits32;
+ VAR z2Ptr:bits32
+ );
+Var
+ z0, z1, z2: bits32;
+ borrow0, borrow1: int8;
+Begin
+ z2 := a2 - b2;
+ borrow1 := int8( a2 < b2 );
+ z1 := a1 - b1;
+ borrow0 := int8( a1 < b1 );
+ z0 := a0 - b0;
+ z0 := z0 - bits32( z1 < borrow1 );
+ z1 := z1 - borrow1;
+ z0 := z0 -borrow0;
+ z2Ptr := z2;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Multiplies `a' by `b' to obtain a 64-bit product. The product is broken
+into two 32-bit pieces which are stored at the locations pointed to by
+`z0Ptr' and `z1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure mul32To64( a:bits32; b:bits32; VAR z0Ptr: bits32; VAR z1Ptr
+:bits32 );
+Var
+ aHigh, aLow, bHigh, bLow: bits16;
+ z0, zMiddleA, zMiddleB, z1: bits32;
+Begin
+ aLow := a and $ffff;
+ aHigh := a shr 16;
+ bLow := b and $ffff;
+ bHigh := b shr 16;
+ z1 := ( bits32( aLow) ) * bLow;
+ zMiddleA := ( bits32 (aLow) ) * bHigh;
+ zMiddleB := ( bits32 (aHigh) ) * bLow;
+ z0 := ( bits32 (aHigh) ) * bHigh;
+ zMiddleA := zMiddleA + zMiddleB;
+ z0 := z0 + ( ( bits32 ( zMiddleA < zMiddleB ) ) shl 16 ) + ( zMiddleA shr 16 );
+ zMiddleA := zmiddleA shl 16;
+ z1 := z1 + zMiddleA;
+ z0 := z0 + bits32( z1 < zMiddleA );
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Multiplies the 64-bit value formed by concatenating `a0' and `a1' by `b'
+to obtain a 96-bit product. The product is broken into three 32-bit pieces
+which are stored at the locations pointed to by `z0Ptr', `z1Ptr', and
+`z2Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ mul64By32To96(
+ a0:bits32;
+ a1:bits32;
+ b:bits32;
+ VAR z0Ptr:bits32;
+ VAR z1Ptr:bits32;
+ VAR z2Ptr:bits32
+ );
+Var
+ z0, z1, z2, more1: bits32;
+Begin
+ mul32To64( a1, b, z1, z2 );
+ mul32To64( a0, b, z0, more1 );
+ add64( z0, more1, 0, z1, z0, z1 );
+ z2Ptr := z2;
+ z1Ptr := z1;
+ z0Ptr := z0;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Multiplies the 64-bit value formed by concatenating `a0' and `a1' to the
+64-bit value formed by concatenating `b0' and `b1' to obtain a 128-bit
+product. The product is broken into four 32-bit pieces which are stored at
+the locations pointed to by `z0Ptr', `z1Ptr', `z2Ptr', and `z3Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ mul64To128(
+ a0:bits32;
+ a1:bits32;
+ b0:bits32;
+ b1:bits32;
+ VAR z0Ptr:bits32;
+ VAR z1Ptr:bits32;
+ VAR z2Ptr:bits32;
+ VAR z3Ptr:bits32
+ );
+Var
+ z0, z1, z2, z3: bits32;
+ more1, more2: bits32;
+Begin
+
+ mul32To64( a1, b1, z2, z3 );
+ mul32To64( a1, b0, z1, more2 );
+ add64( z1, more2, 0, z2, z1, z2 );
+ mul32To64( a0, b0, z0, more1 );
+ add64( z0, more1, 0, z1, z0, z1 );
+ mul32To64( a0, b1, more1, more2 );
+ add64( more1, more2, 0, z2, more1, z2 );
+ add64( z0, z1, 0, more1, z0, z1 );
+ z3Ptr := z3;
+ z2Ptr := z2;
+ z1Ptr := z1;
+ z0Ptr := z0;
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns an approximation to the 32-bit integer quotient obtained by dividing
+`b' into the 64-bit value formed by concatenating `a0' and `a1'. The
+divisor `b' must be at least 2^31. If q is the exact quotient truncated
+toward zero, the approximation returned lies between q and q + 2 inclusive.
+If the exact quotient q is larger than 32 bits, the maximum positive 32-bit
+unsigned integer is returned.
+-------------------------------------------------------------------------------
+*}
+Function estimateDiv64To32( a0:bits32; a1: bits32; b:bits32): bits32;
+Var
+ b0, b1: bits32;
+ rem0, rem1, term0, term1: bits32;
+ z: bits32;
+Begin
+ if ( b <= a0 ) then
+ Begin
+ estimateDiv64To32 := $FFFFFFFF;
+ exit;
+ End;
+ b0 := b shr 16;
+ if ( b0 shl 16 <= a0 ) then
+ z:= $FFFF0000
+ else
+ z:= ( a0 div b0 ) shl 16;
+ mul32To64( b, z, term0, term1 );
+ sub64( a0, a1, term0, term1, rem0, rem1 );
+ while ( ( sbits32 (rem0) ) < 0 ) do
+ Begin
+ z := z - $10000;
+ b1 := b shl 16;
+ add64( rem0, rem1, b0, b1, rem0, rem1 );
+ End;
+ rem0 := ( rem0 shl 16 ) OR ( rem1 shr 16 );
+ if ( b0 shl 16 <= rem0 ) then
+ z := z or $FFFF
+ else
+ z := z or (rem0 div b0);
+ estimateDiv64To32 := z;
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns an approximation to the square root of the 32-bit significand given
+by `a'. Considered as an integer, `a' must be at least 2^31. If bit 0 of
+`aExp' (the least significant bit) is 1, the integer returned approximates
+2^31*sqrt(`a'/2^31), where `a' is considered an integer. If bit 0 of `aExp'
+is 0, the integer returned approximates 2^31*sqrt(`a'/2^30). In either
+case, the approximation returned lies strictly within +/-2 of the exact
+value.
+-------------------------------------------------------------------------------
+*}
+Function estimateSqrt32( aExp: int16; a: bits32 ): bits32;
+ const sqrtOddAdjustments: array[0..15] of bits16 = (
+ $0004, $0022, $005D, $00B1, $011D, $019F, $0236, $02E0,
+ $039C, $0468, $0545, $0631, $072B, $0832, $0946, $0A67
+ );
+ const sqrtEvenAdjustments: array[0..15] of bits16 = (
+ $0A2D, $08AF, $075A, $0629, $051A, $0429, $0356, $029E,
+ $0200, $0179, $0109, $00AF, $0068, $0034, $0012, $0002
+ );
+Var
+ index: int8;
+ z: bits32;
+Begin
+
+ index := ( a shr 27 ) AND 15;
+ if ( aExp AND 1 ) <> 0 then
+ Begin
+ z := $4000 + ( a shr 17 ) - sqrtOddAdjustments[ index ];
+ z := ( ( a div z ) shl 14 ) + ( z shl 15 );
+ a := a shr 1;
+ End
+ else
+ Begin
+ z := $8000 + ( a shr 17 ) - sqrtEvenAdjustments[ index ];
+ z := a div z + z;
+ if ( $20000 <= z ) then
+ z := $FFFF8000
+ else
+ z := ( z shl 15 );
+ if ( z <= a ) then
+ Begin
+ estimateSqrt32 := bits32 ( ( sbits32 (a )) shr 1 );
+ exit;
+ End;
+ End;
+ estimateSqrt32 := ( ( estimateDiv64To32( a, 0, z ) ) shr 1 ) + ( z shr 1 );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the number of leading 0 bits before the most-significant 1 bit of
+`a'. If `a' is zero, 32 is returned.
+-------------------------------------------------------------------------------
+*}
+Function countLeadingZeros32( a:bits32 ): int8;
+
+ const countLeadingZerosHigh:array[0..255] of int8 = (
+ 8, 7, 6, 6, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 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,
+ 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,
+ 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,
+ 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,
+ 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,
+ 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
+ );
+Var
+ shiftCount: int8;
+Begin
+
+ shiftCount := 0;
+ if ( a < $10000 ) then
+ Begin
+ shiftCount := shiftcount + 16;
+ a := a shl 16;
+ End;
+ if ( a < $1000000 ) then
+ Begin
+ shiftCount := shiftcount + 8;
+ a := a shl 8;
+ end;
+ shiftCount := shiftcount + countLeadingZerosHigh[ a shr 24 ];
+ countLeadingZeros32:= shiftCount;
+End;
+
+{*----------------------------------------------------------------------------
+| Returns the number of leading 0 bits before the most-significant 1 bit of
+| `a'. If `a' is zero, 64 is returned.
+*----------------------------------------------------------------------------*}
+
+function countLeadingZeros64( a : bits64): int8;
+var
+ shiftcount : int8;
+Begin
+ shiftCount := 0;
+ if ( a < (bits64(1) shl 32 )) then
+ shiftCount := shiftcount + 32
+ else
+ a := a shr 32;
+ shiftCount := shiftCount + countLeadingZeros32( a );
+ countLeadingZeros64:= shiftCount;
+End;
+
+
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the 64-bit value formed by concatenating `a0' and `a1' is
+equal to the 64-bit value formed by concatenating `b0' and `b1'. Otherwise,
+returns 0.
+-------------------------------------------------------------------------------
+*}
+Function eq64( a0: bits32; a1:bits32 ;b0:bits32; b1:bits32 ): flag;
+Begin
+ eq64 := flag( a0 = b0 ) and flag( a1 = b1 );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the 64-bit value formed by concatenating `a0' and `a1' is less
+than or equal to the 64-bit value formed by concatenating `b0' and `b1'.
+Otherwise, returns 0.
+-------------------------------------------------------------------------------
+*}
+Function le64( a0: bits32; a1:bits32 ;b0:bits32; b1:bits32 ): flag;
+Begin
+
+ le64:= flag( a0 < b0 ) or flag( ( a0 = b0 ) and ( a1 <= b1 ) );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the 64-bit value formed by concatenating `a0' and `a1' is less
+than the 64-bit value formed by concatenating `b0' and `b1'. Otherwise,
+returns 0.
+-------------------------------------------------------------------------------
+*}
+Function lt64( a0: bits32; a1:bits32 ;b0:bits32; b1:bits32 ): flag;
+Begin
+ lt64 := flag( a0 < b0 ) or flag( ( a0 = b0 ) and ( a1 < b1 ) );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the 64-bit value formed by concatenating `a0' and `a1' is not
+equal to the 64-bit value formed by concatenating `b0' and `b1'. Otherwise,
+returns 0.
+-------------------------------------------------------------------------------
+*}
+Function ne64( a0: bits32; a1:bits32 ;b0:bits32; b1:bits32 ): flag;
+Begin
+ ne64:= flag( a0 <> b0 ) or flag( a1 <> b1 );
+End;
+
+(*****************************************************************************)
+(* End Low-Level arithmetic *)
+(*****************************************************************************)
+
+
+
+{*
+-------------------------------------------------------------------------------
+Functions and definitions to determine: (1) whether tininess for underflow
+is detected before or after rounding by default, (2) what (if anything)
+happens when exceptions are raised, (3) how signaling NaNs are distinguished
+from quiet NaNs, (4) the default generated quiet NaNs, and (4) how NaNs
+are propagated from function inputs to output. These details are ENDIAN
+specific
+-------------------------------------------------------------------------------
+*}
+{$IFDEF ENDIAN_LITTLE}
+{*
+-------------------------------------------------------------------------------
+Internal canonical NaN format.
+-------------------------------------------------------------------------------
+*}
+TYPE
+
+
+ commonNaNT = packed record
+ sign: flag;
+ high, low : bits32;
+ end;
+
+{*
+-------------------------------------------------------------------------------
+The pattern for a default generated single-precision NaN.
+-------------------------------------------------------------------------------
+*}
+const float32_default_nan = $FFC00000;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is a NaN;
+otherwise returns 0.
+-------------------------------------------------------------------------------
+*}
+Function float32_is_nan( a : float32 ): flag;
+Begin
+
+ float32_is_nan:= flag( $FF000000 < bits32 ( a shl 1 ) );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is a signaling
+NaN; otherwise returns 0.
+-------------------------------------------------------------------------------
+*}
+Function float32_is_signaling_nan( a : float32 ): flag;
+Begin
+
+ float32_is_signaling_nan := flag
+ ( ( ( a shr 22 ) and $1FF ) = $1FE ) and( a and $003FFFFF );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point NaN
+`a' to the canonical NaN format. If `a' is a signaling NaN, the invalid
+exception is raised.
+-------------------------------------------------------------------------------
+*}
+Procedure float32ToCommonNaN( a: float32; VAR c:commonNaNT );
+var
+ z : commonNaNT ;
+Begin
+ if ( float32_is_signaling_nan( a ) <> 0) then
+ float_raise( float_flag_invalid );
+ z.sign := a shr 31;
+ z.low := 0;
+ z.high := a shl 9;
+ c := z;
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the canonical NaN `a' to the single-
+precision floating-point format.
+-------------------------------------------------------------------------------
+*}
+Function commonNaNToFloat32( a : commonNaNT ): float32;
+Begin
+ commonNaNToFloat32 := ( ( bits32 (a.sign) ) shl 31 ) or $7FC00000 or ( a.high shr 9 );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Takes two single-precision floating-point values `a' and `b', one of which
+is a NaN, and returns the appropriate NaN result. If either `a' or `b' is a
+signaling NaN, the invalid exception is raised.
+-------------------------------------------------------------------------------
+*}
+Function propagateFloat32NaN( a : float32 ; b: float32 ): float32;
+Var
+ aIsNaN, aIsSignalingNaN, bIsNaN, bIsSignalingNaN: flag;
+label returnLargerSignificand;
+Begin
+ aIsNaN := float32_is_nan( a );
+ aIsSignalingNaN := float32_is_signaling_nan( a );
+ bIsNaN := float32_is_nan( b );
+ bIsSignalingNaN := float32_is_signaling_nan( b );
+ a := a or $00400000;
+ b := b or $00400000;
+ if ( aIsSignalingNaN or bIsSignalingNaN ) <> 0 then
+ float_raise( float_flag_invalid );
+ if ( aIsSignalingNaN )<> 0 then
+ Begin
+ if ( bIsSignalingNaN ) <> 0 then
+ goto returnLargerSignificand;
+ if bIsNan <> 0 then
+ propagateFloat32NaN := b
+ else
+ propagateFloat32NaN := a;
+ exit;
+ End
+ else if ( aIsNaN <> 0) then
+ Begin
+ if ( bIsSignalingNaN or not bIsNaN )<> 0 then
+ Begin
+ propagateFloat32NaN := a;
+ exit;
+ End;
+ returnLargerSignificand:
+ if ( bits32 ( a shl 1 ) < bits32 ( b shl 1 ) ) then
+ Begin
+ propagateFloat32NaN := b;
+ exit;
+ End;
+ if ( bits32 ( b shl 1 ) < bits32 ( a shl 1 ) ) then
+ Begin
+ propagateFloat32NaN := a;
+ End;
+ if a < b then
+ propagateFloat32NaN := a
+ else
+ propagateFloat32NaN := b;
+ exit;
+ End
+ else
+ Begin
+ propagateFloat32NaN := b;
+ exit;
+ End;
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+The pattern for a default generated double-precision NaN. The `high' and
+`low' values hold the most- and least-significant bits, respectively.
+-------------------------------------------------------------------------------
+*}
+const
+ float64_default_nan_high = $FFF80000;
+ float64_default_nan_low = $00000000;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is a NaN;
+otherwise returns 0.
+-------------------------------------------------------------------------------
+*}
+Function float64_is_nan( a : float64 ) : flag;
+Begin
+
+ float64_is_nan :=
+ flag( $FFE00000 <= bits32 ( a.high shl 1 ) )
+ and ( a.low or ( a.high and $000FFFFF ) );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is a signaling
+NaN; otherwise returns 0.
+-------------------------------------------------------------------------------
+*}
+Function float64_is_signaling_nan( a : float64 ): flag;
+Begin
+
+ float64_is_signaling_nan :=
+ flag( ( ( a.high shr 19 ) and $FFF ) = $FFE )
+ and ( a.low or ( a.high and $0007FFFF ) );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point NaN
+`a' to the canonical NaN format. If `a' is a signaling NaN, the invalid
+exception is raised.
+-------------------------------------------------------------------------------
+*}
+Procedure float64ToCommonNaN( a : float64; VAR c:commonNaNT );
+Var
+ z : commonNaNT;
+Begin
+ if ( float64_is_signaling_nan( a )<>0 ) then
+ float_raise( float_flag_invalid );
+ z.sign := a.high shr 31;
+ shortShift64Left( a.high, a.low, 12, z.high, z.low );
+ c := z;
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the canonical NaN `a' to the double-
+precision floating-point format.
+-------------------------------------------------------------------------------
+*}
+Procedure commonNaNToFloat64( a : commonNaNT; VAR c: float64 );
+Var
+ z: float64;
+Begin
+ shift64Right( a.high, a.low, 12, z.high, z.low );
+ z.high := z.high or ( ( bits32 (a.sign) ) shl 31 ) or $7FF80000;
+ c := z;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Takes two double-precision floating-point values `a' and `b', one of which
+is a NaN, and returns the appropriate NaN result. If either `a' or `b' is a
+signaling NaN, the invalid exception is raised.
+-------------------------------------------------------------------------------
+*}
+Procedure propagateFloat64NaN( a: float64; b: float64 ; VAR c: float64 );
+Var
+ aIsNaN, aIsSignalingNaN, bIsNaN, bIsSignalingNaN: flag;
+ label returnLargerSignificand;
+Begin
+ aIsNaN := float64_is_nan( a );
+ aIsSignalingNaN := float64_is_signaling_nan( a );
+ bIsNaN := float64_is_nan( b );
+ bIsSignalingNaN := float64_is_signaling_nan( b );
+ a.high := a.high or $00080000;
+ b.high := b.high or $00080000;
+ if ( aIsSignalingNaN or bIsSignalingNaN )<> 0 then
+ float_raise( float_flag_invalid );
+ if ( aIsSignalingNaN )<>0 then
+ Begin
+ if ( bIsSignalingNaN )<>0 then
+ goto returnLargerSignificand;
+ if bIsNan <> 0 then
+ c := b
+ else
+ c := a;
+ exit;
+ End
+ else if ( aIsNaN )<> 0 then
+ Begin
+ if ( bIsSignalingNaN or not bIsNaN ) <> 0 then
+ Begin
+ c := a;
+ exit;
+ End;
+ returnLargerSignificand:
+ if ( lt64( a.high shl 1, a.low, b.high shl 1, b.low ) ) <> 0 then
+ Begin
+ c := b;
+ exit;
+ End;
+ if ( lt64( b.high shl 1, b.low, a.high shl 1, a.low ) ) <> 0 then
+ Begin
+ c := a;
+ exit;
+ End;
+ if a.high < b.high then
+ c := a
+ else
+ c := b;
+ exit;
+ End
+ else
+ Begin
+ c := b;
+ exit;
+ End;
+End;
+{$ELSE}
+{ Big endian code }
+(*----------------------------------------------------------------------------
+| Internal canonical NaN format.
+*----------------------------------------------------------------------------*)
+type
+ commonNANT = packed record
+ sign : flag;
+ high, low : bits32;
+ end;
+
+(*----------------------------------------------------------------------------
+| The pattern for a default generated single-precision NaN.
+*----------------------------------------------------------------------------*)
+const float32_default_nan = $7FFFFFFF;
+
+(*----------------------------------------------------------------------------
+| Returns 1 if the single-precision floating-point value `a' is a NaN;
+| otherwise returns 0.
+*----------------------------------------------------------------------------*)
+function float32_is_nan(a: float32): flag;
+begin
+ float32_is_nan := flag( $FF000000 < bits32( a shl 1 ) );
+end;
+
+(*----------------------------------------------------------------------------
+| Returns 1 if the single-precision floating-point value `a' is a signaling
+| NaN; otherwise returns 0.
+*----------------------------------------------------------------------------*)
+function float32_is_signaling_nan(a: float32):flag;
+ begin
+ float32_is_signaling_nan := flag( ( ( a shr 22 ) and $1FF ) = $1FE ) and flag( boolean((a and $003FFFFF)<>0) );
+ end;
+
+(*----------------------------------------------------------------------------
+| Returns the result of converting the single-precision floating-point NaN
+| `a' to the canonical NaN format. If `a' is a signaling NaN, the invalid
+| exception is raised.
+*----------------------------------------------------------------------------*)
+Procedure float32ToCommonNaN( a: float32; VAR c:commonNaNT );
+ var
+ z: commonNANT;
+ begin
+ if float32_is_signaling_nan(a)<>0 then
+ float_raise(float_flag_invalid);
+ z.sign := a shr 31;
+ z.low := 0;
+ z.high := a shl 9;
+ c:=z;
+ end;
+
+(*----------------------------------------------------------------------------
+| Returns the result of converting the canonical NaN `a' to the single-
+| precision floating-point format.
+*----------------------------------------------------------------------------*)
+function CommonNanToFloat32(a : CommonNaNT): float32;
+ begin
+ CommonNanToFloat32:= ( ( bits32( a.sign )) shl 31 ) OR $7FC00000 OR ( a.high shr 9 );
+ end;
+
+(*----------------------------------------------------------------------------
+| Takes two single-precision floating-point values `a' and `b', one of which
+| is a NaN, and returns the appropriate NaN result. If either `a' or `b' is a
+| signaling NaN, the invalid exception is raised.
+*----------------------------------------------------------------------------*)
+function propagateFloat32NaN( a: float32 ; b: float32): float32;
+ var
+ aIsNaN, aIsSignalingNaN, bIsNaN, bIsSignalingNaN: flag;
+ begin
+ aIsNaN := float32_is_nan( a );
+ aIsSignalingNaN := float32_is_signaling_nan( a );
+ bIsNaN := float32_is_nan( b );
+ bIsSignalingNaN := float32_is_signaling_nan( b );
+ a := a or $00400000;
+ b := b or $00400000;
+ if ( aIsSignalingNaN or bIsSignalingNaN )<>0 then
+ float_raise( float_flag_invalid );
+ if bIsSignalingNaN<>0 then
+ propagateFloat32Nan := b
+ else if aIsSignalingNan<>0 then
+ propagateFloat32Nan := a
+ else if bIsNan<>0 then
+ propagateFloat32Nan := b
+ else
+ propagateFloat32Nan := a;
+ end;
+
+
+(*----------------------------------------------------------------------------
+| The pattern for a default generated double-precision NaN. The `high' and
+| `low' values hold the most- and least-significant bits, respectively.
+*----------------------------------------------------------------------------*)
+const
+ float64_default_nan_high = $7FFFFFFF;
+ float64_default_nan_low = $FFFFFFFF;
+
+(*----------------------------------------------------------------------------
+| Returns 1 if the double-precision floating-point value `a' is a NaN;
+| otherwise returns 0.
+*----------------------------------------------------------------------------*)
+
+function float64_is_nan(a: float64): flag;
+ begin
+ float64_is_nan := flag (
+ ( $FFE00000 <= bits32 ( a.high shl 1 ) )
+ and ( (a.low<>0) or (( a.high and $000FFFFF )<>0) ));
+ end;
+
+(*----------------------------------------------------------------------------
+| Returns 1 if the double-precision floating-point value `a' is a signaling
+| NaN; otherwise returns 0.
+*----------------------------------------------------------------------------*)
+function float64_is_signaling_nan( a:float64): flag;
+ begin
+ float64_is_signaling_nan := flag
+ ( ( ( a.high shr 19 ) and $FFF ) = $FFE )
+ and ( (a.low<>0) or ( boolean(( a.high and $0007FFFF )<>0)) );
+
+ end;
+
+(*----------------------------------------------------------------------------
+| Returns the result of converting the double-precision floating-point NaN
+| `a' to the canonical NaN format. If `a' is a signaling NaN, the invalid
+| exception is raised.
+*----------------------------------------------------------------------------*)
+Procedure float64ToCommonNaN( a : float64; VAR c:commonNaNT );
+ var
+ z : commonNaNT;
+ begin
+ if ( float64_is_signaling_nan( a )<>0 ) then
+ float_raise( float_flag_invalid );
+ z.sign := a.high shr 31;
+ shortShift64Left( a.high, a.low, 12, z.high, z.low );
+ c:=z;
+ end;
+
+(*----------------------------------------------------------------------------
+| Returns the result of converting the canonical NaN `a' to the double-
+| precision floating-point format.
+*----------------------------------------------------------------------------*)
+Procedure commonNaNToFloat64( a : commonNaNT; VAR c: float64 );
+ var
+ z: float64;
+ begin
+ shift64Right( a.high, a.low, 12, z.high, z.low );
+ z.high := z.high or ( ( bits32 (a.sign) ) shl 31 ) or $7FF80000;
+ c:=z;
+ end;
+
+(*----------------------------------------------------------------------------
+| Takes two double-precision floating-point values `a' and `b', one of which
+| is a NaN, and returns the appropriate NaN result. If either `a' or `b' is a
+| signaling NaN, the invalid exception is raised.
+*----------------------------------------------------------------------------*)
+Procedure propagateFloat64NaN( a: float64; b: float64 ; VAR c: float64 );
+var
+ aIsNaN, aIsSignalingNaN, bIsNaN, bIsSignalingNaN : flag;
+ begin
+ aIsNaN := float64_is_nan( a );
+ aIsSignalingNaN := float64_is_signaling_nan( a );
+ bIsNaN := float64_is_nan( b );
+ bIsSignalingNaN := float64_is_signaling_nan( b );
+ a.high := a.high or $00080000;
+ b.high := b.high or $00080000;
+ if ( (aIsSignalingNaN<>0) or (bIsSignalingNaN<>0) ) then
+ float_raise( float_flag_invalid );
+ if bIsSignalingNaN<>0 then
+ c := b
+ else if aIsSignalingNan<>0 then
+ c := a
+ else if bIsNan<>0 then
+ c := b
+ else
+ c := a;
+ end;
+
+{$ENDIF}
+
+(****************************************************************************)
+(* END ENDIAN SPECIFIC CODE *)
+(****************************************************************************)
+
+
+{*
+-------------------------------------------------------------------------------
+Returns the fraction bits of the single-precision floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function ExtractFloat32Frac(a : Float32) : Bits32;
+ Begin
+ ExtractFloat32Frac := A AND $007FFFFF;
+ End;
+
+
+{*
+-------------------------------------------------------------------------------
+Returns the exponent bits of the single-precision floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat32Exp( a: float32 ): Int16;
+ Begin
+ extractFloat32Exp := (a shr 23) AND $FF;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the sign bit of the single-precision floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat32Sign( a: float32 ): Flag;
+ Begin
+ extractFloat32Sign := a shr 31;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Normalizes the subnormal single-precision floating-point value represented
+by the denormalized significand `aSig'. The normalized exponent and
+significand are stored at the locations pointed to by `zExpPtr' and
+`zSigPtr', respectively.
+-------------------------------------------------------------------------------
+*}
+Procedure normalizeFloat32Subnormal( aSig : bits32; VAR zExpPtr: Int16; VAR zSigPtr :bits32);
+ Var
+ ShiftCount : BYTE;
+ Begin
+
+ shiftCount := countLeadingZeros32( aSig ) - 8;
+ zSigPtr := aSig shl shiftCount;
+ zExpPtr := 1 - shiftCount;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Packs the sign `zSign', exponent `zExp', and significand `zSig' into a
+single-precision floating-point value, returning the result. After being
+shifted into the proper positions, the three fields are simply added
+together to form the result. This means that any integer portion of `zSig'
+will be added into the exponent. Since a properly normalized significand
+will have an integer portion equal to 1, the `zExp' input should be 1 less
+than the desired result exponent whenever `zSig' is a complete, normalized
+significand.
+-------------------------------------------------------------------------------
+*}
+Function packFloat32( zSign: Flag; zExp : Int16; zSig: Bits32 ): Float32;
+ Begin
+
+ packFloat32 := ( ( bits32( zSign) ) shl 31 ) + ( ( bits32 (zExp) ) shl 23 )
+ + zSig;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Takes an abstract floating-point value having sign `zSign', exponent `zExp',
+and significand `zSig', and returns the proper single-precision floating-
+point value corresponding to the abstract input. Ordinarily, the abstract
+value is simply rounded and packed into the single-precision format, with
+the inexact exception raised if the abstract input cannot be represented
+exactly. However, if the abstract value is too large, the overflow and
+inexact exceptions are raised and an infinity or maximal finite value is
+returned. If the abstract value is too small, the input value is rounded to
+a subnormal number, and the underflow and inexact exceptions are raised if
+the abstract input cannot be represented exactly as a subnormal single-
+precision floating-point number.
+ The input significand `zSig' has its binary point between bits 30
+and 29, which is 7 bits to the left of the usual location. This shifted
+significand must be normalized or smaller. If `zSig' is not normalized,
+`zExp' must be 0; in that case, the result returned is a subnormal number,
+and it must not require rounding. In the usual case that `zSig' is
+normalized, `zExp' must be 1 less than the ``true'' floating-point exponent.
+The handling of underflow and overflow follows the IEC/IEEE Standard for
+Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function roundAndPackFloat32( zSign : Flag; zExp : Int16; zSig : Bits32 ) : float32;
+ Var
+ roundingMode : BYTE;
+ roundNearestEven : Flag;
+ roundIncrement, roundBits : BYTE;
+ IsTiny : Flag;
+ Begin
+ roundingMode := float_rounding_mode;
+ if (roundingMode = float_round_nearest_even) then
+ Begin
+ roundNearestEven := Flag(TRUE);
+ end
+ else
+ roundNearestEven := Flag(FALSE);
+ roundIncrement := $40;
+ if ( Boolean(roundNearestEven) = FALSE) then
+ Begin
+ if ( roundingMode = float_round_to_zero ) Then
+ Begin
+ roundIncrement := 0;
+ End
+ else
+ Begin
+ roundIncrement := $7F;
+ if ( zSign <> 0 ) then
+ Begin
+ if roundingMode = float_round_up then roundIncrement := 0;
+ End
+ else
+ Begin
+ if roundingMode = float_round_down then roundIncrement := 0;
+ End;
+ End
+ End;
+ roundBits := zSig AND $7F;
+ if ($FD <= bits16 (zExp) ) then
+ Begin
+ if (( $FD < zExp ) OR ( zExp = $FD ) AND ( sbits32 ( zSig + roundIncrement ) < 0 ) ) then
+ Begin
+ float_raise( float_flag_overflow OR float_flag_inexact );
+ roundAndPackFloat32:=packFloat32( zSign, $FF, 0 ) - Flag( roundIncrement = 0 );
+ exit;
+ End;
+ if ( zExp < 0 ) then
+ Begin
+ isTiny :=
+ flag(( float_detect_tininess = float_tininess_before_rounding )
+ OR ( zExp < -1 )
+ OR ( (zSig + roundIncrement) < $80000000 ));
+ shift32RightJamming( zSig, - zExp, zSig );
+ zExp := 0;
+ roundBits := zSig AND $7F;
+ if ( (isTiny = flag(TRUE)) and (roundBits<>0) ) then
+ float_raise( float_flag_underflow );
+ End;
+ End;
+ if ( roundBits )<> 0 then
+ float_exception_flags := float_flag_inexact OR float_exception_flags;
+ zSig := ( zSig + roundIncrement ) shr 7;
+ zSig := zSig AND not bits32( bits32( ( roundBits XOR $40 ) = 0 ) and roundNearestEven );
+ if ( zSig = 0 ) then zExp := 0;
+ roundAndPackFloat32 := packFloat32( zSign, zExp, zSig );
+ exit;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Takes an abstract floating-point value having sign `zSign', exponent `zExp',
+and significand `zSig', and returns the proper single-precision floating-
+point value corresponding to the abstract input. This routine is just like
+`roundAndPackFloat32' except that `zSig' does not have to be normalized.
+Bit 31 of `zSig' must be zero, and `zExp' must be 1 less than the ``true''
+floating-point exponent.
+-------------------------------------------------------------------------------
+*}
+Function normalizeRoundAndPackFloat32( zSign: flag; zExp: int16; zSig:bits32 ): float32;
+ Var
+ ShiftCount : int8;
+ Begin
+ shiftCount := countLeadingZeros32( zSig ) - 1;
+ normalizeRoundAndPackFloat32 := roundAndPackFloat32( zSign, zExp - shiftCount, zSig shl shiftCount );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the least-significant 32 fraction bits of the double-precision
+floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat64Frac( a: float64 ): bits32;
+ Begin
+ extractFloat64Frac := a.low;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the most-significant 20 fraction bits of the double-precision
+floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat64Frac0(a: float64): bits32;
+ Begin
+ extractFloat64Frac0 := a.high and $000FFFFF;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the least-significant 32 fraction bits of the double-precision
+floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat64Frac1(a: float64): bits32;
+ Begin
+ extractFloat64Frac1 := a.low;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the exponent bits of the double-precision floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat64Exp(a: float64): int16;
+ Begin
+ extractFloat64Exp:= ( a.high shr 20 ) AND $7FF;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the sign bit of the double-precision floating-point value `a'.
+-------------------------------------------------------------------------------
+*}
+Function extractFloat64Sign(a: float64) : flag;
+ Begin
+ extractFloat64Sign := a.high shr 31;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Normalizes the subnormal double-precision floating-point value represented
+by the denormalized significand formed by the concatenation of `aSig0' and
+`aSig1'. The normalized exponent is stored at the location pointed to by
+`zExpPtr'. The most significant 21 bits of the normalized significand are
+stored at the location pointed to by `zSig0Ptr', and the least significant
+32 bits of the normalized significand are stored at the location pointed to
+by `zSig1Ptr'.
+-------------------------------------------------------------------------------
+*}
+Procedure normalizeFloat64Subnormal(
+ aSig0: bits32;
+ aSig1: bits32;
+ VAR zExpPtr : Int16;
+ VAR zSig0Ptr : Bits32;
+ VAR zSig1Ptr : Bits32
+ );
+ Var
+ ShiftCount : Int8;
+ Begin
+ if ( aSig0 = 0 ) then
+ Begin
+ shiftCount := countLeadingZeros32( aSig1 ) - 11;
+ if ( shiftCount < 0 ) then
+ Begin
+ zSig0Ptr := aSig1 shr ( - shiftCount );
+ zSig1Ptr := aSig1 shl ( shiftCount AND 31 );
+ End
+ else
+ Begin
+ zSig0Ptr := aSig1 shl shiftCount;
+ zSig1Ptr := 0;
+ End;
+ zExpPtr := - shiftCount - 31;
+ End
+ else
+ Begin
+ shiftCount := countLeadingZeros32( aSig0 ) - 11;
+ shortShift64Left( aSig0, aSig1, shiftCount, zSig0Ptr, zSig1Ptr );
+ zExpPtr := 1 - shiftCount;
+ End;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Packs the sign `zSign', the exponent `zExp', and the significand formed by
+the concatenation of `zSig0' and `zSig1' into a double-precision floating-
+point value, returning the result. After being shifted into the proper
+positions, the three fields `zSign', `zExp', and `zSig0' are simply added
+together to form the most significant 32 bits of the result. This means
+that any integer portion of `zSig0' will be added into the exponent. Since
+a properly normalized significand will have an integer portion equal to 1,
+the `zExp' input should be 1 less than the desired result exponent whenever
+`zSig0' and `zSig1' concatenated form a complete, normalized significand.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ packFloat64( zSign: Flag; zExp: Int16; zSig0: Bits32; zSig1 : Bits32; VAR c : float64);
+ var
+ z: Float64;
+ Begin
+
+ z.low := zSig1;
+ z.high := ( ( bits32 (zSign) ) shl 31 ) + ( ( bits32 (zExp) ) shl 20 ) + zSig0;
+ c := z;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Takes an abstract floating-point value having sign `zSign', exponent `zExp',
+and extended significand formed by the concatenation of `zSig0', `zSig1',
+and `zSig2', and returns the proper double-precision floating-point value
+corresponding to the abstract input. Ordinarily, the abstract value is
+simply rounded and packed into the double-precision format, with the inexact
+exception raised if the abstract input cannot be represented exactly.
+However, if the abstract value is too large, the overflow and inexact
+exceptions are raised and an infinity or maximal finite value is returned.
+If the abstract value is too small, the input value is rounded to a
+subnormal number, and the underflow and inexact exceptions are raised if the
+abstract input cannot be represented exactly as a subnormal double-precision
+floating-point number.
+ The input significand must be normalized or smaller. If the input
+significand is not normalized, `zExp' must be 0; in that case, the result
+returned is a subnormal number, and it must not require rounding. In the
+usual case that the input significand is normalized, `zExp' must be 1 less
+than the ``true'' floating-point exponent. The handling of underflow and
+overflow follows the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ roundAndPackFloat64(
+ zSign: Flag; zExp: Int16; zSig0: Bits32; zSig1: Bits32; zSig2: Bits32; Var c: Float64 );
+ Var
+ roundingMode : Int8;
+ roundNearestEven, increment, isTiny : Flag;
+ Begin
+
+ roundingMode := float_rounding_mode;
+ roundNearestEven := flag( roundingMode = float_round_nearest_even );
+ increment := flag( sbits32 (zSig2) < 0 );
+ if ( roundNearestEven = flag(FALSE) ) then
+ Begin
+ if ( roundingMode = float_round_to_zero ) then
+ increment := 0
+ else
+ Begin
+ if ( zSign )<> 0 then
+ Begin
+ increment := flag( roundingMode = float_round_down ) and zSig2;
+ End
+ else
+ Begin
+ increment := flag( roundingMode = float_round_up ) and zSig2;
+ End
+ End
+ End;
+ if ( $7FD <= bits16 (zExp) ) then
+ Begin
+ if (( $7FD < zExp )
+ or (( zExp = $7FD )
+ and (eq64( $001FFFFF, $FFFFFFFF, zSig0, zSig1 )<>0)
+ and (increment<>0)
+ )
+ ) then
+ Begin
+ float_raise( float_flag_overflow OR float_flag_inexact );
+ if (( roundingMode = float_round_to_zero )
+ or ( (zSign<>0) and ( roundingMode = float_round_up ) )
+ or ( (zSign = 0) and ( roundingMode = float_round_down ) )
+ ) then
+ Begin
+ packFloat64( zSign, $7FE, $000FFFFF, $FFFFFFFF, c );
+ exit;
+ End;
+ packFloat64( zSign, $7FF, 0, 0, c );
+ exit;
+ End;
+ if ( zExp < 0 ) then
+ Begin
+ isTiny :=
+ flag( float_detect_tininess = float_tininess_before_rounding )
+ or flag( zExp < -1 )
+ or flag(increment = 0)
+ or flag(lt64( zSig0, zSig1, $001FFFFF, $FFFFFFFF)<>0);
+ shift64ExtraRightJamming(
+ zSig0, zSig1, zSig2, - zExp, zSig0, zSig1, zSig2 );
+ zExp := 0;
+ if ( isTiny<>0) and (zSig2<>0 ) then float_raise( float_flag_underflow );
+ if ( roundNearestEven )<>0 then
+ Begin
+ increment := flag( sbits32 (zSig2) < 0 );
+ End
+ else
+ Begin
+ if ( zSign )<>0 then
+ Begin
+ increment := flag( roundingMode = float_round_down ) and zSig2;
+ End
+ else
+ Begin
+ increment := flag( roundingMode = float_round_up ) and zSig2;
+ End
+ End;
+ End;
+ End;
+ if ( zSig2 )<>0 then
+ float_exception_flags := float_exception_flags OR float_flag_inexact;
+ if ( increment )<>0 then
+ Begin
+ add64( zSig0, zSig1, 0, 1, zSig0, zSig1 );
+ zSig1 := zSig1 and not ( bits32(flag( zSig2 + zSig2 = 0 )) and roundNearestEven );
+ End
+ else
+ Begin
+ if ( ( zSig0 or zSig1 ) = 0 ) then zExp := 0;
+ End;
+ packFloat64( zSign, zExp, zSig0, zSig1, c );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Takes an abstract floating-point value having sign `zSign', exponent `zExp',
+and significand formed by the concatenation of `zSig0' and `zSig1', and
+returns the proper double-precision floating-point value corresponding
+to the abstract input. This routine is just like `roundAndPackFloat64'
+except that the input significand has fewer bits and does not have to be
+normalized. In all cases, `zExp' must be 1 less than the ``true'' floating-
+point exponent.
+-------------------------------------------------------------------------------
+*}
+Procedure
+ normalizeRoundAndPackFloat64(
+ zSign:flag; zExp:int16; zSig0:bits32; zSig1:bits32; VAR c: float64 );
+ Var
+ shiftCount : int8;
+ zSig2 : bits32;
+ Begin
+
+ if ( zSig0 = 0 ) then
+ Begin
+ zSig0 := zSig1;
+ zSig1 := 0;
+ zExp := zExp -32;
+ End;
+ shiftCount := countLeadingZeros32( zSig0 ) - 11;
+ if ( 0 <= shiftCount ) then
+ Begin
+ zSig2 := 0;
+ shortShift64Left( zSig0, zSig1, shiftCount, zSig0, zSig1 );
+ End
+ else
+ Begin
+ shift64ExtraRightJamming
+ (zSig0, zSig1, 0, - shiftCount, zSig0, zSig1, zSig2 );
+ End;
+ zExp := zExp - shiftCount;
+ roundAndPackFloat64( zSign, zExp, zSig0, zSig1, zSig2, c );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the 32-bit two's complement integer `a' to
+the single-precision floating-point format. The conversion is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function int32_to_float32( a: int32): float32; {$ifdef fpc}[public,Alias:'INT32_TO_FLOAT32'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ zSign : Flag;
+ Begin
+
+ if ( a = 0 ) then
+ Begin
+ int32_to_float32 := 0;
+ exit;
+ End;
+ if ( a = sbits32 ($80000000) ) then
+ Begin
+ int32_to_float32 := packFloat32( 1, $9E, 0 );
+ exit;
+ end;
+ zSign := flag( a < 0 );
+ If zSign<>0 then
+ a := -a;
+ int32_to_float32:=
+ normalizeRoundAndPackFloat32( zSign, $9C, a );
+ End;
+
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the 32-bit two's complement integer `a' to
+the double-precision floating-point format. The conversion is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure int32_to_float64( a: int32; var c: float64 );{$ifdef fpc} [public,Alias:'INT32_TO_FLOAT64'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ var
+ zSign : flag;
+ absA : bits32;
+ shiftCount : int8;
+ zSig0, zSig1 : bits32;
+ Begin
+
+ if ( a = 0 ) then
+ Begin
+ packFloat64( 0, 0, 0, 0, c );
+ exit;
+ end;
+ zSign := flag( a < 0 );
+ if ZSign<>0 then
+ AbsA := -a
+ else
+ AbsA := a;
+ shiftCount := countLeadingZeros32( absA ) - 11;
+ if ( 0 <= shiftCount ) then
+ Begin
+ zSig0 := absA shl shiftCount;
+ zSig1 := 0;
+ End
+ else
+ Begin
+ shift64Right( absA, 0, - shiftCount, zSig0, zSig1 );
+ End;
+ packFloat64( zSign, $412 - shiftCount, zSig0, zSig1,c );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic---which means in particular that the conversion is rounded
+according to the current rounding mode. If `a' is a NaN, the largest
+positive integer is returned. Otherwise, if the conversion overflows, the
+largest integer with the same sign as `a' is returned.
+-------------------------------------------------------------------------------
+*}
+Function float32_to_int32( a : float32) : int32;{$ifdef fpc} [public,Alias:'FLOAT32_TO_INT32'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign: flag;
+ aExp, shiftCount: int16;
+ aSig, aSigExtra: bits32;
+ z: int32;
+ roundingMode: int8;
+ Begin
+
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ shiftCount := aExp - $96;
+ if ( 0 <= shiftCount ) then
+ Begin
+ if ( $9E <= aExp ) then
+ Begin
+ if ( a <> $CF000000 ) then
+ Begin
+ float_raise( float_flag_invalid );
+ if ( (aSign=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then
+ Begin
+ float32_to_int32 := $7FFFFFFF;
+ exit;
+ End;
+ End;
+ float32_to_int32 := sbits32 ($80000000);
+ exit;
+ End;
+ z := ( aSig or $00800000 ) shl shiftCount;
+ if ( aSign<>0 ) then z := - z;
+ End
+ else
+ Begin
+ if ( aExp < $7E ) then
+ Begin
+ aSigExtra := aExp OR aSig;
+ z := 0;
+ End
+ else
+ Begin
+ aSig := aSig OR $00800000;
+ aSigExtra := aSig shl ( shiftCount and 31 );
+ z := aSig shr ( - shiftCount );
+ End;
+ if ( aSigExtra<>0 ) then
+ float_exception_flags := float_exception_flags
+ or float_flag_inexact;
+ roundingMode := float_rounding_mode;
+ if ( roundingMode = float_round_nearest_even ) then
+ Begin
+ if ( sbits32 (aSigExtra) < 0 ) then
+ Begin
+ Inc(z);
+ if ( bits32 ( aSigExtra shl 1 ) = 0 ) then
+ z := z and not 1;
+ End;
+ if ( aSign<>0 ) then
+ z := - z;
+ End
+ else
+ Begin
+ aSigExtra := flag( aSigExtra <> 0 );
+ if ( aSign<>0 ) then
+ Begin
+ z := z + (flag( roundingMode = float_round_down ) and aSigExtra);
+ z := - z;
+ End
+ else
+ Begin
+ z := z + (flag( roundingMode = float_round_up ) and aSigExtra);
+ End
+ End;
+ End;
+ float32_to_int32 := z;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic, except that the conversion is always rounded toward zero.
+If `a' is a NaN, the largest positive integer is returned. Otherwise, if
+the conversion overflows, the largest integer with the same sign as `a' is
+returned.
+-------------------------------------------------------------------------------
+*}
+Function float32_to_int32_round_to_zero( a: Float32 ): int32;
+ {$ifdef fpc}[public,Alias:'FLOAT32_TO_INT32_ROUND_TO_ZERO'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign : flag;
+ aExp, shiftCount : int16;
+ aSig : bits32;
+ z : int32;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ shiftCount := aExp - $9E;
+ if ( 0 <= shiftCount ) then
+ Begin
+ if ( a <> $CF000000 ) then
+ Begin
+ float_raise( float_flag_invalid );
+ if ( (aSign=0) or ( ( aExp = $FF ) and (aSig<>0) ) ) then
+ Begin
+ float32_to_int32_round_to_zero := $7FFFFFFF;
+ exit;
+ end;
+ End;
+ float32_to_int32_round_to_zero:= sbits32 ($80000000);
+ exit;
+ End
+ else
+ if ( aExp <= $7E ) then
+ Begin
+ if ( aExp or aSig )<>0 then
+ float_exception_flags :=
+ float_exception_flags or float_flag_inexact;
+ float32_to_int32_round_to_zero := 0;
+ exit;
+ End;
+ aSig := ( aSig or $00800000 ) shl 8;
+ z := aSig shr ( - shiftCount );
+ if ( bits32 ( aSig shl ( shiftCount and 31 ) )<> 0 ) then
+ Begin
+ float_exception_flags :=
+ float_exception_flags or float_flag_inexact;
+ End;
+ if ( aSign<>0 ) then z := - z;
+ float32_to_int32_round_to_zero := z;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the single-precision floating-point value
+`a' to the double-precision floating-point format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float32_to_float64( a : float32; var out: Float64);
+{$ifdef fpc}[public,Alias:'FLOAT32_TO_FLOAT64'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign : flag;
+ aExp : int16;
+ aSig, zSig0, zSig1: bits32;
+ tmp : CommonNanT;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig<>0 ) then
+ Begin
+ float32ToCommonNaN(a, tmp);
+ commonNaNToFloat64(tmp , out);
+ exit;
+ End;
+ packFloat64( aSign, $7FF, 0, 0, out );
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( aSig = 0 ) then
+ Begin
+ packFloat64( aSign, 0, 0, 0, out );
+ exit;
+ end;
+ normalizeFloat32Subnormal( aSig, aExp, aSig );
+ Dec(aExp);
+ End;
+ shift64Right( aSig, 0, 3, zSig0, zSig1 );
+ packFloat64( aSign, aExp + $380, zSig0, zSig1, out );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Rounds the single-precision floating-point value `a' to an integer,
+and returns the result as a single-precision floating-point value. The
+operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_round_to_int( a: float32): float32;
+{$ifdef fpc}[public,Alias:'FLOAT32_ROUND_TO_INT'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign: flag;
+ aExp: int16;
+ lastBitMask, roundBitsMask: bits32;
+ roundingMode: int8;
+ z: float32;
+ Begin
+ aExp := extractFloat32Exp( a );
+ if ( $96 <= aExp ) then
+ Begin
+ if ( ( aExp = $FF ) and (extractFloat32Frac( a )<>0) ) then
+ Begin
+ float32_round_to_int:= propagateFloat32NaN( a, a );
+ exit;
+ End;
+ float32_round_to_int:=a;
+ exit;
+ End;
+ if ( aExp <= $7E ) then
+ Begin
+ if ( bits32 ( a shl 1 ) = 0 ) then
+ Begin
+ float32_round_to_int:=a;
+ exit;
+ end;
+ float_exception_flags
+ := float_exception_flags OR float_flag_inexact;
+ aSign := extractFloat32Sign( a );
+
+ case ( float_rounding_mode ) of
+ float_round_nearest_even:
+ Begin
+ if ( ( aExp = $7E ) and (extractFloat32Frac( a )<>0) ) then
+ Begin
+ float32_round_to_int := packFloat32( aSign, $7F, 0 );
+ exit;
+ End;
+ End;
+ float_round_down:
+ Begin
+ if aSign <> 0 then
+ float32_round_to_int := $BF800000
+ else
+ float32_round_to_int := 0;
+ exit;
+ End;
+ float_round_up:
+ Begin
+ if aSign <> 0 then
+ float32_round_to_int := $80000000
+ else
+ float32_round_to_int := $3F800000;
+ exit;
+ End;
+ end;
+ float32_round_to_int := packFloat32( aSign, 0, 0 );
+ End;
+ lastBitMask := 1;
+ {_____________________________!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
+ lastBitMask := lastBitMask shl ($96 - aExp);
+ roundBitsMask := lastBitMask - 1;
+ z := a;
+ roundingMode := float_rounding_mode;
+ if ( roundingMode = float_round_nearest_even ) then
+ Begin
+ z := z + (lastBitMask shr 1);
+ if ( ( z and roundBitsMask ) = 0 ) then
+ z := z and not lastBitMask;
+ End
+ else if ( roundingMode <> float_round_to_zero ) then
+ Begin
+ if ( (extractFloat32Sign( z ) xor flag(roundingMode = float_round_up ))<>0 ) then
+ Begin
+ z := z + roundBitsMask;
+ End;
+ End;
+ z := z and not roundBitsMask;
+ if ( z <> a ) then
+ float_exception_flags := float_exception_flags or float_flag_inexact;
+ float32_round_to_int := z;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of adding the absolute values of the single-precision
+floating-point values `a' and `b'. If `zSign' is 1, the sum is negated
+before being returned. `zSign' is ignored if the result is a NaN.
+The addition is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function addFloat32Sigs( a:float32; b: float32; zSign:flag ): float32;
+ Var
+ aExp, bExp, zExp: int16;
+ aSig, bSig, zSig: bits32;
+ expDiff: int16;
+ label roundAndPack;
+ Begin
+ aSig:=extractFloat32Frac( a );
+ aExp:=extractFloat32Exp( a );
+ bSig:=extractFloat32Frac( b );
+ bExp := extractFloat32Exp( b );
+ expDiff := aExp - bExp;
+ aSig := aSig shl 6;
+ bSig := bSig shl 6;
+ if ( 0 < expDiff ) then
+ Begin
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig <> 0) then
+ Begin
+ addFloat32Sigs := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ addFloat32Sigs := a;
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ Dec(expDiff);
+ End
+ else
+ Begin
+ bSig := bSig or $20000000;
+ End;
+ shift32RightJamming( bSig, expDiff, bSig );
+ zExp := aExp;
+ End
+ else
+ If ( expDiff < 0 ) then
+ Begin
+ if ( bExp = $FF ) then
+ Begin
+ if ( bSig<>0 ) then
+ Begin
+ addFloat32Sigs := propagateFloat32NaN( a, b );
+ exit;
+ end;
+
+ addFloat32Sigs := packFloat32( zSign, $FF, 0 );
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ Inc(expDiff);
+ End
+ else
+ Begin
+ aSig := aSig OR $20000000;
+ End;
+ shift32RightJamming( aSig, - expDiff, aSig );
+ zExp := bExp;
+ End
+ else
+ Begin
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig OR bSig )<> 0 then
+ Begin
+ addFloat32Sigs := propagateFloat32NaN( a, b );
+ exit;
+ end;
+ addFloat32Sigs := a;
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ addFloat32Sigs := packFloat32( zSign, 0, ( aSig + bSig ) shr 6 );
+ exit;
+ end;
+ zSig := $40000000 + aSig + bSig;
+ zExp := aExp;
+ goto roundAndPack;
+ End;
+ aSig := aSig OR $20000000;
+ zSig := ( aSig + bSig ) shl 1;
+ Dec(zExp);
+ if ( sbits32 (zSig) < 0 ) then
+ Begin
+ zSig := aSig + bSig;
+ Inc(zExp);
+ End;
+ roundAndPack:
+ addFloat32Sigs := roundAndPackFloat32( zSign, zExp, zSig );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of subtracting the absolute values of the single-
+precision floating-point values `a' and `b'. If `zSign' is 1, the
+difference is negated before being returned. `zSign' is ignored if the
+result is a NaN. The subtraction is performed according to the IEC/IEEE
+Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function subFloat32Sigs( a:float32; b:float32; zSign:flag ): float32;
+ Var
+ aExp, bExp, zExp: int16;
+ aSig, bSig, zSig: bits32;
+ expDiff : int16;
+ label aExpBigger;
+ label bExpBigger;
+ label aBigger;
+ label bBigger;
+ label normalizeRoundAndPack;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ bSig := extractFloat32Frac( b );
+ bExp := extractFloat32Exp( b );
+ expDiff := aExp - bExp;
+ aSig := aSig shl 7;
+ bSig := bSig shl 7;
+ if ( 0 < expDiff ) then goto aExpBigger;
+ if ( expDiff < 0 ) then goto bExpBigger;
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig OR bSig )<> 0 then
+ Begin
+ subFloat32Sigs := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ float_raise( float_flag_invalid );
+ subFloat32Sigs := float32_default_nan;
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ aExp := 1;
+ bExp := 1;
+ End;
+ if ( bSig < aSig ) Then goto aBigger;
+ if ( aSig < bSig ) Then goto bBigger;
+ subFloat32Sigs := packFloat32( flag(float_rounding_mode = float_round_down), 0, 0 );
+ exit;
+ bExpBigger:
+ if ( bExp = $FF ) then
+ Begin
+ if ( bSig<>0 ) then
+ Begin
+ subFloat32Sigs := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ subFloat32Sigs := packFloat32( zSign XOR 1, $FF, 0 );
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ Inc(expDiff);
+ End
+ else
+ Begin
+ aSig := aSig OR $40000000;
+ End;
+ shift32RightJamming( aSig, - expDiff, aSig );
+ bSig := bSig OR $40000000;
+ bBigger:
+ zSig := bSig - aSig;
+ zExp := bExp;
+ zSign := zSign xor 1;
+ goto normalizeRoundAndPack;
+ aExpBigger:
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig <> 0) then
+ Begin
+ subFloat32Sigs := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ subFloat32Sigs := a;
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ Dec(expDiff);
+ End
+ else
+ Begin
+ bSig := bSig OR $40000000;
+ End;
+ shift32RightJamming( bSig, expDiff, bSig );
+ aSig := aSig OR $40000000;
+ aBigger:
+ zSig := aSig - bSig;
+ zExp := aExp;
+ normalizeRoundAndPack:
+ Dec(zExp);
+ subFloat32Sigs := normalizeRoundAndPackFloat32( zSign, zExp, zSig );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of adding the single-precision floating-point values `a'
+and `b'. The operation is performed according to the IEC/IEEE Standard for
+Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_add( a: float32; b:float32 ): float32;{$ifdef fpc} [public,Alias:'FLOAT32_ADD'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign, bSign: Flag;
+ Begin
+ aSign := extractFloat32Sign( a );
+ bSign := extractFloat32Sign( b );
+ if ( aSign = bSign ) then
+ Begin
+ float32_add := addFloat32Sigs( a, b, aSign );
+ End
+ else
+ Begin
+ float32_add := subFloat32Sigs( a, b, aSign );
+ End;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of subtracting the single-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_sub( a: float32 ; b:float32 ): float32;{$ifdef fpc} [public,Alias:'FLOAT32_SUB'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign, bSign: flag;
+ Begin
+ aSign := extractFloat32Sign( a );
+ bSign := extractFloat32Sign( b );
+ if ( aSign = bSign ) then
+ Begin
+ float32_sub := subFloat32Sigs( a, b, aSign );
+ End
+ else
+ Begin
+ float32_sub := addFloat32Sigs( a, b, aSign );
+ End;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of multiplying the single-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_mul(a: float32; b: float32 ) : float32;{$ifdef fpc} [public,Alias:'FLOAT32_MUL'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+
+ Var
+ aSign, bSign, zSign: flag;
+ aExp, bExp, zExp : int16;
+ aSig, bSig, zSig0, zSig1: bits32;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ bSig := extractFloat32Frac( b );
+ bExp := extractFloat32Exp( b );
+ bSign := extractFloat32Sign( b );
+ zSign := aSign xor bSign;
+ if ( aExp = $FF ) then
+ Begin
+ if ( (aSig<>0) OR ( ( bExp = $FF ) AND (bSig<>0) ) ) then
+ Begin
+ float32_mul := propagateFloat32NaN( a, b );
+ End;
+ if ( ( bExp OR bSig ) = 0 ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_mul := float32_default_nan;
+ exit;
+ End;
+ float32_mul := packFloat32( zSign, $FF, 0 );
+ exit;
+ End;
+ if ( bExp = $FF ) then
+ Begin
+ if ( bSig <> 0 ) then
+ Begin
+ float32_mul := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ if ( ( aExp OR aSig ) = 0 ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_mul := float32_default_nan;
+ exit;
+ End;
+ float32_mul := packFloat32( zSign, $FF, 0 );
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( aSig = 0 ) then
+ Begin
+ float32_mul := packFloat32( zSign, 0, 0 );
+ exit;
+ End;
+ normalizeFloat32Subnormal( aSig, aExp, aSig );
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ if ( bSig = 0 ) then
+ Begin
+ float32_mul := packFloat32( zSign, 0, 0 );
+ exit;
+ End;
+ normalizeFloat32Subnormal( bSig, bExp, bSig );
+ End;
+ zExp := aExp + bExp - $7F;
+ aSig := ( aSig OR $00800000 ) shl 7;
+ bSig := ( bSig OR $00800000 ) shl 8;
+ mul32To64( aSig, bSig, zSig0, zSig1 );
+ zSig0 := zSig0 OR bits32( zSig1 <> 0 );
+ if ( 0 <= sbits32 ( zSig0 shl 1 ) ) then
+ Begin
+ zSig0 := zSig0 shl 1;
+ Dec(zExp);
+ End;
+ float32_mul := roundAndPackFloat32( zSign, zExp, zSig0 );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of dividing the single-precision floating-point value `a'
+by the corresponding value `b'. The operation is performed according to the
+IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_div(a: float32;b: float32 ): float32;{$ifdef fpc} [public,Alias:'FLOAT32_DIV'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign, bSign, zSign: flag;
+ aExp, bExp, zExp: int16;
+ aSig, bSig, zSig, rem0, rem1, term0, term1: bits32;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ bSig := extractFloat32Frac( b );
+ bExp := extractFloat32Exp( b );
+ bSign := extractFloat32Sign( b );
+ zSign := aSign xor bSign;
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig <> 0 ) then
+ Begin
+ float32_div := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ if ( bExp = $FF ) then
+ Begin
+ if ( bSig <> 0) then
+ Begin
+ float32_div := propagateFloat32NaN( a, b );
+ End;
+ float_raise( float_flag_invalid );
+ float32_div := float32_default_nan;
+ exit;
+ End;
+ float32_div := packFloat32( zSign, $FF, 0 );
+ exit;
+ End;
+ if ( bExp = $FF ) then
+ Begin
+ if ( bSig <> 0) then
+ Begin
+ float32_div := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ float32_div := packFloat32( zSign, 0, 0 );
+ exit;
+ End;
+ if ( bExp = 0 ) Then
+ Begin
+ if ( bSig = 0 ) Then
+ Begin
+ if ( ( aExp OR aSig ) = 0 ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_div := float32_default_nan;
+ exit;
+ End;
+ float_raise( float_flag_divbyzero );
+ float32_div := packFloat32( zSign, $FF, 0 );
+ exit;
+ End;
+ normalizeFloat32Subnormal( bSig, bExp, bSig );
+ End;
+ if ( aExp = 0 ) Then
+ Begin
+ if ( aSig = 0 ) Then
+ Begin
+ float32_div := packFloat32( zSign, 0, 0 );
+ exit;
+ End;
+ normalizeFloat32Subnormal( aSig, aExp, aSig );
+ End;
+ zExp := aExp - bExp + $7D;
+ aSig := ( aSig OR $00800000 ) shl 7;
+ bSig := ( bSig OR $00800000 ) shl 8;
+ if ( bSig <= ( aSig + aSig ) ) then
+ Begin
+ aSig := aSig shr 1;
+ Inc(zExp);
+ End;
+ zSig := estimateDiv64To32( aSig, 0, bSig );
+ if ( ( zSig and $3F ) <= 2 ) then
+ Begin
+ mul32To64( bSig, zSig, term0, term1 );
+ sub64( aSig, 0, term0, term1, rem0, rem1 );
+ while ( sbits32 (rem0) < 0 ) do
+ Begin
+ Dec(zSig);
+ add64( rem0, rem1, 0, bSig, rem0, rem1 );
+ End;
+ zSig := zSig or bits32( rem1 <> 0 );
+ End;
+ float32_div := roundAndPackFloat32( zSign, zExp, zSig );
+
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the remainder of the single-precision floating-point value `a'
+with respect to the corresponding value `b'. The operation is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_rem(a: float32; b: float32 ):float32;{$ifdef fpc} [public,Alias:'FLOAT32_REM'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+ Var
+ aSign, bSign, zSign: flag;
+ aExp, bExp, expDiff: int16;
+ aSig, bSig, q, allZero, alternateASig: bits32;
+ sigMean: sbits32;
+ Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ bSig := extractFloat32Frac( b );
+ bExp := extractFloat32Exp( b );
+ bSign := extractFloat32Sign( b );
+ if ( aExp = $FF ) then
+ Begin
+ if ( (aSig<>0) OR ( ( bExp = $FF ) AND (bSig <>0)) ) then
+ Begin
+ float32_rem := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ float_raise( float_flag_invalid );
+ float32_rem := float32_default_nan;
+ exit;
+ End;
+ if ( bExp = $FF ) then
+ Begin
+ if ( bSig <> 0 ) then
+ Begin
+ float32_rem := propagateFloat32NaN( a, b );
+ exit;
+ End;
+ float32_rem := a;
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ if ( bSig = 0 ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_rem := float32_default_nan;
+ exit;
+ End;
+ normalizeFloat32Subnormal( bSig, bExp, bSig );
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( aSig = 0 ) then
+ Begin
+ float32_rem := a;
+ exit;
+ End;
+ normalizeFloat32Subnormal( aSig, aExp, aSig );
+ End;
+ expDiff := aExp - bExp;
+ aSig := ( aSig OR $00800000 ) shl 8;
+ bSig := ( bSig OR $00800000 ) shl 8;
+ if ( expDiff < 0 ) then
+ Begin
+ if ( expDiff < -1 ) then
+ Begin
+ float32_rem := a;
+ exit;
+ End;
+ aSig := aSig shr 1;
+ End;
+ q := bits32( bSig <= aSig );
+ if ( q <> 0) then
+ aSig := aSig - bSig;
+ expDiff := expDiff - 32;
+ while ( 0 < expDiff ) do
+ Begin
+ q := estimateDiv64To32( aSig, 0, bSig );
+ if (2 < q) then
+ q := q - 2
+ else
+ q := 0;
+ aSig := - ( ( bSig shr 2 ) * q );
+ expDiff := expDiff - 30;
+ End;
+ expDiff := expDiff + 32;
+ if ( 0 < expDiff ) then
+ Begin
+ q := estimateDiv64To32( aSig, 0, bSig );
+ if (2 < q) then
+ q := q - 2
+ else
+ q := 0;
+ q := q shr (32 - expDiff);
+ bSig := bSig shr 2;
+ aSig := ( ( aSig shr 1 ) shl ( expDiff - 1 ) ) - bSig * q;
+ End
+ else
+ Begin
+ aSig := aSig shr 2;
+ bSig := bSig shr 2;
+ End;
+ Repeat
+ alternateASig := aSig;
+ Inc(q);
+ aSig := aSig - bSig;
+ Until not ( 0 <= sbits32 (aSig) );
+ sigMean := aSig + alternateASig;
+ if ( ( sigMean < 0 ) OR ( ( sigMean = 0 ) AND (( q and 1 )<>0) ) ) then
+ Begin
+ aSig := alternateASig;
+ End;
+ zSign := flag( sbits32 (aSig) < 0 );
+ if ( zSign<>0 ) then
+ aSig := - aSig;
+ float32_rem := normalizeRoundAndPackFloat32( aSign xor zSign, bExp, aSig );
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the square root of the single-precision floating-point value `a'.
+The operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_sqrt(a: float32 ): float32;{$ifdef fpc} [public,Alias:'FLOAT32_SQRT'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign : flag;
+ aExp, zExp : int16;
+ aSig, zSig, rem0, rem1, term0, term1: bits32;
+ label roundAndPack;
+Begin
+ aSig := extractFloat32Frac( a );
+ aExp := extractFloat32Exp( a );
+ aSign := extractFloat32Sign( a );
+ if ( aExp = $FF ) then
+ Begin
+ if ( aSig <> 0) then
+ Begin
+ float32_sqrt := propagateFloat32NaN( a, 0 );
+ exit;
+ End;
+ if ( aSign = 0) then
+ Begin
+ float32_sqrt := a;
+ exit;
+ End;
+ float_raise( float_flag_invalid );
+ float32_sqrt := float32_default_nan;
+ exit;
+ End;
+ if ( aSign <> 0) then
+ Begin
+ if ( ( aExp OR aSig ) = 0 ) then
+ Begin
+ float32_sqrt := a;
+ exit;
+ End;
+ float_raise( float_flag_invalid );
+ float32_sqrt := float32_default_nan;
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( aSig = 0 ) then
+ Begin
+ float32_sqrt := 0;
+ exit;
+ End;
+ normalizeFloat32Subnormal( aSig, aExp, aSig );
+ End;
+ zExp := ( ( aExp - $7F ) shr 1 ) + $7E;
+ aSig := ( aSig OR $00800000 ) shl 8;
+ zSig := estimateSqrt32( aExp, aSig ) + 2;
+ if ( ( zSig and $7F ) <= 5 ) then
+ Begin
+ if ( zSig < 2 ) then
+ Begin
+ zSig := $7FFFFFFF;
+ goto roundAndPack;
+ End
+ else
+ Begin
+ aSig := aSig shr (aExp and 1);
+ mul32To64( zSig, zSig, term0, term1 );
+ sub64( aSig, 0, term0, term1, rem0, rem1 );
+ while ( sbits32 (rem0) < 0 ) do
+ Begin
+ Dec(zSig);
+ shortShift64Left( 0, zSig, 1, term0, term1 );
+ term1 := term1 or 1;
+ add64( rem0, rem1, term0, term1, rem0, rem1 );
+ End;
+ zSig := zSig OR bits32( ( rem0 OR rem1 ) <> 0 );
+ End;
+ End;
+ shift32RightJamming( zSig, 1, zSig );
+ roundAndPack:
+ float32_sqrt := roundAndPackFloat32( 0, zExp, zSig );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is equal to
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_eq( a:float32; b:float32): flag;{$ifdef fpc} [public,Alias:'FLOAT32_EQ'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Begin
+ if ((( extractFloat32Exp( a ) = $FF ) AND (extractFloat32Frac( a )<>0))
+ OR ( ( extractFloat32Exp( b ) = $FF ) AND (extractFloat32Frac( b )<>0) )
+ ) then
+ Begin
+ if ( (float32_is_signaling_nan( a )<>0) OR (float32_is_signaling_nan( b )<>0) ) then
+ Begin
+ float_raise( float_flag_invalid );
+ End;
+ float32_eq := 0;
+ exit;
+ End;
+ float32_eq := flag( a = b ) OR flag( bits32 ( ( a OR b ) shl 1 ) = 0 );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is less than
+or equal to the corresponding value `b', and 0 otherwise. The comparison
+is performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_le( a: float32; b : float32 ):flag;{$ifdef fpc} [public,Alias:'FLOAT32_LE'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+var
+ aSign, bSign: flag;
+Begin
+
+ if ( ( ( extractFloat32Exp( a ) = $FF ) AND (extractFloat32Frac( a )<>0) )
+ OR ( ( extractFloat32Exp( b ) = $FF ) AND (extractFloat32Frac( b )<>0) )
+ ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_le := 0;
+ exit;
+ End;
+ aSign := extractFloat32Sign( a );
+ bSign := extractFloat32Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float32_le := aSign OR flag( bits32 ( ( a OR b ) shl 1 ) = 0 );
+ exit;
+ End;
+ float32_le := flag(flag( a = b ) OR flag( aSign xor flag( a < b ) ));
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is less than
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_lt( a:float32 ; b : float32): flag;{$ifdef fpc} [public,Alias:'FLOAT32_LT'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+var
+ aSign, bSign: flag;
+Begin
+
+ if ( ( ( extractFloat32Exp( a ) = $FF ) AND (extractFloat32Frac( a ) <>0))
+ OR ( ( extractFloat32Exp( b ) = $FF ) AND (extractFloat32Frac( b ) <>0) )
+ ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_lt :=0;
+ exit;
+ End;
+ aSign := extractFloat32Sign( a );
+ bSign := extractFloat32Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float32_lt := aSign AND flag( bits32 ( ( a OR b ) shl 1 ) <> 0 );
+ exit;
+ End;
+ float32_lt := flag(flag( a <> b ) AND flag( aSign xor flag( a < b ) ));
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is equal to
+the corresponding value `b', and 0 otherwise. The invalid exception is
+raised if either operand is a NaN. Otherwise, the comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_eq_signaling( a: float32; b: float32) : flag;
+Begin
+
+ if ( ( ( extractFloat32Exp( a ) = $FF ) AND (extractFloat32Frac( a ) <> 0))
+ OR ( ( extractFloat32Exp( b ) = $FF ) AND (extractFloat32Frac( b ) <> 0))
+ ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float32_eq_signaling := 0;
+ exit;
+ End;
+ float32_eq_signaling := (flag( a = b ) OR flag( bits32 ( ( a OR b ) shl 1 ) = 0 ));
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is less than or
+equal to the corresponding value `b', and 0 otherwise. Quiet NaNs do not
+cause an exception. Otherwise, the comparison is performed according to the
+IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_le_quiet( a: float32 ; b : float32 ): flag;
+Var
+ aSign, bSign: flag;
+ aExp, bExp: int16;
+Begin
+ if ( ( ( extractFloat32Exp( a ) = $FF ) AND (extractFloat32Frac( a )<>0) )
+ OR ( ( extractFloat32Exp( b ) = $FF ) AND (extractFloat32Frac( b )<>0) )
+ ) then
+ Begin
+ if ( (float32_is_signaling_nan( a )<>0) OR (float32_is_signaling_nan( b )<>0) ) then
+ Begin
+ float_raise( float_flag_invalid );
+ End;
+ float32_le_quiet := 0;
+ exit;
+ End;
+ aSign := extractFloat32Sign( a );
+ bSign := extractFloat32Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float32_le_quiet := aSign OR flag( bits32 ( ( a OR b ) shl 1 ) = 0 );
+ exit;
+ End;
+ float32_le_quiet := flag(flag( a = b ) OR flag( aSign xor flag( a < b ) ));
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the single-precision floating-point value `a' is less than
+the corresponding value `b', and 0 otherwise. Quiet NaNs do not cause an
+exception. Otherwise, the comparison is performed according to the IEC/IEEE
+Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float32_lt_quiet( a: float32 ; b: float32 ): flag;
+Var
+ aSign, bSign: flag;
+Begin
+ if ( ( ( extractFloat32Exp( a ) = $FF ) AND (extractFloat32Frac( a )<>0) )
+ OR ( ( extractFloat32Exp( b ) = $FF ) AND (extractFloat32Frac( b )<>0) )
+ ) then
+ Begin
+ if ( (float32_is_signaling_nan( a )<>0) OR (float32_is_signaling_nan( b )<>0) ) then
+ Begin
+ float_raise( float_flag_invalid );
+ End;
+ float32_lt_quiet := 0;
+ exit;
+ End;
+ aSign := extractFloat32Sign( a );
+ bSign := extractFloat32Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float32_lt_quiet := aSign AND flag( bits32 ( ( a OR b ) shl 1 ) <> 0 );
+ exit;
+ End;
+ float32_lt_quiet := flag(flag( a <> b ) AND ( aSign xor flag( a < b ) ));
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic---which means in particular that the conversion is rounded
+according to the current rounding mode. If `a' is a NaN, the largest
+positive integer is returned. Otherwise, if the conversion overflows, the
+largest integer with the same sign as `a' is returned.
+-------------------------------------------------------------------------------
+*}
+Function float64_to_int32(a: float64): int32;{$ifdef fpc} [public,Alias:'FLOAT64_TO_INT32'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+var
+ aSign: flag;
+ aExp, shiftCount: int16;
+ aSig0, aSig1, absZ, aSigExtra: bits32;
+ z: int32;
+ roundingMode: int8;
+ label invalid;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ shiftCount := aExp - $413;
+ if ( 0 <= shiftCount ) then
+ Begin
+ if ( $41E < aExp ) then
+ Begin
+ if ( ( aExp = $7FF ) AND (( aSig0 OR aSig1 )<>0) ) then
+ aSign := 0;
+ goto invalid;
+ End;
+ shortShift64Left(
+ aSig0 OR $00100000, aSig1, shiftCount, absZ, aSigExtra );
+ if ( $80000000 < absZ ) then
+ goto invalid;
+ End
+ else
+ Begin
+ aSig1 := flag( aSig1 <> 0 );
+ if ( aExp < $3FE ) then
+ Begin
+ aSigExtra := aExp OR aSig0 OR aSig1;
+ absZ := 0;
+ End
+ else
+ Begin
+ aSig0 := aSig0 OR $00100000;
+ aSigExtra := ( aSig0 shl ( shiftCount and 31 ) ) OR aSig1;
+ absZ := aSig0 shr ( - shiftCount );
+ End;
+ End;
+ roundingMode := float_rounding_mode;
+ if ( roundingMode = float_round_nearest_even ) then
+ Begin
+ if ( sbits32(aSigExtra) < 0 ) then
+ Begin
+ Inc(absZ);
+ if ( bits32 ( aSigExtra shl 1 ) = 0 ) then
+ absZ := absZ and not 1;
+ End;
+ if aSign <> 0 then
+ z := - absZ
+ else
+ z := absZ;
+ End
+ else
+ Begin
+ aSigExtra := bits32( aSigExtra <> 0 );
+ if ( aSign <> 0) then
+ Begin
+ z := - ( absZ
+ + ( int32( roundingMode = float_round_down ) and aSigExtra ) );
+ End
+ else
+ Begin
+ z := absZ + ( int32( roundingMode = float_round_up ) and aSigExtra );
+ End
+ End;
+ if ( (( aSign xor flag( z < 0 ) )<>0) AND (z<>0) ) then
+ Begin
+ invalid:
+ float_raise( float_flag_invalid );
+ if (aSign <> 0 ) then
+ float64_to_int32 := sbits32 ($80000000)
+ else
+ float64_to_int32 := $7FFFFFFF;
+ exit;
+ End;
+ if ( aSigExtra <> 0) then
+ float_exception_flags := float_exception_flags or float_flag_inexact;
+ float64_to_int32 := z;
+End;
+
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point value
+`a' to the 32-bit two's complement integer format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic, except that the conversion is always rounded toward zero.
+If `a' is a NaN, the largest positive integer is returned. Otherwise, if
+the conversion overflows, the largest integer with the same sign as `a' is
+returned.
+-------------------------------------------------------------------------------
+*}
+Function float64_to_int32_round_to_zero(a: float64 ): int32;
+{$ifdef fpc} [public,Alias:'FLOAT64_TO_INT32_ROUND_TO_ZERO'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign: flag;
+ aExp, shiftCount: int16;
+ aSig0, aSig1, absZ, aSigExtra: bits32;
+ z: int32;
+ label invalid;
+ Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ shiftCount := aExp - $413;
+ if ( 0 <= shiftCount ) then
+ Begin
+ if ( $41E < aExp ) then
+ Begin
+ if ( ( aExp = $7FF ) AND (( aSig0 OR aSig1 )<>0) ) then
+ aSign := 0;
+ goto invalid;
+ End;
+ shortShift64Left(
+ aSig0 OR $00100000, aSig1, shiftCount, absZ, aSigExtra );
+ End
+ else
+ Begin
+ if ( aExp < $3FF ) then
+ Begin
+ if ( aExp OR aSig0 OR aSig1 )<>0 then
+ Begin
+ float_exception_flags :=
+ float_exception_flags or float_flag_inexact;
+ End;
+ float64_to_int32_round_to_zero := 0;
+ exit;
+ End;
+ aSig0 := aSig0 or $00100000;
+ aSigExtra := ( aSig0 shl ( shiftCount and 31 ) ) OR aSig1;
+ absZ := aSig0 shr ( - shiftCount );
+ End;
+ if aSign <> 0 then
+ z := - absZ
+ else
+ z := absZ;
+ if ( (( aSign xor flag( z < 0 )) <> 0) AND (z<>0) ) then
+ Begin
+ invalid:
+ float_raise( float_flag_invalid );
+ if (aSign <> 0) then
+ float64_to_int32_round_to_zero := sbits32 ($80000000)
+ else
+ float64_to_int32_round_to_zero := $7FFFFFFF;
+ exit;
+ End;
+ if ( aSigExtra <> 0) then
+ float_exception_flags := float_exception_flags or float_flag_inexact;
+ float64_to_int32_round_to_zero := z;
+ End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of converting the double-precision floating-point value
+`a' to the single-precision floating-point format. The conversion is
+performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_to_float32(a: float64 ): float32;{$ifdef fpc} [public,Alias:'FLOAT64_TO_FLOAT32'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign: flag;
+ aExp: int16;
+ aSig0, aSig1, zSig: bits32;
+ allZero: bits32;
+ tmp : CommonNanT;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 ) <> 0 then
+ Begin
+ float64ToCommonNaN( a, tmp );
+ float64_to_float32 := commonNaNToFloat32( tmp );
+ exit;
+ End;
+ float64_to_float32 := packFloat32( aSign, $FF, 0 );
+ exit;
+ End;
+ shift64RightJamming( aSig0, aSig1, 22, allZero, zSig );
+ if ( aExp <> 0) then
+ zSig := zSig OR $40000000;
+ float64_to_float32 := roundAndPackFloat32( aSign, aExp - $381, zSig );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Rounds the double-precision floating-point value `a' to an integer,
+and returns the result as a double-precision floating-point value. The
+operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_round_to_int(a: float64; var out: float64 );{$ifdef fpc} [public,Alias:'FLOAT64_ROUND_TO_INT'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+
+Var
+ aSign: flag;
+ aExp: int16;
+ lastBitMask, roundBitsMask: bits32;
+ roundingMode: int8;
+ z: float64;
+Begin
+ aExp := extractFloat64Exp( a );
+ if ( $413 <= aExp ) then
+ Begin
+ if ( $433 <= aExp ) then
+ Begin
+ if ( ( aExp = $7FF )
+ AND
+ (
+ ( extractFloat64Frac0( a ) OR extractFloat64Frac1( a )
+ ) <>0)
+ ) then
+ Begin
+ propagateFloat64NaN( a, a, out );
+ exit;
+ End;
+ out := a;
+ exit;
+ End;
+ lastBitMask := 1;
+ lastBitMask := ( lastBitMask shl ( $432 - aExp ) ) shl 1;
+ roundBitsMask := lastBitMask - 1;
+ z := a;
+ roundingMode := float_rounding_mode;
+ if ( roundingMode = float_round_nearest_even ) then
+ Begin
+ if ( lastBitMask <> 0) then
+ Begin
+ add64( z.high, z.low, 0, lastBitMask shr 1, z.high, z.low );
+ if ( ( z.low and roundBitsMask ) = 0 ) then
+ z.low := z.low and not lastBitMask;
+ End
+ else
+ Begin
+ if ( sbits32 (z.low) < 0 ) then
+ Begin
+ Inc(z.high);
+ if ( bits32 ( z.low shl 1 ) = 0 ) then
+ z.high := z.high and not 1;
+ End;
+ End;
+ End
+ else if ( roundingMode <> float_round_to_zero ) then
+ Begin
+ if ( extractFloat64Sign( z )
+ xor flag( roundingMode = float_round_up ) )<> 0 then
+ Begin
+ add64( z.high, z.low, 0, roundBitsMask, z.high, z.low );
+ End;
+ End;
+ z.low := z.low and not roundBitsMask;
+ End
+ else
+ Begin
+ if ( aExp <= $3FE ) then
+ Begin
+ if ( ( ( bits32 ( a.high shl 1 ) ) OR a.low ) = 0 ) then
+ Begin
+ out := a;
+ exit;
+ End;
+ float_exception_flags := float_exception_flags or
+ float_flag_inexact;
+ aSign := extractFloat64Sign( a );
+ case ( float_rounding_mode ) of
+ float_round_nearest_even:
+ Begin
+ if ( ( aExp = $3FE )
+ AND ( (extractFloat64Frac0( a ) OR extractFloat64Frac1( a ) )<>0)
+ ) then
+ Begin
+ packFloat64( aSign, $3FF, 0, 0, out );
+ exit;
+ End;
+
+ End;
+ float_round_down:
+ Begin
+ if aSign<>0 then
+ packFloat64( 1, $3FF, 0, 0, out )
+ else
+ packFloat64( 0, 0, 0, 0, out );
+ exit;
+ End;
+ float_round_up:
+ Begin
+ if aSign <> 0 then
+ packFloat64( 1, 0, 0, 0, out )
+ else
+ packFloat64( 0, $3FF, 0, 0, out );
+ exit;
+ End;
+ end;
+ packFloat64( aSign, 0, 0, 0, out );
+ exit;
+ End;
+ lastBitMask := 1;
+ lastBitMask := lastBitMask shl ($413 - aExp);
+ roundBitsMask := lastBitMask - 1;
+ z.low := 0;
+ z.high := a.high;
+ roundingMode := float_rounding_mode;
+ if ( roundingMode = float_round_nearest_even ) then
+ Begin
+ z.high := z.high + lastBitMask shr 1;
+ if ( ( ( z.high and roundBitsMask ) OR a.low ) = 0 ) then
+ Begin
+ z.high := z.high and not lastBitMask;
+ End;
+ End
+ else if ( roundingMode <> float_round_to_zero ) then
+ Begin
+ if ( extractFloat64Sign( z )
+ xor flag( roundingMode = float_round_up ) )<> 0 then
+ Begin
+ z.high := z.high or bits32( a.low <> 0 );
+ z.high := z.high + roundBitsMask;
+ End;
+ End;
+ z.high := z.high and not roundBitsMask;
+ End;
+ if ( ( z.low <> a.low ) OR ( z.high <> a.high ) ) then
+ Begin
+ float_exception_flags :=
+ float_exception_flags or float_flag_inexact;
+ End;
+ out := z;
+End;
+
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of adding the absolute values of the double-precision
+floating-point values `a' and `b'. If `zSign' is 1, the sum is negated
+before being returned. `zSign' is ignored if the result is a NaN.
+The addition is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure addFloat64Sigs( a:float64 ; b: float64 ; zSign:flag; Var out: float64 );
+Var
+ aExp, bExp, zExp: int16;
+ aSig0, aSig1, bSig0, bSig1, zSig0, zSig1, zSig2: bits32;
+ expDiff: int16;
+ label shiftRight1;
+ label roundAndPack;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ bSig1 := extractFloat64Frac1( b );
+ bSig0 := extractFloat64Frac0( b );
+ bExp := extractFloat64Exp( b );
+ expDiff := aExp - bExp;
+ if ( 0 < expDiff ) then
+ Begin
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ end;
+ out := a;
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ Dec(expDiff);
+ End
+ else
+ Begin
+ bSig0 := bSig0 or $00100000;
+ End;
+ shift64ExtraRightJamming(
+ bSig0, bSig1, 0, expDiff, bSig0, bSig1, zSig2 );
+ zExp := aExp;
+ End
+ else if ( expDiff < 0 ) then
+ Begin
+ if ( bExp = $7FF ) then
+ Begin
+ if ( bSig0 OR bSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ packFloat64( zSign, $7FF, 0, 0, out );
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ Inc(expDiff);
+ End
+ else
+ Begin
+ aSig0 := aSig0 or $00100000;
+ End;
+ shift64ExtraRightJamming(
+ aSig0, aSig1, 0, - expDiff, aSig0, aSig1, zSig2 );
+ zExp := bExp;
+ End
+ else
+ Begin
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 OR bSig0 OR bSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ out := a;
+ exit;
+ End;
+ add64( aSig0, aSig1, bSig0, bSig1, zSig0, zSig1 );
+ if ( aExp = 0 ) then
+ Begin
+ packFloat64( zSign, 0, zSig0, zSig1, out );
+ exit;
+ End;
+ zSig2 := 0;
+ zSig0 := zSig0 or $00200000;
+ zExp := aExp;
+ goto shiftRight1;
+ End;
+ aSig0 := aSig0 or $00100000;
+ add64( aSig0, aSig1, bSig0, bSig1, zSig0, zSig1 );
+ Dec(zExp);
+ if ( zSig0 < $00200000 ) then
+ goto roundAndPack;
+ Inc(zExp);
+ shiftRight1:
+ shift64ExtraRightJamming( zSig0, zSig1, zSig2, 1, zSig0, zSig1, zSig2 );
+ roundAndPack:
+ roundAndPackFloat64( zSign, zExp, zSig0, zSig1, zSig2, out );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of subtracting the absolute values of the double-
+precision floating-point values `a' and `b'. If `zSign' is 1, the
+difference is negated before being returned. `zSign' is ignored if the
+result is a NaN. The subtraction is performed according to the IEC/IEEE
+Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure subFloat64Sigs( a:float64; b: float64 ; zSign:flag; Var out: float64 );
+Var
+ aExp, bExp, zExp: int16;
+ aSig0, aSig1, bSig0, bSig1, zSig0, zSig1: bits32;
+ expDiff: int16;
+ z: float64;
+ label aExpBigger;
+ label bExpBigger;
+ label aBigger;
+ label bBigger;
+ label normalizeRoundAndPack;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ bSig1 := extractFloat64Frac1( b );
+ bSig0 := extractFloat64Frac0( b );
+ bExp := extractFloat64Exp( b );
+ expDiff := aExp - bExp;
+ shortShift64Left( aSig0, aSig1, 10, aSig0, aSig1 );
+ shortShift64Left( bSig0, bSig1, 10, bSig0, bSig1 );
+ if ( 0 < expDiff ) then goto aExpBigger;
+ if ( expDiff < 0 ) then goto bExpBigger;
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 OR bSig0 OR bSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ float_raise( float_flag_invalid );
+ z.low := float64_default_nan_low;
+ z.high := float64_default_nan_high;
+ out := z;
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ aExp := 1;
+ bExp := 1;
+ End;
+ if ( bSig0 < aSig0 ) then goto aBigger;
+ if ( aSig0 < bSig0 ) then goto bBigger;
+ if ( bSig1 < aSig1 ) then goto aBigger;
+ if ( aSig1 < bSig1 ) then goto bBigger;
+ packFloat64( flag(float_rounding_mode = float_round_down), 0, 0, 0 , out);
+ exit;
+ bExpBigger:
+ if ( bExp = $7FF ) then
+ Begin
+ if ( bSig0 OR bSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ packFloat64( zSign xor 1, $7FF, 0, 0, out );
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ Inc(expDiff);
+ End
+ else
+ Begin
+ aSig0 := aSig0 or $40000000;
+ End;
+ shift64RightJamming( aSig0, aSig1, - expDiff, aSig0, aSig1 );
+ bSig0 := bSig0 or $40000000;
+ bBigger:
+ sub64( bSig0, bSig1, aSig0, aSig1, zSig0, zSig1 );
+ zExp := bExp;
+ zSign := zSign xor 1;
+ goto normalizeRoundAndPack;
+ aExpBigger:
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ out := a;
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ Dec(expDiff);
+ End
+ else
+ Begin
+ bSig0 := bSig0 or $40000000;
+ End;
+ shift64RightJamming( bSig0, bSig1, expDiff, bSig0, bSig1 );
+ aSig0 := aSig0 or $40000000;
+ aBigger:
+ sub64( aSig0, aSig1, bSig0, bSig1, zSig0, zSig1 );
+ zExp := aExp;
+ normalizeRoundAndPack:
+ Dec(zExp);
+ normalizeRoundAndPackFloat64( zSign, zExp - 10, zSig0, zSig1, out );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of adding the double-precision floating-point values `a'
+and `b'. The operation is performed according to the IEC/IEEE Standard for
+Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_add( a: float64; b : float64; Var out : float64);
+{$ifdef fpc}[public,Alias:'FLOAT64_ADD'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign: flag;
+Begin
+ aSign := extractFloat64Sign( a );
+ bSign := extractFloat64Sign( b );
+ if ( aSign = bSign ) then
+ Begin
+ addFloat64Sigs( a, b, aSign, out );
+ End
+ else
+ Begin
+ subFloat64Sigs( a, b, aSign, out );
+ End;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of subtracting the double-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_sub(a: float64; b : float64; var out: float64);
+{$ifdef fpc}[public,Alias:'FLOAT64_SUB'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign: flag;
+Begin
+ aSign := extractFloat64Sign( a );
+ bSign := extractFloat64Sign( b );
+ if ( aSign = bSign ) then
+ Begin
+ subFloat64Sigs( a, b, aSign, out );
+ End
+ else
+ Begin
+ addFloat64Sigs( a, b, aSign, out );
+ End;
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of multiplying the double-precision floating-point values
+`a' and `b'. The operation is performed according to the IEC/IEEE Standard
+for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_mul( a: float64; b:float64; Var out: float64);
+{$ifdef fpc}[public,Alias:'FLOAT64_MUL'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign, zSign: flag;
+ aExp, bExp, zExp: int16;
+ aSig0, aSig1, bSig0, bSig1, zSig0, zSig1, zSig2, zSig3: bits32;
+ z: float64;
+ label invalid;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ bSig1 := extractFloat64Frac1( b );
+ bSig0 := extractFloat64Frac0( b );
+ bExp := extractFloat64Exp( b );
+ bSign := extractFloat64Sign( b );
+ zSign := aSign xor bSign;
+ if ( aExp = $7FF ) then
+ Begin
+ if ( (( aSig0 OR aSig1 ) <>0)
+ OR ( ( bExp = $7FF ) AND (( bSig0 OR bSig1 )<>0) ) ) then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ if ( ( bExp OR bSig0 OR bSig1 ) = 0 ) then goto invalid;
+ packFloat64( zSign, $7FF, 0, 0, out );
+ exit;
+ End;
+ if ( bExp = $7FF ) then
+ Begin
+ if ( bSig0 OR bSig1 )<> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ if ( ( aExp OR aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ invalid:
+ float_raise( float_flag_invalid );
+ z.low := float64_default_nan_low;
+ z.high := float64_default_nan_high;
+ out := z;
+ exit;
+ End;
+ packFloat64( zSign, $7FF, 0, 0, out );
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( ( aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ packFloat64( zSign, 0, 0, 0, out );
+ exit;
+ End;
+ normalizeFloat64Subnormal( aSig0, aSig1, aExp, aSig0, aSig1 );
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ if ( ( bSig0 OR bSig1 ) = 0 ) then
+ Begin
+ packFloat64( zSign, 0, 0, 0, out );
+ exit;
+ End;
+ normalizeFloat64Subnormal( bSig0, bSig1, bExp, bSig0, bSig1 );
+ End;
+ zExp := aExp + bExp - $400;
+ aSig0 := aSig0 or $00100000;
+ shortShift64Left( bSig0, bSig1, 12, bSig0, bSig1 );
+ mul64To128( aSig0, aSig1, bSig0, bSig1, zSig0, zSig1, zSig2, zSig3 );
+ add64( zSig0, zSig1, aSig0, aSig1, zSig0, zSig1 );
+ zSig2 := zSig2 or flag( zSig3 <> 0 );
+ if ( $00200000 <= zSig0 ) then
+ Begin
+ shift64ExtraRightJamming(
+ zSig0, zSig1, zSig2, 1, zSig0, zSig1, zSig2 );
+ Inc(zExp);
+ End;
+ roundAndPackFloat64( zSign, zExp, zSig0, zSig1, zSig2, out );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the result of dividing the double-precision floating-point value `a'
+by the corresponding value `b'. The operation is performed according to the
+IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_div(a: float64; b : float64 ; var out: float64 );
+{$ifdef fpc}[public,Alias:'FLOAT64_DIV'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign, zSign: flag;
+ aExp, bExp, zExp: int16;
+ aSig0, aSig1, bSig0, bSig1, zSig0, zSig1, zSig2: bits32;
+ rem0, rem1, rem2, rem3, term0, term1, term2, term3: bits32;
+ z: float64;
+ label invalid;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ bSig1 := extractFloat64Frac1( b );
+ bSig0 := extractFloat64Frac0( b );
+ bExp := extractFloat64Exp( b );
+ bSign := extractFloat64Sign( b );
+ zSign := aSign xor bSign;
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 )<> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ end;
+ if ( bExp = $7FF ) then
+ Begin
+ if ( bSig0 OR bSig1 )<>0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ goto invalid;
+ End;
+ packFloat64( zSign, $7FF, 0, 0, out );
+ exit;
+ End;
+ if ( bExp = $7FF ) then
+ Begin
+ if ( bSig0 OR bSig1 )<> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ packFloat64( zSign, 0, 0, 0, out );
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ if ( ( bSig0 OR bSig1 ) = 0 ) then
+ Begin
+ if ( ( aExp OR aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ invalid:
+ float_raise( float_flag_invalid );
+ z.low := float64_default_nan_low;
+ z.high := float64_default_nan_high;
+ out := z;
+ exit;
+ End;
+ float_raise( float_flag_divbyzero );
+ packFloat64( zSign, $7FF, 0, 0, out );
+ exit;
+ End;
+ normalizeFloat64Subnormal( bSig0, bSig1, bExp, bSig0, bSig1 );
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( ( aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ packFloat64( zSign, 0, 0, 0, out );
+ exit;
+ End;
+ normalizeFloat64Subnormal( aSig0, aSig1, aExp, aSig0, aSig1 );
+ End;
+ zExp := aExp - bExp + $3FD;
+ shortShift64Left( aSig0 OR $00100000, aSig1, 11, aSig0, aSig1 );
+ shortShift64Left( bSig0 OR $00100000, bSig1, 11, bSig0, bSig1 );
+ if ( le64( bSig0, bSig1, aSig0, aSig1 )<>0 ) then
+ Begin
+ shift64Right( aSig0, aSig1, 1, aSig0, aSig1 );
+ Inc(zExp);
+ End;
+ zSig0 := estimateDiv64To32( aSig0, aSig1, bSig0 );
+ mul64By32To96( bSig0, bSig1, zSig0, term0, term1, term2 );
+ sub96( aSig0, aSig1, 0, term0, term1, term2, rem0, rem1, rem2 );
+ while ( sbits32 (rem0) < 0 ) do
+ Begin
+ Dec(zSig0);
+ add96( rem0, rem1, rem2, 0, bSig0, bSig1, rem0, rem1, rem2 );
+ End;
+ zSig1 := estimateDiv64To32( rem1, rem2, bSig0 );
+ if ( ( zSig1 and $3FF ) <= 4 ) then
+ Begin
+ mul64By32To96( bSig0, bSig1, zSig1, term1, term2, term3 );
+ sub96( rem1, rem2, 0, term1, term2, term3, rem1, rem2, rem3 );
+ while ( sbits32 (rem1) < 0 ) do
+ Begin
+ Dec(zSig1);
+ add96( rem1, rem2, rem3, 0, bSig0, bSig1, rem1, rem2, rem3 );
+ End;
+ zSig1 := zSig1 or flag( ( rem1 OR rem2 OR rem3 ) <> 0 );
+ End;
+ shift64ExtraRightJamming( zSig0, zSig1, 0, 11, zSig0, zSig1, zSig2 );
+ roundAndPackFloat64( zSign, zExp, zSig0, zSig1, zSig2, out );
+
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the remainder of the double-precision floating-point value `a'
+with respect to the corresponding value `b'. The operation is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_rem(a: float64; b : float64; var out: float64);
+{$ifdef fpc}[public,Alias:'FLOAT64_REM'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign, zSign: flag;
+ aExp, bExp, expDiff: int16;
+ aSig0, aSig1, bSig0, bSig1, q, term0, term1, term2: bits32;
+ allZero, alternateASig0, alternateASig1, sigMean1: bits32;
+ sigMean0: sbits32;
+ z: float64;
+ label invalid;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ bSig1 := extractFloat64Frac1( b );
+ bSig0 := extractFloat64Frac0( b );
+ bExp := extractFloat64Exp( b );
+ bSign := extractFloat64Sign( b );
+ if ( aExp = $7FF ) then
+ Begin
+ if ((( aSig0 OR aSig1 )<>0)
+ OR ( ( bExp = $7FF ) AND (( bSig0 OR bSig1 )<>0) ) ) then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ goto invalid;
+ End;
+ if ( bExp = $7FF ) then
+ Begin
+ if ( bSig0 OR bSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, b, out );
+ exit;
+ End;
+ out := a;
+ exit;
+ End;
+ if ( bExp = 0 ) then
+ Begin
+ if ( ( bSig0 OR bSig1 ) = 0 ) then
+ Begin
+ invalid:
+ float_raise( float_flag_invalid );
+ z.low := float64_default_nan_low;
+ z.high := float64_default_nan_high;
+ out := z;
+ exit;
+ End;
+ normalizeFloat64Subnormal( bSig0, bSig1, bExp, bSig0, bSig1 );
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( ( aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ out := a;
+ exit;
+ End;
+ normalizeFloat64Subnormal( aSig0, aSig1, aExp, aSig0, aSig1 );
+ End;
+ expDiff := aExp - bExp;
+ if ( expDiff < -1 ) then
+ Begin
+ out := a;
+ exit;
+ End;
+ shortShift64Left(
+ aSig0 OR $00100000, aSig1, 11 - flag( expDiff < 0 ), aSig0, aSig1 );
+ shortShift64Left( bSig0 OR $00100000, bSig1, 11, bSig0, bSig1 );
+ q := le64( bSig0, bSig1, aSig0, aSig1 );
+ if ( q )<>0 then
+ sub64( aSig0, aSig1, bSig0, bSig1, aSig0, aSig1 );
+ expDiff := expDiff - 32;
+ while ( 0 < expDiff ) do
+ Begin
+ q := estimateDiv64To32( aSig0, aSig1, bSig0 );
+ if 4 < q then
+ q:= q - 4
+ else
+ q := 0;
+ mul64By32To96( bSig0, bSig1, q, term0, term1, term2 );
+ shortShift96Left( term0, term1, term2, 29, term1, term2, allZero );
+ shortShift64Left( aSig0, aSig1, 29, aSig0, allZero );
+ sub64( aSig0, 0, term1, term2, aSig0, aSig1 );
+ expDiff := expDiff - 29;
+ End;
+ if ( -32 < expDiff ) then
+ Begin
+ q := estimateDiv64To32( aSig0, aSig1, bSig0 );
+ if 4 < q then
+ q := q - 4
+ else
+ q := 0;
+ q := q shr (- expDiff);
+ shift64Right( bSig0, bSig1, 8, bSig0, bSig1 );
+ expDiff := expDiff + 24;
+ if ( expDiff < 0 ) then
+ Begin
+ shift64Right( aSig0, aSig1, - expDiff, aSig0, aSig1 );
+ End
+ else
+ Begin
+ shortShift64Left( aSig0, aSig1, expDiff, aSig0, aSig1 );
+ End;
+ mul64By32To96( bSig0, bSig1, q, term0, term1, term2 );
+ sub64( aSig0, aSig1, term1, term2, aSig0, aSig1 );
+ End
+ else
+ Begin
+ shift64Right( aSig0, aSig1, 8, aSig0, aSig1 );
+ shift64Right( bSig0, bSig1, 8, bSig0, bSig1 );
+ End;
+ Repeat
+ alternateASig0 := aSig0;
+ alternateASig1 := aSig1;
+ Inc(q);
+ sub64( aSig0, aSig1, bSig0, bSig1, aSig0, aSig1 );
+ Until not ( 0 <= sbits32 (aSig0) );
+ add64(
+ aSig0, aSig1, alternateASig0, alternateASig1, bits32(sigMean0), sigMean1 );
+ if ( ( sigMean0 < 0 )
+ OR ( ( ( sigMean0 OR sigMean1 ) = 0 ) AND (( q AND 1 )<>0) ) ) then
+ Begin
+ aSig0 := alternateASig0;
+ aSig1 := alternateASig1;
+ End;
+ zSign := flag( sbits32 (aSig0) < 0 );
+ if ( zSign <> 0 ) then
+ sub64( 0, 0, aSig0, aSig1, aSig0, aSig1 );
+ normalizeRoundAndPackFloat64( aSign xor zSign, bExp - 4, aSig0, aSig1, out );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns the square root of the double-precision floating-point value `a'.
+The operation is performed according to the IEC/IEEE Standard for Binary
+Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Procedure float64_sqrt( a: float64; var out: float64 );
+{$ifdef fpc}[public,Alias:'FLOAT64_SQRT'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign: flag;
+ aExp, zExp: int16;
+ aSig0, aSig1, zSig0, zSig1, zSig2, doubleZSig0: bits32;
+ rem0, rem1, rem2, rem3, term0, term1, term2, term3: bits32;
+ z: float64;
+ label invalid;
+Begin
+ aSig1 := extractFloat64Frac1( a );
+ aSig0 := extractFloat64Frac0( a );
+ aExp := extractFloat64Exp( a );
+ aSign := extractFloat64Sign( a );
+ if ( aExp = $7FF ) then
+ Begin
+ if ( aSig0 OR aSig1 ) <> 0 then
+ Begin
+ propagateFloat64NaN( a, a, out );
+ exit;
+ End;
+ if ( aSign = 0) then
+ Begin
+ out := a;
+ exit;
+ End;
+ goto invalid;
+ End;
+ if ( aSign <> 0 ) then
+ Begin
+ if ( ( aExp OR aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ out := a;
+ exit;
+ End;
+ invalid:
+ float_raise( float_flag_invalid );
+ z.low := float64_default_nan_low;
+ z.high := float64_default_nan_high;
+ out := z;
+ exit;
+ End;
+ if ( aExp = 0 ) then
+ Begin
+ if ( ( aSig0 OR aSig1 ) = 0 ) then
+ Begin
+ packFloat64( 0, 0, 0, 0, out );
+ exit;
+ End;
+ normalizeFloat64Subnormal( aSig0, aSig1, aExp, aSig0, aSig1 );
+ End;
+ zExp := ( ( aExp - $3FF ) shr 1 ) + $3FE;
+ aSig0 := aSig0 or $00100000;
+ shortShift64Left( aSig0, aSig1, 11, term0, term1 );
+ zSig0 := ( estimateSqrt32( aExp, term0 ) shr 1 ) + 1;
+ if ( zSig0 = 0 ) then
+ zSig0 := $7FFFFFFF;
+ doubleZSig0 := zSig0 + zSig0;
+ shortShift64Left( aSig0, aSig1, 9 - ( aExp and 1 ), aSig0, aSig1 );
+ mul32To64( zSig0, zSig0, term0, term1 );
+ sub64( aSig0, aSig1, term0, term1, rem0, rem1 );
+ while ( sbits32 (rem0) < 0 ) do
+ Begin
+ Dec(zSig0);
+ doubleZSig0 := doubleZSig0 - 2;
+ add64( rem0, rem1, 0, doubleZSig0 OR 1, rem0, rem1 );
+ End;
+ zSig1 := estimateDiv64To32( rem1, 0, doubleZSig0 );
+ if ( ( zSig1 and $1FF ) <= 5 ) then
+ Begin
+ if ( zSig1 = 0 ) then
+ zSig1 := 1;
+ mul32To64( doubleZSig0, zSig1, term1, term2 );
+ sub64( rem1, 0, term1, term2, rem1, rem2 );
+ mul32To64( zSig1, zSig1, term2, term3 );
+ sub96( rem1, rem2, 0, 0, term2, term3, rem1, rem2, rem3 );
+ while ( sbits32 (rem1) < 0 ) do
+ Begin
+ Dec(zSig1);
+ shortShift64Left( 0, zSig1, 1, term2, term3 );
+ term3 := term3 or 1;
+ term2 := term2 or doubleZSig0;
+ add96( rem1, rem2, rem3, 0, term2, term3, rem1, rem2, rem3 );
+ End;
+ zSig1 := zSig1 or bits32( ( rem1 OR rem2 OR rem3 ) <> 0 );
+ End;
+ shift64ExtraRightJamming( zSig0, zSig1, 0, 10, zSig0, zSig1, zSig2 );
+ roundAndPackFloat64( 0, zExp, zSig0, zSig1, zSig2, out );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is equal to
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_eq(a: float64; b: float64): flag;
+{$ifdef fpc}[public,Alias:'FLOAT64_EQ'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Begin
+ if
+ (
+ ( extractFloat64Exp( a ) = $7FF )
+ AND
+ (
+ (extractFloat64Frac0( a ) OR extractFloat64Frac1( a )) <>0
+ )
+ )
+ OR (
+ ( extractFloat64Exp( b ) = $7FF )
+ AND (
+ (extractFloat64Frac0( b ) OR (extractFloat64Frac1( b )) <> 0
+ )
+ )
+ ) then
+ Begin
+ if ( (float64_is_signaling_nan( a )<>0) OR (float64_is_signaling_nan( b )<>0) ) then
+ float_raise( float_flag_invalid );
+ float64_eq := 0;
+ exit;
+ End;
+ float64_eq := flag(
+ ( a.low = b.low )
+ AND ( ( a.high = b.high )
+ OR ( ( a.low = 0 )
+ AND ( bits32 ( ( a.high OR b.high ) shl 1 ) = 0 ) )
+ ));
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is less than
+or equal to the corresponding value `b', and 0 otherwise. The comparison
+is performed according to the IEC/IEEE Standard for Binary Floating-Point
+Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_le(a: float64;b: float64): flag;
+{$ifdef fpc}[public,Alias:'FLOAT64_LE'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign: flag;
+Begin
+ if
+ (
+ ( extractFloat64Exp( a ) = $7FF )
+ AND
+ (
+ (extractFloat64Frac0( a ) OR extractFloat64Frac1( a )) <>0
+ )
+ )
+ OR (
+ ( extractFloat64Exp( b ) = $7FF )
+ AND (
+ (extractFloat64Frac0( b ) OR (extractFloat64Frac1( b )) <> 0
+ )
+ )
+ ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float64_le := 0;
+ exit;
+ End;
+ aSign := extractFloat64Sign( a );
+ bSign := extractFloat64Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float64_le := flag(
+ (aSign <> 0)
+ OR ( ( ( bits32 ( ( a.high OR b.high ) shl 1 ) ) OR a.low OR b.low )
+ = 0 ));
+ exit;
+ End;
+ if aSign <> 0 then
+ float64_le := le64( b.high, b.low, a.high, a.low )
+ else
+ float64_le := le64( a.high, a.low, b.high, b.low );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is less than
+the corresponding value `b', and 0 otherwise. The comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_lt(a: float64;b: float64): flag;
+{$ifdef fpc}[public,Alias:'FLOAT64_LT'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+Var
+ aSign, bSign: flag;
+Begin
+ if
+ (
+ ( extractFloat64Exp( a ) = $7FF )
+ AND
+ (
+ (extractFloat64Frac0( a ) OR extractFloat64Frac1( a )) <>0
+ )
+ )
+ OR (
+ ( extractFloat64Exp( b ) = $7FF )
+ AND (
+ (extractFloat64Frac0( b ) OR (extractFloat64Frac1( b )) <> 0
+ )
+ )
+ ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float64_lt := 0;
+ exit;
+ End;
+ aSign := extractFloat64Sign( a );
+ bSign := extractFloat64Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float64_lt := flag(
+ (aSign <> 0)
+ AND ( ( ( bits32 ( ( a.high OR b.high ) shl 1 ) ) OR a.low OR b.low )
+ <> 0 ));
+ exit;
+ End;
+ if aSign <> 0 then
+ float64_lt := lt64( b.high, b.low, a.high, a.low )
+ else
+ float64_lt := lt64( a.high, a.low, b.high, b.low );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is equal to
+the corresponding value `b', and 0 otherwise. The invalid exception is
+raised if either operand is a NaN. Otherwise, the comparison is performed
+according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_eq_signaling( a: float64; b: float64): flag;
+Begin
+
+ if
+ (
+ ( extractFloat64Exp( a ) = $7FF )
+ AND
+ (
+ (extractFloat64Frac0( a ) OR extractFloat64Frac1( a )) <>0
+ )
+ )
+ OR (
+ ( extractFloat64Exp( b ) = $7FF )
+ AND (
+ (extractFloat64Frac0( b ) OR (extractFloat64Frac1( b )) <> 0
+ )
+ )
+ ) then
+ Begin
+ float_raise( float_flag_invalid );
+ float64_eq_signaling := 0;
+ exit;
+ End;
+ float64_eq_signaling := flag(
+ ( a.low = b.low )
+ AND ( ( a.high = b.high )
+ OR ( ( a.low = 0 )
+ AND ( bits32 ( ( a.high OR b.high ) shl 1 ) = 0 ) )
+ ));
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is less than or
+equal to the corresponding value `b', and 0 otherwise. Quiet NaNs do not
+cause an exception. Otherwise, the comparison is performed according to the
+IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_le_quiet(a: float64 ; b: float64 ): flag;
+Var
+ aSign, bSign : flag;
+Begin
+ if
+ (
+ ( extractFloat64Exp( a ) = $7FF )
+ AND
+ (
+ (extractFloat64Frac0( a ) OR extractFloat64Frac1( a )) <>0
+ )
+ )
+ OR (
+ ( extractFloat64Exp( b ) = $7FF )
+ AND (
+ (extractFloat64Frac0( b ) OR (extractFloat64Frac1( b )) <> 0
+ )
+ )
+ ) then
+ Begin
+ if ( (float64_is_signaling_nan( a )<>0) OR (float64_is_signaling_nan( b )<>0) ) then
+ float_raise( float_flag_invalid );
+ float64_le_quiet := 0;
+ exit;
+ End;
+ aSign := extractFloat64Sign( a );
+ bSign := extractFloat64Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float64_le_quiet := flag
+ ((aSign <> 0)
+ OR ( ( ( bits32 ( ( a.high OR b.high ) shl 1 ) ) OR a.low OR b.low )
+ = 0 ));
+ exit;
+ End;
+ if aSign <> 0 then
+ float64_le_quiet := le64( b.high, b.low, a.high, a.low )
+ else
+ float64_le_quiet := le64( a.high, a.low, b.high, b.low );
+End;
+
+{*
+-------------------------------------------------------------------------------
+Returns 1 if the double-precision floating-point value `a' is less than
+the corresponding value `b', and 0 otherwise. Quiet NaNs do not cause an
+exception. Otherwise, the comparison is performed according to the IEC/IEEE
+Standard for Binary Floating-Point Arithmetic.
+-------------------------------------------------------------------------------
+*}
+Function float64_lt_quiet(a: float64; b: float64 ): Flag;
+Var
+ aSign, bSign: flag;
+Begin
+ if
+ (
+ ( extractFloat64Exp( a ) = $7FF )
+ AND
+ (
+ (extractFloat64Frac0( a ) OR extractFloat64Frac1( a )) <>0
+ )
+ )
+ OR (
+ ( extractFloat64Exp( b ) = $7FF )
+ AND (
+ (extractFloat64Frac0( b ) OR (extractFloat64Frac1( b )) <> 0
+ )
+ )
+ ) then
+ Begin
+ if ( (float64_is_signaling_nan( a )<>0) OR (float64_is_signaling_nan( b )<>0) ) then
+ float_raise( float_flag_invalid );
+ float64_lt_quiet := 0;
+ exit;
+ End;
+ aSign := extractFloat64Sign( a );
+ bSign := extractFloat64Sign( b );
+ if ( aSign <> bSign ) then
+ Begin
+ float64_lt_quiet := flag(
+ (aSign<>0)
+ AND ( ( ( bits32 ( ( a.high OR b.high ) shl 1 ) ) OR a.low OR b.low )
+ <> 0 ));
+ exit;
+ End;
+ If aSign <> 0 then
+ float64_lt_quiet := lt64( b.high, b.low, a.high, a.low )
+ else
+ float64_lt_quiet := lt64( a.high, a.low, b.high, b.low );
+End;
+
+
+{*----------------------------------------------------------------------------
+| Returns the result of converting the 64-bit two's complement integer `a'
+| to the single-precision floating-point format. The conversion is performed
+| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+*----------------------------------------------------------------------------*}
+function int64_to_float32( a: int64 ): float32;
+{$ifdef fpc}[public,Alias:'INT64_TO_FLOAT32'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+var
+ zSign : flag;
+ absA : uint64;
+ shiftCount: int8;
+ zSig : bits32;
+ intval : int64rec;
+Begin
+ if ( a = 0 ) then
+ begin
+ int64_to_float32 := 0;
+ exit;
+ end;
+ if a < 0 then
+ zSign := flag(TRUE)
+ else
+ zSign := flag(FALSE);
+ if zSign<>0 then
+ absA := -a
+ else
+ absA := a;
+ shiftCount := countLeadingZeros64( absA ) - 40;
+ if ( 0 <= shiftCount ) then
+ begin
+ int64_to_float32:= packFloat32( zSign, $95 - shiftCount, absA shl shiftCount );
+ end
+ else
+ begin
+ shiftCount := shiftCount + 7;
+ if ( shiftCount < 0 ) then
+ begin
+ intval.low := int64rec(AbsA).low;
+ intval.high := int64rec(AbsA).high;
+ shift64RightJamming( intval.low, intval.high, - shiftCount,
+ intval.low, intval.high);
+ int64rec(absA).low := intval.low;
+ int64rec(absA).high := intval.high;
+ end
+ else
+ absA := absA shl shiftCount;
+ int64_to_float32:=roundAndPackFloat32( zSign, $9C - shiftCount, absA );
+ end;
+End;
+
+
+{*----------------------------------------------------------------------------
+| Returns the result of converting the 64-bit two's complement integer `a'
+| to the double-precision floating-point format. The conversion is performed
+| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
+*----------------------------------------------------------------------------*}
+function int64_to_float64( a: int64 ): float64;
+{$ifdef fpc}[public,Alias:'INT64_TO_FLOAT64'];{$ifdef hascompilerproc} compilerproc; {$endif}{$endif}
+var
+ zSign : flag;
+ float_result : float64;
+ intval : int64rec;
+ AbsA : bits64;
+ shiftcount : int8;
+ zSig0, zSig1 : bits32;
+Begin
+ if ( a = 0 ) then
+ Begin
+ packFloat64( 0, 0, 0, 0, float_result );
+ exit;
+ end;
+ zSign := flag( a < 0 );
+ if ZSign<>0 then
+ AbsA := -a
+ else
+ AbsA := a;
+ shiftCount := countLeadingZeros64( absA ) - 11;
+ if ( 0 <= shiftCount ) then
+ Begin
+ absA := absA shl shiftcount;
+ zSig0:=int64rec(absA).high;
+ zSig1:=int64rec(absA).low;
+ End
+ else
+ Begin
+ shift64Right( absA, 0, - shiftCount, zSig0, zSig1 );
+ End;
+ packFloat64( zSign, $432 - shiftCount, zSig0, zSig1, float_result );
+ int64_to_float64:= float_result;
+End;
+
+end.
+{
+ $Log: softfpu.pp,v $
+ Revision 1.7 2005/02/14 17:13:26 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc
new file mode 100644
index 0000000000..1759fdc6a8
--- /dev/null
+++ b/rtl/inc/sstrings.inc
@@ -0,0 +1,903 @@
+{
+ $Id: sstrings.inc,v 1.36 2005/04/02 07:57:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ subroutines for string handling
+****************************************************************************}
+
+{$ifndef INTERNSETLENGTH}
+procedure SetLength(var s:shortstring;len:SizeInt);
+{$else INTERNSETLENGTH}
+procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif INTERNSETLENGTH}
+begin
+ if Len>255 then
+ Len:=255;
+ s[0]:=chr(len);
+end;
+
+{$ifdef interncopy}
+function fpc_shortstr_copy(const s : shortstring;index : SizeInt;count : SizeInt): shortstring;compilerproc;
+{$else}
+function copy(const s : shortstring;index : SizeInt;count : SizeInt): shortstring;
+{$endif}
+begin
+ if count<0 then
+ count:=0;
+ if index>1 then
+ dec(index)
+ else
+ index:=0;
+ if index>length(s) then
+ count:=0
+ else
+ if count>length(s)-index then
+ count:=length(s)-index;
+{$ifdef interncopy}
+ fpc_shortstr_Copy[0]:=chr(Count);
+ Move(s[Index+1],fpc_shortstr_Copy[1],Count);
+{$else}
+ Copy[0]:=chr(Count);
+ Move(s[Index+1],Copy[1],Count);
+{$endif}
+end;
+
+
+procedure delete(var s : shortstring;index : SizeInt;count : SizeInt);
+begin
+ if index<=0 then
+ exit;
+ if (Index<=Length(s)) and (Count>0) then
+ begin
+ if Count>length(s)-Index then
+ Count:=length(s)-Index+1;
+ s[0]:=Chr(length(s)-Count);
+ if Index<=Length(s) then
+ Move(s[Index+Count],s[Index],Length(s)-Index+1);
+ end;
+end;
+
+
+procedure insert(const source : shortstring;var s : shortstring;index : SizeInt);
+var
+ cut,srclen,indexlen : longint;
+begin
+ if index<1 then
+ index:=1;
+ if index>length(s) then
+ index:=length(s)+1;
+ indexlen:=Length(s)-Index+1;
+ srclen:=length(Source);
+ if length(source)+length(s)>=sizeof(s) then
+ begin
+ cut:=length(source)+length(s)-sizeof(s)+1;
+ if cut>indexlen then
+ begin
+ dec(srclen,cut-indexlen);
+ indexlen:=0;
+ end
+ else
+ dec(indexlen,cut);
+ end;
+ move(s[Index],s[Index+srclen],indexlen);
+ move(Source[1],s[Index],srclen);
+ s[0]:=chr(index+srclen+indexlen-1);
+end;
+
+
+procedure insert(source : Char;var s : shortstring;index : SizeInt);
+var
+ indexlen : longint;
+begin
+ if index<1 then
+ index:=1;
+ if index>length(s) then
+ index:=length(s)+1;
+ indexlen:=Length(s)-Index+1;
+ if (length(s)+1=sizeof(s)) and (indexlen>0) then
+ dec(indexlen);
+ move(s[Index],s[Index+1],indexlen);
+ s[Index]:=Source;
+ s[0]:=chr(index+indexlen);
+end;
+
+
+function pos(const substr : shortstring;const s : shortstring):SizeInt;
+var
+ i,MaxLen : SizeInt;
+ pc : pchar;
+begin
+ Pos:=0;
+ if Length(SubStr)>0 then
+ begin
+ MaxLen:=Length(s)-Length(SubStr);
+ i:=0;
+ pc:=@s[1];
+ while (i<=MaxLen) do
+ begin
+ inc(i);
+ if (SubStr[1]=pc^) and
+ (CompareChar(Substr[1],pc^,Length(SubStr))=0) then
+ begin
+ Pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ end;
+end;
+
+
+{Faster when looking for a single char...}
+function pos(c:char;const s:shortstring):SizeInt;
+var
+ i : SizeInt;
+ pc : pchar;
+begin
+ pc:=@s[1];
+ for i:=1 to length(s) do
+ begin
+ if pc^=c then
+ begin
+ pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ pos:=0;
+end;
+
+
+{$ifdef interncopy}
+function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
+begin
+ if (index=1) and (Count>0) then
+ fpc_char_Copy:=c
+ else
+ fpc_char_Copy:='';
+end;
+{$else}
+function copy(c:char;index : SizeInt;count : SizeInt): shortstring;
+begin
+ if (index=1) and (Count>0) then
+ Copy:=c
+ else
+ Copy:='';
+end;
+{$endif}
+
+
+function pos(const substr : shortstring;c:char): SizeInt;
+begin
+ if (length(substr)=1) and (substr[1]=c) then
+ Pos:=1
+ else
+ Pos:=0;
+end;
+
+
+{$ifdef IBM_CHAR_SET}
+const
+ UpCaseTbl : shortstring[7]=#154#142#153#144#128#143#165;
+ LoCaseTbl : shortstring[7]=#129#132#148#130#135#134#164;
+{$endif}
+
+function upcase(c : char) : char;
+{$IFDEF IBM_CHAR_SET}
+var
+ i : longint;
+{$ENDIF}
+begin
+ if (c in ['a'..'z']) then
+ upcase:=char(byte(c)-32)
+ else
+{$IFDEF IBM_CHAR_SET}
+ begin
+ i:=Pos(c,LoCaseTbl);
+ if i>0 then
+ upcase:=UpCaseTbl[i]
+ else
+ upcase:=c;
+ end;
+{$ELSE}
+ upcase:=c;
+{$ENDIF}
+end;
+
+
+function upcase(const s : shortstring) : shortstring;
+var
+ i : longint;
+begin
+ upcase[0]:=s[0];
+ for i := 1 to length (s) do
+ upcase[i] := upcase (s[i]);
+end;
+
+
+function lowercase(c : char) : char;overload;
+{$IFDEF IBM_CHAR_SET}
+var
+ i : longint;
+{$ENDIF}
+begin
+ if (c in ['A'..'Z']) then
+ lowercase:=char(byte(c)+32)
+ else
+{$IFDEF IBM_CHAR_SET}
+ begin
+ i:=Pos(c,UpCaseTbl);
+ if i>0 then
+ lowercase:=LoCaseTbl[i]
+ else
+ lowercase:=c;
+ end;
+ {$ELSE}
+ lowercase:=c;
+ {$ENDIF}
+end;
+
+
+function lowercase(const s : shortstring) : shortstring; overload;
+var
+ i : longint;
+begin
+ lowercase [0]:=s[0];
+ for i:=1 to length(s) do
+ lowercase[i]:=lowercase (s[i]);
+end;
+
+
+const
+ HexTbl : array[0..15] of char='0123456789ABCDEF';
+
+function hexstr(val : longint;cnt : byte) : shortstring;
+var
+ i : longint;
+begin
+ hexstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ hexstr[i]:=hextbl[val and $f];
+ val:=val shr 4;
+ end;
+end;
+
+function octstr(val : longint;cnt : byte) : shortstring;
+var
+ i : longint;
+begin
+ octstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ octstr[i]:=hextbl[val and 7];
+ val:=val shr 3;
+ end;
+end;
+
+
+function binstr(val : longint;cnt : byte) : shortstring;
+var
+ i : longint;
+begin
+ binstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ binstr[i]:=char(48+val and 1);
+ val:=val shr 1;
+ end;
+end;
+
+
+function hexstr(val : int64;cnt : byte) : shortstring;
+var
+ i : longint;
+begin
+ hexstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ hexstr[i]:=hextbl[val and $f];
+ val:=val shr 4;
+ end;
+end;
+
+
+function octstr(val : int64;cnt : byte) : shortstring;
+var
+ i : longint;
+begin
+ octstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ octstr[i]:=hextbl[val and 7];
+ val:=val shr 3;
+ end;
+end;
+
+
+function binstr(val : int64;cnt : byte) : shortstring;
+var
+ i : longint;
+begin
+ binstr[0]:=char(cnt);
+ for i:=cnt downto 1 do
+ begin
+ binstr[i]:=char(48+val and 1);
+ val:=val shr 1;
+ end;
+end;
+
+
+function hexstr(val : pointer) : shortstring;
+var
+ i : longint;
+ v : ptrint;
+begin
+ v:=ptrint(val);
+ hexstr[0]:=chr(sizeof(pointer)*2);
+ for i:=sizeof(pointer)*2 downto 1 do
+ begin
+ hexstr[i]:=hextbl[v and $f];
+ v:=v shr 4;
+ end;
+end;
+
+
+function space (b : byte): shortstring;
+begin
+ space[0] := chr(b);
+ FillChar (Space[1],b,' ');
+end;
+
+
+{*****************************************************************************
+ Str() Helpers
+*****************************************************************************}
+
+{$ifdef STR_USES_VALINT}
+procedure fpc_shortstr_SInt(v : valSInt;len : SizeInt;var s : shortstring);[public,alias:'FPC_SHORTSTR_SINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+procedure fpc_shortstr_longint(v : longint;len : SizeInt;var s : shortstring);[public,alias:'FPC_SHORTSTR_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+begin
+ int_str(v,s);
+ if length(s)<len then
+ s:=space(len-length(s))+s;
+end;
+
+{$ifdef STR_USES_VALINT}
+procedure fpc_shortstr_UInt(v : valUInt;len : SizeInt;var s : shortstring);[public,alias:'FPC_SHORTSTR_UINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+ {$ifdef ver1_0}
+ procedure fpc_shortstr_cardinal(v : longword;len : SizeInt;var s : shortstring);[public,alias:'FPC_SHORTSTR_CARDINAL']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ {$else}
+ procedure fpc_shortstr_longword(v : longword;len : SizeInt;var s : shortstring);[public,alias:'FPC_SHORTSTR_LONGWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ {$endif}
+{$endif}
+begin
+ int_str(v,s);
+ if length(s)<len then
+ s:=space(len-length(s))+s;
+end;
+
+{$ifndef CPU64}
+
+ procedure fpc_shortstr_qword(v : qword;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ int_str(v,s);
+ if length(s)<len then
+ s:=space(len-length(s))+s;
+ end;
+
+
+ procedure fpc_shortstr_int64(v : int64;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ begin
+ int_str(v,s);
+ if length(s)<len then
+ s:=space(len-length(s))+s;
+ end;
+
+{$endif CPU64}
+
+
+{ fpc_shortstr_sInt must appear before this file is included, because }
+{ it's used inside real2str.inc and otherwise the searching via the }
+{ compilerproc name will fail (JM) }
+
+{$I real2str.inc}
+
+procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT']; {$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+begin
+ str_real(len,fr,d,treal_type(rt),s);
+end;
+
+
+{
+ Array Of Char Str() helpers
+}
+
+{$ifdef STR_USES_VALINT}
+procedure fpc_chararray_sint(v : valsint;len : SizeInt;var a:array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+procedure fpc_chararray_longint(v : longint;len : SizeInt;var a:array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+var
+ ss : shortstring;
+ maxlen : SizeInt;
+begin
+ int_str(v,ss);
+ if length(ss)<len then
+ ss:=space(len-length(ss))+ss;
+ if length(ss)<high(a)+1 then
+ maxlen:=length(ss)
+ else
+ maxlen:=high(a)+1;
+ move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
+{$ifdef STR_USES_VALINT}
+procedure fpc_chararray_uint(v : valuint;len : SizeInt;var a : array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+procedure fpc_chararray_longword(v : longword;len : SizeInt;var a : array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+var
+ ss : shortstring;
+ maxlen : SizeInt;
+begin
+ int_str(v,ss);
+ if length(ss)<len then
+ ss:=space(len-length(ss))+ss;
+ if length(ss)<high(a)+1 then
+ maxlen:=length(ss)
+ else
+ maxlen:=high(a)+1;
+ move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
+{$ifndef CPU64}
+
+procedure fpc_chararray_qword(v : qword;len : SizeInt;var a : array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ss : shortstring;
+ maxlen : SizeInt;
+begin
+ int_str(v,ss);
+ if length(ss)<len then
+ ss:=space(len-length(ss))+ss;
+ if length(ss)<high(a)+1 then
+ maxlen:=length(ss)
+ else
+ maxlen:=high(a)+1;
+ move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
+procedure fpc_chararray_int64(v : int64;len : SizeInt;var a : array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ss : shortstring;
+ maxlen : SizeInt;
+begin
+ int_str(v,ss);
+ if length(ss)<len then
+ ss:=space(len-length(ss))+ss;
+ if length(ss)<high(a)+1 then
+ maxlen:=length(ss)
+ else
+ maxlen:=high(a)+1;
+ move(ss[1],pchar(@a)^,maxlen);
+end;
+
+{$endif CPU64}
+
+
+procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;var a : array of char);{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+var
+ ss : shortstring;
+ maxlen : SizeInt;
+begin
+ str_real(len,fr,d,treal_type(rt),ss);
+ if length(ss)<high(a)+1 then
+ maxlen:=length(ss)
+ else
+ maxlen:=high(a)+1;
+ move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
+{*****************************************************************************
+ Val() Functions
+*****************************************************************************}
+
+Function InitVal(const s:shortstring;var negativ:boolean;var base:byte):ValSInt;
+var
+ Code : SizeInt;
+begin
+{Skip Spaces and Tab}
+ code:=1;
+ while (code<=length(s)) and (s[code] in [' ',#9]) do
+ inc(code);
+{Sign}
+ negativ:=false;
+ case s[code] of
+ '-' : begin
+ negativ:=true;
+ inc(code);
+ end;
+ '+' : inc(code);
+ end;
+{Base}
+ base:=10;
+ if code<=length(s) then
+ begin
+ case s[code] of
+ '$' : begin
+ base:=16;
+ inc(code);
+ end;
+ '%' : begin
+ base:=2;
+ inc(code);
+ end;
+ '&' : begin
+ Base:=8;
+ inc(code);
+ end;
+ '0' : begin
+ if (code < length(s)) and (s[code+1] in ['x', 'X']) then
+ begin
+ inc(code, 2);
+ base := 16;
+ end;
+ end;
+ end;
+ end;
+ { strip leading zeros }
+ while ((code < length(s)) and (s[code] = '0')) do begin
+ inc(code);
+ end;
+ InitVal:=code;
+end;
+
+
+Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; var Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ u, temp, prev, maxPrevValue, maxNewValue: ValUInt;
+ base : byte;
+ negative : boolean;
+begin
+ fpc_Val_SInt_ShortStr := 0;
+ Temp:=0;
+ Code:=InitVal(s,negative,base);
+ if Code>length(s) then
+ exit;
+ maxPrevValue := ValUInt(MaxUIntValue) div ValUInt(Base);
+ if (base = 10) then
+ maxNewValue := MaxSIntValue + ord(negative)
+ else
+ maxNewValue := MaxUIntValue;
+ while Code<=Length(s) do
+ begin
+ case s[Code] of
+ '0'..'9' : u:=Ord(S[Code])-Ord('0');
+ 'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
+ 'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+ else
+ u:=16;
+ end;
+ Prev := Temp;
+ Temp := Temp*ValUInt(base);
+ If (u >= base) or
+ (ValUInt(maxNewValue-u) < Temp) or
+ (prev > maxPrevValue) Then
+ Begin
+ fpc_Val_SInt_ShortStr := 0;
+ Exit
+ End;
+ Temp:=Temp+u;
+ inc(code);
+ end;
+ code := 0;
+ fpc_Val_SInt_ShortStr := ValSInt(Temp);
+ If Negative Then
+ fpc_Val_SInt_ShortStr := -fpc_Val_SInt_ShortStr;
+ If Not(Negative) and (base <> 10) Then
+ {sign extend the result to allow proper range checking}
+ Case DestSize of
+ 1: fpc_Val_SInt_ShortStr := shortint(fpc_Val_SInt_ShortStr);
+ 2: fpc_Val_SInt_ShortStr := smallint(fpc_Val_SInt_ShortStr);
+{ Uncomment the folling once full 64bit support is in place
+ 4: fpc_Val_SInt_ShortStr := SizeInt(fpc_Val_SInt_ShortStr);}
+ End;
+end;
+
+{ we need this for fpc_Val_SInt_Ansistr and fpc_Val_SInt_WideStr because }
+{ we have to pass the DestSize parameter on (JM) }
+Function int_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; var Code: ValSInt): ValSInt; [external name 'FPC_VAL_SINT_SHORTSTR'];
+
+
+Function fpc_Val_UInt_Shortstr(Const S: ShortString; var Code: ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ u, prev : ValUInt;
+ base : byte;
+ negative : boolean;
+begin
+ fpc_Val_UInt_Shortstr:=0;
+ Code:=InitVal(s,negative,base);
+ If Negative or (Code>length(s)) Then
+ Exit;
+ while Code<=Length(s) do
+ begin
+ case s[Code] of
+ '0'..'9' : u:=Ord(S[Code])-Ord('0');
+ 'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
+ 'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+ else
+ u:=16;
+ end;
+ prev := fpc_Val_UInt_Shortstr;
+ If (u>=base) or
+ (ValUInt(MaxUIntValue-u) div ValUInt(Base)<prev) then
+ begin
+ fpc_Val_UInt_Shortstr:=0;
+ exit;
+ end;
+ fpc_Val_UInt_Shortstr:=fpc_Val_UInt_Shortstr*ValUInt(base) + u;
+ inc(code);
+ end;
+ code := 0;
+end;
+
+
+{$ifndef CPU64}
+
+ Function fpc_val_int64_shortstr(Const S: ShortString; var Code: ValSInt): Int64; [public, alias:'FPC_VAL_INT64_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ type
+ QWordRec = packed record
+ l1,l2: longint;
+ end;
+
+ var
+ u, temp, prev, maxint64, maxqword : qword;
+ base : byte;
+ negative : boolean;
+
+ begin
+ fpc_val_int64_shortstr := 0;
+ Temp:=0;
+ Code:=InitVal(s,negative,base);
+ if Code>length(s) then
+ exit;
+ { high(int64) produces 0 in version 1.0 (JM) }
+ with qwordrec(maxint64) do
+ begin
+{$ifdef ENDIAN_LITTLE}
+ l1 := longint($ffffffff);
+ l2 := $7fffffff;
+{$else ENDIAN_LITTLE}
+ l1 := $7fffffff;
+ l2 := longint($ffffffff);
+{$endif ENDIAN_LITTLE}
+ end;
+ with qwordrec(maxqword) do
+ begin
+ l1 := longint($ffffffff);
+ l2 := longint($ffffffff);
+ end;
+
+ while Code<=Length(s) do
+ begin
+ case s[Code] of
+ '0'..'9' : u:=Ord(S[Code])-Ord('0');
+ 'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
+ 'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+ else
+ u:=16;
+ end;
+ Prev:=Temp;
+ Temp:=Temp*Int64(base);
+ If (u >= base) or
+ ((base = 10) and
+ (maxint64-temp+ord(negative) < u)) or
+ ((base <> 10) and
+ (qword(maxqword-temp) < u)) or
+ (prev > maxqword div qword(base)) Then
+ Begin
+ fpc_val_int64_shortstr := 0;
+ Exit
+ End;
+ Temp:=Temp+u;
+ inc(code);
+ end;
+ code:=0;
+ fpc_val_int64_shortstr:=int64(Temp);
+ If Negative Then
+ fpc_val_int64_shortstr:=-fpc_val_int64_shortstr;
+ end;
+
+
+ Function fpc_val_qword_shortstr(Const S: ShortString; var Code: ValSInt): QWord; [public, alias:'FPC_VAL_QWORD_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ type qwordrec = packed record
+ l1,l2: longint;
+ end;
+ var
+ u, prev, maxqword: QWord;
+ base : byte;
+ negative : boolean;
+ begin
+ fpc_val_qword_shortstr:=0;
+ Code:=InitVal(s,negative,base);
+ If Negative or (Code>length(s)) Then
+ Exit;
+ with qwordrec(maxqword) do
+ begin
+ l1 := longint($ffffffff);
+ l2 := longint($ffffffff);
+ end;
+ while Code<=Length(s) do
+ begin
+ case s[Code] of
+ '0'..'9' : u:=Ord(S[Code])-Ord('0');
+ 'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
+ 'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+ else
+ u:=16;
+ end;
+ prev := fpc_val_qword_shortstr;
+ If (u>=base) or
+ ((QWord(maxqword-u) div QWord(base))<prev) then
+ Begin
+ fpc_val_qword_shortstr := 0;
+ Exit
+ End;
+ fpc_val_qword_shortstr:=fpc_val_qword_shortstr*QWord(base) + u;
+ inc(code);
+ end;
+ code := 0;
+ end;
+
+{$endif CPU64}
+
+
+Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ hd,
+ esign,sign : valreal;
+ exponent,i : SizeInt;
+ flags : byte;
+begin
+ fpc_Val_Real_ShortStr:=0.0;
+ code:=1;
+ exponent:=0;
+ esign:=1;
+ flags:=0;
+ sign:=1;
+ while (code<=length(s)) and (s[code] in [' ',#9]) do
+ inc(code);
+ case s[code] of
+ '+' : inc(code);
+ '-' : begin
+ sign:=-1;
+ inc(code);
+ end;
+ end;
+ while (Code<=Length(s)) and (s[code] in ['0'..'9']) do
+ begin
+ { Read integer part }
+ flags:=flags or 1;
+
+fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*10+(ord(s[code])-ord('0'));
+ inc(code);
+ end;
+{ Decimal ? }
+ if (length(s)>=code) and (s[code]='.') then
+ begin
+ hd:=1.0;
+ inc(code);
+ while (length(s)>=code) and (s[code] in ['0'..'9']) do
+ begin
+ { Read fractional part. }
+ flags:=flags or 2;
+ fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*10+(ord(s[code])-ord('0'));
+ hd:=hd*10.0;
+ inc(code);
+ end;
+ fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd;
+ end;
+ { Again, read integer and fractional part}
+ if flags=0 then
+ begin
+ fpc_Val_Real_ShortStr:=0.0;
+ exit;
+ end;
+ { Exponent ? }
+ if (length(s)>=code) and (upcase(s[code])='E') then
+ begin
+ inc(code);
+ if Length(s) >= code then
+ if s[code]='+' then
+ inc(code)
+ else
+ if s[code]='-' then
+ begin
+ esign:=-1;
+ inc(code);
+ end;
+ if (length(s)<code) or not(s[code] in ['0'..'9']) then
+ begin
+ fpc_Val_Real_ShortStr:=0.0;
+ exit;
+ end;
+ while (length(s)>=code) and (s[code] in ['0'..'9']) do
+ begin
+ exponent:=exponent*10;
+ exponent:=exponent+ord(s[code])-ord('0');
+ inc(code);
+ end;
+ end;
+{ Calculate Exponent }
+{
+ if esign>0 then
+ for i:=1 to exponent do
+ fpc_Val_Real_ShortStr:=Val_Real_ShortStr*10
+ else
+ for i:=1 to exponent do
+ fpc_Val_Real_ShortStr:=Val_Real_ShortStr/10; }
+ hd:=1.0;
+ for i:=1 to exponent do
+ hd:=hd*10.0;
+ if esign>0 then
+ fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*hd
+ else
+ fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd;
+{ Not all characters are read ? }
+ if length(s)>=code then
+ begin
+ fpc_Val_Real_ShortStr:=0.0;
+ exit;
+ end;
+{ evaluate sign }
+ fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*sign;
+{ success ! }
+ code:=0;
+end;
+
+
+Procedure SetString (Var S : Shortstring; Buf : PChar; Len : SizeInt);
+begin
+ If Len > High(S) then
+ Len := High(S);
+ SetLength(S,Len);
+ If Buf<>Nil then
+ begin
+ Move (Buf[0],S[1],Len);
+ end;
+end;
+
+{
+ $Log: sstrings.inc,v $
+ Revision 1.36 2005/04/02 07:57:38 florian
+ + 0x is now recognized as hex prefix
+
+ Revision 1.35 2005/03/20 12:45:19 michael
+ + Patch from Colin Western to fix uninitialized memory reads
+
+ Revision 1.34 2005/02/25 12:34:46 peter
+ * added HexStr(Pointer)
+
+ Revision 1.33 2005/02/14 17:13:27 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/stdsock.inc b/rtl/inc/stdsock.inc
new file mode 100644
index 0000000000..6f06f11444
--- /dev/null
+++ b/rtl/inc/stdsock.inc
@@ -0,0 +1,120 @@
+{
+ $Id: stdsock.inc,v 1.4 2005/02/14 17:13:28 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$define uselibc:=cdecl; external;}
+
+const libname='c';
+
+function cfpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint; cdecl; external libname name 'accept';
+function cfpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint; cdecl; external libname name 'bind';
+function cfpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint; cdecl; external libname name 'connect';
+function cfpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint; cdecl; external libname name 'getpeername';
+function cfpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint; cdecl; external libname name 'getsockname';
+function cfpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint; cdecl; external libname name 'getsockopt';
+function cfplisten (s:cint; backlog : cint):cint; cdecl; external libname name 'listen';
+function cfprecv (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t; cdecl; external libname name 'recv';
+function cfprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t; cdecl; external libname name 'recvfrom';
+//function cfprecvmsg (s:cint; msg: pmsghdr; flags:cint):ssize_t; cdecl; external libname name '';
+function cfpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t; cdecl; external libname name 'send';
+function cfpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t; cdecl; external libname name 'sendto';
+//function cfpsendmsg (s:cint; hdr: pmsghdr; flags:cint):ssize; cdecl; external libname name '';
+function cfpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint; cdecl; external libname name 'setsockopt';
+function cfpshutdown (s:cint; how:cint):cint; cdecl; external libname name 'shutdown';
+function cfpsocket (domain:cint; xtype:cint; protocol: cint):cint; cdecl; external libname name 'socket';
+function cfpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint; cdecl; external libname name 'socketpair';
+
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+
+begin
+ fpaccept:=cfpaccept(s,addrx,addrlen);
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+ fpbind:=cfpbind (s,addrx,addrlen);
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+begin
+ fpconnect:=cfpconnect (s,name,namelen);
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpgetpeername:=cfpgetpeername (s,name,namelen);
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpgetsockname:=cfpgetsockname(s,name,namelen);
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpgetsockopt:=cfpgetsockopt(s,level,optname,optval,optlen);
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+begin
+ fplisten:=cfplisten(s,backlog);
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+ fprecv:= cfprecv (s,buf,len,flags);
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+ fprecvfrom:= cfprecvfrom (s,buf,len,flags,from,fromlen);
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpsend:=cfpsend (s,msg,len,flags);
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ fpsendto:=cfpsendto (s,msg,len,flags,tox,tolen);
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
+begin
+ fpsetsockopt:=cfpsetsockopt(s,level,optname,optval,optlen);
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpshutdown:=cfpshutdown(s,how);
+end;
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+ fpsocket:=cfpsocket(domain,xtype,protocol);
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+ fpsocketpair:=cfpsocketpair(d,xtype,protocol,sv);
+end;
+
+{
+ $Log: stdsock.inc,v $
+ Revision 1.4 2005/02/14 17:13:28 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/strings.pp b/rtl/inc/strings.pp
new file mode 100644
index 0000000000..e22abfd4e7
--- /dev/null
+++ b/rtl/inc/strings.pp
@@ -0,0 +1,152 @@
+{
+ $Id: strings.pp,v 1.10 2005/02/14 17:13:28 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Strings unit for PChar (asciiz/C compatible strings) handling
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit strings;
+{$S-}
+interface
+
+ { Implemented in System Unit }
+ function strpas(p:pchar):shortstring;external name 'FPC_PCHAR_TO_SHORTSTR';
+ function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
+
+ { Converts a Pascal string to a null-terminated string }
+ function strpcopy(d : pchar;const s : string) : pchar;
+
+ { Copies source to dest, returns a pointer to dest }
+ function strcopy(dest,source : pchar) : pchar;
+
+ { Copies at most maxlen bytes from source to dest. }
+ { Returns a pointer to dest }
+ function strlcopy(dest,source : pchar;maxlen : SizeInt) : pchar;
+
+ { Copies source to dest and returns a pointer to the terminating }
+ { null character. }
+ function strecopy(dest,source : pchar) : pchar;
+
+ { Returns a pointer tro the terminating null character of p }
+ function strend(p : pchar) : pchar;
+
+ { Appends source to dest, returns a pointer do dest}
+ function strcat(dest,source : pchar) : pchar;
+
+ { Compares str1 und str2, returns }
+ { a value <0 if str1<str2; }
+ { 0 when str1=str2 }
+ { and a value >0 if str1>str2 }
+ function strcomp(str1,str2 : pchar) : SizeInt;
+
+ { The same as strcomp, but at most l characters are compared }
+ function strlcomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
+
+ { The same as strcomp but case insensitive }
+ function stricomp(str1,str2 : pchar) : SizeInt;
+
+ { Copies l characters from source to dest, returns dest. }
+ function strmove(dest,source : pchar;l : SizeInt) : pchar;
+
+ { Appends at most l characters from source to dest }
+ function strlcat(dest,source : pchar;l : SizeInt) : pchar;
+
+ { Returns a pointer to the first occurrence of c in p }
+ { If c doesn't occur, nil is returned }
+ function strscan(p : pchar;c : char) : pchar;
+
+ { Returns a pointer to the last occurrence of c in p }
+ { If c doesn't occur, nil is returned }
+ function strrscan(p : pchar;c : char) : pchar;
+
+ { converts p to all-lowercase, returns p }
+ function strlower(p : pchar) : pchar;
+
+ { converts p to all-uppercase, returns p }
+ function strupper(p : pchar) : pchar;
+
+ { The same al stricomp, but at most l characters are compared }
+ function strlicomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
+
+ { Returns a pointer to the first occurrence of str2 in }
+ { str2 Otherwise returns nil }
+ function strpos(str1,str2 : pchar) : pchar;
+
+ { Makes a copy of p on the heap, and returns a pointer to this copy }
+ function strnew(p : pchar) : pchar;
+
+ { Allocates L bytes on the heap, returns a pchar pointer to it }
+ function stralloc(L : SizeInt) : pchar;
+
+ { Releases a null-terminated string from the heap }
+ procedure strdispose(p : pchar);
+
+implementation
+
+{$ifdef FPC_USE_LIBC}
+{$i cgenstr.inc}
+{$endif FPC_USE_LIBC}
+
+{ Read Processor dependent part, shared with sysutils unit }
+{$i strings.inc }
+
+{ Read processor denpendent part, NOT shared with sysutils unit }
+{$i stringss.inc }
+
+{ Read generic string functions that are not implemented for the processor }
+{$i genstr.inc}
+{$i genstrs.inc}
+
+{ Functions not in assembler, but shared with sysutils unit }
+{$i stringsi.inc}
+
+{ Functions, different from the one in sysutils }
+
+ function stralloc(L : SizeInt) : pchar;
+
+ begin
+ StrAlloc:=Nil;
+ GetMem (Stralloc,l);
+ end;
+
+ function strnew(p : pchar) : pchar;
+
+ var
+ len : SizeInt;
+
+ begin
+ strnew:=nil;
+ if (p=nil) or (p^=#0) then
+ exit;
+ len:=strlen(p)+1;
+ getmem(strnew,len);
+ if strnew<>nil then
+ strmove(strnew,p,len);
+ end;
+
+ procedure strdispose(p : pchar);
+
+ begin
+ if p<>nil then
+ begin
+ freemem(p);
+ p:=nil;
+ end;
+ end;
+
+end.
+
+{
+ $Log: strings.pp,v $
+ Revision 1.10 2005/02/14 17:13:28 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/stringsi.inc b/rtl/inc/stringsi.inc
new file mode 100644
index 0000000000..84e9d8a469
--- /dev/null
+++ b/rtl/inc/stringsi.inc
@@ -0,0 +1,72 @@
+{
+ $Id: stringsi.inc,v 1.7 2005/02/14 17:13:29 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor independent part for strings and sysutils units
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ function strcat(dest,source : pchar) : pchar;
+
+ begin
+ strcopy(strend(dest),source);
+ strcat:=dest;
+ end;
+
+ function strlcat(dest,source : pchar;l : SizeInt) : pchar;
+
+ var
+ destend : pchar;
+
+ begin
+ destend:=strend(dest);
+ dec(l,destend-dest);
+ if l>0 then
+ strlcopy(destend,source,l);
+ strlcat:=dest;
+ end;
+
+ function strmove(dest,source : pchar;l : SizeInt) : pchar;
+
+ begin
+ move(source^,dest^,l);
+ strmove:=dest;
+ end;
+
+
+ function strpos(str1,str2 : pchar) : pchar;
+ var
+ p : pchar;
+ lstr2 : SizeInt;
+ begin
+ strpos:=nil;
+ p:=strscan(str1,str2^);
+ if p=nil then
+ exit;
+ lstr2:=strlen(str2);
+ while p<>nil do
+ begin
+ if strlcomp(p,str2,lstr2)=0 then
+ begin
+ strpos:=p;
+ exit;
+ end;
+ inc(p);
+ p:=strscan(p,str2^);
+ end;
+ end;
+
+{
+ $Log: stringsi.inc,v $
+ Revision 1.7 2005/02/14 17:13:29 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/system.fpd b/rtl/inc/system.fpd
new file mode 100644
index 0000000000..dce69f1189
--- /dev/null
+++ b/rtl/inc/system.fpd
@@ -0,0 +1,53 @@
+{
+ $Id: system.fpd,v 1.1 2004/11/22 22:48:10 michael Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This File contains extra, phony declarations used in fpdoc.
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function Addr (X : TAnytype) : Pointer;
+Procedure Assert(Expr : Boolean);
+Procedure Assert(Expr : Boolean; const Msg : string);
+Function Assigned (P : Pointer) : Boolean;
+Procedure Break;
+Function Concat (Const S1,S2,S3,Sn : String) : String;
+Procedure Continue;
+Procedure Dec(Var X : TOrdinal);
+Procedure Dec(Var X : TOrdinal; Decrement : TOrdinal);
+Procedure Dispose (P : Pointer);
+Procedure Dispose (P : TypedPointer; Des : TProcedure);
+Procedure Exclude (Var S : TSetType; E : TSetElement);
+Procedure Exit(Const X : TAnyType);
+Procedure Exit;
+Function High (Arg: TypeOrVariable) : TOrdinal;
+Procedure Inc (Var X : TOrdinal);
+Procedure Inc (Var X : TOrdinal; Increment : TOrdinal);
+Procedure Include (Var S : TSetType; E : TSetElement);
+Function Low (Arg: TypeOrVariable) : TOrdinal;
+Procedure New (Var P : Pointer);
+Procedure New (Var P : Pointer; Cons : TProcedure);
+Function Ofs (Var X) : Longint;
+Function Ord (X : TOrdinal) : Longint;
+Function Pred (X : TOrdinal) : TOrdinal;
+Procedure Read (Var F : Text; Args : Arguments);
+Procedure ReadLn (Var F : Text; Args : Arguments);
+Procedure Read (Args : Arguments);
+Procedure ReadLn (Args : Arguments);
+Function Seg (Var X) : Longint;
+Function SizeOf (X : TAnyType) : Longint;
+Procedure Str (Var X : TNumericType; Var S : String);
+Function Succ (X : TOrdinal) : TOrdinal;
+Procedure Val (const S : string;Var V;var Code : word);
+Procedure Write (Args : Arguments);
+Procedure Writeln (Args : Arguments);
+Procedure Write (Var F : Text; Args : Arguments);
+Procedure WriteLn (Var F : Text; Args : Arguments);
diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
new file mode 100644
index 0000000000..8da795380a
--- /dev/null
+++ b/rtl/inc/system.inc
@@ -0,0 +1,1076 @@
+{
+ $Id: system.inc,v 1.78 2005/03/25 22:53:39 jonas Exp $
+
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ For details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ Local types
+****************************************************************************}
+
+{
+ TextRec and FileRec are put in a separate file to make it available to other
+ units without putting it explicitly in systemh.
+ This way we keep TP compatibility, and the TextRec definition is available
+ for everyone who needs it.
+}
+{$i filerec.inc}
+{$i textrec.inc}
+
+Procedure HandleError (Errno : Longint); forward;
+Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
+
+type
+ FileFunc = Procedure(var t : TextRec);
+
+
+const
+ STACK_MARGIN = 16384; { Stack size margin for stack checking }
+{ Random / Randomize constants }
+ OldRandSeed : Cardinal = 0;
+
+{ For Error Handling.}
+ ErrorBase : Pointer = nil;
+
+{ Used by the ansistrings and maybe also other things in the future }
+var
+ emptychar : char;public name 'FPC_EMPTYCHAR';
+ initialstklen : longint;external name '__stklen';
+
+
+{****************************************************************************
+ Routines which have compiler magic
+****************************************************************************}
+
+{$ifndef INTERNCONSTINTF}
+Function lo(i : Integer) : byte; [INTERNPROC: fpc_in_lo_Word];
+Function lo(w : Word) : byte; [INTERNPROC: fpc_in_lo_Word];
+Function lo(l : Longint) : Word; [INTERNPROC: fpc_in_lo_long];
+Function lo(l : DWord) : Word; [INTERNPROC: fpc_in_lo_long];
+Function hi(i : Integer) : byte; [INTERNPROC: fpc_in_hi_Word];
+Function hi(w : Word) : byte; [INTERNPROC: fpc_in_hi_Word];
+Function hi(l : Longint) : Word; [INTERNPROC: fpc_in_hi_long];
+Function hi(l : DWord) : Word; [INTERNPROC: fpc_in_hi_long];
+
+Function lo(q : QWord) : DWord; [INTERNPROC: fpc_in_lo_qword];
+Function lo(i : Int64) : DWord; [INTERNPROC: fpc_in_lo_qword];
+Function hi(q : QWord) : DWord; [INTERNPROC: fpc_in_hi_qword];
+Function hi(i : Int64) : DWord; [INTERNPROC: fpc_in_hi_qword];
+
+Function chr(b : byte) : Char; [INTERNPROC: fpc_in_chr_byte];
+{$ifndef INTERNLENGTH}
+Function Length(s : string) : byte; [INTERNPROC: fpc_in_Length_string];
+Function Length(c : char) : byte; [INTERNPROC: fpc_in_Length_string];
+{$endif INTERNLENGTH}
+
+Procedure Reset(var f : TypedFile); [INTERNPROC: fpc_in_Reset_TypedFile];
+Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
+{$endif INTERNCONSTINTF}
+
+
+{****************************************************************************
+ Include processor specific routines
+****************************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+{ prefer libc implementations over our own, as they're most likely faster }
+{$i cgeneric.inc}
+{ is now declared as external reference to another routine in the interface }
+{$i cgenstr.inc}
+{$endif FPC_USE_LIBC}
+
+{$ifdef cpui386}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i i386.inc} { Case dependent, don't change }
+{$endif cpui386}
+
+{$ifdef cpum68k}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i m68k.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpum68k}
+
+{$ifdef cpux86_64}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i x86_64.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpux86_64}
+
+{$ifdef cpupowerpc}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i powerpc.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpupowerpc}
+
+{$ifdef cpualpha}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i alpha.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpualpha}
+
+{$ifdef cpuiA64}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i ia64.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpuiA64}
+
+{$ifdef cpusparc}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i sparc.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpusparc}
+
+{$ifdef cpuarm}
+ {$ifdef SYSPROCDEFINED}
+ {$Error Can't determine processor type !}
+ {$endif}
+ {$i arm.inc} { Case dependent, don't change }
+ {$define SYSPROCDEFINED}
+{$endif cpuarm}
+
+procedure fillchar(var x;count : SizeInt;value : boolean);{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ fillchar(x,count,byte(value));
+end;
+
+procedure fillchar(var x;count : SizeInt;value : char);{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ fillchar(x,count,byte(value));
+end;
+
+{ Include generic pascal only routines which are not defined in the processor
+ specific include file }
+{$I generic.inc}
+
+
+{****************************************************************************
+ Set Handling
+****************************************************************************}
+
+{ Include set support which is processor specific}
+{$i set.inc}
+{ Include generic pascal routines for sets if the processor }
+{ specific routines are not available. }
+{$i genset.inc}
+
+
+{****************************************************************************
+ Math Routines
+****************************************************************************}
+
+function Hi(b : byte): byte;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ Hi := b shr 4
+end;
+
+function Lo(b : byte): byte;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ Lo := b and $0f
+end;
+
+Function swap (X : Word) : Word;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_swap_word];{$endif}
+Begin
+ swap:=(X and $ff) shl 8 + (X shr 8)
+End;
+
+Function Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_swap_word];{$endif}
+Begin
+ swap:=(X and $ff) shl 8 + (X shr 8)
+End;
+
+Function swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_swap_long];{$endif}
+Begin
+ Swap:=(X and $ffff) shl 16 + (X shr 16)
+End;
+
+Function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_swap_long];{$endif}
+Begin
+ Swap:=(X and $ffff) shl 16 + (X shr 16)
+End;
+
+Function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_swap_qword];{$endif}
+Begin
+ Swap:=(X and $ffffffff) shl 32 + (X shr 32);
+End;
+
+Function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_swap_qword];{$endif}
+Begin
+ Swap:=(X and $ffffffff) shl 32 + (X shr 32);
+End;
+
+{$ifdef SUPPORT_DOUBLE}
+operator := (b:real48) d:double;
+begin
+ D:=real2double(b);
+end;
+{$endif SUPPORT_DOUBLE}
+
+{$ifdef SUPPORT_EXTENDED}
+operator := (b:real48) e:extended;
+begin
+ e:=real2double(b);
+end;
+{$endif SUPPORT_EXTENDED}
+
+{$ifdef FPC_USE_LIBC}
+{ Include libc versions }
+{$i cgenmath.inc}
+{$endif FPC_USE_LIBC}
+{ Include processor specific routines }
+{$I math.inc}
+{ Include generic version }
+{$I genmath.inc}
+
+
+{****************************************************************************
+ Subroutines for String handling
+****************************************************************************}
+
+{ Needs to be before RTTI handling }
+
+{$i sstrings.inc}
+
+{ requires sstrings.inc for initval }
+{$I int64p.inc}
+{$I int64.inc}
+
+{Requires int64.inc, since that contains the VAL functions for int64 and qword}
+{$i astrings.inc}
+
+{$ifdef HASWIDESTRING}
+{$i wstrings.inc}
+{$endif HASWIDESTRING}
+
+{$i aliases.inc}
+
+{*****************************************************************************
+ Dynamic Array support
+*****************************************************************************}
+
+{$i dynarr.inc}
+
+{*****************************************************************************
+ Object Pascal support
+*****************************************************************************}
+
+{$i objpas.inc}
+
+{*****************************************************************************
+ Variant support
+*****************************************************************************}
+
+{$ifdef HASVARIANT}
+{$i variant.inc}
+{$endif HASVARIANT}
+{****************************************************************************
+ Run-Time Type Information (RTTI)
+****************************************************************************}
+
+{$i rtti.inc}
+
+
+
+{----------------------------------------------------------------------
+ Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
+ Pseudo-Random Number Generator.
+
+ What is Mersenne Twister?
+ Mersenne Twister(MT) is a pseudorandom number generator developped by
+ Makoto Matsumoto and Takuji Nishimura (alphabetical order) during
+ 1996-1997. MT has the following merits:
+ It is designed with consideration on the flaws of various existing
+ generators.
+ Far longer period and far higher order of equidistribution than any
+ other implemented generators. (It is proved that the period is 2^19937-1,
+ and 623-dimensional equidistribution property is assured.)
+ Fast generation. (Although it depends on the system, it is reported that
+ MT is sometimes faster than the standard ANSI-C library in a system
+ with pipeline and cache memory.)
+ Efficient use of the memory. (The implemented C-code mt19937.c
+ consumes only 624 words of working area.)
+
+ home page
+ http://www.math.keio.ac.jp/~matumoto/emt.html
+ original c source
+ http://www.math.keio.ac.jp/~nisimura/random/int/mt19937int.c
+
+ Coded by Takuji Nishimura, considering the suggestions by
+ Topher Cooper and Marc Rieffel in July-Aug. 1997.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later
+ version.
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+ See the GNU Library General Public License for more details.
+ You should have received a copy of the GNU Library General
+ Public License along with this library; if not, write to the
+ Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA
+
+ Copyright (C) 1997, 1999 Makoto Matsumoto and Takuji Nishimura.
+ When you use this, send an email to: matumoto@math.keio.ac.jp
+ with an appropriate reference to your work.
+
+ REFERENCE
+ M. Matsumoto and T. Nishimura,
+ "Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
+ Pseudo-Random Number Generator",
+ ACM Transactions on Modeling and Computer Simulation,
+ Vol. 8, No. 1, January 1998, pp 3--30.
+
+
+ Translated to OP and Delphi interface added by Roman Krejci (6.12.1999)
+
+ http://www.rksolution.cz/delphi/tips.htm
+
+ Revised 21.6.2000: Bug in the function RandInt_MT19937 fixed
+
+ 2003/10/26: adapted to use the improved intialisation mentioned at
+ <http://www.math.keio.ac.jp/~matumoto/MT2002/emt19937ar.html> and
+ removed the assembler code
+
+ ----------------------------------------------------------------------}
+
+{$R-} {range checking off}
+{$Q-} {overflow checking off}
+
+{ Period parameter }
+Const
+ MT19937N=624;
+
+Type
+ tMT19937StateArray = array [0..MT19937N-1] of longint; // the array for the state vector
+
+{ Period parameters }
+const
+ MT19937M=397;
+ MT19937MATRIX_A =$9908b0df; // constant vector a
+ MT19937UPPER_MASK=$80000000; // most significant w-r bits
+ MT19937LOWER_MASK=$7fffffff; // least significant r bits
+
+{ Tempering parameters }
+ TEMPERING_MASK_B=$9d2c5680;
+ TEMPERING_MASK_C=$efc60000;
+
+
+VAR
+ mt : tMT19937StateArray;
+
+const
+ mti: longint=MT19937N+1; // mti=MT19937N+1 means mt[] is not initialized
+
+{ Initializing the array with a seed }
+procedure sgenrand_MT19937(seed: longint);
+var
+ i: longint;
+begin
+ mt[0] := seed;
+ for i := 1 to MT19937N-1 do
+ begin
+ mt[i] := 1812433253 * (mt[i-1] xor (mt[i-1] shr 30)) + i;
+ { See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. }
+ { In the previous versions, MSBs of the seed affect }
+ { only MSBs of the array mt[]. }
+ { 2002/01/09 modified by Makoto Matsumoto }
+ end;
+ mti := MT19937N;
+end;
+
+
+function genrand_MT19937: longint;
+const
+ mag01 : array [0..1] of longint =(0, longint(MT19937MATRIX_A));
+var
+ y: longint;
+ kk: longint;
+begin
+ if (mti >= MT19937N) or
+ (randseed <> oldrandseed) { generate MT19937N longints at one time }
+ then begin
+ if mti = (MT19937N+1) then // if sgenrand_MT19937() has not been called,
+ begin
+ sgenrand_MT19937(randseed); // default initial seed is used
+ { hack: randseed is not used more than once in this algorithm. Most }
+ { user changes are re-initialising reandseed with the value it had }
+ { at the start -> with the "not", we will detect this change. }
+ { Detecting other changes is not useful, since the generated }
+ { numbers will be different anyway. }
+ randseed := not(randseed);
+ oldrandseed := randseed;
+ end;
+ for kk:=0 to MT19937N-MT19937M-1 do begin
+ y := (mt[kk] and MT19937UPPER_MASK) or (mt[kk+1] and MT19937LOWER_MASK);
+ mt[kk] := mt[kk+MT19937M] xor (y shr 1) xor mag01[y and $00000001];
+ end;
+ for kk:= MT19937N-MT19937M to MT19937N-2 do begin
+ y := (mt[kk] and MT19937UPPER_MASK) or (mt[kk+1] and MT19937LOWER_MASK);
+ mt[kk] := mt[kk+(MT19937M-MT19937N)] xor (y shr 1) xor mag01[y and $00000001];
+ end;
+ y := (mt[MT19937N-1] and MT19937UPPER_MASK) or (mt[0] and MT19937LOWER_MASK);
+ mt[MT19937N-1] := mt[MT19937M-1] xor (y shr 1) xor mag01[y and $00000001];
+ mti := 0;
+ end;
+ y := mt[mti]; inc(mti);
+ y := y xor (y shr 11);
+ y := y xor (y shl 7) and TEMPERING_MASK_B;
+ y := y xor (y shl 15) and TEMPERING_MASK_C;
+ y := y xor (y shr 18);
+ Result := y;
+end;
+
+
+function random(l:longint): longint;
+begin
+ random := longint((int64(cardinal(genrand_MT19937))*l) shr 32);
+end;
+
+function random(l:int64): int64;
+begin
+{$ifndef VER1_0}
+ random := int64((qword(cardinal(genrand_MT19937)) or ((qword(cardinal(genrand_MT19937)) shl 32))) and $7fffffffffffffff) mod l;
+{$endif VER1_0}
+end;
+
+function random: extended;
+begin
+ random := cardinal(genrand_MT19937) * (1.0/(int64(1) shl 32));
+end;
+
+{****************************************************************************
+ Memory Management
+****************************************************************************}
+
+Function Ptr(sel,off : Longint) : farpointer;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_ptr];{$endif}
+Begin
+ ptr:=farpointer((sel shl 4)+off);
+End;
+
+Function CSeg : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+ Cseg:=0;
+End;
+
+Function DSeg : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+ Dseg:=0;
+End;
+
+Function SSeg : Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+ Sseg:=0;
+End;
+
+
+{*****************************************************************************
+ Directory support.
+*****************************************************************************}
+
+Procedure getdir(drivenr:byte;Var dir:ansistring);
+{ this is needed to also allow ansistrings, the shortstring version is
+ OS dependent }
+var
+ s : shortstring;
+begin
+ getdir(drivenr,s);
+ dir:=s;
+end;
+
+{$ifopt R+}
+{$define RangeCheckWasOn}
+{$R-}
+{$endif opt R+}
+
+{$ifopt I+}
+{$define IOCheckWasOn}
+{$I-}
+{$endif opt I+}
+
+{$ifopt Q+}
+{$define OverflowCheckWasOn}
+{$Q-}
+{$endif opt Q+}
+
+{*****************************************************************************
+ Miscellaneous
+*****************************************************************************}
+
+procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ HandleErrorFrame(201,get_frame);
+end;
+
+procedure fpc_divbyzero;[public,alias:'FPC_DIVBYZERO']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ HandleErrorFrame(200,get_frame);
+end;
+
+procedure fpc_overflow;[public,alias:'FPC_OVERFLOW']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ HandleErrorFrame(215,get_frame);
+end;
+
+
+procedure fpc_iocheck;{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias:'FPC_IOCHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ l : longint;
+begin
+ if InOutRes<>0 then
+ begin
+ l:=InOutRes;
+ InOutRes:=0;
+ HandleErrorFrame(l,get_frame);
+ end;
+end;
+
+
+Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+ IOResult:=InOutRes;
+ InOutRes:=0;
+End;
+
+Function GetThreadID:SizeUInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+(* ThreadID is stored in a threadvar and made available in interface *)
+(* to allow setup of this value during thread initialization. *)
+ GetThreadID := ThreadID;
+end;
+
+{*****************************************************************************
+ Stack check code
+*****************************************************************************}
+
+{$IFNDEF NO_GENERIC_STACK_CHECK}
+
+{$IFOPT S+}
+{$DEFINE STACKCHECK}
+{$ENDIF}
+{$S-}
+procedure fpc_stackcheck(stack_size:Cardinal);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public,alias:'FPC_STACKCHECK'];
+var
+ c : Pointer;
+begin
+ { Avoid recursive calls when called from the exit routines }
+ if StackError then
+ exit;
+ c := Sptr - (stack_size + STACK_MARGIN);
+ if (c <= StackBottom) then
+ begin
+ StackError:=true;
+ HandleError(202);
+ end;
+end;
+{$IFDEF STACKCHECK}
+{$S+}
+{$ENDIF}
+{$UNDEF STACKCHECK}
+
+{$ENDIF NO_GENERIC_STACK_CHECK}
+
+{*****************************************************************************
+ Initialization / Finalization
+*****************************************************************************}
+
+const
+ maxunits=1024; { See also files.pas of the compiler source }
+type
+ TInitFinalRec=record
+ InitProc,
+ FinalProc : TProcedure;
+ end;
+ TInitFinalTable=record
+ TableCount,
+ InitCount : longint;
+ Procs : array[1..maxunits] of TInitFinalRec;
+ end;
+
+var
+ InitFinalTable : TInitFinalTable;external name 'INITFINAL';
+
+procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ i : longint;
+begin
+ { call cpu/fpu initialisation routine }
+ fpc_cpuinit;
+ with InitFinalTable do
+ begin
+ for i:=1 to TableCount do
+ begin
+ if assigned(Procs[i].InitProc) then
+ Procs[i].InitProc();
+ InitCount:=i;
+ end;
+ end;
+ if assigned(InitProc) then
+ TProcedure(InitProc)();
+end;
+
+
+procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
+begin
+ with InitFinalTable do
+ begin
+ while (InitCount>0) do
+ begin
+ // we've to decrement the cound before calling the final. code
+ // else a halt in the final. code leads to a endless loop
+ dec(InitCount);
+ if assigned(Procs[InitCount+1].FinalProc) then
+ Procs[InitCount+1].FinalProc();
+ end;
+ end;
+end;
+
+{*****************************************************************************
+ Error / Exit / ExitProc
+*****************************************************************************}
+
+Procedure system_exit;forward;
+
+Procedure InternalExit;
+var
+ current_exit : Procedure;
+Begin
+ while exitProc<>nil Do
+ Begin
+ InOutRes:=0;
+ current_exit:=tProcedure(exitProc);
+ exitProc:=nil;
+ current_exit();
+ End;
+ { Finalize units }
+ FinalizeUnits;
+ { Show runtime error and exit }
+ If erroraddr<>nil Then
+ Begin
+ Writeln(stdout,'Runtime error ',Errorcode,' at $',hexstr(PtrInt(Erroraddr),sizeof(PtrInt)*2));
+ { to get a nice symify }
+ Writeln(stdout,BackTraceStrFunc(Erroraddr));
+ dump_stack(stdout,ErrorBase);
+ Writeln(stdout,'');
+ End;
+End;
+
+
+Procedure do_exit;[Public,Alias:'FPC_DO_EXIT'];
+begin
+ InternalExit;
+ System_exit;
+end;
+
+
+Procedure lib_exit;{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_LIB_EXIT'];
+begin
+ InternalExit;
+end;
+
+
+Procedure Halt(ErrNum: Byte);
+Begin
+ ExitCode:=Errnum;
+ Do_Exit;
+end;
+
+
+function SysBackTraceStr (Addr: Pointer): ShortString;
+begin
+ SysBackTraceStr:=' $'+HexStr(Ptrint(addr),sizeof(PtrInt)*2);
+end;
+
+
+Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer);[public,alias:'FPC_BREAK_ERROR'];
+begin
+ If pointer(ErrorProc)<>Nil then
+ ErrorProc(Errno,addr,frame);
+ errorcode:=word(Errno);
+ erroraddr:=addr;
+ errorbase:=frame;
+ if errorcode <= maxExitCode then
+ halt(errorcode)
+ else
+ halt(255)
+end;
+
+Procedure HandleErrorFrame (Errno : longint;frame : Pointer);
+{
+ Procedure to handle internal errors, i.e. not user-invoked errors
+ Internal function should ALWAYS call HandleError instead of RunError.
+ Can be used for exception handlers to specify the frame
+}
+begin
+ HandleErrorAddrFrame(Errno,get_caller_addr(frame),get_caller_frame(frame));
+end;
+
+
+Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
+{
+ Procedure to handle internal errors, i.e. not user-invoked errors
+ Internal function should ALWAYS call HandleError instead of RunError.
+}
+begin
+ HandleErrorFrame(Errno,get_frame);
+end;
+
+
+procedure RunError(w : word);[alias: 'FPC_RUNERROR'];
+begin
+ errorcode:=w;
+ erroraddr:=get_caller_addr(get_frame);
+ errorbase:=get_caller_frame(get_frame);
+ if errorcode <= maxExitCode then
+ halt(errorcode)
+ else
+ halt(255)
+end;
+
+
+Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+ RunError (0);
+End;
+
+
+Procedure Halt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Begin
+ Halt(0);
+End;
+
+
+function do_isdevice(handle:thandle):boolean;forward;
+
+Procedure dump_stack(var f : text;bp : Pointer);
+var
+ i : Longint;
+ prevbp : Pointer;
+ is_dev : boolean;
+ caller_frame,
+ caller_addr : Pointer;
+Begin
+ prevbp:=bp-1;
+ i:=0;
+ is_dev:=do_isdevice(textrec(f).Handle);
+ while bp > prevbp Do
+ Begin
+ caller_addr := get_caller_addr(bp);
+ caller_frame := get_caller_frame(bp);
+ if (caller_addr=nil) or
+ (caller_frame=nil) then
+ break;
+ Writeln(f,BackTraceStrFunc(caller_addr));
+ Inc(i);
+ If ((i>max_frame_dump) and is_dev) or (i>256) Then
+ break;
+ prevbp:=bp;
+ bp:=caller_frame;
+ End;
+End;
+
+
+Type
+ PExitProcInfo = ^TExitProcInfo;
+ TExitProcInfo = Record
+ Next : PExitProcInfo;
+ SaveExit : Pointer;
+ Proc : TProcedure;
+ End;
+const
+ ExitProcList: PExitProcInfo = nil;
+
+Procedure DoExitProc;
+var
+ P : PExitProcInfo;
+ Proc : TProcedure;
+Begin
+ P:=ExitProcList;
+ ExitProcList:=P^.Next;
+ ExitProc:=P^.SaveExit;
+ Proc:=P^.Proc;
+ DisPose(P);
+ Proc();
+End;
+
+
+Procedure AddExitProc(Proc: TProcedure);
+var
+ P : PExitProcInfo;
+Begin
+ New(P);
+ P^.Next:=ExitProcList;
+ P^.SaveExit:=ExitProc;
+ P^.Proc:=Proc;
+ ExitProcList:=P;
+ ExitProc:=@DoExitProc;
+End;
+
+function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
+// Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?)
+// Note: for internal use by skilled programmers only
+// if "s" goes out of scope in the parent procedure, the pointer is dangling.
+
+var p : ppchar;
+ i : LongInt;
+begin
+ if High(s)<Low(s) Then Exit(NIL);
+ Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2)); // one more for NIL, one more
+ // for cmd
+ if p=nil then
+ begin
+ {$ifdef xunix}
+ fpseterrno(ESysEnomem);
+ {$endif}
+ exit(NIL);
+ end;
+ for i:=low(s) to high(s) do
+ p[i+Reserveentries]:=pchar(s[i]);
+ p[high(s)+1+Reserveentries]:=nil;
+ ArrayStringToPPchar:=p;
+end;
+
+Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+}
+
+begin
+ StringToPPChar:=StringToPPChar(PChar(S),ReserveEntries);
+end;
+
+Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
+
+var
+ i,nr : longint;
+ Buf : ^char;
+ p : ppchar;
+
+begin
+ buf:=s;
+ nr:=1;
+ while (buf^<>#0) do // count nr of args
+ begin
+ while (buf^ in [' ',#9,#10]) do // Kill separators.
+ inc(buf);
+ inc(nr);
+ if buf^='"' Then // quotes argument?
+ begin
+ inc(buf);
+ while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+ inc(buf);
+ if buf^='"' then // skip closing quote.
+ inc(buf);
+ end
+ else
+ begin // else std
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+ end;
+ getmem(p,(ReserveEntries+nr)*sizeof(pchar));
+ StringToPPChar:=p;
+ if p=nil then
+ begin
+ {$ifdef xunix}
+ fpseterrno(ESysEnomem);
+ {$endif}
+ exit;
+ end;
+ for i:=1 to ReserveEntries do inc(p); // skip empty slots
+ buf:=s;
+ while (buf^<>#0) do
+ begin
+ while (buf^ in [' ',#9,#10]) do // Kill separators.
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ if buf^='"' Then // quotes argument?
+ begin
+ inc(buf);
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+ inc(buf);
+ if buf^='"' then // skip closing quote.
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ end
+ else
+ begin
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+ end;
+end;
+
+
+
+
+{*****************************************************************************
+ Abstract/Assert support.
+*****************************************************************************}
+
+procedure fpc_AbstractErrorIntern;{$ifdef hascompilerproc}compilerproc;{$endif}[public,alias : 'FPC_ABSTRACTERROR'];
+begin
+ If pointer(AbstractErrorProc)<>nil then
+ AbstractErrorProc();
+ HandleErrorFrame(211,get_frame);
+end;
+
+
+Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [Public,Alias : 'FPC_ASSERT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if pointer(AssertErrorProc)<>nil then
+ AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
+ else
+ HandleErrorFrame(227,get_frame);
+end;
+
+
+Procedure SysAssert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer);
+begin
+ If msg='' then
+ write(stderr,'Assertion failed')
+ else
+ write(stderr,msg);
+ Writeln(stderr,' (',FName,', line ',LineNo,').');
+ Writeln(stderr,'');
+ Halt(227);
+end;
+
+
+{*****************************************************************************
+ SetJmp/LongJmp support.
+*****************************************************************************}
+
+{$i setjump.inc}
+
+
+{$ifdef IOCheckWasOn}
+{$I+}
+{$endif}
+
+{$ifdef RangeCheckWasOn}
+{$R+}
+{$endif}
+
+{$ifdef OverflowCheckWasOn}
+{$Q+}
+{$endif}
+
+
+{*****************************************************************************
+ OS dependent Helpers/Syscalls
+*****************************************************************************}
+
+{$i sysos.inc}
+
+
+{*****************************************************************************
+ Heap
+*****************************************************************************}
+
+{$i sysheap.inc}
+
+{$i heap.inc}
+
+{*****************************************************************************
+ Thread support
+*****************************************************************************}
+
+{ Generic threadmanager }
+{$i thread.inc}
+
+{ Generic threadvar support }
+{$i threadvr.inc}
+
+{ OS Dependent implementation }
+{$i systhrd.inc}
+
+
+{*****************************************************************************
+ File Handling
+*****************************************************************************}
+
+{ OS dependent low level file functions }
+{$i sysfile.inc}
+
+{ Text file }
+{$i text.inc}
+
+{ Untyped file }
+{$i file.inc}
+
+{ Typed file }
+{$i typefile.inc}
+
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+{ OS dependent dir functions }
+{$i sysdir.inc}
+
+
+{
+ $Log: system.inc,v $
+ Revision 1.78 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.77 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.76 2005/02/08 20:25:28 florian
+ - killed power from system unit
+ * move operator ** to math unit
+
+ Revision 1.75 2005/02/06 20:35:54 florian
+ + InitProc
+
+ Revision 1.74 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.73 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.72 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
new file mode 100644
index 0000000000..70293dfe7a
--- /dev/null
+++ b/rtl/inc/systemh.inc
@@ -0,0 +1,811 @@
+{
+ $Id: systemh.inc,v 1.122 2005/04/03 19:29:28 florian Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This File contains the OS independent declarations of the system unit
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ Needed switches
+****************************************************************************}
+
+{$I-,Q-,H-,R-,V-}
+{$mode objfpc}
+
+{ Using inlining for small system functions/wrappers }
+{$ifdef HASINLINE}
+ {$inline on}
+ {$define SYSTEMINLINE}
+{$endif}
+
+{ Use threadvars when the compiler supports it }
+{$ifdef HASTHREADVAR}
+ {$define SUPPORT_THREADVAR}
+{$endif HASTHREADVAR}
+
+{ don't use FPU registervariables on the i386 }
+{$ifdef CPUI386}
+ {$maxfpuregisters 0}
+{$endif CPUI386}
+
+{ the assembler helpers need this }
+{$ifdef POWERPC}
+ {$goto+}
+{$endif POWERPC}
+
+
+{ needed for insert,delete,readln }
+{$P+}
+{ stack checking always disabled
+ for system unit. This is because
+ the startup code might not
+ have been called yet when we
+ get a stack error, this will
+ cause big crashes
+}
+{$S-}
+
+{****************************************************************************
+ Global Types and Constants
+****************************************************************************}
+
+Type
+{$Ifdef HAS_INTERNAL_INTTYPES}
+ { The compiler has all integer types defined internally. Here
+ we define only aliases }
+ DWord = LongWord;
+ Cardinal = LongWord;
+ Integer = SmallInt;
+{$else HAS_INTERNAL_INTTYPES}
+ ShortInt = -128..127;
+ SmallInt = -32768..32767;
+ { can't use -2147483648 because of a bug in 1.0.2's val() procedure (JM) }
+ Longint = +(-2147483647-1)..$7fffffff;
+ Byte = 0..255;
+ Word = 0..65535;
+ {$ifndef ver1_0}
+ DWord = LongWord;
+ Cardinal = LongWord;
+ {$else}
+ Longword = cardinal;
+ Dword = cardinal;
+ {$endif}
+ Integer = SmallInt;
+{$endif HAS_INTERNAL_INTTYPES}
+
+{$ifdef CPUI386}
+ { for bootstrapping with 1.0.x }
+ {$define CPU32}
+
+ {$define DEFAULT_EXTENDED}
+
+ {$define SUPPORT_SINGLE}
+ {$define SUPPORT_DOUBLE}
+ {$define SUPPORT_EXTENDED}
+ {$define SUPPORT_COMP}
+
+ ValReal = Extended;
+{$endif CPUI386}
+
+{$ifdef CPUX86_64}
+ {$define DEFAULT_EXTENDED}
+
+ {$define SUPPORT_SINGLE}
+ {$define SUPPORT_DOUBLE}
+ {$define SUPPORT_EXTENDED}
+ {$define SUPPORT_COMP}
+
+ ValReal = Extended;
+{$endif CPUX86_64}
+
+{$ifdef CPUM68K}
+ ValReal = Real;
+
+ {$define SUPPORT_SINGLE}
+ {$IFDEF Unix}
+ { Linux FPU emulator will be used }
+ {$define SUPPORT_DOUBLE}
+ {$ENDIF}
+ {$IFOPT E-}
+ { If not compiling with emulation }
+ { then support double type. }
+ {$define SUPPORT_DOUBLE}
+ {$ENDIF}
+ { Comp type does not exist on fpu }
+ Comp = int64;
+ PComp = ^Comp;
+
+{$ifdef FPC_HASNOFARPOINTER}
+ FarPointer = Pointer;
+{$endif FPC_HASNOFARPOINTER}
+{$endif CPUM68K}
+
+{$ifdef CPUPOWERPC}
+ {$define DEFAULT_DOUBLE}
+
+ {$define SUPPORT_SINGLE}
+ {$define SUPPORT_DOUBLE}
+
+ {$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+
+ ValReal = Double;
+
+ { map comp to int64, but this doesn't mean we compile the comp support in! }
+ Comp = Int64;
+ PComp = ^Comp;
+
+{$ifdef FPC_HASNOFARPOINTER}
+ FarPointer = Pointer;
+{$endif FPC_HASNOFARPOINTER}
+{$endif CPUPOWERPC}
+
+{$ifdef CPUSPARC}
+ {$define DEFAULT_DOUBLE}
+
+ {$define SUPPORT_SINGLE}
+ {$define SUPPORT_DOUBLE}
+
+ {$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+
+ ValReal = Double;
+
+ { map comp to int64, but this doesn't mean we compile the comp support in! }
+ Comp = Int64;
+ PComp = ^Comp;
+
+{$ifdef FPC_HASNOFARPOINTER}
+ FarPointer = Pointer;
+{$endif FPC_HASNOFARPOINTER}
+{$endif CPUSPARC}
+
+{$ifdef CPUARM}
+ {$define DEFAULT_DOUBLE}
+
+ {$define SUPPORT_SINGLE}
+ {$define SUPPORT_DOUBLE}
+
+ {$define FPC_INCLUDE_SOFTWARE_MOD_DIV}
+ {$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
+ {$define FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE}
+
+ ValReal = Real;
+
+ { map comp to int64, but this doesn't mean we compile the comp support in! }
+ Comp = Int64;
+ PComp = ^Comp;
+
+{$ifdef FPC_HASNOFARPOINTER}
+ FarPointer = Pointer;
+{$endif FPC_HASNOFARPOINTER}
+{$endif CPUARM}
+
+{$ifdef CPU64}
+ SizeInt = Int64;
+ SizeUInt = QWord;
+ PtrInt = Int64;
+ PtrUInt = QWord;
+ ValSInt = int64;
+ ValUInt = qword;
+{$endif CPU64}
+
+{$ifdef CPU32}
+ SizeInt = Longint;
+ SizeUInt = DWord;
+ PtrInt = Longint;
+ PtrUInt = DWord;
+ ValSInt = Longint;
+ ValUInt = Cardinal;
+{$endif CPU32}
+
+{ Zero - terminated strings }
+ PChar = ^Char;
+ PPChar = ^PChar;
+
+ { AnsiChar is equivalent of Char, so we need
+ to use type renamings }
+ TAnsiChar = Char;
+ AnsiChar = Char;
+ PAnsiChar = PChar;
+ PPAnsiChar = PPChar;
+
+ UCS4Char = type LongWord;
+ PUCS4Char = ^UCS4Char;
+ TUCS4CharArray = array[0..$effffff] of UCS4Char;
+ PUCS4CharArray = ^TUCS4CharArray;
+{$ifndef VER1_0}
+ UCS4String = array of UCS4Char;
+{$endif VER1_0}
+
+ UTF8String = type ansistring;
+ PUTF8String = ^UTF8String;
+
+{$ifndef HASCURRENCY}
+ Currency = Int64;
+{$endif HASCURRENCY}
+ HRESULT = type Longint;
+ TDateTime = type Double;
+ Error = type Longint;
+
+ PSingle = ^Single;
+ PDouble = ^Double;
+ PCurrency = ^Currency;
+{$ifdef SUPPORT_COMP}
+ PComp = ^Comp;
+{$endif SUPPORT_COMP}
+ PExtended = ^Extended;
+
+ PSmallInt = ^Smallint;
+ PShortInt = ^Shortint;
+ PInteger = ^Integer;
+ PByte = ^Byte;
+ PWord = ^word;
+ PDWord = ^DWord;
+ PLongWord = ^LongWord;
+ PLongint = ^Longint;
+ PCardinal = ^Cardinal;
+ PQWord = ^QWord;
+ PInt64 = ^Int64;
+ PPtrInt = ^PtrInt;
+ PSizeInt = ^SizeInt;
+
+ PPointer = ^Pointer;
+ PPPointer = ^PPointer;
+
+ PBoolean = ^Boolean;
+ PWordBool = ^WordBool;
+ PLongBool = ^LongBool;
+
+ PShortString = ^ShortString;
+ PAnsiString = ^AnsiString;
+
+ PDate = ^TDateTime;
+ PError = ^Error;
+{$ifdef HASVARIANT}
+ PVariant = ^Variant;
+ POleVariant = ^OleVariant;
+{$endif HASVARIANT}
+
+{$ifdef HASWIDECHAR}
+ PWideChar = ^WideChar;
+ PPWideChar = ^PWideChar;
+ { 1.0.x also has HASWIDECHAR defined, but doesn't support it
+ fully, setting WChar to Word as fallback (PFV) }
+ {$ifndef VER1_0}
+ WChar = Widechar;
+ {$else}
+ WChar = Word;
+ {$endif}
+ UCS2Char = WideChar;
+ PUCS2Char = PWideChar;
+{$else}
+ WChar = Word;
+{$endif HASWIDECHAR}
+{$ifdef HASWIDESTRING}
+ PWideString = ^WideString;
+{$endif HASWIDESTRING}
+
+ { Needed for fpc_get_output }
+ PText = ^Text;
+
+ TTextLineBreakStyle = (tlbsLF,tlbsCRLF,tlbsCR);
+
+{ procedure type }
+ TProcedure = Procedure;
+
+{ platform dependent types }
+{$i sysosh.inc}
+
+
+const
+{ Maximum value of the biggest signed and unsigned integer type available}
+ MaxSIntValue = High(ValSInt);
+ MaxUIntValue = High(ValUInt);
+
+{ max. values for longint and int}
+ maxLongint = $7fffffff;
+ maxSmallint = 32767;
+
+ maxint = maxsmallint;
+
+type
+ IntegerArray = array[0..$effffff] of Integer;
+ PIntegerArray = ^IntegerArray;
+ PointerArray = array [0..512*1024*1024 - 2] of Pointer;
+ PPointerArray = ^PointerArray;
+
+{$ifndef VER1_0}
+ TBoundArray = array of Integer;
+{$endif VER1_0}
+
+ TPCharArray = packed array[0..(MaxLongint div SizeOf(PChar))-1] of PChar;
+ PPCharArray = ^TPCharArray;
+
+const
+{$ifdef cpui386}
+ Test8086 : byte = 2; { Always i386 or newer }
+ Test8087 : byte = 3; { Always 387 or newer. Emulated if needed. }
+{$endif cpui386}
+{$ifdef cpum68k}
+ Test68000 : byte = 0; { Must be determined at startup for both }
+ Test68881 : byte = 0;
+{$endif cpum68k}
+
+{ max level in dumping on error }
+ Max_Frame_Dump : Word = 8;
+
+{ Exit Procedure handling consts and types }
+ ExitProc : pointer = nil;
+ Erroraddr: pointer = nil;
+ Errorcode: Word = 0;
+
+{ file input modes }
+ fmClosed = $D7B0;
+ fmInput = $D7B1;
+ fmOutput = $D7B2;
+ fmInOut = $D7B3;
+ fmAppend = $D7B4;
+ Filemode : byte = 2;
+ CmdLine : PChar = nil;
+(* Value should be changed during system initialization as appropriate. *)
+
+ { assume that this program will not spawn other threads, when the
+ first thread is started the following constants need to be filled }
+ IsMultiThread : boolean = FALSE;
+ { set to true, if a threading helper is used before a thread
+ manager has been installed }
+ ThreadingAlreadyUsed : boolean = FALSE;
+ { Indicates if there was an error }
+ StackError : boolean = FALSE;
+ InitProc : Pointer = nil;
+
+var
+ ExitCode : Word; public name 'operatingsystem_result';
+ RandSeed : Cardinal;
+ { Delphi compatibility }
+ IsLibrary : boolean;
+ IsConsole : boolean;
+ { Threading support }
+ fpc_threadvar_relocate_proc : pointer; public name 'FPC_THREADVAR_RELOCATE';
+
+{$ifdef SUPPORT_THREADVAR}
+ThreadVar
+{$else SUPPORT_THREADVAR}
+Var
+{$endif SUPPORT_THREADVAR}
+ ThreadID : SizeUInt;
+ { Standard In- and Output }
+ ErrOutput,
+ Output,
+ Input,
+ StdOut,
+ StdErr : Text;
+ InOutRes : Word;
+ { Stack checking }
+ StackBottom : Pointer;
+ StackLength : Cardinal;
+
+
+{ Numbers for routines that have compiler magic }
+{$I innr.inc}
+
+
+{****************************************************************************
+ Processor specific routines
+****************************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+{$ifdef SYSTEMINLINE}
+{$define INLINEGENERICS}
+{$endif}
+{$endif}
+
+Procedure Move(const source;var dest;count:SizeInt);{$ifdef INLINEGENERICS}inline;{$endif}
+Procedure FillChar(Var x;count:SizeInt;Value:Boolean);{$ifdef SYSTEMINLINE}inline;{$endif}
+Procedure FillChar(Var x;count:SizeInt;Value:Char);{$ifdef SYSTEMINLINE}inline;{$endif}
+Procedure FillChar(Var x;count:SizeInt;Value:Byte);{$ifdef INLINEGENERICS}inline;{$endif}
+procedure FillByte(var x;count:SizeInt;value:byte);{$ifdef INLINEGENERICS}inline;{$endif}
+Procedure FillWord(Var x;count:SizeInt;Value:Word);
+procedure FillDWord(var x;count:SizeInt;value:DWord);
+function IndexChar(const buf;len:SizeInt;b:char):SizeInt;
+function IndexByte(const buf;len:SizeInt;b:byte):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
+function Indexword(const buf;len:SizeInt;b:word):SizeInt;
+function IndexDWord(const buf;len:SizeInt;b:DWord):SizeInt;
+function CompareChar(const buf1,buf2;len:SizeInt):SizeInt;
+function CompareByte(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
+function CompareWord(const buf1,buf2;len:SizeInt):SizeInt;
+function CompareDWord(const buf1,buf2;len:SizeInt):SizeInt;
+procedure MoveChar0(const buf1;var buf2;len:SizeInt);
+function IndexChar0(const buf;len:SizeInt;b:char):SizeInt;
+function CompareChar0(const buf1,buf2;len:SizeInt):SizeInt;{$ifdef INLINEGENERICS}inline;{$endif}
+procedure prefetch(const mem);{$ifdef INTERNCONSTINTF}[internproc:fpc_in_prefetch_var];{$endif}
+
+
+{****************************************************************************
+ Math Routines
+****************************************************************************}
+
+Function lo(B: Byte):Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function hi(b : Byte) : Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function lo(i : Integer) : byte; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_lo_Word];{$endif}
+Function lo(w : Word) : byte; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_lo_Word];{$endif}
+Function lo(l : Longint) : Word; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_lo_long];{$endif}
+Function lo(l : DWord) : Word; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_lo_long];{$endif}
+Function lo(i : Int64) : DWord; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_lo_qword];{$endif}
+Function lo(q : QWord) : DWord; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_lo_qword];{$endif}
+Function hi(i : Integer) : byte; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_hi_Word];{$endif}
+Function hi(w : Word) : byte; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_hi_Word];{$endif}
+Function hi(l : Longint) : Word; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_hi_long];{$endif}
+Function hi(l : DWord) : Word; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_hi_long];{$endif}
+Function hi(i : Int64) : DWord; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_hi_qword];{$endif}
+Function hi(q : QWord) : DWord; {$ifdef INTERNCONSTINTF}[INTERNPROC: fpc_in_hi_qword];{$endif}
+
+Function swap (X : Word) : Word;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_swap_word];{$endif}
+Function Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_swap_word];{$endif}
+Function swap (X : Longint) : Longint;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_swap_long];{$endif}
+Function Swap (X : Cardinal) : Cardinal;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_swap_long];{$endif}
+Function Swap (X : QWord) : QWord;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_swap_qword];{$endif}
+Function swap (X : Int64) : Int64;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_swap_qword];{$endif}
+
+Function Align (Addr : PtrInt; Alignment : PtrInt) : PtrInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Align (Addr : Pointer; Alignment : PtrInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+Function Random(l:longint):longint;
+Function Random(l:int64):int64;
+Function Random: extended;
+Procedure Randomize;
+
+Function abs(l:Longint):Longint;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function abs(l:Int64):Int64;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function sqr(l:Longint):Longint;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function sqr(l:Int64):Int64;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function sqr(l:QWord):QWord;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function odd(l:Longint):Boolean;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function odd(l:Longword):Boolean;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function odd(l:Int64):Boolean;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function odd(l:QWord):Boolean;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+
+{ float math routines }
+{$I mathh.inc}
+
+{****************************************************************************
+ Addr/Pointer Handling
+****************************************************************************}
+
+Function ptr(sel,off:Longint):farpointer;{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_ptr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Cseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Dseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Sseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+{****************************************************************************
+ PChar and String Handling
+****************************************************************************}
+
+function strpas(p:pchar):shortstring;external name 'FPC_PCHAR_TO_SHORTSTR';
+function strlen(p:pchar):longint;external name 'FPC_PCHAR_LENGTH';
+
+{ Shortstring functions }
+{$ifndef INTERNSETLENGTH}
+Procedure SetLength (Var S:ShortString;len:SizeInt);
+{$endif INTERNSETLENGTH}
+{$ifndef InternCopy}
+Function Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;
+{$endif interncopy}
+Procedure Delete(Var s:shortstring;index:SizeInt;count:SizeInt);
+Procedure Insert(const source:shortstring;Var s:shortstring;index:SizeInt);
+Procedure Insert(source:Char;Var s:shortstring;index:SizeInt);
+Function Pos(const substr:shortstring;const s:shortstring):SizeInt;
+Function Pos(C:Char;const s:shortstring):SizeInt;
+Procedure SetString (Var S : Shortstring; Buf : PChar; Len : SizeInt);
+Procedure SetString (Var S : AnsiString; Buf : PChar; Len : SizeInt);
+{$ifndef INTERNLENGTH}
+Function Length(s:string):byte;
+{$endif INTERNLENGTH}
+Function upCase(const s:shortstring):shortstring;
+Function lowerCase(const s:shortstring):shortstring; overload;
+Function Space(b:byte):shortstring;
+Function hexStr(Val:Longint;cnt:byte):shortstring;
+Function OctStr(Val:Longint;cnt:byte):shortstring;
+Function binStr(Val:Longint;cnt:byte):shortstring;
+Function hexStr(Val:int64;cnt:byte):shortstring;
+Function OctStr(Val:int64;cnt:byte):shortstring;
+Function binStr(Val:int64;cnt:byte):shortstring;
+Function hexStr(Val:Pointer):shortstring;
+
+{ Char functions }
+{$ifdef INTERNCONSTINTF}
+Function chr(b : byte) : Char; [INTERNPROC: fpc_in_chr_byte];
+{$else}
+Function Chr(b:byte):Char;
+{$endif}
+Function upCase(c:Char):Char;
+Function lowerCase(c:Char):Char; overload;
+{$ifndef InternCopy}
+function copy(c:char;index : SizeInt;count : SizeInt): shortstring;
+{$endif interncopy}
+function pos(const substr : shortstring;c:char): SizeInt;
+{$ifndef INTERNLENGTH}
+function length(c:char):byte;
+{$endif INTERNLENGTH}
+
+
+{****************************************************************************
+ AnsiString Handling
+****************************************************************************}
+
+{$ifndef INTERNSETLENGTH}
+Procedure SetLength (Var S : AnsiString; l : SizeInt);
+{$endif INTERNSETLENGTH}
+Procedure UniqueString(Var S : AnsiString);external name 'FPC_ANSISTR_UNIQUE';
+{$ifndef INTERNLENGTH}
+Function Length (Const S : AnsiString) : SizeInt;
+{$endif INTERNLENGTH}
+{$ifndef InternCopy}
+Function Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;
+{$endif interncopy}
+Function Pos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt;
+Function Pos (c : Char; Const s : AnsiString) : SizeInt;
+Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : SizeInt);
+Procedure Delete (Var S : AnsiString; Index,Size: SizeInt);
+Function StringOfChar(c : char;l : SizeInt) : AnsiString;
+function upcase(const s : ansistring) : ansistring;
+function lowercase(const s : ansistring) : ansistring;
+
+
+{****************************************************************************
+ WideString Handling
+****************************************************************************}
+
+{$ifdef HASWIDESTRING}
+{$i wstringh.inc}
+{$endif HASWIDESTRING}
+
+
+{****************************************************************************
+ Untyped File Management
+****************************************************************************}
+
+Procedure Assign(Var f:File;const Name:string);
+Procedure Assign(Var f:File;p:pchar);
+Procedure Assign(Var f:File;c:char);
+Procedure Rewrite(Var f:File;l:Longint);
+Procedure Rewrite(Var f:File);
+Procedure Reset(Var f:File;l:Longint);
+Procedure Reset(Var f:File);
+Procedure Close(Var f:File);
+Procedure BlockWrite(Var f:File;Const Buf;Count:Longint;Var Result:Longint);
+Procedure BlockWrite(Var f:File;Const Buf;Count:Cardinal;var Result:Cardinal);
+Procedure BlockWrite(Var f:File;Const Buf;Count:Word;Var Result:Word);
+Procedure BlockWrite(Var f:File;Const Buf;Count:Word;Var Result:Integer);
+Procedure BlockWrite(Var f:File;Const Buf;Count:Longint);
+Procedure BlockRead(Var f:File;Var Buf;count:Longint;Var Result:Longint);
+Procedure BlockRead(Var f:File;Var Buf;count:Cardinal;Var Result:Cardinal);
+Procedure BlockRead(Var f:File;Var Buf;count:Word;Var Result:Word);
+Procedure BlockRead(Var f:File;Var Buf;count:Word;Var Result:Integer);
+Procedure BlockRead(Var f:File;Var Buf;count:Longint);
+Function FilePos(Var f:File):Longint;
+Function FileSize(Var f:File):Longint;
+Procedure Seek(Var f:File;Pos:Longint);
+Function EOF(Var f:File):Boolean;
+Procedure Erase(Var f:File);
+Procedure Rename(Var f:File;const s:string);
+Procedure Rename(Var f:File;p:pchar);
+Procedure Rename(Var f:File;c:char);
+Procedure Truncate (Var F:File);
+
+
+{****************************************************************************
+ Typed File Management
+****************************************************************************}
+
+Procedure Assign(Var f:TypedFile;const Name:string);
+Procedure Assign(Var f:TypedFile;p:pchar);
+Procedure Assign(Var f:TypedFile;c:char);
+{$ifdef INTERNCONSTINTF}
+Procedure Reset(var f : TypedFile); [INTERNPROC: fpc_in_Reset_TypedFile];
+Procedure Rewrite(var f : TypedFile); [INTERNPROC: fpc_in_Rewrite_TypedFile];
+{$else}
+Procedure Rewrite(Var f:TypedFile);
+Procedure Reset(Var f:TypedFile);
+{$endif}
+
+{****************************************************************************
+ Text File Management
+****************************************************************************}
+
+Procedure Assign(Var t:Text;const s:string);
+Procedure Assign(Var t:Text;p:pchar);
+Procedure Assign(Var t:Text;c:char);
+Procedure Close(Var t:Text);
+Procedure Rewrite(Var t:Text);
+Procedure Reset(Var t:Text);
+Procedure Append(Var t:Text);
+Procedure Flush(Var t:Text);
+Procedure Erase(Var t:Text);
+Procedure Rename(Var t:Text;const s:string);
+Procedure Rename(Var t:Text;p:pchar);
+Procedure Rename(Var t:Text;c:char);
+Function EOF(Var t:Text):Boolean;
+Function EOF:Boolean;
+Function EOLn(Var t:Text):Boolean;
+Function EOLn:Boolean;
+Function SeekEOLn (Var t:Text):Boolean;
+Function SeekEOF (Var t:Text):Boolean;
+Function SeekEOLn:Boolean;
+Function SeekEOF:Boolean;
+Procedure SetTextBuf(Var f:Text; Var Buf);{$ifdef INTERNCONSTINTF}[INTERNPROC:fpc_in_settextbuf_file_x];{$endif}
+Procedure SetTextBuf(Var f:Text; Var Buf; Size:Longint);
+Procedure SetTextLineEnding(Var f:Text; Ending:string);
+
+{****************************************************************************
+ Directory Management
+****************************************************************************}
+
+Procedure chdir(const s:string);
+Procedure mkdir(const s:string);
+Procedure rmdir(const s:string);
+Procedure getdir(drivenr:byte;Var dir:shortstring);
+Procedure getdir(drivenr:byte;Var dir:ansistring);
+
+
+{*****************************************************************************
+ Miscellaneous
+*****************************************************************************}
+
+{ os independent calls to allow backtraces }
+function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Sptr:Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}{$ifdef INTERNCONSTINTF}[internconst:fpc_in_const_ptr];{$endif}
+Function GetProcessID:SizeUInt;
+Function GetThreadID:SizeUInt;
+
+
+{*****************************************************************************
+ Init / Exit / ExitProc
+*****************************************************************************}
+
+Function Paramcount:Longint;
+Function ParamStr(l:Longint):string;
+Procedure Dump_Stack(var f : text;bp:pointer);
+Procedure RunError(w:Word);
+Procedure RunError;{$ifdef SYSTEMINLINE}inline;{$endif}
+Procedure halt(errnum:byte);
+Procedure AddExitProc(Proc:TProcedure);
+Procedure halt;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+{ Need to be exported for threads unit }
+Procedure SysInitExceptions;
+procedure SysInitStdIO;
+Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+{*****************************************************************************
+ Abstract/Assert/Error Handling
+*****************************************************************************}
+
+function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
+Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
+Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
+
+
+procedure AbstractError;external name 'FPC_ABSTRACTERROR';
+Function SysBackTraceStr(Addr:Pointer): ShortString;
+Procedure SysAssert(Const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
+
+{ Error handlers }
+Type
+ TBackTraceStrFunc = Function (Addr: Pointer): ShortString;
+ TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
+ TAbstractErrorProc = Procedure;
+ TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
+
+
+
+const
+ BackTraceStrFunc : TBackTraceStrFunc = @SysBackTraceStr;
+ ErrorProc : TErrorProc = nil;
+ AbstractErrorProc : TAbstractErrorProc = nil;
+ AssertErrorProc : TAssertErrorProc = @SysAssert;
+
+
+{*****************************************************************************
+ SetJmp/LongJmp
+*****************************************************************************}
+
+{$i setjumph.inc}
+
+
+{*****************************************************************************
+ Object Pascal support
+*****************************************************************************}
+
+{$i objpash.inc}
+
+{*****************************************************************************
+ Variant support
+*****************************************************************************}
+
+{$ifdef HASVARIANT}
+{$i varianth.inc}
+{$endif HASVARIANT}
+
+{*****************************************************************************
+ Internal helper routines support
+*****************************************************************************}
+
+{$i dynarrh.inc}
+
+{$i compproc.inc}
+
+{*****************************************************************************
+ Heap
+*****************************************************************************}
+
+{$i heaph.inc}
+
+{*****************************************************************************
+ Thread support
+*****************************************************************************}
+
+{ Generic threadmanager }
+{$i threadh.inc}
+
+
+{*****************************************************************************
+ FPDoc phony declarations.
+*****************************************************************************}
+
+{$ifdef fpdocsystem}
+{$i system.fpd}
+{$endif}
+
+{
+ $Log: systemh.inc,v $
+ Revision 1.122 2005/04/03 19:29:28 florian
+ * proper error message if the cthreads unit is included too late
+ uses clause
+
+ Revision 1.121 2005/02/25 12:34:46 peter
+ * added HexStr(Pointer)
+
+ Revision 1.120 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.119 2005/02/08 20:25:28 florian
+ - killed power from system unit
+ * move operator ** to math unit
+
+ Revision 1.118 2005/02/06 20:37:31 florian
+ * InitProc gets an inital value
+
+ Revision 1.117 2005/02/06 20:35:54 florian
+ + InitProc
+
+ Revision 1.116 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.115 2005/02/05 10:47:38 florian
+ * fixed previous commit
+
+ Revision 1.114 2005/02/05 10:07:21 florian
+ * map farpointer to pointer on platforms not having farpointers
+
+ Revision 1.113 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+ Revision 1.112 2005/01/24 18:03:19 peter
+ * pinteger in non-delphi/objfpc mode is psmallint
+
+}
diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc
new file mode 100644
index 0000000000..a8752244a2
--- /dev/null
+++ b/rtl/inc/text.inc
@@ -0,0 +1,1316 @@
+{
+ $Id: text.inc,v 1.30 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ subroutines For TextFile handling
+****************************************************************************}
+
+Procedure FileCloseFunc(Var t:TextRec);
+Begin
+ Do_Close(t.Handle);
+ t.Handle:=UnusedHandle;
+End;
+
+Procedure FileReadFunc(var t:TextRec);
+Begin
+ t.BufEnd:=Do_Read(t.Handle,t.Bufptr,t.BufSize);
+ t.BufPos:=0;
+End;
+
+
+Procedure FileWriteFunc(var t:TextRec);
+var
+ i : longint;
+Begin
+ i:=Do_Write(t.Handle,t.Bufptr,t.BufPos);
+ if i<>t.BufPos then
+ InOutRes:=101;
+ t.BufPos:=0;
+End;
+
+
+Procedure FileOpenFunc(var t:TextRec);
+var
+ Flags : Longint;
+Begin
+ Case t.mode Of
+ fmInput : Flags:=$10000;
+ fmOutput : Flags:=$11001;
+ fmAppend : Flags:=$10101;
+ else
+ begin
+ InOutRes:=102;
+ exit;
+ end;
+ End;
+ Do_Open(t,PChar(@t.Name),Flags);
+ t.CloseFunc:=@FileCloseFunc;
+ t.FlushFunc:=nil;
+ if t.Mode=fmInput then
+ t.InOutFunc:=@FileReadFunc
+ else
+ begin
+ t.InOutFunc:=@FileWriteFunc;
+ { Only install flushing if its a NOT a file, and only check if there
+ was no error opening the file, becuase else we always get a bad
+ file handle error 6 (PFV) }
+ if (InOutRes=0) and
+ Do_Isdevice(t.Handle) then
+ t.FlushFunc:=@FileWriteFunc;
+ end;
+End;
+
+
+Procedure assign(var t:Text;const s:String);
+Begin
+ FillChar(t,SizeOf(TextRec),0);
+{ only set things that are not zero }
+ TextRec(t).Handle:=UnusedHandle;
+ TextRec(t).mode:=fmClosed;
+ TextRec(t).BufSize:=TextRecBufSize;
+ TextRec(t).Bufptr:=@TextRec(t).Buffer;
+ TextRec(t).OpenFunc:=@FileOpenFunc;
+ TextRec(t).LineEnd:=LineEnding;
+ Move(s[1],TextRec(t).Name,Length(s));
+End;
+
+
+Procedure assign(var t:Text;p:pchar);
+begin
+ Assign(t,StrPas(p));
+end;
+
+
+Procedure assign(var t:Text;c:char);
+begin
+ Assign(t,string(c));
+end;
+
+
+Procedure Close(var t : Text);[IOCheck];
+Begin
+ if InOutRes<>0 then
+ Exit;
+ case TextRec(t).mode of
+ fmInput,fmOutPut,fmAppend:
+ Begin
+ { Write pending buffer }
+ If Textrec(t).Mode=fmoutput then
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ { Only close functions not connected to stdout.}
+ If ((TextRec(t).Handle<>StdInputHandle) and
+ (TextRec(t).Handle<>StdOutputHandle) and
+ (TextRec(t).Handle<>StdErrorHandle)) Then
+ FileFunc(TextRec(t).CloseFunc)(TextRec(t));
+ TextRec(t).mode := fmClosed;
+ { Reset buffer for safety }
+ TextRec(t).BufPos:=0;
+ TextRec(t).BufEnd:=0;
+ End
+ else inOutRes := 103;
+ End;
+End;
+
+
+Procedure OpenText(var t : Text;mode,defHdl:Longint);
+Begin
+ Case TextRec(t).mode Of {This gives the fastest code}
+ fmInput,fmOutput,fmInOut : Close(t);
+ fmClosed : ;
+ else
+ Begin
+ InOutRes:=102;
+ exit;
+ End;
+ End;
+ TextRec(t).mode:=mode;
+ TextRec(t).bufpos:=0;
+ TextRec(t).bufend:=0;
+ FileFunc(TextRec(t).OpenFunc)(TextRec(t));
+ { reset the mode to closed when an error has occured }
+ if InOutRes<>0 then
+ TextRec(t).mode:=fmClosed;
+End;
+
+
+Procedure Rewrite(var t : Text);[IOCheck];
+Begin
+ If InOutRes<>0 then
+ exit;
+ OpenText(t,fmOutput,1);
+End;
+
+
+Procedure Reset(var t : Text);[IOCheck];
+Begin
+ If InOutRes<>0 then
+ exit;
+ OpenText(t,fmInput,0);
+End;
+
+
+Procedure Append(var t : Text);[IOCheck];
+Begin
+ If InOutRes<>0 then
+ exit;
+ OpenText(t,fmAppend,1);
+End;
+
+
+Procedure Flush(var t : Text);[IOCheck];
+Begin
+ If InOutRes<>0 then
+ exit;
+ if TextRec(t).mode<>fmOutput then
+ begin
+ if TextRec(t).mode=fmInput then
+ InOutRes:=105
+ else
+ InOutRes:=103;
+ exit;
+ end;
+{ Not the flushfunc but the inoutfunc should be used, becuase that
+ writes the data, flushfunc doesn't need to be assigned }
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+End;
+
+
+Procedure Erase(var t:Text);[IOCheck];
+Begin
+ If InOutRes <> 0 then
+ exit;
+ If TextRec(t).mode=fmClosed Then
+ Do_Erase(PChar(@TextRec(t).Name));
+End;
+
+
+Procedure Rename(var t : text;p:pchar);[IOCheck];
+Begin
+ If InOutRes <> 0 then
+ exit;
+ If TextRec(t).mode=fmClosed Then
+ Begin
+ Do_Rename(PChar(@TextRec(t).Name),p);
+ { check error code of do_rename }
+ If InOutRes = 0 then
+ Move(p^,TextRec(t).Name,StrLen(p)+1);
+ End;
+End;
+
+
+Procedure Rename(var t : Text;const s : string);[IOCheck];
+var
+ p : array[0..255] Of Char;
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Move(s[1],p,Length(s));
+ p[Length(s)]:=#0;
+ Rename(t,Pchar(@p));
+End;
+
+
+Procedure Rename(var t : Text;c : char);[IOCheck];
+var
+ p : array[0..1] Of Char;
+Begin
+ If InOutRes <> 0 then
+ exit;
+ p[0]:=c;
+ p[1]:=#0;
+ Rename(t,Pchar(@p));
+End;
+
+
+Function Eof(Var t: Text): Boolean;[IOCheck];
+Begin
+ If (InOutRes<>0) then
+ exit(true);
+ if (TextRec(t).mode<>fmInput) Then
+ begin
+ if TextRec(t).mode=fmOutput then
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ exit(true);
+ end;
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ begin
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ exit(true);
+ end;
+ Eof:=CtrlZMarksEOF and (TextRec(t).Bufptr^[TextRec(t).BufPos]=#26);
+end;
+
+
+Function Eof:Boolean;
+Begin
+ Eof:=Eof(Input);
+End;
+
+
+Function SeekEof (Var t : Text) : Boolean;
+var
+ oldfilepos, oldbufpos, oldbufend, reads: longint;
+ isdevice: boolean;
+Begin
+ If (InOutRes<>0) then
+ exit(true);
+ if (TextRec(t).mode<>fmInput) Then
+ begin
+ if TextRec(t).mode=fmOutPut then
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ exit(true);
+ end;
+ { try to save the current position in the file, seekeof() should not move }
+ { the current file position (JM) }
+ oldbufpos := TextRec(t).BufPos;
+ oldbufend := TextRec(t).BufEnd;
+ reads := 0;
+ oldfilepos := -1;
+ isdevice := Do_IsDevice(TextRec(t).handle);
+ repeat
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ begin
+ { signal that the we will have to do a seek }
+ inc(reads);
+ if not isdevice and
+ (reads = 1) then
+ begin
+ oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
+ InOutRes:=0;
+ end;
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ begin
+ { if we only did a read in which we didn't read anything, the }
+ { old buffer is still valid and we can simply restore the }
+ { pointers (JM) }
+ dec(reads);
+ SeekEof := true;
+ break;
+ end;
+ end;
+ case TextRec(t).Bufptr^[TextRec(t).BufPos] of
+ #26 : if CtrlZMarksEOF then
+ begin
+ SeekEof := true;
+ break;
+ end;
+ #10,#13,
+ #9,' ' : ;
+ else
+ begin
+ SeekEof := false;
+ break;
+ end;
+ end;
+ inc(TextRec(t).BufPos);
+ until false;
+ { restore file position if not working with a device }
+ if not isdevice then
+ { if we didn't modify the buffer, simply restore the BufPos and BufEnd }
+ { (the latter becuase it's now probably set to zero because nothing was }
+ { was read anymore) }
+ if (reads = 0) then
+ begin
+ TextRec(t).BufPos:=oldbufpos;
+ TextRec(t).BufEnd:=oldbufend;
+ end
+ { otherwise return to the old filepos and reset the buffer }
+ else
+ begin
+ do_seek(TextRec(t).handle,oldfilepos);
+ InOutRes:=0;
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ TextRec(t).BufPos:=oldbufpos;
+ end;
+End;
+
+
+Function SeekEof : Boolean;
+Begin
+ SeekEof:=SeekEof(Input);
+End;
+
+
+Function Eoln(var t:Text) : Boolean;
+Begin
+ If (InOutRes<>0) then
+ exit(true);
+ if (TextRec(t).mode<>fmInput) Then
+ begin
+ if TextRec(t).mode=fmOutPut then
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ exit(true);
+ end;
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ begin
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ exit(true);
+ end;
+ if CtrlZMarksEOF and (TextRec (T).BufPtr^[TextRec (T).BufPos] = #26) then
+ exit (true);
+ Eoln:=(TextRec(t).Bufptr^[TextRec(t).BufPos] in [#10,#13]);
+End;
+
+
+Function Eoln : Boolean;
+Begin
+ Eoln:=Eoln(Input);
+End;
+
+
+Function SeekEoln (Var t : Text) : Boolean;
+Begin
+ If (InOutRes<>0) then
+ exit(true);
+ if (TextRec(t).mode<>fmInput) Then
+ begin
+ if TextRec(t).mode=fmOutput then
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ exit(true);
+ end;
+ repeat
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ begin
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ If TextRec(t).BufPos>=TextRec(t).BufEnd Then
+ exit(true);
+ end;
+ case TextRec(t).Bufptr^[TextRec(t).BufPos] of
+ #26: if CtrlZMarksEOF then
+ exit (true);
+ #10,#13 : exit(true);
+ #9,' ' : ;
+ else
+ exit(false);
+ end;
+ inc(TextRec(t).BufPos);
+ until false;
+End;
+
+
+Function SeekEoln : Boolean;
+Begin
+ SeekEoln:=SeekEoln(Input);
+End;
+
+
+{$ifndef INTERNCONSTINTF}
+Procedure SetTextBuf(Var F : Text; Var Buf);[INTERNPROC: fpc_In_settextbuf_file_x];
+{$endif}
+
+
+Procedure SetTextBuf(Var F : Text; Var Buf; Size : Longint);
+Begin
+ TextRec(f).BufPtr:=@Buf;
+ TextRec(f).BufSize:=Size;
+ TextRec(f).BufPos:=0;
+ TextRec(f).BufEnd:=0;
+End;
+
+Procedure SetTextLineEnding(Var f:Text; Ending:string);
+Begin
+ TextRec(F).LineEnd:=Ending;
+End;
+
+
+Function fpc_get_input:PText;{$ifdef hascompilerproc}compilerproc;{$endif}
+begin
+ fpc_get_input:=@Input;
+end;
+
+
+Function fpc_get_output:PText;{$ifdef hascompilerproc}compilerproc;{$endif}
+begin
+ fpc_get_output:=@Output;
+end;
+
+
+{*****************************************************************************
+ Write(Ln)
+*****************************************************************************}
+
+Procedure fpc_WriteBuffer(var f:Text;const b;len:longint);[Public,Alias:'FPC_WRITEBUFFER'];
+var
+ p : pchar;
+ left,
+ idx : longint;
+begin
+ p:=pchar(@b);
+ idx:=0;
+ left:=TextRec(f).BufSize-TextRec(f).BufPos;
+ while len>left do
+ begin
+ move(p[idx],TextRec(f).Bufptr^[TextRec(f).BufPos],left);
+ dec(len,left);
+ inc(idx,left);
+ inc(TextRec(f).BufPos,left);
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ left:=TextRec(f).BufSize-TextRec(f).BufPos;
+ end;
+ move(p[idx],TextRec(f).Bufptr^[TextRec(f).BufPos],len);
+ inc(TextRec(f).BufPos,len);
+end;
+
+
+Procedure fpc_WriteBlanks(var f:Text;len:longint);[Public,Alias:'FPC_WRITEBLANKS'];
+var
+ left : longint;
+begin
+ left:=TextRec(f).BufSize-TextRec(f).BufPos;
+ while len>left do
+ begin
+ FillChar(TextRec(f).Bufptr^[TextRec(f).BufPos],left,' ');
+ dec(len,left);
+ inc(TextRec(f).BufPos,left);
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ left:=TextRec(f).BufSize-TextRec(f).BufPos;
+ end;
+ FillChar(TextRec(f).Bufptr^[TextRec(f).BufPos],len,' ');
+ inc(TextRec(f).BufPos,len);
+end;
+
+
+Procedure fpc_Write_End(var f:Text);[Public,Alias:'FPC_WRITE_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if TextRec(f).FlushFunc<>nil then
+ FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+end;
+
+
+Procedure fpc_Writeln_End(var f:Text);[Public,Alias:'FPC_WRITELN_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ If InOutRes <> 0 then exit;
+ case TextRec(f).mode of
+ fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+ begin
+ { Write EOL }
+ fpc_WriteBuffer(f,TextRec(f).LineEnd[1],length(TextRec(f).LineEnd));
+ { Flush }
+ if TextRec(f).FlushFunc<>nil then
+ FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+ end;
+ fmInput: InOutRes:=105
+ else InOutRes:=103;
+ end;
+end;
+
+
+Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ If (InOutRes<>0) then
+ exit;
+ case TextRec(f).mode of
+ fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+ begin
+ If Len>Length(s) Then
+ fpc_WriteBlanks(f,Len-Length(s));
+ fpc_WriteBuffer(f,s[1],Length(s));
+ end;
+ fmInput: InOutRes:=105
+ else InOutRes:=103;
+ end;
+End;
+
+{ provide local access to write_str }
+procedure Write_Str(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR'];
+
+
+Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ArrayLen : longint;
+ p : pchar;
+Begin
+ If (InOutRes<>0) then
+ exit;
+ case TextRec(f).mode of
+ fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+ begin
+ p:=pchar(@s);
+ { can't use StrLen, since that one could try to read past the end }
+ { of the heap (JM) }
+ ArrayLen:=IndexByte(p^,high(s)+1,0);
+ { IndexByte returns -1 if not found (JM) }
+ if ArrayLen = -1 then
+ ArrayLen := high(s)+1;
+ If Len>ArrayLen Then
+ fpc_WriteBlanks(f,Len-ArrayLen);
+ fpc_WriteBuffer(f,p^,ArrayLen);
+ end;
+ fmInput: InOutRes:=105
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_POINTER']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ PCharLen : longint;
+Begin
+ If (p=nil) or (InOutRes<>0) then
+ exit;
+ case TextRec(f).mode of
+ fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+ begin
+ PCharLen:=StrLen(p);
+ If Len>PCharLen Then
+ fpc_WriteBlanks(f,Len-PCharLen);
+ fpc_WriteBuffer(f,p^,PCharLen);
+ end;
+ fmInput: InOutRes:=105
+ else InOutRes:=103;
+ end;
+End;
+
+
+Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; S : AnsiString); iocheck; [Public,alias:'FPC_WRITE_TEXT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Writes a AnsiString to the Text file T
+}
+var
+ SLen : longint;
+begin
+ If (InOutRes<>0) then
+ exit;
+ case TextRec(f).mode of
+ fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+ begin
+ SLen:=Length(s);
+ If Len>SLen Then
+ fpc_WriteBlanks(f,Len-SLen);
+ if slen > 0 then
+ fpc_WriteBuffer(f,PChar(S)^,SLen);
+ end;
+ fmInput: InOutRes:=105
+ else InOutRes:=103;
+ end;
+end;
+
+
+{$ifdef HASWIDESTRING}
+Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; S : WideString); iocheck; [Public,alias:'FPC_WRITE_TEXT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Writes a WideString to the Text file T
+}
+var
+ SLen : longint;
+begin
+ If (pointer(S)=nil) or (InOutRes<>0) then
+ exit;
+ case TextRec(f).mode of
+ fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
+ begin
+ SLen:=Length(s);
+ If Len>SLen Then
+ fpc_WriteBlanks(f,Len-SLen);
+ fpc_WriteBuffer(f,PChar(AnsiString(S))^,SLen);
+ end;
+ fmInput: InOutRes:=105
+ else InOutRes:=103;
+ end;
+end;
+{$endif HASWIDESTRING}
+
+Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s : String;
+Begin
+ If (InOutRes<>0) then
+ exit;
+ Str(l,s);
+ Write_Str(Len,t,s);
+End;
+
+
+Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); iocheck; [Public,Alias:'FPC_WRITE_TEXT_UINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s : String;
+Begin
+ If (InOutRes<>0) then
+ exit;
+ Str(L,s);
+ Write_Str(Len,t,s);
+End;
+
+
+{$ifndef CPU64}
+
+procedure fpc_write_text_qword(len : longint;var t : text;q : qword); iocheck; [public,alias:'FPC_WRITE_TEXT_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s : string;
+begin
+ if (InOutRes<>0) then
+ exit;
+ str(q,s);
+ write_str(len,t,s);
+end;
+
+procedure fpc_write_text_int64(len : longint;var t : text;i : int64); iocheck; [public,alias:'FPC_WRITE_TEXT_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s : string;
+begin
+ if (InOutRes<>0) then
+ exit;
+ str(i,s);
+ write_str(len,t,s);
+end;
+
+{$endif CPU64}
+
+Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); iocheck; [Public,Alias:'FPC_WRITE_TEXT_FLOAT']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ s : String;
+Begin
+ If (InOutRes<>0) then
+ exit;
+ Str_real(Len,fixkomma,r,treal_type(rt),s);
+ Write_Str(Len,t,s);
+End;
+
+
+Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); iocheck; [Public,Alias:'FPC_WRITE_TEXT_BOOLEAN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ If (InOutRes<>0) then
+ exit;
+{ Can't use array[boolean] because b can be >0 ! }
+ if b then
+ Write_Str(Len,t,'TRUE')
+ else
+ Write_Str(Len,t,'FALSE');
+End;
+
+
+Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); iocheck; [Public,Alias:'FPC_WRITE_TEXT_CHAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(t).mode<>fmOutput) Then
+ begin
+ if TextRec(t).mode=fmClosed then
+ InOutRes:=103
+ else
+ InOutRes:=105;
+ exit;
+ end;
+ If Len>1 Then
+ fpc_WriteBlanks(t,Len-1);
+ If TextRec(t).BufPos+1>=TextRec(t).BufSize Then
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ TextRec(t).Bufptr^[TextRec(t).BufPos]:=c;
+ Inc(TextRec(t).BufPos);
+End;
+
+
+{$ifdef HASWIDECHAR}
+Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); iocheck; [Public,Alias:'FPC_WRITE_TEXT_WIDECHAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ch : char;
+Begin
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(t).mode<>fmOutput) Then
+ begin
+ if TextRec(t).mode=fmClosed then
+ InOutRes:=103
+ else
+ InOutRes:=105;
+ exit;
+ end;
+ If Len>1 Then
+ fpc_WriteBlanks(t,Len-1);
+ If TextRec(t).BufPos+1>=TextRec(t).BufSize Then
+ FileFunc(TextRec(t).InOutFunc)(TextRec(t));
+ ch:=c;
+ TextRec(t).Bufptr^[TextRec(t).BufPos]:=ch;
+ Inc(TextRec(t).BufPos);
+End;
+{$endif HASWIDECHAR}
+
+
+{*****************************************************************************
+ Read(Ln)
+*****************************************************************************}
+
+Function NextChar(var f:Text;var s:string):Boolean;
+begin
+ if (TextRec(f).BufPos<TextRec(f).BufEnd) then
+ if not (CtrlZMarksEOF) or (TextRec(f).Bufptr^[TextRec(f).BufPos]<>#26) then
+ begin
+ if length(s)<high(s) then
+ begin
+ inc(s[0]);
+ s[length(s)]:=TextRec(f).BufPtr^[TextRec(f).BufPos];
+ end;
+ Inc(TextRec(f).BufPos);
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ NextChar:=true;
+ end
+ else
+ NextChar:=false;
+end;
+
+
+Function IgnoreSpaces(var f:Text):Boolean;
+{
+ Removes all leading spaces,tab,eols from the input buffer, returns true if
+ the buffer is empty
+}
+var
+ s : string;
+begin
+ s:='';
+ IgnoreSpaces:=false;
+ { Return false when already at EOF }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ exit;
+(* Check performed separately to avoid accessing memory outside buffer *)
+ if CtrlZMarksEOF and (TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) then
+ exit;
+ while (TextRec(f).Bufptr^[TextRec(f).BufPos] <= ' ') do
+ begin
+ if not NextChar(f,s) then
+ exit;
+ { EOF? }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ break;
+ if CtrlZMarksEOF and (TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) then
+ break;
+ end;
+ IgnoreSpaces:=true;
+end;
+
+
+procedure ReadNumeric(var f:Text;var s:string);
+{
+ Read numeric input, if buffer is empty then return True
+}
+begin
+ repeat
+ if not NextChar(f,s) then
+ exit;
+ until (length(s)=high(s)) or (TextRec(f).BufPtr^[TextRec(f).BufPos] <= ' ');
+end;
+
+
+Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if TextRec(f).FlushFunc<>nil then
+ FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+end;
+
+
+Procedure fpc_ReadLn_End(var f : Text);[Public,Alias:'FPC_READLN_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
+var prev: char;
+Begin
+{ Check error and if file is open and load buf if empty }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+ if TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ begin
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ { Flush if set }
+ begin
+ if (TextRec(f).FlushFunc<>nil) then
+ FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+ exit;
+ end;
+ end;
+ if CtrlZMarksEOF and (TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26) then
+ Exit;
+ repeat
+ prev := TextRec(f).BufPtr^[TextRec(f).BufPos];
+ inc(TextRec(f).BufPos);
+{ no system uses #10#13 as line seperator (#10 = *nix, #13 = Mac, }
+{ #13#10 = Dos), so if we've got #10, we can safely exit }
+ if prev = #10 then
+ exit;
+ {$ifdef MACOS}
+ if prev = #13 then
+ {StdInput on macos never have dos line ending, so this is safe.}
+ if TextRec(f).Handle = StdInputHandle then
+ exit;
+ {$endif MACOS}
+ if TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ begin
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ { Flush if set }
+ begin
+ if (TextRec(f).FlushFunc<>nil) then
+ FileFunc(TextRec(f).FlushFunc)(TextRec(f));
+ exit;
+ end;
+ end;
+ if CtrlZMarksEOF and (TextRec (F).BufPtr^ [TextRec (F).BufPos] = #26) then
+ Exit;
+ if (prev=#13) then
+ { is there also a #10 after it? }
+ begin
+ if (TextRec(f).BufPtr^[TextRec(f).BufPos]=#10) then
+ { yes, skip that one as well }
+ inc(TextRec(f).BufPos);
+ exit;
+ end;
+ until false;
+End;
+
+
+Function ReadPCharLen(var f:Text;s:pchar;maxlen:longint):longint;
+var
+ sPos,len : Longint;
+ p,startp,maxp : pchar;
+Begin
+ ReadPCharLen:=0;
+{ Check error and if file is open }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+{ Read maximal until Maxlen is reached }
+ sPos:=0;
+ repeat
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ begin
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ break;
+ end;
+ p:=@TextRec(f).Bufptr^[TextRec(f).BufPos];
+ if SPos+TextRec(f).BufEnd-TextRec(f).BufPos>MaxLen then
+ maxp:=@TextRec(f).BufPtr^[TextRec(f).BufPos+MaxLen-SPos]
+ else
+ maxp:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
+ startp:=p;
+ { search linefeed }
+ while (p<maxp) and not(P^ in [#10,#13]) do
+ inc(p);
+ { calculate read bytes }
+ len:=p-startp;
+ inc(TextRec(f).BufPos,Len);
+ Move(startp^,s[sPos],Len);
+ inc(sPos,Len);
+ { was it a LF or CR? then leave }
+ if (spos=MaxLen) or
+ ((p<maxp) and (p^ in [#10,#13])) then
+ break;
+ until false;
+ ReadPCharLen:=spos;
+End;
+
+
+Procedure fpc_Read_Text_ShortStr(var f : Text;var s : String); iocheck; [Public,Alias:'FPC_READ_TEXT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s)));
+End;
+
+
+Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text;var s : PChar); iocheck; [Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ pchar(s+ReadPCharLen(f,s,$7fffffff))^:=#0;
+End;
+
+
+Procedure fpc_Read_Text_PChar_As_Array(var f : Text;var s : array of char); iocheck; [Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ len: longint;
+Begin
+ len := ReadPCharLen(f,pchar(@s),high(s)+1);
+ if len <= high(s) then
+ s[len] := #0;
+End;
+
+
+Procedure fpc_Read_Text_AnsiStr(var f : Text;var s : AnsiString); iocheck; [Public,Alias:'FPC_READ_TEXT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ slen,len : longint;
+Begin
+ slen:=0;
+ Repeat
+ // SetLength will reallocate the length.
+ SetLength(S,slen+255);
+ len:=ReadPCharLen(f,pchar(Pointer(S)+slen),255);
+ inc(slen,len);
+ Until len<255;
+ // Set actual length
+ SetLength(S,Slen);
+End;
+
+{$ifdef hascompilerproc}
+procedure fpc_Read_Text_Char(var f : Text; var c: char); iocheck; [Public,Alias:'FPC_READ_TEXT_CHAR'];compilerproc;
+{$else hascompilerproc}
+Function fpc_Read_Text_Char(var f : Text):char;[Public,Alias:'FPC_READ_TEXT_CHAR'];
+{$endif hascompilerproc}
+Begin
+{$ifdef hascompilerproc}
+ c:=#0;
+{$else hascompilerproc}
+ fpc_Read_Text_Char:=#0;
+{$endif hascompilerproc}
+{ Check error and if file is open }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+{ Read next char or EOF }
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ begin
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+{$ifdef hascompilerproc}
+ begin
+ c := #26;
+ exit;
+ end;
+{$else hascompilerproc}
+ exit(#26);
+{$endif hascompilerproc}
+ end;
+{$ifdef hascompilerproc}
+ c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
+{$else hascompilerproc}
+ fpc_Read_Text_Char:=TextRec(f).Bufptr^[TextRec(f).BufPos];
+{$endif hascompilerproc}
+ inc(TextRec(f).BufPos);
+end;
+
+
+{$ifdef hascompilerproc}
+Procedure fpc_Read_Text_SInt(var f : Text; var l : ValSInt); iocheck; [Public,Alias:'FPC_READ_TEXT_SINT']; compilerproc;
+{$else hascompilerproc}
+Function fpc_Read_Text_SInt(var f : Text):ValSInt;[Public,Alias:'FPC_READ_TEXT_SINT'];
+{$endif hascompilerproc}
+var
+ hs : String;
+ code : longint;
+Begin
+{$ifdef hascompilerproc}
+ l:=0;
+{$else hascompilerproc}
+ fpc_Read_Text_SInt:=0;
+{$endif hascompilerproc}
+{ Leave if error or not open file, else check for empty buf }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ hs:='';
+ if IgnoreSpaces(f) then
+ begin
+ { When spaces were found and we are now at EOF,
+ then we return 0 }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ exit;
+ if CtrlZMarksEOF and (TextRec(f).Bufptr^[TextRec(f).BufPos]=#26) then
+ exit;
+ ReadNumeric(f,hs);
+ end;
+{$ifdef hascompilerproc}
+ if (hs = '') then
+ L := 0
+ else
+ begin
+ Val(hs,l,code);
+ if Code <> 0 then
+ InOutRes:=106;
+ end;
+{$else hascompilerproc}
+ if (hs = '') then
+ fpc_Read_Text_SInt := 0
+ else
+ begin
+ Val(hs,fpc_Read_Text_SInt,code);
+ if Code <> 0 then
+ InOutRes:=106;
+ end;
+{$endif hascompilerproc}
+End;
+
+
+{$ifdef hascompilerproc}
+Procedure fpc_Read_Text_UInt(var f : Text; var u : ValUInt); iocheck; [Public,Alias:'FPC_READ_TEXT_UINT']; compilerproc;
+{$else hascompilerproc}
+Function fpc_Read_Text_UInt(var f : Text):ValUInt;[Public,Alias:'FPC_READ_TEXT_UINT'];
+{$endif hascompilerproc}
+var
+ hs : String;
+ code : longint;
+Begin
+{$ifdef hascompilerproc}
+ u:=0;
+{$else hascompilerproc}
+ fpc_Read_Text_UInt:=0;
+{$endif hascompilerproc}
+{ Leave if error or not open file, else check for empty buf }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ hs:='';
+ if IgnoreSpaces(f) then
+ begin
+ { When spaces were found and we are now at EOF,
+ then we return 0 }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ exit;
+ ReadNumeric(f,hs);
+ end;
+{$ifdef hascompilerproc}
+ val(hs,u,code);
+{$else hascompilerproc}
+ val(hs,fpc_Read_Text_UInt,code);
+{$endif hascompilerproc}
+ If code<>0 Then
+ InOutRes:=106;
+End;
+
+
+{$ifdef hascompilerproc}
+procedure fpc_Read_Text_Float(var f : Text; var v : ValReal); iocheck; [Public,Alias:'FPC_READ_TEXT_FLOAT']; compilerproc;
+{$else hascompilerproc}
+Function fpc_Read_Text_Float(var f : Text):ValReal;[Public,Alias:'FPC_READ_TEXT_FLOAT'];
+{$endif hascompilerproc}
+var
+ hs : string;
+ code : Word;
+begin
+{$ifdef hascompilerproc}
+ v:=0.0;
+{$else hascompilerproc}
+ fpc_Read_Text_Float:=0.0;
+{$endif hascompilerproc}
+{ Leave if error or not open file, else check for empty buf }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ hs:='';
+ if IgnoreSpaces(f) then
+ begin
+ { When spaces were found and we are now at EOF,
+ then we return 0 }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ exit;
+ ReadNumeric(f,hs);
+ end;
+{$ifdef hascompilerproc}
+ val(hs,v,code);
+{$else hascompilerproc}
+ val(hs,fpc_Read_Text_Float,code);
+{$endif hascompilerproc}
+ If code<>0 Then
+ InOutRes:=106;
+end;
+
+
+{$ifndef cpu64}
+
+{$ifdef hascompilerproc}
+procedure fpc_Read_Text_QWord(var f : text; var q : qword); iocheck; [public,alias:'FPC_READ_TEXT_QWORD']; compilerproc;
+{$else hascompilerproc}
+function fpc_Read_Text_QWord(var f : text) : qword;[public,alias:'FPC_READ_TEXT_QWORD'];
+{$endif hascompilerproc}
+var
+ hs : String;
+ code : longint;
+Begin
+{$ifdef hascompilerproc}
+ q:=0;
+{$else hascompilerproc}
+ fpc_Read_Text_QWord:=0;
+{$endif hascompilerproc}
+ { Leave if error or not open file, else check for empty buf }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ hs:='';
+ if IgnoreSpaces(f) then
+ begin
+ { When spaces were found and we are now at EOF,
+ then we return 0 }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ exit;
+ ReadNumeric(f,hs);
+ end;
+{$ifdef hascompilerproc}
+ val(hs,q,code);
+{$else hascompilerproc}
+ val(hs,fpc_Read_Text_QWord,code);
+{$endif hascompilerproc}
+ If code<>0 Then
+ InOutRes:=106;
+End;
+
+{$ifdef hascompilerproc}
+procedure fpc_Read_Text_Int64(var f : text; var i : int64); iocheck; [public,alias:'FPC_READ_TEXT_INT64']; compilerproc;
+{$else hascompilerproc}
+function fpc_Read_Text_Int64(var f : text) : int64;[public,alias:'FPC_READ_TEXT_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif hascompilerproc}
+var
+ hs : String;
+ code : Longint;
+Begin
+{$ifdef hascompilerproc}
+ i:=0;
+{$else hascompilerproc}
+ fpc_Read_Text_Int64:=0;
+{$endif hascompilerproc}
+{ Leave if error or not open file, else check for empty buf }
+ If (InOutRes<>0) then
+ exit;
+ if (TextRec(f).mode<>fmInput) Then
+ begin
+ case TextRec(f).mode of
+ fmOutPut,fmAppend:
+ InOutRes:=104
+ else
+ InOutRes:=103;
+ end;
+ exit;
+ end;
+ If TextRec(f).BufPos>=TextRec(f).BufEnd Then
+ FileFunc(TextRec(f).InOutFunc)(TextRec(f));
+ hs:='';
+ if IgnoreSpaces(f) then
+ begin
+ { When spaces were found and we are now at EOF,
+ then we return 0 }
+ if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
+ exit;
+ ReadNumeric(f,hs);
+ end;
+{$ifdef hascompilerproc}
+ Val(hs,i,code);
+{$else hascompilerproc}
+ Val(hs,fpc_Read_Text_Int64,code);
+{$endif hascompilerproc}
+ If code<>0 Then
+ InOutRes:=106;
+End;
+
+{$endif CPU64}
+
+
+{*****************************************************************************
+ Initializing
+*****************************************************************************}
+
+procedure OpenStdIO(var f:text;mode,hdl:longint);
+begin
+ Assign(f,'');
+ TextRec(f).Handle:=hdl;
+ TextRec(f).Mode:=mode;
+ TextRec(f).Closefunc:=@FileCloseFunc;
+ case mode of
+ fmInput :
+ TextRec(f).InOutFunc:=@FileReadFunc;
+ fmOutput :
+ begin
+ TextRec(f).InOutFunc:=@FileWriteFunc;
+ TextRec(f).FlushFunc:=@FileWriteFunc;
+ end;
+ else
+ HandleError(102);
+ end;
+end;
+
+
+{
+ $Log: text.inc,v $
+ Revision 1.30 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.29 2005/02/14 17:13:29 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/textrec.inc b/rtl/inc/textrec.inc
new file mode 100644
index 0000000000..77e03f19e8
--- /dev/null
+++ b/rtl/inc/textrec.inc
@@ -0,0 +1,66 @@
+{
+ $Id: textrec.inc,v 1.9 2005/02/26 15:42:45 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Textrec record definition
+
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ This file contains the definition of the textrec record.
+ It is put separately, so it is available outside the system
+ unit without sacrificing TP compatibility.
+}
+
+const
+ TextRecNameLength = 256;
+ TextRecBufSize = 256;
+type
+ TLineEndStr = string [3];
+ TextBuf = array[0..TextRecBufSize-1] of char;
+ TextRec = Packed Record
+ Handle : THandle;
+ Mode : longint;
+ bufsize : SizeInt;
+{$IFDEF FPC_LINEEND_IN_TEXTREC}
+ _private : SizeInt;
+{$ELSE FPC_LINEEND_IN_TEXTREC}
+ LineEnd : TLineEndStr;
+{$ENDIF FPC_LINEEND_IN_TEXTREC}
+ bufpos,
+ bufend : SizeInt;
+ bufptr : ^textbuf;
+ openfunc,
+ inoutfunc,
+ flushfunc,
+ closefunc : pointer;
+{$ifndef FPC_HASUSERDATA32}
+ UserData : array[1..16] of byte;
+{$else FPC_HASUSERDATA32}
+ UserData : array[1..32] of byte;
+{$endif FPC_HASUSERDATA32}
+ name : array[0..textrecnamelength-1] of char;
+{$IFDEF FPC_LINEEND_IN_TEXTREC}
+ LineEnd : TLineEndStr;
+{$ENDIF FPC_LINEEND_IN_TEXTREC}
+ buffer : textbuf;
+ End;
+
+{
+ $Log: textrec.inc,v $
+ Revision 1.9 2005/02/26 15:42:45 florian
+ * userdata in file/textrecs now 32 bytes
+
+ Revision 1.8 2005/02/14 17:13:29 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/thread.inc b/rtl/inc/thread.inc
new file mode 100644
index 0000000000..875bde6054
--- /dev/null
+++ b/rtl/inc/thread.inc
@@ -0,0 +1,545 @@
+{
+ $Id: thread.inc,v 1.30 2005/04/20 07:41:48 hajny Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 2000 by the Free Pascal development team
+
+ OS independent thread functions/overloads
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+Var
+ CurrentTM : TThreadManager;
+
+{*****************************************************************************
+ Threadvar initialization
+*****************************************************************************}
+
+ procedure InitThread(stklen:cardinal);
+ begin
+ SysResetFPU;
+ { ExceptAddrStack and ExceptObjectStack are threadvars }
+ { so every thread has its on exception handling capabilities }
+ SysInitExceptions;
+ { Open all stdio fds again }
+ SysInitStdio;
+ InOutRes:=0;
+ // ErrNo:=0;
+ { Stack checking }
+ StackLength:=stklen;
+ StackBottom:=Sptr - StackLength;
+ ThreadID := CurrentTM.GetCurrentThreadID();
+ end;
+
+{*****************************************************************************
+ Overloaded functions
+*****************************************************************************}
+{$ifndef CPU64}
+{$ifndef unix}
+{$endif unix}
+{$endif CPU64}
+
+ function BeginThread(ThreadFunction : tthreadfunc) : DWord;
+ var
+ dummy : TThreadID;
+ begin
+ BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,nil,0,dummy);
+ end;
+
+
+ function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
+ var
+ dummy : TThreadID;
+ begin
+ BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,dummy);
+ end;
+
+
+ function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : TThreadID) : DWord;
+ begin
+ BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,ThreadId);
+ end;
+
+
+{$ifndef CPU64}
+{$ifndef unix}
+{$endif unix}
+{$endif CPU64}
+
+ procedure EndThread;
+ begin
+ EndThread(0);
+ end;
+
+function BeginThread(sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : DWord;
+
+begin
+ Result:=CurrentTM.BeginThread(sa,stacksize,threadfunction,P,creationflags,ThreadID);
+end;
+
+procedure EndThread(ExitCode : DWord);
+
+begin
+ CurrentTM.EndThread(ExitCode);
+end;
+
+function SuspendThread (threadHandle : TThreadID) : dword;
+
+begin
+ Result:=CurrentTM.SuspendThread(ThreadHandle);
+end;
+
+function ResumeThread (threadHandle : TThreadID) : dword;
+
+begin
+ Result:=CurrentTM.ResumeThread(ThreadHandle);
+end;
+
+procedure ThreadSwitch;
+
+begin
+ CurrentTM.ThreadSwitch;
+end;
+
+function KillThread (threadHandle : TThreadID) : dword;
+
+begin
+ Result:=CurrentTM.KillThread(ThreadHandle);
+end;
+
+function WaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword;
+
+begin
+ Result:=CurrentTM.WaitForThreadTerminate(ThreadHandle,TimeOutMS);
+end;
+
+function ThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean;
+begin
+ Result:=CurrentTM.ThreadSetPriority(ThreadHandle,Prio);
+end;
+
+function ThreadGetPriority (threadHandle : TThreadID): longint;
+
+begin
+ Result:=CurrentTM.ThreadGetPriority(ThreadHandle);
+end;
+
+function GetCurrentThreadId : TThreadID;
+
+begin
+ Result:=CurrentTM.GetCurrentThreadID();
+end;
+
+procedure InitCriticalSection(var cs : TRTLCriticalSection);
+
+begin
+ CurrentTM.InitCriticalSection(cs);
+end;
+
+procedure DoneCriticalsection(var cs : TRTLCriticalSection);
+
+begin
+ CurrentTM.DoneCriticalSection(cs);
+end;
+
+procedure EnterCriticalsection(var cs : TRTLCriticalSection);
+
+begin
+ CurrentTM.EnterCriticalSection(cs);
+end;
+
+procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
+
+begin
+ CurrentTM.LeaveCriticalSection(cs);
+end;
+
+Function GetThreadManager(Var TM : TThreadManager) : Boolean;
+
+begin
+ TM:=CurrentTM;
+ Result:=True;
+end;
+
+Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean;
+
+begin
+ GetThreadManager(OldTM);
+ Result:=SetThreadManager(NewTM);
+end;
+
+Function SetThreadManager(Const NewTM : TThreadManager) : Boolean;
+
+begin
+ Result:=True;
+ If Assigned(CurrentTM.DoneManager) then
+ Result:=CurrentTM.DoneManager();
+ If Result then
+ begin
+ CurrentTM:=NewTM;
+ If Assigned(CurrentTM.InitManager) then
+ Result:=CurrentTM.InitManager();
+ end;
+end;
+
+function BasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+begin
+ result:=currenttm.BasicEventCreate(EventAttributes,AManualReset,InitialState, Name);
+end;
+
+procedure basiceventdestroy(state:peventstate);
+
+begin
+ currenttm.basiceventdestroy(state);
+end;
+
+procedure basiceventResetEvent(state:peventstate);
+
+begin
+ currenttm.basiceventResetEvent(state);
+end;
+
+procedure basiceventSetEvent(state:peventstate);
+
+begin
+ currenttm.basiceventSetEvent(state);
+end;
+
+function basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+ result:=currenttm.basiceventWaitFor(Timeout,state);
+end;
+
+function RTLEventCreate :PRTLEvent;
+
+begin
+ result:=currenttm.rtleventcreate();
+end;
+
+
+procedure RTLeventdestroy(state:pRTLEvent);
+
+begin
+ currenttm.rtleventdestroy(state);
+end;
+
+procedure RTLeventSetEvent(state:pRTLEvent);
+
+begin
+ currenttm.rtleventsetEvent(state);
+end;
+
+procedure RTLeventResetEvent(state:pRTLEvent);
+
+begin
+ currenttm.rtleventResetEvent(state);
+end;
+
+procedure RTLeventStartWait(state:pRTLEvent);
+
+begin
+ currenttm.rtleventStartWait(state);
+end;
+
+procedure RTLeventWaitFor(state:pRTLEvent);
+
+begin
+ currenttm.rtleventWaitFor(state);
+end;
+
+procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
+
+begin
+ currenttm.rtleventWaitForTimeout(state,timeout);
+end;
+
+procedure RTLeventsync(m:trtlmethod;p:tprocedure);
+
+begin
+ currenttm.rtleventsync(m,p);
+end;
+
+
+{ ---------------------------------------------------------------------
+ ThreadManager which gives run-time error. Use if no thread support.
+ ---------------------------------------------------------------------}
+
+{$ifndef DISABLE_NO_THREAD_MANAGER}
+
+{ resourcestrings are not supported by the system unit,
+ they are in the objpas unit and not available for fpc/tp modes }
+const
+ SNoThreads = 'This binary has no thread support compiled in.';
+ SRecompileWithThreads = 'Recompile the application with a thread-driver in the program uses clause before other units using thread.';
+
+Procedure NoThreadError;
+
+begin
+ If IsConsole then
+ begin
+ Writeln(StdErr,SNoThreads);
+ Writeln(StdErr,SRecompileWithThreads);
+ end;
+ RunError(232)
+end;
+
+function NoBeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;
+ creationFlags : dword; var ThreadId : TThreadID) : DWord;
+begin
+ NoThreadError;
+end;
+
+procedure NoEndThread(ExitCode : DWord);
+begin
+ NoThreadError;
+end;
+
+function NoThreadHandler (threadHandle : TThreadID) : dword;
+begin
+ NoThreadError;
+end;
+
+procedure NoThreadSwitch; {give time to other threads}
+begin
+ NoThreadError;
+end;
+
+function NoWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
+begin
+ NoThreadError;
+end;
+
+function NoThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
+begin
+ NoThreadError;
+end;
+
+function NoThreadGetPriority (threadHandle : TThreadID): longint;
+begin
+ NoThreadError;
+end;
+
+function NoGetCurrentThreadId : TThreadID;
+begin
+ if IsMultiThread then
+ NoThreadError
+ else
+ ThreadingAlreadyUsed:=true;
+ result:=ThreadID;
+end;
+
+procedure NoCriticalSection(var CS);
+
+begin
+ if IsMultiThread then
+ NoThreadError
+ else
+ ThreadingAlreadyUsed:=true;
+end;
+
+procedure NoInitThreadvar(var offset : dword;size : dword);
+
+begin
+ NoThreadError;
+end;
+
+function NoRelocateThreadvar(offset : dword) : pointer;
+
+begin
+ NoThreadError;
+end;
+
+
+procedure NoAllocateThreadVars;
+
+begin
+ NoThreadError;
+end;
+
+procedure NoReleaseThreadVars;
+
+begin
+ NoThreadError;
+end;
+
+function noBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+begin
+ NoThreadError;
+end;
+
+procedure nobasiceventdestroy(state:peventstate);
+
+begin
+ NoThreadError;
+end;
+
+procedure nobasiceventResetEvent(state:peventstate);
+
+begin
+ NoThreadError;
+end;
+
+procedure nobasiceventSetEvent(state:peventstate);
+
+begin
+ NoThreadError;
+end;
+
+function nobasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+ NoThreadError;
+end;
+
+function NORTLEventCreate :PRTLEvent;
+
+begin
+ if IsMultiThread then
+ NoThreadError
+ else
+ ThreadingAlreadyUsed:=true
+end;
+
+procedure NORTLeventdestroy(state:pRTLEvent);
+
+begin
+ if IsMultiThread then
+ NoThreadError
+ else
+ ThreadingAlreadyUsed:=true
+end;
+
+procedure NORTLeventSetEvent(state:pRTLEvent);
+
+begin
+ NoThreadError;
+end;
+
+procedure NORTLeventStartWait(state:pRTLEvent);
+ begin
+ NoThreadError;
+ end;
+
+
+procedure NORTLeventWaitFor(state:pRTLEvent);
+ begin
+ NoThreadError;
+ end;
+
+
+procedure NORTLeventWaitForTimeout(state:pRTLEvent;timeout : longint);
+ begin
+ NoThreadError;
+ end;
+
+
+procedure NORTLeventsync(m:trtlmethod;p:tprocedure);
+ begin
+ NoThreadError;
+ end;
+
+
+Var
+ NoThreadManager : TThreadManager;
+
+Procedure SetNoThreadManager;
+
+begin
+ With NoThreadManager do
+ begin
+ InitManager :=Nil;
+ DoneManager :=Nil;
+ BeginThread :=@NoBeginThread;
+ EndThread :=@NoEndThread;
+ SuspendThread :=@NoThreadHandler;
+ ResumeThread :=@NoThreadHandler;
+ KillThread :=@NoThreadHandler;
+ ThreadSwitch :=@NoThreadSwitch;
+ WaitForThreadTerminate :=@NoWaitForThreadTerminate;
+ ThreadSetPriority :=@NoThreadSetPriority;
+ ThreadGetPriority :=@NoThreadGetPriority;
+ GetCurrentThreadId :=@NoGetCurrentThreadId;
+ InitCriticalSection :=@NoCriticalSection;
+ DoneCriticalSection :=@NoCriticalSection;
+ EnterCriticalSection :=@NoCriticalSection;
+ LeaveCriticalSection :=@NoCriticalSection;
+ InitThreadVar :=@NoInitThreadVar;
+ RelocateThreadVar :=@NoRelocateThreadVar;
+ AllocateThreadVars :=@NoAllocateThreadVars;
+ ReleaseThreadVars :=@NoReleaseThreadVars;
+ BasicEventCreate :=@NoBasicEventCreate;
+ basiceventdestroy :=@Nobasiceventdestroy;
+ basiceventResetEvent :=@NobasiceventResetEvent;
+ basiceventSetEvent :=@NobasiceventSetEvent;
+ basiceventWaitFor :=@NobasiceventWaitFor;
+ rtlEventCreate :=@NortlEventCreate;
+ rtleventdestroy :=@Nortleventdestroy;
+ rtleventSetEvent :=@NortleventSetEvent;
+ rtleventStartWait :=@NortleventStartWait;
+ rtleventWaitFor :=@NortleventWaitFor;
+ rtleventsync :=@Nortleventsync;
+ rtleventwaitfortimeout :=@NortleventWaitForTimeout;
+ end;
+ SetThreadManager(NoThreadManager);
+end;
+{$endif DISABLE_NO_THREAD_MANAGER}
+
+{
+ $Log: thread.inc,v $
+ Revision 1.30 2005/04/20 07:41:48 hajny
+ * two more (TThreadID)
+
+ Revision 1.29 2005/04/17 17:19:41 hajny
+ * one more TThreadID fix
+
+ Revision 1.28 2005/04/14 20:42:14 florian
+ * fixed more TThreadID stuff
+
+ Revision 1.27 2005/04/13 20:15:47 florian
+ * TThread on linux fixed
+
+ Revision 1.26 2005/04/09 17:26:08 florian
+ + classes.mainthreadid is set now
+ + rtleventresetevent
+ + rtleventwairfor with timeout
+ + checksynchronize with timeout
+ * race condition in synchronize fixed
+
+ Revision 1.25 2005/04/03 19:29:28 florian
+ * proper error message if the cthreads unit is included too late
+ uses clause
+
+ Revision 1.24 2005/02/26 11:40:38 florian
+ * rtl event init/destroy throws only an error if it's used in a mult threaded program
+
+ Revision 1.23 2005/02/25 22:02:46 florian
+ * another "transfer to linux"-commit
+
+ Revision 1.22 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.21 2005/02/07 17:36:54 peter
+ can't use resourcestrings in the system unit
+
+ Revision 1.20 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.19 2005/01/21 21:45:57 armin
+ * applied patch to compile go32v2 from Tomas (tested by John)
+
+ Revision 1.18 2005/01/16 14:46:57 florian
+ * critical sections can be used in programs without threading driver, they have no effect then
+
+}
diff --git a/rtl/inc/threadh.inc b/rtl/inc/threadh.inc
new file mode 100644
index 0000000000..95be66f766
--- /dev/null
+++ b/rtl/inc/threadh.inc
@@ -0,0 +1,187 @@
+{
+ $Id: threadh.inc,v 1.32 2005/04/20 06:32:47 hajny Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 2000 by the Free Pascal development team
+
+ This file contains the OS indenpendend declartions for multi
+ threading support in FPC
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ DefaultStackSize = 32768; { including 16384 margin for stackchecking }
+
+
+type
+ PEventState = pointer;
+ PRTLEvent = pointer; // Windows=thandle, other=pointer to record.
+ TThreadFunc = function(parameter : pointer) : ptrint;
+ trtlmethod = procedure of object;
+
+ // Function prototypes for TThreadManager Record.
+ TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : DWord;
+ TEndThreadHandler = Procedure (ExitCode : DWord);
+ // Used for Suspend/Resume/Kill
+ TThreadHandler = Function (threadHandle : TThreadID) : dword;
+ TThreadSwitchHandler = Procedure;
+ TWaitForThreadTerminateHandler = Function (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
+ TThreadSetPriorityHandler = Function (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
+ TThreadGetPriorityHandler = Function (threadHandle : TThreadID): longint;
+ TGetCurrentThreadIdHandler = Function : TThreadID;
+ TCriticalSectionHandler = Procedure (var cs);
+ TInitThreadVarHandler = Procedure(var offset : dword;size : dword);
+ TRelocateThreadVarHandler = Function(offset : dword) : pointer;
+ TAllocateThreadVarsHandler = Procedure;
+ TReleaseThreadVarsHandler = Procedure;
+ TBasicEventHandler = procedure(state:peventstate);
+ TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
+ TBasicEventCreateHandler = function (EventAttributes :Pointer; AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
+ TRTLEventHandler = procedure(AEvent:PRTLEvent);
+ TRTLEventHandlerTimeout = procedure(AEvent:PRTLEvent;timeout : longint);
+ TRTLCreateEventHandler = function:PRTLEvent;
+ TRTLEventSyncHandler = procedure (m:trtlmethod;p:tprocedure);
+
+ // TThreadManager interface.
+ TThreadManager = Record
+ InitManager : Function : Boolean;
+ DoneManager : Function : Boolean;
+ BeginThread : TBeginThreadHandler;
+ EndThread : TEndThreadHandler;
+ SuspendThread : TThreadHandler;
+ ResumeThread : TThreadHandler;
+ KillThread : TThreadHandler;
+ ThreadSwitch : TThreadSwitchHandler;
+ WaitForThreadTerminate : TWaitForThreadTerminateHandler;
+ ThreadSetPriority : TThreadSetPriorityHandler;
+ ThreadGetPriority : TThreadGetPriorityHandler;
+ GetCurrentThreadId : TGetCurrentThreadIdHandler;
+ InitCriticalSection : TCriticalSectionHandler;
+ DoneCriticalSection : TCriticalSectionHandler;
+ EnterCriticalSection : TCriticalSectionHandler;
+ LeaveCriticalSection : TCriticalSectionHandler;
+ InitThreadVar : TInitThreadVarHandler;
+ RelocateThreadVar : TRelocateThreadVarHandler;
+ AllocateThreadVars : TAllocateThreadVarsHandler;
+ ReleaseThreadVars : TReleaseThreadVarsHandler;
+ BasicEventCreate : TBasicEventCreateHandler; // left in for a while.
+ BasicEventDestroy : TBasicEventHandler; // we might need BasicEvent
+ BasicEventResetEvent : TBasicEventHandler; // for a real TEvent
+ BasicEventSetEvent : TBasicEventHandler;
+ BasiceventWaitFOr : TBasicEventWaitForHandler;
+ RTLEventCreate : TRTLCreateEventHandler;
+ RTLEventDestroy : TRTLEventHandler;
+ RTLEventSetEvent : TRTLEventHandler;
+ RTLEventResetEvent : TRTLEventHandler;
+ RTLEventStartWait : TRTLEventHandler;
+ RTLEventWaitFor : TRTLEventHandler;
+ RTLEventSync : TRTLEventSyncHandler;
+ RTLEventWaitForTimeout : TRTLEventHandlerTimeout;
+ end;
+
+{*****************************************************************************
+ Thread Handler routines
+*****************************************************************************}
+
+
+Function GetThreadManager(Var TM : TThreadManager) : Boolean;
+Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean;
+Function SetThreadManager(Const NewTM : TThreadManager) : Boolean;
+{$ifndef DISABLE_NO_THREAD_MANAGER}
+Procedure SetNoThreadManager;
+{$endif DISABLE_NO_THREAD_MANAGER}
+// Needs to be exported, so the manager can call it.
+{$ifdef HASTHREADVAR}
+procedure InitThreadVars(RelocProc : Pointer);
+{$endif HASTHREADVAR}
+procedure InitThread(stklen:cardinal);
+
+{*****************************************************************************
+ Multithread Handling
+*****************************************************************************}
+
+function BeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
+ var ThreadId : TThreadID) : DWord;
+
+{ add some simplfied forms which make lifer easier and porting }
+{ to other OSes too ... }
+function BeginThread(ThreadFunction : tthreadfunc) : DWord;
+function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord;
+function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : TThreadID) : DWord;
+
+procedure EndThread(ExitCode : DWord);
+procedure EndThread;
+
+{some thread support functions}
+function SuspendThread (threadHandle : TThreadID) : dword;
+function ResumeThread (threadHandle : TThreadID) : dword;
+procedure ThreadSwitch; {give time to other threads}
+function KillThread (threadHandle : TThreadID) : dword;
+function WaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
+function ThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
+function ThreadGetPriority (threadHandle : TThreadID): longint;
+function GetCurrentThreadId : TThreadID;
+
+
+{ this allows to do a lot of things in MT safe way }
+{ it is also used to make the heap management }
+{ thread safe }
+procedure InitCriticalSection(var cs : TRTLCriticalSection);
+procedure DoneCriticalsection(var cs : TRTLCriticalSection);
+procedure EnterCriticalsection(var cs : TRTLCriticalSection);
+procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
+
+function BasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+procedure basiceventdestroy(state:peventstate);
+procedure basiceventResetEvent(state:peventstate);
+procedure basiceventSetEvent(state:peventstate);
+function basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+function RTLEventCreate :PRTLEvent;
+procedure RTLeventdestroy(state:pRTLEvent);
+procedure RTLeventSetEvent(state:pRTLEvent);
+procedure RTLeventResetEvent(state:pRTLEvent);
+procedure RTLeventStartWait(state:pRTLEvent);
+procedure RTLeventWaitFor(state:pRTLEvent);
+procedure RTLeventWaitFor(state:pRTLEvent;timeout : longint);
+procedure RTLeventsync(m:trtlmethod;p:tprocedure);
+
+{
+ $Log: threadh.inc,v $
+ Revision 1.32 2005/04/20 06:32:47 hajny
+ * yet another TThreadID fix
+
+ Revision 1.31 2005/04/14 20:42:14 florian
+ * fixed more TThreadID stuff
+
+ Revision 1.30 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.29 2005/04/09 17:26:08 florian
+ + classes.mainthreadid is set now
+ + rtleventresetevent
+ + rtleventwairfor with timeout
+ + checksynchronize with timeout
+ * race condition in synchronize fixed
+
+ Revision 1.28 2005/02/25 22:02:48 florian
+ * another "transfer to linux"-commit
+
+ Revision 1.27 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.26 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.25 2005/01/21 21:43:12 armin
+ * applied patch to compile go32v2 from Tomas (tested by John)
+
+}
diff --git a/rtl/inc/threadvr.inc b/rtl/inc/threadvr.inc
new file mode 100644
index 0000000000..e980143c52
--- /dev/null
+++ b/rtl/inc/threadvr.inc
@@ -0,0 +1,111 @@
+{
+ $Id: threadvr.inc,v 1.5 2005/02/14 17:13:29 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt
+ member of the Free Pascal development team
+
+ Threadvar support, platform independent part
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+
+type
+ pltvInitEntry = ^ltvInitEntry;
+ ltvInitEntry = packed record
+ varaddr : pdword;
+ size : longint;
+ end;
+
+ TltvInitTablesTable = packed record
+ count : dword;
+ tables : packed array [1..32767] of pltvInitEntry;
+ end;
+
+var
+ ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_THREADVARTABLES';
+
+procedure init_unit_threadvars (tableEntry : pltvInitEntry);
+begin
+ while tableEntry^.varaddr <> nil do
+ begin
+ CurrentTM.InitThreadvar (tableEntry^.varaddr^, tableEntry^.size);
+ inc (pchar (tableEntry), sizeof (tableEntry^));
+ end;
+end;
+
+
+procedure init_all_unit_threadvars;
+var
+ i : integer;
+begin
+{$ifdef DEBUG_MT}
+ WriteLn ('init_all_unit_threadvars (',ThreadvarTablesTable.count,') units');
+{$endif}
+ for i := 1 to ThreadvarTablesTable.count do
+ init_unit_threadvars (ThreadvarTablesTable.tables[i]);
+end;
+
+
+procedure copy_unit_threadvars (tableEntry : pltvInitEntry);
+var
+ oldp,
+ newp : pointer;
+begin
+ while tableEntry^.varaddr <> nil do
+ begin
+ newp:=CurrentTM.RelocateThreadVar(tableEntry^.varaddr^);
+ oldp:=pointer(pchar(tableEntry^.varaddr)+sizeof(pointer));
+ move(oldp^,newp^,tableEntry^.size);
+ inc (pchar (tableEntry), sizeof (tableEntry^));
+ end;
+end;
+
+
+procedure copy_all_unit_threadvars;
+var
+ i : integer;
+begin
+{$ifdef DEBUG_MT}
+ WriteLn ('copy_all_unit_threadvars (',ThreadvarTablesTable.count,') units');
+{$endif}
+ for i := 1 to ThreadvarTablesTable.count do
+ copy_unit_threadvars (ThreadvarTablesTable.tables[i]);
+end;
+
+procedure InitThreadVars(RelocProc : Pointer);
+
+begin
+ { initialize threadvars }
+ init_all_unit_threadvars;
+ { allocate mem for main thread threadvars }
+ CurrentTM.AllocateThreadVars;
+ { copy main thread threadvars }
+ copy_all_unit_threadvars;
+ { install threadvar handler }
+ fpc_threadvar_relocate_proc:=RelocProc;
+end;
+
+{$endif HASTHREADVAR}
+
+{
+ $Log: threadvr.inc,v $
+ Revision 1.5 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.4 2005/02/05 23:49:49 florian
+ * threadvars on x86_64 fixed
+
+}
diff --git a/rtl/inc/typefile.inc b/rtl/inc/typefile.inc
new file mode 100644
index 0000000000..0a3ca9c094
--- /dev/null
+++ b/rtl/inc/typefile.inc
@@ -0,0 +1,100 @@
+{
+ $Id: typefile.inc,v 1.6 2005/02/14 17:13:29 peter Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ subroutines for typed file handling
+****************************************************************************}
+
+Procedure assign(var f:TypedFile;const Name:string);
+{
+ Assign Name to file f so it can be used with the file routines
+}
+Begin
+ FillChar(f,SizeOF(FileRec),0);
+ FileRec(f).Handle:=UnusedHandle;
+ FileRec(f).mode:=fmClosed;
+ Move(Name[1],FileRec(f).Name,Length(Name));
+End;
+
+
+Procedure assign(var f:TypedFile;p:pchar);
+{
+ Assign Name to file f so it can be used with the file routines
+}
+begin
+ Assign(f,StrPas(p));
+end;
+
+
+Procedure assign(var f:TypedFile;c:char);
+{
+ Assign Name to file f so it can be used with the file routines
+}
+begin
+ Assign(f,string(c));
+end;
+
+
+Procedure fpc_reset_typed(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias:'FPC_RESET_TYPED']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Reset(UnTypedFile(f),Size);
+End;
+
+
+Procedure fpc_rewrite_typed(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias:'FPC_REWRITE_TYPED']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ Rewrite(UnTypedFile(f),Size);
+End;
+
+
+Procedure fpc_typed_write(TypeSize : Longint;var f : TypedFile;const Buf);[IOCheck, Public, Alias :'FPC_TYPED_WRITE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Begin
+ If InOutRes <> 0 then
+ exit;
+ case fileRec(f).mode of
+ fmOutPut,fmInOut:
+ Do_Write(FileRec(f).Handle,@Buf,TypeSize);
+ fmInput: inOutRes := 105;
+ else inOutRes := 103;
+ end;
+End;
+
+Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias :'FPC_TYPED_READ']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ Result : Longint;
+Begin
+ If InOutRes <> 0 then
+ exit;
+ case FileRec(f).mode of
+ fmInput,fmInOut:
+ begin
+ Result:=Do_Read(FileRec(f).Handle,@Buf,TypeSize);
+ If Result<TypeSize Then
+ InOutRes:=100
+ end;
+ fmOutPut: inOutRes := 104
+ else inOutRes := 103;
+ end;
+End;
+
+{
+ $Log: typefile.inc,v $
+ Revision 1.6 2005/02/14 17:13:29 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/ucomplex.pp b/rtl/inc/ucomplex.pp
new file mode 100644
index 0000000000..4246598b7e
--- /dev/null
+++ b/rtl/inc/ucomplex.pp
@@ -0,0 +1,621 @@
+{
+ $Id: ucomplex.pp,v 1.4 2005/02/14 17:13:29 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Pierre Muller,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit UComplex;
+
+{ created for FPC by Pierre Muller }
+{ inpired from the complex unit from JD GAYRARD mai 95 }
+{ FPC supports operator overloading }
+
+
+ interface
+
+ uses math;
+
+ type complex = record
+ re : real;
+ im : real;
+ end;
+
+ pcomplex = ^complex;
+
+ const i : complex = (re : 0.0; im : 1.0);
+ _0 : complex = (re : 0.0; im : 0.0);
+
+
+ { assignment overloading is also used in type conversions
+ (beware also in implicit type conversions)
+ after this operator any real can be passed to a function
+ as a complex arg !! }
+
+ operator := (r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ { operator := (i : longint) z : complex;
+ not needed because longint can be converted to real }
+
+
+ { four operator : +, -, * , / and comparison = }
+ operator + (z1, z2 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ { these ones are created because the code
+ is simpler and thus faster }
+ operator + (z1 : complex; r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator + (r : real; z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+
+ operator - (z1, z2 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator - (z1 : complex;r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator - (r : real; z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+
+ operator * (z1, z2 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator * (z1 : complex; r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator * (r : real; z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+
+ operator / (znum, zden : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator / (znum : complex; r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator / (r : real; zden : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ { ** is the exponentiation operator }
+ operator ** (z1, z2 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator ** (z1 : complex; r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator ** (r : real; z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+
+ operator = (z1, z2 : complex) b : boolean;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator = (z1 : complex;r : real) b : boolean;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator = (r : real; z1 : complex) b : boolean;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ operator - (z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+
+ { complex functions }
+ function cong (z : complex) : complex; { conjuge }
+
+ { inverse function 1/z }
+ function cinv (z : complex) : complex;
+
+ { complex functions with real return values }
+ function cmod (z : complex) : real; { module }
+ function carg (z : complex) : real; { argument : a / z = p.e^ia }
+
+ { fonctions elementaires }
+ function cexp (z : complex) : complex; { exponential }
+ function cln (z : complex) : complex; { natural logarithm }
+ function csqrt (z : complex) : complex; { square root }
+
+ { complex trigonometric functions }
+ function ccos (z : complex) : complex; { cosinus }
+ function csin (z : complex) : complex; { sinus }
+ function ctg (z : complex) : complex; { tangent }
+
+ { inverse complex trigonometric functions }
+ function carc_cos (z : complex) : complex; { arc cosinus }
+ function carc_sin (z : complex) : complex; { arc sinus }
+ function carc_tg (z : complex) : complex; { arc tangent }
+
+ { hyperbolic complex functions }
+ function cch (z : complex) : complex; { hyperbolic cosinus }
+ function csh (z : complex) : complex; { hyperbolic sinus }
+ function cth (z : complex) : complex; { hyperbolic tangent }
+
+ { inverse hyperbolic complex functions }
+ function carg_ch (z : complex) : complex; { hyperbolic arc cosinus }
+ function carg_sh (z : complex) : complex; { hyperbolic arc sinus }
+ function carg_th (z : complex) : complex; { hyperbolic arc tangente }
+
+ { functions to write out a complex value }
+ function cstr(z : complex) : string;
+ function cstr(z:complex;len : integer) : string;
+ function cstr(z:complex;len,dec : integer) : string;
+
+ implementation
+
+ operator := (r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ begin
+ z.re:=r;
+ z.im:=0.0;
+ end;
+
+ { four base operations +, -, * , / }
+
+ operator + (z1, z2 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { addition : z := z1 + z2 }
+ begin
+ z.re := z1.re + z2.re;
+ z.im := z1.im + z2.im;
+ end;
+
+ operator + (z1 : complex; r : real) z : complex;
+ { addition : z := z1 + r }
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ begin
+ z.re := z1.re + r;
+ z.im := z1.im;
+ end;
+
+ operator + (r : real; z1 : complex) z : complex;
+ { addition : z := r + z1 }
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+
+ begin
+ z.re := z1.re + r;
+ z.im := z1.im;
+ end;
+
+ operator - (z1, z2 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { substraction : z := z1 - z2 }
+ begin
+ z.re := z1.re - z2.re;
+ z.im := z1.im - z2.im;
+ end;
+
+ operator - (z1 : complex; r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { substraction : z := z1 - r }
+ begin
+ z.re := z1.re - r;
+ z.im := z1.im;
+ end;
+
+ operator - (z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { substraction : z := - z1 }
+ begin
+ z.re := -z1.re;
+ z.im := -z1.im;
+ end;
+
+ operator - (r : real; z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { substraction : z := r - z1 }
+ begin
+ z.re := r - z1.re;
+ z.im := - z1.im;
+ end;
+
+ operator * (z1, z2 : complex) z : complex;
+ { multiplication : z := z1 * z2 }
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ begin
+ z.re := (z1.re * z2.re) - (z1.im * z2.im);
+ z.im := (z1.re * z2.im) + (z1.im * z2.re);
+ end;
+
+ operator * (z1 : complex; r : real) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { multiplication : z := z1 * r }
+ begin
+ z.re := z1.re * r;
+ z.im := z1.im * r;
+ end;
+
+ operator * (r : real; z1 : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { multiplication : z := r * z1 }
+ begin
+ z.re := z1.re * r;
+ z.im := z1.im * r;
+ end;
+
+ operator / (znum, zden : complex) z : complex;
+ {$ifdef TEST_INLINE}
+ inline;
+ {$endif TEST_INLINE}
+ { division : z := znum / zden }
+ var
+ denom : real;
+ begin
+ with zden do denom := (re * re) + (im * im);
+ { generates a fpu exception if denom=0 as for reals }
+ z.re := ((znum.re * zden.re) + (znum.im * zden.im)) / denom;
+ z.im := ((znum.im * zden.re) - (znum.re * zden.im)) / denom;
+ end;
+
+ operator / (znum : complex; r : real) z : complex;
+ { division : z := znum / r }
+ begin
+ z.re := znum.re / r;
+ z.im := znum.im / r;
+ end;
+
+ operator / (r : real; zden : complex) z : complex;
+ { division : z := r / zden }
+ var denom : real;
+ begin
+ with zden do denom := (re * re) + (im * im);
+ { generates a fpu exception if denom=0 as for reals }
+ z.re := (r * zden.re) / denom;
+ z.im := - (r * zden.im) / denom;
+ end;
+
+ function cmod (z : complex): real;
+ { module : r = |z| }
+ begin
+ with z do
+ cmod := sqrt((re * re) + (im * im));
+ end;
+
+ function carg (z : complex): real;
+ { argument : 0 / z = p ei0 }
+ begin
+ carg := arctan2(z.re, z.im);
+ end;
+
+ function cong (z : complex) : complex;
+ { complex conjugee :
+ if z := x + i.y
+ then cong is x - i.y }
+ begin
+ cong.re := z.re;
+ cong.im := - z.im;
+ end;
+
+ function cinv (z : complex) : complex;
+ { inverse : r := 1 / z }
+ var
+ denom : real;
+ begin
+ with z do denom := (re * re) + (im * im);
+ { generates a fpu exception if denom=0 as for reals }
+ cinv.re:=z.re/denom;
+ cinv.im:=-z.im/denom;
+ end;
+
+ operator = (z1, z2 : complex) b : boolean;
+ { returns TRUE if z1 = z2 }
+ begin
+ b := (z1.re = z2.re) and (z1.im = z2.im);
+ end;
+
+ operator = (z1 : complex; r :real) b : boolean;
+ { returns TRUE if z1 = r }
+ begin
+ b := (z1.re = r) and (z1.im = 0.0)
+ end;
+
+ operator = (r : real; z1 : complex) b : boolean;
+ { returns TRUE if z1 = r }
+ begin
+ b := (z1.re = r) and (z1.im = 0.0)
+ end;
+
+
+ { fonctions elementaires }
+
+ function cexp (z : complex) : complex;
+ { exponantial : r := exp(z) }
+ { exp(x + iy) = exp(x).exp(iy) = exp(x).[cos(y) + i sin(y)] }
+ var expz : real;
+ begin
+ expz := exp(z.re);
+ cexp.re := expz * cos(z.im);
+ cexp.im := expz * sin(z.im);
+ end;
+
+ function cln (z : complex) : complex;
+ { natural logarithm : r := ln(z) }
+ { ln( p exp(i0)) = ln(p) + i0 + 2kpi }
+ var modz : real;
+ begin
+ with z do
+ modz := (re * re) + (im * im);
+ cln.re := ln(modz);
+ cln.im := arctan2(z.re, z.im);
+ end;
+
+ function csqrt (z : complex) : complex;
+ { square root : r := sqrt(z) }
+ var
+ root, q : real;
+ begin
+ if (z.re<>0.0) or (z.im<>0.0) then
+ begin
+ root := sqrt(0.5 * (abs(z.re) + cmod(z)));
+ q := z.im / (2.0 * root);
+ if z.re >= 0.0 then
+ begin
+ csqrt.re := root;
+ csqrt.im := q;
+ end
+ else if z.im < 0.0 then
+ begin
+ csqrt.re := - q;
+ csqrt.im := - root
+ end
+ else
+ begin
+ csqrt.re := q;
+ csqrt.im := root
+ end
+ end
+ else csqrt := z;
+ end;
+
+
+ operator ** (z1, z2 : complex) z : complex;
+ { exp : z := z1 ** z2 }
+ begin
+ z := cexp(z2*cln(z1));
+ end;
+
+ operator ** (z1 : complex; r : real) z : complex;
+ { multiplication : z := z1 * r }
+ begin
+ z := cexp( r *cln(z1));
+ end;
+
+ operator ** (r : real; z1 : complex) z : complex;
+ { multiplication : z := r + z1 }
+ begin
+ z := cexp(z1*ln(r));
+ end;
+
+ { direct trigonometric functions }
+
+ function ccos (z : complex) : complex;
+ { complex cosinus }
+ { cos(x+iy) = cos(x).cos(iy) - sin(x).sin(iy) }
+ { cos(ix) = cosh(x) et sin(ix) = i.sinh(x) }
+ begin
+ ccos.re := cos(z.re) * cosh(z.im);
+ ccos.im := - sin(z.re) * sinh(z.im);
+ end;
+
+ function csin (z : complex) : complex;
+ { sinus complex }
+ { sin(x+iy) = sin(x).cos(iy) + cos(x).sin(iy) }
+ { cos(ix) = cosh(x) et sin(ix) = i.sinh(x) }
+ begin
+ csin.re := sin(z.re) * cosh(z.im);
+ csin.im := cos(z.re) * sinh(z.im);
+ end;
+
+ function ctg (z : complex) : complex;
+ { tangente }
+ var ccosz, temp : complex;
+ begin
+ ccosz := ccos(z);
+ temp := csin(z);
+ ctg := temp / ccosz;
+ end;
+
+ { fonctions trigonometriques inverses }
+
+ function carc_cos (z : complex) : complex;
+ { arc cosinus complex }
+ { arccos(z) = -i.argch(z) }
+ begin
+ carc_cos := -i*carg_ch(z);
+ end;
+
+ function carc_sin (z : complex) : complex;
+ { arc sinus complex }
+ { arcsin(z) = -i.argsh(i.z) }
+ begin
+ carc_sin := -i*carg_sh(i*z);
+ end;
+
+ function carc_tg (z : complex) : complex;
+ { arc tangente complex }
+ { arctg(z) = -i.argth(i.z) }
+ begin
+ carc_tg := -i*carg_th(i*z);
+ end;
+
+ { hyberbolic complex functions }
+
+ function cch (z : complex) : complex;
+ { hyberbolic cosinus }
+ { cosh(x+iy) = cosh(x).cosh(iy) + sinh(x).sinh(iy) }
+ { cosh(iy) = cos(y) et sinh(iy) = i.sin(y) }
+ begin
+ cch.re := cosh(z.re) * cos(z.im);
+ cch.im := sinh(z.re) * sin(z.im);
+ end;
+
+ function csh (z : complex) : complex;
+ { hyberbolic sinus }
+ { sinh(x+iy) = sinh(x).cosh(iy) + cosh(x).sinh(iy) }
+ { cosh(iy) = cos(y) et sinh(iy) = i.sin(y) }
+ begin
+ csh.re := sinh(z.re) * cos(z.im);
+ csh.im := cosh(z.re) * sin(z.im);
+ end;
+
+ function cth (z : complex) : complex;
+ { hyberbolic complex tangent }
+ { th(x) = sinh(x) / cosh(x) }
+ { cosh(x) > 1 qq x }
+ var temp : complex;
+ begin
+ temp := cch(z);
+ z := csh(z);
+ cth := z / temp;
+ end;
+
+ { inverse complex hyperbolic functions }
+
+ function carg_ch (z : complex) : complex;
+ { hyberbolic arg cosinus }
+ { _________ }
+ { argch(z) = -/+ ln(z + i.V 1 - z.z) }
+ begin
+ carg_ch:=-cln(z+i*csqrt(z*z-1.0));
+ end;
+
+ function carg_sh (z : complex) : complex;
+ { hyperbolic arc sinus }
+ { ________ }
+ { argsh(z) = ln(z + V 1 + z.z) }
+ begin
+ carg_sh:=cln(z+csqrt(z*z+1.0));
+ end;
+
+ function carg_th (z : complex) : complex;
+ { hyperbolic arc tangent }
+ { argth(z) = 1/2 ln((z + 1) / (1 - z)) }
+ begin
+ carg_th:=cln((z+1.0)/(z-1.0))/2.0;
+ end;
+
+ { functions to write out a complex value }
+ function cstr(z : complex) : string;
+ var
+ istr : string;
+ begin
+ str(z.im,istr);
+ str(z.re,cstr);
+ while istr[1]=' ' do
+ delete(istr,1,1);
+ if z.im<0 then
+ cstr:=cstr+istr+'i'
+ else if z.im>0 then
+ cstr:=cstr+'+'+istr+'i';
+ end;
+
+ function cstr(z:complex;len : integer) : string;
+ var
+ istr : string;
+ begin
+ str(z.im:len,istr);
+ while istr[1]=' ' do
+ delete(istr,1,1);
+ str(z.re:len,cstr);
+ if z.im<0 then
+ cstr:=cstr+istr+'i'
+ else if z.im>0 then
+ cstr:=cstr+'+'+istr+'i';
+ end;
+
+ function cstr(z:complex;len,dec : integer) : string;
+ var
+ istr : string;
+ begin
+ str(z.im:len:dec,istr);
+ while istr[1]=' ' do
+ delete(istr,1,1);
+ str(z.re:len:dec,cstr);
+ if z.im<0 then
+ cstr:=cstr+istr+'i'
+ else if z.im>0 then
+ cstr:=cstr+'+'+istr+'i';
+ end;
+
+
+end.
+{
+ $Log: ucomplex.pp,v $
+ Revision 1.4 2005/02/14 17:13:29 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/variant.inc b/rtl/inc/variant.inc
new file mode 100644
index 0000000000..747b43e376
--- /dev/null
+++ b/rtl/inc/variant.inc
@@ -0,0 +1,663 @@
+{
+ $Id: variant.inc,v 1.30 2005/04/28 19:34:19 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by the Free Pascal development team
+
+ This include file contains the implementation for variants
+ support in FPC as far as it is part of the system unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+var
+ variantmanager : tvariantmanager;
+
+procedure invalidvariantop;
+ begin
+ HandleErrorFrame(221,get_frame);
+ end;
+
+procedure vardisperror;
+ begin
+ HandleErrorFrame(222,get_frame);
+ end;
+
+
+{ ---------------------------------------------------------------------
+ Compiler helper routines.
+ ---------------------------------------------------------------------}
+
+procedure varclear(var v : tvardata);
+begin
+ if not(v.vtype in [varempty,varerror,varnull]) then
+ invalidvariantop;
+end;
+
+
+procedure variant_init(var v : tvardata);[Public,Alias:'FPC_VARIANT_INIT'];
+ begin
+ { calling the variant manager here is a problem because the static/global variants
+ are initialized while the variant manager isn't assigned }
+ fillchar(v,sizeof(variant),0);
+ end;
+
+
+procedure variant_clear(var v : tvardata);[Public,Alias:'FPC_VARIANT_CLEAR'];
+ begin
+ if assigned(VarClearProc) then
+ VarClearProc(v);
+ end;
+
+
+procedure variant_addref(var v : tvardata);[Public,Alias:'FPC_VARIANT_ADDREF'];
+ begin
+ if assigned(VarAddRefProc) then
+ VarAddRefProc(v);
+ end;
+
+{ using pointers as argument here makes life for the compiler easier }
+procedure fpc_variant_copy(d,s : pointer);compilerproc;
+ begin
+ if assigned(VarCopyProc) then
+ VarCopyProc(tvardata(d^),tvardata(s^));
+ end;
+
+
+Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; compilerproc;
+ begin
+ if (InOutRes<>0) then
+ exit;
+ case TextRec(f).mode of
+ { fmAppend gets changed to fmOutPut in do_open (JM) }
+ fmOutput:
+ if len=-1 then
+ variantmanager.write0variant(f,v)
+ else
+ variantmanager.writevariant(f,v,len);
+ fmInput:
+ InOutRes:=105
+ else InOutRes:=103;
+ end;
+ end;
+
+
+procedure fpc_vararray_get(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+ begin
+ d:=variantmanager.vararrayget(s,len,indices);
+ end;
+
+
+procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;len : sizeint);compilerproc;
+ begin
+ variantmanager.vararrayput(d,s,len,indices);
+ end;
+
+
+function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
+ begin
+ variantmanager.vartodynarray(result,v,typeinfo);
+ end;
+
+
+function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;
+ begin
+ variantmanager.varfromdynarray(result,dynarr,typeinfo);
+ end;
+
+
+function fpc_variant_to_interface(const v : variant) : iinterface;compilerproc;
+ begin
+ variantmanager.vartointf(result,v);
+ end;
+
+
+function fpc_interface_to_variant(const i : iinterface) : variant;compilerproc;
+ begin
+ variantmanager.varfromintf(result,i);
+ end;
+
+
+{ ---------------------------------------------------------------------
+ Overloaded operators.
+ ---------------------------------------------------------------------}
+
+
+{ Integer }
+
+operator :=(const source : byte) dest : variant;
+
+begin
+ Variantmanager.varfromInt(Dest,Source,1);
+end;
+
+
+operator :=(const source : shortint) dest : variant;
+
+begin
+ Variantmanager.varfromInt(Dest,Source,-1);
+end;
+
+
+operator :=(const source : word) dest : variant;
+
+begin
+ Variantmanager.varfromInt(Dest,Source,2);
+end;
+
+
+operator :=(const source : smallint) dest : variant;
+begin
+ Variantmanager.varfromInt(Dest,Source,-2);
+end;
+
+
+operator :=(const source : dword) dest : variant;
+begin
+ Variantmanager.varfromInt(Dest,Source,4);
+end;
+
+
+operator :=(const source : longint) dest : variant;
+begin
+ Variantmanager.varfromInt(Dest,Source,-4);
+end;
+
+
+operator :=(const source : qword) dest : variant;
+begin
+ Variantmanager.varfromWord64(Dest,Source);
+end;
+
+
+operator :=(const source : int64) dest : variant;
+begin
+ Variantmanager.varfromInt64(Dest,Source);
+end;
+
+{ Boolean }
+
+operator :=(const source : boolean) dest : variant;
+begin
+ Variantmanager.varfromBool(Dest,Source);
+end;
+
+
+operator :=(const source : wordbool) dest : variant;
+
+begin
+ Variantmanager.varfromBool(Dest,Boolean(Source));
+end;
+
+
+operator :=(const source : longbool) dest : variant;
+
+begin
+ Variantmanager.varfromBool(Dest,Boolean(Source));
+end;
+
+
+{ Chars }
+
+operator :=(const source : char) dest : variant;
+
+begin
+ VariantManager.VarFromPStr(Dest,Source);
+end;
+
+
+operator :=(const source : widechar) dest : variant;
+
+begin
+ VariantManager.VarFromWStr(Dest,Source);
+end;
+
+{ Strings }
+
+operator :=(const source : shortstring) dest : variant;
+
+begin
+ VariantManager.VarFromPStr(Dest,Source);
+end;
+
+
+operator :=(const source : ansistring) dest : variant;
+
+begin
+ VariantManager.VarFromLStr(Dest,Source);
+end;
+
+
+operator :=(const source : widestring) dest : variant;
+
+begin
+ VariantManager.VarFromWStr(Dest,Source);
+end;
+
+{ Floats }
+
+{$ifdef SUPPORT_SINGLE}
+operator :=(const source : single) dest : variant;
+begin
+ VariantManager.VarFromReal(Dest,Source);
+end;
+{$endif SUPPORT_SINGLE}
+
+
+{$ifdef SUPPORT_DOUBLE}
+operator :=(const source : double) dest : variant;
+begin
+ VariantManager.VarFromReal(Dest,Source);
+end;
+{$endif SUPPORT_DOUBLE}
+
+
+{$ifdef SUPPORT_EXTENDED}
+operator :=(const source : extended) dest : variant;
+begin
+ VariantManager.VarFromReal(Dest,Source);
+end;
+{$endif SUPPORT_EXTENDED}
+
+
+{$ifdef SUPPORT_COMP}
+Operator :=(const source : comp) dest : variant;
+begin
+ VariantManager.VarFromReal(Dest,Source);
+end;
+{$endif SUPPORT_COMP}
+
+
+{ Misc. }
+operator :=(const source : currency) dest : variant;
+ begin
+ VariantManager.VarFromCurr(Dest,Source);
+ end;
+
+
+operator :=(const source : tdatetime) dest : variant;
+ begin
+ VariantManager.VarFromTDateTime(Dest,Source);
+ end;
+
+{**********************************************************************
+ from Variant assignments
+ **********************************************************************}
+
+{ Integer }
+
+operator :=(const source : variant) dest : byte;
+
+begin
+ dest:=variantmanager.vartoint(source);
+end;
+
+
+operator :=(const source : variant) dest : shortint;
+
+begin
+ dest:=variantmanager.vartoint(source);
+end;
+
+
+operator :=(const source : variant) dest : word;
+
+begin
+ dest:=variantmanager.vartoint(source);
+end;
+
+
+operator :=(const source : variant) dest : smallint;
+
+begin
+ dest:=variantmanager.vartoint(source);
+end;
+
+
+operator :=(const source : variant) dest : dword;
+
+begin
+ dest:=variantmanager.vartoint(source);
+end;
+
+
+operator :=(const source : variant) dest : longint;
+
+begin
+ dest:=variantmanager.vartoint(source);
+end;
+
+
+operator :=(const source : variant) dest : qword;
+
+begin
+ dest:=variantmanager.vartoword64(source);
+end;
+
+
+operator :=(const source : variant) dest : int64;
+
+begin
+ dest:=variantmanager.vartoint64(source);
+end;
+
+
+{ Boolean }
+
+operator :=(const source : variant) dest : boolean;
+
+begin
+ dest:=variantmanager.vartobool(source);
+end;
+
+
+operator :=(const source : variant) dest : wordbool;
+
+begin
+ dest:=variantmanager.vartobool(source);
+end;
+
+
+operator :=(const source : variant) dest : longbool;
+
+begin
+ dest:=variantmanager.vartobool(source);
+end;
+
+
+{ Chars }
+
+operator :=(const source : variant) dest : char;
+
+Var
+ S : String;
+
+begin
+ VariantManager.VarToPStr(S,Source);
+ If Length(S)>0 then
+ Dest:=S[1];
+end;
+
+
+operator :=(const source : variant) dest : widechar;
+
+Var
+ WS : WideString;
+
+begin
+ VariantManager.VarToWStr(WS,Source);
+ If Length(WS)>0 then
+ Dest:=WS[1];
+end;
+
+
+{ Strings }
+
+operator :=(const source : variant) dest : shortstring;
+
+begin
+ VariantManager.VarToPStr(Dest,Source);
+end;
+
+operator :=(const source : variant) dest : ansistring;
+
+begin
+ VariantManager.vartolstr(dest,source);
+end;
+
+operator :=(const source : variant) dest : widestring;
+
+begin
+ variantmanager.vartowstr(dest,source);
+end;
+
+{ Floats }
+
+{$ifdef SUPPORT_SINGLE}
+operator :=(const source : variant) dest : single;
+begin
+ dest:=variantmanager.vartoreal(source);
+end;
+{$endif SUPPORT_SINGLE}
+
+
+{$ifdef SUPPORT_DOUBLE}
+operator :=(const source : variant) dest : double;
+begin
+ dest:=variantmanager.vartoreal(source);
+end;
+{$endif SUPPORT_DOUBLE}
+
+
+{$ifdef SUPPORT_EXTENDED}
+operator :=(const source : variant) dest : extended;
+begin
+ dest:=variantmanager.vartoreal(source);
+end;
+{$endif SUPPORT_EXTENDED}
+
+
+{$ifdef SUPPORT_COMP}
+operator :=(const source : variant) dest : comp;
+begin
+ dest:=comp(variantmanager.vartoreal(source));
+end;
+{$endif SUPPORT_COMP}
+
+
+{ Misc. }
+operator :=(const source : variant) dest : currency;
+begin
+ dest:=variantmanager.vartocurr(source);
+end;
+
+
+{$ifdef HASOVERLOADASSIGNBYUNIQUERESULT}
+operator :=(const source : variant) dest : tdatetime;
+begin
+ dest:=variantmanager.vartotdatetime(source);
+end;
+{$endif HASOVERLOADASSIGNBYUNIQUERESULT}
+
+{**********************************************************************
+ Operators
+ **********************************************************************}
+
+operator or(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opor);
+ end;
+
+operator and(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opand);
+ end;
+
+operator xor(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opxor);
+ end;
+
+operator not(const op : variant) dest : variant;
+ begin
+ dest:=op;
+ variantmanager.varnot(dest);
+ end;
+
+operator shl(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opshiftleft);
+ end;
+
+operator shr(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opshiftright);
+ end;
+
+operator +(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opadd);
+ end;
+
+operator -(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opsubtract);
+ end;
+
+operator *(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opmultiply);
+ end;
+
+operator /(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opdivide);
+ end;
+
+operator **(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,oppower);
+ end;
+
+operator div(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opintdivide);
+ end;
+
+operator mod(const op1,op2 : variant) dest : variant;
+ begin
+ dest:=op1;
+ variantmanager.varop(dest,op2,opmodulus);
+ end;
+
+operator -(const op : variant) dest : variant;
+ begin
+ dest:=op;
+ variantmanager.varneg(dest);
+ end;
+
+operator =(const op1,op2 : variant) dest : boolean;
+ begin
+ dest:=variantmanager.cmpop(op1,op2,opcmpeq);
+ end;
+
+operator <(const op1,op2 : variant) dest : boolean;
+ begin
+ dest:=variantmanager.cmpop(op1,op2,opcmplt);
+ end;
+
+operator >(const op1,op2 : variant) dest : boolean;
+ begin
+ dest:=variantmanager.cmpop(op1,op2,opcmpgt);
+ end;
+
+operator >=(const op1,op2 : variant) dest : boolean;
+ begin
+ dest:=variantmanager.cmpop(op1,op2,opcmpge);
+ end;
+
+operator <=(const op1,op2 : variant) dest : boolean;
+ begin
+ dest:=variantmanager.cmpop(op1,op2,opcmplt);
+ end;
+
+procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
+ begin
+ variantmanager.vararrayredim(a,highbound);
+ end;
+
+
+{**********************************************************************
+ Variant manager functions
+ **********************************************************************}
+
+procedure GetVariantManager(var VarMgr: TVariantManager);
+begin
+ VarMgr:=VariantManager;
+end;
+
+procedure SetVariantManager(const VarMgr: TVariantManager);
+begin
+ VariantManager:=VarMgr;
+end;
+
+function IsVariantManagerSet: Boolean;
+var
+ i : longint;
+begin
+ I:=0;
+ Result:=True;
+ While Result and (I<(sizeof(tvariantmanager) div sizeof(pointer))-1) do
+ begin
+ Result:=Pointer(ppointer(@variantmanager+i*sizeof(pointer))^)<>Pointer(@invalidvariantop);
+ Inc(I);
+ end;
+end;
+
+
+procedure initvariantmanager;
+ var
+ i : longint;
+ begin
+ VarDispProc:=@vardisperror;
+ DispCallByIDProc:=@vardisperror;
+ tvardata(Unassigned).VType:=varEmpty;
+ tvardata(Null).VType:=varNull;
+ for i:=0 to (sizeof(tvariantmanager) div sizeof(pointer))-1 do
+ ppointer(@variantmanager+i*sizeof(pointer))^:=@invalidvariantop;
+ pointer(variantmanager.varclear):=@varclear
+ end;
+
+
+{
+ $Log: variant.inc,v $
+ Revision 1.30 2005/04/28 19:34:19 florian
+ + variant<->currency/tdatetime operators
+
+ Revision 1.29 2005/04/10 20:24:31 florian
+ + basic operators (int, real and string) for variants implemented
+
+ Revision 1.28 2005/04/10 09:22:38 florian
+ + varrarrayredim added and implemented
+
+ Revision 1.27 2005/03/28 13:38:05 florian
+ + a lot of vararray stuff
+
+ Revision 1.26 2005/03/25 19:02:59 florian
+ + more vararray stuff
+
+ Revision 1.25 2005/02/24 22:36:36 florian
+ + some variant stuff fixed and added
+
+ Revision 1.24 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.23 2005/02/01 20:22:24 florian
+ + interface <-> variant conversion from Danny Milosavljevic
+
+ Revision 1.22 2005/01/15 18:47:26 florian
+ * several variant init./final. stuff fixed
+
+ Revision 1.21 2005/01/08 20:43:44 florian
+ + init/cleaning code for variants added
+
+ Revision 1.20 2005/01/07 21:15:46 florian
+ + basic rtl support for variant <-> interface implemented
+
+}
diff --git a/rtl/inc/varianth.inc b/rtl/inc/varianth.inc
new file mode 100644
index 0000000000..b250d9e885
--- /dev/null
+++ b/rtl/inc/varianth.inc
@@ -0,0 +1,350 @@
+{
+ $Id: varianth.inc,v 1.24 2005/04/28 19:34:19 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by the Free Pascal development team
+
+ This include file contains the declarations for variants
+ support in FPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+const
+ varempty = 0;
+ varnull = 1;
+ varsmallint = 2;
+ varinteger = 3;
+ varsingle = 4;
+ vardouble = 5;
+ varcurrency = 6;
+ vardate = 7;
+ varolestr = 8;
+ vardispatch = 9;
+ varerror = 10;
+ varboolean = 11;
+ varvariant = 12;
+ varunknown = 13;
+ vardecimal = 14;
+ varshortint = 16;
+ varbyte = 17;
+ varword = 18;
+ varlongword = 19;
+ varint64 = 20;
+ varqword = 21;
+
+ varstrarg = $48;
+ varstring = $100;
+ varany = $101;
+ vartypemask = $fff;
+ vararray = $2000;
+ varbyref = $4000;
+
+ varword64 = varqword;
+
+type
+ tvartype = word;
+
+ pvararrayboundarray = ^tvararrayboundarray;
+ pvararraycoorarray = ^tvararraycoorarray;
+ pvararraybound = ^tvararraybound;
+ pvararray = ^tvararray;
+
+ tvararraybound = packed record
+ elementcount,lowbound : SizeInt;
+ end;
+
+ tvararray = packed record
+ dimcount,flags : word;
+ elementsize,lockcount : longint;
+ data : pointer;
+ bounds : array[0..255] of tvararraybound;
+ end;
+
+ tvararrayboundarray = array[0..0] of tvararraybound;
+ tvararraycoorarray = array[0..0] of SizeInt;
+
+ tvarop = (opadd,opsubtract,opmultiply,opdivide,opintdivide,opmodulus,
+ opshiftleft,opshiftright,opand,opor,opxor,opcompare,opnegate,
+ opnot,opcmpeq,opcmpne,opcmplt,opcmple,opcmpgt,opcmpge,oppower);
+
+ tvardata = packed record
+ vtype : tvartype;
+ case integer of
+ 0:(res1 : word;
+ case integer of
+ 0:
+ (res2,res3 : word;
+ case word of
+ varsmallint : (vsmallint : smallint);
+ varinteger : (vinteger : longint);
+ varsingle : (vsingle : single);
+ vardouble : (vdouble : double);
+ varcurrency : (vcurrency : currency);
+ vardate : (vdate : tdatetime);
+ varolestr : (volestr : pwidechar);
+ vardispatch : (vdispatch : pointer);
+ varerror : (verror : hresult);
+ varboolean : (vboolean : wordbool);
+ varunknown : (vunknown : pointer);
+ // vardecimal : ( : );
+ varshortint : (vshortint : shortint);
+ varbyte : (vbyte : byte);
+ varword : (vword : word);
+ varlongword : (vlongword : dword);
+ varint64 : (vint64 : int64);
+ varqword : (vqword : qword);
+ varword64 : (vword64 : qword);
+ varstring : (vstring : pointer);
+ varany : (vany : pointer);
+ vararray : (varray : pvararray);
+ varbyref : (vpointer : pointer);
+ );
+ 1:
+ (vlongs : array[0..2] of longint);
+ );
+ 1:(vwords : array[0..6] of word);
+ 2:(vbytes : array[0..13] of byte);
+ end;
+ pvardata = ^tvardata;
+
+ pcalldesc = ^tcalldesc;
+ tcalldesc = packed record
+ calltype,argcount,namedargcount : byte;
+ argtypes : array[0..255] of byte;
+ end;
+
+ pdispdesc = ^tdispdesc;
+ tdispdesc = packed record
+ dispid : longint;
+ restype : byte;
+ calldesc : tcalldesc;
+ end;
+
+ tvariantmanager = record
+ vartoint : function(const v : variant) : longint;
+ vartoint64 : function(const v : variant) : int64;
+ vartoword64 : function(const v : variant) : qword;
+ vartobool : function(const v : variant) : boolean;
+ vartoreal : function(const v : variant) : extended;
+ vartotdatetime : function(const v : variant) : tdatetime;
+ vartocurr : function(const v : variant) : currency;
+ vartopstr : procedure(var s ;const v : variant);
+ vartolstr : procedure(var s : ansistring;const v : variant);
+ vartowstr : procedure(var s : widestring;const v : variant);
+ vartointf : procedure(var intf : iinterface;const v : variant);
+ vartodisp : procedure(var disp : idispatch;const v : variant);
+ vartodynarray : procedure(var dynarr : pointer;const v : variant;
+ typeinfo : pointer);
+
+ varfrombool : procedure(var dest : variant;const source : Boolean);
+ varfromint : procedure(var dest : variant;const source,Range : longint);
+ varfromint64 : procedure(var dest : variant;const source : int64);
+ varfromword64 : procedure(var dest : variant;const source : qword);
+ varfromreal : procedure(var dest : variant;const source : extended);
+ varfromtdatetime : procedure(var dest : Variant;const source : TDateTime);
+ varfromcurr : procedure(var dest : Variant;const source : Currency);
+ varfrompstr: procedure(var dest : variant; const source : ShortString);
+ varfromlstr: procedure(var dest : variant; const source : ansistring);
+ varfromwstr: procedure(var dest : variant; const source : WideString);
+ varfromintf: procedure(var dest : variant;const source : iinterface);
+ varfromdisp: procedure(var dest : variant;const source : idispatch);
+ varfromdynarray: procedure(var dest : variant;const source : pointer; typeinfo: pointer);
+ olevarfrompstr: procedure(var dest : olevariant; const source : shortstring);
+ olevarfromlstr: procedure(var dest : olevariant; const source : ansistring);
+ olevarfromvar: procedure(var dest : olevariant; const source : variant);
+ olevarfromint: procedure(var dest : olevariant; const source : longint;const range : shortint);
+
+ { operators }
+ varop : procedure(var left : variant;const right : variant;opcode : tvarop);
+ cmpop : function(const left,right : variant;const opcode : tvarop) : boolean;
+ varneg : procedure(var v : variant);
+ varnot : procedure(var v : variant);
+
+ { misc }
+ varinit : procedure(var v : variant);
+ varclear : procedure(var v : variant);
+ varaddref : procedure(var v : variant);
+ varcopy : procedure(var dest : variant;const source : variant);
+ varcast : procedure(var dest : variant;const source : variant;vartype : longint);
+ varcastole : procedure(var dest : variant; const source : variant;vartype : longint);
+
+ dispinvoke: procedure(dest : pvardata;const source : tvardata;
+ calldesc : pcalldesc;params : pointer);cdecl;
+
+ vararrayredim : procedure(var a : variant;highbound : SizeInt);
+ vararrayget : function(const a : variant;indexcount : SizeInt;indices : PSizeInt) : variant;cdecl;
+ vararrayput: procedure(var a : variant; const value : variant;
+ indexcount : SizeInt;indices : PSizeInt);cdecl;
+ writevariant : function(var t : text;const v : variant;width : longint) : Pointer;
+ write0Variant : function(var t : text;const v : Variant) : Pointer;
+ end;
+ pvariantmanager = ^tvariantmanager;
+
+procedure GetVariantManager(var VarMgr: TVariantManager);
+procedure SetVariantManager(const VarMgr: TVariantManager);
+function IsVariantManagerSet: Boolean;
+
+const
+ VarClearProc : procedure(var v : TVarData) = nil;
+ VarAddRefProc : procedure(var v : TVarData) = nil;
+ VarCopyProc : procedure(var d : TVarData;const s : TVarData) = nil;
+ VarToLStrProc : procedure(var d : AnsiString;const s : TVarData) = nil;
+ VarToWStrProc : procedure(var d : WideString;const s : TVarData) = nil;
+
+var
+ VarDispProc : pointer;
+ DispCallByIDProc : pointer;
+ Null,Unassigned : Variant;
+
+{**********************************************************************
+ to Variant assignments
+ **********************************************************************}
+
+{ Integer }
+operator :=(const source : byte) dest : variant;
+operator :=(const source : shortint) dest : variant;
+operator :=(const source : word) dest : variant;
+operator :=(const source : smallint) dest : variant;
+operator :=(const source : dword) dest : variant;
+operator :=(const source : longint) dest : variant;
+operator :=(const source : qword) dest : variant;
+operator :=(const source : int64) dest : variant;
+
+{ Boolean }
+operator :=(const source : boolean) dest : variant;
+operator :=(const source : wordbool) dest : variant;
+operator :=(const source : longbool) dest : variant;
+
+{ Chars }
+operator :=(const source : char) dest : variant;
+operator :=(const source : widechar) dest : variant;
+
+{ Strings }
+operator :=(const source : shortstring) dest : variant;
+operator :=(const source : ansistring) dest : variant;
+operator :=(const source : widestring) dest : variant;
+
+{ Floats }
+{$ifdef SUPPORT_SINGLE}
+operator :=(const source : single) dest : variant;
+{$endif SUPPORT_SINGLE}
+{$ifdef SUPPORT_DOUBLE}
+operator :=(const source : double) dest : variant;
+{$endif SUPPORT_DOUBLE}
+{$ifdef SUPPORT_EXTENDED}
+operator :=(const source : extended) dest : variant;
+{$endif SUPPORT_EXTENDED}
+{$ifdef SUPPORT_COMP}
+operator :=(const source : comp) dest : variant;
+{$endif SUPPORT_COMP}
+
+{ Misc. }
+operator :=(const source : currency) dest : variant;
+operator :=(const source : tdatetime) dest : variant;
+
+{**********************************************************************
+ from Variant assignments
+ **********************************************************************}
+
+{ Integer }
+operator :=(const source : variant) dest : byte;
+operator :=(const source : variant) dest : shortint;
+operator :=(const source : variant) dest : word;
+operator :=(const source : variant) dest : smallint;
+operator :=(const source : variant) dest : dword;
+operator :=(const source : variant) dest : longint;
+operator :=(const source : variant) dest : qword;
+operator :=(const source : variant) dest : int64;
+
+{ Boolean }
+operator :=(const source : variant) dest : boolean;
+operator :=(const source : variant) dest : wordbool;
+operator :=(const source : variant) dest : longbool;
+
+{ Chars }
+operator :=(const source : variant) dest : char;
+operator :=(const source : variant) dest : widechar;
+
+{ Strings }
+operator :=(const source : variant) dest : shortstring;
+operator :=(const source : variant) dest : ansistring;
+operator :=(const source : variant) dest : widestring;
+
+{ Floats }
+{$ifdef SUPPORT_SINGLE}
+operator :=(const source : variant) dest : single;
+{$endif SUPPORT_SINGLE}
+{$ifdef SUPPORT_DOUBLE}
+operator :=(const source : variant) dest : double;
+{$endif SUPPORT_DOUBLE}
+{$ifdef SUPPORT_EXTENDED}
+operator :=(const source : variant) dest : extended;
+{$endif SUPPORT_EXTENDED}
+{$ifdef SUPPORT_EXTENDED}
+operator :=(const source : variant) dest : comp;
+{$endif SUPPORT_COMP}
+
+{ Misc. }
+operator :=(const source : variant) dest : currency;
+{$ifdef HASOVERLOADASSIGNBYUNIQUERESULT}
+operator :=(const source : variant) dest : tdatetime;
+{$endif HASOVERLOADASSIGNBYUNIQUERESULT}
+
+{**********************************************************************
+ Operators
+ **********************************************************************}
+
+operator or(const op1,op2 : variant) dest : variant;
+operator and(const op1,op2 : variant) dest : variant;
+operator xor(const op1,op2 : variant) dest : variant;
+operator not(const op : variant) dest : variant;
+operator shl(const op1,op2 : variant) dest : variant;
+operator shr(const op1,op2 : variant) dest : variant;
+operator +(const op1,op2 : variant) dest : variant;
+operator -(const op1,op2 : variant) dest : variant;
+operator *(const op1,op2 : variant) dest : variant;
+operator /(const op1,op2 : variant) dest : variant;
+operator **(const op1,op2 : variant) dest : variant;
+operator div(const op1,op2 : variant) dest : variant;
+operator mod(const op1,op2 : variant) dest : variant;
+operator -(const op : variant) dest : variant;
+operator =(const op1,op2 : variant) dest : boolean;
+operator <(const op1,op2 : variant) dest : boolean;
+operator >(const op1,op2 : variant) dest : boolean;
+operator >=(const op1,op2 : variant) dest : boolean;
+operator <=(const op1,op2 : variant) dest : boolean;
+
+{ variant helpers }
+procedure VarArrayRedim(var A: Variant; HighBound: SizeInt);
+
+{
+ $Log: varianth.inc,v $
+ Revision 1.24 2005/04/28 19:34:19 florian
+ + variant<->currency/tdatetime operators
+
+ Revision 1.23 2005/04/10 20:24:31 florian
+ + basic operators (int, real and string) for variants implemented
+
+ Revision 1.22 2005/04/10 09:22:38 florian
+ + varrarrayredim added and implemented
+
+ Revision 1.21 2005/03/28 13:38:05 florian
+ + a lot of vararray stuff
+
+ Revision 1.20 2005/03/25 19:02:59 florian
+ + more vararray stuff
+
+ Revision 1.19 2005/03/25 18:03:50 florian
+ + some vararray stuff added
+
+ Revision 1.18 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.17 2005/01/15 18:47:26 florian
+ * several variant init./final. stuff fixed
+}
diff --git a/rtl/inc/variants.pp b/rtl/inc/variants.pp
new file mode 100644
index 0000000000..f20e3862e0
--- /dev/null
+++ b/rtl/inc/variants.pp
@@ -0,0 +1,3138 @@
+{
+ $Id: variants.pp,v 1.50 2005/05/07 09:47:41 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by the Free Pascal development team
+
+ This include file contains the declarations for variants
+ support in FPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+{$h+}
+
+{ Using inlining for small system functions/wrappers }
+{$ifdef HASINLINE}
+ {$inline on}
+ {$define VARIANTINLINE}
+{$endif}
+
+unit variants;
+
+interface
+
+ uses
+ sysutils,sysconst,rtlconsts,typinfo;
+
+{$ifdef HASVARIANT}
+type
+ EVariantParamNotFoundError = class(EVariantError);
+ EVariantInvalidOpError = class(EVariantError);
+ EVariantTypeCastError = class(EVariantError);
+ EVariantOverflowError = class(EVariantError);
+ EVariantInvalidArgError = class(EVariantError);
+ EVariantBadVarTypeError = class(EVariantError);
+ EVariantBadIndexError = class(EVariantError);
+ EVariantArrayLockedError = class(EVariantError);
+ EVariantNotAnArrayError = class(EVariantError);
+ EVariantArrayCreateError = class(EVariantError);
+ EVariantNotImplError = class(EVariantError);
+ EVariantOutOfMemoryError = class(EVariantError);
+ EVariantUnexpectedError = class(EVariantError);
+ EVariantDispatchError = class(EVariantError);
+ EVariantRangeCheckError = class(EVariantOverflowError);
+ EVariantInvalidNullOpError = class(EVariantInvalidOpError);
+
+ TVariantRelationship = (vrEqual, vrLessThan, vrGreaterThan, vrNotEqual);
+ TNullCompareRule = (ncrError, ncrStrict, ncrLoose);
+ TBooleanToStringRule = (bsrAsIs, bsrLower, bsrUpper);
+
+Const
+ OrdinalVarTypes = [varSmallInt, varInteger, varBoolean, varShortInt,
+ varByte, varWord,varLongWord,varInt64];
+ FloatVarTypes = [varSingle, varDouble, varCurrency];
+
+{ Variant support procedures and functions }
+
+function VarType(const V: Variant): TVarType;
+function VarAsType(const V: Variant; AVarType: TVarType): Variant;
+function VarIsType(const V: Variant; AVarType: TVarType): Boolean; overload;
+function VarIsType(const V: Variant; const AVarTypes: array of TVarType): Boolean; overload;
+function VarIsByRef(const V: Variant): Boolean;
+
+function VarIsEmpty(const V: Variant): Boolean;
+procedure VarCheckEmpty(const V: Variant);
+function VarIsNull(const V: Variant): Boolean;
+function VarIsClear(const V: Variant): Boolean;
+
+function VarIsCustom(const V: Variant): Boolean;
+function VarIsOrdinal(const V: Variant): Boolean;
+function VarIsFloat(const V: Variant): Boolean;
+function VarIsNumeric(const V: Variant): Boolean;
+function VarIsStr(const V: Variant): Boolean;
+
+function VarToStr(const V: Variant): string;
+function VarToStrDef(const V: Variant; const ADefault: string): string;
+function VarToWideStr(const V: Variant): WideString;
+function VarToWideStrDef(const V: Variant; const ADefault: WideString): WideString;
+
+function VarToDateTime(const V: Variant): TDateTime;
+function VarFromDateTime(const DateTime: TDateTime): Variant;
+
+function VarInRange(const AValue, AMin, AMax: Variant): Boolean;
+function VarEnsureRange(const AValue, AMin, AMax: Variant): Variant;
+
+function VarIsEmptyParam(const V: Variant): Boolean;
+
+procedure VarClear(var V: Variant);{$ifdef VARIANTINLINE}inline;{$endif VARIANTINLINE}
+
+procedure SetClearVarToEmptyParam(var V: TVarData);
+
+function VarIsError(const V: Variant; out AResult: HRESULT): Boolean;
+function VarIsError(const V: Variant): Boolean;
+function VarAsError(AResult: HRESULT): Variant;
+
+function VarSupports(const V: Variant; const IID: TGUID; out Intf): Boolean;
+function VarSupports(const V: Variant; const IID: TGUID): Boolean;
+
+{ Variant copy support }
+procedure VarCopyNoInd(var Dest: Variant; const Source: Variant);
+
+{ Variant array support procedures and functions }
+
+function VarArrayCreate(const Bounds: array of SizeInt; AVarType: TVarType): Variant;
+function VarArrayOf(const Values: array of Variant): Variant;
+
+function VarArrayAsPSafeArray(const A: Variant): PVarArray;
+
+function VarArrayDimCount(const A: Variant) : SizeInt;
+function VarArrayLowBound(const A: Variant; Dim : SizeInt) : SizeInt;
+function VarArrayHighBound(const A: Variant; Dim : SizeInt) : SizeInt;
+
+function VarArrayLock(const A: Variant): Pointer;
+procedure VarArrayUnlock(const A: Variant);
+
+function VarArrayRef(const A: Variant): Variant;
+
+function VarIsArray(const A: Variant): Boolean;
+function VarIsArray(const A: Variant; AResolveByRef: Boolean): Boolean;
+
+function VarTypeIsValidArrayType(const AVarType: TVarType): Boolean;
+function VarTypeIsValidElementType(const AVarType: TVarType): Boolean;
+
+{ Variant <--> Dynamic Arrays }
+
+procedure DynArrayToVariant(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
+procedure DynArrayFromVariant(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
+
+{ Global constants }
+
+function Unassigned: Variant; // Unassigned standard constant
+function Null: Variant; // Null standard constant
+
+var
+ EmptyParam: OleVariant;
+
+{ Custom variant base class }
+
+type
+ TVarCompareResult = (crLessThan, crEqual, crGreaterThan);
+ TCustomVariantType = class(TObject, IInterface)
+ private
+ FVarType: TVarType;
+ protected
+ function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+ procedure SimplisticClear(var V: TVarData);
+ procedure SimplisticCopy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean = False);
+ procedure RaiseInvalidOp;
+ procedure RaiseCastError;
+ procedure RaiseDispError;
+ function LeftPromotion(const V: TVarData; const Operation: TVarOp; out RequiredVarType: TVarType): Boolean; virtual;
+ function RightPromotion(const V: TVarData; const Operation: TVarOp; out RequiredVarType: TVarType): Boolean; virtual;
+ function OlePromotion(const V: TVarData; out RequiredVarType: TVarType): Boolean; virtual;
+ procedure DispInvoke(var Dest: TVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer); virtual;
+ procedure VarDataInit(var Dest: TVarData);
+ procedure VarDataClear(var Dest: TVarData);
+ procedure VarDataCopy(var Dest: TVarData; const Source: TVarData);
+ procedure VarDataCopyNoInd(var Dest: TVarData; const Source: TVarData);
+ procedure VarDataCast(var Dest: TVarData; const Source: TVarData);
+ procedure VarDataCastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType); overload;
+ procedure VarDataCastTo(var Dest: TVarData; const AVarType: TVarType); overload;
+ procedure VarDataCastToOleStr(var Dest: TVarData);
+ procedure VarDataFromStr(var V: TVarData; const Value: string);
+ procedure VarDataFromOleStr(var V: TVarData; const Value: WideString);
+ function VarDataToStr(const V: TVarData): string;
+ function VarDataIsEmptyParam(const V: TVarData): Boolean;
+ function VarDataIsByRef(const V: TVarData): Boolean;
+ function VarDataIsArray(const V: TVarData): Boolean;
+ function VarDataIsOrdinal(const V: TVarData): Boolean;
+ function VarDataIsFloat(const V: TVarData): Boolean;
+ function VarDataIsNumeric(const V: TVarData): Boolean;
+ function VarDataIsStr(const V: TVarData): Boolean;
+ public
+ constructor Create; overload;
+ constructor Create(RequestedVarType: TVarType); overload;
+ destructor Destroy; override;
+ function IsClear(const V: TVarData): Boolean; virtual;
+ procedure Cast(var Dest: TVarData; const Source: TVarData); virtual;
+ procedure CastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType); virtual;
+ procedure CastToOle(var Dest: TVarData; const Source: TVarData); virtual;
+ procedure Clear(var V: TVarData); virtual; abstract;
+ procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); virtual; abstract;
+ procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp); virtual;
+ procedure UnaryOp(var Right: TVarData; const Operation: TVarOp); virtual;
+ function CompareOp(const Left, Right: TVarData; const Operation: TVarOp): Boolean; virtual;
+ procedure Compare(const Left, Right: TVarData; var Relationship: TVarCompareResult); virtual;
+ property VarType: TVarType read FVarType;
+ end;
+ TCustomVariantTypeClass = class of TCustomVariantType;
+
+ TVarDataArray = array of TVarData;
+ IVarInvokeable = interface
+ ['{1CB65C52-BBCB-41A6-9E58-7FB916BEEB2D}']
+ function DoFunction(var Dest: TVarData; const V: TVarData;
+ const Name: string; const Arguments: TVarDataArray): Boolean;
+ function DoProcedure(const V: TVarData; const Name: string;
+ const Arguments: TVarDataArray): Boolean;
+ function GetProperty(var Dest: TVarData; const V: TVarData;
+ const Name: string): Boolean;
+ function SetProperty(const V: TVarData; const Name: string;
+ const Value: TVarData): Boolean;
+ end;
+
+ TInvokeableVariantType = class(TCustomVariantType, IVarInvokeable)
+ protected
+ procedure DispInvoke(var Dest: TVarData; const Source: TVarData;
+ CallDesc: PCallDesc; Params: Pointer); override;
+ public
+ { IVarInvokeable }
+ function DoFunction(var Dest: TVarData; const V: TVarData;
+ const Name: string; const Arguments: TVarDataArray): Boolean; virtual;
+ function DoProcedure(const V: TVarData; const Name: string;
+ const Arguments: TVarDataArray): Boolean; virtual;
+ function GetProperty(var Dest: TVarData; const V: TVarData;
+ const Name: string): Boolean; virtual;
+ function SetProperty(const V: TVarData; const Name: string;
+ const Value: TVarData): Boolean; virtual;
+ end;
+
+ IVarInstanceReference = interface
+ ['{5C176802-3F89-428D-850E-9F54F50C2293}']
+ function GetInstance(const V: TVarData): TObject;
+ end;
+
+ TPublishableVariantType = class(TInvokeableVariantType, IVarInstanceReference)
+ protected
+ { IVarInstanceReference }
+ function GetInstance(const V: TVarData): TObject; virtual; abstract;
+ public
+ function GetProperty(var Dest: TVarData; const V: TVarData;
+ const Name: string): Boolean; override;
+ function SetProperty(const V: TVarData; const Name: string;
+ const Value: TVarData): Boolean; override;
+ end;
+
+ function FindCustomVariantType(const AVarType: TVarType;
+ out CustomVariantType: TCustomVariantType): Boolean; overload;
+ function FindCustomVariantType(const TypeName: string;
+ out CustomVariantType: TCustomVariantType): Boolean; overload;
+
+type
+ TAnyProc = procedure (var V: TVarData);
+ TVarDispProc = procedure (Dest: PVariant; const Source: Variant;
+ CallDesc: PCallDesc; Params: Pointer); cdecl;
+
+Const
+ CMaxNumberOfCustomVarTypes = $06FF;
+ CMinVarType = $0100;
+ CMaxVarType = CMinVarType + CMaxNumberOfCustomVarTypes;
+ CIncVarType = $000F;
+ CFirstUserType = CMinVarType + CIncVarType;
+
+var
+ VarDispProc: TVarDispProc;
+ ClearAnyProc: TAnyProc; { Handler clearing a varAny }
+ ChangeAnyProc: TAnyProc; { Handler to change any to variant }
+ RefAnyProc: TAnyProc; { Handler to add a reference to an varAny }
+ InvalidCustomVariantType : TCustomVariantType;
+
+procedure VarCastError;
+procedure VarCastError(const ASourceType, ADestType: TVarType);
+procedure VarInvalidOp;
+procedure VarInvalidNullOp;
+procedure VarBadTypeError;
+procedure VarOverflowError;
+procedure VarOverflowError(const ASourceType, ADestType: TVarType);
+procedure VarBadIndexError;
+procedure VarArrayLockedError;
+procedure VarNotImplError;
+procedure VarOutOfMemoryError;
+procedure VarInvalidArgError;
+procedure VarInvalidArgError(AType: TVarType);
+procedure VarUnexpectedError;
+procedure VarRangeCheckError(const AType: TVarType);
+procedure VarRangeCheckError(const ASourceType, ADestType: TVarType);
+procedure VarArrayCreateError;
+procedure VarResultCheck(AResult: HRESULT);
+procedure VarResultCheck(AResult: HRESULT; ASourceType, ADestType: TVarType);
+procedure HandleConversionException(const ASourceType, ADestType: TVarType);
+function VarTypeAsText(const AType: TVarType): string;
+function FindVarData(const V: Variant): PVarData;
+
+{ Typinfo unit variant routines have been moved here, so as not to make TypInfo dependent on variants }
+
+Function GetPropValue(Instance: TObject; const PropName: string): Variant;
+Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
+Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
+Function GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant;
+Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
+Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
+Procedure SetVariantProp(Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
+
+
+
+{$endif HASVARIANT}
+
+implementation
+
+{$ifdef HASVARIANT}
+
+uses
+ varutils;
+
+ var
+ customvarianttypes : array of tcustomvarianttype;
+ customvarianttypelock : trtlcriticalsection;
+
+procedure sysvarclearproc(var v : tvardata);forward;
+
+{ ---------------------------------------------------------------------
+ String Messages
+ ---------------------------------------------------------------------}
+
+ResourceString
+ SErrVarIsEmpty = 'Variant is empty';
+ SErrInvalidIntegerRange = 'Invalid Integer range: %d';
+
+{ ---------------------------------------------------------------------
+ Auxiliary routines
+ ---------------------------------------------------------------------}
+
+Procedure VariantError (Const Msg : String);
+begin
+ Raise EVariantError.Create(Msg);
+end;
+
+
+Procedure NotSupported(Meth: String);
+begin
+ Raise EVariantError.CreateFmt('Method %s not yet supported.',[Meth]);
+end;
+
+
+{ ---------------------------------------------------------------------
+ VariantManager support
+ ---------------------------------------------------------------------}
+
+procedure sysvarinit(var v : variant);
+begin
+ VariantInit(TVarData(V));
+end;
+
+
+procedure sysvarclear(var v : variant);
+begin
+ varclearproc(TVarData(V));
+end;
+
+
+function Sysvartoint (const v : variant) : longint;
+begin
+ Result:=VariantToLongint(TVarData(V));
+end;
+
+
+function Sysvartoint64 (const v : variant) : int64;
+begin
+ Result:=VariantToInt64(TVarData(V));
+end;
+
+
+function sysvartoword64 (const v : variant) : qword;
+begin
+ Result:=VariantToQWord (TVarData(V));
+end;
+
+
+function sysvartobool (const v : variant) : boolean;
+begin
+ Result:=VariantToBoolean(TVarData(V));
+end;
+
+
+function sysvartoreal (const v : variant) : extended;
+begin
+ Result:=VariantToDouble(TVarData(V));
+end;
+
+
+function sysvartocurr (const v : variant) : currency;
+begin
+ Result:=VariantToCurrency(TVarData(V));
+end;
+
+
+procedure sysvartolstr (var s : ansistring;const v : variant);
+ begin
+ S:=VariantToAnsiString(TVarData(V));
+ end;
+
+
+procedure sysvartopstr (var s;const v : variant);
+ Var
+ T : String;
+ begin
+ SysVarToLstr(T,V);
+ ShortString(S):=T;
+ end;
+
+
+procedure sysvartowstr (var s : widestring;const v : variant);
+ begin
+ case tvardata(v).vtype of
+ varString:
+ s:=ansistring(tvardata(v).vstring);
+ else
+ s:=VariantToWideString(tvardata(v));
+ end;
+ end;
+
+
+procedure sysvartointf (var intf : iinterface;const v : variant);
+ begin
+ case TVarData(v).vtype of
+ varunknown:
+ intf:=iinterface(TVarData(v).VUnknown);
+ else
+ begin
+ varcasterror(TVarData(v).vtype,varunknown);
+ end;
+ end;
+ end;
+
+
+procedure sysvartodisp (var disp : idispatch;const v : variant);
+begin
+ NotSupported('VariantManager.sysvartodisp')
+end;
+
+
+function sysvartotdatetime (const v : variant) : tdatetime;
+begin
+ NotSupported('VariantManager.sysvartotdatetime')
+end;
+
+
+{$ifdef dummy}
+function DynamicArrayDimensions(const p : pointer) : sizeint;
+ begin
+ result:=0;
+ while assigned(pdynarraytypeinfo(p)) and (pdynarraytypeinfo(p)^.kind=tkDynArray) do
+ begin
+ inc(result);
+
+ { skip kind and name }
+ inc(pointer(p),ord(pdynarraytypeinfo(p)^.namelen)+2);
+
+{$ifdef FPC_ALIGNSRTTI}
+ p:=aligntoptr(p);
+{$endif FPC_ALIGNSRTTI}
+
+ p:=pdynarraytypeinfo(p+sizeof(sizeint))^;
+ end;
+ end;
+
+
+function DynamicArrayIsRectangular(const p : pointer;typeinfo : pointer);
+ var
+ arraysize : sizeint;
+ begin
+ result:=true;
+
+ { get typeinfo of second level }
+
+ { skip kind and name }
+ inc(pointer(typeinfo),ord(pdynarraytypeinfo(typeinfo)^.namelen)+2);
+
+{$ifdef FPC_ALIGNSRTTI}
+ p:=aligntoptr(typeinfo);
+{$endif FPC_ALIGNSRTTI}
+
+
+ typeinfo:=pdynarraytypeinfo(typeinfo+sizeof(sizeint))^;
+
+ if assigned(pdynarraytypeinfo(typeinfo)) and (pdynarraytypeinfo(typeinfo).kind=tkDynArray) do
+ begin
+ arraysize:=
+ for i:=1 to psizeint(p-sizeof(sizeint))^ do
+{$endif dummy}
+
+
+procedure sysvartodynarray (var dynarr : pointer;const v : variant; typeinfo : pointer);
+begin
+ DynArrayFromVariant(dynarr,v,typeinfo);
+ if not(assigned(dynarr)) then
+ VarCastError;
+end;
+
+procedure sysvarfrombool (var dest : variant;const source : Boolean);
+
+begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ VType:=varBoolean;
+ VBoolean:=Source;
+ end;
+end;
+
+
+procedure sysvarfromint (var dest : variant;const source,range : longint);
+
+begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ Case Range of
+ -4 : begin
+ vtype:=varinteger;
+ vInteger:=Source;
+ end;
+ -2 : begin
+ vtype:=varsmallInt;
+ vSmallInt:=Source;
+ end;
+ -1 : Begin
+ vtype:=varshortInt;
+ vshortint:=Source;
+ end;
+ 1 : begin
+ vtype:=varByte;
+ vByte:=Source;
+ end;
+ 2 : begin
+ vtype:=varWord;
+ vWord:=Source;
+ end;
+ 4 : Begin
+ vtype:=varLongWord;
+ vLongWord:=Source;
+ end;
+ else
+ VariantError(Format(SErrInvalidIntegerRange,[Range]));
+ end;
+ end;
+end;
+
+procedure sysvarfromint64 (var dest : variant;const source : int64);
+
+begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ vtype:=varint64;
+ vInt64:=Source;
+ end;
+end;
+
+procedure sysvarfromword64 (var dest : variant;const source : qword);
+
+begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ vtype:=varQWord;
+ vQword:=Source;
+ end;
+end;
+
+
+procedure sysvarfromreal (var dest : variant;const source : extended);
+ begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ vtype:=varDouble;
+ vDouble:=Source;
+ end;
+ end;
+
+
+procedure sysvarfromcurr (var dest : variant;const source : currency);
+ begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ vtype:=varCurrency;
+ vCurrency:=Source;
+ end;
+ end;
+
+
+procedure sysvarfromtdatetime (var dest : variant;const source : tdatetime);
+ begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest);
+ With TVarData(dest) do
+ begin
+ vtype:=varDate;
+ vDate:=Source;
+ end;
+ end;
+
+
+procedure sysvarfrompstr (var dest : variant;const source : shortstring);
+ begin
+ if TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest)
+ else
+ fillchar(dest,sizeof(dest),0);
+ With TVarData(dest) do
+ begin
+ vtype:=varstring;
+ vstring:=nil;
+ ansistring(vString):=source;
+ end;
+ end;
+
+
+procedure sysvarfromlstr (var dest : variant;const source : string);
+ begin
+ If TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest)
+ else
+ fillchar(dest,sizeof(dest),0);
+ With TVarData(Dest) do
+ begin
+ vtype:=varstring;
+ vstring:=nil;
+ ansistring(vString):=source;
+ end;
+ end;
+
+
+procedure sysvarfromwstr (var dest : variant;const source : widestring);
+ begin
+ If TVarData(Dest).VType>=varOleStr then
+ sysvarclear(Dest)
+ else
+ fillchar(dest,sizeof(dest),0);
+ With TVarData(Dest) do
+ begin
+ vtype:=varolestr;
+ widestring(pointer(vOlestr)):=copy(source,1,MaxInt);
+ end;
+ end;
+
+
+type
+ tcommontype = (ct_empty,ct_any,ct_error,ct_longint,ct_float,ct_boolean,
+ ct_int64,ct_nil,ct_widestr,ct_date,ct_currency,ct_string);
+
+const
+ { get the basic type for a variant type }
+ vtypemap : array[varempty..varqword] of tcommontype =
+ (ct_empty, // varempty = 0;
+ ct_nil, // varnull = 1;
+ ct_longint, // varsmallint = 2;
+ ct_longint, // varinteger = 3;
+ ct_float, // varsingle = 4;
+ ct_float, // vardouble = 5;
+ ct_currency, // varcurrency = 6;
+ ct_date, // vardate = 7;
+ ct_widestr, // varolestr = 8;
+ ct_error, // vardispatch = 9;
+ ct_error, // varerror = 10;
+ ct_boolean, // varboolean = 11;
+ ct_error, // varvariant = 12;
+ ct_error, // varunknown = 13;
+ ct_error, // ??? 15
+ ct_error, // vardecimal = 14;
+ ct_longint, // varshortint = 16;
+ ct_longint, // varbyte = 17;
+ ct_longint, // varword = 18;
+ ct_int64, // varlongword = 19;
+ ct_int64, // varint64 = 20;
+ ct_int64 // varqword = 21;
+ );
+
+ { map a basic type back to a variant type }
+ commontypemap : array[tcommontype] of word =
+ (
+ varempty,
+ varany,
+ varerror,
+ varinteger,
+ vardouble,
+ varboolean,
+ varint64,
+ varnull,
+ varolestr,
+ vardate,
+ varcurrency,
+ varstring
+ );
+
+function maptocommontype(const vtype : tvartype) : tcommontype;
+ begin
+ case vtype and vartypemask of
+ varString:
+ result:=ct_string;
+ varAny:
+ result:=ct_any;
+ else
+ begin
+ if ((vtype and vartypemask)>=low(vtypemap)) and ((vtype and vartypemask)<=high(vtypemap)) then
+ result:=vtypemap[vtype and vartypemask]
+ else
+ result:=ct_error;
+ end;
+ end;
+ end;
+
+const
+ findcmpcommontype : array[tcommontype,tcommontype] of tcommontype = (
+ { ct_emtpy ct_any ct_error ct_longint ct_float ct_boolean ct_int64 ct_nil ct_widestr ct_date ct_currency ct_string }
+ ({ ct_empty } ct_empty, ct_any, ct_error,ct_longint, ct_float, ct_boolean, ct_int64, ct_nil, ct_widestr, ct_date, ct_currency,ct_string ),
+ ({ ct_any } ct_any, ct_any, ct_error,ct_any, ct_any, ct_any, ct_any, ct_any, ct_any, ct_any, ct_any, ct_any ),
+ ({ ct_error } ct_error, ct_error,ct_error,ct_error, ct_error, ct_error, ct_error, ct_error,ct_error, ct_error,ct_error, ct_error ),
+ ({ ct_longint } ct_longint, ct_any, ct_error,ct_longint, ct_float, ct_boolean, ct_int64, ct_nil, ct_float, ct_date, ct_currency,ct_float ),
+ ({ ct_float } ct_float, ct_any, ct_error,ct_float, ct_float, ct_float, ct_float, ct_nil, ct_float, ct_date, ct_currency,ct_float ),
+ ({ ct_boolean } ct_boolean, ct_any, ct_error,ct_longint, ct_float, ct_boolean, ct_int64, ct_nil, ct_widestr, ct_date, ct_currency,ct_string ),
+ ({ ct_int64 } ct_int64, ct_any, ct_error,ct_int64, ct_float, ct_int64, ct_int64, ct_nil, ct_float, ct_date, ct_currency,ct_float ),
+ ({ ct_nil } ct_nil, ct_any, ct_error,ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil ),
+ ({ ct_widestr } ct_widestr, ct_any, ct_error,ct_float, ct_float, ct_widestr, ct_float, ct_nil, ct_widestr, ct_date, ct_currency,ct_widestr ),
+ ({ ct_date } ct_date, ct_any, ct_error,ct_date, ct_date, ct_date, ct_date, ct_nil, ct_date, ct_date, ct_date, ct_date ),
+ ({ ct_currency } ct_currency,ct_any, ct_error,ct_currency,ct_currency,ct_currency,ct_currency,ct_nil, ct_currency,ct_date, ct_currency,ct_currency),
+ ({ ct_string } ct_string, ct_any, ct_error,ct_float, ct_float, ct_string, ct_float, ct_nil, ct_widestr, ct_date, ct_currency,ct_string)
+ );
+
+function dovarcmpempty(const vl,vr : tvardata) : shortint;
+ begin
+ if vl.vtype=varempty then
+ begin
+ if vr.vtype=varempty then
+ result:=0
+ else
+ result:=-1;
+ end
+ else if vr.vtype=varempty then
+ result:=1;
+ end;
+
+
+function dovarcmp (const vl,vr : tvardata;const opcode : tvarop) : shortint;
+ var
+ resulttype : longint;
+
+ { use a variant here for proper init./finalization }
+ vlconv,vrconv : variant;
+
+ variantmanager : tvariantmanager;
+ begin
+ result:=0;
+ { variant reference? }
+ if vl.vtype=(varbyref or varvariant) then
+ result:=dovarcmp(tvardata(vl.vpointer^),vr,opcode)
+ else if vr.vtype=(varbyref or varvariant) then
+ result:=dovarcmp(vl,tvardata(vr.vpointer^),opcode)
+ { one is empty? }
+ else if vr.vtype=varempty then
+ result:=dovarcmpempty(vl,vr)
+ else if vl.vtype=varempty then
+ result:=dovarcmpempty(vl,vr)
+ else
+ begin
+ GetVariantManager(variantmanager);
+ { cast both to a common type }
+ resulttype:=commontypemap[findcmpcommontype[maptocommontype(vl.vtype),maptocommontype(vr.vtype)]];
+ variantmanager.varcast(vlconv,variant(vl),resulttype);
+ variantmanager.varcast(vrconv,variant(vr),resulttype);
+
+ { sanity check }
+ if tvardata(vlconv).vtype<>tvardata(vrconv).vtype then
+ VarInvalidOp;
+
+ case tvardata(vlconv).vtype of
+ varempty:
+ // both must be empty then
+ result:=0;
+ //!!!! varany:
+
+ varerror:
+ VarInvalidOp;
+
+ varinteger:
+ begin
+ if tvardata(vlconv).vinteger>tvardata(vrconv).vinteger then
+ result:=1
+ else if tvardata(vlconv).vinteger<tvardata(vrconv).vinteger then
+ result:=-1
+ else
+ result:=0;
+ end;
+
+ vardouble:
+ begin
+ if tvardata(vlconv).vdouble>tvardata(vrconv).vdouble then
+ result:=1
+ else if tvardata(vlconv).vdouble<tvardata(vrconv).vdouble then
+ result:=-1
+ else
+ result:=0;
+ end;
+
+ //!!!! varboolean:
+
+ varint64:
+ begin
+ if tvardata(vlconv).vint64>tvardata(vrconv).vint64 then
+ result:=1
+ else if tvardata(vlconv).vint64<tvardata(vrconv).vint64 then
+ result:=-1
+ else
+ result:=0;
+ end;
+
+ //!!!! varnull:
+ varolestr:
+ result:=WideCompareStr(ansistring(tvardata(vlconv).volestr),ansistring(tvardata(vrconv).volestr));
+
+ vardate:
+ begin
+ if tvardata(vlconv).vdate>tvardata(vrconv).vdate then
+ result:=1
+ else if tvardata(vlconv).vdate<tvardata(vrconv).vdate then
+ result:=-1
+ else
+ result:=0;
+ end;
+
+ varcurrency:
+ begin
+ if tvardata(vlconv).vcurrency>tvardata(vrconv).vcurrency then
+ result:=1
+ else if tvardata(vlconv).vcurrency<tvardata(vrconv).vcurrency then
+ result:=-1
+ else
+ result:=0;
+ end;
+
+ varstring:
+ result:=AnsiCompareStr(ansistring(tvardata(vlconv).vstring),ansistring(tvardata(vrconv).vstring));
+ else
+ VarInvalidOp;
+ end;
+ end;
+ end;
+
+
+function syscmpop (const left,right : variant;const opcode : tvarop) : boolean;
+ var
+ cmpres : shortint;
+ begin
+ cmpres:=dovarcmp(tvardata(left),tvardata(right),opcode);
+ case opcode of
+ opcmpeq:
+ result:=cmpres=0;
+ opcmpne:
+ result:=cmpres<>0;
+ opcmplt:
+ result:=cmpres<0;
+ opcmple:
+ result:=cmpres<=0;
+ opcmpgt:
+ result:=cmpres>0;
+ opcmpge:
+ result:=cmpres>=0;
+ else
+ VarInvalidOp;
+ end;
+ end;
+
+
+const
+ findopcommontype : array[tcommontype,tcommontype] of tcommontype = (
+ { ct_emtpy ct_any ct_error ct_longint ct_float ct_boolean ct_int64 ct_nil ct_widestr ct_date ct_currency ct_string }
+ ({ ct_empty } ct_empty, ct_any, ct_error,ct_longint, ct_float, ct_boolean, ct_int64, ct_nil, ct_widestr, ct_date, ct_currency,ct_string ),
+ ({ ct_any } ct_any, ct_any, ct_error,ct_any, ct_any, ct_any, ct_any, ct_any, ct_any, ct_any, ct_any, ct_any ),
+ ({ ct_error } ct_error, ct_error,ct_error,ct_error, ct_error, ct_error, ct_error, ct_error,ct_error, ct_error,ct_error, ct_error ),
+ ({ ct_longint } ct_longint, ct_any, ct_error,ct_longint, ct_float, ct_boolean, ct_int64, ct_nil, ct_float, ct_date, ct_currency,ct_float ),
+ ({ ct_float } ct_float, ct_any, ct_error,ct_float, ct_float, ct_float, ct_float, ct_nil, ct_float, ct_date, ct_currency,ct_float ),
+ ({ ct_boolean } ct_boolean, ct_any, ct_error,ct_longint, ct_float, ct_boolean, ct_int64, ct_nil, ct_boolean, ct_date, ct_currency,ct_boolean ),
+ ({ ct_int64 } ct_int64, ct_any, ct_error,ct_int64, ct_float, ct_int64, ct_int64, ct_nil, ct_float, ct_date, ct_currency,ct_float ),
+ ({ ct_nil } ct_nil, ct_any, ct_error,ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil, ct_nil ),
+ ({ ct_widestr } ct_widestr, ct_any, ct_error,ct_float, ct_float, ct_boolean, ct_float, ct_nil, ct_widestr, ct_date, ct_currency,ct_widestr ),
+ ({ ct_date } ct_date, ct_any, ct_error,ct_date, ct_date, ct_date, ct_date, ct_nil, ct_date, ct_date, ct_date, ct_date ),
+ ({ ct_currency } ct_currency,ct_any, ct_error,ct_currency,ct_currency,ct_currency,ct_currency,ct_nil, ct_currency,ct_date, ct_currency,ct_currency),
+ ({ ct_string } ct_string, ct_any, ct_error,ct_float, ct_float, ct_boolean, ct_float, ct_nil, ct_widestr, ct_date, ct_currency,ct_string)
+ );
+
+
+function dovarop(const vl,vr : tvardata;const opcode : tvarop) : tvardata;
+ var
+ resulttype : longint;
+
+ { use a variant here for proper init./finalization }
+ vlconv,vrconv : variant;
+ tryint64,tryreal : boolean;
+
+ variantmanager : tvariantmanager;
+ begin
+ fillchar(result,sizeof(result),0);
+ { variant reference? }
+ if vl.vtype=(varbyref or varvariant) then
+ result:=dovarop(tvardata(vl.vpointer^),vr,opcode)
+ else if vr.vtype=(varbyref or varvariant) then
+ result:=dovarop(vl,tvardata(vr.vpointer^),opcode)
+ {!!!!
+ { one is empty? }
+ else if vr.vtype=varempty then
+ result:=dovarcmpempty(vl,vr)
+ else if vl.vtype=varempty then
+ result:=dovarcmpempty(vl,vr)
+ }
+ else
+ begin
+ GetVariantManager(variantmanager);
+ { cast both to a common type }
+ resulttype:=commontypemap[findopcommontype[maptocommontype(vl.vtype),maptocommontype(vr.vtype)]];
+ variantmanager.varcast(vlconv,variant(vl),resulttype);
+ variantmanager.varcast(vrconv,variant(vr),resulttype);
+
+ { sanity check }
+ if tvardata(vlconv).vtype<>tvardata(vrconv).vtype then
+ VarInvalidOp;
+
+ case tvardata(vlconv).vtype of
+{
+ varempty:
+ // both must be empty then
+ result:=0;
+ //!!!! varany:
+
+ varerror:
+ VarInvalidOp;
+}
+ varinteger:
+ begin
+ tryint64:=false;
+ result.vtype:=varinteger;
+{$r+,q+}
+ try
+
+ case opcode of
+ opadd:
+ result.vinteger:=tvardata(vlconv).vinteger+tvardata(vrconv).vinteger;
+ opsubtract:
+ result.vinteger:=tvardata(vlconv).vinteger-tvardata(vrconv).vinteger;
+ opmultiply:
+ result.vinteger:=tvardata(vlconv).vinteger*tvardata(vrconv).vinteger;
+ opintdivide:
+ result.vinteger:=tvardata(vlconv).vinteger div tvardata(vrconv).vinteger;
+ oppower:
+ result.vinteger:=tvardata(vlconv).vinteger**tvardata(vrconv).vinteger;
+ opmodulus:
+ result.vinteger:=tvardata(vlconv).vinteger mod tvardata(vrconv).vinteger;
+ opshiftleft:
+ result.vinteger:=tvardata(vlconv).vinteger shl tvardata(vrconv).vinteger;
+ opshiftright:
+ result.vinteger:=tvardata(vlconv).vinteger shr tvardata(vrconv).vinteger;
+ opand:
+ result.vinteger:=tvardata(vlconv).vinteger and tvardata(vrconv).vinteger;
+ opor:
+ result.vinteger:=tvardata(vlconv).vinteger or tvardata(vrconv).vinteger;
+ opxor:
+ result.vinteger:=tvardata(vlconv).vinteger xor tvardata(vrconv).vinteger;
+ opdivide:
+ begin
+ result.vtype:=vardouble;
+ result.vdouble:=tvardata(vlconv).vinteger/tvardata(vrconv).vinteger;
+ end;
+ else
+ VarInvalidOp;
+ end;
+ except
+ on erangeerror do
+ tryint64:=true;
+ on eoverflow do
+ tryint64:=true;
+ end;
+{$r-,q-}
+ if tryint64 then
+ begin
+ variantmanager.varcast(vlconv,vlconv,varint64);
+ variantmanager.varcast(vrconv,vrconv,varint64);
+ variantmanager.varop(vlconv,vrconv,opcode);
+ end;
+ end;
+
+ vardouble:
+ begin
+ result.vtype:=vardouble;
+ case opcode of
+ opadd:
+ result.vdouble:=tvardata(vlconv).vdouble+tvardata(vrconv).vdouble;
+ opsubtract:
+ result.vdouble:=tvardata(vlconv).vdouble-tvardata(vrconv).vdouble;
+ opmultiply:
+ result.vdouble:=tvardata(vlconv).vdouble*tvardata(vrconv).vdouble;
+ oppower:
+ result.vdouble:=tvardata(vlconv).vdouble**tvardata(vrconv).vdouble;
+ opdivide:
+ result.vdouble:=tvardata(vlconv).vdouble/tvardata(vrconv).vdouble;
+ else
+ VarInvalidOp;
+ end;
+ end;
+{
+ varboolean:
+ begin
+ end;
+}
+ varint64:
+ begin
+ tryreal:=false;
+ result.vtype:=varint64;
+{$r+,q+}
+ try
+
+ case opcode of
+ opadd:
+ result.vint64:=tvardata(vlconv).vint64+tvardata(vrconv).vint64;
+ opsubtract:
+ result.vint64:=tvardata(vlconv).vint64-tvardata(vrconv).vint64;
+ opmultiply:
+ result.vint64:=tvardata(vlconv).vint64*tvardata(vrconv).vint64;
+ opintdivide:
+ result.vint64:=tvardata(vlconv).vint64 div tvardata(vrconv).vint64;
+ oppower:
+ result.vint64:=tvardata(vlconv).vint64**tvardata(vrconv).vint64;
+ opmodulus:
+ result.vint64:=tvardata(vlconv).vint64 mod tvardata(vrconv).vint64;
+ opshiftleft:
+ result.vint64:=tvardata(vlconv).vint64 shl tvardata(vrconv).vint64;
+ opshiftright:
+ result.vint64:=tvardata(vlconv).vint64 shr tvardata(vrconv).vint64;
+ opand:
+ result.vint64:=tvardata(vlconv).vint64 and tvardata(vrconv).vint64;
+ opor:
+ result.vint64:=tvardata(vlconv).vint64 or tvardata(vrconv).vint64;
+ opxor:
+ result.vint64:=tvardata(vlconv).vint64 xor tvardata(vrconv).vint64;
+ opdivide:
+ begin
+ result.vtype:=vardouble;
+ result.vdouble:=tvardata(vlconv).vint64/tvardata(vrconv).vint64;
+ end;
+ else
+ VarInvalidOp;
+ end;
+ except
+ on erangeerror do
+ tryreal:=true;
+ on eoverflow do
+ tryreal:=true;
+ end;
+{$r-,q-}
+ if tryreal then
+ begin
+ variantmanager.varcast(vlconv,vlconv,vardouble);
+ variantmanager.varcast(vrconv,vrconv,vardouble);
+ variantmanager.varop(vlconv,vrconv,opcode);
+ end;
+ end;
+{
+ //!!!! varnull:
+ varolestr:
+ result:=WideCompareStr(ansistring(tvardata(vlconv).volestr),ansistring(tvardata(vrconv).volestr));
+
+ vardate:
+ begin
+ end;
+
+ varcurrency:
+ begin
+ end;
+}
+ varstring:
+ begin
+ result.vtype:=varstring;
+ case opcode of
+ opadd:
+ ansistring(result.vstring):=ansistring(tvardata(vlconv).vstring)+ansistring(tvardata(vrconv).vstring);
+ opdivide,
+ opsubtract,
+ opmultiply,
+ oppower:
+ begin
+ variantmanager.varcast(vlconv,vlconv,vardouble);
+ variantmanager.varcast(vrconv,vrconv,vardouble);
+ variantmanager.varop(vlconv,vrconv,opcode);
+ end;
+
+ opintdivide,
+ opmodulus,
+ opshiftleft,
+ opshiftright,
+ opand,
+ opor,
+ opxor:
+ begin
+ variantmanager.varcast(vlconv,vlconv,varinteger);
+ variantmanager.varcast(vrconv,vrconv,varinteger);
+ variantmanager.varop(vlconv,vrconv,opcode);
+ end;
+ else
+ VarInvalidOp;
+ end;
+ end;
+ else
+ VarInvalidOp;
+ end;
+ end;
+ end;
+
+
+procedure sysvarop (var left : variant;const right : variant;opcode : tvarop);
+ begin
+ left:=variant(dovarop(tvardata(left),tvardata(right),opcode));
+ end;
+
+
+procedure sysvarneg (var v : variant);
+ var
+ customvarianttype : tcustomvarianttype;
+ begin
+ with tvardata(v) do
+ case vtype of
+ varempty:
+ v:=smallint(0);
+ varnull:
+ ;
+ varsmallint:
+ vsmallint:=-vsmallint;
+ varinteger:
+ vinteger:=vinteger;
+ varsingle:
+ vsingle:=-vsingle;
+ vardouble:
+ vdouble:=-vdouble;
+ varcurrency:
+ vcurrency:=-vcurrency;
+ vardate:
+ vdate:=-vdate;
+ varolestr:
+ NotSupported('VariantManager.sysvarneg');
+ vardispatch:
+ NotSupported('VariantManager.sysvarneg');
+ varerror:
+ NotSupported('VariantManager.sysvarneg');
+ varboolean:
+ NotSupported('VariantManager.sysvarneg');
+ varvariant:
+ v:=-variant((tvardata(v).vpointer)^);
+ varunknown:
+ NotSupported('VariantManager.sysvarneg');
+ vardecimal:
+ NotSupported('VariantManager.sysvarneg');
+ varshortint:
+ vshortint:=-vshortint;
+ varbyte:
+ vbyte:=-vbyte;
+ varword:
+ vword:=-vword;
+ varlongword:
+ vlongword:=-vlongword;
+ varint64:
+ vint64:=-vint64;
+ varqword:
+ vqword:=-vqword;
+ else
+ begin
+ if FindCustomVariantType(vtype,customvarianttype) then
+ customvarianttype.UnaryOp(tvardata(v),opNegate)
+ else
+ VarInvalidOp;
+ end;
+ end;
+end;
+
+
+procedure sysvarnot (var v : variant);
+ var
+ customvarianttype : tcustomvarianttype;
+ begin
+ with tvardata(v) do
+ case vtype of
+ varempty:
+ v:=smallint(-1);
+ varnull:
+ ;
+ varsmallint:
+ vsmallint:=not(vsmallint);
+ varinteger:
+ vinteger:=not(vinteger);
+ {
+ varsingle:
+ vsingle:=-vsingle;
+ vardouble:
+ vdouble:=-vdouble;
+ varcurrency:
+ vcurrency:=-vcurrency;
+ vardate:
+ vdate:=-vdate;
+ }
+ varolestr:
+ NotSupported('VariantManager.sysvarneg');
+ vardispatch:
+ NotSupported('VariantManager.sysvarneg');
+ varerror:
+ NotSupported('VariantManager.sysvarneg');
+ varboolean:
+ vboolean:=not(vboolean);
+ varvariant:
+ v:=not(variant((tvardata(v).vpointer)^));
+ varunknown:
+ NotSupported('VariantManager.sysvarneg');
+ vardecimal:
+ NotSupported('VariantManager.sysvarneg');
+ varshortint:
+ vshortint:=not(vshortint);
+ varbyte:
+ vbyte:=not(vbyte);
+ varword:
+ vword:=not(vword);
+ varlongword:
+ vlongword:=not(vlongword);
+ varint64:
+ vint64:=not(vint64);
+ varqword:
+ vqword:=not(vqword);
+ else
+ begin
+ if FindCustomVariantType(vtype,customvarianttype) then
+ customvarianttype.UnaryOp(tvardata(v),opNot)
+ else
+ VarInvalidOp;
+ end;
+ end;
+ end;
+
+
+type
+ tvariantarrayiter = object
+ bounds : pvararrayboundarray;
+ coords : pvararraycoorarray;
+ dims : SizeInt;
+ constructor init(d: SizeInt;b : pvararrayboundarray);
+ function next : boolean;
+ destructor done;
+ end;
+
+
+constructor tvariantarrayiter.init(d: SizeInt;b : pvararrayboundarray);
+ var
+ i : sizeint;
+ begin
+ bounds:=b;
+ dims:=d;
+ getmem(coords,sizeof(Sizeint)*dims);
+ { initialize coordinate counter }
+ for i:=0 to dims-1 do
+ coords^[i]:=bounds^[i].lowbound;
+ end;
+
+
+function tvariantarrayiter.next : boolean;
+ var
+ finished : boolean;
+
+ procedure incdim(d : SizeInt);
+ begin
+ if finished then
+ exit;
+ inc(coords^[d]);
+ if coords^[d]>=bounds^[d].lowbound+bounds^[d].elementcount then
+ begin
+ coords^[d]:=bounds^[d].lowbound;
+ if d>0 then
+ incdim(d-1)
+ else
+ finished:=true;
+ end;
+ end;
+
+ begin
+ finished:=false;
+ incdim(dims-1);
+ result:=not(finished);
+ end;
+
+
+destructor tvariantarrayiter.done;
+ begin
+ freemem(coords);
+ end;
+
+
+procedure sysvarclearproc(var v : tvardata);
+ var
+ customvarianttype : tcustomvarianttype;
+ begin
+ { easy type? }
+ if (v.vtype<varOleStr) or
+ (v.vtype=varInt64) or (v.vtype=varQWord) then
+ v.vtype:=varempty
+ { type handled by varutils? }
+ else if v.vtype<varInt64 then
+ begin
+ varresultcheck(variantclear(v));
+ if ((V.vtype=varDispatch) or (V.vtype=varUnknown)) then
+ v.vunknown:=Nil;
+ end
+ { pascal string? }
+ else if v.vtype=varString then
+ begin
+ v.vtype:=varempty;
+ ansistring(v.vstring):='';
+ end
+ { array? }
+ else if (v.vtype and varArray)<>0 then
+ begin
+ varresultcheck(variantclear(v));
+ end
+ { corba? }
+ else if v.vtype=varany then
+ ClearAnyProc(v)
+ { custom? }
+ else if findcustomvarianttype(v.vtype,customvarianttype) then
+ customvarianttype.clear(v)
+ { varutils fallback }
+ else
+ varresultcheck(variantclear(v));
+ end;
+
+
+procedure sysvarcopyproc(var d : tvardata;const s : tvardata);
+ var
+ customvarianttype : tcustomvarianttype;
+ p,newarray : pvararray;
+ boundsarray : pvararrayboundarray;
+ ubound : sizeint;
+ iter : tvariantarrayiter;
+ varfrom,varto : pvardata;
+ i : SizeInt;
+ begin
+ if @d=@s then
+ exit;
+ sysvarclearproc(d);
+ { easy type? }
+ if (s.vtype<varOleStr) or
+ (s.vtype=varInt64) or (s.vtype=varQWord) then
+ d:=s
+ { type handled by varutils? }
+ else if s.vtype<varInt64 then
+ varresultcheck(variantcopy(d,s))
+ { pascal string? }
+ else if s.vtype=varString then
+ begin
+ d.vtype:=varstring;
+ d.vstring:=nil;
+ ansistring(d.vstring):=ansistring(s.vstring);
+ end
+ { array? }
+ else if (s.vtype and varArray)<>0 then
+ begin
+ { vararray of variant needs some extra work ... }
+ if (s.vtype and varTypeMask)=varVariant then
+ begin
+ { get pointer to the array data }
+ if (s.vtype and varByRef)<>0 then
+ p:=pvararray(s.vpointer^)
+ else
+ p:=s.varray;
+
+ getmem(boundsarray,p^.DimCount*sizeof(TVarArrayBound));
+ try
+ for i:=0 to p^.DimCount-1 do
+ begin
+ VarResultCheck(SafeArrayGetLBound(p,i+1,boundsarray^[i].lowbound));
+ VarResultCheck(SafeArrayGetUBound(p,i+1,ubound));
+ boundsarray^[i].elementcount:=ubound-boundsarray^[i].lowbound+1;
+ end;
+
+ newarray:=SafeArrayCreate(varVariant,p^.DimCount,boundsarray^);
+ if not(assigned(newarray)) then
+ VarArrayCreateError;
+
+ try
+ iter.init(p^.DimCount,boundsarray);
+ repeat
+ VarResultCheck(SafeArrayPtrOfIndex(p,iter.coords,varfrom));
+ VarResultCheck(SafeArrayPtrOfIndex(newarray,iter.coords,varto));
+ sysvarcopyproc(varto^,varfrom^);
+ until not(iter.next);
+ d.vtype:=varVariant or varArray;
+ d.varray:=newarray;
+ finally
+ iter.done;
+ end;
+ finally
+ freemem(boundsarray);
+ end;
+ end
+ else
+ varresultcheck(variantcopy(d,s));
+ end
+ { corba? }
+ else if s.vtype=varany then
+ NotSupported('VariantManager.sysvarcopyproc.varAny')
+ { custom? }
+ else if findcustomvarianttype(s.vtype,customvarianttype) then
+ customvarianttype.copy(d,s,false)
+ { varutils fallback }
+ else
+ varresultcheck(variantcopy(d,s));
+ end;
+
+
+procedure sysvaraddrefproc(var v : tvardata);
+ var
+ dummy : tvardata;
+ begin
+ { create a copy to a dummy }
+ fillchar(dummy,sizeof(dummy),0);
+ sysvarcopyproc(dummy,v);
+ end;
+
+
+procedure sysvaraddref(var v : variant);
+ begin
+ sysvaraddrefproc(tvardata(v));
+ end;
+
+
+procedure sysvarcopy (var dest : variant;const source : variant);
+ begin
+ sysvarcopyproc(tvardata(dest),tvardata(source));
+ end;
+
+
+function sysvarcastinteger(const v : tvardata) : longint;
+ begin
+ try
+ case v.vtype of
+ varByte:
+ result:=v.vbyte;
+ varShortint:
+ result:=v.vshortint;
+ varSmallint:
+ result:=v.vsmallint;
+ varWord:
+ result:=v.vword;
+ varInteger:
+ result:=v.vinteger;
+{$R+}
+ varLongword:
+ result:=v.vlongword;
+ varQWord:
+ result:=v.vqword;
+ varInt64:
+ result:=v.vint64;
+{$R-}
+ else
+ VarInvalidOp;
+ end;
+ except
+ HandleConversionException(v.vtype,varinteger);
+ result:=0;
+ end;
+ end;
+
+
+function sysvarcastreal(const v : tvardata) : double;
+ begin
+ try
+ case v.vtype of
+ varByte:
+ result:=v.vbyte;
+ varShortint:
+ result:=v.vshortint;
+ varSmallint:
+ result:=v.vsmallint;
+ varWord:
+ result:=v.vword;
+ varInteger:
+ result:=v.vinteger;
+ varLongword:
+ result:=v.vlongword;
+ varQWord:
+ result:=v.vqword;
+ varInt64:
+ result:=v.vint64;
+ varSingle:
+ result:=v.vsingle;
+ varDouble:
+ result:=v.vdouble;
+ varCurrency:
+ result:=v.vcurrency;
+ else
+ VariantToDouble(v);
+ end;
+ except
+ HandleConversionException(v.vtype,vardouble);
+ result:=0;
+ end;
+ end;
+
+
+procedure sysvarcast (var dest : variant;const source : variant;vartype : longint);
+ var
+ customvarianttype : tcustomvarianttype;
+ variantmanager : tvariantmanager;
+ begin
+ { already the type we want? }
+ if tvardata(source).vtype=vartype then
+ dest:=source
+ else
+ begin
+ getVariantManager(variantmanager);
+ case vartype of
+ varany:
+ VarCastError(tvardata(source).vtype,vartype);
+ varinteger:
+ variantmanager.varfromint(dest,sysvarcastinteger(tvardata(source)),-4);
+ varsingle,
+ vardouble:
+ variantmanager.varfromreal(dest,sysvarcastreal(tvardata(source)));
+ else
+ begin
+ if findcustomvarianttype(tvardata(source).vtype,customvarianttype) then
+ customvarianttype.CastTo(tvardata(dest),tvardata(source),vartype)
+ else if FindCustomVariantType(vartype,customvarianttype) then
+ customvarianttype.Cast(tvardata(dest),tvardata(source))
+ else
+ VarCastError(tvardata(source).vtype,vartype);
+ end;
+ end;
+ end;
+ end;
+
+
+procedure sysvarfromintf(var dest : variant;const source : iinterface);
+ begin
+ sysvarclearproc(TVarData(dest));
+ TVarData(dest).VUnknown:=nil;
+ iinterface(TVarData(dest).VUnknown) := source;
+ TVarData(dest).VType := varUnknown;
+ end;
+
+
+procedure sysvarfromdisp(var dest : variant;const source : idispatch);
+ begin
+ end;
+
+
+procedure sysvarfromdynarray(var dest : variant;const source : pointer; typeinfo: pointer);
+ begin
+ DynArrayToVariant(dest,source,typeinfo);
+ if VarIsEmpty(dest) then
+ VarCastError;
+ end;
+
+
+procedure sysolevarfrompstr(var dest : olevariant; const source : shortstring);
+ begin
+ NotSupported('VariantManager.sysolevarfrompstr');
+ end;
+
+
+procedure sysolevarfromlstr(var dest : olevariant; const source : ansistring);
+ begin
+ NotSupported('VariantManager.sysolevarfromlstr');
+ end;
+
+
+procedure sysolevarfromvar(var dest : olevariant; const source : variant);
+ begin
+ NotSupported('VariantManager.sysolevarfromvar');
+ end;
+
+
+procedure sysolevarfromint(var dest : olevariant; const source : longint;const range : shortint);
+ begin
+ NotSupported('VariantManager.sysolevarfromint');
+ end;
+
+
+procedure sysvarcastole(var dest : variant;const source : variant;vartype : longint);
+ begin
+ NotSupported('VariantManager.sysvarcastole');
+ end;
+
+
+procedure sysdispinvoke(dest : pvardata;const source : tvardata;calldesc : pcalldesc;params : pointer);cdecl;
+ begin
+ NotSupported('VariantManager.sysdispinvoke');
+ end;
+
+
+procedure sysvararrayredim(var a : variant;highbound : SizeInt);
+ var
+ src : tvardata;
+ p : pvararray;
+ newbounds : tvararraybound;
+ begin
+ src:=tvardata(a);
+ { get final variant }
+ while src.vtype=varByRef or varVariant do
+ src:=tvardata(src.vpointer^);
+
+ if (src.vtype and varArray)<>0 then
+ begin
+ { get pointer to the array }
+ if (src.vtype and varByRef)<>0 then
+ p:=pvararray(src.vpointer^)
+ else
+ p:=src.varray;
+
+ if highbound<p^.bounds[p^.dimcount-1].lowbound then
+ VarInvalidArgError;
+
+ newbounds.lowbound:=p^.bounds[p^.dimcount-1].lowbound;
+ newbounds.elementcount:=highbound-newbounds.lowbound+1;
+
+ VarResultCheck(SafeArrayRedim(p,newbounds));
+ end
+ else
+ VarInvalidArgError(src.vtype);
+ end;
+
+
+function getfinalvartype(v : tvardata) : tvartype;{$ifdef VARIANTINLINE}inline;{$endif VARIANTINLINE}
+ begin
+ while v.vtype=varByRef or varVariant do
+ v:=tvardata(v.vpointer^);
+ result:=v.vtype;
+ end;
+
+
+function sysvararrayget(const a : variant;indexcount : SizeInt;indices : psizeint) : variant;cdecl;
+ var
+ src : tvardata;
+ p : pvararray;
+ arraysrc : pvariant;
+ arrayelementtype : tvartype;
+ data : pointer;
+ variantmanager : tvariantmanager;
+ begin
+ src:=tvardata(a);
+ { get final variant }
+ while src.vtype=varByRef or varVariant do
+ src:=tvardata(src.vpointer^);
+
+ if (src.vtype and varArray)<>0 then
+ begin
+ { get pointer to the array }
+ if (src.vtype and varByRef)<>0 then
+ p:=pvararray(src.vpointer^)
+ else
+ p:=src.varray;
+
+ { number of indices ok? }
+ if p^.DimCount<>indexcount then
+ VarInvalidArgError;
+
+ arrayelementtype:=src.vtype and vartypemask;
+ if arrayelementtype=varVariant then
+ begin
+ VarResultCheck(SafeArrayPtrOfIndex(p,pvararraycoorarray(indices),arraysrc));
+ result:=arraysrc^;
+ end
+ else
+ begin
+ tvardata(result).vtype:=arrayelementtype;
+ VarResultCheck(SafeArrayGetElement(p,pvararraycoorarray(indices),@tvardata(result).vpointer));
+ end;
+ end
+ else
+ VarInvalidArgError(src.vtype);
+ end;
+
+
+procedure sysvararrayput(var a : variant;const value : variant;indexcount : SizeInt;indices : psizeint);cdecl;
+ var
+ dest : tvardata;
+ p : pvararray;
+ arraydest : pvariant;
+ valuevtype,
+ arrayelementtype : tvartype;
+ tempvar : variant;
+ data : pointer;
+ variantmanager : tvariantmanager;
+ begin
+ dest:=tvardata(a);
+ { get final variant }
+ while dest.vtype=varByRef or varVariant do
+ dest:=tvardata(dest.vpointer^);
+
+ valuevtype:=getfinalvartype(tvardata(value));
+
+ if not(VarTypeIsValidElementType(valuevtype)) and
+ { varString isn't a valid varArray type but it is converted
+ later }
+ (valuevtype<>varString) then
+ VarCastError(valuevtype,dest.vtype);
+
+ if (dest.vtype and varArray)<>0 then
+ begin
+ { get pointer to the array }
+ if (dest.vtype and varByRef)<>0 then
+ p:=pvararray(dest.vpointer^)
+ else
+ p:=dest.varray;
+
+ { number of indices ok? }
+ if p^.DimCount<>indexcount then
+ VarInvalidArgError;
+
+ arrayelementtype:=dest.vtype and vartypemask;
+ if arrayelementtype=varVariant then
+ begin
+ VarResultCheck(SafeArrayPtrOfIndex(p,pvararraycoorarray(indices),arraydest));
+ { we can't store ansistrings in variant arrays so we convert the string to
+ an olestring }
+ if valuevtype=varString then
+ begin
+ tempvar:=VarToWideStr(value);
+ arraydest^:=tempvar;
+ end
+ else
+ arraydest^:=value;
+ end
+ else
+ begin
+ GetVariantManager(variantmanager);
+ variantmanager.varcast(tempvar,value,arrayelementtype);
+ if arrayelementtype in [varOleStr,varDispatch,varUnknown] then
+ VarResultCheck(SafeArrayPutElement(p,pvararraycoorarray(indices),tvardata(tempvar).vpointer))
+ else
+ VarResultCheck(SafeArrayPutElement(p,pvararraycoorarray(indices),@tvardata(tempvar).vpointer));
+ end;
+ end
+ else
+ VarInvalidArgError(dest.vtype);
+ end;
+
+
+{ import from system unit }
+Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; S : AnsiString); external name 'FPC_WRITE_TEXT_ANSISTR';
+
+
+function syswritevariant(var t : text;const v : variant;width : longint) : Pointer;
+ var
+ s : ansistring;
+ variantmanager : tvariantmanager;
+ begin
+ GetVariantManager(variantmanager);
+ variantmanager.vartolstr(s,v);
+ fpc_write_text_ansistr(width,t,s);
+ end;
+
+
+function syswrite0Variant(var t : text;const v : Variant) : Pointer;
+ var
+ s : ansistring;
+ variantmanager : tvariantmanager;
+ begin
+ getVariantManager(variantmanager);
+ variantmanager.vartolstr(s,v);
+ fpc_write_text_ansistr(-1,t,s);
+ end;
+
+Const
+ SysVariantManager : TVariantManager = (
+ vartoint : @sysvartoint;
+ vartoint64 : @sysvartoint64;
+ vartoword64 : @sysvartoword64;
+ vartobool : @sysvartobool;
+ vartoreal : @sysvartoreal;
+ vartotdatetime: @sysvartotdatetime;
+ vartocurr : @sysvartocurr;
+ vartopstr : @sysvartopstr;
+ vartolstr : @sysvartolstr;
+ vartowstr : @sysvartowstr;
+ vartointf : @sysvartointf;
+ vartodisp : @sysvartodisp;
+ vartodynarray : @sysvartodynarray;
+ varfrombool : @sysvarfromBool;
+ varfromint : @sysvarfromint;
+ varfromint64 : @sysvarfromint64;
+ varfromword64 : @sysvarfromword64;
+ varfromreal : @sysvarfromreal;
+ varfromtdatetime: @sysvarfromtdatetime;
+ varfromcurr : @sysvarfromcurr;
+ varfrompstr : @sysvarfrompstr;
+ varfromlstr : @sysvarfromlstr;
+ varfromwstr : @sysvarfromwstr;
+ varfromintf : @sysvarfromintf;
+ varfromdisp : @sysvarfromdisp;
+ varfromdynarray: @sysvarfromdynarray;
+ olevarfrompstr: @sysolevarfrompstr;
+ olevarfromlstr: @sysolevarfromlstr;
+ olevarfromvar : @sysolevarfromvar;
+ olevarfromint : @sysolevarfromint;
+ varop : @sysvarop;
+ cmpop : @syscmpop;
+ varneg : @sysvarneg;
+ varnot : @sysvarnot;
+ varinit : @sysvarinit;
+ varclear : @sysvarclear;
+ varaddref : @sysvaraddref;
+ varcopy : @sysvarcopy;
+ varcast : @sysvarcast;
+ varcastole : @sysvarcastole;
+ dispinvoke : @sysdispinvoke;
+ vararrayredim : @sysvararrayredim;
+ vararrayget : @sysvararrayget;
+ vararrayput : @sysvararrayput;
+ writevariant : @syswritevariant;
+ write0Variant : @syswrite0variant;
+ );
+
+Var
+ PrevVariantManager : TVariantManager;
+
+Procedure SetSysVariantManager;
+
+begin
+ GetVariantManager(PrevVariantManager);
+ SetVariantManager(SysVariantManager);
+end;
+
+Procedure UnsetSysVariantManager;
+
+begin
+ SetVariantManager(PrevVariantManager);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Variant support procedures and functions
+ ---------------------------------------------------------------------}
+
+
+function VarType(const V: Variant): TVarType;
+
+begin
+ Result:=TVarData(V).vtype;
+end;
+
+
+
+function VarAsType(const V: Variant; AVarType: TVarType): Variant;
+
+begin
+ sysvarcast(Result,V,AvarType);
+end;
+
+
+
+function VarIsType(const V: Variant; AVarType: TVarType): Boolean; overload;
+
+begin
+ Result:=((TVarData(V).vtype and VarTypeMask)=AVarType);
+end;
+
+
+function VarIsType(const V: Variant; const AVarTypes: array of TVarType): Boolean; overload;
+
+Var
+ I : Integer;
+
+begin
+ I:=Low(AVarTypes);
+ Result:=False;
+ While Not Result and (I<=High(AVarTypes)) do
+ Result:=((TVarData(V).vtype and VarTypeMask)=AVarTypes[I]);
+end;
+
+
+function VarIsByRef(const V: Variant): Boolean;
+begin
+ Result:=(TVarData(V).Vtype and varByRef)<>0;
+end;
+
+
+function VarIsEmpty(const V: Variant): Boolean;
+begin
+ Result:=TVarData(V).vtype=varEmpty;
+end;
+
+
+procedure VarCheckEmpty(const V: Variant);
+begin
+ If VarIsEmpty(V) Then
+ VariantError(SErrVarIsEmpty);
+end;
+
+
+procedure VarClear(var V: Variant);{$ifdef VARIANTINLINE}inline;{$endif VARIANTINLINE}
+begin
+ sysvarclear(v);
+end;
+
+
+function VarIsNull(const V: Variant): Boolean;
+begin
+ Result:=TVarData(V).vtype=varNull;
+end;
+
+
+function VarIsClear(const V: Variant): Boolean;
+
+Var
+ VT : TVarType;
+
+begin
+ VT:=TVarData(V).vtype and varTypeMask;
+ Result:=(VT=varEmpty) or
+ (((VT=varDispatch) or (VT=VarUnknown))
+ and (TVarData(V).VDispatch=Nil));
+end;
+
+
+function VarIsCustom(const V: Variant): Boolean;
+
+begin
+ Result:=TVarData(V).vtype>=CFirstUserType;
+end;
+
+
+function VarIsOrdinal(const V: Variant): Boolean;
+begin
+ Result:=(TVarData(V).VType and varTypeMask) in OrdinalVarTypes;
+end;
+
+
+
+function VarIsFloat(const V: Variant): Boolean;
+
+begin
+ Result:=(TVarData(V).VType and varTypeMask) in FloatVarTypes;
+end;
+
+
+function VarIsNumeric(const V: Variant): Boolean;
+
+begin
+ Result:=(TVarData(V).VType and varTypeMask) in (OrdinalVarTypes + FloatVarTypes);
+end;
+
+
+
+function VarIsStr(const V: Variant): Boolean;
+
+begin
+ case (TVarData(V).VType and varTypeMask) of
+ varOleStr,
+ varString :
+ Result:=True;
+ else
+ Result:=False;
+ end;
+end;
+
+
+function VarToStr(const V: Variant): string;
+
+begin
+ Result:=VarToStrDef(V,'');
+end;
+
+
+function VarToStrDef(const V: Variant; const ADefault: string): string;
+
+begin
+ If TVarData(V).vtype<>varNull then
+ Result:=V
+ else
+ Result:=ADefault;
+end;
+
+
+function VarToWideStr(const V: Variant): WideString;
+
+begin
+ Result:=VarToWideStrDef(V,'');
+end;
+
+
+function VarToWideStrDef(const V: Variant; const ADefault: WideString): WideString;
+
+begin
+ If TVarData(V).vtype<>varNull then
+ Result:=V
+ else
+ Result:=ADefault;
+end;
+
+
+function VarToDateTime(const V: Variant): TDateTime;
+
+begin
+ Result:=VariantToDate(TVarData(V));
+end;
+
+
+function VarFromDateTime(const DateTime: TDateTime): Variant;
+
+begin
+ SysVarClear(Result);
+ With TVarData(Result) do
+ begin
+ vtype:=varDate;
+ vdate:=DateTime;
+ end;
+end;
+
+
+function VarInRange(const AValue, AMin, AMax: Variant): Boolean;
+begin
+// Result:=(AValue>=AMin) and (AValue<=AMax);
+end;
+
+
+function VarEnsureRange(const AValue, AMin, AMax: Variant): Variant;
+begin
+ Result:=AValue;
+{ !! Operator not overloaded error...
+ If Result>AMAx then
+ Result:=AMax
+ else If Result<AMin Then
+ Result:=AMin;
+}
+end;
+
+
+function VarIsEmptyParam(const V: Variant): Boolean;
+begin
+ Result:=(TVarData(V).vtype = varerror) and
+ (TVarData(V).verror=VAR_PARAMNOTFOUND);
+end;
+
+
+procedure SetClearVarToEmptyParam(var V: TVarData);
+begin
+ VariantClear(V);
+ V.VType := varError;
+ V.VError := VAR_PARAMNOTFOUND;
+end;
+
+
+function VarIsError(const V: Variant; out AResult: HRESULT): Boolean;
+begin
+end;
+
+
+function VarIsError(const V: Variant): Boolean;
+var
+ LResult: HRESULT;
+begin
+ Result := VarIsError(V, LResult);
+end;
+
+
+function VarAsError(AResult: HRESULT): Variant;
+ begin
+ tvardata(result).VType:=varError;
+ tvardata(result).VError:=AResult;
+ end;
+
+
+function VarSupports(const V: Variant; const IID: TGUID; out Intf): Boolean;
+begin
+ NotSupported('VarSupports');
+end;
+
+
+function VarSupports(const V: Variant; const IID: TGUID): Boolean;
+begin
+ NotSupported('VarSupports');
+end;
+
+
+{ Variant copy support }
+procedure VarCopyNoInd(var Dest: Variant; const Source: Variant);
+
+begin
+ NotSupported('VarCopyNoInd');
+end;
+
+{****************************************************************************
+ Variant array support procedures and functions
+ ****************************************************************************}
+
+
+function VarArrayCreate(const Bounds: array of SizeInt; AVarType: TVarType): Variant;
+ var
+ hp : pvararrayboundarray;
+ p : pvararray;
+ i,lengthb : SizeInt;
+ begin
+ if not(VarTypeIsValidArrayType(AVarType)) or odd(length(Bounds)) then
+ VarArrayCreateError;
+ lengthb:=length(Bounds) div 2;
+ try
+ getmem(hp,lengthb*sizeof(TVarArrayBound));
+ for i:=0 to lengthb-1 do
+ begin
+ hp^[i].lowbound:=Bounds[i*2];
+ hp^[i].elementcount:=Bounds[i*2+1]-Bounds[i*2]+1;
+ end;
+ SysVarClear(result);
+
+ p:=SafeArrayCreate(AVarType,lengthb,hp^);
+
+ if not(assigned(p)) then
+ VarArrayCreateError;
+
+ tvardata(result).vtype:=AVarType or varArray;
+ tvardata(result).varray:=p;
+ finally
+ freemem(hp);
+ end;
+ end;
+
+
+function VarArrayOf(const Values: array of Variant): Variant;
+ var
+ i : SizeInt;
+ begin
+ if length(Values)>0 then
+ begin
+ result:=VarArrayCreate([0,high(Values)],varVariant);
+ for i:=0 to high(Values) do
+ result[i]:=Values[i];
+ end
+ else
+ begin
+ SysVarClear(result);
+ tvardata(result).vtype:=varEmpty;
+ end;
+ end;
+
+
+function VarArrayAsPSafeArray(const A: Variant): PVarArray;
+ var
+ v : tvardata;
+ begin
+ v:=tvardata(a);
+ while v.vtype=varByRef or varVariant do
+ v:=tvardata(v.vpointer^);
+
+ if (v.vtype and varArray)=varArray then
+ begin
+ if (v.vtype and varByRef)<>0 then
+ result:=pvararray(v.vpointer^)
+ else
+ result:=v.varray;
+ end
+ else
+ VarResultCheck(VAR_INVALIDARG);
+ end;
+
+
+function VarArrayDimCount(const A: Variant) : SizeInt;
+ var
+ hv : tvardata;
+ begin
+ hv:=tvardata(a);
+
+ { get final variant }
+ while hv.vtype=varByRef or varVariant do
+ hv:=tvardata(hv.vpointer^);
+
+ if (hv.vtype and varArray)<>0 then
+ result:=hv.varray^.DimCount
+ else
+ result:=0;
+ end;
+
+
+function VarArrayLowBound(const A: Variant; Dim: SizeInt) : SizeInt;
+ begin
+ VarResultCheck(SafeArrayGetLBound(VarArrayAsPSafeArray(A),Dim,Result));
+ end;
+
+
+function VarArrayHighBound(const A: Variant; Dim: SizeInt) : SizeInt;
+ begin
+ VarResultCheck(SafeArrayGetUBound(VarArrayAsPSafeArray(A),Dim,Result));
+ end;
+
+
+function VarArrayLock(const A: Variant): Pointer;
+ begin
+ VarResultCheck(SafeArrayAccessData(VarArrayAsPSafeArray(A),Result));
+ end;
+
+
+procedure VarArrayUnlock(const A: Variant);
+ begin
+ VarResultCheck(SafeArrayUnaccessData(VarArrayAsPSafeArray(A)));
+ end;
+
+
+function VarArrayRef(const A: Variant): Variant;
+ begin
+ if (tvardata(a).vtype and varArray)=0 then
+ VarInvalidArgError(tvardata(a).vtype);
+ tvardata(result).vtype:=tvardata(a).vtype or varByRef;
+ if (tvardata(a).vtype and varByRef)=0 then
+ tvardata(result).vpointer:=@tvardata(a).varray
+ else
+ tvardata(result).vpointer:=@tvardata(a).vpointer;
+ end;
+
+
+function VarIsArray(const A: Variant; AResolveByRef: Boolean): Boolean;
+ var
+ v : tvardata;
+ begin
+ v:=tvardata(a);
+ if AResolveByRef then
+ while v.vtype=varByRef or varVariant do
+ v:=tvardata(v.vpointer^);
+
+ result:=(v.vtype and varArray)=varArray;
+ end;
+
+
+function VarIsArray(const A: Variant): Boolean;
+ begin
+ VarIsArray:=VarIsArray(A,true);
+ end;
+
+
+function VarTypeIsValidArrayType(const AVarType: TVarType): Boolean;
+ begin
+ result:=AVarType in [varsmallint,varinteger,varsingle,vardouble,
+ varcurrency,vardate,varolestr,vardispatch,varerror,varboolean,
+ varvariant,varunknown,varshortint,varbyte,varword,varlongword];
+ end;
+
+
+function VarTypeIsValidElementType(const AVarType: TVarType): Boolean;
+ var
+ customvarianttype : TCustomVariantType;
+ begin
+ if FindCustomVariantType(AVarType,customvarianttype) then
+ result:=true
+ else
+ begin
+ result:=(AVarType and not(varByRef)) in [varempty,varnull,varsmallint,varinteger,varsingle,vardouble,
+ varcurrency,vardate,varolestr,vardispatch,varerror,varboolean,
+ varvariant,varunknown,varshortint,varbyte,varword,varlongword,varint64];
+ end;
+ end;
+
+
+{ ---------------------------------------------------------------------
+ Variant <-> Dynamic arrays support
+ ---------------------------------------------------------------------}
+
+
+procedure DynArrayToVariant(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
+begin
+ NotSupported('DynArrayToVariant');
+end;
+
+
+procedure DynArrayFromVariant(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
+begin
+ NotSupported('DynArrayFromVariant');
+end;
+
+
+function FindCustomVariantType(const AVarType: TVarType; out CustomVariantType: TCustomVariantType): Boolean; overload;
+ begin
+ result:=assigned(customvarianttype) and (AVarType>=CMinVarType);
+ if result then
+ begin
+ EnterCriticalSection(customvarianttypelock);
+ try
+ result:=(AVarType-CMinVarType)<=high(customvarianttypes);
+ if result then
+ begin
+ CustomVariantType:=customvarianttypes[AVarType-CMinVarType];
+ result:=assigned(CustomVariantType) and
+ (CustomVariantType<>InvalidCustomVariantType);
+ end;
+ finally
+ LeaveCriticalSection(customvarianttypelock);
+ end;
+ end;
+ end;
+
+
+function FindCustomVariantType(const TypeName: string; out CustomVariantType: TCustomVariantType): Boolean; overload;
+
+begin
+ NotSupported('FindCustomVariantType');
+end;
+
+function Unassigned: Variant; // Unassigned standard constant
+begin
+ SysVarClear(Result);
+ TVarData(Result).VType := varempty;
+end;
+
+
+function Null: Variant; // Null standard constant
+begin
+ SysVarClear(Result);
+ TVarData(Result).VType := varnull;
+end;
+
+
+{ ---------------------------------------------------------------------
+ TCustomVariantType Class.
+ ---------------------------------------------------------------------}
+
+function TCustomVariantType.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+
+begin
+ NotSupported('TCustomVariantType.QueryInterface');
+end;
+
+
+function TCustomVariantType._AddRef: Integer; stdcall;
+
+begin
+ NotSupported('TCustomVariantType._AddRef');
+end;
+
+
+function TCustomVariantType._Release: Integer; stdcall;
+
+begin
+ NotSupported('TCustomVariantType._Release');
+end;
+
+
+
+procedure TCustomVariantType.SimplisticClear(var V: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.SimplisticClear');
+end;
+
+
+procedure TCustomVariantType.SimplisticCopy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean = False);
+begin
+ NotSupported('TCustomVariantType.SimplisticCopy');
+end;
+
+
+procedure TCustomVariantType.RaiseInvalidOp;
+begin
+ NotSupported('TCustomVariantType.RaiseInvalidOp');
+end;
+
+
+procedure TCustomVariantType.RaiseCastError;
+begin
+ NotSupported('TCustomVariantType.RaiseCastError');
+end;
+
+
+procedure TCustomVariantType.RaiseDispError;
+
+begin
+ NotSupported('TCustomVariantType.RaiseDispError');
+end;
+
+
+
+function TCustomVariantType.LeftPromotion(const V: TVarData; const Operation: TVarOp; out RequiredVarType: TVarType): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.LeftPromotion');
+end;
+
+
+function TCustomVariantType.RightPromotion(const V: TVarData; const Operation: TVarOp; out RequiredVarType: TVarType): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.RightPromotion');
+end;
+
+
+function TCustomVariantType.OlePromotion(const V: TVarData; out RequiredVarType: TVarType): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.OlePromotion');
+end;
+
+
+procedure TCustomVariantType.DispInvoke(var Dest: TVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
+
+begin
+ NotSupported('TCustomVariantType.DispInvoke');
+end;
+
+
+
+procedure TCustomVariantType.VarDataInit(var Dest: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.VarDataInit');
+end;
+
+
+procedure TCustomVariantType.VarDataClear(var Dest: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.VarDataClear');
+end;
+
+
+
+procedure TCustomVariantType.VarDataCopy(var Dest: TVarData; const Source: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.VarDataCopy');
+end;
+
+
+procedure TCustomVariantType.VarDataCopyNoInd(var Dest: TVarData; const Source: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.VarDataCopyNoInd');
+end;
+
+
+
+procedure TCustomVariantType.VarDataCast(var Dest: TVarData; const Source: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.VarDataCast');
+end;
+
+
+procedure TCustomVariantType.VarDataCastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType);
+
+begin
+ NotSupported('TCustomVariantType.VarDataCastTo');
+end;
+
+
+procedure TCustomVariantType.VarDataCastTo(var Dest: TVarData; const AVarType: TVarType);
+
+begin
+ NotSupported('TCustomVariantType.VarDataCastTo');
+end;
+
+
+procedure TCustomVariantType.VarDataCastToOleStr(var Dest: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.VarDataCastToOleStr');
+end;
+
+
+
+procedure TCustomVariantType.VarDataFromStr(var V: TVarData; const Value: string);
+
+begin
+ NotSupported('TCustomVariantType.VarDataFromStr');
+end;
+
+
+procedure TCustomVariantType.VarDataFromOleStr(var V: TVarData; const Value: WideString);
+
+begin
+ NotSupported('TCustomVariantType.VarDataFromOleStr');
+end;
+
+
+function TCustomVariantType.VarDataToStr(const V: TVarData): string;
+
+begin
+ NotSupported('TCustomVariantType.VarDataToStr');
+end;
+
+
+
+function TCustomVariantType.VarDataIsEmptyParam(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsEmptyParam');
+end;
+
+
+function TCustomVariantType.VarDataIsByRef(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsByRef');
+end;
+
+
+function TCustomVariantType.VarDataIsArray(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsArray');
+end;
+
+
+
+function TCustomVariantType.VarDataIsOrdinal(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsOrdinal');
+end;
+
+
+function TCustomVariantType.VarDataIsFloat(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsFloat');
+end;
+
+
+function TCustomVariantType.VarDataIsNumeric(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsNumeric');
+end;
+
+
+function TCustomVariantType.VarDataIsStr(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.VarDataIsStr');
+end;
+
+
+constructor TCustomVariantType.Create;
+
+begin
+ NotSupported('TCustomVariantType.Create;');
+end;
+
+
+constructor TCustomVariantType.Create(RequestedVarType: TVarType);
+
+begin
+ NotSupported('TCustomVariantType.Create');
+end;
+
+
+destructor TCustomVariantType.Destroy;
+
+begin
+ NotSupported('TCustomVariantType.Destroy');
+end;
+
+
+
+function TCustomVariantType.IsClear(const V: TVarData): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.IsClear');
+end;
+
+
+procedure TCustomVariantType.Cast(var Dest: TVarData; const Source: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.Cast');
+end;
+
+
+procedure TCustomVariantType.CastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType);
+
+begin
+ NotSupported('TCustomVariantType.CastTo');
+end;
+
+
+procedure TCustomVariantType.CastToOle(var Dest: TVarData; const Source: TVarData);
+
+begin
+ NotSupported('TCustomVariantType.CastToOle');
+end;
+
+
+
+procedure TCustomVariantType.BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp);
+
+begin
+ NotSupported('TCustomVariantType.BinaryOp');
+end;
+
+
+procedure TCustomVariantType.UnaryOp(var Right: TVarData; const Operation: TVarOp);
+
+begin
+ NotSupported('TCustomVariantType.UnaryOp');
+end;
+
+
+function TCustomVariantType.CompareOp(const Left, Right: TVarData; const Operation: TVarOp): Boolean;
+
+begin
+ NotSupported('TCustomVariantType.CompareOp');
+end;
+
+
+procedure TCustomVariantType.Compare(const Left, Right: TVarData; var Relationship: TVarCompareResult);
+
+begin
+ NotSupported('TCustomVariantType.Compare');
+end;
+
+{ ---------------------------------------------------------------------
+ TInvokeableVariantType implementation
+ ---------------------------------------------------------------------}
+
+procedure TInvokeableVariantType.DispInvoke(var Dest: TVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
+
+begin
+ NotSupported('TInvokeableVariantType.DispInvoke');
+end;
+
+function TInvokeableVariantType.DoFunction(var Dest: TVarData; const V: TVarData; const Name: string; const Arguments: TVarDataArray): Boolean;
+
+begin
+ NotSupported('TInvokeableVariantType.DoFunction');
+end;
+
+function TInvokeableVariantType.DoProcedure(const V: TVarData; const Name: string; const Arguments: TVarDataArray): Boolean;
+begin
+ NotSupported('TInvokeableVariantType.DoProcedure');
+end;
+
+
+function TInvokeableVariantType.GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean;
+ begin
+ NotSupported('TInvokeableVariantType.GetProperty');
+ end;
+
+
+function TInvokeableVariantType.SetProperty(const V: TVarData; const Name: string; const Value: TVarData): Boolean;
+ begin
+ NotSupported('TInvokeableVariantType.SetProperty');
+ end;
+
+
+function TPublishableVariantType.GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean;
+ begin
+ result:=true;
+ variant(dest):=GetPropValue(getinstance(v),name);
+ end;
+
+
+function TPublishableVariantType.SetProperty(const V: TVarData; const Name: string; const Value: TVarData): Boolean;
+ begin
+ result:=true;
+ SetPropValue(getinstance(v),name,variant(value));
+ end;
+
+
+procedure VarCastError;
+ begin
+ raise EVariantTypeCastError.Create(SInvalidVarCast);
+ end;
+
+
+procedure VarCastError(const ASourceType, ADestType: TVarType);
+ begin
+ raise EVariantTypeCastError.CreateFmt(SVarTypeCouldNotConvert,
+ [VarTypeAsText(ASourceType),VarTypeAsText(ADestType)]);
+ end;
+
+
+procedure VarInvalidOp;
+ begin
+ raise EVariantInvalidOpError.Create(SInvalidVarOp);
+ end;
+
+
+procedure VarInvalidNullOp;
+ begin
+ raise EVariantInvalidOpError.Create(SInvalidVarNullOp);
+ end;
+
+
+procedure VarParamNotFoundError;
+ begin
+ raise EVariantParamNotFoundError.Create(SVarParamNotFound);
+ end;
+
+
+procedure VarBadTypeError;
+ begin
+ raise EVariantBadVarTypeError.Create(SVarBadType);
+ end;
+
+
+procedure VarOverflowError;
+ begin
+ raise EVariantOverflowError.Create(SVarOverflow);
+ end;
+
+
+procedure VarOverflowError(const ASourceType, ADestType: TVarType);
+ begin
+ raise EVariantOverflowError.CreateFmt(SVarTypeConvertOverflow,
+ [VarTypeAsText(ASourceType),VarTypeAsText(ADestType)]);
+ end;
+
+
+procedure VarRangeCheckError(const AType: TVarType);
+ begin
+ raise EVariantOverflowError.CreateFmt(SVarTypeRangeCheck1,
+ [VarTypeAsText(AType)])
+ end;
+
+
+procedure VarRangeCheckError(const ASourceType, ADestType: TVarType);
+ begin
+ if ASourceType<>ADestType then
+ raise EVariantOverflowError.CreateFmt(SVarTypeRangeCheck2,
+ [VarTypeAsText(ASourceType),VarTypeAsText(ADestType)])
+ else
+ VarRangeCheckError(ASourceType);
+ end;
+
+
+procedure VarBadIndexError;
+ begin
+ raise EVariantBadIndexError.Create(SVarArrayBounds);
+ end;
+
+
+procedure VarArrayLockedError;
+ begin
+ raise EVariantArrayLockedError.Create(SVarArrayLocked);
+ end;
+
+
+procedure VarNotImplError;
+ begin
+ raise EVariantNotImplError.Create(SVarNotImplemented);
+ end;
+
+
+procedure VarOutOfMemoryError;
+ begin
+ raise EVariantOutOfMemoryError.Create(SOutOfMemory);
+ end;
+
+
+procedure VarInvalidArgError;
+ begin
+ raise EVariantInvalidArgError.Create(SVarInvalid);
+ end;
+
+
+procedure VarInvalidArgError(AType: TVarType);
+ begin
+ raise EVariantInvalidArgError.CreateFmt(SVarInvalid1,
+ [VarTypeAsText(AType)])
+ end;
+
+
+procedure VarUnexpectedError;
+ begin
+ raise EVariantUnexpectedError.Create(SVarUnexpected);
+ end;
+
+
+procedure VarArrayCreateError;
+ begin
+ raise EVariantArrayCreateError.Create(SVarArrayCreate);
+ end;
+
+
+procedure RaiseVarException(res : HRESULT);
+ begin
+ case res of
+ VAR_PARAMNOTFOUND:
+ VarParamNotFoundError;
+ VAR_TYPEMISMATCH:
+ VarCastError;
+ VAR_BADVARTYPE:
+ VarBadTypeError;
+ VAR_EXCEPTION:
+ VarInvalidOp;
+ VAR_OVERFLOW:
+ VarOverflowError;
+ VAR_BADINDEX:
+ VarBadIndexError;
+ VAR_ARRAYISLOCKED:
+ VarArrayLockedError;
+ VAR_NOTIMPL:
+ VarNotImplError;
+ VAR_OUTOFMEMORY:
+ VarOutOfMemoryError;
+ VAR_INVALIDARG:
+ VarInvalidArgError;
+ VAR_UNEXPECTED:
+ VarUnexpectedError;
+ else
+ raise EVariantError.CreateFmt(SInvalidVarOpWithHResultWithPrefix,
+ ['$',res,'']);
+ end;
+ end;
+
+
+procedure VarResultCheck(AResult: HRESULT);
+ begin
+ if AResult<>VAR_OK then
+ RaiseVarException(AResult);
+ end;
+
+
+procedure VarResultCheck(AResult: HRESULT; ASourceType, ADestType: TVarType);
+ begin
+ case AResult of
+ VAR_OK:
+ ;
+ VAR_OVERFLOW:
+ VarOverflowError(ASourceType,ADestType);
+ VAR_TYPEMISMATCH:
+ VarCastError(ASourceType,ADestType);
+ else
+ RaiseVarException(AResult);
+ end;
+ end;
+
+
+procedure HandleConversionException(const ASourceType, ADestType: TVarType);
+ begin
+ if exceptobject is econverterror then
+ varcasterror(asourcetype,adesttype)
+ else if (exceptobject is eoverflow) or
+ (exceptobject is erangeerror) then
+ varoverflowerror(asourcetype,adesttype)
+ else
+ raise exception(acquireexceptionobject);
+ end;
+
+
+function VarTypeAsText(const AType: TVarType): string;
+ var
+ customvarianttype : tcustomvarianttype;
+ const
+ names : array[varempty..varqword] of string[8] = (
+ 'Empty','Null','Smallint','Integer','Single','Double','Currency','Date','OleStr','Dispatch','Error','Boolean','Variant',
+ 'Unknown','Decimal','???','ShortInt','Byte','Word','DWord','Int64','QWord');
+ begin
+ if ((AType and VarTypeMask)>=low(names)) and ((AType and VarTypeMask)<=high(names)) then
+ result:=names[AType]
+ else
+ case AType and VarTypeMask of
+ varString:
+ result:='String';
+ varAny:
+ result:='Any';
+ else
+ begin
+ if FindCustomVariantType(AType and VarTypeMask,customvarianttype) then
+ result:=customvarianttype.classname
+ else
+ result:='$'+IntToHex(AType and VarTypeMask,4)
+ end;
+ end;
+ if (AType and vararray)<>0 then
+ result:='Array of '+result;
+ if (AType and varbyref)<>0 then
+ result:='Ref to '+result;
+ end;
+
+
+function FindVarData(const V: Variant): PVarData;
+ begin
+ NotSupported('FindVarData');
+ end;
+
+{ ---------------------------------------------------------------------
+ Variant properties from typinfo
+ ---------------------------------------------------------------------}
+
+
+Function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
+begin
+{$warning GetVariantProp not implemented}
+{$ifdef HASVARIANT}
+ Result:=Null;
+{$else}
+ Result:=nil;
+{$endif}
+end;
+
+
+Procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo; const Value: Variant);
+begin
+{$warning SetVariantProp not implemented}
+end;
+
+
+Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
+begin
+ Result:=GetVariantProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
+begin
+ SetVariantprop(instance,FindpropInfo(Instance,PropName),Value);
+end;
+
+{ ---------------------------------------------------------------------
+ All properties through variant.
+ ---------------------------------------------------------------------}
+
+Function GetPropValue(Instance: TObject; const PropName: string): Variant;
+begin
+ Result:=GetPropValue(Instance,PropName,True);
+end;
+
+
+Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
+
+var
+ PropInfo: PPropInfo;
+
+begin
+ // find the property
+ PropInfo := GetPropInfo(Instance, PropName);
+ if PropInfo = nil then
+ raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName])
+ else
+ begin
+ Result := Null; //at worst
+ // call the right GetxxxProp
+ case PropInfo^.PropType^.Kind of
+ tkInteger, tkChar, tkWChar, tkClass, tkBool:
+ Result := GetOrdProp(Instance, PropInfo);
+ tkEnumeration:
+ if PreferStrings then
+ Result := GetEnumProp(Instance, PropInfo)
+ else
+ Result := GetOrdProp(Instance, PropInfo);
+ tkSet:
+ if PreferStrings then
+ Result := GetSetProp(Instance, PropInfo, False)
+ else
+ Result := GetOrdProp(Instance, PropInfo);
+ tkFloat:
+ Result := GetFloatProp(Instance, PropInfo);
+ tkMethod:
+ Result := PropInfo^.PropType^.Name;
+ tkString, tkLString, tkAString:
+ Result := GetStrProp(Instance, PropInfo);
+ tkWString:
+ Result := GetWideStrProp(Instance, PropInfo);
+ tkVariant:
+ Result := GetVariantProp(Instance, PropInfo);
+ tkInt64:
+ Result := GetInt64Prop(Instance, PropInfo);
+ else
+ raise EPropertyError.CreateFmt('Invalid Property Type: %s',[PropInfo^.PropType^.Name]);
+ end;
+ end;
+end;
+
+Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
+
+var
+ PropInfo: PPropInfo;
+ TypeData: PTypeData;
+
+begin
+ // find the property
+ PropInfo := GetPropInfo(Instance, PropName);
+ if PropInfo = nil then
+ raise EPropertyError.CreateFmt('SetPropValue: Unknown property: "%s"', [PropName])
+ else
+ begin
+ TypeData := GetTypeData(PropInfo^.PropType);
+ // call right SetxxxProp
+ case PropInfo^.PropType^.Kind of
+ tkInteger, tkChar, tkWChar, tkBool, tkEnumeration, tkSet:
+ SetOrdProp(Instance, PropInfo, Value);
+ tkFloat:
+ SetFloatProp(Instance, PropInfo, Value);
+ tkString, tkLString, tkAString:
+ SetStrProp(Instance, PropInfo, VarToStr(Value));
+ tkWString:
+ SetWideStrProp(Instance, PropInfo, VarToWideStr(Value));
+ tkVariant:
+ SetVariantProp(Instance, PropInfo, Value);
+ tkInt64:
+ SetInt64Prop(Instance, PropInfo, Value);
+ else
+ raise EPropertyError.CreateFmt('SetPropValue: Invalid Property Type %s',
+ [PropInfo^.PropType^.Name]);
+ end;
+ end;
+end;
+
+
+Initialization
+ InitCriticalSection(customvarianttypelock);
+ SetSysVariantManager;
+ SetClearVarToEmptyParam(TVarData(EmptyParam));
+ VarClearProc:=@sysvarclearproc;
+ VarAddRefProc:=@sysvaraddrefproc;
+ VarCopyProc:=@sysvarcopyproc;
+ // Typinfo variant support
+ OnGetVariantProp:=@GetVariantprop;
+ OnSetVariantProp:=@SetVariantprop;
+ OnSetPropValue:=@SetPropValue;
+ OnGetPropValue:=@GetPropValue;
+ InvalidCustomVariantType:=TCustomVariantType(-1);
+Finalization
+ UnSetSysVariantManager;
+ DoneCriticalSection(customvarianttypelock);
+{$endif HASVARIANT}
+
+end.
+
+{
+ $Log: variants.pp,v $
+ Revision 1.50 2005/05/07 09:47:41 florian
+ + added TPublishableVariantType
+
+ Revision 1.49 2005/04/28 19:34:19 florian
+ + variant<->currency/tdatetime operators
+
+ Revision 1.48 2005/04/28 09:15:43 florian
+ + variants: string -> float/int casts
+
+ Revision 1.47 2005/04/16 09:23:38 michael
+ + Added variant support for properties
+
+ Revision 1.46 2005/04/10 20:24:31 florian
+ + basic operators (int, real and string) for variants implemented
+
+ Revision 1.45 2005/04/10 09:22:38 florian
+ + varrarrayredim added and implemented
+
+ Revision 1.44 2005/04/06 07:43:02 michael
+ + Variant type conversion rules
+
+ Revision 1.43 2005/04/03 11:09:09 florian
+ + HandleConversionException implemented
+
+ Revision 1.42 2005/04/03 10:59:06 florian
+ * variants: cast int to real fixed
+
+ Revision 1.41 2005/03/28 20:36:14 florian
+ * some variant <-> string types fixes
+
+ Revision 1.40 2005/03/28 14:14:17 florian
+ + reading of vararray elements implemented
+
+ Revision 1.39 2005/03/28 13:38:05 florian
+ + a lot of vararray stuff
+
+ Revision 1.38 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.37 2005/03/25 19:02:59 florian
+ + more vararray stuff
+
+ Revision 1.36 2005/03/25 18:03:50 florian
+ + some vararray stuff added
+
+ Revision 1.35 2005/03/13 14:36:44 marco
+ * very stupid copy and paste bug fixed
+
+ Revision 1.34 2005/03/13 14:23:02 florian
+ * fixed inline directive
+
+ Revision 1.33 2005/03/13 11:53:25 florian
+ + VarClear
+
+ Revision 1.32 2005/03/12 09:07:54 florian
+ + Null/Unassigned patch from Danny
+
+ Revision 1.31 2005/03/10 21:05:36 florian
+ + writing of variants implemented
+
+ Revision 1.30 2005/03/10 19:09:14 michael
+ * Fixed sysclearvariants so it clears vunknown
+
+ Revision 1.29 2005/03/09 23:18:48 peter
+ reset VUnknown before assigning a new interface
+
+ Revision 1.28 2005/03/06 14:06:53 florian
+ * variant creating from strings fixed
+ * comparisation for strings in variants implemented
+
+ Revision 1.27 2005/03/06 13:06:44 florian
+ + more varcmp code
+
+ Revision 1.26 2005/03/06 12:26:17 florian
+ + varcmp partially implemented
+
+ Revision 1.25 2005/02/24 22:36:36 florian
+ + some variant stuff fixed and added
+
+ Revision 1.24 2005/02/14 17:13:29 peter
+ * truncate log
+
+ Revision 1.23 2005/02/07 21:52:08 florian
+ + basic variant<->intf conversion
+
+ Revision 1.22 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.21 2005/01/15 18:47:26 florian
+ * several variant init./final. stuff fixed
+
+ Revision 1.20 2005/01/08 16:26:45 florian
+ * fixed previous commit
+
+ Revision 1.19 2005/01/08 16:19:42 florian
+ * made some variants stuff more readable
+
+ Revision 1.18 2005/01/07 21:15:46 florian
+ + basic rtl support for variant <-> interface implemented
+
+}
diff --git a/rtl/inc/video.inc b/rtl/inc/video.inc
new file mode 100644
index 0000000000..207424ed63
--- /dev/null
+++ b/rtl/inc/video.inc
@@ -0,0 +1,270 @@
+{
+ $Id: video.inc,v 1.8 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Const
+ LockUpdateScreen : Integer = 0;
+
+Procedure LockScreenUpdate;
+
+begin
+ Inc(LockUpdateScreen);
+end;
+
+Procedure UnLockScreenUpdate;
+
+begin
+ If LockUpdateScreen>0 then
+ Dec(LockUpdateScreen);
+end;
+
+Function GetLockScreenCount : integer;
+begin
+ GetLockScreenCount:=LockUpdateScreen;
+end;
+
+Var
+ CurrentVideoDriver : TVideoDriver;
+ NextVideoMode : TVideoMode;
+
+Const
+ VideoInitialized : Boolean = False;
+ DriverInitialized : Boolean = False;
+ NextVideoModeSet : Boolean = False;
+
+Function SetVideoDriver (Const Driver : TVideoDriver) : Boolean;
+{ Sets the videodriver to be used }
+begin
+ If Not VideoInitialized then
+ Begin
+ CurrentVideoDriver:=Driver;
+ DriverInitialized:=true;
+ NextVideoModeSet:=false;
+ End;
+ SetVideoDriver:=Not VideoInitialized;
+end;
+
+Procedure GetVideoDriver (Var Driver : TVideoDriver);
+{ Retrieves the current videodriver }
+begin
+ Driver:=CurrentVideoDriver;
+end;
+
+{ ---------------------------------------------------------------------
+ External functions that use the video driver.
+ ---------------------------------------------------------------------}
+
+Procedure FreeVideoBuf;
+
+begin
+ if (VideoBuf<>Nil) then
+ begin
+ FreeMem(VideoBuf);
+ FreeMem(OldVideoBuf);
+ VideoBuf:=Nil;
+ OldVideoBuf:=Nil;
+ VideoBufSize:=0;
+ end;
+end;
+
+Procedure AssignVideoBuf (OldCols, OldRows : Word);
+
+Var NewVideoBuf,NewOldVideoBuf : PVideoBuf;
+ S,I,C,R,NewVideoBufSize : Integer;
+
+begin
+ S:=SizeOf(TVideoCell);
+ NewVideoBufSize:=ScreenWidth*ScreenHeight*S;
+ GetMem(NewVideoBuf,NewVideoBufSize);
+ GetMem(NewOldVideoBuf,NewVideoBufSize);
+ // Move contents of old videobuffers to new if there are any.
+ if (VideoBuf<>Nil) then
+ begin
+ If (ScreenWidth<OldCols) then
+ C:=ScreenWidth
+ else
+ C:=OldCols;
+ If (ScreenHeight<OldRows) then
+ R:=ScreenHeight
+ else
+ R:=OldRows;
+ For I:=0 to R-1 do
+ begin
+ Move(VideoBuf^[I*OldCols],NewVideoBuf^[I*ScreenWidth],S*C);
+ Move(OldVideoBuf^[I*OldCols],NewOldVideoBuf^[I*ScreenWidth],S*C);
+ end;
+ end;
+ FreeVideoBuf;
+ VideoBufSize:=NewVideoBufSize;
+ VideoBuf:=NewVideoBuf;
+ OldVideoBuf:=NewOldVideoBuf;
+end;
+
+Procedure InitVideo;
+
+begin
+ If Not VideoInitialized then
+ begin
+ If Assigned(CurrentVideoDriver.InitDriver) then
+ CurrentVideoDriver.InitDriver;
+ VideoInitialized:=True;
+ if NextVideoModeSet then
+ SetVideoMode(NextVideoMode)
+ else
+ AssignVideoBuf(0,0);
+ ClearScreen;
+ end;
+end;
+
+
+Procedure DoneVideo;
+
+begin
+ If VideoInitialized then
+ begin
+ If Assigned(CurrentVideoDriver.DoneDriver) then
+ CurrentVideoDriver.DoneDriver;
+ FreeVideoBuf;
+ VideoInitialized:=False;
+ end;
+end;
+
+Procedure UpdateScreen (Force : Boolean);
+
+begin
+ If (LockUpdateScreen<=0) and
+ Assigned(CurrentVideoDriver.UpdateScreen) then
+ CurrentVideoDriver.UpdateScreen(Force);
+end;
+
+Procedure ClearScreen;
+
+begin
+ // Should this not be the current color ?
+ FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
+ If Assigned(CurrentVideoDriver.ClearScreen) then
+ CurrentVideoDriver.ClearScreen
+ else
+ UpdateScreen(True);
+ FillWord(OldVideoBuf^,VideoBufSize shr 1,$0720);
+end;
+
+Procedure SetCursorType (NewType : Word);
+
+begin
+ if Assigned(CurrentVideoDriver.SetCursorType) then
+ CurrentVideoDriver.SetCursorType(NewType)
+end;
+
+Function GetCursorType : Word;
+
+begin
+ if Assigned(CurrentVideoDriver.GetCursorType) then
+ GetCursorType:=CurrentVideoDriver.GetCursorType()
+ else
+ GetCursorType:=0;
+end;
+
+procedure SetCursorPos(NewCursorX, NewCursorY: Word);
+
+begin
+ If Assigned(CurrentVideoDriver.SetCursorPos) then
+ CurrentVideoDriver.SetCursorPos(NewCursorX, NewCursorY)
+end;
+
+function GetCapabilities: Word;
+begin
+ If Assigned(CurrentVideoDriver.GetCapabilities) then
+ GetCapabilities:=CurrentVideoDriver.GetCapabilities()
+ else
+ GetCapabilities:=0;
+end;
+
+
+{ ---------------------------------------------------------------------
+ General functions
+ ---------------------------------------------------------------------}
+
+
+procedure GetVideoMode(var Mode: TVideoMode);
+begin
+ Mode.Col := ScreenWidth;
+ Mode.Row := ScreenHeight;
+ Mode.Color := ScreenColor;
+end;
+
+Function SetVideoMode(Const Mode: TVideoMode) : Boolean;
+
+Var
+ OldR,OldC: Word;
+
+begin
+ SetVideoMode:=DriverInitialized;
+ if not DriverInitialized then
+ exit;
+ If VideoInitialized then
+ begin
+ OldC:=ScreenWidth;
+ OldR:=ScreenHeight;
+ If Assigned(CurrentVideoDriver.SetVideoMode) then
+ SetVideoMode:=CurrentVideoDriver.SetVideoMode(Mode)
+ else
+ SetVideoMode:=False;
+ // Assign buffer
+ If SetVideoMode then
+ AssignVideoBuf(OldC,Oldr);
+ end
+ else
+ begin
+ NextVideoMode:=Mode;
+ NextVideoModeSet:=true;
+ end;
+end;
+
+
+Function GetVideoModeCount : Word;
+
+begin
+ If Assigned(CurrentVideoDriver.GetVideoModeCount) then
+ GetVideoModeCount:=CurrentVideoDriver.GetVideoModeCount()
+ else
+ GetVideoModeCount:=1;
+end;
+
+Function GetVideoModeData(Index : Word; Var Data: TVideoMode) : Boolean;
+
+begin
+ If Assigned(CurrentVideoDriver.GetVideoModeData) then
+ GetVideoModeData:=CurrentVideoDriver.GetVideoModeData(Index,Data)
+ else
+ begin
+ GetVideoModeData:=(Index=0);
+ If GetVideoModeData then
+ GetVideoMode(Data);
+ end
+end;
+
+function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
+begin
+ ErrorCode := AErrorCode;
+ ErrorInfo := AErrorInfo;
+ DefaultErrorHandler := errAbort; { return error code }
+end;
+
+{
+ $Log: video.inc,v $
+ Revision 1.8 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/inc/videoh.inc b/rtl/inc/videoh.inc
new file mode 100644
index 0000000000..92b9d5af21
--- /dev/null
+++ b/rtl/inc/videoh.inc
@@ -0,0 +1,170 @@
+{
+ $Id: videoh.inc,v 1.8 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ PVideoMode = ^TVideoMode;
+ TVideoMode = record
+ Col,Row : Word;
+ Color : Boolean;
+ end;
+ TVideoModeSelector = function (const VideoMode: TVideoMode; Params: Longint): Boolean;
+
+ TVideoCell = Word;
+ PVideoCell = ^TVideoCell;
+
+ TVideoBuf = array[0..32759] of TVideoCell;
+ PVideoBuf = ^TVideoBuf;
+
+ TVideoDriver = Record
+ InitDriver : Procedure;
+ DoneDriver : Procedure;
+ UpdateScreen : Procedure(Force : Boolean);
+ ClearScreen : Procedure;
+ SetVideoMode : Function (Const Mode : TVideoMode) : Boolean;
+ GetVideoModeCount : Function : Word;
+ GetVideoModeData : Function(Index : Word; Var Data : TVideoMode) : Boolean;
+ SetCursorPos : procedure (NewCursorX, NewCursorY: Word);
+ GetCursorType : function : Word;
+ SetCursorType : procedure (NewType: Word);
+ GetCapabilities : Function : Word;
+ end;
+
+const
+ { Foreground and background color constants }
+ Black = 0;
+ Blue = 1;
+ Green = 2;
+ Cyan = 3;
+ Red = 4;
+ Magenta = 5;
+ Brown = 6;
+ LightGray = 7;
+
+ { Foreground color constants }
+ DarkGray = 8;
+ LightBlue = 9;
+ LightGreen = 10;
+ LightCyan = 11;
+ LightRed = 12;
+ LightMagenta = 13;
+ Yellow = 14;
+ White = 15;
+
+ { Add-in for blinking }
+ Blink = 128;
+
+ { Capabilities bitmask }
+ cpUnderLine = $0001;
+ cpBlink = $0002;
+ cpColor = $0004;
+ cpChangeFont = $0008;
+ cpChangeMode = $0010;
+ cpChangeCursor = $0020;
+
+ { Possible cursor types }
+ crHidden = 0;
+ crUnderLine = 1;
+ crBlock = 2;
+ crHalfBlock = 3;
+
+ { Possible error codes }
+ vioOK = 0;
+ errVioBase = 1000;
+ errVioInit = errVioBase + 1; { Initialization error, shouldn't occur on DOS, but may
+ on Linux }
+ errVioNotSupported = errVioBase + 2; { call to an unsupported function }
+ errVioNoSuchMode = errVioBase + 3; { No such video mode }
+
+const
+ ScreenWidth : Word = 0;
+ ScreenHeight : Word = 0;
+
+var
+ ScreenColor : Boolean;
+ CursorX,
+ CursorY : Word;
+ VideoBuf,
+ OldVideoBuf : PVideoBuf;
+ VideoBufSize : Longint;
+ CursorLines : Byte;
+
+const
+ LowAscii : Boolean = true;
+ NoExtendedFrame : Boolean = false;
+ FVMaxWidth = 132;
+
+Procedure LockScreenUpdate;
+{ Increments the screen update lock count with one.}
+Procedure UnlockScreenUpdate;
+{ Decrements the screen update lock count with one.}
+Function GetLockScreenCount : integer;
+{ Gets the current lock level }
+Function SetVideoDriver (Const Driver : TVideoDriver) : Boolean;
+{ Sets the videodriver to be used }
+Procedure GetVideoDriver (Var Driver : TVideoDriver);
+{ Retrieves the current videodriver }
+
+procedure InitVideo;
+{ Initializes the video subsystem }
+procedure DoneVideo;
+{ Deinitializes the video subsystem }
+function GetCapabilities: Word;
+{ Return the capabilities of the current environment }
+procedure ClearScreen;
+{ Clears the screen }
+procedure UpdateScreen(Force: Boolean);
+{ Force specifies whether the whole screen has to be redrawn, or (if target
+ platform supports it) its parts only }
+procedure SetCursorPos(NewCursorX, NewCursorY: Word);
+{ Position the cursor to the given position }
+function GetCursorType: Word;
+{ Return the cursor type: Hidden, UnderLine or Block }
+procedure SetCursorType(NewType: Word);
+{ Set the cursor to the given type }
+
+procedure GetVideoMode(var Mode: TVideoMode);
+{ Return dimensions of the current video mode }
+Function SetVideoMode(Const Mode: TVideoMode) : Boolean;
+{ Set video-mode to have Mode dimensions, may return errVioNoSuchMode }
+Function GetVideoModeCount : Word;
+{ Get the number of video modes supported by this driver }
+Function GetVideoModeData(Index : Word; Var Data: TVideoMode) : Boolean;
+{ Get the data for Video mode Index. Index is zero based. }
+
+type
+ TErrorHandlerReturnValue = (errRetry, errAbort, errContinue);
+ { errRetry = retry the operation,
+ errAbort = abort, return error code,
+ errContinue = abort, without returning errorcode }
+
+ TErrorHandler = function (Code: Longint; Info: Pointer): TErrorHandlerReturnValue;
+ { ErrorHandler is the standard procedural interface for all error functions.
+ Info may contain any data type specific to the error code passed to the
+ function. }
+
+function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
+{ Default error handler, simply sets error code, and returns errContinue }
+
+const
+ errOk = 0;
+ ErrorCode: Longint = ErrOK;
+ ErrorInfo: Pointer = nil;
+ ErrorHandler: TErrorHandler = @DefaultErrorHandler;
+
+{
+ $Log: videoh.inc,v $
+ Revision 1.8 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/inc/wstringh.inc b/rtl/inc/wstringh.inc
new file mode 100644
index 0000000000..732804b137
--- /dev/null
+++ b/rtl/inc/wstringh.inc
@@ -0,0 +1,125 @@
+{
+ $Id: wstringh.inc,v 1.7 2005/03/14 21:09:04 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2005 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ This file implements support routines for WideStrings/Unicode with FPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$ifndef INTERNSETLENGTH}
+Procedure SetLength (Var S : WideString; l : SizeInt);
+{$endif INTERNSETLENGTH}
+procedure UniqueString(Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';
+{$ifndef INTERNLENGTH}
+Function Length (Const S : WideString) : SizeInt;
+{$endif INTERNLENGTH}
+{$ifndef InternCopy}
+Function Copy (Const S : WideString; Index,Size : SizeInt) : WideString;
+{$endif interncopy}
+Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+Function Pos (c : Char; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
+
+Function UpCase(const s : WideString) : WideString;
+
+Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
+Procedure Delete (Var S : WideString; Index,Size: SizeInt);
+Procedure SetString (Var S : WideString; Buf : PWideChar; Len : SizeInt);
+Procedure SetString (Var S : WideString; Buf : PChar; Len : SizeInt);
+
+function WideCharToString(S : PWideChar) : AnsiString;
+function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
+function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
+procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;var Dest : AnsiString);
+procedure WideCharToStrVar(S : PWideChar;var Dest : AnsiString);
+
+procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+
+Type
+ TWideStringManager = record
+ Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
+ Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
+
+// UpperUTF8 : procedure(p:PUTF8String);
+
+ UpperWideStringProc : function(const S: WideString): WideString;
+// UpperUCS4 : procedure(p:PUCS4Char);
+// LowerUTF8 : procedure(p:PUTF8String);
+ LowerWideStringProc : function(const S: WideString): WideString;
+// LowerUCS4 : procedure(p:PUCS4Char);
+{
+ CompUTF8 : function(p1,p2:PUTF8String) : shortint;
+ CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
+ CompUCS4 : function(p1,p2:PUC42Char) : shortint;
+}
+ CompareWideStringProc : function(const s1, s2 : WideString) : PtrInt;
+ CompareTextWideStringProc : function(const s1, s2 : WideString): PtrInt;
+ CharLengthPCharProc : function(const Str: PChar): PtrInt;
+
+ UpperAnsiStringProc : function(const s : ansistring) : ansistring;
+ LowerAnsiStringProc : function(const s : ansistring) : ansistring;
+ CompareStrAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+ CompareTextAnsiStringProc : function(const S1, S2: ansistring): PtrInt;
+ StrCompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+ StrICompAnsiStringProc : function(S1, S2: PChar): PtrInt;
+ StrLCompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+ StrLICompAnsiStringProc : function(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+ StrLowerAnsiStringProc : function(Str: PChar): PChar;
+ StrUpperAnsiStringProc : function(Str: PChar): PChar;
+ end;
+
+
+function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; SourceChars: SizeUInt): SizeUInt;
+function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+function UTF8Encode(const s : WideString) : UTF8String;
+function UTF8Decode(const s : UTF8String): WideString;
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+
+var
+ widestringmanager : TWideStringManager;
+
+Procedure GetWideStringManager (Var Manager : TWideStringManager);
+Procedure SetWideStringManager (Const New : TWideStringManager);
+Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
+
+{
+ $Log: wstringh.inc,v $
+ Revision 1.7 2005/03/14 21:09:04 florian
+ * widestring manager can handle now ansi<->wide string conversions even if the lens don't match
+
+ Revision 1.6 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.5 2005/02/26 15:00:14 florian
+ + WideSameStr
+
+ Revision 1.4 2005/02/26 10:21:17 florian
+ + implemented WideFormat
+ + some Widestring stuff implemented
+ * some Widestring stuff fixed
+
+ Revision 1.3 2005/02/06 09:38:45 florian
+ + StrCharLength infrastructure
+
+ Revision 1.2 2005/02/03 18:40:50 florian
+ + infrastructure for WideCompareText implemented
+
+ Revision 1.1 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+}
diff --git a/rtl/inc/wstrings.inc b/rtl/inc/wstrings.inc
new file mode 100644
index 0000000000..f2a8de7bb8
--- /dev/null
+++ b/rtl/inc/wstrings.inc
@@ -0,0 +1,1524 @@
+{
+ $Id: wstrings.inc,v 1.58 2005/05/04 10:34:48 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2005 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ This file implements support routines for WideStrings/Unicode with FPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ This file contains the implementation of the WideString type,
+ and all things that are needed for it.
+ WideString is defined as a 'silent' pwidechar :
+ a pwidechar that points to :
+
+ @-8 : SizeInt for reference count;
+ @-4 : SizeInt for size;
+ @ : String + Terminating #0;
+ Pwidechar(Widestring) is a valid typecast.
+ So WS[i] is converted to the address @WS+i-1.
+
+ Constants should be assigned a reference count of -1
+ Meaning that they can't be disposed of.
+}
+
+Type
+ PWideRec = ^TWideRec;
+ TWideRec = Packed Record
+ Ref,
+ Len : SizeInt;
+ First : WideChar;
+ end;
+
+Const
+ WideRecLen = SizeOf(TWideRec);
+ WideFirstOff = SizeOf(TWideRec)-sizeof(WideChar);
+
+{
+ Default WideChar <-> Char conversion is to only convert the
+ lower 127 chars, all others are translated to spaces.
+
+ These routines can be overwritten for the Current Locale
+}
+
+procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+var
+ i : SizeInt;
+begin
+ //writeln('in widetoansimove');
+ setlength(dest,len);
+ for i:=1 to len do
+ begin
+ if word(source^)<256 then
+ dest[i]:=char(word(source^))
+ else
+ dest[i]:='?';
+ //inc(dest);
+ inc(source);
+ end;
+end;
+
+
+procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+var
+ i : SizeInt;
+begin
+ //writeln('in ansitowidemove');
+ setlength(dest,len);
+ for i:=1 to len do
+ begin
+// if byte(source^)<128 then
+ dest[i]:=widechar(byte(source^));
+// else
+// dest^:=' ';
+ //inc(dest);
+ inc(source);
+ end;
+end;
+
+Procedure GetWideStringManager (Var Manager : TWideStringManager);
+begin
+ manager:=widestringmanager;
+end;
+
+
+Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
+begin
+ Old:=widestringmanager;
+ widestringmanager:=New;
+end;
+
+Procedure SetWideStringManager (Const New : TWideStringManager);
+begin
+ widestringmanager:=New;
+end;
+
+(*
+Procedure UniqueWideString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
+{
+ Make sure reference count of S is 1,
+ using copy-on-write semantics.
+}
+
+begin
+end;
+*)
+
+
+{****************************************************************************
+ Internal functions, not in interface.
+****************************************************************************}
+
+{$ifdef WideStrDebug}
+Procedure DumpWideRec(S : Pointer);
+begin
+ If S=Nil then
+ Writeln ('String is nil')
+ Else
+ Begin
+ With PWideRec(S-WideFirstOff)^ do
+ begin
+ Write ('(Maxlen: ',maxlen);
+ Write (' Len:',len);
+ Writeln (' Ref: ',ref,')');
+ end;
+ end;
+end;
+{$endif}
+
+
+Function NewWideString(Len : SizeInt) : Pointer;
+{
+ Allocate a new WideString on the heap.
+ initialize it to zero length and reference count 1.
+}
+Var
+ P : Pointer;
+begin
+ GetMem(P,Len*sizeof(WideChar)+WideRecLen);
+ If P<>Nil then
+ begin
+ PWideRec(P)^.Len:=0; { Initial length }
+ PWideRec(P)^.Ref:=1; { Set reference count }
+ PWideRec(P)^.First:=#0; { Terminating #0 }
+ inc(p,WideFirstOff); { Points to string now }
+ end;
+ NewWideString:=P;
+end;
+
+
+Procedure DisposeWideString(Var S : Pointer);
+{
+ Deallocates a WideString From the heap.
+}
+begin
+ If S=Nil then
+ exit;
+ Dec (S,WideFirstOff);
+ FreeMem (S);
+ S:=Nil;
+end;
+
+
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_WIDESTR_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Decreases the ReferenceCount of a non constant widestring;
+ If the reference count is zero, deallocate the string;
+}
+Type
+ pSizeInt = ^SizeInt;
+Var
+ l : pSizeInt;
+Begin
+ { Zero string }
+ If S=Nil then exit;
+ { check for constant strings ...}
+ l:=@PWIDEREC(S-WideFirstOff)^.Ref;
+ If l^<0 then exit;
+
+ { declocked does a MT safe dec and returns true, if the counter is 0 }
+ If declocked(l^) then
+ { Ref count dropped to zero }
+ DisposeWideString (S); { Remove...}
+{$ifndef decrrefnotnil}
+ s:=nil;
+{$endif}
+end;
+
+{$ifdef hascompilerproc}
+{ alias for internal use }
+Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_WIDESTR_DECR_REF'];
+{$endif compilerproc}
+
+{$ifdef hascompilerproc}
+Procedure fpc_WideStr_Incr_Ref (S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_WIDESTR_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias:'FPC_WIDESTR_INCR_REF'];
+{$endif compilerproc}
+Begin
+ If S=Nil then
+ exit;
+ { Let's be paranoid : Constant string ??}
+ If PWideRec(S-WideFirstOff)^.Ref<0 then exit;
+ inclocked(PWideRec(S-WideFirstOff)^.Ref);
+end;
+
+{$ifdef hascompilerproc}
+{ alias for internal use }
+Procedure fpc_WideStr_Incr_Ref (S : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_WIDESTR_INCR_REF'];
+{$endif compilerproc}
+
+function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a WideString to a ShortString;
+}
+Var
+ Size : SizeInt;
+ temp : ansistring;
+begin
+ if S2='' then
+ fpc_WideStr_To_ShortStr:=''
+ else
+ begin
+ Size:=Length(S2);
+ If Size>high_of_res then
+ Size:=high_of_res;
+ widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
+ fpc_WideStr_To_ShortStr:=temp;
+ end;
+
+end;
+
+
+Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;{$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a ShortString to a WideString;
+}
+Var
+ Size : SizeInt;
+begin
+ Size:=Length(S2);
+ //Setlength (fpc_ShortStr_To_WideStr,Size);
+ if Size>0 then
+ begin
+ widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),fpc_ShortStr_To_WideStr,Size);
+ { Terminating Zero }
+ PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
+ end;
+end;
+
+
+{ old style helper }
+{$ifndef hascompilerproc}
+
+Procedure fpc_ShortStr_To_WideStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_WIDESTR'];
+begin
+ s1 := pointer(fpc_ShortStr_To_WideStr(s2));
+end;
+{$endif hascompilerproc}
+
+Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a WideString to an AnsiString
+}
+Var
+ Size : SizeInt;
+begin
+ if s2='' then
+ exit;
+ Size:=Length(WideString(S2));
+// Setlength (fpc_WideStr_To_AnsiStr,Size);
+ if Size>0 then
+ begin
+ widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),fpc_WideStr_To_AnsiStr,Size);
+ { Terminating Zero }
+// PChar(Pointer(fpc_WideStr_To_AnsiStr)+Size)^:=#0;
+ end;
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_WideStr_To_AnsiStr (Var S1 : Pointer;const S2 : WideString);[Public, alias: 'FPC_WIDESTR_TO_ANSISTR'];
+begin
+ s1 := pointer(fpc_WideStr_To_AnsiStr(s2));
+end;
+{$endif hascompilerproc}
+
+
+Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts an AnsiString to a WideString;
+}
+Var
+ Size : SizeInt;
+begin
+ if s2='' then
+ exit;
+ Size:=Length(S2);
+ // Setlength (result,Size);
+ if Size>0 then
+ begin
+ widestringmanager.Ansi2WideMoveProc(PChar(S2),result,Size);
+ { Terminating Zero }
+ // PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
+ end;
+end;
+
+{ compilers with widestrings should have compiler procs }
+Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
+var
+ Size : SizeInt;
+begin
+ if p=nil then
+ exit;
+ Size := IndexWord(p^, -1, 0);
+ // Setlength (result,Size);
+ if Size>0 then
+ begin
+ widestringmanager.Wide2AnsiMoveProc(P,result,Size);
+ { Terminating Zero }
+ // PChar(Pointer(result)+Size)^:=#0;
+ end;
+end;
+
+
+Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc;
+var
+ Size : SizeInt;
+begin
+ if p=nil then
+ exit;
+ Size := IndexWord(p^, -1, 0);
+ Setlength (result,Size);
+ if Size>0 then
+ begin
+ Move(p^,PWideChar(Pointer(result))^,Size*sizeof(WideChar));
+ { Terminating Zero }
+ PWideChar(Pointer(result)+Size*sizeof(WideChar))^:=#0;
+ end;
+end;
+
+
+Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
+var
+ Size : SizeInt;
+ temp: ansistring;
+begin
+ if p=nil then
+ begin
+ fpc_PWideChar_To_ShortStr:='';
+ exit;
+ end;
+ Size := IndexWord(p^, $7fffffff, 0);
+// Setlength (result,Size+1);
+ if Size>0 then
+ begin
+// If Size>255 then
+// Size:=255;
+ widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
+// byte(result[0]):=byte(Size);
+ end;
+ result := temp
+end;
+
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_AnsiStr_To_WideStr (Var S1 : Pointer; Const S2 : AnsiString);[Public, alias: 'FPC_ANSISTR_TO_WIDESTR'];
+begin
+ s1 := pointer(fpc_AnsiStr_To_WideStr(s2));
+end;
+{$endif hascompilerproc}
+
+
+{ checked against the ansistring routine, 2001-05-27 (FK) }
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Assigns S2 to S1 (S1:=S2), taking in account reference counts.
+}
+begin
+ If S2<>nil then
+ If PWideRec(S2-WideFirstOff)^.Ref>0 then
+ Inc(PWideRec(S2-WideFirstOff)^.ref);
+ { Decrease the reference count on the old S1 }
+ fpc_widestr_decr_ref (S1);
+ { And finally, have S1 pointing to S2 (or its copy) }
+ S1:=S2;
+end;
+
+{$ifdef hascompilerproc}
+{ alias for internal use }
+Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN'];
+{$endif hascompilerproc}
+
+{ checked against the ansistring routine, 2001-05-27 (FK) }
+{$ifdef hascompilerproc}
+function fpc_WideStr_Concat (const S1,S2 : WideString): WideString; compilerproc;
+var
+ S3: WideString absolute result;
+{$else hascompilerproc}
+Procedure fpc_WideStr_Concat (S1,S2 : WideString;var S3 : WideString);[Public, alias: 'FPC_WIDESTR_CONCAT'];
+{$endif hascompilerproc}
+{
+ Concatenates 2 WideStrings : S1+S2.
+ Result Goes to S3;
+}
+Var
+ Size,Location : SizeInt;
+begin
+{ only assign if s1 or s2 is empty }
+ if (S1='') then
+ S3 := S2
+ else
+ if (S2='') then
+ S3 := S1
+ else
+ begin
+ { create new result }
+ Size:=Length(S2);
+ Location:=Length(S1);
+ SetLength (S3,Size+Location);
+ Move (S1[1],S3[1],Location*sizeof(WideChar));
+ Move (S2[1],S3[location+1],(Size+1)*sizeof(WideChar));
+ end;
+end;
+
+
+Function fpc_Char_To_WideStr(const c : WideChar): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Converts a Char to a WideString;
+}
+begin
+ if c = #0 then
+ { result is automatically set to '' }
+ exit;
+ Setlength (fpc_Char_To_WideStr,1);
+ fpc_Char_To_WideStr[1]:=c;
+ { Terminating Zero }
+ PWideChar(Pointer(fpc_Char_To_WideStr)+sizeof(WideChar))^:=#0;
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_Char_To_WideStr(var S1 : Pointer; c : WideChar);[Public, alias: 'FPC_CHAR_TO_WIDESTR'];
+begin
+ s1 := pointer(fpc_Char_To_WideStr(c));
+end;
+{$endif hascompilerproc}
+
+
+Function fpc_PChar_To_WideStr(const p : pchar): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ L : SizeInt;
+begin
+ if (not assigned(p)) or (p[0]=#0) Then
+ { result is automatically set to '' }
+ exit;
+ l:=IndexChar(p^,-1,#0);
+ //SetLength(fpc_PChar_To_WideStr,L);
+ widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+
+Procedure fpc_PChar_To_WideStr(var a : WideString;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ pointer(a) := pointer(fpc_PChar_To_WideStr(p));
+end;
+{$endif hascompilerproc}
+
+Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ i : SizeInt;
+begin
+ if arr[0]=#0 Then
+ { result is automatically set to '' }
+ exit;
+ i:=IndexChar(arr,high(arr)+1,#0);
+ if i = -1 then
+ i := high(arr)+1;
+ SetLength(fpc_CharArray_To_WideStr,i);
+ widestringmanager.Ansi2WideMoveProc (pchar(@arr),fpc_CharArray_To_WideStr,i);
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_CharArray_To_WideStr(var a : WideString; p: pointer; len: SizeInt); [Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ src: pchar;
+ i: SizeInt;
+begin
+ src := pchar(p);
+ if src[0]=#0 Then
+ begin
+ pointer(a) := nil;
+ exit;
+ end;
+ i:=IndexChar(src^,len,#0);
+ if i = -1 then
+ i := len;
+ pointer(a) := NewWideString(i);
+ widestringmanager.Ansi2WideMoveProc (src,a,i);
+end;
+{$endif not hascompilerproc}
+
+{$ifdef hascompilerproc}
+function fpc_WideCharArray_To_ShortStr(const arr: array of widechar): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
+var
+ l: longint;
+{$else hascompilerproc}
+function fpc_WideCharArray_To_ShortStr(arr:pwidechar; l : longint):shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR'];
+var
+{$endif hascompilerproc}
+ index: longint;
+ len: byte;
+ temp: ansistring;
+begin
+{$ifdef hascompilerproc}
+ l := high(arr)+1;
+{$endif hascompilerproc}
+ if l>=256 then
+ l:=255
+ else if l<0 then
+ l:=0;
+ index:=IndexWord(arr[0],l,0);
+ if (index < 0) then
+ len := l
+ else
+ len := index;
+{$ifdef hascompilerproc}
+ widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
+{$else}
+ widestringmanager.Wide2AnsiMoveProc (arr, temp,len);
+{$endif}
+ fpc_WideCharArray_To_ShortStr := temp;
+ //fpc_WideCharArray_To_ShortStr[0]:=chr(len);
+end;
+
+Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar): AnsiString; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ i : SizeInt;
+begin
+ if arr[0]=#0 Then
+ { result is automatically set to '' }
+ exit;
+ i:=IndexWord(arr,high(arr)+1,0);
+ if i = -1 then
+ i := high(arr)+1;
+ SetLength(fpc_WideCharArray_To_AnsiStr,i);
+ widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),fpc_WideCharArray_To_AnsiStr,i);
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_WideCharArray_To_AnsiStr(var a : AnsiString; p: pointer; len: SizeInt); [Public,Alias : 'FPC_WIDECHARARRAY_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ src: pwidechar;
+ i: SizeInt;
+begin
+ src := pwidechar(p);
+ if src[0]=#0 Then
+ begin
+ pointer(a) := nil;
+ exit;
+ end;
+ i:=IndexWord(src^,len,0);
+ if i = -1 then
+ i := len;
+ pointer(a) := NewAnsiString(i);
+ widestringmanager.Wide2AnsiMoveProc (src,a,i);
+end;
+{$endif not hascompilerproc}
+
+Function fpc_WideCharArray_To_WideStr(const arr: array of widechar): WideString; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ i : SizeInt;
+begin
+ if arr[0]=#0 Then
+ { result is automatically set to '' }
+ exit;
+ i:=IndexWord(arr,high(arr)+1,0);
+ if i = -1 then
+ i := high(arr)+1;
+ SetLength(fpc_WideCharArray_To_WideStr,i);
+ Move(pwidechar(@arr)^, PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1]))^,i*sizeof(WideChar));
+ { Terminating Zero }
+ PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1])+i*sizeof(WideChar))^:=#0;
+end;
+
+{ old style helper }
+{$ifndef hascompilerproc}
+Procedure fpc_WideCharArray_To_WideStr(var a : WideString; p: pointer; len: SizeInt); [Public,Alias : 'FPC_WIDECHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ src: pwidechar;
+ i: SizeInt;
+begin
+ src := pwidechar(p);
+ if src[0]=#0 Then
+ begin
+ pointer(a) := nil;
+ exit;
+ end;
+ i:=IndexWord(src^,len,#0);
+ if i = -1 then
+ i := len;
+ pointer(a) := NewWideString(i);
+ Move(p^, PWideChar(Pointer(@a[1]))^,i*sizeof(WideChar));
+ { Terminating Zero }
+ PWideChar(Pointer(@a[1])+i*sizeof(WideChar))^:=#0;
+end;
+{$endif not hascompilerproc}
+
+{$ifdef hascompilerproc}
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM) }
+function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
+var
+ len: SizeInt;
+ temp: ansistring;
+begin
+ len := length(src);
+ { make sure we don't dereference src if it can be nil (JM) }
+ if len > 0 then
+ widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
+ len := length(temp);
+ if len > arraysize then
+ len := arraysize;
+ move(temp[1],fpc_widestr_to_chararray[0],len);
+ fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
+end;
+{$endif hascompilerproc}
+
+{$ifdef hascompilerproc}
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ widechararray we're converting to (JM) }
+function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
+var
+ len: SizeInt;
+begin
+ len := length(src);
+ if len > arraysize then
+ len := arraysize;
+ { make sure we don't try to access element 1 of the ansistring if it's nil }
+ if len > 0 then
+ move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
+ fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+end;
+{$endif hascompilerproc}
+
+{$ifdef hascompilerproc}
+{ inside the compiler, the resulttype is modified to that of the actual }
+{ chararray we're converting to (JM) }
+function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; compilerproc;
+var
+ len: SizeInt;
+ temp: widestring;
+begin
+ len := length(src);
+ { make sure we don't dereference src if it can be nil (JM) }
+ if len > 0 then
+ widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+ len := length(temp);
+ if len > arraysize then
+ len := arraysize;
+
+ move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
+ fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+end;
+{$endif hascompilerproc}
+
+{$ifdef hascompilerproc}
+function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; compilerproc;
+var
+ len: longint;
+ temp : widestring;
+begin
+ len := length(src);
+ { make sure we don't access char 1 if length is 0 (JM) }
+ if len > 0 then
+ widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
+ len := length(temp);
+ if len > arraysize then
+ len := arraysize;
+ move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
+ fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
+end;
+
+{$endif hascompilerproc}
+Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Compares 2 WideStrings;
+ The result is
+ <0 if S1<S2
+ 0 if S1=S2
+ >0 if S1>S2
+}
+Var
+ MaxI,Temp : SizeInt;
+begin
+ if pointer(S1)=pointer(S2) then
+ begin
+ fpc_WideStr_Compare:=0;
+ exit;
+ end;
+ Maxi:=Length(S1);
+ temp:=Length(S2);
+ If MaxI>Temp then
+ MaxI:=Temp;
+ Temp:=CompareWord(S1[1],S2[1],MaxI);
+ if temp=0 then
+ temp:=Length(S1)-Length(S2);
+ fpc_WideStr_Compare:=Temp;
+end;
+
+
+Procedure fpc_WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if p=nil then
+ HandleErrorFrame(201,get_frame);
+end;
+
+
+Procedure fpc_WideStr_CheckRange(len,index : SizeInt);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
+begin
+ if (index>len) or (Index<1) then
+ HandleErrorFrame(201,get_frame);
+end;
+
+{$ifndef INTERNSETLENGTH}
+Procedure SetLength (Var S : WideString; l : SizeInt);
+{$else INTERNSETLENGTH}
+Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif INTERNSETLENGTH}
+{
+ Sets The length of string S to L.
+ Makes sure S is unique, and contains enough room.
+}
+Var
+ Temp : Pointer;
+ movelen: SizeInt;
+begin
+ if (l>0) then
+ begin
+ if Pointer(S)=nil then
+ begin
+ { Need a complete new string...}
+ Pointer(s):=NewWideString(l);
+ end
+ else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
+ begin
+ Dec(Pointer(S),WideFirstOff);
+ if L*sizeof(WideChar)+WideRecLen>MemSize(Pointer(S)) then
+ reallocmem(pointer(S), L*sizeof(WideChar)+WideRecLen);
+ Inc(Pointer(S), WideFirstOff);
+ end
+ else
+ begin
+ { Reallocation is needed... }
+ Temp:=Pointer(NewWideString(L));
+ if Length(S)>0 then
+ begin
+ if l < succ(length(s)) then
+ movelen := l
+ { also move terminating null }
+ else movelen := succ(length(s));
+ Move(Pointer(S)^,Temp^,movelen * Sizeof(WideChar));
+ end;
+ fpc_widestr_decr_ref(Pointer(S));
+ Pointer(S):=Temp;
+ end;
+ { Force nil termination in case it gets shorter }
+ PWord(Pointer(S)+l*sizeof(WideChar))^:=0;
+ PWideRec(Pointer(S)-FirstOff)^.Len:=l;
+ end
+ else
+ begin
+ { Length=0 }
+ if Pointer(S)<>nil then
+ fpc_widestr_decr_ref (Pointer(S));
+ Pointer(S):=Nil;
+ end;
+end;
+
+
+
+
+{*****************************************************************************
+ Public functions, In interface.
+*****************************************************************************}
+
+function WideCharToString(S : PWideChar) : AnsiString;
+ begin
+ result:=WideCharLenToString(s,Length(WideString(s)));
+ end;
+
+function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
+ var
+ temp:widestring;
+ begin
+ widestringmanager.Ansi2WideMoveProc(PChar(Src),temp,Length(Src));
+ if Length(temp)<DestSize then
+ move(temp[1],Dest^,Length(temp))
+ else
+ move(temp[1],Dest^,destsize);
+
+ result:=Dest;
+
+ end;
+
+function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
+ begin
+ //SetLength(result,Len);
+ widestringmanager.Wide2AnsiMoveproc(S,result,Len);
+ end;
+
+procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;var Dest : AnsiString);
+ begin
+ Dest:=WideCharLenToString(Src,Len);
+ end;
+
+procedure WideCharToStrVar(S : PWideChar;var Dest : AnsiString);
+ begin
+ Dest:=WideCharToString(S);
+ end;
+
+
+{$ifndef INTERNLENGTH}
+Function Length (Const S : WideString) : SizeInt;
+{
+ Returns the length of an WideString.
+ Takes in acount that zero strings are NIL;
+}
+begin
+ If Pointer(S)=Nil then
+ Length:=0
+ else
+ Length:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
+end;
+{$endif INTERNLENGTH}
+
+
+Function fpc_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
+{
+ Make sure reference count of S is 1,
+ using copy-on-write semantics.
+}
+Var
+ SNew : Pointer;
+ L : SizeInt;
+begin
+ pointer(result) := pointer(s);
+ If Pointer(S)=Nil then
+ exit;
+ if PWideRec(Pointer(S)-WideFirstOff)^.Ref<>1 then
+ begin
+ L:=PWideRec(Pointer(S)-WideFirstOff)^.len;
+ SNew:=NewWideString (L);
+ Move (PWideChar(S)^,SNew^,(L+1)*sizeof(WideChar));
+ PWideRec(SNew-WideFirstOff)^.len:=L;
+ fpc_widestr_decr_ref (Pointer(S)); { Thread safe }
+ pointer(S):=SNew;
+ pointer(result):=SNew;
+ end;
+end;
+
+
+{$ifdef interncopy}
+Function Fpc_WideStr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc;
+{$else}
+Function Copy (Const S : WideString; Index,Size : SizeInt) : WideString;
+{$endif}
+var
+ ResultAddress : Pointer;
+begin
+ ResultAddress:=Nil;
+ dec(index);
+ if Index < 0 then
+ Index := 0;
+ { Check Size. Accounts for Zero-length S, the double check is needed because
+ Size can be maxint and will get <0 when adding index }
+ if (Size>Length(S)) or
+ (Index+Size>Length(S)) then
+ Size:=Length(S)-Index;
+ If Size>0 then
+ begin
+ If Index<0 Then
+ Index:=0;
+ ResultAddress:=Pointer(NewWideString (Size));
+ if ResultAddress<>Nil then
+ begin
+ Move (PWideChar(S)[Index],ResultAddress^,Size*sizeof(WideChar));
+ PWideRec(ResultAddress-WideFirstOff)^.Len:=Size;
+ PWideChar(ResultAddress+Size*sizeof(WideChar))^:=#0;
+ end;
+ end;
+{$ifdef interncopy}
+ Pointer(fpc_widestr_Copy):=ResultAddress;
+{$else}
+ Pointer(Copy):=ResultAddress;
+{$endif}
+end;
+
+
+Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+var
+ i,MaxLen : SizeInt;
+ pc : pwidechar;
+begin
+ Pos:=0;
+ if Length(SubStr)>0 then
+ begin
+ MaxLen:=Length(source)-Length(SubStr);
+ i:=0;
+ pc:=@source[1];
+ while (i<=MaxLen) do
+ begin
+ inc(i);
+ if (SubStr[1]=pc^) and
+ (CompareWord(Substr[1],pc^,Length(SubStr))=0) then
+ begin
+ Pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ end;
+end;
+
+
+{ Faster version for a widechar alone }
+Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+var
+ i: SizeInt;
+ pc : pwidechar;
+begin
+ pc:=@s[1];
+ for i:=1 to length(s) do
+ begin
+ if pc^=c then
+ begin
+ pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ pos:=0;
+end;
+
+
+Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
+var
+ i: SizeInt;
+ pc : pchar;
+begin
+ pc:=@s[1];
+ for i:=1 to length(s) do
+ begin
+ if widechar(pc^)=c then
+ begin
+ pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ pos:=0;
+end;
+
+
+
+{ Faster version for a char alone. Must be implemented because }
+{ pos(c: char; const s: shortstring) also exists, so otherwise }
+{ using pos(char,pchar) will always call the shortstring version }
+{ (exact match for first argument), also with $h+ (JM) }
+Function Pos (c : Char; Const s : WideString) : SizeInt;
+var
+ i: SizeInt;
+ wc : widechar;
+ pc : pwidechar;
+begin
+ wc:=c;
+ pc:=@s[1];
+ for i:=1 to length(s) do
+ begin
+ if pc^=wc then
+ begin
+ pos:=i;
+ exit;
+ end;
+ inc(pc);
+ end;
+ pos:=0;
+end;
+
+
+
+Procedure Delete (Var S : WideString; Index,Size: SizeInt);
+Var
+ LS : SizeInt;
+begin
+ If Length(S)=0 then
+ exit;
+ if index<=0 then
+ exit;
+ LS:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
+ if (Index<=LS) and (Size>0) then
+ begin
+ UniqueString (S);
+ if Size+Index>LS then
+ Size:=LS-Index+1;
+ if Index+Size<=LS then
+ begin
+ Dec(Index);
+ Move(PWideChar(S)[Index+Size],PWideChar(S)[Index],(LS-Index+1)*sizeof(WideChar));
+ end;
+ Setlength(s,LS-Size);
+ end;
+end;
+
+
+Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
+var
+ Temp : WideString;
+ LS : SizeInt;
+begin
+ If Length(Source)=0 then
+ exit;
+ if index <= 0 then
+ index := 1;
+ Ls:=Length(S);
+ if index > LS then
+ index := LS+1;
+ Dec(Index);
+ Pointer(Temp) := NewWideString(Length(Source)+LS);
+ SetLength(Temp,Length(Source)+LS);
+ If Index>0 then
+ move (PWideChar(S)^,PWideChar(Temp)^,Index*sizeof(WideChar));
+ Move (PWideChar(Source)^,PWideChar(Temp)[Index],Length(Source)*sizeof(WideChar));
+ If (LS-Index)>0 then
+ Move(PWideChar(S)[Index],PWideChar(temp)[Length(Source)+index],(LS-Index)*sizeof(WideChar));
+ S:=Temp;
+end;
+
+
+function UpCase(const s : WideString) : WideString;
+begin
+ result:=widestringmanager.UpperWideStringProc(s);
+end;
+
+
+Procedure SetString (Var S : WideString; Buf : PWideChar; Len : SizeInt);
+var
+ BufLen: SizeInt;
+begin
+ SetLength(S,Len);
+ If (Buf<>Nil) and (Len>0) then
+ begin
+ BufLen := IndexWord(Buf^, Len+1, 0);
+ If (BufLen>0) and (BufLen < Len) then
+ Len := BufLen;
+ Move (Buf[0],S[1],Len*sizeof(WideChar));
+ PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
+ end;
+end;
+
+
+Procedure SetString (Var S : WideString; Buf : PChar; Len : SizeInt);
+var
+ BufLen: SizeInt;
+begin
+ SetLength(S,Len);
+ If (Buf<>Nil) and (Len>0) then
+ begin
+ BufLen := IndexByte(Buf^, Len+1, 0);
+ If (BufLen>0) and (BufLen < Len) then
+ Len := BufLen;
+ widestringmanager.Ansi2WideMoveProc(Buf,S,Len);
+ //PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
+ end;
+end;
+
+
+Function fpc_Val_Real_WideStr(Const S : WideString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : String;
+begin
+ fpc_Val_Real_WideStr := 0;
+ if length(S) > 255 then
+ code := 256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_Real_WideStr,code);
+ end;
+end;
+
+
+Function fpc_Val_UInt_WideStr (Const S : WideString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_UInt_WideStr := 0;
+ if length(S) > 255 then
+ code := 256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_UInt_WideStr,code);
+ end;
+end;
+
+
+Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_SInt_WideStr:=0;
+ if length(S)>255 then
+ code:=256
+ else
+ begin
+ SS := S;
+ fpc_Val_SInt_WideStr := int_Val_SInt_ShortStr(DestSize,SS,Code);
+ end;
+end;
+
+
+{$ifndef CPU64}
+
+Function fpc_Val_qword_WideStr (Const S : WideString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_qword_WideStr:=0;
+ if length(S)>255 then
+ code:=256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_qword_WideStr,Code);
+ end;
+end;
+
+
+Function fpc_Val_int64_WideStr (Const S : WideString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ fpc_Val_int64_WideStr:=0;
+ if length(S)>255 then
+ code:=256
+ else
+ begin
+ SS := S;
+ Val(SS,fpc_Val_int64_WideStr,Code);
+ end;
+end;
+
+{$endif CPU64}
+
+
+procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+var
+ ss : shortstring;
+begin
+ str_real(len,fr,d,treal_type(rt),ss);
+ s:=ss;
+end;
+
+
+{$ifdef STR_USES_VALINT}
+Procedure fpc_WideStr_SInt(v : ValSint; Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_WideStr_Longint(v : Longint; Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+Var
+ SS : ShortString;
+begin
+ Str (v:Len,SS);
+ S:=SS;
+end;
+
+
+{$ifdef STR_USES_VALINT}
+Procedure fpc_WideStr_UInt(v : ValUInt;Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$else}
+Procedure fpc_WideStr_Longword(v : Longword;Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+{$endif}
+Var
+ SS : ShortString;
+begin
+ str(v:Len,SS);
+ S:=SS;
+end;
+
+
+{$ifndef CPU64}
+
+Procedure fpc_WideStr_Int64(v : Int64; Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ Str (v:Len,SS);
+ S:=SS;
+end;
+
+
+Procedure fpc_WideStr_Qword(v : Qword;Len : SizeInt; Var S : WideString);{$ifdef hascompilerproc} compilerproc; {$endif}
+Var
+ SS : ShortString;
+begin
+ str(v:Len,SS);
+ S:=SS;
+end;
+
+{$endif CPU64}
+
+function UnicodeToUtf8(Dest: PChar; Source: PWideChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ if assigned(Source) then
+ Result:=UnicodeToUtf8(Dest,MaxBytes,Source,IndexWord(Source^,-1,0))
+ else
+ Result:=0;
+ end;
+
+
+function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PWideChar; SourceChars: SizeUInt): SizeUInt;
+ var
+ i,j : SizeUInt;
+ w : word;
+ begin
+ result:=0;
+ if source=nil then
+ exit;
+ i:=0;
+ j:=0;
+ if assigned(Dest) then
+ begin
+ while (i<SourceChars) and (j<MaxDestBytes) do
+ begin
+ w:=word(Source[i]);
+ case w of
+ 0..$7f:
+ begin
+ Dest[j]:=char(w);
+ inc(j);
+ end;
+ $80..$7ff:
+ begin
+ if j+1>=MaxDestBytes then
+ break;
+ Dest[j]:=char($c0 or (w shr 6));
+ Dest[j+1]:=char($80 or (w and $3f));
+ inc(j,2);
+ end;
+ else
+ begin
+ if j+2>=MaxDestBytes then
+ break;
+ Dest[j]:=char($e0 or (w shr 12));
+ Dest[j+1]:=char($80 or ((w shr 6)and $3f));
+ Dest[j+2]:=char($80 or (w and $3f));
+ inc(j,3);
+ end;
+ end;
+ inc(i);
+ end;
+
+ if j>MaxDestBytes-1 then
+ j:=MaxDestBytes-1;
+
+ Dest[j]:=#0;
+ end
+ else
+ begin
+ while i<SourceChars do
+ begin
+ case word(Source[i]) of
+ $0..$7f:
+ inc(j);
+ $80..$7ff:
+ inc(j,2);
+ else
+ inc(j,3);
+ end;
+ end;
+ end;
+ result:=j+1;
+ end;
+
+
+function Utf8ToUnicode(Dest: PWideChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ if assigned(Source) then
+ Result:=Utf8ToUnicode(Dest,MaxChars,Source,strlen(Source))
+ else
+ Result:=0;
+ end;
+
+
+function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
+
+var
+ i,j : SizeUInt;
+ w: SizeUInt;
+ b : byte;
+begin
+ if not assigned(Source) then
+ begin
+ result:=0;
+ exit;
+ end;
+ result:=SizeUInt(-1);
+ i:=0;
+ j:=0;
+ if assigned(Dest) then
+ begin
+ while (j<MaxDestChars) and (i<SourceBytes) do
+ begin
+ b:=byte(Source[i]);
+ w:=b;
+ inc(i);
+ // 2 or 3 bytes?
+ if b>=$80 then
+ begin
+ w:=b and $3f;
+ if i>=SourceBytes then
+ exit;
+ // 3 bytes?
+ if (b and $20)<>0 then
+ begin
+ b:=byte(Source[i]);
+ inc(i);
+ if i>=SourceBytes then
+ exit;
+ if (b and $c0)<>$80 then
+ exit;
+ w:=(w shl 6) or (b and $3f);
+ end;
+ b:=byte(Source[i]);
+ w:=(w shl 6) or (b and $3f);
+ if (b and $c0)<>$80 then
+ exit;
+ inc(i);
+ end;
+ Dest[j]:=WideChar(w);
+ inc(j);
+ end;
+ if j>=MaxDestChars then j:=MaxDestChars-1;
+ Dest[j]:=#0;
+ end
+ else
+ begin
+ while i<SourceBytes do
+ begin
+ b:=byte(Source[i]);
+ inc(i);
+ // 2 or 3 bytes?
+ if b>=$80 then
+ begin
+ if i>=SourceBytes then
+ exit;
+ // 3 bytes?
+ b := b and $3f;
+ if (b and $20)<>0 then
+ begin
+ b:=byte(Source[i]);
+ inc(i);
+ if i>=SourceBytes then
+ exit;
+ if (b and $c0)<>$80 then
+ exit;
+ end;
+ if (byte(Source[i]) and $c0)<>$80 then
+ exit;
+ inc(i);
+ end;
+ inc(j);
+ end;
+ end;
+ result:=j+1;
+end;
+
+
+function UTF8Encode(const s : WideString) : UTF8String;
+ var
+ i : SizeInt;
+ hs : UTF8String;
+ begin
+ result:='';
+ if s='' then
+ exit;
+ SetLength(hs,length(s)*3);
+ i:=UnicodeToUtf8(pchar(hs),length(hs)+1,PWideChar(s),length(s));
+ if i>0 then
+ begin
+ SetLength(hs,i-1);
+ result:=hs;
+ end;
+ end;
+
+
+function UTF8Decode(const s : UTF8String): WideString;
+ var
+ i : SizeInt;
+ hs : WideString;
+ begin
+ result:='';
+ if s='' then
+ exit;
+ SetLength(hs,length(s));
+ i:=Utf8ToUnicode(PWideChar(hs),length(hs)+1,pchar(s),length(s));
+ if i>0 then
+ begin
+ SetLength(hs,i-1);
+ result:=hs;
+ end;
+ end;
+
+
+function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ Result:=Utf8Encode(s);
+ end;
+
+
+function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
+ begin
+ Result:=Utf8Decode(s);
+ end;
+
+
+procedure unimplementedwidestring;
+ begin
+ HandleErrorFrame(215,get_frame);
+ end;
+
+
+function GenericWideCase(const s : WideString) : WideString;
+ begin
+ unimplementedwidestring;
+ end;
+
+
+function CompareWideString(const s1, s2 : WideString) : PtrInt;
+ begin
+ unimplementedwidestring;
+ end;
+
+
+function CompareTextWideString(const s1, s2 : WideString): PtrInt;
+ begin
+ unimplementedwidestring;
+ end;
+
+
+function CharLengthPChar(const Str: PChar): PtrInt;
+ begin
+ unimplementedwidestring;
+ end;
+
+procedure initwidestringmanager;
+ begin
+ fillchar(widestringmanager,sizeof(widestringmanager),0);
+ widestringmanager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
+ widestringmanager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
+ widestringmanager.UpperWideStringProc:=@GenericWideCase;
+ widestringmanager.LowerWideStringProc:=@GenericWideCase;
+ widestringmanager.CompareWideStringProc:=@CompareWideString;
+ widestringmanager.CompareTextWideStringProc:=@CompareTextWideString;
+ widestringmanager.CharLengthPCharProc:=@CharLengthPChar;
+ end;
+
+
+{
+ $Log: wstrings.inc,v $
+ Revision 1.58 2005/05/04 10:34:48 michael
+ + Fix for Utf8ToUnicode from Lazarus bug tracker 888
+
+ Revision 1.57 2005/04/03 08:46:02 florian
+ * widestr->shortstr fixed
+ * wstrings to system unit dependencies added
+
+ Revision 1.56 2005/03/22 10:10:54 florian
+ * shortstr_to_widestring fixed
+
+ Revision 1.55 2005/03/14 21:32:04 florian
+ * utf8 to unicode (utf-16) fix from Matthias
+
+ Revision 1.54 2005/03/14 21:09:04 florian
+ * widestring manager can handle now ansi<->wide string conversions even if the lens don't match
+
+ Revision 1.53 2005/02/26 15:00:14 florian
+ + WideSameStr
+
+ Revision 1.52 2005/02/26 10:21:17 florian
+ + implemented WideFormat
+ + some Widestring stuff implemented
+ * some Widestring stuff fixed
+
+ Revision 1.51 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.50 2005/02/06 09:38:45 florian
+ + StrCharLength infrastructure
+
+ Revision 1.49 2005/02/03 18:40:50 florian
+ + infrastructure for WideCompareText implemented
+
+ Revision 1.48 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+ Revision 1.47 2005/01/06 13:31:06 florian
+ * widecharray patch from Peter
+
+}
diff --git a/rtl/linux/Makefile b/rtl/linux/Makefile
new file mode 100644
index 0000000000..d41566e579
--- /dev/null
+++ b/rtl/linux/Makefile
@@ -0,0 +1,2264 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=linux
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+ifeq ($(CPU_TARGET),i386)
+CRT21=cprt21 gprt21
+CPU_UNITS=x86 ports cpu mmx graph
+else
+CPU_UNITS=
+endif
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT1=
+ifeq ($(CPU_TARGET),i386)
+CPU_UNITS+=oldlinux
+endif
+LINUXUNIT2=linux
+else
+SYSTEMUNIT=syslinux
+LINUXUNIT1=linux
+LINUXUNIT2=
+override FPCOPT+=-dUNIX
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo variants sysconst rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override CLEAN_UNITS+=syslinux linux
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override CLEAN_UNITS+=syslinux linux
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_TARGETDIR+=.
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_TARGETDIR+=.
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
+gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+cprt21$(OEXT) : $(CPU_TARGET)/cprt21.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as
+gprt21$(OEXT) : $(CPU_TARGET)/gprt21.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+unix$(PPUEXT) : unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
+ unxfunc.inc
+unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ $(UNIXINC)/bunxh.inc \
+ bunxsysc.inc $(CPU_TARGET)/syscallh.inc $(CPU_TARGET)/sysnr.inc \
+ ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT)
+dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
+ $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp
+ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS)
+ $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) sysutils$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT)
+gpm$(PPUEXT): gpm.pp unix$(PPUEXT) baseunix$(PPUEXT) sockets$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc
new file mode 100644
index 0000000000..ae61d25f33
--- /dev/null
+++ b/rtl/linux/Makefile.fpc
@@ -0,0 +1,296 @@
+#
+# Makefile.fpc for Free Pascal Linux RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0 dllprt0 cprt0 gprt0 $(CRT21)
+units=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil \
+ heaptrc lineinfo \
+ $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) \
+ crt printer ggigraph \
+ sysutils typinfo math matrix varutils \
+ charset ucomplex getopts \
+ errors sockets gpm ipc serial terminfo dl dynlibs \
+ video mouse keyboard variants types dateutils sysconst \
+ cthreads classes strutils rtlconsts dos objects cwstring
+
+rsts=math varutils typinfo variants sysconst rtlconsts
+
+[require]
+nortl=y
+
+[clean]
+units=syslinux linux
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=linux
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
+targetdir=.
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+ unix ports \
+ dos crt objects printer \
+ sysutils typinfo math \
+ cpu mmx getopts heaptrc \
+ errors sockets ipc dl dynlibs varutils
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+
+ifeq ($(CPU_TARGET),i386)
+CRT21=cprt21 gprt21
+CPU_UNITS=x86 ports cpu mmx graph
+else
+CPU_UNITS=
+endif
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT1=
+ifeq ($(CPU_TARGET),i386)
+CPU_UNITS+=oldlinux
+endif
+LINUXUNIT2=linux
+else
+SYSTEMUNIT=syslinux
+LINUXUNIT1=linux
+LINUXUNIT2=
+override FPCOPT+=-dUNIX
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+[rules]
+# Get the $(SYSTEMUNIT) independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put $(SYSTEMUNIT) unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+
+dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
+
+gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+cprt21$(OEXT) : $(CPU_TARGET)/cprt21.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as
+
+gprt21$(OEXT) : $(CPU_TARGET)/gprt21.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as
+
+
+#
+# $(SYSTEMUNIT) Units ($(SYSTEMUNIT), Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# $(SYSTEMUNIT) Dependent Units
+#
+
+unix$(PPUEXT) : unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
+ unxfunc.inc
+
+unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+
+baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ $(UNIXINC)/bunxh.inc \
+ bunxsysc.inc $(CPU_TARGET)/syscallh.inc $(CPU_TARGET)/sysnr.inc \
+ ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT)
+
+dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+
+graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
+ $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp
+
+ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS)
+ $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) sysutils$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other $(SYSTEMUNIT)-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other $(SYSTEMUNIT)-dependent RTL Units
+#
+
+sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT)
+
+gpm$(PPUEXT): gpm.pp unix$(PPUEXT) baseunix$(PPUEXT) sockets$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
diff --git a/rtl/linux/arm/bsyscall.inc b/rtl/linux/arm/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/linux/arm/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/linux/arm/cprt0.as b/rtl/linux/arm/cprt0.as
new file mode 100644
index 0000000000..b057087e30
--- /dev/null
+++ b/rtl/linux/arm/cprt0.as
@@ -0,0 +1,140 @@
+/* Startup code for ARM & ELF
+ Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA. */
+
+/* This is the canonical entry point, usually the first thing in the text
+ segment.
+
+ Note that the code in the .init section has already been run.
+ This includes _init and _libc_init
+
+
+ At this entry point, most registers' values are unspecified, except:
+
+ a1 Contains a function pointer to be registered with `atexit'.
+ This is how the dynamic linker arranges to have DT_FINI
+ functions called for shared libraries that have been loaded
+ before this code runs.
+
+ sp The stack contains the arguments and environment:
+ 0(sp) argc
+ 4(sp) argv[0]
+ ...
+ (4*argc)(sp) NULL
+ (4*(argc+1))(sp) envp[0]
+ ...
+ NULL
+*/
+
+ .text
+ .globl _start
+ .type _start,#function
+_start:
+ /* Clear the frame pointer since this is the outermost frame. */
+ mov fp, #0
+ ldmia sp!, {a2}
+
+ /* Pop argc off the stack and save a pointer to argv */
+ ldr ip,=operatingsystem_parameter_argc
+ ldr a3,=operatingsystem_parameter_argv
+ str a2,[ip]
+
+ /* calc envp */
+ add a4,a2,#1
+ add a4,sp,a4,LSL #2
+ ldr ip,=operatingsystem_parameter_envp
+
+ str sp,[a3]
+ str a4,[ip]
+
+ /* Fetch address of fini */
+ ldr ip, =_fini
+
+ /* argc already loaded to a2*/
+
+ /* load argv
+ mov a3, sp
+
+ /* Push stack limit */
+ str a3, [sp, #-4]!
+
+ /* Push rtld_fini */
+ str a1, [sp, #-4]!
+
+ /* Set up the other arguments in registers */
+ ldr a1, =PASCALMAIN
+ ldr a4, =_init
+
+ /* Push fini */
+ str ip, [sp, #-4]!
+
+ /* __libc_start_main (main, argc, argv, init, fini, rtld_fini, stack_end) */
+
+ /* Let the libc call main and exit with its return code. */
+ bl __libc_start_main
+
+ /* should never get here....*/
+ bl abort
+
+ .globl _haltproc
+ .type _haltproc,#function
+_haltproc:
+ ldr r0,=operatingsystem_result
+ ldrb r0,[r0]
+ swi 0x900001
+ b _haltproc
+
+ /* Define a symbol for the first piece of initialized data. */
+ .data
+ .globl __data_start
+__data_start:
+ .long 0
+ .weak data_start
+ data_start = __data_start
+
+.bss
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+ .section ".comment"
+ .byte 0
+ .ascii "generated by FPC http://www.freepascal.org\0"
+
+/* We need this stuff to make gdb behave itself, otherwise
+ gdb will chokes with SIGILL when trying to debug apps.
+*/
+ .section ".note.ABI-tag", "a"
+ .align 4
+ .long 1f - 0f
+ .long 3f - 2f
+ .long 1
+0: .asciz "GNU"
+1: .align 4
+2: .long 0
+ .long 2,0,0
+3: .align 4
+
+/*
+ $Log: cprt0.as,v $
+ Revision 1.3 2004/11/05 13:15:07 florian
+ * fixed label names
+
+ Revision 1.2 2004/11/05 13:01:34 florian
+ * initial implementation
+*/ \ No newline at end of file
diff --git a/rtl/linux/arm/dllprt0.as b/rtl/linux/arm/dllprt0.as
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/rtl/linux/arm/dllprt0.as
diff --git a/rtl/linux/arm/gprt0.as b/rtl/linux/arm/gprt0.as
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/rtl/linux/arm/gprt0.as
diff --git a/rtl/linux/arm/prt0.as b/rtl/linux/arm/prt0.as
new file mode 100644
index 0000000000..901b58aa29
--- /dev/null
+++ b/rtl/linux/arm/prt0.as
@@ -0,0 +1,125 @@
+/* Startup code for ARM & ELF
+ Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA. */
+
+/* This is the canonical entry point, usually the first thing in the text
+ segment.
+
+ Note that the code in the .init section has already been run.
+ This includes _init and _libc_init
+
+
+ At this entry point, most registers' values are unspecified, except:
+
+ a1 Contains a function pointer to be registered with `atexit'.
+ This is how the dynamic linker arranges to have DT_FINI
+ functions called for shared libraries that have been loaded
+ before this code runs.
+
+ sp The stack contains the arguments and environment:
+ 0(sp) argc
+ 4(sp) argv[0]
+ ...
+ (4*argc)(sp) NULL
+ (4*(argc+1))(sp) envp[0]
+ ...
+ NULL
+*/
+
+ .text
+ .globl _start
+ .type _start,#function
+_start:
+ /* Clear the frame pointer since this is the outermost frame. */
+ mov fp, #0
+ ldmia sp!, {a2}
+
+ /* Pop argc off the stack and save a pointer to argv */
+ ldr ip,=operatingsystem_parameter_argc
+ ldr a3,=operatingsystem_parameter_argv
+ str a2,[ip]
+
+ /* calc envp */
+ add a2,a2,#1
+ add a2,sp,a2,LSL #2
+ ldr ip,=operatingsystem_parameter_envp
+
+ str sp,[a3]
+ str a2,[ip]
+
+ /* Let the libc call main and exit with its return code. */
+ bl PASCALMAIN
+
+ .globl _haltproc
+ .type _haltproc,#function
+_haltproc:
+ ldr r0,=operatingsystem_result
+ ldrb r0,[r0]
+ swi 0x900001
+ b _haltproc
+
+ /* Define a symbol for the first piece of initialized data. */
+ .data
+ .globl __data_start
+__data_start:
+ .long 0
+ .weak data_start
+ data_start = __data_start
+
+.bss
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+ .section ".comment"
+ .byte 0
+ .ascii "generated by FPC http://www.freepascal.org\0"
+
+/* We need this stuff to make gdb behave itself, otherwise
+ gdb will chokes with SIGILL when trying to debug apps.
+*/
+ .section ".note.ABI-tag", "a"
+ .align 4
+ .long 1f - 0f
+ .long 3f - 2f
+ .long 1
+0: .asciz "GNU"
+1: .align 4
+2: .long 0
+ .long 2,0,0
+3: .align 4
+
+/*
+ $Log: prt0.as,v $
+ Revision 1.5 2004/11/05 12:48:15 florian
+ * beautified
+
+ Revision 1.4 2004/07/03 21:50:31 daniel
+ * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+ longer necessary
+
+ Revision 1.3 2004/03/11 22:39:53 florian
+ * arm startup code fixed
+ * made some generic math code more readable
+
+ Revision 1.2 2004/01/20 18:32:46 florian
+ * fixed sigill problem when running in gdb
+
+ Revision 1.1 2003/08/27 13:07:07 florian
+ * initial revision of arm startup code
+*/ \ No newline at end of file
diff --git a/rtl/linux/arm/sighnd.inc b/rtl/linux/arm/sighnd.inc
new file mode 100644
index 0000000000..797f854ffb
--- /dev/null
+++ b/rtl/linux/arm/sighnd.inc
@@ -0,0 +1,58 @@
+{
+ $Id: sighnd.inc,v 1.5 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(Sig: longint; _a2,_a3,_a4 : dword; SigContext: PSigInfo; uContext : PuContext); cdecl;
+
+var
+ res,fpustate : word;
+begin
+ res:=0;
+ case sig of
+ SIGFPE :
+ begin
+ { don't know how to find the different causes, maybe via xer? }
+ res := 207;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ reenable_signal(sig);
+ { give runtime error at the position where the signal was raised }
+ if res<>0 then
+ HandleErrorAddrFrame(res,pointer(uContext^.uc_mcontext.arm_ip),pointer(uContext^.uc_mcontext.arm_fp));
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.5 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.3 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/arm/sighndh.inc b/rtl/linux/arm/sighndh.inc
new file mode 100644
index 0000000000..caa66c9b0c
--- /dev/null
+++ b/rtl/linux/arm/sighndh.inc
@@ -0,0 +1,75 @@
+{
+ $Id: sighndh.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ TSigContext
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+ PSigContext = ^TSigContext;
+ TSigContext = record
+ trap_no : dword;
+ error_code : dword;
+ oldmask : dword;
+ arm_r0 : dword;
+ arm_r1 : dword;
+ arm_r2 : dword;
+ arm_r3 : dword;
+ arm_r4 : dword;
+ arm_r5 : dword;
+ arm_r6 : dword;
+ arm_r7 : dword;
+ arm_r8 : dword;
+ arm_r9 : dword;
+ arm_r10 : dword;
+ arm_fp : dword;
+ arm_ip : dword;
+ arm_sp : dword;
+ arm_lr : dword;
+ arm_pc : dword;
+ arm_cpsr : dword;
+ fault_address : dword;
+ end;
+
+ { from include/asm-ppc/signal.h }
+ stack_t = record
+ ss_sp: pointer;
+ ss_flags: longint;
+ ss_size: size_t;
+ end;
+
+ { from include/asm-arm/ucontext.h }
+ pucontext = ^tucontext;
+ tucontext = record
+ uc_flags : dword;
+ uc_link : pucontext;
+ uc_stack : stack_t;
+ uc_mcontext : TSigContext;
+ uc_sigmask : sigset_t;
+ end;
+
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/arm/stat.inc b/rtl/linux/arm/stat.inc
new file mode 100644
index 0000000000..2a4cf0d217
--- /dev/null
+++ b/rtl/linux/arm/stat.inc
@@ -0,0 +1,65 @@
+ {
+ $Id: stat.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ Stat = packed Record // No unix typing because of differences
+ case byte of
+ 0: (st_dev,
+ __pad1 : word;
+ st_ino : cardinal;
+ st_mode,
+ nlink,
+ uid,
+ gid,
+ rdev,
+ __pad2 : word;
+ st_size,
+ st_blksize,
+ st_blocks,
+ st_atime,
+ __unused1,
+ st_mtime,
+ __unused2,
+ st_ctime,
+ __unused3,
+ __unused4,
+ __unused5 : cardinal;);
+ 1: (dev,
+ __pad3 : word;
+ ino : cardinal;
+ mode,
+ nlink_dummy,
+ uid_dummy,
+ gid_dummy,
+ rdev_dummy,
+ __pad4 : word;
+ size,
+ blksize,
+ blocks,
+ atime,
+ __unused1_dummy,
+ mtime,
+ __unused2_dummy,
+ ctime,
+ __unused3_dummy,
+ __unused4_dummy,
+ __unused5_dummy : cardinal;);
+ end;
+
+{
+ $Log: stat.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/arm/syscall.inc b/rtl/linux/arm/syscall.inc
new file mode 100644
index 0000000000..b1d71aedb9
--- /dev/null
+++ b/rtl/linux/arm/syscall.inc
@@ -0,0 +1,257 @@
+{
+ $Id: syscall.inc,v 1.7 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+ {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{*****************************************************************************
+ --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4'];
+
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4'];
+
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4'];
+
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4'];
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ ldr r4,param4
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4'];
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ ldr r5,param5
+ ldr r4,param4
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4','r5'];
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ ldr r6,param6
+ ldr r5,param5
+ ldr r4,param4
+ swi #0x900071
+ cmn r0,#126
+ bls .LDone
+ rsb r4,r0,#0
+ ldr r2,.Lthread_var
+ ldr r2,[r2]
+ ldr r0,.LErrno
+ cmp r2,#0
+ bne .LThread
+ str r4,[r0,#4]
+ mvn r0,#0
+ b .LDone
+.LThread:
+ mov pc,r2
+ str r4,[r0]
+ mvn r0,#0
+ b .LDone
+.LErrno:
+ .word Errno
+.Lthread_var:
+ .word fpc_threadvar_relocate_proc
+.LDone:
+end ['r4','r5','r6'];
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.7 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.6 2005/01/04 14:13:58 florian
+ * fixed error handling of system calls
+
+}
diff --git a/rtl/linux/arm/syscallh.inc b/rtl/linux/arm/syscallh.inc
new file mode 100644
index 0000000000..be95ec9d3b
--- /dev/null
+++ b/rtl/linux/arm/syscallh.inc
@@ -0,0 +1,49 @@
+{
+ $Id: syscallh.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for arm *nix.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+ TSysResult = longint; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+ TSysParam = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult; external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL6';
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/arm/sysnr.inc b/rtl/linux/arm/sysnr.inc
new file mode 100644
index 0000000000..5c638ca2f0
--- /dev/null
+++ b/rtl/linux/arm/sysnr.inc
@@ -0,0 +1,279 @@
+{
+ $Id: sysnr.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003-2004 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ Syscall nrs for arm-linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+ Last update from 2.4.22 kernel sources according to the sources it contains already the 2.5 extensions
+}
+
+Const
+ syscall_nr_exit = $900000+ 1;
+ syscall_nr_fork = $900000+ 2;
+ syscall_nr_read = $900000+ 3;
+ syscall_nr_write = $900000+ 4;
+ syscall_nr_open = $900000+ 5;
+ syscall_nr_close = $900000+ 6;
+ // not supported: syscall_nr_waitpid = $900000+ 7;
+ syscall_nr_creat = $900000+ 8;
+ syscall_nr_link = $900000+ 9;
+ syscall_nr_unlink = $900000+10;
+ syscall_nr_execve = $900000+11;
+ syscall_nr_chdir = $900000+12;
+ syscall_nr_time = $900000+13;
+ syscall_nr_mknod = $900000+14;
+ syscall_nr_chmod = $900000+15;
+ syscall_nr_lchown = $900000+16;
+ syscall_nr_break = $900000+17;
+
+ syscall_nr_lseek = $900000+19;
+ syscall_nr_getpid = $900000+20;
+ syscall_nr_mount = $900000+21;
+ syscall_nr_umount = $900000+22;
+ syscall_nr_setuid = $900000+23;
+ syscall_nr_getuid = $900000+24;
+ syscall_nr_stime = $900000+25;
+ syscall_nr_ptrace = $900000+26;
+ syscall_nr_alarm = $900000+27;
+
+ syscall_nr_pause = $900000+29;
+ syscall_nr_utime = $900000+30;
+ syscall_nr_stty = $900000+31;
+ syscall_nr_gtty = $900000+32;
+ syscall_nr_access = $900000+33;
+ syscall_nr_nice = $900000+34;
+ syscall_nr_ftime = $900000+35;
+ syscall_nr_sync = $900000+36;
+ syscall_nr_kill = $900000+37;
+ syscall_nr_rename = $900000+38;
+ syscall_nr_mkdir = $900000+39;
+ syscall_nr_rmdir = $900000+40;
+ syscall_nr_dup = $900000+41;
+ syscall_nr_pipe = $900000+42;
+ syscall_nr_times = $900000+43;
+ syscall_nr_prof = $900000+44;
+ syscall_nr_brk = $900000+45;
+ syscall_nr_setgid = $900000+46;
+ syscall_nr_getgid = $900000+47;
+ syscall_nr_signal = $900000+48;
+ syscall_nr_geteuid = $900000+49;
+ syscall_nr_getegid = $900000+50;
+ syscall_nr_acct = $900000+51;
+ syscall_nr_umount2 = $900000+52;
+ syscall_nr_lock = $900000+53;
+ syscall_nr_ioctl = $900000+54;
+ syscall_nr_fcntl = $900000+55;
+ syscall_nr_mpx = $900000+56;
+ syscall_nr_setpgid = $900000+57;
+ syscall_nr_ulimit = $900000+58;
+
+ syscall_nr_umask = $900000+60;
+ syscall_nr_chroot = $900000+61;
+ syscall_nr_ustat = $900000+62;
+ syscall_nr_dup2 = $900000+63;
+ syscall_nr_getppid = $900000+64;
+ syscall_nr_getpgrp = $900000+65;
+ syscall_nr_setsid = $900000+66;
+ syscall_nr_sigaction = $900000+67;
+ syscall_nr_sgetmask = $900000+68;
+ syscall_nr_ssetmask = $900000+69;
+ syscall_nr_setreuid = $900000+70;
+ syscall_nr_setregid = $900000+71;
+ syscall_nr_sigsuspend = $900000+72;
+ syscall_nr_sigpending = $900000+73;
+ syscall_nr_sethostname = $900000+74;
+ syscall_nr_setrlimit = $900000+75;
+ syscall_nr_getrlimit = $900000+76;
+ syscall_nr_getrusage = $900000+77;
+ syscall_nr_gettimeofday = $900000+78;
+ syscall_nr_settimeofday = $900000+79;
+ syscall_nr_getgroups = $900000+80;
+ syscall_nr_setgroups = $900000+81;
+ syscall_nr_select = $900000+82;
+ syscall_nr_symlink = $900000+83;
+
+ syscall_nr_readlink = $900000+85;
+ syscall_nr_uselib = $900000+86;
+ syscall_nr_swapon = $900000+87;
+ syscall_nr_reboot = $900000+88;
+ syscall_nr_readdir = $900000+89;
+ syscall_nr_mmap = $900000+90;
+ syscall_nr_munmap = $900000+91;
+ syscall_nr_truncate = $900000+92;
+ syscall_nr_ftruncate = $900000+93;
+ syscall_nr_fchmod = $900000+94;
+ syscall_nr_fchown = $900000+95;
+ syscall_nr_getpriority = $900000+96;
+ syscall_nr_setpriority = $900000+97;
+ syscall_nr_profil = $900000+98;
+ syscall_nr_statfs = $900000+99;
+ syscall_nr_fstatfs = $900000+100;
+ syscall_nr_ioperm = $900000+101;
+ syscall_nr_socketcall = $900000+102;
+ syscall_nr_syslog = $900000+103;
+ syscall_nr_setitimer = $900000+104;
+ syscall_nr_getitimer = $900000+105;
+ syscall_nr_stat = $900000+106;
+ syscall_nr_lstat = $900000+107;
+ syscall_nr_fstat = $900000+108;
+ syscall_nr_vhangup = $900000+111;
+ syscall_nr_idle = $900000+112;
+ syscall_nr_syscall = $900000+113;
+ syscall_nr_wait4 = $900000+114;
+ syscall_nr_swapoff = $900000+115;
+ syscall_nr_sysinfo = $900000+116;
+ syscall_nr_ipc = $900000+117;
+ syscall_nr_fsync = $900000+118;
+ syscall_nr_sigreturn = $900000+119;
+ syscall_nr_clone = $900000+120;
+ syscall_nr_setdomainname = $900000+121;
+ syscall_nr_uname = $900000+122;
+ syscall_nr_modify_ldt = $900000+123;
+ syscall_nr_adjtimex = $900000+124;
+ syscall_nr_mprotect = $900000+125;
+ syscall_nr_sigprocmask = $900000+126;
+ syscall_nr_create_module = $900000+127;
+ syscall_nr_init_module = $900000+128;
+ syscall_nr_delete_module = $900000+129;
+ syscall_nr_get_kernel_syms = $900000+130;
+ syscall_nr_quotactl = $900000+131;
+ syscall_nr_getpgid = $900000+132;
+ syscall_nr_fchdir = $900000+133;
+ syscall_nr_bdflush = $900000+134;
+ syscall_nr_sysfs = $900000+135;
+ syscall_nr_personality = $900000+136;
+ syscall_nr_afs_syscall = $900000+137;
+ syscall_nr_setfsuid = $900000+138;
+ syscall_nr_setfsgid = $900000+139;
+ syscall_nr__llseek = $900000+140;
+ syscall_nr_getdents = $900000+141;
+ syscall_nr__newselect = $900000+142;
+ syscall_nr_flock = $900000+143;
+ syscall_nr_msync = $900000+144;
+ syscall_nr_readv = $900000+145;
+ syscall_nr_writev = $900000+146;
+ syscall_nr_getsid = $900000+147;
+ syscall_nr_fdatasync = $900000+148;
+ syscall_nr__sysctl = $900000+149;
+ syscall_nr_mlock = $900000+150;
+ syscall_nr_munlock = $900000+151;
+ syscall_nr_mlockall = $900000+152;
+ syscall_nr_munlockall = $900000+153;
+ syscall_nr_sched_setparam = $900000+154;
+ syscall_nr_sched_getparam = $900000+155;
+ syscall_nr_sched_setscheduler = $900000+156;
+ syscall_nr_sched_getscheduler = $900000+157;
+ syscall_nr_sched_yield = $900000+158;
+ syscall_nr_sched_get_priority_max = $900000+159;
+ syscall_nr_sched_get_priority_min = $900000+160;
+ syscall_nr_sched_rr_get_interval = $900000+161;
+ syscall_nr_nanosleep = $900000+162;
+ syscall_nr_mremap = $900000+163;
+ syscall_nr_setresuid = $900000+164;
+ syscall_nr_getresuid = $900000+165;
+ syscall_nr_vm86 = $900000+166;
+ syscall_nr_query_module = $900000+167;
+ syscall_nr_poll = $900000+168;
+ syscall_nr_nfsservctl = $900000+169;
+ syscall_nr_setresgid = $900000+170;
+ syscall_nr_getresgid = $900000+171;
+ syscall_nr_prctl = $900000+172;
+ syscall_nr_rt_sigreturn = $900000+173;
+ syscall_nr_rt_sigaction = $900000+174;
+ syscall_nr_rt_sigprocmask = $900000+175;
+ syscall_nr_rt_sigpending = $900000+176;
+ syscall_nr_rt_sigtimedwait = $900000+177;
+ syscall_nr_rt_sigqueueinfo = $900000+178;
+ syscall_nr_rt_sigsuspend = $900000+179;
+ syscall_nr_pread = $900000+180;
+ syscall_nr_pwrite = $900000+181;
+ syscall_nr_chown = $900000+182;
+ syscall_nr_getcwd = $900000+183;
+ syscall_nr_capget = $900000+184;
+ syscall_nr_capset = $900000+185;
+ syscall_nr_sigaltstack = $900000+186;
+ syscall_nr_sendfile = $900000+187;
+ syscall_nr_vfork = $900000+190;
+ syscall_nr_ugetrlimit = $900000+191;
+ syscall_nr_mmap2 = $900000+192;
+ syscall_nr_truncate64 = $900000+193;
+ syscall_nr_ftruncate64 = $900000+194;
+ syscall_nr_stat64 = $900000+195;
+ syscall_nr_lstat64 = $900000+196;
+ syscall_nr_fstat64 = $900000+197;
+ syscall_nr_lchown32 = $900000+198;
+ syscall_nr_getuid32 = $900000+199;
+ syscall_nr_getgid32 = $900000+200;
+ syscall_nr_geteuid32 = $900000+201;
+ syscall_nr_getegid32 = $900000+202;
+ syscall_nr_setreuid32 = $900000+203;
+ syscall_nr_setregid32 = $900000+204;
+ syscall_nr_getgroups32 = $900000+205;
+ syscall_nr_setgroups32 = $900000+206;
+ syscall_nr_fchown32 = $900000+207;
+ syscall_nr_setresuid32 = $900000+208;
+ syscall_nr_getresuid32 = $900000+209;
+ syscall_nr_setresgid32 = $900000+210;
+ syscall_nr_getresgid32 = $900000+211;
+ syscall_nr_chown32 = $900000+212;
+ syscall_nr_setuid32 = $900000+213;
+ syscall_nr_setgid32 = $900000+214;
+ syscall_nr_setfsuid32 = $900000+215;
+ syscall_nr_setfsgid32 = $900000+216;
+ syscall_nr_getdents64 = $900000+217;
+ syscall_nr_pivot_root = $900000+218;
+ syscall_nr_mincore = $900000+219;
+ syscall_nr_madvise = $900000+220;
+ syscall_nr_fcntl64 = $900000+221;
+ syscall_nr_security = $900000+223;
+ syscall_nr_gettid = $900000+224;
+ syscall_nr_readahead = $900000+225;
+ syscall_nr_setxattr = $900000+226;
+ syscall_nr_lsetxattr = $900000+227;
+ syscall_nr_fsetxattr = $900000+228;
+ syscall_nr_getxattr = $900000+229;
+ syscall_nr_lgetxattr = $900000+230;
+ syscall_nr_fgetxattr = $900000+231;
+ syscall_nr_listxattr = $900000+232;
+ syscall_nr_llistxattr = $900000+233;
+ syscall_nr_flistxattr = $900000+234;
+ syscall_nr_removexattr = $900000+235;
+ syscall_nr_lremovexattr = $900000+236;
+ syscall_nr_fremovexattr = $900000+237;
+ syscall_nr_tkill = $900000+238;
+ syscall_nr_sendfile64 = $900000+239;
+ syscall_nr_futex = $900000+240;
+ syscall_nr_sched_setaffinity = $900000+241;
+ syscall_nr_sched_getaffinity = $900000+242;
+ syscall_nr_io_setup = $900000+243;
+ syscall_nr_io_destroy = $900000+244;
+ syscall_nr_io_getevents = $900000+245;
+ syscall_nr_io_submit = $900000+246;
+ syscall_nr_io_cancel = $900000+247;
+ syscall_nr_exit_group = $900000+248;
+ syscall_nr_lookup_dcookie = $900000+249;
+ syscall_nr_epoll_create = $900000+250;
+ syscall_nr_epoll_ctl = $900000+251;
+ syscall_nr_epoll_wait = $900000+252;
+ syscall_nr_remap_file_pages = $900000+253;
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/bunxsysc.inc b/rtl/linux/bunxsysc.inc
new file mode 100644
index 0000000000..bd2430a54d
--- /dev/null
+++ b/rtl/linux/bunxsysc.inc
@@ -0,0 +1,554 @@
+{
+ $Id: bunxsysc.inc,v 1.4 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ Calls needed for the baseunix unit, but not for system.
+ Some calls that can be used for both Linux and *BSD will be
+ moved to a /unix/ includedfile later.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function fpKill(Pid:pid_t;Sig:cint):cint;
+{
+ Send signal 'sig' to a process, or a group of processes.
+ If Pid > 0 then the signal is sent to pid
+ pid=-1 to all processes except process 1
+ pid < -1 to process group -pid
+ Return value is zero, except for case three, where the return value
+ is the number of processes to which the signal was sent.
+}
+
+begin
+ fpkill:=do_syscall(syscall_nr_kill,TSysParam(pid),TSysParam(sig));
+// if kill<0 THEN
+// Kill:=0;
+end;
+
+Function fpSigPending(var nset: TSigSet):cint;
+{
+ Allows examination of pending signals. The signal mask of pending
+ signals is set in SSet
+}
+begin
+ fpsigpending:=do_syscall(syscall_nr_rt_sigpending,TSysParam(@nset));
+end;
+
+function fpsigsuspend(const sigmask:TSigSet):cint;
+{
+ Set the signal mask with Mask, and suspend the program until a signal
+ is received.
+}
+
+begin
+ fpsigsuspend:= do_syscall(syscall_nr_rt_sigsuspend,TSysParam(@sigmask));
+end;
+
+Type
+ ITimerVal= Record
+ It_Interval,
+ It_Value : TimeVal;
+ end;
+
+Const ITimer_Real =0;
+ ITimer_Virtual =1;
+ ITimer_Prof =2;
+
+Function SetITimer(Which : Longint;Const value : ItimerVal; var VarOValue:ItimerVal):Longint;
+
+Begin
+ SetItimer:=Do_Syscall(syscall_nr_setitimer,Which,TSysParam(@Value),TSysParam(@varovalue));
+End;
+
+Function GetITimer(Which : Longint;Var value : ItimerVal):Longint;
+
+Begin
+ GetItimer:=Do_Syscall(syscall_nr_getItimer,Which,TSysParam(@value));
+End;
+
+Function fpalarm(Seconds: cuint):cuint;
+
+Var it,oitv : Itimerval;
+ retval : cuint;
+
+Begin
+// register struct itimerval *itp = &it;
+
+ it.it_interval.tv_sec:=0;
+ it.it_interval.tv_usec:=0;
+ it.it_value.tv_usec:=0;
+ it.it_value.tv_sec:=seconds;
+ If SetITimer(ITIMER_REAL,it,oitv)<0 Then
+ Exit(0); // different from *BSD!
+
+ retval:= oitv.it_value.tv_usec;
+ if retval<>0 Then
+ inc(retval);
+ fpAlarm:=retval;
+End;
+
+// The following versions are for internal use _ONLY_
+// This because it works for the first 32 signals _ONLY_, but that
+// is enough since they are depreciated, and for legacy applications
+// anyway.
+
+function sigblock(mask:cuint):cint;
+
+var nset,oset: TSigSet;
+
+begin
+ fpsigemptyset(nset);
+ // fpsigaddset(nset,mask); needs _mask_
+ nset[0]:=mask;
+ sigblock:= fpsigprocmask(SIG_BLOCK,@nset,@oset); // SIG_BLOCK=1
+ if sigblock=0 Then
+ sigblock:=oset[0];
+end;
+
+function sigpause(sigmask:cint):cint;
+
+var nset: TSigSet;
+
+begin
+ fpsigemptyset(nset);
+ nset[0]:=sigmask;
+ sigpause:= fpsigsuspend(nset);
+end;
+
+function fppause:cint;
+
+begin
+ fppause:=sigpause(sigblock(cuint(0)));
+end;
+
+function fpsleep(seconds:cuint):cuint;
+{see comments in libc}
+
+var time_to_sleep,time_remaining : timespec;
+ nset,oset : TSigSet;
+ oerrno : cint;
+ oact : sigactionrec;
+
+begin
+ time_to_sleep.tv_sec := seconds;
+ time_to_sleep.tv_nsec := 0;
+ fpsigemptyset(nset);
+ fpsigaddset (nset,SIGCHLD);
+ if fpsigprocmask(SIG_BLOCK,@nset,@oset)=-1 Then
+ exit(cuint(-1));
+ if fpsigismember(oset,SIGCHLD)<>0 Then
+ Begin
+ fpsigemptyset(nset);
+ fpsigaddset (nset,SIGCHLD);
+ if fpsigaction(SIGCHLD,NIL,@oact)<0 Then
+ begin
+ oerrno:=fpgeterrno;
+ fpsigprocmask(SIG_SETMASK,@oset,NIL);
+ fpseterrno(oerrno);
+ exit(cuint(-1));
+ End;
+ if oact.sa_handler=SigActionhandler(SIG_IGN) Then
+ Begin
+ fpsleep:=fpnanosleep(@time_to_sleep, @time_remaining);
+ oerrno:=fpgeterrno;
+ fpsigprocmask(SIG_SETMASK,@oset,NIL);
+ fpseterrno(oerrno);
+ End
+ Else
+ Begin
+ fpsigprocmask(SIG_SETMASK,@oset,NIL);
+ fpsleep:=fpnanosleep(@time_to_sleep, @time_remaining)
+ End;
+ end
+ else
+ fpsleep:=fpnanosleep(@time_to_sleep, @time_remaining);
+ if fpsleep<>0 Then
+ if time_remaining.tv_nsec>=500000000 Then
+ inc(fpsleep);
+End;
+
+function fpuname(var name:utsname):cint; [public,alias:'FPC_SYSC_UNAME'];
+
+begin
+ fpuname:=Do_Syscall(syscall_nr_uname,TSysParam(@name));
+end;
+
+Function fpGetDomainName(Name:PChar; NameLen:size_t):cint;
+
+Var
+ srec : utsname;
+ tsize : size_t;
+Begin
+ if fpuname(srec)<0 Then
+ exit(-1);
+ tsize:=strlen(@srec.domain[0]);
+ if tsize>(namelen-1) Then
+ tsize:=namelen-1;
+ move(srec.domain[0],name[0],tsize);
+ name[namelen-1]:=#0;
+ fpgetDomainName:=0;
+End;
+
+function fpGetHostName(Name:PChar; NameLen:size_t):cint;
+
+Var
+ srec : utsname;
+ tsize : size_t;
+begin
+ if fpuname(srec)<0 Then
+ exit(-1);
+ tsize:=strlen(@srec.nodename[0]);
+ if tsize>(namelen-1) Then
+ tsize:=namelen-1;
+ move(srec.nodename[0],name[0],tsize);
+ name[namelen-1]:=#0;
+ fpgethostName:=0;
+End;
+
+const WAIT_ANY = -1;
+
+function fpwait(var stat_loc:cint): pid_t;
+{
+ Waits until a child with PID Pid exits, or returns if it is exited already.
+ Any resources used by the child are freed.
+ The exit status is reported in the adress referred to by Status. It should
+ be a longint.
+}
+
+begin // actually a wait4() call with 4th arg 0.
+ fpWait:=do_syscall(syscall_nr_Wait4,WAIT_ANY,TSysParam(@Stat_loc),0,0);
+end;
+
+//function fpgetpid : pid_t;
+
+// begin
+// fpgetpid:=do_syscall(syscall_nr_getpid);
+// end;
+
+function fpgetppid : pid_t;
+
+begin
+ fpgetppid:=do_syscall(syscall_nr_getppid);
+end;
+
+function fpgetuid : uid_t;
+
+begin
+ fpgetuid:=do_syscall(syscall_nr_getuid);
+end;
+
+function fpgeteuid : uid_t;
+
+begin
+ fpgeteuid:=do_syscall(syscall_nr_geteuid);
+end;
+
+function fpgetgid : gid_t;
+
+begin
+ fpgetgid:=do_syscall(syscall_nr_getgid);
+end;
+
+function fpgetegid : gid_t;
+
+begin
+ fpgetegid:=do_syscall(syscall_nr_getegid);
+end;
+
+function fpsetuid(uid : uid_t): cint;
+
+begin
+ fpsetuid:=do_syscall(syscall_nr_setuid,uid);
+end;
+
+function fpsetgid(gid : gid_t): cint;
+
+begin
+ fpsetgid:=do_syscall(syscall_nr_setgid,gid);
+end;
+
+// type tgrparr=array[0..0] of gid_t;
+
+function fpgetgroups(gidsetsize : cint; var grouplist:tgrparr): cint;
+
+begin
+ fpgetgroups:=do_syscall(syscall_nr_getgroups,gidsetsize,TSysParam(@grouplist));
+end;
+
+function fpgetpgrp : pid_t;
+
+begin
+ fpgetpgrp:=do_syscall(syscall_nr_getpgrp);
+end;
+
+function fpsetsid : pid_t;
+
+begin
+ fpsetsid:=do_syscall(syscall_nr_setsid);
+end;
+
+Function fpumask(cmask:mode_t):mode_t;
+{
+ Sets file creation mask to (Mask and 0777 (octal) ), and returns the
+ previous value.
+}
+begin
+ fpumask:=Do_syscall(syscall_nr_umask,cmask);
+end;
+
+Function fplink(existing:pchar;newone:pchar):cint;
+{
+ Proceduces a hard link from new to old.
+ In effect, new will be the same file as old.
+}
+begin
+ fpLink:=Do_Syscall(syscall_nr_link,TSysParam(existing),TSysParam(newone));
+end;
+
+Function fpmkfifo(path:pchar;mode:mode_t):cint;
+
+begin
+
+fpmkfifo:=do_syscall(syscall_nr_mknod,TSysParam(path),TSysParam(mode or S_IFIFO),TSysParam(0));
+end;
+
+Function fpchmod(path:pchar;mode:mode_t):cint;
+
+begin
+ fpchmod:=do_syscall(syscall_nr_chmod,TSysParam(path),TSysParam(mode));
+end;
+
+Function fpchown(path:pchar;owner:uid_t;group:gid_t):cint;
+
+begin
+ fpChOwn:=do_syscall(syscall_nr_chown,TSysParam(path),TSysParam(owner),TSysParam(group));
+end;
+
+Function fpUtime(path:pchar;times:putimbuf):cint;
+
+begin
+ fputime:=do_syscall(syscall_nr_utime,TSysParam(path),TSysParam(times));
+end;
+
+
+{$ifndef FPC_BASEUNIX_HAS_FPPIPE}
+Function fppipe(var fildes : tfildes):cint;
+
+begin
+ fppipe:=do_syscall(syscall_nr_pipe,TSysParam(@fildes));
+end;
+{$endif FPC_BASEUNIX_HAS_FPPIPE}
+
+
+function fpfcntl(fildes:cint;Cmd:cint;Arg:cint):cint;
+
+begin
+ fpfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,arg);
+end;
+
+function fpfcntl(fildes:cint;Cmd:cint;var Arg:flock):cint;
+
+begin
+ fpfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,TSysParam(@arg));
+end;
+
+function fpfcntl(fildes:cint;Cmd:cint):cint;
+
+begin
+ fpfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd);
+end;
+
+function fpexecve(path:pchar;argv:ppchar;envp:ppchar):cint;
+
+Begin
+ fpexecve:=do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(argv),TSysParam(envp));
+End;
+
+function fpexecv(path:pchar;argv:ppchar):cint;
+
+Begin
+ fpexecv:=do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(argv),TSysParam(envp));
+End;
+
+function fptimes(var buffer : tms):clock_t;
+begin
+ fptimes:=Do_syscall(syscall_nr_times,TSysParam(@buffer));
+end;
+
+function pfpgetcwd(path : pchar; siz:tsize):pchar; [public, alias : 'FPC_SYSC_GETCWD'];
+
+begin
+ pfpgetcwd:=pchar(Do_Syscall(Syscall_nr_getcwd,TSysParam(Path),TSysParam(siz)));
+end;
+
+Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint;
+{
+ Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+ have changed.
+}
+
+{$ifdef cpui386}
+Var
+ SelectArray : Array[1..5] of TSysParam;
+{$endif}
+
+begin
+{$ifdef cpui386}
+ {$define bunxfunc_fpselect_implemented}
+ SelectArray[1]:=n;
+ SelectArray[2]:=TSysParam(Readfds);
+ Selectarray[3]:=TSysParam(Writefds);
+ selectarray[4]:=TSysParam(exceptfds);
+ Selectarray[5]:=TSysParam(TimeOut);
+ fpSelect:=do_syscall(syscall_nr_select,TSysParam(@selectarray));
+{$endif cpui386}
+{$ifdef cpux86_64}
+ {$define bunxfunc_fpselect_implemented}
+ fpSelect:=do_syscall(syscall_nr_select,n,tsysparam(readfds),tsysparam(writefds),tsysparam(exceptfds),tsysparam(timeout));
+{$endif cpux86_64}
+{$ifdef cpuarm}
+ {$define bunxfunc_fpselect_implemented}
+ fpSelect:=do_syscall(syscall_nr__newselect,n,tsysparam(readfds),tsysparam(writefds),tsysparam(exceptfds),tsysparam(timeout));
+{$endif cpuarm}
+{$ifdef cpupowerpc}
+ {$define bunxfunc_fpselect_implemented}
+ fpSelect:=do_syscall(syscall_nr__newselect,n,tsysparam(readfds),tsysparam(writefds),tsysparam(exceptfds),tsysparam(timeout));
+{$endif cpupowerpc}
+{$ifdef cpusparc}
+ {$define bunxfunc_fpselect_implemented}
+ fpSelect:=do_syscall(syscall_nr__newselect,n,tsysparam(readfds),tsysparam(writefds),tsysparam(exceptfds),tsysparam(timeout));
+{$endif cpusparc}
+{$ifndef bunxfunc_fpselect_implemented}
+ {$error Implement fpselect}
+{$endif bunxfunc_fpselect_implemented}
+end;
+
+Function fpLstat(path:pchar;Info:pstat):cint;
+{
+ Get all information on a link (the link itself), and return it in info.
+}
+
+begin
+ fpLStat:=do_syscall(syscall_nr_lstat,TSysParam(path),TSysParam(info));
+end;
+
+Function fpLstat(Filename: ansistring;Info:pstat):cint;
+{
+ Get all information on a link (the link itself), and return it in info.
+}
+
+begin
+ fpLStat:=do_syscall(syscall_nr_lstat,TSysParam(pchar(filename)),TSysParam(info));
+end;
+
+
+function fpNice(N:cint):cint;
+{
+ Set process priority. A positive N means a lower priority.
+ A negative N increases priority.
+
+Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
+}
+
+{$ifdef cpux86_64}
+var
+ oldprio : cint;
+{$endif}
+begin
+{$ifdef cpux86_64}
+ oldprio:=fpGetPriority(Prio_Process,0);
+ fpNice:=fpSetPriority(Prio_Process,0,oldprio+N);
+ if fpNice=0 then
+ fpNice:=fpGetPriority(Prio_Process,0);
+{$else}
+ fpNice:=do_syscall(Syscall_nr_nice,N);
+{$endif}
+end;
+
+Function fpGetPriority(Which,Who:cint):cint;
+{
+ Get Priority of process, process group, or user.
+ Which : selects what kind of priority is used.
+ can be one of the following predefined Constants :
+ Prio_User.
+ Prio_PGrp.
+ Prio_Process.
+ Who : depending on which, this is , respectively :
+ Uid
+ Pid
+ Process Group id
+ Errors are reported in linuxerror _only_. (priority can be negative)
+}
+begin
+ if (which<prio_process) or (which>prio_user) then
+ begin
+ { We can save an interrupt here }
+ fpgetpriority:=-1;
+ fpsetErrno(ESysEinval);
+ end
+ else
+ fpGetPriority:=do_syscall(syscall_nr_GetPriority,which,who);
+end;
+
+Function fpSetPriority(Which,Who,What:cint):cint;
+{
+ Set Priority of process, process group, or user.
+ Which : selects what kind of priority is used.
+ can be one of the following predefined Constants :
+ Prio_User.
+ Prio_PGrp.
+ Prio_Process.
+ Who : depending on value of which, this is, respectively :
+ Uid
+ Pid
+ Process Group id
+ what : A number between -20 and 20. -20 is most favorable, 20 least.
+ 0 is the default.
+}
+begin
+ if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
+ fpseterrno(ESyseinval) { We can save an interrupt here }
+ else
+ begin
+ fpSetPriority:=do_syscall(Syscall_nr_Setpriority,which,who,what);
+ end;
+end;
+
+
+Function fpSymlink(oldname,newname:pchar):cint;
+{
+ We need this for erase
+}
+
+begin
+ fpsymlink:=do_syscall(syscall_nr_symlink,TSysParam(oldname),TSysParam(newname));
+end;
+
+
+{
+ $Log: bunxsysc.inc,v $
+ Revision 1.4 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+
+ Revision 1.3 2005/03/03 20:13:44 florian
+ + sparc specific pipe implementation
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+ Revision 1.15 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/linux/errno.inc b/rtl/linux/errno.inc
new file mode 100644
index 0000000000..faba160d74
--- /dev/null
+++ b/rtl/linux/errno.inc
@@ -0,0 +1,297 @@
+{
+ $Id: errno.inc,v 1.10 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+
+ Errno.inc :
+ - define all error numbers, kernel version 1.2.13
+ - updated for sparc from kernel version 2.6.8.1
+
+}
+const
+{$ifdef CPUSPARC}
+{$define FPC_HAS_ESYS}
+ { sparc uses Solaris compatible errnos }
+ { comments are stripped here, they can be found in the
+ generic section }
+ ESysEPERM = 1;
+ ESysENOENT = 2;
+ ESysESRCH = 3;
+ ESysEINTR = 4;
+ ESysEIO = 5;
+ ESysENXIO = 6;
+ ESysE2BIG = 7;
+ ESysENOEXEC = 8;
+ ESysEBADF = 9;
+ ESysECHILD = 10;
+ ESysEAGAIN = 11;
+ ESysENOMEM = 12;
+ ESysEACCES = 13;
+ ESysEFAULT = 14;
+ ESysENOTBLK = 15;
+ ESysEBUSY = 16;
+ ESysEEXIST = 17;
+ ESysEXDEV = 18;
+ ESysENODEV = 19;
+ ESysENOTDIR = 20;
+ ESysEISDIR = 21;
+ ESysEINVAL = 22;
+ ESysENFILE = 23;
+ ESysEMFILE = 24;
+ ESysENOTTY = 25;
+ ESysETXTBSY = 26;
+ ESysEFBIG = 27;
+ ESysENOSPC = 28;
+ ESysESPIPE = 29;
+ ESysEROFS = 30;
+ ESysEMLINK = 31;
+ ESysEPIPE = 32;
+ ESysEDOM = 33;
+ ESysERANGE = 34;
+ ESysEWOULDBLOCK = ESysEAGAIN;
+ ESysEINPROGRESS = 36;
+ ESysEALREADY = 37;
+ ESysENOTSOCK = 38;
+ ESysEDESTADDRREQ = 39;
+ ESysEMSGSIZE = 40;
+ ESysEPROTOTYPE = 41;
+ ESysENOPROTOOPT = 42;
+ ESysEPROTONOSUPPORT = 43;
+ ESysESOCKTNOSUPPORT = 44;
+ ESysEOPNOTSUPP = 45;
+ ESysEPFNOSUPPORT = 46;
+ ESysEAFNOSUPPORT = 47;
+ ESysEADDRINUSE = 48;
+ ESysEADDRNOTAVAIL = 49;
+ ESysENETDOWN = 50;
+ ESysENETUNREACH = 51;
+ ESysENETRESET = 52;
+ ESysECONNABORTED = 53;
+ ESysECONNRESET = 54;
+ ESysENOBUFS = 55;
+ ESysEISCONN = 56;
+ ESysENOTCONN = 57;
+ ESysESHUTDOWN = 58;
+ ESysETOOMANYREFS = 59;
+ ESysETIMEDOUT = 60;
+ ESysECONNREFUSED = 61;
+ ESysELOOP = 62;
+ ESysENAMETOOLONG = 63;
+ ESysEHOSTDOWN = 64;
+ ESysEHOSTUNREACH = 65;
+ ESysENOTEMPTY = 66;
+ ESysEPROCLIM = 67;
+ ESysEUSERS = 68;
+ ESysEDQUOT = 69;
+ ESysESTALE = 70;
+ ESysEREMOTE = 71;
+ ESysENOSTR = 72;
+ ESysETIME = 73;
+ ESysENOSR = 74;
+ ESysENOMSG = 75;
+ ESysEBADMSG = 76;
+ ESysEIDRM = 77;
+ ESysEDEADLK = 78;
+ ESysENOLCK = 79;
+ ESysENONET = 80;
+ ESysERREMOTE = 81;
+ ESysENOLINK = 82;
+ ESysEADV = 83;
+ ESysESRMNT = 84;
+ ESysECOMM = 85;
+ ESysEPROTO = 86;
+ ESysEMULTIHOP = 87;
+ ESysEDOTDOT = 88;
+ ESysEREMCHG = 89;
+ ESysENOSYS = 90;
+ ESysESTRPIPE = 91;
+ ESysEOVERFLOW = 92;
+ ESysEBADFD = 93;
+ ESysECHRNG = 94;
+ ESysEL2NSYNC = 95;
+ ESysEL3HLT = 96;
+ ESysEL3RST = 97;
+ ESysELNRNG = 98;
+ ESysEUNATCH = 99;
+ ESysENOCSI = 100;
+ ESysEL2HLT = 101;
+ ESysEBADE = 102;
+ ESysEBADR = 103;
+ ESysEXFULL = 104;
+ ESysENOANO = 105;
+ ESysEBADRQC = 106;
+ ESysEBADSLT = 107;
+ ESysEDEADLOCK = 108;
+ ESysEBFONT = 109;
+ ESysELIBEXEC = 110;
+ ESysENODATA = 111;
+ ESysELIBBAD = 112;
+ ESysENOPKG = 113;
+ ESysELIBACC = 114;
+ ESysENOTUNIQ = 115;
+ ESysERESTART = 116;
+ ESysEUCLEAN = 117;
+ ESysENOTNAM = 118;
+ ESysENAVAIL = 119;
+ ESysEISNAM = 120;
+ ESysEREMOTEIO = 121;
+ ESysEILSEQ = 122;
+ ESysELIBMAX = 123;
+ ESysELIBSCN = 124;
+ ESysENOMEDIUM = 125;
+ ESysEMEDIUMTYPE = 126;
+{$endif CPUSPARC}
+
+{$ifndef FPC_HAS_ESYS}
+ ESysEPERM = 1; { Operation not permitted }
+ ESysENOENT = 2; { No such file or directory }
+ ESysESRCH = 3; { No such process }
+ ESysEINTR = 4; { Interrupted system call }
+ ESysEIO = 5; { I/O error }
+ ESysENXIO = 6; { No such device or address }
+ ESysE2BIG = 7; { Arg list too long }
+ ESysENOEXEC = 8; { Exec format error }
+ ESysEBADF = 9; { Bad file number }
+ ESysECHILD = 10; { No child processes }
+ ESysEAGAIN = 11; { Try again }
+ ESysENOMEM = 12; { Out of memory }
+ ESysEACCES = 13; { Permission denied }
+ ESysEFAULT = 14; { Bad address }
+ ESysENOTBLK = 15; { Block device required, NOT POSIX! }
+ ESysEBUSY = 16; { Device or resource busy }
+ ESysEEXIST = 17; { File exists }
+ ESysEXDEV = 18; { Cross-device link }
+ ESysENODEV = 19; { No such device }
+ ESysENOTDIR = 20; { Not a directory }
+ ESysEISDIR = 21; { Is a directory }
+ ESysEINVAL = 22; { Invalid argument }
+ ESysENFILE = 23; { File table overflow }
+ ESysEMFILE = 24; { Too many open files }
+ ESysENOTTY = 25; { Not a typewriter }
+ ESysETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+ ESysEFBIG = 27; { File too large }
+ ESysENOSPC = 28; { No space left on device }
+ ESysESPIPE = 29; { Illegal seek }
+ ESysEROFS = 30; { Read-only file system }
+ ESysEMLINK = 31; { Too many links }
+ ESysEPIPE = 32; { Broken pipe }
+ ESysEDOM = 33; { Math argument out of domain of func }
+ ESysERANGE = 34; { Math result not representable }
+
+
+ ESysEDEADLK = 35; { Resource deadlock would occur }
+ ESysENAMETOOLONG= 36; { File name too long }
+ ESysENOLCK = 37; { No record locks available }
+ ESysENOSYS = 38; { Function not implemented }
+ ESysENOTEMPTY= 39; { Directory not empty }
+ ESysELOOP = 40; { Too many symbolic links encountered }
+ ESysEWOULDBLOCK = ESysEAGAIN; { Operation would block }
+ ESysENOMSG = 42; { No message of desired type }
+ ESysEIDRM = 43; { Identifier removed }
+ ESysECHRNG = 44; { Channel number out of range }
+ ESysEL2NSYNC= 45; { Level 2 not synchronized }
+ ESysEL3HLT = 46; { Level 3 halted }
+ ESysEL3RST = 47; { Level 3 reset }
+ ESysELNRNG = 48; { Link number out of range }
+ ESysEUNATCH = 49; { Protocol driver not attached }
+ ESysENOCSI = 50; { No CSI structure available }
+ ESysEL2HLT = 51; { Level 2 halted }
+ ESysEBADE = 52; { Invalid exchange }
+ ESysEBADR = 53; { Invalid request descriptor }
+ ESysEXFULL = 54; { Exchange full }
+ ESysENOANO = 55; { No anode }
+ ESysEBADRQC = 56; { Invalid request code }
+ ESysEBADSLT = 57; { Invalid slot }
+ ESysEDEADLOCK= 58; { File locking deadlock error }
+ ESysEBFONT = 59; { Bad font file format }
+ ESysENOSTR = 60; { Device not a stream }
+ ESysENODATA = 61; { No data available }
+ ESysETIME = 62; { Timer expired }
+ ESysENOSR = 63; { Out of streams resources }
+ ESysENONET = 64; { Machine is not on the network }
+ ESysENOPKG = 65; { Package not installed }
+ ESysEREMOTE = 66; { Object is remote }
+ ESysENOLINK = 67; { Link has been severed }
+ ESysEADV = 68; { Advertise error }
+ ESysESRMNT = 69; { Srmount error }
+ ESysECOMM = 70; { Communication error on send }
+ ESysEPROTO = 71; { Protocol error }
+ ESysEMULTIHOP= 72; { Multihop attempted }
+ ESysEDOTDOT = 73; { RFS specific error }
+ ESysEBADMSG = 74; { Not a data message }
+ ESysEOVERFLOW= 75; { Value too large for defined data type }
+ ESysENOTUNIQ= 76; { Name not unique on network }
+ ESysEBADFD = 77; { File descriptor in bad state }
+ ESysEREMCHG = 78; { Remote address changed }
+ ESysELIBACC = 79; { Can not access a needed shared library }
+ ESysELIBBAD = 80; { Accessing a corrupted shared library }
+ ESysELIBSCN = 81; { .lib section in a.out corrupted }
+ ESysELIBMAX = 82; { Attempting to link in too many shared libraries }
+ ESysELIBEXEC= 83; { Cannot exec a shared library directly }
+ ESysEILSEQ = 84; { Illegal byte sequence }
+ ESysERESTART= 85; { Interrupted system call should be restarted }
+ ESysESTRPIPE= 86; { Streams pipe error }
+ ESysEUSERS = 87; { Too many users }
+ ESysENOTSOCK= 88; { Socket operation on non-socket }
+ ESysEDESTADDRREQ= 89; { Destination address required }
+ ESysEMSGSIZE= 90; { Message too long }
+ ESysEPROTOTYPE= 91; { Protocol wrong type for socket }
+ ESysENOPROTOOPT= 92; { Protocol not available }
+ ESysEPROTONOSUPPORT= 93; { Protocol not supported }
+ ESysESOCKTNOSUPPORT= 94; { Socket type not supported }
+ ESysEOPNOTSUPP= 95; { Operation not supported on transport endpoint }
+ ESysEPFNOSUPPORT= 96; { Protocol family not supported }
+ ESysEAFNOSUPPORT= 97; { Address family not supported by protocol }
+ ESysEADDRINUSE= 98; { Address already in use }
+ ESysEADDRNOTAVAIL= 99; { Cannot assign requested address }
+ ESysENETDOWN= 100; { Network is down }
+ ESysENETUNREACH= 101; { Network is unreachable }
+ ESysENETRESET= 102; { Network dropped connection because of reset }
+ ESysECONNABORTED= 103; { Software caused connection abort }
+ ESysECONNRESET= 104; { Connection reset by peer }
+ ESysENOBUFS = 105; { No buffer space available }
+ ESysEISCONN = 106; { Transport endpoint is already connected }
+ ESysENOTCONN= 107; { Transport endpoint is not connected }
+ ESysESHUTDOWN= 108; { Cannot send after transport endpoint shutdown }
+ ESysETOOMANYREFS= 109; { Too many references: cannot splice }
+ ESysETIMEDOUT= 110; { Connection timed out }
+ ESysECONNREFUSED= 111; { Connection refused }
+ ESysEHOSTDOWN= 112; { Host is down }
+ ESysEHOSTUNREACH= 113; { No route to host }
+ ESysEALREADY= 114; { Operation already in progress }
+ ESysEINPROGRESS= 115; { Operation now in progress }
+ ESysESTALE = 116; { Stale NFS file handle }
+ ESysEUCLEAN = 117; { Structure needs cleaning }
+ ESysENOTNAM = 118; { Not a XENIX named type file }
+ ESysENAVAIL = 119; { No XENIX semaphores available }
+ ESysEISNAM = 120; { Is a named type file }
+ ESysEREMOTEIO= 121; { Remote I/O error }
+ ESysEDQUOT = 122; { Quota exceeded }
+{$endif FPC_HAS_ESYS}
+
+{
+ $Log: errno.inc,v $
+ Revision 1.10 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.9 2005/01/27 21:27:02 florian
+ * sparc got correct errnos
+
+}
diff --git a/rtl/linux/gpm.pp b/rtl/linux/gpm.pp
new file mode 100644
index 0000000000..d06f85f1ab
--- /dev/null
+++ b/rtl/linux/gpm.pp
@@ -0,0 +1,967 @@
+{
+ $Id: gpm.pp,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+
+ GPM (>v1.17) mouse Interface for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit gpm;
+
+{Note: Libgpm is *the* interface for Linux text-mode programs.
+ Unfortunately it isn't suitable for anything else besides a blocky
+ cursor on a text mode interface. The GPM protocol suffers from serious
+ defficiencies and ideally, gpm is abolished as quickly as possible.
+
+ With lack of a good alternative, GPM deserves good support. But
+ please keep this in mind while coding.}
+
+{*****************************************************************************}
+ interface
+{*****************************************************************************}
+
+uses
+ baseUnix;
+
+{$ifndef use_external}
+{$linklib gpm}
+{$linklib c}
+{$endif}
+
+{$inline on}
+{$goto on}
+
+const
+ _PATH_VARRUN = '/var/run/';
+ _PATH_DEV = '/dev/';
+ GPM_NODE_DIR = _PATH_VARRUN;
+ GPM_NODE_DIR_MODE = 0775;
+ GPM_NODE_PID = '/var/run/gpm.pid';
+ GPM_NODE_DEV = '/dev/gpmctl';
+ GPM_NODE_CTL = GPM_NODE_DEV;
+ GPM_NODE_FIFO = '/dev/gpmdata';
+
+ GPM_B_LEFT = 4;
+ GPM_B_MIDDLE = 2;
+ GPM_B_RIGHT = 1;
+
+type
+ TGpmEtype = longint;
+ TGpmMargin = longint;
+
+const
+ GPM_MOVE = 1;
+ GPM_DRAG = 2;
+ GPM_DOWN = 4;
+ GPM_UP = 8;
+ GPM_SINGLE = 16;
+ GPM_DOUBLE = 32;
+ GPM_TRIPLE = 64;
+ GPM_MFLAG = 128;
+ GPM_HARD = 256;
+ GPM_ENTER = 512;
+ GPM_LEAVE = 1024;
+
+ GPM_TOP = 1;
+ GPM_BOT = 2;
+ GPM_LFT = 4;
+ GPM_RGT = 8;
+
+type
+{$PACKRECORDS c}
+ Pgpm_event=^Tgpm_event;
+ Tgpm_event=record
+ buttons : byte;
+ modifiers : byte;
+ vc : word;
+ dx : word;
+ dy : word;
+ x,y : word;
+ wdx,wdy : word;
+ EventType : TGpmEType;
+ clicks : longint;
+ margin : TGpmMargin;
+ end;
+
+ Pgpmevent=Pgpm_event;
+ Tgpmevent=Tgpm_event;
+
+ TGpmHandler=function(var event:TGpmEvent;clientdata:pointer):longint;cdecl;
+
+ const
+ GPM_MAGIC = $47706D4C;
+
+ type
+ Pgpm_connect = ^TGpm_connect;
+ Tgpm_connect = record
+ eventMask : word;
+ defaultMask : word;
+ minMod : word;
+ maxMod : word;
+ pid : longint;
+ vc : longint;
+ end;
+
+ Pgpmconnect=Pgpm_connect;
+ Tgpmconnect=Tgpm_connect;
+
+ Pgpm_roi=^Tgpm_roi;
+ Tgpm_roi=record
+ xmin,xmax:integer;
+ ymin,ymax:integer;
+ minmod,maxmod:word;
+ eventmask:word;
+ owned:word;
+ handler:Tgpmhandler;
+ clientdata:pointer;
+ prev,next:Pgpm_roi;
+ end;
+
+ Pgpmroi=Pgpm_roi;
+ Tgpmroi=Tgpm_roi;
+
+{$ifdef external}
+var
+ gpm_flag : longint;cvar;external;
+ gpm_fd : longint;cvar;external;
+ gpm_hflag : longint;cvar;external;
+ gpm_morekeys : Longbool;cvar;external;
+ gpm_zerobased : Longbool;cvar;external;
+ gpm_visiblepointer : Longbool;cvar;external;
+ gpm_mx : longint;cvar;external;
+ gpm_my : longint;cvar;external;
+ gpm_timeout : TTimeVal;cvar;external;
+ _gpm_buf : array[0..0] of char;cvar;external;
+ _gpm_arg : ^word;cvar;external;
+ gpm_handler : TGpmHandler;cvar;external;
+ gpm_data : pointer;cvar;external;
+ gpm_roi_handler : TGpmHandler;cvar;external;
+ gpm_roi_data : pointer;cvar;external;
+ gpm_roi : PGpmRoi;cvar;external;
+ gpm_current_roi : PGpmRoi;cvar;external;
+ gpm_consolefd : longint;cvar;external;
+ Gpm_HandleRoi : TGpmHandler;cvar;external;
+{$else}
+var gpm_roi:Pgpm_roi;
+ gpm_handler,gpm_roi_handler:Tgpmhandler;
+ gpm_current_roi:Pgpm_roi;
+ gpm_roi_data:pointer;
+{$endif}
+
+function Gpm_StrictSingle(EventType : longint) : boolean;
+function Gpm_AnySingle(EventType : longint) : boolean;
+function Gpm_StrictDouble(EventType : longint) : boolean;
+function Gpm_AnyDouble(EventType : longint) : boolean;
+function Gpm_StrictTriple(EventType : longint) : boolean;
+function Gpm_AnyTriple(EventType : longint) : boolean;
+
+{$ifdef use_external}
+function Gpm_Open(var _para1:TGpmConnect; _para2:longint):longint;cdecl;external;
+function Gpm_Close:longint;cdecl;external;
+function Gpm_GetEvent(var _para1:TGpmEvent):longint;cdecl;external;
+{function Gpm_Getc(_para1:pFILE):longint;cdecl;external;
+function Gpm_Getchar : longint;}
+function Gpm_Repeat(millisec:longint):longint;cdecl;external;
+function Gpm_FitValuesM(var x,y:longint; margin:longint):longint;cdecl;external;
+function Gpm_FitValues(var x,y:longint):longint;cdecl;external;
+{function GPM_DRAWPOINTER(ePtr : longint) : longint;}
+function Gpm_PushRoi(x1:longint; y1:longint; X2:longint; Y2:longint; mask:longint; fun:TGpmHandler; xtradata:pointer):PGpmRoi;cdecl;external;
+function Gpm_PopRoi(which:PGpmRoi):PGpmRoi;cdecl;external;
+function Gpm_RaiseRoi(which:PGpmRoi; before:PGpmRoi):PGpmRoi;cdecl;external;
+function Gpm_LowerRoi(which:PGpmRoi; after:PGpmRoi):PGpmRoi;cdecl;external;
+{function Gpm_Wgetch:longint;cdecl;external;
+function Gpm_Getch:longint;}
+function Gpm_GetLibVersion(var where:longint):pchar;cdecl;external;
+function Gpm_GetServerVersion(var where:longint):pchar;cdecl;external;
+function Gpm_GetSnapshot(var ePtr:TGpmEvent):longint;cdecl;external;
+{$else}
+function gpm_open(var conn:Tgpm_connect;flag:longint):longint;
+function gpm_close:longint;
+function gpm_getevent(var event:Tgpm_event):longint;
+{function Gpm_Getc(_para1:pFILE):longint;cdecl;external;
+function Gpm_Getchar : longint;}
+function gpm_repeat(millisec:longint):longint;
+function gpm_fitvaluesM(var x,y:longint; margin:longint):longint;
+function gpm_fitvalues(var x,y:longint):longint;{$ifndef VER1_0}inline;{$endif}
+function gpm_pushroi(x1:longint;y1:longint;x2:longint;y2:longint;
+ mask:longint;fun:Tgpmhandler;xtradata:pointer):Pgpm_roi;
+function gpm_poproi(which:Pgpm_roi):Pgpm_roi;
+function gpm_raiseroi(which:Pgpm_roi;before:Pgpm_roi):Pgpm_roi;
+function gpm_lowerroi(which:Pgpm_roi;after:Pgpm_roi):Pgpm_roi;
+{Should be pointer because proc accepts nil.}
+function gpm_getsnapshot(eptr:Pgpmevent):longint;
+{Overload for compatibility.}
+function gpm_getsnapshot(var eptr:Tgpmevent):longint;
+{$ifndef VER1_0}inline;{$endif}
+{$endif}
+
+
+{*****************************************************************************}
+ implementation
+{*****************************************************************************}
+
+{$ifndef use_external}
+uses termio,sockets,strings,unix;
+
+type Pgpm_stst=^Tgpm_stst;
+ Tgpm_stst=record
+ info:Tgpmconnect;
+ next:Pgpm_stst;
+ end;
+
+ Pmicetab=^Tmicetab;
+ Tmicetab=record
+ next:Pmicetab;
+ device,protocol,options:Pchar;
+ end;
+
+ string63=string[63];
+
+ Toptions=record
+ autodetect:longint;
+ mice_count:longint;
+ repeater:longint;
+ repeater_type:Pchar;
+ run_status:longint;
+ micelist:Pmicetab;
+ progname,
+ consolename:string63;
+ end;
+
+var options:Toptions;
+ gpm_stack:Pgpm_stst;
+ gpm_mx,gpm_my:longint;
+ gpm_saved_winch_hook,gpm_saved_suspend_hook:sigactionrec;
+
+const gpm_flag:boolean=false; {almost unuseful now -- where was it used for ? can
+ we remove it now ? FIXME}
+ gpm_tried:boolean=false;
+ gpm_hflag:boolean=false;
+ gpm_fd:longint=-1;
+ gpm_consolefd:longint=-1;
+ gpm_zerobased:longint=0;
+
+const GPM_DEVFS_CONSOLE='/dev/vc/0';
+ GPM_OLD_CONSOLE='/dev/tty0';
+
+ GPM_REQ_SNAPSHOT=0;
+ GPM_REQ_BUTTONS=1;
+ GPM_REQ_CONFIG=2;
+ GPM_REQ_NOPASTE=3;
+{$endif}
+
+function Gpm_StrictSingle(EventType : longint) : boolean;
+begin
+ Gpm_StrictSingle:=(EventType and GPM_SINGLE<>0) and not(EventType and GPM_MFLAG<>0);
+end;
+
+function Gpm_AnySingle(EventType : longint) : boolean;
+begin
+ Gpm_AnySingle:=(EventType and GPM_SINGLE<>0);
+end;
+
+function Gpm_StrictDouble(EventType : longint) : boolean;
+begin
+ Gpm_StrictDouble:=(EventType and GPM_DOUBLE<>0) and not(EventType and GPM_MFLAG<>0);
+end;
+
+function Gpm_AnyDouble(EventType : longint) : boolean;
+begin
+ Gpm_AnyDouble:=(EventType and GPM_DOUBLE<>0);
+end;
+
+function Gpm_StrictTriple(EventType : longint) : boolean;
+begin
+ Gpm_StrictTriple:=(EventType and GPM_TRIPLE<>0) and not(EventType and GPM_MFLAG<>0);
+end;
+
+function Gpm_AnyTriple(EventType : longint) : boolean;
+begin
+ Gpm_AnyTriple:=(EventType and GPM_TRIPLE<>0);
+end;
+
+{$ifdef use_external}
+procedure Gpm_CheckVersion;
+var
+ l : longint;
+begin
+ Gpm_GetLibVersion(l);
+ if l<11700 then
+ begin
+ writeln('You need at least gpm 1.17');
+ halt(1);
+ end;
+end;
+
+{$else}
+
+const checked_con:boolean=false;
+
+function putdata(where:longint;const what:Tgpmconnect):boolean;
+
+begin
+ putdata:=true;
+ if fpwrite(where,what,sizeof(Tgpmconnect))<>sizeof(Tgpmconnect) then
+ begin
+{ gpm_report(GPM_PR_ERR,GPM_MESS_WRITE_ERR,strerror(errno));}
+ putdata:=false;
+ end;
+end;
+
+function gpm_get_console:string63;
+
+var buf:stat;
+
+begin
+ {First try the devfs device, because in the next time this will be
+ the preferred one. If that fails, take the old console.}
+
+ {Check for open new console.}
+ if fpstat(GPM_DEVFS_CONSOLE,buf)=0 then
+ gpm_get_console:=GPM_DEVFS_CONSOLE
+ {Failed, try OLD console.}
+ else if fpstat(GPM_OLD_CONSOLE,buf)=0 then
+ gpm_get_console:=GPM_OLD_CONSOLE
+ else
+ gpm_get_console:='';
+end;
+
+procedure gpm_winch_hook(signum:longint;SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+
+var win:winsize;
+
+begin
+ if (sigactionhandler(SIG_IGN)<>gpm_saved_winch_hook.sa_handler) and
+ (sigactionhandler(SIG_DFL)<>gpm_saved_winch_hook.sa_handler) then
+ gpm_saved_winch_hook.sa_handler(signum,nil,nil);
+ if fpioctl(gpm_consolefd,TIOCGWINSZ,@win)=-1 then
+ exit;
+ if (win.ws_col=0) or (win.ws_row=0) then
+ begin
+ win.ws_col:=80;
+ win.ws_row:=25;
+ end;
+ gpm_mx:=win.ws_col - gpm_zerobased;
+ gpm_my:=win.ws_row - gpm_zerobased;
+end;
+
+procedure gpm_suspend_hook(signum:longint;SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+
+var conn:Tgpmconnect;
+ old_sigset,new_sigset:Tsigset;
+ sa:sigactionrec;
+ success:boolean;
+
+begin
+ fpsigemptyset(new_sigset);
+ fpsigaddset(new_sigset,SIGTSTP);
+ fpsigprocmask(SIG_BLOCK,{$ifdef ver1_0}@{$endif}new_sigset,{$ifdef ver1_0}@{$endif}old_sigset);
+
+ {Open a completely transparent gpm connection.}
+ conn.eventmask:=0;
+ conn.defaultMask:=$ffff;
+ conn.minmod:=$ffff;
+ conn.maxmod:=0;
+ {cannot do this under xterm, tough}
+ success:=gpm_open(conn,0)>=0;
+
+ {take the default action, whatever it is (probably a stop :)}
+ fpsigprocmask(SIG_SETMASK,@old_sigset,nil);
+ fpsigaction(SIGTSTP,@gpm_saved_suspend_hook,nil);
+ fpkill(fpgetpid,SIGTSTP);
+
+ { in bardo here }
+
+ { Reincarnation. Prepare for another death early. }
+ fpsigemptyset(sa.sa_mask);
+ sa.sa_handler:=@gpm_suspend_hook;
+ sa.sa_flags:=SA_NOMASK;
+ fpsigaction(SIGTSTP,@sa,nil);
+
+ { Pop the gpm stack by closing the useless connection }
+ { but do it only when we know we opened one.. }
+ if success then
+ gpm_close;
+end;
+
+function gpm_open(var conn:Tgpmconnect;flag:longint):longint;
+
+var tty:string;
+ flagstr:string[10];
+ term:Pchar;
+ i:cardinal;
+ addr:Tunixsockaddr;
+ win:Twinsize;
+ n:Pgpm_stst;
+ l:byte;
+ p:byte; {there max 256 console ttys}
+ buf:stat;
+ sa:sigactionrec;
+
+label err;
+
+begin
+ tty:='';
+ options.consolename:='';
+
+{ gpm_report(GPM_PR_DEBUG,"VC: %d",flag);}
+
+ {....................................... First of all, check xterm}
+
+ term:=fpgetenv('TERM');
+ if (term<>nil) and (strcomp(term,'xterm')=0) then
+ begin
+ if gpm_tried then
+ begin
+ gpm_open:=gpm_fd; { no stack }
+ exit;
+ end;
+ gpm_fd:=-2;
+ {save old hilit tracking and enable mouse tracking}
+ write(#27'[?1001s'#27'[?1000h');
+ flush(output);
+
+ gpm_flag:=true;
+ gpm_open:=gpm_fd;
+ exit;
+ end;
+ {....................................... No xterm, go on}
+
+ { check whether we know what name the console is: what's with the lib??? }
+ if not checked_con then
+ begin
+ options.consolename:=gpm_get_console;
+ checked_con:=true;
+ end;
+
+ { So I chose to use the current tty, instead of /dev/console, which
+ has permission problems. (I am fool, and my console is
+ readable/writeable by everybody.
+
+ However, making this piece of code work has been a real hassle.}
+
+ if not gpm_flag and gpm_tried then
+ begin
+ gpm_open:=-1;
+ exit;
+ end;
+ gpm_tried:=true; {do or die}
+
+ new(n);
+ n^.next:=gpm_stack;
+ gpm_stack:=n;
+
+ conn.pid:=fpgetpid; { fill obvious values }
+ if n^.next<>nil then
+ conn.vc:=n^.next^.info.vc {inherit}
+ else
+ begin
+ conn.vc:=0; { default handler }
+ if (flag>0) then
+ begin { forced vc number }
+ conn.vc:=flag;
+ str(flag,flagstr);
+ tty:=options.consolename+flagstr;
+ end
+ else
+ begin {use your current vc}
+ if isatty(0)<>0 then
+ tty:=ttyname(0); { stdin }
+ if (tty='') and (isatty(1)<>0) then
+ tty:=ttyname(1); { stdout }
+ if (tty='') and (isatty(2)<>0) then
+ tty:=ttyname(2); { stderr }
+ if (tty='') then
+ begin
+{ gpm_report(GPM_PR_ERR,"checking tty name failed");}
+ goto err;
+ end;
+ conn.vc:=0;
+ l:=length(tty);
+ p:=1;
+ while tty[l] in ['0'..'9'] do
+ begin
+ inc(conn.vc,p*(byte(tty[l])-byte('0')));
+ p:=p*10;
+ dec(l);
+ end;
+ end;
+
+ if (gpm_consolefd=-1) then
+ begin
+ gpm_consolefd:=fpopen(tty,O_WRONLY);
+ if gpm_consolefd<0 then
+ begin
+{ gpm_report(GPM_PR_ERR,GPM_MESS_DOUBLE_S,tty,strerror(errno));}
+ goto err;
+ end;
+ end;
+ end;
+ n^.info:=conn;
+
+ {....................................... Get screen dimensions }
+
+ fpioctl(gpm_consolefd, TIOCGWINSZ, @win);
+
+ if (win.ws_col or win.ws_row)=0 then
+ begin
+ {Hmmmm. The mad terminal didn't return it's size :/ }
+{ fprintf(stderr, "libgpm: zero screen dimension, assuming 80x25.\n");}
+ win.ws_col:=80;
+ win.ws_row:=25;
+ end;
+ gpm_mx:=win.ws_col-gpm_zerobased;
+ gpm_my:=win.ws_row-gpm_zerobased;
+
+ {....................................... Connect to the control socket}
+ if not gpm_flag then
+ begin
+ gpm_fd:=socket(AF_UNIX,SOCK_STREAM,0);
+ if gpm_fd<0 then
+ begin
+{ gpm_report(GPM_PR_ERR,GPM_MESS_SOCKET,strerror(errno));}
+ goto err;
+ end;
+ end;
+
+ fillchar(addr,sizeof(addr),0);
+ addr.family:=PF_UNIX;
+ strcopy(addr.path, GPM_NODE_CTL);
+ i:=sizeof(addr.family)+length(GPM_NODE_CTL);
+
+ if fpconnect(gpm_fd,@addr,i)<0 then
+ begin
+{ gpm_report(GPM_PR_INFO,GPM_MESS_DOUBLE_S,GPM_NODE_CTL,strerror(errno));}
+ {Well, try to open a chr device called /dev/gpmctl. This should
+ be forward-compatible with a kernel server.}
+ fpclose(gpm_fd); {the socket}
+ gpm_fd:=fpopen(GPM_NODE_DEV,O_RDWR);
+ if gpm_fd=-1 then
+ begin
+{ gpm_report(GPM_PR_ERR,GPM_MESS_DOUBLE_S,GPM_NODE_DEV
+ ,strerror(errno));}
+ goto err;
+ end;
+ if (fpfstat(gpm_fd,buf)=-1) or (buf.st_mode and STAT_IFMT<>STAT_IFCHR) then
+ goto err;
+ end;
+ {....................................... Put your data}
+ if putdata(gpm_fd,conn) then
+ begin
+ { itz Wed Dec 16 23:22:16 PST 1998 use sigaction, the old
+ code caused a signal loop under XEmacs }
+ fpsigemptyset(sa.sa_mask);
+
+ { And the winch (window-resize) hook .. }
+ sa.sa_handler:=@gpm_winch_hook;
+ sa.sa_flags:=0;
+ fpsigaction(SIGWINCH,@sa,@gpm_saved_winch_hook);
+
+ if gpm_flag then
+ begin
+ { Install suspend hook }
+ sa.sa_handler:=sigactionhandler(SIG_IGN);
+ fpsigaction(SIGTSTP,@sa,@gpm_saved_suspend_hook);
+
+ {if signal was originally ignored, job control is not supported}
+ if gpm_saved_suspend_hook.sa_handler<>sigactionhandler(SIG_IGN) then
+ begin
+ sa.sa_flags:=SA_NOMASK;
+ sa.sa_handler:=@gpm_suspend_hook;
+ fpsigaction(SIGTSTP,@sa,nil);
+ end;
+ end;
+ end;
+ gpm_open:=gpm_fd;
+ exit;
+ {....................................... Error: free all memory}
+err:
+{ gpm_report(GPM_PR_ERR,'Oh, oh, it''s an error! possibly I die! ');}
+ repeat
+ n:=gpm_stack^.next;
+ dispose(gpm_stack);
+ gpm_stack:=n;
+ until gpm_stack=nil;
+ if gpm_fd>=0 then
+ fpclose(gpm_fd);
+ gpm_flag:=false;
+ gpm_open:=-1;
+end;
+
+function gpm_close:longint;
+
+var next:Pgpm_stst;
+
+begin
+ gpm_tried:=false; { reset the error flag for next time }
+ if gpm_fd=-2 then { xterm }
+ begin
+ write(#27'[?1000l'#27'[?1001r');
+ flush(output);
+ end
+ else { linux }
+ begin
+ if not gpm_flag then
+ gpm_close:=0
+ else
+ begin
+ next:=gpm_stack^.next;
+ dispose(gpm_stack);
+ gpm_stack:=next;
+ if next<>nil then
+ putdata(gpm_fd,next^.info);
+
+ gpm_flag:=false;
+ end;
+ end;
+
+ if gpm_fd>=0 then
+ fpclose(gpm_fd);
+ gpm_fd:=-1;
+ fpsigaction(SIGTSTP,@gpm_saved_suspend_hook,nil);
+ fpsigaction(SIGWINCH,@gpm_saved_winch_hook,nil);
+ fpclose(gpm_consolefd);
+ gpm_consolefd:=-1;
+ gpm_close:=0;
+end;
+
+function gpm_getevent(var event:Tgpm_event):longint;
+
+var count:longint;
+
+begin
+ gpm_getevent:=0;
+ if gpm_fd=-1 then
+ exit;
+
+ count:=fpread(gpm_fd,event,sizeof(Tgpm_event));
+ if count<>sizeof(Tgpm_event) then
+ begin
+ {avoid to send the message if there is no data; sometimes it makes
+ sense to poll the mouse descriptor any now an then using a
+ non-blocking descriptor}
+{ if (count<>-1) or (errno<>EAGAIN)
+ gpm_report(GPM_PR_INFO,"Read too few bytes (%i) at %s:%d",
+ count,__FILE__,__LINE__);}
+ gpm_getevent:=-1;
+ exit;
+ end;
+
+ dec(event.x,gpm_zerobased);
+ dec(event.y,gpm_zerobased);
+ gpm_getevent:=1;
+end;
+
+function gpm_repeat(millisec:longint):longint;
+
+var fd:longint;
+ selset:Tfdset;
+
+begin
+ fd:=0; {Default to stdin (xterm).}
+ if gpm_fd>=0 then
+ fd:=gpm_fd;
+
+ fpFD_ZERO(selset);
+ fpFD_SET(fd,selset);
+ gpm_repeat:=fpselect(fd+1,@selset,nil,nil,millisec);
+end;
+
+function gpm_fitvaluesM(var x,y:longint;margin:longint):longint;
+
+begin
+ gpm_fitvaluesM:=0;
+ if margin=-1 then
+ begin
+ if x<gpm_zerobased then
+ x:=gpm_zerobased
+ else if x>gpm_mx then
+ x:=gpm_mx;
+ if y<gpm_zerobased then
+ y:=gpm_zerobased
+ else if y>gpm_my then
+ y:=gpm_my;
+ end
+ else
+ case margin of
+ GPM_TOP:
+ inc(y);
+ GPM_BOT:
+ dec(y);
+ GPM_RGT:
+ dec(x);
+ GPM_LFT:
+ inc(x);
+ end;
+end;
+
+function gpm_fitvalues(var x,y:longint):longint;
+{$ifndef VER1_0}inline;{$endif}
+
+begin
+ gpm_fitvalues:=gpm_fitvaluesm(x,y,-1);
+end;
+
+function gpm_handle_roi(var eptr:Tgpm_event;clientdata:pointer):longint;cdecl;
+
+var backevent:Tgpm_event;
+ roi:Pgpm_roi;
+
+begin
+ roi:=gpm_current_roi;
+
+ {If motion or press, look for the interested roi.
+ Drag and release will be reported to the old roi.}
+
+ if eptr.eventtype and (GPM_MOVE or GPM_DOWN)<>0 then
+ begin
+ roi:=gpm_roi;
+ while roi<>nil do
+ begin
+ if not ((roi^.xmin>eptr.x) or (roi^.xmax<eptr.x)) and
+ not ((roi^.ymin>eptr.y) or (roi^.ymax<eptr.y)) and
+ not ((roi^.minmod and eptr.modifiers)<roi^.minmod) and
+ not ((roi^.maxmod and eptr.modifiers)<eptr.modifiers) then
+ break;
+ roi:=roi^.next;
+ end;
+ end;
+
+ {Now generate the leave/enter events}
+
+ if roi<>gpm_current_roi then
+ begin
+ if (gpm_current_roi<>nil) and (gpm_current_roi^.eventmask and GPM_LEAVE<>0) then
+ begin
+ backevent.eventtype:=GPM_LEAVE;
+ gpm_current_roi^.handler(backevent,gpm_current_roi^.clientdata);
+ end;
+ if (roi<>nil) and (roi^.eventmask and GPM_ENTER<>0) then
+ begin
+ backevent.eventtype:=GPM_ENTER;
+ roi^.handler(backevent,roi^.clientdata);
+ end;
+ end;
+ gpm_current_roi:=roi;
+
+ {events not requested are discarded}
+ if (roi<>nil) and (eptr.eventtype and ($0f or GPM_ENTER or GPM_LEAVE) and roi^.eventmask=0) then
+ gpm_handle_roi:=0
+ else
+ begin
+ backevent:=eptr; {copy it, so the main one is unchanged}
+ if roi=nil then
+ if gpm_roi_handler<>nil then
+ gpm_handle_roi:=gpm_roi_handler(backevent,gpm_roi_data)
+ else
+ gpm_handle_roi:=0
+ else
+ begin
+ {Ok, now report the event as it is, after modifying x and y}
+ dec(backevent.x,roi^.xmin);
+ dec(backevent.y,roi^.ymin);
+ roi^.handler(backevent,roi^.clientdata);
+ end;
+ end;
+end;
+
+function gpm_pushroi(x1:longint;y1:longint;x2:longint;y2:longint;
+ mask:longint;fun:Tgpmhandler;xtradata:pointer):Pgpm_roi;
+
+var n:Pgpm_roi;
+
+begin
+ {create a roi and push it}
+ new(n);
+ {use the roi handler, if still null}
+ if (gpm_roi<>nil) and (gpm_handler<>nil) then
+ gpm_handler:=@gpm_handle_roi;
+
+ n^.xmin:=x1; n^.xmax:=x2;
+ n^.ymin:=y1; n^.ymax:=y2;
+ n^.minmod:=0; n^.maxmod:=$ffff;
+ n^.prev:=nil; n^.next:=nil;
+ n^.eventmask:=mask;
+ n^.owned:=0; { use dispose }
+ n^.handler:=fun;
+ if xtradata=nil then
+ n^.clientdata:=n
+ else
+ n^.clientdata:=xtradata;
+ gpm_pushroi:=gpm_raiseroi(n,nil);
+end;
+
+function gpm_useroi(n:Pgpm_roi):Pgpm_roi;
+
+begin
+ { use a Roi by pushing it }
+ n^.prev:=nil;
+ n^.next:=nil;
+ n^.owned:=1;
+
+ { use the roi handler, if still nil }
+ if (gpm_roi=nil) and (gpm_handler=nil) then
+ gpm_handler:=@gpm_handle_roi;
+
+ gpm_useroi:=gpm_raiseroi(n,nil);
+end;
+
+function gpm_poproi(which:Pgpmroi):Pgpmroi;
+
+begin
+ {extract the Roi and remove it}
+ if which^.prev<>nil then
+ which^.prev^.next:=which^.next;
+ if which^.next<>nil then
+ which^.next^.prev:=which^.prev;
+ if gpm_roi=which then
+ gpm_roi:=which^.next;
+
+ if which^.owned=0 then
+ dispose(which);
+ if gpm_current_roi=which then
+ gpm_current_roi:=nil;
+
+ gpm_poproi:=gpm_roi; {return the new top-of-stack}
+end;
+
+
+function gpm_raiseroi(which:Pgpmroi;before:Pgpmroi):Pgpmroi;
+
+begin
+ {raise a Roi above another, or to top-of-stack}
+ if gpm_roi=nil then
+ begin
+ gpm_roi:=which;
+ gpm_raiseroi:=which;
+ exit;
+ end;
+ if before=nil then
+ before:=gpm_roi;
+ if before=which then
+ begin
+ gpm_raiseroi:=gpm_roi;
+ exit;
+ end;
+
+ if which^.prev<>nil then
+ which^.prev^.next:=which^.next;
+ if which^.next<>nil then
+ which^.next^.prev:=which^.prev;
+ if gpm_roi=which then
+ gpm_roi:=which^.next;
+
+ which^.prev:=before^.prev;
+ before^.prev:=which;
+ which^.next:=before;
+
+ if which^.prev<>nil then
+ which^.prev^.next:=which
+ else
+ gpm_roi:=which;
+
+ gpm_raiseroi:=gpm_roi; { return the new top-of-stack }
+end;
+
+function gpm_lowerroi(which:Pgpmroi;after:Pgpmroi):Pgpmroi;
+
+begin
+ {lower a Roi below another, or to bottom-of-stack}
+ if after=nil then
+ begin
+ after:=gpm_roi;
+ while after^.next<>nil do
+ after:=after^.next;
+ end;
+ if after=which then
+ begin
+ gpm_lowerroi:=gpm_roi;
+ exit;
+ end;
+ if which^.prev<>nil then
+ which^.prev^.next:=which^.next;
+ if which^.next<>nil then
+ which^.next^.prev:=which^.prev;
+ if gpm_roi=which then
+ gpm_roi:=which^.next;
+
+ which^.next:=after^.next;
+ after^.next:=which;
+ which^.prev:=after;
+
+ if which^.next<>nil then
+ which^.next^.prev:=which;
+
+ gpm_lowerroi:=gpm_roi; {return the new top-of-stack}
+end;
+
+function gpm_getsnapshot(eptr:Pgpm_event):longint;
+
+var conn:Tgpm_connect;
+ event:Tgpm_event;
+ sillyset:Tfdset;
+ i:longint;
+
+begin
+ fillchar(conn,sizeof(conn),0);
+ if eptr<>nil then
+ conn.vc:=GPM_REQ_SNAPSHOT
+ else
+ begin
+ conn.vc:=GPM_REQ_BUTTONS;
+ eptr:=@event;
+ end;
+
+ if gpm_fd=-1 then
+ begin
+ gpm_getsnapshot:=-1;
+ exit;
+ end;
+ fpFD_ZERO(sillyset);
+ fpFD_SET(gpm_fd,sillyset);
+ if fpselect(gpm_fd+1,@sillyset,nil,nil,0)=1 then
+ gpm_getsnapshot:=0
+ else
+ begin
+ fpwrite(gpm_fd,conn,sizeof(Tgpm_connect));
+
+ i:=gpm_getevent(eptr^);
+ if i<>1 then
+ gpm_getsnapshot:=-1
+ else
+ begin
+ gpm_getsnapshot:=eptr^.eventtype; { number of buttons }
+ eptr^.eventtype:=0;
+ end;
+ end;
+end;
+
+function gpm_getsnapshot(var eptr:Tgpmevent):longint;
+{$ifndef VER1_0}inline;{$endif}
+
+begin
+ gpm_getsnapshot:=gpm_getsnapshot(@eptr);
+end;
+
+{$endif}
+
+end.
+{
+ $Log: gpm.pp,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.5 2005/01/30 18:35:42 peter
+ * goto on
+
+ Revision 1.4 2005/01/30 18:00:28 peter
+ * move gpm.pp to linux
+
+}
diff --git a/rtl/linux/i386/bsyscall.inc b/rtl/linux/i386/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/linux/i386/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/linux/i386/cprt0.as b/rtl/linux/i386/cprt0.as
new file mode 100644
index 0000000000..e79d36474a
--- /dev/null
+++ b/rtl/linux/i386/cprt0.as
@@ -0,0 +1,104 @@
+#
+# $Id: cprt0.as,v 1.4 2004/07/03 21:50:31 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF startup code for Free Pascal
+#
+#
+# Stack layout at program start:
+#
+# nil
+# envn
+# ....
+# .... ENVIRONMENT VARIABLES
+# env1
+# env0
+# nil
+# argn
+# ....
+# .... COMMAND LINE OPTIONS
+# arg1
+# arg0
+# argc <--- esp
+#
+
+ .file "cprt0.as"
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* First locate the start of the environment variables */
+ popl %ecx /* Get argc in ecx */
+ movl %esp,%ebx /* Esp now points to the arguments */
+ leal 4(%esp,%ecx,4),%eax /* The start of the environment is: esp+4*eax+8 */
+ andl $0xfffffff8,%esp /* Align stack */
+
+ movl %eax,operatingsystem_parameter_envp /* Move the environment pointer */
+ movl %ecx,operatingsystem_parameter_argc /* Move the argument counter */
+ movl %ebx,operatingsystem_parameter_argv /* Move the argument pointer */
+
+ movl %eax,__environ /* libc environ */
+
+ pushl %eax
+ pushl %ebx
+ pushl %ecx
+
+ call __libc_init /* init libc */
+ movzwl __fpu_control,%eax
+ pushl %eax
+ call __setfpucw
+ popl %eax
+ pushl $_fini
+ call atexit
+ popl %eax
+ call _init
+
+ popl %eax
+ popl %eax
+
+ xorl %ebp,%ebp
+ call PASCALMAIN /* start the program */
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+_haltproc2: # GAS <= 2.15 bug: generates larger jump if a label is exported
+ movzwl operatingsystem_result,%ebx
+ pushl %ebx
+ call exit
+ xorl %eax,%eax
+ incl %eax /* eax=1, exit call */
+ popl %ebx
+ int $0x80
+ jmp _haltproc2
+
+.data
+
+.bss
+ .type ___fpc_brk_addr,@object
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+#
+# $Log: cprt0.as,v $
+# Revision 1.4 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.3 2002/09/07 16:01:20 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/linux/i386/cprt21.as b/rtl/linux/i386/cprt21.as
new file mode 100644
index 0000000000..3bad439f34
--- /dev/null
+++ b/rtl/linux/i386/cprt21.as
@@ -0,0 +1,122 @@
+#
+# $Id: cprt21.as,v 1.6 2004/07/03 21:50:31 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF startup code for Free Pascal
+#
+# Stack layout at program start:
+#
+# nil
+# envn
+# ....
+# .... ENVIRONMENT VARIABLES
+# env1
+# env0
+# nil
+# argn
+# ....
+# .... COMMAND LINE OPTIONS
+# arg1
+# arg0
+# argc <--- esp
+#
+
+ .file "prt1.as"
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* First locate the start of the environment variables */
+
+ popl %esi
+ movl %eax,%edi
+
+ movl %esp,%ebx /* Points to the arguments */
+ movl %esi,%eax
+ incl %eax
+ shll $2,%eax
+ addl %esp,%eax
+ andl $0xfffffff8,%esp /* Align stack */
+
+ movl %eax,operatingsystem_parameter_envp /* Move the environment pointer */
+ movl %esi,operatingsystem_parameter_argc /* Move the argument counter */
+ movl %ebx,operatingsystem_parameter_argv /* Move the argument pointer */
+
+ xorl %ebp,%ebp
+ pushl %edi
+ pushl %esp
+ pushl %edx
+ pushl $_fini_dummy
+ pushl $_init_dummy
+ pushl %ebx
+ pushl %esi
+ pushl $main
+ call __libc_start_main
+ hlt
+
+/* fake main routine which will be run from libc */
+main:
+ /* save return address */
+ popl %eax
+ movl %eax,___fpc_ret
+ movl %ebx,___fpc_ret_ebx
+ movl %ebp,___fpc_ret_ebp
+ pushl %eax
+
+ /* start the program */
+ xorl %ebp,%ebp
+ call PASCALMAIN
+ hlt
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ movzwl operatingsystem_result,%eax
+
+ movl ___fpc_ret,%edx /* return to libc */
+ movl ___fpc_ret_ebp,%ebp
+ movl ___fpc_ret_ebx,%ebx
+ push %edx
+_init_dummy:
+_fini_dummy:
+ ret
+
+.data
+ .align 4
+
+___fpc_ret: /* return address to libc */
+ .long 0
+___fpc_ret_ebx:
+ .long 0
+___fpc_ret_ebp:
+ .long 0
+
+.bss
+ .type ___fpc_brk_addr,@object
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+
+#
+# $Log: cprt21.as,v $
+# Revision 1.6 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.5 2002/09/07 16:01:20 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/linux/i386/dllprt0.as b/rtl/linux/i386/dllprt0.as
new file mode 100644
index 0000000000..9ab1f2cd4a
--- /dev/null
+++ b/rtl/linux/i386/dllprt0.as
@@ -0,0 +1,67 @@
+#
+# $Id: dllprt0.as,v 1.3 2004/07/03 21:50:31 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 2001 by Peter Vreman
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF shared library startup code for Free Pascal
+#
+
+ .file "dllprt0.as"
+ .text
+ .globl _startlib
+ .type _startlib,@function
+_startlib:
+ .globl FPC_LIB_START
+ .type FPC_LIB_START,@function
+FPC_LIB_START:
+ pushl %ebp
+ movl %esp,%ebp
+
+ movl 8(%ebp),%eax
+ movl 12(%ebp),%ecx
+ movl 16(%ebp),%edx
+
+ movl %edx,operatingsystem_parameter_envp /* Move the environment pointer */
+ movl %eax,operatingsystem_parameter_argc /* Move the argument counter */
+ movl %ecx,operatingsystem_parameter_argv /* Move the argument pointer */
+
+ movb $1,U_SYSTEM_ISLIBRARY
+
+ call PASCALMAIN
+
+ leave
+ ret
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+_haltproc2: # GAS <= 2.15 bug: generates larger jump if a label is exported
+ xorl %eax,%eax
+ incl %eax /* eax=1, exit call */
+ movzwl operatingsystem_result,%ebx
+ int $0x80
+ jmp _haltproc2
+
+.bss
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+#
+# $Log: dllprt0.as,v $
+# Revision 1.3 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.2 2002/09/07 16:01:20 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/linux/i386/gprt0.as b/rtl/linux/i386/gprt0.as
new file mode 100644
index 0000000000..a615762d8d
--- /dev/null
+++ b/rtl/linux/i386/gprt0.as
@@ -0,0 +1,87 @@
+#
+# $Id: gprt0.as,v 1.4 2004/07/03 21:50:31 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF startup code with profiling support for Free Pascal
+# Note: Needs linking with -lgmon and -lc
+#
+
+ .file "gprt1.as"
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* First locate the start of the environment variables */
+ popl %ecx
+ movl %esp,%ebx /* Points to the arguments */
+ movl %ecx,%eax
+ incl %eax
+ shll $2,%eax
+ addl %esp,%eax
+ andl $0xfffffff8,%esp /* Align stack */
+
+ movl %eax,operatingsystem_parameter_envp /* Move the environment pointer */
+ movl %ecx,operatingsystem_parameter_argc /* Move the argument counter */
+ movl %ebx,operatingsystem_parameter_argv /* Move the argument pointer */
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+ pushl $_etext /* Initialize gmon */
+ pushl $_start
+ call monstartup
+ addl $8,%esp
+ pushl $_mcleanup
+ call atexit
+ addl $4,%esp
+
+ xorl %ebp,%ebp
+ call PASCALMAIN
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+_haltproc2: # GAS <= 2.15 bug: generates larger jump if a label is exported
+ movzwl operatingsystem_result,%ebx
+ pushl %ebx
+ call exit /* call libc exit, this will */
+ /* write the gmon.out */
+ xorl %eax,%eax
+ incl %eax /* eax=1, exit call */
+ popl %ebx
+ int $0x80
+ jmp _haltproc2
+
+.data
+___fpucw:
+ .long 0x1332
+
+.bss
+ .type ___fpc_brk_addr,@object
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+#
+# $Log: gprt0.as,v $
+# Revision 1.4 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.3 2002/09/07 16:01:20 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/linux/i386/gprt21.as b/rtl/linux/i386/gprt21.as
new file mode 100644
index 0000000000..28c92080ad
--- /dev/null
+++ b/rtl/linux/i386/gprt21.as
@@ -0,0 +1,138 @@
+#
+# $Id: gprt21.as,v 1.6 2004/07/03 21:50:31 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF startup code for Free Pascal
+#
+
+ .file "prt1.as"
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* First locate the start of the environment variables */
+ popl %esi
+ movl %eax,%edi
+
+ movl %esp,%ebx /* Points to the arguments */
+ movl %esi,%eax
+ incl %eax
+ shll $2,%eax
+ addl %esp,%eax
+ andl $0xfffffff8,%esp /* Align stack */
+
+ movl %eax,operatingsystem_parameter_envp /* Move the environment pointer */
+ movl %esi,operatingsystem_parameter_argc /* Move the argument counter */
+ movl %ebx,operatingsystem_parameter_argv /* Move the argument pointer */
+
+ movl %edi,%eax
+ xorl %ebp,%ebp
+ pushl %eax
+ pushl %esp
+ pushl %edx
+ pushl $_fini_dummy
+ pushl $_init_dummy
+ pushl %ebx
+ pushl %esi
+ pushl $cmain
+ call __libc_start_main
+ hlt
+
+/* fake main routine which will be run from libc */
+cmain:
+ /* save return address */
+ popl %eax
+ movl %eax,___fpc_ret
+ movl %ebx,___fpc_ret_ebx
+ movl %esi,___fpc_ret_esi
+ movl %edi,___fpc_ret_edi
+ pushl %eax
+
+ call __gmon_start__
+
+ /* start the program */
+ call PASCALMAIN
+ hlt
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ movzwl operatingsystem_result,%eax
+
+ movl ___fpc_ret,%edx /* return to libc */
+ movl ___fpc_ret_ebx,%ebx
+ movl ___fpc_ret_esi,%esi
+ movl ___fpc_ret_edi,%edi
+ push %edx
+_init_dummy:
+_fini_dummy:
+ ret
+
+ .globl __gmon_start__
+ .type __gmon_start__,@function
+__gmon_start__:
+ pushl %ebp
+ movl __monstarted,%eax
+ leal 0x1(%eax),%edx
+ movl %esp,%ebp
+ movl %edx,__monstarted
+ testl %eax,%eax
+ jnz .Lnomonstart
+ pushl $etext /* Initialize gmon */
+ pushl $_start
+ call monstartup
+ addl $8,%esp
+ pushl $_mcleanup
+ call atexit
+ addl $4,%esp
+.Lnomonstart:
+ movl %ebp,%esp
+ popl %ebp
+ ret
+
+.data
+ .align 4
+
+___fpc_ret: /* return address to libc */
+ .long 0
+___fpc_ret_ebx:
+ .long 0
+___fpc_ret_esi:
+ .long 0
+___fpc_ret_edi:
+ .long 0
+
+.bss
+ .lcomm __monstarted,4
+
+ .type ___fpc_brk_addr,@object
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+
+#
+# $Log: gprt21.as,v $
+# Revision 1.6 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.5 2004/03/10 20:38:59 peter
+# * only i386 needs cprt21 to link with glibc 2.1+
+#
+# Revision 1.4 2002/09/07 16:01:20 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/linux/i386/prt0.as b/rtl/linux/i386/prt0.as
new file mode 100644
index 0000000000..f134ca7030
--- /dev/null
+++ b/rtl/linux/i386/prt0.as
@@ -0,0 +1,105 @@
+#
+# $Id: prt0.as,v 1.5 2004/07/03 23:04:34 daniel Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2004 by Michael Van Canneyt, Peter Vreman,
+# & Daniel Mantione, members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF startup code for Free Pascal
+#
+# The code in this file is the default startup code, it is used unless
+# libc is linked in, profiling is enabled or you are compiling a shared
+# library.
+#
+#
+# Stack layout at program start:
+#
+# nil
+# envn
+# ....
+# .... ENVIRONMENT VARIABLES
+# env1
+# env0
+# nil
+# argn
+# ....
+# .... COMMAND LINE OPTIONS
+# arg1
+# arg0
+# argc <--- esp
+#
+
+ .file "prt0.as"
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* First locate the start of the environment variables */
+ popl %ecx /* Get argc in ecx */
+ movl %esp,%ebx /* Esp now points to the arguments */
+ leal 4(%esp,%ecx,4),%eax /* The start of the environment is: esp+4*eax+4 */
+ andl $0xfffffff8,%esp /* Align stack */
+
+ leal operatingsystem_parameters,%edi
+ stosl /* Move the environment pointer */
+ xchg %ecx,%eax
+ stosl /* Move the argument counter */
+ xchg %ebx,%eax
+ stosl /* Move the argument pointer */
+
+
+ fninit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+ xorl %ebp,%ebp
+ call PASCALMAIN
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+_haltproc2: # GAS <= 2.15 bug: generates larger jump if a label is exported
+ xorl %eax,%eax
+ incl %eax /* eax=1, exit call */
+ movzwl operatingsystem_result,%ebx
+ int $0x80
+ jmp _haltproc2
+
+.data
+___fpucw:
+ .long 0x1332
+
+
+.bss
+ .type ___fpc_brk_addr,@object
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+operatingsystem_parameters:
+ .skip 3*4
+
+ .global operatingsystem_parameter_envp
+ .global operatingsystem_parameter_argc
+ .global operatingsystem_parameter_argv
+ .set operatingsystem_parameter_envp,operatingsystem_parameters+0
+ .set operatingsystem_parameter_argc,operatingsystem_parameters+4
+ .set operatingsystem_parameter_argv,operatingsystem_parameters+8
+#
+# $Log: prt0.as,v $
+# Revision 1.5 2004/07/03 23:04:34 daniel
+# * Updated comments
+#
+# Revision 1.4 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.3 2002/09/07 16:01:20 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/linux/i386/sighnd.inc b/rtl/linux/i386/sighnd.inc
new file mode 100644
index 0000000000..be5ae5e4bb
--- /dev/null
+++ b/rtl/linux/i386/sighnd.inc
@@ -0,0 +1,95 @@
+{
+ $Id: sighnd.inc,v 1.8 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+const
+ FPU_All = $7f;
+
+function GetFPUState(const SigContext : TSigContext) : longint;
+begin
+ if assigned(SigContext.fpstate) then
+ GetfpuState:=SigContext.fpstate^.sw;
+{$ifdef SYSTEM_DEBUG}
+ writeln('xx:',sigcontext.en_tw,' ',sigcontext.en_cw);
+{$endif SYSTEM_DEBUG}
+{$ifdef SYSTEM_DEBUG}
+ Writeln(stderr,'FpuState = ',GetFpuState);
+{$endif SYSTEM_DEBUG}
+end;
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+ res,fpustate : word;
+begin
+ res:=0;
+ case sig of
+ SIGFPE :
+ begin
+ { this is not allways necessary but I don't know yet
+ how to tell if it is or not PM }
+ res:=200;
+ fpustate:=GetFPUState(SigContext^);
+ if (FpuState and FPU_All) <> 0 then
+ begin
+ { first check the more precise options }
+ if (FpuState and FPU_DivisionByZero)<>0 then
+ res:=200
+ else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
+ res:=207
+ else if (FpuState and FPU_Overflow)<>0 then
+ res:=205
+ else if (FpuState and FPU_Underflow)<>0 then
+ res:=206
+ else if (FpuState and FPU_Denormal)<>0 then
+ res:=216
+ else
+ res:=207; {'Coprocessor Error'}
+ end;
+ sysResetFPU;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ reenable_signal(sig);
+{ give runtime error at the position where the signal was raised }
+ if res<>0 then
+ HandleErrorAddrFrame(res,pointer(SigContext^.eip),pointer(SigContext^.ebp));
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.8 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.7 2005/02/17 18:05:57 peter
+ * change order of if to prevent always stack overflow instead
+ of generic fpu error when multiple states are set
+
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.5 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/linux/i386/sighndh.inc b/rtl/linux/i386/sighndh.inc
new file mode 100644
index 0000000000..ffd7137c23
--- /dev/null
+++ b/rtl/linux/i386/sighndh.inc
@@ -0,0 +1,70 @@
+{
+ $Id: sighndh.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ Sigcontext and Sigaction
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+ tfpreg = record
+ significand: array[0..3] of word;
+ exponent: word;
+ end;
+
+ pfpstate = ^tfpstate;
+ tfpstate = record
+ cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
+ st: array[0..7] of tfpreg;
+ status: cardinal;
+ end;
+
+ PSigContext = ^TSigContext;
+ TSigContext = record
+ gs, __gsh: word;
+ fs, __fsh: word;
+ es, __esh: word;
+ ds, __dsh: word;
+ edi: cardinal;
+ esi: cardinal;
+ ebp: cardinal;
+ esp: cardinal;
+ ebx: cardinal;
+ edx: cardinal;
+ ecx: cardinal;
+ eax: cardinal;
+ trapno: cardinal;
+ err: cardinal;
+ eip: cardinal;
+ cs, __csh: word;
+ eflags: cardinal;
+ esp_at_signal: cardinal;
+ ss, __ssh: word;
+ fpstate: pfpstate;
+ oldmask: cardinal;
+ cr2: cardinal;
+ end;
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/i386/stat.inc b/rtl/linux/i386/stat.inc
new file mode 100644
index 0000000000..f9dcb08f10
--- /dev/null
+++ b/rtl/linux/i386/stat.inc
@@ -0,0 +1,123 @@
+{
+ $Id: stat.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef FPC_USE_LIBC} // kernel record
+
+ Stat = Packed Record // No unix typing because of differences
+ // kernel <->libc
+ case byte of
+ 0: (st_dev : word;
+ pad1 : word;
+ st_ino : longint;
+ st_mode,
+ st_nlink,
+ st_uid,
+ st_gid : word;
+ st_rdev : word;
+ pad2 : word;
+ st_size,
+ st_blksze,
+ st_blocks,
+ st_atime,
+ unused1,
+ st_mtime,
+ unused2,
+ st_ctime,
+ unused3,
+ unused4,
+ unused5 : longint;);
+ 1: (
+ dev : word;
+ pad1_dummy : word;
+ ino : longint;
+ mode,
+ nlink,
+ uid,
+ gid : word;
+ rdev : word;
+ pad2_dummy : word;
+ size,
+ blksze,
+ blocks,
+ atime,
+ unused1_dummy,
+ mtime,
+ unused2_dummy,
+ ctime,
+ unused3_dummy,
+ unused4_dummy,
+ unused5_dummy : longint;
+ );
+ end;
+{$else}
+
+{$packrecords C}
+ Stat = Record // No unix typing because of differences
+ // kernel <->libc
+ case byte of
+ 0: (st_dev : int64;
+ pad1 : word;
+ st_ino : longint;
+ st_mode,
+ st_nlink,
+ st_uid,
+ st_gid : longint;
+ st_rdev : int64;
+ pad2 : word;
+ st_size,
+ st_blksze,
+ st_blocks,
+ st_atime,
+ unused1,
+ st_mtime,
+ unused2,
+ st_ctime,
+ unused3,
+ unused4,
+ unused5 : longint;);
+ 1: (
+ dev : int64;
+ pad1_dummy : word;
+ ino : longint;
+ mode,
+ nlink,
+ uid,
+ gid : longint;
+ rdev : int64;
+ pad2_dummy : word;
+ size,
+ blksze,
+ blocks,
+ atime,
+ unused1_dummy,
+ mtime,
+ unused2_dummy,
+ ctime,
+ unused3_dummy,
+ unused4_dummy,
+ unused5_dummy : longint;
+
+ );
+ end;
+
+
+{$endif}
+
+{
+ $Log: stat.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/i386/syscall.inc b/rtl/linux/i386/syscall.inc
new file mode 100644
index 0000000000..b4fb348deb
--- /dev/null
+++ b/rtl/linux/i386/syscall.inc
@@ -0,0 +1,368 @@
+{
+ $Id: syscall.inc,v 1.18 2005/03/07 08:27:57 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ The syscalls for the new RTL, moved to platform dependant dir.
+ Old linux calling convention is stil kept.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$ASMMODE ATT}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL0'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL1'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ movl param1,%ebx
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif} [public,alias:'FPC_SYSCALL2'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ movl param1,%ebx
+ movl param2,%ecx
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif} [public,alias:'FPC_SYSCALL3'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ movl param1,%ebx
+ movl param2,%ecx
+ movl param3,%edx
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif} [public,alias:'FPC_SYSCALL4'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ movl param1,%ebx
+ movl param2,%ecx
+ movl param3,%edx
+ movl param4,%esi
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL5'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ movl param1,%ebx
+ movl param2,%ecx
+ movl param3,%edx
+ movl param4,%esi
+ movl param5,%edi
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+
+{$ifdef notsupported}
+{ Only 5 params are pushed, so it'll not work as expected (PFV) }
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler; {$ifndef VER1_0} oldfpccall; {$endif}[public,alias:'FPC_SYSCALL6'];
+
+asm
+{ load the registers... }
+ movl sysnr,%eax
+ movl param1,%ebx
+ movl param2,%ecx
+ movl param3,%edx
+ movl param4,%esi
+ movl param5,%edi
+ int $0x80
+ cmpl $-4095,%eax
+ jb .LSyscOK
+ negl %eax
+{$ifdef VER1_0}
+ movl %eax,Errno
+{$else}
+{$ifdef REGCALL}
+ movl fpc_threadvar_relocate_proc,%ecx
+ testl %ecx,%ecx
+ jne .LThread
+ movl %eax,Errno+4
+ jmp .LNoThread
+.LThread:
+ movl %eax,%ebx
+ movl Errno,%eax
+ call *%ecx
+ movl %ebx,(%eax)
+.LNoThread:
+{$else}
+ movl %eax,%edx
+ movl fpc_threadvar_relocate_proc,%eax
+ testl %eax,%eax
+ jne .LThread
+ movl %edx,Errno+4
+ jmp .LNoThread
+.LThread:
+ pushl %edx
+ pushl Errno
+ call *%eax
+ popl %edx
+ movl %edx,(%eax)
+.LNoThread:
+{$endif REGCALL}
+{$endif ver1_0}
+ movl $-1,%eax
+.LSyscOK:
+end;
+{$endif notsupported}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+ {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.18 2005/03/07 08:27:57 florian
+ * applied syscall patch from C Western
+
+ Revision 1.17 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/linux/i386/syscallh.inc b/rtl/linux/i386/syscallh.inc
new file mode 100644
index 0000000000..4fe2e8e636
--- /dev/null
+++ b/rtl/linux/i386/syscallh.inc
@@ -0,0 +1,52 @@
+{
+ $Id: syscallh.inc,v 1.7 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for i386 *BSD.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+
+ TSysResult = longint; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+ TSysParam = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';
+{$ifdef notsupported}
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL6';
+{$endif notsupported}
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.7 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/i386/sysnr.inc b/rtl/linux/i386/sysnr.inc
new file mode 100644
index 0000000000..81d9e68bdf
--- /dev/null
+++ b/rtl/linux/i386/sysnr.inc
@@ -0,0 +1,267 @@
+{
+ $Id: sysnr.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Syscall nrs for 2.4.18
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+
+Const
+ syscall_nr_exit = 1;
+ syscall_nr_fork = 2;
+ syscall_nr_read = 3;
+ syscall_nr_write = 4;
+ syscall_nr_open = 5;
+ syscall_nr_close = 6;
+ syscall_nr_waitpid = 7;
+ syscall_nr_creat = 8;
+ syscall_nr_link = 9;
+ syscall_nr_unlink = 10;
+ syscall_nr_execve = 11;
+ syscall_nr_chdir = 12;
+ syscall_nr_time = 13;
+ syscall_nr_mknod = 14;
+ syscall_nr_chmod = 15;
+ syscall_nr_lchown = 16;
+ syscall_nr_break = 17;
+ syscall_nr_oldstat = 18;
+ syscall_nr_lseek = 19;
+ syscall_nr_getpid = 20;
+ syscall_nr_mount = 21;
+ syscall_nr_umount = 22;
+ syscall_nr_setuid = 23;
+ syscall_nr_getuid = 24;
+ syscall_nr_stime = 25;
+ syscall_nr_ptrace = 26;
+ syscall_nr_alarm = 27;
+ syscall_nr_oldfstat = 28;
+ syscall_nr_pause = 29;
+ syscall_nr_utime = 30;
+ syscall_nr_stty = 31;
+ syscall_nr_gtty = 32;
+ syscall_nr_access = 33;
+ syscall_nr_nice = 34;
+ syscall_nr_ftime = 35;
+ syscall_nr_sync = 36;
+ syscall_nr_kill = 37;
+ syscall_nr_rename = 38;
+ syscall_nr_mkdir = 39;
+ syscall_nr_rmdir = 40;
+ syscall_nr_dup = 41;
+ syscall_nr_pipe = 42;
+ syscall_nr_times = 43;
+ syscall_nr_prof = 44;
+ syscall_nr_brk = 45;
+ syscall_nr_setgid = 46;
+ syscall_nr_getgid = 47;
+ syscall_nr_signal = 48;
+ syscall_nr_geteuid = 49;
+ syscall_nr_getegid = 50;
+ syscall_nr_acct = 51;
+ syscall_nr_umount2 = 52;
+ syscall_nr_lock = 53;
+ syscall_nr_ioctl = 54;
+ syscall_nr_fcntl = 55;
+ syscall_nr_mpx = 56;
+ syscall_nr_setpgid = 57;
+ syscall_nr_ulimit = 58;
+ syscall_nr_oldolduname = 59;
+ syscall_nr_umask = 60;
+ syscall_nr_chroot = 61;
+ syscall_nr_ustat = 62;
+ syscall_nr_dup2 = 63;
+ syscall_nr_getppid = 64;
+ syscall_nr_getpgrp = 65;
+ syscall_nr_setsid = 66;
+ syscall_nr_sigaction = 67;
+ syscall_nr_sgetmask = 68;
+ syscall_nr_ssetmask = 69;
+ syscall_nr_setreuid = 70;
+ syscall_nr_setregid = 71;
+ syscall_nr_sigsuspend = 72;
+ syscall_nr_sigpending = 73;
+ syscall_nr_sethostname = 74;
+ syscall_nr_setrlimit = 75;
+ syscall_nr_getrlimit = 76; { Back compatible 2Gig limited rlimit }
+ syscall_nr_getrusage = 77;
+ syscall_nr_gettimeofday = 78;
+ syscall_nr_settimeofday = 79;
+ syscall_nr_getgroups = 80;
+ syscall_nr_setgroups = 81;
+ syscall_nr_select = 82;
+ syscall_nr_symlink = 83;
+ syscall_nr_oldlstat = 84;
+ syscall_nr_readlink = 85;
+ syscall_nr_uselib = 86;
+ syscall_nr_swapon = 87;
+ syscall_nr_reboot = 88;
+ syscall_nr_readdir = 89;
+ syscall_nr_mmap = 90;
+ syscall_nr_munmap = 91;
+ syscall_nr_truncate = 92;
+ syscall_nr_ftruncate = 93;
+ syscall_nr_fchmod = 94;
+ syscall_nr_fchown = 95;
+ syscall_nr_getpriority = 96;
+ syscall_nr_setpriority = 97;
+ syscall_nr_profil = 98;
+ syscall_nr_statfs = 99;
+ syscall_nr_fstatfs = 100;
+ syscall_nr_ioperm = 101;
+ syscall_nr_socketcall = 102;
+ syscall_nr_syslog = 103;
+ syscall_nr_setitimer = 104;
+ syscall_nr_getitimer = 105;
+ syscall_nr_stat = 106;
+ syscall_nr_lstat = 107;
+ syscall_nr_fstat = 108;
+ syscall_nr_olduname = 109;
+ syscall_nr_iopl = 110;
+ syscall_nr_vhangup = 111;
+ syscall_nr_idle = 112;
+ syscall_nr_vm86old = 113;
+ syscall_nr_wait4 = 114;
+ syscall_nr_swapoff = 115;
+ syscall_nr_sysinfo = 116;
+ syscall_nr_ipc = 117;
+ syscall_nr_fsync = 118;
+ syscall_nr_sigreturn = 119;
+ syscall_nr_clone = 120;
+ syscall_nr_setdomainname = 121;
+ syscall_nr_uname = 122;
+ syscall_nr_modify_ldt = 123;
+ syscall_nr_adjtimex = 124;
+ syscall_nr_mprotect = 125;
+ syscall_nr_sigprocmask = 126;
+ syscall_nr_create_module = 127;
+ syscall_nr_init_module = 128;
+ syscall_nr_delete_module = 129;
+ syscall_nr_get_kernel_syms = 130;
+ syscall_nr_quotactl = 131;
+ syscall_nr_getpgid = 132;
+ syscall_nr_fchdir = 133;
+ syscall_nr_bdflush = 134;
+ syscall_nr_sysfs = 135;
+ syscall_nr_personality = 136;
+ syscall_nr_afs_syscall = 137; { Syscall for Andrew File System }
+ syscall_nr_setfsuid = 138;
+ syscall_nr_setfsgid = 139;
+ syscall_nr__llseek = 140;
+ syscall_nr_getdents = 141;
+ syscall_nr__newselect = 142;
+ syscall_nr_flock = 143;
+ syscall_nr_msync = 144;
+ syscall_nr_readv = 145;
+ syscall_nr_writev = 146;
+ syscall_nr_getsid = 147;
+ syscall_nr_fdatasync = 148;
+ syscall_nr__sysctl = 149;
+ syscall_nr_mlock = 150;
+ syscall_nr_munlock = 151;
+ syscall_nr_mlockall = 152;
+ syscall_nr_munlockall = 153;
+ syscall_nr_sched_setparam = 154;
+ syscall_nr_sched_getparam = 155;
+ syscall_nr_sched_setscheduler = 156;
+ syscall_nr_sched_getscheduler = 157;
+ syscall_nr_sched_yield = 158;
+ syscall_nr_sched_get_priority_max = 159;
+ syscall_nr_sched_get_priority_min = 160;
+ syscall_nr_sched_rr_get_interval = 161;
+ syscall_nr_nanosleep = 162;
+ syscall_nr_mremap = 163;
+ syscall_nr_setresuid = 164;
+ syscall_nr_getresuid = 165;
+ syscall_nr_vm86 = 166;
+ syscall_nr_query_module = 167;
+ syscall_nr_poll = 168;
+ syscall_nr_nfsservctl = 169;
+ syscall_nr_setresgid = 170;
+ syscall_nr_getresgid = 171;
+ syscall_nr_prctl = 172;
+ syscall_nr_rt_sigreturn = 173;
+ syscall_nr_rt_sigaction = 174;
+ syscall_nr_rt_sigprocmask = 175;
+ syscall_nr_rt_sigpending = 176;
+ syscall_nr_rt_sigtimedwait = 177;
+ syscall_nr_rt_sigqueueinfo = 178;
+ syscall_nr_rt_sigsuspend = 179;
+ syscall_nr_pread = 180;
+ syscall_nr_pwrite = 181;
+ syscall_nr_chown = 182;
+ syscall_nr_getcwd = 183;
+ syscall_nr_capget = 184;
+ syscall_nr_capset = 185;
+ syscall_nr_sigaltstack = 186;
+ syscall_nr_sendfile = 187;
+ syscall_nr_getpmsg = 188; { some people actually want streams }
+ syscall_nr_putpmsg = 189; { some people actually want streams }
+ syscall_nr_vfork = 190;
+ syscall_nr_ugetrlimit = 191; { SuS compliant getrlimit }
+ syscall_nr_mmap2 = 192;
+ syscall_nr_truncate64 = 193;
+ syscall_nr_ftruncate64 = 194;
+ syscall_nr_stat64 = 195;
+ syscall_nr_lstat64 = 196;
+ syscall_nr_fstat64 = 197;
+ syscall_nr_lchown32 = 198;
+ syscall_nr_getuid32 = 199;
+ syscall_nr_getgid32 = 200;
+ syscall_nr_geteuid32 = 201;
+ syscall_nr_getegid32 = 202;
+ syscall_nr_setreuid32 = 203;
+ syscall_nr_setregid32 = 204;
+ syscall_nr_getgroups32 = 205;
+ syscall_nr_setgroups32 = 206;
+ syscall_nr_fchown32 = 207;
+ syscall_nr_setresuid32 = 208;
+ syscall_nr_getresuid32 = 209;
+ syscall_nr_setresgid32 = 210;
+ syscall_nr_getresgid32 = 211;
+ syscall_nr_chown32 = 212;
+ syscall_nr_setuid32 = 213;
+ syscall_nr_setgid32 = 214;
+ syscall_nr_setfsuid32 = 215;
+ syscall_nr_setfsgid32 = 216;
+ syscall_nr_pivot_root = 217;
+ syscall_nr_mincore = 218;
+ syscall_nr_madvise = 219;
+ syscall_nr_madvise1 = 219; { delete when C lib stub is removed }
+ syscall_nr_getdents64 = 220;
+ syscall_nr_fcntl64 = 221;
+ syscall_nr_security = 223; { syscall for security modules }
+ syscall_nr_gettid = 224;
+ syscall_nr_readahead = 225;
+ syscall_nr_setxattr = 226;
+ syscall_nr_lsetxattr = 227;
+ syscall_nr_fsetxattr = 228;
+ syscall_nr_getxattr = 229;
+ syscall_nr_lgetxattr = 230;
+ syscall_nr_fgetxattr = 231;
+ syscall_nr_listxattr = 232;
+ syscall_nr_llistxattr = 233;
+ syscall_nr_flistxattr = 234;
+ syscall_nr_removexattr = 235;
+ syscall_nr_lremovexattr = 236;
+ syscall_nr_fremovexattr = 237;
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/ipccall.inc b/rtl/linux/ipccall.inc
new file mode 100644
index 0000000000..c96cb14e96
--- /dev/null
+++ b/rtl/linux/ipccall.inc
@@ -0,0 +1,125 @@
+{
+ $Id: ipccall.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Linux IPC implemented with ipccall
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+{ The following definitions come from linux/ipc.h }
+
+Function ftok (Path : pchar; ID : cint) : TKey;
+Var Info : TStat;
+begin
+ If fpstat(path,info)<0 then
+ ftok:=-1
+ else
+ begin
+ ftok:= (info.st_ino and $FFFF) or ((info.st_dev and $ff) shl 16) or (byte(ID) shl 24)
+ end;
+end;
+
+Const
+ CALL_SEMOP = 1;
+ CALL_SEMGET = 2;
+ CALL_SEMCTL = 3;
+ CALL_MSGSND = 11;
+ CALL_MSGRCV = 12;
+ CALL_MSGGET = 13;
+ CALL_MSGCTL = 14;
+ CALL_SHMAT = 21;
+ CALL_SHMDT = 22;
+ CALL_SHMGET = 23;
+ CALL_SHMCTL = 24;
+
+{ generic call that handles all IPC calls }
+
+function ipccall(Call,First,Second,Third : cint; P : Pointer) : cint;
+begin
+ ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,cint(P));
+// ipcerror:=fpgetErrno;
+end;
+
+function shmget(key: Tkey; size:cint; flag:cint):cint;
+begin
+ shmget:=ipccall (CALL_SHMGET,key,size,flag,nil);
+end;
+
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+Var raddr : pchar;
+ error : cint;
+begin
+ error:=ipccall(CALL_SHMAT,shmid,shmflg,cint(@raddr),shmaddr);
+ If Error<0 then
+ shmat:=pchar(error)
+ else
+ shmat:=raddr;
+end;
+
+function shmdt (shmaddr:pointer): cint;
+begin
+ shmdt:=ipccall(CALL_SHMDT,0,0,0,shmaddr);
+end;
+
+function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+begin
+ shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf);
+end;
+
+function msgget(key:Tkey; msgflg:cint):cint;
+begin
+ msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil);
+end;
+
+function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint):cint;
+begin
+ msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp);
+end;
+
+function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Type
+ TIPC_Kludge = Record
+ msgp : pmsgbuf;
+ msgtyp : cint;
+ end;
+Var
+ tmp : TIPC_Kludge;
+begin
+ tmp.msgp := msgp;
+ tmp.msgtyp := msgtyp;
+ msgrcv:=ipccall(CALL_MSGRCV,msqid,msgsz,msgflg,@tmp);
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+ msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf);
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+ semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil);
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops:cuint): cint;
+begin
+ semop:=ipccall (CALL_SEMOP,semid,cint(nsops),0,Pointer(sops));
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+ semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg);
+end;
+
+{
+ $Log: ipccall.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/ipcsys.inc b/rtl/linux/ipcsys.inc
new file mode 100644
index 0000000000..102e26cdd9
--- /dev/null
+++ b/rtl/linux/ipcsys.inc
@@ -0,0 +1,107 @@
+{
+ $Id: ipcsys.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Ipc body implemented using direct linux syscalls
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+
+Function ftok (Path : pchar; ID : cint) : TKey;
+Var Info : TStat;
+begin
+ If fpstat(path,info)<0 then
+ ftok:=-1
+ else
+ begin
+ ftok:= (info.st_ino and $FFFF) or ((info.st_dev and $ff) shl 16) or (byte(ID) shl 24)
+ end;
+end;
+
+
+function shmget(key: Tkey; size:cint; flag:cint):cint;
+begin
+ shmget:=do_syscall (syscall_nr_SHMGET,TSysParam(key),TSysParam(size),TSysParam(flag),TSysParam(0));
+end;
+
+function shmat (shmid:cint; shmaddr:pointer; shmflg:cint): pointer;
+Var raddr : pointer;
+ error : ptrint;
+begin
+ error:=do_syscall(syscall_nr_SHMAT,TSysParam(shmid),TSysParam(shmflg),TSysParam(@raddr),TSysParam(shmaddr));
+ If Error<0 then
+ shmat:=pointer(error)
+ else
+ shmat:=raddr;
+end;
+
+function shmdt (shmaddr:pointer): cint;
+begin
+ shmdt:=do_syscall(syscall_nr_SHMDT,TSysParam(0),TSysParam(0),TSysParam(0),TSysParam(shmaddr));
+end;
+
+function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+begin
+ shmctl:=do_syscall(syscall_nr_SHMCTL,TSysParam(shmid),TSysParam(cmd),TSysParam(0),TSysParam(buf));
+end;
+
+function msgget(key:Tkey; msgflg:cint):cint;
+begin
+ msgget:=do_syscall(syscall_nr_MSGGET,TSysParam(key),TSysParam(msgflg),TSysParam(0),TSysParam(0));
+end;
+
+function msgsnd(msqid:cint; msgp: pmsgbuf; msgsz: size_t; msgflg:cint):cint;
+begin
+ msgsnd:=do_syscall(syscall_nr_MSGSND,TSysParam(msqid),TSysParam(msgsz),TSysParam(msgflg),TSysParam(msgp));
+end;
+
+function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Type
+ TIPC_Kludge = Record
+ msgp : pmsgbuf;
+ msgtyp : cint;
+ end;
+Var
+ tmp : TIPC_Kludge;
+begin
+ tmp.msgp := msgp;
+ tmp.msgtyp := msgtyp;
+ msgrcv:=do_syscall(syscall_nr_MSGRCV,TSysParam(msqid),TSysParam(msgsz),TSysParam(msgflg),TSysParam(@tmp));
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+ msgctl:=do_syscall(syscall_nr_MSGCTL,TSysParam(msqid),TSysParam(cmd),TSysParam(0),TSysParam(buf));
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+ semget:=do_syscall (syscall_nr_SEMGET,TSysParam(key),TSysParam(nsems),TSysParam(semflg),TSysParam(0));
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops:cuint): cint;
+begin
+ semop:=do_syscall (syscall_nr_SEMOP,TSysParam(semid),TSysParam(nsops),TSysParam(0),TSysParam(sops));
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+ semctl:=do_syscall(syscall_nr_SEMCTL,TSysParam(semid),TSysParam(semnum),TSysParam(cmd),TSysParam(@arg));
+end;
+
+{
+ $Log: ipcsys.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
+
diff --git a/rtl/linux/m68k/bsyscall.inc b/rtl/linux/m68k/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/linux/m68k/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/linux/m68k/prt0.as b/rtl/linux/m68k/prt0.as
new file mode 100644
index 0000000000..576f401ffb
--- /dev/null
+++ b/rtl/linux/m68k/prt0.as
@@ -0,0 +1,26 @@
+.file "prt0.as"
+ .text
+ .globl __entry
+__entry:
+ movel sp@(8),d0
+ movel d0,U_SYSLINUX_ENVP
+ movel sp@(4),d0
+ movel d0,U_SYSLINUX_ARGV
+ movel sp@,d0
+ movel d0,U_SYSLINUX_ARGC
+ jsr PASCALMAIN
+
+ .globl _haltproc
+_haltproc:
+ moveq #1,d0
+ movel U_SYSLINUX_EXITCODE,d1
+ trap #0
+ bras _haltproc
+
+
+ .data
+ .align 4
+ .globl ___fpc_brk_addr
+___fpc_brk_addr:
+ .long 0
+
diff --git a/rtl/linux/m68k/prt1.as b/rtl/linux/m68k/prt1.as
new file mode 100644
index 0000000000..81d79d0538
--- /dev/null
+++ b/rtl/linux/m68k/prt1.as
@@ -0,0 +1,39 @@
+.file "prt0.as"
+ .text
+ .globl __entry
+ .globl _start
+ .globl __start
+__entry:
+_start:
+__start:
+ movel (sp)+, d0
+ lea (4,sp,d0*4),a0
+ movel a0, U_SYSLINUX_ENVP
+ movel sp,U_SYSLINUX_ARGV
+ movel d0,U_SYSLINUX_ARGC
+/*
+ movel d0,U_SYSLINUX_ENVP
+ movel 4(sp),d0
+ movel d0,U_SYSLINUX_ARGV
+ movel (sp),d0
+ movel d0,U_SYSLINUX_ARGC */
+ jsr PASCALMAIN
+
+ .globl _haltproc
+ .globl _HALTPROC
+_haltproc:
+_HALTPROC:
+ moveq #1,d0
+ movew U_SYSLINUX_EXITCODE,d1
+ trap #0
+ bra _haltproc
+
+
+ .data
+ .align 4
+ .globl ___FPC_BRK_ADDR
+ .globl ___fpc_brk_addr
+___fpc_brk_addr:
+___FPC_BRK_ADDR:
+ .long 0
+
diff --git a/rtl/linux/m68k/stat.inc b/rtl/linux/m68k/stat.inc
new file mode 100644
index 0000000000..aba7ebd4e1
--- /dev/null
+++ b/rtl/linux/m68k/stat.inc
@@ -0,0 +1,68 @@
+{
+ $Id: stat.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ Stat = Packed Record // No unix typing because of differences
+ // kernel <->libc
+ case byte of
+ 0: (st_dev : word;
+ pad1 : word;
+ st_ino : longint;
+ st_mode,
+ nlink,
+ uid,
+ gid : word;
+ rdev : word;
+ pad2 : word;
+ st_size,
+ st_blksze,
+ st_blocks,
+ st_atime,
+ unused1,
+ st_mtime,
+ unused2,
+ st_ctime,
+ unused3,
+ unused4,
+ unused5 : longint;);
+ 1: (
+ dev : word;
+ pad1_dummy : word;
+ ino : longint;
+ mode,
+ nlink_dummy,
+ uid_dummy,
+ gid_dummy : word;
+ rdev_dummy : word;
+ pad2_dummy : word;
+ size,
+ blksze,
+ blocks,
+ atime,
+ unused1_dummy,
+ mtime,
+ unused2_dummy,
+ ctime,
+ unused3_dummy,
+ unused4_dummy,
+ unused5_dummy : longint;
+ );
+ end;
+
+{
+ $Log: stat.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/osdefs.inc b/rtl/linux/osdefs.inc
new file mode 100644
index 0000000000..94ff5f7a32
--- /dev/null
+++ b/rtl/linux/osdefs.inc
@@ -0,0 +1,49 @@
+{
+ $Id: osdefs.inc,v 1.3 2005/02/14 17:29:06 peter Exp $
+ Copyright (c) 2000-2002 by Marco van de Voort
+
+ Target dependent defines used when compileing the baseunix unit
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+{$ifndef cpux86_64}
+ {$define usestime} // Use stime() syscall instead of settimeofday
+{$endif}
+{$define oldreaddir} // Keep using readdir system call instead
+ // of userland getdents stuff.
+{$define usedomain} // Allow uname with "domain" entry.
+ // (which is a GNU extension)
+{$ifdef FPC_USE_LIBC}
+ {$define usegetcwd}
+{$endif}
+
+
+{
+ $Log: osdefs.inc,v $
+ Revision 1.3 2005/02/14 17:29:06 peter
+ * no stime for x86_64
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.1 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/linux/osmacro.inc b/rtl/linux/osmacro.inc
new file mode 100644
index 0000000000..b29f4d0df3
--- /dev/null
+++ b/rtl/linux/osmacro.inc
@@ -0,0 +1,103 @@
+{
+ $Id: osmacro.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2000-2002 by Marco van de Voort
+
+ The "linux" posixy macro's that are used both in the Baseunx unit as the
+ system unit. Not aliased via public names because I want these to be
+ inlined as much as possible in the future.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by the
+ Free Software Foundation; either version 2 of the License, or (at your
+ option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program; if not, write to the Free Software Foundation, Inc.,
+ 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+function FpS_ISDIR(m : TMode): boolean;
+
+begin
+ FpS_ISDIR:=((m and S_IFMT) = S_IFDIR);
+end;
+
+function FpS_ISCHR(m : TMode): boolean;
+begin
+ FpS_ISCHR:=((m and S_IFMT) = S_IFCHR);
+end;
+
+function FpS_ISBLK(m : TMode): boolean;
+begin
+ FpS_ISBLK:=((m and S_IFMT) = S_IFBLK);
+end;
+
+function FpS_ISREG(m : TMode): boolean;
+begin
+ FpS_ISREG:=((m and S_IFMT) = S_IFREG);
+end;
+
+function FpS_ISFIFO(m : TMode): boolean;
+begin
+ FpS_ISFIFO:=((m and S_IFMT) = S_IFIFO);
+end;
+
+Function FPS_ISLNK(m:TMode):boolean;
+
+begin
+ FPS_ISLNK:=((m and S_IFMT) = S_IFLNK);
+end;
+
+Function FPS_ISSOCK(m:TMode):boolean;
+
+begin
+ FPS_ISSOCK:=((m and S_IFMT) = S_IFSOCK);
+end;
+
+function wifexited(status : cint): boolean;
+begin
+ wifexited:=(status AND $7f) =0;
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=(status and $FF00) shr 8;
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=(status and $FF00) shr 8;
+end;
+
+const wstopped=127;
+
+function wifsignaled(status : cint): boolean;
+begin
+ wifsignaled:=((status and $FF)<>wstopped) and ((status and 127)<>0);
+end;
+
+function wtermsig(status : cint):cint;
+
+begin
+ wtermsig:=cint(status and 127);
+end;
+
+{
+ $Log: osmacro.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.4 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/linux/ossysc.inc b/rtl/linux/ossysc.inc
new file mode 100644
index 0000000000..b5853e5356
--- /dev/null
+++ b/rtl/linux/ossysc.inc
@@ -0,0 +1,497 @@
+{
+ $Id: ossysc.inc,v 1.36 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ The base Linux syscalls required to implement the system unit. These
+ are aliased for use in other units (to avoid poluting the system units
+ interface)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************
+}
+
+{*****************************************************************************
+ --- Main:The System Call Self ---
+*****************************************************************************}
+
+function Fptime(tloc:pTime): TTime; [public, alias : 'FPC_SYSC_TIME'];
+
+begin
+ Fptime:=do_syscall(syscall_nr_time,TSysParam(tloc));
+End;
+
+{*****************************************************************************
+ --- File:File handling related calls ---
+*****************************************************************************}
+
+function Fpopen(path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN'];
+
+Begin
+ Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode));
+End;
+
+function Fpclose(fd : cint): cint; [public, alias : 'FPC_SYSC_CLOSE'];
+
+begin
+ Fpclose:=do_syscall(syscall_nr_close,fd);
+end;
+
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; [public, alias : 'FPC_SYSC_LSEEK'];
+{
+Must be adapted/overloaded for 64-bit support, but that is a different call under
+Linux?
+}
+begin
+ Fplseek:=do_syscall(syscall_nr_lseek,tsysparam(fd),tsysparam(offset),tsysparam(whence));
+end;
+
+function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
+
+begin
+ Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes);
+end;
+
+function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
+
+begin
+ Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes);
+end;
+
+function Fpunlink(path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
+
+begin
+ Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path));
+end;
+
+function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
+
+begin
+ Fprename:=do_syscall(syscall_nr_rename,TSysParam(old),TSysParam(newpath));
+end;
+
+function Fpstat(path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT'];
+
+begin
+ Fpstat:=do_syscall(syscall_nr_stat,TSysParam(path),TSysParam(@buf));
+end;
+
+
+{*****************************************************************************
+ --- Directory:Directory related calls ---
+*****************************************************************************}
+
+function Fpchdir(path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR'];
+
+begin
+ Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path));
+end;
+
+function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
+
+begin
+ Fpmkdir:=do_syscall(syscall_nr_mkdir,TSysParam(path),TSysParam(mode));
+end;
+
+function Fprmdir(path : pchar): cint; [public, alias : 'FPC_SYSC_RMDIR'];
+
+begin
+ Fprmdir:=do_syscall(syscall_nr_rmdir,TSysParam(path));
+end;
+
+function Fpopendir(dirname : pchar): pdir; [public, alias : 'FPC_SYSC_OPENDIR'];
+
+var
+ fd:integer;
+ st:stat;
+ ptr:pdir;
+
+begin
+ Fpopendir:=nil;
+ if Fpstat(dirname,st)<0 then
+ exit;
+{ Is it a dir ? }
+ if not((st.st_mode and $f000)=$4000)then
+ begin
+ errno:=ESysENOTDIR;
+ exit
+ end;
+{ Open it}
+ fd:=Fpopen(dirname,O_RDONLY,438);
+ if fd<0 then
+ exit;
+ new(ptr);
+ if ptr=nil then
+ exit;
+ getmem(ptr^.dd_buf,sizeof(dirent));
+ if ptr^.dd_buf=nil then
+ exit;
+ ptr^.dd_fd:=fd;
+ ptr^.dd_loc:=0;
+ ptr^.dd_size:=0;
+ ptr^.dd_nextoff:=0;
+ ptr^.dd_max:=sizeof(ptr^.dd_buf^);
+ Fpopendir:=ptr;
+end;
+
+function Fpclosedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR'];
+
+begin
+ Fpclosedir:=Fpclose(dirp^.dd_fd);
+ freemem(dirp^.dd_buf,sizeof(dirent));
+ dispose(dirp);
+end;
+
+Function Fpreaddir(dirp : pdir) : pdirent; [public, alias: 'FPC_SYSC_READDIR'];
+var bytes : longint;
+ dp : pdirent;
+begin
+ repeat
+ if dirp^.dd_nextoff >= dirp^.dd_size then
+ begin
+ bytes := do_SysCall(SysCall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(dirp^.dd_buf),TSysParam(dirp^.dd_max));
+ if bytes <= 0 then
+ begin
+ fpreaddir := nil;
+ exit;
+ end;
+ dirp^.dd_size := bytes;
+ dirp^.dd_nextoff := 0;
+ end;
+ dp := pdirent(ptrint(dirp^.dd_buf)+dirp^.dd_nextoff);
+ inc(dirp^.dd_nextoff,dp^.d_reclen);
+ inc(dirp^.dd_loc,dp^.d_reclen);
+ until dp^.d_fileno <> 0; // Don't show deleted files
+ Fpreaddir := dp;
+end;
+
+
+{*****************************************************************************
+ --- Process:Process & program handling - related calls ---
+*****************************************************************************}
+
+procedure Fpexit(status : cint); [public, alias : 'FPC_SYSC_EXIT'];
+
+begin
+ do_syscall(syscall_nr_exit,status);
+end;
+
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+
+
+{$ifdef cpusparc}
+procedure Fprt_sigreturn_stub;assembler;nostackframe;
+asm
+ mov syscall_nr_rt_sigreturn,%g1
+ ta 0x10
+end;
+{$endif cpusparc}
+
+
+function Fpsigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+begin
+{$ifdef cpusparc}
+ { Sparc has an extra stub parameter }
+ Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(PtrInt(@Fprt_sigreturn_stub)-8),TSysParam(8));
+{$else cpusparc}
+ Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(8));
+{$endif cpusparc}
+end;
+
+
+function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+{ See notes lseek. This one is completely similar for the parameter (but
+doesn't have the returnvalue 64-bit problem)}
+
+begin
+ Fpftruncate:=Do_syscall(syscall_nr_ftruncate,TSysParam(fd),TSysParam(flength));
+end;
+
+function Fpfstat(fd : cint; var sb : stat): cint; [public, alias : 'FPC_SYSC_FSTAT'];
+
+begin
+ FpFStat:=do_SysCall(syscall_nr_fstat,TSysParam(fd),TSysParam(@sb));
+end;
+
+
+{$ifndef FPC_SYSTEM_HAS_FPFORK}
+function Fpfork : pid_t; [public, alias : 'FPC_SYSC_FORK'];
+{
+ This function issues the 'fork' System call. the program is duplicated in memory
+ and Execution continues in parent and child process.
+ In the parent process, fork returns the PID of the child. In the child process,
+ zero is returned.
+ A negative value indicates that an error has occurred, the error is returned in
+ LinuxError.
+}
+
+Begin
+ Fpfork:=Do_syscall(SysCall_nr_fork);
+End;
+{$endif FPC_SYSTEM_HAS_FPFORK}
+
+// Look at execve variants later, when overloaded is determined.
+{
+function Fpexecve(path : pathstr; argv : ppchar; envp: ppchar): cint;
+}
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ environment specified in ep is passed on.
+}
+
+{
+Begin
+ path:=path+#0;
+ do_syscall(syscall_nr_Execve,TSysParam(@path[1]),TSysParam(Argv),TSysParam(envp));
+End;
+}
+{
+function Fpexecve(path : pchar; argv : ppchar; envp: ppchar): cint; [public, alias : 'FPC_SYSC_EXECVE'];
+}
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ environment specified in ep is passed on.
+}
+{
+Begin
+ do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(Argv),TSysParam(envp));
+End;
+}
+
+{$ifdef CPUARM}
+{$define WAIT4}
+{$endif CPUARM}
+
+{$ifdef CPUx86_64}
+{$define WAIT4}
+{$endif CPUx86_64}
+
+{$ifdef CPUSPARC}
+{$define WAIT4}
+{$endif CPUSPARC}
+
+
+function Fpwaitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; [public, alias : 'FPC_SYSC_WAITPID'];
+{
+ Waits until a child with PID Pid exits, or returns if it is exited already.
+ Any resources used by the child are freed.
+ The exit status is reported in the adress referred to by Status. It should
+ be a longint.
+}
+
+begin
+{$ifdef WAIT4}
+ FpWaitPID:=do_syscall(syscall_nr_Wait4,PID,TSysParam(Stat_loc),options,0);
+{$else WAIT4}
+ FpWaitPID:=do_syscall(syscall_nr_WaitPID,PID,TSysParam(Stat_loc),options);
+{$endif WAIT4}
+end;
+
+function Fpaccess(pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS'];
+{
+ Test users access rights on the specified file.
+ Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+ R,W,X stand for read,write and Execute access, simultaneously.
+ F_OK checks whether the test would be allowed on the file.
+ i.e. It checks the search permissions in all directory components
+ of the path.
+ The test is done with the real user-ID, instead of the effective.
+ If access is denied, or an error occurred, false is returned.
+ If access is granted, true is returned.
+ Errors other than no access,are reported in unixerror.
+}
+
+begin
+ FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode);
+end;
+
+(* overloaded
+function Fpaccess(pathname : pathstr; amode : cint): cint;
+
+{
+ Test users access rights on the specified file.
+ Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+ R,W,X stand for read,write and Execute access, simultaneously.
+ F_OK checks whether the test would be allowed on the file.
+ i.e. It checks the search permissions in all directory components
+ of the path.
+ The test is done with the real user-ID, instead of the effective.
+ If access is denied, or an error occurred, false is returned.
+ If access is granted, true is returned.
+ Errors other than no access,are reported in unixerror.
+}
+
+begin
+ pathname:=pathname+#0;
+ Access:=do_syscall(syscall_nr_access, TSysParam(@pathname[1]),mode)=0;
+end;
+*)
+
+Function FpDup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP'];
+
+begin
+ Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes));
+end;
+
+Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
+
+begin
+ Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
+end;
+
+
+type
+ tmmapargs = packed record
+ address : TSysParam;
+ size : TSysParam;
+ prot : TSysParam;
+ flags : TSysParam;
+ fd : TSysParam;
+ offset : TSysParam;
+ end;
+
+
+{$ifdef cpui386}
+{$define OLDMMAP}
+{$endif cpui386}
+
+{$ifdef cpum68k}
+{$define OLDMMAP}
+{$endif cpum68k}
+
+{$ifdef cpuarm}
+{$define OLDMMAP}
+{$endif cpuarm}
+
+
+Function Fpmmap(adr:pointer;len:size_t;prot:cint;flags:cint;fd:cint;off:off_t):pointer; [public, alias : 'FPC_SYSC_MMAP'];
+// OFF_T procedure, and returns a pointer, NOT cint.
+
+{$ifdef OLDMMAP}
+var
+ mmapargs : tmmapargs;
+begin
+ mmapargs.address:=TSysParam(adr);
+ mmapargs.size:=TSysParam(len);
+ mmapargs.prot:=TSysParam(prot);
+ mmapargs.flags:=TSysParam(flags);
+ mmapargs.fd:=TSysParam(fd);
+ mmapargs.offset:=TSysParam(off);
+ Fpmmap:=pointer(do_syscall(syscall_nr_mmap,TSysParam(@MMapArgs)));
+end;
+{$else OLDMMAP}
+begin
+ Fpmmap:= pointer(do_syscall(syscall_nr_mmap,TSysParam(adr),TSysParam(len),
+ TSysParam(prot),TSysParam(flags),TSysParam(fd),TSysParam(off)));
+end;
+{$endif OLDMMAP}
+
+
+Function Fpmunmap(adr:pointer;len:size_t):cint; [public, alias :'FPC_SYSC_MUNMAP'];
+begin
+ Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(Adr),TSysParam(Len));
+end;
+
+{
+ Interface to Unix ioctl call.
+ Performs various operations on the filedescriptor Handle.
+ Ndx describes the operation to perform.
+ Data points to data needed for the Ndx function. The structure of this
+ data is function-dependent.
+}
+
+// prototype is cint __P(cint,culong,....)
+// actual meaning of return value depends on request.
+
+Function FpIOCtl(fd:cint;request:culong;Data: Pointer):cint; [public, alias : 'FPC_SYSC_IOCTL'];
+// This was missing here, instead hardcoded in Do_IsDevice
+begin
+ FpIOCtl:=do_SysCall(syscall_nr_ioctl,tsysparam(fd),tsysparam(Request),TSysParam(data));
+end;
+
+
+Function FpGetPid:pid_t; [public, alias : 'FPC_SYSC_GETPID'];
+{
+ Get Process ID.
+}
+
+begin
+ FpGetPID:=do_syscall(syscall_nr_getpid);
+end;
+
+Function FpReadLink(name,linkname:pchar;maxlen:size_t):cint; [public, alias : 'FPC_SYSC_READLINK'];
+
+begin
+ Fpreadlink:=do_syscall(syscall_nr_readlink, TSysParam(name),TSysParam(linkname),maxlen);
+end;
+
+
+function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, alias : 'FPC_SYSC_SIGPROCMASK'];
+
+{
+ Change the list of currently blocked signals.
+ How determines which signals will be blocked :
+ SigBlock : Add SSet to the current list of blocked signals
+ SigUnBlock : Remove the signals in SSet from the list of blocked signals.
+ SigSetMask : Set the list of blocked signals to SSet
+ if OldSSet is non-null, the old set will be saved there.
+}
+
+begin
+ FPsigprocmask:=do_syscall(syscall_nr_rt_sigprocmask,TSysParam(how),TSysParam(nset),TSysParam(oset),TSysParam(8));
+end;
+
+
+Function FpNanoSleep(req : ptimespec;rem : ptimespec):cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
+begin
+ FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem));
+end;
+
+// The following belongs here, but this should be researched more.
+// function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD'];
+
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; [public, alias: 'FPC_SYSC_GETTIMEOFDAY'];
+
+begin
+ fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp));
+end;
+
+{
+ $Log: ossysc.inc,v $
+ Revision 1.36 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.35 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.34 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+ Revision 1.33 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.32 2005/01/31 20:13:24 peter
+ * rt_sigaction for all cpus
+
+ Revision 1.31 2005/01/31 19:22:48 peter
+ * i386 also needs rtsignal
+
+}
diff --git a/rtl/linux/ostypes.inc b/rtl/linux/ostypes.inc
new file mode 100644
index 0000000000..df7b5c6516
--- /dev/null
+++ b/rtl/linux/ostypes.inc
@@ -0,0 +1,313 @@
+{
+ $Id: ostypes.inc,v 1.12 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Types and structures for the BaseUnix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+{***********************************************************************}
+{ Base Unix Structures }
+{***********************************************************************}
+
+{$IFDEF FPC_IS_SYSTEM}
+ {$i ptypes.inc}
+{$ENDIF}
+
+
+CONST
+// SYS_NMLM = 65;
+ UTSNAME_LENGTH = SYS_NMLN;
+ UTSNAME_NODENAME_LENGTH = UTSNAME_LENGTH;
+ {$ifdef usedomain}
+ UTSNAME_DOMAIN_LENGTH = UTSNAME_LENGTH;
+ {$endif}
+
+ FD_MAXFDSET = 1024;
+ BITSINWORD = 8*sizeof(longint);
+ wordsinsigset = SIG_MAXSIG DIV BITSINWORD; // words in sigset_t
+ wordsinfdset = FD_MAXFDSET DIV BITSINWORD; // words in fdset_t
+ ln2bitsinword = 5; { 32bit : ln(32)/ln(2)=5 }
+ ln2bitmask = 1 shl ln2bitsinword - 1;
+
+
+TYPE
+ Blksize_t = cuint;
+ Blkcnt_t = cuint;
+ Ino64_t = cint64;
+ Off64_t = cint64;
+
+ TBlkSize = BlkSize_t;
+ PBlkSize = ^BlkSize_t;
+ TBlkCnt = Blkcnt_t;
+ PBlkCnt = ^Blkcnt_t;
+ TIno64 = Ino64_t;
+ PIno64 = ^Ino64_t;
+ TOff64 = Off64_t;
+ POff64 = ^Off64_t;
+
+ { system information services }
+ UtsName = Record
+ Sysname : Array[0..UTSNAME_LENGTH -1] OF Char; // Name of this OS
+ Nodename: Array[0..UTSNAME_NODENAME_LENGTH-1] OF Char; // Name of this network node.
+ Release : Array[0..UTSNAME_LENGTH -1] OF Char; // Release level.
+ Version : Array[0..UTSNAME_LENGTH -1] OF Char; // Version level.
+ Machine : Array[0..UTSNAME_LENGTH -1] OF Char; // Hardware type.
+ {$ifdef usedomain}
+ Domain : array[0..UTSNAME_DOMAIN_LENGTH-1] of char; // Linux addition "Domain"
+ {$endif}
+ end;
+ TUtsName = UtsName;
+ PUtsName = TUtsName;
+
+
+{ Definition of (kernel) stat type }
+{ see kernel/include/asm-<cpu>/stat.h, include/linux/types.h and }
+{ include /include/asm-<cpu>/posix-types.h }
+
+{$i stat.inc}
+
+ TStat = Stat;
+ PStat = ^Stat;
+
+
+{$ifdef notused} // 64-bit support needs some work still :-)
+ { file characteristics services }
+ stat64 = record
+ st_dev : dev_t; // inode's device
+ pad1 : cushort;
+ {$ifdef 64bitfs} // ??
+ __st_ino : ino_t;
+ {$else}
+ st_ino : ino_t; // inode's number
+ {$endif}
+ st_mode : mode_t; // inode protection mode
+ st_nlink : nlink_t; // number of hard links
+ st_uid : uid_t; // user ID of the file's owner
+ st_gid : gid_t; // group ID of the file's group
+ st_rdev : dev_t; // device type
+ pad2 : cushort;
+ {$ifdef 64bitfs}
+ st_size : off64_t; // file size, in bytes
+ {$else}
+ st_size : off_t; // file size, in bytes
+ {$endif}
+ st_blksize : blksize_t; // optimal blocksize for I/O
+ {$ifdef 64bitfs}
+ st_blocks : blkcnt64_t; // blocks allocated for file
+ {$else}
+ st_blocks : blkcnt_t; // blocks allocated for file
+ {$endif}
+ st_atime : time_t; // time of last access
+ unused1 : culong;
+ st_mtime : time_t; // time of last data modification
+ unused2 : culong;
+ st_ctime : time_t; // time of last file status change
+ unused3 : culong;
+ {$ifdef 64bitfs}
+ st_ino : ino64_t
+ {$else}
+ unused4 : culong;
+ unused5 : culong;
+ {$endif}
+ end;
+{$endif}
+
+ { directory services }
+
+ Dirent = packed record
+ {$ifndef 64bitfs}
+ d_fileno : ino_t; // file number of entry
+ d_off : off_t;
+ {$else}
+ d_fileno : ino64_t; // file number of entry
+ d_off : off64_t;
+ {$endif}
+ d_reclen : cushort; // length of string in d_name
+ {$ifdef Uselibc} // Libc different from kernel record!
+ d_type : cuchar; // file type, see below
+ {$endif}
+ d_name : array[0..(255 + 1)-1] of char; // name must be no longer than this
+ end;
+ TDirent = Dirent;
+ pDirent = ^Dirent;
+
+{$ifdef oldreaddir}
+ { Still old one. This is a userland struct}
+
+ Dir = record
+ dd_fd : integer;
+ dd_loc : longint;
+ dd_size : integer;
+ dd_buf : pdirent;
+ {The following are used in libc, but NOT in the linux kernel sources ??}
+ dd_nextoff: longint;
+ dd_max : integer; {size of buf. Irrelevant, as buf is of type dirent}
+ dd_lock : pointer;
+ end;
+{$else}
+ // new libc one. NOTE that off_t must be real, so 64-bit ifdef
+ // 64bitsfs
+ Dir = Record // packing doesn't matter. This is a userland struct.
+ fd : cint;
+ data : pchar;
+ allocation: size_t;
+ _size : size_t;
+ offset : size_t;
+ filepos : off_t;
+ end;
+{$endif}
+
+ TDir = Dir;
+ pDir = ^Dir;
+
+
+ UTimBuf = Record
+ actime : time_t;
+ modtime : time_t;
+ end;
+
+ TUtimBuf = UtimBuf;
+ pUtimBuf = ^UtimBuf;
+
+ FLock = Record
+ l_type : cshort; { lock type: read/write, etc. }
+ l_whence: cshort; { type of l_start }
+ {$ifdef 64bitfs}
+ l_start : off64_t; { starting offset }
+ l_len : off64_t; { len = 0 means until end of file }
+ {$else}
+ l_start : off_t; { starting offset }
+ l_len : off_t; { len = 0 means until end of file }
+ {$endif}
+ l_pid : pid_t; { lock owner }
+ End;
+
+ tms = packed Record
+ tms_utime : clock_t; { User CPU time }
+ tms_stime : clock_t; { System CPU time }
+ tms_cutime : clock_t; { User CPU time of terminated child procs }
+ tms_cstime : clock_t; { System CPU time of terminated child procs }
+ end;
+ TTms = tms;
+ PTms = ^tms;
+
+ TFDSet = ARRAY[0..(FD_MAXFDSET div 32)-1] of Cardinal;
+ pFDSet = ^TFDSet;
+
+ timezone = packed record
+ tz_minuteswest,tz_dsttime:cint;
+ end;
+ ptimezone =^timezone;
+ TTimeZone = timezone;
+
+{***********************************************************************}
+{ POSIX CONSTANT ROUTINE DEFINITIONS }
+{***********************************************************************}
+CONST
+ { access routine - these maybe OR'ed together }
+ F_OK = 0; { test for existence of file }
+ R_OK = 4; { test for read permission on file }
+ W_OK = 2; { test for write permission on file }
+ X_OK = 1; { test for execute or search permission }
+ { seek routine }
+ SEEK_SET = 0; { seek from beginning of file }
+ SEEK_CUR = 1; { seek from current position }
+ SEEK_END = 2; { seek from end of file }
+ { open routine }
+ { File access modes for `open' and `fcntl'. }
+ O_RDONLY = 0; { Open read-only. }
+ O_WRONLY = 1; { Open write-only. }
+ O_RDWR = 2; { Open read/write. }
+{$ifdef sparc}
+ O_APPEND = 8;
+ O_CREAT = $200;
+ O_TRUNC = $400;
+ O_EXCL = $800;
+ O_SYNC = $2000;
+ O_NONBLOCK = $4000;
+ O_NDELAY = O_NONBLOCK or 4;
+ O_NOCTTY = $8000;
+ O_DIRECTORY = $10000;
+ O_NOFOLLOW = $20000;
+ O_LARGEFILE = $40000;
+ O_DIRECT = $100000;
+{$else sparc}
+ O_CREAT = $40;
+ O_EXCL = $80;
+ O_NOCTTY = $100;
+ O_TRUNC = $200;
+ O_APPEND = $400;
+ O_NONBLOCK = $800;
+ O_NDELAY = O_NONBLOCK;
+ O_SYNC = $1000;
+ O_DIRECT = $4000;
+ O_LARGEFILE = $8000;
+ O_DIRECTORY = $10000;
+ O_NOFOLLOW = $20000;
+{$endif sparc}
+
+ { mode_t possible values }
+ S_IRUSR = %0100000000; { Read permission for owner }
+ S_IWUSR = %0010000000; { Write permission for owner }
+ S_IXUSR = %0001000000; { Exec permission for owner }
+ S_IRGRP = %0000100000; { Read permission for group }
+ S_IWGRP = %0000010000; { Write permission for group }
+ S_IXGRP = %0000001000; { Exec permission for group }
+ S_IROTH = %0000000100; { Read permission for world }
+ S_IWOTH = %0000000010; { Write permission for world }
+ S_IXOTH = %0000000001; { Exec permission for world }
+
+ { Used for waitpid }
+ WNOHANG = 1; { don't block waiting }
+ WUNTRACED = 2; { report status of stopped children }
+
+ { File types }
+ S_IFMT = 61440; { type of file mask}
+ S_IFIFO = 4096; { named pipe (fifo)}
+ S_IFCHR = 8192; { character special}
+ S_IFDIR = 16384; { directory }
+ S_IFBLK = 24576; { block special}
+ S_IFREG = 32768; { regular }
+ S_IFLNK = 40960; { symbolic link }
+ S_IFSOCK= 49152; { socket }
+
+ { Constansts for MMAP }
+ MAP_PRIVATE =2;
+ MAP_ANONYMOUS =$20;
+
+
+ { For File control mechanism }
+ F_GetFd = 1;
+ F_SetFd = 2;
+ F_GetFl = 3;
+ F_SetFl = 4;
+ F_GetLk = 5;
+ F_SetLk = 6;
+ F_SetLkW = 7;
+ F_SetOwn = 8;
+ F_GetOwn = 9;
+
+ {*************************************************************************}
+ { SIGNALS }
+ {*************************************************************************}
+
+{$i signal.inc}
+
+{
+ $Log: ostypes.inc,v $
+ Revision 1.12 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.11 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+}
diff --git a/rtl/linux/powerpc/bsyscall.inc b/rtl/linux/powerpc/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/linux/powerpc/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/linux/powerpc/cprt0.as b/rtl/linux/powerpc/cprt0.as
new file mode 100644
index 0000000000..876abc3319
--- /dev/null
+++ b/rtl/linux/powerpc/cprt0.as
@@ -0,0 +1,105 @@
+/*
+ $Id: cprt0.as,v 1.9 2004/09/02 18:57:37 marco Exp $
+*/
+/* Startup code for programs linked with GNU libc.
+ Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA. */
+
+ .section ".text"
+ .globl _start
+_start:
+ mr 26,1
+ /* Set up an initial stack frame, and clear the LR. */
+ clrrwi 1,1,4
+ li 0,0
+ stwu 1,-16(1)
+ mtlr 0
+ stw 0,0(1)
+
+ lis 11,operatingsystem_parameter_argc@ha
+ stw 3,operatingsystem_parameter_argc@l(11);
+
+ lis 11,operatingsystem_parameter_argv@ha
+ stw 4,operatingsystem_parameter_argv@l(11);
+
+ lis 11,operatingsystem_parameter_envp@ha
+ stw 5,operatingsystem_parameter_envp@l(11);
+
+ /* init libc, parameters are already setup at this point */
+ bl __libc_init_first
+
+ /* install finalization code handler */
+ lis 3,_fini@ha
+ addi 3,3,_fini@l
+ bl PASCALMAIN
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ li 0,1 /* exit call */
+ lis 3,operatingsystem_result@h
+ stw 3,operatingsystem_result@l(3)
+ sc
+ b _haltproc
+
+ /* Define a symbol for the first piece of initialized data. */
+ .section ".data"
+ .globl __data_start
+__data_start:
+data_start:
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+.text
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+/*
+ $Log: cprt0.as,v $
+ Revision 1.9 2004/09/02 18:57:37 marco
+ * fixed argc<->argv
+
+ Revision 1.8 2004/08/18 14:26:50 karoly
+ * quick fix to make it compile
+
+ Revision 1.7 2004/07/03 21:50:31 daniel
+ * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+ longer necessary
+
+ Revision 1.6 2004/01/04 17:28:03 florian
+ * clean up
+
+ Revision 1.5 2004/01/04 17:12:28 florian
+ * arg* and envp handling fixed
+
+ Revision 1.4 2003/12/28 20:08:53 florian
+ * initial code
+
+ Revision 1.3 2002/09/07 16:01:20 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/07/26 17:09:44 florian
+ * log fixed
+
+ Revision 1.1 2002/07/26 17:07:11 florian
+ + dummy implementation to test the makefile
+*/ \ No newline at end of file
diff --git a/rtl/linux/powerpc/dllprt0.as b/rtl/linux/powerpc/dllprt0.as
new file mode 100644
index 0000000000..6fc8f0056a
--- /dev/null
+++ b/rtl/linux/powerpc/dllprt0.as
@@ -0,0 +1,15 @@
+/*
+ $Id: dllprt0.as,v 1.3 2002/09/07 16:01:20 peter Exp $
+*/
+
+/*
+ $Log: dllprt0.as,v $
+ Revision 1.3 2002/09/07 16:01:20 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/07/26 17:09:44 florian
+ * log fixed
+
+ Revision 1.1 2002/07/26 17:07:11 florian
+ + dummy implementation to test the makefile
+*/
diff --git a/rtl/linux/powerpc/gprt0.as b/rtl/linux/powerpc/gprt0.as
new file mode 100644
index 0000000000..6f11554795
--- /dev/null
+++ b/rtl/linux/powerpc/gprt0.as
@@ -0,0 +1,15 @@
+/*
+ $Id: gprt0.as,v 1.3 2002/09/07 16:01:20 peter Exp $
+*/
+
+/*
+ $Log: gprt0.as,v $
+ Revision 1.3 2002/09/07 16:01:20 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/07/26 17:09:44 florian
+ * log fixed
+
+ Revision 1.1 2002/07/26 17:07:11 florian
+ + dummy implementation to test the makefile
+*/
diff --git a/rtl/linux/powerpc/prt0.as b/rtl/linux/powerpc/prt0.as
new file mode 100644
index 0000000000..9567053033
--- /dev/null
+++ b/rtl/linux/powerpc/prt0.as
@@ -0,0 +1,117 @@
+/*
+ $Id: prt0.as,v 1.14 2004/08/18 14:26:50 karoly Exp $
+*/
+/* Startup code for programs linked with GNU libc.
+ Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA. */
+
+ .section ".text"
+ .globl _start
+_start:
+ mr 26,1
+ /* Set up an initial stack frame, and clear the LR. */
+ clrrwi 1,1,4
+ li 0,0
+ stwu 1,-16(1)
+ mtlr 0
+ stw 0,0(1)
+ lwz 3,0(26) /* get argc */
+ lis 11,operatingsystem_parameter_argc@ha
+ stw 3,operatingsystem_parameter_argc@l(11);
+
+ addi 4,26,4 /* get argv */
+ lis 11,operatingsystem_parameter_argv@ha
+ stw 4,operatingsystem_parameter_argv@l(11);
+
+ addi 27,3,1 /* calculate argc + 1 into r27 */
+ slwi 27,27,2 /* calculate (argc + 1) * sizeof(char *) into r27 */
+ add 5,4,27 /* get address of env[0] */
+ lis 11,operatingsystem_parameter_envp@ha
+ stw 5,operatingsystem_parameter_envp@l(11);
+
+ bl PASCALMAIN
+
+ b _haltproc
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ li 0,1 /* exit call */
+ sc
+ b _haltproc
+
+ /* Define a symbol for the first piece of initialized data. */
+ .section ".data"
+ .globl __data_start
+__data_start:
+data_start:
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+.text
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+/*
+ $Log: prt0.as,v $
+ Revision 1.14 2004/08/18 14:26:50 karoly
+ * quick fix to make it compile
+
+ Revision 1.13 2004/07/03 21:50:31 daniel
+ * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+ longer necessary
+
+ Revision 1.12 2004/05/26 20:48:17 florian
+ * _haltproc fixed
+
+ Revision 1.11 2004/01/04 17:23:57 florian
+ + header added
+
+ Revision 1.10 2003/05/12 22:36:45 florian
+ + added setup of argv, argc and envp
+
+ Revision 1.9 2002/09/07 16:01:20 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.8 2002/08/31 21:29:57 florian
+ * several PC related fixes
+
+ Revision 1.7 2002/08/31 16:13:12 florian
+ * made _start global
+
+ Revision 1.6 2002/08/31 14:02:23 florian
+ * r3 renamed to 3
+
+ Revision 1.5 2002/08/31 14:01:28 florian
+ * _haltproc to prt0.as added (Linux/PPC)
+
+ Revision 1.4 2002/08/31 13:11:11 florian
+ * several fixes for Linux/PPC compilation
+
+ Revision 1.3 2002/08/19 21:19:15 florian
+ * small fixes
+
+ Revision 1.2 2002/07/26 17:09:44 florian
+ * log fixed
+
+ Revision 1.1 2002/07/26 16:57:40 florian
+ + initial version, plain copy from glibc/sysdeps/powerpc/elf/start.S
+*/ \ No newline at end of file
diff --git a/rtl/linux/powerpc/sighnd.inc b/rtl/linux/powerpc/sighnd.inc
new file mode 100644
index 0000000000..795bade104
--- /dev/null
+++ b/rtl/linux/powerpc/sighnd.inc
@@ -0,0 +1,70 @@
+{
+ $Id: sighnd.inc,v 1.7 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+ res : word;
+{ fpustate: longint; }
+begin
+ res:=0;
+ { exception flags are turned off by kernel }
+ fpc_enable_ppc_fpu_exceptions;
+ case sig of
+ SIGFPE :
+ begin
+{
+ fpscr is cleared by the kernel -> can't find out cause :(
+ fpustate := fpc_get_ppc_fpscr;
+ if (fpustate and ppc_fpu_underflow) <> 0 then
+ res := 206
+ else if (fpustate and ppc_fpu_overflow) <> 0 then
+ res := 205
+ else if (fpustate and ppc_fpu_divbyzero) <> 0 then
+ res := 200
+ else
+}
+ res := 207;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ reenable_signal(sig);
+ { give runtime error at the position where the signal was raised }
+ if res<>0 then
+ HandleErrorAddrFrame(res,pointer(SigContext^.pt_regs^.nip),pointer(SigContext^.pt_regs^.gpr[1]));
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.7 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.5 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/powerpc/sighndh.inc b/rtl/linux/powerpc/sighndh.inc
new file mode 100644
index 0000000000..d8268ba5d3
--- /dev/null
+++ b/rtl/linux/powerpc/sighndh.inc
@@ -0,0 +1,91 @@
+{
+ $Id: sighndh.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ TSigContext
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+ { from include/ppc/ptrace.h }
+ pptregs = ^tptregs;
+ tptregs = record
+ gpr: array[0..31] of cardinal;
+ nip: cardinal;
+ msr: cardinal;
+ orig_gpr3: cardinal; { Used for restarting system calls }
+ ctr: cardinal;
+ link: cardinal;
+ xer: cardinal;
+ ccr: cardinal;
+ mq: cardinal; { 601 only (not used at present) }
+ { Used on APUS to hold IPL value. }
+ trap: cardinal; { Reason for being here }
+ dar: cardinal; { Fault registers }
+ dsisr: cardinal;
+ result: cardinal; { Result of a system call }
+ end;
+
+ { from include/asm-ppc/signal.h }
+ stack_t = record
+ ss_sp: pointer;
+ ss_flags: longint;
+ ss_size: size_t;
+ end;
+
+ { from include/asm-ppc/sigcontext.h }
+ tsigcontext_struct = record
+ _unused: array[0..3] of dword;
+ signal: longint;
+ handler: dword;
+ oldmask: dword;
+ pt_regs: pptregs;
+ end;
+
+ { from include/asm-ppc/ucontext.h }
+ pucontext = ^tucontext;
+ tucontext = record
+ uc_flags : dword;
+ uc_link : pucontext;
+ uc_stack : stack_t;
+ uc_mcontext : tsigcontext_struct;
+ uc_sigmask : sigset_t;
+ end;
+
+
+ { from arch/ppc/kernel/signal.c, the type of the actual parameter passed }
+ { to the sigaction handler }
+ t_rt_sigframe = record
+ _unused: array[0..1] of cardinal;
+ pinfo: psiginfo;
+ puc: pointer;
+ siginfo: tsiginfo;
+ uc: tucontext;
+ end;
+
+ PSigContext = ^TSigContext;
+ TSigContext= tsigcontext_struct;
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/powerpc/stat.inc b/rtl/linux/powerpc/stat.inc
new file mode 100644
index 0000000000..70212de546
--- /dev/null
+++ b/rtl/linux/powerpc/stat.inc
@@ -0,0 +1,63 @@
+{
+ $Id: stat.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ Stat = packed Record // No unix typing because of differences
+ case byte of
+ 0: (st_dev : cardinal;
+ st_ino,
+ st_mode : cardinal;
+ nlink : word;
+ __pad1 : word;
+ uid,
+ gid,
+ rdev : cardinal;
+ st_size : longint;
+ st_blksize,
+ st_blocks,
+ st_atime,
+ __unused1,
+ st_mtime,
+ __unused2,
+ st_ctime,
+ __unused3,
+ __unused4,
+ __unused5 : cardinal;);
+ 1: (dev : cardinal;
+ ino,
+ mode : cardinal;
+ nlink_dummy : word;
+ __pad2 : word;
+ uid_dummy,
+ gid_dummy,
+ rdev_dummy : cardinal;
+ size : longint;
+ blksize,
+ blocks,
+ atime,
+ __unused1_dummy,
+ mtime,
+ __unused2_dummy,
+ ctime,
+ __unused3_dummy,
+ __unused4_dummy,
+ __unused5_dummy : cardinal;);
+ end;
+
+{
+ $Log: stat.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/powerpc/syscall.inc b/rtl/linux/powerpc/syscall.inc
new file mode 100644
index 0000000000..8bad2e2927
--- /dev/null
+++ b/rtl/linux/powerpc/syscall.inc
@@ -0,0 +1,302 @@
+{
+ $Id: syscall.inc,v 1.13 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+ {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{*****************************************************************************
+ --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ mr r3,r4
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ mr r7,r8
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+var
+ temp, retaddress: longint;
+asm
+ mr r0,r3
+ mr r3,r4
+ mr r4,r5
+ mr r5,r6
+ mr r6,r7
+ mr r7,r8
+ mr r8,r9
+ sc
+ bns .LDone
+ lis r10,(fpc_threadvar_relocate_proc)@ha
+ lwz r10,(fpc_threadvar_relocate_proc)@l(r10)
+ cmpwi r10,0
+ bne .LThreaded
+ lis r4,(Errno+4)@ha
+ stw r3,(Errno+4)@l(r4)
+ b .LFailed
+.LThreaded:
+ stw r3,temp
+ mflr r3
+ mtctr r10
+ lis r4,(errno)@ha
+ stw r3,retaddress
+ lwz r3,(errno)@l(r4)
+ bctrl
+ lwz r4,temp
+ lwz r5,retaddress
+ stw r4,0(r3)
+ mtlr r5
+.LFailed:
+ li r3,-1
+.LDone:
+end;
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.13 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/linux/powerpc/syscallh.inc b/rtl/linux/powerpc/syscallh.inc
new file mode 100644
index 0000000000..6e8a8d5a42
--- /dev/null
+++ b/rtl/linux/powerpc/syscallh.inc
@@ -0,0 +1,50 @@
+{
+ $Id: syscallh.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for powerpc *nix.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+
+ TSysResult = longint; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+ TSysParam = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult; external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL6';
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/powerpc/sysnr.inc b/rtl/linux/powerpc/sysnr.inc
new file mode 100644
index 0000000000..81d9e68bdf
--- /dev/null
+++ b/rtl/linux/powerpc/sysnr.inc
@@ -0,0 +1,267 @@
+{
+ $Id: sysnr.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Syscall nrs for 2.4.18
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+
+Const
+ syscall_nr_exit = 1;
+ syscall_nr_fork = 2;
+ syscall_nr_read = 3;
+ syscall_nr_write = 4;
+ syscall_nr_open = 5;
+ syscall_nr_close = 6;
+ syscall_nr_waitpid = 7;
+ syscall_nr_creat = 8;
+ syscall_nr_link = 9;
+ syscall_nr_unlink = 10;
+ syscall_nr_execve = 11;
+ syscall_nr_chdir = 12;
+ syscall_nr_time = 13;
+ syscall_nr_mknod = 14;
+ syscall_nr_chmod = 15;
+ syscall_nr_lchown = 16;
+ syscall_nr_break = 17;
+ syscall_nr_oldstat = 18;
+ syscall_nr_lseek = 19;
+ syscall_nr_getpid = 20;
+ syscall_nr_mount = 21;
+ syscall_nr_umount = 22;
+ syscall_nr_setuid = 23;
+ syscall_nr_getuid = 24;
+ syscall_nr_stime = 25;
+ syscall_nr_ptrace = 26;
+ syscall_nr_alarm = 27;
+ syscall_nr_oldfstat = 28;
+ syscall_nr_pause = 29;
+ syscall_nr_utime = 30;
+ syscall_nr_stty = 31;
+ syscall_nr_gtty = 32;
+ syscall_nr_access = 33;
+ syscall_nr_nice = 34;
+ syscall_nr_ftime = 35;
+ syscall_nr_sync = 36;
+ syscall_nr_kill = 37;
+ syscall_nr_rename = 38;
+ syscall_nr_mkdir = 39;
+ syscall_nr_rmdir = 40;
+ syscall_nr_dup = 41;
+ syscall_nr_pipe = 42;
+ syscall_nr_times = 43;
+ syscall_nr_prof = 44;
+ syscall_nr_brk = 45;
+ syscall_nr_setgid = 46;
+ syscall_nr_getgid = 47;
+ syscall_nr_signal = 48;
+ syscall_nr_geteuid = 49;
+ syscall_nr_getegid = 50;
+ syscall_nr_acct = 51;
+ syscall_nr_umount2 = 52;
+ syscall_nr_lock = 53;
+ syscall_nr_ioctl = 54;
+ syscall_nr_fcntl = 55;
+ syscall_nr_mpx = 56;
+ syscall_nr_setpgid = 57;
+ syscall_nr_ulimit = 58;
+ syscall_nr_oldolduname = 59;
+ syscall_nr_umask = 60;
+ syscall_nr_chroot = 61;
+ syscall_nr_ustat = 62;
+ syscall_nr_dup2 = 63;
+ syscall_nr_getppid = 64;
+ syscall_nr_getpgrp = 65;
+ syscall_nr_setsid = 66;
+ syscall_nr_sigaction = 67;
+ syscall_nr_sgetmask = 68;
+ syscall_nr_ssetmask = 69;
+ syscall_nr_setreuid = 70;
+ syscall_nr_setregid = 71;
+ syscall_nr_sigsuspend = 72;
+ syscall_nr_sigpending = 73;
+ syscall_nr_sethostname = 74;
+ syscall_nr_setrlimit = 75;
+ syscall_nr_getrlimit = 76; { Back compatible 2Gig limited rlimit }
+ syscall_nr_getrusage = 77;
+ syscall_nr_gettimeofday = 78;
+ syscall_nr_settimeofday = 79;
+ syscall_nr_getgroups = 80;
+ syscall_nr_setgroups = 81;
+ syscall_nr_select = 82;
+ syscall_nr_symlink = 83;
+ syscall_nr_oldlstat = 84;
+ syscall_nr_readlink = 85;
+ syscall_nr_uselib = 86;
+ syscall_nr_swapon = 87;
+ syscall_nr_reboot = 88;
+ syscall_nr_readdir = 89;
+ syscall_nr_mmap = 90;
+ syscall_nr_munmap = 91;
+ syscall_nr_truncate = 92;
+ syscall_nr_ftruncate = 93;
+ syscall_nr_fchmod = 94;
+ syscall_nr_fchown = 95;
+ syscall_nr_getpriority = 96;
+ syscall_nr_setpriority = 97;
+ syscall_nr_profil = 98;
+ syscall_nr_statfs = 99;
+ syscall_nr_fstatfs = 100;
+ syscall_nr_ioperm = 101;
+ syscall_nr_socketcall = 102;
+ syscall_nr_syslog = 103;
+ syscall_nr_setitimer = 104;
+ syscall_nr_getitimer = 105;
+ syscall_nr_stat = 106;
+ syscall_nr_lstat = 107;
+ syscall_nr_fstat = 108;
+ syscall_nr_olduname = 109;
+ syscall_nr_iopl = 110;
+ syscall_nr_vhangup = 111;
+ syscall_nr_idle = 112;
+ syscall_nr_vm86old = 113;
+ syscall_nr_wait4 = 114;
+ syscall_nr_swapoff = 115;
+ syscall_nr_sysinfo = 116;
+ syscall_nr_ipc = 117;
+ syscall_nr_fsync = 118;
+ syscall_nr_sigreturn = 119;
+ syscall_nr_clone = 120;
+ syscall_nr_setdomainname = 121;
+ syscall_nr_uname = 122;
+ syscall_nr_modify_ldt = 123;
+ syscall_nr_adjtimex = 124;
+ syscall_nr_mprotect = 125;
+ syscall_nr_sigprocmask = 126;
+ syscall_nr_create_module = 127;
+ syscall_nr_init_module = 128;
+ syscall_nr_delete_module = 129;
+ syscall_nr_get_kernel_syms = 130;
+ syscall_nr_quotactl = 131;
+ syscall_nr_getpgid = 132;
+ syscall_nr_fchdir = 133;
+ syscall_nr_bdflush = 134;
+ syscall_nr_sysfs = 135;
+ syscall_nr_personality = 136;
+ syscall_nr_afs_syscall = 137; { Syscall for Andrew File System }
+ syscall_nr_setfsuid = 138;
+ syscall_nr_setfsgid = 139;
+ syscall_nr__llseek = 140;
+ syscall_nr_getdents = 141;
+ syscall_nr__newselect = 142;
+ syscall_nr_flock = 143;
+ syscall_nr_msync = 144;
+ syscall_nr_readv = 145;
+ syscall_nr_writev = 146;
+ syscall_nr_getsid = 147;
+ syscall_nr_fdatasync = 148;
+ syscall_nr__sysctl = 149;
+ syscall_nr_mlock = 150;
+ syscall_nr_munlock = 151;
+ syscall_nr_mlockall = 152;
+ syscall_nr_munlockall = 153;
+ syscall_nr_sched_setparam = 154;
+ syscall_nr_sched_getparam = 155;
+ syscall_nr_sched_setscheduler = 156;
+ syscall_nr_sched_getscheduler = 157;
+ syscall_nr_sched_yield = 158;
+ syscall_nr_sched_get_priority_max = 159;
+ syscall_nr_sched_get_priority_min = 160;
+ syscall_nr_sched_rr_get_interval = 161;
+ syscall_nr_nanosleep = 162;
+ syscall_nr_mremap = 163;
+ syscall_nr_setresuid = 164;
+ syscall_nr_getresuid = 165;
+ syscall_nr_vm86 = 166;
+ syscall_nr_query_module = 167;
+ syscall_nr_poll = 168;
+ syscall_nr_nfsservctl = 169;
+ syscall_nr_setresgid = 170;
+ syscall_nr_getresgid = 171;
+ syscall_nr_prctl = 172;
+ syscall_nr_rt_sigreturn = 173;
+ syscall_nr_rt_sigaction = 174;
+ syscall_nr_rt_sigprocmask = 175;
+ syscall_nr_rt_sigpending = 176;
+ syscall_nr_rt_sigtimedwait = 177;
+ syscall_nr_rt_sigqueueinfo = 178;
+ syscall_nr_rt_sigsuspend = 179;
+ syscall_nr_pread = 180;
+ syscall_nr_pwrite = 181;
+ syscall_nr_chown = 182;
+ syscall_nr_getcwd = 183;
+ syscall_nr_capget = 184;
+ syscall_nr_capset = 185;
+ syscall_nr_sigaltstack = 186;
+ syscall_nr_sendfile = 187;
+ syscall_nr_getpmsg = 188; { some people actually want streams }
+ syscall_nr_putpmsg = 189; { some people actually want streams }
+ syscall_nr_vfork = 190;
+ syscall_nr_ugetrlimit = 191; { SuS compliant getrlimit }
+ syscall_nr_mmap2 = 192;
+ syscall_nr_truncate64 = 193;
+ syscall_nr_ftruncate64 = 194;
+ syscall_nr_stat64 = 195;
+ syscall_nr_lstat64 = 196;
+ syscall_nr_fstat64 = 197;
+ syscall_nr_lchown32 = 198;
+ syscall_nr_getuid32 = 199;
+ syscall_nr_getgid32 = 200;
+ syscall_nr_geteuid32 = 201;
+ syscall_nr_getegid32 = 202;
+ syscall_nr_setreuid32 = 203;
+ syscall_nr_setregid32 = 204;
+ syscall_nr_getgroups32 = 205;
+ syscall_nr_setgroups32 = 206;
+ syscall_nr_fchown32 = 207;
+ syscall_nr_setresuid32 = 208;
+ syscall_nr_getresuid32 = 209;
+ syscall_nr_setresgid32 = 210;
+ syscall_nr_getresgid32 = 211;
+ syscall_nr_chown32 = 212;
+ syscall_nr_setuid32 = 213;
+ syscall_nr_setgid32 = 214;
+ syscall_nr_setfsuid32 = 215;
+ syscall_nr_setfsgid32 = 216;
+ syscall_nr_pivot_root = 217;
+ syscall_nr_mincore = 218;
+ syscall_nr_madvise = 219;
+ syscall_nr_madvise1 = 219; { delete when C lib stub is removed }
+ syscall_nr_getdents64 = 220;
+ syscall_nr_fcntl64 = 221;
+ syscall_nr_security = 223; { syscall for security modules }
+ syscall_nr_gettid = 224;
+ syscall_nr_readahead = 225;
+ syscall_nr_setxattr = 226;
+ syscall_nr_lsetxattr = 227;
+ syscall_nr_fsetxattr = 228;
+ syscall_nr_getxattr = 229;
+ syscall_nr_lgetxattr = 230;
+ syscall_nr_fgetxattr = 231;
+ syscall_nr_listxattr = 232;
+ syscall_nr_llistxattr = 233;
+ syscall_nr_flistxattr = 234;
+ syscall_nr_removexattr = 235;
+ syscall_nr_lremovexattr = 236;
+ syscall_nr_fremovexattr = 237;
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/pthread.inc b/rtl/linux/pthread.inc
new file mode 100644
index 0000000000..2c85cbcef1
--- /dev/null
+++ b/rtl/linux/pthread.inc
@@ -0,0 +1,334 @@
+{
+ $Id: pthread.inc,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains a pthread.h headerconversion for Linux.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Local POSIX Threads (pthread) imports
+*****************************************************************************}
+
+ { Attributes }
+ const
+ THREAD_PRIORITY_IDLE = 1;
+ THREAD_PRIORITY_LOWEST = 15;
+ THREAD_PRIORITY_BELOW_NORMAL = 30;
+ THREAD_PRIORITY_NORMAL = 50;
+ THREAD_PRIORITY_ABOVE_NORMAL = 70;
+ THREAD_PRIORITY_HIGHEST = 80;
+ THREAD_PRIORITY_TIME_CRITICAL = 99;
+ PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP : array [0..5]of Integer = (0, 0, 0, 1, 0, 0);
+
+Type
+ psem_t = ^sem_t;
+ TSemaphore = sem_t;
+ PSemaphore = ^TSemaphore;
+
+
+ TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest, tpTimeCritical);
+
+ const
+ Priorities: array [TThreadPriority] of Integer = (
+ THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
+ THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
+ THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL
+ );
+
+{
+ type
+ psigset_t = ^sigset_t;
+ sigset_t = DWORD; // unsigned long 32 bits
+}
+
+ const
+ _POSIX_THREAD_THREADS_MAX = 64;
+ PTHREAD_THREADS_MAX = 512;
+ _POSIX_THREAD_KEYS_MAX = 128;
+ PTHREAD_KEYS_MAX = 128;
+
+ type
+ ppthread_t = ^pthread_t;
+{
+ p_pthread_queue = ^_pthread_queue;
+}
+ ppthread_mutex_t = ^pthread_mutex_t;
+
+ ppthread_cond_t = ^pthread_cond_t;
+
+ { Attributes }
+
+ const
+ PTHREAD_CREATE_JOINABLE = 0;
+ PTHREAD_CREATE_DETACHED = 1;
+ PTHREAD_INHERIT_SCHED = 0;
+ PTHREAD_EXPLICIT_SCHED = 1;
+ PTHREAD_SCOPE_SYSTEM = 0;
+ PTHREAD_SCOPE_PROCESS = 1;
+
+ type
+ psched_param = ^sched_param;
+
+ ppthread_attr_t = ^pthread_attr_t;
+
+ ppthread_mutexattr_t = ^pthread_mutexattr_t;
+
+ ppthread_condattr_t = ^pthread_condattr_t;
+
+ ppthread_key_t = ^pthread_key_t;
+
+{ pthread_once_t = cint;
+ ppthread_once_t = ^pthread_once_t;}
+
+ const
+ PTHREAD_ONCE_INIT = 0;
+
+ type
+(*
+ tpcb_routine = Procedure(P:Pointer); cdecl;
+
+ p_pthread_cleanup_buffer = ^_pthread_cleanup_buffer;
+ _pthread_cleanup_buffer = record
+ routine : tpcb_routine; { Function to call. }
+ arg : Pointer; { Its argument. }
+ canceltype:LongInt; { Saved cancellation type. }
+ prev : p_pthread_cleanup_buffer; { Chaining of cleanup functions. }
+ end;
+*)
+
+ __start_routine_t = function (_para1:pointer):pointer;cdecl;
+ __destr_function_t = procedure (_para1:pointer);
+{ t_pthread_cleanup_push_routine = procedure (_para1:pointer);
+ t_pthread_cleanup_push_defer_routine = procedure (_para1:pointer);}
+
+{$ifndef dynpthreads}
+ function pthread_create(__thread:ppthread_t; __attr:ppthread_attr_t;__start_routine: __start_routine_t;__arg:pointer):longint;cdecl;external;
+ function pthread_self:pthread_t;cdecl;external;
+ function pthread_equal(__thread1:pthread_t; __thread2:pthread_t):longint;cdecl;external;
+ procedure pthread_exit(__retval:pointer);cdecl;external;
+ function pthread_join(__th:pthread_t; __thread_return:ppointer):longint;cdecl;external;
+ function pthread_detach(__th:pthread_t):longint;cdecl;external;
+ function pthread_attr_init(__attr:ppthread_attr_t):longint;cdecl;external;
+ function pthread_attr_destroy(__attr:ppthread_attr_t):longint;cdecl;external;
+ function pthread_attr_setdetachstate(__attr:ppthread_attr_t; __detachstate:longint):longint;cdecl;external;
+ function pthread_attr_getdetachstate(__attr:ppthread_attr_t; __detachstate:plongint):longint;cdecl;external;
+ function pthread_attr_setschedparam(__attr:ppthread_attr_t; __param:psched_param):longint;cdecl;external;
+ function pthread_attr_getschedparam(__attr:ppthread_attr_t; __param:psched_param):longint;cdecl;external;
+ function pthread_attr_setschedpolicy(__attr:ppthread_attr_t; __policy:longint):longint;cdecl;external;
+ function pthread_attr_getschedpolicy(__attr:ppthread_attr_t; __policy:plongint):longint;cdecl;external;
+ function pthread_attr_setinheritsched(__attr:ppthread_attr_t; __inherit:longint):longint;cdecl;external;
+ function pthread_attr_getinheritsched(__attr:ppthread_attr_t; __inherit:plongint):longint;cdecl;external;
+ function pthread_attr_setscope(__attr:ppthread_attr_t; __scope:longint):longint;cdecl;external;
+ function pthread_attr_getscope(__attr:ppthread_attr_t; __scope:plongint):longint;cdecl;external;
+ function pthread_setschedparam(__target_thread:pthread_t; __policy:longint; __param:psched_param):longint;cdecl;external;
+ function pthread_getschedparam(__target_thread:pthread_t; __policy:plongint; __param:psched_param):longint;cdecl;external;
+ function pthread_mutex_init(__mutex:ppthread_mutex_t; __mutex_attr:ppthread_mutexattr_t):longint;cdecl;external;
+ function pthread_mutex_destroy(__mutex:ppthread_mutex_t):longint;cdecl;external;
+ function pthread_mutex_trylock(__mutex:ppthread_mutex_t):longint;cdecl;external;
+ function pthread_mutex_lock(__mutex:ppthread_mutex_t):longint;cdecl;external;
+ function pthread_mutex_unlock(__mutex:ppthread_mutex_t):longint;cdecl;external;
+ function pthread_mutexattr_init(__attr:ppthread_mutexattr_t):longint;cdecl;external;
+ function pthread_mutexattr_destroy(__attr:ppthread_mutexattr_t):longint;cdecl;external;
+ function pthread_mutexattr_setkind_np(__attr:ppthread_mutexattr_t; __kind:longint):longint;cdecl;external;
+ function pthread_mutexattr_getkind_np(__attr:ppthread_mutexattr_t; __kind:plongint):longint;cdecl;external;
+ function pthread_cond_init(__cond:ppthread_cond_t; __cond_attr:ppthread_condattr_t):longint;cdecl;external;
+ function pthread_cond_destroy(__cond:ppthread_cond_t):longint;cdecl;external;
+ function pthread_cond_signal(__cond:ppthread_cond_t):longint;cdecl;external;
+ function pthread_cond_broadcast(__cond:ppthread_cond_t):longint;cdecl;external;
+ function pthread_cond_wait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t):longint;cdecl;external;
+ function pthread_cond_timedwait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):longint;cdecl;external;
+ function pthread_condattr_init(__attr:ppthread_condattr_t):longint;cdecl;external;
+ function pthread_condattr_destroy(__attr:ppthread_condattr_t):longint;cdecl;external;
+ function pthread_key_create(__key:ppthread_key_t; __destr_function:__destr_function_t):longint;cdecl;external;
+ function pthread_key_delete(__key:pthread_key_t):longint;cdecl;external;
+ function pthread_setspecific(__key:pthread_key_t; __pointer:pointer):longint;cdecl;external;
+ function pthread_getspecific(__key:pthread_key_t):pointer;cdecl;external;
+{ function pthread_once(__once_control:ppthread_once_t; __init_routine:tprocedure ):longint;cdecl;external;}
+ function pthread_setcancelstate(__state:longint; __oldstate:plongint):longint;cdecl;external;
+ function pthread_setcanceltype(__type:longint; __oldtype:plongint):longint;cdecl;external;
+ function pthread_cancel(__thread:pthread_t):longint;cdecl;external;
+ procedure pthread_testcancel;cdecl;external;
+{ procedure _pthread_cleanup_push(__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_routine; __arg:pointer);cdecl;external; }
+{ procedure _pthread_cleanup_push_defer(__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_defer_routine; __arg:pointer);cdecl;external;}
+{ function pthread_sigmask(__how:longint; __newmask:psigset_t; __oldmask:psigset_t):longint;cdecl;external;}
+ function pthread_kill(__thread:pthread_t; __signo:longint):longint;cdecl;external;
+{ function sigwait(__set:psigset_t; __sig:plongint):longint;cdecl;external;}
+ function pthread_atfork(__prepare:tprocedure ; __parent:tprocedure ; __child:tprocedure ):longint;cdecl;external;
+ procedure pthread_kill_other_threads_np;cdecl;external;
+
+ function sem_init (__sem:Psem_t; __pshared:longint; __value:dword):longint;cdecl;external;
+ function sem_destroy (__sem:Psem_t):longint;cdecl;external;
+ function sem_close (__sem:Psem_t):longint;cdecl;external;
+ function sem_unlink (__name:Pchar):longint;cdecl;external;
+ function sem_wait (__sem:Psem_t):longint;cdecl;external;
+ function sem_trywait (__sem:Psem_t):longint;cdecl;external;
+ function sem_post (__sem:Psem_t):longint;cdecl;external;
+ function sem_getvalue (__sem:Psem_t; __sval:Plongint):longint;cdecl;external;
+
+ function pthread_mutexattr_settype (__attr: Ppthread_mutexattr_t; Kind:Integer): Integer; cdecl;external;
+
+{$else}
+Var
+ pthread_create : Function(__thread:ppthread_t; __attr:ppthread_attr_t;__start_routine: __start_routine_t;__arg:pointer):longint;cdecl;
+ pthread_self: Function : pthread_t;cdecl;
+ pthread_equal : Function(__thread1:pthread_t; __thread2:pthread_t):longint;cdecl;
+ pthread_exit : procedure (__retval:pointer);cdecl;
+ pthread_join : Function(__th:pthread_t; __thread_return:ppointer):longint;cdecl;
+ pthread_detach : Function(__th:pthread_t):longint;cdecl;
+ pthread_attr_init : Function(__attr:ppthread_attr_t):longint;cdecl;
+ pthread_attr_destroy : Function(__attr:ppthread_attr_t):longint;cdecl;
+ pthread_attr_setdetachstate : Function(__attr:ppthread_attr_t; __detachstate:longint):longint;cdecl;
+ pthread_attr_getdetachstate : Function(__attr:ppthread_attr_t; __detachstate:plongint):longint;cdecl;
+ pthread_attr_setschedparam : Function(__attr:ppthread_attr_t; __param:psched_param):longint;cdecl;
+ pthread_attr_getschedparam : Function(__attr:ppthread_attr_t; __param:psched_param):longint;cdecl;
+ pthread_attr_setschedpolicy : Function(__attr:ppthread_attr_t; __policy:longint):longint;cdecl;
+ pthread_attr_getschedpolicy : Function(__attr:ppthread_attr_t; __policy:plongint):longint;cdecl;
+ pthread_attr_setinheritsched : Function(__attr:ppthread_attr_t; __inherit:longint):longint;cdecl;
+ pthread_attr_getinheritsched : Function(__attr:ppthread_attr_t; __inherit:plongint):longint;cdecl;
+ pthread_attr_setscope : Function(__attr:ppthread_attr_t; __scope:longint):longint;cdecl;
+ pthread_attr_getscope : Function(__attr:ppthread_attr_t; __scope:plongint):longint;cdecl;
+ pthread_setschedparam : Function(__target_thread:pthread_t; __policy:longint; __param:psched_param):longint;cdecl;
+ pthread_getschedparam : Function(__target_thread:pthread_t; __policy:plongint; __param:psched_param):longint;cdecl;
+ pthread_mutex_init : Function(__mutex:ppthread_mutex_t; __mutex_attr:ppthread_mutexattr_t):longint;cdecl;
+ pthread_mutex_destroy : Function(__mutex:ppthread_mutex_t):longint;cdecl;
+ pthread_mutex_trylock : Function(__mutex:ppthread_mutex_t):longint;cdecl;
+ pthread_mutex_lock : Function(__mutex:ppthread_mutex_t):longint;cdecl;
+ pthread_mutex_unlock : Function(__mutex:ppthread_mutex_t):longint;cdecl;
+ pthread_mutexattr_init : Function(__attr:ppthread_mutexattr_t):longint;cdecl;
+ pthread_mutexattr_destroy : Function(__attr:ppthread_mutexattr_t):longint;cdecl;
+ pthread_mutexattr_setkind_np : Function(__attr:ppthread_mutexattr_t; __kind:longint):longint;cdecl;
+ pthread_mutexattr_getkind_np : Function(__attr:ppthread_mutexattr_t; __kind:plongint):longint;cdecl;
+ pthread_cond_init : Function(__cond:ppthread_cond_t; __cond_attr:ppthread_condattr_t):longint;cdecl;
+ pthread_cond_destroy : Function(__cond:ppthread_cond_t):longint;cdecl;
+ pthread_cond_signal : Function(__cond:ppthread_cond_t):longint;cdecl;
+ pthread_cond_broadcast : Function(__cond:ppthread_cond_t):longint;cdecl;
+ pthread_cond_wait : Function(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t):longint;cdecl;
+ pthread_cond_timedwait : Function(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):longint;cdecl;
+ pthread_condattr_init : Function(__attr:ppthread_condattr_t):longint;cdecl;
+ pthread_condattr_destroy : Function(__attr:ppthread_condattr_t):longint;cdecl;
+ pthread_key_create : Function(__key:ppthread_key_t; __destr_function:__destr_function_t):longint;cdecl;
+ pthread_key_delete : Function(__key:pthread_key_t):longint;cdecl;
+ pthread_setspecific : Function(__key:pthread_key_t; __pointer:pointer):longint;cdecl;
+ pthread_getspecific : Function(__key:pthread_key_t):pointer;cdecl;
+{ pthread_once : Function(__once_control:ppthread_once_t; __init_routine:tprocedure ):longint;cdecl;}
+ pthread_setcancelstate : Function(__state:longint; __oldstate:plongint):longint;cdecl;
+ pthread_setcanceltype : Function(__type:longint; __oldtype:plongint):longint;cdecl;
+ pthread_cancel : Function(__thread:pthread_t):longint;cdecl;
+ pthread_testcancel : Procedure ;cdecl;
+{ _pthread_cleanup_push : procedure (__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_routine; __arg:pointer);cdecl;}
+{ _pthread_cleanup_push_defer : procedure (__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_defer_routine; __arg:pointer);cdecl;}
+{ pthread_sigmask : Function(__how:longint; __newmask:psigset_t; __oldmask:psigset_t):longint;cdecl;}
+ pthread_kill : Function(__thread:pthread_t; __signo:longint):longint;cdecl;
+{ sigwait : Function(__set:psigset_t; __sig:plongint):longint;cdecl;}
+ pthread_atfork : Function(__prepare:tprocedure ; __parent:tprocedure ; __child:tprocedure ):longint;cdecl;
+ pthread_kill_other_threads_np : procedure;cdecl;
+
+ sem_init : function (__sem:Psem_t; __pshared:longint; __value:dword):longint;cdecl;
+ sem_destroy : function (__sem:Psem_t):longint;cdecl;
+ sem_close : function (__sem:Psem_t):longint;cdecl;
+ sem_unlink : function (__name:Pchar):longint;cdecl;
+ sem_wait : function (__sem:Psem_t):longint;cdecl;
+ sem_trywait : function (__sem:Psem_t):longint;cdecl;
+ sem_post : function (__sem:Psem_t):longint;cdecl;
+ sem_getvalue : function (__sem:Psem_t; __sval:Plongint):longint;cdecl;
+
+ pthread_mutexattr_settype : function(__attr: Ppthread_mutexattr_t; Kind:Integer): Integer; cdecl;
+
+
+Var
+ PthreadDLL : Pointer;
+
+Function LoadPthreads : Boolean;
+
+begin
+ PThreadDLL:=DlOpen('libpthread.so.0',RTLD_LAZY);
+ Result:=PThreadDLL<>Nil;
+ If Not Result then
+ exit;
+ Pointer(pthread_create) := dlsym(PthreadDLL,'pthread_create');
+ Pointer(pthread_self) := dlsym(PthreadDLL,'pthread_self');
+ Pointer(pthread_equal) := dlsym(PthreadDLL,'pthread_equal');
+ Pointer(pthread_exit) := dlsym(PthreadDLL,'pthread_exit');
+ Pointer(pthread_join) := dlsym(PthreadDLL,'pthread_join');
+ Pointer(pthread_detach) := dlsym(PthreadDLL,'pthread_detach');
+ Pointer(pthread_attr_init) := dlsym(PthreadDLL,'pthread_attr_init');
+ Pointer(pthread_attr_destroy) := dlsym(PthreadDLL,'pthread_attr_destroy');
+ Pointer(pthread_attr_setdetachstate) := dlsym(PthreadDLL,'pthread_attr_setdetachstate');
+ Pointer(pthread_attr_getdetachstate) := dlsym(PthreadDLL,'pthread_attr_getdetachstate');
+ Pointer(pthread_attr_setschedparam) := dlsym(PthreadDLL,'pthread_attr_setschedparam');
+ Pointer(pthread_attr_getschedparam) := dlsym(PthreadDLL,'pthread_attr_getschedparam');
+ Pointer(pthread_attr_setschedpolicy) := dlsym(PthreadDLL,'pthread_attr_setschedpolicy');
+ Pointer(pthread_attr_getschedpolicy) := dlsym(PthreadDLL,'pthread_attr_getschedpolicy');
+ Pointer(pthread_attr_setinheritsched) := dlsym(PthreadDLL,'pthread_attr_setinheritsched');
+ Pointer(pthread_attr_getinheritsched) := dlsym(PthreadDLL,'pthread_attr_getinheritsched');
+ Pointer(pthread_attr_setscope) := dlsym(PthreadDLL,'pthread_attr_setscope');
+ Pointer(pthread_attr_getscope) := dlsym(PthreadDLL,'pthread_attr_getscope');
+ Pointer(pthread_setschedparam) := dlsym(PthreadDLL,'pthread_setschedparam');
+ Pointer(pthread_getschedparam) := dlsym(PthreadDLL,'pthread_getschedparam');
+ Pointer(pthread_mutex_init) := dlsym(PthreadDLL,'pthread_mutex_init');
+ Pointer(pthread_mutex_destroy) := dlsym(PthreadDLL,'pthread_mutex_destroy');
+ Pointer(pthread_mutex_trylock) := dlsym(PthreadDLL,'pthread_mutex_trylock');
+ Pointer(pthread_mutex_lock) := dlsym(PthreadDLL,'pthread_mutex_lock');
+ Pointer(pthread_mutex_unlock) := dlsym(PthreadDLL,'pthread_mutex_unlock');
+ Pointer(pthread_mutexattr_init) := dlsym(PthreadDLL,'pthread_mutexattr_init');
+ Pointer(pthread_mutexattr_destroy) := dlsym(PthreadDLL,'pthread_mutexattr_destroy');
+ Pointer(pthread_mutexattr_setkind_np) := dlsym(PthreadDLL,'pthread_mutexattr_setkind_np');
+ Pointer(pthread_mutexattr_getkind_np) := dlsym(PthreadDLL,'pthread_mutexattr_getkind_np');
+ Pointer(pthread_cond_init) := dlsym(PthreadDLL,'pthread_cond_init');
+ Pointer(pthread_cond_destroy) := dlsym(PthreadDLL,'pthread_cond_destroy');
+ Pointer(pthread_cond_signal) := dlsym(PthreadDLL,'pthread_cond_signal');
+ Pointer(pthread_cond_broadcast) := dlsym(PthreadDLL,'pthread_cond_broadcast');
+ Pointer(pthread_cond_wait) := dlsym(PthreadDLL,'pthread_cond_wait');
+ Pointer(pthread_cond_timedwait) := dlsym(PthreadDLL,'pthread_cond_timedwait');
+ Pointer(pthread_condattr_init) := dlsym(PthreadDLL,'pthread_condattr_init');
+ Pointer(pthread_condattr_destroy) := dlsym(PthreadDLL,'pthread_condattr_destroy');
+ Pointer(pthread_key_create) := dlsym(PthreadDLL,'pthread_key_create');
+ Pointer(pthread_key_delete) := dlsym(PthreadDLL,'pthread_key_delete');
+ Pointer(pthread_setspecific) := dlsym(PthreadDLL,'pthread_setspecific');
+ Pointer(pthread_getspecific) := dlsym(PthreadDLL,'pthread_getspecific');
+{ Pointer(pthread_once) := dlsym(PthreadDLL,'pthread_once');}
+ Pointer(pthread_setcancelstate) := dlsym(PthreadDLL,'pthread_setcancelstate');
+ Pointer(pthread_setcanceltype) := dlsym(PthreadDLL,'pthread_setcanceltype');
+ Pointer(pthread_cancel) := dlsym(PthreadDLL,'pthread_cancel');
+ Pointer(pthread_testcancel) := dlsym(PthreadDLL,'pthread_testcancel');
+{ Pointer(_pthread_cleanup_push) := dlsym(PthreadDLL,'_pthread_cleanup_push');}
+{ Pointer(_pthread_cleanup_push_defer) := dlsym(PthreadDLL,'_pthread_cleanup_push_defer');}
+{ Pointer(pthread_sigmask) := dlsym(PthreadDLL,'pthread_sigmask');}
+ Pointer(pthread_kill) := dlsym(PthreadDLL,'pthread_kill');
+ Pointer(pthread_atfork):= dlsym(PthreadDLL,'pthread_atfork');
+ Pointer(pthread_kill_other_threads_np) := dlsym(PthreadDLL,'pthread_kill_other_threads_np');
+ Pointer(sem_init ) := dlsym(PthreadDLL,'sem_init');
+ Pointer(sem_destroy ) := dlsym(PthreadDLL,'sem_destroy');
+ Pointer(sem_close ) := dlsym(PthreadDLL,'sem_close');
+ Pointer(sem_unlink ) := dlsym(PthreadDLL,'sem_unlink');
+ Pointer(sem_wait ) := dlsym(PthreadDLL,'sem_wait');
+ Pointer(sem_trywait ) := dlsym(PthreadDLL,'sem_trywait');
+ Pointer(sem_post ) := dlsym(PthreadDLL,'sem_post');
+ Pointer(sem_getvalue ) := dlsym(PthreadDLL,'sem_getvalue');
+ Pointer(pthread_mutexattr_settype) := dlsym(PthreadDLL,'pthread_mutexattr_settype');
+end;
+
+Function UnLoadPthreads : Boolean;
+
+begin
+ Result:=dlclose(PThreadDLL)=0;
+end;
+
+{$endif}
+
+{
+ $Log: pthread.inc,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/ptypes.inc b/rtl/linux/ptypes.inc
new file mode 100644
index 0000000000..f4711a6aa2
--- /dev/null
+++ b/rtl/linux/ptypes.inc
@@ -0,0 +1,253 @@
+{
+ $Id: ptypes.inc,v 1.14 2005/03/16 22:26:12 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+{ Introduced defines
+ - 64bitfs (should be on if libc switches to a 64-bit system.
+
+All three tested systems (PPC,Alpha,2x i386) gave the same POSIX limits,
+and all three 32-bit systems returned completely identical types too
+(everything 32-bit except dev_t, which is assumed to be a result of devfs
+introduction)
+}
+
+{$I ctypes.inc}
+{$packrecords c}
+
+Type
+
+{$ifndef VER_1_0} // maybe wrong (kernel vs libc)
+ dev_t = cuint64; { used for device numbers }
+{$else}
+ dev_t = int64;
+{$endif}
+ TDev = dev_t;
+ pDev = ^dev_t;
+
+ kDev_t = cushort; // Linux has two different device conventions
+ TkDev = KDev_t; // kernel and glibc. This is kernel.
+ pkDev = ^kdev_t;
+
+ gid_t = cuint32; { used for group IDs }
+ TGid = gid_t;
+ pGid = ^gid_t;
+
+ ino_t = clong; { used for file serial numbers }
+ TIno = ino_t;
+ pIno = ^ino_t;
+
+ mode_t = cuint32; { used for file attributes }
+ TMode = mode_t;
+ pMode = ^mode_t;
+
+ nlink_t = cuint32; { used for link counts }
+ TnLink = nlink_t;
+ pnLink = ^nlink_t;
+
+{$ifdef cpu64}
+ off_t = cint64; { used for file sizes }
+{$else}
+ {$ifdef 64BitFS}
+ off_t = cint64;
+ {$else}
+ off_t = cint;
+ {$endif}
+{$endif}
+ TOff = off_t;
+ pOff = ^off_t;
+
+ pid_t = cint32; { used as process identifier }
+ TPid = pid_t;
+ pPid = ^pid_t;
+
+{$ifdef cpu64}
+ size_t = cuint64; { as definied in the C standard}
+ ssize_t = cint64; { used by function for returning number of bytes }
+ clock_t = cuint64;
+ time_t = cint64; { used for returning the time }
+{$else}
+ size_t = cuint32; { as definied in the C standard}
+ ssize_t = cint32; { used by function for returning number of bytes }
+ clock_t = culong;
+ time_t = clong; { used for returning the time }
+{$endif}
+ wint_t = cint32;
+ TSize = size_t;
+ pSize = ^size_t;
+ psize_t = pSize;
+ TSSize = ssize_t;
+ pSSize = ^ssize_t;
+ TClock = clock_t;
+ pClock = ^clock_t;
+ TTime = time_t;
+ pTime = ^time_t;
+ ptime_t = ^time_t;
+
+ wchar_t = widechar;
+ pwchar_t = ^wchar_t;
+
+ uid_t = cuint32; { used for user ID type }
+ TUid = uid_t;
+ pUid = ^uid_t;
+
+ socklen_t= cuint32;
+ TSockLen = socklen_t;
+ pSockLen = ^socklen_t;
+
+ timeval = packed record
+ tv_sec,
+ tv_usec:clong;
+ end;
+ ptimeval = ^timeval;
+ TTimeVal = timeval;
+
+ timespec = packed record
+ tv_sec : time_t;
+ tv_nsec : clong;
+ end;
+ ptimespec = ^timespec;
+ TTimeSpec = timespec;
+
+ TStatfs = packed record
+ fstype, { File system type }
+ bsize : cint; { Optimal block trensfer size }
+ blocks, { Data blocks in system }
+ bfree, { free blocks in system }
+ bavail, { Available free blocks to non-root users }
+ files, { File nodes in system }
+ ffree : clong; { Free file nodes in system }
+ fsid : array[0..1] of cint; { File system ID }
+ namelen : clong; { Maximum name length in system }
+ spare : array [0..5] of clong; { For later use }
+ end;
+ PStatFS=^TStatFS;
+
+ pthread_t = culong;
+
+ sched_param = record
+ __sched_priority: cint;
+ end;
+
+ pthread_attr_t = record
+ __detachstate: cint;
+ __schedpolicy: cint;
+ __schedparam: sched_param;
+ __inheritsched: cint;
+ __scope: cint;
+ __guardsize: size_t;
+ __stackaddr_set: cint;
+ __stackaddr: pointer;
+ __stacksize: size_t;
+ end;
+
+ _pthread_fastlock = record
+ __status: clong;
+ __spinlock: cint;
+ end;
+
+ pthread_mutex_t = record
+ __m_reserved: cint;
+ __m_count: cint;
+ __m_owner: pointer;
+ __m_kind: cint;
+ __m_lock: _pthread_fastlock;
+ end;
+
+ pthread_mutexattr_t = record
+ __mutexkind: cint;
+ end;
+
+ pthread_cond_t = record
+ __c_lock: _pthread_fastlock;
+ __c_waiting: pointer;
+ __padding: array[0..48-1-sizeof(_pthread_fastlock)-sizeof(pointer)-sizeof(clonglong)] of byte;
+ __align: clonglong;
+ end;
+
+ pthread_condattr_t = record
+ __dummy: cint;
+ end;
+
+ pthread_key_t = cuint;
+
+ pthread_rwlock_t = record
+ __rw_readers: cint;
+ __rw_writer: pointer;
+ __rw_read_waiting: pointer;
+ __rw_write_waiting: pointer;
+ __rw_kind: cint;
+ __rw_pshared: cint;
+ end;
+
+ pthread_rwlockattr_t = record
+ __lockkind: cint;
+ __pshared: cint;
+ end;
+
+ sem_t = record
+ __sem_lock: _pthread_fastlock;
+ __sem_value: cint;
+ __sem_waiting: pointer;
+ end;
+
+
+
+CONST
+ _PTHREAD_MUTEX_TIMED_NP = 0;
+ _PTHREAD_MUTEX_RECURSIVE_NP = 1;
+ _PTHREAD_MUTEX_ERRORCHECK_NP = 2;
+ _PTHREAD_MUTEX_ADAPTIVE_NP = 3;
+
+ _PTHREAD_MUTEX_NORMAL = _PTHREAD_MUTEX_TIMED_NP;
+ _PTHREAD_MUTEX_RECURSIVE = _PTHREAD_MUTEX_RECURSIVE_NP;
+ _PTHREAD_MUTEX_ERRORCHECK = _PTHREAD_MUTEX_ERRORCHECK_NP;
+ _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_NORMAL;
+ _PTHREAD_MUTEX_FAST_NP = _PTHREAD_MUTEX_ADAPTIVE_NP;
+
+
+ { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+ { took idefix' values}
+
+ ARG_MAX = 131072; {4096} { Maximum number of argument size }
+ NAME_MAX = 255; {14} { Maximum number of bytes in filename }
+ PATH_MAX = 4095; {255} { Maximum number of bytes in pathname }
+ SYS_NMLN = 65;
+{$ifdef FPC_USE_LIBC}
+ SIG_MAXSIG = 1024; // highest signal version
+{$else}
+ SIG_MAXSIG = 128; // highest signal version
+{$endif}
+
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+{
+ $Log: ptypes.inc,v $
+ Revision 1.14 2005/03/16 22:26:12 florian
+ + ansi<->wide implemented using iconv
+
+ Revision 1.13 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/linux/signal.inc b/rtl/linux/signal.inc
new file mode 100644
index 0000000000..24a8a7c999
--- /dev/null
+++ b/rtl/linux/signal.inc
@@ -0,0 +1,222 @@
+{
+ $Id: signal.inc,v 1.26 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+{********************
+ Signal
+********************}
+
+Const
+ { For sending a signal }
+{$ifdef SPARC}
+ SA_SIGINFO = $200;
+ SA_NOMASK = $20;
+
+ SIG_BLOCK = 1;
+ SIG_UNBLOCK = 2;
+ SIG_SETMASK = 4;
+{$else SPARC}
+ SA_NOCLDSTOP = 1;
+ SA_NOCLDWAIT = 2;
+ SA_SIGINFO = 4;
+ SA_SHIRQ = $04000000;
+ SA_STACK = $08000000;
+ SA_RESTART = $10000000;
+ SA_INTERRUPT = $20000000;
+ SA_NOMASK = $40000000;
+ SA_ONESHOT = $80000000;
+
+ SIG_BLOCK = 0;
+ SIG_UNBLOCK = 1;
+ SIG_SETMASK = 2;
+{$endif SPARC}
+
+ SIG_DFL = 0 ;
+ SIG_IGN = 1 ;
+ SIG_ERR = -1 ;
+
+{$ifdef cpusparc}
+ SIGHUP = 1;
+ SIGINT = 2;
+ SIGQUIT = 3;
+ SIGILL = 4;
+ SIGTRAP = 5;
+ SIGABRT = 6;
+ SIGIOT = 6;
+ SIGEMT = 7;
+ SIGFPE = 8;
+ SIGKILL = 9;
+ SIGBUS = 10;
+ SIGSEGV = 11;
+ SIGSYS = 12;
+ SIGPIPE = 13;
+ SIGALRM = 14;
+ SIGTERM = 15;
+ SIGURG = 16;
+ SIGSTOP = 17;
+ SIGTSTP = 18;
+ SIGCONT = 19;
+ SIGCHLD = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGIO = 23;
+ SIGPOLL = SIGIO;
+ SIGXCPU = 24;
+ SIGXFSZ = 25;
+ SIGVTALRM = 26;
+ SIGPROF = 27;
+ SIGWINCH = 28;
+ SIGLOST = 29;
+ SIGPWR = SIGLOST;
+ SIGUSR1 = 30;
+ SIGUSR2 = 31;
+{$else cpusparc}
+ SIGHUP = 1;
+ SIGINT = 2;
+ SIGQUIT = 3;
+ SIGILL = 4;
+ SIGTRAP = 5;
+ SIGABRT = 6;
+ SIGIOT = 6;
+ SIGBUS = 7;
+ SIGFPE = 8;
+ SIGKILL = 9;
+ SIGUSR1 = 10;
+ SIGSEGV = 11;
+ SIGUSR2 = 12;
+ SIGPIPE = 13;
+ SIGALRM = 14;
+ SIGTerm = 15;
+ SIGSTKFLT = 16;
+ SIGCHLD = 17;
+ SIGCONT = 18;
+ SIGSTOP = 19;
+ SIGTSTP = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGURG = 23;
+ SIGXCPU = 24;
+ SIGXFSZ = 25;
+ SIGVTALRM = 26;
+ SIGPROF = 27;
+ SIGWINCH = 28;
+ SIGIO = 29;
+ SIGPOLL = SIGIO;
+ SIGPWR = 30;
+ SIGUNUSED = 31;
+{$endif cpusparc}
+
+
+const
+ SI_PAD_SIZE = ((128 div sizeof(longint)) - 3);
+
+
+type
+ SigSet = array[0..wordsinsigset-1] of cint;
+ sigset_t= SigSet;
+ PSigSet = ^SigSet;
+ psigset_t=psigset;
+ TSigSet = SigSet;
+
+ psiginfo = ^tsiginfo;
+ tsiginfo = record
+ si_signo : longint;
+ si_errno : longint;
+ si_code : longint;
+ _sifields : record
+ case longint of
+ 0 : ( _pad : array[0..(SI_PAD_SIZE)-1] of longint );
+ 1 : ( _kill : record
+ _pid : pid_t;
+ _uid : uid_t;
+ end );
+ 2 : ( _timer : record
+ _timer1 : dword;
+ _timer2 : dword;
+ end );
+ 3 : ( _rt : record
+ _pid : pid_t;
+ _uid : uid_t;
+ _sigval : pointer;
+ end );
+ 4 : ( _sigchld : record
+ _pid : pid_t;
+ _uid : uid_t;
+ _status : longint;
+ _utime : clock_t;
+ _stime : clock_t;
+ end );
+ 5 : ( _sigfault : record
+ _addr : pointer;
+ end );
+ 6 : ( _sigpoll : record
+ _band : longint;
+ _fd : longint;
+ end );
+ end;
+ end;
+
+{ CPU dependent TSigContext }
+{$i sighndh.inc}
+
+type
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+ SigActionHandler = procedure(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+
+{$ifdef CPUARM}
+{$define NEWSIGNAL}
+{$endif CPUARM}
+
+{$ifdef CPUx86_64}
+{$define NEWSIGNAL}
+{$endif CPUx86_64}
+
+ SigActionRec = packed record // this is temporary for the migration
+ sa_handler : SigActionHandler;
+ {$ifdef NEWSIGNAL}
+ Sa_Flags : cuint;
+ Sa_restorer : SignalRestorer; { Obsolete - Don't use }
+ Sa_Mask : SigSet;
+ {$else NEWSIGNAL}
+ Sa_Mask : SigSet;
+ Sa_Flags : Longint;
+ Sa_restorer : SignalRestorer; { Obsolete - Don't use }
+ {$endif NEWSIGNAL}
+ end;
+ TSigActionRec = SigActionRec;
+ PSigActionRec = ^SigActionRec;
+
+{
+ $Log: signal.inc,v $
+ Revision 1.26 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.25 2005/02/05 22:53:43 peter
+ * use typecasted sigactionhandler, needed for arm
+
+ Revision 1.24 2005/02/05 22:45:54 peter
+ * sigactionhandler fixed for arm
+
+ Revision 1.23 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/sparc/bsyscall.inc b/rtl/linux/sparc/bsyscall.inc
new file mode 100644
index 0000000000..479d06c642
--- /dev/null
+++ b/rtl/linux/sparc/bsyscall.inc
@@ -0,0 +1,48 @@
+{
+ $Id: bsyscall.inc,v 1.2 2005/03/03 22:02:59 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$define FPC_BASEUNIX_HAS_FPPIPE}
+Function fppipe(var fildes : tfildes):cint;assembler;
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov 42,%g1
+ mov %i0,%o0
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ call fpseterrno
+ nop
+ mov -1,%i0
+ b .Lend
+ nop
+.LSyscOK:
+ st %o0,[%i0]
+ st %o1,[%i0+4]
+ mov 0,%i0
+.Lend:
+end;
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.2 2005/03/03 22:02:59 florian
+ * final fppipe fix hopefully
+
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/linux/sparc/cprt0.as b/rtl/linux/sparc/cprt0.as
new file mode 100644
index 0000000000..55425fb97d
--- /dev/null
+++ b/rtl/linux/sparc/cprt0.as
@@ -0,0 +1,93 @@
+/*
+ $Id: cprt0.as,v 1.5 2004/09/25 18:43:45 florian Exp $
+*/
+ .section ".text"
+ .align 4
+ .global _start
+ .type _start,#function
+_start:
+
+ /* Terminate the stack frame, and reserve space for functions to
+ drop their arguments. */
+ mov %g0, %fp
+ sub %sp, 6*4, %sp
+
+ /* Extract the arguments and environment as encoded on the stack. The
+ argument info starts after one register window (16 words) past the SP. */
+ ld [%sp+22*4], %o2
+ sethi %hi(operatingsystem_parameter_argc),%o1
+ or %o1,%lo(operatingsystem_parameter_argc),%o1
+ st %o2, [%o1]
+
+ add %sp, 23*4, %o0
+ sethi %hi(operatingsystem_parameter_argv),%o1
+ or %o1,%lo(operatingsystem_parameter_argv),%o1
+ st %o0, [%o1]
+
+ /* envp=(argc+1)*4+argv */
+ inc %o2
+ sll %o2, 2, %o2
+ add %o2, %o0, %o2
+ sethi %hi(operatingsystem_parameter_envp),%o1
+ or %o1,%lo(operatingsystem_parameter_envp),%o1
+ st %o2, [%o1]
+
+ /* reload the addresses for C startup code */
+ ld [%sp+22*4], %o1
+ add %sp, 23*4, %o2
+
+
+ /* Load the addresses of the user entry points. */
+ sethi %hi(PASCALMAIN), %o0
+ sethi %hi(_init), %o3
+ sethi %hi(_fini), %o4
+ or %o0, %lo(PASCALMAIN), %o0
+ or %o3, %lo(_init), %o3
+ or %o4, %lo(_fini), %o4
+
+ /* When starting a binary via the dynamic linker, %g1 contains the
+ address of the shared library termination function, which will be
+ registered with atexit(). If we are statically linked, this will
+ be NULL. */
+ mov %g1, %o5
+
+ /* Let libc do the rest of the initialization, and call main. */
+ call __libc_start_main
+ nop
+
+ /* Die very horribly if exit returns. */
+ unimp
+
+ .size _start, .-_start
+
+ .globl _haltproc
+ .type _haltproc,@function
+ _haltproc:
+ mov 1, %g1 /* "exit" system call */
+ sethi %hi(operatingsystem_result),%o0
+ or %o0,%lo(operatingsystem_result),%o0
+ ldsh [%o0], %o0 /* give exit status to parent process*/
+ ta 0x10 /* dot the system call */
+ nop /* delay slot */
+ /* Die very horribly if exit returns. */
+ unimp
+
+.data
+
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+/*
+ $Log: cprt0.as,v $
+ Revision 1.5 2004/09/25 18:43:45 florian
+ * fixed symbol names
+
+ Revision 1.4 2004/09/25 12:25:32 florian
+ * first implementation
+
+ Revision 1.3 2003/05/23 21:09:14 florian
+ + dummy implementation readded to satisfy makefile
+*/
diff --git a/rtl/linux/sparc/dllprt0.as b/rtl/linux/sparc/dllprt0.as
new file mode 100644
index 0000000000..d8d5c32837
--- /dev/null
+++ b/rtl/linux/sparc/dllprt0.as
@@ -0,0 +1,9 @@
+/*
+ $Id: dllprt0.as,v 1.3 2003/05/23 21:09:14 florian Exp $
+*/
+
+/*
+ $Log: dllprt0.as,v $
+ Revision 1.3 2003/05/23 21:09:14 florian
+ + dummy implementation readded to satisfy makefile
+*/
diff --git a/rtl/linux/sparc/gprt0.as b/rtl/linux/sparc/gprt0.as
new file mode 100644
index 0000000000..3f5a3db9f4
--- /dev/null
+++ b/rtl/linux/sparc/gprt0.as
@@ -0,0 +1,110 @@
+/*
+ $Id: gprt0.as,v 1.4 2004/11/05 21:36:36 florian Exp $
+*/
+ .section ".text"
+ .align 4
+ .global _start
+ .type _start,#function
+_start:
+
+ /* Terminate the stack frame, and reserve space for functions to
+ drop their arguments. */
+ mov %g0, %fp
+ sub %sp, 6*4, %sp
+
+ /* Extract the arguments and environment as encoded on the stack. The
+ argument info starts after one register window (16 words) past the SP. */
+ ld [%sp+22*4], %o2
+ sethi %hi(operatingsystem_parameter_argc),%o1
+ or %o1,%lo(operatingsystem_parameter_argc),%o1
+ st %o2, [%o1]
+
+ add %sp, 23*4, %o0
+ sethi %hi(operatingsystem_parameter_argv),%o1
+ or %o1,%lo(operatingsystem_parameter_argv),%o1
+ st %o0, [%o1]
+
+ /* envp=(argc+1)*4+argv */
+ inc %o2
+ sll %o2, 2, %o2
+ add %o2, %o0, %o2
+ sethi %hi(operatingsystem_parameter_envp),%o1
+ or %o1,%lo(operatingsystem_parameter_envp),%o1
+ st %o2, [%o1]
+
+ /* reload the addresses for C startup code */
+ ld [%sp+22*4], %o1
+ add %sp, 23*4, %o2
+
+
+ /* Load the addresses of the user entry points. */
+ sethi %hi(main_stub), %o0
+ sethi %hi(_init), %o3
+ sethi %hi(_fini), %o4
+ or %o0, %lo(main_stub), %o0
+ or %o3, %lo(_init), %o3
+ or %o4, %lo(_fini), %o4
+
+ /* When starting a binary via the dynamic linker, %g1 contains the
+ address of the shared library termination function, which will be
+ registered with atexit(). If we are statically linked, this will
+ be NULL. */
+ mov %g1, %o5
+
+ /* Let libc do the rest of the initialization, and call main. */
+ call __libc_start_main
+ nop
+
+ /* Die very horribly if exit returns. */
+ unimp
+
+ .size _start, .-_start
+
+ main_stub:
+ /* Initialize gmon */
+ sethi %hi(_start), %o0
+ sethi %hi(_etext), %o1
+ or %o0, %lo(_start), %o0
+ or %o1, %lo(_etext), %o1
+ call monstartup
+ nop
+
+ sethi %hi(_mcleanup), %o0
+ or %o0, %lo(_mcleanup), %o0
+ call atexit
+ nop
+
+ /* start the program */
+ call PASCALMAIN
+ nop
+
+ ba _haltproc
+ nop
+
+ .globl _haltproc
+ .type _haltproc,@function
+ _haltproc:
+ mov 1, %g1 /* "exit" system call */
+ sethi %hi(operatingsystem_result),%o0
+ or %o0,%lo(operatingsystem_result),%o0
+ ldsh [%o0], %o0 /* give exit status to parent process*/
+ ta 0x10 /* dot the system call */
+ nop /* delay slot */
+ /* Die very horribly if exit returns. */
+ unimp
+
+.data
+
+ .comm ___fpc_brk_addr,4 /* heap management */
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+/*
+ $Log: gprt0.as,v $
+ Revision 1.4 2004/11/05 21:36:36 florian
+ * initial implementation
+
+ Revision 1.3 2003/05/23 21:09:14 florian
+ + dummy implementation readded to satisfy makefile
+*/
diff --git a/rtl/linux/sparc/prt0.as b/rtl/linux/sparc/prt0.as
new file mode 100644
index 0000000000..53f64a0e1f
--- /dev/null
+++ b/rtl/linux/sparc/prt0.as
@@ -0,0 +1,103 @@
+# $Id: prt0.as,v 1.9 2004/07/05 21:07:38 florian Exp $
+/* Startup code for elf32-sparc
+ Copyright (C) 1997, 1998 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+ Contributed by Richard Henderson <richard@gnu.ai.mit.edu>, 1997.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA. */
+
+ .section ".text"
+ .align 4
+ .global _start
+ .type _start,#function
+_start:
+
+ /* Terminate the stack frame, and reserve space for functions to
+ drop their arguments. */
+ mov %g0, %fp
+ sub %sp, 6*4, %sp
+
+ /* Extract the arguments and environment as encoded on the stack. The
+ argument info starts after one register window (16 words) past the SP. */
+ ld [%sp+22*4], %o2
+ sethi %hi(operatingsystem_parameter_argc),%o1
+ or %o1,%lo(operatingsystem_parameter_argc),%o1
+ st %o2, [%o1]
+
+ add %sp, 23*4, %o0
+ sethi %hi(operatingsystem_parameter_argv),%o1
+ or %o1,%lo(operatingsystem_parameter_argv),%o1
+ st %o0, [%o1]
+
+ /* envp=(argc+1)*4+argv */
+ inc %o2
+ sll %o2, 2, %o2
+ add %o2, %o0, %o2
+ sethi %hi(operatingsystem_parameter_envp),%o1
+ or %o1,%lo(operatingsystem_parameter_envp),%o1
+ st %o2, [%o1]
+
+ /* Call the user program entry point. */
+ call PASCALMAIN
+ nop
+
+.globl _haltproc
+.type _haltproc,@function
+_haltproc:
+ mov 1, %g1 /* "exit" system call */
+ sethi %hi(operatingsystem_result),%o0
+ or %o0,%lo(operatingsystem_result),%o0
+ ldsh [%o0], %o0 /* give exit status to parent process*/
+ ta 0x10 /* dot the system call */
+ nop /* delay slot */
+ /* Die very horribly if exit returns. */
+ unimp
+
+ .size _start, .-_start
+
+ .comm operatingsystem_parameter_envp,4
+ .comm operatingsystem_parameter_argc,4
+ .comm operatingsystem_parameter_argv,4
+
+#
+# $Log: prt0.as,v $
+# Revision 1.9 2004/07/05 21:07:38 florian
+# * remade makefile (too old fpcmake)
+# * fixed sparc startup code
+#
+# Revision 1.8 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.7 2004/05/27 23:15:02 peter
+# * startup argc,argv,envp fix
+# * stat fixed
+#
+# Revision 1.6 2004/05/17 20:56:56 peter
+# * use ldsh to load exitcode
+#
+# Revision 1.5 2004/03/16 10:19:11 mazen
+# + _haltproc definition for linux/sparc
+#
+# Revision 1.4 2003/06/02 22:03:37 mazen
+# *making init and fini symbols compatible FPC code by
+# changing _init ==> fpc_initialize
+# and _fini ==> fpc_finalize
+#
+# Revision 1.3 2002/11/18 19:03:46 mazen
+# * start code of gcc adapted for FPC
+#
+
diff --git a/rtl/linux/sparc/sighnd.inc b/rtl/linux/sparc/sighnd.inc
new file mode 100644
index 0000000000..7818efc835
--- /dev/null
+++ b/rtl/linux/sparc/sighnd.inc
@@ -0,0 +1,96 @@
+{
+ $Id: sighnd.inc,v 1.10 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ FPE_INTDIV = 1;
+ FPE_INTOVF = 2;
+ FPE_FLTDIV = 3;
+ FPE_FLTOVF = 4;
+ FPE_FLTUND = 5;
+ FPE_FLTRES = 6;
+ FPE_FLTINV = 7;
+ FPE_FLTSUB = 8;
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+ res : word;
+ addr : pointer;
+begin
+ res:=0;
+ addr:=nil;
+ case sig of
+ SIGFPE :
+ begin
+ addr := siginfo^._sifields._sigfault._addr;
+ res := 207;
+ case siginfo^.si_code of
+ FPE_INTDIV:
+ res:=200;
+ FPE_INTOVF:
+ res:=205;
+ FPE_FLTDIV:
+ res:=200;
+ FPE_FLTOVF:
+ res:=205;
+ FPE_FLTUND:
+ res:=206;
+ FPE_FLTRES,
+ FPE_FLTINV,
+ FPE_FLTSUB:
+ res:=216;
+ else
+ res:=207;
+ end;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ begin
+ addr := siginfo^._sifields._sigfault._addr;
+ res:=216;
+ end;
+ end;
+ reenable_signal(sig);
+ { give runtime error at the position where the signal was raised }
+ if res<>0 then
+ HandleErrorAddrFrame(res,addr,nil);
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.10 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.8 2005/02/05 23:46:12 peter
+ * set addr:=nil for other signals
+
+ Revision 1.7 2005/02/05 23:45:38 peter
+ * sigcontext is invalid, use siginfo only
+
+ Revision 1.6 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/sparc/sighndh.inc b/rtl/linux/sparc/sighndh.inc
new file mode 100644
index 0000000000..577197a6d2
--- /dev/null
+++ b/rtl/linux/sparc/sighndh.inc
@@ -0,0 +1,59 @@
+{
+ $Id: sighndh.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ TSigContext
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+const
+ __SUNOS_MAXWIN = 31;
+
+type
+ twbuf = record
+ locals : array[0..7] of longint;
+ ins : array[0..7] of longint;
+ end;
+
+ PSigContext = ^TSigContext;
+ TSigContext = record
+ sigc_onstack, { state to restore }
+ sigc_mask, { sigmask to restore }
+ sigc_sp, { stack pointer }
+ sigc_pc, { program counter }
+ sigc_npc, { next program counter }
+ sigc_psr, { for condition codes etc }
+ sigc_g1, { User uses these two registers }
+ sigc_o0, { within the trampoline code. }
+ { Now comes information regarding the users window set
+ * at the time of the signal. }
+ sigc_oswins : longint; { outstanding windows }
+ { stack ptrs for each regwin buf }
+ sigc_spbuf : array[0..__SUNOS_MAXWIN-1] of pchar;
+ { Windows to restore after signal }
+ sigc_wbuf : array[0..__SUNOS_MAXWIN] of twbuf;
+ end;
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/sparc/stat.inc b/rtl/linux/sparc/stat.inc
new file mode 100644
index 0000000000..5b6aeb4e7b
--- /dev/null
+++ b/rtl/linux/sparc/stat.inc
@@ -0,0 +1,67 @@
+{
+ $Id: stat.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2003 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ Stat = packed Record // No unix typing because of differences
+ case byte of
+ 0: (st_dev : word;
+ __pad1 : word;
+ st_ino : cardinal;
+ st_mode : word;
+ nlink : smallint;
+ uid : word;
+ gid : word;
+ rdev : word;
+ __pad2 : word;
+ st_size : longint;
+ st_atime : longint;
+ st_atime_nsecs : cardinal;
+ st_mtime : longint;
+ st_mtime_nsecs : cardinal;
+ st_ctime : longint;
+ st_ctime_nsecs : cardinal;
+ st_blksize : longint;
+ st_blocks : longint;
+ __unused1,
+ __unused2 : cardinal;
+ );
+ 1: (dev : word;
+ __pad3 : word;
+ ino : word;
+ mode : cardinal;
+ nlink_dummy : smallint;
+ uid_dummy,
+ gid_dummy,
+ rdev_dummy : word;
+ __pad4 : word;
+ size : longint;
+ atime,
+ __unused1_dummy,
+ mtime,
+ __unused2_dummy,
+ ctime,
+ __unused3_dummy,
+ blksize,
+ blocks : longint;
+ __unused4_dummy,
+ __unused5_dummy : cardinal;
+ );
+ end;
+
+{
+ $Log: stat.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/sparc/syscall.inc b/rtl/linux/sparc/syscall.inc
new file mode 100644
index 0000000000..d0e6568760
--- /dev/null
+++ b/rtl/linux/sparc/syscall.inc
@@ -0,0 +1,329 @@
+{
+ $Id: syscall.inc,v 1.19 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+ {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{$define FPC_SYSTEM_HAS_FPFORK}
+{
+ behaviour of result of fork on sparc/linux is different than on other
+ linux flavours
+}
+function Fpfork : pid_t; [public, alias : 'FPC_SYSC_FORK'];assembler;
+asm
+ mov 2,%g1
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ ba .LReturn
+ mov -1,%i0
+.LSyscOK:
+ // o1 contains 1 in the parent
+ // and 0 in the child
+ sub %o1, 1, %o1
+ and %o0, %o1, %i0
+.LReturn:
+end;
+
+
+{*****************************************************************************
+ --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ mov %i1,%o0
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ mov %i1,%o0
+ mov %i2,%o1
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ mov %i1,%o0
+ mov %i2,%o1
+ mov %i3,%o2
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o2
+ ba .LNoThread
+ or %o2,%lo(Errno+4),%o2
+.LThread:
+ sethi %hi(Errno),%o0
+ ld [%o3],%o1
+ or %o0,%lo(Errno),%o0
+ call %o1
+ nop
+.LNoThread:
+ st %o0,[%o2]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ mov %i1,%o0
+ mov %i2,%o1
+ mov %i3,%o2
+ mov %i4,%o3
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ mov %i1,%o0
+ mov %i2,%o1
+ mov %i3,%o2
+ mov %i4,%o3
+ mov %i5,%o4
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+asm
+ mov %i0,%g1
+ mov %i1,%o0
+ mov %i2,%o1
+ mov %i3,%o2
+ mov %i4,%o3
+ ld [%i6+92],%o5
+ mov %i5,%o4
+ ta 0x10
+ bcc .LSyscOK
+ nop
+ mov %o0,%l0
+ sethi %hi(fpc_threadvar_relocate_proc),%o2
+ or %o2,%lo(fpc_threadvar_relocate_proc),%o2
+ ld [%o2],%o3
+ subcc %o3,%g0,%g0
+ bne .LThread
+ nop
+ sethi %hi(Errno+4),%o0
+ ba .LNoThread
+ or %o0,%lo(Errno+4),%o0
+.LThread:
+ sethi %hi(Errno),%o0
+ or %o0,%lo(Errno),%o0
+ call %o3
+ ld [%o0],%o0
+.LNoThread:
+ st %l0,[%o0]
+ mov -1,%o0
+.LSyscOK:
+ mov %o0,%i0
+end;
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.19 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+
+ Revision 1.18 2005/03/03 20:13:44 florian
+ + sparc specific pipe implementation
+
+ Revision 1.17 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/sparc/syscallh.inc b/rtl/linux/sparc/syscallh.inc
new file mode 100644
index 0000000000..593ec6f478
--- /dev/null
+++ b/rtl/linux/sparc/syscallh.inc
@@ -0,0 +1,49 @@
+{
+ $Id: syscallh.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for powerpc *nix.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+ TSysResult = longint; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+ TSysParam = Longint;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult; external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL6';
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/sparc/sysnr.inc b/rtl/linux/sparc/sysnr.inc
new file mode 100644
index 0000000000..7b19024e41
--- /dev/null
+++ b/rtl/linux/sparc/sysnr.inc
@@ -0,0 +1,285 @@
+{
+ $Id: sysnr.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Peter Vreman
+ member of the Free Pascal development team.
+
+ Syscall nrs for 2.4.21 Sparc
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+
+Const
+ syscall_nr_exit = 1 ; // Common
+ syscall_nr_fork = 2 ; // Common
+ syscall_nr_read = 3 ; // Common
+ syscall_nr_write = 4 ; // Common
+ syscall_nr_open = 5 ; // Common
+ syscall_nr_close = 6 ; // Common
+ syscall_nr_wait4 = 7 ; // Common
+ syscall_nr_creat = 8 ; // Common
+ syscall_nr_link = 9 ; // Common
+ syscall_nr_unlink = 10 ; // Common
+ syscall_nr_execv = 11 ; // SunOS Specific
+ syscall_nr_chdir = 12 ; // Common
+ syscall_nr_chown = 13 ; // Common
+ syscall_nr_mknod = 14 ; // Common
+ syscall_nr_chmod = 15 ; // Common
+ syscall_nr_lchown = 16 ; // Common
+ syscall_nr_brk = 17 ; // Common
+ syscall_nr_perfctr = 18 ; // Performance counter operations
+ syscall_nr_lseek = 19 ; // Common
+ syscall_nr_getpid = 20 ; // Common
+ syscall_nr_capget = 21 ; // Linux Specific
+ syscall_nr_capset = 22 ; // Linux Specific
+ syscall_nr_setuid = 23 ; // Implemented via setreuid in SunOS
+ syscall_nr_getuid = 24 ; // Common
+// syscall_nr_time alias = 25 ENOSYS under SunOS
+ syscall_nr_ptrace = 26 ; // Common
+ syscall_nr_alarm = 27 ; // Implemented via setitimer in SunOS
+ syscall_nr_sigaltstack = 28 ; // Common
+ syscall_nr_pause = 29 ; // Is sigblock(0)->sigpause() in SunOS
+ syscall_nr_utime = 30 ; // Implemented via utimes() under SunOS
+ syscall_nr_lchown32 = 31 ; // Linux sparc32 specific
+ syscall_nr_fchown32 = 32 ; // Linux sparc32 specific
+ syscall_nr_access = 33 ; // Common
+ syscall_nr_nice = 34 ; // Implemented via get/setpriority() in SunOS
+ syscall_nr_chown32 = 35 ; // Linux sparc32 specific
+ syscall_nr_sync = 36 ; // Common
+ syscall_nr_kill = 37 ; // Common
+ syscall_nr_stat = 38 ; // Common
+ syscall_nr_sendfile = 39 ; // Linux Specific
+ syscall_nr_lstat = 40 ; // Common
+ syscall_nr_dup = 41 ; // Common
+ syscall_nr_pipe = 42 ; // Common
+ syscall_nr_times = 43 ; // Implemented via getrusage() in SunOS
+ syscall_nr_getuid32 = 44 ; // Linux sparc32 specific
+ syscall_nr_umount2 = 45 ; // Linux Specific
+ syscall_nr_setgid = 46 ; // Implemented via setregid() in SunOS
+ syscall_nr_getgid = 47 ; // Common
+ syscall_nr_signal = 48 ; // Implemented via sigvec() in SunOS
+ syscall_nr_geteuid = 49 ; // SunOS calls getuid()
+ syscall_nr_getegid = 50 ; // SunOS calls getgid()
+ syscall_nr_acct = 51 ; // Common
+// syscall_nr_memory_ordering= 52 Linux sparc64 specific
+ syscall_nr_getgid32 = 53 ; // Linux sparc32 specific
+ syscall_nr_ioctl = 54 ; // Common
+ syscall_nr_reboot = 55 ; // Common
+ syscall_nr_mmap2 = 56 ; // Linux sparc32 Specific
+ syscall_nr_symlink = 57 ; // Common
+ syscall_nr_readlink = 58 ; // Common
+ syscall_nr_execve = 59 ; // Common
+ syscall_nr_umask = 60 ; // Common
+ syscall_nr_chroot = 61 ; // Common
+ syscall_nr_fstat = 62 ; // Common
+ syscall_nr_fstat64 = 63 ; // Linux sparc32 Specific
+ syscall_nr_getpagesize = 64 ; // Common
+ syscall_nr_msync = 65 ; // Common in newer 1.3.x revs...
+ syscall_nr_vfork = 66 ; // Common
+ syscall_nr_pread = 67 ; // Linux Specific
+ syscall_nr_pwrite = 68 ; // Linux Specific
+ syscall_nr_geteuid32 = 69 ; // Linux sparc32, sbrk under SunOS
+ syscall_nr_getegid32 = 70 ; // Linux sparc32, sstk under SunOS
+ syscall_nr_mmap = 71 ; // Common
+ syscall_nr_setreuid32 = 72 ; // Linux sparc32, vadvise under SunOS
+ syscall_nr_munmap = 73 ; // Common
+ syscall_nr_mprotect = 74 ; // Common
+ syscall_nr_madvise = 75 ; // Common
+ syscall_nr_vhangup = 76 ; // Common
+ syscall_nr_truncate64 = 77 ; // Linux sparc32 Specific
+ syscall_nr_mincore = 78 ; // Common
+ syscall_nr_getgroups = 79 ; // Common
+ syscall_nr_setgroups = 80 ; // Common
+ syscall_nr_getpgrp = 81 ; // Common
+ syscall_nr_setgroups32 = 82 ; // Linux sparc32, setpgrp under SunOS
+ syscall_nr_setitimer = 83 ; // Common
+ syscall_nr_ftruncate64 = 84 ; // Linux sparc32 Specific
+ syscall_nr_swapon = 85 ; // Common
+ syscall_nr_getitimer = 86 ; // Common
+ syscall_nr_setuid32 = 87 ; // Linux sparc32, gethostname under SunOS
+ syscall_nr_sethostname = 88 ; // Common
+ syscall_nr_setgid32 = 89 ; // Linux sparc32, getdtablesize under SunOS
+ syscall_nr_dup2 = 90 ; // Common
+ syscall_nr_setfsuid32 = 91 ; // Linux sparc32, getdopt under SunOS
+ syscall_nr_fcntl = 92 ; // Common
+ syscall_nr_select = 93 ; // Common
+ syscall_nr_setfsgid32 = 94 ; // Linux sparc32, setdopt under SunOS
+ syscall_nr_fsync = 95 ; // Common
+ syscall_nr_setpriority = 96 ; // Common
+ syscall_nr_socket = 97 ; // Common
+ syscall_nr_connect = 98 ; // Common
+ syscall_nr_accept = 99 ; // Common
+ syscall_nr_getpriority = 100 ; // Common
+ syscall_nr_rt_sigreturn = 101 ; // Linux Specific
+ syscall_nr_rt_sigaction = 102 ; // Linux Specific
+ syscall_nr_rt_sigprocmask = 103 ; // Linux Specific
+ syscall_nr_rt_sigpending = 104 ; // Linux Specific
+ syscall_nr_rt_sigtimedwait = 105 ; // Linux Specific
+ syscall_nr_rt_sigqueueinfo = 106 ; // Linux Specific
+ syscall_nr_rt_sigsuspend = 107 ; // Linux Specific
+ syscall_nr_setresuid32 = 108 ; // Linux Specific, sigvec under SunOS
+ syscall_nr_getresuid32 = 109 ; // Linux Specific, sigblock under SunOS
+ syscall_nr_setresgid32 = 110 ; // Linux Specific, sigsetmask under SunOS
+ syscall_nr_getresgid32 = 111 ; // Linux Specific, sigpause under SunOS
+ syscall_nr_setregid32 = 112 ; // Linux sparc32, sigstack under SunOS
+ syscall_nr_recvmsg = 113 ; // Common
+ syscall_nr_sendmsg = 114 ; // Common
+ syscall_nr_getgroups32 = 115 ; // Linux sparc32, vtrace under SunOS
+ syscall_nr_gettimeofday = 116 ; // Common
+ syscall_nr_getrusage = 117 ; // Common
+ syscall_nr_getsockopt = 118 ; // Common
+ syscall_nr_getcwd = 119 ; // Linux Specific
+ syscall_nr_readv = 120 ; // Common
+ syscall_nr_writev = 121 ; // Common
+ syscall_nr_settimeofday = 122 ; // Common
+ syscall_nr_fchown = 123 ; // Common
+ syscall_nr_fchmod = 124 ; // Common
+ syscall_nr_recvfrom = 125 ; // Common
+ syscall_nr_setreuid = 126 ; // Common
+ syscall_nr_setregid = 127 ; // Common
+ syscall_nr_rename = 128 ; // Common
+ syscall_nr_truncate = 129 ; // Common
+ syscall_nr_ftruncate = 130 ; // Common
+ syscall_nr_flock = 131 ; // Common
+ syscall_nr_lstat64 = 132 ; // Linux sparc32 Specific
+ syscall_nr_sendto = 133 ; // Common
+ syscall_nr_shutdown = 134 ; // Common
+ syscall_nr_socketpair = 135 ; // Common
+ syscall_nr_mkdir = 136 ; // Common
+ syscall_nr_rmdir = 137 ; // Common
+ syscall_nr_utimes = 138 ; // SunOS Specific
+ syscall_nr_stat64 = 139 ; // Linux sparc32 Specific
+// syscall_nr_adjtime = 140 SunOS Specific
+ syscall_nr_getpeername = 141 ; // Common
+// syscall_nr_gethostid = 142 SunOS Specific
+ syscall_nr_gettid = 143 ; // ENOSYS under SunOS
+ syscall_nr_getrlimit = 144 ; // Common
+ syscall_nr_setrlimit = 145 ; // Common
+ syscall_nr_pivot_root = 146 ; // Linux Specific, killpg under SunOS
+ syscall_nr_prctl = 147 ; // ENOSYS under SunOS
+ syscall_nr_pciconfig_read = 148 ; // ENOSYS under SunOS
+ syscall_nr_pciconfig_write = 149 ; // ENOSYS under SunOS
+ syscall_nr_getsockname = 150 ; // Common
+// syscall_nr_getmsg = 151 SunOS Specific
+// syscall_nr_putmsg = 152 SunOS Specific
+ syscall_nr_poll = 153 ; // Common
+ syscall_nr_getdents64 = 154 ; // Linux specific
+ syscall_nr_fcntl64 = 155 ; // Linux sparc32 Specific
+// syscall_nr_getdirentries = 156 SunOS Specific
+ syscall_nr_statfs = 157 ; // Common
+ syscall_nr_fstatfs = 158 ; // Common
+ syscall_nr_umount = 159 ; // Common
+// syscall_nr_async_daemon = 160 SunOS Specific
+// syscall_nr_getfh = 161 SunOS Specific
+ syscall_nr_getdomainname = 162 ; // SunOS Specific
+ syscall_nr_setdomainname = 163 ; // Common
+// syscall_nr_ni_syscall = 164 ENOSYS under SunOS
+ syscall_nr_quotactl = 165 ; // Common
+// syscall_nr_exportfs = 166 SunOS Specific
+ syscall_nr_mount = 167 ; // Common
+ syscall_nr_ustat = 168 ; // Common
+// syscall_nr_semsys = 169 SunOS Specific
+// syscall_nr_msgsys = 170 SunOS Specific
+// syscall_nr_shmsys = 171 SunOS Specific
+// syscall_nr_auditsys = 172 SunOS Specific
+// syscall_nr_rfssys = 173 SunOS Specific
+ syscall_nr_getdents = 174 ; // Common
+ syscall_nr_setsid = 175 ; // Common
+ syscall_nr_fchdir = 176 ; // Common
+// syscall_nr_fchroot = 177 SunOS Specific
+// syscall_nr_vpixsys = 178 SunOS Specific
+// syscall_nr_aioread = 179 SunOS Specific
+// syscall_nr_aiowrite = 180 SunOS Specific
+// syscall_nr_aiowait = 181 SunOS Specific
+// syscall_nr_aiocancel = 182 SunOS Specific
+ syscall_nr_sigpending = 183 ; // Common
+ syscall_nr_query_module = 184 ; // Linux Specific
+ syscall_nr_setpgid = 185 ; // Common
+// syscall_nr_pathconf = 186 SunOS Specific
+ syscall_nr_tkill = 187 ; // SunOS: fpathconf
+// syscall_nr_sysconf = 188 SunOS Specific
+ syscall_nr_uname = 189 ; // Linux Specific
+ syscall_nr_init_module = 190 ; // Linux Specific
+ syscall_nr_personality = 191 ; // Linux Specific
+// syscall_nr_prof = 192 Linux Specific
+// syscall_nr_break = 193 Linux Specific
+// syscall_nr_lock = 194 Linux Specific
+// syscall_nr_mpx = 195 Linux Specific
+// syscall_nr_ulimit = 196 Linux Specific
+ syscall_nr_getppid = 197 ; // Linux Specific
+ syscall_nr_sigaction = 198 ; // Linux Specific
+ syscall_nr_sgetmask = 199 ; // Linux Specific
+ syscall_nr_ssetmask = 200 ; // Linux Specific
+ syscall_nr_sigsuspend = 201 ; // Linux Specific
+ syscall_nr_oldlstat = 202 ; // Linux Specific
+ syscall_nr_uselib = 203 ; // Linux Specific
+ syscall_nr_readdir = 204 ; // Linux Specific
+ syscall_nr_readahead = 205 ; // Linux Specific
+ syscall_nr_socketcall = 206 ; // Linux Specific
+ syscall_nr_syslog = 207 ; // Linux Specific
+// syscall_nr_olduname = 208 Linux Specific
+// syscall_nr_iopl = 209 Linux Specific - i386 specific, unused
+// syscall_nr_idle = 210 Linux Specific - was sys_idle, now unused
+// syscall_nr_vm86 = 211 Linux Specific - i386 specific, unused
+ syscall_nr_waitpid = 212 ; // Linux Specific
+ syscall_nr_swapoff = 213 ; // Linux Specific
+ syscall_nr_sysinfo = 214 ; // Linux Specific
+ syscall_nr_ipc = 215 ; // Linux Specific
+ syscall_nr_sigreturn = 216 ; // Linux Specific
+ syscall_nr_clone = 217 ; // Linux Specific
+// syscall_nr_modify_ldt = 218 Linux Specific - i386 specific, unused
+ syscall_nr_adjtimex = 219 ; // Linux Specific
+ syscall_nr_sigprocmask = 220 ; // Linux Specific
+ syscall_nr_create_module = 221 ; // Linux Specific
+ syscall_nr_delete_module = 222 ; // Linux Specific
+ syscall_nr_get_kernel_syms = 223 ; // Linux Specific
+ syscall_nr_getpgid = 224 ; // Linux Specific
+ syscall_nr_bdflush = 225 ; // Linux Specific
+ syscall_nr_sysfs = 226 ; // Linux Specific
+ syscall_nr_afs_syscall = 227 ; // Linux Specific
+ syscall_nr_setfsuid = 228 ; // Linux Specific
+ syscall_nr_setfsgid = 229 ; // Linux Specific
+ syscall_nr__newselect = 230 ; // Linux Specific
+ syscall_nr_time = 231 ; // Linux Specific
+// syscall_nr_oldstat = 232 Linux Specific
+ syscall_nr_stime = 233 ; // Linux Specific
+// syscall_nr_oldfstat = 234 Linux Specific
+// syscall_nr_phys = 235 Linux Specific
+ syscall_nr__llseek = 236 ; // Linux Specific
+ syscall_nr_mlock = 237;
+ syscall_nr_munlock = 238;
+ syscall_nr_mlockall = 239;
+ syscall_nr_munlockall = 240;
+ syscall_nr_sched_setparam = 241;
+ syscall_nr_sched_getparam = 242;
+ syscall_nr_sched_setscheduler = 243;
+ syscall_nr_sched_getscheduler = 244;
+ syscall_nr_sched_yield = 245;
+ syscall_nr_sched_get_priority_max = 246;
+ syscall_nr_sched_get_priority_min = 247;
+ syscall_nr_sched_rr_get_interval= 248;
+ syscall_nr_nanosleep = 249;
+ syscall_nr_mremap = 250;
+ syscall_nr__sysctl = 251;
+ syscall_nr_getsid = 252;
+ syscall_nr_fdatasync = 253;
+ syscall_nr_nfsservctl = 254;
+ syscall_nr_aplib = 255;
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/syslinux.pp b/rtl/linux/syslinux.pp
new file mode 100644
index 0000000000..4d342eaddd
--- /dev/null
+++ b/rtl/linux/syslinux.pp
@@ -0,0 +1 @@
+{$i system.pp}
diff --git a/rtl/linux/sysos.inc b/rtl/linux/sysos.inc
new file mode 100644
index 0000000000..4aac90fac5
--- /dev/null
+++ b/rtl/linux/sysos.inc
@@ -0,0 +1,176 @@
+{
+ $Id: sysos.inc,v 1.5 2005/02/13 21:47:56 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+
+const clib = 'c';
+
+type libcint=longint;
+ plibcint=^libcint;
+
+function geterrnolocation: Plibcint; cdecl;external clib name'__errno_location';
+
+function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ geterrno:=geterrnolocation^;
+end;
+
+procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
+begin
+ geterrnolocation^:=err;
+end;
+
+{$else}
+
+{$ifdef ver1_0}
+Var
+{$else}
+ThreadVar
+{$endif}
+ Errno : longint;
+
+function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ GetErrno:=Errno;
+end;
+
+procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
+
+begin
+ Errno:=err;
+end;
+{$endif}
+
+{ OS dependant parts }
+
+{$I errno.inc} // error numbers
+{$I ostypes.inc} // c-types, unix base types, unix base structures
+{$I osmacro.inc}
+
+{$ifdef FPC_USE_LIBC}
+ {$Linklib c}
+ {$i oscdeclh.inc}
+{$else}
+ {$I syscallh.inc}
+ {$I syscall.inc}
+ {$I sysnr.inc}
+ {$I ossysc.inc}
+{$endif}
+
+
+{*****************************************************************************
+ Error conversion
+*****************************************************************************}
+
+{
+ The lowlevel file functions should take care of setting the InOutRes to the
+ correct value if an error has occured, else leave it untouched
+}
+
+Function PosixToRunError (PosixErrno : longint) : longint;
+{
+ Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+ if PosixErrNo=0 then { Else it will go through all the cases }
+ exit(0);
+ case PosixErrNo of
+ ESysENFILE,
+ ESysEMFILE : Inoutres:=4;
+ ESysENOENT : Inoutres:=2;
+ ESysEBADF : Inoutres:=6;
+ ESysENOMEM,
+ ESysEFAULT : Inoutres:=217;
+ ESysEINVAL : Inoutres:=218;
+ ESysEPIPE,
+ ESysEINTR,
+ ESysEIO,
+ ESysEAGAIN,
+ ESysENOSPC : Inoutres:=101;
+ ESysENAMETOOLONG : Inoutres := 3;
+ ESysEROFS,
+ ESysEEXIST,
+ ESysENOTEMPTY,
+ ESysEACCES : Inoutres:=5;
+ ESysEISDIR : InOutRes:=5;
+ else
+ begin
+ InOutRes := Integer(PosixErrno);
+ end;
+ end;
+ PosixToRunError:=InOutRes;
+end;
+
+
+Function Errno2InoutRes : longint;
+begin
+ Errno2InoutRes:=PosixToRunError(getErrno);
+ InoutRes:=Errno2InoutRes;
+end;
+
+
+{*****************************************************************************
+ Low Level File Routines
+*****************************************************************************}
+
+Function Do_IsDevice(Handle:THandle):boolean;
+{
+ Interface to Unix ioctl call.
+ Performs various operations on the filedescriptor Handle.
+ Ndx describes the operation to perform.
+ Data points to data needed for the Ndx function. The structure of this
+ data is function-dependent.
+}
+const
+{$ifdef PowerPC}
+ IOCtl_TCGETS=$402c7413;
+{$else}
+ IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+{$endif}
+var
+ Data : array[0..255] of byte; {Large enough for termios info}
+begin
+ Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+end;
+
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.5 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.4 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+ Revision 1.3 2005/02/07 22:04:55 peter
+ * moved to unix
+
+ Revision 1.2 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/linux/sysosh.inc b/rtl/linux/sysosh.inc
new file mode 100644
index 0000000000..e57f69820d
--- /dev/null
+++ b/rtl/linux/sysosh.inc
@@ -0,0 +1,52 @@
+{
+ $Id: sysosh.inc,v 1.3 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+ { fd are int in C also for 64bit targets (x86_64) }
+ THandle = Longint;
+ TThreadID = THandle;
+
+ { pthread_mutex_t }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = record
+ __m_reserved: longint;
+ __m_count: longint;
+ __m_owner: pointer;
+ __m_kind: longint;
+ __m_lock: record
+ __status: sizeint;
+ __spinlock: longint;
+ end;
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.3 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp
new file mode 100644
index 0000000000..fb5100aec4
--- /dev/null
+++ b/rtl/linux/system.pp
@@ -0,0 +1,274 @@
+{
+ $Id: system.pp,v 1.25 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time librar~y.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ System unit for Linux.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ These things are set in the makefile, }
+{ But you can override them here.}
+
+
+{ If you use an aout system, set the conditional AOUT}
+{ $Define AOUT}
+
+Unit {$ifdef VER1_0}Syslinux{$else}System{$endif};
+
+Interface
+
+{$define FPC_IS_SYSTEM}
+
+{$i osdefs.inc}
+
+{$I sysunixh.inc}
+
+Implementation
+
+
+{$I system.inc}
+
+
+{*****************************************************************************
+ Misc. System Dependent Functions
+*****************************************************************************}
+
+procedure haltproc(e:longint);cdecl;external name '_haltproc';
+
+procedure System_exit;
+begin
+ haltproc(ExitCode);
+End;
+
+
+Function ParamCount: Longint;
+Begin
+ Paramcount:=argc-1
+End;
+
+
+function BackPos(c:char; const s: shortstring): integer;
+var
+ i: integer;
+Begin
+ for i:=length(s) downto 0 do
+ if s[i] = c then break;
+ if i=0 then
+ BackPos := 0
+ else
+ BackPos := i;
+end;
+
+
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit. }
+var
+ execpathstr : shortstring;
+
+function paramstr(l: longint) : string;
+ begin
+ { stricly conforming POSIX applications }
+ { have the executing filename as argv[0] }
+ if l=0 then
+ begin
+ paramstr := execpathstr;
+ end
+ else
+ paramstr:=strpas(argv[l]);
+ end;
+
+Procedure Randomize;
+Begin
+ randseed:=longint(Fptime(nil));
+End;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+function reenable_signal(sig : longint) : boolean;
+var
+ e : TSigSet;
+ i,j : byte;
+begin
+ fillchar(e,sizeof(e),#0);
+ { set is 1 based PM }
+ dec(sig);
+ i:=sig mod 32;
+ j:=sig div 32;
+ e[j]:=1 shl i;
+ fpsigprocmask(SIG_UNBLOCK,@e,nil);
+ reenable_signal:=geterrno=0;
+end;
+
+
+// signal handler is arch dependant due to processorexception to language
+// exception translation
+
+{$i sighnd.inc}
+
+var
+ act: SigActionRec;
+
+Procedure InstallSignals;
+begin
+ { Initialize the sigaction structure }
+ { all flags and information set to zero }
+ FillChar(act, sizeof(SigActionRec),0);
+ { initialize handler }
+ act.sa_handler := SigActionHandler(@SignalToRunError);
+ act.sa_flags:=SA_SIGINFO
+{$ifdef cpux86_64}
+ or $4000000
+{$endif cpux86_64}
+ ;
+ FpSigAction(SIGFPE,@act,nil);
+ FpSigAction(SIGSEGV,@act,nil);
+ FpSigAction(SIGBUS,@act,nil);
+ FpSigAction(SIGILL,@act,nil);
+end;
+
+procedure SetupCmdLine;
+var
+ bufsize,
+ len,j,
+ size,i : longint;
+ found : boolean;
+ buf : pchar;
+
+ procedure AddBuf;
+ begin
+ reallocmem(cmdline,size+bufsize);
+ move(buf^,cmdline[size],bufsize);
+ inc(size,bufsize);
+ bufsize:=0;
+ end;
+
+begin
+ GetMem(buf,ARG_MAX);
+ size:=0;
+ bufsize:=0;
+ i:=0;
+ while (i<argc) do
+ begin
+ len:=strlen(argv[i]);
+ if len>ARG_MAX-2 then
+ len:=ARG_MAX-2;
+ found:=false;
+ for j:=1 to len do
+ if argv[i][j]=' ' then
+ begin
+ found:=true;
+ break;
+ end;
+ if bufsize+len>=ARG_MAX-2 then
+ AddBuf;
+ if found then
+ begin
+ buf[bufsize]:='"';
+ inc(bufsize);
+ end;
+ move(argv[i]^,buf[bufsize],len);
+ inc(bufsize,len);
+ if found then
+ begin
+ buf[bufsize]:='"';
+ inc(bufsize);
+ end;
+ if i<argc then
+ buf[bufsize]:=' '
+ else
+ buf[bufsize]:=#0;
+ inc(bufsize);
+ inc(i);
+ end;
+ AddBuf;
+ FreeMem(buf,ARG_MAX);
+end;
+
+
+procedure SysInitStdIO;
+begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+
+procedure SysInitExecPath;
+var
+ i : longint;
+begin
+ execpathstr[0]:=#0;
+ i:=Fpreadlink('/proc/self/exe',@execpathstr[1],high(execpathstr));
+ { it must also be an absolute filename, linux 2.0 points to a memory
+ location so this will skip that }
+ if (i>0) and (execpathstr[1]='/') then
+ execpathstr[0]:=char(i);
+end;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := SizeUInt (fpGetPID);
+end;
+
+
+Begin
+ IsConsole := TRUE;
+ IsLibrary := FALSE;
+ StackLength := InitialStkLen;
+ StackBottom := Sptr - StackLength;
+ { Set up signals handlers }
+ InstallSignals;
+ { Setup heap }
+ InitHeap;
+ SysInitExceptions;
+ { Arguments }
+ SetupCmdLine;
+ SysInitExecPath;
+ { Setup stdin, stdout and stderr }
+ SysInitStdIO;
+ { Reset IO Error }
+ InOutRes:=0;
+ { threading }
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+
+{
+ $Log: system.pp,v $
+ Revision 1.25 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.24 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.23 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.22 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.21 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/linux/termio.pp b/rtl/linux/termio.pp
new file mode 100644
index 0000000000..d6909a8bbe
--- /dev/null
+++ b/rtl/linux/termio.pp
@@ -0,0 +1,49 @@
+{
+ $Id: termio.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains the termios interface.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit termio;
+
+interface
+
+Uses BaseUnix; // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.
+
+{
+ $Log: termio.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/termios.inc b/rtl/linux/termios.inc
new file mode 100644
index 0000000000..f43729b804
--- /dev/null
+++ b/rtl/linux/termios.inc
@@ -0,0 +1,1231 @@
+{
+ $Id: termios.inc,v 1.14 2005/04/25 10:26:21 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by Marco van de Voort
+ member of the Free Pascal development team
+
+ ioctls constants for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{********************
+ IOCtl(TermIOS)
+********************}
+
+Const
+ { Amount of Control Chars }
+ NCCS = 32;
+ NCC = 8;
+
+{$ifdef cpupowerpc}
+ TCGETS = $402c7413;
+ TCSETS = $802c7414;
+ TCSETSW = $802c7415;
+ TCSETSF = $802c7416;
+ TCGETA = $40147417;
+ TCSETA = $80147418;
+ TCSETAW = $80147419;
+ TCSETAF = $8014741c;
+ TCSBRK = $2000741d;
+ TCXONC = $2000741e;
+ TCFLSH = $2000741f;
+ TIOCEXCL = $540c;
+ TIOCNXCL = $540d;
+ TIOCSCTTY = $540e;
+ TIOCGPGRP = $40047477;
+ TIOCSPGRP = $80047476;
+ TIOCOUTQ = $40047473;
+ TIOCSTI = $5412;
+ TIOCGWINSZ = $40087468;
+ TIOCSWINSZ = $80087467;
+ TIOCMGET = $5415;
+ TIOCMBIS = $5416;
+ TIOCMBIC = $5417;
+ TIOCMSET = $5418;
+ TIOCGSOFTCAR = $5419;
+ TIOCSSOFTCAR = $541a;
+ FIONREAD = $4004667f;
+ TIOCINQ = $4004667f;
+ TIOCLINUX = $541c;
+ TIOCCONS = $541d;
+ TIOCGSERIAL = $541e;
+ TIOCSSERIAL = $541f;
+ TIOCPKT = $5420;
+ FIONBIO = $8004667e;
+ TIOCNOTTY = $5422;
+ TIOCSETD = $5423;
+ TIOCGETD = $5424;
+ TCSBRKP = $5425;
+ TIOCTTYGSTRUCT = $5426;
+ FIONCLEX = $20006602;
+ FIOCLEX = $20006601;
+ FIOASYNC = $8004667d;
+ TIOCSERCONFIG = $5453;
+ TIOCSERGWILD = $5454;
+ TIOCSERSWILD = $5455;
+ TIOCGLCKTRMIOS = $5456;
+ TIOCSLCKTRMIOS = $5457;
+ TIOCSERGSTRUCT = $5458;
+ TIOCSERGETLSR = $5459;
+ TIOCSERGETMULTI = $545a;
+ TIOCSERSETMULTI = $545b;
+ TIOCMIWAIT = $545c;
+ TIOCGICOUNT = $545d;
+
+{c_cc characters}
+ VINTR = 0;
+ VQUIT = 1;
+ VERASE = 2;
+ VKILL = 3;
+ VEOF = 4;
+ VMIN = 5;
+ VEOL = 6;
+ VTIME = 7;
+ VEOL2 = 8;
+ VSWTC = 9;
+ VWERASE = 10;
+ VREPRINT = 11;
+ VSUSP = 12;
+ VSTART = 13;
+ VSTOP = 14;
+ VLNEXT = 15;
+ VDISCARD = 16;
+
+{ c_iflag bits }
+ IGNBRK = &0000001;
+ BRKINT = &0000002;
+ IGNPAR = &0000004;
+ PARMRK = &0000010;
+ INPCK = &0000020;
+ ISTRIP = &0000040;
+ INLCR = &0000100;
+ IGNCR = &0000200;
+ ICRNL = &0000400;
+ IXON = &0001000;
+ IXOFF = &0002000;
+ IXANY = &0004000;
+ IUCLC = &0010000;
+ IMAXBEL= &0020000;
+
+{ c_oflag bits }
+ OPOST = &0000001;
+ ONLCR = &0000002;
+ OLCUC = &0000004;
+ OCRNL = &0000010;
+ ONOCR = &0000020;
+ ONLRET = &0000040;
+
+ OFILL = &00000100;
+ OFDEL = &00000200;
+ NLDLY = &00001400;
+ NL0 = &00000000;
+ NL1 = &00000400;
+ NL2 = &00001000;
+ NL3 = &00001400;
+ TABDLY = &00006000;
+ TAB0 = &00000000;
+ TAB1 = &00002000;
+ TAB2 = &00004000;
+ TAB3 = &00006000;
+ CRDLY = &00030000;
+ CR0 = &00000000;
+ CR1 = &00010000;
+ CR2 = &00020000;
+ CR3 = &00030000;
+ FFDLY = &00040000;
+ FF0 = &00000000;
+ FF1 = &00040000;
+ BSDLY = &00100000;
+ BS0 = &00000000;
+ BS1 = &00100000;
+ VTDLY = &00200000;
+ VT0 = &00000000;
+ VT1 = &00200000;
+ XTABS = &01000000; { Hmm.. Linux/i386 considers this part of TABDLY.. }
+
+{ c_cflag bit meaning }
+ CBAUD = &0000377;
+ B0 = &0000000; { hang up }
+ B50 = &0000001;
+ B75 = &0000002;
+ B110 = &0000003;
+ B134 = &0000004;
+ B150 = &0000005;
+ B200 = &0000006;
+ B300 = &0000007;
+ B600 = &0000010;
+ B1200 = &0000011;
+ B1800 = &0000012;
+ B2400 = &0000013;
+ B4800 = &0000014;
+ B9600 = &0000015;
+ B19200= &0000016;
+ B38400= &0000017;
+ EXTA = B19200;
+ EXTB = B38400;
+ CBAUDEX = &0000020;
+ B57600 = &00020;
+ B115200 = &00021;
+ B230400 = &00022;
+ B460800 = &00023;
+ B500000 = &00024;
+ B576000 = &00025;
+ B921600 = &00026;
+ B1000000 = &00027;
+ B1152000 = &00030;
+ B1500000 = &00031;
+ B2000000 = &00032;
+ B2500000 = &00033;
+ B3000000 = &00034;
+ B3500000 = &00035;
+ B4000000 = &00036;
+ __MAX_BAUD= B4000000;
+
+ CSIZE = &00001400;
+ CS5 = &00000000;
+ CS6 = &00000400;
+ CS7 = &00001000;
+ CS8 = &00001400;
+
+ CSTOPB = &00002000;
+ CREAD = &00004000;
+ PARENB = &00010000;
+ PARODD = &00020000;
+ HUPCL = &00040000;
+ CLOCAL = &00100000;
+ CRTSCTS= &020000000000; { flow control }
+
+{ c_lflag bits }
+ ISIG = $00000080;
+ ICANON = $00000100;
+ XCASE = $00004000;
+ ECHO = $00000008;
+ ECHOE = $00000002;
+ ECHOK = $00000004;
+ ECHONL = $00000010;
+ NOFLSH = $80000000;
+ TOSTOP = $00400000;
+ ECHOCTL= $00000040;
+ ECHOPRT= $00000020;
+ ECHOKE = $00000001;
+ FLUSHO = $00800000;
+ PENDIN = $20000000;
+ IEXTEN = $00000400;
+
+{ Values for the ACTION argument to `tcflow'. }
+ TCOOFF = 0;
+ TCOON = 1;
+ TCIOFF = 2;
+ TCION = 3;
+
+{ Values for the QUEUE_SELECTOR argument to `tcflush'. }
+ TCIFLUSH = 0;
+ TCOFLUSH = 1;
+ TCIOFLUSH = 2;
+
+{ Values for the OPTIONAL_ACTIONS argument to `tcsetattr'. }
+ TCSANOW = 0;
+ TCSADRAIN = 1;
+ TCSAFLUSH = 2;
+
+{ Used for packet mode }
+ TIOCPKT_DATA = 0;
+ TIOCPKT_FLUSHREAD = 1;
+ TIOCPKT_FLUSHWRITE = 2;
+ TIOCPKT_STOP = 4;
+ TIOCPKT_START = 8;
+ TIOCPKT_NOSTOP = 16;
+ TIOCPKT_DOSTOP = 32;
+
+{ c_cc characters }
+ _VINTR = 0;
+ _VQUIT = 1;
+ _VERASE= 2;
+ _VKILL = 3;
+ _VEOF = 4;
+ _VMIN = 5;
+ _VEOL = 6;
+ _VTIME = 7;
+ _VEOL2 = 8;
+ _VSWTC = 9;
+
+{ modem lines }
+ TIOCM_LE = $001;
+ TIOCM_DTR = $002;
+ TIOCM_RTS = $004;
+ TIOCM_ST = $008;
+ TIOCM_SR = $010;
+ TIOCM_CTS = $020;
+ TIOCM_CAR = $040;
+ TIOCM_RNG = $080;
+ TIOCM_DSR = $100;
+ TIOCM_CD = TIOCM_CAR;
+ TIOCM_RI = TIOCM_RNG;
+
+{ ioctl (fd, TIOCSERGETLSR, &result) where result may be as below }
+ TIOCSER_TEMT = $01; { Transmitter physically empty }
+
+{ line disciplines }
+ N_TTY = 0;
+ N_SLIP = 1;
+ N_MOUSE = 2;
+ N_PPP = 3;
+ N_STRIP = 4;
+ N_AX25 = 5;
+ N_X25 = 6; { X.25 async }
+ N_6PACK = 7;
+ N_MASC = 8; { Mobitex module }
+ N_R3964 = 9; { Simatic R3964 module }
+ N_PROFIBUS_FDL = 10; { Profibus }
+ N_IRDA = 11; { Linux IR }
+ N_SMSBLOCK = 12; { SMS block mode }
+ N_HDLC = 13; { synchronous HDLC }
+ N_SYNC_PPP = 14; { synchronous PPP }
+ N_HCI = 15; { Bluetooth HCI UART }
+
+
+{$endif cpupowerpc}
+
+{$ifdef cpui386}
+ { For Terminal handling }
+ TCGETS = $5401;
+ TCSETS = $5402;
+ TCSETSW = $5403;
+ TCSETSF = $5404;
+ TCGETA = $5405;
+ TCSETA = $5406;
+ TCSETAW = $5407;
+ TCSETAF = $5408;
+ TCSBRK = $5409;
+ TCXONC = $540A;
+ TCFLSH = $540B;
+ TIOCEXCL = $540C;
+ TIOCNXCL = $540D;
+ TIOCSCTTY = $540E;
+ TIOCGPGRP = $540F;
+ TIOCSPGRP = $5410;
+ TIOCOUTQ = $5411;
+ TIOCSTI = $5412;
+ TIOCGWINSZ = $5413;
+ TIOCSWINSZ = $5414;
+ TIOCMGET = $5415;
+ TIOCMBIS = $5416;
+ TIOCMBIC = $5417;
+ TIOCMSET = $5418;
+ TIOCGSOFTCAR = $5419;
+ TIOCSSOFTCAR = $541A;
+ FIONREAD = $541B;
+ TIOCINQ = FIONREAD;
+ TIOCLINUX = $541C;
+ TIOCCONS = $541D;
+ TIOCGSERIAL = $541E;
+ TIOCSSERIAL = $541F;
+ TIOCPKT = $5420;
+ FIONBIO = $5421;
+ TIOCNOTTY = $5422;
+ TIOCSETD = $5423;
+ TIOCGETD = $5424;
+ TCSBRKP = $5425;
+ TIOCTTYGSTRUCT = $5426;
+ FIONCLEX = $5450;
+ FIOCLEX = $5451;
+ FIOASYNC = $5452;
+ TIOCSERCONFIG = $5453;
+ TIOCSERGWILD = $5454;
+ TIOCSERSWILD = $5455;
+ TIOCGLCKTRMIOS = $5456;
+ TIOCSLCKTRMIOS = $5457;
+ TIOCSERGSTRUCT = $5458;
+ TIOCSERGETLSR = $5459;
+ TIOCSERGETMULTI = $545A;
+ TIOCSERSETMULTI = $545B;
+
+ TIOCMIWAIT = $545C;
+ TIOCGICOUNT = $545D;
+ TIOCGHAYESESP = $545E;
+ TIOCSHAYESESP = $545F;
+ FIOQSIZE = $5460;
+
+
+ TIOCPKT_DATA = 0;
+ TIOCPKT_FLUSHREAD = 1;
+ TIOCPKT_FLUSHWRITE = 2;
+ TIOCPKT_STOP = 4;
+ TIOCPKT_START = 8;
+ TIOCPKT_NOSTOP = 16;
+ TIOCPKT_DOSTOP = 32;
+
+{c_cc characters}
+ VINTR = 0;
+ VQUIT = 1;
+ VERASE = 2;
+ VKILL = 3;
+ VEOF = 4;
+ VTIME = 5;
+ VMIN = 6;
+ VSWTC = 7;
+ VSTART = 8;
+ VSTOP = 9;
+ VSUSP = 10;
+ VEOL = 11;
+ VREPRINT = 12;
+ VDISCARD = 13;
+ VWERASE = 14;
+ VLNEXT = 15;
+ VEOL2 = 16;
+
+{c_iflag bits}
+ IGNBRK = $0000001;
+ BRKINT = $0000002;
+ IGNPAR = $0000004;
+ PARMRK = $0000008;
+ INPCK = $0000010;
+ ISTRIP = $0000020;
+ INLCR = $0000040;
+ IGNCR = $0000080;
+ ICRNL = $0000100;
+ IUCLC = $0000200;
+ IXON = $0000400;
+ IXANY = $0000800;
+ IXOFF = $0001000;
+ IMAXBEL = $0002000;
+
+{c_oflag bits}
+ OPOST = $0000001;
+ OLCUC = $0000002;
+ ONLCR = $0000004;
+ OCRNL = $0000008;
+ ONOCR = $0000010;
+ ONLRET = $0000020;
+ OFILL = $0000040;
+ OFDEL = $0000080;
+ NLDLY = $0000100;
+ NL0 = $0000000;
+ NL1 = $0000100;
+ CRDLY = $0000600;
+ CR0 = $0000000;
+ CR1 = $0000200;
+ CR2 = $0000400;
+ CR3 = $0000600;
+ TABDLY = $0001800;
+ TAB0 = $0000000;
+ TAB1 = $0000800;
+ TAB2 = $0001000;
+ TAB3 = $0001800;
+ XTABS = $0001800;
+ BSDLY = $0002000;
+ BS0 = $0000000;
+ BS1 = $0002000;
+ VTDLY = $0004000;
+ VT0 = $0000000;
+ VT1 = $0004000;
+ FFDLY = $0008000;
+ FF0 = $0000000;
+ FF1 = $0008000;
+
+{c_cflag bits}
+ CBAUD = $000100F;
+ B0 = $0000000;
+ B50 = $0000001;
+ B75 = $0000002;
+ B110 = $0000003;
+ B134 = $0000004;
+ B150 = $0000005;
+ B200 = $0000006;
+ B300 = $0000007;
+ B600 = $0000008;
+ B1200 = $0000009;
+ B1800 = $000000A;
+ B2400 = $000000B;
+ B4800 = $000000C;
+ B9600 = $000000D;
+ B19200 = $000000E;
+ B38400 = $000000F;
+ EXTA = B19200;
+ EXTB = B38400;
+ CSIZE = $0000030;
+ CS5 = $0000000;
+ CS6 = $0000010;
+ CS7 = $0000020;
+ CS8 = $0000030;
+ CSTOPB = $0000040;
+ CREAD = $0000080;
+ PARENB = $0000100;
+ PARODD = $0000200;
+ HUPCL = $0000400;
+ CLOCAL = $0000800;
+ CBAUDEX = $0001000;
+ B57600 = $0001001;
+ B115200 = $0001002;
+ B230400 = $0001003;
+ B460800 = $0001004;
+ CIBAUD = $100F0000;
+ CMSPAR = $40000000;
+ CRTSCTS = $80000000;
+
+{c_lflag bits}
+ ISIG = $0000001;
+ ICANON = $0000002;
+ XCASE = $0000004;
+ ECHO = $0000008;
+ ECHOE = $0000010;
+ ECHOK = $0000020;
+ ECHONL = $0000040;
+ NOFLSH = $0000080;
+ TOSTOP = $0000100;
+ ECHOCTL = $0000200;
+ ECHOPRT = $0000400;
+ ECHOKE = $0000800;
+ FLUSHO = $0001000;
+ PENDIN = $0004000;
+ IEXTEN = $0008000;
+
+{c_line bits}
+ TIOCM_LE = $001;
+ TIOCM_DTR = $002;
+ TIOCM_RTS = $004;
+ TIOCM_ST = $008;
+ TIOCM_SR = $010;
+ TIOCM_CTS = $020;
+ TIOCM_CAR = $040;
+ TIOCM_RNG = $080;
+ TIOCM_DSR = $100;
+ TIOCM_CD = TIOCM_CAR;
+ TIOCM_RI = TIOCM_RNG;
+ TIOCM_OUT1 = $2000;
+ TIOCM_OUT2 = $4000;
+
+{TCSetAttr}
+ TCSANOW = 0;
+ TCSADRAIN = 1;
+ TCSAFLUSH = 2;
+
+{TCFlow}
+ TCOOFF = 0;
+ TCOON = 1;
+ TCIOFF = 2;
+ TCION = 3;
+
+{TCFlush}
+ TCIFLUSH = 0;
+ TCOFLUSH = 1;
+ TCIOFLUSH = 2;
+
+{$endif cpui386}
+
+{$ifdef cpusparc}
+ TCGETA = $40125401;
+ TCSETA = $80125402;
+ TCSETAW = $80125403;
+ TCSETAF = $80125404;
+ TCSBRK = $20005405;
+ TCXONC = $20005406;
+ TCFLSH = $20005407;
+ TCGETS = $40245408;
+ TCSETS = $80245409;
+ TCSETSW = $8024540a;
+ TCSETSF = $8024540b;
+ TIOCGETD = $40047400;
+ TIOCSETD = $80047401;
+ TIOCEXCL = $2000740d;
+ TIOCNXCL = $2000740e;
+ TIOCCONS = $20007424;
+ TIOCGSOFTCAR = $40047464;
+ TIOCSSOFTCAR = $80047465;
+ TIOCSWINSZ = $80087467;
+ TIOCGWINSZ = $40087468;
+ TIOCMGET = $4004746a;
+ TIOCMBIC = $8004746b;
+ TIOCMBIS = $8004746c;
+ TIOCMSET = $8004746d;
+ TIOCSTART = $2000746e;
+ TIOCSTOP = $2000746f;
+ TIOCPKT = $80047470;
+ TIOCNOTTY = $20007471;
+ TIOCSTI = $80017472;
+ TIOCOUTQ = $40047473;
+ TIOCCBRK = $2000747a;
+ TIOCSBRK = $2000747b;
+ TIOCSPGRP = $80047482;
+ TIOCGPGRP = $40047483;
+ TIOCSCTTY = $20007484;
+ TIOCGSID = $40047485;
+ TIOCGPTN = $40047486;
+ TIOCSPTLCK = $80047487;
+ FIOCLEX = $20006601;
+ FIONCLEX = $20006602;
+ FIOASYNC = $8004667d;
+ FIONBIO = $8004667e;
+ FIONREAD = $4004667f;
+ TIOCINQ = $4004667f;
+ TIOCLINUX = $541c;
+ TIOCGSERIAL = $541e;
+ TIOCSSERIAL = $541f;
+ TCSBRKP = $5425;
+ TIOCTTYGSTRUCT = $5426;
+ TIOCSERCONFIG = $5453;
+ TIOCSERGWILD = $5454;
+ TIOCSERSWILD = $5455;
+ TIOCGLCKTRMIOS = $5456;
+ TIOCSLCKTRMIOS = $5457;
+ TIOCSERGSTRUCT = $5458;
+ TIOCSERGETLSR = $5459;
+ TIOCSERGETMULTI = $545a;
+ TIOCSERSETMULTI = $545b;
+ TIOCMIWAIT = $545c;
+ TIOCGICOUNT = $545d;
+ TIOCPKT_DATA = $0;
+ TIOCPKT_FLUSHREAD = $1;
+ TIOCPKT_FLUSHWRITE = $2;
+ TIOCPKT_STOP = $4;
+ TIOCPKT_START = $8;
+ TIOCPKT_NOSTOP = $10;
+ TIOCPKT_DOSTOP = $20;
+
+{c_cc characters}
+ VINTR = 0;
+ VQUIT = 1;
+ VERASE = 2;
+ VKILL = 3;
+ VEOF = 4;
+ VEOL = 5;
+ VEOL2 = 6;
+ VSWTC = 7;
+ VSTART = 8;
+ VSTOP = 9;
+ VSUSP = 10;
+ VDSUSP = 11;
+ VREPRINT = 12;
+ VDISCARD = 13;
+ VWERASE = 14;
+ VLNEXT = 15;
+ VMIN = 4;
+ VTIME = 5;
+
+{c_iflag bits}
+ IGNBRK = $0000001;
+ BRKINT = $0000002;
+ IGNPAR = $0000004;
+ PARMRK = $0000008;
+ INPCK = $0000010;
+ ISTRIP = $0000020;
+ INLCR = $0000040;
+ IGNCR = $0000080;
+ ICRNL = $0000100;
+ IUCLC = $0000200;
+ IXON = $0000400;
+ IXANY = $0000800;
+ IXOFF = $0001000;
+ IMAXBEL = $0002000;
+
+{c_oflag bits}
+ OPOST = $0000001;
+ OLCUC = $0000002;
+ ONLCR = $0000004;
+ OCRNL = $0000008;
+ ONOCR = $0000010;
+ ONLRET = $0000020;
+ OFILL = $0000040;
+ OFDEL = $0000080;
+ NLDLY = $0000100;
+ NL0 = $0000000;
+ NL1 = $0000100;
+ CRDLY = $0000600;
+ CR0 = $0000000;
+ CR1 = $0000200;
+ CR2 = $0000400;
+ CR3 = $0000600;
+ TABDLY = $0001800;
+ TAB0 = $0000000;
+ TAB1 = $0000800;
+ TAB2 = $0001000;
+ TAB3 = $0001800;
+ XTABS = $0001800;
+ BSDLY = $0002000;
+ BS0 = $0000000;
+ BS1 = $0002000;
+ VTDLY = $0004000;
+ VT0 = $0000000;
+ VT1 = $0004000;
+ FFDLY = $0008000;
+ FF0 = $0000000;
+ FF1 = $0008000;
+
+{c_cflag bits}
+ CBAUD = $000100F;
+ B0 = $0000000;
+ B50 = $0000001;
+ B75 = $0000002;
+ B110 = $0000003;
+ B134 = $0000004;
+ B150 = $0000005;
+ B200 = $0000006;
+ B300 = $0000007;
+ B600 = $0000008;
+ B1200 = $0000009;
+ B1800 = $000000A;
+ B2400 = $000000B;
+ B4800 = $000000C;
+ B9600 = $000000D;
+ B19200 = $000000E;
+ B38400 = $000000F;
+ EXTA = B19200;
+ EXTB = B38400;
+ CSIZE = $0000030;
+ CS5 = $0000000;
+ CS6 = $0000010;
+ CS7 = $0000020;
+ CS8 = $0000030;
+ CSTOPB = $0000040;
+ CREAD = $0000080;
+ PARENB = $0000100;
+ PARODD = $0000200;
+ HUPCL = $0000400;
+ CLOCAL = $0000800;
+ CBAUDEX = $0001000;
+ B57600 = $0001001;
+ B115200 = $0001002;
+ B230400 = $0001003;
+ B460800 = $0001004;
+ CIBAUD = $100F0000;
+ CMSPAR = $40000000;
+ CRTSCTS = $80000000;
+
+{c_lflag bits}
+ ISIG = $0000001;
+ ICANON = $0000002;
+ XCASE = $0000004;
+ ECHO = $0000008;
+ ECHOE = $0000010;
+ ECHOK = $0000020;
+ ECHONL = $0000040;
+ NOFLSH = $0000080;
+ TOSTOP = $0000100;
+ ECHOCTL = $0000200;
+ ECHOPRT = $0000400;
+ ECHOKE = $0000800;
+ FLUSHO = $0001000;
+ PENDIN = $0004000;
+ IEXTEN = $0008000;
+
+{c_line bits}
+ TIOCM_LE = $001;
+ TIOCM_DTR = $002;
+ TIOCM_RTS = $004;
+ TIOCM_ST = $008;
+ TIOCM_SR = $010;
+ TIOCM_CTS = $020;
+ TIOCM_CAR = $040;
+ TIOCM_RNG = $080;
+ TIOCM_DSR = $100;
+ TIOCM_CD = TIOCM_CAR;
+ TIOCM_RI = TIOCM_RNG;
+ TIOCM_OUT1 = $2000;
+ TIOCM_OUT2 = $4000;
+
+{TCSetAttr}
+ TCSANOW = 0;
+ TCSADRAIN = 1;
+ TCSAFLUSH = 2;
+
+{TCFlow}
+ TCOOFF = 0;
+ TCOON = 1;
+ TCIOFF = 2;
+ TCION = 3;
+
+{TCFlush}
+ TCIFLUSH = 0;
+ TCOFLUSH = 1;
+ TCIOFLUSH = 2;
+
+{$endif cpusparc}
+
+{$ifdef cpux86_64}
+ TCGETS = $5401;
+ TCSETS = $5402;
+ TCSETSW = $5403;
+ TCSETSF = $5404;
+ TCGETA = $5405;
+ TCSETA = $5406;
+ TCSETAW = $5407;
+ TCSETAF = $5408;
+ TCSBRK = $5409;
+ TCXONC = $540A;
+ TCFLSH = $540B;
+ TIOCEXCL = $540C;
+ TIOCNXCL = $540D;
+ TIOCSCTTY = $540E;
+ TIOCGPGRP = $540F;
+ TIOCSPGRP = $5410;
+ TIOCOUTQ = $5411;
+ TIOCSTI = $5412;
+ TIOCGWINSZ = $5413;
+ TIOCSWINSZ = $5414;
+ TIOCMGET = $5415;
+ TIOCMBIS = $5416;
+ TIOCMBIC = $5417;
+ TIOCMSET = $5418;
+ TIOCGSOFTCAR = $5419;
+ TIOCSSOFTCAR = $541A;
+ FIONREAD = $541B;
+ TIOCINQ = FIONREAD;
+ TIOCLINUX = $541C;
+ TIOCCONS = $541D;
+ TIOCGSERIAL = $541E;
+ TIOCSSERIAL = $541F;
+ TIOCPKT = $5420;
+ FIONBIO = $5421;
+ TIOCNOTTY = $5422;
+ TIOCSETD = $5423;
+ TIOCGETD = $5424;
+ TCSBRKP = $5425;
+ TIOCSBRK = $5427;
+ TIOCCBRK = $5428;
+ TIOCGSID = $5429;
+ FIONCLEX = $5450;
+ FIOCLEX = $5451;
+ FIOASYNC = $5452;
+ TIOCSERCONFIG = $5453;
+ TIOCSERGWILD = $5454;
+ TIOCSERSWILD = $5455;
+ TIOCGLCKTRMIOS = $5456;
+ TIOCSLCKTRMIOS = $5457;
+ TIOCSERGSTRUCT = $5458;
+ TIOCSERGETLSR = $5459;
+ TIOCSERGETMULTI = $545A;
+ TIOCSERSETMULTI = $545B;
+ TIOCMIWAIT = $545C;
+ TIOCGICOUNT = $545D;
+ TIOCGHAYESESP = $545E;
+ TIOCSHAYESESP = $545F;
+ FIOQSIZE = $5460;
+ TIOCPKT_DATA = 0;
+ TIOCPKT_FLUSHREAD = 1;
+ TIOCPKT_FLUSHWRITE = 2;
+ TIOCPKT_STOP = 4;
+ TIOCPKT_START = 8;
+ TIOCPKT_NOSTOP = 16;
+ TIOCPKT_DOSTOP = 32;
+ TIOCSER_TEMT = $01;
+
+{c_cc characters}
+ VINTR = 0;
+ VQUIT = 1;
+ VERASE = 2;
+ VKILL = 3;
+ VEOF = 4;
+ VTIME = 5;
+ VMIN = 6;
+ VSWTC = 7;
+ VSTART = 8;
+ VSTOP = 9;
+ VSUSP = 10;
+ VEOL = 11;
+ VREPRINT = 12;
+ VDISCARD = 13;
+ VWERASE = 14;
+ VLNEXT = 15;
+ VEOL2 = 16;
+
+{c_iflag bits}
+ IGNBRK = $0000001;
+ BRKINT = $0000002;
+ IGNPAR = $0000004;
+ PARMRK = $0000008;
+ INPCK = $0000010;
+ ISTRIP = $0000020;
+ INLCR = $0000040;
+ IGNCR = $0000080;
+ ICRNL = $0000100;
+ IUCLC = $0000200;
+ IXON = $0000400;
+ IXANY = $0000800;
+ IXOFF = $0001000;
+ IMAXBEL = $0002000;
+
+{c_oflag bits}
+ OPOST = $0000001;
+ OLCUC = $0000002;
+ ONLCR = $0000004;
+ OCRNL = $0000008;
+ ONOCR = $0000010;
+ ONLRET = $0000020;
+ OFILL = $0000040;
+ OFDEL = $0000080;
+ NLDLY = $0000100;
+ NL0 = $0000000;
+ NL1 = $0000100;
+ CRDLY = $0000600;
+ CR0 = $0000000;
+ CR1 = $0000200;
+ CR2 = $0000400;
+ CR3 = $0000600;
+ TABDLY = $0001800;
+ TAB0 = $0000000;
+ TAB1 = $0000800;
+ TAB2 = $0001000;
+ TAB3 = $0001800;
+ XTABS = $0001800;
+ BSDLY = $0002000;
+ BS0 = $0000000;
+ BS1 = $0002000;
+ VTDLY = $0004000;
+ VT0 = $0000000;
+ VT1 = $0004000;
+ FFDLY = $0008000;
+ FF0 = $0000000;
+ FF1 = $0008000;
+
+{c_cflag bits}
+ CBAUD = $000100F;
+ B0 = $0000000;
+ B50 = $0000001;
+ B75 = $0000002;
+ B110 = $0000003;
+ B134 = $0000004;
+ B150 = $0000005;
+ B200 = $0000006;
+ B300 = $0000007;
+ B600 = $0000008;
+ B1200 = $0000009;
+ B1800 = $000000A;
+ B2400 = $000000B;
+ B4800 = $000000C;
+ B9600 = $000000D;
+ B19200 = $000000E;
+ B38400 = $000000F;
+ EXTA = B19200;
+ EXTB = B38400;
+ CSIZE = $0000030;
+ CS5 = $0000000;
+ CS6 = $0000010;
+ CS7 = $0000020;
+ CS8 = $0000030;
+ CSTOPB = $0000040;
+ CREAD = $0000080;
+ PARENB = $0000100;
+ PARODD = $0000200;
+ HUPCL = $0000400;
+ CLOCAL = $0000800;
+ CBAUDEX = $0001000;
+ B57600 = $0001001;
+ B115200 = $0001002;
+ B230400 = $0001003;
+ B460800 = $0001004;
+ CIBAUD = $100F0000;
+ CMSPAR = $40000000;
+ CRTSCTS = $80000000;
+
+{c_lflag bits}
+ ISIG = $0000001;
+ ICANON = $0000002;
+ XCASE = $0000004;
+ ECHO = $0000008;
+ ECHOE = $0000010;
+ ECHOK = $0000020;
+ ECHONL = $0000040;
+ NOFLSH = $0000080;
+ TOSTOP = $0000100;
+ ECHOCTL = $0000200;
+ ECHOPRT = $0000400;
+ ECHOKE = $0000800;
+ FLUSHO = $0001000;
+ PENDIN = $0004000;
+ IEXTEN = $0008000;
+
+{c_line bits}
+ TIOCM_LE = $001;
+ TIOCM_DTR = $002;
+ TIOCM_RTS = $004;
+ TIOCM_ST = $008;
+ TIOCM_SR = $010;
+ TIOCM_CTS = $020;
+ TIOCM_CAR = $040;
+ TIOCM_RNG = $080;
+ TIOCM_DSR = $100;
+ TIOCM_CD = TIOCM_CAR;
+ TIOCM_RI = TIOCM_RNG;
+ TIOCM_OUT1 = $2000;
+ TIOCM_OUT2 = $4000;
+
+{TCSetAttr}
+ TCSANOW = 0;
+ TCSADRAIN = 1;
+ TCSAFLUSH = 2;
+
+{TCFlow}
+ TCOOFF = 0;
+ TCOON = 1;
+ TCIOFF = 2;
+ TCION = 3;
+
+{TCFlush}
+ TCIFLUSH = 0;
+ TCOFLUSH = 1;
+ TCIOFLUSH = 2;
+
+{$endif cpux86_64}
+
+{$ifdef cpuarm}
+ { For Terminal handling }
+ TCGETS = $5401;
+ TCSETS = $5402;
+ TCSETSW = $5403;
+ TCSETSF = $5404;
+ TCGETA = $5405;
+ TCSETA = $5406;
+ TCSETAW = $5407;
+ TCSETAF = $5408;
+ TCSBRK = $5409;
+ TCXONC = $540A;
+ TCFLSH = $540B;
+ TIOCEXCL = $540C;
+ TIOCNXCL = $540D;
+ TIOCSCTTY = $540E;
+ TIOCGPGRP = $540F;
+ TIOCSPGRP = $5410;
+ TIOCOUTQ = $5411;
+ TIOCSTI = $5412;
+ TIOCGWINSZ = $5413;
+ TIOCSWINSZ = $5414;
+ TIOCMGET = $5415;
+ TIOCMBIS = $5416;
+ TIOCMBIC = $5417;
+ TIOCMSET = $5418;
+ TIOCGSOFTCAR = $5419;
+ TIOCSSOFTCAR = $541A;
+ FIONREAD = $541B;
+ TIOCINQ = FIONREAD;
+ TIOCLINUX = $541C;
+ TIOCCONS = $541D;
+ TIOCGSERIAL = $541E;
+ TIOCSSERIAL = $541F;
+ TIOCPKT = $5420;
+ FIONBIO = $5421;
+ TIOCNOTTY = $5422;
+ TIOCSETD = $5423;
+ TIOCGETD = $5424;
+ TCSBRKP = $5425;
+ TIOCTTYGSTRUCT = $5426;
+ FIONCLEX = $5450;
+ FIOCLEX = $5451;
+ FIOASYNC = $5452;
+ TIOCSERCONFIG = $5453;
+ TIOCSERGWILD = $5454;
+ TIOCSERSWILD = $5455;
+ TIOCGLCKTRMIOS = $5456;
+ TIOCSLCKTRMIOS = $5457;
+ TIOCSERGSTRUCT = $5458;
+ TIOCSERGETLSR = $5459;
+ TIOCSERGETMULTI = $545A;
+ TIOCSERSETMULTI = $545B;
+
+ TIOCMIWAIT = $545C;
+ TIOCGICOUNT = $545D;
+ FIOQSIZE = $545E;
+
+ TIOCPKT_DATA = 0;
+ TIOCPKT_FLUSHREAD = 1;
+ TIOCPKT_FLUSHWRITE = 2;
+ TIOCPKT_STOP = 4;
+ TIOCPKT_START = 8;
+ TIOCPKT_NOSTOP = 16;
+ TIOCPKT_DOSTOP = 32;
+
+{c_cc characters}
+ VINTR = 0;
+ VQUIT = 1;
+ VERASE = 2;
+ VKILL = 3;
+ VEOF = 4;
+ VTIME = 5;
+ VMIN = 6;
+ VSWTC = 7;
+ VSTART = 8;
+ VSTOP = 9;
+ VSUSP = 10;
+ VEOL = 11;
+ VREPRINT = 12;
+ VDISCARD = 13;
+ VWERASE = 14;
+ VLNEXT = 15;
+ VEOL2 = 16;
+
+{c_iflag bits}
+ IGNBRK = $0000001;
+ BRKINT = $0000002;
+ IGNPAR = $0000004;
+ PARMRK = $0000008;
+ INPCK = $0000010;
+ ISTRIP = $0000020;
+ INLCR = $0000040;
+ IGNCR = $0000080;
+ ICRNL = $0000100;
+ IUCLC = $0000200;
+ IXON = $0000400;
+ IXANY = $0000800;
+ IXOFF = $0001000;
+ IMAXBEL = $0002000;
+
+{c_oflag bits}
+ OPOST = $0000001;
+ OLCUC = $0000002;
+ ONLCR = $0000004;
+ OCRNL = $0000008;
+ ONOCR = $0000010;
+ ONLRET = $0000020;
+ OFILL = $0000040;
+ OFDEL = $0000080;
+ NLDLY = $0000100;
+ NL0 = $0000000;
+ NL1 = $0000100;
+ CRDLY = $0000600;
+ CR0 = $0000000;
+ CR1 = $0000200;
+ CR2 = $0000400;
+ CR3 = $0000600;
+ TABDLY = $0001800;
+ TAB0 = $0000000;
+ TAB1 = $0000800;
+ TAB2 = $0001000;
+ TAB3 = $0001800;
+ XTABS = $0001800;
+ BSDLY = $0002000;
+ BS0 = $0000000;
+ BS1 = $0002000;
+ VTDLY = $0004000;
+ VT0 = $0000000;
+ VT1 = $0004000;
+ FFDLY = $0008000;
+ FF0 = $0000000;
+ FF1 = $0008000;
+
+{c_cflag bits}
+ CBAUD = $000100F;
+ B0 = $0000000;
+ B50 = $0000001;
+ B75 = $0000002;
+ B110 = $0000003;
+ B134 = $0000004;
+ B150 = $0000005;
+ B200 = $0000006;
+ B300 = $0000007;
+ B600 = $0000008;
+ B1200 = $0000009;
+ B1800 = $000000A;
+ B2400 = $000000B;
+ B4800 = $000000C;
+ B9600 = $000000D;
+ B19200 = $000000E;
+ B38400 = $000000F;
+ EXTA = B19200;
+ EXTB = B38400;
+ CSIZE = $0000030;
+ CS5 = $0000000;
+ CS6 = $0000010;
+ CS7 = $0000020;
+ CS8 = $0000030;
+ CSTOPB = $0000040;
+ CREAD = $0000080;
+ PARENB = $0000100;
+ PARODD = $0000200;
+ HUPCL = $0000400;
+ CLOCAL = $0000800;
+ CBAUDEX = $0001000;
+ B57600 = $0001001;
+ B115200 = $0001002;
+ B230400 = $0001003;
+ B460800 = $0001004;
+ CIBAUD = $100F0000;
+ CMSPAR = $40000000;
+ CRTSCTS = $80000000;
+
+{c_lflag bits}
+ ISIG = $0000001;
+ ICANON = $0000002;
+ XCASE = $0000004;
+ ECHO = $0000008;
+ ECHOE = $0000010;
+ ECHOK = $0000020;
+ ECHONL = $0000040;
+ NOFLSH = $0000080;
+ TOSTOP = $0000100;
+ ECHOCTL = $0000200;
+ ECHOPRT = $0000400;
+ ECHOKE = $0000800;
+ FLUSHO = $0001000;
+ PENDIN = $0004000;
+ IEXTEN = $0008000;
+
+{c_line bits}
+ TIOCM_LE = $001;
+ TIOCM_DTR = $002;
+ TIOCM_RTS = $004;
+ TIOCM_ST = $008;
+ TIOCM_SR = $010;
+ TIOCM_CTS = $020;
+ TIOCM_CAR = $040;
+ TIOCM_RNG = $080;
+ TIOCM_DSR = $100;
+ TIOCM_CD = TIOCM_CAR;
+ TIOCM_RI = TIOCM_RNG;
+ TIOCM_OUT1 = $2000;
+ TIOCM_OUT2 = $4000;
+
+{TCSetAttr}
+ TCSANOW = 0;
+ TCSADRAIN = 1;
+ TCSAFLUSH = 2;
+
+{TCFlow}
+ TCOOFF = 0;
+ TCOON = 1;
+ TCIOFF = 2;
+ TCION = 3;
+
+{TCFlush}
+ TCIFLUSH = 0;
+ TCOFLUSH = 1;
+ TCIOFLUSH = 2;
+
+{$endif cpuarm}
+
+Type
+ winsize = packed record
+ ws_row,
+ ws_col,
+ ws_xpixel,
+ ws_ypixel : word;
+ end;
+ TWinSize=winsize;
+
+{$PACKRECORDS C}
+ Termios = record
+ c_iflag,
+ c_oflag,
+ c_cflag,
+ c_lflag : cardinal;
+ c_line : char;
+ c_cc : array[0..NCCS-1] of byte;
+ c_ispeed,
+ c_ospeed : cardinal;
+ end;
+ TTermios=Termios;
+{$PACKRECORDS Default}
+
+{
+ $Log: termios.inc,v $
+ Revision 1.14 2005/04/25 10:26:21 marco
+ * most constants now arch dependant due to ppc. Other archs still have to be checked
+
+ Revision 1.13 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/termiosproc.inc b/rtl/linux/termiosproc.inc
new file mode 100644
index 0000000000..1ed58697c4
--- /dev/null
+++ b/rtl/linux/termiosproc.inc
@@ -0,0 +1,157 @@
+{
+ $Id: termiosproc.inc,v 1.7 2005/02/14 17:13:30 peter Exp $
+}
+
+{******************************************************************************
+ IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+ {$ifndef BSD}
+ TCGetAttr:=fpIOCtl(fd,TCGETS,@tios);
+ {$else}
+ TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+ {$endif}
+end;
+
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+ nr:cint;
+begin
+ {$ifndef BSD}
+ case OptAct of
+ TCSANOW : nr:=TCSETS;
+ TCSADRAIN : nr:=TCSETSW;
+ TCSAFLUSH : nr:=TCSETSF;
+ {$else}
+ case OptAct of
+ TCSANOW : nr:=TIOCSETA;
+ TCSADRAIN : nr:=TIOCSETAW;
+ TCSAFLUSH : nr:=TIOCSETAF;
+ {$endif}
+ else
+ begin
+ fpsetErrNo(ESysEINVAL);
+ TCSetAttr:=-1;
+ exit;
+ end;
+ end;
+ TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ {$ifndef BSD}
+ tios.c_cflag:=(tios.c_cflag and (not CBAUD)) or speed;
+ {$else}
+ tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+ {$endif}
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ {$ifndef BSD}
+ CFSetISpeed(tios,speed);
+ {$else}
+ tios.c_ospeed:=speed;
+ {$endif}
+end;
+
+
+{ checked against glibc 2.3.3 (FK) }
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+ with tios do
+ begin
+ c_iflag:=c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
+ INLCR or IGNCR or ICRNL or IXON));
+ c_oflag:=c_oflag and (not OPOST);
+ c_lflag:=c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
+ c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or CS8;
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+end;
+
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+ TCSendBreak:=fpIOCtl(fd,TCSBRK,pointer(ptrint(duration)));
+end;
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+ TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(ptrint(id)));
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+ TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+ {$ifndef BSD}
+ TCDrain:=fpIOCtl(fd,TCSBRK,pointer(1));
+ {$else}
+ TCDrain:=fpIOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
+ {$endif}
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+ {$ifndef BSD}
+ TCFlow:=fpIOCtl(fd,TCXONC,pointer(ptrint(act)));
+ {$else}
+ case act OF
+ TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,0);
+ TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,0);
+ TCIOFF : {N/I}
+ end;
+ {$endif}
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+ {$ifndef BSD}
+ TCFlush:=fpIOCtl(fd,TCFLSH,pointer(ptrint(qsel)));
+ {$else}
+ TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(ptrint(qsel)));
+ {$endif}
+end;
+
+Function IsATTY (Handle:cint):cint;
+{
+ Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+var
+ t : Termios;
+begin
+ if TCGetAttr(Handle,t)=0 then
+ IsAtty:=1
+ else
+ IsAtty:=0;
+end;
+
+
+Function IsATTY(var f: text):cint;
+{
+ Idem as previous, only now for text variables.
+}
+begin
+ IsATTY:=IsaTTY(textrec(f).handle);
+end;
+
+{
+ $Log: termiosproc.inc,v $
+ Revision 1.7 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/tthread.inc b/rtl/linux/tthread.inc
new file mode 100644
index 0000000000..f30d5f9aac
--- /dev/null
+++ b/rtl/linux/tthread.inc
@@ -0,0 +1,349 @@
+{
+ $Id: tthread.inc,v 1.15 2005/03/06 15:24:03 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Peter Vreman
+
+ Linux TThread implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ What follows, is a short description on my implementation of TThread.
+ Most information can also be found by reading the source and accompanying
+ comments.
+
+ A thread is created using BeginThread, which in turn calls
+ pthread_create. So the threads here are always posix threads.
+ Posix doesn't define anything for suspending threads as this is
+ inherintly unsafe. Just don't suspend threads at points they cannot
+ control. Therefore, I didn't implement .Suspend() if its called from
+ outside the threads execution flow (except on Linux _without_ NPTL).
+
+ The implementation for .suspend uses a semaphore, which is initialized
+ at thread creation. If the thread tries to suspend itself, we simply
+ let it wait on the semaphore until it is unblocked by someone else
+ who calls .Resume.
+
+ If a thread is supposed to be suspended (from outside its own path of
+ execution) on a system where the symbol LINUX is defined, two things
+ are possible.
+ 1) the system has the LinuxThreads pthread implementation
+ 2) the system has NPTL as the pthread implementation.
+
+ In the first case, each thread is a process on its own, which as far as
+ know actually violates posix with respect to signal handling.
+ But we can detect this case, because getpid(2) will
+ return a different PID for each thread. In that case, sending SIGSTOP
+ to the PID associated with a thread will actually stop that thread
+ only.
+ In the second case, this is not possible. But getpid(2) returns the same
+ PID across all threads, which is detected, and TThread.Suspend() does
+ nothing in that case. This should probably be changed, but I know of
+ no way to suspend a thread when using NPTL.
+
+ If the symbol LINUX is not defined, then the unimplemented
+ function SuspendThread is called.
+
+ Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+ I don't like this. It eats up 2 filedescriptors for each thread,
+ and those are a limited resource. If you have a server programm
+ handling client connections (one per thread) it will not be able
+ to handle many if we use 2 fds already for internal structures.
+ However, right now I don't see a better option unless some sem_*
+ functions are added to systhrds.
+ I encapsulated all used functions here to make it easier to
+ change them completely.
+}
+
+function SemaphoreInit: Pointer;
+begin
+ SemaphoreInit := GetMem(SizeOf(TFilDes));
+ fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+ b: byte;
+begin
+ fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+ fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+ fpclose(PFilDes(FSem)^[0]);
+ fpclose(PFilDes(FSem)^[1]);
+ FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+ ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+ GMainPID: LongInt = 0;
+{$ENDIF}
+const
+ // stupid, considering its not even implemented...
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+ if not ThreadsInited then begin
+ ThreadsInited := true;
+ {$IFDEF LINUX}
+ GMainPid := fpgetpid();
+ {$ENDIF}
+ end;
+end;
+
+procedure DoneThreads;
+begin
+ ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): PtrInt;
+var
+ LThread: TThread;
+ c: char;
+begin
+ WRITE_DEBUG('ThreadFunc is here...');
+ LThread := TThread(parameter);
+ {$IFDEF LINUX}
+ // save the PID of the "thread"
+ // this is different from the PID of the main thread if
+ // the LinuxThreads implementation is used
+ LThread.FPid := fpgetpid();
+ {$ENDIF}
+ WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+ try
+ if LThread.FInitialSuspended then begin
+ SemaphoreWait(LThread.FSem);
+ if not LThread.FSuspended then begin
+ LThread.FInitialSuspended := false;
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ end else begin
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ except
+ on e: exception do begin
+ WRITE_DEBUG('got exception: ',e.message);
+ LThread.FFatalException := TObject(AcquireExceptionObject);
+ // not sure if we should really do this...
+ // but .Destroy was called, so why not try FreeOnTerminate?
+ if e is EThreadDestroyCalled then
+ LThread.FFreeOnTerminate := true;
+ end;
+ end;
+ WRITE_DEBUG('thread done running');
+ Result := LThread.FReturnValue;
+ WRITE_DEBUG('Result is ',Result);
+ LThread.FFinished := True;
+ LThread.DoTerminate;
+ if LThread.FreeOnTerminate then begin
+ WRITE_DEBUG('Thread should be freed');
+ LThread.Free;
+ WRITE_DEBUG('Thread freed');
+ end;
+ WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+ // lets just hope that the user doesn't create a thread
+ // via BeginThread and creates the first TThread Object in there!
+ InitThreads;
+ inherited Create;
+ FSem := SemaphoreInit;
+ FSuspended :=CreateSuspended;
+ FSuspendedExternal := false;
+ FInitialSuspended := CreateSuspended;
+ FFatalException := nil;
+ WRITE_DEBUG('creating thread, self = ',longint(self));
+ FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+ WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) then
+ raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+
+ // if someone calls .Free on a thread with
+ // FreeOnTerminate, then don't crash!
+ FFreeOnTerminate := false;
+ if not FFinished and not FSuspended then begin
+ Terminate;
+ WaitFor;
+ end;
+ if (FInitialSuspended) then begin
+ // thread was created suspended but never woken up.
+ SemaphorePost(FSem);
+ WaitFor;
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ SemaphoreDestroy(FSem);
+ inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ if not FSuspended then begin
+ if FThreadID = GetCurrentThreadID then begin
+ FSuspended := true;
+ SemaphoreWait(FSem);
+ end else begin
+ FSuspendedExternal := true;
+{$IFDEF LINUX}
+ // naughty hack if the user doesn't have Linux with NPTL...
+ // in that case, the PID of threads will not be identical
+ // to the other threads, which means that our thread is a normal
+ // process that we can suspend via SIGSTOP...
+ // this violates POSIX, but is the way it works on the
+ // LinuxThreads pthread implementation. Not with NPTL, but in that case
+ // getpid(2) also behaves properly and returns the same PID for
+ // all threads. Thats actually (FINALLY!) native thread support :-)
+ if FPid <> GMainPID then begin
+ FSuspended := true;
+ fpkill(FPid, SIGSTOP);
+ end;
+{$ELSE}
+ SuspendThread(FHandle);
+{$ENDIF}
+ end;
+ end;
+end;
+
+
+procedure TThread.Resume;
+begin
+ if (not FSuspendedExternal) then begin
+ if FSuspended then begin
+ FSuspended := False;
+ SemaphorePost(FSem);
+ end;
+ end else begin
+ FSuspendedExternal := false;
+{$IFDEF LINUX}
+ // see .Suspend
+ if FPid <> GMainPID then begin
+ FSuspended := False;
+ fpkill(FPid, SIGCONT);
+ end;
+{$ELSE}
+ ResumeThread(FHandle);
+{$ENDIF}
+ end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+ WRITE_DEBUG('waiting for thread ',FHandle);
+ WaitFor := WaitForThreadTerminate(FHandle, 0);
+ WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ // no need to check if FOnTerminate <> nil, because
+ // thats already done in DoTerminate
+ FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.15 2005/03/06 15:24:03 florian
+ * FreeOnTerminate handling fixed
+
+ Revision 1.14 2005/03/01 20:38:49 jonas
+ * fixed web bug 3387: if one called resume right after creating a
+ suspended thread, it was possible that resume was executed before
+ that thread had completed its initialisation in BeginThread ->
+ FInitialSuspended was set to false in resume and nevertheless a
+ semafore was posted
+ * second problem fixed: set FSuspended to false before waking up the
+ thread, so that it doesn't get FSuspended = true right after waking
+ up. This should be done atomically to be completely correct though.
+
+ Revision 1.13 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.12 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.11 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
diff --git a/rtl/linux/unixsock.inc b/rtl/linux/unixsock.inc
new file mode 100644
index 0000000000..a2ac490f89
--- /dev/null
+++ b/rtl/linux/unixsock.inc
@@ -0,0 +1,234 @@
+{
+ $Id: unixsock.inc,v 1.14 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2004 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ socket call implementations for Linux
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+{$ifndef cpux86_64}
+ {$define NEED_SOCKETCALL}
+{$endif}
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+{$ifdef NEED_SOCKETCALL}
+
+Const
+ {
+ Arguments to the Linux Kernel system call for sockets. All
+ Socket Connected calls go through the same system call,
+ with an extra argument to determine what action to take.
+ }
+ Socket_Sys_SOCKET = 1;
+ Socket_Sys_BIND = 2;
+ Socket_Sys_CONNECT = 3;
+ Socket_Sys_LISTEN = 4;
+ Socket_Sys_ACCEPT = 5;
+ Socket_Sys_GETSOCKNAME = 6;
+ Socket_Sys_GETPEERNAME = 7;
+ Socket_Sys_SOCKETPAIR = 8;
+ Socket_Sys_SEND = 9;
+ Socket_Sys_RECV = 10;
+ Socket_Sys_SENDTO = 11;
+ Socket_Sys_RECVFROM = 12;
+ Socket_Sys_SHUTDOWN = 13;
+ Socket_Sys_SETSOCKOPT = 14;
+ Socket_Sys_GETSOCKOPT = 15;
+ Socket_Sys_SENDMSG = 16;
+ Socket_Sys_RECVMSG = 17;
+
+
+Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:longint):longint;
+var
+ Args:array[1..6] of longint;
+begin
+ args[1]:=a1;
+ args[2]:=a2;
+ args[3]:=a3;
+ args[4]:=a4;
+ args[5]:=a5;
+ args[6]:=a6;
+ SocketCall:=do_Syscall(syscall_nr_socketcall,sockcallnr,longint(@args));
+ If SocketCall<0 then
+ SocketError:=fpgetErrno
+ else
+ SocketError:=0;
+end;
+
+
+function SocketCall(SockCallNr,a1,a2,a3:longint):longint;
+begin
+ SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
+end;
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+ fpSocket:=SocketCall(Socket_Sys_socket,Domain,xtype,Protocol);
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpSend:=SocketCall(Socket_Sys_sendto,S,TSysParam(msg),Len,Flags,0,0);
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ fpSendto:=SocketCall(Socket_Sys_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+ fpRecv:=SocketCall(Socket_Sys_Recvfrom,S,tsysparam(buf),len,flags,0,0);
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+ fpRecvFrom:=SocketCall(Socket_Sys_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+ fpBind:=SocketCall(Socket_Sys_Bind,S,TSysParam(addrx),addrlen);
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+begin
+ fpListen:=SocketCall(Socket_Sys_Listen,S,backlog,0);
+end;
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+ fpAccept:=SocketCall(Socket_Sys_accept,S,TSysParam(addrx),TSysParam(addrlen));
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+begin
+ fpConnect:=SocketCall(Socket_Sys_connect,S,TSysParam(name),namelen);
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpShutDown:=SocketCall(Socket_Sys_shutdown,S,how,0);
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetSockName:=SocketCall(Socket_Sys_GetSockName,S,TSysParam(name),TSysParam(namelen));
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetPeerName:=SocketCall(Socket_Sys_GetPeerName,S,TSysParam(name),TSysParam(namelen));
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
+begin
+ fpSetSockOpt:=SocketCall(Socket_Sys_SetSockOpt,S,level,optname,TSysParam(optval),optlen,0);
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpGetSockOpt:=SocketCall(Socket_Sys_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen),0);
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+ fpSocketPair:=SocketCall(Socket_Sys_SocketPair,d,xtype,protocol,TSysParam(sv),0,0);
+end;
+
+{$else NEED_SOCKETCALL}
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+ fpSocket:=do_syscall(syscall_nr_socket,Domain,xtype,Protocol);
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags);
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+ fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags);
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+ fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+ fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+begin
+ fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
+end;
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+ fpAccept:=do_syscall(syscall_nr_accept,S,TSysParam(addrx),TSysParam(addrlen));
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+begin
+ fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
+begin
+ fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,level,optname,TSysParam(optval),optlen);
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+ fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
+end;
+
+{$endif NEED_do_syscall}
+
+{
+ $Log: unixsock.inc,v $
+ Revision 1.14 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/unxconst.inc b/rtl/linux/unxconst.inc
new file mode 100644
index 0000000000..2ea45812b9
--- /dev/null
+++ b/rtl/linux/unxconst.inc
@@ -0,0 +1,101 @@
+{
+ $Id: unxconst.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Const
+ { Things for OPEN call - after linux/fcntl.h }
+ Open_Accmode = 3;
+ Open_RdOnly = 0;
+ Open_WrOnly = 1;
+ Open_RdWr = 2;
+ Open_Creat = 1 shl 6; // %100 etc
+ Open_Excl = 2 shl 6;
+ Open_NoCtty = 4 shl 6;
+ Open_Trunc = 1 shl 9;
+ Open_Append = 2 shl 9;
+ Open_NonBlock = 4 shl 9;
+ Open_NDelay = Open_NonBlock;
+ Open_Sync = 1 shl 12;
+ Open_Direct = 4 shl 12;
+ Open_LargeFile = 1 shl 15;
+ Open_Directory = 2 shl 15;
+ Open_NoFollow = 4 shl 15;
+
+ { The waitpid uses the following options:}
+ Wait_NoHang = 1;
+ Wait_UnTraced = 2;
+ Wait_Any = -1;
+ Wait_MyPGRP = 0;
+ Wait_Clone = $80000000;
+
+ { Constants to check stat.mode }
+ STAT_IFMT = $f000; {00170000}
+ STAT_IFSOCK = $c000; {0140000}
+ STAT_IFLNK = $a000; {0120000}
+ STAT_IFREG = $8000; {0100000}
+ STAT_IFBLK = $6000; {0060000}
+ STAT_IFDIR = $4000; {0040000}
+ STAT_IFCHR = $2000; {0020000}
+ STAT_IFIFO = $1000; {0010000}
+ STAT_ISUID = $0800; {0004000}
+ STAT_ISGID = $0400; {0002000}
+ STAT_ISVTX = $0200; {0001000}
+ { Constants to check permissions }
+ STAT_IRWXO = $7;
+ STAT_IROTH = $4;
+ STAT_IWOTH = $2;
+ STAT_IXOTH = $1;
+
+ STAT_IRWXG = STAT_IRWXO shl 3;
+ STAT_IRGRP = STAT_IROTH shl 3;
+ STAT_IWGRP = STAT_IWOTH shl 3;
+ STAT_IXGRP = STAT_IXOTH shl 3;
+
+ STAT_IRWXU = STAT_IRWXO shl 6;
+ STAT_IRUSR = STAT_IROTH shl 6;
+ STAT_IWUSR = STAT_IWOTH shl 6;
+ STAT_IXUSR = STAT_IXOTH shl 6;
+
+ { Constants to test the type of filesystem }
+ fs_old_ext2 = $ef51;
+ fs_ext2 = $ef53;
+ fs_ext = $137d;
+ fs_iso = $9660;
+ fs_minix = $137f;
+ fs_minix_30 = $138f;
+ fs_minux_V2 = $2468;
+ fs_msdos = $4d44;
+ fs_nfs = $6969;
+ fs_proc = $9fa0;
+ fs_xia = $012FD16D;
+
+ {Constansts Termios/Ioctl (used in Do_IsDevice) }
+ {$ifdef PowerPC}
+ IOCtl_TCGETS=$402c7413;
+ {$else}
+ IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+ {$endif}
+
+{
+ $Log: unxconst.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.12 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/linux/unxfunc.inc b/rtl/linux/unxfunc.inc
new file mode 100644
index 0000000000..6be339c9a6
--- /dev/null
+++ b/rtl/linux/unxfunc.inc
@@ -0,0 +1,74 @@
+{
+ $Id: unxfunc.inc,v 1.3 2005/03/06 17:12:11 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ pip : tpipe;
+begin
+ {$ifdef FPC_USE_LIBC}
+ assignpipe:=pipe(pip);
+ {$else}
+ assignPipe:=fppipe(pip);
+ {$endif}
+ pipe_in:=pip[0];
+ pipe_out:=pip[1];
+end;
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^cint;
+ res : cint;
+begin
+ fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+ res : cint;
+begin
+ fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+
+{
+ $Log: unxfunc.inc,v $
+ Revision 1.3 2005/03/06 17:12:11 florian
+ * AssignPipe fixed
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.1 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/linux/unxsockh.inc b/rtl/linux/unxsockh.inc
new file mode 100644
index 0000000000..cf2672cd2d
--- /dev/null
+++ b/rtl/linux/unxsockh.inc
@@ -0,0 +1,143 @@
+{
+ $Id: unxsockh.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ socket call implementations for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+Const
+// AF_LOCAL =1; { local to host (pipes, portals) }
+ AF_IMPLINK =3; { arpanet imp addresses }
+ AF_PUP =4; { pup protocols: e.g. BSP }
+ AF_CHAOS =5; { mit CHAOS protocols }
+ AF_NS =6; { XEROX NS protocols }
+ AF_ISO =7; { ISO protocols }
+ AF_OSI =AF_ISO;
+ AF_ECMA =8; { European computer manufacturers }
+ AF_DATAKIT =9; { datakit protocols }
+ AF_CCITT =10; { CCITT protocols, X.25 etc }
+ AF_SNA =11; { IBM SNA }
+ AF_DECnet =12; { DECnet }
+ AF_DLI =13; { DEC Direct data link interface }
+ AF_LAT =14; { LAT }
+ AF_HYLINK =15; { NSC Hyperchannel }
+ AF_APPLETALK =16; { Apple Talk }
+ AF_ROUTE =17; { Internal Routing Protocol }
+ AF_LINK =18; { Link layer interface }
+ pseudo_AF_XTP =19; { eXpress Transfer Protocol (no AF) }
+ AF_COIP =20; { connection-oriented IP, aka ST II }
+ AF_CNT =21; { Computer Network Technology }
+ pseudo_AF_RTIP =22; { Help Identify RTIP packets }
+ AF_IPX =23; { Novell Internet Protocol }
+ AF_SIP =24; { Simple Internet Protocol }
+ pseudo_AF_PIP =25; { Help Identify PIP packets }
+ AF_ISDN =26; { Integrated Services Digital Network}
+ AF_E164 =AF_ISDN; { CCITT E.164 recommendation }
+ pseudo_AF_KEY =27; { Internal key-management function }
+ AF_INET6 =28; { IPv6 }
+ AF_NATM =29; { native ATM access }
+ AF_ATM =30; { ATM }
+ pseudo_AF_HDRCMPLT=31; { Used by BPF to not rewrite headers
+ in interface output routine}
+ AF_NETGRAPH =32; { Netgraph sockets }
+ AF_MAX =33;
+
+ SOCK_MAXADDRLEN =255; { longest possible addresses }
+
+{
+* Protocol families, same as address families for now.
+}
+// PF_LOCAL =AF_LOCAL;
+ PF_IMPLINK =AF_IMPLINK;
+ PF_PUP =AF_PUP;
+ PF_CHAOS =AF_CHAOS;
+ PF_NS =AF_NS;
+ PF_ISO =AF_ISO;
+ PF_OSI =AF_ISO;
+ PF_ECMA =AF_ECMA;
+ PF_DATAKIT =AF_DATAKIT;
+ PF_CCITT =AF_CCITT;
+ PF_SNA =AF_SNA;
+ PF_DECnet =AF_DECnet;
+ PF_DLI =AF_DLI;
+ PF_LAT =AF_LAT;
+ PF_HYLINK =AF_HYLINK;
+ PF_APPLETALK =AF_APPLETALK;
+ PF_ROUTE =AF_ROUTE;
+ PF_LINK =AF_LINK;
+ PF_XTP =pseudo_AF_XTP; { really just proto family, no AF }
+ PF_COIP =AF_COIP;
+ PF_CNT =AF_CNT;
+ PF_SIP =AF_SIP;
+ PF_IPX =AF_IPX; { same format as AF_NS }
+ PF_RTIP =pseudo_AF_RTIP; { same format as AF_INET }
+ PF_PIP =pseudo_AF_PIP;
+ PF_ISDN =AF_ISDN;
+ PF_KEY =pseudo_AF_KEY;
+ PF_INET6 =AF_INET6;
+ PF_NATM =AF_NATM;
+ PF_ATM =AF_ATM;
+ PF_NETGRAPH =AF_NETGRAPH;
+ PF_MAX =AF_MAX;
+
+{ For setsockoptions(2) }
+ SOL_SOCKET = 1;
+ SO_DEBUG = 1;
+ SO_REUSEADDR= 2;
+ SO_TYPE = 3;
+ SO_ERROR = 4;
+ SO_DONTROUTE= 5;
+ SO_BROADCAST= 6;
+ SO_SNDBUF = 7;
+ SO_RCVBUF = 8;
+ SO_KEEPALIVE= 9;
+ SO_OOBINLINE= 10;
+ SO_NO_CHECK = 11;
+ SO_PRIORITY = 12;
+ SO_LINGER = 13;
+ SO_BSDCOMPAT= 14;
+{ To add : SO_REUSEPORT 15 }
+ SO_PASSCRED= 16;
+ SO_PEERCRED= 17;
+ SO_RCVLOWAT= 18;
+ SO_SNDLOWAT= 19;
+ SO_RCVTIMEO= 20;
+ SO_SNDTIMEO= 21;
+
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+
+ SO_SECURITY_AUTHENTICATION = 22;
+ SO_SECURITY_ENCRYPTION_TRANSPORT= 23;
+ SO_SECURITY_ENCRYPTION_NETWORK = 24;
+
+ SO_BINDTODEVICE= 25;
+
+{ Socket filtering }
+
+ SO_ATTACH_FILTER= 26;
+ SO_DETACH_FILTER= 27;
+ SO_PEERNAME = 28;
+ SO_TIMESTAMP = 29;
+ SCM_TIMESTAMP = SO_TIMESTAMP;
+ SO_ACCEPTCONN = 30;
+
+
+ SHUT_RD =0; { shut down the reading side }
+ SHUT_WR =1; { shut down the writing side }
+ SHUT_RDWR =2; { shut down both sides }
+
+{
+ $Log: unxsockh.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/unxsysc.inc b/rtl/linux/unxsysc.inc
new file mode 100644
index 0000000000..0cb59ed605
--- /dev/null
+++ b/rtl/linux/unxsysc.inc
@@ -0,0 +1,81 @@
+{
+ $Id: unxsysc.inc,v 1.9 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Some calls for the unix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+Function fsync (fd : cint) : cint;
+begin
+ fsync := do_SysCall(syscall_nr_fsync, fd);
+end;
+
+Function fpFlock (fd,mode : cint) : cint;
+begin
+ fpflock:=do_Syscall(Syscall_nr_flock,fd,mode);
+end;
+
+
+Function StatFS(Path:Pchar;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Path is the name of a file/directory on the fileSystem you wish to
+ investigate.
+}
+begin
+ StatFS:=(do_SysCall(SysCall_nr_statfs,TSysParam(path),TSysParam(@Info)));
+end;
+
+Function fStatFS(Fd:cint;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+begin
+ fStatFS:=(do_SysCall(SysCall_nr_fstatfs,fd,TSysParam(@info)));
+end;
+
+
+{--------------------------------
+ Port IO functions
+--------------------------------}
+
+{$ifdef cpui386}
+
+Function IOperm (From,Num : cuint; Value : cint) : boolean;
+{
+ Set permissions on NUM ports starting with port FROM to VALUE
+ this works ONLY as root.
+}
+
+begin
+ IOPerm:=do_Syscall(Syscall_nr_ioperm,from,num,value)=0;
+end;
+
+Function IoPL(Level : cint) : Boolean;
+
+begin
+ IOPL:=do_Syscall(Syscall_nr_iopl,level)=0;
+end;
+
+{$endif cpui386}
+
+{
+ $Log: unxsysc.inc,v $
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.8 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/linux/unxsysch.inc b/rtl/linux/unxsysch.inc
new file mode 100644
index 0000000000..f7d9c19301
--- /dev/null
+++ b/rtl/linux/unxsysch.inc
@@ -0,0 +1,27 @@
+{
+ $Id: unxsysch.inc,v 1.9 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ deeper calls exported by unit unix
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************
+}
+
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; external name 'FPC_SYSC_GETTIMEOFDAY';
+
+{
+ $Log: unxsysch.inc,v $
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.8 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/linux/x86_64/bsyscall.inc b/rtl/linux/x86_64/bsyscall.inc
new file mode 100644
index 0000000000..168356fbd4
--- /dev/null
+++ b/rtl/linux/x86_64/bsyscall.inc
@@ -0,0 +1,20 @@
+{
+ $Id: bsyscall.inc,v 1.1 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: bsyscall.inc,v $
+ Revision 1.1 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+} \ No newline at end of file
diff --git a/rtl/linux/x86_64/cprt0.as b/rtl/linux/x86_64/cprt0.as
new file mode 100644
index 0000000000..2b4efd8bab
--- /dev/null
+++ b/rtl/linux/x86_64/cprt0.as
@@ -0,0 +1,164 @@
+/*
+ $Id: cprt0.as,v 1.4 2004/11/02 21:49:46 florian Exp $
+ Dummy implementation
+
+*/
+
+/* This is the canonical entry point, usually the first thing in the text
+ segment. The SVR4/i386 ABI (pages 3-31, 3-32) says that when the entry
+ point runs, most registers' values are unspecified, except for:
+
+ %rdx Contains a function pointer to be registered with `atexit'.
+ This is how the dynamic linker arranges to have DT_FINI
+ functions called for shared libraries that have been loaded
+ before this code runs.
+
+ %rsp The stack contains the arguments and environment:
+ 0(%rsp) argc
+ 8(%rsp) argv[0]
+ ...
+ (8*argc)(%rsp) NULL
+ (8*(argc+1))(%rsp) envp[0]
+ ...
+ NULL
+*/
+
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* Clear the frame pointer. The ABI suggests this be done, to mark
+ the outermost frame obviously. */
+ xorq %rbp, %rbp
+
+ /* Extract the arguments as encoded on the stack and set up
+ the arguments for __libc_start_main (int (*main) (int, char **, char **),
+ int argc, char *argv,
+ void (*init) (void), void (*fini) (void),
+ void (*rtld_fini) (void), void *stack_end).
+ The arguments are passed via registers and on the stack:
+ main: %rdi
+ argc: %rsi
+ argv: %rdx
+ init: %rcx
+ fini: %r8
+ rtld_fini: %r9
+ stack_end: stack. */
+
+ movq %rdx, %r9 /* Address of the shared library termination
+ function. */
+ popq %rsi /* Pop the argument count. */
+ movq %rsp, %rdx /* argv starts just at the current stack top. */
+
+ movq %rsi,operatingsystem_parameter_argc
+ movq %rsp,operatingsystem_parameter_argv /* argv starts just at the current stack top. */
+ leaq 8(,%rsi,8),%rax
+ addq %rsp,%rax
+ movq %rax,operatingsystem_parameter_envp
+
+ /* Align the stack to a 16 byte boundary to follow the ABI. */
+ andq $~15, %rsp
+
+ pushq %rax /* Push garbage because we push 8 more bytes. */
+
+ /* Provide the highest stack address to the user code (for stacks
+ which grow downwards). */
+ pushq %rsp
+
+ /* Pass address of our own entry points to .fini and .init. */
+ movq $_init_dummy, %r8
+ movq $_fini_dummy, %rcx
+
+ movq $main_stub, %rdi
+
+ /* Call the user's main function, and exit with its value.
+ But let the libc call main. */
+ call __libc_start_main
+
+ hlt /* Crash if somehow `exit' does return. */
+
+/* fake main routine which will be run from libc */
+main_stub:
+ /* save return address */
+ popq %rax
+
+ // stack alignment
+ pushq %rax
+
+ movq %rax,___fpc_ret
+ movq %rbp,___fpc_ret_rbp
+ pushq %rax
+
+ /* start the program */
+ xorq %rbp,%rbp
+ call PASCALMAIN
+ hlt
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ movzwq operatingsystem_result,%rax /* load and save exitcode */
+
+ movq ___fpc_ret,%rdx /* return to libc */
+ movq ___fpc_ret_rbp,%rbp
+ pushq %rdx
+_init_dummy:
+_fini_dummy:
+ ret
+
+/* Define a symbol for the first piece of initialized data. */
+ .data
+ .globl __data_start
+__data_start:
+ .long 0
+ .weak data_start
+ data_start = __data_start
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,8
+___fpc_brk_addr:
+ .quad 0
+
+___fpc_ret: /* return address to libc */
+ .quad 0
+___fpc_ret_rbp:
+ .quad 0
+
+.bss
+ .comm operatingsystem_parameter_envp,8
+ .comm operatingsystem_parameter_argc,8
+ .comm operatingsystem_parameter_argv,8
+
+/* We need this stuff to make gdb behave itself, otherwise
+ gdb will chokes with SIGILL when trying to debug apps.
+*/
+ .section ".note.ABI-tag", "a"
+ .align 4
+ .long 1f - 0f
+ .long 3f - 2f
+ .long 1
+0: .asciz "GNU"
+1: .align 4
+2: .long 0
+ .long 2,4,0
+3: .align 4
+
+ .section .note.GNU-stack,"",@progbits
+
+
+/*
+ $Log: cprt0.as,v $
+ Revision 1.4 2004/11/02 21:49:46 florian
+ * x86_64 requires always 16 byte alignment of the stack
+
+ Revision 1.3 2004/07/03 21:50:31 daniel
+ * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+ longer necessary
+
+ Revision 1.2 2004/02/20 23:48:27 peter
+ * c stub implemented
+
+ Revision 1.1 2003/01/06 19:39:17 florian
+ + dummy implementations
+*/
diff --git a/rtl/linux/x86_64/dllprt0.as b/rtl/linux/x86_64/dllprt0.as
new file mode 100644
index 0000000000..6bfed3a4c3
--- /dev/null
+++ b/rtl/linux/x86_64/dllprt0.as
@@ -0,0 +1,13 @@
+/*
+ $Id: dllprt0.as,v 1.1 2003/01/06 19:39:17 florian Exp $
+ Dummy implementation
+
+*/
+
+
+
+/*
+ $Log: dllprt0.as,v $
+ Revision 1.1 2003/01/06 19:39:17 florian
+ + dummy implementations
+*/
diff --git a/rtl/linux/x86_64/gprt0.as b/rtl/linux/x86_64/gprt0.as
new file mode 100644
index 0000000000..6f23dce297
--- /dev/null
+++ b/rtl/linux/x86_64/gprt0.as
@@ -0,0 +1,167 @@
+/*
+ $Id: gprt0.as,v 1.3 2004/11/02 21:49:46 florian Exp $
+ Dummy implementation
+
+*/
+
+/* This is the canonical entry point, usually the first thing in the text
+ segment. The SVR4/i386 ABI (pages 3-31, 3-32) says that when the entry
+ point runs, most registers' values are unspecified, except for:
+
+ %rdx Contains a function pointer to be registered with `atexit'.
+ This is how the dynamic linker arranges to have DT_FINI
+ functions called for shared libraries that have been loaded
+ before this code runs.
+
+ %rsp The stack contains the arguments and environment:
+ 0(%rsp) argc
+ 8(%rsp) argv[0]
+ ...
+ (8*argc)(%rsp) NULL
+ (8*(argc+1))(%rsp) envp[0]
+ ...
+ NULL
+*/
+
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+ /* Clear the frame pointer. The ABI suggests this be done, to mark
+ the outermost frame obviously. */
+ xorq %rbp, %rbp
+
+ /* Extract the arguments as encoded on the stack and set up
+ the arguments for __libc_start_main (int (*main) (int, char **, char **),
+ int argc, char *argv,
+ void (*init) (void), void (*fini) (void),
+ void (*rtld_fini) (void), void *stack_end).
+ The arguments are passed via registers and on the stack:
+ main: %rdi
+ argc: %rsi
+ argv: %rdx
+ init: %rcx
+ fini: %r8
+ rtld_fini: %r9
+ stack_end: stack. */
+
+ movq %rdx, %r9 /* Address of the shared library termination
+ function. */
+ popq %rsi /* Pop the argument count. */
+ movq %rsp, %rdx /* argv starts just at the current stack top. */
+
+ movq %rsi,operatingsystem_parameter_argc
+ movq %rsp,operatingsystem_parameter_argv /* argv starts just at the current stack top. */
+ leaq 8(,%rsi,8),%rax
+ addq %rsp,%rax
+ movq %rax,operatingsystem_parameter_envp
+
+ /* Align the stack to a 16 byte boundary to follow the ABI. */
+ andq $~15, %rsp
+
+ pushq %rax /* Push garbage because we push 8 more bytes. */
+
+ /* Provide the highest stack address to the user code (for stacks
+ which grow downwards). */
+ pushq %rsp
+
+ /* Pass address of our own entry points to .fini and .init. */
+ movq $_init_dummy, %r8
+ movq $_fini_dummy, %rcx
+
+ movq $main_stub, %rdi
+
+ /* Call the user's main function, and exit with its value.
+ But let the libc call main. */
+ call __libc_start_main
+
+ hlt /* Crash if somehow `exit' does return. */
+
+/* fake main routine which will be run from libc */
+main_stub:
+ /* save return address */
+ popq %rax
+
+ // stack alignment
+ pushq %rax
+
+ movq %rax,___fpc_ret
+ movq %rbp,___fpc_ret_rbp
+ pushq %rax
+
+ /* Initialize gmon */
+ movq $_etext,%rsi
+ movq $_start,%rdi
+ call monstartup
+
+ movq $_mcleanup,%rdi
+ call atexit
+
+ /* start the program */
+ xorq %rbp,%rbp
+ call PASCALMAIN
+ hlt
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ movzwq operatingsystem_result,%rax /* load and save exitcode */
+
+ movq ___fpc_ret,%rdx /* return to libc */
+ movq ___fpc_ret_rbp,%rbp
+ pushq %rdx
+_init_dummy:
+_fini_dummy:
+ ret
+
+/* Define a symbol for the first piece of initialized data. */
+ .data
+ .globl __data_start
+__data_start:
+ .long 0
+ .weak data_start
+ data_start = __data_start
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,8
+___fpc_brk_addr:
+ .quad 0
+
+___fpc_ret: /* return address to libc */
+ .quad 0
+___fpc_ret_rbp:
+ .quad 0
+
+.bss
+ .comm operatingsystem_parameter_envp,8
+ .comm operatingsystem_parameter_argc,8
+ .comm operatingsystem_parameter_argv,8
+
+/* We need this stuff to make gdb behave itself, otherwise
+ gdb will chokes with SIGILL when trying to debug apps.
+*/
+ .section ".note.ABI-tag", "a"
+ .align 4
+ .long 1f - 0f
+ .long 3f - 2f
+ .long 1
+0: .asciz "GNU"
+1: .align 4
+2: .long 0
+ .long 2,4,0
+3: .align 4
+
+ .section .note.GNU-stack,"",@progbits
+
+/*
+ $Log: gprt0.as,v $
+ Revision 1.3 2004/11/02 21:49:46 florian
+ * x86_64 requires always 16 byte alignment of the stack
+
+ Revision 1.2 2004/11/02 20:41:57 florian
+ * initial implementation
+
+ Revision 1.1 2003/01/06 19:39:17 florian
+ + dummy implementations
+*/ \ No newline at end of file
diff --git a/rtl/linux/x86_64/prt0.as b/rtl/linux/x86_64/prt0.as
new file mode 100644
index 0000000000..1a95dc831f
--- /dev/null
+++ b/rtl/linux/x86_64/prt0.as
@@ -0,0 +1,129 @@
+#
+# $Id: prt0.as,v 1.10 2005/02/05 23:02:37 florian Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 2002 by Florian Klaempfl
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# Linux ELF startup code for Free Pascal
+#
+
+/* This is the canonical entry point, usually the first thing in the text
+ segment. The SVR4/i386 ABI (pages 3-31, 3-32) says that when the entry
+ point runs, most registers' values are unspecified, except for:
+
+ %rdx Contains a function pointer to be registered with `atexit'.
+ This is how the dynamic linker arranges to have DT_FINI
+ functions called for shared libraries that have been loaded
+ before this code runs.
+
+ %rsp The stack contains the arguments and environment:
+ 0(%rsp) argc
+ 8(%rsp) argv[0]
+ ...
+ (8*argc)(%rsp) NULL
+ (8*(argc+1))(%rsp) envp[0]
+ ...
+ NULL
+*/
+
+ .text
+ .globl _start
+ .type _start,@function
+_start:
+# movq %rdx,%r9 /* Address of the shared library termination
+# function. */
+ popq %rsi /* Pop the argument count. */
+ movq %rsi,operatingsystem_parameter_argc
+ movq %rsp,operatingsystem_parameter_argv /* argv starts just at the current stack top. */
+ leaq 8(,%rsi,8),%rax
+ addq %rsp,%rax
+ movq %rax,operatingsystem_parameter_envp
+ andq $~15,%rsp /* Align the stack to a 16 byte boundary to follow the ABI. */
+
+ xorq %rbp, %rbp
+ call PASCALMAIN
+ jmp _haltproc
+
+ .globl _haltproc
+ .type _haltproc,@function
+_haltproc:
+ movl $60,%eax /* exit call */
+ movzwl operatingsystem_result,%edi
+ syscall
+ jmp _haltproc
+
+/* Define a symbol for the first piece of initialized data. */
+ .data
+ .globl __data_start
+__data_start:
+ .long 0
+ .weak data_start
+ data_start = __data_start
+
+.bss
+ .comm operatingsystem_parameter_envp,8
+ .comm operatingsystem_parameter_argc,8
+ .comm operatingsystem_parameter_argv,8
+
+
+/* We need this stuff to make gdb behave itself, otherwise
+ gdb will chokes with SIGILL when trying to debug apps.
+*/
+ .section ".note.ABI-tag", "a"
+ .align 4
+ .long 1f - 0f
+ .long 3f - 2f
+ .long 1
+0: .asciz "GNU"
+1: .align 4
+2: .long 0
+ .long 2,4,0
+3: .align 4
+
+ .section .note.GNU-stack,"",@progbits
+
+#
+# $Log: prt0.as,v $
+# Revision 1.10 2005/02/05 23:02:37 florian
+# + added some missing c types
+#
+# Revision 1.9 2004/11/02 15:26:21 florian
+# * fixed sse exception handling
+#
+# Revision 1.8 2004/07/03 21:50:31 daniel
+# * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+# longer necessary
+#
+# Revision 1.7 2004/04/24 17:14:09 florian
+# * prt0.as exit code handling fixed
+# * int64 mod int64 for negative numbers fixed
+#
+# Revision 1.6 2004/04/20 20:30:11 florian
+# * fixed halt code
+#
+# Revision 1.5 2004/04/12 19:05:55 florian
+# + haltproc added
+#
+# Revision 1.4 2004/02/20 23:48:27 peter
+# * c stub implemented
+#
+# Revision 1.3 2004/02/08 15:33:50 florian
+# * linking problems fixed
+# + abi tag added
+#
+# Revision 1.2 2004/02/02 21:02:38 peter
+# * fixed syntax errors
+#
+# Revision 1.1 2003/01/06 19:33:10 florian
+# + initial revision
+#
+#
diff --git a/rtl/linux/x86_64/sighnd.inc b/rtl/linux/x86_64/sighnd.inc
new file mode 100644
index 0000000000..6106535c02
--- /dev/null
+++ b/rtl/linux/x86_64/sighnd.inc
@@ -0,0 +1,93 @@
+{
+ $Id: sighnd.inc,v 1.5 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+const
+ FPU_All = $7f;
+
+function GetFPUState(const SigContext : TSigContext) : word;
+ begin
+ if assigned(SigContext.fpstate) then
+ GetfpuState:=SigContext.fpstate^.swd;
+ {$ifdef SYSTEM_DEBUG}
+ writeln('xx:',sigcontext.en_tw,' ',sigcontext.en_cw);
+ {$endif SYSTEM_DEBUG}
+ {$ifdef SYSTEM_DEBUG}
+ Writeln(stderr,'FpuState = ',result);
+ {$endif SYSTEM_DEBUG}
+ end;
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); cdecl;
+ var
+ res,fpustate : word;
+ begin
+ res:=0;
+ case sig of
+ SIGFPE :
+ begin
+ { this is not allways necessary but I don't know yet
+ how to tell if it is or not PM }
+ res:=200;
+ fpustate:=GetFPUState(SigContext^);
+ if (FpuState and FPU_All) <> 0 then
+ begin
+ { first check the more precise options }
+ if (FpuState and FPU_DivisionByZero)<>0 then
+ res:=200
+ else if (FpuState and FPU_Overflow)<>0 then
+ res:=205
+ else if (FpuState and FPU_Underflow)<>0 then
+ res:=206
+ else if (FpuState and FPU_Denormal)<>0 then
+ res:=216
+ else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 Then
+ res:=207
+ else if (FpuState and FPU_Invalid)<>0 then
+ res:=216
+ else
+ res:=207; {'Coprocessor Error'}
+ end;
+ SysResetFPU;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV:
+ res:=216;
+ end;
+ reenable_signal(sig);
+ if res<>0 then
+ HandleErrorAddrFrame(res,pointer(SigContext^.rip),pointer(SigContext^.rbp));
+ end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.5 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.3 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/x86_64/sighndh.inc b/rtl/linux/x86_64/sighndh.inc
new file mode 100644
index 0000000000..ec5a26e586
--- /dev/null
+++ b/rtl/linux/x86_64/sighndh.inc
@@ -0,0 +1,77 @@
+{
+ $Id: sighndh.inc,v 1.1 2005/01/30 18:01:15 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ TSigcontext
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+ Pfpstate = ^Tfpstate;
+ Tfpstate = record
+ cwd,
+ swd,
+ twd, // Note this is not the same as the 32bit/x87/FSAVE twd
+ fop : word;
+ rip,
+ rdp : qword;
+ mxcsr,
+ mxcsr_mask : dword;
+ st_space : array[0..31] of dword; // 8*16 bytes for each FP-reg
+ xmm_space : array[0..63] of dword; // 16*16 bytes for each XMM-reg
+ reserved2 : array[0..23] of dword;
+ end;
+
+ PSigContext = ^TSigContext;
+ TSigContext = record
+ __pad00 : array[0..4] of qword;
+ r8,
+ r9,
+ r10,
+ r11,
+ r12,
+ r13,
+ r14,
+ r15,
+ rdi,
+ rsi,
+ rbp,
+ rbx,
+ rdx,
+ rax,
+ rcx,
+ rsp,
+ rip,
+ eflags : qword;
+ cs,
+ gs,
+ fs,
+ __pad0 : word;
+ err,
+ trapno,
+ oldmask,
+ cr2 : qword;
+ fpstate : Pfpstate; // zero when no FPU context */
+ reserved1 : array[0..7] of qword;
+ end;
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/linux/x86_64/stat.inc b/rtl/linux/x86_64/stat.inc
new file mode 100644
index 0000000000..42a846e34c
--- /dev/null
+++ b/rtl/linux/x86_64/stat.inc
@@ -0,0 +1,75 @@
+{
+ $Id: stat.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef FPC_USE_LIBC} // kernel record
+
+ stat = packed record
+ case byte of
+ 0: (
+ st_dev : qword;
+ st_ino : qword;
+ st_nlink : qword;
+
+ st_mode : dword;
+ st_uid : dword;
+ st_gid : dword;
+ __pad0 : dword;
+ st_rdev : qword;
+ st_size : int64;
+ st_blksize : int64;
+ st_blocks : int64; { Number 512-byte blocks allocated. }
+
+ st_atime : qword;
+ __reserved0 : qword; { reserved for atime.nanoseconds }
+ st_mtime : qword;
+ __reserved1 : qword; { reserved for atime.nanoseconds }
+ st_ctime : qword;
+ __reserved2 : qword; { reserved for atime.nanoseconds }
+ __unused : array[0..2] of int64;
+ );
+ 1: (
+ dev,
+ ino,
+ nlink : qword;
+ mode,
+ uid,
+ gid : dword;
+ pad1_dummy : dword;
+ rdev : qword;
+ size,
+ blksze,
+ blocks : int64;
+ atime,
+ unused1_dummy,
+ mtime,
+ unused2_dummy,
+ ctime,
+ unused3_dummy,
+ unused4_dummy,
+ unused5_dummy : qword;)
+ end;
+
+{$else}
+
+(* get it from glibc/sysdeps/unix/sysv/linux/x86_64/bits/stat.h and check defines with gcc *)
+
+{$endif}
+
+{
+ $Log: stat.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/x86_64/syscall.inc b/rtl/linux/x86_64/syscall.inc
new file mode 100644
index 0000000000..7167cb98a0
--- /dev/null
+++ b/rtl/linux/x86_64/syscall.inc
@@ -0,0 +1,233 @@
+{
+ $Id: syscall.inc,v 1.11 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ The syscalls for the new RTL, moved to platform dependant dir.
+ Old linux calling convention is stil kept.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ASMMODE GAS}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ movq param3, %rdx
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ movq param3, %rdx
+ movq param4, %r10
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ movq param3, %rdx
+ movq param4, %r10
+ movq param5, %r8
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+
+asm
+ movq sysnr, %rax { Syscall number -> rax. }
+ movq param1, %rdi { shift arg1 - arg5. }
+ movq param2, %rsi
+ movq param3, %rdx
+ movq param4, %r10
+ movq param5, %r8
+ movq param6, %r9
+ syscall { Do the system call. }
+ cmpq $-4095, %rax { Check %rax for error. }
+ jnae .LSyscOK { Jump to error handler if error. }
+ negq %rax
+ movq %rax,%rdx
+ movq fpc_threadvar_relocate_proc,%rax
+ testq %rax,%rax
+ jne .LThread
+ movl %edx,Errno+8
+ jmp .LNoThread
+.LThread:
+ pushq %rdx
+ movq Errno,%rdi
+ call *%rax
+ popq %rdx
+ movl %edx,(%rax)
+.LNoThread:
+ movq $-1,%rax
+.LSyscOK:
+end;
+
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+ {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{
+ $Log: syscall.inc,v $
+ Revision 1.11 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.10 2005/02/05 23:49:49 florian
+ * threadvars on x86_64 fixed
+
+}
diff --git a/rtl/linux/x86_64/syscallh.inc b/rtl/linux/x86_64/syscallh.inc
new file mode 100644
index 0000000000..2e4d381a06
--- /dev/null
+++ b/rtl/linux/x86_64/syscallh.inc
@@ -0,0 +1,46 @@
+{
+ $Id: syscallh.inc,v 1.6 2005/02/14 17:13:30 peter Exp $
+ Copyright (c) 2002 by Marco van de Voort
+
+ Header for syscall in system unit for i386 *BSD.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+type
+ TSysResult = int64; // all platforms, cint=32-bit.
+ // On platforms with off_t =64-bit, people should
+ // use int64, and typecast all calls that don't
+ // return off_t to cint.
+
+ TSysParam = int64;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult; external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL6';
+
+{
+ $Log: syscallh.inc,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/linux/x86_64/sysnr.inc b/rtl/linux/x86_64/sysnr.inc
new file mode 100644
index 0000000000..c540e2f2d5
--- /dev/null
+++ b/rtl/linux/x86_64/sysnr.inc
@@ -0,0 +1,308 @@
+{
+ $Id: sysnr.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Syscall nrs for 2.4.18
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+const
+ syscall_nr_read = 0;
+ syscall_nr_write = 1;
+ syscall_nr_open = 2;
+ syscall_nr_close = 3;
+ syscall_nr_stat = 4;
+ syscall_nr_fstat = 5;
+ syscall_nr_lstat = 6;
+ syscall_nr_poll = 7;
+ syscall_nr_lseek = 8;
+ syscall_nr_mmap = 9;
+ syscall_nr_mprotect = 10;
+ syscall_nr_munmap = 11;
+ syscall_nr_brk = 12;
+ syscall_nr_rt_sigaction = 13;
+ syscall_nr_rt_sigprocmask = 14;
+ syscall_nr_rt_sigreturn = 15;
+ syscall_nr_ioctl = 16;
+ syscall_nr_pread64 = 17;
+ syscall_nr_pwrite64 = 18;
+ syscall_nr_readv = 19;
+ syscall_nr_writev = 20;
+ syscall_nr_access = 21;
+ syscall_nr_pipe = 22;
+ syscall_nr_select = 23;
+ syscall_nr_sched_yield = 24;
+ syscall_nr_mremap = 25;
+ syscall_nr_msync = 26;
+ syscall_nr_mincore = 27;
+ syscall_nr_madvise = 28;
+ syscall_nr_shmget = 29;
+ syscall_nr_shmat = 30;
+ syscall_nr_shmctl = 31;
+ syscall_nr_dup = 32;
+ syscall_nr_dup2 = 33;
+ syscall_nr_pause = 34;
+ syscall_nr_nanosleep = 35;
+ syscall_nr_getitimer = 36;
+ syscall_nr_alarm = 37;
+ syscall_nr_setitimer = 38;
+ syscall_nr_getpid = 39;
+ syscall_nr_sendfile = 40;
+ syscall_nr_socket = 41;
+ syscall_nr_connect = 42;
+ syscall_nr_accept = 43;
+ syscall_nr_sendto = 44;
+ syscall_nr_recvfrom = 45;
+ syscall_nr_sendmsg = 46;
+ syscall_nr_recvmsg = 47;
+
+ syscall_nr_shutdown = 48;
+ syscall_nr_bind = 49;
+ syscall_nr_listen = 50;
+ syscall_nr_getsockname = 51;
+ syscall_nr_getpeername = 52;
+ syscall_nr_socketpair = 53;
+ syscall_nr_setsockopt = 54;
+ syscall_nr_getsockopt = 55;
+
+ syscall_nr_clone = 56;
+ syscall_nr_fork = 57;
+ syscall_nr_vfork = 58;
+ syscall_nr_execve = 59;
+ syscall_nr_exit = 60;
+ syscall_nr_wait4 = 61;
+ syscall_nr_kill = 62;
+ syscall_nr_uname = 63;
+
+ syscall_nr_semget = 64;
+ syscall_nr_semop = 65;
+ syscall_nr_semctl = 66;
+ syscall_nr_shmdt = 67;
+ syscall_nr_msgget = 68;
+ syscall_nr_msgsnd = 69;
+ syscall_nr_msgrcv = 70;
+ syscall_nr_msgctl = 71;
+
+ syscall_nr_fcntl = 72;
+ syscall_nr_flock = 73;
+ syscall_nr_fsync = 74;
+ syscall_nr_fdatasync = 75;
+ syscall_nr_truncate = 76;
+ syscall_nr_ftruncate = 77;
+ syscall_nr_getdents = 78;
+ syscall_nr_getcwd = 79;
+
+ syscall_nr_chdir = 80;
+ syscall_nr_fchdir = 81;
+ syscall_nr_rename = 82;
+ syscall_nr_mkdir = 83;
+ syscall_nr_rmdir = 84;
+ syscall_nr_creat = 85;
+ syscall_nr_link = 86;
+ syscall_nr_unlink = 87;
+
+ syscall_nr_symlink = 88;
+ syscall_nr_readlink = 89;
+ syscall_nr_chmod = 90;
+ syscall_nr_fchmod = 91;
+ syscall_nr_chown = 92;
+ syscall_nr_fchown = 93;
+ syscall_nr_lchown = 94;
+ syscall_nr_umask = 95;
+
+ syscall_nr_gettimeofday = 96;
+ syscall_nr_getrlimit = 97;
+ syscall_nr_getrusage = 98;
+ syscall_nr_sysinfo = 99;
+ syscall_nr_times = 100;
+ syscall_nr_ptrace = 101;
+ syscall_nr_getuid = 102;
+ syscall_nr_syslog = 103;
+
+ syscall_nr_getgid = 104;
+ syscall_nr_setuid = 105;
+ syscall_nr_setgid = 106;
+ syscall_nr_geteuid = 107;
+ syscall_nr_getegid = 108;
+ syscall_nr_setpgid = 109;
+ syscall_nr_getppid = 110;
+ syscall_nr_getpgrp = 111;
+
+ syscall_nr_setsid = 112;
+ syscall_nr_setreuid = 113;
+ syscall_nr_setregid = 114;
+ syscall_nr_getgroups = 115;
+ syscall_nr_setgroups = 116;
+ syscall_nr_setresuid = 117;
+ syscall_nr_getresuid = 118;
+ syscall_nr_setresgid = 119;
+
+ syscall_nr_getresgid = 120;
+ syscall_nr_getpgid = 121;
+ syscall_nr_setfsuid = 122;
+ syscall_nr_setfsgid = 123;
+ syscall_nr_getsid = 124;
+ syscall_nr_capget = 125;
+ syscall_nr_capset = 126;
+
+ syscall_nr_rt_sigpending = 127;
+ syscall_nr_rt_sigtimedwait = 128;
+ syscall_nr_rt_sigqueueinfo = 129;
+ syscall_nr_rt_sigsuspend = 130;
+ syscall_nr_sigaltstack = 131;
+ syscall_nr_utime = 132;
+ syscall_nr_mknod = 133;
+
+ syscall_nr_uselib = 134;
+ syscall_nr_personality = 135;
+
+ syscall_nr_ustat = 136;
+ syscall_nr_statfs = 137;
+ syscall_nr_fstatfs = 138;
+ syscall_nr_sysfs = 139;
+
+ syscall_nr_getpriority = 140;
+ syscall_nr_setpriority = 141;
+ syscall_nr_sched_setparam = 142;
+ syscall_nr_sched_getparam = 143;
+ syscall_nr_sched_setscheduler = 144;
+ syscall_nr_sched_getscheduler = 145;
+ syscall_nr_sched_get_priority_max = 146;
+ syscall_nr_sched_get_priority_min = 147;
+ syscall_nr_sched_rr_get_interval = 148;
+
+ syscall_nr_mlock = 149;
+ syscall_nr_munlock = 150;
+ syscall_nr_mlockall = 151;
+ syscall_nr_munlockall = 152;
+
+ syscall_nr_vhangup = 153;
+
+ syscall_nr_modify_ldt = 154;
+
+ syscall_nr_pivot_root = 155;
+
+ syscall_nr__sysctl = 156;
+
+ syscall_nr_prctl = 157;
+ syscall_nr_arch_prctl = 158;
+
+ syscall_nr_adjtimex = 159;
+
+ syscall_nr_setrlimit = 160;
+
+ syscall_nr_chroot = 161;
+
+ syscall_nr_sync = 162;
+
+ syscall_nr_acct = 163;
+
+ syscall_nr_settimeofday = 164;
+
+ syscall_nr_mount = 165;
+ syscall_nr_umount2 = 166;
+
+ syscall_nr_swapon = 167;
+ syscall_nr_swapoff = 168;
+
+ syscall_nr_reboot = 169;
+
+ syscall_nr_sethostname = 170;
+ syscall_nr_setdomainname = 171;
+
+ syscall_nr_iopl = 172;
+ syscall_nr_ioperm = 173;
+
+ syscall_nr_create_module = 174;
+ syscall_nr_init_module = 175;
+ syscall_nr_delete_module = 176;
+ syscall_nr_get_kernel_syms = 177;
+ syscall_nr_query_module = 178;
+
+ syscall_nr_quotactl = 179;
+
+ syscall_nr_nfsservctl = 180;
+
+ syscall_nr_getpmsg = 181;
+ syscall_nr_putpmsg = 182;
+
+ syscall_nr_afs_syscall = 183;
+
+ syscall_nr_tuxcall = 184;
+
+ syscall_nr_security = 185;
+
+ syscall_nr_gettid = 186;
+
+ syscall_nr_readahead = 187;
+ syscall_nr_setxattr = 188;
+ syscall_nr_lsetxattr = 189;
+ syscall_nr_fsetxattr = 190;
+ syscall_nr_getxattr = 191;
+ syscall_nr_lgetxattr = 192;
+ syscall_nr_fgetxattr = 193;
+ syscall_nr_listxattr = 194;
+ syscall_nr_llistxattr = 195;
+ syscall_nr_flistxattr = 196;
+ syscall_nr_removexattr = 197;
+ syscall_nr_lremovexattr = 198;
+ syscall_nr_fremovexattr = 199;
+ syscall_nr_tkill = 200;
+ syscall_nr_time = 201;
+ syscall_nr_futex = 202;
+ syscall_nr_sched_setaffinity = 203;
+ syscall_nr_sched_getaffinity = 204;
+ syscall_nr_set_thread_area = 205;
+ syscall_nr_io_setup = 206;
+ syscall_nr_io_destroy = 207;
+ syscall_nr_io_getevents = 208;
+ syscall_nr_io_submit = 209;
+ syscall_nr_io_cancel = 210;
+ syscall_nr_get_thread_area = 211;
+ syscall_nr_lookup_dcookie = 212;
+ syscall_nr_epoll_create = 213;
+ syscall_nr_epoll_ctl_old = 214;
+ syscall_nr_epoll_wait_old = 215;
+ syscall_nr_remap_file_pages = 216;
+ syscall_nr_getdents64 = 217;
+ syscall_nr_set_tid_address = 218;
+ syscall_nr_restart_syscall = 219;
+ syscall_nr_semtimedop = 220;
+ syscall_nr_fadvise64 = 221;
+ syscall_nr_timer_create = 222;
+ syscall_nr_timer_settime = 223;
+ syscall_nr_timer_gettime = 224;
+ syscall_nr_timer_getoverrun = 225;
+ syscall_nr_timer_delete = 226;
+ syscall_nr_clock_settime = 227;
+ syscall_nr_clock_gettime = 228;
+ syscall_nr_clock_getres = 229;
+ syscall_nr_clock_nanosleep = 230;
+ syscall_nr_exit_group = 231;
+ syscall_nr_epoll_wait = 232;
+ syscall_nr_epoll_ctl = 233;
+ syscall_nr_tgkill = 234;
+ syscall_nr_utimes = 235;
+ syscall_nr_vserver = 236;
+
+{ 237,238,239 reserved for NUMA API }
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/m68k/lowmath.inc b/rtl/m68k/lowmath.inc
new file mode 100644
index 0000000000..f5a0c3fd92
--- /dev/null
+++ b/rtl/m68k/lowmath.inc
@@ -0,0 +1,920 @@
+{
+ $Id: lowmath.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl-Eric Codere,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{*************************************************************************}
+{ lowmath.inc }
+{ Ported to FPC-Pascal by Carl Eric Codere }
+{ Terms of use: This source code is freeware. }
+{*************************************************************************}
+{ This inc. implements low-level mathemtical routines for the motorola }
+{ 68000 family of processors. }
+{*************************************************************************}
+{ single floating point routines taken from GCC 2.5.2 Atari compiler }
+{ library source. }
+{ Original credits: }
+{ written by Kai-Uwe Bloem (I5110401@dbstu1.bitnet). }
+{ Based on a 80x86 floating point packet from comp.os.minix, }
+{ written by P.Housel }
+{ Patched by Olaf Flebbe (flebbe@tat.physik.uni-tuebingen.de) }
+{ Revision by michal 05-93 (ntomczak@vm.ucs.ualberta.ca) }
+{*************************************************************************}
+{--------------------------------------------------------------------}
+{ LEFT TO DO: }
+{ o Add support for FPU if present. }
+{ o Verify if single comparison works in all cases. }
+{ o Add support for NANs in SINGLE_CMP }
+{ o Add comp (80-bit) multiplication,addition,substract,division, }
+{ shift. }
+{ o Add stack checking for the routines which use the stack. }
+{ (This will probably have to be done in the code generator). }
+{--------------------------------------------------------------------}
+
+
+
+Procedure Single_Norm;[alias : 'FPC_SINGLE_NORM'];Assembler;
+{--------------------------------------------}
+{ Low-level routine to normalize single e }
+{ IEEE floating point values. Never called }
+{ directly. }
+{ On Exit: }
+{ d0 = result. }
+{ Registers destroyed: d0,d1 }
+{--------------------------------------------}
+Asm
+ tst.l d4 { rounding and u.mant == 0 ? }
+ bne @normlab1
+ tst.b d1
+ beq @retzok
+@normlab1:
+ clr.b d2 { "sticky byte" }
+@normlab3:
+ move.l #$ff000000,d5
+@normlab4:
+ tst.w d0 { divide (shift) }
+ ble @normlab2 { denormalized number }
+ move.l d4,d3
+ and.l d5,d3 { or until no bits above 23 }
+ beq @normlab5
+@normlab2:
+ addq.w #1,d0 { increment exponent }
+ lsr.l #1,d4
+ or.b d1,d2 { set "sticky" }
+ roxr.b #1,d1 { shift into rounding bits }
+ bra @normlab4
+@normlab5:
+ and.b #1,d2
+ or.b d2,d1 { make least sig bit "sticky" }
+ asr.l #1,d5 { #0xff800000 -> d5 }
+@normlab6:
+ move.l d4,d3 { multiply (shift) until }
+ and.l d5,d3 { one in "implied" position }
+ bne @normlab7
+ subq.w #1,d0 { decrement exponent }
+ beq @normlab7 { too small. store as denormalized number }
+ add.b d1,d1 { some doubt about this one * }
+ addx.l d4,d4
+ bra @normlab6
+@normlab7:
+ tst.b d1 { check rounding bits }
+ bge @normlab9 { round down - no action neccessary }
+ neg.b d1
+ bvc @normlab8 { round up }
+ move.w d4,d1 { tie case - round to even }
+ { dont need rounding bits any more }
+ and.w #1,d1 { check if even }
+ beq @normlab9 { mantissa is even - no action necessary }
+ { fall through }
+@normlab8:
+ clr.w d1 { zero rounding bits }
+ add.l #1,d4
+ tst.w d0
+ bne @normlab10 { renormalize if number was denormalized }
+ add.w #1,d0 { correct exponent for denormalized numbers }
+ bra @normlab3
+@normlab10:
+ move.l d4,d3 { check for rounding overflow }
+ asl.l #1,d5 { #0xff000000 -> d5 }
+ and.l d5,d3
+ bne @normlab4 { go back and renormalize }
+@normlab9:
+ tst.l d4 { check if normalization caused an underflow }
+ beq @retz
+ tst.w d0 { check for exponent overflow or underflow }
+ blt @retz
+ cmp.w #255,d0
+ bge @oflow
+
+ lsl.w #8,d0 { re-position exponent - one bit too high }
+ lsl.w #1,d2 { get X bit }
+ roxr.w #1,d0 { shift it into sign position }
+ swap d0 { map to upper word }
+ clr.w d0
+ and.l #$7fffff,d4 { top mantissa bits }
+ or.l d4,d0 { insert exponent and sign }
+ movem.l (sp)+,d2-d5
+ rts
+
+@retz:
+ { handling underflow should be done here... }
+ { by default simply return 0 as retzok... }
+@retzok:
+ moveq.l #0,d0
+ lsl.w #1,d2
+ roxr.l #1,d0 { sign of 0 is the same as of d2 }
+ movem.l (sp)+,d2-d5
+ rts
+
+@oflow:
+ move.l #$7f800000,d0 { +infinity as proposed by IEEE }
+
+ tst.w d2 { transfer sign }
+ bge @ofl_clear { (mjr++) }
+ bset #31,d0 { }
+@ofl_clear:
+ or.b #2,ccr { set overflow flag. }
+ movem.l (sp)+,d2-d5
+ rts
+end;
+
+
+Procedure Single_AddSub; Assembler;
+{--------------------------------------------}
+{ Low-level routine to add/subtract single }
+{ IEEE floating point values. Never called }
+{ directly. }
+{ On Exit: }
+{ d0 = result -- from normalize routine }
+{ Flags : V set if overflow. }
+{ on underflow d0 = 0 }
+{ Registers destroyed: d0,d1 }
+{--------------------------------------------}
+Asm
+{--------------------------------------------}
+{ On Entry: }
+{ d1-d0 = single values to subtract. }
+{--------------------------------------------}
+XDEF SINGLE_SUB
+ eor.l #$80000000,d0 { reverse sign of v }
+{--------------------------------------------}
+{ On Entry: }
+{ d0, d1 = single values to add. }
+{--------------------------------------------}
+XDEF SINGLE_ADD
+ movem.l d2-d5,-(sp) { save registers }
+ move.l d0,d4 { d4 = d0 = v }
+ move.l d1,d5 { d5 = d1 = u }
+
+ move.l #$7fffff,d3
+ move.l d5,d0 { d0 = u.exp }
+ move.l d5,d2 { d2.h = u.sign }
+ swap d0
+ move.w d0,d2 { d2 = u.sign }
+ and.l d3,d5 { remove exponent from u.mantissa }
+
+ move.l d4,d1 { d1 = v.exp }
+ and.l d3,d4 { remove exponent from v.mantissa }
+ swap d1
+ eor.w d1,d2 { d2 = u.sign ^ v.sign (in bit 15)}
+ clr.b d2 { we will use the lowest byte as a flag }
+ moveq.l #15,d3
+ bclr d3,d1 { kill sign bit u.exp }
+ bclr d3,d0 { kill sign bit u.exp }
+ btst d3,d2 { same sign for u and v? }
+ beq @slabel1
+ cmp.l d0,d1 { different signs - maybe x - x ? }
+ seq d2 { set 'cancellation' flag }
+@slabel1:
+ lsr.w #7,d0 { keep here exponents only }
+ lsr.w #7,d1
+{--------------------------------------------------------------------}
+{ Now perform testing of NaN and infinities }
+{--------------------------------------------------------------------}
+ moveq.l #-1,d3
+ cmp.b d3,d0
+ beq @alabel1
+ cmp.b d3,d1
+ bne @nospec
+ bra @alabel2
+{--------------------------------------------------------------------}
+{ u is special. }
+{--------------------------------------------------------------------}
+@alabel1:
+ tst.b d2
+ bne @retnan { cancellation of specials -> NaN }
+ tst.l d5
+ bne @retnan { arith with Nan gives always NaN }
+
+ addq.w #4,a0 { here is an infinity }
+ cmp.b d3,d1
+ bne @alabel3 { skip check for NaN if v not special }
+{--------------------------------------------------------------------}
+{ v is special. }
+{--------------------------------------------------------------------}
+@alabel2:
+ tst.l d4
+ bne @retnan
+@alabel3:
+ move.l (a0),d0
+ bra @return
+{--------------------------------------------------------------------}
+{ Return a quiet nan }
+{--------------------------------------------------------------------}
+@retnan:
+ moveq.l #-1,d0
+ lsr.l #1,d0 { 0x7fffffff -> d0 }
+ bra @return
+{ Ok, no inifinty or NaN involved.. }
+@nospec:
+ tst.b d2
+ beq @alabel4
+ moveq.l #0,d0 { x - x hence we always return +0 }
+@return:
+ movem.l (sp)+,d2-d5
+ rts
+
+@alabel4:
+ moveq.l #23,d3
+ bset d3,d5 { restore implied leading "1" }
+ tst.w d0 { check for zero exponent - no leading "1" }
+ bne @alabel5
+ bclr d3,d5 { remove it }
+ addq.w #1,d0 { "normalize" exponent }
+@alabel5:
+ bset d3,d4 { restore implied leading "1" }
+ tst.w d1 { check for zero exponent - no leading "1" }
+ bne @alabel6
+ bclr d3,d4 { remove it }
+ addq.w #1,d1 { "normalize" exponent }
+@alabel6:
+ moveq.l #0,d3 { (put initial zero rounding bits in d3) }
+ neg.w d1 { d1 = u.exp - v.exp }
+ add.w d0,d1
+ beq @alabel8 { exponents are equal - no shifting neccessary }
+ bgt @alabel7 { not equal but no exchange neccessary }
+ exg d4,d5 { exchange u and v }
+ sub.w d1,d0 { d0 = u.exp - (u.exp - v.exp) = v.exp }
+ neg.w d1
+ tst.w d2 { d2.h = u.sign ^ (u.sign ^ v.sign) = v.sign }
+ bpl @alabel7
+ bchg #31,d2
+@alabel7:
+ cmp.w #26,d1 { is u so much bigger that v is not }
+ bge @alabel9 { significant ? }
+{--------------------------------------------------------------------}
+{ shift mantissa left two digits, to allow cancellation of }
+{ most significant digit, while gaining an additional digit for }
+{ rounding. }
+{--------------------------------------------------------------------}
+ moveq.l #1,d3
+@alabel10:
+ add.l d5,d5
+ subq.w #1,d0 { decrement exponent }
+ subq.w #1,d1 { done shifting altogether ? }
+ dbeq d3,@alabel10 { loop if still can shift u.mant more }
+ moveq.l #0,d3
+
+ cmp.w #16,d1 { see if fast rotate possible }
+ blt @alabel11
+ or.w d4,d3 { set rounding bits }
+ clr.w d4
+ swap d4
+ subq.w #8,d1
+ subq.w #8,d1
+ bra @alabel11
+
+@alabel12:
+ move.b d4,d2
+ and.b #1,d2
+ or.b d2,d3
+ lsr.l #1,d4 { shift v.mant right the rest of the way }
+@alabel11:
+ dbra d1,@alabel12 { loop }
+
+@alabel8:
+ tst.w d2 { are the signs equal ? }
+ bpl @alabel13 { yes, no negate necessary }
+
+
+ tst.w d3 { negate rounding bits and v.mant }
+ beq @alabel14
+ addq.l #1,d4
+@alabel14:
+ neg.l d4
+
+@alabel13:
+ add.l d4,d5 { u.mant = u.mant + v.mant }
+ bcs @alabel9 { needn not negate }
+ tst.w d2 { opposite signs ? }
+ bpl @alabel9 { do not need to negate result }
+
+ neg.l d5
+ not.l d2 { switch sign }
+@alabel9:
+ move.l d5,d4 { move result for normalization }
+ clr.l d1
+ tst.l d3
+ beq @alabel15
+ moveq.l #-1,d1
+@alabel15:
+ swap d2 { put sign into d2 (exponent is in d0) }
+ jmp FPC_SINGLE_NORM { leave registers on stack for norm_sf }
+end;
+
+
+Procedure Single_Mul;Assembler;
+{--------------------------------------------}
+{ Low-level routine to multiply two single }
+{ IEEE floating point values. Never called }
+{ directly. }
+{ Om Entry: }
+{ d0,d1 = values to multiply }
+{ On Exit: }
+{ d0 = result. }
+{ Registers destroyed: d0,d1 }
+{ stack space used (and restored): 8 bytes. }
+{--------------------------------------------}
+Asm
+XDEF SINGLE_MUL
+ movem.l d2-d5,-(sp)
+ move.l d0,d4 { d4 = v }
+ move.l d1,d5 { d5 = u }
+
+ move.l #$7fffff,d3
+ move.l d5,d0 { d0 = u.exp }
+ and.l d3,d5 { remove exponent from u.mantissa }
+ swap d0
+ move.w d0,d2 { d2 = u.sign }
+
+ move.l d4,d1 { d1 = v.exp }
+ and.l d3,d4 { remove exponent from v.mantissa }
+ swap d1
+ eor.w d1,d2 { d2 = u.sign ^ v.sign (in bit 15)}
+
+ moveq.l #15,d3
+ bclr d3,d0 { kill sign bit }
+ bclr d3,d1 { kill sign bit }
+ tst.l d0 { test if one of factors is 0 }
+ beq @mlabel1
+ tst.l d1
+@mlabel1:
+ seq d2 { 'one of factors is 0' flag in the lowest byte }
+ lsr.w #7,d0 { keep here exponents only }
+ lsr.w #7,d1
+
+{--------------------------------------------------------------------}
+{ Now perform testing of NaN and infinities }
+{--------------------------------------------------------------------}
+ moveq.l #-1,d3
+ cmp.b d3,d0
+ beq @mlabel2
+ cmp.b d3,d1
+ bne @mnospec
+ bra @mlabel3
+{--------------------------------------------------------------------}
+{ first operand is special }
+{--------------------------------------------------------------------}
+@mlabel2:
+ tst.l d5 { is it NaN? }
+ bne @mretnan
+@mlabel3:
+ tst.b d2 { 0 times special or special times 0 ? }
+ bne @mretnan { yes -> NaN }
+ cmp.b d3,d1 { is the other special ? }
+ beq @mlabel4 { maybe it is NaN }
+{--------------------------------------------------------------------}
+{ Return infiny with correct sign }
+{--------------------------------------------------------------------}
+@mretinf:
+ move.l #$ff000000,d0 { we will return #0xff800000 or #0x7f800000 }
+ lsl.w #1,d2
+ roxr.l #1,d0 { shift in high bit as given by d2 }
+@mreturn:
+ movem.l (sp)+,d2-d5
+ rts
+
+{--------------------------------------------------------------------}
+{ v is special. }
+{--------------------------------------------------------------------}
+@mlabel4:
+ tst.l d4 { is this NaN? }
+ beq @mretinf { we know that the other is not zero }
+@mretnan:
+ moveq.l #-1,d0
+ lsr.l #1,d0 { 0x7fffffff -> d0 }
+ bra @mreturn
+{--------------------------------------------------------------------}
+{ End of NaN and Inf }
+{--------------------------------------------------------------------}
+@mnospec:
+ tst.b d2 { not needed - but we can waste two instr. }
+ bne @mretzz { return signed 0 if one of factors is 0 }
+ moveq.l #23,d3
+ bset d3,d5 { restore implied leading "1" }
+ subq.w #8,sp { multiplication accumulator }
+ tst.w d0 { check for zero exponent - no leading "1" }
+ bne @mlabel5
+ bclr d3,d5 { remove it }
+ addq.w #1,d0 { "normalize" exponent }
+@mlabel5:
+ tst.l d5
+ beq @mretz { multiplying zero }
+
+ moveq.l #23,d3
+ bset d3,d4 { restore implied leading "1" }
+ tst.w d1 { check for zero exponent - no leading "1" }
+ bne @mlabel6
+ bclr d3,d4 { remove it }
+ addq.w #1,d1 { "normalize" exponent }
+@mlabel6:
+ tst.l d4
+ beq @mretz { multiply by zero }
+
+ add.w d1,d0 { add exponents, }
+ sub.w #BIAS4+16-8,d0 { remove excess bias, acnt for repositioning }
+
+ clr.l (sp) { initialize 64-bit product to zero }
+ clr.l 4(sp)
+{--------------------------------------------------------------------}
+{ see Knuth, Seminumerical Algorithms, section 4.3. algorithm M }
+{--------------------------------------------------------------------}
+ move.w d4,d3
+ mulu.w d5,d3 { mulitply with bigit from multiplier }
+ move.l d3,4(sp) { store into result }
+
+ move.l d4,d3
+ swap d3
+ mulu.w d5,d3
+ add.l d3,2(sp) { add to result }
+
+ swap d5 { [TOP 8 BITS SHOULD BE ZERO !] }
+
+ move.w d4,d3
+ mulu.w d5,d3 { mulitply with bigit from multiplier }
+ add.l d3,2(sp) { store into result (no carry can occur here) }
+
+ move.l d4,d3
+ swap d3
+ mulu.w d5,d3
+ add.l d3,(sp) { add to result }
+ { [TOP 16 BITS SHOULD BE ZERO !] }
+ movem.l 2(sp),d4-d5 { get the 48 valid mantissa bits }
+ clr.w d5 { (pad to 64) }
+
+ move.l #$0000ffff,d3
+@mlabel7:
+ cmp.l d3,d4 { multiply (shift) until }
+ bhi @mlabel8 { 1 in upper 16 result bits }
+ cmp.w #9,d0 { give up for denormalized numbers }
+ ble @mlabel8
+ swap d4 { (we''re getting here only when multiplying }
+ swap d5 { with a denormalized number; there''s an }
+ move.w d5,d4 { eventual loss of 4 bits in the rounding }
+ clr.w d5 { byte -- what a pity 8-) }
+ subq.w #8,d0 { decrement exponent }
+ subq.w #8,d0
+ bra @mlabel7
+@mlabel8:
+ move.l d5,d1 { get rounding bits }
+ rol.l #8,d1
+ move.l d1,d3 { see if sticky bit should be set }
+ and.l #$ffffff00,d3
+ beq @mlabel9
+ or.b #1,d1 { set "sticky bit" if any low-order set }
+@mlabel9:
+ addq.w #8,sp { remove accumulator from stack }
+ jmp FPC_SINGLE_NORM{ (result in d4) }
+
+@mretz:
+ addq.w #8,sp { release accumulator space }
+@mretzz:
+ moveq.l #0,d0 { save zero as result }
+ lsl.w #1,d2 { and set it sign as for d2 }
+ roxr.l #1,d0
+ movem.l (sp)+,d2-d5
+ rts { no normalizing neccessary }
+end;
+
+
+Procedure Single_Div;Assembler;
+{--------------------------------------------}
+{ Low-level routine to dividr two single }
+{ IEEE floating point values. Never called }
+{ directly. }
+{ Om Entry: }
+{ d1/d0 = u/v = operation to perform. }
+{ On Exit: }
+{ d0 = result. }
+{ Registers destroyed: d0,d1 }
+{ stack space used (and restored): 8 bytes. }
+{--------------------------------------------}
+ASM
+XDEF SINGLE_DIV
+ { u = d1 = dividend }
+ { v = d0 = divisor }
+ tst.l d0 { check if divisor is 0 }
+ bne @dno_exception
+
+ move.l #$7f800000,d0
+ btst #31,d1 { transfer sign of dividend }
+ beq @dclear
+ bset #31,d0
+@dclear:
+ rts
+
+@dno_exception:
+ move.l d1,d4 { d4 = u, d5 = v }
+ move.l d0,d5
+ movem.l d2-d5,-(sp) { save registers }
+
+ move.l #$7fffff,d3
+ move.l d4,d0 { d0 = u.exp }
+ and.l d3,d4 { remove exponent from u.mantissa }
+ swap d0
+ move.w d0,d2 { d2 = u.sign }
+
+ move.l d5,d1 { d1 = v.exp }
+ and.l d3,d5 { remove exponent from v.mantissa }
+ swap d1
+ eor.w d1,d2 { d2 = u.sign ^ v.sign (in bit 15) }
+
+ moveq.l #15,d3
+ bclr d3,d0 { kill sign bit }
+ bclr d3,d1 { kill sign bit }
+ lsr.w #7,d0
+ lsr.w #7,d1
+
+ moveq.l #-1,d3
+ cmp.b d3,d0 { comparison with #0xff }
+ beq @dlabel1 { u == NaN ;; u== Inf }
+ cmp.b d3,d1
+ beq @dlabel2 { v == NaN ;; v == Inf }
+ tst.b d0
+ bne @dlabel4 { u not zero nor denorm }
+ tst.l d4
+ beq @dlabel3 { 0/ ? }
+
+@dlabel4:
+ tst.w d1
+ bne @dnospec
+
+ tst.l d5
+ bne @dnospec
+ bra @dretinf { x/0 -> +/- Inf }
+
+@dlabel1:
+ tst.l d4 { u == NaN ? }
+ bne @dretnan { NaN/ x }
+ cmp.b d3,d1
+ beq @dretnan { Inf/Inf or Inf/NaN }
+{ bra dretinf ; Inf/x ; x != Inf && x != NaN }
+{--------------------------------------------------------------------}
+{ Return infinity with correct sign. }
+{--------------------------------------------------------------------}
+@dretinf:
+ move.l #$ff000000,d0
+ lsl.w #1,d2
+ roxr.l #1,d0 { shift in high bit as given by d2 }
+@dreturn:
+ movem.l (sp)+,d2-d5
+ rts
+
+@dlabel2:
+ tst.l d5
+ bne @dretnan { x/NaN }
+{ bra dretzero ; x/Inf -> +/- 0 }
+{--------------------------------------------------------------------}
+{ Return correct signed zero. }
+{--------------------------------------------------------------------}
+@dretzero:
+ moveq.l #0,d0 { zero destination }
+ lsl.w #1,d2 { set X bit accordingly }
+ roxr.l #1,d0
+ bra @dreturn
+
+@dlabel3:
+ tst.w d1
+ bne @dretzero { 0/x ->+/- 0 }
+ tst.l d4
+ bne @dretzero { 0/x }
+{ bra dretnan 0/0 }
+{--------------------------------------------------------------------}
+{ Return NotANumber }
+{--------------------------------------------------------------------}
+@dretnan:
+ move.l d3,d0 { d3 contains 0xffffffff }
+ lsr.l #1,d0
+ bra @dreturn
+{--------------------------------------------------------------------}
+{ End of Special Handling }
+{--------------------------------------------------------------------}
+@dnospec:
+ moveq.l #23,d3
+ bset d3,d4 { restore implied leading "1" }
+ tst.w d0 { check for zero exponent - no leading "1" }
+ bne @dlabel5
+ bclr d3,d4 { remove it }
+ add.w #1,d0 { "normalize" exponent }
+@dlabel5:
+ tst.l d4
+ beq @dretzero { dividing zero }
+
+ bset d3,d5 { restore implied leading "1" }
+ tst.w d1 { check for zero exponent - no leading "1"}
+ bne @dlabel6
+ bclr d3,d5 { remove it }
+ add.w #1,d1 { "normalize" exponent }
+@dlabel6:
+
+ sub.w d1,d0 { subtract exponents, }
+ add.w #BIAS4-8+1,d0 { add bias back in, account for shift }
+ add.w #34,d0 { add loop offset, +2 for extra rounding bits}
+ { for denormalized numbers (2 implied by dbra)}
+ move.w #27,d1 { bit number for "implied" pos (+4 for rounding)}
+ moveq.l #-1,d3 { zero quotient (for speed a one''s complement) }
+ sub.l d5,d4 { initial subtraction, u = u - v }
+@dlabel7:
+ btst d1,d3 { divide until 1 in implied position }
+ beq @dlabel9
+
+ add.l d4,d4
+ bcs @dlabel8 { if carry is set, add, else subtract }
+
+ addx.l d3,d3 { shift quotient and set bit zero }
+ sub.l d5,d4 { subtract, u = u - v }
+ dbra d0,@dlabel7 { give up if result is denormalized }
+ bra @dlabel9
+@dlabel8:
+ addx.l d3,d3 { shift quotient and clear bit zero }
+ add.l d5,d4 { add (restore), u = u + v }
+ dbra d0,@dlabel7 { give up if result is denormalized }
+@dlabel9:
+ subq.w #2,d0 { remove rounding offset for denormalized nums }
+ not.l d3 { invert quotient to get it right }
+
+ clr.l d1 { zero rounding bits }
+ tst.l d4 { check for exact result }
+ beq @dlabel10
+ moveq.l #-1,d1 { prevent tie case }
+@dlabel10:
+ move.l d3,d4 { save quotient mantissa }
+ jmp FPC_SINGLE_NORM{ (registers on stack removed by norm_sf) }
+end;
+
+
+Procedure Single_Cmp; Assembler;
+{--------------------------------------------}
+{ Low-level routine to compare single two }
+{ single point values.. }
+{ Never called directly. }
+{ On Entry: }
+{ d1 and d0 Values to compare }
+{ d0 = first operand }
+{ On Exit: }
+{ Flags according to result }
+{ Registers destroyed: d0,d1 }
+{--------------------------------------------}
+Asm
+XDEF SINGLE_CMP
+ tst.l d0 { check sign bit }
+ bpl @cmplab1
+ neg.l d0 { negate }
+ bchg #31,d0 { toggle sign bit }
+@cmplab1:
+ tst.l d1 { check sign bit }
+ bpl @cmplab2
+ neg.l d1 { negate }
+ bchg #31,d1 { toggle sign bit }
+@cmplab2:
+ cmp.l d0,d1 { compare... }
+ rts
+end;
+
+
+
+Procedure LongMul;Assembler;
+{--------------------------------------------}
+{ Low-level routine to multiply two signed }
+{ 32-bit values. Never called directly. }
+{ On entry: d1,d0 = 32-bit signed values to }
+{ multiply. }
+{ On Exit: }
+{ d0 = result. }
+{ Registers destroyed: d0,d1 }
+{ stack space used and restored: 10 bytes }
+{--------------------------------------------}
+Asm
+XDEF LONGMUL
+ cmp.b #2,Test68000 { Are we on a 68020+ cpu }
+ blt @Lmulcontinue
+ muls.l d1,d0 { yes, then directly mul... }
+ rts { return... result in d0 }
+@Lmulcontinue:
+ move.l d2,a0 { save registers }
+ move.l d3,a1
+
+ move.l d0,-(sp)
+ move.l d1,-(sp)
+
+ movem.w (sp)+,d0-d3 { u = d0-d1, v = d2-d3 }
+
+ move.w d0,-(sp) { sign flag }
+ bpl @LMul1 { is u negative ? }
+ neg.w d1 { yes, force it positive }
+ negx.w d0
+@LMul1:
+ tst.w d2 { is v negative ? }
+ bpl @LMul2
+ neg.w d3 { yes, force it positive ... }
+ negx.w d2
+ not.w (sp) { ... and modify flag word }
+@LMul2:
+ ext.l d0 { u.h <> 0 ? }
+ beq @LMul3
+ mulu.w d3,d0 { r = v.l * u.h }
+@LMul3:
+ tst.w d2 { v.h <> 0 ? }
+ beq @LMul4
+ mulu.w d1,d2 { r += v.h * u.l }
+ add.w d2,d0
+@LMul4:
+ swap d0
+ clr.w d0
+ mulu.w d3,d1 { r += v.l * u.l }
+ add.l d1,d0
+ move.l a1,d3
+ move.l a0,d2
+ tst.w (sp)+ { should the result be negated ? }
+ bpl @LMul5 { no, just return }
+ neg.l d0 { else r = -r }
+@LMul5:
+ rts
+end;
+
+
+
+Procedure Long2Single;Assembler;
+{--------------------------------------------}
+{ Low-level routine to convert a longint }
+{ to a single floating point value. }
+{ On entry: d0 = longint value to convert. }
+{ On Exit: }
+{ d0 = single IEEE value }
+{ Registers destroyed: d0,d1 }
+{ stack space used and restored: 8 bytes }
+{--------------------------------------------}
+Asm
+XDEF LONG2SINGLE
+ movem.l d2-d5,-(sp) { save registers to make norm_sf happy}
+
+ move.l d0,d4 { prepare result mantissa }
+ move.w #BIAS4+32-8,d0 { radix point after 32 bits }
+ move.l d4,d2 { set sign flag }
+ bge @l2slabel1 { nonnegative }
+ neg.l d4 { take absolute value }
+@l2slabel1:
+ swap d2 { follow SINGLE_NORM conventions }
+ clr.w d1 { set rounding = 0 }
+ jmp FPC_SINGLE_NORM
+end;
+
+
+Procedure LongDiv; [alias : 'FPC_LONGDIV'];Assembler;
+{--------------------------------------------}
+{ Low-level routine to do signed long }
+{ division. }
+{ On entry: d0/d1 operation to perform }
+{ On Exit: }
+{ d0 = quotient }
+{ d1 = remainder }
+{ Registers destroyed: d0,d1,d6 }
+{ stack space used and restored: 10 bytes }
+{--------------------------------------------}
+asm
+XDEF LONGDIV
+ cmp.b #2,Test68000 { can we use divs ? }
+ blt @continue
+ tst.l d1
+ beq @zerodiv2
+ move.l d1,d6
+ clr.l d1 { clr }
+ tst.l d0 { check sign of d0 }
+ bpl @posdiv
+ move.l #$ffffffff,d1{ sign extend into d1 }
+@posdiv:
+ divsl.l d6,d1:d0
+ rts
+@continue:
+
+ move.l d2,a0 { save registers }
+ move.l d3,a1
+ move.l d4,-(sp) { divisor = d1 = d4 }
+ move.l d5,-(sp) { divident = d0 = d5 }
+
+ move.l d1,d4 { save divisor }
+ move.l d0,d5 { save dividend }
+
+ clr.w -(sp) { sign flag }
+
+ clr.l d0 { prepare result }
+ move.l d4,d2 { get divisor }
+ beq @zerodiv { divisor = 0 ? }
+ bpl @LDiv1 { divisor < 0 ? }
+ neg.l d2 { negate it }
+ not.w (sp) { remember sign }
+@LDiv1:
+ move.l d5,d1 { get dividend }
+ bpl @LDiv2 { dividend < 0 ? }
+ neg.l d1 { negate it }
+ not.w (sp) { remember sign }
+@LDiv2:
+{;== case 1) divident < divisor}
+ cmp.l d2,d1 { is divident smaller then divisor ? }
+ bcs @LDiv7 { yes, return immediately }
+{;== case 2) divisor has <= 16 significant bits}
+ move.l d4,d6 { put divisor in d6 register }
+ lsr.l #8,d6 { rotate into low word }
+ lsr.l #8,d6
+ tst.l d6
+ bne @LDiv3 { divisor has only 16 bits }
+ move.w d1,d3 { save dividend }
+ clr.w d1 { divide dvd.h by dvs }
+ swap d1
+ beq @LDiv4 { (no division necessary if dividend zero)}
+ divu d2,d1
+@LDiv4:
+ move.w d1,d0 { save quotient.h }
+ swap d0
+ move.w d3,d1 { (d0.h = remainder of prev divu) }
+ divu d2,d1 { divide dvd.l by dvs }
+ move.w d1,d0 { save quotient.l }
+ clr.w d1 { get remainder }
+ swap d1
+ bra @LDiv7 { and return }
+{;== case 3) divisor > 16 bits (corollary is dividend > 16 bits, see case 1)}
+@LDiv3:
+ moveq.l #31,d3 { loop count }
+@LDiv5:
+ add.l d1,d1 { shift divident ... }
+ addx.l d0,d0 { ... into d0 }
+ cmp.l d2,d0 { compare with divisor }
+ bcs @LDiv6
+ sub.l d2,d0 { big enough, subtract }
+ addq.w #1,d1 { and note bit into result }
+@LDiv6:
+ dbra d3,@LDiv5
+ exg d0,d1 { put quotient and remainder in their registers}
+@LDiv7:
+ tst.l d5 { must the remainder be corrected ? }
+ bpl @LDiv8
+ neg.l d1 { yes, apply sign }
+{ the following line would be correct if modulus is defined as in algebra}
+{; add.l sp@(6),d1 ; algebraic correction: modulus can only be >= 0}
+@LDiv8:
+ tst.w (sp)+ { result should be negative ? }
+ bpl @LDiv9
+ neg.l d0 { yes, negate it }
+@LDiv9:
+ move.l a1,d3
+ move.l a0,d2
+ move.l (sp)+,d5
+ move.l (sp)+,d4
+ rts { en exit : remainder = d1, quotient = d0 }
+@zerodiv:
+ move.l a1,d3 { restore stack... }
+ move.l a0,d2
+ move.w (sp)+,d1 { remove sign word }
+ move.l (sp)+,d5
+ move.l (sp)+,d4
+@zerodiv2:
+ move.l #200,d0
+ jsr FPC_HALT_ERROR { RunError(200) }
+ rts { this should never occur... }
+end;
+
+
+Procedure LongMod;[alias : 'FPC_LONGMOD'];Assembler;
+{ see longdiv for info on calling convention }
+asm
+XDEF LONGMOD
+ jsr FPC_LONGDIV
+ move.l d1,d0 { return the remainder in d0 }
+ rts
+end;
+
+{
+ $Log: lowmath.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/m68k/m68k.inc b/rtl/m68k/m68k.inc
new file mode 100644
index 0000000000..4e98dcde26
--- /dev/null
+++ b/rtl/m68k/m68k.inc
@@ -0,0 +1,329 @@
+{
+ $Id: m68k.inc,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl-Eric Codere,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************
+
+ m68k.inc : Processor dependent implementation of system unit
+ For Motorola 680x0 Processor.
+
+*****************************************************************************}
+
+{****************************************************************************}
+{ Credit where credit is due: }
+{ -Some of the copy routines taken from the Atari dlib source code: }
+{ Dale Schumacher (alias: Dalnefre') dal@syntel.uucp }
+{ 399 Beacon Ave. St. Paul, MN 55104,USA }
+{ -Some of the routines taken from the freeware ATARI Sozobon C compiler }
+{ 1988 by Sozobon, Limited. Author: Johann Ruegg (freeware) }
+{ Thanks to all these people wherever they maybe today! }
+{****************************************************************************}
+
+
+procedure fpc_cpuinit;
+ begin
+ end;
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame : pointer; assembler;
+ asm
+ move.l a6,d0
+ end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp : pointer) : pointer;
+ begin
+ asm
+ move.l FRAMEBP,a0
+ cmp.l #0,a0
+ beq @Lnul_address
+ move.l 4(a0),a0
+ @Lnul_address:
+ move.l a0,@RESULT
+ end ['a0'];
+ end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp : pointer) : pointer;
+ begin
+ asm
+ move.l FRAMEBP,a0
+ cmp.l #0,a0
+ beq @Lnul_frame
+ move.l (a0),a0
+ @Lnul_frame:
+ move.l a0,@RESULT
+ end ['a0'];
+ end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+function Sptr : Longint;
+ begin
+ asm
+ move.l sp,d0
+ add.l #8,d0
+ move.l d0,@RESULT
+ end ['d0'];
+ end;
+
+
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+procedure FillChar(var x;count:longint;value:byte);[public,alias: 'FPC_FILL_OBJECT'];
+ begin
+ asm
+ move.l 8(a6), a0 { destination }
+ move.l 12(a6), d1 { number of bytes to fill }
+ move.b 16(a6),d0 { fill data }
+ cmpi.l #65535, d1 { check, if this is a word move }
+ ble @LMEMSET3 { use fast dbra mode }
+ bra @LMEMSET2
+ @LMEMSET1:
+ move.b d0,(a0)+
+ @LMEMSET2:
+ subq.l #1,d1
+ cmp.l #-1,d1
+ bne @LMEMSET1
+ bra @LMEMSET5 { finished slow mode , exit }
+
+ @LMEMSET4: { fast loop mode section 68010+ }
+ move.b d0,(a0)+
+ @LMEMSET3:
+ dbra d1,@LMEMSET4
+
+ @LMEMSET5:
+ end ['d0','d1','a0'];
+ end;
+
+
+{$ifdef dummy}
+{ procedure strcopy(dstr,sstr : pointer;len : longint);[public,alias: 'STRCOPY'];}
+procedure strcopy; assembler;[public,alias: 'FPC_STRCOPY'];
+{---------------------------------------------------}
+{ Low-level routine to copy a string to another }
+{ string with maximum length. Never call directly! }
+{ On Entry: }
+{ a1.l = string to copy to }
+{ a0.l = source string }
+{ d0.l = maximum length of copy }
+{ registers destroyed: a0,a1,d0,d1 }
+{---------------------------------------------------}
+asm
+{ move.l 12(a6),a0
+ move.l 16(a6),a1
+ move.l 8(a6),d1 }
+ move.l d0,d1
+
+ move.b (a0)+,d0 { Get source length }
+ and.w #$ff,d0
+ cmp.w d1,d0 { This is a signed comparison! }
+ ble @LM4
+ move.b d1,d0 { If longer than maximum size of target, cut
+ source length }
+@LM4:
+ andi.l #$ff,d0 { zero extend d0-byte }
+ move.l d0,d1 { save length to copy }
+ move.b d0,(a1)+ { save new length }
+ { Check if copying length is zero - if so then }
+ { exit without copying anything. }
+ tst.b d1
+ beq @Lend
+ bra @LMSTRCOPY55
+@LMSTRCOPY56: { 68010 Fast loop mode }
+ move.b (a0)+,(a1)+
+@LMSTRCOPY55:
+ dbra d1,@LMSTRCOPY56
+@Lend:
+end;
+
+
+{ Concatenate Strings }
+{ PARAMETERS ARE REVERSED COMPARED TO NORMAL! }
+{ therefore online assembler may not parse the params as normal }
+procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
+ begin
+ asm
+ move.b #255,d0
+ move.l s1,a0 { a0 = destination }
+ move.l s2,a1 { a1 = source }
+ sub.b (a0),d0 { copyl:= 255 -length(s1) }
+ move.b (a1),d6
+ and.w #$ff,d0 { Sign flags are checked! }
+ and.w #$ff,d6
+ cmp.w d6,d0 { if copyl > length(s2) then }
+ ble @Lcontinue
+ move.b (a1),d0 { copyl:=length(s2) }
+@Lcontinue:
+ move.b (a0),d6
+ and.l #$ff,d6
+ lea 1(a0,d6),a0 { s1[length(s1)+1] }
+ add.l #1,a1 { s2[1] }
+ move.b d0,d6
+ { Check if copying length is zero - if so then }
+ { exit without copying anything. }
+ tst.b d6
+ beq @Lend
+ bra @ALoop
+@Loop:
+ move.b (a1)+,(a0)+ { s1[i] := s2[i]; }
+@ALoop:
+ dbra d6,@Loop
+ move.l s1,a0
+ add.b d0,(a0) { change to new string length }
+@Lend:
+ end ['d0','d1','a0','a1','d6'];
+ end;
+
+{ Compares strings }
+{ DO NOT CALL directly. }
+{ a0 = pointer to first string to compare }
+{ a1 = pointer to second string to compare }
+{ ALL FLAGS are set appropriately. }
+{ ZF = strings are equal }
+{ REGISTERS DESTROYED: a0, a1, d0, d1, d6 }
+procedure strcmp; assembler;[public,alias:'FPC_STRCMP'];
+asm
+ move.b (a0)+,d0 { Get length of first string }
+ move.b (a1)+,d6 { Get length of 2nd string }
+
+ move.b d6,d1 { Save length of string for final compare }
+
+ cmp.b d0,d6 { Get shortest string length }
+ ble @LSTRCONCAT1
+ move.b d0,d6 { Set length to shortest string }
+
+ @LSTRCONCAT1:
+ tst.b d6 { Both strings have a length of zero, exit }
+ beq @LSTRCONCAT2
+
+ andi.l #$ff,d6
+
+
+ subq.l #1,d6 { subtract first attempt }
+ { if value is -1 then don't loop and just compare lengths of }
+ { both strings before exiting. }
+ bmi @LSTRCONCAT2
+ or.l d0,d0 { Make sure to set Zerfo flag to 0 }
+ @LSTRCONCAT5:
+ { Workaroung for GAS v.134 bug }
+ { old: cmp.b (a1)+,(a0)+ }
+ cmpm.b (a1)+,(a0)+
+ @LSTRCONCAT4:
+ dbne d6,@LSTRCONCAT5 { Repeat until not equal }
+ bne @LSTRCONCAT3
+ @LSTRCONCAT2:
+ { If length of both string are equal }
+ { Then set zero flag }
+ cmp.b d1,d0 { Compare length - set flag if equal length strings }
+ @LSTRCONCAT3:
+end;
+{$endif dummy}
+
+
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure move(var source;var dest;count : longint);
+{ base pointer+8 = source }
+{ base pointer+12 = destination }
+{ base pointer+16 = number of bytes to move}
+begin
+ asm
+ clr.l d0
+ move.l 16(a6),d0 { number of bytes }
+ @LMOVE0:
+ move.l 12(a6),a1 { destination }
+ move.l 8(a6),a0 { source }
+
+ cmpi.l #65535, d0 { check, if this is a word move }
+ ble @LMEMSET00 { use fast dbra mode 68010+ }
+
+ cmp.l a0,a1 { check copy direction }
+ bls @LMOVE4
+ add.l d0,a0 { move pointers to end }
+ add.l d0,a1
+ bra @LMOVE2
+ @LMOVE1:
+ move.b -(a0),-(a1) { (s < d) copy loop }
+ @LMOVE2:
+ subq.l #1,d0
+ cmpi.l #-1,d0
+ bne @LMOVE1
+ bra @LMOVE5
+ @LMOVE3:
+ move.b (a0)+,(a1)+ { (s >= d) copy loop }
+ @LMOVE4:
+ subq.l #1,d0
+ cmpi.l #-1,d0
+ bne @LMOVE3
+ bra @LMOVE5
+
+ @LMEMSET00: { use fast loop mode 68010+ }
+ cmp.l a0,a1 { check copy direction }
+ bls @LMOVE04
+ add.l d0,a0 { move pointers to end }
+ add.l d0,a1
+ bra @LMOVE02
+ @LMOVE01:
+ move.b -(a0),-(a1) { (s < d) copy loop }
+ @LMOVE02:
+ dbra d0,@LMOVE01
+ bra @LMOVE5
+ @LMOVE03:
+ move.b (a0)+,(a1)+ { (s >= d) copy loop }
+ @LMOVE04:
+ dbra d0,@LMOVE03
+ { end fast loop mode }
+ @LMOVE5:
+ end ['d0','a0','a1'];
+end;
+
+
+{$define FPC_SYSTEM_HAS_FILLWORD}
+procedure fillword(var x;count : longint;value : word);
+ begin
+ asm
+ move.l 8(a6), a0 { destination }
+ move.l 12(a6), d1 { number of bytes to fill }
+ move.w 16(a6),d0 { fill data }
+ bra @LMEMSET21
+ @LMEMSET11:
+ move.w d0,(a0)+
+ @LMEMSET21:
+ subq.l #1,d1
+ cmp.b #-1,d1
+ bne @LMEMSET11
+ end ['d0','d1','a0'];
+ end;
+
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l : longint) : longint;
+ begin
+ asm
+ move.l 8(a6),d0
+ tst.l d0
+ bpl @LMABS1
+ neg.l d0
+ @LMABS1:
+ move.l d0,@RESULT
+ end ['d0'];
+ end;
+
+
+{
+ $Log: m68k.inc,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/m68k/makefile.cpu b/rtl/m68k/makefile.cpu
new file mode 100644
index 0000000000..be1724efeb
--- /dev/null
+++ b/rtl/m68k/makefile.cpu
@@ -0,0 +1,7 @@
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=m68k lowmath math set
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
+
diff --git a/rtl/m68k/math.inc b/rtl/m68k/math.inc
new file mode 100644
index 0000000000..c2608289ee
--- /dev/null
+++ b/rtl/m68k/math.inc
@@ -0,0 +1,949 @@
+{
+ $Id: math.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by several people
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{*************************************************************************}
+{ math.inc }
+{*************************************************************************}
+{ Copyright Abandoned, 1987, Fred Fish }
+{ }
+{ This previously copyrighted work has been placed into the }
+{ public domain by the author (Fred Fish) and may be freely used }
+{ for any purpose, private or commercial. I would appreciate }
+{ it, as a courtesy, if this notice is left in all copies and }
+{ derivative works. Thank you, and enjoy... }
+{ }
+{ The author makes no warranty of any kind with respect to this }
+{ product and explicitly disclaims any implied warranties of }
+{ merchantability or fitness for any particular purpose. }
+{-------------------------------------------------------------------------}
+{ Copyright (c) 1992 Odent Jean Philippe }
+{ }
+{ The source can be modified as long as my name appears and some }
+{ notes explaining the modifications done are included in the file. }
+{-------------------------------------------------------------------------}
+{ Copyright (c) 1997 Carl Eric Codere }
+{ }
+{*************************************************************************}
+{ This is the Motorola 680x0 specific port of the math include. }
+{*************************************************************************}
+{ }
+{ o all reals are mapped to the single type under the motorola version }
+{ }
+{ What is left to do: }
+{ o add support for sqrt with fixed. }
+
+type
+ TabCoef = array[0..6] of Real;
+
+
+const
+ PIO2 = 1.57079632679489661923; { pi/2 }
+ PIO4 = 7.85398163397448309616E-1; { pi/4 }
+ SQRT2 = 1.41421356237309504880; { sqrt(2) }
+ SQRTH = 7.07106781186547524401E-1; { sqrt(2)/2 }
+ LOG2E = 1.4426950408889634073599; { 1/log(2) }
+ SQ2OPI = 7.9788456080286535587989E-1; { sqrt( 2/pi )}
+ LOGE2 = 6.93147180559945309417E-1; { log(2) }
+ LOGSQ2 = 3.46573590279972654709E-1; { log(2)/2 }
+ THPIO4 = 2.35619449019234492885; { 3*pi/4 }
+ TWOOPI = 6.36619772367581343075535E-1; { 2/pi }
+ lossth = 1.073741824e9;
+ MAXLOG = 8.8029691931113054295988E1; { log(2**127) }
+ MINLOG = -8.872283911167299960540E1; { log(2**-128) }
+
+ DP1 = 7.85398125648498535156E-1;
+ DP2 = 3.77489470793079817668E-8;
+ DP3 = 2.69515142907905952645E-15;
+
+const sincof : TabCoef = (
+ 1.58962301576546568060E-10,
+ -2.50507477628578072866E-8,
+ 2.75573136213857245213E-6,
+ -1.98412698295895385996E-4,
+ 8.33333333332211858878E-3,
+ -1.66666666666666307295E-1, 0);
+ coscof : TabCoef = (
+ -1.13585365213876817300E-11,
+ 2.08757008419747316778E-9,
+ -2.75573141792967388112E-7,
+ 2.48015872888517045348E-5,
+ -1.38888888888730564116E-3,
+ 4.16666666666665929218E-2, 0);
+
+
+
+
+ function int(d : real) : real;
+ begin
+ { this will be correct since real = single in the case of }
+ { the motorola version of the compiler... }
+ int:=real(trunc(d));
+ end;
+
+ function trunc(d : real) : longint;
+ var
+ l: longint;
+ Begin
+ asm
+ move.l d,d0 { get number }
+ move.l d2,-(sp) { save register }
+ move.l d0,d1
+ swap d1 { extract exp }
+ move.w d1,d2 { extract sign }
+ bclr #15,d1 { kill sign bit }
+ lsr.w #7,d1
+
+ and.l #$7fffff,d0 { remove exponent from mantissa }
+ bset #23,d0 { restore implied leading "1" }
+
+ cmp.w #BIAS4,d1 { check exponent }
+ blt @zero { strictly factional, no integer part ? }
+ cmp.w #BIAS4+32,d1 { is it too big to fit in a 32-bit integer ? }
+ bgt @toobig
+
+ sub.w #BIAS4+24,d1 { adjust exponent }
+ bgt @trunclab2 { shift up }
+ beq @trunclab7 { no shift (never too big) }
+
+ neg.w d1
+ lsr.l d1,d0 { shift down to align radix point; }
+ { extra bits fall off the end (no rounding) }
+ bra @trunclab7 { never too big }
+ @trunclab2:
+ lsl.l d1,d0 { shift up to align radix point }
+ @trunclab3:
+ cmp.l #$80000000,d0 { -2147483648 is a nasty evil special case }
+ bne @trunclab6
+ tst.w d2 { this had better be -2^31 and not 2^31 }
+ bpl @toobig
+ bra @trunclab8
+ @trunclab6:
+ tst.l d0 { sign bit set ? (i.e. too big) }
+ bmi @toobig
+ @trunclab7:
+ tst.w d2 { is it negative ? }
+ bpl @trunclab8
+ neg.l d0 { negate }
+ bra @trunclab8
+ @zero:
+ clr.l d0 { make the whole thing zero }
+ bra @trunclab8
+ @toobig:
+ moveq #-1,d0 { ugh. Should cause a trap here. }
+ bclr #31,d0 { make it #0x7fffffff }
+ @trunclab8:
+ move.l (sp)+,d2
+ move.l d0,l
+ end;
+ if l = $7fffffff then
+ RunError(207)
+ else
+ trunc := l
+ end;
+
+
+
+
+
+ function abs(d : Real) : Real;
+ begin
+ if( d < 0.0 ) then
+ abs := -d
+ else
+ abs := d ;
+ end;
+
+
+ function frexp(x:Real; var e:Integer ):Real;
+ {* frexp() extracts the exponent from x. It returns an integer *}
+ {* power of two to expnt and the significand between 0.5 and 1 *}
+ {* to y. Thus x = y * 2**expn. *}
+ begin
+ e :=0;
+ if (abs(x)<0.5) then
+ While (abs(x)<0.5) do
+ begin
+ x := x*2;
+ Dec(e);
+ end
+ else
+ While (abs(x)>1) do
+ begin
+ x := x/2;
+ Inc(e);
+ end;
+ frexp := x;
+ end;
+
+
+ function ldexp( x: Real; N: Integer):Real;
+ {* ldexp() multiplies x by 2**n. *}
+ var r : Real;
+ begin
+ R := 1;
+ if N>0 then
+ while N>0 do
+ begin
+ R:=R*2;
+ Dec(N);
+ end
+ else
+ while N<0 do
+ begin
+ R:=R/2;
+ Inc(N);
+ end;
+ ldexp := x * R;
+ end;
+
+
+ function polevl(var x:Real; var Coef:TabCoef; N:Integer):Real;
+ {*****************************************************************}
+ { Evaluate polynomial }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { int N; }
+ { double x, y, coef[N+1], polevl[]; }
+ { }
+ { y = polevl( x, coef, N ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Evaluates polynomial of degree N: }
+ { }
+ { 2 N }
+ { y = C + C x + C x +...+ C x }
+ { 0 1 2 N }
+ { }
+ { Coefficients are stored in reverse order: }
+ { }
+ { coef[0] = C , ..., coef[N] = C . }
+ { N 0 }
+ { }
+ { The function p1evl() assumes that coef[N] = 1.0 and is }
+ { omitted from the array. Its calling arguments are }
+ { otherwise the same as polevl(). }
+ { }
+ { SPEED: }
+ { }
+ { In the interest of speed, there are no checks for out }
+ { of bounds arithmetic. This routine is used by most of }
+ { the functions in the library. Depending on available }
+ { equipment features, the user may wish to rewrite the }
+ { program in microcode or assembly language. }
+ {*****************************************************************}
+ var ans : Real;
+ i : Integer;
+
+ begin
+ ans := Coef[0];
+ for i:=1 to N do
+ ans := ans * x + Coef[i];
+ polevl:=ans;
+ end;
+
+
+ function p1evl(var x:Real; var Coef:TabCoef; N:Integer):Real;
+ { }
+ { Evaluate polynomial when coefficient of x is 1.0. }
+ { Otherwise same as polevl. }
+ { }
+ var
+ ans : Real;
+ i : Integer;
+ begin
+ ans := x + Coef[0];
+ for i:=1 to N-1 do
+ ans := ans * x + Coef[i];
+ p1evl := ans;
+ end;
+
+
+
+
+
+ function sqr(d : Real) : Real;
+ begin
+ sqr := d*d;
+ end;
+
+
+ function pi : Real;
+ begin
+ pi := 3.1415926535897932385;
+ end;
+
+
+ function sqrt(d:Real):Real;
+ {*****************************************************************}
+ { Square root }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, sqrt(); }
+ { }
+ { y = sqrt( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns the square root of x. }
+ { }
+ { Range reduction involves isolating the power of two of the }
+ { argument and using a polynomial approximation to obtain }
+ { a rough value for the square root. Then Heron's iteration }
+ { is used three times to converge to an accurate value. }
+ {*****************************************************************}
+ var e : Integer;
+ w,z : Real;
+ begin
+ if( d <= 0.0 ) then
+ begin
+ if( d < 0.0 ) then
+ RunError(207);
+ sqrt := 0.0;
+ end
+ else
+ begin
+ w := d;
+ { separate exponent and significand }
+ z := frexp( d, e );
+
+ { approximate square root of number between 0.5 and 1 }
+ { relative error of approximation = 7.47e-3 }
+ d := 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z;
+
+ { adjust for odd powers of 2 }
+ if odd(e) then
+ d := d*SQRT2;
+
+ { re-insert exponent }
+ d := ldexp( d, (e div 2) );
+
+ { Newton iterations: }
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ d := 0.5*(d + w/d);
+ sqrt := d;
+ end;
+ end;
+
+
+
+
+ function Exp(d:Real):Real;
+ {*****************************************************************}
+ { Exponential Function }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, exp(); }
+ { }
+ { y = exp( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns e (2.71828...) raised to the x power. }
+ { }
+ { Range reduction is accomplished by separating the argument }
+ { into an integer k and fraction f such that }
+ { }
+ { x k f }
+ { e = 2 e. }
+ { }
+ { A Pade' form of degree 2/3 is used to approximate exp(f)- 1 }
+ { in the basic range [-0.5 ln 2, 0.5 ln 2]. }
+ {*****************************************************************}
+ const P : TabCoef = (
+ 1.26183092834458542160E-4,
+ 3.02996887658430129200E-2,
+ 1.00000000000000000000E0, 0, 0, 0, 0);
+ Q : TabCoef = (
+ 3.00227947279887615146E-6,
+ 2.52453653553222894311E-3,
+ 2.27266044198352679519E-1,
+ 2.00000000000000000005E0, 0 ,0 ,0);
+
+ C1 = 6.9335937500000000000E-1;
+ C2 = 2.1219444005469058277E-4;
+ var n : Integer;
+ px, qx, xx : Real;
+ begin
+ if( d > MAXLOG) then
+ RunError(205)
+ else
+ if( d < MINLOG ) then
+ begin
+ Runerror(205);
+ end
+ else
+ begin
+
+ { Express e**x = e**g 2**n }
+ { = e**g e**( n loge(2) ) }
+ { = e**( g + n loge(2) ) }
+
+ px := d * LOG2E;
+ qx := Trunc( px + 0.5 ); { Trunc() truncates toward -infinity. }
+ n := Trunc(qx);
+ d := d - qx * C1;
+ d := d + qx * C2;
+
+ { rational approximation for exponential }
+ { of the fractional part: }
+ { e**x - 1 = 2x P(x**2)/( Q(x**2) - P(x**2) ) }
+ xx := d * d;
+ px := d * polevl( xx, P, 2 );
+ d := px/( polevl( xx, Q, 3 ) - px );
+ d := ldexp( d, 1 );
+ d := d + 1.0;
+ d := ldexp( d, n );
+ Exp := d;
+ end;
+ end;
+
+
+ function Round(d: Real): longint;
+ var
+ fr: Real;
+ tr: Real;
+ Begin
+ fr := Frac(d);
+ tr := Trunc(d);
+ if fr > 0.5 then
+ Round:=Trunc(d)+1
+ else
+ if fr < 0.5 then
+ Round:=Trunc(d)
+ else { fr = 0.5 }
+ { check sign to decide ... }
+ { as in Turbo Pascal... }
+ if d >= 0.0 then
+ Round := Trunc(d)+1
+ else
+ Round := Trunc(d);
+ end;
+
+
+ function Ln(d:Real):Real;
+ {*****************************************************************}
+ { Natural Logarithm }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, log(); }
+ { }
+ { y = ln( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns the base e (2.718...) logarithm of x. }
+ { }
+ { The argument is separated into its exponent and fractional }
+ { parts. If the exponent is between -1 and +1, the logarithm }
+ { of the fraction is approximated by }
+ { }
+ { log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). }
+ { }
+ { Otherwise, setting z = 2(x-1)/x+1), }
+ { }
+ { log(x) = z + z**3 P(z)/Q(z). }
+ { }
+ {*****************************************************************}
+ const P : TabCoef = (
+ { Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x)
+ 1/sqrt(2) <= x < sqrt(2) }
+
+ 4.58482948458143443514E-5,
+ 4.98531067254050724270E-1,
+ 6.56312093769992875930E0,
+ 2.97877425097986925891E1,
+ 6.06127134467767258030E1,
+ 5.67349287391754285487E1,
+ 1.98892446572874072159E1);
+ Q : TabCoef = (
+ 1.50314182634250003249E1,
+ 8.27410449222435217021E1,
+ 2.20664384982121929218E2,
+ 3.07254189979530058263E2,
+ 2.14955586696422947765E2,
+ 5.96677339718622216300E1, 0);
+
+ { Coefficients for log(x) = z + z**3 P(z)/Q(z),
+ where z = 2(x-1)/(x+1)
+ 1/sqrt(2) <= x < sqrt(2) }
+
+ R : TabCoef = (
+ -7.89580278884799154124E-1,
+ 1.63866645699558079767E1,
+ -6.41409952958715622951E1, 0, 0, 0, 0);
+ S : TabCoef = (
+ -3.56722798256324312549E1,
+ 3.12093766372244180303E2,
+ -7.69691943550460008604E2, 0, 0, 0, 0);
+
+ var e : Integer;
+ z, y : Real;
+
+ Label Ldone;
+ begin
+ if( d <= 0.0 ) then
+ RunError(207);
+ d := frexp( d, e );
+
+ { logarithm using log(x) = z + z**3 P(z)/Q(z),
+ where z = 2(x-1)/x+1) }
+
+ if( (e > 2) or (e < -2) ) then
+ begin
+ if( d < SQRTH ) then
+ begin
+ { 2( 2x-1 )/( 2x+1 ) }
+ Dec(e, 1);
+ z := d - 0.5;
+ y := 0.5 * z + 0.5;
+ end
+ else
+ begin
+ { 2 (x-1)/(x+1) }
+ z := d - 0.5;
+ z := z - 0.5;
+ y := 0.5 * d + 0.5;
+ end;
+ d := z / y;
+ { /* rational form */ }
+ z := d*d;
+ z := d + d * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) );
+ goto ldone;
+ end;
+
+ { logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) }
+
+ if( d < SQRTH ) then
+ begin
+ Dec(e, 1);
+ d := ldexp( d, 1 ) - 1.0; { 2x - 1 }
+ end
+ else
+ d := d - 1.0;
+
+ { rational form }
+ z := d*d;
+ y := d * ( z * polevl( d, P, 6 ) / p1evl( d, Q, 6 ) );
+ y := y - ldexp( z, -1 ); { y - 0.5 * z }
+ z := d + y;
+
+ ldone:
+ { recombine with exponent term }
+ if( e <> 0 ) then
+ begin
+ y := e;
+ z := z - y * 2.121944400546905827679e-4;
+ z := z + y * 0.693359375;
+ end;
+
+ Ln:= z;
+ end;
+
+
+
+ function Sin(d:Real):Real;
+ {*****************************************************************}
+ { Circular Sine }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, sin(); }
+ { }
+ { y = sin( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Range reduction is into intervals of pi/4. The reduction }
+ { error is nearly eliminated by contriving an extended }
+ { precision modular arithmetic. }
+ { }
+ { Two polynomial approximating functions are employed. }
+ { Between 0 and pi/4 the sine is approximated by }
+ { x + x**3 P(x**2). }
+ { Between pi/4 and pi/2 the cosine is represented as }
+ { 1 - x**2 Q(x**2). }
+ {*****************************************************************}
+ var y, z, zz : Real;
+ j, sign : Integer;
+
+ begin
+ { make argument positive but save the sign }
+ sign := 1;
+ if( d < 0 ) then
+ begin
+ d := -d;
+ sign := -1;
+ end;
+
+ { above this value, approximate towards 0 }
+ if( d > lossth ) then
+ begin
+ sin := 0.0;
+ exit;
+ end;
+
+ y := Trunc( d/PIO4 ); { integer part of x/PIO4 }
+
+ { strip high bits of integer part to prevent integer overflow }
+ z := ldexp( y, -4 );
+ z := Trunc(z); { integer part of y/8 }
+ z := y - ldexp( z, 4 ); { y - 16 * (y/16) }
+
+ j := Trunc(z); { convert to integer for tests on the phase angle }
+ { map zeros to origin }
+ if odd( j ) then
+ begin
+ inc(j);
+ y := y + 1.0;
+ end;
+ j := j and 7; { octant modulo 360 degrees }
+ { reflect in x axis }
+ if( j > 3) then
+ begin
+ sign := -sign;
+ dec(j, 4);
+ end;
+
+ { Extended precision modular arithmetic }
+ z := ((d - y * DP1) - y * DP2) - y * DP3;
+
+ zz := z * z;
+
+ if( (j=1) or (j=2) ) then
+ y := 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 )
+ else
+ { y = z + z * (zz * polevl( zz, sincof, 5 )); }
+ y := z + z * z * z * polevl( zz, sincof, 5 );
+
+ if(sign < 0) then
+ y := -y;
+ sin := y;
+ end;
+
+
+
+
+ function Cos(d:Real):Real;
+ {*****************************************************************}
+ { Circular cosine }
+ {*****************************************************************}
+ { }
+ { Circular cosine }
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, cos(); }
+ { }
+ { y = cos( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Range reduction is into intervals of pi/4. The reduction }
+ { error is nearly eliminated by contriving an extended }
+ { precision modular arithmetic. }
+ { }
+ { Two polynomial approximating functions are employed. }
+ { Between 0 and pi/4 the cosine is approximated by }
+ { 1 - x**2 Q(x**2). }
+ { Between pi/4 and pi/2 the sine is represented as }
+ { x + x**3 P(x**2). }
+ {*****************************************************************}
+ var y, z, zz : Real;
+ j, sign : Integer;
+ i : LongInt;
+ begin
+ { make argument positive }
+ sign := 1;
+ if( d < 0 ) then
+ d := -d;
+
+ { above this value, round towards zero }
+ if( d > lossth ) then
+ begin
+ cos := 0.0;
+ exit;
+ end;
+
+ y := Trunc( d/PIO4 );
+ z := ldexp( y, -4 );
+ z := Trunc(z); { integer part of y/8 }
+ z := y - ldexp( z, 4 ); { y - 16 * (y/16) }
+
+ { integer and fractional part modulo one octant }
+ i := Trunc(z);
+ if odd( i ) then { map zeros to origin }
+ begin
+ inc(i);
+ y := y + 1.0;
+ end;
+ j := i and 07;
+ if( j > 3) then
+ begin
+ dec(j,4);
+ sign := -sign;
+ end;
+ if( j > 1 ) then
+ sign := -sign;
+
+ { Extended precision modular arithmetic }
+ z := ((d - y * DP1) - y * DP2) - y * DP3;
+
+ zz := z * z;
+
+ if( (j=1) or (j=2) ) then
+ { y = z + z * (zz * polevl( zz, sincof, 5 )); }
+ y := z + z * z * z * polevl( zz, sincof, 5 )
+ else
+ y := 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 );
+
+ if(sign < 0) then
+ y := -y;
+
+ cos := y ;
+ end;
+
+
+
+ function ArcTan(d:Real):Real;
+ {*****************************************************************}
+ { Inverse circular tangent (arctangent) }
+ {*****************************************************************}
+ { }
+ { SYNOPSIS: }
+ { }
+ { double x, y, atan(); }
+ { }
+ { y = atan( x ); }
+ { }
+ { DESCRIPTION: }
+ { }
+ { Returns radian angle between -pi/2 and +pi/2 whose tangent }
+ { is x. }
+ { }
+ { Range reduction is from four intervals into the interval }
+ { from zero to tan( pi/8 ). The approximant uses a rational }
+ { function of degree 3/4 of the form x + x**3 P(x)/Q(x). }
+ {*****************************************************************}
+ const P : TabCoef = (
+ -8.40980878064499716001E-1,
+ -8.83860837023772394279E0,
+ -2.18476213081316705724E1,
+ -1.48307050340438946993E1, 0, 0, 0);
+ Q : TabCoef = (
+ 1.54974124675307267552E1,
+ 6.27906555762653017263E1,
+ 9.22381329856214406485E1,
+ 4.44921151021319438465E1, 0, 0, 0);
+
+ { tan( 3*pi/8 ) }
+ T3P8 = 2.41421356237309504880;
+ { tan( pi/8 ) }
+ TP8 = 0.41421356237309504880;
+
+ var y,z : Real;
+ Sign : Integer;
+
+ begin
+ { make argument positive and save the sign }
+ sign := 1;
+ if( d < 0.0 ) then
+ begin
+ sign := -1;
+ d := -d;
+ end;
+
+ { range reduction }
+ if( d > T3P8 ) then
+ begin
+ y := PIO2;
+ d := -( 1.0/d );
+ end
+ else if( d > TP8 ) then
+ begin
+ y := PIO4;
+ d := (d-1.0)/(d+1.0);
+ end
+ else
+ y := 0.0;
+
+ { rational form in x**2 }
+
+ z := d * d;
+ y := y + ( polevl( z, P, 3 ) / p1evl( z, Q, 4 ) ) * z * d + d;
+
+ if( sign < 0 ) then
+ y := -y;
+ Arctan := y;
+ end;
+
+ function frac(d : Real) : Real;
+ begin
+ frac := d - Int(d);
+ end;
+
+{$ifdef fixed}
+
+
+ function sqrt(d : fixed) : fixed;
+ begin
+ end;
+
+ function int(d : fixed) : fixed; assembler;
+ {*****************************************************************}
+ { Returns the integral part of d }
+ {*****************************************************************}
+ asm
+ move.l d,d0
+ and.l #$ffff0000,d0 { keep only upper bits .. }
+ end;
+
+
+ function trunc(d : fixed) : longint;
+ {*****************************************************************}
+ { Returns the Truncated integral part of d }
+ {*****************************************************************}
+ begin
+ trunc:=longint(integer(d shr 16)); { keep only upper 16 bits }
+ end;
+
+ function frac(d : fixed) : fixed; assembler;
+ {*****************************************************************}
+ { Returns the Fractional part of d }
+ {*****************************************************************}
+ asm
+ move.l d,d0
+ and.l #$ffff,d0 { keep only decimal parts - lower 16 bits }
+ end;
+
+ function abs(d : fixed) : fixed;
+ {*****************************************************************}
+ { Returns the Absolute value of d }
+ {*****************************************************************}
+ var
+ w: integer;
+ begin
+ w:=integer(d shr 16);
+ if w < 0 then
+ begin
+ w:=-w; { invert sign ... }
+ d:=d and $ffff;
+ d:=d or (fixed(w) shl 16); { add this to fixed number ... }
+ abs:=d;
+ end
+ else
+ abs:=d; { already positive... }
+ end;
+
+
+ function sqr(d : fixed) : fixed;
+ {*****************************************************************}
+ { Returns the Absolute squared value of d }
+ {*****************************************************************}
+ begin
+ {16-bit precision needed, not 32 =)}
+ sqr := d*d;
+{ sqr := (d SHR 8 * d) SHR 8; }
+ end;
+
+
+ function Round(x: fixed): longint;
+ {*****************************************************************}
+ { Returns the Rounded value of d as a longint }
+ {*****************************************************************}
+ var
+ lowf:integer;
+ highf:integer;
+ begin
+ lowf:=x and $ffff; { keep decimal part ... }
+ highf :=integer(x shr 16);
+ if lowf > 5 then
+ highf:=highf+1
+ else
+ if lowf = 5 then
+ begin
+ { here we must check the sign ... }
+ { if greater or equal to zero, then }
+ { greater value will be found by adding }
+ { one... }
+ if highf >= 0 then
+ Highf:=Highf+1;
+ end;
+ Round:= longint(highf);
+ end;
+{$endif fixed}
+
+ function power(bas,expo : real) : real;
+ begin
+ if bas=0.0 then
+ begin
+ if expo<>0.0 then
+ power:=0.0
+ else
+ HandleError(207);
+ end
+ else if expo=0.0 then
+ power:=1
+ else
+ { bas < 0 is not allowed }
+ if bas<0.0 then
+ handleerror(207)
+ else
+ power:=exp(ln(bas)*expo);
+ end;
+
+ function power(bas,expo : longint) : longint;
+ begin
+ if bas=0 then
+ begin
+ if expo<>0 then
+ power:=0
+ else
+ HandleError(207);
+ end
+ else if expo=0 then
+ power:=1
+ else
+ begin
+ if bas<0 then
+ begin
+ if odd(expo) then
+ power:=-round(exp(ln(-bas)*expo))
+ else
+ power:=round(exp(ln(-bas)*expo));
+ end
+ else
+ power:=round(exp(ln(bas)*expo));
+ end;
+ end;
+
+{
+ $Log: math.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/m68k/readme b/rtl/m68k/readme
new file mode 100644
index 0000000000..0d769d90fd
--- /dev/null
+++ b/rtl/m68k/readme
@@ -0,0 +1,7 @@
+This directory contains only RTL parts specific
+to the processor M68K family.
+
+
+Missing units are :
+ strings.pp (you can the strings unit in the template directory)
+ getopts.pp
diff --git a/rtl/m68k/set.inc b/rtl/m68k/set.inc
new file mode 100644
index 0000000000..72275a016d
--- /dev/null
+++ b/rtl/m68k/set.inc
@@ -0,0 +1,428 @@
+{
+ $Id: set.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Carl-Eric Codere,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{*************************************************************************}
+{ Converted by Carl Eric Codere }
+{*************************************************************************}
+{ This inc. implements low-level set operations for the motorola }
+{ 68000 familiy of processors. }
+{ Based on original code bt Florian Kl„mpfl for the 80x86. }
+{*************************************************************************}
+
+
+ { add the element b to the set pointed by p }
+ { On entry }
+ { a0 = pointer to set }
+ { d0.b = element to add to the set }
+ { Registers destroyed: d0,a1,d6 }
+ procedure do_set;assembler;
+ asm
+ XDEF SET_SET_BYTE
+ move.l d0,d6
+ { correct long position: }
+ { -> (value div 32)*4 = longint }
+ { (value shr 5)*shl 2 }
+ lsr.l #5,d6
+ lsl.l #2,d6
+ adda.l d6,a0 { correct offset from start address of set }
+
+ move.l d0,d6 { bit is now in here }
+ andi.l #31,d0 { bit number is = value mod 32 }
+
+ { now bit set the value }
+ move.l (a0),d0 { we must put bits into register }
+ bset.l d6,d0 { otherwise btst will be a byte }
+ { put result in carry flag } { operation. }
+ bne @LDOSET1
+ andi.b #$fe,ccr { clear carry flag }
+ bra @LDOSET2
+ @LDOSET1:
+ ori.b #$01,ccr { set carry flag }
+ @LDOSET2:
+ move.l d0,(a0) { restore the value at that location }
+ { of the set. }
+ end;
+
+ { Finds an element in a set }
+ { a0 = address of set }
+ { d0.b = value to compare with }
+ { CARRY SET IF FOUND ON EXIT }
+ { Registers destroyed: d0,a0,d6 }
+ procedure do_in; assembler;
+ { Returns Carry set then = in set , otherwise carry is cleared }
+ { (D0) }
+ asm
+ XDEF SET_IN_BYTE
+ move.l d0,d6
+ { correct long position: }
+ { -> (value div 32)*4 = longint }
+ { (value shr 5)*shl 2 }
+ lsr.l #5,d6
+ lsl.l #2,d6
+ adda.l d6,a0 { correct offset from start address of set }
+
+ move.l d0,d6 { bit is now in here }
+ andi.l #31,d0 { bit number is = value mod 32 }
+
+ move.l (a0),d0 { we must put bits into register }
+ btst.l d6,d0 { otherwise btst will be a byte }
+ { put result in carry flag } { operation. }
+ bne @LDOIN1
+ andi.b #$fe,ccr { clear carry flag }
+ bra @LDOIN2
+ @LDOIN1:
+ ori.b #$01,ccr { set carry flag }
+ @LDOIN2:
+ end;
+
+
+
+ { vereinigt set1 und set2 und speichert das Ergebnis in dest }
+
+ procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
+ { PSEUDO-CODE:
+ type
+ destination = array[1..8] of longint;
+ for i:=1 to 8 do
+ destination(dest^)[i] := destination(set1^)[i] OR destination(set2^)[i];
+ }
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l #32,d6
+
+ @LMADDSETS1:
+
+ move.b (a0)+,d0
+ or.b (a1)+,d0
+ move.b d0,(a2)+
+ subq.b #1,d6
+ bne @LMADDSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end ['d0','d6','a0','a1'];
+ end;
+
+ { computes the symetric diff from set1 to set2 }
+ { result in dest }
+
+ procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
+
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l #32,d6
+
+ @LMADDSETS1:
+
+ move.b (a0)+,d0
+ move.b (a1)+,d1
+ eor.b d1,d0
+ move.b d0,(a2)+
+ subq.b #1,d6
+ bne @LMADDSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end;
+ end;
+
+
+ { bad implementation, but it's very seldom used }
+ procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
+
+ begin
+ asm
+ move.b h,d0
+ @LSetRLoop:
+ cmp.b l,d0
+ blt @Lend
+ move.w d0,-(sp)
+ { adjust value to correct endian }
+ lsl.w #8,d0
+ pea p
+ jsr SET_SET_BYTE
+ sub.b #1,d0
+ bra @LSetRLoop
+ @Lend:
+ end;
+ end;
+
+
+ { bildet den Durchschnitt von set1 und set2 }
+ { und speichert das Ergebnis in dest }
+
+ procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
+ { type
+ larray = array[0..7] of longint;
+ for i:=0 to 7 do
+ larray(dest^)[i] := larray(set1^)[i] AND larray(set2^)[i];
+ }
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l #32,d6
+
+ @LMMULSETS1:
+
+ move.b (a0)+,d0
+ and.b (a1)+,d0
+ move.b d0,(a2)+
+ subq.b #1,d6
+ bne @LMMULSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end ['d0','d6','a0','a1'];
+ end;
+
+
+ { bildet die Differenz von set1 und set2 }
+ { und speichert das Ergebnis in dest }
+
+ procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
+ { type
+ larray = array[0..7] of longint;
+ begin
+ for i:=0 to 7 do
+ larray(dest^)[i] := larray(set1^)[i] AND NOT (larray(set2^)[i]);
+ end;
+ }
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l #32,d6
+
+ @LSUBSETS1:
+ move.b (a0)+,d0
+ move.b (a1)+,d1
+ not.b d1
+ and.b d1,d0
+ move.b d0,(a2)+
+ sub.b #1,d6
+ bne @LSUBSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end ['d0','d1','d6','a0','a1'];
+ end;
+
+ { compare both sets }
+ { compares set1 and set2 }
+ { zeroflag is set if they are equal }
+ { on entry : a0 = pointer to first set }
+ { : a1 = pointer to second set }
+ procedure comp_sets; assembler;
+
+ asm
+ XDEF SET_COMP_SETS
+ move.l #32,d6
+ @LMCOMPSETS1:
+ move.b (a0)+,d0
+ move.b (a1),d1
+ cmp.b d1,d0
+ bne @LMCOMPSETEND
+ adda.l #1,a1
+ sub.b #1,d6
+ bne @LMCOMPSETS1
+ { we are here only if the two sets are equal }
+ { we have zero flag set, and that what is expected }
+ cmp.b d0,d0
+ @LMCOMPSETEND:
+ end;
+
+ procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
+ begin
+ asm
+ move.l 8(a6),a0
+ move.w 12(a6),d6
+ andi.l #$fff8,d6
+ lsl.l #3,d6
+ adda.l d6,a0
+ move.b 12(a6),d6
+ andi.l #7,d6
+
+ move.l (a0),d0 { we must put bits into register }
+ btst.l d6,d0 { otherwise btst will be a byte }
+ { put result in carry flag } { operation. }
+ bne @LBIGDOSET1
+ andi.b #$fe,ccr { clear carry flag }
+ bra @LBIGDOSET2
+ @LBIGDOSET1:
+ ori.b #$01,ccr { set carry flag }
+ @LBIGDOSET2:
+ end ['d0','a0','d6'];
+ end;
+
+ { testet, ob das Element b in der Menge p vorhanden ist }
+ { und setzt das Carryflag entsprechend }
+
+ procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
+ begin
+ asm
+ move.l 8(a6),a0
+ move.w 12(a6),d6
+ andi.l #$fff8,d6
+ lsl.l #3,d6
+ adda.l d6,a0 { correct offset from start address of set }
+
+ move.b 12(a6),d6
+ andi.l #7,d6
+
+ move.l (a0),d0 { we must put bits into register }
+ btst.l d6,d0 { otherwise btst will be a byte }
+ { put result in carry flag } { operation. }
+ bne @LBIGDOIN1
+ andi.b #$fe,ccr { clear carry flag }
+ bra @LBIGDOIN2
+ @LBIGDOIN1:
+ ori.b #$01,ccr { set carry flag }
+ @LBIGDOIN2:
+ end ['d0','a0','d6'];
+ end;
+
+
+ { vereinigt set1 und set2 und speichert das Ergebnis in dest }
+ { size is the number of bytes in the set }
+
+ procedure add_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_ADD_SETS_SIZE'];
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l 20(a6),d6
+
+ @LBIGMADDSETS1:
+
+ move.l (a0)+,d0
+ or.l (a1)+,d0
+ move.l d0,(a2)+
+ subq.l #4,d6
+ bne @LBIGMADDSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end ['d0','d6','a0','a1'];
+ end;
+
+
+ procedure mul_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_MUL_SETS_SIZE'];
+ { bildet den Durchschnitt von set1 und set2 }
+ { und speichert das Ergebnis in dest }
+ { size is the number of bytes in the set }
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l 20(a6),d6
+
+ @LBIGMMULSETS1:
+
+ move.l (a0)+,d0
+ and.l (a1)+,d0
+ move.l d0,(a2)+
+ subq.l #4,d6
+ bne @LBIGMMULSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end ['d0','d6','a0','a1'];
+ end;
+
+
+ { bildet die Differenz von set1 und set2 }
+ { und speichert das Ergebnis in dest }
+ { size is the number of bytes in the set }
+
+ procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SUB_SETS_SIZE'];
+ begin
+ asm
+ { saved used register }
+ move.l a2,-(sp)
+ move.l 8(a6),a0
+ move.l 12(a6),a1
+ move.l 16(a6),a2
+
+ move.l 20(a6),d6
+
+ @BIGSUBSETS1:
+
+ move.l (a0)+,d0
+ not.l d0
+ and.l (a1)+,d0
+ move.l d0,(a2)+
+ subq.l #4,d6
+ bne @BIGSUBSETS1
+ { restore register }
+ move.l a2,(sp)+
+ end ['d0','d6','a0','a1'];
+ end;
+
+
+ { vergleicht Mengen und setzt die Flags entsprechend }
+
+ procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: 'SET_COMP_SETS_SIZE'];
+
+
+ begin
+ asm
+ move.l 8(a6),a0 { set1 - esi}
+ move.l 12(a6),a1 { set2 - edi }
+ move.l 16(a6),d6
+ @MCOMPSETS1:
+ move.l (a0)+,d0
+ move.l (a1),d1
+ cmp.l d1,d0
+ bne @BIGMCOMPSETEND
+ add.l #4,a1
+ subq.l #1,d6
+ bne @MCOMPSETS1
+ { we are here only if the two sets are equal }
+ { we have zero flag set, and that what is expected }
+ cmp.l d0,d0
+ @BIGMCOMPSETEND:
+ end;
+ end;
+
+{
+ $Log: set.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/m68k/setjump.inc b/rtl/m68k/setjump.inc
new file mode 100644
index 0000000000..baf7a01e9e
--- /dev/null
+++ b/rtl/m68k/setjump.inc
@@ -0,0 +1,34 @@
+{
+ $Id: setjump.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by xxxx
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{**********************************************************************
+ Set_Jmp/Long_jmp
+ **********************************************************************}
+
+Function SetJmp (Var S : Jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];
+
+asm
+end;
+
+Procedure longJmp (Var S : Jmp_buf; value : longint); assembler;[Public, alias : 'FPC_LONGJMP'];
+
+asm
+end;
+
+ $Log: setjump.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/m68k/setjumph.inc b/rtl/m68k/setjumph.inc
new file mode 100644
index 0000000000..1b6884e927
--- /dev/null
+++ b/rtl/m68k/setjumph.inc
@@ -0,0 +1,37 @@
+{
+ $Id: setjumph.inc,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by xxxx
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{**********************************************************************
+ Declarations for SetJmp/LongJmp
+ **********************************************************************}
+
+Type
+ jmp_buf = packed record
+ fp : longint; { frame pointer }
+ sp : longint; { stack pointer }
+ pc : longint; { program counter }
+ aregs : array[0..3] of dword; { address registers (a2,a3,a4,a5) }
+ end;
+ PJmp_buf = ^jmp_buf;
+
+Function Setjmp (Var S : Jmp_buf) : longint;
+Procedure longjmp (Var S : Jmp_buf; value : longint);
+
+{
+ $Log: setjumph.inc,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/macos/MPWmake b/rtl/macos/MPWmake
new file mode 100644
index 0000000000..9205b31a46
--- /dev/null
+++ b/rtl/macos/MPWmake
@@ -0,0 +1,124 @@
+# Make file for MPW make.
+# To run it, use:
+# Make <target> -f MPWMake > Makeout ; Makeout
+# where <target> should be replaced with actual make target.
+
+FPC = {FPCDIR}bin:ppcppc
+REDIR = -FE::units:powerpc-macos:
+SYSDEPS =
+DOSDEPS =
+
+
+all Ä
+ Set Exit 0
+ NewFolder "::units:" ³ Dev:Null
+ NewFolder "::units:powerpc-macos:" ³ Dev:Null
+ Set Exit 1
+ If {RELEASE}
+ Set OPT "{OPT} -Ur"
+ End
+ "{FPC}" {OPT} {REDIR} -Us -Fi::inc -Fi::powerpc system.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:strings.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::objpas:objpas.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:macpas.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc ::unix:unixutil.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc dos.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:objects.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:getopts.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:heaptrc.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:charset.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:cmem.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:matrix.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc macostp.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc macutils.pp
+ "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:ctypes.pp
+
+# The MacOS unit can be built, if the XCode integration kit is installed
+
+# Path to (FPC adapted) Apple Universal Interfaces
+UPINTERFACES = {Boot}Developer:Pascal:UPInterfaces
+
+macos Ä
+ Set Exit 0
+ NewFolder "::units:" ³ Dev:Null
+ NewFolder "::units:powerpc-macos:" ³ Dev:Null
+ Set Exit 1
+ If {RELEASE}
+ Set OPT "{OPT} -Ur"
+ End
+ "{FPC}" {OPT} {REDIR} -Fi"{UPINTERFACES}" macos.pp
+
+clean Ä
+ Set Exit 0
+ Delete -y fpcmade.powerpc-macos
+ Delete -y Å_ppas
+ Delete -y ::units:powerpc-macos:Å.ppu
+ Delete -y ::units:powerpc-macos:Å.o
+ Delete -y ::units:powerpc-macos:Å.s
+ Delete -y ::units:powerpc-macos:Å.xcoff
+ Set Exit 1
+
+install Ä
+ If {FPCDIR} == ''
+ Set -e FPCDIR `GetFileName -wd -m 'Select where to install the FreePascal folder'`FreePascal:
+ Echo "Set -e FPCDIR ¶'{FPCDIR}¶'" > "{MPW}Startup Items:FPC Startup"
+ End
+ Set Exit 0
+ NewFolder "{FPCDIR}" ³ Dev:Null
+ Delete -y "{FPCDIR}units:" ³ Dev:Null
+ Set Exit 1
+ NewFolder "{FPCDIR}units:"
+ NewFolder "{FPCDIR}units:rtl:"
+ Duplicate -y ::units:powerpc-macos:Å.ppu ::units:powerpc-macos:Å.o "{FPCDIR}units:rtl:"
+ Set Exit 0
+ Duplicate -y ::units:powerpc-macos:Å.xcoff "{FPCDIR}units:rtl:" ³ Dev:Null
+ Set Exit 1
+
+
+#system.ppu Ä system.pp macostp.inc macutils.inc {SYSDEPS}
+# "{FPC}" {OPT} {REDIR} -Us -Fi::inc -Fi::powerpc system.pp
+
+#strings.ppu Ä ::inc:strings.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:strings.pp
+
+#objpas.ppu Ä ::objpas:objpas.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::objpas:objpas.pp
+
+#macpas.ppu Ä ::inc:macpas.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:macpas.pp
+
+#dos.ppu Ä dos.pp {DOSDEPS} macutils.ppu unixutil.ppu system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc dos.pp
+
+#objects.ppu Ä ::inc:objects.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:objects.pp
+
+#getopts.ppu Ä ::inc:getopts.pp strings.ppu system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:getopts.pp
+
+#heaptrc.ppu Ä ::inc:heaptrc.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:heaptrc.pp
+
+#unixutil.ppu Ä ::unix:unixutil.pp
+# "{FPC}" {OPT} {REDIR} ::inc:unixutil.pp
+
+#charset.ppu Ä ::inc:charset.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:charset.pp
+
+#cmem.ppu Ä ::inc:cmem.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:cmem.pp
+
+#matrix.ppu Ä ::inc:matrix.pp system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc ::inc:matrix.pp
+
+#macostp.ppu Ä macostp.pp macostp.inc system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc macostp.pp
+
+#macutils.ppu Ä macutils.pp macutils.inc macostp.ppu system.ppu
+# "{FPC}" {OPT} {REDIR} -Fi::inc -Fi::powerpc macutils.pp
+
+#all Ä system.ppu strings.ppu objpas.ppu macpas.ppu dos.ppu ¶
+# objects.ppu getopts.ppu heaptrc.ppu unixutil.ppu charset.ppu ¶
+# cmem.ppu matrix.ppu macostp.ppu macutils.ppu
+
+
diff --git a/rtl/macos/Makefile b/rtl/macos/Makefile
new file mode 100644
index 0000000000..54e790b64f
--- /dev/null
+++ b/rtl/macos/Makefile
@@ -0,0 +1,1757 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=macos
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+PPUEXT=pput
+ASMEXT=.s
+UNITPREFIX=rtl
+ifdef RELEASE
+ifeq ($(findstring 1.0.2,$(FPC_VERSION)),)
+ifeq ($(findstring 1.0.4,$(FPC_VERSION)),)
+override FPCOPT+=-Ur
+endif
+endif
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=system strings objpas macpas heaptrc getopts macostp macutils unixutil dos objects matrix cmem charset ctypes
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp $(REDIR)
+strings$(PPUEXT) : $(INC)/strings.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/strings.pp $(REDIR)
+objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/objpas.pp .
+ $(COMPILER) objpas $(REDIR)
+ $(DEL) objpas.pp
+sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/sysutils.pp .
+ $(COMPILER) sysutils $(REDIR)
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) dos $(REDIR)
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/objects.pp $(REDIR)
+getopts$(PPUEXT) : $(INC)/getopts.pp strings$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(INC)/getopts.pp $(REDIR)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/heaptrc.pp $(REDIR)
+unixutil$(PPUEXT) : ../unix/unixutil.pp
+ $(COMPILER) ../unix/unixutil.pp $(REDIR)
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp system$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
diff --git a/rtl/macos/Makefile.fpc b/rtl/macos/Makefile.fpc
new file mode 100644
index 0000000000..c43426a73a
--- /dev/null
+++ b/rtl/macos/Makefile.fpc
@@ -0,0 +1,155 @@
+#
+# Makefile.fpc for Free Pascal MacOS RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=
+units=system strings objpas macpas heaptrc getopts macostp macutils \
+ unixutil dos objects matrix cmem charset ctypes
+# exec \
+# crt printer \
+# lineinfo graph \
+# sysutils math typinfo
+# rsts=math
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=macos
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+PPUEXT=pput
+ASMEXT=.s
+
+UNITPREFIX=rtl
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+ifeq ($(findstring 1.0.2,$(FPC_VERSION)),)
+ifeq ($(findstring 1.0.4,$(FPC_VERSION)),)
+override FPCOPT+=-Ur
+endif
+endif
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+#prt0$(OEXT) : prt0$(LOADEREXT)
+# -$(AS) prt0$(LOADEREXT) -o prt0$(OEXT)
+
+#gprt0$(OEXT) : $(GLOADERAS)
+# -$(AS) $(GLOADERAS) -o gprt0$(OEXT)
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp $(REDIR)
+
+strings$(PPUEXT) : $(INC)/strings.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/strings.pp $(REDIR)
+
+#exec$(PPUEXT) : exec.pp exec.inc system$(PPUEXT)
+# $(COMPILER) exec $(REDIR)
+
+#
+# Delphi Object Model
+#
+
+objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/objpas.pp .
+ $(COMPILER) objpas $(REDIR)
+ $(DEL) objpas.pp
+
+sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT)
+ $(COPY) $(OBJPASDIR)/sysutils.pp .
+ $(COMPILER) sysutils $(REDIR)
+#$(DEL) sysutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# System Dependent Units
+#
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) dos $(REDIR)
+
+#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc system$(PPUEXT)
+# $(COMPILER) crt $(REDIR)
+
+#printer$(PPUEXT) : printer.pp system$(PPUEXT)
+# $(COMPILER) printer $(REDIR)
+
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/objects.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+getopts$(PPUEXT) : $(INC)/getopts.pp strings$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(INC)/getopts.pp $(REDIR)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/heaptrc.pp $(REDIR)
+
+unixutil$(PPUEXT) : ../unix/unixutil.pp
+ $(COMPILER) ../unix/unixutil.pp $(REDIR)
+
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp system$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
diff --git a/rtl/macos/README b/rtl/macos/README
new file mode 100644
index 0000000000..f987c77157
--- /dev/null
+++ b/rtl/macos/README
@@ -0,0 +1,5 @@
+The info in this file has moved to
+
+http://www.freepascal.org/wiki/index.php/Mode_MacPas
+
+or to the README MacOS file accompanying the installation package.
diff --git a/rtl/macos/dos.pp b/rtl/macos/dos.pp
new file mode 100644
index 0000000000..14fecc253b
--- /dev/null
+++ b/rtl/macos/dos.pp
@@ -0,0 +1,985 @@
+{
+ $Id: dos.pp,v 1.12 2005/04/03 22:16:02 olle Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Olle Raab and
+ members of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit Dos;
+Interface
+
+Uses
+ macostp;
+
+
+Const
+ FileNameLen = 255;
+
+Type
+ SearchRec = packed record
+ Attr: Byte; {attribute of found file}
+ Time: LongInt; {last modify date of found file}
+ Size: LongInt; {file size of found file}
+ Reserved: Word; {future use}
+ Name: string[FileNameLen]; {name of foundfile}
+ SearchSpec: string[FileNameLen]; {search pattern}
+ NamePos: Word; {end of path,start of name position}
+
+ {MacOS specific params, private, do not use:}
+ paramBlock: CInfoPBRec;
+ searchFSSpec: FSSpec;
+ searchAttr: Byte; {attribute we are searching for}
+ exactMatch: Boolean;
+ end;
+
+{$DEFINE HAS_FILENAMELEN}
+{$I dosh.inc}
+
+Implementation
+
+{TODO Obtain disk size and disk free values for volumes > 2 GB.
+ For this, PBXGetVolInfoSync can be used. However, this function
+ is not available on older versions of Mac OS, so the function has
+ to be weak linked. An alternative is to directly look into the VCB
+ (Volume Control Block), but since this is on low leveel it is a
+ compatibility risque.}
+
+{TODO Perhaps make SearchRec.paramBlock opaque, so that uses macostp;
+ is not needed in the interface part.}
+
+{TODO Perhaps add some kind of "Procedure AddDisk" for accessing other
+ volumes. At lest accessing the possible disk drives with
+ drive number 1 and 2 should be easy.}
+
+{TODO Perhaps use LongDateTime for time functions. But the function
+ calls must then be weak linked.}
+
+Uses
+ macutils,
+ unixutil {for FNMatch};
+
+{$UNDEF USE_FEXPAND_INC}
+//{$DEFINE USE_FEXPAND_INC}
+
+{$IFNDEF USE_FEXPAND_INC}
+
+{$DEFINE HAS_FEXPAND}
+{Own implemetation of fexpand.inc}
+{$I dos.inc}
+
+{$ELSE}
+
+{$DEFINE FPC_FEXPAND_VOLUMES}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$DEFINE FPC_FEXPAND_NO_DOTS_UPDIR}
+{$DEFINE FPC_FEXPAND_NO_CURDIR}
+
+{ NOTE: If HAS_FEXPAND is not defined, fexpand.inc is included in dos.inc. }
+{ TODO A lot of issues before this works}
+
+{$I dos.inc}
+
+{$UNDEF FPC_FEXPAND_VOLUMES}
+{$UNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$UNDEF FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$UNDEF FPC_FEXPAND_NO_DOTS_UPDIR}
+{$UNDEF FPC_FEXPAND_NO_CURDIR}
+
+{$ENDIF}
+
+function MacTimeToDosPackedTime(macfiletime: UInt32): Longint;
+var
+ mdt: DateTimeRec; {Mac OS datastructure}
+ ddt: Datetime; {Dos OS datastructure}
+ dospackedtime: Longint;
+
+begin
+ SecondsToDate(macfiletime, mdt);
+ with ddt do
+ begin
+ year := mdt.year;
+ month := mdt.month;
+ day := mdt.day;
+ hour := mdt.hour;
+ min := mdt.minute;
+ sec := mdt.second;
+ end;
+ Packtime(ddt, dospackedtime);
+ MacTimeToDosPackedTime:= dospackedtime;
+end;
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+function DosVersion:Word;
+
+begin
+ DosVersion:=
+ (macosSystemVersion and $FF00) or
+ ((macosSystemVersion and $00F0) shr 4);
+end;
+
+procedure GetDate (var year, month, mday, wday: word);
+
+ var
+ d: DateTimeRec;
+
+begin
+ Macostp.GetTime(d);
+ year := d.year;
+ month := d.month;
+ mday := d.day;
+ wday := d.dayOfWeek - 1; {1-based on mac}
+end;
+
+procedure GetTime (var hour, minute, second, sec100: word);
+
+ var
+ d: DateTimeRec;
+
+begin
+ Macostp.GetTime(d);
+ hour := d.hour;
+ minute := d.minute;
+ second := d.second;
+ sec100 := 0;
+end;
+
+Procedure SetDate(Year, Month, Day: Word);
+
+ var
+ d: DateTimeRec;
+
+Begin
+ Macostp.GetTime(d);
+ d.year := year;
+ d.month := month;
+ d.day := day;
+ Macostp.SetTime(d)
+End;
+
+Procedure SetTime(Hour, Minute, Second, Sec100: Word);
+
+ var
+ d: DateTimeRec;
+
+Begin
+ Macostp.GetTime(d);
+ d.hour := hour;
+ d.minute := minute;
+ d.second := second;
+ Macostp.SetTime(d)
+End;
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+{ Create a DoScript AppleEvent that targets the given application with text as the direct object. }
+function CreateDoScriptEvent (applCreator: OSType; scriptText: PChar; var theEvent: AppleEvent): OSErr;
+
+ var
+ err: OSErr;
+ targetAddress: AEDesc;
+ s: signedByte;
+
+begin
+ err := AECreateDesc(FourCharCodeToLongword(typeApplSignature), @applCreator, sizeof(applCreator), targetAddress);
+ if err = noErr then
+ begin
+ err := AECreateAppleEvent(FourCharCodeToLongword('misc'), FourCharCodeToLongword('dosc'),
+ targetAddress, kAutoGenerateReturnID, kAnyTransactionID, theEvent);
+
+ if err = noErr then
+ { Add script text as the direct object parameter. }
+ err := AEPutParamPtr(theEvent, FourCharCodeToLongword('----'),
+ FourCharCodeToLongword('TEXT'), scriptText, Length(scriptText));
+
+ if err <> noErr then
+ AEDisposeDesc(theEvent);
+ AEDisposeDesc(targetAddress);
+ end;
+
+ CreateDoScriptEvent := err;
+end;
+
+Procedure Fpc_WriteBuffer(var f:Text;const b;len:longint);[external name 'FPC_WRITEBUFFER'];
+{declared in text.inc}
+
+procedure WriteAEDescTypeCharToFile(desc: AEDesc; var f: Text);
+
+begin
+ if desc.descriptorType = FourCharCodeToLongword(typeChar) then
+ begin
+ HLock(desc.dataHandle);
+ Fpc_WriteBuffer(f, PChar(desc.dataHandle^)^, GetHandleSize(desc.dataHandle));
+ Flush(f);
+ HUnLock(desc.dataHandle);
+ end;
+end;
+
+function ExecuteToolserverScript(scriptText: PChar; var statusCode: Longint): OSErr;
+
+ var
+ err: OSErr;
+ err2: OSErr; {Non serious error}
+ theEvent: AppleEvent;
+ reply: AppleEvent;
+ result: AEDesc;
+ applFileSpec: FSSpec;
+ p: SignedByte;
+
+ const
+ applCreator = 'MPSX'; {Toolserver}
+
+begin
+ statusCode:= 3; //3 according to MPW.
+ err:= CreateDoScriptEvent (FourCharCodeToLongword(applCreator), scriptText, theEvent);
+ if err = noErr then
+ begin
+ err := AESend(theEvent, reply, kAEWaitReply, kAENormalPriority, kAEDefaultTimeOut, nil, nil);
+
+ if err = connectionInvalid then { Toolserver not available }
+ begin
+ err := FindApplication(FourCharCodeToLongword(applCreator), applFileSpec);
+ if err = noErr then
+ err := LaunchFSSpec(false, applFileSpec);
+ if err = noErr then
+ err := AESend(theEvent, reply, kAEWaitReply, kAENormalPriority, kAEDefaultTimeOut, nil, nil);
+ end;
+
+ if err = noErr then
+ begin
+ err:= AEGetParamDesc(reply, FourCharCodeToLongword('stat'),
+ FourCharCodeToLongword(typeLongInteger), result);
+
+ if err = noErr then
+ if result.descriptorType = FourCharCodeToLongword(typeLongInteger) then
+ statusCode:= LongintPtr(result.dataHandle^)^;
+
+ {If there is no output below, we get a non zero error code}
+
+ err2:= AEGetParamDesc(reply, FourCharCodeToLongword('----'),
+ FourCharCodeToLongword(typeChar), result);
+ if err2 = noErr then
+ WriteAEDescTypeCharToFile(result, stdout);
+
+ err2:= AEGetParamDesc(reply, FourCharCodeToLongword('diag'),
+ FourCharCodeToLongword(typeChar), result);
+ if err2 = noErr then
+ WriteAEDescTypeCharToFile(result, stderr);
+
+ AEDisposeDesc(reply);
+
+ {$IFDEF TARGET_API_MAC_CARBON }
+ {$ERROR FIXME AEDesc data is not allowed to be directly accessed}
+ {$ENDIF}
+ end;
+
+ AEDisposeDesc(theEvent);
+ end;
+
+ ExecuteToolserverScript:= err;
+end;
+
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+var
+ s: AnsiString;
+ err: OSErr;
+ wdpath: AnsiString;
+
+Begin
+ {Make ToolServers working directory in sync with our working directory}
+ PathArgToFullPath(':', wdpath);
+ wdpath:= 'Directory ' + wdpath;
+ err:= ExecuteToolserverScript(PChar(wdpath), LastDosExitCode);
+ {TODO Only change path when actually needed. But this requires some
+ change counter to be incremented each time wd is changed. }
+
+ s:= path + ' ' + comline;
+
+ err:= ExecuteToolserverScript(PChar(s), LastDosExitCode);
+ if err = afpItemNotFound then
+ DosError := 900
+ else
+ DosError := MacOSErr2RTEerr(err);
+ //TODO Better dos error codes
+End;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+{If drive is 0 the free space on the volume of the working directory is returned.
+ If drive is 1 or 2, the free space on the first or second floppy disk is returned.
+ If drive is 3 the free space on the boot volume is returned.
+ If the free space is > 2 GB, then 2 GB is reported.}
+Function DiskFree(drive: Byte): Int64;
+
+var
+ myHPB: HParamBlockRec;
+ myErr: OSErr;
+
+begin
+ myHPB.ioNamePtr := NIL;
+ myHPB.ioVolIndex := 0;
+ case drive of
+ 0: myHPB.ioVRefNum := GetWorkingDirectoryVRefNum;
+ 1: myHPB.ioVRefNum := 1;
+ 2: myHPB.ioVRefNum := 2;
+ 3: myHPB.ioVRefNum := macosBootVolumeVRefNum;
+ else
+ begin
+ Diskfree:= -1;
+ Exit;
+ end;
+ end;
+
+ myErr := PBHGetVInfoSync(@myHPB);
+
+ if myErr = noErr then
+ Diskfree := myHPB.ioVAlBlkSiz * myHPB.ioVFrBlk
+ else
+ Diskfree:= -1;
+End;
+
+{If drive is 0 the size of the volume of the working directory is returned.
+ If drive is 1 or 2, the size of the first or second floppy disk is returned.
+ If drive is 3 the size of the boot volume is returned.
+ If the actual size is > 2 GB, then 2 GB is reported.}
+Function DiskSize(drive: Byte): Int64;
+
+var
+ myHPB: HParamBlockRec;
+ myErr: OSErr;
+
+Begin
+ myHPB.ioNamePtr := NIL;
+ myHPB.ioVolIndex := 0;
+ case drive of
+ 0: myHPB.ioVRefNum := GetWorkingDirectoryVRefNum;
+ 1: myHPB.ioVRefNum := 1;
+ 2: myHPB.ioVRefNum := 2;
+ 3: myHPB.ioVRefNum := macosBootVolumeVRefNum;
+ else
+ begin
+ DiskSize:= -1;
+ Exit;
+ end;
+ end;
+
+ myErr := PBHGetVInfoSync(@myHPB);
+
+ if myErr = noErr then
+ DiskSize := myHPB.ioVAlBlkSiz * myHPB.ioVNmAlBlks
+ else
+ DiskSize:=-1;
+End;
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+(*
+ {The one defined in Unixutils.pp is used instead}
+
+ function FNMatch (const Pattern, Name: string): Boolean;
+
+ var
+ LenPat, LenName: longint;
+
+ function DoFNMatch (i, j: longint): Boolean;
+
+ var
+ Found: boolean;
+
+ begin
+ Found := true;
+ while Found and (i <= LenPat) do
+ begin
+ case Pattern[i] of
+ '?':
+ Found := (j <= LenName);
+ '*':
+ begin
+ {find the next character in pattern, different of ? and *}
+ while Found and (i < LenPat) do
+ begin
+ i := i + 1;
+ case Pattern[i] of
+ '*':
+ ;
+ '?':
+ begin
+ j := j + 1;
+ Found := (j <= LenName);
+ end;
+ otherwise
+ Found := false;
+ end;
+ end;
+ {Now, find in name the character which i points to, if the * or ?}
+ {wasn 't the last character in the pattern, else, use up all the}
+ {chars in name }
+ Found := true;
+ if (i <= LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j <= LenName) and (name[j] <> pattern[i]) do
+ j := j + 1;
+ if (j < LenName) then
+ begin
+ if DoFnMatch(i + 1, j + 1) then
+ begin
+ i := LenPat;
+ j := LenName;{we can stop}
+ Found := true;
+ end
+ else
+ j := j + 1;{We didn't find one, need to look further}
+ end;
+ until (j >= LenName);
+ end
+ else
+ j := LenName;{we can stop}
+ end;
+ otherwise {not a wildcard character in pattern}
+ Found := (j <= LenName) and (pattern[i] = name[j]);
+ end;
+ i := i + 1;
+ j := j + 1;
+ end;
+ DoFnMatch := Found and (j > LenName);
+ end;
+
+ begin {start FNMatch}
+ LenPat := Length(Pattern);
+ LenName := Length(Name);
+ FNMatch := DoFNMatch(1, 1);
+ end;
+
+*)
+
+ function GetFileAttrFromPB (var paramBlock: CInfoPBRec): Word;
+
+ var
+ isLocked, isInvisible, isDirectory, isNameLocked: Boolean;
+ attr: Word;
+
+ {NOTE "nameLocked" was in pre-System 7 called "isSystem".
+ It is used for files whose name and icon cannot be changed by the user,
+ that is essentially system files. However in System 9 the folder
+ "Applications (Mac OS 9)" also has this attribute, and since this is
+ not a system file in traditional meaning, we will not use this attribute
+ as the "sysfile" attribute.}
+
+ begin
+ with paramBlock do
+ begin
+ attr := 0;
+
+ isDirectory := (ioFlAttrib and $10) <> 0;
+ if isDirectory then
+ attr := (attr or directory);
+
+ isLocked := (ioFlAttrib and $01) <> 0;
+ if isLocked then
+ attr := (attr or readonly);
+
+ if not isDirectory then
+ begin
+ isInvisible := (ioFlFndrInfo.fdFlags and 16384) <> 0;
+ (* isNameLocked := (ioFlFndrInfo.fdFlags and 4096) <> 0; *)
+ end
+ else
+ begin
+ isInvisible := (ioDrUsrWds.frFlags and 16384) <> 0;
+ (* isNameLocked := (ioDrUsrWds.frFlags and 4096) <> 0; *)
+ end;
+
+ if isInvisible then
+ attr := (attr or hidden);
+
+ (*
+ if isNameLocked then
+ attr := (attr or sysfile);
+ *)
+
+ GetFileAttrFromPB := attr;
+ end;
+ end;
+
+ procedure SetPBFromFileAttr (var paramBlock: CInfoPBRec; attr: Word);
+
+ begin
+ with paramBlock do
+ begin
+ (*
+ {Doesn't seem to work, despite the documentation.}
+ {Can instead be set by FSpSetFLock/FSpRstFLock}
+ if (attr and readonly) <> 0 then
+ ioFlAttrib := (ioFlAttrib or $01)
+ else
+ ioFlAttrib := (ioFlAttrib and not($01));
+ *)
+
+ if (attr and hidden) <> 0 then
+ ioFlFndrInfo.fdFlags := (ioFlFndrInfo.fdFlags or 16384)
+ else
+ ioFlFndrInfo.fdFlags := (ioFlFndrInfo.fdFlags and not(16384))
+ end;
+ end;
+
+ function GetFileSizeFromPB (var paramBlock: CInfoPBRec): Longint;
+
+ begin
+ with paramBlock do
+ if ((ioFlAttrib and $10) <> 0) then {if directory}
+ GetFileSizeFromPB := 0
+ else
+ GetFileSizeFromPB := ioFlLgLen + ioFlRLgLen; {Add length of both forks}
+ end;
+
+ function DoFindOne (var spec: FSSpec; var paramBlock: CInfoPBRec): Integer;
+
+ var
+ err: OSErr;
+
+ begin
+ with paramBlock do
+ begin
+ ioVRefNum := spec.vRefNum;
+ ioDirID := spec.parID;
+ ioNamePtr := @spec.name;
+ ioFDirIndex := 0;
+
+ err := PBGetCatInfoSync(@paramBlock);
+
+ DoFindOne := MacOSErr2RTEerr(err);
+ end;
+ end;
+
+ {To be used after a call to DoFindOne, with the same spec and paramBlock.}
+ {Change those parameters in paramBlock, which is to be changed.}
+ function DoSetOne (var spec: FSSpec; var paramBlock: CInfoPBRec): Integer;
+
+ var
+ err: OSErr;
+
+ begin
+ with paramBlock do
+ begin
+ ioVRefNum := spec.vRefNum;
+ ioDirID := spec.parID;
+ ioNamePtr := @spec.name;
+
+ err := PBSetCatInfoSync(@paramBlock);
+
+ DoSetOne := MacOSErr2RTEerr(err);
+ end;
+ end;
+
+ procedure DoFind (var F: SearchRec; firstTime: Boolean);
+
+ var
+ err: OSErr;
+ s: Str255;
+
+ begin
+ with F, paramBlock do
+ begin
+ ioVRefNum := searchFSSpec.vRefNum;
+ if firstTime then
+ ioFDirIndex := 0;
+
+ while true do
+ begin
+ s := '';
+ ioDirID := searchFSSpec.parID;
+ ioFDirIndex := ioFDirIndex + 1;
+ ioNamePtr := @s;
+
+ err := PBGetCatInfoSync(@paramBlock);
+
+ if err <> noErr then
+ begin
+ if err = fnfErr then
+ DosError := 18
+ else
+ DosError := MacOSErr2RTEerr(err);
+ break;
+ end;
+
+ attr := GetFileAttrFromPB(f.paramBlock);
+ if ((Attr and not(searchAttr)) = 0) then
+ begin
+ name := s;
+ UpperString(s, true);
+
+ if FNMatch(F.searchFSSpec.name, s) then
+ begin
+ size := GetFileSizeFromPB(paramBlock);
+ time := MacTimeToDosPackedTime(ioFlMdDat);
+ DosError := 0;
+ break;
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ procedure FindFirst (const path: pathstr; Attr: Word; var F: SearchRec);
+ var
+ s: Str255;
+
+ begin
+ fillchar(f, sizeof(f), 0);
+
+ if path = '' then
+ begin
+ DosError := 3;
+ Exit;
+ end;
+
+ {We always also search for readonly and archive, regardless of Attr.}
+ F.searchAttr := (Attr or (archive or readonly));
+
+ DosError := PathArgToFSSpec(path, F.searchFSSpec);
+ with F do
+ if (DosError = 0) or (DosError = 2) then
+ begin
+ SearchSpec := path;
+ NamePos := Length(path) - Length(searchFSSpec.name);
+
+ if (Pos('?', searchFSSpec.name) = 0) and (Pos('*', searchFSSpec.name) = 0) then {No wildcards}
+ begin {If exact match, we don't have to scan the directory}
+ exactMatch := true;
+ DosError := DoFindOne(searchFSSpec, paramBlock);
+ if DosError = 0 then
+ begin
+ Attr := GetFileAttrFromPB(paramBlock);
+ if ((Attr and not(searchAttr)) = 0) then
+ begin
+ name := searchFSSpec.name;
+ size := GetFileSizeFromPB(paramBlock);
+ time := MacTimeToDosPackedTime(paramBlock.ioFlMdDat);
+ end
+ else
+ DosError := 18;
+ end
+ else if DosError = 2 then
+ DosError := 18;
+ end
+ else
+ begin
+ exactMatch := false;
+
+ s := searchFSSpec.name;
+ UpperString(s, true);
+ F.searchFSSpec.name := s;
+
+ DoFind(F, true);
+ end;
+ end;
+ end;
+
+ procedure FindNext (var f: searchRec);
+
+ begin
+ if F.exactMatch then
+ DosError := 18
+ else
+ DoFind(F, false);
+ end;
+
+ procedure FindClose (var f: searchRec);
+ {Note: Even if this routine is empty, this doesn't mean it will}
+ {be empty in the future. Please use it.}
+ begin
+ end;
+
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+ function FSearch (path: pathstr; dirlist: string): pathstr;
+ {Searches for a file 'path' in the working directory and then in the list of }
+ {directories in 'dirlist' . Returns a valid (possibly relative) path or an }
+ {empty string if not found . Wildcards are NOT allowed }
+ {The dirlist can be separated with ; or , but not :}
+
+ var
+ NewDir: string[255];
+ p1: Longint;
+ spec: FSSpec;
+ fpcerr: Integer;
+
+ begin
+ FSearch := '';
+ if (Length(path) = 0) then
+ Exit;
+
+ {Check for Wild Cards}
+ if (Pos('?', Path) <> 0) or (Pos('*', Path) <> 0) then
+ Exit;
+
+ if pathTranslation then
+ path := TranslatePathToMac(path, false);
+
+ {Search in working directory, or as full path}
+ fpcerr := PathArgToFSSpec(path, spec);
+ if (fpcerr = 0) and not IsDirectory(spec) then
+ begin
+ FSearch := path;
+ Exit;
+ end
+ else if not IsMacFullPath(path) then {If full path, we do not need to continue.}
+ begin
+ {Replace ';' with native mac PathSeparator (',').}
+ {Note: we cannot support unix style ':', because it is used as dir separator in MacOS}
+ for p1 := 1 to length(dirlist) do
+ if dirlist[p1] = ';' then
+ dirlist[p1] := PathSeparator;
+
+ repeat
+ p1 := Pos(PathSeparator, DirList);
+ if p1 = 0 then
+ p1 := 255;
+
+ if pathTranslation then
+ NewDir := TranslatePathToMac(Copy(DirList, 1, P1 - 1), false)
+ else
+ NewDir := Copy(DirList, 1, P1 - 1);
+
+ NewDir := ConcatMacPath(NewDir, Path);
+
+ Delete(DirList, 1, p1);
+
+ fpcerr := PathArgToFSSpec(NewDir, spec);
+ if fpcerr = 0 then
+ begin
+ if IsDirectory(spec) then
+ NewDir := '';
+ end
+ else
+ NewDir := '';
+ until (DirList = '') or (Length(NewDir) > 0);
+ FSearch := NewDir;
+ end;
+ end;
+
+{$IFNDEF USE_FEXPAND_INC}
+
+{ TODO nonexisting dirs in path's doesnt work (nonexisting files do work)
+ example: Writeln('FExpand on :nisse:kalle : ', FExpand(':nisse:kalle')); }
+
+ function FExpand (const path: pathstr): pathstr;
+ var
+ fullpath: AnsiString;
+ begin
+ DosError:= PathArgToFullPath(path, fullpath);
+ FExpand:= fullpath;
+ end;
+
+{$ENDIF USE_FEXPAND_INC}
+
+
+ procedure GetFTime (var f ; var time: longint);
+
+ var
+ spec: FSSpec;
+ paramBlock: CInfoPBRec;
+
+ begin
+ DosError := PathArgToFSSpec(StrPas(filerec(f).name), spec);
+ if (DosError = 0) or (DosError = 2) then
+ begin
+ DosError := DoFindOne(spec, paramBlock);
+ if DosError = 0 then
+ time := MacTimeToDosPackedTime(paramBlock.ioFlMdDat);
+ end;
+ end;
+
+ procedure SetFTime (var f ; time: longint);
+
+ var
+ spec: FSSpec;
+ paramBlock: CInfoPBRec;
+ d: DateTimeRec; {Mac OS datastructure}
+ t: datetime;
+ macfiletime: UInt32;
+
+ begin
+ DosError := PathArgToFSSpec(StrPas(filerec(f).name), spec);
+ if (DosError = 0) or (DosError = 2) then
+ begin
+ DosError := DoFindOne(spec, paramBlock);
+ if DosError = 0 then
+ begin
+ Unpacktime(time, t);
+ with t do
+ begin
+ d.year := year;
+ d.month := month;
+ d.day := day;
+ d.hour := hour;
+ d.minute := min;
+ d.second := sec;
+ end;
+ DateToSeconds(d, macfiletime);
+ paramBlock.ioFlMdDat := macfiletime;
+ DosError := DoSetOne(spec, paramBlock);
+ end;
+ end;
+ end;
+
+ procedure GetFAttr (var f ; var attr: word);
+
+ var
+ spec: FSSpec;
+ paramBlock: CInfoPBRec;
+
+ begin
+ DosError := PathArgToFSSpec(StrPas(filerec(f).name), spec);
+ if (DosError = 0) or (DosError = 2) then
+ begin
+ DosError := DoFindOne(spec, paramBlock);
+ if DosError = 0 then
+ attr := GetFileAttrFromPB(paramBlock);
+ end;
+ end;
+
+ procedure SetFAttr (var f ; attr: word);
+
+ var
+ spec: FSSpec;
+ paramBlock: CInfoPBRec;
+
+ begin
+ if (attr and VolumeID) <> 0 then
+ begin
+ Doserror := 5;
+ Exit;
+ end;
+
+ DosError := PathArgToFSSpec(StrPas(filerec(f).name), spec);
+ if (DosError = 0) or (DosError = 2) then
+ begin
+ DosError := DoFindOne(spec, paramBlock);
+ if DosError = 0 then
+ begin
+ SetPBFromFileAttr(paramBlock, attr);
+ DosError := DoSetOne(spec, paramBlock);
+
+ if (paramBlock.ioFlAttrib and $10) = 0 then {check not directory}
+ if DosError = 0 then
+ if (attr and readonly) <> 0 then
+ DosError := MacOSErr2RTEerr(FSpSetFLock(spec))
+ else
+ DosError := MacOSErr2RTEerr(FSpRstFLock(spec));
+ end;
+ end;
+ end;
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+Function EnvCount: Longint;
+var
+ envcnt : longint;
+ p : ppchar;
+Begin
+ envcnt:=0;
+ p:=envp; {defined in system}
+ while (p^<>nil) do
+ begin
+ inc(envcnt);
+ inc(p);
+ end;
+ EnvCount := envcnt
+End;
+
+
+Function EnvStr (Index: longint): String;
+
+Var
+ i : longint;
+ p : ppchar;
+Begin
+ if Index <= 0 then
+ envstr:=''
+ else
+ begin
+ p:=envp; {defined in system}
+ i:=1;
+ while (i<Index) and (p^<>nil) do
+ begin
+ inc(i);
+ inc(p);
+ end;
+ if p=nil then
+ envstr:=''
+ else
+ envstr:=strpas(p^) + '=' + strpas(p^+strlen(p^)+1);
+ end;
+end;
+
+
+function c_getenv(varname: PChar): PChar; {TODO perhaps move to a separate inc file.}
+ external 'StdCLib' name 'getenv';
+
+Function GetEnv(EnvVar: String): String;
+var
+ p: PChar;
+ name: String;
+Begin
+ name:= EnvVar+#0;
+ p:= c_getenv(@name[1]);
+ if p=nil then
+ GetEnv:=''
+ else
+ GetEnv:=StrPas(p);
+End;
+
+{
+Procedure GetCBreak(Var BreakValue: Boolean);
+Begin
+-- Might be implemented in future on MacOS to handle Cmd-. (period) key press
+End;
+
+Procedure SetCBreak(BreakValue: Boolean);
+Begin
+-- Might be implemented in future on MacOS to handle Cmd-. (period) key press
+End;
+
+Procedure GetVerify(Var Verify: Boolean);
+Begin
+-- Might be implemented in future on MacOS
+End;
+
+Procedure SetVerify(Verify: Boolean);
+Begin
+-- Might be implemented in future on MacOS
+End;
+}
+
+
+{******************************************************************************
+ --- Initialization ---
+******************************************************************************}
+
+End.
diff --git a/rtl/macos/macos.pp b/rtl/macos/macos.pp
new file mode 100644
index 0000000000..aaf4f1a7f4
--- /dev/null
+++ b/rtl/macos/macos.pp
@@ -0,0 +1,181 @@
+{$MODE MACPAS}
+unit MacOS;
+
+{API to Mac OS}
+{This unit include (almost) all units available for classic Mac OS (non-Caron).
+ Note that some units not present below, might be indirectly included.}
+
+interface
+
+{$SETC UsingIncludes:= 1}
+
+{$IFC UNDEFINED __BALLOONS__}
+{$I Balloons.p}
+{$ENDC}
+
+{$IFC UNDEFINED __EVENTS__}
+{$I Events.p}
+{$ENDC}
+
+{$IFC UNDEFINED __PROCESSES__}
+{$I Processes.p}
+{$ENDC}
+
+{$IFC UNDEFINED __NOTIFICATION__}
+{$I Notification.p}
+{$ENDC}
+
+{$IFC UNDEFINED __DRAG__}
+{$I Drag.p}
+{$ENDC}
+
+{$IFC UNDEFINED __ICONS__}
+{$I Icons.p}
+{$ENDC}
+
+{$IFC UNDEFINED __CONTROLS__}
+{$I Controls.p}
+{$ENDC}
+
+{$IFC UNDEFINED __APPEARANCE__}
+{$I Appearance.p}
+{$ENDC}
+
+{$IFC UNDEFINED __MACWINDOWS__}
+{$I MacWindows.p}
+{$ENDC}
+
+{$IFC UNDEFINED __TEXTEDIT__}
+{$I TextEdit.p}
+{$ENDC}
+
+{$IFC UNDEFINED __MENUS__}
+{$I Menus.p}
+{$ENDC}
+
+{$IFC UNDEFINED __DIALOGS__}
+{$I Dialogs.p}
+{$ENDC}
+
+{$IFC UNDEFINED __LISTS__}
+{$I Lists.p}
+{$ENDC}
+
+{$IFC UNDEFINED __TEXTSERVICES__}
+{$I TextServices.p}
+{$ENDC}
+
+{$IFC UNDEFINED __SCRAP__}
+{$I Scrap.p}
+{$ENDC}
+
+{$IFC UNDEFINED __MACTEXTEDITOR__}
+{$I MacTextEditor.p}
+{$ENDC}
+
+{$IFC UNDEFINED __CONTROLDEFINITIONS__}
+{$I ControlDefinitions.p}
+{$ENDC}
+
+{$IFC UNDEFINED __TSMTE__}
+{$I TSMTE.p}
+{$ENDC}
+
+{$IFC UNDEFINED __TRANSLATIONEXTENSIONS__}
+{$I TranslationExtensions.p}
+{$ENDC}
+
+{$IFC UNDEFINED __TRANSLATION__}
+{$I Translation.p}
+{$ENDC}
+
+{$IFC UNDEFINED __AEINTERACTION__}
+{$I AEInteraction.p}
+{$ENDC}
+
+{$IFC UNDEFINED __TYPESELECT__}
+{$I TypeSelect.p}
+{$ENDC}
+
+{$IFC UNDEFINED __INTERNETCONFIG__}
+{$I InternetConfig.p}
+{$ENDC}
+
+{$IFC UNDEFINED __KEYBOARDS__}
+{$I Keyboards.p}
+{$ENDC}
+
+{$IFC UNDEFINED __SOUND__}
+{$I Sound.p}
+{$ENDC}
+
+{$IFC UNDEFINED __OSA__}
+{$I OSA.p}
+{$ENDC}
+
+{$IFC UNDEFINED __OSACOMP__}
+{$I OSAComp.p}
+{$ENDC}
+
+{$IFC UNDEFINED __OSAGENERIC__}
+{$I OSAGeneric.p}
+{$ENDC}
+
+{$IFC UNDEFINED __APPLESCRIPT__}
+{$I AppleScript.p}
+{$ENDC}
+
+{$IFC UNDEFINED __ASDEBUGGING__}
+{$I ASDebugging.p}
+{$ENDC}
+
+{$IFC UNDEFINED __ASREGISTRY__}
+{$I ASRegistry.p}
+{$ENDC}
+
+{$IFC UNDEFINED __FINDERREGISTRY__}
+{$I FinderRegistry.p}
+{$ENDC}
+
+{$IFC UNDEFINED __NAVIGATION__}
+{$I Navigation.p}
+{$ENDC}
+
+{$IFC UNDEFINED __URLACCESS__}
+{$I URLAccess.p}
+{$ENDC}
+
+{$IFC UNDEFINED __COLORPICKER__}
+{$I ColorPicker.p}
+{$ENDC}
+
+{$IFC UNDEFINED __CMCALIBRATOR__}
+{$I CMCalibrator.p}
+{$ENDC}
+
+{$IFC UNDEFINED __HTMLRENDERING__}
+{$I HTMLRendering.p}
+{$ENDC}
+
+{$IFC UNDEFINED __SPEECHRECOGNITION__}
+{$I SpeechRecognition.p}
+{$ENDC}
+
+{$IFC UNDEFINED __KEYCHAINHI__}
+{$I KeychainHI.p}
+{$ENDC}
+
+{$IFC UNDEFINED __ICAAPPLICATION__}
+{$I ICAApplication.p}
+{$ENDC}
+
+{$IFC UNDEFINED __OCADEVICE__}
+{$I ICADevice.p}
+{$ENDC}
+
+{$IFC UNDEFINED __ICACAMERA__}
+{$I ICACamera.p}
+{$ENDC}
+
+implementation
+end.
diff --git a/rtl/macos/macostp.inc b/rtl/macos/macostp.inc
new file mode 100644
index 0000000000..23ac49e29e
--- /dev/null
+++ b/rtl/macos/macostp.inc
@@ -0,0 +1,1390 @@
+{
+ $Id: macostp.inc,v 1.13 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 - 2004 by Olle Raab
+
+ A selection of the MacOS API for FreePascal, written
+ in the Turbo Pascal dialect.
+ It is primarily for internal use in the rtl, please
+ do not expect it to remain the same over time,
+ it will be subject to changes.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Note: Types like Mac_XXX corresponds to the type XXX defined
+in MacOS Universal Headers. The prefix is to avoid name clashes
+with FPC types.}
+
+{For a future possiblity of compiling the RTL under Carbon,
+ sections containing Carbon only code should be under
+ ifdef TARGET_API_MAC_CARBON, at the moment it is always undefinded: }
+
+{$UNDEF TARGET_API_MAC_CARBON }
+
+{$IFDEF TARGET_API_MAC_CARBON }
+{$DEFINE OPAQUE_TOOLBOX_STRUCTS }
+{$ENDIF}
+
+{$PACKRECORDS 2} {Alignment inherited from the m68k days}
+
+{************** from Types.p ***************}
+const
+ noErr = 0;
+
+type
+ SignedByte = shortint;
+ SignedBytePtr = ^SignedByte;
+
+ SInt8 = -128..127;
+ SInt16 = INTEGER;
+ SInt32 = LONGINT;
+ UInt8 = 0..255;
+ UInt16 = WORD;
+ UInt32 = LONGWORD;
+
+ IntegerPtr = ^INTEGER;
+ LongIntPtr = ^LONGINT;
+
+ OSErr = Integer;
+
+ FourCharCode = Longword;
+
+ OSType = FourCharCode;
+ ResType = FourCharCode;
+ Mac_Ptr = pointer;
+ Mac_Handle = ^Mac_Ptr;
+ Str31 = string[31];
+ Str32 = string[32];
+ Str63 = string[63];
+ Str255 = string[255];
+ StringPtr = ^Str255;
+ ProcPtr = Mac_Ptr;
+ UniversalProcPtr = ProcPtr;
+
+ ScriptCode = INTEGER;
+
+ LangCode = INTEGER;
+
+ Point = record
+ case INTEGER of
+ 0: (
+ v: INTEGER;
+ h: INTEGER;
+ );
+ 1: (
+ vh: array[0..1] of INTEGER;
+ );
+ end;
+
+ PointPtr = ^Point;
+
+ Rect = record
+ case INTEGER of
+ 0: (
+ top: INTEGER;
+ left: INTEGER;
+ bottom: INTEGER;
+ right: INTEGER;
+ );
+ 1: (
+ topLeft: Point;
+ botRight: Point;
+ );
+ end;
+
+ RectPtr = ^Rect;
+
+procedure Debugger;
+external 'InterfaceLib';
+
+procedure DebugStr(s: Str255);
+external 'InterfaceLib';
+
+{************** from Memory.p ***************}
+
+type
+ Size = Longint;
+
+function NewHandle (byteCount: Size): Mac_Handle;
+external 'InterfaceLib';
+
+function NewPtr(logicalSize: Size): Mac_Ptr ;
+external 'InterfaceLib';
+
+procedure DisposePtr (p: Mac_Ptr);
+external 'InterfaceLib';
+function GetPtrSize (p: Mac_Ptr): Size;
+external 'InterfaceLib';
+procedure SetPtrSize (p: Mac_Ptr; newSize: Size);
+external 'InterfaceLib';
+procedure DisposeHandle (h: Mac_Handle);
+external 'InterfaceLib';
+procedure SetHandleSize (h: Mac_Handle; newSize: Size);
+external 'InterfaceLib';
+function GetHandleSize (h: Mac_Handle): Size;
+external 'InterfaceLib';
+
+function Mac_FreeMem: Longint;
+external 'InterfaceLib' name 'FreeMem';
+PROCEDURE MaxApplZone;
+external 'InterfaceLib';
+PROCEDURE HLock(h: Mac_Handle);
+external 'InterfaceLib';
+PROCEDURE HUnlock(h: Mac_Handle);
+external 'InterfaceLib';
+function MemError: OSErr;
+external 'InterfaceLib';
+
+{************** from GestaltEqu.p ***************}
+FUNCTION Gestalt(selector: OSType; VAR response: LONGINT): OSErr;
+external 'InterfaceLib' name 'Gestalt';
+
+const
+ { Gestalt selector and values for the Appearance Manager }
+ gestaltAliasMgrAttr = 'alis'; { Alias Mgr Attributes }
+ gestaltAliasMgrPresent = 0; { True if the Alias Mgr is present }
+ gestaltAliasMgrSupportsRemoteAppletalk = 1; { True if the Alias Mgr knows about Remote Appletalk }
+ gestaltAliasMgrSupportsAOCEKeychain = 2; { True if the Alias Mgr knows about the AOCE Keychain }
+ gestaltAliasMgrResolveAliasFileWithMountOptions = 3; { True if the Alias Mgr implements gestaltAliasMgrResolveAliasFileWithMountOptions() and IsAliasFile() }
+ gestaltAliasMgrFollowsAliasesWhenResolving = 4;
+ gestaltAliasMgrSupportsExtendedCalls = 5;
+ gestaltAliasMgrSupportsFSCalls = 6; { true if Alias Mgr supports HFS+ Calls }
+
+ gestaltAppearanceAttr = 'appr';
+ gestaltAppearanceExists = 0;
+ gestaltAppearanceCompatMode = 1;
+
+ { Gestalt selector for determining Appearance Manager version }
+ { If this selector does not exist, but gestaltAppearanceAttr }
+ { does, it indicates that the 1.0 version is installed. This }
+ { gestalt returns a BCD number representing the version of the }
+ { Appearance Manager that is currently running, e.g. 0x0101 for }
+ { version 1.0.1. }
+ gestaltAppearanceVersion = 'apvr';
+
+ gestaltCFMAttr = 'cfrg'; { Selector for information about the Code Fragment Manager }
+ gestaltCFMPresent = 0; { True if the Code Fragment Manager is present }
+ gestaltCFMPresentMask = $0001;
+ gestaltCFM99Present = 2; { True if the CFM-99 features are present. }
+ gestaltCFM99PresentMask = $0004;
+
+ gestaltAppleEventsAttr = 'evnt'; { Apple Events attributes }
+ gestaltAppleEventsPresent = 0; { True if Apple Events present }
+ gestaltScriptingSupport = 1;
+ gestaltOSLInSystem = 2; { OSL is in system so donÕt use the one linked in to app }
+
+ gestaltFindFolderAttr = 'fold'; { Folder Mgr attributes }
+ gestaltFindFolderPresent = 0; { True if Folder Mgr present }
+ gestaltFolderDescSupport = 1; { True if Folder Mgr has FolderDesc calls }
+ gestaltFolderMgrFollowsAliasesWhenResolving = 2; { True if Folder Mgr follows folder aliases }
+ gestaltFolderMgrSupportsExtendedCalls = 3; { True if Folder Mgr supports the Extended calls }
+ gestaltFolderMgrSupportsDomains = 4; { True if Folder Mgr supports domains for the first parameter to FindFolder }
+ gestaltFolderMgrSupportsFSCalls = 5; { True if FOlder manager supports __FindFolderFSRef & __FindFolderExtendedFSRef }
+
+ gestaltFPUType = 'fpu '; { fpu type }
+ gestaltNoFPU = 0; { no FPU }
+ gestalt68881 = 1; { 68881 FPU }
+ gestalt68882 = 2; { 68882 FPU }
+ gestalt68040FPU = 3; { 68040 built-in FPU }
+
+ gestaltFSAttr = 'fs '; { file system attributes }
+ gestaltFullExtFSDispatching = 0; { has really cool new HFSDispatch dispatcher }
+ gestaltHasFSSpecCalls = 1; { has FSSpec calls }
+ gestaltHasFileSystemManager = 2; { has a file system manager }
+ gestaltFSMDoesDynamicLoad = 3; { file system manager supports dynamic loading }
+ gestaltFSSupports4GBVols = 4; { file system supports 4 gigabyte volumes }
+ gestaltFSSupports2TBVols = 5; { file system supports 2 terabyte volumes }
+ gestaltHasExtendedDiskInit = 6; { has extended Disk Initialization calls }
+ gestaltDTMgrSupportsFSM = 7; { Desktop Manager support FSM-based foreign file systems }
+ gestaltFSNoMFSVols = 8; { file system doesn't supports MFS volumes }
+ gestaltFSSupportsHFSPlusVols = 9; { file system supports HFS Plus volumes }
+ gestaltFSIncompatibleDFA82 = 10; { VCB and FCB structures changed; DFA 8.2 is incompatible }
+
+ gestaltHasHFSPlusAPIs = 12; { file system supports HFS Plus APIs }
+ gestaltMustUseFCBAccessors = 13; { FCBSPtr and FSFCBLen are invalid - must use FSM FCB accessor functions }
+ gestaltFSUsesPOSIXPathsForConversion = 14; { The path interchange routines operate on POSIX paths instead of HFS paths }
+
+ gestaltOSAttr = 'os '; { o/s attributes }
+ gestaltSysZoneGrowable = 0; { system heap is growable }
+ gestaltLaunchCanReturn = 1; { can return from launch }
+ gestaltLaunchFullFileSpec = 2; { can launch from full file var spec }
+ gestaltLaunchControl = 3; { launch control support available }
+ gestaltTempMemSupport = 4; { temp memory support }
+ gestaltRealTempMemory = 5; { temp memory handles are real }
+ gestaltTempMemTracked = 6; { temporary memory handles are tracked }
+ gestaltIPCSupport = 7; { IPC support is present }
+ gestaltSysDebuggerSupport = 8; { system debugger support is present }
+ gestaltNativeProcessMgrBit = 19; { the process manager itself is native }
+
+ gestaltQuickdrawVersion = 'qd '; { quickdraw version }
+ gestaltOriginalQD = $0000; { original 1-bit QD }
+ gestalt8BitQD = $0100; { 8-bit color QD }
+ gestalt32BitQD = $0200; { 32-bit color QD }
+ gestalt32BitQD11 = $0201; { 32-bit color QDv1.1 }
+ gestalt32BitQD12 = $0220; { 32-bit color QDv1.2 }
+ gestalt32BitQD13 = $0230; { 32-bit color QDv1.3 }
+ gestaltAllegroQD = $0250; { Allegro QD OS 8.5 }
+ gestaltMacOSXQD = $0300; { Mac OS X QD }
+ gestaltScriptMgrVersion = 'scri'; { Script Manager version number }
+ gestaltScriptCount = 'scr#'; { number of active script systems }
+
+ gestaltStandardFileAttr = 'stdf'; { Standard File attributes }
+ gestaltStandardFile58 = 0; { True if selectors 5-8 (StandardPutFile-CustomGetFile) are supported }
+ gestaltStandardFileTranslationAware = 1; { True if standard file is translation manager aware }
+ gestaltStandardFileHasColorIcons = 2; { True if standard file has 16x16 color icons }
+ gestaltStandardFileUseGenericIcons = 3; { Standard file LDEF to use only the system generic icons if true }
+ gestaltStandardFileHasDynamicVolumeAllocation = 4; { True if standard file supports more than 20 volumes }
+
+ gestaltSystemVersion = 'sysv'; { system version }
+
+ gestaltThreadMgrAttr = 'thds'; { Thread Manager attributes }
+ gestaltThreadMgrPresent = 0; { bit true if Thread Mgr is present }
+ gestaltSpecificMatchSupport = 1; { bit true if Thread Mgr supports exact match creation option }
+ gestaltThreadsLibraryPresent = 2; { bit true if Thread Mgr shared library is present }
+
+
+{************** from OSUtils.p ***************}
+
+type
+ QElemPtr = ^QElem;
+
+ QElem = record
+ qLink: QElemPtr;
+ qType: INTEGER;
+ qData: array[0..0] of INTEGER;
+ end;
+
+CONST
+ curSysEnvVers = 2; { Updated to equal latest SysEnvirons version }
+
+TYPE
+ SysEnvRecPtr = ^SysEnvRec;
+ SysEnvRec = RECORD
+ environsVersion: INTEGER;
+ machineType: INTEGER;
+ systemVersion: INTEGER;
+ processor: INTEGER;
+ hasFPU: BOOLEAN;
+ hasColorQD: BOOLEAN;
+ keyBoardType: INTEGER;
+ atDrvrVersNum: INTEGER;
+ sysVRefNum: INTEGER;
+ END;
+
+FUNCTION SysEnvirons(versionRequested: INTEGER; VAR theWorld: SysEnvRec): OSErr;
+external 'InterfaceLib';
+
+{************** from Finder.p ***************}
+
+ type
+ FInfo = record
+ fdType: OSType; {the type of the file}
+ fdCreator: OSType; {file's creator}
+ fdFlags: INTEGER; {flags ex. hasbundle,invisible,locked, etc.}
+ fdLocation: Point; {file's location in folder}
+ fdFldr: INTEGER; {folder containing file}
+ end;
+
+ FXInfo = record
+ fdIconID: INTEGER; {Icon ID}
+ fdUnused: array[0..2] of INTEGER; {unused but reserved 6 bytes}
+ fdScript: SInt8; {Script flag and number}
+ fdXFlags: SInt8; {More flag bits}
+ fdComment: INTEGER; {Comment ID}
+ fdPutAway: LONGINT; {Home Dir ID}
+ end;
+
+ DInfo = record
+ frRect: Rect; {folder rect}
+ frFlags: INTEGER; {Flags}
+ frLocation: Point; {folder location}
+ frView: INTEGER; {folder view}
+ end;
+
+ DXInfo = record
+ frScroll: Point; {scroll position}
+ frOpenChain: LONGINT; {DirID chain of open folders}
+ frScript: SInt8; {Script flag and number}
+ frXFlags: SInt8; {More flag bits}
+ frComment: INTEGER; {comment}
+ frPutAway: LONGINT; {DirID}
+ end;
+
+{************** from Files.p ***************}
+
+const
+ fsAtMark = 0;
+ fsCurPerm = 0;
+ fsRdPerm = 1;
+ fInvisible = 16384;
+ fsWrPerm = 2;
+ fsRdWrPerm = 3;
+ fsRdWrShPerm = 4;
+ fsFromStart = 1;
+ fsFromLEOF = 2;
+ fsFromMark = 3;
+ rdVerify = 64;
+ ioMapBuffer = 4;
+ ioModeReserved = 8;
+ ioDirFlg = 4; { see IM IV-125 }
+ ioDirMask = $10;
+ fsRtParID = 1;
+ fsRtDirID = 2;
+
+type
+ CatPositionRecPtr = ^CatPositionRec;
+ CatPositionRec = RECORD
+ initialize: LONGINT;
+ priv: ARRAY [1..6] OF INTEGER;
+ END;
+
+ FSSpec = record
+ vRefNum: Integer;
+ parID: Longint;
+ name: Str63;
+ end;
+ FSSpecPtr = ^FSSpec;
+
+ ParmBlkPtr = ^ParamBlockRec;
+
+ IOCompletionUPP = UniversalProcPtr;
+
+ ParamBlockRecPtr = ^ParamBlockRec;
+ ParamBlockRec = RECORD
+ qLink: QElemPtr; { queue link in header }
+ qType: INTEGER; { type byte for safety check }
+ ioTrap: INTEGER; { FS: the Trap }
+ ioCmdAddr: Mac_Ptr; { FS: address to dispatch to }
+ ioCompletion: IOCompletionUPP; { completion routine addr (0 for synch calls) }
+ ioResult: OSErr; { result code }
+ ioNamePtr: StringPtr; { ptr to Vol:FileName string }
+ ioVRefNum: INTEGER; { volume refnum (DrvNum for Eject and MountVol) }
+ CASE INTEGER OF
+ 0: (
+ ioRefNum: INTEGER; { refNum for I/O operation }
+ ioVersNum: SInt8; { version number }
+ ioPermssn: SInt8; { Open: permissions (byte) }
+ ioMisc: Mac_Ptr; { Rename: new name (GetEOF,SetEOF: logical end of file) (Open: optional ptr to buffer) (SetFileType: new type) }
+ ioBuffer: Mac_Ptr; { data buffer Ptr }
+ ioReqCount: LONGINT; { requested byte count; also = ioNewDirID }
+ ioActCount: LONGINT; { actual byte count completed }
+ ioPosMode: INTEGER; { initial file positioning }
+ ioPosOffset: LONGINT; { file position offset }
+ );
+ 1: (
+ ioFRefNum: INTEGER; { reference number }
+ ioFVersNum: SInt8; { version number }
+ filler1: SInt8;
+ ioFDirIndex: INTEGER; { GetFInfo directory index }
+ ioFlAttrib: SInt8; { GetFInfo: in-use bit=7, lock bit=0 }
+ ioFlVersNum: SInt8; { file version number }
+ ioFlFndrInfo: FInfo; { user info }
+ ioFlNum: UInt32; { GetFInfo: file number; TF- ioDirID }
+ ioFlStBlk: UInt16; { start file block (0 if none) }
+ ioFlLgLen: LONGINT; { logical length (EOF) }
+ ioFlPyLen: LONGINT; { physical length }
+ ioFlRStBlk: UInt16; { start block rsrc fork }
+ ioFlRLgLen: LONGINT; { file logical length rsrc fork }
+ ioFlRPyLen: LONGINT; { file physical length rsrc fork }
+ ioFlCrDat: UInt32; { file creation date& time (32 bits in secs) }
+ ioFlMdDat: UInt32; { last modified date and time }
+ );
+ 2: (
+ filler2: LONGINT;
+ ioVolIndex: INTEGER; { volume index number }
+ ioVCrDate: UInt32; { creation date and time }
+ ioVLsBkUp: UInt32; { last backup date and time }
+ ioVAtrb: UInt16; { volume attrib }
+ ioVNmFls: UInt16; { number of files in directory }
+ ioVDirSt: UInt16; { start block of file directory }
+ ioVBlLn: INTEGER; { GetVolInfo: length of dir in blocks }
+ ioVNmAlBlks: UInt16; { for compatibilty ioVNmAlBlks * ioVAlBlkSiz <= 2 GB }
+ ioVAlBlkSiz: UInt32; { for compatibilty ioVAlBlkSiz is <= $0000FE00 (65,024) }
+ ioVClpSiz: UInt32; { GetVolInfo: bytes to allocate at a time }
+ ioAlBlSt: UInt16; { starting disk(512-byte) block in block map }
+ ioVNxtFNum: UInt32; { GetVolInfo: next free file number }
+ ioVFrBlk: UInt16; { GetVolInfo: # free alloc blks for this vol }
+ );
+ 3: (
+ ioCRefNum: INTEGER; { refNum for I/O operation }
+ csCode: INTEGER; { word for control status code }
+ csParam: ARRAY [0..10] OF INTEGER; { operation-defined parameters }
+ );
+ 4: (
+ ioSRefNum: INTEGER;
+ ioSVersNum: SInt8;
+ ioSPermssn: SInt8;
+ ioSMix: Mac_Ptr;
+ ioSFlags: INTEGER;
+ ioSlot: SInt8;
+ ioID: SInt8;
+ );
+ 5: (
+ ioMRefNum: INTEGER;
+ ioMVersNum: SInt8;
+ ioMPermssn: SInt8;
+ ioMMix: Mac_Ptr;
+ ioMFlags: INTEGER;
+ ioSEBlkPtr: Mac_Ptr;
+ );
+ END;
+
+ CInfoPBRecPtr = ^CInfoPBRec;
+
+ CInfoPBRec = record
+ qLink: QElemPtr;
+ qType: INTEGER;
+ ioTrap: INTEGER;
+ ioCmdAddr: Mac_Ptr;
+ ioCompletion: IOCompletionUPP;
+ ioResult: OSErr;
+ ioNamePtr: StringPtr;
+ ioVRefNum: INTEGER;
+ ioFRefNum: INTEGER;
+ ioFVersNum: SInt8;
+ filler1: SInt8;
+ ioFDirIndex: INTEGER;
+ ioFlAttrib: SInt8;
+ ioACUser: SInt8;
+ case INTEGER of
+ 0: (
+ ioFlFndrInfo: FInfo;
+ ioDirID: LONGINT;
+ ioFlStBlk: INTEGER;
+ ioFlLgLen: LONGINT;
+ ioFlPyLen: LONGINT;
+ ioFlRStBlk: INTEGER;
+ ioFlRLgLen: LONGINT;
+ ioFlRPyLen: LONGINT;
+ ioFlCrDat: LONGINT;
+ ioFlMdDat: LONGINT;
+ ioFlBkDat: LONGINT;
+ ioFlXFndrInfo: FXInfo;
+ ioFlParID: LONGINT;
+ ioFlClpSiz: LONGINT;
+ );
+ 1: (
+ ioDrUsrWds: DInfo;
+ ioDrDirID: LONGINT;
+ ioDrNmFls: INTEGER;
+ filler3: array[1..9] of INTEGER;
+ ioDrCrDat: LONGINT;
+ ioDrMdDat: LONGINT;
+ ioDrBkDat: LONGINT;
+ ioDrFndrInfo: DXInfo;
+ ioDrParID: LONGINT;
+ );
+ end;
+
+ CInfoPBPtr = ^CInfoPBRec;
+
+ DTPBRecPtr = ^DTPBRec;
+ DTPBRec = RECORD
+ qLink: QElemPtr; { queue link in header }
+ qType: INTEGER; { type byte for safety check }
+ ioTrap: INTEGER; { FS: the Trap }
+ ioCmdAddr: Mac_Ptr; { FS: address to dispatch to }
+ ioCompletion: IOCompletionUPP; { completion routine addr (0 for synch calls) }
+ ioResult: OSErr; { result code }
+ ioNamePtr: StringPtr; { ptr to Vol:FileName string }
+ ioVRefNum: INTEGER; { volume refnum (DrvNum for Eject and MountVol) }
+ ioDTRefNum: INTEGER; { desktop refnum }
+ ioIndex: INTEGER;
+ ioTagInfo: LONGINT;
+ ioDTBuffer: Mac_Ptr;
+ ioDTReqCount: LONGINT;
+ ioDTActCount: LONGINT;
+ ioFiller1: SInt8;
+ ioIconType: SInt8;
+ ioFiller2: INTEGER;
+ ioDirID: LONGINT;
+ ioFileCreator: OSType;
+ ioFileType: OSType;
+ ioFiller3: LONGINT;
+ ioDTLgLen: LONGINT;
+ ioDTPyLen: LONGINT;
+ ioFiller4: ARRAY [1..14] OF INTEGER;
+ ioAPPLParID: LONGINT;
+ END;
+ DTPBPtr = ^DTPBRec;
+
+ HParamBlockRecPtr = ^HParamBlockRec;
+ HParamBlockRec = RECORD
+ qLink: QElemPtr; { queue link in header }
+ qType: INTEGER; { type byte for safety check }
+ ioTrap: INTEGER; { FS: the Trap }
+ ioCmdAddr: pointer; { FS: address to dispatch to }
+ ioCompletion: IOCompletionUPP; { completion routine addr (0 for synch calls) }
+ ioResult: OSErr; { result code }
+ ioNamePtr: StringPtr; { ptr to Vol:FileName string }
+ ioVRefNum: INTEGER; { volume refnum (DrvNum for Eject and MountVol) }
+ CASE INTEGER OF
+ 0: (
+ ioRefNum: INTEGER;
+ ioVersNum: SInt8;
+ ioPermssn: SInt8;
+ ioMisc: pointer;
+ ioBuffer: pointer;
+ ioReqCount: LONGINT;
+ ioActCount: LONGINT;
+ ioPosMode: INTEGER;
+ ioPosOffset: LONGINT;
+ );
+ 1: (
+ ioFRefNum: INTEGER;
+ ioFVersNum: SInt8;
+ filler1: SInt8;
+ ioFDirIndex: INTEGER;
+ ioFlAttrib: SInt8;
+ ioFlVersNum: SInt8;
+ ioFlFndrInfo: FInfo;
+ ioDirID: LONGINT;
+ ioFlStBlk: UInt16;
+ ioFlLgLen: LONGINT;
+ ioFlPyLen: LONGINT;
+ ioFlRStBlk: UInt16;
+ ioFlRLgLen: LONGINT;
+ ioFlRPyLen: LONGINT;
+ ioFlCrDat: UInt32;
+ ioFlMdDat: UInt32;
+ );
+ 2: (
+ filler2: LONGINT;
+ ioVolIndex: INTEGER;
+ ioVCrDate: UInt32;
+ ioVLsMod: UInt32;
+ ioVAtrb: INTEGER;
+ ioVNmFls: UInt16;
+ ioVBitMap: UInt16;
+ ioAllocPtr: UInt16;
+ ioVNmAlBlks: UInt16;
+ ioVAlBlkSiz: UInt32;
+ ioVClpSiz: UInt32;
+ ioAlBlSt: UInt16;
+ ioVNxtCNID: UInt32;
+ ioVFrBlk: UInt16;
+ ioVSigWord: UInt16;
+ ioVDrvInfo: INTEGER;
+ ioVDRefNum: INTEGER;
+ ioVFSID: INTEGER;
+ ioVBkUp: UInt32;
+ ioVSeqNum: UInt16;
+ ioVWrCnt: UInt32;
+ ioVFilCnt: UInt32;
+ ioVDirCnt: UInt32;
+ ioVFndrInfo: ARRAY [1..8] OF LONGINT;
+ );
+ 3: (
+ filler3: INTEGER;
+ ioDenyModes: INTEGER; { access rights data }
+ filler4: INTEGER;
+ filler5: SInt8;
+ ioACUser: SInt8; { access rights for directory only }
+ filler6: LONGINT;
+ ioACOwnerID: LONGINT; { owner ID }
+ ioACGroupID: LONGINT; { group ID }
+ ioACAccess: LONGINT; { access rights }
+ );
+ 4: (
+ filler7: INTEGER;
+ ioObjType: INTEGER; { function code }
+ ioObjNamePtr: StringPtr; { ptr to returned creator/group name }
+ ioObjID: LONGINT; { creator/group ID }
+ );
+ 5: (
+ ioDstVRefNum: INTEGER; { destination vol identifier }
+ filler8: INTEGER;
+ ioNewName: StringPtr; { ptr to destination pathname }
+ ioCopyName: StringPtr; { ptr to optional name }
+ ioNewDirID: LONGINT; { destination directory ID }
+ );
+ 6: (
+ ioWDCreated: INTEGER;
+ ioWDIndex: INTEGER;
+ ioWDProcID: LONGINT;
+ ioWDVRefNum: INTEGER;
+ filler10: INTEGER;
+ filler11: LONGINT;
+ filler12: LONGINT;
+ filler13: LONGINT;
+ ioWDDirID: LONGINT;
+ );
+ 7: (
+ filler14: LONGINT;
+ ioDestNamePtr: StringPtr; { dest file name }
+ filler15: LONGINT;
+ ioDestDirID: LONGINT; { dest file's directory id }
+ filler16: LONGINT;
+ filler17: LONGINT;
+ ioSrcDirID: LONGINT; { source file's directory id }
+ filler18: INTEGER;
+ ioFileID: LONGINT; { file ID }
+ );
+ 8: (
+ ioMatchPtr: FSSpecPtr; { match array }
+ ioReqMatchCount: LONGINT; { maximum allowable matches }
+ ioActMatchCount: LONGINT; { actual match count }
+ ioSearchBits: LONGINT; { search criteria selector }
+ ioSearchInfo1: CInfoPBPtr; { search values and range lower bounds }
+ ioSearchInfo2: CInfoPBPtr; { search values and range upper bounds }
+ ioSearchTime: LONGINT; { length of time to run search }
+ ioCatPosition: CatPositionRec; { current position in the catalog }
+ ioOptBuffer: pointer; { optional performance enhancement buffer }
+ ioOptBufSize: LONGINT; { size of buffer pointed to by ioOptBuffer }
+ );
+ 9: (
+ ioFiller21: LONGINT;
+ ioFiller22: LONGINT;
+ ioForeignPrivBuffer: pointer;
+ ioForeignPrivActCount: LONGINT;
+ ioForeignPrivReqCount: LONGINT;
+ ioFiller23: LONGINT;
+ ioForeignPrivDirID: LONGINT;
+ ioForeignPrivInfo1: LONGINT;
+ ioForeignPrivInfo2: LONGINT;
+ ioForeignPrivInfo3: LONGINT;
+ ioForeignPrivInfo4: LONGINT;
+ );
+ END;
+
+ HParmBlkPtr = ^HParamBlockRec;
+
+
+ WDPBRecPtr = ^WDPBRec;
+ WDPBRec = RECORD
+ qLink: QElemPtr;
+ qType: INTEGER;
+ ioTrap: INTEGER;
+ ioCmdAddr: pointer;
+ ioCompletion: IOCompletionUPP;
+ ioResult: OSErr;
+ ioNamePtr: StringPtr;
+ ioVRefNum: INTEGER;
+ filler1: INTEGER;
+ ioWDIndex: INTEGER;
+ ioWDProcID: LONGINT;
+ ioWDVRefNum: INTEGER;
+ filler2: ARRAY [1..7] OF INTEGER;
+ ioWDDirID: LONGINT;
+ END;
+
+ WDPBPtr = ^WDPBRec;
+
+FUNCTION PBGetVInfoSync(paramBlock: ParmBlkPtr): OSErr;
+external 'InterfaceLib';
+
+FUNCTION GetVol(volName: StringPtr; VAR vRefNum: INTEGER): OSErr;
+external 'InterfaceLib';
+
+function FSpOpenDF(var spec: FSSpec; permission: SignedByte;
+ var refNum: Integer): OSErr;
+external 'InterfaceLib';
+
+function FSpCreate(var spec: FSSpec; creator, fileType: OSType;
+ scriptTag: ScriptCode): OSErr;
+external 'InterfaceLib';
+
+function FSpDirCreate(var spec: FSSpec; scriptTag: ScriptCode;
+ var createdDirID: Longint): OSErr;
+external 'InterfaceLib';
+
+function FSpDelete(var spec: FSSpec): OSErr;
+external 'InterfaceLib';
+
+FUNCTION FSpGetFInfo(var spec: FSSpec; VAR fndrInfo: FInfo): OSErr;
+external 'InterfaceLib';
+
+FUNCTION FSpSetFInfo(var spec: FSSpec; var fndrInfo: FInfo): OSErr;
+external 'InterfaceLib';
+
+FUNCTION FSpSetFLock(var spec: FSSpec): OSErr;
+external 'InterfaceLib';
+
+FUNCTION FSpRstFLock(var spec: FSSpec): OSErr;
+external 'InterfaceLib';
+
+function FSClose(refNum: Integer): OSErr;
+external 'InterfaceLib';
+
+function FSRead(refNum: Integer; var count: Longint; buffPtr: Mac_Ptr): OSErr;
+external 'InterfaceLib';
+
+function FSWrite(refNum: Integer; var count: Longint; buffPtr: Mac_Ptr): OSErr;
+external 'InterfaceLib';
+
+function GetEOF(refNum: Integer; var logEOF: Longint): OSErr;
+external 'InterfaceLib';
+
+function SetEOF(refNum: Integer; logEOF: Longint): OSErr;
+external 'InterfaceLib';
+
+function GetFPos(refNum: Integer; var filePos: Longint): OSErr;
+external 'InterfaceLib';
+
+function SetFPos(refNum: Integer; posMode: Integer; posOff: Longint): OSErr;
+external 'InterfaceLib';
+
+FUNCTION PBGetWDInfoSync(paramBlock: WDPBPtr): OSErr;
+external 'InterfaceLib';
+
+function PBGetCatInfoSync (paramBlock: CInfoPBPtr): OSErr;
+external 'InterfaceLib';
+
+FUNCTION PBSetCatInfoSync(paramBlock: CInfoPBPtr): OSErr;
+external 'InterfaceLib';
+
+FUNCTION PBHGetVInfoSync(paramBlock: HParmBlkPtr): OSErr;
+external 'InterfaceLib';
+
+function FSMakeFSSpec (vRefNum: Integer; dirID: LongInt;
+ fileName: Str255; VAR spec: FSSpec): OSErr;
+external 'InterfaceLib';
+
+FUNCTION HGetFInfo(vRefNum: INTEGER; dirID: LONGINT; fileName: Str255;
+ VAR fndrInfo: FInfo): OSErr;
+external 'InterfaceLib';
+
+FUNCTION PBDTGetPath(paramBlock: DTPBPtr): OSErr;
+external 'InterfaceLib';
+
+FUNCTION PBDTGetAPPLSync(paramBlock: DTPBPtr): OSErr;
+external 'InterfaceLib';
+
+{************** from Aliases.p ***************}
+
+type
+ AliasHandle = Mac_Handle;
+
+function NewAliasMinimalFromFullPath(fullPathLength: Integer;
+ fullPath: Mac_Ptr; zoneName: Str32; serverName: Str31;
+ var alias: AliasHandle):OSErr;
+external 'InterfaceLib';
+
+function ResolveAlias(fromFile: FSSpecPtr; alias: AliasHandle;
+ var target: FSSpec; var wasChanged: Boolean):OSErr;
+external 'InterfaceLib';
+
+
+{************** from Folders.p ***************}
+
+CONST
+ kOnSystemDisk = -32768; { previously was 0x8000 but that is an unsigned value whereas vRefNum is signed }
+ kOnAppropriateDisk = -32767; { Generally, the same as kOnSystemDisk, but it's clearer that this isn't always the 'boot' disk. }
+ { Folder Domains - Carbon only. The constants above can continue to be used, but the folder/volume returned will }
+ { be from one of the domains below. }
+ kSystemDomain = -32766; { Read-only system hierarchy. }
+ kLocalDomain = -32765; { All users of a single machine have access to these resources. }
+ kNetworkDomain = -32764; { All users configured to use a common network server has access to these resources. }
+ kUserDomain = -32763; { Read/write. Resources that are private to the user. }
+ kClassicDomain = -32762; { Domain referring to the currently configured Classic System Folder }
+
+ kCreateFolder = true;
+ kDontCreateFolder = false;
+
+ kSystemFolderType = 'macs'; { the system folder }
+ kDesktopFolderType = 'desk'; { the desktop folder; objects in this folder show on the desk top. }
+ kSystemDesktopFolderType = 'sdsk'; { the desktop folder at the root of the hard drive, never the redirected user desktop folder }
+ kTrashFolderType = 'trsh'; { the trash folder; objects in this folder show up in the trash }
+ kSystemTrashFolderType = 'strs'; { the trash folder at the root of the drive, never the redirected user trash folder }
+ kWhereToEmptyTrashFolderType = 'empt'; { the "empty trash" folder; Finder starts empty from here down }
+ kPrintMonitorDocsFolderType = 'prnt'; { Print Monitor documents }
+ kStartupFolderType = 'strt'; { Finder objects (applications, documents, DAs, aliases, to...) to open at startup go here }
+ kShutdownFolderType = 'shdf'; { Finder objects (applications, documents, DAs, aliases, to...) to open at shutdown go here }
+ kAppleMenuFolderType = 'amnu'; { Finder objects to put into the Apple menu go here }
+ kControlPanelFolderType = 'ctrl'; { Control Panels go here (may contain INITs) }
+ kSystemControlPanelFolderType = 'sctl'; { System control panels folder - never the redirected one, always "Control Panels" inside the System Folder }
+ kExtensionFolderType = 'extn'; { System extensions go here }
+ kFontsFolderType = 'font'; { Fonts go here }
+ kPreferencesFolderType = 'pref'; { preferences for applications go here }
+ kSystemPreferencesFolderType = 'sprf'; { System-type Preferences go here - this is always the system's preferences folder, never a logged in user's }
+ kTemporaryFolderType = 'temp'; { temporary files go here (deleted periodically, but don't rely on it.) }
+
+FUNCTION FindFolder(vRefNum: INTEGER; folderType: OSType; createFolder: BOOLEAN; VAR foundVRefNum: INTEGER; VAR foundDirID: LONGINT): OSErr;
+external 'InterfaceLib';
+
+{************** from Events.p ***************}
+
+TYPE
+ EventKind = UInt16;
+ EventMask = UInt16;
+ EventModifiers = UInt16;
+
+TYPE
+ EventRecordPtr = ^EventRecord;
+ EventRecord = RECORD
+ what: EventKind;
+ message: UInt32;
+ when: UInt32;
+ where: Point;
+ modifiers: EventModifiers;
+ END;
+
+{************** from Processes.p ***************}
+
+type
+ ProcessSerialNumberPtr = ^ProcessSerialNumber;
+ ProcessSerialNumber = record
+ highLongOfPSN: LONGINT;
+ lowLongOfPSN: LONGINT;
+ end;
+
+const
+{ Process identifier - Various reserved process serial numbers }
+ kNoProcess = 0;
+ kSystemProcess = 1;
+ kCurrentProcess = 2;
+
+TYPE
+ LaunchFlags = UInt16;
+
+CONST
+ launchContinue = $4000;
+ launchNoFileFlags = $0800;
+ launchUseMinimum = $0400;
+ launchDontSwitch = $0200;
+ launchAllow24Bit = $0100;
+ launchInhibitDaemon = $0080;
+
+ { Format for first AppleEvent to pass to new process. The size of the overall
+ buffer variable: the message body immediately follows the messageLength }
+
+TYPE
+ AppParametersPtr = ^AppParameters;
+ AppParameters = RECORD
+ theMsgEvent: EventRecord;
+ eventRefCon: UInt32;
+ messageLength: UInt32;
+ END;
+
+ { Parameter block to _Launch }
+ LaunchParamBlockRecPtr = ^LaunchParamBlockRec;
+ LaunchParamBlockRec = RECORD
+ reserved1: UInt32;
+ reserved2: UInt16;
+ launchBlockID: UInt16;
+ launchEPBLength: UInt32;
+ launchFileFlags: UInt16;
+ launchControlFlags: LaunchFlags;
+ launchAppSpec: FSSpecPtr;
+ launchProcessSN: ProcessSerialNumber;
+ launchPreferredSize: UInt32;
+ launchMinimumSize: UInt32;
+ launchAvailableSize: UInt32;
+ launchAppParameters: AppParametersPtr;
+ END;
+
+ LaunchPBPtr = ^LaunchParamBlockRec;
+
+CONST
+ extendedBlock = $4C43; { 'LC' }
+ extendedBlockLen = 32;
+
+TYPE
+ ProcessInfoRec = record
+ processInfoLength: LONGINT;
+ processName: StringPtr;
+ processNumber: ProcessSerialNumber;
+ processType: LONGINT;
+ processSignature: OSType;
+ processMode: LONGINT;
+ processLocation: Mac_Ptr;
+ processSize: LONGINT;
+ processFreeMem: LONGINT;
+ processLauncher: ProcessSerialNumber;
+ processLaunchDate: LONGINT;
+ processActiveTime: LONGINT;
+ processAppSpec: FSSpecPtr;
+ end;
+
+ ProcessInfoRecPtr = ^ProcessInfoRec;
+
+FUNCTION LaunchApplication(LaunchParams: LaunchPBPtr): OSErr;
+external 'InterfaceLib';
+
+function GetProcessInformation ({CONST} var PSN: ProcessSerialNumber;
+ var info: ProcessInfoRec): OSErr;
+external 'InterfaceLib';
+
+{************** from Script.p ***************}
+
+const
+ smSystemScript = -1;
+
+{************** from MacErrors.p ***************}
+
+{Contains error codes for all File Manager calls, except
+for PBVolumeMount and for File ID Routines (from UI 3.4).
+And also memFullErr}
+
+const
+
+ dirFulErr = -33; { Directory full }
+ dskFulErr = -34; { disk full }
+ nsvErr = -35; { no such volume }
+ ioErr = -36; { I/O error (bummers) }
+ bdNamErr = -37; { there may be no bad names in the final system! }
+ fnOpnErr = -38; { File not open }
+ eofErr = -39; { End of file }
+ posErr = -40; { tried to position to before start of file (r/w) }
+ mFulErr = -41; { memory full (open) or file won't fit (load) }
+ tmfoErr = -42; { too many files open }
+ fnfErr = -43; { File not found }
+ wPrErr = -44; { diskette is write protected. }
+ fLckdErr = -45; { file is locked }
+
+ vLckdErr = -46; { volume is locked }
+ fBsyErr = -47; { File is busy (delete) }
+ dupFNErr = -48; { duplicate filename (rename) }
+ opWrErr = -49; { file already open with with write permission }
+ rfNumErr = -51; { refnum error }
+ gfpErr = -52; { get file position error }
+ volOffLinErr=-53; { volume not on line error (was Ejected) }
+ permErr = -54; { permissions error (on file open) }
+ volOnLinErr= -55; { drive volume already on-line at MountVol }
+ nsDrvErr = -56; { no such drive (tried to mount a bad drive num) }
+ noMacDskErr= -57; { not a mac diskette (sig bytes are wrong) }
+ extFSErr = -58; { volume in question belongs to an external fs }
+ fsRnErr = -59; { file system internal error:during rename the old entry was deleted but could not be restored. }
+ badMDBErr = -60; { bad master directory block }
+ wrPermErr = -61; { write permissions error }
+ dirNFErr = -120; { Directory not found }
+ tmwdoErr = -121; { No free WDCB available }
+ badMovErr = -122; { Move into offspring error }
+ wrgVolTypErr=-123; { Wrong volume type error [operation not supported for MFS] }
+ volGoneErr = -124; { Server volume has been disconnected. }
+
+ { Process Manager errors }
+ procNotFound = -600; { no eligible process with specified descriptor }
+ memFragErr = -601; { not enough room to launch app w/special requirements }
+ appModeErr = -602; { memory mode is 32-bit, but app not 32-bit clean }
+ protocolErr = -603; { app made module calls in improper order }
+ hardwareConfigErr = -604; { hardware configuration not correct for call }
+ appMemFullErr = -605; { application SIZE not big enough for launch }
+ appIsDaemon = -606; { app is BG-only, and launch flags disallow this }
+ bufferIsSmall = -607; { error returns from Post and Accept }
+ noOutstandingHLE = -608;
+ connectionInvalid = -609;
+ noUserInteractionAllowed = -610; { no user interaction allowed }
+
+ diffVolErr = -1303; { files on different volumes }
+ catChangedErr= -1304; { the catalog has been modified }
+ afpAccessDenied= -5000; { Insufficient access privileges for operation }
+ afpDenyConflict= -5006; { Specified open/deny modes conflict with current open modes }
+ afpItemNotFound = -5012;{ Unknown UserName/UserID or missing comment/APPL entry }
+ afpNoMoreLocks= -5015; { Maximum lock limit reached }
+ afpRangeNotLocked= -5020; { Tried to unlock range that was not locked by user }
+ afpRangeOverlap= -5021; { Some or all of range already locked by same user }
+ afpObjectTypeErr= -5025; { File/Directory specified where Directory/File expected }
+ afpCatalogChanged= -5037;
+ afpSameObjectErr= -5038;
+
+ memFullErr = -108; { Not enough room in heap zone }
+
+{************** from Resources ***************}
+
+function GetResource(theType: ResType; theID: Integer): Mac_Handle;
+external 'InterfaceLib';
+
+function Get1Resource(theType: ResType; theID: Integer): Mac_Handle;
+external 'InterfaceLib';
+
+function GetNamedResource(theType: ResType; name: Str255): Mac_Handle;
+external 'InterfaceLib';
+
+function Get1NamedResource(theType: ResType; name: Str255): Mac_Handle;
+external 'InterfaceLib';
+
+procedure ReleaseResource(theResource: Mac_Handle);
+external 'InterfaceLib';
+
+{************** from DateTimeUtils ***************}
+
+type
+ DateTimeRecPtr = ^DateTimeRec;
+ DateTimeRec = RECORD
+ year: INTEGER;
+ month: INTEGER;
+ day: INTEGER;
+ hour: INTEGER;
+ minute: INTEGER;
+ second: INTEGER;
+ dayOfWeek: INTEGER;
+ END;
+
+PROCEDURE GetTime(var d: DateTimeRec);
+external 'InterfaceLib';
+
+PROCEDURE SetTime(var d: DateTimeRec);
+//PROCEDURE SetTime(const d: DateTimeRec);
+external 'InterfaceLib';
+
+PROCEDURE DateToSeconds({CONST}VAR d: DateTimeRec; VAR secs: UInt32);
+external 'InterfaceLib';
+
+PROCEDURE SecondsToDate(secs: UInt32; VAR d: DateTimeRec);
+external 'InterfaceLib';
+
+{************** from TextUtils ***************}
+
+PROCEDURE UpperString(VAR theString: Str255; diacSensitive: BOOLEAN);
+external 'InterfaceLib';
+
+{************** from Quickdraw ***************}
+
+TYPE
+ Bits16 = ARRAY [0..15] OF INTEGER;
+
+ PatternPtr = ^Pattern;
+ Pattern = RECORD
+ pat: PACKED ARRAY [0..7] OF UInt8;
+ END;
+
+ PatPtr = ^Pattern;
+ BitMapPtr = ^BitMap;
+ BitMap = RECORD
+ baseAddr: pointer;
+ rowBytes: INTEGER;
+ bounds: Rect;
+ END;
+ BitMapHandle = ^BitMapPtr;
+
+ CursorPtr = ^Cursor;
+ Cursor = RECORD
+ data: Bits16;
+ mask: Bits16;
+ hotSpot: Point;
+ END;
+ CursPtr = ^Cursor;
+
+ GrafPtr = pointer; //TODO Should actually point to a GrafPort.
+
+ QDGlobalsPtr = ^QDGlobals;
+ QDGlobals = RECORD
+ privates: PACKED ARRAY [0..75] OF CHAR;
+ randSeed: LONGINT; { in Carbon use GetQDGlobalsRandomSeed }
+ screenBits: BitMap; { in Carbon use GetQDGlobalsScreenBits }
+ arrow: Cursor; { in Carbon use GetQDGlobalsArrow }
+ dkGray: Pattern; { in Carbon use GetQDGlobalsDarkGray }
+ ltGray: Pattern; { in Carbon use GetQDGlobalsLightGray }
+ gray: Pattern; { in Carbon use GetQDGlobalsGray }
+ black: Pattern; { in Carbon use GetQDGlobalsBlack }
+ white: Pattern; { in Carbon use GetQDGlobalsWhite }
+ thePort: GrafPtr; { in Carbon use GetQDGlobalsThePort }
+ END;
+
+ QDGlobalsHdl = ^QDGlobalsPtr;
+
+PROCEDURE InitGraf(globalPtr: Mac_Ptr);
+external 'InterfaceLib';
+
+{************** from Fonts ***************}
+
+PROCEDURE SetFScaleDisable(fscaleDisable: BOOLEAN);
+external 'InterfaceLib';
+
+{************** from AEDataModel ***************}
+
+{ Apple event descriptor types }
+
+CONST
+ typeBoolean = 'bool';
+ typeChar = 'TEXT';
+
+ { Preferred numeric Apple event descriptor types }
+ typeSInt16 = 'shor';
+ typeSInt32 = 'long';
+ typeUInt32 = 'magn';
+ typeSInt64 = 'comp';
+ typeIEEE32BitFloatingPoint = 'sing';
+ typeIEEE64BitFloatingPoint = 'doub';
+ type128BitFloatingPoint = 'ldbl';
+ typeDecimalStruct = 'decm';
+
+ { Non-preferred Apple event descriptor types }
+ typeSMInt = 'shor';
+ typeShortInteger = 'shor';
+ typeInteger = 'long';
+ typeLongInteger = 'long';
+ typeMagnitude = 'magn';
+ typeComp = 'comp';
+ typeSMFloat = 'sing';
+ typeShortFloat = 'sing';
+ typeFloat = 'doub';
+ typeLongFloat = 'doub';
+ typeExtended = 'exte';
+ typeApplSignature = 'sign';
+
+ { Constants used creating an AppleEvent }
+ { Constant for the returnID param of AECreateAppleEvent }
+ kAutoGenerateReturnID = -1; { AECreateAppleEvent will generate a session-unique ID }
+ { Constant for transaction IDÕs }
+ kAnyTransactionID = 0; { no transaction is in use }
+
+ { Apple event manager data types }
+
+TYPE
+ DescType = ResType;
+ AEKeyword = FourCharCode;
+{$IFDEF OPAQUE_TOOLBOX_STRUCTS }
+ AEDataStorage = ^LONGINT; { an opaque 32-bit type }
+ AEDataStoragePtr = ^AEDataStorage; { when a VAR xx:AEDataStorage parameter can be nil, it is changed to xx: AEDataStoragePtr }
+{$ELSE}
+ AEDataStorage = Mac_Handle;
+{$ENDIF OPAQUE_TOOLBOX_STRUCTS}
+
+ AEDescPtr = ^AEDesc;
+ AEDesc = RECORD
+ descriptorType: DescType;
+ dataHandle: AEDataStorage;
+ END;
+
+ AEKeyDescPtr = ^AEKeyDesc;
+ AEKeyDesc = RECORD
+ descKey: AEKeyword;
+ descContent: AEDesc;
+ END;
+
+{ a list of AEDesc's is a special kind of AEDesc }
+ AEDescList = AEDesc;
+ AEDescListPtr = ^AEDescList;
+ { AERecord is a list of keyworded AEDesc's }
+ AERecord = AEDescList;
+ AERecordPtr = ^AERecord;
+ { an AEDesc which contains address data }
+ AEAddressDesc = AEDesc;
+ AEAddressDescPtr = ^AEAddressDesc;
+{ an AERecord that contains an AppleEvent, and related data types }
+ AppleEvent = AERecord;
+ AppleEventPtr = ^AppleEvent;
+ AEReturnID = SInt16;
+ AETransactionID = SInt32;
+ AEEventClass = FourCharCode;
+ AEEventID = FourCharCode;
+ AEArrayType = SInt8;
+
+TYPE
+ AESendPriority = SInt16;
+CONST
+ kAENormalPriority = $00000000; { post message at the end of the event queue }
+ kAEHighPriority = $00000001; { post message at the front of the event queue (same as nAttnMsg) }
+
+TYPE
+ AESendMode = SInt32;
+
+CONST
+ kAENoReply = $00000001; { sender doesn't want a reply to event }
+ kAEQueueReply = $00000002; { sender wants a reply but won't wait }
+ kAEWaitReply = $00000003; { sender wants a reply and will wait }
+ kAEDontReconnect = $00000080; { don't reconnect if there is a sessClosedErr from PPCToolbox }
+ kAEWantReceipt = $00000200; { (nReturnReceipt) sender wants a receipt of message }
+ kAENeverInteract = $00000010; { server should not interact with user }
+ kAECanInteract = $00000020; { server may try to interact with user }
+ kAEAlwaysInteract = $00000030; { server should always interact with user where appropriate }
+ kAECanSwitchLayer = $00000040; { interaction may switch layer }
+ kAEDontRecord = $00001000; { don't record this event - available only in vers 1.0.1 and greater }
+ kAEDontExecute = $00002000; { don't send the event for recording - available only in vers 1.0.1 and greater }
+ kAEProcessNonReplyEvents = $00008000; { allow processing of non-reply events while awaiting synchronous AppleEvent reply }
+
+
+ { Constants for timeout durations }
+ kAEDefaultTimeout = -1; { timeout value determined by AEM }
+ kNoTimeOut = -2; { wait until reply comes back, however long it takes }
+
+
+FUNCTION AECreateDesc(typeCode: DescType; dataPtr: Mac_Ptr; dataSize: Size; VAR result: AEDesc): OSErr;
+external 'InterfaceLib';
+FUNCTION AEDisposeDesc(VAR theAEDesc: AEDesc): OSErr;
+external 'InterfaceLib';
+FUNCTION AEDuplicateDesc(var theAEDesc: AEDesc; VAR result: AEDesc): OSErr;
+external 'InterfaceLib';
+
+FUNCTION AECreateAppleEvent(theAEEventClass: AEEventClass; theAEEventID: AEEventID; var target: AEAddressDesc;
+ returnID: AEReturnID; transactionID: AETransactionID; VAR result: AppleEvent): OSErr;
+external 'InterfaceLib';
+FUNCTION AEPutParamPtr(VAR theAppleEvent: AppleEvent; theAEKeyword: AEKeyword; typeCode: DescType; dataPtr: Mac_Ptr; dataSize: Size): OSErr;
+external 'InterfaceLib';
+FUNCTION AEGetParamDesc(var theAppleEvent: AppleEvent; theAEKeyword: AEKeyword; desiredType: DescType; VAR result: AEDesc): OSErr;
+external 'InterfaceLib';
+
+{************** from AEInteraction ***************}
+
+type
+ AEIdleUPP = ^LONGINT; { an opaque UPP }
+ AEFilterUPP = ^LONGINT; { an opaque UPP }
+
+FUNCTION AESend(var theAppleEvent: AppleEvent; VAR reply: AppleEvent; sendMode: AESendMode; sendPriority: AESendPriority;
+ timeOutInTicks: LONGINT; idleProc: AEIdleUPP; filterProc: AEFilterUPP): OSErr;
+external 'InterfaceLib';
+
+{************** from others ***************}
+
+procedure ExitToShell;
+external 'InterfaceLib';
+
+procedure SysBeep(dur: Integer);
+external 'InterfaceLib';
+
+function TickCount: Longint;
+external 'InterfaceLib';
+
+function Munger (h: Mac_Handle; offset: LONGINT; ptr1: Mac_Ptr;
+ len1: LONGINT; ptr2: Mac_Ptr; len2: LONGINT): LONGINT;
+external 'InterfaceLib';
+
+
+{************** misc MPW support routines ***************}
+
+FUNCTION ResolveFolderAliases (volume: INTEGER; directory: LONGINT;
+ path: StringPtr; resolveLeafName: BOOLEAN;
+ VAR theSpec: FSSpec; VAR isFolder, hadAlias,
+ leafIsAlias: BOOLEAN): OSErr;
+external 'InterfaceLib'; {??}
+{ ...from CIncludes:IntEnv.h }
+
+PROCEDURE InitCursorCtl(newCursors: pointer);
+external 'PPCToolLib';
+
+PROCEDURE SpinCursor(increment: INTEGER);
+external 'PPCToolLib';
+
+
+{************** API to StdCLib in MacOS ***************}
+
+{$ifdef MACOS_USE_STDCLIB}
+
+{The prefix C_ or c_ is used where names conflicts with pascal
+keywords and names. Suffix Ptr is added for pointer to a type.}
+
+type
+ size_t = Longint;
+ off_t = Longint;
+ C_int = Longint;
+ C_short = Integer;
+ C_long = Longint;
+ C_unsigned_int = Cardinal;
+
+var
+ errno: C_int; external 'StdCLib' name 'errno';
+ MacOSErr: C_short; external 'StdCLib' name 'MacOSErr';
+
+const
+ _IOFBF = $00;
+ _IOLBF = $40;
+ _IONBF = $04;
+
+
+ O_RDONLY = $00; // Open for reading only.
+ O_WRONLY = $01; // Open for writing only.
+ O_RDWR = $02; // Open for reading & writing.
+ O_APPEND = $08; // Write to the end of the file.
+ O_RSRC = $10; // Open the resource fork.
+ O_ALIAS = $20; // Open alias file.
+ O_CREAT = $100; // Open or create a file.
+ O_TRUNC = $200; // Open and truncate to zero length.
+ O_EXCL = $400; // Create file only; fail if exists.
+ O_BINARY = $800; // Open as a binary stream.
+ O_NRESOLVE = $4000; // Don't resolve any aliases.
+
+
+ SEEK_SET = 0;
+ SEEK_CUR = 1;
+ SEEK_END = 2;
+
+ FIOINTERACTIVE = $00006602; // If device is interactive
+ FIOBUFSIZE = $00006603; // Return optimal buffer size
+ FIOFNAME = $00006604; // Return filename
+ FIOREFNUM = $00006605; // Return fs refnum
+ FIOSETEOF = $00006606; // Set file length
+
+ TIOFLUSH = $00007408; // discard unread input. arg is ignored
+
+function c_open(path: PChar; oflag: C_int): C_int; cdecl;
+ external 'StdCLib' name 'open';
+
+function c_close(filedes: C_int): C_int; cdecl;
+ external 'StdCLib' name 'close';
+
+function c_write(filedes: C_int; buf: pointer; nbyte: size_t): size_t; cdecl;
+ external 'StdCLib' name 'write';
+
+function c_read(filedes: C_int; buf: pointer; nbyte: size_t): size_t; cdecl;
+ external 'StdCLib' name 'read';
+
+function lseek(filedes: C_int; offset: off_t; whence: C_int): off_t; cdecl;
+ external 'StdCLib' name 'lseek';
+
+function ioctl(filedes: C_int; cmd: C_unsigned_int; arg: pointer): C_int; cdecl;
+ external 'StdCLib' name 'ioctl';
+
+function remove(filename: PChar): C_int; cdecl;
+ external 'StdCLib';
+
+function c_rename(old, c_new: PChar): C_int; cdecl;
+ external 'StdCLib' name 'rename';
+
+procedure c_exit(status: C_int); cdecl;
+ external 'StdCLib' name 'exit';
+
+ {cdecl is actually only needed for m68k}
+
+var
+ {Is set to zero for MPWTool, nonzero otherwise.}
+ StandAlone: C_int; external name 'StandAlone';
+
+CONST
+
+Sys_EPERM = 1; { No permission match }
+Sys_ENOENT = 2; { No such file or directory }
+Sys_ENORSRC = 3; { Resource not found *}
+Sys_EINTR = 4; { System service interrupted *}
+Sys_EIO = 5; { I/O error }
+Sys_ENXIO = 6; { No such device or address }
+Sys_E2BIG = 7; { Insufficient space for return argument * }
+Sys_ENOEXEC = 8; { File not executable * }
+Sys_EBADF = 9; { Bad file number }
+Sys_ECHILD = 10; { No child processes }
+Sys_EAGAIN = 11; { Resource temporarily unavailable * }
+Sys_ENOMEM = 12; { Not enough space * }
+Sys_EACCES = 13; { Permission denied }
+Sys_EFAULT = 14; { Illegal filename * }
+Sys_ENOTBLK = 15; { Block device required }
+Sys_EBUSY = 16; { Device or resource busy }
+Sys_EEXIST = 17; { File exists }
+Sys_EXDEV = 18; { Cross-device link }
+Sys_ENODEV = 19; { No such device }
+Sys_ENOTDIR = 20; { Not a directory }
+Sys_EISDIR = 21; { Is a directory }
+Sys_EINVAL = 22; { Invalid parameter * }
+Sys_ENFILE = 23; { File table overflow }
+Sys_EMFILE = 24; { Too many open files }
+Sys_ENOTTY = 25; { Not a typewriter }
+Sys_ETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.
+ (Probably not applicable on macos)}
+Sys_EFBIG = 27; { File too large }
+Sys_ENOSPC = 28; { No space left on device }
+Sys_ESPIPE = 29; { Illegal seek }
+Sys_EROFS = 30; { Read-only file system }
+Sys_EMLINK = 31; { Too many links }
+Sys_EPIPE = 32; { Broken pipe }
+Sys_EDOM = 33; { Math argument out of domain of func }
+Sys_ERANGE = 34; { Math result not representable }
+
+{ Note * is slightly different, compared to rtl/sunos/errno.inc}
+
+{$endif}
+
+{$PACKRECORDS NORMAL}
+
diff --git a/rtl/macos/macostp.pp b/rtl/macos/macostp.pp
new file mode 100644
index 0000000000..387097f93d
--- /dev/null
+++ b/rtl/macos/macostp.pp
@@ -0,0 +1,31 @@
+{
+ $Id: macostp.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 - 2004 by Olle Raab
+
+ A selection of the MacOS API for FreePascal, written
+ in the Turbo Pascal dialect.
+ It is primarily for internal use in the rtl, please
+ do not expect it to remain the same over time,
+ it will be subject to changes.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit macostp;
+
+interface
+
+{$define MACOS_USE_STDCLIB}
+
+{$I macostp.inc}
+
+implementation
+
+end.
diff --git a/rtl/macos/macutils.inc b/rtl/macos/macutils.inc
new file mode 100644
index 0000000000..c741313a25
--- /dev/null
+++ b/rtl/macos/macutils.inc
@@ -0,0 +1,566 @@
+{
+ $Id: macutils.inc,v 1.6 2005/04/03 22:15:04 olle Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Olle Raab
+
+ Some utilities specific for Mac OS.
+ Modified portions from Peter N. Lewis (PNL Libraries). Thanks !
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{NOTE: This file requires the following global variables to be declared:
+ workingDirectorySpec: FSSpec;}
+
+function FourCharCodeToLongword(fourcharcode: Shortstring): Longword;
+
+begin
+ FourCharCodeToLongword:=
+ (ord(fourcharcode[1]) shl 24) or
+ (ord(fourcharcode[2]) shl 16) or
+ (ord(fourcharcode[3]) shl 8) or
+ (ord(fourcharcode[4]))
+end;
+
+function BitIsSet(arg: Longint; bitnr: Integer): Boolean;
+
+begin
+ BitIsSet:= (arg and (1 shl bitnr)) <> 0;
+end;
+
+{ Converts MacOS specific error codes to the correct FPC error code.
+ All non zero MacOS errors corresponds to a nonzero FPC error.}
+Function MacOSErr2RTEerr(err: OSErr): Integer;
+
+var
+ res: Integer;
+
+begin
+ if err = noErr then { Else it will go through all the cases }
+ res:= 0
+ else case err of
+ dirFulErr, { Directory full }
+ dskFulErr { disk full }
+ :res:=101;
+ nsvErr { no such volume }
+ :res:=3;
+ ioErr, { I/O error (bummers) }
+ bdNamErr { there may be no bad names in the final system! }
+ :res:=1; //TODO Exchange to something better
+ fnOpnErr { File not open }
+ :res:=103;
+ eofErr, { End of file }
+ posErr { tried to position to before start of file (r/w) }
+ :res:=100;
+ mFulErr { memory full (open) or file won't fit (load) }
+ :res:=1; //TODO Exchange to something better
+ tmfoErr { too many files open}
+ :res:=4;
+ fnfErr { File not found }
+ :res:=2;
+ wPrErr { diskette is write protected. }
+ :res:=150;
+ fLckdErr { file is locked }
+ :res:=5;
+ vLckdErr { volume is locked }
+ :res:=150;
+ fBsyErr { File is busy (delete) }
+ :res:=5;
+ dupFNErr { duplicate filename (rename) }
+ :res:=5;
+ opWrErr { file already open with with write permission }
+ :res:=5;
+ rfNumErr, { refnum error }
+ gfpErr { get file position error }
+ :res:=1; //TODO Exchange to something better
+ volOffLinErr { volume not on line error (was Ejected) }
+ :res:=152;
+ permErr { permissions error (on file open) }
+ :res:=5;
+ volOnLinErr{ drive volume already on-line at MountVol }
+ :res:=1; //TODO Exchange to something other
+ nsDrvErr { no such drive (tried to mount a bad drive num) }
+ :res:=1; //TODO Perhaps exchange to something better
+ noMacDskErr, { not a mac diskette (sig bytes are wrong) }
+ extFSErr { volume in question belongs to an external fs }
+ :res:=157; //TODO Perhaps exchange to something better
+ fsRnErr, { file system internal error:during rename the old
+ entry was deleted but could not be restored. }
+ badMDBErr { bad master directory block }
+ :res:=1; //TODO Exchange to something better
+ wrPermErr { write permissions error }
+ :res:=5;
+ dirNFErr { Directory not found }
+ :res:=3;
+ tmwdoErr { No free WDCB available }
+ :res:=1; //TODO Exchange to something better
+ badMovErr { Move into offspring error }
+ :res:=5;
+ wrgVolTypErr { Wrong volume type error [operation not
+ supported for MFS] }
+ :res:=1; //TODO Exchange to something better
+ volGoneErr { Server volume has been disconnected. }
+ :res:=152;
+
+ diffVolErr { files on different volumes }
+ :res:=17;
+ catChangedErr { the catalog has been modified }
+ { OR comment: when searching with PBCatSearch }
+ :res:=1; //TODO Exchange to something other
+ afpAccessDenied, { Insufficient access privileges for operation }
+ afpDenyConflict { Specified open/deny modes conflict with current open modes }
+ :res:=5;
+ afpNoMoreLocks { Maximum lock limit reached }
+ :res:=5;
+ afpRangeNotLocked, { Tried to unlock range that was not locked by user }
+ afpRangeOverlap { Some or all of range already locked by same user }
+ :res:=1; //TODO Exchange to something better
+ afpObjectTypeErr { File/Directory specified where Directory/File expected }
+ :res:=3;
+ afpCatalogChanged { OR comment: when searching with PBCatSearch }
+ :res:=1; //TODO Exchange to something other
+ afpSameObjectErr
+ :res:=5; //TODO Exchange to something better
+
+ memFullErr { Not enough room in heap zone }
+ :res:=203;
+ else
+ res := 1; //TODO Exchange to something better
+ end;
+ MacOSErr2RTEerr:= res;
+end;
+
+ {Translates a unix or dos path to a mac path. Even a mac path can be input, }
+ {then it is returned as is. A trailing directory separator in input}
+ {will result in a trailing mac directory separator. For absolute paths, the }
+ {parameter mpw affects how the root volume is denoted. If mpw is true, }
+ {the path is intended for use in MPW, and the environment variable Boot is}
+ {prepended. Otherwise the actual boot volume name is appended.}
+ {All kinds of paths are attempted to be translated, except the unusal }
+ {dos construct: a relative path on a certain drive like : C:xxx\yyy}
+
+ function TranslatePathToMac (const path: string; mpw: Boolean): string;
+
+ function GetVolumeIdentifier: string;
+
+ var
+ s: Str255;
+ dummy: Integer;
+ err: OSErr;
+
+ begin
+ if mpw then
+ GetVolumeIdentifier := '{Boot}'
+ else
+ GetVolumeIdentifier := macosBootVolumeName;
+ end;
+
+ var
+ slashPos, oldpos, newpos, oldlen, maxpos: Longint;
+
+ begin
+ oldpos := 1;
+ slashPos := Pos('/', path);
+ if (slashPos <> 0) then {its a unix path}
+ begin
+ if slashPos = 1 then
+ begin {its a full path}
+ oldpos := 2;
+ TranslatePathToMac := GetVolumeIdentifier;
+ end
+ else {its a partial path}
+ TranslatePathToMac := ':';
+ end
+ else
+ begin
+ slashPos := Pos('\', path);
+ if (slashPos <> 0) then {its a dos path}
+ begin
+ if slashPos = 1 then
+ begin {its a full path, without drive letter}
+ oldpos := 2;
+ TranslatePathToMac := GetVolumeIdentifier;
+ end
+ else if (Length(path) >= 2) and (path[2] = ':') then {its a full path, with drive letter}
+ begin
+ oldpos := 4;
+ TranslatePathToMac := GetVolumeIdentifier;
+ end
+ else {its a partial path}
+ TranslatePathToMac := ':';
+ end;
+ end;
+
+ if (slashPos <> 0) then {its a unix or dos path}
+ begin
+ {Translate "/../" to "::" , "/./" to ":" and "/" to ":" }
+ newpos := Length(TranslatePathToMac);
+ oldlen := Length(path);
+ SetLength(TranslatePathToMac, newpos + oldlen); {It will be no longer than what is already}
+ {prepended plus length of path.}
+ maxpos := Length(TranslatePathToMac); {Get real maxpos, can be short if String is ShortString}
+
+ {There is never a slash in the beginning, because either it was an absolute path, and then the}
+ {drive and slash was removed, or it was a relative path without a preceding slash.}
+ while oldpos <= oldlen do
+ begin
+ {Check if special dirs, ./ or ../ }
+ if path[oldPos] = '.' then
+ if (oldpos + 1 <= oldlen) and (path[oldPos + 1] = '.') then
+ begin
+ if (oldpos + 2 > oldlen) or (path[oldPos + 2] in ['/', '\']) then
+ begin
+ {It is "../" or ".." translates to ":" }
+ if newPos = maxPos then
+ begin {Shouldn't actually happen, but..}
+ Exit('');
+ end;
+ newPos := newPos + 1;
+ TranslatePathToMac[newPos] := ':';
+ oldPos := oldPos + 3;
+ continue; {Start over again}
+ end;
+ end
+ else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in ['/', '\']) then
+ begin
+ {It is "./" or "." ignor it }
+ oldPos := oldPos + 2;
+ continue; {Start over again}
+ end;
+
+ {Collect file or dir name}
+ while (oldpos <= oldlen) and not (path[oldPos] in ['/', '\']) do
+ begin
+ if newPos = maxPos then
+ begin {Shouldn't actually happen, but..}
+ Exit('');
+ end;
+ newPos := newPos + 1;
+ TranslatePathToMac[newPos] := path[oldPos];
+ oldPos := oldPos + 1;
+ end;
+
+ {When we come here there is either a slash or we are at the end.}
+ if (oldpos <= oldlen) then
+ begin
+ if newPos = maxPos then
+ begin {Shouldn't actually happen, but..}
+ Exit('');
+ end;
+ newPos := newPos + 1;
+ TranslatePathToMac[newPos] := ':';
+ oldPos := oldPos + 1;
+ end;
+ end;
+
+ SetLength(TranslatePathToMac, newpos);
+ end
+ else if (path = '.') then
+ TranslatePathToMac := ':'
+ else if (path = '..') then
+ TranslatePathToMac := '::'
+ else
+ TranslatePathToMac := path; {its a mac path}
+ end;
+
+ {Concats the relative or full path path1 and the relative path path2.}
+ function ConcatMacPath (path1, path2: string): string;
+
+ begin
+ if Pos(':', path1) = 0 then {its partial}
+ Insert(':', path1, 1); {because otherwise it would be interpreted}
+ {as a full path, when path2 is appended.}
+
+ if path1[Length(path1)] = ':' then
+ begin
+ if path2[1] = ':' then
+ begin
+ Delete(path1, Length(path1), 1);
+ ConcatMacPath := Concat(path1, path2)
+ end
+ else
+ ConcatMacPath := Concat(path1, path2)
+ end
+ else
+ begin
+ if path2[1] = ':' then
+ ConcatMacPath := Concat(path1, path2)
+ else
+ ConcatMacPath := Concat(path1, ':', path2)
+ end;
+ end;
+
+ function IsMacFullPath (const path: string): Boolean;
+
+ begin
+ if Pos(':', path) = 0 then {its partial}
+ IsMacFullPath := false
+ else if path[1] = ':' then
+ IsMacFullPath := false
+ else
+ IsMacFullPath := true
+ end;
+
+ function IsDirectory (var spec: FSSpec): Boolean;
+
+ var
+ err: OSErr;
+ paramBlock: CInfoPBRec;
+
+ begin
+ with paramBlock do
+ begin
+ ioVRefNum := spec.vRefNum;
+ ioDirID := spec.parID;
+ ioNamePtr := @spec.name;
+ ioFDirIndex := 0;
+
+ err := PBGetCatInfoSync(@paramBlock);
+
+ if err = noErr then
+ IsDirectory := (paramBlock.ioFlAttrib and $10) <> 0
+ else
+ IsDirectory := false;
+ end;
+ end;
+
+
+{Gives the path for a given file or directory. If parent is true,
+ a path to the directory, where the file or directory is located,
+ is returned. Functioning even with System 6.}
+
+function FSpGetFullPath (spec: FSSpec; var fullPath: AnsiString;
+ parent: Boolean): OSErr;
+
+ var
+ res: OSErr;
+ pb: CInfoPBRec;
+
+begin
+ res := noErr;
+ if spec.parID = fsRtParID then { The object is a volume }
+ begin
+ if not parent then
+ begin
+ { Add a colon to make it a full pathname }
+ fullPath:= spec.name + ':';
+ end
+ else
+ begin
+ fullPath:= '';
+ res:= afpObjectTypeErr; {to have something close to this error.}
+ end;
+ end
+ else
+ begin
+ { The object isn't a volume }
+
+ { Add the object name }
+ if not parent then
+ fullPath:= spec.name
+ else
+ fullPath:= '';
+
+ { Get the ancestor directory names }
+ pb.ioNamePtr := @spec.name;
+ pb.ioVRefNum := spec.vRefNum;
+ pb.ioDrParID := spec.parID;
+
+ repeat { loop until we have an error or find the root directory }
+ begin
+ pb.ioFDirIndex := -1;
+ pb.ioDrDirID := pb.ioDrParID;
+ res := PBGetCatInfoSync(@pb);
+
+ if res = noErr then
+ begin
+ { Append colon to directory name }
+ spec.name := spec.name + ':';
+ { Add directory name to fullPathHandle }
+ fullPath:= spec.name + fullPath;
+ end
+ end
+ until not ((res = noErr) and (pb.ioDrDirID <> fsRtDirID));
+ end;
+
+ FSpGetFullPath := res;
+end;
+
+function PathArgToFSSpec(s: string; var spec: FSSpec): Integer;
+var
+ err: OSErr;
+begin
+ if pathTranslation then
+ s := TranslatePathToMac(s, false);
+ err:= FSMakeFSSpec(workingDirectorySpec.vRefNum,
+ workingDirectorySpec.parID, s, spec);
+
+ if s <> '' then
+ PathArgToFSSpec := MacOSErr2RTEerr(err)
+ else
+ PathArgToFSSpec := 3; {Empty paths are invalid paths}
+end;
+
+function PathArgToFullPath(s: string; var fullpath: AnsiString): Integer;
+
+var
+ err: OSErr;
+ res: Integer;
+ spec: FSSpec;
+
+begin
+ res:= PathArgToFSSpec(s, spec);
+ if (res = 0) or (res = 2) then
+ begin
+ err:= FSpGetFullPath(spec, fullpath, false);
+ PathArgToFullPath:= MacOSErr2RTEerr(err);
+ end
+ else
+ PathArgToFullPath:=res;
+end;
+
+function GetVolumeName(vRefNum: Integer; var volName: String): OSErr;
+
+var
+ pb: HParamBlockRec;
+
+begin
+ pb.ioNamePtr := @volName;
+ pb.ioVRefNum := vRefNum;
+ pb.ioVolIndex := 0;
+ PBHGetVInfoSync(@pb);
+ volName:= volName + ':';
+ GetVolumeName:= pb.ioResult;
+end;
+
+function GetWorkingDirectoryVRefNum: Integer;
+
+begin
+ GetWorkingDirectoryVRefNum:= workingDirectorySpec.vRefNum;
+end;
+
+ function GetVolInfo (var name: Str63; var vrn: integer; index: integer; var CrDate: longint): OSErr;
+ var
+ pb: ParamBlockRec;
+ oe: OSErr;
+ begin
+ if (name <> '') and (name[length(name)] <> ':') then begin
+ name := concat(name, ':');
+ end;
+ pb.ioNamePtr := @name;
+ pb.ioVRefNum := vrn;
+ pb.ioVolIndex := index;
+ oe := PBGetVInfoSync(@pb);
+ if oe = noErr then begin
+ vrn := pb.ioVRefNum;
+ CrDate := pb.ioVCrDate;
+ end;
+ GetVolInfo := oe;
+ end;
+
+ {Checks that fs really is an application with the specified creator}
+ function ConfirmApplicationExists (creator: OSType; var fs: FSSpec): OSErr;
+
+ var
+ err: OSErr;
+ info: FInfo;
+ begin
+ err := HGetFInfo(fs.vRefNum, fs.parID, fs.name, info);
+ if err = noErr then begin
+ if (info.fdType <> FourCharCodeToLongword('APPL')) or (info.fdCreator <> creator) then begin
+ err := fnfErr;
+ end;
+ end;
+ ConfirmApplicationExists := err;
+ end;
+
+ {Find an application with the given creator, in any of the mounted volumes.}
+ function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
+ var
+ i: integer;
+ pbdt: DTPBRec;
+ crdate: longint;
+ oe: OSErr;
+ found: Boolean;
+ begin
+ found := false;
+ if (macosSystemVersion >= $0700) then begin
+ i := 1;
+ repeat
+ fs.vRefNum := 0;
+
+ {Get info for volume i}
+ oe := GetVolInfo(fs.name, fs.vRefNum, i, crdate);
+ i := i + 1;
+ if oe = noErr then begin
+ with pbdt do begin
+ fs.name := '';
+ ioNamePtr := @fs.name;
+ ioVRefNum := fs.vRefNum;
+
+ {Get the desktop database for this volume}
+ oe := PBDTGetPath(@pbdt);
+ if oe = noErr then begin
+ ioFileCreator := creator;
+
+ {Look first for the "default" (newest) application file}
+ ioIndex := 0;
+ oe := PBDTGetAPPLSync(@pbdt);
+ if oe = noErr then begin
+ fs.parID := pbdt.ioAPPLParID;
+ found := ConfirmApplicationExists(creator,fs)=noErr;
+ end;
+
+ {If not ok, look for older ones.}
+ if not found then begin
+ ioIndex := 1;
+ repeat
+ oe := PBDTGetAPPLSync(@pbdt);
+ if oe = noErr then begin
+ fs.parID := pbdt.ioAPPLParID;
+ found := ConfirmApplicationExists(creator,fs)=noErr;
+ end;
+ ioIndex := ioIndex + 1;
+ until found or (oe <> noErr);
+ end;
+
+ end;
+ end;
+ oe := noErr;
+ end;
+ until found or (oe <> noErr);
+ end;
+ if found then begin
+ oe := noErr;
+ end else begin
+ oe := fnfErr;
+ fs.vRefNum := 0;
+ fs.parID := 2;
+ fs.name := '';
+ end;
+ FindApplication := oe;
+ end;
+
+function LaunchFSSpec (tofront: Boolean; const applicationFileSpec: FSSpec): OSErr;
+var
+ launchThis: LaunchParamBlockRec;
+begin
+ launchThis.launchAppSpec := @applicationFileSpec;
+ launchThis.launchAppParameters := nil;
+ launchThis.launchBlockID := extendedBlock;
+ launchThis.launchEPBLength := extendedBlockLen;
+ launchThis.launchFileFlags := 0;
+ launchThis.launchControlFlags := launchContinue or launchNoFileFlags;
+ if not tofront then begin
+ launchThis.launchControlFlags := launchThis.launchControlFlags or launchDontSwitch;
+ end;
+
+ LaunchFSSpec:= LaunchApplication(@launchThis);
+end;
+
diff --git a/rtl/macos/macutils.pp b/rtl/macos/macutils.pp
new file mode 100644
index 0000000000..5f4ea46554
--- /dev/null
+++ b/rtl/macos/macutils.pp
@@ -0,0 +1,80 @@
+{
+ $Id: macutils.pp,v 1.4 2005/03/20 19:37:54 olle Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Olle Raab
+
+ Some utilities specific for Mac OS
+ Modified portions from Peter N. Lewis (PNL Libraries). Thanks !
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit macutils;
+
+interface
+
+uses
+ macostp;
+
+function FourCharCodeToLongword(fourcharcode: Shortstring): Longword;
+
+function BitIsSet(arg: Longint; bitnr: Integer): Boolean;
+
+{ Converts MacOS specific error codes to the correct FPC error code.
+ All non zero MacOS errors corresponds to a nonzero FPC error.}
+function MacOSErr2RTEerr(err: OSErr): Integer;
+
+
+{Translates a unix or dos path to a mac path. Even a mac path can be input, }
+{then it is returned as is. A trailing directory separator in input}
+{will result in a trailing mac directory separator. For absolute paths, the }
+{parameter mpw affects how the root volume is denoted. If mpw is true, }
+{the path is intended for use in MPW, and the environment variable Boot is}
+{prepended. Otherwise the actual boot volume name is appended.}
+{All kinds of paths are attempted to be translated, except relative path on}
+{a certain drive, like: C:xxx\yyy }
+
+function TranslatePathToMac (const path: string; mpw: Boolean): string;
+
+
+{Concats the relative or full path1 to the relative path2.}
+function ConcatMacPath (path1, path2: string): string;
+
+
+function IsMacFullPath (const path: string): Boolean;
+
+
+function IsDirectory (var spec: FSSpec): Boolean;
+
+function PathArgToFSSpec(s: string; var spec: FSSpec): Integer;
+
+function PathArgToFullPath(s: string; var fullpath: AnsiString): Integer;
+
+{Gives the volume name (with appended colon) for a given volume reference number.}
+function GetVolumeName(vRefNum: Integer; var volName: String): OSErr;
+
+function GetWorkingDirectoryVRefNum: Integer;
+
+{Find an application with the given creator, in any of the mounted volumes.}
+function FindApplication (creator: OSType; var fs: FSSpec): OSErr;
+
+{Launch the application given by applicationFileSpec. If toFront is true
+ it will be brought to the foreground when launched.}
+function LaunchFSSpec (tofront: Boolean; const applicationFileSpec: FSSpec): OSErr;
+
+implementation
+
+{Actually defined in system.pp. Declared here to be used in macutils.inc: }
+var
+ {emulated working directory}
+ workingDirectorySpec: FSSpec; cvar; external;
+
+{$I macutils.inc}
+
+end.
diff --git a/rtl/macos/sysdir.inc b/rtl/macos/sysdir.inc
new file mode 100644
index 0000000000..4a274585aa
--- /dev/null
+++ b/rtl/macos/sysdir.inc
@@ -0,0 +1,137 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+procedure mkdir(const s:string);[IOCheck];
+var
+ spec: FSSpec;
+ createdDirID: Longint;
+ err: OSErr;
+ res: Integer;
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+
+ res:= PathArgToFSSpec(s, spec);
+ if (res = 0) or (res = 2) then
+ begin
+ err:= FSpDirCreate(spec, smSystemScript, createdDirID);
+ OSErr2InOutRes(err);
+ end
+ else
+ InOutRes:=res;
+end;
+
+procedure rmdir(const s:string);[IOCheck];
+
+var
+ spec: FSSpec;
+ err: OSErr;
+ res: Integer;
+
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+
+ res:= PathArgToFSSpec(s, spec);
+
+ if (res = 0) then
+ begin
+ if IsDirectory(spec) then
+ begin
+ err:= FSpDelete(spec);
+ OSErr2InOutRes(err);
+ end
+ else
+ InOutRes:= 20;
+ end
+ else
+ InOutRes:=res;
+end;
+
+procedure chdir(const s:string);[IOCheck];
+var
+ spec, newDirSpec: FSSpec;
+ err: OSErr;
+ res: Integer;
+begin
+ if (s='') or (InOutRes <> 0) then
+ exit;
+
+ res:= PathArgToFSSpec(s, spec);
+ if (res = 0) or (res = 2) then
+ begin
+ { The fictive file x is appended to the directory name to make
+ FSMakeFSSpec return a FSSpec to a file in the directory.
+ Then by clearing the name, the FSSpec then
+ points to the directory. It doesn't matter whether x exists or not.}
+ err:= FSMakeFSSpec (spec.vRefNum, spec.parID, ':'+spec.name+':x', newDirSpec);
+ if (err = noErr) or (err = fnfErr) then
+ begin
+ workingDirectorySpec:= newDirSpec;
+ workingDirectorySpec.name:='';
+ InOutRes:= 0;
+ end
+ else
+ begin
+ {E g if the directory doesn't exist.}
+ OSErr2InOutRes(err);
+ end;
+ end
+ else
+ InOutRes:=res;
+end;
+
+procedure getDir (DriveNr: byte; var Dir: ShortString);
+
+var
+ fullPath: AnsiString;
+ pathHandleSize: Longint;
+
+begin
+ if FSpGetFullPath(workingDirectorySpec, fullPath, false) <> noErr then
+ Halt(3); {exit code 3 according to MPW}
+
+ if Length(fullPath) <= 255 then {because dir is ShortString}
+ InOutRes := 0
+ else
+ InOutRes := 1; //TODO Exchange to something better
+
+ dir:= fullPath;
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/macos/sysfile.inc b/rtl/macos/sysfile.inc
new file mode 100644
index 0000000000..47ef9fb8d3
--- /dev/null
+++ b/rtl/macos/sysfile.inc
@@ -0,0 +1,374 @@
+{
+ $Id: sysfile.inc,v 1.4 2005/04/28 18:21:04 olle Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001-2005 by Free Pascal development team
+
+ Low level file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Low Level File Routines
+ ****************************************************************************}
+
+function do_isdevice(handle:longint):boolean;
+begin
+ do_isdevice:=false;
+end;
+
+{ close a file from the handle value }
+procedure do_close(h : longint);
+var
+ err: OSErr;
+{Ignore error handling, according to the other targets, which seems reasonable,
+because close might be used to clean up after an error.}
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ c_close(h);
+ errno:= 0;
+ {$else}
+ err:= FSClose(h);
+ // OSErr2InOutRes(err);
+ {$endif}
+end;
+
+procedure do_erase(p : pchar);
+
+var
+ spec: FSSpec;
+ err: OSErr;
+ res: Integer;
+
+begin
+ res:= PathArgToFSSpec(p, spec);
+ if (res = 0) then
+ begin
+ if not IsDirectory(spec) then
+ begin
+ err:= FSpDelete(spec);
+ OSErr2InOutRes(err);
+ end
+ else
+ InOutRes:= 2;
+ end
+ else
+ InOutRes:=res;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+var
+ s1,s2: AnsiString;
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ InOutRes:= PathArgToFullPath(p1, s1);
+ if InOutRes <> 0 then
+ exit;
+ InOutRes:= PathArgToFullPath(p2, s2);
+ if InOutRes <> 0 then
+ exit;
+ c_rename(PChar(s1),PChar(s2));
+ Errno2InoutRes;
+ {$else}
+ InOutRes:=1;
+ {$endif}
+end;
+
+function do_write(h:longint;addr:pointer;len : longint) : longint;
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ do_write:= c_write(h, addr, len);
+ Errno2InoutRes;
+ {$else}
+ InOutRes:=1;
+ if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
+ InOutRes:=0;
+ do_write:= len;
+ {$endif}
+end;
+
+function do_read(h:longint;addr:pointer;len : longint) : longint;
+
+var
+ i: Longint;
+
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ len:= c_read(h, addr, len);
+ Errno2InoutRes;
+
+ do_read:= len;
+
+ {$else}
+ InOutRes:=1;
+ if FSread(h, len, Mac_Ptr(addr)) = noErr then
+ InOutRes:=0;
+ do_read:= len;
+ {$endif}
+end;
+
+function do_filepos(handle : longint) : longint;
+
+var
+ pos: Longint;
+
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ {This returns the filepos without moving it.}
+ do_filepos := lseek(handle, 0, SEEK_CUR);
+ Errno2InoutRes;
+ {$else}
+ InOutRes:=1;
+ if GetFPos(handle, pos) = noErr then
+ InOutRes:=0;
+ do_filepos:= pos;
+ {$endif}
+end;
+
+procedure do_seek(handle,pos : longint);
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ lseek(handle, pos, SEEK_SET);
+ Errno2InoutRes;
+ {$else}
+ InOutRes:=1;
+ if SetFPos(handle, fsFromStart, pos) = noErr then
+ InOutRes:=0;
+ {$endif}
+end;
+
+function do_seekend(handle:longint):longint;
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ do_seekend:= lseek(handle, 0, SEEK_END);
+ Errno2InoutRes;
+ {$else}
+ InOutRes:=1;
+ if SetFPos(handle, fsFromLEOF, 0) = noErr then
+ InOutRes:=0;
+ {TODO Resulting file position is to be returned.}
+ {$endif}
+end;
+
+function do_filesize(handle : longint) : longint;
+
+var
+ aktfilepos: Longint;
+
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ aktfilepos:= lseek(handle, 0, SEEK_CUR);
+ if errno = 0 then
+ begin
+ do_filesize := lseek(handle, 0, SEEK_END);
+ Errno2InOutRes; {Report the error from this operation.}
+ lseek(handle, aktfilepos, SEEK_SET); {Always try to move back,
+ even in presence of error.}
+ end
+ else
+ Errno2InOutRes;
+ {$else}
+ InOutRes:=1;
+ if GetEOF(handle, pos) = noErr then
+ InOutRes:=0;
+ do_filesize:= pos;
+ {$endif}
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+begin
+ {$ifdef MACOS_USE_STDCLIB}
+ ioctl(handle, FIOSETEOF, pointer(pos));
+ Errno2InoutRes;
+ {$else}
+ InOutRes:=1;
+ do_seek(handle,pos); //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
+ if SetEOF(handle, pos) = noErr then
+ InOutRes:=0;
+ {$endif}
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+
+var
+ scriptTag: ScriptCode;
+ refNum: Integer;
+
+ err: OSErr;
+ res: Integer;
+ spec: FSSpec;
+
+ fh: Longint;
+
+ oflags : longint;
+ fullPath: AnsiString;
+
+ finderInfo: FInfo;
+
+begin
+
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed : ;
+ else
+ begin
+ {not assigned}
+ inoutres:=102;
+ exit;
+ end;
+ end;
+ end;
+
+{ reset file handle }
+ filerec(f).handle:=UnusedHandle;
+
+ {$ifdef MACOS_USE_STDCLIB}
+
+{ We do the conversion of filemodes here, concentrated on 1 place }
+ case (flags and 3) of
+ 0 : begin
+ oflags :=O_RDONLY;
+ filerec(f).mode:=fminput;
+ end;
+ 1 : begin
+ oflags :=O_WRONLY;
+ filerec(f).mode:=fmoutput;
+ end;
+ 2 : begin
+ oflags :=O_RDWR;
+ filerec(f).mode:=fminout;
+ end;
+ end;
+
+ if (flags and $1000)=$1000 then
+ oflags:=oflags or (O_CREAT or O_TRUNC)
+ else if (flags and $100)=$100 then
+ oflags:=oflags or (O_APPEND);
+
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end
+ else
+ begin
+ InOutRes:= PathArgToFSSpec(p, spec);
+ if (InOutRes = 0) or (InOutRes = 2) then
+ begin
+ err:= FSpGetFullPath(spec, fullPath, false);
+ InOutRes:= MacOSErr2RTEerr(err);
+ end;
+ if InOutRes <> 0 then
+ exit;
+
+ p:= PChar(fullPath);
+ end;
+
+
+ fh:= c_open(p, oflags);
+ if (fh = -1) and (errno = Sys_EROFS) and ((oflags and O_RDWR)<>0) then
+ begin
+ oflags:=oflags and not(O_RDWR);
+ fh:= c_open(p, oflags);
+ end;
+ Errno2InOutRes;
+ if fh <> -1 then
+ begin
+ if FileRec(f).mode in [fmoutput, fminout, fmappend] then
+ begin
+ {Change of filetype and creator is always done when a file is opened
+ for some kind of writing. This ensures overwritten Darwin files will
+ get apropriate filetype. It must be done after file is opened,
+ in the case the file did not previously exist.}
+
+ FSpGetFInfo(spec, finderInfo);
+ finderInfo.fdType:= defaultFileType;
+ finderInfo.fdCreator:= defaultCreator;
+ FSpSetFInfo(spec, finderInfo);
+ end;
+ filerec(f).handle:= fh;
+ end
+ else
+ filerec(f).handle:= UnusedHandle;
+
+ {$else}
+
+ InOutRes:=1;
+
+ { reset file handle }
+ filerec(f).handle:=UnusedHandle;
+
+ res:= FSpLocationFromFullPath(StrLen(p), p, spec);
+ if (res = noErr) or (res = fnfErr) then
+ begin
+ if FSpCreate(spec, defaultCreator, defaultFileType, smSystemScript) = noErr then
+ ;
+
+ if FSpOpenDF(spec, fsCurPerm, refNum) = noErr then
+ begin
+ filerec(f).handle:= refNum;
+ InOutRes:=0;
+ end;
+ end;
+
+ if (filerec(f).handle=UnusedHandle) then
+ begin
+ //errno:=GetLastError;
+ //Errno2InoutRes;
+ end;
+ {$endif}
+end;
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.4 2005/04/28 18:21:04 olle
+ * Set errno to zero after close
+
+ Revision 1.3 2005/03/20 19:37:31 olle
+ + Added optional path translation mechanism
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/macos/sysheap.inc b/rtl/macos/sysheap.inc
new file mode 100644
index 0000000000..22f1b0b469
--- /dev/null
+++ b/rtl/macos/sysheap.inc
@@ -0,0 +1,52 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/07 21:30:12 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if failed }
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ result := NewPtr(size);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+ DisposePtr(p);
+end;
+
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/macos/sysos.inc b/rtl/macos/sysos.inc
new file mode 100644
index 0000000000..70922ad133
--- /dev/null
+++ b/rtl/macos/sysos.inc
@@ -0,0 +1,181 @@
+{
+ $Id: sysos.inc,v 1.2 2005/03/20 19:35:24 olle Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*********************** MacOS API *********************}
+
+{This implementation uses StdCLib: }
+{$define MACOS_USE_STDCLIB}
+
+{Some MacOS API routines and StdCLib included for internal use:}
+{$I macostp.inc}
+
+{Note, because the System unit is the most low level, it should not
+depend on any other units, and thus the macos api must be accessed
+as an include file and not a unit.}
+
+{The reason StdCLib is used is that it can easily be connected
+to either SIOW or, in case of MPWTOOL, to MPW }
+
+{If the Apples Universal Interfaces are used, the qd variable is required
+to be allocated somewhere, so we do it here for the convenience to the user.}
+
+var
+ qd: QDGlobals; cvar;
+
+
+{$ifdef MACOS_USE_STDCLIB}
+
+{************** API to StdCLib in MacOS ***************}
+{The reason StdCLib is used is that it can easily be connected
+to either SIOW or, in case of MPWTOOL, to MPW }
+
+{$endif}
+
+
+{*********************** Macutils *********************}
+
+{And also include the same utilities as in the macutils.pp unit.}
+
+var
+ {emulated working directory}
+ workingDirectorySpec: FSSpec; cvar;
+
+ {The above variable is also declared in macutils.pp as external. Declared }
+ {here to be available to macutils.inc and below in this file.}
+
+{$I macutils.inc}
+
+{******************************************************}
+
+function GetAppFileLocation (var spec: FSSpec): Boolean;
+{Requires >= System 7}
+
+ var
+ PSN: ProcessSerialNumber;
+ info: ProcessInfoRec;
+ appFileRefNum: Integer;
+ appName: Str255;
+ dummy: Mac_Handle;
+
+begin
+ begin
+ PSN.highLongOfPSN := 0;
+ PSN.lowLongOfPSN := kCurrentProcess;
+ info.processInfoLength := SizeOf(info);
+ info.processName := nil;
+ info.processAppSpec := @spec;
+ if GetProcessInformation(PSN, info) = noErr then
+ begin
+ spec.name := '';
+ GetAppFileLocation := true;
+ end
+ else
+ GetAppFileLocation := false;
+ end
+end;
+
+Procedure Errno2InOutRes;
+{
+ Convert ErrNo error to the correct InOutRes value.
+ It seems that some of the errno is, in macos,
+ used for other purposes than its original definition.
+}
+
+begin
+ if errno = 0 then { Else it will go through all the cases }
+ exit;
+ case Errno of
+ Sys_ENFILE,
+ Sys_EMFILE : Inoutres:=4;
+ Sys_ENOENT : Inoutres:=2;
+ Sys_EBADF : Inoutres:=6;
+ Sys_ENOMEM,
+ Sys_EFAULT : Inoutres:=217; //TODO Exchange to something better
+ Sys_EINVAL : Inoutres:=218; //TODO RTE 218 doesn't exist
+ Sys_EAGAIN,
+ Sys_ENOSPC : Inoutres:=101;
+ Sys_ENOTDIR : Inoutres:=3;
+ Sys_EPERM,
+ Sys_EROFS,
+ Sys_EEXIST,
+ Sys_EISDIR,
+ Sys_EINTR, //Happens when attempt to rename a file fails
+ Sys_EBUSY, //Happens when attempt to remove a locked file
+ Sys_EACCES,
+ Sys_EMLINK : Inoutres:=5; //Happens when attempt to remove open file
+ Sys_ENXIO : InOutRes:=152;
+ Sys_ESPIPE : InOutRes:=156; //Illegal seek
+ else
+ InOutRes := Integer(errno);//TODO Exchange to something better
+ end;
+ errno:=0;
+end;
+
+Procedure OSErr2InOutRes(err: OSErr);
+begin
+ InOutRes:= MacOSErr2RTEerr(err);
+end;
+
+{*****************************************************************************
+ MacOS specific functions
+*****************************************************************************}
+var
+ defaultCreator: OSType = $4D505320; {'MPS ' MPW Shell}
+ //defaultCreator: OSType = $74747874; {'ttxt' Simple Text}
+ defaultFileType: OSType = $54455854; {'TEXT'}
+
+procedure Yield;
+
+begin
+ if StandAlone = 0 then
+ SpinCursor(1);
+end;
+
+procedure SetDefaultMacOSFiletype(ftype: ShortString);
+
+begin
+ if Length(ftype) = 4 then
+ defaultFileType:= PLongWord(@ftype[1])^;
+end;
+
+procedure SetDefaultMacOSCreator(creator: ShortString);
+
+begin
+ if Length(creator) = 4 then
+ defaultCreator:= PLongWord(@creator[1])^;
+end;
+
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.2 2005/03/20 19:35:24 olle
+ - removed FSpLocationFromFullPath
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/macos/sysosh.inc b/rtl/macos/sysosh.inc
new file mode 100644
index 0000000000..47089bffff
--- /dev/null
+++ b/rtl/macos/sysosh.inc
@@ -0,0 +1,50 @@
+{
+ $Id: sysosh.inc,v 1.2 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+ THandle = Int64;
+{$else CPU64}
+ THandle = Longint;
+{$endif CPU64}
+ TThreadID = THandle;
+
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = record
+ Locked: boolean
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/macos/system.pp b/rtl/macos/system.pp
new file mode 100644
index 0000000000..1a0c8156ab
--- /dev/null
+++ b/rtl/macos/system.pp
@@ -0,0 +1,581 @@
+{
+ $Id: system.pp,v 1.32 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002-2004 by Olle Raab
+
+ FreePascal system unit for MacOS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit System;
+
+interface
+
+{ include system-independent routine headers }
+{$I systemh.inc}
+
+const
+ LineEnding = #13;
+ LFNSupport = true;
+ DirectorySeparator = ':';
+ DriveSeparator = ':';
+ PathSeparator = ','; {Is used in MPW and OzTeX}
+ FileNameCaseSensitive = false;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+
+ maxExitCode = 65535;
+
+const
+{ Default filehandles }
+ UnusedHandle : Longint = -1;
+ StdInputHandle : Longint = 0;
+ StdOutputHandle : Longint = 1;
+ StdErrorHandle : Longint = 2;
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCR;
+
+
+
+var
+ argc : longint;
+ argv : ppchar;
+ envp : ppchar;
+
+{*********************************}
+{** MacOS specific functions **}
+{*********************************}
+
+{To be called at regular intervals, for lenghty tasks.
+ Yield might give time for other tasks to run under the cooperative
+ multitasked macos. For an MPW Tool, it also spinns the cursor.}
+
+procedure Yield;
+
+{To set mac file type and creator codes, to be used for files created
+ by the FPC runtime library. They must be exactly 4 chars long.}
+
+procedure SetDefaultMacOSFiletype(ftype: ShortString);
+procedure SetDefaultMacOSCreator(creator: ShortString);
+
+var
+ {Whether unix and dos style paths should be translated. Default false}
+ pathTranslation: Boolean;
+
+
+{*********************************}
+{** Available features on macos **}
+{*********************************}
+
+
+ var
+ macosHasGestalt: Boolean;
+ macosHasWaitNextEvent: Boolean;
+ macosHasColorQD: Boolean;
+ macosHasFPU: Boolean;
+ macosSystemVersion: Integer;
+ macosHasSysDebugger: Boolean = false;
+ macosHasCFM: Boolean;
+
+ macosHasAppleEvents: Boolean;
+ macosHasAliasMgr: Boolean;
+
+
+ macosHasFSSpec: Boolean;
+ macosHasFindFolder: Boolean;
+
+
+ macosHasScriptMgr: Boolean;
+ macosNrOfScriptsInstalled: Integer;
+
+ macosHasAppearance: Boolean;
+ macosHasAppearance101: Boolean;
+ macosHasAppearance11: Boolean;
+
+ macosBootVolumeVRefNum: Integer;
+ macosBootVolumeName: String[31];
+
+{
+ MacOS paths
+ ===========
+ MacOS directory separator is a colon ":" which is the only character not
+ allowed in filenames.
+ A path containing no colon or which begins with a colon is a partial path.
+ E g ":kalle:petter" ":kalle" "kalle"
+ All other paths are full (absolute) paths. E g "HD:kalle:" "HD:"
+ When generating paths, one is safe is one ensures that all partial paths
+ begins with a colon, and all full paths ends with a colon.
+ In full paths the first name (e g HD above) is the name of a mounted volume.
+ These names are not unique, because, for instance, two diskettes with the
+ same names could be inserted. This means that paths on MacOS is not
+ waterproof. In case of equal names the first volume found will do.
+ Two colons "::" are the relative path to the parent. Three is to the
+ grandparent etc.
+}
+
+implementation
+
+{
+About the implementation
+========================
+A MacOS application is assembled and linked by MPW (Macintosh
+Programmers Workshop), which nowadays is free to use. For info
+and download of MPW and MacOS api, see www.apple.com
+
+It can be linked to either a graphical user interface application,
+a standalone text only application (using SIOW) or
+to an MPW tool, this is entirely controlled by the linking step.
+
+It requires system 7 and CFM, which is always the case for PowerPC.
+
+If a m68k version would be implemented, it would save a lot
+of efforts if it also uses CFM. This System.pp should, with
+minor modifications, probably work with m68k.
+
+Initial working directory is the directory of the application,
+or for an MPWTool, the working directory as set by the
+Directory command in MPW.
+
+Note about working directory. There is a facility in MacOS which
+manages a working directory for an application, initially set to
+the applications directory, or for an MPWTool, the tool's directory.
+However, this requires the application to have a unique application
+signature (creator code), to distinguish its working directory
+from working directories of other applications. Due to the fact
+that casual applications are anonymous in this sense (without an
+application signature), this facility will not work. Also, this
+working directory facility is not present in Carbon. Hence we
+will manage a working directory by our self.
+
+
+Deviations
+==========
+
+In current implementation, working directory is stored as
+directory id. This means there is a possibility the user moves the
+working directory or a parent to it, while the application uses it.
+Then the path to the wd suddenly changes. This is AFAIK not in
+accordance with other OS's. Although this is a minor caveat,
+it is mentioned here. To overcome this the wd could be stored
+as a path instead, but this imposes translations from fullpath
+to directory ID each time the filesystem is accessed.
+
+The initial working directory for an MPWTool, as considered by
+FPC, is different from the MacOS working directory facility,
+see above.
+
+
+Possible improvements:
+=====================
+
+Perhaps handle readonly filesystems, as in sysunix.inc
+
+}
+
+{******** include system independent routines **********}
+{$I system.inc}
+
+
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+ //paramcount:=0;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l+1<=argc) then
+ paramstr:=strpas(argv[l])
+ else
+ paramstr:='';
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+begin
+ randseed:= Cardinal(TickCount);
+end;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+procedure pascalmain; external name 'PASCALMAIN';
+
+{Main entry point in C style, needed to capture program parameters.
+ For this to work, the system unit must be before the main program
+ in the linking order.}
+procedure main(argcparam: Longint; argvparam: ppchar; envpparam: ppchar); cdecl; [public];
+
+begin
+ argc:= argcparam;
+ argv:= argvparam;
+ envp:= envpparam;
+ pascalmain; {run the pascal main program}
+end;
+
+procedure setup_arguments;
+ begin
+ {Nothing needs to be done here.}
+ end;
+
+procedure setup_environment;
+ begin
+ end;
+
+
+{ FindSysFolder returns the (real) vRefNum, and the DirID of the current
+system folder. It uses the Folder Manager if present, otherwise it falls
+back to SysEnvirons. It returns zero on success, otherwise a standard
+system error. }
+
+function FindSysFolder(var foundVRefNum: Integer; var foundDirID: Longint): OSErr;
+
+var
+ gesResponse: Longint;
+ envRec: SysEnvRec;
+ myWDPB: WDPBRec;
+ volName: String[34];
+ err: OSErr;
+
+begin
+ foundVRefNum := 0;
+ foundDirID := 0;
+ if macosHasGestalt
+ and (Gestalt (FourCharCodeToLongword(gestaltFindFolderAttr), gesResponse) = noErr)
+ and BitIsSet (gesResponse, gestaltFindFolderPresent) then
+ begin { Does Folder Manager exist? }
+ err := FindFolder (kOnSystemDisk, FourCharCodeToLongword(kSystemFolderType),
+ kDontCreateFolder, foundVRefNum, foundDirID);
+ end
+ else
+ begin
+ { Gestalt can't give us the answer, so we resort to SysEnvirons }
+ err := SysEnvirons (curSysEnvVers, envRec);
+ if (err = noErr) then
+ begin
+ myWDPB.ioVRefNum := envRec.sysVRefNum;
+ volName := '';
+ myWDPB.ioNamePtr := @volName;
+ myWDPB.ioWDIndex := 0;
+ myWDPB.ioWDProcID := 0;
+ err := PBGetWDInfoSync (@myWDPB);
+ if (err = noErr) then
+ begin
+ foundVRefNum := myWDPB.ioWDVRefNum;
+ foundDirID := myWDPB.ioWDDirID;
+ end;
+ end;
+ end;
+ FindSysFolder:= err;
+end;
+
+procedure InvestigateSystem;
+
+ {$IFDEF CPUM68K}
+ const
+ _GestaltDispatch = $A0AD;
+ _WaitNextEvent = $A860;
+ _ScriptUtil = $A8B5;
+
+ qdOffscreenTrap = $AB1D;
+ {$ENDIF}
+
+ var
+ err: Integer;
+ response: Longint;
+ {$IFDEF CPUM68K}
+ environs: SysEnvRec;
+ {$ENDIF}
+
+ {Vi rŠknar med att man kšr pŒ minst system 6.0.5. DŒ finns bŒde Gestalt och GDevice med.}
+ {Enligt Change Histrory Šr MacOS 6.0.5 mera konsistent mellan maskinmodellerna Šn fšregŒende system}
+
+begin
+ {$IFDEF CPUM68K}
+ macosHasGestalt := TrapAvailable(_GestaltDispatch);
+ {$ELSE}
+ macosHasGestalt := true; {There is always Gestalt on PowerPC}
+ {$ENDIF}
+
+ if not macosHasGestalt then (* If we don't have Gestalt, then we can't have any System 7 features *)
+ begin
+ {$IFDEF CPUM68K}
+ { Detta kan endast gŠlla pŒ en 68K maskin.}
+ macosHasScriptMgr := TrapAvailable(_ScriptUtil);
+
+ macosNrOfScriptsInstalled := 1; (* assume only Roman script, to start with *)
+
+ err := SysEnvirons(1, environs);
+ if err = noErr then
+ begin
+ if environs.machineType < 0 then { gammalt ROM}
+ macosHasWaitNextEvent := FALSE
+ else
+ macosHasWaitNextEvent := TrapAvailable(_WaitNextEvent);
+ macosHasColorQD := environs.hasColorQD;
+ macosHasFPU := environs.hasFPU;
+ macosSystemVersion := environs.systemVersion;
+ end
+ else
+ begin
+ macosHasWaitNextEvent := FALSE;
+ macosHasColorQD := FALSE;
+ macosHasFPU := FALSE;
+ macosSystemVersion := 0;
+ end;
+
+ macosHasSysDebugger := (LongintPtr(MacJmp)^ <> 0);
+
+ macosHasCFM := false;
+ macosHasAppleEvents := false;
+ macosHasAliasMgr := false;
+
+ macosHasFSSpec := false;
+ macosHasFindFolder := false;
+
+ macosHasAppearance := false;
+ macosHasAppearance101 := false;
+ macosHasAppearance11 := false;
+ {$IFDEF THINK_PASCAL}
+ if (macosHasScriptMgr) then
+ macosNrOfScriptsInstalled := GetEnvirons(smEnabled);
+ {$ELSE}
+ if (macosHasScriptMgr) then
+ macosNrOfScriptsInstalled := GetScriptManagerVariable(smEnabled); {Gamla rutinnamnet var GetEnvirons.}
+ {$ENDIF}
+ {$ENDIF}
+ end
+ else
+ begin
+ macosHasScriptMgr := Gestalt(FourCharCodeToLongword(gestaltScriptMgrVersion), response) = noErr; {Fšr att ta reda pŒ om script mgr finns.}
+ macosNrOfScriptsInstalled := 1; (* assume only Roman script, to start with *)
+ macosHasWaitNextEvent := true;
+
+ if Gestalt(FourCharCodeToLongword(gestaltSystemVersion), response) = noErr then
+ macosSystemVersion := response
+ else
+ macosSystemVersion := 0; {Borde inte kunna hŠnda.}
+
+ if Gestalt(FourCharCodeToLongword(gestaltOSAttr), response) = noErr then
+ macosHasSysDebugger := BitIsSet(response, gestaltSysDebuggerSupport)
+ else
+ macosHasSysDebugger := false;
+
+ if Gestalt(FourCharCodeToLongword(gestaltQuickdrawVersion), response) = noErr then
+ macosHasColorQD := (response >= $0100)
+ else
+ macosHasColorQD := false;
+
+ if Gestalt(FourCharCodeToLongword(gestaltFPUType), response) = noErr then
+ macosHasFPU := (response <> gestaltNoFPU)
+ else
+ macosHasFPU := false;
+
+ if Gestalt(FourCharCodeToLongword(gestaltCFMAttr), response) = noErr then
+ macosHasCFM := BitIsSet(response, gestaltCFMPresent)
+ else
+ macosHasCFM := false;
+
+ macosHasAppleEvents := Gestalt(FourCharCodeToLongword(gestaltAppleEventsAttr), response) = noErr;
+ macosHasAliasMgr := Gestalt(FourCharCodeToLongword(gestaltAliasMgrAttr), response) = noErr;
+
+ if Gestalt(FourCharCodeToLongword(gestaltFSAttr), response) = noErr then
+ macosHasFSSpec := BitIsSet(response, gestaltHasFSSpecCalls)
+ else
+ macosHasFSSpec := false;
+ macosHasFindFolder := Gestalt(FourCharCodeToLongword(gestaltFindFolderAttr), response) = noErr;
+
+ if macosHasScriptMgr then
+ begin
+ err := Gestalt(FourCharCodeToLongword(gestaltScriptCount), response);
+ if (err = noErr) then
+ macosNrOfScriptsInstalled := Integer(response);
+ end;
+
+ if (Gestalt(FourCharCodeToLongword(gestaltAppearanceAttr), response) = noErr) then
+ begin
+ macosHasAppearance := BitIsSet(response, gestaltAppearanceExists);
+ if Gestalt(FourCharCodeToLongword(gestaltAppearanceVersion), response) = noErr then
+ begin
+ macosHasAppearance101 := (response >= $101);
+ macosHasAppearance11 := (response >= $110);
+ end
+ end
+ else
+ begin
+ macosHasAppearance := false;
+ macosHasAppearance101 := false;
+ macosHasAppearance11 := false;
+ end;
+ end;
+end;
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+Procedure system_exit;
+var
+ s: ShortString;
+begin
+ if StandAlone <> 0 then
+ if exitcode <> 0 then
+ begin
+ Str(exitcode,s);
+ if IsConsole then
+ Writeln( '### Program exited with exit code ' + s)
+ else if macosHasSysDebugger then
+ DebugStr('A possible error occured, exit code: ' + s + '. Type "g" and return to continue.')
+ else
+ {Be quiet}
+ end;
+
+ {$ifndef MACOS_USE_STDCLIB}
+ if StandAlone <> 0 then
+ ExitToShell;
+ {$else}
+ c_exit(exitcode); {exitcode is only utilized by an MPW tool}
+ {$endif}
+end;
+
+procedure SysInitStdIO;
+begin
+ { Setup stdin, stdout and stderr }
+ {$ifdef MACOS_USE_STDCLIB}
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+ {$endif }
+end;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := 1;
+{$WARNING To be implemented - using GetProcessInformation???}
+end;
+
+var
+ resHdl: Mac_Handle;
+ isFolder, hadAlias, leafIsAlias: Boolean;
+ dirStr: string[2];
+ err: OSErr;
+ dummySysFolderDirID: Longint;
+
+begin
+ InvestigateSystem; {Must be first}
+
+ {Check requred features for system.pp to work.}
+ if not macosHasFSSpec then
+ Halt(3); //exit code 3 according to MPW
+
+ if FindSysFolder(macosBootVolumeVRefNum, dummySysFolderDirID) <> noErr then
+ Halt(3); //exit code 3 according to MPW
+
+ if GetVolumeName(macosBootVolumeVRefNum, macosBootVolumeName) <> noErr then
+ Halt(3); //exit code 3 according to MPW
+
+ { To be set if this is a GUI or console application }
+ if StandAlone = 0 then
+ IsConsole := true {Its an MPW tool}
+ else
+ begin
+ resHdl:= Get1Resource(FourCharCodeToLongword('siow'),0);
+ IsConsole := (resHdl <> nil); {A SIOW app is also a console}
+ ReleaseResource(resHdl);
+ end;
+
+ { To be set if this is a library and not a program }
+ IsLibrary := FALSE;
+
+ StackLength := InitialStkLen;
+ StackBottom := SPtr - StackLength;
+ pathTranslation:= false;
+
+ { Setup working directory }
+ if StandAlone <> 0 then
+ begin
+ if not GetAppFileLocation(workingDirectorySpec) then
+ Halt(3); //exit code 3 according to MPW
+ end
+ else
+ begin
+ { The fictive file x is used to make
+ FSMakeFSSpec return a FSSpec to a file in the directory.
+ Then by clearing the name, the FSSpec then
+ points to the directory. It doesn't matter whether x exists or not.}
+ dirStr:= ':x';
+ err:= ResolveFolderAliases(0, 0, @dirStr, true,
+ workingDirectorySpec, isFolder, hadAlias, leafIsAlias);
+ workingDirectorySpec.name:='';
+ if (err <> noErr) and (err <> fnfErr) then
+ Halt(3); //exit code 3 according to MPW
+ end;
+
+ { Setup heap }
+ if StandAlone <> 0 then
+ MaxApplZone;
+
+ InitHeap;
+ SysInitExceptions;
+ SysInitStdIO;
+
+ { Setup environment and arguments }
+ Setup_Environment;
+ setup_arguments;
+ { Reset IO Error }
+ InOutRes:=0;
+ errno:=0;
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+
+ if StandAlone = 0 then
+ begin
+ InitGraf(@qd.thePort);
+ SetFScaleDisable(true);
+ InitCursorCtl(nil);
+ end;
+end.
+
+
+{
+ $Log: system.pp,v $
+ Revision 1.32 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.31 2005/03/20 19:37:31 olle
+ + Added optional path translation mechanism
+
+ Revision 1.30 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.29 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.28 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+ Revision 1.27 2005/01/24 18:51:23 olle
+ * filetype/filecreator changed after the file is opened, in case the file did not previously exist
+
+}
diff --git a/rtl/macos/systhrd.inc b/rtl/macos/systhrd.inc
new file mode 100644
index 0000000000..6232819a8b
--- /dev/null
+++ b/rtl/macos/systhrd.inc
@@ -0,0 +1,42 @@
+{
+ $Id: systhrd.inc,v 1.1 2005/02/07 21:30:12 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure InitSystemThreads;
+begin
+ { This should be changed to a real value during
+ thread driver initialization if appropriate. }
+ ThreadID := 1;
+ SetNoThreadManager;
+end;
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/macos/sysutils.pp b/rtl/macos/sysutils.pp
new file mode 100644
index 0000000000..1147ef4325
--- /dev/null
+++ b/rtl/macos/sysutils.pp
@@ -0,0 +1,732 @@
+{
+ $Id: sysutils.pp,v 1.7 2005/02/26 14:38:14 florian Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004-2005 by Olle Raab
+
+ Sysutils unit for Mac OS.
+
+ NOTE !!! THIS FILE IS UNDER CONSTRUCTION AND DOES NOT WORK CURRENLY.
+
+ THUS IT IS NOT BUILT BY THE MAKEFILES
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ MacOSTP;
+
+//{$DEFINE HAS_SLEEP} TODO
+//{$DEFINE HAS_OSERROR} TODO
+//{$DEFINE HAS_OSCONFIG} TODO
+
+type
+//TODO Check pad and size
+//TODO unify with Dos.SearchRec
+ PMacOSFindData = ^TMacOSFindData;
+ TMacOSFindData = record
+ {MacOS specific params, private, do not use:}
+ paramBlock: CInfoPBRec;
+ searchFSSpec: FSSpec;
+ searchAttr: Byte; {attribute we are searching for}
+ exactMatch: Boolean;
+ end;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+implementation
+
+uses
+ Dos, Sysconst; // For some included files.
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+
+Var LinuxFlags : longint;
+
+BEGIN
+ (* TODO fix
+ LinuxFlags:=0;
+ Case (Mode and 3) of
+ 0 : LinuxFlags:=LinuxFlags or Open_RdOnly;
+ 1 : LinuxFlags:=LinuxFlags or Open_WrOnly;
+ 2 : LinuxFlags:=LinuxFlags or Open_RdWr;
+ end;
+ FileOpen:=fdOpen (FileName,LinuxFlags);
+ //!! We need to set locking based on Mode !!
+ *)
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+
+begin
+ (* TODO fix
+ FileCreate:=fdOpen(FileName,Open_RdWr or Open_Creat or Open_Trunc);
+ *)
+end;
+
+
+Function FileCreate (Const FileName : String;Mode : Longint) : Longint;
+
+Var LinuxFlags : longint;
+
+BEGIN
+ (* TODO fix
+ LinuxFlags:=0;
+ Case (Mode and 3) of
+ 0 : LinuxFlags:=LinuxFlags or Open_RdOnly;
+ 1 : LinuxFlags:=LinuxFlags or Open_WrOnly;
+ 2 : LinuxFlags:=LinuxFlags or Open_RdWr;
+ end;
+ FileCreate:=fdOpen(FileName,LinuxFlags or Open_Creat or Open_Trunc);
+ *)
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+
+begin
+ (* TODO fix
+ FileRead:=fdRead (Handle,Buffer,Count);
+ *)
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+
+begin
+ (* TODO fix
+ FileWrite:=fdWrite (Handle,Buffer,Count);
+ *)
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+
+begin
+ (* TODO fix
+ FileSeek:=fdSeek (Handle,FOffset,Origin);
+ *)
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+
+begin
+ (* TODO fix
+ {$warning need to add 64bit call }
+ FileSeek:=fdSeek (Handle,FOffset,Origin);
+ *)
+end;
+
+
+Procedure FileClose (Handle : Longint);
+
+begin
+ (* TODO fix
+ fdclose(Handle);
+ *)
+end;
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+
+begin
+ (* TODO fix
+ FileTruncate:=fdtruncate(Handle,Size);
+ *)
+end;
+
+Function FileAge (Const FileName : String): Longint;
+
+ (*
+Var Info : Stat;
+ Y,M,D,hh,mm,ss : word;
+ *)
+
+begin
+ (* TODO fix
+ If not fstat (FileName,Info) then
+ exit(-1)
+ else
+ begin
+ EpochToLocal(info.mtime,y,m,d,hh,mm,ss);
+ Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
+ end;
+ *)
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+
+ (*
+Var Info : Stat;
+ *)
+
+begin
+ (* TODO fix
+ FileExists:=fstat(filename,Info);
+ *)
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+
+ (*
+Var Info : Stat;
+ *)
+
+begin
+ (* TODO fix
+ DirectoryExists:=fstat(Directory,Info) and
+ ((info.mode and STAT_IFMT)=STAT_IFDIR);
+ *)
+end;
+
+(*
+Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
+
+begin
+ Result:=faArchive;
+ If (Info.Mode and STAT_IFDIR)=STAT_IFDIR then
+ Result:=Result or faDirectory;
+ If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
+ Result:=Result or faHidden;
+ If (Info.Mode and STAT_IWUSR)=0 Then
+ Result:=Result or faReadOnly;
+ If (Info.Mode and
+ (STAT_IFSOCK or STAT_IFBLK or STAT_IFCHR or STAT_IFIFO))<>0 then
+ Result:=Result or faSysFile;
+end;
+
+{
+ GlobToSearch takes a glob entry, stats the file.
+ The glob entry is removed.
+ If FileAttributes match, the entry is reused
+}
+
+Type
+ TGlobSearchRec = Record
+ Path : String;
+ GlobHandle : PGlob;
+ end;
+ PGlobSearchRec = ^TGlobSearchRec;
+
+Function GlobToTSearchRec (Var Info : TSearchRec) : Boolean;
+
+Var SInfo : Stat;
+ p : Pglob;
+ GlobSearchRec : PGlobSearchrec;
+
+begin
+ GlobSearchRec:=PGlobSearchrec(Info.FindHandle);
+ P:=GlobSearchRec^.GlobHandle;
+ Result:=P<>Nil;
+ If Result then
+ begin
+ GlobSearchRec^.GlobHandle:=P^.Next;
+ Result:=Fstat(GlobSearchRec^.Path+StrPas(p^.name),SInfo);
+ If Result then
+ begin
+ Info.Attr:=LinuxToWinAttr(p^.name,SInfo);
+ Result:=(Info.ExcludeAttr and Info.Attr)=0;
+ If Result Then
+ With Info do
+ begin
+ Attr:=Info.Attr;
+ If P^.Name<>Nil then
+ Name:=strpas(p^.name);
+ Time:=Sinfo.mtime;
+ Size:=Sinfo.Size;
+ end;
+ end;
+ P^.Next:=Nil;
+ GlobFree(P);
+ end;
+end;
+*)
+
+
+procedure DoFind (var F: TSearchRec; firstTime: Boolean);
+
+ var
+ err: OSErr;
+ s: Str255;
+
+begin
+ with Rslt, findData, paramBlock do
+ begin
+ ioVRefNum := searchFSSpec.vRefNum;
+ if firstTime then
+ ioFDirIndex := 0;
+
+ while true do
+ begin
+ s := '';
+ ioDirID := searchFSSpec.parID;
+ ioFDirIndex := ioFDirIndex + 1;
+ ioNamePtr := @s;
+
+ err := PBGetCatInfoSync(@paramBlock);
+
+ if err <> noErr then
+ begin
+ if err = fnfErr then
+ DosError := 18
+ else
+ DosError := MacOSErr2RTEerr(err);
+ break;
+ end;
+
+ attr := GetFileAttrFromPB(Rslt.paramBlock);
+ if ((Attr and not(searchAttr)) = 0) then
+ begin
+ name := s;
+ UpperString(s, true);
+
+ if FNMatch(Rslt.searchFSSpec.name, s) then
+ begin
+ size := GetFileSizeFromPB(paramBlock);
+ time := MacTimeToDosPackedTime(ioFlMdDat);
+ Result := 0;
+ break;
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+ var
+ s: Str255;
+
+begin
+ fillchar(Rslt, sizeof(Rslt), 0);
+
+ if path = '' then
+ begin
+ Result := 3;
+ Exit;
+ end;
+
+ {We always also search for readonly and archive, regardless of Attr.}
+ Rslt.searchAttr := (Attr or (archive or readonly));
+
+ Result := PathArgToFSSpec(path, Rslt.searchFSSpec);
+ with Rslt do
+ if (Result = 0) or (Result = 2) then
+ begin
+ SearchSpec := path;
+ NamePos := Length(path) - Length(searchFSSpec.name);
+
+ if (Pos('?', searchFSSpec.name) = 0) and (Pos('*', searchFSSpec.name) = 0) then {No wildcards}
+ begin {If exact match, we don't have to scan the directory}
+ exactMatch := true;
+ Result := DoFindOne(searchFSSpec, paramBlock);
+ if Result = 0 then
+ begin
+ Attr := GetFileAttrFromPB(paramBlock);
+ if ((Attr and not(searchAttr)) = 0) then
+ begin
+ name := searchFSSpec.name;
+ size := GetFileSizeFromPB(paramBlock);
+ time := MacTimeToDosPackedTime(paramBlock.ioFlMdDat);
+ end
+ else
+ Result := 18;
+ end
+ else if Result = 2 then
+ Result := 18;
+ end
+ else
+ begin
+ exactMatch := false;
+
+ s := searchFSSpec.name;
+ UpperString(s, true);
+ Rslt.searchFSSpec.name := s;
+
+ DoFind(Rslt, true);
+ end;
+ end;
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+
+begin
+ if F.exactMatch then
+ Result := 18
+ else
+ Result:=DoFind (Rslt);
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+
+ (*
+Var
+ GlobSearchRec : PGlobSearchRec;
+ *)
+
+begin
+ (* TODO fix
+ GlobSearchRec:=PGlobSearchRec(F.FindHandle);
+ GlobFree (GlobSearchRec^.GlobHandle);
+ Dispose(GlobSearchRec);
+ *)
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+
+ (*
+Var Info : Stat;
+ *)
+
+begin
+ (* TODO fix
+ If Not(FStat(Handle,Info)) then
+ Result:=-1
+ else
+ Result:=Info.Mtime;
+ *)
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+
+begin
+ // TODO fix
+ // Impossible under Linux from FileHandle !!
+ FileSetDate:=-1;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+
+ (*
+Var Info : Stat;
+ *)
+
+begin
+ (* TODO fix
+ If Not FStat (FileName,Info) then
+ Result:=-1
+ Else
+ Result:=LinuxToWinAttr(Pchar(FileName),Info);
+ *)
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+
+begin
+ Result:=-1;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+
+begin
+ (* TODO fix
+ Result:=UnLink (FileName);
+ *)
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+
+begin
+ (* TODO fix
+ RenameFile:=Unix.FRename(OldNAme,NewName);
+ *)
+end;
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.',
+ '/fd0/.',
+ '/fd1/.',
+ '/.'
+ );
+var
+ Drives : byte;
+ DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+Function DiskFree(Drive: Byte): int64;
+ (*
+var
+ fs : tstatfs;
+ *)
+Begin
+ (* TODO fix
+ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and statfs(StrPas(fixdrivestr[drive]),fs)) or
+ ((not (drivestr[Drive]=nil)) and statfs(StrPas(drivestr[drive]),fs)) then
+ Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+ else
+ Diskfree:=-1;
+ *)
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+ (*
+var
+ fs : tstatfs;
+ *)
+Begin
+ (* TODO fix
+ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and statfs(StrPas(fixdrivestr[drive]),fs)) or
+ ((not (drivestr[Drive]=nil)) and statfs(StrPas(drivestr[drive]),fs)) then
+ DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+ else
+ DiskSize:=-1;
+ *)
+End;
+
+Function GetCurrentDir : String;
+begin
+ GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+//TODO fix
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+begin
+ (* TODO fix
+ Unix.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second);
+ Unix.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
+ SystemTime.MilliSecond := 0;
+ *)
+end ;
+
+
+Procedure InitAnsi;
+Var
+ i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ (* TODO fix
+ Result:=StrError(ErrorCode);
+ *)
+end;
+
+{****************************************************************************
+ OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ (* TODO fix
+ Result:=StrPas(Unix.Getenv(PChar(EnvVar)));
+ *)
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ // Result:=FPCCountEnvVar(EnvP);
+ Result:=0;
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ // Result:=FPCGetEnvStrFromP(Envp,Index);
+ Result:='';
+end;
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+var
+ s: AnsiString;
+ wdpath: AnsiString;
+ laststatuscode : longint;
+Begin
+ {Make ToolServers working directory in sync with our working directory}
+ PathArgToFullPath(':', wdpath);
+ wdpath:= 'Directory ' + wdpath;
+ Result := ExecuteToolserverScript(PChar(wdpath), laststatuscode);
+ {TODO Only change path when actually needed. But this requires some
+ change counter to be incremented each time wd is changed. }
+
+ s:= path + ' ' + comline;
+
+ Result := ExecuteToolserverScript(PChar(s), laststatuscode);
+ if Result = afpItemNotFound then
+ Result := 900
+ else
+ Result := MacOSErr2RTEerr(Result);
+ if Result <> 0
+ then
+ raise EOSErr;
+ //TODO Better dos error codes
+ if laststatuscode <> 0 then
+ begin
+ {MPW status might be 24 bits}
+ Result := laststatuscode and $ffff;
+ if Result = 0 then
+ Result := 1;
+ end
+ else
+ Result := 0;
+End;
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
+begin
+end;
+
+procedure Sleep(milliseconds: Cardinal);
+begin
+end;
+
+(*
+Function GetLastOSError : Integer;
+
+begin
+end;
+*)
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+
+{
+ $Log: sysutils.pp,v $
+ Revision 1.7 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.5 2005/01/24 18:28:58 olle
+ + a tiny bit of support for macos
+ + warning that this is under construction
+
+}
diff --git a/rtl/morphos/Makefile b/rtl/morphos/Makefile
new file mode 100644
index 0000000000..1cd5f52055
--- /dev/null
+++ b/rtl/morphos/Makefile
@@ -0,0 +1,2006 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=morphos
+override CPU_TARGET_DEFAULT=powerpc
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+SYSTEMUNIT=system
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings dos sysutils classes math typinfo varutils charset ucomplex getopts matrix variants types rtlconsts sysconst dateutil exec timer doslib utility hardware inputevent graphics layers intuition clipboard asl ahi get9
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math rtlconsts varutils typinfo variants classes sysconst dateutil
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+%$(OEXT) : %.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)$*$(OEXT) $*.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+exec$(PPUEXT) : exec.pp execf.inc execd.inc
+timer$(PPUEXT) : timer.pp timerd.inc timerf.inc
+utility$(PPUEXT) : utility.pp exec$(PPUEXT) utilf.inc utild1.inc utild2.inc
+doslib$(PPUEXT) : doslib.pp exec$(PPUEXT) timer$(PPUEXT) doslibd.inc doslibf.inc
+hardware$(PPUEXT): hardware.pas exec$(PPUEXT)
+inputevent$(PPUEXT): inputevent.pas exec$(PPUEXT) timer$(PPUEXT) utility$(PPUEXT)
+graphics$(PPUEXT): graphics.pas exec$(PPUEXT) utility$(PPUEXT) hardware$(PPUEXT)
+layers$(PPUEXT) : layers.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT)
+intuition$(PPUEXT): intuition.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT) \
+ inputevent$(PPUEXT) timer$(PPUEXT) layers$(PPUEXT)
+clipboard$(PPUEXT): clipboard.pas exec$(PPUEXT)
+asl$(PPUEXT): asl.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT)
+ahi$(PPUEXT): ahi.pas exec$(PPUEXT) utility$(PPUEXT)
+get9$(PPUEXT): get9.pas exec$(PPUEXT)
diff --git a/rtl/morphos/Makefile.fpc b/rtl/morphos/Makefile.fpc
new file mode 100644
index 0000000000..0e2132bbc9
--- /dev/null
+++ b/rtl/morphos/Makefile.fpc
@@ -0,0 +1,199 @@
+#
+# Makefile.fpc for Free Pascal MorphOS RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0
+units=$(SYSTEMUNIT) objpas macpas strings \
+ dos \
+ sysutils classes math typinfo varutils \
+ charset ucomplex getopts matrix \
+ variants types rtlconsts sysconst dateutil \
+ exec timer doslib utility hardware inputevent graphics layers \
+ intuition clipboard asl ahi get9
+rsts=math rtlconsts varutils typinfo variants classes sysconst dateutil
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=morphos
+cpu=powerpc
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+SYSTEMUNIT=system
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+%$(OEXT) : %.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)$*$(OEXT) $*.as
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+#ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+#graph$(PPUEXT) : graph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
+
+#lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+exec$(PPUEXT) : exec.pp execf.inc execd.inc
+
+timer$(PPUEXT) : timer.pp timerd.inc timerf.inc
+
+utility$(PPUEXT) : utility.pp exec$(PPUEXT) utilf.inc utild1.inc utild2.inc
+
+doslib$(PPUEXT) : doslib.pp exec$(PPUEXT) timer$(PPUEXT) doslibd.inc doslibf.inc
+
+hardware$(PPUEXT): hardware.pas exec$(PPUEXT)
+
+inputevent$(PPUEXT): inputevent.pas exec$(PPUEXT) timer$(PPUEXT) utility$(PPUEXT)
+
+graphics$(PPUEXT): graphics.pas exec$(PPUEXT) utility$(PPUEXT) hardware$(PPUEXT)
+
+layers$(PPUEXT) : layers.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT)
+
+intuition$(PPUEXT): intuition.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT) \
+ inputevent$(PPUEXT) timer$(PPUEXT) layers$(PPUEXT)
+
+clipboard$(PPUEXT): clipboard.pas exec$(PPUEXT)
+
+asl$(PPUEXT): asl.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT)
+
+ahi$(PPUEXT): ahi.pas exec$(PPUEXT) utility$(PPUEXT)
+
+get9$(PPUEXT): get9.pas exec$(PPUEXT)
diff --git a/rtl/morphos/ahi.pas b/rtl/morphos/ahi.pas
new file mode 100644
index 0000000000..1dc86f6009
--- /dev/null
+++ b/rtl/morphos/ahi.pas
@@ -0,0 +1,634 @@
+{
+ $Id: ahi.pas,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 Karoly Balogh for Genesi S.a.r.l.
+
+ ahi.library interface unit for MorphOS/PowerPC
+
+ Based on work of Nils Sjoholm member of the Amiga RTL
+ development team.
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$PACKRECORDS 2}
+unit AHI;
+
+interface
+
+uses exec, utility;
+
+var
+ AHIBase: PLibrary;
+
+ type
+
+ PFixed = ^Fixed;
+ Fixed = LONGINT;
+ { A fixed-point value, 16 bits
+ to the left of the point and
+ 16 bits to the right }
+
+ type
+
+ Psposition = ^sposition;
+ sposition = Fixed;
+
+ { AHIAudioCtrl }
+ { Lots of private data follows! }
+ PAHIAudioCtrl = ^tAHIAudioCtrl;
+ tAHIAudioCtrl = record
+ ahiac_UserData : Pointer;
+ end;
+
+ { AHISoundMessage }
+ PAHISoundMessage = ^tAHISoundMessage;
+ tAHISoundMessage = record
+ ahism_Channel : Word;
+ end;
+
+ { AHIRecordMessage }
+ PAHIRecordMessage = ^tAHIRecordMessage;
+ tAHIRecordMessage = record
+ ahirm_Type : Cardinal; { Format of buffer (object) }
+ ahirm_Buffer : Pointer; { Pointer to the sample array }
+ ahirm_Length : Cardinal; { Number of sample frames in buffer }
+ end;
+
+ { AHISampleInfo }
+ PAHISampleInfo = ^tAHISampleInfo;
+ tAHISampleInfo = record
+ ahisi_Type : Cardinal; { Format of samples }
+ ahisi_Address : Pointer; { Address to array of samples }
+ ahisi_Length : Cardinal; { Number of samples in array }
+ end;
+
+ { AHIAudioModeRequester }
+ PAHIAudioModeRequester = ^tAHIAudioModeRequester;
+ tAHIAudioModeRequester = record
+ ahiam_AudioID : Cardinal; { Selected audio mode }
+ ahiam_MixFreq : Cardinal; { Selected mixing/sampling frequency }
+ ahiam_LeftEdge : WORD; { Coordinates of requester on exit }
+ ahiam_TopEdge : WORD;
+ ahiam_Width : WORD;
+ ahiam_Height : WORD;
+ ahiam_InfoOpened : Boolean; { Info window opened on exit? }
+ ahiam_InfoLeftEdge : WORD; { Last coordinates of Info window }
+ ahiam_InfoTopEdge : WORD;
+ ahiam_InfoWidth : WORD;
+ ahiam_InfoHeight : WORD;
+ ahiam_UserData : Pointer; { You can store your own data here }
+ { Lots of private data follows! }
+ end;
+
+ { AHIEffMasterVolume }
+ PAHIEffMasterVolume = ^tAHIEffMasterVolume;
+ tAHIEffMasterVolume = record
+ ahie_Effect : Cardinal; { Set to AHIET_MASTERVOLUME }
+ ahiemv_Volume : Fixed; { See autodocs for range! }
+ end;
+
+ { AHIEffOutputBuffer }
+ PAHIEffOutputBuffer = ^tAHIEffOutputBuffer;
+ tAHIEffOutputBuffer = record
+ ahie_Effect : Cardinal; { Set to AHIET_OUTPUTBUFFER }
+ ahieob_Func : PHook;
+ { These fields are filled by AHI }
+ ahieob_Type : Cardinal; { Format of buffer }
+ ahieob_Buffer : Pointer; { Pointer to the sample array }
+ ahieob_Length : Cardinal; { Number of sample frames in buffer }
+ end;
+
+ { AHIEffDSPMask (V4) }
+ PAHIEffDSPMask = ^tAHIEffDSPMask;
+ tAHIEffDSPMask = record
+ ahie_Effect : Cardinal; { Set to AHIET_DSPMASK }
+ ahiedm_Channels : Word; { Number of elements in array }
+ ahiedm_Mask : array[0..0] of Byte; { Here follows the array }
+ end;
+
+
+ const
+ AHIEDM_WET = 0;
+ AHIEDM_DRY = 1;
+ { AHIEffDSPEcho (V4) }
+ type
+ PAHIDSPEcho = ^tAHIDSPEcho;
+ tAHIDSPEcho = record
+ ahie_Effect : Cardinal; { Set to AHIET_DSPECHO }
+ ahiede_Delay : Cardinal; { In samples }
+ ahiede_Feedback : Fixed;
+ ahiede_Mix : Fixed;
+ ahiede_Cross : Fixed;
+ end;
+
+ { AHIEffChannelInfo (V4) }
+ PAHIEffChannelInfo = ^tAHIEffChannelInfo;
+ tAHIEffChannelInfo = record
+ ahie_Effect : Cardinal; { Set to AHIET_CHANNELINFO }
+ ahieci_Func : PHook;
+ ahieci_Channels : Word;
+ ahieci_Pad : Word;
+ { The rest is filled by AHI }
+ ahieci_Offset : array[0..0] of Cardinal; { The array follows }
+ end;
+
+ { TAGS }
+
+ const
+ AHI_TagBase = TAG_USER;
+ AHI_TagBaseR = AHI_TagBase or $8000;
+ { AHI_AllocAudioA tags }
+ { Desired audio mode }
+ AHIA_AudioID = AHI_TagBase + 1;
+ { Suggested mixing frequency }
+ AHIA_MixFreq = AHI_TagBase + 2;
+ { Suggested number of channels }
+ AHIA_Channels = AHI_TagBase + 3;
+ { Number of sounds to use }
+ AHIA_Sounds = AHI_TagBase + 4;
+ { End-of-Sound Hook }
+ AHIA_SoundFunc = AHI_TagBase + 5;
+ { Player Hook }
+ AHIA_PlayerFunc = AHI_TagBase + 6;
+ { Frequency for player Hook (Fixed) }
+ AHIA_PlayerFreq = AHI_TagBase + 7;
+ { Minimum Frequency for player Hook }
+ AHIA_MinPlayerFreq = AHI_TagBase + 8;
+ { Maximum Frequency for player Hook }
+ AHIA_MaxPlayerFreq = AHI_TagBase + 9;
+ { Sample recording Hook }
+ AHIA_RecordFunc = AHI_TagBase + 10;
+ { What to put in ahiac_UserData }
+ AHIA_UserData = AHI_TagBase + 11;
+ { AHI_PlayA tags (V4) }
+ { All command tags should be... }
+ AHIP_BeginChannel = AHI_TagBase + 40;
+ { ... enclosed by these tags. }
+ AHIP_EndChannel = AHI_TagBase + 41;
+ AHIP_Freq = AHI_TagBase + 50;
+ AHIP_Vol = AHI_TagBase + 51;
+ AHIP_Pan = AHI_TagBase + 52;
+ AHIP_Sound = AHI_TagBase + 53;
+ AHIP_Offset = AHI_TagBase + 54;
+ AHIP_Length = AHI_TagBase + 55;
+ AHIP_LoopFreq = AHI_TagBase + 60;
+ AHIP_LoopVol = AHI_TagBase + 61;
+ AHIP_LoopPan = AHI_TagBase + 62;
+ AHIP_LoopSound = AHI_TagBase + 63;
+ AHIP_LoopOffset = AHI_TagBase + 64;
+ AHIP_LoopLength = AHI_TagBase + 65;
+ { AHI_ControlAudioA tags }
+ { Booleanean }
+ AHIC_Play = AHI_TagBase + 80;
+ { Booleanean }
+ AHIC_Record = AHI_TagBase + 81;
+ AHIC_MonitorVolume = AHI_TagBase + 82;
+ { ti_Data is pointer to Fixed (LONG) }
+ AHIC_MonitorVolume_Query = AHI_TagBase + 83;
+ { ti_Data is pointer to Cardinal }
+ AHIC_MixFreq_Query = AHI_TagBase + 84;
+ { --- New for V2, they will be ignored by V1 --- }
+ AHIC_InputGain = AHI_TagBase + 85;
+ { ti_Data is pointer to Fixed (LONG) }
+ AHIC_InputGain_Query = AHI_TagBase + 86;
+ AHIC_OutputVolume = AHI_TagBase + 87;
+ { ti_Data is pointer to Fixed (LONG) }
+ AHIC_OutputVolume_Query = AHI_TagBase + 88;
+ AHIC_Input = AHI_TagBase + 89;
+ { ti_Data is pointer to Cardinal }
+ AHIC_Input_Query = AHI_TagBase + 90;
+ AHIC_Output = AHI_TagBase + 91;
+ { ti_Data is pointer to Cardinal }
+ AHIC_Output_Query = AHI_TagBase + 92;
+ { AHI_GetAudioAttrsA tags }
+ AHIDB_AudioID = AHI_TagBase + 100;
+ { Pointer to name of driver }
+ AHIDB_Driver = AHI_TagBaseR + 101;
+ { Private! }
+ AHIDB_Flags = AHI_TagBase + 102;
+ { Booleanean }
+ AHIDB_Volume = AHI_TagBase + 103;
+ { Booleanean }
+ AHIDB_Panning = AHI_TagBase + 104;
+ { Booleanean }
+ AHIDB_Stereo = AHI_TagBase + 105;
+ { Booleanean }
+ AHIDB_HiFi = AHI_TagBase + 106;
+ { Booleanean }
+ AHIDB_PingPong = AHI_TagBase + 107;
+ { Private! }
+ AHIDB_MultTable = AHI_TagBase + 108;
+ { Pointer to name of this mode }
+ AHIDB_Name = AHI_TagBaseR + 109;
+ { Output bits }
+ AHIDB_Bits = AHI_TagBase + 110;
+ { Max supported channels }
+ AHIDB_MaxChannels = AHI_TagBase + 111;
+ { Min mixing freq. supported }
+ AHIDB_MinMixFreq = AHI_TagBase + 112;
+ { Max mixing freq. supported }
+ AHIDB_MaxMixFreq = AHI_TagBase + 113;
+ { Booleanean }
+ AHIDB_Record = AHI_TagBase + 114;
+ AHIDB_Frequencies = AHI_TagBase + 115;
+ { ti_Data is frequency index }
+ AHIDB_FrequencyArg = AHI_TagBase + 116;
+ AHIDB_Frequency = AHI_TagBase + 117;
+ { Pointer to driver author name }
+ AHIDB_Author = AHI_TagBase + 118;
+ { Pointer to driver copyright notice }
+ AHIDB_Copyright = AHI_TagBase + 119;
+ { Pointer to driver version string }
+ AHIDB_Version = AHI_TagBase + 120;
+ { Pointer to driver annotation text }
+ AHIDB_Annotation = AHI_TagBase + 121;
+ { Specifies the string buffer size }
+ AHIDB_BufferLen = AHI_TagBase + 122;
+ { ti_Data is frequency! }
+ AHIDB_IndexArg = AHI_TagBase + 123;
+ AHIDB_Index = AHI_TagBase + 124;
+ { Booleanean }
+ AHIDB_Realtime = AHI_TagBase + 125;
+ { It's sample frames }
+ AHIDB_MaxPlaySamples = AHI_TagBase + 126;
+ { It's sample frames }
+ AHIDB_MaxRecordSamples = AHI_TagBase + 127;
+ { Booleanean }
+ AHIDB_FullDuplex = AHI_TagBase + 129;
+ { --- New for V2, they will be ignored by V1 --- }
+ AHIDB_MinMonitorVolume = AHI_TagBase + 130;
+ AHIDB_MaxMonitorVolume = AHI_TagBase + 131;
+ AHIDB_MinInputGain = AHI_TagBase + 132;
+ AHIDB_MaxInputGain = AHI_TagBase + 133;
+ AHIDB_MinOutputVolume = AHI_TagBase + 134;
+ AHIDB_MaxOutputVolume = AHI_TagBase + 135;
+ AHIDB_Inputs = AHI_TagBase + 136;
+ { ti_Data is input index }
+ AHIDB_InputArg = AHI_TagBase + 137;
+ AHIDB_Input = AHI_TagBase + 138;
+ AHIDB_Outputs = AHI_TagBase + 139;
+ { ti_Data is input index }
+ AHIDB_OutputArg = AHI_TagBase + 140;
+ AHIDB_Output = AHI_TagBase + 141;
+ { --- New for V4, they will be ignored by V2 and earlier --- }
+ { Private! }
+ AHIDB_Data = AHI_TagBaseR + 142;
+ { AHI_BestAudioIDA tags }
+ { --- New for V4, they will be ignored by V2 and earlier --- }
+ AHIB_Dizzy = AHI_TagBase + 190;
+ { AHI_AudioRequestA tags }
+ { Window control }
+ { Parent window }
+ AHIR_Window = AHI_TagBase + 200;
+ { Screen to open on if no window }
+ AHIR_Screen = AHI_TagBase + 201;
+ { Name of public screen }
+ AHIR_PubScreenName = AHI_TagBase + 202;
+ { Allocate private IDCMP? }
+ AHIR_PrivateIDCMP = AHI_TagBase + 203;
+ { Function to handle IntuiMessages }
+ AHIR_IntuiMsgFunc = AHI_TagBase + 204;
+ { Block input in AHIR_Window? }
+ AHIR_SleepWindow = AHI_TagBase + 205;
+ { What to put in ahiam_UserData }
+ AHIR_UserData = AHI_TagBase + 206;
+ { Text display }
+ { Text font to use for gadget text }
+ AHIR_TextAttr = AHI_TagBase + 220;
+ { Locale to use for text }
+ AHIR_Locale = AHI_TagBase + 221;
+ { Title of requester }
+ AHIR_TitleText = AHI_TagBase + 222;
+ { Positive gadget text }
+ AHIR_PositiveText = AHI_TagBase + 223;
+ { Negative gadget text }
+ AHIR_NegativeText = AHI_TagBase + 224;
+ { Initial settings }
+ { Initial requester coordinates }
+ AHIR_InitialLeftEdge = AHI_TagBase + 240;
+ AHIR_InitialTopEdge = AHI_TagBase + 241;
+ { Initial requester dimensions }
+ AHIR_InitialWidth = AHI_TagBase + 242;
+ AHIR_InitialHeight = AHI_TagBase + 243;
+ { Initial audio mode id }
+ AHIR_InitialAudioID = AHI_TagBase + 244;
+ { Initial mixing/sampling frequency }
+ AHIR_InitialMixFreq = AHI_TagBase + 245;
+ { Info window initially opened? }
+ AHIR_InitialInfoOpened = AHI_TagBase + 246;
+ { Initial Info window coords. }
+ AHIR_InitialInfoLeftEdge = AHI_TagBase + 247;
+ AHIR_InitialInfoTopEdge = AHI_TagBase + 248;
+ { Not used! }
+ AHIR_InitialInfoWidth = AHI_TagBase + 249;
+ { Not used! }
+ AHIR_InitialInfoHeight = AHI_TagBase + 250;
+ { Options }
+ { Allow selection of mixing frequency? }
+ AHIR_DoMixFreq = AHI_TagBase + 260;
+ { Allow selection of default mode? (V4) }
+ AHIR_DoDefaultMode = AHI_TagBase + 261;
+ { Filtering }
+ { Pointer to filter taglist }
+ AHIR_FilterTags = AHI_TagBase + 270;
+ { Function to filter mode id's }
+ AHIR_FilterFunc = AHI_TagBase + 271;
+ { DEFS }
+ AHINAME : PChar = 'ahi.device';
+ { Invalid Audio ID }
+ AHI_INVALID_ID = not (0);
+ { Only for AHI_AllocAudioA()! }
+ AHI_DEFAULT_ID = $00000000;
+ { Special sample render Audio ID }
+ AHI_LOOPBACK_ID = $00000001;
+ { Only for AHI_AllocAudioA()! }
+ AHI_DEFAULT_FREQ = 0;
+ { Special frequency for AHI_SetFreq() }
+ AHI_MIXFREQ = not (0);
+ { Turns a channel off }
+ AHI_NOSOUND = $ffff;
+ { Set#? Flags }
+ AHISF_IMM = 1 shl 0;
+ AHISB_IMM = 0;
+ { Effect Types }
+ { OR with effect to disable }
+ AHIET_CANCEL = 1 shl 31;
+ AHIET_MASTERVOLUME = 1;
+ AHIET_OUTPUTBUFFER = 2;
+ { --- New for V4 --- }
+ AHIET_DSPMASK = 3;
+ AHIET_DSPECHO = 4;
+ AHIET_CHANNELINFO = 5;
+ { Sound Types }
+ { Private }
+ AHIST_NOTYPE = not (0);
+ { 8 or 16 bit sample }
+ AHIST_SAMPLE = 0;
+ { Dynamic sample }
+ AHIST_DYNAMICSAMPLE = 1;
+ { The input from your sampler }
+ AHIST_INPUT = 1 shl 29;
+ { Private }
+ AHIST_BW = 1 shl 30;
+ { Sample types }
+ { Note that only AHIST_M8S, AHIST_S8S, AHIST_M16S and AHIST_S16S
+ are supported by AHI_LoadSound(). }
+ { Mono, 8 bit signed (BYTE) }
+ AHIST_M8S = 0;
+ { Mono, 16 bit signed (WORD) }
+ AHIST_M16S = 1;
+ { Stereo, 8 bit signed (2×BYTE) }
+ AHIST_S8S = 2;
+ { Stereo, 16 bit signed (2×WORD) }
+ AHIST_S16S = 3;
+ { Mono, 32 bit signed (LONG) }
+ AHIST_M32S = 8;
+ { Stereo, 32 bit signed (2×LONG) }
+ AHIST_S32S = 10;
+ { OBSOLETE! }
+ AHIST_M8U = 4;
+ { Error codes }
+ { No error }
+ AHIE_OK = 0;
+ { Out of memory }
+ AHIE_NOMEM = 1;
+ { Unknown sound type }
+ AHIE_BADSOUNDTYPE = 2;
+ { Unknown/unsupported sample type }
+ AHIE_BADSAMPLETYPE = 3;
+ { User-triggered abortion }
+ AHIE_ABORTED = 4;
+ { Error, but unknown }
+ AHIE_UNKNOWN = 5;
+ { CMD_WRITE/CMD_READ failure }
+ AHIE_HALFDUPLEX = 6;
+ { DEVICE INTERFACE DEFINITIONS FOLLOWS }
+ { Device units }
+ AHI_DEFAULT_UNIT = 0;
+ AHI_NO_UNIT = 255;
+ { The preference file }
+ ID_AHIU = $41484955;
+ ID_AHIG = $41484947;
+
+
+ type
+ PAHIUnitPrefs = ^tAHIUnitPrefs;
+ tAHIUnitPrefs = record
+ ahiup_Unit : Byte;
+ ahiup_Pad : Byte;
+ ahiup_Channels : Word;
+ ahiup_AudioMode : Cardinal;
+ ahiup_Frequency : Cardinal;
+ ahiup_MonitorVolume : Fixed;
+ ahiup_InputGain : Fixed;
+ ahiup_OutputVolume : Fixed;
+ ahiup_Input : Cardinal;
+ ahiup_Output : Cardinal;
+ end;
+
+
+
+ PAHIGlobalPrefs = ^tAHIGlobalPrefs;
+ tAHIGlobalPrefs = record
+ ahigp_DebugLevel : Word; { Range: 0-3 (for None, Low,}
+ ahigp_DisableSurround : Boolean; { High and All) }
+ ahigp_DisableEcho : Boolean;
+ ahigp_FastEcho : Boolean;
+ ahigp_MaxCPU : Fixed;
+ ahigp_ClipMasterVolume : Boolean;
+ end;
+
+ { Debug levels }
+
+ const
+ AHI_DEBUG_NONE = 0;
+ AHI_DEBUG_LOW = 1;
+ AHI_DEBUG_HIGH = 2;
+ AHI_DEBUG_ALL = 3;
+
+ { AHIRequest }
+ type
+ PAHIRequest = ^tAHIRequest;
+ tAHIRequest = record
+ ahir_Std : tIOStdReq; { Standard IO request }
+ ahir_Version : Word; { Needed version }
+ { --- New for V4, they will be ignored by V2 and earlier --- }
+ ahir_Pad1 : Word;
+ ahir_Private : array[0..1] of Cardinal; { Hands off! }
+ ahir_Type : Cardinal; { Sample format }
+ ahir_Frequency : Cardinal; { Sample/Record frequency }
+ ahir_Volume : Fixed; { Sample volume }
+ ahir_Position : Fixed; { Stereo position }
+ ahir_Link : PAHIRequest; { For double buffering }
+ end;
+
+ { Flags for OpenDevice() }
+
+ const
+ AHIDF_NOMODESCAN = 1 shl 0;
+ AHIDB_NOMODESCAN = 0;
+
+
+function AHI_AllocAudioA(tagList : pTagItem location 'a1') : pAHIAudioCtrl;
+SysCall AHIBase 042;
+
+procedure AHI_FreeAudio(AudioCtrl : pAHIAudioCtrl location 'a2');
+SysCall AHIBase 048;
+
+procedure AHI_KillAudio;
+SysCall AHIBase 054;
+
+function AHI_ControlAudioA(AudioCtrl : pAHIAudioCtrl location 'a2'; tagList : pTagItem location 'a1') : Cardinal;
+SysCall AHIBase 060;
+
+procedure AHI_SetVol(Channel : Word location 'd0'; Volume : LongInt location 'd1'; Pan : LongInt location 'd2'; AudioCtrl : pAHIAudioCtrl location 'a2'; Flags : Cardinal location 'd3');
+SysCall AHIBase 066;
+
+procedure AHI_SetFreq(Channel : Word location 'd0'; Freq : Cardinal location 'd1'; AudioCtrl : pAHIAudioCtrl location 'a2'; Flags : Cardinal location 'd2');
+SysCall AHIBase 072;
+
+procedure AHI_SetSound(Channel : Word location 'd0'; Sound : Word location 'd1'; Offset : Cardinal location 'd2'; Length : LongInt location 'd3'; AudioCtrl : pAHIAudioCtrl location 'a2'; Flags : Cardinal location 'd4');
+SysCall AHIBase 078;
+
+function AHI_SetEffect(Effect : Pointer location 'a0'; AudioCtrl : pAHIAudioCtrl location 'a2') : Cardinal;
+SysCall AHIBase 084;
+
+function AHI_LoadSound(Sound : Word location 'd0'; SType : Cardinal location 'd1'; Info : Pointer location 'a0'; AudioCtrl : pAHIAudioCtrl location 'a2') : Cardinal;
+SysCall AHIBase 090;
+
+procedure AHI_UnloadSound(Sound : Word location 'd0'; Audioctrl : pAHIAudioCtrl location 'a2');
+SysCall AHIBase 096;
+
+function AHI_NextAudioID(Last_ID : Cardinal location 'd0') : Cardinal;
+SysCall AHIBase 102;
+
+function AHI_GetAudioAttrsA(ID : Cardinal location 'd0'; Audioctrl : pAHIAudioCtrl location 'a2'; tagList : pTagItem location 'a1') : BOOLEAN;
+SysCall AHIBase 108;
+
+function AHI_BestAudioIDA(tagList : pTagItem location 'a1') : Cardinal;
+SysCall AHIBase 114;
+
+function AHI_AllocAudioRequestA(tagList : pTagItem location 'a0') : pAHIAudioModeRequester;
+SysCall AHIBase 120;
+
+function AHI_AudioRequestA(Requester : pAHIAudioModeRequester location 'a0'; tagList : pTagItem location 'a1') : BOOLEAN;
+SysCall AHIBase 126;
+
+procedure AHI_FreeAudioRequest(Requester : pAHIAudioModeRequester location 'a0');
+SysCall AHIBase 132;
+
+procedure AHI_PlayA(Audioctrl : pAHIAudioCtrl location 'a2'; tagList : pTagItem location 'a1');
+SysCall AHIBase 138;
+
+function AHI_SampleFrameSize(SampleType : Cardinal location 'd0') : Cardinal;
+SysCall AHIBase 144;
+
+function AHI_AddAudioMode(a0arg : pTagItem location 'a0') : Cardinal;
+SysCall AHIBase 150;
+
+function AHI_RemoveAudioMode(d0arg : Cardinal location 'd0') : Cardinal;
+SysCall AHIBase 156;
+
+function AHI_LoadModeFile(a0arg : PChar location 'a0') : Cardinal;
+SysCall AHIBase 162;
+
+
+{
+ Functions and procedures with tags
+}
+function AHI_AllocAudio(tagList : array of DWord): pAHIAudioCtrl;
+function AHI_ControlAudio(AudioCtrl : pAHIAudioCtrl; tagList : array Of DWord) : Cardinal;
+function AHI_GetAudioAttrs(ID : CARDINAL; Audioctrl : pAHIAudioCtrl; taglist : array of DWord) : Boolean;
+function AHI_BestAudioID(taglist : array of DWord) : Cardinal;
+function AHI_AllocAudioRequest(taglist : array of DWord) : pAHIAudioModeRequester;
+function AHI_AudioRequest(Requester : pAHIAudioModeRequester; taglist : array of DWord) : Boolean;
+procedure AHI_Play(Audioctrl : pAHIAudioCtrl; taglist : array of DWord);
+
+function InitAHILibrary : boolean;
+
+
+implementation
+
+
+function AHI_AllocAudio(tagList : array of DWord): pAHIAudioCtrl;
+begin
+ AHI_AllocAudio:=AHI_AllocAudioA(@taglist);
+end;
+
+function AHI_AllocAudioRequest(taglist : array of DWord) : pAHIAudioModeRequester;
+begin
+ AHI_AllocAudioRequest:=AHI_AllocAudioRequestA(@taglist);
+end;
+
+function AHI_AudioRequest(Requester : pAHIAudioModeRequester; taglist : array of DWord) : Boolean;
+begin
+ AHI_AudioRequest:=AHI_AudioRequestA(Requester,@taglist);
+end;
+
+function AHI_BestAudioID(taglist : array of DWord) : longword;
+begin
+ AHI_BestAudioID:=AHI_BestAudioIDA(@taglist);
+end;
+
+function AHI_ControlAudio(AudioCtrl : pAHIAudioCtrl; taglist : array of DWord) : longword;
+begin
+ AHI_ControlAudio:=AHI_ControlAudioA(AudioCtrl,@taglist);
+end;
+
+function AHI_GetAudioAttrs(ID : longword; Audioctrl : pAHIAudioCtrl; taglist : array of DWord) : Boolean;
+begin
+ AHI_GetAudioAttrs:=AHI_GetAudioAttrsA(ID,Audioctrl,@taglist);
+end;
+
+procedure AHI_Play(Audioctrl : pAHIAudioCtrl; taglist : array of DWord);
+begin
+ AHI_PlayA(Audioctrl,@taglist);
+end;
+
+
+const
+ { Change VERSION and LIBVERSION to proper values }
+
+ VERSION : string[2] = '0';
+ LIBVERSION : longword = 0;
+
+var
+ ahi_exit : Pointer;
+
+procedure CloseAHILibrary;
+begin
+ ExitProc := ahi_exit;
+ if AHIBase <> nil then begin
+ CloseLibrary(PLibrary(AHIBase));
+ AHIBase := nil;
+ end;
+end;
+
+function InitAHILibrary : boolean;
+begin
+ AHIBase := nil;
+ AHIBase := OpenLibrary(AHINAME,LIBVERSION);
+ if AHIBase <> nil then begin
+ ahi_exit := ExitProc;
+ ExitProc := @CloseAhiLibrary;
+ InitAhiLibrary:=True;
+ end else begin
+ InitAhiLibrary:=False;
+ end;
+end;
+
+end. (* UNIT AHI *)
+
+{
+ $Log
+}
diff --git a/rtl/morphos/asl.pas b/rtl/morphos/asl.pas
new file mode 100644
index 0000000000..bb465eaf95
--- /dev/null
+++ b/rtl/morphos/asl.pas
@@ -0,0 +1,620 @@
+{
+ $Id: asl.pas,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 Karoly Balogh for Genesi S.a.r.l.
+
+ intuition.library interface unit for MorphOS/PowerPC
+
+ Based on work of Nils Sjoholm member of the Amiga RTL
+ development team.
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$PACKRECORDS 2}
+unit asl;
+
+interface
+
+uses exec, utility, {workbench,} graphics;
+
+
+{************************************************************************}
+
+const
+ ASLNAME : PChar = 'asl.library';
+ ASL_TB = TAG_USER+$80000;
+
+{************************************************************************}
+
+{ Types of requesters known to ASL, used as arguments to AllocAslRequest() }
+ ASL_FileRequest = 0;
+ ASL_FontRequest = 1;
+ ASL_ScreenModeRequest = 2;
+
+
+{****************************************************************************
+ *
+ * ASL File Requester data structures and constants
+ *
+ * This structure must only be allocated by asl.library amd is READ-ONLY!
+ * Control of the various fields is provided via tags when the requester
+ * is created with AllocAslRequest() and when it is displayed via
+ * AslRequest()
+ }
+
+type
+ pFileRequester = ^tFileRequester;
+ tFileRequester = record
+ rf_Reserved0 : Array[0..3] Of Byte;
+ rf_File : PChar; { Filename pointer }
+ rf_Dir : PChar; { Directory name pointer }
+ rf_Reserved1 : Array[0..9] Of Byte;
+ rf_LeftEdge : smallint;
+ rf_TopEdge : smallint; { Preferred window pos }
+ rf_Width : smallint;
+ rf_Height : smallint; { Preferred window size }
+ rf_Reserved2 : Array[0..1] Of Byte;
+ rf_NumArgs : LongInt; { A-la WB Args, FOR multiselects }
+{$WARNING FIX ME!!! Needs workbench unit}
+{ rf_ArgList : pWBArgList;}
+ rf_ArgList : Pointer;
+ rf_UserData : Pointer; { Applihandle (you may write!!) }
+ rf_Reserved3 : Array[0..7] Of Byte;
+ rf_Pat : PChar; { Pattern match pointer }
+ END; { note - more reserved fields follow }
+
+
+{ File requester tag values, used by AllocAslRequest() and AslRequest() }
+
+const
+{ Window control }
+ ASLFR_Window = ASL_TB+2 ; { Parent window }
+ ASLFR_Screen = ASL_TB+40; { Screen to open on if no window }
+ ASLFR_PubScreenName = ASL_TB+41; { Name of public screen }
+ ASLFR_PrivateIDCMP = ASL_TB+42; { Allocate private IDCMP? }
+ ASLFR_IntuiMsgFunc = ASL_TB+70; { Function to handle IntuiMessages }
+ ASLFR_SleepWindow = ASL_TB+43; { Block input in ASLFR_Window? }
+ ASLFR_UserData = ASL_TB+52; { What to put in fr_UserData }
+ ASLFR_PopToFront = ASL_TB+131; { Make the requester window visible }
+ ASLFR_Activate = ASL_TB+132; { Activate the requester window when }
+
+{ Text display }
+ ASLFR_TextAttr = ASL_TB+51; { Text font to use for gadget text }
+ ASLFR_Locale = ASL_TB+50; { Locale ASL should use for text }
+ ASLFR_TitleText = ASL_TB+1 ; { Title of requester }
+ ASLFR_PositiveText = ASL_TB+18; { Positive gadget text }
+ ASLFR_NegativeText = ASL_TB+19; { Negative gadget text }
+
+{ Initial settings }
+ ASLFR_InitialLeftEdge= ASL_TB+3 ; { Initial requester coordinates }
+ ASLFR_InitialTopEdge = ASL_TB+4 ;
+ ASLFR_InitialWidth = ASL_TB+5 ; { Initial requester dimensions }
+ ASLFR_InitialHeight = ASL_TB+6 ;
+ ASLFR_InitialFile = ASL_TB+8 ; { Initial contents of File gadget }
+ ASLFR_InitialDrawer = ASL_TB+9 ; { Initial contents of Drawer gadg. }
+ ASLFR_InitialPattern = ASL_TB+10; { Initial contents of Pattern gadg.}
+ ASLFR_InitialShowVolumes = ASL_TB+130; { Initially, show the volume list (V44) }
+
+{ Options }
+ ASLFR_Flags1 = ASL_TB+20; { Option flags }
+ ASLFR_Flags2 = ASL_TB+22; { Additional option flags }
+ ASLFR_DoSaveMode = ASL_TB+44; { Being used for saving? }
+ ASLFR_DoMultiSelect = ASL_TB+45; { Do multi-select? }
+ ASLFR_DoPatterns = ASL_TB+46; { Display a Pattern gadget? }
+
+{ Filtering }
+ ASLFR_DrawersOnly = ASL_TB+47; { Don't display files? }
+ ASLFR_FilterFunc = ASL_TB+49; { Function to filter files }
+ ASLFR_RejectIcons = ASL_TB+60; { Display .info files? }
+ ASLFR_RejectPattern = ASL_TB+61; { Don't display files matching pat }
+ ASLFR_AcceptPattern = ASL_TB+62; { Accept only files matching pat }
+ ASLFR_FilterDrawers = ASL_TB+63; { Also filter drawers with patterns}
+ ASLFR_HookFunc = ASL_TB+7 ; { Combined callback function }
+
+{ Sorting }
+ ASLFR_SetSortBy = ASL_TB+124; { Sort criteria (name, date, size) }
+ ASLFR_GetSortBy = ASL_TB+125;
+ ASLFR_SetSortDrawers = ASL_TB+126; { Placement of drawers in the list }
+ ASLFR_GetSortDrawers = ASL_TB+127;
+ ASLFR_SetSortOrder = ASL_TB+128; { Order (ascending or descending) }
+ ASLFR_GetSortOrder = ASL_TB+129;
+
+
+{ Flag bits for the ASLFR_Flags1 tag }
+ FRB_FILTERFUNC = 7;
+ FRB_INTUIFUNC = 6;
+ FRB_DOSAVEMODE = 5;
+ FRB_PRIVATEIDCMP = 4;
+ FRB_DOMULTISELECT = 3;
+ FRB_DOPATTERNS = 0;
+
+ FRF_FILTERFUNC = 128;
+ FRF_INTUIFUNC = 64;
+ FRF_DOSAVEMODE = 32;
+ FRF_PRIVATEIDCMP = 16;
+ FRF_DOMULTISELECT = 8;
+ FRF_DOPATTERNS = 1;
+
+{ Flag bits for the ASLFR_Flags2 tag }
+ FRB_DRAWERSONLY = 0;
+ FRB_FILTERDRAWERS = 1;
+ FRB_REJECTICONS = 2;
+
+ FRF_DRAWERSONLY = 1;
+ FRF_FILTERDRAWERS = 2;
+ FRF_REJECTICONS = 4;
+
+{ Sort criteria for the ASLFR_SetSortBy/ASLFR_GetSortBy tags }
+ ASLFRSORTBY_Name = 0;
+ ASLFRSORTBY_Date = 1;
+ ASLFRSORTBY_Size = 2;
+
+{ Drawer placement for the ASLFR_SetSortDrawers/ASLFR_GetSortDrawers tags }
+ ASLFRSORTDRAWERS_First = 0;
+ ASLFRSORTDRAWERS_Mix = 1;
+ ASLFRSORTDRAWERS_Last = 2;
+
+{ Sort order for the ASLFR_SetSortOrder/ASLFR_GetSortOrder tags }
+ ASLFRSORTORDER_Ascend = 0;
+ ASLFRSORTORDER_Descend = 1;
+
+{****************************************************************************
+ *
+ * ASL Font Requester data structures and constants
+ *
+ * This structure must only be allocated by asl.library amd is READ-ONLY!
+ * Control of the various fields is provided via tags when the requester
+ * is created with AllocAslRequest() and when it is displayed via
+ * AslRequest()
+ }
+
+type
+ pFontRequester = ^tFontRequester;
+ tFontRequester = record
+ fo_Reserved0 : Array[0..7] Of Byte;
+ fo_Attr : tTextAttr; { Returned TextAttr }
+ fo_FrontPen : Byte; { Returned front pen }
+ fo_BackPen : Byte; { Returned back pen }
+ fo_DrawMode : Byte; { Returned drawing mode }
+ fo_Reserved1 : Byte;
+ fo_UserData : Pointer; { You can store your own data here }
+ fo_LeftEdge : smallint; { Coordinates Of requester on Exit }
+ fo_TopEdge : smallint;
+ fo_Width : smallint;
+ fo_Height : smallint;
+ fo_TAttr : tTTextAttr; { Returned TTextAttr }
+ end;
+
+
+{ Font requester tag values, used by AllocAslRequest() AND AslRequest() }
+
+const
+{ Window control }
+ ASLFO_Window = ASL_TB+2 ; { Parent window }
+ ASLFO_Screen = ASL_TB+40; { Screen to open on if no window }
+ ASLFO_PubScreenName = ASL_TB+41; { Name of public screen }
+ ASLFO_PrivateIDCMP = ASL_TB+42; { Allocate private IDCMP? }
+ ASLFO_IntuiMsgFunc = ASL_TB+70; { Function to handle IntuiMessages }
+ ASLFO_SleepWindow = ASL_TB+43; { Block input in ASLFO_Window? }
+ ASLFO_UserData = ASL_TB+52; { What to put in fo_UserData }
+ ASLFO_PopToFront = ASL_TB+131; { Make the requester window visible
+ * when it opens (V44)
+ }
+ ASLFO_Activate = ASL_TB+132; { Activate the requester window when
+ * it opens (V45).
+ }
+{ Text display }
+ ASLFO_TextAttr = ASL_TB+51; { Text font to use for gadget text }
+ ASLFO_Locale = ASL_TB+50; { Locale ASL should use for text }
+ ASLFO_TitleText = ASL_TB+1 ; { Title of requester }
+ ASLFO_PositiveText = ASL_TB+18; { Positive gadget text }
+ ASLFO_NegativeText = ASL_TB+19; { Negative gadget text }
+
+{ Initial settings }
+ ASLFO_InitialLeftEdge= ASL_TB+3 ; { Initial requester coordinates }
+ ASLFO_InitialTopEdge = ASL_TB+4 ;
+ ASLFO_InitialWidth = ASL_TB+5 ; { Initial requester dimensions }
+ ASLFO_InitialHeight = ASL_TB+6 ;
+ ASLFO_InitialName = ASL_TB+10; { Initial contents of Name gadget }
+ ASLFO_InitialSize = ASL_TB+11; { Initial contents of Size gadget }
+ ASLFO_InitialStyle = ASL_TB+12; { Initial font style }
+ ASLFO_InitialFlags = ASL_TB+13; { Initial font flags for TextAttr }
+ ASLFO_InitialFrontPen= ASL_TB+14; { Initial front pen }
+ ASLFO_InitialBackPen = ASL_TB+15; { Initial back pen }
+ ASLFO_InitialDrawMode= ASL_TB+59; { Initial draw mode }
+
+{ Options }
+ ASLFO_Flags = ASL_TB+20; { Option flags }
+ ASLFO_DoFrontPen = ASL_TB+44; { Display Front color selector? }
+ ASLFO_DoBackPen = ASL_TB+45; { Display Back color selector? }
+ ASLFO_DoStyle = ASL_TB+46; { Display Style checkboxes? }
+ ASLFO_DoDrawMode = ASL_TB+47; { Display DrawMode cycle gadget? }
+ ASLFO_SampleText = ASL_TB+133; { Text to display in font sample area (V45) }
+
+{ Filtering }
+ ASLFO_FixedWidthOnly = ASL_TB+48; { Only allow fixed-width fonts? }
+ ASLFO_MinHeight = ASL_TB+16; { Minimum font height to display }
+ ASLFO_MaxHeight = ASL_TB+17; { Maximum font height to display }
+ ASLFO_FilterFunc = ASL_TB+49; { Function to filter fonts }
+ ASLFO_HookFunc = ASL_TB+7 ; { Combined callback function }
+ ASLFO_MaxFrontPen = ASL_TB+66; { Max # of colors in front palette }
+ ASLFO_MaxBackPen = ASL_TB+67; { Max # of colors in back palette }
+
+{ Custom additions }
+ ASLFO_ModeList = ASL_TB+21; { Substitute list for drawmodes }
+ ASLFO_FrontPens = ASL_TB+64; { Color table for front pen palette}
+ ASLFO_BackPens = ASL_TB+65; { Color table for back pen palette }
+
+{ Flag bits for ASLFO_Flags tag }
+ FOB_DOFRONTPEN = 0;
+ FOB_DOBACKPEN = 1;
+ FOB_DOSTYLE = 2;
+ FOB_DODRAWMODE = 3;
+ FOB_FIXEDWIDTHONLY= 4;
+ FOB_PRIVATEIDCMP = 5;
+ FOB_INTUIFUNC = 6;
+ FOB_FILTERFUNC = 7;
+
+ FOF_DOFRONTPEN = 1;
+ FOF_DOBACKPEN = 2;
+ FOF_DOSTYLE = 4;
+ FOF_DODRAWMODE = 8;
+ FOF_FIXEDWIDTHONLY = 16;
+ FOF_PRIVATEIDCMP = 32;
+ FOF_INTUIFUNC = 64;
+ FOF_FILTERFUNC = 128;
+
+{****************************************************************************
+ *
+ * ASL Screen Mode Requester data structures and constants
+ *
+ * This structure must only be allocated by asl.library and is READ-ONLY!
+ * Control of the various fields is provided via tags when the requester
+ * is created with AllocAslRequest() and when it is displayed via
+ * AslRequest()
+ }
+
+Type
+ pScreenModeRequester = ^tScreenModeRequester;
+ tScreenModeRequester = record
+ sm_DisplayID : Cardinal; { Display mode ID }
+ sm_DisplayWidth : Cardinal; { Width Of display IN pixels }
+ sm_DisplayHeight : Cardinal; { Height Of display IN pixels }
+ sm_DisplayDepth : word; { Number OF bit-planes OF display }
+ sm_OverscanType : word; { TYPE OF overscan OF display }
+ sm_AutoScroll : Boolean; { Display should auto-scroll? }
+
+ sm_BitMapWidth : Cardinal; { Used TO create your own BitMap }
+ sm_BitMapHeight : Cardinal;
+
+ sm_LeftEdge : smallint; { Coordinates OF requester on Exit }
+ sm_TopEdge : smallint;
+ sm_Width : smallint;
+ sm_Height : smallint;
+
+ sm_InfoOpened : Boolean; { Info window opened on exit? }
+ sm_InfoLeftEdge : smallint; { Last coordinates OF Info window }
+ sm_InfoTopEdge : smallint;
+ sm_InfoWidth : smallint;
+ sm_InfoHeight : smallint;
+
+ sm_UserData : Pointer; { You can store your own data here }
+ END;
+
+
+{ An Exec list of custom modes can be added to the list of available modes.
+ * The DimensionInfo structure must be completely initialized, including the
+ * Header. See <graphics/displayinfo.h>. Custom mode ID's must be in the range
+ * $FFFF0000..$FFFFFFFF. Regular properties which apply to your custom modes
+ * can be added in the dn_PropertyFlags field. Custom properties are not
+ * allowed.
+ }
+ pDisplayMode = ^tDisplayMode;
+ tDisplayMode = record
+ dm_Node : tNode; { see ln_Name }
+ dm_DimensionInfo : tDimensionInfo; { mode description }
+ dm_PropertyFlags : Cardinal; { applicable properties }
+ end;
+
+
+{ ScreenMode requester tag values, used by AllocAslRequest() and AslRequest() }
+const
+{ Window control }
+ ASLSM_Window = ASL_TB+2 ; { Parent window }
+ ASLSM_Screen = ASL_TB+40; { Screen to open on if no window }
+ ASLSM_PubScreenName = ASL_TB+41; { Name of public screen }
+ ASLSM_PrivateIDCMP = ASL_TB+42; { Allocate private IDCMP? }
+ ASLSM_IntuiMsgFunc = ASL_TB+70; { Function to handle IntuiMessages }
+ ASLSM_SleepWindow = ASL_TB+43; { Block input in ASLSM_Window? }
+ ASLSM_UserData = ASL_TB+52; { What to put in sm_UserData }
+ ASLSM_PopToFront = ASL_TB+131; { Make the requester window visible
+ * when it opens (V44)
+ }
+ ASLSM_Activate = ASL_TB+132; { Activate the requester window when
+ * it opens (V45).
+ }
+
+{ Text display }
+ ASLSM_TextAttr = ASL_TB+51; { Text font to use for gadget text }
+ ASLSM_Locale = ASL_TB+50; { Locale ASL should use for text }
+ ASLSM_TitleText = ASL_TB+1 ; { Title of requester }
+ ASLSM_PositiveText = ASL_TB+18; { Positive gadget text }
+ ASLSM_NegativeText = ASL_TB+19; { Negative gadget text }
+
+{ Initial settings }
+ ASLSM_InitialLeftEdge = ASL_TB+3 ; { Initial requester coordinates }
+ ASLSM_InitialTopEdge = ASL_TB+4 ;
+ ASLSM_InitialWidth = ASL_TB+5 ; { Initial requester dimensions }
+ ASLSM_InitialHeight = ASL_TB+6 ;
+ ASLSM_InitialDisplayID = ASL_TB+100; { Initial display mode id }
+ ASLSM_InitialDisplayWidth = ASL_TB+101; { Initial display width }
+ ASLSM_InitialDisplayHeight = ASL_TB+102; { Initial display height }
+ ASLSM_InitialDisplayDepth = ASL_TB+103; { Initial display depth }
+ ASLSM_InitialOverscanType = ASL_TB+104; { Initial type of overscan }
+ ASLSM_InitialAutoScroll = ASL_TB+105; { Initial autoscroll setting }
+ ASLSM_InitialInfoOpened = ASL_TB+106; { Info wndw initially opened? }
+ ASLSM_InitialInfoLeftEdge = ASL_TB+107; { Initial Info window coords. }
+ ASLSM_InitialInfoTopEdge = ASL_TB+108;
+
+{ Options }
+ ASLSM_DoWidth = ASL_TB+109; { Display Width gadget? }
+ ASLSM_DoHeight = ASL_TB+110; { Display Height gadget? }
+ ASLSM_DoDepth = ASL_TB+111; { Display Depth gadget? }
+ ASLSM_DoOverscanType = ASL_TB+112; { Display Overscan Type gadget? }
+ ASLSM_DoAutoScroll = ASL_TB+113; { Display AutoScroll gadget? }
+
+{ Filtering }
+ ASLSM_PropertyFlags = ASL_TB+114; { Must have these Property flags }
+ ASLSM_PropertyMask = ASL_TB+115; { Only these should be looked at }
+ ASLSM_MinWidth = ASL_TB+116; { Minimum display width to allow }
+ ASLSM_MaxWidth = ASL_TB+117; { Maximum display width to allow }
+ ASLSM_MinHeight = ASL_TB+118; { Minimum display height to allow }
+ ASLSM_MaxHeight = ASL_TB+119; { Maximum display height to allow }
+ ASLSM_MinDepth = ASL_TB+120; { Minimum display depth }
+ ASLSM_MaxDepth = ASL_TB+121; { Maximum display depth }
+ ASLSM_FilterFunc = ASL_TB+122; { Function to filter mode id's }
+
+{ Custom additions }
+ ASLSM_CustomSMList = ASL_TB+123; { Exec list of struct DisplayMode }
+
+{***************************************************************************}
+
+ ASL_LAST_TAG = ASL_TB+133;
+
+{***************************************************************************}
+
+{ This defines the rendezvous data for setting and querying asl.library's
+ * defaults for the window size and the file requester sort order. The name
+ * of the semaphore is given below; it exists only with asl.library V45 and
+ * IPrefs V45 and beyond.
+ }
+ ASL_SEMAPHORE_NAME : Pchar = 'asl.library';
+
+ type
+ PAslSemaphore = ^tAslSemaphore;
+ tAslSemaphore = record
+ as_Semaphore : tSignalSemaphore;
+ as_Version : Word; { Must be >= 45 }
+ as_Size : Cardinal; { Size of this data structure. }
+ as_SortBy : Byte; { File requester defaults; name, date or size }
+ as_SortDrawers : Byte; { File requester defaults; first, mix or last }
+ as_SortOrder : Byte; { File requester defaults; ascending or descending }
+ as_SizePosition : Byte; { See below }
+ as_RelativeLeft : WORD; { Window position offset }
+ as_RelativeTop : WORD;
+ as_RelativeWidth : Byte; { Window size factor; this is
+ * a percentage of the parent
+ * window/screen width.
+ }
+ as_RelativeHeight : Byte;
+ end;
+
+const
+{ Default position of the ASL window. }
+ ASLPOS_DefaultPosition = 0; { Position is calculated according to the builtin rules. }
+ ASLPOS_CenterWindow = 1; { Centred within the bounds of the parent window. }
+ ASLPOS_CenterScreen = 2; { Centred within the bounds of the parent screen. }
+ ASLPOS_WindowPosition = 3; { Relative to the top left corner of the parent window,
+ * using the offset values provided in the
+ * as_RelativeLeft/as_RelativeTop members.
+ }
+ ASLPOS_ScreenPosition = 4; { Relative to the top left corner of the parent screen,
+ * using the offset values provided in the
+ * as_RelativeLeft/as_RelativeTop members.
+ }
+ ASLPOS_CenterMouse = 5; { Directly below the mouse pointer. }
+ ASLPOS_MASK = $0F;
+
+{ Default size of the ASL window. }
+ ASLSIZE_DefaultSize = (0 shl 4); { Size is calculated according to the builtin rules. }
+ ASLSIZE_RelativeSize = (1 shl 4); { Size is relative to the size of the parent
+ * window or screen, using the values provided in
+ * the as_RelativeWidth/as_RelativeHeight members.
+ * The as_RelativeWidth/as_RelativeHeight values are
+ * taken as percentage, i.e. a value of "50" stands for
+ * 50% of the width/height of the parent window/screen.
+ }
+ ASLSIZE_MASK = $30;
+
+{ Other options. }
+ ASLOPTION_ASLOverrides = (1 shl 6); { ASL determines placement and size of requester
+ * windows; application's choice is ignored.
+ }
+
+
+{****************************************************************************
+ *
+ * Obsolete ASL definitions, here for source code compatibility only.
+ * Please do NOT use in new code.
+ *
+ * define ASL_V38_NAMES_ONLY to remove these older names
+ }
+{$define ASL_V38_NAMES_ONLY}
+{$ifndef ASL_V38_NAMES_ONLY}
+const
+ ASL_Dummy = (TAG_USER + $80000);
+ ASL_Hail = ASL_Dummy+1 ;
+ ASL_Window = ASL_Dummy+2 ;
+ ASL_LeftEdge = ASL_Dummy+3 ;
+ ASL_TopEdge = ASL_Dummy+4 ;
+ ASL_Width = ASL_Dummy+5 ;
+ ASL_Height = ASL_Dummy+6 ;
+ ASL_HookFunc = ASL_Dummy+7 ;
+ ASL_File = ASL_Dummy+8 ;
+ ASL_Dir = ASL_Dummy+9 ;
+ ASL_FontName = ASL_Dummy+10;
+ ASL_FontHeight = ASL_Dummy+11;
+ ASL_FontStyles = ASL_Dummy+12;
+ ASL_FontFlags = ASL_Dummy+13;
+ ASL_FrontPen = ASL_Dummy+14;
+ ASL_BackPen = ASL_Dummy+15;
+ ASL_MinHeight = ASL_Dummy+16;
+ ASL_MaxHeight = ASL_Dummy+17;
+ ASL_OKText = ASL_Dummy+18;
+ ASL_CancelText = ASL_Dummy+19;
+ ASL_FuncFlags = ASL_Dummy+20;
+ ASL_ModeList = ASL_Dummy+21;
+ ASL_ExtFlags1 = ASL_Dummy+22;
+ ASL_Pattern = ASL_FontName;
+{ remember what I said up there? Do not use these anymore! }
+ FILB_DOWILDFUNC = 7;
+ FILB_DOMSGFUNC = 6;
+ FILB_SAVE = 5;
+ FILB_NEWIDCMP = 4;
+ FILB_MULTISELECT = 3;
+ FILB_PATGAD = 0;
+ FILF_DOWILDFUNC = 128;
+ FILF_DOMSGFUNC = 64;
+ FILF_SAVE = 32;
+ FILF_NEWIDCMP = 16;
+ FILF_MULTISELECT = 8;
+ FILF_PATGAD = 1;
+ FIL1B_NOFILES = 0;
+ FIL1B_MATCHDIRS = 1;
+ FIL1F_NOFILES = 1;
+ FIL1F_MATCHDIRS = 2;
+ FONB_FRONTCOLOR = 0;
+ FONB_BACKCOLOR = 1;
+ FONB_STYLES = 2;
+ FONB_DRAWMODE = 3;
+ FONB_FIXEDWIDTH = 4;
+ FONB_NEWIDCMP = 5;
+ FONB_DOMSGFUNC = 6;
+ FONB_DOWILDFUNC = 7;
+ FONF_FRONTCOLOR = 1;
+ FONF_BACKCOLOR = 2;
+ FONF_STYLES = 4;
+ FONF_DRAWMODE = 8;
+ FONF_FIXEDWIDTH = 16;
+ FONF_NEWIDCMP = 32;
+ FONF_DOMSGFUNC = 64;
+ FONF_DOWILDFUNC = 128;
+{$endif ASL_V38_NAMES_ONLY}
+
+
+var
+ AslBase : pLibrary;
+
+function AllocFileRequest : pFileRequester;
+SysCall AslBase 030;
+
+procedure FreeFileRequest(fileReq : pFileRequester location 'a0');
+SysCall AslBase 036;
+
+function RequestFile(fileReq : pFileRequester location 'a0'): Boolean;
+SysCall AslBase 042;
+
+function AllocAslRequest(reqType: Cardinal location 'd0';
+ tagList: pTagItem location 'a0'): Pointer;
+SysCall AslBase 048;
+
+procedure FreeAslRequest(requester: Pointer location 'a0');
+SysCall AslBase 054;
+
+function AslRequest(requester: Pointer location 'a0';
+ tagList : pTagItem location 'a1'): Boolean;
+SysCall AslBase 060;
+
+procedure AbortAslRequest(requester: Pointer location 'a0');
+SysCall AslBase 078;
+
+procedure ActivateAslRequest(requester : Pointer location 'a0');
+SysCall AslBase 084;
+
+function AllocAslRequestTags(reqType: Cardinal;
+ tagList: array of DWord): Pointer; Inline;
+function AslRequestTags(requester: Pointer;
+ tagList : array of DWord): Boolean; Inline;
+
+function InitAslLibrary : boolean;
+
+
+implementation
+
+
+function AllocAslRequestTags(reqType: Cardinal;
+ tagList: array of DWord): Pointer; Inline;
+begin
+ AllocAslRequestTags:=AllocAslRequest(reqType,@tagList);
+end;
+
+function AslRequestTags(requester: Pointer;
+ tagList : array of DWord): Boolean; Inline;
+begin
+ AslRequestTags:=AslRequest(requester,@tagList);
+end;
+
+
+const
+ { Change VERSION and LIBVERSION to proper values }
+
+ VERSION : string[2] = '0';
+ LIBVERSION : longword = 0;
+
+var
+ asl_exit: Pointer;
+
+procedure CloseAslLibrary;
+begin
+ ExitProc := asl_exit;
+ if AslBase <> nil then begin
+ CloseLibrary(PLibrary(AslBase));
+ AslBase := nil;
+ end;
+end;
+
+function InitAslLibrary : boolean;
+begin
+ AslBase := nil;
+ AslBase := OpenLibrary(ASLNAME,LIBVERSION);
+ if AslBase <> nil then begin
+ asl_exit := ExitProc;
+ ExitProc := @CloseAslLibrary;
+ InitAslLibrary:=True;
+ end else begin
+ InitAslLibrary:=False;
+ end;
+end;
+
+
+end. (* UNIT ASL *)
+
+{
+ $Log: asl.pas,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/01/30 18:58:23 karoly
+ * initial revision
+
+}
diff --git a/rtl/morphos/classes.pp b/rtl/morphos/classes.pp
new file mode 100644
index 0000000000..1da78afe56
--- /dev/null
+++ b/rtl/morphos/classes.pp
@@ -0,0 +1,57 @@
+{
+ $Id: classes.pp,v 1.3 2005/03/07 17:57:24 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2002 by the Free Pascal development team
+
+ Classes unit for MorphOS
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ rtlconsts,
+ types,
+ typinfo;
+
+{$i classesh.inc}
+
+
+implementation
+
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.3 2005/03/07 17:57:24 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/clipboard.pas b/rtl/morphos/clipboard.pas
new file mode 100644
index 0000000000..346d49fbec
--- /dev/null
+++ b/rtl/morphos/clipboard.pas
@@ -0,0 +1,92 @@
+{
+ $Id: clipboard.pas,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ clipboard.device interface unit for MorphOS/PowerPC
+
+ Based on work of Nils Sjoholm member of the Amiga RTL
+ development team.
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$PACKRECORDS 2}
+
+unit clipboard;
+
+interface
+
+uses exec;
+
+const
+ CBD_POST = CMD_NONSTD + 0;
+ CBD_CURRENTREADID = CMD_NONSTD + 1;
+ CBD_CURRENTWRITEID = CMD_NONSTD + 2;
+ CBD_CHANGEHOOK = CMD_NONSTD + 3;
+
+ CBERR_OBSOLETEID = 1;
+
+type
+
+ pClipboardUnitPartial = ^tClipboardUnitPartial;
+ tClipboardUnitPartial = record
+ cu_Node : tNode; { list of units }
+ cu_UnitNum : DWord; { unit number for this unit }
+ { the remaining unit data is private to the device }
+ end;
+
+
+ pIOClipReq = ^tIOClipReq;
+ tIOClipReq = record
+ io_Message : tMessage;
+ io_Device : pDevice; { device node pointer }
+ io_Unit : pClipboardUnitPartial; { unit (driver private) }
+ io_Command : Word; { device command }
+ io_Flags : Byte; { including QUICK and SATISFY }
+ io_Error : Shortint; { error or warning num }
+ io_Actual : DWord; { number of bytes transferred }
+ io_Length : DWord; { number of bytes requested }
+ io_Data : PChar; { either clip stream or post port }
+ io_Offset : DWord; { offset in clip stream }
+ io_ClipID : Longint; { ordinal clip identifier }
+ end;
+
+const
+ PRIMARY_CLIP = 0; { primary clip unit }
+
+type
+
+ pSatisfyMsg = ^tSatisfyMsg;
+ tSatisfyMsg = record
+ sm_Msg : tMessage; { the length will be 6 }
+ sm_Unit : Word; { which clip unit this is }
+ sm_ClipID : Longint; { the clip identifier of the post }
+ end;
+
+ pClipHookMsg = ^tClipHookMsg;
+ tClipHookMsg = record
+ chm_Type : DWord; { zero for this structure format }
+ chm_ChangeCmd, { command that caused this hook invocation: }
+ { either CMD_UPDATE OR CBD_POST }
+ chm_ClipID : Longint; { the clip identifier of the new data }
+ END;
+
+implementation
+
+end.
+
+{
+ $Log: clipboard.pas,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/dos.pp b/rtl/morphos/dos.pp
new file mode 100644
index 0000000000..63e7d8c47f
--- /dev/null
+++ b/rtl/morphos/dos.pp
@@ -0,0 +1,1014 @@
+{
+ $Id: dos.pp,v 1.15 2005/04/07 03:57:58 karoly Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Karoly Balogh for Genesi S.a.r.l.
+
+ Heavily based on the Commodore Amiga/m68k RTL by Nils Sjoholm and
+ Carl Eric Codere
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$INLINE ON}
+
+unit Dos;
+
+{--------------------------------------------------------------------}
+{ LEFT TO DO: }
+{--------------------------------------------------------------------}
+{ o DiskFree / Disksize don't work as expected }
+{ o Implement EnvCount,EnvStr }
+{ o FindFirst should only work with correct attributes }
+{--------------------------------------------------------------------}
+
+
+interface
+
+type
+ SearchRec = Packed Record
+ { watch out this is correctly aligned for all processors }
+ { don't modify. }
+ { Replacement for Fill }
+{0} AnchorPtr : Pointer; { Pointer to the Anchorpath structure }
+{4} Fill: Array[1..15] of Byte; {future use}
+ {End of replacement for fill}
+ Attr : BYTE; {attribute of found file}
+ Time : LongInt; {last modify date of found file}
+ Size : LongInt; {file size of found file}
+ Name : String[255]; {name of found file}
+ End;
+
+{$I dosh.inc}
+
+implementation
+
+{$DEFINE HAS_GETMSCOUNT}
+{$DEFINE HAS_GETCBREAK}
+{$DEFINE HAS_SETCBREAK}
+
+{$DEFINE FPC_FEXPAND_VOLUMES} (* Full paths begin with drive specification *)
+{$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$I dos.inc}
+
+
+{ * include MorphOS specific functions & definitions * }
+
+{$include execd.inc}
+{$include execf.inc}
+{$include timerd.inc}
+{$include doslibd.inc}
+{$include doslibf.inc}
+{$include utilf.inc}
+
+const
+ DaysPerMonth : Array[1..12] of ShortInt =
+ (031,028,031,030,031,030,031,031,030,031,030,031);
+ DaysPerYear : Array[1..12] of Integer =
+ (031,059,090,120,151,181,212,243,273,304,334,365);
+ DaysPerLeapYear : Array[1..12] of Integer =
+ (031,060,091,121,152,182,213,244,274,305,335,366);
+ SecsPerYear : LongInt = 31536000;
+ SecsPerLeapYear : LongInt = 31622400;
+ SecsPerDay : LongInt = 86400;
+ SecsPerHour : Integer = 3600;
+ SecsPerMinute : ShortInt = 60;
+ TICKSPERSECOND = 50;
+
+
+{******************************************************************************
+ --- Internal routines ---
+******************************************************************************}
+
+{ * PathConv is implemented in the system unit! * }
+function PathConv(path: string): string; external name 'PATHCONV';
+
+function dosLock(const name: String;
+ accessmode: Longint) : LongInt;
+var
+ buffer: array[0..255] of Char;
+begin
+ move(name[1],buffer,length(name));
+ buffer[length(name)]:=#0;
+ dosLock:=Lock(buffer,accessmode);
+end;
+
+function BADDR(bval: LongInt): Pointer; Inline;
+begin
+ BADDR:=Pointer(bval Shl 2);
+end;
+
+function BSTR2STRING(s : LongInt): PChar; Inline;
+begin
+ BSTR2STRING:=Pointer(Longint(BADDR(s))+1);
+end;
+
+function IsLeapYear(Source : Word) : Boolean;
+begin
+ if (source Mod 400 = 0) or ((source Mod 4 = 0) and (source Mod 100 <> 0)) then
+ IsLeapYear:=True
+ else
+ IsLeapYear:=False;
+end;
+
+Procedure Amiga2DateStamp(Date : LongInt; Var TotalDays,Minutes,Ticks: longint);
+{ Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
+{ Taken from SWAG and modified to work with the Amiga format - CEC }
+Var
+ LocalDate : LongInt; Done : Boolean; TotDays : Integer;
+ Y: Word;
+ H: Word;
+ Min: Word;
+ S : Word;
+Begin
+ Y := 1978; H := 0; Min := 0; S := 0;
+ TotalDays := 0;
+ Minutes := 0;
+ Ticks := 0;
+ LocalDate := Date;
+ Done := False;
+ While Not Done Do
+ Begin
+ If LocalDate >= SecsPerYear Then
+ Begin
+ Inc(Y,1);
+ Dec(LocalDate,SecsPerYear);
+ Inc(TotalDays,DaysPerYear[12]);
+ End
+ Else
+ Done := True;
+ If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) And
+ (Not Done) Then
+ Begin
+ Inc(Y,1);
+ Dec(LocalDate,SecsPerLeapYear);
+ Inc(TotalDays,DaysPerLeapYear[12]);
+ End;
+ End; { END WHILE }
+ Done := False;
+ TotDays := LocalDate Div SecsPerDay;
+ { Total number of days }
+ TotalDays := TotalDays + TotDays;
+ Dec(LocalDate,TotDays*SecsPerDay);
+ { Absolute hours since start of day }
+ H := LocalDate Div SecsPerHour;
+ { Convert to minutes }
+ Minutes := H*60;
+ Dec(LocalDate,(H * SecsPerHour));
+ { Find the remaining minutes to add }
+ Min := LocalDate Div SecsPerMinute;
+ Dec(LocalDate,(Min * SecsPerMinute));
+ Minutes:=Minutes+Min;
+ { Find the number of seconds and convert to ticks }
+ S := LocalDate;
+ Ticks:=TICKSPERSECOND*S;
+End;
+
+
+function dosSetProtection(const name: string; mask:longint): Boolean;
+var
+ buffer : array[0..255] of Char;
+begin
+ move(name[1],buffer,length(name));
+ buffer[length(name)]:=#0;
+ dosSetProtection:=SetProtection(buffer,mask);
+end;
+
+function dosSetFileDate(name: string; p : PDateStamp): Boolean;
+var buffer : array[0..255] of Char;
+begin
+ move(name[1],buffer,length(name));
+ buffer[length(name)]:=#0;
+ dosSetFileDate:=SetFileDate(buffer,p);
+end;
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+function DosVersion: Word;
+var p: PLibrary;
+begin
+ p:=PLibrary(MOS_DOSBase);
+ DosVersion:= p^.lib_Version or (p^.lib_Revision shl 8);
+end;
+
+{ Here are a lot of stuff just for setdate and settime }
+
+var
+ TimerBase : Pointer;
+
+
+procedure NewList (list: pList);
+begin
+ with list^ do
+ begin
+ lh_Head := pNode(@lh_Tail);
+ lh_Tail := NIL;
+ lh_TailPred := pNode(@lh_Head)
+ end
+end;
+
+function CreateExtIO (port: pMsgPort; size: Longint): pIORequest;
+var
+ IOReq: pIORequest;
+begin
+ IOReq := NIL;
+ if port <> NIL then
+ begin
+ IOReq := execAllocMem(size, MEMF_CLEAR or MEMF_PUBLIC);
+ if IOReq <> NIL then
+ begin
+ IOReq^.io_Message.mn_Node.ln_Type := 7;
+ IOReq^.io_Message.mn_Length := size;
+ IOReq^.io_Message.mn_ReplyPort := port;
+ end;
+ end;
+ CreateExtIO := IOReq;
+end;
+
+procedure DeleteExtIO (ioReq: pIORequest);
+begin
+ if ioReq <> NIL then
+ begin
+ ioReq^.io_Message.mn_Node.ln_Type := $FF;
+ ioReq^.io_Message.mn_ReplyPort := pMsgPort(-1);
+ ioReq^.io_Device := pDevice(-1);
+ execFreeMem(ioReq, ioReq^.io_Message.mn_Length);
+ end
+end;
+
+function Createport(name : PChar; pri : longint): pMsgPort;
+var
+ sigbit : ShortInt;
+ port : pMsgPort;
+begin
+ sigbit := AllocSignal(-1);
+ if sigbit = -1 then CreatePort := nil;
+ port := execAllocMem(sizeof(tMsgPort),MEMF_CLEAR or MEMF_PUBLIC);
+ if port = nil then begin
+ FreeSignal(sigbit);
+ CreatePort := nil;
+ end;
+ with port^ do begin
+ if assigned(name) then
+ mp_Node.ln_Name := name
+ else mp_Node.ln_Name := nil;
+ mp_Node.ln_Pri := pri;
+ mp_Node.ln_Type := 4;
+ mp_Flags := 0;
+ mp_SigBit := sigbit;
+ mp_SigTask := FindTask(nil);
+ end;
+ if assigned(name) then AddPort(port)
+ else NewList(addr(port^.mp_MsgList));
+ CreatePort := port;
+end;
+
+procedure DeletePort (port: pMsgPort);
+begin
+ if port <> NIL then
+ begin
+ if port^.mp_Node.ln_Name <> NIL then
+ RemPort(port);
+
+ port^.mp_Node.ln_Type := $FF;
+ port^.mp_MsgList.lh_Head := pNode(-1);
+ FreeSignal(port^.mp_SigBit);
+ execFreeMem(port, sizeof(tMsgPort));
+ end;
+end;
+
+
+Function Create_Timer(theUnit : longint) : pTimeRequest;
+var
+ Error : longint;
+ TimerPort : pMsgPort;
+ TimeReq : pTimeRequest;
+begin
+ TimerPort := CreatePort(Nil, 0);
+ if TimerPort = Nil then
+ Create_Timer := Nil;
+ TimeReq := pTimeRequest(CreateExtIO(TimerPort,sizeof(tTimeRequest)));
+ if TimeReq = Nil then begin
+ DeletePort(TimerPort);
+ Create_Timer := Nil;
+ end;
+ Error := OpenDevice(TIMERNAME, theUnit, pIORequest(TimeReq), 0);
+ if Error <> 0 then begin
+ DeleteExtIO(pIORequest(TimeReq));
+ DeletePort(TimerPort);
+ Create_Timer := Nil;
+ end;
+ TimerBase := pointer(TimeReq^.tr_Node.io_Device);
+ Create_Timer := pTimeRequest(TimeReq);
+end;
+
+Procedure Delete_Timer(WhichTimer : pTimeRequest);
+var
+ WhichPort : pMsgPort;
+begin
+
+ WhichPort := WhichTimer^.tr_Node.io_Message.mn_ReplyPort;
+ if assigned(WhichTimer) then begin
+ CloseDevice(pIORequest(WhichTimer));
+ DeleteExtIO(pIORequest(WhichTimer));
+ end;
+ if assigned(WhichPort) then
+ DeletePort(WhichPort);
+end;
+
+function set_new_time(secs, micro : longint): longint;
+var
+ tr : ptimerequest;
+begin
+ tr := create_timer(UNIT_MICROHZ);
+
+ { non zero return says error }
+ if tr = nil then set_new_time := -1;
+
+ tr^.tr_time.tv_secs := secs;
+ tr^.tr_time.tv_micro := micro;
+ tr^.tr_node.io_Command := TR_SETSYSTIME;
+ DoIO(pIORequest(tr));
+
+ delete_timer(tr);
+ set_new_time := 0;
+end;
+
+function get_sys_time(tv : ptimeval): longint;
+var
+ tr : ptimerequest;
+begin
+ tr := create_timer( UNIT_MICROHZ );
+
+ { non zero return says error }
+ if tr = nil then get_sys_time := -1;
+
+ tr^.tr_node.io_Command := TR_GETSYSTIME;
+ DoIO(pIORequest(tr));
+
+ { structure assignment }
+ tv^ := tr^.tr_time;
+
+ delete_timer(tr);
+ get_sys_time := 0;
+end;
+
+Procedure GetDate(Var Year, Month, MDay, WDay: Word);
+Var
+ cd : pClockData;
+ oldtime : ttimeval;
+begin
+ New(cd);
+ get_sys_time(@oldtime);
+ Amiga2Date(oldtime.tv_secs,cd);
+ Year := cd^.year;
+ Month := cd^.month;
+ MDay := cd^.mday;
+ WDay := cd^.wday;
+ Dispose(cd);
+end;
+
+Procedure SetDate(Year, Month, Day: Word);
+var
+ cd : pClockData;
+ oldtime : ttimeval;
+Begin
+ new(cd);
+ get_sys_time(@oldtime);
+ Amiga2Date(oldtime.tv_secs,cd);
+ cd^.year := Year;
+ cd^.month := Month;
+ cd^.mday := Day;
+ set_new_time(Date2Amiga(cd),0);
+ dispose(cd);
+ End;
+
+Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
+Var
+ cd : pClockData;
+ oldtime : ttimeval;
+begin
+ New(cd);
+ get_sys_time(@oldtime);
+ Amiga2Date(oldtime.tv_secs,cd);
+ Hour := cd^.hour;
+ Minute := cd^.min;
+ Second := cd^.sec;
+ Sec100 := oldtime.tv_micro div 10000;
+ Dispose(cd);
+END;
+
+
+Procedure SetTime(Hour, Minute, Second, Sec100: Word);
+var
+ cd : pClockData;
+ oldtime : ttimeval;
+Begin
+ new(cd);
+ get_sys_time(@oldtime);
+ Amiga2Date(oldtime.tv_secs,cd);
+ cd^.hour := Hour;
+ cd^.min := Minute;
+ cd^.sec := Second;
+ set_new_time(Date2Amiga(cd), Sec100 * 10000);
+ dispose(cd);
+ End;
+
+
+function GetMsCount: int64;
+var
+ TV: TTimeVal;
+begin
+ Get_Sys_Time (@TV);
+ GetMsCount := TV.TV_Secs * 1000 + TV.TV_Micro div 1000;
+end;
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+ var
+ p : string;
+ buf: array[0..255] of char;
+ result : longint;
+ MyLock : longint;
+ i : Integer;
+ Begin
+ DosError := 0;
+ LastdosExitCode := 0;
+ p:=Path+' '+ComLine;
+ { allow backslash as slash }
+ for i:=1 to length(p) do
+ if p[i]='\' then p[i]:='/';
+ Move(p[1],buf,length(p));
+ buf[Length(p)]:=#0;
+ { Here we must first check if the command we wish to execute }
+ { actually exists, because this is NOT handled by the }
+ { _SystemTagList call (program will abort!!) }
+
+ { Try to open with shared lock }
+ MyLock:=dosLock(Path,SHARED_LOCK);
+ if MyLock <> 0 then
+ Begin
+ { File exists - therefore unlock it }
+ Unlock(MyLock);
+ result:=SystemTagList(buf,nil);
+ { on return of -1 the shell could not be executed }
+ { probably because there was not enough memory }
+ if result = -1 then
+ DosError:=8
+ else
+ LastDosExitCode:=word(result);
+ end
+ else
+ DosError:=3;
+ End;
+
+
+ Procedure GetCBreak(Var BreakValue: Boolean);
+ Begin
+ breakvalue := system.BreakOn;
+ End;
+
+
+ Procedure SetCBreak(BreakValue: Boolean);
+ Begin
+ system.Breakon := BreakValue;
+ End;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+{ How to solve the problem with this: }
+{ We could walk through the device list }
+{ at startup to determine possible devices }
+
+const
+
+ not_to_use_devs : array[0..12] of string =(
+ 'DF0:',
+ 'DF1:',
+ 'DF2:',
+ 'DF3:',
+ 'PED:',
+ 'PRJ:',
+ 'PIPE:',
+ 'RAM:',
+ 'CON:',
+ 'RAW:',
+ 'SER:',
+ 'PAR:',
+ 'PRT:');
+
+var
+ deviceids : array[1..20] of byte;
+ devicenames : array[1..20] of string[20];
+ numberofdevices : Byte;
+
+Function DiskFree(Drive: Byte): int64;
+Var
+ MyLock : LongInt;
+ Inf : pInfoData;
+ Free : Longint;
+ myproc : pProcess;
+ OldWinPtr : Pointer;
+Begin
+ Free := -1;
+ { Here we stop systemrequesters to appear }
+ myproc := pProcess(FindTask(nil));
+ OldWinPtr := myproc^.pr_WindowPtr;
+ myproc^.pr_WindowPtr := Pointer(-1);
+ { End of systemrequesterstop }
+ New(Inf);
+ MyLock := dosLock(devicenames[deviceids[Drive]],SHARED_LOCK);
+ If MyLock <> 0 then begin
+ if Info(MyLock,Inf) then begin
+ Free := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock) -
+ (Inf^.id_NumBlocksUsed * Inf^.id_BytesPerBlock);
+ end;
+ Unlock(MyLock);
+ end;
+ Dispose(Inf);
+ { Restore systemrequesters }
+ myproc^.pr_WindowPtr := OldWinPtr;
+ diskfree := Free;
+end;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+Var
+ MyLock : LongInt;
+ Inf : pInfoData;
+ Size : Longint;
+ myproc : pProcess;
+ OldWinPtr : Pointer;
+Begin
+ Size := -1;
+ { Here we stop systemrequesters to appear }
+ myproc := pProcess(FindTask(nil));
+ OldWinPtr := myproc^.pr_WindowPtr;
+ myproc^.pr_WindowPtr := Pointer(-1);
+ { End of systemrequesterstop }
+ New(Inf);
+ MyLock := dosLock(devicenames[deviceids[Drive]],SHARED_LOCK);
+ If MyLock <> 0 then begin
+ if Info(MyLock,Inf) then begin
+ Size := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock);
+ end;
+ Unlock(MyLock);
+ end;
+ Dispose(Inf);
+ { Restore systemrequesters }
+ myproc^.pr_WindowPtr := OldWinPtr;
+ disksize := Size;
+end;
+
+
+procedure FindFirst(const Path: PathStr; Attr: Word; Var f: SearchRec);
+var
+ tmpStr: array[0..255] of Char;
+ Anchor: PAnchorPath;
+ Result: LongInt;
+begin
+ tmpStr:=PathConv(path)+#0;
+ DosError:=0;
+
+ new(Anchor);
+ FillChar(Anchor^,sizeof(TAnchorPath),#0);
+
+ Result:=MatchFirst(@tmpStr,Anchor);
+ f.AnchorPtr:=Anchor;
+ if Result = ERROR_NO_MORE_ENTRIES then
+ DosError:=18
+ else
+ if Result<>0 then DosError:=3;
+
+ if DosError=0 then begin
+ {-------------------------------------------------------------------}
+ { Here we fill up the SearchRec attribute, but we also do check }
+ { something else, if the it does not match the mask we are looking }
+ { for we should go to the next file or directory. }
+ {-------------------------------------------------------------------}
+ with Anchor^.ap_Info do begin
+ f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
+ fib_Date.ds_Minute * 60 +
+ fib_Date.ds_Tick div 50;
+ f.attr := 0;
+ {*------------------------------------*}
+ {* Determine if is a file or a folder *}
+ {*------------------------------------*}
+ if fib_DirEntryType>0 then f.attr:=f.attr OR DIRECTORY;
+
+ {*------------------------------------*}
+ {* Determine if Read only *}
+ {* Readonly if R flag on and W flag *}
+ {* off. *}
+ {* Should we check also that EXEC *}
+ {* is zero? for read only? *}
+ {*------------------------------------*}
+ if ((fib_Protection and FIBF_READ) <> 0) and
+ ((fib_Protection and FIBF_WRITE) = 0) then f.attr:=f.attr or READONLY;
+ f.Name := strpas(fib_FileName);
+ f.Size := fib_Size;
+ end; { end with }
+ end;
+end;
+
+
+procedure FindNext(Var f: SearchRec);
+var
+ Result: longint;
+ Anchor: PAnchorPath;
+begin
+ DosError:=0;
+ Result:=MatchNext(f.AnchorPtr);
+ if Result = ERROR_NO_MORE_ENTRIES then
+ DosError:=18
+ else
+ if Result <> 0 then DosError:=3;
+
+ if DosError=0 then begin
+ { Fill up the Searchrec information }
+ { and also check if the files are with }
+ { the correct attributes }
+ Anchor:=pAnchorPath(f.AnchorPtr);
+ with Anchor^.ap_Info do begin
+ f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
+ fib_Date.ds_Minute * 60 +
+ fib_Date.ds_Tick div 50;
+ f.attr := 0;
+ {*------------------------------------*}
+ {* Determine if is a file or a folder *}
+ {*------------------------------------*}
+ if fib_DirEntryType > 0 then f.attr:=f.attr OR DIRECTORY;
+
+ {*------------------------------------*}
+ {* Determine if Read only *}
+ {* Readonly if R flag on and W flag *}
+ {* off. *}
+ {* Should we check also that EXEC *}
+ {* is zero? for read only? *}
+ {*------------------------------------*}
+ if ((fib_Protection and FIBF_READ) <> 0) and
+ ((fib_Protection and FIBF_WRITE) = 0) then f.attr:=f.attr or READONLY;
+ f.Name := strpas(fib_FileName);
+ f.Size := fib_Size;
+ end; { end with }
+ end;
+end;
+
+procedure FindClose(Var f: SearchRec);
+begin
+ MatchEnd(f.AnchorPtr);
+ if assigned(f.AnchorPtr) then
+ Dispose(PAnchorPath(f.AnchorPtr));
+end;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+function FSearch(path: PathStr; dirlist: String) : PathStr;
+var
+ counter: LongInt;
+ p1 : LongInt;
+ tmpSR : SearchRec;
+ newdir : PathStr;
+begin
+ { No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) or (path='') then
+ FSearch:=''
+ else begin
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then begin
+ newdir:=Copy(dirlist,1,p1-1);
+ Delete(dirlist,1,p1);
+ end else begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
+ newdir:=newdir+'/';
+ FindFirst(newdir+path,anyfile,tmpSR);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ FSearch:=newdir;
+ end;
+end;
+
+
+Procedure getftime (var f; var time : longint);
+{
+ This function returns a file's date and time as the number of
+ seconds after January 1, 1978 that the file was created.
+}
+var
+ FInfo : pFileInfoBlock;
+ FTime : Longint;
+ FLock : Longint;
+ Str : String;
+ i : integer;
+begin
+ DosError:=0;
+ FTime := 0;
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+ FLock := dosLock(Str, SHARED_LOCK);
+ IF FLock <> 0 then begin
+ New(FInfo);
+ if Examine(FLock, FInfo) then begin
+ with FInfo^.fib_Date do
+ FTime := ds_Days * (24 * 60 * 60) +
+ ds_Minute * 60 +
+ ds_Tick div 50;
+ end else begin
+ FTime := 0;
+ end;
+ Unlock(FLock);
+ Dispose(FInfo);
+ end
+ else
+ DosError:=6;
+ time := FTime;
+end;
+
+
+ Procedure setftime(var f; time : longint);
+ var
+ DateStamp: pDateStamp;
+ Str: String;
+ i: Integer;
+ Days, Minutes,Ticks: longint;
+ FLock: longint;
+ Begin
+ new(DateStamp);
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+ { Check first of all, if file exists }
+ FLock := dosLock(Str, SHARED_LOCK);
+ IF FLock <> 0 then
+ begin
+ Unlock(FLock);
+ Amiga2DateStamp(time,Days,Minutes,ticks);
+ DateStamp^.ds_Days:=Days;
+ DateStamp^.ds_Minute:=Minutes;
+ DateStamp^.ds_Tick:=Ticks;
+ if dosSetFileDate(Str,DateStamp) then
+ DosError:=0
+ else
+ DosError:=6;
+ end
+ else
+ DosError:=2;
+ if assigned(DateStamp) then Dispose(DateStamp);
+ End;
+
+ Procedure getfattr(var f; var attr : word);
+ var
+ info : pFileInfoBlock;
+ MyLock : Longint;
+ flags: word;
+ Str: String;
+ i: integer;
+ Begin
+ DosError:=0;
+ flags:=0;
+ New(info);
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+ { open with shared lock to check if file exists }
+ MyLock:=dosLock(Str,SHARED_LOCK);
+ if MyLock <> 0 then
+ Begin
+ Examine(MyLock,info);
+ {*------------------------------------*}
+ {* Determine if is a file or a folder *}
+ {*------------------------------------*}
+ if info^.fib_DirEntryType > 0 then
+ flags:=flags OR DIRECTORY;
+
+ {*------------------------------------*}
+ {* Determine if Read only *}
+ {* Readonly if R flag on and W flag *}
+ {* off. *}
+ {* Should we check also that EXEC *}
+ {* is zero? for read only? *}
+ {*------------------------------------*}
+ if ((info^.fib_Protection and FIBF_READ) <> 0)
+ AND ((info^.fib_Protection and FIBF_WRITE) = 0)
+ then
+ flags:=flags OR ReadOnly;
+ Unlock(mylock);
+ end
+ else
+ DosError:=3;
+ attr:=flags;
+ Dispose(info);
+ End;
+
+
+Procedure setfattr (var f;attr : word);
+ var
+ flags: longint;
+ MyLock : longint;
+ str: string;
+ i: integer;
+ Begin
+ DosError:=0;
+ flags:=FIBF_WRITE;
+ { open with shared lock }
+ Str := StrPas(filerec(f).name);
+ for i:=1 to length(Str) do
+ if str[i]='\' then str[i]:='/';
+
+ MyLock:=dosLock(Str,SHARED_LOCK);
+
+ { By default files are read-write }
+ if attr AND ReadOnly <> 0 then
+ { Clear the Fibf_write flags }
+ flags:=FIBF_READ;
+
+
+ if MyLock <> 0 then
+ Begin
+ Unlock(MyLock);
+ if Not dosSetProtection(Str,flags) then
+ DosError:=5;
+ end
+ else
+ DosError:=3;
+ End;
+
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+var
+StrofPaths : string[255];
+
+function getpathstring: string;
+var
+ f : text;
+ s : string;
+ found : boolean;
+ temp : string[255];
+begin
+ found := true;
+ temp := '';
+ assign(f,'ram:makepathstr');
+ rewrite(f);
+ writeln(f,'path >ram:temp.lst');
+ close(f);
+ exec('c:protect','ram:makepathstr sarwed quiet');
+ exec('C:execute','ram:makepathstr');
+ exec('c:delete','ram:makepathstr quiet');
+ assign(f,'ram:temp.lst');
+ reset(f);
+ { skip the first line, garbage }
+ if not eof(f) then readln(f,s);
+ while not eof(f) do begin
+ readln(f,s);
+ if found then begin
+ temp := s;
+ found := false;
+ end else begin;
+ if (length(s) + length(temp)) < 255 then
+ temp := temp + ';' + s;
+ end;
+ end;
+ close(f);
+ exec('C:delete','ram:temp.lst quiet');
+ getpathstring := temp;
+end;
+
+
+ Function EnvCount: Longint;
+ { HOW TO GET THIS VALUE: }
+ { Each time this function is called, we look at the }
+ { local variables in the Process structure (2.0+) }
+ { And we also read all files in the ENV: directory }
+ Begin
+ EnvCount := 0;
+ End;
+
+
+ Function EnvStr(Index: LongInt): String;
+ Begin
+ EnvStr:='';
+ End;
+
+
+
+function GetEnv(envvar : String): String;
+var
+ bufarr : array[0..255] of char;
+ strbuffer : array[0..255] of char;
+ temp : Longint;
+begin
+ if UpCase(envvar) = 'PATH' then begin
+ if StrOfpaths = '' then StrOfPaths := GetPathString;
+ GetEnv := StrofPaths;
+ end else begin
+ move(envvar[1],strbuffer,length(envvar));
+ strbuffer[length(envvar)] := #0;
+ temp := GetVar(strbuffer,bufarr,255,$100);
+ if temp = -1 then
+ GetEnv := ''
+ else GetEnv := StrPas(bufarr);
+ end;
+end;
+
+
+procedure AddDevice(str : String);
+begin
+ inc(numberofdevices);
+ deviceids[numberofdevices] := numberofdevices;
+ devicenames[numberofdevices] := str;
+end;
+
+function MakeDeviceName(str : pchar): string;
+var
+ temp : string[20];
+begin
+ temp := strpas(str);
+ temp := temp + ':';
+ MakeDeviceName := temp;
+end;
+
+function IsInDeviceList(str : string): boolean;
+var
+ i : byte;
+ theresult : boolean;
+begin
+ theresult := false;
+ for i := low(not_to_use_devs) to high(not_to_use_devs) do
+ begin
+ if str = not_to_use_devs[i] then begin
+ theresult := true;
+ break;
+ end;
+ end;
+ IsInDeviceList := theresult;
+end;
+
+procedure ReadInDevices;
+var
+ dl : pDosList;
+ temp : pchar;
+ str : string[20];
+begin
+ dl := LockDosList(LDF_DEVICES or LDF_READ );
+ repeat
+ dl := NextDosEntry(dl,LDF_DEVICES );
+ if dl <> nil then begin
+ temp := BSTR2STRING(dl^.dol_Name);
+ str := MakeDeviceName(temp);
+ if not IsInDeviceList(str) then
+ AddDevice(str);
+ end;
+ until dl = nil;
+ UnLockDosList(LDF_DEVICES or LDF_READ );
+end;
+
+Begin
+ DosError:=0;
+ numberofdevices := 0;
+ StrOfPaths := '';
+ ReadInDevices;
+End.
+
+{
+ $Log: dos.pp,v $
+ Revision 1.15 2005/04/07 03:57:58 karoly
+ * fixed attribute handling in findfirst/findnext
+
+ Revision 1.14 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/doslib.pp b/rtl/morphos/doslib.pp
new file mode 100644
index 0000000000..14da926423
--- /dev/null
+++ b/rtl/morphos/doslib.pp
@@ -0,0 +1,152 @@
+{
+ $Id: doslib.pp,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ dos.library interface unit for MorphOS/PowerPC
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$INLINE ON}
+
+unit doslib;
+
+interface
+
+uses Exec, Timer;
+
+var
+ DosBase: Pointer;
+
+
+{$include doslibd.inc}
+{$include doslibf.inc}
+
+
+{ * dos global definitions (V50)
+ *********************************************************************
+ * }
+
+function BADDR(x: LongInt): Pointer; Inline;
+function MKBADDR(x: Pointer): LongInt; Inline;
+
+
+{ * dos stdio definitions
+ *********************************************************************
+ * }
+
+function ReadChar: LongInt; Inline;
+function WriteChar(ch: Char): LongInt; Inline;
+function UnReadChar(ch: Char): LongInt; Inline;
+function ReadChars(buf: Pointer; num: LongInt): LongInt; Inline;
+function dosReadLn(buf: PChar; num: LongInt): PChar; Inline;
+function WriteStr(str: PChar): LongInt; Inline;
+procedure VWritef(format: PChar; argv: Pointer); Inline;
+
+
+{ * calls with tags workarounds (should be removed later)
+ *********************************************************************
+ * }
+
+function CreateNewProcTags(tags: array of dword): PProcess; Inline;
+
+
+
+implementation
+
+
+{ * dos stdio definitions
+ *********************************************************************
+ * }
+
+function ReadChar: LongInt; Inline;
+begin
+ ReadChar:=FGetC(dosInput);
+end;
+
+function WriteChar(ch: Char): LongInt; Inline;
+begin
+ WriteChar:=FPutC(dosOutput,Byte(ch));
+end;
+
+function UnReadChar(ch: Char): LongInt; Inline;
+begin
+ UnReadChar:=UnGetC(dosInput,Byte(ch));
+end;
+
+function ReadChars(buf: Pointer; num: LongInt): LongInt; Inline;
+begin
+ ReadChars:=FRead(dosInput,buf,1,num);
+end;
+
+function dosReadLn(buf: PChar; num: LongInt): PChar; Inline;
+begin
+ dosReadLn:=FGets(dosInput,buf,num);
+end;
+
+function WriteStr(str: PChar): LongInt; Inline;
+begin
+ WriteStr:=FPuts(dosOutput,str);
+end;
+
+procedure VWritef(format: PChar; argv: Pointer); Inline;
+begin
+ VFWritef(dosOutput,format,argv);
+end;
+
+
+
+{ * dos global definitions (V50)
+ *********************************************************************
+ * }
+
+
+function BADDR(x: LongInt): Pointer; Inline;
+begin
+ BADDR:=Pointer(x Shl 2);
+end;
+
+function MKBADDR(x: Pointer): LongInt; Inline;
+begin
+ MKBADDR:=LongInt(x) Shr 2;
+end;
+
+
+
+{ * calls with tags workarounds (should be removed later)
+ *********************************************************************
+ * }
+
+function CreateNewProcTags(tags: array of DWord): PProcess; Inline;
+begin
+ CreateNewProcTags:=CreateNewProc(@tags);
+end;
+
+
+begin
+ DosBase:=MOS_DOSBase;
+end.
+
+{
+ $Log: doslib.pp,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+ + added {$INLINE ON} to fix cycle
+
+ Revision 1.2 2004/08/09 00:10:19 karoly
+ + added most of missing stuff
+
+ Revision 1.1 2004/06/26 20:46:17 karoly
+ * initial revision
+
+}
diff --git a/rtl/morphos/doslibd.inc b/rtl/morphos/doslibd.inc
new file mode 100644
index 0000000000..86e979489e
--- /dev/null
+++ b/rtl/morphos/doslibd.inc
@@ -0,0 +1,1393 @@
+{
+ $Id: doslibd.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ dos definitions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+
+{ * dos global definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ DOSNAME = 'dos.library';
+
+const
+ DOSTRUE = -1;
+ DOSFALSE = 0;
+
+const
+ MODE_OLDFILE = 1005;
+ MODE_NEWFILE = 1006;
+ MODE_READWRITE = 1004;
+
+const
+ OFFSET_BEGINNING = -1;
+ OFFSET_CURRENT = 0;
+ OFFSET_END = 1;
+ OFFSET_BEGINING = OFFSET_BEGINNING; { * Typo fix * }
+
+const
+ BITSPERBYTE = 8;
+ BYTESPERLONG = 4;
+ BITSPERLONG = 32;
+ _MAXINT = $7FFFFFFF;
+ _MININT = $80000000;
+
+const
+ SHARED_LOCK = -2;
+ ACCESS_READ = -2;
+ EXCLUSIVE_LOCK = -1;
+ ACCESS_WRITE = -1;
+
+
+type
+ PDateStamp = ^TDateStamp;
+ TDateStamp = packed record
+ ds_Days : LongInt;
+ ds_Minute: LongInt;
+ ds_Tick : LongInt;
+ end;
+
+const
+ TICKS_PER_SECOND = 50;
+
+
+type
+ PFileInfoBlock = ^TFileInfoBlock;
+ TFileInfoBlock = packed record
+ fib_DiskKey : LongInt;
+ fib_DirEntryType: LongInt;
+ fib_FileName : Array[0..107] Of Char;
+ fib_Protection : LongInt;
+ fib_EntryType : LongInt;
+ fib_Size : LongInt;
+ fib_NumBlocks : LongInt;
+ fib_Date : TDateStamp;
+ fib_Comment : Array[0..79] Of Char;
+
+ fib_OwnerUID : Word;
+ fib_OwnerGID : Word;
+
+ fib_Reserved : Array[0..31] Of Char;
+ end;
+
+const
+ FIBB_OTR_READ = 15;
+ FIBB_OTR_WRITE = 14;
+ FIBB_OTR_EXECUTE = 13;
+ FIBB_OTR_DELETE = 12;
+ FIBB_GRP_READ = 11;
+ FIBB_GRP_WRITE = 10;
+ FIBB_GRP_EXECUTE = 9;
+ FIBB_GRP_DELETE = 8;
+
+ FIBB_SCRIPT = 6;
+ FIBB_PURE = 5;
+ FIBB_ARCHIVE = 4;
+ FIBB_READ = 3;
+ FIBB_WRITE = 2;
+ FIBB_EXECUTE = 1;
+ FIBB_DELETE = 0;
+
+const
+ FIBF_OTR_READ = (1 Shl FIBB_OTR_READ);
+ FIBF_OTR_WRITE = (1 Shl FIBB_OTR_WRITE);
+ FIBF_OTR_EXECUTE = (1 Shl FIBB_OTR_EXECUTE);
+ FIBF_OTR_DELETE = (1 Shl FIBB_OTR_DELETE);
+ FIBF_GRP_READ = (1 Shl FIBB_GRP_READ);
+ FIBF_GRP_WRITE = (1 Shl FIBB_GRP_WRITE);
+ FIBF_GRP_EXECUTE = (1 Shl FIBB_GRP_EXECUTE);
+ FIBF_GRP_DELETE = (1 Shl FIBB_GRP_DELETE);
+
+ FIBF_SCRIPT = (1 Shl FIBB_SCRIPT);
+ FIBF_PURE = (1 Shl FIBB_PURE);
+ FIBF_ARCHIVE = (1 Shl FIBB_ARCHIVE);
+ FIBF_READ = (1 Shl FIBB_READ);
+ FIBF_WRITE = (1 Shl FIBB_WRITE);
+ FIBF_EXECUTE = (1 Shl FIBB_EXECUTE);
+ FIBF_DELETE = (1 Shl FIBB_DELETE);
+
+const
+ FAULT_MAX = 82;
+
+
+type
+ BPTR = LongInt;
+ BSTR = LongInt;
+
+type
+ PInfoData = ^TInfoData;
+ TInfoData = packed record
+ id_NumSoftErrors: LongInt;
+ id_UnitNumber : LongInt;
+ id_DiskState : LongInt;
+ id_NumBlocks : LongInt;
+ id_NumBlocksUsed: LongInt;
+ id_BytesPerBlock: LongInt;
+ id_DiskType : LongInt;
+ id_VolumeNode : LongInt; {BPTR}
+ id_InUse : LongInt;
+ end;
+
+
+const
+ ID_WRITE_PROTECTED = 80;
+ ID_VALIDATING = 81;
+ ID_VALIDATED = 82;
+
+ ID_NO_DISK_PRESENT = -1;
+ ID_UNREADABLE_DISK = $42414400;
+ ID_DOS_DISK = $444F5300;
+ ID_FFS_DISK = $444F5301;
+ ID_INTER_DOS_DISK = $444F5302;
+ ID_INTER_FFS_DISK = $444F5303;
+ ID_FASTDIR_DOS_DISK = $444F5304;
+ ID_FASTDIR_FFS_DISK = $444F5305;
+ ID_LNFS_DOS_DISK = $444F5306;
+ ID_LNFS_FFS_DISK = $444F5307;
+ ID_NOT_REALLY_DOS = $4E444F53;
+ ID_KICKSTART_DISK = $4B49434B;
+ ID_MSDOS_DISK = $4d534400;
+
+const
+ ERROR_NO_FREE_STORE = 103;
+ ERROR_TASK_TABLE_FULL = 105;
+ ERROR_BAD_TEMPLATE = 114;
+ ERROR_BAD_NUMBER = 115;
+ ERROR_REQUIRED_ARG_MISSING = 116;
+ ERROR_KEY_NEEDS_ARG = 117;
+ ERROR_TOO_MANY_ARGS = 118;
+ ERROR_UNMATCHED_QUOTES = 119;
+ ERROR_LINE_TOO_LONG = 120;
+ ERROR_FILE_NOT_OBJECT = 121;
+ ERROR_INVALID_RESIDENT_LIBRARY = 122;
+ ERROR_NO_DEFAULT_DIR = 201;
+ ERROR_OBJECT_IN_USE = 202;
+ ERROR_OBJECT_EXISTS = 203;
+ ERROR_DIR_NOT_FOUND = 204;
+ ERROR_OBJECT_NOT_FOUND = 205;
+ ERROR_BAD_STREAM_NAME = 206;
+ ERROR_OBJECT_TOO_LARGE = 207;
+ ERROR_ACTION_NOT_KNOWN = 209;
+ ERROR_INVALID_COMPONENT_NAME = 210;
+ ERROR_INVALID_LOCK = 211;
+ ERROR_OBJECT_WRONG_TYPE = 212;
+ ERROR_DISK_NOT_VALIDATED = 213;
+ ERROR_DISK_WRITE_PROTECTED = 214;
+ ERROR_RENAME_ACROSS_DEVICES = 215;
+ ERROR_DIRECTORY_NOT_EMPTY = 216;
+ ERROR_TOO_MANY_LEVELS = 217;
+ ERROR_DEVICE_NOT_MOUNTED = 218;
+ ERROR_SEEK_ERROR = 219;
+ ERROR_COMMENT_TOO_BIG = 220;
+ ERROR_DISK_FULL = 221;
+ ERROR_DELETE_PROTECTED = 222;
+ ERROR_WRITE_PROTECTED = 223;
+ ERROR_READ_PROTECTED = 224;
+ ERROR_NOT_A_DOS_DISK = 225;
+ ERROR_NO_DISK = 226;
+ ERROR_NO_MORE_ENTRIES = 232;
+
+ ERROR_IS_SOFT_LINK = 233;
+ ERROR_OBJECT_LINKED = 234;
+ ERROR_BAD_HUNK = 235;
+ ERROR_NOT_IMPLEMENTED = 236;
+ ERROR_RECORD_NOT_LOCKED = 240;
+ ERROR_LOCK_COLLISION = 241;
+ ERROR_LOCK_TIMEOUT = 242;
+ ERROR_UNLOCK_ERROR = 243;
+
+const
+ RETURN_OK = 0;
+ RETURN_WARN = 5;
+ RETURN_ERROR = 10;
+ RETURN_FAIL = 20;
+
+const
+ SIGBREAKB_CTRL_C = 12;
+ SIGBREAKB_CTRL_D = 13;
+ SIGBREAKB_CTRL_E = 14;
+ SIGBREAKB_CTRL_F = 15;
+
+ SIGBREAKF_CTRL_C = (1 Shl SIGBREAKB_CTRL_C);
+ SIGBREAKF_CTRL_D = (1 Shl SIGBREAKB_CTRL_D);
+ SIGBREAKF_CTRL_E = (1 Shl SIGBREAKB_CTRL_E);
+ SIGBREAKF_CTRL_F = (1 Shl SIGBREAKB_CTRL_F);
+
+const
+ LOCK_DIFFERENT = -1;
+ LOCK_SAME = 0;
+ LOCK_SAME_VOLUME = 1;
+ LOCK_SAME_HANDLER = LOCK_SAME_VOLUME;
+
+const
+ CHANGE_LOCK = 0;
+ CHANGE_FH = 1;
+
+const
+ LINK_HARD = 0;
+ LINK_SOFT = 1;
+
+const
+ ITEM_EQUAL = -2;
+ ITEM_ERROR = -1;
+ ITEM_NOTHING = 0;
+ ITEM_UNQUOTED = 1;
+ ITEM_QUOTED = 2;
+
+const
+ DOS_FILEHANDLE = 0;
+ DOS_EXALLCONTROL = 1;
+ DOS_FIB = 2;
+ DOS_STDPKT = 3;
+ DOS_CLI = 4;
+ DOS_RDARGS = 5;
+
+
+
+{ * dos date/time definitions
+ *********************************************************************
+ * }
+
+
+type
+ { * Required to avoid conflict with default types * }
+ _PDateTime = ^_TDateTime;
+ _TDateTime = packed record
+ dat_Stamp : TDateStamp;
+ dat_Format : Byte;
+ dat_Flags : Byte;
+ dat_StrDay : Pointer;
+ dat_StrDate: Pointer;
+ dat_StrTime: Pointer;
+ end;
+
+const
+ LEN_DATSTRING = 16;
+
+const
+ DTB_SUBST = 0;
+ DTF_SUBST = (1 Shl DTB_SUBST);
+ DTB_FUTURE = 1;
+ DTF_FUTURE = (1 Shl DTB_FUTURE);
+
+const
+ FORMAT_DOS = 0;
+ FORMAT_INT = 1;
+ FORMAT_USA = 2;
+ FORMAT_CDN = 3;
+ FORMAT_MAX = FORMAT_CDN;
+ FORMAT_DEF = 4;
+
+
+
+{ * dos extended structures definitions
+ *********************************************************************
+ * }
+
+
+type
+ PProcess = ^TProcess;
+ TProcess = packed record
+ pr_Task : TTask;
+ pr_MsgPort : TMsgPort;
+ pr_Pad : Word;
+ pr_SegList : DWord; { BPTR }
+ pr_StackSize : LongInt; { 68k stacksize! }
+ pr_GlobVec : Pointer;
+ pr_TaskNum : LongInt;
+ pr_StackBase : DWord; { BPTR }
+ pr_Result2 : LongInt;
+ pr_CurrentDir : DWord; { BPTR }
+ pr_CIS : DWord; { BPTR }
+ pr_COS : DWord; { BPTR }
+ pr_ConsoleTask : Pointer;
+ pr_FileSystemTask: Pointer;
+ pr_CLI : DWord; { BPTR }
+ pr_ReturnAddr : Pointer;
+ pr_PktWait : Pointer;
+ pr_WindowPtr : Pointer;
+ pr_HomeDir : DWord; { BPTR }
+ pr_Flags : LongInt;
+ pr_ExitCode : Pointer; { Procedure }
+ pr_ExitData : LongInt;
+ pr_Arguments : PChar;
+ pr_LocalVars : TMinList;
+ pr_ShellPrivate : DWord;
+ pr_CES : DWord; { BPTR }
+ end;
+
+const
+ PRB_FREESEGLIST = 0;
+ PRF_FREESEGLIST = (1 Shl PRB_FREESEGLIST);
+
+ PRB_FREECURRDIR = 1;
+ PRF_FREECURRDIR = (1 Shl PRB_FREECURRDIR);
+
+ PRB_FREECLI = 2;
+ PRF_FREECLI = (1 Shl PRB_FREECLI);
+
+ PRB_CLOSEINPUT = 3;
+ PRF_CLOSEINPUT = (1 Shl PRB_CLOSEINPUT);
+
+ PRB_CLOSEOUTPUT = 4;
+ PRF_CLOSEOUTPUT = (1 Shl PRB_CLOSEOUTPUT);
+
+ PRB_FREEARGS = 5;
+ PRF_FREEARGS = (1 Shl PRB_FREEARGS);
+
+
+type
+ PFileHandle = ^TFileHandle;
+ TFileHandle = packed record
+ fh_Flags : DWord;
+ fh_Interactive: LongInt;
+ fh_Type : PMsgPort;
+ fh_Buf : LongInt;
+ fh_Pos : LongInt;
+ fh_End : LongInt;
+ fh_Func1 : LongInt;
+ fh_Func2 : LongInt;
+ fh_Func3 : LongInt;
+ fh_Arg1 : LongInt;
+ fh_Arg2 : LongInt;
+ { *** V50 MorphOS *** }
+ fh_BufSize : LongInt;
+ fh_OrigBuf : LongInt;
+ end;
+
+type
+ PDOSPacket = ^TDOSPacket;
+ TDOSPacket = packed record
+ dp_Link: PMessage;
+ dp_Port: PMsgPort;
+ case Byte of
+ 0 : ( dp_Action : Longint;
+ dp_Status : Longint;
+ dp_Status2: Longint;
+ dp_BufAddr: Longint;
+ );
+ 1 : ( dp_Type: Longint;
+ dp_Res1: Longint;
+ dp_Res2: Longint;
+ dp_Arg1: Longint;
+ dp_Arg2: Longint;
+ dp_Arg3: Longint;
+ dp_Arg4: Longint;
+ dp_Arg5: Longint;
+ dp_Arg6: Longint;
+ dp_Arg7: Longint;
+ );
+ end;
+
+type
+ PStandardPacket = ^TStandardPacket;
+ TStandardPacket = packed record
+ sp_Msg: TMessage;
+ sp_Pkt: TDOSPacket;
+ end;
+
+
+const
+ ACTION_NIL = 0;
+ ACTION_STARTUP = 0;
+ ACTION_GET_BLOCK = 2; { *** OBSOLETE *** }
+ ACTION_SET_MAP = 4;
+ ACTION_DIE = 5;
+ ACTION_EVENT = 6;
+ ACTION_CURRENT_VOLUME = 7;
+ ACTION_LOCATE_OBJECT = 8;
+ ACTION_RENAME_DISK = 9;
+ ACTION_WRITE = 'W';
+ ACTION_READ = 'R';
+ ACTION_FREE_LOCK = 15;
+ ACTION_DELETE_OBJECT = 16;
+ ACTION_RENAME_OBJECT = 17;
+ ACTION_MORE_CACHE = 18;
+ ACTION_COPY_DIR = 19;
+ ACTION_WAIT_CHAR = 20;
+ ACTION_SET_PROTECT = 21;
+ ACTION_CREATE_DIR = 22;
+ ACTION_EXAMINE_OBJECT = 23;
+ ACTION_EXAMINE_NEXT = 24;
+ ACTION_DISK_INFO = 25;
+ ACTION_INFO = 26;
+ ACTION_FLUSH = 27;
+ ACTION_SET_COMMENT = 28;
+ ACTION_PARENT = 29;
+ ACTION_TIMER = 30;
+ ACTION_INHIBIT = 31;
+ ACTION_DISK_TYPE = 32;
+ ACTION_DISK_CHANGE = 33;
+ ACTION_SET_DATE = 34;
+
+ ACTION_SAME_LOCK = 40;
+
+ ACTION_SCREEN_MODE = 994;
+
+ ACTION_CHANGE_SIGNAL = 995;
+
+ ACTION_READ_RETURN = 1001;
+ ACTION_WRITE_RETURN = 1002;
+ ACTION_SEEK = 1008;
+ ACTION_FINDUPDATE = 1004;
+ ACTION_FINDINPUT = 1005;
+ ACTION_FINDOUTPUT = 1006;
+ ACTION_END = 1007;
+
+ ACTION_FORMAT = 1020;
+ ACTION_MAKE_LINK = 1021;
+
+ ACTION_SET_FILE_SIZE = 1022;
+ ACTION_WRITE_PROTECT = 1023;
+
+ ACTION_READ_LINK = 1024;
+ ACTION_FH_FROM_LOCK = 1026;
+ ACTION_IS_FILESYSTEM = 1027;
+ ACTION_CHANGE_MODE = 1028;
+
+ ACTION_COPY_DIR_FH = 1030;
+ ACTION_PARENT_FH = 1031;
+ ACTION_EXAMINE_ALL = 1033;
+ ACTION_EXAMINE_FH = 1034;
+
+ ACTION_EXAMINE_ALL_END = 1035;
+ ACTION_SET_OWNER = 1036;
+
+ ACTION_LOCK_RECORD = 2008;
+ ACTION_FREE_RECORD = 2009;
+
+ ACTION_ADD_NOTIFY = 4097;
+ ACTION_REMOVE_NOTIFY = 4098;
+
+ ACTION_SERIALIZE_DISK = 4200;
+
+ ACTION_GET_DISK_FSSM = 4201;
+ ACTION_FREE_DISK_FSSM = 4202;
+
+
+type
+ PErrorString = ^TErrorString;
+ TErrorString = packed record
+ estr_Nums: Pointer; { ^LongInt }
+ estr_Byte: Pointer; { ^Byte }
+ end;
+
+type
+ PRootNode = ^TRootNode;
+ TRootNode = packed record
+ rn_TaskArray : DWord; { BPTR }
+ rn_ConsoleSegment : DWord; { BPTR }
+ rn_Time : TDateStamp;
+ rn_RestartSeg : LongInt;
+ rn_Info : DWord; { BPTR }
+ rn_FileHandlerSegment: DWord; { BPTR }
+ rn_CliList : TMinList;
+ rn_BootProc : PMsgPort;
+ rn_ShellSegment : DWord; { BPTR }
+ rn_Flags : LongInt;
+ end;
+
+type
+ PDOSLibrary = ^TDOSLibrary;
+ TDOSLibrary = packed record
+ dl_Lib : TLibrary;
+ dl_Root : PRootNode;
+ dl_GU : Pointer;
+ dl_A2 : LongInt;
+ dl_A5 : LongInt;
+ dl_A6 : LongInt;
+ dl_Errors : PErrorString;
+ dl_TimeReq : PTimeRequest;
+ dl_UtilityBase : PLibrary;
+ dl_IntuitionBase: PLibrary;
+ end;
+
+
+const
+ RNB_WILDSTAR = 24;
+ RNF_WILDSTAR = (1 Shl RNB_WILDSTAR);
+
+ RNB_PRIVATE1 = 1;
+ RNF_PRIVATE1 = (1 Shl RNB_PRIVATE1);
+
+
+type
+ PCliProcList = ^TCliProcList;
+ TCliProcList = packed record
+ cpl_Node : TMinNode;
+ cpl_First: LongInt;
+ cpl_Array: Array[0..0] Of PMsgPort;
+ end;
+
+type
+ PDOSInfo = ^TDOSInfo;
+ TDOSInfo = packed record
+ case Byte of
+ 0 : ( di_ResList: DWord; { BPTR }
+ );
+ 1 : ( di_McName : DWord; { BPTR }
+ di_DevInfo : DWord; { BPTR }
+ di_Devices : DWord; { BPTR }
+ di_Handlers : DWord; { BPTR }
+ di_NetHand : Pointer;
+ di_DevLock : TSignalSemaphore;
+ di_EntryLock : TSignalSemaphore;
+ di_DeleteLock: TSignalSemaphore;
+ );
+ end;
+
+type
+ PSegment = ^TSegment;
+ TSegment = packed record
+ seg_Next : DWord; { BPTR }
+ seg_UC : LongInt;
+ seg_Seg : DWord; { BPTR }
+ seg_Name : Array[0..3] Of Byte;
+ { * seg_Name continues * }
+ end;
+
+
+const
+ CMD_SYSTEM = -1;
+ CMD_INTERNAL = -2;
+ CMD_NOTLOADED = -998;
+ CMD_DISABLED = -999;
+
+
+type
+ PCommandLineInterface = ^TCommandLineInterface;
+ TCommandLineInterface = packed record
+ cli_Result2 : LongInt;
+ cli_SetName : DWord; { BSTR }
+ cli_CommandDir : DWord; { BPTR }
+ cli_ReturnCode : LongInt;
+ cli_CommandName : DWord; { BSTR }
+ cli_FailLevel : LongInt;
+ cli_Prompt : DWord; { BSTR }
+ cli_StandardInput : DWord; { BPTR }
+ cli_CurrentInput : DWord; { BPTR }
+ cli_CommandFile : DWord; { BSTR }
+ cli_Interactive : LongInt;
+ cli_Background : LongInt;
+ cli_CurrentOutput : DWord; { BPTR }
+ cli_DefaultStack : LongInt;
+ cli_StandardOutput: DWord; { BPTR }
+ cli_Module : DWord; { BPTR }
+ end;
+
+type
+ PDeviceList = ^TDeviceList;
+ TDeviceList = packed record
+ dl_Next : DWord; { BPTR }
+ dl_Type : LongInt;
+ dl_Task : PMsgPort;
+ dl_Lock : DWord; { BPTR }
+ dl_VolumeDate: TDateStamp;
+ dl_LockList : DWord; { BPTR }
+ dl_DiskType : LongInt;
+ dl_unused : LongInt;
+ dl_Name : DWord; { BSTR }
+ end;
+
+type
+ PDevInfo = ^TDevInfo;
+ TDevInfo = packed record
+ dvi_Next : DWord; { BPTR }
+ dvi_Type : LongInt;
+ dvi_Task : Pointer;
+ dvi_Lock : DWord; { BPTR }
+ dvi_Handler : DWord; { BSTR }
+ dvi_StackSize: LongInt;
+ dvi_Priority : LongInt;
+ dvi_Startup : LongInt;
+ dvi_SegList : DWord; { BPTR }
+ dvi_GlobVec : DWord; { BPTR }
+ dvi_Name : DWord; { BSTR }
+ end;
+
+type
+ PAssignList = ^TAssignList;
+ TAssignList = packed record
+ al_Next: PAssignList;
+ al_Lock: DWord; { BPTR }
+ end;
+
+type
+ PDOSList = ^TDOSList;
+ TDOSList = packed record
+ dol_Next: DWord; { BPTR }
+ dol_Type: LongInt;
+ dol_Task: PMsgPort;
+ dol_Lock: DWord; { BPTR }
+ case Byte of
+ 0: ( dol_handler : record
+ dol_Handler : DWord; { BSTR }
+ dol_StackSize: LongInt;
+ dol_Priority : LongInt;
+ dol_Startup : DWord;
+ dol_SegList : DWord; { BPTR }
+ dol_GlobVec : DWord; { BPTR }
+ end;
+ );
+ 1: ( dol_volume : record
+ dol_VolumeDate: TDateStamp;
+ dol_LockList : DWord; { BPTR }
+ dol_DiskType : LongInt;
+ end;
+ );
+ 2: ( dol_assign : record
+ dol_AssignName: PChar;
+ dol_List : PAssignList;
+ end;
+ );
+ 3: ( dol_Misc: array[0..23] of Byte;
+ dol_Name: DWord; { BPTR }
+ );
+ end;
+
+
+const
+ DLT_DEVICE = 0;
+ DLT_DIRECTORY = 1;
+ DLT_VOLUME = 2;
+ DLT_LATE = 3;
+ DLT_NONBINDING = 4;
+ DLT_PRIVATE = -1;
+
+
+type
+ PDevProc = ^TDevProc;
+ TDevProc = packed record
+ dvp_Port : PMsgPort;
+ dvp_Lock : DWord; { BPTR }
+ dvp_Flags : DWord;
+ dvp_DevNode: PDOSList;
+ end;
+
+
+const
+ DVPB_UNLOCK = 0;
+ DVPF_UNLOCK = (1 Shl DVPB_UNLOCK);
+
+ DVPB_ASSIGN = 1;
+ DVPF_ASSIGN = (1 Shl DVPB_ASSIGN);
+
+const
+ LDB_READ = 0;
+ LDF_READ = (1 Shl LDB_READ);
+
+ LDB_WRITE = 1;
+ LDF_WRITE = (1 Shl LDB_WRITE);
+
+ LDB_DEVICES = 2;
+ LDF_DEVICES = (1 Shl LDB_DEVICES);
+
+ LDB_VOLUMES = 3;
+ LDF_VOLUMES = (1 Shl LDB_VOLUMES);
+
+ LDB_ASSIGNS = 4;
+ LDF_ASSIGNS = (1 Shl LDB_ASSIGNS);
+
+ LDB_ENTRY = 5;
+ LDF_ENTRY = (1 Shl LDB_ENTRY);
+
+ LDB_DELETE = 6;
+ LDF_DELETE = (1 Shl LDB_DELETE);
+
+ LDF_ALL = (LDF_DEVICES Or LDF_VOLUMES Or LDF_ASSIGNS);
+
+
+type
+ PFileLock = ^TFileLock;
+ TFileLock = packed record
+ fl_Link : DWord; { BPTR }
+ fl_Key : LongInt;
+ fl_Access: LongInt;
+ fl_Task : PMsgPort;
+ fl_Volume: DWord; { BPTR }
+ end;
+
+
+const
+ REPORT_STREAM = 0;
+ REPORT_TASK = 1;
+ REPORT_LOCK = 2;
+ REPORT_VOLUME = 3;
+ REPORT_INSERT = 4;
+
+const
+ ABORT_DISK_ERROR = 296;
+ ABORT_BUSY = 288;
+
+const
+ RUN_EXECUTE = -1;
+ RUN_SYSTEM = -2;
+ RUN_SYSTEM_ASYNCH = -3;
+
+const
+ ST_ROOT = 1;
+ ST_USERDIR = 2;
+ ST_SOFTLINK = 3;
+ ST_LINKDIR = 4;
+ ST_FILE = -3;
+ ST_LINKFILE = -4;
+ ST_PIPEFILE = -5;
+
+
+
+{ * dos asl definitions
+ *********************************************************************
+ * }
+
+
+type
+ PAChain = ^TAChain;
+ TAChain = packed record
+ an_Child : PAChain;
+ an_Parent: PAChain;
+ an_Lock : DWord; { BPTR }
+ an_Info : TFileInfoBlock;
+ an_Flags : ShortInt;
+ an_String: Array[0..0] Of Char;
+ { * an_String continues * }
+ end;
+
+type
+ PAnchorPath = ^TAnchorPath;
+ TAnchorPath = packed record
+ case Byte of
+ 0 : ( ap_First: PAChain;
+ ap_Last : PAChain;
+ );
+ 1 : ( ap_Base : PAChain;
+ ap_Current : PAChain;
+ ap_BreakBits : LongInt;
+ ap_FoundBreak: LongInt;
+ ap_Flags : ShortInt;
+ ap_Reserved : ShortInt;
+ ap_Strlen : SmallInt;
+ ap_Info : TFileInfoBlock;
+ ap_Buf : Array[0..0] of Char;
+ { * an_Buf continues * }
+ );
+ end;
+
+
+const
+ APB_DOWILD = 0;
+ APF_DOWILD = (1 Shl APB_DOWILD);
+
+ APB_ITSWILD = 1;
+ APF_ITSWILD = (1 Shl APB_ITSWILD);
+
+ APB_DODIR = 2;
+ APF_DODIR = (1 Shl APB_DODIR);
+
+ APB_DIDDIR = 3;
+ APF_DIDDIR = (1 Shl APB_DIDDIR);
+
+ APB_NOMEMERR = 4;
+ APF_NOMEMERR = (1 Shl APB_NOMEMERR);
+
+ APB_DODOT = 5;
+ APF_DODOT = (1 Shl APB_DODOT);
+
+ APB_DirChanged = 6;
+ APF_DirChanged = (1 Shl APB_DirChanged);
+
+ APB_FollowHLinks = 7;
+ APF_FollowHLinks = (1 Shl APB_FollowHLinks);
+
+const
+ APSB_EXTENDED = 15;
+ APSF_EXTENDED = (1 Shl APSB_EXTENDED);
+
+ APEB_DoMultiAssigns = 0;
+ APEF_DoMultiAssigns = (1 Shl APEB_DoMultiAssigns);
+
+ APEB_FutureExtension = 7;
+ APEF_FutureExtension = (1 Shl APEB_FutureExtension);
+
+const
+ DDB_PatternBit = 0;
+ DDF_PatternBit = (1 Shl DDB_PatternBit);
+
+ DDB_ExaminedBit = 1;
+ DDF_ExaminedBit = (1 Shl DDB_ExaminedBit);
+
+ DDB_Completed = 2;
+ DDF_Completed = (1 Shl DDB_Completed);
+
+ DDB_AllBit = 3;
+ DDF_AllBit = (1 Shl DDB_AllBit);
+
+ DDB_Single = 4;
+ DDF_Single = (1 Shl DDB_Single);
+
+const
+ P_ANY = $80;
+ P_SINGLE = $81;
+ P_ORSTART = $82;
+ P_ORNEXT = $83;
+ P_OREND = $84;
+ P_NOT = $85;
+ P_NOTEND = $86;
+ P_NOTCLASS = $87;
+ P_CLASS = $88;
+ P_REPBEG = $89;
+ P_REPEND = $8A;
+ P_STOP = $8B;
+
+const
+ COMPLEX_BIT = 1;
+ EXAMINE_BIT = 2;
+
+const
+ ERROR_BUFFER_OVERFLOW = 303;
+ ERROR_BREAK = 304;
+ ERROR_NOT_EXECUTABLE = 305;
+
+
+
+{ * dos hunk definitions
+ *********************************************************************
+ * }
+
+
+const
+ HUNK_UNIT = 999;
+ HUNK_NAME = 1000;
+ HUNK_CODE = 1001;
+ HUNK_DATA = 1002;
+ HUNK_BSS = 1003;
+
+ HUNK_RELOC32 = 1004;
+ HUNK_ABSRELOC32 = HUNK_RELOC32;
+
+ HUNK_RELOC16 = 1005;
+ HUNK_RELRELOC16 = HUNK_RELOC16;
+
+ HUNK_RELOC8 = 1006;
+ HUNK_RELRELOC8 = HUNK_RELOC8;
+
+ HUNK_EXT = 1007;
+ HUNK_SYMBOL = 1008;
+ HUNK_DEBUG = 1009;
+ HUNK_END = 1010;
+ HUNK_HEADER = 1011;
+
+ HUNK_OVERLAY = 1013;
+ HUNK_BREAK = 1014;
+
+ HUNK_DREL32 = 1015;
+ HUNK_DREL16 = 1016;
+ HUNK_DREL8 = 1017;
+
+ HUNK_LIB = 1018;
+ HUNK_INDEX = 1019;
+
+ HUNK_RELOC32SHORT = 1020;
+
+ HUNK_RELRELOC32 = 1021;
+ HUNK_ABSRELOC16 = 1022;
+
+const
+ HUNKB_ADVISORY = 29;
+ HUNKB_CHIP = 30;
+ HUNKB_FAST = 31;
+
+ HUNKF_ADVISORY = (1 Shl HUNKB_ADVISORY);
+ HUNKF_CHIP = (1 Shl HUNKB_CHIP);
+ HUNKF_FAST = (1 Shl HUNKB_FAST);
+
+const
+ EXT_SYMB = 0;
+ EXT_DEF = 1;
+ EXT_ABS = 2;
+ EXT_RES = 3;
+
+ EXT_REF32 = 129;
+ EXT_ABSREF32 = EXT_REF32;
+
+ EXT_COMMON = 130;
+ EXT_ABSCOMMON = EXT_COMMON;
+
+ EXT_REF16 = 131;
+ EXT_RELREF16 = EXT_REF16;
+
+ EXT_REF8 = 132;
+ EXT_RELREF8 = EXT_REF8;
+
+ EXT_DEXT32 = 133;
+ EXT_DEXT16 = 134;
+ EXT_DEXT8 = 135;
+
+ EXT_RELREF32 = 136;
+ EXT_RELCOMMON = 137;
+
+ EXT_ABSREF16 = 138;
+
+ EXT_ABSREF8 = 139;
+
+
+
+{ * dos ExAll definitions
+ *********************************************************************
+ * }
+
+
+const
+ ED_NAME = 1;
+ ED_TYPE = 2;
+ ED_SIZE = 3;
+ ED_PROTECTION = 4;
+ ED_DATE = 5;
+ ED_COMMENT = 6;
+ ED_OWNER = 7;
+
+
+type
+ PExAllData = ^TExAllData;
+ TExAllData = packed record
+ ed_Next : PExAllData;
+ ed_Name : PChar;
+ ed_Type : LongInt;
+ ed_Size : Cardinal;
+ ed_Prot : Cardinal;
+ ed_Days : Cardinal;
+ ed_Mins : Cardinal;
+ ed_Ticks : Cardinal;
+ ed_Comment : PChar;
+ ed_OwnerUID: Word;
+ ed_OwnerGID: Word;
+ end;
+
+type
+ PExAllControl = ^TExAllControl;
+ TexAllControl = packed record
+ eac_Entries : Cardinal;
+ eac_LastKey : Cardinal;
+ eac_MatchString: PChar;
+ eac_MatchFunc : PHook;
+
+ end;
+
+
+
+{ * dos record definitions
+ *********************************************************************
+ * }
+
+
+const
+ REC_EXCLUSIVE = 0;
+ REC_EXCLUSIVE_IMMED = 1;
+ REC_SHARED = 2;
+ REC_SHARED_IMMED = 3;
+
+
+type
+ PRecordLock = ^TRecordLock;
+ TRecordLock = packed record
+ rec_FH : LongInt;
+ rec_Offset: Cardinal;
+ rec_Length: Cardinal;
+ rec_Mode : Cardinal;
+ end;
+
+
+
+{ * dos tag definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ SYS_Dummy = (TAG_USER + 32);
+ SYS_Input = (SYS_Dummy + 1);
+ SYS_Output = (SYS_Dummy + 2);
+ SYS_Asynch = (SYS_Dummy + 3);
+ SYS_UserShell = (SYS_Dummy + 4);
+ SYS_CustomShell = (SYS_Dummy + 5);
+
+ { *** V50 *** }
+ SYS_FilterTags = (SYS_Dummy + 6); { * filters the tags passed down to CreateNewProc(), default: TRUE * }
+
+const
+ NP_Dummy = (TAG_USER + 1000);
+ NP_Seglist = (NP_Dummy + 1);
+ NP_FreeSeglist = (NP_Dummy + 2);
+ NP_Entry = (NP_Dummy + 3);
+ NP_Input = (NP_Dummy + 4);
+ NP_Output = (NP_Dummy + 5);
+ NP_CloseInput = (NP_Dummy + 6);
+ NP_CloseOutput = (NP_Dummy + 7);
+ NP_Error = (NP_Dummy + 8);
+ NP_CloseError = (NP_Dummy + 9);
+ NP_CurrentDir = (NP_Dummy + 10);
+ NP_StackSize = (NP_Dummy + 11);
+ NP_Name = (NP_Dummy + 12);
+ NP_Priority = (NP_Dummy + 13);
+ NP_ConsoleTask = (NP_Dummy + 14);
+ NP_WindowPtr = (NP_Dummy + 15);
+ NP_HomeDir = (NP_Dummy + 16);
+ NP_CopyVars = (NP_Dummy + 17);
+ NP_Cli = (NP_Dummy + 18);
+ NP_Path = (NP_Dummy + 19);
+ NP_CommandName = (NP_Dummy + 20);
+ NP_Arguments = (NP_Dummy + 21);
+
+ NP_NotifyOnDeath = (NP_Dummy + 22);
+ NP_Synchronous = (NP_Dummy + 23);
+ NP_ExitCode = (NP_Dummy + 24);
+ NP_ExitData = (NP_Dummy + 25);
+
+ { *** V50 *** }
+ NP_SeglistArray = (NP_Dummy + 26);
+ NP_UserData = (NP_Dummy + 27);
+ NP_StartupMsg = (NP_Dummy + 28); { * PMessage, ReplyMsg'd at exit * }
+ NP_TaskMsgPort = (NP_Dummy + 29); { * ^PMsgPort, create MsgPort, automagic delete * }
+
+ NP_CodeType = (NP_Dummy + 100);
+ NP_PPC_Arg1 = (NP_Dummy + 101);
+ NP_PPC_Arg2 = (NP_Dummy + 102);
+ NP_PPC_Arg3 = (NP_Dummy + 103);
+ NP_PPC_Arg4 = (NP_Dummy + 104);
+ NP_PPC_Arg5 = (NP_Dummy + 105);
+ NP_PPC_Arg6 = (NP_Dummy + 106);
+ NP_PPC_Arg7 = (NP_Dummy + 107);
+ NP_PPC_Arg8 = (NP_Dummy + 108);
+ NP_PPCStackSize = (NP_Dummy + 109);
+
+const
+ ADO_Dummy = (TAG_USER + 2000);
+ ADO_FH_Mode = (ADO_Dummy + 1);
+
+ ADO_DirLen = (ADO_Dummy + 2);
+ ADO_CommNameLen = (ADO_Dummy + 3);
+ ADO_CommFileLen = (ADO_Dummy + 4);
+ ADO_PromptLen = (ADO_Dummy + 5);
+
+ { *** V50 *** }
+ ADDS_Dummy = (TAG_USER + 3000);
+ ADDS_Name = (ADDS_Dummy + 1); { * Segment name * }
+ ADDS_Seglist = (ADDS_Dummy + 2); { * Seglist for this segment * }
+ ADDS_Filename = (ADDS_Dummy + 3); { * Name of the file to load when needed. Ignored if Seglist is given. * }
+ ADDS_Type = (ADDS_Dummy + 4); { * Segment type * }
+
+const
+ FNDS_Dummy = (TAG_USER + 3100);
+ FNDS_Name = (FNDS_Dummy + 1); { * Segment name * }
+ FNDS_From = (FNDS_Dummy + 2); { * Segment to start from * }
+ FNDS_System = (FNDS_Dummy + 3); { * Look for a system segment ? * }
+ FNDS_Load = (FNDS_Dummy + 4); { * Load the seglist if needed ? (Default: TRUE) * }
+
+
+
+{ * dos stdio definitions
+ *********************************************************************
+ * }
+
+
+const
+ BUF_LINE = 0;
+ BUF_FULL = 1;
+ BUF_NONE = 2;
+
+const
+ ENDSTREAMCH = -1;
+
+
+
+{ * dos env-var definitions
+ *********************************************************************
+ * }
+
+
+type
+ PLocalVar = ^TLocalVar;
+ TLocalVar = packed record
+ lv_Node : TNode;
+ lv_Flags: Word;
+ lv_Value: PChar;
+ lv_Len : Cardinal;
+ end;
+
+
+const
+ LV_VAR = 0;
+ LV_ALIAS = 1;
+
+const
+ LVB_IGNORE = 7;
+ LVF_IGNORE = (1 Shl LVB_IGNORE);
+
+ GVB_GLOBAL_ONLY = 8;
+ GVF_GLOBAL_ONLY = (1 Shl GVB_GLOBAL_ONLY);
+
+ GVB_LOCAL_ONLY = 9;
+ GVF_LOCAL_ONLY = (1 Shl GVB_LOCAL_ONLY);
+
+ GVB_BINARY_VAR = 10;
+ GVF_BINARY_VAR = (1 Shl GVB_BINARY_VAR);
+
+ GVB_DONT_NULL_TERM = 11;
+ GVF_DONT_NULL_TERM = (1 Shl GVB_DONT_NULL_TERM);
+
+ GVB_SAVE_VAR = 12;
+ GVF_SAVE_VAR = (1 Shl GVB_SAVE_VAR);
+
+
+
+{ * dos ReadArgs definitions
+ *********************************************************************
+ * }
+
+
+type
+ PCSource = ^TCSource;
+ TCSource = packed record
+ CS_Buffer: PChar;
+ CS_Length: LongInt;
+ CS_CurChr: LongInt;
+ end;
+
+type
+ PRDArgs = ^TRDArgs;
+ TRDArgs = packed record
+ RDA_Source : TCSource;
+ RDA_DAList : LongInt;
+ RDA_Buffer : PChar;
+ RDA_BufSiz : LongInt;
+ RDA_ExtHelp: PChar;
+ RDA_Flags : LongInt;
+ end;
+
+
+const
+ RDAB_STDIN = 0;
+ RDAF_STDIN = (1 Shl RDAB_STDIN);
+
+ RDAB_NOALLOC = 1;
+ RDAF_NOALLOC = (1 Shl RDAB_NOALLOC);
+
+ RDAB_NOPROMPT = 2;
+ RDAF_NOPROMPT = (1 Shl RDAB_NOPROMPT);
+
+const
+ MAX_TEMPLATE_ITEMS = 100;
+ MAX_MULTIARGS = 128;
+
+
+
+{ * dos filehandler definitions
+ *********************************************************************
+ * }
+
+
+type
+ PDosEnvec = ^TDosEnvec;
+ TDosEnvec = packed record
+ de_TableSize : Cardinal;
+ de_SizeBlock : Cardinal;
+ de_SecOrg : Cardinal;
+ de_Surfaces : Cardinal;
+ de_SectorPerBlock: Cardinal;
+ de_BlocksPerTrack: Cardinal;
+ de_Reserved : Cardinal;
+ de_PreAlloc : Cardinal;
+ de_Interleave : Cardinal;
+ de_LowCyl : Cardinal;
+ de_HighCyl : Cardinal;
+ de_NumBuffers : Cardinal;
+ de_BufMemType : Cardinal;
+ de_MaxTransfer : Cardinal;
+ de_Mask : Cardinal;
+ de_BootPri : LongInt;
+ de_DosType : Cardinal;
+ de_Baud : Cardinal;
+ de_Control : Cardinal;
+ de_BootBlocks : Cardinal;
+ end;
+
+
+const
+ DE_TABLESIZE = 0;
+ DE_SIZEBLOCK = 1;
+ DE_SECORG = 2;
+ DE_NUMHEADS = 3;
+ DE_SECSPERBLK = 4;
+ DE_BLKSPERTRACK = 5;
+ DE_RESERVEDBLKS = 6;
+ DE_PREFAC = 7;
+ DE_INTERLEAVE = 8;
+ DE_LOWCYL = 9;
+ DE_UPPERCYL = 10;
+ DE_NUMBUFFERS = 11;
+ DE_MEMBUFTYPE = 12;
+ DE_BUFMEMTYPE = 12;
+ DE_MAXTRANSFER = 13;
+ DE_MASK = 14;
+ DE_BOOTPRI = 15;
+ DE_DOSTYPE = 16;
+ DE_BAUD = 17;
+ DE_CONTROL = 18;
+ DE_BOOTBLOCKS = 19;
+
+
+type
+ PFileSysStartupMsg = ^TFileSysStartupMsg;
+ TFileSysStartupMsg = packed record
+ fssm_Unit : Cardinal;
+ fssm_Device : LongInt;
+ fssm_Environ: LongInt;
+ fssm_Flags : Cardinal;
+ end;
+
+type
+ PDeviceNode = ^TDeviceNode;
+ TDeviceNode = packed record
+ dn_Next : LongInt;
+ dn_Type : Cardinal;
+ dn_Task : PMsgPort;
+ dn_Lock : LongInt;
+ dn_Handler : LongInt;
+ dn_StackSize: Cardinal;
+ dn_Priority : LongInt;
+ dn_Startup : LongInt;
+ dn_SegList : LongInt;
+ dn_GlobalVec: LongInt;
+ dn_Name : LongInt;
+ end;
+
+
+
+{ * dos notification definitions
+ *********************************************************************
+ * }
+
+
+const
+ NOTIFY_CLASS = $40000000;
+ NOTIFY_CODE = $1234;
+
+
+type
+ PNotifyRequest = ^TNotifyRequest;
+ TNotifyRequest = packed record
+ nr_Name : PChar;
+ nr_FullName: PChar;
+ nr_UserData: Cardinal;
+ nr_Flags : Cardinal;
+ nr_stuff : record
+ case Byte of
+ 0 : ( nr_Msg : record
+ nr_Port: PMsgPort;
+ end );
+ 1 : ( nr_Signal : record
+ nr_Task : PTask;
+ nr_SignalNum: Byte;
+ nr_pad : Array[0..2] Of Byte;
+ end );
+ end;
+ nr_Reserved: Array[0..3] Of Cardinal;
+ nr_MsgCount: Cardinal;
+ nr_Handler : PMsgPort;
+ end;
+
+type
+ PNotifyMessage = ^TNotifyMessage;
+ TNotifyMessage = packed record
+ nm_ExecMessage: TMessage;
+ nm_Class : Cardinal;
+ nm_Code : Word;
+ nm_NReq : PNotifyRequest;
+ nm_DoNotTouch : Cardinal;
+ nm_DoNotTouch2: Cardinal;
+ end;
+
+
+const
+ NRB_SEND_MESSAGE = 0;
+ NRB_SEND_SIGNAL = 1;
+ NRB_WAIT_REPLY = 3;
+ NRB_NOTIFY_INITIAL = 4;
+
+ NRB_MAGIC = 31;
+
+const
+ NRF_SEND_MESSAGE = (1 Shl NRB_SEND_MESSAGE);
+ NRF_SEND_SIGNAL = (1 Shl NRB_SEND_SIGNAL);
+ NRF_WAIT_REPLY = (1 Shl NRB_WAIT_REPLY);
+ NRF_NOTIFY_INITIAL = (1 Shl NRB_NOTIFY_INITIAL);
+
+ NRF_MAGIC = (1 Shl NRB_MAGIC);
+
+const
+ NR_HANDLER_FLAGS = $ffff0000;
+
+
+
+{ * dos.library segtracker include
+ *********************************************************************
+ * }
+
+
+const
+ SEG_SEM = 'SegTracker';
+
+
+type
+ PSegSem = ^TSegSem;
+ TSegSem = packed record
+ seg_Semaphore: TSignalSemaphore;
+ seg_Find : Procedure; { Name = seg_Find(REG(a0, ULONG Address), REG(a1, ULONG *SegNum), REG(a2, ULONG *Offset)) }
+ seg_List : TMinList;
+ end;
+
+type
+ PSegArray = ^TSegArray;
+ TSegArray = packed record
+ seg_Address: Cardinal;
+ seg_Size : Cardinal;
+ end;
+
+type
+ PSegNode = ^TSegNode;
+ TSegNode = packed record
+ seg_Node : TMinNode;
+ seg_Name : PChar;
+ seg_Array: Array[0..0] Of TSegArray;
+ end;
+
+
+
+{
+ $Log: doslibd.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.4 2005/01/12 07:59:05 karoly
+ * Integers changed to SmallInt to be compatible with all modes
+
+ Revision 1.3 2005/01/10 04:58:52 karoly
+ * fixed alignment problem in TDosList
+
+}
diff --git a/rtl/morphos/doslibf.inc b/rtl/morphos/doslibf.inc
new file mode 100644
index 0000000000..44d3c0d4ee
--- /dev/null
+++ b/rtl/morphos/doslibf.inc
@@ -0,0 +1,699 @@
+{
+ $Id: doslibf.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ dos functions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{ dos.library functions }
+
+function Open(fname : PChar location 'd1';
+ accessMode: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 30;
+
+function dosClose(fileh: LongInt location 'd1'): Boolean;
+SysCall MOS_DOSBase 36;
+
+function dosRead(fileh : LongInt location 'd1';
+ buffer: Pointer location 'd2';
+ length: LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 42;
+
+function dosWrite(fileh : LongInt location 'd1';
+ buffer: Pointer location 'd2';
+ length: LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 48;
+
+function dosInput: LongInt;
+SysCall MOS_DOSBase 54;
+
+function dosOutput: LongInt;
+SysCall MOS_DOSBase 60;
+
+function dosSeek(fileh : LongInt location 'd1';
+ position: LongInt location 'd2';
+ posmode : LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 66;
+
+function dosDeleteFile(fname: PChar location 'd1'): Boolean;
+SysCall MOS_DOSBase 72;
+
+function dosRename(oldName: PChar location 'd1';
+ newName: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 78;
+
+function Lock(lname : PChar location 'd1';
+ accessMode: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 84;
+
+procedure Unlock(lock: LongInt location 'd1');
+SysCall MOS_DOSBase 90;
+
+function DupLock(lock: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 096;
+
+function Examine(lock : LongInt location 'd1';
+ fileInfoBlock: PFileInfoBlock location 'd2'): Boolean;
+SysCall MOS_DOSBase 102;
+
+function ExNext(lock : LongInt location 'd1';
+ fileInfoBlock: PFileInfoBlock location 'd2'): LongInt;
+SysCall MOS_DOSBase 108;
+
+function Info(lock : LongInt location 'd1';
+ parameterBlock: PInfoData location 'd2'): Boolean;
+SysCall MOS_DOSBase 114;
+
+function dosCreateDir(dname: PChar location 'd1'): LongInt;
+SysCall MOS_DOSBase 120;
+
+function CurrentDir(lock: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 126;
+
+function IoErr: LongInt;
+SysCall MOS_DOSBase 132;
+
+function CreateProc(name : PChar location 'd1';
+ pri : LongInt location 'd2';
+ segList : LongInt location 'd3';
+ stackSize: LongInt location 'd4'): PMsgPort;
+SysCall MOS_DOSBase 138;
+
+procedure dosExit(returnCode: LongInt location 'd1');
+SysCall MOS_DOSBase 144;
+
+function LoadSeg(name: PChar location 'd1'): LongInt;
+SysCall MOS_DOSBase 150;
+
+procedure UnLoadSeg(seglist: LongInt location 'd1');
+SysCall MOS_DOSBase 156;
+
+function DeviceProc(name: PChar location 'd1'): PMsgPort;
+SysCall MOS_DOSBase 174;
+
+function SetComment(name : PChar location 'd1';
+ comment: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 180;
+
+function SetProtection(name: PChar location 'd1';
+ mask: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 186;
+
+function DateStamp(date: PDateStamp location 'd1'): PDateStamp;
+SysCall MOS_DOSBase 192;
+
+procedure Delay(timeout: LongInt location 'd1');
+SysCall MOS_DOSBase 198;
+
+function WaitForChar(file1 : LongInt location 'd1';
+ timeout: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 204;
+
+function ParentDir(lock: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 210;
+
+function IsInteractive(file1: LongInt location 'd1'): Boolean;
+SysCall MOS_DOSBase 216;
+
+function Execute(string1: PChar location 'd1';
+ file1 : LongInt location 'd2';
+ file2 : LongInt location 'd3'): Boolean;
+SysCall MOS_DOSBase 222;
+
+function AllocDosObject(type1: Cardinal location 'd1';
+ tags : PTagItem location 'd2'): Pointer;
+SysCall MOS_DOSBase 228;
+
+function AllocDosObjectTagList(type1: Cardinal location 'd1';
+ tags : PTagItem location 'd2'): Pointer;
+SysCall MOS_DOSBase 228;
+
+procedure FreeDosObject(type1: Cardinal location 'd1';
+ ptr : Pointer location 'd2');
+SysCall MOS_DOSBase 234;
+
+function DoPkt(port : PMsgPort location 'd1';
+ action: LongInt location 'd2';
+ arg1 : LongInt location 'd3';
+ arg2 : LongInt location 'd4';
+ arg3 : LongInt location 'd5';
+ arg4 : LongInt location 'd6';
+ arg5 : LongInt location 'd7'): LongInt;
+SysCall MOS_DOSBase 240;
+
+function DoPkt0(port : PMsgPort location 'd1';
+ action: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 240;
+
+function DoPkt1(port : PMsgPort location 'd1';
+ action: LongInt location 'd2';
+ arg1 : LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 240;
+
+function DoPkt2(port : PMsgPort location 'd1';
+ action: LongInt location 'd2';
+ arg1 : LongInt location 'd3';
+ arg2 : LongInt location 'd4'): LongInt;
+SysCall MOS_DOSBase 240;
+
+function DoPkt3(port : PMsgPort location 'd1';
+ action: LongInt location 'd2';
+ arg1 : LongInt location 'd3';
+ arg2 : LongInt location 'd4';
+ arg3 : LongInt location 'd5'): LongInt;
+SysCall MOS_DOSBase 240;
+
+function DoPkt4(port : PMsgPort location 'd1';
+ action: LongInt location 'd2';
+ arg1 : LongInt location 'd3';
+ arg2 : LongInt location 'd4';
+ arg3 : LongInt location 'd5';
+ arg4 : LongInt location 'd6'): LongInt;
+SysCall MOS_DOSBase 240;
+
+procedure SendPkt(dp : PDosPacket location 'd1';
+ port : PMsgPort location 'd2';
+ replyport: PMsgPort location 'd3');
+SysCall MOS_DOSBase 246;
+
+function WaitPkt: PDosPacket;
+SysCall MOS_DOSBase 252;
+
+procedure ReplyPkt(dp : PDosPacket location 'd1';
+ res1: LongInt location 'd2';
+ res2: LongInt location 'd3');
+SysCall MOS_DOSBase 258;
+
+procedure AbortPkt(port: PMsgPort location 'd1';
+ pkt : PDosPacket location 'd2');
+SysCall MOS_DOSBase 264;
+
+function LockRecord(fh : LongInt location 'd1';
+ offset : Cardinal location 'd2';
+ length : Cardinal location 'd3';
+ mode : Cardinal location 'd4';
+ timeout: Cardinal location 'd5'): Boolean;
+SysCall MOS_DOSBase 270;
+
+function LockRecords(recArray: PRecordLock location 'd1';
+ timeout : Cardinal location 'd2'): Boolean;
+SysCall MOS_DOSBase 276;
+
+function UnLockRecord(fh : LongInt location 'd1';
+ offset: Cardinal location 'd2';
+ length: Cardinal location 'd3'): Boolean;
+SysCall MOS_DOSBase 282;
+
+function UnLockRecords(recArray: PRecordLock location 'd1'): Boolean;
+SysCall MOS_DOSBase 288;
+
+function SelectInput(fh: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 294;
+
+function SelectOutput(fh: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 300;
+
+function FGetC(fh: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 306;
+
+function FPutC(fh: LongInt location 'd1';
+ ch: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 312;
+
+function UnGetC(fh : LongInt location 'd1';
+ character: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 318;
+
+function FRead(fh : LongInt location 'd1';
+ block : Pointer location 'd2';
+ blocklen: Cardinal location 'd3';
+ number : Cardinal location 'd4'): LongInt;
+SysCall MOS_DOSBase 324;
+
+function FWrite(fh : LongInt location 'd1';
+ block : Pointer location 'd2';
+ blocklen: Cardinal location 'd3';
+ number : Cardinal location 'd4'): LongInt;
+SysCall MOS_DOSBase 330;
+
+function FGets(fh : LongInt location 'd1';
+ buf : PChar location 'd2';
+ buflen: Cardinal location 'd3'): PChar;
+SysCall MOS_DOSBase 336;
+
+function FPuts(fh : LongInt location 'd1';
+ str: PChar location 'd2'): LongInt;
+SysCall MOS_DOSBase 342;
+
+procedure VFWritef(fh : LongInt location 'd1';
+ format : PChar location 'd2';
+ argarray: Pointer location 'd3');
+SysCall MOS_DOSBase 348;
+
+function VFPrintf(fh : LongInt location 'd1';
+ format : PChar location 'd2';
+ argarray: Pointer location 'd3'): LongInt;
+SysCall MOS_DOSBase 354;
+
+function dosFlush(fh: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 360;
+
+function SetVBuf(fh : LongInt location 'd1';
+ buff : PChar location 'd2';
+ type1: LongInt location 'd3';
+ size : LongInt location 'd4'): LongInt;
+SysCall MOS_DOSBase 366;
+
+function DupLockFromFH(fh: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 372;
+
+function OpenFromLock(lock: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 378;
+
+function ParentOfFH(fh: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 384;
+
+function ExamineFH(fh : LongInt location 'd1';
+ fib: PFileInfoBlock location 'd2'): Boolean;
+SysCall MOS_DOSBase 390;
+
+function SetFileDate(name: PChar location 'd1';
+ date: PDateStamp location 'd2'): Boolean;
+SysCall MOS_DOSBase 396;
+
+function NameFromLock(lock : LongInt location 'd1';
+ buffer: PChar location 'd2';
+ len : LongInt location 'd3'): Boolean;
+SysCall MOS_DOSBase 402;
+
+function NameFromFH(fh : LongInt location 'd1';
+ buffer: PChar location 'd2';
+ len : LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 408;
+
+function SplitName(name : PChar location 'd1';
+ separator: Cardinal location 'd2';
+ buf : PChar location 'd3';
+ oldpos : LongInt location 'd4';
+ size : LongInt location 'd5'): SmallInt;
+SysCall MOS_DOSBase 414;
+
+function SameLock(lock1: LongInt location 'd1';
+ lock2: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 420;
+
+function SetMode(fh : LongInt location 'd1';
+ mode: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 426;
+
+function ExAll(lock : LongInt location 'd1';
+ buffer : PExAllData location 'd2';
+ size : LongInt location 'd3';
+ data : LongInt location 'd4';
+ control: PExAllControl location 'd5'): Boolean;
+SysCall MOS_DOSBase 432;
+
+function ReadLink(port : PMsgPort location 'd1';
+ lock : LongInt location 'd2';
+ path : PChar location 'd3';
+ buffer: PChar location 'd4';
+ size : Cardinal location 'd5'): Boolean;
+SysCall MOS_DOSBase 438;
+
+function MakeLink(name: PChar location 'd1';
+ dest: LongInt location 'd2';
+ soft: LongInt location 'd3'): Boolean;
+SysCall MOS_DOSBase 444;
+
+function ChangeMode(type1 : LongInt location 'd1';
+ fh : LongInt location 'd2';
+ newmode: LongInt location 'd3'): Boolean;
+SysCall MOS_DOSBase 450;
+
+function SetFileSize(fh : LongInt location 'd1';
+ pos : LongInt location 'd2';
+ mode: LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 456;
+
+function SetIoErr(result: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 462;
+
+function Fault(code : LongInt location 'd1';
+ header: PChar location 'd2';
+ buffer: PChar location 'd3';
+ len : LongInt location 'd4'): Boolean;
+SysCall MOS_DOSBase 468;
+
+function PrintFault(code : LongInt location 'd1';
+ header: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 474;
+
+function ErrorReport(code : LongInt location 'd1';
+ type1 : LongInt location 'd2';
+ arg1 : Cardinal location 'd3';
+ device: PMsgPort location 'd4'): Boolean;
+SysCall MOS_DOSBase 480;
+
+function Cli: PCommandLineInterface;
+SysCall MOS_DOSBase 492;
+
+function CreateNewProc(tags: PTagItem location 'd1'): PProcess;
+SysCall MOS_DOSBase 498;
+
+function CreateNewProcTagList(tags: PTagItem location 'd1'): PProcess;
+SysCall MOS_DOSBase 498;
+
+function RunCommand(seg : LongInt location 'd1';
+ stack : LongInt location 'd2';
+ paramptr: PChar location 'd3';
+ paramlen: LongInt location 'd4'): LongInt;
+SysCall MOS_DOSBase 504;
+
+function GetConsoleTask: PMsgPort;
+SysCall MOS_DOSBase 510;
+
+function SetConsoleTask(task: PMsgPort location 'd1'): PMsgPort;
+SysCall MOS_DOSBase 516;
+
+function GetFileSysTask: PMsgPort;
+SysCall MOS_DOSBase 522;
+
+function SetFileSysTask(task: PMsgPort location 'd1'): PMsgPort;
+SysCall MOS_DOSBase 528;
+
+function GetArgStr: PChar;
+SysCall MOS_DOSBase 534;
+
+function SetArgStr(str: PChar location 'd1'): Boolean;
+SysCall MOS_DOSBase 540;
+
+function FindCliProc(num: Cardinal location 'd1'): PProcess;
+SysCall MOS_DOSBase 546;
+
+function MaxCli: Cardinal;
+SysCall MOS_DOSBase 552;
+
+function SetCurrentDirName(name: PChar location 'd1'): Boolean;
+SysCall MOS_DOSBase 558;
+
+function GetCurrentDirName(buf: PChar location 'd1';
+ len: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 564;
+
+function SetProgramName(name: PChar location 'd1'): Boolean;
+SysCall MOS_DOSBase 570;
+
+function GetProgramName(buf: PChar location 'd1';
+ len: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 576;
+
+function SetPrompt(name: PChar location 'd1'): Boolean;
+SysCall MOS_DOSBase 582;
+
+function GetPrompt(buf: PChar location 'd1';
+ len: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 588;
+
+function SetProgramDir(lock: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 594;
+
+function GetProgramDir: LongInt;
+SysCall MOS_DOSBase 600;
+
+function SystemTagList(command: PChar location 'd1';
+ tags : PTagItem location 'd2'): LongInt;
+SysCall MOS_DOSBase 606;
+
+function dosSystem(command: PChar location 'd1';
+ tags : PTagItem location 'd2'): LongInt;
+SysCall MOS_DOSBase 606;
+
+function AssignLock(name: PChar location 'd1';
+ lock: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 612;
+
+function AssignLate(name: PChar location 'd1';
+ path: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 618;
+
+function AssignPath(name: PChar location 'd1';
+ path: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 624;
+
+function AssignAdd(name: PChar location 'd1';
+ lock: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 630;
+
+function RemAssignList(name: PChar location 'd1';
+ lock: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 636;
+
+function GetDeviceProc(name: PChar location 'd1';
+ dp : PDevProc location 'd2'): PDevProc;
+SysCall MOS_DOSBase 642;
+
+procedure FreeDeviceProc(dp: PDevProc location 'd1');
+SysCall MOS_DOSBase 648;
+
+function LockDosList(flags: Cardinal location 'd1'): PDosList;
+SysCall MOS_DOSBase 654;
+
+procedure UnLockDosList(flags: Cardinal location 'd1');
+SysCall MOS_DOSBase 660;
+
+function AttemptLockDosList(flags: Cardinal location 'd1'): PDosList;
+SysCall MOS_DOSBase 666;
+
+function RemDosEntry(dlist: PDosList location 'd1'): Boolean;
+SysCall MOS_DOSBase 672;
+
+function AddDosEntry(dlist: PDosList location 'd1'): LongInt;
+SysCall MOS_DOSBase 678;
+
+function FindDosEntry(dlist: PDosList location 'd1';
+ name : PChar location 'd2';
+ flags: Cardinal location 'd3'): PDosList;
+SysCall MOS_DOSBase 684;
+
+function NextDosEntry(dlist: PDosList location 'd1';
+ flags: Cardinal location 'd2'): PDosList;
+SysCall MOS_DOSBase 690;
+
+function MakeDosEntry(name : PChar location 'd1';
+ type1: LongInt location 'd2'): PDosList;
+SysCall MOS_DOSBase 696;
+
+procedure FreeDosEntry(dlist: PDosList location 'd1');
+SysCall MOS_DOSBase 702;
+
+function IsFileSystem(name: PChar location 'd1'): Boolean;
+SysCall MOS_DOSBase 708;
+
+function Format(filesystem: PChar location 'd1';
+ volumename: PChar location 'd2';
+ dostype : Cardinal location 'd3'): Boolean;
+SysCall MOS_DOSBase 714;
+
+function Relabel(drive : PChar location 'd1';
+ newname: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 720;
+
+function Inhibit(name : PChar location 'd1';
+ onoff: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 726;
+
+function AddBuffers(name : PChar location 'd1';
+ number: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 732;
+
+function CompareDates(date1: PDateStamp location 'd1';
+ date2: PDateStamp location 'd2'): LongInt;
+SysCall MOS_DOSBase 738;
+
+function DateToStr(datetime: _PDateTime location 'd1'): Boolean;
+SysCall MOS_DOSBase 744;
+
+function StrToDate(datetime: _PDateTime location 'd1'): Boolean;
+SysCall MOS_DOSBase 750;
+
+function InternalLoadSeg(fh : LongInt location 'd0';
+ table : LongInt location 'a0';
+ var funcarray: LongInt location 'a1';
+ var stack : LongInt location 'a2'): LongInt;
+SysCall MOS_DOSBase 756;
+
+function NewLoadSeg(file1: PChar location 'd1';
+ tags : PTagItem location 'd2'): LongInt;
+SysCall MOS_DOSBase 768;
+
+function NewLoadSegTagList(file1: PChar location 'd1';
+ tags : PTagItem location 'd2'): LongInt;
+SysCall MOS_DOSBase 768;
+
+function AddSegment(name : PChar location 'd1';
+ seg : LongInt location 'd2';
+ system: LongInt location 'd3'): Boolean;
+SysCall MOS_DOSBase 774;
+
+function FindSegment(name : PChar location 'd1';
+ seg : PSegment location 'd2';
+ system: LongInt location 'd3'): PSegment;
+SysCall MOS_DOSBase 780;
+
+function RemSegment(seg: PSegment location 'd1'): Boolean;
+SysCall MOS_DOSBase 786;
+
+function CheckSignal(mask: LongInt location 'd1'): LongInt;
+SysCall MOS_DOSBase 792;
+
+function ReadArgs(arg_template: PChar location 'd1';
+ var array1 : LongInt location 'd2';
+ args : PRDArgs location 'd3'): PRDArgs;
+SysCall MOS_DOSBase 798;
+
+function FindArg(keyword : PChar location 'd1';
+ arg_template: PChar location 'd2'): LongInt;
+SysCall MOS_DOSBase 804;
+
+function ReadItem(name : PChar location 'd1';
+ maxchars: LongInt location 'd2';
+ cSource : PCSource location 'd3'): LongInt;
+SysCall MOS_DOSBase 810;
+
+function StrToLong(string1 : PChar location 'd1';
+ var value: LongInt location 'd2'): LongInt;
+SysCall MOS_DOSBase 816;
+
+function MatchFirst(pat : PChar location 'd1';
+ anchor: PAnchorPath location 'd2'): LongInt;
+SysCall MOS_DOSBase 822;
+
+function MatchNext(anchor: PAnchorPath location 'd1'): LongInt;
+SysCall MOS_DOSBase 828;
+
+procedure MatchEnd(anchor: PAnchorPath location 'd1');
+SysCall MOS_DOSBase 834;
+
+function ParsePattern(pat : PChar location 'd1';
+ buf : PChar location 'd2';
+ buflen: LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 840;
+
+function MatchPattern(pat: PChar location 'd1';
+ str: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 846;
+
+procedure FreeArgs(args: pRDArgs location 'd1');
+SysCall MOS_DOSBase 858;
+
+function FilePart(path: PChar location 'd1'): PChar;
+SysCall MOS_DOSBase 870;
+
+function PathPart(path: PChar location 'd1'): PChar;
+SysCall MOS_DOSBase 876;
+
+function AddPart(dirname: PChar location 'd1';
+ filename: PChar location 'd2';
+ size : Cardinal location 'd3'): Boolean;
+SysCall MOS_DOSBase 882;
+
+function StartNotify(notify: PNotifyRequest location 'd1'): Boolean;
+SysCall MOS_DOSBase 888;
+
+procedure EndNotify(notify: PNotifyRequest location 'd1');
+SysCall MOS_DOSBase 894;
+
+function SetVar(name : PChar location 'd1';
+ buffer: PChar location 'd2';
+ size : LongInt location 'd3';
+ flags : LongInt location 'd4'): Boolean;
+SysCall MOS_DOSBase 900;
+
+function GetVar(name : PChar location 'd1';
+ buffer: PChar location 'd2';
+ size : LongInt location 'd3';
+ flags : LongInt location 'd4'): LongInt;
+SysCall MOS_DOSBase 906;
+
+function DeleteVar(name : PChar location 'd1';
+ flags: Cardinal location 'd2'): Boolean;
+SysCall MOS_DOSBase 912;
+
+function FindVar(name : PChar location 'd1';
+ type1: Cardinal location 'd2'): PLocalVar;
+SysCall MOS_DOSBase 918;
+
+function CliInitNewcli(dp: PDosPacket location 'a0'): LongInt;
+SysCall MOS_DOSBase 930;
+
+function CliInitRun(dp: PDosPacket location 'a0'): LongInt;
+SysCall MOS_DOSBase 936;
+
+function WriteChars(buf : PChar location 'd1';
+ buflen: Cardinal location 'd2'): LongInt;
+SysCall MOS_DOSBase 942;
+
+function PutStr(str: PChar location 'd1'): LongInt;
+SysCall MOS_DOSBase 948;
+
+function VPrintf(format : PChar location 'd1';
+ argarray: Pointer location 'd2'): LongInt;
+SysCall MOS_DOSBase 954;
+
+function ParsePatternNoCase(pat : PChar location 'd1';
+ buf : PChar location 'd2';
+ buflen: LongInt location 'd3'): LongInt;
+SysCall MOS_DOSBase 966;
+
+function MatchPatternNoCase(pat: PChar location 'd1';
+ str: PChar location 'd2'): Boolean;
+SysCall MOS_DOSBase 972;
+
+function SameDevice(lock1: LongInt location 'd1';
+ lock2: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 984;
+
+procedure ExAllEnd(lock : LongInt location 'd1';
+ buffer : PExAllData location 'd2';
+ size : LongInt location 'd3';
+ data : LongInt location 'd4';
+ control: PExAllControl location 'd5');
+SysCall MOS_DOSBase 990;
+
+function SetOwner(name : PChar location 'd1';
+ owner_info: LongInt location 'd2'): Boolean;
+SysCall MOS_DOSBase 996;
+
+function AddSegmentTagList(tags: PTagItem location 'a0'): LongInt;
+SysCall MOS_DOSBase 1002;
+
+function FindSegmentTagList(tags: PTagItem location 'a0'): PSegment;
+SysCall MOS_DOSBase 1008;
+
+
+
+{
+ $Log: doslibf.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.4 2005/01/12 07:59:54 karoly
+ * Integers changed to SmallInt to be compatible with all modes
+
+ Revision 1.3 2005/01/11 17:44:52 karoly
+ * some updates for sysutils
+
+}
diff --git a/rtl/morphos/emuld.inc b/rtl/morphos/emuld.inc
new file mode 100644
index 0000000000..3c5d3585c2
--- /dev/null
+++ b/rtl/morphos/emuld.inc
@@ -0,0 +1,35 @@
+{
+ $Id: emuld.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ emulinterface definitions for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ * emulinterface structures from MorphOS SDK * }
+
+type
+ PEmulLibEntry = ^TEmulLibEntry;
+ TEmulLibEntry = packed record
+ Trap : Word;
+ Extension: Word; { * MUST be set to 0 if you create it by hand * }
+ Func : Pointer;
+ end;
+
+{
+ $Log: emuld.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/exec.pp b/rtl/morphos/exec.pp
new file mode 100644
index 0000000000..914cbc4739
--- /dev/null
+++ b/rtl/morphos/exec.pp
@@ -0,0 +1,59 @@
+{
+ $Id: exec.pp,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ exec.library interface unit for MorphOS/PowerPC
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit exec;
+
+interface
+
+var
+ ExecBase: Pointer;
+
+{$include execd.inc}
+{$include execf.inc}
+
+
+function NewGetTaskAttrs(Task : PTask;
+ Data : Pointer;
+ DataSize: Cardinal;
+ TType : Cardinal;
+ Tags : array of DWord): Cardinal; Inline;
+
+implementation
+
+
+function NewGetTaskAttrs(Task : PTask;
+ Data : Pointer;
+ DataSize: Cardinal;
+ TType : Cardinal;
+ Tags : array of DWord): Cardinal; Inline;
+begin
+ NewGetTaskAttrs:=NewGetTaskAttrsA(Task,Data,DataSize,TType,@Tags);
+end;
+
+
+begin
+ ExecBase:=MOS_ExecBase;
+end.
+
+{
+ $Log: exec.pp,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/execd.inc b/rtl/morphos/execd.inc
new file mode 100644
index 0000000000..513eda93be
--- /dev/null
+++ b/rtl/morphos/execd.inc
@@ -0,0 +1,1743 @@
+{
+ $Id: execd.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ exec definitions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$include emuld.inc}
+{$include utild1.inc}
+
+
+{ * exec node definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PNode = ^TNode;
+ TNode = packed record
+ ln_Succ: PNode;
+ ln_Pred: PNode;
+ ln_Type: Byte;
+ ln_Pri : ShortInt;
+ ln_Name: PChar;
+ end;
+
+type
+ PMinNode = ^TMinNode;
+ TMinNode = packed record
+ mln_Succ: PMinNode;
+ mln_Pred: PMinNode;
+ end;
+
+
+const
+ NT_UNKNOWN = 0;
+ NT_TASK = 1;
+ NT_INTERRUPT = 2;
+ NT_DEVICE = 3;
+ NT_MSGPORT = 4;
+ NT_MESSAGE = 5;
+ NT_FREEMSG = 6;
+ NT_REPLYMSG = 7;
+ NT_RESOURCE = 8;
+ NT_LIBRARY = 9;
+ NT_MEMORY = 10;
+ NT_SOFTINT = 11;
+ NT_FONT = 12;
+ NT_PROCESS = 13;
+ NT_SEMAPHORE = 14;
+ NT_SIGNALSEM = 15;
+ NT_BOOTNODE = 16;
+ NT_KICKMEM = 17;
+ NT_GRAPHICS = 18;
+ NT_DEATHMESSAGE = 19;
+ NT_USER = 254;
+ NT_EXTENDED = 255;
+
+
+
+{ * exec list definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PList = ^TList;
+ TList = packed record
+ lh_Head : PNode;
+ lh_Tail : PNode;
+ lh_TailPred: PNode;
+ lh_Type : Byte;
+ lh_pad : Byte;
+ end;
+
+type
+ PMinList = ^TMinList;
+ TMinList = packed record
+ mlh_Head : PMinNode;
+ mlh_Tail : PMinNode;
+ mlh_TailPred: PMinNode;
+ end;
+
+
+
+{ * exec alert definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ ACPU_BusErr = $80000002;
+ ACPU_AddressErr = $80000003;
+ ACPU_InstErr = $80000004;
+ ACPU_DivZero = $80000005;
+ ACPU_CHK = $80000006;
+ ACPU_TRAPV = $80000007;
+ ACPU_PrivErr = $80000008;
+ ACPU_Trace = $80000009;
+ ACPU_LineA = $8000000A;
+ ACPU_LineF = $8000000B;
+ ACPU_Format = $8000000E;
+ ACPU_Spurious = $80000018;
+ ACPU_AutoVec1 = $80000019;
+ ACPU_AutoVec2 = $8000001A;
+ ACPU_AutoVec3 = $8000001B;
+ ACPU_AutoVec4 = $8000001C;
+ ACPU_AutoVec5 = $8000001D;
+ ACPU_AutoVec6 = $8000001E;
+ ACPU_AutoVec7 = $8000001F;
+
+ AT_DeadEnd = $80000000;
+ AT_Recovery = $00000000;
+
+ AG_NoMemory = $00010000;
+ AG_MakeLib = $00020000;
+ AG_OpenLib = $00030000;
+ AG_OpenDev = $00040000;
+ AG_OpenRes = $00050000;
+ AG_IOError = $00060000;
+ AG_NoSignal = $00070000;
+ AG_BadParm = $00080000;
+ AG_CloseLib = $00090000;
+ AG_CloseDev = $000A0000;
+ AG_ProcCreate = $000B0000;
+ AG_MsgPortNotEmpty = $000C0000 { * V50 * };
+
+ AO_ExecLib = $00008001;
+ AO_GraphicsLib = $00008002;
+ AO_LayersLib = $00008003;
+ AO_Intuition = $00008004;
+ AO_MathLib = $00008005;
+ AO_DOSLib = $00008007;
+ AO_RAMLib = $00008008;
+ AO_IconLib = $00008009;
+ AO_ExpansionLib = $0000800A;
+ AO_DiskfontLib = $0000800B;
+ AO_UtilityLib = $0000800C;
+ AO_KeyMapLib = $0000800D;
+
+ AO_AudioDev = $00008010;
+ AO_ConsoleDev = $00008011;
+ AO_GamePortDev = $00008012;
+ AO_KeyboardDev = $00008013;
+ AO_TrackDiskDev = $00008014;
+ AO_TimerDev = $00008015;
+
+ AO_CIARsrc = $00008020;
+ AO_DiskRsrc = $00008021;
+ AO_MiscRsrc = $00008022;
+
+ AO_BootStrap = $00008030;
+ AO_Workbench = $00008031;
+ AO_DiskCopy = $00008032;
+ AO_GadTools = $00008033;
+ AO_Unknown = $00008035;
+
+
+ { *
+ * exec.library
+ * }
+const
+ AN_ExecLib = $01000000;
+ AN_ExcptVect = $01000001;
+ AN_BaseChkSum = $01000002;
+ AN_LibChkSum = $01000003;
+
+ AN_MemCorrupt = $81000005;
+ AN_IntrMem = $81000006;
+ AN_InitAPtr = $01000007;
+ AN_SemCorrupt = $01000008;
+
+ AN_FreeTwice = $01000009;
+ AN_BogusExcpt = $8100000A;
+ AN_IOUsedTwice = $0100000B;
+ AN_MemoryInsane = $0100000C;
+
+ AN_IOAfterClose = $0100000D;
+ AN_StackProbe = $0100000E;
+ AN_BadFreeAddr = $0100000F;
+ AN_BadSemaphore = $01000010;
+
+ { *
+ * graphics.library
+ * }
+const
+ AN_GraphicsLib = $02000000;
+ AN_GfxNoMem = $82010000;
+ AN_GfxNoMemMspc = $82010001;
+ AN_LongFrame = $82010006;
+ AN_ShortFrame = $82010007;
+ AN_TextTmpRas = $02010009;
+ AN_BltBitMap = $8201000A;
+ AN_RegionMemory = $8201000B;
+ AN_MakeVPort = $82010030;
+ AN_GfxNewError = $0200000C;
+ AN_GfxFreeError = $0200000D;
+
+ AN_GfxNoLCM = $82011234;
+
+ AN_ObsoleteFont = $02000401;
+
+ { *
+ * layers.library
+ * }
+const
+ AN_LayersLib = $03000000;
+ AN_LayersNoMem = $83010000;
+
+ { *
+ * intuition.library
+ * }
+const
+ AN_Intuition = $04000000;
+ AN_GadgetType = $84000001;
+ AN_BadGadget = $04000001;
+ AN_CreatePort = $84010002;
+ AN_ItemAlloc = $04010003;
+ AN_SubAlloc = $04010004;
+ AN_PlaneAlloc = $84010005;
+ AN_ItemBoxTop = $84000006;
+ AN_OpenScreen = $84010007;
+ AN_OpenScrnRast = $84010008;
+ AN_SysScrnType = $84000009;
+ AN_AddSWGadget = $8401000A;
+ AN_OpenWindow = $8401000B;
+ AN_BadState = $8400000C;
+ AN_BadMessage = $8400000D;
+ AN_WeirdEcho = $8400000E;
+ AN_NoConsole = $8400000F;
+ AN_NoISem = $04000010;
+ AN_ISemOrder = $04000011;
+
+ { *
+ * math.library
+ * }
+const
+ AN_MathLib = $05000000;
+
+ { *
+ * dos.library
+ * }
+const
+ AN_DOSLib = $07000000;
+ AN_StartMem = $07010001;
+ AN_EndTask = $07000002;
+ AN_QPktFail = $07000003;
+ AN_AsyncPkt = $07000004;
+ AN_FreeVec = $07000005;
+ AN_DiskBlkSeq = $07000006;
+ AN_BitMap = $07000007;
+ AN_KeyFree = $07000008;
+ AN_BadChkSum = $07000009;
+ AN_DiskError = $0700000A;
+ AN_KeyRange = $0700000B;
+ AN_BadOverlay = $0700000C;
+ AN_BadInitFunc = $0700000D;
+ AN_FileReclosed = $0700000E;
+
+ { *
+ * ramlib.library
+ * }
+const
+ AN_RAMLib = $08000000;
+ AN_BadSegList = $08000001;
+
+ { *
+ * icon.library
+ * }
+const
+ AN_IconLib = $09000000;
+
+ { *
+ * expansion.library
+ * }
+const
+ AN_ExpansionLib = $0A000000;
+ AN_BadExpansionFree = $0A000001;
+
+ { *
+ * diskfont.library
+ * }
+const
+ AN_DiskfontLib = $0B000000;
+
+ { *
+ * audio.device
+ * }
+const
+ AN_AudioDev = $10000000;
+
+ { *
+ * console.device
+ * }
+const
+ AN_ConsoleDev = $11000000;
+ AN_NoWindow = $11000001;
+
+ { *
+ * gameport.device
+ * }
+const
+ AN_GamePortDev = $12000000;
+
+ { *
+ * keyboard.device
+ * }
+const
+ AN_KeyboardDev = $13000000;
+
+ { *
+ * trackdisk.device
+ * }
+const
+ AN_TrackDiskDev = $14000000;
+ AN_TDCalibSeek = $14000001;
+ AN_TDDelay = $14000002;
+
+ { *
+ * timer.device
+ * }
+const
+ AN_TimerDev = $15000000;
+ AN_TMBadReq = $15000001;
+ AN_TMBadSupply = $15000002;
+
+ { *
+ * cia.resource
+ * }
+const
+ AN_CIARsrc = $20000000;
+
+ { *
+ * disk.resource
+ * }
+const
+ AN_DiskRsrc = $21000000;
+ AN_DRHasDisk = $21000001;
+ AN_DRIntNoAct = $21000002;
+
+ { *
+ * misc.resource
+ * }
+const
+ AN_MiscRsrc = $22000000;
+
+ { *
+ * bootstrap
+ * }
+const
+ AN_BootStrap = $30000000;
+ AN_BootError = $30000001;
+
+ { *
+ * Workbench
+ * }
+const
+ AN_Workbench = $31000000;
+ AN_NoFonts = $B1000001;
+ AN_WBBadStartupMsg1 = $31000001;
+ AN_WBBadStartupMsg2 = $31000002;
+ AN_WBBadIOMsg = $31000003;
+ AN_WBReLayoutToolMenu = $B1010009;
+
+ { *
+ * DiskCopy
+ * }
+const
+ AN_DiskCopy = $32000000;
+
+ { *
+ * toolkit for Intuition
+ * }
+const
+ AN_GadTools = $33000000;
+
+ { *
+ * System utility library
+ * }
+const
+ AN_UtilityLib = $34000000;
+
+ { *
+ * For use by any application that needs it
+ * }
+const
+ AN_Unknown = $35000000;
+
+
+
+{ * exec error definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ IOERR_OPENFAIL = (-1);
+ IOERR_ABORTED = (-2);
+ IOERR_NOCMD = (-3);
+ IOERR_BADLENGTH = (-4);
+ IOERR_BADADDRESS = (-5);
+ IOERR_UNITBUSY = (-6);
+ IOERR_SELFTEST = (-7);
+ IOERR_NOMEMORY = (-8);
+
+
+
+{ * exec resident definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PResident = ^TResident;
+ TResident = packed record
+ rt_MatchWord: Word;
+ rt_MatchTag : PResident;
+ rt_EndSkip : Pointer;
+ rt_Flags : Byte;
+ rt_Version : Byte;
+ rt_Type : Byte;
+ rt_Pri : Byte;
+ rt_Name : PChar;
+ rt_IdString : PChar;
+ rt_Init : Pointer;
+ { * Only valid when RTF_EXTENDED is set
+ * }
+ rt_Revision : Word; { * Revision Entry * }
+ rt_Tags : Pointer;
+ end;
+
+
+const
+ RTC_MATCHWORD = $4AFC;
+
+ RTF_AUTOINIT = (1 Shl 7);
+ RTF_EXTENDED = (1 Shl 6); { * structure extension is valid * }
+ { * rt_Init points to a PPC function which must be defined as
+ *
+ * struct Library* LIB_Init(struct Library *MyLibBase,
+ * BPTR SegList,
+ * struct ExecBase *SysBase)
+ * }
+ RTF_PPC = (1 Shl 3);
+ RTF_AFTERDOS = (1 Shl 2);
+ RTF_SINGLETASK = (1 Shl 1);
+ RTF_COLDSTART = (1 Shl 0);
+
+ RTW_NEVER = 0;
+ RTW_COLDSTART = 1;
+
+
+
+{ * exec memory definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PMemChunk = ^TMemChunk;
+ TMemChunk = packed record
+ nc_Next : PMemChunk;
+ nc_Bytes: DWord;
+ end;
+
+type
+ PMemHeader = ^TMemHeader;
+ TMemHeader = packed record
+ mh_Node : TNode;
+ mh_Attributes: Word;
+ mh_First : PMemChunk;
+ mh_Lower : Pointer;
+ mh_Upper : Pointer;
+ mh_Free : DWord;
+ end;
+
+type
+ PMemEntry = ^TMemEntry;
+ TMemEntry = packed record
+ me_Un: packed record
+ case Byte of
+ 0 : (meu_Regs: DWord);
+ 1 : (meu_Addr: Pointer)
+ end;
+ me_Length: DWord;
+ end;
+
+type
+ PMemList = ^TMemList;
+ TMemList = packed record
+ ml_Node : TNode;
+ ml_NumEntries: Word;
+ ml_ME : PMemEntry;
+ end;
+
+
+const
+ MEMF_ANY = 0;
+ MEMF_PUBLIC = (1 Shl 0);
+ MEMF_CHIP = (1 Shl 1);
+ MEMF_FAST = (1 Shl 2);
+ MEMF_LOCAL = (1 Shl 8);
+ MEMF_24BITDMA = (1 Shl 9);
+ MEMF_KICK = (1 Shl 10);
+ MEMF_SWAP = (1 Shl 11); { * Memory that can be swapped out to disk * }
+
+ MEMF_CLEAR = (1 Shl 16);
+ MEMF_LARGEST = (1 Shl 17);
+ MEMF_REVERSE = (1 Shl 18);
+ MEMF_TOTAL = (1 Shl 19);
+ MEMF_SEM_PROTECTED = (1 Shl 20); { * Pools: semaphore protection * }
+ MEMF_NO_EXPUNGE = (1 Shl 31);
+
+ MEM_BLOCKSIZE = 8;
+ MEM_BLOCKMASK = (MEM_BLOCKSIZE - 1);
+
+
+type
+ PMemHandlerData = ^TMemHandlerData;
+ TMemHandlerData = packed record
+ memh_RequestSize : DWord;
+ memh_RequestFlags: DWord;
+ memh_Flags : DWord;
+ end;
+
+
+const
+ MEMHF_RECYCLE = (1 Shl 0);
+
+ MEM_DID_NOTHING = 0;
+ MEM_ALL_DONE = -1;
+ MEM_TRY_AGAIN = 1;
+
+
+
+{ * exec port definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PMsgPort = ^TMsgPort;
+ TMsgPort = packed record
+ mp_Node : TNode;
+ mp_Flags : Byte;
+ mp_SigBit : Byte;
+ mp_SigTask: Pointer;
+ mp_MsgList: TList;
+ end;
+
+
+const
+ PF_ACTION = 3;
+ PA_SIGNAL = 0;
+ PA_SOFTINT = 1;
+ PA_IGNORE = 2;
+
+
+type
+ PMessage = ^TMessage;
+ TMessage = packed record
+ mn_Node : TNode;
+ mn_ReplyPort: PMsgPort;
+ mn_Length : Word;
+ end;
+
+
+
+{ * exec task definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PTask = ^TTask;
+ TTask = packed record
+ tc_Node : TNode;
+ tc_Flags : Byte;
+ tc_State : Byte;
+ tc_IDNestCnt: ShortInt;
+ tc_TDNestCnt: ShortInt;
+ tc_SigAlloc : DWord;
+ tc_SigWait : DWord;
+ tc_SigRecvd : DWord;
+ tc_SigExcept: DWord;
+ {$IF 0}
+ tc_TrapAlloc: Word;
+ tc_TrapAble : Word;
+ {$ELSE}
+ tc_ETask: Pointer;
+ {$ENDIF}
+ tc_ExceptData: Pointer;
+ tc_ExceptCode: Pointer;
+ tc_TrapData : Pointer;
+ tc_TrapCode : Pointer;
+ tc_SPReg : Pointer;
+ tc_SPLower : Pointer;
+ tc_SPUpper : Pointer;
+ tc_Switch : Pointer; { *** OBSOLETE *** }
+ tc_Launch : Pointer; { *** OBSOLETE *** }
+ tc_MemEntry : TList;
+ tc_UserData : Pointer;
+ end;
+
+
+const
+ TB_PROCTIME = 0;
+ TB_ETASK = 3;
+ TB_STACKCHK = 4;
+ TB_EXCEPT = 5;
+ TB_SWITCH = 6;
+ TB_LAUNCH = 7;
+
+ TF_PROCTIME = (1 Shl TB_PROCTIME);
+ TF_ETASK = (1 Shl TB_ETASK);
+ TF_STACKCHK = (1 Shl TB_STACKCHK);
+ TF_EXCEPT = (1 Shl TB_EXCEPT);
+ TF_SWITCH = (1 Shl TB_SWITCH);
+ TF_LAUNCH = (1 Shl TB_LAUNCH);
+
+ TS_INVALID = 0;
+ TS_ADDED = 1;
+ TS_RUN = 2;
+ TS_READY = 3;
+ TS_WAIT = 4;
+ TS_EXCEPT = 5;
+ TS_REMOVED = 6;
+
+ SIGB_ABORT = 0;
+ SIGB_CHILD = 1;
+ SIGB_BLIT = 4;
+ SIGB_SINGLE = 4;
+ SIGB_INTUITION = 5;
+ SIGB_NET = 7;
+ SIGB_DOS = 8;
+
+ SIGF_ABORT = (1 Shl SIGB_ABORT);
+ SIGF_CHILD = (1 Shl SIGB_CHILD);
+ SIGF_BLIT = (1 Shl SIGB_BLIT);
+ SIGF_SINGLE = (1 Shl SIGB_SINGLE);
+ SIGF_INTUITION = (1 Shl SIGB_INTUITION);
+ SIGF_NET = (1 Shl SIGB_NET);
+ SIGF_DOS = (1 Shl SIGB_DOS);
+
+
+type
+ PTaskTrapMessage = ^TTaskTrapMessage;
+ TTaskTrapMessage = packed record
+ Message: TMessage; { * Message Header * }
+ Task : TTask; { * connected Task * }
+ Version: DWord; { * version of the structure * }
+ TType : DWord; { * Exception Type * }
+ DAR : DWord; { * Exception Address Register * }
+ DSISR : DWord; { * Exception DSISR Reg * }
+
+ { * This is undiscovered land...
+ * never assume a size of this structure
+ * }
+ end;
+
+
+const
+ VERSION_TASKTRAPMESSAGE = $0;
+
+
+type
+ PETask = ^TETask;
+ TETask = packed record
+ Message : TMessage;
+ Parent : PTask;
+ UniqueID : DWord;
+ Children : TMinList;
+ TrapAlloc: Word;
+ TrapAble : Word;
+ Result1 : DWord;
+ Result2 : Pointer;
+ MsgPort : TMsgPort;
+
+ { * Don't touch!!!!!!!!!..there'll be an interface
+ * sooner than later.
+ * New Entries...most of the above entries
+ * are only their for structure compatability.
+ * They have no meaning as the OS never supported
+ * them.
+ * }
+
+ { * A Task Pool for the task.
+ * }
+ MemPool: Pointer;
+
+ { * PPC's Stack Lower Ptr
+ * The initial stack is allocated through
+ * AllocVec, so a FreeVec(ETask^.PPCSPLower);
+ * would work.
+ * If you use PPCStackSwap you must allocate
+ * your stack block with AllocVec();
+ * }
+ PPCSPLower: Pointer;
+
+ { * PPC's Stack Upper Ptr
+ * }
+ PPCSPUpper : Pointer;
+ PPCRegFrame: Pointer;
+ PPCLibData : Pointer;
+
+ { * On a PPC exception this msgport
+ * is sent an exception msg...
+ * the task is stopped until somebody
+ * wakes it up again.
+ * (asynchron exception interface)
+ * If this Port is NULL the message is
+ * sent to SysBase->ex_PPCTrapMsgPort.
+ * }
+ PPCTrapMsgPort: PMsgPort;
+ PPCTrapMessage: PTaskTrapMessage;
+
+ { * This is undiscovered land...
+ * never assume a size of this structure
+ * }
+ end;
+
+
+type
+ PTaskInitExtension = ^TTaskInitExtension;
+ TTaskInitExtension = packed record
+ { * Must be filled with TRAP_PPCTASK
+ * }
+ Trap : Word;
+ Extension: Word; { * Must be set to 0 * }
+ Tags : Pointer;
+ end;
+
+
+const
+ TASKTAG_DUMMY = (TAG_USER + $100000);
+
+ { * Ptr to an ULONG Errorfield where a better error description
+ * can be stored.
+ * }
+ TASKTAG_ERROR = (TASKTAG_DUMMY + $0);
+
+ { * Code type
+ * can be stored.
+ * }
+ TASKTAG_CODETYPE = (TASKTAG_DUMMY + $1);
+
+ { * Start PC
+ * code must be of TASKTAG_CODETYPE
+ * }
+ TASKTAG_PC = (TASKTAG_DUMMY + $2);
+
+ { * Final PC
+ * code must be of TASKTAG_CODETYPE
+ * }
+ TASKTAG_FINALPC = (TASKTAG_DUMMY + $3);
+
+ { * Stacksize...Default 8192
+ * }
+ TASKTAG_STACKSIZE = (TASKTAG_DUMMY + $4);
+
+ { * Std Stacksize...
+ * Default(use the stack defined by tc_SPLower..tc_SPUpper)
+ * }
+ TASKTAG_STACKSIZE_M68K = (TASKTAG_DUMMY + $5);
+
+ { * specify task name, name is copied
+ * }
+ TASKTAG_NAME = (TASKTAG_DUMMY + $6);
+
+ { * tc_UserData
+ * }
+ TASKTAG_USERDATA = (TASKTAG_DUMMY + $7);
+
+ { * Task priority
+ * }
+ TASKTAG_PRI = (TASKTAG_DUMMY + $8);
+
+ { * Pool's Puddlesize
+ * }
+ TASKTAG_POOLPUDDLE = (TASKTAG_DUMMY + $9);
+
+ { * Pool's ThreshSize
+ * }
+ TASKTAG_POOLTHRESH = (TASKTAG_DUMMY + $a);
+
+ { * PPC First Argument..gpr3
+ * }
+ TASKTAG_PPC_ARG1 = (TASKTAG_DUMMY + $10);
+
+ { * PPC First Argument..gpr4
+ * }
+ TASKTAG_PPC_ARG2 = (TASKTAG_DUMMY + $11);
+
+ { * PPC First Argument..gpr5
+ * }
+ TASKTAG_PPC_ARG3 = (TASKTAG_DUMMY + $12);
+
+ { * PPC First Argument..gpr6
+ * }
+ TASKTAG_PPC_ARG4 = (TASKTAG_DUMMY + $13);
+
+ { * PPC First Argument..gpr7
+ * }
+ TASKTAG_PPC_ARG5 = (TASKTAG_DUMMY + $14);
+
+ { * PPC First Argument..gpr8
+ * }
+ TASKTAG_PPC_ARG6 = (TASKTAG_DUMMY + $15);
+
+ { * PPC First Argument..gpr9
+ * }
+ TASKTAG_PPC_ARG7 = (TASKTAG_DUMMY + $16);
+
+ { * PPC First Argument..gpr10
+ * }
+ TASKTAG_PPC_ARG8 = (TASKTAG_DUMMY + $17);
+
+ { *
+ * Startup message to be passed to task/process, ReplyMsg'd at RemTask()
+ * ti_Data: struct Message *
+ * }
+ TASKTAG_STARTUPMSG = (TASKTAG_DUMMY + $18);
+
+ { *
+ * Create internal MsgPort for task/process, deleted at RemTask()
+ * ti_Data: struct MsgPort **, can be NULL
+ * }
+ TASKTAG_TASKMSGPORT = (TASKTAG_DUMMY + $19);
+
+
+const
+ CODETYPE_M68K = $0;
+ { *
+ * System V4 ABI
+ * }
+ CODETYPE_PPC = $1;
+
+const
+ TASKERROR_OK = 0;
+ TASKERROR_NOMEMORY = 1;
+
+
+ { *
+ * Stack swap structure as passed to StackSwap() and PPCStackSwap()
+ * }
+type
+ PStackSwapStruct = ^TStackSwapStruct;
+ TStackSwapStruct = packed record
+ stk_Lower : Pointer; { * Lowest byte of stack * }
+ stk_Upper : Pointer; { * Upper end of stack (size + Lowert) * }
+ stk_Pointer: Pointer; { * Stack pointer at switch point * }
+ end;
+
+type
+ PPPCStackSwapArgs = ^TPPCStackSwapArgs;
+ TPPCStackSwapArgs = packed record
+ Args: Array[0..7] Of DWord; { * The C register arguments from gpr3..gpr11 * }
+ end;
+
+
+ { *
+ * NewGetTaskAttrsA(), NewSetTaskAttrsA() tags
+ * }
+const
+ TASKINFOTYPE_ALLTASK = $0;
+ TASKINFOTYPE_NAME = $1;
+ TASKINFOTYPE_PRI = $2;
+ TASKINFOTYPE_TYPE = $3;
+ TASKINFOTYPE_STATE = $4;
+ TASKINFOTYPE_FLAGS = $5;
+ TASKINFOTYPE_SIGALLOC = $6;
+ TASKINFOTYPE_SIGWAIT = $7;
+ TASKINFOTYPE_SIGRECVD = $8;
+ TASKINFOTYPE_SIGEXCEPT = $9;
+ TASKINFOTYPE_EXCEPTDATA = $a;
+ TASKINFOTYPE_EXCEPTCODE = $b;
+ TASKINFOTYPE_TRAPDATA = $c;
+ TASKINFOTYPE_TRAPCODE = $d;
+ TASKINFOTYPE_STACKSIZE_M68K = $e;
+ TASKINFOTYPE_STACKSIZE = $f;
+ TASKINFOTYPE_USEDSTACKSIZE_M68K = $10;
+ TASKINFOTYPE_USEDSTACKSIZE = $11;
+ TASKINFOTYPE_TRAPMSGPORT = $12;
+ TASKINFOTYPE_STARTUPMSG = $13;
+ TASKINFOTYPE_TASKMSGPORT = $14;
+ TASKINFOTYPE_POOLPTR = $15;
+ TASKINFOTYPE_POOLMEMFLAGS = $16;
+ TASKINFOTYPE_POOLPUDDLESIZE = $17;
+ TASKINFOTYPE_POOLTHRESHSIZE = $18;
+
+ { *
+ * Task Scheduler statistics (exec 50.42)
+ * }
+ TASKINFOTYPE_NICE = $19;
+ TASKINFOTYPE_AGETICKS = $1a;
+ TASKINFOTYPE_CPUTIME = $1b;
+ TASKINFOTYPE_LASTSECCPUTIME = $1c;
+ TASKINFOTYPE_RECENTCPUTIME = $1d;
+ TASKINFOTYPE_VOLUNTARYCSW = $1e;
+ TASKINFOTYPE_INVOLUNTARYCSW = $1f;
+ TASKINFOTYPE_LASTSECVOLUNTARYCSW = $20;
+ TASKINFOTYPE_LASTSECINVOLUNTARYCSW = $21;
+ { * Added in exec 50.45 * }
+ TASKINFOTYPE_LAUNCHTIMETICKS = $22;
+ TASKINFOTYPE_LAUNCHTIMETICKS1978 = $23;
+ TASKINFOTYPE_PID = $24;
+
+ TASKINFOTYPE_68K_NEWFRAME = $50;
+
+ TASKINFOTYPE_PPC_SRR0 = $100;
+ TASKINFOTYPE_PPC_SRR1 = $101;
+ TASKINFOTYPE_PPC_LR = $102;
+ TASKINFOTYPE_PPC_CTR = $103;
+ TASKINFOTYPE_PPC_CR = $104;
+ TASKINFOTYPE_PPC_XER = $105;
+ TASKINFOTYPE_PPC_GPR = $106;
+ TASKINFOTYPE_PPC_FPR = $107;
+ TASKINFOTYPE_PPC_FPSCR = $108;
+ TASKINFOTYPE_PPC_VSCR = $109;
+ TASKINFOTYPE_PPC_VMX = $10a;
+ TASKINFOTYPE_PPC_VSAVE = $10b;
+ TASKINFOTYPE_PPC_FRAME = $10c;
+ TASKINFOTYPE_PPC_FRAMESIZE = $10d;
+ TASKINFOTYPE_PPC_NEWFRAME = $10e;
+
+ TASKINFOTAG_DUMMY = (TAG_USER + $110000);
+ { * Used with TASKINFOTYPE_ALLTASK
+ * }
+ TASKINFOTAG_HOOK = (TASKINFOTAG_DUMMY + $0);
+ { * Used with TASKINFOTYPE_PPC_GPR,TASKINFOTYPE_PPC_FPR,TASKINFOTYPE_PPC_VMX
+ * to define the copy area
+ * }
+ TASKINFOTAG_REGSTART = (TASKINFOTAG_DUMMY + $1);
+ { * Used with TASKINFOTYPE_PPC_GPR,TASKINFOTYPE_PPC_FPR,TASKINFOTYPE_PPC_VMX
+ * to define the copy area
+ * }
+ TASKINFOTAG_REGCOUNT = (TASKINFOTAG_DUMMY + $2);
+
+
+ { *
+ * NewSetTaskAttrsA(..,@TaskFrame68k,sizeof(TTaskFrame68k),TASKINFOTYPE_68K_NEWFRAME,...);
+ * }
+type
+ PTaskFrame68k = ^TTaskFrame68k;
+ TTaskFrame68k = packed record
+ PC: Pointer;
+ SR: Word;
+ Xn: Array[0..14] Of LongInt;
+ end;
+
+
+ { *
+ * Don't depend on these
+ * }
+const
+ DEFAULT_PPCSTACKSIZE = 32768;
+ DEFAULT_M68KSTACKSIZE = 2048;
+ DEFAULT_TASKPUDDLESIZE = 4096;
+ DEFAULT_TASKTHRESHSIZE = 4096;
+
+
+{ * exec interrupt definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PInterrupt = ^TInterrupt;
+ TInterrupt = packed record
+ is_Node: TNode;
+ is_Data: Pointer;
+ is_Code: Pointer;
+ end;
+
+type
+ PIntVector = ^TIntVector;
+ TIntVector = packed record
+ iv_Data: Pointer;
+ iv_Code: Pointer;
+ iv_Node: PNode;
+ end;
+
+type
+ PSoftIntList = ^TSoftIntList;
+ TSoftIntList = packed record
+ sh_List: TList;
+ sh_Pad : Word;
+ end;
+
+
+const
+ SIH_PRIMASK = $f0;
+
+ INTB_NMI = 15;
+ INTF_NMI = (1 Shl INTB_NMI);
+
+
+
+{ * exec semaphore definitions (V50)
+ *********************************************************************
+ * }
+
+
+ { *
+ * Shouldn't be available public..
+ * }
+type
+ PSemaphoreRequest = ^TSemaphoreRequest;
+ TSemaphoreRequest = packed record
+ sr_Link : TMinNode;
+ sr_Waiter: PTask;
+ end;
+
+type
+ PSignalSemaphore = ^TSignalSemaphore;
+ TSignalSemaphore = packed record
+ ss_Link : TNode;
+ ss_NestCount : SmallInt;
+ ss_WaitQueue : TMinList;
+ ss_MultipleLink: TSemaphoreRequest;
+ ss_Owner : PTask;
+ ss_QueueCount : SmallInt;
+ end;
+
+type
+ PSemaphoreMessage = ^TSemaphoreMessage;
+ TSemaphoreMessage = packed record
+ ssm_Message : TMessage;
+ ssm_Semaphore: PSignalSemaphore;
+ end;
+
+
+const
+ SM_SHARED = 1;
+ SM_EXCLUSIVE = 0;
+
+
+
+{ * exec machine definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ MACHINE_M68k = $0;
+ MACHINE_PPC = $1;
+ MACHINE_NO = $ffffffff;
+
+
+
+{ * exec library definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ LIB_VECTSIZE = 6;
+ LIB_RESERVED = 4;
+ LIB_BASE = (-LIB_VECTSIZE);
+ LIB_USERDEF = (LIB_BASE - (LIB_RESERVED * LIB_VECTSIZE));
+ LIB_NONSTD = (LIB_USERDEF);
+
+ LIB_OPEN = -6;
+ LIB_CLOSE = -12;
+ LIB_EXPUNGE = -18;
+ LIB_EXTFUNC = -24;
+ LIB_GETQUERYATTR = -24; { * LIBF_QUERY * }
+
+
+type
+ PLibrary = ^TLibrary;
+ TLibrary = packed record
+ lib_Node : TNode;
+ lib_Flags : Byte;
+ lib_pad : Byte;
+ lib_MegSize : Word;
+ lib_PosSize : Word;
+ lib_Version : Word;
+ lib_Revision: Word;
+ lib_IdString: PChar;
+ lib_Sum : DWord;
+ lib_OpenCnt : Word;
+ end;
+
+
+const
+ LIBF_SUMMING = (1 Shl 0);
+ LIBF_CHANGED = (1 Shl 1);
+ LIBF_SUMUSED = (1 Shl 2);
+ LIBF_DELEXP = (1 Shl 3);
+ { *
+ * private
+ * }
+ LIBF_RAMLIB = (1 Shl 4);
+ { *
+ * Needs to be set if the GetQueryAttr function is legal
+ * }
+ LIBF_QUERYINFO = (1 Shl 5);
+ { *
+ * The remaining bits are reserved and aren`t allowed to be touched
+ * }
+
+
+ { * NewSetFunction extensions
+ * }
+const
+ SETFUNCTAG_Dummy = (TAG_USER +$01000000);
+
+ { * Set the machine type of the function
+ * Default is 68k
+ * }
+ SETFUNCTAG_MACHINE = (SETFUNCTAG_Dummy + $1);
+
+ { * Function type specifier
+ * }
+ SETFUNCTAG_TYPE = (SETFUNCTAG_Dummy + $2);
+
+ { * ID String
+ * }
+ SETFUNCTAG_IDNAME = (SETFUNCTAG_Dummy + $3);
+
+ { *
+ * Set to TRUE if the replaced function will never be used
+ * again.
+ * }
+ SETFUNCTAG_DELETE = (SETFUNCTAG_Dummy + $4);
+
+
+ { * See emul/emulinterface.h for more informations
+ * }
+
+ { * Save Emulation PPC Registers
+ * Call Function
+ * Restore Emulation PPC Registers
+ * REG_D0 = Result
+ * }
+const
+ SETFUNCTYPE_NORMAL = 0;
+ { * Call Function
+ * Must use the global register settings of the emulation
+ * REG_D0 = Result
+ * }
+ SETFUNCTYPE_QUICK = 1;
+ { * Save Emulation PPC Registers
+ * Call Function
+ * Restore Emulation PPC Registers
+ * No Result
+ * Needed to replace functions like
+ * forbid,obtainsemaphores which are
+ * defined as trashing no registers
+ * }
+ SETFUNCTYPE_NORMALNR = 2;
+ { * Call Function
+ * Must use the global register settings of the emulation
+ * No Result
+ * Needed to replace functions like
+ * forbid,obtainsemaphores which are
+ * defined as trashing no registers
+ * }
+ SETFUNCTYPE_QUICKNR = 3;
+ SETFUNCTYPE_NORMALSR = 4;
+ SETFUNCTYPE_NORMALSRNR = 5;
+ SETFUNCTYPE_NORMALD0_D1 = 6;
+ SETFUNCTYPE_NORMALRESTORE = 7;
+ SETFUNCTYPE_SYSTEMV = 8;
+ SETFUNCTYPE_NORMALD0D1SR = 9;
+ SETFUNCTYPE_NORMALD0D1A0A1SR = 10;
+
+
+ { * CreateLibrary extensions
+ * }
+ LIBTAG_BASE = (TAG_USER + $01000100);
+
+ { *
+ * Function/Vector Array
+ * }
+ LIBTAG_FUNCTIONINIT = (LIBTAG_BASE+$0);
+ { *
+ * Struct Init
+ * }
+ LIBTAG_STRUCTINIT = (LIBTAG_BASE+$1);
+ { *
+ * Library Init
+ * }
+ LIBTAG_LIBRARYINIT = (LIBTAG_BASE+$2);
+ { *
+ * Init Code Type
+ * }
+ LIBTAG_MACHINE = (LIBTAG_BASE+$3);
+ { *
+ * Library Base Size
+ * }
+ LIBTAG_BASESIZE = (LIBTAG_BASE+$4);
+ { *
+ * SegList Ptr
+ * }
+ LIBTAG_SEGLIST = (LIBTAG_BASE+$5);
+ { *
+ * Library Priority
+ * }
+ LIBTAG_PRI = (LIBTAG_BASE+$6);
+ { *
+ * Library Type..Library,Device,Resource,whatever
+ * }
+ LIBTAG_TYPE = (LIBTAG_BASE+$7);
+ { *
+ * Library Version
+ * (UWORD)
+ * }
+ LIBTAG_VERSION = (LIBTAG_BASE+$8);
+ { *
+ * Library Flags
+ * }
+ LIBTAG_FLAGS = (LIBTAG_BASE+$9);
+ { *
+ * Library Name
+ * }
+ LIBTAG_NAME = (LIBTAG_BASE+$a);
+ { *
+ * Library IDString
+ * }
+ LIBTAG_IDSTRING = (LIBTAG_BASE+$b);
+ { *
+ * AddDevice(),AddLibrary(),AddResource()..
+ * depends on LibNode.ln_Type field which
+ * can be set by some Init function, Struct Scripts
+ * or LIBTAG_TYPE.
+ * If you set LIBTAG_PUBLIC the library
+ * is added to the right system list.
+ * }
+ LIBTAG_PUBLIC = (LIBTAG_BASE+$c);
+ { *
+ * Library Revision
+ * (UWORD)
+ * }
+ LIBTAG_REVISION = (LIBTAG_BASE+$d);
+ { *
+ * Library QueryInfo Flag
+ * (Boolean)
+ * }
+ LIBTAG_QUERYINFO = (LIBTAG_BASE+$e);
+
+
+ { * Private
+ * don`t touch...floating design
+ * }
+type
+ PFuncEntry = ^TFuncEntry;
+ TFuncEntry = packed record
+ EmulLibEntry : TEmulLibEntry;
+ OldFunction : Pointer; { * Needed for bookkeeping * }
+ end;
+
+ PFuncOldEntry = ^TFuncOldEntry;
+ TFuncOldEntry = packed record
+ Command : Word;
+ FuncEntry: PFuncEntry;
+ end;
+
+
+ { *
+ * EmulLibEntry.Extension
+ * }
+const
+ FUNCENTRYEXTF_LIBRARY = $1; { * Entry created by the OS * }
+
+ { *
+ * Functionarray first ULONG ID defines the format
+ * of the functionarray for MakeFunctions()/MakeLibrary().
+ *
+ * If there`s not such id the functionarray is a
+ * 32Bit 68k function ptr array.
+ * (ULONG) $ffffffff stops it
+ * }
+
+ { * 68k 16bit relative functionarray ptrs
+ * (UWORD) $ffff stops it
+ * }
+
+ FUNCARRAY_16BIT_OLD = $ffffffff;
+
+ { * PPC 32bit functionarray ptrs
+ * (ULONG) $ffff stops it
+ * }
+ FUNCARRAY_32BIT_NATIVE = $fffefffe;
+
+ { * Starts a functionarray block.
+ * This way it`s possible to mix 68k and PPC
+ * function definitions.
+ * BASE:
+ * FUNCTIONARRAY_BEGIN
+ * FUNCARRAY_32BIT_NATIVE
+ * FUNC0
+ * FUNC1
+ * .
+ * FUNCn
+ * $ffffffff
+ * FUNCn+1 (No ID->32Bit 68k)
+ * FUNCn+2
+ * .
+ * FUNCm
+ * $ffffffff
+ * FUNCARRAY_16BIT_OLD
+ * FUNCm+1-BASE
+ * FUNCm+2-BASE
+ * .
+ * FUNCo-BASE
+ * $ffff
+ * FUNCTIONARRAY_END
+ * }
+
+ FUNCARRAY_BEGIN = $fffdfffd;
+
+ { * Ends a functionarray block.
+ * }
+ FUNCARRAY_END = $fffcfffc;
+
+ { * PPC 32bit Quick functionarray ptrs.
+ * These functions must comply to the emulation's
+ * register layout which is defined inside the
+ * emul/emulregs.h. That means the register layout
+ * MUST also be valid during interrupts/task switches.
+ * You can't just destroy A7(r31), SR or PC.
+ *
+ * You shouldn't use this for any normal code
+ * as there's no real reason to do so. If you
+ * really think you need to use it please ask
+ * us first on the dev mailinglist.
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_QUICK_NATIVE = $fffbfffb;
+
+ { * PPC 32bit QuickNR(No Result) functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_QUICKNR_NATIVE = $fffafffa;
+
+ { * PPC 32bit no result functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_NR_NATIVE = $fff9fff9;
+
+ { * PPC 32bit SR functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_SR_NATIVE = $fff8fff8;
+
+ { * PPC 32bit SR(no result) functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_SRNR_NATIVE = $fff7fff7;
+
+ { * PPC 32bit D0_D1 functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_D0D1_NATIVE = $fff6fff6;
+
+ { * PPC 32bit Restore1 functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_RESTORE_NATIVE = $fff5fff5;
+
+ { * PPC 32bit SystemV ABI entry
+ * these function entries DON'T comply
+ * to the amiga register modell REG_D0-A6
+ * but comply to the PPC SystemV ABI so
+ * you can directly use PPC C Argument
+ * parsing. That way you're also not limited
+ * with the register count.
+ * Such library functions can't be used
+ * by 68k emulation, so you can only use
+ * them for new code.
+ * As we allow these new functions to be
+ * used with old functions we keep the
+ * 6 bytes function entry steps in the library.
+ * Layout is
+ *
+ * CODE_JMP, &FuncEntry ; Old Entry
+ * CODE_ILLEGAL, Function ; SystemV ABI Entry
+ *
+ *
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_SYSTEMV = $fff4fff4;
+
+ { * PPC 32bit D0D1SR functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_D0D1SR_NATIVE = $fff3fff3;
+
+ { * PPC 32bit D0D1A0A1SR functionarray ptrs
+ * (ULONG) $ffffffff stops it
+ * }
+ FUNCARRAY_32BIT_D0D1A0A1SR_NATIVE = $fff2fff2;
+
+
+
+{ * exec device definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PDevice = ^TDevice;
+ TDevice = packed record
+ dd_Library: TLibrary;
+ end;
+
+type
+ PUnit = ^TUnit;
+ TUnit = packed record
+ unit_MsgPort: TMsgPort;
+ unit_flags : Byte;
+ unit_pad : Byte;
+ unit_OpenCnt: Word;
+ end;
+
+
+const
+ UNITF_ACTIVE = (1 Shl 0);
+ UNITF_INTASK = (1 Shl 1);
+
+
+
+{ * exec io definitions (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PIORequest = ^TIORequest;
+ TIORequest = packed record
+ io_Message: TMessage;
+ io_Device : PDevice;
+ io_Unit : PUnit;
+ io_Command: Word;
+ io_Flags : Byte;
+ io_Error : ShortInt;
+ end;
+
+type
+ PIOStdReq = ^TIOStdReq;
+ TIOStdReq = packed record
+ io_Message: TMessage;
+ io_Device : PDevice;
+ io_Unit : PUnit;
+ io_Command: Word;
+ io_Flags : Byte;
+ io_Error : ShortInt;
+ io_Actual : DWord;
+ io_Length : DWord;
+ io_Data : Pointer;
+ io_Offset : DWord;
+ end;
+
+
+const
+ DEV_BEGINIO = -30;
+ DEV_ABORTIO = -36;
+
+ IOB_QUICK = 0;
+ IOF_QUICK = (1 Shl IOB_QUICK);
+
+ CMD_INVALID = 0;
+ CMD_RESET = 1;
+ CMD_READ = 2;
+ CMD_WRITE = 3;
+ CMD_UPDATE = 4;
+ CMD_CLEAR = 5;
+ CMD_STOP = 6;
+ CMD_START = 7;
+ CMD_FLUSH = 8;
+ CMD_NONSTD = 9;
+
+
+
+{ * exec include (V50)
+ *********************************************************************
+ * }
+
+
+type
+ PExecBase = ^TExecBase;
+ TExecBase = packed record
+ LIbNode : TLibrary;
+ SoftVer : Word;
+ LowMemChkSum: SmallInt;
+ ChkBase : DWord;
+ ColdCapture : Pointer;
+ CoolCapture : Pointer;
+ WarmCapture : Pointer;
+ SysStkUpper : Pointer;
+ SysStkLower : Pointer;
+ MaxLocMem : DWord;
+ DebugEntry : Pointer;
+ DebugData : Pointer;
+ AlertData : Pointer;
+ MaxExtMem : Pointer;
+ ChkSum : Word;
+ IntVects : Array[0..15] Of TIntVector;
+ ThisTask : PTask;
+ IdleCount : DWord;
+ DispCount : DWord;
+ Quantum : Word;
+ Elapsed : Word;
+ SysFlags : Word;
+ IDNestCnt : ShortInt;
+ TDNestCnt : ShortInt;
+ AttnFlags : Word;
+ AttnResched : Word;
+ ResModules : Pointer;
+
+ TaskTrapCode : Pointer;
+ TaskExceptCode: Pointer;
+ TaskExitCode : Pointer;
+ TaskSigAlloc : DWord;
+ TaskTrapAlloc : Word;
+
+ MemList : TList;
+ ResourceList: TList;
+ DeviceList : TList;
+ IntrList : TList;
+ LibList : TList;
+ PortList : TList;
+ TaskReady : TList;
+ TaskWait : TList;
+ SoftInts : Array[0..5] Of TSoftIntList;
+ LastAlert : Array[0..3] Of LongInt;
+
+ VBlankFrequency : Byte;
+ PowerSupplyFrequency: Byte;
+ SemaphoreList : TList;
+ KickMemPtr : Pointer;
+ KickTagPtr : Pointer;
+ KickCheckSum : Pointer;
+ ex_Pad0 : Word;
+ ex_LaunchPoint : DWord;
+ ex_RamLibPrivate : Pointer;
+ ex_EClockFrequency : DWord;
+ ex_CacheControl : DWord;
+ ex_TaskID : DWord;
+
+ { * New ABox Emulation Entries
+ * }
+ ex_EmulHandleSize : DWord; { * PPC EmulHandleSize..*private* * }
+ ex_PPCTrapMsgPort : PMsgPort; { * PPC ABox Exception MsgPort..*private* * }
+ ex_Reserved1 : Array[0..2] Of DWord;
+ ex_MMULock : Pointer;
+ ex_PatchPool : Pointer; { * PatchPool Ptr needed by SetFunction..*private* * }
+ ex_PPCTaskExitCode : Pointer; { * PPC Task exit function * }
+ ex_DebugFlags : DWord; { * Exec Debug Flags..*private* * }
+
+ ex_MemHandlers : TMinList;
+ ex_MemHandler : Pointer;
+ end;
+
+
+ { *
+ * Outdated 68k cpu informations
+ *
+ * }
+const
+ AFB_68010 = 0;
+ AFB_68020 = 1;
+ AFB_68030 = 2;
+ AFB_68040 = 3;
+ AFB_68881 = 4;
+ AFB_68882 = 5;
+ AFB_FPU40 = 6;
+ AFB_68060 = 7;
+ AFB_PRIVATE = 15;
+
+ AFF_68010 = (1 Shl AFB_68010);
+ AFF_68020 = (1 Shl AFB_68020);
+ AFF_68030 = (1 Shl AFB_68030);
+ AFF_68040 = (1 Shl AFB_68040);
+ AFF_68881 = (1 Shl AFB_68881);
+ AFF_68882 = (1 Shl AFB_68882);
+ AFF_FPU40 = (1 Shl AFB_FPU40);
+ AFF_68060 = (1 Shl AFB_68060);
+ AFF_PRIVATE = (1 Shl AFB_PRIVATE);
+
+ { *
+ * Outdated 68k cache functionality
+ * Mostly without function.
+ * }
+const
+ CACRF_EnableI = (1 Shl 0);
+ CACRF_FreezeI = (1 Shl 1);
+ CACRF_ClearI = (1 Shl 3);
+ CACRF_IBE = (1 Shl 4);
+ CACRF_EnableD = (1 Shl 8);
+ CACRF_FreezeD = (1 Shl 9);
+ CACRF_ClearD = (1 Shl 11);
+ CACRF_DBE = (1 Shl 12);
+ CACRF_WriteAllocate = (1 Shl 13);
+ CACRF_EnableE = (1 Shl 30);
+ CACRF_CopyBack = (1 Shl 31);
+
+ DMA_Continue = (1 Shl 1);
+ DMA_NoModify = (1 Shl 2);
+ DMA_ReadFromRAM = (1 Shl 3);
+
+ SB_SAR = 15;
+ SB_TQE = 14;
+ SB_SINT = 13;
+
+ SF_SAR = (1 Shl SB_SAR);
+ SF_TQE = (1 Shl SB_TQE);
+ SF_SINT = (1 Shl SB_SINT);
+
+
+ { ****** Debug Flags...(don`t depend on them) ********** }
+const
+ EXECDEBUGF_INITRESIDENT = $1;
+ EXECDEBUGF_INITCODE = $2;
+ EXECDEBUGF_FINDRESIDENT = $4;
+
+ EXECDEBUGF_CREATELIBRARY = $10;
+ EXECDEBUGF_SETFUNCTION = $20;
+ EXECDEBUGF_NEWSETFUNCTION = $40;
+ EXECDEBUGF_CHIPRAM = $80;
+
+ EXECDEBUGF_ADDTASK = $100;
+ EXECDEBUGF_REMTASK = $200;
+ EXECDEBUGF_GETTASKATTR = $400;
+ EXECDEBUGF_SETTASKATTR = $800;
+
+ EXECDEBUGF_EXCEPTHANDLER = $1000;
+ EXECDEBUGF_ADDDOSNODE = $2000;
+ EXECDEBUGF_PCI = $4000;
+ EXECDEBUGF_RAMLIB = $8000;
+
+ EXECDEBUGF_NOLOGSERVER = $10000;
+ EXECDEBUGF_NOLOGWINDOW = $20000;
+
+ { *
+ * "env:MorphOS/LogPath" contains the logfile path,
+ * If not specified it`s using "ram:.morphoslog"
+ * }
+ EXECDEBUGF_LOGFILE = $40000;
+ EXECDEBUGF_LOGKPRINTF = $80000;
+
+ { * Memory Tracking Flags
+ * }
+ EXECDEBUGF_PERMMEMTRACK = $100000;
+ EXECDEBUGF_MEMTRACK = $200000;
+
+ { * CyberGuardPPC Flags
+ * }
+ EXECDEBUGF_CYBERGUARDDEADLY = $400000;
+
+ { * PPCLib Flags
+ * }
+ EXECDEBUGF_LOADSEG = $01000000;
+ EXECDEBUGF_UNLOADSEG = $02000000;
+ EXECDEBUGF_PPCSTART = $04000000;
+
+ { * UserFlags
+ * }
+
+ { *
+ * Enables debug output for cybergraphx
+ * }
+const
+ EXECDEBUGF_CGXDEBUG = $08000000;
+
+ { *
+ * Should be used to control user LibInit/DevInit Debug output
+ * }
+ EXECDEBUGF_INIT = $40000000;
+
+ { *
+ * Should be used to control logging
+ * }
+ EXECDEBUGF_LOG = $80000000;
+
+ { *
+ * Execbase list IDs
+ * }
+ EXECLIST_DEVICE = 0;
+ EXECLIST_INTERRUPT = 1;
+ EXECLIST_LIBRARY = 2;
+ EXECLIST_MEMHANDLER = 3;
+ EXECLIST_MEMHEADER = 4;
+ EXECLIST_PORT = 5;
+ EXECLIST_RESOURCE = 6;
+ EXECLIST_SEMAPHORE = 7;
+ EXECLIST_TASK = 8;
+
+
+ { *
+ * Execnotify hook message
+ * }
+type
+ PExecNotifyMessage = ^TExecNotifyMessage;
+ TExecNotifyMessage = packed record
+ MType : DWord;
+ Flags : DWord;
+ Extra : DWord;
+ Extension: Pointer;
+ end;
+
+
+const
+ EXECNOTIFYF_REMOVE = (1 Shl 0); { * if clear, is ADD * }
+ EXECNOTIFYF_POST = (1 Shl 1); { * if clear, is PRE * }
+
+
+ { *
+ * AddExecNodeTagList tags
+ * }
+const
+ SAL_Dummy = (TAG_USER + 1000);
+ SAL_Type = (SAL_Dummy + 1);
+ SAL_Priority = (SAL_Dummy + 2);
+ SAL_Name = (SAL_Dummy + 3);
+
+
+{$include utild2.inc}
+
+
+{
+ $Log: execd.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.3 2005/01/12 07:59:05 karoly
+ * Integers changed to SmallInt to be compatible with all modes
+
+}
diff --git a/rtl/morphos/execf.inc b/rtl/morphos/execf.inc
new file mode 100644
index 0000000000..33664d6390
--- /dev/null
+++ b/rtl/morphos/execf.inc
@@ -0,0 +1,598 @@
+{
+ $Id: execf.inc,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ exec functions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function Supervisor(userFunction: Pointer location 'a5'): Cardinal;
+SysCall MOS_ExecBase 030;
+
+procedure InitCode(startClass: Cardinal location 'd0';
+ version : Cardinal location 'd1');
+SysCall MOS_ExecBase 072;
+
+procedure InitStruct(initTable: Pointer location 'a1';
+ memory : Pointer location 'a2';
+ size : Cardinal location 'd0');
+SysCall MOS_ExecBase 078;
+
+function MakeLibrary(funcInit : Pointer location 'a0';
+ structInit: Pointer location 'a1';
+ libInit : Pointer location 'a2';
+ dataSize : Cardinal location 'd0';
+ segList : Cardinal location 'd1'): PLibrary;
+SysCall MOS_ExecBase 084;
+
+procedure MakeFunctions(target : Pointer location 'a0';
+ functionArray: Pointer location 'a1';
+ funcDispBase : Pointer location 'a2');
+SysCall MOS_ExecBase 090;
+
+function FindResident(name: PChar location 'a1'): PResident;
+SysCall MOS_ExecBase 096;
+
+function InitResident(resident: PResident location 'a1';
+ segList : Cardinal location 'd1'): Pointer;
+SysCall MOS_ExecBase 102;
+
+procedure Alert(alertNum: Cardinal location 'd7');
+SysCall MOS_ExecBase 108;
+
+procedure Debug(flags: Cardinal location 'd0');
+SysCall MOS_ExecBase 114;
+
+procedure Disable;
+SysCall MOS_ExecBase 120;
+
+procedure Enable;
+SysCall MOS_ExecBase 126;
+
+procedure Forbid;
+SysCall MOS_ExecBase 132;
+
+procedure Permit;
+SysCall MOS_ExecBase 138;
+
+function SetSR(newSR: Cardinal location 'd0';
+ mask : Cardinal location 'd1'): Cardinal;
+SysCall MOS_ExecBase 144;
+
+function SuperState : Pointer;
+SysCall MOS_ExecBase 150;
+
+procedure UserState(sysStack: Pointer location 'd0');
+SysCall MOS_ExecBase 156;
+
+function SetIntVector(intNumber: LongInt location 'd0';
+ interrupt: PInterrupt location 'a1'): PInterrupt;
+SysCall MOS_ExecBase 162;
+
+procedure AddIntServer(intNumber: LongInt location 'd0';
+ interrupt: PInterrupt location 'a1');
+SysCall MOS_ExecBase 168;
+
+procedure RemIntServer(intNumber: LongInt location 'd0';
+ interrupt: PInterrupt location 'a1');
+SysCall MOS_ExecBase 174;
+
+procedure Cause(interrupt: PInterrupt location 'a1');
+SysCall MOS_ExecBase 180;
+
+function Allocate(freeList: PMemHeader location 'a0';
+ byteSize: Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 186;
+
+procedure Deallocate(freeList : PMemHeader location 'a0';
+ memoryBlock: Pointer location 'a1';
+ byteSize : Cardinal location 'd0');
+SysCall MOS_ExecBase 192;
+
+{ * Name changed to avoid conflict with heap manager... * }
+function execAllocMem(byteSize : Cardinal location 'd0';
+ requirements: Cardinal location 'd1'): Pointer;
+SysCall MOS_ExecBase 198;
+
+function AllocAbs(byteSize: Cardinal location 'd0';
+ location: Pointer location 'a1'): Pointer;
+SysCall MOS_ExecBase 204;
+
+{ * Name changed to avoid conflict with heap manager... * }
+procedure execFreeMem(memoryBlock: Pointer location 'a1';
+ byteSize : Cardinal location 'd0');
+SysCall MOS_ExecBase 210;
+
+function AvailMem(requirements: Cardinal location 'd1'): Cardinal;
+SysCall MOS_ExecBase 216;
+
+function AllocEntry(entry: PMemList location 'a0'): PMemList;
+SysCall MOS_ExecBase 222;
+
+procedure FreeEntry(entry: PMemList location 'a0');
+SysCall MOS_ExecBase 228;
+
+{ * Name changed to avoid conflict with other System unit call... * }
+procedure execInsert(list: PList location 'a0';
+ node: PNode location 'a1';
+ pred: PNode location 'a2');
+SysCall MOS_ExecBase 234;
+
+procedure AddHead(list: PList location 'a0';
+ node: PNode location 'a1');
+SysCall MOS_ExecBase 240;
+
+procedure AddTail(list: PList location 'a0';
+ node: PNode location 'a1');
+SysCall MOS_ExecBase 246;
+
+procedure Remove(node: PNode location 'a1');
+SysCall MOS_ExecBase 252;
+
+function RemHead(list: PList location 'a0'): PNode;
+SysCall MOS_ExecBase 258;
+
+function RemTail(list: PList location 'a0'): PNode;
+SysCall MOS_ExecBase 264;
+
+procedure Enqueue(list: PList location 'a0';
+ node: PNode location 'a1');
+SysCall MOS_ExecBase 270;
+
+function FindName(list: PList location 'a0';
+ name: PChar location 'a1'): PNode;
+SysCall MOS_ExecBase 276;
+
+function AddTask(task : PTask location 'a1';
+ initPC : Pointer location 'a2';
+ finalPC: Pointer location 'a3'): Pointer;
+SysCall MOS_ExecBase 282;
+
+procedure RemTask(task: PTask location 'a1');
+SysCall MOS_ExecBase 288;
+
+function FindTask(name: PChar location 'a1'): PTask;
+SysCall MOS_ExecBase 294;
+
+function SetTaskPri(task : PTask location 'a1';
+ priority: LongInt location 'd0'): ShortInt;
+SysCall MOS_ExecBase 300;
+
+function SetSignal(newSignals: Cardinal location 'd0';
+ signalSet : Cardinal location 'd1'): Cardinal;
+SysCall MOS_ExecBase 306;
+
+function SetExcept(newSignals: Cardinal location 'd0';
+ signalSet : Cardinal location 'd1'): Cardinal;
+SysCall MOS_ExecBase 312;
+
+function Wait(signalSet: Cardinal location 'd0'): Cardinal;
+SysCall MOS_ExecBase 318;
+
+procedure Signal(task : PTask location 'a1';
+ signalSet: Cardinal location 'd0');
+SysCall MOS_ExecBase 324;
+
+function AllocSignal(signalNum: LongInt location 'd0'): ShortInt;
+SysCall MOS_ExecBase 330;
+
+procedure FreeSignal(signalNum: LongInt location 'd0');
+SysCall MOS_ExecBase 336;
+
+function AllocTrap(trapNum: LongInt location 'd0'): LongInt;
+SysCall MOS_ExecBase 342;
+
+procedure FreeTrap(trapNum: LongInt location 'd0');
+SysCall MOS_ExecBase 348;
+
+procedure AddPort(port: PMsgPort location 'a1');
+SysCall MOS_ExecBase 354;
+
+procedure RemPort(port: PMsgPort location 'a1');
+SysCall MOS_ExecBase 360;
+
+procedure PutMsg(port : PMsgPort location 'a0';
+ message: PMessage location 'a1');
+SysCall MOS_ExecBase 366;
+
+function GetMsg(port: PMsgPort location 'a0'): PMessage;
+SysCall MOS_ExecBase 372;
+
+procedure ReplyMsg(message : PMessage location 'a1');
+SysCall MOS_ExecBase 378;
+
+function WaitPort(port: PMsgPort location 'a0'): PMessage;
+SysCall MOS_ExecBase 384;
+
+function FindPort(name: PChar location 'a1'): PMsgPort;
+SysCall MOS_ExecBase 390;
+
+procedure AddLibrary(libHandle: PLibrary location 'a1');
+SysCall MOS_ExecBase 396;
+
+procedure RemLibrary(libHandle: PLibrary location 'a1');
+SysCall MOS_ExecBase 402;
+
+function OldOpenLibrary(libName: PChar location 'a1'): PLibrary;
+SysCall MOS_ExecBase 408;
+
+procedure CloseLibrary(libHandle: PLibrary location 'a1');
+SysCall MOS_ExecBase 414;
+
+function SetFunction(libHandle : PLibrary location 'a1';
+ funcOffset : LongInt location 'a0';
+ newFunction: Pointer location 'd0'): Pointer;
+SysCall MOS_ExecBase 420;
+
+procedure SumLibrary(libHandle: PLibrary location 'a1');
+SysCall MOS_ExecBase 426;
+
+procedure AddDevice(device: PDevice location 'a1');
+SysCall MOS_ExecBase 432;
+
+procedure RemDevice(device: PDevice location 'a1');
+SysCall MOS_ExecBase 438;
+
+function OpenDevice(devName : PChar location 'a0';
+ numunit : Cardinal location 'd0';
+ ioRequest: pIORequest location 'a1';
+ flags : Cardinal location 'd1'): ShortInt;
+SysCall MOS_ExecBase 444;
+
+procedure CloseDevice(ioRequest: PIORequest location 'a1');
+SysCall MOS_ExecBase 450;
+
+function DoIO(ioRequest: PIORequest location 'a1'): ShortInt;
+SysCall MOS_ExecBase 456;
+
+procedure SendIO(ioRequest: PIORequest location 'a1');
+SysCall MOS_ExecBase 462;
+
+function CheckIO(ioRequest: PIORequest location 'a1'): PIORequest;
+SysCall MOS_ExecBase 468;
+
+function WaitIO(ioRequest: PIORequest location 'a1'): ShortInt;
+SysCall MOS_ExecBase 474;
+
+procedure AbortIO(ioRequest: PIORequest location 'a1');
+SysCall MOS_ExecBase 480;
+
+procedure AddResource(resource: Pointer location 'a1');
+SysCall MOS_ExecBase 486;
+
+procedure RemResource(resource: Pointer location 'a1');
+SysCall MOS_ExecBase 492;
+
+function OpenResource(resName: PChar location 'a1'): Pointer;
+SysCall MOS_ExecBase 498;
+
+procedure RawIOInit;
+SysCall MOS_ExecBase 504;
+
+function RawMayGetChar: Char;
+SysCall MOS_ExecBase 510;
+
+procedure RawPutChar(d0arg: Char location 'd0');
+SysCall MOS_ExecBase 516;
+
+function RawDoFmt(formatString: PChar location 'a0';
+ dataStream : Pointer location 'a1';
+ putChProc : Pointer location 'a2';
+ putChData : Pointer location 'a3'): Pointer;
+SysCall MOS_ExecBase 522;
+
+function GetCC: Cardinal;
+SysCall MOS_ExecBase 528;
+
+function TypeOfMem(address: Pointer location 'a1'): Cardinal;
+SysCall MOS_ExecBase 534;
+
+function Procure(sigSem: PSignalSemaphore location 'a0';
+ bidMsg: PSemaphoreMessage location 'a1'): Cardinal;
+SysCall MOS_ExecBase 540;
+
+procedure Vacate(sigSem: PSignalSemaphore location 'a0';
+ bidMsg: PSemaphoreMessage location 'a1');
+SysCall MOS_ExecBase 546;
+
+function OpenLibrary(libname: PChar location 'a1';
+ libver : Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 552;
+
+procedure InitSemaphore(sigSem: PSignalSemaphore location 'a0');
+SysCall MOS_ExecBase 558;
+
+procedure ObtainSemaphore(sigSem: PSignalSemaphore location 'a0');
+SysCall MOS_ExecBase 564;
+
+procedure ReleaseSemaphore(sigSem: PSignalSemaphore location 'a0');
+SysCall MOS_ExecBase 570;
+
+function AttemptSemaphore(sigSem: PSignalSemaphore location 'a0'): Cardinal;
+SysCall MOS_ExecBase 576;
+
+procedure ObtainSemaphoreList(sigSem: PList location 'a0');
+SysCall MOS_ExecBase 582;
+
+procedure ReleaseSemaphoreList(sigSem: PList location 'a0');
+SysCall MOS_ExecBase 588;
+
+function FindSemaphore(sigSem: PChar location 'a1'): PSignalSemaphore;
+SysCall MOS_ExecBase 594;
+
+procedure AddSemaphore(sigSem: PSignalSemaphore location 'a1');
+SysCall MOS_ExecBase 600;
+
+procedure RemSemaphore(sigSem: PSignalSemaphore location 'a1');
+SysCall MOS_ExecBase 606;
+
+function SumKickData: Cardinal;
+SysCall MOS_ExecBase 612;
+
+procedure AddMemList(size : Cardinal location 'd0';
+ attributes: Cardinal location 'd1';
+ pri : LongInt location 'd2';
+ base : Pointer location 'a0';
+ name : PChar location 'a1');
+SysCall MOS_ExecBase 618;
+
+procedure CopyMem(source: Pointer location 'a0';
+ dest : Pointer location 'a1';
+ size : Cardinal location 'd0');
+SysCall MOS_ExecBase 624;
+
+procedure CopyMemQuick(source: Pointer location 'a0';
+ dest : Pointer location 'a1';
+ size : Cardinal location 'd0');
+SysCall MOS_ExecBase 630;
+
+procedure CacheClearU;
+SysCall MOS_ExecBase 636;
+
+procedure CacheClearE(address: Pointer location 'a0';
+ length : Cardinal location 'd0';
+ caches : Cardinal location 'd1');
+SysCall MOS_ExecBase 642;
+
+function CacheControl(cacheBits: Cardinal location 'd0';
+ cacheMask: Cardinal location 'd1'): Cardinal;
+SysCall MOS_ExecBase 648;
+
+function CreateIORequest(port: PMsgPort location 'a0';
+ size: Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 654;
+
+procedure DeleteIORequest(iorequest: Pointer location 'a0');
+SysCall MOS_ExecBase 660;
+
+function CreateMsgPort: PMsgPort;
+SysCall MOS_ExecBase 666;
+
+procedure DeleteMsgPort(port: PMsgPort location 'a0');
+SysCall MOS_ExecBase 672;
+
+procedure ObtainSemaphoreShared(sigSem: PSignalSemaphore location 'a0');
+SysCall MOS_ExecBase 678;
+
+function AllocVec(byteSize : Cardinal location 'd0';
+ requirements: Cardinal location 'd1'): Pointer;
+SysCall MOS_ExecBase 684;
+
+procedure FreeVec(memoryBlock: Pointer location 'a1');
+SysCall MOS_ExecBase 690;
+
+function CreatePool(requirements: Cardinal location 'd0';
+ puddleSize : Cardinal location 'd1';
+ threshSize : Cardinal location 'd2'): Pointer;
+SysCall MOS_ExecBase 696;
+
+procedure DeletePool(poolHeader: Pointer location 'a0');
+SysCall MOS_ExecBase 702;
+
+function AllocPooled(poolHeader: Pointer location 'a0';
+ memSize : Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 708;
+
+function FreePooled(poolHeader: Pointer location 'a0';
+ memory : Pointer location 'a1';
+ memSize : Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 714;
+
+function AttemptSemaphoreShared(sigSem: pSignalSemaphore location 'a0'): Cardinal;
+SysCall MOS_ExecBase 720;
+
+procedure ColdReboot;
+SysCall MOS_ExecBase 726;
+
+procedure StackSwap(newStack: PStackSwapStruct location 'a0');
+SysCall MOS_ExecBase 732;
+
+function NewGetTaskAttrsA(Task : PTask location 'a0';
+ Data : Pointer location 'a1';
+ DataSize: Cardinal location 'd0';
+ TType : Cardinal location 'd1';
+ Tags : PTagItem location 'a2'): Cardinal;
+SysCall MOS_ExecBase 738;
+
+function NewSetTaskAttrsA(Task : PTask location 'a0';
+ Data : Pointer location 'a1';
+ DataSize: Cardinal location 'd0';
+ TType : Cardinal location 'd1';
+ Tags : PTagItem location 'a2'): Cardinal;
+SysCall MOS_ExecBase 744;
+
+function CachePreDMA(address : Pointer location 'a0';
+ var length: Cardinal location 'a1';
+ flags : Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 762;
+
+procedure CachePostDMA(address : Pointer location 'a0';
+ var length: Cardinal location 'a1';
+ flags : Cardinal location 'd0');
+SysCall MOS_ExecBase 768;
+
+procedure AddMemHandler(memhand: PInterrupt location 'a1');
+SysCall MOS_ExecBase 774;
+
+procedure RemMemHandler(memhand: PInterrupt location 'a1');
+SysCall MOS_ExecBase 780;
+
+function ObtainQuickVector(interruptCode: Pointer location 'a0'): Cardinal;
+SysCall MOS_ExecBase 786;
+
+function NewSetFunction(libHandle : PLibrary location 'a0';
+ newfunction: Pointer location 'a1';
+ offset : LongInt location 'd0';
+ tags : PTagItem location 'a2'): Pointer;
+SysCall MOS_ExecBase 792;
+
+function NewCreateLibrary(tags: PTagItem location 'a0'): PLibrary;
+SysCall MOS_ExecBase 798;
+
+function NewPPCStackSwap(newStack : PStackSwapStruct location 'a0';
+ sfunction: Pointer location 'a1';
+ args : PPPCStackSwapArgs location 'a2'): Cardinal;
+SysCall MOS_ExecBase 804;
+
+function TaggedOpenLibrary(d0arg: LongInt location 'd0'): Pointer;
+SysCall MOS_ExecBase 810;
+
+function ReadGayle: Cardinal;
+SysCall MOS_ExecBase 816;
+
+function VNewRawDoFmt(FmtString: PChar;
+ PutChProc: Pointer;
+ PutChData: PChar;
+ args : PChar): PChar;
+SysCall BaseSysV MOS_ExecBase 822;
+
+procedure CacheFlushDataArea(Address: Pointer location 'a0';
+ Size : Cardinal location 'd0');
+SysCall MOS_ExecBase 828;
+
+procedure CacheInvalidInstArea(Address: Pointer location 'a0';
+ Size : Cardinal location 'd0');
+SysCall MOS_ExecBase 834;
+
+procedure CacheInvalidDataArea(Address: Pointer location 'a0';
+ Size : Cardinal location 'd0');
+SysCall MOS_ExecBase 840;
+
+procedure CacheFlushDataInstArea(Address: Pointer location 'a0';
+ Size : Cardinal location 'd0');
+SysCall MOS_ExecBase 846;
+
+procedure CacheTrashCacheArea(Address: Pointer location 'a0';
+ Size : Cardinal location 'd0');
+SysCall MOS_ExecBase 852;
+
+function AllocTaskPooled(Size: Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 858;
+
+procedure FreeTaskPooled(Address: Pointer location 'a1';
+ Size : Cardinal location 'd0');
+SysCall MOS_ExecBase 864;
+
+function AllocVecTaskPooled(Size: Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 870;
+
+procedure FreeVecTaskPooled(Address: Pointer location 'a1');
+SysCall MOS_ExecBase 876;
+
+procedure FlushPool(poolHeader: Pointer location 'a0');
+SysCall MOS_ExecBase 882;
+
+procedure FlushTaskPool;
+SysCall MOS_ExecBase 888;
+
+function AllocVecPooled(poolHeader: Pointer location 'a0';
+ memSize : Cardinal location 'd0'): Pointer;
+SysCall MOS_ExecBase 894;
+
+function NewGetSystemAttrsA(Data : Pointer location 'a0';
+ DataSize: Cardinal location 'd0';
+ TType : Cardinal location 'd1';
+ Tags : PTagItem location 'a1'): Cardinal;
+SysCall MOS_ExecBase 906;
+
+function NewSetSystemAttrsA(Data : Pointer location 'a0';
+ DataSize: Cardinal location 'd0';
+ TType : Cardinal location 'd1';
+ Tags : PTagItem location 'a1'): Cardinal;
+SysCall MOS_ExecBase 912;
+
+function NewCreateTaskA(Tags: PTagItem location 'a0'): PTask;
+SysCall MOS_ExecBase 918;
+
+function AllocateAligned(memHeader : pMemHeader;
+ byteSize : Cardinal;
+ alignSize : Cardinal;
+ alignOffset: Cardinal): Pointer;
+SysCall BaseSysV MOS_ExecBase 930;
+
+function AllocMemAligned(byteSize : Cardinal;
+ attributes : Cardinal;
+ alignSize : Cardinal;
+ alignOffset: Cardinal): Pointer;
+SysCall BaseSysV MOS_ExecBase 936;
+
+function AllocVecAligned(byteSize : Cardinal;
+ attributes : Cardinal;
+ alignSize : Cardinal;
+ alignOffset: Cardinal): Pointer;
+SysCall BaseSysV MOS_ExecBase 942;
+
+procedure AddExecNotify(hook: PHook);
+SysCall BaseSysV MOS_ExecBase 948;
+
+procedure RemExecNotify(hook: PHook);
+SysCall BaseSysV MOS_ExecBase 954;
+
+function FindExecNode(ttype: Cardinal location 'd0';
+ name : PChar location 'a0'): PNode;
+SysCall MOS_ExecBase 960;
+
+function AddExecNodeA(innode : Pointer location 'a0';
+ TagItems: PTagItem location 'a1'): Pointer;
+SysCall MOS_ExecBase 966;
+
+function AllocVecDMA(byteSize : Cardinal location 'd0';
+ requirements: Cardinal location 'd1'): Pointer;
+SysCall MOS_ExecBase 972;
+
+procedure FreeVecDMA(memoryBlock: Pointer location 'a1');
+SysCall MOS_ExecBase 978;
+
+function AllocPooledAligned(poolHeader : Pointer;
+ byteSize : Cardinal;
+ alignSize : Cardinal;
+ alignOffset: Cardinal): Pointer;
+SysCall BaseSysV MOS_ExecBase 984;
+
+function AddResident(resident: pResident location 'd0'): LongInt;
+SysCall BaseSysV MOS_ExecBase 990;
+
+function FindTaskByPID(processID: Cardinal): PTask;
+SysCall BaseSysV MOS_ExecBase 996;
+
+
+{
+ $Log: execf.inc,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.5 2005/01/30 03:02:36 karoly
+ * syscalls with basesysv abi fixed
+
+}
diff --git a/rtl/morphos/get9.pas b/rtl/morphos/get9.pas
new file mode 100644
index 0000000000..8d2244b900
--- /dev/null
+++ b/rtl/morphos/get9.pas
@@ -0,0 +1,77 @@
+{
+ $Id: get9.pas,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh
+
+ get9.library interface unit for MorphOS/PowerPC
+
+ Free Pascal MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit get9;
+
+interface
+
+uses exec;
+
+var
+ Get9Base: Pointer;
+
+const
+ GET9NAME : PChar = 'get9.library';
+
+procedure DNetCheck(force: boolean);
+SysCall BaseSysV Get9Base 28;
+
+function InitGet9Library : boolean;
+
+implementation
+
+var
+ Get9_exit : Pointer;
+
+const
+ LIBVERSION=1;
+
+procedure CloseGet9Library;
+begin
+ ExitProc := Get9_exit;
+ if Get9Base <> nil then begin
+ CloseLibrary(PLibrary(Get9Base));
+ Get9Base := nil;
+ end;
+end;
+
+function InitGet9Library : boolean;
+begin
+ Get9Base := nil;
+ Get9Base := OpenLibrary(GET9NAME,LIBVERSION);
+ if Get9Base <> nil then begin
+ Get9_exit := ExitProc;
+ ExitProc := @CloseGet9Library;
+ InitGet9Library:=True;
+ end else begin
+ InitGet9Library:=False;
+ end;
+end;
+
+begin
+end.
+
+{
+ $Log: get9.pas,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/01/06 08:28:41 karoly
+ * initial revision
+
+}
diff --git a/rtl/morphos/graphics.pas b/rtl/morphos/graphics.pas
new file mode 100644
index 0000000000..243fc9893c
--- /dev/null
+++ b/rtl/morphos/graphics.pas
@@ -0,0 +1,2844 @@
+{
+ $Id: graphics.pas,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ graphics.library interface unit for MorphOS/PowerPC
+
+ Based on work of Nils Sjoholm member of the Amiga RTL
+ development team.
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$PACKRECORDS 2}
+
+unit graphics;
+
+interface
+
+uses exec, hardware, utility;
+
+const
+ BITSET = $8000;
+ BITCLR = 0;
+
+type
+ pRectangle = ^tRectangle;
+ tRectangle = record
+ MinX,MinY : Word;
+ MaxX,MaxY : Word;
+ end;
+
+ pRect32 = ^tRect32;
+ tRect32 = record
+ MinX,MinY : Longint;
+ MaxX,MaxY : Longint;
+ end;
+
+ pPoint = ^tPoint;
+ tPoint = record
+ x,y : Word;
+ end;
+
+ PLANEPTR = Pointer;
+
+ pBitMap = ^tBitMap;
+ tBitMap = record
+ BytesPerRow : Word;
+ Rows : Word;
+ Flags : Byte;
+ Depth : Byte;
+ pad : Word;
+ Planes : Array [0..7] of PLANEPTR;
+ end;
+{* flags for AllocBitMap, etc. *}
+const
+ BMB_CLEAR = 0;
+ BMB_DISPLAYABLE = 1;
+ BMB_INTERLEAVED = 2;
+ BMB_STANDARD = 3;
+ BMB_MINPLANES = 4;
+
+ BMF_CLEAR = (1 shl BMB_CLEAR);
+ BMF_DISPLAYABLE = (1 shl BMB_DISPLAYABLE);
+ BMF_INTERLEAVED = (1 shl BMB_INTERLEAVED);
+ BMF_STANDARD = (1 shl BMB_STANDARD);
+ BMF_MINPLANES = (1 shl BMB_MINPLANES);
+
+{* the following are for GetBitMapAttr() *}
+ BMA_HEIGHT = 0;
+ BMA_DEPTH = 4;
+ BMA_WIDTH = 8;
+ BMA_FLAGS = 12;
+
+
+{ structures used by and constructed by windowlib.a }
+{ understood by rom software }
+type
+ pClipRect = ^tClipRect;
+ tClipRect = record
+ Next : pClipRect; { roms used to find next ClipRect }
+ prev : pClipRect; { ignored by roms, used by windowlib }
+ lobs : Pointer; { ignored by roms, used by windowlib (LayerPtr)}
+ BitMap : pBitMap;
+ bounds : tRectangle; { set up by windowlib, used by roms }
+ _p1,
+ _p2 : Pointer; { system reserved }
+ reserved : Longint; { system use }
+ Flags : Longint; { only exists in layer allocation }
+ end;
+
+ pLayer = ^tLayer;
+ tLayer = record
+ front,
+ back : pLayer; { ignored by roms }
+ ClipRect : pClipRect; { read by roms to find first cliprect }
+ rp : Pointer; { (RastPortPtr) ignored by roms, I hope }
+ bounds : tRectangle; { ignored by roms }
+ reserved : Array [0..3] of Byte;
+ priority : Word; { system use only }
+ Flags : Word; { obscured ?, Virtual BitMap? }
+ SuperBitMap : pBitMap;
+ SuperClipRect : pClipRect; { super bitmap cliprects if
+ VBitMap != 0}
+ { else damage cliprect list for refresh }
+ Window : Pointer; { reserved for user interface use }
+ Scroll_X,
+ Scroll_Y : Word;
+ cr,
+ cr2,
+ crnew : pClipRect; { used by dedice }
+ SuperSaveClipRects : pClipRect; { preallocated cr's }
+ cliprects : pClipRect; { system use during refresh }
+ LayerInfo : Pointer; { points to head of the list }
+ Lock : tSignalSemaphore;
+ BackFill : pHook;
+ reserved1 : Cardinal;
+ ClipRegion : Pointer;
+ saveClipRects : Pointer; { used to back out when in trouble}
+ Width,
+ Height : smallint;
+ reserved2 : Array [0..17] of Byte;
+ { this must stay here }
+ DamageList : Pointer; { list of rectangles to refresh
+ through }
+ end;
+
+const
+
+{ internal cliprect flags }
+
+ CR_NEEDS_NO_CONCEALED_RASTERS = 1;
+ CR_NEEDS_NO_LAYERBLIT_DAMAGE = 2;
+
+
+{ defines for code values for getcode }
+
+ ISLESSX = 1;
+ ISLESSY = 2;
+ ISGRTRX = 4;
+ ISGRTRY = 8;
+
+
+{------ Font Styles ------------------------------------------------}
+
+ FS_NORMAL = 0; { normal text (no style bits set) }
+ FSB_EXTENDED = 3; { extended face (wider than normal) }
+ FSF_EXTENDED = 8;
+ FSB_ITALIC = 2; { italic (slanted 1:2 right) }
+ FSF_ITALIC = 4;
+ FSB_BOLD = 1; { bold face text (ORed w/ shifted) }
+ FSF_BOLD = 2;
+ FSB_UNDERLINED = 0; { underlined (under baseline) }
+ FSF_UNDERLINED = 1;
+
+ FSB_COLORFONT = 6; { this uses ColorTextFont structure }
+ FSF_COLORFONT = $40;
+ FSB_TAGGED = 7; { the TextAttr is really an TTextAttr, }
+ FSF_TAGGED = $80;
+
+
+{------ Font Flags -------------------------------------------------}
+ FPB_ROMFONT = 0; { font is in rom }
+ FPF_ROMFONT = 1;
+ FPB_DISKFONT = 1; { font is from diskfont.library }
+ FPF_DISKFONT = 2;
+ FPB_REVPATH = 2; { designed path is reversed (e.g. left) }
+ FPF_REVPATH = 4;
+ FPB_TALLDOT = 3; { designed for hires non-interlaced }
+ FPF_TALLDOT = 8;
+ FPB_WIDEDOT = 4; { designed for lores interlaced }
+ FPF_WIDEDOT = 16;
+ FPB_PROPORTIONAL = 5; { character sizes can vary from nominal }
+ FPF_PROPORTIONAL = 32;
+ FPB_DESIGNED = 6; { size is "designed", not constructed }
+ FPF_DESIGNED = 64;
+ FPB_REMOVED = 7; { the font has been removed }
+ FPF_REMOVED = 128;
+
+{***** TextAttr node, matches text attributes in RastPort *********}
+
+type
+
+ pTextAttr = ^tTextAttr;
+ tTextAttr = record
+ ta_Name : PChar; { name of the font }
+ ta_YSize : Word; { height of the font }
+ ta_Style : Byte; { intrinsic font style }
+ ta_Flags : Byte; { font preferences and flags }
+ end;
+
+ pTTextAttr = ^tTTextAttr;
+ tTTextAttr = record
+ tta_Name : PChar; { name of the font }
+ tta_YSize : Word; { height of the font }
+ tta_Style : Byte; { intrinsic font style }
+ tta_Flags : Byte; { font preferences AND flags }
+ tta_Tags : pTagItem; { extended attributes }
+ end;
+
+{***** Text Tags **************************************************}
+CONST
+ TA_DeviceDPI = (1+TAG_USER); { Tag value is Point union: }
+ { Hi Longint XDPI, Lo Longint YDPI }
+
+ MAXFONTMATCHWEIGHT = 32767; { perfect match from WeighTAMatch }
+
+
+
+{***** TextFonts node *********************************************}
+Type
+
+ pTextFont = ^tTextFont;
+ tTextFont = record
+ tf_Message : tMessage; { reply message for font removal }
+ { font name in LN \ used in this }
+ tf_YSize : Word; { font height | order to best }
+ tf_Style : Byte; { font style | match a font }
+ tf_Flags : Byte; { preferences and flags / request. }
+ tf_XSize : Word; { nominal font width }
+ tf_Baseline : Word; { distance from the top of char to baseline }
+ tf_BoldSmear : Word; { smear to affect a bold enhancement }
+
+ tf_Accessors : Word; { access count }
+
+ tf_LoChar : Byte; { the first character described here }
+ tf_HiChar : Byte; { the last character described here }
+ tf_CharData : Pointer; { the bit character data }
+
+ tf_Modulo : Word; { the row modulo for the strike font data }
+ tf_CharLoc : Pointer; { ptr to location data for the strike font }
+ { 2 words: bit offset then size }
+ tf_CharSpace : Pointer; { ptr to words of proportional spacing data }
+ tf_CharKern : Pointer; { ptr to words of kerning data }
+ end;
+
+
+{----- tfe_Flags0 (partial definition) ----------------------------}
+CONST
+ TE0B_NOREMFONT = 0; { disallow RemFont for this font }
+ TE0F_NOREMFONT = $01;
+
+Type
+
+ pTextFontExtension = ^tTextFontExtension;
+ tTextFontExtension = record { this structure is read-only }
+ tfe_MatchWord : Word; { a magic cookie for the extension }
+ tfe_Flags0 : Byte; { (system private flags) }
+ tfe_Flags1 : Byte; { (system private flags) }
+ tfe_BackPtr : pTextFont; { validation of compilation }
+ tfe_OrigReplyPort : pMsgPort; { original value in tf_Extension }
+ tfe_Tags : pTagItem; { Text Tags for the font }
+ tfe_OFontPatchS, { (system private use) }
+ tfe_OFontPatchK : Pointer; { (system private use) }
+ { this space is reserved for future expansion }
+ END;
+
+{***** ColorTextFont node *****************************************}
+{----- ctf_Flags --------------------------------------------------}
+CONST
+ CT_COLORMASK = $000F; { mask to get to following color styles }
+ CT_COLORFONT = $0001; { color map contains designer's colors }
+ CT_GREYFONT = $0002; { color map describes even-stepped }
+ { brightnesses from low to high }
+ CT_ANTIALIAS = $0004; { zero background thru fully saturated char }
+
+ CTB_MAPCOLOR = 0; { map ctf_FgColor to the rp_FgPen IF it's }
+ CTF_MAPCOLOR = $0001; { is a valid color within ctf_Low..ctf_High }
+
+{----- ColorFontColors --------------------------------------------}
+Type
+ pColorFontColors = ^tColorFontColors;
+ tColorFontColors = record
+ cfc_Reserved, { *must* be zero }
+ cfc_Count : Word; { number of entries in cfc_ColorTable }
+ cfc_ColorTable : Pointer; { 4 bit per component color map packed xRGB }
+ END;
+
+{----- ColorTextFont ----------------------------------------------}
+
+ pColorTextFont = ^tColorTextFont;
+ tColorTextFont = record
+ ctf_TF : tTextFont;
+ ctf_Flags : Word; { extended flags }
+ ctf_Depth, { number of bit planes }
+ ctf_FgColor, { color that is remapped to FgPen }
+ ctf_Low, { lowest color represented here }
+ ctf_High, { highest color represented here }
+ ctf_PlanePick, { PlanePick ala Images }
+ ctf_PlaneOnOff : Byte; { PlaneOnOff ala Images }
+ ctf_ColorFontColors : pColorFontColors; { colors for font }
+ ctf_CharData : Array[0..7] of Pointer; {pointers to bit planes ala tf_CharData }
+ END;
+
+{***** TextExtent node ********************************************}
+
+ pTextExtent = ^tTextExtent;
+ tTextExtent = record
+ te_Width, { same as TextLength }
+ te_Height : Word; { same as tf_YSize }
+ te_Extent : tRectangle; { relative to CP }
+ END;
+
+
+const
+
+ COPPER_MOVE = 0; { pseude opcode for move #XXXX,dir }
+ COPPER_WAIT = 1; { pseudo opcode for wait y,x }
+ CPRNXTBUF = 2; { continue processing with next buffer }
+ CPR_NT_LOF = $8000; { copper instruction only for Longint frames }
+ CPR_NT_SHT = $4000; { copper instruction only for long frames }
+ CPR_NT_SYS = $2000; { copper user instruction only }
+type
+
+{ Note: The combination VWaitAddr and HWaitAddr replace a three way
+ union in C. The three possibilities are:
+
+ nxtList : CopListPtr; or
+
+ VWaitPos : Longint;
+ HWaitPos : Longint; or
+
+ DestAddr : Longint;
+ DestData : Longint;
+}
+
+ pCopIns = ^tCopIns;
+ tCopIns = record
+ OpCode : smallint; { 0 = move, 1 = wait }
+ VWaitAddr : smallint; { vertical or horizontal wait position }
+ HWaitData : smallint; { destination Pointer or data to send }
+ end;
+
+{ structure of cprlist that points to list that hardware actually executes }
+
+ pcprlist = ^tcprlist;
+ tcprlist = record
+ Next : pcprlist;
+ start : psmallint; { start of copper list }
+ MaxCount : smallint; { number of long instructions }
+ end;
+
+ pCopList = ^tCopList;
+ tCopList = record
+ Next : pCopList; { next block for this copper list }
+ CopList : pCopList; { system use }
+ ViewPort : Pointer; { system use }
+ CopIns : pCopIns; { start of this block }
+ CopPtr : pCopIns; { intermediate ptr }
+ CopLStart : psmallint; { mrgcop fills this in for Long Frame}
+ CopSStart : psmallint; { mrgcop fills this in for Longint Frame}
+ Count : smallint; { intermediate counter }
+ MaxCount : smallint; { max # of copins for this block }
+ DyOffset : smallint; { offset this copper list vertical waits }
+ SLRepeat : Word;
+ Flags : Word;
+ end;
+
+ pUCopList = ^tUCopList;
+ tUCopList = record
+ Next : pUCopList;
+ FirstCopList : pCopList; { head node of this copper list }
+ CopList : pCopList; { node in use }
+ end;
+
+ pcopinit = ^tcopinit;
+ tcopinit = record
+ vsync_hblank : array [0..1] of word;
+ diagstrt : Array [0..11] of word;
+ fm0 : array [0..1] of word;
+ diwstart : array [0..9] of word;
+ bplcon2 : array [0..1] of word;
+ sprfix : array [0..(2*8)] of word;
+ sprstrtup : Array [0..(2*8*2)] of Word;
+ wait14 : array [0..1] of word;
+ norm_hblank : array [0..1] of word;
+ jump : array [0..1] of word;
+ wait_forever : array [0..5] of word;
+ sprstop : Array [0..7] of Word;
+ end;
+
+
+
+ pAreaInfo = ^tAreaInfo;
+ tAreaInfo = record
+ VctrTbl : Pointer; { ptr to start of vector table }
+ VctrPtr : Pointer; { ptr to current vertex }
+ FlagTbl : Pointer; { ptr to start of vector flag table }
+ FlagPtr : Pointer; { ptrs to areafill flags }
+ Count : smallint; { number of vertices in list }
+ MaxCount : smallint; { AreaMove/Draw will not allow Count>MaxCount}
+ FirstX,
+ FirstY : smallint; { first point for this polygon }
+ end;
+
+ pTmpRas = ^tTmpRas;
+ tTmpRas = record
+ RasPtr : Pointer;
+ Size : Longint;
+ end;
+
+{ unoptimized for 32bit alignment of pointers }
+
+ pGelsInfo = ^tGelsInfo;
+ tGelsInfo = record
+ sprRsrvd : Shortint; { flag of which sprites to reserve from
+ vsprite system }
+ Flags : Byte; { system use }
+ gelHead,
+ gelTail : Pointer; { (VSpritePtr) dummy vSprites for list management}
+
+ { pointer to array of 8 WORDS for sprite available lines }
+
+ nextLine : Pointer;
+
+ { pointer to array of 8 pointers for color-last-assigned to vSprites }
+
+ lastColor : Pointer;
+ collHandler : Pointer; { (collTablePtr) Pointeres of collision routines }
+ leftmost,
+ rightmost,
+ topmost,
+ bottommost : smallint;
+ firstBlissObj,
+ lastBlissObj : Pointer; { system use only }
+ end;
+
+ pRastPort = ^tRastPort;
+ tRastPort = record
+ Layer : pLayer; { LayerPtr }
+ BitMap : pBitMap; { BitMapPtr }
+ ArePointern : Pointer; { ptr to areafill pattern }
+ TmpRas : pTmpRas;
+ AreaInfo : pAreaInfo;
+ GelsInfo : pGelsInfo;
+ Mask : Byte; { write mask for this raster }
+ FgPen : Shortint; { foreground pen for this raster }
+ BgPen : Shortint; { background pen }
+ AOlPen : Shortint; { areafill outline pen }
+ DrawMode : Shortint; { drawing mode for fill, lines, and text }
+ AreaPtSz : Shortint; { 2^n words for areafill pattern }
+ linpatcnt : Shortint; { current line drawing pattern preshift }
+ dummy : Shortint;
+ Flags : Word; { miscellaneous control bits }
+ LinePtrn : Word; { 16 bits for textured lines }
+ cp_x,
+ cp_y : smallint; { current pen position }
+ minterms : Array [0..7] of Byte;
+ PenWidth : smallint;
+ PenHeight : smallint;
+ Font : pTextFont; { (TextFontPtr) current font Pointer }
+ AlgoStyle : Byte; { the algorithmically generated style }
+ TxFlags : Byte; { text specific flags }
+ TxHeight : Word; { text height }
+ TxWidth : Word; { text nominal width }
+ TxBaseline : Word; { text baseline }
+ TxSpacing : smallint; { text spacing (per character) }
+ RP_User : Pointer;
+ longreserved : Array [0..1] of Cardinal;
+ wordreserved : Array [0..6] of Word; { used to be a node }
+ reserved : Array [0..7] of Byte; { for future use }
+ end;
+
+const
+
+{ drawing modes }
+
+ JAM1 = 0; { jam 1 color into raster }
+ JAM2 = 1; { jam 2 colors into raster }
+ COMPLEMENT = 2; { XOR bits into raster }
+ INVERSVID = 4; { inverse video for drawing modes }
+
+{ these are the flag bits for RastPort flags }
+
+ FRST_DOT = $01; { draw the first dot of this line ? }
+ ONE_DOT = $02; { use one dot mode for drawing lines }
+ DBUFFER = $04; { flag set when RastPorts are double-buffered }
+
+ { only used for bobs }
+
+ AREAOUTLINE = $08; { used by areafiller }
+ NOCROSSFILL = $20; { areafills have no crossovers }
+
+{ there is only one style of clipping: raster clipping }
+{ this preserves the continuity of jaggies regardless of clip window }
+{ When drawing into a RastPort, if the ptr to ClipRect is nil then there }
+{ is no clipping done, this is dangerous but useful for speed }
+
+
+Const
+ CleanUp = $40;
+ CleanMe = CleanUp;
+
+ BltClearWait = 1; { Waits for blit to finish }
+ BltClearXY = 2; { Use Row/Bytes per row method }
+
+ { Useful minterms }
+
+ StraightCopy = $C0; { Vanilla copy }
+ InvertAndCopy = $30; { Invert the source before copy }
+ InvertDest = $50; { Forget source, invert dest }
+
+
+ { mode coercion definitions }
+
+const
+{ These flags are passed (in combination) to CoerceMode() to determine the
+ * type of coercion required.
+ }
+
+{ Ensure that the mode coerced to can display just as many colours as the
+ * ViewPort being coerced.
+ }
+ PRESERVE_COLORS = 1;
+
+{ Ensure that the mode coerced to is not interlaced. }
+ AVOID_FLICKER = 2;
+
+{ Coercion should ignore monitor compatibility issues. }
+ IGNORE_MCOMPAT = 4;
+
+
+ BIDTAG_COERCE = 1; { Private }
+
+const
+
+{ VSprite flags }
+{ user-set VSprite flags: }
+
+ SUSERFLAGS = $00FF; { mask of all user-settable VSprite-flags }
+ VSPRITE_f = $0001; { set if VSprite, clear if Bob }
+ { VSPRITE had to be changed for name conflict }
+ SAVEBACK = $0002; { set if background is to be saved/restored }
+ OVERLAY = $0004; { set to mask image of Bob onto background }
+ MUSTDRAW = $0008; { set if VSprite absolutely must be drawn }
+
+{ system-set VSprite flags: }
+
+ BACKSAVED = $0100; { this Bob's background has been saved }
+ BOBUPDATE = $0200; { temporary flag, useless to outside world }
+ GELGONE = $0400; { set if gel is completely clipped (offscreen) }
+ VSOVERFLOW = $0800; { VSprite overflow (if MUSTDRAW set we draw!) }
+
+{ Bob flags }
+{ these are the user flag bits }
+
+ BUSERFLAGS = $00FF; { mask of all user-settable Bob-flags }
+ SAVEBOB = $0001; { set to not erase Bob }
+ BOBISCOMP = $0002; { set to identify Bob as AnimComp }
+
+{ these are the system flag bits }
+
+ BWAITING = $0100; { set while Bob is waiting on 'after' }
+ BDRAWN = $0200; { set when Bob is drawn this DrawG pass}
+ BOBSAWAY = $0400; { set to initiate removal of Bob }
+ BOBNIX = $0800; { set when Bob is completely removed }
+ SAVEPRESERVE = $1000; { for back-restore during double-buffer}
+ OUTSTEP = $2000; { for double-clearing if double-buffer }
+
+{ defines for the animation procedures }
+
+ ANFRACSIZE = 6;
+ ANIMHALF = $0020;
+ RINGTRIGGER = $0001;
+
+
+{ UserStuff definitions
+ * the user can define these to be a single variable or a sub-structure
+ * if undefined by the user, the system turns these into innocuous variables
+ * see the manual for a thorough definition of the UserStuff definitions
+ *
+ }
+
+type
+
+ VUserStuff = smallint; { Sprite user stuff }
+ BUserStuff = smallint; { Bob user stuff }
+ AUserStuff = smallint; { AnimOb user stuff }
+
+{********************** GEL STRUCTURES **********************************}
+
+ pVSprite = ^tVSprite;
+ tVSprite = record
+
+{ --------------------- SYSTEM VARIABLES ------------------------------- }
+{ GEL linked list forward/backward pointers sorted by y,x value }
+
+ NextVSprite : pVSprite;
+ PrevVSprite : pVSprite;
+
+{ GEL draw list constructed in the order the Bobs are actually drawn, then
+ * list is copied to clear list
+ * must be here in VSprite for system boundary detection
+ }
+
+ DrawPath : pVSprite; { pointer of overlay drawing }
+ ClearPath : pVSprite; { pointer for overlay clearing }
+
+{ the VSprite positions are defined in (y,x) order to make sorting
+ * sorting easier, since (y,x) as a long Longint
+ }
+
+ OldY, OldX : smallint; { previous position }
+
+{ --------------------- COMMON VARIABLES --------------------------------- }
+
+ Flags : smallint; { VSprite flags }
+
+
+{ --------------------- USER VARIABLES ----------------------------------- }
+{ the VSprite positions are defined in (y,x) order to make sorting
+ * sorting easier, since (y,x) as a long Longint
+ }
+
+ Y, X : smallint; { screen position }
+
+ Height : smallint;
+ Width : smallint; { number of words per row of image data }
+ Depth : smallint; { number of planes of data }
+
+ MeMask : smallint; { which types can collide with this VSprite}
+ HitMask : smallint; { which types this VSprite can collide with}
+
+ ImageData : Pointer; { pointer to VSprite image }
+
+{ borderLine is the one-dimensional logical OR of all
+ * the VSprite bits, used for fast collision detection of edge
+ }
+
+ BorderLine : Pointer; { logical OR of all VSprite bits }
+ CollMask : Pointer; { similar to above except this is a matrix }
+
+{ pointer to this VSprite's color definitions (not used by Bobs) }
+
+ SprColors : Pointer;
+
+ VSBob : Pointer; { (BobPtr) points home if this VSprite
+ is part of a Bob }
+
+{ planePick flag: set bit selects a plane from image, clear bit selects
+ * use of shadow mask for that plane
+ * OnOff flag: if using shadow mask to fill plane, this bit (corresponding
+ * to bit in planePick) describes whether to fill with 0's or 1's
+ * There are two uses for these flags:
+ * - if this is the VSprite of a Bob, these flags describe how the Bob
+ * is to be drawn into memory
+ * - if this is a simple VSprite and the user intends on setting the
+ * MUSTDRAW flag of the VSprite, these flags must be set too to describe
+ * which color registers the user wants for the image
+ }
+
+ PlanePick : Shortint;
+ PlaneOnOff : Shortint;
+
+ VUserExt : VUserStuff; { user definable: see note above }
+ end;
+
+
+
+
+{ dBufPacket defines the values needed to be saved across buffer to buffer
+ * when in double-buffer mode
+ }
+
+ pDBufPacket = ^tDBufPacket;
+ tDBufPacket = record
+ BufY,
+ BufX : Word; { save other buffers screen coordinates }
+ BufPath : pVSprite; { carry the draw path over the gap }
+
+{ these pointers must be filled in by the user }
+{ pointer to other buffer's background save buffer }
+
+ BufBuffer : Pointer;
+ end;
+
+
+
+
+
+ pBob = ^tBob;
+ tBob = record
+{ blitter-objects }
+
+{ --------------------- SYSTEM VARIABLES --------------------------------- }
+
+{ --------------------- COMMON VARIABLES --------------------------------- }
+
+ Flags : smallint; { general purpose flags (see definitions below) }
+
+{ --------------------- USER VARIABLES ----------------------------------- }
+
+ SaveBuffer : Pointer; { pointer to the buffer for background save }
+
+{ used by Bobs for "cookie-cutting" and multi-plane masking }
+
+ ImageShadow : Pointer;
+
+{ pointer to BOBs for sequenced drawing of Bobs
+ * for correct overlaying of multiple component animations
+ }
+ Before : pBob; { draw this Bob before Bob pointed to by before }
+ After : pBob; { draw this Bob after Bob pointed to by after }
+
+ BobVSprite : pVSprite; { this Bob's VSprite definition }
+
+ BobComp : Pointer; { (AnimCompPtr) pointer to this Bob's AnimComp def }
+
+ DBuffer : Pointer; { pointer to this Bob's dBuf packet }
+
+ BUserExt : BUserStuff; { Bob user extension }
+ end;
+
+ pAnimComp = ^tAnimComp;
+ tAnimComp = record
+
+{ --------------------- SYSTEM VARIABLES --------------------------------- }
+
+{ --------------------- COMMON VARIABLES --------------------------------- }
+
+ Flags : smallint; { AnimComp flags for system & user }
+
+{ timer defines how long to keep this component active:
+ * if set non-zero, timer decrements to zero then switches to nextSeq
+ * if set to zero, AnimComp never switches
+ }
+
+ Timer : smallint;
+
+{ --------------------- USER VARIABLES ----------------------------------- }
+{ initial value for timer when the AnimComp is activated by the system }
+
+ TimeSet : smallint;
+
+{ pointer to next and previous components of animation object }
+
+ NextComp : pAnimComp;
+ PrevComp : pAnimComp;
+
+{ pointer to component component definition of next image in sequence }
+
+ NextSeq : pAnimComp;
+ PrevSeq : pAnimComp;
+
+ AnimCRoutine : Pointer; { Pointer of special animation procedure }
+
+ YTrans : smallint; { initial y translation (if this is a component) }
+ XTrans : smallint; { initial x translation (if this is a component) }
+
+ HeadOb : Pointer; { AnimObPtr }
+
+ AnimBob : pBob;
+ end;
+
+ pAnimOb = ^tAnimOb;
+ tAnimOb = record
+
+{ --------------------- SYSTEM VARIABLES --------------------------------- }
+
+ NextOb,
+ PrevOb : pAnimOb;
+
+{ number of calls to Animate this AnimOb has endured }
+
+ Clock : Longint;
+
+ AnOldY,
+ AnOldX : smallint; { old y,x coordinates }
+
+{ --------------------- COMMON VARIABLES --------------------------------- }
+
+ AnY,
+ AnX : smallint; { y,x coordinates of the AnimOb }
+
+{ --------------------- USER VARIABLES ----------------------------------- }
+
+ YVel,
+ XVel : smallint; { velocities of this object }
+ YAccel,
+ XAccel : smallint; { accelerations of this object }
+
+ RingYTrans,
+ RingXTrans : smallint; { ring translation values }
+
+ AnimORoutine : Pointer; { Pointer of special animation
+ procedure }
+
+ HeadComp : pAnimComp; { pointer to first component }
+
+ AUserExt : AUserStuff; { AnimOb user extension }
+ end;
+
+ ppAnimOb = ^pAnimOb;
+
+
+{ ************************************************************************ }
+
+const
+
+ B2NORM = 0;
+ B2SWAP = 1;
+ B2BOBBER = 2;
+
+{ ************************************************************************ }
+
+type
+
+{ a structure to contain the 16 collision procedure addresses }
+
+ collTable = Array [0..15] of Pointer;
+ pcollTable = ^collTable;
+
+const
+
+{ These bit descriptors are used by the GEL collide routines.
+ * These bits are set in the hitMask and meMask variables of
+ * a GEL to describe whether or not these types of collisions
+ * can affect the GEL. BNDRY_HIT is described further below;
+ * this bit is permanently assigned as the boundary-hit flag.
+ * The other bit GEL_HIT is meant only as a default to cover
+ * any GEL hitting any other; the user may redefine this bit.
+ }
+
+ BORDERHIT = 0;
+
+{ These bit descriptors are used by the GEL boundry hit routines.
+ * When the user's boundry-hit routine is called (via the argument
+ * set by a call to SetCollision) the first argument passed to
+ * the user's routine is the Pointer of the GEL involved in the
+ * boundry-hit, and the second argument has the appropriate bit(s)
+ * set to describe which boundry was surpassed
+ }
+
+ TOPHIT = 1;
+ BOTTOMHIT = 2;
+ LEFTHIT = 4;
+ RIGHTHIT = 8;
+
+Type
+ pExtendedNode = ^tExtendedNode;
+ tExtendedNode = record
+ xln_Succ,
+ xln_Pred : pNode;
+ xln_Type : Byte;
+ xln_Pri : Shortint;
+ xln_Name : PChar;
+ xln_Subsystem : Byte;
+ xln_Subtype : Byte;
+ xln_Library : Longint;
+ xln_Init : Pointer;
+ END;
+
+CONST
+ SS_GRAPHICS = $02;
+
+ VIEW_EXTRA_TYPE = 1;
+ VIEWPORT_EXTRA_TYPE = 2;
+ SPECIAL_MONITOR_TYPE = 3;
+ MONITOR_SPEC_TYPE = 4;
+
+type
+
+{ structure used by AddTOFTask }
+
+ pIsrvstr = ^tIsrvstr;
+ tIsrvstr = record
+ is_Node : tNode;
+ Iptr : pIsrvstr; { passed to srvr by os }
+ code : Pointer;
+ ccode : Pointer;
+ Carg : Pointer;
+ end;
+
+Type
+ pAnalogSignalInterval = ^tAnalogSignalInterval;
+ tAnalogSignalInterval = record
+ asi_Start,
+ asi_Stop : Word;
+ END;
+
+ pSpecialMonitor = ^tSpecialMonitor;
+ tSpecialMonitor = record
+ spm_Node : tExtendedNode;
+ spm_Flags : Word;
+ do_monitor,
+ reserved1,
+ reserved2,
+ reserved3 : Pointer;
+ hblank,
+ vblank,
+ hsync,
+ vsync : tAnalogSignalInterval;
+ END;
+
+
+ pMonitorSpec = ^tMonitorSpec;
+ tMonitorSpec = record
+ ms_Node : tExtendedNode;
+ ms_Flags : Word;
+ ratioh,
+ ratiov : Longint;
+ total_rows,
+ total_colorclocks,
+ DeniseMaxDisplayColumn,
+ BeamCon0,
+ min_row : Word;
+ ms_Special : pSpecialMonitor;
+ ms_OpenCount : Word;
+ ms_transform,
+ ms_translate,
+ ms_scale : Pointer;
+ ms_xoffset,
+ ms_yoffset : Word;
+ ms_LegalView : tRectangle;
+ ms_maxoscan, { maximum legal overscan }
+ ms_videoscan : Pointer; { video display overscan }
+ DeniseMinDisplayColumn : Word;
+ DisplayCompatible : Cardinal;
+ DisplayInfoDataBase : tList;
+ DisplayInfoDataBaseSemaphore : tSignalSemaphore;
+ ms_MrgCop,
+ ms_LoadView,
+ ms_KillView : Longint;
+ END;
+
+const
+ TO_MONITOR = 0;
+ FROM_MONITOR = 1;
+ STANDARD_XOFFSET = 9;
+ STANDARD_YOFFSET = 0;
+
+ MSB_REQUEST_NTSC = 0;
+ MSB_REQUEST_PAL = 1;
+ MSB_REQUEST_SPECIAL = 2;
+ MSB_REQUEST_A2024 = 3;
+ MSB_DOUBLE_SPRITES = 4;
+ MSF_REQUEST_NTSC = 1;
+ MSF_REQUEST_PAL = 2;
+ MSF_REQUEST_SPECIAL = 4;
+ MSF_REQUEST_A2024 = 8;
+ MSF_DOUBLE_SPRITES = 16;
+
+
+{ obsolete, v37 compatible definitions follow }
+ REQUEST_NTSC = 1;
+ REQUEST_PAL = 2;
+ REQUEST_SPECIAL = 4;
+ REQUEST_A2024 = 8;
+
+ DEFAULT_MONITOR_NAME : PChar = 'default.monitor';
+ NTSC_MONITOR_NAME : PChar = 'ntsc.monitor';
+ PAL_MONITOR_NAME : PChar = 'pal.monitor';
+ STANDARD_MONITOR_MASK = ( REQUEST_NTSC OR REQUEST_PAL ) ;
+
+ STANDARD_NTSC_ROWS = 262;
+ STANDARD_PAL_ROWS = 312;
+ STANDARD_COLORCLOCKS = 226;
+ STANDARD_DENISE_MAX = 455;
+ STANDARD_DENISE_MIN = 93 ;
+ STANDARD_NTSC_BEAMCON = $0000;
+ STANDARD_PAL_BEAMCON = DISPLAYPAL ;
+
+ SPECIAL_BEAMCON = ( VARVBLANK OR LOLDIS OR VARVSYNC OR VARHSYNC OR VARBEAM OR CSBLANK OR VSYNCTRUE);
+
+ MIN_NTSC_ROW = 21 ;
+ MIN_PAL_ROW = 29 ;
+ STANDARD_VIEW_X = $81 ;
+ STANDARD_VIEW_Y = $2C ;
+ STANDARD_HBSTRT = $06 ;
+ STANDARD_HSSTRT = $0B ;
+ STANDARD_HSSTOP = $1C ;
+ STANDARD_HBSTOP = $2C ;
+ STANDARD_VBSTRT = $0122;
+ STANDARD_VSSTRT = $02A6;
+ STANDARD_VSSTOP = $03AA;
+ STANDARD_VBSTOP = $1066;
+
+ VGA_COLORCLOCKS = (STANDARD_COLORCLOCKS/2);
+ VGA_TOTAL_ROWS = (STANDARD_NTSC_ROWS*2);
+ VGA_DENISE_MIN = 59 ;
+ MIN_VGA_ROW = 29 ;
+ VGA_HBSTRT = $08 ;
+ VGA_HSSTRT = $0E ;
+ VGA_HSSTOP = $1C ;
+ VGA_HBSTOP = $1E ;
+ VGA_VBSTRT = $0000;
+ VGA_VSSTRT = $0153;
+ VGA_VSSTOP = $0235;
+ VGA_VBSTOP = $0CCD;
+
+ VGA_MONITOR_NAME : PChar = 'vga.monitor';
+
+{ NOTE: VGA70 definitions are obsolete - a VGA70 monitor has never been
+ * implemented.
+ }
+ VGA70_COLORCLOCKS = (STANDARD_COLORCLOCKS/2) ;
+ VGA70_TOTAL_ROWS = 449;
+ VGA70_DENISE_MIN = 59;
+ MIN_VGA70_ROW = 35 ;
+ VGA70_HBSTRT = $08 ;
+ VGA70_HSSTRT = $0E ;
+ VGA70_HSSTOP = $1C ;
+ VGA70_HBSTOP = $1E ;
+ VGA70_VBSTRT = $0000;
+ VGA70_VSSTRT = $02A6;
+ VGA70_VSSTOP = $0388;
+ VGA70_VBSTOP = $0F73;
+
+ VGA70_BEAMCON = (SPECIAL_BEAMCON XOR VSYNCTRUE);
+ VGA70_MONITOR_NAME : PChar = 'vga70.monitor';
+
+ BROADCAST_HBSTRT = $01 ;
+ BROADCAST_HSSTRT = $06 ;
+ BROADCAST_HSSTOP = $17 ;
+ BROADCAST_HBSTOP = $27 ;
+ BROADCAST_VBSTRT = $0000;
+ BROADCAST_VSSTRT = $02A6;
+ BROADCAST_VSSTOP = $054C;
+ BROADCAST_VBSTOP = $1C40;
+ BROADCAST_BEAMCON = ( LOLDIS OR CSBLANK );
+ RATIO_FIXEDPART = 4;
+ RATIO_UNITY = 16;
+
+
+
+Type
+ pRasInfo = ^tRasInfo;
+ tRasInfo = record { used by callers to and InitDspC() }
+ Next : pRasInfo; { used for dualpf }
+ BitMap : pBitMap;
+ RxOffset,
+ RyOffset : smallint; { scroll offsets in this BitMap }
+ end;
+
+
+ pView = ^tView;
+ tView = record
+ ViewPort : Pointer; { ViewPortPtr }
+ LOFCprList : pcprlist; { used for interlaced and noninterlaced }
+ SHFCprList : pcprlist; { only used during interlace }
+ DyOffset,
+ DxOffset : smallint; { for complete View positioning }
+ { offsets are +- adjustments to standard #s }
+ Modes : WORD; { such as INTERLACE, GENLOC }
+ end;
+
+{ these structures are obtained via GfxNew }
+{ and disposed by GfxFree }
+Type
+ pViewExtra = ^tViewExtra;
+ tViewExtra = record
+ n : tExtendedNode;
+ View : pView; { backwards link } { view in C-Includes }
+ Monitor : pMonitorSpec; { monitors for this view }
+ TopLine : Word;
+ END;
+
+
+ pViewPort = ^tViewPort;
+ tViewPort = record
+ Next : pViewPort;
+ ColorMap : Pointer; { table of colors for this viewport } { ColorMapPtr }
+ { if this is nil, MakeVPort assumes default values }
+ DspIns : pCopList; { user by MakeView() }
+ SprIns : pCopList; { used by sprite stuff }
+ ClrIns : pCopList; { used by sprite stuff }
+ UCopIns : pUCopList; { User copper list }
+ DWidth,
+ DHeight : smallint;
+ DxOffset,
+ DyOffset : smallint;
+ Modes : Word;
+ SpritePriorities : Byte; { used by makevp }
+ reserved : Byte;
+ RasInfo : pRasInfo;
+ end;
+
+
+{ this structure is obtained via GfxNew }
+{ and disposed by GfxFree }
+
+ pViewPortExtra = ^tViewPortExtra;
+ tViewPortExtra = record
+ n : tExtendedNode;
+ ViewPort : pViewPort; { backwards link } { ViewPort in C-Includes }
+ DisplayClip : tRectangle; { makevp display clipping information }
+ { These are added for V39 }
+ VecTable : Pointer; { Private }
+ DriverData : Array[0..1] of Pointer;
+ Flags : WORD;
+ Origin : Array[0..1] of tPoint; { First visible point relative to the DClip.
+ * One for each possible playfield.
+ }
+ cop1ptr, { private }
+ cop2ptr : Cardinal; { private }
+ END;
+
+
+ pColorMap = ^tColorMap;
+ tColorMap = record
+ Flags : Byte;
+ CType : Byte; { This is "Type" in C includes }
+ Count : Word;
+ ColorTable : Pointer;
+ cm_vpe : pViewPortExtra;
+ LowColorBits : Pointer;
+ TransparencyPlane,
+ SpriteResolution,
+ SpriteResDefault,
+ AuxFlags : Byte;
+ cm_vp : pViewPort; { ViewPortPtr }
+ NormalDisplayInfo,
+ CoerceDisplayInfo : Pointer;
+ cm_batch_items : pTagItem;
+ VPModeID : Cardinal;
+ PalExtra : Pointer;
+ SpriteBase_Even,
+ SpriteBase_Odd,
+ Bp_0_base,
+ Bp_1_base : Word;
+ end;
+
+{ if Type == 0 then ColorMap is V1.2/V1.3 compatible }
+{ if Type != 0 then ColorMap is V36 compatible }
+{ the system will never create other than V39 type colormaps when running V39 }
+
+CONST
+ COLORMAP_TYPE_V1_2 = $00;
+ COLORMAP_TYPE_V1_4 = $01;
+ COLORMAP_TYPE_V36 = COLORMAP_TYPE_V1_4; { use this definition }
+ COLORMAP_TYPE_V39 = $02;
+
+
+{ Flags variable }
+ COLORMAP_TRANSPARENCY = $01;
+ COLORPLANE_TRANSPARENCY = $02;
+ BORDER_BLANKING = $04;
+ BORDER_NOTRANSPARENCY = $08;
+ VIDEOCONTROL_BATCH = $10;
+ USER_COPPER_CLIP = $20;
+
+
+CONST
+ EXTEND_VSTRUCT = $1000; { unused bit in Modes field of View }
+
+
+{ defines used for Modes in IVPargs }
+
+CONST
+ GENLOCK_VIDEO = $0002;
+ LACE = $0004;
+ SUPERHIRES = $0020;
+ PFBA = $0040;
+ EXTRA_HALFBRITE= $0080;
+ GENLOCK_AUDIO = $0100;
+ DUALPF = $0400;
+ HAM = $0800;
+ EXTENDED_MODE = $1000;
+ VP_HIDE = $2000;
+ SPRITES = $4000;
+ HIRES = $8000;
+
+ VPF_A2024 = $40;
+ VPF_AGNUS = $20;
+ VPF_TENHZ = $20;
+
+ BORDERSPRITES = $40;
+
+ CMF_CMTRANS = 0;
+ CMF_CPTRANS = 1;
+ CMF_BRDRBLNK = 2;
+ CMF_BRDNTRAN = 3;
+ CMF_BRDRSPRT = 6;
+
+ SPRITERESN_ECS = 0;
+{ ^140ns, except in 35ns viewport, where it is 70ns. }
+ SPRITERESN_140NS = 1;
+ SPRITERESN_70NS = 2;
+ SPRITERESN_35NS = 3;
+ SPRITERESN_DEFAULT = -1;
+
+{ AuxFlags : }
+ CMAB_FULLPALETTE = 0;
+ CMAF_FULLPALETTE = 1;
+ CMAB_NO_INTERMED_UPDATE = 1;
+ CMAF_NO_INTERMED_UPDATE = 2;
+ CMAB_NO_COLOR_LOAD = 2;
+ CMAF_NO_COLOR_LOAD = 4;
+ CMAB_DUALPF_DISABLE = 3;
+ CMAF_DUALPF_DISABLE = 8;
+
+Type
+ pPaletteExtra = ^tPaletteExtra;
+ tPaletteExtra = record { structure may be extended so watch out! }
+ pe_Semaphore : tSignalSemaphore; { shared semaphore for arbitration }
+ pe_FirstFree, { *private* }
+ pe_NFree, { number of free colors }
+ pe_FirstShared, { *private* }
+ pe_NShared : WORD; { *private* }
+ pe_RefCnt : Pointer; { *private* }
+ pe_AllocList : Pointer; { *private* }
+ pe_ViewPort : pViewPort; { back pointer to viewport }
+ pe_SharableColors : WORD; { the number of sharable colors. }
+ end;
+{ flags values for ObtainPen }
+Const
+ PENB_EXCLUSIVE = 0;
+ PENB_NO_SETCOLOR = 1;
+
+ PENF_EXCLUSIVE = 1;
+ PENF_NO_SETCOLOR = 2;
+
+{ obsolete names for PENF_xxx flags: }
+
+ PEN_EXCLUSIVE = PENF_EXCLUSIVE;
+ PEN_NO_SETCOLOR = PENF_NO_SETCOLOR;
+
+{ precision values for ObtainBestPen : }
+
+ PRECISION_EXACT = -1;
+ PRECISION_IMAGE = 0;
+ PRECISION_ICON = 16;
+ PRECISION_GUI = 32;
+
+
+{ tags for ObtainBestPen: }
+ OBP_Precision = $84000000;
+ OBP_FailIfBad = $84000001;
+
+{ From V39, MakeVPort() will return an error if there is not enough memory,
+ * or the requested mode cannot be opened with the requested depth with the
+ * given bitmap (for higher bandwidth alignments).
+ }
+
+ MVP_OK = 0; { you want to see this one }
+ MVP_NO_MEM = 1; { insufficient memory for intermediate workspace }
+ MVP_NO_VPE = 2; { ViewPort does not have a ViewPortExtra, and
+ * insufficient memory to allocate a temporary one.
+ }
+ MVP_NO_DSPINS = 3; { insufficient memory for intermidiate copper
+ * instructions.
+ }
+ MVP_NO_DISPLAY = 4; { BitMap data is misaligned for this viewport's
+ * mode and depth - see AllocBitMap().
+ }
+ MVP_OFF_BOTTOM = 5; { PRIVATE - you will never see this. }
+
+{ From V39, MrgCop() will return an error if there is not enough memory,
+ * or for some reason MrgCop() did not need to make any copper lists.
+ }
+
+ MCOP_OK = 0; { you want to see this one }
+ MCOP_NO_MEM = 1; { insufficient memory to allocate the system
+ * copper lists.
+ }
+ MCOP_NOP = 2; { MrgCop() did not merge any copper lists
+ * (eg, no ViewPorts in the list, or all marked as
+ * hidden).
+ }
+Type
+ pDBufInfo = ^tDBufInfo;
+ tDBufInfo = record
+ dbi_Link1 : Pointer;
+ dbi_Count1 : Cardinal;
+ dbi_SafeMessage : tMessage; { replied to when safe to write to old bitmap }
+ dbi_UserData1 : Pointer; { first user data }
+
+ dbi_Link2 : Pointer;
+ dbi_Count2 : Cardinal;
+ dbi_DispMessage : tMessage; { replied to when new bitmap has been displayed at least
+ once }
+ dbi_UserData2 : Pointer; { second user data }
+ dbi_MatchLong : Cardinal;
+ dbi_CopPtr1,
+ dbi_CopPtr2,
+ dbi_CopPtr3 : Pointer;
+ dbi_BeamPos1,
+ dbi_BeamPos2 : WORD;
+ end;
+
+
+
+ { include define file for graphics display mode IDs. }
+
+
+const
+
+ INVALID_ID = NOT 0;
+
+{ With all the new modes that are available under V38 and V39, it is highly
+ * recommended that you use either the asl.library screenmode requester,
+ * and/or the V39 graphics.library function BestModeIDA().
+ *
+ * DO NOT interpret the any of the bits in the ModeID for its meaning. For
+ * example, do not interpret bit 3 ($4) as meaning the ModeID is interlaced.
+ * Instead, use GetDisplayInfoData() with DTAG_DISP, and examine the DIPF_...
+ * flags to determine a ModeID's characteristics. The only exception to
+ * this rule is that bit 7 ($80) will always mean the ModeID is
+ * ExtraHalfBright, and bit 11 ($800) will always mean the ModeID is HAM.
+ }
+
+{ normal identifiers }
+
+ MONITOR_ID_MASK = $FFFF1000;
+
+ DEFAULT_MONITOR_ID = $00000000;
+ NTSC_MONITOR_ID = $00011000;
+ PAL_MONITOR_ID = $00021000;
+
+{ the following 22 composite keys are for Modes on the default Monitor.
+ * NTSC & PAL "flavors" of these particular keys may be made by or'ing
+ * the NTSC or PAL MONITOR_ID with the desired MODE_KEY...
+ *
+ * For example, to specifically open a PAL HAM interlaced ViewPort
+ * (or intuition screen), you would use the modeid of
+ * (PAL_MONITOR_ID OR HAMLACE_KEY)
+ }
+
+ LORES_KEY = $00000000;
+ HIRES_KEY = $00008000;
+ SUPER_KEY = $00008020;
+ HAM_KEY = $00000800;
+ LORESLACE_KEY = $00000004;
+ HIRESLACE_KEY = $00008004;
+ SUPERLACE_KEY = $00008024;
+ HAMLACE_KEY = $00000804;
+ LORESDPF_KEY = $00000400;
+ HIRESDPF_KEY = $00008400;
+ SUPERDPF_KEY = $00008420;
+ LORESLACEDPF_KEY = $00000404;
+ HIRESLACEDPF_KEY = $00008404;
+ SUPERLACEDPF_KEY = $00008424;
+ LORESDPF2_KEY = $00000440;
+ HIRESDPF2_KEY = $00008440;
+ SUPERDPF2_KEY = $00008460;
+ LORESLACEDPF2_KEY = $00000444;
+ HIRESLACEDPF2_KEY = $00008444;
+ SUPERLACEDPF2_KEY = $00008464;
+ EXTRAHALFBRITE_KEY = $00000080;
+ EXTRAHALFBRITELACE_KEY = $00000084;
+{ New for AA ChipSet (V39) }
+ HIRESHAM_KEY = $00008800;
+ SUPERHAM_KEY = $00008820;
+ HIRESEHB_KEY = $00008080;
+ SUPEREHB_KEY = $000080a0;
+ HIRESHAMLACE_KEY = $00008804;
+ SUPERHAMLACE_KEY = $00008824;
+ HIRESEHBLACE_KEY = $00008084;
+ SUPEREHBLACE_KEY = $000080a4;
+{ Added for V40 - may be useful modes for some games or animations. }
+ LORESSDBL_KEY = $00000008;
+ LORESHAMSDBL_KEY = $00000808;
+ LORESEHBSDBL_KEY = $00000088;
+ HIRESHAMSDBL_KEY = $00008808;
+
+
+{ VGA identifiers }
+
+ VGA_MONITOR_ID = $00031000;
+
+ VGAEXTRALORES_KEY = $00031004;
+ VGALORES_KEY = $00039004;
+ VGAPRODUCT_KEY = $00039024;
+ VGAHAM_KEY = $00031804;
+ VGAEXTRALORESLACE_KEY = $00031005;
+ VGALORESLACE_KEY = $00039005;
+ VGAPRODUCTLACE_KEY = $00039025;
+ VGAHAMLACE_KEY = $00031805;
+ VGAEXTRALORESDPF_KEY = $00031404;
+ VGALORESDPF_KEY = $00039404;
+ VGAPRODUCTDPF_KEY = $00039424;
+ VGAEXTRALORESLACEDPF_KEY = $00031405;
+ VGALORESLACEDPF_KEY = $00039405;
+ VGAPRODUCTLACEDPF_KEY = $00039425;
+ VGAEXTRALORESDPF2_KEY = $00031444;
+ VGALORESDPF2_KEY = $00039444;
+ VGAPRODUCTDPF2_KEY = $00039464;
+ VGAEXTRALORESLACEDPF2_KEY = $00031445;
+ VGALORESLACEDPF2_KEY = $00039445;
+ VGAPRODUCTLACEDPF2_KEY = $00039465;
+ VGAEXTRAHALFBRITE_KEY = $00031084;
+ VGAEXTRAHALFBRITELACE_KEY = $00031085;
+{ New for AA ChipSet (V39) }
+ VGAPRODUCTHAM_KEY = $00039824;
+ VGALORESHAM_KEY = $00039804;
+ VGAEXTRALORESHAM_KEY = VGAHAM_KEY;
+ VGAPRODUCTHAMLACE_KEY = $00039825;
+ VGALORESHAMLACE_KEY = $00039805;
+ VGAEXTRALORESHAMLACE_KEY = VGAHAMLACE_KEY;
+ VGAEXTRALORESEHB_KEY = VGAEXTRAHALFBRITE_KEY;
+ VGAEXTRALORESEHBLACE_KEY = VGAEXTRAHALFBRITELACE_KEY;
+ VGALORESEHB_KEY = $00039084;
+ VGALORESEHBLACE_KEY = $00039085;
+ VGAEHB_KEY = $000390a4;
+ VGAEHBLACE_KEY = $000390a5;
+{ These ModeIDs are the scandoubled equivalents of the above, with the
+ * exception of the DualPlayfield modes, as AA does not allow for scandoubling
+ * dualplayfield.
+ }
+ VGAEXTRALORESDBL_KEY = $00031000;
+ VGALORESDBL_KEY = $00039000;
+ VGAPRODUCTDBL_KEY = $00039020;
+ VGAEXTRALORESHAMDBL_KEY = $00031800;
+ VGALORESHAMDBL_KEY = $00039800;
+ VGAPRODUCTHAMDBL_KEY = $00039820;
+ VGAEXTRALORESEHBDBL_KEY = $00031080;
+ VGALORESEHBDBL_KEY = $00039080;
+ VGAPRODUCTEHBDBL_KEY = $000390a0;
+
+{ a2024 identifiers }
+
+ A2024_MONITOR_ID = $00041000;
+
+ A2024TENHERTZ_KEY = $00041000;
+ A2024FIFTEENHERTZ_KEY = $00049000;
+
+{ prototype identifiers (private) }
+
+ PROTO_MONITOR_ID = $00051000;
+
+
+{ These monitors and modes were added for the V38 release. }
+
+ EURO72_MONITOR_ID = $00061000;
+
+ EURO72EXTRALORES_KEY = $00061004;
+ EURO72LORES_KEY = $00069004;
+ EURO72PRODUCT_KEY = $00069024;
+ EURO72HAM_KEY = $00061804;
+ EURO72EXTRALORESLACE_KEY = $00061005;
+ EURO72LORESLACE_KEY = $00069005;
+ EURO72PRODUCTLACE_KEY = $00069025;
+ EURO72HAMLACE_KEY = $00061805;
+ EURO72EXTRALORESDPF_KEY = $00061404;
+ EURO72LORESDPF_KEY = $00069404;
+ EURO72PRODUCTDPF_KEY = $00069424;
+ EURO72EXTRALORESLACEDPF_KEY = $00061405;
+ EURO72LORESLACEDPF_KEY = $00069405;
+ EURO72PRODUCTLACEDPF_KEY = $00069425;
+ EURO72EXTRALORESDPF2_KEY = $00061444;
+ EURO72LORESDPF2_KEY = $00069444;
+ EURO72PRODUCTDPF2_KEY = $00069464;
+ EURO72EXTRALORESLACEDPF2_KEY = $00061445;
+ EURO72LORESLACEDPF2_KEY = $00069445;
+ EURO72PRODUCTLACEDPF2_KEY = $00069465;
+ EURO72EXTRAHALFBRITE_KEY = $00061084;
+ EURO72EXTRAHALFBRITELACE_KEY = $00061085;
+{ New AA modes (V39) }
+ EURO72PRODUCTHAM_KEY = $00069824;
+ EURO72PRODUCTHAMLACE_KEY = $00069825;
+ EURO72LORESHAM_KEY = $00069804;
+ EURO72LORESHAMLACE_KEY = $00069805;
+ EURO72EXTRALORESHAM_KEY = EURO72HAM_KEY;
+ EURO72EXTRALORESHAMLACE_KEY = EURO72HAMLACE_KEY ;
+ EURO72EXTRALORESEHB_KEY = EURO72EXTRAHALFBRITE_KEY;
+ EURO72EXTRALORESEHBLACE_KEY = EURO72EXTRAHALFBRITELACE_KEY;
+ EURO72LORESEHB_KEY = $00069084;
+ EURO72LORESEHBLACE_KEY = $00069085;
+ EURO72EHB_KEY = $000690a4;
+ EURO72EHBLACE_KEY = $000690a5;
+{ These ModeIDs are the scandoubled equivalents of the above, with the
+ * exception of the DualPlayfield modes, as AA does not allow for scandoubling
+ * dualplayfield.
+ }
+ EURO72EXTRALORESDBL_KEY = $00061000;
+ EURO72LORESDBL_KEY = $00069000;
+ EURO72PRODUCTDBL_KEY = $00069020;
+ EURO72EXTRALORESHAMDBL_KEY = $00061800;
+ EURO72LORESHAMDBL_KEY = $00069800;
+ EURO72PRODUCTHAMDBL_KEY = $00069820;
+ EURO72EXTRALORESEHBDBL_KEY = $00061080;
+ EURO72LORESEHBDBL_KEY = $00069080;
+ EURO72PRODUCTEHBDBL_KEY = $000690a0;
+
+
+ EURO36_MONITOR_ID = $00071000;
+
+{ Euro36 modeids can be ORed with the default modeids a la NTSC and PAL.
+ * For example, Euro36 SuperHires is
+ * (EURO36_MONITOR_ID OR SUPER_KEY)
+ }
+
+ SUPER72_MONITOR_ID = $00081000;
+
+{ Super72 modeids can be ORed with the default modeids a la NTSC and PAL.
+ * For example, Super72 SuperHiresLace (80$600) is
+ * (SUPER72_MONITOR_ID OR SUPERLACE_KEY).
+ * The following scandoubled Modes are the exception:
+ }
+ SUPER72LORESDBL_KEY = $00081008;
+ SUPER72HIRESDBL_KEY = $00089008;
+ SUPER72SUPERDBL_KEY = $00089028;
+ SUPER72LORESHAMDBL_KEY = $00081808;
+ SUPER72HIRESHAMDBL_KEY = $00089808;
+ SUPER72SUPERHAMDBL_KEY = $00089828;
+ SUPER72LORESEHBDBL_KEY = $00081088;
+ SUPER72HIRESEHBDBL_KEY = $00089088;
+ SUPER72SUPEREHBDBL_KEY = $000890a8;
+
+
+{ These monitors and modes were added for the V39 release. }
+
+ DBLNTSC_MONITOR_ID = $00091000;
+
+ DBLNTSCLORES_KEY = $00091000;
+ DBLNTSCLORESFF_KEY = $00091004;
+ DBLNTSCLORESHAM_KEY = $00091800;
+ DBLNTSCLORESHAMFF_KEY = $00091804;
+ DBLNTSCLORESEHB_KEY = $00091080;
+ DBLNTSCLORESEHBFF_KEY = $00091084;
+ DBLNTSCLORESLACE_KEY = $00091005;
+ DBLNTSCLORESHAMLACE_KEY = $00091805;
+ DBLNTSCLORESEHBLACE_KEY = $00091085;
+ DBLNTSCLORESDPF_KEY = $00091400;
+ DBLNTSCLORESDPFFF_KEY = $00091404;
+ DBLNTSCLORESDPFLACE_KEY = $00091405;
+ DBLNTSCLORESDPF2_KEY = $00091440;
+ DBLNTSCLORESDPF2FF_KEY = $00091444;
+ DBLNTSCLORESDPF2LACE_KEY = $00091445;
+ DBLNTSCHIRES_KEY = $00099000;
+ DBLNTSCHIRESFF_KEY = $00099004;
+ DBLNTSCHIRESHAM_KEY = $00099800;
+ DBLNTSCHIRESHAMFF_KEY = $00099804;
+ DBLNTSCHIRESLACE_KEY = $00099005;
+ DBLNTSCHIRESHAMLACE_KEY = $00099805;
+ DBLNTSCHIRESEHB_KEY = $00099080;
+ DBLNTSCHIRESEHBFF_KEY = $00099084;
+ DBLNTSCHIRESEHBLACE_KEY = $00099085;
+ DBLNTSCHIRESDPF_KEY = $00099400;
+ DBLNTSCHIRESDPFFF_KEY = $00099404;
+ DBLNTSCHIRESDPFLACE_KEY = $00099405;
+ DBLNTSCHIRESDPF2_KEY = $00099440;
+ DBLNTSCHIRESDPF2FF_KEY = $00099444;
+ DBLNTSCHIRESDPF2LACE_KEY = $00099445;
+ DBLNTSCEXTRALORES_KEY = $00091200;
+ DBLNTSCEXTRALORESHAM_KEY = $00091a00;
+ DBLNTSCEXTRALORESEHB_KEY = $00091280;
+ DBLNTSCEXTRALORESDPF_KEY = $00091600;
+ DBLNTSCEXTRALORESDPF2_KEY = $00091640;
+ DBLNTSCEXTRALORESFF_KEY = $00091204;
+ DBLNTSCEXTRALORESHAMFF_KEY = $00091a04;
+ DBLNTSCEXTRALORESEHBFF_KEY = $00091284;
+ DBLNTSCEXTRALORESDPFFF_KEY = $00091604;
+ DBLNTSCEXTRALORESDPF2FF_KEY = $00091644;
+ DBLNTSCEXTRALORESLACE_KEY = $00091205;
+ DBLNTSCEXTRALORESHAMLACE_KEY = $00091a05;
+ DBLNTSCEXTRALORESEHBLACE_KEY = $00091285;
+ DBLNTSCEXTRALORESDPFLACE_KEY = $00091605;
+ DBLNTSCEXTRALORESDPF2LACE_KEY = $00091645;
+
+ DBLPAL_MONITOR_ID = $000a1000;
+
+ DBLPALLORES_KEY = $000a1000;
+ DBLPALLORESFF_KEY = $000a1004;
+ DBLPALLORESHAM_KEY = $000a1800;
+ DBLPALLORESHAMFF_KEY = $000a1804;
+ DBLPALLORESEHB_KEY = $000a1080;
+ DBLPALLORESEHBFF_KEY = $000a1084;
+ DBLPALLORESLACE_KEY = $000a1005;
+ DBLPALLORESHAMLACE_KEY = $000a1805;
+ DBLPALLORESEHBLACE_KEY = $000a1085;
+ DBLPALLORESDPF_KEY = $000a1400;
+ DBLPALLORESDPFFF_KEY = $000a1404;
+ DBLPALLORESDPFLACE_KEY = $000a1405;
+ DBLPALLORESDPF2_KEY = $000a1440;
+ DBLPALLORESDPF2FF_KEY = $000a1444;
+ DBLPALLORESDPF2LACE_KEY = $000a1445;
+ DBLPALHIRES_KEY = $000a9000;
+ DBLPALHIRESFF_KEY = $000a9004;
+ DBLPALHIRESHAM_KEY = $000a9800;
+ DBLPALHIRESHAMFF_KEY = $000a9804;
+ DBLPALHIRESLACE_KEY = $000a9005;
+ DBLPALHIRESHAMLACE_KEY = $000a9805;
+ DBLPALHIRESEHB_KEY = $000a9080;
+ DBLPALHIRESEHBFF_KEY = $000a9084;
+ DBLPALHIRESEHBLACE_KEY = $000a9085;
+ DBLPALHIRESDPF_KEY = $000a9400;
+ DBLPALHIRESDPFFF_KEY = $000a9404;
+ DBLPALHIRESDPFLACE_KEY = $000a9405;
+ DBLPALHIRESDPF2_KEY = $000a9440;
+ DBLPALHIRESDPF2FF_KEY = $000a9444;
+ DBLPALHIRESDPF2LACE_KEY = $000a9445;
+ DBLPALEXTRALORES_KEY = $000a1200;
+ DBLPALEXTRALORESHAM_KEY = $000a1a00;
+ DBLPALEXTRALORESEHB_KEY = $000a1280;
+ DBLPALEXTRALORESDPF_KEY = $000a1600;
+ DBLPALEXTRALORESDPF2_KEY = $000a1640;
+ DBLPALEXTRALORESFF_KEY = $000a1204;
+ DBLPALEXTRALORESHAMFF_KEY = $000a1a04;
+ DBLPALEXTRALORESEHBFF_KEY = $000a1284;
+ DBLPALEXTRALORESDPFFF_KEY = $000a1604;
+ DBLPALEXTRALORESDPF2FF_KEY = $000a1644;
+ DBLPALEXTRALORESLACE_KEY = $000a1205;
+ DBLPALEXTRALORESHAMLACE_KEY = $000a1a05;
+ DBLPALEXTRALORESEHBLACE_KEY = $000a1285;
+ DBLPALEXTRALORESDPFLACE_KEY = $000a1605;
+ DBLPALEXTRALORESDPF2LACE_KEY = $000a1645;
+
+
+{ Use these tags for passing to BestModeID() (V39) }
+
+ SPECIAL_FLAGS = $100E;
+ { Original:
+ SPECIAL_FLAGS = DIPF_IS_DUALPF OR DIPF_IS_PF2PRI OR DIPF_IS_HAM OR DIPF_IS_EXTRAHALFBRITE;
+ ( Mu?te aufgrund eines Fehler in PCQ ge?ndert werden )
+ }
+
+
+ BIDTAG_DIPFMustHave = $80000001; { mask of the DIPF_ flags the ModeID must have }
+ { Default - NULL }
+ BIDTAG_DIPFMustNotHave = $80000002; { mask of the DIPF_ flags the ModeID must not have }
+ { Default - SPECIAL_FLAGS }
+ BIDTAG_ViewPort = $80000003; { ViewPort for which a ModeID is sought. }
+ { Default - NULL }
+ BIDTAG_NominalWidth = $80000004; { \ together make the aspect ratio and }
+ BIDTAG_NominalHeight = $80000005; { / override the vp->Width/Height. }
+ { Default - SourceID NominalDimensionInfo,
+ * or vp->DWidth/Height, or (640 * 200),
+ * in that preferred order.
+ }
+ BIDTAG_DesiredWidth = $80000006; { \ Nominal Width and Height of the }
+ BIDTAG_DesiredHeight = $80000007; { / returned ModeID. }
+ { Default - same as Nominal }
+ BIDTAG_Depth = $80000008; { ModeID must support this depth. }
+ { Default - vp->RasInfo->BitMap->Depth or 1 }
+ BIDTAG_MonitorID = $80000009; { ModeID must use this monitor. }
+ { Default - use best monitor available }
+ BIDTAG_SourceID = $8000000a; { instead of a ViewPort. }
+ { Default - VPModeID(vp) if BIDTAG_ViewPort is
+ * specified, else leave the DIPFMustHave and
+ * DIPFMustNotHave values untouched.
+ }
+ BIDTAG_RedBits = $8000000b; { \ }
+ BIDTAG_BlueBits = $8000000c; { > Match up from the database }
+ BIDTAG_GreenBits = $8000000d; { / }
+ { Default - 4 }
+ BIDTAG_GfxPrivate = $8000000e; { Private }
+
+
+const
+
+{ bplcon0 defines }
+
+ MODE_640 = $8000;
+ PLNCNTMSK = $7; { how many bit planes? }
+ { 0 = none, 1->6 = 1->6, 7 = reserved }
+ PLNCNTSHFT = 12; { bits to shift for bplcon0 }
+ PF2PRI = $40; { bplcon2 bit }
+ COLORON = $0200; { disable color burst }
+ DBLPF = $400;
+ HOLDNMODIFY = $800;
+ INTERLACE = 4; { interlace mode for 400 }
+
+{ bplcon1 defines }
+
+ PFA_FINE_SCROLL = $F;
+ PFB_FINE_SCROLL_SHIFT = 4;
+ PF_FINE_SCROLL_MASK = $F;
+
+{ display window start and stop defines }
+
+ DIW_HORIZ_POS = $7F; { horizontal start/stop }
+ DIW_VRTCL_POS = $1FF; { vertical start/stop }
+ DIW_VRTCL_POS_SHIFT = $7;
+
+{ Data fetch start/stop horizontal position }
+
+ DFTCH_MASK = $FF;
+
+{ vposr bits }
+
+ VPOSRLOF = $8000;
+
+ { include define file for displayinfo database }
+
+{ the "public" handle to a DisplayInfoRecord }
+Type
+
+ DisplayInfoHandle = Pointer;
+
+{ datachunk type identifiers }
+
+CONST
+ DTAG_DISP = $80000000;
+ DTAG_DIMS = $80001000;
+ DTAG_MNTR = $80002000;
+ DTAG_NAME = $80003000;
+ DTAG_VEC = $80004000; { internal use only }
+
+Type
+
+ pQueryHeader = ^tQueryHeader;
+ tQueryHeader = record
+ tructID, { datachunk type identifier }
+ DisplayID, { copy of display record key }
+ SkipID, { TAG_SKIP -- see tagitems.h }
+ Length : Cardinal; { length of local data in double-longwords }
+ END;
+
+ pDisplayInfo = ^tDisplayInfo;
+ tDisplayInfo = record
+ Header : tQueryHeader;
+ NotAvailable : Word; { IF NULL available, else see defines }
+ PropertyFlags : Cardinal; { Properties of this mode see defines }
+ Resolution : tPoint; { ticks-per-pixel X/Y }
+ PixelSpeed : Word; { aproximation in nanoseconds }
+ NumStdSprites : Word; { number of standard amiga sprites }
+ PaletteRange : Word; { distinguishable shades available }
+ SpriteResolution : tPoint; { std sprite ticks-per-pixel X/Y }
+ pad : Array[0..3] of Byte;
+ RedBits : Byte;
+ GreenBits : Byte;
+ BlueBits : Byte;
+ pad2 : array [0..4] of Byte;
+ reserved : Array[0..1] of Cardinal; { terminator }
+ END;
+
+{ availability }
+
+CONST
+ DI_AVAIL_NOCHIPS =$0001;
+ DI_AVAIL_NOMONITOR =$0002;
+ DI_AVAIL_NOTWITHGENLOCK =$0004;
+
+{ mode properties }
+
+ DIPF_IS_LACE = $00000001;
+ DIPF_IS_DUALPF = $00000002;
+ DIPF_IS_PF2PRI = $00000004;
+ DIPF_IS_HAM = $00000008;
+
+ DIPF_IS_ECS = $00000010; { note: ECS modes (SHIRES, VGA, AND **
+ PRODUCTIVITY) do not support **
+ attached sprites. **
+ }
+ DIPF_IS_AA = $00010000; { AA modes - may only be available
+ ** if machine has correct memory
+ ** type to support required
+ ** bandwidth - check availability.
+ ** (V39)
+ }
+ DIPF_IS_PAL = $00000020;
+ DIPF_IS_SPRITES = $00000040;
+ DIPF_IS_GENLOCK = $00000080;
+
+ DIPF_IS_WB = $00000100;
+ DIPF_IS_DRAGGABLE = $00000200;
+ DIPF_IS_PANELLED = $00000400;
+ DIPF_IS_BEAMSYNC = $00000800;
+
+ DIPF_IS_EXTRAHALFBRITE = $00001000;
+
+{ The following DIPF_IS_... flags are new for V39 }
+ DIPF_IS_SPRITES_ATT = $00002000; { supports attached sprites }
+ DIPF_IS_SPRITES_CHNG_RES = $00004000; { supports variable sprite resolution }
+ DIPF_IS_SPRITES_BORDER = $00008000; { sprite can be displayed in the border }
+ DIPF_IS_SCANDBL = $00020000; { scan doubled }
+ DIPF_IS_SPRITES_CHNG_BASE = $00040000;
+ { can change the sprite base colour }
+ DIPF_IS_SPRITES_CHNG_PRI = $00080000;
+ { can change the sprite priority
+ ** with respect to the playfield(s).
+ }
+ DIPF_IS_DBUFFER = $00100000; { can support double buffering }
+ DIPF_IS_PROGBEAM = $00200000; { is a programmed beam-sync mode }
+ DIPF_IS_FOREIGN = $80000000; { this mode is not native to the Amiga }
+
+Type
+ pDimensionInfo =^tDimensionInfo;
+ tDimensionInfo = record
+ Header : tQueryHeader;
+ MaxDepth, { log2( max number of colors ) }
+ MinRasterWidth, { minimum width in pixels }
+ MinRasterHeight, { minimum height in pixels }
+ MaxRasterWidth, { maximum width in pixels }
+ MaxRasterHeight : Word; { maximum height in pixels }
+ Nominal, { "standard" dimensions }
+ MaxOScan, { fixed, hardware dependant }
+ VideoOScan, { fixed, hardware dependant }
+ TxtOScan, { editable via preferences }
+ StdOScan : tRectangle; { editable via preferences }
+ pad : Array[0..13] of Byte;
+ reserved : Array[0..1] of Longint; { terminator }
+ END;
+
+ pMonitorInfo = ^tMonitorInfo;
+ tMonitorInfo = record
+ Header : tQueryHeader;
+ Mspc : pMonitorSpec; { pointer to monitor specification }
+ ViewPosition, { editable via preferences }
+ ViewResolution : tPoint; { standard monitor ticks-per-pixel }
+ ViewPositionRange : tRectangle; { fixed, hardware dependant }
+ TotalRows, { display height in scanlines }
+ TotalColorClocks, { scanline width in 280 ns units }
+ MinRow : Word; { absolute minimum active scanline }
+ Compatibility : smallint; { how this coexists with others }
+ pad : Array[0..31] of Byte;
+ MouseTicks : tPoint;
+ DefaultViewPosition : tPoint;
+ PreferredModeID : Cardinal;
+ reserved : Array[0..1] of Cardinal; { terminator }
+ END;
+
+{ monitor compatibility }
+
+CONST
+ MCOMPAT_MIXED = 0; { can share display with other MCOMPAT_MIXED }
+ MCOMPAT_SELF = 1; { can share only within same monitor }
+ MCOMPAT_NOBODY= -1; { only one viewport at a time }
+
+ DISPLAYNAMELEN = 32;
+
+Type
+ pNameInfo = ^tNameInfo;
+ tNameInfo = record
+ Header : tQueryHeader;
+ Name : Array[0..DISPLAYNAMELEN-1] of Char;
+ reserved : Array[0..1] of Cardinal; { terminator }
+ END;
+
+
+{****************************************************************************}
+
+{ The following VecInfo structure is PRIVATE, for our use only
+ * Touch these, and burn! (V39)
+ }
+Type
+ pVecInfo = ^tVecInfo;
+ tVecInfo = record
+ Header : tQueryHeader;
+ Vec : Pointer;
+ Data : Pointer;
+ vi_Type : WORD; { Type in C Includes }
+ pad : Array[0..2] of WORD;
+ reserved : Array[0..1] of Cardinal;
+ end;
+
+
+CONST
+ VTAG_END_CM = $00000000;
+ VTAG_CHROMAKEY_CLR = $80000000;
+ VTAG_CHROMAKEY_SET = $80000001;
+ VTAG_BITPLANEKEY_CLR = $80000002;
+ VTAG_BITPLANEKEY_SET = $80000003;
+ VTAG_BORDERBLANK_CLR = $80000004;
+ VTAG_BORDERBLANK_SET = $80000005;
+ VTAG_BORDERNOTRANS_CLR = $80000006;
+ VTAG_BORDERNOTRANS_SET = $80000007;
+ VTAG_CHROMA_PEN_CLR = $80000008;
+ VTAG_CHROMA_PEN_SET = $80000009;
+ VTAG_CHROMA_PLANE_SET = $8000000A;
+ VTAG_ATTACH_CM_SET = $8000000B;
+ VTAG_NEXTBUF_CM = $8000000C;
+ VTAG_BATCH_CM_CLR = $8000000D;
+ VTAG_BATCH_CM_SET = $8000000E;
+ VTAG_NORMAL_DISP_GET = $8000000F;
+ VTAG_NORMAL_DISP_SET = $80000010;
+ VTAG_COERCE_DISP_GET = $80000011;
+ VTAG_COERCE_DISP_SET = $80000012;
+ VTAG_VIEWPORTEXTRA_GET = $80000013;
+ VTAG_VIEWPORTEXTRA_SET = $80000014;
+ VTAG_CHROMAKEY_GET = $80000015;
+ VTAG_BITPLANEKEY_GET = $80000016;
+ VTAG_BORDERBLANK_GET = $80000017;
+ VTAG_BORDERNOTRANS_GET = $80000018;
+ VTAG_CHROMA_PEN_GET = $80000019;
+ VTAG_CHROMA_PLANE_GET = $8000001A;
+ VTAG_ATTACH_CM_GET = $8000001B;
+ VTAG_BATCH_CM_GET = $8000001C;
+ VTAG_BATCH_ITEMS_GET = $8000001D;
+ VTAG_BATCH_ITEMS_SET = $8000001E;
+ VTAG_BATCH_ITEMS_ADD = $8000001F;
+ VTAG_VPMODEID_GET = $80000020;
+ VTAG_VPMODEID_SET = $80000021;
+ VTAG_VPMODEID_CLR = $80000022;
+ VTAG_USERCLIP_GET = $80000023;
+ VTAG_USERCLIP_SET = $80000024;
+ VTAG_USERCLIP_CLR = $80000025;
+{ The following tags are V39 specific. They will be ignored (returing error -3) by
+ earlier versions }
+ VTAG_PF1_BASE_GET = $80000026;
+ VTAG_PF2_BASE_GET = $80000027;
+ VTAG_SPEVEN_BASE_GET = $80000028;
+ VTAG_SPODD_BASE_GET = $80000029;
+ VTAG_PF1_BASE_SET = $8000002a;
+ VTAG_PF2_BASE_SET = $8000002b;
+ VTAG_SPEVEN_BASE_SET = $8000002c;
+ VTAG_SPODD_BASE_SET = $8000002d;
+ VTAG_BORDERSPRITE_GET = $8000002e;
+ VTAG_BORDERSPRITE_SET = $8000002f;
+ VTAG_BORDERSPRITE_CLR = $80000030;
+ VTAG_SPRITERESN_SET = $80000031;
+ VTAG_SPRITERESN_GET = $80000032;
+ VTAG_PF1_TO_SPRITEPRI_SET = $80000033;
+ VTAG_PF1_TO_SPRITEPRI_GET = $80000034;
+ VTAG_PF2_TO_SPRITEPRI_SET = $80000035;
+ VTAG_PF2_TO_SPRITEPRI_GET = $80000036;
+ VTAG_IMMEDIATE = $80000037;
+ VTAG_FULLPALETTE_SET = $80000038;
+ VTAG_FULLPALETTE_GET = $80000039;
+ VTAG_FULLPALETTE_CLR = $8000003A;
+ VTAG_DEFSPRITERESN_SET = $8000003B;
+ VTAG_DEFSPRITERESN_GET = $8000003C;
+
+{ all the following tags follow the new, rational standard for videocontrol tags:
+ * VC_xxx,state set the state of attribute 'xxx' to value 'state'
+ * VC_xxx_QUERY,&var get the state of attribute 'xxx' and store it into the longword
+ * pointed to by &var.
+ *
+ * The following are new for V40:
+ }
+
+ VC_IntermediateCLUpdate = $80000080;
+ { default=true. When set graphics will update the intermediate copper
+ * lists on color changes, etc. When false, it won't, and will be faster.
+ }
+ VC_IntermediateCLUpdate_Query = $80000081;
+
+ VC_NoColorPaletteLoad = $80000082;
+ { default = false. When set, graphics will only load color 0
+ * for this ViewPort, and so the ViewPort's colors will come
+ * from the previous ViewPort's.
+ *
+ * NB - Using this tag and VTAG_FULLPALETTE_SET together is undefined.
+ }
+ VC_NoColorPaletteLoad_Query = $80000083;
+
+ VC_DUALPF_Disable = $80000084;
+ { default = false. When this flag is set, the dual-pf bit
+ in Dual-Playfield screens will be turned off. Even bitplanes
+ will still come from the first BitMap and odd bitplanes
+ from the second BitMap, and both R[xy]Offsets will be
+ considered. This can be used (with appropriate palette
+ selection) for cross-fades between differently scrolling
+ images.
+ When this flag is turned on, colors will be loaded for
+ the viewport as if it were a single viewport of depth
+ depth1+depth2 }
+ VC_DUALPF_Disable_Query = $80000085;
+
+
+const
+
+ SPRITE_ATTACHED = $80;
+
+type
+
+ pSimpleSprite = ^tSimpleSprite;
+ tSimpleSprite = record
+ posctldata : Pointer;
+ height : Word;
+ x,y : Word; { current position }
+ num : Word;
+ end;
+
+ pExtSprite = ^tExtSprite;
+ tExtSprite = record
+ es_SimpleSprite : tSimpleSprite; { conventional simple sprite structure }
+ es_wordwidth : WORD; { graphics use only, subject to change }
+ es_flags : WORD; { graphics use only, subject to change }
+ end;
+
+const
+{ tags for AllocSpriteData() }
+ SPRITEA_Width = $81000000;
+ SPRITEA_XReplication = $81000002;
+ SPRITEA_YReplication = $81000004;
+ SPRITEA_OutputHeight = $81000006;
+ SPRITEA_Attached = $81000008;
+ SPRITEA_OldDataFormat = $8100000a; { MUST pass in outputheight if using this tag }
+
+{ tags for GetExtSprite() }
+ GSTAG_SPRITE_NUM = $82000020;
+ GSTAG_ATTACHED = $82000022;
+ GSTAG_SOFTSPRITE = $82000024;
+
+{ tags valid for either GetExtSprite or ChangeExtSprite }
+ GSTAG_SCANDOUBLED = $83000000; { request "NTSC-Like" height if possible. }
+
+
+Type
+ pBitScaleArgs = ^tBitScaleArgs;
+ tBitScaleArgs = record
+ bsa_SrcX, bsa_SrcY, { source origin }
+ bsa_SrcWidth, bsa_SrcHeight, { source size }
+ bsa_XSrcFactor, bsa_YSrcFactor, { scale factor denominators }
+ bsa_DestX, bsa_DestY, { destination origin }
+ bsa_DestWidth, bsa_DestHeight, { destination size result }
+ bsa_XDestFactor, bsa_YDestFactor : Word; { scale factor numerators }
+ bsa_SrcBitMap, { source BitMap }
+ bsa_DestBitMap : pBitMap; { destination BitMap }
+ bsa_Flags : Cardinal; { reserved. Must be zero! }
+ bsa_XDDA, bsa_YDDA : Word; { reserved }
+ bsa_Reserved1,
+ bsa_Reserved2 : Longint;
+ END;
+
+ { tag definitions for GetRPAttr, SetRPAttr }
+
+const
+ RPTAG_Font = $80000000; { get/set font }
+ RPTAG_APen = $80000002; { get/set apen }
+ RPTAG_BPen = $80000003; { get/set bpen }
+ RPTAG_DrMd = $80000004; { get/set draw mode }
+ RPTAG_OutlinePen = $80000005; { get/set outline pen. corrected case. }
+ RPTAG_WriteMask = $80000006; { get/set WriteMask }
+ RPTAG_MaxPen = $80000007; { get/set maxpen }
+
+ RPTAG_DrawBounds = $80000008; { get only rastport draw bounds. pass &rect }
+
+
+
+
+TYPE
+
+ pRegionRectangle = ^tRegionRectangle;
+ tRegionRectangle = record
+ Next, Prev : pRegionRectangle;
+ bounds : tRectangle;
+ END;
+
+ pRegion = ^tRegion;
+ tRegion = record
+ bounds : tRectangle;
+ RegionRectangle : pRegionRectangle;
+ END;
+
+type
+
+ pGfxBase = ^tGfxBase;
+ tGfxBase = record
+ LibNode : tLibrary;
+ ActiView : pView; { ViewPtr }
+ copinit : pcopinit; { (copinitptr) ptr to copper start up list }
+ cia : Pointer; { for 8520 resource use }
+ blitter : Pointer; { for future blitter resource use }
+ LOFlist : Pointer;
+ SHFlist : Pointer;
+ blthd,
+ blttl : pbltnode;
+ bsblthd,
+ bsblttl : pbltnode; { Previous four are (bltnodeptr) }
+ vbsrv,
+ timsrv,
+ bltsrv : tInterrupt;
+ TextFonts : tList;
+ DefaultFont : pTextFont; { TextFontPtr }
+ Modes : Word; { copy of current first bplcon0 }
+ VBlank : Shortint;
+ Debug : Shortint;
+ BeamSync : smallint;
+ system_bplcon0 : smallint; { it is ored into each bplcon0 for display }
+ SpriteReserved : Byte;
+ bytereserved : Byte;
+ Flags : Word;
+ BlitLock : smallint;
+ BlitNest : smallint;
+
+ BlitWaitQ : tList;
+ BlitOwner : pTask; { TaskPtr }
+ TOF_WaitQ : tList;
+ DisplayFlags : Word; { NTSC PAL GENLOC etc}
+
+ { Display flags are determined at power on }
+
+ SimpleSprites : Pointer; { SimpleSpritePtr ptr }
+ MaxDisplayRow : Word; { hardware stuff, do not use }
+ MaxDisplayColumn : Word; { hardware stuff, do not use }
+ NormalDisplayRows : Word;
+ NormalDisplayColumns : Word;
+
+ { the following are for standard non interlace, 1/2 wb width }
+
+ NormalDPMX : Word; { Dots per meter on display }
+ NormalDPMY : Word; { Dots per meter on display }
+ LastChanceMemory : pSignalSemaphore; { SignalSemaphorePtr }
+ LCMptr : Pointer;
+ MicrosPerLine : Word; { 256 time usec/line }
+ MinDisplayColumn : Word;
+ ChipRevBits0 : Byte;
+ MemType : Byte;
+ crb_reserved : Array[0..3] of Byte;
+ monitor_id : Word; { normally null }
+ hedley : Array[0..7] of Cardinal;
+ hedley_sprites : Array[0..7] of Cardinal; { sprite ptrs for intuition mouse }
+ hedley_sprites1 : Array[0..7] of Cardinal; { sprite ptrs for intuition mouse }
+ hedley_count : smallint;
+ hedley_flags : Word;
+ hedley_tmp : smallint;
+ hash_table : Pointer;
+ current_tot_rows : Word;
+ current_tot_cclks : Word;
+ hedley_hint : Byte;
+ hedley_hint2 : Byte;
+ nreserved : Array[0..3] of Cardinal;
+ a2024_sync_raster : Pointer;
+ control_delta_pal : Word;
+ control_delta_ntsc : Word;
+ current_monitor : pMonitorSpec;
+ MonitorList : tList;
+ default_monitor : pMonitorSpec;
+ MonitorListSemaphore : pSignalSemaphore;
+ DisplayInfoDataBase : Pointer;
+ TopLine : Word;
+ ActiViewCprSemaphore : pSignalSemaphore;
+ UtilityBase : Pointer; { for hook AND tag utilities }
+ ExecBase : Pointer; { to link with rom.lib }
+ bwshifts : Pointer;
+ StrtFetchMasks,
+ StopFetchMasks,
+ Overrun,
+ RealStops : Pointer;
+ SpriteWidth, { current width (in words) of sprites }
+ SpriteFMode : WORD; { current sprite fmode bits }
+ SoftSprites, { bit mask of size change knowledgeable sprites }
+ arraywidth : Shortint;
+ DefaultSpriteWidth : WORD; { what width intuition wants }
+ SprMoveDisable : Shortint;
+ WantChips,
+ BoardMemType,
+ Bugs : Byte;
+ gb_LayersBase : Pointer;
+ ColorMask : Cardinal;
+ IVector,
+ IData : Pointer;
+ SpecialCounter : Cardinal; { special for double buffering }
+ DBList : Pointer;
+ MonitorFlags : WORD;
+ ScanDoubledSprites,
+ BP3Bits : Byte;
+ MonitorVBlank : tAnalogSignalInterval;
+ natural_monitor : pMonitorSpec;
+ ProgData : Pointer;
+ ExtSprites : Byte;
+ pad3 : Byte;
+ GfxFlags : WORD;
+ VBCounter : Cardinal;
+ HashTableSemaphore : pSignalSemaphore;
+ HWEmul : Array[0..8] of Pointer;
+ end;
+
+const
+
+ NTSC = 1;
+ GENLOC = 2;
+ PAL = 4;
+ TODA_SAFE = 8;
+
+ BLITMSG_FAULT = 4;
+
+{ bits defs for ChipRevBits }
+ GFXB_BIG_BLITS = 0 ;
+ GFXB_HR_AGNUS = 0 ;
+ GFXB_HR_DENISE = 1 ;
+ GFXB_AA_ALICE = 2 ;
+ GFXB_AA_LISA = 3 ;
+ GFXB_AA_MLISA = 4 ; { internal use only. }
+
+ GFXF_BIG_BLITS = 1 ;
+ GFXF_HR_AGNUS = 1 ;
+ GFXF_HR_DENISE = 2 ;
+ GFXF_AA_ALICE = 4 ;
+ GFXF_AA_LISA = 8 ;
+ GFXF_AA_MLISA = 16; { internal use only }
+
+{ Pass ONE of these to SetChipRev() }
+ SETCHIPREV_A = GFXF_HR_AGNUS;
+ SETCHIPREV_ECS = (GFXF_HR_AGNUS OR GFXF_HR_DENISE);
+ SETCHIPREV_AA = (GFXF_AA_ALICE OR GFXF_AA_LISA OR SETCHIPREV_ECS);
+ SETCHIPREV_BEST= $ffffffff;
+
+{ memory type }
+ BUS_16 = 0;
+ NML_CAS = 0;
+ BUS_32 = 1;
+ DBL_CAS = 2;
+ BANDWIDTH_1X = (BUS_16 OR NML_CAS);
+ BANDWIDTH_2XNML= BUS_32;
+ BANDWIDTH_2XDBL= DBL_CAS;
+ BANDWIDTH_4X = (BUS_32 OR DBL_CAS);
+
+{ GfxFlags (private) }
+ NEW_DATABASE = 1;
+
+ GRAPHICSNAME : PChar = 'graphics.library';
+
+
+var
+ GfxBase : Pointer;
+
+
+function BltBitMap(srcBitMap : pBitMap location 'a0'; xSrc : LongInt location 'd0'; ySrc : LongInt location 'd1'; destBitMap : pBitMap location 'a1'; xDest : LongInt location 'd2'; yDest : LongInt location 'd3'; xSize : LongInt location 'd4'; ySize : LongInt location 'd5'; minterm : CARDINAL location 'd6'; mask : CARDINAL location 'd7'; tempA : pCHAR location 'a2') : LongInt;
+SysCall GfxBase 030;
+
+procedure BltTemplate(source : pCHAR location 'a0'; xSrc : LongInt location 'd0'; srcMod : LongInt location 'd1'; destRP : pRastPort location 'a1'; xDest : LongInt location 'd2'; yDest : LongInt location 'd3'; xSize : LongInt location 'd4'; ySize : LongInt location 'd5');
+SysCall GfxBase 036;
+
+procedure ClearEOL(rp : pRastPort location 'a1');
+SysCall GfxBase 042;
+
+procedure ClearScreen(rp : pRastPort location 'a1');
+SysCall GfxBase 048;
+
+function TextLength(rp : pRastPort location 'a1'; string1 : pSHORTINT location 'a0'; count : CARDINAL location 'd0') : INTEGER;
+SysCall GfxBase 054;
+
+function Text(rp : pRastPort location 'a1'; string1: pSHORTINT location 'a0'; count : CARDINAL location 'd0') : LongInt;
+SysCall GfxBase 060;
+
+function SetFont(rp : pRastPort location 'a1'; textFont : pTextFont location 'a0') : LongInt;
+SysCall GfxBase 066;
+
+function OpenFont(textAttr : pTextAttr location 'a0') : pTextFont;
+SysCall GfxBase 072;
+
+procedure CloseFont(textFont : pTextFont location 'a1');
+SysCall GfxBase 078;
+
+function AskSoftStyle(rp : pRastPort location 'a1') : CARDINAL;
+SysCall GfxBase 084;
+
+function SetSoftStyle(rp : pRastPort location 'a1'; style : CARDINAL location 'd0'; enable : CARDINAL location 'd1') : CARDINAL;
+SysCall GfxBase 090;
+
+procedure AddBob(bob : pBob location 'a0'; rp : pRastPort location 'a1');
+SysCall GfxBase 096;
+
+procedure AddVSprite(vSprite : pVSprite location 'a0'; rp : pRastPort location 'a1');
+SysCall GfxBase 102;
+
+procedure DoCollision(rp : pRastPort location 'a1');
+SysCall GfxBase 108;
+
+procedure DrawGList(rp : pRastPort location 'a1'; vp : pViewPort location 'a0');
+SysCall GfxBase 114;
+
+procedure InitGels(head : pVSprite location 'a0'; tail : pVSprite location 'a1'; gelsInfo : pGelsInfo location 'a2');
+SysCall GfxBase 120;
+
+procedure InitMasks(vSprite : pVSprite location 'a0');
+SysCall GfxBase 126;
+
+procedure RemIBob(bob : pBob location 'a0'; rp : pRastPort location 'a1'; vp : pViewPort location 'a2');
+SysCall GfxBase 132;
+
+procedure RemVSprite(vSprite : pVSprite location 'a0');
+SysCall GfxBase 138;
+
+procedure SortGList(rp : pRastPort location 'a1');
+SysCall GfxBase 150;
+
+procedure AddAnimOb(anOb : pAnimOb location 'a0'; anKey : ppAnimOb location 'a1'; rp : pRastPort location 'a2');
+SysCall GfxBase 156;
+
+procedure Animate(anKey : ppAnimOb location 'a0'; rp : pRastPort location 'a1');
+SysCall GfxBase 162;
+
+function GetGBuffers(anOb : pAnimOb location 'a0'; rp : pRastPort location 'a1'; flag : LongInt location 'd0') : BOOLEAN;
+SysCall GfxBase 168;
+
+procedure InitGMasks(anOb : pAnimOb location 'a0');
+SysCall GfxBase 174;
+
+procedure DrawEllipse(rp : pRastPort location 'a1'; xCenter : LongInt location 'd0'; yCenter : LongInt location 'd1'; a : LongInt location 'd2'; b : LongInt location 'd3');
+SysCall GfxBase 180;
+
+function AreaEllipse(rp : pRastPort location 'a1'; xCenter : LongInt location 'd0'; yCenter : LongInt location 'd1'; a : LongInt location 'd2'; b : LongInt location 'd3') : LongInt;
+SysCall GfxBase 186;
+
+procedure LoadRGB4(vp : pViewPort location 'a0'; VAR colors : Integer location 'a1'; count : LongInt location 'd0');
+SysCall GfxBase 192;
+
+procedure InitRastPort(rp : pRastPort location 'a1');
+SysCall GfxBase 198;
+
+procedure InitVPort(vp : pViewPort location 'a0');
+SysCall GfxBase 204;
+
+function MrgCop(view : pView location 'a1') : CARDINAL;
+SysCall GfxBase 210;
+
+function MakeVPort(view : pView location 'a0'; vp : pViewPort location 'a1') : CARDINAL;
+SysCall GfxBase 216;
+
+procedure LoadView(view : pView location 'a1');
+SysCall GfxBase 222;
+
+procedure WaitBlit;
+SysCall GfxBase 228;
+
+procedure SetRast(rp : pRastPort location 'a1'; pen : CARDINAL location 'd0');
+SysCall GfxBase 234;
+
+procedure Move(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1');
+SysCall GfxBase 240;
+
+procedure Draw(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1');
+SysCall GfxBase 246;
+
+function AreaMove(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1') : LongInt;
+SysCall GfxBase 252;
+
+function AreaDraw(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1') : LongInt;
+SysCall GfxBase 258;
+
+function AreaEnd(rp : pRastPort location 'a1') : LongInt;
+SysCall GfxBase 264;
+
+procedure WaitTOF;
+SysCall GfxBase 270;
+
+procedure QBlit(blit : pbltnode location 'a1');
+SysCall GfxBase 276;
+
+procedure InitArea(areaInfo : pAreaInfo location 'a0'; vectorBuffer : POINTER location 'a1'; maxVectors : LongInt location 'd0');
+SysCall GfxBase 282;
+
+procedure SetRGB4(vp : pViewPort location 'a0'; index : LongInt location 'd0'; red : CARDINAL location 'd1'; green : CARDINAL location 'd2'; blue : CARDINAL location 'd3');
+SysCall GfxBase 288;
+
+procedure QBSBlit(blit : pbltnode location 'a1');
+SysCall GfxBase 294;
+
+procedure BltClear(memBlock : pCHAR location 'a1'; byteCount : CARDINAL location 'd0'; flags : CARDINAL location 'd1');
+SysCall GfxBase 300;
+
+procedure RectFill(rp : pRastPort location 'a1'; xMin : LongInt location 'd0'; yMin : LongInt location 'd1'; xMax : LongInt location 'd2'; yMax : LongInt location 'd3');
+SysCall GfxBase 306;
+
+procedure BltPattern(rp : pRastPort location 'a1'; mask : pCHAR location 'a0'; xMin : LongInt location 'd0'; yMin : LongInt location 'd1'; xMax : LongInt location 'd2'; yMax : LongInt location 'd3'; maskBPR : CARDINAL location 'd4');
+SysCall GfxBase 312;
+
+function ReadPixel(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1') : CARDINAL;
+SysCall GfxBase 318;
+
+function WritePixel(rp : pRastPort location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1') : LongInt;
+SysCall GfxBase 324;
+
+function Flood(rp : pRastPort location 'a1'; mode : CARDINAL location 'd2'; x : LongInt location 'd0'; y : LongInt location 'd1') : BOOLEAN;
+SysCall GfxBase 330;
+
+procedure PolyDraw(rp : pRastPort location 'a1'; count : LongInt location 'd0'; VAR polyTable : INTEGER location 'a0');
+SysCall GfxBase 336;
+
+procedure SetAPen(rp : pRastPort location 'a1'; pen : CARDINAL location 'd0');
+SysCall GfxBase 342;
+
+procedure SetBPen(rp : pRastPort location 'a1'; pen : CARDINAL location 'd0');
+SysCall GfxBase 348;
+
+procedure SetDrMd(rp : pRastPort location 'a1'; drawMode : CARDINAL location 'd0');
+SysCall GfxBase 354;
+
+procedure InitView(view : pView location 'a1');
+SysCall GfxBase 360;
+
+procedure CBump(copList : pUCopList location 'a1');
+SysCall GfxBase 366;
+
+procedure CMove(copList : pUCopList location 'a1'; destination : POINTER location 'd0'; data : LongInt location 'd1');
+SysCall GfxBase 372;
+
+procedure CWait(copList : pUCopList location 'a1'; v : LongInt location 'd0'; h : LongInt location 'd1');
+SysCall GfxBase 378;
+
+function VBeamPos : LongInt;
+SysCall GfxBase 384;
+
+procedure InitBitMap(bitMap : pBitMap location 'a0'; depth : LongInt location 'd0'; width : LongInt location 'd1'; height : LongInt location 'd2');
+SysCall GfxBase 390;
+
+procedure ScrollRaster(rp : pRastPort location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1'; xMin : LongInt location 'd2'; yMin : LongInt location 'd3'; xMax : LongInt location 'd4'; yMax : LongInt location 'd5');
+SysCall GfxBase 396;
+
+procedure WaitBOVP(vp : pViewPort location 'a0');
+SysCall GfxBase 402;
+
+function GetSprite(sprite : pSimpleSprite location 'a0'; num : LongInt location 'd0') : INTEGER;
+SysCall GfxBase 408;
+
+procedure FreeSprite(num : LongInt location 'd0');
+SysCall GfxBase 414;
+
+procedure ChangeSprite(vp : pViewPort location 'a0'; sprite : pSimpleSprite location 'a1'; VAR newData : Integer location 'a2');
+SysCall GfxBase 420;
+
+procedure MoveSprite(vp : pViewPort location 'a0'; sprite : pSimpleSprite location 'a1'; x : LongInt location 'd0'; y : LongInt location 'd1');
+SysCall GfxBase 426;
+
+procedure LockLayerRom(layer : pLayer location 'a5');
+SysCall GfxBase 432;
+
+procedure UnlockLayerRom(layer : pLayer location 'a5');
+SysCall GfxBase 438;
+
+procedure SyncSBitMap(layer : pLayer location 'a0');
+SysCall GfxBase 444;
+
+procedure CopySBitMap(layer : pLayer location 'a0');
+SysCall GfxBase 450;
+
+procedure OwnBlitter;
+SysCall GfxBase 456;
+
+procedure DisownBlitter;
+SysCall GfxBase 462;
+
+function InitTmpRas(tmpRas : pTmpRas location 'a0'; buffer : pCHAR location 'a1'; size : LongInt location 'd0') : pTmpRas;
+SysCall GfxBase 468;
+
+procedure AskFont(rp : pRastPort location 'a1'; textAttr : pTextAttr location 'a0');
+SysCall GfxBase 474;
+
+procedure AddFont(textFont : pTextFont location 'a1');
+SysCall GfxBase 480;
+
+procedure RemFont(textFont : pTextFont location 'a1');
+SysCall GfxBase 486;
+
+function AllocRaster(width : CARDINAL location 'd0'; height : CARDINAL location 'd1') : pCHAR;
+SysCall GfxBase 492;
+
+procedure FreeRaster(p : pCHAR location 'a0'; width : CARDINAL location 'd0'; height : CARDINAL location 'd1');
+SysCall GfxBase 498;
+
+procedure AndRectRegion(region : pRegion location 'a0'; rectangle : pRectangle location 'a1');
+SysCall GfxBase 504;
+
+function OrRectRegion(region : pRegion location 'a0'; rectangle : pRectangle location 'a1') : BOOLEAN;
+SysCall GfxBase 510;
+
+function NewRegion : pRegion;
+SysCall GfxBase 516;
+
+function ClearRectRegion(region : pRegion location 'a0'; rectangle : pRectangle location 'a1') : BOOLEAN;
+SysCall GfxBase 522;
+
+procedure ClearRegion(region : pRegion location 'a0');
+SysCall GfxBase 528;
+
+procedure DisposeRegion(region : pRegion location 'a0');
+SysCall GfxBase 534;
+
+procedure FreeVPortCopLists(vp : pViewPort location 'a0');
+SysCall GfxBase 540;
+
+procedure FreeCopList(copList : pCopList location 'a0');
+SysCall GfxBase 546;
+
+procedure ClipBlit(srcRP : pRastPort location 'a0'; xSrc : LongInt location 'd0'; ySrc : LongInt location 'd1'; destRP : pRastPort location 'a1'; xDest : LongInt location 'd2'; yDest : LongInt location 'd3'; xSize : LongInt location 'd4'; ySize : LongInt location 'd5'; minterm : CARDINAL location 'd6');
+SysCall GfxBase 552;
+
+function XorRectRegion(region : pRegion location 'a0'; rectangle : pRectangle location 'a1') : BOOLEAN;
+SysCall GfxBase 558;
+
+procedure FreeCprList(cprList : pcprlist location 'a0');
+SysCall GfxBase 564;
+
+function GetColorMap(entries : LongInt location 'd0') : pColorMap;
+SysCall GfxBase 570;
+
+procedure FreeColorMap(colorMap : pColorMap location 'a0');
+SysCall GfxBase 576;
+
+function GetRGB4(colorMap : pColorMap location 'a0'; entry : LongInt location 'd0') : CARDINAL;
+SysCall GfxBase 582;
+
+procedure ScrollVPort(vp : pViewPort location 'a0');
+SysCall GfxBase 588;
+
+function UCopperListInit(uCopList : pUCopList location 'a0'; n : LongInt location 'd0') : pCopList;
+SysCall GfxBase 594;
+
+procedure FreeGBuffers(anOb : pAnimOb location 'a0'; rp : pRastPort location 'a1'; flag : LongInt location 'd0');
+SysCall GfxBase 600;
+
+procedure BltBitMapRastPort(srcBitMap : pBitMap location 'a0'; xSrc : LongInt location 'd0'; ySrc : LongInt location 'd1'; destRP : pRastPort location 'a1'; xDest : LongInt location 'd2'; yDest : LongInt location 'd3'; xSize : LongInt location 'd4'; ySize : LongInt location 'd5'; minterm : CARDINAL location 'd6');
+SysCall GfxBase 606;
+
+function OrRegionRegion(srcRegion : pRegion location 'a0'; destRegion : pRegion location 'a1') : BOOLEAN;
+SysCall GfxBase 612;
+
+function XorRegionRegion(srcRegion : pRegion location 'a0'; destRegion : pRegion location 'a1') : BOOLEAN;
+SysCall GfxBase 618;
+
+function AndRegionRegion(srcRegion : pRegion location 'a0'; destRegion : pRegion location 'a1') : BOOLEAN;
+SysCall GfxBase 624;
+
+procedure SetRGB4CM(colorMap : pColorMap location 'a0'; index : LongInt location 'd0'; red : CARDINAL location 'd1'; green : CARDINAL location 'd2'; blue : CARDINAL location 'd3');
+SysCall GfxBase 630;
+
+procedure BltMaskBitMapRastPort(srcBitMap : pBitMap location 'a0'; xSrc : LongInt location 'd0'; ySrc : LongInt location 'd1'; destRP : pRastPort location 'a1'; xDest : LongInt location 'd2'; yDest : LongInt location 'd3'; xSize : LongInt location 'd4'; ySize : LongInt location 'd5'; minterm : CARDINAL location 'd6'; bltMask : pCHAR location 'a2');
+SysCall GfxBase 636;
+
+function AttemptLockLayerRom(layer : pLayer location 'a5') : BOOLEAN;
+SysCall GfxBase 654;
+
+function GfxNew(gfxNodeType : CARDINAL location 'd0') : POINTER;
+SysCall GfxBase 660;
+
+procedure GfxFree(gfxNodePtr : POINTER location 'a0');
+SysCall GfxBase 666;
+
+procedure GfxAssociate(associateNode : POINTER location 'a0'; gfxNodePtr : POINTER location 'a1');
+SysCall GfxBase 672;
+
+procedure BitMapScale(bitScaleArgs : pBitScaleArgs location 'a0');
+SysCall GfxBase 678;
+
+function ScalerDiv(factor : CARDINAL location 'd0'; numerator : CARDINAL location 'd1'; denominator : CARDINAL location 'd2') : Integer;
+SysCall GfxBase 684;
+
+function TextExtent(rp : pRastPort location 'a1'; string1: pSHORTINT location 'a0'; count : LongInt location 'd0'; textExtent : pTextExtent location 'a2') : INTEGER;
+SysCall GfxBase 690;
+
+function TextFit(rp : pRastPort location 'a1'; string1: pSHORTINT location 'a0'; strLen : CARDINAL location 'd0'; textExtent : pTextExtent location 'a2'; constrainingExtent : pTextExtent location 'a3'; strDirection : LongInt location 'd1'; constrainingBitWidth : CARDINAL location 'd2'; constrainingBitHeight : CARDINAL location 'd3') : CARDINAL;
+SysCall GfxBase 696;
+
+function GfxLookUp(associateNode : POINTER location 'a0') : POINTER;
+SysCall GfxBase 702;
+
+function VideoControl(colorMap : pColorMap location 'a0'; tagarray : pTagItem location 'a1') : BOOLEAN;
+SysCall GfxBase 708;
+
+function OpenMonitor(monitorName : pSHORTINT location 'a1'; displayID : CARDINAL location 'd0') : pMonitorSpec;
+SysCall GfxBase 714;
+
+function CloseMonitor(monitorSpec : pMonitorSpec location 'a0') : BOOLEAN;
+SysCall GfxBase 720;
+
+function FindDisplayInfo(displayID : CARDINAL location 'd0') : POINTER;
+SysCall GfxBase 726;
+
+function NextDisplayInfo(displayID : CARDINAL location 'd0') : CARDINAL;
+SysCall GfxBase 732;
+
+function GetDisplayInfoData(handle : POINTER location 'a0'; buf : POINTER location 'a1'; size : CARDINAL location 'd0'; tagID : CARDINAL location 'd1'; displayID : CARDINAL location 'd2') : CARDINAL;
+SysCall GfxBase 756;
+
+procedure FontExtent(font : pTextFont location 'a0'; fontExtent : pTextExtent location 'a1');
+SysCall GfxBase 762;
+
+function ReadPixelLine8(rp : pRastPort location 'a0'; xstart : CARDINAL location 'd0'; ystart : CARDINAL location 'd1'; width : CARDINAL location 'd2'; array1 : pCHAR location 'a2'; tempRP : pRastPort location 'a1') : LongInt;
+SysCall GfxBase 768;
+
+function WritePixelLine8(rp : pRastPort location 'a0'; xstart : CARDINAL location 'd0'; ystart : CARDINAL location 'd1'; width : CARDINAL location 'd2'; array1 : pCHAR location 'a2'; tempRP : pRastPort location 'a1') : LongInt;
+SysCall GfxBase 774;
+
+function ReadPixelArray8(rp : pRastPort location 'a0'; xstart : CARDINAL location 'd0'; ystart : CARDINAL location 'd1'; xstop : CARDINAL location 'd2'; ystop : CARDINAL location 'd3'; array1: pCHAR location 'a2'; temprp : pRastPort location 'a1') : LongInt;
+SysCall GfxBase 780;
+
+function WritePixelArray8(rp : pRastPort location 'a0'; xstart : CARDINAL location 'd0'; ystart : CARDINAL location 'd1'; xstop : CARDINAL location 'd2'; ystop : CARDINAL location 'd3'; array1: pCHAR location 'a2'; temprp : pRastPort location 'a1') : LongInt;
+SysCall GfxBase 786;
+
+function GetVPModeID(vp : pViewPort location 'a0') : LongInt;
+SysCall GfxBase 792;
+
+function ModeNotAvailable(modeID : CARDINAL location 'd0') : LongInt;
+SysCall GfxBase 798;
+
+function WeighTAMatch(reqTextAttr : pTTextAttr location 'a0'; targetTextAttr : pTextAttr location 'a1'; targetTags : pTagItem location 'a2') : INTEGER;
+SysCall GfxBase 804;
+
+procedure EraseRect(rp : pRastPort location 'a1'; xMin : LongInt location 'd0'; yMin : LongInt location 'd1'; xMax : LongInt location 'd2'; yMax : LongInt location 'd3');
+SysCall GfxBase 810;
+
+function ExtendFont(font : pTextFont location 'a0'; fontTags : pTagItem location 'a1') : CARDINAL;
+SysCall GfxBase 816;
+
+procedure StripFont(font : pTextFont location 'a0');
+SysCall GfxBase 822;
+
+function CalcIVG(v : pView location 'a0'; vp : pViewPort location 'a1') : Integer;
+SysCall GfxBase 828;
+
+function AttachPalExtra(cm : pColorMap location 'a0'; vp : pViewPort location 'a1') : LongInt;
+SysCall GfxBase 834;
+
+function ObtainBestPenA(cm : pColorMap location 'a0'; r : CARDINAL location 'd1'; g : CARDINAL location 'd2'; b : CARDINAL location 'd3'; tags : pTagItem location 'a1') : LongInt;
+SysCall GfxBase 840;
+
+procedure SetRGB32(vp : pViewPort location 'a0'; n : CARDINAL location 'd0'; r : CARDINAL location 'd1'; g : CARDINAL location 'd2'; b : CARDINAL location 'd3');
+SysCall GfxBase 852;
+
+function GetAPen(rp : pRastPort location 'a0') : CARDINAL;
+SysCall GfxBase 858;
+
+function GetBPen(rp : pRastPort location 'a0') : CARDINAL;
+SysCall GfxBase 864;
+
+function GetDrMd(rp : pRastPort location 'a0') : CARDINAL;
+SysCall GfxBase 870;
+
+function GetOutlinePen(rp : pRastPort location 'a0') : CARDINAL;
+SysCall GfxBase 876;
+
+procedure LoadRGB32(vp : pViewPort location 'a0'; VAR table : CARDINAL location 'a1');
+SysCall GfxBase 882;
+
+function SetChipRev(want : CARDINAL location 'd0') : CARDINAL;
+SysCall GfxBase 888;
+
+procedure SetABPenDrMd(rp : pRastPort location 'a1'; apen : CARDINAL location 'd0'; bpen : CARDINAL location 'd1'; drawmode : CARDINAL location 'd2');
+SysCall GfxBase 894;
+
+procedure GetRGB32(cm : pColorMap location 'a0'; firstcolor : CARDINAL location 'd0'; ncolors : CARDINAL location 'd1'; VAR table : CARDINAL location 'a1');
+SysCall GfxBase 900;
+
+function AllocBitMap(sizex : CARDINAL location 'd0'; sizey : CARDINAL location 'd1'; depth : CARDINAL location 'd2'; flags : CARDINAL location 'd3'; friend_bitmap : pBitMap location 'a0') : pBitMap;
+SysCall GfxBase 918;
+
+procedure FreeBitMap(bm : pBitMap location 'a0');
+SysCall GfxBase 924;
+
+function GetExtSpriteA(ss : pExtSprite location 'a2'; tags : pTagItem location 'a1') : LongInt;
+SysCall GfxBase 930;
+
+function CoerceMode(vp : pViewPort location 'a0'; monitorid : CARDINAL location 'd0'; flags : CARDINAL location 'd1') : CARDINAL;
+SysCall GfxBase 936;
+
+procedure ChangeVPBitMap(vp : pViewPort location 'a0'; bm : pBitMap location 'a1'; db : pDBufInfo location 'a2');
+SysCall GfxBase 942;
+
+procedure ReleasePen(cm : pColorMap location 'a0'; n : CARDINAL location 'd0');
+SysCall GfxBase 948;
+
+function ObtainPen(cm : pColorMap location 'a0'; n : CARDINAL location 'd0'; r : CARDINAL location 'd1'; g : CARDINAL location 'd2'; b : CARDINAL location 'd3'; f : LongInt location 'd4') : CARDINAL;
+SysCall GfxBase 954;
+
+function GetBitMapAttr(bm : pBitMap location 'a0'; attrnum : CARDINAL location 'd1') : CARDINAL;
+SysCall GfxBase 960;
+
+function AllocDBufInfo(vp : pViewPort location 'a0') : pDBufInfo;
+SysCall GfxBase 966;
+
+procedure FreeDBufInfo(dbi : pDBufInfo location 'a1');
+SysCall GfxBase 972;
+
+function SetOutlinePen(rp : pRastPort location 'a0'; pen : CARDINAL location 'd0') : CARDINAL;
+SysCall GfxBase 978;
+
+function SetWriteMask(rp : pRastPort location 'a0'; msk : CARDINAL location 'd0') : CARDINAL;
+SysCall GfxBase 984;
+
+procedure SetMaxPen(rp : pRastPort location 'a0'; maxpen : CARDINAL location 'd0');
+SysCall GfxBase 990;
+
+procedure SetRGB32CM(cm : pColorMap location 'a0'; n : CARDINAL location 'd0'; r : CARDINAL location 'd1'; g : CARDINAL location 'd2'; b : CARDINAL location 'd3');
+SysCall GfxBase 996;
+
+procedure ScrollRasterBF(rp : pRastPort location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1'; xMin : LongInt location 'd2'; yMin : LongInt location 'd3'; xMax : LongInt location 'd4'; yMax : LongInt location 'd5');
+SysCall GfxBase 1002;
+
+function FindColor(cm : pColorMap location 'a3'; r : CARDINAL location 'd1'; g : CARDINAL location 'd2'; b : CARDINAL location 'd3'; maxcolor : LongInt location 'd4') : LongInt;
+SysCall GfxBase 1008;
+
+function AllocSpriteDataA(bm : pBitMap location 'a2'; tags : pTagItem location 'a1') : pExtSprite;
+SysCall GfxBase 1020;
+
+function ChangeExtSpriteA(vp : pViewPort location 'a0'; oldsprite : pExtSprite location 'a1'; newsprite : pExtSprite location 'a2'; tags : pTagItem location 'a3') : LongInt;
+SysCall GfxBase 1026;
+
+procedure FreeSpriteData(sp : pExtSprite location 'a2');
+SysCall GfxBase 1032;
+
+procedure SetRPAttrsA(rp : pRastPort location 'a0'; tags : pTagItem location 'a1');
+SysCall GfxBase 1038;
+
+procedure GetRPAttrsA(rp : pRastPort location 'a0'; tags : pTagItem location 'a1');
+SysCall GfxBase 1044;
+
+function BestModeIDA(tags : pTagItem location 'a0') : CARDINAL;
+SysCall GfxBase 1050;
+
+procedure WriteChunkyPixels(rp : pRastPort location 'a0'; xstart : CARDINAL location 'd0'; ystart : CARDINAL location 'd1'; xstop : CARDINAL location 'd2'; ystop : CARDINAL location 'd3'; array1: pCHAR location 'a2'; bytesperrow : LongInt location 'd4');
+SysCall GfxBase 1056;
+
+function OpenFontTagList(textattr : pTextAttr location 'a0'; tags : pTagItem location 'a1') : pTextFont;
+SysCall GfxBase 1062;
+
+
+{ gfxmacros }
+procedure BNDRYOFF (w: pRastPort);
+procedure InitAnimate (animkey: ppAnimOb);
+procedure SetAfPt(w: pRastPort;p: Pointer; n: Byte);
+procedure SetDrPt(w: pRastPort;p: Word);
+procedure SetOPen(w: pRastPort;c: Byte);
+procedure SetWrMsk(w: pRastPort; m: Byte);
+
+procedure SafeSetOutlinePen(w : pRastPort; c : byte);
+procedure SafeSetWriteMask( w : pRastPort ; m : smallint ) ;
+
+procedure OFF_DISPLAY (cust: pCustom);
+procedure ON_DISPLAY (cust: pCustom);
+procedure OFF_SPRITE (cust: pCustom);
+procedure ON_SPRITE (cust: pCustom);
+procedure OFF_VBLANK (cust: pCustom);
+procedure ON_VBLANK (cust: pCustom);
+
+{ unit/library initialization }
+function InitGraphicsLibrary : boolean;
+
+
+
+implementation
+
+
+procedure BNDRYOFF (w: pRastPort);
+begin
+ with w^ do Flags := Flags And (Not AREAOUTLINE);
+end;
+
+procedure InitAnimate (animkey: ppAnimOb);
+begin
+ animkey^ := NIL;
+end;
+
+procedure SetAfPt(w: pRastPort;p: Pointer; n: Byte);
+begin
+ with w^ do begin
+ ArePointern := p;
+ AreaPtSz := n;
+ end;
+end;
+
+procedure SetDrPt(w: pRastPort;p: Word);
+begin
+ with w^ do begin
+ LinePtrn := p;
+ Flags := Flags or FRST_doT;
+ linpatcnt := 15;
+ end;
+end;
+
+procedure SetOPen(w: pRastPort;c: Byte);
+begin
+ with w^ do begin
+ AOlPen := c;
+ Flags := Flags or AREAOUTLINE;
+ end;
+end;
+
+{ This function is fine, but For OS39 the SetWriteMask() gfx function
+ should be prefered because it SHOULD operate with gfx boards as well.
+ At least I hope it does.... }
+procedure SetWrMsk(w: pRastPort; m: Byte);
+begin
+ w^.Mask := m;
+end;
+
+procedure SafeSetOutlinePen(w : pRastPort; c : byte);
+begin
+ IF pGfxBase(GfxBase)^.LibNode.Lib_Version < 39 THEN begin
+ w^.AOlPen := c;
+ w^.Flags := w^.Flags or AREAOUTLINE;
+ end ELSE begin
+ c := SetOutlinePen(w,c);
+ end;
+end;
+
+procedure SafeSetWriteMask( w : pRastPort ; m : smallint ) ;
+ VAR x : smallint ;
+begin
+ IF pGfxBase(GfxBase)^.LibNode.Lib_Version < 39 THEN w^.Mask := BYTE(m)
+ ELSE x := SetWriteMask( w, m );
+end;
+
+procedure OFF_DISPLAY (cust: pCustom);
+begin
+ cust^.dmacon := BITCLR or DMAF_RASTER;
+end;
+
+procedure ON_DISPLAY (cust: pCustom);
+begin
+ cust^.dmacon := BITSET or DMAF_RASTER;
+end;
+
+procedure OFF_SPRITE (cust: pCustom);
+begin
+ cust^.dmacon := BITCLR or DMAF_SPRITE;
+end;
+
+procedure ON_SPRITE (cust: pCustom);
+begin
+ cust^.dmacon := BITSET or DMAF_SPRITE;
+end;
+
+procedure OFF_VBLANK (cust: pCustom);
+begin
+ cust^.intena := BITCLR or INTF_VERTB;
+end;
+
+procedure ON_VBLANK (cust: pCustom);
+begin
+ cust^.intena := BITSET or INTF_VERTB;
+end;
+
+
+const
+ { Change VERSION and LIBVERSION to proper values }
+ VERSION : string[2] = '50';
+ LIBVERSION : longword = 50;
+
+var
+ graphics_exit : Pointer;
+
+procedure CloseGraphicsLibrary;
+begin
+ ExitProc := graphics_exit;
+ if GfxBase <> nil then begin
+ CloseLibrary(GfxBase);
+ GfxBase := nil;
+ end;
+end;
+
+function InitGraphicsLibrary : boolean;
+begin
+ GfxBase := nil;
+ GfxBase := OpenLibrary(GRAPHICSNAME,LIBVERSION);
+ if GfxBase <> nil then begin
+ graphics_exit := ExitProc;
+ ExitProc := @CloseGraphicsLibrary;
+ InitGraphicsLibrary:=True;
+ end else begin
+ InitGraphicsLibrary:=False;
+ end;
+end;
+
+end.
+
+{
+ $Log: graphics.pas,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/hardware.pas b/rtl/morphos/hardware.pas
new file mode 100644
index 0000000000..2903a768d6
--- /dev/null
+++ b/rtl/morphos/hardware.pas
@@ -0,0 +1,590 @@
+{
+ $Id: hardware.pas,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ Hardware definitions unit for MorphOS/PowerPC
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$PACKRECORDS 2}
+unit hardware;
+
+interface
+
+uses exec;
+
+
+
+{ * adkcon bit defines
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+const
+ ADKB_SETCLR = 15;
+ ADKB_PRECOMP1 = 14;
+ ADKB_PRECOMP0 = 13;
+ ADKB_MFMPREC = 12;
+ ADKB_UARTBRK = 11;
+ ADKB_WORDSYNC = 10;
+ ADKB_MSBSYNC = 9;
+ ADKB_FAST = 8;
+ ADKB_USE3PN = 7;
+ ADKB_USE2P3 = 6;
+ ADKB_USE1P2 = 5;
+ ADKB_USE0P1 = 4;
+ ADKB_USE3VN = 3;
+ ADKB_USE2V3 = 2;
+ ADKB_USE1V2 = 1;
+ ADKB_USE0V1 = 0;
+
+const
+ ADKF_SETCLR = (1 Shl ADKB_SETCLR);
+ ADKF_PRECOMP1 = (1 Shl ADKB_PRECOMP1);
+ ADKF_PRECOMP0 = (1 Shl ADKB_PRECOMP0);
+ ADKF_MFMPREC = (1 Shl ADKB_MFMPREC);
+ ADKF_UARTBRK = (1 Shl ADKB_UARTBRK);
+ ADKF_WORDSYNC = (1 Shl ADKB_WORDSYNC);
+ ADKF_MSBSYNC = (1 Shl ADKB_MSBSYNC);
+ ADKF_FAST = (1 Shl ADKB_FAST);
+ ADKF_USE3PN = (1 Shl ADKB_USE3PN);
+ ADKF_USE2P3 = (1 Shl ADKB_USE2P3);
+ ADKF_USE1P2 = (1 Shl ADKB_USE1P2);
+ ADKF_USE0P1 = (1 Shl ADKB_USE0P1);
+ ADKF_USE3VN = (1 Shl ADKB_USE3VN);
+ ADKF_USE2V3 = (1 Shl ADKB_USE2V3);
+ ADKF_USE1V2 = (1 Shl ADKB_USE1V2);
+ ADKF_USE0V1 = (1 Shl ADKB_USE0V1);
+
+const
+ ADKF_PRE000NS = 0;
+ ADKF_PRE140NS = (ADKF_PRECOMP0);
+ ADKF_PRE280NS = (ADKF_PRECOMP1);
+ ADKF_PRE560NS = (ADKF_PRECOMP0 or ADKF_PRECOMP1);
+
+
+
+{ * blitter defines
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+const
+ HSIZEBITS = 6;
+ VSIZEBITS = (16 - HSIZEBITS);
+ HSIZEMASK = $3F;
+ VSIZEMASK = $3FF;
+
+{$IFNDEF NO_BIG_BLITS}
+ MINBYTESPERROW = 128;
+ MAXBYTESPERROW = 4096;
+{$ELSE}
+ MAXBYTESPERROW = 128;
+{$ENDIF}
+
+const
+ ABC = $80;
+ ABNC = $40;
+ ANBC = $20;
+ ANBNC = $10;
+ NABC = $8;
+ NABNC = $4;
+ NANBC = $2;
+ NANBNC = $1;
+
+const
+ A_OR_B = (ABC or ANBC or NABC or ABNC or ANBNC or NABNC);
+ A_OR_C = (ABC or NABC or ABNC or ANBC or NANBC or ANBNC);
+ A_XOR_C = (NABC or ABNC or NANBC or ANBNC);
+ A_TO_D = (ABC or ANBC or ABNC or ANBNC);
+
+const
+ BC0B_DEST = 8;
+ BC0B_SRCC = 9;
+ BC0B_SRCB = 10;
+ BC0B_SRCA = 11;
+ BC0F_DEST = (1 Shl BC0B_DEST);
+ BC0F_SRCC = (1 Shl BC0B_SRCC);
+ BC0F_SRCB = (1 Shl BC0B_SRCB);
+ BC0F_SRCA = (1 Shl BC0B_SRCA);
+
+ BC1F_DESC = 2;
+
+ DEST = BC0F_DEST;
+ SRCC = BC0F_SRCC;
+ SRCB = BC0F_SRCB;
+ SRCA = BC0F_SRCA;
+
+ ASHIFTSHIFT = 12;
+ BSHIFTSHIFT = 12;
+
+const
+ LINEMODE = $1;
+ FILL_OR = $8;
+ FILL_XOR = $10;
+ FILL_CARRYIN = $4;
+ ONEDOT = $2;
+ OVFLAG = $20;
+ SIGNFLAG = $40;
+ BLITREVERSE = $2;
+
+ SUD = $10;
+ SUL = $8;
+ AUL = $4;
+
+ OCTANT8 = 24;
+ OCTANT7 = 4;
+ OCTANT6 = 12;
+ OCTANT5 = 28;
+ OCTANT4 = 20;
+ OCTANT3 = 8;
+ OCTANT2 = 0;
+ OCTANT1 = 16;
+
+type
+ Pbltnode = ^Tbltnode;
+ Tbltnode = record
+ n : Pbltnode;
+ _function: Pointer;
+ stat : Byte;
+ blitsize : SmallInt;
+ beamsync : SmallInt;
+ cleanup : Pointer;
+ end;
+
+const
+ CLEANUP = $40;
+ CLEANME = CLEANUP;
+
+
+
+{ * byteswap routines
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+{$WARNING Byteswap macros not yet converted!}
+
+
+
+{ * cia registers and bits
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+
+type
+ PCIA = ^TCIA;
+ TCIA = record
+ ciapra : Byte;
+ pad0 : Array[0..254] of Byte;
+ ciaprb : Byte;
+ pad1 : array[0..254] of Byte;
+ ciaddra : Byte;
+ pad2 : array[0..254] of Byte;
+ ciaddrb : Byte;
+ pad3 : array[0..254] of Byte;
+ ciatalo : Byte;
+ pad4 : array[0..254] of Byte;
+ ciatahi : Byte;
+ pad5 : array[0..254] of Byte;
+ ciatblo : Byte;
+ pad6 : array[0..254] of Byte;
+ ciatbhi : Byte;
+ pad7 : array[0..254] of Byte;
+ ciatodlow: Byte;
+ pad8 : array[0..254] of Byte;
+ ciatodmid: Byte;
+ pad9 : array[0..254] of Byte;
+ ciatodhi : Byte;
+ pad10 : array[0..254] of Byte;
+ unusedreg: Byte;
+ pad11 : array[0..254] of Byte;
+ ciasdr : Byte;
+ pad12 : array[0..254] of Byte;
+ ciaicr : Byte;
+ pad13 : array[0..254] of Byte;
+ ciacra : Byte;
+ pad14 : array[0..254] of Byte;
+ ciacrb : Byte;
+ end;
+
+const
+ CIAICRB_TA = 0;
+ CIAICRB_TB = 1;
+ CIAICRB_ALRM = 2;
+ CIAICRB_SP = 3;
+ CIAICRB_FLG = 4;
+ CIAICRB_IR = 7;
+ CIAICRB_SETCLR = 7;
+
+ CIAICRF_TA = (1 Shl CIAICRB_TA);
+ CIAICRF_TB = (1 Shl CIAICRB_TB);
+ CIAICRF_ALRM = (1 Shl CIAICRB_ALRM);
+ CIAICRF_SP = (1 Shl CIAICRB_SP);
+ CIAICRF_FLG = (1 Shl CIAICRB_FLG);
+ CIAICRF_IR = (1 Shl CIAICRB_IR);
+ CIAICRF_SETCLR = (1 Shl CIAICRB_SETCLR);
+
+const
+ CIACRAB_START = 0;
+ CIACRAB_PBON = 1;
+ CIACRAB_OUTMODE = 2;
+ CIACRAB_RUNMODE = 3;
+ CIACRAB_LOAD = 4;
+ CIACRAB_INMODE = 5;
+ CIACRAB_SPMODE = 6;
+ CIACRAB_TODIN = 7;
+
+ CIACRAF_START = (1 Shl CIACRAB_START);
+ CIACRAF_PBON = (1 Shl CIACRAB_PBON);
+ CIACRAF_OUTMODE = (1 Shl CIACRAB_OUTMODE);
+ CIACRAF_RUNMODE = (1 Shl CIACRAB_RUNMODE);
+ CIACRAF_LOAD = (1 Shl CIACRAB_LOAD);
+ CIACRAF_INMODE = (1 Shl CIACRAB_INMODE);
+ CIACRAF_SPMODE = (1 Shl CIACRAB_SPMODE);
+ CIACRAF_TODIN = (1 Shl CIACRAB_TODIN);
+
+const
+ CIACRBB_START = 0;
+ CIACRBB_PBON = 1;
+ CIACRBB_OUTMODE = 2;
+ CIACRBB_RUNMODE = 3;
+ CIACRBB_LOAD = 4;
+ CIACRBB_INMODE0 = 5;
+ CIACRBB_INMODE1 = 6;
+ CIACRBB_ALARM = 7;
+
+ CIACRBF_START = (1 Shl CIACRBB_START);
+ CIACRBF_PBON = (1 Shl CIACRBB_PBON);
+ CIACRBF_OUTMODE = (1 Shl CIACRBB_OUTMODE);
+ CIACRBF_RUNMODE = (1 Shl CIACRBB_RUNMODE);
+ CIACRBF_LOAD = (1 Shl CIACRBB_LOAD);
+ CIACRBF_INMODE0 = (1 Shl CIACRBB_INMODE0);
+ CIACRBF_INMODE1 = (1 Shl CIACRBB_INMODE1);
+ CIACRBF_ALARM = (1 Shl CIACRBB_ALARM);
+
+const
+ CIACRBF_IN_PHI2 = 0;
+ CIACRBF_IN_CNT = (CIACRBF_INMODE0);
+ CIACRBF_IN_TA = (CIACRBF_INMODE1);
+ CIACRBF_IN_CNT_TA = (CIACRBF_INMODE0 or CIACRBF_INMODE1);
+
+const
+ CIAB_GAMEPORT1 = (7);
+ CIAB_GAMEPORT0 = (6);
+ CIAB_DSKRDY = (5);
+ CIAB_DSKTRACK0 = (4);
+ CIAB_DSKPROT = (3);
+ CIAB_DSKCHANGE = (2);
+ CIAB_LED = (1);
+ CIAB_OVERLAY = (0);
+
+ CIAF_GAMEPORT1 = (1 Shl CIAB_GAMEPORT1);
+ CIAF_GAMEPORT0 = (1 Shl CIAB_GAMEPORT0);
+ CIAF_DSKRDY = (1 Shl CIAB_DSKRDY);
+ CIAF_DSKTRACK0 = (1 Shl CIAB_DSKTRACK0);
+ CIAF_DSKPROT = (1 Shl CIAB_DSKPROT);
+ CIAF_DSKCHANGE = (1 Shl CIAB_DSKCHANGE);
+ CIAF_LED = (1 Shl CIAB_LED);
+ CIAF_OVERLAY = (1 Shl CIAB_OVERLAY);
+
+const
+ CIAB_COMDTR = (7);
+ CIAB_COMRTS = (6);
+ CIAB_COMCD = (5);
+ CIAB_COMCTS = (4);
+ CIAB_COMDSR = (3);
+ CIAB_PRTRSEL = (2);
+ CIAB_PRTRPOUT = (1);
+ CIAB_PRTRBUSY = (0);
+
+ CIAF_COMDTR = (1 Shl CIAB_COMDTR);
+ CIAF_COMRTS = (1 Shl CIAB_COMRTS);
+ CIAF_COMCD = (1 Shl CIAB_COMCD);
+ CIAF_COMCTS = (1 Shl CIAB_COMCTS);
+ CIAF_COMDSR = (1 Shl CIAB_COMDSR);
+ CIAF_PRTRSEL = (1 Shl CIAB_PRTRSEL);
+ CIAF_PRTRPOUT = (1 Shl CIAB_PRTRPOUT);
+ CIAF_PRTRBUSY = (1 Shl CIAB_PRTRBUSY);
+
+const
+ CIAB_DSKMOTOR = (7);
+ CIAB_DSKSEL3 = (6);
+ CIAB_DSKSEL2 = (5);
+ CIAB_DSKSEL1 = (4);
+ CIAB_DSKSEL0 = (3);
+ CIAB_DSKSIDE = (2);
+ CIAB_DSKDIREC = (1);
+ CIAB_DSKSTEP = (0);
+
+ CIAF_DSKMOTOR = (1 Shl CIAB_DSKMOTOR);
+ CIAF_DSKSEL3 = (1 Shl CIAB_DSKSEL3);
+ CIAF_DSKSEL2 = (1 Shl CIAB_DSKSEL2);
+ CIAF_DSKSEL1 = (1 Shl CIAB_DSKSEL1);
+ CIAF_DSKSEL0 = (1 Shl CIAB_DSKSEL0);
+ CIAF_DSKSIDE = (1 Shl CIAB_DSKSIDE);
+ CIAF_DSKDIREC = (1 Shl CIAB_DSKDIREC);
+ CIAF_DSKSTEP = (1 Shl CIAB_DSKSTEP);
+
+
+
+{ * custom-chip registers and bits
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+type
+ PAudChannel = ^TAudChannel;
+ TAudChannel = record
+ ac_ptr: Pointer;
+ ac_len: Word;
+ ac_per: Word;
+ ac_vol: Word;
+ ac_dat: Word;
+ ac_pad: array[0..1] of Word;
+ end;
+
+ PSpriteDef = ^TSpriteDef;
+ TSpriteDef = record
+ pos : Word;
+ ctl : Word;
+ dataa: Word;
+ datab: Word;
+ end;
+
+ PCustom = ^TCustom;
+ TCustom = record
+ bltddat : Word;
+ dmaconr : Word;
+ vposr : Word;
+ vhposr : Word;
+ dskdatr : Word;
+ joy0dat : Word;
+ joy1dat : Word;
+ clxdat : Word;
+ adkconr : Word;
+ pot0dat : Word;
+ pot1dat : Word;
+ potinp : Word;
+ serdatr : Word;
+ dskbytr : Word;
+ intenar : Word;
+ intreqr : Word;
+ dskpt : Pointer;
+ dsklen : Word;
+ dskdat : Word;
+ refptr : Word;
+ vposw : Word;
+ vhposw : Word;
+ copcon : Word;
+ serdat : Word;
+ serper : Word;
+ potgo : Word;
+ joytest : Word;
+ strequ : Word;
+ strvbl : Word;
+ strhor : Word;
+ strlong : Word;
+ bltcon0 : Word;
+ bltcon1 : Word;
+ bltafwm : Word;
+ bltalwm : Word;
+ bltcpt : Pointer;
+ bltbpt : Pointer;
+ bltapt : Pointer;
+ bltdpt : Pointer;
+ bltsize : Word;
+ pad2d : Byte;
+ bltcon0l: Byte;
+ bltsizv : Word;
+ bltsizh : Word;
+ bltcmod : Word;
+ bltbmod : Word;
+ bltamod : Word;
+ bltdmod : Word;
+ pad34 : array[0..3] of Word;
+ bltcdat : Word;
+ bltbdat : Word;
+ bltadat : Word;
+ pad3b : array[0..2] of Word;
+ deniseid: Word;
+ dsksync : Word;
+ cop1lc : Longint;
+ cop2lc : Longint;
+ copjmp1 : Word;
+ copjmp2 : Word;
+ copins : Word;
+ diwstrt : Word;
+ diwstop : Word;
+ ddfstrt : Word;
+ ddfstop : Word;
+ dmacon : Word;
+ clxcon : Word;
+ intena : Word;
+ intreq : Word;
+ adkcon : Word;
+ aud : array[0..3] of TAudChannel;
+ bplpt : array[0..7] of Pointer;
+ bplcon0 : Word;
+ bplcon1 : Word;
+ bplcon2 : Word;
+ bplcon3 : Word;
+ bpl1mod : Word;
+ bpl2mod : Word;
+ bplcon4 : Word;
+ clxcon2 : Word;
+ bpldat : array[0..7] of Word;
+ sprpt : array[0..7] of Pointer;
+ spr : array[0..7] of TSpriteDef;
+ color : array[0..31] of Word;
+ htotal : Word;
+ hsstop : Word;
+ hbstrt : Word;
+ hbstop : Word;
+ vtotal : Word;
+ vsstop : Word;
+ vbstrt : Word;
+ vbstop : Word;
+ sprhstrt: Word;
+ sprhstop: Word;
+ bplhstrt: Word;
+ bplhstop: Word;
+ hhposw : Word;
+ hhposr : Word;
+ beamcon0: Word;
+ hsstrt : Word;
+ vsstrt : Word;
+ hcenter : Word;
+ diwhigh : Word;
+ padf3 : array[0..10] of Word;
+ fmode : Word;
+ end;
+
+
+const
+ VARVBLANK = $1000;
+ LOLDIS = $0800;
+ CSCBLANKEN = $0400;
+ VARVSYNC = $0200;
+ VARHSYNC = $0100;
+ VARBEAM = $0080;
+ DISPLAYDUAL = $0040;
+ DISPLAYPAL = $0020;
+ VARCSYNC = $0010;
+ CSBLANK = $0008;
+ CSYNCTRUE = $0004;
+ VSYNCTRUE = $0002;
+ HSYNCTRUE = $0001;
+
+ USE_BPLCON3 = 1;
+
+ BPLCON2_ZDCTEN = (1 Shl 10);
+ BPLCON2_ZDBPEN = (1 Shl 11);
+ BPLCON2_ZDBPSEL0 = (1 Shl 12);
+ BPLCON2_ZDBPSEL1 = (1 Shl 13);
+ BPLCON2_ZDBPSEL2 = (1 Shl 14);
+
+ BPLCON3_EXTBLNKEN = (1 Shl 0);
+ BPLCON3_EXTBLKZD = (1 Shl 1);
+ BPLCON3_ZDCLKEN = (1 Shl 2);
+ BPLCON3_BRDNTRAN = (1 Shl 4);
+ BPLCON3_BRDNBLNK = (1 Shl 5);
+
+
+
+{ * dma bits
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+const
+ DMAB_AUD0 = 0;
+ DMAB_AUD1 = 1;
+ DMAB_AUD2 = 2;
+ DMAB_AUD3 = 3;
+ DMAB_DISK = 4;
+ DMAB_SPRITE = 5;
+ DMAB_BLITTER = 6;
+ DMAB_COPPER = 7;
+ DMAB_RASTER = 8;
+ DMAB_MASTER = 9;
+ DMAB_BLITHOG = 10;
+ DMAB_BLTNZERO = 13;
+ DMAB_BLTDONE = 14;
+ DMAB_SETCLR = 15;
+
+ DMAF_AUD0 = (1 Shl DMAB_AUD0);
+ DMAF_AUD1 = (1 Shl DMAB_AUD1);
+ DMAF_AUD2 = (1 Shl DMAB_AUD2);
+ DMAF_AUD3 = (1 Shl DMAB_AUD3);
+ DMAF_DISK = (1 Shl DMAB_DISK);
+ DMAF_SPRITE = (1 Shl DMAB_SPRITE);
+ DMAF_BLITTER = (1 Shl DMAB_BLITTER);
+ DMAF_COPPER = (1 Shl DMAB_COPPER);
+ DMAF_RASTER = (1 Shl DMAB_RASTER);
+ DMAF_MASTER = (1 Shl DMAB_MASTER);
+ DMAF_BLITHOG = (1 Shl DMAB_BLITHOG);
+ DMAF_BLTNZERO = (1 Shl DMAB_BLTNZERO);
+ DMAF_BLTDONE = (1 Shl DMAB_BLTDONE);
+ DMAF_SETCLR = (1 Shl DMAB_SETCLR);
+
+const
+ DMAF_AUDIO = (DMAF_AUD0 or DMAF_AUD1 or DMAF_AUD2 or DMAF_AUD3);
+ DMAF_ALL = (DMAF_AUD0 or DMAF_AUD1 or DMAF_AUD2 or DMAF_AUD3 or DMAF_DISK or DMAF_SPRITE or DMAF_BLITTER or DMAF_COPPER or DMAF_RASTER);
+
+
+
+{ * interrupt bits
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+const
+ INTB_SETCLR = (15);
+ INTB_INTEN = (14);
+ INTB_EXTER = (13);
+ INTB_DSKSYNC = (12);
+ INTB_RBF = (11);
+ INTB_AUD3 = (10);
+ INTB_AUD2 = (9);
+ INTB_AUD1 = (8);
+ INTB_AUD0 = (7);
+ INTB_BLIT = (6);
+ INTB_VERTB = (5);
+ INTB_COPER = (4);
+ INTB_PORTS = (3);
+ INTB_SOFTINT = (2);
+ INTB_DSKBLK = (1);
+ INTB_TBE = (0);
+
+ INTF_SETCLR = (1 Shl INTB_SETCLR);
+ INTF_INTEN = (1 Shl INTB_INTEN);
+ INTF_EXTER = (1 Shl INTB_EXTER);
+ INTF_DSKSYNC = (1 Shl INTB_DSKSYNC);
+ INTF_RBF = (1 Shl INTB_RBF);
+ INTF_AUD3 = (1 Shl INTB_AUD3);
+ INTF_AUD2 = (1 Shl INTB_AUD2);
+ INTF_AUD1 = (1 Shl INTB_AUD1);
+ INTF_AUD0 = (1 Shl INTB_AUD0);
+ INTF_BLIT = (1 Shl INTB_BLIT);
+ INTF_VERTB = (1 Shl INTB_VERTB);
+ INTF_COPER = (1 Shl INTB_COPER);
+ INTF_PORTS = (1 Shl INTB_PORTS);
+ INTF_SOFTINT = (1 Shl INTB_SOFTINT);
+ INTF_DSKBLK = (1 Shl INTB_DSKBLK);
+ INTF_TBE = (1 Shl INTB_TBE);
+
+implementation
+
+end.
+
+{
+ $Log: hardware.pas,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/inputevent.pas b/rtl/morphos/inputevent.pas
new file mode 100644
index 0000000000..5483ed3f14
--- /dev/null
+++ b/rtl/morphos/inputevent.pas
@@ -0,0 +1,220 @@
+{
+ $Id: inputevent.pas,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ input.device event definitions unit for MorphOS/PowerPC
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$PACKRECORDS 2}
+unit inputevent;
+
+interface
+
+uses exec, utility, timer;
+
+
+{ * input.device event definitions
+ * Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+ * }
+
+const
+ IECLASS_NULL = $00;
+ IECLASS_RAWKEY = $01;
+ IECLASS_RAWMOUSE = $02;
+ IECLASS_EVENT = $03;
+ IECLASS_POINTERPOS = $04;
+ IECLASS_TIMER = $06;
+ IECLASS_GADGETDOWN = $07;
+ IECLASS_GADGETUP = $08;
+ IECLASS_REQUESTER = $09;
+ IECLASS_MENULIST = $0A;
+ IECLASS_CLOSEWINDOW = $0B;
+ IECLASS_SIZEWINDOW = $0C;
+ IECLASS_REFRESHWINDOW = $0D;
+ IECLASS_NEWPREFS = $0E;
+ IECLASS_DISKREMOVED = $0F;
+ IECLASS_DISKINSERTED = $10;
+ IECLASS_ACTIVEWINDOW = $11;
+ IECLASS_INACTIVEWINDOW = $12;
+ IECLASS_NEWPOINTERPOS = $13;
+ IECLASS_MENUHELP = $14;
+ IECLASS_CHANGEWINDOW = $15;
+
+{$ifndef IECLASS_NEWMOUSE}
+ const
+ IECLASS_NEWMOUSE = $16;
+{$endif}
+
+
+const
+ IECLASS_MAX = $16;
+ IESUBCLASS_COMPATIBLE = $00;
+ IESUBCLASS_PIXEL = $01;
+ IESUBCLASS_TABLET = $02;
+ IESUBCLASS_NEWTABLET = $03;
+
+type
+ PIEPointerPixel = ^TIEPointerPixel;
+ TIEPointerPixel = record
+ iepp_Screen : Pointer;
+ iepp_Position : record
+ X : Integer;
+ Y : Integer;
+ end;
+ end;
+
+ PIEPointerTablet = ^TIEPointerTablet;
+ TIEPointerTablet = record
+ iept_Range : record
+ X : Word;
+ Y : Word;
+ end;
+ iept_Value : record
+ X : Word;
+ Y : Word;
+ end;
+ iept_Pressure : Integer;
+ end;
+
+ PIENewTablet = ^TIENewTablet;
+ TIENewTablet = record
+ ient_CallBack : PHook;
+ ient_ScaledX : Word;
+ ient_ScaledY : Word;
+ ient_ScaledXFraction : Word;
+ ient_ScaledYFraction : Word;
+ ient_TabletX : DWord;
+ ient_TabletY : DWord;
+ ient_RangeX : DWord;
+ ient_RangeY : DWord;
+ ient_TagList : PTagItem;
+ end;
+
+
+const
+ IECODE_UP_PREFIX = $80;
+ IECODE_KEY_CODE_FIRST = $00;
+ IECODE_KEY_CODE_LAST = $77;
+ IECODE_COMM_CODE_FIRST = $78;
+ IECODE_COMM_CODE_LAST = $7F;
+ IECODE_C0_FIRST = $00;
+ IECODE_C0_LAST = $1F;
+ IECODE_ASCII_FIRST = $20;
+ IECODE_ASCII_LAST = $7E;
+ IECODE_ASCII_DEL = $7F;
+ IECODE_C1_FIRST = $80;
+ IECODE_C1_LAST = $9F;
+ IECODE_LATIN1_FIRST = $A0;
+ IECODE_LATIN1_LAST = $FF;
+ IECODE_LBUTTON = $68;
+ IECODE_RBUTTON = $69;
+ IECODE_MBUTTON = $6A;
+ IECODE_NOBUTTON = $FF;
+ IECODE_NEWACTIVE = $01;
+ IECODE_NEWSIZE = $02;
+ IECODE_REFRESH = $03;
+ IECODE_REQSET = $01;
+ IECODE_REQCLEAR = $00;
+ IEQUALIFIER_LSHIFT = $0001;
+ IEQUALIFIER_RSHIFT = $0002;
+ IEQUALIFIER_CAPSLOCK = $0004;
+ IEQUALIFIER_CONTROL = $0008;
+ IEQUALIFIER_LALT = $0010;
+ IEQUALIFIER_RALT = $0020;
+ IEQUALIFIER_LCOMMAND = $0040;
+ IEQUALIFIER_RCOMMAND = $0080;
+ IEQUALIFIER_NUMERICPAD = $0100;
+ IEQUALIFIER_REPEAT = $0200;
+ IEQUALIFIER_INTERRUPT = $0400;
+ IEQUALIFIER_MULTIBROADCAST = $0800;
+ IEQUALIFIER_MIDBUTTON = $1000;
+ IEQUALIFIER_RBUTTON = $2000;
+ IEQUALIFIER_LEFTBUTTON = $4000;
+ IEQUALIFIER_RELATIVEMOUSE = $8000;
+ IEQUALIFIERB_LSHIFT = 0;
+ IEQUALIFIERB_RSHIFT = 1;
+ IEQUALIFIERB_CAPSLOCK = 2;
+ IEQUALIFIERB_CONTROL = 3;
+ IEQUALIFIERB_LALT = 4;
+ IEQUALIFIERB_RALT = 5;
+ IEQUALIFIERB_LCOMMAND = 6;
+ IEQUALIFIERB_RCOMMAND = 7;
+ IEQUALIFIERB_NUMERICPAD = 8;
+ IEQUALIFIERB_REPEAT = 9;
+ IEQUALIFIERB_INTERRUPT = 10;
+ IEQUALIFIERB_MULTIBROADCAST = 11;
+ IEQUALIFIERB_MIDBUTTON = 12;
+ IEQUALIFIERB_RBUTTON = 13;
+ IEQUALIFIERB_LEFTBUTTON = 14;
+ IEQUALIFIERB_RELATIVEMOUSE = 15;
+
+{ * NewMouse events. }
+{$ifndef NM_WHEEL_UP}
+ const
+ NM_WHEEL_UP = $7a;
+{$endif}
+{$ifndef NM_WHEEL_DOWN}
+ const
+ NM_WHEEL_DOWN = $7b;
+{$endif}
+{$ifndef NM_WHEEL_LEFT}
+ const
+ NM_WHEEL_LEFT = $7c;
+{$endif}
+{$ifndef NM_WHEEL_RIGHT}
+ const
+ NM_WHEEL_RIGHT = $7d;
+{$endif}
+{$ifndef NM_BUTTON_FOURTH}
+ const
+ NM_BUTTON_FOURTH = $7e;
+{$endif}
+
+type
+ PInputEvent = ^TInputEvent;
+ TInputEvent = record
+ ie_NextEvent : PInputEvent;
+ ie_Class : Byte;
+ ie_SubClass : Byte;
+ ie_Code : Word;
+ ie_Qualifier : Word;
+ ie_position : record
+ case longint of
+ 0 : ( ie_xy : record
+ ie_x : Integer;
+ ie_y : Integer;
+ end );
+ 1 : ( ie_addr : Pointer );
+ 2 : ( ie_dead : record
+ ie_prev1DownCode : Byte;
+ ie_prev1DownQual : Byte;
+ ie_prev2DownCode : Byte;
+ ie_prev2DownQual : Byte;
+ end );
+ end;
+ ie_TimeStamp : TTimeval;
+ end;
+
+
+implementation
+
+end.
+
+{
+ $Log: inputevent.pas,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/intuition.pas b/rtl/morphos/intuition.pas
new file mode 100644
index 0000000000..95dd61fe3e
--- /dev/null
+++ b/rtl/morphos/intuition.pas
@@ -0,0 +1,4699 @@
+{
+ $Id: intuition.pas,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ intuition.library interface unit for MorphOS/PowerPC
+
+ Based on work of Nils Sjoholm member of the Amiga RTL
+ development team.
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$PACKRECORDS 2}
+
+unit intuition;
+
+interface
+
+uses
+ exec, graphics, utility, inputevent, timer, layers;
+
+
+{
+ * NOTE: intuition/iobsolete.h is included at the END of this file!
+ }
+
+{ ======================================================================== }
+{ === IntuiText ========================================================== }
+{ ================================= ======================================= }
+{ IntuiText is a series of strings that start with a screen location
+ * (always relative to the upper-left corner of something) and then the
+ * text of the string. The text is null-terminated.
+ }
+Type
+ pIntuiText = ^tIntuiText;
+ tIntuiText = record
+ FrontPen,
+ BackPen : Byte; { the pen numbers for the rendering }
+ DrawMode : Byte; { the mode for rendering the text }
+ LeftEdge : smallint; { relative start location for the text }
+ TopEdge : smallint; { relative start location for the text }
+ ITextFont : pTextAttr; { if NULL, you accept the default }
+ IText : PChar; { pointer to null-terminated text }
+ NextText : pIntuiText; { continuation to TxWrite another text }
+ end;
+
+
+
+{ ======================================================================== }
+{ === Border ============================================================= }
+{ ======================================================================== }
+{ Data type Border, used for drawing a series of lines which is intended for
+ * use as a border drawing, but which may, in fact, be used to render any
+ * arbitrary vector shape.
+ * The routine DrawBorder sets up the RastPort with the appropriate
+ * variables, then does a Move to the first coordinate, then does Draws
+ * to the subsequent coordinates.
+ * After all the Draws are done, if NextBorder is non-zero we call DrawBorder
+ * recursively
+ }
+Type
+ pBorder = ^tBorder;
+ tBorder = record
+ LeftEdge,
+ TopEdge : smallint; { initial offsets from the origin }
+ FrontPen,
+ BackPen : Byte; { pens numbers for rendering }
+ DrawMode : Byte; { mode for rendering }
+ Count : Shortint; { number of XY pairs }
+ XY : Pointer; { vector coordinate pairs rel to LeftTop}
+ NextBorder : pBorder; { pointer to any other Border too }
+ end;
+
+{ ======================================================================== }
+{ === MenuItem =========================================================== }
+{ ======================================================================== }
+
+Type
+
+ pMenuItem = ^tMenuItem;
+ tMenuItem = record
+ NextItem : pMenuItem; { pointer to next in chained list }
+ LeftEdge,
+ TopEdge : smallint; { position of the select box }
+ Width,
+ Height : smallint; { dimensions of the select box }
+ Flags : Word; { see the defines below }
+
+ MutualExclude : Longint; { set bits mean this item excludes that }
+
+ ItemFill : Pointer; { points to Image, IntuiText, or NULL }
+
+ { when this item is pointed to by the cursor and the items highlight
+ * mode HIGHIMAGE is selected, this alternate image will be displayed
+ }
+
+ SelectFill : Pointer; { points to Image, IntuiText, or NULL }
+
+ Command : Char; { only if appliprog sets the COMMSEQ flag }
+
+ SubItem : pMenuItem; { if non-zero, DrawMenu shows "->" }
+
+ { The NextSelect field represents the menu number of next selected
+ * item (when user has drag-selected several items)
+ }
+
+ NextSelect : Word;
+ end;
+
+
+Const
+
+{ FLAGS SET BY THE APPLIPROG }
+ CHECKIT = $0001; { whether to check this item if selected }
+ ITEMTEXT = $0002; { set if textual, clear if graphical item }
+ COMMSEQ = $0004; { set if there's an command sequence }
+ MENUTOGGLE = $0008; { set to toggle the check of a menu item }
+ ITEMENABLED = $0010; { set if this item is enabled }
+
+{ these are the SPECIAL HIGHLIGHT FLAG state meanings }
+ HIGHFLAGS = $00C0; { see definitions below for these bits }
+ HIGHIMAGE = $0000; { use the user's "select image" }
+ HIGHCOMP = $0040; { highlight by complementing the selectbox }
+ HIGHBOX = $0080; { highlight by "boxing" the selectbox }
+ HIGHNONE = $00C0; { don't highlight }
+
+{ FLAGS SET BY BOTH APPLIPROG AND INTUITION }
+ CHECKED = $0100; { if CHECKIT, then set this when selected }
+
+{ FLAGS SET BY INTUITION }
+ ISDRAWN = $1000; { this item's subs are currently drawn }
+ HIGHITEM = $2000; { this item is currently highlighted }
+ MENUTOGGLED = $4000; { this item was already toggled }
+
+
+{ ======================================================================== }
+{ === Menu =============================================================== }
+{ ======================================================================== }
+Type
+
+ pMenu = ^tMenu;
+ tMenu = record
+ NextMenu : pMenu; { same level }
+ LeftEdge,
+ TopEdge : smallint; { position of the select box }
+ Width,
+ Height : smallint; { dimensions of the select box }
+ Flags : Word; { see flag definitions below }
+ MenuName : PChar; { text for this Menu Header }
+ FirstItem : pMenuItem; { pointer to first in chain }
+
+ { these mysteriously-named variables are for internal use only }
+
+ JazzX,
+ JazzY,
+ BeatX,
+ BeatY : smallint;
+ end;
+
+CONST
+{ FLAGS SET BY BOTH THE APPLIPROG AND INTUITION }
+ MENUENABLED = $0001; { whether or not this menu is enabled }
+
+{ FLAGS SET BY INTUITION }
+ MIDRAWN = $0100; { this menu's items are currently drawn }
+
+
+
+
+{ ======================================================================== }
+{ === Gadget ============================================================= }
+{ ======================================================================== }
+
+Type
+
+ pGadget = ^tGadget;
+ tGadget = record
+ NextGadget : pGadget; { next gadget in the list }
+
+ LeftEdge,
+ TopEdge : smallint; { "hit box" of gadget }
+ Width,
+ Height : smallint; { "hit box" of gadget }
+
+ Flags : Word; { see below for list of defines }
+
+ Activation : Word; { see below for list of defines }
+
+ GadgetType : Word; { see below for defines }
+
+ { appliprog can specify that the Gadget be rendered as either as Border
+ * or an Image. This variable points to which (or equals NULL if there's
+ * nothing to be rendered about this Gadget)
+ }
+
+ GadgetRender : Pointer;
+
+ { appliprog can specify "highlighted" imagery rather than algorithmic
+ * this can point to either Border or Image data
+ }
+
+ SelectRender : Pointer;
+
+ GadgetText : pIntuiText; { text for this gadget }
+
+ { by using the MutualExclude word, the appliprog can describe
+ * which gadgets mutually-exclude which other ones. The bits
+ * in MutualExclude correspond to the gadgets in object containing
+ * the gadget list. If this gadget is selected and a bit is set
+ * in this gadget's MutualExclude and the gadget corresponding to
+ * that bit is currently selected (e.g. bit 2 set and gadget 2
+ * is currently selected) that gadget must be unselected.
+ * Intuition does the visual unselecting (with checkmarks) and
+ * leaves it up to the program to unselect internally
+ }
+
+ MutualExclude : Longint; { set bits mean this gadget excludes that gadget }
+
+ { pointer to a structure of special data required by Proportional,
+ * String and Longint Gadgets
+ }
+
+ SpecialInfo : Pointer;
+
+ GadgetID : Word; { user-definable ID field }
+ UserData : Pointer; { ptr to general purpose User data (ignored by In) }
+ end;
+
+ pExtGadget = ^tExtGadget;
+ tExtGadget = record
+ { The first fields match struct Gadget exactly }
+ NextGadget : pExtGadget; { Matches struct Gadget }
+ LeftEdge, TopEdge, { Matches struct Gadget }
+ Width, Height : smallint; { Matches struct Gadget }
+ Flags, { Matches struct Gadget }
+ Activation, { Matches struct Gadget }
+ GadgetType : WORD; { Matches struct Gadget }
+ GadgetRender, { Matches struct Gadget }
+ SelectRender : Pointer; { Matches struct Gadget }
+ GadgetText : pIntuiText; { Matches struct Gadget }
+ MutualExclude : Longint; { Matches struct Gadget }
+ SpecialInfo : Pointer; { Matches struct Gadget }
+ GadgetID : WORD; { Matches struct Gadget }
+ UserData : Pointer; { Matches struct Gadget }
+
+ { These fields only exist under V39 and only if GFLG_EXTENDED is set }
+ MoreFlags : Cardinal; { see GMORE_ flags below }
+ BoundsLeftEdge, { Bounding extent for gadget, valid }
+ BoundsTopEdge, { only if GMORE_BOUNDS is set. The }
+ BoundsWidth, { GFLG_RELxxx flags affect these }
+ BoundsHeight : smallint; { coordinates as well. }
+ end;
+
+
+CONST
+{ --- Gadget.Flags values --- }
+{ combinations in these bits describe the highlight technique to be used }
+ GFLG_GADGHIGHBITS = $0003;
+ GFLG_GADGHCOMP = $0000; { Complement the select box }
+ GFLG_GADGHBOX = $0001; { Draw a box around the image }
+ GFLG_GADGHIMAGE = $0002; { Blast in this alternate image }
+ GFLG_GADGHNONE = $0003; { don't highlight }
+
+ GFLG_GADGIMAGE = $0004; { set IF GadgetRender AND SelectRender
+ * point to an Image structure, clear
+ * if they point to Border structures
+ }
+
+{ combinations in these next two bits specify to which corner the gadget's
+ * Left & Top coordinates are relative. If relative to Top/Left,
+ * these are "normal" coordinates (everything is relative to something in
+ * this universe).
+ *
+ * Gadget positions and dimensions are relative to the window or
+ * requester which contains the gadget
+ }
+ GFLG_RELBOTTOM = $0008; { vert. pos. is relative to bottom edge }
+ GFLG_RELRIGHT = $0010; { horiz. pos. is relative to right edge }
+ GFLG_RELWIDTH = $0020; { width is relative to req/window }
+ GFLG_RELHEIGHT = $0040; { height is relative to req/window }
+
+{ New for V39: GFLG_RELSPECIAL allows custom gadget implementors to
+ * make gadgets whose position and size depend in an arbitrary way
+ * on their window's dimensions. The GM_LAYOUT method will be invoked
+ * for such a gadget (or any other GREL_xxx gadget) at suitable times,
+ * such as when the window opens or the window's size changes.
+ }
+ GFLG_RELSPECIAL = $4000; { custom gadget has special relativity.
+ * Gadget box values are absolutes, but
+ * can be changed via the GM_LAYOUT method.
+ }
+
+ GFLG_SELECTED = $0080; { you may initialize AND look at this }
+
+{ the GFLG_DISABLED flag is initialized by you and later set by Intuition
+ * according to your calls to On/OffGadget(). It specifies whether or not
+ * this Gadget is currently disabled from being selected
+ }
+ GFLG_DISABLED = $0100;
+
+{ These flags specify the type of text field that Gadget.GadgetText
+ * points to. In all normal (pre-V36) gadgets which you initialize
+ * this field should always be zero. Some types of gadget objects
+ * created from classes will use these fields to keep track of
+ * types of labels/contents that different from IntuiText, but are
+ * stashed in GadgetText.
+ }
+
+ GFLG_LABELMASK = $3000;
+ GFLG_LABELITEXT = $0000; { GadgetText points to IntuiText }
+ GFLG_LABELSTRING = $1000; { GadgetText points to (UBYTE *) }
+ GFLG_LABELIMAGE = $2000; { GadgetText points to Image (object) }
+
+{ New for V37: GFLG_TABCYCLE }
+ GFLG_TABCYCLE = $0200; { (string OR custom) gadget participates in
+ * cycling activation with Tab or Shift-Tab
+ }
+{ New for V37: GFLG_STRINGEXTEND. We discovered that V34 doesn't properly
+ * ignore the value we had chosen for the Gadget->Activation flag
+ * GACT_STRINGEXTEND. NEVER SET THAT FLAG WHEN RUNNING UNDER V34.
+ * The Gadget->Flags bit GFLG_STRINGEXTEND is provided as a synonym which is
+ * safe under V34, and equivalent to GACT_STRINGEXTEND under V37.
+ * (Note that the two flags are not numerically equal)
+ }
+ GFLG_STRINGEXTEND = $0400; { this String Gadget has StringExtend }
+
+{ New for V39: GFLG_IMAGEDISABLE. This flag is automatically set if
+ * the custom image of this gadget knows how to do disabled rendering
+ * (more specifically, if its IA_SupportsDisable attribute is TRUE).
+ * Intuition uses this to defer the ghosting to the image-class,
+ * instead of doing it itself (the old compatible way).
+ * Do not set this flag yourself - Intuition will do it for you.
+ }
+
+ GFLG_IMAGEDISABLE = $0800; { Gadget's image knows how to do disabled
+ * rendering
+ }
+
+{ New for V39: If set, this bit means that the Gadget is actually
+ * a struct ExtGadget, with new fields and flags. All V39 boopsi
+ * gadgets are ExtGadgets. Never ever attempt to read the extended
+ * fields of a gadget if this flag is not set.
+ }
+ GFLG_EXTENDED = $8000; { Gadget is extended }
+
+{ --- Gadget.Activation flag values --- }
+{ Set GACT_RELVERIFY if you want to verify that the pointer was still over
+ * the gadget when the select button was released. Will cause
+ * an IDCMP_GADGETUP message to be sent if so.
+ }
+ GACT_RELVERIFY = $0001;
+
+{ the flag GACT_IMMEDIATE, when set, informs the caller that the gadget
+ * was activated when it was activated. This flag works in conjunction with
+ * the GACT_RELVERIFY flag
+ }
+ GACT_IMMEDIATE = $0002;
+
+{ the flag GACT_ENDGADGET, when set, tells the system that this gadget,
+ * when selected, causes the Requester to be ended. Requesters
+ * that are ended are erased and unlinked from the system.
+ }
+ GACT_ENDGADGET = $0004;
+
+{ the GACT_FOLLOWMOUSE flag, when set, specifies that you want to receive
+ * reports on mouse movements while this gadget is active.
+ * You probably want to set the GACT_IMMEDIATE flag when using
+ * GACT_FOLLOWMOUSE, since that's the only reasonable way you have of
+ * learning why Intuition is suddenly sending you a stream of mouse
+ * movement events. If you don't set GACT_RELVERIFY, you'll get at
+ * least one Mouse Position event.
+ }
+ GACT_FOLLOWMOUSE = $0008;
+
+{ if any of the BORDER flags are set in a Gadget that's included in the
+ * Gadget list when a Window is opened, the corresponding Border will
+ * be adjusted to make room for the Gadget
+ }
+ GACT_RIGHTBORDER = $0010;
+ GACT_LEFTBORDER = $0020;
+ GACT_TOPBORDER = $0040;
+ GACT_BOTTOMBORDER= $0080;
+ GACT_BORDERSNIFF = $8000; { neither set nor rely on this bit }
+
+ GACT_TOGGLESELECT= $0100; { this bit for toggle-select mode }
+ GACT_BOOLEXTEND = $2000; { this Boolean Gadget has a BoolInfo }
+
+{ should properly be in StringInfo, but aren't }
+ GACT_STRINGLEFT = $0000; { NOTE WELL: that this has value zero }
+ GACT_STRINGCENTER= $0200;
+ GACT_STRINGRIGHT = $0400;
+ GACT_LONGINT = $0800; { this String Gadget is for Long Ints }
+ GACT_ALTKEYMAP = $1000; { this String has an alternate keymap }
+ GACT_STRINGEXTEND= $2000; { this String Gadget has StringExtend }
+ { NOTE: NEVER SET GACT_STRINGEXTEND IF YOU
+ * ARE RUNNING ON LESS THAN V36! SEE
+ * GFLG_STRINGEXTEND (ABOVE) INSTEAD
+ }
+
+ GACT_ACTIVEGADGET = $4000; { this gadget is "active". This flag
+ * is maintained by Intuition, and you
+ * cannot count on its value persisting
+ * while you do something on your program's
+ * task. It can only be trusted by
+ * people implementing custom gadgets
+ }
+
+{ note $8000 is used above (GACT_BORDERSNIFF);
+ * all Activation flags defined }
+
+{ --- GADGET TYPES ------------------------------------------------------- }
+{ These are the Gadget Type definitions for the variable GadgetType
+ * gadget number type MUST start from one. NO TYPES OF ZERO ALLOWED.
+ * first comes the mask for Gadget flags reserved for Gadget typing
+ }
+ GTYP_GADGETTYPE = $FC00; { all Gadget Global Type flags (padded) }
+ GTYP_SYSGADGET = $8000; { 1 = Allocated by the system, 0 = by app. }
+ GTYP_SCRGADGET = $4000; { 1 = ScreenGadget, 0 = WindowGadget }
+ GTYP_GZZGADGET = $2000; { 1 = for WFLG_GIMMEZEROZERO borders }
+ GTYP_REQGADGET = $1000; { 1 = this is a Requester Gadget }
+{ system gadgets }
+ GTYP_SIZING = $0010;
+ GTYP_WDRAGGING = $0020;
+ GTYP_SDRAGGING = $0030;
+ GTYP_WUPFRONT = $0040;
+ GTYP_SUPFRONT = $0050;
+ GTYP_WDOWNBACK = $0060;
+ GTYP_SDOWNBACK = $0070;
+ GTYP_CLOSE = $0080;
+{ application gadgets }
+ GTYP_BOOLGADGET = $0001;
+ GTYP_GADGET0002 = $0002;
+ GTYP_PROPGADGET = $0003;
+ GTYP_STRGADGET = $0004;
+ GTYP_CUSTOMGADGET = $0005;
+
+
+{* GTYP_GTYPEMASK is a mask you can apply to tell what class
+ * of gadget this is. The possible classes follow.
+ *}
+ GTYP_GTYPEMASK = $0007;
+
+{ This bit in GadgetType is reserved for undocumented internal use
+ * by the Gadget Toolkit, and cannot be used nor relied on by
+ * applications: $0100;
+ }
+
+{ New for V39. Gadgets which have the GFLG_EXTENDED flag set are
+ * actually ExtGadgets, which have more flags. The GMORE_xxx
+ * identifiers describe those flags. For GMORE_SCROLLRASTER, see
+ * important information in the ScrollWindowRaster() autodoc.
+ * NB: GMORE_SCROLLRASTER must be set before the gadget is
+ * added to a window.
+ }
+ GMORE_BOUNDS = $00000001; { ExtGadget has valid Bounds }
+ GMORE_GADGETHELP = $00000002; { This gadget responds to gadget help }
+ GMORE_SCROLLRASTER = $00000004; { This (custom) gadget uses ScrollRaster }
+
+{ ======================================================================== }
+{ === BoolInfo======================================================= }
+{ ======================================================================== }
+{ This is the special data needed by an Extended Boolean Gadget
+ * Typically this structure will be pointed to by the Gadget field SpecialInfo
+ }
+Type
+ pBoolInfo = ^tBoolInfo;
+ tBoolInfo = record
+ Flags : Word; { defined below }
+ Mask : Pointer; { bit mask for highlighting and selecting
+ * mask must follow the same rules as an Image
+ * plane. It's width and height are determined
+ * by the width and height of the gadget's
+ * select box. (i.e. Gadget.Width and .Height).
+ }
+ Reserved : Cardinal; { set to 0 }
+ end;
+
+Const
+
+{ set BoolInfo.Flags to this flag bit.
+ * in the future, additional bits might mean more stuff hanging
+ * off of BoolInfo.Reserved.
+}
+ BOOLMASK = $0001; { extension is for masked gadget }
+
+{ ======================================================================== }
+{ === PropInfo =========================================================== }
+{ ======================================================================== }
+{ this is the special data required by the proportional Gadget
+ * typically, this data will be pointed to by the Gadget variable SpecialInfo
+ }
+
+Type
+
+ pPropInfo = ^tPropInfo;
+ tPropInfo = record
+ Flags : Word; { general purpose flag bits (see defines below) }
+
+ { You initialize the Pot variables before the Gadget is added to
+ * the system. Then you can look here for the current settings
+ * any time, even while User is playing with this Gadget. To
+ * adjust these after the Gadget is added to the System, use
+ * ModifyProp(); The Pots are the actual proportional settings,
+ * where a value of zero means zero and a value of MAXPOT means
+ * that the Gadget is set to its maximum setting.
+ }
+
+ HorizPot : WORD; { 16-bit FixedPoint horizontal quantity percentage }
+ VertPot : WORD; { 16-bit FixedPoint vertical quantity percentage }
+
+ { the 16-bit FixedPoint Body variables describe what percentage of
+ * the entire body of stuff referred to by this Gadget is actually
+ * shown at one time. This is used with the AUTOKNOB routines,
+ * to adjust the size of the AUTOKNOB according to how much of
+ * the data can be seen. This is also used to decide how far
+ * to advance the Pots when User hits the Container of the Gadget.
+ * For instance, if you were controlling the display of a 5-line
+ * Window of text with this Gadget, and there was a total of 15
+ * lines that could be displayed, you would set the VertBody value to
+ * (MAXBODY / (TotalLines / DisplayLines)) = MAXBODY / 3.
+ * Therefore, the AUTOKNOB would fill 1/3 of the container, and
+ * if User hits the Cotainer outside of the knob, the pot would
+ * advance 1/3 (plus or minus) If there's no body to show, or
+ * the total amount of displayable info is less than the display area,
+ * set the Body variables to the MAX. To adjust these after the
+ * Gadget is added to the System, use ModifyProp();
+ }
+
+ HorizBody : Word; { horizontal Body }
+ VertBody : Word; { vertical Body }
+
+ { these are the variables that Intuition sets and maintains }
+
+ CWidth : Word; { Container width (with any relativity absoluted) }
+ CHeight : Word; { Container height (with any relativity absoluted) }
+ HPotRes,
+ VPotRes : Word; { pot increments }
+ LeftBorder : Word; { Container borders }
+ TopBorder : Word; { Container borders }
+ end;
+
+CONST
+{ --- FLAG BITS ---------------------------------------------------------- }
+ AUTOKNOB = $0001; { this flag sez: gimme that old auto-knob }
+{ NOTE: if you do not use an AUTOKNOB for a proportional gadget,
+ * you are currently limited to using a single Image of your own
+ * design: Intuition won't handle a linked list of images as
+ * a proportional gadget knob.
+ }
+
+ FREEHORIZ = $0002; { IF set, the knob can move horizontally }
+ FREEVERT = $0004; { IF set, the knob can move vertically }
+ PROPBORDERLESS = $0008; { IF set, no border will be rendered }
+ KNOBHIT = $0100; { set when this Knob is hit }
+ PROPNEWLOOK = $0010; { set this IF you want to get the new
+ * V36 look
+ }
+
+ KNOBHMIN = 6; { minimum horizontal size of the Knob }
+ KNOBVMIN = 4; { minimum vertical size of the Knob }
+ MAXBODY = $FFFF; { maximum body value }
+ MAXPOT = $FFFF; { maximum pot value }
+
+{ ======================================================================== }
+{ === StringInfo ========================================================= }
+{ ======================================================================== }
+{ this is the special data required by the string Gadget
+ * typically, this data will be pointed to by the Gadget variable SpecialInfo
+ }
+
+Type
+
+ pStringInfo = ^tStringInfo;
+ tStringInfo = record
+ { you initialize these variables, and then Intuition maintains them }
+ Buffer : PChar; { the buffer containing the start and final string }
+ UndoBuffer : PChar; { optional buffer for undoing current entry }
+ BufferPos : smallint; { character position in Buffer }
+ MaxChars : smallint; { max number of chars in Buffer (including NULL) }
+ DispPos : smallint; { Buffer position of first displayed character }
+
+ { Intuition initializes and maintains these variables for you }
+
+ UndoPos : smallint; { character position in the undo buffer }
+ NumChars : smallint; { number of characters currently in Buffer }
+ DispCount : smallint; { number of whole characters visible in Container }
+ CLeft,
+ CTop : smallint; { topleft offset of the container }
+
+ { you can initialize this variable before the gadget is submitted to
+ * Intuition, and then examine it later to discover what Longint
+ * the user has entered (if the user never plays with the gadget,
+ * the value will be unchanged from your initial setting)
+ }
+ Extension : Pointer;
+ _LongInt : Longint;
+
+ { If you want this Gadget to use your own Console keymapping, you
+ * set the ALTKEYMAP bit in the Activation flags of the Gadget, and then
+ * set this variable to point to your keymap. If you don't set the
+ * ALTKEYMAP, you'll get the standard ASCII keymapping.
+ }
+
+ AltKeyMap : Pointer;
+ end;
+
+
+{ ======================================================================== }
+{ === Requester ========================================================== }
+{ ======================================================================== }
+
+Type
+
+ pRequester = ^tRequester;
+ tRequester = record
+ { the ClipRect and BitMap and used for rendering the requester }
+ OlderRequest : pRequester;
+ LeftEdge,
+ TopEdge : smallint; { dimensions of the entire box }
+ Width,
+ Height : smallint; { dimensions of the entire box }
+ RelLeft,
+ RelTop : smallint; { for Pointer relativity offsets }
+
+ ReqGadget : pGadget; { pointer to a list of Gadgets }
+ ReqBorder : pBorder; { the box's border }
+ ReqText : pIntuiText; { the box's text }
+ Flags : Word; { see definitions below }
+
+ { pen number for back-plane fill before draws }
+
+ BackFill : Byte;
+
+ { Layer in place of clip rect }
+
+ ReqLayer : pLayer;
+
+ ReqPad1 : Array [0..31] of Byte;
+
+ { If the BitMap plane pointers are non-zero, this tells the system
+ * that the image comes pre-drawn (if the appliprog wants to define
+ * it's own box, in any shape or size it wants!); this is OK by
+ * Intuition as long as there's a good correspondence between
+ * the image and the specified Gadgets
+ }
+
+ ImageBMap : pBitMap; { points to the BitMap of PREDRAWN imagery }
+ RWindow : Pointer; { added. points back to Window }
+ ReqImage : Pointer;
+ ReqPad2 : Array [0..31] of Shortint;
+ end;
+
+
+Const
+
+{ FLAGS SET BY THE APPLIPROG }
+ POINTREL = $0001; { if POINTREL set, TopLeft is relative to pointer}
+ PREDRAWN = $0002; { if ReqBMap points to predrawn Requester imagery }
+ NOISYREQ = $0004; { if you don't want requester to filter input }
+
+ SIMPLEREQ = $0010;
+ { to use SIMPLEREFRESH layer (recommended) }
+
+ { New for V36 }
+ USEREQIMAGE = $0020;
+ { render linked list ReqImage after BackFill
+ * but before gadgets and text
+ }
+ NOREQBACKFILL = $0040;
+ { don't bother filling requester with Requester.BackFill pen }
+
+
+{ FLAGS SET BY INTUITION }
+ REQOFFWINDOW = $1000; { part of one of the Gadgets was offwindow }
+ REQACTIVE = $2000; { this requester is active }
+ SYSREQUEST = $4000; { this requester caused by system }
+ DEFERREFRESH = $8000; { this Requester stops a Refresh broadcast }
+
+
+
+
+{ ======================================================================== }
+{ === Image ============================================================== }
+{ ======================================================================== }
+{ This is a brief image structure for very simple transfers of
+ * image data to a RastPort
+ }
+
+Type
+ pImage = ^tImage;
+ tImage = record
+ LeftEdge : smallint; { starting offset relative to some origin }
+ TopEdge : smallint; { starting offsets relative to some origin }
+ Width : smallint; { pixel size (though data is word-aligned) }
+ Height,
+ Depth : smallint; { pixel sizes }
+ ImageData : Pointer; { pointer to the actual word-aligned bits }
+
+ { the PlanePick and PlaneOnOff variables work much the same way as the
+ * equivalent GELS Bob variables. It's a space-saving
+ * mechanism for image data. Rather than defining the image data
+ * for every plane of the RastPort, you need define data only
+ * for the planes that are not entirely zero or one. As you
+ * define your Imagery, you will often find that most of the planes
+ * ARE just as color selectors. For instance, if you're designing
+ * a two-color Gadget to use colors two and three, and the Gadget
+ * will reside in a five-plane display, bit plane zero of your
+ * imagery would be all ones, bit plane one would have data that
+ * describes the imagery, and bit planes two through four would be
+ * all zeroes. Using these flags allows you to avoid wasting all
+ * that memory in this way: first, you specify which planes you
+ * want your data to appear in using the PlanePick variable. For
+ * each bit set in the variable, the next "plane" of your image
+ * data is blitted to the display. For each bit clear in this
+ * variable, the corresponding bit in PlaneOnOff is examined.
+ * If that bit is clear, a "plane" of zeroes will be used.
+ * If the bit is set, ones will go out instead. So, for our example:
+ * Gadget.PlanePick = $02;
+ * Gadget.PlaneOnOff = $01;
+ * Note that this also allows for generic Gadgets, like the
+ * System Gadgets, which will work in any number of bit planes.
+ * Note also that if you want an Image that is only a filled
+ * rectangle, you can get this by setting PlanePick to zero
+ * (pick no planes of data) and set PlaneOnOff to describe the pen
+ * color of the rectangle.
+ }
+
+ PlanePick,
+ PlaneOnOff : Byte;
+
+ { if the NextImage variable is not NULL, Intuition presumes that
+ * it points to another Image structure with another Image to be
+ * rendered
+ }
+
+ NextImage : pImage;
+ end;
+
+
+{ New for V39, Intuition supports the IESUBCLASS_NEWTABLET subclass
+ * of the IECLASS_NEWPOINTERPOS event. The ie_EventAddress of such
+ * an event points to a TabletData structure (see below).
+ *
+ * The TabletData structure contains certain elements including a taglist.
+ * The taglist can be used for special tablet parameters. A tablet driver
+ * should include only those tag-items the tablet supports. An application
+ * can listen for any tag-items that interest it. Note: an application
+ * must set the WA_TabletMessages attribute to TRUE to receive this
+ * extended information in its IntuiMessages.
+ *
+ * The definitions given here MUST be followed. Pay careful attention
+ * to normalization and the interpretation of signs.
+ *
+ * TABLETA_TabletZ: the current value of the tablet in the Z direction.
+ * This unsigned value should typically be in the natural units of the
+ * tablet. You should also provide TABLETA_RangeZ.
+ *
+ * TABLETA_RangeZ: the maximum value of the tablet in the Z direction.
+ * Normally specified along with TABLETA_TabletZ, this allows the
+ * application to scale the actual Z value across its range.
+ *
+ * TABLETA_AngleX: the angle of rotation or tilt about the X-axis. This
+ * number should be normalized to fill a signed long Longint. Positive
+ * values imply a clockwise rotation about the X-axis when viewing
+ * from +X towards the origin.
+ *
+ * TABLETA_AngleY: the angle of rotation or tilt about the Y-axis. This
+ * number should be normalized to fill a signed long Longint. Positive
+ * values imply a clockwise rotation about the Y-axis when viewing
+ * from +Y towards the origin.
+ *
+ * TABLETA_AngleZ: the angle of rotation or tilt about the Z axis. This
+ * number should be normalized to fill a signed long Longint. Positive
+ * values imply a clockwise rotation about the Z-axis when viewing
+ * from +Z towards the origin.
+ *
+ * Note: a stylus that supports tilt should use the TABLETA_AngleX
+ * and TABLETA_AngleY attributes. Tilting the stylus so the tip
+ * points towards increasing or decreasing X is actually a rotation
+ * around the Y-axis. Thus, if the stylus tip points towards
+ * positive X, then that tilt is represented as a negative
+ * TABLETA_AngleY. Likewise, if the stylus tip points towards
+ * positive Y, that tilt is represented by positive TABLETA_AngleX.
+ *
+ * TABLETA_Pressure: the pressure reading of the stylus. The pressure
+ * should be normalized to fill a signed long Longint. Typical devices
+ * won't generate negative pressure, but the possibility is not precluded.
+ * The pressure threshold which is considered to cause a button-click is
+ * expected to be set in a Preferences program supplied by the tablet
+ * vendor. The tablet driver would send IECODE_LBUTTON-type events as
+ * the pressure crossed that threshold.
+ *
+ * TABLETA_ButtonBits: ti_Data is a long Longint whose bits are to
+ * be interpreted at the state of the first 32 buttons of the tablet.
+ *
+ * TABLETA_InProximity: ti_Data is a boolean. For tablets that support
+ * proximity, they should send the (TABLETA_InProximity,FALSE) tag item
+ * when the stylus is out of proximity. One possible use we can forsee
+ * is a mouse-blanking commodity which keys off this to blank the
+ * mouse. When this tag is absent, the stylus is assumed to be
+ * in proximity.
+ *
+ * TABLETA_ResolutionX: ti_Data is an unsigned long Longint which
+ * is the x-axis resolution in dots per inch.
+ *
+ * TABLETA_ResolutionY: ti_Data is an unsigned long Longint which
+ * is the y-axis resolution in dots per inch.
+ }
+
+const
+ TABLETA_Dummy = (TAG_USER + $3A000) ;
+ TABLETA_TabletZ = (TABLETA_Dummy + $01);
+ TABLETA_RangeZ = (TABLETA_Dummy + $02);
+ TABLETA_AngleX = (TABLETA_Dummy + $03);
+ TABLETA_AngleY = (TABLETA_Dummy + $04);
+ TABLETA_AngleZ = (TABLETA_Dummy + $05);
+ TABLETA_Pressure = (TABLETA_Dummy + $06);
+ TABLETA_ButtonBits = (TABLETA_Dummy + $07);
+ TABLETA_InProximity = (TABLETA_Dummy + $08);
+ TABLETA_ResolutionX = (TABLETA_Dummy + $09);
+ TABLETA_ResolutionY = (TABLETA_Dummy + $0A);
+
+{ If your window sets WA_TabletMessages to TRUE, then it will receive
+ * extended IntuiMessages (struct ExtIntuiMessage) whose eim_TabletData
+ * field points at a TabletData structure. This structure contains
+ * additional information about the input event.
+ }
+
+Type
+ pTabletData = ^tTabletData;
+ tTabletData = record
+ { Sub-pixel position of tablet, in screen coordinates,
+ * scaled to fill a UWORD fraction:
+ }
+ td_XFraction, td_YFraction : WORD;
+
+ { Current tablet coordinates along each axis: }
+ td_TabletX, td_TabletY : Cardinal;
+
+ { Tablet range along each axis. For example, if td_TabletX
+ * can take values 0-999, td_RangeX should be 1000.
+ }
+ td_RangeX, td_RangeY : Cardinal;
+
+ { Pointer to tag-list of additional tablet attributes.
+ * See <intuition/intuition.h> for the tag values.
+ }
+ td_TagList : pTagItem;
+ end;
+
+{ If a tablet driver supplies a hook for ient_CallBack, it will be
+ * invoked in the standard hook manner. A0 will point to the Hook
+ * itself, A2 will point to the InputEvent that was sent, and
+ * A1 will point to a TabletHookData structure. The InputEvent's
+ * ie_EventAddress field points at the IENewTablet structure that
+ * the driver supplied.
+ *
+ * Based on the thd_Screen, thd_Width, and thd_Height fields, the driver
+ * should scale the ient_TabletX and ient_TabletY fields and store the
+ * result in ient_ScaledX, ient_ScaledY, ient_ScaledXFraction, and
+ * ient_ScaledYFraction.
+ *
+ * The tablet hook must currently return NULL. This is the only
+ * acceptable return-value under V39.
+ }
+
+ pTabletHookData = ^tTabletHookData;
+ tTabletHookData = record
+ { Pointer to the active screen:
+ * Note: if there are no open screens, thd_Screen will be NULL.
+ * thd_Width and thd_Height will then describe an NTSC 64$400
+ * screen. Please scale accordingly.
+ }
+ thd_Screen : Pointer;
+
+ { The width and height (measured in pixels of the active screen)
+ * that your are to scale to:
+ }
+ thd_Width,
+ thd_Height : Cardinal;
+
+ { Non-zero if the screen or something about the screen
+ * changed since the last time you were invoked:
+ }
+ thd_ScreenChanged : Longint;
+ end;
+
+
+{ ======================================================================== }
+{ === IntuiMessage ======================================================= }
+{ ======================================================================== }
+
+Type
+
+ pIntuiMessage = ^tIntuiMessage;
+ tIntuiMessage = record
+ ExecMessage : tMessage;
+
+ { the Class bits correspond directly with the IDCMP Flags, except for the
+ * special bit LONELYMESSAGE (defined below)
+ }
+
+ IClass : Cardinal;
+
+ { the Code field is for special values like MENU number }
+
+ Code : Word;
+
+ { the Qualifier field is a copy of the current InputEvent's Qualifier }
+
+ Qualifier : Word;
+
+ { IAddress contains particular addresses for Intuition functions, like
+ * the pointer to the Gadget or the Screen
+ }
+
+ IAddress : Pointer;
+
+ { when getting mouse movement reports, any event you get will have the
+ * the mouse coordinates in these variables. the coordinates are relative
+ * to the upper-left corner of your Window (GIMMEZEROZERO notwithstanding)
+ }
+
+ MouseX,
+ MouseY : smallint;
+
+ { the time values are copies of the current system clock time. Micros
+ * are in units of microseconds, Seconds in seconds.
+ }
+
+ Seconds,
+ Micros : Cardinal;
+
+ { the IDCMPWindow variable will always have the Pointer of the Window of
+ * this IDCMP
+ }
+
+ IDCMPWindow : Pointer;
+
+ { system-use variable }
+
+ SpecialLink : pIntuiMessage;
+ end;
+
+{ New for V39:
+ * All IntuiMessages are now slightly extended. The ExtIntuiMessage
+ * structure has an additional field for tablet data, which is usually
+ * NULL. If a tablet driver which is sending IESUBCLASS_NEWTABLET
+ * events is installed in the system, windows with the WA_TabletMessages
+ * property set will find that eim_TabletData points to the TabletData
+ * structure. Applications must first check that this field is non-NULL;
+ * it will be NULL for certain kinds of message, including mouse activity
+ * generated from other than the tablet (i.e. the keyboard equivalents
+ * or the mouse itself).
+ *
+ * NEVER EVER examine any extended fields when running under pre-V39!
+ *
+ * NOTE: This structure is subject to grow in the future. Making
+ * assumptions about its size is A BAD IDEA.
+ }
+
+ pExtIntuiMessage = ^tExtIntuiMessage;
+ tExtIntuiMessage = record
+ eim_IntuiMessage : tIntuiMessage;
+ eim_TabletData : pTabletData;
+ end;
+
+
+CONST
+
+{ --- IDCMP Classes ------------------------------------------------------ }
+{ Please refer to the Autodoc for OpenWindow() and to the Rom Kernel
+ * Manual for full details on the IDCMP classes.
+ }
+ IDCMP_SIZEVERIFY = $00000001;
+ IDCMP_NEWSIZE = $00000002;
+ IDCMP_REFRESHWINDOW = $00000004;
+ IDCMP_MOUSEBUTTONS = $00000008;
+ IDCMP_MOUSEMOVE = $00000010;
+ IDCMP_GADGETDOWN = $00000020;
+ IDCMP_GADGETUP = $00000040;
+ IDCMP_REQSET = $00000080;
+ IDCMP_MENUPICK = $00000100;
+ IDCMP_CLOSEWINDOW = $00000200;
+ IDCMP_RAWKEY = $00000400;
+ IDCMP_REQVERIFY = $00000800;
+ IDCMP_REQCLEAR = $00001000;
+ IDCMP_MENUVERIFY = $00002000;
+ IDCMP_NEWPREFS = $00004000;
+ IDCMP_DISKINSERTED = $00008000;
+ IDCMP_DISKREMOVED = $00010000;
+ IDCMP_WBENCHMESSAGE = $00020000; { System use only }
+ IDCMP_ACTIVEWINDOW = $00040000;
+ IDCMP_INACTIVEWINDOW = $00080000;
+ IDCMP_DELTAMOVE = $00100000;
+ IDCMP_VANILLAKEY = $00200000;
+ IDCMP_INTUITICKS = $00400000;
+{ for notifications from "boopsi" gadgets }
+ IDCMP_IDCMPUPDATE = $00800000; { new for V36 }
+{ for getting help key report during menu session }
+ IDCMP_MENUHELP = $01000000; { new for V36 }
+{ for notification of any move/size/zoom/change window }
+ IDCMP_CHANGEWINDOW = $02000000; { new for V36 }
+ IDCMP_GADGETHELP = $04000000; { new for V39 }
+
+{ NOTEZ-BIEN: $80000000 is reserved for internal use }
+
+{ the IDCMP Flags do not use this special bit, which is cleared when
+ * Intuition sends its special message to the Task, and set when Intuition
+ * gets its Message back from the Task. Therefore, I can check here to
+ * find out fast whether or not this Message is available for me to send
+ }
+ IDCMP_LONELYMESSAGE = $80000000;
+
+
+{ --- IDCMP Codes -------------------------------------------------------- }
+{ This group of codes is for the IDCMP_CHANGEWINDOW message }
+ CWCODE_MOVESIZE = $0000; { Window was moved and/or sized }
+ CWCODE_DEPTH = $0001; { Window was depth-arranged (new for V39) }
+
+{ This group of codes is for the IDCMP_MENUVERIFY function }
+ MENUHOT = $0001; { IntuiWants verification OR MENUCANCEL }
+ MENUCANCEL = $0002; { HOT Reply of this cancels Menu operation }
+ MENUWAITING = $0003; { Intuition simply wants a ReplyMsg() ASAP }
+
+{ These are internal tokens to represent state of verification attempts
+ * shown here as a clue.
+ }
+ OKOK = MENUHOT; { guy didn't care }
+ OKABORT = $0004; { window rendered question moot }
+ OKCANCEL = MENUCANCEL; { window sent cancel reply }
+
+{ This group of codes is for the IDCMP_WBENCHMESSAGE messages }
+ WBENCHOPEN = $0001;
+ WBENCHCLOSE = $0002;
+
+
+{ A data structure common in V36 Intuition processing }
+Type
+ pIBox = ^tIBox;
+ tIBox = record
+ Left,
+ Top,
+ Width,
+ Height : smallint;
+ END;
+
+
+{ ======================================================================== }
+{ === Window ============================================================= }
+{ ======================================================================== }
+
+Type
+
+ pWindow = ^tWindow;
+ tWindow = record
+ NextWindow : pWindow; { for the linked list in a screen }
+
+ LeftEdge,
+ TopEdge : smallint; { screen dimensions of window }
+ Width,
+ Height : smallint; { screen dimensions of window }
+
+ MouseY,
+ MouseX : smallint; { relative to upper-left of window }
+
+ MinWidth,
+ MinHeight : smallint; { minimum sizes }
+ MaxWidth,
+ MaxHeight : smallint; { maximum sizes }
+
+ Flags : Cardinal; { see below for defines }
+
+ MenuStrip : pMenu; { the strip of Menu headers }
+
+ Title : PChar; { the title text for this window }
+
+ FirstRequest : pRequester; { all active Requesters }
+
+ DMRequest : pRequester; { double-click Requester }
+
+ ReqCount : smallint; { count of reqs blocking Window }
+
+ WScreen : Pointer; { this Window's Screen }
+ RPort : pRastPort; { this Window's very own RastPort }
+
+ { the border variables describe the window border. If you specify
+ * GIMMEZEROZERO when you open the window, then the upper-left of the
+ * ClipRect for this window will be upper-left of the BitMap (with correct
+ * offsets when in SuperBitMap mode; you MUST select GIMMEZEROZERO when
+ * using SuperBitMap). If you don't specify ZeroZero, then you save
+ * memory (no allocation of RastPort, Layer, ClipRect and associated
+ * Bitmaps), but you also must offset all your writes by BorderTop,
+ * BorderLeft and do your own mini-clipping to prevent writing over the
+ * system gadgets
+ }
+
+ BorderLeft,
+ BorderTop,
+ BorderRight,
+ BorderBottom : Shortint;
+ BorderRPort : pRastPort;
+
+
+ { You supply a linked-list of Gadgets for your Window.
+ * This list DOES NOT include system gadgets. You get the standard
+ * window system gadgets by setting flag-bits in the variable Flags (see
+ * the bit definitions below)
+ }
+
+ FirstGadget : pGadget;
+
+ { these are for opening/closing the windows }
+
+ Parent,
+ Descendant : pWindow;
+
+ { sprite data information for your own Pointer
+ * set these AFTER you Open the Window by calling SetPointer()
+ }
+
+ _Pointer : Pointer; { sprite data }
+ PtrHeight : Shortint; { sprite height (not including sprite padding) }
+ PtrWidth : Shortint; { sprite width (must be less than or equal to 16) }
+ XOffset,
+ YOffset : Shortint; { sprite offsets }
+
+ { the IDCMP Flags and User's and Intuition's Message Ports }
+ IDCMPFlags : Cardinal; { User-selected flags }
+ UserPort,
+ WindowPort : pMsgPort;
+ MessageKey : pIntuiMessage;
+
+ DetailPen,
+ BlockPen : Byte; { for bar/border/gadget rendering }
+
+ { the CheckMark is a pointer to the imagery that will be used when
+ * rendering MenuItems of this Window that want to be checkmarked
+ * if this is equal to NULL, you'll get the default imagery
+ }
+
+ CheckMark : pImage;
+
+ ScreenTitle : PChar; { if non-null, Screen title when Window is active }
+
+ { These variables have the mouse coordinates relative to the
+ * inner-Window of GIMMEZEROZERO Windows. This is compared with the
+ * MouseX and MouseY variables, which contain the mouse coordinates
+ * relative to the upper-left corner of the Window, GIMMEZEROZERO
+ * notwithstanding
+ }
+
+ GZZMouseX : smallint;
+ GZZMouseY : smallint;
+
+ { these variables contain the width and height of the inner-Window of
+ * GIMMEZEROZERO Windows
+ }
+
+ GZZWidth : smallint;
+ GZZHeight : smallint;
+
+ ExtData : Pointer;
+
+ UserData : Pointer; { general-purpose pointer to User data extension }
+
+ {* jimm: NEW: 11/18/85: this pointer keeps a duplicate of what
+ * Window.RPort->Layer is _supposed_ to be pointing at
+ }
+
+ WLayer : pLayer;
+
+ { jimm: NEW 1.2: need to keep track of the font that
+ * OpenWindow opened, in case user SetFont's into RastPort
+ }
+
+ IFont : pTextFont;
+ {* (V36) another flag word (the Flags field is used up).
+ * At present, all flag values are system private.
+ * Until further notice, you may not change nor use this field.
+ *}
+ MoreFlags : Cardinal;
+
+ {**** Data beyond this point are Intuition Private. DO NOT USE ****}
+
+ end;
+
+CONST
+{ --- Flags requested at OpenWindow() time by the application --------- }
+ WFLG_SIZEGADGET = $00000001; { include sizing system-gadget? }
+ WFLG_DRAGBAR = $00000002; { include dragging system-gadget? }
+ WFLG_DEPTHGADGET = $00000004; { include depth arrangement gadget? }
+ WFLG_CLOSEGADGET = $00000008; { include close-box system-gadget? }
+
+ WFLG_SIZEBRIGHT = $00000010; { size gadget uses right border }
+ WFLG_SIZEBBOTTOM = $00000020; { size gadget uses bottom border }
+
+{ --- refresh modes ------------------------------------------------------ }
+{ combinations of the WFLG_REFRESHBITS select the refresh type }
+ WFLG_REFRESHBITS = $000000C0;
+ WFLG_SMART_REFRESH = $00000000;
+ WFLG_SIMPLE_REFRESH= $00000040;
+ WFLG_SUPER_BITMAP = $00000080;
+ WFLG_OTHER_REFRESH = $000000C0;
+
+ WFLG_BACKDROP = $00000100; { this is a backdrop window }
+
+ WFLG_REPORTMOUSE = $00000200; { to hear about every mouse move }
+
+ WFLG_GIMMEZEROZERO = $00000400; { a GimmeZeroZero window }
+
+ WFLG_BORDERLESS = $00000800; { to get a Window sans border }
+
+ WFLG_ACTIVATE = $00001000; { when Window opens, it's Active }
+
+
+{ --- Other User Flags --------------------------------------------------- }
+ WFLG_RMBTRAP = $00010000; { Catch RMB events for your own }
+ WFLG_NOCAREREFRESH = $00020000; { not to be bothered with REFRESH }
+
+{ - V36 new Flags which the programmer may specify in NewWindow.Flags }
+ WFLG_NW_EXTENDED = $00040000; { extension data provided }
+ { see struct ExtNewWindow }
+
+{ - V39 new Flags which the programmer may specify in NewWindow.Flags }
+ WFLG_NEWLOOKMENUS = $00200000; { window has NewLook menus }
+
+{ These flags are set only by Intuition. YOU MAY NOT SET THEM YOURSELF! }
+ WFLG_WINDOWACTIVE = $00002000; { this window is the active one }
+ WFLG_INREQUEST = $00004000; { this window is in request mode }
+ WFLG_MENUSTATE = $00008000; { Window is active with Menus on }
+ WFLG_WINDOWREFRESH = $01000000; { Window is currently refreshing }
+ WFLG_WBENCHWINDOW = $02000000; { WorkBench tool ONLY Window }
+ WFLG_WINDOWTICKED = $04000000; { only one timer tick at a time }
+
+{ --- V36 Flags to be set only by Intuition ------------------------- }
+ WFLG_VISITOR = $08000000; { visitor window }
+ WFLG_ZOOMED = $10000000; { identifies "zoom state" }
+ WFLG_HASZOOM = $20000000; { windowhas a zoom gadget }
+
+{ --- Other Window Values ---------------------------------------------- }
+ DEFAULTMOUSEQUEUE = (5); { no more mouse messages }
+
+{ --- see struct IntuiMessage for the IDCMP Flag definitions ------------- }
+
+
+{ ======================================================================== }
+{ === NewWindow ========================================================== }
+{ ======================================================================== }
+
+Type
+
+ pNewWindow = ^tNewWindow;
+ tNewWindow = record
+ LeftEdge,
+ TopEdge : smallint; { screen dimensions of window }
+ Width,
+ Height : smallint; { screen dimensions of window }
+
+ DetailPen,
+ BlockPen : Byte; { for bar/border/gadget rendering }
+
+ IDCMPFlags : Cardinal; { User-selected IDCMP flags }
+
+ Flags : Cardinal; { see Window struct for defines }
+
+ { You supply a linked-list of Gadgets for your Window.
+ * This list DOES NOT include system Gadgets. You get the standard
+ * system Window Gadgets by setting flag-bits in the variable Flags (see
+ * the bit definitions under the Window structure definition)
+ }
+
+ FirstGadget : pGadget;
+
+ { the CheckMark is a pointer to the imagery that will be used when
+ * rendering MenuItems of this Window that want to be checkmarked
+ * if this is equal to NULL, you'll get the default imagery
+ }
+
+ CheckMark : pImage;
+
+ Title : PChar; { the title text for this window }
+
+ { the Screen pointer is used only if you've defined a CUSTOMSCREEN and
+ * want this Window to open in it. If so, you pass the Pointer of the
+ * Custom Screen structure in this variable. Otherwise, this variable
+ * is ignored and doesn't have to be initialized.
+ }
+
+ Screen : Pointer;
+
+ { SUPER_BITMAP Window? If so, put the Pointer of your BitMap structure
+ * in this variable. If not, this variable is ignored and doesn't have
+ * to be initialized
+ }
+
+ BitMap : pBitMap;
+
+ { the values describe the minimum and maximum sizes of your Windows.
+ * these matter only if you've chosen the WINDOWSIZING Gadget option,
+ * which means that you want to let the User to change the size of
+ * this Window. You describe the minimum and maximum sizes that the
+ * Window can grow by setting these variables. You can initialize
+ * any one these to zero, which will mean that you want to duplicate
+ * the setting for that dimension (if MinWidth == 0, MinWidth will be
+ * set to the opening Width of the Window).
+ * You can change these settings later using SetWindowLimits().
+ * If you haven't asked for a SIZING Gadget, you don't have to
+ * initialize any of these variables.
+ }
+
+ MinWidth,
+ MinHeight : smallint; { minimums }
+ MaxWidth,
+ MaxHeight : smallint; { maximums }
+
+ { the type variable describes the Screen in which you want this Window to
+ * open. The type value can either be CUSTOMSCREEN or one of the
+ * system standard Screen Types such as WBENCHSCREEN. See the
+ * type definitions under the Screen structure
+ }
+
+ WType : Word; { is "Type" in C includes }
+ end;
+
+
+{ The following structure is the future NewWindow. Compatibility
+ * issues require that the size of NewWindow not change.
+ * Data in the common part (NewWindow) indicates the the extension
+ * fields are being used.
+ * NOTE WELL: This structure may be subject to future extension.
+ * Writing code depending on its size is not allowed.
+ }
+ pExtNewWindow = ^tExtNewWindow;
+ tExtNewWindow = record
+ LeftEdge, TopEdge : smallint;
+ Width, Height : smallint;
+
+ DetailPen, BlockPen : Byte;
+ IDCMPFlags : Cardinal;
+ Flags : Cardinal;
+ FirstGadget : pGadget;
+
+ CheckMark : pImage;
+
+ Title : PChar;
+ WScreen : Pointer;
+ WBitMap : pBitMap;
+
+ MinWidth, MinHeight : smallint;
+ MaxWidth, MaxHeight : Word;
+
+ { the type variable describes the Screen in which you want this Window to
+ * open. The type value can either be CUSTOMSCREEN or one of the
+ * system standard Screen Types such as WBENCHSCREEN. See the
+ * type definitions under the Screen structure.
+ * A new possible value for this field is PUBLICSCREEN, which
+ * defines the window as a 'visitor' window. See below for
+ * additional information provided.
+ }
+ WType : Word;
+
+ { ------------------------------------------------------- *
+ * extensions for V36
+ * if the NewWindow Flag value WFLG_NW_EXTENDED is set, then
+ * this field is assumed to point to an array ( or chain of arrays)
+ * of TagItem structures. See also ExtNewScreen for another
+ * use of TagItems to pass optional data.
+ *
+ * see below for tag values and the corresponding data.
+ }
+ Extension : pTagItem;
+ END;
+
+{
+ * The TagItem ID's (ti_Tag values) for OpenWindowTagList() follow.
+ * They are values in a TagItem array passed as extension/replacement
+ * values for the data in NewWindow. OpenWindowTagList() can actually
+ * work well with a NULL NewWindow pointer.
+ }
+CONST
+ WA_Dummy = (TAG_USER + 99); { $80000063 }
+
+{ these tags simply override NewWindow parameters }
+ WA_Left = (WA_Dummy + $01);
+ WA_Top = (WA_Dummy + $02);
+ WA_Width = (WA_Dummy + $03);
+ WA_Height = (WA_Dummy + $04);
+ WA_DetailPen = (WA_Dummy + $05);
+ WA_BlockPen = (WA_Dummy + $06);
+ WA_IDCMP = (WA_Dummy + $07);
+ { "bulk" initialization of NewWindow.Flags }
+ WA_Flags = (WA_Dummy + $08);
+ WA_Gadgets = (WA_Dummy + $09);
+ WA_Checkmark = (WA_Dummy + $0A);
+ WA_Title = (WA_Dummy + $0B);
+ { means you don't have to call SetWindowTitles
+ * after you open your window
+ }
+ WA_ScreenTitle = (WA_Dummy + $0C);
+ WA_CustomScreen = (WA_Dummy + $0D);
+ WA_SuperBitMap = (WA_Dummy + $0E);
+ { also implies WFLG_SUPER_BITMAP property }
+ WA_MinWidth = (WA_Dummy + $0F);
+ WA_MinHeight = (WA_Dummy + $10);
+ WA_MaxWidth = (WA_Dummy + $11);
+ WA_MaxHeight = (WA_Dummy + $12);
+
+{ The following are specifications for new features }
+
+ WA_InnerWidth = (WA_Dummy + $13);
+ WA_InnerHeight = (WA_Dummy + $14);
+ { You can specify the dimensions of the interior
+ * region of your window, independent of what
+ * the border widths will be. You probably want
+ * to also specify WA_AutoAdjust to allow
+ * Intuition to move your window or even
+ * shrink it so that it is completely on screen.
+ }
+
+ WA_PubScreenName = (WA_Dummy + $15);
+ { declares that you want the window to open as
+ * a visitor on the public screen whose name is
+ * pointed to by (UBYTE *) ti_Data
+ }
+ WA_PubScreen = (WA_Dummy + $16);
+ { open as a visitor window on the public screen
+ * whose Pointer is in (struct Screen *) ti_Data.
+ * To ensure that this screen remains open, you
+ * should either be the screen's owner, have a
+ * window open on the screen, or use LockPubScreen().
+ }
+ WA_PubScreenFallBack = (WA_Dummy + $17);
+ { A Boolean, specifies whether a visitor window
+ * should "fall back" to the default public screen
+ * (or Workbench) if the named public screen isn't
+ * available
+ }
+ WA_WindowName = (WA_Dummy + $18);
+ { not implemented }
+ WA_Colors = (WA_Dummy + $19);
+ { a ColorSpec array for colors to be set
+ * when this window is active. This is not
+ * implemented, and may not be, since the default
+ * values to restore would be hard to track.
+ * We'd like to at least support per-window colors
+ * for the mouse pointer sprite.
+ }
+ WA_Zoom = (WA_Dummy + $1A);
+ { ti_Data points to an array of four WORD's,
+ * the initial Left/Top/Width/Height values of
+ * the "alternate" zoom position/dimensions.
+ * It also specifies that you want a Zoom gadget
+ * for your window, whether or not you have a
+ * sizing gadget.
+ }
+ WA_MouseQueue = (WA_Dummy + $1B);
+ { ti_Data contains initial value for the mouse
+ * message backlog limit for this window.
+ }
+ WA_BackFill = (WA_Dummy + $1C);
+ { unimplemented at present: provides a "backfill
+ * hook" for your window's layer.
+ }
+ WA_RptQueue = (WA_Dummy + $1D);
+ { initial value of repeat key backlog limit }
+
+ { These Boolean tag items are alternatives to the NewWindow.Flags
+ * boolean flags with similar names.
+ }
+ WA_SizeGadget = (WA_Dummy + $1E);
+ WA_DragBar = (WA_Dummy + $1F);
+ WA_DepthGadget = (WA_Dummy + $20);
+ WA_CloseGadget = (WA_Dummy + $21);
+ WA_Backdrop = (WA_Dummy + $22);
+ WA_ReportMouse = (WA_Dummy + $23);
+ WA_NoCareRefresh = (WA_Dummy + $24);
+ WA_Borderless = (WA_Dummy + $25);
+ WA_Activate = (WA_Dummy + $26);
+ WA_RMBTrap = (WA_Dummy + $27);
+ WA_WBenchWindow = (WA_Dummy + $28); { PRIVATE!! }
+ WA_SimpleRefresh = (WA_Dummy + $29);
+ { only specify if TRUE }
+ WA_SmartRefresh = (WA_Dummy + $2A);
+ { only specify if TRUE }
+ WA_SizeBRight = (WA_Dummy + $2B);
+ WA_SizeBBottom = (WA_Dummy + $2C);
+
+ { New Boolean properties }
+ WA_AutoAdjust = (WA_Dummy + $2D);
+ { shift or squeeze the window's position and
+ * dimensions to fit it on screen.
+ }
+
+ WA_GimmeZeroZero = (WA_Dummy + $2E);
+ { equiv. to NewWindow.Flags WFLG_GIMMEZEROZERO }
+
+{ New for V37: WA_MenuHelp (ignored by V36) }
+ WA_MenuHelp = (WA_Dummy + $2F);
+ { Enables IDCMP_MENUHELP: Pressing HELP during menus
+ * will return IDCMP_MENUHELP message.
+ }
+
+{ New for V39: (ignored by V37 and earlier) }
+ WA_NewLookMenus = (WA_Dummy + $30);
+ { Set to TRUE if you want NewLook menus }
+ WA_AmigaKey = (WA_Dummy + $31);
+ { Pointer to image for Amiga-key equiv in menus }
+ WA_NotifyDepth = (WA_Dummy + $32);
+ { Requests IDCMP_CHANGEWINDOW message when
+ * window is depth arranged
+ * (imsg->Code = CWCODE_DEPTH)
+ }
+
+{ WA_Dummy + $33 is obsolete }
+
+ WA_Pointer = (WA_Dummy + $34);
+ { Allows you to specify a custom pointer
+ * for your window. ti_Data points to a
+ * pointer object you obtained via
+ * "pointerclass". NULL signifies the
+ * default pointer.
+ * This tag may be passed to OpenWindowTags()
+ * or SetWindowPointer().
+ }
+
+ WA_BusyPointer = (WA_Dummy + $35);
+ { ti_Data is boolean. Set to TRUE to
+ * request the standard busy pointer.
+ * This tag may be passed to OpenWindowTags()
+ * or SetWindowPointer().
+ }
+
+ WA_PointerDelay = (WA_Dummy + $36);
+ { ti_Data is boolean. Set to TRUE to
+ * request that the changing of the
+ * pointer be slightly delayed. The change
+ * will be called off if you call NewSetPointer()
+ * before the delay expires. This allows
+ * you to post a busy-pointer even if you think
+ * the busy-time may be very Word, without
+ * fear of a flashing pointer.
+ * This tag may be passed to OpenWindowTags()
+ * or SetWindowPointer().
+ }
+
+ WA_TabletMessages = (WA_Dummy + $37);
+ { ti_Data is a boolean. Set to TRUE to
+ * request that tablet information be included
+ * in IntuiMessages sent to your window.
+ * Requires that something (i.e. a tablet driver)
+ * feed IESUBCLASS_NEWTABLET InputEvents into
+ * the system. For a pointer to the TabletData,
+ * examine the ExtIntuiMessage->eim_TabletData
+ * field. It is UNSAFE to check this field
+ * when running on pre-V39 systems. It's always
+ * safe to check this field under V39 and up,
+ * though it may be NULL.
+ }
+
+ WA_HelpGroup = (WA_Dummy + $38);
+ { When the active window has gadget help enabled,
+ * other windows of the same HelpGroup number
+ * will also get GadgetHelp. This allows GadgetHelp
+ * to work for multi-windowed applications.
+ * Use GetGroupID() to get an ID number. Pass
+ * this number as ti_Data to all your windows.
+ * See also the HelpControl() function.
+ }
+
+ WA_HelpGroupWindow = (WA_Dummy + $39);
+ { When the active window has gadget help enabled,
+ * other windows of the same HelpGroup will also get
+ * GadgetHelp. This allows GadgetHelp to work
+ * for multi-windowed applications. As an alternative
+ * to WA_HelpGroup, you can pass a pointer to any
+ * other window of the same group to join its help
+ * group. Defaults to NULL, which has no effect.
+ * See also the HelpControl() function.
+ }
+
+
+{ HelpControl() flags:
+ *
+ * HC_GADGETHELP - Set this flag to enable Gadget-Help for one or more
+ * windows.
+ }
+
+ HC_GADGETHELP = 1;
+
+
+{ ======================================================================== }
+{ === Remember =========================================================== }
+{ ======================================================================== }
+{ this structure is used for remembering what memory has been allocated to
+ * date by a given routine, so that a premature abort or systematic exit
+ * can deallocate memory cleanly, easily, and completely
+ }
+
+Type
+
+ pRemember = ^tRemember;
+ tRemember = record
+ NextRemember : pRemember;
+ RememberSize : Cardinal;
+ Memory : Pointer;
+ end;
+
+
+{ === Color Spec ====================================================== }
+{ How to tell Intuition about RGB values for a color table entry. }
+
+ pColorSpec = ^tColorSpec;
+ tColorSpec = record
+ ColorIndex : smallint; { -1 terminates an array of ColorSpec }
+ Red : Word; { only the _bottom_ 4 bits recognized }
+ Green : Word; { only the _bottom_ 4 bits recognized }
+ Blue : Word; { only the _bottom_ 4 bits recognized }
+ END;
+
+{ === Easy Requester Specification ======================================= }
+{ see also autodocs for EasyRequest and BuildEasyRequest }
+{ NOTE: This structure may grow in size in the future }
+
+ pEasyStruct = ^tEasyStruct;
+ tEasyStruct = record
+ es_StructSize : Cardinal; { should be sizeof (struct EasyStruct )}
+ es_Flags : Cardinal; { should be 0 for now }
+ es_Title : PChar; { title of requester window }
+ es_TextFormat : PChar; { 'printf' style formatting string }
+ es_GadgetFormat : PChar; { 'printf' style formatting string }
+ END;
+
+
+
+{ ======================================================================== }
+{ === Miscellaneous ====================================================== }
+{ ======================================================================== }
+CONST
+{ = MENU STUFF =========================================================== }
+ NOMENU = $001F;
+ NOITEM = $003F;
+ NOSUB = $001F;
+ MENUNULL = -1;
+
+
+{ = =RJ='s peculiarities ================================================= }
+
+{ these defines are for the COMMSEQ and CHECKIT menu stuff. If CHECKIT,
+ * I'll use a generic Width (for all resolutions) for the CheckMark.
+ * If COMMSEQ, likewise I'll use this generic stuff
+ }
+
+ CHECKWIDTH = 19;
+ COMMWIDTH = 27;
+ LOWCHECKWIDTH = 13;
+ LOWCOMMWIDTH = 16;
+
+{ these are the AlertNumber defines. if you are calling DisplayAlert()
+ * the AlertNumber you supply must have the ALERT_TYPE bits set to one
+ * of these patterns
+ }
+
+ ALERT_TYPE = $80000000;
+ RECOVERY_ALERT = $00000000; { the system can recover from this }
+ DEADEND_ALERT = $80000000; { no recovery possible, this is it }
+
+
+{ When you're defining IntuiText for the Positive and Negative Gadgets
+ * created by a call to AutoRequest(), these defines will get you
+ * reasonable-looking text. The only field without a define is the IText
+ * field; you decide what text goes with the Gadget
+ }
+
+ AUTOFRONTPEN = 0;
+ AUTOBACKPEN = 1;
+ AUTODRAWMODE = JAM2;
+ AUTOLEFTEDGE = 6;
+ AUTOTOPEDGE = 3;
+
+{ -
+ AUTOITEXTFONT = Nil;
+ AUTONEXTTEXT = Nil;
+- }
+
+
+{ --- RAWMOUSE Codes and Qualifiers (Console OR IDCMP) ------------------- }
+
+
+ SELECTUP = IECODE_LBUTTON + IECODE_UP_PREFIX;
+ SELECTDOWN = IECODE_LBUTTON;
+ MENUUP = IECODE_RBUTTON + IECODE_UP_PREFIX;
+ MENUDOWN = IECODE_RBUTTON;
+ ALTLEFT = IEQUALIFIER_LALT;
+ ALTRIGHT = IEQUALIFIER_RALT;
+ AMIGALEFT = IEQUALIFIER_LCOMMAND;
+ AMIGARIGHT = IEQUALIFIER_RCOMMAND;
+ AMIGAKEYS = AMIGALEFT + AMIGARIGHT;
+
+ CURSORUP = $4C;
+ CURSORLEFT = $4F;
+ CURSORRIGHT = $4E;
+ CURSORDOWN = $4D;
+ KEYCODE_Q = $10;
+ KEYCODE_X = $32;
+ KEYCODE_N = $36;
+ KEYCODE_M = $37;
+ KEYCODE_V = $34;
+ KEYCODE_B = $35;
+ KEYCODE_LESS = $38;
+ KEYCODE_GREATER = $39;
+
+{ these are the display modes for which we have corresponding parameter
+ * settings in the config arrays
+ }
+CONST
+ DMODECOUNT = $0002; { how many modes there are }
+ HIRESPICK = $0000;
+ LOWRESPICK = $0001;
+
+ EVENTMAX = 10; { size of event array }
+
+{ these are the system Gadget defines }
+ RESCOUNT = 2;
+ HIRESGADGET = 0;
+ LOWRESGADGET = 1;
+
+ GADGETCOUNT = 8;
+ UPFRONTGADGET = 0;
+ DOWNBACKGADGET = 1;
+ SIZEGADGET = 2;
+ CLOSEGADGET = 3;
+ DRAGGADGET = 4;
+ SUPFRONTGADGET = 5;
+ SDOWNBACKGADGET= 6;
+ SDRAGGADGET = 7;
+
+
+{ ======================================================================== }
+{ === DrawInfo ========================================================= }
+{ ======================================================================== }
+
+{ This is a packet of information for graphics rendering. It originates
+ * with a Screen, and is gotten using GetScreenDrawInfo( screen );
+ }
+
+{ If you find dri_Version >= DRI_VERSION, you know this structure
+ * has at least the fields defined in this version of the include file
+ }
+CONST
+ RI_VERSION = (1); { obsolete, will be removed }
+ DRI_VERSION = (1);
+
+Type
+
+ pDrawInfo = ^tDrawInfo;
+ tDrawInfo = record
+ dri_Version : Word; { will be DRI_VERSION }
+ dri_NumPens : Word; { guaranteed to be >= numDrIPens }
+ dri_Pens : Pointer; { pointer to pen array }
+
+ dri_Font : pTextFont; { screen default font }
+ dri_Depth : Word; { (initial) depth of screen bitmap }
+
+ dri_Resolution : record { from DisplayInfo database for initial display mode }
+ x : word;
+ y : word;
+ end;
+
+ dri_Flags : Cardinal; { defined below }
+{ New for V39: dri_CheckMark, dri_AmigaKey. }
+ dri_CheckMark : pImage; { ImagePtr } { pointer to scaled checkmark image
+ * Will be NULL if DRI_VERSION < 2
+ }
+ dri_AmigaKey : pImage; { ImagePtr } { pointer to scaled Amiga-key image
+ * Will be NULL if DRI_VERSION < 2
+ }
+
+ dri_Reserved : Array[0..4] of Cardinal; { avoid recompilation ;^) }
+ END;
+
+CONST
+ DRIF_NEWLOOK = $00000001; { specified SA_Pens, full treatment }
+
+{ rendering pen number indexes into DrawInfo.dri_Pens[] }
+ DETAILPEN = ($0000); { compatible Intuition rendering pens }
+ BLOCKPEN = ($0001); { compatible Intuition rendering pens }
+ TEXTPEN = ($0002); { text on background }
+ SHINEPEN = ($0003); { bright edge on 3D objects }
+ SHADOWPEN = ($0004); { dark edge on 3D objects }
+ FILLPEN = ($0005); { active-window/selected-gadget fill }
+ FILLTEXTPEN = ($0006); { text over FILLPEN }
+ BACKGROUNDPEN = ($0007); { always color 0 }
+ HIGHLIGHTTEXTPEN = ($0008); { special color text, on background }
+{ New for V39, only present if DRI_VERSION >= 2: }
+ BARDETAILPEN = ($0009); { text/detail in screen-bar/menus }
+ BARBLOCKPEN = ($000A); { screen-bar/menus fill }
+ BARTRIMPEN = ($000B); { trim under screen-bar }
+
+ NUMDRIPENS = ($0009);
+
+{ New for V39: It is sometimes useful to specify that a pen value
+ * is to be the complement of color zero to three. The "magic" numbers
+ * serve that purpose:
+ }
+ PEN_C3 = $FEFC; { Complement of color 3 }
+ PEN_C2 = $FEFD; { Complement of color 2 }
+ PEN_C1 = $FEFE; { Complement of color 1 }
+ PEN_C0 = $FEFF; { Complement of color 0 }
+
+{ ======================================================================== }
+{ === Screen ============================================================= }
+{ ======================================================================== }
+
+Type
+
+ pScreen = ^tScreen;
+ tScreen = record
+ NextScreen : pScreen; { linked list of screens }
+ FirstWindow : pWindow; { linked list Screen's Windows }
+
+ LeftEdge,
+ TopEdge : smallint; { parameters of the screen }
+ Width,
+ Height : smallint; { parameters of the screen }
+
+ MouseY,
+ MouseX : smallint; { position relative to upper-left }
+
+ Flags : Word; { see definitions below }
+
+ Title : PChar; { null-terminated Title text }
+ DefaultTitle : PChar; { for Windows without ScreenTitle }
+
+ { Bar sizes for this Screen and all Window's in this Screen }
+ BarHeight,
+ BarVBorder,
+ BarHBorder,
+ MenuVBorder,
+ MenuHBorder : Shortint;
+ WBorTop,
+ WBorLeft,
+ WBorRight,
+ WBorBottom : Shortint;
+
+ Font : pTextAttr; { this screen's default font }
+
+ { the display data structures for this Screen (note the prefix S)}
+ ViewPort : tViewPort; { describing the Screen's display }
+ RastPort : tRastPort; { describing Screen rendering }
+ BitMap : tBitMap; { extra copy of RastPort BitMap }
+ LayerInfo : tLayer_Info; { each screen gets a LayerInfo }
+
+ { You supply a linked-list of Gadgets for your Screen.
+ * This list DOES NOT include system Gadgets. You get the standard
+ * system Screen Gadgets by default
+ }
+
+ FirstGadget : pGadget;
+
+ DetailPen,
+ BlockPen : Byte; { for bar/border/gadget rendering }
+
+ { the following variable(s) are maintained by Intuition to support the
+ * DisplayBeep() color flashing technique
+ }
+ SaveColor0 : Word;
+
+ { This layer is for the Screen and Menu bars }
+ BarLayer : pLayer;
+
+ ExtData : Pointer;
+ UserData : Pointer;
+ { general-purpose pointer to User data extension }
+ {**** Data below this point are SYSTEM PRIVATE ****}
+
+ end;
+
+Const
+
+{ The screen flags have the suffix "_f" added to avoid conflicts with
+ routine names. }
+
+{ --- FLAGS SET BY INTUITION --------------------------------------------- }
+{ The SCREENTYPE bits are reserved for describing various Screen types
+ * available under Intuition.
+ }
+ SCREENTYPE_f = $000F; { all the screens types available }
+{ --- the definitions for the Screen Type ------------------------------- }
+ WBENCHSCREEN_f = $0001; { Ta Da! The Workbench }
+ CUSTOMSCREEN_f = $000F; { for that special look }
+
+ SHOWTITLE_f = $0010; { this gets set by a call to ShowTitle() }
+
+ BEEPING_f = $0020; { set when Screen is beeping }
+
+ CUSTOMBITMAP_f = $0040; { if you are supplying your own BitMap }
+
+ SCREENBEHIND_f = $0080; { if you want your screen to open behind
+ * already open screens
+ }
+ SCREENQUIET_f = $0100; { if you do not want Intuition to render
+ * into your screen (gadgets, title) }
+ SCREENHIRES = $0200; { do no use lowres gadgets (private) }
+
+ NS_EXTENDED = $1000; { ExtNewScreen.Extension is valid }
+ { V36 applications can use OpenScreenTagList() instead of NS_EXTENDED }
+
+{ New for V39: }
+ PENSHARED = $0400; { Screen opener set (SA_SharePens,TRUE) }
+
+
+ AUTOSCROLL = $4000; { screen is to autoscoll }
+
+ STDSCREENHEIGHT = -1; { supply in NewScreen.Height }
+ STDSCREENWIDTH = -1; { supply in NewScreen.Width }
+
+
+
+{
+ * Screen attribute tag ID's. These are used in the ti_Tag field of
+ * TagItem arrays passed to OpenScreenTagList() (or in the
+ * ExtNewScreen.Extension field).
+ }
+
+{ Screen attribute tags. Please use these versions, not those in
+ * iobsolete.h.
+ }
+CONST
+ SA_Dummy = (TAG_USER + 32);
+{
+ * these items specify items equivalent to fields in NewScreen
+ }
+ SA_Left = (SA_Dummy + $0001);
+ SA_Top = (SA_Dummy + $0002);
+ SA_Width = (SA_Dummy + $0003);
+ SA_Height = (SA_Dummy + $0004);
+ { traditional screen positions and dimensions }
+ SA_Depth = (SA_Dummy + $0005);
+ { screen bitmap depth }
+ SA_DetailPen= (SA_Dummy + $0006);
+ { serves as default for windows, too }
+ SA_BlockPen = (SA_Dummy + $0007);
+ SA_Title = (SA_Dummy + $0008);
+ { default screen title }
+ SA_Colors = (SA_Dummy + $0009);
+ { ti_Data is an array of struct ColorSpec,
+ * terminated by ColorIndex = -1. Specifies
+ * initial screen palette colors.
+ }
+ SA_ErrorCode= (SA_Dummy + $000A);
+ { ti_Data points to LONG error code (values below)}
+ SA_Font = (SA_Dummy + $000B);
+ { equiv. to NewScreen.Font }
+ SA_SysFont = (SA_Dummy + $000C);
+ { Selects one of the preferences system fonts:
+ * 0 - old DefaultFont, fixed-width
+ * 1 - WB Screen preferred font
+ }
+ SA_Type = (SA_Dummy + $000D);
+ { equiv. to NewScreen.Type }
+ SA_BitMap = (SA_Dummy + $000E);
+ { ti_Data is pointer to custom BitMap. This
+ * implies type of CUSTOMBITMAP
+ }
+ SA_PubName = (SA_Dummy + $000F);
+ { presence of this tag means that the screen
+ * is to be a public screen. Please specify
+ * BEFORE the two tags below
+ }
+ SA_PubSig = (SA_Dummy + $0010);
+ SA_PubTask = (SA_Dummy + $0011);
+ { Task ID and signal for being notified that
+ * the last window has closed on a public screen.
+ }
+ SA_DisplayID= (SA_Dummy + $0012);
+ { ti_Data is new extended display ID from
+ * <graphics/displayinfo.h>.
+ }
+ SA_DClip = (SA_Dummy + $0013);
+ { ti_Data points to a rectangle which defines
+ * screen display clip region
+ }
+ SA_Overscan = (SA_Dummy + $0014);
+ { was S_STDDCLIP. Set to one of the OSCAN_
+ * specifiers below to get a system standard
+ * overscan region for your display clip,
+ * screen dimensions (unless otherwise specified),
+ * and automatically centered position (partial
+ * support only so far).
+ * If you use this, you shouldn't specify
+ * SA_DClip. SA_Overscan is for "standard"
+ * overscan dimensions, SA_DClip is for
+ * your custom numeric specifications.
+ }
+ SA_Obsolete1= (SA_Dummy + $0015);
+ { obsolete S_MONITORNAME }
+
+{* booleans *}
+ SA_ShowTitle = (SA_Dummy + $0016);
+ { boolean equivalent to flag SHOWTITLE }
+ SA_Behind = (SA_Dummy + $0017);
+ { boolean equivalent to flag SCREENBEHIND }
+ SA_Quiet = (SA_Dummy + $0018);
+ { boolean equivalent to flag SCREENQUIET }
+ SA_AutoScroll = (SA_Dummy + $0019);
+ { boolean equivalent to flag AUTOSCROLL }
+ SA_Pens = (SA_Dummy + $001A);
+ { pointer to ~0 terminated UWORD array, as
+ * found in struct DrawInfo
+ }
+ SA_FullPalette= (SA_Dummy + $001B);
+ { boolean: initialize color table to entire
+ * preferences palette (32 for V36), rather
+ * than compatible pens 0-3, 17-19, with
+ * remaining palette as returned by GetColorMap()
+ }
+
+ SA_ColorMapEntries = (SA_Dummy + $001C);
+ { New for V39:
+ * Allows you to override the number of entries
+ * in the ColorMap for your screen. Intuition
+ * normally allocates (1<<depth) or 32, whichever
+ * is more, but you may require even more if you
+ * use certain V39 graphics.library features
+ * (eg. palette-banking).
+ }
+
+ SA_Parent = (SA_Dummy + $001D);
+ { New for V39:
+ * ti_Data is a pointer to a "parent" screen to
+ * attach this one to. Attached screens slide
+ * and depth-arrange together.
+ }
+
+ SA_Draggable = (SA_Dummy + $001E);
+ { New for V39:
+ * Boolean tag allowing non-draggable screens.
+ * Do not use without good reason!
+ * (Defaults to TRUE).
+ }
+
+ SA_Exclusive = (SA_Dummy + $001F);
+ { New for V39:
+ * Boolean tag allowing screens that won't share
+ * the display. Use sparingly! Starting with 3.01,
+ * attached screens may be SA_Exclusive. Setting
+ * SA_Exclusive for each screen will produce an
+ * exclusive family. (Defaults to FALSE).
+ }
+
+ SA_SharePens = (SA_Dummy + $0020);
+ { New for V39:
+ * For those pens in the screen's DrawInfo->dri_Pens,
+ * Intuition obtains them in shared mode (see
+ * graphics.library/ObtainPen()). For compatibility,
+ * Intuition obtains the other pens of a public
+ * screen as PEN_EXCLUSIVE. Screens that wish to
+ * manage the pens themselves should generally set
+ * this tag to TRUE. This instructs Intuition to
+ * leave the other pens unallocated.
+ }
+
+ SA_BackFill = (SA_Dummy + $0021);
+ { New for V39:
+ * provides a "backfill hook" for your screen's
+ * Layer_Info.
+ * See layers.library/InstallLayerInfoHook()
+ }
+
+ SA_Interleaved = (SA_Dummy + $0022);
+ { New for V39:
+ * Boolean tag requesting that the bitmap
+ * allocated for you be interleaved.
+ * (Defaults to FALSE).
+ }
+
+ SA_Colors32 = (SA_Dummy + $0023);
+ { New for V39:
+ * Tag to set the screen's initial palette colors
+ * at 32 bits-per-gun. ti_Data is a pointer
+ * to a table to be passed to the
+ * graphics.library/LoadRGB32() function.
+ * This format supports both runs of color
+ * registers and sparse registers. See the
+ * autodoc for that function for full details.
+ * Any color set here has precedence over
+ * the same register set by SA_Colors.
+ }
+
+ SA_VideoControl = (SA_Dummy + $0024);
+ { New for V39:
+ * ti_Data is a pointer to a taglist that Intuition
+ * will pass to graphics.library/VideoControl(),
+ * upon opening the screen.
+ }
+
+ SA_FrontChild = (SA_Dummy + $0025);
+ { New for V39:
+ * ti_Data is a pointer to an already open screen
+ * that is to be the child of the screen being
+ * opened. The child screen will be moved to the
+ * front of its family.
+ }
+
+ SA_BackChild = (SA_Dummy + $0026);
+ { New for V39:
+ * ti_Data is a pointer to an already open screen
+ * that is to be the child of the screen being
+ * opened. The child screen will be moved to the
+ * back of its family.
+ }
+
+ SA_LikeWorkbench = (SA_Dummy + $0027);
+ { New for V39:
+ * Set ti_Data to 1 to request a screen which
+ * is just like the Workbench. This gives
+ * you the same screen mode, depth, size,
+ * colors, etc., as the Workbench screen.
+ }
+
+ SA_Reserved = (SA_Dummy + $0028);
+ { Reserved for private Intuition use }
+
+ SA_MinimizeISG = (SA_Dummy + $0029);
+ { New for V40:
+ * For compatibility, Intuition always ensures
+ * that the inter-screen gap is at least three
+ * non-interlaced lines. If your application
+ * would look best with the smallest possible
+ * inter-screen gap, set ti_Data to TRUE.
+ * If you use the new graphics VideoControl()
+ * VC_NoColorPaletteLoad tag for your screen's
+ * ViewPort, you should also set this tag.
+ }
+
+
+{ this is an obsolete tag included only for compatibility with V35
+ * interim release for the A2024 and Viking monitors
+ }
+ NSTAG_EXT_VPMODE = (TAG_USER + 1);
+
+
+{ OpenScreen error codes, which are returned in the (optional) LONG
+ * pointed to by ti_Data for the SA_ErrorCode tag item
+ }
+ OSERR_NOMONITOR = (1); { named monitor spec not available }
+ OSERR_NOCHIPS = (2); { you need newer custom chips }
+ OSERR_NOMEM = (3); { couldn't get normal memory }
+ OSERR_NOCHIPMEM = (4); { couldn't get chipmem }
+ OSERR_PUBNOTUNIQUE= (5); { public screen name already used }
+ OSERR_UNKNOWNMODE = (6); { don't recognize mode asked for }
+
+{ ======================================================================== }
+{ === NewScreen ========================================================== }
+{ ======================================================================== }
+
+Type
+
+ pNewScreen = ^tNewScreen;
+ tNewScreen = record
+ LeftEdge,
+ TopEdge,
+ Width,
+ Height,
+ Depth : smallint; { screen dimensions }
+
+ DetailPen,
+ BlockPen : Byte; { for bar/border/gadget rendering }
+
+ ViewModes : Word; { the Modes for the ViewPort (and View) }
+
+ SType : Word; { the Screen type (see defines above) }
+
+ Font : pTextAttr; { this Screen's default text attributes }
+
+ DefaultTitle : PChar; { the default title for this Screen }
+
+ Gadgets : pGadget; { your own Gadgets for this Screen }
+
+ { if you are opening a CUSTOMSCREEN and already have a BitMap
+ * that you want used for your Screen, you set the flags CUSTOMBITMAP in
+ * the Type field and you set this variable to point to your BitMap
+ * structure. The structure will be copied into your Screen structure,
+ * after which you may discard your own BitMap if you want
+ }
+
+ CustomBitMap : pBitMap;
+ end;
+
+
+type
+
+ pExtNewScreen = ^tExtNewScreen;
+ tExtNewScreen = record
+ LeftEdge, TopEdge, Width, Height, Depth : smallint;
+ DetailPen, BlockPen : Byte;
+ ViewModes : Word;
+ ens_Type : Word; { Type in C-Includes }
+ Font : pTextAttr;
+ DefaultTitle : PChar;
+ Gadgets : pGadget;
+ CustomBitMap : pBitMap;
+ Extension : pTagItem;
+ END;
+
+
+CONST
+{ === Overscan Types === }
+ OSCAN_TEXT = (1); { entirely visible }
+ OSCAN_STANDARD = (2); { just past edges }
+ OSCAN_MAX = (3); { as much as possible }
+ OSCAN_VIDEO = (4); { even more than is possible }
+
+
+{ === Public Shared Screen Node === }
+
+{ This is the representative of a public shared screen.
+ * This is an internal data structure, but some functions may
+ * present a copy of it to the calling application. In that case,
+ * be aware that the screen pointer of the structure can NOT be
+ * used safely, since there is no guarantee that the referenced
+ * screen will remain open and a valid data structure.
+ *
+ * Never change one of these.
+ }
+
+Type
+ pPubScreenNode = ^tPubScreenNode;
+ tPubScreenNode = record
+ psn_Node : tNode; { ln_Name is screen name }
+ psn_Screen : pScreen;
+ psn_Flags : Word; { below }
+ psn_Size : smallint; { includes name buffer }
+ psn_VisitorCount : smallint; { how many visitor windows }
+ psn_SigTask : pTask; { who to signal when visitors gone }
+ psn_SigBit : Byte; { which signal }
+ END;
+
+CONST
+ PSNF_PRIVATE = ($0001);
+
+ MAXPUBSCREENNAME = (139); { names no longer, please }
+
+{ pub screen modes }
+ SHANGHAI = $0001; { put workbench windows on pub screen }
+ POPPUBSCREEN = $0002; { pop pub screen to front when visitor opens }
+
+{ New for V39: Intuition has new screen depth-arrangement and movement
+ * functions called ScreenDepth() and ScreenPosition() respectively.
+ * These functions permit the old behavior of ScreenToFront(),
+ * ScreenToBack(), and MoveScreen(). ScreenDepth() also allows
+ * independent depth control of attached screens. ScreenPosition()
+ * optionally allows positioning screens even though they were opened
+ * (SA_Draggable,FALSE).
+ }
+
+{ For ScreenDepth(), specify one of SDEPTH_TOFRONT or SDEPTH_TOBACK,
+ * and optionally also SDEPTH_INFAMILY.
+ *
+ * NOTE: ONLY THE OWNER OF THE SCREEN should ever specify
+ * SDEPTH_INFAMILY. Commodities, "input helper" programs,
+ * or any other program that did not open a screen should never
+ * use that flag. (Note that this is a style-behavior
+ * requirement; there is no technical requirement that the
+ * task calling this function need be the task which opened
+ * the screen).
+ }
+
+ SDEPTH_TOFRONT = (0); { Bring screen to front }
+ SDEPTH_TOBACK = (1); { Send screen to back }
+ SDEPTH_INFAMILY = (2); { Move an attached screen with
+ * respect to other screens of
+ * its family
+ }
+
+{ Here's an obsolete name equivalent to SDEPTH_INFAMILY: }
+ SDEPTH_CHILDONLY = SDEPTH_INFAMILY;
+
+
+{ For ScreenPosition(), specify one of SPOS_RELATIVE, SPOS_ABSOLUTE,
+ * or SPOS_MAKEVISIBLE to describe the kind of screen positioning you
+ * wish to perform:
+ *
+ * SPOS_RELATIVE: The x1 and y1 parameters to ScreenPosition() describe
+ * the offset in coordinates you wish to move the screen by.
+ * SPOS_ABSOLUTE: The x1 and y1 parameters to ScreenPosition() describe
+ * the absolute coordinates you wish to move the screen to.
+ * SPOS_MAKEVISIBLE: (x1,y1)-(x2,y2) describes a rectangle on the
+ * screen which you would like autoscrolled into view.
+ *
+ * You may additionally set SPOS_FORCEDRAG along with any of the
+ * above. Set this if you wish to reposition an (SA_Draggable,FALSE)
+ * screen that you opened.
+ *
+ * NOTE: ONLY THE OWNER OF THE SCREEN should ever specify
+ * SPOS_FORCEDRAG. Commodities, "input helper" programs,
+ * or any other program that did not open a screen should never
+ * use that flag.
+ }
+
+ SPOS_RELATIVE = (0); { Coordinates are relative }
+
+ SPOS_ABSOLUTE = (1); { Coordinates are expressed as
+ * absolutes, not relatives.
+ }
+
+ SPOS_MAKEVISIBLE = (2); { Coordinates describe a box on
+ * the screen you wish to be
+ * made visible by autoscrolling
+ }
+
+ SPOS_FORCEDRAG = (4); { Move non-draggable screen }
+
+{ New for V39: Intuition supports double-buffering in screens,
+ * with friendly interaction with menus and certain gadgets.
+ * For each buffer, you need to get one of these structures
+ * from the AllocScreenBuffer() call. Never allocate your
+ * own ScreenBuffer structures!
+ *
+ * The sb_DBufInfo field is for your use. See the graphics.library
+ * AllocDBufInfo() autodoc for details.
+ }
+Type
+
+ pScreenBuffer = ^tScreenBuffer;
+ tScreenBuffer = record
+ sb_BitMap : pBitMap; { BitMap of this buffer }
+ sb_DBufInfo : pDBufInfo; { DBufInfo for this buffer }
+ end;
+
+const
+{ These are the flags that may be passed to AllocScreenBuffer().
+ }
+ SB_SCREEN_BITMAP = 1;
+ SB_COPY_BITMAP = 2;
+
+
+{ ======================================================================== }
+{ === Preferences ======================================================== }
+{ ======================================================================== }
+
+Const
+
+{ these are the definitions for the printer configurations }
+ FILENAME_SIZE = 30; { Filename size }
+
+ POINTERSIZE = (1 + 16 + 1) * 2; { Size of Pointer data buffer }
+
+{ These defines are for the default font size. These actually describe the
+ * height of the defaults fonts. The default font type is the topaz
+ * font, which is a fixed width font that can be used in either
+ * eighty-column or sixty-column mode. The Preferences structure reflects
+ * which is currently selected by the value found in the variable FontSize,
+ * which may have either of the values defined below. These values actually
+ * are used to select the height of the default font. By changing the
+ * height, the resolution of the font changes as well.
+ }
+ TOPAZ_EIGHTY = 8;
+ TOPAZ_SIXTY = 9;
+
+Type
+
+ pPreferences = ^tPreferences;
+ tPreferences = record
+ { the default font height }
+ FontHeight : Shortint; { height for system default font }
+
+ { constant describing what's hooked up to the port }
+ PrinterPort : Byte; { printer port connection }
+
+ { the baud rate of the port }
+ BaudRate : Word; { baud rate for the serial port }
+
+ { various timing rates }
+ KeyRptSpeed : ttimeval; { repeat speed for keyboard }
+ KeyRptDelay : ttimeval; { Delay before keys repeat }
+ DoubleClick : ttimeval; { Interval allowed between clicks }
+
+ { Intuition Pointer data }
+ PointerMatrix : Array [0..POINTERSIZE-1] of Word;
+ { Definition of pointer sprite }
+ XOffset : Shortint; { X-Offset for active 'bit' }
+ YOffset : Shortint; { Y-Offset for active 'bit' }
+ color17 : Word; {*********************************}
+ color18 : Word; { Colours for sprite pointer }
+ color19 : Word; {*********************************}
+ PointerTicks : Word; { Sensitivity of the pointer }
+
+ { Workbench Screen colors }
+ color0 : Word; {*********************************}
+ color1 : Word; { Standard default colours }
+ color2 : Word; { Used in the Workbench }
+ color3 : Word; {*********************************}
+
+ { positioning data for the Intuition View }
+ ViewXOffset : Shortint; { Offset for top lefthand corner }
+ ViewYOffset : Shortint; { X and Y dimensions }
+ ViewInitX,
+ ViewInitY : smallint; { View initial offset values }
+
+ EnableCLI : Boolean; { CLI availability switch }
+
+ { printer configurations }
+ PrinterType : Word; { printer type }
+ PrinterFilename : Array [0..FILENAME_SIZE-1] of Char;
+ { file for printer }
+
+ { print format and quality configurations }
+ PrintPitch : Word; { print pitch }
+ PrintQuality : Word; { print quality }
+ PrintSpacing : Word; { number of lines per inch }
+ PrintLeftMargin : Word; { left margin in characters }
+ PrintRightMargin : Word; { right margin in characters }
+ PrintImage : Word; { positive or negative }
+ PrintAspect : Word; { horizontal or vertical }
+ PrintShade : Word; { b&w, half-tone, or color }
+ PrintThreshold : smallint; { darkness ctrl for b/w dumps }
+
+ { print paper descriptors }
+ PaperSize : Word; { paper size }
+ PaperLength : Word; { paper length in number of lines }
+ PaperType : Word; { continuous or single sheet }
+
+ { Serial device settings: These are six nibble-fields in three bytes }
+ { (these look a little strange so the defaults will map out to zero) }
+ SerRWBits : Byte;
+ { upper nibble = (8-number of read bits) }
+ { lower nibble = (8-number of write bits) }
+ SerStopBuf : Byte;
+ { upper nibble = (number of stop bits - 1) }
+ { lower nibble = (table value for BufSize) }
+ SerParShk : Byte;
+ { upper nibble = (value for Parity setting) }
+ { lower nibble = (value for Handshake mode) }
+ LaceWB : Byte; { if workbench is to be interlaced }
+
+ WorkName : Array [0..FILENAME_SIZE-1] of Char;
+ { temp file for printer }
+
+ RowSizeChange : Shortint;
+ ColumnSizeChange : Shortint;
+
+ PrintFlags : Word; { user preference flags }
+ PrintMaxWidth : Word; { max width of printed picture in 10ths/inch }
+ PrintMaxHeight : Word; { max height of printed picture in 10ths/inch }
+ PrintDensity : Byte; { print density }
+ PrintXOffset : Byte; { offset of printed picture in 10ths/inch }
+
+ wb_Width : Word; { override default workbench width }
+ wb_Height : Word; { override default workbench height }
+ wb_Depth : Byte; { override default workbench depth }
+
+ ext_size : Byte; { extension information -- do not touch! }
+ { extension size in blocks of 64 bytes }
+ end;
+
+Const
+
+{ Workbench Interlace (use one bit) }
+ LACEWB = $01;
+ LW_RESERVED = 1; { internal use only }
+
+{ PrinterPort }
+ PARALLEL_PRINTER = $00;
+ SERIAL_PRINTER = $01;
+
+{ BaudRate }
+ BAUD_110 = $00;
+ BAUD_300 = $01;
+ BAUD_1200 = $02;
+ BAUD_2400 = $03;
+ BAUD_4800 = $04;
+ BAUD_9600 = $05;
+ BAUD_19200 = $06;
+ BAUD_MIDI = $07;
+
+{ PaperType }
+ FANFOLD = $00;
+ SINGLE = $80;
+
+{ PrintPitch }
+ PICA = $000;
+ ELITE = $400;
+ FINE = $800;
+
+{ PrintQuality }
+ DRAFT = $000;
+ LETTER = $100;
+
+{ PrintSpacing }
+ SIX_LPI = $000;
+ EIGHT_LPI = $200;
+
+{ Print Image }
+ IMAGE_POSITIVE = $00;
+ IMAGE_NEGATIVE = $01;
+
+{ PrintAspect }
+ ASPECT_HORIZ = $00;
+ ASPECT_VERT = $01;
+
+{ PrintShade }
+ SHADE_BW = $00;
+ SHADE_GREYSCALE = $01;
+ SHADE_COLOR = $02;
+
+{ PaperSize }
+ US_LETTER = $00;
+ US_LEGAL = $10;
+ N_TRACTOR = $20;
+ W_TRACTOR = $30;
+ CUSTOM_PAPER = $40;
+
+{ New PaperSizes for V36: }
+ EURO_A0 = $50; { European size A0: 841 x 1189 }
+ EURO_A1 = $60; { European size A1: 594 x 841 }
+ EURO_A2 = $70; { European size A2: 420 x 594 }
+ EURO_A3 = $80; { European size A3: 297 x 420 }
+ EURO_A4 = $90; { European size A4: 210 x 297 }
+ EURO_A5 = $A0; { European size A5: 148 x 210 }
+ EURO_A6 = $B0; { European size A6: 105 x 148 }
+ EURO_A7 = $C0; { European size A7: 74 x 105 }
+ EURO_A8 = $D0; { European size A8: 52 x 74 }
+
+{ PrinterType }
+ CUSTOM_NAME = $00;
+ ALPHA_P_101 = $01;
+ BROTHER_15XL = $02;
+ CBM_MPS1000 = $03;
+ DIAB_630 = $04;
+ DIAB_ADV_D25 = $05;
+ DIAB_C_150 = $06;
+ EPSON = $07;
+ EPSON_JX_80 = $08;
+ OKIMATE_20 = $09;
+ QUME_LP_20 = $0A;
+{ new printer entries, 3 October 1985 }
+ HP_LASERJET = $0B;
+ HP_LASERJET_PLUS = $0C;
+
+{ Serial Input Buffer Sizes }
+ SBUF_512 = $00;
+ SBUF_1024 = $01;
+ SBUF_2048 = $02;
+ SBUF_4096 = $03;
+ SBUF_8000 = $04;
+ SBUF_16000 = $05;
+
+{ Serial Bit Masks }
+ SREAD_BITS = $F0; { for SerRWBits }
+ SWRITE_BITS = $0F;
+
+ SSTOP_BITS = $F0; { for SerStopBuf }
+ SBUFSIZE_BITS = $0F;
+
+ SPARITY_BITS = $F0; { for SerParShk }
+ SHSHAKE_BITS = $0F;
+
+{ Serial Parity (upper nibble, after being shifted by
+ * macro SPARNUM() )
+ }
+ SPARITY_NONE = 0;
+ SPARITY_EVEN = 1;
+ SPARITY_ODD = 2;
+
+{ Serial Handshake Mode (lower nibble, after masking using
+ * macro SHANKNUM() )
+ }
+ SHSHAKE_XON = 0;
+ SHSHAKE_RTS = 1;
+ SHSHAKE_NONE = 2;
+
+{ new defines for PrintFlags }
+
+ CORRECT_RED = $0001; { color correct red shades }
+ CORRECT_GREEN = $0002; { color correct green shades }
+ CORRECT_BLUE = $0004; { color correct blue shades }
+
+ CENTER_IMAGE = $0008; { center image on paper }
+
+ IGNORE_DIMENSIONS = $0000; { ignore max width/height settings }
+ BOUNDED_DIMENSIONS = $0010; { use max width/height as boundaries }
+ ABSOLUTE_DIMENSIONS = $0020; { use max width/height as absolutes }
+ PIXEL_DIMENSIONS = $0040; { use max width/height as prt pixels }
+ MULTIPLY_DIMENSIONS = $0080; { use max width/height as multipliers }
+
+ INTEGER_SCALING = $0100; { force integer scaling }
+
+ ORDERED_DITHERING = $0000; { ordered dithering }
+ HALFTONE_DITHERING = $0200; { halftone dithering }
+ FLOYD_DITHERING = $0400; { Floyd-Steinberg dithering }
+
+ ANTI_ALIAS = $0800; { anti-alias image }
+ GREY_SCALE2 = $1000; { for use with hi-res monitor }
+
+{ masks used for checking bits }
+
+ CORRECT_RGB_MASK = CORRECT_RED + CORRECT_GREEN + CORRECT_BLUE;
+ DIMENSIONS_MASK = BOUNDED_DIMENSIONS + ABSOLUTE_DIMENSIONS +
+ PIXEL_DIMENSIONS + MULTIPLY_DIMENSIONS;
+ DITHERING_MASK = HALFTONE_DITHERING + FLOYD_DITHERING;
+
+
+
+
+
+
+{ ======================================================================== }
+{ === IntuitionBase ====================================================== }
+{ ======================================================================== }
+{
+ * Be sure to protect yourself against someone modifying these data as
+ * you look at them. This is done by calling:
+ *
+ * lock = LockIBase(0), which returns an Integer. When done call
+ * UnlockIBase(lock) where lock is what LockIBase() returned.
+ }
+
+Type
+
+ pIntuitionBase = ^tIntuitionBase;
+ tIntuitionBase = record
+{ IntuitionBase should never be directly modified by programs }
+{ even a little bit, guys/gals; do you hear me? }
+
+ LibNode : tLibrary;
+
+ ViewLord : tView;
+
+ ActiveWindow : pWindow;
+ ActiveScreen : pScreen;
+
+ { the FirstScreen variable points to the frontmost Screen. Screens are
+ * then maintained in a front to back order using Screen.NextScreen
+ }
+
+ FirstScreen : pScreen; { for linked list of all screens }
+
+ Flags : Cardinal; { see definitions below }
+ MouseY,
+ MouseX : smallint; { mouse position relative to View }
+
+ Seconds : Cardinal; { timestamp of most current input event }
+ Micros : Cardinal; { timestamp of most current input event }
+
+ { I told you this was private.
+ * The data beyond this point has changed, is changing, and
+ * will continue to change.
+ }
+
+ end;
+
+
+{
+ * Package of information passed to custom and 'boopsi'
+ * gadget 'hook' functions. This structure is READ ONLY.
+ }
+Type
+
+ pGadgetInfo = ^tGadgetInfo;
+ tGadgetInfo = record
+ gi_Screen : pScreen; { ScreenPtr }
+ gi_Window : pWindow; { null for screen gadgets } { WindowPtr }
+ gi_Requester : pRequester; { null IF not GTYP_REQGADGET } { RequesterPtr }
+
+ { rendering information:
+ * don't use these without cloning/locking.
+ * Official way is to call ObtainRPort()
+ }
+ gi_RastPort : pRastPort; { RastPortPtr }
+ gi_Layer : pLayer; { LayerPtr }
+
+ { copy of dimensions of screen/window/g00/req(/group)
+ * that gadget resides in. Left/Top of this box is
+ * offset from window mouse coordinates to gadget coordinates
+ * screen gadgets: 0,0 (from screen coords)
+ * window gadgets (no g00): 0,0
+ * GTYP_GZZGADGETs (borderlayer): 0,0
+ * GZZ innerlayer gadget: borderleft, bordertop
+ * Requester gadgets: reqleft, reqtop
+ }
+ gi_Domain : tIBox;
+
+ gi_Pens : record
+ DetailPen : Byte;
+ BlockPen : Byte;
+ end;
+
+ { the Detail and Block pens in gi_DrInfo->dri_Pens[] are
+ * for the screen. Use the above for window-sensitive
+ * colors.
+ }
+ gi_DrInfo : pDrawInfo; { DrawInfoPtr }
+
+ { reserved space: this structure is extensible
+ * anyway, but using these saves some recompilation
+ }
+ gi_Reserved : Array[0..5] of Cardinal;
+ END;
+
+{** system private data structure for now **}
+{ prop gadget extra info }
+
+ pPGX = ^tPGX;
+ tPGX = record
+ pgx_Container : tIBox;
+ pgx_NewKnob : tIBox;
+ END;
+
+{ this casts MutualExclude for easy assignment of a hook
+ * pointer to the unused MutualExclude field of a custom gadget
+ }
+
+{** User visible handles on objects, classes, messages **}
+Type
+ Object_ = Cardinal;
+ pObject_ = ^Object_;
+ ClassID = ^Byte;
+
+{
+ you can use this type to point to a 'generic' message,
+ * in the object-oriented programming parlance. Based on
+ * the value of 'MethodID', you dispatch to processing
+ * for the various message types. The meaningful parameter
+ * packet structure definitions are defined below.
+
+typedef struct
+ Cardinal MethodID;
+ method-specific data follows, some examples below
+ *Msg; }
+
+ pMsg = ^tMsg;
+ tMsg = record
+ MethodID : Cardinal;
+ end;
+
+{
+ * Class id strings for Intuition classes.
+ * There's no real reason to use the uppercase constants
+ * over the lowercase strings, but this makes a good place
+ * to list the names of the built-in classes.
+ }
+CONST
+ ROOTCLASS : PChar = 'rootclass' ; { classusr.h }
+ IMAGECLASS : PChar = 'imageclass' ; { imageclass.h }
+ FRAMEICLASS : PChar = 'frameiclass' ;
+ SYSICLASS : PChar = 'sysiclass' ;
+ FILLRECTCLASS : PChar = 'fillrectclass';
+ GADGETCLASS : PChar = 'gadgetclass' ; { gadgetclass.h }
+ PROPGCLASS : PChar = 'propgclass' ;
+ STRGCLASS : PChar = 'strgclass' ;
+ BUTTONGCLASS : PChar = 'buttongclass' ;
+ FRBUTTONCLASS : PChar = 'frbuttonclass';
+ GROUPGCLASS : PChar = 'groupgclass' ;
+ ICCLASS : PChar = 'icclass' ; { icclass.h }
+ MODELCLASS : PChar = 'modelclass' ;
+ ITEXTICLASS : PChar = 'itexticlass' ;
+ POINTERCLASS : PChar = 'pointerclass' ; { pointerclass.h }
+
+
+{ Dispatched method ID's
+ * NOTE: Applications should use Intuition entry points, not direct
+ * DoMethod() calls, for NewObject, DisposeObject, SetAttrs,
+ * SetGadgetAttrs, and GetAttr.
+ }
+
+ OM_Dummy = ($100);
+ OM_NEW = ($101); { 'object' parameter is 'true class' }
+ OM_DISPOSE = ($102); { delete self (no parameters) }
+ OM_SET = ($103); { set attributes (in tag list) }
+ OM_GET = ($104); { return single attribute value }
+ OM_ADDTAIL = ($105); { add self to a List (let root do it) }
+ OM_REMOVE = ($106); { remove self from list }
+ OM_NOTIFY = ($107); { send to self: notify dependents }
+ OM_UPDATE = ($108); { notification message from somebody }
+ OM_ADDMEMBER = ($109); { used by various classes with lists }
+ OM_REMMEMBER = ($10A); { used by various classes with lists }
+
+{ Parameter 'Messages' passed to methods }
+
+{ OM_NEW and OM_SET }
+Type
+ popSet = ^topSet;
+ topSet = record
+ MethodID : Cardinal;
+ ops_AttrList : pTagItem; { new attributes }
+ ops_GInfo : pGadgetInfo; { always there for gadgets,
+ * when SetGadgetAttrs() is used,
+ * but will be NULL for OM_NEW
+ }
+ END;
+
+{ OM_NOTIFY, and OM_UPDATE }
+
+ popUpdate = ^topUpdate;
+ topUpdate = record
+ MethodID : Cardinal;
+ opu_AttrList : pTagItem; { new attributes }
+ opu_GInfo : pGadgetInfo; { non-NULL when SetGadgetAttrs OR
+ * notification resulting from gadget
+ * input occurs.
+ }
+ opu_Flags : Cardinal; { defined below }
+ END;
+
+{ this flag means that the update message is being issued from
+ * something like an active gadget, a la GACT_FOLLOWMOUSE. When
+ * the gadget goes inactive, it will issue a final update
+ * message with this bit cleared. Examples of use are for
+ * GACT_FOLLOWMOUSE equivalents for propgadclass, and repeat strobes
+ * for buttons.
+ }
+CONST
+ OPUF_INTERIM = 1;
+
+{ OM_GET }
+Type
+
+ popGet = ^topGet;
+ topGet = record
+ MethodID,
+ opg_AttrID : Cardinal;
+ opg_Storage : Pointer; { may be other types, but 'int'
+ * types are all Cardinal
+ }
+ END;
+
+{ OM_ADDTAIL }
+
+ popAddTail = ^topAddTail;
+ topAddTail = record
+ MethodID : Cardinal;
+ opat_List : pList;
+ END;
+
+{ OM_ADDMEMBER, OM_REMMEMBER }
+Type
+
+ popMember = ^topMember;
+ topMember = record
+ MethodID : Cardinal;
+ opam_Object : pObject_;
+ END;
+
+
+
+{*****************************************}
+{** 'White box' access to struct IClass **}
+{*****************************************}
+
+{ This structure is READ-ONLY, and allocated only by Intuition }
+TYPE
+
+ pIClass = ^tIClass;
+ tIClass = record
+ cl_Dispatcher : tHook;
+ cl_Reserved : Cardinal; { must be 0 }
+ cl_Super : pIClass;
+ cl_ID : ClassID;
+
+ { where within an object is the instance data for this class? }
+ cl_InstOffset : Word;
+ cl_InstSize : Word;
+
+ cl_UserData : Cardinal; { per-class data of your choice }
+ cl_SubclassCount : Cardinal;
+ { how many direct subclasses? }
+ cl_ObjectCount : Cardinal;
+ { how many objects created of this class? }
+ cl_Flags : Cardinal;
+ END;
+
+CONST
+ CLF_INLIST = $00000001; { class is in public class list }
+
+
+
+{************************************************}
+{** 'White box' access to struct _Object **}
+{************************************************}
+
+{
+ * We have this, the instance data of the root class, PRECEDING
+ * the 'object'. This is so that Gadget objects are Gadget pointers,
+ * and so on. If this structure grows, it will always have o_Class
+ * at the end, so the macro OCLASS(o) will always have the same
+ * offset back from the pointer returned from NewObject().
+ *
+ * This data structure is subject to change. Do not use the o_Node
+ * embedded structure.
+ }
+Type
+ p_Object = ^t_Object;
+ t_Object = record
+ o_Node : tMinNode;
+ o_Class : pIClass;
+ END;
+
+{ BOOPSI class libraries should use this structure as the base for their
+ * library data. This allows developers to obtain the class pointer for
+ * performing object-less inquiries. }
+
+
+ PClassLibrary = ^tClassLibrary;
+ tClassLibrary = record
+ cl_Lib : tLibrary; { Embedded library }
+ cl_Pad : Word; { Align the structure }
+ cl_Class : PIClass; { Class pointer }
+ end;
+
+{
+ * NOTE: <intuition/iobsolete.h> is included at the END of this file!
+ }
+
+{ Gadget Class attributes }
+CONST
+ GA_Dummy = (TAG_USER +$30000);
+
+ { (LONG) Left edge of the gadget relative to the left edge of
+ * the window }
+ GA_Left = (GA_Dummy + $0001);
+
+ { (LONG) Left edge of the gadget relative to the right edge of
+ * the window }
+ GA_RelRight = (GA_Dummy + $0002);
+
+ { (LONG) Top edge of the gadget relative to the top edge of
+ * the window }
+ GA_Top = (GA_Dummy + $0003);
+
+ { (LONG) Top edge of the gadget relative to the bottom edge
+ * of the window }
+ GA_RelBottom = (GA_Dummy + $0004);
+
+ { (LONG) Width of the gadget }
+ GA_Width = (GA_Dummy + $0005);
+
+ { (LONG) Width of the gadget relative to the width of the
+ * window }
+ GA_RelWidth = (GA_Dummy + $0006);
+
+ { (LONG) Height of the gadget }
+ GA_Height = (GA_Dummy + $0007);
+
+ { (LONG) Height of the gadget relative to the height of
+ * the window }
+ GA_RelHeight = (GA_Dummy + $0008);
+
+ { (PChar) Gadget imagry is NULL terminated string }
+ GA_Text = (GA_Dummy + $0009); { ti_Data is (UBYTE *) }
+
+ { (struct Image *) Gadget imagry is an image }
+ GA_Image = (GA_Dummy + $000A);
+
+ { (struct Border *) Gadget imagry is a border }
+ GA_Border = (GA_Dummy + $000B);
+
+ { (struct Image *) Selected gadget imagry }
+ GA_SelectRender = (GA_Dummy + $000C);
+
+ { (UWORD) One of GFLG_GADGHNONE, GFLG_GADGHBOX, GFLG_GADGHCOMP,
+ * or GFLG_GADGHIMAGE }
+ GA_Highlight = (GA_Dummy + $000D);
+
+ { (BOOL) Indicate whether gadget is disabled or not.
+ * Defaults to FALSE. }
+ GA_Disabled = (GA_Dummy + $000E);
+
+ { (BOOL) Indicate whether the gadget is for
+ * WFLG_GIMMEZEROZERO window borders or not. Defaults
+ * to FALSE. }
+ GA_GZZGadget = (GA_Dummy + $000F);
+
+ { (UWORD) Gadget ID assigned by the application }
+ GA_ID = (GA_Dummy + $0010);
+
+ { (APTR) Application specific data }
+ GA_UserData = (GA_Dummy + $0011);
+
+ { (APTR) Gadget specific data }
+ GA_SpecialInfo = (GA_Dummy + $0012);
+
+ { (BOOL) Indicate whether the gadget is selected or not.
+ * Defaults to FALSE }
+ GA_Selected = (GA_Dummy + $0013);
+
+ { (BOOL) When set tells the system that when this gadget
+ * is selected causes the requester that it is in to be
+ * ended. Defaults to FALSE. }
+ GA_EndGadget = (GA_Dummy + $0014);
+
+ { (BOOL) When set indicates that the gadget is to
+ * notify the application when it becomes active. Defaults
+ * to FALSE. }
+ GA_Immediate = (GA_Dummy + $0015);
+
+ { (BOOL) When set indicates that the application wants to
+ * verify that the pointer was still over the gadget when
+ * the select button is released. Defaults to FALSE. }
+ GA_RelVerify = (GA_Dummy + $0016);
+
+ { (BOOL) When set indicates that the application wants to
+ * be notified of mouse movements while the gadget is active.
+ * It is recommmended that GA_Immediate and GA_RelVerify are
+ * also used so that the active gadget can be tracked by the
+ * application. Defaults to FALSE. }
+ GA_FollowMouse = (GA_Dummy + $0017);
+
+ { (BOOL) Indicate whether the gadget is in the right border
+ * or not. Defaults to FALSE. }
+ GA_RightBorder = (GA_Dummy + $0018);
+
+ { (BOOL) Indicate whether the gadget is in the left border
+ * or not. Defaults to FALSE. }
+ GA_LeftBorder = (GA_Dummy + $0019);
+
+ { (BOOL) Indicate whether the gadget is in the top border
+ * or not. Defaults to FALSE. }
+ GA_TopBorder = (GA_Dummy + $001A);
+
+ { (BOOL) Indicate whether the gadget is in the bottom border
+ * or not. Defaults to FALSE. }
+ GA_BottomBorder = (GA_Dummy + $001B);
+
+ { (BOOL) Indicate whether the gadget is toggle-selected
+ * or not. Defaults to FALSE. }
+ GA_ToggleSelect = (GA_Dummy + $001C);
+
+ { (BOOL) Reserved for system use to indicate that the
+ * gadget belongs to the system. Defaults to FALSE. }
+ GA_SysGadget = (GA_Dummy + $001D);
+
+ { (UWORD) Reserved for system use to indicate the
+ * gadget type. }
+ GA_SysGType = (GA_Dummy + $001E);
+
+ { (struct Gadget *) Previous gadget in the linked list.
+ * NOTE: This attribute CANNOT be used to link new gadgets
+ * into the gadget list of an open window or requester.
+ * You must use AddGList(). }
+ GA_Previous = (GA_Dummy + $001F);
+
+ { (struct Gadget *) Next gadget in the linked list. }
+ GA_Next = (GA_Dummy + $0020);
+
+ { (struct DrawInfo *) Some gadgets need a DrawInfo at creation time }
+ GA_DrawInfo = (GA_Dummy + $0021);
+
+ { You should use at most ONE of GA_Text, GA_IntuiText, and GA_LabelImage }
+ { (struct IntuiText *) Label is an IntuiText. }
+ GA_IntuiText = (GA_Dummy + $0022);
+
+ { (Object *) Label is an image object. }
+ GA_LabelImage = (GA_Dummy + $0023);
+
+ { New for V37:
+ * Boolean indicates that this gadget is to participate in
+ * cycling activation with Tab or Shift-Tab.
+ }
+ GA_TabCycle = (GA_Dummy + $0024);
+
+ { New for V39:
+ * Boolean indicates that this gadget sends gadget-help
+ }
+ GA_GadgetHelp = (GA_Dummy + $0025);
+
+ { New for V39:
+ * ti_Data is a pointer to an IBox structure which is
+ * to be copied into the extended gadget's bounds.
+ }
+ GA_Bounds = (GA_Dummy + $0026);
+
+ { New for V39:
+ * Boolean indicates that this gadget has the "special relativity"
+ * property, which is useful for certain fancy relativity
+ * operations through the GM_LAYOUT method.
+ }
+ GA_RelSpecial = (GA_Dummy + $0027);
+
+
+ GA_TextAttr = GA_Dummy + 40;
+ { (struct TextAttr ) Indicate the font to use for the gadget.
+ New for V42. }
+
+ GA_ReadOnly = GA_Dummy + 41;
+ { (BOOL) Indicate that the gadget is read-only (non-selectable).
+ Defaults to FALSE. New for V42. }
+
+ GA_Underscore = GA_Dummy + 42;
+ { (UBYTE) Underscore/escape character for keyboard shortcuts.
+ Defaults to '_' . New for V44. }
+
+ GA_ActivateKey = GA_Dummy + 43;
+ { (PChar) Set/Get the gadgets shortcut/activation key(s)
+ Defaults to NULL. New for V44. }
+
+ GA_BackFill = GA_Dummy + 44;
+ { (struct Hook ) Backfill pattern hook.
+ Defaults to NULL. New for V44. }
+
+ GA_GadgetHelpText = GA_Dummy + 45;
+ { (PChar) RESERVERD/PRIVATE DO NOT USE
+ Defaults to NULL. New for V44. }
+
+ GA_UserInput = GA_Dummy + 46;
+ { (BOOL) Notification tag indicates this notification is from the activite
+ gadget receiving user input - an attempt to make IDCMPUPDATE more efficient.
+ Defaults to FALSE. New for V44. }
+{ PROPGCLASS attributes }
+
+ PGA_Dummy = (TAG_USER + $31000);
+ PGA_Freedom = (PGA_Dummy + $0001);
+ { only one of FREEVERT or FREEHORIZ }
+ PGA_Borderless = (PGA_Dummy + $0002);
+ PGA_HorizPot = (PGA_Dummy + $0003);
+ PGA_HorizBody = (PGA_Dummy + $0004);
+ PGA_VertPot = (PGA_Dummy + $0005);
+ PGA_VertBody = (PGA_Dummy + $0006);
+ PGA_Total = (PGA_Dummy + $0007);
+ PGA_Visible = (PGA_Dummy + $0008);
+ PGA_Top = (PGA_Dummy + $0009);
+{ New for V37: }
+ PGA_NewLook = (PGA_Dummy + $000A);
+
+{ STRGCLASS attributes }
+
+ STRINGA_Dummy = (TAG_USER +$32000);
+ STRINGA_MaxChars = (STRINGA_Dummy + $0001);
+ STRINGA_Buffer = (STRINGA_Dummy + $0002);
+ STRINGA_UndoBuffer = (STRINGA_Dummy + $0003);
+ STRINGA_WorkBuffer = (STRINGA_Dummy + $0004);
+ STRINGA_BufferPos = (STRINGA_Dummy + $0005);
+ STRINGA_DispPos = (STRINGA_Dummy + $0006);
+ STRINGA_AltKeyMap = (STRINGA_Dummy + $0007);
+ STRINGA_Font = (STRINGA_Dummy + $0008);
+ STRINGA_Pens = (STRINGA_Dummy + $0009);
+ STRINGA_ActivePens = (STRINGA_Dummy + $000A);
+ STRINGA_EditHook = (STRINGA_Dummy + $000B);
+ STRINGA_EditModes = (STRINGA_Dummy + $000C);
+
+{ booleans }
+ STRINGA_ReplaceMode = (STRINGA_Dummy + $000D);
+ STRINGA_FixedFieldMode = (STRINGA_Dummy + $000E);
+ STRINGA_NoFilterMode = (STRINGA_Dummy + $000F);
+
+ STRINGA_Justification = (STRINGA_Dummy + $0010);
+ { GACT_STRINGCENTER, GACT_STRINGLEFT, GACT_STRINGRIGHT }
+ STRINGA_LongVal = (STRINGA_Dummy + $0011);
+ STRINGA_TextVal = (STRINGA_Dummy + $0012);
+
+ STRINGA_ExitHelp = (STRINGA_Dummy + $0013);
+ { STRINGA_ExitHelp is new for V37, and ignored by V36.
+ * Set this if you want the gadget to exit when Help is
+ * pressed. Look for a code of $5F, the rawkey code for Help
+ }
+
+ SG_DEFAULTMAXCHARS = (128);
+
+{ Gadget Layout related attributes }
+
+ LAYOUTA_Dummy = (TAG_USER + $38000);
+ LAYOUTA_LayoutObj = (LAYOUTA_Dummy + $0001);
+ LAYOUTA_Spacing = (LAYOUTA_Dummy + $0002);
+ LAYOUTA_Orientation = (LAYOUTA_Dummy + $0003);
+
+ LAYOUTA_ChildMaxWidth = LAYOUTA_Dummy + $0004;
+ { (BOOL) Child objects are of equal width. Should default to TRUE for
+ gadgets with a horizontal orientation. New for V42. }
+
+ LAYOUTA_ChildMaxHeight = LAYOUTA_Dummy + $0005;
+ { (BOOL) Child objects are of equal height. Should default to TRUE for
+ gadgets with a vertical orientation. New for V42. }
+
+{ orientation values }
+ LORIENT_NONE = 0;
+ LORIENT_HORIZ = 1;
+ LORIENT_VERT = 2;
+
+
+{ Gadget Method ID's }
+
+ GM_Dummy = (-1); { not used for anything }
+ GM_HITTEST = (0); { return GMR_GADGETHIT IF you are clicked on
+ * (whether or not you are disabled).
+ }
+ GM_RENDER = (1); { draw yourself, in the appropriate state }
+ GM_GOACTIVE = (2); { you are now going to be fed input }
+ GM_HANDLEINPUT = (3); { handle that input }
+ GM_GOINACTIVE = (4); { whether or not by choice, you are done }
+ GM_HELPTEST = (5); { Will you send gadget help if the mouse is
+ * at the specified coordinates? See below
+ * for possible GMR_ values.
+ }
+ GM_LAYOUT = (6); { re-evaluate your size based on the GadgetInfo
+ * Domain. Do NOT re-render yourself yet, you
+ * will be called when it is time...
+ }
+
+{ Parameter "Messages" passed to gadget class methods }
+
+{ GM_HITTEST }
+type
+
+ pgpHitTest = ^tgpHitTest;
+ tgpHitTest = record
+ MethodID : Cardinal;
+ gpht_GInfo : pGadgetInfo;
+ gpht_Mouse : record
+ x : smallint;
+ y : smallint;
+ end;
+ END;
+
+const
+{ For GM_HITTEST, return GMR_GADGETHIT if you were indeed hit,
+ * otherwise return zero.
+ *
+ * For GM_HELPTEST, return GMR_NOHELPHIT (zero) if you were not hit.
+ * Typically, return GMR_HELPHIT if you were hit.
+ * It is possible to pass a UWORD to the application via the Code field
+ * of the IDCMP_GADGETHELP message. Return GMR_HELPCODE or'd with
+ * the UWORD-sized result you wish to return.
+ *
+ * GMR_HELPHIT yields a Code value of ((UWORD) ~0), which should
+ * mean "nothing particular" to the application.
+ }
+
+ GMR_GADGETHIT = ($00000004); { GM_HITTEST hit }
+
+ GMR_NOHELPHIT = ($00000000); { GM_HELPTEST didn't hit }
+ GMR_HELPHIT = ($FFFFFFFF); { GM_HELPTEST hit, return code = ~0 }
+ GMR_HELPCODE = ($00010000); { GM_HELPTEST hit, return low word as code }
+
+
+{ GM_RENDER }
+Type
+ pgpRender = ^tgpRender;
+ tgpRender = record
+ MethodID : Cardinal;
+ gpr_GInfo : pGadgetInfo; { gadget context }
+ gpr_RPort : pRastPort; { all ready for use }
+ gpr_Redraw : Longint; { might be a "highlight pass" }
+ END;
+
+{ values of gpr_Redraw }
+CONST
+ GREDRAW_UPDATE = (2); { incremental update, e.g. prop slider }
+ GREDRAW_REDRAW = (1); { redraw gadget }
+ GREDRAW_TOGGLE = (0); { toggle highlight, IF applicable }
+
+{ GM_GOACTIVE, GM_HANDLEINPUT }
+Type
+
+ pgpInput = ^tgpInput;
+ tgpInput = record
+ MethodID : Cardinal;
+ gpi_GInfo : pGadgetInfo;
+ gpi_IEvent : pInputEvent;
+ gpi_Termination : Pointer;
+ gpi_Mouse : record
+ x : smallint;
+ y : smallint;
+ end;
+ {* (V39) Pointer to TabletData structure, if this event originated
+ * from a tablet which sends IESUBCLASS_NEWTABLET events, or NULL if
+ * not.
+ *
+ * DO NOT ATTEMPT TO READ THIS FIELD UNDER INTUITION PRIOR TO V39!
+ * IT WILL BE INVALID!
+ *}
+ gpi_TabletData : pTabletData;
+ END;
+
+{ GM_HANDLEINPUT and GM_GOACTIVE return code flags }
+{ return GMR_MEACTIVE (0) alone if you want more input.
+ * Otherwise, return ONE of GMR_NOREUSE and GMR_REUSE, and optionally
+ * GMR_VERIFY.
+ }
+CONST
+ GMR_MEACTIVE = (0);
+ GMR_NOREUSE = (2);
+ GMR_REUSE = (4);
+ GMR_VERIFY = (8); { you MUST set cgp_Termination }
+
+{ New for V37:
+ * You can end activation with one of GMR_NEXTACTIVE and GMR_PREVACTIVE,
+ * which instructs Intuition to activate the next or previous gadget
+ * that has GFLG_TABCYCLE set.
+ }
+ GMR_NEXTACTIVE = (16);
+ GMR_PREVACTIVE = (32);
+
+{ GM_GOINACTIVE }
+Type
+
+ pgpGoInactive = ^tgpGoInactive;
+ tgpGoInactive = record
+ MethodID : Cardinal;
+ gpgi_GInfo : pGadgetInfo;
+
+ { V37 field only! DO NOT attempt to read under V36! }
+ gpgi_Abort : Cardinal; { gpgi_Abort=1 IF gadget was aborted
+ * by Intuition and 0 if gadget went
+ * inactive at its own request
+ }
+ END;
+
+{* New for V39: Intuition sends GM_LAYOUT to any GREL_ gadget when
+ * the gadget is added to the window (or when the window opens, if
+ * the gadget was part of the NewWindow.FirstGadget or the WA_Gadgets
+ * list), or when the window is resized. Your gadget can set the
+ * GA_RelSpecial property to get GM_LAYOUT events without Intuition
+ * changing the interpretation of your gadget select box. This
+ * allows for completely arbitrary resizing/repositioning based on
+ * window size.
+ *}
+{* GM_LAYOUT *}
+Type
+
+ pgpLayout = ^tgpLayout;
+ tgpLayout = record
+ MethodID : Cardinal;
+ gpl_GInfo : pGadgetInfo;
+ gpl_Initial : Cardinal; {* non-zero if this method was invoked
+ * during AddGList() or OpenWindow()
+ * time. zero if this method was invoked
+ * during window resizing.
+ *}
+ end;
+
+{***************************************************************************}
+
+{ The GM_DOMAIN method is used to obtain the sizing requirements of an
+ * object for a class before ever creating an object. }
+
+{ GM_DOMAIN }
+
+ PgpDomain = ^tgpDomain;
+ tgpDomain = record
+ MethodID : Cardinal;
+ gpd_GInfo : PGadgetInfo;
+ gpd_RPort : PRastPort; { RastPort to layout for }
+ gpd_Which : LongInt;
+ gpd_Domain : tIBox; { Resulting domain }
+ gpd_Attrs : PTagItem; { Additional attributes }
+ end;
+
+
+ const
+ GDOMAIN_MINIMUM = 0;
+ { Minimum size }
+
+ GDOMAIN_NOMINAL = 1;
+ { Nominal size }
+
+ GDOMAIN_MAXIMUM = 2;
+ { Maximum size }
+
+{***************************************************************************}
+
+{ The GM_KEYTEST method is used to determin if a key press matches an
+ * object's activation key(s). }
+
+{ GM_KEYTEST send this message.
+ }
+
+ type
+ PgpKeyTest = ^tgpKeyTest;
+ tgpKeyTest = record
+ MethodID : Cardinal;
+ gpkt_GInfo : PGadgetInfo;
+ gpkt_IMsg : PIntuiMessage; { The IntuiMessage that triggered this }
+ gpkt_VanillaKey : Cardinal;
+ end;
+
+{***************************************************************************}
+
+{ The GM_KEYGOACTIVE method is called to "simulate" a gadget going down.
+ * A gadget should render itself in a selected state when receiving
+ * this message. If the class supports this method, it must return
+ * GMR_KEYACTIVE.
+ *
+ * If a gadget returns zero for this method, it will subsequently be
+ * activated via ActivateGadget() with a NULL IEvent.
+ }
+
+ PgpKeyInput = ^tgpKeyInput;
+ tgpKeyInput = record
+ MethodID : Cardinal; { GM_KEYGOACTIVE }
+ gpk_GInfo : PGadgetInfo;
+ gpk_IEvent : PInputEvent;
+ gpk_Termination : ^LongInt;
+ end;
+
+
+ const
+ GMR_KEYACTIVE = 1 shl 4;
+
+ { you MUST set gpk_Termination }
+ GMR_KEYVERIFY = 1 shl 5;
+
+{ The GM_KEYGOINACTIVE method is called to simulate the gadget release.
+ * Upon receiving this message, the gadget should do everything a
+ * normal gadget release would do.
+ }
+
+ type
+ PgpKeyGoInactive = ^tgpKeyGoInactive;
+ tgpKeyGoInactive = record
+ MethodID : Cardinal;
+ gpki_GInfo : PGadgetInfo;
+ gpki_Abort : Cardinal;
+ end;
+
+CONST
+ ICM_Dummy = ($0401); { used for nothing }
+ ICM_SETLOOP = ($0402); { set/increment loop counter }
+ ICM_CLEARLOOP = ($0403); { clear/decrement loop counter }
+ ICM_CHECKLOOP = ($0404); { set/increment loop }
+
+{ no parameters for ICM_SETLOOP, ICM_CLEARLOOP, ICM_CHECKLOOP }
+
+{ interconnection attributes used by icclass, modelclass, and gadgetclass }
+ ICA_Dummy = (TAG_USER+$40000);
+ ICA_TARGET = (ICA_Dummy + 1);
+ { interconnection target }
+ ICA_MAP = (ICA_Dummy + 2);
+ { interconnection map tagitem list }
+ ICSPECIAL_CODE = (ICA_Dummy + 3);
+ { a "pseudo-attribute", see below. }
+
+{ Normally, the value for ICA_TARGET is some object pointer,
+ * but if you specify the special value ICTARGET_IDCMP, notification
+ * will be send as an IDCMP_IDCMPUPDATE message to the appropriate window's
+ * IDCMP port. See the definition of IDCMP_IDCMPUPDATE.
+ *
+ * When you specify ICTARGET_IDCMP for ICA_TARGET, the map you
+ * specify will be applied to derive the attribute list that is
+ * sent with the IDCMP_IDCMPUPDATE message. If you specify a map list
+ * which results in the attribute tag id ICSPECIAL_CODE, the
+ * lower sixteen bits of the corresponding ti_Data value will
+ * be copied into the Code field of the IDCMP_IDCMPUPDATE IntuiMessage.
+ }
+ ICTARGET_IDCMP = (NOT 0);
+
+
+CONST
+ CUSTOMIMAGEDEPTH = (-1);
+{ if image.Depth is this, it's a new Image class object }
+
+
+{****************************************************}
+CONST
+ IA_Dummy = (TAG_USER + $20000);
+ IA_Left = (IA_Dummy + $01);
+ IA_Top = (IA_Dummy + $02);
+ IA_Width = (IA_Dummy + $03);
+ IA_Height = (IA_Dummy + $04);
+ IA_FGPen = (IA_Dummy + $05);
+ { IA_FGPen also means "PlanePick" }
+ IA_BGPen = (IA_Dummy + $06);
+ { IA_BGPen also means "PlaneOnOff" }
+ IA_Data = (IA_Dummy + $07);
+ { bitplanes, for classic image,
+ * other image classes may use it for other things
+ }
+ IA_LineWidth = (IA_Dummy + $08);
+ IA_Pens = (IA_Dummy + $0E);
+ { pointer to UWORD pens[],
+ * ala DrawInfo.Pens, MUST be
+ * terminated by ~0. Some classes can
+ * choose to have this, or SYSIA_DrawInfo,
+ * or both.
+ }
+ IA_Resolution = (IA_Dummy + $0F);
+ { packed uwords for x/y resolution into a longword
+ * ala DrawInfo.Resolution
+ }
+
+{*** see class documentation to learn which ****}
+{*** classes recognize these ****}
+ IA_APattern = (IA_Dummy + $10);
+ IA_APatSize = (IA_Dummy + $11);
+ IA_Mode = (IA_Dummy + $12);
+ IA_Font = (IA_Dummy + $13);
+ IA_Outline = (IA_Dummy + $14);
+ IA_Recessed = (IA_Dummy + $15);
+ IA_DoubleEmboss = (IA_Dummy + $16);
+ IA_EdgesOnly = (IA_Dummy + $17);
+
+{*** "sysiclass" attributes ****}
+ SYSIA_Size = (IA_Dummy + $0B);
+ { 's below }
+ SYSIA_Depth = (IA_Dummy + $0C);
+ { this is unused by Intuition. SYSIA_DrawInfo
+ * is used instead for V36
+ }
+ SYSIA_Which = (IA_Dummy + $0D);
+ { see 's below }
+ SYSIA_DrawInfo = (IA_Dummy + $18);
+ { pass to sysiclass, please }
+
+{**** obsolete: don't use these, use IA_Pens ****}
+ SYSIA_Pens = IA_Pens;
+ IA_ShadowPen = (IA_Dummy + $09);
+ IA_HighlightPen = (IA_Dummy + $0A);
+
+{ New for V39: }
+ SYSIA_ReferenceFont = (IA_Dummy + $19);
+ { Font to use as reference for scaling
+ * certain sysiclass images
+ }
+ IA_SupportsDisable = (IA_Dummy + $1a);
+ { By default, Intuition ghosts gadgets itself,
+ * instead of relying on IDS_DISABLED or
+ * IDS_SELECTEDDISABLED. An imageclass that
+ * supports these states should return this attribute
+ * as TRUE. You cannot set or clear this attribute,
+ * however.
+ }
+
+ IA_FrameType = (IA_Dummy + $1b);
+ { Starting with V39, FrameIClass recognizes
+ * several standard types of frame. Use one
+ * of the FRAME_ specifiers below. Defaults
+ * to FRAME_DEFAULT.
+ }
+
+ IA_Underscore = IA_Dummy + $1c;
+ { V44, Indicate underscore keyboard shortcut for image labels.
+ (UBYTE) Defaults to '_'
+ }
+
+ IA_Scalable = IA_Dummy + $1d;
+ { V44, Attribute indicates this image is allowed
+ to/can scale its rendering.
+ (BOOL) Defaults to FALSE.
+ }
+
+ IA_ActivateKey = IA_Dummy + $1e;
+ { V44, Used to get an underscored label shortcut.
+ Useful for labels attached to string gadgets.
+ (UBYTE) Defaults to NULL.
+ }
+
+ IA_Screen = IA_Dummy + $1f;
+ { V44 Screen pointer, may be useful/required by certain classes.
+ (struct Screen )
+ }
+
+ IA_Precision = IA_Dummy + $20;
+ { V44 Precision value, typically pen precision but may be
+ used for similar custom purposes.
+ (Cardinal)
+ }
+
+{* next attribute: (IA_Dummy + $1c) *}
+
+{***********************************************}
+
+{ data values for SYSIA_Size }
+ SYSISIZE_MEDRES = (0);
+ SYSISIZE_LOWRES = (1);
+ SYSISIZE_HIRES = (2);
+
+{
+ * SYSIA_Which tag data values:
+ * Specifies which system gadget you want an image for.
+ * Some numbers correspond to internal Intuition s
+ }
+ DEPTHIMAGE = ($00);
+ ZOOMIMAGE = ($01);
+ SIZEIMAGE = ($02);
+ CLOSEIMAGE = ($03);
+ SDEPTHIMAGE = ($05); { screen depth gadget }
+ LEFTIMAGE = ($0A);
+ UPIMAGE = ($0B);
+ RIGHTIMAGE = ($0C);
+ DOWNIMAGE = ($0D);
+ CHECKIMAGE = ($0E);
+ MXIMAGE = ($0F); { mutual exclude "button" }
+{* New for V39: *}
+ MENUCHECK = ($10); { Menu checkmark image }
+ AMIGAKEY = ($11); { Menu Amiga-key image }
+
+{ Data values for IA_FrameType (recognized by FrameIClass)
+ *
+ * FRAME_DEFAULT: The standard V37-type frame, which has
+ * thin edges.
+ * FRAME_BUTTON: Standard button gadget frames, having thicker
+ * sides and nicely edged corners.
+ * FRAME_RIDGE: A ridge such as used by standard string gadgets.
+ * You can recess the ridge to get a groove image.
+ * FRAME_ICONDROPBOX: A broad ridge which is the standard imagery
+ * for areas in AppWindows where icons may be dropped.
+ }
+
+ FRAME_DEFAULT = 0;
+ FRAME_BUTTON = 1;
+ FRAME_RIDGE = 2;
+ FRAME_ICONDROPBOX = 3;
+
+{ image message id's }
+ IM_DRAW = $202; { draw yourself, with "state" }
+ IM_HITTEST = $203; { return TRUE IF click hits image }
+ IM_ERASE = $204; { erase yourself }
+ IM_MOVE = $205; { draw new AND erase old, smoothly }
+
+ IM_DRAWFRAME= $206; { draw with specified dimensions }
+ IM_FRAMEBOX = $207; { get recommended frame around some box}
+ IM_HITFRAME = $208; { hittest with dimensions }
+ IM_ERASEFRAME= $209; { hittest with dimensions }
+ IM_DOMAINFRAME = $20A;{ query image for its domain info (V44) }
+
+{ image draw states or styles, for IM_DRAW }
+ IDS_NORMAL = (0);
+ IDS_SELECTED = (1); { for selected gadgets }
+ IDS_DISABLED = (2); { for disabled gadgets }
+ IDS_BUSY = (3); { for future functionality }
+ IDS_INDETERMINATE = (4); { for future functionality }
+ IDS_INACTIVENORMAL = (5); { normal, in inactive window border }
+ IDS_INACTIVESELECTED= (6); { selected, in inactive border }
+ IDS_INACTIVEDISABLED= (7); { disabled, in inactive border }
+ IDS_SELECTEDDISABLED = 8; { disabled and selected }
+
+{ oops, please forgive spelling error by jimm }
+ IDS_INDETERMINANT = IDS_INDETERMINATE;
+
+{ IM_FRAMEBOX }
+Type
+
+ pimpFrameBox = ^timpFrameBox;
+ timpFrameBox = record
+ MethodID : Cardinal;
+ imp_ContentsBox : pIBox; { input: relative box of contents }
+ imp_FrameBox : pIBox; { output: rel. box of encl frame }
+ imp_DrInfo : pDrawInfo;
+ imp_FrameFlags : Cardinal;
+ END;
+
+CONST
+ FRAMEF_SPECIFY = (1); { Make do with the dimensions of FrameBox
+ * provided.
+ }
+
+{ IM_DRAW, IM_DRAWFRAME }
+Type
+
+ pimpDraw = ^timpDraw;
+ timpDraw = record
+ MethodID : Cardinal;
+ imp_RPort : pRastPort;
+ imp_Offset : record
+ x : Word;
+ y : Word;
+ end;
+ imp_State : Cardinal;
+ imp_DrInfo : pDrawInfo;
+
+ { these parameters only valid for IM_DRAWFRAME }
+ imp_Dimensions : record
+ Width : Word;
+ Height : Word;
+ end;
+ END;
+
+{ IM_ERASE, IM_ERASEFRAME }
+{ NOTE: This is a subset of impDraw }
+
+ pimpErase = ^timpErase;
+ timpErase = record
+ MethodID : Cardinal;
+ imp_RPort : pRastPort;
+ imp_Offset : record
+ x : Word;
+ y : Word;
+ end;
+
+ { these parameters only valid for IM_ERASEFRAME }
+ imp_Dimensions : record
+ Width : Word;
+ Height : Word;
+ end;
+ END;
+
+{ IM_HITTEST, IM_HITFRAME }
+
+ pimpHitTest = ^timpHitTest;
+ timpHitTest = record
+ MethodID : Cardinal;
+ imp_Point : record
+ x : Word;
+ y : Word;
+ end;
+
+ { these parameters only valid for IM_HITFRAME }
+ imp_Dimensions : record
+ Width : Word;
+ Height : Word;
+ end;
+ END;
+
+
+{ The IM_DOMAINFRAME method is used to obtain the sizing
+ * requirements of an image object within a layout group.
+ }
+
+{ IM_DOMAINFRAME }
+ PimpDomainFrame = ^timpDomainFrame;
+ timpDomainFrame = record
+ MethodID : Cardinal;
+ imp_DrInfo : PDrawInfo;
+ imp_RPort : PRastPort;
+ imp_Which : LongInt;
+ imp_Domain : tIBox;
+ imp_Attrs : PTagItem;
+ end;
+
+ { Accepted vales for imp_Which.
+ }
+
+ const
+ IDOMAIN_MINIMUM = 0;
+ IDOMAIN_NOMINAL = 1;
+ IDOMAIN_MAXIMUM = 2;
+
+ { ** 'boopsi' pointer class interface }
+
+const
+{ The following tags are recognized at NewObject() time by
+ * pointerclass:
+ *
+ * POINTERA_BitMap (struct BitMap *) - Pointer to bitmap to
+ * get pointer imagery from. Bitplane data need not be
+ * in chip RAM.
+ * POINTERA_XOffset (LONG) - X-offset of the pointer hotspot.
+ * POINTERA_YOffset (LONG) - Y-offset of the pointer hotspot.
+ * POINTERA_WordWidth (Cardinal) - designed width of the pointer in words
+ * POINTERA_XResolution (Cardinal) - one of the POINTERXRESN_ flags below
+ * POINTERA_YResolution (Cardinal) - one of the POINTERYRESN_ flags below
+ *
+ }
+
+ POINTERA_Dummy = (TAG_USER + $39000);
+
+ POINTERA_BitMap = (POINTERA_Dummy + $01);
+ POINTERA_XOffset = (POINTERA_Dummy + $02);
+ POINTERA_YOffset = (POINTERA_Dummy + $03);
+ POINTERA_WordWidth = (POINTERA_Dummy + $04);
+ POINTERA_XResolution = (POINTERA_Dummy + $05);
+ POINTERA_YResolution = (POINTERA_Dummy + $06);
+
+{ These are the choices for the POINTERA_XResolution attribute which
+ * will determine what resolution pixels are used for this pointer.
+ *
+ * POINTERXRESN_DEFAULT (ECS-compatible pointer width)
+ * = 70 ns if SUPERHIRES-type mode, 140 ns if not
+ *
+ * POINTERXRESN_SCREENRES
+ * = Same as pixel speed of screen
+ *
+ * POINTERXRESN_LORES (pointer always in lores-like pixels)
+ * = 140 ns in 15kHz modes, 70 ns in 31kHz modes
+ *
+ * POINTERXRESN_HIRES (pointer always in hires-like pixels)
+ * = 70 ns in 15kHz modes, 35 ns in 31kHz modes
+ *
+ * POINTERXRESN_140NS (pointer always in 140 ns pixels)
+ * = 140 ns always
+ *
+ * POINTERXRESN_70NS (pointer always in 70 ns pixels)
+ * = 70 ns always
+ *
+ * POINTERXRESN_35NS (pointer always in 35 ns pixels)
+ * = 35 ns always
+ }
+
+ POINTERXRESN_DEFAULT = 0;
+ POINTERXRESN_140NS = 1;
+ POINTERXRESN_70NS = 2;
+ POINTERXRESN_35NS = 3;
+
+ POINTERXRESN_SCREENRES = 4;
+ POINTERXRESN_LORES = 5;
+ POINTERXRESN_HIRES = 6;
+
+{ These are the choices for the POINTERA_YResolution attribute which
+ * will determine what vertical resolution is used for this pointer.
+ *
+ * POINTERYRESN_DEFAULT
+ * = In 15 kHz modes, the pointer resolution will be the same
+ * as a non-interlaced screen. In 31 kHz modes, the pointer
+ * will be doubled vertically. This means there will be about
+ * 200-256 pointer lines per screen.
+ *
+ * POINTERYRESN_HIGH
+ * POINTERYRESN_HIGHASPECT
+ * = Where the hardware/software supports it, the pointer resolution
+ * will be high. This means there will be about 400-480 pointer
+ * lines per screen. POINTERYRESN_HIGHASPECT also means that
+ * when the pointer comes out double-height due to hardware/software
+ * restrictions, its width would be doubled as well, if possible
+ * (to preserve aspect).
+ *
+ * POINTERYRESN_SCREENRES
+ * POINTERYRESN_SCREENRESASPECT
+ * = Will attempt to match the vertical resolution of the pointer
+ * to the screen's vertical resolution. POINTERYRESN_SCREENASPECT also
+ * means that when the pointer comes out double-height due to
+ * hardware/software restrictions, its width would be doubled as well,
+ * if possible (to preserve aspect).
+ *
+ }
+
+ POINTERYRESN_DEFAULT = 0;
+ POINTERYRESN_HIGH = 2;
+ POINTERYRESN_HIGHASPECT = 3;
+ POINTERYRESN_SCREENRES = 4;
+ POINTERYRESN_SCREENRESASPECT = 5;
+
+{ Compatibility note:
+ *
+ * The AA chipset supports variable sprite width and resolution, but
+ * the setting of width and resolution is global for all sprites.
+ * When no other sprites are in use, Intuition controls the sprite
+ * width and sprite resolution for correctness based on pointerclass
+ * attributes specified by the creator of the pointer. Intuition
+ * controls sprite resolution with the VTAG_DEFSPRITERESN_SET tag
+ * to VideoControl(). Applications can override this on a per-viewport
+ * basis with the VTAG_SPRITERESN_SET tag to VideoControl().
+ *
+ * If an application uses a sprite other than the pointer sprite,
+ * Intuition will automatically regenerate the pointer sprite's image in
+ * a compatible width. This might involve BitMap scaling of the imagery
+ * you supply.
+ *
+ * If any sprites other than the pointer sprite were obtained with the
+ * old GetSprite() call, Intuition assumes that the owner of those
+ * sprites is unaware of sprite resolution, hence Intuition will set the
+ * default sprite resolution (VTAG_DEFSPRITERESN_SET) to ECS-compatible,
+ * instead of as requested by the various pointerclass attributes.
+ *
+ * No resolution fallback occurs when applications use ExtSprites.
+ * Such applications are expected to use VTAG_SPRITERESN_SET tag if
+ * necessary.
+ *
+ * NB: Under release V39, only sprite width compatibility is implemented.
+ * Sprite resolution compatibility was added for V40.
+ }
+
+
+Type
+
+ pStringExtend = ^tStringExtend;
+ tStringExtend = record
+ { display specifications }
+ Font : pTextFont; { must be an open Font (not TextAttr) }
+ Pens : Array[0..1] of Byte; { color of text/backgroun }
+ ActivePens : Array[0..1] of Byte; { colors when gadget is active }
+
+ { edit specifications }
+ InitialModes : Cardinal; { initial mode flags, below }
+ EditHook : pHook; { IF non-NULL, must supply WorkBuffer }
+ WorkBuffer : PChar; { must be as large as StringInfo.Buffer}
+
+ Reserved : Array[0..3] of Cardinal; { set to 0 }
+ END;
+
+ pSGWork = ^tSGWork;
+ tSGWork = record
+ { set up when gadget is first activated }
+ Gad : pGadget; { the contestant itself } { Gadget in C-Includes }
+ StrInfo : pStringInfo; { easy access to sinfo } { StrInfo in C-Includes }
+ WorkBuffer : PChar; { intuition's planned result }
+ PrevBuffer : PChar; { what was there before }
+ Modes : Cardinal; { current mode }
+
+ { modified for each input event }
+ IEvent : pInputEvent; { actual event: do not change }
+ Code : Word; { character code, IF one byte }
+ BufferPos : smallint; { cursor position }
+ NumChars : smallint;
+ Actions : Cardinal; { what Intuition will do }
+ LongInt_ : Longint; { temp storage for longint }
+
+ GInfo : pGadgetInfo; { see cghooks.h } { GadgetInfo in C-Includes }
+ EditOp : Word; { from constants below }
+ END;
+
+{ SGWork.EditOp -
+ * These values indicate what basic type of operation the global
+ * editing hook has performed on the string before your gadget's custom
+ * editing hook gets called. You do not have to be concerned with the
+ * value your custom hook leaves in the EditOp field, only if you
+ * write a global editing hook.
+ *
+ * For most of these general edit operations, you'll want to compare
+ * the BufferPos and NumChars of the StringInfo (before global editing)
+ * and SGWork (after global editing).
+ }
+
+CONST
+ EO_NOOP = ($0001);
+ { did nothing }
+ EO_DELBACKWARD= ($0002);
+ { deleted some chars (maybe 0). }
+ EO_DELFORWARD = ($0003);
+ { deleted some characters under and in front of the cursor }
+ EO_MOVECURSOR = ($0004);
+ { moved the cursor }
+ EO_ENTER = ($0005);
+ { "enter" or "return" key, terminate }
+ EO_RESET = ($0006);
+ { current Intuition-style undo }
+ EO_REPLACECHAR= ($0007);
+ { replaced one character and (maybe) advanced cursor }
+ EO_INSERTCHAR = ($0008);
+ { inserted one char into string or added one at end }
+ EO_BADFORMAT = ($0009);
+ { didn't like the text data, e.g., Bad LONGINT }
+ EO_BIGCHANGE = ($000A); { unused by Intuition }
+ { complete or major change to the text, e.g. new string }
+ EO_UNDO = ($000B); { unused by Intuition }
+ { some other style of undo }
+ EO_CLEAR = ($000C);
+ { clear the string }
+ EO_SPECIAL = ($000D); { unused by Intuition }
+ { some operation that doesn't fit into the categories here }
+
+
+{ Mode Flags definitions (ONLY first group allowed as InitialModes) }
+ SGM_REPLACE = (1); { replace mode }
+{ please initialize StringInfo with in-range value of BufferPos
+ * if you are using SGM_REPLACE mode.
+ }
+
+ SGM_FIXEDFIELD = (2); { fixed length buffer }
+ { always set SGM_REPLACE, too }
+ SGM_NOFILTER = (4); { don't filter control chars }
+
+{ SGM_EXITHELP is new for V37, and ignored by V36: }
+ SGM_EXITHELP = (128); { exit with code = $5F IF HELP hit }
+
+
+{ These Mode Flags are for internal use only }
+ SGM_NOCHANGE = (8); { no edit changes yet }
+ SGM_NOWORKB = (16); { Buffer == PrevBuffer }
+ SGM_CONTROL = (32); { control char escape mode }
+ SGM_LONGINT = (64); { an intuition longint gadget }
+
+{ String Gadget Action Flags (put in SGWork.Actions by EditHook) }
+ SGA_USE = ($1); { use contents of SGWork }
+ SGA_END = ($2); { terminate gadget, code in Code field }
+ SGA_BEEP = ($4); { flash the screen for the user }
+ SGA_REUSE = ($8); { reuse input event }
+ SGA_REDISPLAY = ($10); { gadget visuals changed }
+
+{ New for V37: }
+ SGA_NEXTACTIVE = ($20); { Make next possible gadget active. }
+ SGA_PREVACTIVE = ($40); { Make previous possible gadget active.}
+
+{ function id for only existing custom string gadget edit hook }
+
+ SGH_KEY = (1); { process editing keystroke }
+ SGH_CLICK = (2); { process mouse click cursor position }
+
+{ Here's a brief summary of how the custom string gadget edit hook works:
+ * You provide a hook in StringInfo.Extension.EditHook.
+ * The hook is called in the standard way with the 'object'
+ * a pointer to SGWork, and the 'message' a pointer to a command
+ * block, starting either with (longword) SGH_KEY, SGH_CLICK,
+ * or something new.
+ *
+ * You return 0 if you don't understand the command (SGH_KEY is
+ * required and assumed). Return non-zero if you implement the
+ * command.
+ *
+ * SGH_KEY:
+ * There are no parameters following the command longword.
+ *
+ * Intuition will put its idea of proper values in the SGWork
+ * before calling you, and if you leave SGA_USE set in the
+ * SGWork.Actions field, Intuition will use the values
+ * found in SGWork fields WorkBuffer, NumChars, BufferPos,
+ * and LongInt, copying the WorkBuffer back to the StringInfo
+ * Buffer.
+ *
+ * NOTE WELL: You may NOT change other SGWork fields.
+ *
+ * If you clear SGA_USE, the string gadget will be unchanged.
+ *
+ * If you set SGA_END, Intuition will terminate the activation
+ * of the string gadget. If you also set SGA_REUSE, Intuition
+ * will reuse the input event after it deactivates your gadget.
+ *
+ * In this case, Intuition will put the value found in SGWork.Code
+ * into the IntuiMessage.Code field of the IDCMP_GADGETUP message it
+ * sends to the application.
+ *
+ * If you set SGA_BEEP, Intuition will call DisplayBeep(); use
+ * this if the user has typed in error, or buffer is full.
+ *
+ * Set SGA_REDISPLAY if the changes to the gadget warrant a
+ * gadget redisplay. Note: cursor movement requires a redisplay.
+ *
+ * Starting in V37, you may set SGA_PREVACTIVE or SGA_NEXTACTIVE
+ * when you set SGA_END. This tells Intuition that you want
+ * the next or previous gadget with GFLG_TABCYCLE to be activated.
+ *
+ * SGH_CLICK:
+ * This hook command is called when Intuition wants to position
+ * the cursor in response to a mouse click in the string gadget.
+ *
+ * Again, here are no parameters following the command longword.
+ *
+ * This time, Intuition has already calculated the mouse position
+ * character cell and put it in SGWork.BufferPos. The previous
+ * BufferPos value remains in the SGWork.StringInfo.BufferPos.
+ *
+ * Intuition will again use the SGWork fields listed above for
+ * SGH_KEY. One restriction is that you are NOT allowed to set
+ * SGA_END or SGA_REUSE for this command. Intuition will not
+ * stand for a gadget which goes inactive when you click in it.
+ *
+ * You should always leave the SGA_REDISPLAY flag set, since Intuition
+ * uses this processing when activating a string gadget.
+ }
+
+const
+ INTUITIONNAME : PChar = 'intuition.library';
+
+var
+ intuitionbase : PIntuitionBase;
+
+
+procedure OpenIntuition;
+SysCall IntuitionBase 030;
+
+procedure Intuition(iEvent : pInputEvent location 'a0');
+SysCall IntuitionBase 036;
+
+function AddGadget(window : pWindow location 'a0'; gadget : pGadget location 'a1'; position : CARDINAL location 'd0') : Word;
+SysCall IntuitionBase 042;
+
+function ClearDMRequest(window : pWindow location 'a0') : BOOLEAN;
+SysCall IntuitionBase 048;
+
+procedure ClearMenuStrip(window : pWindow location 'a0');
+SysCall IntuitionBase 054;
+
+procedure ClearPointer(window : pWindow location 'a0');
+SysCall IntuitionBase 060;
+
+function CloseScreen(screen : pScreen location 'a0') : BOOLEAN;
+SysCall IntuitionBase 066;
+
+procedure CloseWindow(window : pWindow location 'a0');
+SysCall IntuitionBase 072;
+
+function CloseWorkBench : LongInt;
+SysCall IntuitionBase 078;
+
+procedure CurrentTime(VAR seconds : CARDINAL location 'a0'; VAR micros : CARDINAL location 'a1');
+SysCall IntuitionBase 084;
+
+function DisplayAlert(alertNumber : CARDINAL location 'd0'; string1 : PChar location 'a0'; height : CARDINAL location 'd1') : BOOLEAN;
+SysCall IntuitionBase 090;
+
+procedure DisplayBeep(screen : pScreen location 'a0');
+SysCall IntuitionBase 096;
+
+function DoubleClick(sSeconds : CARDINAL location 'd0'; sMicros : CARDINAL location 'd1'; cSeconds : CARDINAL location 'd2'; cMicros : CARDINAL location 'd3') : BOOLEAN;
+SysCall IntuitionBase 102;
+
+procedure DrawBorder(rp : pRastPort location 'a0'; border : pBorder location 'a1'; leftOffset : LongInt location 'd0'; topOffset : LongInt location 'd1');
+SysCall IntuitionBase 108;
+
+procedure DrawImage(rp : pRastPort location 'a0'; image : pImage location 'a1'; leftOffset : LongInt location 'd0'; topOffset : LongInt location 'd1');
+SysCall IntuitionBase 114;
+
+procedure EndRequest(requester : pRequester location 'a0'; window : pWindow location 'a1');
+SysCall IntuitionBase 120;
+
+function GetDefPrefs(preferences : pPreferences location 'a0'; size : LongInt location 'd0') : pPreferences;
+SysCall IntuitionBase 126;
+
+function GetPrefs(preferences : pPreferences location 'a0'; size : LongInt location 'd0') : pPreferences;
+SysCall IntuitionBase 132;
+
+procedure InitRequester(requester : pRequester location 'a0');
+SysCall IntuitionBase 138;
+
+function ItemAddress(menuStrip : pMenu location 'a0'; menuNumber : CARDINAL location 'd0') : pMenuItem;
+SysCall IntuitionBase 144;
+
+function ModifyIDCMP(window : pWindow location 'a0'; flags : CARDINAL location 'd0') : BOOLEAN;
+SysCall IntuitionBase 150;
+
+procedure ModifyProp(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; flags : CARDINAL location 'd0'; horizPot : CARDINAL location 'd1'; vertPot : CARDINAL location 'd2'; horizBody : CARDINAL location 'd3'; vertBody : CARDINAL location 'd4');
+SysCall IntuitionBase 156;
+
+procedure MoveScreen(screen : pScreen location 'a0'; dx : LongInt location 'd0'; dy : LongInt location 'd1');
+SysCall IntuitionBase 162;
+
+procedure MoveWindow(window : pWindow location 'a0'; dx : LongInt location 'd0'; dy : LongInt location 'd1');
+SysCall IntuitionBase 168;
+
+procedure OffGadget(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2');
+SysCall IntuitionBase 174;
+
+procedure OffMenu(window : pWindow location 'a0'; menuNumber : CARDINAL location 'd0');
+SysCall IntuitionBase 180;
+
+procedure OnGadget(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2');
+SysCall IntuitionBase 186;
+
+procedure OnMenu(window : pWindow location 'a0'; menuNumber : CARDINAL location 'd0');
+SysCall IntuitionBase 192;
+
+function OpenScreen(newScreen : pNewScreen location 'a0') : pScreen;
+SysCall IntuitionBase 198;
+
+function OpenWindow(newWindow : pNewWindow location 'a0') : pWindow;
+SysCall IntuitionBase 204;
+
+function OpenWorkBench : CARDINAL;
+SysCall IntuitionBase 210;
+
+procedure PrintIText(rp : pRastPort location 'a0'; iText : pIntuiText location 'a1'; left : LongInt location 'd0'; top : LongInt location 'd1');
+SysCall IntuitionBase 216;
+
+procedure RefreshGadgets(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2');
+SysCall IntuitionBase 222;
+
+function RemoveGadget(window : pWindow location 'a0'; gadget : pGadget location 'a1') : Word;
+SysCall IntuitionBase 228;
+
+procedure ReportMouse(flag : LongInt location 'd0'; window : pWindow location 'a0');
+SysCall IntuitionBase 234;
+
+function Request(requester : pRequester location 'a0'; window : pWindow location 'a1') : BOOLEAN;
+SysCall IntuitionBase 240;
+
+procedure ScreenToBack(screen : pScreen location 'a0');
+SysCall IntuitionBase 246;
+
+procedure ScreenToFront(screen : pScreen location 'a0');
+SysCall IntuitionBase 252;
+
+function SetDMRequest(window : pWindow location 'a0'; requester : pRequester location 'a1') : BOOLEAN;
+SysCall IntuitionBase 258;
+
+function SetMenuStrip(window : pWindow location 'a0'; menu : pMenu location 'a1') : BOOLEAN;
+SysCall IntuitionBase 264;
+
+procedure SetPointer(window : pWindow location 'a0'; VAR pointer : Word location 'a1'; height : LongInt location 'd0'; width : LongInt location 'd1'; xOffset : LongInt location 'd2'; yOffset : LongInt location 'd3');
+SysCall IntuitionBase 270;
+
+procedure SetWindowTitles(window : pWindow location 'a0'; windowTitle : PChar location 'a1'; screenTitle : PChar location 'a2');
+SysCall IntuitionBase 276;
+
+procedure ShowTitle(screen : pScreen location 'a0'; showIt : LongInt location 'd0');
+SysCall IntuitionBase 282;
+
+procedure SizeWindow(window : pWindow location 'a0'; dx : LongInt location 'd0'; dy : LongInt location 'd1');
+SysCall IntuitionBase 288;
+
+function ViewAddress : pView;
+SysCall IntuitionBase 294;
+
+function ViewPortAddress(window : pWindow location 'a0') : pViewPort;
+SysCall IntuitionBase 300;
+
+procedure WindowToBack(window : pWindow location 'a0');
+SysCall IntuitionBase 306;
+
+procedure WindowToFront(window : pWindow location 'a0');
+SysCall IntuitionBase 312;
+
+function WindowLimits(window : pWindow location 'a0'; widthMin : LongInt location 'd0'; heightMin : LongInt location 'd1'; widthMax : CARDINAL location 'd2'; heightMax : CARDINAL location 'd3') : BOOLEAN;
+SysCall IntuitionBase 318;
+
+function SetPrefs(preferences : pPreferences location 'a0'; size : LongInt location 'd0'; inform : LongInt location 'd1') : pPreferences;
+SysCall IntuitionBase 324;
+
+function IntuiTextLength(iText : pIntuiText location 'a0') : LongInt;
+SysCall IntuitionBase 330;
+
+function WBenchToBack : BOOLEAN;
+SysCall IntuitionBase 336;
+
+function WBenchToFront : BOOLEAN;
+SysCall IntuitionBase 342;
+
+function AutoRequest(window : pWindow location 'a0'; body : pIntuiText location 'a1'; posText : pIntuiText location 'a2'; negText : pIntuiText location 'a3'; pFlag : CARDINAL location 'd0'; nFlag : CARDINAL location 'd1'; width : CARDINAL location 'd2'; height : CARDINAL location 'd3') : BOOLEAN;
+SysCall IntuitionBase 348;
+
+procedure BeginRefresh(window : pWindow location 'a0');
+SysCall IntuitionBase 354;
+
+function BuildSysRequest(window : pWindow location 'a0'; body : pIntuiText location 'a1'; posText : pIntuiText location 'a2'; negText : pIntuiText location 'a3'; flags : CARDINAL location 'd0'; width : CARDINAL location 'd1'; height : CARDINAL location 'd2') : pWindow;
+SysCall IntuitionBase 360;
+
+procedure EndRefresh(window : pWindow location 'a0'; complete : LongInt location 'd0');
+SysCall IntuitionBase 366;
+
+procedure FreeSysRequest(window : pWindow location 'a0');
+SysCall IntuitionBase 372;
+
+function MakeScreen(screen : pScreen location 'a0') : LongInt;
+SysCall IntuitionBase 378;
+
+function RemakeDisplay : LongInt;
+SysCall IntuitionBase 384;
+
+function RethinkDisplay : LongInt;
+SysCall IntuitionBase 390;
+
+function AllocRemember(var rememberKey : pRemember location 'a0'; size : CARDINAL location 'd0'; flags : CARDINAL location 'd1') : POINTER;
+SysCall IntuitionBase 396;
+
+procedure FreeRemember(var rememberKey : pRemember location 'a0'; reallyForget : LongInt location 'd0');
+SysCall IntuitionBase 408;
+
+function LockIBase(dontknow : CARDINAL location 'd0') : CARDINAL;
+SysCall IntuitionBase 414;
+
+procedure UnlockIBase(ibLock : CARDINAL location 'a0');
+SysCall IntuitionBase 420;
+
+function GetScreenData(buffer : POINTER location 'a0'; size : CARDINAL location 'd0'; type1 : CARDINAL location 'd1'; screen : pScreen location 'a1') : LongInt;
+SysCall IntuitionBase 426;
+
+procedure RefreshGList(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; numGad : LongInt location 'd0');
+SysCall IntuitionBase 432;
+
+function AddGList(window : pWindow location 'a0'; gadget : pGadget location 'a1'; position : CARDINAL location 'd0'; numGad : LongInt location 'd1'; requester : pRequester location 'a2') : Word;
+SysCall IntuitionBase 438;
+
+function RemoveGList(remPtr : pWindow location 'a0'; gadget : pGadget location 'a1'; numGad : LongInt location 'd0') : Word;
+SysCall IntuitionBase 444;
+
+procedure ActivateWindow(window : pWindow location 'a0');
+SysCall IntuitionBase 450;
+
+procedure RefreshWindowFrame(window : pWindow location 'a0');
+SysCall IntuitionBase 456;
+
+function ActivateGadget(gadgets : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2') : BOOLEAN;
+SysCall IntuitionBase 462;
+
+procedure NewModifyProp(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; flags : CARDINAL location 'd0'; horizPot : CARDINAL location 'd1'; vertPot : CARDINAL location 'd2'; horizBody : CARDINAL location 'd3'; vertBody : CARDINAL location 'd4'; numGad : LongInt location 'd5');
+SysCall IntuitionBase 468;
+
+function QueryOverscan(displayID : CARDINAL location 'a0'; rect : pRectangle location 'a1'; oScanType : LongInt location 'd0') : LongInt;
+SysCall IntuitionBase 474;
+
+procedure MoveWindowInFrontOf(window : pWindow location 'a0'; behindWindow : pWindow location 'a1');
+SysCall IntuitionBase 480;
+
+procedure ChangeWindowBox(window : pWindow location 'a0'; left : LongInt location 'd0'; top : LongInt location 'd1'; width : LongInt location 'd2'; height : LongInt location 'd3');
+SysCall IntuitionBase 486;
+
+function SetEditHook(hook : pHook location 'a0') : pHook;
+SysCall IntuitionBase 492;
+
+function SetMouseQueue(window : pWindow location 'a0'; queueLength : CARDINAL location 'd0') : LongInt;
+SysCall IntuitionBase 498;
+
+procedure ZipWindow(window : pWindow location 'a0');
+SysCall IntuitionBase 504;
+
+function LockPubScreen(name : PChar location 'a0') : pScreen;
+SysCall IntuitionBase 510;
+
+procedure UnlockPubScreen(name : PChar location 'a0'; screen : pScreen location 'a1');
+SysCall IntuitionBase 516;
+
+function LockPubScreenList : pList;
+SysCall IntuitionBase 522;
+
+procedure UnlockPubScreenList;
+SysCall IntuitionBase 528;
+
+function NextPubScreen(screen : pScreen location 'a0'; namebuf : PChar location 'a1') : PChar;
+SysCall IntuitionBase 534;
+
+procedure SetDefaultPubScreen(name : PChar location 'a0');
+SysCall IntuitionBase 540;
+
+function SetPubScreenModes(modes : CARDINAL location 'd0') : Word;
+SysCall IntuitionBase 546;
+
+function PubScreenStatus(screen : pScreen location 'a0'; statusFlags : CARDINAL location 'd0') : Word;
+SysCall IntuitionBase 552;
+
+function ObtainGIRPort(gInfo : pGadgetInfo location 'a0') : pRastPort;
+SysCall IntuitionBase 558;
+
+procedure ReleaseGIRPort(rp : pRastPort location 'a0');
+SysCall IntuitionBase 564;
+
+procedure GadgetMouse(gadget : pGadget location 'a0'; gInfo : pGadgetInfo location 'a1'; VAR mousePoint : INTEGER location 'a2');
+SysCall IntuitionBase 570;
+
+procedure GetDefaultPubScreen(nameBuffer : PChar location 'a0');
+SysCall IntuitionBase 582;
+
+function EasyRequestArgs(window : pWindow location 'a0'; easyStruct : pEasyStruct location 'a1'; idcmpPtr : Pointer location 'a2'; args : POINTER location 'a3') : LongInt;
+SysCall IntuitionBase 588;
+
+function BuildEasyRequestArgs(window : pWindow location 'a0'; easyStruct : pEasyStruct location 'a1'; idcmp : CARDINAL location 'd0'; args : POINTER location 'a3') : pWindow;
+SysCall IntuitionBase 594;
+
+function SysReqHandler(window : pWindow location 'a0'; VAR idcmpPtr : CARDINAL location 'a1'; waitInput : LongInt location 'd0') : LongInt;
+SysCall IntuitionBase 600;
+
+function OpenWindowTagList(newWindow : pNewWindow location 'a0'; tagList : pTagItem location 'a1') : pWindow;
+SysCall IntuitionBase 606;
+
+function OpenWindowTags(newWindow : pNewWindow; tagList : array of DWord) : pWindow; Inline;
+
+function OpenScreenTagList(newScreen : pNewScreen location 'a0'; tagList : pTagItem location 'a1') : pScreen;
+SysCall IntuitionBase 612;
+
+function OpenScreenTags(newScreen : pNewScreen; tagList : array of DWord) : pScreen; Inline;
+
+procedure DrawImageState(rp : pRastPort location 'a0'; image : pImage location 'a1'; leftOffset : LongInt location 'd0'; topOffset : LongInt location 'd1'; state : CARDINAL location 'd2'; drawInfo : pDrawInfo location 'a2');
+SysCall IntuitionBase 618;
+
+function PointInImage(point : CARDINAL location 'd0'; image : pImage location 'a0') : BOOLEAN;
+SysCall IntuitionBase 624;
+
+procedure EraseImage(rp : pRastPort location 'a0'; image : pImage location 'a1'; leftOffset : LongInt location 'd0'; topOffset : LongInt location 'd1');
+SysCall IntuitionBase 630;
+
+function NewObjectA(classPtr : pIClass location 'a0'; classID : PChar location 'a1'; tagList : pTagItem location 'a2') : POINTER;
+SysCall IntuitionBase 636;
+
+procedure DisposeObject(object1 : POINTER location 'a0');
+SysCall IntuitionBase 642;
+
+function SetAttrsA(object1 : POINTER location 'a0'; tagList : pTagItem location 'a1') : CARDINAL;
+SysCall IntuitionBase 648;
+
+function GetAttr(attrID : CARDINAL location 'd0'; object1 : POINTER location 'a0'; VAR storagePtr : CARDINAL location 'a1') : CARDINAL;
+SysCall IntuitionBase 654;
+
+function SetGadgetAttrsA(gadget : pGadget location 'a0'; window : pWindow location 'a1'; requester : pRequester location 'a2'; tagList : pTagItem location 'a3') : CARDINAL;
+SysCall IntuitionBase 660;
+
+function NextObject(objectPtrPtr : POINTER location 'a0') : POINTER;
+SysCall IntuitionBase 666;
+
+function MakeClass(classID : PChar location 'a0'; superClassID : PChar location 'a1'; superClassPtr : pIClass location 'a2'; instanceSize : CARDINAL location 'd0'; flags : CARDINAL location 'd1') : pIClass;
+SysCall IntuitionBase 678;
+
+procedure AddClass(classPtr : pIClass location 'a0');
+SysCall IntuitionBase 684;
+
+function GetScreenDrawInfo(screen : pScreen location 'a0') : pDrawInfo;
+SysCall IntuitionBase 690;
+
+procedure FreeScreenDrawInfo(screen : pScreen location 'a0'; drawInfo : pDrawInfo location 'a1');
+SysCall IntuitionBase 696;
+
+function ResetMenuStrip(window : pWindow location 'a0'; menu : pMenu location 'a1') : BOOLEAN;
+SysCall IntuitionBase 702;
+
+procedure RemoveClass(classPtr : pIClass location 'a0');
+SysCall IntuitionBase 708;
+
+function FreeClass(classPtr : pIClass location 'a0') : BOOLEAN;
+SysCall IntuitionBase 714;
+
+function AllocScreenBuffer(sc : pScreen location 'a0'; bm : pBitMap location 'a1'; flags : CARDINAL location 'd0') : pScreenBuffer;
+SysCall IntuitionBase 768;
+
+procedure FreeScreenBuffer(sc : pScreen location 'a0'; sb : pScreenBuffer location 'a1');
+SysCall IntuitionBase 774;
+
+function ChangeScreenBuffer(sc : pScreen location 'a0'; sb : pScreenBuffer location 'a1') : CARDINAL;
+SysCall IntuitionBase 780;
+
+procedure ScreenDepth(screen : pScreen location 'a0'; flags : CARDINAL location 'd0'; reserved : POINTER location 'a1');
+SysCall IntuitionBase 786;
+
+procedure ScreenPosition(screen : pScreen location 'a0'; flags : CARDINAL location 'd0'; x1 : LongInt location 'd1'; y1 : LongInt location 'd2'; x2 : LongInt location 'd3'; y2 : LongInt location 'd4');
+SysCall IntuitionBase 792;
+
+procedure ScrollWindowRaster(win : pWindow location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1'; xMin : LongInt location 'd2'; yMin : LongInt location 'd3'; xMax : LongInt location 'd4'; yMax : LongInt location 'd5');
+SysCall IntuitionBase 798;
+
+procedure LendMenus(fromwindow : pWindow location 'a0'; towindow : pWindow location 'a1');
+SysCall IntuitionBase 804;
+
+function DoGadgetMethodA(gad : pGadget location 'a0'; win : pWindow location 'a1'; req : pRequester location 'a2'; message : pLongInt location 'a3') : CARDINAL;
+SysCall IntuitionBase 810;
+
+procedure SetWindowPointerA(win : pWindow location 'a0'; taglist : pTagItem location 'a1');
+SysCall IntuitionBase 816;
+
+function TimedDisplayAlert(alertNumber : CARDINAL location 'd0'; string1 : PChar location 'a0'; height : CARDINAL location 'd1'; time : CARDINAL location 'a1') : BOOLEAN;
+SysCall IntuitionBase 822;
+
+procedure HelpControl(win : pWindow location 'a0'; flags : CARDINAL location 'd0');
+SysCall IntuitionBase 828;
+
+procedure ShowWindow(win : pWindow location 'a0');
+SysCall IntuitionBase 840;
+
+procedure HideWindow(win : pWindow location 'a0');
+SysCall IntuitionBase 846;
+
+function GetSkinInfoAttrA(drawinfo : pDrawInfo location 'a0'; attr : CARDINAL location 'd0'; taglist : pTagItem location 'a1') : CARDINAL;
+SysCall IntuitionBase 918;
+
+function GetDrawInfoAttr(drawinfo : pDrawInfo location 'a0'; attr : CARDINAL location 'd0'; VAR errorPtr : CARDINAL location 'a1') : CARDINAL;
+SysCall IntuitionBase 936;
+
+procedure WindowAction(window : pWindow location 'a0'; action : CARDINAL location 'd0'; tags : pTagItem location 'a1');
+SysCall IntuitionBase 942;
+
+function TransparencyControl(window : pWindow location 'a0'; method : CARDINAL location 'd0'; tags : pTagItem location 'a1') : BOOLEAN;
+SysCall IntuitionBase 948;
+
+procedure ScrollWindowRasterNoFill(win : pWindow location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1'; xMin : LongInt location 'd2'; yMin : LongInt location 'd3'; xMax : LongInt location 'd4'; yMax : LongInt location 'd5');
+SysCall IntuitionBase 954;
+
+
+{ Intuition macros }
+function INST_DATA (cl: pIClass; o: p_Object): Pointer;
+function SIZEOF_INSTANCE (cl: pIClass): Longint;
+function BASEOBJECT (o: p_Object): Pointer;
+function _OBJ(o: p_Object): p_Object;
+function __OBJECT (o: Pointer): p_Object;
+function OCLASS (o: Pointer): pIClass;
+function SHIFTITEM (n: smallint): word;
+function SHIFTMENU (n: smallint): word;
+function SHIFTSUB (n: smallint): word;
+function FULLMENUNUM (menu, item, sub: smallint): word;
+function IM_BGPEN (im: pImage): byte;
+function IM_BOX (im: pImage): pIBox;
+function IM_FGPEN (im: pImage): byte;
+function GADGET_BOX (g: pGadget): pIBox;
+function CUSTOM_HOOK (gadget: pGadget): pHook;
+function ITEMNUM( n : Word): Word;
+function MENUNUM( n : Word): Word;
+function SUBNUM( n : Word): Word;
+
+{
+FUNCTION DisplayAlert(alertNumber : Cardinal;string_ : string; height : Cardinal) : BOOLEAN;
+FUNCTION LockPubScreen(name : string) : pScreen;
+FUNCTION MakeClass(classID : string;superClassID : pCHAR;superClassPtr : pIClass; instanceSize : Cardinal; flags : Cardinal) : pIClass;
+FUNCTION MakeClass(classID : pCHAR;superClassID : string;superClassPtr : pIClass; instanceSize : Cardinal; flags : Cardinal) : pIClass;
+FUNCTION MakeClass(classID : string;superClassID : string;superClassPtr : pIClass; instanceSize : Cardinal; flags : Cardinal) : pIClass;
+FUNCTION NewObjectA(classPtr : pIClass;classID : string;tagList : pTagItem) : POINTER;
+PROCEDURE SetDefaultPubScreen(name : string);
+PROCEDURE SetWindowTitles(window : pWindow;windowTitle : string;screenTitle : pCHAR);
+PROCEDURE SetWindowTitles(window : pWindow;windowTitle : pCHAR;screenTitle : string);
+PROCEDURE SetWindowTitles(window : pWindow;windowTitle : string;screenTitle : string);
+FUNCTION TimedDisplayAlert(alertNumber : Cardinal;string_ : string; height : Cardinal; time : Cardinal) : BOOLEAN;
+PROCEDURE UnlockPubScreen(name : string; screen : pScreen);
+}
+
+{ Helper calls }
+function InitIntuitionLibrary : boolean;
+
+
+implementation
+
+{$WARNING Ugly workaround, this still needs support in the compiler}
+function OpenScreenTags(newScreen : pNewScreen; tagList : array of DWord) : pScreen; Inline;
+begin
+ OpenScreenTags:=OpenScreenTagList(newScreen,@tagList);
+end;
+
+function OpenWindowTags(newWindow : pNewWindow; tagList : array of DWord) : pWindow; Inline;
+begin
+ OpenWindowTags:=OpenWindowTagList(newWindow,@tagList);
+end;
+
+
+function INST_DATA (cl: pIClass; o: p_Object): Pointer;
+begin
+ INST_DATA := Pointer(Longint(o) + cl^.cl_InstOffset);
+end;
+
+function SIZEOF_INSTANCE (cl: pIClass): Longint;
+begin
+ SIZEOF_INSTANCE := cl^.cl_InstOffset + cl^.cl_InstSize + sizeof(t_Object);
+end;
+
+function BASEOBJECT (o: p_Object): Pointer;
+begin
+ BASEOBJECT := Pointer(Longint(o) + sizeof(t_Object));
+end;
+
+function _OBJ(o: p_Object): p_Object;
+begin
+ _OBJ := p_Object(o);
+END;
+
+function __OBJECT (o: Pointer): p_Object;
+begin
+ __OBJECT := p_Object(Longint(o) - sizeof(t_Object))
+end;
+
+function OCLASS (o: Pointer): pIClass;
+var
+ obj: p_Object;
+begin
+ obj := p_Object(Longint(o) - sizeof(t_Object));
+ OCLASS := obj^.o_Class;
+end;
+
+function SHIFTITEM (n: smallint): word;
+begin
+ SHIFTITEM := (n and $3f) shl 5
+end;
+
+function SHIFTMENU (n: smallint): word;
+begin
+ SHIFTMENU := n and $1f
+end;
+
+function SHIFTSUB (n: smallint): word;
+begin
+ SHIFTSUB := (n and $1f) shl 11
+end;
+
+function FULLMENUNUM (menu, item, sub: smallint): word;
+begin
+ FULLMENUNUM := ((sub and $1f) shl 11) or
+ ((item and $3f) shl 5) or
+ (menu and $1f)
+end;
+
+
+{ The next functons _BGPEN AND _FGPEN aren't a full replacement of the
+ C macros because the C preprocessor makes it possible to set the
+ A/BPen values of the image class objects as well. This can't work
+ in pascal, of course! }
+
+function IM_BGPEN (im: pImage): byte;
+begin
+ IM_BGPEN := im^.PlaneOnOff;
+end;
+
+function IM_BOX (im: pImage): pIBox;
+begin
+ IM_BOX := pIBox(@im^.LeftEdge);
+END;
+
+function IM_FGPEN (im: pImage): byte;
+begin
+ IM_FGPEN := im^.PlanePick;
+end;
+
+function GADGET_BOX (g: pGadget): pIBox;
+begin
+ GADGET_BOX := pIBox(@g^.LeftEdge);
+end;
+
+function CUSTOM_HOOK (gadget: pGadget): pHook;
+begin
+ CUSTOM_HOOK := pHook(gadget^.MutualExclude);
+end;
+
+function ITEMNUM( n : Word): Word;
+begin
+ ITEMNUM := (n shr 5) and $3F
+end;
+
+function MENUNUM( n : Word): Word;
+begin
+ MENUNUM := n and $1f
+end;
+
+function SUBNUM( n : Word): Word;
+begin
+ SUBNUM := (n shr 11) and $1f
+end;
+
+{
+FUNCTION DisplayAlert(alertNumber : Cardinal;string_ : string; height : Cardinal) : BOOLEAN;
+begin
+ DisplayAlert := DisplayAlert(alertNumber,pas2c(string_),height);
+end;
+
+FUNCTION LockPubScreen(name : string) : pScreen;
+begin
+ LockPubScreen := LockPubScreen(pas2c(name));
+end;
+
+FUNCTION MakeClass(classID : string;superClassID : pCHAR;superClassPtr : pIClass; instanceSize : Cardinal; flags : Cardinal) : pIClass;
+begin
+ MakeClass := MakeClass(pas2c(classID),superClassID,superClassPtr,instanceSize,flags);
+end;
+
+FUNCTION MakeClass(classID : pCHAR;superClassID : string;superClassPtr : pIClass; instanceSize : Cardinal; flags : Cardinal) : pIClass;
+begin
+ MakeClass := MakeClass(classID,pas2c(superClassID),superClassPtr,instanceSize,flags);
+end;
+
+FUNCTION MakeClass(classID : string;superClassID : string;superClassPtr : pIClass; instanceSize : Cardinal; flags : Cardinal) : pIClass;
+begin
+ MakeClass := MakeClass(pas2c(classID),pas2c(superClassID),superClassPtr,instanceSize,flags);
+end;
+
+FUNCTION NewObjectA(classPtr : pIClass;classID : string;tagList : pTagItem) : POINTER;
+begin
+ NewObjectA := NewObjectA(classPtr,pas2c(classID),taglist);
+end;
+
+PROCEDURE SetDefaultPubScreen(name : string);
+begin
+ SetDefaultPubScreen(pas2c(name));
+end;
+
+PROCEDURE SetWindowTitles(window : pWindow;windowTitle : string;screenTitle : pCHAR);
+begin
+ SetWindowTitles(window,pas2c(windowTitle),screenTitle);
+end;
+
+PROCEDURE SetWindowTitles(window : pWindow;windowTitle : pCHAR;screenTitle : string);
+begin
+ SetWindowTitles(window,windowTitle,pas2c(screenTitle));
+end;
+
+PROCEDURE SetWindowTitles(window : pWindow;windowTitle : string;screenTitle : string);
+begin
+ SetWindowTitles(window,pas2c(windowTitle),pas2c(screenTitle));
+end;
+
+FUNCTION TimedDisplayAlert(alertNumber : Cardinal;string_ : string; height : Cardinal; time : Cardinal) : BOOLEAN;
+begin
+ TimedDisplayAlert := TimedDisplayAlert(alertNumber,pas2c(string_),height,time);
+end;
+
+PROCEDURE UnlockPubScreen(name : string; screen : pScreen);
+begin
+ UnlockPubScreen(pas2c(name),screen);
+end;
+}
+
+
+const
+ { Change VERSION and LIBVERSION to proper values }
+ VERSION : string[2] = '50';
+ LIBVERSION : longword = 50;
+
+var
+ intuition_exit : Pointer;
+
+procedure CloseIntuitionLibrary;
+begin
+ ExitProc := intuition_exit;
+ if IntuitionBase <> nil then begin
+ CloseLibrary(PLibrary(IntuitionBase));
+ IntuitionBase := nil;
+ end;
+end;
+
+function InitIntuitionLibrary : boolean;
+begin
+ IntuitionBase := nil;
+ IntuitionBase := OpenLibrary(INTUITIONNAME,LIBVERSION);
+ if IntuitionBase <> nil then begin
+ intuition_exit := ExitProc;
+ ExitProc := @CloseIntuitionLibrary;
+ InitIntuitionLibrary:=True;
+ end else begin
+ InitIntuitionLibrary:=False;
+ end;
+end;
+
+
+end. (* UNIT INTUITION *)
+
+{
+ $Log: intuition.pas,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.2 2005/01/30 19:00:09 karoly
+ * changes for ASL and AHI support
+
+}
diff --git a/rtl/morphos/layers.pas b/rtl/morphos/layers.pas
new file mode 100644
index 0000000000..e1b41e88ea
--- /dev/null
+++ b/rtl/morphos/layers.pas
@@ -0,0 +1,239 @@
+{
+ $Id: layers.pas,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ layers.library interface unit for MorphOS/PowerPC
+
+ Based on work of Nils Sjoholm member of the Amiga RTL
+ development team.
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$PACKRECORDS 2}
+unit layers;
+
+interface
+
+uses exec, graphics, utility;
+
+const
+ LAYERSIMPLE = 1;
+ LAYERSMART = 2;
+ LAYERSUPER = 4;
+ LAYERUPDATING = $10;
+ LAYERBACKDROP = $40;
+ LAYERREFRESH = $80;
+ LAYER_CLIPRECTS_LOST = $100; { during BeginUpdate }
+ { or during layerop }
+ { this happens if out of memory }
+ LMN_REGION = -1;
+
+type
+ pLayer_Info = ^tLayer_Info;
+ tLayer_Info = packed record
+ top_layer : pLayer;
+ check_lp : pLayer; { !! Private !! }
+ obs : pClipRect;
+ FreeClipRects : pClipRect; { !! Private !! }
+ PrivateReserve1, { !! Private !! }
+ PrivateReserve2 : Longint; { !! Private !! }
+ Lock : tSignalSemaphore; { !! Private !! }
+ gs_Head : tMinList; { !! Private !! }
+ PrivateReserve3 : smallint; { !! Private !! }
+ PrivateReserve4 : Pointer; { !! Private !! }
+ Flags : WORD;
+ fatten_count : Shortint; { !! Private !! }
+ LockLayersCount : Shortint; { !! Private !! }
+ PrivateReserve5 : smallint; { !! Private !! }
+ BlankHook, { !! Private !! }
+ LayerInfo_extra : Pointer; { !! Private !! }
+ end;
+
+const
+ NEWLAYERINFO_CALLED = 1;
+
+{
+ * LAYERS_NOBACKFILL is the value needed to get no backfill hook
+ * LAYERS_BACKFILL is the value needed to get the default backfill hook
+ }
+ LAYERS_NOBACKFILL = 1;
+ LAYERS_BACKFILL = 0;
+
+ LAYERSNAME : PChar = 'layers.library';
+
+var
+ LayersBase : PLibrary;
+
+procedure InitLayers(li : pLayer_Info location 'a0');
+SysCall LayersBase 030;
+
+function CreateUpfrontLayer(li : pLayer_Info location 'a0'; bm : pBitMap location 'a1'; x0 : LongInt location 'd0'; y0 : LongInt location 'd1'; x1 : LongInt location 'd2'; y1 : LongInt location 'd3'; flags : LongInt location 'd4'; bm2 : pBitMap location 'a2') : pLayer;
+SysCall LayersBase 036;
+
+function CreateBehindLayer(li : pLayer_Info location 'a0'; bm : pBitMap location 'a1'; x0 : LongInt location 'd0'; y0 : LongInt location 'd1'; x1 : LongInt location 'd2'; y1 : LongInt location 'd3'; flags : LongInt location 'd4'; bm2 : pBitMap location 'a2') : pLayer;
+SysCall LayersBase 042;
+
+function UpfrontLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1') : LongInt;
+SysCall LayersBase 048;
+
+function BehindLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1') : LongInt;
+SysCall LayersBase 054;
+
+function MoveLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1') : LongInt;
+SysCall LayersBase 060;
+
+function SizeLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1') : LongInt;
+SysCall LayersBase 066;
+
+procedure ScrollLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1'; dx : LongInt location 'd0'; dy : LongInt location 'd1');
+SysCall LayersBase 072;
+
+function BeginUpdate(l : pLayer location 'a0') : LongInt;
+SysCall LayersBase 078;
+
+procedure EndUpdate(layer : pLayer location 'a0'; flag : CARDINAL location 'd0');
+SysCall LayersBase 084;
+
+function DeleteLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1') : LongInt;
+SysCall LayersBase 090;
+
+procedure LockLayer(dummy : LongInt location 'a0'; layer : pLayer location 'a1');
+SysCall LayersBase 096;
+
+procedure UnlockLayer(layer : pLayer location 'a0');
+SysCall LayersBase 102;
+
+procedure LockLayers(li : pLayer_Info location 'a0');
+SysCall LayersBase 108;
+
+procedure UnlockLayers(li : pLayer_Info location 'a0');
+SysCall LayersBase 114;
+
+procedure LockLayerInfo(li : pLayer_Info location 'a0');
+SysCall LayersBase 120;
+
+procedure SwapBitsRastPortClipRect(rp : pRastPort location 'a0'; cr : pClipRect location 'a1');
+SysCall LayersBase 126;
+
+function WhichLayer(li : pLayer_Info location 'a0'; x : LongInt location 'd0'; y : LongInt location 'd1') : pLayer;
+SysCall LayersBase 132;
+
+procedure UnlockLayerInfo(li : pLayer_Info location 'a0');
+SysCall LayersBase 138;
+
+function NewLayerInfo : pLayer_Info;
+SysCall LayersBase 144;
+
+procedure DisposeLayerInfo(li : pLayer_Info location 'a0');
+SysCall LayersBase 150;
+
+function FattenLayerInfo(li : pLayer_Info location 'a0') : LongInt;
+SysCall LayersBase 156;
+
+procedure ThinLayerInfo(li : pLayer_Info location 'a0');
+SysCall LayersBase 162;
+
+function MoveLayerInFrontOf(layer_to_move : pLayer location 'a0'; other_layer : pLayer location 'a1') : LongInt;
+SysCall LayersBase 168;
+
+function InstallClipRegion(layer : pLayer location 'a0'; CONST region : pRegion location 'a1') : pRegion;
+SysCall LayersBase 174;
+
+function MoveSizeLayer(layer : pLayer location 'a0'; dx : LongInt location 'd0'; dy : LongInt location 'd1'; dw : LongInt location 'd2'; dh : LongInt location 'd3') : LongInt;
+SysCall LayersBase 180;
+
+function CreateUpfrontHookLayer(li : pLayer_Info location 'a0'; bm : pBitMap location 'a1'; x0 : LongInt location 'd0'; y0 : LongInt location 'd1'; x1 : LongInt location 'd2'; y1 : LongInt location 'd3'; flags : LongInt location 'd4'; hook : pHook location 'a3'; bm2 : pBitMap location 'a2') : pLayer;
+SysCall LayersBase 186;
+
+function CreateBehindHookLayer(li : pLayer_Info location 'a0'; bm : pBitMap location 'a1'; x0 : LongInt location 'd0'; y0 : LongInt location 'd1'; x1 : LongInt location 'd2'; y1 : LongInt location 'd3'; flags : LongInt location 'd4'; hook : pHook location 'a3'; bm2 : pBitMap location 'a2') : pLayer;
+SysCall LayersBase 192;
+
+function InstallLayerHook(layer : pLayer location 'a0'; hook : pHook location 'a1') : pHook;
+SysCall LayersBase 198;
+
+function InstallLayerInfoHook(li : pLayer_Info location 'a0'; CONST hook : pHook location 'a1') : pHook;
+SysCall LayersBase 204;
+
+procedure SortLayerCR(layer : pLayer location 'a0'; dx : LongInt location 'd0'; dy : LongInt location 'd1');
+SysCall LayersBase 210;
+
+procedure DoHookClipRects(hook : pHook location 'a0'; rport : pRastPort location 'a1'; CONST rect : pRectangle location 'a2');
+SysCall LayersBase 216;
+
+function InstallTransparentRegion(l : pLayer location 'a0'; r : pRegion location 'a1') : pRegion;
+SysCall LayersBase 222;
+
+function InstallTransparentRegionHook(l : pLayer location 'a0'; h : pHook location 'a1') : pHook;
+SysCall LayersBase 228;
+
+function CreateUpfrontLayerTagList(li : pLayer_Info location 'a0'; bm : pBitMap location 'a1'; x0 : LongInt location 'd0'; y0 : LongInt location 'd1'; x1 : LongInt location 'd2'; y1 : LongInt location 'd3'; flags : LongInt location 'd4'; taglist : pTagItem location 'a2') : pLayer;
+SysCall LayersBase 234;
+
+function CreateBehindLayerTagList(li : pLayer_Info location 'a0'; bm : pBitMap location 'a1'; x0 : LongInt location 'd0'; y0 : LongInt location 'd1'; x1 : LongInt location 'd2'; y1 : LongInt location 'd3'; flags : LongInt location 'd4'; taglist : pTagItem location 'a2') : pLayer;
+SysCall LayersBase 240;
+
+{
+ Functions and procedures with array of const go here
+}
+{
+function CreateUpfrontLayerTags(li : pLayer_Info; bm : pBitMap; x0 : LongInt; y0 : LongInt; x1 : LongInt; y1 : LongInt; flags : LongInt; const taglist : Array Of Const) : pLayer;
+function CreateBehindLayerTags(li : pLayer_Info; bm : pBitMap; x0 : LongInt; y0 : LongInt; x1 : LongInt; y1 : LongInt; flags : LongInt; const taglist : Array Of Const) : pLayer;
+}
+
+
+{ Helper func }
+function InitLayersLibrary : boolean;
+
+
+implementation
+
+const
+ { Change VERSION and LIBVERSION to proper values }
+ VERSION : string[2] = '50';
+ LIBVERSION : longword = 50;
+
+var
+ layers_exit : Pointer;
+
+procedure CloseLayersLibrary;
+begin
+ ExitProc := layers_exit;
+ if LayersBase <> nil then begin
+ CloseLibrary(LayersBase);
+ LayersBase := nil;
+ end;
+end;
+
+function InitLayersLibrary : boolean;
+begin
+ LayersBase := nil;
+ LayersBase := OpenLibrary(LAYERSNAME,LIBVERSION);
+ if LayersBase <> nil then begin
+ layers_exit := ExitProc;
+ ExitProc := @CloseLayersLibrary;
+ InitLayersLibrary:=True;
+ end else begin
+ InitLayersLibrary:=False;
+ end;
+end;
+
+
+end.
+
+{
+ $Log: layers.pas,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/prt0.as b/rtl/morphos/prt0.as
new file mode 100644
index 0000000000..69fd4e1aa4
--- /dev/null
+++ b/rtl/morphos/prt0.as
@@ -0,0 +1,227 @@
+/*
+ $Id: prt0.as,v 1.12 2005/02/03 19:09:11 karoly Exp $
+*/
+/*
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Karoly Balogh for Genesi Sarl
+
+ Thanks for Martin 'MarK' Kuchinka <kuchinka@volny.cz>
+ for his help.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+*/
+ .section ".text"
+ .globl _start
+ .align 4
+_start:
+ mflr 0
+ stw 0,4(1)
+ stwu 1,-16(1)
+
+ /* Get ExecBase */
+ lwz 3,4(0)
+ lis 4,_ExecBase@ha
+ stw 3,_ExecBase@l(4)
+
+ /* Allocating new stack */
+ lis 4,__stklen@ha
+ lwz 3,__stklen@l(4)
+ stw 3,0(2)
+ lwz 3,4(0)
+ stw 3,56(2)
+ lwz 3,100(2)
+ mtlr 3
+ li 3,-858 /* AllocTaskPooled */
+ blrl
+
+ cmplwi cr0,3,0
+ beq cr0,_exit
+
+ lis 4,stackArea@ha
+ stw 3,stackArea@l(4)
+
+ /* Setting up stackSwap struct */
+ lis 4,stackSwap@ha
+ addi 4,4,stackSwap@l
+ stw 3,0(4)
+ lis 5,__stklen@ha
+ lwz 6,__stklen@l(5)
+ add 3,3,6
+ stw 3,4(4)
+ stw 3,8(4)
+
+ /* Calling main function with the new stack */
+ stw 4,32(2)
+ lis 4,_initproc@ha
+ addi 4,4,_initproc@l
+ stw 4,36(2)
+ li 3,0
+ stw 3,40(2)
+ lwz 4,100(2)
+ mtlr 4
+ li 3,-804 /* NewPPCStackSwap */
+ blrl
+
+ /* Setting return value */
+ lis 4,returnValue@ha
+ lwz 3,returnValue@l(4)
+
+_exit:
+ addi 1,1,16
+ lwz 0,4(1)
+ mtlr 0
+ blr
+
+_initproc:
+ mflr 0
+ stw 0,4(1)
+ stwu 1,-128(1)
+ stw 13,52(1)
+ stw 14,56(1)
+ stw 15,60(1)
+ stw 16,64(1)
+ stw 17,68(1)
+ stw 18,72(1)
+ stw 19,76(1)
+ stw 20,80(1)
+ stw 21,84(1)
+ stw 22,88(1)
+ stw 23,92(1)
+ stw 24,96(1)
+ stw 25,100(1)
+ stw 26,104(1)
+ stw 27,108(1)
+ stw 28,112(1)
+ stw 29,116(1)
+ stw 30,120(1)
+ stw 31,124(1)
+
+ /* Save Stackpointer */
+ lis 4,OriginalStkPtr@ha
+ stw 1,OriginalStkPtr@l(4)
+
+ bl PASCALMAIN
+
+ .globl _haltproc
+_haltproc:
+ /* Restore Stackpointer */
+ lis 4,OriginalStkPtr@ha
+ lwz 1,OriginalStkPtr@l(4)
+
+ /* Store return value */
+ lis 4,returnValue@ha
+ stw 3,returnValue@l(4)
+
+ lwz 13,52(1)
+ lwz 14,56(1)
+ lwz 15,60(1)
+ lwz 16,64(1)
+ lwz 17,68(1)
+ lwz 18,72(1)
+ lwz 19,76(1)
+ lwz 20,80(1)
+ lwz 21,84(1)
+ lwz 22,88(1)
+ lwz 23,92(1)
+ lwz 24,96(1)
+ lwz 25,100(1)
+ lwz 26,104(1)
+ lwz 27,108(1)
+ lwz 28,112(1)
+ lwz 29,116(1)
+ lwz 30,120(1)
+ lwz 31,124(1)
+ addi 1,1,128
+ lwz 0,4(1)
+ mtlr 0
+ blr
+
+ .globl _ExecBase
+ .globl SysBase
+ .align 4
+SysBase:
+_ExecBase:
+ .long 0
+
+ .globl OriginalStkPtr
+ .align 4
+OriginalStkPtr:
+ .long 0
+
+ .globl OriginalLinkRegister
+ .align 4
+OriginalLinkRegister:
+ .long 0
+
+ .globl returnValue
+ .align 4
+returnValue:
+ .long 0
+
+ .globl stackArea
+ .align 4
+stackArea:
+ .long 0
+
+ .globl stackSwap
+ .align 4
+stackSwap:
+ .long 0
+ .long 0
+ .long 0
+
+ /* This is needed to be a proper MOS ABox executable */
+ /* This symbol _MUST NOT_ be stripped out from the executable */
+ /* or else... */
+ .globl __abox__
+ .type __abox__,@object
+ .size __abox__,4
+__abox__:
+ .long 1
+
+/*
+ $Log: prt0.as,v $
+ Revision 1.12 2005/02/03 19:09:11 karoly
+ * reworked startup code:
+ - now uses AllocTaskPooled
+ - check for unsuccessful stack allocation
+
+ Revision 1.11 2004/06/06 22:02:22 karoly
+ * hopefully fixed stack problems causing hits
+
+ Revision 1.10 2004/06/06 12:51:06 karoly
+ * changelog fixed
+
+ Revision 1.9 2004/06/06 12:47:57 karoly
+ * some cleanup, comments added
+
+ Revision 1.8 2004/06/05 19:25:12 karoly
+ + reworked to support resizing of stack
+
+ Revision 1.7 2004/05/13 01:15:42 karoly
+ - removed comment about argc/argv, made it work another way
+
+ Revision 1.6 2004/05/01 15:08:57 karoly
+ + haltproc added, saving/restoring stackpointer added
+
+ Revision 1.5 2004/04/21 03:24:55 karoly
+ * rewritten to be similar to GCC startup code
+
+ Revision 1.4 2004/04/09 04:02:43 karoly
+ * abox id symbol fixed
+
+ Revision 1.3 2004/04/09 02:58:15 karoly
+ * typo fixed.
+
+ Revision 1.2 2004/04/09 02:54:25 karoly
+ * execbase loading oops fixed.
+
+ Revision 1.1 2004/03/16 10:29:22 karoly
+ * first implementation of some startup code for MOS
+
+*/
diff --git a/rtl/morphos/sysdir.inc b/rtl/morphos/sysdir.inc
new file mode 100644
index 0000000000..cef70c598b
--- /dev/null
+++ b/rtl/morphos/sysdir.inc
@@ -0,0 +1,113 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+var
+ tmpStr : array[0..255] of char;
+ tmpLock: LongInt;
+begin
+ checkCTRLC;
+ if (s='') or (InOutRes<>0) then exit;
+ tmpStr:=PathConv(s)+#0;
+ tmpLock:=dosCreateDir(@tmpStr);
+ if tmpLock=0 then begin
+ dosError2InOut(IoErr);
+ exit;
+ end;
+ UnLock(tmpLock);
+end;
+
+procedure rmdir(const s : string);[IOCheck];
+var
+ tmpStr : array[0..255] of Char;
+begin
+ checkCTRLC;
+ if (s='.') then InOutRes:=16;
+ If (s='') or (InOutRes<>0) then exit;
+ tmpStr:=PathConv(s)+#0;
+ if not dosDeleteFile(@tmpStr) then
+ dosError2InOut(IoErr);
+end;
+
+procedure chdir(const s : string);[IOCheck];
+var
+ tmpStr : array[0..255] of Char;
+ tmpLock: LongInt;
+ FIB : PFileInfoBlock;
+begin
+ checkCTRLC;
+ If (s='') or (InOutRes<>0) then exit;
+ tmpStr:=PathConv(s)+#0;
+ tmpLock:=0;
+
+ { Changing the directory is a pretty complicated affair }
+ { 1) Obtain a lock on the directory }
+ { 2) CurrentDir the lock }
+ tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+ if tmpLock=0 then begin
+ dosError2InOut(IoErr);
+ exit;
+ end;
+
+ FIB:=nil;
+ new(FIB);
+
+ if (Examine(tmpLock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
+ tmpLock:=CurrentDir(tmpLock);
+ if MOS_OrigDir=0 then begin
+ MOS_OrigDir:=tmpLock;
+ tmpLock:=0;
+ end;
+ end;
+
+ if tmpLock<>0 then Unlock(tmpLock);
+ if assigned(FIB) then dispose(FIB);
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+var tmpbuf: array[0..255] of char;
+begin
+ checkCTRLC;
+ Dir:='';
+ if not GetCurrentDirName(tmpbuf,256) then
+ dosError2InOut(IoErr)
+ else
+ Dir:=strpas(tmpbuf);
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/morphos/sysfile.inc b/rtl/morphos/sysfile.inc
new file mode 100644
index 0000000000..b93e2210b2
--- /dev/null
+++ b/rtl/morphos/sysfile.inc
@@ -0,0 +1,337 @@
+{
+ $Id: sysfile.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ MorphOS File-handling Support Functions
+*****************************************************************************}
+type
+ { AmigaOS does not automatically close opened files on exit back to }
+ { the operating system, therefore as a precuation we close all files }
+ { manually on exit. }
+ PFileList = ^TFileList;
+ TFileList = record { no packed, must be correctly aligned }
+ handle : LongInt; { Handle to file }
+ next : PFileList; { Next file in list }
+ end;
+
+var
+ MOS_fileList: PFileList; public name 'MOS_FILELIST'; { List pointer to opened files }
+
+{ Function to be called at program shutdown, to close all opened files }
+procedure CloseList(l: PFileList);
+var
+ tmpNext : PFileList;
+ tmpHandle : LongInt;
+begin
+ if l=nil then exit;
+
+ { First, close all tracked files }
+ tmpNext:=l^.next;
+ while tmpNext<>nil do begin
+ tmpHandle:=tmpNext^.handle;
+ if (tmpHandle<>StdInputHandle) and (tmpHandle<>StdOutputHandle)
+ and (tmpHandle<>StdErrorHandle) then begin
+ dosClose(tmpHandle);
+ end;
+ tmpNext:=tmpNext^.next;
+ end;
+
+ { Next, erase the linked list }
+ while l<>nil do begin
+ tmpNext:=l;
+ l:=l^.next;
+ dispose(tmpNext);
+ end;
+end;
+
+{ Function to be called to add a file to the opened file list }
+procedure AddToList(var l: PFileList; h: LongInt); alias: 'ADDTOLIST'; [public];
+var
+ p : PFileList;
+ inList: Boolean;
+begin
+ inList:=False;
+ if l<>nil then begin
+ { if there is a valid filelist, search for the value }
+ { in the list to avoid double additions }
+ p:=l;
+ while (p^.next<>nil) and (not inList) do
+ if p^.next^.handle=h then inList:=True
+ else p:=p^.next;
+ p:=nil;
+ end else begin
+ { if the list is not yet allocated, allocate it. }
+ New(l);
+ l^.next:=nil;
+ end;
+
+ if not inList then begin
+ New(p);
+ p^.handle:=h;
+ p^.next:=l^.next;
+ l^.next:=p;
+ end;
+end;
+
+{ Function to be called to remove a file from the list }
+procedure RemoveFromList(var l: PFileList; h: LongInt); alias: 'REMOVEFROMLIST'; [public];
+var
+ p : PFileList;
+ inList: Boolean;
+begin
+ if l=nil then exit;
+
+ inList:=False;
+ p:=l;
+ while (p^.next<>nil) and (not inList) do
+ if p^.next^.handle=h then inList:=True
+ else p:=p^.next;
+
+ if p^.next<>nil then begin
+ dispose(p^.next);
+ p^.next:=p^.next^.next;
+ end;
+end;
+
+
+{****************************************************************************
+ Low level File Routines
+ All these functions can set InOutRes on errors
+****************************************************************************}
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+begin
+ if (handle<=0) then exit;
+
+ RemoveFromList(MOS_fileList,handle);
+ { Do _NOT_ check CTRL_C on Close, because it will conflict
+ with System_Exit! }
+ if not dosClose(handle) then
+ dosError2InOut(IoErr);
+end;
+
+procedure do_erase(p : pchar);
+begin
+ checkCTRLC;
+ if not dosDeleteFile(p) then
+ dosError2InOut(IoErr);
+end;
+
+procedure do_rename(p1,p2 : pchar);
+begin
+ checkCTRLC;
+ if not dosRename(p1,p2) then
+ dosError2InOut(IoErr);
+end;
+
+function do_write(h:longint; addr: pointer; len: longint) : longint;
+var dosResult: LongInt;
+begin
+ checkCTRLC;
+ do_write:=0;
+ if (len<=0) or (h<=0) then exit;
+
+ dosResult:=dosWrite(h,addr,len);
+ if dosResult<0 then begin
+ dosError2InOut(IoErr);
+ end else begin
+ do_write:=dosResult;
+ end;
+end;
+
+function do_read(h:longint; addr: pointer; len: longint) : longint;
+var dosResult: LongInt;
+begin
+ checkCTRLC;
+ do_read:=0;
+ if (len<=0) or (h<=0) then exit;
+
+ dosResult:=dosRead(h,addr,len);
+ if dosResult<0 then begin
+ dosError2InOut(IoErr);
+ end else begin
+ do_read:=dosResult;
+ end
+end;
+
+function do_filepos(handle : longint) : longint;
+var dosResult: LongInt;
+begin
+ checkCTRLC;
+ do_filepos:=-1;
+ if (handle<=0) then exit;
+
+ { Seeking zero from OFFSET_CURRENT to find out where we are }
+ dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
+ if dosResult<0 then begin
+ dosError2InOut(IoErr);
+ end else begin
+ do_filepos:=dosResult;
+ end;
+end;
+
+procedure do_seek(handle,pos : longint);
+begin
+ checkCTRLC;
+ if (handle<=0) then exit;
+
+ { Seeking from OFFSET_BEGINNING }
+ if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then
+ dosError2InOut(IoErr);
+end;
+
+function do_seekend(handle:longint):longint;
+var dosResult: LongInt;
+begin
+ checkCTRLC;
+ do_seekend:=-1;
+ if (handle<=0) then exit;
+
+ { Seeking to OFFSET_END }
+ dosResult:=dosSeek(handle,0,OFFSET_END);
+ if dosResult<0 then begin
+ dosError2InOut(IoErr);
+ end else begin
+ do_seekend:=dosResult;
+ end
+end;
+
+function do_filesize(handle : longint) : longint;
+var currfilepos: longint;
+begin
+ checkCTRLC;
+ do_filesize:=-1;
+ if (handle<=0) then exit;
+
+ currfilepos:=do_filepos(handle);
+ { We have to do this twice, because seek returns the OLD position }
+ do_filesize:=do_seekend(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,currfilepos)
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+begin
+ checkCTRLC;
+ if (handle<=0) then exit;
+
+ { Seeking from OFFSET_BEGINNING }
+ if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
+ dosError2InOut(IoErr);
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $10) the file will be append
+ when (flags and $100) the file will be truncate/rewritten
+ when (flags and $1000) there is no check for close (needed for textfiles)
+}
+var
+ handle : LongInt;
+ openflags: LongInt;
+ tmpStr : array[0..255] of Char;
+begin
+ tmpStr:=PathConv(strpas(p))+#0;
+
+ { close first if opened }
+ if ((flags and $10000)=0) then begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed : ;
+ else begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+
+ { reset file handle }
+ filerec(f).handle:=UnusedHandle;
+
+ { convert filemode to filerec modes }
+ { READ/WRITE on existing file }
+ { RESET/APPEND }
+ openflags:=MODE_OLDFILE;
+ case (flags and 3) of
+ 0 : filerec(f).mode:=fminput;
+ 1 : filerec(f).mode:=fmoutput;
+ 2 : filerec(f).mode:=fminout;
+ end;
+
+ { rewrite (create a new file) }
+ if (flags and $1000)<>0 then openflags:=MODE_NEWFILE;
+
+ { empty name is special }
+ if p[0]=#0 then begin
+ case filerec(f).mode of
+ fminput :
+ filerec(f).handle:=StdInputHandle;
+ fmappend,
+ fmoutput : begin
+ filerec(f).handle:=StdOutputHandle;
+ filerec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+
+ handle:=Open(@tmpStr,openflags);
+ if handle=0 then begin
+ dosError2InOut(IoErr);
+ end else begin
+ AddToList(MOS_fileList,handle);
+ filerec(f).handle:=handle;
+ end;
+
+ { append mode }
+ if ((Flags and $100)<>0) and
+ (FileRec(F).Handle<>UnusedHandle) then begin
+ do_seekend(filerec(f).handle);
+ filerec(f).mode:=fmoutput; {fool fmappend}
+ end;
+end;
+
+function do_isdevice(handle:longint):boolean;
+begin
+ if (handle=StdOutputHandle) or (handle=StdInputHandle) or
+ (handle=StdErrorHandle) then
+ do_isdevice:=True
+ else
+ do_isdevice:=False;
+end;
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/morphos/sysheap.inc b/rtl/morphos/sysheap.inc
new file mode 100644
index 0000000000..1e657048c0
--- /dev/null
+++ b/rtl/morphos/sysheap.inc
@@ -0,0 +1,49 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/07 21:30:12 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ result:=AllocPooled(MOS_heapPool,size);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+ FreePooled(MOS_heapPool,p,size);
+end;
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/morphos/sysos.inc b/rtl/morphos/sysos.inc
new file mode 100644
index 0000000000..c5c185007c
--- /dev/null
+++ b/rtl/morphos/sysos.inc
@@ -0,0 +1,158 @@
+{
+ $Id: sysos.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ MorphOS structures
+*****************************************************************************}
+
+{$include execd.inc}
+{$include timerd.inc}
+{$include doslibd.inc}
+
+
+{*****************************************************************************
+ MorphOS functions
+*****************************************************************************}
+
+{ exec.library functions }
+
+{$include execf.inc}
+{$include doslibf.inc}
+
+
+{*****************************************************************************
+ System Dependent Structures/Consts
+*****************************************************************************}
+
+const
+ CTRL_C = 20; { Error code on CTRL-C press }
+
+{ Used for CTRL_C checking in I/O calls }
+procedure checkCTRLC;
+begin
+ if BreakOn then begin
+ if (SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin
+ { Clear CTRL-C signal }
+ SetSignal(0,SIGBREAKF_CTRL_C);
+ Halt(CTRL_C);
+ end;
+ end;
+end;
+
+
+{ Converts a MorphOS dos.library error code to a TP compatible error code }
+{ Based on 1.0.x Amiga RTL }
+procedure dosError2InOut(errno: LongInt);
+begin
+ case errno of
+ ERROR_BAD_NUMBER,
+ ERROR_ACTION_NOT_KNOWN,
+ ERROR_NOT_IMPLEMENTED : InOutRes := 1;
+
+ ERROR_OBJECT_NOT_FOUND : InOutRes := 2;
+ ERROR_DIR_NOT_FOUND : InOutRes := 3;
+ ERROR_DISK_WRITE_PROTECTED : InOutRes := 150;
+ ERROR_OBJECT_WRONG_TYPE : InOutRes := 151;
+
+ ERROR_OBJECT_EXISTS,
+ ERROR_DELETE_PROTECTED,
+ ERROR_WRITE_PROTECTED,
+ ERROR_READ_PROTECTED,
+ ERROR_OBJECT_IN_USE,
+ ERROR_DIRECTORY_NOT_EMPTY : InOutRes := 5;
+
+ ERROR_NO_MORE_ENTRIES : InOutRes := 18;
+ ERROR_RENAME_ACROSS_DEVICES : InOutRes := 17;
+ ERROR_DISK_FULL : InOutRes := 101;
+ ERROR_INVALID_RESIDENT_LIBRARY : InoutRes := 153;
+ ERROR_BAD_HUNK : InOutRes := 153;
+ ERROR_NOT_A_DOS_DISK : InOutRes := 157;
+
+ ERROR_NO_DISK,
+ ERROR_DISK_NOT_VALIDATED,
+ ERROR_DEVICE_NOT_MOUNTED : InOutRes := 152;
+
+ ERROR_SEEK_ERROR : InOutRes := 156;
+
+ ERROR_LOCK_COLLISION,
+ ERROR_LOCK_TIMEOUT,
+ ERROR_UNLOCK_ERROR,
+ ERROR_INVALID_LOCK,
+ ERROR_INVALID_COMPONENT_NAME,
+ ERROR_BAD_STREAM_NAME,
+ ERROR_FILE_NOT_OBJECT : InOutRes := 6;
+ else
+ InOutres := errno;
+ end;
+end;
+
+
+{ Converts an Unix-like path to Amiga-like path }
+function PathConv(path: string): string; alias: 'PATHCONV'; [public];
+var tmppos: longint;
+begin
+ { check for short paths }
+ if length(path)<=2 then begin
+ if (path='.') or (path='./') then path:='' else
+ if path='..' then path:='/' else
+ if path='*' then path:='#?';
+ end else begin
+ { convert parent directories }
+ tmppos:=pos('../',path);
+ while tmppos<>0 do begin
+ { delete .. to have / as parent dir sign }
+ delete(path,tmppos,2);
+ tmppos:=pos('../',path);
+ end;
+ { convert current directories }
+ tmppos:=pos('./',path);
+ while tmppos<>0 do begin
+ { delete ./ since we doesn't need to sign current directory }
+ delete(path,tmppos,2);
+ tmppos:=pos('./',path);
+ end;
+ { convert wildstart to #? }
+ tmppos:=pos('*',path);
+ while tmppos<>0 do begin
+ delete(path,tmppos,1);
+ insert('#?',path,tmppos);
+ tmppos:=pos('*',path);
+ end;
+ end;
+ PathConv:=path;
+end;
+
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/morphos/sysosh.inc b/rtl/morphos/sysosh.inc
new file mode 100644
index 0000000000..00b30298e5
--- /dev/null
+++ b/rtl/morphos/sysosh.inc
@@ -0,0 +1,50 @@
+{
+ $Id: sysosh.inc,v 1.2 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+ THandle = Int64;
+{$else CPU64}
+ THandle = Longint;
+{$endif CPU64}
+ TThreadID = THandle;
+
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = record
+ Locked: boolean
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/morphos/system.pp b/rtl/morphos/system.pp
new file mode 100644
index 0000000000..954443496d
--- /dev/null
+++ b/rtl/morphos/system.pp
@@ -0,0 +1,357 @@
+{
+ $Id: system.pp,v 1.33 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Karoly Balogh for Genesi S.a.r.l.
+
+ System unit for MorphOS/PowerPC
+
+ Uses parts of the Commodore Amiga/68k port by Carl Eric Codere
+ and Nils Sjoholm
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit {$ifdef VER1_0}SysMorph{$else}System{$endif};
+
+interface
+
+{$define FPC_IS_SYSTEM}
+
+{$I systemh.inc}
+
+const
+ LineEnding = #10;
+ LFNSupport = True;
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+ maxExitCode = 255;
+
+const
+ UnusedHandle : LongInt = -1;
+ StdInputHandle : LongInt = 0;
+ StdOutputHandle : LongInt = 0;
+ StdErrorHandle : LongInt = 0;
+
+ FileNameCaseSensitive : Boolean = False;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+
+ sLineBreak : string[1] = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+
+ BreakOn : Boolean = True;
+
+
+var
+ MOS_ExecBase : Pointer; external name '_ExecBase';
+ MOS_DOSBase : Pointer;
+ MOS_UtilityBase: Pointer;
+
+ MOS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
+ MOS_origDir : LongInt; { original directory on startup }
+ MOS_ambMsg : Pointer;
+ MOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
+ MOS_ConHandle: LongInt;
+
+ argc: LongInt;
+ argv: PPChar;
+ envp: PPChar;
+
+
+implementation
+
+{$I system.inc}
+
+
+{*****************************************************************************
+ Misc. System Dependent Functions
+*****************************************************************************}
+
+procedure haltproc(e:longint);cdecl;external name '_haltproc';
+
+procedure System_exit;
+begin
+ { We must remove the CTRL-C FLAG here because halt }
+ { may call I/O routines, which in turn might call }
+ { halt, so a recursive stack crash }
+ if BreakOn then begin
+ if (SetSignal(0,0) and SIGBREAKF_CTRL_C)<>0 then
+ SetSignal(0,SIGBREAKF_CTRL_C);
+ end;
+
+ { Closing opened files }
+ CloseList(MOS_fileList);
+
+ { Changing back to original directory if changed }
+ if MOS_origDir<>0 then begin
+ CurrentDir(MOS_origDir);
+ end;
+
+ if MOS_UtilityBase<>nil then CloseLibrary(MOS_UtilityBase);
+ if MOS_DOSBase<>nil then CloseLibrary(MOS_DOSBase);
+ if MOS_heapPool<>nil then DeletePool(MOS_heapPool);
+ haltproc(ExitCode);
+end;
+
+{ Generates correct argument array on startup }
+procedure GenerateArgs;
+var
+ argvlen : longint;
+
+ procedure allocarg(idx,len:longint);
+ var
+ i,oldargvlen : longint;
+ begin
+ if idx>=argvlen then
+ begin
+ oldargvlen:=argvlen;
+ argvlen:=(idx+8) and (not 7);
+ sysreallocmem(argv,argvlen*sizeof(pointer));
+ for i:=oldargvlen to argvlen-1 do
+ argv[i]:=nil;
+ end;
+ { use realloc to reuse already existing memory }
+ sysreallocmem(argv[idx],len+1);
+ end;
+
+var
+ count: word;
+ start: word;
+ localindex: word;
+ p : pchar;
+ temp : string;
+
+begin
+ p:=GetArgStr;
+ argvlen:=0;
+
+ { Set argv[0] }
+ temp:=paramstr(0);
+ allocarg(0,length(temp));
+ move(temp[1],argv[0]^,length(temp));
+ argv[0][length(temp)]:=#0;
+
+ { check if we're started from Ambient }
+ if MOS_ambMsg<>nil then
+ begin
+ argc:=0;
+ exit;
+ end;
+
+ { Handle the other args }
+ count:=0;
+ { first index is one }
+ localindex:=1;
+ while (p[count]<>#0) do
+ begin
+ while (p[count]=' ') or (p[count]=#9) or (p[count]=LineEnding) do inc(count);
+ start:=count;
+ while (p[count]<>#0) and (p[count]<>' ') and (p[count]<>#9) and (p[count]<>LineEnding) do inc(count);
+ if (count-start>0) then
+ begin
+ allocarg(localindex,count-start);
+ move(p[start],argv[localindex]^,count-start);
+ argv[localindex][count-start]:=#0;
+ inc(localindex);
+ end;
+ end;
+ argc:=localindex;
+end;
+
+function GetProgDir: String;
+var
+ s1 : String;
+ alock : LongInt;
+ counter: Byte;
+begin
+ GetProgDir:='';
+ FillChar(s1,255,#0);
+ { GetLock of program directory }
+ alock:=GetProgramDir;
+ if alock<>0 then begin
+ if NameFromLock(alock,@s1[1],255) then begin
+ counter:=1;
+ while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
+ s1[0]:=Char(counter-1);
+ GetProgDir:=s1;
+ end;
+ end;
+end;
+
+function GetProgramName: String;
+{ Returns ONLY the program name }
+var
+ s1 : String;
+ counter: Byte;
+begin
+ GetProgramName:='';
+ FillChar(s1,255,#0);
+ if GetProgramName(@s1[1],255) then begin
+ { now check out and assign the length of the string }
+ counter := 1;
+ while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
+ s1[0]:=Char(counter-1);
+
+ { now remove any component path which should not be there }
+ for counter:=length(s1) downto 1 do
+ if (s1[counter] = '/') or (s1[counter] = ':') then break;
+ { readjust counterv to point to character }
+ if counter<>1 then Inc(counter);
+
+ GetProgramName:=copy(s1,counter,length(s1));
+ end;
+end;
+
+
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+ if MOS_ambMsg<>nil then
+ paramcount:=0
+ else
+ paramcount:=argc-1;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+var
+ s1: String;
+begin
+ paramstr:='';
+ if MOS_ambMsg<>nil then exit;
+
+ if l=0 then begin
+ s1:=GetProgDir;
+ if s1[length(s1)]=':' then paramstr:=s1+GetProgramName
+ else paramstr:=s1+'/'+GetProgramName;
+ end else begin
+ if (l>0) and (l+1<=argc) then paramstr:=strpas(argv[l]);
+ end;
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+var tmpTime: TDateStamp;
+begin
+ DateStamp(@tmpTime);
+ randseed:=tmpTime.ds_tick;
+end;
+
+
+{ MorphOS specific startup }
+procedure SysInitMorphOS;
+var self: PProcess;
+begin
+ self:=PProcess(FindTask(nil));
+ if self^.pr_CLI=0 then begin
+ { if we're running from Ambient/Workbench, we catch its message }
+ WaitPort(@self^.pr_MsgPort);
+ MOS_ambMsg:=GetMsg(@self^.pr_MsgPort);
+ end;
+
+ MOS_DOSBase:=OpenLibrary('dos.library',50);
+ if MOS_DOSBase=nil then Halt(1);
+ MOS_UtilityBase:=OpenLibrary('utility.library',50);
+ if MOS_UtilityBase=nil then Halt(1);
+
+ { Creating the memory pool for growing heap }
+ MOS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
+ if MOS_heapPool=nil then Halt(1);
+
+ if MOS_ambMsg=nil then begin
+ StdInputHandle:=dosInput;
+ StdOutputHandle:=dosOutput;
+ end else begin
+ MOS_ConHandle:=Open(MOS_ConName,MODE_OLDFILE);
+ if MOS_ConHandle<>0 then begin
+ StdInputHandle:=MOS_ConHandle;
+ StdOutputHandle:=MOS_ConHandle;
+ end else
+ Halt(1);
+ end;
+end;
+
+
+procedure SysInitStdIO;
+begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+
+ { * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * }
+ StdErrorHandle:=StdOutputHandle;
+ // OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+ // OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+end;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID:=SizeUInt(FindTask(NIL));
+end;
+
+
+begin
+ IsConsole := TRUE;
+ IsLibrary := FALSE;
+ StackLength := InitialStkLen;
+ StackBottom := Sptr - StackLength;
+{ OS specific startup }
+ MOS_ambMsg:=nil;
+ MOS_origDir:=0;
+ MOS_fileList:=nil;
+ envp:=nil;
+ SysInitMorphOS;
+{ Set up signals handlers }
+// InstallSignals;
+{ Setup heap }
+ InitHeap;
+ SysInitExceptions;
+{ Setup stdin, stdout and stderr }
+ SysInitStdIO;
+{ Reset IO Error }
+ InOutRes:=0;
+{ Arguments }
+ GenerateArgs;
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+end.
+
+{
+ $Log: system.pp,v $
+ Revision 1.33 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.32 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.31 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.30 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+ Revision 1.29 2005/01/12 08:03:42 karoly
+ * Few more Sysutils functions implemented
+
+ Revision 1.28 2005/01/11 17:43:14 karoly
+ * some cleanup, more sanity checks and updates for sysutils
+
+}
diff --git a/rtl/morphos/systhrd.inc b/rtl/morphos/systhrd.inc
new file mode 100644
index 0000000000..6232819a8b
--- /dev/null
+++ b/rtl/morphos/systhrd.inc
@@ -0,0 +1,42 @@
+{
+ $Id: systhrd.inc,v 1.1 2005/02/07 21:30:12 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure InitSystemThreads;
+begin
+ { This should be changed to a real value during
+ thread driver initialization if appropriate. }
+ ThreadID := 1;
+ SetNoThreadManager;
+end;
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.1 2005/02/07 21:30:12 peter
+ * system unit updated
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/morphos/sysutils.pp b/rtl/morphos/sysutils.pp
new file mode 100644
index 0000000000..3b73cccf9a
--- /dev/null
+++ b/rtl/morphos/sysutils.pp
@@ -0,0 +1,587 @@
+{
+ $Id: sysutils.pp,v 1.7 2005/02/26 14:38:14 florian Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Karoly Balogh
+
+ Sysutils unit for MorphOS
+
+ Based on Amiga version by Carl Eric Codere, and other
+ parts of the RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit sysutils;
+
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+{ Platform dependent calls }
+
+Procedure AddDisk(const path:string);
+
+
+implementation
+
+uses dos,sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{ * Include MorphOS specific includes * }
+{$include execd.inc}
+{$include execf.inc}
+{$include timerd.inc}
+{$include doslibd.inc}
+{$include doslibf.inc}
+{$include utilf.inc}
+
+{ * Followings are implemented in the system unit! * }
+function PathConv(path: shortstring): shortstring; external name 'PATHCONV';
+procedure AddToList(var l: Pointer; h: LongInt); external name 'ADDTOLIST';
+procedure RemoveFromList(var l: Pointer; h: LongInt); external name 'REMOVEFROMLIST';
+
+var
+ MOS_fileList: Pointer; external name 'MOS_FILELIST';
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+{$I-}{ Required for correct usage of these routines }
+
+
+(****** non portable routines ******)
+
+function FileOpen(const FileName: string; Mode: Integer): LongInt;
+var
+ dosResult: LongInt;
+ tmpStr : array[0..255] of char;
+begin
+ {$WARNING FIX ME! To do: FileOpen Access Modes}
+ tmpStr:=PathConv(FileName)+#0;
+ dosResult:=Open(@tmpStr,MODE_OLDFILE);
+ if dosResult=0 then
+ dosResult:=-1
+ else
+ AddToList(MOS_fileList,dosResult);
+
+ FileOpen:=dosResult;
+end;
+
+
+function FileGetDate(Handle: LongInt) : LongInt;
+begin
+end;
+
+
+function FileSetDate(Handle, Age: LongInt) : LongInt;
+begin
+ // Impossible under unix from FileHandle !!
+ FileSetDate:=-1;
+end;
+
+
+function FileCreate(const FileName: string) : LongInt;
+var
+ dosResult: LongInt;
+ tmpStr : array[0..255] of char;
+begin
+ tmpStr:=PathConv(FileName)+#0;
+ dosResult:=Open(@tmpStr,MODE_NEWFILE);
+ if dosResult=0 then
+ dosResult:=-1
+ else
+ AddToList(MOS_fileList,dosResult);
+
+ FileCreate:=dosResult;
+end;
+
+
+function FileCreate(const FileName: string; Mode: integer): LongInt;
+begin
+ {$WARNING FIX ME! To do: FileCreate Access Modes}
+ FileCreate:=FileCreate(FileName);
+end;
+
+
+function FileRead(Handle: LongInt; var Buffer; Count: LongInt): LongInt;
+begin
+ FileRead:=-1;
+ if (Count<=0) or (Handle<=0) then exit;
+
+ FileRead:=dosRead(Handle,@Buffer,Count);
+end;
+
+
+function FileWrite(Handle: LongInt; const Buffer; Count: LongInt): LongInt;
+begin
+ FileWrite:=-1;
+ if (Count<=0) or (Handle<=0) then exit;
+
+ FileWrite:=dosWrite(Handle,@Buffer,Count);
+end;
+
+
+function FileSeek(Handle, FOffset, Origin: LongInt) : LongInt;
+var
+ seekMode: LongInt;
+begin
+ FileSeek:=-1;
+ if (Handle<=0) then exit;
+
+ case Origin of
+ fsFromBeginning: seekMode:=OFFSET_BEGINNING;
+ fsFromCurrent : seekMode:=OFFSET_CURRENT;
+ fsFromEnd : seekMode:=OFFSET_END;
+ end;
+
+ FileSeek:=dosSeek(Handle, FOffset, seekMode);
+end;
+
+function FileSeek(Handle: LongInt; FOffset, Origin: Int64): Int64;
+begin
+ {$WARNING Need to add 64bit call }
+ FileSeek:=FileSeek(Handle,LongInt(FOffset),LongInt(Origin));
+end;
+
+
+procedure FileClose(Handle: LongInt);
+begin
+ if (Handle<=0) then exit;
+
+ dosClose(Handle);
+ RemoveFromList(MOS_fileList,Handle);
+end;
+
+
+function FileTruncate(Handle, Size: LongInt): Boolean;
+var
+ dosResult: LongInt;
+begin
+ FileTruncate:=False;
+ if (Handle<=0) then exit;
+
+ dosResult:=SetFileSize(Handle, Size, OFFSET_BEGINNING);
+ if (dosResult<0) then exit;
+
+ FileTruncate:=True;
+end;
+
+
+function DeleteFile(const FileName: string) : Boolean;
+var
+ tmpStr: array[0..255] of char;
+begin
+ tmpStr:=PathConv(FileName)+#0;
+
+ DeleteFile:=dosDeleteFile(@tmpStr);
+end;
+
+
+function RenameFile(const OldName, NewName: string): Boolean;
+var
+ tmpOldName, tmpNewName: array[0..255] of char;
+begin
+ tmpOldName:=PathConv(OldName)+#0;
+ tmpNewName:=PathConv(NewName)+#0;
+
+ RenameFile:=dosRename(tmpOldName, tmpNewName);
+end;
+
+
+(****** end of non portable routines ******)
+
+
+Function FileAge (Const FileName : String): Longint;
+
+var F: file;
+ Time: longint;
+begin
+ Assign(F,FileName);
+ dos.GetFTime(F,Time);
+ { Warning this is not compatible with standard routines
+ since Double are not supported on m68k by default!
+ }
+ FileAge:=Time;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+Var
+ F: File;
+ OldMode : Byte;
+Begin
+ OldMode := FileMode;
+ FileMode := fmOpenRead;
+ Assign(F,FileName);
+ Reset(F,1);
+ FileMode := OldMode;
+ If IOResult <> 0 then
+ FileExists := FALSE
+ else
+ Begin
+ FileExists := TRUE;
+ Close(F);
+ end;
+end;
+
+type
+ PDOSSearchRec = ^SearchRec;
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+Const
+ faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
+var
+ p : pDOSSearchRec;
+ dosattr: word;
+ DT: Datetime;
+begin
+ dosattr:=0;
+ if Attr and faHidden <> 0 then
+ dosattr := dosattr or Hidden;
+ if Attr and faSysFile <> 0 then
+ dosattr := dosattr or SysFile;
+ if Attr and favolumeID <> 0 then
+ dosattr := dosattr or VolumeID;
+ if Attr and faDirectory <> 0 then
+ dosattr := dosattr or Directory;
+ New(p);
+ Rslt.FindHandle := THandle(p);
+ dos.FindFirst(path,dosattr,p^);
+ if DosError <> 0 then
+ begin
+ FindFirst := -1;
+ end
+ else
+ begin
+ Rslt.Name := p^.Name;
+ { Not compatible with other platforms! }
+ Rslt.Time:=p^.Time;
+ Rslt.Attr := p^.Attr;
+ Rslt.ExcludeAttr := not p^.Attr;
+ Rslt.Size := p^.Size;
+ FindFirst := 0;
+ end;
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+var
+ p : pDOSSearchRec;
+ DT: Datetime;
+begin
+ p:= PDOsSearchRec(Rslt.FindHandle);
+ if not assigned(p) then
+ begin
+ FindNext := -1;
+ exit;
+ end;
+ Dos.FindNext(p^);
+ if DosError <> 0 then
+ begin
+ FindNext := -1;
+ end
+ else
+ begin
+ Rslt.Name := p^.Name;
+ UnpackTime(p^.Time, DT);
+ { Warning: Not compatible with other platforms }
+ Rslt.time := p^.Time;
+ Rslt.Attr := p^.Attr;
+ Rslt.ExcludeAttr := not p^.Attr;
+ Rslt.Size := p^.Size;
+ FindNext := 0;
+ end;
+end;
+
+Procedure FindClose (Var F : TSearchrec);
+Var
+ p : PDOSSearchRec;
+
+begin
+ p:=PDOSSearchRec(f.FindHandle);
+ if not assigned(p) then
+ exit;
+ Dos.FindClose(p^);
+ if assigned(p) then
+ Dispose(p);
+ f.FindHandle := THandle(nil);
+end;
+
+Function FileGetAttr (Const FileName : String) : Longint;
+var
+ F: file;
+ attr: word;
+begin
+ Assign(F,FileName);
+ dos.GetFAttr(F,attr);
+ if DosError <> 0 then
+ FileGetAttr := -1
+ else
+ FileGetAttr := Attr;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+ F: file;
+begin
+ Assign(F, FileName);
+ Dos.SetFAttr(F, Attr and $ffff);
+ FileSetAttr := DosError;
+end;
+
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.',
+ '/fd0/.',
+ '/fd1/.',
+ '/.'
+ );
+var
+ Drives : byte;
+ DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+
+Function DiskFree(Drive: Byte): int64;
+Begin
+ DiskFree := dos.diskFree(Drive);
+End;
+
+
+Function DiskSize(Drive: Byte): int64;
+Begin
+ DiskSize := dos.DiskSize(Drive);
+End;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ ChDir(NewDir);
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ MkDir(NewDir);
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ RmDir(Dir);
+ result := (IOResult = 0);
+end;
+
+
+Function DirectoryExists(const Directory: string): Boolean;
+var
+ s: string;
+begin
+ { Get old directory }
+ s:=GetCurrentDir;
+ ChDir(Directory);
+ DirectoryExists := (IOResult = 0);
+ ChDir(s);
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var
+ dayOfWeek: word;
+begin
+ dos.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second,SystemTime.Millisecond);
+ dos.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day, DayOfWeek);
+end ;
+
+
+Procedure InitAnsi;
+Var
+ i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+{ Result:=StrError(ErrorCode);}
+end;
+
+{****************************************************************************
+ OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=Dos.Getenv(shortstring(EnvVar));
+end;
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ // Result:=FPCCountEnvVar(EnvP);
+ Result:=Dos.envCount;
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ // Result:=FPCGetEnvStrFromP(Envp,Index);
+ Result:=Dos.EnvStr(Index);
+end;
+
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+ integer;
+var
+ CommandLine: AnsiString;
+ E: EOSError;
+
+begin
+ Dos.Exec (Path, ComLine);
+ if DosError <> 0 then begin
+
+ if ComLine = '' then
+ CommandLine := Path
+ else
+ CommandLine := Path + ' ' + ComLine;
+
+ E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, DosError]);
+ E.ErrorCode := DosError;
+ raise E;
+ end;
+end;
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions;
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+{
+ $Log: sysutils.pp,v $
+ Revision 1.7 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.5 2005/01/30 02:36:14 karoly
+ * fixed compilation
+
+ Revision 1.4 2005/01/12 08:03:42 karoly
+ * Few more Sysutils functions implemented
+
+ Revision 1.3 2005/01/11 17:44:06 karoly
+ * basic file I/O implemented
+
+}
diff --git a/rtl/morphos/timer.pp b/rtl/morphos/timer.pp
new file mode 100644
index 0000000000..195426c7d3
--- /dev/null
+++ b/rtl/morphos/timer.pp
@@ -0,0 +1,43 @@
+{
+ $Id: timer.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ timer.device interface unit for MorphOS/PowerPC
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit timer;
+
+interface
+
+uses
+ exec;
+
+var
+ TimerBase : Pointer;
+
+{$include timerd.inc}
+{$include timerf.inc}
+
+implementation
+
+begin
+end.
+
+{
+ $Log: timer.pp,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/timerd.inc b/rtl/morphos/timerd.inc
new file mode 100644
index 0000000000..5fa3e7258b
--- /dev/null
+++ b/rtl/morphos/timerd.inc
@@ -0,0 +1,74 @@
+{
+ $Id: timerd.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ timer.device definitions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002-3 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{ * timer.device definitions (V50)
+ *********************************************************************
+ * }
+
+
+const
+ UNIT_MICROHZ = 0;
+ UNIT_VBLANK = 1;
+ UNIT_ECLOCK = 2;
+ UNIT_WAITUNTIL = 3;
+ UNIT_WAITECLOCK = 4;
+ { *** V50 *** }
+ UNIT_CPUCLOCK = 5;
+ UNIT_WAITCPUCLOCK = 6;
+
+const
+ TIMERNAME = 'timer.device';
+
+
+type
+ PTimeVal = ^TTimeVal;
+ TTimeVal = packed record
+ tv_secs : DWord;
+ tv_micro: DWord;
+ end;
+
+type
+ PEClockVal = ^TEClockVal;
+ TEClockVal = packed record
+ ev_hi: DWord;
+ ev_lo: DWord;
+ end;
+
+type
+ PTimeRequest = ^TTimeRequest;
+ TTimeRequest = packed record
+ tr_node: TIORequest;
+ tr_time: TTimeVal;
+ end;
+
+
+const
+ TR_ADDREQUEST = (CMD_NONSTD);
+ TR_GETSYSTIME = (CMD_NONSTD + 1);
+ TR_SETSYSTIME = (CMD_NONSTD + 2);
+
+
+
+{
+ $Log: timerd.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/timerf.inc b/rtl/morphos/timerf.inc
new file mode 100644
index 0000000000..f57d78c2eb
--- /dev/null
+++ b/rtl/morphos/timerf.inc
@@ -0,0 +1,45 @@
+{
+ $Id: timerf.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ timer.device functions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002-3 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure AddTime(Dest : PTimeVal location 'a0';
+ Source: PTimeVal location 'a1');
+SysCall TimerBase 42;
+
+procedure SubTime(Dest : PTimeVal location 'a0';
+ Source: PTimeVal location 'a1');
+SysCall TimerBase 48;
+
+function CmpTime(Dest : PTimeVal location 'a0';
+ Source: PTimeVal location 'a1'): LongInt;
+SysCall TimerBase 54;
+
+function ReadEClock(Dest: PTimeVal location 'a0'): DWord;
+SysCall TimerBase 60;
+
+procedure GetSysTime(Dest: PTimeVal location 'a0');
+SysCall TimerBase 66;
+
+
+{
+ $Log: timerf.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/tthread.inc b/rtl/morphos/tthread.inc
new file mode 100644
index 0000000000..8408407125
--- /dev/null
+++ b/rtl/morphos/tthread.inc
@@ -0,0 +1,188 @@
+{
+ $Id: tthread.inc,v 1.3 2005/02/25 21:41:09 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2002 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************}
+{* TThread *}
+{****************************************************************************}
+
+{$WARNING This file is only a stub, and will not work!}
+
+const
+ ThreadCount: longint = 0;
+
+(* Implementation of exported functions *)
+
+procedure AddThread (T: TThread);
+begin
+ Inc (ThreadCount);
+end;
+
+
+procedure RemoveThread (T: TThread);
+begin
+ Dec (ThreadCount);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate (Self);
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+var
+{ PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;}
+ I: TThreadPriority;
+begin
+{
+ DosGetInfoBlocks (@PTIB, @PPIB);
+ with PTIB^.TIB2^ do
+ if Priority >= $300 then GetPriority := tpTimeCritical else
+ if Priority < $200 then GetPriority := tpIdle else
+ begin
+ I := Succ (Low (TThreadPriority));
+ while (I < High (TThreadPriority)) and
+ (Priority - Priorities [I] <= Priorities [Succ (I)] - Priority) do Inc (I);
+ GetPriority := I;
+ end;
+}
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+{var
+ PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;}
+begin
+{ DosGetInfoBlocks (@PTIB, @PPIB);}
+(*
+ PTIB^.TIB2^.Priority := Priorities [Value];
+*)
+{
+ DosSetPriority (2, High (Priorities [Value]),
+ Low (Priorities [Value]) - PTIB^.TIB2^.Priority, FHandle);}
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ begin
+ if Value then Suspend else Resume;
+ end;
+end;
+
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned (FOnTerminate) then Synchronize (@CallOnTerminate);
+end;
+
+
+function ThreadProc(Args: pointer): Integer; cdecl;
+var
+ FreeThread: Boolean;
+ Thread: TThread absolute Args;
+begin
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ Result := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then Thread.Free;
+{
+ DosExit (deThread, Result);
+}
+end;
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: cardinal;
+begin
+ inherited Create;
+ AddThread (Self);
+{
+ FSuspended := CreateSuspended;
+ Flags := dtStack_Commited;
+ if FSuspended then Flags := Flags or dtSuspended;
+ if DosCreateThread (cardinal (FThreadID), @ThreadProc, pointer (Self),
+ Flags, 16384) <> 0 then
+ begin
+ FFinished := true;
+ Destroy;
+ end else FHandle := FThreadID;
+ IsMultiThread := true;
+ FFatalException := nil;
+}
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished and not Suspended then
+ begin
+ Terminate;
+ WaitFor;
+ end;
+{
+ if FHandle <> -1 then DosKillThread (cardinal (FHandle));
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread (Self);
+}
+end;
+
+procedure TThread.Resume;
+begin
+{ FSuspended := not (DosResumeThread (cardinal (FHandle)) = 0);}
+end;
+
+
+procedure TThread.Suspend;
+begin
+{ FSuspended := DosSuspendThread (cardinal (FHandle)) = 0;}
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := true;
+end;
+
+
+function TThread.WaitFor: Integer;
+var
+ FH: cardinal;
+begin
+{ WaitFor := DosWaitThread (FH, dtWait);}
+end;
+
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.3 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/utild1.inc b/rtl/morphos/utild1.inc
new file mode 100644
index 0000000000..e6036d4f64
--- /dev/null
+++ b/rtl/morphos/utild1.inc
@@ -0,0 +1,160 @@
+{
+ $Id: utild1.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ utility definitions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion, first part
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{ * utility.library date defines
+ *********************************************************************
+ * }
+
+
+type
+ PClockData = ^TClockData;
+ TClockData = packed record
+ sec : Word;
+ min : Word;
+ hour : Word;
+ mday : Word;
+ month: Word;
+ year : Word;
+ wday : Word;
+ end;
+
+
+
+{ * utility.library tagitem defines
+ *********************************************************************
+ * }
+
+
+type
+ Tag = Cardinal;
+
+type
+ PPTagItem = ^PTagItem;
+ PTagItem = ^TTagItem;
+ TTagItem = packed record
+ ti_Tag : Tag;
+ ti_Data: Cardinal;
+ end;
+
+
+const
+ TAG_DONE = 0;
+ TAG_END = 0;
+ TAG_IGNORE = 1;
+ TAG_MORE = 2;
+ TAG_SKIP = 3;
+
+const
+ TAG_USER = 1 Shl 31;
+
+const
+ TAGFILTER_AND = 0;
+ TAGFILTER_NOT = 1;
+
+const
+ MAP_REMOVE_NOT_FOUND = 0;
+ MAP_KEEP_NOT_FOUND = 1;
+
+
+
+{ * utility.library namespace defines
+ *********************************************************************
+ * }
+
+
+type
+ PNamedObject = ^TNamedObject;
+ TNamedObject = packed record
+ no_Object: Pointer;
+ end;
+
+
+const
+ ANO_NameSpace = 4000;
+ ANO_UserSpace = 4001;
+ ANO_Priority = 4002;
+ ANO_Flags = 4003;
+
+ NSB_NODUPS = 0;
+ NSB_CASE = 1;
+
+ NSF_NODUPS = 1 Shl NSB_NODUPS;
+ NSF_CASE = 1 Shl NSB_CASE;
+
+
+
+{ * utility.library pack attributes and macros
+ *********************************************************************
+ * }
+
+
+const
+ PSTB_SIGNED = 31;
+ PSTB_UNPACK = 30;
+ PSTB_PACK = 29;
+ PSTB_EXISTS = 26;
+
+ PSTF_SIGNED = (1 Shl PSTB_SIGNED);
+ PSTF_UNPACK = (1 Shl PSTB_UNPACK);
+ PSTF_PACK = (1 Shl PSTB_PACK);
+ PSTF_EXISTS = (1 Shl PSTB_EXISTS);
+
+const
+ PKCTRL_PACKUNPACK = $00000000;
+ PKCTRL_PACKONLY = $40000000;
+ PKCTRL_UNPACKONLY = $20000000;
+
+ PKCTRL_BYTE = $80000000;
+ PKCTRL_WORD = $88000000;
+ PKCTRL_LONG = $90000000;
+
+ PKCTRL_UBYTE = $00000000;
+ PKCTRL_UWORD = $08000000;
+ PKCTRL_ULONG = $10000000;
+
+ PKCTRL_BIT = $18000000;
+ PKCTRL_FLIPBIT = $98000000;
+
+{$WARNING FIX ME!!! Some macros to convert}
+{
+ PK_BITNUM1(flg) ((flg) == 0x01 ? 0 : (flg) == 0x02 ? 1 : (flg) == 0x04 ? 2 : (flg) == 0x08 ? 3 : (flg) == 0x10 ? 4 : (flg) == 0x20 ? 5 : (flg) == 0x40 ? 6 : 7)
+ PK_BITNUM2(flg) ((flg < 0x100 ? PK_BITNUM1(flg) : 8 + PK_BITNUM1(flg >> 8)))
+ PK_BITNUM(flg) ((flg < 0x10000 ? PK_BITNUM2(flg) : 16 + PK_BITNUM2(flg >> 16)))
+ PK_WORDOFFSET(flg) ((flg) < 0x100 ? 1 : 0)
+ PK_LONGOFFSET(flg) ((flg) < 0x100 ? 3 : (flg) < 0x10000 ? 2 : (flg) < 0x1000000 ? 1 : 0)
+ PK_CALCOFFSET(type,field) ((ULONG)(&((struct type *)0)->field))
+
+
+ PACK_STARTTABLE(tagbase) (tagbase)
+ PACK_NEWOFFSET(tagbase) (-1L),(tagbase)
+ PACK_ENDTABLE 0
+ PACK_ENTRY(tagbase,tag,type,field,control) (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field))
+ PACK_BYTEBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field) | (PK_BITNUM(flags) << 13L))
+ PACK_WORDBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field) + PK_WORDOFFSET(flags)) | ((PK_BITNUM(flags) & 7) << 13L))
+ PACK_LONGBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field) + PK_LONGOFFSET(flags)) | ((PK_BITNUM(flags) & 7) << 13L))
+}
+
+
+{
+ $Log: utild1.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/utild2.inc b/rtl/morphos/utild2.inc
new file mode 100644
index 0000000000..32b32f8c50
--- /dev/null
+++ b/rtl/morphos/utild2.inc
@@ -0,0 +1,60 @@
+{
+ $Id: utild2.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ utility definitions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion, second part
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{ * utility.library include
+ *********************************************************************
+ * }
+
+
+const
+ UtilityName = 'utility.library';
+
+
+type
+ PUtilityBase = ^TUtilityName;
+ TUtilityName = packed record
+ ub_LibNode : TLibrary;
+ ub_Language: Byte;
+ ub_Reserved: Byte;
+ end;
+
+
+
+{ * utility.library hook defines
+ *********************************************************************
+ * }
+
+
+type
+ PHook = ^THook;
+ THook = packed record
+ h_MinNode : TMinNode;
+ h_Entry : Cardinal;
+ h_SubEntry: Cardinal;
+ h_Data : Pointer;
+ end;
+
+
+{
+ $Log: utild2.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/utilf.inc b/rtl/morphos/utilf.inc
new file mode 100644
index 0000000000..c9b383a8cf
--- /dev/null
+++ b/rtl/morphos/utilf.inc
@@ -0,0 +1,176 @@
+{
+ $Id: utilf.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ utility functions (V50) for MorphOS/PowerPC
+ Copyright (c) 2002 The MorphOS Development Team, All Rights Reserved.
+
+ Free Pascal conversion
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+function FindTagItem(tagVal : Cardinal location 'd0';
+ tagList: PTagItem location 'a0'): PTagItem;
+SysCall MOS_UtilityBase 030;
+
+function GetTagData(tagValue : Cardinal location 'd0';
+ defaultVal: Cardinal location 'd1';
+ tagList : PTagItem location 'a0'): Cardinal;
+SysCall MOS_UtilityBase 036;
+
+function PackBoolTags(initialFlags: Cardinal location 'd0';
+ tagList : PTagItem location 'a0';
+ boolMap : PTagItem location 'a1'): Cardinal;
+SysCall MOS_UtilityBase 042;
+
+function NextTagItem(tagListPtr: pPTagItem location 'a0'): PTagItem;
+SysCall MOS_UtilityBase 048;
+
+procedure FilterTagChanges(changeList : PTagItem location 'a0';
+ originalList: PTagItem location 'a1';
+ apply : Cardinal location 'd0');
+SysCall MOS_UtilityBase 054;
+
+procedure MapTags(tagList: PTagItem location 'a0';
+ mapList: PTagItem location 'a1';
+ mapType: Cardinal location 'd0');
+SysCall MOS_UtilityBase 060;
+
+function AllocateTagItems(numTags: Cardinal location 'd0'): PTagItem;
+SysCall MOS_UtilityBase 066;
+
+function CloneTagItems(tagList: PTagItem location 'a0'): PTagItem;
+SysCall MOS_UtilityBase 072;
+
+procedure FreeTagItems(tagList: PTagItem location 'a0');
+SysCall MOS_UtilityBase 078;
+
+procedure RefreshTagItemClones(clone : PTagItem location 'a0';
+ original: PTagItem location 'a1');
+SysCall MOS_UtilityBase 084;
+
+function TagInArray(tagValue : Cardinal location 'd0';
+ var tagArray: Cardinal location 'a0'): Boolean;
+SysCall MOS_UtilityBase 090;
+
+function FilterTagItems(tagList : PTagItem location 'a0';
+ var filterArray: Cardinal location 'a1';
+ logic : Cardinal location 'd0'): Cardinal;
+SysCall MOS_UtilityBase 096;
+
+function CallHookPkt(hook : PHook location 'a0';
+ hobject : Pointer location 'a2';
+ paramPacket: Pointer location 'a1'): Cardinal;
+SysCall MOS_UtilityBase 102;
+
+procedure Amiga2Date(seconds: Cardinal location 'd0';
+ result : PClockData location 'a0');
+SysCall MOS_UtilityBase 120;
+
+function Date2Amiga(date: PClockData location 'a0'): Cardinal;
+SysCall MOS_UtilityBase 126;
+
+function CheckDate(date: PClockData location 'a0'): Cardinal;
+SysCall MOS_UtilityBase 132;
+
+function SMult32(arg1: LongInt location 'd0';
+ arg2: LongInt location 'd1'): LongInt;
+SysCall MOS_UtilityBase 138;
+
+function UMult32(arg1: Cardinal location 'd0';
+ arg2: Cardinal location 'd1'): Cardinal;
+SysCall MOS_UtilityBase 144;
+
+function SDivMod32(dividend: LongInt location 'd0';
+ divisor: LongInt location 'd1'): LongInt;
+SysCall MOS_UtilityBase 150;
+
+function UDivMod32(dividend: Cardinal location 'd0';
+ divisor : Cardinal location 'd1'): Cardinal;
+SysCall MOS_UtilityBase 156;
+
+function Stricmp(string1: PChar location 'a0';
+ string2: PChar location 'a1'): LongInt;
+SysCall MOS_UtilityBase 162;
+
+function Strnicmp(string1: PChar location 'a0';
+ string2: PChar location 'a1';
+ length : LongInt location 'd0'): LongInt;
+SysCall MOS_UtilityBase 168;
+
+function ToUpper(character: Cardinal location 'd0'): Char;
+SysCall MOS_UtilityBase 174;
+
+function ToLower(character: Cardinal location 'd0'): Char;
+SysCall MOS_UtilityBase 180;
+
+procedure ApplyTagChanges(list : PTagItem location 'a0';
+ changeList: PTagItem location 'a1');
+SysCall MOS_UtilityBase 186;
+
+function SMult64(arg1: LongInt location 'd0';
+ arg2: LongInt location 'd1'): LongInt;
+SysCall MOS_UtilityBase 198;
+
+function UMult64(arg1: Cardinal location 'd0';
+ arg2: Cardinal location 'd1'): Cardinal;
+SysCall MOS_UtilityBase 204;
+
+function PackStructureTags(pack : Pointer location 'a0';
+ var packTable: Cardinal location 'a1';
+ tagList : PTagItem location 'a2'): Cardinal;
+SysCall MOS_UtilityBase 210;
+
+function UnpackStructureTags(pack : Pointer location 'a0';
+ var packTable: Cardinal location 'a1';
+ tagList : PTagItem location 'a2'): Cardinal;
+SysCall MOS_UtilityBase 216;
+
+function AddNamedObject(nameSpace: PNamedObject location 'a0';
+ nobject : PNamedObject location 'a1'): Boolean;
+SysCall MOS_UtilityBase 222;
+
+function AllocNamedObjectA(name : PChar location 'a0';
+ tagList: PTagItem location 'a1'): PNamedObject;
+SysCall MOS_UtilityBase 228;
+
+function AttemptRemNamedObject(nobject: PNamedObject location 'a0'): LongInt;
+SysCall MOS_UtilityBase 234;
+
+function FindNamedObject(nameSpace : PNamedObject location 'a0';
+ name : PChar location 'a1';
+ lastObject: PNamedObject location 'a2'): PNamedObject;
+SysCall MOS_UtilityBase 240;
+
+procedure FreeNamedObject(nobject: PNamedObject location 'a0');
+SysCall MOS_UtilityBase 246;
+
+function NamedObjectName(nobject: PNamedObject location 'a0'): PChar;
+SysCall MOS_UtilityBase 252;
+
+procedure ReleaseNamedObject(nobject: pNamedObject location 'a0');
+SysCall MOS_UtilityBase 258;
+
+procedure RemNamedObject(nobject: PNamedObject location 'a0';
+ message: PMessage location 'a1');
+SysCall MOS_UtilityBase 264;
+
+function GetUniqueID: Cardinal;
+SysCall MOS_UtilityBase 270;
+
+
+{
+ $Log: utilf.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/utility.pp b/rtl/morphos/utility.pp
new file mode 100644
index 0000000000..b56befb58f
--- /dev/null
+++ b/rtl/morphos/utility.pp
@@ -0,0 +1,45 @@
+{
+ $Id: utility.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Karoly Balogh for Genesi S.a.r.l. <www.genesi.lu>
+
+ utility.library interface unit for MorphOS/PowerPC
+
+ MorphOS port was done on a free Pegasos II/G4 machine
+ provided by Genesi S.a.r.l. <www.genesi.lu>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit utility;
+
+interface
+
+uses
+ exec;
+
+var
+ UtilityBase: Pointer;
+
+{$include utild1.inc}
+{$include utild2.inc}
+{$include utilf.inc}
+
+implementation
+
+begin
+ UtilityBase:=MOS_UtilityBase;
+end.
+
+{
+ $Log: utility.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/morphos/varutils.pp b/rtl/morphos/varutils.pp
new file mode 100644
index 0000000000..527b494c28
--- /dev/null
+++ b/rtl/morphos/varutils.pp
@@ -0,0 +1,47 @@
+{
+ $Id: varutils.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netbsd/Makefile b/rtl/netbsd/Makefile
new file mode 100644
index 0000000000..8dd21e4153
--- /dev/null
+++ b/rtl/netbsd/Makefile
@@ -0,0 +1,2029 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=netbsd
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+TARGETPROCINC=$(RTL)/netbsd/$(CPU_TARGET)
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT=
+PRT0=prt0
+else
+SYSTEMUNIT=sysbsd
+LINUXUNIT=
+override FPCOPT+=-dUNIX
+PRT0=prt0_10
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst mmx cpu
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+override INSTALL_FPCPACKAGE=y y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : errno.inc $(BSDINC)/bunxtype.inc ptypes.inc $(BSDINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc $(BSDINC)/bunxmain.inc $(BSDINC)/ostypes.inc \
+ $(BSDINC)/bunxfunc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/ossysch.inc $(BSDINC)/bunxmacr.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc \
+ unixsysc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+syscall$(PPUEXT) : $(UNIXINC)/syscall.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT)
diff --git a/rtl/netbsd/Makefile.fpc b/rtl/netbsd/Makefile.fpc
new file mode 100644
index 0000000000..ee078501b7
--- /dev/null
+++ b/rtl/netbsd/Makefile.fpc
@@ -0,0 +1,240 @@
+#
+# Makefile.fpc for Free Pascal NetBSD RTL
+#
+
+[package]
+main=rtl
+
+[install]
+fpcpackage=y
+
+[target]
+loaders=prt0 cprt0
+units=$(SYSTEMUNIT) objpas macpas strings syscall baseunix \
+ $(LINUXUNIT) unix initc systhrds \
+ dos crt objects printer matrix \
+ sysutils classes typinfo math varutils \
+ charset ucomplex getopts heaptrc lineinfo \
+ errors sockets gpm ipc terminfo \
+ video mouse keyboard serial variants types systhrds sysctl sysconst
+units_netbsd_i386=mmx cpu
+rsts=math varutils typinfo variants classes sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=netbsd
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+ unix \
+ dos crt objects printer \
+ sysutils typinfo math \
+ cpu mmx getopts heaptrc \
+ errors sockets ipc
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+TARGETPROCINC=$(RTL)/netbsd/$(CPU_TARGET)
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT=
+PRT0=prt0
+else
+SYSTEMUNIT=sysbsd
+LINUXUNIT=
+override FPCOPT+=-dUNIX
+PRT0=prt0_10
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+baseunix$(PPUEXT) : errno.inc $(BSDINC)/bunxtype.inc ptypes.inc $(BSDINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc $(BSDINC)/bunxmain.inc $(BSDINC)/ostypes.inc \
+ $(BSDINC)/bunxfunc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/ossysch.inc $(BSDINC)/bunxmacr.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc \
+ unixsysc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+
+syscall$(PPUEXT) : $(UNIXINC)/syscall.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT)
diff --git a/rtl/netbsd/classes.pp b/rtl/netbsd/classes.pp
new file mode 100644
index 0000000000..ae97e5fe82
--- /dev/null
+++ b/rtl/netbsd/classes.pp
@@ -0,0 +1,63 @@
+{
+ $Id: classes.pp,v 1.6 2005/04/17 17:33:40 hajny Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for FreeBSD
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ rtlconsts,
+ types,
+ typinfo;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+ baseunix,unix,Systhrds
+ ;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+
+{$ifndef ver1_0}
+ if ThreadsInited then
+ DoneThreads;
+{$endif}
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.6 2005/04/17 17:33:40 hajny
+ * more rtlconst/s fixes
+
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/errno.inc b/rtl/netbsd/errno.inc
new file mode 100644
index 0000000000..50eb556b2a
--- /dev/null
+++ b/rtl/netbsd/errno.inc
@@ -0,0 +1,144 @@
+{
+ $Id: errno.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+
+ Errno.inc : define all error numbers, kernel version 1.2.13
+
+}
+Const
+
+
+ ESysEPERM = 1; { Operation not permitted }
+ ESysENOENT = 2; { No such file or directory }
+ ESysESRCH = 3; { No such process }
+ ESysEINTR = 4; { Interrupted system call }
+ ESysEIO = 5; { Input/output error }
+ ESysENXIO = 6; { Device not configured }
+ ESysE2BIG = 7; { Argument list too long }
+ ESysENOEXEC = 8; { Exec format error }
+ ESysEBADF = 9; { Bad file descriptor }
+ ESysECHILD = 10; { No child processes }
+ ESysEDEADLK = 11; { Resource deadlock avoided }
+ { 11 was EAGAIN }
+ ESysENOMEM = 12; { Cannot allocate memory }
+ ESysEACCES = 13; { Permission denied }
+ ESysEFAULT = 14; { Bad address }
+ ESysENOTBLK = 15; { Block device required }
+ ESysEBUSY = 16; { Device busy }
+ ESysEEXIST = 17; { File exists }
+ ESysEXDEV = 18; { Cross-device link }
+ ESysENODEV = 19; { Operation not supported by device }
+ ESysENOTDIR = 20; { Not a directory }
+ ESysEISDIR = 21; { Is a directory }
+ ESysEINVAL = 22; { Invalid argument }
+ ESysENFILE = 23; { Too many open files in system }
+ ESysEMFILE = 24; { Too many open files }
+ ESysENOTTY = 25; { Inappropriate ioctl for device }
+ ESysETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+ ESysEFBIG = 27; { File too large }
+ ESysENOSPC = 28; { No space left on device }
+ ESysESPIPE = 29; { Illegal seek }
+ ESysEROFS = 30; { Read-only file system }
+ ESysEMLINK = 31; { Too many links }
+ ESysEPIPE = 32; { Broken pipe }
+
+{ math software }
+ ESysEDOM = 33; { Numerical argument out of domain }
+ ESysERANGE = 34; { Result too large }
+
+{ non-blocking and interrupt i/o }
+ ESysEAGAIN = 35; { Resource temporarily unavailable }
+ ESysEWOULDBLOCK = ESysEAGAIN; { Operation would block }
+ ESysEINPROGRESS = 36; { Operation now in progress }
+ ESysEALREADY = 37; { Operation already in progress }
+
+{ ipc/network software - - argument errors }
+ ESysENOTSOCK = 38; { Socket operation on non-socket }
+ ESysEDESTADDRREQ = 39; { Destination address required }
+ ESysEMSGSIZE = 40; { Message too long }
+ ESysEPROTOTYPE = 41; { Protocol wrong type for socket }
+ ESysENOPROTOOPT = 42; { Protocol not available }
+ ESysEPROTONOSUPPORT = 43; { Protocol not supported }
+ ESysESOCKTNOSUPPORT = 44; { Socket type not supported }
+ ESysEOPNOTSUPP = 45; { Operation not supported }
+ ESysENOTSUP = ESysEOPNOTSUPP; { Operation not supported }
+ ESysEPFNOSUPPORT = 46; { Protocol family not supported }
+ ESysEAFNOSUPPORT = 47; { Address family not supported by protocol family }
+ ESysEADDRINUSE = 48; { Address already in use }
+ ESysEADDRNOTAVAIL = 49; { Can't assign requested address }
+
+{ ipc/network software - - operational errors }
+ ESysENETDOWN = 50; { Network is down }
+ ESysENETUNREACH = 51; { Network is unreachable }
+ ESysENETRESET = 52; { Network dropped connection on reset }
+ ESysECONNABORTED = 53; { Software caused connection abort }
+ ESysECONNRESET = 54; { Connection reset by peer }
+ ESysENOBUFS = 55; { No buffer space available }
+ ESysEISCONN = 56; { Socket is already connected }
+ ESysENOTCONN = 57; { Socket is not connected }
+ ESysESHUTDOWN = 58; { Can't send after socket shutdown }
+ ESysETOOMANYREFS = 59; { Too many references: can't splice }
+ ESysETIMEDOUT = 60; { Operation timed out }
+ ESysECONNREFUSED = 61; { Connection refused }
+
+ ESysELOOP = 62; { Too many levels of symbolic links }
+ ESysENAMETOOLONG = 63; { File name too long }
+
+{ should be rearranged }
+ ESysEHOSTDOWN = 64; { Host is down }
+ ESysEHOSTUNREACH = 65; { No route to host }
+ ESysENOTEMPTY = 66; { Directory not empty }
+
+{ quotas & mush }
+ ESysEPROCLIM = 67; { Too many processes }
+ ESysEUSERS = 68; { Too many users }
+ ESysEDQUOT = 69; { Disc quota exceeded }
+
+{ Network File System }
+ ESysESTALE = 70; { Stale NFS file handle }
+ ESysEREMOTE = 71; { Too many levels of remote in path }
+ ESysEBADRPC = 72; { RPC struct is bad }
+ ESysERPCMISMATCH = 73; { RPC version wrong }
+ ESysEPROGUNAVAIL = 74; { RPC prog. not avail }
+ ESysEPROGMISMATCH = 75; { Program version wrong }
+ ESysEPROCUNAVAIL = 76; { Bad procedure for program }
+
+ ESysENOLCK = 77; { No locks available }
+ ESysENOSYS = 78; { Function not implemented }
+
+ ESysEFTYPE = 79; { Inappropriate file type or format }
+ ESysEAUTH = 80; { Authentication error }
+ ESysENEEDAUTH = 81; { Need authenticator }
+ ESysEIDRM = 82; { Identifier removed }
+ ESysENOMSG = 83; { No message of desired type }
+ ESysEOVERFLOW = 84; { Value too large to be stored in data type }
+ ESysECANCELED = 85; { Operation canceled }
+ ESysEILSEQ = 86; { Illegal byte sequence }
+ ESysELAST = 86; { Must be equal largest errno }
+
+
+
+{
+ $Log: errno.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/i386/cprt0.as b/rtl/netbsd/i386/cprt0.as
new file mode 100644
index 0000000000..8d0f7a958f
--- /dev/null
+++ b/rtl/netbsd/i386/cprt0.as
@@ -0,0 +1,438 @@
+#
+# $Id: cprt0.as,v 1.2 2004/01/04 01:13:23 marco Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Marco van de Voort, Michael Van Canneyt
+# and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# NetBSD standard (shared) ELF/i386 startup code for Free Pascal
+#
+
+ .file "crt0.c"
+ .version "01.01"
+gcc2_compiled.:
+.globl __progname
+.section .rodata
+.LC0:
+ .ascii "\0"
+.data
+ .align 4
+ .type __progname,@object
+ .size __progname,4
+__progname:
+ .long .LC0
+.globl __ps_strings
+ .align 4
+ .type __ps_strings,@object
+ .size __ps_strings,4
+__ps_strings:
+ .long 0
+ .align 4
+___fpucw:
+ .long 0x1332
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+#APP
+ .weak _DYNAMIC
+
+ .text
+ .align 4
+ .globl __start
+ .globl _start
+_start:
+__start:
+ pushl %ebx # ps_strings
+ pushl %ecx # obj
+ pushl %edx # cleanup
+ movl 12(%esp),%eax
+ leal 20(%esp,%eax,4),%ecx
+ leal 16(%esp),%edx
+ pushl %ecx
+ pushl %edx
+ pushl %eax
+ movl %eax,U_SYSTEM_ARGC
+ movl %edx,U_SYSTEM_ARGV
+ call ___start
+
+#NO_APP
+.text
+ .align 4
+.globl ___start
+ .type ___start,@function
+___start:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %edi
+ pushl %esi
+ pushl %ebx
+ call .L12
+.L12:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L12],%ebx
+ movl 12(%ebp),%esi
+ movl 16(%ebp),%edx
+ movl 28(%ebp),%edi
+ movl environ@GOT(%ebx),%eax
+ movl %edx,(%eax)
+ movl %edx,U_SYSTEM_ENVP
+ movl __progname@GOT(%ebx),%edx
+ movl (%esi),%eax
+ movl %eax,(%edx)
+ testl %eax,%eax
+ je .L6
+ pushl $47
+ movl __progname@GOT(%ebx),%eax
+ pushl (%eax)
+ call _strrchr@PLT
+ movl %eax,%edx
+ movl __progname@GOT(%ebx),%eax
+ movl %edx,(%eax)
+ addl $8,%esp
+ testl %edx,%edx
+ jne .L7
+ movl __progname@GOT(%ebx),%edx
+ movl (%esi),%eax
+ movl %eax,(%edx)
+ jmp .L6
+ .align 4
+.L7:
+ movl __progname@GOT(%ebx),%eax
+ incl %edx
+ movl %edx,(%eax)
+.L6:
+ testl %edi,%edi
+ je .L9
+ movl __ps_strings@GOT(%ebx),%eax
+ movl %edi,(%eax)
+.L9:
+ cmpl $0,_DYNAMIC@GOT(%ebx)
+ je .L10
+ pushl 24(%ebp)
+ pushl 20(%ebp)
+ call _rtld_setup@PLT
+ addl $8,%esp
+.L10:
+ pushl _fini@GOT(%ebx)
+ call atexit@PLT
+ call _init@PLT
+# movl environ@GOT(%ebx),%eax
+# pushl (%eax)
+# pushl %esi
+# pushl 8(%ebp)
+# call main@PLT
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+// xorl %ebp,%ebp /* Detect main from nested */
+ /* procs/unwinding? */
+ pushl (%eax)
+ pushl (%esi)
+ pushl 8(%ebp)
+ call main
+ pushl %eax
+ pushl %eax
+ call exit@PLT
+
+.p2align 2,0x90
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl U_SYSTEM_EXITCODE,%ebx
+ pushl %ebx
+ call _actualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+_actualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+
+
+.Lfe1:
+ .size ___start,.Lfe1-___start
+ .align 4
+ .type _strrchr,@function
+_strrchr:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $4,%esp
+ pushl %esi
+ movl 8(%ebp),%eax
+ movb 12(%ebp),%cl
+ movb %cl,-1(%ebp)
+ xorl %esi,%esi
+ .align 4
+.L14:
+ movb (%eax),%dl
+ cmpb -1(%ebp),%dl
+ jne .L17
+ movl %eax,%esi
+.L17:
+ testb %dl,%dl
+ je .L16
+ incl %eax
+ jmp .L14
+ .align 4
+.L16:
+ movl %esi,%eax
+ movl -8(%ebp),%esi
+ leave
+ ret
+.Lfe2:
+ .size _strrchr,.Lfe2-_strrchr
+.section .rodata
+ .align 32
+.LC1:
+ .ascii "Corrupt Obj_Entry pointer in GOT\0"
+ .align 32
+.LC2:
+ .ascii "Dynamic linker version mismatch\0"
+.text
+ .align 4
+.globl _rtld_setup
+ .type _rtld_setup,@function
+_rtld_setup:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %esi
+ pushl %ebx
+ call .L35
+.L35:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L35],%ebx
+ movl 12(%ebp),%esi
+ testl %esi,%esi
+ je .L22
+ cmpl $-716130182,(%esi)
+ je .L21
+.L22:
+ pushl $33
+ leal .LC1@GOTOFF(%ebx),%eax
+ pushl %eax
+ pushl $2
+ pushl $4
+ call __syscall@PLT
+ pushl $1
+ pushl $1
+ call __syscall@PLT
+ addl $24,%esp
+ .align 4
+.L21:
+ cmpl $1,4(%esi)
+ je .L28
+ pushl $32
+ leal .LC2@GOTOFF(%ebx),%eax
+ pushl %eax
+ pushl $2
+ pushl $4
+ call __syscall@PLT
+ pushl $1
+ pushl $1
+ call __syscall@PLT
+ addl $24,%esp
+ .align 4
+.L28:
+ pushl 8(%ebp)
+ call atexit@PLT
+ leal -8(%ebp),%esp
+ popl %ebx
+ popl %esi
+ leave
+ ret
+.Lfe3:
+ .size _rtld_setup,.Lfe3-_rtld_setup
+#APP
+ .weak dlopen ; dlopen = _dlopen
+ .weak dlclose ; dlclose = _dlclose
+ .weak dlsym ; dlsym = _dlsym
+ .weak dlerror ; dlerror = _dlerror
+ .weak dladdr ; dladdr = _dladdr
+#NO_APP
+ .align 4
+.globl _dlopen
+ .type _dlopen,@function
+_dlopen:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ call .L40
+.L40:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L40],%ebx
+ movl __mainprog_obj@GOT(%ebx),%eax
+ movl (%eax),%eax
+ testl %eax,%eax
+ je .L37
+ pushl 12(%ebp)
+ pushl 8(%ebp)
+ movl 80(%eax),%eax
+ call *%eax
+ jmp .L38
+ .align 4
+.L37:
+ xorl %eax,%eax
+.L38:
+ movl -4(%ebp),%ebx
+ leave
+ ret
+.Lfe4:
+ .size _dlopen,.Lfe4-_dlopen
+ .align 4
+.globl _dlclose
+ .type _dlclose,@function
+_dlclose:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ call .L45
+.L45:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L45],%ebx
+ movl __mainprog_obj@GOT(%ebx),%eax
+ movl (%eax),%eax
+ testl %eax,%eax
+ je .L42
+ pushl 8(%ebp)
+ movl 92(%eax),%eax
+ call *%eax
+ jmp .L43
+ .align 4
+.L42:
+ movl $-1,%eax
+.L43:
+ movl -4(%ebp),%ebx
+ leave
+ ret
+.Lfe5:
+ .size _dlclose,.Lfe5-_dlclose
+ .align 4
+.globl _dlsym
+ .type _dlsym,@function
+_dlsym:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ call .L50
+.L50:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L50],%ebx
+ movl __mainprog_obj@GOT(%ebx),%eax
+ movl (%eax),%eax
+ testl %eax,%eax
+ je .L47
+ pushl 12(%ebp)
+ pushl 8(%ebp)
+ movl 84(%eax),%eax
+ call *%eax
+ jmp .L48
+ .align 4
+.L47:
+ xorl %eax,%eax
+.L48:
+ movl -4(%ebp),%ebx
+ leave
+ ret
+.Lfe6:
+ .size _dlsym,.Lfe6-_dlsym
+.section .rodata
+ .align 32
+.LC3:
+ .ascii "Dynamic linker interface not available\0"
+.text
+ .align 4
+.globl _dlerror
+ .type _dlerror,@function
+_dlerror:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ call .L55
+.L55:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L55],%ebx
+ movl __mainprog_obj@GOT(%ebx),%eax
+ movl (%eax),%eax
+ testl %eax,%eax
+ je .L52
+ movl 88(%eax),%eax
+ call *%eax
+ jmp .L53
+ .align 4
+.L52:
+ leal .LC3@GOTOFF(%ebx),%eax
+.L53:
+ movl -4(%ebp),%ebx
+ leave
+ ret
+.Lfe7:
+ .size _dlerror,.Lfe7-_dlerror
+ .align 4
+.globl _dladdr
+ .type _dladdr,@function
+_dladdr:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ call .L60
+.L60:
+ popl %ebx
+ addl $_GLOBAL_OFFSET_TABLE_+[.-.L60],%ebx
+ movl __mainprog_obj@GOT(%ebx),%eax
+ movl (%eax),%eax
+ testl %eax,%eax
+ je .L57
+ pushl 12(%ebp)
+ pushl 8(%ebp)
+ movl 96(%eax),%eax
+ call *%eax
+ jmp .L58
+ .align 4
+.L57:
+ movl $-1,%eax
+.L58:
+ movl -4(%ebp),%ebx
+ leave
+ ret
+.Lfe8:
+ .size _dladdr,.Lfe8-_dladdr
+ .comm environ,4,4
+ .comm __mainprog_obj,4,4
+
+
+
+# This section is needed for NetBSD to recognize a NetBSD binary as such.
+# otherwise it will be startup in Linux emulation mode.
+
+.section ".note.netbsd.ident","a"
+.p2align 2
+
+.long 7
+.long 4
+# ELF NOTE TYPE NETBSD TAG
+.long 1
+.ascii "NetBSD\0\0"
+.long 199905
diff --git a/rtl/netbsd/i386/prt0.as b/rtl/netbsd/i386/prt0.as
new file mode 100644
index 0000000000..e3c943774b
--- /dev/null
+++ b/rtl/netbsd/i386/prt0.as
@@ -0,0 +1,204 @@
+#
+# $Id: prt0.as,v 1.2 2004/01/04 01:13:23 marco Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Marco van de Voort, Michael Van Canneyt
+# and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# NetBSD standard (static) ELF/i386 startup code for Free Pascal
+#
+
+
+ .file "prt0.s"
+ .version "01.01"
+gcc2_compiled.:
+.globl __progname
+
+.section .rodata
+.LC0:
+ .ascii "\0"
+.data
+ .align 4
+ .type __progname,@object
+ .size __progname,4
+__progname:
+ .long .LC0
+.globl __ps_strings
+ .align 4
+ .type __ps_strings,@object
+ .size __ps_strings,4
+__ps_strings:
+ .long 0
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+#APP
+
+ .text
+ .align 4
+ .globl __start
+ .globl _start
+_start:
+__start:
+ pushl %ebx # ps_strings
+ pushl %ecx # obj
+ pushl %edx # cleanup
+ movl 12(%esp),%eax
+ leal 20(%esp,%eax,4),%ecx
+ leal 16(%esp),%edx
+ pushl %ecx
+ pushl %edx
+ pushl %eax
+ call ___start
+
+#NO_APP
+.text
+ .align 4
+.globl ___start
+ .type ___start,@function
+___start:
+ pushl %ebp
+ movl %esp,%ebp
+ movl 16(%ebp),%eax
+ movl %eax,environ
+ movl %eax,U_SYSTEM_ENVP
+ movl 8(%ebp),%eax
+ movl %eax,U_SYSTEM_ARGC
+ movl 12(%ebp),%eax
+ movl %eax,U_SYSTEM_ARGV
+ movl (%eax),%edx
+ movl %edx,__progname
+ testl %edx,%edx
+ je .L2
+ pushl $47
+ movl __progname,%eax
+ pushl %eax
+ call _strrchr
+ addl $8,%esp
+ movl %eax,%eax
+ movl %eax,__progname
+ cmpl $0,__progname
+ jne .L3
+ movl 12(%ebp),%eax
+ movl (%eax),%edx
+ movl %edx,__progname
+ jmp .L2
+ .align 4
+.L3:
+ incl __progname
+.L4:
+.L2:
+ cmpl $0,28(%ebp)
+ je .L5
+ movl 28(%ebp),%eax
+ movl %eax,__ps_strings
+.L5:
+# pushl $_fini
+# call atexit
+# addl $4,%esp
+# call _init
+# copied from linux
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+ xorl %ebp,%ebp
+
+ call _main
+ pushl %eax
+ jmp _haltproc
+
+.p2align 2,0x90
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl U_SYSTEM_EXITCODE,%ebx
+ pushl %ebx
+ call _actualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+_actualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+
+.Lfe1:
+ .size ___start,.Lfe1-___start
+ .align 4
+ .type _strrchr,@function
+_strrchr:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $8,%esp
+ movl 12(%ebp),%eax
+ movb %al,-1(%ebp)
+ movl $0,-8(%ebp)
+ .align 4
+.L7:
+ movl 8(%ebp),%eax
+ movb (%eax),%dl
+ cmpb -1(%ebp),%dl
+ jne .L10
+ movl 8(%ebp),%eax
+ movl %eax,-8(%ebp)
+.L10:
+ movl 8(%ebp),%eax
+ cmpb $0,(%eax)
+ jne .L9
+ movl -8(%ebp),%edx
+ movl %edx,%eax
+ jmp .L6
+ .align 4
+.L11:
+.L9:
+ incl 8(%ebp)
+ jmp .L7
+ .align 4
+.L8:
+.L6:
+ leave
+ ret
+
+
+.Lfe2:
+ .size _strrchr,.Lfe2-_strrchr
+ .comm environ,4,4
+
+# This section is needed for NetBSD to recognize a NetBSD binary as such.
+# otherwise it will be startup in Linux emulation mode.
+
+.section ".note.netbsd.ident","a"
+.p2align 2
+
+.long 7
+.long 4
+# ELF NOTE TYPE NETBSD TAG
+.long 1
+.ascii "NetBSD\0\0"
+.long 199905
diff --git a/rtl/netbsd/i386/prt0_10.as b/rtl/netbsd/i386/prt0_10.as
new file mode 100644
index 0000000000..bc813232a9
--- /dev/null
+++ b/rtl/netbsd/i386/prt0_10.as
@@ -0,0 +1,204 @@
+#
+# $Id: prt0_10.as,v 1.1 2004/01/04 01:13:23 marco Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Marco van de Voort, Michael Van Canneyt
+# and Peter Vreman
+# members of the Free Pascal development team.
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY;without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************}
+#
+# NetBSD standard (static) ELF/i386 startup code for Free Pascal
+#
+
+
+ .file "prt0.s"
+ .version "01.01"
+gcc2_compiled.:
+.globl __progname
+
+.section .rodata
+.LC0:
+ .ascii "\0"
+.data
+ .align 4
+ .type __progname,@object
+ .size __progname,4
+__progname:
+ .long .LC0
+.globl __ps_strings
+ .align 4
+ .type __ps_strings,@object
+ .size __ps_strings,4
+__ps_strings:
+ .long 0
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+#APP
+
+ .text
+ .align 4
+ .globl __start
+ .globl _start
+_start:
+__start:
+ pushl %ebx # ps_strings
+ pushl %ecx # obj
+ pushl %edx # cleanup
+ movl 12(%esp),%eax
+ leal 20(%esp,%eax,4),%ecx
+ leal 16(%esp),%edx
+ pushl %ecx
+ pushl %edx
+ pushl %eax
+ call ___start
+
+#NO_APP
+.text
+ .align 4
+.globl ___start
+ .type ___start,@function
+___start:
+ pushl %ebp
+ movl %esp,%ebp
+ movl 16(%ebp),%eax
+ movl %eax,environ
+ movl %eax,U_SYSBSD_ENVP
+ movl 8(%ebp),%eax
+ movl %eax,U_SYSBSD_ARGC
+ movl 12(%ebp),%eax
+ movl %eax,U_SYSBSD_ARGV
+ movl (%eax),%edx
+ movl %edx,__progname
+ testl %edx,%edx
+ je .L2
+ pushl $47
+ movl __progname,%eax
+ pushl %eax
+ call _strrchr
+ addl $8,%esp
+ movl %eax,%eax
+ movl %eax,__progname
+ cmpl $0,__progname
+ jne .L3
+ movl 12(%ebp),%eax
+ movl (%eax),%edx
+ movl %edx,__progname
+ jmp .L2
+ .align 4
+.L3:
+ incl __progname
+.L4:
+.L2:
+ cmpl $0,28(%ebp)
+ je .L5
+ movl 28(%ebp),%eax
+ movl %eax,__ps_strings
+.L5:
+# pushl $_fini
+# call atexit
+# addl $4,%esp
+# call _init
+# copied from linux
+
+ finit /* initialize fpu */
+ fwait
+ fldcw ___fpucw
+
+ xorl %ebp,%ebp
+
+ call main
+ pushl %eax
+ jmp _haltproc
+
+.p2align 2,0x90
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl U_SYSBSD_EXITCODE,%ebx
+ pushl %ebx
+ call _actualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+_actualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+
+.Lfe1:
+ .size ___start,.Lfe1-___start
+ .align 4
+ .type _strrchr,@function
+_strrchr:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $8,%esp
+ movl 12(%ebp),%eax
+ movb %al,-1(%ebp)
+ movl $0,-8(%ebp)
+ .align 4
+.L7:
+ movl 8(%ebp),%eax
+ movb (%eax),%dl
+ cmpb -1(%ebp),%dl
+ jne .L10
+ movl 8(%ebp),%eax
+ movl %eax,-8(%ebp)
+.L10:
+ movl 8(%ebp),%eax
+ cmpb $0,(%eax)
+ jne .L9
+ movl -8(%ebp),%edx
+ movl %edx,%eax
+ jmp .L6
+ .align 4
+.L11:
+.L9:
+ incl 8(%ebp)
+ jmp .L7
+ .align 4
+.L8:
+.L6:
+ leave
+ ret
+
+
+.Lfe2:
+ .size _strrchr,.Lfe2-_strrchr
+ .comm environ,4,4
+
+# This section is needed for NetBSD to recognize a NetBSD binary as such.
+# otherwise it will be startup in Linux emulation mode.
+
+.section ".note.netbsd.ident","a"
+.p2align 2
+
+.long 7
+.long 4
+# ELF NOTE TYPE NETBSD TAG
+.long 1
+.ascii "NetBSD\0\0"
+.long 199905
diff --git a/rtl/netbsd/i386/sighnd.inc b/rtl/netbsd/i386/sighnd.inc
new file mode 100644
index 0000000000..467bc314cf
--- /dev/null
+++ b/rtl/netbsd/i386/sighnd.inc
@@ -0,0 +1,86 @@
+{
+ $Id: sighnd.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Signalhandler for FreeBSD/i386
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+CONST FPU_ALL=$7F;
+
+function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
+begin
+ getfpustate:=0;
+end;
+procedure SignalToRunerror(Sig: longint;code:longint; var SigContext: SigContextRec); cdecl;
+
+var
+ res,fpustate : word;
+begin
+ res:=0;
+{$ifdef BSD}
+{$ifdef cpui386}
+ fpustate:=0;
+ asm
+ fnstsw fpustate
+ end;
+{$endif cpui386}
+{$endif BSD}
+ case sig of
+ SIGFPE :
+ begin
+ { this is not allways necessary but I don't know yet
+ how to tell if it is or not PM }
+ res:=200;
+ fpustate:=GetFPUState(SigContext);
+
+ if (FpuState and FPU_All) <> 0 then
+ begin
+ { first check the more precise options }
+ if (FpuState and FPU_DivisionByZero)<>0 then
+ res:=200
+ else if (FpuState and FPU_Overflow)<>0 then
+ res:=205
+ else if (FpuState and FPU_Underflow)<>0 then
+ res:=206
+ else if (FpuState and FPU_Denormal)<>0 then
+ res:=216
+ else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
+ res:=207
+ else if (FpuState and FPU_Invalid)<>0 then
+ res:=216
+ else
+ res:=207; {'Coprocessor Error'}
+ end;
+ SysResetFPU;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ reenable_signal(sig);
+{ give runtime error at the position where the signal was raised }
+ if res<>0 then
+ begin
+{$ifdef cpui386}
+ HandleErrorAddrFrame(res,pointer(SigContext.sc_eip),pointer(SigContext.sc_ebp));
+{$endif}
+ end;
+end;
+
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/powerpc/cprt0.as b/rtl/netbsd/powerpc/cprt0.as
new file mode 100644
index 0000000000..ca1e5ab8cc
--- /dev/null
+++ b/rtl/netbsd/powerpc/cprt0.as
@@ -0,0 +1,443 @@
+ .file "crt0.c"
+gcc2_compiled.:
+ .globl __progname
+ .section ".data" # .rodata
+ .align 2
+.LC0:
+ .string ""
+ .section ".sdata","aw"
+ .align 2
+ .type __progname,@object
+ .size __progname,4
+__progname:
+.LCP0:
+ .long (.LC0)@fixup
+ .section ".fixup","aw"
+ .align 2
+ .long .LCP0
+ .previous
+ .globl __ps_strings
+ .align 2
+ .type __ps_strings,@object
+ .size __ps_strings,4
+__ps_strings:
+ .long 0
+ .weak _DYNAMIC
+ .weak _SDA_BASE_
+ .weak _SDA2_BASE_
+ .section ".got2","aw"
+.LCTOC1 = .+32768
+.LC1 = .-.LCTOC1
+ .long __progname
+.LC2 = .-.LCTOC1
+ .long environ
+.LC3 = .-.LCTOC1
+ .long __ps_strings
+.LC4 = .-.LCTOC1
+ .long _DYNAMIC
+.LC5 = .-.LCTOC1
+ .long _fini
+ .section ".text"
+ .align 2
+ .globl _start
+.LCL0:
+ .long .LCTOC1-.LCF0
+ .type _start,@function
+_start:
+ stwu 1,-48(1)
+ mflr 0
+ stw 24,16(1)
+ stw 25,20(1)
+ stw 26,24(1)
+ stw 27,28(1)
+ stw 28,32(1)
+ stw 29,36(1)
+ stw 30,40(1)
+ stw 31,44(1)
+ stw 0,52(1)
+ bl .LCF0
+.LCF0:
+ mflr 30
+ lwz 0,(.LCL0-.LCF0)(30)
+ add 30,0,30
+ mr 27,4
+ mr 24,3
+ mr 28,5
+ mr 25,6
+ mr 26,7
+ mr 29,8
+ lis %r13,_SDA_BASE_@ha;addi %r13,%r13,_SDA_BASE_@l;lis %r2,_SDA2_BASE_@ha;addi %r2,%r2,_SDA2_BASE_@l
+ lwz 31,0(27)
+ cmpwi 0,31,0
+ bc 12,2,.L7
+ mr 3,31
+ li 4,47
+ bl _strrchr@local
+ lwz 9,.LC1(30)
+ cmpwi 0,3,0
+ stw 3,0(9)
+ bc 4,2,.L8
+ stw 31,0(9)
+ b .L12
+.L8:
+ addi 0,3,1
+ stw 0,0(9)
+.L12:
+.L7:
+ lwz 31,.LC2(30)
+ cmpwi 0,29,0
+ stw 28,0(31)
+ bc 12,2,.L10
+ lwz 9,.LC3(30)
+ stw 29,0(9)
+.L10:
+ lwz 0,.LC4(30)
+ cmpwi 0,0,0
+ bc 12,2,.L11
+ mr 3,26
+ mr 4,25
+ bl _rtld_setup@plt
+.L11:
+ lwz 3,.LC5(30)
+ bl atexit@plt
+ bl _init@plt
+ lwz 5,0(31)
+ mr 3,24
+ mr 4,27
+
+ lis 11,U_SYSTEM_ARGC@ha
+ stw 3,U_SYSTEM_ARGC@l(11);
+ lis 11,U_SYSTEM_ARGV@ha
+ stw 4,U_SYSTEM_ARGV@l(11);
+
+ lis 11,U_SYSTEM_ENVP@ha
+ stw 5,U_SYSTEM_ENVP@l(11);
+ mtlr 0
+ bl main@plt
+
+_haltproc:
+ lis 3,U_SYSTEM_EXITCODE@h
+ stw 3,U_SYSTEM_EXITCODE@l(3)
+ bl exit@plt
+.Lfe1:
+ .size _start,.Lfe1-_start
+ .section .ident ; .asciz "$NetBSD: crt0.c,v 1.22 2002/05/09 20:32:59 matt Exp $" ; .text
+ .align 2
+ .type _strrchr,@function
+_strrchr:
+ rlwinm 4,4,0,0xff
+ li 10,0
+.L14:
+ lbz 0,0(3)
+ xor 9,0,4
+ neg 9,9
+ srawi 9,9,31
+ andc 11,3,9
+ cmpwi 0,0,0
+ and 9,10,9
+ or 10,9,11
+ addi 3,3,1
+ bc 4,2,.L14
+ mr 3,10
+ blr
+.Lfe2:
+ .size _strrchr,.Lfe2-_strrchr
+ .section ".data" # .rodata
+ .align 2
+.LC6:
+ .string "Corrupt Obj_Entry pointer in GOT\n"
+ .align 2
+.LC8:
+ .string "Dynamic linker version mismatch\n"
+ .section ".got2","aw"
+.LC7 = .-.LCTOC1
+ .long .LC6
+.LC9 = .-.LCTOC1
+ .long .LC8
+ .section ".text"
+ .align 2
+ .globl _rtld_setup
+.LCL1:
+ .long .LCTOC1-.LCF1
+ .type _rtld_setup,@function
+_rtld_setup:
+ stwu 1,-32(1)
+ mflr 0
+ stw 29,20(1)
+ stw 30,24(1)
+ stw 31,28(1)
+ stw 0,36(1)
+ bl .LCF1
+.LCF1:
+ mflr 30
+ lwz 0,(.LCL1-.LCF1)(30)
+ add 30,0,30
+ mr. 31,4
+ mr 29,3
+ bc 12,2,.L22
+ lwz 9,0(31)
+ lis 0,0xd550
+ ori 0,0,47226
+ cmpw 0,9,0
+ bc 12,2,.L21
+.L22:
+ lwz 6,.LC7(30)
+ li 3,0
+ li 4,4
+ li 5,2
+ li 7,33
+ crxor 6,6,6
+ bl __syscall@plt
+ li 3,0
+ li 4,1
+ li 5,1
+ crxor 6,6,6
+ bl __syscall@plt
+.L21:
+ lwz 0,4(31)
+ cmpwi 0,0,1
+ bc 12,2,.L27
+ lwz 6,.LC9(30)
+ li 3,0
+ li 4,4
+ li 5,2
+ li 7,32
+ crxor 6,6,6
+ bl __syscall@plt
+ li 3,0
+ li 4,1
+ li 5,1
+ crxor 6,6,6
+ bl __syscall@plt
+.L27:
+ mr 3,29
+ bl atexit@plt
+ lwz 0,36(1)
+ mtlr 0
+ lwz 29,20(1)
+ lwz 30,24(1)
+ lwz 31,28(1)
+ la 1,32(1)
+ blr
+.Lfe3:
+ .size _rtld_setup,.Lfe3-_rtld_setup
+ .weak dlopen ; dlopen = _dlopen
+ .weak dlclose ; dlclose = _dlclose
+ .weak dlsym ; dlsym = _dlsym
+ .weak dlerror ; dlerror = _dlerror
+ .weak dladdr ; dladdr = _dladdr
+ .section ".got2","aw"
+.LC10 = .-.LCTOC1
+ .long __mainprog_obj
+ .section ".text"
+ .align 2
+ .globl _dlopen
+.LCL2:
+ .long .LCTOC1-.LCF2
+ .type _dlopen,@function
+_dlopen:
+ stwu 1,-16(1)
+ mflr 0
+ stw 30,8(1)
+ stw 31,12(1)
+ stw 0,20(1)
+ bl .LCF2
+.LCF2:
+ mflr 30
+ lwz 0,(.LCL2-.LCF2)(30)
+ add 30,0,30
+ lwz 9,.LC10(30)
+ lwz 9,0(9)
+ cmpwi 0,9,0
+ bc 12,2,.L33
+ lwz 0,140(9)
+ mtlr 0
+ blrl
+ b .L34
+.L33:
+ li 3,0
+.L34:
+ lwz 0,20(1)
+ mtlr 0
+ lwz 30,8(1)
+ lwz 31,12(1)
+ la 1,16(1)
+ blr
+.Lfe4:
+ .size _dlopen,.Lfe4-_dlopen
+ .section ".got2","aw"
+.LC11 = .-.LCTOC1
+ .long __mainprog_obj
+ .section ".text"
+ .align 2
+ .globl _dlclose
+.LCL3:
+ .long .LCTOC1-.LCF3
+ .type _dlclose,@function
+_dlclose:
+ stwu 1,-16(1)
+ mflr 0
+ stw 30,8(1)
+ stw 31,12(1)
+ stw 0,20(1)
+ bl .LCF3
+.LCF3:
+ mflr 30
+ lwz 0,(.LCL3-.LCF3)(30)
+ add 30,0,30
+ lwz 9,.LC11(30)
+ lwz 9,0(9)
+ cmpwi 0,9,0
+ bc 12,2,.L36
+ lwz 0,152(9)
+ mtlr 0
+ blrl
+ b .L37
+.L36:
+ li 3,-1
+.L37:
+ lwz 0,20(1)
+ mtlr 0
+ lwz 30,8(1)
+ lwz 31,12(1)
+ la 1,16(1)
+ blr
+.Lfe5:
+ .size _dlclose,.Lfe5-_dlclose
+ .section ".got2","aw"
+.LC12 = .-.LCTOC1
+ .long __mainprog_obj
+ .section ".text"
+ .align 2
+ .globl _dlsym
+.LCL4:
+ .long .LCTOC1-.LCF4
+ .type _dlsym,@function
+_dlsym:
+ stwu 1,-16(1)
+ mflr 0
+ stw 30,8(1)
+ stw 31,12(1)
+ stw 0,20(1)
+ bl .LCF4
+.LCF4:
+ mflr 30
+ lwz 0,(.LCL4-.LCF4)(30)
+ add 30,0,30
+ lwz 9,.LC12(30)
+ lwz 9,0(9)
+ cmpwi 0,9,0
+ bc 12,2,.L39
+ lwz 0,144(9)
+ mtlr 0
+ blrl
+ b .L40
+.L39:
+ li 3,0
+.L40:
+ lwz 0,20(1)
+ mtlr 0
+ lwz 30,8(1)
+ lwz 31,12(1)
+ la 1,16(1)
+ blr
+.Lfe6:
+ .size _dlsym,.Lfe6-_dlsym
+ .section ".data" # .rodata
+ .align 2
+.LC14:
+ .string "Dynamic linker interface not available"
+ .section ".got2","aw"
+.LC13 = .-.LCTOC1
+ .long __mainprog_obj
+.LC15 = .-.LCTOC1
+ .long .LC14
+ .section ".text"
+ .align 2
+ .globl _dlerror
+.LCL5:
+ .long .LCTOC1-.LCF5
+ .type _dlerror,@function
+_dlerror:
+ stwu 1,-16(1)
+ mflr 0
+ stw 30,8(1)
+ stw 31,12(1)
+ stw 0,20(1)
+ bl .LCF5
+.LCF5:
+ mflr 30
+ lwz 0,(.LCL5-.LCF5)(30)
+ add 30,0,30
+ lwz 9,.LC13(30)
+ lwz 9,0(9)
+ cmpwi 0,9,0
+ bc 12,2,.L42
+ lwz 0,148(9)
+ mtlr 0
+ blrl
+ b .L43
+.L42:
+ lwz 3,.LC15(30)
+.L43:
+ lwz 0,20(1)
+ mtlr 0
+ lwz 30,8(1)
+ lwz 31,12(1)
+ la 1,16(1)
+ blr
+.Lfe7:
+ .size _dlerror,.Lfe7-_dlerror
+ .section ".got2","aw"
+.LC16 = .-.LCTOC1
+ .long __mainprog_obj
+ .section ".text"
+ .align 2
+ .globl _dladdr
+.LCL6:
+ .long .LCTOC1-.LCF6
+ .type _dladdr,@function
+_dladdr:
+ stwu 1,-16(1)
+ mflr 0
+ stw 30,8(1)
+ stw 31,12(1)
+ stw 0,20(1)
+ bl .LCF6
+.LCF6:
+ mflr 30
+ lwz 0,(.LCL6-.LCF6)(30)
+ add 30,0,30
+ lwz 9,.LC16(30)
+ lwz 9,0(9)
+ cmpwi 0,9,0
+ bc 12,2,.L45
+ lwz 0,156(9)
+ mtlr 0
+ blrl
+ b .L46
+.L45:
+ li 3,-1
+.L46:
+ lwz 0,20(1)
+ mtlr 0
+ lwz 30,8(1)
+ lwz 31,12(1)
+ la 1,16(1)
+ blr
+
+.Lfe8:
+ .size _dladdr,.Lfe8-_dladdr
+ .comm environ,4,4
+ .comm __mainprog_obj,4,4
+ .ident "GCC: (GNU) 2.95.3 20010315 (release) (NetBSD nb3)"
+
+ .section ".data"
+ .globl __data_start
+__data_start:
+data_start:
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
diff --git a/rtl/netbsd/powerpc/prt0.as b/rtl/netbsd/powerpc/prt0.as
new file mode 100644
index 0000000000..616286d539
--- /dev/null
+++ b/rtl/netbsd/powerpc/prt0.as
@@ -0,0 +1,164 @@
+ .file "crt0.c"
+gcc2_compiled.:
+ .globl __progname
+ .section ".data" # .rodata
+ .align 2
+.LC0:
+ .string ""
+ .section ".sdata","aw"
+ .align 2
+ .type __progname,@object
+ .size __progname,4
+__progname:
+.LCP0:
+ .long (.LC0)@fixup
+ .section ".fixup","aw"
+ .align 2
+ .long .LCP0
+ .previous
+ .globl __ps_strings
+ .align 2
+ .type __ps_strings,@object
+ .size __ps_strings,4
+__ps_strings:
+ .long 0
+ .weak _DYNAMIC
+ .weak _SDA_BASE_
+ .weak _SDA2_BASE_
+ .section ".got2","aw"
+.LCTOC1 = .+32768
+.LC1 = .-.LCTOC1
+ .long __progname
+.LC2 = .-.LCTOC1
+ .long environ
+.LC3 = .-.LCTOC1
+ .long __ps_strings
+.LC4 = .-.LCTOC1
+ .long _DYNAMIC
+.LC5 = .-.LCTOC1
+ .section ".text"
+ .align 2
+ .globl _start
+.LCL0:
+ .long .LCTOC1-.LCF0
+ .type _start,@function
+_start:
+ stwu 1,-48(1)
+ mflr 0
+ stw 24,16(1)
+ stw 25,20(1)
+ stw 26,24(1)
+ stw 27,28(1)
+ stw 28,32(1)
+ stw 29,36(1)
+ stw 30,40(1)
+ stw 31,44(1)
+ stw 0,52(1)
+ bl .LCF0
+.LCF0:
+ mflr 30
+ lwz 0,(.LCL0-.LCF0)(30)
+ add 30,0,30
+ mr 27,4
+ mr 24,3
+ mr 28,5
+ mr 25,6
+ mr 26,7
+ mr 29,8
+# lis %r13,_SDA_BASE_@ha;addi %r13,%r13,_SDA_BASE_@l;lis %r2,_SDA2_BASE_@ha;addi %r2,%r2,_SDA2_BASE_@l
+ lwz 31,0(27)
+ cmpwi 0,31,0
+ bc 12,2,.L7
+ mr 3,31
+ li 4,47
+ bl _strrchr@local
+ lwz 9,.LC1(30)
+ cmpwi 0,3,0
+ stw 3,0(9)
+ bc 4,2,.L8
+ stw 31,0(9)
+ b .L12
+.L8:
+ addi 0,3,1
+ stw 0,0(9)
+.L12:
+.L7:
+ lwz 31,.LC2(30)
+ cmpwi 0,29,0
+ stw 28,0(31)
+ bc 12,2,.L10
+ lwz 9,.LC3(30)
+ stw 29,0(9)
+.L10:
+ lwz 0,.LC4(30)
+ cmpwi 0,0,0
+ bc 12,2,.L11
+ mr 3,26
+ mr 4,25
+.L11:
+ lwz 3,.LC5(30)
+ lwz 5,0(31)
+ mr 3,24
+ mr 4,27
+
+ lis 11,U_SYSTEM_ARGC@ha
+ stw 3,U_SYSTEM_ARGC@l(11);
+ lis 11,U_SYSTEM_ARGV@ha
+ stw 4,U_SYSTEM_ARGV@l(11);
+
+ lis 11,U_SYSTEM_ENVP@ha
+ stw 5,U_SYSTEM_ENVP@l(11);
+ mtlr 0
+ bl PASCALMAIN
+
+
+ .globl _haltproc
+ .type _haltproc,@function
+
+_haltproc:
+ li 0,1 /* exit call */
+ lis 3,U_SYSTEM_EXITCODE@h
+ stw 3,U_SYSTEM_EXITCODE@l(3)
+ sc
+ b _haltproc
+
+
+
+.Lfe1:
+ .size _start,.Lfe1-_start
+ .section .ident ; .asciz "$NetBSD: crt0.c,v 1.22 2002/05/09 20:32:59 matt Exp $" ; .text
+ .align 2
+ .type _strrchr,@function
+_strrchr:
+ rlwinm 4,4,0,0xff
+ li 10,0
+.L14:
+ lbz 0,0(3)
+ xor 9,0,4
+ neg 9,9
+ srawi 9,9,31
+ andc 11,3,9
+ cmpwi 0,0,0
+ and 9,10,9
+ or 10,9,11
+ addi 3,3,1
+ bc 4,2,.L14
+ mr 3,10
+ blr
+.Lfe2:
+ .size _strrchr,.Lfe2-_strrchr
+ .section ".data" # .rodata
+ .align 2
+ .comm environ,4,4
+ .comm __mainprog_obj,4,4
+ .ident "GCC: (GNU) 2.95.3 20010315 (release) (NetBSD nb3)"
+
+ .section ".data"
+ .globl __data_start
+__data_start:
+data_start:
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
diff --git a/rtl/netbsd/powerpc/sighnd.inc b/rtl/netbsd/powerpc/sighnd.inc
new file mode 100644
index 0000000000..9af50cf15d
--- /dev/null
+++ b/rtl/netbsd/powerpc/sighnd.inc
@@ -0,0 +1,52 @@
+{
+ $Id: sighnd.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Signalhandler for FreeBSD/i386
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+CONST FPU_ALL=$7F;
+
+function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
+begin
+ getfpustate:=0;
+end;
+
+procedure SignalToRunerror(signo: cint); cdecl;
+var
+ res : word;
+begin
+ res:=0;
+ if signo = SIGFPE then
+ begin
+ res := 200;
+ end
+ else
+ if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
+ begin
+ res := 216;
+ end;
+ { give runtime error at the position where the signal was raised }
+ if res<>0 then
+ begin
+ HandleError(res);
+ end;
+end;
+
+
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/ptypes.inc b/rtl/netbsd/ptypes.inc
new file mode 100644
index 0000000000..071c6a0807
--- /dev/null
+++ b/rtl/netbsd/ptypes.inc
@@ -0,0 +1,153 @@
+{
+ $Id: ptypes.inc,v 1.9 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+{$I ctypes.inc}
+{$packrecords c}
+
+type
+
+ dev_t = cuint32; { used for device numbers }
+ TDev = dev_t;
+ pDev = ^dev_t;
+
+ gid_t = cuint32; { used for group IDs }
+ TGid = gid_t;
+ pGid = ^gid_t;
+
+ ino_t = clong; { used for file serial numbers }
+ TIno = ino_t;
+ pIno = ^ino_t;
+
+ mode_t = cuint32; { used for file attributes }
+ TMode = mode_t;
+ pMode = ^mode_t;
+
+ nlink_t = cuint32; { used for link counts }
+ TnLink = nlink_t;
+ pnLink = ^nlink_t;
+
+ off_t = cint64; { used for file sizes }
+ TOff = off_t;
+ pOff = ^off_t;
+
+ pid_t = cint32; { used as process identifier }
+ TPid = pid_t;
+ pPid = ^pid_t;
+
+ size_t = cuint32; { as definied in the C standard}
+ TSize = size_t;
+ pSize = ^size_t;
+
+ ssize_t = cint32; { used by function for returning number of bytes }
+ TsSize = ssize_t;
+ psSize = ^ssize_t;
+
+ uid_t = cuint32; { used for user ID type }
+ TUid = Uid_t;
+ pUid = ^Uid_t;
+
+ clock_t = culong;
+ TClock = clock_t;
+ pClock = ^clock_t;
+
+ time_t = clong; { used for returning the time }
+ TTime = time_t;
+ pTime = ^time_t;
+ ptime_t = ^time_t;
+
+ socklen_t= cuint32;
+ TSocklen = socklen_t;
+ pSocklen = ^socklen_t;
+
+ timeval = packed record
+ tv_sec,
+ tv_usec : clong;
+ end;
+ ptimeval= ^timeval;
+ TTimeval= timeval;
+
+ timespec = packed record
+ tv_sec : time_t;
+ tv_nsec : clong;
+ end;
+ ptimespec= ^timespec;
+ Ttimespec= timespec;
+
+ pthread_t = pointer;
+ pthread_attr_t = pointer;
+ pthread_mutex_t = pointer;
+ pthread_mutexattr_t = pointer;
+ pthread_cond_t = pointer;
+ pthread_condattr_t = pointer;
+ pthread_key_t = cint;
+ pthread_rwlock_t = pointer;
+ pthread_rwlockattr_t = pointer;
+
+ sem_t = pointer;
+
+ {
+ Mutex types (Single UNIX Specification, Version 2, 1997).
+
+ Note that a mutex attribute with one of the following types:
+
+ PTHREAD_MUTEX_NORMAL
+ PTHREAD_MUTEX_RECURSIVE
+ MUTEX_TYPE_FAST (deprecated)
+ MUTEX_TYPE_COUNTING_FAST (deprecated)
+
+ will deviate from POSIX specified semantics.
+ }
+
+ pthread_mutextype = (
+ { Default POSIX mutex }
+ _PTHREAD_MUTEX_ERRORCHECK := 1,
+ { Recursive mutex }
+ _PTHREAD_MUTEX_RECURSIVE := 2,
+ { No error checking }
+ _PTHREAD_MUTEX_NORMAL := 3,
+ _MUTEX_TYPE_MAX
+ );
+
+
+const
+ _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_ERRORCHECK;
+ _MUTEX_TYPE_FAST = _PTHREAD_MUTEX_NORMAL;
+ _MUTEX_TYPE_COUNTING_FAST = _PTHREAD_MUTEX_RECURSIVE;
+
+ _PTHREAD_KEYS_MAX = 256;
+ _PTHREAD_STACK_MIN = 1024;
+
+ { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+ ARG_MAX = 256*1024; {4096} { Maximum number of argument size }
+ NAME_MAX = 255; {14} { Maximum number of bytes in filename }
+ PATH_MAX = 1024; {255} { Maximum number of bytes in pathname }
+
+ SYS_NMLN = 32; {BSD utsname struct limit}
+
+ SIG_MAXSIG = 128; // highest signal version
+
+{
+ $Log: ptypes.inc,v $
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/signal.inc b/rtl/netbsd/signal.inc
new file mode 100644
index 0000000000..3da14adea8
--- /dev/null
+++ b/rtl/netbsd/signal.inc
@@ -0,0 +1,170 @@
+{
+ $Id: signal.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+Const { For sending a signal }
+
+ SA_NOCLDSTOP = 8;
+ SA_ONSTACK = $001; { take signal on signal stack }
+ SA_RESTART = $002; { restart system call on signal return }
+ SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
+ SA_NODEFER = $010; { don't mask the signal we're delivering }
+ SA_NOCLDWAIT = $020; { don't keep zombies around }
+ SA_SIGINFO = $040; { signal handler with SA_SIGINFO args }
+ SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
+
+ SIG_BLOCK = 1;
+ SIG_UNBLOCK = 2;
+ SIG_SETMASK = 3;
+
+{BSD Checked}
+ SIG_DFL = 0 ;
+ SIG_IGN = 1 ;
+ SIG_ERR = -1 ;
+
+ SIGHUP = 1;
+ SIGINT = 2;
+ SIGQUIT = 3;
+ SIGILL = 4;
+ SIGTRAP = 5;
+ SIGABRT = 6;
+ SIGIOT = 6;
+ SIGEMT = 7;
+ SIGFPE = 8;
+ SIGKILL = 9;
+ SIGBUS = 10;
+ SIGSEGV = 11;
+ SIGSYS = 12;
+ SIGPIPE = 13;
+ SIGALRM = 14;
+ SIGTERM = 15;
+ SIGURG = 16;
+ SIGSTOP = 17;
+ SIGTSTP = 18;
+ SIGCONT = 19;
+ SIGCHLD = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGIO = 23;
+ SIGXCPU = 24;
+ SIGXFSZ = 25;
+ SIGVTALRM = 26;
+ SIGPROF = 27;
+ SIGWINCH = 28;
+ SIGINFO = 29;
+ SIGUSR1 = 30;
+ SIGUSR2 = 31;
+
+
+{$packrecords C}
+const
+ SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
+
+{
+ * The sequence of the fields/registers in struct sigcontext should match
+ * those in mcontext_t.
+ }
+
+type sigset_t = array[0..3] of cardinal;
+
+ PSigContextRec = ^SigContextRec;
+ SigContextRec = record
+ sc_mask : sigset_t; { signal mask to restore }
+ sc_onstack : longint; { sigstack state to restore }
+
+ sc_gs : longint; { machine state (struct trapframe): }
+ sc_fs : longint;
+ sc_es : longint;
+ sc_ds : longint;
+ sc_edi : longint;
+ sc_esi : longint;
+ sc_ebp : longint;
+ sc_isp : longint;
+ sc_ebx : longint;
+ sc_edx : longint;
+ sc_ecx : longint;
+ sc_eax : longint;
+ sc_trapno : longint;
+ sc_err : longint;
+ sc_eip : longint;
+ sc_cs : longint;
+ sc_efl : longint;
+ sc_esp : longint;
+ sc_ss : longint;
+ {
+ * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
+ * needed here), or that + 16 * 4 bytes for emulators (probably all
+ * needed here). The "spare" bytes are mostly not spare.
+ }
+ en_cw : cardinal; { control word (16bits used) }
+ en_sw : cardinal; { status word (16bits) }
+ en_tw : cardinal; { tag word (16bits) }
+ en_fip : cardinal; { floating point instruction pointer }
+ en_fcs : word; { floating code segment selector }
+ en_opcode : word; { opcode last executed (11 bits ) }
+ en_foo : cardinal; { floating operand offset }
+ en_fos : cardinal; { floating operand segment selector }
+ fpr_acc : array[0..79] of char;
+ fpr_ex_sw : cardinal;
+ fpr_pad : array[0..63] of char;
+ end;
+
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+
+{$ifdef powerpc}
+ TSigaction= procedure(Sig: Longint); cdecl;
+{$else}
+{$define BSDHandler}
+{$ifdef BSDHandler}
+ TSigAction = procedure(Sig: Longint; code:longint;var SigContext: SigContextRec);cdecl;
+{$else}
+ TSigAction = procedure(Sig: Longint; var sininfo:tsiginfo_t;var SigContext: SigContextRec);cdecl;
+{$endif}
+{$endif}
+
+ Sigset=sigset_t;
+ TSigset=sigset_t;
+ PSigSet = ^SigSet;
+
+ SigActionRec = packed record
+// Handler : record
+ sa_handler : TSigAction;
+// case byte of
+// 0: (Sh: SignalHandler);
+// 1: (Sa: TSigAction);
+// end;
+ Sa_Flags : Longint;
+ Sa_Mask : SigSet;
+ end;
+
+ PSigActionRec = ^SigActionRec;
+
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+
+
+{
+ $Log: signal.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/syscalls.inc b/rtl/netbsd/syscalls.inc
new file mode 100644
index 0000000000..d35f2cfc72
--- /dev/null
+++ b/rtl/netbsd/syscalls.inc
@@ -0,0 +1,23 @@
+{
+ $Id: syscalls.inc,v 1.9 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+
+{
+ $Log: syscalls.inc,v $
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/sysconst.inc b/rtl/netbsd/sysconst.inc
new file mode 100644
index 0000000000..433d5df375
--- /dev/null
+++ b/rtl/netbsd/sysconst.inc
@@ -0,0 +1,110 @@
+{
+ $Id: sysconst.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{BSD version, only the blocks with BSD in the comment are updated}
+
+const
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+ { Things for LSEEK call, same in linux and BSD }
+ Seek_set = 0;
+ Seek_Cur = 1;
+ Seek_End = 2;
+ { Things for OPEN call - after include/sys/fcntl.h, BSD updated.
+ BSD specifies these constants in hex }
+ Open_Accmode = 3;
+ Open_RdOnly = 0;
+ Open_WrOnly = 1;
+ Open_RdWr = 2;
+ Open_NonBlock = 4;
+ Open_Append = 8;
+ Open_ShLock = $10;
+ Open_ExLock = $20;
+ Open_ASync = $40;
+ Open_FSync = $80;
+ Open_NoFollow = $100;
+ Open_Create = $200; {BSD convention}
+ Open_Creat = $200; {Linux convention}
+ Open_Trunc = $400;
+ Open_Excl = $800;
+ Open_NOCTTY = $8000;
+
+ { The waitpid uses the following options:}
+ Wait_NoHang = 1;
+ Wait_UnTraced = 2;
+ Wait_Any = -1;
+ Wait_MyPGRP = 0;
+ { Constants to check stat.mode - checked all STAT constants with BSD}
+ STAT_IFMT = $f000; {00170000 }
+ STAT_IFSOCK = $c000; {0140000 }
+ STAT_IFLNK = $a000; {0120000 }
+ STAT_IFREG = $8000; {0100000 }
+ STAT_IFBLK = $6000; {0060000 }
+ STAT_IFDIR = $4000; {0040000 }
+ STAT_IFCHR = $2000; {0020000 }
+ STAT_IFIFO = $1000; {0010000 }
+ STAT_ISUID = $0800; {0004000 }
+ STAT_ISGID = $0400; {0002000 }
+ STAT_ISVTX = $0200; {0001000}
+ { Constants to check permissions all }
+ STAT_IRWXO = $7;
+ STAT_IROTH = $4;
+ STAT_IWOTH = $2;
+ STAT_IXOTH = $1;
+
+ STAT_IRWXG = STAT_IRWXO shl 3;
+ STAT_IRGRP = STAT_IROTH shl 3;
+ STAT_IWGRP = STAT_IWOTH shl 3;
+ STAT_IXGRP = STAT_IXOTH shl 3;
+
+ STAT_IRWXU = STAT_IRWXO shl 6;
+ STAT_IRUSR = STAT_IROTH shl 6;
+ STAT_IWUSR = STAT_IWOTH shl 6;
+ STAT_IXUSR = STAT_IXOTH shl 6;
+
+ { Constants to test the type of filesystem }
+ fs_old_ext2 = $ef51;
+ fs_ext2 = $ef53;
+ fs_ext = $137d;
+ fs_iso = $9660;
+ fs_minix = $137f;
+ fs_minix_30 = $138f;
+ fs_minux_V2 = $2468;
+ fs_msdos = $4d44;
+ fs_nfs = $6969;
+ fs_proc = $9fa0;
+ fs_xia = $012FD16D;
+
+ { Constansts for MMAP }
+ MAP_PRIVATE =2;
+ MAP_ANONYMOUS =$1000;
+
+ {Constansts Termios/Ioctl (used in Do_IsDevice) }
+ IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+// a type, and a wrong one. only for quick port atm.
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+
+
+{
+ $Log: sysconst.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/sysctlh.inc b/rtl/netbsd/sysctlh.inc
new file mode 100644
index 0000000000..38048129aa
--- /dev/null
+++ b/rtl/netbsd/sysctlh.inc
@@ -0,0 +1,886 @@
+{
+ $Id: sysctlh.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Marco van de Voort
+
+ The OS dependant sysctl constants.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+CONST
+
+{
+ * Definitions for sysctl call. The sysctl call uses a hierarchical name
+ * for objects that can be examined or modified. The name is expressed as
+ * a sequence of integers. Like a file path name, the meaning of each
+ * component depends on its place in the hierarchy. The top-level and kern
+ * identifiers are defined here, and other identifiers are defined in the
+ * respective subsystem header files.
+}
+
+ CTL_MAXNAME = 12; { largest number of components supported }
+
+{
+ * Each subsystem defined by sysctl defines a list of variables
+ * for that subsystem. Each name is either a node with further
+ * levels defined below it, or it is a leaf of some particular
+ * type given below. Each sysctl level defines a set of name/type
+ * pairs to be used by sysctl(1) in manipulating the subsystem.
+}
+
+Type
+ ctlname = record
+ ctl_name : pchar; { subsystem name }
+ ctl_type : cint { type of name }
+ End;
+
+Const
+ CTLTYPE = $f; { Mask for the type }
+ CTLTYPE_NODE = 1; { name is a node }
+ CTLTYPE_INT = 2; { name describes an integer }
+ CTLTYPE_STRING = 3; { name describes a string }
+ CTLTYPE_QUAD = 4; { name describes a 64-bit number }
+ CTLTYPE_OPAQUE = 5; { name describes a structure }
+ CTLTYPE_STRUCT = CTLTYPE_OPAQUE; { name describes a structure }
+ CTLTYPE_UINT = 6; { name describes an unsigned integer }
+ CTLTYPE_LONG = 7; { name describes a long }
+ CTLTYPE_ULONG = 8; { name describes an unsigned long }
+
+ CTLFLAG_RD = $80000000; { Allow reads of variable }
+ CTLFLAG_WR = $40000000; { Allow writes to the variable }
+ CTLFLAG_RW = (CTLFLAG_RD OR CTLFLAG_WR);
+ CTLFLAG_NOLOCK = $20000000; { XXX Don't Lock }
+ CTLFLAG_ANYBODY = $10000000; { All users can set this var }
+ CTLFLAG_SECURE = $8000000; { Permit set only if securelevel<=0 }
+ CTLFLAG_PRISON = $4000000; { Prisoned roots can fiddle }
+ CTLFLAG_DYN = $2000000; { Dynamic oid - can be freed }
+
+{
+ * USE THIS instead of a hardwired number from the categories below
+ * to get dynamically assigned sysctl entries using the linker-set
+ * technology. This is the way nearly all new sysctl variables should
+ * be implemented.
+ * e.g. SYSCTL_INT(_parent, OID_AUTO, name, CTLFLAG_RW, &variable, 0, "");
+ }
+ OID_AUTO = (-1);
+
+{
+ * Top-level identifiers
+ }
+ CTL_UNSPEC = 0;
+ CTL_KERN = 1; { "high kernel": proc, limits }
+ CTL_VM = 2; { virtual memory }
+ CTL_VFS = 3; { file system, mount type is next }
+ CTL_NET = 4; { network, see socket.h }
+ CTL_DEBUG = 5; { debugging parameters }
+ CTL_HW = 6; { generic cpu/io }
+ CTL_MACHDEP = 7; { machine dependent }
+ CTL_USER = 8; { user-level }
+ CTL_P1003_1B = 9; { POSIX 1003.1B }
+ CTL_MAXID = 10; { number of valid top-level ids }
+
+
+{
+ * CTL_KERN identifiers
+ }
+ KERN_OSTYPE = 1; { string: system version }
+ KERN_OSRELEASE = 2; { string: system release }
+ KERN_OSREV = 3; { int: system revision }
+ KERN_VERSION = 4; { string: compile time info }
+ KERN_MAXVNODES = 5; { int: max vnodes }
+ KERN_MAXPROC = 6; { int: max processes }
+ KERN_MAXFILES = 7; { int: max open files }
+ KERN_ARGMAX = 8; { int: max arguments to exec }
+ KERN_SECURELVL = 9; { int: system security level }
+ KERN_HOSTNAME = 10; { string: hostname }
+ KERN_HOSTID = 11; { int: host identifier }
+ KERN_CLOCKRATE = 12; { struct: struct clockrate }
+ KERN_VNODE = 13; { struct: vnode structures }
+ KERN_PROC = 14; { struct: process entries }
+ KERN_FILE = 15; { struct: file entries }
+ KERN_PROF = 16; { node: kernel profiling info }
+ KERN_POSIX1 = 17; { int: POSIX.1 version }
+ KERN_NGROUPS = 18; { int: # of supplemental group ids }
+ KERN_JOB_CONTROL = 19; { int: is job control available }
+ KERN_SAVED_IDS = 20; { int: saved set-user/group-ID }
+ KERN_BOOTTIME = 21; { struct: time kernel was booted }
+ KERN_NISDOMAINNAME = 22; { string: YP domain name }
+ KERN_UPDATEINTERVAL = 23; { int: update process sleep time }
+ KERN_OSRELDATE = 24; { int: OS release date }
+ KERN_NTP_PLL = 25; { node: NTP PLL control }
+ KERN_BOOTFILE = 26; { string: name of booted kernel }
+ KERN_MAXFILESPERPROC = 27; { int: max open files per proc }
+ KERN_MAXPROCPERUID = 28; { int: max processes per uid }
+ KERN_DUMPDEV = 29; { dev_t: device to dump on }
+ KERN_IPC = 30; { node: anything related to IPC }
+ KERN_DUMMY = 31; { unused }
+ KERN_PS_STRINGS = 32; { int: address of PS_STRINGS }
+ KERN_USRSTACK = 33; { int: address of USRSTACK }
+ KERN_LOGSIGEXIT = 34; { int: do we log sigexit procs? }
+ KERN_MAXID = 35; { number of valid kern ids }
+
+
+
+{
+ * KERN_PROC subtypes
+ }
+ KERN_PROC_ALL = 0; { everything }
+ KERN_PROC_PID = 1; { by process id }
+ KERN_PROC_PGRP = 2; { by process group id }
+ KERN_PROC_SESSION = 3; { by session of pid }
+ KERN_PROC_TTY = 4; { by controlling tty }
+ KERN_PROC_UID = 5; { by effective uid }
+ KERN_PROC_RUID = 6; { by real uid }
+ KERN_PROC_ARGS = 7; { get/set arguments/proctitle }
+
+{
+ * KERN_IPC identifiers
+ }
+ KIPC_MAXSOCKBUF = 1; { int: max size of a socket buffer }
+ KIPC_SOCKBUF_WASTE = 2; { int: wastage factor in sockbuf }
+ KIPC_SOMAXCONN = 3; { int: max length of connection q }
+ KIPC_MAX_LINKHDR = 4; { int: max length of link header }
+ KIPC_MAX_PROTOHDR = 5; { int: max length of network header }
+ KIPC_MAX_HDR = 6; { int: max total length of headers }
+ KIPC_MAX_DATALEN = 7; { int: max length of data? }
+ KIPC_MBSTAT = 8; { struct: mbuf usage statistics }
+ KIPC_NMBCLUSTERS = 9; { int: maximum mbuf clusters }
+
+{
+ * CTL_HW identifiers
+ }
+ HW_MACHINE = 1; { string: machine class }
+ HW_MODEL = 2; { string: specific machine model }
+ HW_NCPU = 3; { int: number of cpus }
+ HW_BYTEORDER = 4; { int: machine byte order }
+ HW_PHYSMEM = 5; { int: total memory }
+ HW_USERMEM = 6; { int: non-kernel memory }
+ HW_PAGESIZE = 7; { int: software page size }
+ HW_DISKNAMES = 8; { strings: disk drive names }
+ HW_DISKSTATS = 9; { struct: diskstats[] }
+ HW_FLOATINGPT = 10; { int: has HW floating point? }
+ HW_MACHINE_ARCH = 11; { string: machine architecture }
+ HW_MAXID = 12; { number of valid hw ids }
+
+
+{
+ * CTL_USER definitions
+ }
+ USER_CS_PATH = 1; { string: _CS_PATH }
+ USER_BC_BASE_MAX = 2; { int: BC_BASE_MAX }
+ USER_BC_DIM_MAX = 3; { int: BC_DIM_MAX }
+ USER_BC_SCALE_MAX = 4; { int: BC_SCALE_MAX }
+ USER_BC_STRING_MAX = 5; { int: BC_STRING_MAX }
+ USER_COLL_WEIGHTS_MAX = 6; { int: COLL_WEIGHTS_MAX }
+ USER_EXPR_NEST_MAX = 7; { int: EXPR_NEST_MAX }
+ USER_LINE_MAX = 8; { int: LINE_MAX }
+ USER_RE_DUP_MAX = 9; { int: RE_DUP_MAX }
+ USER_POSIX2_VERSION = 10; { int: POSIX2_VERSION }
+ USER_POSIX2_C_BIND = 11; { int: POSIX2_C_BIND }
+ USER_POSIX2_C_DEV = 12; { int: POSIX2_C_DEV }
+ USER_POSIX2_CHAR_TERM = 13; { int: POSIX2_CHAR_TERM }
+ USER_POSIX2_FORT_DEV = 14; { int: POSIX2_FORT_DEV }
+ USER_POSIX2_FORT_RUN = 15; { int: POSIX2_FORT_RUN }
+ USER_POSIX2_LOCALEDEF = 16; { int: POSIX2_LOCALEDEF }
+ USER_POSIX2_SW_DEV = 17; { int: POSIX2_SW_DEV }
+ USER_POSIX2_UPE = 18; { int: POSIX2_UPE }
+ USER_STREAM_MAX = 19; { int: POSIX2_STREAM_MAX }
+ USER_TZNAME_MAX = 20; { int: POSIX2_TZNAME_MAX }
+ USER_MAXID = 21; { number of valid user ids }
+
+
+ CTL_P1003_1B_ASYNCHRONOUS_IO = 1 ; { boolean }
+ CTL_P1003_1B_MAPPED_FILES = 2 ; { boolean }
+ CTL_P1003_1B_MEMLOCK = 3 ; { boolean }
+ CTL_P1003_1B_MEMLOCK_RANGE = 4 ; { boolean }
+ CTL_P1003_1B_MEMORY_PROTECTION = 5 ; { boolean }
+ CTL_P1003_1B_MESSAGE_PASSING = 6 ; { boolean }
+ CTL_P1003_1B_PRIORITIZED_IO = 7 ; { boolean }
+ CTL_P1003_1B_PRIORITY_SCHEDULING = 8 ; { boolean }
+ CTL_P1003_1B_REALTIME_SIGNALS = 9 ; { boolean }
+ CTL_P1003_1B_SEMAPHORES = 10; { boolean }
+ CTL_P1003_1B_FSYNC = 11; { boolean }
+ CTL_P1003_1B_SHARED_MEMORY_OBJECTS = 12; { boolean }
+ CTL_P1003_1B_SYNCHRONIZED_IO = 13; { boolean }
+ CTL_P1003_1B_TIMERS = 14; { boolean }
+ CTL_P1003_1B_AIO_LISTIO_MAX = 15; { int }
+ CTL_P1003_1B_AIO_MAX = 16; { int }
+ CTL_P1003_1B_AIO_PRIO_DELTA_MAX = 17; { int }
+ CTL_P1003_1B_DELAYTIMER_MAX = 18; { int }
+ CTL_P1003_1B_MQ_OPEN_MAX = 19; { int }
+ CTL_P1003_1B_PAGESIZE = 20; { int }
+ CTL_P1003_1B_RTSIG_MAX = 21; { int }
+ CTL_P1003_1B_SEM_NSEMS_MAX = 22; { int }
+ CTL_P1003_1B_SEM_VALUE_MAX = 23; { int }
+ CTL_P1003_1B_SIGQUEUE_MAX = 24; { int }
+ CTL_P1003_1B_TIMER_MAX = 25; { int }
+
+ CTL_P1003_1B_MAXID = 26;
+
+{ LongestStringInCtlNames = 21;}
+
+
+Const
+
+ CTL_NAMES : Array[0..9] OF CtlNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'kern'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'vm'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'vfs'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'net'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'debug'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'hw'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'machdep'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'user'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'p1003_1b'; CtlType : CTLTYPE_NODE ));
+
+ CTL_KERN_NAME : Array[0..34] OF CtlNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'ostype'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'osrelease'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'osrevision'; CtlType : CTLTYPE_INT ),
+ ( Name: 'version'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'maxvnodes'; CtlType : CTLTYPE_INT ),
+ ( Name: 'maxproc'; CtlType : CTLTYPE_INT ),
+ ( Name: 'maxfiles'; CtlType : CTLTYPE_INT ),
+ ( Name: 'argmax'; CtlType : CTLTYPE_INT ),
+ ( Name: 'securelevel'; CtlType : CTLTYPE_INT ),
+ ( Name: 'hostname'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'hostid'; CtlType : CTLTYPE_UINT ),
+ ( Name: 'clockrate'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'vnode'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'proc'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'file'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'profiling'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'posix1version'; CtlType : CTLTYPE_INT ),
+ ( Name: 'ngroups'; CtlType : CTLTYPE_INT ),
+ ( Name: 'job_control'; CtlType : CTLTYPE_INT ),
+ ( Name: 'saved_ids'; CtlType : CTLTYPE_INT ),
+ ( Name: 'boottime'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'nisdomainname'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'update'; CtlType : CTLTYPE_INT ),
+ ( Name: 'osreldate'; CtlType : CTLTYPE_INT ),
+ ( Name: 'ntp_pll'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'bootfile'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'maxfilesperproc'; CtlType : CTLTYPE_INT ),
+ ( Name: 'maxprocperuid'; CtlType : CTLTYPE_INT ),
+ ( Name: 'dumpdev'; CtlType : CTLTYPE_STRUCT ), { we lie; don't print as int }
+ ( Name: 'ipc'; CtlType : CTLTYPE_NODE ),
+ ( Name: 'dummy'; CtlType : CTLTYPE_INT ),
+ ( Name: 'ps_strings'; CtlType : CTLTYPE_INT ),
+ ( Name: 'usrstack'; CtlType : CTLTYPE_INT ),
+ ( Name: 'logsigexit'; CtlType : CTLTYPE_INT ));
+
+{
+ * CTL_VFS identifiers
+}
+ CTL_VFS_NAMES : array[0..0] of CTLNameRec = (
+ ( Name: 'vfsconf'; CtlType : CTLTYPE_STRUCT ));
+
+
+ CTL_HW_NAMES : array[0..10] of CTLNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'machine'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'model'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'ncpu'; CtlType : CTLTYPE_INT ),
+ ( Name: 'byteorder'; CtlType : CTLTYPE_INT ),
+ ( Name: 'physmem'; CtlType : CTLTYPE_UINT ),
+ ( Name: 'usermem'; CtlType : CTLTYPE_UINT ),
+ ( Name: 'pagesize'; CtlType : CTLTYPE_INT ),
+ ( Name: 'disknames'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'diskstats'; CtlType : CTLTYPE_STRUCT ),
+ ( Name: 'floatingpoint'; CtlType : CTLTYPE_INT ));
+
+
+ CTL_USER_NAMES : array[0..20] of CTLNameRec = (
+ ( Name :''; CtlType: 0 ),
+ ( Name: 'cs_path'; CtlType : CTLTYPE_STRING ),
+ ( Name: 'bc_base_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'bc_dim_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'bc_scale_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'bc_string_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'coll_weights_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'expr_nest_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'line_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 're_dup_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_version'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_c_bind'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_c_dev'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_char_term'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_fort_dev'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_fort_run'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_localedef'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_sw_dev'; CtlType : CTLTYPE_INT ),
+ ( Name: 'posix2_upe'; CtlType : CTLTYPE_INT ),
+ ( Name: 'stream_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'tzname_max'; CtlType : CTLTYPE_INT ));
+
+ CTL_P1003_1B_NAMES : array[0..25] of CTLNameRec = (
+ ( Name: ''; CtlType: 0 ),
+ ( Name: 'asynchronous_io'; CtlType : CTLTYPE_INT ),
+ ( Name: 'mapped_files'; CtlType : CTLTYPE_INT ),
+ ( Name: 'memlock'; CtlType : CTLTYPE_INT ),
+ ( Name: 'memlock_range'; CtlType : CTLTYPE_INT ),
+ ( Name: 'memory_protection'; CtlType : CTLTYPE_INT ),
+ ( Name: 'message_passing'; CtlType : CTLTYPE_INT ),
+ ( Name: 'prioritized_io'; CtlType : CTLTYPE_INT ),
+ ( Name: 'priority_scheduling'; CtlType : CTLTYPE_INT ),
+ ( Name: 'realtime_signals'; CtlType : CTLTYPE_INT ),
+ ( Name: 'semaphores'; CtlType : CTLTYPE_INT ),
+ ( Name: 'fsync'; CtlType : CTLTYPE_INT ),
+ ( Name: 'shared_memory_objects'; CtlType : CTLTYPE_INT ),
+ ( Name: 'synchronized_io'; CtlType : CTLTYPE_INT ),
+ ( Name: 'timers'; CtlType : CTLTYPE_INT ),
+ ( Name: 'aio_listio_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'aio_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'aio_prio_delta_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'delaytimer_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'mq_open_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'pagesize'; CtlType : CTLTYPE_INT ),
+ ( Name: 'rtsig_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'nsems_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'sem_value_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'sigqueue_max'; CtlType : CTLTYPE_INT ),
+ ( Name: 'timer_max'; CtlType : CTLTYPE_INT ));
+
+
+const
+{
+ * Types
+}
+ SOCK_STREAM = 1; { stream socket }
+ SOCK_DGRAM = 2; { datagram socket }
+ SOCK_RAW = 3; { raw-protocol interface }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequenced packet stream }
+
+{
+ * Address families.
+}
+ AF_UNSPEC = 0; { unspecified }
+ AF_LOCAL = 1; { local to host (Name:pipes;CtlType: portals) }
+ AF_UNIX = AF_LOCAL; { backward compatibility }
+ AF_INET = 2; { internetwork: UDP, TCP, etc. }
+ AF_IMPLINK = 3; { arpanet imp addresses }
+ AF_PUP = 4; { pup protocols: e.g. BSP }
+ AF_CHAOS = 5; { mit CHAOS protocols }
+ AF_NS = 6; { XEROX NS protocols }
+ AF_ISO = 7; { ISO protocols }
+ AF_OSI = AF_ISO;
+ AF_ECMA = 8; { European computer manufacturers }
+ AF_DATAKIT = 9; { datakit protocols }
+ AF_CCITT = 10; { CCITT protocols, X.25 etc }
+ AF_SNA = 11; { IBM SNA }
+ AF_DECnet = 12; { DECnet }
+ AF_DLI = 13; { DEC Direct data link interface }
+ AF_LAT = 14; { LAT }
+ AF_HYLINK = 15; { NSC Hyperchannel }
+ AF_APPLETALK = 16; { Apple Talk }
+ AF_ROUTE = 17; { Internal Routing Protocol }
+ AF_LINK = 18; { Link layer interface }
+ pseudo_AF_XTP = 19; { eXpress Transfer Protocol (Name:no AF) }
+ AF_COIP = 20; { connection-oriented IP, aka ST II }
+ AF_CNT = 21; { Computer Network Technology }
+ pseudo_AF_RTIP = 22; { Help Identify RTIP packets }
+ AF_IPX = 23; { Novell Internet Protocol }
+ AF_SIP = 24; { Simple Internet Protocol }
+ pseudo_AF_PIP = 25; { Help Identify PIP packets }
+ AF_ISDN = 26; { Integrated Services Digital Network}
+ AF_E164 = AF_ISDN; { CCITT E.164 recommendation }
+ pseudo_AF_KEY = 27; { Internal key-management function }
+ AF_INET6 = 28; { IPv6 }
+ AF_NATM = 29; { native ATM access }
+ AF_ATM = 30; { ATM }
+ pseudo_AF_HDRCMPLT = 31; { Used by BPF to not rewrite headers
+ * in interface output routine
+ }
+ AF_NETGRAPH = 32; { Netgraph sockets }
+
+ AF_MAX = 33;
+
+{
+ * Protocol families, same as address families for now.
+}
+
+{
+ * Definitions for network related sysctl, CTL_NET.
+ *
+ * Second level is protocol family.
+ * Third level is protocol number.
+ *
+ * Further levels are defined by the individual families below.
+}
+ NET_MAXID = AF_MAX;
+
+ CTL_NET_NAMES : Array[0..32] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'unix';CtlType: CTLTYPE_NODE ),
+ (Name: 'inet';CtlType: CTLTYPE_NODE ),
+ (Name: 'implink';CtlType: CTLTYPE_NODE ),
+ (Name: 'pup';CtlType: CTLTYPE_NODE ),
+ (Name: 'chaos';CtlType: CTLTYPE_NODE ),
+ (Name: 'xerox_ns';CtlType: CTLTYPE_NODE ),
+ (Name: 'iso';CtlType: CTLTYPE_NODE ),
+ (Name: 'emca';CtlType: CTLTYPE_NODE ),
+ (Name: 'datakit';CtlType: CTLTYPE_NODE ),
+ (Name: 'ccitt';CtlType: CTLTYPE_NODE ),
+ (Name: 'ibm_sna';CtlType: CTLTYPE_NODE ),
+ (Name: 'decnet';CtlType: CTLTYPE_NODE ),
+ (Name: 'dec_dli';CtlType: CTLTYPE_NODE ),
+ (Name: 'lat';CtlType: CTLTYPE_NODE ),
+ (Name: 'hylink';CtlType: CTLTYPE_NODE ),
+ (Name: 'appletalk';CtlType: CTLTYPE_NODE ),
+ (Name: 'route';CtlType: CTLTYPE_NODE ),
+ (Name: 'link_layer';CtlType: CTLTYPE_NODE ),
+ (Name: 'xtp';CtlType: CTLTYPE_NODE ),
+ (Name: 'coip';CtlType: CTLTYPE_NODE ),
+ (Name: 'cnt';CtlType: CTLTYPE_NODE ),
+ (Name: 'rtip';CtlType: CTLTYPE_NODE ),
+ (Name: 'ipx';CtlType: CTLTYPE_NODE ),
+ (Name: 'sip';CtlType: CTLTYPE_NODE ),
+ (Name: 'pip';CtlType: CTLTYPE_NODE ),
+ (Name: 'isdn';CtlType: CTLTYPE_NODE ),
+ (Name: 'key';CtlType: CTLTYPE_NODE ),
+ (Name: 'inet6';CtlType: CTLTYPE_NODE ),
+ (Name: 'natm';CtlType: CTLTYPE_NODE ),
+ (Name: 'atm';CtlType: CTLTYPE_NODE ),
+ (Name: 'hdrcomplete';CtlType: CTLTYPE_NODE ),
+ (Name: 'netgraph';CtlType: CTLTYPE_NODE ));
+
+{
+ * PF_ROUTE - Routing table
+ *
+ * Three additional levels are defined:
+ * Fourth: address family, 0 is wildcard
+ * Fifth: type of info, defined below
+ * Sixth: flag(Name:s) to mask with for NET_RT_FLAGS
+}
+ NET_RT_DUMP = 1; { dump; may limit to a.f. }
+ NET_RT_FLAGS = 2; { by flags, e.g. RESOLVING }
+ NET_RT_IFLIST = 3; { survey interface list }
+ NET_RT_MAXID = 4;
+
+ CTL_NET_RT_NAMES : Array[0..3] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'dump';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'flags';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'iflist';CtlType: CTLTYPE_STRUCT ));
+
+{
+ * Possible states of profiling.
+}
+ GMON_PROF_ON = 0;
+ GMON_PROF_BUSY = 1;
+ GMON_PROF_ERROR = 2;
+ GMON_PROF_OFF = 3;
+ GMON_PROF_HIRES = 4;
+
+{
+ * Sysctl definitions for extracting profiling information from the kernel.
+}
+ GPROF_STATE = 0; { int: profiling enabling variable }
+ GPROF_COUNT = 1; { struct: profile tick count buffer }
+ GPROF_FROMS = 2; { struct: from location hash bucket }
+ GPROF_TOS = 3; { struct: destination/count structure }
+ GPROF_GMONPARAM = 4; { struct: profiling parameters (Name:see above) }
+
+{
+ * CTL_VM identifiers
+}
+ VM_METER = 1; { struct vmmeter }
+ VM_LOADAVG = 2; { struct loadavg }
+ VM_V_FREE_MIN = 3; { cnt.v_free_min }
+ VM_V_FREE_TARGET = 4; { cnt.v_free_target }
+ VM_V_FREE_RESERVED = 5; { cnt.v_free_reserved }
+ VM_V_INACTIVE_TARGET = 6; { cnt.v_inactive_target }
+ VM_V_CACHE_MIN = 7; { cnt.v_cache_max }
+ VM_V_CACHE_MAX = 8; { cnt.v_cache_min }
+ VM_V_PAGEOUT_FREE_MIN = 9; { cnt.v_pageout_free_min }
+ VM_PAGEOUT_ALGORITHM = 10; { pageout algorithm }
+ VM_SWAPPING_ENABLED = 11; { swapping enabled }
+ VM_MAXID = 12; { number of valid vm ids }
+
+ CTL_VM_NAMES : Array[0..11] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'vmmeter';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'loadavg';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'v_free_min';CtlType: CTLTYPE_INT ),
+ (Name: 'v_free_target';CtlType: CTLTYPE_INT ),
+ (Name: 'v_free_reserved';CtlType: CTLTYPE_INT ),
+ (Name: 'v_inactive_target';CtlType: CTLTYPE_INT ),
+ (Name: 'v_cache_min';CtlType: CTLTYPE_INT ),
+ (Name: 'v_cache_max';CtlType: CTLTYPE_INT ),
+ (Name: 'v_pageout_free_min';CtlType: CTLTYPE_INT),
+ (Name: 'pageout_algorithm';CtlType: CTLTYPE_INT),
+ (Name: 'swapping_enabled';CtlType: CTLTYPE_INT));
+
+{
+ * Protocols (Name:RFC 1700)
+}
+ IPPROTO_IP = 0; { dummy for IP }
+ IPPROTO_HOPOPTS = 0; { IP6 hop-by-hop options }
+ IPPROTO_ICMP = 1; { control message protocol }
+ IPPROTO_IGMP = 2; { group mgmt protocol }
+ IPPROTO_GGP = 3; { gateway^2 (Name:deprecated) }
+ IPPROTO_IPV4 = 4; { IPv4 encapsulation }
+ IPPROTO_IPIP = IPPROTO_IPV4; { for compatibility }
+ IPPROTO_TCP = 6; { tcp }
+ IPPROTO_ST = 7; { Stream protocol II }
+ IPPROTO_EGP = 8; { exterior gateway protocol }
+ IPPROTO_PIGP = 9; { private interior gateway }
+ IPPROTO_RCCMON = 10; { BBN RCC Monitoring }
+ IPPROTO_NVPII = 11; { network voice protocol}
+ IPPROTO_PUP = 12; { pup }
+ IPPROTO_ARGUS = 13; { Argus }
+ IPPROTO_EMCON = 14; { EMCON }
+ IPPROTO_XNET = 15; { Cross Net Debugger }
+ IPPROTO_CHAOS = 16; { Chaos}
+ IPPROTO_UDP = 17; { user datagram protocol }
+ IPPROTO_MUX = 18; { Multiplexing }
+ IPPROTO_MEAS = 19; { DCN Measurement Subsystems }
+ IPPROTO_HMP = 20; { Host Monitoring }
+ IPPROTO_PRM = 21; { Packet Radio Measurement }
+ IPPROTO_IDP = 22; { xns idp }
+ IPPROTO_TRUNK1 = 23; { Trunk-1 }
+ IPPROTO_TRUNK2 = 24; { Trunk-2 }
+ IPPROTO_LEAF1 = 25; { Leaf-1 }
+ IPPROTO_LEAF2 = 26; { Leaf-2 }
+ IPPROTO_RDP = 27; { Reliable Data }
+ IPPROTO_IRTP = 28; { Reliable Transaction }
+ IPPROTO_TP = 29; { tp-4 w/ class negotiation }
+ IPPROTO_BLT = 30; { Bulk Data Transfer }
+ IPPROTO_NSP = 31; { Network Services }
+ IPPROTO_INP = 32; { Merit Internodal }
+ IPPROTO_SEP = 33; { Sequential Exchange }
+ IPPROTO_3PC = 34; { Third Party Connect }
+ IPPROTO_IDPR = 35; { InterDomain Policy Routing }
+ IPPROTO_XTP = 36; { XTP }
+ IPPROTO_DDP = 37; { Datagram Delivery }
+ IPPROTO_CMTP = 38; { Control Message Transport }
+ IPPROTO_TPXX = 39; { TP++ Transport }
+ IPPROTO_IL = 40; { IL transport protocol }
+ IPPROTO_IPV6 = 41; { IP6 header }
+ IPPROTO_SDRP = 42; { Source Demand Routing }
+ IPPROTO_ROUTING = 43; { IP6 routing header }
+ IPPROTO_FRAGMENT = 44; { IP6 fragmentation header }
+ IPPROTO_IDRP = 45; { InterDomain Routing}
+ IPPROTO_RSVP = 46; { resource reservation }
+ IPPROTO_GRE = 47; { General Routing Encap. }
+ IPPROTO_MHRP = 48; { Mobile Host Routing }
+ IPPROTO_BHA = 49; { BHA }
+ IPPROTO_ESP = 50; { IP6 Encap Sec. Payload }
+ IPPROTO_AH = 51; { IP6 Auth Header }
+ IPPROTO_INLSP = 52; { Integ. Net Layer Security }
+ IPPROTO_SWIPE = 53; { IP with encryption }
+ IPPROTO_NHRP = 54; { Next Hop Resolution }
+{ 55-57: Unassigned }
+ IPPROTO_ICMPV6 = 58; { ICMP6 }
+ IPPROTO_NONE = 59; { IP6 no next header }
+ IPPROTO_DSTOPTS = 60; { IP6 destination option }
+ IPPROTO_AHIP = 61; { any host internal protocol }
+ IPPROTO_CFTP = 62; { CFTP }
+ IPPROTO_HELLO = 63; { 'hello' routing protocol }
+ IPPROTO_SATEXPAK = 64; { SATNET/Backroom EXPAK }
+ IPPROTO_KRYPTOLAN = 65; { Kryptolan }
+ IPPROTO_RVD = 66; { Remote Virtual Disk }
+ IPPROTO_IPPC = 67; { Pluribus Packet Core }
+ IPPROTO_ADFS = 68; { Any distributed FS }
+ IPPROTO_SATMON = 69; { Satnet Monitoring }
+ IPPROTO_VISA = 70; { VISA Protocol }
+ IPPROTO_IPCV = 71; { Packet Core Utility }
+ IPPROTO_CPNX = 72; { Comp. Prot. Net. Executive }
+ IPPROTO_CPHB = 73; { Comp. Prot. HeartBeat }
+ IPPROTO_WSN = 74; { Wang Span Network }
+ IPPROTO_PVP = 75; { Packet Video Protocol }
+ IPPROTO_BRSATMON = 76; { BackRoom SATNET Monitoring }
+ IPPROTO_ND = 77; { Sun net disk proto (Name:temp.) }
+ IPPROTO_WBMON = 78; { WIDEBAND Monitoring }
+ IPPROTO_WBEXPAK = 79; { WIDEBAND EXPAK }
+ IPPROTO_EON = 80; { ISO cnlp }
+ IPPROTO_VMTP = 81; { VMTP }
+ IPPROTO_SVMTP = 82; { Secure VMTP }
+ IPPROTO_VINES = 83; { Banyon VINES }
+ IPPROTO_TTP = 84; { TTP }
+ IPPROTO_IGP = 85; { NSFNET-IGP }
+ IPPROTO_DGP = 86; { dissimilar gateway prot. }
+ IPPROTO_TCF = 87; { TCF }
+ IPPROTO_IGRP = 88; { Cisco/GXS IGRP }
+ IPPROTO_OSPFIGP = 89; { OSPFIGP }
+ IPPROTO_SRPC = 90; { Strite RPC protocol }
+ IPPROTO_LARP = 91; { Locus Address Resoloution }
+ IPPROTO_MTP = 92; { Multicast Transport }
+ IPPROTO_AX25 = 93; { AX.25 Frames }
+ IPPROTO_IPEIP = 94; { IP encapsulated in IP }
+ IPPROTO_MICP = 95; { Mobile Int.ing control }
+ IPPROTO_SCCSP = 96; { Semaphore Comm. security }
+ IPPROTO_ETHERIP = 97; { Ethernet IP encapsulation }
+ IPPROTO_ENCAP = 98; { encapsulation header }
+ IPPROTO_APES = 99; { any private encr. scheme }
+ IPPROTO_GMTP = 100; { GMTP}
+ IPPROTO_IPCOMP = 108; { payload compression (Name:IPComp) }
+{ 101-254: Partly Unassigned }
+ IPPROTO_PIM = 103; { Protocol Independent Mcast }
+ IPPROTO_PGM = 113; { PGM }
+{ 255: Reserved }
+{ BSD Private, local use, namespace incursion }
+ IPPROTO_DIVERT = 254; { divert pseudo-protocol }
+ IPPROTO_RAW = 255; { raw IP packet }
+ IPPROTO_MAX = 256;
+
+{ last return value of *_input(Name:);CtlType: meaning 'all job for this pkt is done'. }
+ IPPROTO_DONE = 257;
+
+
+{
+ * Options for use with [gs]etsockopt at the IP level.
+ * First word of comment is data type; bool is stored in int.
+}
+ IP_OPTIONS = 1; { buf/ip_opts; set/get IP options }
+ IP_HDRINCL = 2; { int; header is included with data }
+ IP_TOS = 3; { int; IP type of service and preced. }
+ IP_TTL = 4; { int; IP time to live }
+ IP_RECVOPTS = 5; { bool; receive all IP opts w/dgram }
+ IP_RECVRETOPTS = 6; { bool; receive IP opts for response }
+ IP_RECVDSTADDR = 7; { bool; receive IP dst addr w/dgram }
+ IP_RETOPTS = 8; { ip_opts; set/get IP options }
+ IP_MULTICAST_IF = 9; { u_char; set/get IP multicast i/f }
+ IP_MULTICAST_TTL = 10; { u_char; set/get IP multicast ttl }
+ IP_MULTICAST_LOOP = 11; { u_char; set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = 12; { ip_mreq; add an IP group membership }
+ IP_DROP_MEMBERSHIP = 13; { ip_mreq; drop an IP group membership }
+ IP_MULTICAST_VIF = 14; { set/get IP mcast virt. iface }
+ IP_RSVP_ON = 15; { enable RSVP in kernel }
+ IP_RSVP_OFF = 16; { disable RSVP in kernel }
+ IP_RSVP_VIF_ON = 17; { set RSVP per-vif socket }
+ IP_RSVP_VIF_OFF = 18; { unset RSVP per-vif socket }
+ IP_PORTRANGE = 19; { int; range to choose for unspec port }
+ IP_RECVIF = 20; { bool; receive reception if w/dgram }
+{ for IPSEC }
+ IP_IPSEC_POLICY = 21; { int; set/get security policy }
+ IP_FAITH = 22; { bool; accept FAITH'ed connections }
+
+ IP_FW_ADD = 50; { add a firewall rule to chain }
+ IP_FW_DEL = 51; { delete a firewall rule from chain }
+ IP_FW_FLUSH = 52; { flush firewall rule chain }
+ IP_FW_ZERO = 53; { clear single/all firewall counter(Name:s) }
+ IP_FW_GET = 54; { get entire firewall rule chain }
+ IP_FW_RESETLOG = 55; { reset logging counters }
+
+ IP_DUMMYNET_CONFIGURE = 60; { add/configure a dummynet pipe }
+ IP_DUMMYNET_DEL = 61; { delete a dummynet pipe from chain }
+ IP_DUMMYNET_FLUSH = 62; { flush dummynet }
+ IP_DUMMYNET_GET = 64; { get entire dummynet pipes }
+
+{
+ * Defaults and limits for options
+}
+ IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
+ IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member }
+ IP_MAX_MEMBERSHIPS = 20; { per socket }
+
+{
+ * Argument for IP_PORTRANGE:
+ * - which range to search when port is unspecified at bind(Name:) or connect()
+}
+ IP_PORTRANGE_DEFAULT = 0; { default range }
+ IP_PORTRANGE_HIGH = 1; { 'high' - request firewall bypass }
+ IP_PORTRANGE_LOW = 2; { 'low' - vouchsafe security }
+
+{
+ * Definitions for inet sysctl operations.
+ *
+ * Third level is protocol number.
+ * Fourth level is desired variable within that protocol.
+}
+ IPPROTO_MAXID = (IPPROTO_AH + 1); { don't list to IPPROTO_MAX }
+
+ CTL_IPPROTO_NAMES : Array[0..51] OF CtlNameRec = (
+ (Name: 'ip';CtlType: CTLTYPE_NODE ),
+ (Name: 'icmp';CtlType: CTLTYPE_NODE ),
+ (Name: 'igmp';CtlType: CTLTYPE_NODE ),
+ (Name: 'ggp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'tcp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'egp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'pup';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'udp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'idp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'ipsec';CtlType: CTLTYPE_NODE ));
+
+{
+ * Names for IP sysctl objects
+}
+ IPCTL_FORWARDING = 1; { act as router }
+ IPCTL_SENDREDIRECTS = 2; { may send redirects when forwarding }
+ IPCTL_DEFTTL = 3; { default TTL }
+{$ifdef notyettunable}
+ IPCTL_DEFMTU = 4; { default MTU }
+{$endif}
+ IPCTL_RTEXPIRE = 5; { cloned route expiration time }
+ IPCTL_RTMINEXPIRE = 6; { min value for expiration time }
+ IPCTL_RTMAXCACHE = 7; { trigger level for dynamic expire }
+ IPCTL_SOURCEROUTE = 8; { may perform source routes }
+ IPCTL_DIRECTEDBROADCAST = 9; { may re-broadcast received packets }
+ IPCTL_INTRQMAXLEN = 10; { max length of netisr queue }
+ IPCTL_INTRQDROPS = 11; { number of netisr q drops }
+ IPCTL_STATS = 12; { ipstat structure }
+ IPCTL_ACCEPTSOURCEROUTE = 13; { may accept source routed packets }
+ IPCTL_FASTFORWARDING = 14; { use fast IP forwarding code }
+ IPCTL_KEEPFAITH = 15; { FAITH IPv4->IPv6 translater ctl }
+ IPCTL_GIF_TTL = 16; { default TTL for gif encap packet }
+ IPCTL_MAXID = 17;
+
+ IPCTL_NAMES : Array[0..14] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'forwarding';CtlType: CTLTYPE_INT ),
+ (Name: 'redirect';CtlType: CTLTYPE_INT ),
+ (Name: 'ttl';CtlType: CTLTYPE_INT ),
+ (Name: 'mtu';CtlType: CTLTYPE_INT ),
+ (Name: 'rtexpire';CtlType: CTLTYPE_INT ),
+ (Name: 'rtminexpire';CtlType: CTLTYPE_INT ),
+ (Name: 'rtmaxcache';CtlType: CTLTYPE_INT ),
+ (Name: 'sourceroute';CtlType: CTLTYPE_INT ),
+ (Name: 'directed-broadcast';CtlType: CTLTYPE_INT ),
+ (Name: 'intr-queue-maxlen';CtlType: CTLTYPE_INT ),
+ (Name: 'intr-queue-drops';CtlType: CTLTYPE_INT ),
+ (Name: 'stats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'accept_sourceroute';CtlType: CTLTYPE_INT ),
+ (Name: 'fastforwarding';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for ICMP sysctl objects
+}
+ ICMPCTL_MASKREPL = 1; { allow replies to netmask requests }
+ ICMPCTL_STATS = 2; { statistics (Name:read-only) }
+ ICMPCTL_ICMPLIM = 3;
+ ICMPCTL_MAXID = 4;
+
+ ICMPCTL_NAMES : Array[0..3] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'maskrepl';CtlType: CTLTYPE_INT ),
+ (Name: 'stats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'icmplim';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for ICMP sysctl objects
+}
+ ICMPV6CTL_STATS = 1;
+ ICMPV6CTL_REDIRACCEPT = 2; { accept/process redirects }
+ ICMPV6CTL_REDIRTIMEOUT = 3; { redirect cache time }
+{$ifdef obsolete} {obsoleted}
+ ICMPV6CTL_ERRRATELIMIT = 5; { ICMPv6 error rate limitation }
+{$endif}
+ ICMPV6CTL_ND6_PRUNE = 6;
+ ICMPV6CTL_ND6_DELAY = 8;
+ ICMPV6CTL_ND6_UMAXTRIES = 9;
+ ICMPV6CTL_ND6_MMAXTRIES = 10;
+ ICMPV6CTL_ND6_USELOOPBACK = 11;
+//define ICMPV6CTL_ND6_PROXYALL = 12; obsoleted, do not reuse here
+ ICMPV6CTL_NODEINFO = 13;
+ ICMPV6CTL_ERRPPSLIMIT = 14; { ICMPv6 error pps limitation }
+ ICMPV6CTL_ND6_MAXNUDHINT= 15;
+ ICMPV6CTL_MTUDISC_HIWAT = 16;
+ ICMPV6CTL_MTUDISC_LOWAT = 17;
+ ICMPV6CTL_ND6_DEBUG = 18;
+ ICMPV6CTL_ND6_DRLIST = 19;
+ ICMPV6CTL_ND6_PRLIST = 20;
+ ICMPV6CTL_MAXID = 21;
+
+ ICMPV6CTL_NAMES : Array[0..20] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'rediraccept';CtlType: CTLTYPE_INT ),
+ (Name: 'redirtimeout';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nd6_prune';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nd6_delay';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_umaxtries';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_mmaxtries';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_useloopback';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nodeinfo';CtlType: CTLTYPE_INT ),
+ (Name: 'errppslimit';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_maxnudhint';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisc_hiwat';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisc_lowat';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_debug';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ));
+
+
+{
+ * Names for UDP sysctl objects
+}
+ UDPCTL_CHECKSUM = 1; { checksum UDP packets }
+ UDPCTL_STATS = 2; { statistics (Name:read-only) }
+ UDPCTL_MAXDGRAM = 3; { max datagram size }
+ UDPCTL_RECVSPACE = 4; { default receive buffer space }
+ UDPCTL_PCBLIST = 5; { list of PCBs for UDP sockets }
+ UDPCTL_MAXID = 6;
+
+ UDPCTL_NAMES : Array[0..5] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'checksum';CtlType: CTLTYPE_INT ),
+ (Name: 'stats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'maxdgram';CtlType: CTLTYPE_INT ),
+ (Name: 'recvspace';CtlType: CTLTYPE_INT ),
+ (Name: 'pcblist';CtlType: CTLTYPE_STRUCT ));
+
+{
+
+ $Log: sysctlh.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/sysnr.inc b/rtl/netbsd/sysnr.inc
new file mode 100644
index 0000000000..610167cb65
--- /dev/null
+++ b/rtl/netbsd/sysnr.inc
@@ -0,0 +1,539 @@
+{
+ $Id: sysnr.inc,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+
+ {
+ Converted from NetBSD CVS tree:
+ syscall.h,v 1.120 2001/07/01 18:07:33
+ }
+
+ syscall_nr_syscall = 0;
+ { syscall: "exit" ret: "void" args: "int" }
+ syscall_nr_exit = 1;
+ { syscall: "fork" ret: "int" args: }
+ syscall_nr_fork = 2;
+ { syscall: "read" ret: "ssize_t" args: "int" "void " "size_t" }
+ syscall_nr_read = 3;
+ { syscall: "write" ret: "ssize_t" args: "int" "const void " "size_t" }
+ syscall_nr_write = 4;
+ { syscall: "open" ret: "int" args: "const char " "int" "..." }
+ syscall_nr_open = 5;
+ { syscall: "close" ret: "int" args: "int" }
+ syscall_nr_close = 6;
+ { syscall: "wait4" ret: "int" args: "int" "int " "int" "struct rusage " }
+ syscall_nr_wait4 = 7;
+ syscall_nr_compat_43_ocreat = 8;
+ { syscall: "link" ret: "int" args: "const char " "const char " }
+ syscall_nr_link = 9;
+ { syscall: "unlink" ret: "int" args: "const char " }
+ syscall_nr_unlink = 10;
+ { 11 is obsolete execv }
+ { syscall: "chdir" ret: "int" args: "const char " }
+ syscall_nr_chdir = 12;
+ { syscall: "fchdir" ret: "int" args: "int" }
+ syscall_nr_fchdir = 13;
+ { syscall: "mknod" ret: "int" args: "const char " "mode_t" "dev_t" }
+ syscall_nr_mknod = 14;
+ { syscall: "chmod" ret: "int" args: "const char " "mode_t" }
+ syscall_nr_chmod = 15;
+ { syscall: "chown" ret: "int" args: "const char " "uid_t" "gid_t" }
+ syscall_nr_chown = 16;
+ { syscall: "break" ret: "int" args: "char " }
+ syscall_nr_break = 17;
+ { syscall: "getfsstat" ret: "int" args: "struct statfs " "long" "int" }
+ syscall_nr_getfsstat = 18;
+ syscall_nr_compat_43_olseek = 19;
+ { syscall: "getpid" ret: "pid_t" args: }
+ syscall_nr_getpid = 20;
+ { syscall: "mount" ret: "int" args: "const char " "const char " "int" "void " }
+ syscall_nr_mount = 21;
+ { syscall: "unmount" ret: "int" args: "const char " "int" }
+ syscall_nr_unmount = 22;
+ { syscall: "setuid" ret: "int" args: "uid_t" }
+ syscall_nr_setuid = 23;
+ { syscall: "getuid" ret: "uid_t" args: }
+ syscall_nr_getuid = 24;
+ { syscall: "geteuid" ret: "uid_t" args: }
+ syscall_nr_geteuid = 25;
+ { syscall: "ptrace" ret: "int" args: "int" "pid_t" "caddr_t" "int" }
+ syscall_nr_ptrace = 26;
+ { syscall: "recvmsg" ret: "ssize_t" args: "int" "struct msghdr " "int" }
+ syscall_nr_recvmsg = 27;
+ { syscall: "sendmsg" ret: "ssize_t" args: "int" "const struct msghdr " "int" }
+ syscall_nr_sendmsg = 28;
+ { syscall: "recvfrom" ret: "ssize_t" args: "int" "void " "size_t" "int" "struct sockaddr " "unsigned int " }
+ syscall_nr_recvfrom = 29;
+ { syscall: "accept" ret: "int" args: "int" "struct sockaddr " "unsigned int " }
+ syscall_nr_accept = 30;
+ { syscall: "getpeername" ret: "int" args: "int" "struct sockaddr " "unsigned int " }
+ syscall_nr_getpeername = 31;
+ { syscall: "getsockname" ret: "int" args: "int" "struct sockaddr " "unsigned int " }
+ syscall_nr_getsockname = 32;
+ { syscall: "access" ret: "int" args: "const char " "int" }
+ syscall_nr_access = 33;
+ { syscall: "chflags" ret: "int" args: "const char " "u_long" }
+ syscall_nr_chflags = 34;
+ { syscall: "fchflags" ret: "int" args: "int" "u_long" }
+ syscall_nr_fchflags = 35;
+ { syscall: "sync" ret: "void" args: }
+ syscall_nr_sync = 36;
+ { syscall: "kill" ret: "int" args: "int" "int" }
+ syscall_nr_kill = 37;
+ syscall_nr_compat_43_stat43 = 38;
+ { syscall: "getppid" ret: "pid_t" args: }
+ syscall_nr_getppid = 39;
+ syscall_nr_compat_43_lstat43 = 40;
+ { syscall: "dup" ret: "int" args: "int" }
+ syscall_nr_dup = 41;
+ { syscall: "pipe" ret: "int" args: }
+ syscall_nr_pipe = 42;
+ { syscall: "getegid" ret: "gid_t" args: }
+ syscall_nr_getegid = 43;
+ { syscall: "profil" ret: "int" args: "caddr_t" "size_t" "u_long" "u_int" }
+ syscall_nr_profil = 44;
+ { syscall: "ktrace" ret: "int" args: "const char " "int" "int" "int" }
+ syscall_nr_ktrace = 45;
+ { 45 is excluded ktrace }
+ syscall_nr_compat_13_sigaction13 = 46;
+ { syscall: "getgid" ret: "gid_t" args: }
+ syscall_nr_getgid = 47;
+ syscall_nr_compat_13_sigprocmask13 = 48;
+ { syscall: "__getlogin" ret: "int" args: "char " "size_t" }
+ syscall_nr___getlogin = 49;
+ { syscall: "setlogin" ret: "int" args: "const char " }
+ syscall_nr_setlogin = 50;
+ { syscall: "acct" ret: "int" args: "const char " }
+ syscall_nr_acct = 51;
+ syscall_nr_compat_13_sigpending13 = 52;
+ syscall_nr_compat_13_sigaltstack13 = 53;
+ { syscall: "ioctl" ret: "int" args: "int" "u_long" "..." }
+ syscall_nr_ioctl = 54;
+ syscall_nr_compat_12_oreboot = 55;
+ { syscall: "revoke" ret: "int" args: "const char " }
+ syscall_nr_revoke = 56;
+ { syscall: "symlink" ret: "int" args: "const char " "const char " }
+ syscall_nr_symlink = 57;
+ { syscall: "readlink" ret: "int" args: "const char " "char " "size_t" }
+ syscall_nr_readlink = 58;
+ { syscall: "execve" ret: "int" args: "const char " "char const " "char const " }
+ syscall_nr_execve = 59;
+ { syscall: "umask" ret: "mode_t" args: "mode_t" }
+ syscall_nr_umask = 60;
+ { syscall: "chroot" ret: "int" args: "const char " }
+ syscall_nr_chroot = 61;
+ syscall_nr_compat_43_fstat43 = 62;
+ syscall_nr_compat_43_ogetkerninfo = 63;
+ syscall_nr_compat_43_ogetpagesize = 64;
+ syscall_nr_compat_12_msync = 65;
+ { syscall: "vfork" ret: "int" args: }
+ syscall_nr_vfork = 66;
+ { 67 is obsolete vread }
+ { 68 is obsolete vwrite }
+ { syscall: "sbrk" ret: "int" args: "intptr_t" }
+ syscall_nr_sbrk = 69;
+ { syscall: "sstk" ret: "int" args: "int" }
+ syscall_nr_sstk = 70;
+ syscall_nr_compat_43_ommap = 71;
+ { syscall: "vadvise" ret: "int" args: "int" }
+ syscall_nr_vadvise = 72;
+ { syscall: "munmap" ret: "int" args: "void " "size_t" }
+ syscall_nr_munmap = 73;
+ { syscall: "mprotect" ret: "int" args: "void " "size_t" "int" }
+ syscall_nr_mprotect = 74;
+ { syscall: "madvise" ret: "int" args: "void " "size_t" "int" }
+ syscall_nr_madvise = 75;
+ { 76 is obsolete vhangup }
+ { 77 is obsolete vlimit }
+ { syscall: "mincore" ret: "int" args: "void " "size_t" "char " }
+ syscall_nr_mincore = 78;
+ { syscall: "getgroups" ret: "int" args: "int" "gid_t " }
+ syscall_nr_getgroups = 79;
+ { syscall: "setgroups" ret: "int" args: "int" "const gid_t " }
+ syscall_nr_setgroups = 80;
+ { syscall: "getpgrp" ret: "int" args: }
+ syscall_nr_getpgrp = 81;
+ { syscall: "setpgid" ret: "int" args: "int" "int" }
+ syscall_nr_setpgid = 82;
+ { syscall: "setitimer" ret: "int" args: "int" "const struct itimerval " "struct itimerval " }
+ syscall_nr_setitimer = 83;
+ syscall_nr_compat_43_owait = 84;
+ syscall_nr_compat_12_oswapon = 85;
+ { syscall: "getitimer" ret: "int" args: "int" "struct itimerval " }
+ syscall_nr_getitimer = 86;
+ syscall_nr_compat_43_ogethostname = 87;
+ syscall_nr_compat_43_osethostname = 88;
+ syscall_nr_compat_43_ogetdtablesize = 89;
+ { syscall: "dup2" ret: "int" args: "int" "int" }
+ syscall_nr_dup2 = 90;
+ { syscall: "fcntl" ret: "int" args: "int" "int" "..." }
+ syscall_nr_fcntl = 92;
+ { syscall: "select" ret: "int" args: "int" "fd_set " "fd_set " "fd_set " "struct timeval " }
+ syscall_nr_select = 93;
+ { syscall: "fsync" ret: "int" args: "int" }
+ syscall_nr_fsync = 95;
+ { syscall: "setpriority" ret: "int" args: "int" "int" "int" }
+ syscall_nr_setpriority = 96;
+ { syscall: "socket" ret: "int" args: "int" "int" "int" }
+ syscall_nr_socket = 97;
+ { syscall: "connect" ret: "int" args: "int" "const struct sockaddr " "unsigned int" }
+ syscall_nr_connect = 98;
+ syscall_nr_compat_43_oaccept = 99;
+ { syscall: "getpriority" ret: "int" args: "int" "int" }
+ syscall_nr_getpriority = 100;
+ syscall_nr_compat_43_osend = 101;
+ syscall_nr_compat_43_orecv = 102;
+ syscall_nr_compat_13_sigreturn13 = 103;
+ { syscall: "bind" ret: "int" args: "int" "const struct sockaddr " "unsigned int" }
+ syscall_nr_bind = 104;
+ { syscall: "setsockopt" ret: "int" args: "int" "int" "int" "const void " "unsigned int" }
+ syscall_nr_setsockopt = 105;
+ { syscall: "listen" ret: "int" args: "int" "int" }
+ syscall_nr_listen = 106;
+ { 107 is obsolete vtimes }
+ syscall_nr_compat_43_osigvec = 108;
+ syscall_nr_compat_43_osigblock = 109;
+ syscall_nr_compat_43_osigsetmask = 110;
+ syscall_nr_compat_13_sigsuspend13 = 111;
+ syscall_nr_compat_43_osigstack = 112;
+ syscall_nr_compat_43_orecvmsg = 113;
+ syscall_nr_compat_43_osendmsg = 114;
+ { 115 is obsolete vtrace }
+ { syscall: "gettimeofday" ret: "int" args: "struct timeval " "struct timezone " }
+ syscall_nr_gettimeofday = 116;
+ { syscall: "getrusage" ret: "int" args: "int" "struct rusage " }
+ syscall_nr_getrusage = 117;
+ { syscall: "getsockopt" ret: "int" args: "int" "int" "int" "void " "unsigned int " }
+ syscall_nr_getsockopt = 118;
+ { 119 is obsolete resuba }
+ { syscall: "readv" ret: "ssize_t" args: "int" "const struct iovec " "int" }
+ syscall_nr_readv = 120;
+ { syscall: "writev" ret: "ssize_t" args: "int" "const struct iovec " "int" }
+ syscall_nr_writev = 121;
+ { syscall: "settimeofday" ret: "int" args: "const struct timeval " "const struct timezone " }
+ syscall_nr_settimeofday = 122;
+ { syscall: "fchown" ret: "int" args: "int" "uid_t" "gid_t" }
+ syscall_nr_fchown = 123;
+ { syscall: "fchmod" ret: "int" args: "int" "mode_t" }
+ syscall_nr_fchmod = 124;
+ syscall_nr_compat_43_orecvfrom = 125;
+ { syscall: "setreuid" ret: "int" args: "uid_t" "uid_t" }
+ syscall_nr_setreuid = 126;
+ { syscall: "setregid" ret: "int" args: "gid_t" "gid_t" }
+ syscall_nr_setregid = 127;
+ { syscall: "rename" ret: "int" args: "const char " "const char " }
+ syscall_nr_rename = 128;
+ syscall_nr_compat_43_otruncate = 129;
+ syscall_nr_compat_43_oftruncate = 130;
+ { syscall: "flock" ret: "int" args: "int" "int" }
+ syscall_nr_flock = 131;
+ { syscall: "mkfifo" ret: "int" args: "const char " "mode_t" }
+ syscall_nr_mkfifo = 132;
+ { syscall: "sendto" ret: "ssize_t" args: "int" "const void " "size_t" "int" "const struct sockaddr " "unsigned int" }
+ syscall_nr_sendto = 133;
+ { syscall: "shutdown" ret: "int" args: "int" "int" }
+ syscall_nr_shutdown = 134;
+ { syscall: "socketpair" ret: "int" args: "int" "int" "int" "int " }
+ syscall_nr_socketpair = 135;
+ { syscall: "mkdir" ret: "int" args: "const char " "mode_t" }
+ syscall_nr_mkdir = 136;
+ { syscall: "rmdir" ret: "int" args: "const char " }
+ syscall_nr_rmdir = 137;
+ { syscall: "utimes" ret: "int" args: "const char " "const struct timeval " }
+ syscall_nr_utimes = 138;
+ { 139 is obsolete 4.2 sigreturn }
+ { syscall: "adjtime" ret: "int" args: "const struct timeval " "struct timeval " }
+ syscall_nr_adjtime = 140;
+ syscall_nr_compat_43_ogetpeername = 141;
+ syscall_nr_compat_43_ogethostid = 142;
+ syscall_nr_compat_43_osethostid = 143;
+ syscall_nr_compat_43_ogetrlimit = 144;
+ syscall_nr_compat_43_osetrlimit = 145;
+ syscall_nr_compat_43_okillpg = 146;
+ { syscall: "setsid" ret: "int" args: }
+ syscall_nr_setsid = 147;
+ { syscall: "quotactl" ret: "int" args: "const char " "int" "int" "caddr_t" }
+ syscall_nr_quotactl = 148;
+ syscall_nr_compat_43_oquota = 149;
+ syscall_nr_compat_43_ogetsockname = 150;
+ { syscall: "nfssvc" ret: "int" args: "int" "void " }
+ syscall_nr_nfssvc = 155;
+ { 155 is excluded nfssvc }
+ syscall_nr_compat_43_ogetdirentries = 156;
+ { syscall: "statfs" ret: "int" args: "const char " "struct statfs " }
+ syscall_nr_statfs = 157;
+ { syscall: "fstatfs" ret: "int" args: "int" "struct statfs " }
+ syscall_nr_fstatfs = 158;
+ { syscall: "getfh" ret: "int" args: "const char " "fhandle_t " }
+ syscall_nr_getfh = 161;
+ syscall_nr_compat_09_ogetdomainname = 162;
+ syscall_nr_compat_09_osetdomainname = 163;
+ syscall_nr_compat_09_ouname = 164;
+ { syscall: "sysarch" ret: "int" args: "int" "void " }
+ syscall_nr_sysarch = 165;
+ syscall_nr_compat_10_osemsys = 169;
+ { 169 is excluded 1.0 semsys }
+ syscall_nr_compat_10_omsgsys = 170;
+ { 170 is excluded 1.0 msgsys }
+ syscall_nr_compat_10_oshmsys = 171;
+ { 171 is excluded 1.0 shmsys }
+ { syscall: "pread" ret: "ssize_t" args: "int" "void " "size_t" "int" "off_t" }
+ syscall_nr_pread = 173;
+ { syscall: "pwrite" ret: "ssize_t" args: "int" "const void " "size_t" "int" "off_t" }
+ syscall_nr_pwrite = 174;
+ { syscall: "ntp_gettime" ret: "int" args: "struct ntptimeval " }
+ syscall_nr_ntp_gettime = 175;
+ { syscall: "ntp_adjtime" ret: "int" args: "struct timex " }
+ syscall_nr_ntp_adjtime = 176;
+ { 176 is excluded ntp_adjtime }
+ { syscall: "setgid" ret: "int" args: "gid_t" }
+ syscall_nr_setgid = 181;
+ { syscall: "setegid" ret: "int" args: "gid_t" }
+ syscall_nr_setegid = 182;
+ { syscall: "seteuid" ret: "int" args: "uid_t" }
+ syscall_nr_seteuid = 183;
+ { syscall: "lfs_bmapv" ret: "int" args: "fsid_t " "struct block_info " "int" }
+ syscall_nr_lfs_bmapv = 184;
+ { syscall: "lfs_markv" ret: "int" args: "fsid_t " "struct block_info " "int" }
+ syscall_nr_lfs_markv = 185;
+ { syscall: "lfs_segclean" ret: "int" args: "fsid_t " "u_long" }
+ syscall_nr_lfs_segclean = 186;
+ { syscall: "lfs_segwait" ret: "int" args: "fsid_t " "struct timeval " }
+ syscall_nr_lfs_segwait = 187;
+ { 184 is excluded lfs_bmapv }
+ { 185 is excluded lfs_markv }
+ { 186 is excluded lfs_segclean }
+ { 187 is excluded lfs_segwait }
+ syscall_nr_compat_12_stat12 = 188;
+ syscall_nr_compat_12_fstat12 = 189;
+ syscall_nr_compat_12_lstat12 = 190;
+ { syscall: "pathconf" ret: "long" args: "const char " "int" }
+ syscall_nr_pathconf = 191;
+ { syscall: "fpathconf" ret: "long" args: "int" "int" }
+ syscall_nr_fpathconf = 192;
+ { syscall: "getrlimit" ret: "int" args: "int" "struct rlimit " }
+ syscall_nr_getrlimit = 194;
+ { syscall: "setrlimit" ret: "int" args: "int" "const struct rlimit " }
+ syscall_nr_setrlimit = 195;
+ syscall_nr_compat_12_getdirentries = 196;
+ { syscall: "mmap" ret: "void " args: "void " "size_t" "int" "int" "int" "long" "off_t" }
+ syscall_nr_mmap = 197;
+ { syscall: "__syscall" ret: "quad_t" args: "quad_t" "..." }
+ syscall_nr___syscall = 198;
+ { syscall: "lseek" ret: "off_t" args: "int" "int" "off_t" "int" }
+ syscall_nr_lseek = 199;
+ { syscall: "truncate" ret: "int" args: "const char " "int" "off_t" }
+ syscall_nr_truncate = 200;
+ { syscall: "ftruncate" ret: "int" args: "int" "int" "off_t" }
+ syscall_nr_ftruncate = 201;
+ { syscall: "__sysctl" ret: "int" args: "int " "u_int" "void " "size_t " "void " "size_t" }
+ syscall_nr___sysctl = 202;
+ { syscall: "mlock" ret: "int" args: "const void " "size_t" }
+ syscall_nr_mlock = 203;
+ { syscall: "munlock" ret: "int" args: "const void " "size_t" }
+ syscall_nr_munlock = 204;
+ { syscall: "undelete" ret: "int" args: "const char " }
+ syscall_nr_undelete = 205;
+ { syscall: "futimes" ret: "int" args: "int" "const struct timeval " }
+ syscall_nr_futimes = 206;
+ { syscall: "getpgid" ret: "pid_t" args: "pid_t" }
+ syscall_nr_getpgid = 207;
+ { syscall: "reboot" ret: "int" args: "int" "char " }
+ syscall_nr_reboot = 208;
+ { syscall: "poll" ret: "int" args: "struct pollfd " "u_int" "int" }
+ syscall_nr_poll = 209;
+ { 210 is excluded lkmnosys }
+ { 211 is excluded lkmnosys }
+ { 212 is excluded lkmnosys }
+ { 213 is excluded lkmnosys }
+ { 214 is excluded lkmnosys }
+ { 215 is excluded lkmnosys }
+ { 216 is excluded lkmnosys }
+ { 217 is excluded lkmnosys }
+ { 218 is excluded lkmnosys }
+ { 219 is excluded lkmnosys }
+ syscall_nr_compat_14___semctl = 220;
+ { syscall: "semget" ret: "int" args: "key_t" "int" "int" }
+ syscall_nr_semget = 221;
+ { syscall: "semop" ret: "int" args: "int" "struct sembuf " "size_t" }
+ syscall_nr_semop = 222;
+ { syscall: "semconfig" ret: "int" args: "int" }
+ syscall_nr_semconfig = 223;
+ { 220 is excluded compat_14_semctl }
+ { 221 is excluded semget }
+ { 222 is excluded semop }
+ { 223 is excluded semconfig }
+ syscall_nr_compat_14_msgctl = 224;
+ { syscall: "msgget" ret: "int" args: "key_t" "int" }
+ syscall_nr_msgget = 225;
+ { syscall: "msgsnd" ret: "int" args: "int" "const void " "size_t" "int" }
+ syscall_nr_msgsnd = 226;
+ { syscall: "msgrcv" ret: "ssize_t" args: "int" "void " "size_t" "long" "int" }
+ syscall_nr_msgrcv = 227;
+ { 224 is excluded compat_14_msgctl }
+ { 225 is excluded msgget }
+ { 226 is excluded msgsnd }
+ { 227 is excluded msgrcv }
+ { syscall: "shmat" ret: "void " args: "int" "const void " "int" }
+ syscall_nr_shmat = 228;
+ syscall_nr_compat_14_shmctl = 229;
+ { syscall: "shmdt" ret: "int" args: "const void " }
+ syscall_nr_shmdt = 230;
+ { syscall: "shmget" ret: "int" args: "key_t" "size_t" "int" }
+ syscall_nr_shmget = 231;
+ { 228 is excluded shmat }
+ { 229 is excluded compat_14_shmctl }
+ { 230 is excluded shmdt }
+ { 231 is excluded shmget }
+ { syscall: "clock_gettime" ret: "int" args: "clockid_t" "struct timespec " }
+ syscall_nr_clock_gettime = 232;
+ { syscall: "clock_settime" ret: "int" args: "clockid_t" "const struct timespec " }
+ syscall_nr_clock_settime = 233;
+ { syscall: "clock_getres" ret: "int" args: "clockid_t" "struct timespec " }
+ syscall_nr_clock_getres = 234;
+ { syscall: "nanosleep" ret: "int" args: "const struct timespec " "struct timespec " }
+ syscall_nr_nanosleep = 240;
+ { syscall: "fdatasync" ret: "int" args: "int" }
+ syscall_nr_fdatasync = 241;
+ { syscall: "mlockall" ret: "int" args: "int" }
+ syscall_nr_mlockall = 242;
+ { syscall: "munlockall" ret: "int" args: }
+ syscall_nr_munlockall = 243;
+ { syscall: "__posix_rename" ret: "int" args: "const char " "const char " }
+ syscall_nr___posix_rename = 270;
+ { syscall: "swapctl" ret: "int" args: "int" "const void " "int" }
+ syscall_nr_swapctl = 271;
+ { syscall: "getdents" ret: "int" args: "int" "char " "size_t" }
+ syscall_nr_getdents = 272;
+ { syscall: "minherit" ret: "int" args: "void " "size_t" "int" }
+ syscall_nr_minherit = 273;
+ { syscall: "lchmod" ret: "int" args: "const char " "mode_t" }
+ syscall_nr_lchmod = 274;
+ { syscall: "lchown" ret: "int" args: "const char " "uid_t" "gid_t" }
+ syscall_nr_lchown = 275;
+ { syscall: "lutimes" ret: "int" args: "const char " "const struct timeval " }
+ syscall_nr_lutimes = 276;
+ { syscall: "__msync13" ret: "int" args: "void " "size_t" "int" }
+ syscall_nr___msync13 = 277;
+ { syscall: "__stat13" ret: "int" args: "const char " "struct stat " }
+ syscall_nr___stat13 = 278;
+ { syscall: "__fstat13" ret: "int" args: "int" "struct stat " }
+ syscall_nr___fstat13 = 279;
+ { syscall: "__lstat13" ret: "int" args: "const char " "struct stat " }
+ syscall_nr___lstat13 = 280;
+ { syscall: "__sigaltstack14" ret: "int" args: "const struct sigaltstack " "struct sigaltstack " }
+ syscall_nr___sigaltstack14 = 281;
+ { syscall: "__vfork14" ret: "int" args: }
+ syscall_nr___vfork14 = 282;
+ { syscall: "__posix_chown" ret: "int" args: "const char " "uid_t" "gid_t" }
+ syscall_nr___posix_chown = 283;
+ { syscall: "__posix_fchown" ret: "int" args: "int" "uid_t" "gid_t" }
+ syscall_nr___posix_fchown = 284;
+ { syscall: "__posix_lchown" ret: "int" args: "const char " "uid_t" "gid_t" }
+ syscall_nr___posix_lchown = 285;
+ { syscall: "getsid" ret: "pid_t" args: "pid_t" }
+ syscall_nr_getsid = 286;
+ { syscall: "__clone" ret: "pid_t" args: "int" "void " }
+ syscall_nr___clone = 287;
+ { syscall: "fktrace" ret: "int" args: "const int" "int" "int" "int" }
+ syscall_nr_fktrace = 288;
+ { 288 is excluded ktrace }
+ { syscall: "preadv" ret: "ssize_t" args: "int" "const struct iovec " "int" "int" "off_t" }
+ syscall_nr_preadv = 289;
+ { syscall: "pwritev" ret: "ssize_t" args: "int" "const struct iovec " "int" "int" "off_t" }
+ syscall_nr_pwritev = 290;
+ { syscall: "__sigaction14" ret: "int" args: "int" "const struct sigaction " "struct sigaction " }
+ syscall_nr___sigaction14 = 291;
+ { syscall: "__sigpending14" ret: "int" args: "sigset_t " }
+ syscall_nr___sigpending14 = 292;
+ { syscall: "__sigprocmask14" ret: "int" args: "int" "const sigset_t " "sigset_t " }
+ syscall_nr___sigprocmask14 = 293;
+ { syscall: "__sigsuspend14" ret: "int" args: "const sigset_t " }
+ syscall_nr___sigsuspend14 = 294;
+ { syscall: "__sigreturn14" ret: "int" args: "struct sigcontext " }
+ syscall_nr___sigreturn14 = 295;
+ { syscall: "__getcwd" ret: "int" args: "char " "size_t" }
+ syscall_nr___getcwd = 296;
+ { syscall: "fchroot" ret: "int" args: "int" }
+ syscall_nr_fchroot = 297;
+ { syscall: "fhopen" ret: "int" args: "const fhandle_t " "int" }
+ syscall_nr_fhopen = 298;
+ { syscall: "fhstat" ret: "int" args: "const fhandle_t " "struct stat " }
+ syscall_nr_fhstat = 299;
+ { syscall: "fhstatfs" ret: "int" args: "const fhandle_t " "struct statfs " }
+ syscall_nr_fhstatfs = 300;
+ { syscall: "____semctl13" ret: "int" args: "int" "int" "int" "..." }
+ syscall_nr_____semctl13 = 301;
+ { 301 is excluded ____semctl13 }
+ { syscall: "__msgctl13" ret: "int" args: "int" "int" "struct msqid_ds " }
+ syscall_nr___msgctl13 = 302;
+ { 302 is excluded __msgctl13 }
+ { syscall: "__shmctl13" ret: "int" args: "int" "int" "struct shmid_ds " }
+ syscall_nr___shmctl13 = 303;
+ { 303 is excluded __shmctl13 }
+ { syscall: "lchflags" ret: "int" args: "const char " "u_long" }
+ syscall_nr_lchflags = 304;
+ { syscall: "issetugid" ret: "int" args: }
+ syscall_nr_issetugid = 305;
+ { syscall: "utrace" ret: "int" args: "const char " "void " "size_t" }
+ syscall_nr_utrace = 306;
+ syscall_nr_MAXSYSCALL = 340;
+ syscall_nr_NSYSENT = 512;
+
+
+{ More or less checked BSD syscalls }
+{ I checked the values of these constant
+ and removed those who are equal
+ and added some equivalents, unchecked PM }
+
+{ syscall_nr_compat_12_fstat12 = 189 }
+{ syscall_nr___fstat13 = 279 }
+ syscall_nr_fstat = syscall_nr___fstat13;
+{ syscall_nr_compat_12_lstat12 = 190 }
+{ syscall_nr___lstat13 = 280 }
+ syscall_nr_lstat = syscall_nr___lstat13;
+{ syscall_nr_sigaction = 342; MISSING }
+{ syscall: "__sigaction14" ret: "int" args: "int" "const struct sigaction " "struct sigaction " }
+ syscall_nr_sigaction = syscall_nr___sigaction14;
+{ syscall_nr_sigpending = 343; MISSING }
+{ syscall: "__sigpending14" ret: "int" args: "sigset_t " }
+ syscall_nr_sigpending = syscall_nr___sigpending14;
+{ syscall_nr_sigprocmask = 340; MISSING }
+{ syscall: "__sigprocmask14" ret: "int" args: "int" "const sigset_t " "sigset_t " }
+ syscall_nr_sigprocmask = syscall_nr___sigprocmask14;
+{ syscall_nr_sigsuspend = 341; MISSING }
+{ syscall: "__sigsuspend14" ret: "int" args: "const sigset_t " }
+ syscall_nr_sigsuspend = syscall_nr___sigsuspend14;
+{ syscall: "__sigreturn14" ret: "int" args: "struct sigcontext " }
+ syscall_nr_sigreturn = syscall_nr___sigreturn14;
+{ Note: syscall_nr_sigreturn was not on the checked list for FreeBSD }
+
+{ syscall_nr_compat_12_stat12 = 188; }
+{ syscall_nr___stat13 = 278 }
+ syscall_nr_stat = syscall_nr___stat13;
+{ syscall_nr_wait4 = 7 }
+ syscall_nr_waitpid = syscall_nr_wait4;
+{ This one seems to be missing !!!!
+ syscall_nr_rfork = 251;}
+{$define FPC_HAS_NO_SYSCALL_NR_RFORK }
+{ syscall_nr_compat_12_getdirentries = 196 }
+ syscall_nr_getdirentries = syscall_nr_compat_12_getdirentries;
+
+{
+ $Log: sysnr.inc,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/sysofft.inc b/rtl/netbsd/sysofft.inc
new file mode 100644
index 0000000000..aa81929aea
--- /dev/null
+++ b/rtl/netbsd/sysofft.inc
@@ -0,0 +1,108 @@
+
+
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; assembler; [public, alias : 'FPC_SYSC_LSEEK'];
+
+asm
+ stwu r1,-16(r1)
+ mflr r0
+ stw r0,20(r1)
+ mr r11,r4
+ mr r12,r5
+ mr r5,r3
+ mr r9,r6
+ li r3,0
+ mr r7,r11
+ mr r8,r12
+ li r6,0
+ li r4,199
+// crclr cr1*4+eq
+ crxor 6,6,6
+ li r0,198
+ sc
+ bso .Lcerrorlseek
+// mr r0,r3
+// mr r3,r4
+// mr r4,r0
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+ blr
+.Lcerrorlseek:
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ li r4,-1
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+end;
+
+function Fpftruncate(fd : cint; flength : off_t): cint; assembler; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+
+asm
+stwu r1,-16(r1)
+mflr r0
+stw r0,20(r1)
+mr r7,r5
+mr r8,r6
+mr r5,r3
+li r3,0
+li r4,201
+li r6,0
+
+//crclr cr1*4+eq
+crxor 6,6,6
+li r0,198
+sc
+bso .Lcerrortrunc
+mr r4,r3
+lwz r0,20(r1)
+mtlr r0
+addi r1,r1,16
+blr
+.Lcerrortrunc:
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+end;
+
+Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; assembler; [public, alias: 'FPC_SYSC_MMAP'];
+
+//Function Fpmmap(adr,len,prot,flags,fdes,off:longint):longint; assembler; [public, alias : 'FPC_SYSC_MMAP'];
+
+asm
+ stwu r1,-16(r1)
+ mflr r0
+ stw r0,20(r1)
+ mr r0,r5
+ mr r8,r6
+ stw r9,8(r1)
+ stw r10,12(r1)
+ mr r5,r3
+ mr r6,r4
+ mr r9,r7
+ li r3,0
+ mr r7,r0
+ li r4,197
+ li r10,0
+// crclr cr1*4+eq
+ crxor 6,6,6
+ li r0,198
+ sc
+ bso .Lcerrormmap
+ mr r4,r3
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+ blr
+.Lcerrormmap:
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+end;
diff --git a/rtl/netbsd/systypes.inc b/rtl/netbsd/systypes.inc
new file mode 100644
index 0000000000..3f36141fd3
--- /dev/null
+++ b/rtl/netbsd/systypes.inc
@@ -0,0 +1,43 @@
+{
+ $Id: systypes.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+type
+
+ TStatfs = packed record
+ spare2, { place holder}
+ bsize, { fundamental block size}
+ iosize, { optimal block size }
+ blocks, { total blocks}
+ bfree, { blocks free}
+ bavail, { block available for mortal users}
+ files, { Total file nodes}
+ ffree : longint; { file nodes free}
+ fsid : array[0..1] of longint;
+ fowner : longint; {mounter uid}
+ ftype : longint;
+ fflags : longint; {copy of mount flags}
+ spare : array [0..1] of longint; { For later use }
+ fstypename : array[0..15] of char;
+ mountpoint : array[0..89] of char;
+ mnfromname : array[0..89] of char;
+ end;
+ PStatFS=^TStatFS;
+
+
+{
+ $Log: systypes.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/termio.pp b/rtl/netbsd/termio.pp
new file mode 100644
index 0000000000..d6909a8bbe
--- /dev/null
+++ b/rtl/netbsd/termio.pp
@@ -0,0 +1,49 @@
+{
+ $Id: termio.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains the termios interface.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit termio;
+
+interface
+
+Uses BaseUnix; // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.
+
+{
+ $Log: termio.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/termios.inc b/rtl/netbsd/termios.inc
new file mode 100644
index 0000000000..ac9d715649
--- /dev/null
+++ b/rtl/netbsd/termios.inc
@@ -0,0 +1,371 @@
+{
+ $Id: termios.inc,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Termios header for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+CONST
+
+{
+ * Special Control Characters
+ *
+ * Index into c_cc[] character array.
+ *
+ * Name Subscript Enabled by
+ }
+ VEOF =0;
+ VEOL =1;
+ VEOL2 =2;
+ VERASE =3;
+ VWERASE =4;
+ VKILL =5;
+ VREPRINT =6;
+{ =7; spare 1 }
+ VINTR =8;
+ VQUIT =9;
+ VSUSP =10;
+ VDSUSP =11;
+ VSTART =12;
+ VSTOP =13;
+ VLNEXT =14;
+ VDISCARD =15;
+ VMIN =16;
+ VTIME =17;
+ VSTATUS =18;
+{ =19 spare 2 }
+ NCCS =20;
+
+Type
+ winsize = packed record
+ ws_row,
+ ws_col,
+ ws_xpixel,
+ ws_ypixel : word;
+ end;
+ TWinSize=winsize;
+
+
+type
+ Termios = packed record
+ c_iflag,
+ c_oflag,
+ c_cflag,
+ c_lflag : longint;
+ c_line : char;
+ c_cc : array[0..NCCS-1] of byte;
+ {$IFDEF BSD}
+ c_ispeed,
+ c_ospeed : longint;
+ {$endif}
+ end;
+ TTermios=Termios;
+
+CONST
+
+
+ POSIX_VDISABLE=Chr($ff);
+{
+
+#define CCEQ(val, c) ((c) == (val) ? (val) != _POSIX_VDISABLE : 0)
+}
+
+{ * Input flags - software input processing}
+
+ IGNBRK = $1; { ignore BREAK condition }
+ BRKINT = $2; { map BREAK to SIGINTR }
+ IGNPAR = $4; { ignore (discard) parity errors }
+ PARMRK = $8; { mark parity and framing errors }
+ INPCK = $10; { enable checking of parity errors }
+ ISTRIP = $20; { strip 8th bit off chars }
+ INLCR = $40; { map NL into CR }
+ IGNCR = $80; { ignore CR }
+ ICRNL = $100; { map CR to NL (ala CRMOD) }
+ IXON = $200; { enable output flow control }
+ IXOFF = $400; { enable input flow control }
+ IXANY = $800; { any char will restart after stop }
+ IMAXBEL = $2000; { ring bell on input queue full }
+
+{
+ * Output flags - software output processing
+}
+ OPOST = $1; { enable following output processing }
+ ONLCR = $2; { map NL to CR-NL (ala CRMOD) }
+ OXTABS = $4; { expand tabs to spaces }
+ ONOEOT = $8; { discard EOT's (^D) on output) }
+
+{
+ * Control flags - hardware control of terminal
+}
+ CIGNORE = $1; { ignore control flags }
+ CSIZE = $300; { character size mask }
+ CS5 = $0; { 5 bits (pseudo) }
+ CS6 = $100; { 6 bits }
+ CS7 = $200; { 7 bits }
+ CS8 = $300; { 8 bits }
+ CSTOPB = $400; { send 2 stop bits }
+ CREAD = $800; { enable receiver }
+ PARENB = $1000; { parity enable }
+ PARODD = $2000; { odd parity, else even }
+ HUPCL = $4000; { hang up on last close }
+ CLOCAL = $8000; { ignore modem status lines }
+ CCTS_OFLOW = $10000; { CTS flow control of output }
+ CRTS_IFLOW = $20000; { RTS flow control of input }
+ CRTSCTS = (CCTS_OFLOW or CRTS_IFLOW);
+ CDTR_IFLOW = $40000; { DTR flow control of input }
+ CDSR_OFLOW = $80000; { DSR flow control of output }
+ CCAR_OFLOW = $100000; { DCD flow control of output }
+ MDMBUF = $100000; { old name for CCAR_OFLOW }
+
+{
+ * "Local" flags - dumping ground for other state
+ *
+ * Warning: some flags in this structure begin with
+ * the letter "I" and look like they belong in the
+ * input flag.
+ }
+
+ ECHOKE = $1; { visual erase for line kill }
+ ECHOE = $2; { visually erase chars }
+ ECHOK = $4; { echo NL after line kill }
+ ECHO = $8; { enable echoing }
+ ECHONL = $10; { echo NL even if ECHO is off }
+ ECHOPRT = $20; { visual erase mode for hardcopy }
+ ECHOCTL = $40; { echo control chars as ^(Char) }
+ ISIG = $80; { enable signals INTR, QUIT, [D]SUSP }
+ ICANON = $100; { canonicalize input lines }
+ ALTWERASE = $200; { use alternate WERASE algorithm }
+ IEXTEN = $400; { enable DISCARD and LNEXT }
+ EXTPROC = $800; { external processing }
+ TOSTOP = $400000; { stop background jobs from output }
+ FLUSHO = $800000; { output being flushed (state) }
+ NOKERNINFO = $2000000; { no kernel output from VSTATUS }
+ PENDIN =$20000000; { XXX retype pending input (state) }
+ NOFLSH =$80000000; { don't flush after interrupt }
+
+
+
+{
+ * Commands passed to tcsetattr() for setting the termios structure.
+}
+
+CONST
+
+ TCSANOW =0; { make change immediate }
+ TCSADRAIN =1; { drain output, then change }
+ TCSAFLUSH =2; { drain output, flush input }
+ TCSASOFT =$10; { flag - don't alter h.w. state }
+
+{
+ * Standard speeds
+}
+ B0 = 0;
+ B50 = 50;
+ B75 = 75;
+ B110 = 110;
+ B134 = 134;
+ B150 = 150;
+ B200 = 200;
+ B300 = 300;
+ B600 = 600;
+ B1200 = 1200;
+ B1800 = 1800;
+ B2400 = 2400;
+ B4800 = 4800;
+ B9600 = 9600;
+ B19200 = 19200;
+ B38400 = 38400;
+ B7200 = 7200;
+ B14400 = 14400;
+ B28800 = 28800;
+ B57600 = 57600;
+ B76800 = 76800;
+ B115200 =115200;
+ B230400 =230400;
+ EXTA = 19200;
+ EXTB = 38400;
+
+ TCIFLUSH =1;
+ TCOFLUSH =2;
+ TCIOFLUSH =3;
+ TCOOFF =1;
+ TCOON =2;
+ TCIOFF =3;
+ TCION =4;
+
+{
+#include <sys/cdefs.h>
+
+__BEGIN_DECLS
+speed_t cfgetispeed __P((const struct termios *));
+speed_t cfgetospeed __P((const struct termios *));
+int cfsetispeed __P((struct termios *, speed_t));
+int cfsetospeed __P((struct termios *, speed_t));
+int tcgetattr __P((int, struct termios *));
+int tcsetattr __P((int, int, const struct termios *));
+int tcdrain __P((int));
+int tcflow __P((int, int));
+int tcflush __P((int, int));
+int tcsendbreak __P((int, int));
+
+#ifndef _POSIX_SOURCE
+void cfmakeraw __P((struct termios *));
+int cfsetspeed __P((struct termios *, speed_t));
+#endif { !_POSIX_SOURCE }
+__END_DECLS
+
+#endif { !_KERNEL }
+
+
+
+struct winsize {
+ unsigned short ws_row; { rows, in characters }
+ unsigned short ws_col; { columns, in characters }
+ unsigned short ws_xpixel; { horizontal size, pixels }
+ unsigned short ws_ypixel; { vertical size, pixels }
+};
+
+}
+ IOCTLREAD = $40000000;
+ IOCTLWRITE = $80000000;
+ IOCTLVOID = $20000000;
+
+ TIOCMODG = IOCTLREAD+$47400+ 3; { get modem control state }
+ TIOCMODS = IOCTLWRITE+$47400+ 4; { set modem control state }
+ TIOCM_LE =$0001; { line enable }
+ TIOCM_DTR =$0002; { data terminal ready }
+ TIOCM_RTS =$0004; { request to send }
+ TIOCM_ST =$0010; { secondary transmit }
+ TIOCM_SR =$0020; { secondary receive }
+ TIOCM_CTS =$0040; { clear to send }
+ TIOCM_CAR =$0100; { carrier detect }
+ TIOCM_CD =TIOCM_CAR;
+ TIOCM_RNG =$0200; { ring }
+ TIOCM_RI =TIOCM_RNG;
+ TIOCM_DSR =$0400; { data set ready }
+ { 8-10 compat }
+ TIOCEXCL =IOCTLVOID+$7400+ 13; { set exclusive use of tty }
+ TIOCNXCL =IOCTLVOID+$7400+ 14; { reset exclusive use of tty }
+ { 15 unused }
+ TIOCFLUSH =IOCTLWRITE+$47400+ 16; { flush buffers }
+ { 17-18 compat }
+ TIOCGETA =IOCTLREAD+$2C7400+ 19; { get termios struct }
+ TIOCSETA =IOCTLWRITE+$2C7400+ 20; { set termios struct }
+ TIOCSETAW =IOCTLWRITE+$2C7400+ 21; { drain output, set }
+ TIOCSETAF =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
+ TIOCGETD =IOCTLREAD+$47400+ 26; { get line discipline }
+ TIOCSETD =IOCTLWRITE+$47400+ 27; { set line discipline }
+ { 127-124 compat }
+ TIOCSBRK =IOCTLVOID+$7400+ 123; { set break bit }
+ TIOCCBRK =IOCTLVOID+$7400+ 122; { clear break bit }
+ TIOCSDTR =IOCTLVOID+$7400+ 121; { set data terminal ready }
+ TIOCCDTR =IOCTLVOID+$7400+ 120; { clear data terminal ready }
+ TIOCGPGRP =IOCTLREAD+$47400+ 119; { get pgrp of tty }
+ TIOCSPGRP =IOCTLWRITE+$47400+ 118; { set pgrp of tty }
+ { 117-116 compat }
+ TIOCOUTQ =IOCTLREAD+$47400+ 115; { output queue size }
+ TIOCSTI =IOCTLWRITE+$17400+ 114; { simulate terminal input }
+ TIOCNOTTY =IOCTLVOID+$7400+ 113; { void tty association }
+ TIOCPKT =IOCTLWRITE+$47400+ 112; { pty: set/clear packet mode }
+ TIOCPKT_DATA =$00; { data packet }
+ TIOCPKT_FLUSHREAD =$01; { flush packet }
+ TIOCPKT_FLUSHWRITE =$02; { flush packet }
+ TIOCPKT_STOP =$04; { stop output }
+ TIOCPKT_START =$08; { start output }
+ TIOCPKT_NOSTOP =$10; { no more ^S, ^Q }
+ TIOCPKT_DOSTOP =$20; { now do ^S ^Q }
+ TIOCPKT_IOCTL =$40; { state change of pty driver }
+ TIOCSTOP =IOCTLVOID+$7400+ 111; { stop output, like ^S }
+ TIOCSTART =IOCTLVOID+$7400+ 110; { start output, like ^Q }
+ TIOCMSET =IOCTLWRITE+$47400+ 109; { set all modem bits }
+ TIOCMBIS =IOCTLWRITE+$47400+ 108; { bis modem bits }
+ TIOCMBIC =IOCTLWRITE+$47400+ 107; { bic modem bits }
+ TIOCMGET =IOCTLREAD+$47400+ 106; { get all modem bits }
+ TIOCREMOTE =IOCTLWRITE+$47400+ 105; { remote input editing }
+ TIOCGWINSZ =IOCTLREAD+$87400+ 104; { get window size }
+ TIOCSWINSZ =IOCTLWRITE+$87400+ 103; { set window size }
+ TIOCUCNTL =IOCTLWRITE+$47400+ 102; { pty: set/clr usr cntl mode }
+ TIOCSTAT =IOCTLVOID+$7400+ 101; { simulate ^T status message }
+ // UIOCCMD(n) _IO('u', n) { usr cntl op "n" }
+ TIOCCONS =IOCTLWRITE+$47400+ 98; { become virtual console }
+ TIOCSCTTY =IOCTLVOID+$7400+ 97; { become controlling tty }
+ TIOCEXT =IOCTLWRITE+$47400+ 96; { pty: external processing }
+ TIOCSIG =IOCTLVOID+$7400+ 95; { pty: generate signal }
+ TIOCDRAIN =IOCTLVOID+$7400+ 94; { wait till output drained }
+ TIOCMSDTRWAIT =IOCTLWRITE+$47400+ 91; { modem: set wait on close }
+ TIOCMGDTRWAIT =IOCTLREAD+$47400+ 90; { modem: get wait on close }
+ TIOCTIMESTAMP =IOCTLREAD+$87400+ 89; { enable/get timestamp
+ * of last input event }
+ TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
+ * of last DCd rise }
+ TIOCSDRAINWAIT =IOCTLWRITE+$47400+ 87; { set ttywait timeout }
+ TIOCGDRAINWAIT =IOCTLREAD+$47400+ 86; { get ttywait timeout }
+
+ TTYDISC =0; { termios tty line discipline }
+ SLIPDISC =4; { serial IP discipline }
+ PPPDISC =5; { PPP discipline }
+ NETGRAPHDISC =6; { Netgraph tty node discipline }
+
+
+{
+ * Defaults on "first" open.
+ }
+ TTYDEF_IFLAG =(BRKINT or ICRNL or IMAXBEL or IXON or IXANY);
+ TTYDEF_OFLAG =(OPOST or ONLCR);
+ TTYDEF_LFLAG =(ECHO or ICANON or ISIG or IEXTEN or ECHOE or ECHOKE or ECHOCTL);
+ TTYDEF_CFLAG =(CREAD or CS8 or HUPCL);
+ TTYDEF_SPEED =(B9600);
+
+
+
+{
+ * Control Character Defaults
+ }
+ CtrlMask = $1f; {\037}
+ CEOF =chr( ORD('d') and CtrlMask);
+ CEOL =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
+ CERASE =chr( $7F and CtrlMask);
+ CINTR =chr(ORD('c') and CtrlMask);
+ CSTATUS =chr(ORD('t') and CtrlMask);
+ CKILL =chr(ORD('u') and CtrlMask);
+ CMIN =chr(1);
+ CQUIT =chr(034 and CtrlMask); { FS, ^\ }
+ CSUSP =chr(ORD('z') and CtrlMask);
+ CTIME =chr(0);
+ CDSUSP =chr(ORD('y') and CtrlMask);
+ CSTART =chr(ORD('q') and CtrlMask);
+ CSTOP =chr(ORD('s') and CtrlMask);
+ CLNEXT =chr(ORD('v') and CtrlMask);
+ CDISCARD =chr(ORD('o') and CtrlMask);
+ CWERASE =chr(ORD('w') and CtrlMask);
+ CREPRINT =chr(ORD('r') and CtrlMask);
+ CEOT =CEOF;
+{ compat }
+ CBRK =CEOL;
+ CRPRNT =CREPRINT;
+ CFLUSH =CDISCARD;
+
+
+{
+ * TTYDEFCHARS to include an array of default control characters.
+}
+ ttydefchars : array[0..NCCS-1] OF char =(
+ CEOF, CEOL, CEOL, CERASE, CWERASE, CKILL, CREPRINT,
+ POSIX_VDISABLE, CINTR, CQUIT, CSUSP, CDSUSP, CSTART, CSTOP, CLNEXT,
+ CDISCARD, CMIN, CTIME, CSTATUS, POSIX_VDISABLE);
+
+{
+ $Log: termios.inc,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/termiosproc.inc b/rtl/netbsd/termiosproc.inc
new file mode 100644
index 0000000000..1723bec7a8
--- /dev/null
+++ b/rtl/netbsd/termiosproc.inc
@@ -0,0 +1,138 @@
+{
+ $Id: termiosproc.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Termios implementation for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{******************************************************************************
+ IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+ TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+end;
+
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+ nr:cint;
+begin
+ case OptAct of
+ TCSANOW : nr:=TIOCSETA;
+ TCSADRAIN : nr:=TIOCSETAW;
+ TCSAFLUSH : nr:=TIOCSETAF;
+ else
+ begin
+ fpsetErrNo(ESysEINVAL);
+ TCSetAttr:=-1;
+ exit;
+ end;
+ end;
+ TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ospeed:=speed;
+end;
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+ with tios do
+ begin
+ c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
+ PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+ IGNPAR));
+ c_iflag:=c_iflag OR IGNBRK;
+ c_oflag:=c_oflag and (not OPOST);
+ c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+ ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
+ c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+end;
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+ TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+end;
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+ TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+ TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+ TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+ case act OF
+ TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
+ TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,nil);
+ TCIOFF : {N/I}
+ end;
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+ TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
+end;
+
+Function IsATTY (Handle:cint):cint;
+{
+ Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+var
+ t : Termios;
+begin
+ IsAtty:=TCGetAttr(Handle,t);
+end;
+
+
+Function IsATTY(var f: text):cint;
+{
+ Idem as previous, only now for text variables.
+}
+begin
+ IsATTY:=IsaTTY(textrec(f).handle);
+end;
+
+{
+ $Log: termiosproc.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/tthread.inc b/rtl/netbsd/tthread.inc
new file mode 100644
index 0000000000..93d2e4a0d4
--- /dev/null
+++ b/rtl/netbsd/tthread.inc
@@ -0,0 +1,604 @@
+{
+ $Id: tthread.inc,v 1.5 2005/03/01 20:38:49 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ TThread implementation old (1.0) and new (pthreads) style
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{$IFDEF VER1_0} // leaving the old implementation in for now...
+type
+ PThreadRec=^TThreadRec;
+ TThreadRec=record
+ thread : TThread;
+ next : PThreadRec;
+ end;
+
+var
+ ThreadRoot : PThreadRec;
+ ThreadsInited : boolean;
+// MainThreadID: longint;
+
+Const
+ ThreadCount: longint = 0;
+
+function ThreadSelf:TThread;
+var
+ hp : PThreadRec;
+ sp : Pointer;
+begin
+ sp:=SPtr;
+ hp:=ThreadRoot;
+ while assigned(hp) do
+ begin
+ if (sp<=hp^.Thread.FStackPointer) and
+ (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+ begin
+ Result:=hp^.Thread;
+ exit;
+ end;
+ hp:=hp^.next;
+ end;
+ Result:=nil;
+end;
+
+
+//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
+procedure SIGCHLDHandler(Sig: longint); cdecl;
+
+begin
+ fpwaitpid(-1, nil, WNOHANG);
+end;
+
+procedure InitThreads;
+var
+ Act, OldAct: Baseunix.PSigActionRec;
+begin
+ ThreadRoot:=nil;
+ ThreadsInited:=true;
+
+
+// This will install SIGCHLD signal handler
+// signal() installs "one-shot" handler,
+// so it is better to install and set up handler with sigaction()
+
+ GetMem(Act, SizeOf(SigActionRec));
+ GetMem(OldAct, SizeOf(SigActionRec));
+
+ Act^.sa_handler := TSigAction(@SIGCHLDHandler);
+ Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
+ Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
+ FpSigAction(SIGCHLD, Act, OldAct);
+
+ FreeMem(Act, SizeOf(SigActionRec));
+ FreeMem(OldAct, SizeOf(SigActionRec));
+end;
+
+
+procedure DoneThreads;
+var
+ hp : PThreadRec;
+begin
+ while assigned(ThreadRoot) do
+ begin
+ ThreadRoot^.Thread.Destroy;
+ hp:=ThreadRoot;
+ ThreadRoot:=ThreadRoot^.Next;
+ dispose(hp);
+ end;
+ ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+ hp : PThreadRec;
+begin
+ { Need to initialize threads ? }
+ if not ThreadsInited then
+ InitThreads;
+
+ { Put thread in the linked list }
+ new(hp);
+ hp^.Thread:=t;
+ hp^.next:=ThreadRoot;
+ ThreadRoot:=hp;
+
+ inc(ThreadCount, 1);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+ lasthp,hp : PThreadRec;
+begin
+ hp:=ThreadRoot;
+ lasthp:=nil;
+ while assigned(hp) do
+ begin
+ if hp^.Thread=t then
+ begin
+ if assigned(lasthp) then
+ lasthp^.next:=hp^.next
+ else
+ ThreadRoot:=hp^.next;
+ dispose(hp);
+ exit;
+ end;
+ lasthp:=hp;
+ hp:=hp^.next;
+ end;
+
+ Dec(ThreadCount, 1);
+ if ThreadCount = 0 then DoneThreads;
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;cdecl;
+var
+ FreeThread: Boolean;
+ Thread : TThread absolute args;
+begin
+ while Thread.FHandle = 0 do fpsleep(1);
+ if Thread.FSuspended then Thread.suspend();
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ Result := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then
+ Thread.Free;
+ fpexit(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: Integer;
+begin
+ inherited Create;
+ AddThread(self);
+ FSuspended := CreateSuspended;
+ Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
+ { Setup 16k of stack }
+ FStackSize:=16384;
+ Getmem(FStackPointer,FStackSize);
+ inc(FStackPointer,FStackSize);
+ FCallExitProcess:=false;
+ { Clone }
+ FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
+// if FSuspended then Suspend;
+ FThreadID := FHandle;
+ IsMultiThread := TRUE;
+ FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished and not Suspended then
+ begin
+ Terminate;
+ WaitFor;
+ end;
+ if FHandle <> -1 then
+ fpkill(FHandle, SIGKILL);
+ dec(FStackPointer,FStackSize);
+ Freemem(FStackPointer);
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread(self);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+
+const
+{ I Don't know idle or timecritical, value is also 20, so the largest other
+ possibility is 19 (PFV) }
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,9,10,19,20);
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := fpGetPriority(Prio_Process,FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+ FSuspended := true;
+ fpKill(FHandle, SIGSTOP);
+end;
+
+
+procedure TThread.Resume;
+begin
+ fpKill(FHandle, SIGCONT);
+ FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+ status : longint;
+begin
+ if FThreadID = MainThreadID then
+ fpwaitpid(0,@status,0)
+ else
+ fpwaitpid(FHandle,@status,0);
+ Result:=status;
+end;
+{$ELSE}
+
+{
+ What follows, is a short description on my implementation of TThread.
+ Most information can also be found by reading the source and accompanying
+ comments.
+
+ A thread is created using BeginThread, which in turn calls
+ pthread_create. So the threads here are always posix threads.
+ Posix doesn't define anything for suspending threads as this is
+ inherintly unsafe. Just don't suspend threads at points they cannot
+ control. Therefore, I didn't implement .Suspend() if its called from
+ outside the threads execution flow (except on Linux _without_ NPTL).
+
+ The implementation for .suspend uses a semaphore, which is initialized
+ at thread creation. If the thread tries to suspend itself, we simply
+ let it wait on the semaphore until it is unblocked by someone else
+ who calls .Resume.
+
+ If a thread is supposed to be suspended (from outside its own path of
+ execution) on a system where the symbol LINUX is defined, two things
+ are possible.
+ 1) the system has the LinuxThreads pthread implementation
+ 2) the system has NPTL as the pthread implementation.
+
+ In the first case, each thread is a process on its own, which as far as
+ know actually violates posix with respect to signal handling.
+ But we can detect this case, because getpid(2) will
+ return a different PID for each thread. In that case, sending SIGSTOP
+ to the PID associated with a thread will actually stop that thread
+ only.
+ In the second case, this is not possible. But getpid(2) returns the same
+ PID across all threads, which is detected, and TThread.Suspend() does
+ nothing in that case. This should probably be changed, but I know of
+ no way to suspend a thread when using NPTL.
+
+ If the symbol LINUX is not defined, then the unimplemented
+ function SuspendThread is called.
+
+ Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+ I don't like this. It eats up 2 filedescriptors for each thread,
+ and those are a limited resource. If you have a server programm
+ handling client connections (one per thread) it will not be able
+ to handle many if we use 2 fds already for internal structures.
+ However, right now I don't see a better option unless some sem_*
+ functions are added to systhrds.
+ I encapsulated all used functions here to make it easier to
+ change them completely.
+}
+
+function SemaphoreInit: Pointer;
+begin
+ SemaphoreInit := GetMem(SizeOf(TFilDes));
+ fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+ b: byte;
+begin
+ fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+ fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+ fpclose(PFilDes(FSem)^[0]);
+ fpclose(PFilDes(FSem)^[1]);
+ FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+ ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+ GMainPID: LongInt = 0;
+{$ENDIF}
+const
+ // stupid, considering its not even implemented...
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+ if not ThreadsInited then begin
+ ThreadsInited := true;
+ {$IFDEF LINUX}
+ GMainPid := fpgetpid();
+ {$ENDIF}
+ end;
+end;
+
+procedure DoneThreads;
+begin
+ ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt; cdecl;
+var
+ LThread: TThread;
+ c: char;
+begin
+ WRITE_DEBUG('ThreadFunc is here...');
+ LThread := TThread(parameter);
+ {$IFDEF LINUX}
+ // save the PID of the "thread"
+ // this is different from the PID of the main thread if
+ // the LinuxThreads implementation is used
+ LThread.FPid := fpgetpid();
+ {$ENDIF}
+ WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+ try
+ if LThread.FInitialSuspended then begin
+ SemaphoreWait(LThread.FSem);
+ if not LThread.FSuspended then begin
+ LThread.FInitialSuspended := false;
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ end else begin
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ except
+ on e: exception do begin
+ WRITE_DEBUG('got exception: ',e.message);
+ LThread.FFatalException := TObject(AcquireExceptionObject);
+ // not sure if we should really do this...
+ // but .Destroy was called, so why not try FreeOnTerminate?
+ if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+ end;
+ end;
+ WRITE_DEBUG('thread done running');
+ Result := LThread.FReturnValue;
+ WRITE_DEBUG('Result is ',Result);
+ LThread.FFinished := True;
+ LThread.DoTerminate;
+ if LThread.FreeOnTerminate then begin
+ WRITE_DEBUG('Thread should be freed');
+ LThread.Free;
+ WRITE_DEBUG('Thread freed');
+ end;
+ WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+ // lets just hope that the user doesn't create a thread
+ // via BeginThread and creates the first TThread Object in there!
+ InitThreads;
+ inherited Create;
+ FSem := SemaphoreInit;
+ FSuspended := CreateSuspended;
+ FSuspendedExternal := false;
+ FInitialSuspended := CreateSuspended;
+ FFatalException := nil;
+ WRITE_DEBUG('creating thread, self = ',longint(self));
+ FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+ WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if FThreadID = GetCurrentThreadID then begin
+ raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+ end;
+ // if someone calls .Free on a thread with
+ // FreeOnTerminate, then don't crash!
+ FFreeOnTerminate := false;
+ if not FFinished and not FSuspended then begin
+ Terminate;
+ WaitFor;
+ end;
+ if (FInitialSuspended) then begin
+ // thread was created suspended but never woken up.
+ SemaphorePost(FSem);
+ WaitFor;
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ SemaphoreDestroy(FSem);
+ inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ if not FSuspended then begin
+ if FThreadID = GetCurrentThreadID then begin
+ FSuspended := true;
+ SemaphoreWait(FSem);
+ end else begin
+ FSuspendedExternal := true;
+{$IFDEF LINUX}
+ // naughty hack if the user doesn't have Linux with NPTL...
+ // in that case, the PID of threads will not be identical
+ // to the other threads, which means that our thread is a normal
+ // process that we can suspend via SIGSTOP...
+ // this violates POSIX, but is the way it works on the
+ // LinuxThreads pthread implementation. Not with NPTL, but in that case
+ // getpid(2) also behaves properly and returns the same PID for
+ // all threads. Thats actually (FINALLY!) native thread support :-)
+ if FPid <> GMainPID then begin
+ FSuspended := true;
+ fpkill(FPid, SIGSTOP);
+ end;
+{$ELSE}
+ SuspendThread(FHandle);
+{$ENDIF}
+ end;
+ end;
+end;
+
+
+procedure TThread.Resume;
+begin
+ if (not FSuspendedExternal) then begin
+ if FSuspended then begin
+ FSuspended := False;
+ SemaphorePost(FSem);
+ end;
+ end else begin
+ FSuspendedExternal := false;
+ ResumeThread(FHandle);
+ end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+ WRITE_DEBUG('waiting for thread ',FHandle);
+ WaitFor := WaitForThreadTerminate(FHandle, 0);
+ WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ // no need to check if FOnTerminate <> nil, because
+ // thats already done in DoTerminate
+ FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+{$ENDIF}
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.5 2005/03/01 20:38:49 jonas
+ * fixed web bug 3387: if one called resume right after creating a
+ suspended thread, it was possible that resume was executed before
+ that thread had completed its initialisation in BeginThread ->
+ FInitialSuspended was set to false in resume and nevertheless a
+ semafore was posted
+ * second problem fixed: set FSuspended to false before waking up the
+ thread, so that it doesn't get FSuspended = true right after waking
+ up. This should be done atomically to be completely correct though.
+
+ Revision 1.4 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/unixsock.inc b/rtl/netbsd/unixsock.inc
new file mode 100644
index 0000000000..b9e2a56e9a
--- /dev/null
+++ b/rtl/netbsd/unixsock.inc
@@ -0,0 +1,218 @@
+{
+ $Id: unixsock.inc,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ socket call implementations for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ Socket:=Do_Syscall(syscall_nr_socket,Domain,SocketType,Protocol);
+end;
+
+Function CloseSocket (Sock:Longint):Longint;
+begin
+ if fpclose(Sock)=0 then
+ CloseSocket := 0 else
+ CloseSocket := -1;
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+begin
+ Send:=do_syscall(syscall_nr_sendto,Sock,Longint(@Buf),BufLen,Flags,0,0);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+begin
+ Sendto:=do_syscall(syscall_nr_Sendto,Sock,Longint(@Buf),BufLen,Flags,Longint(@Addr),AddrLen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=do_syscall(syscall_nr_Recvfrom,Sock,Longint(@Buf),BufLen,Flags,0,0);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr ; AddrLen : Integer) : longint;
+
+begin
+ RecvFrom:=do_syscall(syscall_nr_Recvfrom,Sock,Longint(@buf),buflen,flags,Longint(@Addr),AddrLen);
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+begin
+ Bind:=(do_syscall(syscall_nr_Bind,Sock,Longint(@Addr),AddrLen)=0);
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+begin
+ Listen:=(do_syscall(syscall_nr_Listen,Sock,MaxConnect,0)=0);
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ Accept:=do_syscall(syscall_nr_accept,Sock,longint(@Addr),longint(@AddrLen));
+ If Accept<0 Then
+ Accept:=-1;
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint): boolean;
+
+begin
+ Connect:=do_syscall(syscall_nr_connect,Sock,longint(@Addr),AddrLen)=0;
+end;
+
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+ ShutDown:=do_syscall(syscall_nr_shutdown,Sock,How);
+end;
+
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=do_syscall(syscall_nr_GetSockName,Sock,longint(@Addr),longint(@AddrLen));
+end;
+
+
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=do_syscall(syscall_nr_GetPeerName,Sock,longint(@Addr),longint(@AddrLen));
+end;
+
+
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+begin
+ SetSocketOptions:=do_syscall(syscall_nr_SetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
+end;
+
+
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=do_syscall(syscall_nr_GetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
+end;
+
+
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ SocketPair:=do_syscall(syscall_nr_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+end;
+
+{******************************************************************************
+ UnixSock
+******************************************************************************}
+
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+begin
+ Move(Addr[1],t.Path,length(Addr));
+ t.Family:=AF_UNIX;
+ t.Path[length(Addr)]:=#0;
+ Len:=Length(Addr)+3;
+end;
+
+
+Function Bind(Sock:longint;const addr:string):boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ Bind(Sock,UnixAddr,AddrLen);
+ Bind:=(SocketError=0);
+end;
+
+
+
+Function DoAccept(Sock:longint;var addr:string):longint;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ AddrLen:=length(addr)+3;
+ DoAccept:=Accept(Sock,UnixAddr,AddrLen);
+ Move(UnixAddr.Path,Addr[1],AddrLen);
+ SetLength(Addr,AddrLen);
+end;
+
+
+
+Function DoConnect(Sock:longint;const addr:string):Boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ DoConnect:=Connect(Sock,UnixAddr,AddrLen);
+end;
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2Text(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2File(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ If Connect then
+ Sock2Text(Sock,SockIn,SockOut);
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ if Connect then
+ Sock2File(Sock,SockIn,SockOut);
+end;
+
+{
+ $Log: unixsock.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netbsd/unixsysc.inc b/rtl/netbsd/unixsysc.inc
new file mode 100644
index 0000000000..b4c40bce06
--- /dev/null
+++ b/rtl/netbsd/unixsysc.inc
@@ -0,0 +1,283 @@
+{
+ $Id: unixsysc.inc,v 1.8 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{
+function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+{NOT IMPLEMENTED YET UNDER BSD}
+begin // perhaps it is better to implement the hack from solaris then this msg
+ HALT;
+END;
+
+ if (pointer(func)=nil) or (sp=nil) then
+ begin
+ Lfpseterrno(EsysEInval);
+ exit(-1);
+ end;
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ pushl %ebx
+ // movl flags,%ebx
+ movl $251,%eax
+ int $0x80
+ popl %ebx
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+end;
+}
+
+{$ifndef FPC_USE_LIBC}
+Function fsync (fd : cint) : cint;
+
+begin
+ fsync:=do_syscall(syscall_nr_fsync,fd);
+end;
+
+Function Flock (fd,mode : longint) : cint;
+
+begin
+ Flock:=do_syscall(syscall_nr_flock,fd,mode);
+end;
+
+Function fStatFS(Fd:Longint;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+
+begin
+ fStatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info));
+end;
+
+Function StatFS(path:pchar;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+
+begin
+ StatFS:=do_syscall(syscall_nr_statfs,longint(path),longint(@info));
+end;
+
+// needs oldfpccall;
+Function intAssignPipe(var pipe_in,pipe_out:longint;var errn:cint):cint; {$ifndef ver1_0} oldfpccall;{$endif}
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+
+begin
+{$ifdef cpui386}
+ asm
+ mov $42,%eax
+ int $0x80
+ jb .Lerror
+ mov pipe_in,%ebx
+ mov %eax,(%ebx)
+ mov pipe_out,%ebx
+ mov $0,%eax
+ mov %edx,(%ebx)
+ mov %eax,%ebx
+ jmp .Lexit
+.Lerror:
+ mov %eax,%ebx
+ mov $-1,%eax
+.Lexit:
+ mov Errn,%edx
+ mov %ebx,(%edx)
+ end;
+{$endif}
+end;
+
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^longint;
+ res : longint;
+
+begin
+ do_syscall(syscall_nr_close,Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+ res : cint;
+
+begin
+ do_syscall(syscall_nr_close,filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+function MUnMap (P : Pointer; Size : size_t) : cint;
+
+begin
+ MUnMap:=do_syscall(syscall_nr_munmap,longint(P),Size);
+end;
+{$else}
+
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+ res : cint;
+
+begin
+ fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^longint;
+ res : longint;
+
+begin
+ fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+{$endif}
+// can't have oldfpccall here, linux doesn't need it.
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ ret : longint;
+ errn : cint;
+ {$ifdef FPC_USE_LIBC}
+ fdis : array[0..1] of cint;
+ {$endif}
+begin
+{$ifndef FPC_USE_LIBC}
+ ret:=intAssignPipe(pipe_in,pipe_out,errn);
+ if ret=-1 Then
+ fpseterrno(errn);
+{$ELSE}
+ fdis[0]:=pipe_in;
+ fdis[1]:=pipe_out;
+ ret:=pipe(fdis);
+ pipe_in:=fdis[0];
+ pipe_out:=fdis[1];
+{$ENDIF}
+ AssignPipe:=ret;
+end;
+
+
+{
+function intClone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; {$ifndef ver1_0} oldfpccall; {$endif}
+
+
+var lerrno : Longint;
+ errset : Boolean;
+ Res : Longint;
+begin
+ errset:=false;
+ Res:=0;
+asm
+ pushl %esi
+ movl 12(%ebp), %esi // get stack addr
+ subl $4, %esi
+ movl 20(%ebp), %eax // get __arg
+ movl %eax, (%esi)
+ subl $4, %esi
+ movl 8(%ebp), %eax // get __fn
+ movl %eax, (%esi)
+ pushl 16(%ebp)
+ pushl %esi
+ mov syscall_nr_rfork, %eax
+ int $0x80 // call actualsyscall
+ jb .L2
+ test %edx, %edx
+ jz .L1
+ movl %esi,%esp
+ popl %eax
+ call %eax
+ addl $8, %esp
+ call halt // Does not return
+.L2:
+ mov %eax,LErrNo
+ mov $true,Errset
+ mov $-1,%eax
+// jmp .L1
+.L1:
+ addl $8, %esp
+ popl %esi
+ mov %eax,Res
+end;
+ If ErrSet Then
+ fpSetErrno(LErrno);
+ intClone:=Res;
+end;
+
+
+
+function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+
+begin
+ Clone:=
+ intclone(tclonefunc(func),sp,flags,args);
+end;
+}
+
+
+{
+ $Log: unixsysc.inc,v $
+ Revision 1.8 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/Makefile b/rtl/netware/Makefile
new file mode 100644
index 0000000000..32bf18c38f
--- /dev/null
+++ b/rtl/netware/Makefile
@@ -0,0 +1,2040 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=netware
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysnetwa
+endif
+override FPCOPT+=-Ur
+override FPCOPT+=-dMT
+CREATESMART=1
+OBJPASDIR=$(RTL)/objpas
+IMPFILES=aio.imp audnlm32.imp \
+calnlm32.imp ccs.imp ccs-os.imp clibaux.imp \
+clibctx.imp clib.imp clxnlm32.imp dplsv386.imp \
+dsapi.imp dsevent.imp lib0.imp \
+locnlm32.imp ndpsrpc.imp netnlm32.imp nit.imp \
+nlmlib.imp nwpsrv3x.imp nwpsrv.imp nwsnut.imp \
+requestr.imp socklib.imp streams.imp threads.imp \
+tli.imp vollib.imp ws2_32.imp ws2nlm.imp unicode.imp
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix dos crt objects sysconst initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=nwpre prelude
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+copyimpfiles:
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+nwpre$(OEXT) : nwpre.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)nwpre$(OEXT) nwpre.as
+prelude$(OEXT) : prelude.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prelude$(OEXT) prelude.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp nwsys.inc $(SYSDEPS)
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
+winsock$(PPUEXT) : winsock.pp $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(INC)/sockets.inc $(INC)/socketsh.inc
+initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) nwsys.inc sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) \
+ sysconst$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
+ objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+freebidi$(PPUEXT) : $(OBJPASDIR)/freebidi.pp
+utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp freebidi$(PPUEXT)
+ $(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+mouse$(PPUEXT) : $(INC)/mouseh.inc $(SYSTEMUNIT)$(PPUEXT)
+video$(PPUEXT) : $(INC)/video.inc $(SYSTEMUNIT)$(PPUEXT)
+keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
+nwsnut$(PPUEXT) : nwsnut.pp nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+nwserv$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+nwcalls$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+override INSTALLPPUFILES+=$(IMPFILES)
+override CLEANPPUFILES+=$(addprefix $(COMPILER_UNITTARGETDIR)/,$(IMPFILES))
diff --git a/rtl/netware/Makefile.fpc b/rtl/netware/Makefile.fpc
new file mode 100644
index 0000000000..af7d71f610
--- /dev/null
+++ b/rtl/netware/Makefile.fpc
@@ -0,0 +1,263 @@
+#
+# Makefile.fpc for Free Pascal Netware RTL (clib)
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=nwpre prelude
+units=$(SYSTEMUNIT) objpas macpas strings \
+ lineinfo winsock heaptrc matrix \
+ dos crt objects sysconst \
+ initc sysutils types typinfo classes \
+ cpu mmx getopts \
+ dateutils strutils convutils \
+ charset ucomplex variants \
+ rtlconsts math varutils freebidi utf8bidi \
+ mouse video keyboard cmem sockets \
+ aio nwsnut nwserv nwnit nwprot netware nwcalls ctypes
+rsts=math varutils variants typinfo classes dateutils sysconst convutils rtlconsts
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=netware
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysnetwa
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+# ifdef RELEASE
+override FPCOPT+=-Ur
+# endif
+
+#debug, -a: dont delete asm, -al include lines
+#override FPCOPT+=-a
+#override FPCOPT+=-al
+
+
+# for netware always use multithread
+override FPCOPT+=-dMT
+
+# and alway use smartlinking
+CREATESMART=1
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+# Imp-Files
+IMPFILES=aio.imp audnlm32.imp \
+calnlm32.imp ccs.imp ccs-os.imp clibaux.imp \
+clibctx.imp clib.imp clxnlm32.imp dplsv386.imp \
+dsapi.imp dsevent.imp lib0.imp \
+locnlm32.imp ndpsrpc.imp netnlm32.imp nit.imp \
+nlmlib.imp nwpsrv3x.imp nwpsrv.imp nwsnut.imp \
+requestr.imp socklib.imp streams.imp threads.imp \
+tli.imp vollib.imp ws2_32.imp ws2nlm.imp unicode.imp
+
+
+[rules]
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+copyimpfiles:
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+
+#
+# Loaders
+#
+
+nwpre$(OEXT) : nwpre.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)nwpre$(OEXT) nwpre.as
+
+prelude$(OEXT) : prelude.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prelude$(OEXT) prelude.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+# always copy the imp files to the ppu dir, does not work
+# with system.pp copyimpfile nwsys.inc ...
+# because this will always build system.ppu
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp nwsys.inc $(SYSDEPS)
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
+
+winsock$(PPUEXT) : winsock.pp $(SYSTEMUNIT)$(PPUEXT)
+
+sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(INC)/sockets.inc $(INC)/socketsh.inc
+
+#dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
+
+initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
+
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) nwsys.inc sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) \
+ sysconst$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
+ objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+
+freebidi$(PPUEXT) : $(OBJPASDIR)/freebidi.pp
+
+utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp freebidi$(PPUEXT)
+ $(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+mouse$(PPUEXT) : $(INC)/mouseh.inc $(SYSTEMUNIT)$(PPUEXT)
+
+video$(PPUEXT) : $(INC)/video.inc $(SYSTEMUNIT)$(PPUEXT)
+
+keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
+
+nwsnut$(PPUEXT) : nwsnut.pp nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+nwserv$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+nwcalls$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Netware-.imp files need to be installed in the unit-dir
+#
+override INSTALLPPUFILES+=$(IMPFILES)
+override CLEANPPUFILES+=$(addprefix $(COMPILER_UNITTARGETDIR)/,$(IMPFILES))
diff --git a/rtl/netware/README b/rtl/netware/README
new file mode 100644
index 0000000000..00ac6be350
--- /dev/null
+++ b/rtl/netware/README
@@ -0,0 +1,179 @@
+
+ General
+ =======
+
+ Currently generating NetWare-NLM's only work under Linux and win32. (may work under other
+ unix versions also but this is not tested yet)
+
+
+ Binutils with netware-support needed
+ ====================================
+
+ You need a version of binutils compiled with netware-support. As of FreePascal 1.9.5 Nov 2004
+ binutils needs to be named i386-netware-* (i.e. i386-netware-ld, i386-netware-nlmconv).
+ Unfortunately in the Linux distibutions this component of the binutils is not included
+ so you have to compile it. So download the latest stable binutils package from your
+ favourite GNU mirror, decompress it ('tar xfz binutils-x.yy.z.tar.gz' on unices
+ with GNU tar), change to the binutils-x.yy.z directory and configure:
+
+ ./configure --prefix=/usr --enable-shared --enable-target=i386-netware
+
+ I used the prefix /usr because thats the default location on redhat (thats what I'm using)
+
+ and use
+
+ make
+ make install
+
+ to build and install binutils. To check that netware is supported by the version of binutils
+ installed, use i386-netware-ld --version. The emulation 'i386nw' must be present. Also check that
+ i386-netware-nlmconv
+ is present and can be started without specifying the complete path of i386-netware-nlmconv.
+
+ You can find more information and a binary version of binutils with netware-support for
+ linux on:
+ http://home.sch.bme.hu/~keresztg/novell/howto/NLM-Linux-HOWTO.html.
+
+ Binutils for win32 and Fedora Core 2 are available from:
+ ftp://ftp.freepascal.org/pub/fpc/contrib/cross
+
+
+ Building the freepascal runtime-library for netware
+ ===================================================
+
+ Install the current fpc sources from ftp.freepascal.org and change to the directory
+ rtl/netware under the freepascal sourcetree. Verify the path of your units in
+ Makefile. The default is /usr/lib/fpc/1.9.5/units/i386-netware/*.
+ Compile and install the rtl with
+
+ make install
+
+ This will install the basic rtl files. To install all (packages,fcl and nlm's) do a
+
+ make OS_TARGET=netware build
+
+ and
+
+ make OS_TARGET=netware install
+
+ at the fpc source root dir.
+
+
+ Settings and needed files to compile for netware
+ ================================================
+
+ Edit your /etc/fpc.cfg and add the rtl source path for netware. This are my settings,
+ you may paste it to your fpc.cfg:
+
+#IFDEF Netware_clib
+ -Fu/usr/lib/fpc/1.9.5/units/i386-netware/*
+ -Fl/usr/lib/fpc/1.9.5/units/i386-netware/rtl
+#ENDIF
+
+#IFDEF Netware_libc
+ -Fu/usr/lib/fpc/1.9.5/units/i386-netwlibc/*
+ -Fl/usr/lib/fpc/1.9.5/units/i386-netwlibc/rtl
+ -XPi386-netware-
+#ENDIF
+
+ This adds the search path for the rtl-units as well as for the needed import-files.
+ You can use the import files from the rtl/netware directory, they are automaticly
+ installed. If you want to use import files from novell, be aware that you have to
+ convert the files to unix format (i.e. with dos2unix).
+
+ Building the first nlm
+ ======================
+
+ Ok, now you have installed all needed files, try the following program and compile it
+ with
+
+ ppc386 -Tnetware hello.pas
+
+ PROGRAM Hello;
+ {$Description The FreePascal HelloWorld for Netware}
+ {$Version 1.0.0}
+ {$Copyright Copyright (c) 2001 The FreePascal Development Team}
+ {$Screenname FPC Hello World for Netware}
+
+ BEGIN
+ WriteLn ('This is open source, FreePascal for netware');
+ END.
+
+ Hints on using freepascal for nlm's
+ ===================================
+
+ - Compiler Switches for Netware
+ -----------------------------
+ The following compiler-swiches are supported for NetWare:
+ $DESCRIPTION : NLM-Description, will be displayed at load-time
+ $M : For Stack-Size. Heap-Size will be ignored
+ $VERSION x.x.x : Sets Major, Minor and Revision, Revision 0 is nothing, 1=a, 2=b ...
+ $COPYRIGHT : Sets Copyright, needs a patched nlmconv, patch is
+ available at the location for binutils-win32 shown
+ above.
+ $SCREENNAME : Sets the screen-name (i.e. shown in ctrl-esc screen)
+ $SCREENNAME DEFAULT : output to logger screen
+ $SCREENNAME NONE : no output at all (do not use this, writeln,
+ even from a runtime error may crash the sever)
+ $SCREENNAME MyScreen: Name the screen "MyScreen"
+ $THREADNAME : Sets the thread name (dont use names that are to long
+ for netware, that will prevent your nlm from loading)
+
+ - Exports
+ -------
+
+ Exports will be handled like in win32:
+ procedure bla; CDECL; EXPORT;
+ begin
+ end;
+
+ exports bla name 'bla';
+
+ Be aware that without Name 'bla' this will be exported in upper-case.
+
+ - Netware import (.imp) files
+ ---------------------------
+
+ Import files are needed by nlmconv as with other netware linkers. FreePascal is
+ searching import files via the specified library path (-Fl). If you plan to use
+ import files from novell be aware that they have to be converted from CR/LF to
+ LF only. The script 'convertimp' in rtl/netware/nwimp will do that.
+ If a module name is specified in an import, the module is automaticly
+ declared as autoload by FreePascal.
+
+ I.e. the following declaration needs nlmlib.imp and sets nlmlib.nlm as autoload:
+
+ FUNCTION rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL 'nlmlib.nlm' NAME 'rmdir';
+
+ while the following declaration only imports the symbol without autoloading:
+
+ FUNCTION rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL;
+
+ If nlmlib.nlm is not loaded while loading your nlm, you will get an error about
+ unknown symbols.
+
+
+ - Debugging
+ ---------
+
+ Debugging is possible with gdb on Netware 4.11, 5, 6 and 6.5.
+ See http://home.arcor.de/armin.diehl/fpcnw/gdbnw.html for details
+
+
+ - Netware SDK
+ -----------
+
+ Delphi declarations for the multiplattform api is available at
+ http://developer.novell.com. You can download the sdk after registering
+ as a developer.
+ The files are designed for win32 so they will not work off the box.
+ I think changing the dll-name to the corrosponding nlm-name will work.
+ i.e. in calwin32.imp the following declaration:
+
+ function NWAbortServicingQueueJob2; StdCall; external 'calwin32.dll' index 231;
+
+ has to be changed to
+
+ function NWAbortServicingQueueJob2; CDecl; external 'calwin32.nlm';
+
+armin@freepascal.org
diff --git a/rtl/netware/aio.imp b/rtl/netware/aio.imp
new file mode 100644
index 0000000000..bcd87f379d
--- /dev/null
+++ b/rtl/netware/aio.imp
@@ -0,0 +1,41 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+#
+# functions for Application to call
+#
+
+ AIOAcquirePort,
+ AIOConfigurePort,
+ AIOFlushBuffers,
+ AIOGetBoardList,
+ AIOGetDriverList,
+ AIOGetExternalStatus,
+ AIOGetFirstPortInfo,
+ AIOGetNextPortInfo,
+ AIOGetFirstPortStatistics,
+ AIOGetNextPortStatistics,
+ AIOGetPortCapability,
+ AIOGetPortConfiguration,
+ AIOGetPortStatistics,
+ AIOGetPortStatus,
+ AIOGetReadBufferSize,
+ AIOGetWriteBufferSize,
+ AIOReadData,
+ AIOReadStatus,
+ AIOReleasePort,
+ AIOSetControlData,
+ AIOSetExternalControl,
+ AIOSetFlowControl,
+ AIOSetFlowControlCharacters,
+ AIOSetReadBufferSize,
+ AIOSetWriteBufferSize,
+ AIOWriteData,
+ AIOWriteStatus,
+ AIOGetName_FirstPortInfo,
+ AIOGetName_NextPortInfo,
+
+#
+# functions for Internal Application to call
+#
+ AIOAcquirePortWithRTag
+
diff --git a/rtl/netware/aio.pp b/rtl/netware/aio.pp
new file mode 100644
index 0000000000..ac14af88e7
--- /dev/null
+++ b/rtl/netware/aio.pp
@@ -0,0 +1,512 @@
+{
+ $Id: aio.pp,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library
+ for Netware.
+ Copyright (c) 1999-2002 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ First Version of AIO, currently UNTESTED, i have to write some samples
+ to test it.
+
+ **********************************************************************}
+unit aio;
+interface
+
+const
+ aionlm='aio.nlm';
+
+
+{$PACKRECORDS C}
+
+
+{----------------------------------------------------------------------------
+ Predefined hardware types for use with the AIOAcquirePort function.
+ ---------------------------------------------------------------------------- }
+
+const
+ AIO_COMX_TYPE = 1;
+ AIO_ARTIC_TYPE = 2;
+ AIO_WNIM_TYPE = 3;
+
+{----------------------------------------------------------------------------
+ Function completion code status values.
+
+ Note that all error statuses are negative values.
+ ---------------------------------------------------------------------------- }
+ AIO_SUCCESS = 0;
+ AIO_BAD_HANDLE = -(1);
+ AIO_FAILURE = -(2);
+ AIO_FUNC_NOT_SUPPORTED = -(3);
+ AIO_INVALID_PARAMETER = -(5);
+ AIO_PORT_NOT_AVAILABLE = -(6);
+ AIO_QUALIFIED_SUCCESS = -(7);
+ AIO_NO_MORE_PORTS = -(8);
+ AIO_TYPE_NUMBER_INVALID = -(10);
+ AIO_BOARD_NUMBER_INVALID = -(11);
+ AIO_PORT_NUMBER_INVALID = -(12);
+ AIO_RESOURCE_TAG_INVALID = -(13);
+ AIO_DATA_PRESENT = -(14);
+ AIO_BAD_REQUEST_TYPE = -(15);
+ AIO_PORT_GONE = -(20);
+ AIO_RTAG_INVALID = -(21);
+{ This is only for non-CLIB application }
+{ 'NYSA' }
+ ASYNCIOSignature = $4E595341;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOSetExternalControl function.
+ ---------------------------------------------------------------------------- }
+ AIO_EXTERNAL_CONTROL = 1;
+ AIO_EXTCTRL_DTR = 1;
+ AIO_EXTCTRL_RTS = 2;
+ AIO_BREAK_CONTROL = 2;
+ AIO_SET_BREAK_OFF = 0;
+ AIO_SET_BREAK_ON = 1;
+ AIO_FLOW_CONTROL = 3;
+ AIO_SOFTWARE_FLOW_CONTROL_OFF = 0;
+ AIO_SOFTWARE_FLOW_CONTROL_ON = 1;
+ AIO_HARDWARE_FLOW_CONTROL_OFF = 0;
+ AIO_HARDWARE_FLOW_CONTROL_ON = 2;
+ AIO_FLOW_CONTROL_CHARACTERS = 4;
+ AIO_SET_DEADMAN_TIMER = 5;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOGetExternalStatus function.
+ ---------------------------------------------------------------------------- }
+ AIO_EXTSTA_RI = $00000001;
+ AIO_EXTSTA_DCD = $00000008;
+ AIO_EXTSTA_DSR = $00000010;
+ AIO_EXTSTA_CTS = $00000020;
+ AIO_EXTSTA_BREAK = $00000080;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOFlushBuffers function.
+ ---------------------------------------------------------------------------- }
+ AIO_FLUSH_WRITE_BUFFER = 1;
+ AIO_FLUSH_READ_BUFFER = 2;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOReadStatus function.
+ ---------------------------------------------------------------------------- }
+ AIO_RECEIVE_ACTIVE = 0;
+ AIO_RECEIVE_FULL = 1;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOWriteStatus function.
+ ---------------------------------------------------------------------------- }
+ AIO_TRANSMIT_IDLE = 0;
+ AIO_TRANSMIT_ACTIVE = 1;
+ AIO_TRANSMIT_XOFFED = 2;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOAcquirePort function.
+ ---------------------------------------------------------------------------- }
+ AIO_HARDWARE_TYPE_WILDCARD = -(1);
+ AIO_BOARD_NUMBER_WILDCARD = -(1);
+ AIO_PORT_NUMBER_WILDCARD = -(1);
+
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOConfigurePort function.
+ ---------------------------------------------------------------------------- }
+{ BitRate }
+ AIO_BAUD_50 = 0;
+ AIO_BAUD_75 = 1;
+ AIO_BAUD_110 = 2;
+ AIO_BAUD_134p5 = 3;
+ AIO_BAUD_150 = 4;
+ AIO_BAUD_300 = 5;
+ AIO_BAUD_600 = 6;
+ AIO_BAUD_1200 = 7;
+ AIO_BAUD_1800 = 8;
+ AIO_BAUD_2000 = 9;
+ AIO_BAUD_2400 = 10;
+ AIO_BAUD_3600 = 11;
+ AIO_BAUD_4800 = 12;
+ AIO_BAUD_7200 = 13;
+ AIO_BAUD_9600 = 14;
+ AIO_BAUD_19200 = 15;
+ AIO_BAUD_38400 = 16;
+ AIO_BAUD_57600 = 17;
+ AIO_BAUD_115200 = 18;
+{ DataBits }
+ AIO_DATA_BITS_5 = 0;
+ AIO_DATA_BITS_6 = 1;
+ AIO_DATA_BITS_7 = 2;
+ AIO_DATA_BITS_8 = 3;
+{ StopBits }
+ AIO_STOP_BITS_1 = 0;
+ AIO_STOP_BITS_1p5 = 1;
+ AIO_STOP_BITS_2 = 2;
+{ Parity }
+ AIO_PARITY_NONE = 0;
+ AIO_PARITY_ODD = 1;
+ AIO_PARITY_EVEN = 2;
+ AIO_PARITY_MARK = 3;
+ AIO_PARITY_SPACE = 4;
+{ FlowControl }
+ AIO_SOFTWARE_FLOWCONTROL_OFF = 0;
+ AIO_SOFTWARE_FLOWCONTROL_ON = 1;
+ AIO_HARDWARE_FLOWCONTROL_OFF = 0;
+ AIO_HARDWARE_FLOWCONTROL_ON = 2;
+ AIO_DROPOUT_VALUE = $FF;
+
+{----------------------------------------------------------------------------
+ Definitions for use with AIOPORTCAPABILITIES structure.
+ ---------------------------------------------------------------------------- }
+
+type
+
+ PAIOPORTCAPABILITIES = ^TAIOPORTCAPABILITIES;
+ TAIOPORTCAPABILITIES = record
+ returnLength : WORD; { byte length of capabilities data }
+ majorVersion : BYTE;
+ minorVersion : BYTE;
+ notSupportedMask : LONGINT;
+ minBitRate : BYTE;
+ maxBitRate : BYTE; { minimum bit rate index supported }
+ minDataBits : BYTE; { minimum data bits per char index supported }
+ maxDataBits : BYTE; { maximum data bits per char index supported }
+ minStopBits : BYTE; { minimum stop bits per char index supported }
+ maxStopBits : BYTE; { maximum stop bits per char index supported }
+ minParityMode : BYTE; { minimum parity mode index supported }
+ maxParityMode : BYTE; { maximum parity mode index supported }
+ minFlowCtrlMode : BYTE; { minimum flow control mode index supported }
+ maxFlowCtrlMode : BYTE; { maximum flow control mode index supported }
+ miscCapabilities : LONGINT; { miscellaneous capability flags }
+ minReadBufferSize : LONGINT; { minimum length of receive buffer }
+ maxReadBufferSize : LONGINT; { maximum length of receive buffer }
+ minWriteBufferSize : LONGINT; { minimum length of transmit buffer }
+ maxWriteBufferSize : LONGINT; { maximum length of transmit buffer }
+ minDeadmanTime : WORD; { minimum deadman time (seconds) }
+ maxDeadmanTime : WORD; { maximum deadman time (seconds) }
+ end;
+
+const
+ AIO_PORT_NS_MINBITRATE = $80000000;
+ AIO_PORT_NS_MAXBITRATE = $40000000;
+ AIO_PORT_NS_MINDATABITS = $20000000;
+ AIO_PORT_NS_MAXDATABITS = $10000000;
+ AIO_PORT_NS_MINSTOPBITS = $08000000;
+ AIO_PORT_NS_MAXSTOPBITS = $04000000;
+ AIO_PORT_NS_MINPARITYMODE = $02000000;
+ AIO_PORT_NS_MAXPARITYMODE = $01000000;
+ AIO_PORT_NS_MINFLOWCTRLMODE = $00800000;
+ AIO_PORT_NS_MAXFLOWCTRLMODE = $00400000;
+ AIO_PORT_NS_MISCCAPABILITIES = $00200000;
+ AIO_PORT_NS_MINREADBUFFERSIZE = $00100000;
+ AIO_PORT_NS_MAXREADBUFFERSIZE = $00080000;
+ AIO_PORT_NS_MINWRITEBUFFERSIZE = $00040000;
+ AIO_PORT_NS_MAXWRITEBUFFERSIZE = $00020000;
+ AIO_PORT_NS_MINDEADMANTIME = $00010000;
+ AIO_PORT_NS_MAXDEADMANTIME = $00008000;
+ AIO_PORT_CAPS_NOT_SUPPORTED = $00007FFF;
+ AIO_PORT_CAPS_MAJOR_VERSION = 1;
+ AIO_PORT_CAPS_MINOR_VERSION = 0;
+ AIO_CAP_OUTPUT_BREAK = $00000002;
+ AIO_CAP_FLOWCTRLCHARS = $00000004;
+ AIO_CAP_PROGRAMMABLE = $00000008;
+ AIO_CAP_INPUT = $00000010;
+ AIO_CAP_OUTPUT = $00000020;
+
+{ byte length of driver capabilities structure }
+type
+
+ PAIODVRCAPABILITIES = ^TAIODVRCAPABILITIES;
+ TAIODVRCAPABILITIES = record
+ returnLength : WORD;
+ byteData : array[0..1] of BYTE;
+ end;
+
+const
+ AIO_NO_STRUCT_DATA_RETURNED = 2;
+
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOGetPortsRollCall function.
+ ---------------------------------------------------------------------------- }
+
+type
+
+ PAIOPORTINFO = ^TAIOPORTINFO;
+ TAIOPORTINFO = record
+ returnLength : WORD; { byte length of port info data }
+ majorVersion : BYTE;
+ minorVersion : BYTE;
+ notSupportedMask : longint;
+ hardwareType : longint; { value used with AIOAcquirePort }
+ boardNumber : longint; { " }
+ portNumber : longint; { " }
+ availability : WORD; { availability of port for acquire }
+ externalStatus : longint; { current external status value for port }
+ chgdExternalStatus : longint; { changed external status value for port }
+ end;
+
+const
+ AIO_INFO_NS_HARDWARETYPE = $80000000;
+ AIO_INFO_NS_BOARDNUMBER = $40000000;
+ AIO_INFO_NS_PORTNUMBER = $20000000;
+ AIO_INFO_NS_AVAILABILITY = $10000000;
+ AIO_INFO_NS_EXTERNALSTATUS = $08000000;
+ AIO_INFO_NS_CHGDEXTERNALSTATUS = $04000000;
+ AIO_PORT_INFO_NOT_SUPPORTED = $03FFFFFF;
+ AIO_PORT_INFO_MAJOR_VERSION = 1;
+ AIO_PORT_INFO_MINOR_VERSION = 0;
+ AIO_AVAILABLE_FOR_ACQUIRE = 0;
+ AIO_ALREADY_ACQUIRED = 1;
+ AIO_UNAVAILABLE = $FF;
+ AIO_INITIAL = 0;
+ AIO_SUCCESSOR = 1;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOGetPortConfiguration function.
+ ---------------------------------------------------------------------------- }
+
+type
+
+ PAIOPORTCONFIG = ^TAIOPORTCONFIG;
+ TAIOPORTCONFIG = record
+ returnLength : WORD; { byte length of port configuration data }
+ majorVersion : BYTE;
+ minorVersion : BYTE;
+ notSupportedMask : LONGINT;
+ hardwareType : longint; { value used with AIOAcquirePort }
+ boardNumber : longint; { " " }
+ portNumber : longint; { " " }
+ bitRate : BYTE; { Bits per second index }
+ dataBits : BYTE; { Bits per character index }
+ stopBits : BYTE; { Stop bits per char index }
+ parityMode : BYTE; { Generated parity index }
+ flowCtrlMode : BYTE; { Flow control mode }
+ breakMode : BYTE; { Break control mode }
+ readSize : LONGINT; { Receive buffer size }
+ writeSize : LONGINT; { Transmit buffer size }
+ transmitXon : BYTE;
+ transmitXoff : BYTE;
+ receiveXon : BYTE;
+ receiveXoff : BYTE;
+ externalControl : WORD; { set with AIO_EXTERNAL_CONTROL }
+ end;
+
+const
+ AIO_CONFIG_NS_HARDWARETYPE = $80000000;
+ AIO_CONFIG_NS_BOARDNUMBER = $40000000;
+ AIO_CONFIG_NS_PORTNUMBER = $20000000;
+ AIO_CONFIG_NS_BITRATE = $10000000;
+ AIO_CONFIG_NS_DATABITS = $08000000;
+ AIO_CONFIG_NS_STOPBITS = $04000000;
+ AIO_CONFIG_NS_PARITYMODE = $02000000;
+ AIO_CONFIG_NS_FLOWCTRLMODE = $01000000;
+ AIO_CONFIG_NS_BREAKMODE = $00800000;
+ AIO_CONFIG_NS_READSIZE = $00400000;
+ AIO_CONFIG_NS_WRITESIZE = $00200000;
+ AIO_CONFIG_NS_TRANSMITXON = $00100000;
+ AIO_CONFIG_NS_TRANSMITXOFF = $00080000;
+ AIO_CONFIG_NS_RECEIVEXON = $00040000;
+ AIO_CONFIG_NS_RECEIVEXOFF = $00020000;
+ AIO_CONFIG_NS_EXTERNALCONTROL = $00010000;
+ AIO_PORT_CONFIG_NOT_SUPPORTED = $0007FFFF;
+ AIO_PORT_CONFIG_MAJOR_VERSION = 1;
+ AIO_PORT_CONFIG_MINOR_VERSION = 0;
+ AIO_EXTCTRL_DTR_ENABLE = 1;
+ AIO_EXTCTRL_DTR_DISABLE = 0;
+ AIO_EXTCTRL_RTS_ENABLE = 2;
+ AIO_EXTCTRL_RTS_DISABLE = 0;
+ AIO_BREAK_MODE_OFF = 0;
+ AIO_BREAK_MODE_ON = 1;
+
+type
+
+ PAIODVRCONFIG = ^TAIODVRCONFIG;
+ TAIODVRCONFIG = record
+ returnLength : WORD; { byte length of driver config structure }
+ byteData : array[0..1] of BYTE;
+ end;
+
+{----------------------------------------------------------------------------
+ Definitions for use with the AIOGetStatistics function.
+ ---------------------------------------------------------------------------- }
+
+
+ PAIOPORTSTATISTICS = ^TAIOPORTSTATISTICS;
+ TAIOPORTSTATISTICS = record
+ returnLength : WORD; { byte length of port statistics structure }
+ majorVersion : BYTE;
+ minorVersion : BYTE;
+ notSupportedMask : LONGINT;
+ receiveBytes : LONGINT; { total number of bytes received on port }
+ transmitBytes : LONGINT; { total number of bytes transmitted from port }
+ parityErrors : LONGINT; { number of receive parity errors }
+ framingErrors : LONGINT; { number of receive framing errors }
+ overrunSoftware : LONGINT; { number of software overruns (occurrences) }
+ overrunHardware : LONGINT; { number of hardware overruns (occurrences) }
+ end;
+
+const
+ AIO_STATS_NS_RECEIVEBYTES = $80000000;
+ AIO_STATS_NS_TRANSMITBYTES = $40000000;
+ AIO_STATS_NS_PARITYERRORS = $20000000;
+ AIO_STATS_NS_FRAMINGERRORS = $10000000;
+ AIO_STATS_NS_OVERRUNSOFTWARE = $08000000;
+ AIO_STATS_NS_OVERRUNHARDWARE = $04000000;
+ AIO_PORT_STATS_NOT_SUPPORTED = $03FFFFFF;
+ AIO_PORT_STATS_MAJOR_VERSION = 1;
+ AIO_PORT_STATS_MINOR_VERSION = 0;
+
+type
+
+ PAIODVRSTATISTICS = ^TAIODVRSTATISTICS;
+ TAIODVRSTATISTICS = record
+ returnLength : WORD; { byte length of driver statistics structure }
+ byteData : array[0..1] of BYTE;
+ end;
+
+
+{----------------------------------------------------------------------------
+ Definitions for use with AIOGetDriverList function.
+ ---------------------------------------------------------------------------- }
+
+ PAIODRIVERLISTENTRY = ^TAIODRIVERLISTENTRY;
+ TAIODRIVERLISTENTRY = record
+ hardwareType : longint;
+ ports : longint;
+ name : array[0..127] of char;
+ end;
+
+ PAIODRIVERLIST = ^TAIODRIVERLIST;
+ TAIODRIVERLIST = record
+ returnLength : WORD;
+ driver : array[0..0] of TAIODRIVERLISTENTRY;
+ end;
+
+const
+ AIO_DRIVER_LIST_GET_FIRST = -(1);
+
+{----------------------------------------------------------------------------
+ Definitions for use with AIOGetBoardList function.
+ ---------------------------------------------------------------------------- }
+type
+
+ PAIOBOARDLISTENTRY = ^TAIOBOARDLISTENTRY;
+ TAIOBOARDLISTENTRY = record
+ boardNumber : longint;
+ ports : longint;
+ name : array[0..127] of char;
+ end;
+
+ PAIOBOARDLIST = ^TAIOBOARDLIST;
+ TAIOBOARDLIST = record
+ returnLength : WORD;
+ board : array[0..0] of TAIOBOARDLISTENTRY;
+ end;
+
+const
+ AIO_BOARD_LIST_GET_FIRST = -(1);
+
+{----------------------------------------------------------------------------
+ Definitions for use with AIOSetControlData function.
+ ---------------------------------------------------------------------------- }
+{ byte length of control data structure }
+type
+
+ PAIOCONTROLDATA = ^TAIOCONTROLDATA;
+ TAIOCONTROLDATA = record
+ returnLength : WORD;
+ byteData : array[0..1] of BYTE;
+ end;
+
+
+{----------------------------------------------------------------------------
+ Definitions for use with AIOGetFirstPortInfo and AIOGetNextPortInfo
+ ---------------------------------------------------------------------------- }
+
+ PAIOPORTSEARCH = ^TAIOPORTSEARCH;
+ TAIOPORTSEARCH = record
+ typeMask : longint;
+ boardMask : longint;
+ portMask : longint;
+ reserved : array[0..5] of longint;
+ end;
+
+{----------------------------------------------------------------------------
+ Definition of AIO functions.
+ ---------------------------------------------------------------------------- }
+
+
+function AIOAcquirePort(hardwareType:Plongint; boardNumber:Plongint; portNumber:Plongint; portHandle:Plongint):longint;cdecl;external aionlm name 'AIOAcquirePort';
+function AIOAcquirePort(var hardwareType,boardNumber,portNumber,portHandle:longint):longint;cdecl;external aionlm name 'AIOAcquirePort';
+
+function AIOAcquirePortWithRTag(hardwareType:Plongint; boardNumber:Plongint; portNumber:Plongint; portHandle:Plongint; RTag:longint):longint;cdecl;external aionlm name 'AIOAcquirePortWithRTag';
+function AIOAcquirePortWithRTag(var hardwareType,boardNumber,portNumber,portHandle:longint; RTag:longint):longint;cdecl;external aionlm name 'AIOAcquirePortWithRTag';
+
+function AIOConfigurePort(portHandle:longint; bitRate:byte; dataBits:byte; stopBits:byte; parityMode:byte;
+ flowCtrlMode:byte):longint;cdecl;external aionlm name 'AIOConfigurePort';
+function AIOFlushBuffers(portHandle:longint; flushFlag:WORD):longint;cdecl;external aionlm name 'AIOFlushBuffers';
+function AIOGetBoardList(hardwareType:longint; boardIndex:longint; pBoardList:PAIOBOARDLIST):longint;cdecl;external aionlm name 'AIOGetBoardList';
+function AIOGetDriverList(lastHardwareType:longint; pDriverList:PAIODRIVERLIST):longint;cdecl;external aionlm name 'AIOGetDriverList';
+function AIOGetExternalStatus(portHandle:longint; extStatus:PLongint; chgdExtStatus:PLongint):longint;cdecl;external aionlm name 'AIOGetExternalStatus';
+function AIOGetExternalStatus(portHandle:longint; var extStatus,chgdExtStatus:Longint):longint;cdecl;external aionlm name 'AIOGetExternalStatus';
+
+function AIOGetFirstPortInfo(hardwareType:longint; boardNumber:longint; portNumber:longint; portSearchP:PAIOPORTSEARCH; portInfoP:PAIOPORTINFO;
+ capabilitiesP:PAIOPORTCAPABILITIES; dvrCapabilitiesP:PAIODVRCAPABILITIES; NLMModuleNameP:Pchar):longint;cdecl;external aionlm name 'AIOGetFirstPortInfo';
+function AIOGetNextPortInfo(portSearchP:PAIOPORTSEARCH; portInfoP:PAIOPORTINFO; capabilitiesP:PAIOPORTCAPABILITIES; dvrCapabilitiesP:PAIODVRCAPABILITIES; NLMModuleNameP:Pchar):longint;cdecl;external aionlm name 'AIOGetNextPortInfo';
+function AIOGetName_FirstPortInfo(hardwareType:longint; boardNumber:longint; portNumber:longint; portSearchP:PAIOPORTSEARCH; portInfoP:PAIOPORTINFO;
+ capabilitiesP:PAIOPORTCAPABILITIES; dvrCapabilitiesP:PAIODVRCAPABILITIES; NLMModuleNameP:Pchar):longint;cdecl;external aionlm name 'AIOGetName_FirstPortInfo';
+function AIOGetName_NextPortInfo(portSearchP:PAIOPORTSEARCH; portInfoP:PAIOPORTINFO; capabilitiesP:PAIOPORTCAPABILITIES; dvrCapabilitiesP:PAIODVRCAPABILITIES; NLMModuleNameP:Pchar):longint;cdecl;external aionlm name 'AIOGetName_NextPortInfo';
+function AIOGetPortCapability(portHandle:longint; pCapabilities:PAIOPORTCAPABILITIES; pDvrCapabilities:PAIODVRCAPABILITIES):longint;cdecl;external aionlm name 'AIOGetPortCapability';
+function AIOGetPortConfiguration(portHandle:longint; pPortConfig:PAIOPORTCONFIG; pDvrConfig:PAIODVRCONFIG):longint;cdecl;external aionlm name 'AIOGetPortConfiguration';
+function AIOGetPortStatus(portHandle:longint; writeCount:PLongint; writeState:PWORD; readCount:PLongint; readState:PWORD;
+ extStatus:PLongint; chgdExtStatus:PLongint):longint;cdecl;external aionlm name 'AIOGetPortStatus';
+function AIOGetPortStatus(portHandle:longint; var writeCount:Longint; var writeState:WORD; var readCount:Longint; var readState:WORD;
+ var extStatus,chgdExtStatus:Longint):longint;cdecl;external aionlm name 'AIOGetPortStatus';
+
+function AIOGetReadBufferSize(portHandle:longint; readSize:PLongint):longint;cdecl;external aionlm name 'AIOGetReadBufferSize';
+function AIOGetReadBufferSize(portHandle:longint; var readSize:Longint):longint;cdecl;external aionlm name 'AIOGetReadBufferSize';
+
+function AIOGetPortStatistics(portHandle:longint; pPortStatistics:PAIOPORTSTATISTICS; pDvrStatistics:PAIODVRSTATISTICS):longint;cdecl;external aionlm name 'AIOGetPortStatistics';
+function AIOGetPortStatistics(portHandle:longint; var pPortStatistics:TAIOPORTSTATISTICS; var pDvrStatistics:TAIODVRSTATISTICS):longint;cdecl;external aionlm name 'AIOGetPortStatistics';
+
+function AIOGetWriteBufferSize(portHandle:longint; writeSize:PLongint):longint;cdecl;external aionlm name 'AIOGetWriteBufferSize';
+function AIOGetWriteBufferSize(portHandle:longint; var writeSize:Longint):longint;cdecl;external aionlm name 'AIOGetWriteBufferSize';
+
+function AIOReadData(portHandle:longint; buffer:Pchar; length:longint; numberBytesRead:PLongint):longint;cdecl;external aionlm name 'AIOReadData';
+function AIOReadData(portHandle:longint; var buffer; length:longint; var numberBytesRead:Longint):longint;cdecl;external aionlm name 'AIOReadData';
+
+function AIOReadStatus(portHandle:longint; count:PLongint; state:PWORD):longint;cdecl;external aionlm name 'AIOReadStatus';
+function AIOReadStatus(portHandle:longint; var count:Longint; var state:WORD):longint;cdecl;external aionlm name 'AIOReadStatus';
+
+function AIOReleasePort(portHandle:longint):longint;cdecl;external aionlm name 'AIOReleasePort';
+function AIOSetControlData(portHandle:longint; requestType:longint; requestStructValue:PAIOCONTROLDATA):longint;cdecl;external aionlm name 'AIOSetControlData';
+function AIOSetControlData(portHandle:longint; requestType:longint; var requestStructValue:TAIOCONTROLDATA):longint;cdecl;external aionlm name 'AIOSetControlData';
+
+function AIOSetExternalControl(portHandle:longint; requestType:longint; requestValue:longint):longint;cdecl;external aionlm name 'AIOSetExternalControl';
+function AIOSetFlowControl(portHandle:longint; flowCtrlMode:longint):longint;cdecl;external aionlm name 'AIOSetFlowControl';
+function AIOSetFlowControlCharacters(portHandle:longint; transmitXon:byte; transmitXoff:byte; receiveXon:byte; receiveXoff:byte):longint;cdecl;external aionlm name 'AIOSetFlowControlCharacters';
+function AIOSetReadBufferSize(portHandle:longint; bufferSize:longint):longint;cdecl;external aionlm name 'AIOSetReadBufferSize';
+function AIOSetWriteBufferSize(portHandle:longint; bufferSize:longint):longint;cdecl;external aionlm name 'AIOSetWriteBufferSize';
+
+function AIOWriteData(portHandle:longint; buffer:Pchar; length:longint; numberBytesWritten:PLongint):longint;cdecl;external aionlm name 'AIOWriteData';
+function AIOWriteData(portHandle:longint; var buffer; length:longint; var numberBytesWritten:Longint):longint;cdecl;external aionlm name 'AIOWriteData';
+
+function AIOWriteStatus(portHandle:longint; count:PLongint; state:PWORD):longint;cdecl;external aionlm name 'AIOWriteStatus';
+function AIOWriteStatus(portHandle:longint; var count:Longint; var state:WORD):longint;cdecl;external aionlm name 'AIOWriteStatus';
+
+
+implementation
+
+
+end.
+
+
+{
+ $Log: aio.pp,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/audnlm32.imp b/rtl/netware/audnlm32.imp
new file mode 100644
index 0000000000..c763d5c67e
--- /dev/null
+++ b/rtl/netware/audnlm32.imp
@@ -0,0 +1,33 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWGetNWADVersion,
+ NWADOpen,
+ NWADClose,
+ NWADGetStatus,
+ NWADLogin,
+ NWADInitLevelTwoPassword,
+ NWADChangePassword,
+ NWADCheckAccess,
+ NWADCheckLevelTwoAccess,
+ NWADGetFlags,
+ NWADDisable,
+ NWADEnable,
+ NWADIsObjectAudited,
+ NWADChangeObjectProperty,
+ NWADReadBitMap,
+ NWADReadConfigHeader,
+ NWADReadRecord,
+ NWADOpenRecordFile,
+ NWADCloseRecordFile,
+ NWADLogout,
+ NWADResetFile,
+ NWADWriteBitMap,
+ NWADWriteConfigHeader,
+ NWADCloseOldFile,
+ NWADDeleteFile,
+ NWADGetFileList,
+ NWADDeleteOldFile,
+ NWADSetPassword,
+ NWADRestartVolumeAuditing,
+ NWADAppendExternalRecords
+
diff --git a/rtl/netware/calnlm32.imp b/rtl/netware/calnlm32.imp
new file mode 100644
index 0000000000..e02f62bf95
--- /dev/null
+++ b/rtl/netware/calnlm32.imp
@@ -0,0 +1,470 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWGetMaximumConnections,
+ NWAttachToFileServer,
+ NWDetachFromFileServer,
+ NWLogoutFromFileServer,
+ NWGetConnectionList,
+ NWGetConnectionStatus,
+ NWGetFileServerName,
+ NWGetConnectionNumber,
+ NWGetDefaultConnectionID,
+ NWSetDriveBase,
+ NWDeleteDriveBase,
+ NWGetDriveInformation,
+ NWSetPrimaryConnectionID,
+ NWGetPrimaryConnectionID,
+ NWLoginToFileServer,
+ NWVerifyObjectPassword,
+ NWChangeObjectPassword,
+ NWReadPropertyValue,
+ NWWritePropertyValue,
+ NWAddObjectToSet,
+ NWDeleteObjectFromSet,
+ NWIsObjectInSet,
+ NWScanProperty,
+ NWGetObjectID,
+ NWGetObjectName,
+ NWScanObject,
+ NWGetBinderyAccessLevel,
+ NWCreateProperty,
+ NWDeleteProperty,
+ NWChangePropertySecurity,
+ NWCreateObject,
+ NWDeleteObject,
+ NWRenameObject,
+ NWChangeObjectSecurity,
+ NWOpenBindery,
+ NWCloseBindery,
+ NWScanObjectTrusteePaths,
+ NWSpoolEndCapture,
+ NWSpoolCancelCapture,
+ NWSpoolGetBannerUserName,
+ NWSpoolSetBannerUserName,
+ NWCreateQueueFile,
+ NWCloseFileAndStartQueueJob,
+ NWCloseFileAndAbortQueueJob,
+ NWRemoveJobFromQueue,
+ NWGetQueueJobList,
+ NWReadQueueJobEntry,
+ NWGetQueueJobFileSize,
+ NWGetPrinterQueueID,
+ NWCreateQueue,
+ NWDestroyQueue,
+ NWReadQueueCurrentStatus,
+ NWSetQueueCurrentStatus,
+ NWChangeQueueJobEntry,
+ NWChangeQueueJobPosition,
+ NWReadQueueServerCurrentStatus,
+ NWAttachQueueServerToQueue,
+ NWDetachQueueServerFromQueue,
+ NWServiceQueueJob,
+ NWFinishServicingQueueJob,
+ NWAbortServicingQueueJob,
+ NWChangeToClientRights,
+ NWRestoreQueueServerRights,
+ NWSetQueueServerCurrentStatus,
+ NWGetFileServerDescription,
+ NWGetRequesterVersion,
+ NWAddTrusteeToDirectory,
+ NWDeleteTrusteeFromDirectory,
+ NWGetEffectiveDirectoryRights,
+ NWModifyMaximumRightsMask,
+ NWScanDirectoryForTrustees,
+ NWScanDirectoryInformation,
+ NWSetDirectoryInformation,
+ NWAllocTemporaryDirectoryHandle,
+ NWDeallocateDirectoryHandle,
+ NWSetDirectoryHandlePath,
+ NWGetDirectoryHandlePath,
+ NWTTSIsAvailable,
+ NWTTSBeginTransaction,
+ NWTTSEndTransaction,
+ NWTTSAbortTransaction,
+ NWTTSTransactionStatus,
+ NWTTSGetProcessThresholds,
+ NWTTSSetProcessThresholds,
+ NWTTSGetConnectionThresholds,
+ NWTTSSetConnectionThresholds,
+ NWTTSGetControlFlags,
+ NWTTSSetControlFlags,
+ NWOpenSemaphore,
+ NWExamineSemaphore,
+ NWWaitOnSemaphore,
+ NWSignalSemaphore,
+ NWCloseSemaphore,
+ NWParseNetWarePath,
+ NWParsePath,
+ NWParsePathConnRef,
+ NWFileServerFileCopy,
+ NWGetVolumeInfoWithHandle,
+ NWGetVolumeInfoWithNumber,
+ NWGetVolumeName,
+ NWGetVolumeNumber,
+ NWRestoreErasedFile,
+ NWPurgeErasedFiles,
+ NWGetFileConnectionID,
+ NWGetConnectionInformation,
+ NWGetFileServerDateAndTime,
+ NWGetObjectConnectionNumbers,
+ NWGetInternetAddress,
+ NWGetFileServerInformation,
+ NWGetFileServerExtendedInfo,
+ NWSendBroadcastMessage,
+ NWGetBroadcastMode,
+ NWSetBroadcastMode,
+ NWBroadcastToConsole,
+ NWSendConsoleBroadcast,
+ NWLogPhysicalRecord,
+ NWLockPhysicalRecordSet,
+ NWReleasePhysicalRecordSet,
+ NWClearPhysicalRecordSet,
+ NWReleasePhysicalRecord,
+ NWClearPhysicalRecord,
+ NWLockFileLockSet,
+ NWReleaseFileLockSet,
+ NWClearFileLockSet,
+ NWLogLogicalRecord,
+ NWLockLogicalRecordSet,
+ NWReleaseLogicalRecordSet,
+ NWClearLogicalRecordSet,
+ NWReleaseLogicalRecord,
+ NWClearLogicalRecord,
+ NWWordSwap,
+ NWLongSwap,
+ NWRequest,
+ NWScanFileInformation,
+ NWSetFileInformation,
+ NWGetPrinterStatus,
+ NWCreateDirectory,
+ NWDeleteDirectory,
+ NWRenameDirectory,
+ NWRenameFile,
+ NWEraseFiles,
+ NWSetFileAttributes,
+ NWSetInitDrive,
+ NWDisallowObjectPassword,
+ NWFileSearchInitialize,
+ NWScanDirectoryForTrustees2,
+ NWScanDirectoryInformation2,
+ NWScanFileInformation2,
+ NWSetFileInformation2,
+ NWIsLNSSupportedOnVolume,
+ NWGetFileServerType,
+ NWGetFileServerLANIOStats,
+ NWGetBroadcastMessage,
+ NWAttachToFileServerByConn,
+ NWParseUNCPath,
+ NWParseUNCPathConnRef,
+ NWStripServerOffPath,
+ CleanPath,
+ IndexPath,
+ NWDisableBroadcasts,
+ NWEnableBroadcasts,
+ _NWFillComponentPath,
+ _NWFillComponentPath2,
+ NWConvertHandle,
+ NWCloseFile,
+ _NWFillHandlePathStruct,
+ _NWFillHandlePathStruct2,
+ _NWGetRequesterType,
+ NWOrderedRequestToAll,
+ NWRequestToAll,
+ WildCardCheck,
+ _NWFillWildPath,
+ NWGetConnectionHandle,
+ NWIntFileSearchContinue,
+ NWIsIDInUse,
+ NWAbortServicingQueueJob2,
+ NWChangeQueueJobEntry2,
+ NWChangeQueueJobPosition2,
+ NWChangeToClientRights2,
+ NWCloseFileAndAbortQueueJob2,
+ NWCloseFileAndStartQueueJob2,
+ NWCreateQueueFile2,
+ NWFinishServicingQueueJob2,
+ NWGetQueueJobList2,
+ NWGetQueueJobFileSize2,
+ NWReadQueueCurrentStatus2,
+ NWReadQueueJobEntry2,
+ NWReadQueueServerCurrentStatus2,
+ NWRemoveJobFromQueue2,
+ NWServiceQueueJob2,
+ NWSetQueueCurrentStatus2,
+ _NWGetFileServerType,
+ NWAddTrustee,
+ NWAFPAllocTemporaryDirHandle,
+ NWAFPCreateDirectory,
+ NWAFPDelete,
+ NWAFPDirectoryEntry,
+ NWAFPGetEntryIDFromHandle,
+ NWAFPGetEntryIDFromName,
+ NWAFPGetEntryIDFromPathName,
+ NWAFPGetFileInformation,
+ NWAFPOpenFileFork,
+ NWAFPRename,
+ NWAFPScanFileInformation,
+ NWAFPSetFileInformation,
+ NWAFPSupported,
+ NWAllocTempNSDirHandle,
+ NWCloseEA,
+ NWDeleteTrustee,
+ NWFindFirstEA,
+ NWFindNextEA,
+ NWGetDirectoryBase,
+ NWGetEAHandleStruct,
+ NWGetEffectiveRights,
+ NWGetLongName,
+ NWNSGetMiscInfo,
+ NWGetNSEntryInfo,
+ NWGetNSInfo2,
+ NWGetNSLoadedList2,
+ NWGetNSPath,
+ NWGetOwningNameSpace,
+ NWMoveDirEntry,
+ NWOpenCreateNSEntry,
+ NWOpenDataStream,
+ NWPurgeDeletedFile,
+ NWReadEA,
+ NWReadExtendedNSInfo,
+ NWReadNSInfo,
+ NWRecoverDeletedFile,
+ NWScanDirEntryInfo,
+ NWScanExtendedInfo,
+ NWScanForDeletedFiles,
+ NWScanForTrustees,
+ NWScanNSEntryInfo,
+ NWSetDirEntryInfo,
+ NWSetDirSpaceLimit,
+ NWSetLongName,
+ NWWriteEA,
+ NWWriteExtendedNSInfo,
+ NWWriteNSInfo,
+ _NWConvert4ByteTo6ByteHandle,
+ _NWConvertHandle,
+ NWOpenEA,
+ NWGetExtendedFileAttributes2,
+ NWSetExtendedFileAttributes2,
+ NWConvertPathToDirEntry,
+ NWOpenNSEntry,
+ NWGetFileServerVersion,
+ NWRemoveObjectDiskRestrictions,
+ NWScanVolDiskRestrictions,
+ NWSetObjectVolSpaceLimit,
+ NWGetObjDiskRestrictions,
+ NWAFPCreateFile,
+ NWGetDirSpaceLimitList,
+ NWGetDirSpaceInfo,
+ NWCheckConsolePrivileges,
+ NWCheckNetWareVersion,
+ NWClearConnectionNumber,
+ NWDisableFileServerLogin,
+ NWDisableTTS,
+ NWDownFileServer,
+ NWEnableFileServerLogin,
+ NWEnableTTS,
+ NWGetConnectionUsageStats,
+ NWGetFSDriveMapTable,
+ NWGetDiskCacheStats,
+ NWGetDiskChannelStats,
+ NWGetObjectDiskSpaceLeft,
+ NWGetDiskUtilization,
+ NWGetFileSystemStats,
+ NWGetFileServerLoginStatus,
+ NWGetFileServerVersionInfo,
+ NWGetFSLANDriverConfigInfo,
+ NWGetPhysicalDiskStats,
+ NWGetPathFromDirectoryEntry,
+ NWGetTTSStats,
+ NWSetFileServerDateAndTime,
+ NWAllocPermanentDirectoryHandle,
+ NWGetAccountStatus,
+ NWGetTaskInformationByConn,
+ NWGetVolumeStats,
+ NWQueryAccountingInstalled,
+ NWRestoreDirectoryHandle,
+ NWSaveDirectoryHandle,
+ NWScanConnectionsUsingFile,
+ NWScanLogicalLocksByConn,
+ NWScanLogicalLocksByName,
+ NWScanOpenFilesByConn,
+ NWScanPhysicalLocksByConnFile,
+ NWScanPhysicalLocksByFile,
+ NWScanSemaphoresByConn,
+ NWScanSemaphoresByName,
+ NWSubmitAccountCharge,
+ NWSubmitAccountHold,
+ NWSubmitAccountNote,
+ NWCallsInit,
+ NWIntScanForTrustees,
+ NWIntScanDirectoryInformation2,
+ NWIntScanDirEntryInfo,
+ NWIntScanDirectoryInformation,
+ NWIntMoveDirEntry,
+ NWIntScanExtendedInfo,
+ NWIntScanFileInformation,
+ NWIntScanFileInformation2,
+ NWIntFileSearchInitialize,
+ NWIntEraseFiles,
+ NWNSRename,
+ NWGetObjectEffectiveRights,
+ NWGetExtendedVolumeInfo2,
+ NWLogFileLock2,
+ NWReleaseFileLock2,
+ NWClearFileLock2,
+ NWScanOpenFilesByConn2,
+ NWSetNSEntryDOSInfo,
+ NWAllocTempNSDirHandle2,
+ _NWGetCompathStructLength,
+ NWConvertAndAugment,
+ NWConvertToSpecChar,
+ NWGetActiveConnListByType,
+ NWGetActiveLANBoardList,
+ NWGetActiveProtocolStacks,
+ NWGetCacheInfo,
+ NWGetCPUInfo,
+ NWGetDataMigratorInfo2,
+ NWGetDefaultSupportModule2,
+ NWGetDirCacheInfo,
+ NWGetDMFileInfo2,
+ NWGetDMVolumeInfo2,
+ NWGetFileServerInfo,
+ NWGetGarbageCollectionInfo,
+ NWGetIPXSPXInfo,
+ NWGetLANCommonCountersInfo,
+ NWGetLANConfigInfo,
+ NWGetLANCustomCountersInfo,
+ NWGetLoadedMediaNumList,
+ NWGetLSLInfo,
+ NWGetLSLLogicalBoardStats,
+ NWGetMediaMgrObjChildrenList,
+ NWGetMediaMgrObjInfo,
+ NWGetMediaMgrObjList,
+ NWGetMediaNameByMediaNum,
+ NWGetNetWareFileSystemsInfo,
+ NWGetNLMInfo,
+ NWGetNLMLoadedList,
+ NWGetNLMsResourceTagList,
+ NWGetOSVersionInfo,
+ NWGetPacketBurstInfo,
+ NWGetProtocolStackConfigInfo,
+ NWGetProtocolStackCustomInfo,
+ NWGetProtocolStackStatsInfo,
+ NWGetProtocolStkNumsByLANBrdNum,
+ NWGetProtocolStkNumsByMediaNum,
+ NWGetSupportModuleInfo2,
+ NWGetUserInfo,
+ NWGetVolumeSegmentList,
+ NWGetVolumeSwitchInfo,
+ NWMoveFileFromDM2,
+ NWMoveFileToDM2,
+ NWSetDefaultSupportModule2,
+ NWGetNWCallsVersion,
+ NWCancelCapture,
+ NWEndCapture,
+ NWFlushCapture,
+ NWGetBannerUserName,
+ NWGetCaptureFlags,
+ NWGetCaptureStatus,
+ NWGetPrinterStrings,
+ NWSetBannerUserName,
+ NWSetCaptureFlags,
+ NWSetPrinterStrings,
+ NWStartQueueCapture,
+ NWGetMaxPrinters,
+ ConvertNWQueueToQueue,
+ ConvertQueueToNWQueue,
+ NWAFPASCIIZToLenStr,
+ NWDosClose,
+ NWGetNCPExtensionInfo2,
+ NWScanNCPExtensions2,
+ NWNCPExtensionRequest,
+ NWFragNCPExtensionRequest,
+ _NWGetComPathLen2,
+ __LStrChr,
+ CheckPathAtRoot,
+ NWUnpackDate,
+ NWUnpackTime,
+ NWUnpackDateTime,
+ NWGetGeneralRouterAndSAPInfo,
+ NWGetKnownNetworksInfo,
+ NWGetNetworkRouterInfo,
+ NWGetNetworkRoutersInfo,
+ NWGetServerInfo,
+ NWGetServerSourcesInfo,
+ NWGetKnownServersInfo,
+ NWGetServerSetCommandsInfo,
+ NWGetServerSetCategories,
+ NWGetConnListFromObject,
+ _NWMakeComponentPath,
+ NWGetNCPExtensionInfoByName,
+ NWGetNCPExtensionsList,
+ NWGetNumberNCPExtensions,
+ NWLockConnection,
+ NWGetVolumeInfoByLevel,
+ NWPackDate,
+ NWPackTime,
+ NWPackDateTime,
+ NWConvertDate,
+ NWConvertTime,
+ NWConvertDateTime,
+ NWConvertFileHandle,
+ __NWFillComponentPath2,
+ __NWFillHandlePathStruct,
+ __NWFillHandlePathStruct2,
+ __NWFillWildPath,
+ NWGetConnInfo,
+ NWScanVolDiskRestrictions2,
+ NWGetInetAddr,
+ _enumEA,
+ NWCallsTerm,
+ NWGetSparseFileBitMap,
+ NWCreateUNCPath,
+ NWGetFileServerMiscInfo,
+ NWGetNetworkSerialNumber,
+ NWIsManager,
+ __NWGetCurNS,
+ Encode,
+ Encrypt,
+ EncryptPassword,
+ GetLoginKey,
+ GetPasswordKey,
+ NWGetLoginPasswordKey,
+ NWSetCompressedFileSize,
+ NWGetPathFromDirectoryBase,
+ NWGetClientType,
+ NWNSGetDefaultNS,
+ NWDeleteNSEntry,
+ NWSMLoadNLM,
+ NWSMUnloadNLM,
+ NWSMMountVolume,
+ NWSMDismountVolumeByNumber,
+ NWSMDismountVolumeByName,
+ NWSMAddNSToVolume,
+ NWSMSetDynamicCmdStrValue,
+ NWSMSetDynamicCmdIntValue,
+ NWSMExecuteNCFFile,
+ NWGetSupportModuleCapacity,
+ NWGetObjectEffectiveRights2,
+ NWGetFileDirEntryNumber,
+ NWGetDirectoryEntryNumber,
+ NWGetNSFileDirEntryNumber,
+ NWGetObjectNamesBeginA,
+ NWGetObjectNamesNextA,
+ NWGetObjectNamesEndA,
+ NWScanMountedVolumeList,
+ NWScanNSEntryInfoSet,
+ NWGetMLIDBoardInfo,
+ NWEnumNetAddresses,
+ NWGenerateGUIDs,
+ NWGetServerConnInfo,
+ NWAddTrusteeToNSDirectory,
+ NWSMLoadNLM2,
+ NWGetDirSpaceLimitList2,
+ NWDeleteTrusteeFromNSDirectory,
+ NWScanNSEntryInfo2,
+ NWGetNetWareProductVersion,
+ NWGetObjectNamesBeginW,
+ NWGetObjectNamesNextW,
+ NWGetObjectNamesEndW
+
diff --git a/rtl/netware/ccs-os.imp b/rtl/netware/ccs-os.imp
new file mode 100644
index 0000000000..7724d22d5f
--- /dev/null
+++ b/rtl/netware/ccs-os.imp
@@ -0,0 +1,27 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+Alloc,
+AllocateResourceTag,
+AllocSleepOK,
+CAllocSemaphore,
+CCmpB,
+CDeAllocateSemaphore,
+CExamineSemaphore,
+CMovB,
+CPSemaphore,
+CSemaphoreReleaseAll,
+CSetB,
+CStrCmp,
+CVSemaphore,
+CYieldWithDelay,
+Disable,
+DisableAndRetFlags,
+Enable,
+Free,
+GetCurrentTime,
+GetSyncClockFields,
+RegisterForEventNotification,
+SetFlags,
+SizeOfAllocBlock,
+UnRegisterEventNotification
+
diff --git a/rtl/netware/ccs.imp b/rtl/netware/ccs.imp
new file mode 100644
index 0000000000..feee5fcdd6
--- /dev/null
+++ b/rtl/netware/ccs.imp
@@ -0,0 +1,78 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+CCSX_Authenticate,
+CCSX_CreateContext,
+CCSX_DataDecryptInit,
+CCSX_DataEncryptInit,
+CCSX_Decrypt,
+CCSX_DecryptFinal,
+CCSX_DecryptRestart,
+CCSX_DecryptUpdate,
+CCSX_DeObfuscate,
+CCSX_DestroyContext,
+CCSX_DestroyObject,
+CCSX_Digest,
+CCSX_DigestFinal,
+CCSX_DigestInit,
+CCSX_DigestRestart,
+CCSX_DigestUpdate,
+CCSX_Encrypt,
+CCSX_EncryptFinal,
+CCSX_EncryptRestart,
+CCSX_EncryptUpdate,
+CCSX_FindObjects,
+CCSX_FindObjectsInit,
+CCSX_GenerateCertificate,
+CCSX_GenerateCertificateFromRequest,
+CCSX_GenerateKey,
+CCSX_GenerateKeyPair,
+CCSX_GetAlgorithmInfo,
+CCSX_GetAlgorithmList,
+CCSX_GetAttributeValue,
+CCSX_GetCertificate,
+CCSX_GetInfo,
+CCSX_GetKMStrength,
+CCSX_GetModuleInfo,
+CCSX_GetMoreAlgorithmInfo,
+CCSX_GetPolicyInfo,
+CCSX_GetRandom,
+CCSX_Goodbye,
+CCSX_LoadBinderySessionKey,
+CCSX_LoadCertificate,
+CCSX_LoadSelfSignedCertificate,
+CCSX_LoadUnverifiedCertificate,
+CCSX_Obfuscate,
+CCSX_PacketReplySign,
+CCSX_PacketReSign,
+CCSX_PacketSign,
+CCSX_PacketSignInit,
+CCSX_SetAttributeValue,
+CCSX_Sign,
+CCSX_SignFinal,
+CCSX_SignInit,
+CCSX_SignRecover,
+CCSX_SignRecoverInit,
+CCSX_SignRecoverRestart,
+CCSX_SignRestart,
+CCSX_SignUpdate,
+CCSX_UnwrapKey,
+CCSX_UnwrapSessionKey,
+CCSX_Verify,
+CCSX_VerifyFinal,
+CCSX_VerifyInit,
+CCSX_VerifyRecover,
+CCSX_VerifyRecoverInit,
+CCSX_VerifyRecoverRestart,
+CCSX_VerifyRestart,
+CCSX_VerifyUpdate,
+CCSX_WrapKey,
+SSLX_CalcMAC,
+SSLX_ComputeKeys,
+SSLX_DestroySSLKeys,
+SSLX_GenerateClientNonce,
+SSLX_GenerateServerNonce,
+SSLX_GenerateSessionID,
+SSLX_GetHandshakeHashes,
+SSLX_PKCS1_PrivateDecrypt,
+SSLX_PKCS1_PublicEncrypt
+
diff --git a/rtl/netware/classes.pp b/rtl/netware/classes.pp
new file mode 100644
index 0000000000..8d418a3fc8
--- /dev/null
+++ b/rtl/netware/classes.pp
@@ -0,0 +1,59 @@
+{
+ $Id: classes.pp,v 1.8 2005/03/07 17:57:24 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for win32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ types,
+ typinfo,
+ rtlconsts;
+
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+initialization
+ CommonInit;
+
+finalization
+ DoneThreads;
+ CommonCleanup;
+
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.8 2005/03/07 17:57:24 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.7 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.6 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+}
diff --git a/rtl/netware/clib.imp b/rtl/netware/clib.imp
new file mode 100644
index 0000000000..57ecf46a93
--- /dev/null
+++ b/rtl/netware/clib.imp
@@ -0,0 +1,1937 @@
+#
+# ad 2003/03/01: added contents of nit, nlmlib, threads, requestr, lib0, fpsm
+#
+ _3xAddFSMonitorHook,
+ _3xRemoveFSMonitorHook,
+ __8087,
+ _8087,
+ abort,
+ AbortServicingQueueJobAndFile,
+ abs,
+ accept,
+ access,
+ AccountingInstalled,
+ acos,
+ AddBinderyObjectToSet,
+ AddConnectionToSyncTable,
+ _AddExtendedHandle,
+ AddLanguage,
+ AddLink,
+ _AddNLMDependent,
+ _AddNLMEntry,
+ _AddSignalEntry,
+ AddSpaceRestrictionForDirectory,
+ AddTrustee,
+ AddUserSpaceRestriction,
+ AdvertiseService,
+ AFPAllocTemporaryDirHandle,
+ AFPCreateDirectory,
+ AFPCreateFile,
+ AFPDelete,
+ AFPDirectoryEntry,
+ AFPGetEntryIDFromName,
+ AFPGetEntryIDFromNetWareHandle,
+ AFPGetEntryIDFromPathName,
+ AFPGetFileInformation,
+ AFPOpenFileFork,
+ AFPRename,
+ AFPScanFileInformation,
+ AFPSetFileInformation,
+ AFPSupported,
+ Alloc,
+ AllocateBlockOfTasks,
+ AllocateCLIBHandle,
+ AllocateCLIBHandleStruct,
+ AllocateDynArrayEntry,
+ AllocateGivenDynArrayEntry,
+ _AllocateNCPSlotTCP,
+ _AllocateNCPSlotUDP,
+ AllocateResourceTag,
+ _AllocMutex,
+ _AllocMutexedData,
+ _AllocRwLock,
+ _AllocSemaphore,
+ AllocShMemCtrlStruct,
+ _AllocSleepOK,
+ _AllocSpinLock,
+ altzone,
+ ASCIIZToLenStr,
+ ASCIIZToMaxLenStr,
+ asctime,
+ asctime_r,
+ asin,
+ ___assert,
+ __assert,
+ ___assertCancelAbort,
+ AsyncRead,
+ AsyncRelease,
+ atan,
+ atan2,
+ atexit,
+ atof,
+ atoi,
+ atol,
+ atomic_add,
+ atomic_btr,
+ atomic_bts,
+ atomic_dec,
+ atomic_inc,
+ atomic_sub,
+ atomic_xchg,
+ AttachByAddress,
+ AttachQueueServerToQueue,
+ AttachToFileServer,
+ AtUnload,
+ BeginThread,
+ BeginThreadGroup,
+ BeginThreadGroup_500,
+ bind,
+ BitClear,
+ BitSet,
+ BitTest,
+ BitTestAndClear,
+ BitTestAndSet,
+ BlockedOnSleep,
+ Breakpoint,
+ BroadcastToConsole,
+ bsd_accept,
+ bsd_bind,
+ bsd_close,
+ bsd_connect,
+ bsd_deregister,
+ bsd_fd_clr,
+ bsd_fd_isset,
+ bsd_fd_set,
+ bsd_forget_thread,
+ bsd_getpeername,
+ bsd_getsockname,
+ bsd_getsockopt,
+ bsd_ioctl,
+ bsd_listen,
+ bsd_recvmsg,
+ bsd_register,
+ _bsd_select,
+ bsd_select,
+ bsd_select_wakeup,
+ bsd_sendmsg,
+ bsd_setsockopt,
+ bsd_shutdown,
+ bsd_sleep,
+ bsd_socket,
+ BSDSocketCleanup,
+ bsd_wakeup,
+ bsd_wakeup_all,
+ bsearch,
+ BuildDBCSTableFromVector,
+ _BumpFunctionCount,
+ cabs,
+ CalculateIsDST,
+ CalendarDayFromOrdinalDayWeek,
+ CallLibraryCleanups,
+ calloc,
+ CancelNoSleepAESProcessEvent,
+ CancelSleepAESProcessEvent,
+ ceil,
+ cgets,
+ ChangeBinderyObjectPassword,
+ ChangeBinderyObjectSecurity,
+ ChangeDirectoryEntry,
+ ChangePropertySecurity,
+ ChangeQueueJobEntry,
+ ChangeQueueJobPosition,
+ ChangeToClientRights,
+ chdir,
+ CheckConsolePrivileges,
+ CheckForCancellation,
+ CheckIfConnectionActive,
+ CheckIfScreenDisplayed,
+ CheckNetWareVersion,
+ _CheckNLMState,
+ __CHK,
+ chmod,
+ __CHP,
+ chsize,
+ CleanLocalConnectionFromNLM,
+ _clear87,
+ ClearConnectionNumber,
+ clearenv,
+ clearerr,
+ ClearFile,
+ ClearFileSet,
+ ClearLogicalRecord,
+ ClearLogicalRecordSet,
+ ClearNLMDontUnloadFlag,
+ ClearPhysicalRecord,
+ ClearPhysicalRecordSet,
+ ClearThreadInSyncTable,
+ CLibAlloc,
+ CLibGlobals,
+ CLibRealloc,
+ _clock,
+ clock,
+ close,
+ CloseBindery,
+ closedir,
+ closedir_510,
+ __CloseDuplicateNLMHandle,
+ CloseEA,
+ CloseFileAndAbortQueueJob,
+ CloseFileAndStartQueueJob,
+ CloseLocalSemaphore,
+ CloseSemaphore,
+ clrscr,
+ connect,
+ ConsolePrintf,
+ _control87,
+ _ConvertDOSTimeToCalendar,
+ ConvertFilDesToNetWareOSHandle,
+ ConvertNameToFullPath,
+ ConvertNameToFullPathNoUpper,
+ ConvertNameToVolumePath,
+ ConvertPathForDisplay,
+ ConvertScrHandleToScrStruct,
+ _ConvertTimeToDOS,
+ ConvertWildString,
+ CopyEA,
+ Copy__fp_characteristics,
+ CopyFromScreenMemory,
+ CopyToScreenMemory,
+ cos,
+ cosh,
+ CountAndFlushLibStats,
+ CountComponents,
+ cprintf,
+ __cputs,
+ cputs,
+ creat,
+ CreateAQueue,
+ CreateBinderyObject,
+ _CreateCallBackBlock,
+ CreateChildProcess,
+ CreateJavaLibTailorStruct,
+ CreateLibraryContext,
+ CreateProperty,
+ CreateQueueJobAndFile,
+ CreateScreen,
+ cscanf,
+ ctime,
+ ctime_r,
+ __ctype,
+ CurrentNCSDSGlobals,
+ CurrentProcess,
+ daylight,
+ daylightOffset,
+ daylightOnOff,
+ _DBCSVector,
+ DeallocateCLIBHandle,
+ DeallocateDynArrayEntry,
+ _DeallocMutex,
+ _DeallocMutexedData,
+ _DeallocRwLock,
+ _DeallocSemaphore,
+ _DeallocSpinLock,
+ DebugBoobyTrapPID,
+ Debug_free,
+ DebugGetNLMFromPID,
+ DebugGetPIDName,
+ _DebugLog,
+ _DebugLogClose,
+ _DebugLogMode,
+ _DebugLogOpen,
+ Debug_malloc,
+ DebugSetupPIDForACleanExit,
+ DebugUnBoobyTrapPID,
+ DebugValidatePID,
+ DecrementRTagCount,
+ _DefaultSignalHandler,
+ delay,
+ DeleteBinderyObject,
+ DeleteBinderyObjectFromSet,
+ DeleteProperty,
+ DeleteTrustee,
+ DeleteUserSpaceRestriction,
+ __delink,
+ DeLinkTCSFromTGCS,
+ _DeRegisterAddressSpace,
+ DeregisterEnvNotification,
+ DeregisterLibrary,
+ _DestroyCallBackBlock,
+ DestroyLibraryContext,
+ DestroyQueue,
+ DestroyScreen,
+ _DestroyThread,
+ DestroyThread,
+ _DestroyThreadGroup,
+ DetachQueueServerFromQueue,
+ DetectIPProtocols,
+ DetectIPXProtocols,
+ DFSclose,
+ DFScreat,
+ DFSExpandFile,
+ DFSFreeLimboVolumeSpace,
+ DFSRead,
+ DFSReadNoWait,
+ DFSReturnFileMappingInformation,
+ DFSReturnVolumeBlockInformation,
+ DFSReturnVolumeMappingInformation,
+ DFSSetDataSize,
+ DFSSetEndOfFile,
+ DFSsopen,
+ DFSWrite,
+ DFSWriteNoWait,
+ difftime,
+ _disable,
+ DisableAndRetFlags,
+ DisableConnection,
+ DisableFileServerLogin,
+ DisableStationBroadcasts,
+ DisableTransactionTracking,
+ DisplayConnectionsByNLM,
+ DisplayConnectionsByServer,
+ DisplayInputCursor,
+ DisplayScreen,
+ DisposeJavaLibTailorStruct,
+ div,
+ DOSChangeFileMode,
+ DOSClose,
+ DOSCopy,
+ DOSCreate,
+ DOSFindFirstFile,
+ DOSFindNextFile,
+ DOSMkdir,
+ DOSOpen,
+ DOSPresent,
+ DOSRead,
+ DOSRemove,
+ DOSRename,
+ DOSRmdir,
+ DOSSetDateAndTime,
+ DOSShutOffFloppyDrive,
+ DOSsopen,
+ DOSUnlink,
+ DOSWrite,
+ DownFileServer,
+ DropPopUpScreen,
+ DSAllocateEventTag,
+ DSAllocTDSData,
+ _DSAPICreateSessionKey,
+ DSCheckIfConnection,
+ DSCleanUpDSAPIsConnections,
+ DSCloseFileHandle,
+ DSConnectionExists,
+ DSConvertFileHandle,
+ DSCreateContext,
+ DSDeinit,
+ DSFreeConnectionSlot,
+ DSFreeContext,
+ DSFreeTDSData,
+ DSGetConnectionHandle,
+ DSGetConnectionIDFromAddress,
+ DSGetConnectionInfo,
+ DSGetConnectionSlot,
+ DSGetContextPtr,
+ DSGetFileServerVersion,
+ DSGetNearestDirectoryService,
+ DSGetTDSControlInfo,
+ DSReadFromTDS,
+ DSSendToLocalServer,
+ DSSetConnectionStatus,
+ DSSetCurrentConnection,
+ DSSetLicensedBit,
+ DSValidateUserID,
+ DSWriteToTDS,
+ dup,
+ dup2,
+ __DuplicateNLMHandle,
+ ecvt,
+ _enable,
+ EnableConnection,
+ EnabledPointerIncrement,
+ EnableFileServerLogin,
+ EnableStationBroadcasts,
+ EnableTransactionTracking,
+ EnterCritSec,
+ EnterDebugger,
+ EnumerateEA,
+ EnvironmentExists,
+ eof,
+ __EPI,
+ ExamineLocalSemaphore,
+ _ExamineSemaphore,
+ ExamineSemaphore,
+ _exit,
+ exit,
+ ExitCritSec,
+ ExitFSHooks,
+ ExitThread,
+ exp,
+ fabs,
+ fbufsize,
+ fclose,
+ fcloseall,
+ fcntl,
+ fcvt,
+ __FDA,
+ __FDC,
+ __FDD,
+ __FDFS,
+ __FDI4,
+ __FDM,
+ __FDN,
+ fdopen,
+ __FDS,
+ fdsize,
+ fdtype,
+ __FDU4,
+ __FDU87,
+ FEConvertDirectoryNumber,
+ FEcreat,
+ FEFlushWrite,
+ FEGetCWDnum,
+ FEGetCWVnum,
+ FEGetDirectoryEntry,
+ FEGetEntryVersion,
+ FEGetOpenFileInfo,
+ FEGetOpenFileInfoForNS,
+ FEGetOriginatingNameSpace,
+ FEMapConnsHandleToVolAndDir,
+ FEMapHandleToVolumeAndDirectory,
+ FEMapPathVolumeDirToVolumeDir,
+ FEMapVolumeAndDirectoryToPath,
+ FEMapVolumeAndDirectoryToPathForNS,
+ FEMapVolumeNumberToName,
+ feof,
+ FEQuickClose,
+ FEQuickFileLength,
+ FEQuickOpen,
+ FEQuickRead,
+ FEQuickWrite,
+ FERegisterNSPathParser,
+ ferror,
+ FESetCWDnum,
+ FESetCWVandCWDnums,
+ FESetCWVnum,
+ FESetOriginatingNameSpace,
+ FEsopen,
+ fflush,
+ fgetc,
+ fgetchar,
+ fgetpos,
+ fgets,
+ filelength,
+ fileno,
+ FileServerFileCopy,
+ filesize,
+ filetype,
+ filetypeandsize,
+ _FillHandlePathPath,
+ _FillStructure,
+ FindCancelRecInList,
+ FindConnectionInSyncTable,
+ FindNLMHandle,
+ FindNLMHandleInAddressSpace,
+ FindSymbol,
+ FinishServicingQueueJobAndFile,
+ FirstWeekDayOfMonth,
+ FixupCallToData,
+ FixupCallToFunc,
+ FixupStubToData,
+ FixupStubToFunc,
+ floor,
+ _fltused_,
+ flushall,
+ flushenv,
+ FlushLibStats,
+ fmod,
+ fopen,
+ __fp_characteristics,
+ fpgetmask,
+ fpgetround,
+ fpgetsticky,
+ _fpreset,
+ fprintf,
+ fpsetmask,
+ fpsetround,
+ fpsetsticky,
+ fputc,
+ fputchar,
+ fputs,
+ fread,
+ free,
+ Free,
+ FreeLink,
+ FreeQueryServicesList,
+ FreeShMemCtrlStruct,
+ _FreeUpProcessFromSemaphore,
+ _FreeUpProcessFromSpecificMutex,
+ _FreeUpProcessFromSpecificSemaphore,
+ _FreeUpProcessFromSpecRwLock,
+ freopen,
+ frexp,
+ __FSA,
+ __FSC,
+ fscanf,
+ __FSD,
+ fseek,
+ fsetmode,
+ fsetpos,
+ __FSFD,
+ __FSI1,
+ __FSI2,
+ __FSI4,
+ __FSM,
+ __FSN,
+ __FSS,
+ fstat,
+ fstat_410,
+ fstat_411,
+ fstat_500,
+ __FSU1,
+ __FSU2,
+ __FSU4,
+ __FSU87,
+ ftell,
+ __full_io_exit,
+ fwrite,
+ gAbbrevDay,
+ gAbbrevMonth,
+ gBeginCLibNLM,
+ gBeginCLibThread,
+ gBeginCLibThreadGroup,
+ gCumulDaysToMonth,
+ gCumulDaysToMonthInLeapYear,
+ gcvt,
+ gDateTimeFmt,
+ gDay,
+ gDaysInMonth,
+ gDaysInMonthOfLeapYear,
+ gDebugString,
+ gDummyContext,
+ gEndCLibThread,
+ gEndCLibThreadGroup,
+ gEndNoContextCLibNLM,
+ GetAccountStatus,
+ __get_altzone,
+ GetAvailableUserDiskSpace,
+ GetBinderyAccessLevel,
+ GetBinderyObjectDiskSpaceLeft,
+ GetBinderyObjectID,
+ GetBinderyObjectName,
+ GetBroadcastMessage,
+ getc,
+ getch,
+ getchar,
+ getche,
+ __get_cin,
+ Get_CLIB_BSD_DIAG,
+ Get_CLIB_CONTEXT_FLAGS,
+ GetCLIBHandleStruct,
+ Get_CLIB_MEM_FLAGS,
+ __GetCLIBNLMPrefixSize,
+ Get_CLIB_RING_BUFFER_TRACK,
+ Get_CLIB_SYNC_FLAGS,
+ __get_CLK_TCK,
+ GetClockStatus,
+ getcmd,
+ GetConnectionID,
+ GetConnectionInformation,
+ GetConnectionList,
+ GetConnectionNumber,
+ GetConnectionSemaphores,
+ GetConnectionsOpenFiles,
+ GetConnectionsTaskInformation,
+ GetConnectionsUsageStats,
+ GetConnectionsUsingFile,
+ GetContext,
+ __get_cout,
+ GetCurrentAddressSpaceID,
+ _GetCurrentClock,
+ GetCurrentConnection,
+ GetCurrentConnectionID,
+ GetCurrentFileServerID,
+ GetCurrentOSLanguageID,
+ GetCurrentScreen,
+ GetCurrentTask,
+ GetCurrentTicks,
+ GetCurrentTransportType,
+ GetCursorCouplingMode,
+ GetCursorShape,
+ GetCursorSize,
+ GetCustomThreadDataArea,
+ getcwd,
+ GetDataAreaPtr,
+ GetDataStreamName,
+ __get_daylight,
+ __get_daylightOffset,
+ __get_daylightOnOff,
+ GetDefaultConnectionID,
+ GetDefaultFileServerID,
+ __get_default_tzname,
+ GetDiskCacheStats,
+ GetDiskChannelStats,
+ GetDiskSpaceUsedByObject,
+ GetDiskUtilization,
+ GetDriveMappingTable,
+ __GETDS,
+ GetEAInfo,
+ GetEffectiveRights,
+ getenv,
+ GetEnv,
+ _get_errno,
+ __get_errno_ptr,
+ __get_errno_string,
+ GetExtendedFileAttributes,
+ _GetFDDataAreaPtr,
+ Get_FD_SETSIZE,
+ GetFileHoleMap,
+ GetFileServerDateAndTime,
+ GetFileServerDescriptionStrings,
+ GetFileServerID,
+ GetFileServerLANIOStats,
+ GetFileServerLoginStatus,
+ GetFileServerMiscInformation,
+ GetFileServerName,
+ GetFileSystemStats,
+ GetFirstShMemCtrlStruct,
+ GetHighResolutionTimer,
+ GetInternetAddress,
+ _getIPAddressFromSLP,
+ GetLANAddress,
+ GetLANDriverConfigInfo,
+ GetLib0InternalVersion,
+ GetLibraryFunction,
+ GetLibraryMessage,
+ GetLoaderType,
+ GetLogicalRecordInformation,
+ GetLogicalRecordsByConnection,
+ GetMaximumNumberOfStations,
+ GetMaximumUserSpaceRestriction,
+ GetModuleAddress,
+ getmsg,
+ GetNameSpaceName,
+ GetNCSAllocRTag,
+ GetNCSProfileInfo,
+ GetNCSsizeof_long_double,
+ GetNCSVersionFlag,
+ GetNetNumber,
+ GetNetworkSerialNumber,
+ GetNLMHandle,
+ GetNLMID,
+ GetNLMIDFromNLMHandle,
+ GetNLMIDFromThreadID,
+ GetNLMLP,
+ GetNLMNameFromNLMHandle,
+ GetNLMNameFromNLMID,
+ GetNumberOfVolumes,
+ __get_NWErrno,
+ _get_NWErrno,
+ __get_NWErrno_ptr,
+ GetObjectConnectionNumbers,
+ GetOFSAccessNShare,
+ GetOFSConnection,
+ getOFSInfo,
+ GetOFSNWHandle,
+ GetOFSPosition,
+ GetOFSStdConsole,
+ GetOFSTask,
+ GetOFSThreadID,
+ GetOFSType,
+ GetPathFromDirectoryEntry,
+ getpeername,
+ GetPhysicalDiskStats,
+ GetPhysicalRecordLocksByFile,
+ GetPhysRecLockByConnectAndFile,
+ GetPositionOfOutputCursor,
+ GetProcessContext,
+ GetPrty,
+ GetQueueJobList,
+ GetQueueJobsFileSize,
+ gets,
+ __GetScreenID,
+ GetScreenInfo,
+ GetSemaphoreInformation,
+ GetServerConfigurationInfo,
+ _GetServerInformation,
+ GetServerInformation,
+ GetServerMemorySize,
+ GetServerUtilization,
+ GetSessionListHasChanged,
+ GetSetableParameterValue,
+ GetSizeOfScreen,
+ getsockname,
+ getsockopt,
+ GetStationAddress,
+ __get_stderr,
+ __get_stdin,
+ __get_stdout,
+ GetSuperHighResolutionTimer,
+ _GetSyncClockFields,
+ GetSyncTableInfo,
+ GetSyntheticVersion,
+ GetTCSProfileInfo,
+ __get_t_errno_ptr,
+ GetTGLP,
+ GetThLP,
+ GetThreadAddressSpaceID,
+ GetThreadContextSpecifier,
+ __get_thread_data_area_ptr,
+ GetThreadDataAreaPtr,
+ GetThreadFromThreadGroup,
+ GetThreadGroupID,
+ GetThreadHandicap,
+ GetThreadID,
+ __GetThreadIDFromPCB,
+ GetThreadName,
+ GetThreadSuspendFlags,
+ __get_timezone,
+ GetTimeZoneInfo,
+ __get_tzname,
+ GetUserNameFromNetAddress,
+ _GetVolInfoWithNum,
+ GetVolumeDriveStartBlock,
+ GetVolumeInformation,
+ GetVolumeInfoWithNumber,
+ GetVolumeName,
+ GetVolumeNumber,
+ GetVolumeStatistics,
+ _GetXVolInfo,
+ gHugeValue,
+ GiveMeTheConn,
+ GiveMeTheSession,
+ GiveUpTheConn,
+ GiveUpTheSession,
+ gLibraryVersion,
+ gMonth,
+ gmtime,
+ gmtime_r,
+ gNCPDisconnect,
+ gotoxy,
+ gPostEndCLibNLM,
+ gPreEndCLibNLM,
+ gReleaseFileResourcesForThread,
+ gRequestrTGCSTearDown,
+ gStreamCancel,
+ gwrite,
+ HandleCtrlChars,
+ haveOFSReady,
+ HideInputCursor,
+ htol,
+ _HugeValue,
+ hypot,
+ __I4FD,
+ __I4FS,
+ __I8D,
+ __I8LS,
+ __I8M,
+ __I8RS,
+ _ibsscan,
+ _idonwprint,
+ _idoprint,
+ _idoscan,
+ ImportSymbol,
+ IncrementRTagCount,
+ __init_387_emulator,
+ InitializeConsoleOFS,
+ InitializeFSHooks,
+ _InitializeNLMDABs,
+ _InitializeSapGuy,
+ inp,
+ inpd,
+ InProtectedAddressSpace,
+ inpw,
+ InternalBeginThread,
+ InternalBeginThreadGroup,
+ InternalGetNLMID,
+ InternalGetNLMsAllocRTag,
+ InternalGetNLMsSemaRTag,
+ InternalRegisterLibrary,
+ InternalStartNLM,
+ _InternalSuspendOrStop,
+ InternalTrackSemaphore,
+ InternalUnTrackSemaphore,
+ IntSwap,
+ __INWLogFile,
+ ioctl,
+ IpxCancelEvent,
+ IpxCheckSocket,
+ IpxCloseSocket,
+ IpxConnect,
+ IpxDisconnect,
+ IpxGetAndClearQ,
+ IpxGetInternetworkAddress,
+ IpxGetLocalTarget,
+ IpxGetStatistics,
+ IpxGetVersion,
+ IpxOpenSocket,
+ IpxQueuedReceive,
+ IpxQueuedSend,
+ IpxReceive,
+ IpxResetStatistics,
+ IpxSend,
+ isalnum,
+ isalpha,
+ isascii,
+ isatty,
+ IsBinderyObjectInSet,
+ iscntrl,
+ IsColorMonitor,
+ isdigit,
+ _isDOSPrint,
+ isgraph,
+ islower,
+ IsMacintoshTextFile,
+ IsNameSpaceLoaded,
+ IsOnSummerTime,
+ isprint,
+ ispunct,
+ isspace,
+ _IsTable,
+ IsThreadSuspended,
+ is_unix_text_file,
+ isupper,
+ isxdigit,
+ itoa,
+ itoab,
+ j0,
+ j1,
+ jn,
+ kbhit,
+ KillChildProcess,
+ labs,
+ ldexp,
+ ldiv,
+ LenStrCat,
+ LenStrCmp,
+ LenStrCpy,
+ LenToASCIIZStr,
+ __LFileSet,
+ _Lib0AdvertiseService,
+ Lib0Alloc,
+ Lib0Assign,
+ Lib0Free,
+ Lib0MemCpy,
+ Lib0MemSet,
+ Lib0Realloc,
+ _Lib0ShutdownAdvertising,
+ Lib3Globals,
+ LibAsyncRead,
+ LibAsyncRelease,
+ LibraryFunctionRegistryStats,
+ LinkTCSToTGCS,
+ listen,
+ LLAToI,
+ LLDecStrToNum,
+ LLGetToken,
+ LLGetTokenTypeStr,
+ LLHexStrToAddr,
+ LLInitTokenRec,
+ LLIntToBinStr,
+ _Llocaleconv,
+ LLOutputToScreen,
+ LLOutputToScreenSingle,
+ LLOutputToScreenWithVa_list,
+ LLUngetToken,
+ LLZeroToken,
+ LoadLanguageMessageTable,
+ localeconv,
+ localtime,
+ localtime_r,
+ lock,
+ LockFileSet,
+ LockLogicalRecordSet,
+ _LockMutex,
+ _LockMutexNoCancel,
+ LockPhysicalRecordSet,
+ __LockPRecSet,
+ _LockSpinLock,
+ _LockSpinLockDisable,
+ log,
+ log10,
+ LogFile,
+ LoginObject,
+ LoginToFileServer,
+ LoginUser,
+ LogLogicalRecord,
+ Logout,
+ LogoutConnection,
+ LogoutFromFileServer,
+ LogoutObject,
+ LogPhysicalRecord,
+ __LogPRec,
+ __LogRec,
+ longjmp,
+ _LongJmp,
+ LongSwap,
+ __LRecSet,
+ _lrotl,
+ _lrotr,
+ lseek,
+ Lstridiff,
+ ltoa,
+ _makepath,
+ malloc,
+ _MapExtendedHandle,
+ MapNLMIDToHandle,
+ MapScreenIDToHandle,
+ _MarkNLMFinished,
+ matherr,
+ max,
+ mblen,
+ mbstowcs,
+ mbtowc,
+ memchr,
+ memcmp,
+ memcpy,
+ memicmp,
+ memmove,
+ memset,
+ min,
+ mkdir,
+ mkdir_510,
+ mktime,
+ MM_Abort_Function,
+ MM_AddMirrorObjectToMirrorGroup,
+ MM_Check_For_Pending_Aborts,
+ MM_CreateHotFix,
+ MM_Create_Media_Object,
+ MM_CreateMirror,
+ MM_CreatePartition,
+ MM_DeleteHotFix,
+ MM_Delete_Media_Object,
+ MM_DeleteMirror,
+ MM_DeletePartition,
+ MM_DelPartitionFromMirrorGroup,
+ MM_Find_Object_Type,
+ MM_ForceMirrorGroupInSync,
+ MM_InitializePartitionTable,
+ MM_Object_Blocking_IO,
+ MM_Object_IO,
+ MM_Register_Application,
+ MM_Register_Identification_Routines,
+ MM_Register_Notify_Routine,
+ MM_Release_Object,
+ MM_Release_Unload_Semaphore,
+ MM_RemirrorGroup,
+ MM_Rename_Object,
+ MM_Reserve_Object,
+ MM_ReturnMirrorInfo,
+ MM_Return_Object_Attribute,
+ MM_Return_Object_Generic_Info,
+ MM_Return_Object_Mapping_Info,
+ MM_Return_Objects_Attributes,
+ MM_Return_Object_Specific_Info,
+ MM_Return_Object_Table_Size,
+ MM_ReturnPartitionTableInfo,
+ MM_Set_Object_Attribute,
+ MM_Set_Unload_Semaphore,
+ MM_Special_Object_Blocking_IO,
+ MM_Unregister_Application,
+ MM_Unregister_Identification_Routines,
+ MM_Unregister_Notify_Routine,
+ modf,
+ ModifyInheritedRightsMask,
+ _ModifyKernelMemory,
+ MoveData,
+ MPAllocMutex,
+ MPDeallocMutex,
+ MPKAllocQue,
+ MPKAllocQueLite,
+ MPKAllocQueLiteNoSleep,
+ MPKBarrierAlloc,
+ MPKBarrierDecrement,
+ MPKBarrierFree,
+ MPKBarrierIncrement,
+ MPKBarrierThreadCount,
+ MPKBarrierWait,
+ MPKBarrierWaitCount,
+ MPKCreateThread,
+ MPKCurrentThread,
+ MPKDeQue,
+ MPKDeQueAll,
+ MPKDeQueAllNoLock,
+ MPKDeQueByQLink,
+ MPKDeQueByQLinkNoLock,
+ MPKDeQueLite,
+ MPKDeQueLiteAll,
+ MPKDeQueLiteAllNoLock,
+ MPKDeQueLiteByQueLink,
+ MPKDeQueLiteByQueLinkNoLock,
+ MPKDeQueLiteNoLock,
+ MPKDeQueLiteWait,
+ MPKDeQueLiteWaitNoLock,
+ MPKDeQueNoLock,
+ MPKDeQueWait,
+ MPKDeQueWaitNoLock,
+ MPKDestroyThread,
+ MPKEnQue,
+ MPKEnQueLite,
+ MPKEnQueLiteNoLock,
+ MPKEnQueNoLock,
+ MPKEnQueOrdered,
+ MPKEnQueOrderedNoLock,
+ MPKEnterNetWare,
+ MPKExitClassicNetWare,
+ MPKExitNetWare,
+ MPKFirstQLinkNoLock,
+ MPKFirstQueLinkLiteNoLock,
+ MPKFreeQue,
+ MPKFreeQueLite,
+ MPKFunc,
+ MPKFunc_kCurrentThread,
+ MPKFunc_kGetNPLThreadData,
+ MPKFunc_kGetThreadLibraryContext,
+ MPKFunc_kSetNPLThreadData,
+ MPKFunc_kSetThreadLibraryContext,
+ MPKGetThreadName,
+ MPKGetThreadPriority,
+ MPKMutexAlloc,
+ MPKMutexFree,
+ MPKMutexLock,
+ MPKMutexTryLock,
+ MPKMutexUnlock,
+ MPKMutexWaitCount,
+ MPKPushQue,
+ MPKPushQueLite,
+ MPKPushQueLiteNoLock,
+ MPKPushQueNoLock,
+ MPKPushQueOrdered,
+ MPKPushQueOrderedNoLock,
+ MPKQueCount,
+ MPKQueLiteCount,
+ MPKResumeThread,
+ MPKRWLockAlloc,
+ MPKRWLockFree,
+ MPKRWLockInfo,
+ MPKRWReadLock,
+ MPKRWReadTryLock,
+ MPKRWReadUnlock,
+ MPKRWWriteLock,
+ MPKRWWriteTryLock,
+ MPKRWWriteUnlock,
+ MPKScheduleThread,
+ MPKSemaphoreAlloc,
+ MPKSemaphoreExamineCount,
+ MPKSemaphoreFree,
+ MPKSemaphoreSignal,
+ MPKSemaphoreTimedWait,
+ MPKSemaphoreTry,
+ MPKSemaphoreWait,
+ MPKSemaphoreWaitCount,
+ MPKSetThreadName,
+ MPKSetThreadPriority,
+ MPKStartThread,
+ MPKSuspendThread,
+ MPKVar_kNPLThreadData,
+ MPKVar_kThreadLibraryContext,
+ MPKVar_RunningProcess,
+ MPKYieldThread,
+ MPLockMutex,
+ MPUnlockMutex,
+ _msize,
+ MTAllocMutex,
+ MTAllocRwLock,
+ MTDeallocMutex,
+ MTDeallocRwLock,
+ MTLockMutex,
+ MTReadRwLock,
+ MTReadRwUnlock,
+ MTUnlockMutex,
+ MTWriteRwLock,
+ MTWriteRwUnlock,
+ __Must_Have_Three_One_Or_Greater,
+ NCP87GenerateDirBase,
+ NCP87GetEntryInformation,
+ NCPAllocateTasks,
+ NCPAllocFileHandle,
+ NCPAllocSearchHandle,
+ NCPAttachHandle,
+ NCPChangeBinderyObjectPassword,
+ NCPCheckForNewPacket,
+ NCPCloseDirectory,
+ NCPCloseEA,
+ NCPCloseFile,
+ NCPConnect,
+ NCPConnectByAddress,
+ NCPConnectByAddressTCP,
+ NCPConnectByAddressUDP,
+ NCPConnectTCP,
+ NCPConnectUDP,
+ _NCPConvertNameSpacePath,
+ NCPConvertPath,
+ NCPConvertPathToDirEntry,
+ NCPCreateSessionKey,
+ NCPDirectorySearch,
+ _NCPDisconnect,
+ NCPDisconnect,
+ NCPEraseFile,
+ NCPFreeDebugPacket,
+ NCPFreeDirHandle,
+ NCPFreeFileHandle,
+ NCPFreeSearchHandle,
+ NCPFreeUserConnections,
+ NCPGetCachedConnection,
+ NCPGetConnectionFromSlot,
+ NCPGetConnectionInfo,
+ NCPGetConnectionSlot,
+ NCPGetConnectionTask,
+ NCPGetConnectionUser,
+ NCPGetDirHandle,
+ NCPGetDirPath,
+ NCPGetEntryAccessRights,
+ NCPGetEntryAttributes,
+ NCPGetEntryInformation,
+ NCPGetFileHandleList,
+ NCPGetFileSize,
+ NCPGetFullPath,
+ NCPGetMonitoredConnection,
+ NCPGetNextDebugPacket,
+ NCPGetNumOfConnections,
+ NCPGetNWCConnectionInfo,
+ NCPGetSecurityFlags,
+ NCPGetServerConnection,
+ NCPGetServerID,
+ NCPGetServerIDFromAddress,
+ NCPGetServerIDFromName,
+ NCPGetServerName,
+ NCPGetServerVersion,
+ _NCPGetSessionKey,
+ NCPGetSessionKey,
+ NCPGetUserConnection,
+ NCPGetVolumeNumberFromDirectoryHandle,
+ NCPIsValidConnection,
+ NCPLockRec,
+ NCPLoginToRemoteServer,
+ _NCPLogout,
+ NCPLogout,
+ NCPLogoutDSConnection,
+ NCPLogoutFromServer,
+ NCPMakeDirectory,
+ NCPModifyDirectoryEntry,
+ NCPOpenCreate,
+ NCPOpenDirectory,
+ NCPOrderedRequestAll,
+ NCPReadFile,
+ NCPRegisterPacketDebugger,
+ NCPRemoveDirectory,
+ NCPRenameEntry,
+ NCPRequest,
+ NCPRequestAll,
+ NCPResetDirHandle,
+ NCPReturnTasks,
+ NCPScanExtendedTrustees,
+ NCPScanFileInformation,
+ NCPScanNWCConnectionInfo,
+ NCPScanTrustees,
+ NCPSend,
+ NCPSendToLocalServer,
+ NCPSendToLocalServerWithReplyLen,
+ NCPSetConnectionInfo,
+ NCPSetConnectionUser,
+ NCPSetFileAttributes,
+ NCPSetFileInformation,
+ NCPSetLicensedBit,
+ NCPSetNWCConnectionInfo,
+ NCPSetTask,
+ NCPStartSigning,
+ NCPUnlockRec,
+ NCPUnRegisterPacketDebugger,
+ NCPVerifyBinderyObjectPassword,
+ NCPWriteFile,
+ NCSDSGlobals,
+ NetWareAlert,
+ NITGlobals,
+ NLMDEBUGDoneWithOFS,
+ NLMDebugVar,
+ NLMLIBArgvParser,
+ NLMLibGlobals,
+ NormalizeStructTM,
+ NotifyNLMDebug,
+ NotifyThreadsOfInterfaces,
+ NVMFunc,
+ NWAddFSMonitorHook,
+ NWAddRecordToAuditingFile,
+ NWAddSearchPathAtEnd,
+ _NWCAttachByAddress,
+ _NWCAttachByAddressP,
+ _NWCAttachToFileServer,
+ _NWCAttachToFileServerP,
+ _NWCDecrementConnectionCount,
+ _NWCGetConnectionCount,
+ NWCharType,
+ NWCharUpr,
+ NWCharVal,
+ _NWCIncrementConnectionCount,
+ NWClearBreakpoint,
+ NWConvertToUpperCase,
+ NWcprintf,
+ _NWCreateSessionKey,
+ NWDeleteSearchPath,
+ NWDeRegisterDMSupportModule,
+ NWDeRegisterNCPExtension,
+ _NWDeregisterNLMLibrary,
+ NWDeRegisterRTDataMigrationNLM,
+ NWDoesStringHaveControlChars,
+ NWDSCreateUser,
+ NWDSDeleteUser,
+ NWDSGetCurrentUser,
+ NWDSGetDefaultNameContext,
+ NWDSSetCurrentUser,
+ NWDSSetPreferredDSTree,
+ NWFindAnchor,
+ NWfprintf,
+ NWGarbageCollect,
+ NWGetAllocPageOverhead,
+ NWGetAuditingIdentity,
+ NWGetAvailableMemory,
+ NWGetCompressedFileLengths,
+ NWGetDataMigratorInfo,
+ NWGetDefaultSupportModule,
+ _NWGetDirBaseFromPath,
+ NWGetDirBaseFromPath,
+ NWGetDiskIOsPending,
+ NWGetDMFileInfo,
+ NWGetDMVolumeInfo,
+ _NWGetErrno,
+ NWGetExtendedVolumeInfo,
+ NWGetHugeNSInfo,
+ NWGetNameSpaceEntryName,
+ NWGetNCPExtensionInfo,
+ NWGetNCPExtensionInfoByID,
+ _NWGetNLMLevelLibDataPtr,
+ NWGetNSInfo,
+ NWGetNSLoadedList,
+ _NWGetNWErrno,
+ NWGetPacketBurstBufferCount,
+ NWGetPageSize,
+ NWGetSearchPathElement,
+ _NWGetSecurityFlags,
+ NWGetSecurityLevel,
+ NWGetSessionKey,
+ NWGetSupportModuleInfo,
+ _NWGetThreadGroupLevelLibDataPtr,
+ _NWGetThreadLevelLibDataPtr,
+ NWGetVolumeFlags,
+ NWIncrement,
+ NWInsertSearchPath,
+ NWIsDataMigrationAllowed,
+ NWLatoi,
+ NWLisalnum,
+ NWLisalpha,
+ NWLisdigit,
+ NWLlocaleconv,
+ NWLmblen,
+ _NWLoadNLMMessageTable,
+ NWLsetlocale,
+ NWLsetlocale_411,
+ _NWLstrchr,
+ NWLstrchr,
+ _NWLstrcoll,
+ NWLstrcoll,
+ NWLstrcspn,
+ NWLstrftime,
+ NWLstrpbrk,
+ NWLstrrchr,
+ NWLstrrev,
+ NWLstrspn,
+ NWLstrstr,
+ _NWLstrupr,
+ NWLstrupr,
+ NWLstrxfrm,
+ NWMapDown,
+ NWMapUp,
+ NWMapUpPathComponentString,
+ NWmblen,
+ NWMemorySizeAddressable,
+ NWMoveFileFromDM,
+ NWMoveFileToDM,
+ NWNCPSend,
+ NWNumberOfRegisteredProcessors,
+ _NWOSMajorVersion,
+ _NWOSMinorVersion,
+ NWPeekFileData,
+ _NWPrevChar,
+ NWPrevChar,
+ NWprintf,
+ NWQAbortJob,
+ NWQAbortJobService,
+ NWQAttachServer,
+ NWQBeginJobService,
+ NWQChangeJobEntry,
+ NWQChangeJobPosition,
+ NWQChangeJobQueue,
+ NWQChangeToClientRights,
+ NWQCreate,
+ NWQCreateJob,
+ NWQDestroy,
+ NWQDetachServer,
+ NWQEndJobService,
+ NWQGetJobEntry,
+ NWQGetJobFileSize,
+ NWQGetServers,
+ NWQGetServerStatus,
+ NWQGetStatus,
+ NWQMarkJobForService,
+ NWQRemoveJob,
+ NWQRestoreServerRights,
+ NWQScanJobNums,
+ NWQServiceJob,
+ NWQSetServerStatus,
+ NWQSetStatus,
+ NWQueryNSInfoFormat,
+ NWRAllocTds,
+ NWRAuthenticateBind,
+ NWRAuthenticateDS,
+ NWRCloseConn,
+ NWRConvertLocalFileHandle,
+ NWRConvertNetwareFileHandle,
+ NWRCreateSessionKey,
+ NWRegisterDMSupportModule,
+ NWRegisterNCPExtension,
+ NWRegisterNCPExtensionByID,
+ _NWRegisterNLMLibrary,
+ _NWRegisterNLMLibraryUser,
+ NWRegisterRTDataMigrationNLM,
+ NWRemoveFSMonitorHook,
+ NWREnumerateTds,
+ NWRFreeTds,
+ NWRGetConnInfo,
+ NWRGetDefNameContext,
+ NWRGetMonitoredConnReference,
+ NWRGetNumConns,
+ NWRGetPrefDsTreeName,
+ NWRGetPrefServerName,
+ NWRGetPrimConnRef,
+ NWRGetRequesterVersion,
+ NWRGetSecurityFlags,
+ NWRGetSessionKey,
+ NWRGetTdsInfo,
+ NWRLicenseConn,
+ NWRMakeConnPermanent,
+ NWROpenConnByAddr,
+ NWROpenConnByName,
+ NWROpenConnByReference,
+ NWROrderedRequestAll,
+ NWRReadTds,
+ NWRRenegotiateSecurityLevel,
+ NWRRequest,
+ NWRRequestAll,
+ NWRResetRequester,
+ NWRScanConnInfo,
+ NWRSetConnInfo,
+ NWRSetDefNameContext,
+ NWRSetMonitoredConn,
+ NWRSetPrefDsTreeName,
+ NWRSetPrefServerName,
+ NWRSetPrimConnRef,
+ NWRSetSecurityFlags,
+ NWRSysCloseConn,
+ NWRUnauthenticateConnection,
+ NWRUnlicenseConn,
+ NWRWriteTds,
+ NWScanNCPExtensions,
+ NWSendNCPExtensionFraggedRequest,
+ NWSendNCPExtensionRequest,
+ NWSetAuditingIdentity,
+ NWSetBreakpoint,
+ NWSetCompressedFileLengths,
+ NWSetDefaultSupportModule,
+ _NWSetErrno,
+ NWSetHugeNSInfo,
+ NWSetNameSpaceEntryName,
+ _NWSetNLMLevelLibDataPtr,
+ NWSetNSInfo,
+ _NWSetNWErrno,
+ NWSetPacketBurstBufferCount,
+ NWSetSecurityLevel,
+ _NWSetThreadGroupLevelLibDataPtr,
+ _NWSetThreadLevelLibDataPtr,
+ NWSetVolumeFlags,
+ NWSMPBarrierAlloc,
+ NWSMPBarrierDestroy,
+ NWSMPBarrierWait,
+ NWSMPCondAlloc,
+ NWSMPCondBroadcast,
+ NWSMPCondDestroy,
+ NWSMPCondSignal,
+ NWSMPCondWait,
+ NWSMPIsAvailable,
+ NWSMPIsLoaded,
+ NWSMPMutexDestroy,
+ NWSMPMutexLock,
+ NWSMPMutexSleepAlloc,
+ NWSMPMutexTryLock,
+ NWSMPMutexUnlock,
+ NWSMPRMutexAlloc,
+ NWSMPRMutexDestroy,
+ NWSMPRMutexLock,
+ NWSMPRMutexOwner,
+ NWSMPRMutexTryLock,
+ NWSMPRMutexUnlock,
+ NWSMPRWLockAlloc,
+ NWSMPRWLockDestroy,
+ NWSMPRWReadLock,
+ NWSMPRWTryReadLock,
+ NWSMPRWTryWriteLock,
+ NWSMPRWUnlock,
+ NWSMPRWWriteLock,
+ NWSMPSpinAlloc,
+ NWSMPSpinDestroy,
+ NWSMPSpinLock,
+ NWSMPSpinTryLock,
+ NWSMPSpinUnlock,
+ NWSMPThreadToMP,
+ NWSMPThreadToNetWare,
+ NWsprintf,
+ _NWStoreAsComponentPath,
+ NWstrImoney,
+ NWstrmoney,
+ NWstrncoll,
+ NWstrncpy,
+ NWstrnum,
+ NWThreadToMP,
+ NWThreadToNetWare,
+ NWToLowerCase,
+ NWvcprintf,
+ NWvfprintf,
+ NWVolumeIsCDROM,
+ NWvprintf,
+ NWvsprintf,
+ NWwsprintf,
+ OFSFromDescriptor,
+ __old_8087,
+ OldNLMBinary,
+ open,
+ OpenBindery,
+ opendir,
+ opendir_411,
+ OpenEA,
+ OpenLocalSemaphore,
+ OpenSemaphore,
+ OpenStandardConsoleOFS,
+ OptimalPageUseSize,
+ OSAddressSpaceID,
+ OSFunc,
+ _OSTZSet,
+ OSVar,
+ outp,
+ outpd,
+ outpw,
+ OverrideInternalVersion,
+ _OwnerMutex,
+ _OwnerRwLock,
+ _ParseArgs,
+ _ParsePath,
+ ParsePath,
+ PBurstRead,
+ PBurstWrite,
+ perror,
+ pipe,
+ poll,
+ PopThreadCleanup,
+ PopThreadGroupCleanup,
+ pow,
+ pread,
+ PressAnyKeyToContinue,
+ PressEscapeToQuit,
+ printf,
+ PrintLibError,
+ PrintMem,
+ ProcessFromThreadID,
+ PurgeErasedFile,
+ PurgeTrusteeFromVolume,
+ _PUSH_CANCELLATION,
+ PushThreadCleanup,
+ PushThreadGroupCleanup,
+ putc,
+ putch,
+ putchar,
+ putenv,
+ PutLibraryFunction,
+ putmsg,
+ puts,
+ pwrite,
+ __qcalloc,
+ __qmalloc,
+ qread,
+ __qrealloc,
+ qsort,
+ QueryServices,
+ QueueDirectReadFileNoWait,
+ QueueDirectWriteFileNoWait,
+ qwrite,
+ raise,
+ rand,
+ rand_r,
+ RBAddToReadSuspendList,
+ RBAddToWriteSuspendList,
+ RBBufferIOState,
+ RBBufferPeek,
+ RBClose,
+ RBOpen,
+ RBRead,
+ RBRemoveThreadFromPipe,
+ RBReset,
+ RBResumeReaders,
+ RBResumeWriters,
+ RBSetBufferSize,
+ RBWrite,
+ __RDI4,
+ __RDU4,
+ read,
+ readdir,
+ readdir_411,
+ ReadEA,
+ _ReadNLMExitCode,
+ ReadPropertyValue,
+ ReadQueueCurrentStatus,
+ ReadQueueJobEntry,
+ ReadQueueServerCurrentStatus,
+ _ReadRwLock,
+ readv,
+ realloc,
+ RecordNWErrnoAndErrno,
+ RecordTestResult,
+ recv,
+ recvfrom,
+ recvmsg,
+ RedirectFrontEndedAddresses,
+ RedirectSymbolInLoadedModule,
+ ReEnableConnection,
+ _RegisterAddressSpace,
+ RegisterConsoleCommand,
+ RegisterEnvNotification,
+ RegisterFileOpenWatch,
+ RegisterForEvent,
+ RegisterForThreadSwitchEvent,
+ RegisterLibrary,
+ RegisterMatherrHandler,
+ RegisterProfiler,
+ _ReleaseAllSemaphore,
+ ReleaseFile,
+ ReleaseFileSet,
+ ReleaseLogicalRecord,
+ ReleaseLogicalRecordSet,
+ ReleasePhysicalRecord,
+ ReleasePhysicalRecordSet,
+ remainder,
+ _RemoteServerCleanup,
+ remove,
+ _RemoveExtendedHandle,
+ RemoveJobFromQueue,
+ _RemoveNLMDependent,
+ _RemoveSignalEntry,
+ _rename,
+ rename,
+ RenameBinderyObject,
+ RenameLanguage,
+ RenameThread,
+ _ReportContextError,
+ _Report_errno,
+ _ReportNoContext,
+ _Report_NWErrno,
+ ReqFunc,
+ ReqFunc_IPFindRoute,
+ ReqFunc_NWgethostbyname,
+ ReqFunc_SAPGetServerEntry,
+ ReqFunc_SLPDeregisterClient,
+ ReqFunc_SLPReadAttributes,
+ ReqFunc_SLPRegisterClient,
+ ReqFunc_TCPAbort,
+ ReqFunc_TCPBind,
+ ReqFunc_TCPClose,
+ ReqFunc_TCPConnect,
+ ReqFunc_TCPDeregister,
+ ReqFunc_TCPGetOption,
+ ReqFunc_TCPLastSendData,
+ ReqFunc_TCPListen,
+ ReqFunc_TCPNewSendData,
+ ReqFunc_TCPNewWindow,
+ ReqFunc_TCPRegister,
+ ReqFunc_TCPSetOption,
+ ReqFunc_UDPDeregister,
+ ReqFunc_UDPRegister,
+ ReqFunc_UDPReturnPacket,
+ ReqFunc_UDPSend,
+ RequestrGlobals,
+ ResetDSTParms,
+ RestoreQueueServerRights,
+ ResumeThread,
+ ReturnAndClearConnection,
+ ReturnBlockOfTasks,
+ ReturnConnection,
+ ReturnLanguageName,
+ ReturnLocalConnection,
+ _ReturnLocalConnectionInfo,
+ ReturnNLMVersionInfoFromFile,
+ ReturnNLMVersionInformation,
+ ReturnSpaceRestrictionForDirectory,
+ rewind,
+ rewinddir,
+ RingTheBell,
+ rmdir,
+ _rotl,
+ _rotr,
+ SalvageErasedFile,
+ SaveDataAreaPtr,
+ SaveThreadDataAreaPtr,
+ ScanBinderyObject,
+ ScanBinderyObjectTrusteePaths,
+ ScanBits,
+ ScanClearedBits,
+ scanenv,
+ ScanEnvVariables,
+ ScanErasedFiles,
+ ScanErasedFiles_411,
+ scanf,
+ ScanProperty,
+ ScanScreens,
+ ScanSetableParameters,
+ ScanTrustees,
+ ScanUserSpaceRestrictions,
+ ScheduleNoSleepAESProcessEvent,
+ ScheduleSleepAESProcessEvent,
+ ScheduleWorkToDo,
+ __screenOutput,
+ ScrollScreenRegionDown,
+ ScrollScreenRegionUp,
+ ScrollWindowScreenRegionDown,
+ ScrollWindowScreenRegionUp,
+ SecondsToTicks,
+ sel_cvt_from_skts,
+ sel_cvt_to_skts,
+ select,
+ send,
+ SendBroadcastMessage,
+ SendConsoleBroadcast,
+ sendmsg,
+ _SendSignal,
+ sendto,
+ ServiceQueueJobAndOpenFile,
+ SetAutoScreenDestructionMode,
+ setbuf,
+ SetCLIBHandleStruct,
+ SetCLIBTCSBlockCode,
+ SetConnectionCriticalErrorHandler,
+ _SetCriticalErrorHandler,
+ SetCtrlCharCheckMode,
+ SetCurrentConnection,
+ SetCurrentConnectionID,
+ SetCurrentFileServerID,
+ SetCurrentNameSpace,
+ SetCurrentOSLanguageID,
+ SetCurrentScreen,
+ SetCurrentTask,
+ SetCursorCouplingMode,
+ SetCursorShape,
+ SetCustomThreadDataArea,
+ SetDirectoryInfo,
+ __set_EDOM,
+ setenv,
+ SetEnv,
+ __set_ERANGE,
+ _set_errno,
+ SetExtendedFileAttributes,
+ _SetFDDataAreaPtr,
+ Set_FD_SETSIZE,
+ SetFileInfo,
+ SetFileServerDateAndTime,
+ SetFlags,
+ SetHardwareInterrupt,
+ SetInputAtOutputCursorPosition,
+ _setjmp,
+ setjmp,
+ setlocale,
+ setlocale_411,
+ SetMacintoshTextMode,
+ setmode,
+ SetNCSProfileInfo,
+ SetNLMDontUnloadFlag,
+ SetNLMID,
+ _set_NWErrno,
+ SetOFSPosition,
+ SetOutputAtInputCursorPosition,
+ SetPositionOfInputCursor,
+ SetProcessContext,
+ SetPrty,
+ SetQueueCurrentStatus,
+ SetQueueServerCurrentStatus,
+ SetReaddirAttribute,
+ SetRTagCustomData,
+ SetScreenAreaAttribute,
+ SetScreenCharacterAttribute,
+ SetScreenRegionAttribute,
+ SetSecurityLevel,
+ SetSessionListHasChanged,
+ SetSetableParameterValue,
+ SetSocketStructClientInfo,
+ setsockopt,
+ SetSyncTableInfo,
+ SetSyntheticVersion,
+ SetTargetNameSpace,
+ SetTCSProfileInfo,
+ SetThreadContextSpecifier,
+ SetThreadGroupID,
+ SetThreadHandicap,
+ set_unix_text_mode,
+ _SetupArgv,
+ _SetupArgV_411,
+ setvbuf,
+ SetWildcardTranslationMode,
+ shm_open,
+ shm_unlink,
+ shutdown,
+ ShutdownAdvertising,
+ signal,
+ SignalLocalSemaphore,
+ _SignalSemaphore,
+ SignalSemaphore,
+ sin,
+ sinh,
+ _SizeOfAllocBlock,
+ socket,
+ sopen,
+ spawnlp,
+ spawnvp,
+ _splitpath,
+ sprintf,
+ __SPSemaphore,
+ SpxAbortConnection,
+ SpxCancelEvent,
+ SpxCheckSocket,
+ SpxCloseSocket,
+ SpxEstablishConnection,
+ SpxGetConfiguration,
+ SpxGetConnectionStatus,
+ SpxGetTime,
+ SpxGetVersion,
+ SpxListenForConnectedPacket,
+ SpxListenForConnection,
+ SpxListenForSequencedPacket,
+ SpxOpenSocket,
+ SpxQueuedListenForSequencedPacket,
+ SpxQueuedSendSequencedPacket,
+ SpxSendSequencedPacket,
+ SpxTerminateConnection,
+ sqrt,
+ srand,
+ sscanf,
+ SSGetActiveConnListByType,
+ SSGetActiveLANBoardList,
+ SSGetActiveProtocolStacks,
+ SSGetCacheInfo,
+ SSGetCPUInfo,
+ SSGetDirCacheInfo,
+ SSGetFileServerInfo,
+ SSGetFileSystemInfo,
+ SSGetGarbageCollectionInfo,
+ SSGetIPXSPXInfo,
+ SSGetKnownNetworksInfo,
+ SSGetKnownServersInfo,
+ SSGetLANCommonCounters,
+ SSGetLANConfiguration,
+ SSGetLANCustomCounters,
+ SSGetLoadedMediaNumberList,
+ SSGetLSLInfo,
+ SSGetLSLLogicalBoardStats,
+ SSGetMediaManagerObjChildList,
+ SSGetMediaManagerObjInfo,
+ SSGetMediaManagerObjList,
+ SSGetMediaNameByNumber,
+ SSGetNetRouterInfo,
+ SSGetNetworkRoutersInfo,
+ SSGetNLMInfo,
+ SSGetNLMLoadedList,
+ SSGetNLMResourceTagList,
+ SSGetOSVersionInfo,
+ SSGetPacketBurstInfo,
+ SSGetProtocolConfiguration,
+ SSGetProtocolCustomInfo,
+ SSGetProtocolNumbersByLANBoard,
+ SSGetProtocolNumbersByMedia,
+ SSGetProtocolStatistics,
+ SSGetRouterAndSAPInfo,
+ SSGetServerInfo,
+ SSGetServerSourcesInfo,
+ SSGetUserInfo,
+ SSGetVolumeSegmentList,
+ SSGetVolumeSwitchInfo,
+ stackavail,
+ StackAvail,
+ StackLimit,
+ _StartNLM,
+ stat,
+ stat_410,
+ stat_411,
+ stat_500,
+ _status87,
+ __STK,
+ __STOSB,
+ __STOSD,
+ strcat,
+ strchr,
+ strcmp,
+ strcmpi,
+ strcoll,
+ strcpy,
+ strcspn,
+ strdup,
+ strerror,
+ strftime,
+ stricmp,
+ StripFileServerFromPath,
+ strlen,
+ strlist,
+ strlwr,
+ strncat,
+ strncmp,
+ strncpy,
+ strnicmp,
+ strnset,
+ strpbrk,
+ strrchr,
+ strrev,
+ strset,
+ strspn,
+ strstr,
+ strtod,
+ strtod_ld,
+ strtoi,
+ strtok,
+ strtok_r,
+ strtol,
+ strtoul,
+ strupr,
+ strxfrm,
+ SubmitAccountCharge,
+ SubmitAccountChargeWithLength,
+ SubmitAccountHold,
+ SubmitAccountNote,
+ _SuspendOrStop,
+ SuspendThread,
+ swab,
+ swaw,
+ SynchronizeStart,
+ SyntheticVersion,
+ sys_errlist,
+ sys_nerr,
+ system,
+ SystemConsoleScreen,
+ TailorForJava,
+ tan,
+ tanh,
+ TCPGetSendCB,
+ TCPRcvCB,
+ TCPSendDoneCB,
+ TCSFromThreadID,
+ tell,
+ _TerminateNLM,
+ ThreadsGlobals,
+ ThreadSwitch,
+ ThreadSwitchLowPriority,
+ ThreadSwitchWithDelay,
+ TicksToSeconds,
+ _time,
+ time,
+ TimedWaitOnLocalSemaphore,
+ TimeToStructTM,
+ timezone,
+ tmpfile,
+ tmpnam,
+ toascii,
+# to be able to load generated nlm on netware 3.20
+ tolower,
+ ToolsFunc,
+ ToolsVar,
+ toupper,
+ TryLocalSemaphore,
+ _TryLockMutex,
+ _TryReadRwLock,
+ _TrySpinLock,
+ _TrySpinLockDisable,
+ _TryWaitOnSemaphore,
+ _TryWriteRwLock,
+ TTSAbortTransaction,
+ TTSBeginTransaction,
+ TTSEndTransaction,
+ TTSGetApplicationThresholds,
+ TTSGetStats,
+ TTSGetWorkstationThresholds,
+ TTSIsAvailable,
+ TTSSetApplicationThresholds,
+ TTSSetWorkstationThresholds,
+ TTSTransactionStatus,
+ tzname,
+ tzset,
+ __U4FD,
+ __U4FS,
+ __U8D,
+ __U8FD7,
+ __U8FS7,
+ __U8LS,
+ __U8M,
+ __U8RS,
+ UDPRcvCB,
+ UDPSendDoneCB,
+ ultoa,
+ umask,
+ uname,
+ ungetc,
+ ungetch,
+ UnimportIPProtocols,
+ UnimportIPXProtocols,
+ UnimportSymbol,
+ unlink,
+ unlock,
+ _UnlockMutex,
+ _UnlockRwLock,
+ _UnlockSpecificMutex,
+ _UnlockSpinLock,
+ _UnlockSpinLockRestore,
+ UnRegisterConsoleCommand,
+ UnRegisterFileOpenWatch,
+ UnregisterForEvent,
+ UnRegisterForThreadSwitchEvent,
+ UnRegisterProfiler,
+ unsetenv,
+ UnsetMacintoshTextMode,
+ unset_unix_text_mode,
+ UpdateDirectoryEntry,
+ UseAccurateCaseForPaths,
+ utime,
+ utoa,
+ ValidateCLIBHandle,
+ ValidateMappedAddress,
+ vcprintf,
+ vcscanf,
+ VerifyBinderyObjectPassword,
+ VerifyNetworkSerialNumber,
+ vfprintf,
+ vfscanf,
+ vprintf,
+ vscanf,
+ vsprintf,
+ vsscanf,
+ WaitOnChildProcess,
+ WaitOnLocalSemaphore,
+ _WaitOnSemaphore,
+ WaitOnSemaphore,
+ wcstombs,
+ wctomb,
+ wherex,
+ wherey,
+ write,
+ WriteEA,
+ WritePropertyValue,
+ _WriteRwLock,
+ writev,
+ XlateLocaleCategory,
+ xldexp,
+ y0,
+ y1,
+ YearsSince1970,
+ yn,
+ __ZBuf2F,
+# GetKey,UnGetKey from server.nlm (or syscalls)
+ GetKey,
+ UngetKey
+
diff --git a/rtl/netware/clibaux.imp b/rtl/netware/clibaux.imp
new file mode 100644
index 0000000000..9d4005c00d
--- /dev/null
+++ b/rtl/netware/clibaux.imp
@@ -0,0 +1,4 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ CLibAuxIsLoaded
+
diff --git a/rtl/netware/clibctx.imp b/rtl/netware/clibctx.imp
new file mode 100644
index 0000000000..7e6f9c148a
--- /dev/null
+++ b/rtl/netware/clibctx.imp
@@ -0,0 +1,11 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ CtxVoid,
+ CtxInt,
+ CtxPtr,
+ CtxDouble,
+ CtxRegister,
+ CtxDeregister,
+ CtxBeginThread,
+ CtxBeginThreadGroup
+
diff --git a/rtl/netware/clxnlm32.imp b/rtl/netware/clxnlm32.imp
new file mode 100644
index 0000000000..25d445578e
--- /dev/null
+++ b/rtl/netware/clxnlm32.imp
@@ -0,0 +1,39 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWCLXInit,
+ NWCLXTerm,
+ NWCCGetCLXVersion,
+ NWCCOpenConnByName,
+ NWCCOpenConnByAddr,
+ NWCCOpenConnByRef,
+ NWCCCloseConn,
+ NWCCSysCloseConnRef,
+ NWCCMakeConnPermanent,
+ NWCCLicenseConn,
+ NWCCUnlicenseConn,
+ NWCCGetConnRef,
+ NWCCGetPrefServerName,
+ NWCCSetPrefServerName,
+ NWCCGetPrimConnRef,
+ NWCCSetPrimConn,
+ NWCCScanConnRefs,
+ NWCCGetConnInfo,
+ NWCCGetConnRefInfo,
+ NWCCGetAllConnInfo,
+ NWCCGetAllConnRefInfo,
+ NWCCGetConnAddressLength,
+ NWCCGetConnRefAddressLength,
+ NWCCGetConnAddress,
+ NWCCGetConnRefAddress,
+ NWCCOpenConnByPref,
+ NWCCQueryFeature,
+ NWCCGetNumConns,
+ NWCCScanConnInfo,
+ NWCCSetCurrentConnection,
+ NWCCResetRequester,
+ NWCCGetSecurityFlags,
+ NWCCSetSecurityFlags,
+ NWCCRenegotiateSecurityLevel,
+ NWCCRequest,
+ NWCCFragmentRequest
+
diff --git a/rtl/netware/convertimp b/rtl/netware/convertimp
new file mode 100644
index 0000000000..b9292a69bc
--- /dev/null
+++ b/rtl/netware/convertimp
@@ -0,0 +1,50 @@
+#!/bin/sh
+
+usage ()
+{
+ echo "$0 SOURCEDIR"
+ echo ""
+ echo "converts .imp, .Imp and .IMP files from DOS CR/LF to LF only and"
+ echo "translates filename to lower case. Converted files are stored"
+ echo "in current directory."
+ echo "ad 2001/04/16"
+ exit 1
+}
+
+cnv ()
+{
+ DESTFN=`echo "$1" | tr [A-Z] [a-z]`
+ echo -n "converting $1 to $DESTDIR/$DESTFN "
+
+ echo "# converted to unix by $USERNAME on $HST at $NOW" >$DESTDIR/$DESTFN
+ echo "#" >>$DESTDIR/$DESTFN
+ cat $1 | tr -d '\r' >> $DESTDIR/$DESTFN
+ # set time/date from source
+ touch -r $1 $DESTDIR/$DESTFN
+ echo ""
+}
+
+if [ -x /usr/bin/tr ]; then
+ if [ -x /bin/tr ]; then
+ if [ -x /usr/local/bin/tr ]; then
+ echo "this utility needs tr. Please install GNU textutils."
+ usage
+ fi
+ fi
+fi
+[ "$1" = "" ] && usage
+[ ! -d $1 ] && usage
+HST=`uname -n`
+NOW=`date`
+DESTDIR=`pwd`
+cd $1
+for i in *.imp; do
+ [ "$i" != "*.imp" ] && cnv $i
+done
+for i in *.IMP; do
+ [ "$i" != "*.IMP" ] && cnv $i
+done
+for i in *.Imp; do
+ [ "$i" != "*.Imp" ] && cnv $i
+done
+cd $DESTDIR
diff --git a/rtl/netware/crt.pp b/rtl/netware/crt.pp
new file mode 100644
index 0000000000..fd2fe4291e
--- /dev/null
+++ b/rtl/netware/crt.pp
@@ -0,0 +1,655 @@
+{
+ $Id: crt.pp,v 1.5 2004/02/08 16:22:20 michael Exp $
+ Copyright (c) 1999-2001 by the Free Pascal development team.
+
+ Borland Pascal 7 Compatible CRT Unit for Netware, tested with
+ Netware 4.11 and 5.1
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{At initialization time, AutoScreenDestructionMode is set to true so after program termination
+ no "press any key to close screen" is displayed. Also check for ctrl-c in readkey is disabled.
+ To enable ctrl-c check, set CheckBreak to true before calling ReadKey.
+
+ 2001/04/13 armin: first version for netware, compilable, completely untested
+ 2001/04/14 armin: tested, seems to work
+ TextMode, Sound and NoSound are dummys, don't know how to
+ implement that for netware
+}
+unit crt;
+
+interface
+
+{$i crth.inc}
+
+Const
+ ScreenHeight : longint=25;
+ ScreenWidth : longint=80;
+
+implementation
+
+{$I nwsys.inc}
+
+
+{$ASMMODE ATT}
+
+var
+ DelayCnt,
+// ScreenWidth,
+// ScreenHeight : longint;
+ VidSeg : Word;
+
+{
+ definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
+
+
+{****************************************************************************
+ Low level Routines
+****************************************************************************}
+
+procedure setscreenmode(mode : byte);
+begin
+end;
+
+
+function GetScreenHeight : longint;
+VAR Height, Width : WORD;
+begin
+ _GetSizeOfScreen (Height,Width);
+ GetScreenHeight := Height;
+end;
+
+
+function GetScreenWidth : longint;
+VAR Height, Width : WORD;
+begin
+ _GetSizeOfScreen (Height,Width);
+ GetScreenWidth := Width;
+end;
+
+
+procedure GetScreenCursor(var x,y : longint);
+begin
+ x := _wherex+1;
+ y := _wherey+1;
+end;
+
+
+{****************************************************************************
+ Helper Routines
+****************************************************************************}
+
+Function WinMinX: Longint;
+{
+ Current Minimum X coordinate
+}
+Begin
+ WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Longint;
+{
+ Current Minimum Y Coordinate
+}
+Begin
+ WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Longint;
+{
+ Current Maximum X coordinate
+}
+Begin
+ WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Longint;
+{
+ Current Maximum Y coordinate;
+}
+Begin
+ WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+Function FullWin:boolean;
+{
+ Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+ FullWin:=(WinMinX=1) and (WinMinY=1) and
+ (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
+end;
+
+
+{****************************************************************************
+ Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+begin
+ Window (1,1,byte(ScreenWidth),byte(ScreenHeight));
+ ClrScr;
+end;
+
+
+Procedure TextColor(Color: Byte);
+{
+ Switch foregroundcolor
+}
+Begin
+ TextAttr:=(Color and $f) or (TextAttr and $70);
+ If (Color>15) Then TextAttr:=TextAttr Or Blink;
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+ Switch backgroundcolor
+}
+Begin
+ TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+End;
+
+
+
+Procedure HighVideo;
+{
+ Set highlighted output.
+}
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+ Set normal output
+}
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+ Set normal back and foregroundcolors.
+}
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+ Go to coordinates X,Y in the current window.
+}
+Begin
+ If (X>0) and (X<=WinMaxX- WinMinX+1) and
+ (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+ Begin
+ X := X + WinMinX - 1;
+ Y := Y + WinMinY - 1;
+ _GotoXY (x-1,y-1);
+ End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+ Set screen window to the specified coordinates.
+}
+Begin
+ if (X1>X2) or (X2>ScreenWidth) or
+ (Y1>Y2) or (Y2>ScreenHeight) then
+ exit;
+ WindMin:=((Y1-1) Shl 8)+(X1-1);
+ WindMax:=((Y2-1) Shl 8)+(X2-1);
+ GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+ Clear the current window, and set the cursor on 1,1
+}
+var
+ fil : word;
+ y : longint;
+ p : pointer;
+ rowlen,rows: longint;
+begin
+ fil:=32 or (textattr shl 8);
+ if FullWin then
+ begin
+ _clrscr; {seems to swich cursor off}
+ _DisplayInputCursor;
+ end else
+ begin
+ rowlen := WinMaxX-WinMinX+1;
+ rows := WinMaxY-WinMinY+1;
+ GetMem (p, rows * rowlen * 2);
+ FillWord (p^, rows * rowlen, fil);
+ _CopyToScreenMemory (word(rows),word(rowlen),p,WinMinX-1,WinMinY-1);
+ FreeMem (p, rows * rowlen * 2);
+ end;
+ Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+ Clear from current position to end of line.
+}
+var
+ x,y : longint;
+ fil : word;
+ rowlen : word;
+ p : pointer;
+Begin
+ GetScreenCursor(x,y);
+ fil:=32 or (textattr shl 8);
+ if x<WinMaxX then
+ begin
+ rowlen := WinMaxX-x+1;
+ GetMem (p, rowlen * 2);
+ FillWord (p^, rowlen, fil);
+ _CopyToScreenMemory (1,rowlen,p,x-1,y-1);
+ FreeMem (p, rowlen * 2);
+ end;
+End;
+
+
+
+Function WhereX: Byte;
+{
+ Return current X-position of cursor.
+}
+var
+ x,y : longint;
+Begin
+ GetScreenCursor(x,y);
+ WhereX:=x-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+ Return current Y-position of cursor.
+}
+var
+ x,y : longint;
+Begin
+ GetScreenCursor(x,y);
+ WhereY:=y-WinMinY+1;
+End;
+
+
+{*************************************************************************
+ Keyboard
+*************************************************************************}
+
+var
+ is_last : boolean;
+
+function readkey : char;
+var
+ char1 : char;
+begin
+ if is_last then
+ begin
+ is_last:=false;
+ readkey:=_getch;
+ end else
+ begin
+ _SetCtrlCharCheckMode (CheckBreak);
+ char1 := _getch;
+ if char1 = #0 then is_last := true;
+ readkey:=char1;
+ end;
+end;
+
+
+function keypressed : boolean;
+begin
+ if is_last then
+ begin
+ keypressed:=true;
+ exit;
+ end else
+ keypressed := (_kbhit <> 0);
+end;
+
+
+{*************************************************************************
+ Delay
+*************************************************************************}
+
+procedure Delay(MS: Word);
+begin
+ _delay (MS);
+end;
+
+
+procedure sound(hz : word);
+begin
+ _RingTheBell;
+end;
+
+
+procedure nosound;
+begin
+end;
+
+
+
+{****************************************************************************
+ HighLevel Crt Functions
+****************************************************************************}
+
+procedure removeline(y : longint);
+var
+ fil : word;
+ rowlen : word;
+ p : pointer;
+begin
+ fil:=32 or (textattr shl 8);
+ rowlen:=WinMaxX-WinMinX+1;
+ GetMem (p, rowlen*2);
+ y:=WinMinY+y-1;
+ While (y<=WinMaxY) do
+ begin
+ _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,word(y));
+ _CopyToScreenMemory (1,rowlen,p,WinMinX-1,word(y-1));
+ inc(y);
+ end;
+ FillWord (p^,rowlen,fil);
+ _CopyToScreenMemory (1,rowlen,p,WinMinX-1,WinMaxY-1);
+ FreeMem (p, rowlen*2);
+end;
+
+
+procedure delline;
+begin
+ removeline(wherey);
+end;
+
+
+procedure insline;
+var
+ my : longint;
+ y : word;
+ fil : word;
+ rowlen : word;
+ p : pointer;
+begin
+ fil:=32 or (textattr shl 8);
+ y:=WhereY-1;
+ my:=WinMaxY-WinMinY;
+ rowlen := WinMaxX-WinMinX+1;
+ GetMem (p, rowlen*2);
+ while (my>=y) do
+ begin
+ _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,word(my));
+ _CopyToScreenMemory (1,rowlen,p,WinMinX-1,word(my+1));
+ dec(my);
+ end;
+ FillWord (p^,rowlen,fil);
+ _CopyToScreenMemory (1,rowlen,p,WinMinX-1,y);
+ FreeMem (p, rowlen*2);
+end;
+
+
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+begin
+ if _IsColorMonitor <> 0 then
+ _SetCursorShape (9,$A)
+ else
+ _SetCursorShape ($B,$D);
+ _DisplayInputCursor;
+end;
+
+
+procedure cursoroff;
+begin
+ _HideInputCursor;
+end;
+
+
+procedure cursorbig;
+begin
+ _SetCursorShape (1,$A);
+ _DisplayInputCursor;
+end;
+
+
+{*****************************************************************************
+ Read and Write routines
+*****************************************************************************}
+
+var
+ CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var
+ w : word;
+begin
+ case c of
+ #10 : inc(CurrY);
+ #13 : CurrX:=WinMinX;
+ #8 : begin
+ if CurrX>WinMinX then
+ dec(CurrX);
+ end;
+ #7 : begin { beep }
+ _RingTheBell;
+ end;
+ else
+ begin
+ w:=(textattr shl 8) or byte(c);
+ _CopyToScreenMemory (1,1,@w,CurrX-1,CurrY-1);
+ inc(CurrX);
+ end;
+ end;
+ if CurrX>WinMaxX then
+ begin
+ CurrX:=WinMinX;
+ inc(CurrY);
+ end;
+ while CurrY>WinMaxY do
+ begin
+ removeline(1);
+ dec(CurrY);
+ end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+ i : longint;
+begin
+ GetScreenCursor(CurrX,CurrY);
+ for i:=0 to f.bufpos-1 do
+ WriteChar(f.buffer[i]); { ad: may be better to use a buffer but i think it's fast enough }
+ _GotoXY (CurrX-1,CurrY-1);
+ f.bufpos:=0;
+ CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+ procedure BackSpace;
+ begin
+ if (f.bufpos>0) and (f.bufpos=f.bufend) then
+ begin
+ WriteChar(#8);
+ WriteChar(' ');
+ WriteChar(#8);
+ dec(f.bufpos);
+ dec(f.bufend);
+ end;
+ end;
+
+var
+ ch : Char;
+Begin
+ GetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ f.bufend:=0;
+ repeat
+ if f.bufpos>f.bufend then
+ f.bufend:=f.bufpos;
+ _GotoXY (CurrX-1,CurrY-1);
+ ch:=readkey;
+ case ch of
+ #0 : case readkey of
+ #71 : while f.bufpos>0 do
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #75 : if f.bufpos>0 then
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #77 : if f.bufpos<f.bufend then
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #79 : while f.bufpos<f.bufend do
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ end;
+ ^S,
+ #8 : BackSpace;
+ ^Y,
+ #27 : begin
+ f.bufpos:=f.bufend;
+ while f.bufend>0 do
+ BackSpace;
+ end;
+ #13 : begin
+ WriteChar(#13);
+ WriteChar(#10);
+ f.bufptr^[f.bufend]:=#13;
+ f.bufptr^[f.bufend+1]:=#10;
+ inc(f.bufend,2);
+ break;
+ end;
+ #26 : if CheckEOF then
+ begin
+ f.bufptr^[f.bufend]:=#26;
+ inc(f.bufend);
+ break;
+ end;
+ else
+ begin
+ if f.bufpos<f.bufsize-2 then
+ begin
+ f.buffer[f.bufpos]:=ch;
+ inc(f.bufpos);
+ WriteChar(ch);
+ end;
+ end;
+ end;
+ until false;
+ f.bufpos:=0;
+ _GotoXY (CurrX-1,CurrY-1);
+ CrtRead:=0;
+End;
+
+
+Function CrtReturn(Var F: TextRec): Integer;
+Begin
+ CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+ If F.Mode=fmOutput Then
+ begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end
+ Else
+ begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+var
+ x,y : longint;
+begin
+{ Load startup values }
+ ScreenWidth:=GetScreenWidth;
+ ScreenHeight:=GetScreenHeight;
+ lastmode := CO80;
+ TextMode (lastmode);
+ GetScreenCursor(x,y);
+ if screenheight>25 then
+ lastmode:=lastmode or $100;
+ TextColor (LightGray);
+ TextBackground (Black);
+{ Redirect the standard output }
+ assigncrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:=StdOutputHandle;
+ assigncrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:=StdInputHandle;
+ CheckBreak := FALSE;
+ CheckEOF := FALSE;
+ _SetCtrlCharCheckMode (CheckBreak);
+ _SetAutoScreenDestructionMode (TRUE);
+end.
+
diff --git a/rtl/netware/demos/Makefile b/rtl/netware/demos/Makefile
new file mode 100644
index 0000000000..86cc121293
--- /dev/null
+++ b/rtl/netware/demos/Makefile
@@ -0,0 +1,25 @@
+# Makefile for freepascal nlm-test
+# Needs working nlmconv + i386-netware-ld
+# AD 8/2000
+
+PPC386OPT = -XX -O3 -Tnetware -Xs
+INCLUDES =
+
+OBJS = check.on
+
+%.on: %.pp
+ ppc386 $(PPC386OPT) $(INCLUDES) $*.pp
+
+all: $(OBJS)
+
+# copy test.nlm to sys:test on 4.11 (fs-develop) and 5.1 (fs-ad) server
+install: all
+ ncftpput -u linux -p linux fs-develop /sys/test *.nlm
+ ncftpput -u linux -p linux fs-ad /sys/test *.nlm
+
+clean:
+ rm -f *.on *.nlm *.ppn *.s *.bak *.o *.a
+
+dist: clean
+
+distclean: clean
diff --git a/rtl/netware/demos/check.pp b/rtl/netware/demos/check.pp
new file mode 100644
index 0000000000..2fa8026b2f
--- /dev/null
+++ b/rtl/netware/demos/check.pp
@@ -0,0 +1,53 @@
+{
+ $Id: check.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of Free Pascal for Netware.
+ Copyright (c) 1999-2002 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ Demonstrates the use of the check-function provided by the RTL
+ **********************************************************************}
+
+{$MODE OBJFPC}
+{$Description Demo CheckFunction for FreePascal Netware-RTL}
+{$Version 1.0.0}
+{$Copyright (c) 2002 the FreePascal development team}
+
+
+{ using crt automaticly calls _SetAutoScreenDestructionMode (TRUE);
+ so no "Press any key to close screeen" will be shown by netware }
+uses crt;
+
+var first : boolean = true;
+
+procedure checkfunction (var res : longint);
+begin
+ if first then
+ begin
+ ConsolePrintf (#13'It is unsafe to unload the nlm'#13#10);
+ res := 1;
+ end;
+ first := false;
+end;
+
+begin
+ WriteLn ('Press any key to unload nlm or unload via unload command');
+ WriteLn ('The first unload should show a message that it is unsafe');
+ WriteLn ('to unload the NLM, the second attempt should unload the');
+ WriteLn ('NLM without a message.');
+ System.NetwareCheckFunction := @checkfunction;
+ ReadKey;
+end.
+
+{
+ $Log: check.pp,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netware/dos.pp b/rtl/netware/dos.pp
new file mode 100644
index 0000000000..6dac9a8517
--- /dev/null
+++ b/rtl/netware/dos.pp
@@ -0,0 +1,529 @@
+{
+ $Id: dos.pp,v 1.15 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Dos unit for BP7 compatible RTL (novell netware)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit dos;
+interface
+
+Type
+ searchrec = packed record
+ DirP : POINTER; { used for opendir }
+ EntryP: POINTER; { and readdir }
+ Magic : WORD;
+ fill : array[1..11] of byte;
+ attr : byte;
+ time : longint;
+ { reserved : word; not in DJGPP V2 }
+ size : longint;
+ name : string[255]; { NW uses only [12] but more can't hurt }
+ end;
+
+{$i dosh.inc}
+
+implementation
+
+uses
+ strings, nwserv;
+
+{$DEFINE HAS_GETMSCOUNT}
+{$DEFINE HAS_GETCBREAK}
+{$DEFINE HAS_SETCBREAK}
+{$DEFINE HAS_KEEP}
+
+{$define FPC_FEXPAND_DRIVES}
+{$define FPC_FEXPAND_VOLUMES}
+{$define FPC_FEXPAND_NO_DEFAULT_PATHS}
+
+{$I dos.inc}
+
+
+{$ASMMODE ATT}
+{$I nwsys.inc }
+
+{*****************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+{$PACKRECORDS 4}
+
+
+function dosversion : word;
+VAR F : FILE_SERV_INFO;
+begin
+ IF GetServerInformation(SIZEOF(F),@F) = 0 THEN
+ dosversion := WORD (F.netwareVersion) SHL 8 + F.netwareSubVersion;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+VAR N : NWdateAndTime;
+begin
+ GetFileServerDateAndTime (N);
+ wday:=N.DayOfWeek;
+ year:=1900 + N.Year;
+ month:=N.Month;
+ mday:=N.Day;
+end;
+
+
+procedure setdate(year,month,day : word);
+VAR N : NWdateAndTime;
+begin
+ GetFileServerDateAndTime (N);
+ SetFileServerDateAndTime(year,month,day,N.Hour,N.Minute,N.Second);
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+VAR N : NWdateAndTime;
+begin
+ GetFileServerDateAndTime (N);
+ hour := N.Hour;
+ Minute:= N.Minute;
+ Second := N.Second;
+ sec100 := 0;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+VAR N : NWdateAndTime;
+begin
+ GetFileServerDateAndTime (N);
+ SetFileServerDateAndTime(N.year,N.month,N.day,hour,minute,second);
+end;
+
+
+function GetMsCount: int64;
+begin
+ GetMsCount := Nwserv.GetCurrentTicks * 55;
+end;
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+const maxargs=256;
+procedure exec(const path : pathstr;const comline : comstr);
+var c : comstr;
+ i : integer;
+ args : array[0..maxargs] of pchar;
+ arg0 : pathstr;
+ numargs : integer;
+begin
+ //writeln ('dos.exec (',path,',',comline,')');
+ arg0 := fexpand (path)+#0;
+ args[0] := @arg0[1];
+ numargs := 0;
+ c:=comline;
+ i:=1;
+ while i<=length(c) do
+ begin
+ if c[i]<>' ' then
+ begin
+ {Commandline argument found. append #0 and set pointer in args }
+ inc(numargs);
+ args[numargs]:=@c[i];
+ while (i<=length(c)) and (c[i]<>' ') do
+ inc(i);
+ c[i] := #0;
+ end;
+ inc(i);
+ end;
+ args[numargs+1] := nil;
+ i := spawnvp (P_WAIT,args[0],@args);
+ if i >= 0 then
+ begin
+ doserror := 0;
+ lastdosexitcode := i;
+ end else
+ begin
+ doserror := 8; // for now, what about errno ?
+ end;
+end;
+
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+ breakvalue := _SetCtrlCharCheckMode (false); { get current setting }
+ if breakvalue then
+ _SetCtrlCharCheckMode (breakvalue); { and restore old setting }
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+ _SetCtrlCharCheckMode (breakvalue);
+end;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+function getvolnum (drive : byte) : longint;
+var dir : STRING[255];
+ P,PS,
+ V : LONGINT;
+begin
+ if drive = 0 then
+ begin // get volume name from current directory (i.e. SERVER-NAME/VOL2:TEST)
+ getdir (0,dir);
+ p := pos (':', dir);
+ if p = 0 then
+ begin
+ getvolnum := -1;
+ exit;
+ end;
+ byte (dir[0]) := p-1;
+ dir[p] := #0;
+ PS := pos ('/', dir);
+ INC (PS);
+ if _GetVolumeNumber (@dir[PS], V) <> 0 then
+ getvolnum := -1
+ else
+ getvolnum := V;
+ end else
+ getvolnum := drive-1;
+end;
+
+
+function diskfree(drive : byte) : int64;
+VAR Buf : ARRAY [0..255] OF CHAR;
+ TotalBlocks : WORD;
+ SectorsPerBlock : WORD;
+ availableBlocks : WORD;
+ totalDirectorySlots : WORD;
+ availableDirSlots : WORD;
+ volumeisRemovable : WORD;
+ volumeNumber : LONGINT;
+begin
+ volumeNumber := getvolnum (drive);
+ if volumeNumber >= 0 then
+ begin
+ {i think thats not the right function but for others i need a connection handle}
+ if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
+ TotalBlocks,
+ SectorsPerBlock,
+ availableBlocks,
+ totalDirectorySlots,
+ availableDirSlots,
+ volumeisRemovable) = 0 THEN
+ begin
+ diskfree := int64 (availableBlocks) * int64 (SectorsPerBlock) * 512;
+ end else
+ diskfree := 0;
+ end else
+ diskfree := 0;
+end;
+
+
+function disksize(drive : byte) : int64;
+VAR Buf : ARRAY [0..255] OF CHAR;
+ TotalBlocks : WORD;
+ SectorsPerBlock : WORD;
+ availableBlocks : WORD;
+ totalDirectorySlots : WORD;
+ availableDirSlots : WORD;
+ volumeisRemovable : WORD;
+ volumeNumber : LONGINT;
+begin
+ volumeNumber := getvolnum (drive);
+ if volumeNumber >= 0 then
+ begin
+ {i think thats not the right function but for others i need a connection handle}
+ if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
+ TotalBlocks,
+ SectorsPerBlock,
+ availableBlocks,
+ totalDirectorySlots,
+ availableDirSlots,
+ volumeisRemovable) = 0 THEN
+ begin
+ disksize := int64 (TotalBlocks) * int64 (SectorsPerBlock) * 512;
+ end else
+ disksize := 0;
+ end else
+ disksize := 0;
+end;
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+
+PROCEDURE find_setfields (VAR f : searchRec);
+BEGIN
+ WITH F DO
+ BEGIN
+ IF Magic = $AD01 THEN
+ BEGIN
+ attr := WORD (PNWDirEnt(EntryP)^.d_attr); // lowest 16 bit -> same as dos
+ time := PNWDirEnt(EntryP)^.d_time + (LONGINT (PNWDirEnt(EntryP)^.d_date) SHL 16);
+ size := PNWDirEnt(EntryP)^.d_size;
+ name := strpas (PNWDirEnt(EntryP)^.d_name);
+ if name = '' then
+ name := strpas (PNWDirEnt(EntryP)^.d_nameDOS);
+ doserror := 0;
+ END ELSE
+ BEGIN
+ FillChar (f,SIZEOF(f),0);
+ doserror := 18;
+ END;
+ END;
+END;
+
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+ path0 : array[0..256] of char;
+begin
+ IF path = '' then
+ begin
+ doserror := 18;
+ exit;
+ end;
+ strpcopy(path0,path);
+ PNWDirEnt(f.DirP) := _opendir (path0);
+ IF f.DirP = NIL THEN
+ doserror := 18
+ ELSE
+ BEGIN
+ IF attr <> anyfile THEN
+ _SetReaddirAttribute (PNWDirEnt(f.DirP), attr);
+ F.Magic := $AD01;
+ PNWDirEnt(f.EntryP) := _readdir (PNWDirEnt(f.DirP));
+ IF F.EntryP = NIL THEN
+ BEGIN
+ _closedir (PNWDirEnt(f.DirP));
+ f.Magic := 0;
+ doserror := 18;
+ END ELSE
+ find_setfields (f);
+ END;
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+ IF F.Magic <> $AD01 THEN
+ BEGIN
+ doserror := 18;
+ EXIT;
+ END;
+ doserror:=0;
+ PNWDirEnt(f.EntryP) := _readdir (PNWDirEnt(f.DirP));
+ IF F.EntryP = NIL THEN
+ doserror := 18
+ ELSE
+ find_setfields (f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+ IF F.Magic <> $AD01 THEN
+ BEGIN
+ doserror := 18;
+ EXIT;
+ END;
+ doserror:=0;
+ _closedir (PNWDirEnt(f.DirP));
+ f.Magic := 0;
+ f.DirP := NIL;
+ f.EntryP := NIL;
+end;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+ i,p1 : longint;
+ s : searchrec;
+ newdir : pathstr;
+begin
+ write ('FSearch ("',path,'","',dirlist,'"');
+{ check if the file specified exists }
+ findfirst(path,anyfile,s);
+ if doserror=0 then
+ begin
+ findclose(s);
+ fsearch:=path;
+ exit;
+ end;
+{ No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow backslash as slash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='\' then dirlist[i]:='/';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
+ newdir:=newdir+'/';
+ findfirst(newdir+path,anyfile,s);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
+ end;
+ findclose(s);
+end;
+
+
+{******************************************************************************
+ --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+VAR StatBuf : NWStatBufT;
+ T : DateTime;
+ DosDate,
+ DosTime : WORD;
+begin
+ IF _fstat (FileRec (f).Handle, StatBuf) = 0 THEN
+ BEGIN
+ _ConvertTimeToDos (StatBuf.st_mtime, DosDate, DosTime);
+ time := DosTime + (LONGINT (DosDate) SHL 16);
+ END ELSE
+ time := 0;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+ {is there a netware function to do that ?????}
+ ConsolePrintf ('warning: fpc dos.setftime not implemented'#13#10);
+end;
+
+
+procedure getfattr(var f;var attr : word);
+VAR StatBuf : NWStatBufT;
+begin
+ IF _fstat (FileRec (f).Handle, StatBuf) = 0 THEN
+ BEGIN
+ attr := word (StatBuf.st_attr);
+ END ELSE
+ attr := 0;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+ {is there a netware function to do that ?????}
+ ConsolePrintf ('warning: fpc dos.setfattr not implemented'#13#10);
+end;
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+function envcount : longint;
+begin
+ envcount := 0; {is there a netware function to do that ?????}
+ ConsolePrintf ('warning: fpc dos.envcount not implemented'#13#10);
+end;
+
+
+function envstr (index: longint) : string;
+begin
+ envstr := ''; {is there a netware function to do that ?????}
+ ConsolePrintf ('warning: fpc dos.envstr not implemented'#13#10);
+end;
+
+{ works fine (at least with netware 6.5) }
+Function GetEnv(envvar: string): string;
+var envvar0 : array[0..512] of char;
+ p : pchar;
+ i,isDosPath,res : longint;
+begin
+ if upcase(envvar) = 'PATH' then
+ begin // netware does not have search paths in the environment var PATH
+ // return it here (needed for the compiler)
+ GetEnv := '';
+ i := 1;
+ res := _NWGetSearchPathElement (i, isdosPath, @envvar0[0]);
+ while res = 0 do
+
+ begin
+
+ if GetEnv <> '' then GetEnv := GetEnv + ';';
+
+ GetEnv := GetEnv + strpas(envvar0);
+
+ inc (i);
+
+ res := _NWGetSearchPathElement (i, isdosPath, @envvar0[0]);
+
+ end;
+
+ for i := 1 to length(GetEnv) do
+
+ if GetEnv[i] = '\' then
+
+ GetEnv[i] := '/';
+
+ end else
+ begin
+ strpcopy(envvar0,envvar);
+ p := _getenv (envvar0);
+ if p = NIL then
+ GetEnv := ''
+ else
+ GetEnv := strpas (p);
+ end;
+end;
+
+
+{******************************************************************************
+ --- Not Supported ---
+******************************************************************************}
+
+Procedure keep(exitcode : word);
+Begin
+ { simply wait until nlm will be unloaded }
+ while true do _delay (60000);
+End;
+
+
+end.
+{
+ $Log: dos.pp,v $
+ Revision 1.15 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.14 2005/01/11 11:32:33 armin
+ * fixed compile error in getenv
+
+}
+
diff --git a/rtl/netware/dplsv386.imp b/rtl/netware/dplsv386.imp
new file mode 100644
index 0000000000..5cf9adc3c2
--- /dev/null
+++ b/rtl/netware/dplsv386.imp
@@ -0,0 +1,276 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWDPLibTerm,
+ NWDPLibSetArtificialIODelay,
+ NWDPLibSetArtificialMemLimit,
+ NWDPLibMalloc,
+ NWDPLibFree,
+ NWDPLibRealloc,
+ NWDPLibCalloc,
+ NWDPLibQMalloc,
+ NWDPNSrvSetNativeNDSContext,
+ NWDPNSrvAddPrinterObject,
+ NWDPNSrvAddPSMObject,
+ NWDPNSrvAddBrokerObject,
+ NWDPNSrvMakeFQNFromObject,
+ NWDPNSrvRemoveObject,
+ NWDPNSrvCreateRef,
+ NWDPNSrvDestroyRef,
+ NWDPNSrvListObjects,
+ NWDPNSrvObjGetAttributeSet,
+ NWDPNSrvModifyAttrs,
+ NWDPNSrvGetNativeNDSContext,
+ NWDPNSrvValidateObjectRef,
+ NWDPNSrvQueryRoleMembership,
+ NWDPNSrvCompareNDSObjectNames,
+ NWDPSrsCreateRefBasedOnAddr,
+ NWDPSrsCreateRefBasedOnFQN,
+ NWDPSrsCreateRefBasedOnSAP,
+ NWDPSrsDeregisterServer,
+ NWDPSrsDestroyRef,
+ NWDPSrsGetConnectionStatus,
+ NWDPSrsGetFQN,
+ NWDPSrsListServers,
+ NWDPSrsRegisterServer,
+ NWDPSrsValidateRef,
+ NWDPNSrvQueryRoleMembership2,
+ NWDPNSrvModifyNDSSchema,
+ NWDPLibDisplayError,
+ NWDPSrsListServers2,
+ NWDPLibGetDefaultLanguageId,
+ NWDPBrkCreateRefBasedOnFQN,
+ NWDPBrkDestroyRef,
+ NWDPBrkDisableService,
+ NWDPBrkEnableService,
+ NWDPBrkGetConnectionStatus,
+ NWDPBrkGetFQN,
+ NWDPBrkListServices,
+ NWDPBrkShutdown,
+ NWDPBrkValidateRef,
+ NWDPResAddResourceFile,
+ NWDPResCreateRefBasedOnAddr,
+ NWDPResCreateRefBasedOnFQN,
+ NWDPResCreateRefBasedOnSrsSAP,
+ NWDPResDeleteResourceFile,
+ NWDPResDestroyRef,
+ NWDPResGetFQN,
+ NWDPResGetResourceFile,
+ NWDPResGetResourceFileDate,
+ NWDPResListResource,
+ NWDPResValidateRef,
+ NWDPNtfyAddDetailEventObject,
+ NWDPNtfyAddEvent,
+ NWDPNtfyAddFilterEventObject,
+ NWDPNtfyAddObjectEventObject,
+ NWDPNtfyAddMethod,
+ NWDPNtfyAddProfile,
+ NWDPNtfyCreateMethodInfoRef,
+ NWDPNtfyCreateProfileRef,
+ NWDPNtfyCreateProfileRefBOP,
+ NWDPNtfyCreateRefBasedOnFQN,
+ NWDPNtfyDestroyMethodInfoRef,
+ NWDPNtfyDestroyRef,
+ NWDPNtfyGetDeliveryMethodInfo,
+ NWDPNtfyGetProfileId,
+ NWDPNtfyGetProfileInfo,
+ NWDPNtfyGetSupportedEvents,
+ NWDPNtfyListEventObjects,
+ NWDPNtfyListMethods,
+ NWDPNtfyListProfiles,
+ NWDPNtfyListPrompts,
+ NWDPNtfyModifyProfile,
+ NWDPNtfyReleaseProfileRef,
+ NWDPNtfyRemoveDetailEventObject,
+ NWDPNtfyRemoveEvent,
+ NWDPNtfyRemoveFilterEventObject,
+ NWDPNtfyRemoveObjectEventObject,
+ NWDPNtfyRemoveMethod,
+ NWDPNtfyRemoveProfile,
+ NWDPNtfySetDeliveryAddress,
+ NWDPNtfySetLanguageId,
+ NWDPNtfySetMethodId,
+ NWDPNtfySetSupplierId,
+ NWDPNtfyUseProfileRef,
+ NWDPNtfyValidateRef,
+ NWDPNtfyValidateMethodInfoRef,
+ NWDPNtfyValidateProfileRef,
+ NWDPResAddResourceFile2,
+ NWDPResCreateRefBasedOnPrinter,
+ NWDPResCreateRefBasedOnDriverId,
+ NWDPInfCreateRef,
+ NWDPInfDestroyRef,
+ NWDPInfMakeSectionRef16,
+ NWDPInfGetNextKeyAndValue16,
+ NWDPInfGetValueFromKey16,
+ NWDPInfWriteToFile,
+ NWDPResCreateRefForLocal,
+ NWDPInfInsertLineInSection16,
+ NWDPInfReplaceLineInSection16,
+ NWDPResSelectAndAddCABData,
+ NWDPASAddAttribute,
+ NWDPASAddAttrValue,
+ NWDPASCreateRef,
+ NWDPASCreateRefBasedOnSet,
+ NWDPASListAttributes,
+ NWDPASListAttrValues,
+ NWDPASMakeAVPRef,
+ NWDPASModifyAttrValue,
+ NWDPASReleaseRef,
+ NWDPASRemoveAttribute,
+ NWDPASRemoveAttrValue,
+ NWDPASSetAVPByAttributeId,
+ NWDPASSetModifyOperators,
+ NWDPASUseRef,
+ NWDPASValidateRef,
+ NWDPAUtilAddAttributeWithValues,
+ NWDPAUtilAppendAttrSet,
+ NWDPAUtilAppendAttrValueSet,
+ NWDPAUtilAsciiToCardinal64,
+ NWDPAUtilCardinal64ToAscii,
+ NWDPAUtilCompareDataType,
+ NWDPAUtilCompareAttrValue,
+ NWDPAUtilDupAttribute,
+ NWDPAUtilDupDataType,
+ NWDPAUtilDupAttrValue,
+ NWDPAUtilFreeAttribute,
+ NWDPAUtilFreeAttrValueSet,
+ NWDPAUtilFreeDataType,
+ NWDPAUtilFreeAttrValue,
+ NWDPAUtilListAttributes,
+ NWDPAUtilListAttrValues,
+ NWDPAUtilMergeAttrSet,
+ NWDPAUtilRemoveAllAttributes,
+ NWDPFltCreateRef,
+ NWDPFltDestroyRef,
+ NWDPFltAppendDelimiter,
+ NWDPFltAppendSubstringMatch,
+ NWDPFltAppendAttrSetMatch,
+ NWDPFltValidateRef,
+ NWDPOidInterpretRef,
+ NWDPOidInterpretRefAsASCII,
+ NWDPOidInterpretRefValue,
+ NWDPOidCreateRefBasedOnASCII,
+ NWDPOidCreateRefBasedOnString,
+ NWDPOidMakeOidPtrFromOidRef,
+ NWDPOidGetAttrCharacteristics,
+ NWDPOidReleaseRef,
+ NWDPOidCreateRefBasedOnOID,
+ NWDPOidListRefValues,
+ NWDPOidCmp,
+ NWDPOidInterpretRefWithClosest,
+ NWDPOidValidateRef,
+ NWDPOSListOids,
+ NWDPOSReleaseRef,
+ NWDPOSCreateRef,
+ NWDPOSAddOid,
+ NWDPOSRemoveOid,
+ NWDPOSUseRef,
+ NWDPOSValidateRef,
+ NWDPDocCancel,
+ NWDPDocCreateRef,
+ NWDPDocCreateRefBasedOnDocId,
+ NWDPDocDestroyRef,
+ NWDPDocGetAttributeSet,
+ NWDPDocGetId,
+ NWDPDocModifyAttrs,
+ NWDPDocTransferFile,
+ NWDPDocValidateRef,
+ NWDPDocWriteBuf,
+ NWDPJobCancel,
+ NWDPJobCopy,
+ NWDPJobCreateRef,
+ NWDPJobCreateRefBasedOnJobId,
+ NWDPJobDestroyRef,
+ NWDPJobGetAttributeSet,
+ NWDPJobGetId,
+ NWDPJobGetStatus,
+ NWDPJobInterrupt,
+ NWDPJobModifyAttrs,
+ NWDPJobMove,
+ NWDPJobPause,
+ NWDPJobPromote,
+ NWDPJobReorder,
+ NWDPJobResume,
+ NWDPJobSubmit,
+ NWDPJobValidateRef,
+ NWDPPrtAddJobConfig,
+ NWDPPrtAddInstalledPrinter,
+ NWDPPrtAddInstalledPrtWConfig,
+ NWDPPrtAddPrinterObjToPA,
+ NWDPPrtChangeMedia,
+ NWDPPrtControl,
+ NWDPPrtCreateMODObject,
+ NWDPPrtCreateRefBasedOnAddr,
+ NWDPPrtCreateRefBasedOnLabel,
+ NWDPPrtCreateRefBasedOnFQN,
+ NWDPPrtCreateRefBasedOnPort,
+ NWDPPrtCreateRefBasedOnPSM,
+ NWDPPrtDeleteAllJobs,
+ NWDPPrtDeleteMODObject,
+ NWDPPrtDriverDownload,
+ NWDPPrtGetAttributeSet,
+ NWDPPrtGetDefaultPrinter,
+ NWDPPrtGetDriverKeyName,
+ NWDPPrtGetDriverName,
+ NWDPPrtGetFQN,
+ NWDPPrtGetJobConfig,
+ NWDPPrtGetLabel,
+ NWDPPrtGetMODObjectAttrSet,
+ NWDPPrtGetPort,
+ NWDPPrtGetPrinterInfo,
+ NWDPPrtGetRefType,
+ NWDPPrtGetStatus,
+ NWDPPrtJobCopy,
+ NWDPPrtJobMove,
+ NWDPPrtListGlobalPrinters,
+ NWDPPrtListInstalledPrinters,
+ NWDPPrtListJobConfigs,
+ NWDPPrtListJobs,
+ NWDPPrtListMODObjects,
+ NWDPPrtModifyAttrs,
+ NWDPPrtModifyMODObjectAttrs,
+ NWDPPrtReleaseRef,
+ NWDPPrtRemoveInstalledPrinter,
+ NWDPPrtRemoveJobConfig,
+ NWDPPrtRemovePrinterObjFromPA,
+ NWDPPrtRenameJobConfig,
+ NWDPPrtResyncWithNameService,
+ NWDPPrtSetDefaultPrinter,
+ NWDPPrtSetLabel,
+ NWDPPrtShutdownPA,
+ NWDPPrtStartupPA,
+ NWDPPrtSyncInstalledPrinters,
+ NWDPPrtUseRef,
+ NWDPPrtValidateRef,
+ NWDPPsmGetMODObjectAttrSet,
+ NWDPPsmModifyMODObjectAttrs,
+ NWDPPsmListMODObjects,
+ NWDPPsmCreateRefBasedOnFQN,
+ NWDPPsmCreateRefBasedOnAddr,
+ NWDPPsmListPAs,
+ NWDPPsmShutdownPA,
+ NWDPPsmStartupPA,
+ NWDPPsmAddPA,
+ NWDPPsmRemovePA,
+ NWDPPsmAddPAAndAssignPrinterObj,
+ NWDPPsmGetFQN,
+ NWDPPsmShutdownPSM,
+ NWDPPsmCancelShutdownPSM,
+ NWDPPsmCreateMODObject,
+ NWDPPsmDeleteMODObject,
+ NWDPPsmValidateRef,
+ NWDPPsmDestroyRef,
+ NWDPPsmGetConnectionStatus,
+ NWDPPrtCreateRefBasedOnRegName,
+ NWDPPrtCreateRefBasedOnPAP,
+ NWDPPrtDownloadAndAddDriver,
+ NWDPPrtAddInstalledPrinter2,
+ NWDPPrtAddInstalledPrinterWCfg,
+ NWDPPrtListInstalledPrinters2,
+ NWDPPrtGetRegName,
+ NWDPPrtCallVendorSetup,
+ NWDPPrtSetDriver,
+ NWDPPrtDeleteAllJobs2,
+ NWDPPrtCreateRefBasedOnCreds,
+ NWDPLibInit
+
diff --git a/rtl/netware/dsapi.imp b/rtl/netware/dsapi.imp
new file mode 100644
index 0000000000..b765a9dbd5
--- /dev/null
+++ b/rtl/netware/dsapi.imp
@@ -0,0 +1,188 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWDSCreateContext,
+ NWDSFreeContext,
+ NWDSGetContext,
+ NWDSSetContext,
+ NWDSInitBuf,
+ NWDSAllocBuf,
+ NWDSFreeBuf,
+ NWDSGetAttrCount,
+ NWDSGetClassDefCount,
+ NWDSGetClassItemCount,
+ NWDSGetObjectCount,
+ NWDSGetAttrName,
+ NWDSGetObjectName,
+ NWDSPutAttrName,
+ NWDSPutChange,
+ NWDSPutAttrVal,
+ NWDSGetAttrDef,
+ NWDSGetClassDef,
+ NWDSGetClassItem,
+ NWDSPutClassItem,
+ NWDSGetAttrVal,
+ NWDSList,
+ NWDSAddObject,
+ NWDSCompare,
+ NWDSModifyObject,
+ NWDSModifyDN,
+ NWDSRead,
+ NWDSReadObjectInfo,
+ NWDSRemoveObject,
+ NWDSCanonicalizeName,
+ NWDSDefineAttr,
+ NWDSDefineClass,
+ NWDSListContainableClasses,
+ NWDSModifyClassDef,
+ NWDSReadAttrDef,
+ NWDSReadClassDef,
+ NWDSRemoveAttrDef,
+ NWDSAllocFilter,
+ NWDSFreeFilter,
+ NWDSPutFilter,
+ NWDSSearch,
+ NWDSRemoveClassDef,
+ NWDSGetEffectiveRights,
+ NWDSComputeAttrValSize,
+ NWDSMapIDToName,
+ NWDSMapNameToID,
+ NWDSAddFilterToken,
+ NWDSReplaceAttrNameAbbrev,
+ NWDSAbbreviateName,
+ NWDSGetSyntaxID,
+ NWDSOpenStream,
+ NWDSRemoveAllTypes,
+ NWDSGetPartitionRoot,
+ NWDSListPartitions,
+ NWDSAddPartition,
+ NWDSAddReplica,
+ NWDSChangeReplicaType,
+ NWDSJoinPartitions,
+ NWDSRemovePartition,
+ NWDSRemoveReplica,
+ NWDSSplitPartition,
+ NWDSDelFilterToken,
+ NWDSGetPartitionInfo,
+ NWDSBeginClassItem,
+ NWDSCloseIteration,
+ NWDSGetServerName,
+ NWDSGetSyntaxCount,
+ NWDSGetSyntaxDef,
+ NWDSReadSyntaxes,
+ NWDSWhoAmI,
+ NWDSAuditGetObjectID,
+ NWDSGetObjectHostServerAddress,
+ NWGetNWNetVersion,
+ NWDSGetServerDN,
+ NWDSGetServerAddresses,
+ NWIsDSServer,
+ NWDSListAttrsEffectiveRights,
+ NWDSGetBinderyContext,
+ NWDSRepairTimeStamps,
+ NWDSModifyRDN,
+ NWDSMoveObject,
+ NWGetFileServerUTCTime,
+ NWDSDuplicateContext,
+ NWDSReadSyntaxDef,
+ NWDSListByClassAndName,
+ NWDSCIStringsMatch,
+ NWDSGetCountByClassAndName,
+ NWDSPartitionReceiveAllUpdates,
+ NWDSPartitionSendAllUpdates,
+ NWDSListContainers,
+ NWDSAbortPartitionOperation,
+ NWDSSyncPartition,
+ NWDSInspectEntry,
+ NWDSReadReferences,
+ NWDSExtSyncRead,
+ NWDSExtSyncList,
+ NWDSExtSyncSearch,
+ NWDSAddSecurityEquiv,
+ NWDSRemSecurityEquiv,
+ NWDSGetDSVerInfo,
+ NWDSOpenConnToNDSServer,
+ NWDSSyncReplicaToServer,
+ NWDSReloadDS,
+ NWDSCreateContextHandle,
+ NWDSDuplicateContextHandle,
+ NWDSGetDefNameContext,
+ NWDSSetDefNameContext,
+ NWDSAuthenticateConn,
+ NWDSGetMonitoredConnRef,
+ NWDSOpenMonitoredConn,
+ NWDSScanConnsForTrees,
+ NWDSScanForAvailableTrees,
+ NWDSReturnBlockOfAvailableTrees,
+ NWDSGetReplicaReferenceRootID,
+ NWDSListPartitionsExtInfo,
+ NWDSGetPartitionExtInfoPtr,
+ NWDSGetPartitionExtInfo,
+ NWDSGetConnectionInfo,
+ NWDSSetConnectionInfo,
+ NWGetNumConnections,
+ NWDSGetConnectionSlot,
+ NWFreeConnectionSlot,
+ NWGetConnectionIDFromAddress,
+ NWGetNearestDirectoryService,
+ NWIsDSAuthenticated,
+ NWGetNextConnectionID,
+ NWGetDefaultNameContext,
+ NWSetDefaultNameContext,
+ NWGetConnectionIDFromName,
+ NWGetPreferredDSServer,
+ NWDSChangeResourceOnConnection,
+ NWDSGetMonitoredConnection,
+ NWDSSetMonitoredConnection,
+ NWSetPreferredDSTree,
+ NWDSLockConnection,
+ NWDSUnlockConnection,
+ _NWDSGetConnectionSlot,
+ NWGetPreferredConnName,
+ NWDSResolveName,
+ NWDSBackupObject,
+ NWDSRestoreObject,
+ NWGetNearestDSConnRef,
+ NWNetInit,
+ NWNetTerm,
+ NWDSSyncSchema,
+ NWDSCanDSAuthenticate,
+ NWDSGetServerAddresses2,
+ NWDSAuthenticate,
+ NWDSChangeObjectPassword,
+ NWDSGenerateObjectKeyPair,
+ NWDSLogin,
+ NWDSLogin2,
+ NWDSLoginAsServer,
+ NWDSLogout,
+ NWDSVerifyObjectPassword,
+ NWDSPutAttrNameAndVal,
+ NWDSPutChangeAndVal,
+ NWDSReadObjectDSIInfo,
+ NWDSGetDSIInfo,
+ NWDSReadNDSInfo,
+ NWDSGetNDSInfo,
+ NWDSGetObjectNameAndInfo,
+ NWDSGetNDSIntervals,
+ NWDSSetNDSIntervals,
+ NWDSGenerateObjectKeyPair2,
+ NWDSGetAttrValModTime,
+ NWDSGetAttrValFlags,
+ NWDSItrDestroy,
+ NWDSItrClone,
+ NWDSItrGetPosition,
+ NWDSItrSetPosition,
+ NWDSItrSetPositionFromIterator,
+ NWDSItrTypeDown,
+ NWDSItrSkip,
+ NWDSItrGetNext,
+ NWDSItrGetPrev,
+ NWDSItrGetCurrent,
+ NWDSItrCount,
+ NWDSItrAtFirst,
+ NWDSItrAtEOF,
+ NWDSItrGetInfo,
+ NWDSItrCreateList,
+ NWDSItrCreateSearch,
+ NWDSMutateObject,
+ NWDSAuthenticateConnEx
+
diff --git a/rtl/netware/dsevent.imp b/rtl/netware/dsevent.imp
new file mode 100644
index 0000000000..8b1dcfcca0
--- /dev/null
+++ b/rtl/netware/dsevent.imp
@@ -0,0 +1,12 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+ NWDSEConvertEntryName,
+ NWDSEGetLocalAttrID,
+ NWDSEGetLocalClassID,
+ NWDSEGetLocalEntryID,
+ NWDSEGetLocalEntryName,
+ NWDSEGetLocalAttrName,
+ NWDSEGetLocalClassName,
+ NWDSERegisterForEvent,
+ NWDSERegisterForEventWithResult,
+ NWDSEUnRegisterForEvent
+
diff --git a/rtl/netware/errno.inc b/rtl/netware/errno.inc
new file mode 100644
index 0000000000..de25332271
--- /dev/null
+++ b/rtl/netware/errno.inc
@@ -0,0 +1,144 @@
+ { -------------------------- Base POSIX-mandated constants --------------- }
+ { no such file or directory }
+ const
+ SYS_ENOENT = 1; // arg list too big
+ SYS_E2BIG = 2; // arg list too big
+ SYS_ENOEXEC = 3; // exec format error
+ SYS_EBADF = 4; // bad file number
+ SYS_ENOMEM = 5; // not enough memory
+ SYS_EACCES = 6; // permission denied
+ SYS_EEXIST = 7; // file exists
+ SYS_EXDEV = 8; // cross-device link
+ SYS_EINVAL = 9; // invalid argument
+ SYS_ENFILE = 10; // file table overflow
+ SYS_EMFILE = 11; // too many open files
+ SYS_ENOSPC = 12; // no space left on device
+ SYS_EDOM = 13; // argument too large
+ SYS_ERANGE = 14; // result too large
+ SYS_EDEADLK = 15; // resource deadlock would occur
+ { -------------------------- Miscellaneous NLM Library constants --------- }
+ SYS_EINUSE = 16; // resource(s) in use
+ SYS_ESERVER = 17; // server error (memory out, I/O error, etc.)
+ SYS_ENOSERVR = 18; // no server (queue server, file server, etc.)
+ SYS_EWRNGKND = 19; // wrong kind--an operation is being...
+ // ...attempted on the wrong kind of object
+ SYS_ETRNREST = 20; // transaction restarted
+ SYS_ERESOURCE = 21; // resources unavailable (maybe permanently)
+ SYS_EBADHNDL = 22; // bad non-file handle (screen, semaphore, etc)
+ SYS_ENO_SCRNS = 23; // screen I/O attempted when no screens
+ { -------------------------- Additional POSIX / traditional UNIX constants }
+ SYS_EAGAIN = 24; // resource temporarily unavailable
+ SYS_ENXIO = 25; // no such device or address
+ SYS_EBADMSG = 26; // not a data message
+ SYS_EFAULT = 27; // bad address
+ SYS_EIO = 28; // physical I/O error
+ SYS_ENODATA = 29; // no data
+ SYS_ENOSTRMS = 30; // streams not available
+ { Berkeley sockets constants ------------------ }
+ SYS_EPROTO = 31; // fatal protocol error
+ SYS_EPIPE = 32; // broken pipe
+ SYS_ESPIPE = 33; // illegal seek
+ { Non-blocking and interrupt I/O constants ---- }
+ SYS_ETIME = 34; // ioctl acknowledge timeout
+ { operation would block }
+ SYS_EWOULDBLOCK=35; // operation would block
+ SYS_EINPROGRESS=36; // operation now in progress
+ SYS_EALREADY = 37; // operation already in progress
+ { IPC network argument constants -------------- }
+ SYS_ENOTSOCK = 38; // socket operation on non-socket
+ SYS_EDESTADDRREQ=39; // destination address required
+ SYS_EMSGSIZE = 40; // message too long
+ SYS_EPROTOTYPE= 41; // protocol wrong type for socket
+ SYS_ENOPROTOOPT=42; // protocol not available
+ SYS_EPROTONOSUPPORT = 43; // protocol not supported
+ SYS_ESOCKTNOSUPPORT = 44; // socket type not supported
+ SYS_EOPNOTSUPP = 45; // operation not supported on socket
+ SYS_EPFNOSUPPORT = 46; // protocol family not supported
+ SYS_EAFNOSUPPORT = 47; // address family unsupported by protocol family
+ SYS_EADDRINUSE = 48; // address already in use
+ SYS_EADDRNOTAVAIL = 49; // can't assign requested address
+ { Operational constants ----------------------- }
+ SYS_ENETDOWN = 50; // Network is down
+ { network is unreachable }
+ SYS_ENETUNREACH = 51;
+ { network dropped connection on reset }
+ SYS_ENETRESET = 52;
+ { software caused connection abort }
+ SYS_ECONNABORTED = 53;
+ { connection reset by peer }
+ SYS_ECONNRESET = 54;
+ { no buffer space available }
+ SYS_ENOBUFS = 55;
+ { socket is already connected }
+ SYS_EISCONN = 56;
+ { socket is not connected }
+ SYS_ENOTCONN = 57;
+ { can't send after socket shutdown }
+ SYS_ESHUTDOWN = 58;
+ { too many references: can't splice }
+ SYS_ETOOMANYREFS = 59;
+ { connection timed out }
+ SYS_ETIMEDOUT = 60;
+ { connection refused }
+ SYS_ECONNREFUSED = 61;
+ { -------------------------- Additional POSIX-mandated constants --------- }
+ { resource busy }
+ SYS_EBUSY = 62;
+ { interrupted function call }
+ SYS_EINTR = 63;
+ { is a directory }
+ SYS_EISDIR = 64;
+ { filename too long }
+ SYS_ENAMETOOLONG = 65;
+ { function not implemented }
+ SYS_ENOSYS = 66;
+ { not a directory }
+ SYS_ENOTDIR = 67;
+ { directory not empty }
+ SYS_ENOTEMPTY = 68;
+ { operation not permitted }
+ SYS_EPERM = 69;
+ { no child process }
+ SYS_ECHILD = 70;
+ { file too large }
+ SYS_EFBIG = 71;
+ { too many links }
+ SYS_EMLINK = 72;
+ SYS_ELOOP = SYS_EMLINK;
+ { no such device }
+ SYS_ENODEV = 73;
+ { no locks available }
+ SYS_ENOLCK = 74;
+ { inappropriate I/O control operation }
+ SYS_ENOTTY = 75;
+ { inappropriate operation for file type }
+ SYS_EFTYPE = SYS_ENOTTY;
+ { read-only file system }
+ SYS_EROFS = 76;
+ { no such process }
+ SYS_ESRCH = 77;
+ { operation was cancelled }
+ SYS_ECANCELED = 78;
+ { this optional functionality not supported }
+ SYS_ENOTSUP = 79;
+ { -------------------------- CLib-implementation-specific constants ------ }
+ SYS_ECANCELLED = SYS_ECANCELED;
+ { anomaly in NLM data structure }
+ SYS_ENLMDATA = 100;
+ { illegal character sequence in multibyte }
+ SYS_EILSEQ = 101;
+ { internal library inconsistency }
+ SYS_EINCONSIS = 102;
+ { DOS-text file inconsistency--no newline... }
+ SYS_EDOSTEXTEOL = 103;
+ { ...after carriage return }
+ { object doesn't exist }
+ SYS_ENONEXTANT = 104;
+ SYS_ENOCONTEXT = 105; // no thread library context present
+ SYS_ELASTERR = SYS_ENOCONTEXT;
+{
+ $Log: errno.inc,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/initc.pp b/rtl/netware/initc.pp
new file mode 100644
index 0000000000..dfa7603a27
--- /dev/null
+++ b/rtl/netware/initc.pp
@@ -0,0 +1,49 @@
+{
+ $Id: initc.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 the Free Pascal development team
+
+ This file handles the clib errno abstraction for netware.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit initc;
+interface
+{$i nwsys.inc}
+
+type libcint = longint;
+ plibcint = ^libcint;
+
+function fpgetCerrno:libcint;
+procedure fpsetCerrno(err:libcint);
+
+{$ifdef HASGLOBALPROPERTY}
+property cerrno:libcint read fpgetCerrno write fpsetcerrno;
+{$endif HASGLOBALPROPERTY}
+
+implementation
+
+function fpgetCerrno:libcint;
+begin
+ fpgetCerrno:=__get_errno_ptr^;
+end;
+
+procedure fpsetCerrno(err:libcint);
+begin
+ __get_errno_ptr^:=err;
+end;
+
+
+end.
+{
+ $Log: initc.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/keyboard.pp b/rtl/netware/keyboard.pp
new file mode 100644
index 0000000000..b07f2b9200
--- /dev/null
+++ b/rtl/netware/keyboard.pp
@@ -0,0 +1,100 @@
+{
+ $Id: keyboard.pp,v 1.5 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team.
+
+ Keyboard unit for netware
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ 2001/04/16 armin: first version for netware
+ 2002/03/03 armin: changes for fpc 1.1 }
+unit Keyboard;
+interface
+
+{$i keybrdh.inc}
+
+
+implementation
+
+{$i keyboard.inc}
+{$i nwsys.inc}
+
+procedure SysInitKeyboard;
+begin
+ PendingKeyEvent := 0;
+end;
+
+
+function SysGetKeyEvent: TKeyEvent;
+var T : TKeyEvent;
+begin
+ if PendingKeyEvent<>0 then
+ begin
+ SysGetKeyEvent:=PendingKeyEvent;
+ PendingKeyEvent:=0;
+ exit;
+ end;
+ T := byte(_getch);
+ if T = 0 then
+ T := word(_getch) shl 8;
+ SysGetKeyEvent := $03000000 OR T;
+end;
+
+
+function SysPollKeyEvent: TKeyEvent;
+begin
+ if PendingKeyEvent<>0 then
+ exit(PendingKeyEvent);
+ if _kbhit <> 0 then
+ begin
+ PendingKeyEvent := byte(_getch);
+ if PendingKeyEvent = 0 then
+ PendingKeyEvent := word(_getch) shl 8;
+ PendingKeyEvent := PendingKeyEvent OR $03000000;
+ SysPollKeyEvent := PendingKeyEvent;
+ end else
+ SysPollKeyEvent := 0;
+end;
+
+
+function SysPollShiftStateEvent: TKeyEvent;
+begin
+ SysPollShiftStateEvent:=0;
+end;
+
+function SysGetShiftState: Byte;
+begin
+ SysGetShiftState:=0;
+end;
+
+
+Const
+ SysKeyboardDriver : TKeyboardDriver = (
+ InitDriver : Nil;
+ DoneDriver : Nil;
+ GetKeyevent : @SysGetKeyEvent;
+ PollKeyEvent : @SysPollKeyEvent;
+ GetShiftState : @SysGetShiftState;
+ TranslateKeyEvent : Nil;
+ TranslateKeyEventUnicode : Nil;
+ );
+
+begin
+ KeyboardInitialized := false;
+ PendingKeyEvent := 0;
+ SetKeyBoardDriver(SysKeyBoardDriver);
+end.
+
+{
+ $Log: keyboard.pp,v $
+ Revision 1.5 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/lib0.imp b/rtl/netware/lib0.imp
new file mode 100644
index 0000000000..e645853ba6
--- /dev/null
+++ b/rtl/netware/lib0.imp
@@ -0,0 +1,2 @@
+# dummy, now included in clib
+
diff --git a/rtl/netware/locnlm32.imp b/rtl/netware/locnlm32.imp
new file mode 100644
index 0000000000..77996c7e40
--- /dev/null
+++ b/rtl/netware/locnlm32.imp
@@ -0,0 +1,108 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWisalnum,
+ NWisalpha,
+ NWisdigit,
+ NWNextChar,
+ NWLTruncateString,
+ NWatoi,
+ NWLstrbcpy,
+ NWstrlen,
+ NWLocalToUnicode,
+ NWUnicodeToLocal,
+ NWUnicodeToCollation,
+ NWUnicodeCompare,
+ NWUnicodeToMonocase,
+ NWFreeUnicodeTables,
+ NWGetUnicodeToLocalHandle,
+ NWGetLocalToUnicodeHandle,
+ NWGetMonocaseHandle,
+ NWGetCollationHandle,
+ NWInitUnicodeTables,
+ unicmp,
+ unincmp,
+ unicat,
+ unichr,
+ unicpy,
+ unicspn,
+ unilen,
+ unincat,
+ unincpy,
+ uninset,
+ unipbrk,
+ unipcpy,
+ unirchr,
+ unirev,
+ uniset,
+ unispn,
+ unistr,
+ unitok,
+ uniicmp,
+ uninicmp,
+ unisize,
+ uniindex,
+ uninlen,
+ NWGetNWLOCALEVersion,
+ NWLstrtok,
+ NWitoa,
+ NWltoa,
+ NWutoa,
+ NWultoa,
+ NWLmbslen,
+ NWLstricmp,
+ NWisxdigit,
+ NWUSStandardUnicodeInit,
+ NWUSStandardUnicodeRelease,
+ NWUSGetCodePage,
+ NWUSByteToUnicode,
+ NWUSLenByteToUnicode,
+ NWUSByteToUnicodePath,
+ NWUSLenByteToUnicodePath,
+ NWUSUnicodeToByte,
+ NWUSUnicodeToBytePath,
+ NWUSUnicodeToLowerCase,
+ NWUSUnicodeToUpperCase,
+ NWUSUnicodeToUntermByte,
+ NWUSUnicodeToUntermBytePath,
+ NWUXLoadByteUnicodeConverter,
+ NWUXLoadCaseConverter,
+ NWUXLoadCollationConverter,
+ NWUXLoadNormalizeConverter,
+ NWUXUnloadConverter,
+ NWUXByteToUnicode,
+ NWUXLenByteToUnicode,
+ NWUXByteToUnicodePath,
+ NWUXLenByteToUnicodePath,
+ NWUXUnicodeToByte,
+ NWUXUnicodeToBytePath,
+ NWUXUnicodeToCase,
+ NWUXUnicodeToCollation,
+ NWUXUnicodeToNormalized,
+ NWUXGetCharSize,
+ NWUXUnicodeToUntermByte,
+ NWUXUnicodeToUntermBytePath,
+ NWUXSetNoMapAction,
+ NWUXGetNoMapAction,
+ NWUXSetSubByte,
+ NWUXGetSubByte,
+ NWUXSetSubUni,
+ NWUXGetSubUni,
+ NWUXSetByteFunctions,
+ NWUXGetByteFunctions,
+ NWUXSetUniFunctions,
+ NWUXGetUniFunctions,
+ NWUXResetConverter,
+ nwusuniicmp,
+ nwusuninicmp,
+ NWUXSetScanAction,
+ NWUXGetScanAction,
+ NWUSStandardUnicodeOverride,
+ NWLIsAnsi,
+ NWLOemToAnsi,
+ NWLAnsiToOem,
+ NWLUTF8ToUnicode,
+ NWLUnicodeToUTF8,
+ NWLUTF8ToUnicodeSize,
+ NWLUnicodeToUTF8Size,
+ NWLstrtok_r
+
diff --git a/rtl/netware/mouse.pp b/rtl/netware/mouse.pp
new file mode 100644
index 0000000000..52ff8ac2b9
--- /dev/null
+++ b/rtl/netware/mouse.pp
@@ -0,0 +1,121 @@
+{
+ $Id: mouse.pp,v 1.4 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Dummy Mouse unit for netware
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{2001/04/14 armin: first version, only a dummy, i think there is no 'official' way to support
+ a mouse under netware }
+unit Mouse;
+interface
+
+{$ifdef NOMOUSE}
+{$DEFINE NOGPM}
+{$ENDIF}
+
+{const
+ MouseEventBufSize = 16; }
+
+{$i mouseh.inc}
+
+implementation
+
+
+procedure PlaceMouseCur(ofs:longint);
+begin
+end;
+
+
+procedure InitMouse;
+begin
+end;
+
+
+procedure DoneMouse;
+begin
+end;
+
+
+function DetectMouse:byte;
+begin
+ DetectMouse:=0;
+end;
+
+
+procedure ShowMouse;
+begin
+end;
+
+
+procedure HideMouse;
+begin
+end;
+
+
+function GetMouseX:word;
+begin
+ GetMouseX:=0;
+end;
+
+
+function GetMouseY:word;
+begin
+ GetMouseY:=0;
+end;
+
+
+function GetMouseButtons:word;
+begin
+ GetMouseButtons:=0;
+end;
+
+
+procedure SetMouseXY(x,y:word);
+begin
+end;
+
+
+procedure GetMouseEvent(var MouseEvent: TMouseEvent);
+begin
+ fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+end;
+
+
+procedure PutMouseEvent(const MouseEvent: TMouseEvent);
+begin
+end;
+
+
+function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+begin
+ fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+ exit(false);
+end;
+
+Procedure SetMouseDriver(Const Driver : TMouseDriver);
+{ Sets the mouse driver. }
+begin
+end;
+
+Procedure GetMouseDriver(Var Driver : TMouseDriver);
+{ Returns the currently active mouse driver }
+begin
+end;
+
+end.
+{
+ $Log: mouse.pp,v $
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/ndpsrpc.imp b/rtl/netware/ndpsrpc.imp
new file mode 100644
index 0000000000..353cc6a3dd
--- /dev/null
+++ b/rtl/netware/ndpsrpc.imp
@@ -0,0 +1,59 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ clnt_ndps_create,
+ svc_ndps_create,
+ ndps_authnone_create,
+ ndps_clnt_sperror,
+ ndps_freenetconfigent,
+ ndps_getnetconfigent,
+ ndps__get_rpc_createerr_,
+ ndps__seterr_reply,
+ ndps_svc_control,
+ ndps_svc_getreq,
+ ndps_svc_interrupt,
+ ndps_svc_run,
+ ndps_svc_sendreply,
+ ndps_svc_tp_create,
+ ndps_svcerr_decode,
+ ndps_svcerr_noproc,
+ ndps_svcerr_systemerr,
+ ndps_xdr_array,
+ ndps_xdr_bool,
+ ndps_xdr_bytes,
+ ndps_xdr_callhdr,
+ ndps_xdr_callmsg,
+ ndps_xdr_char,
+ ndps_xdr_double,
+ ndps_xdr_enum,
+ ndps_xdr_fast_string,
+ ndps_xdr_float,
+ ndps_xdr_free,
+ ndps_xdr_free_pointer,
+ ndps_xdr_int,
+ ndps_xdr_long,
+ ndps_xdr_opaque,
+ ndps_xdr_opaque_auth,
+ ndps_xdr_pointer,
+ ndps_xdr_replymsg,
+ ndps_xdr_short,
+ ndps_xdr_string,
+ ndps_xdr_u_char,
+ ndps_xdr_u_int,
+ ndps_xdr_u_long,
+ ndps_xdr_u_short,
+ ndps_xdr_union,
+ ndps_xdr_vector,
+ ndps_xdr_void,
+ ndps_xdr_wrapstring,
+ ndps_xdrmem_create,
+ ndps_xdrrec_create,
+ ndps_xdrrec_endofrecord,
+ ndps_xdrrec_eof,
+ ndps_xdrrec_flush,
+ ndps_xdrrec_skiprecord,
+ ndps_xdrrec_splice,
+ ndps_RemoveClient,
+ ndps_RemoveClientId,
+ ndps_AddClientId,
+ ndps_GetClientId
+
diff --git a/rtl/netware/netnlm32.imp b/rtl/netware/netnlm32.imp
new file mode 100644
index 0000000000..b765a9dbd5
--- /dev/null
+++ b/rtl/netware/netnlm32.imp
@@ -0,0 +1,188 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWDSCreateContext,
+ NWDSFreeContext,
+ NWDSGetContext,
+ NWDSSetContext,
+ NWDSInitBuf,
+ NWDSAllocBuf,
+ NWDSFreeBuf,
+ NWDSGetAttrCount,
+ NWDSGetClassDefCount,
+ NWDSGetClassItemCount,
+ NWDSGetObjectCount,
+ NWDSGetAttrName,
+ NWDSGetObjectName,
+ NWDSPutAttrName,
+ NWDSPutChange,
+ NWDSPutAttrVal,
+ NWDSGetAttrDef,
+ NWDSGetClassDef,
+ NWDSGetClassItem,
+ NWDSPutClassItem,
+ NWDSGetAttrVal,
+ NWDSList,
+ NWDSAddObject,
+ NWDSCompare,
+ NWDSModifyObject,
+ NWDSModifyDN,
+ NWDSRead,
+ NWDSReadObjectInfo,
+ NWDSRemoveObject,
+ NWDSCanonicalizeName,
+ NWDSDefineAttr,
+ NWDSDefineClass,
+ NWDSListContainableClasses,
+ NWDSModifyClassDef,
+ NWDSReadAttrDef,
+ NWDSReadClassDef,
+ NWDSRemoveAttrDef,
+ NWDSAllocFilter,
+ NWDSFreeFilter,
+ NWDSPutFilter,
+ NWDSSearch,
+ NWDSRemoveClassDef,
+ NWDSGetEffectiveRights,
+ NWDSComputeAttrValSize,
+ NWDSMapIDToName,
+ NWDSMapNameToID,
+ NWDSAddFilterToken,
+ NWDSReplaceAttrNameAbbrev,
+ NWDSAbbreviateName,
+ NWDSGetSyntaxID,
+ NWDSOpenStream,
+ NWDSRemoveAllTypes,
+ NWDSGetPartitionRoot,
+ NWDSListPartitions,
+ NWDSAddPartition,
+ NWDSAddReplica,
+ NWDSChangeReplicaType,
+ NWDSJoinPartitions,
+ NWDSRemovePartition,
+ NWDSRemoveReplica,
+ NWDSSplitPartition,
+ NWDSDelFilterToken,
+ NWDSGetPartitionInfo,
+ NWDSBeginClassItem,
+ NWDSCloseIteration,
+ NWDSGetServerName,
+ NWDSGetSyntaxCount,
+ NWDSGetSyntaxDef,
+ NWDSReadSyntaxes,
+ NWDSWhoAmI,
+ NWDSAuditGetObjectID,
+ NWDSGetObjectHostServerAddress,
+ NWGetNWNetVersion,
+ NWDSGetServerDN,
+ NWDSGetServerAddresses,
+ NWIsDSServer,
+ NWDSListAttrsEffectiveRights,
+ NWDSGetBinderyContext,
+ NWDSRepairTimeStamps,
+ NWDSModifyRDN,
+ NWDSMoveObject,
+ NWGetFileServerUTCTime,
+ NWDSDuplicateContext,
+ NWDSReadSyntaxDef,
+ NWDSListByClassAndName,
+ NWDSCIStringsMatch,
+ NWDSGetCountByClassAndName,
+ NWDSPartitionReceiveAllUpdates,
+ NWDSPartitionSendAllUpdates,
+ NWDSListContainers,
+ NWDSAbortPartitionOperation,
+ NWDSSyncPartition,
+ NWDSInspectEntry,
+ NWDSReadReferences,
+ NWDSExtSyncRead,
+ NWDSExtSyncList,
+ NWDSExtSyncSearch,
+ NWDSAddSecurityEquiv,
+ NWDSRemSecurityEquiv,
+ NWDSGetDSVerInfo,
+ NWDSOpenConnToNDSServer,
+ NWDSSyncReplicaToServer,
+ NWDSReloadDS,
+ NWDSCreateContextHandle,
+ NWDSDuplicateContextHandle,
+ NWDSGetDefNameContext,
+ NWDSSetDefNameContext,
+ NWDSAuthenticateConn,
+ NWDSGetMonitoredConnRef,
+ NWDSOpenMonitoredConn,
+ NWDSScanConnsForTrees,
+ NWDSScanForAvailableTrees,
+ NWDSReturnBlockOfAvailableTrees,
+ NWDSGetReplicaReferenceRootID,
+ NWDSListPartitionsExtInfo,
+ NWDSGetPartitionExtInfoPtr,
+ NWDSGetPartitionExtInfo,
+ NWDSGetConnectionInfo,
+ NWDSSetConnectionInfo,
+ NWGetNumConnections,
+ NWDSGetConnectionSlot,
+ NWFreeConnectionSlot,
+ NWGetConnectionIDFromAddress,
+ NWGetNearestDirectoryService,
+ NWIsDSAuthenticated,
+ NWGetNextConnectionID,
+ NWGetDefaultNameContext,
+ NWSetDefaultNameContext,
+ NWGetConnectionIDFromName,
+ NWGetPreferredDSServer,
+ NWDSChangeResourceOnConnection,
+ NWDSGetMonitoredConnection,
+ NWDSSetMonitoredConnection,
+ NWSetPreferredDSTree,
+ NWDSLockConnection,
+ NWDSUnlockConnection,
+ _NWDSGetConnectionSlot,
+ NWGetPreferredConnName,
+ NWDSResolveName,
+ NWDSBackupObject,
+ NWDSRestoreObject,
+ NWGetNearestDSConnRef,
+ NWNetInit,
+ NWNetTerm,
+ NWDSSyncSchema,
+ NWDSCanDSAuthenticate,
+ NWDSGetServerAddresses2,
+ NWDSAuthenticate,
+ NWDSChangeObjectPassword,
+ NWDSGenerateObjectKeyPair,
+ NWDSLogin,
+ NWDSLogin2,
+ NWDSLoginAsServer,
+ NWDSLogout,
+ NWDSVerifyObjectPassword,
+ NWDSPutAttrNameAndVal,
+ NWDSPutChangeAndVal,
+ NWDSReadObjectDSIInfo,
+ NWDSGetDSIInfo,
+ NWDSReadNDSInfo,
+ NWDSGetNDSInfo,
+ NWDSGetObjectNameAndInfo,
+ NWDSGetNDSIntervals,
+ NWDSSetNDSIntervals,
+ NWDSGenerateObjectKeyPair2,
+ NWDSGetAttrValModTime,
+ NWDSGetAttrValFlags,
+ NWDSItrDestroy,
+ NWDSItrClone,
+ NWDSItrGetPosition,
+ NWDSItrSetPosition,
+ NWDSItrSetPositionFromIterator,
+ NWDSItrTypeDown,
+ NWDSItrSkip,
+ NWDSItrGetNext,
+ NWDSItrGetPrev,
+ NWDSItrGetCurrent,
+ NWDSItrCount,
+ NWDSItrAtFirst,
+ NWDSItrAtEOF,
+ NWDSItrGetInfo,
+ NWDSItrCreateList,
+ NWDSItrCreateSearch,
+ NWDSMutateObject,
+ NWDSAuthenticateConnEx
+
diff --git a/rtl/netware/netware.pp b/rtl/netware/netware.pp
new file mode 100644
index 0000000000..a42bae60d3
--- /dev/null
+++ b/rtl/netware/netware.pp
@@ -0,0 +1,173 @@
+{
+ $Id: netware.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+ <partof>
+ Copyright (c) 1998 by <yourname>
+
+ <infoline>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit netware;
+
+interface
+
+const
+ NlmLib = 'nlmlib.nlm';
+
+type
+ fdSet=array[0..7] of longint;{=256 bits}
+ pfdset=^fdset;
+ TFDSet=fdset;
+
+ timeval = packed record
+ sec,usec:longint
+ end;
+ ptimeval=^timeval;
+ TTimeVal=timeval;
+
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint; CDECL; EXTERNAL NlmLib NAME 'select';
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
+Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
+
+Procedure FD_Zero(var fds:fdSet);
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+Procedure FD_Set(fd:longint;var fds:fdSet);
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+Function GetFS (var T:Text):longint;
+Function GetFS(Var F:File):longint;
+
+
+implementation
+
+{ Get the definitions of textrec and filerec }
+{$i textrec.inc}
+{$i filerec.inc}
+
+
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
+{
+ Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+ have changed.
+ This function allows specification of a timeout as a longint.
+}
+var
+ p : PTimeVal;
+ tv : TimeVal;
+begin
+ if TimeOut=-1 then
+ p:=nil
+ else
+ begin
+ tv.Sec:=Timeout div 1000;
+ tv.Usec:=(Timeout mod 1000)*1000;
+ p:=@tv;
+ end;
+ Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
+end;
+
+
+
+Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
+Var
+ F:FDSet;
+begin
+ if textrec(t).mode=fmclosed then
+ begin
+ {LinuxError:=Sys_EBADF;}
+ exit(-1);
+ end;
+ FD_Zero(f);
+ FD_Set(textrec(T).handle,f);
+ if textrec(T).mode=fminput then
+ SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
+ else
+ SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
+end;
+
+
+{--------------------------------
+ FiledescriptorSets
+--------------------------------}
+
+Procedure FD_Zero(var fds:fdSet);
+{
+ Clear the set of filedescriptors
+}
+begin
+ FillChar(fds,sizeof(fdSet),0);
+end;
+
+
+
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+{
+ Remove fd from the set of filedescriptors
+}
+begin
+ fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
+end;
+
+
+
+Procedure FD_Set(fd:longint;var fds:fdSet);
+{
+ Add fd to the set of filedescriptors
+}
+begin
+ fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
+end;
+
+
+
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+{
+ Test if fd is part of the set of filedescriptors
+}
+begin
+ FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
+end;
+
+
+
+Function GetFS (var T:Text):longint;
+{
+ Get File Descriptor of a text file.
+}
+begin
+ if textrec(t).mode=fmclosed then
+ exit(-1)
+ else
+ GETFS:=textrec(t).Handle
+end;
+
+
+
+Function GetFS(Var F:File):longint;
+{
+ Get File Descriptor of an unTyped file.
+}
+begin
+ { Handle and mode are on the same place in textrec and filerec. }
+ if filerec(f).mode=fmclosed then
+ exit(-1)
+ else
+ GETFS:=filerec(f).Handle
+end;
+
+
+
+end.
+{
+ $Log: netware.pp,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
+
diff --git a/rtl/netware/nit.imp b/rtl/netware/nit.imp
new file mode 100644
index 0000000000..2b5f5a5fcd
--- /dev/null
+++ b/rtl/netware/nit.imp
@@ -0,0 +1,2 @@
+ NITGlobals
+
diff --git a/rtl/netware/nlmlib.imp b/rtl/netware/nlmlib.imp
new file mode 100644
index 0000000000..54c7e6918e
--- /dev/null
+++ b/rtl/netware/nlmlib.imp
@@ -0,0 +1,2 @@
+ NLMLibGlobals
+
diff --git a/rtl/netware/npackoff.inc b/rtl/netware/npackoff.inc
new file mode 100644
index 0000000000..0816d7f15e
--- /dev/null
+++ b/rtl/netware/npackoff.inc
@@ -0,0 +1,13 @@
+(* this header sets packing back to default *)
+
+{$PACKRECORDS DEFAULT}
+
+// pragma pack()
+
+{
+ $Log: npackoff.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netware/npackon.inc b/rtl/netware/npackon.inc
new file mode 100644
index 0000000000..ef3eb39bfe
--- /dev/null
+++ b/rtl/netware/npackon.inc
@@ -0,0 +1,12 @@
+(* this header sets packing to 1 *)
+
+{$PACKRECORDS 1}
+
+// pragma pack(1)
+
+{
+ $Log: npackon.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/nwcalls.pp b/rtl/netware/nwcalls.pp
new file mode 100644
index 0000000000..4d5ac1b8d3
--- /dev/null
+++ b/rtl/netware/nwcalls.pp
@@ -0,0 +1,6075 @@
+{ $Id: nwcalls.pp,v 1.1 2005/01/14 22:13:11 armin Exp $
+
+ Netware Server Imports for FreePascal Netware Clib RTL, contains
+ definitions from the following NDK header files:
+
+ ntypes.h,nwacct.h,nwafp.h,nwalias.h,nwapidef.h,nwbindry.h,
+ nwcaldef.h,nwcalls.h,nwconnec.h,nwdel.h,nwdentry.h,nwdirect.h,
+ nwdpath.h,nwea.h,nwerror.h,nwfattr.h,nwfile.h,nwfse.h,nwmigrat.h,
+ nwmisc.h,nwmsg.h,nwnamspc.h,nwprint.h,nwqms.h,nwserver.h,nwsm.h,
+ nwsync.h,nwtts.h,nwvol.h,stddef.h,unicode.h
+
+ Initial Version 2005/01/14 Armin (armin@freepascal.org)
+
+ The C-NDK and Documentation can be found here:
+ http://developer.novell.com
+
+ This program is distributed in the hope that it will be useful,but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE.
+
+ Do not blame Novell if there are errors in this file, instead
+ create a bug report on http://www.freepascal.org and i will see what i
+ can do.
+}
+
+
+unit nwcalls;
+{$MODE objfpc}
+{$MACRO on}
+
+interface
+
+{Macros for netware imports:}
+{$DEFINE NWLIB_CALNLM32 := cdecl; external 'calnlm32'}
+{$DEFINE NWLIB_LOCNLM32 := cdecl; external 'locnlm32'}
+{$DEFINE NWLIB_UNICODE := cdecl; external 'unicode'}
+{$DEFINE NWLIB_UNKNOWN := cdecl; external} {for these ones i have not found the exporting module}
+{$DEFINE NWLIB_CLIB := cdecl; external 'clib'}
+{$DEFINE NWLIB_DSAPI := cdecl; external 'DSAPI'}
+
+type
+ Tnuint16 = word;
+ Pnuint16 = pword;
+ Tnuint8 = byte;
+ Pnuint8 = ^byte;
+ Tnptr = pointer;
+ pnstr = pchar;
+ ppnstr = ppchar;
+ Tnstr8 = char;
+ Pnstr8 = pchar;
+ nptr = pointer;
+ Pnptr = ^pointer;
+ Tnflag32 = longint;
+
+ PBYTE_REGISTERS = ^TBYTE_REGISTERS;
+ TBYTE_REGISTERS = record
+ si: Tnuint16;
+ ds: Tnuint16;
+ di: Tnuint16;
+ es: Tnuint16;
+ al: Tnuint8;
+ ah: Tnuint8;
+ bl: Tnuint8;
+ bh: Tnuint8;
+ cl: Tnuint8;
+ ch: Tnuint8;
+ dl: Tnuint8;
+ dh: Tnuint8;
+ end;
+
+ PWORD_REGISTERS = ^TWORD_REGISTERS;
+ TWORD_REGISTERS = record
+ si: Tnuint16;
+ ds: Tnuint16;
+ di: Tnuint16;
+ es: Tnuint16;
+ ax: Tnuint16;
+ bx: Tnuint16;
+ cx: Tnuint16;
+ dx: Tnuint16;
+ bp: Tnuint16;
+ flags: Tnuint16;
+ end;
+
+ PPTR_REGISTERS = ^TPTR_REGISTERS;
+ TPTR_REGISTERS = record
+ requestBuffer: Tnptr;
+ replyBuffer: Tnptr;
+ end;
+
+ PSEG_OFF_REGISTERS = ^TSEG_OFF_REGISTERS;
+ TSEG_OFF_REGISTERS = record
+ ds_si: Tnptr;
+ es_di: Tnptr;
+ end;
+
+ PREGISTERS = ^TREGISTERS;
+ TREGISTERS = record
+ case longint of
+ 0: (w: TWORD_REGISTERS);
+ 1: (b: TBYTE_REGISTERS);
+ 2: (p: TPTR_REGISTERS);
+ 3: (s: TSEG_OFF_REGISTERS);
+ end;
+
+
+{$IFDEF FPC}
+{$PACKRECORDS C}
+{$ENDIF}
+
+
+{$DEFINE N_PLAT_NLM}
+
+
+//*****************************************************************************
+//nwapidef.h
+//*****************************************************************************
+
+
+{ Miscellaneous string lengths (constant) }
+{ NOTE: These max values include a nullbyte }
+
+const
+ NW_MAX_USER_NAME_LEN = 49;
+ NW_MAX_VOLUME_NAME_LEN = 17;
+ NW_MAX_SERVER_NAME_LEN = 49;
+ NW_MAX_TREE_NAME_LEN = 33;
+ NW_MAX_SERVICE_TYPE_LEN = 49;
+{ Miscellaneous unicode string sizes in bytes (constant) }
+
+ NW_MAX_USER_NAME_BYTES = 2 * NW_MAX_USER_NAME_LEN;
+ NW_MAX_VOLUME_NAME_BYTES = 2 * NW_MAX_VOLUME_NAME_LEN;
+ NW_MAX_SERVER_NAME_BYTES = 2 * NW_MAX_SERVER_NAME_LEN;
+ NW_MAX_TREE_NAME_BYTES = 2 * NW_MAX_TREE_NAME_LEN;
+ NW_MAX_SERVICE_TYPE_BYTES = 2 * NW_MAX_SERVICE_TYPE_LEN;
+{ PrintFlags (word value) }
+ NW_PRINT_FLAG_RELEASE = $0001;
+ NW_PRINT_FLAG_SUPPRESS_FF = $0002;
+ NW_PRINT_FLAG_TEXT_FILE = $0004;
+ NW_PRINT_FLAG_PRINT_BANNER = $0008;
+ NW_PRINT_FLAG_NOTIFY = $0010;
+{ Print string lengths (constant) }
+ NW_MAX_JOBDESCR_LEN = 50;
+ NW_MAX_FORM_NAME_LEN = 13;
+ NW_MAX_BANNER_NAME_LEN = 13;
+ NW_MAX_QUEUE_NAME_LEN = 65;
+{ Client Types : these are returned by NWGetClientType }
+ NW_NETX_SHELL = 1; {dos netx}
+ NW_VLM_REQ = 2; {dos vlm}
+ NW_CLIENT32 = 3; {dos or 9x nlm client}
+ NW_NT_REQ = 4;
+ NW_OS2_REQ = 5;
+ NW_NLM_REQ = 6; {a netware server}
+
+
+type
+ Tnuint = cardinal;
+ pnuint = ^Tnuint;
+ Tnint = longint;
+ pnint = plongint;
+ Tnint32 = longint;
+ pnint32 = plongint;
+ Tnuint32 = cardinal;
+ pnuint32 = pcardinal;
+ Tnint16 = smallint;
+ Pnint16 = ^smallint;
+ TNWCONN_HANDLE = Tnuint;
+ pNWCONN_HANDLE = pnuint;
+ NWCONN_NUM = Tnuint16;
+ //NWCCODE = Tnuint;
+ TNWCCODE = Tnuint;
+ NWDIR_HANDLE = Tnuint8;
+ TNWDIR_HANDLE = NWDIR_HANDLE;
+ PNWDIR_HANDLE = ^NWDIR_HANDLE;
+
+ NWFILE_HANDLE = Tnint;
+ TNWFILE_HANDLE = Tnint;
+ PNWFILE_HANDLE = ^NWFILE_HANDLE;
+ LONG = Tnuint32;
+
+const
+ FA_NORMAL = $00;
+ FA_READ_ONLY = $01;
+ FA_HIDDEN = $02;
+ FA_SYSTEM = $04;
+ FA_EXECUTE_ONLY = $08;
+ FA_DIRECTORY = $10;
+ FA_NEEDS_ARCHIVED = $20;
+ FA_SHAREABLE = $80;
+ { Extended file attributes }
+ FA_TRANSACTIONAL = $10;
+ FA_INDEXED = $20;
+ FA_READ_AUDIT = $40;
+ FA_WRITE_AUDIT = $80;
+
+ { the following is a the correct attribute mask list }
+ { The difference between these and the FA_ constants above is that these
+ are in the correct positions. The last four attributes above are 8 bits
+ off. (They need to be shifted 8 bits to the left.) }
+
+const
+ A_NORMAL = $00000000;
+ A_READ_ONLY = $00000001;
+ A_HIDDEN = $00000002;
+ A_SYSTEM = $00000004;
+ A_EXECUTE_ONLY = $00000008;
+ A_DIRECTORY = $00000010;
+ A_NEEDS_ARCHIVED = $00000020;
+ A_SHAREABLE = $00000080;
+ A_DONT_SUBALLOCATE = $00000800;
+ A_TRANSACTIONAL = $00001000;
+ { not in the NCP book }
+ A_INDEXED = $00002000;
+ A_READ_AUDIT = $00004000;
+ A_WRITE_AUDIT = $00008000;
+ A_IMMEDIATE_PURGE = $00010000;
+ A_RENAME_INHIBIT = $00020000;
+ A_DELETE_INHIBIT = $00040000;
+ A_COPY_INHIBIT = $00080000;
+ A_FILE_MIGRATED = $00400000;
+ A_DONT_MIGRATE = $00800000;
+ A_IMMEDIATE_COMPRESS = $02000000;
+ A_FILE_COMPRESSED = $04000000;
+ A_DONT_COMPRESS = $08000000;
+ A_CANT_COMPRESS = $20000000;
+ { access rights attributes }
+
+const
+ AR_READ = $0001;
+ AR_WRITE = $0002;
+ AR_READ_ONLY = $0001;
+ AR_WRITE_ONLY = $0002;
+ AR_DENY_READ = $0004;
+ AR_DENY_WRITE = $0008;
+ AR_COMPATIBILITY = $0010;
+ AR_WRITE_THROUGH = $0040;
+ AR_OPEN_COMPRESSED = $0100;
+
+ { search attributes }
+ SA_NORMAL = $0000;
+ SA_HIDDEN = $0002;
+ SA_SYSTEM = $0004;
+ SA_SUBDIR_ONLY = $0010;
+ SA_SUBDIR_FILES = $8000;
+ SA_ALL = $8006;
+ USE_NW_WILD_MATCH = 0;
+ USE_DOS_WILD_MATCH = 1;
+
+{ Scope specifiers }
+ GLOBAL = 0;
+ PRIVATE = 1;
+ MY_SESSION = 2;
+ ALL_SESSIONS = 3;
+
+//****************************************************************************
+// nwalias.h
+//****************************************************************************
+
+type
+ FILE_ATTRIBUTES_MASK = Tnuint32;
+ NWACCESS_MODE = Tnuint8;
+ NWACCESS_RIGHTS = Tnuint8;
+ NWACCT_BALANCE = Tnint32;
+ NWACCT_HOLDS = Tnuint16;
+ NWACCT_LIMIT = Tnint32;
+ NWADDR_LEN = Tnuint8;
+ NWADDR_TYPE = Tnuint8;
+ NWAES_COUNT = Tnuint16;
+
+ //!! NWASN1_ID = Asn1ID_T;
+ NWATTR = Tnuint32;
+ NWATTRIBUTES = Tnuint32;
+ //!! NWATTR_INFO = Attr_Info_T;
+ NWAUDIT_BUF_SIZE = Tnuint16;
+ NWAUDIT_CONN_ID = Tnuint32;
+ NWAUDIT_CONTAINER_BIT_MAP = Tnuint32;
+ NWAUDIT_DATA_LEN = Tnuint32;
+ NWAUDIT_DATE_TIME = Tnuint32;
+ NWAUDIT_DS_FLAG = Tnint16;
+ NWAUDIT_EVENT = Tnuint16;
+ NWAUDIT_FILE_CODE = Tnint16;
+ NWAUDIT_FILE_HANDLE = Tnuint32;
+ NWAUDIT_FLAGS = Tnuint32;
+ NWAUDIT_KEY_BUF = pnuint8;
+ NWAUDIT_LEVEL = Tnuint8;
+ NWAUDIT_NAME_SPACE = Tnuint32;
+ NWAUDIT_OBJ_SECURITY = Tnuint32;
+ NWAUDIT_PASSWORD = pnuint8;
+ NWAUDIT_PROCESS_ID = Tnuint32;
+ NWAUDIT_QUEUE_TYPE = Tnuint32;
+ NWAUDIT_RECORD_ID = Tnuint32;
+ NWAUDIT_REC_NUM = Tnuint32;
+ NWAUDIT_REPLICA_NUM = Tnuint16;
+ //!! NWAUDIT_SIZE = NWSIZE;
+ NWAUDIT_STATUS_CODE = Tnuint32;
+ NWAUDIT_TRUSTEE_RIGHTS = Tnuint32;
+ NWAUDIT_VOL_NUM = Tnuint32;
+ { AN ADDITIONAL FLAG SIZE }
+ NWAUGMENT = Tnuint16;
+ NWBITS = Tnuint32;
+ NWBROADCAST_MODE = Tnuint16;
+ NWBUF_SIZE = Tnuint16;
+ NWCHANGE_BITS = Tnuint32;
+ NWCHANGE_TYPE = Tnuint32;
+ NWCHARGE_AMOUNT = Tnint32;
+ //!! NWCLASS_INFO = Class_Info_T;
+ NWCONFIG_DEFAULT_VALUE = Tnint32;
+ NWCONFIG_ELEMENT_NUM = Tnint16;
+ NWCONFIG_PARAM_TYPE = Tnint16;
+ NWCONN_FLAGS = Tnuint16;
+ NWCONN_NUM_WORD = Tnuint16;
+ NWCONN_TYPE = Tnuint8;
+ NWCOUNT = Tnuint32;
+ NWCTLR_NUM = Tnuint8;
+ NWCTLR_TYPE = Tnuint8;
+ NWCURRENT_REC = Tnuint16;
+ NWDATA_STREAM = Tnuint32;
+ NWDATE = Tnuint16;
+ NWDATE_TIME = Tnuint32;
+ NWDELETE_TIME = Tnuint32;
+ NWDENY_COUNT = Tnuint16;
+ NWDEVICE_ID = Tnuint16;
+ NWDIR_ATTRIBUTES = Tnuint8;
+ NWDIR_BASE = Tnuint32;
+ NWDIR_ENTRY = Tnuint32;
+ NWDIR_ID = Tnuint8;
+ NWDIR_NUM = Tnuint16;
+ NWDIR_SPACE = Tnuint32;
+ NWDIR_STAMP = Tnuint16;
+ NWDIR_TRUSTEE_RIGHTS = Tnuint16;
+ NWDIR_VOL = Tnuint8;
+ NWDISK_CHANNEL = byte;
+ NWDISK_DRV_TYPE = byte;
+ NWDISK_FLAGS = word;
+ NWDISK_NUM = byte;
+ NWDISK_SPACE = cardinal;
+ NWDISK_TYPE = byte;
+ NWDISTANCE = word;
+ NWDMA = byte;
+ NWDM_FLAGS = cardinal;
+ NWDRIVE_NUM = word;
+ NWDRIVE_NUMBER = byte;
+ NWDRV_COMMAND = cardinal;
+ NWDRV_CONFIG = cardinal;
+ NWDRV_FLAGS = word;
+ NWDRV_ID = word;
+ NWDRV_LINK = cardinal;
+ NWDRV_MEM = cardinal;
+ NWDRV_NAME = cardinal;
+ NWDRV_TAG = cardinal;
+ NWDRV_TYPE = cardinal;
+ NWDRV_VERSION = byte;
+ NWDSLEN = cardinal;
+ //!! NWDS_BUFFER = Buf_T;
+ NWDS_EVENT = cardinal;
+ //!! NWDS_FILTER_CURSOR = Filter_Cursor_T;
+ NWDS_FILTER_LEVEL = word;
+ //!! NWDS_FILTER_NODE = Filter_Node_T;
+ NWDS_FLAGS = cardinal;
+ NWDS_ID = Tnint16;
+ NWDS_INTERVAL = cardinal;
+ NWDS_ITERATION = Tnint32;
+ NWDS_LOGIN_FILE = Tnint16;
+ NWDS_NUM_OBJ = Tnint32;
+ NWDS_OPERATION = cardinal;
+ NWDS_PRIVILEGES = cardinal;
+ NWDS_SEARCH_SCOPE = word;
+ //!! NWDS_SESSION_KEY = NWDS_Session_Key_T;
+ NWDS_SIZE = cardinal;
+ NWDS_SYNTAX_FLAGS = Tnint16;
+ NWDS_TOKEN = word;
+ NWDS_TYPE = cardinal;
+ NWDS_TYPE_LEVEL = cardinal;
+ NWDS_VALIDITY = cardinal;
+ NWDS_VALUE = cardinal;
+ //!! NWEA = NW_EA_HANDLE;
+ NWEA_HANDLE = cardinal;
+ NWEA_KEY = word;
+ NWEA_KEY_LEN = word;
+ NWEA_KEY_OFFSET = word;
+ //!! NWEA_SCAN = NW_EA_FF_STRUCT;
+ NWECB_CANCEL_COUNT = word;
+ NWELEMENT_VALUE = Tnint16;
+ NWEMAIL_TYPE = cardinal;
+ NWFACTOR = cardinal;
+ NWFAT = cardinal;
+ NWFILE_ATTR = byte;
+ NWFILE_LEN = cardinal;
+ NWFILE_MODE = byte;
+ NWFILE_SYS_ID = cardinal;
+ NWFINDER_INFO = byte;
+ NWFLAGS = byte;
+ NWFORM_NUM = byte;
+ NWFORM_TYPE = word;
+ NWFRAG_SIZE = word;
+ NWFSE_CONN_TYPE = cardinal;
+ NWFSE_FLAGS = cardinal;
+ NWGLT_FAIL_COUNT = word;
+ NWHANDLE = byte;
+ NWHF_START = cardinal;
+ //!! NWHOLDS_INFO = HOLDS_INFO;
+ //!! NWHOLDS_STATUS = HOLDS_STATUS;
+ NWHOLD_AMOUNT = cardinal;
+ NWHOLD_CANCEL_AMOUNT = cardinal;
+ NWINFO_LEVEL = cardinal;
+ NWINTERRUPT = byte;
+ NWIO_MEM = word;
+ NWJOB_FLAGS = word;
+ NWJOB_HANDLE = cardinal;
+ NWJOB_POSITION = byte;
+ NWJOB_POSITION2 = word;
+ NWJOB_TYPE = word;
+ NWLAN_NUM = byte;
+ NWLAST_RECORD = Tnint16;
+ NWLEN = cardinal;
+ NWLENGTH = word;
+ { FOR DOS, OS/2, AND WINDOWS }
+ NWLOCAL_FILE_HANDLE = word;
+ NWLOCAL_MODE = word;
+ NWLOCAL_SCOPE = word;
+ NWLOCK_COUNT = word;
+ NWLOCK_DATA_STREAM = byte;
+ NWLOCK_STATE = byte;
+ NWLOCK_TYPE = byte;
+ //NWLOCK_TYPE = byte;
+ NWLOGIN_TIME = array[0..6] of byte;
+
+
+type
+ NWLPT = byte;
+ NWMAX_PACKET_SIZE = word;
+ NWMEDIA_MASK = cardinal;
+ NWMEDIA_TYPE = cardinal;
+ NWMEM_OFFSET = word;
+ NWMINUTES = byte;
+ NWMODULE_ID = cardinal;
+ NWNAME = pnuint8;
+ NWNAME_LEN = byte;
+ NWNAME_SPACE = byte;
+ NWNAME_SPACE_TYPE = cardinal;
+ NWNET_ADDR = byte;
+ NWNET_ADDR_LEN = cardinal;
+ NWNET_ADDR_TYPE = cardinal;
+ NWNEXT_REQUEST = word;
+ NWNLM_ID = cardinal;
+ NWNLM_TYPE = cardinal;
+ NWNOTE_TYPE = word;
+ NWNS_ACCESS_MODE = word;
+ NWNS_ACCESS_RIGHTS = word;
+ NWNS_ATTR = word;
+ NWNS_BITS = word;
+ NWNS_DATA_STREAM = byte;
+ NWNS_DATA_STREAM2 = word;
+ NWNS_FLAGS = word;
+ NWNS_HANDLE = cardinal;
+ NWNS_LIST_SIZE = byte;
+ NWNS_MASK = cardinal;
+ NWNS_NUM = byte;
+ NWNS_TYPE = word;
+ NWNUM = cardinal;
+ NWNUMBER = word;
+ NWNUMBER_ENTRIES = byte;
+ NWNUM_BLOCKS = cardinal;
+ NWNUM_BUFFERS = word;
+ NWNUM_BYTES = cardinal;
+ NWNUM_CONNS = byte;
+ NWNUM_COPIES = byte;
+ NWNUM_DIR_ENTRIES = cardinal;
+ NWNUM_DRIVES = byte;
+ NWNUM_ELEMENTS = Tnint16;
+ NWNUM_ENTRIES = word;
+ NWNUM_FORKS = byte;
+ NWNUM_HEADS = byte;
+ NWNUM_HOPS = word;
+ NWNUM_PACKETS = cardinal;
+ NWNUM_REQUESTS = cardinal;
+ NWNUM_SECTORS = byte;
+ NWNUM_TRANSACTIONS = byte;
+ //!! NWOBJECT_INFO = Object_Info_T;
+ NWOBJ_ID = cardinal;
+ NWOBJ_TYPE = word;
+ NWOFFSET = cardinal;
+ NWOPEN_COUNT = word;
+ NWOPTION_NUM = byte;
+ NWOS_REVISION = word;
+ NWOS_VERSION = word;
+ NWPATH_SIZE = word;
+ NWPATH_VOL = byte;
+ NWPOSITION = cardinal;
+ NWPRINTER = word;
+ NWPRINT_FLAGS = word;
+ NWPRINT_TASK = cardinal;
+ NWPROTOCOL_MASK = cardinal;
+ NWPROTOCOL_VERSION = byte;
+ NWPSTR = pnstr;
+ NWQMS_HANDLE = cardinal;
+ NWQMS_TASK = cardinal;
+ NWREC_OFFSET = word;
+ NWREPLICA_NUM = Tnint32;
+ NWREPLICA_TYPE = cardinal;
+ NWREQUESTER_VERSION = byte;
+ NWREQUEST_MASK = word;
+ NWRESERVED16 = cardinal;
+ NWRESERVED32 = cardinal;
+ NWREVISION = cardinal;
+ NWRIGHTS = cardinal;
+ NWRIGHTS_MASK = word;
+ NWSEARCH_ATTR = byte;
+ NWSEARCH_ATTRIBUTES = word;
+ NWSEARCH_CONTEXT = word;
+ NWSEARCH_MASK = word;
+ NWSECONDS = cardinal;
+ NWSEGMENT_DATA = pnuint8;
+ NWSEGMENT_NUM = byte;
+ NWSEM_HANDLE = cardinal;
+ NWSEM_INT = Tnint16;
+ NWSEM_VALUE = word;
+ NWSEQUENCE = cardinal;
+ NWSEQUENCE_NUM = word;
+ NWSEQ_NUM = byte;
+ NWSERVER_NAME_LEN = word;
+ NWSERVER_TYPE = word;
+ NWSERVICE_VERSION = byte;
+ NWSESSION_ID = word;
+ NWSIZE = cardinal;
+ NWSOCKET_COUNT = word;
+ NWSPX_COUNT = word;
+ NWSTATION_NUM = byte;
+ NWSTATION_NUM2 = cardinal;
+ NWSTATS_VERSION = byte;
+ NWSTATUS = cardinal;
+ NWSTRUCT_SIZE = word;
+ NWSUPPORT_LEVEL = byte;
+ NWSYNTAX_ID = cardinal;
+ //!! NWSYNTAX_INFO = Syntax_Info_T;
+ NWSYS_TIME = cardinal;
+ NWTAB = byte;
+ NWTASK = word;
+ NWTASK_COUNT = byte;
+ NWTASK_NUM = word;
+ NWTASK_STATE = byte;
+ NWTDS = word;
+ NWTDS_OFFSET = word;
+ NWTICKS = word;
+ NWTIME = word;
+ NWTRAN_TYPE = byte;
+ NWTRUSTEE_SEQUENCE_NUM = word;
+ NWUSE_COUNT = word;
+ NWUTILIZATION = cardinal;
+ NWVCONSOLE_REVISION = byte;
+ NWVCONSOLE_VERSION = byte;
+ NWVERSION = cardinal;
+ NWVOL = cardinal;
+ NWVOL_FLAGS = word;
+ NWVOL_NUM = word;
+ NWVOL_NUMBER = byte;
+ NWVOL_TYPE = cardinal;
+ TRUSTEE_RIGHTS = cardinal;
+//*****************************************************************************
+//nwafp.h
+//*****************************************************************************
+
+
+ {* This is the structure that the application expects to see. Note that the
+ long name and short name will be null terminated, and one extra byte has
+ been added to long name and short name to assure word alignment * }
+type
+
+ PAFPFILEINFO = ^TAFPFILEINFO;
+ TAFPFILEINFO = record
+ entryID: Tnuint32;
+ parentID: Tnuint32;
+ attributes: Tnuint16;
+ dataForkLength: Tnuint32;
+ resourceForkLength: Tnuint32;
+ numOffspring: Tnuint16;
+ creationDate: Tnuint16;
+ accessDate: Tnuint16;
+ modifyDate: Tnuint16;
+ modifyTime: Tnuint16;
+ backupDate: Tnuint16;
+ backupTime: Tnuint16;
+ finderInfo: array[0..31] of Tnuint8;
+ longName: array[0..33] of Tnstr8;
+ ownerID: Tnuint32;
+ shortName: array[0..13] of Tnstr8;
+ accessPrivileges: Tnuint16;
+ proDOSInfo: array[0..5] of Tnuint8;
+ end;
+ TNW_AFP_FILE_INFO = TAFPFILEINFO;
+ PNW_AFP_FILE_INFO = ^TNW_AFP_FILE_INFO;
+ {This is the structure that actually returned from the NCP call}
+
+ PRECPKT_AFPFILEINFO = ^TRECPKT_AFPFILEINFO;
+ TRECPKT_AFPFILEINFO = record
+ entryID: Tnuint32;
+ parentID: Tnuint32;
+ attributes: Tnuint16;
+ dataForkLength: Tnuint32;
+ resourceForkLength: Tnuint32;
+ numOffspring: Tnuint16;
+ creationDate: Tnuint16;
+ accessDate: Tnuint16;
+ modifyDate: Tnuint16;
+ modifyTime: Tnuint16;
+ backupDate: Tnuint16;
+ backupTime: Tnuint16;
+ finderInfo: array[0..31] of Tnuint8;
+ longName: array[0..31] of Tnstr8;
+ ownerID: Tnuint32;
+ shortName: array[0..11] of Tnstr8;
+ accessPrivileges: Tnuint16;
+ proDOSInfo: array[0..5] of Tnuint8;
+ end;
+
+ PAFPSETINFO = ^TAFPSETINFO;
+ TAFPSETINFO = record
+ attributes: Tnuint16;
+ creationDate: Tnuint16;
+ accessDate: Tnuint16;
+ modifyDate: Tnuint16;
+ modifyTime: Tnuint16;
+ backupDate: Tnuint16;
+ backupTime: Tnuint16;
+ finderInfo: array[0..31] of Tnuint8;
+ proDOSInfo: array[0..5] of Tnuint8;
+ end;
+ TNW_AFP_SET_INFO = TAFPSETINFO;
+ PNW_AFP_SET_INFO = ^TNW_AFP_SET_INFO;
+
+ NWAFP_ACCESS_PRIVILEGES = word;
+ NWAFP_ENTRY_ID = cardinal;
+ NWAFP_FILE_ATTRIBUTES = word;
+ //!! NWAFP_FILE_INFO = AFPFILEINFO;
+ NWAFP_FORK_LEN = cardinal;
+ NWAFP_NUM_OFFSPRING = word;
+ //!! NWAFP_SET_INFO = AFPSETINFO;
+ NWAPP_NUM = word;
+
+
+
+{ the following are the constants that can be used for requestMasks
+ in NWAFPScanFileInformation and NWAFPGetFileInformation. }
+
+const
+ AFP_GET_ATTRIBUTES = $0001;
+ AFP_GET_PARENT_ID = $0002;
+ AFP_GET_CREATE_DATE = $0004;
+ AFP_GET_ACCESS_DATE = $0008;
+ AFP_GET_MODIFY_DATETIME = $0010;
+ AFP_GET_BACKUP_DATETIME = $0020;
+ AFP_GET_FINDER_INFO = $0040;
+ AFP_GET_LONG_NAME = $0080;
+ AFP_GET_ENTRY_ID = $0100;
+ AFP_GET_DATA_LEN = $0200;
+ AFP_GET_RESOURCE_LEN = $0400;
+ AFP_GET_NUM_OFFSPRING = $0800;
+ AFP_GET_OWNER_ID = $1000;
+ AFP_GET_SHORT_NAME = $2000;
+ AFP_GET_ACCESS_RIGHTS = $4000;
+ AFP_GET_PRO_DOS_INFO = $8000;
+ AFP_GET_ALL = $FFFF;
+
+{ used for NWAFPSetFileInformation }
+ AFP_SET_ATTRIBUTES = $0001;
+ AFP_SET_CREATE_DATE = $0004;
+ AFP_SET_ACCESS_DATE = $0008;
+ AFP_SET_MODIFY_DATETIME = $0010;
+ AFP_SET_BACKUP_DATETIME = $0020;
+ AFP_SET_FINDER_INFO = $0040;
+ AFP_SET_PRO_DOS_INFO = $8000;
+ AFP_SA_NORMAL = $0000;
+ AFP_SA_HIDDEN = $0100;
+ AFP_SA_SYSTEM = $0200;
+ AFP_SA_SUBDIR = $0400;
+ AFP_SA_FILES = $0800;
+ AFP_SA_ALL = $0F00;
+
+
+function NWAFPAllocTemporaryDirHandle(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; AFPPathString: Pnstr8; dirHandle: PNWDIR_HANDLE;
+ accessRights: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWAFPCreateDirectory(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; finderInfo: pnuint8; AFPPathString: pnstr8;
+ newAFPEntryID: pnuint32): TNWCCODE; NWLIB_CLIB;
+
+function NWAFPCreateFile(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; delExistingFile: Tnuint8; finderInfo: pnuint8;
+ AFPPathString: Pnstr8; newAFPEntryID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPDelete(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; AFPPathString: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPGetEntryIDFromName(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; AFPPathString: Pnstr8; newAFPEntryID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPGetEntryIDFromHandle(conn: TNWCONN_HANDLE; NWHandle: Pnuint8; volNum: pnuint16; AFPEntryID: pnuint32; forkIndicator: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPGetEntryIDFromPathName(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; AFPEntryID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPGetFileInformation(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; reqMask: Tnuint16; AFPPathString: Pnstr8;
+ structSize: Tnuint16; AFPFileInfo: PNW_AFP_FILE_INFO): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPDirectoryEntry(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPOpenFileFork(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; forkIndicator: Tnuint8; accessMode: Tnuint8;
+ AFPPathString: Pnstr8; fileID: pnuint32; forkLength: pnuint32; NWHandle: pnuint8; DOSFileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWAFPRename(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPSourceEntryID: Tnuint32; AFPDestEntryID: Tnuint32; AFPSrcPath: Pnstr8;
+ AFPDstPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPScanFileInformation(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPEntryID: Tnuint32; AFPLastSeenID: pnuint32; searchMask: Tnuint16;
+ reqMask: Tnuint16; AFPPathString: Pnstr8; structSize: Tnuint16; AFPFileInfo: PNW_AFP_FILE_INFO): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPSetFileInformation(conn: TNWCONN_HANDLE; volNum: Tnuint16; AFPBaseID: Tnuint32; reqMask: Tnuint16; AFPPathString: Pnstr8;
+ structSize: Tnuint16; AFPSetInfo: PNW_AFP_SET_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWAFPSupported(conn: TNWCONN_HANDLE; volNum: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAFPASCIIZToLenStr(pbstrDstStr: Pnstr8; pbstrSrcStr: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+//*******************
+// unicode.h
+//*******************
+
+type
+ Psize_t = ^Tsize_t;
+ Tsize_t = dword;
+ Punicode = ^Tunicode;
+ Tunicode = word;
+ { Unicode data must be 16 bits }
+
+ {typedef unicode * punicode; }
+ {typedef unicode * * ppunicode; }
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ //function nwunisize(x : longint) : longint;
+
+ { Converter handle }
+type
+
+ PCONVERT = ^TCONVERT;
+ TCONVERT = pointer;
+
+ PpCONVERT = ^TpCONVERT;
+ TpCONVERT = TCONVERT;
+
+ {************************************************************************** }
+ {Type definitions for converter based APIs }
+ {Function called when non-mappable bytes are found }
+ { Handle to Byte <-> Uni converter }
+ { Pointer to current output position }
+ { Space left in output buffer }
+ { Space used in output buffer }
+ { Pointer to unmappable bytes }
+ { Size of unmappable input }
+type
+
+ TNMBYTE = function(byteUniHandle: TpCONVERT; output: punicode; outputLeft: Tnuint; outputUsed: pnuint; badInput: Pnuint8;
+ badInputSize: Tnuint): Tnint; cdecl;
+ {
+ Function called when non-mappable unicode characters are found
+ }
+ { Handle to Byte <-> Uni converter }
+ { Pointer to current output position }
+ { Space left in output buffer }
+ { Space used in output buffer }
+ { Ptr to unmappable unicode chars }
+ { Size of unmappable input }
+
+ TNMUNI = function(byteUniHandle: TpCONVERT; output: pnuint8; outputLeft: Tnuint; outputUsed: pnuint; badInput: Punicode;
+ badInputSize: Tnuint): Tnint; cdecl;
+ {
+ Function called to scan for special byte input
+ }
+ { Handle to Byte <-> Uni converter }
+ { Input to scan for special bytes }
+ { Maximum # of bytes to scan or -1 }
+
+ TSCBYTE = function(byteUniHandle: TpCONVERT; input: Pnuint8; scanmax: Tnint): pnuint8; cdecl;
+ {
+ Function called to scan for special Unicode input
+ }
+ { Handle to Byte <-> Uni converter }
+ { Input to scan for special chars }
+ { Maximum # of bytes to scan or -1 }
+
+ TSCUNI = function(byteUniHandle: TpCONVERT; input: Punicode; scanmax: Tnint): punicode; cdecl;
+ {
+ Function called to parse special byte input
+ }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for Unicode output }
+ { Space left in output buffer }
+ { Space used in output buffer }
+ { Buffer containing byte input }
+ { Number of bytes of input used }
+
+ TPRBYTE = function(byteUniHandle: TpCONVERT; output: punicode; outputleft: Tnuint; outputUsed: pnuint; input: Pnuint8;
+ inputUsed: pnuint): Tnint; cdecl;
+ {
+ Function called to parse special Unicode input
+ }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for bytes output }
+ { Space left in output buffer }
+ { Space used in output buffer }
+ { Buffer containing byte input }
+ { Number of Unicodes of input used }
+
+ TPRUNI = function(byteUniHandle: TpCONVERT; output: pnuint8; outputLeft: Tnuint; outputUsed: pnuint; input: Punicode;
+ inputUsed: pnuint): Tnint; cdecl;
+ {************************************************************************** }
+ {
+ Macros used by and returned from converter based API calls
+ (i.e. NWUS*, NWUX*)
+ }
+ {
+ Novell-defined Unicode characters.
+ Consult with the Internationalization group before adding to this list.
+ }
+
+const
+ UNI_CHANGE_NAMESPACE = $F8F4;
+ UNI_PREVIOUS_DIR = $F8F5;
+ UNI_CURRENT_DIR = $F8F6;
+ UNI_PATH_SEPARATOR = $F8F7;
+ UNI_VOLUMENAME_ROOT = $F8F8;
+ UNI_VOLUME_ROOT = $F8F9;
+ UNI_NDS_ROOT = $F8FA;
+ UNI_WILD_QMARK = $F8FB;
+ UNI_WILD_ASTERISK = $F8FC;
+ UNI_WILD_AUG_QMARK = $F8FD;
+ UNI_WILD_AUG_ASTERISK = $F8FE;
+ UNI_WILD_AUG_PERIOD = $F8FF;
+ {
+ Actions to take when an unmappable byte or uni character is encountered.
+ Used in SetNoMapAction call.
+ }
+ { Leave action unchanged }
+ NWU_UNCHANGED_ACTION = -(1);
+ { Return error code NWU_UNMAPPABLE_CHAR }
+ NWU_RETURN_ERROR = 0;
+ { Use the current substitution character }
+ NWU_SUBSTITUTE = 1;
+ { Call the no map handler function }
+ NWU_CALL_HANDLER = 2;
+ {
+ Codes to enable the Scan and Parse handler functions.
+ Used in SetScanAction call.
+ }
+ NWU_DISABLED = 0; // Disable Scan/Parse functions
+ NWU_ENABLED = 2; // Enable Scan/Parse functions
+ { Flags to pass to NWUXGetCaseConverter to specify whether to load
+ a converter which converts to upper, lower or title case. }
+ NWU_LOWER_CASE = 0; // Lower case
+ NWU_UPPER_CASE = 1;
+ NWU_TITLE_CASE = 2;
+ { Flags to pass to NWUXGetNormalizeConverter to specify whether to
+ load a converter which converts to pre-composed or de-composed
+ unicode characters. }
+ NWU_PRECOMPOSED = 0;
+ NWU_DECOMPOSED = 1;
+ { For use in SetByte/UniFunction calls }
+ //function NWU_UNCHANGED_FUNCTION : pointer;
+
+
+const
+ NWU_RESET_TO_DEFAULT = nil;
+ { Error codes. FFFFFDE0 to FFFFFDFF reserved for new unicode APIs. }
+ NWU_NO_CONVERTER = -(544); // Default converter not loaded
+ NWU_CONVERTER_NOT_FOUND = -(543); // Converter file was not found
+ NWU_TOO_MANY_FILES = -(542); // Too many open files
+ NWU_NO_PERMISSION = -(541); // Access to file was denied
+ NWU_OPEN_FAILED = -(540); // File open failed
+ NWU_READ_FAILED = -(539); // File read failed
+ NWU_OUT_OF_MEMORY = -(538); // Insufficient memory
+ NWU_CANT_LOAD_CONVERTER = -(537); // Unable to load converter
+ NWU_CONVERTER_CORRUPT = -(536); // The converter is invalid
+ NWU_NULL_HANDLE = -(535); // Converter handle was NULL
+ NWU_BAD_HANDLE = -(534); // Converter handle is invalid
+ NWU_HANDLE_MISMATCH = -(533); // Handle doesn't match operation
+ NWU_UNMAPPABLE_CHAR = -(532); // Unmappable character found
+ NWU_RANGE_ERROR = -(531); // Invalid constant passed to fn
+ NWU_BUFFER_FULL = -(530); // Buffer too small for output
+ NWU_INPUT_MAX = -(529); // Processed max # of input chars
+ UNI_PARSER_ERROR = -(528); // Error from user-written parser
+ NWU_OLD_CONVERTER_VERSION = -(527); // Outdated converter DLL
+ NWU_UNSUPPORTED_AUX_FUNCTION = -(526); // Unsupported AUX function
+ NWU_EMBEDDED_NULL = -(525); // Embedded null in len spec string
+ NWU_GET_CODE_PAGE_FAILED = -(524); // Failed to get system cp or cc
+ NWU_ILLEGAL_UTF8_CHARACTER = -(506); // Cannot convert UTF8 char to Uni
+ NWU_INSUFFICIENT_BUFFER = -(500);
+ { Error codes for translator based APIs (i.e. NW prefix) }
+ UNI_ALREADY_LOADED = -(489); // Already loaded another country or code page
+ UNI_FUTURE_OPCODE = -(490); // Rule table has unimplimented rules
+ UNI_NO_SUCH_FILE = -(491); // No such file or directory
+ UNI_TOO_MANY_FILES = -(492); // Too many files already open
+ UNI_NO_PERMISSION = -(493); // Permission denied on file open
+ UNI_NO_MEMORY = -(494); // Not enough memory
+ UNI_LOAD_FAILED = -(495); // NWLoadRuleTable failed, don't know why
+ UNI_HANDLE_BAD = -(496); // Rule table handle was bad
+ UNI_HANDLE_MISMATCH = -(497); // Rule table handle doesn't match operation
+ UNI_RULES_CORRUPT = -(498); // Rule table is corrupt
+ UNI_NO_DEFAULT = -(499); // No default rule and no 'No map' character
+ UNI_INSUFFICIENT_BUFFER = -(500);
+ UNI_OPEN_FAILED = -(501); // Open failed in NWLoadRuleTable
+ UNI_NO_LOAD_DIR = -(502); // Load directory could not be determined
+ UNI_BAD_FILE_HANDLE = -(503); // File handle was bad
+ UNI_READ_FAILED = -(504); // File read of rule table failed
+ UNI_TRANS_CORRUPT = -(505); // Translator is corrupt
+ UNI_ILLEGAL_UTF8_CHARACTER = -(506); // Illegal UTF-8 character encountered
+
+ {************************************************************************** }
+ { Unicode converter prototypes - These APIs are preferred over the older
+ non-converter counterparts (i.e. NWUnicodeToLocal, NWLocalToUnicode, etc.)}
+ { These are the Standard API's }
+
+ { Initialize standard converters }
+
+function NWUSStandardUnicodeInit: Tnint; NWLIB_LOCNLM32;
+ { Replace standard converter. }
+function NWUSStandardUnicodeOverride(codepage: Tnuint): Tnint; NWLIB_LOCNLM32;
+ { Release the standard converters }
+procedure NWUSStandardUnicodeRelease; NWLIB_LOCNLM32;
+ { Get the native code page and country }
+function NWUSGetCodePage(pCodePage: pnuint; pCountry: pnuint): Tnint; NWLIB_LOCNLM32;
+ { NOTE: The actualLength parameter returned by the conversion routines
+ does *not* include the null terminator.
+ }
+ { Convert bytes to Unicode }
+ { Buffer for resulting Unicode }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for input bytes }
+ { Length of results in uni chars }
+function NWUSByteToUnicode(unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode for file path }
+ { Buffer for resulting Unicode }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for input bytes }
+ { Length of results in uni chars }
+function NWUSByteToUnicodePath(unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode }
+ { Buffer for resulting Unicode }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for input bytes }
+ { Input str length in bytes or -1 }
+ { Length of results in uni chars }
+function NWUSLenByteToUnicode(unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; inLength: Tnint; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode for file path }
+ { Buffer for resulting Unicode }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for input bytes }
+ { Input str length in bytes or -1 }
+ { Length of results in uni chars }
+function NWUSLenByteToUnicodePath(unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; inLength: Tnint; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes }
+ { Buffer for output bytes }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUSUnicodeToByte(byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes for file path }
+ { Buffer for output bytes }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUSUnicodeToBytePath(byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes }
+ { Buffer for output bytes }
+ { Length of output buffer }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUSUnicodeToUntermByte(byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes for file path }
+ { Buffer for output bytes }
+ { Length of output buffer }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUSUnicodeToUntermBytePath(byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to lower case }
+ { Buffer for lower cased output }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in uni chars }
+function NWUSUnicodeToLowerCase(lowerCaseOutput: punicode; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to upper case }
+ { Buffer for upper cased output }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in uni chars }
+function NWUSUnicodeToUpperCase(upperCaseOutput: punicode; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ {
+ These are the Extended API's
+ }
+ { Load a Byte <-> Unicode converter }
+ { Codepage number }
+ { Converter handle returned here }
+function NWUXLoadByteUnicodeConverter(codepage: Tnuint; byteUniHandle: PpCONVERT): Tnint; NWLIB_LOCNLM32;
+ { Load a Unicode -> Case converter }
+ { Want upper, lower or title casing? }
+ { Converter handle returned here }
+function NWUXLoadCaseConverter(caseFlag: Tnuint; caseHandle: PpCONVERT): Tnint; NWLIB_LOCNLM32;
+ { Load a Unicode -> Collation converter }
+ { Country code for this locale }
+ { Converter handle returned here }
+function NWUXLoadCollationConverter(countryCode: Tnuint; collationHandle: PpCONVERT): Tnint; NWLIB_LOCNLM32;
+ { Load a Unicode -> Normalized converter }
+ { Want precomposed or decomposed flag? }
+ { Converter handle returned here }
+function NWUXLoadNormalizeConverter(preDeFlag: Tnuint; normalizeHandle: PpCONVERT): Tnint; NWLIB_LOCNLM32;
+ { Release a converter from memory }
+ { Handle to converter to be released }
+function NWUXUnloadConverter(converterHandle: TpCONVERT): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for resulting Unicode }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for input bytes }
+ { Length of results in uni chars }
+function NWUXByteToUnicode(byteUniHandle: TpCONVERT; unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode for file path }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for resulting Unicode }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for input bytes }
+ { Length of results in uni chars }
+function NWUXByteToUnicodePath(byteUniHandle: TpCONVERT; unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for resulting Unicode }
+ { Length of output buffer }
+
+ { Buffer for input bytes }
+ { Input str length in bytes or -1 }
+ { Length of results in uni chars }
+function NWUXLenByteToUnicode(byteUniHandle: TpCONVERT; unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; inLength: Tnint;
+ actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert bytes to Unicode for file path }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for resulting Unicode }
+ { Length of output buffer }
+
+ { Buffer for input bytes }
+ { Input str length in bytes or -1 }
+ { Length of results in uni chars }
+function NWUXLenByteToUnicodePath(byteUniHandle: TpCONVERT; unicodeOutput: punicode; outputBufferLen: Tnuint; byteInput: Pnuint8; inLength: Tnint;
+ actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for output bytes }
+ { Length of output buffer }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUXUnicodeToByte(byteUniHandle: TpCONVERT; byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes for file path }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for output bytes }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUXUnicodeToBytePath(byteUniHandle: TpCONVERT; byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for output bytes }
+ { Length of output buffer }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUXUnicodeToUntermByte(byteUniHandle: TpCONVERT; byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes for file path }
+ { Handle to Byte <-> Uni converter }
+ { Buffer for output bytes }
+ { Length of output buffer }
+
+ { Buffer for Unicode input }
+ { Length of results in bytes }
+function NWUXUnicodeToUntermBytePath(byteUniHandle: TpCONVERT; byteOutput: pnuint8; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert to upper, lower or title case }
+ { Handle to converter }
+ { Buffer for output }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in uni chars }
+function NWUXUnicodeToCase(caseHandle: TpCONVERT; monocasedOutput: punicode; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to Collation weights }
+ { Handle to converter }
+ { Buffer for collation weights }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in uni chars }
+function NWUXUnicodeToCollation(collationHandle: TpCONVERT; collationWeights: punicode; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to normalized }
+ { Handle to converter }
+ { Buffer for normalized output }
+ { Length of output buffer. Or 0 }
+
+ { Buffer for Unicode input }
+ { Length of results in uni chars }
+function NWUXUnicodeToNormalized(normalizeHandle: TpCONVERT; normalizedOutput: punicode; outputBufferLen: Tnuint; unicodeInput: Punicode; actualLength: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to bytes for file path }
+ { Handle to Byte <-> Uni converter }
+
+ { Ptr to single or double-byte char }
+ { # bytes in character (1 or 2) }
+function NWUXGetCharSize(byteUniHandle: TpCONVERT; byteInput: Pnuint8; pCharSize: pnuint): Tnint; NWLIB_LOCNLM32;
+ { Set action to be taken for no map chars }
+ { Handle to a Byte <-> Unicode converter }
+ { Action to take for unmappable bytes }
+ { Action to take for unmappable unicode }
+function NWUXSetNoMapAction(byteUniHandle: TpCONVERT; noMapByteAction: Tnint; noMapUniAction: Tnint): Tnint; NWLIB_LOCNLM32;
+ { Get action to be taken for no map chars }
+ { Handle to a Byte <-> Unicode converter }
+ { Action to take for unmappable bytes }
+ { Action to take for unmappable unicode }
+function NWUXGetNoMapAction(byteUniHandle: TpCONVERT; noMapByteAction: pnint; noMapUniAction: pnint): Tnint; NWLIB_LOCNLM32;
+ { Enable or disable scan/parse functions }
+ { Handle to a Byte <-> Unicode converter }
+ { Set action for scan/parse byte functions }
+ { Set action for scan/parse uni functions }
+function NWUXSetScanAction(byteUniHandle: TpCONVERT; scanByteAction: Tnint; scanUniAction: Tnint): Tnint; NWLIB_LOCNLM32;
+ { Get status of scan/parse functions }
+ { Handle to a Byte <-> Unicode converter }
+ { Status of scan/parse byte functions }
+ { Status of scan/parse uni functions }
+function NWUXGetScanAction(byteUniHandle: TpCONVERT; scanByteAction: pnint; scanUniAction: pnint): Tnint; NWLIB_LOCNLM32;
+ { Set substitution byte for converter }
+ { Handle to a Byte <-> Unicode converter }
+ { Byte to be substituted }
+function NWUXSetSubByte(byteUniHandle: TpCONVERT; substituteByte: Tnuint8): Tnint; NWLIB_LOCNLM32;
+ { Get substitution byte for converter }
+ { Handle to a Byte <-> Unicode converter }
+ { Substitution byte returned here }
+function NWUXGetSubByte(byteUniHandle: TpCONVERT; substituteByte: pnuint8): Tnint; NWLIB_LOCNLM32;
+ { Set substitute uni char for converter }
+ { Handle to a Byte <-> Unicode converter }
+ { Unicode character to be substituted }
+function NWUXSetSubUni(byteUniHandle: TpCONVERT; substituteUni: Tunicode): Tnint; NWLIB_LOCNLM32;
+ { Get substitute uni char for converter }
+ { Handle to a Byte <-> Unicode converter }
+ { Substitution unicode char returned here }
+function NWUXGetSubUni(byteUniHandle: TpCONVERT; substituteUni: punicode): Tnint; NWLIB_LOCNLM32;
+ { Set up unmappable byte handling }
+ { Handle to a Byte <-> Unicode converter }
+ { Function called for unmappable bytes }
+ { Byte scanning function }
+ { Byte parsing function }
+function NWUXSetByteFunctions(byteUniHandle: TpCONVERT; noMapByteFunc: TNMBYTE; scanByteFunc: TSCBYTE; parseByteFunc: TPRBYTE): Tnint; NWLIB_LOCNLM32;
+ { Get unmappable byte handling functions }
+ { Handle to a Byte <-> Unicode converter }
+ { Handler function returned here }
+ { Byte scanning function }
+ { Byte parsing function }
+function NWUXGetByteFunctions(byteUniHandle: TpCONVERT; var noMapByteFunc: TNMBYTE; var scanByteFunc: TSCBYTE; var parseByteFunc: TPRBYTE): Tnint; NWLIB_LOCNLM32;
+ { Set up unmappable character handling }
+ { Handle to a Byte <-> Unicode converter }
+ { Function called for unmappable uni chars }
+ { Unicode scanning function }
+ { Unicode parsing function }
+function NWUXSetUniFunctions(byteUniHandle: TpCONVERT; noMapUniFunc: TNMUNI; scanUniFunc: TSCUNI; parseUniFunc: TPRUNI): Tnint; NWLIB_LOCNLM32;
+ { Set up unmappable unicode char handling }
+ { Handle to a Byte <-> Unicode converter }
+ { Function called for unmappable uni chars }
+ { Unicode scan function }
+ { Unicode parse function }
+function NWUXGetUniFunctions(byteUniHandle: TpCONVERT; var noMapUniFunc: TNMUNI; var scanUniFunc: TSCUNI; var parseUniFunc: TPRUNI): Tnint; NWLIB_LOCNLM32;
+ { Set up converter to use the NW OEM Euro }
+function NWUXEnableOemEuro(convert: TpCONVERT): Tnint; NWLIB_LOCNLM32;
+ { Reset a converter to default state }
+function NWUXResetConverter(convert: TpCONVERT): Tnint; NWLIB_LOCNLM32;
+ {************************************************************************** }
+ {
+ Table based Unicode/Local text conversion APIs. The converter based
+ APIs are preferred over these.
+ }
+function NWInitUnicodeTables(countryCode: Tnint; codePage: Tnint): Tnint; NWLIB_LOCNLM32;
+function NWLSetPrimaryUnicodeSearchPath(strSearchPath: Pnstr): longint; NWLIB_UNICODE;
+function NWFreeUnicodeTables: Tnint; NWLIB_LOCNLM32;
+function NWLoadRuleTable(ruleTableName: pnstr; ruleHandle: pnptr): Tnint; NWLIB_UNICODE;
+ { Rule table handle }
+function NWUnloadRuleTable(ruleHandle: Tnptr): Tnint; NWLIB_UNICODE;
+
+ { NWUSByteToUnicode or NWUXByteToUnicode are preferred }
+ { Convert local to Unicode }
+ { Rule table handle }
+ { Buffer for resulting Unicode }
+ { Size of results buffer }
+
+ { Buffer with source local code }
+ { No map character }
+ { Number of unicode chars in output }
+ { Flag indicating default map is allowable }
+
+function NWLocalToUnicode(ruleHandle: Tnptr; dest: punicode; maxLen: Tnuint32; src: pointer; noMap: Tunicode;
+ len: pnuint; allowNoMapFlag: Tnuint32): Tnint; NWLIB_LOCNLM32;
+ { NWUSUnicodeToByte or NWUXUnicodeToByte are preferred }
+ { Convert Unicode to local code }
+ { Rule table handle }
+ { Buffer for resulting local code }
+ { Size of results buffer }
+
+ { Buffer with source Unicode }
+ { No Map character }
+ { Number of bytes in output }
+ { Flag indicating default map is allowable }
+function NWUnicodeToLocal(ruleHandle: Tnptr; dest: Tnptr; maxLen: Tnuint32; src: Punicode; noMap: Tnuint8;
+ len: pnuint; allowNoMapFlag: Tnuint32): Tnint; NWLIB_LOCNLM32;
+
+ { was #define dname(params) para_def_expr }
+ //function NWLocalToUnicode(P1,P2,P3,P4,P5,P6 : longint) : longint;
+
+ { was #define dname(params) para_def_expr }
+ //function NWUnicodeToLocal(P1,P2,P3,P4,P5,P6 : longint) : longint;
+
+ { If I could make size_t be cardinal for N_PLAT_NLM all of the functions }
+ { below here could be single sourced. }
+{$IF 0}
+ { Convert Unicode to collation }
+ { Rule table handle }
+ { Buffer for resulting Unicode weights }
+ { Size of results buffer }
+
+ { Buffer with source Unicode }
+ { No map character }
+ { Number of unicode chars in output }
+
+function NWUnicodeToCollation(ruleHandle: Tnptr; dest: punicode; maxLen: Tnuint32; src: Punicode; noMap: Tunicode;
+ len: pnuint32): Tnint; NWLIB_LOCNLM32;
+ { Compare two unicode characters }
+ { Rule table handle }
+ { 1st character }
+ { 2nd character }
+function NWUnicodeCompare(ruleHandle: Tnptr; chr1: Tunicode; chr2: Tunicode): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to collation }
+ { Rule table handle }
+ { Buffer for resulting Unicode weights }
+ { Size of results buffer }
+
+ { Buffer with source Unicode }
+ { Number of unicode chars in output }
+function NWUnicodeToMonocase(ruleHandle: Tnptr; dest: punicode; maxLen: Tnuint32; src: Punicode; len: pnuint32): Tnint; NWLIB_LOCNLM32;
+{$ENDIF}
+
+ { not N_PLAT_NLM }
+ { NWUSByteToUnicode or NWUXByteToUnicode are preferred }
+ { Convert local to Unicode }
+ { Rule table handle }
+ { Buffer for resulting Unicode }
+ { Size of results buffer }
+
+ { Buffer with source local code }
+ { No map character }
+ { Number of unicode chars in output }
+
+function NWLocalToUnicode(ruleHandle: Tnptr; dest: punicode; maxLen: Tsize_t; src: Pnuint8; noMap: Tunicode;
+ len: Psize_t): Tnint; NWLIB_LOCNLM32;
+ { NWUSUnicodeToByte or NWUXUnicodeToByte are preferred }
+ { Convert Unicode to local code }
+ { Rule table handle }
+ { Buffer for resulting local code }
+ { Size of results buffer }
+
+ { Buffer with source Unicode }
+ { No Map character }
+ { Number of bytes in output }
+function NWUnicodeToLocal(ruleHandle: Tnptr; dest: pnuint8; maxLen: Tsize_t; src: Punicode; noMap: byte;
+ len: Psize_t): Tnint; NWLIB_LOCNLM32;
+
+ { not N_PLAT_NLM }
+ { Convert Unicode to collation }
+ { Rule table handle }
+ { Buffer for resulting Unicode weights }
+ { Size of results buffer }
+
+ { Buffer with source Unicode }
+ { No map character }
+ { Number of unicode chars in output }
+
+function NWUnicodeToCollation(ruleHandle: Tnptr; dest: punicode; maxLen: Tsize_t; src: Punicode; noMap: Tunicode;
+ len: Psize_t): Tnint; NWLIB_LOCNLM32;
+ { Compare two unicode characters }
+ { Rule table handle }
+ { 1st character }
+ { 2nd character }
+function NWUnicodeCompare(ruleHandle: Tnptr; chr1: Tunicode; chr2: Tunicode): Tnint; NWLIB_LOCNLM32;
+ { Convert Unicode to collation }
+ { Rule table handle }
+ { Buffer for resulting Unicode weights }
+ { Size of results buffer }
+
+ { Buffer with source Unicode }
+ { Number of unicode chars in output }
+function NWUnicodeToMonocase(ruleHandle: Tnptr; dest: punicode; maxLen: Tsize_t; src: Punicode; len: Psize_t): Tnint; NWLIB_LOCNLM32;
+ {
+ * Functions that work with XLate Tables
+ }
+{$IFDEF 0} // defined N_PLAT_DOS && defined N_UNI_NEW_TABLES}
+
+const
+ N_UNI_LOAD_MONOCASE = $0001;
+ N_UNI_LOAD_COLLATION = $0002;
+
+function NWLInitXlateTables(codePage: Tnint; flags: Tnflag8): Tnint; NWLIB_UNKNOWN;
+function NWLFreeXlateTables: Tnint; NWLIB_UNKNOWN;
+ { Name of the rule table }
+ { Where to put the rule table handle }
+function NWLLoadXlateTable(ruleTableName: pnstr; ruleHandle: pnptr): Tnint; NWLIB_UNKNOWN;
+
+ { Rule table handle }
+function NWLUnloadXlateTable(ruleHandle: pointer): Tnint; NWLIB_UNKNOWN;
+{function NWInitUnicodeTables(CountryCode,CodePage : longint) : longint;}
+
+
+const
+ NWFreeUnicodeTables = NWLFreeXlateTables;
+ NWLoadRuleTable = NWLLoadXlateTable;
+ NWUnloadRuleTable = NWLUnloadXlateTable;
+{$ENDIF}
+
+function NWGetUnicodeToLocalHandle(handle: pnptr): Tnint; NWLIB_LOCNLM32;
+function NWGetLocalToUnicodeHandle(handle: pnptr): Tnint; NWLIB_LOCNLM32;
+function NWGetMonocaseHandle(handle: pnptr): Tnint; NWLIB_LOCNLM32;
+function NWGetCollationHandle(handle: pnptr): Tnint; NWLIB_LOCNLM32;
+ {************************************************************************** }
+ {
+ Redefine these functions to use the new unicode API monocase routines.
+ }
+ { was #define dname(params) para_def_expr }
+ //function uniicmp(s1,s2 : longint) : longint;
+
+ { was #define dname(params) para_def_expr }
+ //function uninicmp(s1,s2,l : longint) : longint;
+
+ { Unicode string functions that work like those in string.h }
+ { Corresponds to strcat }
+ { Original string }
+
+ { String to be appended }
+
+function unicat(s1: punicode; s2: Punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strchr }
+
+ { String to be scanned }
+ { Character to be found }
+function unichr(s: Punicode; c: Tunicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strcpy }
+ { Destination string }
+
+ { Source string }
+function unicpy(s1: punicode; s2: Punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strcspn }
+
+ { String to be scanned }
+
+ { Character set }
+function unicspn(s1: Punicode; s2: Punicode): Tsize_t; NWLIB_LOCNLM32;
+ { Corresponds to strlen }
+
+ { String to determine length of }
+function unilen(s: Punicode): Tsize_t; NWLIB_LOCNLM32;
+ { Corresponds to strncat }
+ { Original string }
+
+ { String to be appended }
+ { Maximum characters to be appended }
+function unincat(s1: punicode; s2: Punicode; n: Tsize_t): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strncpy }
+ { Destination string }
+
+ { Source string }
+ { Maximum length }
+function unincpy(s1: punicode; s2: Punicode; n: Tsize_t): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strnset }
+ { String to be modified }
+ { Fill character }
+ { Maximum length }
+function uninset(s: punicode; c: Tunicode; n: Tsize_t): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strpbrk }
+
+ { String to be scanned }
+
+ { Character set }
+function unipbrk(s1: Punicode; s2: Punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strpcpy }
+ { Destination string }
+
+ { Source string }
+function unipcpy(s1: punicode; s2: Punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strrchr }
+
+ { String to be scanned }
+ { Character to be found }
+function unirchr(s: Punicode; c: Tunicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strrev }
+ { String to be reversed }
+function unirev(s: punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strset }
+ { String to modified }
+ { Fill character }
+function uniset(s: punicode; c: Tunicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strspn }
+
+ { String to be tested }
+
+ { Character set }
+function unispn(s1: Punicode; s2: Punicode): Tsize_t; NWLIB_LOCNLM32;
+ { Corresponds to strstr }
+
+ { String to be scanned }
+
+ { String to be located }
+function unistr(s1: Punicode; s2: Punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to strtok }
+ { String to be parsed }
+
+ { Delimiter values }
+function unitok(s1: punicode; s2: Punicode): punicode; NWLIB_LOCNLM32;
+ { Corresponds to stricmp }
+
+ { 1st string to be compared }
+
+ { 2nd string to be compared }
+function uniicmp(s1: Punicode; s2: Punicode): Tnint; NWLIB_LOCNLM32;
+ { Corresponds to strnicmp }
+
+ { 1st string to be compared }
+
+ { 2nd string to be compared }
+ { Maximum length }
+function uninicmp(s1: Punicode; s2: Punicode; len: Tsize_t): Tnint; NWLIB_LOCNLM32;
+ { Unicode compare }
+
+
+function unicmp(s1: Punicode; s2: Punicode): Tnint; NWLIB_LOCNLM32;
+ { Unicode length compare }
+
+
+function unincmp(s1: Punicode; s2: Punicode; len: Tsize_t): Tnint; NWLIB_LOCNLM32;
+ { Corresponds to sizeof }
+
+function unisize(s: Punicode): Tsize_t; NWLIB_LOCNLM32;
+ {
+ * UTF-8 <--> Unicode Conversion APIS
+ }
+
+function NWLUnicodeToUTF8(uniStr: Punicode; maxSize: Tnuint; utf8Str: pnuint8; utf8Size: pnuint): Tnint; NWLIB_LOCNLM32;
+
+function NWLUTF8ToUnicode(utf8Str: Pnuint8; maxSize: Tnuint; uniStr: punicode; uniSize: pnuint; badSequence: ppnstr): Tnint; NWLIB_LOCNLM32;
+
+function NWLUTF8ToUnicodeSize(utf8Str: Pnuint8; size: pnuint): Tnint; NWLIB_LOCNLM32;
+
+function NWLUnicodeToUTF8Size(uniStr: Punicode): Tnuint; NWLIB_LOCNLM32;
+
+
+//**************************************************************************
+// nwbindry.h
+//**************************************************************************
+
+ { Bindery object types (in HIGH-LOW order) }
+
+const
+ OT_WILD = $FFFF;
+ OT_UNKNOWN = $0000;
+ OT_USER = $0100;
+ OT_USER_GROUP = $0200;
+ OT_PRINT_QUEUE = $0300;
+ OT_FILE_SERVER = $0400;
+ OT_JOB_SERVER = $0500;
+ OT_GATEWAY = $0600;
+ OT_PRINT_SERVER = $0700;
+ OT_ARCHIVE_QUEUE = $0800;
+ OT_ARCHIVE_SERVER = $0900;
+ OT_JOB_QUEUE = $0A00;
+ OT_ADMINISTRATION = $0B00;
+ OT_NAS_SNA_GATEWAY = $2100;
+ OT_REMOTE_BRIDGE_SERVER = $2600;
+ OT_TCPIP_GATEWAY = $2700;
+ OT_TREE_NAME = $7802;
+ { Extended bindery object types }
+ OT_TIME_SYNCHRONIZATION_SERVER = $2D00;
+ OT_ARCHIVE_SERVER_DYNAMIC_SAP = $2E00;
+ OT_ADVERTISING_PRINT_SERVER = $4700;
+ OT_BTRIEVE_VAP = $5000;
+ OT_PRINT_QUEUE_USER = $5300;
+ { Bindery object and property flags }
+ BF_STATIC = $00;
+ BF_DYNAMIC = $01;
+ BF_ITEM = $00;
+ BF_SET = $02;
+ {******** Bindery object and property security access levels ********* }
+ BS_ANY_READ = $00; // Readable by anyone
+ BS_LOGGED_READ = $01; // Must be logged in to read
+ BS_OBJECT_READ = $02; // Readable by same object or super
+ BS_SUPER_READ = $03; // Readable by supervisor only
+ BS_BINDERY_READ = $04; // Readable only by the bindery
+ BS_ANY_WRITE = $00; // Writeable by anyone
+ BS_LOGGED_WRITE = $10; // Must be logged in to write
+ BS_OBJECT_WRITE = $20; // Writeable by same object or super
+ BS_SUPER_WRITE = $30; // Writeable only by the supervisor
+ BS_BINDERY_WRITE = $40; // Writeable by the bindery only
+
+
+
+function NWVerifyObjectPassword
+ (conn: TNWCONN_HANDLE;
+ objName: Pnstr8;
+ objType: Tnuint16;
+ password: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWDisallowObjectPassword(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; disallowedPassword: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+function NWChangeObjectPassword(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; oldPassword: Pnstr8; newPassword: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWReadPropertyValue(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; segmentNum: Tnuint8;
+ segmentData: pnuint8; moreSegments: pnuint8; flags: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+function NWWritePropertyValue(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; segmentNum: Tnuint8;
+ segmentData: Pnuint8; moreSegments: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+function NWAddObjectToSet(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; memberName: Pnstr8;
+ memberType: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWDeleteObjectFromSet(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; memberName: Pnstr8;
+ memberType: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+function NWIsObjectInSet(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; memberName: Pnstr8;
+ memberType: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWScanProperty(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; searchPropertyName: Pnstr8; iterHandle: pnuint32;
+ propertyName: Pnstr8; propertyFlags: pnuint8; propertySecurity: pnuint8; valueAvailable: pnuint8; moreFlag: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWGetObjectID(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; objID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectDiskSpaceLeft(conn: TNWCONN_HANDLE; objID: Tnuint32; systemElapsedTime: pnuint32; unusedDiskBlocks: pnuint32; restrictionEnforced: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectName(conn: TNWCONN_HANDLE; objID: Tnuint32; objName: Pnstr8; objType: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWScanObject(conn: TNWCONN_HANDLE; searchName: Pnstr8; searchType: Tnuint16; objID: pnuint32; objName: Pnstr8;
+ objType: pnuint16; hasPropertiesFlag: pnuint8; objFlags: pnuint8; objSecurity: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetBinderyAccessLevel(conn: TNWCONN_HANDLE; accessLevel: pnuint8; objID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWCreateProperty(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; propertyFlags: Tnuint8;
+ propertySecurity: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWDeleteProperty(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWChangePropertySecurity(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; propertyName: Pnstr8; newPropertySecurity: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWCreateObject(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; objFlags: Tnuint8; objSecurity: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWDeleteObject(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWRenameObject(conn: TNWCONN_HANDLE; oldObjName: Pnstr8; newObjName: Pnstr8; objType: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWChangeObjectSecurity(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; newObjSecurity: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenBindery(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseBindery(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWScanObjectTrusteePaths(conn: TNWCONN_HANDLE; objID: Tnuint32; volNum: Tnuint16; iterHandle: pnuint16; accessRights: pnuint8;
+ dirPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWScanObjectTrusteePathsExt(conn: TNWCONN_HANDLE; objID: Tnuint32; volNum: Tnuint16; iterHandle: pnuint16; accessRights: pnuint8;
+ dirPath1506: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+
+function NWGetObjectEffectiveRights(conn: TNWCONN_HANDLE; objID: Tnuint32; dirHandle: TNWDIR_HANDLE; path: Pnstr8; rightsMask: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWGetObjectEffectiveRightsExt(conn: TNWCONN_HANDLE; objID: Tnuint32; dirHandle: TNWDIR_HANDLE; path: Pnstr8; buNameSpace: Tnuint8;
+ rightsMask: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWGetObjectEffectiveRights2(conn: TNWCONN_HANDLE; objID: Tnuint32; dirHandle: TNWDIR_HANDLE; path: Pnstr8; rightsMask: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectNamesBeginA(luObjectType: Tnuint32; pluHandle: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectNamesNextA(luHandle: Tnuint32; pluLenBuffer: pnuint32; strBuffer: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectNamesEndA(luHandle: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectNamesBeginW(luObjectType: Tnuint32; pluHandle: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectNamesNextW(luHandle: Tnuint32; pluLenBuffer: pnuint32; strBuffer: punicode): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjectNamesEndW(luHandle: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwconnec.h
+//*****************************************************************************
+
+ { 3.11 and above only: 0=not in use, 2=NCP over IPX, 4=AFP }
+type
+ PtNWINET_ADDR = ^TtNWINET_ADDR;
+ TtNWINET_ADDR = record
+ networkAddr: array[0..3] of Tnuint8;
+ netNodeAddr: array[0..5] of Tnuint8;
+ socket: Tnuint16;
+ connType: Tnuint16;
+ end;
+ TNWINET_ADDR = TtNWINET_ADDR;
+ PNWINET_ADDR = ^TNWINET_ADDR;
+
+const
+ CONNECTION_AVAILABLE = $0001;
+ { obsolete }
+ CONNECTION_PRIVATE = $0002;
+ CONNECTION_LOGGED_IN = $0004;
+ CONNECTION_LICENSED = $0004;
+ CONNECTION_BROADCAST_AVAILABLE = $0008;
+ CONNECTION_ABORTED = $0010;
+ CONNECTION_REFUSE_GEN_BROADCAST = $0020;
+ CONNECTION_BROADCASTS_DISABLED = $0040;
+ CONNECTION_PRIMARY = $0080;
+ CONNECTION_NDS = $0100;
+ { obsolete }
+ CONNECTION_PNW = $4000;
+ CONNECTION_AUTHENTICATED = $8000;
+ { End of new connection model calls. }
+
+function NWLockConnection(connHandle: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetConnectionInformation(connHandle: TNWCONN_HANDLE; connNumber: Tnuint16; pObjName: Pnstr8; pObjType: pnuint16; pObjID: pnuint32;
+ pLoginTime: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetInternetAddress(connHandle: TNWCONN_HANDLE; connNumber: Tnuint16; pInetAddr: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetInetAddr(connHandle: TNWCONN_HANDLE; connNum: Tnuint16; pInetAddr: PNWINET_ADDR): TNWCCODE; NWLIB_CALNLM32;
+function NWClearConnectionNumber(connHandle: TNWCONN_HANDLE; connNumber: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDefaultConnRef(pConnReference: pnuint32): TNWCCODE; NWLIB_UNKNOWN;
+
+function NWGetObjectConnectionNumbers(connHandle: TNWCONN_HANDLE; pObjName: Pnstr8; objType: Tnuint16; pNumConns: pnuint16; pConnHandleList: pnuint16;
+ maxConns: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetConnListFromObject(connHandle: TNWCONN_HANDLE; objID: Tnuint32; searchConnNum: Tnuint32; pConnListLen: pnuint16; pConnList: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetPreferredServer(pConnHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_UNKNOWN;
+function NWSetPreferredServer(connHandle: TNWCONN_HANDLE): TNWCCODE; NWLIB_UNKNOWN;
+
+ { The NLM LibC x-plat libraries do not support obsolete apis }
+
+//*****************************************************************************
+// nwdel.h
+//*****************************************************************************
+
+type
+
+ PNWDELETED_INFO = ^TNWDELETED_INFO;
+ TNWDELETED_INFO = record
+ sequence: Tnuint32;
+ parent: Tnuint32;
+ attributes: Tnuint32;
+ uniqueID: Tnuint8;
+ flags: Tnuint8;
+ nameSpace: Tnuint8;
+ nameLength: Tnuint8;
+ name: array[0..255] of Tnuint8;
+ creationDateAndTime: Tnuint32;
+ ownerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ lastArchiverID: Tnuint32;
+ updateDateAndTime: Tnuint32;
+ updatorID: Tnuint32;
+ fileSize: Tnuint32;
+ reserved: array[0..43] of Tnuint8;
+ inheritedRightsMask: Tnuint16;
+ lastAccessDate: Tnuint16;
+ deletedTime: Tnuint32;
+ deletedDateAndTime: Tnuint32;
+ deletorID: Tnuint32;
+ reserved3: array[0..15] of Tnuint8;
+ end;
+
+ PNWDELETED_INFO_EXT = ^TNWDELETED_INFO_EXT;
+ TNWDELETED_INFO_EXT = record
+ sequence: Tnuint32;
+ parent: Tnuint32;
+ attributes: Tnuint32;
+ uniqueID: Tnuint8;
+ flags: Tnuint8;
+ nameSpace: Tnuint8;
+ nameLength: Tnuint16;
+ name: array[0..765] of Tnuint8;
+ creationDateAndTime: Tnuint32;
+ ownerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ lastArchiverID: Tnuint32;
+ updateDateAndTime: Tnuint32;
+ updatorID: Tnuint32;
+ fileSize: Tnuint32;
+ reserved: array[0..43] of Tnuint8;
+ inheritedRightsMask: Tnuint16;
+ lastAccessDate: Tnuint16;
+ deletedTime: Tnuint32;
+ deletedDateAndTime: Tnuint32;
+ deletorID: Tnuint32;
+ reserved3: array[0..15] of Tnuint8;
+ end;
+
+
+function NWPurgeDeletedFile(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; iterHandle: Tnuint32; volNum: Tnuint32; dirBase: Tnuint32;
+ fileName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWRecoverDeletedFile(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; iterHandle: Tnuint32; volNum: Tnuint32; dirBase: Tnuint32;
+ delFileName: Pnstr8; rcvrFileName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWRecoverDeletedFileExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; iterHandle: Tnuint32; volNum: Tnuint32; dirBase: Tnuint32;
+ delFileName: Pnstr8; rcvrFileName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWScanForDeletedFiles(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; iterHandle: pnuint32; volNum: pnuint32; dirBase: pnuint32;
+ entryInfo: PNWDELETED_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWScanForDeletedFilesExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; iterHandle: pnuint32; volNum: pnuint32; dirBase: pnuint32;
+ entryInfo: PNWDELETED_INFO_EXT): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwdentry.h
+//*****************************************************************************
+
+type
+ PTRUSTEE_INFO = ^TTRUSTEE_INFO;
+ TTRUSTEE_INFO = record
+ objectID: Tnuint32;
+ objectRights: Tnuint16;
+ end;
+
+ PNW_LIMIT_LIST = ^TNW_LIMIT_LIST;
+ TNW_LIMIT_LIST = record
+ numEntries: Tnuint8;
+ list: array[0..101] of record
+ level: Tnuint8;
+ max: Tnuint32;
+ current: Tnuint32;
+ end;
+ end;
+
+
+ PNWET_INFO = ^TNWET_INFO;
+ TNWET_INFO = record
+ entryName: array[0..15] of Tnstr8;
+ creationDateAndTime: Tnuint32;
+ ownerID: Tnuint32;
+ sequenceNumber: Tnuint32;
+ trusteeList: array[0..19] of TTRUSTEE_INFO;
+ end;
+
+ PNWET_INFO_EXT = ^TNWET_INFO_EXT;
+ TNWET_INFO_EXT = record
+ entryName: array[0..15] of Tnstr8;
+ creationDateAndTime: Tnuint32;
+ ownerID: Tnuint32;
+ sequenceNumber: Tnuint32;
+ trusteeList: array[0..99] of TTRUSTEE_INFO;
+ end;
+
+ PNWFILE_INFO = ^TNWFILE_INFO;
+ TNWFILE_INFO = record
+ updateDateAndTime: Tnuint32;
+ updatorID: Tnuint32;
+ fileSize: Tnuint32;
+ reserved: array[0..43] of Tnuint8;
+ inheritedRightsMask: Tnuint16;
+ lastAccessDate: Tnuint16;
+ reserved2: array[0..27] of Tnuint8;
+ end;
+
+ PNWDIR_INFO = ^TNWDIR_INFO;
+ TNWDIR_INFO = record
+ lastModifyDateAndTime: Tnuint32;
+ nextTrusteeEntry: Tnuint32;
+ reserved: array[0..47] of Tnuint8;
+ maximumSpace: Tnuint32;
+ inheritedRightsMask: Tnuint16;
+ reserved2: array[0..13] of Tnuint8;
+ volObjectID: Tnuint32;
+ reserved3: array[0..7] of Tnuint8;
+ end;
+
+ PNWENTRY_INFO = ^TNWENTRY_INFO;
+ TNWENTRY_INFO = record
+ sequence: Tnuint32;
+ parent: Tnuint32;
+ attributes: Tnuint32;
+ uniqueID: Tnuint8;
+ flags: Tnuint8;
+ nameSpace: Tnuint8;
+ nameLength: Tnuint8;
+ name: array[0..11] of Tnuint8;
+ creationDateAndTime: Tnuint32;
+ ownerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ lastArchiverID: Tnuint32;
+ info: record
+ case longint of
+ 0: (_file: TNWFILE_INFO);
+ 1: (dir: TNWDIR_INFO);
+ end;
+ end;
+ { file size }
+
+ PNW_EXT_FILE_INFO = ^TNW_EXT_FILE_INFO;
+ TNW_EXT_FILE_INFO = record
+ sequence: Tnuint32;
+ parent: Tnuint32;
+ attributes: Tnuint32;
+ uniqueID: Tnuint8;
+ flags: Tnuint8;
+ nameSpace: Tnuint8;
+ nameLength: Tnuint8;
+ name: array[0..11] of Tnuint8;
+ creationDateAndTime: Tnuint32;
+ ownerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ lastArchiverID: Tnuint32;
+ updateDateAndTime: Tnuint32;
+ lastUpdatorID: Tnuint32;
+ dataForkSize: Tnuint32;
+ dataForkFirstFAT: Tnuint32;
+ nextTrusteeEntry: Tnuint32;
+ reserved: array[0..35] of Tnuint8;
+ inheritedRightsMask: Tnuint16;
+ lastAccessDate: Tnuint16;
+ deletedFileTime: Tnuint32;
+ deletedDateAndTime: Tnuint32;
+ deletorID: Tnuint32;
+ reserved2: array[0..15] of Tnuint8;
+ otherForkSize: array[0..1] of Tnuint32;
+ end;
+
+const
+ TR_NONE = $0000;
+ TR_READ = $0001;
+ TR_WRITE = $0002;
+ TR_OPEN = $0004;
+ TR_DIRECTORY = $0004;
+ TR_CREATE = $0008;
+ TR_DELETE = $0010;
+ TR_ERASE = $0010;
+ TR_OWNERSHIP = $0020;
+ TR_ACCESS_CTRL = $0020;
+ TR_FILE_SCAN = $0040;
+ TR_SEARCH = $0040;
+ TR_FILE_ACCESS = $0040;
+ TR_MODIFY = $0080;
+ TR_ALL = $01FB;
+ TR_SUPERVISOR = $0100;
+ TR_NORMAL = $00FB;
+
+ MModifyNameBit = $0001;
+ MFileAttributesBit = $0002;
+ MCreateDateBit = $0004;
+ MCreateTimeBit = $0008;
+ MOwnerIDBit = $0010;
+ MLastArchivedDateBit = $0020;
+ MLastArchivedTimeBit = $0040;
+ MLastArchivedIDBit = $0080;
+ MLastUpdatedDateBit = $0100;
+ MLastUpdatedTimeBit = $0200;
+ MLastUpdatedIDBit = $0400;
+ MLastAccessedDateBit = $0800;
+ MInheritedRightsMaskBit = $1000;
+ MMaximumSpaceBit = $2000;
+
+
+function NWDeleteTrustee(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; objID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWDeleteTrusteeExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; objID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWAddTrustee(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; objID: Tnuint32; rightsMask: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWAddTrusteeExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; objID: Tnuint32; rightsMask: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWIntScanDirEntryInfo(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; attrs: Tnuint16; iterHandle: pnuint32; searchPattern: Pnuint8;
+ entryInfo: PNWENTRY_INFO; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+ { was #define dname(params) para_def_expr }
+ // function NWScanForTrustees(a,b,c,d,e,f : longint) : longint;
+
+
+function NWIntScanForTrustees(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; iterHandle: pnuint32; numOfEntries: pnuint16;
+ entryTrusteeInfo: PNWET_INFO; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+ { was #define dname(params) para_def_expr }
+ //function NWScanForTrusteesExt(a,b,c,d,e,f : longint) : longint;
+
+
+function NWIntScanForTrusteesExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; iterHandle: pnuint32; numOfEntries: pnuint16;
+ entryTrusteeInfo: PNWET_INFO_EXT; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWIntMoveDirEntry(conn: TNWCONN_HANDLE; searchAttrs: Tnuint8; srcDirHandle: TNWDIR_HANDLE; srcPath: Pnstr8; dstDirHandle: TNWDIR_HANDLE;
+ dstPath: Pnstr8; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWSetDirEntryInfo(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; searchAttrs: Tnuint8; iterHandle: Tnuint32; changeBits: Tnuint32;
+ newEntryInfo: PNWENTRY_INFO): TNWCCODE; NWLIB_CALNLM32;
+
+function NWIntScanExtendedInfo(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; attrs: Tnuint8; iterHandle: pnuint32; searchPattern: Pnstr8;
+ entryInfo: PNW_EXT_FILE_INFO; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWGetEffectiveRights(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; effectiveRights: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetEffectiveRightsExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; effectiveRights: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwdirect.h
+//*****************************************************************************
+
+ { set to zero if a dirHandle is present }
+ {....when the NWGetDIrSpaceInfo() is called }
+type
+
+ PDIR_SPACE_INFO = ^TDIR_SPACE_INFO;
+ TDIR_SPACE_INFO = record
+ totalBlocks: Tnuint32;
+ availableBlocks: Tnuint32;
+ purgeableBlocks: Tnuint32;
+ notYetPurgeableBlocks: Tnuint32;
+ totalDirEntries: Tnuint32;
+ availableDirEntries: Tnuint32;
+ reserved: Tnuint32;
+ sectorsPerBlock: Tnuint8;
+ volLen: Tnuint8;
+ volName: array[0..(NW_MAX_VOLUME_NAME_LEN) - 1] of Tnuint8;
+ end;
+ { Trustee Access Rights in a network directory }
+ { NOTE: TA_OPEN is obsolete in 3.x }
+
+const
+ TA_NONE = $00;
+ TA_READ = $01;
+ TA_WRITE = $02;
+ TA_OPEN = $04;
+ TA_CREATE = $08;
+ TA_DELETE = $10;
+ TA_OWNERSHIP = $20;
+ TA_SEARCH = $40;
+ TA_MODIFY = $80;
+ TA_ALL = $FB;
+
+
+function NWAddTrusteeToDirectory(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; trusteeID: Tnuint32; rightsMask: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWDeleteTrusteeFromDirectory(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; objID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetEffectiveDirectoryRights(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; rightsMask: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWModifyMaximumRightsMask(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; revokeRightsMask: Tnuint8; grantRightsMask: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWScanDirectoryForTrustees(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; searchPath: Pnstr8; iterHandle: pnuint16; dirName: Pnstr8;
+ dirDateTime: pnuint32; ownerID: pnuint32; trusteeIDs: pnuint32; trusteeRights: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWScanDirectoryForTrustees2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; searchPath: Pnstr8; iterHandle: pnuint32; dirName: Pnstr8;
+ dirDateTime: pnuint32; ownerID: pnuint32; trusteeList: PTRUSTEE_INFO): TNWCCODE; NWLIB_CALNLM32;
+ { was #define dname(params) para_def_expr }
+ // function NWScanDirectoryInformation(a,b,c,d,e,f,g,h : longint) : longint;
+
+
+function NWIntScanDirectoryInformation(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; searchPath: Pnstr8; iterHandle: pnuint16; dirName: Pnstr8;
+ dirDateTime: pnuint32; ownerID: pnuint32; rightsMask: pnuint8; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWIntScanDirectoryInformation2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; searchPath: Pnstr8; sequence: pnuint8; dirName: Pnstr8;
+ dirDateTime: pnuint32; ownerID: pnuint32; rightsMask: pnuint8; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWSetDirectoryInformation(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; dirDateTime: Tnuint32; ownerID: Tnuint32;
+ rightsMask: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWAllocPermanentDirectoryHandle(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; newDirHandle: PNWDIR_HANDLE; effectiveRights: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWAllocTemporaryDirectoryHandle(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; newDirHandle: PNWDIR_HANDLE; rightsMask: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWDeallocateDirectoryHandle(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWSetDirectoryHandlePath(conn: TNWCONN_HANDLE; sourceDirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; destDirHandle: TNWDIR_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirectoryHandlePath(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWCreateDirectory(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; accessMask: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWDeleteDirectory(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWRenameDirectory(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; oldName: Pnstr8; newName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetDirSpaceLimit(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; spaceLimit: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirSpaceLimitList(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; returnBuf: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirSpaceLimitList2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; limitList: PNW_LIMIT_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirSpaceInfo(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; volNum: Tnuint16; spaceInfo: PDIR_SPACE_INFO): TNWCCODE; NWLIB_CALNLM32;
+
+const
+ TF_NORMAL = $0000;
+ TF_READ_ONLY = $0001;
+ TF_HIDDEN = $0002;
+ TF_SYSTEM = $0004;
+ TF_EXECUTE_ONLY = $0008;
+ TF_DIRECTORY = $0010;
+ TF_NEEDS_ARCHIVED = $0020;
+ TF_EXECUTE_CONFIRM = $0040;
+ TF_SHAREABLE = $0080;
+ TF_LOW_SEARCH_BIT = $0100;
+ TF_MID_SEARCH_BIT = $0200;
+ TF_HI_SEARCH_BIT = $0400;
+ TF_PRIVATE = $0800;
+ TF_TRANSACTIONAL = $1000;
+ TF_INDEXED = $2000;
+ TF_READ_AUDIT = $4000;
+ TF_WRITE_AUDIT = $8000;
+ TF_PURGE = $10000;
+ TF_RENAME_INHIBIT = $20000;
+ TF_DELETE_INHIBIT = $40000;
+ TF_COPY_INHIBIT = $80000;
+ TF_AUDITING_BIT = $00100000;
+ { DIRECTORY ATTRIBUTES }
+
+ TD_HIDDEN = TF_HIDDEN;
+ TD_SYSTEM = TF_SYSTEM;
+ TD_PURGE = TF_PURGE;
+ TD_PRIVATE = TF_PRIVATE;
+ TD_VISIBLE = TF_PRIVATE;
+ TD_RENAME_INHIBIT = TF_RENAME_INHIBIT;
+ TD_DELETE_INHIBIT = TF_DELETE_INHIBIT;
+
+
+//*****************************************************************************
+//nwdpath.h
+//*****************************************************************************
+
+
+const
+ NW_UNMAPPED_DRIVE = $0000;
+ NW_FREE_DRIVE = $0000;
+ NW_CDROM_DRIVE = $0400;
+ NW_LOCAL_FREE_DRIVE = $0800;
+ NW_LOCAL_DRIVE = $1000;
+ NW_NETWORK_DRIVE = $2000;
+ NW_LITE_DRIVE = $4000;
+ NW_PNW_DRIVE = $4000;
+ NW_NETWARE_DRIVE = $8000;
+ { return error for NWGetDriveStatus }
+ NW_INVALID_DRIVE = 15;
+ { defined for pathFormat parameter in NWGetDriveStatus }
+ NW_FORMAT_NETWARE = 0;
+ NW_FORMAT_SERVER_VOLUME = 1;
+ NW_FORMAT_DRIVE = 2;
+ NW_FORMAT_UNC = 3;
+
+
+function NWSetDriveBase(driveNum: Tnuint16; conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; driveScope: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWSetInitDrive(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWSetSearchDriveVector(vectorBuffer: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetSearchDriveVector(vectorBuffer: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+function NWDeleteDriveBase(driveNum: Tnuint16; driveScope: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+ { 3.x & 4.x file servers }
+function NWGetPathFromDirectoryBase(conn: TNWCONN_HANDLE; volNum: Tnuint8; dirBase: Tnuint32; namSpc: Tnuint8; len: pnuint8;
+ pathName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+ { 2.x file servers only }
+function NWGetPathFromDirectoryEntry(conn: TNWCONN_HANDLE; volNum: Tnuint8; dirEntry: Tnuint16; len: pnuint8; pathName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDrivePathConnRef(driveNum: Tnuint16; mode: Tnuint16; connRef: pnuint32; basePath: Pnstr8; driveScope: pnuint16): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetDrivePath(driveNum: Tnuint16; mode: Tnuint16; conn: PNWCONN_HANDLE; basePath: Pnstr8; driveScope: pnuint16): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetDriveInformation(driveNum: Tnuint16; mode: Tnuint16; conn: PNWCONN_HANDLE; dirHandle: PNWDIR_HANDLE; driveScope: pnuint16;
+ dirPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDriveInfoConnRef(driveNum: Tnuint16; mode: Tnuint16; connRef: pnuint32; dirHandle: PNWDIR_HANDLE; driveScope: pnuint16;
+ dirPath: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetDriveStatus(driveNum: Tnuint16; pathFormat: Tnuint16; status: pnuint16; conn: PNWCONN_HANDLE; rootPath: Pnstr8;
+ relPath: Pnstr8; fullPath: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetDriveStatusConnRef(driveNum: Tnuint16; pathFormat: Tnuint16; status: pnuint16; connRef: pnuint32; rootPath: Pnstr8;
+ relPath: Pnstr8; fullPath: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetFirstDrive(firstDrive: pnuint16): TNWCCODE; NWLIB_UNKNOWN;
+function NWParseNetWarePath(path: Pnstr8; conn: PNWCONN_HANDLE; dirHandle: PNWDIR_HANDLE; newPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWParseNetWarePathConnRef(path: Pnstr8; connRef: pnuint32; dirHandle: PNWDIR_HANDLE; newPath: Pnstr8): TNWCCODE; NWLIB_UNKNOWN;
+function NWParsePathConnRef(path: Pnstr8; serverName: Pnstr8; connRef: pnuint32; volName: Pnstr8; dirPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWParsePath(path: Pnstr8; serverName: Pnstr8; conn: PNWCONN_HANDLE; volName: Pnstr8; dirPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWStripServerOffPath(path: Pnstr8; server: Pnstr8): Pnstr8; NWLIB_CALNLM32;
+function NWCreateUNCPath(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; UNCPath: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwea.h
+//*****************************************************************************
+
+
+const
+ EA_EOF = 1;
+ EA_DONE = 1;
+ EA_READWRITE = 0;
+ EA_CREATE = 1;
+ { 0xC8 }
+ MISSING_EA_KEY = 200;
+ { 0xC9 }
+ EA_NOT_FOUND = 201;
+ { 0xCA }
+ INVALID_EA_HANDLE_TYPE = 202;
+ { 0xCB }
+ EA_NO_KEY_NO_DATA = 203;
+ { 0xCC }
+ EA_NUMBER_MISMATCH = 204;
+ { 0xCD }
+ EXTENT_NUMBER_OUT_OF_RANGE = 205;
+ { 0xCE }
+ EA_BAD_DIR_NUM = 206;
+ { 0xCF }
+ INVALID_EA_HANDLE = 207;
+ { 0xD0 }
+ EA_POSITION_OUT_OF_RANGE = 208;
+ { 0xD1 }
+ EA_ACCESS_DENIED = 209;
+ { 0xD2 }
+ DATA_PAGE_ODD_SIZE = 210;
+ { 0xD3 }
+ EA_VOLUME_NOT_MOUNTED = 211;
+ { 0xD4 }
+ BAD_PAGE_BOUNDARY = 212;
+ { 0xD5 }
+ INSPECT_FAILURE = 213;
+ { 0xD6 }
+ EA_ALREADY_CLAIMED = 214;
+ { 0xD7 }
+ ODD_BUFFER_SIZE = 215;
+ { 0xD8 }
+ NO_SCORECARDS = 216;
+ { 0xD9 }
+ BAD_EDS_SIGNATURE = 217;
+ { 0xDA }
+ EA_SPACE_LIMIT = 218;
+ { 0xDB }
+ EA_KEY_CORRUPT = 219;
+ { 0xDC }
+ EA_KEY_LIMIT = 220;
+ { 0xDD }
+ TALLY_CORRUPT = 221;
+
+
+type
+ PNW_EA_HANDLE = ^TNW_EA_HANDLE;
+ TNW_EA_HANDLE = record
+ connID: TNWCONN_HANDLE;
+ rwPosition: Tnuint32;
+ EAHandle: Tnuint32;
+ volNumber: Tnuint32;
+ dirBase: Tnuint32;
+ keyUsed: Tnuint8;
+ keyLength: Tnuint16;
+ key: array[0..255] of Tnuint8;
+ end;
+
+ PNW_EA_HANDLE_EXT = ^TNW_EA_HANDLE_EXT;
+ TNW_EA_HANDLE_EXT = record
+ connID: TNWCONN_HANDLE;
+ rwPosition: Tnuint32;
+ EAHandle: Tnuint32;
+ volNumber: Tnuint32;
+ dirBase: Tnuint32;
+ keyUsed: Tnuint8;
+ keyLength: Tnuint16;
+ key: array[0..765] of Tnuint8;
+ end;
+
+ PNW_EA_FF_STRUCT = ^TNW_EA_FF_STRUCT;
+ TNW_EA_FF_STRUCT = record
+ connID: TNWCONN_HANDLE;
+ nextKeyOffset: Tnuint16;
+ nextKey: Tnuint16;
+ numKeysRead: Tnuint32;
+ totalKeys: Tnuint32;
+ EAHandle: Tnuint32;
+ sequence: Tnuint16;
+ numKeysInBuffer: Tnuint16;
+ enumBuffer: array[0..511] of Tnuint8;
+ end;
+
+ PNW_EA_FF_STRUCT_EXT = ^TNW_EA_FF_STRUCT_EXT;
+ TNW_EA_FF_STRUCT_EXT = record
+ connID: TNWCONN_HANDLE;
+ nextKeyOffset: Tnuint16;
+ nextKey: Tnuint16;
+ numKeysRead: Tnuint32;
+ totalKeys: Tnuint32;
+ EAHandle: Tnuint32;
+ sequence: Tnuint16;
+ numKeysInBuffer: Tnuint16;
+ enumBuffer: array[0..1529] of Tnuint8;
+ end;
+
+ PNW_IDX = ^TNW_IDX;
+ TNW_IDX = record
+ volNumber: Tnuint8;
+ srcNameSpace: Tnuint8;
+ srcDirBase: Tnuint32;
+ dstNameSpace: Tnuint8;
+ dstDirBase: Tnuint32;
+ end;
+
+
+
+
+function NWCloseEA(EAHandle: PNW_EA_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseEAExt(EAHandle: PNW_EA_HANDLE_EXT): TNWCCODE; NWLIB_CALNLM32;
+function NWFindFirstEA(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; ffStruct: PNW_EA_FF_STRUCT; EAHandle: PNW_EA_HANDLE; EAName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWFindFirstEAExt(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; ffStruct: PNW_EA_FF_STRUCT_EXT; EAHandle: PNW_EA_HANDLE_EXT; EAName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWFindNextEA(ffStruct: PNW_EA_FF_STRUCT; EAHandle: PNW_EA_HANDLE; EAName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWFindNextEAExt(ffStruct: PNW_EA_FF_STRUCT_EXT; EAHandle: PNW_EA_HANDLE_EXT; EAName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWReadEA(EAHandle: PNW_EA_HANDLE; bufferSize: Tnuint32; buffer: pnuint8; totalEASize: pnuint32; amountRead: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWReadEAExt(EAHandle: PNW_EA_HANDLE_EXT; bufferSize: Tnuint32; buffer: pnuint8; totalEASize: pnuint32; amountRead: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWWriteEA(EAHandle: PNW_EA_HANDLE; totalWriteSize: Tnuint32; bufferSize: Tnuint32; buffer: Pnuint8; amountWritten: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWWriteEAExt(EAHandle: PNW_EA_HANDLE_EXT; totalWriteSize: Tnuint32; bufferSize: Tnuint32; buffer: Pnuint8; amountWritten: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetEAHandleStruct(conn: TNWCONN_HANDLE; EAName: Pnstr8; idxStruct: PNW_IDX; EAHandle: PNW_EA_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetEAHandleStructExt(conn: TNWCONN_HANDLE; EAName: Pnstr8; idxStruct: PNW_IDX; EAHandle: PNW_EA_HANDLE_EXT): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenEA(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; EAName: Pnstr8; nameSpace: Tnuint8;
+ EAHandle: PNW_EA_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+
+function NWOpenEAExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; EAName: Pnstr8; nameSpace: Tnuint8;
+ EAHandle: PNW_EA_HANDLE_EXT): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+const
+ SUCCESS = 0;
+ { Network errors }
+ { Decimal values at end of line are 32768 lower than actual }
+ SHELL_ERROR = $8800;
+ VLM_ERROR = $8800;
+ ALREADY_ATTACHED = $8800; { 0 - Attach attempted to server with valid, existing connection }
+ INVALID_CONNECTION = $8801; { 1 - Request attempted with invalid or non-attached connection handle }
+ DRIVE_IN_USE = $8802; { 2 - OS/2 only (NOT USED) }
+ CANT_ADD_CDS = $8803; { 3 - Map drive attempted but unable to add new current directory structure }
+ DRIVE_CANNOT_MAP = $8803;
+ BAD_DRIVE_BASE = $8804; { 4 - Map drive attempted with invalid path specification }
+ NET_READ_ERROR = $8805; { 5 - Attempt to receive from the selected transport failed }
+ NET_RECV_ERROR = $8805;
+ UNKNOWN_NET_ERROR = $8806; { 6 - Network send attempted with an un-specific network error }
+ SERVER_INVALID_SLOT = $8807; { 7 - Server request attempted with invalid server connection slot }
+ BAD_SERVER_SLOT = $8807;
+ NO_SERVER_SLOTS = $8808; { 8 - Attach attempted to server with no connection slots available }
+ NET_WRITE_ERROR = $8809; { 9 - Attempt to send on the selected transport failed }
+ CONNECTION_IN_ERROR_STATE = $8809; { Client-32 }
+ NET_SEND_ERROR = $8809;
+ SERVER_NO_ROUTE = $880A; { 10 - Attempted to find route to server where no route exists }
+ BAD_LOCAL_TARGET = $880B; { 11 - OS/2 only }
+ TOO_MANY_REQ_FRAGS = $880C; { 12 - Attempted request with too many request fragments specified }
+ CONNECT_LIST_OVERFLOW = $880D;
+ BUFFER_OVERFLOW = $880E; { 14 - Attempt to receive more data than the reply buffer had room for }
+ MORE_DATA_ERROR = $880E; { Client-32 }
+ NO_CONN_TO_SERVER = $880F;
+ NO_CONNECTION_TO_SERVER = $880F; { 15 - Attempt to get connection for a server not connected }
+ NO_ROUTER_FOUND = $8810; { 16 - OS/2 only }
+ BAD_FUNC_ERROR = $8811;
+ INVALID_SHELL_CALL = $8811; { 17 - Attempted function call to non- existent or illegal function }
+ SCAN_COMPLETE = $8812;
+ LIP_RESIZE_ERROR = $8812; { Client-32 }
+ UNSUPPORTED_NAME_FORMAT_TYPE = $8813;
+ INVALID_DIR_HANDLE = $8813; { Client-32 }
+ HANDLE_ALREADY_LICENSED = $8814;
+ OUT_OF_CLIENT_MEMORY = $8814; { Client-32 }
+ HANDLE_ALREADY_UNLICENSED = $8815;
+ PATH_NOT_OURS = $8815; { Client-32 }
+ INVALID_NCP_PACKET_LENGTH = $8816;
+ PATH_IS_PRINT_DEVICE = $8816; { Client-32 }
+ SETTING_UP_TIMEOUT = $8817;
+ PATH_IS_EXCLUDED_DEVICE = $8817; { Client-32 }
+ SETTING_SIGNALS = $8818;
+ PATH_IS_INVALID = $8818; { Client-32 }
+ SERVER_CONNECTION_LOST = $8819;
+ NOT_SAME_DEVICE = $8819; { Client-32 }
+ OUT_OF_HEAP_SPACE = $881A;
+ INVALID_SERVICE_REQUEST = $881B;
+ INVALID_SEARCH_HANDLE = $881B; { Client-32 }
+ INVALID_TASK_NUMBER = $881C;
+ INVALID_DEVICE_HANDLE = $881C; { Client-32 }
+ INVALID_MESSAGE_LENGTH = $881D;
+ INVALID_SEM_HANDLE = $881D; { Client-32 }
+ EA_SCAN_DONE = $881E;
+ INVALID_CFG_HANDLE = $881E; { Client-32 }
+ BAD_CONNECTION_NUMBER = $881F;
+ INVALID_MOD_HANDLE = $881F; { Client-32 }
+ ASYN_FIRST_PASS = $8820;
+ INVALID_DEVICE_INDEX = $8821;
+ INVALID_CONN_HANDLE = $8822;
+ INVALID_QUEUE_ID = $8823;
+ INVALID_PDEVICE_HANDLE = $8824;
+ INVALID_JOB_HANDLE = $8825;
+ INVALID_ELEMENT_ID = $8826;
+ ALIAS_NOT_FOUND = $8827;
+ RESOURCE_SUSPENDED = $8828;
+ INVALID_QUEUE_SPECIFIED = $8829;
+ DEVICE_ALREADY_OPEN = $882A;
+ JOB_ALREADY_OPEN = $882B;
+ QUEUE_NAME_ID_MISMATCH = $882C;
+ JOB_ALREADY_STARTED = $882D;
+ SPECT_DAA_TYPE_NOT_SUPPORTED = $882E;
+ INVALID_ENVIR_HANDLE = $882F;
+ NOT_SAME_CONNECTION = $8830; { 48 - Internal server request attempted accross different server connections }
+ PRIMARY_CONNECTION_NOT_SET = $8831; { 49 - Attempt to retrieve default connection with no primary connection set }
+ NO_PRIMARY_SET = $8831;
+ KEYWORD_NOT_FOUND = $8832; { Client-32 }
+ PRINT_CAPTURE_NOT_IN_PROGRESS = $8832; { Client-32 }
+ NO_CAPTURE_SET = $8832;
+ NO_CAPTURE_IN_PROGRESS = $8832; { 50 - Capture information requested on port with no capture in progress }
+ BAD_BUFFER_LENGTH = $8833;
+ INVALID_BUFFER_LENGTH = $8833; { 51 - Used to indicate length which caller requested on a GetDNC or SetDNC was too large }
+ NO_USER_NAME = $8834;
+ NO_NETWARE_PRINT_SPOOLER = $8835; { 53 - Capture requested without having the local print spooler installed }
+ INVALID_PARAMETER = $8836; { 54 - Attempted function with an invalid function parameter specified }
+ CONFIG_FILE_OPEN_FAILED = $8837; { 55 - OS/2 only }
+ NO_CONFIG_FILE = $8838; { 56 - OS/2 only }
+ CONFIG_FILE_READ_FAILED = $8839; { 57 - OS/2 only }
+ CONFIG_LINE_TOO_LONG = $883A; { 58 - OS/2 only }
+ CONFIG_LINES_IGNORED = $883B; { 59 - OS/2 only }
+ NOT_MY_RESOURCE = $883C; { 60 - Attempted request made with a parameter using foriegn resource }
+ DAEMON_INSTALLED = $883D; { 61 - OS/2 only }
+ SPOOLER_INSTALLED = $883E; { 62 - Attempted load of print spooler with print spooler already installed }
+ CONN_TABLE_FULL = $883F;
+ CONNECTION_TABLE_FULL = $883F; { 63 - Attempted to allocate a connection handle with no more local connection table entries }
+ CONFIG_SECTION_NOT_FOUND = $8840; { 64 - OS/2 only }
+ BAD_TRAN_TYPE = $8841;
+ INVALID_TRANSPORT_TYPE = $8841; { 65 - Attempted function on a connection with an invalid transport selected }
+ TDS_TAG_IN_USE = $8842; { 66 - OS/2 only }
+ TDS_OUT_OF_MEMORY = $8843; { 67 - OS/2 only }
+ TDS_INVALID_TAG = $8844; { 68 - Attempted TDS function with invalid tag }
+ TDS_WRITE_TRUNCATED = $8845; { 69 - Attempted TDS write with buffer that exceeded buffer }
+ NO_CONNECTION_TO_DS = $8846; { Client-32 }
+ NO_DIRECTORY_SERVICE_CONNECTION = $8846;
+ SERVICE_BUSY = $8846; { 70 - Attempted request made to partially asynchronous function in busy state }
+ NO_SERVER_ERROR = $8847; { 71 - Attempted connect failed to find any servers responding }
+ BAD_VLM_ERROR = $8848; { 72 - Attempted function call to non-existant or not-loaded overlay }
+ NETWORK_DRIVE_IN_USE = $8849; { 73 - Attempted map to network drive that was already mapped }
+ LOCAL_DRIVE_IN_USE = $884A; { 74 - Attempted map to local drive that was in use }
+ NO_DRIVES_AVAILABLE = $884B; { 75 - Attempted map to next available drive when none were available }
+ DEVICE_NOT_REDIRECTED = $884C; { 76 - The device is not redirected }
+ NO_MORE_SFT_ENTRIES = $884D; { 77 - Maximum number of files was reached }
+ UNLOAD_ERROR = $884E; { 78 - Attempted unload failed }
+ IN_USE_ERROR = $884F; { 79 - Attempted re-use of already in use connection entry }
+ TOO_MANY_REP_FRAGS = $8850; { 80 - Attempted request with too many reply fragments specified }
+ TABLE_FULL = $8851; { 81 - Attempted to add a name into the name table after it was full }
+ SOCKET_NOT_OPEN = $8852; { 82 - Listen was posted on unopened socket }
+ MEM_MGR_ERROR = $8853; { 83 - Attempted enhanced memory operation failed }
+ SFT3_ERROR = $8854; { 84 - An SFT3 switch occured mid-transfer }
+ PREFERRED_NOT_FOUND = $8855; { 85 - the preferred directory server was not established but another directory server was returned }
+ DEVICE_NOT_RECOGNIZED = $8856; { 86 - used to determine if the device is not used by VISE so pass it on to the next redirector, if any. }
+ BAD_NET_TYPE = $8857; { 87 - the network type (Bind/NDS) does not match the server version }
+ ERROR_OPENING_FILE = $8858; { 88 - generic open failure error, invalid path, access denied, etc.. }
+ NO_PREFERRED_SPECIFIED = $8859; { 89 - no preferred name specified }
+ ERROR_OPENING_SOCKET = $885A; { 90 - error opening a socket }
+ REQUESTER_FAILURE = $885A; { Client-32 }
+ RESOURCE_ACCESS_DENIED = $885B; { Client-32 }
+ SIGNATURE_LEVEL_CONFLICT = $8861;
+ NO_LOCK_FOUND = $8862; { OS/2 - process lock on conn handle failed, process ID not recognized }
+ LOCK_TABLE_FULL = $8863; { OS/2 - process lock on conn handle failed, process lock table full }
+ INVALID_MATCH_DATA = $8864;
+ MATCH_FAILED = $8865;
+ NO_MORE_ENTRIES = $8866;
+ INSUFFICIENT_RESOURCES = $8867;
+ STRING_TRANSLATION = $8868;
+ STRING_TRANSLATION_NEEDED = $8868; { Client-32 }
+ ACCESS_VIOLATION = $8869;
+ NOT_AUTHENTICATED = $886A;
+ INVALID_LEVEL = $886B;
+ RESOURCE_LOCK_ERROR = $886C;
+ INVALID_NAME_FORMAT = $886D;
+ OBJECT_EXISTS = $886E;
+ OBJECT_NOT_FOUND = $886F;
+ UNSUPPORTED_TRAN_TYPE = $8870;
+ INVALID_STRING_TYPE = $8871;
+ INVALID_OWNER = $8872;
+ UNSUPPORTED_AUTHENTICATOR = $8873;
+ IO_PENDING = $8874;
+ INVALID_DRIVE_NUM = $8875;
+ SHELL_FAILURE = $88FF;
+ VLM_FAILURE = $88FF;
+ SVC_ALREADY_REGISTERED = $8880; { Client-32 }
+ SVC_REGISTRY_FULL = $8881; { Client-32 }
+ SVC_NOT_REGISTERED = $8882; { Client-32 }
+ OUT_OF_RESOURCES = $8883; { Client-32 }
+ RESOLVE_SVC_FAILED = $8884; { Client-32 }
+ CONNECT_FAILED = $8885; { Client-32 }
+ PROTOCOL_NOT_BOUND = $8886; { Client-32 }
+ AUTHENTICATION_FAILED = $8887; { Client-32 }
+ INVALID_AUTHEN_HANDLE = $8888; { Client-32 }
+ AUTHEN_HANDLE_ALREADY_EXISTS = $8889; { Client-32 }
+ DIFF_OBJECT_ALREADY_AUTHEN = $8890; { Client-32 }
+ REQUEST_NOT_SERVICEABLE = $8891; { Client-32 }
+ AUTO_RECONNECT_SO_REBUILD = $8892; { Client-32 }
+ AUTO_RECONNECT_RETRY_REQUEST = $8893; { Client-32 }
+ ASYNC_REQUEST_IN_USE = $8894; { Client-32 }
+ ASYNC_REQUEST_CANCELED = $8895; { Client-32 }
+ SESS_SVC_ALREADY_REGISTERED = $8896; { Client-32 }
+ SESS_SVC_NOT_REGISTERED = $8897; { Client-32 }
+ PREVIOUSLY_AUTHENTICATED = $8899; { Client-32 }
+ RESOLVE_SVC_PARTIAL = $889A; { Client-32 }
+ NO_DEFAULT_SPECIFIED = $889B; { Client-32 }
+ HOOK_REQUEST_NOT_HANDLED = $889C; { Client-32 }
+ HOOK_REQUEST_BUSY = $889D; { Client-32 }
+ HOOK_REQUEST_QUEUED = $889D; { Client-32 }
+ AUTO_RECONNECT_SO_IGNORE = $889E; { Client-32 }
+ ASYNC_REQUEST_NOT_IN_USE = $889F; { Client-32 }
+ AUTO_RECONNECT_FAILURE = $88A0; { Client-32 }
+ NET_ERROR_ABORT_APPLICATION = $88A1; { Client-32 }
+ NET_ERROR_SUSPEND_APPLICATION = $88A2; { Client-32 }
+ NET_ERROR_ABORTED_PROCESS_GROUP = $88A3; { Client-32 }
+ NET_ERROR_PASSWORD_HAS_EXPIRED = $88A5; { Client-32 }
+ NET_ERROR_NETWORK_INACTIVE = $88A6; { Client-32 }
+ REPLY_TRUNCATED = $88E6; { 230 NLM }
+ UTF8_CONVERSION_FAILED = $88F0; { NWCALLS }
+ { Server Errors }
+ ERR_INSUFFICIENT_SPACE = $8901; { 001 }
+ NLM_INVALID_CONNECTION = $890A; { 010 }
+ ERR_TIMEOUT = $8910; { 016 - nlm connection timeout }
+ ERR_NO_MORE_ENTRY = $8914; { 020 }
+ ERR_BUFFER_TOO_SMALL = $8977; { 119 }
+ ERR_VOLUME_FLAG_NOT_SET = $8978; { 120 the service requested, not avail. on the selected vol. }
+ ERR_NO_ITEMS_FOUND = $8979; { 121 }
+ ERR_CONN_ALREADY_TEMP = $897A; { 122 }
+ ERR_CONN_ALREADY_LOGGED_IN = $897B; { 123 }
+ ERR_CONN_NOT_AUTHENTICATED = $897C; { 124 }
+ ERR_CONN_NOT_LOGGED_IN = $897D; { 125 }
+ NCP_BOUNDARY_CHECK_FAILED = $897E; { 126 }
+ ERR_LOCK_WAITING = $897F; { 127 }
+ ERR_LOCK_FAIL = $8980; { 128 }
+ FILE_IN_USE_ERROR = $8980; { 128 }
+ NO_MORE_FILE_HANDLES = $8981; { 129 }
+ NO_OPEN_PRIVILEGES = $8982; { 130 }
+ IO_ERROR_NETWORK_DISK = $8983; { 131 }
+ ERR_AUDITING_HARD_IO_ERROR = $8983; { 131 }
+ NO_CREATE_PRIVILEGES = $8984; { 132 }
+ ERR_AUDITING_NOT_SUPV = $8984; { 132 }
+ NO_CREATE_DELETE_PRIVILEGES = $8985; { 133 }
+ CREATE_FILE_EXISTS_READ_ONLY = $8986; { 134 }
+ WILD_CARDS_IN_CREATE_FILE_NAME = $8987;
+ CREATE_FILENAME_ERROR = $8987; { 135 }
+ INVALID_FILE_HANDLE = $8988; { 136 }
+ NO_SEARCH_PRIVILEGES = $8989; { 137 }
+ NO_DELETE_PRIVILEGES = $898A; { 138 }
+ NO_RENAME_PRIVILEGES = $898B; { 139 }
+ NO_MODIFY_PRIVILEGES = $898C; { 140 }
+ SOME_FILES_AFFECTED_IN_USE = $898D; { 141 }
+ NO_FILES_AFFECTED_IN_USE = $898E; { 142 }
+ SOME_FILES_AFFECTED_READ_ONLY = $898F; { 143 }
+ NO_FILES_AFFECTED_READ_ONLY = $8990; { 144 }
+ SOME_FILES_RENAMED_NAME_EXISTS = $8991; { 145 }
+ NO_FILES_RENAMED_NAME_EXISTS = $8992; { 146 }
+ NO_READ_PRIVILEGES = $8993; { 147 }
+ NO_WRITE_PRIVILEGES_OR_READONLY = $8994; { 148 }
+ FILE_DETACHED = $8995; { 149 }
+ SERVER_OUT_OF_MEMORY = $8996; { 150 }
+ ERR_TARGET_NOT_A_SUBDIRECTORY = $8996; { 150 can be changed later (note written by server people). }
+ NO_DISK_SPACE_FOR_SPOOL_FILE = $8997; { 151 }
+ ERR_AUDITING_NOT_ENABLED = $8997; { 151 }
+ VOLUME_DOES_NOT_EXIST = $8998; { 152 }
+ DIRECTORY_FULL = $8999; { 153 }
+ RENAMING_ACROSS_VOLUMES = $899A; { 154 }
+ BAD_DIRECTORY_HANDLE = $899B; { 155 }
+ INVALID_PATH = $899C; { 156 }
+ NO_MORE_TRUSTEES = $899C; { 156 }
+ NO_MORE_DIRECTORY_HANDLES = $899D; { 157 }
+ INVALID_FILENAME = $899E; { 158 }
+ DIRECTORY_ACTIVE = $899F; { 159 }
+ DIRECTORY_NOT_EMPTY = $89A0; { 160 }
+ DIRECTORY_IO_ERROR = $89A1; { 161 }
+ READ_FILE_WITH_RECORD_LOCKED = $89A2; { 162 }
+ ERR_TRANSACTION_RESTARTED = $89A3; { 163 }
+ ERR_RENAME_DIR_INVALID = $89A4; { 164 }
+ ERR_INVALID_OPENCREATE_MODE = $89A5; { 165 }
+ ERR_ALREADY_IN_USE = $89A6; { 166 }
+ ERR_AUDITING_ACTIVE = $89A6; { 166 }
+ ERR_INVALID_RESOURCE_TAG = $89A7; { 167 }
+ ERR_ACCESS_DENIED = $89A8; { 168 }
+ ERR_AUDITING_NO_RIGHTS = $89A8; { 168 }
+ ERR_LINK_IN_PATH = $89A9; { 169 }
+ INVALID_DATA_TYPE = $89AA; { 170 }
+ INVALID_DATA_STREAM = $89BE; { 190 }
+ INVALID_NAME_SPACE = $89BF; { 191 }
+ NO_ACCOUNTING_PRIVILEGES = $89C0; { 192 }
+ LOGIN_DENIED_NO_ACCOUNT_BALANCE = $89C1; { 193 }
+ LOGIN_DENIED_NO_CREDIT = $89C2; { 194 }
+ ERR_AUDITING_RECORD_SIZE = $89C2; { 194 }
+ ERR_TOO_MANY_HOLDS = $89C3; { 195 }
+ ACCOUNTING_DISABLED = $89C4; { 196 }
+ INTRUDER_DETECTION_LOCK = $89C5; { 197 }
+ NO_CONSOLE_OPERATOR = $89C6; { 198 }
+ NO_CONSOLE_PRIVILEGES = $89C6; { 198 }
+ ERR_Q_IO_FAILURE = $89D0; { 208 }
+ ERR_NO_QUEUE = $89D1; { 209 }
+ ERR_NO_Q_SERVER = $89D2; { 210 }
+ ERR_NO_Q_RIGHTS = $89D3; { 211 }
+ ERR_Q_FULL = $89D4; { 212 }
+ ERR_NO_Q_JOB = $89D5; { 213 }
+ ERR_NO_Q_JOB_RIGHTS = $89D6; { 214 }
+ ERR_Q_IN_SERVICE = $89D7; { 215 }
+ PASSWORD_NOT_UNIQUE = $89D7; { 215 }
+ ERR_Q_NOT_ACTIVE = $89D8; { 216 }
+ PASSWORD_TOO_SHORT = $89D8; { 216 }
+ ERR_Q_STN_NOT_SERVER = $89D9; { 217 }
+ LOGIN_DENIED_NO_CONNECTION = $89D9; { 217 }
+ ERR_MAXIMUM_LOGINS_EXCEEDED = $89D9; { 217 }
+ ERR_Q_HALTED = $89DA; { 218 }
+ UNAUTHORIZED_LOGIN_TIME = $89DA; { 218 }
+ UNAUTHORIZED_LOGIN_STATION = $89DB; { 219 }
+ ERR_Q_MAX_SERVERS = $89DB; { 219 }
+ ACCOUNT_DISABLED = $89DC; { 220 }
+ PASSWORD_HAS_EXPIRED_NO_GRACE = $89DE; { 222 }
+ PASSWORD_HAS_EXPIRED = $89DF; { 223 }
+ E_NO_MORE_USERS = $89E7; { 231 }
+ NOT_ITEM_PROPERTY = $89E8; { 232 }
+ WRITE_PROPERTY_TO_GROUP = $89E8; { 232 }
+ MEMBER_ALREADY_EXISTS = $89E9; { 233 }
+ NO_SUCH_MEMBER = $89EA; { 234 }
+ NOT_GROUP_PROPERTY = $89EB; { 235 }
+ NO_SUCH_SEGMENT = $89EC; { 236 }
+ PROPERTY_ALREADY_EXISTS = $89ED; { 237 }
+ OBJECT_ALREADY_EXISTS = $89EE; { 238 }
+ INVALID_NAME = $89EF; { 239 }
+ WILD_CARD_NOT_ALLOWED = $89F0; { 240 }
+ INVALID_BINDERY_SECURITY = $89F1; { 241 }
+ NO_OBJECT_READ_PRIVILEGE = $89F2; { 242 }
+ NO_OBJECT_RENAME_PRIVILEGE = $89F3; { 243 }
+ NO_OBJECT_DELETE_PRIVILEGE = $89F4; { 244 }
+ NO_OBJECT_CREATE_PRIVILEGE = $89F5; { 245 }
+ NO_PROPERTY_DELETE_PRIVILEGE = $89F6; { 246 }
+ NO_PROPERTY_CREATE_PRIVILEGE = $89F7; { 247 }
+ NO_PROPERTY_WRITE_PRIVILEGE = $89F8; { 248 }
+ NO_FREE_CONNECTION_SLOTS = $89F9; { 249 }
+ NO_PROPERTY_READ_PRIVILEGE = $89F9; { 249 }
+ NO_MORE_SERVER_SLOTS = $89FA; { 250 }
+ TEMP_REMAP_ERROR = $89FA; { 250 }
+ INVALID_PARAMETERS = $89FB; { 251 }
+ NO_SUCH_PROPERTY = $89FB; { 251 }
+ ERR_NCP_NOT_SUPPORTED = $89FB; { 251 }
+ INTERNET_PACKET_REQT_CANCELED = $89FC; { 252 }
+ UNKNOWN_FILE_SERVER = $89FC; { 252 }
+ MESSAGE_QUEUE_FULL = $89FC; { 252 }
+ NO_SUCH_OBJECT = $89FC; { 252 }
+ LOCK_COLLISION = $89FD; { 253 }
+ BAD_STATION_NUMBER = $89FD; { 253 }
+ INVALID_PACKET_LENGTH = $89FD; { 253 }
+ UNKNOWN_REQUEST = $89FD; { 253 }
+ BINDERY_LOCKED = $89FE; { 254 }
+ TRUSTEE_NOT_FOUND = $89FE; { 254 }
+ DIRECTORY_LOCKED = $89FE; { 254 }
+ INVALID_SEMAPHORE_NAME_LENGTH = $89FE; { 254 }
+ PACKET_NOT_DELIVERABLE = $89FE; { 254 }
+ SERVER_BINDERY_LOCKED = $89FE; { 254 }
+ SOCKET_TABLE_FULL = $89FE; { 254 }
+ SPOOL_DIRECTORY_ERROR = $89FE; { 254 }
+ SUPERVISOR_HAS_DISABLED_LOGIN = $89FE; { 254 }
+ TIMEOUT_FAILURE = $89FE; { 254 }
+ BAD_PRINTER_ERROR = $89FF; { 255 }
+ BAD_RECORD_OFFSET = $89FF; { 255 }
+ CLOSE_FCB_ERROR = $89FF; { 255 }
+ FILE_EXTENSION_ERROR = $89FF; { 255 }
+ FILE_NAME_ERROR = $89FF; { 255 }
+ HARDWARE_FAILURE = $89FF; { 255 }
+ INVALID_DRIVE_NUMBER = $89FF; { 255 }
+ DOS_INVALID_DRIVE = $000F; { 255 }
+ INVALID_INITIAL_SEMAPHORE_VALUE = $89FF; { 255 }
+ INVALID_SEMAPHORE_HANDLE = $89FF; { 255 }
+ IO_BOUND_ERROR = $89FF; { 255 }
+ NO_FILES_FOUND_ERROR = $89FF; { 255 }
+ NO_RESPONSE_FROM_SERVER = $89FF; { 255 }
+ NO_SUCH_OBJECT_OR_BAD_PASSWORD = $89FF; { 255 }
+ PATH_NOT_LOCATABLE = $89FF; { 255 }
+ QUEUE_FULL_ERROR = $89FF; { 255 }
+ REQUEST_NOT_OUTSTANDING = $89FF; { 255 }
+ SOCKET_ALREADY_OPEN = $89FF; { 255 }
+ LOCK_ERROR = $89FF; { 255 }
+ FAILURE = $89FF; { 255 Generic Failure }
+ { NOT_SAME_LOCAL_DRIVE = $89F6; }
+ { TARGET_DRIVE_NOT_LOCAL = $89F7; }
+ { ALREADY_ATTACHED_TO_SERVER = $89F8; // 248 }
+ { NOT_ATTACHED_TO_SERVER = $89F8; }
+ {/// Network errors ///// }
+ { Decimal values at end of line are 32768 lower than actual }
+
+
+ NWE_ALREADY_ATTACHED = $8800; { 0 - Attach attempted to server with valid, existing connection }
+ NWE_CONN_INVALID = $8801; { 1 - Request attempted with invalid or non-attached connection handle }
+ NWE_DRIVE_IN_USE = $8802; { 2 - OS/2 only (NOT USED) }
+ NWE_DRIVE_CANNOT_MAP = $8803; { 3 - Map drive attempted but unable to add new current directory structure }
+ NWE_DRIVE_BAD_PATH = $8804; { 4 - Map drive attempted with invalid path specification }
+ NWE_NET_RECEIVE = $8805; { 5 - Attempt to receive from the selected transport failed }
+ NWE_NET_UNKNOWN = $8806; { 6 - Network send attempted with an un-specific network error }
+ NWE_SERVER_BAD_SLOT = $8807; { 7 - Server request attempted with invalid server connection slot }
+ NWE_SERVER_NO_SLOTS = $8808; { 8 - Attach attempted to server with no connection slots available }
+ NWE_NET_SEND = $8809; { 9 - Attempt to send on the selected transport failed }
+ NWE_SERVER_NO_ROUTE = $880A; { 10 - Attempted to find route to server where no route exists }
+ NWE_BAD_LOCAL_TARGET = $880B; { 11 - OS/2 only }
+ NWE_REQ_TOO_MANY_REQ_FRAGS = $880C; { 12 - Attempted request with too many request fragments specified }
+ NWE_CONN_LIST_OVERFLOW = $880D;
+ NWE_BUFFER_OVERFLOW = $880E; { 14 - Attempt to receive more data than the reply buffer had room for }
+ NWE_SERVER_NO_CONN = $880F; { 15 - Attempt to get connection for a server not connected }
+ NWE_NO_ROUTER_FOUND = $8810; { 16 - OS/2 only }
+ NWE_FUNCTION_INVALID = $8811; { 17 - Attempted function call to non- existent or illegal function }
+ NWE_SCAN_COMPLETE = $8812;
+ NWE_UNSUPPORTED_NAME_FORMAT_TYP = $8813;
+ NWE_HANDLE_ALREADY_LICENSED = $8814;
+ NWE_HANDLE_ALREADY_UNLICENSED = $8815;
+ NWE_INVALID_NCP_PACKET_LENGTH = $8816;
+ NWE_SETTING_UP_TIMEOUT = $8817;
+ NWE_SETTING_SIGNALS = $8818;
+ NWE_SERVER_CONNECTION_LOST = $8819;
+ NWE_OUT_OF_HEAP_SPACE = $881A;
+ NWE_INVALID_SERVICE_REQUEST = $881B;
+ NWE_INVALID_TASK_NUMBER = $881C;
+ NWE_INVALID_MESSAGE_LENGTH = $881D;
+ NWE_EA_SCAN_DONE = $881E;
+ NWE_BAD_CONNECTION_NUMBER = $881F;
+ NWE_MULT_TREES_NOT_SUPPORTED = $8820; { 32 - Attempt to open a connection to a DS tree other than the default tree }
+ NWE_CONN_NOT_SAME = $8830; { 48 - Internal server request attempted across different server connections }
+ NWE_CONN_PRIMARY_NOT_SET = $8831; { 49 - Attempt to retrieve default connection with no primary connection set }
+ NWE_PRN_CAPTURE_NOT_IN_PROGRESS = $8832; { 50 - Capture information requested on port with no capture in progress }
+ NWE_BUFFER_INVALID_LEN = $8833; { 51 - Used to indicate length which caller requested on a GetDNC or SetDNC was too large }
+ NWE_USER_NO_NAME = $8834; { 52 }
+ NWE_PRN_NO_LOCAL_SPOOLER = $8835; { 53 - Capture requested without having the local print spooler installed }
+ NWE_PARAM_INVALID = $8836; { 54 - Attempted function with an invalid function parameter specified }
+ NWE_CFG_OPEN_FAILED = $8837; { 55 - OS/2 only }
+ NWE_CFG_NO_FILE = $8838; { 56 - OS/2 only }
+ NWE_CFG_READ_FAILED = $8839; { 57 - OS/2 only }
+ NWE_CFG_LINE_TOO_LONG = $883A; { 58 - OS/2 only }
+ NWE_CFG_LINES_IGNORED = $883B; { 59 - OS/2 only }
+ NWE_RESOURCE_NOT_OWNED = $883C; { 60 - Attempted request made with a parameter using foriegn resource }
+ NWE_DAEMON_INSTALLED = $883D; { 61 - OS/2 only }
+ NWE_PRN_SPOOLER_INSTALLED = $883E; { 62 - Attempted load of print spooler with print spooler already installed }
+ NWE_CONN_TABLE_FULL = $883F; { 63 - Attempted to allocate a connection handle with no more local connection table entries }
+ NWE_CFG_SECTION_NOT_FOUND = $8840; { 64 - OS/2 only }
+ NWE_TRAN_INVALID_TYPE = $8841; { 65 - Attempted function on a connection with an invalid transport selected }
+ NWE_TDS_TAG_IN_USE = $8842; { 66 - OS/2 only }
+ NWE_TDS_OUT_OF_MEMORY = $8843; { 67 - OS/2 only }
+ NWE_TDS_INVALID_TAG = $8844; { 68 - Attempted TDS function with invalid tag }
+ NWE_TDS_WRITE_TRUNCATED = $8845; { 69 - Attempted TDS write with buffer that exceeded buffer }
+ NWE_DS_NO_CONN = $8846; { 70 }
+ NWE_SERVICE_BUSY = $8846; { 70 - Attempted request made to partially asynchronous function in busy state }
+ NWE_SERVER_NOT_FOUND = $8847; { 71 - Attempted connect failed to find any servers responding }
+ NWE_VLM_INVALID = $8848; { 72 - Attempted function call to non-existant or not-loaded overlay }
+ NWE_DRIVE_ALREADY_MAPPED = $8849; { 73 - Attempted map to network drive that was already mapped }
+ NWE_DRIVE_LOCAL_IN_USE = $884A; { 74 - Attempted map to local drive that was in use }
+ NWE_DRIVE_NONE_AVAILABLE = $884B; { 75 - Attempted map to next available drive when none were available }
+ NWE_DEVICE_NOT_REDIRECTED = $884C; { 76 - The device is not redirected }
+ NWE_FILE_MAX_REACHED = $884D; { 77 - Maximum number of files was reached }
+ NWE_UNLOAD_FAILED = $884E; { 78 - Attempted unload failed }
+ NWE_CONN_IN_USE = $884F; { 79 - Attempted re-use of already in use connection entry }
+ NWE_REQ_TOO_MANY_REP_FRAGS = $8850; { 80 - Attempted request with too many reply fragments specified }
+ NWE_NAME_TABLE_FULL = $8851; { 81 - Attempted to add a name into the name table after it was full }
+ NWE_SOCKET_NOT_OPEN = $8852; { 82 - Listen was posted on unopened socket }
+ NWE_MEMORY_MGR_ERROR = $8853; { 83 - Attempted enhanced memory operation failed }
+ NWE_SFT3_ERROR = $8854; { 84 - An SFT3 switch occured mid-transfer }
+ NWE_DS_PREFERRED_NOT_FOUND = $8855; { 85 - the preferred directory server was not established but another directory server was returned }
+ NWE_DEVICE_NOT_RECOGNIZED = $8856; { 86 - used to determine if the device is not used by VISE so pass it on to the next redirector, if any. }
+ NWE_NET_INVALID_TYPE = $8857; { 87 - the network type (Bind/NDS) does not match the server version }
+ NWE_FILE_OPEN_FAILED = $8858; { 88 - generic open failure error, invalid path, access denied, etc.. }
+ NWE_DS_PREFERRED_NOT_SPECIFIED = $8859; { 89 - no preferred name specified }
+ NWE_SOCKET_OPEN_FAILED = $885A; { 90 - error opening a socket }
+ NWE_SIGNATURE_LEVEL_CONFLICT = $8861;
+ NWE_NO_LOCK_FOUND = $8862; { OS/2 - process lock on conn handle failed, process ID not recognized }
+ NWE_LOCK_TABLE_FULL = $8863; { OS/2 - process lock on conn handle failed, process lock table full }
+ NWE_INVALID_MATCH_DATA = $8864;
+ NWE_MATCH_FAILED = $8865;
+ NWE_NO_MORE_ENTRIES = $8866;
+ NWE_INSUFFICIENT_RESOURCES = $8867;
+ NWE_STRING_TRANSLATION = $8868;
+ NWE_ACCESS_VIOLATION = $8869;
+ NWE_NOT_AUTHENTICATED = $886A;
+ NWE_INVALID_LEVEL = $886B;
+ NWE_RESOURCE_LOCK = $886C;
+ NWE_INVALID_NAME_FORMAT = $886D;
+ NWE_OBJECT_EXISTS = $886E;
+ NWE_OBJECT_NOT_FOUND = $886F;
+ NWE_UNSUPPORTED_TRAN_TYPE = $8870;
+ NWE_INVALID_STRING_TYPE = $8871;
+ NWE_INVALID_OWNER = $8872;
+ NWE_UNSUPPORTED_AUTHENTICATOR = $8873;
+ NWE_IO_PENDING = $8874;
+ NWE_INVALID_DRIVE_NUMBER = $8875;
+ NWE_REPLY_TRUNCATED = $88E6; { 230 NLM }
+ NWE_REQUESTER_FAILURE = $88FF;
+ { Server Errors }
+ NWE_INSUFFICIENT_SPACE = $8901; { 001 }
+ NWE_INVALID_CONNECTION = $890A; { 010 - nlm invalid connection }
+ NWE_TIMEOUT = $8910; { 016 - nlm connection timeout }
+ NWE_NO_MORE_ENTRY = $8914; { 020 }
+ NWE_BUFFER_TOO_SMALL = $8977; { 119 }
+ NWE_VOL_FLAG_NOT_SET = $8978; { 120 the service requested, not avail. on the selected vol. }
+ NWE_NO_ITEMS_FOUND = $8979; { 121 }
+ NWE_CONN_ALREADY_TEMP = $897A; { 122 }
+ NWE_CONN_ALREADY_LOGGED_IN = $897B; { 123 }
+ NWE_CONN_NOT_AUTHENTICATED = $897C; { 124 }
+ NWE_CONN_NOT_LOGGED_IN = $897D; { 125 }
+ NWE_NCP_BOUNDARY_CHECK_FAILED = $897E; { 126 }
+ NWE_LOCK_WAITING = $897F; { 127 }
+ NWE_LOCK_FAIL = $8980; { 128 }
+ NWE_FILE_IN_USE = $8980; { 128 }
+ NWE_FILE_NO_HANDLES = $8981; { 129 }
+ NWE_FILE_NO_OPEN_PRIV = $8982; { 130 }
+ NWE_DISK_IO_ERROR = $8983; { 131 }
+ NWE_AUDITING_HARD_IO_ERROR = $8983; { 131 }
+ NWE_FILE_NO_CREATE_PRIV = $8984; { 132 }
+ NWE_AUDITING_NOT_SUPV = $8984; { 132 }
+ NWE_FILE_NO_CREATE_DEL_PRIV = $8985; { 133 }
+ NWE_FILE_EXISTS_READ_ONLY = $8986; { 134 }
+ NWE_FILE_WILD_CARDS_IN_NAME = $8987; { 135 }
+ NWE_FILE_INVALID_HANDLE = $8988; { 136 }
+ NWE_FILE_NO_SRCH_PRIV = $8989; { 137 }
+ NWE_FILE_NO_DEL_PRIV = $898A; { 138 }
+ NWE_FILE_NO_RENAME_PRIV = $898B; { 139 }
+ NWE_FILE_NO_MOD_PRIV = $898C; { 140 }
+ NWE_FILE_SOME_IN_USE = $898D; { 141 }
+ NWE_FILE_NONE_IN_USE = $898E; { 142 }
+ NWE_FILE_SOME_READ_ONLY = $898F; { 143 }
+ NWE_FILE_NONE_READ_ONLY = $8990; { 144 }
+ NWE_FILE_SOME_RENAMED_EXIST = $8991; { 145 }
+ NWE_FILE_NONE_RENAMED_EXIST = $8992; { 146 }
+ NWE_FILE_NO_READ_PRIV = $8993; { 147 }
+ NWE_FILE_NO_WRITE_PRIV = $8994; { 148 }
+ NWE_FILE_READ_ONLY = $8994; { 148 }
+ NWE_FILE_DETACHED = $8995; { 149 }
+ NWE_SERVER_OUT_OF_MEMORY = $8996; { 150 }
+ NWE_DIR_TARGET_INVALID = $8996; { 150 }
+ NWE_DISK_NO_SPOOL_SPACE = $8997; { 151 }
+ NWE_AUDITING_NOT_ENABLED = $8997; { 151 }
+ NWE_VOL_INVALID = $8998; { 152 }
+ NWE_DIR_FULL = $8999; { 153 }
+ NWE_VOL_RENAMING_ACROSS = $899A; { 154 }
+ NWE_DIRHANDLE_INVALID = $899B; { 155 }
+ NWE_PATH_INVALID = $899C; { 156 }
+ NWE_TRUSTEES_NO_MORE = $899C; { 156 }
+ NWE_DIRHANDLE_NO_MORE = $899D; { 157 }
+ NWE_FILE_NAME_INVALID = $899E; { 158 }
+ NWE_DIR_ACTIVE = $899F; { 159 }
+ NWE_DIR_NOT_EMPTY = $89A0; { 160 }
+ NWE_DIR_IO_ERROR = $89A1; { 161 }
+ NWE_FILE_IO_LOCKED = $89A2; { 162 }
+ NWE_TTS_RANSACTION_RESTARTED = $89A3; { 163 }
+ NWE_TTS_TRANSACTION_RESTARTED = $89A3; { 163 }
+ NWE_DIR_RENAME_INVALID = $89A4; { 164 }
+ NWE_FILE_OPENCREAT_MODE_INVALID = $89A5; { 165 }
+ NWE_ALREADY_IN_USE = $89A6; { 166 }
+ NWE_AUDITING_ACTIVE = $89A6; { 166 }
+ NWE_RESOURCE_TAG_INVALID = $89A7; { 167 }
+ NWE_ACCESS_DENIED = $89A8; { 168 }
+ NWE_AUDITING_NO_RIGHTS = $89A8; { 168 }
+ NWE_DATA_STREAM_INVALID = $89BE; { 190 }
+ NWE_NAME_SPACE_INVALID = $89BF; { 191 }
+ NWE_ACCTING_NO_PRIV = $89C0; { 192 }
+ NWE_ACCTING_NO_BALANCE = $89C1; { 193 }
+ NWE_ACCTING_NO_CREDIT = $89C2; { 194 }
+ NWE_AUDITING_RECORD_SIZE = $89C2; { 194 }
+ NWE_ACCTING_TOO_MANY_HOLDS = $89C3; { 195 }
+ NWE_ACCTING_DISABLED = $89C4; { 196 }
+ NWE_LOGIN_LOCKOUT = $89C5; { 197 }
+ NWE_CONSOLE_NO_PRIV = $89C6; { 198 }
+ NWE_Q_IO_FAILURE = $89D0; { 208 }
+ NWE_Q_NONE = $89D1; { 209 }
+ NWE_Q_NO_SERVER = $89D2; { 210 }
+ NWE_Q_NO_RIGHTS = $89D3; { 211 }
+ NWE_Q_FULL = $89D4; { 212 }
+ NWE_Q_NO_JOB = $89D5; { 213 }
+ NWE_Q_NO_JOB_RIGHTS = $89D6; { 214 }
+ NWE_PASSWORD_UNENCRYPTED = $89D6; { 214 }
+ NWE_Q_IN_SERVICE = $89D7; { 215 }
+ NWE_PASSWORD_NOT_UNIQUE = $89D7; { 215 }
+ NWE_Q_NOT_ACTIVE = $89D8; { 216 }
+ NWE_PASSWORD_TOO_SHORT = $89D8; { 216 }
+ NWE_Q_STN_NOT_SERVER = $89D9; { 217 }
+ NWE_LOGIN_NO_CONN = $89D9; { 217 }
+ NWE_LOGIN_MAX_EXCEEDED = $89D9; { 217 }
+ NWE_Q_HALTED = $89DA; { 218 }
+ NWE_LOGIN_UNAUTHORIZED_TIME = $89DA; { 218 }
+ NWE_LOGIN_UNAUTHORIZED_STATION = $89DB; { 219 }
+ NWE_Q_MAX_SERVERS = $89DB; { 219 }
+ NWE_ACCT_DISABLED = $89DC; { 220 }
+ NWE_PASSWORD_INVALID = $89DE; { 222 }
+ NWE_PASSWORD_EXPIRED = $89DF; { 223 }
+ NWE_LOGIN_NO_CONN_AVAIL = $89E0; { 224 }
+ NWE_E_NO_MORE_USERS = $89E7; { 231 }
+ NWE_BIND_NOT_ITEM_PROP = $89E8; { 232 }
+ NWE_BIND_WRITE_TO_GROUP_PROP = $89E8; { 232 }
+ NWE_BIND_MEMBER_ALREADY_EXISTS = $89E9; { 233 }
+ NWE_BIND_NO_SUCH_MEMBER = $89EA; { 234 }
+ NWE_BIND_NOT_GROUP_PROP = $89EB; { 235 }
+ NWE_BIND_NO_SUCH_SEGMENT = $89EC; { 236 }
+ NWE_BIND_PROP_ALREADY_EXISTS = $89ED; { 237 }
+ NWE_BIND_OBJ_ALREADY_EXISTS = $89EE; { 238 }
+ NWE_BIND_NAME_INVALID = $89EF; { 239 }
+ NWE_BIND_WILDCARD_INVALID = $89F0; { 240 }
+ NWE_BIND_SECURITY_INVALID = $89F1; { 241 }
+ NWE_BIND_OBJ_NO_READ_PRIV = $89F2; { 242 }
+ NWE_BIND_OBJ_NO_RENAME_PRIV = $89F3; { 243 }
+ NWE_BIND_OBJ_NO_DELETE_PRIV = $89F4; { 244 }
+ NWE_BIND_OBJ_NO_CREATE_PRIV = $89F5; { 245 }
+ NWE_BIND_PROP_NO_DELETE_PRIV = $89F6; { 246 }
+ NWE_BIND_PROP_NO_CREATE_PRIV = $89F7; { 247 }
+ NWE_BIND_PROP_NO_WRITE_PRIV = $89F8; { 248 }
+ NWE_BIND_PROP_NO_READ_PRIV = $89F9; { 249 }
+ NWE_NO_FREE_CONN_SLOTS = $89F9; { 249 }
+ NWE_NO_MORE_SERVER_SLOTS = $89FA; { 250 }
+ NWE_TEMP_REMAP_ERROR = $89FA; { 250 }
+ NWE_PARAMETERS_INVALID = $89FB; { 251 }
+ NWE_BIND_NO_SUCH_PROP = $89FB; { 251 }
+ NWE_NCP_NOT_SUPPORTED = $89FB; { 251 }
+ NWE_INET_PACKET_REQ_CANCELED = $89FC; { 252 }
+ NWE_SERVER_UNKNOWN = $89FC; { 252 }
+ NWE_MSG_Q_FULL = $89FC; { 252 }
+ NWE_BIND_NO_SUCH_OBJ = $89FC; { 252 }
+ NWE_LOCK_COLLISION = $89FD; { 253 }
+ NWE_CONN_NUM_INVALID = $89FD; { 253 }
+ NWE_PACKET_LEN_INVALID = $89FD; { 253 }
+ NWE_UNKNOWN_REQ = $89FD; { 253 }
+ NWE_BIND_LOCKED = $89FE; { 254 }
+ NWE_TRUSTEE_NOT_FOUND = $89FE; { 254 }
+ NWE_DIR_LOCKED = $89FE; { 254 }
+ NWE_SEM_INVALID_NAME_LEN = $89FE; { 254 }
+ NWE_PACKET_NOT_DELIVERABLE = $89FE; { 254 }
+ NWE_SOCKET_TABLE_FULL = $89FE; { 254 }
+ NWE_SPOOL_DIR_ERROR = $89FE; { 254 }
+ NWE_LOGIN_DISABLED_BY_SUPER = $89FE; { 254 }
+ NWE_TIMEOUT_FAILURE = $89FE; { 254 }
+ NWE_FILE_EXT = $89FF; { 255 }
+ NWE_FILE_NAME = $89FF; { 255 }
+ NWE_HARD_FAILURE = $89FF; { 255 }
+ NWE_FCB_CLOSE = $89FF; { 255 }
+ NWE_IO_BOUND = $89FF; { 255 }
+ NWE_BAD_SPOOL_PRINTER = $89FF; { 255 }
+ NWE_BAD_RECORD_OFFSET = $89FF; { 255 }
+ NWE_DRIVE_INVALID_NUM = $89FF; { 255 }
+ NWE_SEM_INVALID_INIT_VAL = $89FF; { 255 }
+ NWE_SEM_INVALID_HANDLE = $89FF; { 255 }
+ NWE_NO_FILES_FOUND_ERROR = $89FF; { 255 }
+ NWE_NO_RESPONSE_FROM_SERVER = $89FF; { 255 }
+ NWE_NO_OBJ_OR_BAD_PASSWORD = $89FF; { 255 }
+ NWE_PATH_NOT_LOCATABLE = $89FF; { 255 }
+ NWE_Q_FULL_ERROR = $89FF; { 255 }
+ NWE_REQ_NOT_OUTSTANDING = $89FF; { 255 }
+ NWE_SOCKET_ALREADY_OPEN = $89FF; { 255 }
+ NWE_LOCK_ERROR = $89FF; { 255 }
+ NWE_FAILURE = $89FF; { 255 Generic Failure }
+
+//*****************************************************************************
+//nwfile.h
+//*****************************************************************************
+
+type
+
+ PNW_FILE_INFO = ^TNW_FILE_INFO;
+ TNW_FILE_INFO = record
+ fileName: array[0..13] of Tnstr8;
+ fileAttributes: Tnuint8;
+ extendedFileAttributes: Tnuint8;
+ fileSize: Tnuint32;
+ creationDate: Tnuint16;
+ lastAccessDate: Tnuint16;
+ lastUpdateDateAndTime: Tnuint32;
+ fileOwnerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ end;
+
+ PNW_FILE_INFO2 = ^TNW_FILE_INFO2;
+ TNW_FILE_INFO2 = record
+ fileAttributes: Tnuint8;
+ extendedFileAttributes: Tnuint8;
+ fileSize: Tnuint32;
+ creationDate: Tnuint16;
+ lastAccessDate: Tnuint16;
+ lastUpdateDateAndTime: Tnuint32;
+ fileOwnerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ fileName: array[0..259] of Tnstr8;
+ end;
+ { 255*3 + 1 }
+
+ PNW_FILE_INFO2_EXT = ^TNW_FILE_INFO2_EXT;
+ TNW_FILE_INFO2_EXT = record
+ fileAttributes: Tnuint8;
+ extendedFileAttributes: Tnuint8;
+ fileSize: Tnuint32;
+ creationDate: Tnuint16;
+ lastAccessDate: Tnuint16;
+ lastUpdateDateAndTime: Tnuint32;
+ fileOwnerID: Tnuint32;
+ lastArchiveDateAndTime: Tnuint32;
+ fileName: array[0..765] of Tnstr8;
+ end;
+
+ PSEARCH_FILE_INFO = ^TSEARCH_FILE_INFO;
+ TSEARCH_FILE_INFO = record
+ sequenceNumber: Tnuint16;
+ reserved: Tnuint16;
+ fileName: array[0..14] of Tnstr8;
+ fileAttributes: Tnuint8;
+ fileMode: Tnuint8;
+ fileLength: Tnuint32;
+ createDate: Tnuint16;
+ accessDate: Tnuint16;
+ updateDate: Tnuint16;
+ updateTime: Tnuint16;
+ end;
+
+ PSEARCH_DIR_INFO = ^TSEARCH_DIR_INFO;
+ TSEARCH_DIR_INFO = record
+ sequenceNumber: Tnuint16;
+ reserved1: Tnuint16;
+ directoryName: array[0..14] of Tnstr8;
+ directoryAttributes: Tnuint8;
+ directoryAccessRights: Tnuint8;
+ createDate: Tnuint16;
+ createTime: Tnuint16;
+ owningObjectID: Tnuint32;
+ reserved2: Tnuint16;
+ directoryStamp: Tnuint16;
+ end;
+
+ PCONN_OPEN_FILE = ^TCONN_OPEN_FILE;
+ TCONN_OPEN_FILE = record
+ taskNumber: Tnuint8;
+ lockType: Tnuint8;
+ accessControl: Tnuint8;
+ lockFlag: Tnuint8;
+ volNumber: Tnuint8;
+ dirEntry: Tnuint16;
+ fileName: array[0..13] of Tnstr8;
+ end;
+
+ PCONN_OPEN_FILES = ^TCONN_OPEN_FILES;
+ TCONN_OPEN_FILES = record
+ nextRequest: Tnuint16;
+ connCount: Tnuint8;
+ connInfo: array[0..21] of TCONN_OPEN_FILE;
+ end;
+
+ POPEN_FILE_CONN = ^TOPEN_FILE_CONN;
+ TOPEN_FILE_CONN = record
+ taskNumber: Tnuint16;
+ lockType: Tnuint8;
+ accessControl: Tnuint8;
+ lockFlag: Tnuint8;
+ volNumber: Tnuint8;
+ parent: Tnuint32;
+ dirEntry: Tnuint32;
+ forkCount: Tnuint8;
+ nameSpace: Tnuint8;
+ nameLen: Tnuint8;
+ fileName: array[0..254] of Tnstr8;
+ end;
+
+ POPEN_FILE_CONN_CTRL = ^TOPEN_FILE_CONN_CTRL;
+ TOPEN_FILE_CONN_CTRL = record
+ nextRequest: Tnuint16;
+ openCount: Tnuint16;
+ buffer: array[0..511] of Tnuint8;
+ curRecord: Tnuint16;
+ end;
+
+ PCONN_USING_FILE = ^TCONN_USING_FILE;
+ TCONN_USING_FILE = record
+ connNumber: Tnuint16;
+ taskNumber: Tnuint16;
+ lockType: Tnuint8;
+ accessControl: Tnuint8;
+ lockFlag: Tnuint8;
+ end;
+
+ PCONNS_USING_FILE = ^TCONNS_USING_FILE;
+ TCONNS_USING_FILE = record
+ nextRequest: Tnuint16;
+ useCount: Tnuint16;
+ openCount: Tnuint16;
+ openForReadCount: Tnuint16;
+ openForWriteCount: Tnuint16;
+ denyReadCount: Tnuint16;
+ denyWriteCount: Tnuint16;
+ locked: Tnuint8;
+ forkCount: Tnuint8;
+ connCount: Tnuint16;
+ connInfo: array[0..69] of TCONN_USING_FILE;
+ end;
+
+const
+ SEEK_FROM_BEGINNING = 1;
+ SEEK_FROM_CURRENT_OFFSET = 2;
+ SEEK_FROM_END = 3;
+ { The following flags are to be used in the createFlag parameter of
+ the NWCreateFile call. }
+ NWCREATE_NEW_FILE = 1;
+ NWOVERWRITE_FILE = 2;
+
+function NWSetCompressedFileSize(conn: TNWCONN_HANDLE; fileHandle: TNWFILE_HANDLE; reqFileSize: Tnuint32; resFileSize: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWFileServerFileCopy(srcFileHandle: TNWFILE_HANDLE; dstFileHandle: TNWFILE_HANDLE; srcOffset: Tnuint32; dstOffset: Tnuint32; bytesToCopy: Tnuint32;
+ bytesCopied: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileConnectionID(fileHandle: TNWFILE_HANDLE; conn: PNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileConnRef(fileHandle: TNWFILE_HANDLE; connRef: pnuint32): TNWCCODE; NWLIB_UNKNOWN;
+
+function NWFileSearchInitialize(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; volNum: pnuint8; dirID: pnuint16;
+ iterhandle: pnuint16; accessRights: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+ { was #define dname(params) para_def_expr }
+ //function NWIntFileSearchInitialize(a,b,c,d,e,f,g,h : longint) : longint;
+
+
+function NWIntFileSearchContinue(conn: TNWCONN_HANDLE; volNum: Tnuint8; dirID: Tnuint16; searchContext: Tnuint16; searchAttr: Tnuint8;
+ searchPath: Pnstr8; retBuf: pnuint8; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+ { was #define dname(params) para_def_expr }
+ // function NWScanFileInformation(a,b,c,d,e,f : longint) : longint;
+
+
+function NWIntScanFileInformation(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; filePattern: Pnstr8; searchAttr: Tnuint8; iterhandle: pnint16;
+ info: PNW_FILE_INFO; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWSetFileInformation(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; searchAttrs: Tnuint8; info: PNW_FILE_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWSetFileInformation2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; searchAttrs: Tnuint8; info: PNW_FILE_INFO2): TNWCCODE; NWLIB_CALNLM32;
+
+function NWIntScanFileInformation2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; filePattern: Pnstr8; searchAttrs: Tnuint8; iterHandle: pnuint8;
+ info: PNW_FILE_INFO2; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWIntScanFileInformation2Ext(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; filePattern: Pnstr8; searchAttrs: Tnuint8; iterHandle: pnuint8;
+ info: PNW_FILE_INFO2_EXT; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+function NWSetFileAttributes(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; searchAttrs: Tnuint8; newAttrs: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetExtendedFileAttributes2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; extAttrs: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWScanConnectionsUsingFile(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; filePath: Pnstr8; iterhandle: pnint16; fileUse: PCONN_USING_FILE;
+ fileUsed: PCONNS_USING_FILE): TNWCCODE; NWLIB_CALNLM32;
+function NWScanOpenFilesByConn2(conn: TNWCONN_HANDLE; connNum: Tnuint16; iterHandle: pnint16; openCtrl: POPEN_FILE_CONN_CTRL; openFile: POPEN_FILE_CONN): TNWCCODE; NWLIB_CALNLM32;
+function NWScanOpenFilesByConn(conn: TNWCONN_HANDLE; connNum: Tnuint16; iterHandle: pnint16; openFile: PCONN_OPEN_FILE; openFiles: PCONN_OPEN_FILES): TNWCCODE; NWLIB_CALNLM32;
+function NWSetExtendedFileAttributes2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; extAttrs: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWRenameFile(conn: TNWCONN_HANDLE; oldDirHandle: TNWDIR_HANDLE; oldFileName: Pnstr8; searchAttrs: Tnuint8; newDirHandle: TNWDIR_HANDLE;
+ newFileName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWIntEraseFiles(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; searchAttrs: Tnuint8; augmentFlag: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetSparseFileBitMap(conn: TNWCONN_HANDLE; fileHandle: Tnuint32; flag: Tnint16; offset: Tnuint32; blockSize: pnuint32;
+ bitMap: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+
+function NWLogPhysicalRecord(fileHandle: TNWFILE_HANDLE; recStartOffset: Tnuint32; recLength: Tnuint32; lockFlags: Tnuint8; timeOut: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWLockPhysicalRecordSet(lockFlags: Tnuint8; timeOut: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWReleasePhysicalRecordSet: TNWCCODE; NWLIB_CALNLM32;
+function NWClearPhysicalRecordSet: TNWCCODE; NWLIB_CALNLM32;
+function NWReleasePhysicalRecord(fileHandle: TNWFILE_HANDLE; recStartOffset: Tnuint32; recSize: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWClearPhysicalRecord(fileHandle: TNWFILE_HANDLE; recStartOffset: Tnuint32; recSize: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWLockFileLockSet(timeOut: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWReleaseFileLockSet: TNWCCODE; NWLIB_CALNLM32;
+function NWClearFileLockSet: TNWCCODE; NWLIB_CALNLM32;
+function NWClearFileLock2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWReleaseFileLock2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWLogFileLock2(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; lockFlags: Tnuint8; timeOut: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWLogLogicalRecord(conn: TNWCONN_HANDLE; logRecName: Pnstr8; lockFlags: Tnuint8; timeOut: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWLockLogicalRecordSet(lockFlags: Tnuint8; timeOut: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWReleaseLogicalRecordSet: TNWCCODE; NWLIB_CALNLM32;
+function NWClearLogicalRecordSet: TNWCCODE; NWLIB_CALNLM32;
+function NWReleaseLogicalRecord(conn: TNWCONN_HANDLE; logRecName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWClearLogicalRecord(conn: TNWCONN_HANDLE; logRecName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseFile(fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCreateFile(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; fileAttrs: Tnuint8; fileHandle: PNWFILE_HANDLE;
+ createFlag: Tnflag32): TNWCCODE; NWLIB_UNKNOWN;
+function NWOpenFile(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; searchAttr: Tnuint16; accessRights: Tnuint8;
+ fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_UNKNOWN;
+function NWReadFile(fileHandle: TNWFILE_HANDLE; bytesToRead: Tnuint32; bytesActuallyRead: pnuint32; data: pnuint8): TNWCCODE; NWLIB_UNKNOWN;
+function NWWriteFile(fileHandle: TNWFILE_HANDLE; bytesToWrite: Tnuint32; data: pnuint8): TNWCCODE; NWLIB_UNKNOWN;
+function NWCommitFile(fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetEOF(fileHandle: TNWFILE_HANDLE; getEOF: pnuint32): TNWCCODE; NWLIB_UNKNOWN;
+function NWSetEOF(fileHandle: TNWFILE_HANDLE; setEOF: Tnuint32): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetFilePos(fileHandle: TNWFILE_HANDLE; filePos: pnuint32): TNWCCODE; NWLIB_UNKNOWN;
+function NWSetFilePos(fileHandle: TNWFILE_HANDLE; mode: Tnuint; filePos: Tnuint32): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetFileDirEntryNumber(fileHandle: TNWFILE_HANDLE; volumeNum: pnuint32; directoryEntry: pnuint32; DOSDirectoryEntry: pnuint32; nameSpace: pnuint32;
+ dataStream: pnuint32; parentDirEntry: pnuint32; parentDOSDirEntry: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirectoryEntryNumber(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; volumeNum: pnuint32; directoryEntry: pnuint32; DOSDirectoryEntry: pnuint32;
+ nameSpace: pnuint32; parentDirEntry: pnuint32; parentDOSDirEntry: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSFileDirEntryNumber(fileHandle: TNWFILE_HANDLE; nameSpace: Tnuint8; volumeNum: pnuint32; directoryEntry: pnuint32; dataStream: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwmisc.h
+//*****************************************************************************
+
+const
+ NW_SHORT_NAME_SERVER = 0;
+ NW_LONG_NAME_SERVER = 1;
+ NW_ENCP_SERVER = 1;
+ NW_EXTENDED_NCP_SERVER = 1;
+ _NETX_COM = $0001;
+ _NETX_VLM = $0002;
+ _REDIR_LOADED = $4000;
+ _VLM_LOADED = $8000;
+
+type
+ PNW_DATE = ^TNW_DATE;
+ TNW_DATE = record
+ day: Tnuint8;
+ month: Tnuint8;
+ year: Tnuint16;
+ end;
+ { hours is a word so that this structure will be the same length as a dword }
+
+ PNW_TIME = ^TNW_TIME;
+ TNW_TIME = record
+ seconds: Tnuint8;
+ minutes: Tnuint8;
+ hours: Tnuint16;
+ end;
+
+ PNW_REQUESTER_TYPE = ^TNW_REQUESTER_TYPE;
+ TNW_REQUESTER_TYPE = Longint;
+const
+ NW_LONG_NAME_REQUESTER = 0;
+ NW_SHORT_NAME_REQUESTER = 1;
+ NW_ERROR_ON_REQUESTER_TYPE = 2;
+type
+
+ PNW_FRAGMENT = ^TNW_FRAGMENT;
+ TNW_FRAGMENT = record
+ fragAddress: Tnptr;
+ fragSize: Tnuint32;
+ fragSize16: Tnuint16;
+ end;
+
+ PCONN_TASK = ^TCONN_TASK;
+ TCONN_TASK = record
+ taskNumber: Tnuint16;
+ taskState: Tnuint8;
+ end;
+ { use NW_ constants from nwserver.h }
+ { this field is only valid in 3.11 }
+ { this field is only valid in 3.11 }
+ { this field is only valid in 2.x }
+
+ PCONN_TASK_INFO = ^TCONN_TASK_INFO;
+ TCONN_TASK_INFO = record
+ serverVersion: Tnuint16;
+ lockState: Tnuint8;
+ waitingTaskNumber: Tnuint16;
+ recordStart: Tnuint32;
+ recordEnd: Tnuint32;
+ volNumber: Tnuint8;
+ dirEntry: Tnuint32;
+ nameSpace: Tnuint8;
+ dirID: Tnuint16;
+ lockedName: array[0..255] of Tnstr8;
+ taskCount: Tnuint8;
+ tasks: array[0..255] of TCONN_TASK;
+ end;
+
+ PDIR_ENTRY = ^TDIR_ENTRY;
+ TDIR_ENTRY = record
+ volNumber: Tnuint8;
+ dirEntry: Tnuint32;
+ end;
+
+procedure NWUnpackDateTime(dateTime: Tnuint32; sDate: PNW_DATE; sTime: PNW_TIME); NWLIB_CALNLM32;
+procedure NWUnpackDate(date: Tnuint16; sDate: PNW_DATE); NWLIB_CALNLM32;
+procedure NWUnpackTime(time: Tnuint16; sTime: PNW_TIME); NWLIB_CALNLM32;
+function NWPackDateTime(sDate: PNW_DATE; sTime: PNW_TIME): Tnuint32; NWLIB_CALNLM32;
+function NWPackDate(sDate: PNW_DATE): Tnuint16; NWLIB_CALNLM32;
+function NWPackTime(sTime: PNW_TIME): Tnuint16; NWLIB_CALNLM32;
+ { Avoid using the following three NWConvertDate/Time functions,
+ they just call the NWUnpackDate/Time functions. They are here for
+ compatibility reasons only. }
+procedure NWConvertDateTime(dateTime: Tnuint32; sDate: PNW_DATE; sTime: PNW_TIME); NWLIB_CALNLM32;
+procedure NWConvertDate(date: Tnuint16; sDate: PNW_DATE); NWLIB_CALNLM32;
+procedure NWConvertTime(time: Tnuint16; sTime: PNW_TIME); NWLIB_CALNLM32;
+function NWRequest(conn: TNWCONN_HANDLE; _function: Tnuint16; numReqFrags: Tnuint16; reqFrags: PNW_FRAGMENT; numReplyFrags: Tnuint16;
+ replyFrags: PNW_FRAGMENT): TNWCCODE; NWLIB_CALNLM32;
+function _NWGetRequesterType(_type: PNW_REQUESTER_TYPE): TNWCCODE; NWLIB_CALNLM32;
+function NWWordSwap(swapWord: Tnuint16): Tnuint16; NWLIB_CALNLM32;
+function NWLongSwap(swapLong: Tnuint32): Tnuint32; NWLIB_CALNLM32;
+function NWInitDBCS: Tnint16; NWLIB_UNKNOWN;
+function NWConvertPathToDirEntry(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; dirEntry: PDIR_ENTRY): TNWCCODE; NWLIB_CALNLM32;
+function NWGetTaskInformationByConn(conn: TNWCONN_HANDLE; connNum: Tnuint16; taskInfo: PCONN_TASK_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetRequesterVersion(majorVer: pnuint8; minorVer: pnuint8; revision: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWIsLNSSupportedOnVolume(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWConvertFileHandle(fileHandle: TNWFILE_HANDLE; handleType: Tnuint16; NWHandle: pnuint8; conn: PNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWConvertFileHandleConnRef(fileHandle: TNWFILE_HANDLE; handleType: Tnuint16; NWHandle: pnuint8; connRef: pnuint32): TNWCCODE; NWLIB_UNKNOWN;
+procedure _NWConvert4ByteTo6ByteHandle(NW4ByteHandle: pnuint8; NW6ByteHandle: pnuint8); NWLIB_CALNLM32;
+function NWEndOfJob: TNWCCODE; NWLIB_UNKNOWN;
+function NWCallsInit(reserved1: Tnptr; reserved2: Tnptr): TNWCCODE; NWLIB_CALNLM32;
+function NWCallsTerm(reserved: Tnptr): TNWCCODE; NWLIB_CALNLM32;
+function NWGetClientType: Tnuint16; NWLIB_CALNLM32;
+function __NWGetNWCallsState: Tnuint16; NWLIB_UNKNOWN;
+function NWSetNetWareErrorMode(errorMode: Tnuint8; prevMode: pnuint8): TNWCCODE; NWLIB_UNKNOWN;
+function NWSetEndOfJobStatus(endOfJobStatus: Tnuint8; prevStatus: pnuint8): TNWCCODE; NWLIB_UNKNOWN;
+procedure NWGetNWCallsVersion(majorVer: pnuint8; minorVer: pnuint8; revLevel: pnuint8; betaLevel: pnuint8); NWLIB_CALNLM32;
+function NWConvertHandle(conn: TNWCONN_HANDLE; accessMode: Tnuint8; NWHandle: pointer; handleSize: Tnuint16; fileSize: Tnuint32;
+ fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwmsg.h
+//*****************************************************************************
+
+function NWDisableBroadcasts(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWEnableBroadcasts(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWSendBroadcastMessage(conn: TNWCONN_HANDLE; message: Pnstr8; connCount: Tnuint16; connList: Pnuint16; resultList: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetBroadcastMessage(conn: TNWCONN_HANDLE; message: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetBroadcastMode(conn: TNWCONN_HANDLE; mode: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWBroadcastToConsole(conn: TNWCONN_HANDLE; message: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSendConsoleBroadcast(conn: TNWCONN_HANDLE; message: Pnstr8; connCount: Tnuint16; connList: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+//*****************************************************************************
+//nwnamspc.h
+//*****************************************************************************
+
+const
+ SUCCESSFUL = 0;
+ MORE_NS_TO_READ = 0;
+ NO_EXTENDED_NS_INFO = 9;
+ NS_EOF = $8910;
+ NW_NS_DOS = 0;
+ NW_NS_MAC = 1;
+ NW_NS_NFS = 2;
+ NW_NS_FTAM = 3;
+ NW_NS_OS2 = 4;
+ NW_NS_LONG = 4;
+ NW_DS_DOS = 0;
+ NW_DS_MAC = 1;
+ NW_DS_FTAM = 2;
+
+type
+ PNWNSINFO = ^TNWNSINFO;
+ TNWNSINFO = record
+ NSInfoBitMask: Tnuint32;
+ fixedBitMask: Tnuint32;
+ reservedBitMask: Tnuint32;
+ extendedBitMask: Tnuint32;
+ fixedBitsDefined: Tnuint16;
+ reservedBitsDefined: Tnuint16;
+ extendedBitsDefined: Tnuint16;
+ fieldsLenTable: array[0..31] of Tnuint32;
+ hugeStateInfo: array[0..15] of Tnuint8;
+ hugeDataLength: Tnuint32;
+ end;
+ TNW_NS_INFO = TNWNSINFO;
+ PNW_NS_INFO = ^TNW_NS_INFO;
+
+ PNW_ENTRY_INFO = ^TNW_ENTRY_INFO;
+ TNW_ENTRY_INFO = record
+ spaceAlloc: Tnuint32;
+ attributes: Tnuint32;
+ flags: Tnuint16;
+ dataStreamSize: Tnuint32;
+ totalStreamSize: Tnuint32;
+ numberOfStreams: Tnuint16;
+ creationTime: Tnuint16;
+ creationDate: Tnuint16;
+ creatorID: Tnuint32;
+ modifyTime: Tnuint16;
+ modifyDate: Tnuint16;
+ modifierID: Tnuint32;
+ lastAccessDate: Tnuint16;
+ archiveTime: Tnuint16;
+ archiveDate: Tnuint16;
+ archiverID: Tnuint32;
+ inheritedRightsMask: Tnuint16;
+ dirEntNum: Tnuint32;
+ DosDirNum: Tnuint32;
+ volNumber: Tnuint32;
+ EADataSize: Tnuint32;
+ EAKeyCount: Tnuint32;
+ EAKeySize: Tnuint32;
+ NSCreator: Tnuint32;
+ nameLength: Tnuint8;
+ entryName: array[0..255] of Tnstr8;
+ end;
+ { 255*3 + 1 }
+
+ PNW_ENTRY_INFO_EXT = ^TNW_ENTRY_INFO_EXT;
+ TNW_ENTRY_INFO_EXT = record
+ spaceAlloc: Tnuint32;
+ attributes: Tnuint32;
+ flags: Tnuint16;
+ dataStreamSize: Tnuint32;
+ totalStreamSize: Tnuint32;
+ numberOfStreams: Tnuint16;
+ creationTime: Tnuint16;
+ creationDate: Tnuint16;
+ creatorID: Tnuint32;
+ modifyTime: Tnuint16;
+ modifyDate: Tnuint16;
+ modifierID: Tnuint32;
+ lastAccessDate: Tnuint16;
+ archiveTime: Tnuint16;
+ archiveDate: Tnuint16;
+ archiverID: Tnuint32;
+ inheritedRightsMask: Tnuint16;
+ dirEntNum: Tnuint32;
+ DosDirNum: Tnuint32;
+ volNumber: Tnuint32;
+ EADataSize: Tnuint32;
+ EAKeyCount: Tnuint32;
+ EAKeySize: Tnuint32;
+ NSCreator: Tnuint32;
+ nameLength: Tnuint16;
+ entryName: array[0..765] of Tnstr8;
+ end;
+
+ PNW_DATA_STREAM_FAT_INFO = ^TNW_DATA_STREAM_FAT_INFO;
+ TNW_DATA_STREAM_FAT_INFO = record
+ dataStreamNumber: Tnuint32;
+ dataStreamFATBlocksSize: Tnuint32;
+ end;
+
+ PNW_DATA_STREAM_SIZE_INFO = ^TNW_DATA_STREAM_SIZE_INFO;
+ TNW_DATA_STREAM_SIZE_INFO = record
+ dataStreamNumber: Tnuint32;
+ dataStreamSize: Tnuint32;
+ end;
+
+ PNW_MAC_TIME = ^TNW_MAC_TIME;
+ TNW_MAC_TIME = record
+ MACCreateTime: Tnuint32;
+ MACBackupTime: Tnuint32;
+ end;
+
+ PNW_ENTRY_INFO2 = ^TNW_ENTRY_INFO2;
+ TNW_ENTRY_INFO2 = record
+ spaceAlloc: Tnuint32;
+ attributes: Tnuint32;
+ flags: Tnuint16;
+ dataStreamSize: Tnuint32;
+ totalStreamSize: Tnuint32;
+ numberOfStreams: Tnuint16;
+ EADataSize: Tnuint32;
+ EAKeyCount: Tnuint32;
+ EAKeySize: Tnuint32;
+ archiveTime: Tnuint16;
+ archiveDate: Tnuint16;
+ archiverID: Tnuint32;
+ modifyTime: Tnuint16;
+ modifyDate: Tnuint16;
+ modifierID: Tnuint32;
+ lastAccessDate: Tnuint16;
+ creationTime: Tnuint16;
+ creationDate: Tnuint16;
+ creatorID: Tnuint32;
+ NSCreator: Tnuint32;
+ dirEntNum: Tnuint32;
+ DosDirNum: Tnuint32;
+ volNumber: Tnuint32;
+ inheritedRightsMask: Tnuint16;
+ currentReferenceID: Tnuint16;
+ NSFileAttributes: Tnuint32;
+ numberOfDataStreamFATInfo: Tnuint32;
+ dataStreamFATInfo: array[0..2] of TNW_DATA_STREAM_FAT_INFO;
+ numberOfDataStreamSizeInfo: Tnuint32;
+ dataStreamSizeInfo: array[0..2] of TNW_DATA_STREAM_SIZE_INFO;
+ secondsRelativeToTheYear2000: Tnint32;
+ DOSNameLen: Tnuint8;
+ DOSName: array[0..12] of Tnstr8;
+ flushTime: Tnuint32;
+ parentBaseID: Tnuint32;
+ MacFinderInfo: array[0..31] of Tnuint8;
+ siblingCount: Tnuint32;
+ effectiveRights: Tnuint32;
+ MacTime: TNW_MAC_TIME;
+ lastAccessedTime: Tnuint16;
+ nameLength: Tnuint8;
+ entryName: array[0..255] of Tnstr8;
+ end;
+
+ PMODIFY_DOS_INFO = ^TMODIFY_DOS_INFO;
+ TMODIFY_DOS_INFO = record
+ attributes: Tnuint32;
+ createDate: Tnuint16;
+ createTime: Tnuint16;
+ creatorID: Tnuint32;
+ modifyDate: Tnuint16;
+ modifyTime: Tnuint16;
+ modifierID: Tnuint32;
+ archiveDate: Tnuint16;
+ archiveTime: Tnuint16;
+ archiverID: Tnuint32;
+ lastAccessDate: Tnuint16;
+ inheritanceGrantMask: Tnuint16;
+ inheritanceRevokeMask: Tnuint16;
+ maximumSpace: Tnuint32;
+ end;
+
+ PSEARCH_SEQUENCE = ^TSEARCH_SEQUENCE;
+ TSEARCH_SEQUENCE = record
+ volNumber: Tnuint8;
+ dirNumber: Tnuint32;
+ searchDirNumber: Tnuint32;
+ end;
+
+ PNW_NS_PATH = ^TNW_NS_PATH;
+ TNW_NS_PATH = record
+ srcPath,
+ dstPath: Pnstr8;
+ dstPathSize: Tnuint16;
+ end;
+
+ PNW_NS_OPENCREATE = ^TNW_NS_OPENCREATE;
+ TNW_NS_OPENCREATE = record
+ openCreateMode: Tnuint8;
+ searchAttributes: Tnuint16;
+ reserved: Tnuint32;
+ createAttributes: Tnuint32;
+ accessRights: Tnuint16;
+ NetWareHandle: Tnuint32;
+ openCreateAction: Tnuint8;
+ end;
+ TNW_NS_OPEN = TNW_NS_OPENCREATE;
+ PNW_NS_OPEN = ^TNW_NS_OPEN;
+ { open/create modes }
+
+const
+ OC_MODE_OPEN = $01;
+ OC_MODE_TRUNCATE = $02;
+ OC_MODE_REPLACE = $02;
+ OC_MODE_CREATE = $08;
+ { open/create results }
+ OC_ACTION_NONE = $00;
+ OC_ACTION_OPEN = $01;
+ OC_ACTION_CREATE = $02;
+ OC_ACTION_TRUNCATE = $04;
+ OC_ACTION_REPLACE = $04;
+ { return info mask }
+ IM_NAME = $0001;
+ IM_ENTRY_NAME = $0001;
+ IM_SPACE_ALLOCATED = $0002;
+ IM_ATTRIBUTES = $0004;
+ IM_SIZE = $0008;
+ IM_TOTAL_SIZE = $0010;
+ IM_EA = $0020;
+ IM_ARCHIVE = $0040;
+ IM_MODIFY = $0080;
+ IM_CREATION = $0100;
+ IM_OWNING_NAMESPACE = $0200;
+ IM_DIRECTORY = $0400;
+ IM_RIGHTS = $0800;
+ IM_ALMOST_ALL = $0FED;
+ IM_ALL = $0FFF;
+ IM_REFERENCE_ID = $1000;
+ IM_NS_ATTRIBUTES = $2000;
+ IM_DATASTREAM_SIZES = $4000;
+ IM_DATASTREAM_ACTUAL = $4000;
+ IM_DATASTREAM_LOGICAL = $8000;
+ IM_LASTUPDATEDINSECONDS = $00010000;
+ IM_DOSNAME = $00020000;
+ IM_FLUSHTIME = $00040000;
+ IM_PARENTBASEID = $00080000;
+ IM_MACFINDER = $00100000;
+ IM_SIBLINGCOUNT = $00200000;
+ IM_EFECTIVERIGHTS = $00400000;
+ IM_MACTIME = $00800000;
+ IM_LASTACCESSEDTIME = $01000000;
+ IM_EXTENDED_ALL = $01FFF000;
+ IM_NSS_LARGE_SIZES = $40000000;
+ IM_COMPRESSED_INFO = $80000000;
+ IM_NS_SPECIFIC_INFO = $80000000;
+ { access rights attributes }
+
+const
+ NW_TYPE_FILE = $8000;
+ NW_TYPE_SUBDIR = $0010;
+ NW_NAME_CONVERT = $03;
+ NW_NO_NAME_CONVERT = $04;
+ { modify mask - use with MODIFY_DOS_INFO structure }
+ DM_FILENAME = $0001;
+ DM_ATTRIBUTES = $0002;
+ DM_CREATE_DATE = $0004;
+ DM_CREATE_TIME = $0008;
+ DM_CREATOR_ID = $0010;
+ DM_ARCHIVE_DATE = $0020;
+ DM_ARCHIVE_TIME = $0040;
+ DM_ARCHIVER_ID = $0080;
+ DM_MODIFY_DATE = $0100;
+ DM_MODIFY_TIME = $0200;
+ DM_MODIFIER_ID = $0400;
+ DM_LAST_ACCESS_DATE = $0800;
+ DM_INHERITED_RIGHTS_MASK = $1000;
+ DM_MAXIMUM_SPACE = $2000;
+
+{$IF defined( N_PLAT_NLM )}
+ {const
+ NWGetNSLoadedList = NWGetNSLoadedList2;
+ NWGetNSInfo = NWGetNSInfo2;}
+{$ENDIF}
+
+
+function NWGetDirectoryBase(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; dstNamSpc: Tnuint8; idxStruct: PNW_IDX): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirectoryBaseExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; dstNamSpc: Tnuint8; idxStruct: PNW_IDX): TNWCCODE; NWLIB_CALNLM32;
+function NWScanNSEntryInfo(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; attrs: Tnuint16; sequence: PSEARCH_SEQUENCE;
+ searchPattern: Pnstr8; retInfoMask: Tnuint32; entryInfo: PNW_ENTRY_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWScanNSEntryInfoExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; attrs: Tnuint16; sequence: PSEARCH_SEQUENCE;
+ searchPattern: Pnstr8; retInfoMask: Tnuint32; entryInfo: PNW_ENTRY_INFO_EXT): TNWCCODE; NWLIB_CALNLM32;
+function NWScanNSEntryInfo2(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; attrs: Tnuint16; sequence: PSEARCH_SEQUENCE;
+ searchPattern: Pnstr8; retInfoMask: Tnuint32; entryInfo2: PNW_ENTRY_INFO2): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSLoadedList(conn: TNWCONN_HANDLE; volNum: Tnuint8; maxListLen: Tnuint8; NSLoadedList: pnuint8; actualListLen: pnuint8): TNWCCODE; NWLIB_CLIB;
+function NWGetOwningNameSpace(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; namSpc: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenCreateNSEntry(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; path: Pnstr8; NSOpenCreate: PNW_NS_OPENCREATE;
+ fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenCreateNSEntryExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; path: Pnstr8; NSOpenCreate: PNW_NS_OPENCREATE;
+ fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenNSEntry(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; dataStream: Tnuint8; path: Pnstr8;
+ NSOpen: PNW_NS_OPEN; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenNSEntryExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; dataStream: Tnuint8; path: Pnstr8;
+ NSOpen: PNW_NS_OPEN; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWSetLongName(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; dstPath: Pnstr8; dstType: Tnuint16;
+ longName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLongName(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; srcNamSpc: Tnuint8; dstNamSpc: Tnuint8;
+ longName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLongNameExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; srcNamSpc: Tnuint8; dstNamSpc: Tnuint8;
+ longName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSInfo(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO): TNWCCODE; NWLIB_CLIB;
+function NWWriteNSInfo(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO; data: Pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWWriteNSInfoExt(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO; data: Pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWWriteExtendedNSInfo(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO; data: Pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWReadNSInfo(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO; data: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWReadNSInfoExt(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO; data: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWReadExtendedNSInfo(conn: TNWCONN_HANDLE; idxStruct: PNW_IDX; NSInfo: PNW_NS_INFO; data: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSPath(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; fileFlag: Tnuint16; srcNamSpc: Tnuint8; dstNamSpc: Tnuint8;
+ NSPath: PNW_NS_PATH): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSPathExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; fileFlag: Tnuint16; srcNamSpc: Tnuint8; dstNamSpc: Tnuint8;
+ NSPath: PNW_NS_PATH): TNWCCODE; NWLIB_CALNLM32;
+function NWAllocTempNSDirHandle2(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; namSpc: Tnuint8; newDirHandle: pnuint8;
+ newNamSpc: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWAllocTempNSDirHandle2Ext(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; namSpc: Tnuint8; newDirHandle: pnuint8;
+ newNamSpc: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSEntryInfo(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; srcNamSpc: Tnuint8; dstNamSpc: Tnuint8;
+ searchAttrs: Tnuint16; retInfoMask: Tnuint32; entryInfo: PNW_ENTRY_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNSEntryInfoExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; srcNamSpc: Tnuint8; dstNamSpc: Tnuint8;
+ searchAttrs: Tnuint16; retInfoMask: Tnuint32; entryInfo: PNW_ENTRY_INFO_EXT): TNWCCODE; NWLIB_CALNLM32;
+function NWNSGetMiscInfo(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; dstNameSpace: Tnuint8; idxStruct: PNW_IDX): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenDataStream(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; fileName: Pnstr8; dataStream: Tnuint16; attrs: Tnuint16;
+ accessMode: Tnuint16; NWHandle: pnuint32; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWNSRename(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; oldName: Pnstr8; oldType: Tnuint16;
+ newName: Pnstr8; renameFlag: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWNSRenameExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; namSpc: Tnuint8; oldName: Pnstr8; oldType: Tnuint16;
+ newName: Pnstr8; renameFlag: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetNSEntryDOSInfo(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; namSpc: Tnuint8; searchAttrs: Tnuint16;
+ modifyDOSMask: Tnuint32; dosInfo: PMODIFY_DOS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWSetNSEntryDOSInfoExt(conn: TNWCONN_HANDLE; dirHandle: Tnuint8; path: Pnstr8; namSpc: Tnuint8; searchAttrs: Tnuint16;
+ modifyDOSMask: Tnuint32; dosInfo: PMODIFY_DOS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFullPath(conn: TNWCONN_HANDLE; volNum: Tnuint8; dirBase: Tnuint32; handleFlag: Tnuint16; srcNamSpc: Tnint;
+ dstNamSpc: Tnint; maxPathLen: Tnuint16; path: Pnstr8; pathType: pnuint16): TNWCCODE; NWLIB_UNKNOWN;
+function NWDeleteNSEntry(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; nameSpace: Tnuint8; searchAttr: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWDeleteNSEntryExt(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; fileName: Pnstr8; nameSpace: Tnuint8; searchAttr: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWNSGetDefaultNS(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; pbuDefaultNameSpace: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWScanNSEntryInfoSet(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; buNameSpace: Tnuint8; suAttr: Tnuint16; pIterHnd: PSEARCH_SEQUENCE;
+ pbstrSrchPattern: Pnstr8; luRetMask: Tnuint32; pbuMoreEntriesFlag: pnuint8; psuNumReturned: pnuint16; suNumItems: Tnuint16;
+ pEntryInfo: PNW_ENTRY_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWAddTrusteeToNSDirectory(conn: TNWCONN_HANDLE; namSpc: Tnuint8; dirHandle: TNWDIR_HANDLE; path: Pnstr8; trusteeID: Tnuint32;
+ rightsMask: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWDeleteTrusteeFromNSDirectory(conn: TNWCONN_HANDLE; namSpc: Tnuint8; dirHandle: TNWDIR_HANDLE; dirPath: Pnstr8; objID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWScanNSDirectoryForTrustees(conn: TNWCONN_HANDLE; namSpc: Tnuint8; dirHandle: TNWDIR_HANDLE; pbstrSrchPath: Pnstr8; pluIterHnd: pnuint32;
+ pbstrDirName: Pnstr8; pluDirDateTime: pnuint32; pluOwnerID: pnuint32; trusteeList: PTRUSTEE_INFO): TNWCCODE; NWLIB_CALNLM32;
+
+function SetCurrentNameSpace(newNameSpace: Tnuint8): Tnuint8; NWLIB_CLIB;
+function SetTargetNameSpace(newNameSpace: Tnuint8): Tnuint8; NWLIB_CLIB;
+
+//*****************************************************************************
+//nwprint.h
+//*****************************************************************************
+
+const
+ LPT1 = 1;
+ LPT2 = 2;
+ LPT3 = 3;
+ LPT4 = 4;
+ LPT5 = 5;
+ LPT6 = 6;
+ LPT7 = 7;
+ LPT8 = 8;
+ LPT9 = 9;
+ START_CAPTURE = 1;
+ END_CAPTURE = 2;
+ CANCEL_CAPTURE = 3;
+ GET_PRINT_JOB_FLAGS = 4;
+ SET_PRINT_JOB_FLAGS = 5;
+ GET_BANNER_USER_NAME = 6;
+ SET_BANNER_USER_NAME = 7;
+ GET_PRINTER_SETUP_STRING = 8;
+ SET_PRINTER_SETUP_STRING = 9;
+ GET_PRINTER_RESET_STRING = 10;
+ SET_PRINTER_RESET_STRING = 11;
+ { must be set to zeros }
+type
+
+ PPrintJobStruct = ^TPrintJobStruct;
+ TPrintJobStruct = record
+ clientStation: Tnuint8;
+ clientTask: Tnuint8;
+ clientID: Tnuint32;
+ targetServerID: Tnuint32;
+ targetExecutionTime: array[0..5] of Tnuint8;
+ jobEntryTime: array[0..5] of Tnuint8;
+ jobNumber: Tnuint16;
+ formType: Tnuint16;
+ jobPosition: Tnuint8;
+ jobControlFlags: Tnuint8;
+ jobFileName: array[0..13] of Tnuint8;
+ jobFileHandle: array[0..5] of Tnuint8;
+ servicingServerStation: Tnuint8;
+ servicingServerTask: Tnuint8;
+ servicingServerID: Tnuint32;
+ jobDescription: array[0..49] of Tnuint8;
+ clientJobInfoVer: Tnuint8;
+ tabSize: Tnuint8;
+ numberCopies: Tnuint16;
+ printFlags: Tnuint16;
+ maxLines: Tnuint16;
+ maxChars: Tnuint16;
+ formName: array[0..15] of Tnuint8;
+ reserved: array[0..5] of Tnuint8;
+ bannerUserName: array[0..12] of Tnuint8;
+ bannerFileName: array[0..12] of Tnuint8;
+ bannerHeaderFileName: array[0..13] of Tnuint8;
+ filePathName: array[0..79] of Tnuint8;
+ end;
+ { must be set to zeros }
+
+ PNWPrintJobStruct = ^TNWPrintJobStruct;
+ TNWPrintJobStruct = record
+ clientStation: Tnuint32;
+ clientTask: Tnuint32;
+ clientID: Tnuint32;
+ targetServerID: Tnuint32;
+ targetExecutionTime: array[0..5] of Tnuint8;
+ jobEntryTime: array[0..5] of Tnuint8;
+ jobNumber: Tnuint32;
+ formType: Tnuint16;
+ jobPosition: Tnuint16;
+ jobControlFlags: Tnuint16;
+ jobFileName: array[0..13] of Tnuint8;
+ jobFileHandle: Tnuint32;
+ servicingServerStation: Tnuint32;
+ servicingServerTask: Tnuint32;
+ servicingServerID: Tnuint32;
+ jobDescription: array[0..49] of Tnuint8;
+ clientJobInfoVer: Tnuint8;
+ tabSize: Tnuint8;
+ numberCopies: Tnuint16;
+ printFlags: Tnuint16;
+ maxLines: Tnuint16;
+ maxChars: Tnuint16;
+ formName: array[0..15] of Tnuint8;
+ reserved: array[0..5] of Tnuint8;
+ bannerUserName: array[0..12] of Tnuint8;
+ bannerFileName: array[0..12] of Tnuint8;
+ bannerHeaderFileName: array[0..13] of Tnuint8;
+ filePathName: array[0..79] of Tnuint8;
+ end;
+
+ PPRINTER_STATUS = ^TPRINTER_STATUS;
+ TPRINTER_STATUS = record
+ printerHalted: Tnuint8;
+ printerOffline: Tnuint8;
+ currentFormType: Tnuint8;
+ redirectedPrinter: Tnuint8;
+ end;
+ { OS/2, VLM only }
+ { VLM returns or sets only 12 characters }
+ { plus the NULL -- a total of 13 byte's }
+ { OS/2, VLM only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+
+ PNWCAPTURE_FLAGSRW = ^TNWCAPTURE_FLAGSRW;
+ TNWCAPTURE_FLAGSRW = record
+ jobDescription: array[0..49] of Tnuint8;
+ jobControlFlags: Tnuint8;
+ tabSize: Tnuint8;
+ numCopies: Tnuint16;
+ printFlags: Tnuint16;
+ maxLines: Tnuint16;
+ maxChars: Tnuint16;
+ formName: array[0..12] of Tnuint8;
+ reserved: array[0..8] of Tnuint8;
+ formType: Tnuint16;
+ bannerText: array[0..12] of Tnuint8;
+ reserved2: Tnuint8;
+ flushCaptureTimeout: Tnuint16;
+ flushCaptureOnClose: Tnuint8;
+ end;
+
+
+ TNWCAPTURE_FLAGS1 = TNWCAPTURE_FLAGSRW;
+ PNWCAPTURE_FLAGS1 = ^TNWCAPTURE_FLAGS1;
+
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { VLM only }
+
+
+ PNWCAPTURE_FLAGSRO = ^TNWCAPTURE_FLAGSRO;
+ TNWCAPTURE_FLAGSRO = record
+ connID: TNWCONN_HANDLE;
+ queueID: Tnuint32;
+ setupStringMaxLen: Tnuint16;
+ resetStringMaxLen: Tnuint16;
+ LPTCaptureFlag: Tnuint8;
+ fileCaptureFlag: Tnuint8;
+ timingOutFlag: Tnuint8;
+ inProgress: Tnuint8;
+ printQueueFlag: Tnuint8;
+ printJobValid: Tnuint8;
+ queueName: array[0..64] of Tnstr8;
+ end;
+
+
+ TNWCAPTURE_FLAGS2 = TNWCAPTURE_FLAGSRO;
+ PNWCAPTURE_FLAGS2 = ^TNWCAPTURE_FLAGS2;
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { DOS/WIN only }
+ { VLM only }
+type
+
+ PNWCAPTURE_FLAGSRO3 = ^TNWCAPTURE_FLAGSRO3;
+ TNWCAPTURE_FLAGSRO3 = record
+ connRef: Tnuint32;
+ queueID: Tnuint32;
+ setupStringMaxLen: Tnuint16;
+ resetStringMaxLen: Tnuint16;
+ LPTCaptureFlag: Tnuint8;
+ fileCaptureFlag: Tnuint8;
+ timingOutFlag: Tnuint8;
+ inProgress: Tnuint8;
+ printQueueFlag: Tnuint8;
+ printJobValid: Tnuint8;
+ queueName: array[0..64] of Tnstr8;
+ end;
+
+
+ TNWCAPTURE_FLAGS3 = TNWCAPTURE_FLAGSRO3;
+ PNWCAPTURE_FLAGS3 = ^TNWCAPTURE_FLAGS3;
+
+
+ PCaptureFlagsStruct = ^TCaptureFlagsStruct;
+ TCaptureFlagsStruct = record
+ status: Tnuint8;
+ flags: Tnuint8;
+ tabSize: Tnuint8;
+ serverPrinter: Tnuint8;
+ numberCopies: Tnuint8;
+ formType: Tnuint8;
+ reserved: Tnuint8;
+ bannerText: array[0..12] of Tnuint8;
+ reserved2: Tnuint8;
+ localLPTDevice: Tnuint8;
+ captureTimeOutCount: Tnuint16;
+ captureOnDeviceClose: Tnuint8;
+ end;
+
+function NWGetPrinterDefaults(status: pnuint8; flags: pnuint8; tabSize: pnuint8; serverPrinter: pnuint8; numberCopies: pnuint8;
+ formType: pnuint8; bannerText: Pnstr8; localLPTDevice: pnuint8; captureTimeOutCount: pnuint16; captureOnDeviceClose: pnuint8): TNWCCODE; NWLIB_UNKNOWN;
+function NWSetPrinterDefaults(flags: Tnuint8; tabSize: Tnuint8; serverPrinter: Tnuint8; numberCopies: Tnuint8; formType: Tnuint8;
+ bannerText: Pnstr8; localLPTDevice: Tnuint8; captureTimeOutCount: Tnuint16; captureOnDeviceClose: Tnuint8): TNWCCODE; NWLIB_UNKNOWN;
+function NWStartLPTCapture(deviceID: Tnuint16): TNWCCODE; NWLIB_UNKNOWN;
+function NWGetLPTCaptureStatus(conn: PNWCONN_HANDLE): TNWCCODE; NWLIB_UNKNOWN;
+
+function NWSpoolStartCapture(deviceID: Tnuint16; queueID: Tnuint32; conn: TNWCONN_HANDLE; scope: Tnuint16): TNWCCODE; NWLIB_UNKNOWN;
+function NWSpoolEndCapture(deviceID: Tnuint16; scope: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWSpoolCancelCapture(deviceID: Tnuint16; scope: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWSpoolGetBannerUserName(username: Pnstr8; mode: Tnuint16; scope: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWSpoolSetBannerUserName(username: Pnstr8; scope: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetPrinterStatus(conn: TNWCONN_HANDLE; printerNumber: Tnuint16; status: PPRINTER_STATUS): TNWCCODE; NWLIB_CALNLM32;
+function NWStartQueueCapture(conn: TNWCONN_HANDLE; LPTDevice: Tnuint8; queueID: Tnuint32; queueName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetCaptureStatus(LPTDevice: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWFlushCapture(LPTDevice: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWEndCapture(LPTDevice: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWCancelCapture(LPTDevice: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetBannerUserName(userName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetBannerUserName(userName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetCaptureFlags(LPTDevice: Tnuint8; captureFlags1: PNWCAPTURE_FLAGS1; captureFlags2: PNWCAPTURE_FLAGS2): TNWCCODE; NWLIB_CALNLM32;
+function NWGetCaptureFlagsConnRef(LPTDevice: Tnuint8; captureFlags1: PNWCAPTURE_FLAGS1; captureFlags3: PNWCAPTURE_FLAGS3): TNWCCODE; NWLIB_UNKNOWN;
+function NWSetCaptureFlags(conn: TNWCONN_HANDLE; LPTDevice: Tnuint8; captureFlags1: PNWCAPTURE_FLAGS1): TNWCCODE; NWLIB_CALNLM32;
+function NWGetPrinterStrings(LPTDevice: Tnuint8; setupStringLen: pnuint16; setupString: Pnstr8; resetStringLen: pnuint16; resetString: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetPrinterStrings(LPTDevice: Tnuint8; setupStringLen: Tnuint16; setupString: Pnstr8; resetStringLen: Tnuint16; resetString: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetMaxPrinters(numPrinters: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwqms.h
+//*****************************************************************************
+
+const
+ QF_AUTO_START = $08;
+ QF_ENTRY_RESTART = $10;
+ QF_ENTRY_OPEN = $20;
+ QF_USER_HOLD = $40;
+ QF_OPERATOR_HOLD = $80;
+ QS_CANT_ADD_JOBS = $01;
+ QS_SERVERS_CANT_ATTACH = $02;
+ QS_CANT_SERVICE_JOBS = $04;
+ {
+ This struct is taken from NLM platform in the nwqueue.h file. This
+ structure is the format for a print queue only. Other queue types
+ might have different structures. Used with the clientRecordArea field
+ in some of the structures listed below.
+ }
+type
+
+ PQueuePrintJobStruct = ^TQueuePrintJobStruct;
+ TQueuePrintJobStruct = record
+ versionNumber: Tnuint8;
+ tabSize: Tnuint8;
+ numberOfCopies: Tnuint16;
+ printControlFlags: Tnuint16;
+ maxLinesPerPage: Tnuint16;
+ maxCharsPerLine: Tnuint16;
+ formName: array[0..12] of Tnuint8;
+ reserve: array[0..8] of Tnuint8;
+ bannerNameField: array[0..12] of Tnuint8;
+ bannerFileField: array[0..12] of Tnuint8;
+ bannerFileName: array[0..13] of Tnuint8;
+ directoryPath: array[0..79] of Tnuint8;
+ end;
+
+ PQueueJobStruct = ^TQueueJobStruct;
+ TQueueJobStruct = record
+ clientStation: Tnuint8;
+ clientTask: Tnuint8;
+ clientID: Tnuint32;
+ targetServerID: Tnuint32;
+ targetExecutionTime: array[0..5] of Tnuint8;
+ jobEntryTime: array[0..5] of Tnuint8;
+ jobNumber: Tnuint16;
+ jobType: Tnuint16;
+ jobPosition: Tnuint8;
+ jobControlFlags: Tnuint8;
+ jobFileName: array[0..13] of Tnuint8;
+ jobFileHandle: array[0..5] of Tnuint8;
+ servicingServerStation: Tnuint8;
+ servicingServerTask: Tnuint8;
+ servicingServerID: Tnuint32;
+ jobDescription: array[0..49] of Tnuint8;
+ clientRecordArea: array[0..151] of Tnuint8;
+ end;
+
+ PReplyJobStruct = ^TReplyJobStruct;
+ TReplyJobStruct = record
+ clientStation: Tnuint8;
+ clientTask: Tnuint8;
+ clientID: Tnuint32;
+ targetServerID: Tnuint32;
+ targetExecutionTime: array[0..5] of Tnuint8;
+ jobEntryTime: array[0..5] of Tnuint8;
+ jobNumber: Tnuint16;
+ jobType: Tnuint16;
+ jobPosition: Tnuint8;
+ jobControlFlags: Tnuint8;
+ jobFileName: array[0..13] of Tnuint8;
+ jobFileHandle: array[0..5] of Tnuint8;
+ servicingServerStation: Tnuint8;
+ servicingServerTask: Tnuint8;
+ servicingServerID: Tnuint32;
+ end;
+
+ PNWQueueJobStruct = ^TNWQueueJobStruct;
+ TNWQueueJobStruct = record
+ clientStation: Tnuint32;
+ clientTask: Tnuint32;
+ clientID: Tnuint32;
+ targetServerID: Tnuint32;
+ targetExecutionTime: array[0..5] of Tnuint8;
+ jobEntryTime: array[0..5] of Tnuint8;
+ jobNumber: Tnuint32;
+ jobType: Tnuint16;
+ jobPosition: Tnuint16;
+ jobControlFlags: Tnuint16;
+ jobFileName: array[0..13] of Tnuint8;
+ jobFileHandle: Tnuint32;
+ servicingServerStation: Tnuint32;
+ servicingServerTask: Tnuint32;
+ servicingServerID: Tnuint32;
+ jobDescription: array[0..49] of Tnuint8;
+ clientRecordArea: array[0..151] of Tnuint8;
+ end;
+
+ PNWReplyJobStruct = ^TNWReplyJobStruct;
+ TNWReplyJobStruct = record
+ clientStation: Tnuint32;
+ clientTask: Tnuint32;
+ clientID: Tnuint32;
+ targetServerID: Tnuint32;
+ targetExecutionTime: array[0..5] of Tnuint8;
+ jobEntryTime: array[0..5] of Tnuint8;
+ jobNumber: Tnuint32;
+ jobType: Tnuint16;
+ jobPosition: Tnuint16;
+ jobControlFlags: Tnuint16;
+ jobFileName: array[0..13] of Tnuint8;
+ jobFileHandle: Tnuint32;
+ servicingServerStation: Tnuint32;
+ servicingServerTask: Tnuint32;
+ servicingServerID: Tnuint32;
+ end;
+ { 250 to hold job #'s for old NCP }
+
+ PQueueJobListReply = ^TQueueJobListReply;
+ TQueueJobListReply = record
+ totalQueueJobs: Tnuint32;
+ replyQueueJobNumbers: Tnuint32;
+ jobNumberList: array[0..249] of Tnuint32;
+ end;
+
+function NWCreateQueueFile(conn: TNWCONN_HANDLE; queueID: Tnuint32; job: PQueueJobStruct; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCreateQueueFile2(conn: TNWCONN_HANDLE; queueID: Tnuint32; job: PNWQueueJobStruct; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseFileAndStartQueueJob(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseFileAndStartQueueJob2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseFileAndAbortQueueJob(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseFileAndAbortQueueJob2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWRemoveJobFromQueue(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWRemoveJobFromQueue2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetQueueJobList(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobCount: pnuint16; jobList: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetQueueJobList2(conn: TNWCONN_HANDLE; queueID: Tnuint32; queueStartPos: Tnuint32; job: PQueueJobListReply): TNWCCODE; NWLIB_CALNLM32;
+function NWReadQueueJobEntry(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16; job: PQueueJobStruct): TNWCCODE; NWLIB_CALNLM32;
+function NWReadQueueJobEntry2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32; job: PNWQueueJobStruct): TNWCCODE; NWLIB_CALNLM32;
+function NWGetQueueJobFileSize(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16; fileSize: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetQueueJobFileSize2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32; fileSize: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+function NWChangeQueueJobEntry(conn: TNWCONN_HANDLE; queueID: Tnuint32; job: PQueueJobStruct): TNWCCODE; NWLIB_CALNLM32;
+
+function NWChangeQueueJobEntry2(conn: TNWCONN_HANDLE; queueID: Tnuint32; job: PNWQueueJobStruct): TNWCCODE; NWLIB_CALNLM32;
+function NWChangeQueueJobPosition(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16; newJobPos: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWChangeQueueJobPosition2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32; newJobPos: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWServiceQueueJob(conn: TNWCONN_HANDLE; queueID: Tnuint32; targetJobType: Tnuint16; job: PQueueJobStruct; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWServiceQueueJob2(conn: TNWCONN_HANDLE; queueID: Tnuint32; targetJobType: Tnuint16; job: PNWQueueJobStruct; fileHandle: PNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWAbortServicingQueueJob(conn: TNWCONN_HANDLE; QueueID: Tnuint32; JobNumber: Tnuint16; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWAbortServicingQueueJob2(conn: TNWCONN_HANDLE; QueueID: Tnuint32; JobNumber: Tnuint32; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWChangeToClientRights(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWChangeToClientRights2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWFinishServicingQueueJob(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint16; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWFinishServicingQueueJob2(conn: TNWCONN_HANDLE; queueID: Tnuint32; jobNumber: Tnuint32; fileHandle: TNWFILE_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetPrinterQueueID(conn: TNWCONN_HANDLE; printerNum: Tnuint16; queueID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWCreateQueue(conn: TNWCONN_HANDLE; queueName: Pnstr8; queueType: Tnuint16; dirPath: Tnuint8; path: Pnstr8;
+ queueID: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWDestroyQueue(conn: TNWCONN_HANDLE; queueID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWReadQueueCurrentStatus(conn: TNWCONN_HANDLE; queueID: Tnuint32; queueStatus: pnuint8; numberOfJobs: pnuint16; numberOfServers: pnuint16;
+ serverIDlist: pnuint32; serverConnList: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWReadQueueCurrentStatus2(conn: TNWCONN_HANDLE; queueID: Tnuint32; queueStatus: pnuint32; numberOfJobs: pnuint32; numberOfServers: pnuint32;
+ serverIDlist: pnuint32; serverConnList: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWSetQueueCurrentStatus(conn: TNWCONN_HANDLE; queueID: Tnuint32; queueStatus: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetQueueCurrentStatus2(conn: TNWCONN_HANDLE; queueID: Tnuint32; queueStatus: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWReadQueueServerCurrentStatus(conn: TNWCONN_HANDLE; queueID: Tnuint32; serverID: Tnuint32; serverConn: Tnuint16; statusRec: Tnptr): TNWCCODE; NWLIB_CALNLM32;
+function NWReadQueueServerCurrentStatus2(conn: TNWCONN_HANDLE; queueID: Tnuint32; serverID: Tnuint32; serverConn: Tnuint32; statusRec: Tnptr): TNWCCODE; NWLIB_CALNLM32;
+function NWAttachQueueServerToQueue(conn: TNWCONN_HANDLE; queueID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWDetachQueueServerFromQueue(conn: TNWCONN_HANDLE; queueID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWRestoreQueueServerRights(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+
+function NWSetQueueServerCurrentStatus(conn: TNWCONN_HANDLE; queueID: Tnuint32; statusRec: pointer): TNWCCODE; NWLIB_CALNLM32;
+
+//*****************************************************************************
+//nwserver.h
+//*****************************************************************************
+
+const
+ LNS_CHECK = 0;
+ VERSION_CHECK = 1;
+ NW_2X = 0;
+ NW_30 = 1;
+ NW_311 = 2;
+ NW_32 = 3;
+ NW_40 = 4;
+type
+
+ PVERSION_INFO = ^TVERSION_INFO;
+ TVERSION_INFO = record
+ serverName: array[0..47] of Tnuint8;
+ fileServiceVersion: Tnuint8;
+ fileServiceSubVersion: Tnuint8;
+ maximumServiceConnections: Tnuint16;
+ connectionsInUse: Tnuint16;
+ maxNumberVolumes: Tnuint16;
+ revision: Tnuint8;
+ SFTLevel: Tnuint8;
+ TTSLevel: Tnuint8;
+ maxConnectionsEverUsed: Tnuint16;
+ accountVersion: Tnuint8;
+ VAPVersion: Tnuint8;
+ queueVersion: Tnuint8;
+ printVersion: Tnuint8;
+ virtualConsoleVersion: Tnuint8;
+ restrictionLevel: Tnuint8;
+ internetBridge: Tnuint8;
+ reserved: array[0..59] of Tnuint8;
+ end;
+
+ PNETWARE_PRODUCT_VERSION = ^TNETWARE_PRODUCT_VERSION;
+ TNETWARE_PRODUCT_VERSION = record
+ majorVersion: Tnuint16;
+ minorVersion: Tnuint16;
+ revision: Tnuint16;
+ end;
+ { Defines that are used for the NWCheckNetWareVersion call for values
+ that can be returned in the compatibilityFlag byte. }
+
+const
+ COMPATIBLE = $00;
+ VERSION_NUMBER_TOO_LOW = $01;
+ SFT_LEVEL_TOO_LOW = $02;
+ TTS_LEVEL_TOO_LOW = $04;
+
+function NWCheckConsolePrivileges(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWDownFileServer(conn: TNWCONN_HANDLE; forceFlag: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerDateAndTime(conn: TNWCONN_HANDLE; dateTimeBuffer: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWSetFileServerDateAndTime(conn: TNWCONN_HANDLE; year: Tnuint8; month: Tnuint8; day: Tnuint8; hour: Tnuint8;
+ minute: Tnuint8; second: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWCheckNetWareVersion(conn: TNWCONN_HANDLE; minVer: Tnuint16; minSubVer: Tnuint16; minRev: Tnuint16; minSFT: Tnuint16;
+ minTTS: Tnuint16; compatibilityFlag: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerVersionInfo(conn: TNWCONN_HANDLE; versBuffer: PVERSION_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNetWareProductVersion(conn: TNWCONN_HANDLE; version: PNETWARE_PRODUCT_VERSION): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerInformation(conn: TNWCONN_HANDLE; serverName: Pnstr8; majorVer: pnuint8; minVer: pnuint8; rev: pnuint8;
+ maxConns: pnuint16; maxConnsUsed: pnuint16; connsInUse: pnuint16; numVolumes: pnuint16; SFTLevel: pnuint8;
+ TTSLevel: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerExtendedInfo(conn: TNWCONN_HANDLE; accountingVer: pnuint8; VAPVer: pnuint8; queueingVer: pnuint8; printServerVer: pnuint8;
+ virtualConsoleVer: pnuint8; securityVer: pnuint8; internetBridgeVer: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function _NWGetFileServerType(conn: TNWCONN_HANDLE; typeFlag: Tnuint16; serverType: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWAttachToFileServer(serverName: Pnstr8; scopeFlag: Tnuint16; newConnID: PNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerLoginStatus(conn: TNWCONN_HANDLE; loginEnabledFlag: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWLogoutFromFileServer(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWLoginToFileServer(conn: TNWCONN_HANDLE; objName: Pnstr8; objType: Tnuint16; password: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWEnableFileServerLogin(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWDisableFileServerLogin(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerDescription(conn: TNWCONN_HANDLE; companyName: Pnstr8; revision: Pnstr8; revisionDate: Pnstr8; copyrightNotice: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWAttachToFileServerByConn(conn: TNWCONN_HANDLE; serverName: Pnstr8; scopeFlag: Tnuint16; newConnID: PNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNetworkSerialNumber(conn: TNWCONN_HANDLE; serialNum: pnuint32; appNum: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWIsManager(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwsync.h
+//*****************************************************************************
+
+type
+
+ PLOGICAL_LOCK = ^TLOGICAL_LOCK;
+ TLOGICAL_LOCK = record
+ connNumber: Tnuint16;
+ taskNumber: Tnuint16;
+ lockStatus: Tnuint8;
+ end;
+
+ PLOGICAL_LOCKS = ^TLOGICAL_LOCKS;
+ TLOGICAL_LOCKS = record
+ useCount: Tnuint16;
+ shareableLockCount: Tnuint16;
+ locked: Tnuint8;
+ nextRequest: Tnuint16;
+ numRecords: Tnuint16;
+ logicalLock: array[0..127] of TLOGICAL_LOCK;
+ curRecord: Tnuint16;
+ end;
+
+ PCONN_LOGICAL_LOCK = ^TCONN_LOGICAL_LOCK;
+ TCONN_LOGICAL_LOCK = record
+ taskNumber: Tnuint16;
+ lockStatus: Tnuint8;
+ logicalName: array[0..127] of Tnstr8;
+ end;
+
+ PCONN_LOGICAL_LOCKS = ^TCONN_LOGICAL_LOCKS;
+ TCONN_LOGICAL_LOCKS = record
+ nextRequest: Tnuint16;
+ numRecords: Tnuint16;
+ records: array[0..507] of Tnuint8;
+ curOffset: Tnuint16;
+ curRecord: Tnuint16;
+ end;
+
+ PPHYSICAL_LOCK = ^TPHYSICAL_LOCK;
+ TPHYSICAL_LOCK = record
+ loggedCount: Tnuint16;
+ shareableLockCount: Tnuint16;
+ recordStart: Tnuint32;
+ recordEnd: Tnuint32;
+ connNumber: Tnuint16;
+ taskNumber: Tnuint16;
+ lockType: Tnuint8;
+ end;
+
+ PPHYSICAL_LOCKS = ^TPHYSICAL_LOCKS;
+ TPHYSICAL_LOCKS = record
+ nextRequest: Tnuint16;
+ numRecords: Tnuint16;
+ locks: array[0..31] of TPHYSICAL_LOCK;
+ curRecord: Tnuint16;
+ reserved: array[0..7] of Tnuint8;
+ end;
+
+ PCONN_PHYSICAL_LOCK = ^TCONN_PHYSICAL_LOCK;
+ TCONN_PHYSICAL_LOCK = record
+ taskNumber: Tnuint16;
+ lockType: Tnuint8;
+ recordStart: Tnuint32;
+ recordEnd: Tnuint32;
+ end;
+
+ PCONN_PHYSICAL_LOCKS = ^TCONN_PHYSICAL_LOCKS;
+ TCONN_PHYSICAL_LOCKS = record
+ nextRequest: Tnuint16;
+ numRecords: Tnuint16;
+ locks: array[0..50] of TCONN_PHYSICAL_LOCK;
+ curRecord: Tnuint16;
+ reserved: array[0..21] of Tnuint8;
+ end;
+
+ PSEMAPHORE = ^TSEMAPHORE;
+ TSEMAPHORE = record
+ connNumber: Tnuint16;
+ taskNumber: Tnuint16;
+ end;
+
+ PSEMAPHORES = ^TSEMAPHORES;
+ TSEMAPHORES = record
+ nextRequest: Tnuint16;
+ openCount: Tnuint16;
+ semaphoreValue: Tnuint16;
+ semaphoreCount: Tnuint16;
+ semaphores: array[0..169] of TSEMAPHORE;
+ curRecord: Tnuint16;
+ end;
+
+ PCONN_SEMAPHORE = ^TCONN_SEMAPHORE;
+ TCONN_SEMAPHORE = record
+ openCount: Tnuint16;
+ semaphoreValue: Tnuint16;
+ taskNumber: Tnuint16;
+ semaphoreName: array[0..127] of Tnstr8;
+ end;
+
+ PCONN_SEMAPHORES = ^TCONN_SEMAPHORES;
+ TCONN_SEMAPHORES = record
+ nextRequest: Tnuint16;
+ numRecords: Tnuint16;
+ records: array[0..507] of Tnuint8;
+ curOffset: Tnuint16;
+ curRecord: Tnuint16;
+ end;
+
+function NWScanPhysicalLocksByFile(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; dataStream: Tnuint8; iterHandle: pnint16;
+ lock: PPHYSICAL_LOCK; locks: PPHYSICAL_LOCKS): TNWCCODE; NWLIB_CALNLM32;
+function NWScanLogicalLocksByConn(conn: TNWCONN_HANDLE; connNum: Tnuint16; iterHandle: pnint16; logicalLock: PCONN_LOGICAL_LOCK; logicalLocks: PCONN_LOGICAL_LOCKS): TNWCCODE; NWLIB_CALNLM32;
+function NWScanPhysicalLocksByConnFile(conn: TNWCONN_HANDLE; connNum: Tnuint16; dirHandle: TNWDIR_HANDLE; path: Pnstr8; dataStream: Tnuint8;
+ iterHandle: pnint16; lock: PCONN_PHYSICAL_LOCK; locks: PCONN_PHYSICAL_LOCKS): TNWCCODE; NWLIB_CALNLM32;
+function NWScanLogicalLocksByName(conn: TNWCONN_HANDLE; logicalName: Pnstr8; iterHandle: pnint16; logicalLock: PLOGICAL_LOCK; logicalLocks: PLOGICAL_LOCKS): TNWCCODE; NWLIB_CALNLM32;
+function NWScanSemaphoresByConn(conn: TNWCONN_HANDLE; connNum: Tnuint16; iterHandle: pnint16; semaphore: PCONN_SEMAPHORE; semaphores: PCONN_SEMAPHORES): TNWCCODE; NWLIB_CALNLM32;
+function NWScanSemaphoresByName(conn: TNWCONN_HANDLE; semName: Pnstr8; iterHandle: pnint16; semaphore: PSEMAPHORE; semaphores: PSEMAPHORES): TNWCCODE; NWLIB_CALNLM32;
+function NWSignalSemaphore(conn: TNWCONN_HANDLE; semHandle: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWCloseSemaphore(conn: TNWCONN_HANDLE; semHandle: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWOpenSemaphore(conn: TNWCONN_HANDLE; semName: Pnstr8; initSemHandle: Tnint16; semHandle: pnuint32; semOpenCount: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWExamineSemaphore(conn: TNWCONN_HANDLE; semHandle: Tnuint32; semValue: pnint16; semOpenCount: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWWaitOnSemaphore(conn: TNWCONN_HANDLE; semHandle: Tnuint32; timeOutValue: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+//*****************************************************************************
+//nwtts.h
+//*****************************************************************************
+
+type
+
+ PTTS_STATS = ^TTTS_STATS;
+ TTTS_STATS = record
+ systemElapsedTime: Tnuint32;
+ TTS_Supported: Tnuint8;
+ TTS_Enabled: Tnuint8;
+ TTS_VolumeNumber: Tnuint16;
+ TTS_MaxOpenTransactions: Tnuint16;
+ TTS_MaxTransactionsOpened: Tnuint16;
+ TTS_CurrTransactionsOpen: Tnuint16;
+ TTS_TotalTransactions: Tnuint32;
+ TTS_TotalWrites: Tnuint32;
+ TTS_TotalBackouts: Tnuint32;
+ TTS_UnfilledBackouts: Tnuint16;
+ TTS_DiskBlocksInUse: Tnuint16;
+ TTS_FATAllocations: Tnuint32;
+ TTS_FileSizeChanges: Tnuint32;
+ TTS_FilesTruncated: Tnuint32;
+ numberOfTransactions: Tnuint8;
+ connTask: array[0..234] of record
+ connNumber: Tnuint8;
+ taskNumber: Tnuint8;
+ end;
+ end;
+
+function NWTTSAbortTransaction(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSBeginTransaction(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSIsAvailable(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSGetControlFlags(conn: TNWCONN_HANDLE; controlFlags: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSSetControlFlags(conn: TNWCONN_HANDLE; controlFlags: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSEndTransaction(conn: TNWCONN_HANDLE; transactionNum: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSTransactionStatus(conn: TNWCONN_HANDLE; transactionNum: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSGetProcessThresholds(conn: TNWCONN_HANDLE; logicalLockLevel: pnuint8; physicalLockLevel: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSSetProcessThresholds(conn: TNWCONN_HANDLE; logicalLockLevel: Tnuint8; physicalLockLevel: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSGetConnectionThresholds(conn: TNWCONN_HANDLE; logicalLockLevel: pnuint8; physicalLockLevel: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWTTSSetConnectionThresholds(conn: TNWCONN_HANDLE; logicalLockLevel: Tnuint8; physicalLockLevel: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWEnableTTS(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWDisableTTS(conn: TNWCONN_HANDLE): TNWCCODE; NWLIB_CALNLM32;
+function NWGetTTSStats(conn: TNWCONN_HANDLE; ttsStats: PTTS_STATS): TNWCCODE; NWLIB_CALNLM32;
+
+//*****************************************************************************
+//nwvol.h
+//*****************************************************************************
+
+ { define volume types }
+
+const
+ VINetWare386 = 0;
+ VINetWare286 = 1;
+ VINetWare386v30 = 2;
+ VINetWare386v31 = 3;
+ { define the extended volume information status flag bits }
+ NWSubAllocEnabledBit = $01;
+ NWCompressionEnabledBit = $02;
+ NWMigrationEnabledBit = $04;
+ NWAuditingEnabledBit = $08;
+ NWReadOnlyEnabledBit = $10;
+ NWPSSEnabledBit = $80000000;
+ { define the constant for volume request flag for NWScanMountedVolumeList }
+ NW_VOLUME_NUMBER_ONLY = 0;
+ NW_VOLUME_NUMBER_AND_NAME = 1;
+type
+
+ PNWOBJ_REST = ^TNWOBJ_REST;
+ TNWOBJ_REST = record
+ objectID: Tnuint32;
+ restriction: Tnuint32;
+ end;
+
+ PNWVolumeRestrictions = ^TNWVolumeRestrictions;
+ TNWVolumeRestrictions = record
+ numberOfEntries: Tnuint8;
+ resInfo: array[0..11] of record
+ objectID: Tnuint32;
+ restriction: Tnuint32;
+ end;
+ end;
+
+ PNWVOL_RESTRICTIONS = ^TNWVOL_RESTRICTIONS;
+ TNWVOL_RESTRICTIONS = record
+ numberOfEntries: Tnuint8;
+ resInfo: array[0..15] of record
+ objectID: Tnuint32;
+ restriction: Tnuint32;
+ end;
+ end;
+
+ PVOL_STATS = ^TVOL_STATS;
+ TVOL_STATS = record
+ systemElapsedTime: Tnint32;
+ volumeNumber: Tnuint8;
+ logicalDriveNumber: Tnuint8;
+ sectorsPerBlock: Tnuint16;
+ startingBlock: Tnuint16;
+ totalBlocks: Tnuint16;
+ availableBlocks: Tnuint16;
+ totalDirectorySlots: Tnuint16;
+ availableDirectorySlots: Tnuint16;
+ maxDirectorySlotsUsed: Tnuint16;
+ isHashing: Tnuint8;
+ isCaching: Tnuint8;
+ isRemovable: Tnuint8;
+ isMounted: Tnuint8;
+ volumeName: array[0..15] of Tnstr8;
+ end;
+ { non freeable }
+
+ PExtendedVolInfo_tag = ^TExtendedVolInfo_tag;
+ TExtendedVolInfo_tag = record
+ volType: Tnuint32;
+ statusFlag: Tnuint32;
+ sectorSize: Tnuint32;
+ sectorsPerCluster: Tnuint32;
+ volSizeInClusters: Tnuint32;
+ freeClusters: Tnuint32;
+ subAllocFreeableClusters: Tnuint32;
+ freeableLimboSectors: Tnuint32;
+ nonfreeableLimboSectors: Tnuint32;
+ availSubAllocSectors: Tnuint32;
+ nonuseableSubAllocSectors: Tnuint32;
+ subAllocClusters: Tnuint32;
+ numDataStreams: Tnuint32;
+ numLimboDataStreams: Tnuint32;
+ oldestDelFileAgeInTicks: Tnuint32;
+ numCompressedDataStreams: Tnuint32;
+ numCompressedLimboDataStreams: Tnuint32;
+ numNoncompressibleDataStreams: Tnuint32;
+ precompressedSectors: Tnuint32;
+ compressedSectors: Tnuint32;
+ numMigratedDataStreams: Tnuint32;
+ migratedSectors: Tnuint32;
+ clustersUsedByFAT: Tnuint32;
+ clustersUsedByDirs: Tnuint32;
+ clustersUsedByExtDirs: Tnuint32;
+ totalDirEntries: Tnuint32;
+ unusedDirEntries: Tnuint32;
+ totalExtDirExtants: Tnuint32;
+ unusedExtDirExtants: Tnuint32;
+ extAttrsDefined: Tnuint32;
+ extAttrExtantsUsed: Tnuint32;
+ DirectoryServicesObjectID: Tnuint32;
+ volLastModifiedDateAndTime: Tnuint32;
+ end;
+ TNWVolExtendedInfo = TExtendedVolInfo_tag;
+ PNWVolExtendedInfo = ^TNWVolExtendedInfo;
+
+ PNWVolMountNumWithName_tag = ^TNWVolMountNumWithName_tag;
+ TNWVolMountNumWithName_tag = record
+ volumeNumber: Tnuint32;
+ volumeName: array[0..(NW_MAX_VOLUME_NAME_LEN) - 1] of Tnstr8;
+ end;
+ TNWVolMountNumWithName = TNWVolMountNumWithName_tag;
+ PNWVolMountNumWithName = ^TNWVolMountNumWithName;
+
+function NWGetDiskUtilization(conn: TNWCONN_HANDLE; objID: Tnuint32; volNum: Tnuint8; usedDirectories: pnuint16; usedFiles: pnuint16;
+ usedBlocks: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetObjDiskRestrictions(conn: TNWCONN_HANDLE; volNumber: Tnuint8; objectID: Tnuint32; restriction: pnuint32; inUse: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWScanVolDiskRestrictions(conn: TNWCONN_HANDLE; volNum: Tnuint8; iterhandle: pnuint32; volInfo: PNWVolumeRestrictions): TNWCCODE; NWLIB_CALNLM32;
+function NWScanVolDiskRestrictions2(conn: TNWCONN_HANDLE; volNum: Tnuint8; iterhandle: pnuint32; volInfo: PNWVOL_RESTRICTIONS): TNWCCODE; NWLIB_CALNLM32;
+function NWRemoveObjectDiskRestrictions(conn: TNWCONN_HANDLE; volNum: Tnuint8; objID: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWSetObjectVolSpaceLimit(conn: TNWCONN_HANDLE; volNum: Tnuint16; objID: Tnuint32; restriction: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeInfoWithHandle(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; volName: Pnstr8; totalBlocks: pnuint16; sectorsPerBlock: pnuint16;
+ availableBlocks: pnuint16; totalDirEntries: pnuint16; availableDirEntries: pnuint16; volIsRemovableFlag: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeInfoWithNumber(conn: TNWCONN_HANDLE; volNum: Tnuint16; volName: Pnstr8; totalBlocks: pnuint16; sectorsPerBlock: pnuint16;
+ availableBlocks: pnuint16; totalDirEntries: pnuint16; availableDirEntries: pnuint16; volIsRemovableFlag: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeName(conn: TNWCONN_HANDLE; volNum: Tnuint16; volName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeNumber(conn: TNWCONN_HANDLE; volName: Pnstr8; volNum: pnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeStats(conn: TNWCONN_HANDLE; volNum: Tnuint8; volInfo: PVOL_STATS): TNWCCODE; NWLIB_CALNLM32;
+
+
+function NWGetExtendedVolumeInfo(conn: TNWCONN_HANDLE; volNum: Tnuint16; volInfo: PNWVolExtendedInfo): TNWCCODE; NWLIB_CLIB;
+function NWGetExtendedVolumeInfo2(conn: TNWCONN_HANDLE; volNum: Tnuint16; volInfo: PNWVolExtendedInfo): TNWCCODE; NWLIB_CLIB;
+function NWScanMountedVolumeList(conn: TNWCONN_HANDLE; volRequestFlags: Tnuint32; nameSpace: Tnuint32; iterHandle: pnuint32; numberItems: Tnuint32;
+ numberReturned: pnuint32; volMountArr: PNWVolMountNumWithName): TNWCCODE; NWLIB_CALNLM32;
+
+
+//*****************************************************************************
+//nwacct.h
+//*****************************************************************************
+
+type
+ PHOLDS_INFO = ^THOLDS_INFO;
+ THOLDS_INFO = record
+ objectID: Tnuint32;
+ amount: Tnint32;
+ end;
+
+ PHOLDS_STATUS = ^THOLDS_STATUS;
+ THOLDS_STATUS = record
+ holdsCount: Tnuint16;
+ holds: array[0..15] of THOLDS_INFO;
+ end;
+
+
+function NWGetAccountStatus(conn: TNWCONN_HANDLE; objType: Tnuint16; objName: Pnstr8; balance: pnint32; limit: pnint32;
+ holds: PHOLDS_STATUS): TNWCCODE; NWLIB_CALNLM32;
+function NWQueryAccountingInstalled(conn: TNWCONN_HANDLE; installed: pnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWSubmitAccountCharge(conn: TNWCONN_HANDLE; objType: Tnuint16; objName: Pnstr8; serviceType: Tnuint16; chargeAmt: Tnint32;
+ holdCancelAmt: Tnint32; noteType: Tnuint16; note: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSubmitAccountHold(conn: TNWCONN_HANDLE; objType: Tnuint16; objName: Pnstr8; holdAmt: Tnint32): TNWCCODE; NWLIB_CALNLM32;
+function NWSubmitAccountNote(conn: TNWCONN_HANDLE; objType: Tnuint16; objName: Pnstr8; serviceType: Tnuint16; noteType: Tnuint16;
+ note: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+//*****************************************************************************
+//nwfse.h
+//*****************************************************************************
+
+type
+ PSERVER_AND_VCONSOLE_INFO = ^TSERVER_AND_VCONSOLE_INFO;
+ TSERVER_AND_VCONSOLE_INFO = record
+ currentServerTime: Tnuint32;
+ vconsoleVersion: Tnuint8;
+ vconsoleRevision: Tnuint8;
+ end;
+ { Get Cache Information }
+
+ PCACHE_COUNTERS = ^TCACHE_COUNTERS;
+ TCACHE_COUNTERS = record
+ readExistingBlockCount: Tnuint32;
+ readExistingWriteWaitCount: Tnuint32;
+ readExistingPartialReadCount: Tnuint32;
+ readExistingReadErrorCount: Tnuint32;
+ writeBlockCount: Tnuint32;
+ writeEntireBlockCount: Tnuint32;
+ getDiskCount: Tnuint32;
+ getDiskNeedToAllocCount: Tnuint32;
+ getDiskSomeoneBeatMeCount: Tnuint32;
+ getDiskPartialReadCount: Tnuint32;
+ getDiskReadErrorCount: Tnuint32;
+ getAsyncDiskCount: Tnuint32;
+ getAsyncDiskNeedToAlloc: Tnuint32;
+ getAsyncDiskSomeoneBeatMe: Tnuint32;
+ errorDoingAsyncReadCount: Tnuint32;
+ getDiskNoReadCount: Tnuint32;
+ getDiskNoReadAllocCount: Tnuint32;
+ getDiskNoReadSomeoneBeatMeCount: Tnuint32;
+ diskWriteCount: Tnuint32;
+ diskWriteAllocCount: Tnuint32;
+ diskWriteSomeoneBeatMeCount: Tnuint32;
+ writeErrorCount: Tnuint32;
+ waitOnSemaphoreCount: Tnuint32;
+ allocBlockWaitForSomeoneCount: Tnuint32;
+ allocBlockCount: Tnuint32;
+ allocBlockWaitCount: Tnuint32;
+ end;
+
+ PCACHE_MEM_COUNTERS = ^TCACHE_MEM_COUNTERS;
+ TCACHE_MEM_COUNTERS = record
+ originalNumOfCacheBuffers: Tnuint32;
+ currentNumOfCacheBuffers: Tnuint32;
+ cacheDirtyBlockThreshold: Tnuint32;
+ waitNodeCount: Tnuint32;
+ waitNodeAllocFailureCount: Tnuint32;
+ moveCacheNodeCount: Tnuint32;
+ moveCacheNodeFromAvailCount: Tnuint32;
+ accelerateCacheNodeWriteCount: Tnuint32;
+ removeCacheNodeCount: Tnuint32;
+ removeCacheNodeFromAvailCount: Tnuint32;
+ end;
+
+ PCACHE_TREND_COUNTERS = ^TCACHE_TREND_COUNTERS;
+ TCACHE_TREND_COUNTERS = record
+ numCacheChecks: Tnuint32;
+ numCacheHits: Tnuint32;
+ numDirtyCacheChecks: Tnuint32;
+ numDirtyCacheHits: Tnuint32;
+ cacheUsedWhileChecking: Tnuint32;
+ waitForDirtyBlocksDecreaseCount: Tnuint32;
+ allocBlockFromAvailCount: Tnuint32;
+ allocBlockFromLRUCount: Tnuint32;
+ allocBlockAlreadyWaiting: Tnuint32;
+ LRUSittingTime: Tnuint32;
+ end;
+
+ PCACHE_INFO = ^TCACHE_INFO;
+ TCACHE_INFO = record
+ maxByteCount: Tnuint32;
+ minNumOfCacheBuffers: Tnuint32;
+ minCacheReportThreshold: Tnuint32;
+ allocWaitingCount: Tnuint32;
+ numDirtyBlocks: Tnuint32;
+ cacheDirtyWaitTime: Tnuint32;
+ cacheMaxConcurrentWrites: Tnuint32;
+ maxDirtyTime: Tnuint32;
+ numOfDirCacheBuffers: Tnuint32;
+ cacheByteToBlockShiftFactor: Tnuint32;
+ end;
+
+ PNWFSE_CACHE_INFO = ^TNWFSE_CACHE_INFO;
+ TNWFSE_CACHE_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ cacheCounters: TCACHE_COUNTERS;
+ cacheMemCounters: TCACHE_MEM_COUNTERS;
+ cacheTrendCounters: TCACHE_TREND_COUNTERS;
+ cacheInformation: TCACHE_INFO;
+ end;
+ { Get File Server Information }
+ { writeHeldOffWithDuplicateRequest }
+
+ PFSE_SERVER_INFO = ^TFSE_SERVER_INFO;
+ TFSE_SERVER_INFO = record
+ replyCanceledCount: Tnuint32;
+ writeHeldOffCount: Tnuint32;
+ writeHeldOffWithDupRequest: Tnuint32;
+ invalidRequestTypeCount: Tnuint32;
+ beingAbortedCount: Tnuint32;
+ alreadyDoingReallocCount: Tnuint32;
+ deAllocInvalidSlotCount: Tnuint32;
+ deAllocBeingProcessedCount: Tnuint32;
+ deAllocForgedPacketCount: Tnuint32;
+ deAllocStillTransmittingCount: Tnuint32;
+ startStationErrorCount: Tnuint32;
+ invalidSlotCount: Tnuint32;
+ beingProcessedCount: Tnuint32;
+ forgedPacketCount: Tnuint32;
+ stillTransmittingCount: Tnuint32;
+ reExecuteRequestCount: Tnuint32;
+ invalidSequenceNumCount: Tnuint32;
+ duplicateIsBeingSentAlreadyCnt: Tnuint32;
+ sentPositiveAcknowledgeCount: Tnuint32;
+ sentDuplicateReplyCount: Tnuint32;
+ noMemForStationCtrlCount: Tnuint32;
+ noAvailableConnsCount: Tnuint32;
+ reallocSlotCount: Tnuint32;
+ reallocSlotCameTooSoonCount: Tnuint32;
+ end;
+
+ PFILE_SERVER_COUNTERS = ^TFILE_SERVER_COUNTERS;
+ TFILE_SERVER_COUNTERS = record
+ tooManyHops: Tnuint16;
+ unknownNetwork: Tnuint16;
+ noSpaceForService: Tnuint16;
+ noReceiveBuffers: Tnuint16;
+ notMyNetwork: Tnuint16;
+ netBIOSProgatedCount: Tnuint32;
+ totalPacketsServiced: Tnuint32;
+ totalPacketsRouted: Tnuint32;
+ end;
+
+ PNWFSE_FILE_SERVER_INFO = ^TNWFSE_FILE_SERVER_INFO;
+ TNWFSE_FILE_SERVER_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ NCPStationsInUseCount: Tnuint32;
+ NCPPeakStationsInUseCount: Tnuint32;
+ numOfNCPRequests: Tnuint32;
+ serverUtilization: Tnuint32;
+ ServerInfo: TFSE_SERVER_INFO;
+ fileServerCounters: TFILE_SERVER_COUNTERS;
+ end;
+ { Netware File Systems Information }
+
+ PFSE_FILE_SYSTEM_INFO = ^TFSE_FILE_SYSTEM_INFO;
+ TFSE_FILE_SYSTEM_INFO = record
+ FATMovedCount: Tnuint32;
+ FATWriteErrorCount: Tnuint32;
+ someoneElseDidItCount0: Tnuint32;
+ someoneElseDidItCount1: Tnuint32;
+ someoneElseDidItCount2: Tnuint32;
+ iRanOutSomeoneElseDidItCount0: Tnuint32;
+ iRanOutSomeoneElseDidItCount1: Tnuint32;
+ iRanOutSomeoneElseDidItCount2: Tnuint32;
+ turboFATBuildScrewedUpCount: Tnuint32;
+ extraUseCountNodeCount: Tnuint32;
+ extraExtraUseCountNodeCount: Tnuint32;
+ errorReadingLastFATCount: Tnuint32;
+ someoneElseUsingThisFileCount: Tnuint32;
+ end;
+
+ PNWFSE_FILE_SYSTEM_INFO = ^TNWFSE_FILE_SYSTEM_INFO;
+ TNWFSE_FILE_SYSTEM_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ fileSystemInfo: TFSE_FILE_SYSTEM_INFO;
+ end;
+ { User Information }
+ { status }
+
+const
+ FSE_LOGGED_IN = $00000001;
+ FSE_BEING_ABORTED = $00000002;
+ FSE_AUDITED = $00000004;
+ FSE_NEEDS_SECURITY_CHANGE = $00000008;
+ FSE_MAC_STATION = $00000010;
+ FSE_AUTHENTICATED_TEMPORARY = $00000020;
+ FSE_AUDIT_CONNECTION_RECORDED = $00000040;
+ FSE_DSAUDIT_CONNECTION_RECORDED = $00000080;
+ { fileWriteFlags }
+ FSE_WRITE = 1;
+ FSE_WRITE_ABORTED = 2;
+ { fileWriteState }
+ FSE_NOT_WRITING = 0;
+ FSE_WRITE_IN_PROGRESS = 1;
+ FSE_WRITE_BEING_STOPPED = 2;
+ { Includes active and stop bits }
+type
+
+ PUSER_INFO = ^TUSER_INFO;
+ TUSER_INFO = record
+ connNum: Tnuint32;
+ useCount: Tnuint32;
+ connServiceType: Tnuint8;
+ loginTime: array[0..6] of Tnuint8;
+ status: Tnuint32;
+ expirationTime: Tnuint32;
+ objType: Tnuint32;
+ transactionFlag: Tnuint8;
+ logicalLockThreshold: Tnuint8;
+ recordLockThreshold: Tnuint8;
+ fileWriteFlags: Tnuint8;
+ fileWriteState: Tnuint8;
+ filler: Tnuint8;
+ fileLockCount: Tnuint16;
+ recordLockCount: Tnuint16;
+ totalBytesRead: array[0..5] of Tnuint8;
+ totalBytesWritten: array[0..5] of Tnuint8;
+ totalRequests: Tnuint32;
+ heldRequests: Tnuint32;
+ heldBytesRead: array[0..5] of Tnuint8;
+ heldBytesWritten: array[0..5] of Tnuint8;
+ end;
+
+ PNWFSE_USER_INFO = ^TNWFSE_USER_INFO;
+ TNWFSE_USER_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ userInfo: TUSER_INFO;
+ end;
+ { Packet Burst Information }
+ { writeTooManyBuffersCheckedOutCount }
+ { writeDidntNeedButRequestedACKCount }
+
+ PPACKET_BURST_INFO = ^TPACKET_BURST_INFO;
+ TPACKET_BURST_INFO = record
+ bigInvalidSlotCount: Tnuint32;
+ bigForgedPacketCount: Tnuint32;
+ bigInvalidPacketCount: Tnuint32;
+ bigStillTransmittingCount: Tnuint32;
+ stillDoingTheLastRequestCount: Tnuint32;
+ invalidCtrlRequestCount: Tnuint32;
+ ctrlInvalidMessageNumCount: Tnuint32;
+ ctrlBeingTornDownCount: Tnuint32;
+ bigRepeatTheFileReadCount: Tnuint32;
+ bigSendExtraCCCount: Tnuint32;
+ bigReturnAbortMessageCount: Tnuint32;
+ bigReadInvalidMessageNumCount: Tnuint32;
+ bigReadDoItOverCount: Tnuint32;
+ bigReadBeingTornDownCount: Tnuint32;
+ previousCtrlPacketCount: Tnuint32;
+ sendHoldOffMessageCount: Tnuint32;
+ bigReadNoDataAvailableCount: Tnuint32;
+ bigReadTryingToReadTooMuchCount: Tnuint32;
+ asyncReadErrorCount: Tnuint32;
+ bigReadPhysicalReadErrorCount: Tnuint32;
+ ctrlBadACKFragmentListCount: Tnuint32;
+ ctrlNoDataReadCount: Tnuint32;
+ writeDuplicateRequestCount: Tnuint32;
+ shouldntBeACKingHereCount: Tnuint32;
+ writeInconsistentPktLengthsCnt: Tnuint32;
+ firstPacketIsntAWriteCount: Tnuint32;
+ writeTrashedDuplicateRequestCnt: Tnuint32;
+ bigWriteInvalidMessageNumCount: Tnuint32;
+ bigWriteBeingTornDownCount: Tnuint32;
+ bigWriteBeingAbortedCount: Tnuint32;
+ zeroACKFragmentCountCount: Tnuint32;
+ writeCurrentlyTransmittingCount: Tnuint32;
+ tryingToWriteTooMuchCount: Tnuint32;
+ writeOutOfMemForCtrlNodesCount: Tnuint32;
+ writeDidntNeedThisFragmentCount: Tnuint32;
+ writeTooManyBuffsCheckedOutCnt: Tnuint32;
+ writeTimeOutCount: Tnuint32;
+ writeGotAnACKCount: Tnuint32;
+ writeGotAnACKCount1: Tnuint32;
+ pollerAbortedTheConnCount: Tnuint32;
+ maybeHadOutOfOrderWritesCount: Tnuint32;
+ hadAnOutOfOrderWriteCount: Tnuint32;
+ movedTheACKBitDownCount: Tnuint32;
+ bumpedOutOfOrderWriteCount: Tnuint32;
+ pollerRemovedOldOutOfOrderCount: Tnuint32;
+ writeDidntNeedButRequestACKCnt: Tnuint32;
+ writeTrashedPacketCount: Tnuint32;
+ tooManyACKFragmentsCount: Tnuint32;
+ savedAnOutOfOrderPacketCount: Tnuint32;
+ connBeingAbortedCount: Tnuint32;
+ end;
+
+ PNWFSE_PACKET_BURST_INFO = ^TNWFSE_PACKET_BURST_INFO;
+ TNWFSE_PACKET_BURST_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ packetBurstInfo: TPACKET_BURST_INFO;
+ end;
+ { IPX SPX Information }
+
+ PIPX_INFO = ^TIPX_INFO;
+ TIPX_INFO = record
+ IPXSendPacketCount: Tnuint32;
+ IPXMalformPacketCount: Tnuint16;
+ IPXGetECBRequestCount: Tnuint32;
+ IPXGetECBFailCount: Tnuint32;
+ IPXAESEventCount: Tnuint32;
+ IPXPostponedAESCount: Tnuint16;
+ IPXMaxConfiguredSocketCount: Tnuint16;
+ IPXMaxOpenSocketCount: Tnuint16;
+ IPXOpenSocketFailCount: Tnuint16;
+ IPXListenECBCount: Tnuint32;
+ IPXECBCancelFailCount: Tnuint16;
+ IPXGetLocalTargetFailCount: Tnuint16;
+ end;
+
+ PSPX_INFO = ^TSPX_INFO;
+ TSPX_INFO = record
+ SPXMaxConnsCount: Tnuint16;
+ SPXMaxUsedConns: Tnuint16;
+ SPXEstConnReq: Tnuint16;
+ SPXEstConnFail: Tnuint16;
+ SPXListenConnectReq: Tnuint16;
+ SPXListenConnectFail: Tnuint16;
+ SPXSendCount: Tnuint32;
+ SPXWindowChokeCount: Tnuint32;
+ SPXBadSendCount: Tnuint16;
+ SPXSendFailCount: Tnuint16;
+ SPXAbortedConn: Tnuint16;
+ SPXListenPacketCount: Tnuint32;
+ SPXBadListenCount: Tnuint16;
+ SPXIncomingPacketCount: Tnuint32;
+ SPXBadInPacketCount: Tnuint16;
+ SPXSuppressedPackCount: Tnuint16;
+ SPXNoSesListenECBCount: Tnuint16;
+ SPXWatchDogDestSesCount: Tnuint16;
+ end;
+
+ PNWFSE_IPXSPX_INFO = ^TNWFSE_IPXSPX_INFO;
+ TNWFSE_IPXSPX_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ IPXInfo: TIPX_INFO;
+ SPXInfo: TSPX_INFO;
+ end;
+ { Garbage Collection Information }
+
+ PNWFSE_GARBAGE_COLLECTION_INFO = ^TNWFSE_GARBAGE_COLLECTION_INFO;
+ TNWFSE_GARBAGE_COLLECTION_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ failedAllocRequestCount: Tnuint32;
+ numOfAllocs: Tnuint32;
+ noMoreMemAvailableCount: Tnuint32;
+ numOfGarbageCollections: Tnuint32;
+ garbageFoundSomeMem: Tnuint32;
+ garbageNumOfChecks: Tnuint32;
+ end;
+ { CPU Information }
+
+const
+ FSE_CPU_STR_MAX = 16;
+ FSE_COPROCESSOR_STR_MAX = 48;
+ FSE_BUS_STR_MAX = 32;
+type
+
+ PCPU_INFO = ^TCPU_INFO;
+ TCPU_INFO = record
+ pageTableOwnerFlag: Tnuint32;
+ CPUTypeFlag: Tnuint32;
+ coProcessorFlag: Tnuint32;
+ busTypeFlag: Tnuint32;
+ IOEngineFlag: Tnuint32;
+ FSEngineFlag: Tnuint32;
+ nonDedicatedFlag: Tnuint32;
+ end;
+
+ PNWFSE_CPU_INFO = ^TNWFSE_CPU_INFO;
+ TNWFSE_CPU_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numOfCPUs: Tnuint32;
+ CPUInfo: TCPU_INFO;
+ end;
+ { Volume Switch Information }
+ { cardinal mapPathToDirectoryNumberOrPhantom; }
+ { cardinal stationHasAccessRightsGrantedBelow; }
+ { cardinal getDataStreamLengthsFromPathStringBase; }
+
+ PVOLUME_SWITCH_INFO = ^TVOLUME_SWITCH_INFO;
+ TVOLUME_SWITCH_INFO = record
+ readFile: Tnuint32;
+ writeFile: Tnuint32;
+ deleteFile: Tnuint32;
+ renMove: Tnuint32;
+ openFile: Tnuint32;
+ createFile: Tnuint32;
+ createAndOpenFile: Tnuint32;
+ closeFile: Tnuint32;
+ scanDeleteFile: Tnuint32;
+ salvageFile: Tnuint32;
+ purgeFile: Tnuint32;
+ migrateFile: Tnuint32;
+ deMigrateFile: Tnuint32;
+ createDir: Tnuint32;
+ deleteDir: Tnuint32;
+ directoryScans: Tnuint32;
+ mapPathToDirNum: Tnuint32;
+ modifyDirEntry: Tnuint32;
+ getAccessRights: Tnuint32;
+ getAccessRightsFromIDs: Tnuint32;
+ mapDirNumToPath: Tnuint32;
+ getEntryFromPathStrBase: Tnuint32;
+ getOtherNSEntry: Tnuint32;
+ getExtDirInfo: Tnuint32;
+ getParentDirNum: Tnuint32;
+ addTrusteeR: Tnuint32;
+ scanTrusteeR: Tnuint32;
+ delTrusteeR: Tnuint32;
+ purgeTrust: Tnuint32;
+ findNextTrustRef: Tnuint32;
+ scanUserRestNodes: Tnuint32;
+ addUserRest: Tnuint32;
+ deleteUserRest: Tnuint32;
+ rtnDirSpaceRest: Tnuint32;
+ getActualAvailDskSp: Tnuint32;
+ cntOwnedFilesAndDirs: Tnuint32;
+ migFileInfo: Tnuint32;
+ volMigInfo: Tnuint32;
+ readMigFileData: Tnuint32;
+ getVolUsageStats: Tnuint32;
+ getActualVolUsageStats: Tnuint32;
+ getDirUsageStats: Tnuint32;
+ NMFileReadsCount: Tnuint32;
+ NMFileWritesCount: Tnuint32;
+ mapPathToDirNumOrPhantom: Tnuint32;
+ stationHasAccessRgtsGntedBelow: Tnuint32;
+ gtDataStreamLensFromPathStrBase: Tnuint32;
+ checkAndGetDirectoryEntry: Tnuint32;
+ getDeletedEntry: Tnuint32;
+ getOriginalNameSpace: Tnuint32;
+ getActualFileSize: Tnuint32;
+ verifyNameSpaceNumber: Tnuint32;
+ verifyDataStreamNumber: Tnuint32;
+ checkVolumeNumber: Tnuint32;
+ commitFile: Tnuint32;
+ VMGetDirectoryEntry: Tnuint32;
+ createDMFileEntry: Tnuint32;
+ renameNameSpaceEntry: Tnuint32;
+ logFile: Tnuint32;
+ releaseFile: Tnuint32;
+ clearFile: Tnuint32;
+ setVolumeFlag: Tnuint32;
+ clearVolumeFlag: Tnuint32;
+ getOriginalInfo: Tnuint32;
+ createMigratedDir: Tnuint32;
+ F3OpenCreate: Tnuint32;
+ F3InitFileSearch: Tnuint32;
+ F3ContinueFileSearch: Tnuint32;
+ F3RenameFile: Tnuint32;
+ F3ScanForTrustees: Tnuint32;
+ F3ObtainFileInfo: Tnuint32;
+ F3ModifyInfo: Tnuint32;
+ F3EraseFile: Tnuint32;
+ F3SetDirHandle: Tnuint32;
+ F3AddTrustees: Tnuint32;
+ F3DeleteTrustees: Tnuint32;
+ F3AllocDirHandle: Tnuint32;
+ F3ScanSalvagedFiles: Tnuint32;
+ F3RecoverSalvagedFiles: Tnuint32;
+ F3PurgeSalvageableFile: Tnuint32;
+ F3GetNSSpecificInfo: Tnuint32;
+ F3ModifyNSSpecificInfo: Tnuint32;
+ F3SearchSet: Tnuint32;
+ F3GetDirBase: Tnuint32;
+ F3QueryNameSpaceInfo: Tnuint32;
+ F3GetNameSpaceList: Tnuint32;
+ F3GetHugeInfo: Tnuint32;
+ F3SetHugeInfo: Tnuint32;
+ F3GetFullPathString: Tnuint32;
+ F3GetEffectiveDirectoryRights: Tnuint32;
+ end;
+ { 512 / sizeof(cardinal) }
+ { VOLUME_SWITCH_INFO volumeSwitchInfo; }{ Cant return all counters }
+
+ PNWFSE_VOLUME_SWITCH_INFO = ^TNWFSE_VOLUME_SWITCH_INFO;
+ TNWFSE_VOLUME_SWITCH_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ totalLFSCounters: Tnuint32;
+ CurrentLFSCounters: Tnuint32;
+ LFSCounters: array[0..127] of Tnuint32;
+ end;
+ { Get NLM Loaded List }
+
+const
+ FSE_NLM_NUMS_RETURNED_MAX = 128;
+ FSE_NLM_NUMS_MAX = 130;
+type
+
+ PNWFSE_NLM_LOADED_LIST = ^TNWFSE_NLM_LOADED_LIST;
+ TNWFSE_NLM_LOADED_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberNLMsLoaded: Tnuint32;
+ NLMsInList: Tnuint32;
+ NLMNums: array[0..(FSE_NLM_NUMS_RETURNED_MAX) - 1] of Tnuint32;
+ end;
+
+ PNWFSE_NLM_LOADED_LIST_LG = ^TNWFSE_NLM_LOADED_LIST_LG;
+ TNWFSE_NLM_LOADED_LIST_LG = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberNLMsLoaded: Tnuint32;
+ NLMsInList: Tnuint32;
+ NLMNums: array[0..(FSE_NLM_NUMS_MAX) - 1] of Tnuint32;
+ end;
+ { NLM Information }
+ { 1 is added for the NULL }
+
+const
+ FSE_NLM_FILENAME_LEN_MAX = 37;
+ FSE_NLM_NAMELEN_MAX = 129;
+ FSE_NLM_COPYRIGHTLEN_MAX = 256;
+type
+
+ PNLM_INFO = ^TNLM_INFO;
+ TNLM_INFO = record
+ identificationNum: Tnuint32;
+ flags: Tnuint32;
+ _type: Tnuint32;
+ parentID: Tnuint32;
+ majorVersion: Tnuint32;
+ minorVersion: Tnuint32;
+ revision: Tnuint32;
+ year: Tnuint32;
+ month: Tnuint32;
+ day: Tnuint32;
+ allocAvailableBytes: Tnuint32;
+ allocFreeCount: Tnuint32;
+ lastGarbageCollection: Tnuint32;
+ messageLanguage: Tnuint32;
+ numOfReferencedPublics: Tnuint32;
+ end;
+
+ PNWFSE_NLM_INFO = ^TNWFSE_NLM_INFO;
+ TNWFSE_NLM_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ NLMInfo: TNLM_INFO;
+ end;
+ { Get Directory Cache Information }
+
+ PDIR_CACHE_INFO = ^TDIR_CACHE_INFO;
+ TDIR_CACHE_INFO = record
+ minTimeSinceFileDelete: Tnuint32;
+ absMinTimeSinceFileDelete: Tnuint32;
+ minNumOfDirCacheBuffers: Tnuint32;
+ maxNumOfDirCacheBuffers: Tnuint32;
+ numOfDirCacheBuffers: Tnuint32;
+ dCMinNonReferencedTime: Tnuint32;
+ dCWaitTimeBeforeNewBuffer: Tnuint32;
+ dCMaxConcurrentWrites: Tnuint32;
+ dCDirtyWaitTime: Tnuint32;
+ dCDoubleReadFlag: Tnuint32;
+ mapHashNodeCount: Tnuint32;
+ spaceRestrictionNodeCount: Tnuint32;
+ trusteeListNodeCount: Tnuint32;
+ percentOfVolumeUsedByDirs: Tnuint32;
+ end;
+
+ PNWFSE_DIR_CACHE_INFO = ^TNWFSE_DIR_CACHE_INFO;
+ TNWFSE_DIR_CACHE_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ dirCacheInfo: TDIR_CACHE_INFO;
+ end;
+ { Get Operating System Version Information }
+
+ PNWFSE_OS_VERSION_INFO = ^TNWFSE_OS_VERSION_INFO;
+ TNWFSE_OS_VERSION_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ OSMajorVersion: Tnuint8;
+ OSMinorVersion: Tnuint8;
+ OSRevisionNum: Tnuint8;
+ accountingVersion: Tnuint8;
+ VAPVersion: Tnuint8;
+ queueingVersion: Tnuint8;
+ securityRestrictionsLevel: Tnuint8;
+ bridgingSupport: Tnuint8;
+ maxNumOfVolumes: Tnuint32;
+ numOfConnSlots: Tnuint32;
+ maxLoggedInConns: Tnuint32;
+ maxNumOfNameSpaces: Tnuint32;
+ maxNumOfLans: Tnuint32;
+ maxNumOfMediaTypes: Tnuint32;
+ maxNumOfProtocols: Tnuint32;
+ maxMaxSubdirTreeDepth: Tnuint32;
+ maxNumOfDataStreams: Tnuint32;
+ maxNumOfSpoolPrinters: Tnuint32;
+ serialNum: Tnuint32;
+ applicationNum: Tnuint16;
+ end;
+ { Get Active Connection List by Type }
+ { Connection service type }
+ { NOTE: type 1 is reserved by CLIB for backward compatability }
+
+const
+ FSE_NCP_CONNECTION_TYPE = 2;
+ FSE_NLM_CONNECTION_TYPE = 3;
+ FSE_AFP_CONNECTION_TYPE = 4;
+ FSE_FTAM_CONNECTION_TYPE = 5;
+ FSE_ANCP_CONNECTION_TYPE = 6;
+ FSE_ACP_CONNECTION_TYPE = 7;
+ FSE_SMB_CONNECTION_TYPE = 8;
+ FSE_WINSOCK_CONNECTION_TYPE = 9;
+ FSE_HTTP_CONNECTION_TYPE = 10;
+ FSE_UDP_CONNECTION_TYPE = 11;
+type
+
+ PNWFSE_ACTIVE_CONN_LIST = ^TNWFSE_ACTIVE_CONN_LIST;
+ TNWFSE_ACTIVE_CONN_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ activeConnBitList: array[0..511] of Tnuint8;
+ end;
+ { Get NLM's Resource Tag List }
+ { This packed structure consisting of:
+ **
+ ** cardinal number,
+ ** cardinal signature,
+ ** cardinal count,
+ ** byte name[] }
+
+ PNWFSE_NLMS_RESOURCE_TAG_LIST = ^TNWFSE_NLMS_RESOURCE_TAG_LIST;
+ TNWFSE_NLMS_RESOURCE_TAG_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ totalNumOfResourceTags: Tnuint32;
+ packetResourceTags: Tnuint32;
+ resourceTagBuf: array[0..511] of Tnuint8;
+ end;
+ { Active LAN Board List --- 20 }
+
+const
+ FSE_MAX_NUM_OF_LANS = 64;
+type
+
+ PNWFSE_ACTIVE_LAN_BOARD_LIST = ^TNWFSE_ACTIVE_LAN_BOARD_LIST;
+ TNWFSE_ACTIVE_LAN_BOARD_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ MaxNumOfLANs: Tnuint32;
+ LANLoadedCount: Tnuint32;
+ boardNums: array[0..(FSE_MAX_NUM_OF_LANS) - 1] of Tnuint32;
+ end;
+ { LAN Configuration Information }
+
+ PLAN_CONFIG_INFO = ^TLAN_CONFIG_INFO;
+ TLAN_CONFIG_INFO = record
+ DriverCFG_MajorVersion: Tnuint8;
+ DriverCFG_MinorVersion: Tnuint8;
+ DriverNodeAddress: array[0..5] of Tnuint8;
+ DriverModeFlags: Tnuint16;
+ DriverBoardNum: Tnuint16;
+ DriverBoardInstance: Tnuint16;
+ DriverMaxSize: Tnuint32;
+ DriverMaxRecvSize: Tnuint32;
+ DriverRecvSize: Tnuint32;
+ Reserved1: array[0..2] of Tnuint32;
+ DriverCardID: Tnuint16;
+ DriverMediaID: Tnuint16;
+ DriverTransportTime: Tnuint16;
+ DriverReserved: array[0..15] of Tnuint8;
+ DriverMajorVersion: Tnuint8;
+ DriverMinorVersion: Tnuint8;
+ DriverFlags: Tnuint16;
+ DriverSendRetries: Tnuint16;
+ DriverLink: Tnuint32;
+ DriverSharingFlags: Tnuint16;
+ DriverSlot: Tnuint16;
+ DriverIOPortsAndLengths: array[0..3] of Tnuint16;
+ DriverMemDecode0: Tnuint32;
+ DriverLength0: Tnuint16;
+ DriverMemDecode1: Tnuint32;
+ DriverLength1: Tnuint16;
+ DriverInterrupt: array[0..1] of Tnuint8;
+ DriverDMAUsage: array[0..1] of Tnuint8;
+ Reserved2: array[0..2] of Tnuint32;
+ DriverLogicalName: array[0..17] of Tnuint8;
+ DriverLinearMem: array[0..1] of Tnuint32;
+ DriverChannelNum: Tnuint16;
+ DriverIOReserved: array[0..5] of Tnuint8;
+ end;
+
+ PNWFSE_LAN_CONFIG_INFO = ^TNWFSE_LAN_CONFIG_INFO;
+ TNWFSE_LAN_CONFIG_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ LANConfigInfo: TLAN_CONFIG_INFO;
+ end;
+ { LAN Common Counters Information }
+
+ PLAN_COMMON_INFO = ^TLAN_COMMON_INFO;
+ TLAN_COMMON_INFO = record
+ notSupportedMask: Tnuint32;
+ totalTxPacketCount: Tnuint32;
+ totalRxPacketCount: Tnuint32;
+ noECBAvailableCount: Tnuint32;
+ packetTxTooBigCount: Tnuint32;
+ packetTxTooSmallCount: Tnuint32;
+ packetRxOverflowCount: Tnuint32;
+ packetRxTooBigCount: Tnuint32;
+ packetRxTooSmallCount: Tnuint32;
+ packetTxMiscErrorCount: Tnuint32;
+ packetRxMiscErrorCount: Tnuint32;
+ retryTxCount: Tnuint32;
+ checksumErrorCount: Tnuint32;
+ hardwareRxMismatchCount: Tnuint32;
+ reserved: array[0..49] of Tnuint32;
+ end;
+
+ PNWFSE_LAN_COMMON_COUNTERS_INFO = ^TNWFSE_LAN_COMMON_COUNTERS_INFO;
+ TNWFSE_LAN_COMMON_COUNTERS_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ statisticsMajorVersion: Tnuint8;
+ statisticsMinorVersion: Tnuint8;
+ numberOfGenericCounters: Tnuint32;
+ numberOfCounterBlocks: Tnuint32;
+ customVariableCount: Tnuint32;
+ NextCounterBlock: Tnuint32;
+ LANCommonInfo: TLAN_COMMON_INFO;
+ end;
+ { LAN Custom Counters Information }
+ { (Tnint32, byte[])[] - byte[] is a length preceded
+ ** non-null terminated string. }
+
+ PNWFSE_LAN_CUSTOM_INFO = ^TNWFSE_LAN_CUSTOM_INFO;
+ TNWFSE_LAN_CUSTOM_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numCustomVar: Tnuint32;
+ customInfo: array[0..511] of Tnuint8;
+ end;
+ { LSL Information }
+
+ PLSL_INFO = ^TLSL_INFO;
+ TLSL_INFO = record
+ rxBufs: Tnuint32;
+ rxBufs75PerCent: Tnuint32;
+ rxBufsCheckedOut: Tnuint32;
+ rxBufMaxSize: Tnuint32;
+ maxPhysicalSize: Tnuint32;
+ lastTimeRxBufAllocated: Tnuint32;
+ maxNumsOfProtocols: Tnuint32;
+ maxNumsOfMediaTypes: Tnuint32;
+ totalTXPackets: Tnuint32;
+ getECBBfrs: Tnuint32;
+ getECBFails: Tnuint32;
+ AESEventCounts: Tnuint32;
+ postponedEvents: Tnuint32;
+ ECBCxlFails: Tnuint32;
+ validBfrsReused: Tnuint32;
+ enqueuedSendCount: Tnuint32;
+ totalRXPackets: Tnuint32;
+ unclaimedPackets: Tnuint32;
+ StatisticsTableMajorVersion: Tnuint8;
+ StatisticsTableMinorVersion: Tnuint8;
+ end;
+
+ PNWFSE_LSL_INFO = ^TNWFSE_LSL_INFO;
+ TNWFSE_LSL_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ LSLInfo: TLSL_INFO;
+ end;
+ { LSL Logical Board Statistics }
+
+ PNWFSE_LSL_LOGICAL_BOARD_STATS = ^TNWFSE_LSL_LOGICAL_BOARD_STATS;
+ TNWFSE_LSL_LOGICAL_BOARD_STATS = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved0: Tnuint16;
+ LogTtlTxPackets: Tnuint32;
+ LogTtlRxPackets: Tnuint32;
+ LogUnclaimedPackets: Tnuint32;
+ reserved1: Tnuint32;
+ end;
+ { objtype }
+
+const
+ FSE_ADAPTER_OBJECT = 0;
+ FSE_CHANGER_OBJECT = 1;
+ FSE_DEVICE_OBJECT = 2;
+ FSE_MEDIA_OBJECT = 4;
+ FSE_PARTITION_OBJECT = 5;
+ FSE_SLOT_OBJECT = 6;
+ FSE_HOTFIX_OBJECT = 7;
+ FSE_MIRROR_OBJECT = 8;
+ FSE_PARITY_OBJECT = 9;
+ FSE_VOLUME_SEG_OBJECT = 10;
+ FSE_VOLUME_OBJECT = 11;
+ FSE_CLONE_OBJECT = 12;
+ FSE_MAGAZINE_OBJECT = 14;
+ FSE_VIRTUAL_DEVICE_OBJECT = 15;
+ FSE_MAX_OBJECTS = 128;
+ FSE_UNKNOWN_OBJECT = $FFFF;
+ FSE_UNKNOWN_OBJECT_TYPE = $FFFF;
+ { mediatype }
+ FSE_HARD_DISK = 0;
+ FSE_CDROM_DISK = 1;
+ FSE_WORM_DISK = 2;
+ FSE_TAPE_DEVICE = 3;
+ FSE_MAGNETO_OPTICAL = 4;
+ { cartridgetype }
+ FSE_FIXED_MEDIA = $00000000;
+ FSE_FLOPPY_5_25 = $00000001;
+ FSE_FLOPPY_3_5 = $00000002;
+ FSE_OPTICAL_5_25 = $00000003;
+ FSE_OPTICAL_3_5 = $00000004;
+ FSE_TAPE_0_5 = $00000005;
+ FSE_TAPE_0_25 = $00000006;
+ FSE_TAPE_8_MM = $00000007;
+ FSE_TAPE_4_MM = $00000008;
+ FSE_BERNOULLI_DISK = $00000009;
+ { type }
+ { same as defined below for object types }
+ { status bits }
+ FSE_OBJECT_ACTIVATED = $00000001;
+ FSE_OBJECT_CREATED = $00000002;
+ FSE_OBJECT_SCRAMBLED = $00000004;
+ FSE_OBJECT_RESERVED = $00000010;
+ FSE_OBJECT_BEING_IDENTIFIED = $00000020;
+ FSE_OBJECT_MAGAZINE_LOADED = $00000040;
+ FSE_OBJECT_FAILURE = $00000080;
+ FSE_OBJECT_REMOVABLE = $00000100;
+ FSE_OBJECT_READ_ONLY = $00000200;
+ FSE_OBJECT_IN_DEVICE = $00010000;
+ FSE_OBJECT_ACCEPTS_MAGAZINES = $00020000;
+ FSE_OBJECT_IS_IN_A_CHANGER = $00040000;
+ FSE_OBJECT_LOADABLE = $00080000;
+ FSE_OBJECT_BEING_LOADED = $00080000;
+ FSE_OBJECT_DEVICE_LOCK = $01000000;
+ FSE_OBJECT_CHANGER_LOCK = $02000000;
+ FSE_OBJECT_REMIRRORING = $04000000;
+ FSE_OBJECT_SELECTED = $08000000;
+ { functionmask }
+ FSE_RANDOM_READ = $0001;
+ FSE_RANDOM_WRITE = $0002;
+ FSE_RANDOM_WRITE_ONCE = $0004;
+ FSE_SEQUENTIAL_READ = $0008;
+ FSE_SEQUENTIAL_WRITE = $0010;
+ FSE_RESET_END_OF_TAPE = $0020;
+ FSE_SINGLE_FILE_MARK = $0040;
+ FSE_MULTIPLE_FILE_MARK = $0080;
+ FSE_SINGLE_SET_MARK = $0100;
+ FSE_MULTIPLE_SET_MARK = $0200;
+ FSE_SPACE_DATA_BLOCKS = $0400;
+ FSE_LOCATE_DATA_BLOCKS = $0800;
+ FSE_POSITION_PARTITION = $1000;
+ FSE_POSITION_MEDIA = $2000;
+ { controlmask }
+ FSE_ACTIVATE_DEACTIVE = $0001;
+ FSE_MOUNT_DISMOUNT = $0002;
+ FSE_SELECT_UNSELECT = $0004;
+ FSE_LOCK_UNLOCK = $0008;
+ FSE_EJECT = $0010;
+ FSE_MOVE = $0020;
+type
+
+ PMEDIA_INFO_DEF = ^TMEDIA_INFO_DEF;
+ TMEDIA_INFO_DEF = record
+ _label: array[0..63] of Tnuint8;
+ identificationType: Tnuint32;
+ identificationTimeStamp: Tnuint32;
+ end;
+
+ PFSE_MM_OBJ_INFO = ^TFSE_MM_OBJ_INFO;
+ TFSE_MM_OBJ_INFO = record
+ MediaInfo: TMEDIA_INFO_DEF;
+ mediaType: Tnuint32;
+ cartridgeType: Tnuint32;
+ unitSize: Tnuint32;
+ blockSize: Tnuint32;
+ capacity: Tnuint32;
+ preferredUnitSize: Tnuint32;
+ name: array[0..63] of Tnuint8;
+ _type: Tnuint32;
+ status: Tnuint32;
+ functionMask: Tnuint32;
+ controlMask: Tnuint32;
+ parentCount: Tnuint32;
+ siblingCount: Tnuint32;
+ childCount: Tnuint32;
+ specificInfoSize: Tnuint32;
+ objectUniqueID: Tnuint32;
+ mediaSlot: Tnuint32;
+ end;
+
+ PNWFSE_MEDIA_MGR_OBJ_INFO = ^TNWFSE_MEDIA_MGR_OBJ_INFO;
+ TNWFSE_MEDIA_MGR_OBJ_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ fseMMObjInfo: TFSE_MM_OBJ_INFO;
+ end;
+ { Get Media Manager Objects List
+ Get Media Manager Object Children's List }
+
+ PNWFSE_MEDIA_MGR_OBJ_LIST = ^TNWFSE_MEDIA_MGR_OBJ_LIST;
+ TNWFSE_MEDIA_MGR_OBJ_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ nextStartObjNum: Tnuint32;
+ objCount: Tnuint32;
+ objs: array[0..(FSE_MAX_OBJECTS) - 1] of Tnuint32;
+ end;
+ { Get Volume Segment List }
+
+const
+ FSE_MAX_NUM_SEGS_RETURNED = 43;
+type
+
+ PVOLUME_SEGMENT = ^TVOLUME_SEGMENT;
+ TVOLUME_SEGMENT = record
+ volumeSegmentDeviceNum: Tnuint32;
+ volumeSegmentOffset: Tnuint32;
+ volumeSegmentSize: Tnuint32;
+ end;
+ { segment info follows }
+ { VOLUME_SEGMENT structures are packed }
+
+ PNWFSE_VOLUME_SEGMENT_LIST = ^TNWFSE_VOLUME_SEGMENT_LIST;
+ TNWFSE_VOLUME_SEGMENT_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numOfVolumeSegments: Tnuint32;
+ volumeSegment: array[0..41] of TVOLUME_SEGMENT;
+ end;
+ { Volume Information by Level }
+
+ PVOLUME_INFO_BY_LEVEL_DEF = ^TVOLUME_INFO_BY_LEVEL_DEF;
+ TVOLUME_INFO_BY_LEVEL_DEF = record
+ volumeType: Tnuint32;
+ statusFlagBits: Tnuint32;
+ sectorSize: Tnuint32;
+ sectorsPerCluster: Tnuint32;
+ volumeSizeInClusters: Tnuint32;
+ freedClusters: Tnuint32;
+ subAllocFreeableClusters: Tnuint32;
+ freeableLimboSectors: Tnuint32;
+ nonFreeableLimboSectors: Tnuint32;
+ nonFreeableAvailSubAllocSectors: Tnuint32;
+ notUsableSubAllocSectors: Tnuint32;
+ subAllocClusters: Tnuint32;
+ dataStreamsCount: Tnuint32;
+ limboDataStreamsCount: Tnuint32;
+ oldestDeletedFileAgeInTicks: Tnuint32;
+ compressedDataStreamsCount: Tnuint32;
+ compressedLimboDataStreamsCount: Tnuint32;
+ unCompressableDataStreamsCount: Tnuint32;
+ preCompressedSectors: Tnuint32;
+ compressedSectors: Tnuint32;
+ migratedFiles: Tnuint32;
+ migratedSectors: Tnuint32;
+ clustersUsedByFAT: Tnuint32;
+ clustersUsedByDirectories: Tnuint32;
+ clustersUsedByExtendedDirs: Tnuint32;
+ totalDirectoryEntries: Tnuint32;
+ unUsedDirectoryEntries: Tnuint32;
+ totalExtendedDirectoryExtants: Tnuint32;
+ unUsedExtendedDirectoryExtants: Tnuint32;
+ extendedAttributesDefined: Tnuint32;
+ extendedAttributeExtantsUsed: Tnuint32;
+ directoryServicesObjectID: Tnuint32;
+ volumeLastModifiedDateAndTime: Tnuint32;
+ end;
+
+ PVOLUME_INFO_BY_LEVEL_DEF2 = ^TVOLUME_INFO_BY_LEVEL_DEF2;
+ TVOLUME_INFO_BY_LEVEL_DEF2 = record
+ volumeActiveCount: Tnuint32;
+ volumeUseCount: Tnuint32;
+ mACRootIDs: Tnuint32;
+ volumeLastModifiedDateAndTime: Tnuint32;
+ volumeReferenceCount: Tnuint32;
+ compressionLowerLimit: Tnuint32;
+ outstandingIOs: Tnuint32;
+ outstandingCompressionIOs: Tnuint32;
+ compressionIOsLimit: Tnuint32;
+ end;
+
+ PVOLUME_INFO_BY_LEVEL = ^TVOLUME_INFO_BY_LEVEL;
+ TVOLUME_INFO_BY_LEVEL = record
+ case longint of
+ 0: (volInfoDef: TVOLUME_INFO_BY_LEVEL_DEF);
+ 1: (volInfoDef2: TVOLUME_INFO_BY_LEVEL_DEF2);
+ end;
+
+ PNWFSE_VOLUME_INFO_BY_LEVEL = ^TNWFSE_VOLUME_INFO_BY_LEVEL;
+ TNWFSE_VOLUME_INFO_BY_LEVEL = record
+ serverAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ infoLevel: Tnuint32;
+ volumeInfo: TVOLUME_INFO_BY_LEVEL;
+ end;
+ { Active Protocol Stacks }
+
+const
+ FSE_MAX_NUM_OF_STACKINFO = 25;
+type
+
+ PSTACK_INFO = ^TSTACK_INFO;
+ TSTACK_INFO = record
+ StackNum: Tnuint32;
+ StackShortName: array[0..15] of Tnuint8;
+ end;
+
+ PNWFSE_ACTIVE_STACKS = ^TNWFSE_ACTIVE_STACKS;
+ TNWFSE_ACTIVE_STACKS = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ maxNumOfStacks: Tnuint32;
+ stackCount: Tnuint32;
+ nextStartNum: Tnuint32;
+ stackInfo: array[0..(FSE_MAX_NUM_OF_STACKINFO) - 1] of TSTACK_INFO;
+ end;
+ { Get Protocol Stack Configuration Information }
+
+const
+ FSE_STK_FULL_NAME_STR_LEN_MAX = 256;
+type
+
+ PNWFSE_PROTOCOL_STK_CONFIG_INFO = ^TNWFSE_PROTOCOL_STK_CONFIG_INFO;
+ TNWFSE_PROTOCOL_STK_CONFIG_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ configMajorVersionNum: Tnuint8;
+ configMinorVersionNum: Tnuint8;
+ stackMajorVersionNum: Tnuint8;
+ stackMinorVersionNum: Tnuint8;
+ stackShortName: array[0..15] of Tnuint8;
+ end;
+ { Get Protocol Stack Statistics Information }
+ { always set to 3? }
+
+ PNWFSE_PROTOCOL_STK_STATS_INFO = ^TNWFSE_PROTOCOL_STK_STATS_INFO;
+ TNWFSE_PROTOCOL_STK_STATS_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ statMajorVersionNum: Tnuint8;
+ statMinorVersionNum: Tnuint8;
+ commonCounters: Tnuint16;
+ validCountersMask: Tnuint32;
+ totalTxPackets: Tnuint32;
+ totalRxPackets: Tnuint32;
+ ignoredRxPackets: Tnuint32;
+ numCustomCounters: Tnuint16;
+ end;
+ { Get Protocol Stack Custom Information }
+ { (Tnint32, byte[])[] - byte[] is a length preceded
+ ** non-null terminated string. }
+
+ PNWFSE_PROTOCOL_CUSTOM_INFO = ^TNWFSE_PROTOCOL_CUSTOM_INFO;
+ TNWFSE_PROTOCOL_CUSTOM_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved0: Tnuint16;
+ customCount: Tnuint32;
+ customStruct: array[0..511] of Tnuint8;
+ end;
+
+const
+ FSE_STACK_IDS_MAX = 128;
+ FSE_NO_FRAME_ID_MAC = 0;
+ FSE_APPLE_LOCALTALK = 1;
+ FSE_ETHERNETII_DEC = 2;
+ FSE_ETHERNET_802_3_USING_802_2 = 3;
+ FSE_TRING_802_5_USING_802_2 = 4;
+ FSE_IPX_802_3 = 5;
+ FSE_TOKEN_PASSING_BUS = 6;
+ FSE_IBM_PC_NETWORK_II = 7;
+ FSE_GATEWAY_GNET = 8;
+ FSE_PROTEON_PRONET = 9;
+ FSE_ENET_802_3_USING_802_2_SNAP = 10;
+ FSE_TRING_802_5_USE_802_2_SNAP = 11;
+ FSE_RACORE_FRAME = 12;
+ FSE_ISDN_FRAME = 13;
+ FSE_NOVELL_ARCNET = 14;
+ FSE_IBM_PCN2_USING_802_2 = 15;
+ FSE_IBM_PCN2_USING_802_2_SNAP = 16;
+ FSE_CORVUS_FRAME = 17;
+ FSE_HARRIS_ADACOM_FRAME = 18;
+ FSE_IP_TUNNEL_FRAME = 19;
+ FSE_FDDI_USING_802_2 = 20;
+ FSE_COMMTEX_FRAME = 21;
+ FSE_DATACO_FRAME = 22;
+ FSE_FDDI_USING_802_2_SMAP = 23;
+ FSE_SDLC_TUNNEL = 24;
+ FSE_PC_OFFICE_FRAME = 25;
+ FSE_HYPERCOMMUNICATIONS = 26;
+ FSE_NOVELL_FRAME = 27;
+type
+
+ PNWFSE_PROTOCOL_ID_NUMS = ^TNWFSE_PROTOCOL_ID_NUMS;
+ TNWFSE_PROTOCOL_ID_NUMS = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ stackIDCount: Tnuint32;
+ stackIDs: array[0..(FSE_STACK_IDS_MAX) - 1] of Tnuint32;
+ end;
+ { Get Media Name by Media Number }
+
+const
+ FSE_MEDIA_NAME_LEN_MAX = 81;
+type
+
+ PNWFSE_MEDIA_NAME_LIST = ^TNWFSE_MEDIA_NAME_LIST;
+ TNWFSE_MEDIA_NAME_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ end;
+ { Get Loaded Media Number List }
+
+const
+ FSE_MEDIA_LIST_MAX = 32;
+type
+
+ PNWFSE_LOADED_MEDIA_NUM_LIST = ^TNWFSE_LOADED_MEDIA_NUM_LIST;
+ TNWFSE_LOADED_MEDIA_NUM_LIST = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ maxMediaTypes: Tnuint32;
+ mediaListCount: Tnuint32;
+ mediaList: array[0..(FSE_MEDIA_LIST_MAX) - 1] of Tnuint32;
+ end;
+ { Get General Router And SAP Information }
+
+ PNWFSE_GENERAL_ROUTER_SAP_INFO = ^TNWFSE_GENERAL_ROUTER_SAP_INFO;
+ TNWFSE_GENERAL_ROUTER_SAP_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ internalRIPSocket: Tnuint32;
+ internalRouterDownFlag: Tnuint32;
+ trackOnFlag: Tnuint32;
+ externalRouterActiveFlag: Tnuint32;
+ internalSAPSocketNumber: Tnuint32;
+ replyToNearestServerFlag: Tnuint32;
+ end;
+ { Get Network Router Information }
+
+ PNWFSE_NETWORK_ROUTER_INFO = ^TNWFSE_NETWORK_ROUTER_INFO;
+ TNWFSE_NETWORK_ROUTER_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ NetIDNumber: Tnuint32;
+ HopsToNet: Tnuint16;
+ NetStatus: Tnuint16;
+ TimeToNet: Tnuint16;
+ end;
+ { Get Network Routers Information }
+
+ PROUTERS_INFO = ^TROUTERS_INFO;
+ TROUTERS_INFO = record
+ nodeAddress: array[0..5] of Tnuint8;
+ connectedLAN: Tnuint32;
+ routeHops: Tnuint16;
+ routeTime: Tnuint16;
+ end;
+ { 512 / sizeof( ROUTERS_INFO ) }
+
+ PNWFSE_NETWORK_ROUTERS_INFO = ^TNWFSE_NETWORK_ROUTERS_INFO;
+ TNWFSE_NETWORK_ROUTERS_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ NumberOfEntries: Tnuint32;
+ routersInfo: array[0..35] of TROUTERS_INFO;
+ end;
+ { Get Known Networks Information }
+
+const
+ FSE_LOCALBIT = $01;
+ FSE_NETSTARBIT = $02;
+ FSE_NETRELIABLEBIT = $04;
+ FSE_NETWANBIT = $10;
+type
+
+ PKNOWN_NET_INFO = ^TKNOWN_NET_INFO;
+ TKNOWN_NET_INFO = record
+ netIDNumber: Tnuint32;
+ hopsToNet: Tnuint16;
+ netStatus: Tnuint16;
+ timeToNet: Tnuint16;
+ end;
+ { 512 / sizeof( KNOWN_NET_INFO ) }
+
+ PNWFSE_KNOWN_NETWORKS_INFO = ^TNWFSE_KNOWN_NETWORKS_INFO;
+ TNWFSE_KNOWN_NETWORKS_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberOfEntries: Tnuint32;
+ knownNetInfo: array[0..50] of TKNOWN_NET_INFO;
+ end;
+ { Get Server Information }
+
+ PNWFSE_SERVER_INFO = ^TNWFSE_SERVER_INFO;
+ TNWFSE_SERVER_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ serverAddress: array[0..11] of Tnuint8;
+ hopsToServer: Tnuint16;
+ end;
+ { Get Server Sources Information }
+
+ PSERVERS_SRC_INFO = ^TSERVERS_SRC_INFO;
+ TSERVERS_SRC_INFO = record
+ serverNode: array[0..5] of Tnuint8;
+ connectedLAN: Tnuint32;
+ sourceHops: Tnuint16;
+ end;
+ { 512 / sizeof( SERVERS_SRC_INFO ) }
+
+ PNWFSE_SERVER_SRC_INFO = ^TNWFSE_SERVER_SRC_INFO;
+ TNWFSE_SERVER_SRC_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberOfEntries: Tnuint32;
+ serversSrcInfo: array[0..41] of TSERVERS_SRC_INFO;
+ end;
+
+ PNWFSE_KNOWN_SERVER_INFO = ^TNWFSE_KNOWN_SERVER_INFO;
+ TNWFSE_KNOWN_SERVER_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberOfEntries: Tnuint32;
+ data: array[0..511] of Tnuint8;
+ end;
+
+const
+ FSE_TYPE_NUMBER = 0;
+ FSE_TYPE_BOOLEAN = 1;
+ FSE_TYPE_TICKS = 2;
+ { 512 * number }
+ FSE_TYPE_BLOCK_SHIFT = 3;
+ { [+|-]hh:mm:ss converted to seconds }
+ FSE_TYPE_TIME_OFFSET = 4;
+ FSE_TYPE_STRING = 5;
+ { The following show the types of triggers }
+ FSE_TYPE_TRIGGER = 6;
+ FSE_TYPE_TRIGGER_OFF = $00;
+ FSE_TYPE_TRIGGER_ON = $01;
+ FSE_TYPE_TRIGGER_PENDING = $10;
+ FSE_TYPE_TRIGGER_SUCCESS = $20;
+ FSE_TYPE_TRIGGER_FAILED = $30;
+ { setCmdFlags }
+ FSE_STARTUP_ONLY = $01;
+ FSE_HIDE = $02;
+ FSE_ADVANCED = $04;
+ FSE_STARTUP_OR_LATER = $08;
+ { Can't be performed on secured console }
+ FSE_NOT_SECURED_CONSOLE = $10;
+ { setCmdCategory }
+ FSE_COMMUNICATIONS = 0;
+ FSE_MEMORY = 1;
+ FSE_FILE_CACHE = 2;
+ FSE_DIR_CACHE = 3;
+ FSE_FILE_SYSTEM = 4;
+ FSE_LOCKS = 5;
+ FSE_TRANSACTION_TRACKING = 6;
+ FSE_DISK = 7;
+ FSE_TIME = 8;
+ FSE_NCP = 9;
+ FSE_MISCELLANEOUS = 10;
+ FSE_ERRORS = 11;
+ FSE_DIRECTORY_SERVICES = 12;
+ FSE_MULTIPROCESSOR = 13;
+ FSE_SERVICE_LOCATION_PROTOCOL = 14;
+ { The setNameAndValueInfo contains ASCIIZ strings in the following layout:
+ ** byte setCmdName[ ];
+ ** byte setCmdValue[ ]; }
+type
+
+ PNWFSE_SERVER_SET_CMDS_INFO = ^TNWFSE_SERVER_SET_CMDS_INFO;
+ TNWFSE_SERVER_SET_CMDS_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberOfSetCommands: Tnuint32;
+ nextSequenceNumber: Tnuint32;
+ setCmdType: Tnuint32;
+ setCmdCategory: Tnuint32;
+ setCmdFlags: Tnuint32;
+ setNameAndValueInfo: array[0..499] of Tnuint8;
+ end;
+ { Len preceded string which is not NULL terminated }
+
+ PNWFSE_SERVER_SET_CATEGORIES = ^TNWFSE_SERVER_SET_CATEGORIES;
+ TNWFSE_SERVER_SET_CATEGORIES = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint16;
+ numberOfSetCategories: Tnuint32;
+ nextSequenceNumber: Tnuint32;
+ categoryName: array[0..511] of Tnuint8;
+ end;
+ { MLID Board Info }
+
+const
+ FSE_MAX_NUM_BOARD_INFO = 18;
+type
+
+ PMLID_BOARD_INFO = ^TMLID_BOARD_INFO;
+ TMLID_BOARD_INFO = record
+ protocolBoardNum: Tnuint32;
+ protocolNumber: Tnuint16;
+ protocolID: array[0..5] of Tnuint8;
+ protocolName: array[0..15] of Tnuint8;
+ end;
+
+ PNWFSE_MLID_BOARD_INFO = ^TNWFSE_MLID_BOARD_INFO;
+ TNWFSE_MLID_BOARD_INFO = record
+ serverTimeAndVConsoleInfo: TSERVER_AND_VCONSOLE_INFO;
+ reserved: Tnuint8;
+ numberProtocols: Tnuint8;
+ MLIDBoardInfo: array[0..(FSE_MAX_NUM_BOARD_INFO) - 1] of TMLID_BOARD_INFO;
+ end;
+ { Enumerate Network Addresses }
+
+ PNW_GUID = ^TNW_GUID;
+ TNW_GUID = record
+ GUID: array[0..15] of Tnuint8;
+ end;
+
+ PNWFSE_NETWORK_ADDRESS = ^TNWFSE_NETWORK_ADDRESS;
+ TNWFSE_NETWORK_ADDRESS = record
+ addressType: Tnuint32;
+ addressSize: Tnuint32;
+ address: pnuint8;
+ end;
+ { retInfoMask for NWEnumServerConnInfo }
+
+const
+ CONN_INFO_TRANS_MASK = $00000001;
+ CONN_INFO_LOGIN_TIME_MASK = $00000002;
+ CONN_INFO_LOGIN_NAME_MASK = $00000004;
+ CONN_INFO_LOCK_MASK = $00000008;
+ CONN_INFO_PRINT_MASK = $00000010;
+ CONN_INFO_STATS_MASK = $00000020;
+ CONN_INFO_ACCT_MASK = $00000040;
+ CONN_INFO_AUTH_MASK = $00000080;
+ CONN_INFO_ALL_MASK = $FFFFFFFF;
+ { some structs for NWEnumServerConnInfo }
+type
+
+ PNWFSE_LOGIN_TIME = ^TNWFSE_LOGIN_TIME;
+ TNWFSE_LOGIN_TIME = record
+ loginTime: array[0..6] of Tnuint8;
+ loginExpirationTime: Tnuint32;
+ end;
+
+ PNWFSE_LOGIN_NAME = ^TNWFSE_LOGIN_NAME;
+ TNWFSE_LOGIN_NAME = record
+ loginObjectType: Tnuint32;
+ loginNameLen: Tnuint8;
+ loginName: pnuint8;
+ end;
+
+ PNWFSE_LOCK_INFO = ^TNWFSE_LOCK_INFO;
+ TNWFSE_LOCK_INFO = record
+ logicalLockThreshold: Tnuint8;
+ recordLockThreshold: Tnuint8;
+ fileLockCount: Tnuint16;
+ recordLockCount: Tnuint16;
+ end;
+
+ PNWFSE_PRINT_INFO = ^TNWFSE_PRINT_INFO;
+ TNWFSE_PRINT_INFO = record
+ printFlags: Tnuint8;
+ tabSize: Tnuint8;
+ numberCopies: Tnuint8;
+ printToFileFlag: Tnuint8;
+ bannerFileName: array[0..13] of Tnuint8;
+ targetServerID: Tnuint8;
+ formType: Tnuint8;
+ end;
+
+ PNWFSE_STATS_INFO = ^TNWFSE_STATS_INFO;
+ TNWFSE_STATS_INFO = record
+ totalBytesRead: array[0..5] of Tnuint8;
+ totalBytesWritten: array[0..5] of Tnuint8;
+ totalRequests: Tnuint32;
+ end;
+
+ PNWFSE_ACCT_INFO = ^TNWFSE_ACCT_INFO;
+ TNWFSE_ACCT_INFO = record
+ holdTime: Tnuint32;
+ holdAmt: Tnuint32;
+ chargeAmt: Tnuint32;
+ heldConnectTimeInMinutes: Tnuint32;
+ heldRequests: Tnuint32;
+ heldBytesRead: array[0..5] of Tnuint8;
+ heldBytesWritten: array[0..5] of Tnuint8;
+ end;
+
+ PNWFSE_AUTH_INFO = ^TNWFSE_AUTH_INFO;
+ TNWFSE_AUTH_INFO = record
+ loginStatus: Tnuint32;
+ loginPrivileges: Tnuint32;
+ end;
+
+function NWGetCacheInfo(conn: TNWCONN_HANDLE; fseCacheInfo: PNWFSE_CACHE_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetFileServerInfo(conn: TNWCONN_HANDLE; fseFileServerInfo: PNWFSE_FILE_SERVER_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNetWareFileSystemsInfo(conn: TNWCONN_HANDLE; fseFileSystemInfo: PNWFSE_FILE_SYSTEM_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetUserInfo(conn: TNWCONN_HANDLE; connNum: Tnuint32; userName: Pnstr8; fseUserInfo: PNWFSE_USER_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetPacketBurstInfo(conn: TNWCONN_HANDLE; fsePacketBurstInfo: PNWFSE_PACKET_BURST_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetIPXSPXInfo(conn: TNWCONN_HANDLE; fseIPXSPXInfo: PNWFSE_IPXSPX_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetGarbageCollectionInfo(conn: TNWCONN_HANDLE; fseGarbageCollectionInfo: PNWFSE_GARBAGE_COLLECTION_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetCPUInfo(conn: TNWCONN_HANDLE; CPUNum: Tnuint32; CPUName: Pnstr8; numCoprocessor: Pnstr8; bus: Pnstr8;
+ fseCPUInfo: PNWFSE_CPU_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeSwitchInfo(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseVolumeSwitchInfo: PNWFSE_VOLUME_SWITCH_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNLMLoadedList(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseNLMLoadedList: PNWFSE_NLM_LOADED_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNLMInfo(conn: TNWCONN_HANDLE; NLMNum: Tnuint32; fileName: Pnstr8; NLMname: Pnstr8; copyright: Pnstr8;
+ fseNLMInfo: PNWFSE_NLM_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetDirCacheInfo(conn: TNWCONN_HANDLE; fseDirCacheInfo: PNWFSE_DIR_CACHE_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetOSVersionInfo(conn: TNWCONN_HANDLE; fseOSVersionInfo: PNWFSE_OS_VERSION_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetActiveConnListByType(conn: TNWCONN_HANDLE; startConnNum: Tnuint32; connType: Tnuint32; fseActiveConnListByType: PNWFSE_ACTIVE_CONN_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNLMsResourceTagList(conn: TNWCONN_HANDLE; NLMNum: Tnuint32; startNum: Tnuint32; fseNLMsResourceTagList: PNWFSE_NLMS_RESOURCE_TAG_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetActiveLANBoardList(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseActiveLANBoardList: PNWFSE_ACTIVE_LAN_BOARD_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLANConfigInfo(conn: TNWCONN_HANDLE; boardNum: Tnuint32; fseLANConfigInfo: PNWFSE_LAN_CONFIG_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLANCommonCountersInfo(conn: TNWCONN_HANDLE; boardNum: Tnuint32; blockNum: Tnuint32; fseLANCommonCountersInfo: PNWFSE_LAN_COMMON_COUNTERS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLANCustomCountersInfo(conn: TNWCONN_HANDLE; boardNum: Tnuint32; startingNum: Tnuint32; fseLANCustomInfo: PNWFSE_LAN_CUSTOM_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLSLInfo(conn: TNWCONN_HANDLE; fseLSLInfo: PNWFSE_LSL_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLSLLogicalBoardStats(conn: TNWCONN_HANDLE; LANBoardNum: Tnuint32; fseLSLLogicalBoardStats: PNWFSE_LSL_LOGICAL_BOARD_STATS): TNWCCODE; NWLIB_CALNLM32;
+function NWGetMediaMgrObjInfo(conn: TNWCONN_HANDLE; objNum: Tnuint32; fseMediaMgrObjInfo: PNWFSE_MEDIA_MGR_OBJ_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetMediaMgrObjList(conn: TNWCONN_HANDLE; startNum: Tnuint32; objType: Tnuint32; fseMediaMgrObjList: PNWFSE_MEDIA_MGR_OBJ_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetMediaMgrObjChildrenList(conn: TNWCONN_HANDLE; startNum: Tnuint32; objType: Tnuint32; parentObjNum: Tnuint32; fseMediaMgrObjList: PNWFSE_MEDIA_MGR_OBJ_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeSegmentList(conn: TNWCONN_HANDLE; volNum: Tnuint32; fseVolumeSegmentList: PNWFSE_VOLUME_SEGMENT_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetVolumeInfoByLevel(conn: TNWCONN_HANDLE; volNum: Tnuint32; infoLevel: Tnuint32; fseVolumeInfo: PNWFSE_VOLUME_INFO_BY_LEVEL): TNWCCODE; NWLIB_CALNLM32;
+function NWGetActiveProtocolStacks(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseActiveStacks: PNWFSE_ACTIVE_STACKS): TNWCCODE; NWLIB_CALNLM32;
+function NWGetProtocolStackConfigInfo(conn: TNWCONN_HANDLE; stackNum: Tnuint32; stackFullName: Pnstr8; fseProtocolStkConfigInfo: PNWFSE_PROTOCOL_STK_CONFIG_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetProtocolStackStatsInfo(conn: TNWCONN_HANDLE; stackNum: Tnuint32; fseProtocolStkStatsInfo: PNWFSE_PROTOCOL_STK_STATS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetProtocolStackCustomInfo(conn: TNWCONN_HANDLE; stackNum: Tnuint32; customStartNum: Tnuint32; fseProtocolStackCustomInfo: PNWFSE_PROTOCOL_CUSTOM_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetProtocolStkNumsByMediaNum(conn: TNWCONN_HANDLE; mediaNum: Tnuint32; fseProtocolStkIDNums: PNWFSE_PROTOCOL_ID_NUMS): TNWCCODE; NWLIB_CALNLM32;
+function NWGetProtocolStkNumsByLANBrdNum(conn: TNWCONN_HANDLE; LANBoardNum: Tnuint32; fseProtocolStkIDNums: PNWFSE_PROTOCOL_ID_NUMS): TNWCCODE; NWLIB_CALNLM32;
+function NWGetMediaNameByMediaNum(conn: TNWCONN_HANDLE; mediaNum: Tnuint32; mediaName: Pnstr8; fseMediaNameList: PNWFSE_MEDIA_NAME_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetLoadedMediaNumList(conn: TNWCONN_HANDLE; fseLoadedMediaNumList: PNWFSE_LOADED_MEDIA_NUM_LIST): TNWCCODE; NWLIB_CALNLM32;
+function NWGetGeneralRouterAndSAPInfo(conn: TNWCONN_HANDLE; fseGeneralRouterSAPInfo: PNWFSE_GENERAL_ROUTER_SAP_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNetworkRouterInfo(conn: TNWCONN_HANDLE; networkNum: Tnuint32; fseNetworkRouterInfo: PNWFSE_NETWORK_ROUTER_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetNetworkRoutersInfo(conn: TNWCONN_HANDLE; networkNum: Tnuint32; startNum: Tnuint32; fseNetworkRoutersInfo: PNWFSE_NETWORK_ROUTERS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetKnownNetworksInfo(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseKnownNetworksInfo: PNWFSE_KNOWN_NETWORKS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetServerInfo(conn: TNWCONN_HANDLE; serverType: Tnuint32; serverName: Pnstr8; fseServerInfo: PNWFSE_SERVER_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetServerSourcesInfo(conn: TNWCONN_HANDLE; startNum: Tnuint32; serverType: Tnuint32; serverName: Pnstr8; fseServerSrcInfo: PNWFSE_SERVER_SRC_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetKnownServersInfo(conn: TNWCONN_HANDLE; startNum: Tnuint32; serverType: Tnuint32; fseKnownServerInfo: PNWFSE_KNOWN_SERVER_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetServerSetCommandsInfo(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseServerSetCmdsInfo: PNWFSE_SERVER_SET_CMDS_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWGetServerSetCategories(conn: TNWCONN_HANDLE; startNum: Tnuint32; fseServerSetCategories: PNWFSE_SERVER_SET_CATEGORIES): TNWCCODE; NWLIB_CALNLM32;
+function NWGetMLIDBoardInfo(conn: TNWCONN_HANDLE; MLIDBoardNum: Tnuint32; fseMLIDBoardInfo: PNWFSE_MLID_BOARD_INFO): TNWCCODE; NWLIB_CALNLM32;
+function NWEnumNetAddresses(conn: TNWCONN_HANDLE; searchNumber: pnuint32; serverTimeAndVConsoleInfo: PSERVER_AND_VCONSOLE_INFO; reserved: pnuint16; fseServerGUID: PNW_GUID;
+ itemsInArray: Tnuint32; itemsReturned: pnuint32; fseNetworkAddresses: PNWFSE_NETWORK_ADDRESS): TNWCCODE; NWLIB_CALNLM32;
+function NWGenerateGUIDs(connHandle: TNWCONN_HANDLE; GUIDSize: Tnuint32; GUIDList: PNW_GUID): TNWCCODE; NWLIB_CALNLM32;
+function NWGetServerConnInfo(conn: TNWCONN_HANDLE; retInfoMask: Tnuint32; connectionNumber: Tnuint32; serverTimeAndVConsoleInfo: PSERVER_AND_VCONSOLE_INFO; reserved: pnuint16;
+ networkAddress: PNWFSE_NETWORK_ADDRESS; loginTime: PNWFSE_LOGIN_TIME; loginName: PNWFSE_LOGIN_NAME; lockInfo: PNWFSE_LOCK_INFO; printInfo: PNWFSE_PRINT_INFO;
+ statsInfo: PNWFSE_STATS_INFO; acctInfo: PNWFSE_ACCT_INFO; authInfo: PNWFSE_AUTH_INFO): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+//*****************************************************************************
+//nwmigrat.h
+//*****************************************************************************
+
+const
+ MAX_NUM_OF_DATA_STREAMS = 3;
+ MAX_SIZE_OF_SM_STRING = 128;
+ MAX_SIZE_OF_SM_INFO = 128;
+ MAX_NUM_OF_SM = 32;
+ ERR_INVALID_SM_ID = 240;
+ ERR_SM_ALREADY_REGISTERED = 241;
+ ERR_SM_CREATE_FAILED = 242;
+ ERR_SM_CLOSE_FAILED = 243;
+ ERR_SM_WRITE_NO_SPACE = 244;
+ ERR_SM_WRITE_IO_ERROR = 245;
+ ERR_SM_READ_IO_ERROR = 246;
+ ERR_SM_OPEN_FAILED = 247;
+
+ ERR_SM_DELETE_FAILED = 248;
+ { A length preceded string is followed by SMInfo data }
+type
+ PSUPPORT_MODULE_INFO = ^TSUPPORT_MODULE_INFO;
+ TSUPPORT_MODULE_INFO = record
+ IOStatus: Tnuint32;
+ InfoBlockSize: Tnuint32;
+ AvailSpace: Tnuint32;
+ UsedSpace: Tnuint32;
+ SMInfo: array[0..(MAX_SIZE_OF_SM_STRING + MAX_SIZE_OF_SM_INFO) - 1] of Tnuint8;
+ end;
+
+ PSUPPORT_MODULE_IDS = ^TSUPPORT_MODULE_IDS;
+ TSUPPORT_MODULE_IDS = record
+ numberOfSMs: Tnuint32;
+ SMIDs: array[0..(MAX_NUM_OF_SM) - 1] of Tnuint32;
+ end;
+
+
+{ const
+ NWMoveFileToDM = NWMoveFileToDM2;
+ NWMoveFileFromDM = NWMoveFileFromDM2;
+ NWGetDMFileInfo = NWGetDMFileInfo2;
+ NWGetDMVolumeInfo = NWGetDMVolumeInfo2;
+ NWGetDefaultSupportModule = NWGetDefaultSupportModule2;
+ NWSetDefaultSupportModule = NWSetDefaultSupportModule2;
+ NWGetDataMigratorInfo = NWGetDataMigratorInfo2;
+ NWGetSupportModuleInfo = NWGetSupportModuleInfo2;}
+
+
+
+function NWMoveFileToDM(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; nameSpace: Tnuint8; supportModuleID: Tnuint32;
+ saveKeyFlag: Tnuint32): TNWCCODE; NWLIB_CLIB;
+function NWMoveFileFromDM(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; nameSpace: Tnuint8): TNWCCODE; NWLIB_CLIB;
+function NWGetDMFileInfo(conn: TNWCONN_HANDLE; dirHandle: TNWDIR_HANDLE; path: Pnstr8; nameSpace: Tnuint8; supportModuleID: pnuint32;
+ restoreTime: pnuint32; dataStreams: pnuint32): TNWCCODE; NWLIB_CLIB;
+function NWGetDMVolumeInfo(conn: TNWCONN_HANDLE; volume: Tnuint16; supportModuleID: Tnuint32; numberOfFilesMigrated: pnuint32; totalMigratedSize: pnuint32;
+ spaceUsedOnDM: pnuint32; limboSpaceUsedOnDM: pnuint32; spaceMigrated: pnuint32; filesInLimbo: pnuint32): TNWCCODE; NWLIB_CLIB;
+function NWGetSupportModuleInfo(conn: TNWCONN_HANDLE; infomationLevel: Tnuint32; supportModuleID: Tnuint32; returnInfo: pnuint8; returnInfoLen: pnuint32): TNWCCODE; NWLIB_CLIB;
+function NWGetDataMigratorInfo(conn: TNWCONN_HANDLE; DMPresentFlag: pnuint32; majorVersion: pnuint32; minorVersion: pnuint32; DMSMRegistered: pnuint32): TNWCCODE; NWLIB_CLIB;
+function NWGetDefaultSupportModule(conn: TNWCONN_HANDLE; supportModuleID: pnuint32): TNWCCODE; NWLIB_CLIB;
+function NWSetDefaultSupportModule(conn: TNWCONN_HANDLE; supportModuleID: pnuint32): TNWCCODE; NWLIB_CLIB;
+function NWGetSupportModuleCapacity(conn: TNWCONN_HANDLE; luSupportModuleID: Tnuint32; luVolume: Tnuint32; luDirectoryBase: Tnuint32; pluSMBlockSizeInSectors: pnuint32;
+ pluSMTotalBlocks: pnuint32; pluSMUsedBlocks: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+
+
+
+//*****************************************************************************
+//nwsm.h
+//*****************************************************************************
+
+const
+ LOAD_COULD_NOT_FIND_FILE = 1;
+ LOAD_ERROR_READING_FILE = 2;
+ LOAD_NOT_NLM_FILE_FORMAT = 3;
+ LOAD_WRONG_NLM_FILE_VERSION = 4;
+ LOAD_REENTRANT_INITIALIZE_FAILURE = 5;
+ LOAD_CAN_NOT_LOAD_MULTIPLE_COPIES = 6;
+ LOAD_ALREADY_IN_PROGRESS = 7;
+ LOAD_NOT_ENOUGH_MEMORY = 8;
+ LOAD_INITIALIZE_FAILURE = 9;
+ LOAD_INCONSISTENT_FILE_FORMAT = 10;
+ LOAD_CAN_NOT_LOAD_AT_STARTUP = 11;
+ LOAD_AUTO_LOAD_MODULES_NOT_LOADED = 12;
+ LOAD_UNRESOLVED_EXTERNAL = 13;
+ LOAD_PUBLIC_ALREADY_DEFINED = 14;
+ LOAD_XDC_DATA_ERROR = 15;
+ LOAD_NOT_OS_DOMAIN = 16;
+
+function NWSMLoadNLM(connHandle: TNWCONN_HANDLE; loadCommand: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSMLoadNLM2(connHandle: TNWCONN_HANDLE; loadCommand: Pnstr8; loadNLMReturnCode: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWSMUnloadNLM(connHandle: TNWCONN_HANDLE; NLMName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSMMountVolume(connHandle: TNWCONN_HANDLE; volumeName: Pnstr8; volumeNumber: pnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWSMDismountVolumeByNumber(connHandle: TNWCONN_HANDLE; volumeNumber: Tnuint16): TNWCCODE; NWLIB_CALNLM32;
+function NWSMDismountVolumeByName(connHandle: TNWCONN_HANDLE; volumeName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSMAddNSToVolume(connHandle: TNWCONN_HANDLE; volNumber: Tnuint16; namspc: Tnuint8): TNWCCODE; NWLIB_CALNLM32;
+function NWSMSetDynamicCmdStrValue(connHandle: TNWCONN_HANDLE; setCommandName: Pnstr8; cmdValue: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+function NWSMSetDynamicCmdIntValue(connHandle: TNWCONN_HANDLE; setCommandName: Pnstr8; cmdValue: Tnuint32): TNWCCODE; NWLIB_CALNLM32;
+function NWSMExecuteNCFFile(connHandle: TNWCONN_HANDLE; NCFFileName: Pnstr8): TNWCCODE; NWLIB_CALNLM32;
+
+// Obsolete API's
+//****************************************
+//o_ndscon
+//****************************************
+{ replacement - NWCCGetConnInfo }
+function NWDSGetConnectionInfo
+ (connHandle: TNWCONN_HANDLE;
+ connStatus: pnuint8;
+ connType: pnuint8;
+ serverFlags: pnuint8;
+ serverName: pchar;
+ transType: pnuint8;
+ transLen: pnuint32;
+ transBuf: pointer;
+ distance: pnuint16;
+ maxPacketSize: pnuint16): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWDSOpenMonitoredConn }
+function NWDSGetMonitoredConnection
+ (connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWGetPreferredConnName & NWCCOpenConnByName }
+function NWGetPreferredDSServer(connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCLicenseConn }
+function NWDSLockConnection(connHandle: TNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCScanConnRefs }
+function NWGetNextConnectionID(connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCOpenConnByAddr followed by NWCCLicenseConn }
+function NWDSGetConnectionSlot
+ (connType: Tnuint8;
+ transType: Tnuint8;
+ transLen: Tnuint32;
+ transBuf: pointer;
+ connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCScanConnInfo }
+function NWGetNearestDirectoryService(connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCScanConnInfo, NWCCOpenConnByRef, NWCCLicenseConn }
+function NWGetConnectionIDFromAddress
+ (transType: Tnuint8;
+ transLen: Tnuint32;
+ transBuf: pointer;
+ connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCScanConnInfo, NWCCOpenConnByRef, NWCCLicenseConn }
+function NWGetConnectionIDFromName
+ (nameLen: Tnuint32;
+ name: pchar;
+ connHandle: PNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWCCScanConnInfo, NWCCOpenConnByRef }
+function NWGetNearestDSConnRef(connRef: pnuint32): TNWCCODE; NWLIB_DSAPI;
+{ replacement - NWDSSetDefNameContext }
+function NWSetDefaultNameContext
+ (contextLength: Tnuint16;
+ context: pnuint8): TNWCCODE; NWLIB_DSAPI;
+
+{ replacement - NWDSGetDefNameContext }
+function NWGetDefaultNameContext
+ (bufferSize: Tnuint16;
+ context: pnuint8): TNWCCODE; NWLIB_DSAPI;
+
+{ replacement - NWCCGetNumConns }
+function NWGetNumConnections(numConnections: pnuint16): TNWCCODE; NWLIB_DSAPI;
+
+{ replacement - NWDSCanDSAuthenticate }
+function NWIsDSAuthenticated: TNWCCODE; NWLIB_DSAPI;
+
+{ replacement - NWCCUnlicenseConn }
+function NWDSUnlockConnection(connHandle: TNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+
+{ replacement - NWCCGetPrefServerName }
+function NWGetPreferredConnName(preferredName: pnuint8; preferredType: pnuint8): TNWCCODE; NWLIB_DSAPI;
+
+{ replacment - NWCSysCloseConnRef }
+function NWFreeConnectionSlot(connHandle: TNWCONN_HANDLE; disconnectType: Tnuint8): TNWCCODE; NWLIB_DSAPI;
+
+{ replacement - NONE (monitored connections are managed automatically
+ * by the client software) }
+function NWDSSetMonitoredConnection(connHandle: TNWCONN_HANDLE): TNWCCODE; NWLIB_DSAPI;
+
+
+
+type
+ PNMBYTE = ^TNMBYTE;
+ PNMUNI = ^TNMUNI;
+ PSCBYTE = ^TSCBYTE;
+ PSCUNI = ^TSCUNI;
+
+
+implementation
+(*
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function nwunisize(x : longint) : longint;
+ begin
+ //nwunisize:=(sizeof(x)) / (sizeof(unicode));
+ end;
+
+ { was #define dname def_expr }
+ function NWU_UNCHANGED_FUNCTION : pointer;
+ begin
+ //NWU_UNCHANGED_FUNCTION:=pointer(-(1));
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWLocalToUnicode(P1,P2,P3,P4,P5,P6 : longint) : longint;
+ begin
+ //NWLocalToUnicode:=NWLocalToUnicode(P1,P2,P3,P4,P5,P6,1);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWUnicodeToLocal(P1,P2,P3,P4,P5,P6 : longint) : longint;
+ begin
+ //NWUnicodeToLocal:=NWUnicodeToLocal(P1,P2,P3,P4,P5,P6,1);
+ end;
+
+ {function NWInitUnicodeTables(CountryCode,CodePage : longint) : longint;
+ begin
+ NWInitUnicodeTables:=NWLInitXlateTables(CodePage,N_UNI_LOAD_MONOCASE or N_UNI_LOAD_COLLATION);
+ end;}
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function uniicmp(s1,s2 : longint) : longint;
+ begin
+ //uniicmp:=nwusuniicmp(s1,s2);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function uninicmp(s1,s2,l : longint) : longint;
+ begin
+ //uninicmp:=nwusuninicmp(s1,s2,l);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWScanForTrustees(a,b,c,d,e,f : longint) : longint;
+ begin
+ //NWScanForTrustees:=NWIntScanForTrustees(a,b,c,d,e,f,0);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWScanForTrusteesExt(a,b,c,d,e,f : longint) : longint;
+ begin
+ //NWScanForTrusteesExt:=NWIntScanForTrusteesExt(a,b,c,d,e,f,0);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWScanDirectoryInformation(a,b,c,d,e,f,g,h : longint) : longint;
+ begin
+ //NWScanDirectoryInformation:=NWIntScanDirectoryInformation(a,b,c,d,e,f,g,h,0);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWIntFileSearchInitialize(a,b,c,d,e,f,g,h : longint) : longint;
+ begin
+ //NWIntFileSearchInitialize:=NWFileSearchInitialize(a,b,c,d,e,f,g);
+ end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function NWScanFileInformation(a,b,c,d,e,f : longint) : longint;
+ begin
+ //NWScanFileInformation:=NWIntScanFileInformation(a,b,c,d,e,f,0);
+ end;
+*)
+end.
+
+{
+ $Log: nwcalls.pp,v $
+ Revision 1.1 2005/01/14 22:13:11 armin
+ * added nwcalls.pp
+
+}
diff --git a/rtl/netware/nwnit.pp b/rtl/netware/nwnit.pp
new file mode 100644
index 0000000000..2074ec0085
--- /dev/null
+++ b/rtl/netware/nwnit.pp
@@ -0,0 +1,3165 @@
+{ $Id: nwnit.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+
+ Netware Server Imports for FreePascal, contains definition from the
+ following ndk header files:
+
+ nit/nwaccntg.h nit/nwafp.h nit/nwbindry.h nit/nwdatamg.h nit/nwdir.h
+ nit/nwenvrn.h nit/nwenvrn1.h nit/nwextatt.h nit/nwmsg.h nit/nwnit.h
+ nit/nwqueue.h nit/nwserial.h nit/nwservst.h nit/nwsync.h nit/nwtts.h
+
+ Initial Version 2002/02/22 Armin (diehl@nordrhein.de or armin@freepascal.org)
+
+ The C-NDK and Documentation can be found here:
+ http://developer.novell.com
+
+ This program is distributed in the hope that it will be useful,but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE.
+
+ Do not blame Novell if there are errors in this file, instead
+ contact me and i will se what i can do.
+
+}
+
+unit nwnit;
+
+interface
+
+{$mode objfpc}
+{$packrecords C}
+
+const
+ Clib='clib';
+
+function AccountingInstalled (fileServerID:word):longint;cdecl;external Clib name 'AccountingInstalled';
+function GetAccountStatus (binderyObjectType:word;
+ binderyObjectName:Pchar;
+ balance,limits,holds:Plongint):longint;cdecl;external Clib name 'GetAccountStatus';
+function GetAccountStatus (binderyObjectType:word;
+ binderyObjectName:Pchar;
+ var balance,limits,holds:longint):longint;cdecl;external Clib name 'GetAccountStatus';
+
+function SubmitAccountCharge(binderyObjectType:word;
+ binderyObjectName:Pchar;
+ serviceType:word;
+ chargeAmount:longint;
+ cancelHoldAmount:longint;
+ commentType:word;
+ comment:Pchar):longint;cdecl;external Clib name 'SubmitAccountCharge';
+function SubmitAccountChargeWithLength(
+ binderyObjectType:word;
+ binderyObjectName:Pchar;
+ serviceType:word;
+ chargeAmount:longint;
+ cancelHoldAmount:longint;
+ commentType:word;
+ commentData:pointer;
+ commentLength:word):longint;cdecl;external Clib name 'SubmitAccountChargeWithLength';
+function SubmitAccountHold (binderyObjectType:word;
+ binderyObjectName:Pchar;
+ reserveAmount:longint):longint;cdecl;external Clib name 'SubmitAccountHold';
+function SubmitAccountNote (binderyObjectType:word;
+ binderyObjectName:Pchar;
+ serviceType:word;
+ commentType:word;
+ comment:Pchar):longint;cdecl;external Clib name 'SubmitAccountNote';
+
+{------------------------------------------------------------------------------}
+
+{$include npackon.inc}
+
+type
+ PAFPFILEINFO = ^TAFPFILEINFO;
+ TAFPFILEINFO = record
+ entryID : longint;
+ parentID : longint;
+ attributes : word;
+ dataForkLength : longint;
+ resourceForkLength : longint;
+ numOffspring : word;
+ creationDate : word;
+ accessDate : word;
+ modifyDate : word;
+ modifyTime : word;
+ backupDate : word;
+ backupTime : word;
+ finderInfo : array[0..31] of byte;
+ longName : array[0..32] of char;
+ pad1 : char;
+ ownerID : longint;
+ shortName : array[0..12] of char;
+ pad2 : char;
+ accessPrivileges : word;
+ proDosInfo : array[0..5] of byte;
+ end;
+
+ PAFPSETINFO = ^TAFPSETINFO;
+ TAFPSETINFO = record
+ attributes : word;
+ creationDate : word;
+ accessDate : word;
+ modifyDate : word;
+ modifyTime : word;
+ backupDate : word;
+ backupTime : word;
+ finderInfo : array[0..31] of byte;
+ proDosInfo : array[0..5] of byte;
+ end;
+{$include npackoff.inc}
+
+function AFPAllocTemporaryDirHandle (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ AFPPathString:Pchar;
+ NetWareDirectoryHandle:PBYTE;
+ AccessRights:PBYTE):longint; cdecl;external Clib name 'AFPAllocTemporaryDirHandle';
+
+function AFPCreateDirectory (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ finderInfo:PBYTE;
+ AFPPathString:Pchar;
+ newAFPEntryID:Plongint):longint;cdecl;external Clib name 'AFPCreateDirectory';
+
+function AFPCreateFile (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ deleteExistingFile:byte;
+ finderInfo:PBYTE;
+ AFPPathString:Pchar;
+ newAFPEntryID:Plongint):longint; cdecl;external Clib name 'AFPCreateFile';
+
+function AFPDelete (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ AFPPathString:Pchar):longint; cdecl;external Clib name 'AFPDelete';
+
+function AFPDirectoryEntry (connectionID:word;
+ directoryHandle:byte;
+ pathName:Pchar):longint; cdecl;external Clib name 'AFPDirectoryEntry';
+
+function AFPGetEntryIDFromName (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ AFPPathString:Pchar;
+ newAFPEntryID:Plongint):longint; cdecl;external Clib name 'AFPGetEntryIDFromName';
+
+function AFPGetEntryIDFromNetWareHandle (connectionID:word;
+ NetWareHandle:PBYTE;
+ volumeID:PBYTE;
+ AFPEntryID:Plongint;
+ forkIndicator:PBYTE):longint; cdecl;external Clib name 'AFPGetEntryIDFromNetWareHandle';
+
+function AFPGetEntryIDFromNetWareHandle (connectionID:word;
+ var NetWareHandle:byte;
+ var volumeID:byte;
+ var AFPEntryID:longint;
+ var forkIndicator:byte):longint; cdecl;external Clib name 'AFPGetEntryIDFromNetWareHandle';
+
+function AFPGetEntryIDFromPathName (connectionID:word;
+ directoryHandle:byte;
+ pathName:Pchar;
+ AFPEntryID:Plongint):longint; cdecl;external Clib name 'AFPGetEntryIDFromPathName';
+
+function AFPGetFileInformation (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ requestBitMap:word;
+ AFPPathString:Pchar;
+ strucSize:word;
+ AFPFileInfo:PAFPFILEINFO):longint; cdecl;external Clib name 'AFPGetFileInformation';
+
+function AFPGetFileInformation (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ requestBitMap:word;
+ AFPPathString:Pchar;
+ strucSize:word;
+ var AFPFileInfo:TAFPFILEINFO):longint; cdecl;external Clib name 'AFPGetFileInformation';
+
+function AFPOpenFileFork (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ forkIndicator:byte;
+ accessMode:byte;
+ AFPPathString:Pchar;
+ fileID:Plongint;
+ forkLength:Plongint;
+ NetWareHandle:PBYTE;
+ fileHandle:Plongint):longint; cdecl;external Clib name 'AFPOpenFileFork';
+
+function AFPOpenFileFork (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ forkIndicator:byte;
+ accessMode:byte;
+ AFPPathString:Pchar;
+ var fileID:longint;
+ var forkLength:longint;
+ var NetWareHandle:byte;
+ var fileHandle:longint):longint; cdecl;external Clib name 'AFPOpenFileFork';
+
+
+function AFPRename (connectionID:word;
+ volumeNum:byte;
+ AFPSourceEntryID:longint;
+ AFPDestEntryID:longint;
+ AFPSourcePath:Pchar;
+ AFPDestPath:Pchar):longint; cdecl;external Clib name 'AFPRename';
+
+function AFPScanFileInformation (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ AFPLastSeenID:Plongint;
+ searchBitMap:word;
+ requestBitMap:word;
+ AFPPathString:Pchar;
+ strucSize:word;
+ AFPScanFileInfo:PAFPFILEINFO):longint; cdecl;external Clib name 'AFPScanFileInformation';
+function AFPScanFileInformation (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ AFPLastSeenID:Plongint;
+ searchBitMap:word;
+ requestBitMap:word;
+ AFPPathString:Pchar;
+ strucSize:word;
+ var AFPScanFileInfo:TAFPFILEINFO):longint; cdecl;external Clib name 'AFPScanFileInformation';
+
+function AFPSetFileInformation (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ requestBitMap:word;
+ AFPPathString:Pchar;
+ strucSize:word;
+ AFPSetInfo:PAFPSETINFO):longint; cdecl;external Clib name 'AFPSetFileInformation';
+
+function AFPSetFileInformation (connectionID:word;
+ volumeNum:byte;
+ AFPEntryID:longint;
+ requestBitMap:word;
+ AFPPathString:Pchar;
+ strucSize:word;
+ var AFPSetInfo:TAFPSETINFO):longint; cdecl;external Clib name 'AFPSetFileInformation';
+
+function AFPSupported (connectionID:word):longint; cdecl;external Clib name 'AFPSupported';
+
+
+{------------------------------------------------------------------------------}
+const
+ BS_ANY_READ = $0000;
+ BS_ANY_WRITE = $0000; // Writeable by anyone
+ BS_LOGGED_READ = $0001; // Must be logged in to read
+ BS_OBJECT_READ = $0002; // Readable by same object or super
+ BS_SUPER_READ = $0003; // Readable by supervisor only
+ BS_BINDERY_READ = $0004; // Readable only by the bindery
+ BS_LOGGED_WRITE = $0010; // Must be logged in to write
+ BS_OBJECT_WRITE = $0020; // Writeable by same object or super
+ BS_SUPER_WRITE = $0030; // Writeable only by the supervisor
+ BS_BINDERY_WRITE = $0040; // Writeable by the bindery only
+
+ // Bindery object type definitions
+ OT_WILD = -(1);
+
+ OT_UNKNOWN = $0000;
+ OT_USER = $0001;
+ OT_USER_GROUP = $0002;
+ OT_GROUP = $0002;
+ OT_PRINT_QUEUE = $0003;
+
+ OT_FILE_SERVER = $0004;
+ OT_JOB_SERVER = $0005;
+ OT_GATEWAY = $0006;
+ OT_PRINT_SERVER = $0007;
+ OT_ARCHIVE_QUEUE = $0008;
+
+ OT_ARCHIVE_SERVER = $0009;
+ OT_JOB_QUEUE = $000A;
+ OT_ADMINISTRATION = $000B;
+ OT_NAS_SNA_GATEWAY = $0021;
+ OT_REMOTE_BRIDGE_SERVER = $0024;
+ OT_TCPIP_GATEWAY = $0027;
+ OT_TIME_SYNCHRONIZATION_SERVER = $002D;
+ OT_ARCHIVE_SERVER_DYNAMIC_SAP = $002E;
+ OT_ADVERTISING_PRINT_SERVER = $0047;
+ OT_BTRIEVE_VAP = $004B;
+ OT_NWSQL_VAP = $004C;
+ OT_PRINT_QUEUE_USER = $0053;
+
+ // Attributes of objects and properties in the bindery
+ BF_STATIC = $0000;
+ BF_DYNAMIC = $0001;
+ BF_ITEM = $0000;
+ BF_SET = $0002;
+
+ BL_OBJECT = 48; // Maximum lengths of object, properties, (includes terminating null)
+ BL_PROPERTY = 16;
+ BL_PASSWORD = 128;
+
+function AddBinderyObjectToSet (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ memberName : Pchar;
+ memberType : word):longint; cdecl;external Clib name 'AddBinderyObjectToSet';
+
+function ChangeBinderyObjectPassword (objectName : Pchar;
+ objectType : word;
+ oldPassword : Pchar;
+ newPassword : Pchar):longint; cdecl;external Clib name 'ChangeBinderyObjectPassword';
+
+function ChangeBinderyObjectSecurity (objectName : Pchar;
+ objectType : word;
+ newObjectSecurity : byte):longint; cdecl;external Clib name 'ChangeBinderyObjectSecurity';
+
+
+function ChangePropertySecurity (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ newPropertySecurity: byte):longint; cdecl;external Clib name 'ChangePropertySecurity';
+
+function CloseBindery:longint; cdecl;external Clib name 'CloseBindery';
+function CreateBinderyObject (objectName : Pchar;
+ objectType : word;
+ objectFlag : byte;
+ objectSecurity : byte):longint; cdecl;external Clib name 'CreateBinderyObject';
+function CreateProperty (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ propertyFlags : byte;
+ propertySecurity : byte):longint; cdecl;external Clib name 'CreateProperty';
+
+function DeleteBinderyObject (objectName : Pchar;
+ objectType : word):longint; cdecl;external Clib name 'DeleteBinderyObject';
+
+function DeleteBinderyObjectFromSet (objectName:Pchar;
+ objectType:word;
+ propertyName:Pchar;
+ memberName:Pchar;
+ memberType:word):longint; cdecl;external Clib name 'DeleteBinderyObjectFromSet';
+
+function DeleteProperty (objectName:Pchar;
+ objectType:word;
+ propertyName:Pchar):longint; cdecl;external Clib name 'DeleteProperty';
+function GetBinderyAccessLevel (accessLevel:PBYTE;
+ objectID:Plongint):longint; cdecl;external Clib name 'GetBinderyAccessLevel';
+function GetBinderyAccessLevel (var accessLevel:byte;
+ var objectID:longint):longint; cdecl;external Clib name 'GetBinderyAccessLevel';
+
+function GetBinderyObjectID (objectName:Pchar;
+ objectType:word;
+ objectID:Plongint):longint; cdecl;external Clib name 'GetBinderyObjectID';
+function GetBinderyObjectID (objectName:Pchar;
+ objectType:word;
+ var objectID:longint):longint; cdecl;external Clib name 'GetBinderyObjectID';
+function GetBinderyObjectName (objectID:longint;
+ objectName:Pchar;
+ objectType:PWORD):longint; cdecl;external Clib name 'GetBinderyObjectName';
+function GetBinderyObjectName (objectID:longint;
+ objectName:Pchar;
+ var objectType:word):longint; cdecl;external Clib name 'GetBinderyObjectName';
+
+function IsBinderyObjectInSet (objectName:Pchar;
+ objectType:word;
+ propertyName:Pchar;
+ memberName:Pchar;
+ memberType:word):longint; cdecl;external Clib name 'IsBinderyObjectInSet';
+function OpenBindery:longint; cdecl;external Clib name 'OpenBindery';
+function ReadPropertyValue (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ segmentNumber: longint;
+ propertyValue: PBYTE;
+ moreSegments : PBYTE;
+ propertyFlags: PBYTE):longint; cdecl;external Clib name 'ReadPropertyValue';
+function ReadPropertyValue (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ segmentNumber: longint;
+ var propertyValue: byte;
+ var moreSegments : byte;
+ var propertyFlags: byte):longint; cdecl;external Clib name 'ReadPropertyValue';
+
+function RenameBinderyObject (objectName : Pchar;
+ newObjectName: Pchar;
+ objectType : word):longint; cdecl;external Clib name 'RenameBinderyObject';
+
+function ScanBinderyObject (searchObjectName:Pchar;
+ searchObjectType:word;
+ objectID:Plongint;
+ objectName:Pchar;
+ objectType:PWORD;
+ objectHasProperties:Pchar;
+ objectFlag:Pchar;
+ objectSecurity:Pchar):longint; cdecl;external Clib name 'ScanBinderyObject';
+function ScanBinderyObject (searchObjectName:Pchar;
+ searchObjectType:word;
+ var objectID:longint;
+ objectName:Pchar;
+ var objectType:word;
+ objectHasProperties:Pchar;
+ objectFlag:Pchar;
+ objectSecurity:Pchar):longint; cdecl;external Clib name 'ScanBinderyObject';
+
+function ScanProperty (objectName:Pchar;
+ objectType:word;
+ searchPropertyName:Pchar;
+ sequenceNumber:Plongint;
+ propertyName:Pchar;
+ propertyFlags:Pchar;
+ propertySecurity:Pchar;
+ propertyHasValue:Pchar;
+ moreProperties:Pbyte):longint; cdecl;external Clib name 'ScanProperty';
+function ScanProperty (objectName:Pchar;
+ objectType:word;
+ searchPropertyName:Pchar;
+ var sequenceNumber:longint;
+ propertyName:Pchar;
+ propertyFlags:Pchar;
+ propertySecurity:Pchar;
+ propertyHasValue:Pchar;
+ var moreProperties:byte):longint; cdecl;external Clib name 'ScanProperty';
+
+
+function VerifyBinderyObjectPassword (objectName : Pchar;
+ objectType : word;
+ password : Pchar):longint; cdecl;external Clib name 'VerifyBinderyObjectPassword';
+
+function WritePropertyValue (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ segmentNumber : longint;
+ propertyValue : PBYTE;
+ moreSegments : byte):longint; cdecl;external Clib name 'WritePropertyValue';
+function WritePropertyValue (objectName : Pchar;
+ objectType : word;
+ propertyName : Pchar;
+ segmentNumber : longint;
+ var propertyValue : byte;
+ moreSegments : byte):longint; cdecl;external Clib name 'WritePropertyValue';
+
+
+{------------------------------------------------------------------------------}
+const
+ ERR_INVALID_SUPPORT_MODULE_ID = 240;
+ ERR_SUPPORT_MODULE_ALREADY_REGISTERED = 241;
+ ERR_SUPPORT_MODULE_CREATE_FAILED = 242;
+ ERR_SUPPORT_MODULE_CLOSE_FAILED = 243;
+ ERR_SM_WRITE_NO_SPACE = 244;
+ ERR_SM_WRITE_IO_ERROR = 245;
+ ERR_SM_READ_IO_ERROR = 246;
+ ERR_SUPPORT_MODULE_OPEN_FAILED = 247;
+ ERR_SUPPORT_MODULE_DELETE_FAILED = 248;
+ MaximumNumberOfDataStreams = 3;
+{$include npackon.inc}
+(*
+TInfo0Rep = record
+ rIOStatus : longint;
+ rInfoBlockSize: longint;
+ rAvailSpace: longint;
+ rUsedSpace: longint;
+ rSMString: byte;
+end;
+
+TInfo1Rep = record
+ rSMRegs : longint;
+end;
+
+TInfo2Rep = record
+ NameLength : byte;
+end;
+*)
+
+type
+ PSUPPORT_MODULE_INFO = ^TSUPPORT_MODULE_INFO;
+ TSUPPORT_MODULE_INFO = record
+ IOStatus : longint;
+ InfoBlockSize : longint;
+ AvailSpace : longint;
+ UsedSpace : longint;
+ SMString : char; // 128 length limit, Info block follows string
+ end;
+
+{$include npackoff.inc}
+
+
+function NWDeRegisterDMSupportModule (SupportModuleID:longint;
+ SupportModuleName:PChar;
+ SlotNumber:longint):longint; cdecl;external Clib name 'NWDeRegisterDMSupportModule';
+function NWDeRegisterRTDataMigrationNLM (Station:longint;
+ DMTAG:PBYTE;
+ ForceFlag:longint):longint; cdecl;external Clib name 'NWDeRegisterRTDataMigrationNLM';
+function NWDeRegisterRTDataMigrationNLM (Station:longint;
+ var DMTAG:byte;
+ ForceFlag:longint):longint; cdecl;external Clib name 'NWDeRegisterRTDataMigrationNLM';
+{ Local and Remote Call }
+procedure NWGetDataMigratorInfo (DMPresentFlag:PLongint;
+ majorVersion:PLongint;
+ minorVersion:PLongint;
+ numberOfSupportModules:PLongint); cdecl;external Clib name 'NWGetDataMigratorInfo';
+procedure NWGetDataMigratorInfo (var DMPresentFlag:longint;
+ var majorVersion:longint;
+ var minorVersion:longint;
+ var numberOfSupportModules:longint); cdecl;external Clib name 'NWGetDataMigratorInfo';
+{ Local and Remote call }
+function NWGetDefaultSupportModule (defaultSupportModuleID:PLongint):longint; cdecl;external Clib name 'NWGetDefaultSupportModule';
+function NWGetDefaultSupportModule (var defaultSupportModuleID:longint):longint; cdecl;external Clib name 'NWGetDefaultSupportModule';
+
+{ Local and Remote call }
+function NWGetDMFileInfo (path:Pchar;
+ nameSpace:longint;
+ supportModuleID:PLongint;
+ validDataStreams:PLongint;
+ estRetrievalTime:PLongint;
+ info:PLongint):longint;cdecl;external Clib name 'NWGetDMFileInfo';
+function NWGetDMFileInfo (path:Pchar;
+ nameSpace:longint;
+ var supportModuleID:longint;
+ var validDataStreams:longint;
+ var estRetrievalTime:longint;
+ var info:longint):longint;cdecl;external Clib name 'NWGetDMFileInfo';
+
+{ Local and Remote call }
+function NWGetDMVolumeInfo (volume:longint;
+ supportModuleID:longint;
+ numberOfFilesMigrated:PLongint;
+ totalMigratedSize:PLongint;
+ spaceUsed:PLongint;
+ limboUsed:PLongint;
+ spaceMigrated:PLongint;
+ filesLimbo:PLongint):longint; cdecl;external Clib name 'NWGetDMVolumeInfo';
+function NWGetDMVolumeInfo (volume:longint;
+ supportModuleID:longint;
+ var numberOfFilesMigrated:longint;
+ var totalMigratedSize:longint;
+ var spaceUsed:longint;
+ var limboUsed:longint;
+ var spaceMigrated:longint;
+ var filesLimbo:longint):longint; cdecl;external Clib name 'NWGetDMVolumeInfo';
+{ Local and Remote call }
+function NWGetSupportModuleInfo (informationLevel:longint;
+ supportModuleID:longint;
+ returnInfo:pointer;
+ returnInfoLen:PLongint):longint;cdecl;external Clib name 'NWGetSupportModuleInfo';
+function NWGetSupportModuleInfo (informationLevel:longint;
+ supportModuleID:longint;
+ returnInfo:pointer;
+ var returnInfoLen:longint):longint;cdecl;external Clib name 'NWGetSupportModuleInfo';
+
+function NWIsDataMigrationAllowed (Volume:longint):longint; cdecl;external Clib name 'NWIsDataMigrationAllowed';
+{ Local and Remote call }
+function NWMoveFileFromDM (path:Pchar;
+ nameSpace:longint):longint; cdecl;external Clib name 'NWMoveFileFromDM';
+{ Local and Remote call }
+function NWMoveFileToDM (path:Pchar;
+ nameSpace:longint;
+ SupportModuleID:longint;
+ flags:longint):longint; cdecl;external Clib name 'NWMoveFileToDM';
+
+function NWPeekFileData (path:Pchar;
+ nameSpace:longint;
+ noWaitFlag:longint;
+ startingSector:longint;
+ sectorsToRead:longint;
+ buffer:PBYTE;
+ sectorsRead:PLongint;
+ bytesRead:PLongint;
+ NoWaitReason:PLongint):longint; cdecl;external Clib name 'NWPeekFileData';
+function NWPeekFileData (path:Pchar;
+ nameSpace:longint;
+ noWaitFlag:longint;
+ startingSector:longint;
+ sectorsToRead:longint;
+ var buffer;
+ var sectorsRead:longint;
+ var bytesRead:longint;
+ var NoWaitReason:longint):longint; cdecl;external Clib name 'NWPeekFileData';
+type TFunction = function : longint; cdecl;
+
+function NWRegisterDMSupportModule (ioFlag:longint;
+ addr:array of TFunction;
+ SupportModuleName:PBYTE;
+ SupportModuleID:longint;
+ MaxSectorsXF:longint;
+ SlotNumber:PLongint):longint; cdecl;external Clib name 'NWRegisterDMSupportModule';
+
+function NWRegisterRTDataMigrationNLM (Station:longint;
+ addr:array of TFunction;
+ DMTAG:PBYTE; majorVersion:longint;
+ minorVersion:longint):longint; cdecl;external Clib name 'NWRegisterRTDataMigrationNLM';
+{ Local and Remote call }
+function NWSetDefaultSupportModule (newSupportModuleID:longint;
+ currentSupportModuleID:PLongint):longint; cdecl;external Clib name 'NWSetDefaultSupportModule';
+function NWSetDefaultSupportModule (newSupportModuleID:longint;
+ var currentSupportModuleID:longint):longint; cdecl;external Clib name 'NWSetDefaultSupportModule';
+
+{------------------------------------------------------------------------------}
+{ Trustee Access Rights in a network directory }
+const
+ TA_NONE = $0000;
+ TA_READ = $0001;
+ TA_WRITE = $0002;
+ TA_CREATE = $0008;
+ TA_DELETE = $0010;
+ TA_ACCESSCONTROL = $0020;
+ TA_SEEFILES = $0040;
+ TA_MODIFY = $0080;
+ TA_SUPERVISOR = $0100;
+ TA_ALL = $01FB;
+
+{ Old names for rights }
+ TA_OPEN = $0004;
+ TA_OWNERSHIP = $0020;
+ TA_SEARCH = $0040;
+ BYTES_PER_SECTOR = 512;
+
+{ define volume types }
+ VINetWare386 = 0;
+ VINetWare286 = 1;
+ VINetWare386v30 = 2;
+ VINetWare386v31 = 3;
+{ define the extended volume information status flag bits }
+ NWSubAllocEnabledBit = $01;
+ NWCompressionEnabledBit = $02;
+ NWMigrationEnabledBit = $04;
+ NWAuditingEnabledBit = $08;
+ NWReadOnlyEnabledBit = $10;
+
+{$include npackon.inc}
+type
+ PAnswerStructure = ^TAnswerStructure;
+ TAnswerStructure = record
+ ALevelNumber : byte;
+ AMaximumAmount : longint; // ?? TMisalignedLONG;
+ ACurrentAmount : longint; // ?? TMisalignedLONG;
+ end;
+
+
+ PVOLUME_STATS = ^TVOLUME_STATS;
+ TVOLUME_STATS = record
+ systemElapsedTime : longint;
+ volumeNumber : byte;
+ logicalDriveNumber : byte;
+ sectorsPerBlock : word;
+ startingBlock : longint;
+ totalBlocks : word;
+ availableBlocks : word;
+ totalDirectorySlots : word;
+ availableDirectorySlots : word;
+ maxDirectorySlotsUsed : word;
+ isHashing : byte;
+ isRemovable : byte;
+ isMounted : byte;
+ volumeName : array[0..16] of char;
+ purgableBlocks : longint;
+ notYetPurgableBlocks : longint;
+ end;
+
+ PVOLUME_INFO = ^TVOLUME_INFO;
+ TVOLUME_INFO = record
+ systemElapsedTime : longint;
+ volumeNumber : byte;
+ logicalDriveNumber : byte;
+ sectorsPerBlock : word;
+ startingBlock : smallint;
+ totalBlocks : longint;
+ availableBlocks : longint;
+ totalDirectorySlots : longint;
+ availableDirectorySlots : longint;
+ isHashing : byte;
+ isRemovable : byte;
+ isMounted : byte;
+ volumeName : array[0..16] of char;
+ purgableBlocks : longint;
+ notYetPurgableBlocks : longint;
+ end;
+
+ PNWVolExtendedInfo = ^TNWVolExtendedInfo;
+ TNWVolExtendedInfo = record
+ volType : longint;
+ statusFlag : longint;
+ sectorSize : longint;
+ sectorsPerCluster : longint;
+ volSizeInClusters : longint;
+ freeClusters : longint;
+ subAllocFreeableClusters : longint;
+ freeableLimboSectors : longint;
+ nonfreeableLimboSectors : longint;
+ availSubAllocSectors : longint;
+ nonuseableSubAllocSectors : longint;
+ subAllocClusters : longint;
+ numDataStreams : longint;
+ numLimboDataStreams : longint;
+ oldestDelFileAgeInTicks : longint;
+ numCompressedDataStreams : longint;
+ numCompressedLimboDataStreams : longint;
+ numNoncompressibleDataStreams : longint;
+ precompressedSectors : longint;
+ compressedSectors : longint;
+ numMigratedDataStreams : longint;
+ migratedSectors : longint;
+ clustersUsedByFAT : longint;
+ clustersUsedByDirs : longint;
+ clustersUsedByExtDirs : longint;
+ totalDirEntries : longint;
+ unusedDirEntries : longint;
+ totalExtDirExtants : longint;
+ unusedExtDirExtants : longint;
+ extAttrsDefined : longint;
+ extAttrExtantsUsed : longint;
+ directoryServicesObjectID : longint;
+ lastModifiedDateAndTime : longint;
+ end;
+
+{$include npackoff.inc}
+
+function AddSpaceRestrictionForDirectory (pathName:Pchar;
+ value:longint;
+ allowWildCardsFlag:longint):longint;cdecl;external Clib name 'AddSpaceRestrictionForDirectory';
+function AddTrustee (pathName:Pchar;
+ trusteeID:longint;
+ newRights:word):longint; cdecl;external Clib name 'AddTrustee';
+function AddUserSpaceRestriction (volume:longint;
+ trusteeID:longint;
+ value:longint):longint;cdecl;external Clib name 'AddUserSpaceRestriction';
+function ChangeDirectoryEntry (pathName:Pchar;
+ modifyVector:pointer; //PModifyStructure;
+ modifyBits:longint;
+ allowWildCardsFlag:longint):longint;cdecl;external Clib name 'ChangeDirectoryEntry';
+function ChangeDirectoryEntry (pathName:Pchar;
+ var modifyVector;
+ modifyBits:longint;
+ allowWildCardsFlag:longint):longint;cdecl;external Clib name 'ChangeDirectoryEntry';
+function ConvertNameToFullPath (partialPath:Pchar;
+ fullPath:Pchar):longint;cdecl;external Clib name 'ConvertNameToFullPath';
+function ConvertNameToVolumePath (fileName:Pchar;
+ volumePath:Pchar):longint;cdecl;external Clib name 'ConvertNameToVolumePath';
+function DeleteTrustee (pathName:Pchar;
+ trusteeID:longint):longint;cdecl;external Clib name 'DeleteTrustee';
+function DeleteUserSpaceRestriction (volume:longint;
+ trusteeID:longint):longint;cdecl;external Clib name 'DeleteUserSpaceRestriction';
+function GetAvailableUserDiskSpace (pathName:Pchar;
+ availableSpace:PLongint):longint;cdecl;external Clib name 'GetAvailableUserDiskSpace';
+function GetAvailableUserDiskSpace (pathName:Pchar;
+ var availableSpace:longint):longint;cdecl;external Clib name 'GetAvailableUserDiskSpace';
+function GetDiskSpaceUsedByObject (trusteeID:longint;
+ volume:longint;
+ usedSpace:PLongint):longint;cdecl;external Clib name 'GetDiskSpaceUsedByObject';
+function GetDiskSpaceUsedByObject (trusteeID:longint;
+ volume:longint;
+ var usedSpace:longint):longint;cdecl;external Clib name 'GetDiskSpaceUsedByObject';
+function GetEffectiveRights (pathName:Pchar;
+ accessRights:PWORD):longint;cdecl;external Clib name 'GetEffectiveRights';
+function GetEffectiveRights (pathName:Pchar;
+ var accessRights:word):longint;cdecl;external Clib name 'GetEffectiveRights';
+function GetMaximumUserSpaceRestriction (trusteeID, volume:longint; maxRestriction:PLongint):longint;cdecl;external Clib name 'GetMaximumUserSpaceRestriction';
+function GetMaximumUserSpaceRestriction (trusteeID, volume:longint; var maxRestriction:longint):longint;cdecl;external Clib name 'GetMaximumUserSpaceRestriction';
+function GetNumberOfVolumes : longint; cdecl;external Clib name 'GetNumberOfVolumes';
+function GetVolumeInformation (connectionID:word;
+ volumeNumber:byte;
+ structSize:longint;
+ volumeStatistics:PVOLUME_STATS):longint;cdecl;external Clib name 'GetVolumeInformation';
+function GetVolumeInformation (connectionID:word;
+ volumeNumber:byte;
+ structSize:longint;
+ var volumeStatistics:TVOLUME_STATS):longint;cdecl;external Clib name 'GetVolumeInformation';
+function GetVolumeInfoWithNumber (volumeNumber:byte;
+ volumeName:Pchar;
+ totalBlocks:PWORD;
+ sectorsPerBlock:PWORD;
+ availableBlocks:PWORD;
+ totalDirectorySlots:PWORD;
+ availableDirectorySlots:PWORD;
+ volumeIsRemovable:PWORD):longint;cdecl;external Clib name 'GetVolumeInfoWithNumber';
+function GetVolumeInfoWithNumber (volumeNumber:byte;
+ volumeName:Pchar;
+ var totalBlocks:word;
+ var sectorsPerBlock:word;
+ var availableBlocks:word;
+ var totalDirectorySlots:word;
+ var availableDirectorySlots:word;
+ var volumeIsRemovable:word):longint;cdecl;external Clib name 'GetVolumeInfoWithNumber';
+function GetVolumeName(volumeNumber:longint; volumeName:Pchar):longint;cdecl;external Clib name 'GetVolumeName';
+
+function GetVolumeNumber(volumeName:Pchar; volumeNumber:Plongint):longint;cdecl;external Clib name 'GetVolumeNumber';
+function GetVolumeNumber(volumeName:Pchar; var volumeNumber:longint):longint;cdecl;external Clib name 'GetVolumeNumber';
+function GetVolumeStatistics (connectionID:word;
+ volumeNumber:byte;
+ structSize:longint;
+ volumeStatistics:PVOLUME_INFO):longint;cdecl;external Clib name 'GetVolumeStatistics';
+function GetVolumeStatistics (connectionID:word;
+ volumeNumber:byte;
+ structSize:longint;
+ var volumeStatistics:TVOLUME_INFO):longint;cdecl;external Clib name 'GetVolumeStatistics';
+
+procedure _makepath (path:Pchar;
+ drive:Pchar;
+ dir:Pchar;
+ fname:Pchar;
+ ext:Pchar);cdecl;external Clib name '_makepath';
+
+function ModifyInheritedRightsMask (path:Pchar;
+ revokeRightsMask:word;
+ grantRightsMask:word):longint;cdecl;external Clib name 'ModifyInheritedRightsMask';
+function NWGetExtendedVolumeInfo (volNumber:longint;
+ volName:Pchar;
+ volInfo:PNWVolExtendedInfo):longint;cdecl;external Clib name 'NWGetExtendedVolumeInfo';
+function NWGetExtendedVolumeInfo (volNumber:longint;
+ volName:Pchar;
+ var volInfo:TNWVolExtendedInfo):longint;cdecl;external Clib name 'NWGetExtendedVolumeInfo';
+function NWVolumeIsCDROM (volNumber:longint;
+ isCDROM:PLongint):longint;cdecl;external Clib name 'NWVolumeIsCDROM';
+function NWVolumeIsCDROM (volNumber:longint;
+ var isCDROM:longint):longint;cdecl;external Clib name 'NWVolumeIsCDROM';
+
+function ParsePath (path:Pchar;
+ server:Pchar;
+ volume:Pchar;
+ directories:Pchar):longint;cdecl;external Clib name 'ParsePath';
+function PurgeTrusteeFromVolume (volume:longint;
+ trusteeID:longint):longint;cdecl;external Clib name 'PurgeTrusteeFromVolume';
+
+function ReturnSpaceRestrictionForDirectory(pathName:Pchar;
+ numberOfStructuresToReturn:longint;
+ answerBuffer:pointer;
+ numberOfStructuresReturned:PLongint):longint;cdecl;external Clib name 'ReturnSpaceRestrictionForDirectory';
+function ScanBinderyObjectTrusteePaths (objectID:longint;
+ volumeNumber:byte;
+ sequenceNumber:Plongint;
+ trusteeAccessMask:PWORD;
+ trusteePathName:Pchar):longint;cdecl;external Clib name 'ScanBinderyObjectTrusteePaths';
+function ScanBinderyObjectTrusteePaths (objectID:longint;
+ volumeNumber:byte;
+ var sequenceNumber:longint;
+ var trusteeAccessMask:word;
+ trusteePathName:Pchar):longint;cdecl;external Clib name 'ScanBinderyObjectTrusteePaths';
+(* Const before type ignored *)
+function ScanTrustees (pathName:Pchar;
+ startingOffset:longint;
+ vectorSize:longint;
+ trusteeVector:PLongint;
+ maskVector:PWORD;
+ actualVectorSize:PLongint):longint;cdecl;external Clib name 'ScanTrustees';
+function ScanTrustees (pathName:Pchar;
+ startingOffset:longint;
+ vectorSize:longint;
+ var trusteeVector:longint;
+ var maskVector:longint;
+ var actualVectorSize:longint):longint;cdecl;external Clib name 'ScanTrustees';
+function ScanUserSpaceRestrictions (volume:longint;
+ sequenceNumber:PLongint;
+ numberOfTrusteesToReturn:longint;
+ answerArea:PLongint;
+ numberOfTrusteesReturned:PLongint):longint;cdecl;external Clib name 'ScanUserSpaceRestrictions';
+function ScanUserSpaceRestrictions (volume:longint;
+ var sequenceNumber:longint;
+ numberOfTrusteesToReturn:longint;
+ var answerArea;
+ var numberOfTrusteesReturned:longint):longint;cdecl;external Clib name 'ScanUserSpaceRestrictions';
+
+function SetDirectoryInfo (pathName:Pchar;
+ newCreationDateAndTime:PBYTE;
+ newOwnerObjectID:longint;
+ inheritedRightsMask:word):longint;cdecl;external Clib name 'SetDirectoryInfo';
+
+function SetWildcardTranslationMode (newMode:byte):byte;cdecl;external Clib name 'SetWildcardTranslationMode';
+
+procedure _splitpath (path:Pchar;
+ drive:Pchar;
+ dir:Pchar;
+ fname:Pchar;
+ ext:Pchar);cdecl;external Clib name '_splitpath';
+
+function StripFileServerFromPath (path:Pchar;
+ server:Pchar):Pchar;cdecl;external Clib name 'StripFileServerFromPath';
+function UpdateDirectoryEntry (handle:longint):longint;cdecl;external Clib name 'UpdateDirectoryEntry';
+
+{------------------------------------------------------------------------------}
+const
+ TYPE_NORMAL_SERVER = 0;
+ TYPE_IO_ENGINE = 1;
+ TYPE_MS_ENGINE = 2;
+ LOADER_TYPE_DOS = 1;
+ LOADER_TYPE_OS2 = 2;
+ LOADER_TYPE_MSWIN31 = 3;
+ RSUPER = 3;
+{$include npackon.inc}
+type
+
+ PFILE_SERV_INFO = ^TFILE_SERV_INFO;
+ TFILE_SERV_INFO = record
+ serverName : array[0..47] of char;
+ netwareVersion : byte;
+ netwareSubVersion : byte;
+ maxConnectionsSupported : word;
+ connectionsInUse : word;
+ maxVolumesSupported : word;
+ revisionLevel : byte;
+ SFTLevel : byte;
+ TTSLevel : byte;
+ peakConnectionsUsed : word;
+ accountingVersion : byte;
+ VAPversion : byte;
+ queingVersion : byte;
+ printServerVersion : byte;
+ virtualConsoleVersion : byte;
+ securityRestrictionLevel : byte;
+ internetBridgeSupport : byte;
+ reserved : array[0..59] of byte;
+ CLibMajorVersion : byte;
+ CLibMinorVersion : byte;
+ CLibRevision : byte;
+ end;
+
+{$include npackoff.inc}
+
+function CheckConsolePrivileges:longint;cdecl;external Clib name 'CheckConsolePrivileges';
+function CheckNetWareVersion (majorVersion,
+ minorVersion,
+ revisionNumber,
+ minimumSFTLevel,
+ minimumTTSLevel:word):longint;cdecl;external Clib name 'CheckNetWareVersion';
+function ClearConnectionNumber(connectionNumber:word):longint;cdecl;external Clib name 'ClearConnectionNumber';
+function DisableFileServerLogin:longint;cdecl;external Clib name 'DisableFileServerLogin';
+function DisableTransactionTracking:longint;cdecl;external Clib name 'DisableTransactionTracking';
+function DownFileServer(forceFlag:longint):longint;cdecl;external Clib name 'DownFileServer';
+function EnableFileServerLogin:longint;cdecl;external Clib name 'EnableFileServerLogin';
+function EnableTransactionTracking:longint;cdecl;external Clib name 'EnableTransactionTracking';
+function GetBinderyObjectDiskSpaceLeft (connectionID:word;
+ binderyObjectID:longint;
+ systemElapsedTime:PLongint;
+ unusedDiskBlocks:PLongint;
+ restrictionEnforced:PBYTE):longint;cdecl;external Clib name 'GetBinderyObjectDiskSpaceLeft';
+function GetBinderyObjectDiskSpaceLeft (connectionID:word;
+ binderyObjectID:longint;
+ var systemElapsedTime:Longint;
+ var unusedDiskBlocks:Longint;
+ var restrictionEnforced:byte):longint;cdecl;external Clib name 'GetBinderyObjectDiskSpaceLeft';
+function GetDiskUtilization (objectID:longint;
+ volumeNumber:char;
+ usedDirectories:PLongint;
+ usedFiles:PLongint;
+ usedBlocks:PLongint):longint;cdecl;external Clib name 'GetDiskUtilization';
+function GetDiskUtilization (objectID:longint;
+ volumeNumber:char;
+ var usedDirectories:Longint;
+ var usedFiles:Longint;
+ var usedBlocks:Longint):longint; cdecl;external Clib name 'GetDiskUtilization';
+
+//procedure GetFileServerConnectionID(fileServerName:Pchar; connectionID:PWORD);cdecl;external Clib name 'GetFileServerConnectionID';
+procedure GetFileServerDateAndTime(dateAndTime:PBYTE);cdecl;external Clib name 'GetFileServerDateAndTime';
+procedure GetFileServerDateAndTime(var dateAndTime);cdecl;external Clib name 'GetFileServerDateAndTime';
+function GetFileServerDescriptionStrings (company_Name:Pchar;
+ revision:Pchar;
+ revisionDate:Pchar;
+ copyrightNotice:Pchar):longint;cdecl;external Clib name 'GetFileServerDescriptionStrings';
+function GetFileServerLoginStatus (loginEnabledFlag:PLongint):longint;cdecl;external Clib name 'GetFileServerLoginStatus';
+function GetFileServerLoginStatus (var loginEnabledFlag:Longint):longint;cdecl;external Clib name 'GetFileServerLoginStatus';
+procedure GetFileServerName(connectionID:word; fileServerName:Pchar);cdecl;external Clib name 'GetFileServerName';
+function GetServerConfigurationInfo (serverType:PLongint;
+ loaderType:PLongint):longint;cdecl;external Clib name 'GetServerConfigurationInfo';
+function GetServerConfigurationInfo (var serverType:Longint;
+ var loaderType:Longint):longint;cdecl;external Clib name 'GetServerConfigurationInfo';
+function GetServerInformation (returnSize:longint;
+ serverInfo:PFILE_SERV_INFO):longint;cdecl;external Clib name 'GetServerInformation';
+function GetServerInformation (returnSize:longint;
+ var serverInfo:TFILE_SERV_INFO):longint;cdecl;external Clib name 'GetServerInformation';
+function GetServerMemorySize:longint;cdecl;external Clib name 'GetServerMemorySize';
+function GetServerUtilization:longint;cdecl;external Clib name 'GetServerUtilization';
+function SendConsoleBroadcast(msg:Pchar;
+ connectionCount:word;
+ connectionList:PWORD):longint;cdecl;external Clib name 'SendConsoleBroadcast';
+function SendConsoleBroadcast(msg:Pchar;
+ connectionCount:word;
+ const connectionList:array of word):longint;cdecl;external Clib name 'SendConsoleBroadcast';
+function SetFileServerDateAndTime (year,month,day,hour,minute,second:word):longint;cdecl;external Clib name 'SetFileServerDateAndTime';
+
+
+{------------------------------------------------------------------------------}
+const
+ ENVSERV_OVERHEAD_SIZE = 2 * cardinal(sizeof(WORD));
+ ENVSERV_BUFFER1_SIZE = 512 + ENVSERV_OVERHEAD_SIZE;
+ ENVSERV_CONN_TYPE_286 = 286;
+ ENVSERV_CONN_TYPE_386 = 386;
+
+{$include npackon.inc}
+type
+
+ PCONN_USAGE = ^TCONN_USAGE;
+ TCONN_USAGE = record
+ systemElapsedTime : longint;
+ bytesRead : array[0..5] of byte;
+ bytesWritten : array[0..5] of byte;
+ totalRequestPackets : longint;
+ end;
+
+ PDISK_CACHE_STATS = ^TDISK_CACHE_STATS;
+ TDISK_CACHE_STATS = record
+ systemElapsedTime : longint;
+ cacheBufferCount : word;
+ cacheBufferSize : word;
+ dirtyCacheBuffers : word;
+ cacheReadRequests : longint;
+ cacheWriteRequests : longint;
+ cacheHits : longint;
+ cacheMisses : longint;
+ physicalReadRequests : longint;
+ physicalWriteRequests : longint;
+ physicalReadErrors : word;
+ physicalWriteErrors : word;
+ cacheGetRequests : longint;
+ cacheFullWriteRequests : longint;
+ cachePartialWriteRequests : longint;
+ backgroundDirtyWrites : longint;
+ backgroundAgedWrites : longint;
+ totalCacheWrites : longint;
+ cacheAllocations : longint;
+ thrashingCount : word;
+ LRUBlockWasDirtyCount : word;
+ readBeyondWriteCount : word;
+ fragmentedWriteCount : word;
+ cacheHitOnUnavailCount : word;
+ cacheBlockScrappedCount : word;
+ end;
+
+
+ PDISK_CHANNEL_STATS = ^TDISK_CHANNEL_STATS;
+ TDISK_CHANNEL_STATS = record
+ systemElapsedTime : longint;
+ channelState : word;
+ channelSyncState : word;
+ driverType : byte;
+ driverMajorVersion : byte;
+ driverMinorVersion : byte;
+ driverDescription : array[0..64] of char;
+ IOAddr1 : word;
+ IOAddr1Size : word;
+ IOAddr2 : word;
+ IOAddr2Size : word;
+ sharedMem1Seg : array[0..2] of byte;
+ sharedMem1Ofs : word;
+ sharedMem2Seg : array[0..2] of byte;
+ sharedMem2Ofs : word;
+ interrupt1Used : byte;
+ interrupt1 : byte;
+ interrupt2Used : byte;
+ interrupt2 : byte;
+ DMAChannel1Used : byte;
+ DMAChannel1 : byte;
+ DMAChannel2Used : byte;
+ DMAChannel2 : byte;
+ reserved2 : word;
+ configDescription : array[0..79] of char;
+ end;
+
+
+ PDRIVE_MAP_TABLE = ^TDRIVE_MAP_TABLE;
+ TDRIVE_MAP_TABLE = record
+ systemElapsedTime : longint;
+ SFTLevel : byte;
+ logicalDriveCount : byte;
+ physicalDriveCount : byte;
+ diskChannelTable : array[0..4] of byte;
+ pendingIOCommands : word;
+ mappingTable : array[0..31] of byte;
+ driveMirrorTable : array[0..31] of byte;
+ deadMirrorTable : array[0..31] of byte;
+ remirroredDrive : byte;
+ reserved : byte;
+ remirroredBlock : longint;
+ SFTErrorTable : array[0..59] of word;
+ end;
+
+
+ PSERVER_LAN_IO = ^TSERVER_LAN_IO;
+ TSERVER_LAN_IO = record
+ systemElapsedTime : longint;
+ maxRoutingBuffersAvail : word;
+ maxRoutingBuffersUsed : word;
+ routingBuffersInUse : word;
+ totalFileServicePackets : longint;
+ fileServicePacketsBuffered : word;
+ invalidConnPacketCount : word;
+ badLogicalConnCount : word;
+ packetsRcvdDuringProcCount : word;
+ reprocessedRequestCount : word;
+ badSequenceNumberPacketCount : word;
+ duplicateReplyCount : word;
+ acknowledgementsSent : word;
+ badRequestTypeCount : word;
+ attachDuringProcCount : word;
+ attachWhileAttachingCount : word;
+ forgedDetachRequestCount : word;
+ badConnNumberOnDetachCount : word;
+ detachDuringProcCount : word;
+ repliesCanceledCount : word;
+ hopCountDiscardCount : word;
+ unknownNetDiscardCount : word;
+ noDGroupBufferDiscardCount : word;
+ outPacketNoBufferDiscardCount : word;
+ IPXNotMyNetworkCount : word;
+ NetBIOSPropagationCount : longint;
+ totalOtherPackets : longint;
+ totalRoutedPackets : longint;
+ end;
+
+
+ PSERVER_MISC_INFO = ^TSERVER_MISC_INFO;
+ TSERVER_MISC_INFO = record
+ systemElapsedTime : longint;
+ processorType : byte;
+ reserved : byte;
+ serviceProcessCount : byte;
+ serverUtilizationPercent : byte;
+ maxBinderyObjectsAvail : word;
+ maxBinderyObjectsUsed : word;
+ binderyObjectsInUse : word;
+ serverMemoryInK : word;
+ serverWastedMemoryInK : word;
+ dynamicAreaCount : word;
+ dynamicSpace1 : longint;
+ maxUsedDynamicSpace1 : longint;
+ dynamicSpaceInUse1 : longint;
+ dynamicSpace2 : longint;
+ maxUsedDynamicSpace2 : longint;
+ dynamicSpaceInUse2 : longint;
+ dynamicSpace3 : longint;
+ maxUsedDynamicSpace3 : longint;
+ dynamicSpaceInUse3 : longint;
+ end;
+
+
+ PFILE_SYS_STATS = ^TFILE_SYS_STATS;
+ TFILE_SYS_STATS = record
+ systemElapsedTime : longint;
+ maxOpenFiles : word;
+ maxFilesOpened : word;
+ currOpenFiles : word;
+ totalFilesOpened : longint;
+ totalReadRequests : longint;
+ totalWriteRequests : longint;
+ currChangedFATSectors : word;
+ totalChangedFATSectors : longint;
+ FATWriteErrors : word;
+ fatalFATWriteErrors : word;
+ FATScanErrors : word;
+ maxIndexFilesOpened : word;
+ currOpenIndexedFiles : word;
+ attachedIndexFiles : word;
+ availableIndexFiles : word;
+ end;
+
+
+ PLAN_CONFIG = ^TLAN_CONFIG;
+ TLAN_CONFIG = record
+ networkAddress : array[0..3] of byte;
+ hostAddress : array[0..5] of byte;
+ LANDriverInstalled : byte;
+ optionNumber : byte;
+ configurationText : array[0..159] of char;
+ end;
+
+ PPHYS_DISK_STATS = ^TPHYS_DISK_STATS;
+ TPHYS_DISK_STATS = record
+ systemElapsedTime : longint;
+ diskChannel : byte;
+ diskRemovable : byte;
+ driveType : byte;
+ controllerDriveNumber : byte;
+ controllerNumber : byte;
+ controllerType : byte;
+ driveSize : longint;
+ driveCylinders : word;
+ driveHeads : byte;
+ sectorsPerTrack : byte;
+ driveDefinition : array[0..63] of char;
+ IOErrorCount : word;
+ hotFixStart : longint;
+ hotFixSize : word;
+ hotFixBlockAvailable : word;
+ hotFixDisabled : byte;
+ end;
+
+
+ PTTS_STATS = ^TTTS_STATS;
+ TTTS_STATS = record
+ systemElapsedTime : longint;
+ TTS_Supported : byte;
+ TTS_Enabled : byte;
+ TTS_VolumeNumber : word;
+ TTS_MaxOpenTransactions : word;
+ TTS_MaxTransactionsOpened : word;
+ TTS_CurrTransactionsOpen : word;
+ TTS_TotalTransactions : longint;
+ TTS_TotalWrites : longint;
+ TTS_TotalBackouts : longint;
+ TTS_UnfilledBackouts : word;
+ TTS_DiskBlocksInUse : word;
+ TTS_FATAllocations : longint;
+ TTS_FileSizeChanges : longint;
+ TTS_FilesTruncated : longint;
+ numberOfTransactions : byte;
+ end;
+
+ PTTS_CONNECTIONS = ^TTTS_CONNECTIONS;
+ TTTS_CONNECTIONS = record
+ connectionNumber : byte;
+ taskNumber : byte;
+ end;
+
+
+ PCONN_OPEN_FILES_286 = ^TCONN_OPEN_FILES_286;
+ TCONN_OPEN_FILES_286 = record
+ taskNumber : byte;
+ lockType : byte;
+ accessControl : byte;
+ lockFlag : byte;
+ volumeNumber : byte;
+ dirEntry : word;
+ fileName : array[0..13] of char;
+ end;
+
+ PCONN_OPEN_FILES_386 = ^TCONN_OPEN_FILES_386;
+ TCONN_OPEN_FILES_386 = record
+ taskNumber : word;
+ lockType : byte;
+ accessControl : byte;
+ lockFlag : byte;
+ volumeNumber : byte;
+ parentDirEntry : longint;
+ dirEntry : longint;
+ forkCount : byte;
+ nameSpace : byte;
+ nameLength : byte;
+ fileName : array[0..255] of byte;
+ end;
+
+ PCONN_OPEN_FILES = ^TCONN_OPEN_FILES;
+ TCONN_OPEN_FILES = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( con286 : TCONN_OPEN_FILES_286 );
+ 1 : ( con386 : TCONN_OPEN_FILES_386 );
+ end;
+ end;
+
+ PCONN_SEMAPHORE_286 = ^TCONN_SEMAPHORE_286;
+ TCONN_SEMAPHORE_286 = record
+ openCount : word;
+ semaphoreValue : byte;
+ taskNumber : byte;
+ nameLength : byte;
+ semaphoreName : array[0..254] of byte;
+ end;
+
+ PCONN_SEMAPHORE_386 = ^TCONN_SEMAPHORE_386;
+ TCONN_SEMAPHORE_386 = record
+ openCount : word;
+ semaphoreValue : word;
+ taskNumber : word;
+ nameLength : byte;
+ semaphoreName : array[0..254] of byte;
+ end;
+
+ PCONN_SEMAPHORE = ^TCONN_SEMAPHORE;
+ TCONN_SEMAPHORE = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( con286 : TCONN_SEMAPHORE_286 );
+ 1 : ( con386 : TCONN_SEMAPHORE_386 );
+ end;
+ end;
+
+ PCONN_TASK_INFO_286 = ^TCONN_TASK_INFO_286;
+ TCONN_TASK_INFO_286 = record
+ unionType : word;
+ lockStatus : byte;
+ waitRecord : record
+ case longint of
+ 0 : ( LockStatus1 : record
+ taskNumber : byte;
+ beginAddress : word;
+ endAddress : word;
+ volumeNumber : byte;
+ directoryEntry : word;
+ nameLength : byte;
+ name : byte;
+ end );
+ 1 : ( LockStatus2 : record
+ taskNumber : byte;
+ volumeNumber : byte;
+ directoryEntry : word;
+ nameLength : byte;
+ name : byte;
+ end );
+ 2 : ( LockStatus3Or4 : record
+ taskNumber : byte;
+ nameLength : byte;
+ name : byte;
+ end );
+ end;
+ end;
+
+ PCONN_TASK_INFO_386 = ^TCONN_TASK_INFO_386;
+ TCONN_TASK_INFO_386 = record
+ unionType : word;
+ lockStatus : byte;
+ waitRecord : record
+ case longint of
+ 0 : ( LockStatus1 : record
+ taskNumber : word;
+ beginAddress : longint;
+ endAddress : longint;
+ volumeNumber : word;
+ parentID : longint;
+ directoryEntry : longint;
+ forkCount : byte;
+ nameSpace : byte;
+ nameLength : byte;
+ name : byte;
+ end );
+ 1 : ( LockStatus2 : record
+ taskNumber : word;
+ volumeNumber : word;
+ parentID : longint;
+ directoryEntry : longint;
+ forkCount : byte;
+ nameSpace : byte;
+ nameLength : byte;
+ name : byte;
+ end );
+ 2 : ( LockStatus3Or4 : record
+ taskNumber : word;
+ nameLength : byte;
+ name : byte;
+ end );
+ end;
+ end;
+
+ PCONN_TASK_PAIRS_286 = ^TCONN_TASK_PAIRS_286;
+ TCONN_TASK_PAIRS_286 = record
+ task : byte;
+ taskStatus : byte;
+ end;
+
+ PCONN_TASK_PAIRS_386 = ^TCONN_TASK_PAIRS_386;
+ TCONN_TASK_PAIRS_386 = record
+ task : word;
+ taskStatus : byte;
+ end;
+
+ PCONN_USING_FILE_REQ_286 = ^TCONN_USING_FILE_REQ_286;
+ TCONN_USING_FILE_REQ_286 = record
+ lastRecordSeen : word;
+ directoryHandle : byte;
+ pathLength : byte;
+ path : array[0..254] of byte;
+ end;
+
+ PCONN_USING_FILE_REQ_386 = ^TCONN_USING_FILE_REQ_386;
+ TCONN_USING_FILE_REQ_386 = record
+ forkType : byte;
+ volume : byte;
+ directoryID : longint;
+ nextRecord : word;
+ end;
+
+ PCONN_USING_FILE_REQUEST = ^TCONN_USING_FILE_REQUEST;
+ TCONN_USING_FILE_REQUEST = record
+ unionType : word;
+ reserved1 : word;
+ reserved2 : byte;
+ request : record
+ case longint of
+ 0 : ( req286 : TCONN_USING_FILE_REQ_286 );
+ 1 : ( req386 : TCONN_USING_FILE_REQ_386 );
+ end;
+ end;
+
+ PCONN_USING_FILE_REPLY_286 = ^TCONN_USING_FILE_REPLY_286;
+ TCONN_USING_FILE_REPLY_286 = record
+ useCount : word;
+ openCount : word;
+ openForReadCount : word;
+ openForWriteCount : word;
+ denyReadCount : word;
+ denyWriteCount : word;
+ nextRequestRecord : word;
+ locked : byte;
+ numberOfRecords : word;
+ end;
+
+ PCONN_USING_FILE_REPLY_386 = ^TCONN_USING_FILE_REPLY_386;
+ TCONN_USING_FILE_REPLY_386 = record
+ nextRequestRecord : word;
+ useCount : word;
+ openCount : word;
+ openForReadCount : word;
+ openForWriteCount : word;
+ denyReadCount : word;
+ denyWriteCount : word;
+ locked : byte;
+ forkCount : byte;
+ numberOfRecords : word;
+ end;
+
+ PCONN_USING_FILE_RECORD_286 = ^TCONN_USING_FILE_RECORD_286;
+ TCONN_USING_FILE_RECORD_286 = record
+ connectionNumber : word;
+ taskNumber : byte;
+ lockType : byte;
+ accessFlags : byte;
+ lockStatus : byte;
+ end;
+
+ PCONN_USING_FILE_RECORD_386 = ^TCONN_USING_FILE_RECORD_386;
+ TCONN_USING_FILE_RECORD_386 = record
+ connectionNumber : word;
+ taskNumber : word;
+ lockType : byte;
+ accessFlags : byte;
+ lockStatus : byte;
+ end;
+
+ PCONN_USING_FILE_REPLY = ^TCONN_USING_FILE_REPLY;
+ TCONN_USING_FILE_REPLY = record
+ unionType : word;
+ reply : record
+ case longint of
+ 0 : ( rep286 : TCONN_USING_FILE_REPLY_286 );
+ 1 : ( rep386 : TCONN_USING_FILE_REPLY_386 );
+ end;
+ end;
+
+ PLOGICAL_RECORD_INFO_286 = ^TLOGICAL_RECORD_INFO_286;
+ TLOGICAL_RECORD_INFO_286 = record
+ useCount : word;
+ shareableLockCount : word;
+ nextRequestRecord : word;
+ locked : byte;
+ numberOfRecords : byte;
+ end;
+
+ PLOGICAL_RECORD_INFO_386 = ^TLOGICAL_RECORD_INFO_386;
+ TLOGICAL_RECORD_INFO_386 = record
+ useCount : word;
+ shareableLockCount : word;
+ locked : byte;
+ nextRequestRecord : word;
+ numberOfRecords : word;
+ end;
+
+ PLOGICAL_RECORD_286 = ^TLOGICAL_RECORD_286;
+ TLOGICAL_RECORD_286 = record
+ connectionNumber : word;
+ taskNumber : byte;
+ lockStatus : byte;
+ end;
+
+ PLOGICAL_RECORD_386 = ^TLOGICAL_RECORD_386;
+ TLOGICAL_RECORD_386 = record
+ connectionNumber : word;
+ taskNumber : word;
+ lockStatus : byte;
+ end;
+
+ PLOGICAL_RECORD_INFO = ^TLOGICAL_RECORD_INFO;
+ TLOGICAL_RECORD_INFO = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( lr286 : TLOGICAL_RECORD_INFO_286 );
+ 1 : ( lr386 : TLOGICAL_RECORD_INFO_386 );
+ end;
+ end;
+
+ PLOGICAL_RECORD_REQUEST = ^TLOGICAL_RECORD_REQUEST;
+ TLOGICAL_RECORD_REQUEST = record
+ reserved1 : word;
+ reserved2 : byte;
+ nextRecord : word;
+ nameLength : byte;
+ name : array[0..254] of byte;
+ end;
+
+ PCONN_LOGICAL_RECORD_286 = ^TCONN_LOGICAL_RECORD_286;
+ TCONN_LOGICAL_RECORD_286 = record
+ nextRequest : word;
+ numberOfRecords : byte;
+ end;
+
+ PCONN_LOGICAL_RECORD_386 = ^TCONN_LOGICAL_RECORD_386;
+ TCONN_LOGICAL_RECORD_386 = record
+ nextRequest : word;
+ numberOfRecords : word;
+ end;
+
+ PCONN_LOGICAL_RECORD = ^TCONN_LOGICAL_RECORD;
+ TCONN_LOGICAL_RECORD = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( lr286 : TCONN_LOGICAL_RECORD_286 );
+ 1 : ( lr386 : TCONN_LOGICAL_RECORD_386 );
+ end;
+ end;
+
+ PCONN_LOGICAL_RECORD_BLOCK_286 = ^TCONN_LOGICAL_RECORD_BLOCK_286;
+ TCONN_LOGICAL_RECORD_BLOCK_286 = record
+ taskNumber : byte;
+ lockStatus : byte;
+ lockNameLength : byte;
+ lockName : byte;
+ end;
+
+ PCONN_LOGICAL_RECORD_BLOCK_386 = ^TCONN_LOGICAL_RECORD_BLOCK_386;
+ TCONN_LOGICAL_RECORD_BLOCK_386 = record
+ taskNumber : word;
+ lockStatus : byte;
+ lockNameLength : byte;
+ lockName : byte;
+ end;
+
+ PFILE_PHYSICAL_RECORD_LOCK_286 = ^TFILE_PHYSICAL_RECORD_LOCK_286;
+ TFILE_PHYSICAL_RECORD_LOCK_286 = record
+ nextRequest : word;
+ numberOfLocks : byte;
+ reserved : byte;
+ end;
+
+ PFILE_PHYSICAL_RECORD_LOCK_386 = ^TFILE_PHYSICAL_RECORD_LOCK_386;
+ TFILE_PHYSICAL_RECORD_LOCK_386 = record
+ nextRequest : word;
+ numberOfLocks : word;
+ end;
+
+ PFILE_PHYSICAL_RECORD_LOCK = ^TFILE_PHYSICAL_RECORD_LOCK;
+ TFILE_PHYSICAL_RECORD_LOCK = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( pr286 : TFILE_PHYSICAL_RECORD_LOCK_286 );
+ 1 : ( pr386 : TFILE_PHYSICAL_RECORD_LOCK_286 );
+ end;
+ end;
+
+ PFILE_PHYSICAL_RECORD_286 = ^TFILE_PHYSICAL_RECORD_286;
+ TFILE_PHYSICAL_RECORD_286 = record
+ loggedCount : word;
+ shareLockCount : word;
+ recordStart : longint;
+ recordEnd : longint;
+ connectionNumber : word;
+ taskNumber : byte;
+ lockType : byte;
+ end;
+
+ PFILE_PHYSICAL_RECORD_386 = ^TFILE_PHYSICAL_RECORD_386;
+ TFILE_PHYSICAL_RECORD_386 = record
+ loggedCount : word;
+ shareLockCount : word;
+ recordStart : longint;
+ recordEnd : longint;
+ connectionNumber : word;
+ taskNumber : word;
+ lockType : byte;
+ end;
+
+ PFILE_PHYSICAL_REQUEST_286 = ^TFILE_PHYSICAL_REQUEST_286;
+ TFILE_PHYSICAL_REQUEST_286 = record
+ lastRecord : word;
+ directoryHandle : byte;
+ pathLength : byte;
+ name : array[0..254] of byte;
+ end;
+
+ PFILE_PHYSICAL_REQUEST_386 = ^TFILE_PHYSICAL_REQUEST_386;
+ TFILE_PHYSICAL_REQUEST_386 = record
+ forkType : byte;
+ volume : byte;
+ directoryID : longint;
+ next : word;
+ end;
+
+ PFILE_PHYSICAL_RECORD_REQUEST = ^TFILE_PHYSICAL_RECORD_REQUEST;
+ TFILE_PHYSICAL_RECORD_REQUEST = record
+ unionType : word;
+ reserved1 : word;
+ reserved2 : byte;
+ u : record
+ case longint of
+ 0 : ( pr286 : TFILE_PHYSICAL_REQUEST_286 );
+ 1 : ( pr386 : TFILE_PHYSICAL_REQUEST_386 );
+ end;
+ end;
+
+ PCONN_RECORD_LOCKS_286 = ^TCONN_RECORD_LOCKS_286;
+ TCONN_RECORD_LOCKS_286 = record
+ nextRecord : word;
+ numberOfLocks : byte;
+ reserved : byte;
+ end;
+
+ PCONN_RECORD_LOCKS_386 = ^TCONN_RECORD_LOCKS_386;
+ TCONN_RECORD_LOCKS_386 = record
+ nextRecord : word;
+ numberOfLocks : word;
+ end;
+
+ PCONN_RECORD_LOCKS = ^TCONN_RECORD_LOCKS;
+ TCONN_RECORD_LOCKS = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( rl286 : TCONN_RECORD_LOCKS_286 );
+ 1 : ( rl386 : TCONN_RECORD_LOCKS_386 );
+ end;
+ end;
+
+ PCONN_LOCK_RECORD_286 = ^TCONN_LOCK_RECORD_286;
+ TCONN_LOCK_RECORD_286 = record
+ taskNumber : byte;
+ lockFlag : byte;
+ recordStart : longint;
+ recordEnd : longint;
+ end;
+
+ PCONN_LOCK_RECORD_386 = ^TCONN_LOCK_RECORD_386;
+ TCONN_LOCK_RECORD_386 = record
+ taskNumber : word;
+ lockFlag : byte;
+ recordStart : longint;
+ recordEnd : longint;
+ end;
+
+ PCONN_LOCK_REQUEST_286 = ^TCONN_LOCK_REQUEST_286;
+ TCONN_LOCK_REQUEST_286 = record
+ connectionNumber : word;
+ lastRecord : word;
+ volume : byte;
+ directoryID : word;
+ pathLength : byte;
+ fileName : array[0..13] of byte;
+ end;
+
+ PCONN_LOCK_REQUEST_386 = ^TCONN_LOCK_REQUEST_386;
+ TCONN_LOCK_REQUEST_386 = record
+ connectionNumber : word;
+ forkType : byte;
+ volume : byte;
+ directoryID : longint;
+ next : word;
+ end;
+
+ PCONN_LOCK_REQUEST = ^TCONN_LOCK_REQUEST;
+ TCONN_LOCK_REQUEST = record
+ unionType : word;
+ reserved1 : word;
+ reserved2 : byte;
+ u : record
+ case longint of
+ 0 : ( lr286 : TCONN_LOCK_REQUEST_286 );
+ 1 : ( lr386 : TCONN_LOCK_REQUEST_386 );
+ end;
+ end;
+
+ PSEMAPHORE_INFO_286 = ^TSEMAPHORE_INFO_286;
+ TSEMAPHORE_INFO_286 = record
+ nextRequest : word;
+ openCount : word;
+ semaphoreValue : byte;
+ numberOfRecords : byte;
+ end;
+
+ PSEMAPHORE_INFO_386 = ^TSEMAPHORE_INFO_386;
+ TSEMAPHORE_INFO_386 = record
+ nextRequest : word;
+ openCount : word;
+ semaphoreValue : word;
+ numberOfRecords : word;
+ end;
+
+ PSEMAPHORE_INFO = ^TSEMAPHORE_INFO;
+ TSEMAPHORE_INFO = record
+ unionType : word;
+ u : record
+ case longint of
+ 0 : ( si286 : TSEMAPHORE_INFO_286 );
+ 1 : ( si386 : TSEMAPHORE_INFO_386 );
+ end;
+ end;
+
+ PSEMAPHORE_INFO_RECORD_286 = ^TSEMAPHORE_INFO_RECORD_286;
+ TSEMAPHORE_INFO_RECORD_286 = record
+ connectionNumber : word;
+ taskNumber : byte;
+ end;
+
+ PSEMAPHORE_INFO_RECORD_386 = ^TSEMAPHORE_INFO_RECORD_386;
+ TSEMAPHORE_INFO_RECORD_386 = record
+ connectionNumber : word;
+ taskNumber : word;
+ end;
+
+ PSEMAPHORE_INFO_REQUEST = ^TSEMAPHORE_INFO_REQUEST;
+ TSEMAPHORE_INFO_REQUEST = record
+ reserved1 : word;
+ reserved2 : byte;
+ nextRecord : word;
+ nameLength : byte;
+ name : array[0..254] of byte;
+ end;
+
+{$include npackoff.inc}
+
+function GetConnectionsOpenFiles(connectionNumber:word; lastRecord:Plongint; lastTask:Plongint; structSize:longint; openFiles:PCONN_OPEN_FILES;
+ buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetConnectionsOpenFiles';
+function GetConnectionsTaskInformation(connectionNumber:word; connectionTaskInfo:Ppointer; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetConnectionsTaskInformation';
+function GetConnectionsUsageStats(connectionNumber:longint; connectionUsage:PCONN_USAGE):longint;cdecl;external Clib name 'GetConnectionsUsageStats';
+function GetConnectionsUsingFile(requestSize:longint; request:pointer; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetConnectionsUsingFile';
+function GetDiskCacheStats(cacheStats:PDISK_CACHE_STATS):longint;cdecl;external Clib name 'GetDiskCacheStats';
+function GetDiskCacheStats(var cacheStats:TDISK_CACHE_STATS):longint;cdecl;external Clib name 'GetDiskCacheStats';
+function GetDiskChannelStats(channelNumber:longint; diskChannelStats:PDISK_CHANNEL_STATS):longint;cdecl;external Clib name 'GetDiskChannelStats';
+function GetDiskChannelStats(channelNumber:longint; var diskChannelStats:TDISK_CHANNEL_STATS):longint;cdecl;external Clib name 'GetDiskChannelStats';
+function GetDriveMappingTable(driveMappingTable:PDRIVE_MAP_TABLE):longint;cdecl;external Clib name 'GetDriveMappingTable';
+function GetDriveMappingTable(var driveMappingTable:TDRIVE_MAP_TABLE):longint;cdecl;external Clib name 'GetDriveMappingTable';
+function GetFileServerLANIOStats(serverLANIOStats:PSERVER_LAN_IO):longint;cdecl;external Clib name 'GetFileServerLANIOStats';
+function GetFileServerLANIOStats(var serverLANIOStats:TSERVER_LAN_IO):longint;cdecl;external Clib name 'GetFileServerLANIOStats';
+function GetFileServerMiscInformation(miscInformation:PSERVER_MISC_INFO):longint;cdecl;external Clib name 'GetFileServerMiscInformation';
+function GetFileServerMiscInformation(var miscInformation:TSERVER_MISC_INFO):longint;cdecl;external Clib name 'GetFileServerMiscInformation';
+function GetFileSystemStats(fileSysStats:PFILE_SYS_STATS):longint;cdecl;external Clib name 'GetFileSystemStats';
+function GetFileSystemStats(var fileSysStats:TFILE_SYS_STATS):longint;cdecl;external Clib name 'GetFileSystemStats';
+function GetLANDriverConfigInfo(LANBoardNumber:byte; LANConfiguration:PLAN_CONFIG):longint;cdecl;external Clib name 'GetLANDriverConfigInfo';
+function GetLANDriverConfigInfo(LANBoardNumber:byte; var LANConfiguration:TLAN_CONFIG):longint;cdecl;external Clib name 'GetLANDriverConfigInfo';
+function GetLogicalRecordInformation(requestSize:longint; request:pointer; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetLogicalRecordInformation';
+function GetLogicalRecordsByConnection(connectionNumber:word; nextRecord:word; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetLogicalRecordsByConnection';
+function GetPathFromDirectoryEntry(volumeNumber:byte; directoryEntry:word; pathLength:PBYTE; path:Pchar):longint;cdecl;external Clib name 'GetPathFromDirectoryEntry';
+function GetPhysicalDiskStats(physicalDiskNumber:byte; physicalDiskStats:PPHYS_DISK_STATS):longint;cdecl;external Clib name 'GetPhysicalDiskStats';
+function GetPhysicalDiskStats(physicalDiskNumber:byte; var physicalDiskStats:TPHYS_DISK_STATS):longint;cdecl;external Clib name 'GetPhysicalDiskStats';
+function GetPhysicalRecordLocksByFile(requestSize:longint; request:pointer; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetPhysicalRecordLocksByFile';
+function GetPhysRecLockByConnectAndFile(requestSize:longint; request:pointer; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetPhysRecLockByConnectAndFile';
+function GetSemaphoreInformation(requestSize:longint; request:pointer; buffer:pointer; bufferSize:longint):longint;cdecl;external Clib name 'GetSemaphoreInformation';
+function TTSGetStats(TTSStats:PTTS_STATS; bufferLen:longint; buffer:PBYTE):longint;cdecl;external Clib name 'TTSGetStats';
+function TTSGetStats(var TTSStats:TTTS_STATS; bufferLen:longint; var buffer):longint;cdecl;external Clib name 'TTSGetStats';
+
+{------------------------------------------------------------------------------}
+{$include npackon.inc}
+
+const
+ CRITICAL_ATTRIBUTE_FLAG = $00000080;
+ RESERVED_FLAGS_MASK = $0000FFFF;
+ USER_FLAGS_MASK = $FFFF0000;
+{------------------------------------------------------------------
+ T_enumerateEAnoKey is the structure returned in the dataBuffer
+ by EnumerateEA if a empty key (or NULL) is specified. The
+ EAsInReply output parameter tells how many T_enumerateEAnoKey
+ structures are in the dataBuffer.
+ ------------------------------------------------------------------ }
+{ length of entire EA }
+{ length of this field is given by keyLength }
+type
+
+ PT_enumerateEAnoKey = ^TT_enumerateEAnoKey;
+ TT_enumerateEAnoKey = record
+ valueLength : longint;
+ keyLength : word;
+ accessFlags : longint;
+ keyValue : array[0..0] of char;
+ end;
+{----------------------------------------------------------------------
+ T_enumerateEAwithKey is the structure returned in the dataBuffer
+ by EnumerateEA if a non-empty key is specified. In this case the
+ EAsInReply output parameter will return one and there will only be
+ one T_enumerateEAwithKey structure in the dataBuffer.
+ ---------------------------------------------------------------------- }
+
+ PT_enumerateEAwithKey = ^TT_enumerateEAwithKey;
+ TT_enumerateEAwithKey = record
+ valueLength : longint;
+ keyLength : word;
+ accessFlags : longint;
+ keyExtants : longint;
+ valueExtants : longint;
+ keyValue : array[0..0] of char;
+ end;
+
+{$include npackoff.inc}
+
+function CloseEA(handle:longint):longint;cdecl;external Clib name 'CloseEA';
+function CopyEA (srcPath,destPath:Pchar; destVolumeNumber,destDirectoryNumber:longint;
+ EAcount,EAdataSize,EAkeySize:PLongint):longint;cdecl;external Clib name 'CopyEA';
+function CopyEA (srcPath,destPath:Pchar; destVolumeNumber,destDirectoryNumber:longint;
+ var EAcount,EAdataSize,EAkeySize:longint):longint;cdecl;external Clib name 'CopyEA';
+
+function EnumerateEA(handle:longint; keyBuffer:Pchar; dataBuffer:pointer; dataBufferSize:longint;
+ startPosition:longint;
+ dataSize,EAsInReply:PLongint):longint;cdecl;external Clib name 'EnumerateEA';
+function EnumerateEA(handle:longint; keyBuffer:Pchar; var dataBuffer; dataBufferSize:longint;
+ startPosition:longint;
+ var dataSize,EAsInReply:longint):longint;cdecl;external Clib name 'EnumerateEA';
+function EnumerateEA(handle:longint; keyBuffer:Pchar; dataBuffer:pointer; dataBufferSize:longint;
+ startPosition:longint;
+ var dataSize,EAsInReply:longint):longint;cdecl;external Clib name 'EnumerateEA';
+function GetEAInfo (handle:longint; totalEAs,totalDataSizeOfEAs,totalKeySizeOfEAs:PLongint):longint;cdecl;external Clib name 'GetEAInfo';
+function GetEAInfo (handle:longint; var totalEAs,totalDataSizeOfEAs,totalKeySizeOfEAs:longint):longint;cdecl;external Clib name 'GetEAInfo';
+
+function OpenEA(path:Pchar; reserved:longint):longint;cdecl;external Clib name 'OpenEA';
+function ReadEA(handle:longint; keyBuffer:Pchar; dataBuffer:Pchar; dataBufferSize:longint; accessFlags:PLongint):longint;cdecl;external Clib name 'ReadEA';
+function ReadEA(handle:longint; keyBuffer:Pchar; dataBuffer:Pchar; dataBufferSize:longint; var accessFlags:longint):longint;cdecl;external Clib name 'ReadEA';
+function WriteEA(handle:longint; keyBuffer:Pchar; dataBuffer:Pchar; dataBufferSize:longint; accessFlags:longint):longint;cdecl;external Clib name 'WriteEA';
+
+{------------------------------------------------------------------------------}
+
+const MAX_CONSOLE_MESSAGE_LENGTH = 80;
+ MAX_MESSAGE_LENGTH = 58;
+ NEW_MAX_MESSAGE_LENGTH = 250;
+
+function BroadcastToConsole (msg:Pchar):longint; cdecl;external Clib name 'BroadcastToConsole';
+function DisableStationBroadcasts:longint; cdecl;external Clib name 'DisableStationBroadcasts';
+function EnableStationBroadcasts:longint; cdecl;external Clib name 'EnableStationBroadcasts';
+function GetBroadcastMessage (msgBuffer:Pchar):longint; cdecl;external Clib name 'GetBroadcastMessage';
+function SendBroadcastMessage (msg:Pchar;
+ connectionList:PWORD;
+ resultList:PBYTE;
+ connectionCount:word):longint; cdecl;external Clib name 'SendBroadcastMessage';
+function SendBroadcastMessage (msg:Pchar;
+ var connectionList;
+ var resultList;
+ var connectionCount:word):longint; cdecl;external Clib name 'SendBroadcastMessage';
+
+{------------------------------------------------------------------------------}
+{$include npackon.inc}
+
+const
+ NWMAX_QENTRIES = 250;
+{ the following manifest constant applies to server versions BELOW 3.X }
+ NWMAX_JOB_SERVERS = 25;
+{ the following manifest constant applies to server versions ABOVE 2.X }
+ NWQ_MAX_JOB_SERVERS = 50;
+ QF_AUTO_START = $08;
+ QF_SERVICE_RESTART = $10;
+ QF_ENTRY_OPEN = $20;
+ QF_USER_HOLD = $40;
+ QF_OPERATOR_HOLD = $80;
+{ Queue Status Flags }
+ QS_CANT_ADD_JOBS = $01;
+ QS_SERVERS_CANT_ATTACH = $02;
+ QS_CANT_SERVICE_JOBS = $04;
+type
+
+ PJobStruct = ^TJobStruct;
+ TJobStruct = record
+ clientStation : byte;
+ clientTaskNumber : byte;
+ clientIDNumber : longint;
+ targetServerIDNumber : longint;
+ targetExecutionTime : array[0..5] of byte;
+ jobEntryTime : array[0..5] of byte;
+ jobNumber : word;
+ jobType : word;
+ jobPosition : byte;
+ jobControlFlags : byte;
+ jobFileName : array[0..13] of byte;
+ jobFileHandle : array[0..5] of byte;
+ serverStation : byte;
+ serverTaskNumber : byte;
+ serverIDNumber : longint;
+ textJobDescription : array[0..49] of byte;
+ clientRecordArea : array[0..151] of byte;
+ end;
+{ (19)80 - (20)79 }
+{ 1 = January, ... }
+{ 1 - 31 }
+{ 0 - 23 }
+{ 0 - 59 }
+{ 0 - 59 }
+
+ PNWStandardChronRec_t = ^TNWStandardChronRec_t;
+ TNWStandardChronRec_t = record
+ year : byte;
+ month : byte;
+ day : byte;
+ hour : byte;
+ minute : byte;
+ second : byte;
+ end;
+
+ PNWQChronRec_t = ^TNWQChronRec_t;
+ TNWQChronRec_t = TNWStandardChronRec_t;
+
+ PNWFileHandle_t = ^TNWFileHandle_t;
+ TNWFileHandle_t = byte;
+
+ PNWQEntityInfo_t = ^TNWQEntityInfo_t;
+ TNWQEntityInfo_t = record
+ clientConnNum : longint;
+ taskNum : longint;
+ id : longint;
+ end;
+
+ PNWQJobServerInfo_t = ^TNWQJobServerInfo_t;
+ TNWQJobServerInfo_t = record
+ id : longint;
+ executionTime : TNWQChronRec_t;
+ end;
+
+ PNWQJobInfo_t = ^TNWQJobInfo_t;
+ TNWQJobInfo_t = record
+ entryTime : TNWQChronRec_t;
+ num : longint;
+ _type : word;
+ position : word;
+ controlFlags : word;
+ assocFileName : array[0..13] of char;
+ fileHandle : TNWFileHandle_t;
+ end;
+
+ PNWQPrintJobInfo_t = ^TNWQPrintJobInfo_t;
+ TNWQPrintJobInfo_t = record
+ entryTime : TNWQChronRec_t;
+ num : longint;
+ formType : word;
+ position : word;
+ controlFlags : word;
+ assocFileName : array[0..13] of char;
+ fileHandle : TNWFileHandle_t;
+ end;
+
+ PNWQJobRec_t = ^TNWQJobRec_t;
+ TNWQJobRec_t = record
+ reserved : array[0..9] of byte;
+ client : TNWQEntityInfo_t;
+ target : TNWQJobServerInfo_t;
+ job : TNWQJobInfo_t;
+ jobServer : TNWQEntityInfo_t;
+ textJobDescription : array[0..49] of byte;
+ jobServerRecord : array[0..151] of byte;
+ end;
+
+ PNWQPrintServerRec_t = ^TNWQPrintServerRec_t;
+ TNWQPrintServerRec_t = record
+ versionNumber : byte;
+ tabSize : byte;
+ numberOfCopies : word;
+ printControlFlags : word;
+ maxLinesPerPage : word;
+ maxCharsPerLine : word;
+ formName : array[0..12] of char;
+ reserve : array[0..8] of byte;
+ bannerNameField : array[0..12] of char;
+ bannerFileField : array[0..12] of char;
+ bannerFileName : array[0..13] of char;
+ directoryPath : array[0..79] of char;
+ end;
+{$include npackoff.inc}
+
+function AbortServicingQueueJobAndFile(queueID:longint; jobNumber:word; fileHandle:longint):longint;cdecl;external Clib name 'AbortServicingQueueJobAndFile';
+function AttachQueueServerToQueue(queueID:longint):longint;cdecl;external Clib name 'AttachQueueServerToQueue';
+function ChangeQueueJobEntry(queueID:longint; job:PJobStruct):longint;cdecl;external Clib name 'ChangeQueueJobEntry';
+function ChangeQueueJobEntry(queueID:longint; var job:TJobStruct):longint;cdecl;external Clib name 'ChangeQueueJobEntry';
+function ChangeQueueJobPosition(queueID:longint; jobNumber:word; newPosition:byte):longint;cdecl;external Clib name 'ChangeQueueJobPosition';
+function ChangeToClientRights(queueID:longint; jobNumber:word):longint;cdecl;external Clib name 'ChangeToClientRights';
+function CloseFileAndAbortQueueJob(queueID:longint; jobNumber:word; fileHandle:longint):longint;cdecl;external Clib name 'CloseFileAndAbortQueueJob';
+function CloseFileAndStartQueueJob(queueID:longint; jobNumber:word; fileHandle:longint):longint;cdecl;external Clib name 'CloseFileAndStartQueueJob';
+function CreateAQueue(queueName:Pchar; queueType:longint; pathName:Pchar; queueID:Plongint):longint;cdecl;external Clib name 'CreateAQueue';
+function CreateAQueue(queueName:Pchar; queueType:longint; pathName:Pchar; var queueID:longint):longint;cdecl;external Clib name 'CreateAQueue';
+function CreateQueueJobAndFile(queueID:longint; job:PJobStruct; fileHandle:Plongint):longint;cdecl;external Clib name 'CreateQueueJobAndFile';
+function CreateQueueJobAndFile(queueID:longint; var job:TJobStruct; var fileHandle:longint):longint;cdecl;external Clib name 'CreateQueueJobAndFile';
+function DestroyQueue(queueID:longint):longint;cdecl;external Clib name 'DestroyQueue';
+function DetachQueueServerFromQueue(queueID:longint):longint;cdecl;external Clib name 'DetachQueueServerFromQueue';
+function FinishServicingQueueJobAndFile(queueID:longint; jobNumber:word; charge:longint; fileHandle:longint):longint;cdecl;external Clib name 'FinishServicingQueueJobAndFile';
+function GetQueueJobList(queueID:longint; jobCount:PWORD; jobNumberList:PWORD; maxJobNumbers:word):longint;cdecl;external Clib name 'GetQueueJobList';
+function GetQueueJobsFileSize(queueID:longint; jobNumber:longint; fileSize:Plongint):longint;cdecl;external Clib name 'GetQueueJobsFileSize';
+function NWQAbortJob(queueID:longint; jobNum:longint; fileHandle:longint):longint;cdecl;external Clib name 'NWQAbortJob';
+function NWQAbortJobService(queueID:longint; jobNum:longint; fileHandle:longint):longint;cdecl;external Clib name 'NWQAbortJobService';
+function NWQAttachServer(queueID:longint):longint;cdecl;external Clib name 'NWQAttachServer';
+function NWQBeginJobService(queueID:longint; targetJobType:word; jobInfo:PNWQJobRec_t; fileHandle:Plongint):longint;cdecl;external Clib name 'NWQBeginJobService';
+function NWQChangeJobEntry(queueID:longint; jobInfo:PNWQJobRec_t):longint;cdecl;external Clib name 'NWQChangeJobEntry';
+function NWQChangeJobPosition(queueID:longint; jobNum:longint; newPosition:longint):longint;cdecl;external Clib name 'NWQChangeJobPosition';
+function NWQChangeJobQueue(srcQueueID:longint; srcJobNum:longint; dstQueueID:longint; dstJobNum:Plongint):longint;cdecl;external Clib name 'NWQChangeJobQueue';
+function NWQChangeToClientRights(queueID:longint; jobNum:longint):longint;cdecl;external Clib name 'NWQChangeToClientRights';
+function NWQCreate(queueName:Pchar; queueType:word; pathName:Pchar; queueID:Plongint):longint;cdecl;external Clib name 'NWQCreate';
+function NWQCreateJob(queueID:longint; jobInfo:PNWQJobRec_t; fileHandle:Plongint):longint;cdecl;external Clib name 'NWQCreateJob';
+function NWQCreateJob(queueID:longint; var jobInfo:TNWQJobRec_t; fileHandle:Plongint):longint;cdecl;external Clib name 'NWQCreateJob';
+function NWQDestroy(queueID:longint):longint;cdecl;external Clib name 'NWQDestroy';
+function NWQDetachServer(queueID:longint):longint;cdecl;external Clib name 'NWQDetachServer';
+function NWQEndJobService(queueID:longint; jobNum:longint; chargeInfo:longint; fileHandle:longint):longint;cdecl;external Clib name 'NWQEndJobService';
+function NWQGetJobEntry(queueID:longint; jobNum:longint; jobInfo:PNWQJobRec_t):longint;cdecl;external Clib name 'NWQGetJobEntry';
+function NWQGetJobEntry(queueID:longint; jobNum:longint; var jobInfo:TNWQJobRec_t):longint;cdecl;external Clib name 'NWQGetJobEntry';
+function NWQGetJobFileSize(queueID:longint; jobNum:longint; fileSize:Plongint):longint;cdecl;external Clib name 'NWQGetJobFileSize';
+function NWQGetJobFileSize(queueID:longint; jobNum:longint; var fileSize:longint):longint;cdecl;external Clib name 'NWQGetJobFileSize';
+function NWQGetServers(queueID:longint; currentServers,qServerIDs,qServerConnNums:Plongint):longint;cdecl;external Clib name 'NWQGetServers';
+function NWQGetServerStatus(queueID:longint; jobServerID:longint; jobServerConnNum:longint; jobServerRecord:pointer):longint;cdecl;external Clib name 'NWQGetServerStatus';
+function NWQGetStatus(queueID:longint; queueStatus:Plongint; currentEntries:Plongint; currentServers:Plongint):longint;cdecl;external Clib name 'NWQGetStatus';
+function NWQMarkJobForService(queueID:longint; jobNum:longint; fileHandle:longint):longint;cdecl;external Clib name 'NWQMarkJobForService';
+function NWQRemoveJob(queueID:longint; jobNum:longint):longint;cdecl;external Clib name 'NWQRemoveJob';
+function NWQRestoreServerRights:longint;cdecl;external Clib name 'NWQRestoreServerRights';
+function NWQScanJobNums(queueID:longint; queueSequence:Plongint; totalJobs:Plongint; jobCount:Plongint; jobNumList:Plongint):longint;cdecl;external Clib name 'NWQScanJobNums';
+function NWQServiceJob(queueID:longint; targetJobTypesCount:longint; targetJobTypes:PWORD; jobInfo:PNWQJobRec_t; fileHandle:Plongint):longint;cdecl;external Clib name 'NWQServiceJob';
+function NWQSetServerStatus(queueID:longint; serverStatusRecord:pointer):longint;cdecl;external Clib name 'NWQSetServerStatus';
+function NWQSetStatus(queueID:longint; queueStatus:longint):longint;cdecl;external Clib name 'NWQSetStatus';
+function ReadQueueCurrentStatus(queueID:longint; queueStatus:PBYTE; numberOfJobs:PBYTE; numberOfServers:PBYTE; serverIDList:Plongint;
+ serverStationList:PWORD; maxNumberOfServers:word):longint;cdecl;external Clib name 'ReadQueueCurrentStatus';
+function ReadQueueJobEntry(queueID:longint; jobNumber:word; job:PJobStruct):longint;cdecl;external Clib name 'ReadQueueJobEntry';
+function ReadQueueServerCurrentStatus(queueID:longint; serverID:longint; serverStation:char; serverStatusRecord:Pchar):longint;cdecl;external Clib name 'ReadQueueServerCurrentStatus';
+function RemoveJobFromQueue(queueID:longint; jobNumber:word):longint;cdecl;external Clib name 'RemoveJobFromQueue';
+function RestoreQueueServerRights:longint;cdecl;external Clib name 'RestoreQueueServerRights';
+function ServiceQueueJobAndOpenFile(queueID:longint; targetJobType:word; job:PJobStruct; fileHandle:Plongint):longint;cdecl;external Clib name 'ServiceQueueJobAndOpenFile';
+function ServiceQueueJobAndOpenFile(queueID:longint; targetJobType:word; var job:TJobStruct; var fileHandle:longint):longint;cdecl;external Clib name 'ServiceQueueJobAndOpenFile';
+function SetQueueCurrentStatus(queueID:longint; queueStatus:byte):longint;cdecl;external Clib name 'SetQueueCurrentStatus';
+function SetQueueServerCurrentStatus(queueID:longint; serverStatusRecord:PBYTE):longint;cdecl;external Clib name 'SetQueueServerCurrentStatus';
+function SetQueueServerCurrentStatus(queueID:longint; var serverStatusRecord):longint;cdecl;external Clib name 'SetQueueServerCurrentStatus';
+
+{------------------------------------------------------------------------------}
+function GetNetworkSerialNumber (networkSerialNumber : Plongint;
+ applicationNumber : Pword) : longint; cdecl; external Clib name 'GetNetworkSerialNumber';
+function GetNetworkSerialNumber (var networkSerialNumber : longint;
+ var applicationNumber : word) : longint; cdecl; external Clib name 'GetNetworkSerialNumber';
+function VerifyNetworkSerialNumber (networkSerialNumber : longint;
+ applicationNumber : Pword) : longint; cdecl; external Clib name 'VerifyNetworkSerialNumber';
+function VerifyNetworkSerialNumber (networkSerialNumber : longint;
+ var applicationNumber : word) : longint; cdecl; external Clib name 'VerifyNetworkSerialNumber';
+
+{------------------------------------------------------------------------------}
+const
+ OLD_SS_DEFAULT_BUFFER_SIZE = 538;
+ SS_DEFAULT_BUFFER_SIZE = 600;
+
+{ These connection types are used by SSGetActiveConnListByType }
+{ They are all conditionally defined because some of them may appear in }
+{ other clib header files. }
+{ }
+{ Connection service type }
+{ NOTE: type 1 is reserved by CLIB for backward compatability }
+
+ NCP_CONNECTION_TYPE = 2;
+ NLM_CONNECTION_TYPE = 3;
+ AFP_CONNECTION_TYPE = 4;
+ FTAM_CONNECTION_TYPE = 5;
+ ANCP_CONNECTION_TYPE = 6;
+
+{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% }
+{ User Interface Structures }
+{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% }
+{$include npackon.inc}
+type
+
+ PSSDefaultBuffer = ^TSSDefaultBuffer;
+ TSSDefaultBuffer = record
+ data : array[0..(SS_DEFAULT_BUFFER_SIZE)-1] of byte;
+ end;
+
+ PCacheMemoryCounters = ^TCacheMemoryCounters;
+ TCacheMemoryCounters = record
+ OriginalNumberOfCacheBuffers : longint;
+ CurrentNumberOfCacheBuffers : longint;
+ CacheDirtyBlockThreshold : longint;
+ debugCounters : array[0..6] of longint;
+ end;
+
+ PCacheTrendCounters = ^TCacheTrendCounters;
+ TCacheTrendCounters = record
+ NumOfCacheChecks : longint;
+ NumOfCacheHits : longint;
+ debugCounters : array[0..6] of longint;
+ LRUSittingTime : longint;
+ end;
+
+ PCacheInformation = ^TCacheInformation;
+ TCacheInformation = record
+ MaximumByteCount : longint;
+ MinimumNumberOfCacheBuffers : longint;
+ MinimumCacheReportThreshold : longint;
+ AllocateWaitingCount : longint;
+ NDirtyBlocks : longint;
+ CacheDirtyWaitTime : longint;
+ CacheMaximumConcurrentWrites : longint;
+ MaximumDirtyTime : longint;
+ NumberOfDirectoryCacheBuffers : longint;
+ CacheByteToBlockShiftFactor : longint;
+ end;
+
+ PGetCacheInfoStructure = ^TGetCacheInfoStructure;
+ TGetCacheInfoStructure = record
+ currentServerTime : longint;
+ VConsoleVersion : byte;
+ VConsoleRevision : byte;
+ reserved : word;
+ CacheCntrs : array[0..25] of longint;
+ MemoryCntrs : TCacheMemoryCounters;
+ TrendCntrs : TCacheTrendCounters;
+ CacheInfo : TCacheInformation;
+ end;
+
+ PServerInformation = ^TServerInformation;
+ TServerInformation = record
+ ReplyCanceledCount : longint;
+ WriteHeldOffCount : longint;
+ reserved1 : longint;
+ InvalidRequestTypeCount : longint;
+ BeingAbortedCount : longint;
+ AlreadyDoingReAllocateCount : longint;
+ reserved2 : array[0..2] of longint;
+ DeAllocateStillTransmittingCount : longint;
+ StartStationErrorCount : longint;
+ InvalidSlotCount : longint;
+ BeingProcessedCount : longint;
+ ForgedPacketCount : longint;
+ StillTransmittingCount : longint;
+ ReExecuteRequestCount : longint;
+ InvalidSequenceNumberCount : longint;
+ DuplicateIsBeingSentAlreadyCount : longint;
+ SentPositiveAcknowledgeCount : longint;
+ SentADuplicateReplyCount : longint;
+ NoMemoryForStationControlCount : longint;
+ NoAvailableConnectionsCount : longint;
+ ReAllocateSlotCount : longint;
+ ReAllocateSlotCameTooSoonCount : longint;
+ end;
+
+ PFSCounters = ^TFSCounters;
+ TFSCounters = record
+ TooManyHops : word;
+ UnknownNetwork : word;
+ NoSpaceForService : word;
+ NoRecieveBuffers : word;
+ NotMyNetwork : word;
+ NetBIOSPropagatedCount : longint;
+ TotalPacketsServiced : longint;
+ TotalPacketsRouted : longint;
+ end;
+
+ PGetFileServerInfoStructure = ^TGetFileServerInfoStructure;
+ TGetFileServerInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ NCPStaInUseCnt : longint;
+ NCPPeakStaInUse : longint;
+ numOfNCPReqs : longint;
+ serverUtilization : longint;
+ serverInfo : TServerInformation;
+ fileServerCounters : TFSCounters;
+ end;
+
+ PGetFileSystemInfoStructure = ^TGetFileSystemInfoStructure;
+ TGetFileSystemInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ debugCounters : array[0..12] of longint;
+ end;
+
+ PUserInformation = ^TUserInformation;
+ TUserInformation = record
+ connectionNumber : longint;
+ useCount : longint;
+ connectionServiceType : byte;
+ loginTime : array[0..6] of byte;
+ status : longint;
+ expirationTime : longint;
+ objectType : longint;
+ transactionFlag : byte;
+ logicalLockThreshold : byte;
+ recordLockThreshold : byte;
+ fileWriteFlags : byte;
+ fileWriteState : byte;
+ filler : byte;
+ fileLockCount : word;
+ recordLockCount : word;
+ totalBytesRead : array[0..5] of byte;
+ totalBytesWritten : array[0..5] of byte;
+ totalRequests : longint;
+ heldRequests : longint;
+ heldBytesRead : array[0..5] of byte;
+ heldBytesWritten : array[0..5] of byte;
+ end;
+
+ PGetUserInfoStructure = ^TGetUserInfoStructure;
+ TGetUserInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ userInfo : TUserInformation;
+ userNameLen : byte;
+ username : byte;
+ end;
+
+ PPacketBurstInformation = ^TPacketBurstInformation;
+ TPacketBurstInformation = record
+ BigInvalidSlotCount : longint;
+ BigForgedPacketCount : longint;
+ BigInvalidPacketCount : longint;
+ BigStillTransmittingCount : longint;
+ StillDoingTheLastRequestCount : longint;
+ InvalidControlRequestCount : longint;
+ ControlInvalidMessageNumberCount : longint;
+ ControlBeingTornDownCount : longint;
+ BigRepeatTheFileReadCount : longint;
+ BigSendExtraCCCount : longint;
+ BigReturnAbortMessageCount : longint;
+ BigReadInvalidMessageNumberCount : longint;
+ BigReadDoItOverCount : longint;
+ BigReadBeingTornDownCount : longint;
+ PreviousControlPacketCount : longint;
+ SendHoldOffMessageCount : longint;
+ BigReadNoDataAvailableCount : longint;
+ BigReadTryingToReadTooMuchCount : longint;
+ ASyncReadErrorCount : longint;
+ BigReadPhysicalReadErrorCount : longint;
+ ControlBadACKFragmentListCount : longint;
+ ControlNoDataReadCount : longint;
+ WriteDuplicateRequestCount : longint;
+ ShouldntBeACKingHereCount : longint;
+ WriteInconsistentPacketLengthsCount : longint;
+ FirstPacketIsntAWriteCount : longint;
+ WriteTrashedDuplicateRequestCount : longint;
+ BigWriteInvalidMessageNumberCount : longint;
+ BigWriteBeingTornDownCount : longint;
+ BigWriteBeingAbortedCount : longint;
+ ZeroACKFragmentCountCount : longint;
+ WriteCurrentlyTransmittingCount : longint;
+ TryingToWriteTooMuchCount : longint;
+ WriteOutOfMemoryForControlNodesCount : longint;
+ WriteDidntNeedThisFragmentCount : longint;
+ WriteTooManyBuffersCheckedOutCount : longint;
+ WriteTimeOutCount : longint;
+ WriteGotAnACKCount : longint;
+ WriteGotAnACKCount1 : longint;
+ PollerAbortedTheConnectionCount : longint;
+ MaybeHadOutOfOrderWritesCount : longint;
+ HadAnOutOfOrderWriteCount : longint;
+ MovedTheACKBitDownCount : longint;
+ BumpedOutOfOrderWriteCount : longint;
+ PollerRemovedOldOutOfOrderCount : longint;
+ WriteDidntNeedButRequestedACKCount : longint;
+ WriteTrashedPacketCount : longint;
+ TooManyACKFragmentsCount : longint;
+ SavedAnOutOfOrderPacketCount : longint;
+ ConnectionBeingAbortedCount : longint;
+ end;
+
+ PGetPacketBurstInfoStructure = ^TGetPacketBurstInfoStructure;
+ TGetPacketBurstInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ packetBurstInfo : TPacketBurstInformation;
+ end;
+
+ PIPXInformation = ^TIPXInformation;
+ TIPXInformation = record
+ IpxSendPacketCount : longint;
+ IpxMalformPacketCount : word;
+ IpxGetECBRequestCount : longint;
+ IpxGetECBFailCount : longint;
+ IpxAESEventCount : longint;
+ IpxPostponedAESCount : word;
+ IpxMaxConfiguredSocketCount : word;
+ IpxMaxOpenSocketCount : word;
+ IpxOpensocketFailCount : word;
+ IpxListenECBCount : longint;
+ IpxECBCancelFailCount : word;
+ IpxGetLocalTargetFailCount : word;
+ end;
+
+ PSPXInformation = ^TSPXInformation;
+ TSPXInformation = record
+ SpxMaxConnectionsCount : word;
+ SpxMaxUsedConnections : word;
+ SpxEstConnectionReq : word;
+ SpxEstConnectionFail : word;
+ SpxListenConnectReq : word;
+ SpxListenConnectFail : word;
+ SpxSendCount : longint;
+ SpxWindowChokeCount : longint;
+ SpxBadSendCount : word;
+ SpxSendFailCount : word;
+ SpxAbortedConnection : word;
+ SpxListenPacketCount : longint;
+ SpxBadListenCount : word;
+ SpxIncomingPacketCount : longint;
+ SpxBadInPacketCnt : word;
+ SpxSuppressedPackCnt : word;
+ SpxNoSesListenECBCnt : word;
+ SpxWatchDogDestSesCnt : word;
+ end;
+
+ PGetIPXSPXInfoStructure = ^TGetIPXSPXInfoStructure;
+ TGetIPXSPXInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ IPXInfo : TIPXInformation;
+ SPXInfo : TSPXInformation;
+ end;
+
+ PGetGarbageCollInfoStructure = ^TGetGarbageCollInfoStructure;
+ TGetGarbageCollInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ failedAllocReqCount : longint;
+ numberOfAllocs : longint;
+ noMoreMemAvlCnt : longint;
+ numOfGarbageColl : longint;
+ foundSomeMem : longint;
+ numOfChecks : longint;
+ end;
+ TGetGarbageCollInfoStruc = TGetGarbageCollInfoStructure;
+ PGetGarbageCollInfoStruc = ^TGetGarbageCollInfoStruc;
+
+ PCPUInformation = ^TCPUInformation;
+ TCPUInformation = record
+ numberOfCPUs : longint;
+ PageTableOwnerFlag : longint;
+ CPUType : longint;
+ CoProcessorFlag : longint;
+ BusType : longint;
+ IOEngineFlag : longint;
+ FSEngineFlag : longint;
+ NonDedFlag : longint;
+ end;
+
+
+ PGetCPUInfoStructure = ^TGetCPUInfoStructure;
+ TGetCPUInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ CPUInfo : TCPUInformation;
+ variableStringsStart : byte;
+ end;
+{ The LFSCountersStructure is provided }
+{ so that you can see field names. It }
+{ isn't referenced and developers will }
+{ probably want to define their own }
+{ structure. This structure may grow }
+{ beyond what one call can return at }
+{ some future date. }
+{ }
+
+ PLFSCountersStructure = ^TLFSCountersStructure;
+ TLFSCountersStructure = record
+ ReadFile : longint;
+ WriteFile : longint;
+ DeleteFile : longint;
+ RenMove : longint;
+ OpenFile : longint;
+ CreateFile : longint;
+ CreateAndOpenFile : longint;
+ CloseFile : longint;
+ ScanDeleteFile : longint;
+ SalvageFile : longint;
+ PurgeFile : longint;
+ MigrateFile : longint;
+ DeMigrateFile : longint;
+ CreateDir : longint;
+ DeleteDir : longint;
+ DirectoryScans : longint;
+ MapPathToDirNum : longint;
+ ModifyDirEntry : longint;
+ GetAccessRights : longint;
+ GetAccessRightsFromIDs : longint;
+ MapDirNumToPath : longint;
+ GetEntryFromPathStrBase : longint;
+ GetOtherNSEntry : longint;
+ GetExtDirInfo : longint;
+ GetParentDirNum : longint;
+ AddTrusteeR : longint;
+ ScanTrusteeR : longint;
+ DelTrusteeR : longint;
+ PurgeTrust : longint;
+ FindNextTrustRef : longint;
+ ScanUserRestNodes : longint;
+ AddUserRest : longint;
+ DeleteUserRest : longint;
+ RtnDirSpaceRest : longint;
+ GetActualAvailDskSp : longint;
+ CntOwnedFilesAndDirs : longint;
+ MigFileInfo : longint;
+ VolMigInfo : longint;
+ ReadMigFileData : longint;
+ GetVolusageStats : longint;
+ GetActualVolUsageStats : longint;
+ GetDirUsageStats : longint;
+ NMFileReadsCount : longint;
+ NMFileWritesCount : longint;
+ MapPathToDirectoryNumberOrPhantom : longint;
+ StationHasAccessRightsGrantedBelow : longint;
+ GetDataStreamLengthsFromPathStringBase : longint;
+ CheckAndGetDirectoryEntry : longint;
+ GetDeletedEntry : longint;
+ GetOriginalNameSpace : longint;
+ GetActualFileSize : longint;
+ VerifyNameSpaceNumber : longint;
+ VerifyDataStreamNumber : longint;
+ CheckVolumeNumber : longint;
+ CommitFile : longint;
+ VMGetDirectoryEntry : longint;
+ CreateDMFileEntry : longint;
+ RenameNameSpaceEntry : longint;
+ LogFile : longint;
+ ReleaseFile : longint;
+ ClearFile : longint;
+ SetVolumeFlag : longint;
+ ClearVolumeFlag : longint;
+ GetOriginalInfo : longint;
+ CreateMigratedDir : longint;
+ F3OpenCreate : longint;
+ F3InitFileSearch : longint;
+ F3ContinueFileSearch : longint;
+ F3RenameFile : longint;
+ F3ScanForTrustees : longint;
+ F3ObtainFileInfo : longint;
+ F3ModifyInfo : longint;
+ F3EraseFile : longint;
+ F3SetDirHandle : longint;
+ F3AddTrustees : longint;
+ F3DeleteTrustees : longint;
+ F3AllocDirHandle : longint;
+ F3ScanSalvagedFiles : longint;
+ F3RecoverSalvagedFiles : longint;
+ F3PurgeSalvageableFile : longint;
+ F3GetNSSpecificInfo : longint;
+ F3ModifyNSSpecificInfo : longint;
+ F3SearchSet : longint;
+ F3GetDirBase : longint;
+ F3QueryNameSpaceInfo : longint;
+ F3GetNameSpaceList : longint;
+ F3GetHugeInfo : longint;
+ F3SetHugeInfo : longint;
+ F3GetFullPathString : longint;
+ F3GetEffectiveDirectoryRights : longint;
+ ParseTree : longint;
+ end;
+
+ PGetVolumeSwitchInfoStructure = ^TGetVolumeSwitchInfoStructure;
+ TGetVolumeSwitchInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ totalLFSCounters : longint;
+ currentLFSCounters : longint;
+ counters : longint;
+ end;
+
+ PGetNLMLoadedListStructure = ^TGetNLMLoadedListStructure;
+ TGetNLMLoadedListStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ moreFlag : word;
+ NLMLoadedCount : longint;
+ NLMCount : longint;
+ NLMNumbers : longint;
+ end;
+
+
+ PNLMInformation = ^TNLMInformation;
+ TNLMInformation = record
+ nlmIdentificationNumber : longint;
+ nlmFlags : longint;
+ nlmType : longint;
+ nlmParentID : longint;
+ nlmMajorVersion : longint;
+ nlmMinorVersion : longint;
+ nlmRevision : longint;
+ nlmYear : longint;
+ nlmMonth : longint;
+ nlmDay : longint;
+ nlmAllocAvailBytes : longint;
+ nlmAllocFreeCount : longint;
+ nlmLastGarbCollect : longint;
+ nlmMessageLanguage : longint;
+ nlmNumberOfReferencedPublics : longint;
+ end;
+
+{ In GetNLMInfoStructure: }
+{ At startOFLStrings there will be three }
+{ length preceeded strings -- they may be }
+{ zero bytes long! The strings are: }
+{ the file name, the NLM name, and the }
+{ copyright. }
+{ Each string consists of one byte which }
+{ contains the length of the string }
+{ followed by zero to 255 bytes of data, }
+{ depending upon the value of the length }
+{ byte. When the length byte is zero, no }
+{ data is present for that string. }
+{ }
+{ 3 Len preceeded strings: filename, name, copyright }
+
+ PGetNLMInfoStructure = ^TGetNLMInfoStructure;
+ TGetNLMInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ NLMInfo : TNLMInformation;
+ startOfLStrings : byte;
+ end;
+
+ PDirectoryCacheInformation = ^TDirectoryCacheInformation;
+ TDirectoryCacheInformation = record
+ MinimumTimeSinceFileDelete : longint;
+ AbsMinimumTimeSinceFileDelete : longint;
+ MinimumNumberOfDirCacheBuffers : longint;
+ MaximumNumberOfDirCacheBuffers : longint;
+ NumberOfDirectoryCacheBuffers : longint;
+ DCMinimumNonReferencedTime : longint;
+ DCWaitTimeBeforeNewBuffer : longint;
+ DCMaximumConcurrentWrites : longint;
+ DCDirtyWaitTime : longint;
+ debugCounters : array[0..3] of longint;
+ PercentOfVolumeUsedByDirs : longint;
+ end;
+
+ PGetDirCacheInfoStructure = ^TGetDirCacheInfoStructure;
+ TGetDirCacheInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ dirCacheInfo : TDirectoryCacheInformation;
+ end;
+
+ PGetOSVersionInfoStructure = ^TGetOSVersionInfoStructure;
+ TGetOSVersionInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ OSMajorVersion : byte;
+ OSMinorVersion : byte;
+ OSRevision : byte;
+ accountVersion : byte;
+ VAPVersion : byte;
+ queueingVersion : byte;
+ securityRestLvl : byte;
+ bridgingSupport : byte;
+ maxNumOfVol : longint;
+ maxNumOfConn : longint;
+ maxNumOfUsers : longint;
+ maxNumOfnameSpaces : longint;
+ maxNumOfLANS : longint;
+ maxNumOfMedias : longint;
+ maxNumOfStacks : longint;
+ maxDirDepth : longint;
+ maxDataStreams : longint;
+ maxNumOfSpoolPr : longint;
+ serverSerialNumber : longint;
+ serverApplicationNumber : word;
+ end;
+
+ PGetActiveConnListByTypeStructure = ^TGetActiveConnListByTypeStructure;
+ TGetActiveConnListByTypeStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ ActiveConnBitList : array[0..511] of byte;
+ end;
+
+ PRTagStructure = ^TRTagStructure;
+ TRTagStructure = record
+ rTagNumber : longint;
+ signature : longint;
+ count : longint;
+ name : byte;
+ end;
+
+ PGetNLMResourceTagList = ^TGetNLMResourceTagList;
+ TGetNLMResourceTagList = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ totalNumOfRTags : longint;
+ currentNumOfRTags : longint;
+ RTagStart : TRTagStructure;
+ end;
+
+ PGetActiveLANBoardListStructure = ^TGetActiveLANBoardListStructure;
+ TGetActiveLANBoardListStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ maxNumOfLANs : longint;
+ itemsCount : longint;
+ boardNumbers : longint;
+ end;
+
+ PDriverConfigStructure = ^TDriverConfigStructure;
+ TDriverConfigStructure = record
+ DriverCFG_MajorVersion : byte;
+ DriverCFG_MinorVersion : byte;
+ DriverNodeAddress : array[0..5] of byte;
+ DriverModeFlags : word;
+ DriverBoardNumber : word;
+ DriverBoardInstance : word;
+ DriverMaximumSize : longint;
+ DriverMaxRecvSize : longint;
+ DriverRecvSize : longint;
+ DriverCardName : longint;
+ DriverShortName : longint;
+ DriverMediaType : longint;
+ DriverCardID : word;
+ DriverMediaID : word;
+ DriverTransportTime : word;
+ DriverReserved : array[0..15] of byte;
+ DriverMajorVersion : byte;
+ DriverMinorVersion : byte;
+ DriverFlags : word;
+ DriverSendRetries : word;
+ DriverLink : longint;
+ DriverSharingFlags : word;
+ DriverSlot : word;
+ DriverIOPortsAndLengths : array[0..3] of word;
+ DriverMemoryDecode0 : longint;
+ DriverLength0 : word;
+ DriverMemoryDecode1 : longint;
+ DriverLength1 : word;
+ DriverInterrupt : array[0..1] of byte;
+ DriverDMAUsage : array[0..1] of byte;
+ DriverResourceTag : longint;
+ DriverConfig : longint;
+ DriverCommandString : longint;
+ DriverLogicalName : array[0..17] of byte;
+ DriverLinearMemory : array[0..1] of longint;
+ DriverChannelNumber : word;
+ DriverIOReserved : array[0..5] of byte;
+ end;
+
+ PGetLANConfigInfoStructure = ^TGetLANConfigInfoStructure;
+ TGetLANConfigInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ LANConfig : TDriverConfigStructure;
+ end;
+
+ PCommonLANStructure = ^TCommonLANStructure;
+ TCommonLANStructure = record
+ notSupportedMask : longint;
+ TotalTxPacketCount : longint;
+ TotalRxPacketCount : longint;
+ NoECBAvailableCount : longint;
+ PacketTxTooBigCount : longint;
+ PacketTxTooSmallCount : longint;
+ PacketRxOverflowCount : longint;
+ PacketRxTooBigCount : longint;
+ PacketRxTooSmallCount : longint;
+ PacketTxMiscErrorCount : longint;
+ PacketRxMiscErrorCount : longint;
+ RetryTxCount : longint;
+ ChecksumErrorCount : longint;
+ HardwareRxMismatchCount : longint;
+ TotalTxOKByteCountLow : longint;
+ TotalTxOKByteCountHigh : longint;
+ TotalRxOKByteCountLow : longint;
+ TotalRxOKByteCountHigh : longint;
+ TotalGroupAddrTxCount : longint;
+ TotalGroupAddrRxCount : longint;
+ AdapterResetCount : longint;
+ AdapterOprTimeStamp : longint;
+ AdapterQueDepth : longint;
+ MediaSpecificCounter1 : longint;
+ MediaSpecificCounter2 : longint;
+ MediaSpecificCounter3 : longint;
+ MediaSpecificCounter4 : longint;
+ MediaSpecificCounter5 : longint;
+ MediaSpecificCounter6 : longint;
+ MediaSpecificCounter7 : longint;
+ MediaSpecificCounter8 : longint;
+ MediaSpecificCounter9 : longint;
+ MediaSpecificCounter10 : longint;
+ ValidMask1 : longint;
+ MediaSpecificCounter11 : longint;
+ MediaSpecificCounter12 : longint;
+ MediaSpecificCounter13 : longint;
+ MediaSpecificCounter14 : longint;
+ end;
+
+ PGetLANCommonCountersStructure = ^TGetLANCommonCountersStructure;
+ TGetLANCommonCountersStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ statMajorVersion : byte;
+ statMinorVersion : byte;
+ totalCommonCnts : longint;
+ totalCntBlocks : longint;
+ customCounters : longint;
+ nextCntBlock : longint;
+ info : TCommonLANStructure;
+ end;
+
+ PCustomCountersInfo = ^TCustomCountersInfo;
+ TCustomCountersInfo = record
+ value : longint;
+ stringLength : byte;
+ stringStart : byte;
+ end;
+
+ PGetCustomCountersInfoStructure = ^TGetCustomCountersInfoStructure;
+ TGetCustomCountersInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ moreflag : word;
+ numberOfCustomCounters : longint;
+ startOfCustomCounters : byte;
+ end;
+
+ PLSLInformation = ^TLSLInformation;
+ TLSLInformation = record
+ RxBufs : longint;
+ RxBufs75PerCent : longint;
+ RxBufsCheckedOut : longint;
+ RxBufMaxSize : longint;
+ MaxPhysicalSize : longint;
+ LastTimeRxBufAllocated : longint;
+ MaxNumbersOfProtocols : longint;
+ MaxNumbersOfMediaTypes : longint;
+ TotalTXPackets : longint;
+ GetECBBfrs : longint;
+ GetECBFails : longint;
+ AESEventCounts : longint;
+ PostpondedEvents : longint;
+ ECBCxlFails : longint;
+ ValidBfrsReused : longint;
+ EnqueuedSendCnt : longint;
+ TotalRXPackets : longint;
+ UnclaimedPackets : longint;
+ StatisticsTableMajorVersion : byte;
+ StatisticsTableMinorVersion : byte;
+ end;
+
+ PGetLSLInfoStructure = ^TGetLSLInfoStructure;
+ TGetLSLInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ LSLInfo : TLSLInformation;
+ end;
+
+ PLogicalBoard = ^TLogicalBoard;
+ TLogicalBoard = record
+ LogTtlTxPackets : longint;
+ LogTtlRxPackets : longint;
+ LogUnclaimedPackets : longint;
+ reserved : longint;
+ end;
+
+ PGetLSLBoardStatsStructure = ^TGetLSLBoardStatsStructure;
+ TGetLSLBoardStatsStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ boardStats : TLogicalBoard;
+ end;
+
+ PCopyOfPMStructure = ^TCopyOfPMStructure;
+ TCopyOfPMStructure = record
+ f1 : array[0..63] of byte;
+ f2 : longint;
+ f3 : longint;
+ end;
+
+ PCopyOfGenericInfoDef = ^TCopyOfGenericInfoDef;
+ TCopyOfGenericInfoDef = record
+ mediaInfo : TCopyOfPMStructure;
+ mediatype : longint;
+ cartridgetype : longint;
+ unitsize : longint;
+ blocksize : longint;
+ capacity : longint;
+ preferredunitsize : longint;
+ name : array[0..63] of byte;
+ _type : longint;
+ status : longint;
+ functionmask : longint;
+ controlmask : longint;
+ parentcount : longint;
+ siblingcount : longint;
+ childcount : longint;
+ specificinfosize : longint;
+ objectuniqueid : longint;
+ mediaslot : longint;
+ end;
+
+ PGetMManagerObjInfoStructure = ^TGetMManagerObjInfoStructure;
+ TGetMManagerObjInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ info : TCopyOfGenericInfoDef;
+ end;
+
+ PGetMMObjectListsStructure = ^TGetMMObjectListsStructure;
+ TGetMMObjectListsStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ nextStartNum : longint;
+ objectCount : longint;
+ objects : longint;
+ end;
+
+ PGetMMObjectChildListStructure = ^TGetMMObjectChildListStructure;
+ TGetMMObjectChildListStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ nextStartNum : longint;
+ objectCount : longint;
+ objects : longint;
+ end;
+
+ PVolumeSegmentStructure = ^TVolumeSegmentStructure;
+ TVolumeSegmentStructure = record
+ segmentDevice : longint;
+ segmentOffset : longint;
+ segmentSize : longint;
+ end;
+
+ PGetVolumeSegmentListStructure = ^TGetVolumeSegmentListStructure;
+ TGetVolumeSegmentListStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ numberOfSegments : longint;
+ segment : TVolumeSegmentStructure;
+ end;
+
+ PProtocolStackInfo = ^TProtocolStackInfo;
+ TProtocolStackInfo = record
+ stackNumber : longint;
+ stackName : array[0..15] of byte;
+ end;
+
+ PGetActiveProtocolStackStructure = ^TGetActiveProtocolStackStructure;
+ TGetActiveProtocolStackStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ maxNumberOfStacks : longint;
+ stackCount : longint;
+ nextStartNumber : longint;
+ stackInfo : TProtocolStackInfo;
+ end;
+
+ PGetProtocolConfigStructure = ^TGetProtocolConfigStructure;
+ TGetProtocolConfigStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ configMajorVersion : byte;
+ configMinorVerstion : byte;
+ stackMajorVersion : byte;
+ stackMinorVersion : byte;
+ shortName : array[0..15] of byte;
+ fullNameLength : byte;
+ fullName : byte;
+ end;
+
+ PGetProtocolStatsStructure = ^TGetProtocolStatsStructure;
+ TGetProtocolStatsStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ StatMajorVersion : byte;
+ StatMinorVersion : byte;
+ GenericCounters : word;
+ ValidCntsMask : longint;
+ TotalTxPackets : longint;
+ TotalRxPackets : longint;
+ IgnoredRxPackets : longint;
+ NumberOfCustomCounters : word;
+ end;
+
+ PProtocolCustomInfo = ^TProtocolCustomInfo;
+ TProtocolCustomInfo = record
+ value : longint;
+ length : byte;
+ customData : byte;
+ end;
+
+ PGetProtocolCustomInfoStructure = ^TGetProtocolCustomInfoStructure;
+ TGetProtocolCustomInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ customCount : longint;
+ info : TProtocolCustomInfo;
+ end;
+
+ PGetProtocolByMediaStructure = ^TGetProtocolByMediaStructure;
+ TGetProtocolByMediaStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ stackIDCount : longint;
+ stackID : longint;
+ end;
+
+ PGetProtocolByBoardStructure = ^TGetProtocolByBoardStructure;
+ TGetProtocolByBoardStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ stackIDCount : longint;
+ stackID : longint;
+ end;
+
+ PGetMediaNameByNumberStructure = ^TGetMediaNameByNumberStructure;
+ TGetMediaNameByNumberStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ mediaNameLength : byte;
+ mediaName : byte;
+ end;
+
+ PGetMediaNumberListStructure = ^TGetMediaNumberListStructure;
+ TGetMediaNumberListStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ maxNumberOfMedia : longint;
+ mediaListCount : longint;
+ mediaList : longint;
+ end;
+
+ PGetRouterAndSAPInfoStructure = ^TGetRouterAndSAPInfoStructure;
+ TGetRouterAndSAPInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ RIPSocketNumber : longint;
+ routerDownFlag : longint;
+ trackOnFlag : longint;
+ extRouterActiveFlag : longint;
+ SAPSocketNumber : longint;
+ rpyNearestServerFlag : longint;
+ end;
+
+ PGetNetRouterInfoStructure = ^TGetNetRouterInfoStructure;
+ TGetNetRouterInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ netIDNumber : longint;
+ hopsToNet : word;
+ netStatus : word;
+ timeToNet : word;
+ end;
+
+ PRoutersInfoStructure = ^TRoutersInfoStructure;
+ TRoutersInfoStructure = record
+ node : array[0..5] of byte;
+ connectedLAN : longint;
+ hopsToNetCount : word;
+ timeToNet : word;
+ end;
+
+ PGetNetworkRoutersInfoStructure = ^TGetNetworkRoutersInfoStructure;
+ TGetNetworkRoutersInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ numberOfEntries : longint;
+ info : TRoutersInfoStructure;
+ end;
+
+ PKnownNetworksStructure = ^TKnownNetworksStructure;
+ TKnownNetworksStructure = record
+ netIDNumber : longint;
+ hopsToNet : word;
+ netStatus : word;
+ timeToNet : word;
+ end;
+
+ PGetKnownNetworksStructure = ^TGetKnownNetworksStructure;
+ TGetKnownNetworksStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ numberOfEntries : longint;
+ info : TKnownNetworksStructure;
+ end;
+
+ PGetServerInfoStructure = ^TGetServerInfoStructure;
+ TGetServerInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ serverAddress : array[0..11] of byte;
+ hopsToServer : word;
+ end;
+
+ PServerSourceInfoStructure = ^TServerSourceInfoStructure;
+ TServerSourceInfoStructure = record
+ serverNode : array[0..5] of byte;
+ connectLAN : longint;
+ hopCount : word;
+ end;
+
+ PGetServerSourcesStructure = ^TGetServerSourcesStructure;
+ TGetServerSourcesStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ numberOfEntries : longint;
+ info : TServerSourceInfoStructure;
+ end;
+
+ PKnownServerStructure = ^TKnownServerStructure;
+ TKnownServerStructure = record
+ serverAddress : array[0..11] of byte;
+ hopCount : word;
+ serverNameLength : byte;
+ name : byte;
+ end;
+
+ PGetKnownServersInfoStructure = ^TGetKnownServersInfoStructure;
+ TGetKnownServersInfoStructure = record
+ currentServerTime : longint;
+ vConsoleVersion : byte;
+ vConsoleRevision : byte;
+ reserved : word;
+ numberOfEntries : longint;
+ info : TKnownServerStructure;
+ end;
+
+{$include npackoff.inc}
+
+function SSGetActiveConnListByType(startConnNumber:longint; connType:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetActiveConnListByType';
+function SSGetActiveLANBoardList(startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetActiveLANBoardList';
+function SSGetActiveProtocolStacks(startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetActiveProtocolStacks';
+function SSGetCacheInfo(pointer:PBYTE; bufferLen:word):longint;cdecl;external Clib name 'SSGetCacheInfo';
+function SSGetCPUInfo(CPUNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetCPUInfo';
+function SSGetDirCacheInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetDirCacheInfo';
+function SSGetFileServerInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetFileServerInfo';
+function SSGetFileSystemInfo(fileSystemID:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetFileSystemInfo';
+function SSGetGarbageCollectionInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetGarbageCollectionInfo';
+function SSGetIPXSPXInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetIPXSPXInfo';
+function SSGetKnownNetworksInfo(startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetKnownNetworksInfo';
+function SSGetKnownServersInfo(startNumber:longint; serverType:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetKnownServersInfo';
+function SSGetLANCommonCounters(boardNumber:longint; blockNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetLANCommonCounters';
+function SSGetLANConfiguration(boardNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetLANConfiguration';
+function SSGetLANCustomCounters(boardNumber:longint; startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetLANCustomCounters';
+function SSGetLSLInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetLSLInfo';
+function SSGetLSLLogicalBoardStats(boardNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetLSLLogicalBoardStats';
+function SSGetLoadedMediaNumberList(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetLoadedMediaNumberList';
+function SSGetMediaManagerObjChildList(startNumber:longint; objType:longint; parentObjNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetMediaManagerObjChildList';
+function SSGetMediaManagerObjInfo(objNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetMediaManagerObjInfo';
+function SSGetMediaManagerObjList(startNumber:longint; objType:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetMediaManagerObjList';
+function SSGetMediaNameByNumber(mediaNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetMediaNameByNumber';
+function SSGetNetRouterInfo(networkNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetNetRouterInfo';
+function SSGetNetworkRoutersInfo(networkNumber:longint; startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetNetworkRoutersInfo';
+function SSGetNLMInfo(NLMNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetNLMInfo';
+function SSGetNLMLoadedList(startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetNLMLoadedList';
+function SSGetNLMResourceTagList(NLMNumber:longint; startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetNLMResourceTagList';
+function SSGetOSVersionInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetOSVersionInfo';
+function SSGetPacketBurstInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetPacketBurstInfo';
+function SSGetProtocolConfiguration(startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetProtocolConfiguration';
+function SSGetProtocolCustomInfo(stackNumber:longint; customStartNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetProtocolCustomInfo';
+function SSGetProtocolNumbersByLANBoard(LANBoardNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetProtocolNumbersByLANBoard';
+function SSGetProtocolNumbersByMedia(mediaNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetProtocolNumbersByMedia';
+function SSGetProtocolStatistics(stackNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetProtocolStatistics';
+function SSGetRouterAndSAPInfo(buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetRouterAndSAPInfo';
+function SSGetServerInfo(serverType:longint; nameLength:byte; name:PBYTE; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetServerInfo';
+function SSGetServerSourcesInfo(startNumber:longint; serverType:longint; nameLength:byte; name:PChar; buffer:pointer;
+ bufferLen:word):longint;cdecl;external Clib name 'SSGetServerSourcesInfo';
+function SSGetUserInfo(connectionNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetUserInfo';
+function SSGetVolumeSegmentList(volumeNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetVolumeSegmentList';
+function SSGetVolumeSwitchInfo(startNumber:longint; buffer:pointer; bufferLen:word):longint;cdecl;external Clib name 'SSGetVolumeSwitchInfo';
+
+{------------------------------------------------------------------------------}
+const _MAX_LOGREC_NAME = 128;
+ _MAX_SEMAPHORE_NAME = 128;
+
+function ClearFile(fileName:Pchar):longint; cdecl;external Clib name 'ClearFile';
+procedure ClearFileSet; cdecl;external Clib name 'ClearFileSet';
+function ClearLogicalRecord(logicalRecordName:Pchar):longint;cdecl;external Clib name 'ClearLogicalRecord';
+procedure ClearLogicalRecordSet; cdecl;external Clib name 'ClearLogicalRecordSet';
+function ClearPhysicalRecord(fileHandle,recordStartOffset,recordLength:longint):longint;cdecl;external Clib name 'ClearPhysicalRecord';
+procedure ClearPhysicalRecordSet;cdecl;external Clib name 'ClearPhysicalRecordSet';
+function CloseSemaphore(semaphoreHandle:longint):longint;cdecl;external Clib name 'CloseSemaphore';
+function ExamineSemaphore(semaphoreHandle:longint; semaphoreValue:Plongint; openCount:PWORD):longint;cdecl;external Clib name 'ExamineSemaphore';
+function ExamineSemaphore(semaphoreHandle:longint; var semaphoreValue:longint; var openCount:word):longint;cdecl;external Clib name 'ExamineSemaphore';
+function LockFileSet(timeoutLimit:word):longint;cdecl;external Clib name 'LockFileSet';
+function LockLogicalRecordSet(timeoutLimit:word):longint;cdecl;external Clib name 'LockLogicalRecordSet';
+function LockPhysicalRecordSet(lockDirective:byte; timeoutLimit:word):longint;cdecl;external Clib name 'LockPhysicalRecordSet';
+function LogFile(fileName:Pchar; lockDirective:byte; timeoutLimit:word):longint;cdecl;external Clib name 'LogFile';
+function LogLogicalRecord(logicalRecordName:Pchar; lockDirective:byte; timeoutLimit:word):longint;cdecl;external Clib name 'LogLogicalRecord';
+function LogPhysicalRecord(fileHandle,recordStartOffset,recordLength:longint; lockDirective:byte; timeoutLimit:word):longint;cdecl;external Clib name 'LogPhysicalRecord';
+function OpenSemaphore(semaphoreName:Pchar; initialValue:longint; semaphoreHandle:Plongint; openCount:PWORD):longint;cdecl;external Clib name 'OpenSemaphore';
+function OpenSemaphore(semaphoreName:Pchar; initialValue:longint; var semaphoreHandle:longint; var openCount:word):longint;cdecl;external Clib name 'OpenSemaphore';
+function ReleaseFile(fileName:Pchar):longint;cdecl;external Clib name 'ReleaseFile';
+procedure ReleaseFileSet;cdecl;external Clib name 'ReleaseFileSet';
+function ReleaseLogicalRecord(logicalRecordName:Pchar):longint;cdecl;external Clib name 'ReleaseLogicalRecord';
+procedure ReleaseLogicalRecordSet;cdecl;external Clib name 'ReleaseLogicalRecordSet';
+function ReleasePhysicalRecord(fileHandle,recordStartOffset,recordLength:longint):longint;cdecl;external Clib name 'ReleasePhysicalRecord';
+procedure ReleasePhysicalRecordSet;cdecl;external Clib name 'ReleasePhysicalRecordSet';
+function SignalSemaphore(semaphoreHandle:longint):longint;cdecl;external Clib name 'SignalSemaphore';
+function WaitOnSemaphore(semaphoreHandle:longint; timeoutLimit:word):longint;cdecl;external Clib name 'WaitOnSemaphore';
+
+{------------------------------------------------------------------------------}
+
+function TTSAbortTransaction:longint;cdecl;external 'clib' name 'TTSAbortTransaction';
+function TTSBeginTransaction:longint;cdecl;external 'clib' name 'TTSBeginTransaction';
+function TTSEndTransaction(transactionNumber:Plongint):longint;cdecl;external 'clib' name 'TTSEndTransaction';
+function TTSEndTransaction(var transactionNumber:longint):longint;cdecl;external 'clib' name 'TTSEndTransaction';
+function TTSGetApplicationThresholds(logicalRecordLockThreshold:pbyte; physicalRecordLockThreshold:pbyte):longint;cdecl;external 'clib' name 'TTSGetApplicationThresholds';
+function TTSGetWorkstationThresholds(logicalRecordLockThreshold:pbyte; physicalRecordLockThreshold:pbyte):longint;cdecl;external 'clib' name 'TTSGetWorkstationThresholds';
+function TTSIsAvailable:longint;cdecl;external 'clib' name 'TTSIsAvailable';
+function TTSSetApplicationThresholds(logicalRecordLockThreshold:pbyte; physicalRecordLockThreshold:pbyte):longint;cdecl;external 'clib' name 'TTSSetApplicationThresholds';
+function TTSSetWorkstationThresholds(logicalRecordLockThreshold:pbyte; physicalRecordLockThreshold:pbyte):longint;cdecl;external 'clib' name 'TTSSetWorkstationThresholds';
+function TTSTransactionStatus(transactionNumber:longint):longint;cdecl;external 'clib' name 'TTSTransactionStatus';
+
+{------------------------------------------------------------------------------}
+
+implementation
+
+end.
+
+{
+ $Log: nwnit.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/nwpre.as b/rtl/netware/nwpre.as
new file mode 100644
index 0000000000..3e23966e28
--- /dev/null
+++ b/rtl/netware/nwpre.as
@@ -0,0 +1,142 @@
+#
+# $Id: nwpre.as,v 1.3 2003/03/25 18:17:54 armin Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2002 by the Free Pascal development team
+# Copyright (c) 2002 Armin Diehl
+#
+# This is the (nwpre-like) startup code for netware
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************
+
+ .file "nwpre.as"
+ .text
+
+#
+# This is the main program (not loader) Entry-Point that will be called by netware
+# it sets up the argc and argv and calls _nlm_main (in system.pp)
+#
+_pasStart_:
+ pushl $_nlm_main
+ call _SetupArgV_411
+ addl $4,%esp
+ ret
+# this is a hack to avoid that FPC_NW_CHECKFUNCTION will be
+# eleminated by the linker (with smartlinking)
+ call FPC_NW_CHECKFUNCTION
+
+
+#
+# this will be called by the loader, we pass the address of _pasStart_ and
+# _kNLMInfo (needed by clib) and netware is doing the work
+#
+ .globl _Prelude
+_Prelude:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %edi
+ pushl %esi
+ pushl %ebx
+ movl 0x14(%ebp),%edi
+ movl 0x18(%ebp),%esi
+ movl %esi, __uninitializedDataSize
+ movl 0x1c(%ebp),%ebx
+ movl 0x20(%ebp),%ecx
+ movl 0x28(%ebp),%eax
+ pushl $_pasStart_
+ pushl $_kNLMInfo
+ pushl %eax
+ movl 0x24(%ebp),%edx # 1b7f6
+ pushl %edx
+ pushl %ecx
+ pushl %ebx
+ pushl %esi # uninitialized data size
+ pushl %edi
+ movl 0x10(%ebp),%edx
+ pushl %edx
+ movl 0xc(%ebp),%edx
+ pushl %edx
+ movl 0x8(%ebp),%edx
+ pushl %edx
+ call _StartNLM
+ test %eax,%eax
+ jne x1
+ xorl %eax,%eax # dont know why this is needed ?
+x1:
+ lea 0xfffffff4(%ebp),%esp
+ popl %ebx
+ popl %esi
+ popl %edi
+ movl %ebp,%esp
+ popl %ebp
+ ret
+
+
+#
+# the global stop-function
+#
+ .globl _Stop
+_Stop:
+ pushl $0x5 # TERMINATE_BY_UNLOAD=0, TERMINATE_BY_EXTERNAL_THREAD=0
+ pushl $0x0
+ movl _kNLMInfo,%edx
+ pushl %edx
+ call _TerminateNLM
+ addl $0x0c,%esp
+ ret
+
+
+.data
+# argc is defined in the novell nwpre, i assume it is not needed
+#_argc:
+# .long 0
+
+# structure needed by clib
+# kNLMInfoT =
+# PACKED RECORD
+# Signature : ARRAY [0..3] OF CHAR; // LONG 'NLMI'
+# Flavor : LONGINT; // TRADINIONAL_FLAVOR = 0
+# Version : LONGINT; // TRADINIONAL_VERSION = 0, LIBERTY_VERSION = 1
+# LongDoubleSize : LONGINT; // gcc nwpre defines 12, watcom 8
+# wchar_tSize : LONGINT;
+# END;
+ .globl _kNLMInfo # will be used as data start
+_kNLMInfo:
+ .ascii "NLMI"
+ .long 0,1,8,2
+
+
+.text
+.globl __getTextStart
+__getTextStart:
+ movl $.text,%eax
+ ret
+
+.text
+.globl __getDataStart
+__getDataStart:
+ movl $.data,%eax
+ ret
+
+.text
+.globl __getBssStart
+__getBssStart:
+ movl $.bss,%eax
+ ret
+
+.data
+ __uninitializedDataSize: .long
+
+
+
+.text
+.globl __getUninitializedDataSize
+__getUninitializedDataSize:
+ movl __uninitializedDataSize, %eax
+ ret
diff --git a/rtl/netware/nwpre.pp b/rtl/netware/nwpre.pp
new file mode 100644
index 0000000000..6153cf648e
--- /dev/null
+++ b/rtl/netware/nwpre.pp
@@ -0,0 +1,158 @@
+{
+ $Id: nwpre.pp,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+ Copyright (c) 2001 Armin Diehl
+
+ This unit implements the startup code for a netware nlm. It must be the first object file
+ linked. Currently the 'old-style', similar to novell's prelude.obj is used. With the newer
+ way (novells nwpre.obj) i only got abends. Dont know what's different in novells nwpre.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+unit nwpre;
+
+interface
+
+{ 2000/08/29 armin: first version, untested
+ 2000/09/02 armin: Dont know why its not working with kNLMInfo...
+ It always abends in TerminateNLM, so i am using the old style
+ 2001/04/15 armin: Added comments, S-
+ Removed dead code }
+
+{$DEFINE OldPrelude}
+
+FUNCTION _Prelude (NLMHandle : LONGINT;
+ initErrorScreenID : LONGINT;
+ cmdLineP : PCHAR;
+ loadDirectoryPath : PCHAR;
+ uninitializedDataLength : LONGINT;
+ NLMFileHandle : LONGINT;
+ readRoutineP : POINTER;
+ customDataOffset : LONGINT;
+ customDataSize : LONGINT) : LONGINT; CDECL;
+
+
+implementation
+
+{$S-}
+
+FUNCTION _TerminateNLM (NLMInformation : POINTER;
+ threadID, status : LONGINT) : LONGINT; CDECL; EXTERNAL;
+
+FUNCTION _SetupArgV_411 (MainProc : POINTER) : LONGINT; CDECL; EXTERNAL;
+
+FUNCTION _StartNLM (NLMHandle : LONGINT;
+ initErrorScreenID : LONGINT;
+ cmdLineP : PCHAR;
+ loadDirectoryPath : PCHAR;
+ uninitializedDataLength : LONGINT;
+ NLMFileHandle : LONGINT;
+ readRoutineP : POINTER;
+ customDataOffset : LONGINT;
+ customDataSize : LONGINT;
+ NLMInformation : POINTER;
+ userStartFunc : POINTER) : LONGINT; CDECL; EXTERNAL;
+
+
+{**************************************************************************************************}
+
+CONST TRADINIONAL_NLM_INFO_SIGNATURE = 0;
+ TRADINIONAL_FLAVOR = 0;
+ TRADINIONAL_VERSION = 0;
+ LIBERTY_VERSION = 1;
+ TERMINATE_BY_EXTERNAL_THREAD = 0;
+ TERMINATE_BY_UNLOAD = 5;
+
+
+{$IFDEF OldPrelude}
+CONST NLMID : LONGINT = 0;
+{$ELSE}
+TYPE
+ kNLMInfoT =
+ PACKED RECORD
+ Signature : ARRAY [0..3] OF CHAR; // LONG
+ Flavor : LONGINT;
+ Version : LONGINT;
+ LongDoubleSize : LONGINT;
+ wchar_tSize : LONGINT;
+ END;
+
+CONST NLM_INFO_SIGNATURE = 'NLMI'; // 0x494d3c3e;
+
+ kNLMInfo : kNLMInfoT =
+ (Signature : NLM_INFO_SIGNATURE;
+ Flavor : TRADINIONAL_FLAVOR; // 0
+ Version : LIBERTY_VERSION; // 1
+ LongDoubleSize : 8;
+ wchar_tSize : 2);
+{$ENDIF}
+
+{**************************************************************************************************}
+
+{ _nlm_main is defined in system.pp. It sets command line parameters and calls PASCALMAIN }
+FUNCTION _nlm_main (Argc : LONGINT; ArgV : ARRAY OF PCHAR) : LONGINT; CDECL;
+EXTERNAL;
+
+
+FUNCTION _Stop : LONGINT; CDECL;
+BEGIN
+ {$IFDEF OldPrelude}
+ _Stop := _TerminateNLM (POINTER(NLMID),0,TERMINATE_BY_UNLOAD);
+ {$ELSE}
+ _Stop := _TerminateNLM (@kNLMInfo,0,TERMINATE_BY_UNLOAD);
+ {$ENDIF}
+END;
+
+
+FUNCTION _cstart_ : LONGINT; CDECL;
+BEGIN
+ _cstart_ := _SetupArgV_411 (@_nlm_main);
+END;
+
+
+FUNCTION _Prelude (NLMHandle : LONGINT;
+ initErrorScreenID : LONGINT;
+ cmdLineP : PCHAR;
+ loadDirectoryPath : PCHAR;
+ uninitializedDataLength : LONGINT;
+ NLMFileHandle : LONGINT;
+ readRoutineP : POINTER;
+ customDataOffset : LONGINT;
+ customDataSize : LONGINT) : LONGINT; CDECL;
+BEGIN
+ _Prelude := _StartNLM
+ (NLMHandle,
+ initErrorScreenID,
+ cmdLineP,
+ loadDirectoryPath,
+ uninitializedDataLength,
+ NLMFileHandle,
+ readRoutineP,
+ customDataOffset,
+ customDataSize,
+ {$IFDEF OldPrelude}
+ @NLMID,
+ {$ELSE}
+ @kNLMInfo,
+ {$ENDIF}
+ @_cstart_);
+END;
+
+
+
+
+end.
+{
+ $Log: nwpre.pp,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/nwprot.pp b/rtl/netware/nwprot.pp
new file mode 100644
index 0000000000..a688ae4cce
--- /dev/null
+++ b/rtl/netware/nwprot.pp
@@ -0,0 +1,1356 @@
+{ $Id: nwprot.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+
+ Netware Server Imports for FreePascal, contains definitions for the
+ netware server protocol library
+
+ Initial Version 2003/02/23 Armin (diehl@nordrhein.de or armin@freepascal.org)
+
+ The C-NDK and Documentation can be found here:
+ http://developer.novell.com
+
+ This program is distributed in the hope that it will be useful,but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE.
+
+ Do not blame Novell if there are errors in this file, instead
+ contact me and i will se what i can do.
+
+ This module is untested, for the socket functions please use winsock
+}
+
+unit nwprot;
+
+interface
+
+{$mode objfpc}
+{$packrecords C}
+
+const
+ O_RDONLY = $0000;
+ O_WRONLY = $0001;
+ O_RDWR = $0002;
+ O_ACCMODE = $0003;
+ O_APPEND = $0010;
+ O_CREAT = $0020;
+ O_TRUNC = $0040;
+ O_EXCL = $0080;
+ O_TEXT = $0100;
+ O_BINARY = $0200;
+ O_NDELAY = $0400;
+ O_NOCTTY = $0800;
+ O_NONBLOCK = O_NDELAY;
+
+
+{-ip_route.h-------------------------------------------------------------------}
+// dont know where the symbols came from, may be TCPIP.NLM, for now we
+// define 'clib'
+
+{ total size of an IP address in bytes }
+
+const
+ IP_ADDR_SZ = 4;
+
+
+type
+ Pip_addr = ^Tip_addr;
+ Tip_addr = record
+ case longint of
+ 0 : ( ip_array : array[0..(IP_ADDR_SZ)-1] of byte );
+ 1 : ( ip_short : array[0..(IP_ADDR_SZ DIV 2)-1] of word );
+ 2 : ( ip_long : dword );
+ end;
+
+const
+ SNPA_MX = 10; // maximum address mapping size is that largest we currently use
+
+// Simple IP interface information block --
+type
+ Pip_if_info = ^Tip_if_info;
+ Tip_if_info = record
+ ifi_local_addr : Tip_addr; // interface's IP address
+ ifi_net_mask : Tip_addr; // Netmask
+ ifi_broadcast : Tip_addr; // Broadcast
+ end;
+
+// Extended IP interface information block
+ Pip_extended_if_info = ^Tip_extended_if_info;
+ Tip_extended_if_info = record
+ iex_signature : dword; // API signature
+ iex_version : dword; // API version
+ iex_length : dword; // bufsize
+ iex_flags : dword;
+ iex_if_id : dword; // Interface-ID
+ iex_timestamp : dword; // creation time
+ iex_local_addr : Tip_addr; // IP Address
+ iex_net_mask : Tip_addr; // Netmask
+ iex_broadcast : Tip_addr; // Broadcast Address
+ iex_packet_mx : dword; // max out packet size
+ iex_packet_opt : dword; // optimum packet size
+ iex_reasm_mx : dword; // maximum reassembled packet
+ iex_net_type : longint; // Network type
+ iex_board_num : dword; // ODLI voardnumber
+ iex_our_snpa : array[0..(SNPA_MX)-1] of byte; // SNPA for interface
+ end;
+
+function IPExtendedIFInfo(info_pt:Pip_extended_if_info):longint;cdecl;external 'clib' name 'IPExtendedIFInfo';
+function IPExtendedIFInfo(var info_t:Tip_extended_if_info):longint;cdecl;external 'clib' name 'IPExtendedIFInfo';
+function IPGetIFInfo(if_info_pt:Pip_if_info):longint;cdecl;external 'clib' name 'IPGetIFInfo';
+function IPGetIFInfo(var if_info_t:Tip_if_info):longint;cdecl;external 'clib' name 'IPGetIFInfo';
+function IPGetLocalAddr(last_addr:dword):dword;cdecl;external 'clib' name 'IPGetLocalAddr';function IPGetLocalAddrIncludingAux(last_addr:dword):dword;cdecl;external 'clib' name 'IPGetLocalAddrIncludingAux';
+
+{-netdb.h----------------------------------------------------------------------}
+
+// Macros mapping the standard 4.3BSD names are not implemented in pascal
+
+{
+ $Abstract:
+ Standard definitions for accessing the socket interface's network
+ database in Novell's NetWare 386 TCP/IP. Since process context is
+ limited in NetWare 386, we need to play some games to provide context
+ to the database.
+ $
+
+ $Implementation Notes:
+ The actual NetWare 386 TCP/IP routines take an additional parameter
+ to provide them a block for maintaining context. The normal routines
+ are actually macros which call the context aware routines.
+
+ One modification is required for porting an NLM the NetWare 386
+ versions of the database routines: a context block must be defined.
+ This is done by using the macro NETDB_DEFINE_CONTEXT in any one
+ module linked into the NLM.
+
+ If the preprocessor symbol NOT_NETWARE_386 is defined, this becomes
+ the standard netdb.h from 4.3BSD for use in more typical environments.
+ $
+
+ The HOSTS database macros (i.e. gethostxxx) have the capability to
+ evaluate either to the routines that access just the local /etc/hosts
+ file (i.e. NWgethostxxx), or else the routines that automatically access
+ a combination of local file, DNS, and NIS (i.e. NetDBgethostxxx). The
+ former case is the way previous SDK usage of the macro was implemented.
+ The latter case is a newer option that utilizes network name services
+ transparent to the NLM, but it requires NETDB.NLM (which is also provided
+ in this SDK). NETDB.NLM is an extension to TCP/IP and may be freely
+ distributed with your product.
+
+ The developer may choose which routines to use by directly calling the
+ routines desired (either NWgethostxxx or NetDBgethostxxx). If the macros
+ are used, then the macros will call the local-file-only versions of the
+ calls (i.e. NWgethostxxx) unless the symbol NETDB_USE_INTERNET is
+ defined below. If you wish to use the internet name services such as
+ NIS or DNS in addition to the local hosts file for host access, then this
+ symbol must be defined (either here or in your source file).
+ }
+{$define NETDB_USE_INTERNET}
+
+const
+ HOST_NOT_FOUND = 1;
+ TRY_AGAIN = 2;
+ NO_RECOVERY = 3;
+ NO_ADDRESS = 4;
+
+{ Structures returned by network
+ data base library. All addresses
+ are supplied in host order, and
+ returned in network order (suitable
+ for use in system calls). }
+
+{ define h_addr h_addr_list[0] /* address, for backward compatiblity */ }
+type
+ Phostent = ^Thostent;
+ Thostent = record
+ h_name : Pchar; // official name of host
+ h_aliases : ^Pchar; // alias list
+ h_addrtype : longint;
+ h_length : longint; // length of address
+ h_addr_list : ^Pchar; // list of addresses from name server
+ end;
+
+// Assumption here is that a network number fits in 32 bits -- probably a poor one.
+ Pnetent = ^Tnetent;
+ Tnetent = record
+ n_name : Pchar; // official name of net
+ n_aliases : ^Pchar; // alias list
+ n_addrtype : longint;
+ n_net : dword;
+ n_mask : dword; // Netmask, Novell extension
+ end;
+
+ Pservent = ^Tservent;
+ Tservent = record
+ s_name : Pchar; // official service name
+ s_aliases : ^Pchar; // alias list
+ s_port : longint; // portnumber
+ s_proto : Pchar; // protocol to use
+ end;
+
+ Pprotoent = ^Tprotoent;
+ Tprotoent = record
+ p_name : Pchar; // official protocol name
+ p_aliases : ^Pchar;
+ p_proto : longint;
+ end;
+
+// var h_errno : longint;cvar;external;
+
+ const
+ SCRATCHBUFSIZE = 1024;
+ MAXALIASES = 10;
+ MAXALIASSIZE = 64;
+ MAXNAMESIZE = 64;
+ MAXADDRSIZE = 19;
+ MAXHOSTADDR = 1;
+
+ { Special Novell structure for providing context in the otherwise
+ context-free NetWare 386 environment. The applications SHOULD NOT
+ access this structure ! }
+ type
+ Pnwsockent = ^Tnwsockent;
+ Tnwsockent = record
+ nse_hostctx : pointer; // PFILE;
+ nse_netctx : pointer; // PFILE;
+ nse_protoctx : pointer; // PFILE;
+ nse_servctx : pointer; // PFILE;
+ nse_h_errno : longint;
+ nse_sockent_un : record
+ case longint of
+ 0 : ( nsu_hst : Thostent );
+ 1 : ( nsu_net : Tnetent );
+ 2 : ( nsu_proto : Tprotoent );
+ 3 : ( nsu_serv : Tservent );
+ end;
+ nse_scratch : array[0..(SCRATCHBUFSIZE)-1] of char;
+ end;
+ { Declare the context block. The client must supply the actual
+ block by placing NETDB_DEFINE_CONTEXT in one of the C modules
+ in the link. }
+// var nwSocketCtx : longint;cvar;external;
+
+ { ------------------------------------------------------------------------
+ Host file examination
+ ------------------------------------------------------------------------ }
+{ Local-file-only routines }
+
+function NWgethostbyname(nwsktctx:Pnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyname';
+function NWgethostbyname(var nwsktctx:Tnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyname';
+
+function NWgethostbyaddr(nwsktctx:Pnwsockent; addr:Pchar; length:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyaddr';
+function NWgethostbyaddr(var nwsktctx:Tnwsockent; addr:Pchar; length:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NWgethostbyaddr';
+
+function NWgethostent(nwsktctx:Pnwsockent):Phostent;cdecl;external {'tcpip'} name 'NWgethostent';
+function NWgethostent(var nwsktctx:Tnwsockent):Phostent;cdecl;external {'tcpip'} name 'NWgethostent';
+
+procedure NWsethostent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsethostent';
+procedure NWsethostent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsethostent';
+
+procedure NWendhostent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendhostent';
+procedure NWendhostent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendhostent';
+ { Internet Name Service routines }
+ {
+ NetDBgethostbyname() -- returns the host entry (struct hostent ) given
+ the name of a host.
+
+ The local file sys:/etc/hosts is consulted first to see if the entry
+ exists there. If so, then that is returned. If not, then if DNS is
+ installed on the machine, it will be consulted to perform the lookup.
+ If the host still is not found, then NIS will be consulted if at all
+ possible.
+
+ This function returns NULL when an error occurs. The integer
+ nwsktent->nse_h_errno can be checked to determine the nature of the
+ error.
+
+ The integer nwsktent->nse_h_errno can have the following values:
+
+ HOST_NOT_FOUND No such host exists.
+
+ If the NetDBgethostbyname function succeeds, it will return a pointer
+ to a structure of type struct hostent.
+
+ Syntax:
+ struct hostent NetDBgethostbyname(struct nwsockent nwsktent,
+ char name);
+
+ nwskent: Points to a context block.
+
+ name: Official name of the host.
+
+ Returns:
+ A pointer to the appropriate struct hostent if any that matches.
+ NULL if no match found.
+ }
+function NetDBgethostbyname(nwskent:Pnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyname';
+function NetDBgethostbyname(var nwskent:Tnwsockent; name:Pchar):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyname';
+ {
+ NetDBgethostbyaddr() -- returns the host entry (struct hostent ) given
+ the address of a host.
+
+ The local file sys:/etc/hosts is consulted first to see if the entry
+ exists there. If so, then that is returned. If not, then if DNS is
+ installed on the machine, it will be consulted to perform the lookup.
+ If the host still is not found, then NIS will be consulted if at all
+ possible.
+
+ This function returns NULL when an error occurs. The integer
+ nwsktent->nse_h_errno can be checked to determine the nature of the
+ error.
+
+ The integer nwsktent->nse_h_errno can have the following values:
+
+ HOST_NOT_FOUND No such host exists.
+
+ If the NetDBgethostbyaddr function succeeds, it will return a pointer
+ to a structure of type struct hostent.
+
+ Syntax:
+ struct hostent NetDBgethostbyaddr(struct nwsockent nwskent,
+ char addr, int len, int type);
+
+ nwsktent: (Input) Points to a context block.
+
+ addr: (Input) Internet address of the host.
+
+ len: (Input) Length of the Internet address, in bytes.
+
+ type: (Input) Value corresponding to the type of Internet
+ address. Currently, the type is always AF_INET.
+
+ Returns:
+ A pointer to the appropriate struct hostent if any that matches.
+ NULL if no match found.
+ }
+function NetDBgethostbyaddr(nwsktent:Pnwsockent; addr:Pchar; len:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyaddr';
+function NetDBgethostbyaddr(var nwsktent:Tnwsockent; addr:Pchar; len:longint; _type:longint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostbyaddr';
+ {
+ NetDBgethostent() -- returns the next sequential entry from the
+ SYS:ETC/HOSTS file, opening the file it it is not already open. Once
+ the local file is depleted, all of the NIS host entries will be
+ retrieved until those are depleted.
+
+ Note that there may be duplicate entries in the local and NIS databases.
+ The caller should handle these appropriately.
+
+ This function returns NULL when an error occurs. The integer
+ nwsktent->nse_h_errno can be checked to determine the nature of the
+ error.
+
+ The integer nwsktent->nse_h_errno can have the following values:
+
+ HOST_NOT_FOUND No more hosts exist in either SYS:ETC/HOSTS or
+ NIS.
+
+ Syntax:
+ struct hostent NetDBgethostent(struct nwsockent nwsktent,
+ short ploc);
+
+ nwsktent: (Input) Points to a context block.
+
+ ploc: (Output) If non-NULL, this short will indicate if this
+ entry is from the local sys:etc/hosts file (NETDB_LOC_LOCAL)
+ or from the NIS database (NETDB_LOC_NIS).
+
+ Pass in NULL if you're not interested in this information.
+
+ Returns:
+ A pointer to the next host entry if the function is successful.
+ NULL if no more entries or an error occurred.
+ }
+function NetDBgethostent(nwsktent:Pnwsockent; ploc:Psmallint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostent';
+function NetDBgethostent(var nwsktent:Tnwsockent; ploc:Psmallint):Phostent;cdecl;external {'tcpip'} name 'NetDBgethostent';
+ {
+ NetDBsethostent() -- rewinds the SYS:ETC/HOSTS file if the file is
+ already open. This call guarantees that the next call to
+ NetDBgethostent() will return the FIRST record in the local hosts file,
+ regardless of whether the LAST call returned an entry from the local
+ file or from NIS.
+
+ If the stayopen flag is set (nonzero), the SYS:ETC/HOSTS file is NOT
+ closed after each call made to NetDBgethostbyname() or
+ NetDBgethostbyaddr().
+
+ Syntax:
+ void NetDBsethostent(struct nwsockent nwsktent, int stayopen);
+
+ nwsktent: (Input) Points to a context block.
+
+ stayopen: (Input) If nonzero, causes SYS:ETC/HOSTS to remain open
+ after a call to NetDBgethostbyname() or
+ NetDBgethostbyaddr().
+
+ Returns:
+ Nothing.
+ }
+procedure NetDBsethostent(nwsktent:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NetDBsethostent';
+procedure NetDBsethostent(var nwsktent:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NetDBsethostent';
+ {
+ NetDBendhostent() -- closes the SYS:ETC/HOSTS file. Also ends access
+ to the NIS database. After this call, the next call to
+ NetDBgethostent() will be from the beginning of the local file again.
+
+ Syntax:
+ void NetDBendhostent(struct nwsockent nwsktent);
+
+ nwsktent: (Input) Points to a context block.
+
+ Returns:
+ Nothing.
+ }
+procedure NetDBendhostent(nwsktent:Pnwsockent);cdecl;external {'tcpip'} name 'NetDBendhostent';
+procedure NetDBendhostent(var nwsktent:Tnwsockent);cdecl;external {'tcpip'} name 'NetDBendhostent';
+ {
+ NetDBgethostname() -- this gets the current machine's host name into the
+ passed in buffer (if it is large enough).
+
+ This will use the local hosts file if it exists, otherwise it will then
+ try both DNS and NIS if available in order to get the official name of
+ our own machine.
+
+ Syntax:
+ int NetDBgethostname(struct nwsockent nwsktent, char name,
+ int namelen);
+
+ nwsktent: (Input) Points to a context block.
+
+ name: (Output) Official name of the host.
+
+ namelen: (Input) Specifies the size of the array pointed to by name.
+
+ Returns:
+ 0: The call succeeded.
+ -1: The call failed.
+ }
+function NetDBgethostname(nwsktent:Pnwsockent; name:Pchar; namelen:longint):longint;cdecl;external {'tcpip'} name 'NetDBgethostname';
+function NetDBgethostname(var nwsktent:Tnwsockent; name:Pchar; namelen:longint):longint;cdecl;external {'tcpip'} name 'NetDBgethostname';
+
+// Network file examination
+function NWgetnetbyname(nwsktctx:Pnwsockent; name:Pchar):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyname';
+function NWgetnetbyname(var nwsktctx:Tnwsockent; name:Pchar):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyname';
+
+function NWgetnetbyaddr(nwsktctx:Pnwsockent; net:longint; _type:longint):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyaddr';
+function NWgetnetbyaddr(var nwsktctx:Tnwsockent; net:longint; _type:longint):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetbyaddr';
+
+function NWgetnetent(nwsktctx:Pnwsockent):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetent';
+function NWgetnetent(var nwsktctx:Tnwsockent):Pnetent;cdecl;external {'tcpip'} name 'NWgetnetent';
+
+procedure NWsetnetent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetnetent';
+procedure NWsetnetent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetnetent';
+
+procedure NWendnetent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendnetent';
+procedure NWendnetent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendnetent';
+
+// Service file examination
+function NWgetservbyname(nwsktctx:Pnwsockent; name:Pchar; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyname';
+function NWgetservbyname(var nwsktctx:Tnwsockent; name:Pchar; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyname';
+
+function NWgetservbyport(nwsktctx:Pnwsockent; port:longint; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyport';
+function NWgetservbyport(var nwsktctx:Tnwsockent; port:longint; protocol:Pchar):Pservent;cdecl;external {'tcpip'} name 'NWgetservbyport';
+
+function NWgetservent(nwsktctx:Pnwsockent):Pservent;cdecl;external {'tcpip'} name 'NWgetservent';
+function NWgetservent(var nwsktctx:Tnwsockent):Pservent;cdecl;external {'tcpip'} name 'NWgetservent';
+
+procedure NWsetservent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetservent';
+procedure NWsetservent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetservent';
+
+procedure NWendservent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendservent';
+procedure NWendservent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendservent';
+
+// Protocol file examination
+function NWgetprotobyname(nwsktctx:Pnwsockent; name:Pchar):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobyname';
+function NWgetprotobyname(var nwsktctx:Tnwsockent; name:Pchar):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobyname';
+
+function NWgetprotobynumber(nwsktctx:Pnwsockent; protocol:longint):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobynumber';
+function NWgetprotobynumber(var nwsktctx:Tnwsockent; protocol:longint):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotobynumber';
+
+function NWgetprotoent(nwsktctx:Pnwsockent):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotoent';
+function NWgetprotoent(var nwsktctx:Tnwsockent):Pprotoent;cdecl;external {'tcpip'} name 'NWgetprotoent';
+
+procedure NWsetprotoent(nwsktctx:Pnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetprotoent';
+procedure NWsetprotoent(var nwsktctx:Tnwsockent; stayopen:longint);cdecl;external {'tcpip'} name 'NWsetprotoent';
+
+procedure NWendprotoent(nwsktctx:Pnwsockent);cdecl;external {'tcpip'} name 'NWendprotoent';
+procedure NWendprotoent(var nwsktctx:Tnwsockent);cdecl;external {'tcpip'} name 'NWendprotoent';
+
+function gethostname(name:Pchar; namelen:longint):longint;cdecl;external {'tcpip'} name 'gethostname';
+function gethostid:longint;cdecl;external {'tcpip'} name 'gethostid';
+{-tiuser.h---------------------------------------------------------------------}
+const
+ EAGAIN = -(1);
+{ Error values }
+ TACCES = 1;
+ TBADADDR = 2;
+ TBADDATA = 3;
+ TBADF = 4;
+ TBADFLAG = 5;
+ TBADOPT = 6;
+ TBADSEQ = 7;
+ TBUFOVFLW = 8;
+ TFLOW = 9;
+ TLOOK = 10;
+ TNOADDR = 11;
+ TNODATA = 12;
+ TNOREL = 13;
+ TNOTSUPPORT = 14;
+ TOUTSTATE = 15;
+ TSTATECHNG = 16;
+ TSYSERR = 17;
+ TNOUDERR = 18;
+ TNODIS = 19;
+ TNOSTRUCTYPE = 20;
+ TBADNAME = 21;
+ TBADQLEN = 22;
+ TADDRBUSY = 23;
+{ t_look events }
+ _T_LISTEN = 1;
+ _T_CONNECT = 2;
+ _T_DATA = 3;
+ _T_EXDATA = 4;
+ _T_DISCONNECT = 5;
+ _T_ORDREL = 6;
+ _T_ERROR = 7;
+ _T_UDERR = 8;
+ _T_GODATA = 9;
+ _T_GOEXDATA = 10;
+ _T_EVENTS = 11;
+{ Flag definitions }
+ _T_EXPEDITED = $01;
+ _T_MORE = $02;
+ _T_NEGOTIATE = $04;
+ _T_CHECK = $08;
+ _T_DEFAULT = $10;
+ _T_SUCCESS = $20;
+ _T_FAILURE = $40;
+
+var t_errno : longint;cvar;external;
+
+ type
+ Pt_info = ^Tt_info;
+ Tt_info = record
+ addr : longint;
+ options : longint;
+ tsdu : longint;
+ etsdu : longint;
+ connect : longint;
+ discon : longint;
+ servtype : longint;
+ end;
+
+ { Service types }
+ { Connection-mode service }
+
+ const
+ T_COTS = 1;
+ { Connection service with orderly release }
+ T_COTS_ORD = 2;
+ { Connectionless-mode service }
+ T_CLTS = 3;
+ type
+ Pnetbuf = ^Tnetbuf;
+ Tnetbuf = record
+ maxlen : dword;
+ len : dword;
+ buf : Pchar;
+ end;
+
+ Pt_bind = ^Tt_bind;
+ Tt_bind = record
+ addr : Tnetbuf;
+ qlen : dword;
+ end;
+
+ Pt_optmgmt = ^Tt_optmgmt;
+ Tt_optmgmt = record
+ opt : Tnetbuf;
+ flags : longint;
+ end;
+
+ Pt_discon = ^Tt_discon;
+ Tt_discon = record
+ udata : Tnetbuf;
+ reason : longint;
+ sequence : longint;
+ end;
+
+ Pt_call = ^Tt_call;
+ Tt_call = record
+ addr : Tnetbuf;
+ opt : Tnetbuf;
+ udata : Tnetbuf;
+ sequence : longint;
+ end;
+
+ Pt_unitdata = ^Tt_unitdata;
+ Tt_unitdata = record
+ addr : Tnetbuf;
+ opt : Tnetbuf;
+ udata : Tnetbuf;
+ end;
+
+ Pt_uderr = ^Tt_uderr;
+ Tt_uderr = record
+ addr : Tnetbuf;
+ opt : Tnetbuf;
+ error : longint;
+ end;
+
+ // t_alloc structure types, had to prefix with _ because some
+ // names conflict with functions
+
+ const
+ _T_BIND = $1;
+ _T_CALL = $2;
+ _T_OPTMGMT = $4;
+ _T_DIS = $8;
+ _T_UNITDATA = $10;
+ _T_UDERROR = $20;
+ _T_INFO = $40;
+ { XTI names for t_alloc structure types }
+ _T_BIND_STR = _T_BIND;
+ _T_OPTMGMT_STR = _T_OPTMGMT;
+ _T_CALL_STR = _T_CALL;
+ _T_DIS_STR = _T_DIS;
+ _T_UNITDATA_STR = _T_UNITDATA;
+ _T_UDERROR_STR = _T_UDERROR;
+ _T_INFO_STR = _T_INFO;
+ { t_alloc field identifiers }
+ _T_ADDR = $1000;
+ _T_OPT = $2000;
+ _T_UDATA = $4000;
+ _T_ALL = $8000;
+ { State values }
+ { added to match xti state tables }
+ _T_UNINIT = 0;
+ { unbound }
+ _T_UNBND = 1;
+ { idle }
+ _T_IDLE = 2;
+ { outgoing connection pending }
+ _T_OUTCON = 3;
+ { incoming connection pending }
+ _T_INCON = 4;
+ { data transfer }
+ _T_DATAXFER = 5;
+ { outgoing orderly release }
+ _T_OUTREL = 6;
+ { incoming orderly release }
+ _T_INREL = 7;
+ { general purpose defines }
+ _T_YES = 1;
+ _T_NO = 0;
+ _T_UNUSED = -(1);
+ _T_NULL = 0;
+ _T_ABSREQ = $8000;
+ var
+ t_errlist : array of Pchar;cvar;external;
+ t_nerr : longint;cvar;external;
+ {---------------------TCP specific Options-------------------------- }
+ { TCP Precedence Levels }
+
+ const
+ _T_ROUTINE = 0;
+ _T_PRIORITY = 1;
+ _T_IMMEDIATE = 2;
+ _T_FLASH = 3;
+ _T_OVERRIDEFLASH = 4;
+ _T_CRITIC_ECP = 5;
+ _T_INETCONTROL = 6;
+ _T_NETCONTROL = 7;
+
+ type
+ Psecoptions = ^Tsecoptions;
+ Tsecoptions = record
+ security : smallint;
+ compartment : smallint;
+ handling : smallint;
+ tcc : longint;
+ end;
+
+ Ptcp_options = ^Ttcp_options;
+ Ttcp_options = record
+ precedence : smallint; // TCP options
+ timeout : longint; // abort timeout
+ max_seg_size : longint;
+ secopt : Tsecoptions; // security options
+ end;
+
+
+function t_accept(fd:longint; resfd:longint; call:Pt_call):longint;cdecl;external 'tli' name 't_accept';
+function t_alloc(fd:longint; struct_type:longint; fields:longint):Pchar;cdecl;external 'tli' name 't_alloc';
+function t_bind(fd:longint; req:Pt_bind; ret:Pt_bind):longint;cdecl;external 'tli' name 't_bind';
+function t_blocking(fd:longint):longint;cdecl;external 'tli' name 't_blocking';
+function t_close(fd:longint):longint;cdecl;external 'tli' name 't_close';
+function t_connect(fd:longint; sndcall:Pt_call; rcvcall:Pt_call):longint;cdecl;external 'tli' name 't_connect';
+procedure t_error(errmsg:Pchar);cdecl;external 'tli' name 't_error';
+function t_free(ptr:Pchar; struct_type:longint):longint;cdecl;external 'tli' name 't_free';
+function t_getinfo(fd:longint; info:Pt_info):longint;cdecl;external 'tli' name 't_getinfo';
+function t_getstate(fd:longint):longint;cdecl;external 'tli' name 't_getstate';
+function t_listen(fd:longint; call:Pt_call):longint;cdecl;external 'tli' name 't_listen';
+function t_look(fd:longint):longint;cdecl;external 'tli' name 't_look';
+function t_nonblocking(fd:longint):longint;cdecl;external 'tli' name 't_nonblocking';
+function t_open(path:Pchar; oflag:longint; info:Pt_info):longint;cdecl;external 'tli' name 't_open';
+function t_optmgmt(fd:longint; req:Pt_optmgmt; ret:Pt_optmgmt):longint;cdecl;external 'tli' name 't_optmgmt';
+function t_rcv(fd:longint; buf:Pchar; nbytes:dword; flags:Plongint):longint;cdecl;external 'tli' name 't_rcv';
+function t_rcvconnect(fd:longint; call:Pt_call):longint;cdecl;external 'tli' name 't_rcvconnect';
+function t_rcvdis(fd:longint; discon:Pt_discon):longint;cdecl;external 'tli' name 't_rcvdis';
+function t_rcvrel(fd:longint):longint;cdecl;external 'tli' name 't_rcvrel';
+function t_rcvudata(fd:longint; unitdata:Pt_unitdata; flags:Plongint):longint;cdecl;external 'tli' name 't_rcvudata';
+function t_rcvuderr(fd:longint; uderr:Pt_uderr):longint;cdecl;external 'tli' name 't_rcvuderr';
+function t_snd(fd:longint; buf:Pchar; nbytes:dword; flags:longint):longint;cdecl;external 'tli' name 't_snd';
+function t_snddis(fd:longint; call:Pt_call):longint;cdecl;external 'tli' name 't_snddis';
+function t_sndrel(fd:longint):longint;cdecl;external 'tli' name 't_sndrel';
+function t_sndudata(fd:longint; unitdata:Pt_unitdata):longint;cdecl;external 'tli' name 't_sndudata';
+function t_sync(fd:longint):longint;cdecl;external 'tli' name 't_sync';
+function t_unbind(fd:longint):longint;cdecl;external 'tli' name 't_unbind';
+
+// havent found the declaration for __get_t_errno_ptr, hope that is correct:
+function __get_t_errno_ptr:plongint; cdecl;external 'clib' name '__get_t_errno_ptr';
+
+function t_error : longint;
+
+{-ositli.h---------------------------------------------------------------------}
+const
+ TPDR_NORMAL = 128 + 0;
+ TPDR_CRCONG = 128 + 1;
+ TPDR_CONNEG = 128 + 2;
+ TPDR_DUPSR = 128 + 3;
+ TPDR_MMREF = 128 + 4;
+ TPDR_PE = 128 + 5;
+ TPDR_REOVFL = 128 + 7;
+ TPDR_NWREF = 128 + 8;
+ TPDR_INVHD = 128 + 10;
+ TPDR_RNS = 0;
+ TPDR_CONG = 1;
+ TPDR_NOSESS = 2;
+ TPDR_UNKADDR = 3; // Address unknown
+
+// Options management pre-defined values.
+ T_YES = 1;
+ T_NO = 0;
+ T_UNUSED = -(1);
+ T_NULL = 0;
+ T_ABSREQ = $8000;
+ T_PRIDFLT = 4;
+ T_PRILOW = 3;
+ T_PRIMID = 2;
+ T_PRIHIGH = 1;
+ T_PRITOP = 0;
+ T_NOPROTECT = 1;
+ T_PASSIVEPROTECT = 2;
+ T_ACTIVEPROTECT = 4;
+ T_LTPDUDFLT = 2048;
+ T_CLASS0 = 0;
+ T_CLASS1 = 1;
+ T_CLASS2 = 2;
+ T_CLASS3 = 3;
+ T_CLASS4 = 4;
+
+ // Options Management structures.
+type
+ Prate = ^Trate;
+ Trate = record
+ targetvalue : longint; // target value
+ minacceptvalue : longint; // minimum acceptable value
+ end;
+
+ Preqvalue = ^Treqvalue;
+ Treqvalue = record
+ called : Trate; // called rate
+ calling : Trate; // calling rate
+ end;
+
+ Pthrpt = ^Tthrpt;
+ Tthrpt = record
+ maxthrpt : Treqvalue; // maximum throughput
+ avgthrpt : Treqvalue; // average throughput
+ end;
+
+ Pmanagement = ^Tmanagement;
+ Tmanagement = record
+ dflt : smallint;
+ ltpdu : longint;
+ reastime : smallint;
+ _class : char;
+ altclass : char;
+ extform : char;
+ flowctrl : char;
+ checksum : char;
+ netexp : char;
+ netrecptcf: char;
+ end;
+
+// Connection oriented options.
+ Pisoco_options = ^Tisoco_options;
+ Tisoco_options = record
+ throughput : Tthrpt;
+ transdel : Treqvalue;
+ reserrorrate : Trate;
+ transffailprob : Trate;
+ estfailprob : Trate;
+ relfailprob : Trate;
+ estdelay : Trate;
+ reldelay : Trate;
+ connresil : Tnetbuf;
+ protection : word;
+ priority : smallint;
+ mngmt : Tmanagement; // management parameters
+ expd : char; // expedited data: T_YES or T_NO
+ end;
+
+// Connectionless options.
+ Pisocl_options = ^Tisocl_options;
+ Tisocl_options = record
+ transdel : Trate; // transit delay
+ reserrorrate : Trate; // residual error rate
+ protection : word;
+ priority : smallint;
+ end;
+
+// Novell connectionless options.
+ Pnovell_isocl_options = ^Tnovell_isocl_options;
+ Tnovell_isocl_options = record
+ transdel : Trate; // transit delay
+ reserrorrate : Trate; // residual error rate
+ protection : word;
+ priority : smallint;
+ checksum : longint;
+ end;
+{-param.h----------------------------------------------------------------------}
+const
+ HZ = 18;
+ NULL = 0;
+ PZERO = 20;
+ PCATCH = $8000;
+{-poll.h-----------------------------------------------------------------------}
+const
+ NPOLLFILE = 65535;
+ POLLIN = 1;
+ POLLPRI = 2;
+ POLLOUT = 4;
+ POLLERR = 10;
+ POLLHUP = 20;
+ POLLNVAL = 40;
+{ array of streams to poll }
+{ Internal "fd" for the benefit of the kernel }
+type
+ Ppollfd = ^Tpollfd;
+ Tpollfd = record
+ fd : longint;
+ events : smallint;
+ revents : smallint;
+ _ifd : longint;
+ end;
+
+{ I_POLL structure for ioctl on non-5.3 systems }
+ Pstrpoll = ^Tstrpoll;
+ Tstrpoll = record
+ nfds : dword;
+ pollfdp : Ppollfd;
+ timeout : longint;
+ end;
+
+function poll(const fds:array of Tpollfd; nfds:dword; timeout:longint):longint;cdecl;external 'clib' name 'poll';
+{-proc.h-----------------------------------------------------------------------}
+type
+ Pproc = ^Tproc;
+ Tproc = record
+ p_pid : smallint;
+ p_pgrp : smallint;
+ end;
+{-strlog.h---------------------------------------------------------------------}
+const
+ SL_FATAL = $1;
+ SL_NOTIFY = $2;
+ SL_ERROR = $4;
+ SL_TRACE = $8;
+ I_TRCLOG = 1;
+ I_ERRLOG = 2;
+ LOGMSGSZ = 128;
+
+type
+ Plog_ctl = ^Tlog_ctl;
+ Tlog_ctl = record
+ mid : smallint;
+ sid : smallint;
+ level : char;
+ flags : smallint;
+ ltime : longint;
+ ttime : longint;
+ seq_no: longint;
+ end;
+
+ Ptrace_ids = ^Ttrace_ids;
+ Ttrace_ids = record
+ ti_mid : smallint;
+ ti_sid : smallint;
+ ti_level : char;
+ ti_flags : smallint;
+ end;
+{-strstat.h--------------------------------------------------------------------}
+type
+ Pmodule_stat = ^Tmodule_stat;
+ Tmodule_stat = record
+ ms_pcnt : longint;
+ ms_scnt : longint;
+ ms_ocnt : longint;
+ ms_ccnt : longint;
+ ms_acnt : longint;
+ ms_xptr : Pchar;
+ ms_xsize: smallint;
+ end;
+{-user.h-----------------------------------------------------------------------}
+type
+ Puser = ^Tuser;
+ Tuser = record
+ u_error : longint;
+ u_uid : longint;
+ u_gid : longint;
+ u_ruid : longint;
+ u_rgid : longint;
+ u_ttyp : Psmallint;
+ u_procp : Pproc;
+ end;
+{-stream.h---------------------------------------------------------------------}
+type
+ Pmodule_info = ^Tmodule_info;
+ Tmodule_info = record
+ mi_idnum : word;
+ mi_idname : Pchar;
+ mi_minpsz : smallint;
+ mi_maxpsz : smallint;
+ mi_hiwat : smallint;
+ mi_lowat : smallint;
+ end;
+
+ Pqinit = ^Tqinit;
+ Tqinit = record
+ qi_putp : function :longint;cdecl;
+ qi_srvp : function :longint;
+ qi_qopen : function :longint;
+ qi_qclose : function :longint;
+ qi_qadmin : function :longint;
+ qi_minfo : Pmodule_info;
+ qi_mstat : Pmodule_stat;
+ end;
+
+ Pdatab = ^Tdatab;
+ Tdatab = record
+ db_freep : Pdatab;
+ db_base : Pbyte;
+ db_lim : Pbyte;
+ db_ref : byte;
+ db_type : byte;
+ db_class : byte;
+ db_pad : array[0..0] of byte;
+ end;
+
+ Tdblk_t = Tdatab;
+
+type
+ Pmsgb = ^Tmsgb;
+ Tmsgb = record
+ b_next : Pmsgb; // next message on queue
+ b_prev : Pmsgb; // previous message on queue
+ b_cont : Pmsgb; // next message block of message
+ b_rptr : PChar; // first unread data byte in buffer
+ b_wptr : PChar; // first unwritten data byte
+ b_datap : Pdatab; // data block
+ end;
+
+ Tmblk_t = Tmsgb;
+ Pmblk_t = Pmsgb;
+
+ Pq_xtra = pointer; // dont know where this is defined
+
+ Pqueue = ^Tqueue;
+ Tqueue = record
+ q_qinfo : Pqinit;
+ q_first : Pmsgb;
+ q_last : Pmsgb;
+ q_next : Pqueue;
+ q_link : Pqueue;
+ q_ptr : Pchar;
+ q_count : byte; //ushort;
+ q_flag : byte; // ushort;
+ q_minpsz: smallint;
+ q_maxpsz: smallint;
+ q_hiwat : byte; // ushort;
+ q_lowat : byte; // ushort;
+ q_osx : Pq_xtra;
+ q_ffcp : Pqueue;
+ q_bfcp : Pqueue;
+ end;
+
+ Tqueue_t = Tqueue;
+ Pqueue_t = Pqueue;
+{ Q state defines }
+
+const
+ F_Q_IS_WRITE_Q = $1;
+ F_Q_DISABLED = $2;
+ F_Q_FULL = $4;
+ F_Q_TO_SCHEDULE = $8;
+ F_Q_PUT_STOPPED = $10;
+ F_Q_WELDED = $20;
+ F_Q_SEQUENT_SYNCH = $40;
+{ Q state defines for 5.4 compatibility }
+ QREADR = $80;
+ QFULL = F_Q_FULL;
+ QENAB = F_Q_TO_SCHEDULE;
+{ Used in M_IOCTL mblks to muxes (ioc_cmd I_LINK) }
+{ lowest level write queue of upper stream }
+{ highest level write queue of lower stream }
+{ system-unique index for lower stream }
+type
+ Plinkblk = ^Tlinkblk;
+ Tlinkblk = record
+ l_qtop : Pqueue_t;
+ l_qbot : Pqueue_t;
+ l_index : longint;
+ end;
+
+{ Message types }
+
+const
+ QNORM = 0;
+{ Ordinary data }
+ M_DATA = 0;
+{ Internal control info and data }
+ M_PROTO = 1;
+{ Request a driver to send a break }
+ M_BREAK = 010;
+{ Used to pass a file pointer }
+ M_PASSFP = 011;
+{ Requests a signal to be sent }
+ M_SIG = 013;
+{ Request a real-time delay }
+ M_DELAY = 014;
+{ For inter-module communication }
+ M_CTL = 015;
+{ Used internally for I_STR requests }
+ M_IOCTL = 016;
+{ Alters characteristics of stream head }
+ M_SETOPTS = 020;
+{ Priority messages types }
+ QPCTL = 0200;
+{ Positive ack of previous M_IOCTL }
+ M_IOCACK = 0201;
+{ Previous M_IOCTL failed }
+ M_IOCNAK = 0202;
+{ Same as M_PROTO except for priority }
+ M_PCPROTO = 0203;
+{ Priority signal }
+ M_PCSIG = 0204;
+{ Requests modules to flush queues }
+ M_FLUSH = 0206;
+{ Request drivers to stop output }
+ M_STOP = 0207;
+{ Request drivers to start output }
+ M_START = 0210;
+{ Driver can no longer produce data }
+ M_HANGUP = 0211;
+{ Reports downstream error condition }
+ M_ERROR = 0212;
+{ Reports client read at stream head }
+ M_READ = 0213;
+{ PSE-private type; high priority data }
+ M_HPDATA = 0214;
+ FLUSHALL = 1;
+ FLUSHDATA = 0;
+
+type
+ Piocblk = ^Tiocblk;
+ Tiocblk = record
+ ioc_cmd : longint;
+ ioc_uid : word;
+ ioc_gid : word;
+ ioc_id : dword;
+ ioc_count : dword;
+ ioc_error : longint;
+ ioc_rval : longint;
+ end;
+
+ Pstrpfp = ^Tstrpfp;
+ Tstrpfp = record
+ pass_file_cookie : dword;
+ pass_uid : word;
+ pass_gid : word;
+ pass_sth : pointer;
+ end;
+
+ Pstroptions = ^Tstroptions;
+ Tstroptions = record
+ so_flags : smallint;
+ so_readopt : smallint;
+ so_wroff : word;
+ so_minpsz : smallint;
+ so_maxpsz : smallint;
+ so_hiwat : word;
+ so_lowat : word;
+ end;
+
+const
+ SO_ALL = 0377;
+ SO_READOPT = 01;
+ SO_WROFF = 02;
+ SO_MINPSZ = 04;
+ SO_MAXPSZ = 010;
+ SO_HIWAT = 020;
+ SO_LOWAT = 040;
+ SO_MREADON = 0100;
+ SO_MREADOFF = 0200;
+ BPRI_LO = 1;
+ BPRI_MED = 2;
+ BPRI_HI = 3;
+ INFPSZ = -(1);
+
+const
+ MAXMSGSIZE = 4096;
+ OPENFAIL = -(1);
+ CLONEOPEN = $2;
+ MODOPEN = $1;
+ NSTREVENT = 40;
+ STRMSGSZ = MAXMSGSIZE;
+ STRCTLSZ = 1024;
+ STRLOFRAC = 80;
+ STRMEDFRAC = 90;
+ MAXBSIZE = MAXMSGSIZE;
+
+type TFuncLongCdecl = function : longint; cdecl;
+
+function allocb(size:longint; pri:longint):Pmblk_t;cdecl;external 'streams' name 'allocb';
+function allocq:Pqueue_t;cdecl;external 'streams' name 'allocq';
+function adjmsg(mp:Pmblk_t; len_param:longint):longint;cdecl;external 'streams' name 'adjmsg';
+function backq(q:Pqueue_t):Pqueue_t;cdecl;external 'streams' name 'backq';
+function bufcall(size:longint; pri:longint; func:TFuncLongCdecl; arg:longint):longint;cdecl;external 'streams' name 'bufcall';
+procedure bcopy(src:Pchar; dst:Pchar; len:longint);cdecl;external 'streams' name 'bcopy';
+procedure bzero(buffer:Pchar; nbytes:longint);cdecl;external 'streams' name 'bzero';
+function canput(q:Pqueue_t):longint;cdecl;external 'streams' name 'canput';
+function copyb(mp:Pmblk_t):Pmblk_t;cdecl;external 'streams' name 'copyb';
+function copymsg(mp:Pmblk_t):Pmblk_t;cdecl;external 'streams' name 'copymsg';
+function dupb(bp:Pmblk_t):Pmblk_t;cdecl;external 'streams' name 'dupb';
+function dupmsg(mp:Pmblk_t):Pmblk_t;cdecl;external 'streams' name 'dupmsg';
+function flushq(q:Pqueue_t; flag:longint):longint;cdecl;external 'streams' name 'flushq';
+function freeb(bp:Pmblk_t):longint;cdecl;external 'streams' name 'freeb';
+function freemsg(mp:Pmblk_t):longint;cdecl;external 'streams' name 'freemsg';
+function freeq(q:Pqueue_t):longint;cdecl;external 'streams' name 'freeq';
+function getq(q:Pqueue_t):Pmblk_t;cdecl;external 'streams' name 'getq';
+function insq(q:Pqueue_t; emp:Pmblk_t; nmp:Pmblk_t):longint;cdecl;external 'streams' name 'insq';
+function linkb(mp1:Pmblk_t; mp2:Pmblk_t):longint;cdecl;external 'streams' name 'linkb';
+function msgdsize(mp:Pmblk_t):longint;cdecl;external 'streams' name 'msgdsize';
+function pullupmsg(mp:Pmblk_t; len:longint):longint;cdecl;external 'streams' name 'pullupmsg';
+function putbq(q:Pqueue_t; mp:Pmblk_t):longint;cdecl;external 'streams' name 'putbq';
+function putctl(q:Pqueue_t; _type:longint):longint;cdecl;external 'streams' name 'putctl';
+function putctl1(q:Pqueue_t; _type:longint; c:longint):longint;cdecl;external 'streams' name 'putctl1';
+function putq(q:Pqueue_t; mp:Pmblk_t):longint;cdecl;external 'streams' name 'putq';
+function qenable(q:Pqueue_t):longint;cdecl;external 'streams' name 'qenable';
+function qreply(q:Pqueue_t; mp:Pmblk_t):longint;cdecl;external 'streams' name 'qreply';
+function qsize(q:Pqueue_t):longint;cdecl;external 'streams' name 'qsize';
+function rmvb(mp:Pmblk_t; bp:Pmblk_t):Pmblk_t;cdecl;external 'streams' name 'rmvb';
+function rmvq(q:Pqueue_t; mp:Pmblk_t):longint;cdecl;external 'streams' name 'rmvq';
+function strlog(sid:smallint; mid:smallint; level:char; aflags:smallint; args:array of const):longint;cdecl;external 'streams' name 'strlog';
+function strlog(sid:smallint; mid:smallint; level:char; aflags:smallint):longint;cdecl;external 'streams' name 'strlog';
+function testb(size:longint; pri:longint):longint;cdecl;external 'streams' name 'testb';
+function timeout(func:TFuncLongCdecl; arg:pointer; ticks:longint):longint;cdecl;external 'streams' name 'timeout';
+function unlinkb(mp:Pmblk_t):Pmblk_t;cdecl;external 'streams' name 'unlinkb';
+function unbufcall(id:longint):longint;cdecl;external 'streams' name 'unbufcall';
+{-tispxipx.h-------------------------------------------------------------------}
+type
+ Pipxaddr_s = ^Tipxaddr_s;
+ Tipxaddr_s = record
+ ipxa_net : array[0..3] of byte;
+ ipxa_node : array[0..5] of byte;
+ ipxa_socket : array[0..1] of byte;
+ end;
+ TIPX_ADDR = Tipxaddr_s;
+ PIPX_ADDR = ^TIPX_ADDR;
+
+ Pipxopt_s = ^Tipxopt_s;
+ Tipxopt_s = record
+ ipx_type : byte;
+ ipx_pad1 : array[0..2] of byte;
+ ipx_hops : byte;
+ ipx_pad2 : array[0..2] of byte;
+ end;
+ TIPX_OPTS = Tipxopt_s;
+ PIPX_OPTS = ^TIPX_OPTS;
+
+ Pspxopt_s = ^Tspxopt_s;
+ Tspxopt_s = record
+ spx_connectionID : array[0..1] of byte;
+ spx_allocationNumber : array[0..1] of byte;
+ spx_pad1 : array[0..3] of byte;
+ end;
+ TSPX_OPTS = Tspxopt_s;
+ PSPX_OPTS = ^TSPX_OPTS;
+
+ Pspx_optmgmt = ^Tspx_optmgmt;
+ Tspx_optmgmt = record
+ spxo_retry_count : byte;
+ spxo_watchdog_flag : byte;
+ spxo_min_retry_delay : dword;
+ spxo_pad2 : array[0..1] of byte;
+ end;
+
+const
+ OPTIONS_VERSION = 1;
+
+function OPTIONS_SIZE : longint;
+
+type
+ Pspx2_options = ^Tspx2_options;
+ Tspx2_options = record
+ versionNumber : dword;
+ spxIIOptionNegotiate : dword;
+ spxIIRetryCount : dword;
+ spxIIMinimumRetryDelay : dword;
+ spxIIMaximumRetryDelta : dword;
+ spxIIWatchdogTimeout : dword;
+ spxIIConnectTimeout : dword;
+ spxIILocalWindowSize : dword;
+ spxIIRemoteWindowSize : dword;
+ spxIIConnectionID : dword;
+ spxIIInboundPacketSize : dword;
+ spxIIOutboundPacketSize: dword;
+ spxIISessionFlags : dword;
+ end;
+
+const
+ SPX_WATCHDOG_OFF = 0;
+ SPX_WATCHDOG_ON = not (SPX_WATCHDOG_OFF);
+ SPX_WATCHDOG_DEFAULT = SPX_WATCHDOG_ON;
+ SPX_RETRY_MIN = 3;
+ SPX_RETRY_MAX = 50;
+ SPX_RETRY_DEFAULT = 10;
+ SPX_WATCHDOG_TIMEOUT_MIN = 3000;
+ SPX_WATCHDOG_TIMEOUT_MAX = 300000;
+ SPX_WATCHDOG_TIMEOUT_DEFAULT = 60000;
+ SPX_MIN_RETRY_DELAY_MIN = 1;
+ SPX_MIN_RETRY_DELAY_MAX = 60000;
+ SPX_MIN_RETRY_DELAY_DEFAULT = 0;
+ SPX_MAX_RETRY_DELTA_MIN = 1000;
+ SPX_MAX_RETRY_DELTA_MAX = 60000;
+ SPX_MAX_RETRY_DELTA_DEFAULT = 5000;
+ SPX_OPTION_NEGOTIATE_OFF = 0;
+ SPX_OPTION_NEGOTIATE_ON = not (SPX_OPTION_NEGOTIATE_OFF);
+ SPX_OPTION_NEGOTIATE_DEFAULT = SPX_OPTION_NEGOTIATE_ON;
+ SPX_CONNECT_TIMEOUT_MIN = 1000;
+ SPX_CONNECT_TIMEOUT_MAX = 120000;
+ SPX_CONNECT_TIMEOUT_DEFAULT = 0;
+ SPX_LOCAL_WINDOW_SIZE_MIN = 1;
+ SPX_LOCAL_WINDOW_SIZE_MAX = 8;
+ SPX_LOCAL_WINDOW_SIZE_DEFAULT = 0;
+ SPX2_SF_NONE = $00;
+ SPX2_SF_IPX_CHECKSUM = $01;
+ SPX2_SF_SPX2_SESSION = $02;
+ TLI_SPX_CONNECTION_FAILED = $ed;
+ TLI_SPX_CONNECTION_TERMINATED = $ec;
+ TLI_SPX_MALFORMED_PACKET = $fe;
+ TLI_SPX_PACKET_OVERFLOW = $fd;
+ TLI_SPX_UNREACHABLE_DEST = $70;
+ TLI_IPX_MALFORMED_ADDRESS = $fe;
+ TLI_IPX_PACKET_OVERFLOW = $fd;
+
+{-in.pp------------------------------------------------------------------------}
+const
+ IPPROTO_IP = 0;
+ IPPROTO_ICMP = 1;
+ IPPROTO_IGMP = 2;
+ IPPROTO_GGP = 3;
+ IPPROTO_TCP = 6;
+ IPPROTO_EGP = 8;
+ IPPROTO_PUP = 12;
+ IPPROTO_UDP = 17;
+ IPPROTO_IDP = 22;
+ IPPROTO_ND = 77;
+ IPPROTO_RAW = 255;
+ IPPROTO_MAX = 256;
+
+// Port/socket numbers: network standard functions
+ IPPORT_ECHO = 7;
+ IPPORT_DISCARD = 9;
+ IPPORT_SYSTAT = 11;
+ IPPORT_DAYTIME = 13;
+ IPPORT_NETSTAT = 15;
+ IPPORT_FTP = 21;
+ IPPORT_TELNET = 23;
+ IPPORT_SMTP = 25;
+ IPPORT_TIMESERVER = 37;
+ IPPORT_NAMESERVER = 42;
+ IPPORT_WHOIS = 43;
+ IPPORT_MTP = 57;
+
+// Port/socket numbers: host specific functions
+ IPPORT_TFTP = 69;
+ IPPORT_RJE = 77;
+ IPPORT_FINGER = 79;
+ IPPORT_TTYLINK = 87;
+ IPPORT_SUPDUP = 95;
+
+// UNIX TCP sockets
+ IPPORT_EXECSERVER = 512;
+ IPPORT_LOGINSERVER = 513;
+ IPPORT_CMDSERVER = 514;
+ IPPORT_EFSSERVER = 520;
+
+// UNIX UDP sockets
+ IPPORT_BIFFUDP = 512;
+ IPPORT_WHOSERVER = 513;
+{ 520+1 also used }
+ IPPORT_ROUTESERVER = 520;
+
+ IPPORT_RESERVED = 1024;
+ IPPORT_USERRESERVED = 5000;
+
+type
+ Pin_addr = ^Tin_addr;
+ Tin_addr = record
+ s_addr : dword;
+ end;
+
+const
+ IN_CLASSA_NET = $ff000000;
+ IN_CLASSA_NSHIFT = 24;
+ IN_CLASSA_HOST = $00ffffff;
+ IN_CLASSA_MAX = 128;
+ IN_CLASSB_NET = $ffff0000;
+ IN_CLASSB_NSHIFT = 16;
+ IN_CLASSB_HOST = $0000ffff;
+ IN_CLASSB_MAX = 65536;
+ IN_CLASSC_NET = $ffffff00;
+ IN_CLASSC_NSHIFT = 8;
+ IN_CLASSC_HOST = $000000ff;
+ IN_LOOPBACKNET = 127;
+
+// var sin_port : word;cvar;public;
+// sin_zero : array[0..7] of char;cvar;public;
+
+ const
+ IP_OPTIONS = 1;
+
+function ntohs(value:word):word;cdecl;external {'tcpip'} name 'ntohs';
+function htons(value:word):word;cdecl;external {'tcpip'} name 'htons';
+function ntohl(value:dword):dword;cdecl;external {'tcpip'} name 'ntohl';
+function htonl(value:dword):dword;cdecl;external {'tcpip'} name 'htonl';
+{------------------------------------------------------------------------------}
+
+implementation
+
+function t_error : longint;
+begin
+ t_error := __get_t_errno_ptr^;
+end;
+
+function OPTIONS_SIZE : longint;
+begin
+ OPTIONS_SIZE:=13 * (sizeof(longint));
+end;
+
+
+end.
+
+{
+ $Log: nwprot.pp,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/nwpsrv.imp b/rtl/netware/nwpsrv.imp
new file mode 100644
index 0000000000..9681929496
--- /dev/null
+++ b/rtl/netware/nwpsrv.imp
@@ -0,0 +1,384 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWPSRegisterLibraryClient,
+ NWPSDeRegisterLibraryClient,
+ NWPSJobScan,
+ NWPSJobWrite,
+ NWPSJobRead,
+ NWPSJobDelete,
+ NWPSJobGetDefault,
+ NWPSJobSetDefault,
+ NWPSPdfGetVersion,
+ NWPSPdfSetVersion,
+ NWPSPdfAddForm,
+ NWPSPdfDeleteForm,
+ NWPSPdfScanForm,
+ NWPSPdfReadForm,
+ NWPSPdfUpdateForm,
+ NWPSPdfAddDevice,
+ NWPSPdfDeleteDevice,
+ NWPSPdfScanDevice,
+ NWPSPdfReadDevice,
+ NWPSPdfUpdateDevice,
+ NWPSPdfAddMode,
+ NWPSPdfDeleteMode,
+ NWPSPdfScanMode,
+ NWPSPdfReadMode,
+ NWPSPdfUpdateMode,
+ NWPSPdfAddModeFunction,
+ NWPSPdfDeleteModeFunction,
+ NWPSPdfScanModeFunction,
+ NWPSPdfReadModeFunction,
+ NWPSPdfAddFunction,
+ NWPSPdfDeleteFunction,
+ NWPSPdfScanFunction,
+ NWPSPdfReadFunction,
+ NWPSPdfUpdateFunction,
+ NWPSCfgAddPrintServer,
+ NWPSCfgDeletePrintServer,
+ NWPSCfgScanPrintServer,
+ NWPSCfgAddPrintServerAttr,
+ NWPSCfgDeletePrintServerAttr,
+ NWPSCfgScanPrintServerAttr,
+ NWPSCfgAddNServer,
+ NWPSCfgDeleteNServer,
+ NWPSCfgScanNServer,
+ NWPSCfgAddPrinter,
+ NWPSCfgDeletePrinter,
+ NWPSCfgScanPrinter,
+ NWPSCfgAddPrinterAttr,
+ NWPSCfgDeletePrinterAttr,
+ NWPSCfgScanPrinterAttr,
+ NWPSCfgGetPrinterDefaults,
+ NWPSCfgAddPrintQueue,
+ NWPSCfgDeletePrintQueue,
+ NWPSCfgScanPrintQueue,
+ NWPSCfgAddPrintQueueAttr,
+ NWPSCfgDeletePrintQueueAttr,
+ NWPSCfgScanPrintQueueAttr,
+ NWPSCfgModifyPrintServerAttr,
+ NWPSCfgModifyPrintQueueAttr,
+ NWPSCfgModifyPrinterAttr,
+ NWPSCfgAttrNameToNumber,
+ NWPSCfgAttrNumberToName,
+ NWPSComAbortPrintJob,
+ NWPSComAddNotifyObject,
+ NWPSComAddQueueToPrinter,
+ NWPSComAttachPServerToNServer,
+ NWPSComAttachToPrintServer,
+ NWPSComCancelDownRequest,
+ NWPSComChangeNotifyInterval,
+ NWPSComChangeQueuePriority,
+ NWPSComChangeServiceMode,
+ NWPSComDeleteNotifyObject,
+ NWPSComDeleteQueueFromPrinter,
+ NWPSComDetachFromPrintServer,
+ NWPSComDetachPServerFromNServer,
+ NWPSComDownPrintServer,
+ NWPSComEjectForm,
+ NWPSComGetAttachedNServers,
+ NWPSComGetNextRemotePrinter,
+ NWPSComGetNotifyObject,
+ NWPSComGetPrintersServicingQ,
+ NWPSComGetPrinterStatus,
+ NWPSComGetPrintJobStatus,
+ NWPSComGetPrintServerInfo,
+ NWPSComGetQueuesServiced,
+ NWPSComLoginToPrintServer,
+ NWPSComMarkTopOfForm,
+ NWPSComRequestRemotePrinter,
+ NWPSComRewindPrintJob,
+ NWPSComSetMountedForm,
+ NWPSComSetRemoteMode,
+ NWPSComStartPrinter,
+ NWPSComStopPrinter,
+ NWPSPdfDebug,
+ NWPSJobInit,
+ NWPSJobSet,
+ NWPSPdfImportDevice,
+ NWPSPdfExportDevice,
+ NWPSPdfGetImportDate,
+ NWPSPdfSetImportDate,
+ NWPSComScanXNPs,
+ NWPSComGetExtPrinterStatus,
+ NWPSXNPRegister,
+ NWPSXNPDeregister,
+ NWPSXNPGetConfigInfo,
+ NWPSXNPSendStatus,
+ NWPSXNPCloseFile,
+ NWPSXNPOpenFile,
+ NWPSXNPReadFile,
+ NWPSXNPSeekFile,
+ NWPSXNPWriteFile,
+ NWPSXNPAcceptJob,
+ NWPSXNPCreateBanner,
+ NWPSXNPDeclineJobs,
+ NWPSXNPFinishJob,
+ NWPSXNPQuery,
+ NWPSApiConfigToFileConfig,
+ NWPSFileConfigToApiConfig,
+ NWPSComMountXNPForm,
+ NWPSComDismountXNPForm,
+ NWPSComAbortXNPJob,
+ NWPSComGetXNPJobStatus,
+ NWPSComRewindXNPJob,
+ NWPSCfgGetFirstPrinter,
+ NWPSCfgGetNextPrinter,
+ NWPSCfgEndNextPrinter,
+ NWPSCfgVerifyPrinter,
+ NWPSCfgGetFirstPrinterAttr,
+ NWPSCfgGetNextPrinterAttr,
+ NWPSCfgEndNextPrinterAttr,
+ NWPSCfgGetFirstPrintServer,
+ NWPSCfgGetNextPrintServer,
+ NWPSCfgEndNextPrintServer,
+ NWPSCfgVerifyPrintServer,
+ NWPSCfgGetFirstPrintQueue,
+ NWPSCfgGetNextPrintQueue,
+ NWPSCfgEndNextPrintQueue,
+ NWPSCfgVerifyPrintQueue,
+ NWPSCfgGetFirstPrintServerAttr,
+ NWPSCfgGetNextPrintServerAttr,
+ NWPSCfgEndNextPrintServerAttr,
+ NWPSCfgGetFirstPrintQueueAttr,
+ NWPSCfgGetNextPrintQueueAttr,
+ NWPSCfgEndNextPrintQueueAttr,
+ NWPSCfgGetFirstNServer,
+ NWPSCfgGetNextNServer,
+ NWPSCfgEndNextNServer,
+ NWPSCfgVerifyNServer,
+ NWPSPdfScanFunctionMode,
+ NWPSPdfLocateDBAndSetContext,
+ NWPSPdfDeleteDatabase,
+ NWPSJobDeleteDatabase,
+ NWPSJobGetFirstJob,
+ NWPSJobGetNextJob,
+ NWPSJobEndNextJob,
+ NWP0CfgAddPrintServer,
+ NWP0CfgDeletePrintServer,
+ NWP0CfgGetFirstPrintServer,
+ NWP0CfgGetNextPrintServer,
+ NWP0CfgEndNextPrintServer,
+ NWP0CfgVerifyPrintServer,
+ NWP0CfgAddPrintServerAttr,
+ NWP0CfgDeletePrintServerAttr,
+ NWP0CfgGetFirstPrintServerAttr,
+ NWP0CfgGetNextPrintServerAttr,
+ NWP0CfgEndNextPrintServerAttr,
+ NWP0CfgModifyPrintServerAttr,
+ NWP0CfgAddNServer,
+ NWP0CfgDeleteNServer,
+ NWP0CfgAddPrinter,
+ NWP0CfgDeletePrinter,
+ NWP0CfgGetFirstPrinter,
+ NWP0CfgGetNextPrinter,
+ NWP0CfgEndNextPrinter,
+ NWP0CfgVerifyPrinter,
+ NWP0CfgAddPrinterAttr,
+ NWP0CfgDeletePrinterAttr,
+ NWP0CfgGetFirstPrinterAttr,
+ NWP0CfgGetNextPrinterAttr,
+ NWP0CfgEndNextPrinterAttr,
+ NWP0CfgModifyPrinterAttr,
+ NWP0CfgAddPrintQueue,
+ NWP0CfgDeletePrintQueue,
+ NWP0CfgGetFirstPrintQueue,
+ NWP0CfgGetNextPrintQueue,
+ NWP0CfgEndNextPrintQueue,
+ NWP0CfgVerifyPrintQueue,
+ NWP0CfgAddPrintQueueAttr,
+ NWP0CfgDeletePrintQueueAttr,
+ NWP0CfgGetFirstPrintQueueAttr,
+ NWP0CfgGetNextPrintQueueAttr,
+ NWP0CfgEndNextPrintQueueAttr,
+ NWP0CfgModifyPrintQueueAttr,
+ NWP0ComAttachToPrintServer,
+ NWP0ComLoginToPrintServer,
+ NWP0JobGetFirstJob,
+ NWP0JobGetNextJob,
+ NWP0JobWrite,
+ NWP0JobRead,
+ NWP0JobDelete,
+ NWP0JobGetDefault,
+ NWP0JobSetDefault,
+ NWP0PdfGetVersion,
+ NWP0PdfSetVersion,
+ NWP0PdfAddForm,
+ NWP0PdfDeleteForm,
+ NWP0PdfScanForm,
+ NWP0PdfReadForm,
+ NWP0PdfUpdateForm,
+ NWP0PdfAddDevice,
+ NWP0PdfDeleteDevice,
+ NWP0PdfScanDevice,
+ NWP0PdfReadDevice,
+ NWP0PdfUpdateDevice,
+ NWP0PdfAddMode,
+ NWP0PdfDeleteMode,
+ NWP0PdfScanMode,
+ NWP0PdfReadMode,
+ NWP0PdfUpdateMode,
+ NWP0PdfAddModeFunction,
+ NWP0PdfDeleteModeFunction,
+ NWP0PdfScanModeFunction,
+ NWP0PdfScanFunctionMode,
+ NWP0PdfReadModeFunction,
+ NWP0PdfAddFunction,
+ NWP0PdfDeleteFunction,
+ NWP0PdfScanFunction,
+ NWP0PdfReadFunction,
+ NWP0PdfUpdateFunction,
+ NWP0PdfManagedImportDevice,
+ NWP0PdfExportDevice,
+ NWP0PdfDeleteDatabase,
+ NWP1CfgAddPrintServer,
+ NWP1CfgDeletePrintServer,
+ NWP1CfgGetFirstPrintServer,
+ NWP1CfgGetNextPrintServer,
+ NWP1CfgEndNextPrintServer,
+ NWP1CfgVerifyPrintServer,
+ NWP1CfgAddPrintServerAttr,
+ NWP1CfgDeletePrintServerAttr,
+ NWP1CfgGetFirstPrintServerAttr,
+ NWP1CfgGetNextPrintServerAttr,
+ NWP1CfgEndNextPrintServerAttr,
+ NWP1CfgModifyPrintServerAttr,
+ NWP1CfgAddPrinter,
+ NWP1CfgDeletePrinter,
+ NWP1CfgGetFirstPrinter,
+ NWP1CfgGetNextPrinter,
+ NWP1CfgEndNextPrinter,
+ NWP1CfgVerifyPrinter,
+ NWP1CfgAddPrinterAttr,
+ NWP1CfgDeletePrinterAttr,
+ NWP1CfgGetFirstPrinterAttr,
+ NWP1CfgGetNextPrinterAttr,
+ NWP1CfgEndNextPrinterAttr,
+ NWP1CfgModifyPrinterAttr,
+ NWP1CfgAddPrintQueue,
+ NWP1CfgDeletePrintQueue,
+ NWP1CfgGetFirstPrintQueue,
+ NWP1CfgGetNextPrintQueue,
+ NWP1CfgEndNextPrintQueue,
+ NWP1CfgVerifyPrintQueue,
+ NWP1CfgAddPrintQueueAttr,
+ NWP1CfgDeletePrintQueueAttr,
+ NWP1CfgGetFirstPrintQueueAttr,
+ NWP1CfgGetNextPrintQueueAttr,
+ NWP1CfgEndNextPrintQueueAttr,
+ NWP1CfgModifyPrintQueueAttr,
+ NWP1ComAttachToPrintServer,
+ NWP1ComLoginToPrintServer,
+ NWP1JobGetNextJob,
+ NWP1JobGetFirstJob,
+ NWP1JobWrite,
+ NWP1JobRead,
+ NWP1JobDelete,
+ NWP1JobGetDefault,
+ NWP1JobSetDefault,
+ NWP1JobDeleteDatabase,
+ NWP1PdfGetVersion,
+ NWP1PdfSetVersion,
+ NWP1PdfAddForm,
+ NWP1PdfDeleteForm,
+ NWP1PdfScanForm,
+ NWP1PdfReadForm,
+ NWP1PdfUpdateForm,
+ NWP1PdfAddDevice,
+ NWP1PdfDeleteDevice,
+ NWP1PdfScanDevice,
+ NWP1PdfReadDevice,
+ NWP1PdfUpdateDevice,
+ NWP1PdfAddMode,
+ NWP1PdfDeleteMode,
+ NWP1PdfScanMode,
+ NWP1PdfReadMode,
+ NWP1PdfUpdateMode,
+ NWP1PdfAddModeFunction,
+ NWP1PdfDeleteModeFunction,
+ NWP1PdfScanModeFunction,
+ NWP1PdfScanFunctionMode,
+ NWP1PdfReadModeFunction,
+ NWP1PdfAddFunction,
+ NWP1PdfDeleteFunction,
+ NWP1PdfScanFunction,
+ NWP1PdfReadFunction,
+ NWP1PdfUpdateFunction,
+ NWP1PdfExportDevice,
+ NWP1PdfDeleteDatabase,
+ NWP1PdfManagedImportDevice,
+ NWPSPdfManagedImportDevice,
+ NWPSComPrintServerRequest,
+ NWP2JobGetFirstJob,
+ NWP2JobGetNextJob,
+ NWP2JobWrite,
+ NWP2JobRead,
+ NWP2JobDelete,
+ NWP2JobGetDefault,
+ NWP2JobSetDefault,
+ NWP2PdfAddForm,
+ NWP2PdfScanForm,
+ NWP2PdfReadForm,
+ NWP2PdfAddDevice,
+ NWP2PdfScanDevice,
+ NWP2PdfReadDevice,
+ NWP2PdfAddMode,
+ NWP2PdfScanMode,
+ NWP2PdfReadMode,
+ NWP2PdfAddModeFunction,
+ NWP2PdfScanModeFunction,
+ NWP2PdfScanFunctionMode,
+ NWP2PdfReadModeFunction,
+ NWP2PdfAddFunction,
+ NWP2PdfScanFunction,
+ NWP2PdfReadFunction,
+ NWP2PdfExportDevice,
+ NWP2PdfManagedImportDevice,
+ NWPSGetLibraryVersion,
+ NWPSPdfEndNext,
+ NWPSPdfGetFirstForm,
+ NWPSPdfGetNextForm,
+ NWPSPdfGetFirstDevice,
+ NWPSPdfGetNextDevice,
+ NWPSPdfGetFirstMode,
+ NWPSPdfGetNextMode,
+ NWPSPdfGetFirstModeFunction,
+ NWPSPdfGetNextModeFunction,
+ NWPSPdfGetFirstFunction,
+ NWPSPdfGetNextFunction,
+ NWP0PdfGetFirstForm,
+ NWP0PdfGetNextForm,
+ NWP0PdfGetFirstDevice,
+ NWP0PdfGetNextDevice,
+ NWP0PdfGetFirstMode,
+ NWP0PdfGetNextMode,
+ NWP0PdfGetFirstModeFunction,
+ NWP0PdfGetNextModeFunction,
+ NWP0PdfGetFirstFunction,
+ NWP0PdfGetNextFunction,
+ NWP1PdfGetFirstForm,
+ NWP1PdfGetNextForm,
+ NWP1PdfGetFirstDevice,
+ NWP1PdfGetNextDevice,
+ NWP1PdfGetFirstMode,
+ NWP1PdfGetNextMode,
+ NWP1PdfGetFirstModeFunction,
+ NWP1PdfGetNextModeFunction,
+ NWP1PdfGetFirstFunction,
+ NWP1PdfGetNextFunction,
+ NWP2PdfGetFirstForm,
+ NWP2PdfGetNextForm,
+ NWP2PdfGetFirstDevice,
+ NWP2PdfGetNextDevice,
+ NWP2PdfGetFirstMode,
+ NWP2PdfGetNextMode,
+ NWP2PdfGetFirstModeFunction,
+ NWP2PdfGetNextModeFunction,
+ NWP2PdfGetFirstFunction,
+ NWP2PdfGetNextFunction,
+ NWPSJobGetDatabaseVersion,
+ NWP0JobGetDatabaseVersion,
+ NWP1JobGetDatabaseVersion,
+ NWP2JobGetDatabaseVersion,
+ NWPSFindNextPeriodInDSName
+
diff --git a/rtl/netware/nwpsrv3x.imp b/rtl/netware/nwpsrv3x.imp
new file mode 100644
index 0000000000..efd5c37c9c
--- /dev/null
+++ b/rtl/netware/nwpsrv3x.imp
@@ -0,0 +1,250 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWPSRegisterLibraryClient,
+ NWPSDeRegisterLibraryClient,
+ NWPSJobScan,
+ NWPSJobWrite,
+ NWPSJobRead,
+ NWPSJobDelete,
+ NWPSJobGetDefault,
+ NWPSJobSetDefault,
+ NWPSPdfGetVersion,
+ NWPSPdfSetVersion,
+ NWPSPdfAddForm,
+ NWPSPdfDeleteForm,
+ NWPSPdfScanForm,
+ NWPSPdfReadForm,
+ NWPSPdfUpdateForm,
+ NWPSPdfAddDevice,
+ NWPSPdfDeleteDevice,
+ NWPSPdfScanDevice,
+ NWPSPdfReadDevice,
+ NWPSPdfUpdateDevice,
+ NWPSPdfAddMode,
+ NWPSPdfDeleteMode,
+ NWPSPdfScanMode,
+ NWPSPdfReadMode,
+ NWPSPdfUpdateMode,
+ NWPSPdfAddModeFunction,
+ NWPSPdfDeleteModeFunction,
+ NWPSPdfScanModeFunction,
+ NWPSPdfReadModeFunction,
+ NWPSPdfAddFunction,
+ NWPSPdfDeleteFunction,
+ NWPSPdfScanFunction,
+ NWPSPdfReadFunction,
+ NWPSPdfUpdateFunction,
+ NWPSCfgAddNServer,
+ NWPSCfgDeleteNServer,
+ NWPSCfgGetPrinterDefaults,
+ NWPSCfgAttrNameToNumber,
+ NWPSCfgAttrNumberToName,
+ NWPSComAbortPrintJob,
+ NWPSComAddNotifyObject,
+ NWPSComAddQueueToPrinter,
+ NWPSComAttachPServerToNServer,
+ NWPSComCancelDownRequest,
+ NWPSComChangeNotifyInterval,
+ NWPSComChangeQueuePriority,
+ NWPSComChangeServiceMode,
+ NWPSComDeleteNotifyObject,
+ NWPSComDeleteQueueFromPrinter,
+ NWPSComDetachFromPrintServer,
+ NWPSComDetachPServerFromNServer,
+ NWPSComDownPrintServer,
+ NWPSComEjectForm,
+ NWPSComGetAttachedNServers,
+ NWPSComGetNextRemotePrinter,
+ NWPSComGetNotifyObject,
+ NWPSComGetPrintersServicingQ,
+ NWPSComGetPrinterStatus,
+ NWPSComGetPrintJobStatus,
+ NWPSComGetPrintServerInfo,
+ NWPSComGetQueuesServiced,
+ NWPSComMarkTopOfForm,
+ NWPSComRequestRemotePrinter,
+ NWPSComRewindPrintJob,
+ NWPSComSetMountedForm,
+ NWPSComSetRemoteMode,
+ NWPSComStartPrinter,
+ NWPSComStopPrinter,
+ NWPSPdfDebug,
+ NWPSJobInit,
+ NWPSJobSet,
+ NWPSPdfImportDevice,
+ NWPSPdfExportDevice,
+ NWPSPdfGetImportDate,
+ NWPSPdfSetImportDate,
+ NWPSComScanXNPs,
+ NWPSComGetExtPrinterStatus,
+ NWPSXNPRegister,
+ NWPSXNPDeregister,
+ NWPSXNPGetConfigInfo,
+ NWPSXNPSendStatus,
+ NWPSXNPCloseFile,
+ NWPSXNPOpenFile,
+ NWPSXNPReadFile,
+ NWPSXNPSeekFile,
+ NWPSXNPWriteFile,
+ NWPSXNPAcceptJob,
+ NWPSXNPCreateBanner,
+ NWPSXNPDeclineJobs,
+ NWPSXNPFinishJob,
+ NWPSXNPQuery,
+ NWPSApiConfigToFileConfig,
+ NWPSFileConfigToApiConfig,
+ NWPSComMountXNPForm,
+ NWPSComDismountXNPForm,
+ NWPSComAbortXNPJob,
+ NWPSComGetXNPJobStatus,
+ NWPSComRewindXNPJob,
+ NWPSCfgGetFirstNServer,
+ NWPSCfgGetNextNServer,
+ NWPSCfgEndNextNServer,
+ NWPSCfgVerifyNServer,
+ NWPSPdfScanFunctionMode,
+ NWPSPdfDeleteDatabase,
+ NWPSJobDeleteDatabase,
+ NWPSJobGetFirstJob,
+ NWPSJobGetNextJob,
+ NWPSJobEndNextJob,
+ NWP0CfgAddPrintServer,
+ NWP0CfgDeletePrintServer,
+ NWP0CfgGetFirstPrintServer,
+ NWP0CfgGetNextPrintServer,
+ NWP0CfgEndNextPrintServer,
+ NWP0CfgVerifyPrintServer,
+ NWP0CfgAddPrintServerAttr,
+ NWP0CfgDeletePrintServerAttr,
+ NWP0CfgGetFirstPrintServerAttr,
+ NWP0CfgGetNextPrintServerAttr,
+ NWP0CfgEndNextPrintServerAttr,
+ NWP0CfgModifyPrintServerAttr,
+ NWP0CfgAddNServer,
+ NWP0CfgDeleteNServer,
+ NWP0CfgAddPrinter,
+ NWP0CfgDeletePrinter,
+ NWP0CfgGetFirstPrinter,
+ NWP0CfgGetNextPrinter,
+ NWP0CfgEndNextPrinter,
+ NWP0CfgVerifyPrinter,
+ NWP0CfgAddPrinterAttr,
+ NWP0CfgDeletePrinterAttr,
+ NWP0CfgGetFirstPrinterAttr,
+ NWP0CfgGetNextPrinterAttr,
+ NWP0CfgEndNextPrinterAttr,
+ NWP0CfgModifyPrinterAttr,
+ NWP0CfgAddPrintQueue,
+ NWP0CfgDeletePrintQueue,
+ NWP0CfgGetFirstPrintQueue,
+ NWP0CfgGetNextPrintQueue,
+ NWP0CfgEndNextPrintQueue,
+ NWP0CfgVerifyPrintQueue,
+ NWP0CfgAddPrintQueueAttr,
+ NWP0CfgDeletePrintQueueAttr,
+ NWP0CfgGetFirstPrintQueueAttr,
+ NWP0CfgGetNextPrintQueueAttr,
+ NWP0CfgEndNextPrintQueueAttr,
+ NWP0CfgModifyPrintQueueAttr,
+ NWP0ComAttachToPrintServer,
+ NWP0ComLoginToPrintServer,
+ NWP0JobGetFirstJob,
+ NWP0JobGetNextJob,
+ NWP0JobWrite,
+ NWP0JobRead,
+ NWP0JobDelete,
+ NWP0JobGetDefault,
+ NWP0JobSetDefault,
+ NWP0PdfGetVersion,
+ NWP0PdfSetVersion,
+ NWP0PdfAddForm,
+ NWP0PdfDeleteForm,
+ NWP0PdfScanForm,
+ NWP0PdfReadForm,
+ NWP0PdfUpdateForm,
+ NWP0PdfAddDevice,
+ NWP0PdfDeleteDevice,
+ NWP0PdfScanDevice,
+ NWP0PdfReadDevice,
+ NWP0PdfUpdateDevice,
+ NWP0PdfAddMode,
+ NWP0PdfDeleteMode,
+ NWP0PdfScanMode,
+ NWP0PdfReadMode,
+ NWP0PdfUpdateMode,
+ NWP0PdfAddModeFunction,
+ NWP0PdfDeleteModeFunction,
+ NWP0PdfScanModeFunction,
+ NWP0PdfScanFunctionMode,
+ NWP0PdfReadModeFunction,
+ NWP0PdfAddFunction,
+ NWP0PdfDeleteFunction,
+ NWP0PdfScanFunction,
+ NWP0PdfReadFunction,
+ NWP0PdfUpdateFunction,
+ NWP0PdfManagedImportDevice,
+ NWP0PdfExportDevice,
+ NWP0PdfDeleteDatabase,
+ NWPSPdfManagedImportDevice,
+ NWPSComPrintServerRequest,
+ NWP2JobGetFirstJob,
+ NWP2JobGetNextJob,
+ NWP2JobWrite,
+ NWP2JobRead,
+ NWP2JobDelete,
+ NWP2JobGetDefault,
+ NWP2JobSetDefault,
+ NWP2PdfAddForm,
+ NWP2PdfScanForm,
+ NWP2PdfReadForm,
+ NWP2PdfAddDevice,
+ NWP2PdfScanDevice,
+ NWP2PdfReadDevice,
+ NWP2PdfAddMode,
+ NWP2PdfScanMode,
+ NWP2PdfReadMode,
+ NWP2PdfAddModeFunction,
+ NWP2PdfScanModeFunction,
+ NWP2PdfScanFunctionMode,
+ NWP2PdfReadModeFunction,
+ NWP2PdfAddFunction,
+ NWP2PdfScanFunction,
+ NWP2PdfReadFunction,
+ NWP2PdfExportDevice,
+ NWP2PdfManagedImportDevice,
+ NWPSGetLibraryVersion,
+ NWPSPdfEndNext,
+ NWPSPdfGetFirstForm,
+ NWPSPdfGetNextForm,
+ NWPSPdfGetFirstDevice,
+ NWPSPdfGetNextDevice,
+ NWPSPdfGetFirstMode,
+ NWPSPdfGetNextMode,
+ NWPSPdfGetFirstModeFunction,
+ NWPSPdfGetNextModeFunction,
+ NWPSPdfGetFirstFunction,
+ NWPSPdfGetNextFunction,
+ NWP0PdfGetFirstForm,
+ NWP0PdfGetNextForm,
+ NWP0PdfGetFirstDevice,
+ NWP0PdfGetNextDevice,
+ NWP0PdfGetFirstMode,
+ NWP0PdfGetNextMode,
+ NWP0PdfGetFirstModeFunction,
+ NWP0PdfGetNextModeFunction,
+ NWP0PdfGetFirstFunction,
+ NWP0PdfGetNextFunction,
+ NWP2PdfGetFirstForm,
+ NWP2PdfGetNextForm,
+ NWP2PdfGetFirstDevice,
+ NWP2PdfGetNextDevice,
+ NWP2PdfGetFirstMode,
+ NWP2PdfGetNextMode,
+ NWP2PdfGetFirstModeFunction,
+ NWP2PdfGetNextModeFunction,
+ NWP2PdfGetFirstFunction,
+ NWP2PdfGetNextFunction,
+ NWPSJobGetDatabaseVersion,
+ NWP0JobGetDatabaseVersion,
+ NWP2JobGetDatabaseVersion
+
diff --git a/rtl/netware/nwserv.pp b/rtl/netware/nwserv.pp
new file mode 100644
index 0000000000..26995ca2b4
--- /dev/null
+++ b/rtl/netware/nwserv.pp
@@ -0,0 +1,5395 @@
+{ $Id: nwserv.pp,v 1.8 2005/02/14 17:13:30 peter Exp $
+
+ Netware Server Imports for FreePascal, contains definition from the
+ following header files:
+
+ string.h dirent.h errno.h fcntl.h limits.h locale.h nwaudnlm.h
+ nwbitops.h nwcntask.h nwconio.h nwconn.h nwdebug.h nwdfs.h nwdos.h
+ nwerrno.h nwfattr.h nwfileio.h nwfileng.h nwfinfo.h nwfshook.h
+ nwipx.h nwlib.h nwlocale.h nwmalloc.h nwncpx.h nwnspace.h nwproc.h
+ nwsemaph.h nwserv.h nwsignal.h nwstring.h nwtoolib.h stdio.h stdlib.h
+ unistd.h time.h utime.h nwthread.h nwmediam.h ioctl.h
+ sys/socket.h sys/time.h sys/filio.h syys/ioctl.h sys/stat.h
+ sys/time.h sys/timeval.h sys/uio.h sys/utsname.h
+
+ Initial Version 2002/02/22 Armin (diehl@nordrhein.de)
+
+ The C-NDK and Documentation can be found here:
+ http://developer.novell.com
+
+ This program is distributed in the hope that it will be useful,but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE.
+
+ Do not blame Novell if there are errors in this file, instead
+ contact me and i will se what i can do.
+
+}
+
+unit nwserv;
+
+interface
+
+{$mode objfpc}
+
+const NULL = 0;
+ ThreadsNlm = 'threads';
+ Lib0Nlm = 'lib0';
+ NlmLibNlm = 'nlmlib';
+ FIONREAD = 1; // get count of bytes to read (readable)
+ FIONBIO = 2; // set/clear nonblocking I/O
+ FIOGETNBIO = 3; // get nonblocking I/O status
+
+type
+ Psize_t = ^Tsize_t;
+ Tsize_t = dword;
+ PPChar = ^PChar;
+ PPPChar= ^PPChar;
+ Tsigset_t = longint;
+ TNlmHandle = longint;
+
+const
+ NullNlmHandle = 0;
+
+{-time.h-----------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+const
+ CLOCKS_PER_SEC = 100;
+
+type
+ Pclock_t = ^Tclock_t;
+ Tclock_t = dword;
+
+ Ptime_t = ^Ttime_t;
+ Ttime_t = dword;
+ Ptm = ^Ttm;
+ Ttm = record
+ tm_sec : longint; { seconds after the minute--range [0, 59] }
+ tm_min : longint; { minutes after the hour--range [0, 59] }
+ tm_hour : longint; { hours since midnight--range [0, 23] }
+ tm_mday : longint; { days of the month--range [1, 31] }
+ tm_mon : longint; { months since January--range [0, 11] }
+ tm_year : longint; { years since 1900--range [0, 99] }
+ tm_wday : longint; { days since Sunday--range [0, 6] }
+ tm_yday : longint; { days since first of January--range [0, 365] }
+ tm_isdst : longint; { Daylight Savings Time flag--set [-, 0, +]: }
+ end;
+
+{ ISO/ANSI C functions... }
+function asctime(para1:Ptm):Pchar;cdecl;external 'clib' name 'asctime';
+function clock:Tclock_t;cdecl;external 'clib' name 'clock';
+function ctime(para1:Ptime_t):Pchar;cdecl;external 'clib' name 'ctime';
+function difftime(para1:Ttime_t; para2:Ttime_t):double;cdecl;external 'clib' name 'difftime';
+function gmtime(para1:Ptime_t):Ptm;cdecl;external 'clib' name 'gmtime';
+function localtime(para1:Ptime_t):Ptm;cdecl;external 'clib' name 'localtime';
+function mktime(para1:Ptm):Ttime_t;cdecl;external 'clib' name 'mktime';
+function strftime(para1:Pchar; para2:Tsize_t; para3:Pchar; para4:Ptm):Tsize_t;cdecl;external 'clib' name 'strftime';
+function time(para1:Ptime_t):Ttime_t;cdecl;external 'clib' name 'time';
+{ POSIX data and functions... }
+{ For extern char tzname[2], see macro below }
+procedure tzset;cdecl;external 'clib' name 'tzset';
+function __get_CLK_TCK:Tclock_t;cdecl;external 'clib' name '__get_CLK_TCK';
+function __get_tzname:pPchar;cdecl;external 'clib' name '__get_tzname';
+{ POSIX-defined additions ... }
+function asctime_r(para1:Ptm; para2:Pchar):Pchar;cdecl;external 'clib' name 'asctime_r';
+function ctime_r(para1:Ptime_t; para2:Pchar):Pchar;cdecl;external 'clib' name 'ctime_r';
+function gmtime_r(para1:Ptime_t; para2:Ptm):Ptm;cdecl;external 'clib' name 'gmtime_r';
+function localtime_r(para1:Ptime_t; para2:Ptm):Ptm;cdecl;external 'clib' name 'localtime_r';
+function CLK_TCK : longint;
+function tzname : pchar;
+
+{-utime.h----------------------------------------------------------------------}
+type
+ Putimbuf = ^Tutimbuf;
+ Tutimbuf = record
+ actime : Ttime_t; // access time
+ modtime : Ttime_t; // modification time
+ end;
+
+
+function utime(path:Pchar; times:Putimbuf):longint;cdecl;external 'clib' name 'utime';
+function utime(path:Pchar; var times:Tutimbuf):longint;cdecl;external 'clib' name 'utime';
+
+{-string.h---------------------------------------------------------------------}
+function memchr(para1:pointer; para2:longint; para3:Tsize_t):pointer;cdecl;external 'clib' name 'memchr';
+function memcmp(para1:pointer; para2:pointer; para3:Tsize_t):longint;cdecl;external 'clib' name 'memcmp';
+function memcpy(para1:pointer; para2:pointer; para3:Tsize_t):pointer;cdecl;external 'clib' name 'memcpy';
+function memmove(para1:pointer; para2:pointer; para3:Tsize_t):pointer;cdecl;external 'clib' name 'memmove';
+function memset(para1:pointer; para2:longint; para3:Tsize_t):pointer;cdecl;external 'clib' name 'memset';
+function strcpy(para1:Pchar; para2:Pchar):Pchar;cdecl;external 'clib' name 'strcpy';
+function strcat(para1:Pchar; para2:Pchar):Pchar;cdecl;external 'clib' name 'strcat';
+function strchr(para1:Pchar; para2:longint):Pchar;cdecl;external 'clib' name 'strchr';
+function strcmp(para1:Pchar; para2:Pchar):longint;cdecl;external 'clib' name 'strcmp';
+function strcoll(para1:Pchar; para2:Pchar):longint;cdecl;external 'clib' name 'strcoll';
+function strcspn(para1:Pchar; para2:Pchar):Tsize_t;cdecl;external 'clib' name 'strcspn';
+function strerror(para1:longint):Pchar;cdecl;external 'clib' name 'strerror';
+function strlen(para1:Pchar):Tsize_t;cdecl;external 'clib' name 'strlen';
+function strncat(para1:Pchar; para2:Pchar; para3:Tsize_t):Pchar;cdecl;external 'clib' name 'strncat';
+function strncmp(para1:Pchar; para2:Pchar; para3:Tsize_t):longint;cdecl;external 'clib' name 'strncmp';
+function strncpy(para1:Pchar; para2:Pchar; para3:Tsize_t):Pchar;cdecl;external 'clib' name 'strncpy';
+function strpbrk(para1:Pchar; para2:Pchar):Pchar;cdecl;external 'clib' name 'strpbrk';
+function strrchr(para1:Pchar; para2:longint):Pchar;cdecl;external 'clib' name 'strrchr';
+function strspn(para1:Pchar; para2:Pchar):Tsize_t;cdecl;external 'clib' name 'strspn';
+function strstr(para1:Pchar; para2:Pchar):Pchar;cdecl;external 'clib' name 'strstr';
+function strtok(para1:Pchar; para2:Pchar):Pchar;cdecl;external 'clib' name 'strtok';
+function strxfrm(para1:Pchar; para2:Pchar; para3:Tsize_t):Tsize_t;cdecl;external 'clib' name 'strxfrm';
+function strtok_r(para1:Pchar; para2:Pchar; para3:PPchar):Pchar;cdecl;external 'clib' name 'strtok_r';
+function memicmp(para1:pointer; para2:pointer; para3:Tsize_t):longint;cdecl;external 'clib' name 'memicmp';
+function strcmpi(para1:Pchar; para2:Pchar):longint;cdecl;external 'clib' name 'strcmpi';
+function stricmp(para1:Pchar; para2:Pchar):longint;cdecl;external 'clib' name 'stricmp';
+function strdup(para1:Pchar):Pchar;cdecl;external 'clib' name 'strdup';
+function strlist(para1,para2:Pchar; args:array of const):Pchar;cdecl;external 'clib' name 'strlist';
+function strlist(para1,para2:Pchar):Pchar;cdecl;external 'clib' name 'strlist';
+function strlwr(para1:Pchar):Pchar;cdecl;external 'clib' name 'strlwr';
+function strnicmp(para1,para2:Pchar; para3:Tsize_t):longint;cdecl;external 'clib' name 'strnicmp';
+function strnset(para1:Pchar; para2:longint; para3:Tsize_t):Pchar;cdecl;external 'clib' name 'strnset';
+function strrev(para1:Pchar):Pchar;cdecl;external 'clib' name 'strrev';
+function strset(para1:Pchar; para2:longint):Pchar;cdecl;external 'clib' name 'strset';
+function strupr(para1:Pchar):Pchar;cdecl;external 'clib' name 'strupr';
+procedure swab(para1:pointer; para2:pointer; para3:Tsize_t);cdecl;external 'clib' name 'swab';
+procedure swaw(para1:pointer; para2:pointer; para3:Tsize_t);cdecl;external 'clib' name 'swaw';
+{-dirent.h---------------------------------------------------------------------}
+{$I npackon.inc}
+type
+ Pino_t = ^Tino_t;
+ Tino_t = longint;
+ Pdev_t = ^Tdev_t;
+ Tdev_t = longint;
+ Pdirent = ^Tdirent;
+ Tdirent =
+ record
+ d_attr : dword;
+ d_time : word;
+ d_date : word;
+ d_size : longint;
+ d_ino : Tino_t;
+ d_dev : Tdev_t;
+ d_cdatetime : dword;
+ d_adatetime : dword;
+ d_bdatetime : dword;
+ d_uid : longint;
+ d_archivedID : dword;
+ d_updatedID : dword;
+ d_nameDOS : array[0..12] of char;
+ d_inheritedRightsMask : word;
+ d_originatingNameSpace : byte;
+ d_ddatetime : dword;
+ d_deletedID : dword;
+ d_name : array[0..255] of char;
+ end;
+ TDIR = Tdirent;
+ PDIR = ^TDIR;
+{$I npackoff.inc}
+
+function closedir_old (dirp:PDIR):longint; cdecl; external 'clib' name 'closedir';
+function closedir (dirp:PDIR):longint; cdecl; external 'clib' name 'closedir_510';
+function opendir_old (pathName:Pchar):PDIR; cdecl; external 'clib' name 'opendir';
+function opendir (pathName:Pchar):PDIR; cdecl; external 'clib' name 'opendir_411';
+function readdir_old (dirp:PDIR):PDIR; cdecl; external 'clib' name 'readdir';
+function readdir (dirp:PDIR):PDIR; cdecl; external 'clib' name 'readdir_411';
+procedure rewinddir (dirp:PDIR); cdecl; external 'clib' name 'rewinddir';
+function SetReaddirAttribute(dirp:PDIR; newAttribute:dword):longint; cdecl; external 'clib' name 'SetReaddirAttribute';
+{-errno.h----------------------------------------------------------------------}
+const
+ ENOENT = 1;
+ E2BIG = 2;
+ ENOEXEC = 3;
+ EBADF = 4;
+ ENOMEM = 5;
+ EACCES = 6;
+ EEXIST = 7;
+ EXDEV = 8;
+ EINVAL = 9;
+ ENFILE = 10;
+ EMFILE = 11;
+ ENOSPC = 12;
+ EDOM = 13;
+ ERANGE = 14;
+ EDEADLK = 15;
+ EINUSE = 16;
+ ESERVER = 17;
+ ENOSERVR = 18;
+ EWRNGKND = 19;
+ ETRNREST = 20;
+ ERESOURCE= 21;
+ EBADHNDL = 22;
+ ENO_SCRNS= 23;
+ EAGAIN = 24;
+ ENXIO = 25;
+ EBADMSG = 26;
+ EFAULT = 27;
+ EIO = 28;
+ ENODATA = 29;
+ ENOSTRMS = 30;
+ EPROTO = 31;
+ EPIPE = 32;
+ ESPIPE = 33;
+ ETIME = 34;
+ EWOULDBLOCK = 35;
+ EINPROGRESS = 36;
+ EALREADY = 37;
+ ENOTSOCK = 38;
+ EDESTADDRREQ = 39;
+ EMSGSIZE = 40;
+ EPROTOTYPE = 41;
+ ENOPROTOOPT = 42;
+ EPROTONOSUPPORT = 43;
+ ESOCKTNOSUPPORT = 44;
+ EOPNOTSUPP = 45;
+ EPFNOSUPPORT = 46;
+ EAFNOSUPPORT = 47;
+ EADDRINUSE = 48;
+ EADDRNOTAVAIL = 49;
+ ENETDOWN = 50;
+ ENETUNREACH = 51;
+ ENETRESET = 52;
+ ECONNABORTED = 53;
+ ECONNRESET = 54;
+ ENOBUFS = 55;
+ EISCONN = 56;
+ ENOTCONN = 57;
+ ESHUTDOWN = 58;
+ ETOOMANYREFS = 59;
+ ETIMEDOUT = 60;
+ ECONNREFUSED = 61;
+
+ EBUSY = 62;
+ EINTR = 63;
+ EISDIR = 64;
+ ENAMETOOLONG = 65;
+ ENOSYS = 66;
+ ENOTDIR = 67;
+ ENOTEMPTY = 68;
+ EPERM = 69;
+ ECHILD = 70;
+ EFBIG = 71;
+ EMLINK = 72;
+ ENODEV = 73;
+ ENOLCK = 74;
+ ENOTTY = 75;
+ EFTYPE = ENOTTY;
+ EROFS = 76;
+ ESRCH = 77;
+ ECANCELED = 78;
+ ENOTSUP = 79;
+
+ // CLib-implementation-specific constants
+ ECANCELLED = ECANCELED;
+ ENLMDATA = 100;
+ EILSEQ = 101;
+ EINCONSIS = 102;
+ EDOSTEXTEOL = 103;
+ ENONEXTANT = 104;
+ ENOCONTEXT = 105;
+ ELASTERR = ENOCONTEXT;
+{-nwerrno.h--------------------------------------------------------------------}
+{ Multi purpose return values.}
+const
+ ESUCCESS = 0;
+ EFAILURE = -(1);
+ ERR_TTS_NOT_AVAILABLE = $00;
+ ERR_RECORD_NOT_LOCKED = $01;
+ ERR_INSUFFICIENT_SPACE = $01;
+ ERR_STRING_EXCEEDS_LENGTH = $01;
+ ERR_TTS_AVAILABLE = $01;
+ ERR_NOT_AVAILABLE_PROTECTED = $64;
+ ERR_NOT_AVAILABLE_ON_3X = $65;
+ ERR_BAD_THREAD_ID = $66;
+ ERR_BAD_PRTY_CLASS = $67;
+ ERR_BAD_PRTY_SCOPE = $68;
+ ERR_NOT_A_POPUP_SCREEN = $69;
+ ERR_OPEN_SCREEN = $6A;
+ ERR_BAD_SHFLAG = $6B;
+ ERR_BAD_ACCESS = $6C;
+ ERR_BAD_ORIGIN = $6D;
+ ERR_BAD_ACTION_CODE = $6E;
+ ERR_OUT_OF_TASKS = $6F;
+ ERR_BAD_QUERY_TYPE = $70;
+ ERR_BAD_LIBRARY_HANDLE = $71;
+ ERR_STREAMS = $72;
+ ERR_BAD_FILE_SERVER_ID = $73;
+ ERR_BAD_CONNECTION_ID = $73;
+ ERR_BAD_FLAGS = $74;
+ ERR_STRUCT_NOT_FOUND = $C8;
+ ERR_NO_ITEMS_FOUND = $79;
+ ERR_NCPEXT_TRANSPORT_PROTOCOL_VIOLATION = $7E;
+ ERR_FILE_IN_USE = $80;
+ ERR_LOCK_FAIL = $80;
+ ERR_MAPPED_TO_A_LOCAL_DRIVE = $80;
+ ERR_NO_MORE_FILE_HANDLES = $81;
+ ERR_NO_OPEN_PRIVILEGE = $82;
+ ERR_NETWORK_DISK_IO = $83;
+ ERR_NO_CREATE_PRIVILEGE = $84;
+ ERR_NO_CREATE_DELETE_PRIVILEGE = $85;
+ ERR_R_O_CREATE_FILE = $86;
+ ERR_CREATE_FILE_INVALID_NAME = $87;
+ ERR_INVALID_FILE_HANDLE = $88;
+ ERR_NO_SEARCH_PRIVILEGE = $89;
+ ERR_NO_DELETE_PRIVILEGE = $8A;
+ ERR_NO_RENAME_PRIVILEGE = $8B;
+ ERR_NO_MODIFY_PRIVILEGE = $8C;
+ ERR_NO_SET_PRIVILEGE = $8C;
+ ERR_SOME_FILES_IN_USE = $8D;
+ ERR_ALL_FILES_IN_USE = $8E;
+ ERR_SOME_READ_ONLY = $8F;
+ ERR_ALL_READ_ONLY = $90;
+ ERR_SOME_NAMES_EXIST = $91;
+ ERR_ALL_NAMES_EXIST = $92;
+ ERR_NO_READ_PRIVILEGE = $93;
+ ERR_NO_WRITE_PRIVILEGE_OR_READONLY = $94;
+ ERR_FILE_DETACHED = $95;
+ ERR_NO_ALLOC_SPACE = $96;
+ ERR_SERVER_OUT_OF_MEMORY = $96;
+ ERR_TARGET_NOT_A_SUBDIRECTORY = $96;
+ ERR_NO_SPOOL_SPACE = $97;
+ ERR_INVALID_VOLUME = $98;
+ ERR_VOLUME_DOES_NOT_EXIST = $98;
+ ERR_DIRECTORY_FULL = $99;
+ ERR_RENAME_ACROSS_VOLUME = $9A;
+ ERR_BAD_DIR_HANDLE = $9B;
+ ERR_HOLE_FOUND = $9C;
+ ERR_INVALID_PATH = $9C;
+ ERR_NO_SUCH_EXTENSION = $9C;
+ ERR_NO_DIR_HANDLES = $9D;
+ ERR_BAD_FILE_NAME = $9E;
+ ERR_DIRECTORY_ACTIVE = $9F;
+ ERR_DIRECTORY_IN_USE = $9F;
+ ERR_DIRECTORY_NOT_EMPTY = $A0;
+ ERR_DIRECTORY_IO_ERROR = $A1;
+ ERR_IO_LOCKED = $A2;
+ ERR_TRANSACTION_RESTARTED = $A3;
+ ERR_RENAME_DIR_INVALID = $A4;
+ ERR_INVALID_OPENCREATE_MODE = $A5;
+ ERR_ALREADY_IN_USE = $A6;
+ ERR_SEARCH_DRIVE_VECTOR_FULL = $B0;
+ ERR_DRIVE_DOES_NOT_EXIST = $B1;
+ ERR_DRIVE_IS_NOT_MAPPED = $B1;
+ ERR_CANT_MAP_LOCAL_DRIVE = $B2;
+ ERR_INVALID_MAP_TYPE = $B3;
+ ERR_INVALID_DRIVE_LETTER = $B4;
+ ERR_NO_DRIVE_AVAILABLE = $B5;
+ ERR_WORKSTATION_OUT_OF_MEMORY = $B6;
+ ERR_NO_SUCH_SEARCH_DRIVE = $B7;
+ ERR_INVALID_ENVIRON_VARIABLE = $B8;
+ ERR_DOES_NOT_RUN_ON_IOENGINE = $B9;
+ ERR_PACKET_SIGNATURES_REQURIED = $BC;
+ ERR_PACKET_SIGNATURES_REQUIRED = $BC;
+ ERR_INVALID_DATA_STREAM = $BE;
+ ERR_INVALID_NAME_SPACE = $BF;
+ ERR_NO_ACCOUNT_PRIVILEGES = $C0;
+ ERR_NO_ACCOUNTING_PRIVILEGES = $C0;
+ ERR_NO_ACCOUNT_BALANCE = $C1;
+ ERR_CREDIT_LIMIT_EXCEEDED = $C2;
+ ERR_LOGIN_DENIED_NO_CREDIT = $C2;
+ ERR_TOO_MANY_HOLDS = $C3;
+ ERR_ACCOUNTING_DISABLED = $C4;
+ ERR_LOGIN_LOCKOUT = $C5;
+ ERR_NO_CONSOLE_OPERATOR_RIGHTS = $C6;
+ ERR_MISSING_EA_KEY = $C8;
+ ERR_EA_NOT_FOUND = $C9;
+ ERR_INVALID_EA_HANDLE_TYPE = $CA;
+ ERR_EA_NO_KEY_NO_DATA = $CB;
+ ERR_EA_NUMBER_MISMATCH = $CC;
+ ERR_EXTENT_NUMBER_OUT_OF_RANGE = $CD;
+ ERR_EA_BAD_DIR_NUM = $CE;
+ ERR_INVALID_EA_HANDLE = $CF;
+ ERR_EA_POSITION_OUT_OF_RANGE = $D0;
+ ERR_Q_IO_FAILURE = $D0;
+ ERR_EA_ACCESS_DENIED = $D1;
+ ERR_NO_QUEUE = $D1;
+ ERR_DATA_PAGE_ODD_SIZE = $D2;
+ ERR_NO_Q_SERVER = $D2;
+ ERR_EA_VOLUME_NOT_MOUNTED = $D3;
+ ERR_NO_Q_RIGHTS = $D3;
+ ERR_BAD_PAGE_BOUNDARY = $D4;
+ ERR_Q_FULL = $D4;
+ ERR_INSPECT_FAILURE = $D5;
+ ERR_NO_Q_JOB = $D5;
+ ERR_EA_ALREADY_CLAIMED = $D6;
+ ERR_NO_Q_JOB_RIGHTS = $D6;
+ ERR_UNENCRYPTED_NOT_ALLOWED = $D6;
+ ERR_ODD_BUFFER_SIZE = $D7;
+ ERR_DUPLICATE_PASSWORD = $D7;
+ ERR_Q_IN_SERVICE = $D7;
+ ERR_NO_SCORECARDS = $D8;
+ ERR_PASSWORD_TOO_SHORT = $D8;
+ ERR_Q_NOT_ACTIVE = $D8;
+ ERR_BAD_EDS_SIGNATURE = $D9;
+ ERR_MAXIMUM_LOGINS_EXCEEDED = $D9;
+ ERR_LOGIN_DENIED_NO_CONNECTION = $D9;
+ ERR_Q_STN_NOT_SERVER = $D9;
+ ERR_EA_SPACE_LIMIT = $DA;
+ ERR_BAD_LOGIN_TIME = $DA;
+ ERR_Q_HALTED = $DA;
+ ERR_EA_KEY_CORRUPT = $DB;
+ ERR_NODE_ADDRESS_VIOLATION = $DB;
+ ERR_Q_MAX_SERVERS = $DB;
+ ERR_EA_KEY_LIMIT = $DC;
+ ERR_LOG_ACCOUNT_EXPIRED = $DC;
+ ERR_TALLY_CORRUPT = $DD;
+ ERR_BAD_PASSWORD = $DE;
+ ERR_PASSWORD_EXPIRED_NO_GRACE = $DE;
+ ERR_PASSWORD_EXPIRED = $DF;
+ ERR_NOT_ITEM_PROPERTY = $E8;
+ ERR_WRITE_TO_GROUP_PROPERTY = $E8;
+ ERR_MEMBER_ALREADY_EXISTS = $E9;
+ ERR_NO_SUCH_MEMBER = $EA;
+ ERR_PROPERTY_NOT_GROUP = $EB;
+ ERR_NOT_GROUP_PROPERTY = $EB;
+ ERR_NO_SUCH_SEGMENT = $EC;
+ ERR_NO_SUCH_VALUE_SET = $EC;
+ ERR_SPX_CONNECTION_TERMINATED = $EC;
+ ERR_TERMINATED_BY_REMOTE_PARTNER = $EC;
+ ERR_PROPERTY_ALREADY_EXISTS = $ED;
+ ERR_SPX_CONNECTION_FAILED = $ED;
+ ERR_SPX_TERMINATED_POORLY = $ED;
+ ERR_SPX_NO_ANSWER_FROM_TARGET = $ED;
+ ERR_OBJECT_ALREADY_EXISTS = $EE;
+ ERR_SPX_INVALID_CONNECTION = $EE;
+ ERR_INVALID_NAME = $EF;
+ ERR_SPX_CONNECTION_TABLE_FULL = $EF;
+ ERR_IPX_NOT_INSTALLED = $F0;
+ ERR_ILLEGAL_WILDCARD = $F0;
+ ERR_WILDCARD_NOT_ALLOWED = $F0;
+ ERR_SOCKET_NOT_OPEN = $F0;
+ ERR_BINDERY_SECURITY = $F1;
+ ERR_INVALID_BINDERY_SECURITY = $F1;
+ ERR_SOCKET_ALREADY_OPEN = $F1;
+ ERR_NO_OBJECT_READ_PRIVILEGE = $F2;
+ ERR_NO_OBJECT_READ_RIGHTS = $F2;
+ ERR_NO_OBJECT_RENAME_PRIVILEGE = $F3;
+ ERR_NO_OBJECT_RENAME_RIGHTS = $F3;
+ ERR_NO_OBJECT_DELETE_PRIVILEGE = $F4;
+ ERR_NO_OBJECT_DELETE_RIGHTS = $F4;
+ ERR_NO_OBJECT_CREATE_PRIVILEGE = $F5;
+ ERR_NO_OBJECT_CREATE_RIGHTS = $F5;
+ ERR_NO_PROPERTY_DELETE_PRIVILEGE = $F6;
+ ERR_NO_PROPERTY_DELETE_RIGHTS = $F6;
+ ERR_NO_PROPERTY_CREATE_PRIVILEGE = $F7;
+ ERR_NO_PROPERTY_CREATE_RIGHTS = $F7;
+ ERR_ALREADY_ATTACHED_TO_SERVER = $F8;
+ ERR_NO_PROPERTY_WRITE_PRIVILEGE = $F8;
+ ERR_NO_PROPERTY_WRITE_RIGHTS = $F8;
+ ERR_NOT_ATTACHED_TO_SERVER = $F8;
+ ERR_ECB_CANNOT_BE_CANCELLED = $F9;
+ ERR_NO_FREE_CONNECTION_SLOTS = $F9;
+ ERR_NO_PROPERTY_READ_PRIVILEGE = $F9;
+ ERR_NO_PROPERTY_READ_RIGHTS = $F9;
+ ERR_NO_LOCAL_TARGET_IDENTIFIED = $FA;
+ ERR_NO_MORE_SERVER_SLOTS = $FA;
+ ERR_TEMP_REMAP = $FA;
+ ERR_NO_KNOWN_ROUTE_TO_DESTINATION = $FA;
+ ERR_INVALID_PARAMETERS = $FB;
+ ERR_NO_SUCH_PROPERTY = $FB;
+ ERR_UNKNOWN_REQUEST = $FB;
+ ERR_EVENT_CANCELLED = $FC;
+ ERR_INTERNET_PACKET_REQT_CANCELED = $FC;
+ ERR_MESSAGE_QUEUE_FULL = $FC;
+ ERR_NO_SUCH_BINDERY_OBJECT = $FC;
+ ERR_NO_SUCH_OBJECT = $FC;
+ ERR_REQUEST_CANCELLED = $FC;
+ ERR_SPX_COMMAND_CANCELLED = $FC;
+ ERR_SPX_SOCKET_CLOSED = $FC;
+ ERR_UNKNOWN_FILE_SERVER = $FC;
+ ERR_TARGET_ALREADY_HAS_MESSAGE = $FC;
+ ERR_NCPEXT_SERVICE_PROTOCOL_VIOLATION = $FC;
+ ERR_BAD_SERIAL_NUMBER = $FD;
+ ERR_INVALID_PACKET_LENGTH = $FD;
+ ERR_PACKET_OVERFLOW = $FD;
+ ERR_TTS_DISABLED = $FD;
+ ERR_FIELD_ALREADY_LOCKED = $FD;
+ ERR_FSCOPY_DIFFERENT_NETWORKS = $FD;
+ ERR_BAD_STATION_NUMBER = $FD;
+ ERR_BAD_PACKET = $FE;
+ ERR_SPX_MALFORMED_PACKET = $FE;
+ ERR_BINDERY_LOCKED = $FE;
+ ERR_DOS_ACCESS_DENIED = $FE;
+ ERR_DOS_NO_SEARCH_RIGHTS = $FE;
+ ERR_IMPLICIT_TRANSACTION_ACTIVE = $FE;
+ ERR_INCORRECT_ACCESS_PRIVILEGES = $FE;
+ ERR_INVALID_NAME_LENGTH = $FE;
+ ERR_INVALID_SEMAPHORE_NAME_LENGTH = $FE;
+ ERR_IO_FAILURE = $FE;
+ ERR_PACKET_NOT_DELIVERABLE = $FE;
+ ERR_SPOOL_DIRECTORY_ERROR = $FE;
+ ERR_SUPERVISOR_HAS_DISABLED_LOGIN = $FE;
+ ERR_TRANSACTION_ENDS_RECORDS_LOCKED = $FE;
+ ERR_SERVER_BINDERY_LOCKED = $FE;
+ ERR_TIMEOUT_FAILURE = $FE;
+ ERR_TRUSTEE_NOT_FOUND = $FE;
+ ERR_SOCKET_TABLE_FULL = $FE;
+ ERR_NCPEXT_NO_HANDLER = $FE;
+ ERR_BAD_PARAMETER = $FF;
+ ERR_BAD_SPOOL_PRINTER = $FF;
+ ERR_RECORD_ALREADY_LOCKED = $FF;
+ ERR_BAD_RECORD_OFFSET = $FF;
+ ERR_BINDERY_FAILURE = $FF;
+ ERR_ECB_NOT_IN_USE = $FF;
+ ERR_FAILURE = $FF;
+ ERR_FILE_EXTENSION_ERROR = $FF;
+ ERR_HARD_FAILURE = $FF;
+ ERR_INVALID_INITIAL_SEMAPHORE_VALUE = $FF;
+ ERR_INVALID_SEMAPHORE_HANDLE = $FF;
+ ERR_DOS_FILE_NOT_FOUND = $FF;
+ ERR_EXPLICIT_TRANSACTION_ACTIVE = $FF;
+ ERR_FILE_NOT_OPEN = $FF;
+ ERR_NO_EXPLICIT_TRANSACTION_ACTIVE = $FF;
+ ERR_NO_FILES_FOUND = $FF;
+ ERR_NO_RECORD_FOUND = $FF;
+ ERR_NO_RESPONSE_FROM_SERVER = $FF;
+ ERR_NO_SPOOL_FILE = $FF;
+ ERR_NO_SUCH_OBJECT_OR_BAD_PASSWORD = $FF;
+ ERR_OPEN_FILES = $FF;
+ ERR_PATH_ALREADY_EXISTS = $FF;
+ ERR_PATH_NOT_LOCATABLE = $FF;
+ ERR_QUEUE_FULL = $FF;
+ ERR_REQUEST_NOT_OUTSTANDING = $FF;
+ ERR_SOCKET_CLOSED = $FF;
+ ERR_SPX_IS_INSTALLED = $FF;
+ ERR_SPX_SOCKET_NOT_OPENED = $FF;
+ ERR_TARGET_NOT_LOGGED_IN = $FF;
+ ERR_TARGET_NOT_ACCEPTING_MESSAGES = $FF;
+ ERR_TRANSACTION_NOT_YET_WRITTEN = $FF;
+ ERR_NO_TRUSTEE_CHANGE_PRIVILEGE = $FF;
+ ERR_CHECKSUMS_REQUIRED = $FF;
+ ERR_SERVICE_NOT_LOADED = $101;
+ ERR_NO_LIBRARY_CONTEXT = $400;
+{-----------------------------------------------------------------------------
+ Important Note:
+ Additional NetWareErrno values that don't employ a ERR_ prefix have been
+ moved from this position into obsolete header niterror.h. Many of these had
+ been included for compatibility with the now-obsolete NIT API for DOS
+ clients and many conflict with current cross-platform headers.
+ -----------------------------------------------------------------------------}
+{ NetWare Core Protocol (NCP) error codes. }
+ DISKFULL = 1;
+ BADNET = 2;
+ LISTENERROR = 2;
+ BADLADDRESS = 3;
+ INVALIDSESSION = 3;
+ NOSLOTS = 4;
+ SLOTALLOCERR = 4;
+ BROADCASTERROR = 5;
+ BADSERVERNAME = 6;
+ BADUSERNAME = 7;
+ BADPASSWORD = 8;
+ MEMERROR = 9;
+ INVALIDCONNECTION = 10;
+ INVALIDHANDLE = 11;
+ INVALIDREQUEST = 12;
+ SOCKETERROR = 13;
+ ALLOCTAGERR = 14;
+ CONNECTIONABORTED = 15;
+ TIMEOUTERR = 16;
+{ frame type: Ethernet 802.3 }
+ CHECKSUMS_NOT_SUPPORTED = 17;
+ CHECKSUM_FAILURE = 18;
+ NO_FRAGMENT_LIST = 19;
+{ Values for 'NetWareErrno' as set by spawnlp() and spawnvp().}
+ LOAD_COULD_NOT_FIND_FILE = 1;
+ LOAD_ERROR_READING_FILE = 2;
+ LOAD_NOT_NLM_FILE_FORMAT = 3;
+ LOAD_WRONG_NLM_FILE_VERSION = 4;
+ LOAD_REENTRANT_INITIALIZE_FAILURE = 5;
+ LOAD_CAN_NOT_LOAD_MULTIPLE_COPIES = 6;
+ LOAD_ALREADY_IN_PROGRESS = 7;
+ LOAD_NOT_ENOUGH_MEMORY = 8;
+ LOAD_INITIALIZE_FAILURE = 9;
+ LOAD_INCONSISTENT_FILE_FORMAT = 10;
+ LOAD_CAN_NOT_LOAD_AT_STARTUP = 11;
+ LOAD_AUTO_LOAD_MODULES_NOT_LOADED = 12;
+ LOAD_UNRESOLVED_EXTERNAL = 13;
+ LOAD_PUBLIC_ALREADY_DEFINED = 14;
+ { Values for _msize() error return and NWMemorySizeAddressable(). }
+ ERR_HEAP_BAD_PTR = $FFFFFFFF;
+ ERR_HEAP_BLOCK_ALREADY_FREE = $FFFFFFFE;
+ ERR_INVALID_ADDRESS = $FFFFFFFD;
+ { Values for NetWare Virtual Memory (NVM) APIs as returned by GetVMErrno().
+ These values should be examined after calling a Win32 VM API without a
+ satisfactorily-lucid error in 'errno' or from (Win32) GetLastError(). }
+ ERROR_INSUFFICIENT_CONTIGUOUS_MEMORY = $1000;
+ ERROR_INSUFFICIENT_DISK_SWAP_SPACE = $1001;
+ ERROR_INSUFFICIENT_MEMORY = $1002;
+ ERROR_INSUFFICIENT_RESOURCES_TO_COMMIT_MEMORY = $1003;
+ ERROR_INVALID_ATTRIBUTE_FLAGS = $1004;
+ ERROR_INVALID_ADDRESS = $1005;
+ ERROR_INVALID_LOCK_FLAGS = $1006;
+ ERROR_INVALID_PAGE_COUNT = $1007;
+ ERROR_INVALID_PROTECTION_FLAGS = $1008;
+ ERROR_NON_SHARED_MEMORY_ADDRESS = $1009;
+ ERROR_SHARED_MEMORY_ADDRESS = $100A;
+
+function GetVMErrno:longint;cdecl;external 'clib' name 'GetVMErrno';
+procedure SetVMErrno(para1:longint);cdecl;external 'clib' name 'SetVMErrno';
+function __get_NWErrno:longint;cdecl;external 'clib' name '__get_NWErrno';
+function __get_NWErrno_ptr:Plongint;cdecl;external 'clib' name '__get_NWErrno_ptr';
+function NetWareErrno : longint;
+{-fcntl.h----------------------------------------------------------------------}
+const
+ F_GETFL = 1;
+ F_SETFL = 2;
+ F_DUPFD = 3;
+ F_GETFD = 4;
+ F_SETFD = 5;
+ F_SETLK = 6;
+ F_GETLK = 7;
+ F_SETLKW = 8;
+ F_RDLCK = 9;
+ F_UNLCK = 10;
+ F_WRLCK = 11;
+ F_CLOEXEC = 12;
+ O_RDONLY = $0000;
+ O_WRONLY = $0001;
+ O_RDWR = $0002;
+ O_ACCMODE = $0003;
+ O_APPEND = $0010;
+ O_CREAT = $0020;
+ O_TRUNC = $0040;
+ O_EXCL = $0080;
+ O_TEXT = $0100;
+ O_BINARY = $0200;
+ O_NDELAY = $0400;
+ O_NOCTTY = $0800;
+ O_NONBLOCK = O_NDELAY;
+ FNDELAY = $0004;
+type
+ Poff_t = ^Toff_t;
+ Toff_t = longint;
+ Ppid_t = ^Tpid_t;
+ Tpid_t = longint;
+ Pssize_t = ^Tssize_t;
+ Tssize_t = longint;
+ Pmode_t = ^Tmode_t;
+ Tmode_t = dword;
+
+ Pflock = ^Tflock;
+ Tflock = record
+ l_type : smallint;
+ l_whence : smallint;
+ l_start : Toff_t;
+ l_len : Toff_t;
+ l_pid : Tpid_t;
+ end;
+
+
+function creat (path:Pchar; mode:Tmode_t):longint; cdecl;external 'clib' name 'creat';
+function _fcntl (fildes:longint; cmd:longint;
+ args:array of const):longint; cdecl;external 'clib' name 'fcntl';
+function _fcntl (fildes:longint; cmd:longint):longint; cdecl;external 'clib' name 'fcntl';
+function open (path:Pchar; oflag:longint;
+ args:array of const):longint; cdecl;external 'clib' name 'open';
+function open (path:Pchar; oflag:longint):longint; cdecl;external 'clib' name 'open';
+function fpopen(path:Pchar; oflag:longint):longint; cdecl;external 'clib' name 'open';
+function sopen (path:Pchar; oflag, shflag:longint;
+ args:array of const):longint; cdecl;external 'clib' name 'sopen';
+function sopen (path:Pchar; oflag,shflag:longint):longint; cdecl;external 'clib' name 'sopen';
+
+{-limits.h---------------------------------------------------------------------}
+const
+ PAGESIZE = 4096;
+ CHAR_BIT = 8;
+ SCHAR_MIN = -(128);
+ SCHAR_MAX = 127;
+ UCHAR_MAX = 255;
+ CHAR_MIN = SCHAR_MIN;
+ CHAR_MAX = SCHAR_MAX;
+
+ MB_LEN_MAX = 5;
+ SHRT_MIN = -(32768);
+ SHRT_MAX = 32767;
+ USHRT_MAX = 65535;
+ LONG_MIN = (-(2147483647)) - 1;
+ LONG_MAX = 2147483647;
+ ULONG_MAX = 4294967295;
+ INT_MIN = LONG_MIN;
+ INT_MAX = LONG_MAX;
+ UINT_MAX = ULONG_MAX;
+ SSIZE_MAX = INT_MAX;
+ TZNAME_MAX = 8;
+ PIPE_BUF = 512;
+{-locale.h---------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+const
+ LC_CTYPE = 0;
+ LC_NUMERIC = 1;
+ LC_TIME = 2;
+ LC_COLLATE = 3;
+ LC_MONETARY = 4;
+ LC_MESSAGES = 5;
+ LC_ALL = 6;
+
+type
+ Plconv = ^Tlconv;
+ Tlconv =
+ record
+ decimal_point : array [0..3] of char;
+ thousands_sep : array [0..3] of char;
+ grouping : array [0..3] of char;
+ int_curr_symbol : array [0..7] of char;
+ currency_symbol : array [0..3] of char;
+ mon_decimal_point : array [0..3] of char;
+ mon_thousands_sep : array [0..3] of char;
+ mon_grouping : array [0..7] of char;
+ positive_sign : array [0..3] of char;
+ negative_sign : array [0..3] of char;
+ int_frac_digits : char;
+ frac_digits : char;
+ p_cs_precedes : char;
+ p_sep_by_space : char;
+ n_cs_precedes : char;
+ n_sep_by_space : char;
+ p_sign_posn : char;
+ n_sign_posn : char;
+ code_page : word;
+ country_id : word;
+ data_list_separator : array[0..1] of char;
+ date_separator : array[0..1] of char;
+ time_separator : array[0..1] of char;
+ time_format : char;
+ date_format : word;
+ reserved : array[0..49] of char;
+ end;
+
+// ???? struct lconv *localeconv( void );
+
+function setlocale_old (p1:longint; p2:Pchar):Pchar; cdecl; external 'clib' name 'setlocale';
+function setlocale (p1:longint; p2:Pchar):Pchar; cdecl; external 'clib' name 'setlocale_411';
+{-nwlocale.h-------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+type
+ TNUMBER_TYPE = double;
+ TUCHAR = byte;
+
+
+const
+ MERIDLEN = 5;
+ L_MB_LEN_MAX = 2; // multibyte character length maximum is 2
+ NWSINGLE_BYTE = 1; // returned from NWCharType()...
+ NWDOUBLE_BYTE = 2;
+{ country/language ID definitions (field 'country_id' in struct Llconv)... }
+ ARABIC = 785;
+ AUSTRALIA = 61;
+ BELGIUM = 32;
+ CANADA_ENG = 1;
+ CANADA_FR = 2;
+ DENMARK = 45;
+ FINLAND = 358;
+ FRANCE = 33;
+ GERMANY = 49;
+ HEBREW = 972;
+ ITALY = 39;
+ LATIN_AMERICA = 003;
+ NETHERLANDS = 31;
+ NORWAY = 47;
+ PORTUGAL = 351;
+ SPAIN = 34;
+ SWEDEN = 46;
+ SWITZERLAND = 41;
+ UK = 44;
+ USA = 1;
+ JAPAN = 81;
+ KOREA = 82;
+ PRC = 86;
+ TAIWAN = 88;
+ ASIAN_ENGLISH = 99;
+
+
+type
+ PVECTOR = ^TVECTOR;
+ TVECTOR = record
+ lowValue : char;
+ highValue : char;
+ end;
+{ extern double-byte table data... }
+//?? var _DBCSVector : array[0..4] of TVECTOR;cvar;external;
+{ prototypes... }
+
+function NWCharType(ch:dword):longint;cdecl;external 'locnlm32' name 'NWCharType';
+function NWCharVal(_string:Pchar):longint;cdecl;external 'locnlm32' name 'NWCharVal';
+function NWCharUpr(chr:longint):longint;cdecl;external 'locnlm32' name 'NWCharUpr';
+function NWcprintf(format:Pchar; args:array of const):longint;cdecl;external 'locnlm32' name 'NWcprintf';
+function NWcprintf(format:Pchar):longint;cdecl;external 'locnlm32' name 'NWcprintf';
+function NWIncrement(_string:Pchar; numChars:Tsize_t):Pchar;cdecl;external 'locnlm32' name 'NWIncrement';
+{
+ NWatoi, NWisalnum, NWisalpha, and NWisdigit are preferred over NWLatoi,
+ NWisalnum, NWLisalpha, and NWLisdigit respectively.
+ }
+function NWatoi(_string:Pchar):longint;cdecl;external 'locnlm32' name 'NWatoi';
+function NWisalnum(ch:dword):longint;cdecl;external 'locnlm32' name 'NWisalnum';
+function NWisalpha(ch:dword):longint;cdecl;external 'locnlm32' name 'NWisalpha';
+function NWisdigit(ch:dword):longint;cdecl;external 'locnlm32' name 'NWisdigit';
+function NWisxdigit(ch:dword):longint;cdecl;external 'locnlm32' name 'NWisxdigit';
+function NWitoa(value:longint; _string:Pchar; radix:longint):longint;cdecl;external 'locnlm32' name 'NWitoa';
+function NWutoa(value:dword; _string:Pchar; radix:longint):longint;cdecl;external 'locnlm32' name 'NWutoa';
+function NWltoa(value:longint; _string:Pchar; radix:longint):longint;cdecl;external 'locnlm32' name 'NWltoa';
+function NWultoa(value:dword; _string:Pchar; radix:longint):longint;cdecl;external 'locnlm32' name 'NWultoa';
+(* Const before type ignored *)
+function NWLatoi(_string:Pchar):longint;cdecl;external 'locnlm32' name 'NWLatoi';
+function NWLisalnum(ch:dword):longint;cdecl;external 'locnlm32' name 'NWLisalnum';
+function NWLisalpha(ch:dword):longint;cdecl;external 'locnlm32' name 'NWLisalpha';
+function NWLisdigit(ch:dword):longint;cdecl;external 'locnlm32' name 'NWLisdigit';
+function NWLlocaleconv(lconvPtr:PLCONV):PLCONV;cdecl;external 'locnlm32' name 'NWLlocaleconv';
+function NWLmblen(_string:Pchar; maxBytes:Tsize_t):longint;cdecl;external 'locnlm32' name 'NWLmblen';
+function NWLmbslen(_string:Pchar):longint;cdecl;external 'locnlm32' name 'NWLmbslen';
+function NWLsetlocale(category:longint; locale:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLsetlocale';
+function NWLsetlocale_411(category:longint; locale:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLsetlocale_411';
+function NWLstrbcpy(dest:Pchar; src:Pchar; maxlen:Tsize_t):Pchar;cdecl;external 'locnlm32' name 'NWLstrbcpy';
+function NWLstrchr(_string:Pchar; find:longint):Pchar;cdecl;external 'locnlm32' name 'NWLstrchr';
+function NWLstrcoll(string1:Pchar; string2:Pchar):longint;cdecl;external 'locnlm32' name 'NWLstrcoll';
+function NWLstrcspn(string1:Pchar; string2:Pchar):Tsize_t;cdecl;external 'locnlm32' name 'NWLstrcspn';
+function NWLstrftime(_string:Pchar; maxSize:Tsize_t; format:Pchar; timePtr:Ptm):Tsize_t;cdecl;external 'locnlm32' name 'NWLstrftime';
+function NWLstricmp(str1:Pchar; str2:Pchar):longint;cdecl;external 'locnlm32' name 'NWLstricmp';
+function NWLstrlwr(_string:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLstrlwr';
+function NWLstrpbrk(string1:Pchar; string2:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLstrpbrk';
+function NWLstrrchr(_string:Pchar; find:longint):Pchar;cdecl;external 'locnlm32' name 'NWLstrrchr';
+function NWLstrrev(string1:Pchar; string2:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLstrrev';
+function NWLstrspn(string1:Pchar; string2:Pchar):Tsize_t;cdecl;external 'locnlm32' name 'NWLstrspn';
+function NWLstrstr(_string:Pchar; searchString:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLstrstr';
+function NWLstrupr(_string:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWLstrupr';
+function NWLstrxfrm(string1:Pchar; string2:Pchar; numChars:Tsize_t):Tsize_t;cdecl;external 'locnlm32' name 'NWLstrxfrm';
+function NWPrevChar(_string:Pchar; position:Pchar):Pchar;cdecl;external 'locnlm32' name 'NWPrevChar';
+function NWprintf(format:Pchar; args:array of const):longint;cdecl;external 'locnlm32' name 'NWprintf';
+function NWprintf(format:Pchar):longint;cdecl;external 'locnlm32' name 'NWprintf';
+function NWsprintf(s:Pchar; format:Pchar; args:array of const):longint;cdecl;external 'locnlm32' name 'NWsprintf';
+function NWsprintf(s:Pchar; format:Pchar):longint;cdecl;external 'locnlm32' name 'NWsprintf';
+function NWstrImoney(buffer:Pchar; Value:TNUMBER_TYPE):Pchar;cdecl;external 'locnlm32' name 'NWstrImoney';
+function NWstrmoney(buffer:Pchar; Value:TNUMBER_TYPE):Pchar;cdecl;external 'locnlm32' name 'NWstrmoney';
+function NWstrncoll(string1:Pchar; string2:Pchar; maxChars:Tsize_t):longint;cdecl;external 'locnlm32' name 'NWstrncoll';
+function NWstrncpy(target_string:Pchar; source_string:Pchar; numChars:longint):Pchar;cdecl;external 'locnlm32' name 'NWstrncpy';
+function NWstrnum(buffer:Pchar; Value:TNUMBER_TYPE):Pchar;cdecl;external 'locnlm32' name 'NWstrnum';
+//function NWvcprintf(format:Pchar; arg:Tva_list):longint;cdecl;external 'locnlm32' name 'NWvcprintf';
+//function NWvprintf(format:Pchar; arg:Tva_list):longint;cdecl;external 'locnlm32' name 'NWvprintf';
+//function NWvsprintf(s:Pchar; format:Pchar; arg:Tva_list):longint;cdecl;external 'locnlm32' name 'NWvsprintf';
+{-nwaudnlm.h-------------------------------------------------------------------}
+{ defined network address types: }
+
+const
+ ASCIIZ_STRING_NET_ADDRESS_TYPE = 0;
+ IPX_NET_ADDRESS_TYPE = 1;
+
+ // special value network address type:
+ NO_IDENTITY_HAS_BEEN_SET = $FF;
+
+function NWAddRecordToAuditingFile
+ (volumeNumber,
+ recordType,
+ stationNumber,
+ statusCode : longint;
+ data : pointer;
+ dataSize : longint):longint;cdecl;external 'clib' name 'NWAddRecordToAuditingFile';
+function NWAddRecordToAuditingFile
+ (volumeNumber,
+ recordType,
+ stationNumber,
+ statusCode : longint;
+ var data;
+ dataSize : longint):longint;cdecl;external 'clib' name 'NWAddRecordToAuditingFile';
+
+
+function NWGetAuditingIdentity
+ (addressType : Plongint;
+ networkAddress : pointer;
+ identityName : Pchar):longint;cdecl;external 'clib' name 'NWGetAuditingIdentity';
+function NWGetAuditingIdentity
+ (var addressType : longint;
+ var networkAddress;
+ identityName : Pchar):longint;cdecl;external 'clib' name 'NWGetAuditingIdentity';
+function NWSetAuditingIdentity
+ (addressType:longint;
+ networkAddress:pointer;
+ identityName:Pchar):longint;cdecl;external 'clib' name 'NWSetAuditingIdentity';
+function NWSetAuditingIdentity
+ (addressType:longint;
+ var networkAddress;
+ identityName:Pchar):longint;cdecl;external 'clib' name 'NWSetAuditingIdentity';
+{-nwbitops.h-------------------------------------------------------------------}
+procedure BitClear (bitArray:pointer; bitNumber:longint);cdecl;external 'clib' name 'BitClear';
+procedure BitSet (bitArray:pointer; bitNumber:longint);cdecl;external 'clib' name 'BitSet';
+function BitTest (bitArray:pointer; bitNumber:longint):longint;cdecl;external 'clib' name 'BitTest';
+function BitTestAndClear (bitArray:pointer; bitNumber:longint):longint;cdecl;external 'clib' name 'BitTestAndClear';
+function BitTestAndSet (bitArray:pointer; bitNumber:longint):longint;cdecl;external 'clib' name 'BitTestAndSet';
+function ScanBits (bitArray:pointer; startingBitNumber,totalBitCount:longint):longint;cdecl;external 'clib' name 'ScanBits';
+function ScanClearedBits (bitArray:pointer; startingBitNumber,totalBitCount:longint):longint;cdecl;external 'clib' name 'ScanClearedBits';
+
+procedure BitClear (var bitArray; bitNumber:longint);cdecl;external 'clib' name 'BitClear';
+procedure BitSet (var bitArray; bitNumber:longint);cdecl;external 'clib' name 'BitSet';
+function BitTest (var bitArray; bitNumber:longint):longint;cdecl;external 'clib' name 'BitTest';
+function BitTestAndClear (var bitArray; bitNumber:longint):longint;cdecl;external 'clib' name 'BitTestAndClear';
+function BitTestAndSet (var bitArray; bitNumber:longint):longint;cdecl;external 'clib' name 'BitTestAndSet';
+function ScanBits (var bitArray; startingBitNumber,totalBitCount:longint):longint;cdecl;external 'clib' name 'ScanBits';
+function ScanClearedBits (var bitArray; startingBitNumber,totalBitCount:longint):longint;cdecl;external 'clib' name 'ScanClearedBits';
+{-nwcntask.h-------------------------------------------------------------------}
+{#define LOGIN_WITHOUT_PASSWORD ((char *) N_TRUE) }
+
+function AllocateBlockOfTasks(numberWanted:longint):longint;cdecl;external 'clib' name 'AllocateBlockOfTasks';
+function CheckIfConnectionActive(connection:longint):byte;cdecl;external 'clib' name 'CheckIfConnectionActive';
+function DisableConnection(connection:longint):longint;cdecl;external 'clib' name 'DisableConnection';
+function EnableConnection(connection:longint):longint;cdecl;external 'clib' name 'EnableConnection';
+function GetCurrentConnection:longint;cdecl;external 'clib' name 'GetCurrentConnection';
+function GetCurrentFileServerID:word;cdecl;external 'clib' name 'GetCurrentFileServerID';
+function GetCurrentTask:longint;cdecl;external 'clib' name 'GetCurrentTask';
+function LoginObject(connection:longint; objectName:Pchar; objectType:word; password:Pchar):longint;cdecl;external 'clib' name 'LoginObject';
+function LogoutObject(connection:longint):longint;cdecl;external 'clib' name 'LogoutObject';
+function ReturnBlockOfTasks(startingTask,numberOfTasks:longint):longint;cdecl;external 'clib' name 'ReturnBlockOfTasks';
+function ReturnConnection(connection:longint):longint;cdecl;external 'clib' name 'ReturnConnection';
+function ReturnLocalConnection(connection:longint):longint;cdecl;external 'clib' name 'ReturnLocalConnection';
+function SetCurrentConnection(connectionNumber:longint):longint;cdecl;external 'clib' name 'SetCurrentConnection';
+function SetCurrentFileServerID(connectionID:word):word;cdecl;external 'clib' name 'SetCurrentFileServerID';
+function SetCurrentTask(taskNumber:longint):longint;cdecl;external 'clib' name 'SetCurrentTask';
+{-nwconio.h--------------------------------------------------------------------}
+const
+ DONT_AUTO_ACTIVATE = $01; // avoids autoactivation when screens are
+ // created, but no other screens exist
+ DONT_SWITCH_SCREEN = $02; // avoids screen being switched
+ DONT_CHECK_CTRL_CHARS = $10; // turns off ^C and ^S processing
+ AUTO_DESTROY_SCREEN = $20; // avoids "Press any key to close screen
+ POP_UP_SCREEN = $40;
+ UNCOUPLED_CURSORS = $80; // for distinct input & output cursors
+{ more screen attribute values returned by GetScreenInfo() }
+ HAS_A_CLIB_HANDLE = $00000100;
+ _KEYBOARD_INPUT_ACTIVE = $00010000;
+ _PROCESS_BLOCKED_ON_KEYBOARD = $00020000;
+ _PROCESS_BLOCKED_ON_SCREEN = $00040000;
+ _INPUT_CURSOR_DISABLED = $00080000;
+ _SCREEN_HAS_TITLE_BAR = $00400000;
+ _NON_SWITCHABLE_SCREEN = $01000000;
+
+ { key types... }
+ NORMAL_KEY = $00;
+ FUNCTION_KEY = $01;
+ ENTER_KEY = $02;
+ ESCAPE_KEY = $03;
+ BACKSPACE_KEY = $04;
+ DELETE_KEY = $05;
+ INSERT_KEY = $06;
+ CURSOR_UP_KEY = $07;
+ CURSOR_DOWN_KEY = $08;
+ CURSOR_RIGHT_KEY = $09;
+ CURSOR_LEFT_KEY = $0A;
+ CURSOR_HOME_KEY = $0B;
+ CURSOR_END_KEY = $0C;
+ CURSOR_PUP_KEY = $0D;
+ CURSOR_PDOWN_KEY = $0E;
+ { some name equivalents... }
+ ENTER = $0D;
+ ESCAPE = $1B;
+ BACKSPACE = $08;
+ { modifier code constituents... }
+ SHIFT_KEY_HELD = $01;
+ CTRL_KEY_HELD = $04;
+ ALT_KEY_HELD = $08;
+ CAPS_LOCK_IS_ON = $40;
+ NUM_LOCK_IS_ON = $20;
+ SCROLL_LOCK_IS_ON = $10;
+
+ { cursor types... }
+ CURSOR_NORMAL = $0C0B;
+ CURSOR_THICK = $0C09;
+ CURSOR_BLOCK = $0C00;
+ CURSOR_TOP = $0400;
+
+type // libc compatible
+ Pscr_t = ^scr_t;
+ scr_t = pointer;
+ TScr = scr_t;
+ PScr = Pscr_t;
+ PScreenStruct = PScr;
+
+function getch:longint; cdecl; external 'clib' name 'getch';
+function getche:longint; cdecl; external 'clib' name 'getche';
+function kbhit:longint; cdecl; external 'clib' name 'kbhit';
+function putch(c:longint):longint; cdecl; external 'clib' name 'putch';
+function ungetch(c:longint):longint; cdecl; external 'clib' name 'ungetch';
+function ungetcharacter(c:longint):longint; cdecl; external 'clib' name 'ungetch';
+function cgets(buf:Pchar):Pchar; cdecl; external 'clib' name 'cgets';
+function CheckIfScreenDisplayed(screenHandle,waitFlag:longint):longint; cdecl; external 'clib' name 'CheckIfScreenDisplayed';
+function CheckIfScreenDisplayed(screenHandle:TScr;waitFlag:longint):longint; cdecl; external 'clib' name 'CheckIfScreenDisplayed';
+procedure clrscr; cdecl; external 'clib' name 'clrscr';
+procedure ConsolePrintf(format:Pchar; args:array of const); cdecl; external 'clib' name 'ConsolePrintf';
+procedure ConsolePrintf(format:Pchar); cdecl; external 'clib' name 'ConsolePrintf';
+procedure CopyToScreenMemory(height,width:word; Rect:PBYTE; beg_x,beg_y:word); cdecl; external 'clib' name 'CopyToScreenMemory';
+procedure CopyToScreenMemory(height,width:word; var Data; beg_x,beg_y:word); cdecl; external 'clib' name 'CopyToScreenMemory';
+procedure CopyFromScreenMemory(height,width:word; Rect:PBYTE; beg_x,beg_y:word); cdecl; external 'clib' name 'CopyFromScreenMemory';
+procedure CopyFromScreenMemory(height,width:word; var Data; beg_x,beg_y:word); cdecl; external 'clib' name 'CopyFromScreenMemory';
+function CoupleInputOutputCursors:longint; cdecl; external 'clib' name 'CoupleInputOutputCursors';
+function cputs(buf:Pchar):longint; cdecl; external 'clib' name 'cputs';
+function cprintf(fmt:Pchar; args:array of const):longint; cdecl; external 'clib' name 'cprintf';
+function cprintf(fmt:Pchar):longint; cdecl; external 'clib' name 'cprintf';
+//function CreateScreen(screenName:Pchar; attr:byte):longint; cdecl; external 'clib' name 'CreateScreen';
+function CreateScreen(screenName:Pchar; attr:byte):TScr; cdecl; external 'clib' name 'CreateScreen';
+function cscanf(fmt:Pchar; args:array of const):longint; cdecl; external 'clib' name 'cscanf';
+function cscanf(fmt:Pchar):longint; cdecl; external 'clib' name 'cscanf';
+function DecoupleInputOutputCursors:longint; cdecl; external 'clib' name 'DecoupleInputOutputCursors';
+function DestroyScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'DestroyScreen';
+function DestroyScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'DestroyScreen';
+function DisplayInputCursor:longint; cdecl; external 'clib' name 'DisplayInputCursor';
+function DisplayScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'DisplayScreen';
+function DisplayScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'DisplayScreen';
+function DropPopUpScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'DropPopUpScreen';
+function DropPopUpScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'DropPopUpScreen';
+//function GetCurrentScreen:longint; cdecl; external 'clib' name 'GetCurrentScreen';
+function GetCurrentScreen:TScr; cdecl; external 'clib' name 'GetCurrentScreen';
+function GetCursorCouplingMode:byte; cdecl; external 'clib' name 'GetCursorCouplingMode';
+function GetCursorShape(startline,endline:PBYTE):word; cdecl; external 'clib' name 'GetCursorShape';
+function GetCursorShape(var startline,endline:byte):word; cdecl; external 'clib' name 'GetCursorShape';
+function GetCursorSize(firstline,lastline:PBYTE):word; cdecl; external 'clib' name 'GetCursorSize';
+function GetCursorSize(var firstline,lastline:byte):word; cdecl; external 'clib' name 'GetCursorSize';
+function GetPositionOfOutputCursor(rowP,columnP:PWORD):longint; cdecl; external 'clib' name 'GetPositionOfOutputCursor';
+function GetPositionOfOutputCursor(var row,col:word):longint; cdecl; external 'clib' name 'GetPositionOfOutputCursor';
+function __GetScreenID(screenHandle:longint):longint; cdecl; external 'clib' name '__GetScreenID';
+function __GetScreenID(screenHandle:TScr):longint; cdecl; external 'clib' name '__GetScreenID';
+function GetScreenInfo(handle:longint; name:Pchar; attr:plongint):longint; cdecl; external 'clib' name 'GetScreenInfo';
+function GetScreenInfo(handle:longint; name:Pchar; var attr:longint):longint; cdecl; external 'clib' name 'GetScreenInfo';
+function GetSizeOfScreen(heightP,widthP:PWORD):longint; cdecl; external 'clib' name 'GetSizeOfScreen';
+function GetSizeOfScreen(var heightP,widthP:word):longint; cdecl; external 'clib' name 'GetSizeOfScreen';
+procedure gotoxy(col,row:word); cdecl; external 'clib' name 'gotoxy';
+function HideInputCursor:longint; cdecl; external 'clib' name 'HideInputCursor';
+function IsColorMonitor:longint; cdecl; external 'clib' name 'IsColorMonitor';
+function PressAnyKeyToContinue:longint; cdecl; external 'clib' name 'PressAnyKeyToContinue';
+function PressAnyKey:longint; cdecl; external 'clib' name 'PressAnyKeyToContinue';
+function PressEscapeToQuit:longint; cdecl; external 'clib' name 'PressEscapeToQuit';
+function PressEscape:longint; cdecl; external 'clib' name 'PressEscapeToQuit';
+procedure RingTheBell; cdecl; external 'clib' name 'RingTheBell';
+procedure RingBell; cdecl; external 'clib' name 'RingTheBell';
+
+function ScanScreens(LastScreenID:longint; name:Pchar; attr:plongint):longint; cdecl; external 'clib' name 'ScanScreens';
+function ScanScreens(LastScreenID:longint; name:Pchar; var attr:longint):longint; cdecl; external 'clib' name 'ScanScreens';
+function ScanScreens(LastScreenID:TScr; name:Pchar; attr:plongint):TScr; cdecl; external 'clib' name 'ScanScreens';
+function ScanScreens(LastScreenID:TScr; name:Pchar; var attr:longint):TScr; cdecl; external 'clib' name 'ScanScreens';
+
+function ScrollScreenRegionDown(firstLine,numLines:longint):longint; cdecl; external 'clib' name 'ScrollScreenRegionDown';
+function ScrollScreenRegionUp(firstLine,numLines:longint):longint; cdecl; external 'clib' name 'ScrollScreenRegionUp';
+function SetAutoScreenDestructionMode(newMode:byte):byte; cdecl; external 'clib' name 'SetAutoScreenDestructionMode';
+function SetCtrlCharCheckMode(newMode:byte):byte; cdecl; external 'clib' name 'SetCtrlCharCheckMode';
+function SetCursorCouplingMode(newMode:byte):byte; cdecl; external 'clib' name 'SetCursorCouplingMode';
+function SetCursorShape(startline,endline:byte):word; cdecl; external 'clib' name 'SetCursorShape';
+function SetCurrentScreen(screenHandle:longint):longint; cdecl; external 'clib' name 'SetCurrentScreen';
+function SetCurrentScreen(screenHandle:TScr):longint; cdecl; external 'clib' name 'SetCurrentScreen';
+function SetInputAtOutputCursorPosition:longint; cdecl; external 'clib' name 'SetInputAtOutputCursorPosition';
+function SetOutputAtInputCursorPosition:longint; cdecl; external 'clib' name 'SetOutputAtInputCursorPosition';
+function SetPositionOfInputCursor(row,col:word):longint; cdecl; external 'clib' name 'SetPositionOfInputCursor';
+function SetScreenAreaAttribute(line,col:longint; numLines:longint; numColumns:longint; attr:longint):longint; cdecl; external 'clib' name 'SetScreenAreaAttribute';
+function SetScreenAttributes(mask,attr:longint):longint; cdecl; external 'clib' name 'SetScreenAttributes';
+function SetScreenCharacterAttribute(line,column,attr:longint):longint; cdecl; external 'clib' name 'SetScreenCharacterAttribute';
+function SetScreenRegionAttribute(firstLine,numLines:longint; attr:byte):longint; cdecl; external 'clib' name 'SetScreenRegionAttribute';
+function wherex:word; cdecl; external 'clib' name 'wherex';
+function wherey:word; cdecl; external 'clib' name 'wherey';
+
+procedure GetKey(scrID:TScr; _type,value,status,scancode:Pbyte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
+procedure GetKey(scrID:TScr; var _type,value,status,scancode:byte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
+procedure GetKey(scrID:Longint; _type,value,status,scancode:Pbyte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
+procedure GetKey(scrID:Longint; var _type,value,status,scancode:byte;linesToProtect:Longint);cdecl;external 'clib' name 'GetKey';
+
+function UngetKey(scrID:TScr; _type,value,status,scancode:byte):longint;cdecl;external 'clib' name 'UngetKey';
+function UngetKey(scrID:Longint; _type,value,status,scancode:byte):longint;cdecl;external 'clib' name 'UngetKey';
+{-nwconn.h---------------------------------------------------------------------}
+{ Structures and typedefs for connection services }
+
+const
+ IPX_TRANSPORT_ADDRESS = 1;
+ IPX_TRANSPORT_LENGTH = 12;
+ UDP_TRANSPORT_ADDRESS = 8;
+ UDP_TRANSPORT_LENGTH = 4;
+ TCP_TRANSPORT_ADDRESS = 9;
+ TCP_TRANSPORT_LENGTH = 4;
+{$include npackon.inc}
+type
+ PUserNameStruct = ^TUserNameStruct;
+ TUserNameStruct = record
+ UserName : array[0..47] of char;
+ ObjectID : longint;
+ end;
+ TConnectionCriticalErrorHandler =
+ function (fileServerID,connection,err:longint):longint; cdecl;
+
+{$include npackoff.inc}
+
+function AttachByAddress(transType:byte; transLen:longint; transBuf:pointer; fileServerID:PWORD):longint;cdecl;external 'clib' name 'AttachByAddress';
+function AttachByAddress(transType:byte; transLen:longint; var transBuf; var fileServerID:word):longint;cdecl;external 'clib' name 'AttachByAddress';
+
+function AttachToFileServer(fileServerName:Pchar; fileServerID:PWORD):longint;cdecl;external 'clib' name 'AttachToFileServer';
+function AttachToFileServer(fileServerName:Pchar; var fileServerID:word):longint;cdecl;external 'clib' name 'AttachToFileServer';
+
+function GetConnectionFromID(fileServerID:PWORD):longint;cdecl;external 'clib' name 'GetConnectionFromID';
+function GetConnectionFromID(var fileServerID:word):longint;cdecl;external 'clib' name 'GetConnectionFromID';
+
+function GetConnectionInformation (connectionNumber:word;
+ objectName :Pchar;
+ objectType :PWORD;
+ objectID :Plongint;
+ loginTime :pointer):longint;cdecl;external 'clib' name 'GetConnectionInformation';
+function GetConnectionInformation (connectionNumber:word;
+ objectName :Pchar;
+ var objectType :word;
+ var objectID :longint;
+ var loginTime):longint;cdecl;external 'clib' name 'GetConnectionInformation';
+
+function GetConnectionList(objectID,lastConnection:longint;
+ numberOfConnections:Plongint;
+ connectionList:pointer;
+ connectionSize:longint):longint;cdecl;external 'clib' name 'GetConnectionList';
+function GetConnectionList(objectID,lastConnection:longint;
+ var numberOfConnections:longint;
+ var connectionList; {array of longint}
+ connectionSize:longint):longint;cdecl;external 'clib' name 'GetConnectionList';
+function GetConnectionNumber:word;cdecl;external 'clib' name 'GetConnectionNumber';
+function GetDefaultConnectionID:longint;cdecl;external 'clib' name 'GetDefaultConnectionID';
+function GetDefaultFileServerID:longint;cdecl;external 'clib' name 'GetDefaultFileServerID';
+function GetFileServerID(fileServerName:Pchar; fileServerID:PWORD):longint;cdecl;external 'clib' name 'GetFileServerID';
+function GetFileServerID(fileServerName:Pchar; var fileServerID:word):longint;cdecl;external 'clib' name 'GetFileServerID';
+
+function GetInternetAddress(connectionNumber:word;
+ networkNumber:pointer;
+ physicalNodeAddress:pointer):longint;cdecl;external 'clib' name 'GetInternetAddress';
+function GetInternetAddress(connectionNumber:word;
+ var networkNumber; {4 bytes}
+ var physicalNodeAddress {6 bytes}):longint;cdecl;external 'clib' name 'GetInternetAddress';
+function GetLANAddress (boardNumber:longint;
+ nodeAddress:pointer):longint;cdecl;external 'clib' name 'GetLANAddress';
+function GetLANAddress (boardNumber:longint;
+ var nodeAddress{6 bytes}):longint;cdecl;external 'clib' name 'GetLANAddress';
+
+function GetMaximumNumberOfStations:longint;cdecl;external 'clib' name 'GetMaximumNumberOfStations';
+function GetNetNumber(boardNumber:longint):longint;cdecl;external 'clib' name 'GetNetNumber';
+
+function GetObjectConnectionNumbers (objectName:Pchar;
+ objectType:word;
+ numberOfConnections:PWORD;
+ connectionList:PWORD;
+ maxConnections:word):longint;cdecl;external 'clib' name 'GetObjectConnectionNumbers';
+function GetObjectConnectionNumbers (objectName:Pchar;
+ objectType:word;
+ var numberOfConnections:word;
+ var connectionList; {array of WORD}
+ maxConnections:word):longint;cdecl;external 'clib' name 'GetObjectConnectionNumbers';
+
+procedure GetStationAddress(physicalNodeAddress:pointer);cdecl;external 'clib' name 'GetStationAddress';
+procedure GetStationAddress(var physicalNodeAddress {6 bytes});cdecl;external 'clib' name 'GetStationAddress';
+
+function GetUserNameFromNetAddress (internetAddress:PBYTE;
+ sequenceNumber:longint;
+ userNameP:PUserNameStruct):longint;cdecl;external 'clib' name 'GetUserNameFromNetAddress';
+function GetUserNameFromNetAddress (var internetAddress; {10 bytes}
+ sequenceNumber:longint;
+ var userName:TUserNameStruct):longint;cdecl;external 'clib' name 'GetUserNameFromNetAddress';
+
+function LoginToFileServer (objectName:Pchar;
+ objectType:word;
+ objectPassword:Pchar):longint;cdecl;external 'clib' name 'LoginToFileServer';
+procedure Logout;cdecl;external 'clib' name 'Logout';
+procedure LogoutFromFileServer(fileServerID:word);cdecl;external 'clib' name 'LogoutFromFileServer';
+function NWDSGetCurrentUser:longint;cdecl;external 'clib' name 'NWDSGetCurrentUser';
+function NWDSSetCurrentUser(userHandle:longint):longint;cdecl;external 'clib' name 'NWDSSetCurrentUser';
+
+function NWDSSetPreferredDSTree (len:longint; treeName:Pchar):longint;cdecl;external 'clib' name 'NWDSSetPreferredDSTree';
+function NWGetPacketBurstBufferCount:longint;cdecl;external 'clib' name 'NWGetPacketBurstBufferCount';
+function NWGetSecurityLevel:longint;cdecl;external 'clib' name 'NWGetSecurityLevel';
+
+function NWNCPSend (functionCode:byte;
+ sendPacket:pointer; sendLen :word;
+ replyBuf :pointer; replyLen:word):longint;cdecl;external 'clib' name 'NWNCPSend';
+function NWNCPSend (functionCode:byte;
+ var sendPacket; sendLen :word;
+ var replyBuf; replyLen:word):longint;cdecl;external 'clib' name 'NWNCPSend';
+
+function NWSetPacketBurstBufferCount(numberOfBuffers:longint):longint;cdecl;external 'clib' name 'NWSetPacketBurstBufferCount';
+function NWSetSecurityLevel(SecurityLevel:longint):longint;cdecl;external 'clib' name 'NWSetSecurityLevel';
+
+function SetConnectionCriticalErrorHandler(func:TConnectionCriticalErrorHandler):longint;cdecl;external 'clib' name 'SetConnectionCriticalErrorHandler';
+{-nwdebug.h--------------------------------------------------------------------}
+{ library-debug flags }
+
+const
+ CLIB_CONTEXT_CHECK = $002; { CLib Context }
+ CLIB_MEMCHECK = $004; { Memory Overwrites }
+ CLIB_RESOURCECHECK = $020; { Resource Check }
+ CLIB_THREAD_CHECK = $200; { Thread Check }
+ CLIB_SEMCHECK = $080; { Semaphore Checking }
+ CLIB_RING_BELL = $040;
+{ dynamic setting and clearing of breakpoints }
+ EXECUTION_BREAKPOINT = 0;
+ WRITE_BREAKPOINT = 1;
+ READ_WRITE_BREAKPOINT = 3;
+
+// most of the functions are in the kernel (system), we define clib here to
+// avoid linker errors
+procedure NWClearBreakpoint(breakpoint:longint);cdecl;external 'clib' name 'NWClearBreakpoint';
+function NWSetBreakpoint(address,breakType:longint):longint;cdecl;external 'clib' name 'NWSetBreakpoint';
+function NWDebugPrintf(format:Pchar; args:array of const):longint;cdecl;external 'clib' name 'NWDebugPrintf';
+function NWDebugPrintf(format:Pchar):longint;cdecl;external 'clib' name 'NWDebugPrintf';
+function NWValidateDebugProfile:longint;cdecl;external 'clib' name 'NWValidateDebugProfile';
+procedure NWBumpFunctionCount(name:Pchar);cdecl;external 'clib' name 'NWBumpFunctionCount';
+procedure NWDisplayBinaryAtAddr(addr:pointer);cdecl;external 'clib' name 'NWDisplayBinaryAtAddr';
+procedure NWDisplayDoubleAtAddr(addr:pointer);cdecl;external 'clib' name 'NWDisplayDoubleAtAddr';
+procedure NWDisplayLConvAtAddr(lc:pointer);cdecl;external 'clib' name 'NWDisplayLConvAtAddr';
+procedure NWDisplayStringAtAddr(s:Pchar; len:longint);cdecl;external 'clib' name 'NWDisplayStringAtAddr';
+procedure NWDisplayTMAtAddr(t:pointer);cdecl;external 'clib' name 'NWDisplayTMAtAddr';
+procedure NWDisplayUnicodeAtAddr(s:pointer; len:longint);cdecl;external 'clib' name 'NWDisplayUnicodeAtAddr';
+procedure NWEnableDebugProfile(flag:longint);cdecl;external 'clib' name 'NWEnableDebugProfile';
+procedure EnterDebugger;cdecl;external 'clib' name 'EnterDebugger';
+function GetDebugSettings:longint;cdecl;external 'clib' name 'GetDebugSettings';
+procedure SetDebugSettings(Settings:longint);cdecl;external 'clib' name 'SetDebugSettings';
+function GetNLMIDFromNLMName(NLMName:PChar):longint;cdecl;external 'clib' name 'GetNLMIDFromNLMName';
+function GetDebugErrorMessage:PChar;cdecl;external 'clib' name 'GetDebugErrorMessage';
+function GetMemoryUsage(NLMID:longint):longint;cdecl;external 'clib' name 'GetMemoryUsage';
+{-nwdfs.h----------------------------------------------------------------------}
+// completion codes
+const
+ DFSFailedCompletion = -1;
+ DFSNormalCompletion = 0;
+ DFSInsufficientSpace = 1;
+ DFSVolumeSegmentDeactivated = 4;
+ DFSTruncationFailure = 16;
+ DFSHoleInFileError = 17;
+ DFSParameterError = 18;
+ DFSOverlapError = 19;
+ DFSSegmentError = 20;
+ DFSBoundryError = 21;
+ DFSInsufficientLimboFileSpace = 22;
+ DFSNotInDirectFileMode = 23;
+ DFSOperationBeyondEndOfFile = 24;
+ DFSOutOfHandles = 129;
+ DFSHardIOError = 131;
+ DFSInvalidFileHandle = 136;
+ DFSNoReadPrivilege = 147;
+ DFSNoWritePrivilege = 148;
+ DFSFileDetached = 149;
+ DFSInsufficientMemory = 150;
+ DFSInvalidVolume = 152;
+ DFSIOLockError = 162;
+
+{$PACKRECORDS C}
+type
+ PFileMapStructure = ^TFileMapStructure;
+ TFileMapStructure = record
+ fileBlock : longint;
+ volumeBlock : longint;
+ numberOfBlocks : longint;
+ end;
+
+ PVolumeInformationStructure = ^TVolumeInformationStructure;
+ TVolumeInformationStructure = record
+ VolumeAllocationUnitSizeInBytes : longint;
+ VolumeSizeInAllocationUnits : longint;
+ VolumeSectorSize : longint;
+ AllocationUnitsUsed : longint;
+ AllocationUnitsFreelyAvailable : longint;
+ AllocationUnitsInDeletedFilesNotAvailable : longint;
+ AllocationUnitsInAvailableDeletedFiles : longint;
+ NumberOfPhysicalSegmentsInVolume : longint;
+ PhysicalSegmentSizeInAllocationUnits : array[0..63] of longint;
+ end;
+
+ PDFSCallBackParameters = ^TDFSCallBackParameters;
+ TDFSCallBackParameters = record
+ localSemaphoreHandle : longint;
+ completionCode : longint;
+ end;
+
+{-------------------------------------------------------------------------
+ Definition of setSizeFlags
+ ------------------------------------------------------------------------- }
+
+const
+ SETSIZE_NON_SPARSE_FILE = $00000001; // Alloc blocks to extend the file
+ SETSIZE_NO_ZERO_FILL = $00000002; // Do not zero fill the newly allocated blocks
+ SETSIZE_UNDO_ON_ERR = $00000004; // In non sparse cases truncate back to original eof if an error occurs
+ SETSIZE_PHYSICAL_ONLY = $00000008; // Change the physical EOF only, dont change logical EOF. This means non sparse for the expand case
+ SETSIZE_LOGICAL_ONLY = $00000010; // Change only the logical EOF expand will always be sparse and truncate won't free physical blocks
+
+function DFSclose(fileHandle:longint):longint;cdecl;external 'clib' name 'DFSclose';
+function DFScreat(fileName:Pchar; permission,flagBits:longint):longint;cdecl;external 'clib' name 'DFScreat';
+function DFSExpandFile(fileHandle,fileBlockNumber,
+ numberOfBlocks,volumeBlockNumber,segmentNumber:longint):longint;cdecl;external 'clib' name 'DFSExpandFile';
+function DFSFreeLimboVolumeSpace(volumeNumber,numberOfBlocks:longint):longint;cdecl;external 'clib' name 'DFSFreeLimboVolumeSpace';
+function DFSsopen(fileName:PChar; access,share,permission,flagBits,dataStream:longint):longint;cdecl;external 'clib' name 'DFSsopen';
+function DFSRead(fileHandle,startingSector,sectorCount:longint; buffer:pointer):longint;cdecl;external 'clib' name 'DFSRead';
+function DFSRead(fileHandle,startingSector,sectorCount:longint; var buffer):longint;cdecl;external 'clib' name 'DFSRead';
+function DFSReadNoWait(fileHandle,startingSector,sectorCount:longint; buffer:pointer; callBackNode:PDFSCallBackParameters):longint;cdecl;external 'clib' name 'DFSReadNoWait';
+function DFSReadNoWait(fileHandle,startingSector,sectorCount:longint; var buffer; var callBackNode:TDFSCallBackParameters):longint;cdecl;external 'clib' name 'DFSReadNoWait';
+function DFSReturnFileMappingInformation(fileHandle,startingBlockNumber:longint; numberOfEntries:Plongint; tableSize:longint; table:PFileMapStructure):longint;cdecl;external 'clib' name 'DFSReturnFileMappingInformation';
+function DFSReturnFileMappingInformation(fileHandle,startingBlockNumber:longint; var numberOfEntries:longint; tableSize:longint; var table:TFileMapStructure):longint;cdecl;external 'clib' name 'DFSReturnFileMappingInformation';
+function DFSReturnVolumeBlockInformation(volumeNumber,startingBlockNumber,numberOfBlocks:longint; buffer:Pointer):longint;cdecl;external 'clib' name 'DFSReturnVolumeBlockInformation';
+function DFSReturnVolumeBlockInformation(volumeNumber,startingBlockNumber,numberOfBlocks:longint; var buffer):longint;cdecl;external 'clib' name 'DFSReturnVolumeBlockInformation';
+function DFSReturnVolumeMappingInformation(volumeNumber:longint; volumeInformation:PVolumeInformationStructure):longint;cdecl;external 'clib' name 'DFSReturnVolumeMappingInformation';
+function DFSSetDataSize (handle:longint; newFileSize:int64; setSizeFlags:longint):longint; cdecl;external 'clib' name 'DFSSetDataSize';
+function DFSSetEndOfFile(handle,newFileSize,returnTruncatedBlocksFlag:longint):longint;cdecl;external 'clib' name 'DFSSetEndOfFile';
+function DFSWrite(fileHandle,startingSector,sectorCount:longint; buffer:pointer):longint;cdecl;external 'clib' name 'DFSWrite';
+function DFSWrite(fileHandle,startingSector,sectorCount:longint; var buffer):longint;cdecl;external 'clib' name 'DFSWrite';
+function DFSWriteNoWait(fileHandle,startingSector,sectorCount:longint; buffer:pointer; callBackNode:PDFSCallBackParameters):longint;cdecl;external 'clib' name 'DFSWriteNoWait';
+function DFSWriteNoWait(fileHandle,startingSector,sectorCount:longint; var buffer; var callBackNode:TDFSCallBackParameters):longint;cdecl;external 'clib' name 'DFSWriteNoWait';
+{-nwdos.h----------------------------------------------------------------------}
+{$include npackon.inc}
+type
+ Pfind_t = ^Tfind_t;
+ Tfind_t = record
+ reserved : array[0..20] of char;
+ attrib : char;
+ wr_time : word;
+ wr_date : word;
+ size : longint;
+ name : array[0..12] of char;
+ end;
+
+{$include npackoff.inc}
+
+function DOSChangeFileMode(name:Pchar; attributes:Plongint; _function:longint; newAttributes:longint):longint;cdecl;external 'clib' name 'DOSChangeFileMode';
+function DOSClose(handle:longint):longint;cdecl;external 'clib' name 'DOSClose';
+function DOSCopy(NetWareFileName,DOSFileName:Pchar):longint;cdecl;external 'clib' name 'DOSCopy';
+function DOSCreate(fileName:Pchar; handle:Plongint):longint;cdecl;external 'clib' name 'DOSCreate';
+function DOSCreate(fileName:Pchar; var handle:longint):longint;cdecl;external 'clib' name 'DOSCreate';
+function DOSsopen(filename:Pchar; access,share,permission:longint):longint;cdecl;external 'clib' name 'DOSsopen';
+function DOSFindFirstFile(fileName:Pchar; searchAttributes:word; diskTransferAddress:Pfind_t):longint;cdecl;external 'clib' name 'DOSFindFirstFile';
+function DOSFindNextFile(diskTransferAddress:Pfind_t):longint;cdecl;external 'clib' name 'DOSFindNextFile';
+function DOSMkdir(__dirName:Pchar):longint;cdecl;external 'clib' name 'DOSMkdir';
+function DOSOpen(fileName:Pchar; handle:Plongint):longint;cdecl;external 'clib' name 'DOSOpen';
+function DOSOpen(fileName:Pchar; var handle:longint):longint;cdecl;external 'clib' name 'DOSOpen';
+function DOSPresent:longint;cdecl;external 'clib' name 'DOSPresent';
+function DOSRead(handle,fileOffset:longint; buffer:pointer; numberOfBytesToRead:longint; numberOfBytesRead:Plongint):longint;cdecl;external 'clib' name 'DOSRead';
+function DOSRead(handle,fileOffset:longint; var buffer; numberOfBytesToRead:longint; var numberOfBytesRead:longint):longint;cdecl;external 'clib' name 'DOSRead';
+function DOSRemove(name:Pchar):longint;cdecl;external 'clib' name 'DOSRemove';
+function DOSRename(srcName,dstName:Pchar):longint;cdecl;external 'clib' name 'DOSRename';
+function DOSRmdir(Name:Pchar):longint;cdecl;external 'clib' name 'DOSRmdir';
+function DOSSetDateAndTime(handle,date,time:longint):longint;cdecl;external 'clib' name 'DOSSetDateAndTime';
+procedure DOSShutOffFloppyDrive;cdecl;external 'clib' name 'DOSShutOffFloppyDrive';
+function DOSUnlink(Name:Pchar):longint;cdecl;external 'clib' name 'DOSUnlink';
+function DOSWrite(handle,fileOffset:longint; buffer:pointer; numberOfBytesToWrite:longint; numberOfBytesWritten:Plongint):longint;cdecl;external 'clib' name 'DOSWrite';
+function DOSWrite(handle,fileOffset:longint; var buffer; numberOfBytesToWrite:longint; var numberOfBytesWritten:longint):longint;cdecl;external 'clib' name 'DOSWrite';
+{-nwfattr.h--------------------------------------------------------------------}
+const
+ NWSH_PRE_401D_COMPAT = $80000000; // for multiple thread use, see documentation for sopen()...
+{ Attribute values for use with existing files }
+{ Normal (read/write) file }
+ _A_NORMAL = $00000000;
+ _A_RDONLY = $00000001;
+ _A_HIDDEN = $00000002;
+ _A_SYSTEM = $00000004;
+ _A_EXECUTE = $00000008;
+ _A_VOLID = $00000008; // Volume ID entry
+ _A_SUBDIR = $00000010;
+ _A_ARCH = $00000020;
+ _A_SHARE = $00000080;
+ _A_NO_SUBALLOC = $00000800; // Don't sub alloc. this file
+ _A_TRANS = $00001000; // Transactional file (TTS usable)
+ _A_READAUD = $00004000; // Read audit
+ _A_WRITAUD = $00008000; // Write audit
+ _A_IMMPURG = $00010000; // Immediate purge
+ _A_NORENAM = $00020000; // Rename inhibit
+ _A_NODELET = $00040000; // Delete inhibit
+ _A_NOCOPY = $00080000; // Copy inhibit
+ _A_FILE_MIGRATED = $00400000; // File has been migrated
+ _A_DONT_MIGRATE = $00800000; // Don't migrate this file
+ _A_IMMEDIATE_COMPRESS = $02000000; // Compress this file immediately
+ _A_FILE_COMPRESSED = $04000000; // File is compressed
+ _A_DONT_COMPRESS = $08000000; // Don't compress this file
+ _A_CANT_COMPRESS = $20000000; // Can't compress this file
+ _A_ATTR_ARCHIVE = $40000000; // Entry has had an EA modified
+ // an ownerID changed, or trustee
+ // info changed, etc.
+
+// Attribute values usable during file creation
+// Use: OR value with the file mode value to initialize the mode parameter
+ FA_NORMAL = _A_NORMAL shl 16;
+ FA_RDONLY = _A_RDONLY shl 16;
+ FA_HIDDEN = _A_HIDDEN shl 16;
+ FA_SYSTEM = _A_SYSTEM shl 16;
+ FA_EXECUTE = _A_EXECUTE shl 16;
+ FA_SUBDIR = _A_SUBDIR shl 16;
+ FA_ARCHIVE = _A_ARCH shl 16;
+ FA_SHARE = _A_SHARE shl 16;
+{ Extended file attributes values }
+ FA_TRANSAC = _A_TRANS shl 12;
+ FA_READAUD = _A_READAUD shl 12;
+ FA_WRITEAUD= _A_WRITAUD shl 12;
+ FA_IMMPURG = _A_IMMPURG shl 12;
+ FA_NORENAM = _A_NORENAM shl 12;
+ FA_NODELET = _A_NODELET shl 12;
+ FA_NOCOPY = _A_NOCOPY shl 12;
+{ Sharing values for sharable open functions }
+{ compatibility mode }
+ SH_COMPAT = $00;
+{ deny read/write mode }
+ SH_DENYRW = $10;
+{ deny write mode }
+ SH_DENYWR = $20;
+{ deny read mode }
+ SH_DENYRD = $30;
+{ deny none mode }
+ SH_DENYNO = $40;
+{ FEcreat/FEsopen flagBits parameter values used when creating a file }
+ DELETE_FILE_ON_CREATE_BIT = $0001;
+ NO_RIGHTS_CHECK_ON_CREATE_BIT = $0002;
+{ FEsopen flagBits parameter values used when opening a file }
+ FILE_WRITE_THROUGH_BIT = $00000040;
+ ENABLE_IO_ON_COMPRESSED_DATA_BIT = $00000100;
+ LEAVE_FILE_COMPRESSED_DATA_BIT = $00000200;
+ DELETE_FILE_ON_CLOSE_BIT = $00000400;
+ NO_RIGHTS_CHECK_ON_OPEN_BIT = $00010000;
+ OK_TO_OPEN_DOS_FILE = $80000000;
+{ Volume Flags used with NWGetVolumeFlags and NWSetVolumeFlags }
+ SUB_ALLOCATION_FLAG = $02; // if set sub allocation units valid on this volume
+ FILE_COMPRESSION_FLAG = $04; // if set file compression enabled on this volume
+ DATA_MIGRATION_FLAG = $08; // if set data migration is allowed on this volume
+ VOLUME_IMMEDIATE_PURGE_FLAG = $40; // if set volume is marked as immediate purge
+{ Name space values }
+ DOSNameSpace = 0;
+ MACNameSpace = 1;
+ NFSNameSpace = 2;
+ FTAMNameSpace = 3;
+ OS2NameSpace = 4;
+ LONGNameSpace = 4;
+ NTNameSpace = 5;
+ MAX_NAMESPACES = 6;
+ NWDOS_NAME_SPACE = DOSNameSpace;
+ NWMAC_NAME_SPACE = MACNameSpace;
+ NWNFS_NAME_SPACE = NFSNameSpace;
+ NWFTAM_NAME_SPACE = FTAMNameSpace;
+ NWOS2_NAME_SPACE = OS2NameSpace;
+ NWLONG_NAME_SPACE = LONGNameSpace;
+ NWNT_NAME_SPACE = NTNameSpace;
+{ Data stream values }
+ PrimaryDataStream = 0;
+ MACResourceForkDataStream = 1;
+ FTAMStructuringDataStream = 2;
+{ File path length values }
+ _MAX_PATH = 255; // maximum length of full pathname
+ _MAX_SERVER = 48; // maximum length of server name
+ _MAX_VOLUME = 16; // maximum length of volume component
+ _MAX_DRIVE = 3; // maximum length of drive component
+ _MAX_DIR = 255; // maximum length of path component
+ _MAX_FNAME = 9; // maximum length of file name component
+ _MAX_EXT = 5; // maximum length of extension component
+ _MAX_NAME = 13; // maximum length of file name
+ NAME_MAX = 12; // maximum length of file name (alternate view)
+
+{ Modify structure mask values }
+ MModifyNameBit = $0001;
+ MFileAttributesBit = $0002;
+ MCreateDateBit = $0004;
+ MCreateTimeBit = $0008;
+ MOwnerIDBit = $0010;
+ MLastArchivedDateBit = $0020;
+ MLastArchivedTimeBit = $0040;
+ MLastArchivedIDBit = $0080;
+ MLastUpdatedDateBit = $0100;
+ MLastUpdatedTimeBit = $0200;
+ MLastUpdatedIDBit = $0400;
+ MLastAccessedDateBit = $0800;
+ MInheritanceRestrictionMaskBit = $1000;
+ MMaximumSpaceBit = $2000;
+ MLastUpdatedInSecondsBit = $4000;
+{$include npackon.inc}
+type
+ PModifyStructure = ^TModifyStructure;
+ TModifyStructure = record
+ MModifyName : PBYTE;
+ MFileAttributes : longint;
+ MFileAttributesMask : longint;
+ MCreateDate : word;
+ MCreateTime : word;
+ MOwnerID : longint;
+ MLastArchivedDate : word;
+ MLastArchivedTime : word;
+ MLastArchivedID : longint;
+ MLastUpdatedDate : word;
+ MLastUpdatedTime : word;
+ MLastUpdatedID : longint;
+ MLastAccessedDate : word;
+ MInheritanceGrantMask : word;
+ MInheritanceRevokeMask : word;
+ MMaximumSpace : longint;
+ MLastUpdatedInSeconds : longint;
+ end;
+
+{$include npackoff.inc}
+
+{-nwadv.h----------------------------------------------------------------------}
+{$include npackon.inc}
+{ Resource tag signatures for AllocateResourceTag }
+
+const
+ AllocSignature = $54524C41;
+ AESProcessSignature = $50534541;
+ CacheNonMovableMemorySignature = $544D4E43;
+ ConsoleCommandSignature = $4D4F4343;
+ HardwareInterruptSignature = $50544E49;
+ InterruptTimeCallBackSignature = $524D4954;
+ SemiPermMemorySignature = $454D5053;
+ DebuggerSignature = $47554244;
+ BreakpointSignature = $54504B42;
+
+type
+ TCommandParserFunc = function (screenID : scr_t;
+ commandLine : PChar):longint;cdecl;
+ PcommandParserStructure = ^TcommandParserStructure;
+ TcommandParserStructure = record // Data structure for RegisterConsoleCommand
+ Link : PcommandParserStructure; // set by RegisterConsoleCommand
+ parseRoutine : TCommandParserFunc; // parsing routing (user defined)
+ RTag : longint; // set to resource tag
+ end;
+
+{
+ Structures and constants for RegisterForEvent function. Unless otherwise
+ noted an event does NOT call a Warn routine.
+ }
+
+const
+ EVENT_VOL_SYS_MOUNT = 0;
+{ parameter is undefined. Report Routine will be called immediately
+ after vol SYS has been mounted.
+ }
+ EVENT_VOL_SYS_DISMOUNT = 1;
+{ parameter is undefined. Warn Routine and Report Routine will be
+ called before vol SYS is dismounted.
+ }
+ EVENT_ANY_VOL_MOUNT = 2;
+{ parameter is volume number. Report Routine will be called immediately
+ after any volume is mounted.
+ }
+ EVENT_ANY_VOL_DISMOUNT = 3;
+{ parameter is volume number. Warn Routine and Report Routine will be
+ called before any volume is dismounted.
+ }
+ EVENT_DOWN_SERVER = 4;
+{ parameter is undefined. Warn Routine and Report Routine will be
+ called before the server is shut down.
+ }
+ EVENT_EXIT_TO_DOS = 7;
+{ parameter is undefined. The Report Routine will be called before the
+ server exits to DOS.
+ }
+ EVENT_MODULE_UNLOAD = 8;
+{ parameter is module handle. Warn Routine and Report Routine will be
+ called when a module is unloaded from the console command line. Only
+ the Report Routine will be called when a module unloads itself.
+ }
+ EVENT_CLEAR_CONNECTION = 9;
+{ parameter is connection number. Report Routine is called before the
+ connection is cleared.
+ }
+ EVENT_LOGIN_USER = 10;
+{ parameter is connection number. Report Routine is called after the
+ connection has been allocated.
+ }
+ EVENT_CREATE_BINDERY_OBJ = 11;
+{ parameter is object ID. Report Routine is called after the object is
+ created and entered in the bindery.
+ }
+ EVENT_DELETE_BINDERY_OBJ = 12;
+{ parameter is object ID. Report Routine is called before the object is
+ removed from the bindery.
+ }
+ EVENT_CHANGE_SECURITY = 13;
+{ parameter is a pointer a structure of type EventSecurityChangeStruct.
+ Report Routine is called after a security
+ equivalence change has occurred.
+ }
+ EVENT_ACTIVATE_SCREEN = 14;
+{ Parameter is screen ID. Report routine is called after the
+ screen becomes the active screen.
+ }
+ EVENT_UPDATE_SCREEN = 15;
+{ Parameter is screen ID. Report routine is called after a change is
+ made to the screen image.
+ }
+ EVENT_UPDATE_CURSOR = 16;
+{ Parameter is screen ID. Report routine is called after a change to
+ the cursor position or state occurs.
+ }
+ EVENT_KEY_WAS_PRESSED = 17;
+{ Parameter is undefined. Report routine is called whenever a
+ key on the keyboard is pressed (including shift/alt/control).
+ This routine is called at interrupt time.
+ }
+ EVENT_DEACTIVATE_SCREEN = 18;
+{ Parameter is screen ID. Report routine is called when the
+ screen becomes inactive.
+ }
+ EVENT_TRUSTEE_CHANGE = 19;
+{ Parameter is a pointer to type struct EventTrusteeChangeStruct. The
+ report routine is called everytime there is a change to a trustee in
+ the file system. Shouldn't sleep.
+ }
+ EVENT_OPEN_SCREEN = 20;
+{ Parameter is the screen ID for the newly created screen. The report
+ routine will be called after the screen is created.
+ }
+ EVENT_CLOSE_SCREEN = 21;
+{ Parameter is the screen ID for the screen that will be closed. The
+ report routine will be called before the screen is closed.
+ }
+ EVENT_MODIFY_DIR_ENTRY = 22;
+{ Parameter is a pointer to a structure of type EventModifyDirEntryStruct
+ which contains the modify information. The report routine will be
+ called right after the entry is changed but before the directory
+ entry is unlocked. The report routine must not go to sleep.
+ }
+ EVENT_NO_RELINQUISH_CONTROL = 23;
+{ Parameter is the running process. This will be called when the
+ timer detects that a process is hogging the processor. The report
+ routine must not sleep.
+ }
+ EVENT_THREAD_SWITCH = 25;
+{ Parameter is the threadID of the thread that was executing when the
+ thread switch occurred. The report routine will be called when the
+ new thread begins executing. The report routine must not go to sleep.
+ }
+ EVENT_MODULE_LOAD = 27;
+{ parameter is module handle. The report routine will be called
+ after a module has loaded.
+ }
+ EVENT_CREATE_PROCESS = 28;
+{ parameter is the PID of the process being created. It is called
+ after the process is created. The report routine may not sleep.
+ }
+ EVENT_DESTROY_PROCESS = 29;
+{ parameter is the PID of the process being destroyed. It is called
+ before the process is actually destroyed. The report routine may not
+ sleep.
+ }
+ EVENT_NEW_PUBLIC = 32;
+{ Parameter is a pointer to a length preceded string which is the name
+ of the new public entry point. This event may not sleep.
+ }
+ EVENT_PROTOCOL_BIND = 33;
+{ Parameter is a pointer to a structure of type EventProtocolBindStruct.
+ This event is generated every time a board is bound to a protocol.
+ This event may sleep.
+ }
+ EVENT_PROTOCOL_UNBIND = 34;
+{ Parameter is a pointer to a structure of type EventProtocolBindStruct.
+ This event is generated every time a board is unbound from a protocol.
+ This event may sleep.
+ }
+ EVENT_ALLOCATE_CONNECTION = 37;
+{ parameter is connection number. Report Routine is called after the
+ connection is allocated.
+ }
+ EVENT_LOGOUT_CONNECTION = 38;
+{ parameter is connection number. Report Routine is called before the
+ connection is logged out. The event handler may sleep.
+ }
+ EVENT_MLID_REGISTER = 39;
+{ parameter is board number. Report Routine is called after the MLID
+ is registered.
+ }
+ EVENT_MLID_DEREGISTER = 40;
+{ parameter is board number. Report Routine is called before the MLID
+ is deregistered.
+ }
+ EVENT_DATA_MIGRATION = 41;
+{ Parameter is a pointer to a structure of type EventDateMigrationInfo.
+ This event is generated when a file's data has been migrated.
+ }
+ EVENT_DATA_DEMIGRATION = 42;
+{ Parameter is a pointer to a structure of type EventDateMigrationInfo.
+ This event is generated when a file's data has been de-migrated.
+ }
+ EVENT_QUEUE_ACTION = 43;
+{ Parameter is a pointer to a structure of type EventQueueNote.
+ This event is generated when a queue is activated, deactivated,
+ created, or deleted.
+ }
+ EVENT_NETWARE_ALERT = 44;
+{ Parameter is a pointer to a structure of type EventNetwareAlertStruct.
+ This event is generated anytime the following alert calls are
+ made:
+ NetWareAlert NW 4.X
+
+ The report routine may sleep.
+ }
+ EVENT_CREATE_OBJECT = 46;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_DELETE_OBJECT = 47;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_RENAME_OBJECT = 48;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_VALUE_CHANGE = 49;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_CLOSE_FILE = 50;
+{ Parameter is a pointer to a structure of type EventCloseFileInfo. }
+ EVENT_CHANGE_TIME = 51;
+{ This event is given when the time is changed or when Time
+ Synchronization schedules a nonuniform adjustment. The parameter is
+ the UTC time (in seconds) before the time change. The current time
+ is available from the OS. Since you have no way of knowing the
+ magnitudue of the time change, nor whether it has taken place or is
+ scheduled for the next clock interrupt, you must detect the time
+ change on your own. In general, if current time is less than old
+ time, or at least two seconds ahead of old time, then the time change
+ has been applied. You must wait for one of those conditions to be
+ sure that the time change has "settled down" before you can assume
+ that the event has "happened."
+ }
+ EVENT_MOVE_OBJECT = 52;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_VALUE_ADD = 53;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_VALUE_DEL = 54;
+{ Parameter is a pointer to a structure of type EventBinderyObject
+ or EventDSObject
+ }
+ EVENT_DM_KEY_MODIFIED = 55;
+{ Parameter is a pointer to a structure of type EventDMKeyModified
+ }
+ EVENT_MODULE_UNLOADED = 56;
+{ Parameter is module handle. Report Routine will be called after the
+ NLM's exit routine has been called, after his resources have been
+ returned to the OS, and after he has been unlinked from the OS's lists.
+ The only thing left of this NLM is the memory for his load definition
+ structure, data image, and code image.
+ }
+ EVENT_REMOVE_PUBLIC = 57;
+{ Parameter is the address of the public entry point. This only happens
+ on module unload.
+ }
+ EVENT_DS_EVENT = 58;
+{ Parameter is the address of a DS defined event structure }
+ EVENT_UNICODE = 59;
+{ Parameter is the address of a UNICODE defined event structure }
+ EVENT_SFT3_SERVER_STATE = 60;
+{ Parameter is the ServerState Number
+ (Refer to messtype.h, server state codes)
+ IOEngineState 0
+ PrimaryNoSecondaryState 1
+ PrimarySyncingWithSecondaryState 2
+ PrimaryTransferingMemoryImageState 3
+ PrimaryWithSecondaryState 4
+ SecondaryTransferingMemoryImageState 5
+ SecondaryMirroredState 6
+ }
+ EVENT_SFT3_IMAGE_STATE = 61;
+{ Parameter is memory mirror state }
+{ 0 = Not mirrored }
+{ 1 = Mirrored }
+ EVENT_SFT3_PRESYNC_STATE = 62;
+{ called when the primary is about ready to synchronize }
+{ with the secondary }
+{ Parameter is unsed for now. }
+{ This event report is allowed to sleep }
+ EVENT_ALTERNATE_MOUNT_VOLUME = 63;
+{ called when NetWare is not aware of the volume name to be mounted, }
+{ Parameter is used to pass a event structure EventAlternateMountVolume. }
+{ This event report is allowed to sleep, also the return code is in the }
+{ structre, after it has been processed. }
+ EVENT_CONSOLE_CONFIG_COMMAND = 64;
+{ called when the console command CONFIG is typed on the server command }
+{ line. The event report is allowed to sleep. The console screen handle }
+{ pointer is passed as the only parameter }
+ EVENT_CONSOLE_VERSION_COMMAND = 65;
+{ called when the console command VERSION is typed on the server command }
+{ line. The event report is allowed to sleep. A pointer to the structure }
+{ struct EventConfigVersionCmdInfo to help in the displaying to the screen }
+ EVENT_PRE_LOAD_NLM = 66;
+{ called while an NLM is being loaded but before most of the work is
+ done. The data and code segments have not been allocated yet. The
+ event report is allowed to sleep. The parameter is a pointer to an
+ NLM Load File Header structure.
+ }
+ EVENT_LOW_MEMORY = 67;
+{ called when the cache memory allocator tries to allocate a cache block
+ and fails; only one event per minute will be generated. It happens
+ in conjunction with the netware alert. The event report can block.
+ The parameter is a zero. This event is mainly for OS2 based NetWare
+ so it can try to borrow memory back from OS2.
+ }
+{-----------------------------------------------------------
+ Flags for the trustee change event (EVENT_TRUSTEE_CHANGE)
+ ----------------------------------------------------------- }
+ EVENT_NEW_TRUSTEE = 1;
+ EVENT_REMOVE_TRUSTEE = 2;
+{-------------------------------------------------------------
+ Flags for the change security event (EVENT_CHANGE_SECURITY)
+ ------------------------------------------------------------- }
+ EVENT_ADD_EQUIVALENCE = 1;
+ EVENT_REMOVE_EQUIVALENCE = 2;
+{----------------------------------------------
+ Structure returned for EVENT_TRUSTEE_CHANGE
+ ---------------------------------------------- }
+{ flags are EVENT_NEW_TRUSTEE and EVENT_REMOVE_TRUSTEE }
+type
+ PEventTrusteeChangeStruct = ^TEventTrusteeChangeStruct;
+ TEventTrusteeChangeStruct = record
+ objectID : longint;
+ entryID : longint;
+ volumeNumber : longint;
+ changeFlags : longint;
+ newRights : longint;
+ end;
+
+{-----------------------------------------------
+ Structure returned for EVENT_CHANGE_SECURITY
+ ----------------------------------------------- }
+{ EVENT_ADD_EQUIVALENCE and EVENT_REMOVE_EQUIVALENCE }
+ PEventSecurityChangeStruct = ^TEventSecurityChangeStruct;
+ TEventSecurityChangeStruct = record
+ objectID : longint;
+ equivalentID : longint;
+ changeFlags : longint;
+ end;
+
+{------------------------------------------------
+ Structure returned for EVENT_MODIFY_DIR_ENTRY
+ ------------------------------------------------ }
+ PEventModifyDirEntryStruct = ^TEventModifyDirEntryStruct;
+ TEventModifyDirEntryStruct = record
+ primaryDirectoryEntry : longint;
+ nameSpace : longint;
+ modifyBits : longint;
+ modifyVector : PModifyStructure;
+ volumeNumber : longint;
+ directoryEntry : longint;
+ end;
+
+{----------------------------------------------------
+ Structure returned for EVENT_PROTOCOL_BIND & UNBIND
+ ---------------------------------------------------- }
+ PEventProtocolBindStruct = ^TEventProtocolBindStruct;
+ TEventProtocolBindStruct = record
+ boardNumber : longint;
+ protocolNumber : longint;
+ end;
+
+{----------------------------------------------------------
+ Structure returned for EVENT_DATA_MIGRATION & DEMIGRATION
+ ---------------------------------------------------------- }
+{ 255 + 1 len byte }
+ PEventDateMigrationInfo = ^TEventDateMigrationInfo;
+ TEventDateMigrationInfo = record
+ FileSystemTypeID : longint;
+ Volume : longint;
+ DOSDirEntry : longint;
+ OwnerDirEntry : longint;
+ OwnerNameSpace : longint;
+ OwnerFileName : array[0..255] of byte;
+ end;
+
+{------------------------------------------------
+ Structure returned for EVENT_QUEUE_ACTION
+ ------------------------------------------------ }
+{ 0=created, 1=deleted, 2 = activated, 3 = deactivated }
+ PEventQueueNote = ^TEventQueueNote;
+ TEventQueueNote = record
+ QAction : longint;
+ QID : longint;
+ QName : array[0..49] of byte;
+ end;
+
+{------------------------------------------------
+ Structure returned for EVENT_NETWARE_ALERT
+ ------------------------------------------------ }
+ PEventNetwareAlertStruct = ^TEventNetwareAlertStruct;
+ TEventNetwareAlertStruct = record
+ alertFlags : longint;
+ alertId : longint;
+ alertLocus : longint;
+ alertClass : longint;
+ alertSeverity : longint;
+ targetStationCount : longint;
+ targetStationList : array[0..31] of longint;
+ targetNotificationBits : longint;
+ alertParmCount : longint;
+ alertDataPtr : pointer;
+ NetWorkManagementAttributePointer : pointer;
+ alertUnused : array[0..1] of longint;
+ alertControlStringMessageNumber : longint;
+ alertControlString : array[0..255] of byte;
+ alertParameters : array[0..(256 + 256)-1] of byte;
+ alertModuleName : array[0..35] of byte;
+ alertModuleMajorVersion : longint;
+ alertModuleMinorVersion : longint;
+ alertModuleRevision : longint;
+ end;
+
+{ set to 'BIND' for bindery }
+ PEventBinderyObject = ^TEventBinderyObject;
+ TEventBinderyObject = record
+ EventObjectType : longint;
+ ObjectID : longint;
+ ObjectType : longint;
+ end;
+
+{ 'DNIB' }
+
+const
+ EventBinderySignature = $444e4942;
+{ 'CVSD' }
+ EventDSSignature = $43565344;
+{ set to 'DSVC' for directory services }
+{ add, delete, etc. }
+{ DS defined entry structure }
+type
+ PEventDSObject = ^TEventDSObject;
+ TEventDSObject = record
+ EventObjectType : longint;
+ EventType : longint;
+ entry : pointer;
+ end;
+
+ PEventCloseFileInfo = ^TEventCloseFileInfo;
+ TEventCloseFileInfo = record
+ fileHandle : longint;
+ station : longint;
+ task : longint;
+ fileHandleFlags : longint;
+ completionCode : longint;
+ end;
+
+ TreportProcedure = procedure (parameter:longint; userParameter:longint); cdecl;
+ TOutputRoutine = procedure (controlString:pointer; args:array of const); cdecl;
+ TWarnProcedure = function (OutputRoutine:TOutputRoutine; parameter,userParameter:longint):longint; cdecl;
+
+{ struct EventCloseFileInfo's fileHandleFlags }
+
+const
+ ECNotReadableBit = $00000001;
+ ECNotWriteableBit = $00000002;
+ ECWrittenBit = $00000004;
+ ECDetachedBit = $00000008;
+ ECDirectFileSystemBit = $00000020;
+ ECFileWriteThroughBit = $00000040;
+ HANDLEDCOMMAND = 0;
+ NOTMYCOMMAND = 1;
+{$include npackoff.inc}
+
+type
+ TRtag = longint;
+ PRtag = ^TRtag;
+
+function AllocateResourceTag (NLMHandle:TNlmHandle;
+ descriptionString:PChar;
+ resourceType:longint):longint;cdecl;external 'clib' name 'AllocateResourceTag';
+function DSAllocateEventTag (DSEventSignature:longint):pointer;cdecl;external 'clib' name 'DSAllocateEventTag';
+function GetCurrentOSLanguageID:longint;cdecl;external 'clib' name 'GetCurrentOSLanguageID';
+function GetFileHoleMap (handle:longint;
+ startingPosition:longint;
+ numberOfBlocks:longint;
+ replyBitMapP:PBYTE;
+ allocationUnitSizeP:Plongint):longint;cdecl;external 'clib' name 'GetFileHoleMap';
+function GetFileHoleMap (handle:longint;
+ startingPosition:longint;
+ numberOfBlocks:longint;
+ var replyBitMapP;
+ var allocationUnitSizeP:longint):longint;cdecl;external 'clib' name 'GetFileHoleMap';
+function GetSetableParameterValue (connectionNumber:longint;
+ setableParameterString:PChar;
+ returnValue:pointer):longint;cdecl;external 'clib' name 'GetSetableParameterValue';
+function GetSettableParameterValue (connectionNumber:longint;
+ setableParameterString:PBYTE;
+ returnValue:pointer):longint;cdecl;external 'clib' name 'GetSetableParameterValue'; // use this define if the misspelling is too annoying
+function GetThreadDataAreaPtr:pointer;cdecl;external 'clib' name 'GetThreadDataAreaPtr';
+function ImportSymbol(NLMHandle:TNlmHandle; symbolName:Pchar):pointer;cdecl;external 'clib' name 'ImportSymbol';
+function LoadLanguageMessageTable(messageTable:PPPchar; messageCount:Plongint; languageID:Plongint):longint;cdecl;external 'clib' name 'LoadLanguageMessageTable';
+function LoadLanguageMessageTable(var messageTable; var messageCount:longint; languageID:Plongint):longint;cdecl;external 'clib' name 'LoadLanguageMessageTable';
+function NWAddSearchPathAtEnd(searchPath:PChar; number:Plongint):longint;cdecl;external 'clib' name 'NWAddSearchPathAtEnd';
+function NWAddSearchPathAtEnd(searchPath:PChar; var number:longint):longint;cdecl;external 'clib' name 'NWAddSearchPathAtEnd';
+function NWDeleteSearchPath(searchPathNumber:longint):longint;cdecl;external 'clib' name 'NWDeleteSearchPath';
+function NWGetSearchPathElement (searchPathNumber:longint;
+ isDOSSearchPath:Plongint;
+ searchPath:PChar):longint;cdecl;external 'clib' name 'NWGetSearchPathElement';
+function NWGetSearchPathElement (searchPathNumber:longint;
+ var isDOSSearchPath:boolean;
+ searchPath:PChar):longint;cdecl;external 'clib' name 'NWGetSearchPathElement';
+function NWInsertSearchPath(searchPathNumber:longint; path:PChar):longint;cdecl;external 'clib' name 'NWInsertSearchPath';
+function RegisterConsoleCommand(newCommandParser:PcommandParserStructure):longint;cdecl;external 'clib' name 'RegisterConsoleCommand';
+function RegisterConsoleCommand(var newCommandParser:TcommandParserStructure):longint;cdecl;external 'clib' name 'RegisterConsoleCommand';
+function RegisterForEvent (eventType:longint;
+ reportProcedure:TreportProcedure;
+ warnProcedure:TwarnProcedure):longint;cdecl;external 'clib' name 'RegisterForEvent';
+function RenameLanguage (languageID:longint;
+ newLanguageName:PChar;
+ showErrorsToConsole:longint):longint;cdecl;external 'clib' name 'RenameLanguage';
+function ReturnLanguageName(languageID:longint; languageName:PChar):longint;cdecl;external 'clib' name 'ReturnLanguageName';
+procedure SaveThreadDataAreaPtr(threadDataAreaPtr:pointer);cdecl;external 'clib' name 'SaveThreadDataAreaPtr';
+ { -1 for all, COMMUNICATIONS, MEMORY, etc }
+ { 0 for first time }
+ { 0 = number, 1 = boolean, 2 = time ticks., etc }
+ { STARTUP, HIDE, etc }
+ { COMMUNICATIONS, MEMORY, etc }
+ { description string }
+function ScanSetableParameters (scanCategory:longint;
+ scanSequence:Plongint;
+ rParameterName:PBYTE;
+ rType:Plongint;
+ rFlags:Plongint;
+ rCategory:Plongint;
+ rParameterDescription:pointer;
+ rCurrentValue:pointer;
+ rLowerLimit:Plongint;
+ rUpperLimit:Plongint):longint;cdecl;external 'clib' name 'ScanSetableParameters';
+function SetCurrentOSLanguageID(newLanguageID:longint):longint;cdecl;external 'clib' name 'SetCurrentOSLanguageID';
+function SetSetableParameterValue (connectionNumber:longint;
+ setableParameterString:PBYTE;
+ newValue:pointer):longint;cdecl;external 'clib' name 'SetSetableParameterValue';
+procedure SynchronizeStart;cdecl;external 'clib' name 'SynchronizeStart';
+function UnimportSymbol (NLMHandle:TNlmHandle;
+ symbolName:Pchar):longint;cdecl;external 'clib' name 'UnimportSymbol';
+function UnRegisterConsoleCommand (commandParserToDelete:PcommandParserStructure):longint;cdecl;external 'clib' name 'UnRegisterConsoleCommand';
+function UnRegisterConsoleCommand (var commandParserToDelete:TcommandParserStructure):longint;cdecl;external 'clib' name 'UnRegisterConsoleCommand';
+function UnregisterForEvent (eventHandle:longint):longint;cdecl;external 'clib' name 'UnregisterForEvent';
+{-nwfileio.h-------------------------------------------------------------------}
+type
+ PcacheBufferStructure = ^TcacheBufferStructure;
+ TcacheBufferStructure = record
+ cacheBufferPointer : Pchar;
+ cacheBufferLength : longint;
+ completionCode : longint;
+ end;
+ TT_cacheBufferStructure = TcacheBufferStructure;
+ PT_cacheBufferStructure = ^TT_cacheBufferStructure;
+
+ PmwriteBufferStructure = ^TmwriteBufferStructure;
+ TmwriteBufferStructure = record
+ mwriteBufferPointer : Pchar;
+ mwriteBufferLength : longint;
+ reserved : longint;
+ end;
+ TT_mwriteBufferStructure = TmwriteBufferStructure;
+ PT_mwriteBufferStructure = ^TT_mwriteBufferStructure;
+
+{ NetWare additions to POSIX... }
+
+function filelength(fildes:longint):longint;cdecl;external 'clib' name 'filelength';
+function gwrite(fildes:longint; bufferP:PT_mwriteBufferStructure; numberBufs:longint; numberBufsWritten:plongint):longint;cdecl;external 'clib' name 'gwrite';
+function gwrite(fildes:longint; var buffer:TT_mwriteBufferStructure; numberBufs:longint; var numberBufsWritten:longint):longint;cdecl;external 'clib' name 'gwrite';
+function lock(fildes,offset,nbytes:longint):longint;cdecl;external 'clib' name 'lock';
+function qread(fildes:longint; buffer:pointer; len,position:longint):longint;cdecl;external 'clib' name 'qread';
+function qread(fildes:longint; var buffer; len,position:longint):longint;cdecl;external 'clib' name 'qread';
+function qwrite(fildes:longint; buffer:pointer; len,position:longint):longint;cdecl;external 'clib' name 'qwrite';
+function qwrite(fildes:longint; var buffer; len,position:longint):longint;cdecl;external 'clib' name 'qwrite';
+function setmode(fildes,mode:longint):longint;cdecl;external 'clib' name 'setmode';
+// sopen already in fcntl
+//function sopen(path:Pchar; oflag,shflag:longint; args:array of const):longint;cdecl;external 'clib' name 'sopen';
+//function sopen(path:Pchar; oflag,shflag:longint):longint;cdecl;external 'clib' name 'sopen';
+function tell(fildes:longint):longint;cdecl;external 'clib' name 'tell';
+function unlock(fildes,offset,nbytes:longint):longint;cdecl;external 'clib' name 'unlock';
+{ other NetWare file I/O utilities... }
+function AsyncRead(handle:longint;
+ startingOffset:longint;
+ numberBytesToRead:longint;
+ numberBytesRead:plongint;
+ localSemaHandle:longint;
+ cacheBufferInfo:PT_cacheBufferStructure;
+ numOfCacheBufs:plongint):longint;cdecl;external 'clib' name 'AsyncRead';
+function AsyncRead(handle:longint;
+ startingOffset:longint;
+ numberBytesToRead:longint;
+ var numberBytesRead:longint;
+ localSemaHandle:longint;
+ var cacheBufferInfo:TT_cacheBufferStructure;
+ var numOfCacheBufs:longint):longint;cdecl;external 'clib' name 'AsyncRead';
+
+procedure AsyncRelease(cacheBufferInfo:PT_cacheBufferStructure);cdecl;external 'clib' name 'AsyncRelease';
+procedure AsyncRelease(var cacheBufferInfo:TT_cacheBufferStructure);cdecl;external 'clib' name 'AsyncRelease';
+function CountComponents(pathString:PChar; len:longint):longint;cdecl;external 'clib' name 'CountComponents';
+function GetExtendedFileAttributes(pathName:Pchar; extFileAttrs:PBYTE):longint;cdecl;external 'clib' name 'GetExtendedFileAttributes';
+function GetExtendedFileAttributes(pathName:Pchar; var extFileAttrs):longint;cdecl;external 'clib' name 'GetExtendedFileAttributes';
+procedure _makepath(path,drive,dir,fname,ext:Pchar);cdecl;external 'clib' name '_makepath';
+function NWGetVolumeFlags(volume:longint; flags:plongint):longint;cdecl;external 'clib' name 'NWGetVolumeFlags';
+function NWGetVolumeFlags(volume:longint; var flags:longint):longint;cdecl;external 'clib' name 'NWGetVolumeFlags';
+function NWSetVolumeFlags(volume,flags:longint):longint;cdecl;external 'clib' name 'NWSetVolumeFlags';
+function ParsePath(path,server,volume,directories:Pchar):longint;cdecl;external 'clib' name 'ParsePath';
+// SetReaddirAttribute already defined in dirent
+//function SetReaddirAttribute(dirP:PDIR; newAttribute:dword):longint;cdecl;external 'clib' name 'SetReaddirAttribute';
+procedure _splitpath(path,drive,dir,fname,ext:Pchar);cdecl;external 'clib' name '_splitpath';
+procedure UseAccurateCaseForPaths(yesno:longint);cdecl;external 'clib' name 'UseAccurateCaseForPaths';
+procedure UnAugmentAsterisk(yesno:longint);cdecl;external 'clib' name 'UnAugmentAsterisk';
+{-nwfileeng.h------------------------------------------------------------------}
+{ values for flags parameter in FEGetOpenFileInfo()... }
+const
+ _NotReadableBit = $00000001;
+ _NotWriteableBit = $00000002;
+ _WrittenBit = $00000004;
+ _DetachedBit = $00000008;
+ _SwitchingToDirectFileSystemModeBit = $00000010;
+ _DirectFileSystemModeBit = $00000020;
+ _FileWriteThroughBit = $00000040;
+{ extra flags }
+ _DiskBlockReturnedBit = $00010000;
+ _IAmOnTheOpenFileListBit = $00020000;
+ _FileReadAuditBit = $00040000;
+ _FileWriteAuditBit = $00080000;
+ _FileCloseAuditBit = $00100000;
+ _DontFileWriteSystemAlertBit = $00200000;
+ _ReadAheadHintBit = $00400000;
+ _NotifyCompressionOnCloseBit = $00800000;
+{ extra extra flags }
+ _IsWritingCompressedBit = $01000000;
+ _HasTimeDateBit = $02000000;
+ _DoingDeCompressionBit = $04000000;
+ _NoSubAllocBit = $08000000;
+ _IsATransactionFileBit = $10000000;
+ _HasFileWritePrivilegeBit = $20000000;
+ _TTSReadAuditBit = $40000000;
+ _TTSWriteAuditBit = $80000000;
+
+type
+ TT_PathParseFunc = function (inputPath:Pchar;
+ var connectionIDp:word;
+ var volumeNumber:longint;
+ var directoryNumber:longint;
+ outPathStringP:PChar;
+ var outPathCount:longint):longint;cdecl;
+ TVolumeNameString = String [17];
+
+function FEConvertDirectoryNumber(sourceNameSpace:longint;
+ volumeNumber:longint;
+ sourceDirectoryNumber:longint;
+ destinationNameSpace:longint;
+ destinationDirectoryNumberP:Plongint):longint;cdecl;external 'clib' name 'FEConvertDirectoryNumber';
+function FEConvertDirectoryNumber(sourceNameSpace:longint;
+ volumeNumber:longint;
+ sourceDirectoryNumber:longint;
+ destinationNameSpace:longint;
+ var destinationDirectoryNumber:longint):longint;cdecl;external 'clib' name 'FEConvertDirectoryNumber';
+function FEcreat(name:Pchar; permission,flagBits:longint):longint;cdecl;external 'clib' name 'FEcreat';
+function FEFlushWrite(handle:longint):longint;cdecl;external 'clib' name 'FEFlushWrite';
+function FEGetCWDnum:longint;cdecl;external 'clib' name 'FEGetCWDnum';
+function FEGetCWVnum:longint;cdecl;external 'clib' name 'FEGetCWVnum';
+function FEGetDirectoryEntry(volumeNumber,directoryNumber:longint; pathString:PChar;
+ pathCount,desiredNameSpace:longint;
+ namespaceDirectoryStructPp:Ppointer;
+ DOSdirectoryStructPp:Ppointer):longint;cdecl;external 'clib' name 'FEGetDirectoryEntry';
+function FEGetDirectoryEntry(volumeNumber,directoryNumber:longint; pathString:PChar;
+ pathCount,desiredNameSpace:longint;
+ var namespaceDirectoryStructP:Pointer;
+ var DOSdirectoryStructP:Pointer):longint;cdecl;external 'clib' name 'FEGetDirectoryEntry';
+function FEGetEntryVersion(volumeNumber,directoryNumber:longint; pathString:PChar; pathCount:longint; version:PWORD):longint;cdecl;external 'clib' name 'FEGetEntryVersion';
+function FEGetEntryVersion(volumeNumber,directoryNumber:longint; pathString:PChar; pathCount:longint; var version:word):longint;cdecl;external 'clib' name 'FEGetEntryVersion';
+function FEGetOpenFileInfo (connection:longint;
+ handle:longint;
+ volume:Plongint;
+ directoryNumber:Plongint;
+ dataStream:Plongint;
+ flags:Plongint):longint;cdecl;external 'clib' name 'FEGetOpenFileInfo';
+function FEGetOpenFileInfo (connection:longint;
+ handle:longint;
+ var volume,directoryNumber,dataStream,flags:longint):longint;cdecl;external 'clib' name 'FEGetOpenFileInfo';
+function FEGetOpenFileInfoForNS (connection, handle:longint;
+ volume,DOSdirectoryNumber,directoryNumber:Plongint;
+ nameSpace,dataStream,flags:Plongint):longint;cdecl;external 'clib' name 'FEGetOpenFileInfoForNS';
+function FEGetOpenFileInfoForNS (connection, handle:longint;
+ var volume,DOSdirectoryNumber,directoryNumber:longint;
+ var nameSpace,dataStream,flags:longint):longint;cdecl;external 'clib' name 'FEGetOpenFileInfoForNS';
+function FEGetOriginatingNameSpace(volumeNumber,directoryNumber:longint):longint;cdecl;external 'clib' name 'FEGetOriginatingNameSpace';
+function FEMapConnsHandleToVolAndDir(connection,handle:longint; volumeNumberP,directoryNumberP:Plongint):longint;cdecl;external 'clib' name 'FEMapConnsHandleToVolAndDir';
+function FEMapConnsHandleToVolAndDir(connection,handle:longint; var volumeNumber,directoryNumber:longint):longint;cdecl;external 'clib' name 'FEMapConnsHandleToVolAndDir';
+function FEMapHandleToVolumeAndDirectory(handle:longint; volumeNumberP,directoryNumberP:PLongint):longint;cdecl;external 'clib' name 'FEMapHandleToVolumeAndDirectory';
+function FEMapHandleToVolumeAndDirectory(handle:longint; var volumeNumberP,directoryNumberP:Longint):longint;cdecl;external 'clib' name 'FEMapHandleToVolumeAndDirectory';
+function FEMapPathVolumeDirToVolumeDir(pathName:Pchar; volumeNumber,directoryNumber:longint; newVolumeNumberP,newDirectoryNumberP:Plongint):longint;cdecl;external 'clib' name 'FEMapPathVolumeDirToVolumeDir';
+function FEMapPathVolumeDirToVolumeDir(pathName:Pchar; volumeNumber,directoryNumber:longint; var newVolumeNumberP,newDirectoryNumberP:longint):longint;cdecl;external 'clib' name 'FEMapPathVolumeDirToVolumeDir';
+
+function FEMapVolumeAndDirectoryToPath(volumeNumber,directoryNumber:longint; pathString:PChar; pathCount:Plongint):longint;cdecl;external 'clib' name 'FEMapVolumeAndDirectoryToPath';
+function FEMapVolumeAndDirectoryToPath(volumeNumber,directoryNumber:longint; pathString:PChar; var pathCount:longint):longint;cdecl;external 'clib' name 'FEMapVolumeAndDirectoryToPath';
+
+function FEMapVolumeAndDirectoryToPathForNS(volumeNumber,directoryNumber:longint; nameSpace:longint; pathString:PBYTE; pathCount:Plongint):longint;cdecl;external 'clib' name 'FEMapVolumeAndDirectoryToPathForNS';
+function FEMapVolumeNumberToName(volumeNumber:longint; volumeName:PChar):longint;cdecl;external 'clib' name 'FEMapVolumeNumberToName';
+function FEMapVolumeNumberToName(volumeNumber:longint; var volumeName:TVolumeNameString):longint;cdecl;external 'clib' name 'FEMapVolumeNumberToName';
+function FEQuickClose(connection,task,fileHandle:longint):longint;cdecl;external 'clib' name 'FEQuickClose';
+function FEQuickFileLength(connection,handle:longint; fileSize:Plongint):longint;cdecl;external 'clib' name 'FEQuickFileLength';
+function FEQuickFileLength(connection,handle:longint; var fileSize:longint):longint;cdecl;external 'clib' name 'FEQuickFileLength';
+function FEQuickOpen (connection,task,volumeNumber,directoryNumber:longint;
+ pathString:PChar;
+ pathCount,nameSpace,attributeMatchBits,requestedAccessRights,dataStreamNumber:longint;
+ fileHandle:Plongint):longint;cdecl;external 'clib' name 'FEQuickOpen';
+function FEQuickOpen (connection,task,volumeNumber,directoryNumber:longint;
+ pathString:PChar;
+ pathCount,nameSpace,attributeMatchBits,requestedAccessRights,dataStreamNumber:longint;
+ var fileHandle:longint):longint;cdecl;external 'clib' name 'FEQuickOpen';
+
+function FEQuickRead (connection,handle,postition,bytesToRead:longint;
+ bytesRead:Plongint;
+ buffer:pointer):longint;cdecl;external 'clib' name 'FEQuickRead';
+function FEQuickRead (connection,handle,postition,bytesToRead:longint;
+ var bytesRead:longint;
+ var buffer):longint;cdecl;external 'clib' name 'FEQuickRead';
+
+function FEQuickWrite(connection,handle,position,bytesToWrite:longint; buffer:pointer):longint;cdecl;external 'clib' name 'FEQuickWrite';
+function FEQuickWrite(connection,handle,position,bytesToWrite:longint; var buffer):longint;cdecl;external 'clib' name 'FEQuickWrite';
+
+function FERegisterNSPathParser(normalFunc:TT_PathParseFunc):longint;cdecl;external 'clib' name 'FERegisterNSPathParser';
+function FESetCWDnum(CWDnum:longint):longint;cdecl;external 'clib' name 'FESetCWDnum';
+function FESetCWVandCWDnums(CWVnum:longint; CWDnum:longint):longint;cdecl;external 'clib' name 'FESetCWVandCWDnums';
+function FESetCWVnum(CWVnum:longint):longint;cdecl;external 'clib' name 'FESetCWVnum';
+function FESetOriginatingNameSpace(volumeNumber,directoryNumber,currentNameSpace,newNameSpace:longint):longint;cdecl;external 'clib' name 'FESetOriginatingNameSpace';
+function FEsopen(name:Pchar; access,share,permission,flagBits:longint;
+ dataStream:byte):longint;cdecl;external 'clib' name 'FEsopen';
+function NWGetDirBaseFromPath(path:Pchar; nameSpace:byte; volNum,NSDirBase,DOSDirBase:Plongint):longint;cdecl;external 'clib' name 'NWGetDirBaseFromPath';
+function NWGetDirBaseFromPath(path:Pchar; nameSpace:byte; var volNum,NSDirBase,DOSDirBase:longint):longint;cdecl;external 'clib' name 'NWGetDirBaseFromPath';
+{-nwfinfo.h--------------------------------------------------------------------}
+function FileServerFileCopy (sourceFileHandle,destinationFileHandle:longint;
+ sourceFileOffset,destinationFileOffset,numberOfBytesToCopy:longint;
+ numberOfBytesCopied:Plongint):longint;cdecl;external 'clib' name 'FileServerFileCopy';
+function FileServerFileCopy (sourceFileHandle,destinationFileHandle:longint;
+ sourceFileOffset,destinationFileOffset,numberOfBytesToCopy:longint;
+ var numberOfBytesCopied:longint):longint;cdecl;external 'clib' name 'FileServerFileCopy';
+
+function NWGetCompressedFileLengths (handle:longint;
+ uncompressedLength,
+ compressedLength:Plongint):longint;cdecl;external 'clib' name 'NWGetCompressedFileLengths';
+function NWGetCompressedFileLengths (handle:longint;
+ var uncompressedLength,
+ compressedLength:longint):longint;cdecl;external 'clib' name 'NWGetCompressedFileLengths';
+
+function NWGetDiskIOsPending:longint;cdecl;external 'clib' name 'NWGetDiskIOsPending';
+function NWSetCompressedFileLengths (handle,
+ uncompressedLength,
+ compressedLengt:longint):longint;cdecl;external 'clib' name 'NWSetCompressedFileLengths';
+
+function PurgeErasedFile(pathName:Pchar; sequenceNumber:longint):longint;cdecl;external 'clib' name 'PurgeErasedFile';
+function SalvageErasedFile(pathName:Pchar; sequenceNumber:longint; newFileName:Pchar):longint;cdecl;external 'clib' name 'SalvageErasedFile';
+
+function ScanErasedFiles_411 (path : PChar;
+ nextEntryNumber: Plongint;
+ deletedFileInfo: PDIR):longint; cdecl;external 'clib' name 'ScanErasedFiles_411';
+function ScanErasedFiles_411 (path : PChar;
+ var nextEntryNumber: longint;
+ var deletedFileInfo: TDIR):longint; cdecl;external 'clib' name 'ScanErasedFiles_411';
+
+function SetExtendedFileAttributes(pathName:Pchar; extendedFileAttributes:byte):longint;cdecl;external 'clib' name 'SetExtendedFileAttributes';
+function SetFileInfo(pathName:Pchar; searchAttributes:byte; fileAttributes:longint; creationDate:Pchar; lastAccessDate:Pchar;
+ lastUpdateDateAndTime:Pchar; lastArchiveDateAndTime:Pchar; fileOwnerID:longint):longint;cdecl;external 'clib' name 'SetFileInfo';
+{-nwfshook.h-------------------------------------------------------------------}
+{ ------------ File System Monitor Hook Call Back Numbers ------------
+ The defined constants below that have _GEN_ in the name represent call back
+ numbers that will hook Generic versions of the respective OS routines.
+ Namely, routines that support Name Spaces other than DOS.
+ --------------------------------------------------------------------- }
+
+const
+ FSHOOK_PRE_ERASEFILE = 0;
+ FSHOOK_PRE_OPENFILE = 1;
+ FSHOOK_PRE_CREATEFILE = 2;
+ FSHOOK_PRE_CREATE_OPENFILE = 3;
+ FSHOOK_PRE_RENAME_OR_MOVE = 4;
+ FSHOOK_PRE_CLOSEFILE = 5;
+ FSHOOK_PRE_CREATEDIR = 6;
+ FSHOOK_PRE_DELETEDIR = 7;
+ FSHOOK_PRE_MODIFY_DIRENTRY = 8;
+ FSHOOK_PRE_SALVAGE_DELETED = 9;
+ FSHOOK_PRE_PURGE_DELETED = 10;
+ FSHOOK_PRE_RENAME_NS_ENTRY = 11;
+ FSHOOK_PRE_GEN_SALVAGE_DELETED = 12;
+ FSHOOK_PRE_GEN_PURGE_DELETED = 13;
+ FSHOOK_PRE_GEN_OPEN_CREATE = 14;
+ FSHOOK_PRE_GEN_RENAME = 15;
+ FSHOOK_PRE_GEN_ERASEFILE = 16;
+ FSHOOK_PRE_GEN_MODIFY_DOS_INFO = 17;
+ FSHOOK_PRE_GEN_MODIFY_NS_INFO = 18;
+ FSHOOK_POST_ERASEFILE = $80000000;
+ FSHOOK_POST_OPENFILE = $80000001;
+ FSHOOK_POST_CREATEFILE = $80000002;
+ FSHOOK_POST_CREATE_OPENFILE = $80000003;
+ FSHOOK_POST_RENAME_OR_MOVE = $80000004;
+ FSHOOK_POST_CLOSEFILE = $80000005;
+ FSHOOK_POST_CREATEDIR = $80000006;
+ FSHOOK_POST_DELETEDIR = $80000007;
+ FSHOOK_POST_MODIFY_DIRENTRY = $80000008;
+ FSHOOK_POST_SALVAGE_DELETED = $80000009;
+ FSHOOK_POST_PURGE_DELETED = $8000000A;
+ FSHOOK_POST_RENAME_NS_ENTRY = $8000000B;
+ FSHOOK_POST_GEN_SALVAGE_DELETED = $8000000C;
+ FSHOOK_POST_GEN_PURGE_DELETED = $8000000D;
+ FSHOOK_POST_GEN_OPEN_CREATE = $8000000E;
+ FSHOOK_POST_GEN_RENAME = $8000000F;
+ FSHOOK_POST_GEN_ERASEFILE = $80000010;
+ FSHOOK_POST_GEN_MODIFY_DOS_INFO = $80000011;
+ FSHOOK_POST_GEN_MODIFY_NS_INFO = $80000012;
+
+ {--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_ERASEFILE and FSHOOK_POST_ERASEFILE
+ -------------------------------------------------------------------- }
+type
+
+ PEraseFileCallBackStruct = ^TEraseFileCallBackStruct;
+ TEraseFileCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : Pchar;
+ pathComponentCount,
+ nameSpace,
+ attributeMatchBits : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_OPENFILE and FSHOOK_POST_OPENFILE
+ -------------------------------------------------------------------- }
+
+ POpenFileCallBackStruct = ^TOpenFileCallBackStruct;
+ TOpenFileCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : Pchar;
+ pathComponentCount,
+ nameSpace,
+ attributeMatchBits,
+ requestedAccessRights,
+ dataStreamNumber : Longint;
+ fileHandle : PLongint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_CREATEFILE and FSHOOK_POST_CREATEFILE
+ -------------------------------------------------------------------- }
+
+ PCreateFileCallBackStruct = ^TCreateFileCallBackStruct;
+ TCreateFileCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : Pchar;
+ pathComponentCount,
+ nameSpace,
+ createAttributeBits,
+ createFlagBits,
+ dataStreamNumber : Longint;
+ fileHandle : PLongint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_CREATE_OPENFILE and FSHOOK_POST_CREATE_OPENFILE
+ -------------------------------------------------------------------- }
+
+ PCreateAndOpenCallBackStruct = ^TCreateAndOpenCallBackStruct;
+ TCreateAndOpenCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : Pchar;
+ pathComponentCount,
+ nameSpace,
+ createAttributeBits,
+ requestedAccessRights,
+ createFlagBits,
+ dataStreamNumber : Longint;
+ fileHandle : PLongint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_RENAME_OR_MOVE and FSHOOK_POST_RENAME_OR_MOVE
+ -------------------------------------------------------------------- }
+
+ PRenameMoveEntryCallBackStruct = ^TRenameMoveEntryCallBackStruct;
+ TRenameMoveEntryCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : Pchar;
+ pathComponentCount,
+ nameSpace,
+ attributeMatchBits,
+ subDirsOnlyFlag,
+ newDirBase : Longint;
+ newPathString : Pchar;
+ originalNewCount,
+ compatibilityFlag,
+ allowRenamesToMyselfFlag: Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_CLOSEFILE and FSHOOK_POST_CLOSEFILE
+ -------------------------------------------------------------------- }
+
+ PCloseFileCallBackStruct = ^TCloseFileCallBackStruct;
+ TCloseFileCallBackStruct = record
+ connection,
+ task,
+ fileHandle : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_CREATEDIR and FSHOOK_POST_CREATEDIR
+-------------------------------------------------------------------- }
+
+ PCreateDirCallBackStruct = ^TCreateDirCallBackStruct;
+ TCreateDirCallBackStruct = record
+ connection,
+ volume,
+ dirBase : Longint;
+ pathString : Pchar;
+ pathComponentCount,
+ nameSpace,
+ directoryAccessMask : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_DELETEDIR and FSHOOK_POST_DELETEDIR
+ -------------------------------------------------------------------- }
+
+ PDeleteDirCallBackStruct = ^TDeleteDirCallBackStruct;
+ TDeleteDirCallBackStruct = record
+ connection,
+ volume,
+ dirBase : Longint;
+ pathString : PChar;
+ pathComponentCount,
+ nameSpace : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_MODIFYDIRENTRY and FSHOOK_POST_MODIFYDIRENTRY
+ -------------------------------------------------------------------- }
+
+ PModifyDirEntryCallBackStruct = ^TModifyDirEntryCallBackStruct;
+ TModifyDirEntryCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : PChar;
+ pathComponentCount,
+ nameSpace,
+ attributeMatchBits,
+ targetNameSpace : Longint;
+ modifyVector : PModifyStructure;
+ modifyBits,
+ allowWildCardsFlag : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_SALVAGE_DELETED and FSHOOK_POST_SALVAGE_DELETED
+ -------------------------------------------------------------------- }
+
+ PSalvageDeletedCallBackStruct = ^TSalvageDeletedCallBackStruct;
+ TSalvageDeletedCallBackStruct = record
+ connection,
+ volume,
+ dirBase,
+ toBeSalvagedDirBase,
+ nameSpace : Longint;
+ newName : PChar;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_PURGE_DELETED and FSHOOK_POST_PURGE_DELETED
+ -------------------------------------------------------------------- }
+
+ PPurgeDeletedCallBackStruct = ^TPurgeDeletedCallBackStruct;
+ TPurgeDeletedCallBackStruct = record
+ connection,
+ volume,
+ dirBase,
+ toBePurgedDirBase,
+ nameSpace : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_RENAME_NS_ENTRY and FSHOOK_POST_RENAME_NS_ENTRY
+ -------------------------------------------------------------------- }
+
+ PRenameNSEntryCallBackStruct = ^TRenameNSEntryCallBackStruct;
+ TRenameNSEntryCallBackStruct = record
+ connection,
+ task,
+ volume,
+ dirBase : Longint;
+ pathString : PChar;
+ pathComponentCount,
+ nameSpace,
+ matchBits : Longint;
+ newName : PChar;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_SALVAGE_DELETED and FSHOOK_POST_GEN_SALVAGE_DELETED
+ -------------------------------------------------------------------- }
+
+ PGenericSalvageDeletedCBStruct = ^TGenericSalvageDeletedCBStruct;
+ TGenericSalvageDeletedCBStruct = record
+ connection,
+ nameSpace,
+ sequence,
+ volume,
+ dirBase : Longint;
+ newName : PChar;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_PURGE_DELETED and FSHOOK_POST_GEN_PURGE_DELETED
+ -------------------------------------------------------------------- }
+
+ PGenericPurgeDeletedCBStruct = ^TGenericPurgeDeletedCBStruct;
+ TGenericPurgeDeletedCBStruct = record
+ connection,
+ nameSpace,
+ sequence,
+ volume,
+ dirBase : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_OPEN_CREATE and FSHOOK_POST_GEN_OPEN_CREATE
+ -------------------------------------------------------------------- }
+
+ PGenericOpenCreateCBStruct = ^TGenericOpenCreateCBStruct;
+ TGenericOpenCreateCBStruct = record
+ connection,
+ task,
+ volume,
+ pathComponentCount,
+ dirBase : Longint;
+ pathString : Pchar;
+ nameSpace,
+ dataStreamNumber,
+ openCreateFlags,
+ searchAttributes,
+ createAttributes,
+ requestedAccessRights,
+ returnInfoMask : Longint;
+ fileHandle : PLongint;
+ openCreateAction : Pointer;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_RENAME and FSHOOK_POST_GEN_RENAME
+ -------------------------------------------------------------------- }
+
+ PGenericRenameCBStruct = ^TGenericRenameCBStruct;
+ TGenericRenameCBStruct = record
+ connection,
+ task,
+ nameSpace,
+ renameFlag,
+ searchAttributes,
+ srcVolume,
+ srcPathComponentCount,
+ srcDirBase : Longint;
+ srcPathString : Pchar;
+ dstVolume,
+ dstPathComponentCount,
+ dstDirBase : Longint;
+ dstPathString : Pchar;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_ERASEFILE and FSHOOK_POST_GEN_ERASEFILE
+ -------------------------------------------------------------------- }
+
+ PGenericEraseFileCBStruct = ^TGenericEraseFileCBStruct;
+ TGenericEraseFileCBStruct = record
+ connection,
+ task,
+ volume,
+ pathComponentCount,
+ dirBase : Longint;
+ pathString : Pchar;
+ nameSpace,
+ searchAttributes : Longint;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_MODIFY_DOS_INFO and FSHOOK_POST_GEN_MODIFY_DOS_INFO
+ -------------------------------------------------------------------- }
+
+ PGenericModifyDOSInfoCBStruct = ^TGenericModifyDOSInfoCBStruct;
+ TGenericModifyDOSInfoCBStruct = record
+ connection,
+ task,
+ volume,
+ pathComponentCount,
+ dirBase : Longint;
+ pathString : Pchar;
+ nameSpace : Longint;
+ searchAttributes : Longint;
+ modifyMask : Longint;
+ modifyInfo : pointer;
+ end;
+{--------------------------------------------------------------------
+ Structure returned for
+ FSHOOK_PRE_GEN_MODIFY_NS_INFO and FSHOOK_POST_GEN_MODIFY_NS_INFO
+-------------------------------------------------------------------- }
+
+ PGenericModifyNSInfoCBStruct = ^TGenericModifyNSInfoCBStruct;
+ TGenericModifyNSInfoCBStruct = record
+ connection,
+ task,
+ dataLength,
+ srcNameSpace,
+ dstNameSpace,
+ volume,
+ dirBase,
+ modifyMask : Longint;
+ modifyInfo : pointer;
+ end;
+
+function NWAddFSMonitorHook (callBackNumber:Longint;
+ callBackFunc:pointer;
+ callBackHandle:PLongint):Longint;cdecl;external 'clib' name 'NWAddFSMonitorHook';
+function NWAddFSMonitorHook (callBackNumber:Longint;
+ callBackFunc:pointer;
+ var callBackHandle:Longint):Longint;cdecl;external 'clib' name 'NWAddFSMonitorHook';
+function NWRemoveFSMonitorHook (callBackNumber,callBackHandle:Longint):Longint;cdecl;external 'clib' name 'NWRemoveFSMonitorHook';
+{-nwipx.h----------------------------------------------------------------------}
+{$include npackon.inc}
+{ ECB status field completion codes }
+
+const
+ STS_SPX_CONNECTION_TERMINATED = $FFEC;
+ STS_SPX_TERMINATED_POORLY = $FFED;
+ STS_SPX_INVALID_CONNECTION = $FFEE;
+ STS_SPX_CONNECTION_TABLE_FULL = $FFEF;
+ STS_SPX_SOCKET_NOT_OPEN = $FFF0;
+ STS_SPX_SOCKET_ALREADY_OPEN = $FFF1;
+ STS_SPX_ECB_CANNOT_BE_CANCELLED = $FFF9;
+ STS_SPX_NO_KNOWN_ROUTE_TO_DESTINATION = $FFFA;
+ STS_SPX_EVENT_CANCELLED = $FFFC;
+ STS_SPX_PACKET_OVERFLOW = $FFFD;
+ STS_SPX_MALFORMED_PACKET = $FFFE;
+ STS_SPX_TRANSMIT_FAILURE = $FFFF;
+
+ SPX_SSTATUS_ABORTED = $00;
+ SPX_SSTATUS_WAITING = $01;
+ SPX_SSTATUS_STARTING = $02;
+ SPX_SSTATUS_ESTABLISHED = $03;
+ SPX_SSTATUS_TERMINATING = $04;
+
+
+{
+ This define is for the Queued IPX/SPX Calls. The return code passed in will
+ be set to this value until the packet is actually sent to IPX/SPX.
+ }
+ PACKET_IN_QUEUE = $0001;
+{---------------------------------------------------------------------------
+
+ IPX_ECB status field busy (in-process) codes:
+
+ 0x11 - AES (asynchronous event service) waiting
+ 0x12 - Holding
+ 0x13 - Session listen
+ 0x14 - Processing
+ 0x15 - Receiving
+ 0x16 - Sending
+ 0x17 - Waiting
+
+ -------------------------------------------------------------------------- }
+{---------------------------------------------------------------------------
+ The comment characters in the IPX_ECB structure have the
+ following meanings
+ s - this field must be filled in prior to a send
+ r - this field must be filled in prior to a receive
+ R - this field is reserved
+ A - this field may be used when the ECB is not in use by IPX/SPX
+ q - the application may read this field
+ -------------------------------------------------------------------------- }
+{ Packet type codes }
+ UNKNOWN_PACKET_TYPE = 0;
+ ROUTING_INFORMATION_PACKET = 1;
+ ECHO_PACKET = 2;
+ ERROR_PACKET = 3;
+ PACKET_EXCHANGE_PACKET = 4;
+ SEQUENCED_PACKET_PROTOCOL_PACKET = 5;
+
+ SPX_END_OF_MESSAGE = $10;
+ ENABLE_WATCHDOG = $ff;
+
+{ various SAP definitions }
+
+ SAP_SOCKET = $0452;
+ GENERAL_SERVICE_QUERY = 1;
+ GENERAL_SERVICE_RESPONSE = 2;
+ NEAREST_SERVICE_QUERY = 3;
+ NEAREST_SERVICE_RESPONSE = 4;
+ PERIODIC_ID_PACKET = 2;
+ NOT_SUPPORTED = 1;
+ INVALID_QUERY_TYPE = 2;
+ SAP_RESPONSES_PER_PACKET = 8;
+{ 'ELRS' }
+ QUERY_LIST_SIGNATURE = $454C5253;
+{ type definitions }
+type
+ TMisalignedLONG = longint;
+ TMisalignedWORD = word;
+
+ PtagECBFrag = ^TtagECBFrag;
+ TtagECBFrag = record
+ fragAddress : pointer;
+ fragSize : longint;
+ end;
+ TECBFrag = TtagECBFrag;
+ PECBFrag = ^TECBFrag;
+
+ PIPX_ECBStruct = ^TIPX_ECBStruct;
+ TIPX_ECBStruct = record
+ semHandleSave : longint;
+ queueHead : ^PIPX_ECBStruct;
+ next : PIPX_ECBStruct;
+ prev : PIPX_ECBStruct;
+ status : word;
+ semHandle : longint;
+ lProtID : word;
+ protID : array[0..5] of byte;
+ boardNumber : longint;
+ immediateAddress : array[0..5] of byte;
+ driverWS : array[0..3] of byte;
+ ESREBXValue : longint;
+ socket : word;
+ protocolWorkspace : word;
+ dataLen : longint;
+ fragCount : longint;
+ fragList : array[0..1] of TECBFrag;
+ end;
+ TIPX_ECB = TIPX_ECBStruct;
+ PIPX_ECB = ^TIPX_ECB;
+ PPIPX_ECB = ^PIPX_ECB;
+
+ TSPX_ECB = TIPX_ECBStruct;
+ PSPX_ECB = PIPX_ECBStruct;
+
+
+ PtagInternetAddress = ^TtagInternetAddress;
+ TtagInternetAddress = record
+ network : TMisalignedLONG;
+ node : array[0..5] of byte;
+ socket : TMisalignedWORD;
+ end;
+ TInternetAddress = TtagInternetAddress;
+ PInternetAddress = ^TInternetAddress;
+
+ PtagIPX_HEADER = ^TtagIPX_HEADER;
+ TtagIPX_HEADER = record
+ checksum : word;
+ packetLen : word;
+ transportCtl: byte;
+ packetType : byte;
+ destNet : TMisalignedLONG;
+ destNode : array[0..5] of byte;
+ destSocket : word;
+ sourceNet : TMisalignedLONG;
+ sourceNode : array[0..5] of byte;
+ sourceSocket: word;
+ end;
+ TIPX_HEADER = TtagIPX_HEADER;
+ PIPX_HEADER = ^TIPX_HEADER;
+{ included only for compatibility }
+
+ PtagIPX_STATS = ^TtagIPX_STATS;
+ TtagIPX_STATS = record
+ dummy : char;
+ end;
+ TIPX_STATS = TtagIPX_STATS;
+ PIPX_STATS = ^TIPX_STATS;
+
+ PtagSPX_HEADER = ^TtagSPX_HEADER;
+ TtagSPX_HEADER = record
+ checksum : word;
+ packetLen : word;
+ transportCtl : byte;
+ packetType : byte;
+ destNet : TMisalignedLONG;
+ destNode : array[0..5] of byte;
+ destSocket : word;
+ sourceNet : TMisalignedLONG;
+ sourceNode : array[0..5] of byte;
+ sourceSocket : word;
+ connectionCtl : byte;
+ dataStreamType : byte;
+ sourceConnectID : word;
+ destConnectID : word;
+ sequenceNumber : word;
+ ackNumber : word;
+ allocNumber : word;
+ end;
+ TSPX_HEADER = TtagSPX_HEADER;
+ PSPX_HEADER = ^TSPX_HEADER;
+
+ PSPX_ConnStruct = ^TSPX_ConnStruct;
+ TSPX_ConnStruct = record
+ sStatus : byte;
+ sFlags : byte;
+ sSourceConnectID : word;
+ sDestConnectID : word;
+ sSequenceNumber : word;
+ sAckNumber : word;
+ sAllocNumber : word;
+ sRemoteAckNumber : word;
+ sRemoteAllocNumber : word;
+ sLocalSocket : word;
+ sImmediateAddress : array[0..5] of byte;
+ sRemoteNet : longint;
+ sRemoteNode : array[0..5] of byte;
+ sRemoteSocket : word;
+ sRetransmitCount : byte;
+ sRetransmitMax : byte;
+ sRoundTripTimer : word;
+ sRetransmittedPackets : word;
+ sSuppressedPackets : word;
+ sLastReceiveTime : word;
+ sLastSendTime : word;
+ sRoundTripMax : word;
+ sWatchdogTimeout : word;
+ sSessionXmitQHead : array[0..3] of byte;
+ sSessionXmitECBp : array[0..3] of byte;
+ end;
+ TSPX_SESSION = TSPX_ConnStruct;
+ PSPX_SESSION = ^TSPX_SESSION;
+
+
+type
+
+ PT_SAP_ID_PACKET = ^TT_SAP_ID_PACKET;
+ TT_SAP_ID_PACKET = record
+ SAPPacketType : word; // 2 or 4
+ serverType : word; // assigned by novell
+ serverName : array[0..47] of byte; // Service name
+ serverAddress : TInternetAddress;
+ interveningNetworks : word; // # of networks packets must pass
+ end;
+
+ PSERVICE_QUERY_PACKET = ^TSERVICE_QUERY_PACKET;
+ TSERVICE_QUERY_PACKET = record
+ queryType, // 1 or 3
+ serverType : word; // assigned by novell
+ end;
+
+ PSAPResponse = ^TSAPResponse;
+ TSAPResponse = record
+ SAPPacketType : word; // 2 or 4
+ responses : array[0..(SAP_RESPONSES_PER_PACKET)-1] of record
+ serverType : word;
+ serverName : array[0..47] of byte;
+ serverAddress : TInternetAddress;
+ interveningNetworks : word;
+ end;
+ next : PSAPResponse;
+ signature : longint;
+ count : longint;
+ end;
+ TSAP_RESPONSE_LIST_ENTRY = TSAPResponse;
+ PSAP_RESPONSE_LIST_ENTRY = ^TSAP_RESPONSE_LIST_ENTRY;
+{$include npackoff.inc}
+
+
+{ IPX function prototypes... }
+
+function IpxCheckSocket(socket:word):longint;cdecl;external 'clib' name 'IpxCheckSocket';
+function IpxCancelEvent(ECBp:PIPX_ECB):longint;cdecl;external 'clib' name 'IpxCancelEvent';
+function IpxCloseSocket(socket:word):longint;cdecl;external 'clib' name 'IpxCloseSocket';
+function IpxConnect(ECBp:PIPX_ECB):longint;cdecl;external 'clib' name 'IpxConnect';
+function IpxDisconnect(ECBp:PIPX_ECB):longint;cdecl;external 'clib' name 'IpxDisconnect';
+function IpxGetAndClearQ(replyQptr:PPIPX_ECB):PIPX_ECB;cdecl;external 'clib' name 'IpxGetAndClearQ';
+function IpxGetInternetworkAddress(address:PBYTE):longint;cdecl;external 'clib' name 'IpxGetInternetworkAddress';
+function IpxGetLocalTarget(address:PBYTE; ECBp:PIPX_ECB; timeToNet:Plongint):longint;cdecl;external 'clib' name 'IpxGetLocalTarget';
+function IpxGetStatistics(ipxStats:PIPX_STATS):longint;cdecl;external 'clib' name 'IpxGetStatistics';
+function IpxGetVersion(majorVersion:PBYTE; minorVersion:PBYTE; revision:PWORD):longint;cdecl;external 'clib' name 'IpxGetVersion';
+function IpxGetVersion(var majorVersion,minorVersion:byte; var revision:word):longint;cdecl;external 'clib' name 'IpxGetVersion';
+function IpxOpenSocket(socketP:PWORD):longint;cdecl;external 'clib' name 'IpxOpenSocket';
+function IpxOpenSocket(var socket:word):longint;cdecl;external 'clib' name 'IpxOpenSocket';
+function IpxQueuedSend(socket:word; ECBp:PIPX_ECB; rcode:Plongint):longint;cdecl;external 'clib' name 'IpxQueuedSend';
+function IpxQueuedSend(socket:word; ECBp:PIPX_ECB; var rcode:longint):longint;cdecl;external 'clib' name 'IpxQueuedSend';
+function IpxQueuedReceive(socket:word; ECBp:PIPX_ECB; rcode:Plongint):longint;cdecl;external 'clib' name 'IpxQueuedReceive';
+function IpxQueuedReceive(socket:word; ECBp:PIPX_ECB; var rcode:longint):longint;cdecl;external 'clib' name 'IpxQueuedReceive';
+function IpxReceive(socket:word; ECBp:PIPX_ECB):longint;cdecl;external 'clib' name 'IpxReceive';
+function IpxResetStatistics:longint;cdecl;external 'clib' name 'IpxResetStatistics';
+function IpxSend(socket:word; ECBp:PIPX_ECB):longint;cdecl;external 'clib' name 'IpxSend';
+{ SPX function prototypes... }
+function SpxAbortConnection(connection:word):longint;cdecl;external 'clib' name 'SpxAbortConnection';
+function SpxCancelEvent(ecb:PSPX_ECB):longint;cdecl;external 'clib' name 'SpxCancelEvent';
+function SpxCheckSocket(socket:word):longint;cdecl;external 'clib' name 'SpxCheckSocket';
+function SpxCloseSocket(socket:word):longint;cdecl;external 'clib' name 'SpxCloseSocket';
+function SpxEstablishConnection(socket:word; ecb:PSPX_ECB; retryCount:byte; watchDogFlag:byte; connection:PWORD):longint;cdecl;external 'clib' name 'SpxEstablishConnection';
+function SpxEstablishConnection(socket:word; ecb:PSPX_ECB; retryCount:byte; watchDogFlag:byte; var connection:word):longint;cdecl;external 'clib' name 'SpxEstablishConnection';
+function SpxGetConfiguration(maxConn,availConn:Plongint):longint;cdecl;external 'clib' name 'SpxGetConfiguration';
+function SpxGetConfiguration(var maxConn,availConn:longint):longint;cdecl;external 'clib' name 'SpxGetConfiguration';
+function SpxGetConnectionStatus(connection:word; buffer:PSPX_SESSION):longint;cdecl;external 'clib' name 'SpxGetConnectionStatus';
+{ (56 bytes) }
+function SpxGetTime(marker:Plongint):longint;cdecl;external 'clib' name 'SpxGetTime';
+function SpxGetTime(var marker:longint):longint;cdecl;external 'clib' name 'SpxGetTime';
+function SpxGetVersion(major,minor:PBYTE; revision:PWORD; revDate:Plongint):longint;cdecl;external 'clib' name 'SpxGetVersion';
+function SpxGetVersion(var major,minor:byte; var revision:word; var revDate:longint):longint;cdecl;external 'clib' name 'SpxGetVersion';
+function SpxListenForConnection(socket:word; ecb:PSPX_ECB; retryCount:byte; watchDogFlag:byte; connection:PWORD):longint;cdecl;external 'clib' name 'SpxListenForConnection';
+function SpxListenForConnection(socket:word; ecb:PSPX_ECB; retryCount:byte; watchDogFlag:byte; var connection:word):longint;cdecl;external 'clib' name 'SpxListenForConnection';
+function SpxListenForConnectedPacket(socket:word; ecb:PSPX_ECB; connection:word):longint;cdecl;external 'clib' name 'SpxListenForConnectedPacket';
+function SpxListenForSequencedPacket(socket:word; ecb:PSPX_ECB):longint;cdecl;external 'clib' name 'SpxListenForSequencedPacket';
+function SpxOpenSocket(socket:PWORD):longint;cdecl;external 'clib' name 'SpxOpenSocket';
+function SpxOpenSocket(var socket:word):longint;cdecl;external 'clib' name 'SpxOpenSocket';
+function SpxQueuedListenForSequencedPacket(socket:word; ecb:PSPX_ECB; rcode:Plongint):longint;cdecl;external 'clib' name 'SpxQueuedListenForSequencedPacket';
+function SpxQueuedListenForSequencedPacket(socket:word; ecb:PSPX_ECB; var rcode:longint):longint;cdecl;external 'clib' name 'SpxQueuedListenForSequencedPacket';
+function SpxQueuedSendSequencedPacket(connection:word; ecb:PSPX_ECB; rcode:Plongint):longint;cdecl;external 'clib' name 'SpxQueuedSendSequencedPacket';
+function SpxQueuedSendSequencedPacket(connection:word; ecb:PSPX_ECB; var rcode:longint):longint;cdecl;external 'clib' name 'SpxQueuedSendSequencedPacket';
+function SpxSendSequencedPacket(connection:word; ecb:PSPX_ECB):longint;cdecl;external 'clib' name 'SpxSendSequencedPacket';
+function SpxTerminateConnection(connection:word; ecb:PSPX_ECB):longint;cdecl;external 'clib' name 'SpxTerminateConnection';
+{ SAP function prototypes... }
+function AdvertiseService(serviceType:word; serviceName:Pchar; serviceSocket:word):longint;cdecl;external 'clib' name 'AdvertiseService';
+function FreeQueryServicesList(listP:PSAP_RESPONSE_LIST_ENTRY):longint;cdecl;external 'clib' name 'FreeQueryServicesList';
+function QueryServices(queryType,serviceType:word):PSAP_RESPONSE_LIST_ENTRY;cdecl;external 'clib' name 'QueryServices';
+function ShutdownAdvertising(advertisingHandle:longint):longint;cdecl;external 'clib' name 'ShutdownAdvertising';
+{-nwlib.h----------------------------------------------------------------------}
+type
+ TLibraryCleanupFunc = function (dataAreaPtr:pointer):longint; cdecl;
+
+function __get_thread_data_area_ptr:Plongint;cdecl;external 'clib' name '__get_thread_data_area_ptr';
+function GetDataAreaPtr(libraryHandle:longint):pointer;cdecl;external 'clib' name 'GetDataAreaPtr';
+function DeregisterLibrary(libraryHandle:longint):longint;cdecl;external 'clib' name 'DeregisterLibrary';
+function RegisterLibrary(cleanupFunc:TLibraryCleanupFunc):longint;cdecl;external 'clib' name 'RegisterLibrary';
+function SaveDataAreaPtr(libraryHandle:longint; dataAreaPtr:pointer):longint;cdecl;external 'clib' name 'SaveDataAreaPtr';
+// function Thread_Data_Area : pointer; Thread_Data_Area (*__get_thread_data_area_ptr())
+{-nwmalloc.h-------------------------------------------------------------------}
+procedure NWGarbageCollect (NLMHandle:TNlmHandle); cdecl; external 'clib' name 'NWGarbageCollect';
+function NWGetAllocPageOverhead (pageCount:longint):longint;cdecl; external 'clib' name 'NWGetAllocPageOverhead';
+function NWGetAvailableMemory : longint; cdecl; external 'clib' name 'NWGetAvailableMemory';
+function NWGetPageSize : longint; cdecl; external 'clib' name 'NWGetPageSize';
+function NWMemorySizeAddressable (addr:pointer; size:longint):longint;cdecl; external 'clib' name 'NWMemorySizeAddressable';
+function alloca (size:longint):pointer; cdecl; external 'clib' name 'alloca';
+function _msize (buffer:pointer):longint; cdecl; external 'clib' name '_msize';
+function __qcalloc (num,siz:longint):pointer; cdecl; external 'clib' name '__qcalloc';
+function __qmalloc (siz:longint):pointer; cdecl; external 'clib' name '__qmalloc';
+function __qrealloc (old:pointer; siz:longint):pointer;cdecl; external 'clib' name '__qrealloc';
+function stackavail:longint; cdecl; external 'clib' name 'stackavail';
+
+function calloc (num,siz:longint):pointer; cdecl; external 'clib' name 'calloc';
+procedure free (p:pointer); cdecl; external 'clib' name 'free';
+function malloc (siz:longint):pointer; cdecl; external 'clib' name 'malloc';
+function realloc (oldMemP:pointer;
+ newsize:longint):pointer; cdecl; external 'clib' name 'realloc';
+{-nwncpx.h---------------------------------------------------------------------}
+const
+ MAX_NCP_EXTENSION_NAME_BYTES = 33;
+ BEGIN_SCAN_NCP_EXTENSIONS = $FFFFFFFF;
+ REPLY_BUFFER_IS_FRAGGED = $FFFFFFFF;
+ CONNECTION_BEING_RESTARTED = $01101001;
+ CONNECTION_BEING_KILLED = $02202002;
+ CONNECTION_BEING_LOGGED_OUT = $03303003;
+ CONNECTION_BEING_FREED = $04404004;
+type
+ PNCPExtensionClient = ^TNCPExtensionClient;
+ TNCPExtensionClient = record
+ connection : longint;
+ task : longint;
+ end;
+
+ PFragElement = ^TFragElement;
+ TFragElement = record
+ ptr : pointer;
+ size : longint;
+ end;
+
+ PNCPExtensionMessageFrag = ^TNCPExtensionMessageFrag;
+ TNCPExtensionMessageFrag = record
+ totalMessageSize : longint;
+ fragCount : longint;
+ fragList : array[0..3] of TFragElement;
+ end;
+
+ TNCPExtensionHandlerFunc =
+ function (NCPExtensionClient:PNCPExtensionClient;
+ requestData:pointer;
+ requestDataLen:longint;
+ replyData:pointer;
+ replyDataLen:Plongint):byte; cdecl;
+ TConnectionEventHandlerProc =
+ procedure (connection:longint; eventType:longint); cdecl;
+
+ TReplyBufferManagerProc =
+ procedure (NCPExtensionClient:PNCPExtensionClient; replyBuffer:pointer); cdecl;
+
+function NWDeRegisterNCPExtension(queryData:pointer):longint;cdecl;external name 'NWDeRegisterNCPExtension';
+function NWGetNCPExtensionInfo(NCPExtensionName:Pchar; NCPExtensionID:Plongint; majorVersion:PBYTE; minorVersion:PBYTE; revision:PBYTE;
+ queryData:pointer):longint;cdecl;external name 'NWGetNCPExtensionInfo';
+function NWGetNCPExtensionInfoByID(NCPExtensionID:longint; NCPExtensionName:Pchar; majorVersion:PBYTE; minorVersion:PBYTE; revision:PBYTE;
+ queryData:pointer):longint;cdecl;external name 'NWGetNCPExtensionInfoByID';
+function NWRegisterNCPExtension(NCPExtensionName:Pchar;
+ NCPExtensionHandler:TNCPExtensionHandlerFunc;
+ ConnectionEventHandler:TConnectionEventHandlerProc;
+ ReplyBufferManager:TReplyBufferManagerProc;
+ majorVersion,minorVersion,revision:byte;
+ queryData:Ppointer):longint;cdecl;external name 'NWRegisterNCPExtension';
+
+function NWRegisterNCPExtensionByID(NCPExtensionID:longint;
+ NCPExtensionName:Pchar;
+ NCPExtensionHandler:TNCPExtensionHandlerFunc;
+ ConnectionEventHandler:TConnectionEventHandlerProc;
+ ReplyBufferManager:TReplyBufferManagerProc;
+ majorVersion,minorVersion,revision:byte; queryData:Ppointer):longint;cdecl;external name 'NWRegisterNCPExtensionByID';
+
+function NWScanNCPExtensions(NCPExtensionID:Plongint; NCPExtensionName:Pchar; majorVersion:PBYTE; minorVersion:PBYTE; revision:PBYTE;
+ queryData:pointer):longint;cdecl;external name 'NWScanNCPExtensions';
+function NWSendNCPExtensionFraggedRequest(NCPExtensionID:longint; requestFrag:PNCPExtensionMessageFrag; replyFrag:PNCPExtensionMessageFrag):longint;cdecl;external name 'NWSendNCPExtensionFraggedRequest';
+function NWSendNCPExtensionRequest(NCPExtensionID:longint; requestData:pointer; requestDataLen:longint; replyData:pointer; replyDataLen:Plongint):longint;cdecl;external name 'NWSendNCPExtensionRequest';
+{-nwnspace.h-------------------------------------------------------------------}
+{$include npackon.inc}
+type
+
+ PNWNSINFO = ^TNWNSINFO;
+ TNWNSINFO = record
+ nsInfoBitMask,
+ fixedBitMask,
+ reservedBitMask,
+ extendedBitMask : longint;
+ fixedBitsDefined,
+ reservedBitsDefined,
+ extendedBitsDefined : word;
+ fieldsLenTable : array[0..31] of longint;
+ hugeStateInfo : array[0..15] of byte;
+ hugeDataLength : longint;
+ end;
+ TNW_NS_INFO = TNWNSINFO;
+ PNW_NS_INFO = ^TNW_NS_INFO;
+
+{$include npackoff.inc}
+
+function GetDataStreamName(volume:longint; dataStream:byte; name:Pchar; numberOfDataStreams:Plongint):longint;cdecl;external 'clib' name 'GetDataStreamName';
+function GetDataStreamName(volume:longint; dataStream:byte; name:Pchar; var numberOfDataStreams:longint):longint;cdecl;external 'clib' name 'GetDataStreamName';
+function GetNameSpaceName(volume:longint; nameSpace:longint; name:Pchar; numberOfNameSpaces:Plongint):longint;cdecl;external 'clib' name 'GetNameSpaceName';
+function GetNameSpaceName(volume:longint; nameSpace:longint; name:Pchar; var numberOfNameSpaces:longint):longint;cdecl;external 'clib' name 'GetNameSpaceName';
+function NWGetHugeNSInfo(volNum,nameSpace:byte; dirBase,hugeInfoMask:longint;
+ hugeStateInfo:PBYTE;
+ hugeData:PBYTE;
+ hugeDataLen:PLongint;
+ nextHugeStateInfo:PBYTE):longint;cdecl;external 'clib' name 'NWGetHugeNSInfo';
+function NWGetHugeNSInfo(volNum,nameSpace:byte; dirBase,hugeInfoMask:longint;
+ var hugeStateInfo;
+ var hugeData;
+ var hugeDataLen:longint;
+ var nextHugeStateInfo):longint;cdecl;external 'clib' name 'NWGetHugeNSInfo';
+function NWGetNameSpaceEntryName(path:PBYTE; nameSpace:longint; maxNameBufferLength:longint; nameSpaceEntryName:PChar):longint;cdecl;external 'clib' name 'NWGetNameSpaceEntryName';
+function NWGetNameSpaceEntryName(var path:byte; nameSpace:longint; maxNameBufferLength:longint; nameSpaceEntryName:PChar):longint;cdecl;external 'clib' name 'NWGetNameSpaceEntryName';
+function NWGetNSInfo(volNum:byte; srcNameSpace:byte; dstNameSpace:byte; dirBase:longint; nsInfoMask:longint;
+ nsSpecificInfo:PBYTE):longint;cdecl;external 'clib' name 'NWGetNSInfo';
+function NWGetNSLoadedList(volNum:byte; loadListSize:word; NSLoadedList:PBYTE; returnListSize:PWORD):longint;cdecl;external 'clib' name 'NWGetNSLoadedList';
+function NWQueryNSInfoFormat(nameSpace,volNum:byte; nsInfo:PNW_NS_INFO):longint;cdecl;external 'clib' name 'NWQueryNSInfoFormat';
+function NWQueryNSInfoFormat(nameSpace,volNum:byte; var nsInfo:TNW_NS_INFO):longint;cdecl;external 'clib' name 'NWQueryNSInfoFormat';
+function NWSetHugeNSInfo(volNum,nameSpace:byte; dirBase:longint;
+ hugeInfoMask:longint; hugeStateInfo:PBYTE;
+ hugeDataLen:longint;
+ hugeData:PBYTE;
+ nextHugeStateInfo:PBYTE;
+ hugeDataUsed:PLongint):longint;cdecl;external 'clib' name 'NWSetHugeNSInfo';
+function NWSetHugeNSInfo(volNum,nameSpace:byte; dirBase:longint;
+ hugeInfoMask:longint; var hugeStateInfo;
+ hugeDataLen:longint;
+ var hugeData;
+ var nextHugeStateInfo;
+ var hugeDataUsed:longint):longint;cdecl;external 'clib' name 'NWSetHugeNSInfo';
+
+function NWSetNameSpaceEntryName(path:PChar; nameSpace:longint; nameSpaceEntryName:PChar):longint;cdecl;external 'clib' name 'NWSetNameSpaceEntryName';
+function NWSetNSInfo(volNum,srcNameSpace,dstNameSpace:byte; dirBase:longint;
+ nsInfoMask:longint;
+ nsSpecificInfoLen:longint;
+ nsSpecificInfo:Pointer):longint;cdecl;external 'clib' name 'NWSetNSInfo';
+function NWSetNSInfo(volNum,srcNameSpace,dstNameSpace:byte; dirBase:longint;
+ nsInfoMask:longint;
+ nsSpecificInfoLen:longint;
+ var nsSpecificInfo):longint;cdecl;external 'clib' name 'NWSetNSInfo';
+function SetCurrentNameSpace(newNameSpace:byte):byte;cdecl;external 'clib' name 'SetCurrentNameSpace';
+function SetTargetNameSpace(newNameSpace:byte):byte;cdecl;external 'clib' name 'SetTargetNameSpace';
+{-nwproc.h---------------------------------------------------------------------}
+type TStdfds = array[0..2] of longint;
+
+function CreateChildProcess (func:pointer;
+ threadName:PChar;
+ cmdLine:PChar;
+ arg:PChar;
+ stack:pointer;
+ stackSize:longint;
+ stdfds:TStdfds;
+ clearenv:longint;
+ procName:PChar;
+ enableApp:longint):Tpid_t;cdecl;external 'clib' name 'CreateChildProcess';
+function KillChildProcess(pid:Tpid_t):longint;cdecl;external 'clib' name 'KillChildProcess';
+function WaitOnChildProcess(pid:Tpid_t; statloc:Plongint; options:longint):longint;cdecl;external 'clib' name 'WaitOnChildProcess';
+function WaitOnChildProcess(pid:Tpid_t; var statloc:longint; options:longint):longint;cdecl;external 'clib' name 'WaitOnChildProcess';
+{-nwsemaph.h-------------------------------------------------------------------}
+function CloseLocalSemaphore (semaHandle : longint) : longint; cdecl; external 'clib' name 'CloseLocalSemaphore';
+function ExamineLocalSemaphore (semaHandle : longint) : longint; cdecl; external 'clib' name 'ExamineLocalSemaphore';
+function OpenLocalSemaphore (initValue : longint) : longint; cdecl; external 'clib' name 'OpenLocalSemaphore';
+function SignalLocalSemaphore (semaHandle : longint) : longint; cdecl; external 'clib' name 'SignalLocalSemaphore';
+function TimedWaitOnLocalSemaphore (semaHandle,Timeout:longint) : longint; cdecl; external 'clib' name 'TimedWaitOnLocalSemaphore';
+function WaitOnLocalSemaphore (semaHandle : longint) : longint; cdecl; external 'clib' name 'WaitOnLocalSemaphore';
+{-signal.h---------------------------------------------------------------------}
+{ #define SIG_IGN (void (*)(int)) 1 }
+{ #define SIG_DFL (void (*)(int)) 2 }
+{ #define SIG_ERR (void (*)(int)) 3 }
+const
+ SIGABRT = 1;
+ SIGFPE = 2;
+ SIGILL = 3;
+ SIGINT = 4;
+ SIGSEGV = 5;
+ SIGTERM = 6;
+ SIGPOLL = 7;
+ { currently unimplemented POSIX-mandated signals }
+ SIGKILL = 101;
+ SA_NOCLDSTOP = 102;
+ SIGALRM = 103;
+ SIGCHILD = 104;
+ SIGCONT = 105;
+ SIGHUP = 106;
+ SIGPIPE = 107;
+ SIGQUIT = 108;
+ SIGSTOP = 109;
+ SIGTSTP = 110;
+ SIGTTIN = 111;
+ SIGTTOU = 112;
+ SIGUSR1 = 113;
+ SIGUSR2 = 114;
+ SIG_BLOCK = 115;
+ SIG_SETMASK = 116;
+ SIG_UNBLOCK = 117;
+ { Novell-defined signals }
+ SIG_FINI = 500;
+ SIG_IPBIND = 501;
+ SIG_IPUNBIND = 502;
+ SIG_IPXBIND = 503;
+ SIG_IPXUNBIND = 504;
+ SIG_IPREGISTER = 505;
+ SIG_IPUNREGISTER = 506;
+ SIG_IPXREGISTER = 507;
+ SIG_IPXUNREGISTER = 508;
+ SIG_LOCALECHANGE = 510;
+
+type
+ Psig_atomic_t = ^Tsig_atomic_t;
+ Tsig_atomic_t = longint;
+ TSigHandlerProc = procedure (Sig:longint); cdecl;
+
+function _raise(para1:longint):longint;cdecl;external 'clib' name 'raise';
+function signal(sig:longint; func:TSigHandlerProc):longint;cdecl;external 'clib' name 'signal';
+
+function nw_raise(para1:longint):longint;cdecl;external 'clib' name 'raise';
+function nw_signal(sig:longint; func:TSigHandlerProc):longint;cdecl;external 'clib' name 'signal';
+{-nwstring.h-------------------------------------------------------------------}
+function ASCIIZToLenStr (lenString,ASCIIZstring:Pchar) : longint; cdecl;external 'clib' name 'ASCIIZToLenStr';
+function ASCIIZToMaxLenStr (lenString,ASCIIZstring:Pchar; maximumLength:longint):longint; cdecl;external 'clib' name 'ASCIIZToMaxLenStr';
+function IntSwap (w:word):word; cdecl;external 'clib' name 'IntSwap';
+function LenStrCat (destStr,srcStr:Pchar):Pchar; cdecl;external 'clib' name 'LenStrCat';
+function LenStrCmp (s1,s2:Pchar):longint; cdecl;external 'clib' name 'LenStrCmp';
+function LenStrCpy (dest,src:Pchar):Pchar; cdecl;external 'clib' name 'LenStrCpy';
+function LenToASCIIZStr (ASCIIZstring,lenString:Pchar) : longint; cdecl;external 'clib' name 'LenToASCIIZStr';
+function LongSwap (l:longint) : longint; cdecl;external 'clib' name 'LongSwap';
+{-nwtoolib.h-------------------------------------------------------------------}
+type
+ TreadFunc = function :longint; cdecl;
+ TNLMBeginFunc = procedure (NLMID:longint; commandLine:Pchar); cdecl;
+ TNLMPreEndFunc = procedure (NLMID:longint); cdecl;
+ TNLMPostEndFunc = procedure (NLMID:longint); cdecl;
+ TNLMEndNoContextFunc= procedure (NLMID:longint); cdecl;
+ TthreadGroupBeginFunc=function (threadGroupID:longint; argc:longint; const argv:array of Pchar):longint; cdecl;
+ TthreadGroupEndFunc = procedure (threadGroupID:longint); cdecl;
+ TthreadBeginFunc = function (threadID:longint):longint; cdecl;
+ TthreadEndFunc = procedure (threadID:longint); cdecl;
+ TthreadReleaseFileResourcesFunc = procedure (threadID:longint); cdecl;
+
+function _NWGetErrno:longint;cdecl;external 'clib' name '_NWGetErrno';
+function _NWGetNWErrno:longint;cdecl;external 'clib' name '_NWGetNWErrno';
+function _NWGetNLMLevelLibDataPtr(NLMID:longint):pointer;cdecl;external 'clib' name '_NWGetNLMLevelLibDataPtr';
+function _NWGetThreadGroupLevelLibDataPtr(threadGroupID:longint):pointer;cdecl;external 'clib' name '_NWGetThreadGroupLevelLibDataPtr';
+function _NWGetThreadLevelLibDataPtr(threadID:longint):pointer;cdecl;external 'clib' name '_NWGetThreadLevelLibDataPtr';
+function _NWLoadNLMMessageTable(NLMHandle:TNlmHandle; messageTable:PPPchar; messageCount:Plongint; languageID:Plongint):longint;cdecl;external 'clib' name '_NWLoadNLMMessageTable';
+function _NWRegisterNLMLibrary (NLMHandle:TNlmHandle;
+ NLMFileHandle:longint;
+ readFunc:TReadFunc;
+ NLMBegin:TNLMBeginFunc;
+ NLMPreEnd:TNLMPreEndFunc;
+ NLMPostEnd:TNLMPostEndFunc;
+ NLMEndNoContext:TNLMEndNoContextFunc;
+ threadGroupBegin:TthreadGroupBeginFunc;
+ threadGroupEnd:TthreadGroupEndFunc;
+ threadBegin:TthreadBeginFunc;
+ threadEnd:TthreadEndFunc;
+ threadReleaseFileResources:TthreadReleaseFileResourcesFunc ):longint;cdecl;external 'clib' name '_NWRegisterNLMLibrary';
+procedure _NWSetErrno (errnoValue : longint);cdecl;external 'clib' name '_NWSetErrno';
+procedure _NWSetNWErrno (NWErrnoValue : longint);cdecl;external 'clib' name '_NWSetNWErrno';
+procedure _NWSetNLMLevelLibDataPtr (NLMID : longint; dataPtr : pointer);cdecl;external 'clib' name '_NWSetNLMLevelLibDataPtr';
+procedure _NWSetThreadGroupLevelLibDataPtr (threadGroupID : longint; dataPtr : pointer);cdecl;external 'clib' name '_NWSetThreadGroupLevelLibDataPtr';
+procedure _NWSetThreadLevelLibDataPtr (threadID : longint; dataPtr : pointer);cdecl;external 'clib' name '_NWSetThreadLevelLibDataPtr';
+{-stdio.h----------------------------------------------------------------------}
+type
+ Tva_list = pointer; // dont know what this is
+
+ Pfpos_t = ^Tfpos_t;
+ Tfpos_t = longint;
+
+ Pwchar_t = ^Twchar_t;
+ Twchar_t = word;
+
+ Pwint_t = ^Twint_t;
+ Twint_t = longint;
+{ values for fseek()' whence argument }
+{ add 'offset' to beginning of file }
+
+const
+ SEEK_SET = 0;
+{ add 'offset' to current position in file }
+ SEEK_CUR = 1;
+{ add 'offset' to end of file }
+ SEEK_END = 2;
+{ miscellaneous definitions }
+{ at least this many FILEs available }
+ FOPEN_MAX = 20;
+{ (extreme) default buffer size }
+ BUFSIZ = 1024;
+{ max number of characters in a path name }
+ FILENAME_MAX = 1024;
+{ definitions for tmpnam() and tmpfil() }
+{ "_T-00000.TMP" to "_T-99999.TMP" }
+ TMP_MAX = 100000;
+{ 8 + 1 + 3 + 1 (always DOS namespace) }
+ L_tmpnam = 13;
+{ values for field '_flag' in FILE below }
+{ currently reading }
+ _IOREAD = $0001;
+{ currently writing }
+ _IOWRT = $0002;
+{ opened for reading and writing }
+ _IORW = $0004;
+{ binary file (O_BINARY) }
+ _IOBIN = $0008;
+{ unbuffered (e.g.: stdout and stderr) }
+ _IONBF = $0010;
+{ line buffered (e.g.: stdin) }
+ _IOLBF = $0020;
+{ fully buffered (most files) }
+ _IOFBF = $0040;
+{ EOF reached on read }
+ _IOEOF = $0080;
+{ I/O error from system }
+ _IOERR = $0100;
+{ stdio code malloc()'d this buffer }
+ _IOBUF = $0200;
+{ was a temporary file by tmpfile() }
+ _IOTMP = $0400;
+{ file stream structure }
+type
+ Piobuf = ^Tiobuf;
+ Tiobuf = record
+ _signature : dword; { identifies this structure }
+ _avail : longint; { available (unused/unread) room in buffer }
+ _ptr : Pbyte; { next character from/to here in buffer }
+ _base : Pbyte; { the buffer (not really) }
+ _oflag : dword; { pre-CLib.NLM v4.11 compatibility }
+ _file : dword; { file descriptor }
+ _flag : dword; { state of stream }
+ _buf : array[0..3] of
+ byte; { fake, micro buffer as a fall-back }
+ _env : dword; { Macintosh or UNIX text file signature }
+ end;
+ TFILE = Tiobuf;
+ PFILE = ^TFILE;
+ PPFILE = ^PFILE;
+
+
+{ ISO/ANSI C defined functions... }
+procedure clearerr(para1:PFILE);cdecl;external 'clib' name 'clearerr';
+procedure clearerr(var para1:TFILE);cdecl;external 'clib' name 'clearerr';
+function fclose(para1:PFILE):longint;cdecl;external 'clib' name 'fclose';
+function fclose(var para1:TFILE):longint;cdecl;external 'clib' name 'fclose';
+function feof(para1:PFILE):longint;cdecl;external 'clib' name 'feof';
+function feof(var para1:TFILE):longint;cdecl;external 'clib' name 'feof';
+function ferror(para1:PFILE):longint;cdecl;external 'clib' name 'ferror';
+function ferror(var para1:TFILE):longint;cdecl;external 'clib' name 'ferror';
+function fflush(para1:PFILE):longint;cdecl;external 'clib' name 'fflush';
+function fflush(var para1:TFILE):longint;cdecl;external 'clib' name 'fflush';
+function fgetc(para1:PFILE):char;cdecl;external 'clib' name 'fgetc';
+function fgetc(var para1:TFILE):char;cdecl;external 'clib' name 'fgetc';
+function fgetpos(para1:PFILE; para2:Pfpos_t):longint;cdecl;external 'clib' name 'fgetpos';
+function fgetpos(var para1:TFILE; var para2:Tfpos_t):longint;cdecl;external 'clib' name 'fgetpos';
+function fgets(para1:Pchar; para2:longint; para3:PFILE):Pchar;cdecl;external 'clib' name 'fgets';
+function fgets(para1:Pchar; para2:longint; var para3:TFILE):Pchar;cdecl;external 'clib' name 'fgets';
+function fopen(para1,para2:Pchar):PFILE;cdecl;external 'clib' name 'fopen';
+function fprintf(para1:PFILE; para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'fprintf';
+function fprintf(var para1:TFILE; para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'fprintf';
+function fprintf(para1:PFILE; para2:Pchar):longint;cdecl;external 'clib' name 'fprintf';
+function fprintf(var para1:TFILE; para2:Pchar):longint;cdecl;external 'clib' name 'fprintf';
+function fputc(para1:longint; para2:PFILE):longint;cdecl;external 'clib' name 'fputc';
+function fputs(para1:Pchar; para2:PFILE):longint;cdecl;external 'clib' name 'fputs';
+function fread(para1:pointer; para2:Tsize_t; para3:Tsize_t; para4:PFILE):Tsize_t;cdecl;external 'clib' name 'fread';
+function freopen(para1:Pchar; para2:Pchar; para3:PFILE):PFILE;cdecl;external 'clib' name 'freopen';
+function fscanf(para1:PFILE; para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'fscanf';
+function fscanf(var para1:TFILE; para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'fscanf';
+function fscanf(para1:PFILE; para2:Pchar):longint;cdecl;external 'clib' name 'fscanf';
+function fscanf(var para1:TFILE; para2:Pchar):longint;cdecl;external 'clib' name 'fscanf';
+function fseek(fp:PFILE; offset:longint; whence:longint):longint;cdecl;external 'clib' name 'fseek';
+function fseek(var fp:TFILE; offset:longint; whence:longint):longint;cdecl;external 'clib' name 'fseek';
+(* Const before type ignored *)
+function fsetpos(para1:PFILE; para2:Pfpos_t):longint;cdecl;external 'clib' name 'fsetpos';
+function fsetpos(var para1:TFILE; para2:Pfpos_t):longint;cdecl;external 'clib' name 'fsetpos';
+function ftell(para1:PFILE):longint;cdecl;external 'clib' name 'ftell';
+function ftell(var para1:TFILE):longint;cdecl;external 'clib' name 'ftell';
+
+function fwrite(para1:pointer; para2:Tsize_t; para3:Tsize_t; para4:PFILE):Tsize_t;cdecl;external 'clib' name 'fwrite';
+
+function getc(para1:PFILE):char;cdecl;external 'clib' name 'getc';
+function getc(var para1:TFILE):char;cdecl;external 'clib' name 'getc';
+
+function getchar:char;cdecl;external 'clib' name 'getchar';
+function gets(para1:Pchar):Pchar;cdecl;external 'clib' name 'gets';
+procedure perror(para1:Pchar);cdecl;external 'clib' name 'perror';
+function printf(para1:Pchar; args:array of const):longint;cdecl;external 'clib' name 'printf';
+function printf(para1:Pchar):longint;cdecl;external 'clib' name 'printf';
+function putc(para1:char; para2:PFILE):longint;cdecl;external 'clib' name 'putc';
+function putc(para1:char; var para2:TFILE):longint;cdecl;external 'clib' name 'putc';
+
+function putchar(para1:char):longint;cdecl;external 'clib' name 'putchar';
+
+function puts(para1:Pchar):longint;cdecl;external 'clib' name 'puts';
+function remove(para1:Pchar):longint;cdecl;external 'clib' name 'remove';
+function rename(para1, para2:Pchar):longint;cdecl;external 'clib' name 'rename';
+procedure rewind(para1:PFILE);cdecl;external 'clib' name 'rewind';
+procedure rewind(var para1:TFILE);cdecl;external 'clib' name 'rewind';
+
+function scanf(para1:Pchar; args:array of const):longint;cdecl;external 'clib' name 'scanf';
+function scanf(para1:Pchar):longint;cdecl;external 'clib' name 'scanf';
+procedure setbuf(para1:PFILE; para2:Pchar);cdecl;external 'clib' name 'setbuf';
+procedure setbuf(var para1:TFILE; para2:Pchar);cdecl;external 'clib' name 'setbuf';
+function setvbuf(para1:PFILE; para2:Pchar; para3:longint; para4:Tsize_t):longint;cdecl;external 'clib' name 'setvbuf';
+function setvbuf(para1:TFILE; para2:Pchar; para3:longint; para4:Tsize_t):longint;cdecl;external 'clib' name 'setvbuf';
+
+function sprintf(para1,para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'sprintf';
+function sprintf(para1,para2:Pchar):longint;cdecl;external 'clib' name 'sprintf';
+function sscanf(para1, para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'sscanf';
+function sscanf(para1, para2:Pchar):longint;cdecl;external 'clib' name 'sscanf';
+function tmpfile:PFILE;cdecl;external 'clib' name 'tmpfile';
+function tmpnam(para1:Pchar):Pchar;cdecl;external 'clib' name 'tmpnam';
+function ungetc(para1:longint; para2:PFILE):longint;cdecl;external 'clib' name 'ungetc';
+function ungetc(para1:longint; var para2:TFILE):longint;cdecl;external 'clib' name 'ungetc';
+
+function vfprintf(para1:PFILE; para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'vfprintf';
+function vfprintf(var para1:TFILE; para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'vfprintf';
+
+function vfscanf(para1:PFILE; para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'vfscanf';
+function vfscanf(var para1:TFILE; para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'vfscanf';
+
+function vprintf(para1:Pchar; para2:Tva_list):longint;cdecl;external 'clib' name 'vprintf';
+function vscanf(para1:Pchar; para2:Tva_list):longint;cdecl;external 'clib' name 'vscanf';
+function vsprintf(para1,para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'vsprintf';
+function vsscanf(para1, para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'vsscanf';
+{ POSIX-defined additions... }
+function fdopen(para1:longint; para2:Pchar):PFILE;cdecl;external 'clib' name 'fdopen';
+function fileno(fp:PFILE):longint;cdecl;external 'clib' name 'fileno';
+function fileno(var f:TFILE):longint;cdecl;external 'clib' name 'fileno';
+//function cgets(para1:Pchar):Pchar;cdecl;external 'clib' name 'cgets';
+//function cprintf(para1:Pchar; args:array of const):longint;cdecl;external 'clib' name 'cprintf';
+//function cprintf(para1:Pchar):longint;cdecl;external 'clib' name 'cprintf';
+//function cputs(para1:Pchar):longint;cdecl;external 'clib' name 'cputs';
+//function cscanf(para1:Pchar; args:array of const):longint;cdecl;external 'clib' name 'cscanf';
+//function cscanf(para1:Pchar):longint;cdecl;external 'clib' name 'cscanf';
+function fcloseall:longint;cdecl;external 'clib' name 'fcloseall';
+function fgetchar:longint;cdecl;external 'clib' name 'fgetchar';
+function flushall:longint;cdecl;external 'clib' name 'flushall';
+function fputchar(para1:longint):longint;cdecl;external 'clib' name 'fputchar';
+function vcprintf(para1:Pchar; para2:Tva_list):longint;cdecl;external 'clib' name 'vcprintf';
+function vcscanf(para1:Pchar; para2:Tva_list):longint;cdecl;external 'clib' name 'vcscanf';
+function NWfprintf(var para1:TFILE; para2:Pchar; args:array of const):longint;cdecl;external 'clib' name 'NWfprintf';
+function NWfprintf(var para1:TFILE; para2:Pchar):longint;cdecl;external 'clib' name 'NWfprintf';
+function NWvcprintf(para1:Pchar; para2:Tva_list):longint;cdecl;external 'clib' name 'NWvcprintf';
+function NWvfprintf(para1:PFILE; para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'NWvfprintf';
+function NWvprintf(para1:Pchar; para2:Tva_list):longint;cdecl;external 'clib' name 'NWvprintf';
+function NWvsprintf(para1:Pchar; para2:Pchar; para3:Tva_list):longint;cdecl;external 'clib' name 'NWvsprintf';
+{
+ For the following support, open the file without 'b' in the mode. Additions
+ for transparent Macintosh text file support ('\r' on lines) and additions
+ for transparent UNIX text file support ('\n' on lines).
+ }
+function IsMacintoshTextFile(para1:PFILE):longint;cdecl;external 'clib' name 'IsMacintoshTextFile';
+function SetMacintoshTextMode(para1:PFILE):longint;cdecl;external 'clib' name 'SetMacintoshTextMode';
+function UnsetMacintoshTextMode(para1:PFILE):longint;cdecl;external 'clib' name 'UnsetMacintoshTextMode';
+
+function IsMacintoshTextFile(var para1:TFILE):longint;cdecl;external 'clib' name 'IsMacintoshTextFile';
+function SetMacintoshTextMode(var para1:TFILE):longint;cdecl;external 'clib' name 'SetMacintoshTextMode';
+function UnsetMacintoshTextMode(var para1:TFILE):longint;cdecl;external 'clib' name 'UnsetMacintoshTextMode';
+
+{ back to '\r\n' }
+function is_unix_text_file(para1:PFILE):longint;cdecl;external 'clib' name 'is_unix_text_file';
+function set_unix_text_mode(para1:PFILE):longint;cdecl;external 'clib' name 'set_unix_text_mode';
+function unset_unix_text_mode(para1:PFILE):longint;cdecl;external 'clib' name 'unset_unix_text_mode';
+
+function is_unix_text_file(var para1:TFILE):longint;cdecl;external 'clib' name 'is_unix_text_file';
+function set_unix_text_mode(var para1:TFILE):longint;cdecl;external 'clib' name 'set_unix_text_mode';
+function unset_unix_text_mode(var para1:TFILE):longint;cdecl;external 'clib' name 'unset_unix_text_mode';
+
+{ back to '\r\n' }
+{ functions underlying macro support... }
+function __get_stdin:PPFILE;cdecl;external 'clib' name '__get_stdin';
+function __get_stdout:PPFILE;cdecl;external 'clib' name '__get_stdout';
+function __get_stderr:PPFILE;cdecl;external 'clib' name '__get_stderr';
+
+function __stdin : PFILE;
+function __stdout : PFILE;
+function __stderr : PFILE;
+{-stdlib.h---------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+
+const
+ EXIT_FAILURE = -(1);
+ EXIT_SUCCESS = 0;
+ RAND_MAX = 32767;
+type
+ Pdiv_t = ^Tdiv_t;
+ Tdiv_t = record
+ quot : longint;
+ rem : longint;
+ end;
+
+ Pldiv_t = ^Tldiv_t;
+ Tldiv_t = record
+ quot : longint;
+ rem : longint;
+ end;
+
+ TCdeclProcedure = procedure; cdecl;
+ TBSearchFunc = function (para1:pointer; para2:pointer):longint; cdecl;
+ TQSortFunc = function (para1:pointer; para2:pointer):longint; cdecl;
+
+//?? var __ctype : array of byte;cvar;external;
+
+procedure abort;cdecl;external 'clib' name 'abort';
+function abs(para1:longint):longint;cdecl;external 'clib' name 'abs';
+function atexit(proc:TCdeclProcedure):longint;cdecl;external 'clib' name 'atexit';
+function atof(para1:Pchar):double;cdecl;external 'clib' name 'atof';
+function atoi(para1:Pchar):longint;cdecl;external 'clib' name 'atoi';
+function atol(para1:Pchar):longint;cdecl;external 'clib' name 'atol';
+function bsearch(para1,para2:pointer; para3,para4:Tsize_t; para5:TBsearchFunc):pointer;cdecl;external 'clib' name 'bsearch';
+function calloc(para1:Tsize_t; para2:Tsize_t):pointer;cdecl;external 'clib' name 'calloc';
+function _div(para1,para2:longint):Tdiv_t;cdecl;external 'clib' name 'div';
+//procedure exit(para1:longint);cdecl;external 'clib' name 'exit';
+procedure _exit(para1:longint);cdecl;external 'clib' name '_exit';
+function getenv(para1:Pchar):Pchar;cdecl;external 'clib' name 'getenv';
+function labs(para1:longint):longint;cdecl;external 'clib' name 'labs';
+function ldiv(para1:longint; para2:longint):Tldiv_t;cdecl;external 'clib' name 'ldiv';
+function malloc(para1:Tsize_t):pointer;cdecl;external 'clib' name 'malloc';
+function mblen(para1:Pchar; para2:Tsize_t):longint;cdecl;external 'clib' name 'mblen';
+function mbstowcs(para1:Pwchar_t; para2:Pchar; para3:Tsize_t):Tsize_t;cdecl;external 'clib' name 'mbstowcs';
+function mbtowc(para1:Pwchar_t; para2:Pchar; para3:Tsize_t):longint;cdecl;external 'clib' name 'mbtowc';
+procedure qsort(para1:pointer; para2,para3:Tsize_t; para4:TQSortFunc);cdecl;external 'clib' name 'qsort';
+function rand:longint;cdecl;external 'clib' name 'rand';
+function realloc(para1:pointer; para2:Tsize_t):pointer;cdecl;external 'clib' name 'realloc';
+procedure srand(para1:dword);cdecl;external 'clib' name 'srand';
+function strtod(para1:Pchar; para2:PPchar):double;cdecl;external 'clib' name 'strtod';
+function strtol(para1:Pchar; para2:PPchar; para3:longint):longint;cdecl;external 'clib' name 'strtol';
+function strtoul(para1:Pchar; para2:PPchar; para3:longint):dword;cdecl;external 'clib' name 'strtoul';
+function _system(para1:Pchar):longint;cdecl;external 'clib' name 'system';
+function wcstombs(para1:Pchar; para2:Pwchar_t; para3:Tsize_t):Tsize_t;cdecl;external 'clib' name 'wcstombs';
+function wctomb(para1:Pchar; para2:Twchar_t):longint;cdecl;external 'clib' name 'wctomb';
+function clearenv:longint;cdecl;external 'clib' name 'clearenv';
+function ecvt(para1:double; para2:longint; para3:Plongint; para4:Plongint):Pchar;cdecl;external 'clib' name 'ecvt';
+function fcvt(para1:double; para2:longint; para3:Plongint; para4:Plongint):Pchar;cdecl;external 'clib' name 'fcvt';
+function gcvt(para1:double; para2:longint; para3:Pchar):Pchar;cdecl;external 'clib' name 'gcvt';
+function htol(para1:Pchar):dword;cdecl;external 'clib' name 'htol';
+function itoa(para1:longint; para2:Pchar; para3:longint):Pchar;cdecl;external 'clib' name 'itoa';
+function itoab(para1:dword; para2:Pchar):Pchar;cdecl;external 'clib' name 'itoab';
+function ltoa(para1:longint; para2:Pchar; para3:longint):Pchar;cdecl;external 'clib' name 'ltoa';
+function max(para1:longint; para2:longint):longint;cdecl;external 'clib' name 'max';
+function min(para1:longint; para2:longint):longint;cdecl;external 'clib' name 'min';
+function putenv(name:Pchar):longint;cdecl;external 'clib' name 'putenv';
+function rand_r(seed:Pdword; result:Plongint):longint;cdecl;external 'clib' name 'rand_r';
+function _rotl(para1:dword; para2:dword):dword;cdecl;external 'clib' name '_rotl';
+function _rotr(para1:dword; para2:dword):dword;cdecl;external 'clib' name '_rotr';
+function scanenv(sequence:Plongint; variable:Pchar; length:Psize_t; value:Pchar):longint;cdecl;external 'clib' name 'scanenv';
+function setenv(name:Pchar; value:Pchar; overwrite:longint):longint;cdecl;external 'clib' name 'setenv';
+// double strtod_ld( const char *, char **, long double *);
+function strtoi(para1:Pchar; para2:longint):longint;cdecl;external 'clib' name 'strtoi';
+function ultoa(para1:dword; para2:Pchar; para3:longint):Pchar;cdecl;external 'clib' name 'ultoa';
+function unsetenv(name:Pchar):longint;cdecl;external 'clib' name 'unsetenv';
+function utoa(para1:dword; para2:Pchar; para3:longint):Pchar;cdecl;external 'clib' name 'utoa';
+function _lrotl(para1:dword; para2:dword):dword;cdecl;external 'clib' name '_lrotl';
+function _lrotr(para1:dword; para2:dword):dword;cdecl;external 'clib' name '_lrotr';
+{-unistd.h---------------------------------------------------------------------}
+const
+ F_OK = 0;
+ R_OK = 4;
+ W_OK = 2;
+ X_OK = 1;
+{ test using effective ids }
+ EFF_ONLY_OK = 8;
+ STDIN_FILENO = 0;
+ STDOUT_FILENO = 1;
+ STDERR_FILENO = 2;
+
+type TPipeFiledes = array [0..1] of longint;
+
+function access(path:Pchar; mode:longint):longint;cdecl;external 'clib' name 'access';
+function _chdir(path:Pchar):longint;cdecl;external 'clib' name 'chdir';
+function Fpchdir(path:Pchar):longint;cdecl;external 'clib' name 'chdir';
+function chsize(fildes:longint; size:dword):longint;cdecl;external 'clib' name 'chsize';
+function _close(fildes:longint):longint;cdecl;external 'clib' name 'close';
+function Fpclose(fildes:longint):longint;cdecl;external 'clib' name 'close';
+function dup(fildes:longint):longint;cdecl;external 'clib' name 'dup';
+function fpdup(fildes:longint):longint;cdecl;external 'clib' name 'dup';
+function dup2(fildes1:longint; fildes2:longint):longint;cdecl;external 'clib' name 'dup2';
+function fpdup2(fildes1:longint; fildes2:longint):longint;cdecl;external 'clib' name 'dup2';
+function _eof(fildes:longint):longint;cdecl;external 'clib' name 'eof';
+function Fpeof(fildes:longint):longint;cdecl;external 'clib' name 'eof';
+function getcwd(path:Pchar; len:Tsize_t):Pchar;cdecl;external 'clib' name 'getcwd';
+function isatty(fildes:longint):longint;cdecl;external 'clib' name 'isatty';
+function lseek(fildes:longint; offset:Toff_t; whence:longint):Toff_t;cdecl;external 'clib' name 'lseek';
+function pipe(fildes:TPipeFiledes):longint;cdecl;external 'clib' name 'pipe';
+function _read(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'read';
+function Fpread(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'read';
+function rmdir(path:Pchar):longint;cdecl;external 'clib' name 'rmdir';
+function unlink(path:Pchar):longint;cdecl;external 'clib' name 'unlink';
+function _write(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
+function Fpwrite(fildes:longint; buf:pointer; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
+function pread(fildes:longint; buf:pointer; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pread';
+function pwrite(fildes:longint; buf:pointer; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pwrite';
+
+function _write(fildes:longint; var buf; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
+function Fpwrite(fildes:longint; var buf; nbytes:Tsize_t):Tssize_t;cdecl;external 'clib' name 'write';
+function pread(fildes:longint; var buf; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pread';
+function pwrite(fildes:longint; var buf; nbytes:Tsize_t; offset:Toff_t):Tssize_t;cdecl;external 'clib' name 'pwrite';
+{-libcclib.h-------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+type
+ Tstart_routineProc = procedure (arg:pointer); cdecl;
+ Pclibctx_t = ^Tclibctx_t;
+ Tclibctx_t = record
+ ThreadGroupGetID : function :longint;cdecl;
+ ThreadGroupCreate : function (name:Pchar; threadGroupID:Plongint):longint; cdecl;
+ ThreadGroupDispose : function (threadGroupID:longint):longint; cdecl;
+ ThreadGroupUnwrap : function (threadGroupID:longint; restoredThreadGroupID:longint):longint; cdecl;
+ ThreadGroupWrap : function (threadGroupID:longint):longint; cdecl;
+ ThreadCreate : function (threadGroupID:longint;
+ start_routine:Tstart_routineProc;
+ arg:pointer;
+ stackSize:Tsize_t;
+ flags:dword;
+ threadID:Plongint):longint; cdecl;
+ __UnloadBroker : procedure ; cdecl;
+ reserved1 : pointer;
+ reserved : array[0..7] of pointer;
+ end;
+
+function CLibLoadContextBroker(module:pointer; callback:Pchar):longint;cdecl;external 'clib' name 'CLibLoadContextBroker';
+function CLibUnloadContextBroker(broker:Pclibctx_t):longint;cdecl;external 'clib' name 'CLibUnloadContextBroker';
+function MyCallBack(broker:Pclibctx_t):longint;cdecl;external 'clib' name 'MyCallBack';
+{-nwtime.h---------------------------------------------------------------------}
+const
+ CLOCK_IS_SYNCHRONIZED = $01;
+type
+
+ PclockAndStatus = ^TclockAndStatus;
+ TclockAndStatus = longint;
+
+const
+ CLOCK_IS_NETWORK_SYNCHRONIZED = $02;
+ CLOCK_SYNCHRONIZATION_IS_ACTIVE = $04;
+
+{$include npackon.inc}
+type
+ PDOSTime = ^TDOSTime;
+ TDOSTime = record
+ flag0 : word;
+ end;
+
+const
+ bm_TDOSTime_bisecond = $1F;
+ bp_TDOSTime_bisecond = 0;
+ bm_TDOSTime_minute = $7E0;
+ bp_TDOSTime_minute = 5;
+ bm_TDOSTime_hour = $F800;
+ bp_TDOSTime_hour = 11;
+function bisecond(var a : TDOSTime) : word;
+procedure set_bisecond(var a : TDOSTime; __bisecond : word);
+function minute(var a : TDOSTime) : word;
+procedure set_minute(var a : TDOSTime; __minute : word);
+function hour(var a : TDOSTime) : word;
+procedure set_hour(var a : TDOSTime; __hour : word);
+type
+ PDOSDate = ^TDOSDate;
+ TDOSDate = record
+ flag0 : word;
+ end;
+ T_DOSDate = TDOSDate;
+
+const
+ bm_TDOSDate_day = $1F;
+ bp_TDOSDate_day = 0;
+ bm_TDOSDate_month = $1E0;
+ bp_TDOSDate_month = 5;
+ bm_TDOSDate_yearsSince80 = $FE00;
+ bp_TDOSDate_yearsSince80 = 9;
+function day(var a : TDOSDate) : word;
+procedure set_day(var a : TDOSDate; __day : word);
+function month(var a : TDOSDate) : word;
+procedure set_month(var a : TDOSDate; __month : word);
+function yearsSince80(var a : TDOSDate) : word;
+procedure set_yearsSince80(var a : TDOSDate; __yearsSince80 : word);
+type
+ P_DOSTime = ^T_DOSTime;
+ T_DOSTime = record
+ flag0 : word;
+ end;
+
+const
+ bm_T_DOSTime_bisecond = $1F;
+ bp_T_DOSTime_bisecond = 0;
+ bm_T_DOSTime_minute = $7E0;
+ bp_T_DOSTime_minute = 5;
+ bm_T_DOSTime_hour = $F800;
+ bp_T_DOSTime_hour = 11;
+function bisecond(var a : T_DOSTime) : word;
+procedure set_bisecond(var a : T_DOSTime; __bisecond : word);
+function minute(var a : T_DOSTime) : word;
+procedure set_minute(var a : T_DOSTime; __minute : word);
+function hour(var a : T_DOSTime) : word;
+procedure set_hour(var a : T_DOSTime; __hour : word);
+
+const
+ bm_T_DOSDate_day = $1F;
+ bp_T_DOSDate_day = 0;
+ bm_T_DOSDate_month = $1E0;
+ bp_T_DOSDate_month = 5;
+ bm_T_DOSDate_yearsSince80 = $FE00;
+ bp_T_DOSDate_yearsSince80 = 9;
+
+
+{$include npackoff.inc}
+
+function _ConvertDOSTimeToCalendar(dateTime:longint):Ttime_t;cdecl;external 'clib' name '_ConvertDOSTimeToCalendar';
+procedure _ConvertTimeToDOS(calendarTime:Ttime_t; filDatP:PDOSDate; filTimP:PDOSTime);cdecl;external 'clib' name '_ConvertTimeToDOS';
+procedure GetClockStatus(_dataPtr:TclockAndStatus);cdecl;external 'clib' name 'GetClockStatus';
+function GetCurrentTicks:longint;cdecl;external 'clib' name 'GetCurrentTicks';
+function GetHighResolutionTimer:longint;cdecl;external 'clib' name 'GetHighResolutionTimer';
+function GetSuperHighResolutionTimer:longint;cdecl;external 'clib' name 'GetSuperHighResolutionTimer';
+function NWGetHighResolutionTimer:longint;cdecl;external 'clib' name 'NWGetHighResolutionTimer';
+function NWGetSuperHighResolutionTimer:longint;cdecl;external 'clib' name 'NWGetSuperHighResolutionTimer';
+function __get_altzone:Ptime_t;cdecl;external 'clib' name '__get_altzone';
+function altzone:Ptime_t;cdecl;external 'clib' name '__get_altzone';
+function __get_daylight:Plongint;cdecl;external 'clib' name '__get_daylight';
+function daylight:Plongint;cdecl;external 'clib' name '__get_daylight';
+function __get_daylightOffset:Ptime_t;cdecl;external 'clib' name '__get_daylightOffset';
+function daylightOffset:Ptime_t;cdecl;external 'clib' name '__get_daylightOffset';
+function __get_daylightOnOff:Plongint;cdecl;external 'clib' name '__get_daylightOnOff';
+function daylightOnOff:Plongint;cdecl;external 'clib' name '__get_daylightOnOff';
+function __get_timezone:Ptime_t;cdecl;external 'clib' name '__get_timezone';
+function timezone:Ptime_t;cdecl;external 'clib' name '__get_timezone';
+procedure SecondsToTicks(Seconds:longint; TenthsOfSeconds:longint; Ticks:Plongint);cdecl;external 'clib' name 'SecondsToTicks';
+procedure TicksToSeconds(Ticks:longint; Seconds:Plongint; TenthsOfSeconds:Plongint);cdecl;external 'clib' name 'TicksToSeconds';
+{-nwthread.h-------------------------------------------------------------------}
+ { values for __action_code used with ExitThread() }
+
+ const
+ TSR_THREAD = -1;
+ EXIT_THREAD = 0;
+ EXIT_NLM = 1;
+ { values for __mode used with spawnxx() }
+ P_WAIT = 0;
+ P_NOWAIT = 1;
+ P_OVERLAY = 2;
+ P_NOWAITO = 4;
+ P_SPAWN_IN_CURRENT_DOMAIN = 8;
+ NO_CONTEXT = 0;
+ USE_CURRENT_CONTEXT = 1;
+ { stack defines }
+ MIN_STACKSIZE = 16384;
+ DEFAULT_STACKSIZE = 16384;
+
+ type
+
+ PWorkToDo = ^TWorkToDo;
+
+ TProcedure = procedure; cdecl;
+ TThreadFunc = procedure (param1:pointer); cdecl;
+ TWorkToDoProc = procedure (data:pointer; workToDo:PWorkToDo); cdecl;
+ TCleanup = procedure (para1:longint); cdecl;
+
+
+ PAESProcessStructure = ^TAESProcessStructure;
+ TAESProcessStructure = record
+ ALink : PAESProcessStructure;
+ AWakeUpDelayAmount : longint;
+ AWakeUpTime : longint;
+ AProcessToCall : procedure (para1:pointer);cdecl;
+ ARTag : longint;
+ AOldLink : longint;
+ end;
+
+
+ PWorkToDoStructure = ^TWorkToDoStructure;
+ TWorkToDoStructure = record
+ Link : PWorkToDoStructure;
+ workProcedure : TProcedure;
+ WorkResourceTag : longint;
+ PollCountAmount : longint;
+ PollCountWhen : longint;
+ userProcedure : TProcedure;
+ dataPtr : pointer;
+ destThreadGroup : longint;
+ end;
+ TWorkToDo = TWorkToDoStructure;
+
+
+
+ { custom data area variables... }
+{
+ var
+ threadCustomDataPtr : pointer;cvar;external;
+ threadCustomDataSize : longint;cvar;external;
+ threadGroupCustomDataPtr : pointer;cvar;external;
+ threadGroupCustomDataSize : longint;cvar;external;
+ }
+
+
+ function AtUnload(func:Tprocedure):longint; cdecl;external ThreadsNlm name 'AtUnload';
+ function BeginThread(func:TThreadFunc;
+ stackP:pointer;
+ stackSize:dword;
+ arg:pointer):longint; cdecl;external ThreadsNlm name 'BeginThread';
+ function BeginThreadGroup(func:TThreadFunc;
+ stackP:pointer;
+ stackSize:dword;
+ arg:pointer):longint; cdecl;external ThreadsNlm name 'BeginThreadGroup';
+ function Breakpoint(arg:longint):longint; cdecl;external Lib0Nlm name 'Breakpoint';
+ procedure CancelNoSleepAESProcessEvent(EventNode:PAESProcessStructure);cdecl;external ThreadsNlm name 'CancelNoSleepAESProcessEvent';
+ procedure CancelSleepAESProcessEvent (EventNode:PAESProcessStructure);cdecl;external ThreadsNlm name 'CancelSleepAESProcessEvent';
+ function ClearNLMDontUnloadFlag(NLMID:longint):longint; cdecl;external ThreadsNlm name 'ClearNLMDontUnloadFlag';
+ procedure delay(milliseconds:dword); cdecl;external ThreadsNlm name 'delay';
+ function EnterCritSec:longint; cdecl;external ThreadsNlm name 'EnterCritSec';
+ function ExitCritSec:longint; cdecl;external ThreadsNlm name 'ExitCritSec';
+ procedure ExitThread(action_code :longint;
+ termination_code:longint); cdecl;external ThreadsNlm name 'ExitThread';
+
+ function FindNLMHandle(NLMFileName:Pchar):TNlmHandle; cdecl;external ThreadsNlm name 'FindNLMHandle';
+ function getcmd(cmdLine:Pchar):Pchar; cdecl;external ThreadsNlm name 'getcmd';
+ function GetNLMHandle:TNlmHandle; cdecl;external ThreadsNlm name 'GetNLMHandle';
+ function GetNLMID:longint; cdecl;external ThreadsNlm name 'GetNLMID';
+ function GetNLMIDFromNLMHandle(NLMHandle:longint):longint; cdecl;external ThreadsNlm name 'GetNLMIDFromNLMHandle';
+ function GetNLMIDFromThreadID(threadID:longint;fileName:Pchar):longint;cdecl;external ThreadsNlm name 'GetNLMIDFromThreadID';
+ function GetNLMNameFromNLMID(NLMID:longint;
+ fileName:Pchar;
+ description:Pchar):longint; cdecl;external ThreadsNlm name 'GetNLMNameFromNLMID';
+ function GetNLMNameFromNLMHandle(NLMHandle:TNlmHandle;
+ LDFileName:Pchar;
+ LDName:Pchar):longint; cdecl;external ThreadsNlm name 'GetNLMNameFromNLMHandle';
+ function GetThreadContextSpecifier(threadID:longint):longint; cdecl;external ThreadsNlm name 'GetThreadContextSpecifier';
+ function GetThreadGroupID:longint; cdecl;external ThreadsNlm name 'GetThreadGroupID';
+ function __GetThreadIDFromPCB(PCB:longint):longint; cdecl;external Lib0Nlm name '__GetThreadIDFromPCB';
+ function GetThreadHandicap(threadID:longint):longint; cdecl;external ThreadsNlm name 'GetThreadHandicap';
+ function GetThreadID:longint; cdecl;external ThreadsNlm name 'GetThreadID';
+ function GetThreadName(threadID:longint; tName:Pchar):longint; cdecl;external ThreadsNlm name 'GetThreadName';
+ function GetThreadName(threadID:longint; var tName):longint; cdecl;external ThreadsNlm name 'GetThreadName';
+ function MapNLMIDToHandle(NLMID:longint):TNlmHandle; cdecl;external ThreadsNlm name 'MapNLMIDToHandle';
+ function PopThreadCleanup(execute:longint):TCLEANUP; cdecl;external ThreadsNlm name 'PopThreadCleanup';
+ function PopThreadGroupCleanup(execute:longint):TCLEANUP; cdecl;external ThreadsNlm name 'PopThreadGroupCleanup';
+ function PushThreadCleanup(func:TCLEANUP):longint; cdecl;external ThreadsNlm name 'PushThreadCleanup';
+ function PushThreadGroupCleanup(func:TCLEANUP):longint; cdecl;external ThreadsNlm name 'PushThreadGroupCleanup';
+ function RenameThread(threadID:longint; newName:Pchar):longint; cdecl;external ThreadsNlm name 'RenameThread';
+ function ResumeThread(threadID:longint):longint; cdecl;external ThreadsNlm name 'ResumeThread';
+ function ReturnNLMVersionInfoFromFile(pathName:pchar;
+ majorVersion:Plongint;
+ minorVersion:Plongint;
+ revision:Plongint;
+ year:Plongint;
+ month:Plongint;
+ day:Plongint;
+ copyrightString:pchar;
+ description:pchar):longint; cdecl;external NlmLibNlm name 'ReturnNLMVersionInfoFromFile';
+ function ReturnNLMVersionInfoFromFile(pathName:pchar;
+ var majorVersion,minorVersion,revision:longint;
+ var year,month,day:longint;
+ copyrightString:pchar;
+ description:pchar):longint; cdecl;external NlmLibNlm name 'ReturnNLMVersionInfoFromFile';
+
+ function ReturnNLMVersionInformation(NLMHandle:TNlmHandle;
+ majorVersion,minorVersion,revision,year,month,day:Plongint;
+ copyrightString:pchar; description:pchar):longint;cdecl;external NlmLibNlm name 'ReturnNLMVersionInformation';
+ function ReturnNLMVersionInformation(NLMHandle:TNlmHandle;
+ var majorVersion,minorVersion,revision,year,month,day:longint;
+ copyrightString:pchar; description:pchar):longint;cdecl;external NlmLibNlm name 'ReturnNLMVersionInformation';
+
+ procedure ScheduleNoSleepAESProcessEvent(EventNode:PAESProcessStructure);cdecl;external ThreadsNlm name 'ScheduleNoSleepAESProcessEvent';
+ procedure ScheduleSleepAESProcessEvent(EventNode:PAESProcessStructure); cdecl;external ThreadsNlm name 'ScheduleSleepAESProcessEvent';
+
+
+ function ScheduleWorkToDo(ProcedureToCall:TWorkToDoProc;
+ workData :pointer;
+ workToDo :PWorkToDo):longint; cdecl;external ThreadsNlm name 'ScheduleWorkToDo';
+ function SetNLMDontUnloadFlag(NLMID:longint):longint; cdecl;external ThreadsNlm name 'SetNLMDontUnloadFlag';
+ function SetNLMID(newNLMID:longint):longint; cdecl;external ThreadsNlm name 'SetNLMID';
+ function SetThreadContextSpecifier(threadID,
+ contextSpecifier:longint):longint; cdecl;external ThreadsNlm name 'SetThreadContextSpecifier';
+ function SetThreadGroupID(newThreadGroupID:longint):longint; cdecl;external ThreadsNlm name 'SetThreadGroupID';
+ procedure SetThreadHandicap(threadID, handicap:longint); cdecl;external ThreadsNlm name 'SetThreadHandicap';
+ function spawnlp(mode:longint;
+ path,arg0:Pchar;
+ args:array of const):longint; cdecl;external ThreadsNlm name 'spawnlp';
+ function spawnlp(mode:longint;
+ path,arg0:Pchar):longint; cdecl;external ThreadsNlm name 'spawnlp';
+ function spawnvp(mode:longint;
+ path,argv:PPchar):longint; cdecl;external ThreadsNlm name 'spawnvp';
+ function SuspendThread(threadID:longint):longint; cdecl;external ThreadsNlm name 'SuspendThread';
+ procedure ThreadSwitch; cdecl;external ThreadsNlm name 'ThreadSwitch';
+ procedure ThreadSwitchLowPriority; cdecl;external ThreadsNlm name 'ThreadSwitchLowPriority';
+ procedure ThreadSwitchWithDelay; cdecl;external ThreadsNlm name 'ThreadSwitchWithDelay';
+{-nwmediam.h-------------------------------------------------------------------}
+{$include npackon.inc}
+
+const
+ FORMAT_MEDIA = $0000;
+ TAPE_CONTROL = $0001;
+ ACTIVATE_FUNCTIONS = $0003;
+ MOUNT_FUNCTIONS = $0004;
+ SELECT_FUNCTIONS = $0005;
+ INSERTION_FUNCTIONS = $0006;
+ LOCK_FUNCTIONS = $0007;
+ MOVE_FUNCTIONS = $0008;
+ STAMP_FUNCTIONS = $0009;
+ SCAN_FUNCTIONS = $000A;
+ MAGAZINE_FUNCTIONS = $000D;
+{ IO Functions }
+ RANDOM_READ = $0020;
+ RANDOM_WRITE = $0021;
+ RANDOM_WRITE_ONCE = $0022;
+ SEQUENTIAL_READ = $0023;
+ SEQUENTIAL_WRITE = $0024;
+ RESET_END_OF_TAPE = $0025;
+ SINGLE_FILE_MARK = $0026;
+ MULTIPLE_FILE_MARK = $0027;
+ SINGLE_SET_MARK = $0028;
+ MULTIPLE_SET_MARK = $0029;
+ SPACE_DATA_BLOCKS = $002A;
+ LOCATE_DATA_BLOCKS = $002B;
+ POSITION_PARTITION = $002C;
+ POSITION_MEDIA = $002D;
+ DEVICE_GENERIC_IOCTL = $003E;
+{ Object Types }
+ UNKNOWN_OBJECT = $FFFF;
+ ADAPTER_OBJECT = 0;
+ CHANGER_OBJECT = 1;
+ DEVICE_OBJECT = 2;
+ MEDIA_OBJECT = 4;
+ PARTITION_OBJECT = 5;
+ SLOT_OBJECT = 6;
+ HOTFIX_OBJECT = 7;
+ MIRROR_OBJECT = 8;
+ PARITY_OBJECT = 9;
+ VOLUME_SEG_OBJECT = 10;
+ VOLUME_OBJECT = 11;
+ CLONE_OBJECT = 12;
+ MAGAZINE_OBJECT = 14;
+ UNIDENTIFIABLE_MEDIA = $00000001;
+ HIGH_SIERRA_CDROM_MEDIA = $00000002;
+ ISO_CDROM_MEDIA = $00000003;
+ MAC_CDROM_MEDIA = $00000004;
+ NETWARE_FILE_SYSTEM_MEDIA = $00000005;
+ INTERNAL_IDENTIFY_TYPE = $00000007;
+ SMS_MEDIA_TYPE = $00000008;
+{ Notify Event Bits }
+ NOTIFY_OBJECT_CREATION = $0001;
+ NOTIFY_OBJECT_DELETION = $0002;
+ NOTIFY_OBJECT_ACTIVATED = $0004;
+ NOTIFY_OBJECT_DEACTIVATED = $0008;
+ NOTIFY_OBJECT_RESERVATION = $0010;
+ NOTIFY_OBJECT_UNRESERVATION = $0020;
+{ Object Status Bits }
+ OBJECT_ACTIVATED = $00000001;
+ OBJECT_PHANTOM = $00000002;
+ OBJECT_ASSIGNABLE = $00000004;
+ OBJECT_ASSIGNED = $00000008;
+ OBJECT_RESERVED = $00000010;
+ OBJECT_BEING_IDENTIFIED = $00000020;
+ OBJECT_MAGAZINE_LOADED = $00000040;
+ OBJECT_FAILURE = $00000080;
+ OBJECT_REMOVABLE = $00000100;
+ OBJECT_READ_ONLY = $00000200;
+ OBJECT_IN_DEVICE = $00010000;
+ OBJECT_ACCEPTS_MAGAZINES = $00020000;
+ OBJECT_IS_IN_A_CHANGER = $00040000;
+ OBJECT_LOADABLE = $00080000;
+ OBJECT_BEING_LOADED = $00080000;
+ OBJECT_DEVICE_LOCK = $01000000;
+ OBJECT_CHANGER_LOCK = $02000000;
+ OBJECT_REMIRRORING = $04000000;
+ OBJECT_SELECTED = $08000000;
+{ Resource Tag Allocation Signatures }
+{ 'PAMM' }
+ MMApplicationSignature = $50424D4D;
+{ 'ONMM' }
+ MMNotifySignature = $4F4E4D4D;
+{ 'DIMM' }
+ MMIdentifySignature = $44494D4D;
+{ AlertTypes }
+ ALERT_MESSAGE = $00000001;
+ ALERT_ACTIVATE = $00000002;
+ ALERT_DEACTIVATE = $00000003;
+ ALERT_DELETE = $00000004;
+{ AlertReasons }
+ ALERT_HOTFIX_ERROR = $00000000;
+ ALERT_DRIVER_UNLOAD = $00000001;
+ ALERT_DEVICE_FAILURE = $00000002;
+ ALERT_PROGRAM_CONTROL = $00000003;
+ ALERT_MEDIA_DISMOUNT = $00000004;
+ ALERT_MEDIA_EJECT = $00000005;
+ ALERT_SERVER_DOWN = $00000006;
+ ALERT_SERVER_FAILURE = $00000007;
+ ALERT_MEDIA_LOAD = $00000008;
+ ALERT_MEDIA_MOUNT = $00000009;
+ ALERT_DRIVER_LOAD = $0000000A;
+ ALERT_LOST_SOFTWARE_FAULT_TOLERANCE = $0000000B;
+ ALERT_INTERNAL_OBJECT_DELETE = $0000000C;
+ ALERT_MAGAZINE_LOAD = $0000000D;
+ ALERT_MAGAZINE_UNLOAD = $0000000E;
+ ALERT_DEVICE_GOING_TO_BE_REMOVED = $0000000F;
+ ALERT_CHECK_DEVICE = $00000010;
+ ALERT_CONFIGURATION_CHANGE = $00000011;
+ ALERT_APPLICATION_UNREGISTER = $00000012;
+ ALERT_DAI_EMMULATION = $00000013;
+ ALERT_LOST_HARDWARE_FAULT_TOLERANCE = $00000014;
+ ALERT_INTERNAL_OBJECT_CREATE = $00000015;
+ ALERT_INTERNAL_MANAGER_REMOVE = $00000016;
+ ALERT_DEVICE_GOING_TO_BE_DEACTIVATED = $00000017;
+ ALERT_DEVICE_END_OF_MEDIA = $00000018;
+ ALERT_MEDIA_INSERTED = $00000019;
+ ALERT_UNKNOWN_DEVICE_ALERT = $0000001A;
+ ALERT_UNKNOWN_ADAPTER_ALERT = $0000001B;
+{ Function Control (Priority) Bits }
+ PRIORITY_1 = $0001;
+ PRIORITY_2 = $0002;
+ ACCELERATED_BIT = $0004;
+ ELEVATOR_OFF_BIT = $0008;
+ RETURN_RAW_COMPLETION = $0010;
+ SCRAMBLE_BIT = $0020;
+{ Application Alert Codes }
+ GOING_TO_BE_DEACTIVATED = $0001;
+ OBJECT_BEING_DEACTIVATED = $0002;
+ OBJECT_SIZE_CHANGED = $0003;
+ OBJECT_BEING_ACTIVATED = $0004;
+ OBJECT_BEING_DELETED = $0005;
+ OBJECT_LOST_FAULT_TOLERANCE = $0006;
+{ Initial Completion Codes }
+ MESSAGE_PROCESSED = $00;
+ MESSAGE_DATA_MISSING = $01;
+ MESSAGE_POSTPONE = $02;
+ MESSAGE_ABORTED = $03;
+ MESSAGE_INVALID_PARAMETERS = $04;
+ MESSAGE_OBJECT_NOT_ACTIVE = $05;
+ MESSAGE_INVALID_OJECT = $06;
+ MESSAGE_FUNCTION_NOT_SUPPORTED = $07;
+ MESSAGE_INVALID_MODE = $08;
+ MESSAGE_INTERNAL_ERROR = $09;
+{ FinalCompletion Codes }
+ FUNCTION_OK = $00;
+ FUNCTION_CORRECTED_MEDIA_ERROR = $10;
+ FUNCTION_MEDIA_ERROR = $11;
+ FUNCTION_DEVICE_ERROR = $12;
+ FUNCTION_ADAPTER_ERROR = $13;
+ FUNCTION_NOT_SUPPORTED_BY_DEVICE = $14;
+ FUNCTION_NOT_SUPPORTED_BY_DRIVER = $15;
+ FUNCTION_PARAMETER_ERROR = $16;
+ FUNCTION_MEDIA_NOT_PRESENT = $17;
+ FUNCTION_MEDIA_CHANGED = $18;
+ FUNCTION_PREVIOUSLY_WRITTEN = $19;
+ FUNCTION_MEDIA_NOT_FORMATED = $1A;
+ FUNCTION_BLANK_MEDIA = $1B;
+{end of partition }
+ FUNCTION_END_OF_MEDIA = $1C;
+ FUNCTION_FILE_MARK_DETECTED = $1D;
+ FUNCTION_SET_MARK_DETECTED = $1E;
+ FUNCTION_WRITE_PROTECTED = $1F;
+ FUNCTION_OK_EARLY_WARNING = $20;
+ FUNCTION_BEGINNING_OF_MEDIA = $21;
+ FUNCTION_MEDIA_NOT_FOUND = $22;
+ FUNCTION_MEDIA_NOT_REMOVED = $23;
+ FUNCTION_UNKNOWN_COMPLETION = $24;
+ FUNCTION_DATA_MISSING = $25;
+ FUNCTION_HOTFIX_ERROR = $26;
+ FUNCTION_HOTFIX_UPDATE_ERROR = $27;
+ FUNCTION_IO_ERROR = $28;
+ FUNCTION_CHANGER_SOURCE_EMPTY = $29;
+ FUNCTION_CHANGER_DEST_FULL = $2A;
+ FUNCTION_CHANGER_JAMMED = $2B;
+ FUNCTION_MAGAZINE_NOT_PRESENT = $2D;
+ FUNCTION_MAGAZINE_SOURCE_EMPTY = $2E;
+ FUNCTION_MAGAZINE_DEST_FULL = $2F;
+ FUNCTION_MAGAZINE_JAMMED = $30;
+ FUNCTION_ABORT_CAUSED_BY_PRIOR_ERROR = $31;
+ FUNCTION_CHANGER_ERROR = $32;
+ FUNCTION_MAGAZINE_ERROR = $33;
+{ ErrorCodes }
+ MM_OK = $00;
+ MM_INVALID_OBJECT = $01;
+ MM_INVALID_APPLICATION = $02;
+ MM_INVALID_RESOURCETAG = $03;
+ MM_MEMORY_ALLOCATION_ERROR = $04;
+ MM_INVALID_MODE = $05;
+ MM_RESERVATION_CONFLICT = $06;
+ MM_PARAMETER_ERROR = $07;
+ MM_OBJECT_NOT_FOUND = $08;
+ MM_ATTRIBUTE_NOT_SETABLE = $09;
+ MM_FAILURE = $0A;
+{ Console Human Jukebox Definitions }
+ HJ_INSERT_MESSAGE = 0;
+ HJ_EJECT_MESSAGE = 1;
+ HJ_ACK_MESSAGE = 2;
+ HJ_NACK_MESSAGE = 3;
+ HJ_ERROR = 4;
+{ Media Manager Structures }
+type
+ PMM_F1_Structure = ^TMM_F1_Structure;
+ TMM_F1_Structure = record
+ code : word;
+ control : word;
+ end;
+
+ PPrivateIOConfigurationStucture = ^TPrivateIOConfigurationStucture;
+ TPrivateIOConfigurationStucture = record
+ f1 : longint;
+ f2 : word;
+ f3 : word;
+ f4 : array[0..3] of word;
+ f5 : longint;
+ f6 : word;
+ f7 : longint;
+ f8 : word;
+ f9 : array[0..1] of byte;
+ f10 : array[0..1] of byte;
+ f11 : longint;
+ f12 : longint;
+ f13 : longint;
+ f14 : array[0..17] of byte;
+ f15 : array[0..1] of longint;
+ f16 : word;
+ f17 : array[0..5] of byte;
+ end;
+
+ PAdapterInfoDef = ^TAdapterInfoDef;
+ TAdapterInfoDef = record
+ systemtype : byte;
+ processornumber : byte;
+ uniquetag : word;
+ systemnumber : longint;
+ devices : array[0..31] of longint;
+ configinfo : TPrivateIOConfigurationStucture;
+ drivername : array[0..35] of byte;
+ systemname : array[0..63] of byte;
+ numberofdevices : longint;
+ reserved : array[0..6] of longint;
+ end;
+
+ PAttributeInfoDef = ^TAttributeInfoDef;
+ TAttributeInfoDef = record
+ name : array[0..63] of byte;
+ attributetype : longint;
+ nextattributeid : longint;
+ attributesize : longint;
+ end;
+
+ PChangerInfoDef = ^TChangerInfoDef;
+ TChangerInfoDef = record
+ numberofdevices : longint;
+ numberofslots : longint;
+ numberofmailslots : longint;
+ reserved : array[0..7] of longint;
+ slotmappingtable : array[0..0] of longint;
+ end;
+
+ PDeviceInfoDef = ^TDeviceInfoDef;
+ TDeviceInfoDef = record
+ status : longint;
+ controllernumber : byte;
+ drivenumber : byte;
+ cardnumber : byte;
+ systemtype : byte;
+ accessflags : byte;
+ _type : byte;
+ blocksize : byte;
+ sectorsize : byte;
+ heads : byte;
+ sectors : byte;
+ cylinders : word;
+ capacity : longint;
+ mmadapternumber : longint;
+ mmmedianumber : longint;
+ rawname : array[0..39] of byte;
+ reserved : array[0..7] of longint;
+ end;
+
+ PPrivateMediaInfoDef = ^TPrivateMediaInfoDef;
+ TPrivateMediaInfoDef = record
+ f1 : array[0..63] of byte;
+ f2 : longint;
+ f3 : longint;
+ end;
+
+ PGenericInfoDef = ^TGenericInfoDef;
+ TGenericInfoDef = record
+ mediainfo : TPrivateMediaInfoDef;
+ mediatype : longint;
+ cartridgetype : longint;
+ unitsize : longint;
+ blocksize : longint;
+ capacity : longint;
+ preferredunitsize : longint;
+ name : array[0..63] of byte;
+ _type : longint;
+ status : longint;
+ functionmask : longint;
+ controlmask : longint;
+ parentcount : longint;
+ siblingcount : longint;
+ childcount : longint;
+ specificinfosize : longint;
+ objectuniqueid : longint;
+ mediaslot : longint;
+ end;
+
+ PHotfixInfoDef = ^THotfixInfoDef;
+ THotfixInfoDef = record
+ hotfixoffset : longint;
+ hotfixidentifier : longint;
+ numberoftotalblocks : longint;
+ numberofusedblocks : longint;
+ numberofavailableblocks : longint;
+ numberofsystemblocks : longint;
+ reserved : array[0..7] of longint;
+ end;
+
+ PIdentifierInfoDef = ^TIdentifierInfoDef;
+ TIdentifierInfoDef = record
+ applicationtype : longint;
+ mediatype : longint;
+ cartridgetype : longint;
+ name : array[0..63] of byte;
+ stampflag : longint;
+ end;
+
+ PInsertRequestDef = ^TInsertRequestDef;
+ TInsertRequestDef = record
+ devicenumber : longint;
+ mailslot : longint;
+ medianumber : longint;
+ mediacount : longint;
+ end;
+
+ PMagazineInfoDef = ^TMagazineInfoDef;
+ TMagazineInfoDef = record
+ numberofslots : longint;
+ reserved : array[0..7] of longint;
+ slotmappingtable : array[0..0] of longint;
+ end;
+
+ PMappintInfoHeaderDef = ^TMappintInfoHeaderDef;
+ TMappintInfoHeaderDef = record
+ parentcount : longint;
+ siblingcount : longint;
+ childcount : longint;
+ end;
+
+ PMediaInfoDef = ^TMediaInfoDef;
+ TMediaInfoDef = record
+ _label : array[0..63] of byte;
+ identificationtype : longint;
+ identificationtimestamp : longint;
+ end;
+
+ PMediaRequestDef = ^TMediaRequestDef;
+ TMediaRequestDef = record
+ devicenumber : longint;
+ mailslot : longint;
+ medianumber : longint;
+ mediacount : longint;
+ end;
+
+ PMirrorInfoDef = ^TMirrorInfoDef;
+ TMirrorInfoDef = record
+ mirrorcount : longint;
+ mirroridentifier : longint;
+ mirrormembers : array[0..7] of longint;
+ mirrorsynchflags : array[0..7] of byte;
+ reserved : array[0..7] of longint;
+ end;
+
+ PPartitionInfoDef = ^TPartitionInfoDef;
+ TPartitionInfoDef = record
+ partitionertype : longint;
+ partitiontype : longint;
+ partitionoffset : longint;
+ partitionsize : longint;
+ reserved : array[0..7] of longint;
+ end;
+
+{ these also correspond to offsets in struct ObjectDef }
+ PResourceTagDef = ^TResourceTagDef;
+ TResourceTagDef = record
+ reserved : array[0..1] of longint;
+ resourcetagtype : longint;
+ resourcetagcount : longint;
+ resourcenext : PResourceTagDef;
+ resourcelast : PResourceTagDef;
+ end;
+
+{$include npackoff.inc}
+
+function HJ_Media_Request_Ack(minfo:PInsertRequestDef; ackcode:longint; uniqueid:longint):longint;cdecl;external 'clib' name 'HJ_Media_Request_Ack';
+function MM_Abort_Function(messagehandle:longint):longint;cdecl;external 'clib' name 'MM_Abort_Function';
+function MM_Check_For_Pending_Aborts(OSRequestHandle:longint):longint;cdecl;external 'clib' name 'MM_Check_For_Pending_Aborts';
+function MM_Create_Media_Object(objectnumber:longint; mediainfo:PMediaInfoDef):longint;cdecl;external 'clib' name 'MM_Create_Media_Object';
+procedure MM_ExecuteMessages;cdecl;external 'clib' name 'MM_ExecuteMessages';
+function MM_Find_Identifier(lastidentifiernumber:Plongint):longint;cdecl;external 'clib' name 'MM_Find_Identifier';
+function MM_Find_Identifier(var lastidentifiernumber:longint):longint;cdecl;external 'clib' name 'MM_Find_Identifier';
+function MM_Find_Object_Type(typ:longint; nextindicator:Plongint):longint;cdecl;external 'clib' name 'MM_Find_Object_Type';
+function MM_Find_Object_Type(typ:longint; var nextindicator:longint):longint;cdecl;external 'clib' name 'MM_Find_Object_Type';
+function MM_Object_Blocking_IO (returnparameter:Plongint;
+ objecthandle:longint;
+ _function:TMM_F1_Structure;
+ parameter0:longint;
+ parameter1:longint;
+ parameter2:longint;
+ bufferlength:longint;
+ buffer:pointer):longint;cdecl;external 'clib' name 'MM_Object_Blocking_IO';
+function MM_Object_Blocking_IO (var returnparameter:longint;
+ objecthandle:longint;
+ _function:TMM_F1_Structure;
+ parameter0:longint;
+ parameter1:longint;
+ parameter2:longint;
+ bufferlength:longint;
+ var buffer):longint;cdecl;external 'clib' name 'MM_Object_Blocking_IO';
+// This call is not handled by the server libraries
+//function MM_Object_IO(messagehandle:Plongint; applicationrequesthandle:longint; objecthandle:longint; _function:TMM_F1_Structure; parameter0:longint;
+// parameter1:longint; parameter2:longint; bufferlength:longint; buffer:pointer; callbackroutine:procedure ):longint;cdecl;external 'clib' name 'MM_Object_IO';
+
+type TLongintCDeclFunc = function :longint; cdecl;
+ TCdeclProc = procedure; cdecl;
+
+function MM_Register_Application (applicationhandle:Plongint;
+ applicationid:longint;
+ name:PChar;
+ reserved:longint;
+ mediaconsoleroutine:TLongintCDeclFunc;
+ resourcetag:PResourceTagDef):longint;cdecl;external 'clib' name 'MM_Register_Application';
+
+function MM_Register_Identification_Routines (oshandle:Plongint;
+ applicationhandle:longint;
+ identifyroutine:TLongintCDeclFunc;
+ unstamproutine:TLongintCDeclFunc;
+ stamproutine:TLongintCDeclFunc;
+ identifiertype:longint;
+ identifiername:PBYTE;
+ resourcetag:PResourceTagDef):longint;cdecl;external 'clib' name 'MM_Register_Identification_Routines';
+function MM_Register_Notify_Routine (oshandle:Plongint;
+ applicationhandle:longint;
+ notifyroutine:TCdeclProc;
+ objectclass:longint;
+ eventmask:longint;
+ resourcetag:PResourceTagDef):longint;cdecl;external 'clib' name 'MM_Register_Notify_Routine';
+// This call is not handled by the server libraries
+//function MM_Release_Object(objecthandle:longint; applicationhandle:longint):longint;cdecl;external 'clib' name 'MM_Release_Object';
+
+function MM_Release_Unload_Semaphore(currentinstance:longint):longint;cdecl;external 'clib' name 'MM_Release_Unload_Semaphore';
+function MM_Rename_Object(objectID:longint; para2:PBYTE):longint;cdecl;external 'clib' name 'MM_Rename_Object';
+// This call is not handled by the server libraries
+//function MM_Reserve_Object(objecthandle:Plongint; applicationidentifier:longint; objectid:longint; iomode:longint; applicationhandle:longint;
+// notifyroutine:function :longint):longint;cdecl;external 'clib' name 'MM_Reserve_Object';
+
+function MM_Return_Identifier_Info(identifiernumber:longint; info:PIdentifierInfoDef):longint;cdecl;external 'clib' name 'MM_Return_Identifier_Info';
+function MM_Return_Object_Attribute(objectid:longint; attributeid:longint; length:longint; info:pointer):longint;cdecl;external 'clib' name 'MM_Return_Object_Attribute';
+function MM_Return_Object_Generic_Info(objectid:longint; info:PGenericInfoDef):longint;cdecl;external 'clib' name 'MM_Return_Object_Generic_Info';
+function MM_Return_Object_Mapping_Info(objectid:longint; mappinginfolength:longint; mappinginfo:Plongint):longint;cdecl;external 'clib' name 'MM_Return_Object_Mapping_Info';
+function MM_Return_Object_Specific_Info(objectid:longint; infolength:longint; info:pointer):longint;cdecl;external 'clib' name 'MM_Return_Object_Specific_Info';
+function MM_Return_Object_Table_Size:longint;cdecl;external 'clib' name 'MM_Return_Object_Table_Size';
+function MM_Return_Objects_Attributes(objectid:longint; attributeid:longint; info:PAttributeInfoDef):longint;cdecl;external 'clib' name 'MM_Return_Objects_Attributes';
+function MM_Set_Object_Attribute(objecthandle:longint; attributeid:longint; length:longint; info:pointer):longint;cdecl;external 'clib' name 'MM_Set_Object_Attribute';
+function MM_Set_Unload_Semaphore(currentinstance:Plongint):longint;cdecl;external 'clib' name 'MM_Set_Unload_Semaphore';
+function MM_Special_Object_Blocking_IO(returnparameter:Plongint; objectnumber:longint; _function:TMM_F1_Structure; parameter0:longint; parameter1:longint;
+ parameter2:longint; bufferlength:longint; buffer:pointer):longint;cdecl;external 'clib' name 'MM_Special_Object_Blocking_IO';
+function MM_Unregister_Application(applicationhandle,applicationid:longint):longint;cdecl;external 'clib' name 'MM_Unregister_Application';
+function MM_Unregister_Identification_Routines(handle,applicationtype:longint):longint;cdecl;external 'clib' name 'MM_Unregister_Identification_Routines';
+function MM_Unregister_Notify_Routine(oshandle, applicationhandle:longint):longint;cdecl;external 'clib' name 'MM_Unregister_Notify_Routine';
+{-ioctl.h----------------------------------------------------------------------}
+const
+ I_NWRITE = 101;
+ I_SETBUF = 102;
+
+function ioctl(fd:longint; command:longint; args:array of const):longint;cdecl;external 'clib' name 'ioctl';
+function ioctl(fd:longint; command:longint):longint;cdecl;external 'clib' name 'ioctl';
+{-sys/socket.h-----------------------------------------------------------------}
+{$PACKRECORDS C}
+
+type
+ Piovec = ^Tiovec;
+ Tiovec = record
+ iov_base : Pchar;
+ iov_len : longint;
+ end;
+
+{ Berkeley Sockets definitions and types }
+
+const
+ FD_SETSIZE = 16;
+type
+
+ Pfd_array = ^Tfd_array;
+ Tfd_array = longint;
+
+ Pfd_set = ^Tfd_set;
+ Tfd_set = record
+ fds : Tfd_array;
+ end;
+
+ Ptimeval = ^Ttimeval;
+ Ttimeval = record
+ tv_sec : longint;
+ tv_usec : longint;
+ end;
+
+{ definitions related to sockets: types, address families, options }
+{ types }
+{ just NW OFSD, no socket }
+
+const
+ SOCK_NULL = 0;
+{ stream socket }
+ SOCK_STREAM = 1;
+{ datagram socket }
+ SOCK_DGRAM = 2;
+{ raw-protocol interface }
+ SOCK_RAW = 3;
+{ reliably-delivered message }
+ SOCK_RDM = 4;
+{ sequenced packet stream }
+ SOCK_SEQPACKET = 5;
+{ option flags per-socket }
+{ turn on debugging info recording }
+ SO_DEBUG = $0001;
+{ socket has had listen() }
+ SO_ACCEPTCONN = $0002;
+{ allow local address reuse }
+ SO_REUSEADDR = $0004;
+{ keep connections alive }
+ SO_KEEPALIVE = $0008;
+{ just use interface addresses }
+ SO_DONTROUTE = $0010;
+{ permit sending of broadcast msgs }
+ SO_BROADCAST = $0020;
+{ bypass hardware when possible }
+ SO_USELOOPBACK = $0040;
+{ linger on close if data present }
+ SO_LINGER = $0080;
+{ leave received OOB data in line }
+ SO_OOBINLINE = $0100;
+{
+ N.B.: The following definition is present only for compatibility with
+ release 3.0. It will disappear in later releases.
+ }
+{ ~SO_LINGER }
+ SO_DONTLINGER = not (SO_LINGER);
+{ additional options, not kept in so_options }
+{ send buffer size }
+ SO_SNDBUF = $1001;
+{ receive buffer size }
+ SO_RCVBUF = $1002;
+{ send low-water mark }
+ SO_SNDLOWAT = $1003;
+{ receive low-water mark }
+ SO_RCVLOWAT = $1004;
+{ send timeout }
+ SO_SNDTIMEO = $1005;
+{ receive timeout }
+ SO_RCVTIMEO = $1006;
+{ get error status and clear }
+ SO_ERROR = $1007;
+{ get socket type }
+ SO_TYPE = $1008;
+{ additional option to be used with level IPPROTO_TCP }
+{ turn off the Nagle delay algorithm }
+ TCP_NODELAY = 1;
+
+ SIOCATMARK = 8; // at oob mark?
+ SIOCDGRAMSIZE = 500;
+ IP_INBOUND_IF = 501;
+ IP_OUTBOUND_IF = 502;
+
+
+{ structure used for manipulating linger option }
+{ option on/off }
+{ linger time }
+
+type
+ Plinger = ^Tlinger;
+ Tlinger = record
+ l_onoff : longint;
+ l_linger : longint;
+ end;
+
+{ level number for get/setsockopt() to apply to socket itself }
+{ options for socket level }
+
+const
+ SOL_SOCKET = $ffff;
+{ address families }
+{ unspecified }
+ AF_UNSPEC = 0;
+{ local to host (pipes, portals) }
+ AF_UNIX = 1;
+{ internetwork: UDP, TCP, etc. }
+ AF_INET = 2;
+{ Xerox NS protocols }
+ AF_NS = 6;
+{ AppleTalk }
+ AF_APPLETALK = 16;
+{ umbrella for all (e.g. protosw lookup) }
+ AF_OSI = 19;
+{ U.S. Government OSI }
+ AF_GOSIP = 22;
+ AF_MAX = 21;
+{ structure used by kernel to store most addresses }
+{ address family }
+{ up to 14 bytes of direct address }
+type
+ Psockaddr = ^Tsockaddr;
+ Tsockaddr = record
+ sa_family : word;
+ sa_data : array[0..13] of char;
+ end;
+
+{ structure used by kernel to pass protocol information in raw sockets }
+{ address family }
+{ protocol }
+ Psockproto = ^Tsockproto;
+ Tsockproto = record
+ sp_family : word;
+ sp_protocol : word;
+ end;
+
+{ protocol families, same as address families for now }
+
+const
+ PF_UNSPEC = AF_UNSPEC;
+ PF_UNIX = AF_UNIX;
+ PF_INET = AF_INET;
+ PF_NS = AF_NS;
+ PF_APPLETALK = AF_APPLETALK;
+ PF_OSI = AF_OSI;
+ PF_GOSIP = AF_GOSIP;
+ PF_MAX = AF_MAX;
+{ test protocol "numbered pipe" }
+ TSTPROTO_NPIPE = 0;
+{ maximum queue length specifiable by listen }
+ SOMAXCONN = 5;
+{
+ Message header for recvmsg and sendmsg calls.
+ }
+{ optional address }
+{ size of address }
+{ scatter/gather array }
+{ number of elements in msg_iov }
+{ access rights sent/received }
+type
+ Pmsghdr = ^Tmsghdr;
+ Tmsghdr = record
+ msg_name : Pchar;
+ msg_namelen : longint;
+ msg_iov : Piovec;
+ msg_iovlen : longint;
+ msg_accrights : Pchar;
+ msg_accrightslen : longint;
+ end;
+
+{ process out-of-band data }
+
+const
+ MSG_OOB = $1;
+{ peek at incoming message }
+ MSG_PEEK = $2;
+{ send without using routing tables }
+ MSG_DONTROUTE = $4;
+ MSG_MAXIOVLEN = 16;
+{ for NLM clients }
+type TSKT = longint;
+
+function accept(s:TSKT; addr:Psockaddr; addrlen:Plongint):longint;cdecl;external 'clib' name 'accept';
+function accept(s:TSKT; var addr:Tsockaddr; var addrlen:longint):longint;cdecl;external 'clib' name 'accept';
+function bind(s:TSKT; name:Psockaddr; namelen:longint):longint;cdecl;external 'clib' name 'bind';
+function connect(s:TSKT; name:Psockaddr; namelen:longint):longint;cdecl;external 'clib' name 'connect';
+function getpeername(s:TSKT; name:Psockaddr; namelen:Plongint):longint;cdecl;external 'clib' name 'getpeername';
+function getsockname(s:TSKT; name:Psockaddr; namelen:Plongint):longint;cdecl;external 'clib' name 'getsockname';
+function getsockopt(s:TSKT; level:longint; name:longint; val:Pchar; len:Plongint):longint;cdecl;external 'clib' name 'getsockopt';
+function getsockopt(s:TSKT; level:longint; name:longint; val:Pchar; var len:longint):longint;cdecl;external 'clib' name 'getsockopt';
+
+function listen(s:TSKT; backlog:longint):longint;cdecl;external 'clib' name 'listen';
+function readv(s:TSKT; iov:Piovec; iovcnt:longint):longint;cdecl;external 'clib' name 'readv';
+function recv(s:TSKT; msg:Pchar; len:longint; flags:longint):longint;cdecl;external 'clib' name 'recv';
+function recv(s:TSKT; var data; len:longint; flags:longint):longint;cdecl;external 'clib' name 'recv';
+
+function recvfrom(s:TSKT; msg:Pchar; len:longint; flags:longint; from:Psockaddr;
+ fromlen:Plongint):longint;cdecl;external 'clib' name 'recvfrom';
+function recvfrom(s:TSKT; var data; len:longint; flags:longint; from:Psockaddr;
+ var fromlen:longint):longint;cdecl;external 'clib' name 'recvfrom';
+
+function recvmsg(s:TSKT; msg:Pmsghdr; flags:longint):longint;cdecl;external 'clib' name 'recvmsg';
+function send(s:TSKT; msg:Pchar; len:longint; flags:longint):longint;cdecl;external 'clib' name 'send';
+function send(s:TSKT; var data; len:longint; flags:longint):longint;cdecl;external 'clib' name 'send';
+function sendto(s:TSKT; msg:Pchar; len:longint; flags:longint; _to:Psockaddr;
+ tolen:longint):longint;cdecl;external 'clib' name 'sendto';
+function sendto(s:TSKT; var data; len:longint; flags:longint; _to:Psockaddr;
+ tolen:longint):longint;cdecl;external 'clib' name 'sendto';
+
+function sendmsg(s:TSKT; msg:Pmsghdr; flags:longint):longint;cdecl;external 'clib' name 'sendmsg';
+function setsockopt(s:TSKT; level:longint; name:longint; val:Pchar; len:longint):longint;cdecl;external 'clib' name 'setsockopt';
+function setsockopt(s:TSKT; level:longint; name:longint; var value; len:longint):longint;cdecl;external 'clib' name 'setsockopt';
+function shutdown(s:TSKT; how:longint):longint;cdecl;external 'clib' name 'shutdown';
+function socket(domain:longint; _type:longint; protocol:longint):longint;cdecl;external 'clib' name 'socket';
+function writev(s:TSKT; iov:Piovec; iovcnt:longint):longint;cdecl;external 'clib' name 'writev';
+function select(width:longint; readfds:Pfd_set; writefds:Pfd_set; exceptfds:Pfd_set; timeout:Ptimeval):longint;cdecl;external 'clib' name 'select';
+
+{-sys/time.h-------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+{ commonly-used definitions... }
+
+const
+ SEC = 1;
+ MILLISEC = 1000;
+ MICROSEC = 1000000;
+ NANOSEC = 1000000000;
+{ wall clock, bound to LWP }
+ __CLOCK_REALTIME0 = 0;
+{ user CPU usage clock }
+ CLOCK_VIRTUAL = 1;
+{ user and system CPU usage clock }
+ CLOCK_PROF = 2;
+{ wall clock, not bound }
+ __CLOCK_REALTIME3 = 3;
+ CLOCK_REALTIME = __CLOCK_REALTIME3;
+{ set timer relative }
+ TIMER_RELTIME = $0;
+{ set timer absolute }
+ TIMER_ABSTIME = $1;
+{ time expressed in seconds and nanoseconds }
+{ seconds }
+{ and nanoseconds }
+type
+
+ Ptimespec = ^Ttimespec;
+ Ttimespec = record
+ tv_sec : Ttime_t;
+ tv_nsec : longint;
+ end;
+ Ttimespec_t = Ttimespec;
+ Ptimespec_t = ^Ttimespec_t;
+ Ttimestrc_t = Ttimespec;
+ Ptimestrc_t = ^Ttimestrc_t;
+
+{-sys/utsname.h----------------------------------------------------------------}
+const
+ _SYS_NMLN = 260;
+
+type
+ Putsname = ^Tutsname;
+ Tutsname = record
+ sysname : array[0..(_SYS_NMLN)-1] of char; // name of operating system implementation
+ release : array[0..(_SYS_NMLN)-1] of char;
+ version : array[0..(_SYS_NMLN)-1] of char;
+ nodename : array[0..(_SYS_NMLN)-1] of char;
+ machine : array[0..(_SYS_NMLN)-1] of char;
+ _library : array[0..(_SYS_NMLN)-1] of char;
+ end;
+
+function uname(name:Putsname):longint;cdecl;external 'clib' name 'uname';
+function uname(var name:Tutsname):longint;cdecl;external 'clib' name 'uname';
+
+{-sys/stat.h-------------------------------------------------------------------}
+{$PACKRECORDS C}
+
+{ POSIX file types }
+{ type of file (mask for following) }
+
+const
+ S_IFMT = 0170000;
+{ first-in/first-out (pipe) }
+ S_IFIFO = 0010000;
+{ character-special file }
+ S_IFCHR = 0020000;
+{ directory }
+ S_IFDIR = 0040000;
+{ blocking device (not used on NetWare) }
+ S_IFBLK = 0060000;
+{ regular }
+ S_IFREG = 0100000;
+{ symbolic link (not used on NetWare) }
+ S_IFLNK = 0120000;
+{ Berkeley socket }
+ S_IFSOCK = 0140000;
+
+{ POSIX file modes: owner (user) permission }
+
+const
+ S_IRWXU = 0000700;
+ S_IRUSR = 0000400;
+ S_IWUSR = 0000200;
+ S_IXUSR = 0000100;
+ S_IREAD = S_IRUSR;
+ S_IWRITE = S_IWUSR;
+ S_IEXEC = S_IXUSR;
+{ POSIX file modes: group permission }
+ S_IRWXG = 0000070;
+ S_IRGRP = 0000040;
+ S_IWGRP = 0000020;
+ S_IXGRP = 0000010;
+{ POSIX file modes: other permission }
+ S_IRWXO = 0000007;
+ S_IROTH = 0000004;
+ S_IWOTH = 0000002;
+ S_IXOTH = 0000001;
+{ Novell-defined additional directory modes for mkdir() }
+{ system directory }
+ S_DSYSTEM = $00100000;
+{ hidden directory }
+ S_DHIDE = $00200000;
+{ delete-inhibit }
+ S_DDEL_INH = $00400000;
+{ rename-inhibit }
+ S_DREN_INH = $00800000;
+{ purge-immediate }
+ S_DPURGE_IMM = $01000000;
+{ compress-immediate }
+ S_DCOMP_IMM = $02000000;
+{ no compression }
+ S_DCOMP_NO = $04000000;
+{ equivalent to mode = 0 }
+ S_DALL = $01FB;
+{ POSIX setuid, setgid, and sticky }
+ S_ISUID = 0004000;
+ S_ISGID = 0002000;
+ S_ISVTX = 0001000;
+
+type
+ Pstat = ^Tstat;
+ Tstat = record
+ st_dev : Tdev_t;
+ st_ino : Tino_t;
+ st_mode : word;
+ st_pad1 : word;
+ st_nlink : dword;
+ st_uid : dword;
+ st_gid : dword;
+ st_rdev : Tdev_t;
+ st_size : Toff_t;
+ st_atime : Ttime_t;
+ st_mtime : Ttime_t;
+ st_ctime : Ttime_t;
+ st_btime : Ttime_t;
+ st_attr : dword;
+ st_archivedID : dword;
+ st_updatedID : dword;
+ st_inheritedRightsMask : word;
+ st_pad2 : word;
+ st_originatingNameSpace : dword;
+ st_blksize : Tsize_t;
+ st_blocks : Tsize_t;
+ st_flags : dword;
+ st_spare : array[0..3] of dword;
+ st_name : array[0..(255 + 1)-1] of byte;
+ end;
+
+{ definitions of older structure technology are mostly for reference }
+{ v4.11 }
+{----------------- new fields starting in v4.11 ------------------------- }
+ Pstat411 = ^Tstat411;
+ Tstat411 = record
+ st_dev : Tdev_t;
+ st_ino : Tino_t;
+ st_mode : word;
+ st_nlink : smallint;
+ st_uid : dword;
+ st_gid : smallint;
+ st_rdev : Tdev_t;
+ st_size : Toff_t;
+ st_atime : Ttime_t;
+ st_mtime : Ttime_t;
+ st_ctime : Ttime_t;
+ st_btime : Ttime_t;
+ st_attr : dword;
+ st_archivedID : dword;
+ st_updatedID : dword;
+ st_inheritedRightsMask : word;
+ st_originatingNameSpace : byte;
+ st_name : array[0..(255 + 1)-1] of byte;
+ st_blksize : Tsize_t;
+ st_blocks : Tsize_t;
+ st_flags : dword;
+ st_spare : array[0..3] of dword;
+ end;
+
+{ v3.12, v4.0, v4.01, v4.02 and v4.10 }
+ Pstat410 = ^Tstat410;
+ Tstat410 = record
+ st_dev : Tdev_t;
+ st_ino : Tino_t;
+ st_mode : word;
+ st_nlink : smallint;
+ st_uid : dword;
+ st_gid : smallint;
+ st_rdev : Tdev_t;
+ st_size : Toff_t;
+ st_atime : Ttime_t;
+ st_mtime : Ttime_t;
+ st_ctime : Ttime_t;
+ st_btime : Ttime_t;
+ st_attr : dword;
+ st_archivedID : dword;
+ st_updatedID : dword;
+ st_inheritedRightsMask : word;
+ st_originatingNameSpace : byte;
+ st_name : array[0..12] of byte;
+ end;
+
+function chmod(path:Pchar; mode:Tmode_t):longint;cdecl;external 'clib' name 'chmod';
+function mkdir(path:Pchar):longint;cdecl;external 'clib' name 'mkdir';
+function mkdir_510(pathname:Pchar; mode:Tmode_t):longint;cdecl;external 'clib' name 'mkdir_510';
+function umask(cmask:Tmode_t):Tmode_t;cdecl;external 'clib' name 'umask';
+function fstat_410(fildes:longint; buf:Pstat410):longint;cdecl;external 'clib' name 'fstat_410';
+function fstat_410(fildes:longint; var buf:Tstat410):longint;cdecl;external 'clib' name 'fstat_410';
+function fstat_411(fildes:longint; buf:Pstat411):longint;cdecl;external 'clib' name 'fstat_411';
+function fstat_411(fildes:longint; var buf:Tstat411):longint;cdecl;external 'clib' name 'fstat_411';
+function fstat_500(fildes:longint; buf:Pstat):longint;cdecl;external 'clib' name 'fstat_500';
+function fstat_500(fildes:longint; var buf:Tstat):longint;cdecl;external 'clib' name 'fstat_500';
+function fstat (fildes:longint; buf:Pstat):longint;cdecl;external 'clib' name 'fstat_500';
+function fstat (fildes:longint; var buf:Tstat):longint;cdecl;external 'clib' name 'fstat_500';
+
+function stat_410(path:Pchar; buf:Pstat410):longint;cdecl;external 'clib' name 'stat_410';
+function stat_410(path:Pchar; var buf:Tstat410):longint;cdecl;external 'clib' name 'stat_410';
+function stat_411(path:Pchar; buf:Pstat411):longint;cdecl;external 'clib' name 'stat_411';
+function stat_411(path:Pchar; var buf:Tstat411):longint;cdecl;external 'clib' name 'stat_411';
+function stat_500(path:Pchar; buf:Pstat):longint;cdecl;external 'clib' name 'stat_500';
+function stat_500(path:Pchar; var buf:Tstat):longint;cdecl;external 'clib' name 'stat_500';
+function stat (path:Pchar; buf:Pstat):longint;cdecl;external 'clib' name 'stat_500';
+function stat (path:Pchar; var buf:Tstat):longint;cdecl;external 'clib' name 'stat_500';
+{------------------------------------------------------------------------------}
+{definitions for netwareAlert, not documented, found that on the novell developer newsgroup}
+const
+// ModuleNumbers for 'nwAlertID' in TNetWareAlertStructure
+ ALERT_BINDERY = $01020000; // Bindery Subject
+ ALERT_OS = $01030000; // OS Event Subject
+ ALERT_LLC = $01040000; // LLC
+ ALERT_SDLC = $01050000; // SDLC Stack
+ ALERT_REMOTE = $01060000; // RConsole
+ ALERT_MLID = $01070000; // MLID LAN Drivers
+ ALERT_QLLC = $01080000; // QLLC
+ ALERT_UPS = $01090000; // UPS Monitor
+ ALERT_DS = $010a0000; // Directory Service
+ ALERT_RSPX = $010c0000; // RSPX
+ ALERT_R232 = $010d0000; // R232
+ ALERT_TIME_SYNC = $010e0000; // TimeSync
+ ALERT_CLIB = $010f0000; // CLib
+ ALERT_PRINT = $01100000; // Print
+ ALERT_NRS = $01200000; // Novell Replication Services
+ ALERT_DNS = $01300000; // IP/Domain Name Services
+ ALERT_DHCP = $01400000; // DHCP Services
+ ALERT_MM = $01500000; // Media Manager
+
+// OS-defined AlertNumber values for nwAlertID in TNetWareAlertStructure
+// starting with NetWare 4...
+ nmAllocFailed = 1;
+ nmErrWrtExtDir = 2;
+ nmSysErrWrtDSnoFN = 3;
+ nmStaErrWrtDSnoFN = 4;
+ nmSysErrWrtDSwithFN = 5;
+ nmStaErrWrtDSwithFN = 6;
+ nmSysErrRdDSnoFN = 7;
+ nmStaErrRdDSnoFN = 8;
+ nmSysErrRdDSwithFN = 9;
+ nmStaErrRdDSwithFN = 10;
+ nmSysWrtPreRDnoFN = 11;
+ nmStaWrtPreRDnoFN = 12;
+ nmSysWrtPreRDwithFN = 13;
+ nmStaWrtPreRDwithFN = 14;
+ nmCacheMemLimitExceded = 15;
+ nmCacheMemOutOfMem = 16;
+ nmCacheBufsGetLo = 17;
+ nmDskSpcNoDelFiles = 18;
+ nmDskSpcNoLimbo = 19;
+ nmVolSpcAlmostGone = 20;
+ nmFATWrtErr = 21;
+ nmDirWrtErr = 22;
+ nmDirCopyRdErr = 23;
+ nmDirDblRdErr = 24;
+ nmAllocDirWrtErr = 25;
+ nmDirExpansionErr = 26;
+ nmDirTooLarge = 27;
+ nmErrExpandingDir = 28;
+ nmErrExpandingMem = 29;
+ nmErrDirGetTooLarge = 30;
+ nmDskBottleneck = 31;
+ nmWDClearedConn = 32;
+ nmCpyrtViolation = 33;
+ nmReadFault = 35;
+ nmPktTooSmall = 36;
+ nmCreatingVolLog = 37;
+ nmWrtVolLog = 38;
+ nmVolDmtDevDeact = 39;
+ nmLoginDisabled = 40;
+ nmLoginEnabled = 41;
+ nmClrSta = 42;
+ nmClrStaByUsr = 43;
+ nmFSDownByUser = 44;
+ nmRIPAlreadyOpn = 45;
+ nmRouterConfigErr = 46;
+ nmLANLoopbackErr = 47;
+ nmRouterConfigErrNoInfo = 48;
+ nmIPXUnreachable = 49;
+ nmIPXUnbind = 50;
+ nmSAPAlreadyOpn = 51;
+ nmRouterConfigErrNameInfo = 52;
+ nmSpuriousInt = 53;
+ nmChecksumInvalidAlert = 54;
+ nmPrimaryPicLostInt = 55;
+ nmSecondaryPicLostInt = 56;
+ nmCompErrHoleCountMismatch = 57;
+ nmInvalidScreen = 58;
+ nmRelinquishControl = 59;
+ nmFSUserDeleted = 60;
+ nmAccDelByUser = 61;
+ nmInvalidRTag = 62;
+ nmDeactUnknown = 63;
+ nmDeactDriveUnld = 64;
+ nmDeactDevFailure = 65;
+ nmDeactUsrRequest = 66;
+ nmDeactMediaDismount = 67;
+ nmDeactMediaEject = 68;
+ nmDeactServerDown = 69;
+ nmDeactServerFailure = 70;
+ nmResourceRelErr = 71;
+ nmMirrorsNotSync = 72;
+ nmMirrorsSyncUp = 73;
+ nmPartMirrorSync = 74;
+ nmPartMirrorNotSync = 75;
+ nmReMirroringPart = 76;
+ nmReMirroringPartAborted = 77;
+ nmLogPartMirrorInconsist = 78;
+ nmSysFileLockThresh = 79;
+ nmStaFileLockThresh = 80;
+ nmSysRecLockThresh = 81;
+ nmStaRecLockThresh = 82;
+ nmOpnNETACCTFailed = 83;
+ nmNCPSearchLimitSys = 84;
+ nmNCPSearchLimitSta = 85;
+ nmInsMediaAck = 86;
+ nmInsMediaAborted = 87;
+ nmRemMediaAck = 88;
+ nmRemMediaAbort = 89;
+ nmInsMediaInto = 90;
+ nmRemMediaFrom = 91;
+ nmReDirectedBlockPart = 92;
+ nmReDirectedBlockPartErr = 93;
+ nmOutOfHotFixBlocks = 94;
+ nmLowWarningHotFixBlocks = 95;
+ nmReDirectInconsistNoFix = 96;
+ nmReDirectInconsistFixed = 97;
+ nmInvalidRTagHOptions = 98;
+ nmCheckAndAddHWNoGetRTag = 99;
+ nmRemHWBadPtr = 100;
+ nmErrUnldNLM = 101;
+ nmIvldRTagCrProc = 102;
+ nmCrProcStkTooSmall = 103;
+ nmCrProcNoPCB = 104;
+ nmDelToLimboFileErr = 105;
+ nmDelToLimboNoSpace = 106;
+ nmMLIDResetLanBd = 107;
+ nmRouterReset = 108;
+ nmVolWrongDOSType = 109;
+ nmNoOwnerNSfound = 110;
+ nmRTDMDefSMchanged = 111;
+ nmErrOpnTTSLOG = 112;
+ nmErrWrtTTSLOG = 113;
+ nmTTSdownVolDismount = 114;
+ nmTTSdisableByStaUsr = 115;
+ nmTTSdisByOp = 116;
+ nmTTSdisErrRdBackFile = 117;
+ nmTTSdisErrWrBackFile = 118;
+ nmTTSdisTooManyDefVol = 119;
+ nmTTSdisWrtVolDefInfo = 120;
+ nmTTSdisErrRdBkFlRecGen = 121;
+ nmTTSdisGrowMemTables = 122;
+ nmTTSdisErrAllDiskSp = 123;
+ nmTTSdisDirErrOnBkFile = 124;
+ nmTTSEnableByStaUsr = 125;
+ nmTTStransAbortedForSta = 126;
+ nmTTStooManyTransDelaying = 127;
+ nmTTSNoMemForExpTransNodes = 128;
+ nmAuditEvent = 129;
+ nmAuditDisNoAuditCfg = 130;
+ nmInvldConnTypeToAllocConn = 131;
+ nmInvldRTagToAllocConn = 132;
+ nmOutOfServerConns = 133;
+ nmConnTermAfter5Min = 134;
+ nmUsrAccDisableBySta = 135;
+ nmUnEncryptPwdNotAllowed = 136;
+ nmSuperAccLockedByConsole = 137;
+ nmSystemTimeChangedByCon = 138;
+ nmSystemTimeChangedBySta = 139;
+ nmVolStillActWithError = 140;
+ nmRouterFalsehood = 141;
+ nmServerAddressChanged = 142;
+ nmExtFileNoOwnerCharge = 143;
+ nmRouterConfigErrNode = 144;
+ nmRouterConfigErrMyAddr = 145;
+ nmNoMigratorLd = 146;
+ nmNoSMLd = 147;
+ nmNotEnoughRamForCompression = 148;
+ nmDiskErrorCompressing = 149;
+ nmUnknownErrorCompressing = 150;
+ nmInsufficientSpaceForDeCompression = 151;
+ nmDecompressUnknownCompressionVersion = 152;
+ nmUnknownDecompressError = 153;
+ nmInsufficientRAMToDecompress = 154;
+ nmCompressedFileIsCorrupt = 155;
+ nmStaAttemptedToUseBadPckt = 156;
+ nmStaUsedABadPckt = 157;
+ nmStaAttemptedToUseBadSFL = 158;
+ nmStaUsedABadSFL = 159;
+ nmCorruptCompFileWithName = 160;
+ nmCorruptCompFileWithNameAndStation = 161;
+ nmLowPriThreadsNotRun = 162;
+ nmWorkToDoNotRun = 163;
+ nmCompressErrorTempFileError = 164;
+ nmCompressErrorLengthTotalsMismatch = 165;
+ nmCompressErrorOffsetTotalsMismatch = 166;
+ nmCompressErrorDataCodeCountMismatch = 167;
+ nmCompressErrorLengthCountMismatch = 168;
+ nmCompressErrorLargeLengthCountMismatch = 169;
+ nmCompressErrorReadZeroBytesOrg = 170;
+ nmCompressErrorTreeTooBig = 171;
+ nmCompressErrorMatchSizeFail = 172;
+ nmSignatureInvalidAlert = 173;
+ nmLicenseIsInvalid = 174;
+ nmDeactHotFixError = 175;
+ nmUnknownDecompressErrorFN = 176;
+ nmInsufficientRAMToDecompressFN = 177;
+ nmDecompressUnderFreePercentage = 178;
+ nmNegPktTriedLargeBuffer = 179;
+ nmLoginDisabledByConsole = 180;
+ nmLoginEnabledByConsole = 181;
+ nmGrwStkNotAvail = 182;
+ nmLicenseFileIsMissing = 183;
+ nmFailedToDeletedMigratedFile = 184;
+ nmNoMemForAuditing = 185;
+ nmAuditFileWriteError = 186;
+ nmAuditFileFull = 187;
+ nmAuditFileThresholdOverflow = 188;
+ nmCompressErrorReadZeroBytesInt = 189;
+ nmEASpaceLimit = 190;
+ nmThreadAreaNotEmpty = 191;
+ nmErrMovingLogToMSEngine = 192;
+ nmFaultInConsoleCmdHandler = 193;
+ nmServerToServerComLinkActivated = 194;
+ nmServerToServerComLinkFailure = 195;
+ nmServerToServerComLinkDeact = 196;
+ nmOtherServerAttemptedToSync = 197;
+ nmServerToServerComLinkBrokeOK = 198;
+ nmServerSyncStartingIAmSecondary = 199;
+ nmBadSvrInitMsgFromOtherSvr = 200;
+ nmSvrToSvrCommLinkInitFailed = 201;
+ nmFailedDuringSyncWithReason = 202;
+ nmCommDrvLdDuringActivateWait = 203;
+ nmErrWritingStatusDump = 204;
+ nmComDrvFailureOnPrimary = 205;
+ nmComDrvFailureOnSecondary = 206;
+ nmErrFinishingGenStatusDump = 207;
+ nmSFTIIWhatToDoWithReasonString = 208;
+ nmSFTIIErrorUnexpected = 209;
+ nmSyncErrFromCustomServerNLM = 210;
+ nmSvrLinkHasPluggedPacket = 211;
+ nmSvrToBeRevived = 212;
+ nmServersAreSyncPri = 213;
+ nmSvrCantRouteIPXSec = 214;
+ nmSrvIPXRouteInfoSec = 215;
+ nmErrGivingRAMtoMS = 216;
+ nmMoreRAMgivenToMS = 217;
+ nmServersAreSyncSec = 218;
+ nmSvrCantRouteIPXPri = 219;
+ nmSrvIPXRouteInfoPri = 220;
+ nmPriSvrFailedButSecDown = 221;
+ nmPriSvrFailedNewPri = 222;
+ nmNumMemSegsExceedLimit = 223;
+ nmNumScreenExceedsLimit = 224;
+ nmIOVersionMismatch = 225;
+ nmOtherSvrProtectLvlNoMatch = 226;
+ nmOtherSvrScrAddrMismatch = 227;
+ nmIOEngNotAtSameAddr = 228;
+ nmBothSvrHaveMSEng = 229;
+ nmNoMSEngOnServers = 230;
+ nmSecSvrMissingRAM = 231;
+ nmBothSrvHaveSameIPXAddr = 232;
+ nmIOEngIPXAddrMatchMSEng = 233;
+ nmIOEngsMismatchRxSizes = 234;
+ nmIOEngsHaveSameName = 235;
+ nmNoMemForIOEngName = 236;
+ nmSrvToSvrLinkBeginSync = 237;
+ nmMSEngActivated = 238;
+ nmMSEngActNowSyncOther = 239;
+ nmIOtoMSComMisMatchUnload = 240;
+ nmSFTIIIOutOfMsgCodes = 241;
+ nmErrXferDumpToSystem = 242;
+ nmFailureChkPrimary = 243;
+ nmNoMemForOtherIOEngScr = 244;
+ nmErrStarting2ndProc = 245;
+ nmSrvFailureMsg = 246;
+ nmSecIOEngSupModNotLd = 247;
+ nmMSLBdNumHasConn = 248;
+ nmSecSvrLANIsBetter = 249;
+ nmIPXrtnStatusPckts = 250;
+ nmIPXnotRtnStatChkPckts = 251;
+ nmIPXnotRtnStatLANJam = 252;
+ nmFailReasonByOtherSrv = 253;
+ nmIPXMayBeTooSlowForSecSrv = 254;
+ nmIPXToOtherSrvTooManyHops = 255;
+ nmIPXappearsDown = 256;
+ nmIPXFoundRouteToOtherSrv = 257;
+ nmIPXLostRoute = 258;
+ nmSecSrvGoingToDie = 259;
+ nmPriSrcDyingTimerStart = 260;
+ nmPriSrvDying = 261;
+ nmIPXInternetIsJammed = 262;
+ nmIPXNewRouteToSecSvr = 263;
+ nmSrvsSyncing = 264;
+ nmFSHookRegistered = 265;
+ nmFSHookDeRegistered = 266;
+ nmIOEngCantBorrowMemory = 267;
+ nmDecompressNoCompressionOnVolume = 268;
+ nmMkProcessUsingTooSmallStk = 269;
+ nmQueueEventReportNoMemory = 270;
+ nmServerPartMirrorNotSync = 271;
+ nmStaWithoutRightsConsoleRPC = 272;
+ nmAuditOverflowFileThreshold = 273;
+ nmAuditOverflowFileFull = 274;
+ nmSwitchStacksGrwStk = 275;
+ nmConsoleCommandProcRestarted = 276;
+ nmGrowableStackGrew = 278;
+ nmOtherSvrIOLogSpaceNoMatch = 279;
+ nmDFSLogicalStackRead = 280;
+ nmDFSLogicalStackWrite = 281;
+ nmSecureEraseFailure = 282;
+ nmDropBadPktBurstConn = 283;
+ nmOutOfIPXSockets = 284;
+ nmVolumeObjectIDChanged = 285;
+ nmAbendRecovery = 286;
+ nmOpLockTimeout = 287;
+ nmAbendRecovered = 288;
+
+// starting with NetWare 5...
+ nmUnknownSetCmd = 289;
+ nmAddressSpaceProtectionFault = 290;
+ nmAddressSpaceFailedToRestart = 291;
+ nmAddressSpaceRestarted = 292;
+ nmCorruptMemoryNodeDetected = 293;
+ nmAddressSpaceCleanupFailure = 294;
+ nmInvalidParameter = 295;
+ nmInvalidObjectHandle = 296;
+ nmNullPointer = 297;
+ nmVolDmtMedDmt = 298;
+ nmVolDmtmedChgd = 299;
+ nmAccDelByUsrActConn = 300;
+ nmResourcesRelErr = 301;
+ nmDemoVersion = 302;
+ nmDemoVersionTooLong = 303;
+ nmLicenseReSellerFileIsMissing = 304;
+ nmLicenseUpgradeIsMissing = 305;
+ nmLicenseVersionInvalid = 306;
+ nmLicenseProductInvalid = 307;
+ nmLicenseNoMoreFiles = 308;
+ nmLicensePIDInvalid = 309;
+ nmLicenseContentInalid = 310;
+ nmLicenseBadUpgrade = 311;
+ nmLicensePrevMaxConnMisMatch = 312;
+ nmLicenseContentResellerBad = 313;
+ nmLicenseSNMisMatch = 314;
+ nmLicenseUIDMisMatch = 315;
+ nmLicenseOpenError = 316;
+ nmLicenseCompanionErr = 317;
+ nmLicenseSNUpgradeMisMatch = 318;
+ nmLicenseUnableToRemMSL = 319;
+ nmLicenseUnableToRemULF = 320;
+ nmLicenseUnableToRemRLF = 321;
+ nmLicenseUnableToGetFileSize = 322;
+ nmLicenseUnkLicenseType = 323;
+ nmLicenseReadErr = 324;
+ nmLicenseFileSizeMisMatch = 325;
+ nmLicenseDupServerLic = 326;
+ nmLicenseNeedUpgrade = 327;
+ nmLicenseMirrorNeedUpgrade = 328;
+ nmLicenseDupLicDiscovered = 329;
+ nmLicenseDupLicDiscoveredDel = 330;
+ nmLicenseCpyRightViolated = 331;
+ nmLicenseExpired = 332;
+ nmVolDmtDevMedChgd = 333;
+ nmVolDmtDevMedDmt = 334;
+ nmInsMediaAckDS = 335;
+ nmInsMediaAckMag = 336;
+ nmInsMediaAbortedDS = 337;
+ nmInsMediaAbortedMag = 338;
+ nmRemMediaAckDS = 339;
+ nmRemMediaAckMag = 340;
+ nmRemMediaAbortDS = 341;
+ nmRemMediaAbortMag = 342;
+ nmInsMediaIntoDS = 343;
+ nmInsMediaIntoMag = 344;
+ nmRemMediaFromDS = 345;
+ nmRemMediaFromMag = 346;
+ nmServAddr = 347;
+ nmSwapInError = 348;
+ nmSwapOutError = 349;
+ nmAveragePageInThresholdExceeded = 350;
+ nmIllegalRequest = 351;
+ nmTTSThrottleDelayError = 352;
+ nmTTSLackOfResourcesError = 353;
+ nmTTSLackOfResourcesNoReason = 354;
+ nmDelayedWTDNotRunning = 355;
+ nmInvalidCharacterInName = 356;
+
+// starting with NetWare 6
+ nmMPKBadThreadState = 357;
+ nmPoolSeriousError = 358;
+ nmPoolSeriousReadError = 359;
+ nmVolSeriousError = 360;
+ nmVolSeriousReadError = 361;
+ nmVolDeactSeriousIOError = 362;
+ nmVolDeactSeriousNonIOError = 363;
+ nmPoolDeactSeriousIOError = 364;
+ nmPoolDeactSeriousNonIOError = 365;
+ nmTaskZeroCheck = 366;
+
+// Values for nwAlertLocus
+ LOCUS_UNKNOWN = 0;
+ LOCUS_MEMORY = 1;
+ LOCUS_FILESYSTEM = 2;
+ LOCUS_DISKS = 3;
+ LOCUS_LANBOARDS = 4;
+ LOCUS_COMSTACKS = 5;
+ LOCUS_TTS = 7;
+ LOCUS_BINDERY = 8;
+ LOCUS_STATION = 9;
+ LOCUS_ROUTER = 10;
+ LOCUS_LOCKS = 11;
+ LOCUS_KERNEL = 12;
+ LOCUS_UPS = 13;
+ LOCUS_SERVICE_PROTOCOL = 14;
+ LOCUS_SFT_III = 15;
+ LOCUS_RESOURCE_TRACKING = 16;
+ LOCUS_NLM = 17;
+ LOCUS_OS_INFORMATION = 18;
+ LOCUS_CACHE = 19;
+
+ AlertIDValidMask = $00000002;
+ AlertLocusValidMask = $00000004;
+ NoDisplayAlertIDBit = $20000000;
+
+ NOTIFY_CONNECTION_BIT = $00000001;
+ NOTIFY_EVERYONE_BIT = $00000002;
+ NOTIFY_ERROR_LOG_BIT = $00000004;
+ NOTIFY_CONSOLE_BIT = $00000008;
+ NOTIFY_QUEUE_MESSAGE = $10000000;
+ NOTIFY_DONT_NOTIFY_NMAGENT = $80000000;
+
+// ERROR CLASSES
+ CLASS_UNKNOWN = 0;
+ CLASS_OUT_OF_RESOURCE = 1;
+ CLASS_TEMP_SITUATION = 2;
+ CLASS_AUTHORIZATION_FAILURE = 3;
+ CLASS_INTERNAL_ERROR = 4;
+ CLASS_HARDWARE_FAILURE = 5;
+ CLASS_SYSTEM_FAILURE = 6;
+ CLASS_REQUEST_ERROR = 7;
+ CLASS_NOT_FOUND = 8;
+ CLASS_BAD_FORMAT = 9;
+ CLASS_LOCKED = 10;
+ CLASS_MEDIA_FAILURE = 11;
+ CLASS_ITEM_EXISTS = 12;
+ CLASS_STATION_FAILURE = 13;
+ CLASS_LIMIT_EXCEEDED = 14;
+ CLASS_CONFIGURATION_ERROR = 15;
+ CLASS_LIMIT_ALMOST_EXCEEDED = 16;
+ CLASS_SECURITY_AUDIT_INFO = 17;
+ CLASS_DISK_INFORMATION = 18;
+ CLASS_GENERAL_INFORMATION = 19;
+ CLASS_FILE_COMPRESSION = 20;
+ CLASS_PROTECTION_VIOLATION = 21;
+ CLASS_VIRTUAL_MEMORY = 22;
+
+ SEVERITY_INFORMATIONAL = 0;
+ SEVERITY_WARNING = 1;
+ SEVERITY_RECOVERABLE = 2;
+ SEVERITY_CRITICAL = 3;
+ SEVERITY_FATAL = 4;
+ SEVERITY_OPERATION_ABORTED = 5;
+ SEVERITY_NONOS_UNRECOVERABLE = 6;
+
+type
+ TnwAlertDataFreeProc = procedure (nwAlertDataPtr:pointer);cdecl;
+ PNetWareAlertStructure = ^TNetWareAlertStructure;
+ TNetWareAlertStructure = record
+ pNetworkManagementAttribute : pointer;
+ nwAlertFlags,
+ nwTargetStation,
+ nwTargetNotificationBits,
+ nwAlertID,
+ nwAlertLocus,
+ nwAlertClass,
+ nwAlertSeverity : longint;
+ nwAlertDataPtr : pointer;
+ nwAlertDataFree : TnwAlertDataFreeProc;
+ nwControlString : pchar;
+ nwControlStringMessageNumber : longint;
+ end;
+
+
+procedure NetWareAlert(nlmHandle : TNlmHandle;
+ nwAlert : PNetWareAlertStructure;
+ parameterCount : longint;
+ args : array of const); cdecl; external 'clib';
+
+procedure NetWareAlert(nlmHandle : TNlmHandle;
+ nwAlert : PNetWareAlertStructure;
+ parameterCount : longint); cdecl; external 'clib';
+
+{------------------------------------------------------------------------------}
+
+implementation
+
+function CLK_TCK : longint;
+begin
+ CLK_TCK:=__get_CLK_TCK;
+end;
+
+function tzname : pchar;
+begin
+ tzname:=__get_tzname^;
+end;
+
+function NetWareErrno : longint;
+begin
+ NetWareErrno := __get_NWErrno_ptr()^;
+end;
+
+function __stdin : PFILE;
+begin
+ __stdin := __get_stdin^;
+end;
+
+function __stdout : PFILE;
+begin
+ __stdout := __get_stdout^;
+end;
+
+function __stderr : PFILE;
+begin
+ __stderr := __get_stderr^;
+end;
+
+function bisecond(var a : TDOSTime) : word;
+begin
+ bisecond:=(a.flag0 and bm_TDOSTime_bisecond) shr bp_TDOSTime_bisecond;
+end;
+
+procedure set_bisecond(var a : TDOSTime; __bisecond : word);
+begin
+ a.flag0:=a.flag0 or ((__bisecond shl bp_TDOSTime_bisecond) and bm_TDOSTime_bisecond);
+end;
+
+function minute(var a : TDOSTime) : word;
+begin
+ minute:=(a.flag0 and bm_TDOSTime_minute) shr bp_TDOSTime_minute;
+end;
+
+procedure set_minute(var a : TDOSTime; __minute : word);
+begin
+ a.flag0:=a.flag0 or ((__minute shl bp_TDOSTime_minute) and bm_TDOSTime_minute);
+end;
+
+function hour(var a : TDOSTime) : word;
+begin
+ hour:=(a.flag0 and bm_TDOSTime_hour) shr bp_TDOSTime_hour;
+end;
+
+procedure set_hour(var a : TDOSTime; __hour : word);
+begin
+ a.flag0:=a.flag0 or ((__hour shl bp_TDOSTime_hour) and bm_TDOSTime_hour);
+end;
+
+function day(var a : TDOSDate) : word;
+begin
+ day:=(a.flag0 and bm_TDOSDate_day) shr bp_TDOSDate_day;
+end;
+
+procedure set_day(var a : TDOSDate; __day : word);
+begin
+ a.flag0:=a.flag0 or ((__day shl bp_TDOSDate_day) and bm_TDOSDate_day);
+end;
+
+function month(var a : TDOSDate) : word;
+begin
+ month:=(a.flag0 and bm_TDOSDate_month) shr bp_TDOSDate_month;
+end;
+
+procedure set_month(var a : TDOSDate; __month : word);
+begin
+ a.flag0:=a.flag0 or ((__month shl bp_TDOSDate_month) and bm_TDOSDate_month);
+end;
+
+function yearsSince80(var a : TDOSDate) : word;
+begin
+ yearsSince80:=(a.flag0 and bm_TDOSDate_yearsSince80) shr bp_TDOSDate_yearsSince80;
+end;
+
+procedure set_yearsSince80(var a : TDOSDate; __yearsSince80 : word);
+begin
+ a.flag0:=a.flag0 or ((__yearsSince80 shl bp_TDOSDate_yearsSince80) and bm_TDOSDate_yearsSince80);
+end;
+
+function bisecond(var a : T_DOSTime) : word;
+begin
+ bisecond:=(a.flag0 and bm_T_DOSTime_bisecond) shr bp_T_DOSTime_bisecond;
+end;
+
+procedure set_bisecond(var a : T_DOSTime; __bisecond : word);
+begin
+ a.flag0:=a.flag0 or ((__bisecond shl bp_T_DOSTime_bisecond) and bm_T_DOSTime_bisecond);
+end;
+
+function minute(var a : T_DOSTime) : word;
+begin
+ minute:=(a.flag0 and bm_T_DOSTime_minute) shr bp_T_DOSTime_minute;
+end;
+
+procedure set_minute(var a : T_DOSTime; __minute : word);
+begin
+ a.flag0:=a.flag0 or ((__minute shl bp_T_DOSTime_minute) and bm_T_DOSTime_minute);
+end;
+
+function hour(var a : T_DOSTime) : word;
+begin
+ hour:=(a.flag0 and bm_T_DOSTime_hour) shr bp_T_DOSTime_hour;
+end;
+
+procedure set_hour(var a : T_DOSTime; __hour : word);
+begin
+ a.flag0:=a.flag0 or ((__hour shl bp_T_DOSTime_hour) and bm_T_DOSTime_hour);
+end;
+
+end.
+
+
+{
+ $Log: nwserv.pp,v $
+ Revision 1.8 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.7 2005/01/04 11:25:33 armin
+ * rtl code cleanup, compat fixes between clib and libc
+
+}
diff --git a/rtl/netware/nwsnut.imp b/rtl/netware/nwsnut.imp
new file mode 100644
index 0000000000..908ff264ea
--- /dev/null
+++ b/rtl/netware/nwsnut.imp
@@ -0,0 +1,150 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWSAlert,
+ NWSAlertWithHelp,
+ NWSAlloc,
+ NWSAppendBoolField,
+ NWSAppendCommentField,
+ NWSAppendGenericBoolField,
+ NWSAppendScrollableStringField,
+ NWSAppendHexField,
+ NWSAppendHotSpotField,
+ NWSAppendIntegerField,
+ NWSAppendMenuField,
+ NWSAppendPasswordField,
+ NWSAppendPromptField,
+ NWSAppendStringField,
+ NWSAppendToForm,
+ NWSAppendToList,
+ NWSAppendToMenu,
+ NWSAppendToMenuField,
+ NWSAppendUnsignedIntegerField,
+ NWSAsciiHexToInt,
+ NWSAsciiToInt,
+ NWSAsciiToLONG,
+ NWSClearPortal,
+ NWSComputePortalPosition,
+ NWSConfirm,
+ NWSCreatePortal,
+ NWSDeleteFromList,
+ NWSDeleteFromPortalList,
+ NWSDeselectPortal,
+ NWSDestroyForm,
+ NWSDestroyList,
+ NWSDestroyMenu,
+ NWSDestroyPortal,
+ NWSDisableAllFunctionKeys,
+ NWSDisableAllInterruptKeys,
+ NWSDisableFunctionKey,
+ NWSDisableInterruptKey,
+ NWSDisablePortalCursor,
+ NWSDisplayErrorCondition,
+ NWSDisplayErrorText,
+ NWSDisplayHelpScreen,
+ NWSDisplayInformation,
+ NWSDisplayInformationInPortal,
+ NWSDisplayPreHelp,
+ NWSDisplayTextInPortal,
+ NWSDisplayTextJustifiedInPortal,
+ NWSDrawPortalBorder,
+ NWSEditForm,
+ NWSEditPortalForm,
+ NWSEditPortalFormField,
+ NWSEditString,
+ NWSEditText,
+ NWSEditTextWithScrollBars,
+ NWSEnableAllFunctionKeys,
+ NWSEnableFunctionKey,
+ NWSEnableFunctionKeyList,
+ NWSEnableInterruptKey,
+ NWSEnableInterruptList,
+ NWSEnablePortalCursor,
+ NWSEndWait,
+ NWSFillPortalZone,
+ NWSFillPortalZoneAttribute,
+ NWSFree,
+ NWSGetADisk,
+ NWSGetCurrentPortal,
+ NWSGetDefaultCompare,
+ NWSGetFieldFunctionPtr,
+ NWSGetHandleCustomData,
+ NWSGetKey,
+ NWSGetLineDrawCharacter,
+ NWSGetList,
+ NWSGetListElementText,
+ NWSGetListHead,
+ NWSGetListNotifyProcedure,
+ NWSGetListSortFunction,
+ NWSGetListTail,
+ NWSGetMessage,
+ NWSGetNUTVersion,
+ NWSGetPCB,
+ NWSGetScreenPalette,
+ NWSGetSortCharacter,
+ NWSInitForm,
+ NWSInitializeNut,
+ NWSInitList,
+ NWSInitListPtr,
+ NWSInitMenu,
+ NWSInitMenuField,
+ NWSInsertInList,
+ NWSInsertInPortalList,
+ NWSIsdigit,
+ NWSIsxdigit,
+ NWSKeyStatus,
+ NWSList,
+ NWSMemmove,
+ NWSMenu,
+ NWSModifyInPortalList,
+ NWSPopHelpContext,
+ NWSPopList,
+ NWSPopMarks,
+ NWSPositionCursor,
+ NWSPositionPortalCursor,
+ NWSPromptForPassword,
+ NWSPushHelpContext,
+ NWSPushList,
+ NWSPushMarks,
+ NWSRemovePreHelp,
+ NWSRestoreDisplay,
+ NWSRestoreList,
+ NWSRestoreNut,
+ NWSRestoreZone,
+ NWSSaveFunctionKeyList,
+ NWSSaveInterruptList,
+ NWSSaveList,
+ NWSSaveZone,
+ NWSScreenSize,
+ NWSScrollPortalZone,
+ NWSScrollZone,
+ NWSSelectPortal,
+ NWSSetDefaultCompare,
+ NWSSetDynamicMessage,
+ NWSSetErrorLabelDisplayFlag,
+ NWSSetFieldFunctionPtr,
+ NWSSetFormNoWrap,
+ NWSSetHandleCustomData,
+ NWSSetHelpHelp,
+ NWSSetList,
+ NWSSetListNotifyProcedure,
+ NWSSetListSortFunction,
+ NWSSetScreenPalette,
+ NWSSetScrollableFieldInsertProc,
+ NWSShowLine,
+ NWSShowLineAttribute,
+ NWSShowPortalLine,
+ NWSShowPortalLineAttribute,
+ NWSSortList,
+ NWSStartWait,
+ NWSStrcat,
+ NWSToupper,
+ NWSTrace,
+ NWSUngetKey,
+ NWSUnmarkList,
+ NWSUpdatePortal,
+ NWSViewText,
+ NWSViewTextWithScrollBars,
+ NWSWaitForEscape,
+ NWSWaitForEscapeOrCancel,
+ NWSWaitForKeyAndValue
+
diff --git a/rtl/netware/nwsnut.pp b/rtl/netware/nwsnut.pp
new file mode 100644
index 0000000000..7647ed0331
--- /dev/null
+++ b/rtl/netware/nwsnut.pp
@@ -0,0 +1,1544 @@
+{
+ $Id: nwsnut.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library
+ for Netware.
+ Copyright (c) 1999-2005 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+unit nwsnut;
+
+interface
+
+{$mode objfpc}
+{$if defined (netware_clib)}
+uses nwserv;
+{$else}
+uses libc;
+{$endif}
+
+{$PACKRECORDS C}
+
+ const
+ External_library='nwsnut';
+
+ { constants
+ the constant CURRENT_NUT_VERSION is incremented when increased
+ functionality is added. An NLM can check this value which is placed
+ in the NUTInfo structure, version field, to determine if the NWSNUT
+ NLM contains sufficient functionality to support its requirements }
+
+
+ CURRENT_NUT_VERSION = 405;
+ { the constant NUT_REVISION_LEVEL is incremented when a major change
+ in the behavior of NWSNUT is made. This value is not used by the calling
+ NLM, but rather by NWSNUT itself to determine what is expected of it
+ by the calling NLM }
+ NUT_REVISION_LEVEL = 1;
+ SAVE = 1;
+ NO_SAVE = 0;
+ NOHEADER = 0;
+ NOBORDER = 0;
+ NO_HELP_CONTEXT = $ffff;
+ SINGLE = 1;
+ DOUBLE = 2;
+ CURSOR_OFF = 0;
+ CURSOR_ON = 1;
+ VIRTUAL = 0;
+ DIRECT = 1;
+ SEVERITY_INFORM = 1;
+ SEVERITY_WARNING = 2;
+ SEVERITY_FATAL = 3;
+ { text size minimization styles }
+ SNORMAL = 0;
+ SMINWIDTH = 1;
+ SMINHEIGHT = 2;
+ { palettes to set screen colors.
+ background and foreground can be reversed with VREVERSE }
+ BW_PALETTE = 0; // white and black
+ NORMAL_PALETTE = 1; // white and dark blue
+ INIT_PALETTE = 2; // light blue and dark blue
+ HELP_PALETTE = 3; // green and black
+ ERROR_PALETTE = 4; // red and black
+ WARNING_PALETTE = 5; // pink and white
+ OTHER_PALETTE = 6; // green and red
+ { text and portal justification styles }
+ JRIGHT = 0;
+ JLEFT = 1;
+ JTOP = 2;
+ JBOTTOM = 3;
+ JCENTER = 4;
+ JTOPRIGHT = 5;
+ JTOPLEFT = 6;
+ JBOTTOMLEFT = 7;
+ JBOTTOMRIGHT = 8;
+ { video constants }
+ V_UP = 6;
+ V_DOWN = 7;
+ LINE_OFFSET = 160;
+ EXPLODE_RATE = 45;
+ SCREEN_SPEED = 0;
+ { video attributes }
+ VNORMAL = 0;
+ VINTENSE = 1;
+ VREVERSE = 2;
+ VBLINK = 3;
+ VIBLINK = 4;
+ VRBLINK = 5;
+ { header types }
+ NO_HEADER = 0;
+ SMALL_HEADER = 1;
+ NORMAL_HEADER = 2;
+ LARGE_HEADER = 3;
+ { keyboard constants }
+ KS_OFF = 0;
+ KS_ON = 1;
+ KS_INT = 2;
+ K_NORMAL = 0;
+ K_F1 = 1;
+ K_F2 = 2;
+ K_F3 = 3;
+ K_F4 = 4;
+ K_F5 = 5;
+ K_F6 = 6;
+ K_F7 = 7;
+ K_F8 = 8;
+ K_F9 = 9;
+ K_F10 = 10;
+ K_SF1 = 11;
+ K_SF2 = 12;
+ K_SF3 = 13;
+ K_SF4 = 14;
+ K_SF5 = 15;
+ K_SF6 = 16;
+ K_SF7 = 17;
+ K_SF8 = 18;
+ K_SF9 = 19;
+ K_SF10 = 20;
+ K_CF1 = 21;
+ K_CF2 = 22;
+ K_CF3 = 23;
+ K_CF4 = 24;
+ K_CF5 = 25;
+ K_CF6 = 26;
+ K_CF7 = 27;
+ K_CF8 = 28;
+ K_CF9 = 29;
+ K_CF10 = 30;
+ K_AF1 = 31;
+ K_AF2 = 32;
+ K_AF3 = 33;
+ K_AF4 = 34;
+ K_AF5 = 35;
+ K_AF6 = 36;
+ K_AF7 = 37;
+ K_AF8 = 38;
+ K_AF9 = 39;
+ K_AF10 = 40;
+ K_HELP = 1;
+ K_MODIFY = 3;
+ K_MARK = 5;
+ K_CANCEL = 7;
+ K_MODE = 9;
+ K_EXIT = 40;
+ K_ESCAPE = 41;
+ K_BACK = 42;
+ K_INSERT = 43;
+ K_DELETE = 44;
+ K_SELECT = 45;
+ K_CYCLE = 46;
+ K_UP = 47;
+ K_DOWN = 48;
+ K_LEFT = 49;
+ K_RIGHT = 50;
+ K_SUP = 51;
+ K_SDOWN = 52;
+ K_SLEFT = 53;
+ K_SRIGHT = 54;
+ K_PUP = 55;
+ K_PDOWN = 56;
+ K_FRIGHT = 57;
+ K_FLEFT = 58;
+ K_DELETE_END = 59;
+ {
+ For NWSUngetKey of function keys, use UGK_FUNCTION_KEY for the "type"
+ parameter and "K_F1" etc. for the "value" parameter
+ }
+ UGK_NORMAL_KEY = $00;
+ UGK_FUNCTION_KEY = $01;
+ {
+ For other special keys listed below, use UGK_NORMAL_KEY for the "value"
+ parameter, and the UGK_xxx for the "type" parameter.
+ }
+ UGK_ENTER_KEY = $02;
+ UGK_ESCAPE_KEY = $03;
+ UGK_BACKSPACE_KEY = $04;
+ UGK_DELETE_KEY = $05;
+ UGK_INSERT_KEY = $06;
+ UGK_CURSOR_UP_KEY = $07;
+ UGK_CURSOR_DOWN_KEY = $08;
+ UGK_CURSOR_RIGHT_KEY = $09;
+ UGK_CURSOR_LEFT_KEY = $0a;
+ UGK_CURSOR_HOME_KEY = $0b;
+ UGK_CURSOR_END_KEY = $0c;
+ UGK_CURSOR_PUP_KEY = $0d;
+ UGK_CURSOR_PDOWN_KEY = $0e;
+ {
+ Added in version 403
+
+ A special key type to cause LISTs to refresh. K_REFRESH_KEY may be returned
+ from an action procedure passed to NWSList, or another thread that wishes
+ to cause a list to refresh may call NWSUngetKey with the UGK version of this,
+ and it too will cause the list to be redrawn.
+
+ Use "type" = UGK_SPECIAL_KEY, and "value" = UGK_REFRESH_KEY
+ }
+ UGK_SPECIAL_KEY = 3;
+ UGK_REFRESH_KEY = $22222222;
+ K_REFRESH_KEY = UGK_REFRESH_KEY;
+ OLD_REFRESH_KEY = 222;
+ { available action keys for list }
+ M_ESCAPE = $0001;
+ M_INSERT = $0002;
+ M_DELETE = $0004;
+ M_MODIFY = $0008;
+ M_SELECT = $0010;
+ { marked delete }
+ M_MDELETE = $0020;
+ M_CYCLE = $0040;
+ { marked modify }
+ M_MMODIFY = $0080;
+ { marked select }
+ M_MSELECT = $0100;
+ { don't sort list }
+ M_NO_SORT = $0200;
+ { allow the list to be refreshed }
+ M_REFRESH = $0400;
+ { return values for EditString }
+ E_ESCAPE = 1;
+ E_SELECT = 2;
+ E_EMPTY = 4;
+ E_CHANGE = 8;
+ { type values for EditString }
+ EF_ANY = $0001;
+ EF_DECIMAL = $0002;
+ EF_HEX = $0004;
+ EF_NOSPACES = $0008;
+ EF_UPPER = $0010;
+ EF_DATE = $0020;
+ EF_TIME = $0040;
+ EF_FLOAT = $0080;
+ EF_SET = $0100;
+ EF_NOECHO = $0200;
+ EF_FILENAME = $0400;
+ { added in version 404 }
+ EF_MASK = $0800;
+ { and in version 405 }
+ EF_NOCONFIRM_EXIT = $1000;
+ { scroll bar stuff for NWSEditTextWithScrollBars, and NWSViewTextWithScrollBars }
+ { which scroll bars to show }
+ SHOW_VERTICAL_SCROLL_BAR = 2;
+ SHOW_HORIZONTAL_SCROLL_BAR = 4;
+ { when to show the scroll bars. Use ONLY one of these }
+ CONSTANT_SCROLL_BARS = $0200;
+ TEXT_SENSITIVE_SCROLL_BARS = $0400;
+ CONSIDER_LOCKED_FIELDS = $0800;
+ { character and key constants }
+
+ function F_H1 : longint;
+ { Í } function F_H2 : longint;
+ { ³ } function F_V1 : longint;
+ { º } function F_V2 : longint;
+ { Ú } function F_UL1 : longint;
+ { ¿ } function F_UR1 : longint;
+ { À } function F_LL1 : longint;
+ { Ù } function F_LR1 : longint;
+ { É } function F_UL2 : longint;
+ { » } function F_UR2 : longint;
+ { È } function F_LL2 : longint;
+ { ¼ } function F_LR2 : longint;
+ { Á } function F_UT1 : longint;
+ { Â } function F_DT1 : longint;
+ { ´ } function F_LT1 : longint;
+ { Ã } function F_RT1 : longint;
+ { Ê } function F_UT2 : longint;
+ { Ë } function F_DT2 : longint;
+ { ¹ } function F_LT2 : longint;
+ { Ì } function F_RT2 : longint;
+ { Å } function F_X1 : longint;
+ { Î } function F_X2 : longint;
+ {  } function F_UP : longint;
+ {  } function F_DOWN : longint;
+ {  } function F_LEFT : longint;
+ {  } function F_RIGHT : longint;
+ { ° } function F_BG1 : longint;
+ { ± } function F_BG2 : longint;
+ { ² } function F_BG3 : longint;
+ { Û } function F_BG4 : longint;
+
+
+ { form constants (control flags) }
+ const
+ F_NOVERIFY = $00;
+ F_VERIFY = $10;
+ F_FORCE = $20;
+ { a flag to pass if no help is desired in the form }
+ F_NO_HELP = $ffffffff;
+ { fieldFlags Type masks }
+ { normal editable field }
+ NORMAL_FIELD = $00;
+ { non accessable }
+ LOCKED_FIELD = $01;
+ { non editable }
+ SECURE_FIELD = $02;
+ { verify field on form exit }
+ REQUIRED_FIELD = $04;
+ { hidden fields are also locked }
+ HIDDEN_FIELD = $09;
+ { prompt fields are also locked }
+ PROMPT_FIELD = $11;
+ { field locked by user, not by NUT }
+ ULOCKED_FIELD = $0100;
+ { MASKED_FIELD added in version 402 }
+ { display ' ' for text }
+ MASKED_FIELD = $200;
+ { flag to cause form deselection
+ before action & verify routines
+ are called }
+ FORM_DESELECT = $20;
+ { In case old flag was used }
+ NO_FORM_DESELECT = $00;
+ { normal field controlled justify }
+ DEFAULT_FORMAT = $00;
+ { right justification format }
+ RIGHT_FORMAT = $40;
+ { left justification format }
+ LEFT_FORMAT = $80;
+ { centering format }
+ CENTER_FORMAT = $C0;
+ MAXPORTALS = 50;
+ MAXLISTS = 20;
+ SAVELISTS = 20;
+ MAXACTIONS = 60;
+ MAXFUNCTIONS = MAXACTIONS;
+ MAXHELP = 30;
+ NO_MESSAGE = $ffff;
+ DYNAMIC_MESSAGE_ONE = $fffe;
+ DYNAMIC_MESSAGE_TWO = $fffd;
+ DYNAMIC_MESSAGE_THREE = $fffc;
+ DYNAMIC_MESSAGE_FOUR = $fffb;
+ DYNAMIC_MESSAGE_FIVE = $fffa;
+ DYNAMIC_MESSAGE_SIX = $fff9;
+ DYNAMIC_MESSAGE_SEVEN = $fff8;
+ DYNAMIC_MESSAGE_EIGHT = $fff7;
+ DYNAMIC_MESSAGE_NINE = $fff6;
+ DYNAMIC_MESSAGE_TEN = $fff5;
+ DYNAMIC_MESSAGE_ELEVEN = $fff4;
+ DYNAMIC_MESSAGE_TWELVE = $fff3;
+ DYNAMIC_MESSAGE_THIRTEEN = $fff2;
+ DYNAMIC_MESSAGE_FOURTEEN = $fff1;
+ SYSTEM_MESSAGE = $8000;
+
+ function IS_DYNAMIC_MESSAGE(a : longint) : boolean;
+
+
+ type
+ PNUTInfo_ = ^TNUTInfo_;
+
+ PPCB_ = ^TPCB_;
+ TPCB_ = record
+ frameLine : longint;
+ frameColumn : longint;
+ frameHeight : longint;
+ frameWidth : longint;
+ virtualHeight : longint;
+ virtualWidth : longint;
+ cursorState : longint;
+ borderType : longint;
+ borderAttribute : longint;
+ saveFlag : word;
+ secondarySaveFlag : word;
+ directFlag : longint;
+ headerAttribute : longint;
+ portalLine : longint;
+ portalColumn : longint;
+ portalHeight : longint;
+ portalWidth : longint;
+ virtualLine : longint;
+ virtualColumn : longint;
+ cursorLine : longint;
+ cursorColumn : longint;
+ firstUpdateFlag : longint;
+ headerText : pchar;
+ headerText2 : pchar;
+ virtualScreen : pointer;
+ saveScreen : pointer;
+ screenID : TScr;
+ nutInfo : PNUTInfo_;
+ sequenceNumber : longint;
+ reserved1 : longint;
+ mtflags : longint;
+ borderPalette : longint;
+ showScrollBars : longint;
+ lastLine : longint;
+ longestLineLen : longint;
+ verticalScroll : longint;
+ horizontalScroll : longint;
+ oldVertical : longint;
+ oldHorizontal : longint;
+ deHighlightFunction : procedure (para1:PNUTInfo_; para2:PPCB_);cdecl;
+ reHighlightFunction : procedure (para1:PNUTInfo_; para2:PPCB_); cdecl;
+ reportPortalUpdate : procedure (para1:PPCB_; para2:PNUTInfo_; updateType:longint); cdecl;
+ end;
+ TPCB = TPCB_;
+ PPCB = ^TPCB;
+
+ PHS_ = ^THS_;
+ THS_ = record
+ nextScreen : longint;
+ previousScreen : longint;
+ frameLine : longint;
+ frameColumn : longint;
+ frameHeight : longint;
+ frameWidth : longint;
+ virtualHeight : longint;
+ virtualWidth : longint;
+ cursorState : longint;
+ borderType : longint;
+ borderAttribute : longint;
+ saveFlag : longint;
+ directFlag : longint;
+ headerAttribute : longint;
+ headerText : pchar;
+ text : pchar;
+ end;
+ THELP_SCREEN = THS_;
+ PHELP_SCREEN = ^THELP_SCREEN;
+
+ PLIST_STRUCT = ^TLIST_STRUCT;
+ TLIST_STRUCT = record
+ prev : PLIST_STRUCT;
+ next : PLIST_STRUCT;
+ otherInfo : pointer;
+ marked : longint;
+ flags : word;
+ maxSkew : word;
+ entryProcedure : procedure (listElement:PLIST_STRUCT; displayLine:longint; NUTInfoStructure:pointer);cdecl;
+ extra : longint;
+ text : array[0..0] of char;
+ end;
+ TLIST = TLIST_STRUCT;
+ PLIST = ^TLIST;
+ PPLIST= ^PLIST;
+
+ PLP_ = ^TLP_;
+ TLP_ = record
+ head : pointer;
+ tail : pointer;
+ sortProc : function :longint;cdecl;
+ freeProcedure : procedure (memoryPointer:pointer);
+ end;
+ TLISTPTR = TLP_;
+ PLISTPTR = ^TLISTPTR;
+
+ PMI_ = ^TMI_;
+ TMI_ = record
+ dynamicMessageOne : pchar;
+ dynamicMessageTwo : pchar;
+ dynamicMessageThree : pchar;
+ dynamicMessageFour : pchar;
+ dynamicMessageFive : pchar;
+ dynamicMessageSix : pchar;
+ dynamicMessageSeven : pchar;
+ dynamicMessageEight : pchar;
+ dynamicMessageNine : pchar;
+ dynamicMessageTen : pchar;
+ dynamicMessageEleven : pchar;
+ dynamicMessageTwelve : pchar;
+ dynamicMessageThirteen : pchar;
+ dynamicMessageFourteen : pchar;
+ messageCount : longint;
+ programMesgTable : ppchar;
+ end;
+ TMessageInfo = TMI_;
+ PMessageInfo = ^TMessageInfo;
+
+ PINT_ = ^TINT_;
+ TINT_ = record
+ interruptProc : procedure (handle:pointer);cdecl;
+ key : longint;
+ end;
+ TINTERRUPT = TINT_;
+ PINTERRUPT = ^TINTERRUPT;
+
+ PMP_ = ^TMP_;
+ TMP_ = record
+ listAction : function (option:longint; parameter:pointer):longint;cdecl;
+ parameter : pointer;
+ end;
+ TMENU_PARAMETER = TMP_;
+ PMENU_PARAMETER = ^TMENU_PARAMETER;
+ { environment structure }
+ { always leave the following fields at the end of the struct. They
+ should never be referenced directly by an application }
+
+
+ TNUTInfo_ = record
+ portal : array[0..(MAXPORTALS)-1] of PPCB;
+ currentPortal : longint;
+ headerHeight : longint;
+ waitFlag : longint;
+ listStack : array[0..(MAXLISTS)-1] of TLISTPTR;
+ saveStack : array[0..(SAVELISTS)-1] of TLISTPTR;
+ nextAvailList : longint;
+ head : PLIST;
+ tail : PLIST;
+ defaultCompareFunction : function (el1:PLIST; el2:PLIST):longint;cdecl;
+ freeProcedure : procedure (memoryPointer:pointer);
+ interruptTable : array[0..(MAXFUNCTIONS)-1] of procedure ;
+ functionKeyStatus : array[0..(MAXACTIONS)-1] of longint;
+ messages : TMessageInfo;
+ helpContextStack : array[0..(MAXHELP)-1] of longint;
+ currentPreHelpMessage : longint;
+ freeHelpSlot : longint;
+ redisplayFormFlag : longint;
+ preHelpPortal : longint;
+ helpActive : smallint;
+ errorDisplayActive : smallint;
+ helpPortal : longint;
+ waitPortal : longint;
+ errorPortal : longint;
+ resourceTag : pointer;
+ screenID : pointer;
+ helpScreens : pointer;
+ helpOffset : longint;
+ helpHelp : longint;
+ allocChain : pointer;
+ version : longint;
+ reserved : array[0..9] of longint;
+ moduleHandle : longint;
+ customData : pointer;
+ customDataRelease : procedure (theData:pointer; thisStructure:PNUTInfo_); cdecl;
+ displayErrorLabel : longint;
+ markBuffer : pchar;
+ markBufferLength : longint;
+ editBuffer : pchar;
+ editBufferLength : longint;
+ staticFlag : longint;
+ processID : longint;
+ mtflags : longint;
+ saveCurrentPortal : longint;
+ palette : longint;
+ nutDataHandle : pointer;
+ next : PNUTInfo_;
+ prev : PNUTInfo_;
+ listSortFunction : procedure (head:PLIST; tail:PLIST; thisStructure:PNUTInfo_); cdecl;
+ compatibilityLevel : longint;
+ end;
+ TNUTInfo = TNUTInfo_;
+ PNUTInfo = ^TNUTInfo;
+ PPNUTInfo= ^PNUTInfo;
+
+ { menu header message number }
+ { menu center line }
+ { menu center column }
+ { len of longest menu option }
+ { menu action routine }
+ { list head for menu list }
+
+ PMFC_ = ^TMFC_;
+ TMFC_ = record
+ headernum : longint;
+ centerLine : longint;
+ centerColumn : longint;
+ maxoptlen : longint;
+ action : function (option:longint; parameter:pointer):longint;cdecl;
+ arg1 : longint;
+ arg2 : longint;
+ arg3 : longint;
+ arg4 : longint;
+ arg5 : longint;
+ arg6 : longint;
+ menuhead : TLISTPTR;
+ nutInfo : PNUTInfo;
+ end;
+ TMFCONTROL = TMFC_;
+ PMFCONTROL = ^TMFCONTROL;
+ { list element that owns the field }
+ { Control flags }
+ { Line where field is located }
+ { Column where field is located }
+ { Maximum width of field }
+ { Display attribute for field }
+ { Keys that will activate the field }
+ { Routine called when field selected }
+ { Routine to verify Input }
+ { Data & Xtra field release routine }
+ { Pointer to data }
+ { Additional control info }
+ { help context for this field }
+ { Pointer to field above }
+ { Pointer to field below }
+ { Pointer to field to left }
+ { Pointer to field to right }
+ { Pointer to previous field }
+ { Pointer to next field }
+ { if this value is set, this routine will be called upon
+ entry to each field }
+ { this allows the user to have any sort of custom data that
+ he wants attached to the field. }
+ { and this lets him release it. Note that these parameters
+ match NWSFree which allows the use of NWSAlloc for
+ this data (a further guarantee that the memory will be freed }
+ { handle to keep track of who owns the field }
+
+ Pfielddef = ^Tfielddef;
+ Tfielddef = record
+ element : PLIST;
+ fieldFlags : longint;
+ fieldLine : longint;
+ fieldColumn : longint;
+ fieldWidth : longint;
+ fieldAttribute : longint;
+ fieldActivateKeys : longint;
+ fieldFormat : procedure (field:Pfielddef; text:pchar; buffLen:longint);cdecl;
+ fieldControl : function (field:Pfielddef; selectKey:longint; fieldChanged:Plongint; handle:PNUTInfo):longint;
+ fieldVerify : function (field:Pfielddef; data:pchar; handle:PNUTInfo):longint;
+ fieldRelease : procedure (para1:Pfielddef);
+ fieldData : pchar;
+ fieldXtra : pchar;
+ fieldHelp : longint;
+ fieldAbove : Pfielddef;
+ fieldBelow : Pfielddef;
+ fieldLeft : Pfielddef;
+ fieldRight : Pfielddef;
+ fieldPrev : Pfielddef;
+ fieldNext : Pfielddef;
+ fieldEntry : procedure (intoField:Pfielddef; fieldData:pointer; handle:PNUTInfo);
+ customData : pointer;
+ customDataRelease : procedure (fieldCustomData:pointer; handle:PNUTInfo);
+ nutInfo : PNUTInfo;
+ end;
+ TFIELD = Tfielddef;
+ PFIELD = ^TFIELD;
+ { Structures used for DisplayErrorCondition }
+
+ PPCERR_ = ^TPCERR_;
+ TPCERR_ = record
+ ccodeReturned : longint;
+ errorMessageNumber : longint;
+ end;
+ TPROCERROR = TPCERR_;
+ PPROCERROR = ^TPROCERROR;
+
+ PNA_ = ^TNA_;
+ TNA_ = record
+ address : pointer;
+ next : pointer;
+ end;
+ TNUT_ALLOC = TNA_;
+ PNUT_ALLOC = ^TNUT_ALLOC;
+
+ function NWSInitializeNut
+ (utility,
+ version,
+ headerType,
+ compatibilityLevel : longint;
+ messageTable : PPchar;
+ helpScreens : pchar;
+ screenID : TScr; // Clib/OS Screen Id
+ resourceTag : TRtag; // OS ResourceTagStructure
+ var handle : PNUTInfo) : longint;cdecl;external External_library name 'NWSInitializeNut';
+
+ procedure NWSScreenSize(maxLines,maxColumns:plongint);cdecl;external External_library name 'NWSScreenSize';
+ procedure NWSScreenSize(var maxLines,maxColumns:longint);cdecl;external External_library name 'NWSScreenSize';
+
+ procedure NWSShowPortalLine(line,column:longint; text:pchar; length:longint; portal:PPCB);cdecl;external External_library name 'NWSShowPortalLine';
+
+ procedure NWSShowPortalLineAttribute(line,column:longint; text:pchar; attribute,length:longint;
+ portal:PPCB);cdecl;external External_library name 'NWSShowPortalLineAttribute';
+
+ procedure NWSScrollPortalZone(line,column,height,width,attribute,
+ count,direction:longint; portal:PPCB);cdecl;external External_library name 'NWSScrollPortalZone';
+
+ procedure NWSFillPortalZone(line,column,height,width,fillCharacter,
+ fillAttribute:longint; portal:PPCB);cdecl;external External_library name 'NWSFillPortalZone';
+
+ procedure NWSFillPortalZoneAttribute(line,column,height,width,attribute:longint;
+ portal:PPCB);cdecl;external External_library name 'NWSFillPortalZoneAttribute';
+
+ function NWSGetMessage(message:longint; messages:PMessageInfo):pchar;cdecl;external External_library name 'NWSGetMessage';
+
+ procedure NWSSetDynamicMessage(message:longint; text:pchar; messages:PMessageInfo);cdecl;external External_library name 'NWSSetDynamicMessage';
+ procedure NWSSetDynamicMessage(message:longint; text:pchar; var messages:TMessageInfo);cdecl;external External_library name 'NWSSetDynamicMessage';
+
+ function NWSCreatePortal
+ (line,
+ column,
+ frameHeight,
+ frameWidth,
+ virtualHeight,
+ virtualWidth,
+ saveFlag:longint;
+ headerText:pchar;
+ headerAttribute,
+ borderType,
+ borderAttribute,
+ cursorFlag,
+ directFlag : longint;
+ handle : PNUTInfo) : longint;cdecl;external External_library name 'NWSCreatePortal';
+
+ procedure NWSDestroyPortal(portalNumber:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSDestroyPortal';
+
+ procedure NWSPositionPortalCursor(line:longint; column:longint; portal:PPCB);cdecl;external External_library name 'NWSPositionPortalCursor';
+
+ procedure NWSEnablePortalCursor(portal:PPCB);cdecl;external External_library name 'NWSEnablePortalCursor';
+
+ procedure NWSDisablePortalCursor(portal:PPCB);cdecl;external External_library name 'NWSDisablePortalCursor';
+
+ procedure NWSDeselectPortal(handle:PNUTInfo);cdecl;external External_library name 'NWSDeselectPortal';
+
+ procedure NWSSelectPortal(portalNumber:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSSelectPortal';
+
+ function NWSComputePortalPosition(centerLine:longint; centerColumn:longint; height:longint; width:longint; line:plongint;
+ column:plongint; handle:PNUTInfo):longint;cdecl;external External_library name 'NWSComputePortalPosition';
+
+ procedure NWSClearPortal(portal:PPCB);cdecl;external External_library name 'NWSClearPortal';
+
+type TFreeRoutine = procedure (memoryPointer:pointer); cdecl;
+
+ procedure NWSInitList(handle:PNUTInfo; freeRoutine:TFreeRoutine);cdecl;external External_library name 'NWSInitList';
+
+ function NWSPushList(handle:PNUTInfo):longint;cdecl;external External_library name 'NWSPushList';
+
+ function NWSPopList(handleNWS:PNUTInfo):longint;cdecl;external External_library name 'NWSPopList';
+
+ function NWSSaveList(listIndex:longint; handle:PNUTInfo):longint;cdecl;external External_library name 'NWSSaveList';
+
+ function NWSRestoreList(listIndex:longint; handle:PNUTInfo):longint;cdecl;external External_library name 'NWSRestoreList';
+
+ procedure NWSDestroyList(handle:PNUTInfo);cdecl;external External_library name 'NWSDestroyList';
+
+ procedure NWSDestroyMenu(handle:PNUTInfo);cdecl;external External_library name 'NWSDestroyMenu';
+
+ procedure NWSDestroyForm(handle:PNUTInfo);cdecl;external External_library name 'NWSDestroyForm';
+
+ function NWSAppendToList(text:pchar; otherInfo:pointer; handle:PNUTInfo):PLIST;cdecl;external External_library name 'NWSAppendToList';
+
+ function NWSDeleteFromList(el:PLIST; handle:PNUTInfo):PLIST;cdecl;external External_library name 'NWSDeleteFromList';
+
+ function NWSInsertInList(text:pchar; otherInfo:pointer; atElement:PLIST; handle:PNUTInfo):PLIST;cdecl;external External_library name 'NWSInsertInList';
+
+ function NWSGetListElementText(element:PLIST):pchar;cdecl;external External_library name 'NWSGetListElementText';
+
+ function NWSGetListHead(handle:PNUTInfo):PLIST;cdecl;external External_library name 'NWSGetListHead';
+
+ function NWSGetListTail(handle:PNUTInfo):PLIST;cdecl;external External_library name 'NWSGetListTail';
+
+ procedure NWSUnmarkList(handle:PNUTInfo);cdecl;external External_library name 'NWSUnmarkList';
+
+ procedure NWSSetList(listPtr:PLISTPTR; handle:PNUTInfo);cdecl;external External_library name 'NWSSetList';
+
+ procedure NWSGetList(listPtr:PLISTPTR; handle:PNUTInfo);cdecl;external External_library name 'NWSGetList';
+
+ function NWSIsAnyMarked(handle:PNUTInfo):longint;cdecl;external External_library name 'NWSIsAnyMarked';
+
+ procedure NWSPushMarks(handle:PNUTInfo);cdecl;external External_library name 'NWSPushMarks';
+
+ procedure NWSPopMarks(handle:PNUTInfo);cdecl;external External_library name 'NWSPopMarks';
+
+ procedure NWSSortList(handle:PNUTInfo);cdecl;external External_library name 'NWSSortList';
+
+ procedure NWSInitMenu(handle:PNUTInfo);cdecl;external External_library name 'NWSInitMenu';
+
+ procedure NWSInitForm(handle:PNUTInfo);cdecl;external External_library name 'NWSInitForm';
+
+ function NWSGetSortCharacter(charIndex:longint):longint;cdecl;external External_library name 'NWSGetSortCharacter';
+
+ function NWSGetLineDrawCharacter(charIndex:longint):longint;cdecl;external External_library name 'NWSGetLineDrawCharacter';
+
+ function NWSStrcat(_string, newStuff:pchar):longint;cdecl;external External_library name 'NWSStrcat';
+
+ procedure NWSMemmove(dest:pointer; source:pointer; len:longint);cdecl;external External_library name 'NWSMemmove';
+
+ function NWSToupper(ch:char):char;cdecl;external External_library name 'NWSToupper';
+
+ function NWSIsdigit(ch:char):longbool;cdecl;external External_library name 'NWSIsdigit';
+
+ function NWSIsxdigit(ch:char):longbool;cdecl;external External_library name 'NWSIsxdigit';
+
+ function NWSAsciiToInt(data:pchar):longint;cdecl;external External_library name 'NWSAsciiToInt';
+
+ function NWSAsciiToLONG(data:pchar):longint;cdecl;external External_library name 'NWSAsciiToLONG';
+
+ function NWSAsciiHexToInt(data:pchar):longint;cdecl;external External_library name 'NWSAsciiHexToInt';
+
+ procedure NWSWaitForEscape(handle:PNUTInfo);cdecl;external External_library name 'NWSWaitForEscape';
+
+ function NWSWaitForEscapeOrCancel(handle:PNUTInfo):longint;cdecl;external External_library name 'NWSWaitForEscapeOrCancel';
+
+ procedure NWSGetKey(_type:plongint; value:pchar; handle:PNUTInfo);cdecl;external External_library name 'NWSGetKey';
+ procedure NWSGetKey(var _type:longint; value:pchar; handle:PNUTInfo);cdecl;external External_library name 'NWSGetKey';
+
+ function NWSKeyStatus(handle:PNUTInfo):longint;cdecl;external External_library name 'NWSKeyStatus';
+
+ function NWSUngetKey(_type:longint; value:longint; handle:PNUTInfo):longint;cdecl;external External_library name 'NWSUngetKey';
+
+ procedure NWSEnableFunctionKey(key:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSEnableFunctionKey';
+
+ procedure NWSDisableFunctionKey(key:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSDisableFunctionKey';
+
+ procedure NWSDisableInterruptKey(key:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSDisableInterruptKey';
+
+type TInterruptProc = procedure (handle:pointer); cdecl;
+
+ procedure NWSEnableInterruptKey(key:longint; interruptProc:TInterruptProc; handle:PNUTInfo);cdecl;external External_library name 'NWSEnableInterruptKey';
+
+ procedure NWSSaveFunctionKeyList(keyList:pchar; handle:PNUTInfo);cdecl;external External_library name 'NWSSaveFunctionKeyList';
+
+ procedure NWSEnableFunctionKeyList(keyList:pchar; handle:PNUTInfo);cdecl;external External_library name 'NWSEnableFunctionKeyList';
+
+ procedure NWSSaveInterruptList(interruptList:PINTERRUPT; handle:PNUTInfo);cdecl;external External_library name 'NWSSaveInterruptList';
+
+ procedure NWSEnableInterruptList(interruptList:PINTERRUPT; handle:PNUTInfo);cdecl;external External_library name 'NWSEnableInterruptList';
+
+ procedure NWSDisableAllInterruptKeys(handle:PNUTInfo);cdecl;external External_library name 'NWSDisableAllInterruptKeys';
+
+ procedure NWSDisableAllFunctionKeys(handle:PNUTInfo);cdecl;external External_library name 'NWSDisableAllFunctionKeys';
+
+ procedure NWSEnableAllFunctionKeys(handle:PNUTInfo);cdecl;external External_library name 'NWSEnableAllFunctionKeys';
+
+ function NWSDisplayTextInPortal(line,indentLevel:longint; text:pchar; attribute:longint; portal:PPCB):longint;cdecl;external External_library name 'NWSDisplayTextInPortal';
+
+ function NWSDisplayInformation(header,pauseFlag,centerLine,centerColumn,palette,
+ attribute:longint; displayText:pchar; handle:PNUTInfo):longint;cdecl;external External_library name 'NWSDisplayInformation';
+
+ procedure NWSStartWait(centerLine,centerColumn:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSStartWait';
+
+ procedure NWSEndWait(handle:PNUTInfo);cdecl;external External_library name 'NWSEndWait';
+
+ function NWSAlert(centerLine,centerColumn:longint; handle:PNUTInfo; message:longint; args:array of const):longint;cdecl;external External_library name 'NWSAlert';
+
+ function NWSAlert(centerLine,centerColumn:longint; handle:PNUTInfo; message:longint):longint;cdecl;external External_library name 'NWSAlert';
+
+ function NWSAlertWithHelp(centerLine,centerColumn:longint; handle:PNUTInfo; message,helpContext:longint;
+ args:array of const):longint;cdecl;external External_library name 'NWSAlertWithHelp';
+
+ function NWSAlertWithHelp(centerLine,centerColumn:longint; handle:PNUTInfo; message:longint; helpContext:longint):longint;cdecl;external External_library name 'NWSAlertWithHelp';
+
+ function NWSTrace(handle:PNUTInfo; message:pchar; args:array of const):longint;cdecl;external External_library name 'NWSTrace';
+ function NWSTrace(handle:PNUTInfo; message:pchar):longint;cdecl;external External_library name 'NWSTrace';
+
+ procedure NWSDisplayErrorText(message:longint; severity:longint; handle:PNUTInfo; args:array of const);cdecl;external External_library name 'NWSDisplayErrorText';
+
+ procedure NWSDisplayErrorText(message:longint; severity:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSDisplayErrorText';
+
+ procedure NWSDisplayErrorCondition(procedureName:pchar; errorCode:longint; severity:longint; errorList:PPROCERROR; handle:PNUTInfo;
+ args:array of const);cdecl;external External_library name 'NWSDisplayErrorCondition';
+
+ procedure NWSDisplayErrorCondition(procedureName:pchar; errorCode:longint; severity:longint; errorList:PPROCERROR; handle:PNUTInfo);cdecl;external External_library name 'NWSDisplayErrorCondition';
+
+ function NWSAppendToMenu(message:longint; option:longint; handle:PNUTInfo):PLIST;cdecl;external External_library name 'NWSAppendToMenu';
+
+type TActionFunc = function (option:longint; parameter:pointer) : longint; cdecl;
+
+ function NWSMenu(header,
+ centerLine,
+ centerColumn:longint;
+ defaultElement:PLIST;
+ action:TActionFunc;
+ handle:PNUTInfo;
+ actionParameter:pointer):longint;cdecl;external External_library name 'NWSMenu';
+
+ function NWSConfirm(header,centerLine,centerColumn,defaultChoice:longint;
+ action:TActionFunc;
+ handle:PNUTInfo;
+ actionParameter:pointer):longint;cdecl;external External_library name 'NWSConfirm';
+
+ function NWSPushHelpContext(helpContext:longint; handle:PNUTInfo):longint;cdecl;external External_library name 'NWSPushHelpContext';
+
+ function NWSPopHelpContext(handle:PNUTInfo):longint;cdecl;external External_library name 'NWSPopHelpContext';
+
+type TFormatFunc=function (element:PLIST; skew:longint; displayLine:pchar; width:longint):longint; cdecl;
+ TNWSListActionFunc=function (keyPressed:longint; elementSelected:PPLIST; itemLineNumber:plongint; actionParameter:pointer):longint; cdecl;
+
+ function NWSList(header:longint; centerLine:longint; centerColumn:longint; height:longint; width:longint;
+ validKeyFlags:longint; element:PPLIST; handle:PNUTInfo; format:TFormatFunc; action:TNWSListActionFunc;
+ actionParameter:pointer):longint;cdecl;external External_library name 'NWSList';
+
+type TInsertFunc = function (text:pchar; otherInfo:Ppointer; parameters:pointer):longint; cdecl;
+ TFreeProcedure=function (otherInfo:pointer):longint; cdecl;
+
+ function NWSInsertInPortalList(currentElement:PPLIST; currentLine:plongint; InsertProcedure:TInsertFunc; FreeProcedure:TFreeProcedure; handle:PNUTInfo;
+ parameters:pointer):longint;cdecl;external External_library name 'NWSInsertInPortalList';
+
+type TModifyProcedure=function (text:pchar; parameters:pointer):longint; cdecl;
+
+ function NWSModifyInPortalList(currentElement:PPLIST; currentLine:plongint; ModifyProcedure:TModifyProcedure; handle:PNUTInfo; parameters:pointer):longint;cdecl;external External_library name 'NWSModifyInPortalList';
+
+type TDeleteFunc = function (el:PLIST; handle:PNUTInfo; parameters:pointer):PLIST; cdecl;
+ function NWSDeleteFromPortalList(currentElement:PPLIST; currentLine:plongint; DeleteProcedure:TDeleteFunc; deleteCurrentHeader:longint; deleteMarkedHeader:longint;
+ handle:PNUTInfo; parameters:pointer):longint;cdecl;external External_library name 'NWSDeleteFromPortalList';
+
+type TNWSEditInsertFunc=function (buffer:pchar; maxLen:longint; parameters:pointer):longint; cdecl;
+ TNWSEditActionFunc=function (action:longint; buffer:pchar; parameters:pointer):longint; cdecl;
+
+ function NWSEditString(
+ centerLine, centerColumn, editHeight, editWidth, header,
+ prompt :longint;
+ buf:pchar;
+ maxLen, _type:longint; handle:PNUTInfo;
+ insertProc:TNWSEditInsertFunc;
+ actionProc:TNWSEditActionFunc;
+ parameters:pointer):longint;cdecl;external External_library name 'NWSEditString';
+
+ function NWSAppendIntegerField
+ (line, column, fflag:longint; data:Plongint;
+ minimum, maximum, help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendIntegerField';
+
+ function NWSAppendIntegerField
+ (line, column, fflag:longint; var data:longint;
+ minimum, maximum, help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendIntegerField';
+
+ function NWSAppendUnsignedIntegerField
+ (line,
+ column,
+ fflag:longint;
+ data:plongint;
+ minimum, maximum, help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendUnsignedIntegerField';
+
+ function NWSAppendUnsignedIntegerField
+ (line,
+ column,
+ fflag:longint;
+ var data:cardinal;
+ minimum, maximum, help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendUnsignedIntegerField';
+
+ function NWSAppendHexField
+ (line,column,fflag:longint;
+ data:Plongint;
+ minimum, maximum, help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendHexField';
+
+ procedure NWSDisplayPreHelp
+ (line, column, message:longint;
+ handle:PNUTInfo);cdecl;external External_library name 'NWSDisplayPreHelp';
+
+ procedure NWSRemovePreHelp
+ (handle:PNUTInfo);cdecl;external External_library name 'NWSRemovePreHelp';
+
+ function NWSGetADisk
+ (volName,prompt:pchar;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSGetADisk';
+
+ procedure NWSInitListPtr(listPtr:PLISTPTR);cdecl;external External_library name 'NWSInitListPtr';
+
+ function NWSEditForm
+ (headernum,
+ line,
+ col,
+ portalHeight,
+ portalWidth,
+ virtualHeight,
+ virtualWidth,
+ ESCverify,
+ forceverify,
+ confirmMessage : longint;
+ handle : PNUTInfo):longint;cdecl;external External_library name 'NWSEditForm';
+
+ function NWSEditPortalFormField
+ (header,
+ cline,
+ ccol,
+ formHeight,
+ formWidth,
+ controlFlags:longint;
+ formHelp:CARDINAL;
+ confirmMessage:longint;
+ startField:PFIELD;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSEditPortalFormField';
+
+ function NWSEditPortalForm
+ (header,
+ centerLine,
+ centerColumn,
+ formHeight,
+ formWidth,
+ controlFlags:longint;
+ formHelp:CARDINAL;
+ confirmMessage:longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSEditPortalForm';
+
+type TfFormat = procedure (field:Pfielddef; text:pchar; buffLen:longint); cdecl;
+ TfControl = function (field:Pfielddef; selectKey:longint; var fieldChanged:longint; handle:PNUTInfo):longint; cdecl;
+ TfVerify = function (field:Pfielddef; data:pointer; handle:PNUTInfo):longint; cdecl;
+ TfRelease = procedure (field:Pfielddef); cdecl;
+
+ { Data & Xtra field release routine }
+ function NWSAppendToForm(
+ fline,
+ fcol,
+ fwidth,
+ fattr:longint;
+ fFormat:TfFormat;
+ fControl:TfControl;
+ fVerify:TfVerify;
+ fRelease:TfRelease;
+ fData:pointer;
+ fXtra:pointer;
+ fflags:longint;
+ fActivateKeys:longint;
+ fhelp:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendToForm';
+
+ function NWSAppendPromptField(line,column,promptnum:longint; handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendPromptField';
+
+ function NWSAppendCommentField(line,column:longint; prompt:pchar; handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendCommentField';
+
+ function NWSAppendStringField
+ (line,
+ column,
+ width,
+ fflag:longint;
+ data,cset:pchar;
+ help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendStringField';
+
+ function NWSAppendBoolField
+ (line,
+ column,
+ fflag:longint;
+ data:pointer;
+ help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendBoolField';
+
+ function NWSAppendBoolField
+ (line,
+ column,
+ fflag:longint;
+ var data:longbool;
+ help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendBoolField';
+
+ function NWSAppendGenericBoolField
+ (line,
+ column,
+ fflag:longint;
+ data:pointer;
+ help:longint;
+ yesString, noString:pchar;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendGenericBoolField';
+
+ function NWSAppendGenericBoolField
+ (line,
+ column,
+ fflag:longint;
+ var data:longbool;
+ help:longint;
+ yesString, noString:pchar;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendGenericBoolField';
+
+type TSpotActionFunc = function (fp:PFIELD; selectKey:longint; var changedField:longint; handle:PNUTInfo):longint; cdecl;
+ function NWSAppendHotSpotField
+ (line,
+ column,
+ fflag:longint;
+ displayString:pchar;
+ SpotAction:TSpotActionFunc;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendHotSpotField';
+
+ function NWSInitMenuField
+ (headermsg,
+ cLine,
+ cCol:longint;
+ action:TActionFunc;
+ nutInfo:PNUTInfo;
+ args:array of const):PMFCONTROL;cdecl;external External_library name 'NWSInitMenuField';
+
+ function NWSInitMenuField
+ (headermsg,
+ cLine,
+ cCol:longint;
+ action:TActionFunc;
+ nutInfo:PNUTInfo):PMFCONTROL;cdecl;external External_library name 'NWSInitMenuField';
+
+ function NWSAppendToMenuField
+ (m:PMFCONTROL;
+ optiontext:longint;
+ option:longint;
+ nutInfo:PNUTInfo):longint;cdecl;external External_library name 'NWSAppendToMenuField';
+
+ function NWSAppendMenuField
+ (line,
+ column,
+ fflag:longint;
+ data:Plongint;
+ m:PMFCONTROL;
+ help:longint;
+ nutInfo:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendMenuField';
+
+ function NWSAppendMenuField
+ (line,
+ column,
+ fflag:longint;
+ var data:longint;
+ m:PMFCONTROL;
+ help:longint;
+ nutInfo:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendMenuField';
+
+ function NWSEditText
+ (centerLine,
+ centerColumn,
+ height,
+ width,
+ headerNumber:longint;
+ textBuffer:pchar;
+ maxBufferLength,
+ confirmMessage,
+ forceConfirm:longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSEditText';
+
+ function NWSViewText
+ (centerLine,
+ centerColumn,
+ height,
+ width,
+ headerNumber:longint;
+ textBuffer:pchar;
+ maxBufferLength:longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSViewText';
+
+ procedure NWSDisplayHelpScreen
+ (offset:longint;
+ handle:PNUTInfo);cdecl;external External_library name 'NWSDisplayHelpScreen';
+
+ // Allocates memory for NWSNUT purposes
+ function NWSAlloc
+ (numberOfBytes:longint;
+ handle:PNUTInfo):pointer;cdecl;external External_library name 'NWSAlloc';
+
+ procedure NWSFree
+ (address:pointer;
+ handle:PNUTInfo);cdecl;external External_library name 'NWSFree';
+
+ // Displays justified text in an existing portal
+ function NWSDisplayTextJustifiedInPortal
+ (justify,
+ line:longint; column:longint; textWidth:longint; text:pchar;
+ attribute:longint; portal:PPCB):longint;cdecl;external External_library name 'NWSDisplayTextJustifiedInPortal';
+
+ function NWSDisplayInformationInPortal
+ (header,
+ portalJustifyLine,
+ portalJustifyColumn,
+ portalJustifyType,
+ portalPalette,
+ portalBorderType,
+ portalMaxWidth,
+ portalMaxHeight,
+ portalMinWidth,
+ portalMinHeight,
+ textLRJustifyType,
+ textLRIndent,
+ textTBJustifyType,
+ textTBIndent,
+ textAttribute,
+ textMinimizeStyle:longint;
+ text:pchar;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSDisplayInformationInPortal';
+
+ procedure NWSRestoreNut(handle:PNUTInfo);cdecl;external External_library name 'NWSRestoreNut';
+
+ procedure NWSDrawPortalBorder(portal:PPCB);cdecl;external External_library name 'NWSDrawPortalBorder';
+
+ procedure NWSUpdatePortal(portal:PPCB);cdecl;external External_library name 'NWSUpdatePortal';
+
+type TSSFEntryProc = procedure (para1:PFIELD; para2:pointer; para3:PNUTInfo); cdecl;
+ TSSFCustomDataReleaseProc = procedure (para1:pointer; para2:PNUTInfo); cdecl;
+ TSSFFormat=procedure (para1:PFIELD; text:pchar; para3:longint); cdecl;
+ TSSFControlFunc = function (para1:PFIELD; para2:longint; para3:Plongint; para4:PNUTInfo):longint; cdecl;
+ TSSFVerifyFunc = function (para1:PFIELD; para2:pointer; para3:PNUTInfo):longint; cdecl;
+ TSSFReleaseProc = procedure (para1:PFIELD); cdecl;
+
+ procedure NWSSetFieldFunctionPtr(fp:PFIELD;
+ Format : TSSFFormat;
+ Control: TSSFControlFunc;
+ Verify : TSSFVerifyFunc;
+ Release: TSSFReleaseProc;
+ Entry : TSSFEntryProc;
+ customDataRelease
+ : TSSFCustomDataReleaseProc);cdecl;external External_library name 'NWSSetFieldFunctionPtr';
+
+
+type TCompareFunc = function (el1:PLIST; el2:PLIST):longint; cdecl;
+ procedure NWSSetDefaultCompare(handle:PNUTInfo;
+ defaultCompareFunction:TCompareFunc);cdecl;external External_library name 'NWSSetDefaultCompare';
+
+ procedure NWSGetDefaultCompare(handle:PNUTInfo; var defaultCompareFunction:TCompareFunc);cdecl;external External_library name 'NWSGetDefaultCompare';
+
+type TlistSortFunction = procedure (head:PLIST; tail:PLIST; handle:PNUTInfo); cdecl;
+ { added in version 402 }
+ procedure NWSSetListSortFunction(handle:PNUTInfo;
+ listSortFunction:TlistSortFunction);cdecl;external External_library name 'NWSSetListSortFunction';
+
+ { added in version 402 }
+ procedure NWSGetListSortFunction(handle:PNUTInfo;
+ var listSortFunction:TlistSortFunction);cdecl;external External_library name 'NWSGetListSortFunction';
+
+ procedure NWSSetScreenPalette(newPalette:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSSetScreenPalette';
+
+ function NWSGetScreenPalette(handle:PNUTInfo):longint;cdecl;external External_library name 'NWSGetScreenPalette';
+
+ procedure NWSGetPCB(var _pPcb:PPCB; portalNumber:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSGetPCB';
+
+type TentryProcedure = procedure (element:PLIST; displayLine:longint; handle:PNUTInfo); cdecl;
+ procedure NWSSetListNotifyProcedure(el:PLIST;
+ entryProcedure:TentryProcedure);cdecl;external External_library name 'NWSSetListNotifyProcedure';
+
+ procedure NWSGetListNotifyProcedure(el:PLIST;
+ var entryProcedure:TentryProcedure);cdecl;external External_library name 'NWSGetListNotifyProcedure';
+
+type TcdReleaseProc = procedure (theData:pointer; handle:PNUTInfo); cdecl;
+ procedure NWSSetHandleCustomData(handle:PNUTInfo;
+ customData:pointer;
+ customDataRelease:TcdReleaseProc);cdecl;external External_library name 'NWSSetHandleCustomData';
+
+ procedure NWSGetHandleCustomData(handle:PNUTInfo;
+ customData:Ppointer;
+ customDataRelease:TcdReleaseProc);cdecl;external External_library name 'NWSGetHandleCustomData';
+
+ procedure NWSSetErrorLabelDisplayFlag(flag:longint;
+ handle:PNUTInfo);cdecl;external External_library name 'NWSSetErrorLabelDisplayFlag';
+
+ procedure NWSSetHelpHelp(helpIndex:longint;
+ handle:PNUTInfo);cdecl;external External_library name 'NWSSetHelpHelp';
+
+ { max length of passwordString, including NULL }
+ function NWSPromptForPassword
+ (passwordHeader,
+ line,
+ column,
+ maxPasswordLen : longint;
+ passwordString:pchar;
+ verifyEntry:longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSPromptForPassword';
+
+ function NWSAppendPasswordField
+ (line,
+ column,
+ width,
+ fflag:longint; // field flags
+ data:pchar; // ptr to field text
+ maxDataLen, // including null
+ help, // help for field
+ verifyEntry, // force password verification
+ passwordPortalHeader,
+ maskCharacter:longint; // fill character for field
+ nhandle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendPasswordField';
+
+ function NWSAppendScrollableStringField
+ (line,
+ column,
+ width,
+ fflag:longint;
+ data:pchar;
+ maxLen:longint; // max len of data, allowing for null terminator
+ cset:pointer; // valid characters, if using EF_SET
+ editFlags, // NWSEditString flags (EF_UPPER etc.)
+ help:longint;
+ handle:PNUTInfo):PFIELD;cdecl;external External_library name 'NWSAppendScrollableStringField';
+
+type TSSFInsertFunc = function (_string:pchar; maxLen:longint; parameters:pointer):longint; cdecl;
+ procedure NWSSetScrollableFieldInsertProc(fp:PFIELD; insertProc:TSSFInsertFunc);cdecl;external External_library name 'NWSSetScrollableFieldInsertProc';
+
+ { Returns 0 for success, -1 if none selected }
+ { if not NULL, returns portal number }
+ function NWSGetCurrentPortal(nutInfo:PNUTInfo; portalNumber:plongint; var portal:PPCB):longint;cdecl;external External_library name 'NWSGetCurrentPortal';
+
+ { if not NULL, returns PCB pointer }
+ function NWSWaitForKeyAndValue(handle:PNUTInfo;
+ nKeys:longint;
+ keyType:array of longint;
+ keyValue:array of longint):longint;cdecl;external External_library name 'NWSWaitForKeyAndValue';
+
+ procedure NWSShowLineAttribute(line,
+ column:longint;
+ text:pchar;
+ attribute,
+ length:longint;
+ screenID:TScr);cdecl;external External_library name 'NWSShowLineAttribute';
+
+ procedure NWSShowLine(line,column:longint; text:pchar; length:longint; screenID:TScr);cdecl;external External_library name 'NWSShowLine';
+
+ procedure NWSScrollZone
+ (line,
+ column,
+ height,
+ width,
+ attribute,
+ count,
+ direction:longint;
+ screenID:TScr);cdecl;external External_library name 'NWSScrollZone';
+
+ procedure NWSSaveZone
+ (line,
+ column,
+ height,
+ width:longint;
+ buffer:pointer;
+ screenID:TScr);cdecl;external External_library name 'NWSSaveZone';
+
+ procedure NWSSaveZone
+ (line,
+ column,
+ height,
+ width:longint;
+ var buffer;
+ screenID:TScr);cdecl;external External_library name 'NWSSaveZone';
+
+ procedure NWSRestoreZone
+ (line,
+ column,
+ height,
+ width:longint;
+ buffer:pointer;
+ screenID:TScr);cdecl;external External_library name 'NWSRestoreZone';
+
+ procedure NWSRestoreZone
+ (line,
+ column,
+ height,
+ width:longint;
+ var buffer;
+ screenID:TScr);cdecl;external External_library name 'NWSRestoreZone';
+
+ procedure NWSRestoreDisplay(screenID:TScr);cdecl;external External_library name 'NWSRestoreDisplay';
+
+ procedure NWSPositionCursor(line, column:longint; screenID:TScr);cdecl;external External_library name 'NWSPositionCursor';
+
+ procedure NWSGetNUTVersion(majorVersion, minorVersion, revision:plongint);cdecl;external External_library name 'NWSGetNUTVersion';
+ procedure NWSGetNUTVersion(var majorVersion, minorVersion, revision:longint);cdecl;external External_library name 'NWSGetNUTVersion';
+
+ procedure NWSSetFormRepaintFlag(value:longint; handle:PNUTInfo);cdecl;external External_library name 'NWSSetFormRepaintFlag';
+
+ procedure NWSSetFormNoWrap(handle:PNUTInfo);cdecl;external External_library name 'NWSSetFormNoWrap';
+
+ function NWSViewTextWithScrollBars
+ (centerLine,
+ centerColumn,
+ height,
+ width,
+ headerNumber:longint;
+ textBuffer:pchar;
+ maxBufferLength,
+ scrollBarFlag:longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSViewTextWithScrollBars';
+
+ { length of document }
+ function NWSEditTextWithScrollBars
+ (centerLine,
+ centerColumn,
+ height,
+ width,
+ headerNumber:longint;
+ textBuffer:pchar;
+ maxBufferLength,
+ confirmMessage,
+ forceConfirm,
+ scrollBarFlag:longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSEditTextWithScrollBars';
+
+ function NWSEditTextWithScrollBars
+ (centerLine,
+ centerColumn,
+ height,
+ width,
+ headerNumber:longint;
+ textBuffer:pchar;
+ maxBufferLength,
+ confirmMessage : longint;
+ forceConfirm : longbool;
+ scrollBarFlag : longint;
+ handle:PNUTInfo):longint;cdecl;external External_library name 'NWSEditTextWithScrollBars';
+
+
+implementation
+
+ function F_H1 : longint;
+ begin
+ F_H1:=NWSGetLineDrawCharacter(0);
+ end;
+
+ function F_H2 : longint;
+ begin
+ F_H2:=NWSGetLineDrawCharacter(1);
+ end;
+
+ function F_V1 : longint;
+ begin
+ F_V1:=NWSGetLineDrawCharacter(2);
+ end;
+
+ function F_V2 : longint;
+ begin
+ F_V2:=NWSGetLineDrawCharacter(3);
+ end;
+
+ function F_UL1 : longint;
+ begin
+ F_UL1:=NWSGetLineDrawCharacter(4);
+ end;
+
+ function F_UR1 : longint;
+ begin
+ F_UR1:=NWSGetLineDrawCharacter(5);
+ end;
+
+ function F_LL1 : longint;
+ begin
+ F_LL1:=NWSGetLineDrawCharacter(6);
+ end;
+
+ function F_LR1 : longint;
+ begin
+ F_LR1:=NWSGetLineDrawCharacter(7);
+ end;
+
+ function F_UL2 : longint;
+ begin
+ F_UL2:=NWSGetLineDrawCharacter(8);
+ end;
+
+ function F_UR2 : longint;
+ begin
+ F_UR2:=NWSGetLineDrawCharacter(9);
+ end;
+
+ function F_LL2 : longint;
+ begin
+ F_LL2:=NWSGetLineDrawCharacter(10);
+ end;
+
+ function F_LR2 : longint;
+ begin
+ F_LR2:=NWSGetLineDrawCharacter(11);
+ end;
+
+ function F_UT1 : longint;
+ begin
+ F_UT1:=NWSGetLineDrawCharacter(12);
+ end;
+
+ function F_DT1 : longint;
+ begin
+ F_DT1:=NWSGetLineDrawCharacter(13);
+ end;
+
+ function F_LT1 : longint;
+ begin
+ F_LT1:=NWSGetLineDrawCharacter(14);
+ end;
+
+ function F_RT1 : longint;
+ begin
+ F_RT1:=NWSGetLineDrawCharacter(15);
+ end;
+
+ function F_UT2 : longint;
+ begin
+ F_UT2:=NWSGetLineDrawCharacter(24);
+ end;
+
+ function F_DT2 : longint;
+ begin
+ F_DT2:=NWSGetLineDrawCharacter(25);
+ end;
+
+ function F_LT2 : longint;
+ begin
+ F_LT2:=NWSGetLineDrawCharacter(26);
+ end;
+
+ function F_RT2 : longint;
+ begin
+ F_RT2:=NWSGetLineDrawCharacter(27);
+ end;
+
+ function F_X1 : longint;
+ begin
+ F_X1:=NWSGetLineDrawCharacter(36);
+ end;
+
+ function F_X2 : longint;
+ begin
+ F_X2:=NWSGetLineDrawCharacter(39);
+ end;
+
+ function F_UP : longint;
+ begin
+ F_UP:=NWSGetLineDrawCharacter(40);
+ end;
+
+ function F_DOWN : longint;
+ begin
+ F_DOWN:=NWSGetLineDrawCharacter(41);
+ end;
+
+ function F_LEFT : longint;
+ begin
+ F_LEFT:=NWSGetLineDrawCharacter(42);
+ end;
+
+ function F_RIGHT : longint;
+ begin
+ F_RIGHT:=NWSGetLineDrawCharacter(43);
+ end;
+
+ function F_BG1 : longint;
+ begin
+ F_BG1:=NWSGetLineDrawCharacter(44);
+ end;
+
+ function F_BG2 : longint;
+ begin
+ F_BG2:=NWSGetLineDrawCharacter(45);
+ end;
+
+ function F_BG3 : longint;
+ begin
+ F_BG3:=NWSGetLineDrawCharacter(46);
+ end;
+
+ function F_BG4 : longint;
+ begin
+ F_BG4:=NWSGetLineDrawCharacter(47);
+ end;
+
+ function IS_DYNAMIC_MESSAGE(a : longint) : boolean;
+ begin
+ IS_DYNAMIC_MESSAGE:=(a > $fff0) and (a < $ffff);
+ end;
+
+
+end.
+
+{
+ $Log: nwsnut.pp,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.2 2005/01/04 11:25:33 armin
+ * rtl code cleanup, compat fixes between clib and libc
+
+}
diff --git a/rtl/netware/nwsock.inc b/rtl/netware/nwsock.inc
new file mode 100644
index 0000000000..8e2962af70
--- /dev/null
+++ b/rtl/netware/nwsock.inc
@@ -0,0 +1,227 @@
+{! completely untested !}
+
+
+{******************************************************************************
+ Import Socket Functions from nlmlib
+******************************************************************************}
+
+CONST SockLib = 'nlmlib.nlm';
+
+Function _NWsocket(Domain,SocketType,Protocol:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'socket';
+Function _NWSend(Sock:Longint;Const Addr;AddrLen,Flags:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'send';
+Function _NWSendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint; Var Addr; AddrLen : longint):Longint; CDECL; EXTERNAL SockLib NAME 'sendto';
+Function _NWRecv(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'recv';
+Function _NWRecvFrom(Sock:Longint;Var Buf;BufLen,Flags:Longint; Var Addr; AddrLen : Longint):Longint; CDECL; EXTERNAL SockLib NAME 'recvfrom';
+Function _NWBind(Sock:Longint;Const Addr;AddrLen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'bind';
+Function _NWListen(Sock,MaxConnect:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'listen';
+Function _NWAccept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'accept';
+Function _NWConnect(Sock:Longint;Const Addr;Addrlen:Longint): longint; CDECL; EXTERNAL SockLib NAME 'connect';
+Function _NWShutdown(Sock:Longint;How:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'shutdown';
+Function _NWGetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'getsocketname';
+Function _NWGetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint; CDECL; EXTERNAL SockLib NAME 'getpeername';
+Function _NWSetSockOpt(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint; CDECL; EXTERNAL SockLib NAME 'setsockopt';
+Function _NWGetSockOpt(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint; CDECL; EXTERNAL SockLib NAME 'getsockopt';
+
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ Socket:=_NWSocket(Domain,SocketType,Protocol);
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+begin
+ Send:=_NWSend(Sock,Buf,BufLen,Flags);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+begin
+ SendTo := _NWSendTo (Sock, Buf, BufLen, Flags, Addr, AddrLen);
+end;
+
+
+Function Recv(Sock:Longint;Var Buf; BufLen,Flags:Longint):Longint;
+begin
+ Recv:=_NWRecv(Sock,Buf,BufLen,Flags);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr ; AddrLen : Integer) : longint;
+begin
+ RecvFrom := _NWRecvFrom (Sock, Buf, BufLen, Flags, Addr, AddrLen);
+end;
+
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+begin
+ Bind:=(_NWBind(Sock,Addr,AddrLen)=0);
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+begin
+ Listen:=(_NWListen(Sock,MaxConnect)=0);
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ Accept:=_NWAccept(Sock,Addr,AddrLen);
+ If Accept<0 Then
+ Accept:=-1;
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint): boolean;
+begin
+ Connect:=_NWConnect(Sock,Addr,AddrLen)=0;
+end;
+
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+ ShutDown:=_NWShutdown(Sock,How);
+end;
+
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=_NWGetSocketName(Sock,Addr,AddrLen);
+end;
+
+
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=_NWGetPeerName(Sock,Addr,AddrLen);
+end;
+
+
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+begin
+ SetSocketOptions:=_NWSetsockopt(Sock,Level,OptName,OptVal,OptLen);
+end;
+
+
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=_NWGetsockopt(Sock,Level,OptName,OptVal,OptLen);
+end;
+
+
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ //SocketPair:=do_syscall(syscall_nr_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+ Socketpair := -1;
+end;
+
+{******************************************************************************
+ UnixSock
+******************************************************************************}
+
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+begin
+ Move(Addr[1],t.Path,length(Addr));
+ t.Family:=AF_UNIX;
+ t.Path[length(Addr)]:=#0;
+ Len:=Length(Addr)+3;
+end;
+
+
+Function Bind(Sock:longint;const addr:string):boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ Bind(Sock,UnixAddr,AddrLen);
+ Bind:=(SocketError=0);
+end;
+
+
+
+Function DoAccept(Sock:longint;var addr:string):longint;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ AddrLen:=length(addr)+3;
+ DoAccept:=Accept(Sock,UnixAddr,AddrLen);
+ Move(UnixAddr.Path,Addr[1],AddrLen);
+ SetLength(Addr,AddrLen);
+end;
+
+
+
+Function DoConnect(Sock:longint;const addr:string):Boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ DoConnect:=Connect(Sock,UnixAddr,AddrLen);
+end;
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2Text(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2File(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ If Connect then
+ Sock2Text(Sock,SockIn,SockOut);
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ if Connect then
+ Sock2File(Sock,SockIn,SockOut);
+end;
+
+
+// fsread and fswrite are used in socket.inc
+procedure fdwrite (Handle:longint; VAR Data; Len : LONGINT);
+begin
+ { this has to be checked: }
+ _NWSend(Handle,Data,Len,0);
+end;
+
+function fdread (Handle:longint; VAR Data; Len : LONGINT) : LONGINT;
+begin
+ { this has to be checked: }
+ fdread := _NWRecv(Handle,Data,Len,0);
+end;
diff --git a/rtl/netware/nwsys.inc b/rtl/netware/nwsys.inc
new file mode 100644
index 0000000000..7d695b1ffd
--- /dev/null
+++ b/rtl/netware/nwsys.inc
@@ -0,0 +1,378 @@
+{
+ $Id: nwsys.inc,v 1.14 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+ Copyright (c) 2001-2004 Armin Diehl
+
+ Interface to netware clib
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+CONST Clib = 'clib';
+ ThreadsNlm = 'threads';
+
+TYPE
+ dev_t = LONGINT;
+ ino_t = LONGINT;
+ unsignedshort = WORD;
+ unsignedlong = LONGINT;
+ unsignedint = LONGINT;
+ off_t = LONGINT;
+ size_t = LONGINT;
+ time_t = LONGINT;
+ NWStatBufT = PACKED RECORD
+ st_dev : dev_t; (* volume number *)
+ st_ino : ino_t; (* directory entry number of the st_name *)
+ st_mode : unsignedshort; (* emulated file mode *)
+ st_nlink : unsignedshort; (* count of hard links (always 1) *)
+ st_uid : unsignedlong; (* object id of owner *)
+ st_gid : unsignedshort; (* group-id (always 0) *)
+ st_rdev : dev_t; (* device type (always 0) *)
+ st_size : off_t; (* total file size--files only *)
+ st_atime : time_t; (* last access date--files only *)
+ st_mtime : time_t; (* last modify date and time *)
+ st_ctime : time_t; (* POSIX: last status change time... *)
+ (* ...NetWare: creation date/time *)
+ st_btime : time_t; (* last archived date and time *)
+ st_attr : unsignedlong; (* file attributes *)
+ st_archivedID : unsignedlong; (* user/object ID of last archive *)
+ st_updatedID : unsignedlong; (* user/object ID of last update *)
+ st_inheritedRightsMask
+ : unsignedshort; (* inherited rights mask *)
+ st_originatingNameSpace
+ : BYTE; (* namespace of creation *)
+ st_name : ARRAY [0..255] OF CHAR;
+ (* TARGET_NAMESPACE name *)
+ st_blksize : LONGINT;
+ st_blocks : LONGINT;
+ st_flags : LONGINT;
+ st_spare : ARRAY [0..3] OF LONGINT;
+ END;
+
+FUNCTION _stat (path : PCHAR; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL Clib NAME 'stat_411';
+FUNCTION _fstat (Fileno : LONGINT; VAR buf : NWStatBufT) : LONGINT; CDECL; EXTERNAL CLib NAME 'fstat_411';
+
+PROCEDURE NWFree (P : POINTER); CDECL; EXTERNAL Clib NAME 'free';
+
+PROCEDURE PressAnyKeyToContinue; CDecl; EXTERNAL; // Clib;
+
+
+PROCEDURE ExitThread (action_code, termination_code : LONGINT); CDecl; EXTERNAL CLib;
+FUNCTION _BeginThread (func, stack : pointer; Stacksize : LONGINT; arg : pointer) : LONGINT; Cdecl; EXTERNAL CLib NAME 'BeginThread';
+FUNCTION _GetThreadDataAreaPtr : POINTER; CDecl; EXTERNAL CLib NAME 'GetThreadDataAreaPtr';
+PROCEDURE _SaveThreadDataAreaPtr (P : POINTER); CDecl; EXTERNAL CLib NAME 'SaveThreadDataAreaPtr';
+PROCEDURE _exit (ExitCode : LONGINT); CDecl; EXTERNAL CLib;
+function _SuspendThread(threadID:longint):longint; cdecl;external ThreadsNlm name 'SuspendThread';
+function _GetThreadID:longint; cdecl;external ThreadsNlm name 'GetThreadID';
+procedure _ThreadSwitchWithDelay; cdecl;external ThreadsNlm name 'ThreadSwitchWithDelay';
+function _GetThreadName(threadID:longint; var tName):longint; cdecl;external ThreadsNlm name 'GetThreadName';
+function GetNLMHandle:dword; cdecl;external ThreadsNlm name 'GetNLMHandle';
+(*
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : pchar); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
+PROCEDURE ConsolePrintf (FormatStr : PCHAR; P1,P2,P3,P4 : LONGINT); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
+PROCEDURE ConsolePrintf (FormatStr : PCHAR); CDecl; EXTERNAL CLib Name 'ConsolePrintf';
+*)
+// this gives internal compiler error 1234124 ??
+//PROCEDURE ConsolePrintf (FormatStr : PCHAR; Param : array of const); CDecl; EXTERNAL CLib;
+
+PROCEDURE _printf (FormatStr : PCHAR; Param : LONGINT); CDecl; EXTERNAL CLib;
+PROCEDURE _printf (FormatStr : PCHAR); CDecl; EXTERNAL CLib;
+// this gives internet compiler error 1234124 ??
+// PROCEDURE _printf (FormatStr : PCHAR; Param : array of const); CDecl; EXTERNAL CLib;
+
+// values for __action_code used with ExitThread()
+CONST
+ TSR_THREAD = -1; //-Terminate only the current thread.
+ EXIT_THREAD = 0; //-Terminate the current thread; if the current thread is
+ // also the last thread, terminate the NLM.
+ EXIT_NLM = 1; //-Terminate the entire NLM.
+
+FUNCTION _GetStdIn : POINTER; CDECL; EXTERNAL Clib NAME '__get_stdin'; // result: **FILE
+FUNCTION _GetStdOut : POINTER; CDECL; EXTERNAL Clib NAME '__get_stdout';
+FUNCTION _GetStdErr : POINTER; CDECL; EXTERNAL Clib NAME '__get_stderr';
+
+// FileIO by Fileno
+FUNCTION _open (FileName : PCHAR; access, mode : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'open';
+FUNCTION _close (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'close';
+FUNCTION _lseek (FileNo,Pos,whence :LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'lseek';
+FUNCTION _chsize (FileNo,Pos : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'chsize';
+FUNCTION _tell (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'tell';
+FUNCTION _write (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'write';
+FUNCTION _read (FileNo : LONGINT; BufP : POINTER; Len : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'read';
+FUNCTION _filelength (filedes : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'filelength';
+FUNCTION _lock (filedes : LONGINT; Offset, Length : Cardinal) : LONGINT; CDECL; EXTERNAL Clib NAME 'lock';
+FUNCTION _unlock (filedes : LONGINT; Offset, Length : Cardinal) : LONGINT; CDECL; EXTERNAL Clib NAME 'unlock';
+
+TYPE
+ NWModifyStructure =
+ RECORD
+ MModifyName : PCHAR;
+ MFileAttributes : LONGINT;
+ MFileAttributesMask : LONGINT;
+ MCreateDate : WORD;
+ MCreateTime : WORD;
+ MOwnerID : LONGINT;
+ MLastArchivedDate : WORD;
+ MLastArchivedTime : WORD;
+ MLastArchivedID : LONGINT;
+ MLastUpdatedDate : WORD;
+ MLastUpdatedTime : WORD;
+ MLastUpdatedID : LONGINT;
+ MLastAccessedDate : WORD;
+ MInheritanceGrantMask : WORD;
+ MInheritanceRevokeMask : WORD;
+ MMaximumSpace : LONGINT;
+ MLastUpdatedInSeconds : LONGINT
+ END;
+
+CONST MModifyNameBit = $0001;
+ MFileAtrributesBit = $0002;
+ MCreateDateBit = $0004;
+ MCreateTimeBit = $0008;
+ MOwnerIDBit = $0010;
+ MLastArchivedDateBit = $0020;
+ MLastArchivedTimeBit = $0040;
+ MLastArchivedIDBit = $0080;
+ MLastUpdatedDateBit = $0100;
+ MLastUpdatedTimeBit = $0200;
+ MLastUpdatedIDBit = $0400;
+ MLastAccessedDateBit = $0800;
+ MInheritanceRestrictionMaskBit = $1000;
+ MMaximumSpaceBit = $2000;
+ MLastUpdatedInSecondsBit = $4000;
+
+// Directory
+FUNCTION _chdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'chdir';
+FUNCTION _getcwd (path : PCHAR; pathlen : LONGINT) : PCHAR; CDECL; EXTERNAL CLib NAME 'getcwd';
+FUNCTION _mkdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'mkdir';
+FUNCTION _rmdir (path : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'rmdir';
+FUNCTION _ChangeDirectoryEntry (PathName : PCHAR; VAR ModyStruct : NWModifyStructure; ModifyBits, AllowWildcard : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'ChangeDirectoryEntry';
+
+// get fileno from stream
+FUNCTION _fileno (Handle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'fileno';
+FUNCTION _isatty (FileNo : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'isatty';
+
+(* values for 'o_flag' in open()... *)
+CONST O_RDONLY = $0000; (* open for read only *)
+ O_WRONLY = $0001; (* open for write only *)
+ O_RDWR = $0002; (* open for read and write *)
+ O_ACCMODE = $0003; (* AND with value to extract access flags *)
+ O_APPEND = $0010; (* writes done at end of file *)
+ O_CREAT = $0020; (* create new file *)
+ O_TRUNC = $0040; (* truncate existing file *)
+ O_EXCL = $0080; (* exclusive open *)
+ O_TEXT = $0100; (* text file--unsupported *)
+ O_BINARY = $0200; (* binary file *)
+ O_NDELAY = $0400; (* nonblocking flag *)
+ O_NOCTTY = $0800; (* currently unsupported *)
+ O_NONBLOCK = O_NDELAY;
+
+
+// File Utils
+FUNCTION _unlink (FileName : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'unlink';
+FUNCTION _rename (oldpath, newpath : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'rename';
+
+// Error
+TYPE _PLONGINT = ^LONGINT;
+FUNCTION __get_errno_ptr : _PLONGINT; CDECL; EXTERNAL Clib;
+
+// Memory
+FUNCTION _malloc (size : LONGINT) : POINTER; CDECL; EXTERNAL CLib NAME 'malloc';
+FUNCTION _realloc (p : POINTER; size : LONGINT) : POINTER; CDECL; EXTERNAL CLib NAME 'realloc';
+PROCEDURE _free (what : POINTER); CDECL; EXTERNAL CLib NAME 'free';
+FUNCTION _stackavail : CARDINAL; CDECL; EXTERNAL CLib NAME 'stackavail';
+
+// Debug
+PROCEDURE _EnterDebugger; CDECL; EXTERNAL Clib NAME 'EnterDebugger';
+
+// String
+FUNCTION _strlen (P : PCHAR) : LONGINT; CDECL; EXTERNAL Clib NAME 'strlen';
+
+// Time/Date
+TYPE NWTM = RECORD
+ tm_sec, tm_min, tm_hour,
+ tm_mday, tm_mon, tm_year,
+ tm_wday, tm_yday, tm_isdst : LONGINT;
+ END;
+ PNWTM = ^NWTM;
+FUNCTION _localtime (VAR time : time_t) : PNWTM; CDECL; EXTERNAL Clib NAME 'localtime';
+FUNCTION _time (tloc : POINTER) : LONGINT; CDECL; EXTERNAL Clib NAME 'time';
+PROCEDURE _ConvertTimeToDOS (time : time_t; VAR DosDate, DosTime : WORD); CDECL; EXTERNAL Clib NAME '_ConvertTimeToDOS';
+PROCEDURE _tzset; CDECL; EXTERNAL Clib NAME 'tzset';
+
+
+//-----------------------------------------------------------------------
+
+CONST NWDEFCONN_HANDLE = 0;
+
+TYPE NWCONN_HANDLE = LONGINT;
+ NWRCODE = LONGINT;
+ NWDateAndTime = PACKED RECORD
+ Year,Month,Day,
+ Hour,Minute,Second,DayOfWeek : BYTE;
+ END;
+
+PROCEDURE GetFileServerDateAndTime (VAR TimeBuf : NWDateAndTime); CDECL; EXTERNAL CLib NAME 'GetFileServerDateAndTime';
+FUNCTION SetFileServerDateAndTime(year:WORD; month:WORD; day:WORD; hour:WORD; minute:WORD;
+ second:WORD):longint;cdecl; EXTERNAL CLib Name 'SetFileServerDateAndTime';
+
+TYPE FILE_SERV_INFO = record
+ serverName : array[0..47] of char;
+ netwareVersion : BYTE;
+ netwareSubVersion : BYTE;
+ maxConnectionsSupported : WORD;
+ connectionsInUse : WORD;
+ maxVolumesSupported : WORD;
+ revisionLevel : BYTE;
+ SFTLevel : BYTE;
+ TTSLevel : BYTE;
+ peakConnectionsUsed : WORD;
+ accountingVersion : BYTE;
+ VAPversion : BYTE;
+ queingVersion : BYTE;
+ printServerVersion : BYTE;
+ virtualConsoleVersion : BYTE;
+ securityRestrictionLevel: BYTE;
+ internetBridgeSupport : BYTE;
+ reserved : array[0..59] of BYTE;
+ CLibMajorVersion : BYTE;
+ CLibMinorVersion : BYTE;
+ CLibRevision : BYTE;
+ end;
+ pFILE_SERV_INFO = ^FILE_SERV_INFO;
+
+FUNCTION GetServerInformation(returnSize:longint; serverInfo:pFILE_SERV_INFO):longint;cdecl; EXTERNAL CLib NAME 'GetServerInformation';
+
+// Directory
+TYPE NWDirEnt =
+ PACKED RECORD
+ d_attr : LONGINT;
+ d_time : WORD; {modification time}
+ d_date : WORD; {modification date}
+ d_size : LONGINT; {filesize}
+ d_ino : LONGINT; {serial number}
+ d_dev : LONGINT; {volume number}
+ d_cdatetime : time_t; {creation date and time}
+ d_adatetime : time_t; {last access - files only}
+ d_bdatetime : time_t; {last archive date and time}
+ d_uid : LONGINT; {owner id (object id) }
+ d_archivedID : LONGINT;
+ d_updatedID : LONGINT;
+ d_nameDOS : ARRAY [0..12] OF CHAR;
+ d_inheritedRightsMask : WORD;
+ d_originatingNameSpace: BYTE;
+ d_ddatetime : time_t; {deleted date time}
+ d_deletedID : LONGINT;
+ {---- new fields starting in v4.11 ----}
+ d_name : ARRAY [0..255] OF CHAR; { enty's namespace name }
+ END;
+ PNWDirEnt = ^NWDirEnt;
+
+ FUNCTION _opendir (pathname : PCHAR) : PNWDirEnt; CDECL; EXTERNAL CLib NAME 'opendir_411';
+ FUNCTION _closedir (dirH : PNWDirEnt) : LONGINT; CDECL; EXTERNAL CLib NAME 'closedir';
+ FUNCTION _readdir (dirH : PNWDirEnt) : PNWDirEnt; CDECL; EXTERNAL CLib NAME 'readdir';
+ FUNCTION _SetReaddirAttribute (dirH : PNWDirEnt; Attribute : LONGINT) : LONGINT; EXTERNAL CLib NAME 'SetReaddirAttribute';
+
+// Environment
+ FUNCTION _getenv (name : PCHAR) : PCHAR; CDECL; EXTERNAL CLib NAME 'getenv';
+
+// Volumes
+ FUNCTION _GetVolumeName (volumeNumber : LONGINT; volumeName : PCHAR) : LONGINT; CDECL; EXTERNAL CLib NAME 'GetVolumeName';
+ FUNCTION _GetVolumeNumber (volumeName : PCHAR; VAR volumeNumber : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'GetVolumeNumber';
+ FUNCTION _GetVolumeInfoWithNumber (VolumeNumber : BYTE;
+ VolumeName : PCHAR;
+ VAR TotalBlocks : WORD;
+ VAR SectorsPerBlock : WORD;
+ VAR availableBlocks : WORD;
+ VAR totalDirectorySlots : WORD;
+ VAR availableDirSlots : WORD;
+ VAR volumeisRemovable : WORD) : LONGINT; CDECL; EXTERNAL CLib NAME 'GetVolumeInfoWithNumber';
+ FUNCTION _GetNumberOfVolumes : LONGINT; CDECL; EXTERNAL CLib NAME 'GetNumberOfVolumes';
+
+// Screen/Keyboad
+PROCEDURE _CopyToScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL Clib NAME 'CopyToScreenMemory';
+PROCEDURE _CopyFromScreenMemory (Height, Width : WORD; Data : POINTER; x, y : WORD); CDECL; EXTERNAL CLib NAME 'CopyFromScreenMemory';
+FUNCTION _DisplayInputCursor : LONGINT; CDECL; EXTERNAL CLib NAME 'DisplayInputCursor';
+FUNCTION _HideInputCursor : LONGINT; CDECL; EXTERNAL CLib NAME 'HideInputCursor';
+FUNCTION _SetPositionOfInputCursor (row,col : WORD): LONGINT; CDECL; EXTERNAL Clib NAME 'SetPositionOfInputCursor';
+PROCEDURE _GotoXY (col, row : WORD); CDECL; EXTERNAL Clib NAME 'gotoxy';
+FUNCTION _GetSizeOfScreen (VAR height,width : WORD): LONGINT; CDECL; EXTERNAL CLib NAME 'GetSizeOfScreen';
+FUNCTION _IsColorMonitor : LONGINT; CDECL; EXTERNAL CLib NAME 'IsColorMonitor';
+PROCEDURE _RingTheBell; CDECL; EXTERNAL CLib NAME 'RingTheBell';
+FUNCTION _SetCursorShape (startline,endline : BYTE) : WORD; CDECL; EXTERNAL CLib NAME 'SetCursorShape';
+FUNCTION _GetCursorShape (VAR startline,endline : BYTE) : WORD; CDECL; EXTERNAL CLib NAME 'GetCursorShape';
+FUNCTION _wherex : WORD; CDECL; EXTERNAL CLib NAME 'wherex';
+FUNCTION _wherey : WORD; CDECL; EXTERNAL CLib NAME 'wherey';
+PROCEDURE _clrscr; CDECL; EXTERNAL CLib NAME 'clrscr';
+FUNCTION _kbhit : LONGINT; CDECL; EXTERNAL Clib NAME 'kbhit';
+FUNCTION _getch : CHAR; CDECL; EXTERNAL CLib NAME 'getch';
+PROCEDURE _delay (miliseconds : longint); CDECL; EXTERNAL Clib NAME 'delay';
+FUNCTION _SetCtrlCharCheckMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL CLib NAME 'SetCtrlCharCheckMode';
+FUNCTION _SetAutoScreenDestructionMode (Enabled : BOOLEAN) : BOOLEAN; CDECL; EXTERNAL CLib NAME 'SetAutoScreenDestructionMode';
+
+// Misc
+FUNCTION _memcpy (Dest, Src : POINTER; Len : LONGINT) : POINTER; CDECL; EXTERNAL Clib NAME 'memcpy';
+
+FUNCTION _OpenLocalSemaphore (InitialValue : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'OpenLocalSemaphore';
+FUNCTION _WaitOnLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL Clib NAME 'WaitOnLocalSemaphore';
+FUNCTION _SignalLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'SignalLocalSemaphore';
+FUNCTION _CloseLocalSemaphore (semaphoreHandle : LONGINT) : LONGINT; CDECL; EXTERNAL CLib NAME 'CloseLocalSemaphore';
+FUNCTION _EnterCritSec : LONGINT; CDecl; EXTERNAL CLib NAME 'EnterCritSec';
+FUNCTION _ExitCritSec : LONGINT; CDecl; EXTERNAL CLib NAME 'ExitCritSec';
+
+
+FUNCTION _SetThreadGroupID (id : longint) : longint; CDecl; EXTERNAL CLib NAME 'SetThreadGroupID';
+FUNCTION _GetThreadGroupID : longint; CDecl; EXTERNAL CLib NAME 'GetThreadGroupID';
+
+CONST _SIGTERM = 6;
+
+PROCEDURE _Signal (Sig : longint; SigFunc : pointer); CDECL; EXTERNAL Clib NAME 'signal';
+
+FUNCTION _SetCurrentNameSpace (newNameSpace : BYTE) : BYTE; CDECL; EXTERNAL Clib NAME 'SetCurrentNameSpace';
+FUNCTION _SetTargetNameSpace (newNameSpace : BYTE) : BYTE; CDECL; EXTERNAL Clib NAME 'SetTargetNameSpace';
+
+CONST
+ NW_NS_DOS = 0;
+ NW_NS_MAC = 1;
+ NW_NS_NFS = 2;
+ NW_NS_FTAM = 3;
+ NW_NS_LONG = 4;
+
+function _NWAddSearchPathAtEnd (searchPath : pchar; var number : longint) : longint; cdecl; external Clib name 'NWAddSearchPathAtEnd';
+function _NWDeleteSearchPath (searchPathNumber : longint) : longint; cdecl; external Clib name 'NWDeleteSearchPath';
+function _NWInsertSearchPath (searchPathNumber : longint; path : pchar) : longint; cdecl; external Clib name 'NWInsertSearchPath';
+function _NWGetSearchPathElement (searchPathNumber : longint; var isDOSSearchPath : longint; searchPath : pchar) : longint; cdecl; external Clib name 'NWGetSearchPathElement';
+
+
+// values for __mode used with spawnxx()
+CONST
+ P_WAIT = 0;
+ P_NOWAIT = 1;
+ P_OVERLAY = 2;
+ P_NOWAITO = 4;
+ P_SPAWN_IN_CURRENT_DOMAIN = 8;
+
+
+//function spawnlp(mode:longint; path:Pchar; arg0:Pchar; args:array of const):longint;cdecl;external CLib name 'spawnlp';
+function spawnlp(mode:longint; path:Pchar; arg0:Pchar):longint;cdecl;external Clib name 'spawnlp';
+function spawnvp(mode:longint; path:Pchar; argv:PPchar):longint;cdecl;external Clib name 'spawnvp';
+
+
+{
+ $Log: nwsys.inc,v $
+ Revision 1.14 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netware/prelude.as b/rtl/netware/prelude.as
new file mode 100644
index 0000000000..254dc257b2
--- /dev/null
+++ b/rtl/netware/prelude.as
@@ -0,0 +1,133 @@
+#
+# $Id: prelude.as,v 1.2 2003/03/25 18:17:54 armin Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2002 by the Free Pascal development team
+# Copyright (c) 2002 Armin Diehl
+#
+# This is the (prelude-like) startup code for netware before 4.11
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+#**********************************************************************
+
+ .file "nwpre.as"
+ .text
+
+#
+# This is the main program (not loader) Entry-Point that will be called by netware
+# it sets up the argc and argv and calls _nlm_main (in system.pp)
+# This version uses the old _SetupArgv and not the newer _SetupArvV_411
+#
+ .globl _pas_Start_
+_pasStart_:
+ pushl $_nlm_main
+ call _SetupArgv
+ addl $4,%esp
+ ret
+# this is a hack to avoid that FPC_NW_CHECKFUNCTION will be
+# eleminated by the linker (with smartlinking)
+ call FPC_NW_CHECKFUNCTION
+
+
+#
+# this will be called by the loader, we pass the address of _pasStart_ and
+# _NLMID (needed by clib) and netware is doing the work
+#
+ .globl _Prelude
+_Prelude:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %edi
+ pushl %esi
+ pushl %ebx
+ movl 0x14(%ebp),%edi
+ movl 0x18(%ebp),%esi
+ movl %esi, __uninitializedDataSize
+ movl 0x1c(%ebp),%ebx
+ movl 0x20(%ebp),%ecx
+ movl 0x28(%ebp),%eax
+ pushl $_pasStart_
+ pushl $_NLMID
+ pushl %eax
+ movl 0x24(%ebp),%edx
+ pushl %edx
+ pushl %ecx
+ pushl %ebx
+ pushl %esi
+ pushl %edi
+ movl 0x10(%ebp),%edx
+ pushl %edx
+ movl 0xc(%ebp),%edx
+ pushl %edx
+ movl 0x8(%ebp),%edx
+ pushl %edx
+ call _StartNLM
+ test %eax,%eax
+ jne x1
+ xorl %eax,%eax # dont know why this is needed ?
+x1:
+ lea 0xfffffff4(%ebp),%esp
+ popl %ebx
+ popl %esi
+ popl %edi
+ movl %ebp,%esp
+ popl %ebp
+ ret
+
+
+#
+# the global stop-function
+#
+ .globl _Stop
+_Stop:
+ pushl $0x5 # TERMINATE_BY_UNLOAD=0, TERMINATE_BY_EXTERNAL_THREAD=0
+ pushl $0x0
+ movl _NLMID,%edx
+ pushl %edx
+ call _TerminateNLM
+ addl $0x0c,%esp
+ ret
+
+
+.data
+# argc is defined in the novell prelude, i assume it is not needed
+#_argc:
+# .long 0
+
+_NLMID:
+ .long 0
+
+.text
+.globl __getTextStart
+__getTextStart:
+ movl $.text,%eax
+ ret
+
+.text
+.globl __getDataStart
+__getDataStart:
+ movl $.data,%eax
+ ret
+
+.text
+.globl __getBssStart
+__getBssStart:
+ movl $.bss,%eax
+ ret
+
+.data
+ __uninitializedDataSize: .long
+
+
+
+.text
+.globl __getUninitializedDataSize
+__getUninitializedDataSize:
+ movl __uninitializedDataSize, %eax
+ ret
+
diff --git a/rtl/netware/qos.inc b/rtl/netware/qos.inc
new file mode 100644
index 0000000000..aaba1991d8
--- /dev/null
+++ b/rtl/netware/qos.inc
@@ -0,0 +1,293 @@
+{
+ $Id: qos.inc,v 1.2 2002/09/07 16:01:21 peter Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the declarations for the WinSock2
+ Socket Library for Netware and Win32
+
+ Copyright (c) 1999-2002 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ { This module defines the Quality of Service structures and types used
+ by Winsock applications. }
+
+ {
+ Definitions for valued-based Service Type for each direction of data flow.
+ }
+
+ type
+
+ SERVICETYPE = u_long;
+ { No data in this direction }
+
+ const
+ SERVICETYPE_NOTRAFFIC = $00000000;
+ { Best Effort }
+ SERVICETYPE_BESTEFFORT = $00000001;
+ { Controlled Load }
+ SERVICETYPE_CONTROLLEDLOAD = $00000002;
+ { Guaranteed }
+ SERVICETYPE_GUARANTEED = $00000003;
+ { Used to notify
+ change to user }
+ SERVICETYPE_NETWORK_UNAVAILABLE = $00000004;
+ { corresponds to
+ "General Parameters"
+ defined by IntServ }
+ SERVICETYPE_GENERAL_INFORMATION = $00000005;
+ { used to indicate
+ that the flow spec
+ contains no change
+ from any previous
+ one }
+ SERVICETYPE_NOCHANGE = $00000006;
+ { Non-Conforming Traffic }
+ SERVICETYPE_NONCONFORMING = $00000009;
+ { Custom ServiceType 1 }
+ SERVICETYPE_CUSTOM1 = $0000000A;
+ { Custom ServiceType 2 }
+ SERVICETYPE_CUSTOM2 = $0000000B;
+ { Custom ServiceType 3 }
+ SERVICETYPE_CUSTOM3 = $0000000C;
+ { Custom ServiceType 4 }
+ SERVICETYPE_CUSTOM4 = $0000000D;
+ {
+ Definitions for bitmap-based Service Type for each direction of data flow.
+ }
+ SERVICE_BESTEFFORT = $80020000;
+ SERVICE_CONTROLLEDLOAD = $80040000;
+ SERVICE_GUARANTEED = $80080000;
+ SERVICE_CUSTOM1 = $80100000;
+ SERVICE_CUSTOM2 = $80200000;
+ SERVICE_CUSTOM3 = $80400000;
+ SERVICE_CUSTOM4 = $80800000;
+ {
+ Number of available Service Types.
+ }
+ NUM_SERVICETYPES = 8;
+ {
+ to turn on immediate traffic control, OR ( | ) this flag with the
+ ServiceType field in the FLOWSPEC
+ }
+ { #define SERVICE_IMMEDIATE_TRAFFIC_CONTROL 0x80000000 // obsolete }
+ SERVICE_NO_TRAFFIC_CONTROL = $81000000;
+ {
+ this flag can be used with the immediate traffic control flag above to
+ prevent any rsvp signaling messages from being sent. Local traffic
+ control will be invoked, but no RSVP Path messages will be sent.This flag
+ can also be used in conjunction with a receiving flowspec to suppress
+ the automatic generation of a Reserve message. The application would
+ receive notification that a Path message had arrived and would then need
+ to alter the QOS by issuing WSAIoctl( SIO_SET_QOS ), to unset this flag
+ and thereby cause Reserve messages to go out.
+ }
+ SERVICE_NO_QOS_SIGNALING = $40000000;
+ { rsvp status code }
+ STATUS_QOS_RELEASED = $10101010;
+ {
+ Flow Specifications for each direction of data flow.
+ }
+ { In Bytes/sec }
+ { In Bytes }
+ { In Bytes/sec }
+ { In microseconds }
+ { In microseconds }
+ { In Bytes }
+ { In Bytes }
+
+ type
+
+ Tflowspec = record
+ TokenRate : u_long;
+ TokenBucketSize : u_long;
+ PeakBandwidth : u_long;
+ Latency : u_long;
+ DelayVariation : u_long;
+ ServiceType : SERVICETYPE;
+ MaxSduSize : u_long;
+ MinimumPolicedSize : u_long;
+ end;
+ PFLOWSPEC = ^Tflowspec;
+ LPFLOWSPEC = ^Tflowspec;
+ {
+ this value can be used in the FLOWSPEC structure to instruct the Rsvp Service
+ provider to derive the appropriate default value for the parameter. Note
+ that not all values in the FLOWSPEC structure can be defaults. In the
+ ReceivingFlowspec, all parameters can be defaulted except the ServiceType.
+ In the SendingFlowspec, the MaxSduSize and MinimumPolicedSize can be
+ defaulted. Other defaults may be possible. Refer to the appropriate
+ documentation.
+ }
+
+ const
+ QOS_NOT_SPECIFIED = $FFFFFFFF;
+ NULL_QOS_TYPE = $FFFFFFFD;
+ {
+ define a value that can be used for the PeakBandwidth, which will map into
+ positive infinity when the FLOWSPEC is converted into IntServ floating point
+ format. We can't use (-1) because that value was previously defined to mean
+ "select the default".
+ }
+ POSITIVE_INFINITY_RATE = $FFFFFFFE;
+ {
+ the provider specific structure can have a number of objects in it.
+ Each next structure in the
+ ProviderSpecific will be the QOS_OBJECT_HDR struct that prefaces the actual
+ data with a type and length for that object. This QOS_OBJECT struct can
+ repeat several times if there are several objects. This list of objects
+ terminates either when the buffer length has been reached ( WSABUF ) or
+ an object of type QOS_END_OF_LIST is encountered.
+ }
+ { the length of object buffer INCLUDING
+ this header }
+
+ type
+
+ TQOS_OBJECT_HDR = record
+ ObjectType : u_long;
+ ObjectLength : u_long;
+ end;
+ LPQOS_OBJECT_HDR = ^TQOS_OBJECT_HDR;
+ PQOS_OBJECT_HDR = ^TQOS_OBJECT_HDR;
+ {
+ general QOS objects start at this offset from the base and have a range
+ of 1000
+ }
+
+ const
+ QOS_GENERAL_ID_BASE = 2000;
+ QOS_OBJECT_PRIORITY = $00000000 + QOS_GENERAL_ID_BASE;
+ { QOS_PRIORITY structure passed }
+ QOS_OBJECT_END_OF_LIST = $00000001 + QOS_GENERAL_ID_BASE;
+ { QOS_End_of_list structure passed }
+ QOS_OBJECT_SD_MODE = $00000002 + QOS_GENERAL_ID_BASE;
+ { QOS_ShapeDiscard structure passed }
+ QOS_OBJECT_TRAFFIC_CLASS = $00000003 + QOS_GENERAL_ID_BASE;
+ { QOS_Traffic class structure passed }
+ QOS_OBJECT_DESTADDR = $00000004 + QOS_GENERAL_ID_BASE;
+ { QOS_DestAddr structure }
+ QOS_OBJECT_SHAPER_QUEUE_DROP_MODE = $00000005 + QOS_GENERAL_ID_BASE;
+ { QOS_ShaperQueueDropMode structure }
+ QOS_OBJECT_SHAPER_QUEUE_LIMIT = $00000006 + QOS_GENERAL_ID_BASE;
+ { QOS_ShaperQueueLimit structure }
+ {
+ This structure defines the absolute priorty of the flow. Priorities in the
+ range of 0-7 are currently defined. Receive Priority is not currently used,
+ but may at some point in the future.
+ }
+ { this gets mapped to layer 2 priority. }
+ { there are none currently defined. }
+ { this could be used to decide who
+ gets forwarded up the stack first
+ - not used now }
+
+ type
+
+ TQOS_PRIORITY = record
+ ObjectHdr : TQOS_OBJECT_HDR;
+ SendPriority : u_char;
+ SendFlags : u_char;
+ ReceivePriority : u_char;
+ Unused : u_char;
+ end;
+ LPQOS_PRIORITY = ^TQOS_PRIORITY;
+ PQOS_PRIORITY = ^TQOS_PRIORITY;
+ {
+ This structure is used to define the behaviour that the traffic
+ control packet shaper will apply to the flow.
+
+ PS_NONCONF_BORROW - the flow will receive resources remaining
+ after all higher priority flows have been serviced. If a
+ TokenRate is specified, packets may be non-conforming and
+ will be demoted to less than best-effort priority.
+
+ PS_NONCONF_SHAPE - TokenRate must be specified. Non-conforming
+ packets will be retianed in the packet shaper until they become
+ conforming.
+
+ PS_NONCONF_DISCARD - TokenRate must be specified. Non-conforming
+ packets will be discarded.
+
+ }
+
+ TQOS_SD_MODE = record
+ ObjectHdr : TQOS_OBJECT_HDR;
+ ShapeDiscardMode : u_long;
+ end;
+ LPQOS_SD_MODE = ^TQOS_SD_MODE;
+ PQOS_SD_MODE = ^TQOS_SD_MODE;
+
+ const
+ TC_NONCONF_BORROW = 0;
+ TC_NONCONF_SHAPE = 1;
+ TC_NONCONF_DISCARD = 2;
+ TC_NONCONF_BORROW_PLUS = 3;
+ {
+ This structure may carry an 802.1 TrafficClass parameter which
+ has been provided to the host by a layer 2 network, for example,
+ in an 802.1 extended RSVP RESV message. If this object is obtained
+ from the network, hosts will stamp the MAC headers of corresponding
+ transmitted packets, with the value in the object. Otherwise, hosts
+ may select a value based on the standard Intserv mapping of
+ ServiceType to 802.1 TrafficClass.
+
+ }
+
+ type
+
+ TQOS_TRAFFIC_CLASS = record
+ ObjectHdr : TQOS_OBJECT_HDR;
+ TrafficClass : u_long;
+ end;
+ LPQOS_TRAFFIC_CLASS = ^TQOS_TRAFFIC_CLASS;
+ PQOS_TRAFFIC_CLASS = ^TQOS_TRAFFIC_CLASS;
+ {
+ This structure allows overriding of the default schema used to drop
+ packets when a flow's shaper queue limit is reached.
+
+ DropMethod -
+ QOS_SHAPER_DROP_FROM_HEAD - Drop packets from
+ the head of the queue until the new packet can be
+ accepted into the shaper under the current limit. This
+ behavior is the default.
+ QOS_SHAPER_DROP_INCOMING - Drop the incoming,
+ limit-offending packet.
+
+ }
+
+ TQOS_SHAPER_QUEUE_LIMIT_DROP_MODE = record
+ ObjectHdr : TQOS_OBJECT_HDR;
+ DropMode : u_long;
+ end;
+ LPQOS_SHAPER_QUEUE_LIMIT_DROP_MODE = ^TQOS_SHAPER_QUEUE_LIMIT_DROP_MODE;
+ PQOS_SHAPER_QUEUE_LIMIT_DROP_MODE = ^TQOS_SHAPER_QUEUE_LIMIT_DROP_MODE;
+
+ const
+ QOS_SHAPER_DROP_INCOMING = 0;
+ QOS_SHAPER_DROP_FROM_HEAD = 1;
+
+ { This structure allows the default per-flow limit on the shaper queue
+ size to be overridden.
+
+ QueueSizeLimit - Limit, in bytes, of the size of the shaper queue }
+
+ type
+
+ TQOS_SHAPER_QUEUE_LIMIT = record
+ ObjectHdr : TQOS_OBJECT_HDR;
+ QueueSizeLimit : u_long;
+ end;
+ LPQOS_SHAPER_QUEUE_LIMIT = ^TQOS_SHAPER_QUEUE_LIMIT;
+ PQOS_SHAPER_QUEUE_LIMIT = ^TQOS_SHAPER_QUEUE_LIMIT;
+
+{
+ $Log:
+
+}
diff --git a/rtl/netware/requestr.imp b/rtl/netware/requestr.imp
new file mode 100644
index 0000000000..14b1dcc4af
--- /dev/null
+++ b/rtl/netware/requestr.imp
@@ -0,0 +1,2 @@
+ RequestrGlobals
+
diff --git a/rtl/netware/sockets.pp b/rtl/netware/sockets.pp
new file mode 100644
index 0000000000..ff3bbafe85
--- /dev/null
+++ b/rtl/netware/sockets.pp
@@ -0,0 +1,400 @@
+{
+ $Id: sockets.pp,v 1.8 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+unit Sockets;
+
+Interface
+
+{$macro on}
+{$define maybelibc:=}
+
+{$R-}
+
+Uses
+ winsock;
+
+Type
+ cushort=word;
+ cuint16=word;
+ cuint32=cardinal;
+ size_t =cuint32;
+ ssize_t=cuint16;
+ cint =longint;
+ pcint =^cint;
+ tsocklen=cint;
+ psocklen=^tsocklen;
+
+
+ Const
+ AF_MAX = WinSock.AF_MAX;
+ PF_MAX = AF_MAX;
+
+{$i socketsh.inc}
+
+Implementation
+
+{ Include filerec and textrec structures }
+{$i filerec.inc}
+{$i textrec.inc}
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+
+
+//function fprecvmsg (s:cint; msg: pmsghdr; flags:cint):ssize_t;
+//function fpsendmsg (s:cint; hdr: pmsghdr; flags:cint):ssize;
+
+//function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+ fpSocket:=WinSock.Socket(Domain,xtype,ProtoCol);
+ if fpSocket<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpSend:=WinSock.Send(S,msg,len,flags);
+ if fpSend<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ // Dubious construct, this should be checked. (IPV6 fails ?)
+ fpSendTo:=WinSock.SendTo(S,msg,Len,Flags,Winsock.TSockAddr(tox^),toLen);
+ if fpSendTo<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t;
+begin
+ fpRecv:=WinSock.Recv(S,Buf,Len,Flags);
+ if fpRecv<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+
+begin
+fpRecvFrom:=WinSock.RecvFrom(S,Buf,Len,Flags,Winsock.TSockAddr(from^),FromLen^);
+ if fpRecvFrom<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+
+begin
+ fpConnect:=WinSock.Connect(S,WinSock.TSockAddr(name^),nameLen);
+ if fpConnect<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpShutDown:=WinSock.ShutDown(S,How);
+ if fpShutDown<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ socket:=fpsocket(Domain,sockettype,protocol);
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+
+begin
+ send:=fpsend(sock,@buf,buflen,flags);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+
+begin
+ sendto:=fpsendto(sock,@buf,buflen,flags,@addr,addrlen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=fpRecv(Sock,@Buf,BufLen,Flags);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; var AddrLen : longint) : longint;
+begin
+ RecvFrom:=fpRecvFrom(Sock,@Buf,BufLen,Flags,@Addr,@AddrLen);
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+
+begin
+ fpbind:=WinSock.Bind(S,WinSock.PSockAddr(Addrx),AddrLen);
+ if fpbind<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+
+begin
+ fplisten:=WinSock.Listen(S,backlog);
+ if fplisten<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+ fpAccept:=WinSock.Accept(S,WinSock.PSockAddr(Addrx),plongint(AddrLen));
+ if fpAccept<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+
+begin
+ fpGetSockName:=WinSock.GetSockName(S,WinSock.TSockAddr(name^),nameLen^);
+ if fpGetSockName<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetPeerName:=WinSock.GetPeerName(S,WinSock.TSockAddr(name^),NameLen^);
+ if fpGetPeerName<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpGetSockOpt:=WinSock.GetSockOpt(S,Level,OptName,OptVal,OptLen^);
+ if fpGetSockOpt<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
+
+begin
+ fpSetSockOpt:=WinSock.SetSockOpt(S,Level,OptName,OptVal,OptLen);
+ if fpSetSockOpt<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+ fpSocketPair := -1;
+end;
+
+Function CloseSocket(Sock:Longint):Longint;
+var i : longint;
+begin
+ i := Winsock.CloseSocket (Sock);
+ if i <> 0 then
+ begin
+ SocketError:=WSAGetLastError;
+ CloseSocket := i;
+ end else
+ begin
+ CloseSocket := 0;
+ SocketError := 0;
+ end;
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+
+begin
+ bind:=fpBind(Sock,@Addr,AddrLen)=0;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+
+begin
+ Listen:=fplisten(Sock,MaxConnect)=0;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+
+begin
+ Accept:=FPAccept(sock,@addr,@addrlen);
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+
+begin
+ shutdown:=fpshutdown(sock,how);
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):Boolean;
+
+begin
+ connect:=fpconnect(sock,@addr,addrlen)=0;
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=fpGetSockName(sock,@addr,@addrlen);
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=fpGetPeerName(Sock,@addr,@addrlen);
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=fpGetSockOpt(sock,level,optname,@optval,@optlen);
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+
+begin
+ SetSocketOptions:=fpsetsockopt(sock,level,optname,@optval,optlen);
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ // SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+ SocketPair := -1;
+end;
+
+
+{$ifdef unix}
+{ mimic the linux fpWrite/fpRead calls for the file/text socket wrapper }
+function fpWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fpWrite := dword(WinSock.send(handle, bufptr, size, 0));
+ if fpWrite = dword(SOCKET_ERROR) then
+ begin
+ SocketError := WSAGetLastError;
+ fpWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fpRead(handle : longint;var bufptr;size : dword) : dword;
+ var
+ d : dword;
+
+ begin
+ if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+ begin
+ SocketError:=WSAGetLastError;
+ fpRead:=0;
+ exit;
+ end;
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fpRead := dword(WinSock.recv(handle, bufptr, size, 0));
+ if fpRead = dword(SOCKET_ERROR) then
+ begin
+ SocketError:= WSAGetLastError;
+ fpRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+ end;
+{$else}
+{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
+function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fdWrite := dword(WinSock.send(handle, bufptr, size, 0));
+ if fdWrite = dword(SOCKET_ERROR) then
+ begin
+ SocketError := WSAGetLastError;
+ fdWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fdRead(handle : longint;var bufptr;size : dword) : dword;
+ var
+ d : dword;
+
+ begin
+ if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+ begin
+ SocketError:=WSAGetLastError;
+ fdRead:=0;
+ exit;
+ end;
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fdRead := dword(WinSock.recv(handle, bufptr, size, 0));
+ if fdRead = dword(SOCKET_ERROR) then
+ begin
+ SocketError:= WSAGetLastError;
+ fdRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+ end;
+{$endif}
+
+{$i sockets.inc}
+
+{ winsocket stack needs an init. and cleanup code }
+var
+ wsadata : twsadata;
+
+initialization
+ WSAStartUp($2,wsadata);
+finalization
+ WSACleanUp;
+end.
+{
+ $Log: sockets.pp,v $
+ Revision 1.8 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/socklib.imp b/rtl/netware/socklib.imp
new file mode 100644
index 0000000000..b46e3b4797
--- /dev/null
+++ b/rtl/netware/socklib.imp
@@ -0,0 +1,48 @@
+#
+# Symbols exported from the TCP/IP NLM
+#
+# $Header: /FPC/CVS/fpc/rtl/netware/socklib.imp,v 1.1 2004/08/13 19:57:44 armin Exp $
+#
+
+# SOCKLIB entry points
+ htonl,
+ htons,
+ ntohl,
+ ntohs,
+ NWgethostent,
+ NWgethostbyname,
+ NWgethostbyaddr,
+ NWsethostent,
+ NWendhostent,
+ NetDBgethostent,
+ NetDBgethostbyname,
+ NetDBgethostbyaddr,
+ NetDBsethostent,
+ NetDBendhostent,
+ NetDBgethostname,
+ NWgetnetent,
+ NWgetnetbyname,
+ NWgetnetbyaddr,
+ NWsetnetent,
+ NWendnetent,
+ NWgetprotoent,
+ NWgetprotobyname,
+ NWgetprotobynumber,
+ NWsetprotoent,
+ NWendprotoent,
+ NWgetservent,
+ NWgetservbyname,
+ NWgetservbyport,
+ NWsetservent,
+ NWendservent,
+ inet_addr,
+ inet_network,
+ NWinet_ntoa,
+ inet_makeaddr,
+ inet_lnaof,
+ inet_netof,
+ inet_netent,
+ inet_hostent,
+ gethostid,
+ gethostname
+
diff --git a/rtl/netware/streams.imp b/rtl/netware/streams.imp
new file mode 100644
index 0000000000..11a7541b53
--- /dev/null
+++ b/rtl/netware/streams.imp
@@ -0,0 +1,135 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ StreamAlloc,
+ StreamCancel,
+ StreamClose,
+ StreamDecrementInuseSemaphore,
+ StreamDelay,
+ StreamFree,
+ StreamGetmsg,
+ StreamIncrementInuseSemaphore,
+ StreamOpenRTag,
+ StreamPoll,
+ StreamPutmsg,
+ StreamRead,
+ StreamRealloc,
+ StreamTime,
+ StreamVersion,
+ StreamWrite,
+ StreamIoctl,
+ MaxMessageSize,
+ dev_load,
+ dev_register,
+ dev_unregister,
+ dev_unload,
+ mod_load,
+ mod_register,
+ mod_unregister,
+ mod_unload,
+ nws_timeout,
+ nws_untimeout,
+ odi_deregister,
+ odi_register,
+ __putnext,
+ adjmsg,
+ allocb,
+ allocbi,
+ backq,
+ bcopy,
+ bufcall,
+ bzero,
+ canput,
+ cmn_err,
+ copyb,
+ copymsg,
+ dupb,
+ dupmsg,
+ flushq,
+ freeb,
+ freemsg,
+ getq,
+ initb,
+ insq,
+ linkb,
+ msgdsize,
+ pullupmsg,
+ putbq,
+ putctl,
+ putctl1,
+ putq,
+ qenable,
+ qreply,
+ qsize,
+ rmvb,
+ rmvq,
+ splstr,
+ spl0,
+ spl1,
+ spl2,
+ spl3,
+ spl4,
+ spl5,
+ spl6,
+ spl7,
+ splx,
+ strlog,
+ testb,
+ timeout,
+ u,
+ unlinkb,
+ untimeout,
+ unbufcall,
+ vtop,
+ mi_addr_scanf,
+ mi_allocq,
+ mi_bufcall,
+ mi_bzero,
+ mi_close_comm,
+ mi_free,
+ mi_gq_head,
+ mi_gq_in,
+ mi_gq_init,
+ mi_gq_out,
+ mi_link_device,
+ mi_mpprintf,
+ mi_nd_get,
+ mi_nd_set,
+ mi_next_ptr,
+ mi_open_comm,
+ mi_printf,
+ mi_reallocb,
+ mi_set_sth_wroff,
+ mi_sprintf,
+ mi_strcmp,
+ mi_strlen,
+ mi_strlog,
+ mi_strtol,
+ mi_timer,
+ mi_timer_alloc,
+ mi_timer_free,
+ mi_timer_valid,
+ mi_tpi_ack_alloc,
+ mi_tpi_conn_con,
+ mi_tpi_conn_ind,
+ mi_tpi_conn_req,
+ mi_tpi_data_ind,
+ mi_tpi_data_req,
+ mi_tpi_discon_ind,
+ mi_tpi_discon_req,
+ mi_tpi_err_ack_alloc,
+ mi_tpi_exdata_ind,
+ mi_tpi_exdata_req,
+ mi_tpi_ioctl_info_req,
+ mi_tpi_ok_ack_alloc,
+ mi_tpi_ordrel_ind,
+ mi_tpi_ordrel_req,
+ mi_tpi_uderror_ind,
+ mi_tpi_unitdata_ind,
+ mi_weld,
+ mi_zalloc,
+ nd_free,
+ nd_get_long,
+ nd_getset,
+ nd_load,
+ nd_set_long
+
diff --git a/rtl/netware/sysdir.inc b/rtl/netware/sysdir.inc
new file mode 100644
index 0000000000..93531a4e6a
--- /dev/null
+++ b/rtl/netware/sysdir.inc
@@ -0,0 +1,101 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+ Res: LONGINT;
+BEGIN
+ S2 := S;
+ IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+ S2 := S2 + #0;
+ Res := _mkdir (@S2[1]);
+ IF Res = 0 THEN
+ InOutRes:=0
+ ELSE
+ SetFileError (Res);
+END;
+
+procedure rmdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+ Res: LONGINT;
+BEGIN
+ S2 := S;
+ IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+ S2 := S2 + #0;
+ Res := _rmdir (@S2[1]);
+ IF Res = 0 THEN
+ InOutRes:=0
+ ELSE
+ SetFileError (Res);
+end;
+
+procedure chdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+ Res: LONGINT;
+begin
+ S2 := S;
+ IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+ S2 := S2 + #0;
+ Res := _chdir (@S2[1]);
+ IF Res = 0 THEN
+ InOutRes:=0
+ ELSE
+ SetFileError (Res);
+end;
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+VAR P : ARRAY [0..255] OF CHAR;
+ i : LONGINT;
+begin
+ P[0] := #0;
+ _getcwd (@P, SIZEOF (P));
+ i := _strlen (P);
+ if i > 0 then
+ begin
+ Move (P, dir[1], i);
+ BYTE(dir[0]) := i;
+ For i := 1 to length (dir) do
+ if dir[i] = '\' then dir [i] := '/';
+ // fix / after volume, the compiler needs that
+ // normaly root of a volumes is SERVERNAME/SYS:, change that
+ // to SERVERNAME/SYS:/
+ i := pos (':',dir);
+ if (i > 0) then
+ if i = Length (dir) then dir := dir + '/' else
+ if dir [i+1] <> '/' then insert ('/',dir,i+1);
+ END ELSE
+ InOutRes := 1;
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/netware/sysfile.inc b/rtl/netware/sysfile.inc
new file mode 100644
index 0000000000..8b9d13e4da
--- /dev/null
+++ b/rtl/netware/sysfile.inc
@@ -0,0 +1,290 @@
+{
+ $Id: sysfile.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ Low level File Routines
+ All these functions can set InOutRes on errors
+ ****************************************************************************}
+
+
+PROCEDURE NW2PASErr (Err : LONGINT);
+BEGIN
+ if Err = 0 then { Else it will go through all the cases }
+ exit;
+ case Err of
+ Sys_ENFILE,
+ Sys_EMFILE : Inoutres:=4;
+ Sys_ENOENT : Inoutres:=2;
+ Sys_EBADF : Inoutres:=6;
+ Sys_ENOMEM,
+ Sys_EFAULT : Inoutres:=217;
+ Sys_EINVAL : Inoutres:=218;
+ Sys_EPIPE,
+ Sys_EINTR,
+ Sys_EIO,
+ Sys_EAGAIN,
+ Sys_ENOSPC : Inoutres:=101;
+ Sys_ENAMETOOLONG,
+ Sys_ELOOP,
+ Sys_ENOTDIR : Inoutres:=3;
+ Sys_EROFS,
+ Sys_EEXIST,
+ Sys_EACCES : Inoutres:=5;
+ Sys_EBUSY : Inoutres:=162;
+ end;
+END;
+
+FUNCTION errno : LONGINT;
+BEGIN
+ errno := __get_errno_ptr^;
+END;
+
+PROCEDURE Errno2Inoutres;
+BEGIN
+ NW2PASErr (errno);
+END;
+
+PROCEDURE SetFileError (VAR Err : LONGINT);
+BEGIN
+ IF Err >= 0 THEN
+ InOutRes := 0
+ ELSE
+ BEGIN
+ Err := errno;
+ NW2PASErr (Err);
+ Err := 0;
+ END;
+END;
+
+{ close a file from the handle value }
+procedure do_close(handle : thandle);
+VAR res : LONGINT;
+begin
+ res := _close (handle);
+ IF res <> 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+end;
+
+procedure do_erase(p : pchar);
+VAR res : LONGINT;
+begin
+ res := _unlink (p);
+ IF Res < 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+VAR res : LONGINT;
+begin
+ res := _rename (p1,p2);
+ IF Res < 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0
+end;
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+VAR res : LONGINT;
+begin
+ res := _write (h,addr,len);
+ IF res > 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+ do_write := res;
+end;
+
+function do_read(h:thandle;addr:pointer;len : longint) : longint;
+VAR res : LONGINT;
+begin
+ res := _read (h,addr,len);
+ IF res > 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+ do_read := res;
+end;
+
+
+function do_filepos(handle : thandle) : longint;
+VAR res : LONGINT;
+begin
+ InOutRes:=1;
+ res := _tell (handle);
+ IF res < 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+ do_filepos := res;
+end;
+
+CONST SEEK_SET = 0; // Seek from beginning of file.
+ SEEK_CUR = 1; // Seek from current position.
+ SEEK_END = 2; // Seek from end of file.
+
+
+procedure do_seek(handle:thandle;pos : longint);
+VAR res : LONGINT;
+begin
+ res := _lseek (handle,pos, SEEK_SET);
+ IF res >= 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+end;
+
+function do_seekend(handle:thandle):longint;
+VAR res : LONGINT;
+begin
+ res := _lseek (handle,0, SEEK_END);
+ IF res >= 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+ do_seekend := res;
+end;
+
+
+function do_filesize(handle : thandle) : longint;
+VAR res : LONGINT;
+begin
+ res := _filelength (handle);
+ IF res < 0 THEN
+ BEGIN
+ SetFileError (Res);
+ do_filesize := -1;
+ END ELSE
+ BEGIN
+ InOutRes := 0;
+ do_filesize := res;
+ END;
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;pos:longint);
+VAR res : LONGINT;
+begin
+ res := _chsize (handle,pos);
+ IF res <> 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+end;
+
+// mostly stolen from syslinux
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $10) the file will be append
+ when (flags and $100) the file will be truncate/rewritten
+ when (flags and $1000) there is no check for close (needed for textfiles)
+}
+var
+ oflags : longint;
+Begin
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case FileRec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file Handle }
+ FileRec(f).Handle:=UnusedHandle;
+
+{ We do the conversion of filemodes here, concentrated on 1 place }
+ case (flags and 3) of
+ 0 : begin
+ oflags := O_RDONLY;
+ filerec(f).mode := fminput;
+ end;
+ 1 : begin
+ oflags := O_WRONLY;
+ filerec(f).mode := fmoutput;
+ end;
+ 2 : begin
+ oflags := O_RDWR;
+ filerec(f).mode := fminout;
+ end;
+ end;
+ if (flags and $1000)=$1000 then
+ oflags:=oflags or (O_CREAT or O_TRUNC)
+ else
+ if (flags and $100)=$100 then
+ oflags:=oflags or (O_APPEND);
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+{ real open call }
+ FileRec(f).Handle := _open(p,oflags,438);
+ //WriteLn ('_open (',p,') returned ',ErrNo, 'Handle: ',FileRec(f).Handle);
+ // errno does not seem to be set on succsess ??
+ IF FileRec(f).Handle < 0 THEN
+ if (ErrNo=Sys_EROFS) and ((OFlags and O_RDWR)<>0) then
+ begin // i.e. for cd-rom
+ Oflags:=Oflags and not(O_RDWR);
+ FileRec(f).Handle := _open(p,oflags,438);
+ end;
+ IF FileRec(f).Handle < 0 THEN
+ Errno2Inoutres
+ ELSE
+ InOutRes := 0;
+End;
+
+function do_isdevice(handle:THandle):boolean;
+begin
+ do_isdevice := (_isatty (handle) > 0);
+end;
+
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netware/sysheap.inc b/rtl/netware/sysheap.inc
new file mode 100644
index 0000000000..275ab7554d
--- /dev/null
+++ b/rtl/netware/sysheap.inc
@@ -0,0 +1,150 @@
+{
+ $Id: sysheap.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Heap Management
+*****************************************************************************}
+
+{$ifdef autoHeapRelease}
+
+const HeapInitialMaxBlocks = 32;
+type THeapSbrkBlockList = array [1.. HeapInitialMaxBlocks] of pointer;
+var HeapSbrkBlockList : ^THeapSbrkBlockList = nil;
+ HeapSbrkLastUsed : dword = 0;
+ HeapSbrkAllocated : dword = 0;
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if fail }
+{ for netware all allocated blocks are saved to free them at }
+{ exit (to avoid message "Module did not release xx resources") }
+Function Sbrk(size : longint):pointer;
+var P2 : POINTER;
+ i : longint;
+begin
+ Sbrk := _malloc (size);
+ if Sbrk <> nil then begin
+ if HeapSbrkBlockList = nil then
+ begin
+ Pointer (HeapSbrkBlockList) := _malloc (sizeof (HeapSbrkBlockList^));
+ if HeapSbrkBlockList = nil then
+ begin
+ _free (Sbrk);
+ Sbrk := nil;
+ exit;
+ end;
+ fillchar (HeapSbrkBlockList^,sizeof(HeapSbrkBlockList^),0);
+ HeapSbrkAllocated := HeapInitialMaxBlocks;
+ end;
+ if (HeapSbrkLastUsed > 0) then
+ for i := 1 to HeapSbrkLastUsed do
+ if (HeapSbrkBlockList^[i] = nil) then
+ begin // reuse free slot
+ HeapSbrkBlockList^[i] := Sbrk;
+ exit;
+ end;
+ if (HeapSbrkLastUsed = HeapSbrkAllocated) then
+ begin { grow }
+ p2 := _realloc (HeapSbrkBlockList, (HeapSbrkAllocated + HeapInitialMaxBlocks) * sizeof(pointer));
+ if p2 = nil then // should we better terminate with error ?
+ begin
+ _free (Sbrk);
+ Sbrk := nil;
+ exit;
+ end;
+ HeapSbrkBlockList := p2;
+ inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
+ end;
+ inc (HeapSbrkLastUsed);
+ HeapSbrkBlockList^[HeapSbrkLastUsed] := Sbrk;
+ end;
+end;
+
+
+procedure FreeSbrkMem;
+var i : longint;
+begin
+ if HeapSbrkBlockList <> nil then
+ begin
+ for i := 1 to HeapSbrkLastUsed do
+ if (HeapSbrkBlockList^[i] <> nil) then
+ _free (HeapSbrkBlockList^[i]);
+ _free (HeapSbrkBlockList);
+ HeapSbrkAllocated := 0;
+ HeapSbrkLastUsed := 0;
+ HeapSbrkBlockList := nil;
+ end;
+end;
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ result := sbrk(size);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+var i : longint;
+begin
+//fpmunmap(p, size);
+ if (HeapSbrkLastUsed > 0) then
+ for i := 1 to HeapSbrkLastUsed do
+ if (HeapSbrkBlockList^[i] = p) then
+ begin
+ _free (p);
+ HeapSbrkBlockList^[i] := nil;
+ exit;
+ end;
+ HandleError (204); // invalid pointer operation
+end;
+
+{$else autoHeapRelease}
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+ _free (p);
+end;
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ SysOSAlloc := _malloc (size);
+end;
+
+{$endif autoHeapRelease}
+
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netware/sysos.inc b/rtl/netware/sysos.inc
new file mode 100644
index 0000000000..cdfb363ceb
--- /dev/null
+++ b/rtl/netware/sysos.inc
@@ -0,0 +1,56 @@
+{
+ $Id: sysos.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{ some declarations for Netware API calls }
+{$I nwsys.inc}
+{$I errno.inc}
+
+
+var
+ CloseAllRemainingSemaphores : TSysCloseAllRemainingSemaphores = nil;
+ ReleaseThreadVars : TSysReleaseThreadVars = nil;
+ SetThreadDataAreaPtr : TSysSetThreadDataAreaPtr = nil;
+ TerminatingThreadID : longint = 0; {used for unload, the signal handler will}
+ {be called from the console thread. avoid}
+ {calling _exit in another thread}
+
+procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
+ rtv:TSysReleaseThreadVars;
+ stdata:TSysSetThreadDataAreaPtr);
+begin
+ CloseAllRemainingSemaphores := crs;
+ ReleaseThreadVars := rtv;
+ SetThreadDataAreaPtr := stdata;
+end;
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netware/sysosh.inc b/rtl/netware/sysosh.inc
new file mode 100644
index 0000000000..2b199d2898
--- /dev/null
+++ b/rtl/netware/sysosh.inc
@@ -0,0 +1,57 @@
+{
+ $Id: sysosh.inc,v 1.2 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+type
+ THandle = DWord;
+ TThreadID = THandle;
+
+ { the fields of this record are os dependent }
+ { and they shouldn't be used in a program }
+ { only the type TCriticalSection is important }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = packed record
+ SemaHandle : LONGINT;
+ SemaIsOpen : BOOLEAN;
+ end;
+
+{Delphi/Windows compatible priority constants, they are also defined for Unix and Win32}
+const
+ THREAD_PRIORITY_IDLE = -15;
+ THREAD_PRIORITY_LOWEST = -2;
+ THREAD_PRIORITY_BELOW_NORMAL = -1;
+ THREAD_PRIORITY_NORMAL = 0;
+ THREAD_PRIORITY_ABOVE_NORMAL = 1;
+ THREAD_PRIORITY_HIGHEST = 2;
+ THREAD_PRIORITY_TIME_CRITICAL = 15;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netware/system.pp b/rtl/netware/system.pp
new file mode 100644
index 0000000000..b624803c63
--- /dev/null
+++ b/rtl/netware/system.pp
@@ -0,0 +1,504 @@
+{
+ $Id: system.pp,v 1.37 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ no stack check in system }
+{$S-}
+unit system;
+
+interface
+
+{$define StdErrToConsole}
+{$define useLongNamespaceByDefault}
+{$define autoHeapRelease}
+
+{$ifdef SYSTEMDEBUG}
+ {$define SYSTEMEXCEPTIONDEBUG}
+{$endif SYSTEMDEBUG}
+
+{$ifdef cpui386}
+ {$define Set_i386_Exception_handler}
+{$endif cpui386}
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+{Platform specific information}
+const
+ LineEnding = #13#10;
+ LFNSupport : boolean = false;
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 255;
+
+
+CONST
+ { Default filehandles }
+ UnusedHandle : THandle = -1;
+ StdInputHandle : THandle = 0;
+ StdOutputHandle : THandle = 0;
+ StdErrorHandle : THandle = 0;
+
+ FileNameCaseSensitive : boolean = false;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+TYPE
+ TNWCheckFunction = procedure (var code : longint);
+
+VAR
+ ArgC : INTEGER;
+ ArgV : ppchar;
+ NetwareCheckFunction : TNWCheckFunction;
+ NetwareMainThreadGroupID: longint;
+ NetwareCodeStartAddress : dword;
+ NetwareUnloadProc : pointer = nil; {like exitProc but for nlm unload only}
+
+CONST
+ envp : ppchar = nil; {dummy to make heaptrc happy}
+
+
+procedure ConsolePrintf (FormatStr : PCHAR; Param : LONGINT); CDecl; external 'clib' name 'printf';
+procedure ConsolePrintf (FormatStr : PCHAR; Param : pchar); CDecl; external 'clib' name 'printf';
+procedure ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT); CDecl; external 'clib' name 'printf';
+procedure ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT); CDecl; external 'clib' name 'printf';
+procedure ConsolePrintf (FormatStr : PCHAR); CDecl; external 'clib' name 'printf';
+// this gives internal compiler error 200404181
+// procedure ConsolePrintf (FormatStr : PCHAR; Param : array of const); CDecl; EXTERNAL 'clib' name 'ConsolePrintf';
+
+procedure __EnterDebugger; cdecl; external 'clib' name 'EnterDebugger';
+
+type
+ TSysCloseAllRemainingSemaphores = procedure;
+ TSysReleaseThreadVars = procedure;
+ TSysSetThreadDataAreaPtr = function (newPtr:pointer):pointer;
+
+procedure NWSysSetThreadFunctions (crs:TSysCloseAllRemainingSemaphores;
+ rtv:TSysReleaseThreadVars;
+ stdata:TSysSetThreadDataAreaPtr);
+
+function NWGetCodeStart : pointer; // needed for lineinfo
+
+implementation
+{ Indicate that stack checking is taken care by OS}
+{$DEFINE NO_GENERIC_STACK_CHECK}
+
+{ include system independent routines }
+{$I system.inc}
+
+//procedure __EnterDebugger; cdecl; external 'clib' name 'EnterDebugger';
+
+
+procedure PASCALMAIN;external name 'PASCALMAIN';
+procedure fpc_do_exit;external name 'FPC_DO_EXIT';
+
+
+{*****************************************************************************
+ Startup
+*****************************************************************************}
+
+ function __GetBssStart : pointer; external name '__getBssStart';
+ function __getUninitializedDataSize : longint; external name '__getUninitializedDataSize';
+ //function __getDataStart : longint; external name '__getDataStart';
+ function __GetTextStart : longint; external name '__getTextStart';
+
+PROCEDURE nlm_main (_ArgC : LONGINT; _ArgV : ppchar); CDECL; [public,alias: '_nlm_main'];
+BEGIN
+ // Initialize BSS
+ if __getUninitializedDataSize > 0 then
+ fillchar (__getBssStart^,__getUninitializedDataSize,0);
+ NetwareCodeStartAddress := __GetTextStart;
+ ArgC := _ArgC;
+ ArgV := _ArgV;
+ fpc_threadvar_relocate_proc := nil;
+ PASCALMAIN;
+END;
+
+function NWGetCodeStart : pointer; // needed for lineinfo
+begin
+ NWGetCodeStart := pointer(NetwareCodeStartAddress);
+end;
+
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+var SigTermHandlerActive : boolean;
+
+Procedure system_exit;
+begin
+ if TerminatingThreadID <> 0 then
+ if TerminatingThreadID <> ThreadId then
+ if TerminatingThreadID <> _GetThreadID then
+ begin
+ {$ifdef DEBUG_MT}
+ ConsolePrintf ('Terminating Thread %x because halt was called while Thread %x terminates nlm'#13#10,_GetThreadId,TerminatingThreadId);
+ {$endif}
+ ExitThread (EXIT_THREAD,0);
+ // only for the case ExitThread fails
+ while true do
+ _ThreadSwitchWithDelay;
+ end;
+ if assigned (CloseAllRemainingSemaphores) then CloseAllRemainingSemaphores;
+ if assigned (ReleaseThreadVars) then ReleaseThreadVars;
+
+ {$ifdef autoHeapRelease}
+ FreeSbrkMem; { free memory allocated by heapmanager }
+ {$endif}
+
+ if not SigTermHandlerActive then
+ begin
+ if ExitCode <> 0 Then { otherwise we dont see runtime-errors }
+ _SetAutoScreenDestructionMode (false);
+
+ _exit (ExitCode);
+ end;
+end;
+
+{*****************************************************************************
+ Stack check code
+*****************************************************************************}
+
+const StackErr : boolean = false;
+
+procedure int_stackcheck(stack_size:Cardinal);[public,alias:'FPC_STACKCHECK'];
+{
+ called when trying to get local stack if the compiler directive $S
+ is set this function must preserve all registers
+
+ With a 2048 byte safe area used to write to StdIo without crossing
+ the stack boundary
+}
+begin
+ if StackErr then exit; // avoid recursive calls
+ asm
+ pusha
+ end;
+ stackerr := ( _stackavail < stack_size + 2048);
+ asm
+ popa
+ end;
+ if not StackErr then exit;
+ StackErr := true;
+ HandleError (202);
+end;
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l+1<=argc) then
+ begin
+ paramstr:=strpas(argv[l]);
+ if l = 0 then // fix nlm path
+ begin
+ for l := 1 to length (paramstr) do
+ if paramstr[l] = '\' then paramstr[l] := '/';
+ end;
+ end else
+ paramstr:='';
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+begin
+ randseed := _time (NIL);
+end;
+
+
+
+{*****************************************************************************
+ Thread Handling
+*****************************************************************************}
+
+procedure InitFPU;assembler;
+
+ asm
+ fninit
+ fldcw fpucw
+ end;
+
+
+{ if return-value is <> 0, netware shows the message
+ Unload Anyway ?
+ To Disable unload at all, SetNLMDontUnloadFlag can be used on
+ Netware >= 4.0 }
+function CheckFunction : longint; CDECL; [public,alias: 'FPC_NW_CHECKFUNCTION'];
+var oldTG:longint;
+ oldPtr: pointer;
+begin
+ if assigned (NetwareCheckFunction) then
+ begin
+ { this function is called without clib context, to allow clib
+ calls, we set the thread group id before calling the
+ user-function }
+ oldTG := _SetThreadGroupID (NetwareMainThreadGroupID);
+ { to allow use of threadvars, we simply set the threadvar-memory
+ from the main thread }
+ if assigned (SetThreadDataAreaPtr) then
+ oldPtr := SetThreadDataAreaPtr (NIL); { nil means main threadvars }
+ result := 0;
+ NetwareCheckFunction (result);
+ if assigned (SetThreadDataAreaPtr) then
+ SetThreadDataAreaPtr (oldPtr);
+
+ _SetThreadGroupID (oldTG);
+ end else
+ result := 0;
+end;
+
+
+
+{$ifdef StdErrToConsole}
+var ConsoleBuff : array [0..512] of char;
+
+Function ConsoleWrite(Var F: TextRec): Integer;
+var
+ i : longint;
+Begin
+ if F.BufPos>0 then
+ begin
+ if F.BufPos>sizeof(ConsoleBuff)-1 then
+ i:=sizeof(ConsoleBuff)-1
+ else
+ i:=F.BufPos;
+ Move(F.BufPtr^,ConsoleBuff,i);
+ ConsoleBuff[i] := #0;
+ ConsolePrintf(@ConsoleBuff[0]);
+ end;
+ F.BufPos:=0;
+ ConsoleWrite := 0;
+End;
+
+
+Function ConsoleClose(Var F: TextRec): Integer;
+begin
+ ConsoleClose:=0;
+end;
+
+
+Function ConsoleOpen(Var F: TextRec): Integer;
+Begin
+ TextRec(F).InOutFunc:=@ConsoleWrite;
+ TextRec(F).FlushFunc:=@ConsoleWrite;
+ TextRec(F).CloseFunc:=@ConsoleClose;
+ ConsoleOpen:=0;
+End;
+
+
+procedure AssignStdErrConsole(Var T: Text);
+begin
+ Assign(T,'');
+ TextRec(T).OpenFunc:=@ConsoleOpen;
+ Rewrite(T);
+end;
+{$endif}
+
+
+{ this will be called if the nlm is unloaded. It will NOT be
+ called if the program exits i.e. with halt.
+ Halt (or _exit) can not be called from this callback procedure }
+procedure TermSigHandler (Sig:longint); CDecl;
+var oldTG : longint;
+ oldPtr: pointer;
+ err : longint;
+ current_exit : procedure;
+ ThreadName : array [0..20] of char;
+ HadExitProc : boolean;
+ Count : longint;
+begin
+
+ oldTG := _SetThreadGroupID (NetwareMainThreadGroupID); { this is only needed for nw 3.11 }
+
+ { _GetThreadDataAreaPtr will not be valid because the signal
+ handler is called by netware with a differnt thread. To avoid
+ problems in the exit routines, we set the data of the main thread
+ here }
+ if assigned (SetThreadDataAreaPtr) then
+ oldPtr := SetThreadDataAreaPtr (NIL); { nil means main thread }
+
+ {this signal handler is called within the console command
+ thread, the main thread is still running. Via NetwareUnloadProc
+ running threads may terminate itself}
+ TerminatingThreadID := _GetThreadID;
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'TermSigHandler Called, MainThread:%x, OurThread: %x'#13#10,ThreadId,TerminatingThreadId);
+ if NetwareUnloadProc <> nil then
+ ConsolePrintf (#13'Calling NetwareUnloadProcs'#13#10);
+ {$endif}
+ HadExitProc := false;
+ {we need to finalize winock to release threads
+ waiting on a blocking socket call. If that thread
+ calls halt, we have to avoid that unit finalization
+ is called by that thread because we are doing it
+ here
+
+ like the old exitProc, mainly to allow winsock to release threads
+ blocking in a winsock calls }
+ while NetwareUnloadProc<>nil Do
+ Begin
+ InOutRes:=0;
+ current_exit:=tProcedure(NetwareUnloadProc);
+ NetwareUnloadProc:=nil;
+ current_exit();
+ _ThreadSwitchWithDelay;
+ hadExitProc := true;
+ End;
+
+ err := 0;
+ if hadExitProc then
+ begin {give the main thread a little bit of time to terminate}
+ count := 0;
+ repeat
+ err := _GetThreadName(ThreadID,ThreadName);
+ if err = 0 then _Delay (200);
+ inc(count);
+ until (err <> 0) or (count > 100); {about 20 seconds}
+ {$ifdef DEBUG_MT}
+ if err = 0 then
+ ConsolePrintf (#13,'Main Thread not terminated'#13#10)
+ else
+ ConsolePrintf (#13'Main Thread has ended'#13#10);
+ {$endif}
+ end;
+
+ if err = 0 then
+ {$ifdef DEBUG_MT}
+ begin
+ err := _SuspendThread(ThreadId);
+ ConsolePrintf (#13'SuspendThread(%x) returned %d'#13#10,ThreadId,err);
+ end;
+ {$else}
+ _SuspendThread(ThreadId);
+ {$endif}
+ _ThreadSwitchWithDelay;
+
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'Calling do_exit'#13#10);
+ {$endif}
+ SigTermHandlerActive := true; { to avoid that system_exit calls _exit }
+ do_exit; { calls finalize units }
+ if assigned (SetThreadDataAreaPtr) then
+ SetThreadDataAreaPtr (oldPtr);
+ _SetThreadGroupID (oldTG);
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'TermSigHandler: all done'#13#10);
+ {$endif}
+end;
+
+
+procedure SysInitStdIO;
+begin
+{ Setup stdin, stdout and stderr }
+ StdInputHandle := _fileno (LONGINT (_GetStdIn^)); // GetStd** returns **FILE
+ StdOutputHandle:= _fileno (LONGINT (_GetStdOut^));
+ StdErrorHandle := _fileno (LONGINT (_GetStdErr^));
+
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+
+ {$ifdef StdErrToConsole}
+ AssignStdErrConsole(StdErr);
+ AssignStdErrConsole(ErrOutput);
+ {$else}
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ {$endif}
+end;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := SizeUInt (GetNlmHandle);
+end;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+Begin
+ StackBottom := SPtr - StackLength;
+ SigTermHandlerActive := false;
+ NetwareCheckFunction := nil;
+ NetwareMainThreadGroupID := _GetThreadGroupID;
+
+ _Signal (_SIGTERM, @TermSigHandler);
+
+ {$ifdef useLongNamespaceByDefault}
+ if _getenv ('FPC_DISABLE_LONG_NAMESPACE') = nil then
+ begin
+ if _SetCurrentNameSpace (NW_NS_LONG) <> 255 then
+ begin
+ if _SetTargetNamespace (NW_NS_LONG) <> 255 then
+ LFNSupport := true
+ else
+ _SetCurrentNameSpace (NW_NS_DOS);
+ end;
+ end;
+ {$endif useLongNamespaceByDefault}
+
+{ Setup heap }
+ InitHeap;
+ SysInitExceptions;
+
+{ Reset IO Error }
+ InOutRes:=0;
+
+ ThreadID := _GetThreadID;
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'Start system, ThreadID: %x'#13#10,ThreadID);
+ {$endif}
+
+ SysInitStdIO;
+
+{Delphi Compatible}
+ IsLibrary := FALSE;
+ IsConsole := TRUE;
+ ExitCode := 0;
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+{
+ $Log: system.pp,v $
+ Revision 1.37 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.36 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.35 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.34 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/netware/systhrd.inc b/rtl/netware/systhrd.inc
new file mode 100644
index 0000000000..44c30439a1
--- /dev/null
+++ b/rtl/netware/systhrd.inc
@@ -0,0 +1,509 @@
+{
+ $Id: systhrd.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ Multithreading for netware, armin 16 Mar 2002
+ - threads are basicly tested and working
+ - TRTLCriticalSections are working but NEVER call Enter or
+ LeaveCriticalSection with uninitialized CriticalSections.
+ Critial Sections are based on local semaphores and the
+ Server will abend if the semaphore handles are invalid. There
+ are basic tests in the rtl but this will not work in every case.
+ Not closed semaphores will be closed by the rtl on program
+ termination because some versions of netware will abend if there
+ are open semaphores on nlm unload.
+}
+
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+
+const
+ threadvarblocksize : dword = 0; // total size of allocated threadvars
+ thredvarsmainthread: pointer = nil; // to free the threadvars in the signal handler
+
+
+procedure SysInitThreadvar (var offset : dword;size : dword);[public,alias: 'FPC_INIT_THREADVAR'];
+begin
+ offset:=threadvarblocksize;
+ inc(threadvarblocksize,size);
+ {$ifdef DEBUG_MT}
+ ConsolePrintf(#13'init_threadvar, new offset: (%d), Size:%d'#13#10,offset,size,0);
+ {$endif DEBUG_MT}
+end;
+
+
+{$ifdef DEBUG_MT}
+var dummy_buff : array [0..255] of char; // to avoid abends (for current compiler error that not all threadvars are initialized)
+{$endif}
+
+function SysRelocateThreadvar (offset : dword) : pointer;
+var p : pointer;
+begin
+ {$ifdef DEBUG_MT}
+// ConsolePrintf(#13'relocate_threadvar, offset: (%d)'#13#10,offset);
+ if offset > threadvarblocksize then
+ begin
+// ConsolePrintf(#13'relocate_threadvar, invalid offset'#13#10,0);
+ SysRelocateThreadvar := @dummy_buff;
+ exit;
+ end;
+ {$endif DEBUG_MT}
+ SysRelocateThreadvar:= _GetThreadDataAreaPtr + offset;
+end;
+
+procedure SysAllocateThreadVars;
+
+ var
+ threadvars : pointer;
+
+ begin
+ { we've to allocate the memory from netware }
+ { because the FPC heap management uses }
+ { exceptions which use threadvars but }
+ { these aren't allocated yet ... }
+ { allocate room on the heap for the thread vars }
+ threadvars := _malloc (threadvarblocksize);
+ fillchar (threadvars^, threadvarblocksize, 0);
+ _SaveThreadDataAreaPtr (threadvars);
+ {$ifdef DEBUG_MT}
+ ConsolePrintf(#13'threadvars allocated at (%x), size: %d'#13#10,longint(threadvars),threadvarblocksize,0);
+ {$endif DEBUG_MT}
+ if thredvarsmainthread = nil then
+ thredvarsmainthread := threadvars;
+ end;
+
+procedure SysReleaseThreadVars;
+var threadvars : pointer;
+begin
+ { release thread vars }
+ if threadvarblocksize > 0 then
+ begin
+ threadvars:=_GetThreadDataAreaPtr;
+ if threadvars <> nil then
+ begin
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'free threadvars'#13#10,0);
+ {$endif DEBUG_MT}
+ _Free (threadvars);
+ _SaveThreadDataAreaPtr (nil);
+ end;
+ end;
+end;
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+ Thread starting
+*****************************************************************************}
+
+type
+ tthreadinfo = record
+ f : tthreadfunc;
+ p : pointer;
+ stklen: cardinal;
+ end;
+ pthreadinfo = ^tthreadinfo;
+
+
+
+procedure DoneThread;
+
+ begin
+ { release thread vars }
+{$ifdef HASTHREADVAR}
+ SysReleaseThreadVars;
+{$endif}
+ end;
+
+
+function ThreadMain(param : pointer) : dword; cdecl;
+
+ var
+ ti : tthreadinfo;
+
+ begin
+{$ifdef HASTHREADVAR}
+ { Allocate local thread vars, this must be the first thing,
+ because the exception management and io depends on threadvars }
+ SysAllocateThreadVars;
+{$endif HASTHREADVAR}
+{$ifdef DEBUG_MT}
+ ConsolePrintf(#13'New thread %x started, initialising ...'#13#10,_GetThreadID);
+{$endif DEBUG_MT}
+ ti:=pthreadinfo(param)^;
+ InitThread(ti.stklen);
+ dispose(pthreadinfo(param));
+{$ifdef DEBUG_MT}
+ ConsolePrintf(#13'Jumping to thread function'#13#10);
+{$endif DEBUG_MT}
+ ThreadMain:=ti.f(ti.p);
+ DoneThread;
+ end;
+
+function SysBeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;
+ creationFlags : dword; var ThreadId : DWord) : DWord;
+
+ var ti : pthreadinfo;
+
+ begin
+{$ifdef DEBUG_MT}
+ ConsolePrintf(#13'Creating new thread'#13#10);
+{$endif DEBUG_MT}
+{$ifdef HASTHREADVAR}
+ if not IsMultiThread then
+ begin
+ InitThreadVars(@SysRelocateThreadvar);
+ IsMultithread:=true;
+ end;
+{$endif}
+ { the only way to pass data to the newly created thread }
+ { in a MT safe way, is to use the heap }
+ new(ti);
+ ti^.f:=ThreadFunction;
+ ti^.p:=p;
+ ti^.stklen:=stacksize;
+{$ifdef DEBUG_MT}
+ ConsolePrintf(#13'Starting new thread'#13#10);
+{$endif DEBUG_MT}
+ SysBeginThread :=
+ _BeginThread (@ThreadMain,NIL,Stacksize,ti);
+ end;
+
+
+procedure SysEndThread(ExitCode : DWord);
+begin
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'SysEndThread %x'#13#10,_GetThreadID);
+ {$endif}
+ DoneThread;
+ ExitThread(ExitCode , TSR_THREAD);
+end;
+
+{*****************************************************************************
+ Thread handling
+*****************************************************************************}
+
+
+function __SuspendThread (threadId : dword) : dword; cdecl; external 'clib' name 'SuspendThread';
+function __ResumeThread (threadId : dword) : dword; cdecl; external 'clib' name 'ResumeThread';
+procedure __ThreadSwitchWithDelay; cdecl; external 'clib' name 'ThreadSwitchWithDelay';
+
+procedure SysThreadSwitch;
+begin
+ __ThreadSwitchWithDelay;
+end;
+
+
+{redefined because the interface has not cdecl calling convention}
+function SysSuspendThread (threadHandle : dword) : dword;
+begin
+ SysSuspendThread := __SuspendThread (threadHandle);
+end;
+
+
+function SysResumeThread (threadHandle : dword) : dword;
+begin
+ SysResumeThread := __ResumeThread (threadHandle);
+end;
+
+
+function SysKillThread (threadHandle : dword) : dword;
+begin
+ SysKillThread := 1; {not supported for netware}
+end;
+
+function GetThreadName (threadId : longint; var threadName) : longint; cdecl; external 'clib' name 'GetThreadName';
+function CGetThreadID : dword; cdecl; external 'clib' name 'GetThreadID';
+//function __RenameThread (threadId : longint; threadName:pchar) : longint; cdecl; external 'clib' name 'RenameThread';
+
+function SysWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;
+var
+ status : longint;
+ buf : array [0..50] of char;
+begin
+ {$warning timeout needs to be implemented}
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'SysWaitForThreadTerminate ThreadID:%x Handle:%x'#13#10,GetThreadID,threadHandle);
+ {$endif}
+ repeat
+ status := GetThreadName (ThreadHandle,Buf); {should return EBADHNDL if thread is terminated}
+ ThreadSwitch;
+ until status <> 0;
+ SysWaitForThreadTerminate:=0;
+end;
+
+function SysThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
+begin
+ SysThreadSetPriority := true;
+end;
+
+function SysThreadGetPriority (threadHandle : dword): Longint;
+begin
+ SysThreadGetPriority := 0;
+end;
+
+
+
+function SysGetCurrentThreadId : dword;
+begin
+ SysGetCurrentThreadId := CGetThreadID;
+end;
+
+
+{ netware requires all allocated semaphores }
+{ to be closed before terminating the nlm, otherwise }
+{ the server will abend (except for netware 6 i think) }
+
+TYPE TSemaList = ARRAY [1..1000] OF LONGINT;
+ PSemaList = ^TSemaList;
+
+CONST NumSemaOpen : LONGINT = 0;
+ NumEntriesMax : LONGINT = 0;
+ SemaList : PSemaList = NIL;
+
+PROCEDURE SaveSema (Handle : LONGINT);
+BEGIN
+ {$ifdef DEBUG_MT}
+ ConsolePrintf(#13'new Semaphore allocated (%x)'#13#10,Handle);
+ {$endif DEBUG_MT}
+ _EnterCritSec;
+ IF NumSemaOpen = NumEntriesMax THEN
+ BEGIN
+ IF SemaList = NIL THEN
+ BEGIN
+ SemaList := _malloc (32 * SIZEOF (TSemaList[0]));
+ NumEntriesMax := 32;
+ END ELSE
+ BEGIN
+ INC (NumEntriesMax, 16);
+ SemaList := _realloc (SemaList, NumEntriesMax * SIZEOF (TSemaList[0]));
+ END;
+ END;
+ INC (NumSemaOpen);
+ SemaList^[NumSemaOpen] := Handle;
+ _ExitCritSec;
+END;
+
+PROCEDURE ReleaseSema (Handle : LONGINT);
+VAR I : LONGINT;
+BEGIN
+ {$ifdef DEBUG_MT}
+ ConsolePrintf(#13'Semaphore released (%x)'#13#10,Handle);
+ {$endif DEBUG_MT}
+ _EnterCritSec;
+ IF SemaList <> NIL then
+ if NumSemaOpen > 0 then
+ begin
+ for i := 1 to NumSemaOpen do
+ if SemaList^[i] = Handle then
+ begin
+ if i < NumSemaOpen then
+ SemaList^[i] := SemaList^[NumSemaOpen];
+ dec (NumSemaOpen);
+ _ExitCritSec;
+ exit;
+ end;
+ end;
+ _ExitCritSec;
+ ConsolePrintf (#13'fpc-rtl: ReleaseSema, Handle not found'#13#10,0);
+END;
+
+
+PROCEDURE SysCloseAllRemainingSemaphores;
+var i : LONGINT;
+begin
+ IF SemaList <> NIL then
+ begin
+ if NumSemaOpen > 0 then
+ for i := 1 to NumSemaOpen do
+ _CloseLocalSemaphore (SemaList^[i]);
+ _free (SemaList);
+ SemaList := NIL;
+ NumSemaOpen := 0;
+ NumEntriesMax := 0;
+ end;
+end;
+
+{ this allows to do a lot of things in MT safe way }
+{ it is also used to make the heap management }
+{ thread safe }
+procedure SysInitCriticalSection(var cs);// : TRTLCriticalSection);
+begin
+ with PRTLCriticalSection(@cs)^ do
+ begin
+ SemaHandle := _OpenLocalSemaphore (1);
+ if SemaHandle <> 0 then
+ begin
+ SemaIsOpen := true;
+ SaveSema (SemaHandle);
+ end else
+ begin
+ SemaIsOpen := false;
+ ConsolePrintf (#13'fpc-rtl: InitCriticalsection, OpenLocalSemaphore returned error'#13#10,0);
+ end;
+ end;
+end;
+
+procedure SysDoneCriticalsection(var cs);
+begin
+ with PRTLCriticalSection(@cs)^ do
+ begin
+ if SemaIsOpen then
+ begin
+ _CloseLocalSemaphore (SemaHandle);
+ ReleaseSema (SemaHandle);
+ SemaIsOpen := FALSE;
+ end;
+ end;
+end;
+
+procedure SysEnterCriticalsection(var cs);
+begin
+ with PRTLCriticalSection(@cs)^ do
+ begin
+ if SemaIsOpen then
+ _WaitOnLocalSemaphore (SemaHandle)
+ else
+ ConsolePrintf (#13'fpc-rtl: EnterCriticalsection, TRTLCriticalSection not open'#13#10,0);
+ end;
+end;
+
+procedure SysLeaveCriticalSection(var cs);
+begin
+ with PRTLCriticalSection(@cs)^ do
+ begin
+ if SemaIsOpen then
+ _SignalLocalSemaphore (SemaHandle)
+ else
+ ConsolePrintf (#13'fpc-rtl: LeaveCriticalsection, TRTLCriticalSection not open'#13#10,0);
+ end;
+end;
+
+
+function SysSetThreadDataAreaPtr (newPtr:pointer):pointer;
+begin
+ SysSetThreadDataAreaPtr := _GetThreadDataAreaPtr;
+ if newPtr = nil then
+ newPtr := thredvarsmainthread;
+ _SaveThreadDataAreaPtr (newPtr);
+end;
+
+
+
+{*****************************************************************************
+ Heap Mutex Protection
+*****************************************************************************}
+
+var
+ HeapMutex : TRTLCriticalSection;
+
+procedure NWHeapMutexInit;
+begin
+ InitCriticalSection(heapmutex);
+end;
+
+procedure NWHeapMutexDone;
+begin
+ DoneCriticalSection(heapmutex);
+end;
+
+procedure NWHeapMutexLock;
+begin
+ EnterCriticalSection(heapmutex);
+end;
+
+procedure NWHeapMutexUnlock;
+begin
+ LeaveCriticalSection(heapmutex);
+end;
+
+const
+ NWMemoryMutexManager : TMemoryMutexManager = (
+ MutexInit : @NWHeapMutexInit;
+ MutexDone : @NWHeapMutexDone;
+ MutexLock : @NWHeapMutexLock;
+ MutexUnlock : @NWHeapMutexUnlock;
+ );
+
+procedure InitHeapMutexes;
+begin
+ SetMemoryMutexManager(NWMemoryMutexManager);
+end;
+
+Var
+ NWThreadManager : TThreadManager;
+
+Procedure InitSystemThreads;
+
+begin
+ With NWThreadManager do
+ begin
+ InitManager :=Nil;
+ DoneManager :=Nil;
+ BeginThread :=@SysBeginThread;
+ EndThread :=@SysEndThread;
+ SuspendThread :=@SysSuspendThread;
+ ResumeThread :=@SysResumeThread;
+ KillThread :=@SysKillThread;
+ ThreadSwitch :=@SysThreadSwitch;
+ WaitForThreadTerminate :=@SysWaitForThreadTerminate;
+ ThreadSetPriority :=@SysThreadSetPriority;
+ ThreadGetPriority :=@SysThreadGetPriority;
+ GetCurrentThreadId :=@SysGetCurrentThreadId;
+ InitCriticalSection :=@SysInitCriticalSection;
+ DoneCriticalSection :=@SysDoneCriticalSection;
+ EnterCriticalSection :=@SysEnterCriticalSection;
+ LeaveCriticalSection :=@SysLeaveCriticalSection;
+{$ifdef HASTHREADVAR}
+ InitThreadVar :=@SysInitThreadVar;
+ RelocateThreadVar :=@SysRelocateThreadVar;
+ AllocateThreadVars :=@SysAllocateThreadVars;
+ ReleaseThreadVars :=@SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+ BasicEventCreate :=@NoBasicEventCreate;
+ basiceventdestroy :=@Nobasiceventdestroy;
+ basiceventResetEvent :=@NobasiceventResetEvent;
+ basiceventSetEvent :=@NobasiceventSetEvent;
+ basiceventWaitFor :=@NobasiceventWaitFor;
+ end;
+ SetThreadManager(NWThreadManager);
+ InitHeapMutexes;
+ NWSysSetThreadFunctions (@SysCloseAllRemainingSemaphores,
+ @SysReleaseThreadVars,
+ @SysSetThreadDataAreaPtr);
+end;
+
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netware/sysutils.pp b/rtl/netware/sysutils.pp
new file mode 100644
index 0000000000..6a67a0218e
--- /dev/null
+++ b/rtl/netware/sysutils.pp
@@ -0,0 +1,593 @@
+{
+ $Id: sysutils.pp,v 1.20 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for netware
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses DOS;
+
+{$I nwsys.inc}
+{$I errno.inc}
+{$DEFINE HAS_SLEEP}
+
+TYPE
+ TNetwareFindData =
+ RECORD
+ DirP : PNWDirEnt; { used for opendir }
+ EntryP: PNWDirEnt; { and readdir }
+ Magic : WORD; { to avoid abends with uninitialized TSearchRec }
+ END;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+
+{ additional NetWare file flags}
+CONST
+ faSHARE = $00000080; { Sharable file }
+
+ faNO_SUBALLOC = $00000800; { Don't sub alloc. this file }
+ faTRANS = $00001000; { Transactional file (TTS usable) }
+ faREADAUD = $00004000; { Read audit }
+ faWRITAUD = $00008000; { Write audit }
+
+ faIMMPURG = $00010000; { Immediate purge }
+ faNORENAM = $00020000; { Rename inhibit }
+ faNODELET = $00040000; { Delete inhibit }
+ faNOCOPY = $00080000; { Copy inhibit }
+
+ faFILE_MIGRATED = $00400000; { File has been migrated }
+ faDONT_MIGRATE = $00800000; { Don't migrate this file }
+ faIMMEDIATE_COMPRESS = $02000000; { Compress this file immediately }
+ faFILE_COMPRESSED = $04000000; { File is compressed }
+ faDONT_COMPRESS = $08000000; { Don't compress this file }
+ faCANT_COMPRESS = $20000000; { Can't compress this file }
+ faATTR_ARCHIVE = $40000000; { Entry has had an EA modified, }
+ { an ownerID changed, or trustee }
+ { info changed, etc. }
+
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+VAR NWOpenFlags : longint;
+BEGIN
+ NWOpenFlags:=0;
+ Case (Mode and 3) of
+ 0 : NWOpenFlags:=NWOpenFlags or O_RDONLY;
+ 1 : NWOpenFlags:=NWOpenFlags or O_WRONLY;
+ 2 : NWOpenFlags:=NWOpenFlags or O_RDWR;
+ end;
+ FileOpen := _open (pchar(FileName),NWOpenFlags,0);
+
+ //!! We need to set locking based on Mode !!
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+
+begin
+ FileCreate:=_open(Pchar(FileName),O_RdWr or O_Creat or O_Trunc,0);
+end;
+
+Function FileCreate (Const FileName : String; mode:longint) : Longint;
+
+begin
+ FileCreate:=FileCreate (FileName);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+
+begin
+ FileRead:=_read (Handle,@Buffer,Count);
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+
+begin
+ FileWrite:=_write (Handle,@Buffer,Count);
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+
+begin
+ FileSeek:=_lseek (Handle,FOffset,Origin);
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+begin
+ {$warning need to add 64bit FileSeek }
+ FileSeek:=FileSeek(Handle,Longint(FOffset),Longint(Origin));
+end;
+
+
+Procedure FileClose (Handle : Longint);
+
+begin
+ _close(Handle);
+end;
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+
+begin
+ FileTruncate:=(_chsize(Handle,Size) = 0);
+end;
+
+Function FileLock (Handle,FOffset,FLen : Longint) : Longint;
+begin
+ FileLock := _lock (Handle,FOffset,FLen);
+end;
+
+Function FileLock (Handle : Longint; FOffset,FLen : Int64) : Longint;
+begin
+ {$warning need to add 64bit FileLock call }
+ FileLock := FileLock (Handle, longint(FOffset),longint(FLen));
+end;
+
+Function FileUnlock (Handle,FOffset,FLen : Longint) : Longint;
+begin
+ FileUnlock := _unlock (Handle,FOffset,FLen);
+end;
+
+Function FileUnlock (Handle : Longint; FOffset,FLen : Int64) : Longint;
+begin
+ {$warning need to add 64bit FileUnlock call }
+ FileUnlock := FileUnlock (Handle, longint(FOffset),longint(FLen));
+end;
+
+Function FileAge (Const FileName : String): Longint;
+
+VAR Info : NWStatBufT;
+ PTM : PNWTM;
+begin
+ If _stat (pchar(FileName),Info) <> 0 then
+ exit(-1)
+ else
+ begin
+ PTM := _localtime (Info.st_mtime);
+ IF PTM = NIL THEN
+ exit(-1)
+ else
+ WITH PTM^ DO
+ Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+ end;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+VAR Info : NWStatBufT;
+begin
+ FileExists:=(_stat(pchar(filename),Info) = 0);
+end;
+
+
+
+PROCEDURE find_setfields (VAR f : TsearchRec);
+VAR T : Dos.DateTime;
+BEGIN
+ WITH F DO
+ BEGIN
+ IF FindData.Magic = $AD01 THEN
+ BEGIN
+ {attr := FindData.EntryP^.d_attr AND $FF;} // lowest 8 bit -> same as dos
+ attr := FindData.EntryP^.d_attr; { return complete netware attributes }
+ UnpackTime(FindData.EntryP^.d_time + (LONGINT (FindData.EntryP^.d_date) SHL 16), T);
+ time := DateTimeToFileDate(EncodeDate(T.Year,T.Month,T.day)+EncodeTime(T.Hour,T.Min,T.Sec,0));
+ size := FindData.EntryP^.d_size;
+ name := strpas (FindData.EntryP^.d_nameDOS);
+ END ELSE
+ BEGIN
+ FillChar (f,SIZEOF(f),0);
+ END;
+ END;
+END;
+
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+begin
+ IF path = '' then
+ exit (18);
+ Rslt.FindData.DirP := _opendir (pchar(Path));
+ IF Rslt.FindData.DirP = NIL THEN
+ exit (18);
+ IF attr <> faAnyFile THEN
+ _SetReaddirAttribute (Rslt.FindData.DirP, attr);
+ Rslt.FindData.Magic := $AD01;
+ Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
+ if Rslt.FindData.EntryP = nil then
+ begin
+ _closedir (Rslt.FindData.DirP);
+ Rslt.FindData.DirP := NIL;
+ result := 18;
+ end else
+ begin
+ find_setfields (Rslt);
+ result := 0;
+ end;
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+
+begin
+ IF Rslt.FindData.Magic <> $AD01 THEN
+ exit (18);
+ Rslt.FindData.EntryP := _readdir (Rslt.FindData.DirP);
+ IF Rslt.FindData.EntryP = NIL THEN
+ exit (18);
+ find_setfields (Rslt);
+ result := 0;
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+begin
+ IF F.FindData.Magic = $AD01 THEN
+ BEGIN
+ IF F.FindData.DirP <> NIL THEN
+ _closedir (F.FindData.DirP);
+ F.FindData.Magic := 0;
+ F.FindData.DirP := NIL;
+ F.FindData.EntryP := NIL;
+ END;
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+Var Info : NWStatBufT;
+ PTM : PNWTM;
+begin
+ If _fstat(Handle,Info) <> 0 then
+ Result:=-1
+ else
+ begin
+ PTM := _localtime (Info.st_mtime);
+ IF PTM = NIL THEN
+ exit(-1)
+ else
+ WITH PTM^ DO
+ Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+ end;
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+begin
+ { i think its impossible under netware from FileHandle. I dident found a way to get the
+ complete pathname of a filehandle, that would be needed for ChangeDirectoryEntry }
+ FileSetDate:=-1;
+ ConsolePrintf ('warning: fpc sysutils.FileSetDate not implemented'#13#10,0);
+ {$warning FileSetDate not implemented (i think is impossible) }
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+Var Info : NWStatBufT;
+begin
+ If _stat (pchar(FileName),Info) <> 0 then
+ Result:=-1
+ Else
+ Result := Info.st_attr AND $FFFF;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+VAR MS : NWModifyStructure;
+begin
+ FillChar (MS, SIZEOF (MS), 0);
+ if _ChangeDirectoryEntry (PChar (Filename), MS, MFileAtrributesBit, 0) <> 0 then
+ result := -1
+ else
+ result := 0;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+
+begin
+ Result:= (_UnLink (pchar(FileName)) = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+
+begin
+ RenameFile:=(_rename(pchar(OldName),pchar(NewName)) = 0);
+end;
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.',
+ 'a:.',
+ 'b:.',
+ 'sys:/'
+ );
+var
+ Drives : byte;
+ DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+Function DiskFree(Drive: Byte): int64;
+//var fs : statfs;
+Begin
+{ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+ ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+ Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+ else
+ Diskfree:=-1;}
+ DiskFree := -1;
+ ConsolePrintf ('warning: fpc sysutils.diskfree not implemented'#13#10,0);
+ {$warning DiskFree not implemented (does it make sense ?) }
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+//var fs : statfs;
+Begin
+{ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+ ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+ DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+ else
+ DiskSize:=-1;}
+ DiskSize := -1;
+ ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10,0);
+ {$warning DiskSize not implemented (does it make sense ?) }
+End;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+function DirectoryExists (const Directory: string): boolean;
+VAR Info : NWStatBufT;
+begin
+ If _stat (pchar(Directory),Info) <> 0 then
+ exit(false)
+ else
+ Exit ((Info.st_attr and faDirectory) <> 0);
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+ _RingTheBell;
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var xx : word;
+begin
+ Dos.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, xx);
+ Dos.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day, xx);
+ SystemTime.MilliSecond := 0;
+end;
+
+
+Procedure InitAnsi;
+Var i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=''; // StrError(ErrorCode);
+end;
+
+{****************************************************************************
+ OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=StrPas(_getenv(PChar(EnvVar)));
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ // Result:=FPCCountEnvVar(EnvP);
+ Result:=0;
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ // Result:=FPCGetEnvStrFromP(Envp,Index);
+ Result:='';
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+
+var
+ e : EOSError;
+ CommandLine: AnsiString;
+
+begin
+ dos.exec(path,comline);
+
+ if (Dos.DosError <> 0) then
+ begin
+ if ComLine <> '' then
+ CommandLine := Path + ' ' + ComLine
+ else
+ CommandLine := Path;
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+ e.ErrorCode:=Dos.DosError;
+ raise e;
+ end;
+ Result := DosExitCode;
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+procedure Sleep(milliseconds: Cardinal);
+begin
+ _delay (milliseconds);
+end;
+
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+{
+
+ $Log: sysutils.pp,v $
+ Revision 1.20 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.19 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/tests/Makefile b/rtl/netware/tests/Makefile
new file mode 100644
index 0000000000..bee52a6d28
--- /dev/null
+++ b/rtl/netware/tests/Makefile
@@ -0,0 +1,28 @@
+# Makefile for freepascal nlm-test
+# Needs working nlmconv + i386-netware-ld
+# AD 8/2000
+
+UNITDIR = /usr/lib/fpc/1.1/cross/i386-netware/units/rtl
+PPC386OPT = -a -al -Or -O3 -XX -Tnetware -Fi$(UNITDIR)
+INCLUDES = -Fo$(UNITDIR) -Fu$(UNITDIR)
+
+OBJS = test.on thrd.on
+
+%.on: %.pas
+ ppc386 $(PPC386OPT) $(INCLUDES) $*.pas
+
+all: $(OBJS)
+
+#test.nlm: $(OBJS)
+# nlmconv -Ttest.def
+
+# mount netware and copy test.nlm to sys:test on 4.11 and 5.1 server
+install: all
+ ncftpput -u linux -p linux fs-develop /sys/test *.nlm
+ ncftpput -u linux -p linux fs-ad /sys/test *.nlm
+
+
+clean:
+ rm -f *.on *.nlm *.ppn *.s *.bak *.o
+
+dist: clean
diff --git a/rtl/netware/tests/test.pas b/rtl/netware/tests/test.pas
new file mode 100644
index 0000000000..07080d5124
--- /dev/null
+++ b/rtl/netware/tests/test.pas
@@ -0,0 +1,604 @@
+Program Test;
+{$Description Test for FreePascal Netware-RTL}
+{$Version 1.1.0}
+
+{$I-}
+{$Mode Delphi}
+
+USES Strings, Dos, SysUtils, CRT, Video, Keyboard;
+
+TYPE Str255 = STRING [255];
+
+PROCEDURE ErrorCheck (Action,FN : STRING);
+VAR Err : INTEGER;
+BEGIN
+ Err := IOResult;
+ IF Err = 0 THEN
+ BEGIN
+ WriteLn (' OK');
+ EXIT;
+ END;
+ WriteLn (' ! Error (',Action,' in ',FN,'), IOResult: ',Err);
+ HALT;
+END;
+
+PROCEDURE FileTest;
+CONST TestFN = 'SYS:TEST/TEST.DAT';
+ NumBlocks = 100;
+ BlockSize = 1024;
+VAR F : FILE;
+ Err : LONGINT;
+ Buffer : ARRAY [0..BlockSize-1] OF BYTE;
+ Written: LONGINT;
+ I : BYTE;
+ J : LONGINT;
+BEGIN
+ Write ('Creating ',TestFN);
+ Assign (F,TestFN);
+ ReWrite (F,1);
+ ErrorCheck ('Create',TestFN);
+ FOR I := 1 TO NumBlocks DO
+ BEGIN
+ FillChar (Buffer, SIZEOF (Buffer), CHAR(I));
+ Write ('BlockWrite');
+ BlockWrite (F,Buffer,SIZEOF(Buffer));
+ ErrorCheck ('BlockWrite',TestFN);
+ END;
+ Write ('Seek');
+ Seek (F,0);
+ ErrorCheck ('Seek',TestFN);
+ FOR I := 1 TO NumBlocks DO
+ BEGIN
+ Write ('BlockRead');
+ BlockRead (F,Buffer,SIZEOF(Buffer));
+ ErrorCheck ('BlockRead',TestFN);
+ FOR J := LOW (Buffer) TO HIGH (Buffer) DO
+ IF Buffer[J] <> I THEN
+ BEGIN
+ WriteLn ('Verify-Error');
+ HALT;
+ END;
+ END;
+ Write ('Close');
+ Close (F);
+ ErrorCheck ('Close',TestFN);
+ Write ('Erase');
+ Erase (F);
+ ErrorCheck ('Erase',TestFN);
+END;
+
+PROCEDURE TextFileTest;
+CONST NumLines = 100;
+ FN = 'SYS:TEST/TEST.TXT';
+VAR I : LONGINT;
+ S,S1 : STRING;
+ T : TEXT;
+BEGIN
+ Assign (T,FN);
+ ReWrite (T);
+ ErrorCheck ('ReWrite',FN);
+ FOR I := 1 TO NumLines DO
+ BEGIN
+ Str (I, S);
+ Write ('WriteLn');
+ WriteLn (T, S);
+ ErrorCheck ('WriteLn',FN);
+ END;
+ Write ('Close'); Close (T); ErrorCheck ('Close',FN);
+ Assign (T,FN);
+ Reset (T);
+ ErrorCheck ('Reset',FN);
+ FOR I := 1 TO NumLines DO
+ BEGIN
+ Str (I, S1);
+ Write ('ReadLn');
+ ReadLn (T, S);
+ ErrorCheck ('ReadLn',FN);
+ IF (S <> S1) THEN
+ BEGIN
+ WriteLn ('Verify-Error "',S,'" <> "',S1,'"');
+ HALT;
+ END;
+ END;
+ Write ('Close'); Close (T); ErrorCheck ('Close',FN);
+ Write ('Erase'); Erase (T); ErrorCheck ('Erase',FN);
+END;
+
+
+PROCEDURE MemTest;
+CONST NumBlocks = 1000;
+ BlockSize = 1024;
+VAR I : LONGINT;
+ P : ARRAY [0..NumBlocks-1] OF POINTER;
+BEGIN
+ Write ('GetMem/FreeMem Test');
+ FillChar (P, SIZEOF(P), 0);
+ FOR I := 0 TO NumBlocks-1 DO
+ BEGIN
+ Write ('g');
+ GetMem (P[I],BlockSize);
+ FillChar (P[I]^,BlockSize,$FF);
+ END;
+ FOR I := 0 TO NumBlocks-1 DO
+ BEGIN
+ Write ('f');
+ FreeMem (P[I],BlockSize);
+ END;
+ WriteLn (' Ok');
+END;
+
+PROCEDURE DosTest;
+VAR Year, Month, Day, DayVal, hour, Minute, Second, Sec100 : WORD;
+BEGIN
+ GetDate (Year,Month, Day, DayVal);
+ WriteLn ('GetDate: ',Year,'/',Month,'/',Day);
+ GetTime (hour, Minute, Second, Sec100);
+ WriteLn ('GetTime: ',Hour,':',Minute,':',Second,':',Sec100);
+END;
+
+PROCEDURE ExceptTest;
+BEGIN
+ TRY
+ WriteLn ('Raising Exception');
+ Raise (Exception.Create (''));
+ EXCEPT
+ WriteLn ('Fine, Except-Handler called');
+ END;
+END;
+
+{PROCEDURE ReadDirTest;
+VAR EntryH, DirH : PNWDirEnt;
+ T : DateTime;
+BEGIN
+ DirH := _opendir ('SYS:TEST/*.*');
+ IF DirH <> NIL THEN
+ BEGIN
+ EntryH := _readdir (DirH);
+ WHILE (EntryH <> NIL) DO
+ BEGIN
+ unpacktime (EntryH^.d_time + (LONGINT (EntryH^.d_date) SHL 16),T);
+ WriteLn ('Name: "', EntryH^.d_nameDOS,'" size:',EntryH^.d_size,' namespace-name: "',EntryH^.d_name,'" ',T.Day,'.',T.Month,'.',T.Year,' ',T.Hour,':',T.Min,':',T.Sec);
+ EntryH := _readdir (DirH);
+ END;
+ _closedir (DirH);
+ END ELSE
+ WriteLn ('opendir failed');
+END;}
+
+
+PROCEDURE FindTest;
+VAR f : Dos.SearchRec;
+ t : Dos.DateTime;
+ s : string [5];
+ fh: FILE;
+ time: LONGINT;
+ attr: word;
+BEGIN
+ Dos.FindFirst ('SYS:TEST\*.*',anyfile,f);
+ WHILE Dos.DosError = 0 DO
+ BEGIN
+ unpacktime (f.time,t);
+ IF f.attr AND directory <> 0 THEN
+ S := '<DIR>'
+ ELSE
+ S := '';
+ WriteLn (f.Name:15,f.attr:6,S:6,f.size:6,' ',t.Month:2,'/',t.day:2,'/',t.year,' ',t.hour:2,':',t.min:2,':',t.sec:2);
+ Dos.FindNext (f);
+ END;
+ Dos.FindClose (f);
+ {WriteLn ('Directories:');
+ Dos.FindFirst ('SYS:SYSTEM\*.*',directory,f);
+ WHILE Dos.DosError = 0 DO
+ BEGIN
+ WriteLn (f.Name:15);
+ Dos.FindNext (f);
+ END;
+ Dos.FindClose (f);}
+ WriteLn;
+ Assign (FH,ParamStr(0));
+ Reset (FH,1);
+ ErrorCheck ('Reset',ParamStr(0));
+ Getftime (FH, time);
+ Getfattr (FH, attr);
+ Close (FH);
+ unpacktime (time,t);
+ WriteLn (ParamStr(0),attr:6,' ',t.Month:2,'/',t.day:2,'/',t.year,' ',t.hour:2,':',t.min:2,':',t.sec:2);
+ WriteLn ('GetEnv (XX): "',GetEnv ('XX'),'"');
+END;
+
+{PROCEDURE VolInfo;
+VAR I : LONGINT;
+ Buf: ARRAY [0..255] OF CHAR;
+ TotalBlocks : WORD;
+ SectorsPerBlock : WORD;
+ availableBlocks : WORD;
+ totalDirectorySlots : WORD;
+ availableDirSlots : WORD;
+ volumeisRemovable : WORD;
+ Err : LONGINT;
+BEGIN
+ WriteLn ('Number of Volumes: ',_GetNumberOfVolumes);
+ FOR I := 0 TO _GetNumberOfVolumes-1 DO
+ BEGIN
+ _GetVolumeName (I,@Buf);
+ WriteLn (I,': "',Buf,'"');
+ Err := _GetVolumeInfoWithNumber (I,@Buf,
+ TotalBlocks,
+ SectorsPerBlock,
+ availableBlocks,
+ totalDirectorySlots,
+ availableDirSlots,
+ volumeisRemovable);
+ IF Err = 0 THEN
+ BEGIN
+ WriteLn ('TotalBlocks: ',TotalBlocks,' Sectors/Block: ',SectorsPerBlock,' avail: ',availableBlocks);
+ END ELSE
+ WriteLn ('Err: ',Err);
+ END;
+ FOR I := 0 TO 5 DO
+ BEGIN
+ WriteLn ('DiskFree(',I,'): ',Dos.DiskFree(I));
+ WriteLn ('DiskSize(',I,'): ',Dos.DiskSize(I));
+ END;
+
+END;}
+
+PROCEDURE CrtTest;
+VAR C : CHAR;
+ I : INTEGER;
+
+ PROCEDURE KeyTest;
+ VAR C : CHAR;
+ BEGIN
+ WriteLn ('Key-Test, CR will be converted to ausgegeben, End with ESC');
+ Repeat
+ C := ReadKey;
+ CASE C OF
+ #0 : Write ('#0');
+ #13: Write (#13#10)
+ ELSE Write (C);
+ END;
+ Until C = #27;
+ END;
+
+ PROCEDURE FillScreen;
+ VAR I : INTEGER;
+ BEGIN
+ ClrScr;
+ TextColor (Green);
+ FOR I := 1 TO 24 DO
+ Write ('12345678901234567890123456789012345678901234567890123456789012345678901234567890');
+ TextColor (Yellow);
+ FOR I := 1 TO 25 DO
+ BEGIN
+ GotoXY (76,I); Write (' ',I,' ');
+ END;
+ TextColor (LightGray);
+ END;
+
+BEGIN
+ {GotoXY (1,1); writeln ('Text @ 1,1');
+ GotoXY (2,2); writeln ('Text @ 2,2');
+ GotoXY (3,3); writeln ('Text @ 3,3');
+ GotoXY (4,4); writeln ('Text @ 4,4, Delay 5 Secs');
+ GotoXY (1,1);
+ IF WhereX <> 1 THEN
+ BEGIN
+ GotoXY (1,10); Write ('WhereX - ERROR');
+ END;
+ GotoXY (1,1);
+ IF WhereY <> 1 THEN
+ BEGIN
+ GotoXY (1,11); Write ('WhereY - ERROR');
+ END;
+
+ Delay (1000);
+ }
+ ClrScr;
+
+ WriteLn ('Empty Screen ');
+ Delay (1000);
+ WriteLn ('Cursoroff '); CursorOff;
+ Delay (1000);
+ WriteLn ('Cursorbig '); CursorBig;
+ Delay (1000);
+ WriteLn ('Cursoron '); CursorOn;
+ LowVideo; Write ('Low '); HighVideo; Write ('High '); LowVideo; Write ('Low ');
+ Delay (1000);
+ KeyTest;
+ FillScreen;
+ Window (10,10,40,15);
+ ClrScr; Write ('Window 10,10,20,15');
+ KeyTest;
+ Window (1,1,80,25);
+ FillScreen;
+ GotoXY (10,10); ClrEol;
+ GotoXY (1,21); Write (' ClrEol @ 10,10 ');
+ ReadKey;
+ FillScreen;
+ GotoXY (10,10); InsLine;
+ GotoXY (1,21); Write (' Insline @ 10,10 ');
+ ReadKey;
+ Write ('Waiting for keypress: ');
+ WHILE NOT Keypressed DO
+ BEGIN
+ Delay (500);
+ END;
+ Write ('OK'); ReadKey;
+ FOR I := 1 TO 5 DO
+ BEGIN
+ Write (^G); Delay (200);
+ END;
+
+
+ Delay (1000);
+ GotoXY (1,25); ClrEol;
+END;
+
+{
+Function FileSetDate (Handle,Age : Longint) : Longint;
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+}
+PROCEDURE SysUtilsTest;
+VAR H,I,Attr : LONGINT;
+ X : ARRAY [0..255] OF CHAR;
+ TD: TDateTime;
+ SR: TSearchRec;
+ ST1,ST2: STRING;
+BEGIN
+ WriteLn ('FileExists SYS:SYSTEM/CLIB.NLM: ',FileExists ('SYS:SYSTEM/CLIB.NLM'));
+ WriteLn ('FileExists SYS:SYSTEM\CLIB.NLM: ',FileExists ('SYS:SYSTEM\CLIB.NLM'));
+ WriteLn ('FileExists SYS:SYSTEM/CLIB.N: ',FileExists ('SYS:SYSTEM/CLIB.N'));
+ WriteLn ('FileExists SYS:SYSTEM\CLIB.N: ',FileExists ('SYS:SYSTEM\CLIB.N'));
+ WriteLn ('FileExists SYS:SYSTEM: ',FileExists ('SYS:SYSTEM\CLIB.N'));
+
+ H := FileOpen ('SYS:TEST/Autoexec.ncf',0);
+ IF H >= 0 THEN
+ BEGIN
+ I := FileRead (H, X, 20); X[20] := #0;
+ WriteLn ('FileRead returned ',I,' Buffer: "',X,'"');
+ END ELSE
+ WriteLn ('FileOpen failed');
+ FileClose (H);
+
+ H := FileAge ('SYS:SYSTEM/CLIB.NLM');
+ TD := FileDateToDateTime (H);
+ WriteLn ('CLIBs file date: ',DateTimeToStr (TD));
+ H := FileAge ('SYS:SYSTEM/DSREPAIR.LOG');
+ TD := FileDateToDateTime (H);
+ WriteLn ('DSREPAIR.LOGs file date: ',DateTimeToStr (TD));
+ H := SysUtils.FindFirst ('SYS:SYSTEM/CLIB.nlm',faAnyFile,SR);
+ IF H = 0 THEN
+ BEGIN
+ WriteLn (SR.Name:20,SR.Size:6,' ',DateTimeToStr (FileDateToDateTime (SR.time)):20,' ',hexstr (SR.attr,8));
+ END ELSE WriteLn ('FindFirst failed');
+ FindClose (SR);
+
+ H := SysUtils.FindFirst ('SYS:SYSTEM/CLIB.N',faAnyFile,SR);
+ IF H = 0 THEN
+ WriteLn ('FindFirst on non existing file returned 0 !');
+ FindClose (SR);
+
+ H := SysUtils.FindFirst ('SYS:SYSTEM/DSREPAIR.LOG',faAnyFile,SR);
+ IF H = 0 THEN
+ BEGIN
+ WriteLn (SR.Name:20,SR.Size:6,' ',DateTimeToStr (FileDateToDateTime (SR.time)):20,' ',hexstr (SR.attr,8));
+ END ELSE WriteLn ('FindFirst failed');
+ FindClose (SR);
+
+ H := FileOpen ('SYS:SYSTEM/DSRepair.log',0);
+ IF H >= 0 THEN
+ BEGIN
+ I := FileGetDate (H);
+ FileClose (H);
+ TD := FileDateToDateTime (I);
+ WriteLn ('DSREPAIR.LOGs file date via FileGetDate: ',DateTimeToStr (TD));
+ END ELSE WriteLn ('FileOpen failed');
+ Attr := FileGetAttr ('SYS:SYSTEM/CLIB.NLM');
+ WriteLn ('Attr of clib: ',hexstr (Attr,8));
+
+ chdir ('sys:test');
+ H := FileCreate ('TEST12.DAT');
+ IF H >= 0 THEN
+ BEGIN
+ IF NOT FileExists ('SYS:TEST/TEST12.DAT') THEN
+ WriteLn ('FileCreate returned ok but FileExists returned false !');
+ FillChar (X,SIZEOF(X),BYTE('X'));
+ I := FileWrite (H,X,SIZEOF(X));
+ WriteLn ('FileWrite returned ',I);
+ IF I = SIZEOF (X) THEN
+ BEGIN
+ IF NOT FileTruncate (H,SIZEOF(X) DIV 2) THEN
+ WriteLn ('FileTruncate failed');
+ END;
+ FileClose (H);
+
+ I := SysUtils.FindFirst ('TEST12.DAT',faAnyFile,SR);
+ IF I <> 0 THEN
+ WriteLn ('FindFirst failed')
+ ELSE
+ IF SR.Size <> (SIZEOF (X) DIV 2) THEN
+ WriteLn ('FileTruncate: wrong FileSize after truncate (',SR.Size,')');
+ FindClose (SR);
+
+ IF NOT RenameFile ('TEST12.DAT','TEST12.BAK') THEN
+ WriteLn ('RenameFile failed')
+ ELSE
+ BEGIN
+ IF NOT FileExists ('SYS:TEST/TEST12.BAK') THEN
+ WriteLn ('FileRename returned ok but FileExists returned false');
+ IF NOT DeleteFile ('TEST12.BAK') THEN
+ WriteLn ('DeleteFile failed')
+ ELSE
+ IF FileExists ('SYS:TEST/TEST12.BAK') THEN
+ WriteLn ('DeleteFile returned ok but FileExists returned true');
+ END;
+
+ END ELSE WriteLn ('FileCreate failed');
+
+ H := FileCreate ('TEST12.DAT');
+ IF H >= 0 THEN
+ BEGIN
+ FillChar (X,SIZEOF(X),BYTE('X'));
+ FileWrite (H,X,SIZEOF(X));
+ I := FileSeek (H,10,fsFromBeginning);
+ X[0] := '0';
+ FileWrite (H,X,1);
+ IF I <> 10 THEN WriteLn ('FileSeek returned wrong result at 10 (',I,')');
+ I := FileSeek (H,10,fsFromCurrent);
+ X[0] := '1';
+ FileWrite (H,X,1);
+ IF I <> 21 THEN WriteLn ('FileSeek returned wrong result at 21 (',I,')');
+ I := FileSeek (H,-10,fsFromEnd);
+ X[0] := '2';
+ FileWrite (H,X,1);
+ IF I <> SIZEOF(X)-10 THEN WriteLn ('FileSeek returned wrong result at End-10 (',I,')');
+ FileClose (H);
+ END ELSE WriteLn ('FileCreate failed');
+
+ ST1 := 'SYS:ETC;SYS:TEST;SYS:SYSTEM/;SYS:PUBLIC';
+ ST2 := FileSearch ('clib.nlm',ST1);
+ WriteLn ('FileSearch (clib.nlm,',ST1,') returned "',ST2,'"');
+ WriteLn ('FExpand (TEST12.DAT): "',FExpand ('TEST12.DAT'));
+ WriteLn ('FExpand (.\TEST12.DAT): "',FExpand ('.\TEST12.DAT'));
+ WriteLn ('FExpand (..\SYSTEM\CLIB.NLM): "',FExpand ('..\SYSTEM\CLIB.NLM'));
+
+END;
+
+
+PROCEDURE VideoTest;
+
+ PROCEDURE WriteString (S : STRING; X,Y : WORD; Fore,Back: BYTE);
+ VAR I : INTEGER;
+ W : WORD;
+ P : POINTER;
+ Textattr : WORD;
+ BEGIN
+ W := X + (Y * Video.ScreenWidth);
+ P := Pointer (@VideoBuf^[W]);
+ TextAttr := (Fore and $f) or (Back shl 4);
+ FOR I := 1 TO Length (S) DO
+ BEGIN
+ W := (TextAttr SHL 8) or byte (S[I]);
+ PWord(P)^ := w;
+ INC (PChar(P),2);
+ END;
+ END;
+
+BEGIN
+ InitVideo;
+ Video.ClearScreen;
+ WriteString ('Test @ 0,0, LightGray on Black',0,0,LightGray,Black);
+ UpdateScreen (false);
+ WriteString ('Test @ 10,1, Yellow on Blue',1,1,Yellow,Blue);
+ UpdateScreen (false);
+ ReadKey;
+ Video.ClearScreen;
+ WriteString ('Cursor crHidden',0,0,Yellow,Blue);
+ SetCursorPos (0,0);
+ SetCursorType (crHidden);
+ UpdateScreen (false);
+ ReadKey;
+
+ Video.ClearScreen;
+ WriteString ('Cursor crUnderLine',0,0,Yellow,Blue);
+ SetCursorPos (0,0);
+ SetCursorType (crUnderLine);
+ UpdateScreen (false);
+ ReadKey;
+
+ Video.ClearScreen;
+ WriteString ('Cursor crBlock',0,0,Yellow,Blue);
+ SetCursorPos (0,0);
+ SetCursorType (crBlock);
+ UpdateScreen (false);
+ ReadKey;
+
+ Video.ClearScreen;
+ WriteString ('Cursor crHalfBlock',0,0,Yellow,Blue);
+ SetCursorPos (0,0);
+ SetCursorType (crHalfBlock);
+ UpdateScreen (false);
+ ReadKey;
+
+ CRT.ClrScr;
+ SetCursorType (crUnderLine);
+END;
+
+PROCEDURE KeyboardTest;
+VAR T : TKeyEvent;
+BEGIN
+ InitKeyboard;
+ WriteLn ('Keyboard-Test, ESC Ends');
+ REPEAT
+ T := GetKeyEvent;
+ WriteLn (' Event: ',HexStr (T,8),' EventChar: "',GetKeyEventChar(T),'" KeyEventCode: ',HexStr (GetKeyEventCode(T),8));
+ T := TranslateKeyEvent (T);
+ WriteLn ('Translated Event: ',HexStr (T,8),' EventChar: "',GetKeyEventChar(T),'" KeyEventCode: ',HexStr (GetKeyEventCode(T),8));
+ WriteLn;
+ UNTIL GetKeyEventChar (T) = #27;
+END;
+
+
+VAR I : LONGINT;
+ S : STRING [255];
+ C : CHAR;
+ P : ^Str255;
+BEGIN
+ New (P);
+ Dispose (P);
+ // WriteLn ('Test');
+ //__ConsolePrintf ('Ok, this is PASCALMAIN'#13#10,0);
+ WriteLn ('Test via WriteLn');
+ WriteLn ('No of params: ', ParamCount);
+ //__EnterDebugger;
+ WriteLn ('ParamStr(0): "', ParamStr(0),'"');
+ IF ParamCount > 0 THEN
+ FOR I := 1 TO ParamCount DO
+ WriteLn (I:6,': "',ParamStr(I),'"');
+ GetDir (0, S);
+ WriteLn ('Current Directory: "',S,'"');
+// ChDir ('TEST');
+// GetDir (0, S);
+// WriteLn ('Current Directory: "',S,'"');
+// MkDir ('SYS:TEST');
+// IF IOResult <> 0 THEN WriteLn ('MkDir SYS:TEST failed (Ok)');
+// Write ('MkDir'); MkDir ('SYS:TEST/TESTDIR');
+// ErrorCheck ('MkDir','SYS:TEST/TESTDIR');
+// Write ('RmDir'); RmDir ('SYS:TEST/TESTDIR');
+// ErrorCheck ('RmDir','SYS:TEST/TESTDIR');
+
+ REPEAT
+ WriteLn;
+ WriteLn ('1 : File-Test');
+ WriteLn ('2 : Textfile-Test');
+ WriteLn ('3 : GetMem/FreeMem Test');
+ WriteLn ('4 : DosTest');
+ WriteLn ('5 : ExceptTest');
+ WriteLn ('6 : Video-Test');
+ WriteLn ('7 : Find-Test');
+ WriteLn ('8 : SysUtils-Test');
+ WriteLn ('9 : CrtTest');
+ WriteLn ('K : Keyboard-Test');
+ WriteLn ('E : Ende');
+ WriteLn;
+ Write ('?: ');
+ C := Crt.ReadKey;
+ WriteLn (C);
+ CASE upcase(C) OF
+ '1' : FileTest;
+ '2' : TextfileTest;
+ '3' : MemTest;
+ '4' : DosTest;
+ '5' : ExceptTest;
+ '6' : VideoTest;
+ '7' : FindTest;
+ '8' : SysUtilsTest;
+ '9' : CrtTest;
+ 'K' : KeyboardTest;
+ END;
+ UNTIL UpCase (C) = 'E';
+ (*$IFDEF Netware*)
+ PressAnyKeyToContinue;
+ (*$ENDIF*)
+END.
diff --git a/rtl/netware/threads.imp b/rtl/netware/threads.imp
new file mode 100644
index 0000000000..65014c7632
--- /dev/null
+++ b/rtl/netware/threads.imp
@@ -0,0 +1,2 @@
+ ThreadsGlobals
+
diff --git a/rtl/netware/tli.imp b/rtl/netware/tli.imp
new file mode 100644
index 0000000000..39a277e0b8
--- /dev/null
+++ b/rtl/netware/tli.imp
@@ -0,0 +1,32 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ t_accept,
+ t_alloc,
+ t_bind,
+ t_blocking,
+ t_close,
+ t_connect,
+ t_error,
+ t_free,
+ t_getinfo,
+ t_getstate,
+ t_listen,
+ t_look,
+ t_nonblocking,
+ t_open,
+ t_optmgmt,
+ t_rcv,
+ t_rcvconnect,
+ t_rcvdis,
+ t_rcvudata,
+ t_rcvuderr,
+ t_rcvrel,
+ t_snd,
+ t_snddis,
+ t_sndrel,
+ t_sndudata,
+ t_sync,
+ t_unbind,
+ t_errlist,
+ t_nerr
+
diff --git a/rtl/netware/tthread.inc b/rtl/netware/tthread.inc
new file mode 100644
index 0000000000..7a0f56c3a9
--- /dev/null
+++ b/rtl/netware/tthread.inc
@@ -0,0 +1,268 @@
+{
+ $Id: tthread.inc,v 1.5 2005/02/25 21:41:09 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 2003-2004 Armin Diehl, member of the Free Pascal
+ development team
+
+ Netware clib TThread implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+type
+ PThreadRec=^TThreadRec;
+ TThreadRec=record
+ thread : TThread;
+ next : PThreadRec;
+ end;
+
+var
+ ThreadRoot : PThreadRec;
+ ThreadsInited : boolean;
+ DisableRemoveThread : boolean;
+
+Const
+ ThreadCount: longint = 0;
+
+{function ThreadSelf:TThread;
+var
+ hp : PThreadRec;
+ sp : longint;
+begin
+ sp:=SPtr;
+ hp:=ThreadRoot;
+ while assigned(hp) do
+ begin
+ if (sp<=hp^.Thread.FStackPointer) and
+ (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+ begin
+ Result:=hp^.Thread;
+ exit;
+ end;
+ hp:=hp^.next;
+ end;
+ Result:=nil;
+end;}
+
+
+procedure InitThreads;
+begin
+ ThreadRoot:=nil;
+ ThreadsInited:=true;
+ DisableRemoveThread:=false;
+end;
+
+{DoneThreads will terminate all remaining threads}
+procedure DoneThreads;
+var
+ hp,next : PThreadRec;
+begin
+ DisableRemoveThread := true; {to avoid that Destroy calling RemoveThread modifies Thread List}
+ while assigned(ThreadRoot) do
+ begin
+ ThreadRoot^.Thread.Destroy;
+ hp:=ThreadRoot;
+ ThreadRoot:=ThreadRoot^.Next;
+ dispose(hp);
+ {$ifdef DEBUG_MT}
+ ConsolePrintf(#13'DoneThreads: called destroy, remaining threads: %d ThreadRoot: %x'#13#10,ThreadCount,longint(ThreadRoot));
+ {$endif}
+ end;
+ ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+ hp : PThreadRec;
+begin
+ { Need to initialize threads ? }
+ if not ThreadsInited then
+ InitThreads;
+
+ { Put thread in the linked list }
+ new(hp);
+ hp^.Thread:=t;
+ hp^.next:=ThreadRoot;
+ ThreadRoot:=hp;
+
+ inc(ThreadCount);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+ lasthp,hp : PThreadRec;
+begin
+ if not DisableRemoveThread then {disabled while in DoneThreads}
+ begin
+ hp:=ThreadRoot;
+ lasthp:=nil;
+ while assigned(hp) do
+ begin
+ if hp^.Thread=t then
+ begin
+ if assigned(lasthp) then
+ lasthp^.next:=hp^.next
+ else
+ ThreadRoot:=hp^.next;
+ dispose(hp);
+ Dec(ThreadCount);
+ if ThreadCount = 0 then ThreadsInited := false;
+ exit;
+ end;
+ lasthp:=hp;
+ hp:=hp^.next;
+ end;
+ end else
+ dec(ThreadCount);
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;
+var
+ FreeThread: Boolean;
+ Thread : TThread absolute args;
+begin
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ ThreadProc := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then
+ begin
+ Thread.Destroy;
+ Thread.Free;
+ end;
+ EndThread(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: Integer;
+begin
+ inherited Create;
+ AddThread(self);
+ FSuspended := CreateSuspended;
+ { Create new thread }
+ FHandle := BeginThread (@ThreadProc,pointer(self));
+ if FSuspended then Suspend;
+ FThreadID := FHandle;
+ FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished then
+ begin
+ Terminate;
+ if Suspended then
+ ResumeThread (FHandle); {netware can not kill a thread, the thread has to}
+ {leave it's execute routine if terminated is true}
+ WaitFor; {wait for the thread to terminate}
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread(self); {remove it from the list of active threads}
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+
+const
+ Priorities: array [TThreadPriority] of Integer =
+ (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
+ THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
+ THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+ SuspendThread (FHandle);
+ FSuspended := true;
+end;
+
+
+procedure TThread.Resume;
+begin
+ ResumeThread (FHandle);
+ FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+ ThreadSwitch;
+end;
+
+
+function TThread.WaitFor: Integer;
+begin
+ Result := WaitForThreadTerminate (FHandle,0);
+ if Result = 0 then
+ FHandle := 0;
+end;
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.5 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/unicode.imp b/rtl/netware/unicode.imp
new file mode 100644
index 0000000000..065595267b
--- /dev/null
+++ b/rtl/netware/unicode.imp
@@ -0,0 +1,56 @@
+# $Id: unicode.imp,v 1.3 2005/01/05 22:44:24 armin Exp $
+ xlate_error,
+ uprintf,
+ unitok,
+ unistr,
+ unispn,
+ unisize,
+ uniset,
+ unirev,
+ unirchr,
+ unipcpy,
+ unipbrk,
+ uninset,
+ uninlen,
+ uninicmp,
+ unincpy,
+ unincmp,
+ unincat,
+ unilen,
+ uniindex,
+ uniicmp,
+ unicspn,
+ unicpy,
+ unicode_to_upper,
+ unicode_to_title,
+ unicode_to_lower,
+ unicode_to_byte,
+ unicmp,
+ unichr,
+ unicat,
+ get_xlate_info,
+ byte_to_unicode,
+ auxiliary_xlate,
+ UnloadRules,
+ UnicodeToLocal,
+ UnicodeToKeyword,
+ OverrideDefaultRules,
+ NWUnloadRuleTable,
+ NWUnicodeToMonocase,
+ NWUnicodeToLocal,
+ NWUnicodeToCollation,
+ NWUnicodeCompare,
+ NWLocalToUnicode,
+ NWLoadRuleTable,
+ NWLSetPrimaryUnicodeSearchPath,
+ NWInitUnicodeTables,
+ NWGetUnicodeToLocalHandle,
+ NWGetMonocaseHandle,
+ NWGetLocalToUnicodeHandle,
+ NWGetCollationHandle,
+ NWFreeUnicodeTables,
+ MonoCase,
+ LocalToUnicode,
+ LoadRules,
+ KeywordToUnicode,
+ FlushRulesTables
diff --git a/rtl/netware/varutils.pp b/rtl/netware/varutils.pp
new file mode 100644
index 0000000000..ce39ed6774
--- /dev/null
+++ b/rtl/netware/varutils.pp
@@ -0,0 +1,47 @@
+{
+ $Id: varutils.pp,v 1.3 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netware/video.pp b/rtl/netware/video.pp
new file mode 100644
index 0000000000..9a7dbc37c8
--- /dev/null
+++ b/rtl/netware/video.pp
@@ -0,0 +1,198 @@
+{
+ $Id: video.pp,v 1.5 2004/10/03 20:16:43 armin Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Video unit for netware
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ 2001/04/16 armin: first version for netware
+ 2002/02/26 armin: changes for current fpc }
+unit Video;
+interface
+
+{$i videoh.inc}
+
+implementation
+
+uses
+ dos;
+
+{$i video.inc}
+{$i nwsys.inc}
+
+var
+ MaxVideoBufSize : DWord;
+ VideoBufAllocated: boolean;
+
+
+procedure SysInitVideo;
+VAR height,width : WORD;
+ startline, endline : BYTE;
+begin
+ DoneVideo;
+ ScreenColor:= (_IsColorMonitor <> 0);
+ _GetSizeOfScreen (height, width);
+ ScreenWidth := width;
+ ScreenHeight:= height;
+
+ { TDrawBuffer only has FVMaxWidth elements
+ larger values lead to crashes }
+ if ScreenWidth> FVMaxWidth then
+ ScreenWidth:=FVMaxWidth;
+
+ CursorX := _wherex;
+ CursorY := _wherey;
+ _GetCursorShape (startline,endline);
+ {if not ConsoleCursorInfo.bvisible then
+ CursorLines:=0
+ else
+ CursorLines:=ConsoleCursorInfo.dwSize;}
+
+ { allocate back buffer }
+ MaxVideoBufSize:= ScreenWidth * ScreenHeight * 2;
+ VideoBufSize := ScreenWidth * ScreenHeight * 2;
+
+ LockUpdateScreen := 0;
+end;
+
+
+procedure SysDoneVideo;
+begin
+ SetCursorType(crUnderLine);
+end;
+
+
+function SysGetCapabilities: Word;
+begin
+ SysGetCapabilities:=cpColor or cpChangeCursor;
+end;
+
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+begin
+ _GotoXY (NewCursorX, NewCursorY);
+end;
+
+
+function SysGetCursorType: Word;
+var startline, endline : byte;
+begin
+ _GetCursorShape (startline, endline);
+ CASE startline of
+ 1 : SysGetCursorType := crBlock;
+ 5 : SysGetCursorType := crHalfBlock
+ ELSE
+ SysGetCursorType := crUnderline;
+ END;
+ {crHidden ?}
+end;
+
+
+procedure SysSetCursorType(NewType: Word);
+begin
+ if newType=crHidden then
+ _HideInputCursor
+ else
+ begin
+ case NewType of
+ crUnderline:
+ _SetCursorShape (9,$A);
+ crHalfBlock:
+ _SetCursorShape (5,$A);
+ crBlock:
+ _SetCursorShape (1,$A);
+ end;
+ _DisplayInputCursor;
+ end;
+end;
+
+
+{procedure ClearScreen;
+begin
+ FillWord(VideoBuf^,VideoBufSize div 2,$0720);
+ UpdateScreen(true);
+end;}
+
+
+procedure SysUpdateScreen(Force: Boolean);
+begin
+ if VideoBuf = nil then exit;
+ if (LockUpdateScreen<>0) or (VideoBufSize = 0) then
+ exit;
+ if not force then
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl VideoBuf,%esi
+ movl OldVideoBuf,%edi
+ movl VideoBufSize,%ecx
+ shrl $2,%ecx
+ repe
+ cmpsl
+ setne force
+ popl %edi
+ popl %esi
+ end;
+ end;
+ if Force then
+ _CopyToScreenMemory (ScreenHeight, ScreenWidth, VideoBuf, 0, 0);
+end;
+
+
+Const
+ SysVideoModeCount = 1;
+ SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+ (Col: 80; Row : 25; Color : True));
+
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
+begin
+ SysSetVideoMode := ((Mode.Col = 80) AND (Mode.Row = 25) AND (Mode.Color));
+end;
+
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+begin
+ SysGetVideoModeData:=(Index<=SysVideoModeCount);
+ If SysGetVideoModeData then
+ Data:=SysVMD[Index];
+end;
+
+Function SysGetVideoModeCount : Word;
+
+begin
+ SysGetVideoModeCount:=SysVideoModeCount;
+end;
+
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities
+);
+
+
+
+initialization
+ VideoBufAllocated := false;
+ VideoBufSize := 0;
+ VideoBuf := nil;
+ SetVideoDriver (SysVideoDriver);
+end.
+
diff --git a/rtl/netware/vollib.imp b/rtl/netware/vollib.imp
new file mode 100644
index 0000000000..d8bde43870
--- /dev/null
+++ b/rtl/netware/vollib.imp
@@ -0,0 +1,31 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ NWVL_Start,
+ NWVL_End,
+ NWVL_ScanForVolumes,
+ NWVL_GetNextVolume,
+ NWVL_GetMirrorObjectFirstSegment,
+ NWVL_GetNextSegment,
+ NWVL_GetSegmentInfo,
+ NWVL_GetVolumeFirstSegment,
+ NWVL_CreateANewVolume,
+ NWVL_EnlargeVolume,
+ NWVL_DeleteAVolume,
+ NWVL_ChangeVolumeName,
+ NWVL_ChangeSegmentName,
+ NWVL_DeleteSegment,
+ NWVL_IsVolumeMounted,
+ NWVL_MountVolume,
+ NWVL_DismountVolume,
+ NWVL_SetOrGetVolumeControlInfo,
+ NWVL_ValidateVolumeName,
+ NWVL_GetDefaultBlockSizeAndControlFlags,
+ NWVL_GetMirrorObjectSupportedLimits,
+ NWVL_GetSupportedLimits,
+ NWVL_LocalToUnicode,
+ NWVL_UnicodeToLocal,
+ NWVL_Nuint32ToQuad,
+ NWVL_QuadToNuint32,
+ NWVL_ConvertMirrorObjectToLogicalPartition,
+ NWVL_ConvertLogicalPartitionToMirrorObject
+
diff --git a/rtl/netware/winsock.pp b/rtl/netware/winsock.pp
new file mode 100644
index 0000000000..c42bb51fd8
--- /dev/null
+++ b/rtl/netware/winsock.pp
@@ -0,0 +1,2446 @@
+{
+ $Id: winsock.pp,v 1.6 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the declarations for the WinSock2
+ Socket Library for Netware and Win32
+
+ Copyright (c) 1999-2003 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ************************************************************************
+ For NetWare 4.11 you have to install winsock-support (i.e. nw4wsock.exe)
+ NetWare >= 5.0 contains winsock support by default
+ ************************************************************************}
+
+{$PACKRECORDS 1}
+{$R-}
+
+unit winsock;
+
+{$mode objfpc}
+
+ interface
+
+ const
+ {
+ Default maximium number of sockets.
+ this does not mean that the underlying netware
+ Sockets implementation has to support that many!
+ }
+ FD_SETSIZE = 64;
+
+ type
+ tOS_INT = LongInt;
+ tOS_UINT = DWord;
+ ptOS_INT = ^tOS_INT;
+ ptOS_UINT = ^tOS_UINT;
+
+ u_char = char;
+ u_short = word;
+ u_int = tOS_UINT;
+ u_long = dword;
+ pu_long = ^u_long;
+ pu_short = ^u_short;
+ plongint = ^longint;
+ TSocket = longint;
+ BOOL = boolean;
+ LPINT = ^integer;
+ LPDWORD = ^dword;
+ {$ifdef netware}
+ OVERLAPPED = record
+ Internal : DWORD;
+ InternalHigh: DWORD;
+ Offset : DWORD;
+ OffsetHigh : DWORD;
+ hEvent : THandle;
+ end;
+ LPOVERLAPPED = ^OVERLAPPED;
+ TOVERLAPPED = OVERLAPPED;
+ POVERLAPPED = ^OVERLAPPED;
+ {$endif}
+ PHandle = ^THandle;
+ TWSAOVERLAPPED= OVERLAPPED;
+ PWSAOVERLAPPED= ^OVERLAPPED;
+ TWSAEVENT = THandle;
+ PWSAEVENT = ^THandle;
+
+ { there is already a procedure called FD_SET, so this
+ record was renamed (FK) }
+ fdset = record
+ fd_count : u_int;
+ fd_array : array[0..(FD_SETSIZE)-1] of TSocket;
+ end;
+
+ TFDSet = fdset;
+ PFDSet = ^fdset;
+
+ timeval = record
+ tv_sec : longint;
+ tv_usec : longint;
+ end;
+
+ TTimeVal = timeval;
+ PTimeVal = ^TTimeVal;
+
+ const
+ IOCPARM_MASK = $7f;
+ IOC_VOID = $20000000;
+ IOC_OUT = $40000000;
+ IOC_IN = $80000000;
+ IOC_INOUT = IOC_IN or IOC_OUT;
+ FIONREAD = IOC_OUT or
+ ((4 and IOCPARM_MASK) shl 16) or
+ (102 shl 8) or 127;
+ FIONBIO = IOC_IN or
+ ((4 and IOCPARM_MASK) shl 16) or
+ (102 shl 8) or 126;
+ FIOASYNC = IOC_IN or
+ ((4 and IOCPARM_MASK) shl 16) or
+ (102 shl 8) or 125;
+ {
+ Structures returned by network data base library, taken from the
+ BSD file netdb.h. All addresses are supplied in host order, and
+ returned in network order (suitable for use in system calls).
+ Slight modifications for differences between Linux and winsock.h
+ }
+ type
+ hostent = record
+ { official name of host }
+ h_name: pchar;
+ { alias list }
+ h_aliases: ^pchar;
+ { host address type }
+ h_addrtype: SmallInt;
+ { length of address }
+ h_length: SmallInt;
+ { list of addresses }
+ case byte of
+ 0: (h_addr_list: ^pchar);
+ 1: (h_addr: ^pchar)
+ end;
+ THostEnt = hostent;
+ PHostEnt = ^THostEnt;
+
+ {
+ Assumption here is that a network number
+ fits in an unsigned long -- someday that won't be true!
+ }
+ netent = record
+ n_name : ^char; // official name of net
+ n_aliases : ^pchar; // alias list
+ n_addrtype : SmallInt; // net address type
+ n_pad1 : SmallInt; // ensure right packaging
+ n_net : u_long; // network #
+ end;
+ TNetEnt = netent;
+ PNetEnt = ^TNetEnt;
+
+ servent = record
+ { official service name }
+ s_name : ^char;
+ { alias list }
+ s_aliases : ^pchar;
+ { port # }
+ s_port : SmallInt;
+ n_pad1 : SmallInt; { ensure right packaging }
+ { protocol to use }
+ s_proto : ^char;
+ end;
+ TServEnt = servent;
+ PServEnt = ^TServEnt;
+
+ protoent = record
+ { official protocol name }
+ p_name : ^char;
+ { alias list }
+ p_aliases : ^pchar;
+ { protocol # }
+ p_proto : SmallInt;
+ p_pad1 : SmallInt; { ensure packaging }
+ end;
+ TProtoEnt = protoent;
+ PProtoEnt = ^TProtoEnt;
+
+ const
+ {
+ Standard well-known IP protocols.
+ For some reason there are differences between Linx and winsock.h
+ }
+ IPPROTO_IP = 0;
+ IPPROTO_ICMP = 1;
+ IPPROTO_IGMP = 2;
+ IPPROTO_GGP = 3;
+ IPPROTO_TCP = 6;
+ IPPORT_ECHO = 7;
+ IPPORT_DISCARD = 9;
+ IPPORT_SYSTAT = 11;
+ IPPROTO_PUP = 12;
+ IPPORT_DAYTIME = 13;
+ IPPORT_NETSTAT = 15;
+ IPPROTO_UDP = 17;
+ IPPROTO_IDP = 22;
+ IPPROTO_ND = 77;
+ IPPROTO_RAW = 255;
+ IPPROTO_MAX = 256;
+ IPPORT_FTP = 21;
+ IPPORT_TELNET = 23;
+ IPPORT_SMTP = 25;
+ IPPORT_TIMESERVER = 37;
+ IPPORT_NAMESERVER = 42;
+ IPPORT_WHOIS = 43;
+ IPPORT_MTP = 57;
+ IPPORT_TFTP = 69;
+ IPPORT_RJE = 77;
+ IPPORT_FINGER = 79;
+ IPPORT_TTYLINK = 87;
+ IPPORT_SUPDUP = 95;
+ IPPORT_EXECSERVER = 512;
+ IPPORT_LOGINSERVER = 513;
+ IPPORT_CMDSERVER = 514;
+ IPPORT_EFSSERVER = 520;
+ IPPORT_BIFFUDP = 512;
+ IPPORT_WHOSERVER = 513;
+ IPPORT_ROUTESERVER = 520;
+ IPPORT_RESERVED = 1024;
+
+ const
+ IMPLINK_IP = 155;
+ IMPLINK_LOWEXPER = 156;
+ IMPLINK_HIGHEXPER = 158;
+
+ type
+ SunB = packed record
+ s_b1,s_b2,s_b3,s_b4 : u_char;
+ end;
+
+ SunW = packed record
+ s_w1,s_w2 : u_short;
+ end;
+
+ in_addr = record
+ case integer of
+ 0 : (S_un_b : SunB);
+ 1 : (S_un_w : SunW);
+ 2 : (S_addr : u_long);
+ end;
+ TInAddr = in_addr;
+ PInAddr = ^TInAddr;
+
+ sockaddr_in = record
+ case integer of
+ 0 : ( (* equals to sockaddr_in, size is 16 byte *)
+ sin_family : SmallInt; (* 2 byte *)
+ sin_port : u_short; (* 2 byte *)
+ sin_addr : TInAddr; (* 4 byte *)
+ sin_zero : array[0..7] of char; (* 8 byte *)
+ );
+ 1 : ( (* equals to sockaddr, size is 16 byte *)
+ sa_family : SmallInt; (* 2 byte *)
+ sa_data : array[0..13] of char; (* 14 byte *)
+ );
+
+ end;
+
+ TSockAddrIn = sockaddr_in;
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddr = sockaddr_in;
+ PSockAddr = ^TSockAddr;
+
+ const
+ INADDR_ANY = $00000000;
+ INADDR_LOOPBACK = $7F000001;
+ INADDR_BROADCAST = $FFFFFFFF;
+
+ IN_CLASSA_NET = $ff000000;
+ IN_CLASSA_NSHIFT = 24;
+ IN_CLASSA_HOST = $00ffffff;
+ IN_CLASSA_MAX = 128;
+ IN_CLASSB_NET = $ffff0000;
+ IN_CLASSB_NSHIFT = 16;
+ IN_CLASSB_HOST = $0000ffff;
+ IN_CLASSB_MAX = 65536;
+ IN_CLASSC_NET = $ffffff00;
+ IN_CLASSC_NSHIFT = 8;
+ IN_CLASSC_HOST = $000000ff;
+ INADDR_NONE = $ffffffff;
+
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+
+ type
+ WSADATA = record
+ wVersion : WORD; { 2 byte, ofs 0 }
+ wHighVersion : WORD; { 2 byte, ofs 2 }
+ szDescription : array[0..(WSADESCRIPTION_LEN+1)-1] of char; { 257 byte, ofs 4 }
+ szSystemStatus : array[0..(WSASYS_STATUS_LEN+1)-1] of char; { 129 byte, ofs 261 }
+ iMaxSockets : word; { 2 byte, ofs 390 }
+ iMaxUdpDg : word; { 2 byte, ofs 392 }
+ pad1 : SmallInt; { 2 byte, ofs 394 } { ensure right packaging }
+ lpVendorInfo : pchar; { 4 byte, ofs 396 }
+ end; { total size 400 }
+ TWSAData = WSADATA;
+ PWSAData = TWSAData;
+
+ const
+ IP_OPTIONS = 1;
+ IP_MULTICAST_IF = 2;
+ IP_MULTICAST_TTL = 3;
+ IP_MULTICAST_LOOP = 4;
+ IP_ADD_MEMBERSHIP = 5;
+ IP_DROP_MEMBERSHIP = 6;
+ IP_DEFAULT_MULTICAST_TTL = 1;
+ IP_DEFAULT_MULTICAST_LOOP = 1;
+ IP_MAX_MEMBERSHIPS = 20;
+
+ type
+ ip_mreq = record
+ imr_multiaddr : in_addr;
+ imr_interface : in_addr;
+ end;
+
+ {
+ Definitions related to sockets: types, address families, options,
+ taken from the BSD file sys/socket.h.
+ }
+ const
+ INVALID_SOCKET = longint(not(1));
+ SOCKET_ERROR = -1;
+ SOCK_STREAM = 1;
+ SOCK_DGRAM = 2;
+ SOCK_RAW = 3;
+ SOCK_RDM = 4;
+ SOCK_SEQPACKET = 5;
+
+ { For setsockoptions(2) }
+ SO_DEBUG = $0001;
+ SO_ACCEPTCONN = $0002;
+ SO_REUSEADDR = $0004;
+ SO_KEEPALIVE = $0008;
+ SO_DONTROUTE = $0010;
+ SO_BROADCAST = $0020;
+ SO_USELOOPBACK = $0040;
+ SO_LINGER = $0080;
+ SO_OOBINLINE = $0100;
+ {
+ Additional options.
+ }
+ { send buffer size }
+ SO_SNDBUF = $1001;
+ { receive buffer size }
+ SO_RCVBUF = $1002;
+ { send low-water mark }
+ SO_SNDLOWAT = $1003;
+ { receive low-water mark }
+ SO_RCVLOWAT = $1004;
+ { send timeout }
+ SO_SNDTIMEO = $1005;
+ { receive timeout }
+ SO_RCVTIMEO = $1006;
+ { get error status and clear }
+ SO_ERROR = $1007;
+ { get socket type }
+ SO_TYPE = $1008;
+
+ { WinSock 2 extension -- new option }
+ SO_GROUP_ID = $2001; { ID of a socket group }
+ SO_GROUP_PRIORITY = $2002; { the relative priority within a group }
+ SO_MAX_MSG_SIZE = $2003; { maximum message size }
+ SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
+ SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
+ SO_PROTOCOL_INFO = SO_PROTOCOL_INFOW;
+ PVD_CONFIG = $3001; { configuration info for service provider }
+
+
+ {
+ Options for connect and disconnect data and options. Used only by
+ non-TCP/IP transports such as DECNet, OSI TP4, etc.
+ }
+ SO_CONNDATA = $7000;
+ SO_CONNOPT = $7001;
+ SO_DISCDATA = $7002;
+ SO_DISCOPT = $7003;
+ SO_CONNDATALEN = $7004;
+ SO_CONNOPTLEN = $7005;
+ SO_DISCDATALEN = $7006;
+ SO_DISCOPTLEN = $7007;
+
+ {
+ Option for opening sockets for synchronous access.
+ }
+ SO_OPENTYPE = $7008;
+ SO_SYNCHRONOUS_ALERT = $10;
+ SO_SYNCHRONOUS_NONALERT = $20;
+
+ {
+ Other NT-specific options.
+ }
+ SO_MAXDG = $7009;
+ SO_MAXPATHDG = $700A;
+ SO_UPDATE_ACCEPT_CONTEXT = $700B;
+ SO_CONNECT_TIME = $700C;
+
+ {
+ TCP options.
+ }
+ TCP_NODELAY = $0001;
+ TCP_BSDURGENT = $7000;
+
+ { Address families. }
+ { unspecified }
+ AF_UNSPEC = 0;
+ {
+ * Although AF_UNSPEC is defined for backwards compatibility, using
+ * AF_UNSPEC for the "af" parameter when creating a socket is STRONGLY
+ * DISCOURAGED. The interpretation of the "protocol" parameter
+ * depends on the actual address family chosen. As environments grow
+ * to include more and more address families that use overlapping
+ * protocol values there is more and more chance of choosing an
+ * undesired address family when AF_UNSPEC is used. }
+
+ { local to host (pipes, portals) }
+ AF_UNIX = 1;
+ { internetwork: UDP, TCP, etc. }
+ AF_INET = 2;
+ { arpanet imp addresses }
+ AF_IMPLINK = 3;
+ { pup protocols: e.g. BSP }
+ AF_PUP = 4;
+ { mit CHAOS protocols }
+ AF_CHAOS = 5;
+ { IPX and SPX }
+ AF_IPX = 6;
+ { XEROX NS protocols }
+ AF_NS = 6;
+ { ISO protocols }
+ AF_ISO = 7;
+ { OSI is ISO }
+ AF_OSI = AF_ISO;
+ { european computer manufacturers }
+ AF_ECMA = 8;
+ { datakit protocols }
+ AF_DATAKIT = 9;
+ { CCITT protocols, X.25 etc }
+ AF_CCITT = 10;
+ { IBM SNA }
+ AF_SNA = 11;
+ { DECnet }
+ AF_DECnet = 12;
+ { Direct data link interface }
+ AF_DLI = 13;
+ { LAT }
+ AF_LAT = 14;
+ { NSC Hyperchannel }
+ AF_HYLINK = 15;
+ { AppleTalk }
+ AF_APPLETALK = 16;
+ { NetBios-style addresses }
+ AF_NETBIOS = 17;
+ { VoiceView }
+ AF_VOICEVIEW = 18;
+ { FireFox }
+ AF_FIREFOX = 19;
+ { Somebody is using this! }
+ AF_UNKNOWN1 = 20;
+ { Banyan }
+ AF_BAN = 21;
+
+ AF_ATM = 22;
+ AF_INET6 = 23;
+ AF_CLUSTER = 24;
+ AF_12844 = 25;
+ AF_IRDA = 26;
+
+ AF_MAX = 27;
+
+ type
+ {
+ Structure used by kernel to pass protocol
+ information in raw sockets.
+ }
+ sockproto = record
+ sp_family : u_short;
+ sp_protocol : u_short;
+ end;
+ TSockProto = sockproto;
+ PSockProto = ^TSockProto;
+
+ const
+ {
+ Protocol families, same as address families for now.
+ }
+ PF_UNSPEC = AF_UNSPEC;
+ PF_UNIX = AF_UNIX;
+ PF_INET = AF_INET;
+ PF_IMPLINK = AF_IMPLINK;
+ PF_PUP = AF_PUP;
+ PF_CHAOS = AF_CHAOS;
+ PF_NS = AF_NS;
+ PF_IPX = AF_IPX;
+ PF_ISO = AF_ISO;
+ PF_OSI = AF_OSI;
+ PF_ECMA = AF_ECMA;
+ PF_DATAKIT = AF_DATAKIT;
+ PF_CCITT = AF_CCITT;
+ PF_SNA = AF_SNA;
+ PF_DECnet = AF_DECnet;
+ PF_DLI = AF_DLI;
+ PF_LAT = AF_LAT;
+ PF_HYLINK = AF_HYLINK;
+ PF_APPLETALK = AF_APPLETALK;
+ PF_VOICEVIEW = AF_VOICEVIEW;
+ PF_FIREFOX = AF_FIREFOX;
+ PF_UNKNOWN1 = AF_UNKNOWN1;
+ PF_BAN = AF_BAN;
+ PF_ATM = AF_ATM;
+ PF_INET6 = AF_INET6;
+ PF_MAX = AF_MAX;
+
+ type
+ {
+ Structure used for manipulating linger option.
+ }
+ linger = record
+ l_onoff : u_short;
+ l_linger : u_short;
+ end;
+ TLinger = linger;
+ PLinger = ^TLinger;
+
+ const
+ {
+ Level number for (get/set)sockopt() to apply to socket itself.
+ }
+ { options for socket level }
+ SOL_SOCKET = $ffff;
+ {
+ Maximum queue length specifiable by listen.
+ }
+ SOMAXCONN = $7fffffff;
+ { process out-of-band data }
+ MSG_OOB = $1;
+ { peek at incoming message }
+ MSG_PEEK = $2;
+ { send without using routing tables }
+ MSG_DONTROUTE = $4;
+ MSG_MAXIOVLEN = 16;
+ { partial send or recv for message xport }
+ MSG_PARTIAL = $8000;
+
+ {
+ Define constant based on rfc883, used by gethostbyxxxx() calls.
+ }
+ MAXGETHOSTSTRUCT = 1024;
+ MAXHOSTNAMELEN = MAXGETHOSTSTRUCT;
+
+ { Winsock2 extension -- new flags for WSASend, WSASendTo, WSARecv
+ and WSARecvFrom }
+ MSG_INTERRUPT = $10; { send/recv in the interrupt context }
+
+ { Define flags to be used with the WSAAsyncSelect() call. }
+ FD_READ = $01;
+ FD_WRITE = $02;
+ FD_OOB = $04;
+ FD_ACCEPT = $08;
+ FD_CONNECT = $10;
+ FD_CLOSE = $20;
+ FD_QOS = $40;
+ FD_GROUP_QOS = $80;
+ FD_ROUTING_INTERFACE_CHANGE = $100;
+ FD_ADDRESS_LIST_CHANGE = $200;
+ FD_MAX_EVENTS = 10;
+ FD_ALL_EVENTS = $4ff;
+
+ { All Windows Sockets error constants are biased by WSABASEERR from
+ the "normal" }
+ WSABASEERR = 10000;
+
+ { Windows Sockets definitions of regular Microsoft C error constants }
+ WSAEINTR = WSABASEERR + 4;
+ WSAEBADF = WSABASEERR + 9;
+ WSAEACCES = WSABASEERR + 13;
+ WSAEFAULT = WSABASEERR + 14;
+ WSAEINVAL = WSABASEERR + 22;
+ WSAEMFILE = WSABASEERR + 24;
+
+ { Windows Sockets definitions of regular Berkeley error constants }
+ WSAEWOULDBLOCK = WSABASEERR + 35;
+ WSAEINPROGRESS = WSABASEERR + 36;
+ WSAEALREADY = WSABASEERR + 37;
+ WSAENOTSOCK = WSABASEERR + 38;
+ WSAEDESTADDRREQ = WSABASEERR + 39;
+ WSAEMSGSIZE = WSABASEERR + 40;
+ WSAEPROTOTYPE = WSABASEERR + 41;
+ WSAENOPROTOOPT = WSABASEERR + 42;
+ WSAEPROTONOSUPPORT = WSABASEERR + 43;
+ WSAESOCKTNOSUPPORT = WSABASEERR + 44;
+ WSAEOPNOTSUPP = WSABASEERR + 45;
+ WSAEPFNOSUPPORT = WSABASEERR + 46;
+ WSAEAFNOSUPPORT = WSABASEERR + 47;
+ WSAEADDRINUSE = WSABASEERR + 48;
+ WSAEADDRNOTAVAIL = WSABASEERR + 49;
+ WSAENETDOWN = WSABASEERR + 50;
+ WSAENETUNREACH = WSABASEERR + 51;
+ WSAENETRESET = WSABASEERR + 52;
+ WSAECONNABORTED = WSABASEERR + 53;
+ WSAECONNRESET = WSABASEERR + 54;
+ WSAENOBUFS = WSABASEERR + 55;
+ WSAEISCONN = WSABASEERR + 56;
+ WSAENOTCONN = WSABASEERR + 57;
+ WSAESHUTDOWN = WSABASEERR + 58;
+ WSAETOOMANYREFS = WSABASEERR + 59;
+ WSAETIMEDOUT = WSABASEERR + 60;
+ WSAECONNREFUSED = WSABASEERR + 61;
+ WSAELOOP = WSABASEERR + 62;
+ WSAENAMETOOLONG = WSABASEERR + 63;
+ WSAEHOSTDOWN = WSABASEERR + 64;
+ WSAEHOSTUNREACH = WSABASEERR + 65;
+ WSAENOTEMPTY = WSABASEERR + 66;
+ WSAEPROCLIM = WSABASEERR + 67;
+ WSAEUSERS = WSABASEERR + 68;
+ WSAEDQUOT = WSABASEERR + 69;
+ WSAESTALE = WSABASEERR + 70;
+ WSAEREMOTE = WSABASEERR + 71;
+
+ { Extended Windows Sockets error constant definitions }
+ WSASYSNOTREADY = WSABASEERR + 91;
+ WSAVERNOTSUPPORTED = WSABASEERR + 92;
+ WSANOTINITIALISED = WSABASEERR + 93;
+ WSAEDISCON = WSABASEERR + 101;
+ WSAENOMORE = WSABASEERR+102;
+ WSAECANCELLED = WSABASEERR+103;
+ WSAEINVALIDPROCTABLE = WSABASEERR+104;
+ WSAEINVALIDPROVIDER = WSABASEERR+105;
+ WSAEPROVIDERFAILEDINIT = WSABASEERR+106;
+ WSASYSCALLFAILURE = WSABASEERR+107;
+ WSASERVICE_NOT_FOUND = WSABASEERR+108;
+ WSATYPE_NOT_FOUND = WSABASEERR+109;
+ WSA_E_NO_MORE = WSABASEERR+110;
+ WSA_E_CANCELLED = WSABASEERR+111;
+ WSAEREFUSED = WSABASEERR+112;
+
+ {
+ Error return codes from gethostbyname() and gethostbyaddr()
+ (when using the resolver). Note that these errors are
+ retrieved via WSAGetLastError() and must therefore follow
+ the rules for avoiding clashes with error numbers from
+ specific implementations or language run-time systems.
+ For this reason the codes are based at WSABASEERR+1001.
+ Note also that [WSA]NO_ADDRESS is defined only for
+ compatibility purposes.
+ }
+ WSAHOST_NOT_FOUND = WSABASEERR + 1001;
+ HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
+ { Non-Authoritative: Host not found, or SERVERFAIL }
+ WSATRY_AGAIN = WSABASEERR + 1002;
+ TRY_AGAIN = WSATRY_AGAIN;
+
+ { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+ WSANO_RECOVERY = WSABASEERR + 1003;
+ NO_RECOVERY = WSANO_RECOVERY;
+
+ { Valid name, no data record of requested type }
+ WSANO_DATA = WSABASEERR + 1004;
+ NO_DATA = WSANO_DATA;
+
+ { no address, look for MX record }
+ WSANO_ADDRESS = WSANO_DATA;
+ NO_ADDRESS = WSANO_ADDRESS;
+
+ { Define QOS related error return codes }
+ WSA_QOS_RECEIVERS = WSABASEERR + 1005;
+ { at least one Reserve has arrived }
+ WSA_QOS_SENDERS = WSABASEERR + 1006;
+ { at least one Path has arrived }
+ WSA_QOS_NO_SENDERS = WSABASEERR + 1007;
+ { there are no senders }
+ WSA_QOS_NO_RECEIVERS = WSABASEERR + 1008;
+ { there are no receivers }
+ WSA_QOS_REQUEST_CONFIRMED = WSABASEERR + 1009;
+ { Reserve has been confirmed }
+ WSA_QOS_ADMISSION_FAILURE = WSABASEERR + 1010;
+
+ WSA_QOS_POLICY_FAILURE = WSABASEERR + 1011;
+ { rejected for administrative reasons - bad credentials }
+ WSA_QOS_BAD_STYLE = WSABASEERR + 1012;
+ { unknown or conflicting style }
+ WSA_QOS_BAD_OBJECT = WSABASEERR + 1013;
+ {* problem with some part of the filterspec or providerspecific
+ * buffer in general }
+ WSA_QOS_TRAFFIC_CTRL_ERROR = WSABASEERR + 1014;
+ { problem with some part of the flowspec }
+ WSA_QOS_GENERIC_ERROR = WSABASEERR + 1015;
+ { general error }
+
+ const
+ {
+ Windows Sockets errors redefined as regular Berkeley error constants.
+ }
+ EWOULDBLOCK = WSAEWOULDBLOCK;
+ EINPROGRESS = WSAEINPROGRESS;
+ EALREADY = WSAEALREADY;
+ ENOTSOCK = WSAENOTSOCK;
+ EDESTADDRREQ = WSAEDESTADDRREQ;
+ EMSGSIZE = WSAEMSGSIZE;
+ EPROTOTYPE = WSAEPROTOTYPE;
+ ENOPROTOOPT = WSAENOPROTOOPT;
+ EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
+ ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
+ EOPNOTSUPP = WSAEOPNOTSUPP;
+ EPFNOSUPPORT = WSAEPFNOSUPPORT;
+ EAFNOSUPPORT = WSAEAFNOSUPPORT;
+ EADDRINUSE = WSAEADDRINUSE;
+ EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
+ ENETDOWN = WSAENETDOWN;
+ ENETUNREACH = WSAENETUNREACH;
+ ENETRESET = WSAENETRESET;
+ ECONNABORTED = WSAECONNABORTED;
+ ECONNRESET = WSAECONNRESET;
+ ENOBUFS = WSAENOBUFS;
+ EISCONN = WSAEISCONN;
+ ENOTCONN = WSAENOTCONN;
+ ESHUTDOWN = WSAESHUTDOWN;
+ ETOOMANYREFS = WSAETOOMANYREFS;
+ ETIMEDOUT = WSAETIMEDOUT;
+ ECONNREFUSED = WSAECONNREFUSED;
+ ELOOP = WSAELOOP;
+ ENAMETOOLONG = WSAENAMETOOLONG;
+ EHOSTDOWN = WSAEHOSTDOWN;
+ EHOSTUNREACH = WSAEHOSTUNREACH;
+ ENOTEMPTY = WSAENOTEMPTY;
+ EPROCLIM = WSAEPROCLIM;
+ EUSERS = WSAEUSERS;
+ EDQUOT = WSAEDQUOT;
+ ESTALE = WSAESTALE;
+ EREMOTE = WSAEREMOTE;
+
+ TF_DISCONNECT = $01;
+ TF_REUSE_SOCKET = $02;
+ TF_WRITE_BEHIND = $04;
+
+ {
+ Options for use with [gs]etsockopt at the IP level.
+ }
+ IP_TTL = 7;
+ IP_TOS = 8;
+ IP_DONTFRAGMENT = 9;
+
+ type
+ _TRANSMIT_FILE_BUFFERS = record
+ Head : Pointer;
+ HeadLength : dword;
+ Tail : Pointer;
+ TailLength : dword;
+ end;
+ TRANSMIT_FILE_BUFFERS = _TRANSMIT_FILE_BUFFERS;
+ TTransmitFileBuffers = _TRANSMIT_FILE_BUFFERS;
+ PTransmitFileBuffers = ^TTransmitFileBuffers;
+
+ { WinSock 2 extension -- WSABUF and QOS struct, include qos.h
+ to pull in FLOWSPEC and related definitions }
+ { the length of the buffer }
+ (* far ignored *)
+ { the pointer to the buffer }
+ (* far ignored *)
+
+ TWSABUF = record
+ len : u_long;
+ buf : ^char;
+ end;
+ _WSABUF = TWSABUF;
+ LPWSABUF = ^TWSABUF;
+ PWSABUF = ^TWSABUF;
+
+ {$i qos.inc }
+
+ { the flow spec for data sending }
+ { the flow spec for data receiving }
+ { additional provider specific stuff }
+
+ type
+
+ TQualityOfService = record
+ SendingFlowspec : TFLOWSPEC;
+ ReceivingFlowspec : TFLOWSPEC;
+ ProviderSpecific : TWSABUF;
+ end;
+ TQOS = TQualityOfService;
+ PQOS = ^TQOS;
+
+ { WinSock 2 extension -- manifest constants for return values of the condition function }
+
+ const
+ CF_ACCEPT = $0000;
+ CF_REJECT = $0001;
+ CF_DEFER = $0002;
+
+ { WinSock 2 extension -- manifest constants for shutdown() }
+ SD_RECEIVE = $00;
+ SD_SEND = $01;
+ SD_BOTH = $02;
+
+ { WinSock 2 extension -- data type and manifest constants for socket groups }
+
+ type
+ TGROUP = dword;
+ PGROUP = ^TGROUP;
+
+ const
+ SG_UNCONSTRAINED_GROUP = $01;
+ SG_CONSTRAINED_GROUP = $02;
+
+ { WinSock 2 extension -- data type for WSAEnumNetworkEvents() }
+
+ type
+
+ TWSANETWORKEVENTS = record
+ lNetworkEvents : longint;
+ iErrorCode : array[0..(FD_MAX_EVENTS)-1] of longint;
+ end;
+ LPWSANETWORKEVENTS = ^TWSANETWORKEVENTS;
+ PWSANETWORKEVENTS = ^TWSANETWORKEVENTS;
+
+ { WinSock 2 extension -- WSAPROTOCOL_INFO structure and associated
+ manifest constants }
+
+ type
+
+ TGUID = record
+ Data1 : dword;
+ Data2 : word;
+ Data3 : word;
+ Data4 : array[0..7] of byte;
+ end;
+ PGUID = ^TGUID;
+ LPGUID = PGUID;
+
+ const
+ MAX_PROTOCOL_CHAIN = 7;
+ BASE_PROTOCOL = 1;
+ LAYERED_PROTOCOL = 0;
+ { the length of the chain, }
+ { length = 0 means layered protocol, }
+ { length = 1 means base protocol, }
+ { length > 1 means protocol chain }
+ { a list of dwCatalogEntryIds }
+
+ type
+
+ TWSAPROTOCOLCHAIN = record
+ ChainLen : longint;
+ ChainEntries : array[0..(MAX_PROTOCOL_CHAIN)-1] of DWORD;
+ end;
+ LPWSAPROTOCOLCHAIN = ^TWSAPROTOCOLCHAIN;
+ PWSAPROTOCOLCHAIN = ^TWSAPROTOCOLCHAIN;
+
+ const
+ WSAPROTOCOL_LEN = 255;
+ (* far ignored *)
+
+ type
+
+ TWSAPROTOCOL_INFOA = record
+ dwServiceFlags1 : DWORD;
+ dwServiceFlags2 : DWORD;
+ dwServiceFlags3 : DWORD;
+ dwServiceFlags4 : DWORD;
+ dwProviderFlags : DWORD;
+ ProviderId : TGUID;
+ dwCatalogEntryId: DWORD;
+ ProtocolChain : TWSAPROTOCOLCHAIN;
+ iVersion : longint;
+ iAddressFamily : longint;
+ iMaxSockAddr : longint;
+ iMinSockAddr : longint;
+ iSocketType : longint;
+ iProtocol : longint;
+ iProtocolMaxOffset : longint;
+ iNetworkByteOrder : longint;
+ iSecurityScheme : longint;
+ dwMessageSize : DWORD;
+ dwProviderReserved : DWORD;
+ szProtocol : array[0..(WSAPROTOCOL_LEN + 1)-1] of CHAR;
+ end;
+ LPWSAPROTOCOL_INFOA = ^TWSAPROTOCOL_INFOA;
+ PWSAPROTOCOL_INFOA = ^TWSAPROTOCOL_INFOA;
+
+
+ TWSAPROTOCOL_INFOW = record
+ dwServiceFlags1 : DWORD;
+ dwServiceFlags2 : DWORD;
+ dwServiceFlags3 : DWORD;
+ dwServiceFlags4 : DWORD;
+ dwProviderFlags : DWORD;
+ ProviderId : TGUID;
+ dwCatalogEntryId: DWORD;
+ ProtocolChain : TWSAPROTOCOLCHAIN;
+ iVersion : longint;
+ iAddressFamily : longint;
+ iMaxSockAddr : longint;
+ iMinSockAddr : longint;
+ iSocketType : longint;
+ iProtocol : longint;
+ iProtocolMaxOffset : longint;
+ iNetworkByteOrder : longint;
+ iSecurityScheme : longint;
+ dwMessageSize : DWORD;
+ dwProviderReserved : DWORD;
+ szProtocol : array[0..(WSAPROTOCOL_LEN + 1)-1] of WCHAR;
+ end;
+ LPWSAPROTOCOL_INFOW = ^TWSAPROTOCOL_INFOW;
+ PWSAPROTOCOL_INFOW = ^TWSAPROTOCOL_INFOW;
+
+{$ifdef UNICODE}
+ type
+ TWSAPROTOCOL_INFO = TWSAPROTOCOL_INFOW;
+ LPWSAPROTOCOL_INFO = LPWSAPROTOCOL_INFOW;
+ PWSAPROTOCOL_INFO = PWSAPROTOCOL_INFOW;
+{$else}
+ type
+ TWSAPROTOCOL_INFO = TWSAPROTOCOL_INFOA;
+ LPWSAPROTOCOL_INFO = LPWSAPROTOCOL_INFOA;
+ PWSAPROTOCOL_INFO = PWSAPROTOCOL_INFOA;
+{$endif}
+
+ { Flag bit definitions for dwProviderFlags }
+
+ const
+ PFL_MULTIPLE_PROTO_ENTRIES = $00000001;
+ PFL_RECOMMENDED_PROTO_ENTRY = $00000002;
+ PFL_HIDDEN = $00000004;
+ PFL_MATCHES_PROTOCOL_ZERO = $00000008;
+ { Flag bit definitions for dwServiceFlags1 }
+ XP1_CONNECTIONLESS = $00000001;
+ XP1_GUARANTEED_DELIVERY = $00000002;
+ XP1_GUARANTEED_ORDER = $00000004;
+ XP1_MESSAGE_ORIENTED = $00000008;
+ XP1_PSEUDO_STREAM = $00000010;
+ XP1_GRACEFUL_CLOSE = $00000020;
+ XP1_EXPEDITED_DATA = $00000040;
+ XP1_CONNECT_DATA = $00000080;
+ XP1_DISCONNECT_DATA = $00000100;
+ XP1_SUPPORT_BROADCAST = $00000200;
+ XP1_SUPPORT_MULTIPOINT = $00000400;
+ XP1_MULTIPOINT_CONTROL_PLANE = $00000800;
+ XP1_MULTIPOINT_DATA_PLANE = $00001000;
+ XP1_QOS_SUPPORTED = $00002000;
+ XP1_INTERRUPT = $00004000;
+ XP1_UNI_SEND = $00008000;
+ XP1_UNI_RECV = $00010000;
+ XP1_IFS_HANDLES = $00020000;
+ XP1_PARTIAL_MESSAGE = $00040000;
+ BIGENDIAN = $0000;
+ LITTLEENDIAN = $0001;
+ SECURITY_PROTOCOL_NONE = $0000;
+
+ { WinSock 2 extension -- manifest constants for WSAJoinLeaf() }
+ JL_SENDER_ONLY = $01;
+ JL_RECEIVER_ONLY = $02;
+ JL_BOTH = $04;
+
+ { WinSock 2 extension -- manifest constants for WSASocket() }
+ WSA_FLAG_OVERLAPPED = $01;
+ WSA_FLAG_MULTIPOINT_C_ROOT = $02;
+ WSA_FLAG_MULTIPOINT_C_LEAF = $04;
+ WSA_FLAG_MULTIPOINT_D_ROOT = $08;
+ WSA_FLAG_MULTIPOINT_D_LEAF = $10;
+
+
+ { WinSock 2 extension -- manifest constants for WSAIoctl() }
+ IOC_UNIX = $00000000;
+ IOC_WS2 = $08000000;
+ IOC_PROTOCOL = $10000000;
+ IOC_VENDOR = $18000000;
+
+ { WinSock 2 extension -- manifest constants for SIO_TRANSLATE_HANDLE ioctl }
+
+ const
+ TH_NETDEV = $00000001;
+ TH_TAPI = $00000002;
+
+ { Microsoft Windows Extended data types required for the functions to
+ convert back and forth between binary and string forms of
+ addresses. }
+
+ type
+ //PSOCKADDR = sockaddr;
+ LPSOCKADDR = PSockAddr;
+
+ { Manifest constants and type definitions related to name resolution and
+ registration (RNR) API }
+ type
+ TBLOB = record
+ cbSize : u_long;
+ pBlobData:ARRAY[0..0] OF POINTER; {???}
+ end;
+ PBLOB = ^TBLOB;
+
+ { Service Install Flags }
+
+ const
+ SERVICE_MULTIPLE = $00000001;
+
+ { & Name Spaces }
+ NS_ALL = 0;
+ NS_SAP = 1;
+ NS_NDS = 2;
+ NS_PEER_BROWSE = 3;
+ NS_TCPIP_LOCAL = 10;
+ NS_TCPIP_HOSTS = 11;
+ NS_DNS = 12;
+ NS_NETBT = 13;
+ NS_WINS = 14;
+ NS_NBP = 20;
+ NS_MS = 30;
+ NS_STDA = 31;
+ NS_NTDS = 32;
+ NS_X500 = 40;
+ NS_NIS = 41;
+ NS_NISPLUS = 42;
+ NS_WRQ = 50;
+
+ { Resolution flags for WSAGetAddressByName().
+ Note these are also used by the 1.1 API GetAddressByName, so
+ leave them around. }
+
+ RES_UNUSED_1 = $00000001;
+ RES_FLUSH_CACHE = $00000002;
+
+ RES_SERVICE = $00000004;
+
+ { RES_SERVICE }
+ { Well known value names for Service Types }
+
+ const
+ SERVICE_TYPE_VALUE_IPXPORTA = 'IpxSocket';
+(* error #define SERVICE_TYPE_VALUE_IPXPORTW L"IpxSocket" *)
+ SERVICE_TYPE_VALUE_SAPIDA = 'SapId';
+(* error #define SERVICE_TYPE_VALUE_SAPIDW L"SapId" *)
+ SERVICE_TYPE_VALUE_TCPPORTA = 'TcpPort';
+(* error #define SERVICE_TYPE_VALUE_TCPPORTW L"TcpPort" *)
+ SERVICE_TYPE_VALUE_UDPPORTA = 'UdpPort';
+(* error #define SERVICE_TYPE_VALUE_UDPPORTW L"UdpPort" *)
+ SERVICE_TYPE_VALUE_OBJECTIDA = 'ObjectId';
+(* error #define SERVICE_TYPE_VALUE_OBJECTIDW L"ObjectId" *)
+
+{$ifdef UNICODE}
+ const
+ SERVICE_TYPE_VALUE_SAPID = SERVICE_TYPE_VALUE_SAPIDW;
+ SERVICE_TYPE_VALUE_TCPPORT = SERVICE_TYPE_VALUE_TCPPORTW;
+ SERVICE_TYPE_VALUE_UDPPORT = SERVICE_TYPE_VALUE_UDPPORTW;
+ SERVICE_TYPE_VALUE_OBJECTID = SERVICE_TYPE_VALUE_OBJECTIDW;
+{$else}
+ { not UNICODE }
+ const
+ SERVICE_TYPE_VALUE_SAPID = SERVICE_TYPE_VALUE_SAPIDA;
+ SERVICE_TYPE_VALUE_TCPPORT = SERVICE_TYPE_VALUE_TCPPORTA;
+ SERVICE_TYPE_VALUE_UDPPORT = SERVICE_TYPE_VALUE_UDPPORTA;
+ SERVICE_TYPE_VALUE_OBJECTID = SERVICE_TYPE_VALUE_OBJECTIDA;
+{$endif}
+
+ { SockAddr Information }
+ type
+
+ TSOCKET_ADDRESS = record
+ lpSockaddr : PSockAddr;
+ iSockaddrLength : tOS_INT;
+ end;
+ PSOCKET_ADDRESS = ^TSOCKET_ADDRESS;
+ LPSOCKET_ADDRESS = ^TSOCKET_ADDRESS;
+
+ { CSAddr Information }
+
+ TCSADDR_INFO = record
+ LocalAddr : TSOCKET_ADDRESS;
+ RemoteAddr : TSOCKET_ADDRESS;
+ iSocketType : tOS_INT;
+ iProtocol : tOS_INT;
+ end;
+ PCSADDR_INFO = ^TCSADDR_INFO;
+ LPCSADDR_INFO = ^TCSADDR_INFO;
+
+ { Address list returned via SIO_ADDRESS_LIST_QUERY }
+
+ type
+
+ TSOCKET_ADDRESS_LIST = record
+ iAddressCount : tOS_INT;
+ Address : array[0..0] of TSOCKET_ADDRESS;
+ end;
+ LPSOCKET_ADDRESS_LIST = ^TSOCKET_ADDRESS_LIST;
+ PSOCKET_ADDRESS_LIST = ^TSOCKET_ADDRESS_LIST;
+
+ { Address Family/Protocol Tuples }
+
+ TAFPROTOCOLS = record
+ iAddressFamily : tOS_INT;
+ iProtocol : tOS_INT;
+ end;
+ PAFPROTOCOLS = ^TAFPROTOCOLS;
+ LPAFPROTOCOLS = ^TAFPROTOCOLS;
+
+ { Client Query API Typedefs }
+ { The comparators }
+
+ TWSAEcomparator = (COMP_EQUAL := 0,COMP_NOTLESS);
+ PWSAECOMPARATOR = ^TWSAEcomparator;
+ LPWSAECOMPARATOR = ^TWSAEcomparator;
+
+ TWSAVersion = record
+ dwVersion : DWORD;
+ ecHow : TWSAECOMPARATOR;
+ end;
+ PWSAVERSION = ^TWSAVersion;
+ LPWSAVERSION = ^TWSAVersion;
+
+ TWSAQuerySetA = record
+ dwSize : DWORD;
+ lpszServiceInstanceName : PChar;
+ lpServiceClassId : LPGUID;
+ lpVersion : LPWSAVERSION;
+ lpszComment : PChar;
+ dwNameSpace : DWORD;
+ lpNSProviderId : LPGUID;
+ lpszContext : PChar;
+ dwNumberOfProtocols : DWORD;
+ lpafpProtocols : LPAFPROTOCOLS;
+ lpszQueryString : PChar;
+ dwNumberOfCsAddrs : DWORD;
+ lpcsaBuffer : LPCSADDR_INFO;
+ dwOutputFlags : DWORD;
+ lpBlob : PBLOB;
+ end;
+ PWSAQUERYSETA = ^TWSAQuerySetA;
+ LPWSAQUERYSETA = ^TWSAQuerySetA;
+
+ TWSAQuerySetW = record
+ dwSize : DWORD;
+ lpszServiceInstanceName : PWideChar;
+ lpServiceClassId : LPGUID;
+ lpVersion : LPWSAVERSION;
+ lpszComment : PWideChar;
+ dwNameSpace : DWORD;
+ lpNSProviderId : LPGUID;
+ lpszContext : PWideChar;
+ dwNumberOfProtocols : DWORD;
+ lpafpProtocols : LPAFPROTOCOLS;
+ lpszQueryString : PWideChar;
+ dwNumberOfCsAddrs : DWORD;
+ lpcsaBuffer : LPCSADDR_INFO;
+ dwOutputFlags : DWORD;
+ lpBlob : PBLOB;
+ end;
+ PWSAQUERYSETW = ^TWSAQuerySetW;
+ LPWSAQUERYSETW = ^TWSAQuerySetW;
+{$ifdef UNICODE}
+
+ type
+ TWSAQUERYSET = TWSAQUERYSETW;
+ PWSAQUERYSET = PWSAQUERYSETW;
+ LPWSAQUERYSET = LPWSAQUERYSETW;
+{$else}
+ type
+ TWSAQUERYSET = TWSAQUERYSETA;
+ PWSAQUERYSET = PWSAQUERYSETA;
+ LPWSAQUERYSET = LPWSAQUERYSETA;
+{$endif}
+
+ const
+ LUP_DEEP = $0001;
+ LUP_CONTAINERS = $0002;
+ LUP_NOCONTAINERS = $0004;
+ LUP_NEAREST = $0008;
+ LUP_RETURN_NAME = $0010;
+ LUP_RETURN_TYPE = $0020;
+ LUP_RETURN_VERSION = $0040;
+ LUP_RETURN_COMMENT = $0080;
+ LUP_RETURN_ADDR = $0100;
+ LUP_RETURN_BLOB = $0200;
+ LUP_RETURN_ALIASES = $0400;
+ LUP_RETURN_QUERY_STRING = $0800;
+ LUP_RETURN_ALL = $0FF0;
+ LUP_RES_SERVICE = $8000;
+ LUP_FLUSHCACHE = $1000;
+ LUP_FLUSHPREVIOUS = $2000;
+
+ { Return flags }
+
+ RESULT_IS_ALIAS = $0001;
+
+ { Service Address Registration and Deregistration Data Types. }
+
+ type
+
+ TWSAESETSERVICEOP =
+ (RNRSERVICE_REGISTER := 0,RNRSERVICE_DEREGISTER, RNRSERVICE_DELETE);
+ PWSAESETSERVICEOP = ^TWSAESETSERVICEOP;
+ LPWSAESETSERVICEOP = ^TWSAESETSERVICEOP;
+
+ { Service Installation/Removal Data Types. }
+
+ TWSANSClassInfoA = record
+ lpszName : PChar;
+ dwNameSpace : DWORD;
+ dwValueType : DWORD;
+ dwValueSize : DWORD;
+ lpValue : Pointer;
+ end;
+ PWSANSCLASSINFOA = ^TWSANSClassInfoA;
+ LPWSANSCLASSINFOA = ^TWSANSClassInfoA;
+
+ TWSANSClassInfoW = record
+ lpszName : PWideChar;
+ dwNameSpace : DWORD;
+ dwValueType : DWORD;
+ dwValueSize : DWORD;
+ lpValue : Pointer;
+ end;
+ PWSANSCLASSINFOW = ^TWSANSClassInfoW;
+ LPWSANSCLASSINFOW = ^TWSANSClassInfoW;
+{$ifdef UNICODE}
+ type
+ TWSANSCLASSINFO = TWSANSCLASSINFOW;
+ PWSANSCLASSINFO = PWSANSCLASSINFOW;
+ LPWSANSCLASSINFO = LPWSANSCLASSINFOW;
+{$else}
+ type
+ TWSANSCLASSINFO = TWSANSCLASSINFOA;
+ PWSANSCLASSINFO = PWSANSCLASSINFOA;
+ LPWSANSCLASSINFO = LPWSANSCLASSINFOA;
+{$endif}
+
+ type
+ TWSAServiceClassInfoA = record
+ lpServiceClassId : LPGUID;
+ lpszServiceClassName : PChar;
+ dwCount : DWORD;
+ lpClassInfos : LPWSANSCLASSINFOA;
+ end;
+ PWSASERVICECLASSINFOA = ^TWSAServiceClassInfoA;
+ LPWSASERVICECLASSINFOA = ^TWSAServiceClassInfoA;
+
+ TWSAServiceClassInfoW = record
+ lpServiceClassId : LPGUID;
+ lpszServiceClassName : PWideChar;
+ dwCount : DWORD;
+ lpClassInfos : LPWSANSCLASSINFOW;
+ end;
+ PWSASERVICECLASSINFOW = ^TWSAServiceClassInfoW;
+ LPWSASERVICECLASSINFOW = ^TWSAServiceClassInfoW;
+
+{$ifdef UNICODE}
+ type
+ TWSASERVICECLASSINFO = TWSASERVICECLASSINFOW;
+ PWSASERVICECLASSINFO = PWSASERVICECLASSINFOW;
+ LPWSASERVICECLASSINFO = LPWSASERVICECLASSINFOW;
+{$else}
+ type
+ TWSASERVICECLASSINFO = TWSASERVICECLASSINFOA;
+ PWSASERVICECLASSINFO = PWSASERVICECLASSINFOA;
+ LPWSASERVICECLASSINFO = LPWSASERVICECLASSINFOA;
+{$endif}
+
+ type
+ TWSANAMESPACE_INFOA = record
+ NSProviderId : TGUID;
+ dwNameSpace : DWORD;
+ fActive : BOOL;
+ dwVersion : DWORD;
+ lpszIdentifier: PChar;
+ end;
+ PWSANAMESPACE_INFOA = ^TWSANAMESPACE_INFOA;
+ LPWSANAMESPACE_INFOA = ^TWSANAMESPACE_INFOA;
+
+ TWSANAMESPACE_INFOW = record
+ NSProviderId : TGUID;
+ dwNameSpace : DWORD;
+ fActive : BOOL;
+ dwVersion : DWORD;
+ lpszIdentifier: PWideChar;
+ end;
+ PWSANAMESPACE_INFOW = ^TWSANAMESPACE_INFOW;
+ LPWSANAMESPACE_INFOW = ^TWSANAMESPACE_INFOW;
+{$ifdef UNICODE}
+ type
+ TWSANAMESPACE_INFO = TWSANAMESPACE_INFOW;
+ PWSANAMESPACE_INFO = PWSANAMESPACE_INFOW;
+ LPWSANAMESPACE_INFO = LPWSANAMESPACE_INFOW;
+{$else}
+ type
+ TWSANAMESPACE_INFO = TWSANAMESPACE_INFOA;
+ PWSANAMESPACE_INFO = PWSANAMESPACE_INFOA;
+ LPWSANAMESPACE_INFO = LPWSANAMESPACE_INFOA;
+{$endif}
+
+ { WinSock 2 extensions -- data types for the condition function in
+ WSAAccept() and overlapped I/O completion routine. }
+
+ type
+ TWSAOVERLAPPED_COMPLETION_ROUTINE =
+ function (dwError,cbTransferred : longint;
+ lpOverlapped : PWSAOVERLAPPED;
+ dwFlags : longint) : longint;
+ {$ifdef netware} cdecl; {$else} stdcall; {$endif}
+
+ TCONDITIONPROC =
+ function (lpCallerId, lpCallerData : PWSABUF;
+ lpSQOS, lpGQOS : PQOS;
+ lpCalleeId, lpCalleeData : PWSABUF;
+ g : PGROUP;
+ dwCallbackData : dword) : longint;
+ {$ifdef netware} cdecl; {$else} stdcall; {$endif}
+
+{--------------------------------------------------------------------}
+{netware extensions from ws2nlm.h}
+{$ifdef netware}
+ { New Address Types }
+
+ const
+ AF_INET_ACP = 25;
+ AF_IPX_ACP = 26;
+ AF_ACP = 27;
+
+ { NetWare SSL Ioctls }
+
+ const
+ SECURITY_PROTOCOL_SSL = 1;
+ SECURITY_PROTOCOL_TLS = 2;
+
+ { There are three interesting authentication types }
+ { CLIENT - Client initiates a SSL connection. }
+ { SERVER - Listener set up to listen for incoming SSL conns, (Server sends it's cert during auth) }
+ { MUTUAL is SSL Server requesting client authentication, (Server asks for client cert inaddition to sending it's cert) }
+ { optval is a DWORD defined as }
+
+ const
+ MUTUAL = $00000002;
+
+ { System flags not defined in NetWare }
+
+ const
+ INFINITE = $FFFFFFFF;
+ WAIT_OBJECT_0 = 0;
+
+ {Various Types that may not be defined }
+ { }
+ { }
+ { Predefined Value Types. }
+ { }
+ { No value type }
+
+ const
+ REG_NONE = 0;
+ REG_SZ = 1;
+ REG_EXPAND_SZ = 2;
+ REG_BINARY = 3;
+ REG_DWORD = 4;
+ REG_DWORD_LITTLE_ENDIAN = 4;
+ REG_DWORD_BIG_ENDIAN = 5;
+ REG_LINK = 6;
+ REG_MULTI_SZ = 7;
+ REG_RESOURCE_LIST = 8;
+ REG_FULL_RESOURCE_DESCRIPTOR = 9;
+ REG_RESOURCE_REQUIREMENTS_LIST = 10;
+
+ ERROR_INVALID_HANDLE = 6;
+ ERROR_NOT_ENOUGH_MEMORY = 8;
+ ERROR_INVALID_PARAMETER = 87;
+ ERROR_IO_PENDING = 997;
+ ERROR_OPERATION_ABORTED = 995;
+ ERROR_IO_INCOMPLETE = 996;
+
+ { connect timeout }
+
+ const
+ SO_CONNTIMEO = $1009;
+ { NetWare Fast Accept and Recv option structures }
+ { Fast Recv also has a cleanup routine returned. }
+
+ type
+
+ LPFASTACCEPT_COMPLETION_ROUTINE = longint;
+ LPFASTRECV_COMPLETION_ROUTINE = longint;
+
+ TFASTACCEPT_OP = record
+ acceptHandler : LPFASTACCEPT_COMPLETION_ROUTINE;
+ arg : pointer;
+ end;
+ LPFAST_ACCEPT_OPT = ^TFASTACCEPT_OP;
+ PFAST_ACCEPT_OPT = ^TFASTACCEPT_OP;
+
+ TFASTRECV_OP = record
+ recvHandler : LPFASTRECV_COMPLETION_ROUTINE;
+ Arg : pointer;
+ end;
+ LPFAST_RECV_OPT = ^TFASTRECV_OP;
+ PFAST_RECV_OPT = ^TFASTRECV_OP;
+
+ { Winsock 2 applications that want to use SSL need to define WS_SSL }
+ type
+ time_t = dword;
+
+ { Secure Sockets Layer - needed until Winsock SDK supplies ssl header file. }
+ { Taken from Winsock 2 protocol Annex for SSL Security Protocol. Unsupported }
+ { options are labeled "not supported". }
+ { This value is the SSL protocol tag and WSAIoctl dwIoControlCode
+ "T" value. }
+
+ const
+ _SO_SSL = (2 shl 27) or ($73 shl 16);
+ {
+ These values are used to form the WSAIoctl dwIoControlCode
+ "Code" value.
+ }
+ _SO_SSL_FLAGS = $01;
+ _SO_SSL_CIPHERS = $02;
+ _SO_SSL_SERVER = $04;
+ { not supported }
+ _SO_SSL_AUTH_CERT_HOOK = $08;
+ { not supported }
+ _SO_SSL_RSA_ENCRYPT_HOOK = $10;
+ { not supported }
+ _SO_SSL_RSA_DECRYPT_HOOK = $20;
+ { _SO_SSL_CLIENT has been changed from 0x03 to 0x80 to avoid bitwise }
+ { conflicts with _SO_SSL_CIPHERS _SO_SSL_FLAGS. }
+ _SO_SSL_CLIENT = $80;
+ { Actual SSL Ioctl commands }
+ SO_SSL_GET_FLAGS = (IOC_IN or _SO_SSL) or _SO_SSL_FLAGS;
+ SO_SSL_SET_FLAGS = (IOC_OUT or _SO_SSL) or _SO_SSL_FLAGS;
+ SO_SSL_GET_CIPHERS = (IOC_IN or _SO_SSL) or _SO_SSL_CIPHERS;
+ {not supported }
+ SO_SSL_SET_CIPHERS = (IOC_OUT or _SO_SSL) or _SO_SSL_CIPHERS;
+ SO_SSL_GET_CLIENT = (IOC_IN or _SO_SSL) or _SO_SSL_CLIENT;
+ SO_SSL_SET_CLIENT = (IOC_OUT or _SO_SSL) or _SO_SSL_CLIENT;
+ SO_SSL_GET_SERVER = (IOC_IN or _SO_SSL) or _SO_SSL_SERVER;
+ SO_SSL_SET_SERVER = (IOC_OUT or _SO_SSL) or _SO_SSL_SERVER;
+ {not supported }
+ SO_SSL_GET_AUTH_CERT_HOOK = (IOC_IN or _SO_SSL) or _SO_SSL_AUTH_CERT_HOOK;
+ {not supported }
+ SO_SSL_SET_AUTH_CERT_HOOK = (IOC_OUT or _SO_SSL) or _SO_SSL_AUTH_CERT_HOOK;
+ {not supported }
+ SO_SSL_GET_RSA_ENCRYPT_HOOK = (IOC_IN or _SO_SSL) or _SO_SSL_RSA_ENCRYPT_HOOK;
+ {not supported }
+ SO_SSL_SET_RSA_ENCRYPT_HOOK = (IOC_OUT or _SO_SSL) or _SO_SSL_RSA_ENCRYPT_HOOK;
+ {not supported }
+ SO_SSL_GET_RSA_DECRYPT_HOOK = (IOC_IN or _SO_SSL) or _SO_SSL_RSA_DECRYPT_HOOK;
+ {not supported }
+ SO_SSL_SET_RSA_DECRYPT_HOOK = (IOC_OUT or _SO_SSL) or _SO_SSL_RSA_DECRYPT_HOOK;
+ SO_SSL_ENABLE = $001;
+ SO_SSL_SERVER = $002;
+ SO_SSL_AUTH_CLIENT = $004;
+ {not supported }
+ SO_SSL_ACCEPT_WEAK = $008;
+
+ type
+
+ Tsslcipheropts = record
+ n : longint;
+ specs : array[0..2] of char;
+ end;
+
+ Tsslclientopts = record
+ cert : PChar;
+ certlen : longint;
+ sidtimeout : time_t;
+ sidentries : longint;
+ siddir : PChar;
+ end;
+
+ Tsslserveropts = record
+ cert : PChar;
+ certlen : longint;
+ sidtimeout : time_t;
+ sidentries : longint;
+ siddir : PChar;
+ end;
+
+ {not suppported }
+ {Tsslauthcertopts = record
+ _type : longint;
+ func : function (arg:pointer; cert:Pchar; len:longint):longint;cdecl;
+ arg : pointer;
+ end;}
+
+ {not supported }
+
+ const
+ SSL_ACK_OK = 1;
+ {not supported }
+ SSL_ACH_WEAK_OK = 2;
+ {not supported }
+ SSL_ACH_LONG_DATA = 3;
+ {not supported }
+ SSL_ACH_BAD_DATA = 4;
+ {not supported }
+ SSL_ACH_BAD_SIG = 5;
+ {not supported }
+ SSL_ACH_CERT_EXPIRED = 6;
+ {not suppported }
+
+ type
+ sslrsaencrypthook = record
+ func : function (arg:pointer; blockType:longint; dest:Pchar; destlen:Plongint; src:Pchar;
+ srclen:longint):longint; cdecl;
+ arg : pointer;
+ end;
+
+ {not supported }
+
+ const
+ SSL_REH_OK = 0;
+ {not supported }
+ SSL_REH_BAD_TYPE = 1;
+ {not supported }
+ SSL_REH_BAD_LEN = 2;
+ {not suppported }
+
+ type
+ Tsslrsadecrypthook = record
+ func : function (arg:pointer; blockType:longint; dest:Pchar; destlen:Plongint; src:Pchar;
+ srclen:longint):longint; cdecl;
+ arg : pointer;
+ end;
+ Psslrsadecrypthook = ^Tsslrsadecrypthook;
+
+ {not supported }
+
+ const
+ SSL_RDH_OK = 0;
+ {not supported }
+ SSL_RDH_BAD_TYPE = 1;
+ {not supported }
+ SSL_RDH_BAD_LEN = 2;
+ { TLS options }
+ { Secure Sockets Layer - needed until Winsock SDK supplies ssl header file. }
+ { Taken from Winsock 2 protocol Annex for SSL Security Protocol. Unsupported }
+ { options are labeled "not supported". }
+ {
+ This value is the SSL protocol tag and WSAIoctl dwIoControlCode
+ "T" value. This value is unique to distinguish a TLS Ioctl from an SSL
+ Ioctl due to different structure definitions.
+ }
+ _SO_TLS = (2 shl 27) or ($74 shl 16);
+ {
+ These values are used to form the WSAIoctl dwIoControlCode
+ "Code" value.
+ }
+ _SO_TLS_FLAGS = $01;
+ _SO_TLS_CIPHERS = $02;
+ _SO_TLS_SERVER = $04;
+ { not supported }
+ _SO_TLS_AUTH_CERT_HOOK = $08;
+ { not supported }
+ _SO_TLS_RSA_ENCRYPT_HOOK = $10;
+ { not supported }
+ _SO_TLS_RSA_DECRYPT_HOOK = $20;
+ _SO_TLS_CERT = $40;
+ { _SO_TLS_CLIENT has been changed from 0x03 to 0x80 to avoid bitwise }
+ { conflicts with _SO_TLS_CIPHERS _SO_TLS_FLAGS. }
+ _SO_TLS_CLIENT = $80;
+ {
+ Actual TLS Ioctl commands
+ }
+ SO_TLS_GET_FLAGS = (IOC_IN or _SO_TLS) or _SO_TLS_FLAGS;
+ SO_TLS_SET_FLAGS = (IOC_OUT or _SO_TLS) or _SO_TLS_FLAGS;
+ SO_TLS_GET_CIPHERS = (IOC_IN or _SO_TLS) or _SO_TLS_CIPHERS;
+ {not supported }
+ SO_TLS_SET_CIPHERS = (IOC_OUT or _SO_TLS) or _SO_TLS_CIPHERS;
+ SO_TLS_GET_CLIENT = (IOC_IN or _SO_TLS) or _SO_TLS_CLIENT;
+ SO_TLS_SET_CLIENT = (IOC_OUT or _SO_TLS) or _SO_TLS_CLIENT;
+ SO_TLS_GET_SERVER = (IOC_IN or _SO_TLS) or _SO_TLS_SERVER;
+ SO_TLS_SET_SERVER = (IOC_OUT or _SO_TLS) or _SO_TLS_SERVER;
+ SO_TLS_GET_CERT = (IOC_IN or _SO_TLS) or _SO_TLS_CERT;
+ {not supported }
+ SO_TLS_GET_AUTH_CERT_HOOK = (IOC_IN or _SO_TLS) or _SO_TLS_AUTH_CERT_HOOK;
+ {not supported }
+ SO_TLS_SET_AUTH_CERT_HOOK = (IOC_OUT or _SO_TLS) or _SO_TLS_AUTH_CERT_HOOK;
+ {not supported }
+ SO_TLS_GET_RSA_ENCRYPT_HOOK = (IOC_IN or _SO_TLS) or _SO_TLS_RSA_ENCRYPT_HOOK;
+ {not supported }
+ SO_TLS_SET_RSA_ENCRYPT_HOOK = (IOC_OUT or _SO_TLS) or _SO_TLS_RSA_ENCRYPT_HOOK;
+ {not supported }
+ SO_TLS_GET_RSA_DECRYPT_HOOK = (IOC_IN or _SO_TLS) or _SO_TLS_RSA_DECRYPT_HOOK;
+ {not supported }
+ SO_TLS_SET_RSA_DECRYPT_HOOK = (IOC_OUT or _SO_TLS) or _SO_TLS_RSA_DECRYPT_HOOK;
+ SO_TLS_ENABLE = $0001;
+ SO_TLS_SERVER = $0002;
+ SO_TLS_AUTH_CLIENT = $0004;
+ {not supported }
+ SO_TLS_ACCEPT_WEAK = $0008;
+ SO_TLS_MAP_DISABLE = $0010;
+ SO_TLS_MAP_IDENTITY = $0020;
+ SO_TLS_BLIND_ACCEPT = $0040;
+ SO_TLS_INTERACTIVE_ACCEPT = $0080;
+
+ type
+ Ttlscipheropts = record
+ n : longint;
+ specs : array[0..2] of char;
+ end;
+ Ptlscipheropts = ^Ttlscipheropts;
+
+ Ttlsclientopts = record
+ wallet : PWideChar; // ^unicode;
+ walletlen : longint;
+ sidtimeout : time_t;
+ sidentries : longint;
+ siddir : PChar; // ^char;
+ options : pointer;
+ end;
+ Ptlsclientopts = ^Ttlsclientopts;
+
+ Ttlsserveropts = record
+ wallet : PWideChar; // ^unicode;
+ walletlen : longint;
+ sidtimeout : time_t;
+ sidentries : longint;
+ siddir : PChar; // ^char;
+ options : pointer;
+ end;
+ Ptlsserveropts = ^Ttlsserveropts;
+
+ {wallet content provider e.g. PFX, KMO, DER. }
+ {alias for private key in wallet to be used }
+ { not used for anything but pfx wallet provider }
+ {number of elements in the array }
+ {array of trusted root names }
+ {number of elements in the array }
+ {reserved to set ciphers }
+ {reserved for CRL }
+ {reserved for CRL len. }
+ Tnwtlsopts = record
+ walletProvider : PWideChar; //^unicode;
+ keysList : PPWideChar; // ^^unicode;
+ numElementsInKeyList : longint;
+ TrustedRootList : PPWideChar; // ^^unicode;
+ numElementsInTRList : longint;
+ reservedforfutureuse : pointer;
+ reservedforfutureCRL : pointer;
+ reservedforfutureCRLLen : longint;
+ reserved1 : pointer;
+ reserved2 : pointer;
+ reserved3 : pointer;
+ end;
+ Pnwtlsopts=^Tnwtlsopts;
+
+ {not suppported }
+ {tlsauthcertopts = record
+ _type : longint;
+ func : function (arg:pointer; cert:Pchar; len:longint):longint; cdecl;
+ arg : pointer;
+ end;}
+
+ {not supported }
+
+ const
+ TLS_ACK_OK = 1;
+ {not supported }
+ TLS_ACH_WEAK_OK = 2;
+ {not supported }
+ TLS_ACH_LONG_DATA = 3;
+ {not supported }
+ TLS_ACH_BAD_DATA = 4;
+ {not supported }
+ TLS_ACH_BAD_SIG = 5;
+ {not supported }
+ TLS_ACH_CERT_EXPIRED = 6;
+ {not suppported }
+
+ type
+ Ttlsrsaencrypthook = record
+ func : function (arg:pointer; blockType:longint; dest:Pchar; destlen:Plongint; src:Pchar;
+ srclen:longint):longint; cdecl;
+ arg : pointer;
+ end;
+ Ptlsrsaencrypthook=^Ttlsrsaencrypthook;
+
+ {not supported }
+
+ const
+ TLS_REH_OK = 0;
+ {not supported }
+ TLS_REH_BAD_TYPE = 1;
+ {not supported }
+ TLS_REH_BAD_LEN = 2;
+ {not suppported }
+
+ type
+ Ttlsrsadecrypthook = record
+ func : function (arg:pointer; blockType:longint; dest:Pchar; destlen:Plongint; src:Pchar;
+ srclen:longint):longint; cdecl;
+ arg : pointer;
+ end;
+ Ptlsrsadecrypthook=^Ttlsrsadecrypthook;
+ {not supported }
+
+ const
+ TLS_RDH_OK = 0;
+ {not supported }
+ TLS_RDH_BAD_TYPE = 1;
+ {not supported }
+ TLS_RDH_BAD_LEN = 2;
+
+ type
+ Ttlscert = record
+ cert : PChar;
+ certlen : longint;
+ end;
+ Ptlscert = ^Ttlscert;
+
+ const SIO_RAWCALLBACKS = $1ADD0002;
+ SIO_WORKTODOCALLBACKS = $1ADD0004;
+ SIO_FASTACCEPTCALLBACK = $1ADD0008;
+ SIO_FASTRECVCALLBACK = $1ADD000C;
+ SIO_RCVFULLMSG = $1ADD0010;
+ SIO_SSL_CRYPTFILE = $1ADD0010;
+ SIO_SSL_AUTHTYPE = $1ADD0020;
+ SIO_SSL_CONVERT = $1ADD0040;
+ SKTS_RAWCALLBACKS = $40000000;
+ SKTS_WORKTODOCALLBACKS = $20000000;
+ WAIT_ABANDONED = $00000080;
+ WAIT_TIMEOUT = $00000102;
+ WAIT_FAILED = $FFFFFFFF;
+ MAXIMUM_WAIT_OBJECTS = 64;
+ WAIT_IO_COMPLETION = $000000C0;
+
+ { This file contains proposed extensions to the Winsock 2 specification to }
+ { support Novell's implementation of namespace providers. }
+
+ {___[ Manifest constants ]________________________________________________________________________ }
+ { Proposed output flag for deregistered services }
+ const
+ RESULT_IS_DEREGISTERED = $0002;
+ { Proposed output flag for containers }
+ RESULT_IS_CONTAINER = $0004;
+
+ { Values used to indicate an attribute list in the blob }
+ { blob contains ASCII strings }
+
+ WS_ATTRLIST_ASCII = $b10bea1a;
+ { blob contains UNICODE strings }
+ WS_ATTRLIST_UNICODE = $b10bea10;
+ { Name Spaces }
+ { Extends definitions in WINSOCK2.H }
+ NS_BINDERY = 4;
+ NS_SLP = 5;
+ { Predefined BLOB Value Types }
+ { Extends Predefined Value Types in winnt.h }
+
+ REG_BOOL = 11; // Boolean value; TRUE or FALSE }
+ REG_KEYWORD = 12; // Keyword with no value
+
+ {___[ Type definitions ]__________________________________________________________________________ }
+
+ type
+
+ TWSAATTRINFO = TWSANSCLASSINFO;
+ LPWSAATTRINFO = ^TWSAATTRINFO;
+ PWSAATTRINFO = ^TWSAATTRINFO;
+ { Structure of a blob containing an attribute list }
+ { Identifies the blob as an attribute list }
+ { Number of attributes present }
+ { Pointer to attribute array }
+
+ TWSABlobAttrList = record
+ dwSignature : DWORD;
+ dwAttrCount : DWORD;
+ lpAttributes : PWSAATTRINFO;
+ end;
+ LPWSABLOBATTRLIST = ^TWSABlobAttrList;
+ PWSABLOBATTRLIST = ^TWSABlobAttrList;
+{$endif netware}
+
+{--------------------------------------------------------------------}
+
+ { Socket function prototypes }
+ const
+ {$ifndef netware}
+ winsockdll = 'ws2_32.dll';
+ _fn_bind = 'bind';
+ _fn_closesocket = 'closesocket';
+ _fn_ioctlsocket = 'ioctlsocket';
+ _fn_getpeername = 'getpeername';
+ _fn_getsockopt = 'getsockopt';
+ _fn_htonl = 'htonl';
+ _fn_htons = 'htons';
+ _fn_inet_addr = 'inet_addr';
+ _fn_inet_ntoa = 'inet_ntoa';
+ _fn_listen = 'listen';
+ _fn_recv = 'recv';
+ _fn_recvfrom = 'recvfrom';
+ _fn_select = 'select';
+ _fn_send = 'send';
+ _fn_sendto = 'sendto';
+ _fn_setsockopt = 'setsockopt';
+ _fn_shutdown = 'shutdown';
+ _fn_socket = 'socket';
+ _fn_gethostbyaddr = 'gethostbyaddr';
+ _fn_gethostbyname = 'gethostbyname';
+ _fn_gethostname = 'gethostname';
+ _fn_getservbyport = 'getservbyport';
+ _fn_getservbyname = 'getservbyname';
+ _fn_getprotobynumber = 'getprotobynumber';
+ _fn_getprotobyname = 'getprotobyname';
+ {$else}
+ winsockdll = 'ws2_32.nlm';
+ {for netware the function names for the non WSA-functions are
+ different because the names are already present from bsd-sockets}
+ _fn_bind = 'WS2_32_bind';
+ _fn_closesocket = 'WS2_32_closesocket';
+ _fn_ioctlsocket = 'WS2_32_ioctlsocket';
+ _fn_getpeername = 'WS2_32_getpeername';
+ _fn_getsockopt = 'WS2_32_getsockopt';
+ _fn_htonl = 'WS2_32_htonl';
+ _fn_htons = 'WS2_32_htons';
+ _fn_inet_addr = 'WS2_32_inet_addr';
+ _fn_inet_ntoa = 'WS2_32_inet_ntoa';
+ _fn_listen = 'WS2_32_listen';
+ _fn_recv = 'WS2_32_recv';
+ _fn_recvfrom = 'WS2_32_recvfrom';
+ _fn_select = 'WS2_32_select';
+ _fn_send = 'WS2_32_send';
+ _fn_sendto = 'WS2_32_sendto';
+ _fn_setsockopt = 'WS2_32_setsockopt';
+ _fn_shutdown = 'WS2_32_shutdown';
+ _fn_socket = 'WS2_32_socket';
+ _fn_gethostbyaddr = 'WS2_32_gethostbyaddr';
+ _fn_gethostbyname = 'WS2_32_gethostbyname';
+ _fn_gethostname = 'WS2_32_gethostname';
+ _fn_getservbyport = 'WS2_32_getservbyport';
+ _fn_getservbyname = 'WS2_32_getservbyname';
+ _fn_getprotobynumber = 'WS2_32_getprotobynumber';
+ _fn_getprotobyname = 'WS2_32_getprotobyname';
+ {$endif}
+
+{
+Winsock types all buffers as pchar (char *), modern POSIX does it the ANSI
+C way with pointer (void *). If the pointer overloaded version doesn't exist,
+a "pointer" will be passed to the "var" version. (bug 3142).
+So if there are var/const versions:
+- To keep ported unix code working, there must be "pointer" variants (ANSI)
+- To keep Delphi/ported C Winsock code working there must be pchar variants
+ (K&R)
+IOW, there _must_ be 3 versions then: var/const, pchar and pointer}
+
+ {$ifdef netware}
+ function accept(s:TSocket; addr: PSockAddr; addrlen : ptOS_INT) : TSocket;
+ function accept(s:TSocket; addr: PSockAddr; var addrlen : tOS_INT) : TSocket;
+ {$else}
+ function accept(s:TSocket; addr: PSockAddr; addrlen : ptOS_INT) : TSocket;stdcall;external winsockdll name 'accept';
+ function accept(s:TSocket; addr: PSockAddr; var addrlen : tOS_INT) : TSocket;stdcall;external winsockdll name 'accept';
+ {$endif}
+ function bind(s:TSocket; addr: PSockaddr;namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_Bind;
+ function bind(s:TSocket; const addr: TSockaddr;namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_Bind;
+ function closesocket(s:TSocket):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_closesocket;
+ {$ifdef netware}
+ function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT;
+ function connect(s:TSocket; Const name:TSockAddr; namelen:tOS_INT):tOS_INT;
+ {$else}
+ function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT; stdcall;external winsockdll name 'connect';
+ function connect(s:TSocket; Const name:TSockAddr; namelen:tOS_INT):tOS_INT; stdcall;external winsockdll name 'connect';
+ {$endif}
+
+ function ioctlsocket(s:TSocket; cmd:longint; var arg:u_long):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_ioctlsocket;
+ function ioctlsocket(s:TSocket; cmd:longint; var arg:longint):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_ioctlsocket;
+ function ioctlsocket(s:TSocket; cmd:longint; argp:pu_long):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_ioctlsocket;
+ function getpeername(s:TSocket; var name:TSockAddr;var namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_getpeername;
+ function getsockname(s:TSocket; var name:TSockAddr;var namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_getpeername;
+ function getsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pchar;var optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_getsockopt;
+ function getsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pointer;var optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_getsockopt;
+ function getsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT;var optval;var optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_getsockopt;
+ function htonl(hostlong:u_long):u_long;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_htonl;
+ function htons(hostshort:u_short):u_short;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_htons;
+ function inet_addr(cp:pchar):cardinal;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_inet_addr;
+ function inet_ntoa(i : TInAddr):pchar;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_inet_ntoa;
+ function listen(s:TSocket; backlog:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_listen;
+ { are ntohl and ntohs macros or bsd-functions (for netware) ?? }
+ {$ifndef netware}
+ function ntohl(netlong:u_long):u_long;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'ntohl';
+ function ntohs(netshort:u_short):u_short;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'ntohs';
+ {$endif}
+
+ function recv(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv;
+ function recv(s:TSocket;buf:pointer; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv;
+ function recv(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_recv;
+ function recvfrom(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT;from:PSockAddr; fromlen:ptOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom;
+ function recvfrom(s:TSocket;buf:pointer; len:tOS_INT; flags:tOS_INT;from:PSockAddr; fromlen:ptOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom;
+ function recvfrom(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT;Const from:TSockAddr; var fromlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_recvfrom;
+ function select(nfds:tOS_INT; readfds,writefds,exceptfds : PFDSet;timeout: PTimeVal):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_select;
+ function send(s:TSocket;const buf; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_send;
+ function send(s:TSocket;buf : pchar; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_send;
+ function send(s:TSocket;buf : pointer; len:tOS_INT; flags:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_send;
+ function sendto(s:TSocket; buf:pchar; len:tOS_INT; flags:tOS_INT;toaddr:PSockAddr; tolen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_sendto;
+ function sendto(s:TSocket; buf:pointer; len:tOS_INT; flags:tOS_INT;toaddr:PSockAddr; tolen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_sendto;
+ function sendto(s:TSocket; const buf; len:tOS_INT; flags:tOS_INT;Const toaddr:TSockAddr; tolen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}
+ external winsockdll name _fn_sendto;
+
+ function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pchar; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_setsockopt;
+ function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; Const optval; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_setsockopt;
+ function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pointer; optlen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_setsockopt;
+ function shutdown(s:TSocket; how:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_shutdown;
+ function socket(af:tOS_INT; t:tOS_INT; protocol:tOS_INT):TSocket;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name _fn_socket;
+
+ { Database function prototypes }
+ function gethostbyaddr(addr:pchar; len:tOS_INT; t:tOS_INT): PHostEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_gethostbyaddr;
+ function gethostbyname(name:pchar):PHostEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_gethostbyname;
+ function gethostname(name:pchar; namelen:tOS_INT):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_gethostname;
+ function getservbyport(port:tOS_INT; proto:pchar):PServEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_getservbyport;
+ function getservbyname(name:pchar; proto:pchar):PServEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_getservbyname;
+ function getprotobynumber(proto:tOS_INT):PProtoEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_getprotobynumber;
+ function getprotobyname(name:pchar):PProtoEnt;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name _fn_getprotobyname;
+
+ { Microsoft Windows Extension function prototypes }
+ function WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;
+ function WSACleanup:tOS_INT;
+ procedure WSASetLastError(iError:tOS_INT);{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSASetLastError';
+ function WSAGetLastError:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetLastError';
+ {$ifndef netware}
+ //function WSAIsBlocking:BOOL;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAIsBlocking';
+ // function WSAUnhookBlockingHook:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAUnhookBlockingHook';
+ // function WSASetBlockingHook(lpBlockFunc:TFarProc):TFarProc;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSASetBlockingHook';
+ {$endif}
+ function WSACancelBlockingCall:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSACancelBlockingCall';
+ {$ifndef netware}
+ function WSAAsyncGetServByName(hWnd:HWND; wMsg:u_int; name:pchar; proto:pchar; buf:pchar;
+ buflen:tOS_INT):THandle;stdcall;external winsockdll name 'WSAAsyncGetServByName';
+ function WSAAsyncGetServByPort(hWnd:HWND; wMsg:u_int; port:tOS_INT; proto:pchar; buf:pchar;
+ buflen:tOS_INT):THandle;stdcall;external winsockdll name 'WSAAsyncGetServByPort';
+ function WSAAsyncGetProtoByName(hWnd:HWND; wMsg:u_int; name:pchar; buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetProtoByName';
+ function WSAAsyncGetProtoByNumber(hWnd:HWND; wMsg:u_int; number:tOS_INT; buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetProtoByNumber';
+ function WSAAsyncGetHostByName(hWnd:HWND; wMsg:u_int; name:pchar; buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetHostByName';
+ function WSAAsyncGetHostByAddr(hWnd:HWND; wMsg:u_int; addr:pchar; len:tOS_INT; t:tOS_INT;
+ buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetHostByAddr';
+ function WSACancelAsyncRequest(hAsyncTaskHandle:THandle):tOS_INT;stdcall;
+ external winsockdll name 'WSACancelAsyncRequest';
+ function WSAAsyncSelect(s:TSocket; hWnd:HWND; wMsg:u_int; lEvent:longint):tOS_INT; stdcall;
+ external winsockdll name 'WSAAsyncSelect';
+ function WSARecvEx(s:TSocket;var buf; len:tOS_INT; flags:ptOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'WSARecvEx';
+ {$endif}
+ function __WSAFDIsSet(s:TSocket; var FDSet:TFDSet):Bool;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name '__WSAFDIsSet';
+ function __WSAFDIsSet_(s:TSocket; var FDSet:TFDSet):tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name '__WSAFDIsSet';
+
+ {$ifndef netware}
+ function TransmitFile(hSocket:TSocket; hFile:THandle; nNumberOfBytesToWrite:dword;
+ nNumberOfBytesPerSend:DWORD; lpOverlapped:POverlapped;
+ lpTransmitBuffers:PTransmitFileBuffers; dwReserved:dword):Bool;stdcall;
+ external winsockdll name 'TransmitFile';
+
+ function AcceptEx(sListenSocket,sAcceptSocket:TSocket;
+ lpOutputBuffer:Pointer; dwReceiveDataLength,dwLocalAddressLength,
+ dwRemoteAddressLength:dword; var lpdwBytesReceived:dword;
+ lpOverlapped:POverlapped):Bool;stdcall;
+ external winsockdll name 'AcceptEx';
+
+ procedure GetAcceptExSockaddrs(lpOutputBuffer:Pointer;
+ dwReceiveDataLength,dwLocalAddressLength,dwRemoteAddressLength:dword;
+ var LocalSockaddr:TSockAddr; var LocalSockaddrLength:tOS_INT;
+ var RemoteSockaddr:TSockAddr; var RemoteSockaddrLength:tOS_INT);stdcall;
+ external winsockdll name 'GetAcceptExSockaddrs';
+ {$endif}
+
+ function WSAMakeSyncReply(Buflen,Error:Word):dword;
+ function WSAMakeSelectReply(Event,Error:Word):dword;
+ function WSAGetAsyncBuflen(Param:dword):Word;
+ function WSAGetAsyncError(Param:dword):Word;
+ function WSAGetSelectEvent(Param:dword):Word;
+ function WSAGetSelectError(Param:dword):Word;
+ procedure FD_CLR(Socket:TSocket; var FDSet:TFDSet);
+ function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean;
+ procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
+ procedure FD_ZERO(var FDSet:TFDSet);
+
+ function MAKELONG(a,b : longint) : LONGINT;
+ function MAKEWORD(a,b : longint) : WORD;
+
+ { WinSock 2 API new function prototypes }
+
+ function WSAAccept(s: TSocket; addr:PSockAddr; addrlen : ptOS_INT;
+ lpfnCondition : TCONDITIONPROC;
+ dwCallbackData: dword) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAAccept';
+
+ function WSAAccept(s: TSocket; addr:PSockAddr; var addrlen:longint;
+ lpfnCondition : TCONDITIONPROC;
+ dwCallbackData: dword) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAAccept';
+
+ function WSACloseEvent (hEvent : TWSAEVENT) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSACloseEvent';
+
+ function WSAconnect (s:TSocket; Const name:TSockAddr;
+ namelen: tOS_INT;
+ lpCallerData, lpCaleeData : PWSABUF;
+ lpSQOS, lpGQOS : PQOS) : tOS_INT;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAConnect';
+
+ function WSAconnect (s:TSocket; name:PSockAddr;
+ namelen: tOS_INT;
+ lpCallerData, lpCaleeData : PWSABUF;
+ lpSQOS, lpGQOS : PQOS) : tOS_INT;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAConnect';
+
+ {$ifndef netware}
+ function WSADuplicateSocket (s:TSocket; dwProcessId:dword; lpProtoInfo: PWSAPROTOCOL_INFOA) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSADuplicateSocketA';
+ {$endif}
+
+ function WSAEnumNetworkEvents(s:TSocket;hEventObject:TWSAEVENT;lpNetworkEvents:PWSANETWORKEVENTS): longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAEnumNetworkEvents';
+
+ function WSAEnumProtocols (lpiProtocols:LPINT;
+ lpProtocolBuffer:PWSAPROTOCOL_INFOA;
+ var lpdwBufferLength : dword) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAEnumProtocolsA';
+
+ function WSAEventSelect(s:TSocket; hEventObject: TWSAEvent;lNetworkEvents:longint):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAEventSelect';
+
+ function WSAGetOverlappedResult (s:TSocket;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpcbTransfer : LPDWORD;
+ fWait : BOOL;
+ lpdwFlags : LPDWORD) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAGetOverlappedResult';
+
+ function WSAGetQOSByName(s:TSocket; lpQOSName: LPWSABUF; lpQOS:PQOS) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAGetQOSByName';
+
+ function WSAHtonl(s:TSocket; hostlong:u_long;lpnetlong:pu_long):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAHtonl';
+
+ function WSAHtonl(s:TSocket; hostlong:u_long;var lpnetlong:u_long):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAHtonl';
+
+ function WSAHtons(s:TSocket; hostshort:u_short;lpnetshort:pu_short):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAHtons';
+
+ function WSAHtons(s:TSocket; hostshort:u_short;var lpnetshort:u_short):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAHtons';
+
+ function WSAIoctl(s:TSocket;dwIoControlCode:dword;
+ lpvInBuffer:pointer; cbInBuffer:dword;
+ lpvOutBuffer:pointer; cbOutBuffer:dword;
+ lpcbBytesReturned:LPDWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAIoctl';
+
+ function WSAIoctl(s:TSocket;dwIoControlCode:dword;
+ var lpvInBuffer; cbInBuffer:dword;
+ var lpvOutBuffer; cbOutBuffer:dword;
+ var lpcbBytesReturned:DWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAIoctl';
+
+ function WSAJoinLeaf(s:TSocket; name: PSockAddr; namelen:longint;
+ lpCallerData,lpCalleeData:PWSABUF;
+ lpSQOS, lpGQOS : PQOS; dwFlags:dword):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAJoinLeaf';
+
+ function WSANtohl(s:TSocket;netlong:u_long;lphostlong:pu_long):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSANtohl';
+
+ function WSANtohl(s:TSocket;netlong:u_long;var hostlong:u_long):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSANtohl';
+
+ function WSANtohs(s:TSocket;netshort:u_short;lphostshort:pu_short):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSANtohs';
+
+ function WSANtohs(s:TSocket;netshort:u_short;var hostshort:u_short):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSANtohs';
+
+ function WSARecv(s:TSocket;buf:pchar; dwBufferCount:dword;
+ lpNumberOfBytesRecvd,lpFlags : LPDWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecv';
+
+ function WSARecv(s:TSocket;buf:pointer; dwBufferCount:dword;
+ lpNumberOfBytesRecvd,lpFlags : LPDWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecv';
+
+ function WSARecv(s:TSocket;var buf; dwBufferCount:dword;
+ var lpNumberOfBytesRecvd,lpFlags : DWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecv';
+
+ function WSARecvDisconnect(s:TSocket;lpInboundDisconnectData:PWSABUF):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecvDisconnect';
+
+ function WSARecvDisconnect(s:TSocket;var InboundDisconnectData:TWSABUF):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecvDisconnect';
+
+ function WSARecvFrom(s:TSocket;buf:pchar; dwBufferCount:dword;
+ lpNumberOfBytesRecvd,lpFlags : LPDWORD;
+ lpFrom: PSockaddr;
+ lpFromlen: PDWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecvFrom';
+
+ function WSARecvFrom(s:TSocket;buf:pointer; dwBufferCount:dword;
+ lpNumberOfBytesRecvd,lpFlags : LPDWORD;
+ lpFrom: PSockaddr;
+ lpFromlen: PDWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecvFrom';
+
+ function WSARecvFrom(s:TSocket;var buf; dwBufferCount:dword;
+ var lpNumberOfBytesRecvd,lpFlags : DWORD;
+ var lpFrom: TSockaddr;
+ var lpFromlen: DWORD;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSARecvFrom';
+
+ function WSAResetEvent(hEvent:TWSAEVENT):BOOL;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAResetEvent';
+
+ function WSASend(s:TSocket;buf:pchar;len:dword;
+ NumberOfBytesSent:PDWORD; Flags:dword;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASend';
+
+ function WSASend(s:TSocket;buf:pointer;len:dword;
+ NumberOfBytesSent:PDWORD; Flags:dword;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASend';
+
+ function WSASend(s:TSocket;var buf;len:dword;
+ var NumberOfBytesSent: DWORD; Flags:dword;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASend';
+
+ function WSASendDisconnect(s:TSocket;lpOutboundDisconnectData:PWSABUF):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASendDisconnect';
+
+ function WSASendTo(s:TSocket;buf:pchar;len:dword;
+ NumberOfBytesSent:LPDWORD;
+ Flags:dword;
+ lpTo: PSockaddr;
+ iToLen:dword;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASendTo';
+
+ function WSASendTo(s:TSocket;buf:pointer;len:dword;
+ NumberOfBytesSent:LPDWORD;
+ Flags:dword;
+ lpTo: PSockaddr;
+ iToLen:dword;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASendTo';
+
+ function WSASendTo(s:TSocket;var buf;len:dword;
+ var NumberOfBytesSent:DWORD;
+ Flags:dword;
+ var lpTo: TSockaddr;
+ iToLen:dword;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASendTo';
+
+ function WSASetEvent(hEvent:TWSAEVENT):BOOL;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASetEvent';
+
+ function WSASocket(af,typ,proto:tOS_INT;
+ lpProtocolInfo:PWSAPROTOCOL_INFO;
+ g : TGROUP; Flags:dword):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSASocketA';
+
+ function WSAWaitForMultipleEvents(cEvents:dword;
+ lphEvents:pointer; {IN const WSAEVENT FAR * lphEvents,}
+ fWaitAll:BOOL; dwTimeout:dword; fAlertable:BOOL):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAWaitForMultipleEvents';
+
+ function WSAAddressToString(addr:PSockAddr; len:dword;
+ ProtocolInfo:PWSAPROTOCOL_INFO;
+ lpszAddressString:pchar;
+ lpdwAddressStringLength:lpdword):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAAddressToStringA';
+
+ function WSAAddressToString(var addr:TSockAddr; len:dword;
+ ProtocolInfo:PWSAPROTOCOL_INFO;
+ lpszAddressString:pchar;
+ var lpdwAddressStringLength:dword):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAAddressToStringA';
+
+ function WSAStringToAddress (AddressString : pchar;
+ AddressFamily : longint;
+ lpProtocolInfo : PWSAPROTOCOL_INFOA;
+ VAR lpAddress : TSOCKADDR;
+ VAR lpAddressLength: LONGINT) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif} external winsockdll name 'WSAStringToAddressA';
+
+ function WSAStringToAddress (AddressString : pchar;
+ AddressFamily : longint;
+ lpProtocolInfo : PWSAPROTOCOL_INFOA;
+ lpAddress : PSOCKADDR;
+ VAR lpAddressLength: LONGINT) : longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAStringToAddressA';
+
+ function WSALookupServiceBegin(lpqsRestrictions:PWSAQUERYSET;
+ ControlFlags:dword;lphLookup:PHandle):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSALookupServiceBeginA';
+
+ function WSALookupServiceBegin(var Restrictions:TWSAQUERYSET;
+ ControlFlags:dword;var hLookup:THandle):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSALookupServiceBeginA';
+
+ function WSALookupServiceNext(hLookup:THandle;ControlFlags:dword;
+ lpdwBufferLength:LPDWORD;
+ lpqsResults:PWSAQUERYSET):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSALookupServiceNextA';
+
+ function WSAInstallServiceClass(lpServiceClassInfo:PWSASERVICECLASSINFO):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAInstallServiceClassA';
+
+ function WSARemoveServiceClass(lpServiceClassId:PGUID):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSARemoveServiceClass';
+
+ function WSAGetServiceClassInfo(lpProviderId,lpServiceClassId:PGUID;
+ lpdwBufSize:LPDWORD;
+ lpServiceClassInfo:PWSASERVICECLASSINFO):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetServiceClassInfoA';
+
+ function WSAGetServiceClassInfo(var ProviderId,ServiceClassId:TGUID;
+ var BufSize:DWORD;
+ var ServiceClassInfo:TWSASERVICECLASSINFO):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetServiceClassInfoA';
+
+ function WSAEnumNameSpaceProviders(lpdwBufferLength:LPDWORD;lpnspBuffer:PWSANAMESPACE_INFO):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAEnumNameSpaceProvidersA';
+
+ function WSAEnumNameSpaceProviders(var BufferLength:DWORD;var Buffer:TWSANAMESPACE_INFO):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAEnumNameSpaceProvidersA';
+
+ function WSAGetServiceClassNameByClassId(lpServiceClassId:PGUID;lpszServiceClassName:pchar;buflen:PDWORD):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetServiceClassNameByClassIdA';
+
+ function WSAGetServiceClassNameByClassId(var lpServiceClassId:TGUID;lpszServiceClassName:pchar;var buflen:DWORD):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAGetServiceClassNameByClassIdA';
+
+ function WSASetService(lpqsRegInfo:PWSAQUERYSET;essoperation:TWSAESETSERVICEOP;flags:dword):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSASetServiceA';
+
+ {$ifndef Netware}
+ function WSAProviderConfigChange(lpNotificationHandle:LPHANDLE;
+ lpOverlapped:PWSAOVERLAPPED;
+ lpCompletionRoutine:TWSAOVERLAPPED_COMPLETION_ROUTINE):longint;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSAProviderConfigChange';
+ {$endif}
+
+
+
+ implementation
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELONG(a,b : longint) : LONGINT;
+ begin
+ MAKELONG:=LONGINT((WORD(a)) or ((DWORD(WORD(b))) shl 16));
+ end;
+
+ function MAKEWORD(a,b : longint) : WORD;
+ begin
+ MAKEWORD:=WORD((BYTE(a)) or ((WORD(BYTE(b))) shl 8));
+ end;
+
+ {
+ Implementation of the helper routines
+ }
+ function WSAMakeSyncReply(Buflen,Error:Word):dword;
+
+ begin
+ WSAMakeSyncReply:=MakeLong(Buflen, Error);
+ end;
+
+ function WSAMakeSelectReply(Event,Error:Word):dword;
+
+ begin
+ WSAMakeSelectReply:=MakeLong(Event,Error);
+ end;
+
+ function WSAGetAsyncBuflen(Param:dword):Word;
+
+ begin
+ WSAGetAsyncBuflen:=lo(Param);
+ end;
+
+ function WSAGetAsyncError(Param:dword):Word;
+
+ begin
+ WSAGetAsyncError:=hi(Param);
+ end;
+
+ function WSAGetSelectEvent(Param:dword):Word;
+
+ begin
+ WSAGetSelectEvent:=lo(Param);
+ end;
+
+ function WSAGetSelectError(Param:dword):Word;
+
+ begin
+ WSAGetSelectError:=hi(Param);
+ end;
+
+ procedure FD_CLR(Socket:TSocket; var FDSet:TFDSet);
+
+ var
+ i : u_int;
+
+ begin
+ i:=0;
+ while i<FDSet.fd_count do
+ begin
+ if FDSet.fd_array[i]=Socket then
+ begin
+ while i<FDSet.fd_count-1 do
+ begin
+ FDSet.fd_array[i]:=FDSet.fd_array[i+1];
+ inc(i);
+ end;
+ dec(FDSet.fd_count);
+ break;
+ end;
+ inc(i);
+ end;
+ end;
+
+ function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean;
+ begin
+ FD_ISSET:=__WSAFDIsSet(Socket,FDSet);
+ end;
+
+ procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
+ var i : integer;
+ begin
+ if FDSet.fd_count > FD_SETSIZE then
+ FDSet.fd_count := FD_SETSIZE;
+ for i := 1 to FDSet.fd_count do
+ if FDSet.fd_array[i-1] = Socket then exit; {this is what the c macro FD_SET does}
+ if FDSet.fd_count<FD_SETSIZE then
+ begin
+ FDSet.fd_array[FDSet.fd_count]:=Socket;
+ Inc(FDSet.fd_count);
+ end;
+ end;
+
+ procedure FD_ZERO(var FDSet:TFDSet);
+ begin
+ fillchar(FDSet,sizeof(FDSet),0);
+ {FDSet.fd_count:=0;}
+ end;
+
+ {$ifdef netware}
+ {windows has connect and accept in ws2_32.dll, netware has not, they
+ are defined as macros in ws2nlm.h }
+
+ function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT;
+ begin
+ connect := WSAConnect (s,addr,namelen,nil,nil,nil,nil);
+ end;
+
+ function connect(s:TSocket; Const name:TSockAddr; namelen:tOS_INT):tOS_INT; //cdecl;external winsockdll name 'WSAConnect';
+ begin
+ connect := WSAConnect (s,@name,namelen,nil,nil,nil,nil);
+ end;
+
+ function accept(s:TSocket; addr: PSockAddr; addrlen : ptOS_INT) : TSocket;
+ begin
+ accept := WSAAccept (s,addr,addrlen,nil,0);
+ end;
+
+ function accept(s:TSocket; addr: PSockAddr; var addrlen : tOS_INT) : TSocket;
+ begin
+ accept := WSAAccept (s,addr,@addrlen,nil,0);
+ end;
+
+
+ {$endif}
+
+ {AD 2003/03/25: Special for netware
+ if WSAStartup is called more than once, bad thinks will happen
+ on netware. This is not a problem under windows.
+ This happens with fcl because the unit initialization of SSockets and
+ resolve both calls WSAStartup, for the second startup we simply
+ return success without calling the WS2_32 WSAStartup }
+
+ function __WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;
+ {$ifdef Netware}cdecl;{$else}stdcall;{$endif}
+ external winsockdll name 'WSAStartup';
+
+ function __WSACleanup:tOS_INT;{$ifdef Netware}cdecl;{$else}stdcall;{$endif}external winsockdll name 'WSACleanup';
+
+ var WSAstartupData : TWSADATA;
+
+ function WSACleanup:tOS_INT;
+ begin
+ if WSAstartupData.wVersion <> $ffff then
+ begin
+ Result := __WSACleanup;
+ if Result = 0 then WSAstartupData.wVersion := $ffff;
+ end else Result := WSANOTINITIALISED;
+ end;
+
+ function WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;
+ begin
+ if WSAstartupData.wVersion = $ffff then
+ begin
+ Result := __WSAStartup(wVersionRequired,WSAData);
+ if Result = 0 then WSAstartupData := WSAData;
+ {Writeln (stderr,'WSAStartup called');}
+ end else
+ begin
+ result := 0;
+ {Writeln (stderr,'WSAStartup should be called only once !');}
+ end;
+ end;
+
+var
+ oldUnloadProc : pointer;
+
+ procedure exitProc;
+ begin
+ {$ifdef DEBUG_MT}
+ ConsolePrintf (#13'winsock.exitProc called'#13#10);
+ {$endif}
+ NetwareUnloadProc := oldUnloadProc;
+ WSACleanup;
+ end;
+
+
+
+initialization
+ WSAstartupData.wVersion := $ffff;
+ oldUnloadProc := NetwareUnloadProc;
+ NetwareUnloadProc := @exitProc;
+finalization
+ WSACleanUp;
+end.
+{
+ $Log: winsock.pp,v $
+ Revision 1.6 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netware/ws2_32.imp b/rtl/netware/ws2_32.imp
new file mode 100644
index 0000000000..d82be2cefa
--- /dev/null
+++ b/rtl/netware/ws2_32.imp
@@ -0,0 +1,345 @@
+ WS2_32_bind,
+ WS2_32_closesocket,
+ WS2_32_getpeername,
+ WS2_32_getsockname,
+ WS2_32_getsockopt,
+ WS2_32_htonl,
+ WS2_32_htons,
+ WS2_32_ioctlsocket,
+ WS2_32_listen,
+ WS2_32_ntohl,
+ WS2_32_ntohs,
+ WS2_32_recv,
+ WS2_32_recvfrom,
+ WS2_32_select,
+ WS2_32_send,
+ WS2_32_sendto,
+ WS2_32_setsockopt,
+ WS2_32_shutdown,
+ WS2_32_socket,
+ WSAAccept,
+ WSACancelBlockingCall,
+ WSACleanup,
+ WSACloseEvent,
+ WSAConnect,
+ WSACreateEvent,
+ WSCEnableNSProvider,
+ WSAEnumNetworkEvents,
+ WSAEnumProtocolsA,
+ WSAEnumProtocolsW,
+ WSAEventSelect,
+ WSAGetLastError,
+ WSAGetOverlappedResult,
+ WSAGetQOSByName,
+ WSAHtonl,
+ WSAHtons,
+ WSAIoctl,
+ WSAJoinLeaf,
+ WSANtohl,
+ WSANtohs,
+ WSARecv,
+ WSARecvDisconnect,
+ WSARecvFrom,
+ WSAResetEvent,
+ WSASend,
+ WSASendDisconnect,
+ WSASendTo,
+ WSASetEvent,
+ WSASetLastError,
+ WSASocketA,
+ WSASocketW,
+ WSAStartup,
+ WSAWaitForMultipleEvents,
+ WSAAddressToStringA,
+ WSAAddressToStringW,
+ WSAEnumNameSpaceProvidersA,
+ WSAEnumNameSpaceProvidersW,
+ WSAGetServiceClassInfoA,
+ WSAGetServiceClassInfoW,
+ WSAGetServiceClassNameByClassIdA,
+ WSAGetServiceClassNameByClassIdW,
+ WSAInstallServiceClassA,
+ WSAInstallServiceClassW,
+ WSALookupServiceBeginA,
+ WSALookupServiceBeginW,
+ WSALookupServiceEnd,
+ WSALookupServiceNextA,
+ WSALookupServiceNextW,
+ WSARemoveServiceClass,
+ WSASetServiceA,
+ WSASetServiceW,
+ WSAStringToAddressA,
+ WSAStringToAddressW,
+ WSCUnInstallNameSpace,
+ WSCInstallNameSpace,
+ WS2_32_gethostbyaddr,
+ WS2_32_gethostbyname,
+ WS2_32_gethostname,
+ WS2_32_getprotobyname,
+ WS2_32_getprotobynumber,
+ WS2_32_getservbyname,
+ WS2_32_getservbyport,
+ WS2_32_inet_addr,
+ WS2_32_inet_ntoa,
+ __WSAFDIsSet,
+ NiosCancelAESEvent,
+ NiosFindNode,
+ NiosDFindNode,
+ NiosDLinkFirst,
+ NiosDLinkLast,
+ NiosDprintf,
+ NiosDUnlinkFirst,
+ NiosDUnlinkLast,
+ NiosDUnlinkNode,
+ NiosFree,
+ NiosGetTickCount,
+ NiosLinkFirst,
+ NiosLinkLast,
+ NiosLongTermAlloc,
+ NiosMemSet,
+ NiosPoll,
+ NiosPrintf,
+ NiosScheduleAESEvent,
+ NiosScheduleForegroundEvent,
+ NiosShortTermAlloc,
+ NiosUnlinkFirst,
+ NiosUnlinkNode,
+ NiosMemCpy,
+ WSDebMsg,
+ WSAssertFail,
+ WSdebugLevel,
+ WSdebugModule,
+ WSDebChar,
+ WSDebugAllocCheck,
+ WSDebugFreeCheck,
+ WSDebugAlloc,
+ WSDebugString,
+ kYieldThreadStub,
+ FreeObjectStub,
+ AllocateObjectStub,
+ DestroyObjectCacheStub,
+ CreateObjectCacheStub,
+ kRWWriteUnlockStub,
+ kRWWriteLockStub,
+ kRWReadUnlockStub,
+ kRWReadLockStub,
+ kRWLockFreeStub,
+ kRWLockAllocStub,
+ kCurrentThreadStub,
+ WaitForSingleObject,
+ CreateEvent,
+ CloseHandle,
+ WPUSetEvent,
+ bufFree,
+ WSCreateAndLinkObjectCache,
+ WSDestroyObjectCacheList,
+ WSGarbageCollectObjectCache,
+ NetWareOSMajorVersion,
+ WVT,
+ ecbFreePlatformBuffer,
+ ecbImportMsgByRef,
+ ecbImportMsgByCopy,
+ msgCreate,
+ msgReset,
+ msgIncRef,
+ msgDecRef,
+ msgForEach,
+ msgDestroy,
+ msgCopyBufAtFront,
+ msgCopyBufAtEnd,
+ msgCopyToBuf,
+ msgRefBufAtFront,
+ msgRefBufAtEnd,
+ msgCopyMsgAtFront,
+ msgRefMsgAtFront,
+ msgCopyMsgAtEnd,
+ msgImportECBByCopy,
+ msgImportECBByRef,
+ msgRefMsgAtEnd,
+ msgRemoveDataAtFront,
+ msgRemoveDataAtEnd,
+ msgSetCurrentOffset,
+ msgModifyCurrentOffset,
+ msgPushWS,
+ msgPopWS,
+ msgPeekWS,
+ msgLaunchCallback,
+ msgPushAttrib,
+ msgPopAttrib,
+ msgScanMsgForAttrib,
+ mapClose,
+ mapCreate,
+ createProto,
+ termProto,
+ new_termProto,
+ addProtoToLlpList,
+ removeProtoFromLlpList,
+ incProtoRefCount,
+ incSessnRefCount,
+ decProtoRefCount,
+ decSessnRefCount,
+ createSocket,
+ destroySocket,
+ GetDown,
+ setProtoVtbl,
+ setSessnVtbl,
+ ctlPushWS,
+ ctlPopWS,
+ ctlPeekWS,
+ ctlLaunchCallback,
+ wsSocket,
+ wsGetAcceptData,
+ wsAccept,
+ wsBind,
+ wsConnect,
+ wsListen,
+ wsRecv,
+ wsRecvDisconnect,
+ wsSend,
+ wsSendDisconnect,
+ wsCloseSocket,
+ wsEventCallBack,
+ wsRecvCallBack,
+ wsREAD_EventCallBack,
+ wsWRITE_EventCallBack,
+ wsACCEPT_EventCallBack,
+ wsFASTACCEPT_EventCallBack,
+ wsCONNECT_EventCallBack,
+ wsCLOSE_EventCallBack,
+ wsCLOSE_DONE_EventCallBack,
+ wsEventSelect,
+ wsEventPoll,
+ wsControl,
+ wsGetSockName,
+ wsGetPeerName,
+ wsGetSockOpt,
+ wsSetSockOpt,
+ wsJoinLeaf,
+ wsGetQOSByName,
+ getProtoByModuleType,
+ mergeProtoCallTable,
+ estimateTypedData,
+ addTypedDataBegin,
+ addTypedDataNext,
+ addTypedDataEnd,
+ getTypedDataPtr,
+ registerProtocolInfo,
+ deregisterProtocolInfo,
+ getModuleTypeByProtocolInfo,
+ getModuleTypeByCatalogId,
+ kSetThreadWinSockDataStub,
+ kGetThreadWinSockDataStub,
+ kScheduleWorkToDoStub,
+ kCancelWorkToDoStub,
+ kCreateExSetStub,
+ kDestroyExSetStub,
+ kGetExSetHandleStub,
+ kEnterExSetStub,
+ kExitExSetStub,
+ kEnterNetWareStub,
+ kExitNetWareStub,
+ kBindExSetStub,
+ CfwAtomicInc,
+ CfwAtomicDec,
+ destroyProto,
+ kUnbindExSetStub,
+ kCurrentExSetBindingStub,
+ kMutexAllocStub,
+ kMutexFreeStub,
+ kMutexLockStub,
+ kMutexTryLockStub,
+ kMutexTimedWaitStub,
+ kMutexUnlockStub,
+ kMutexWaitCountStub,
+ kSemaphoreAllocStub,
+ kSemaphoreFreeStub,
+ kSemaphoreWaitStub,
+ kSemaphoreTryStub,
+ kSemaphoreTimedWaitStub,
+ kSemaphoreSignalStub,
+ kSemaphoreExamineCountStub,
+ kSemaphoreWaitCountStub,
+ kRWReadTryLockStub,
+ kRWWriteTryLockStub,
+ kRWWriterToReaderStub,
+ kRWReaderToWriterStub,
+ kSpinLockInitStub,
+ kSpinLockStub,
+ kSpinTryLockStub,
+ kSpinUnlockStub,
+ kSpinLockDisableStub,
+ kSpinTryLockDisableStub,
+ kSpinUnlockRestoreStub,
+ kAllocQueStub,
+ kAllocQueNoSleepStub,
+ kFreeQueStub,
+ kQueCountStub,
+ kEnQueStub,
+ kEnQueOrderedStub,
+ kDeQueStub,
+ kDeQueWaitStub,
+ kPushQueStub,
+ kPushQueOrderedStub,
+ kDeQueByQLinkStub,
+ kDeQueAllStub,
+ kEnQueNoLockStub,
+ kEnQueOrderedNoLockStub,
+ kPushQueNoLockStub,
+ kPushQueOrderedNoLockStub,
+ kDeQueNoLockStub,
+ kDeQueByQLinkNoLockStub,
+ kDeQueWaitNoLockStub,
+ kDeQueAllNoLockStub,
+ kFirstQLINKNoLockStub,
+ atomic_incStub,
+ atomic_decStub,
+ atomic_addStub,
+ atomic_subStub,
+ kConditionAllocStub,
+ kConditionDestroyStub,
+ kConditionWaitStub,
+ kConditionTimedWaitStub,
+ kConditionSignalStub,
+ kConditionBroadcastStub,
+ gwspProto,
+ getPackedMsg,
+ putPackedMsg,
+ WS2_32_DNSQuery,
+ FreeDNSReply,
+ HostsTable,
+ HostsEntries,
+ UsedHostsEntries,
+ HostsRWLock,
+ ResizeTable,
+ WS2DNSAllocRTag,
+ WSLocalToUnicode,
+ WSUnicodeToLocal,
+ WS2getservbyname,
+ WS2getservbyport,
+ WS2gethostbyaddr,
+ WS2gethostbyname,
+ WS2_32_GetGeneralStatistics,
+ WS2_32_GetSocketStatistics,
+ WS2_32_GetDebugState,
+ WS2_32_SetDebugState,
+ GetTimerMinorTicksPerSecondStub,
+ WSStartupNLMQ,
+ WSStartupNLMQSpinLock,
+ WSPCloseSocket,
+ wsSktDiag,
+ NiosVidMessageBox,
+ NiosThreadSignalId,
+ NiosThreadBlockOnId,
+ NiosThreadArmId,
+ NiosStrLen,
+ NiosStrCmp,
+ NiosStrCat,
+ NiosGetHighResIntervalMarker,
+ NiosGetDateTime,
+ NiosMemCmp,
+ wsNewWindow,
+ INWNSPInstallServiceClass,
+ INWNSPGetServiceClassInfo,
+ INWNSPRemoveServiceClass,
+ mapReCreateTable
+
diff --git a/rtl/netware/ws2nlm.imp b/rtl/netware/ws2nlm.imp
new file mode 100644
index 0000000000..81f886eb6c
--- /dev/null
+++ b/rtl/netware/ws2nlm.imp
@@ -0,0 +1,87 @@
+# converted to unix by root on mail.armin.d at Mon Apr 16 00:36:06 CEST 2001
+#
+ WS2_32_bind,
+ WS2_32_closesocket,
+ WS2_32_getpeername,
+ WS2_32_getsockname,
+ WS2_32_getsockopt,
+ WS2_32_htonl,
+ WS2_32_htons,
+ WS2_32_ioctlsocket,
+ WS2_32_listen,
+ WS2_32_ntohl,
+ WS2_32_ntohs,
+ WS2_32_recv,
+ WS2_32_recvfrom,
+ WS2_32_select,
+ WS2_32_send,
+ WS2_32_sendto,
+ WS2_32_setsockopt,
+ WS2_32_shutdown,
+ WS2_32_socket,
+ WSAAccept,
+ WSACancelBlockingCall,
+ WSACleanup,
+ WSACloseEvent,
+ WSAConnect,
+ WSACreateEvent,
+ WSCEnableNSProvider,
+ WSAEnumNetworkEvents,
+ WSAEnumProtocolsA,
+ WSAEnumProtocolsW,
+ WSAEventSelect,
+ WSAGetLastError,
+ WSAGetOverlappedResult,
+ WSAGetQOSByName,
+ WSAHtonl,
+ WSAHtons,
+ WSAIoctl,
+ WSAJoinLeaf,
+ WSANtohl,
+ WSANtohs,
+ WSARecv,
+ WSARecvDisconnect,
+ WSARecvFrom,
+ WSAResetEvent,
+ WSASend,
+ WSASendDisconnect,
+ WSASendTo,
+ WSASetEvent,
+ WSASetLastError,
+ WSASocketA,
+ WSASocketW,
+ WSAStartup,
+ WSAWaitForMultipleEvents,
+ WSAAddressToStringA,
+ WSAAddressToStringW,
+ WSAEnumNameSpaceProvidersA,
+ WSAEnumNameSpaceProvidersW,
+ WSAGetServiceClassInfoA,
+ WSAGetServiceClassInfoW,
+ WSAGetServiceClassNameByClassIdA,
+ WSAGetServiceClassNameByClassIdW,
+ WSAInstallServiceClassA,
+ WSAInstallServiceClassW,
+ WSALookupServiceBeginA,
+ WSALookupServiceBeginW,
+ WSALookupServiceEnd,
+ WSALookupServiceNextA,
+ WSALookupServiceNextW,
+ WSARemoveServiceClass,
+ WSASetServiceA,
+ WSASetServiceW,
+ WSAStringToAddressA,
+ WSAStringToAddressW,
+ WSCUnInstallNameSpace,
+ WSCInstallNameSpace,
+ WS2_32_gethostbyaddr,
+ WS2_32_gethostbyname,
+ WS2_32_gethostname,
+ WS2_32_getprotobyname,
+ WS2_32_getprotobynumber,
+ WS2_32_getservbyname,
+ WS2_32_getservbyport,
+ WS2_32_inet_addr,
+ WS2_32_inet_ntoa,
+ __WSAFDIsSet
+
diff --git a/rtl/netwlibc/Makefile b/rtl/netwlibc/Makefile
new file mode 100644
index 0000000000..0d4b30981c
--- /dev/null
+++ b/rtl/netwlibc/Makefile
@@ -0,0 +1,2034 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=netwlibc
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+IMPFILES=nwsnut.imp ws2_32.imp ws2nlm.imp libc.imp netware.imp \
+libcclib.imp
+SYSTEMUNIT=system
+override FPCOPT+=-Ur
+override FPCOPT+=-dMT
+CREATESMART=1
+OBJPASDIR=$(RTL)/objpas
+override BINUTILSPREFIX=$(CPU_TARGET)-netware-
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings lineinfo winsock heaptrc matrix nwsnut libc dos crt objects sysconst dynlibs initc sysutils types typinfo classes cpu mmx getopts dateutils strutils convutils charset ucomplex variants rtlconsts math varutils freebidi utf8bidi mouse video keyboard cmem sockets ctypes
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=nwplibc nwl_main nwl_dlle
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+copyimpfiles:
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+nwplibc$(OEXT) :
+ cp pre/libcpre.gcc.o $(UNITTARGETDIRPREFIX)nwplibc$(OEXT)
+nwl_main$(OEXT) : nwl_main.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)nwl_main$(OEXT) nwl_main.as
+nwl_dlle$(OEXT) : nwl_dlle.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)nwl_dlle$(OEXT) nwl_dlle.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp libc.pp $(SYSDEPS)
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(WININC) netware.pp
+winsock$(PPUEXT) : winsock.pp ../netware/winsock.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
+nwsnut$(PPUEXT) : nwsnut.pp ../netware/nwsnut.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : sockets.pp winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(INC)/sockets.inc $(INC)/socketsh.inc
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+initc$(PPUEXT) : initc.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pp libc.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pp libc.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) libc.pp sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) \
+ sysconst$(PPUEXT) types$(PPUEXT) \
+ tthread.inc
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
+ objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+freebidi$(PPUEXT) : $(OBJPASDIR)/freebidi.pp
+utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp freebidi$(PPUEXT)
+ $(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp $(OBJPASDIR)/dateutil.inc
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+mouse$(PPUEXT) : $(INC)/mouseh.inc $(SYSTEMUNIT)$(PPUEXT)
+video$(PPUEXT) : $(INC)/video.inc $(SYSTEMUNIT)$(PPUEXT)
+keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
+override INSTALLPPUFILES+=$(IMPFILES)
+override CLEANPPUFILES+=$(addprefix $(COMPILER_UNITTARGETDIR)/,$(IMPFILES))
diff --git a/rtl/netwlibc/Makefile.fpc b/rtl/netwlibc/Makefile.fpc
new file mode 100644
index 0000000000..175f693e2a
--- /dev/null
+++ b/rtl/netwlibc/Makefile.fpc
@@ -0,0 +1,265 @@
+#
+# Makefile.fpc for Free Pascal Netware RTL (Libc)
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=nwplibc nwl_main nwl_dlle
+units=$(SYSTEMUNIT) objpas macpas strings \
+ lineinfo winsock heaptrc matrix \
+ nwsnut libc dos crt objects sysconst dynlibs \
+ initc sysutils types typinfo classes \
+ cpu mmx getopts \
+ dateutils strutils convutils \
+ charset ucomplex variants \
+ rtlconsts math varutils freebidi utf8bidi \
+ mouse video keyboard cmem sockets ctypes
+
+rsts=math varutils variants convutils typinfo classes dateutils sysconst rtlconsts system
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=netwlibc
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+UNITPREFIX=rtl
+
+IMPFILES=nwsnut.imp ws2_32.imp ws2nlm.imp libc.imp netware.imp \
+libcclib.imp
+# nwplibc.o
+
+SYSTEMUNIT=system
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+# ifdef RELEASE
+override FPCOPT+=-Ur
+# endif
+
+#debug, -a: dont delete asm, -al include lines
+#override FPCOPT+=-a
+#override FPCOPT+=-al
+
+
+# for netware always use multithread
+override FPCOPT+=-dMT
+
+# and alway use smartlinking
+CREATESMART=1
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+# binutils are the same for targets netware and netwlibc
+override BINUTILSPREFIX=$(CPU_TARGET)-netware-
+
+[rules]
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+copyimpfiles:
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+
+
+
+#
+# Loaders
+#
+
+#nwpre$(OEXT) : nwpre.as
+# $(AS) -o nwpre$(OEXT) nwpre.as
+
+#prelude$(OEXT) : prelude.as
+# $(AS) -o prelude$(OEXT) prelude.as
+
+# for now use the gcc pre
+nwplibc$(OEXT) :
+ cp pre/libcpre.gcc.o $(UNITTARGETDIRPREFIX)nwplibc$(OEXT)
+
+nwl_main$(OEXT) : nwl_main.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)nwl_main$(OEXT) nwl_main.as
+
+nwl_dlle$(OEXT) : nwl_dlle.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)nwl_dlle$(OEXT) nwl_dlle.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp libc.pp $(SYSDEPS)
+ $(COPY) $(IMPFILES) $(COMPILER_UNITTARGETDIR)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(WININC) netware.pp
+
+
+winsock$(PPUEXT) : winsock.pp ../netware/winsock.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
+
+nwsnut$(PPUEXT) : nwsnut.pp ../netware/nwsnut.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+sockets$(PPUEXT) : sockets.pp winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(INC)/sockets.inc $(INC)/socketsh.inc
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+initc$(PPUEXT) : initc.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp libc.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp libc.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) libc.pp sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) \
+ sysconst$(PPUEXT) types$(PPUEXT) \
+ tthread.inc
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
+ objpas$(PPUEXT) $(OBJPASDIR)/varutilh.inc
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+
+freebidi$(PPUEXT) : $(OBJPASDIR)/freebidi.pp
+
+utf8bidi$(PPUEXT) : $(OBJPASDIR)/utf8bidi.pp freebidi$(PPUEXT)
+ $(COMPILER) -Sc $(OBJPASDIR)/utf8bidi.pp
+
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp $(OBJPASDIR)/dateutil.inc
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+mouse$(PPUEXT) : $(INC)/mouseh.inc $(SYSTEMUNIT)$(PPUEXT)
+
+video$(PPUEXT) : $(INC)/video.inc $(SYSTEMUNIT)$(PPUEXT)
+
+keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Netware-.imp files need to be installed in the unit-dir
+#
+override INSTALLPPUFILES+=$(IMPFILES)
+override CLEANPPUFILES+=$(addprefix $(COMPILER_UNITTARGETDIR)/,$(IMPFILES))
+
diff --git a/rtl/netwlibc/classes.pp b/rtl/netwlibc/classes.pp
new file mode 100644
index 0000000000..320f7d5d78
--- /dev/null
+++ b/rtl/netwlibc/classes.pp
@@ -0,0 +1,60 @@
+{
+ $Id: classes.pp,v 1.5 2005/03/07 17:57:25 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2004 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for netware libc
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ types,
+ typinfo,
+ rtlconsts,
+ Libc;
+
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+initialization
+ CommonInit;
+
+finalization
+ DoneThreads;
+ CommonCleanup;
+
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.5 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.4 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.3 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+}
diff --git a/rtl/netwlibc/crt.pp b/rtl/netwlibc/crt.pp
new file mode 100644
index 0000000000..b035ca9bc8
--- /dev/null
+++ b/rtl/netwlibc/crt.pp
@@ -0,0 +1,626 @@
+{
+ $Id: crt.pp,v 1.1 2004/09/05 20:58:47 armin Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ Borland Pascal 7 Compatible CRT Unit for Netware (libc version)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit crt;
+
+interface
+
+{$i crth.inc}
+
+Const
+ ScreenHeight : longint=25;
+ ScreenWidth : longint=80;
+
+implementation
+
+uses Libc;
+
+
+{$ASMMODE ATT}
+
+var
+ ScreenHandle : scr_t;
+
+{ Definition of textrec is in textrec.inc }
+{$i textrec.inc}
+
+
+{****************************************************************************
+ Low level Routines
+****************************************************************************}
+
+procedure setscreenmode(mode : byte);
+begin
+ setscreenmode (mode);
+end;
+
+
+function GetScreenHeight : longint;
+VAR Height, Width : WORD;
+begin
+ GetScreenSize(Height, Width);
+ GetScreenHeight := Height;
+end;
+
+
+function GetScreenWidth : longint;
+VAR Height, Width : WORD;
+begin
+ GetScreenSize(Height, Width);
+ GetScreenWidth := Width;
+end;
+
+procedure GetScreenCursor(var x,y : longint);
+begin
+ x := wherecol+1;
+ y := whererow+1;
+end;
+
+
+{****************************************************************************
+ Helper Routines
+****************************************************************************}
+
+Function WinMinX: Longint;
+{
+ Current Minimum X coordinate
+}
+Begin
+ WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Longint;
+{
+ Current Minimum Y Coordinate
+}
+Begin
+ WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Longint;
+{
+ Current Maximum X coordinate
+}
+Begin
+ WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Longint;
+{
+ Current Maximum Y coordinate;
+}
+Begin
+ WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+Function FullWin:boolean;
+{
+ Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+ FullWin:=(WinMinX=1) and (WinMinY=1) and
+ (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
+end;
+
+
+{****************************************************************************
+ Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+begin
+ Window (1,1,byte(ScreenWidth),byte(ScreenHeight));
+ ClrScr;
+end;
+
+
+Procedure TextColor(Color: Byte);
+{
+ Switch foregroundcolor
+}
+Begin
+ TextAttr:=(Color and $f) or (TextAttr and $70);
+ If (Color>15) Then TextAttr:=TextAttr Or Blink;
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+ Switch backgroundcolor
+}
+Begin
+ TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+End;
+
+
+
+Procedure HighVideo;
+{
+ Set highlighted output.
+}
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+ Set normal output
+}
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+ Set normal back and foregroundcolors.
+}
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+ Go to coordinates X,Y in the current window.
+}
+Begin
+ If (X>0) and (X<=WinMaxX- WinMinX+1) and
+ (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+ Begin
+ X := X + WinMinX - 1;
+ Y := Y + WinMinY - 1;
+ gotorowcol (y-1,x-1);
+ End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+ Set screen window to the specified coordinates.
+}
+Begin
+ if (X1>X2) or (X2>ScreenWidth) or
+ (Y1>Y2) or (Y2>ScreenHeight) then
+ exit;
+ WindMin:=((Y1-1) Shl 8)+(X1-1);
+ WindMax:=((Y2-1) Shl 8)+(X2-1);
+ GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+ Clear the current window, and set the cursor on 1,1
+}
+var
+ rowlen,rows: longint;
+begin
+ if FullWin then
+ begin
+ clearscreen; {seems to swich cursor off}
+ //_DisplayInputCursor;
+ end else
+ begin
+ rowlen := WinMaxX-WinMinX+1;
+ rows := WinMaxY-WinMinY+1;
+ FillScreenArea(ScreenHandle,WinMinY-1,WinMinX-1,rows,rowlen,' ',textattr);
+ end;
+ Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+ Clear from current position to end of line.
+}
+var
+ x,y : longint;
+ rowlen : word;
+Begin
+ GetScreenCursor(x,y);
+ if x<WinMaxX then
+ begin
+ rowlen := WinMaxX-x+1;
+ FillScreenArea(ScreenHandle,y-1,x-1,1,rowlen,' ',textattr);
+ end;
+End;
+
+
+
+Function WhereX: Byte;
+{
+ Return current X-position of cursor.
+}
+Begin
+ WhereX:=wherecol-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+ Return current Y-position of cursor.
+}
+Begin
+ WhereY:=whererow-WinMinY+1;
+End;
+
+
+{*************************************************************************
+ Keyboard
+*************************************************************************}
+
+var
+ is_last : boolean;
+
+{
+function readkey : char;
+var
+ keytype,modifier,scancode : longint;
+begin
+ if is_last then
+ begin
+ is_last:=false;
+ readkey:=getch;
+ end else
+ begin
+ // _SetCtrlCharCheckMode (CheckBreak);
+ WaitForKey (ScreenHandle);
+ getkey(keytype,modifer,scancode):longint;
+ char1 := getch;
+ if char1 = #0 then is_last := true;
+ readkey:=char1;
+ end;
+end;
+}
+
+function readkey : char; // for now
+begin
+ readkey := char(getcharacter);
+end;
+
+
+function keypressed : boolean;
+begin
+ if is_last then
+ begin
+ keypressed:=true;
+ exit;
+ end else
+ keypressed := (kbhit <> 0);
+end;
+
+
+{*************************************************************************
+ Delay
+*************************************************************************}
+
+procedure Delay(MS: Word);
+begin
+ libc.delay (MS);
+end;
+
+procedure sound(hz : word);
+begin
+ RingBell;
+end;
+
+procedure nosound;
+begin
+end;
+
+
+
+{****************************************************************************
+ HighLevel Crt Functions
+****************************************************************************}
+
+{procedure removeline(y : longint);
+var
+ fil : word;
+ rowlen : word;
+ p : pointer;
+begin
+ fil:=32 or (textattr shl 8);
+ rowlen:=WinMaxX-WinMinX+1;
+ GetMem (p, rowlen*2);
+ y:=WinMinY+y-1;
+ While (y<=WinMaxY) do
+ begin
+ _CopyFromScreenMemory (1,rowlen,p,WinMinX-1,word(y));
+ _CopyToScreenMemory (1,rowlen,p,WinMinX-1,word(y-1));
+ inc(y);
+ end;
+ FillWord (p^,rowlen,fil);
+ _CopyToScreenMemory (1,rowlen,p,WinMinX-1,WinMaxY-1);
+ FreeMem (p, rowlen*2);
+end;}
+procedure removeline(y : longint);
+var rowlen : longint;
+begin
+ rowlen:=WinMaxX-WinMinX+1;
+ y:=WinMinY+y-1-1;
+ ScrollScreenArea(ScreenHandle,y,WinMinX-1,WinMaxY-WinMinY+1,rowlen,1,0,SCROLL_UP);
+end;
+
+
+procedure delline;
+begin
+ removeline(wherey);
+end;
+
+
+procedure insline;
+var rowlen : longint;
+begin
+ rowlen:=WinMaxX-WinMinX+1;
+ ScrollScreenArea(ScreenHandle,wherecol,WinMinX-1,WinMaxY-WinMinY+1,rowlen,1,textattr,SCROLL_DOWN);
+end;
+
+
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+begin
+ SetCursorStyle(ScreenHandle,CURSOR_NORMAL);
+ EnableInputCursor(ScreenHandle);
+end;
+
+
+procedure cursoroff;
+begin
+ DisableInputCursor (ScreenHandle);
+end;
+
+
+procedure cursorbig;
+begin
+ SetCursorStyle(ScreenHandle,CURSOR_BLOCK);
+ EnableInputCursor(ScreenHandle);
+end;
+
+
+{*****************************************************************************
+ Read and Write routines
+*****************************************************************************}
+
+var
+ CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var st : array [0..1] of char;
+begin
+ case c of
+ #10 : inc(CurrY);
+ #13 : CurrX:=WinMinX;
+ #8 : begin
+ if CurrX>WinMinX then
+ dec(CurrX);
+ end;
+ #7 : begin { beep }
+ RingBell;
+ end;
+ else
+ begin
+ //WriteScreenCharacterAttribute(ScreenHandle,CurrY-1,CurrX-1,c,textattr); {not available in protected mode}
+ st[0] := c;
+ st[1] := #0;
+ OutputToScreenWithAttribute(ScreenHandle,textattr,@st);
+ inc(CurrX);
+ end;
+ end;
+ if CurrX>WinMaxX then
+ begin
+ CurrX:=WinMinX;
+ inc(CurrY);
+ end;
+ while CurrY>WinMaxY do
+ begin
+ removeline(1);
+ dec(CurrY);
+ end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+ i : longint;
+begin
+ GetScreenCursor(CurrX,CurrY);
+ for i:=0 to f.bufpos-1 do
+ WriteChar(f.buffer[i]); { ad: may be better to use a buffer but i think it's fast enough }
+ gotorowcol (CurrY-1,CurrX-1);
+ f.bufpos:=0;
+ CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+ procedure BackSpace;
+ begin
+ if (f.bufpos>0) and (f.bufpos=f.bufend) then
+ begin
+ WriteChar(#8);
+ WriteChar(' ');
+ WriteChar(#8);
+ dec(f.bufpos);
+ dec(f.bufend);
+ end;
+ end;
+
+var
+ ch : Char;
+Begin
+ GetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ f.bufend:=0;
+ repeat
+ if f.bufpos>f.bufend then
+ f.bufend:=f.bufpos;
+ gotorowcol (CurrY-1,CurrX-1);
+ ch:=readkey;
+ case ch of
+ #0 : case readkey of
+ #71 : while f.bufpos>0 do
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #75 : if f.bufpos>0 then
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #77 : if f.bufpos<f.bufend then
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #79 : while f.bufpos<f.bufend do
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ end;
+ ^S,
+ #8 : BackSpace;
+ ^Y,
+ #27 : begin
+ f.bufpos:=f.bufend;
+ while f.bufend>0 do
+ BackSpace;
+ end;
+ #13 : begin
+ WriteChar(#13);
+ WriteChar(#10);
+ f.bufptr^[f.bufend]:=#13;
+ f.bufptr^[f.bufend+1]:=#10;
+ inc(f.bufend,2);
+ break;
+ end;
+ #26 : if CheckEOF then
+ begin
+ f.bufptr^[f.bufend]:=#26;
+ inc(f.bufend);
+ break;
+ end;
+ else
+ begin
+ if f.bufpos<f.bufsize-2 then
+ begin
+ f.buffer[f.bufpos]:=ch;
+ inc(f.bufpos);
+ WriteChar(ch);
+ end;
+ end;
+ end;
+ until false;
+ f.bufpos:=0;
+ gotorowcol (CurrY-1,CurrX-1);
+ CrtRead:=0;
+End;
+
+{$Warnings off}
+Function CrtReturn(Var F: TextRec): Integer;
+Begin
+ CrtReturn:=0;
+end;
+{$Warnings on}
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+ If F.Mode=fmOutput Then
+ begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end
+ Else
+ begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+procedure InitScreenMode;
+var
+ s_mode : dword;
+begin
+ getscreenmode (s_mode);
+ lastmode := s_mode;
+end;
+
+var
+ x,y : longint;
+begin
+ ScreenHandle := getscreenhandle;
+{ Load startup values }
+ ScreenWidth:=GetScreenWidth;
+ ScreenHeight:=GetScreenHeight;
+ lastmode := CO80;
+ GetScreenCursor(x,y);
+ TextColor (LightGray);
+ TextBackground (Black);
+ InitScreenMode;
+{ Redirect the standard output }
+ assigncrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:=StdOutputHandle;
+ assigncrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:=StdInputHandle;
+ CheckBreak := FALSE;
+ CheckEOF := FALSE;
+ //_SetCtrlCharCheckMode (CheckBreak);
+ //_SetAutoScreenDestructionMode (TRUE);
+end.
+
diff --git a/rtl/netwlibc/dos.pp b/rtl/netwlibc/dos.pp
new file mode 100644
index 0000000000..3df02da19f
--- /dev/null
+++ b/rtl/netwlibc/dos.pp
@@ -0,0 +1,699 @@
+{
+ $Id: dos.pp,v 1.7 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ Dos unit for BP7 compatible RTL (novell netware libc)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit dos;
+interface
+
+uses libc;
+
+Type
+ searchrec = packed record
+ DirP : POINTER; { used for opendir }
+ EntryP: POINTER; { and readdir }
+ Magic : WORD;
+ fill : array[1..11] of byte;
+ attr : byte;
+ time : longint;
+ size : longint;
+ name : string[255];
+ { Internals used by netware port only: }
+ _mask : string[255];
+ _dir : string[255];
+ _attr : word;
+ end;
+
+{$i dosh.inc}
+{Extra Utils}
+function weekday(y,m,d : longint) : longint;
+
+
+implementation
+
+uses
+ strings;
+
+{$DEFINE HAS_GETMSCOUNT}
+{$DEFINE HAS_KEEP}
+
+{$DEFINE FPC_FEXPAND_DRIVES}
+{$DEFINE FPC_FEXPAND_VOLUMES}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+
+{$i dos.inc}
+
+
+{$ASMMODE ATT}
+
+{*****************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+{$PACKRECORDS 4}
+
+
+function dosversion : word;
+var i : Tutsname;
+begin
+ if Fpuname (i) >= 0 then
+ dosversion := WORD (i.netware_minor) SHL 8 + i.netware_major
+ else dosversion := $0005;
+end;
+
+function WeekDay (y,m,d:longint):longint;
+{
+ Calculates th day of the week. returns -1 on error
+}
+var
+ u,v : longint;
+begin
+ if (m<1) or (m>12) or (y<1600) or (y>4000) or
+ (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
+ ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
+ WeekDay:=-1
+ else
+ begin
+ u:=m;
+ v:=y;
+ if m<3 then
+ begin
+ inc(u,12);
+ dec(v);
+ end;
+ WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
+ end;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+var
+ t : TTime;
+ tm : Ttm;
+begin
+ time(t); localtime_r(t,tm);
+ with tm do
+ begin
+ year := tm_year+1900;
+ month := tm_mon+1;
+ mday := tm_mday;
+ wday := tm_wday;
+ end;
+end;
+
+
+procedure setdate(year,month,day : word);
+begin
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+var
+ t : TTime;
+ tm : Ttm;
+begin
+ time(t); localtime_r(t,tm);
+ with tm do
+ begin
+ hour := tm_hour;
+ minute := tm_min;
+ second := tm_sec;
+ sec100 := 0;
+ end;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+begin
+end;
+
+
+function GetMsCount: int64;
+var
+ tv : TimeVal;
+ tz : TimeZone;
+begin
+ FPGetTimeOfDay (tv, tz);
+ GetMsCount := tv.tv_Sec * 1000 + tv.tv_uSec div 1000;
+end;
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+const maxargs=256;
+procedure exec(const path : pathstr;const comline : comstr);
+var c : comstr;
+ i : integer;
+ args : array[0..maxargs] of pchar;
+ arg0 : pathstr;
+ numargs,wstat : integer;
+ Wiring : TWiring;
+begin
+ if pos ('.',path) = 0 then
+ arg0 := fexpand(path+'.nlm'#0) else
+ arg0 := fexpand (path)+#0;
+ //writeln (stderr,'dos.exec (',path,',',comline,') arg0:"',copy(arg0,1,length(arg0)-1),'"');
+ args[0] := @arg0[1];
+ numargs := 0;
+ c:=comline;
+ i:=1;
+ while i<=length(c) do
+ begin
+ if c[i]<>' ' then
+ begin
+ {Commandline argument found. append #0 and set pointer in args }
+ inc(numargs);
+ args[numargs]:=@c[i];
+ while (i<=length(c)) and (c[i]<>' ') do
+ inc(i);
+ c[i] := #0;
+ end;
+ inc(i);
+ end;
+ args[numargs+1] := nil;
+ // i := spawnvp (P_WAIT,args[0],@args);
+ Wiring.infd := StdInputHandle; //textrec(Stdin).Handle;
+ Wiring.outfd:= textrec(stdout).Handle;
+ Wiring.errfd:= textrec(stderr).Handle;
+ //writeln (stderr,'calling procve');
+ i := procve(args[0],
+ PROC_CURRENT_SPACE+PROC_INHERIT_CWD,
+ envP, // const char * env[] If passed as NULL, the child process inherits the parent.s environment at the time of the call.
+ @Wiring, // wiring_t *wiring, Pass NULL to inherit system defaults for wiring.
+ nil, // struct fd_set *fds, Not currently implemented. Pass in NULL.
+ nil, // void *appdata, Not currently implemented. Pass in NULL.
+ 0, // size_t appdata_size, Not currently implemented. Pass in 0
+ nil, // void *reserved, Reserved. Pass NULL.
+ @args); // const char *argv[]
+ //writeln (stderr,'Ok');
+ if i <> -1 then
+ begin
+ Fpwaitpid(i,@wstat,0);
+ doserror := 0;
+ lastdosexitcode := wstat;
+ end else
+ begin
+ doserror := 8; // for now, what about errno ?
+ end;
+end;
+
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+function getvolnum (drive : byte) : longint;
+var dir : STRING[255];
+ P,PS,
+ V : LONGINT;
+begin
+ {if drive = 0 then
+ begin // get volume name from current directory (i.e. SERVER-NAME/VOL2:TEST)
+ getdir (0,dir);
+ p := pos (':', dir);
+ if p = 0 then
+ begin
+ getvolnum := -1;
+ exit;
+ end;
+ byte (dir[0]) := p-1;
+ dir[p] := #0;
+ PS := pos ('/', dir);
+ INC (PS);
+ if _GetVolumeNumber (@dir[PS], V) <> 0 then
+ getvolnum := -1
+ else
+ getvolnum := V;
+ end else
+ getvolnum := drive-1;}
+ getvolnum := -1;
+end;
+
+
+function diskfree(drive : byte) : int64;
+{VAR Buf : ARRAY [0..255] OF CHAR;
+ TotalBlocks : WORD;
+ SectorsPerBlock : WORD;
+ availableBlocks : WORD;
+ totalDirectorySlots : WORD;
+ availableDirSlots : WORD;
+ volumeisRemovable : WORD;
+ volumeNumber : LONGINT;}
+begin
+ // volumeNumber := getvolnum (drive);
+ (*
+ if volumeNumber >= 0 then
+ begin
+ {i think thats not the right function but for others i need a connection handle}
+ if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
+ TotalBlocks,
+ SectorsPerBlock,
+ availableBlocks,
+ totalDirectorySlots,
+ availableDirSlots,
+ volumeisRemovable) = 0 THEN
+ begin
+ diskfree := int64 (availableBlocks) * int64 (SectorsPerBlock) * 512;
+ end else
+ diskfree := 0;
+ end else*)
+ diskfree := 0;
+end;
+
+
+function disksize(drive : byte) : int64;
+VAR Buf : ARRAY [0..255] OF CHAR;
+ TotalBlocks : WORD;
+ SectorsPerBlock : WORD;
+ availableBlocks : WORD;
+ totalDirectorySlots : WORD;
+ availableDirSlots : WORD;
+ volumeisRemovable : WORD;
+ volumeNumber : LONGINT;
+begin
+ volumeNumber := getvolnum (drive);
+ (*
+ if volumeNumber >= 0 then
+ begin
+ {i think thats not the right function but for others i need a connection handle}
+ if _GetVolumeInfoWithNumber (byte(volumeNumber),@Buf,
+ TotalBlocks,
+ SectorsPerBlock,
+ availableBlocks,
+ totalDirectorySlots,
+ availableDirSlots,
+ volumeisRemovable) = 0 THEN
+ begin
+ disksize := int64 (TotalBlocks) * int64 (SectorsPerBlock) * 512;
+ end else
+ disksize := 0;
+ end else*)
+ disksize := 0;
+end;
+
+
+{******************************************************************************
+ --- Utils ---
+******************************************************************************}
+
+procedure timet2dostime (timet:longint; var dostime : longint);
+var tm : Ttm;
+begin
+ localtime_r(timet,tm);
+ dostime:=(tm.tm_sec shr 1)+(tm.tm_min shl 5)+(tm.tm_hour shl 11)+(tm.tm_mday shl 16)+((tm.tm_mon+1) shl 21)+((tm.tm_year+1900-1980) shl 25);
+end;
+
+function nwattr2dosattr (nwattr : longint) : word;
+begin
+ nwattr2dosattr := 0;
+ if nwattr and M_A_RDONLY > 0 then nwattr2dosattr := nwattr2dosattr + readonly;
+ if nwattr and M_A_HIDDEN > 0 then nwattr2dosattr := nwattr2dosattr + hidden;
+ if nwattr and M_A_SYSTEM > 0 then nwattr2dosattr := nwattr2dosattr + sysfile;
+ if nwattr and M_A_SUBDIR > 0 then nwattr2dosattr := nwattr2dosattr + directory;
+ if nwattr and M_A_ARCH > 0 then nwattr2dosattr := nwattr2dosattr + archive;
+end;
+
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+{returns true if attributes match}
+function find_setfields (var f : searchRec) : boolean;
+var
+ StatBuf : TStat;
+ fname : string[255];
+begin
+ find_setfields := false;
+ with F do
+ begin
+ if Magic = $AD01 then
+ begin
+ attr := nwattr2dosattr (Pdirent(EntryP)^.d_mode);
+ size := Pdirent(EntryP)^.d_size;
+ name := strpas (Pdirent(EntryP)^.d_name);
+ doserror := 0;
+ fname := f._dir + f.name;
+ if length (fname) = 255 then dec (byte(fname[0]));
+ fname := fname + #0;
+ if Fpstat (@fname[1],StatBuf) = 0 then
+ timet2dostime (StatBuf.st_mtim.tv_sec, time)
+ else
+ time := 0;
+ if (f._attr and hidden) = 0 then
+ if attr and hidden > 0 then exit;
+ if (f._attr and Directory) = 0 then
+ if attr and Directory > 0 then exit;
+ if (f._attr and SysFile) = 0 then
+ if attr and SysFile > 0 then exit;
+ find_setfields := true;
+ end else
+ begin
+ FillChar (f,sizeof(f),0);
+ doserror := 18;
+ end;
+ end;
+end;
+
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+ path0 : array[0..256] of char;
+ p : longint;
+begin
+ IF path = '' then
+ begin
+ doserror := 18;
+ exit;
+ end;
+ f._attr := attr;
+ p := length (path);
+ while (p > 0) and (not (path[p] in ['\','/'])) do
+ dec (p);
+ if p > 0 then
+ begin
+ f._mask := copy (path,p+1,255);
+ f._dir := copy (path,1,p);
+ strpcopy(path0,f._dir);
+ end else
+ begin
+ f._mask := path;
+ getdir (0,f._dir);
+ if (f._dir[length(f._dir)] <> '/') and
+ (f._dir[length(f._dir)] <> '\') then
+ f._dir := f._dir + '/';
+ strpcopy(path0,f._dir);
+ end;
+ if f._mask = '*' then f._mask := '';
+ if f._mask = '*.*' then f._mask := '';
+ //writeln (stderr,'mask: "',f._mask,'" dir:"',path0,'"');
+ f._mask := f._mask + #0;
+ Pdirent(f.DirP) := opendir (path0);
+ if f.DirP = nil then
+ doserror := 18
+ else begin
+ F.Magic := $AD01;
+ findnext (f);
+ end;
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+ if F.Magic <> $AD01 then
+ begin
+ doserror := 18;
+ exit;
+ end;
+ doserror:=0;
+ repeat
+ Pdirent(f.EntryP) := readdir (Pdirent(f.DirP));
+ if F.EntryP = nil then
+ doserror := 18
+ else
+ if find_setfields (f) then
+ begin
+ if f._mask = #0 then exit;
+ if fnmatch(@f._mask[1],Pdirent(f.EntryP)^.d_name,FNM_CASEFOLD) = 0 then
+ exit;
+ end;
+ until doserror <> 0;
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+ if F.Magic <> $AD01 then
+ begin
+ doserror := 18;
+ EXIT;
+ end;
+ doserror:=0;
+ closedir (Pdirent(f.DirP));
+ f.Magic := 0;
+ f.DirP := NIL;
+ f.EntryP := NIL;
+end;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+ i,p1 : longint;
+ s : searchrec;
+ newdir : pathstr;
+begin
+{ check if the file specified exists }
+ findfirst(path,anyfile,s);
+ if doserror=0 then
+ begin
+ findclose(s);
+ fsearch:=path;
+ exit;
+ end;
+{ No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow backslash as slash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='\' then dirlist[i]:='/';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
+ newdir:=newdir+'/';
+ findfirst(newdir+path,anyfile,s);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
+ end;
+ findclose(s);
+end;
+
+
+{******************************************************************************
+ --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+
+procedure getftime(var f;var time : longint);
+var
+ StatBuf : TStat;
+begin
+ doserror := 0;
+ if Fpfstat (filerec (f).handle, StatBuf) = 0 then
+ timet2dostime (StatBuf.st_mtim.tv_sec,time)
+ else begin
+ time := 0;
+ doserror := ___errno^;
+ end;
+end;
+
+
+procedure setftime(var f;time : longint);
+Var
+ utim: utimbuf;
+ DT: DateTime;
+ path: pathstr;
+ tm : TTm;
+Begin
+ doserror:=0;
+ with utim do
+ begin
+ actime:=libc.time(nil); // getepochtime;
+ UnPackTime(Time,DT);
+ with tm do
+ begin
+ tm_sec := DT.Sec; // seconds after the minute [0..59]
+ tm_min := DT.Min; // minutes after the hour [0..59]
+ tm_hour := DT.hour; // hours since midnight [0..23]
+ tm_mday := DT.Day; // days of the month [1..31]
+ tm_mon := DT.month-1; // months since January [0..11]
+ tm_year := DT.year-1900;
+ tm_wday := -1;
+ tm_yday := -1;
+ tm_isdst := -1;
+ end;
+ modtime:=mktime(tm);
+ end;
+ if utime(@filerec(f).name,utim)<0 then
+ begin
+ Time:=0;
+ doserror:=3;
+ end;
+end;
+
+
+procedure getfattr(var f;var attr : word);
+VAR StatBuf : TStat;
+begin
+ doserror := 0;
+ if Fpstat (@textrec(f).name, StatBuf) = 0 then
+ attr := nwattr2dosattr (StatBuf.st_mode)
+ else
+ begin
+ attr := 0;
+ doserror := ___errno^;
+ end;
+end;
+
+
+procedure setfattr(var f;attr : word);
+var
+ StatBuf : TStat;
+ newMode : longint;
+begin
+ if Fpstat (@textrec(f).name,StatBuf) = 0 then
+ begin
+ newmode := StatBuf.st_mode and ($FFFF0000 - M_A_RDONLY-M_A_HIDDEN-M_A_SYSTEM-M_A_ARCH); {only this can be set by dos unit}
+ newmode := newmode or M_A_BITS_SIGNIFICANT; {set netware attributes}
+ if attr and readonly > 0 then
+ newmode := newmode or M_A_RDONLY;
+ if attr and hidden > 0 then
+ newmode := newmode or M_A_HIDDEN;
+ if attr and sysfile > 0 then
+ newmode := newmode or M_A_SYSTEM;
+ if attr and archive > 0 then
+ newmode := newmode or M_A_ARCH;
+ if Fpchmod (@textrec(f).name,newMode) < 0 then
+ doserror := ___errno^ else
+ doserror := 0;
+ end else
+ doserror := ___errno^;
+end;
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+Function EnvCount: Longint;
+var
+ envcnt : longint;
+ p : ppchar;
+Begin
+ envcnt:=0;
+ p:=envp; {defined in system}
+ while (p^<>nil) do
+ begin
+ inc(envcnt);
+ inc(p);
+ end;
+ EnvCount := envcnt
+End;
+
+
+Function EnvStr (Index: longint): String;
+Var
+ i : longint;
+ p : ppchar;
+Begin
+ if Index <= 0 then
+ envstr:=''
+ else
+ begin
+ p:=envp; {defined in system}
+ i:=1;
+ while (i<Index) and (p^<>nil) do
+ begin
+ inc(i);
+ inc(p);
+ end;
+ if p=nil then
+ envstr:=''
+ else
+ envstr:=strpas(p^)
+ end;
+end;
+
+
+{ works fine (at least with netware 6.5) }
+Function GetEnv(envvar: string): string;
+var envvar0 : array[0..512] of char;
+ p : pchar;
+ SearchElement : string[255];
+ i,isDosPath,res : longint;
+begin
+ if upcase(envvar) = 'PATH' then
+ begin // netware does not have search paths in the environment var PATH
+ // return it here (needed for the compiler)
+ GetEnv := '';
+ i := 1;
+ res := GetSearchPathElement (i, isdosPath, @SearchElement[0]);
+ while res = 0 do
+ begin
+ if isDosPath = 0 then
+ begin
+ if GetEnv <> '' then GetEnv := GetEnv + ';';
+ GetEnv := GetEnv + SearchElement;
+ end;
+ inc (i);
+ res := GetSearchPathElement (i, isdosPath, @SearchElement[0]);
+ end;
+ for i := 1 to length(GetEnv) do
+ if GetEnv[i] = '\' then
+ GetEnv[i] := '/';
+ end else
+ begin
+ strpcopy(envvar0,envvar);
+ p := libc.getenv (envvar0);
+ if p = NIL then
+ GetEnv := ''
+ else
+ GetEnv := strpas (p);
+ end;
+end;
+
+
+{******************************************************************************
+ --- Not Supported ---
+******************************************************************************}
+
+Procedure keep(exitcode : word);
+Begin
+ { simply wait until nlm will be unloaded }
+ while true do delay (60000);
+End;
+
+
+end.
+{
+ $Log: dos.pp,v $
+ Revision 1.7 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.6 2005/01/14 20:59:15 armin
+ * forgot to remove debug output in fsearch
+
+}
+
diff --git a/rtl/netwlibc/dynlibs.inc b/rtl/netwlibc/dynlibs.inc
new file mode 100644
index 0000000000..578caa9e98
--- /dev/null
+++ b/rtl/netwlibc/dynlibs.inc
@@ -0,0 +1,62 @@
+{
+ $Id: dynlibs.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+
+ Implement OS-dependent part of dynamic library loading.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef readinterface}
+
+{ ---------------------------------------------------------------------
+ Interface declarations
+ ---------------------------------------------------------------------}
+
+Type
+ TLibHandle = Pointer;
+
+Const
+ NilHandle = Nil;
+
+{$else}
+
+{ ---------------------------------------------------------------------
+ Implementation section
+ ---------------------------------------------------------------------}
+
+uses libc;
+
+Function LoadLibrary(Name : AnsiString) : TLibHandle;
+
+begin
+ Result:=dlopen(Pchar(Name),RTLD_LAZY);
+end;
+
+Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
+
+begin
+ Result:=dlsym(lib,pchar(ProcName));
+end;
+
+Function UnloadLibrary(Lib : TLibHandle) : Boolean;
+
+begin
+ Result:=dlClose(Lib)=0;
+end;
+
+{$endif}
+
+{
+ $Log: dynlibs.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/errno.inc b/rtl/netwlibc/errno.inc
new file mode 100644
index 0000000000..353c2656fb
--- /dev/null
+++ b/rtl/netwlibc/errno.inc
@@ -0,0 +1,144 @@
+ { -------------------------- Base POSIX-mandated constants --------------- }
+ { no such file or directory }
+ const
+ SYS_ENOENT = 1; // arg list too big
+ SYS_E2BIG = 2; // arg list too big
+ SYS_ENOEXEC = 3; // exec format error
+ SYS_EBADF = 4; // bad file number
+ SYS_ENOMEM = 5; // not enough memory
+ SYS_EACCES = 6; // permission denied
+ SYS_EEXIST = 7; // file exists
+ SYS_EXDEV = 8; // cross-device link
+ SYS_EINVAL = 9; // invalid argument
+ SYS_ENFILE = 10; // file table overflow
+ SYS_EMFILE = 11; // too many open files
+ SYS_ENOSPC = 12; // no space left on device
+ SYS_EDOM = 13; // argument too large
+ SYS_ERANGE = 14; // result too large
+ SYS_EDEADLK = 15; // resource deadlock would occur
+ { -------------------------- Miscellaneous NLM Library constants --------- }
+ SYS_EINUSE = 16; // resource(s) in use
+ SYS_ESERVER = 17; // server error (memory out, I/O error, etc.)
+ SYS_ENOSERVR = 18; // no server (queue server, file server, etc.)
+ SYS_EWRNGKND = 19; // wrong kind--an operation is being...
+ // ...attempted on the wrong kind of object
+ SYS_ETRNREST = 20; // transaction restarted
+ SYS_ERESOURCE = 21; // resources unavailable (maybe permanently)
+ SYS_EBADHNDL = 22; // bad non-file handle (screen, semaphore, etc)
+ SYS_ENO_SCRNS = 23; // screen I/O attempted when no screens
+ { -------------------------- Additional POSIX / traditional UNIX constants }
+ SYS_EAGAIN = 24; // resource temporarily unavailable
+ SYS_ENXIO = 25; // no such device or address
+ SYS_EBADMSG = 26; // not a data message
+ SYS_EFAULT = 27; // bad address
+ SYS_EIO = 28; // physical I/O error
+ SYS_ENODATA = 29; // no data
+ SYS_ENOSTRMS = 30; // streams not available
+ { Berkeley sockets constants ------------------ }
+ SYS_EPROTO = 31; // fatal protocol error
+ SYS_EPIPE = 32; // broken pipe
+ SYS_ESPIPE = 33; // illegal seek
+ { Non-blocking and interrupt I/O constants ---- }
+ SYS_ETIME = 34; // ioctl acknowledge timeout
+ { operation would block }
+ SYS_EWOULDBLOCK=35; // operation would block
+ SYS_EINPROGRESS=36; // operation now in progress
+ SYS_EALREADY = 37; // operation already in progress
+ { IPC network argument constants -------------- }
+ SYS_ENOTSOCK = 38; // socket operation on non-socket
+ SYS_EDESTADDRREQ=39; // destination address required
+ SYS_EMSGSIZE = 40; // message too long
+ SYS_EPROTOTYPE= 41; // protocol wrong type for socket
+ SYS_ENOPROTOOPT=42; // protocol not available
+ SYS_EPROTONOSUPPORT = 43; // protocol not supported
+ SYS_ESOCKTNOSUPPORT = 44; // socket type not supported
+ SYS_EOPNOTSUPP = 45; // operation not supported on socket
+ SYS_EPFNOSUPPORT = 46; // protocol family not supported
+ SYS_EAFNOSUPPORT = 47; // address family unsupported by protocol family
+ SYS_EADDRINUSE = 48; // address already in use
+ SYS_EADDRNOTAVAIL = 49; // can't assign requested address
+ { Operational constants ----------------------- }
+ SYS_ENETDOWN = 50; // Network is down
+ { network is unreachable }
+ SYS_ENETUNREACH = 51;
+ { network dropped connection on reset }
+ SYS_ENETRESET = 52;
+ { software caused connection abort }
+ SYS_ECONNABORTED = 53;
+ { connection reset by peer }
+ SYS_ECONNRESET = 54;
+ { no buffer space available }
+ SYS_ENOBUFS = 55;
+ { socket is already connected }
+ SYS_EISCONN = 56;
+ { socket is not connected }
+ SYS_ENOTCONN = 57;
+ { can't send after socket shutdown }
+ SYS_ESHUTDOWN = 58;
+ { too many references: can't splice }
+ SYS_ETOOMANYREFS = 59;
+ { connection timed out }
+ SYS_ETIMEDOUT = 60;
+ { connection refused }
+ SYS_ECONNREFUSED = 61;
+ { -------------------------- Additional POSIX-mandated constants --------- }
+ { resource busy }
+ SYS_EBUSY = 62;
+ { interrupted function call }
+ SYS_EINTR = 63;
+ { is a directory }
+ SYS_EISDIR = 64;
+ { filename too long }
+ SYS_ENAMETOOLONG = 65;
+ { function not implemented }
+ SYS_ENOSYS = 66;
+ { not a directory }
+ SYS_ENOTDIR = 67;
+ { directory not empty }
+ SYS_ENOTEMPTY = 68;
+ { operation not permitted }
+ SYS_EPERM = 69;
+ { no child process }
+ SYS_ECHILD = 70;
+ { file too large }
+ SYS_EFBIG = 71;
+ { too many links }
+ SYS_EMLINK = 72;
+ SYS_ELOOP = SYS_EMLINK;
+ { no such device }
+ SYS_ENODEV = 73;
+ { no locks available }
+ SYS_ENOLCK = 74;
+ { inappropriate I/O control operation }
+ SYS_ENOTTY = 75;
+ { inappropriate operation for file type }
+ SYS_EFTYPE = SYS_ENOTTY;
+ { read-only file system }
+ SYS_EROFS = 76;
+ { no such process }
+ SYS_ESRCH = 77;
+ { operation was cancelled }
+ SYS_ECANCELED = 78;
+ { this optional functionality not supported }
+ SYS_ENOTSUP = 79;
+ { -------------------------- CLib-implementation-specific constants ------ }
+ SYS_ECANCELLED = SYS_ECANCELED;
+ { anomaly in NLM data structure }
+ SYS_ENLMDATA = 100;
+ { illegal character sequence in multibyte }
+ SYS_EILSEQ = 101;
+ { internal library inconsistency }
+ SYS_EINCONSIS = 102;
+ { DOS-text file inconsistency--no newline... }
+ SYS_EDOSTEXTEOL = 103;
+ { ...after carriage return }
+ { object doesn't exist }
+ SYS_ENONEXTANT = 104;
+ SYS_ENOCONTEXT = 105; // no thread library context present
+ SYS_ELASTERR = SYS_ENOCONTEXT;
+{
+ $Log: errno.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/initc.pp b/rtl/netwlibc/initc.pp
new file mode 100644
index 0000000000..8ef7b01703
--- /dev/null
+++ b/rtl/netwlibc/initc.pp
@@ -0,0 +1,54 @@
+{
+ $Id: initc.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ This file handles the libc errno abstraction.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit initc;
+
+interface
+
+type libcint = longint;
+ plibcint = ^libcint;
+
+function fpgetCerrno:libcint;
+procedure fpsetCerrno(err:libcint);
+
+{$ifdef HASGLOBALPROPERTY}
+property cerrno:libcint read fpgetCerrno write fpsetcerrno;
+{$endif HASGLOBALPROPERTY}
+
+implementation
+
+const clib = 'libc';
+
+function geterrnolocation: Plibcint; cdecl;external clib name '___errno';
+
+function fpgetCerrno:libcint;
+
+begin
+ fpgetCerrno:=geterrnolocation^;
+end;
+
+procedure fpsetCerrno(err:libcint);
+begin
+ geterrnolocation^:=err;
+end;
+
+
+end.
+{
+ $Log: initc.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/keyboard.pp b/rtl/netwlibc/keyboard.pp
new file mode 100644
index 0000000000..a792615c90
--- /dev/null
+++ b/rtl/netwlibc/keyboard.pp
@@ -0,0 +1,142 @@
+{
+ $Id: keyboard.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ Keyboard unit for netware libc
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Keyboard;
+
+interface
+
+{$i keybrdh.inc}
+
+implementation
+
+uses Libc;
+
+{$i keyboard.inc}
+
+procedure SysInitKeyboard;
+begin
+ PendingKeyEvent := 0;
+end;
+
+
+function SysGetKeyEvent: TKeyEvent;
+var Ktype,Kvalue,Kstatus,Kscancode : byte;
+begin
+ if PendingKeyEvent<>0 then
+ begin
+ SysGetKeyEvent:=PendingKeyEvent;
+ PendingKeyEvent:=0;
+ exit;
+ end;
+ Libc.GetKey(Libc.GetScreenHandle,Ktype,Kvalue,Kstatus,Kscancode,0{ ??? linesToProtect:size_t});
+ with TKeyRecord (SysGetKeyEvent) do
+ begin
+ Case Ktype of
+ ENTER_KEY : begin
+ KeyCode := $1c0d; Flags := 3;
+ end;
+ ESCAPE_KEY : begin
+ KeyCode := $011b; Flags := 3;
+ end;
+ BACKSPACE_KEY : begin
+ KeyCode := $0e08; Flags := 3;
+ end;
+ NORMAL_KEY : begin
+ if KStatus AND ALT_KEY_HELD > 0 then KValue := 0;
+ IF (KValue = 9) and ((KStatus and SHIFT_KEY_HELD) > 0) then KValue := 0;
+ KeyCode := (Kscancode shl 8) + KValue;
+ Flags := 3;
+ end;
+ FUNCTION_KEY,
+ DELETE_KEY,
+ INSERT_KEY,
+ CURSOR_DOWN_KEY,
+ CURSOR_UP_KEY,
+ CURSOR_RIGHT_KEY,
+ CURSOR_LEFT_KEY,
+ CURSOR_HOME_KEY,
+ CURSOR_END_KEY,
+ CURSOR_PUP_KEY,
+ CURSOR_PDOWN_KEY : begin
+ KeyCode := KScancode shl 8;
+ Flags := 3;
+ end;
+ end;
+ ShiftState := 0;
+ if KStatus AND SHIFT_KEY_HELD > 0 then ShiftState := ShiftState or kbShift;
+ if KStatus AND CTRL_KEY_HELD > 0 then ShiftState := ShiftState or kbCtrl;
+ if KStatus AND ALT_KEY_HELD > 0 then ShiftState := ShiftState or kbAlt;
+ end;
+end;
+
+
+function SysPollKeyEvent: TKeyEvent;
+begin
+ if PendingKeyEvent<>0 then
+ exit(PendingKeyEvent);
+ if Libc.CheckKeyStatus (Libc.GetScreenHandle) <> 0 then
+ begin
+ PendingKeyEvent := SysGetKeyEvent;
+ SysPollKeyEvent := PendingKeyEvent;
+ end else
+ begin
+ SysPollKeyEvent := 0;
+ //NXThreadYield;
+ Delay(50);
+ end;
+end;
+
+
+function SysPollShiftStateEvent: TKeyEvent;
+begin
+ SysPollShiftStateEvent:=0;
+end;
+
+function SysGetShiftState: Byte;
+begin
+ SysGetShiftState:=0;
+end;
+
+function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+begin
+ {if KeyEvent and $03000000 = $03000000 then
+ KeyEvent := KeyEvent - $03000000;}
+ SysTranslateKeyEvent := KeyEvent;
+end;
+
+
+Const
+ SysKeyboardDriver : TKeyboardDriver = (
+ InitDriver : Nil;
+ DoneDriver : Nil;
+ GetKeyevent : @SysGetKeyEvent;
+ PollKeyEvent : @SysPollKeyEvent;
+ GetShiftState : @SysGetShiftState;
+ TranslateKeyEvent : nil; //@SysTranslateKeyEvent;
+ TranslateKeyEventUnicode : Nil;
+ );
+
+begin
+ KeyboardInitialized := false;
+ PendingKeyEvent := 0;
+ SetKeyBoardDriver(SysKeyBoardDriver);
+end.
+
+{
+ $Log: keyboard.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/libc.imp b/rtl/netwlibc/libc.imp
new file mode 100644
index 0000000000..5c11f4497c
--- /dev/null
+++ b/rtl/netwlibc/libc.imp
@@ -0,0 +1,1391 @@
+ ASCIIZToLenStr,
+ ASCIIZToMaxLenStr,
+ Copy__fp_characteristics,
+ Delete_CLIB_OPT_FromCommandLine,
+ DllMain,
+ ExportPublicObject,
+ GetRawKeyWithScreen,
+ ImportPublicObject,
+ KernelSpinLock,
+ KernelSpinLockDisable,
+ KernelSpinLockInit,
+ KernelSpinTryLock,
+ KernelSpinTryLockDisable,
+ KernelSpinUnlock,
+ KernelSpinUnlockRestore,
+ LenStrCat,
+ LenStrCmp,
+ LenStrCpy,
+ LenToASCIIZStr,
+ LibCPostStart,
+ LibCPreStart,
+ Lisalnum,
+ Lisalpha,
+ Lisblank,
+ Liscntrl,
+ Lisdigit,
+ Lisgraph,
+ Lislower,
+ Lisprint,
+ Lispunct,
+ Lisspace,
+ Lisupper,
+ Lisxdigit,
+ Lstrbcpy,
+ Lstrchr,
+ Lstrcmp,
+ Lstrcoll,
+ Lstrcspn,
+ Lstricmp,
+ Lstrlen,
+ Lstrlwr,
+ Lstrncat,
+ Lstrncmp,
+ Lstrncpy,
+ Lstrnicmp,
+ Lstrpbrk,
+ Lstrrchr,
+ Lstrrev,
+ Lstrspn,
+ Lstrstr,
+ Lstrtok_r,
+ Lstrupr,
+ Lstrxfrm,
+ PromptForPassword,
+ PromptForString,
+ ReallocSleepOK,
+ RxIdentifyCode,
+ RxLockMemory,
+ RxRegisterKernelResource,
+ RxRegisterSysCall,
+ RxRegisterSyscall,
+ RxRegisterThreadResource,
+ RxUnidentifyCode,
+ RxUnlockMemory,
+ RxUnregisterKernelResource,
+ RxUnregisterSysCall,
+ RxUnregisterSyscall,
+ RxUnregisterThreadResource,
+ SetAutoUnloadFlag,
+ ShutdownServer,
+ StartNLMInNKS,
+ TerminateNLMFromNKS,
+ TransmitFile,
+ UnImportPublicObject,
+ UnregisterKLibHandlers,
+ _8087,
+ _NonAppCheckUnload,
+ _NonAppStart,
+ _NonAppStop,
+ __8087,
+ __CHP,
+ __CW_div,
+ __CW_ldiv,
+ __FDA,
+ __FDC,
+ __FDD,
+ __FDFS,
+ __FDI4,
+ __FDM,
+ __FDN,
+ __FDS,
+ __FDU4,
+ __FSA,
+ __FSC,
+ __FSD,
+ __FSFD,
+ __FSI1,
+ __FSI2,
+ __FSI4,
+ __FSM,
+ __FSN,
+ __FSS,
+ __FSU1,
+ __FSU2,
+ __FSU4,
+ __I4FD,
+ __I4FS,
+ __RDI4,
+ __RDU4,
+ __TlsAlloc,
+ __U4FD,
+ __U4FS,
+ __ZBuf2F,
+ ____environ,
+ ___cin,
+ ___clocks_per_sec,
+ ___cout,
+ ___daylight,
+ ___daylightOffset,
+ ___daylightOnOff,
+ ___environ,
+ ___errno,
+ ___fd_clr,
+ ___fd_isset,
+ ___fd_set,
+ ___fd_zero,
+ ___fpclassify_d,
+ ___fpclassify_f,
+ ___fpclassify_ld,
+ ___h_errno,
+ ___huge_double,
+ ___huge_float,
+ ___huge_long_double,
+ ___isfinite_d,
+ ___isfinite_f,
+ ___isfinite_ld,
+ ___lastClientErrno,
+ ___lastFileSysErrno,
+ ___nan_float,
+ ___optarg,
+ ___opterr,
+ ___optind,
+ ___optopt,
+ ___optreset,
+ ___signbit_d,
+ ___signbit_f,
+ ___signbit_ld,
+ ___stderr,
+ ___stdin,
+ ___stdout,
+ ___timezone,
+ ___tzname,
+ __ashldi3,
+ __ashrdi3,
+ __ctype,
+ __deinit_environment,
+ __divdi3,
+ __fp_characteristics,
+ __get_stderr,
+ __get_stdin,
+ __get_stdout,
+ __init_387_emulator,
+ __init_environment,
+ __longjmp,
+ __lshrdi3,
+ __moddi3,
+ __muldi3,
+ __old_8087,
+ __set_errno,
+ __setjmp,
+ __udivdi3,
+ __umoddi3,
+ __utf8width,
+ _alldiv,
+ _allmul,
+ _allrem,
+ _allshl,
+ _allshr,
+ _assert,
+ _assert_expr,
+ _aulldiv,
+ _aullrem,
+ _aullshl,
+ _aullshr,
+ _clear87,
+ _control87,
+ _fini,
+ _fltused_,
+ _fpreset,
+ _init,
+ _lldiv,
+ _llmod,
+ _llmul,
+ _llshl,
+ _llshr,
+ _lludiv,
+ _llumod,
+ _llushr,
+ _lrotl,
+ _lrotr,
+ _rotl,
+ _rotr,
+ _rt_cmps64%16,
+ _rt_cmpu64%16,
+ _rt_divs64%16,
+ _rt_divu64%16,
+ _rt_mods64%16,
+ _rt_modu64%16,
+ _rt_mul64%16,
+ _rt_rotl64%16,
+ _rt_rotr64%16,
+ _rt_shl64%16,
+ _rt_shrs64%16,
+ _rt_shru64%16,
+ _status87,
+ abs,
+ acos,
+ asin,
+ assert_action,
+ atan,
+ atan2,
+ atof,
+ atoi,
+ atol,
+ atoll,
+ atomic64_add,
+ atomic64_cmpxchg,
+ atomic64_dec,
+ atomic64_inc,
+ atomic64_sub,
+ atomic64_xchg,
+ atomic64_xchgadd,
+ atomic_add,
+ atomic_and,
+ atomic_btr,
+ atomic_bts,
+ atomic_cmpxchg,
+ atomic_dec,
+ atomic_inc,
+ atomic_or,
+ atomic_sub,
+ atomic_xchg,
+ atomic_xchgadd,
+ atomic_xor,
+ basename,
+ bsearch,
+ btowc,
+ cabs,
+ cbrt,
+ ceil,
+ cleardontunloadflag,
+ confstr,
+ construct,
+ construct_argc_argv,
+ cos,
+ cosh,
+ deconstruct,
+ detect_redirection,
+ dirname,
+ dlclose,
+ dlerror,
+ dlopen,
+ dlsym,
+ err,
+ errx,
+ exp,
+ fabs,
+ feclearexcept,
+ fegetenv,
+ fegetexceptflag,
+ fegetround,
+ feholdexcept,
+ feraiseexceptflag,
+ fesetenv,
+ fesetexceptflag,
+ fesetround,
+ fetestexcept,
+ feupdateenv,
+ finite,
+ floor,
+ fmod,
+ fpathconf,
+ fpgetmask,
+ fpgetround,
+ fpgetsticky,
+ fpsetmask,
+ fpsetround,
+ fpsetsticky,
+ frexp,
+ fs_getslotinfo,
+ fs_mapkeytopath,
+ fs_mapzidtopath,
+ fs_read,
+ fs_register,
+ fs_unregister,
+ fs_write,
+ fst_getorignamespace,
+ fst_getvoldir,
+ fst_mapvoldirtopath,
+ fst_mapvoltoname,
+ fst_read,
+ fst_register,
+ fst_unregister,
+ fst_write,
+ get_app_data,
+ get_app_type,
+ getaddressspace,
+ getaddressspacename,
+ getallocresourcetag,
+ getnativethread,
+ getnlmhandle,
+ getnlmhandlefromthread,
+ getnlmloadpath,
+ getnlmname,
+ getopt,
+ getopt_long,
+ getopt_long_only,
+ getthreadid,
+ getthreadname,
+ htol,
+ hypot,
+ in6addr_any,
+ in6addr_loopback,
+ inet_makeaddr,
+ inet_ntop,
+ inet_pton,
+ isalnum,
+ isalpha,
+ isascii,
+ isblank,
+ iscntrl,
+ isdigit,
+ isgraph,
+ islower,
+ ismultibyte,
+ isprint,
+ ispunct,
+ isspace,
+ isupper,
+ isutf8alnum,
+ isutf8alpha,
+ isutf8ascii,
+ isutf8digit,
+ isutf8lower,
+ isutf8space,
+ isutf8upper,
+ isutf8xdigit,
+ iswalnum,
+ iswalpha,
+ iswascii,
+ iswcntrl,
+ iswctype,
+ iswdigit,
+ iswgraph,
+ iswlower,
+ iswprint,
+ iswpunct,
+ iswspace,
+ iswupper,
+ iswxdigit,
+ isxdigit,
+ itoa,
+ itoab,
+ j0,
+ j1,
+ jn,
+ labs,
+ ldexp,
+ libcthreshold,
+ library_calloc,
+ library_free,
+ library_malloc,
+ library_msize,
+ library_realloc,
+ lltoa,
+ log,
+ log10,
+ ltoa,
+ main,
+ matherr_handler,
+ max,
+ mbrlen,
+ mbrtowc,
+ mbsinit,
+ mbsrtowcs,
+ memchr,
+ memcmp,
+ memcpy,
+ memicmp,
+ memmove,
+ memset,
+ min,
+ mkdtemp,
+ mkstemp,
+ mktemp,
+ modf,
+ multibyte,
+ netware_conn_info,
+ netware_conn_info_from_slot,
+ netware_cpu_info,
+ netware_fs_info,
+ netware_mem_info,
+ netware_mem_info_for_nlm,
+ netware_net_info,
+ netware_net_macaddr,
+ netware_os_info,
+ netware_restag_info_for_nlm,
+ netware_vmem_info,
+ netware_vol_info,
+ netware_vol_info_from_name,
+ netware_vol_info_from_number,
+ nextmb,
+ nlmisloadedprotected,
+ null_ipv6_address,
+ pathconf,
+ posix_checkunload,
+ posix_start,
+ posix_stop,
+ pow,
+ prevmb,
+ qsort,
+ register_destructor,
+ register_library,
+ remainder,
+ rint,
+ rotl16,
+ rotl32,
+ rotl64,
+ rotl8,
+ rotr16,
+ rotr32,
+ rotr64,
+ rotr8,
+ set_app_data,
+ setdontunloadflag,
+ sethostid,
+ setthreadname,
+ sin,
+ sinh,
+ sqrt,
+ stackwatermark,
+ stpcpy,
+ strcasecmp,
+ strcat,
+ strchr,
+ strcmp,
+ strcpy,
+ strcspn,
+ strecpy,
+ stricmp,
+ strindex,
+ strlcat,
+ strlcpy,
+ strlen,
+ strlist,
+ strlwr,
+ strncasecmp,
+ strncat,
+ strncmp,
+ strncoll,
+ strncpy,
+ strnicmp,
+ strnset,
+ strpbrk,
+ strrchr,
+ strrev,
+ strrindex,
+ strset,
+ strspn,
+ strstr,
+ strsub,
+ strtod,
+ strtoi,
+ strtok_r,
+ strtol,
+ strtoll,
+ strtoul,
+ strtoull,
+ strupr,
+ strwhich,
+ strxfrm,
+ swab,
+ swaw,
+ sysconf,
+ system,
+ tan,
+ tanh,
+ toascii,
+ tolower,
+ toupper,
+ towctrans,
+ towlower,
+ towupper,
+ truncmb,
+ ucs2_to_utf8,
+ ulltoa,
+ ultoa,
+ uname2,
+ unregister_library,
+ utf8_to_ucs2,
+ utf8cat,
+ utf8chr,
+ utf8cmp,
+ utf8cpy,
+ utf8cspn,
+ utf8dup,
+ utf8index,
+ utf8len,
+ utf8list,
+ utf8lwr,
+ utf8ncat,
+ utf8ncpy,
+ utf8next,
+ utf8nlen,
+ utf8nset,
+ utf8pbrk,
+ utf8prev,
+ utf8rchr,
+ utf8rev,
+ utf8size,
+ utf8spn,
+ utf8str,
+ utf8tok_r,
+ utf8upr,
+ utf8width,
+ utoa,
+ validateaddressrange,
+ valuemb,
+ verifynlmhandle,
+ verr,
+ verrx,
+ vwarn,
+ vwarnx,
+ warn,
+ warnx,
+ wcrtomb,
+ wcscasecmp,
+ wcscat,
+ wcschr,
+ wcscmp,
+ wcscoll,
+ wcscpy,
+ wcscspn,
+ wcserror,
+ wcsftime,
+ wcsicmp,
+ wcsindex,
+ wcslen,
+ wcslist,
+ wcslwr,
+ wcsmemcmp,
+ wcsmemcpy,
+ wcsmemmove,
+ wcsncasecmp,
+ wcsncat,
+ wcsncmp,
+ wcsncpy,
+ wcsnicmp,
+ wcsnset,
+ wcspbrk,
+ wcsrchr,
+ wcsrev,
+ wcsrindex,
+ wcsrtombs,
+ wcsset,
+ wcsspn,
+ wcsstr,
+ wcstod,
+ wcstof,
+ wcstok,
+ wcstok_r,
+ wcstol,
+ wcstold,
+ wcstoll,
+ wcstoul,
+ wcstoull,
+ wcsupr,
+ wcswidth,
+ wcsxfrm,
+ wctob,
+ wctrans,
+ wctype,
+ wcwidth,
+ wmemchr,
+ wmemmove,
+ wungettok,
+ wungettok_r,
+ y0,
+ y1,
+ yn,
+ NXClose,
+ NXCondAlloc,
+ NXCondBroadcast,
+ NXCondDeinit,
+ NXCondFree,
+ NXCondInit,
+ NXCondSignal,
+ NXCondTimedWait,
+ NXCondWait,
+ NXContextAlloc,
+ NXContextFree,
+ NXContextGet,
+ NXContextGetInfo,
+ NXContextGetName,
+ NXContextReinit,
+ NXContextSetName,
+ NXCreatePathContext,
+ NXDelayedWorkSchedule,
+ NXDeviceOpen,
+ NXDirCreate,
+ NXDirEnumEnd,
+ NXDirEnumGetEntries,
+ NXDirEnumStart,
+ NXDirMarkInit,
+ NXDirRemove,
+ NXFifoOpen,
+ NXFileCancelIo,
+ NXFileFlushBuffers,
+ NXFileGetAttributesWithHandle,
+ NXFileGetLength,
+ NXFileGetLengthWithHandle,
+ NXFileOpen,
+ NXFileOpenEx,
+ NXFileRangeLock,
+ NXFileRangeUnlock,
+ NXFileRemoveWithHandle,
+ NXFileRenameWithHandle,
+ NXFileSetAttributesWithHandle,
+ NXFileSetLength,
+ NXFileSetLengthWithHandle,
+ NXFindDeinit,
+ NXFindEntry,
+ NXFindInit,
+ NXFreePathContext,
+ NXGetAttr,
+ NXGetAttrWithHandle,
+ NXGetAttributes,
+ NXGetCacheLineSize,
+ NXGetCpuCount,
+ NXGetCpuId,
+ NXGetNKSVersion,
+ NXGetPageSize,
+ NXGetSystemTick,
+ NXGetTime,
+ NXIoGetOpenMode,
+ NXIoSetBlockingState,
+ NXKeyCreate,
+ NXKeyDelete,
+ NXKeyGetValue,
+ NXKeySetValue,
+ NXLock,
+ NXLwWorkCancel,
+ NXLwWorkSchedule,
+ NXMemAlloc,
+ NXMemCtl,
+ NXMemFree,
+ NXMemRealloc,
+ NXMutexAlloc,
+ NXMutexDeinit,
+ NXMutexDepth,
+ NXMutexFree,
+ NXMutexInit,
+ NXMutexIsOwned,
+ NXMutexTestFlag,
+ NXPageAlloc,
+ NXPageFree,
+ NXProcessInterruptSet,
+ NXRdLock,
+ NXRead,
+ NXReadEx,
+ NXRemove,
+ NXRename,
+ NXRwLockAlloc,
+ NXRwLockDeinit,
+ NXRwLockDowngrade,
+ NXRwLockFree,
+ NXRwLockInit,
+ NXRwLockIsOwned,
+ NXRwLockUpgrade,
+ NXRwUnlock,
+ NXSeedRandom,
+ NXSemaAlloc,
+ NXSemaDeinit,
+ NXSemaFree,
+ NXSemaInit,
+ NXSemaPost,
+ NXSemaTryWait,
+ NXSemaWait,
+ NXSetAttr,
+ NXSetAttrWithHandle,
+ NXSetAttributes,
+ NXStrError,
+ NXThreadBind,
+ NXThreadContinue,
+ NXThreadCreate,
+ NXThreadCreateSx,
+ NXThreadDelay,
+ NXThreadDestroy,
+ NXThreadDetach,
+ NXThreadExit,
+ NXThreadGetBinding,
+ NXThreadGetContext,
+ NXThreadGetId,
+ NXThreadGetPriority,
+ NXThreadInterrupt,
+ NXThreadIsInterrupted,
+ NXThreadJoin,
+ NXThreadSetPriority,
+ NXThreadSuspend,
+ NXThreadSwapContext,
+ NXThreadUnbind,
+ NXThreadYield,
+ NXTimeOutCancel,
+ NXTimeOutSchedule,
+ NXTryLock,
+ NXTryRdLock,
+ NXTryWrLock,
+ NXUnlock,
+ NXVmDestroy,
+ NXVmExit,
+ NXVmGetId,
+ NXVmGetWorkerThreadConfig,
+ NXVmGetStringType,
+ NXVmJoin,
+ NXVmRegisterExitHandler,
+ NXVmSetWorkerThreadConfig,
+ NXVmSpawn,
+ NXVmUnregisterExitHandler,
+ NXWorkCancel,
+ NXWorkSchedule,
+ NXWrLock,
+ NXWrite,
+ NXWriteEx,
+ _set_vm_context,
+ nxAddTrustee,
+ nxCancelCheck,
+ nxCancelDisable,
+ nxCancelEnable,
+ nxDeleteTrustee,
+ nxExportInterface,
+ nxExportInterfaceWrapped,
+ nxGetEnviron,
+ nxScanTrustees,
+ nxThreadCreate,
+ nxUnexportInterfaceWrapped,
+ (LIBC)
+ LocToUniSize,
+ LocToUniTagFunc,
+ LocToUtf8Size,
+ UniDisposeTable,
+ UniGetHostCodePage,
+ UniGetMacintoshTable,
+ UniGetTable,
+ UniSetDefault,
+ UniToLocSize,
+ UniToUtf8Size,
+ UniToLocTagFunc,
+ Utf8ToLocSize,
+ Utf8ToUniSize,
+ asc2uni,
+ ascn2uni,
+ chr2lwr,
+ chr2upr,
+ dbcs_width,
+ loc2uni,
+ loc2unipath,
+ loc2utf8,
+ loc2utf8path,
+ locn2uni,
+ locn2unispecial,
+ locn2unispecial_legacy,
+ locn2utf8,
+ locnp2uni,
+ locnp2uni_nonull,
+ locnx2uni,
+ uni2asc,
+ uni2loc,
+ uni2locpath,
+ uni2lwr,
+ uni2mono,
+ uni2upr,
+ uni2utf8,
+ uni2utf8path,
+ unicase,
+ unicat,
+ unichr,
+ unicmp,
+ unicoll,
+ unicpy,
+ unicspn,
+ unidup,
+ uniicmp,
+ uniindex,
+ unilen,
+ unilist,
+ unilwr,
+ unin2asc,
+ unin2loc,
+ unin2locspecial,
+ unin2locspecial_legacy,
+ unin2lwr,
+ unin2mono,
+ unin2title,
+ unin2upr,
+ unin2utf8,
+ unincat,
+ unincmp,
+ unincoll,
+ unincpy,
+ uninicmp,
+ uninlen,
+ uninset,
+ uninp2loc,
+ uninp2loc_nonull,
+ uninx2loc,
+ unipbrk,
+ unirchr,
+ unirev,
+ uniset,
+ unisize,
+ unispn,
+ unistr,
+ unitok,
+ unitok_r,
+ unitype,
+ uniupr,
+ utf82loc,
+ utf82uni,
+ utf8n2loc,
+ utf8n2uni,
+ utf8nx2loc,
+ FreeLibrary,
+ GetLastError,
+ LoadLibrary,
+ SetLastError,
+ __isleap,
+ _exit,
+ _fildes_from_nsskey,
+ _fildes_type,
+ _fs_type,
+ abort,
+ accept,
+ access,
+ asctime,
+ asctime_r,
+ atexit,
+ barrier_dec,
+ barrier_destroy,
+ barrier_inc,
+ barrier_init,
+ barrier_wait,
+ bind,
+ brk,
+ build_username,
+ calendar2dos,
+ calloc,
+ cancel,
+ catclose,
+ catgets,
+ catopen,
+ cgetc,
+ cgets,
+ chdir,
+ chdir2,
+ chmod,
+ chsize,
+ chsize64,
+ clearenv,
+ clearerr,
+ clearscreen,
+ clock,
+ close,
+ close_ncp_session,
+ closedir,
+ closedir64,
+ closelog,
+ cond_broadcast,
+ cond_destroy,
+ cond_init,
+ cond_signal,
+ cond_timedwait,
+ cond_wait,
+ connect,
+ consoleprintf,
+ cprintf,
+ cputc,
+ cputs,
+ creat,
+ create_identity,
+ create_server_identity,
+ crypt,
+ cscanf,
+ ctime,
+ ctime_r,
+ delay,
+ delete_identity,
+ derivelocale,
+ dfs_close,
+ dfs_creat,
+ dfs_extend,
+ dfs_freelimbospace,
+ dfs_getfilemapinfo,
+ dfs_getvolblockinfo,
+ dfs_getvolmapinfo,
+ dfs_read,
+ dfs_readnowait,
+ dfs_seteof,
+ dfs_setlength,
+ dfs_sopen,
+ dfs_write,
+ dfs_writenowait,
+ difftime,
+ dos2calendar,
+ dup,
+ dup2,
+ encrypt,
+ eof,
+ exit,
+ fchdir,
+ fchmod,
+ fclose,
+ fcntl,
+ fdatasync,
+ fdopen,
+ feof,
+ ferror,
+ fflush,
+ fgetc,
+ fgetpos,
+ fgetpos64,
+ fgets,
+ fgetstat,
+ fgetwc,
+ fgetws,
+ fileno,
+ findnlmhandle,
+ flockfile,
+ flushenv,
+ fnmatch,
+ fopen,
+ fork,
+ fprintf,
+ fputc,
+ fputs,
+ fputwc,
+ fputws,
+ fread,
+ free,
+ freopen,
+ fscanf,
+ fscopy,
+ fseek,
+ fseek64,
+ fsetpos,
+ fsetpos64,
+ fstat,
+ fstatfs,
+ fsync,
+ ftell,
+ ftell64,
+ ftok,
+ ftruncate,
+ ftruncate64,
+ ftrylockfile,
+ funlockfile,
+ fwide,
+ fwprintf,
+ fwrite,
+ fwscanf,
+ get_identity,
+ getalternateconsole,
+ getbsize,
+ getc,
+ getc_unlocked,
+ getchar,
+ getchar_unlocked,
+ getcharacter,
+ getcmd,
+ getconsolehandle,
+ getcwd,
+ getcwdpath,
+ getdtablehi,
+ getdtablesize,
+ getegid,
+ getenv,
+ geteuid,
+ getgid,
+ getgrgid,
+ getgrnam,
+ gethostbyaddr,
+ gethostbyname,
+ gethostname,
+ getkey,
+ getnetwareconsole,
+ getnetwarelogger,
+ getpassword,
+ getpeername,
+ getpgrp,
+ getpid,
+ getppid,
+ getprotobyname,
+ getprotobynumber,
+ getpwnam,
+ getpwuid,
+ gets,
+ getscreenhandle,
+ getscreenmode,
+ getservbyname,
+ getservbyport,
+ getsockname,
+ getsockopt,
+ getstat,
+ getstat_with_namespace,
+ getstring,
+ getw,
+ gettimeofday,
+ getuid,
+ getwc,
+ getwchar,
+ glob,
+ globfree,
+ gmtime,
+ gmtime_r,
+ gotorowcol,
+ htonl,
+ htons,
+ iconv,
+ iconv_close,
+ iconv_open,
+ inet_addr,
+ inet_aton,
+ inet_ntoa,
+ ioctl,
+ is_valid_identity,
+ isatty,
+ kbhit,
+ kill,
+ listen,
+ localeconv,
+ localtime,
+ localtime_r,
+ lseek,
+ lseek64,
+ lstat,
+ ltime,
+ madvise,
+ malloc,
+ max,
+ mblen,
+ mbstowcs,
+ mbtowc,
+ mincore,
+ mkdir,
+ mkfifo,
+ mkgmtime,
+ mknod,
+ mktime,
+ mlock,
+ mlockall,
+ mmap,
+ mmap64,
+ mprotect,
+ msize,
+ msync,
+ munlock,
+ munlockall,
+ munmap,
+ mutex_destroy,
+ mutex_init,
+ mutex_lock,
+ mutex_trylock,
+ mutex_unlock,
+ mvalidrange,
+ nanosleep,
+ nl_langinfo,
+ ntohl,
+ ntohs,
+ open,
+ open_ncp_session,
+ opendir,
+ opendir64,
+ openlog,
+ pclose,
+ perror,
+ pipe,
+ pipe_open,
+ pipe_select,
+ popen,
+ pread,
+ pread64,
+ pressanykey,
+ pressenter,
+ pressescape,
+ printf,
+ processle,
+ processve,
+ procle,
+ procve,
+ pthread_atfork,
+ pthread_attr_destroy,
+ pthread_attr_getdetachstate,
+ pthread_attr_getinheritsched,
+ pthread_attr_getname_np,
+ pthread_attr_getschedparam,
+ pthread_attr_getschedpolicy,
+ pthread_attr_getscope,
+ pthread_attr_getstackaddr,
+ pthread_attr_getstacksize,
+ pthread_attr_init,
+ pthread_attr_setdetachstate,
+ pthread_attr_setinheritsched,
+ pthread_attr_setname_np,
+ pthread_attr_setschedparam,
+ pthread_attr_setschedpolicy,
+ pthread_attr_setscope,
+ pthread_attr_setstackaddr,
+ pthread_attr_setstacksize,
+ pthread_cancel,
+ pthread_cleanup_pop,
+ pthread_cleanup_push,
+ pthread_cond_broadcast,
+ pthread_cond_destroy,
+ pthread_cond_init,
+ pthread_cond_signal,
+ pthread_cond_timedwait,
+ pthread_cond_wait,
+ pthread_condattr_destroy,
+ pthread_condattr_getpshared,
+ pthread_condattr_init,
+ pthread_condattr_setpshared,
+ pthread_create,
+ pthread_detach,
+ pthread_equal,
+ pthread_exit,
+ pthread_getschedparam,
+ pthread_getspecific,
+ pthread_join,
+ pthread_key_create,
+ pthread_key_delete,
+ pthread_kill,
+ pthread_mutex_destroy,
+ pthread_mutex_init,
+ pthread_mutex_lock,
+ pthread_mutex_trylock,
+ pthread_mutex_unlock,
+ pthread_mutexattr_destroy,
+ pthread_mutexattr_getprioceiling,
+ pthread_mutexattr_getprotocol,
+ pthread_mutexattr_getpshared,
+ pthread_mutexattr_gettype,
+ pthread_mutexattr_init,
+ pthread_mutexattr_setprioceiling,
+ pthread_mutexattr_setprotocol,
+ pthread_mutexattr_setpshared,
+ pthread_mutexattr_settype,
+ pthread_once,
+ pthread_rwlock_destroy,
+ pthread_rwlock_init,
+ pthread_rwlock_rdlock,
+ pthread_rwlock_timedrdlock,
+ pthread_rwlock_timedwrlock,
+ pthread_rwlock_tryrdlock,
+ pthread_rwlock_trywrlock,
+ pthread_rwlock_unlock,
+ pthread_rwlock_wrlock,
+ pthread_rwlockattr_destroy,
+ pthread_rwlockattr_getpshared,
+ pthread_rwlockattr_init,
+ pthread_rwlockattr_setpshared,
+ pthread_self,
+ pthread_setcancelstate,
+ pthread_setcanceltype,
+ pthread_setschedparam,
+ pthread_setspecific,
+ pthread_sigmask,
+ pthread_testcancel,
+ pthread_yield,
+ purgeerasedfile,
+ putc,
+ putc_unlocked,
+ putchar,
+ putchar_unlocked,
+ putcharacter,
+ putenv,
+ puts,
+ putstring,
+ putwc,
+ putwchar,
+ pwrite,
+ pwrite64,
+ raise,
+ rand,
+ rand_r,
+ read,
+ readdir,
+ readdir64,
+ readdir_r,
+ readlink,
+ readv,
+ realloc,
+ realname,
+ recv,
+ recvfrom,
+ recvmsg,
+ regcomp,
+ regerror,
+ regexec,
+ regfree,
+ remove,
+ rename,
+ renamescreen,
+ rewind,
+ rewinddir,
+ rewinddir64,
+ ringbell,
+ rmdir,
+ rw_rdlock,
+ rw_tryrdlock,
+ rw_trywrlock,
+ rw_unlock,
+ rw_wrlock,
+ rwlock_destroy,
+ rwlock_init,
+ salvageerasedfile,
+ sbrk,
+ scanerasedfiles,
+ scanf,
+ sched_get_priority_max,
+ sched_get_priority_min,
+ sched_getparam,
+ sched_getscheduler,
+ sched_rr_get_interval,
+ sched_setparam,
+ sched_setscheduler,
+ sched_yield,
+ screenprintf,
+ select,
+ sem_destroy,
+ sem_getvalue,
+ sem_init,
+ sem_post,
+ sem_timedwait,
+ sem_trywait,
+ sem_wait,
+ sema_destroy,
+ sema_init,
+ sema_post,
+ sema_trywait,
+ sema_wait,
+ semctl,
+ semget,
+ semop,
+ send,
+ send_ncp,
+ sendfile,
+ sendmsg,
+ sendto,
+ set_pathname_format,
+ setbuf,
+ setcwd,
+ setcwd2,
+ setenv,
+ setgid,
+ setkey,
+ setlocale,
+ setlocale_r,
+ setlogmask,
+ setmode,
+ setpgid,
+ setscreenmode,
+ setsid,
+ setsockopt,
+ settimeofday,
+ setuid,
+ setvbuf,
+ shmat,
+ shmctl,
+ shmdt,
+ shmget,
+ shutdown,
+ sigaction,
+ sigaddset,
+ sigdelset,
+ sigemptyset,
+ sigfillset,
+ sigismember,
+ signal,
+ sigpending,
+ sigprocmask,
+ sigsuspend,
+ sigwait,
+ sleep,
+ snprintf,
+ socket,
+ sopen,
+ sprintf,
+ srand,
+ sscanf,
+ stackavail,
+ stackbase,
+ stat,
+ stat64,
+ statfs,
+ strcoll,
+ strdup,
+ strerror,
+ strerror_r,
+ strftime,
+ strftime_r,
+ strtok,
+ strxfrm,
+ swprintf,
+ swscanf,
+ sync,
+ syslog,
+ tcgetattr,
+ tcsetattr,
+ tell,
+ tell64,
+ tempnam,
+ thr_continue,
+ thr_create,
+ thr_exit,
+ thr_getconcurrency,
+ thr_getprio,
+ thr_getspecific,
+ thr_join,
+ thr_keycreate,
+ thr_minstack,
+ thr_self,
+ thr_setconcurrency,
+ thr_setprio,
+ thr_setspecific,
+ thr_sigsetmask,
+ thr_suspend,
+ thr_yield,
+ time,
+ times,
+ tmpfile,
+ tmpnam,
+ ttyname,
+ ttyname_r,
+ tzset,
+ umask,
+ uname,
+ ungetc,
+ ungetcharacter,
+ ungetkey,
+ ungettok,
+ ungetwc,
+ unlink,
+ unsetenv,
+ usleep,
+ utime,
+ vasprintf,
+ vconsoleprintf,
+ vcprintf,
+ vcscanf,
+ vfprintf,
+ vfscanf,
+ vfwprintf,
+ vfwscanf,
+ vprintf,
+ vscanf,
+ vscreenprintf,
+ vsnprintf,
+ vsprintf,
+ vsscanf,
+ vswprintf,
+ vswscanf,
+ vwprintf,
+ vwscanf,
+ wait,
+ waitpid,
+ want_posix_semantics,
+ wcstombs,
+ wctomb,
+ wherecol,
+ whererow,
+ whererowcol,
+ wmemcmp,
+ wmemcpy,
+ wmemset,
+ wprintf,
+ write,
+ writev,
+ wscanf,
+ xcalloc,
+ xfree,
+ xmalloc,
+ xrealloc
diff --git a/rtl/netwlibc/libc.pp b/rtl/netwlibc/libc.pp
new file mode 100644
index 0000000000..134f2c8285
--- /dev/null
+++ b/rtl/netwlibc/libc.pp
@@ -0,0 +1,9237 @@
+{
+ $Id: libc.pp,v 1.11 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Armin Diehl, member of the Free Pascal
+ development team
+
+ Interface to Netware libc
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+
+{$ifndef INCLUDED_FROM_SYSTEM}
+{$mode objfpc}
+unit libc;
+interface
+
+{ Netware libc interface
+ Translated from c ndk Armin Diehl 2004/09/02 }
+{$endif}
+
+const
+ libc_nlm='libc';
+ system_nlm='!netware';
+
+{ Pointers to basic pascal types, inserted by h2pas conversion program.}
+Type
+{$ifndef INCLUDED_FROM_SYSTEM}
+ PLongint = ^Longint;
+ PSmallInt = ^SmallInt;
+ PByte = ^Byte;
+ PWord = ^Word;
+ PDWord = ^DWord;
+ PDouble = ^Double;
+{$endif}
+ PPPChar = ^PPChar;
+ void = pointer;
+ cint = longint;
+ TNLMHandle = Pointer;
+
+const
+ NullNlmHandle = nil;
+
+{$PACKRECORDS C}
+
+// string.h
+// limits.h
+
+{ some limits wanted by POSIX... }
+{ exact-width signed types... }
+type
+
+ Pint8_t = ^int8_t;
+ int8_t = char;
+
+ Pint16 = ^Tint16;
+ Tint16 = smallint;
+
+ Pint64_t = ^Tint64;
+ Tint64 = int64;
+{ exact-width unsigned types... }
+
+ Puint64 = ^Tuint64;
+ Tuint64 = qword;
+{ lower and upper bound of exact width integer types... }
+{ macros for minimum-width integer constants... }
+{ minimum-width signed integer types... }
+
+ Pint_least8_t = ^int_least8_t;
+ int_least8_t = char;
+
+ Pint_least16_t = ^int_least16_t;
+ int_least16_t = smallint;
+
+ Pint_least32_t = ^int_least32_t;
+ int_least32_t = longint;
+
+ Pint_least64_t = ^int_least64_t;
+ int_least64_t = int64;
+{ minimum-width unsigned integer types... }
+
+ Puint_least8_t = ^uint_least8_t;
+ uint_least8_t = byte;
+
+ Puint_least16_t = ^uint_least16_t;
+ uint_least16_t = word;
+
+ Puint_least32_t = ^uint_least32_t;
+ uint_least32_t = dword;
+
+ Puint_least64_t = ^uint_least64_t;
+ uint_least64_t = qword;
+{ lower and upper bound of exact width integer types... }
+{ fastest minimum-width signed integer types... }
+
+ Pint_fast8_t = ^int_fast8_t;
+ int_fast8_t = char;
+
+ Pint_fast16_t = ^int_fast16_t;
+ int_fast16_t = smallint;
+
+ Pint_fast32_t = ^int_fast32_t;
+ int_fast32_t = longint;
+
+ Pint_fast64_t = ^int_fast64_t;
+ int_fast64_t = int64;
+{ fastest minimum-width unsigned integer types... }
+
+ Puint_fast8_t = ^uint_fast8_t;
+ uint_fast8_t = byte;
+
+ Puint_fast16_t = ^uint_fast16_t;
+ uint_fast16_t = word;
+
+ Puint_fast32_t = ^uint_fast32_t;
+ uint_fast32_t = dword;
+
+ Puint_fast64_t = ^uint_fast64_t;
+ uint_fast64_t = qword;
+{ lower and upper bound of fastest minimum-width integer types... }
+{ integer types capable of holding object pointer... }
+
+ Pintptr_t = ^intptr_t;
+ intptr_t = longint;
+
+ Puintptr_t = ^uintptr_t;
+ uintptr_t = dword;
+{ limit of integer type capable of holding object pointer... }
+{ maximum-width integer types... }
+
+ Pintmax_t = ^intmax_t;
+ intmax_t = int64;
+
+ Puintmax_t = ^uintmax_t;
+ uintmax_t = Tuint64;
+{ macros for maximum-width integer constants... }
+{ limits for other integer types... }
+
+ Psize_t = ^size_t;
+ size_t = dword;
+{ type yielded by sizeof() }
+
+ Pssize_t = ^ssize_t;
+ ssize_t = longint;
+{ signed byte counts for file I/O }
+
+ Psize64_t = ^size64_t;
+ size64_t = Tuint64;
+{ used for 64-bit (long) file I/O }
+
+ Pmode_t = ^mode_t;
+ mode_t = dword;
+{ file attributes, permissions }
+
+ Poff_t = ^off_t;
+ off_t = longint;
+{ file offset value }
+
+ Poff64_t = ^off64_t;
+ off64_t = int64;
+{ 64-bit (long) file offset value }
+
+ Pino_t = ^ino_t;
+ ino_t = Tuint64;
+
+ Ppid_t = ^pid_t;
+ pid_t = longint;
+{ capable of holding a pointer or -1 }
+
+ Puid_t = ^uid_t;
+ uid_t = Tuint64;
+
+ Pgid_t = ^gid_t;
+ gid_t = Tuint64;
+
+ Pblksize_t = ^blksize_t;
+ blksize_t = Tuint64;
+
+ Pblkcnt_t = ^blkcnt_t;
+ blkcnt_t = Tuint64;
+
+ Pdev_t = ^dev_t;
+ dev_t = Tuint64;
+
+ Pnlink_t = ^nlink_t;
+ nlink_t = dword;
+
+ Pptrdiff_t = ^ptrdiff_t;
+ ptrdiff_t = longint;
+
+ Pwchar_t = ^wchar_t;
+ wchar_t = WideChar;
+ PPwchar_t = ^Pwchar_t;
+
+
+{ prototypes for functions standard and nonstandard... }
+
+function memchr(_para1:pointer; _para2:longint; _para3:size_t):pointer;cdecl;external libc_nlm name 'memchr';
+function memcmp(_para1, _para2:pointer; _para3:size_t):longint;cdecl;external libc_nlm name 'memcmp';
+function memcpy(__restrict, __restrict1:pointer; _para3:size_t):pointer;cdecl;external libc_nlm name 'memcpy';
+function memmove(_para1, _para2:pointer; _para3:size_t):pointer;cdecl;external libc_nlm name 'memmove';
+function memset(_para1:pointer; _para2:longint; _para3:size_t):pointer;cdecl;external libc_nlm name 'memset';
+function strcasecmp(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'strcasecmp';
+function strcat(dst,src:Pchar):Pchar;cdecl;external libc_nlm name 'strcat';
+function strchr(_para1:Pchar; _para2:longint):Pchar;cdecl;external libc_nlm name 'strchr';
+function strcmp(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'strcmp';
+function strcoll(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'strcoll';
+function strcpy(__restrict, __restrict1:Pchar):Pchar;cdecl;external libc_nlm name 'strcpy';
+function strcspn(_para1, _para2:Pchar):size_t;cdecl;external libc_nlm name 'strcspn';
+function strerror(_para1:longint):Pchar;cdecl;external libc_nlm name 'strerror';
+function strlcat(__restrict, __restrict1:Pchar; _para3:size_t):size_t;cdecl;external libc_nlm name 'strlcat';
+function strlcpy(__restrict, __restrict1:Pchar; _para3:size_t):size_t;cdecl;external libc_nlm name 'strlcpy';
+function {$ifdef INCLUDED_FROM_SYSTEM}libc_strlen{$else}strlen{$endif}(_para1:Pchar):size_t;cdecl;external libc_nlm name 'strlen';
+function strncasecmp(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'strncasecmp';
+function strncat(__restrict, __restrict1:Pchar; _para3:size_t):Pchar;cdecl;external libc_nlm name 'strncat';
+function strncmp(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'strncmp';
+function strncoll(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'strncoll';
+function strncpy(__restrict, __restrict1:Pchar; _para3:size_t):Pchar;cdecl;external libc_nlm name 'strncpy';
+function strnicmp(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'strnicmp';
+function strnset(_para1, _para2:longint; _para3:size_t):Pchar;cdecl;external libc_nlm name 'strnset';
+function strpbrk(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'strpbrk';
+function strrchr(_para1, _para2:longint):Pchar;cdecl;external libc_nlm name 'strrchr';
+function strrev(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'strrev';
+function strset(_para1:Pchar; _para2:longint):Pchar;cdecl;external libc_nlm name 'strset';
+function strspn(_para1, _para2:Pchar):size_t;cdecl;external libc_nlm name 'strspn';
+function strstr(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'strstr';
+function strtok(__restrict, __restrict1:Pchar):Pchar;cdecl;external libc_nlm name 'strtok';
+function strxfrm(__restrict, __restrict1:Pchar; _para3:size_t):size_t;cdecl;external libc_nlm name 'strxfrm';
+{ POSIX and other functions... }
+
+function strtok_r(__restrict, __restrict1, __restrict2:PPchar):Pchar;cdecl;external libc_nlm name 'strtok_r';
+function memicmp(_para1, _para2:pointer; _para3:size_t):longint;cdecl;external libc_nlm name 'memicmp';
+function stpcpy(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'stpcpy';
+function stricmp(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'stricmp';
+function strdup(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'strdup';
+function strecpy(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'strecpy';
+function strerror_r(_para1:longint; _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'strerror_r';
+
+{$ifndef DisableArrayOfConst}
+function strlist(_para1, _para2:Pchar; args:array of const):Pchar;cdecl;external libc_nlm name 'strlist';
+{$endif}
+function strlist(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'strlist';
+function strlwr(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'strlwr';
+function strrindex(_para1:Pchar; _para2:size_t; _para3:longint):Pchar;cdecl;external libc_nlm name 'strrindex';
+function strwhich(_para1:Pchar; _para2:longint; _para3:Pchar):Pchar;cdecl;external libc_nlm name 'strwhich';
+function strupr(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'strupr';
+procedure swab(_para1, _para2:pointer; _para3:size_t);cdecl;external libc_nlm name 'swab';
+procedure swaw(_para1, _para2:pointer; _para3:size_t);cdecl;external libc_nlm name 'swaw';
+procedure ungettok(__restrict, __restrict1:Pchar);cdecl;external libc_nlm name 'ungettok';
+procedure ungettok_r(__restrict, __restrict1:Pchar; __restrict2:PPchar);cdecl;external libc_nlm name 'ungettok_r';
+{ multibyte (double) interfaces for locale code page work... }
+function Lstrbcpy(__restrict, __restrict1:Pchar; _para3:size_t):Pchar;cdecl;external libc_nlm name 'Lstrbcpy';
+function Lstrchr(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrchr';
+function Lstrcmp(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'Lstrcmp';
+function Lstrcoll(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'Lstrcoll';
+function Lstrcspn(_para1, _para2:Pchar):size_t;cdecl;external libc_nlm name 'Lstrcspn';
+function Lstricmp(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'Lstricmp';
+function Lstrlen(_para1:Pchar):size_t;cdecl;external libc_nlm name 'Lstrlen';
+function Lstrlwr(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrlwr';
+function Lstrncat(__restrict:Pchar; __restrict1:Pchar; _para3:size_t):Pchar;cdecl;external libc_nlm name 'Lstrncat';
+function Lstrncmp(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'Lstrncmp';
+function Lstrncoll(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'Lstrncoll';
+function Lstrncpy(__restrict, __restrict1:Pchar; _para3:size_t):Pchar;cdecl;external libc_nlm name 'Lstrncpy';
+function Lstrnicmp(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'Lstrnicmp';
+function Lstrpbrk(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrpbrk';
+function Lstrrchr(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrrchr';
+function Lstrrev(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrrev';
+function Lstrspn(_para1, _para2:Pchar):size_t;cdecl;external libc_nlm name 'Lstrspn';
+function Lstrstr(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrstr';
+function Lstrtok_r(__restrict:Pchar; __restrict1:Pchar; __restrict2:PPchar):Pchar;cdecl;external libc_nlm name 'Lstrtok_r';
+function Lstrupr(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'Lstrupr';
+function Lstrxfrm(__restrict:Pchar; __restrict1:Pchar; _para3:size_t):size_t;cdecl;external libc_nlm name 'Lstrxfrm';
+{ length-preceeded string manipulation... }
+function ASCIIZToLenStr(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'ASCIIZToLenStr';
+function ASCIIZToMaxLenStr(_para1, _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'ASCIIZToMaxLenStr';
+function LenStrCat(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'LenStrCat';
+function LenStrCmp(_para1, _para2:Pchar):longint;cdecl;external libc_nlm name 'LenStrCmp';
+function LenStrCpy(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'LenStrCpy';
+function LenToASCIIZStr(_para1,_para2:Pchar):longint;cdecl;external libc_nlm name 'LenToASCIIZStr';
+function strindex(_para1, _para2:Pchar):Pchar;cdecl;external libc_nlm name 'strindex';
+
+
+// stdarg.h
+
+ const
+ //EOF = -(1);
+ BUFSIZ = 8096; { default buffer size--change with setbuf() }
+ FOPEN_MAX = 1024; { at least this many FILEs available }
+ FILENAME_MAX = 1024; { maximum characters in any path name }
+ { values for argument 'flags' to setvbuf()...}
+ _IONBF = $0010; { unbuffered (e.g.: stdout and stderr) }
+ _IOLBF = $0020; { line buffered (e.g.: stdin) }
+ _IOFBF = $0040; { fully buffered (most files) }
+ { values for fseek()'s whence argument }
+ SEEK_SET = 0; { add 'offset' to beginning of file }
+ SEEK_CUR = 1; { add 'offset' to current position in file }
+ SEEK_END = 2; { add 'offset' to end of file }
+ { definitions for tmpnam() and tmpfil() }
+ TMP_MAX = 1000000; { "T-000000.TMP" to "T-999999.TMP" }
+ L_tmpnam = 36;
+ P_tmpdir = 'sys:/tmp';
+ { FILE type definition (result is opaque) }
+
+
+type
+
+ Pva_list = ^va_list;
+ va_list = char;
+
+ P_iobuf = ^_iobuf;
+ _iobuf = record
+ reserved : longint;
+ end;
+ TFILE = _iobuf;
+ PFILE = ^TFILE;
+ PPFILE = ^PFILE;
+
+ Pfpos_t = ^fpos_t;
+ fpos_t = longint;
+
+ Pfpos64_t = ^fpos64_t;
+ fpos64_t = off64_t;
+
+procedure clearerr(_para1:PFILE);cdecl;external libc_nlm name 'clearerr';
+function fclose(_para1:PFILE):longint;cdecl;external libc_nlm name 'fclose';
+function feof(_para1:PFILE):longint;cdecl;external libc_nlm name 'feof';
+function ferror(_para1:PFILE):longint;cdecl;external libc_nlm name 'ferror';
+function fflush(_para1:PFILE):longint;cdecl;external libc_nlm name 'fflush';
+function fgetc(_para1:PFILE):longint;cdecl;external libc_nlm name 'fgetc';
+function fgetpos(_para1:PFILE; _para2:Pfpos_t):longint;cdecl;external libc_nlm name 'fgetpos';
+function fgets(_para1:Pchar; _para2:longint; _para3:PFILE):Pchar;cdecl;external libc_nlm name 'fgets';
+
+
+function fopen(__restrict:Pchar; __restrict1:Pchar):PFILE;cdecl;external libc_nlm name 'fopen';
+{$ifndef DisableArrayOfConst}
+function fprintf(__restrict:PFILE; __restrict1:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'fprintf';
+{$endif}
+function fprintf(__restrict:PFILE; __restrict1:Pchar):longint;cdecl;external libc_nlm name 'fprintf';
+function fputc(_para1:longint; _para2:PFILE):longint;cdecl;external libc_nlm name 'fputc';
+
+function fputs(__restrict:Pchar; __restrict1:PFILE):longint;cdecl;external libc_nlm name 'fputs';
+function fread(__restrict:pointer; _para2:size_t; _para3:size_t; __restrict1:PFILE):size_t;cdecl;external libc_nlm name 'fread';
+
+
+function freopen(__restrict:Pchar; __restrict1:Pchar; __restrict2:PFILE):PFILE;cdecl;external libc_nlm name 'freopen';
+{$ifndef DisableArrayOfConst}
+function fscanf(__restrict:PFILE; __restrict1:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'fscanf';
+{$endif}
+function fscanf(__restrict:PFILE; __restrict1:Pchar):longint;cdecl;external libc_nlm name 'fscanf';
+function fseek(fp:PFILE; offset:longint; whence:longint):longint;cdecl;external libc_nlm name 'fseek';
+
+function fsetpos(_para1:PFILE; _para2:Pfpos_t):longint;cdecl;external libc_nlm name 'fsetpos';
+function ftell(_para1:PFILE):longint;cdecl;external libc_nlm name 'ftell';
+
+function fwrite(__restrict:pointer; _para2:size_t; _para3:size_t; __restrict1:PFILE):size_t;cdecl;external libc_nlm name 'fwrite';
+function getc(_para1:PFILE):longint;cdecl;external libc_nlm name 'getc';
+function getchar:longint;cdecl;external libc_nlm name 'getchar';
+function gets(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'gets';
+procedure {$ifdef INCLUDED_FROM_SYSTEM}libc_perror{$else}perror{$endif}(_para1:Pchar);cdecl;external libc_nlm name 'perror';
+
+{$ifndef DisableArrayOfConst}
+function printf(__restrict:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'printf';
+{$endif}
+function printf(__restrict:Pchar):longint;cdecl;external libc_nlm name 'printf';
+function putc(_para1:longint; _para2:PFILE):longint;cdecl;external libc_nlm name 'putc';
+function putchar(_para1:longint):longint;cdecl;external libc_nlm name 'putchar';
+function puts(_para1:Pchar):longint;cdecl;external libc_nlm name 'puts';
+function remove(_para1:Pchar):longint;cdecl;external libc_nlm name 'remove';
+function rename(_para1:Pchar; _para2:Pchar):longint;cdecl;external libc_nlm name 'rename';
+procedure rewind(_para1:PFILE);cdecl;external libc_nlm name 'rewind';
+
+{$ifndef DisableArrayOfConst}
+function scanf(__restrict:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'scanf';
+{$endif}
+function scanf(__restrict:Pchar):longint;cdecl;external libc_nlm name 'scanf';
+procedure setbuf(__restrict:PFILE; __restrict1:Pchar);cdecl;external libc_nlm name 'setbuf';
+function setvbuf(__restrict:PFILE; __restrict1:Pchar; _para3:longint; _para4:size_t):longint;cdecl;external libc_nlm name 'setvbuf';
+{$ifndef DisableArrayOfConst}
+function sprintf(__restrict:Pchar; __restrict1:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'sprintf';
+{$endif}
+function sprintf(__restrict:Pchar; __restrict1:Pchar):longint;cdecl;external libc_nlm name 'sprintf';
+{$ifndef DisableArrayOfConst}
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'snprintf';
+{$endif}
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1:longint):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1:longint; p2:pchar):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1:pchar):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1,p2:pchar):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1,p2,p3:pchar):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1,p2:longint):longint;cdecl;external libc_nlm name 'snprintf';
+function snprintf(__restrict:Pchar; n:size_t; Format:Pchar; p1,p2,p3:longint):longint;cdecl;external libc_nlm name 'snprintf';
+
+{$ifndef DisableArrayOfConst}
+function sscanf(__restrict:Pchar; __restrict1:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'sscanf';
+{$endif}
+function sscanf(__restrict:Pchar; __restrict1:Pchar):longint;cdecl;external libc_nlm name 'sscanf';
+function tmpfile:PFILE;cdecl;external libc_nlm name 'tmpfile';
+function tmpnam(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'tmpnam';
+function ungetc(_para1:longint; _para2:PFILE):longint;cdecl;external libc_nlm name 'ungetc';
+
+function vfprintf(__restrict:PFILE; __restrict1:Pchar; _para3:va_list):longint;cdecl;external libc_nlm name 'vfprintf';
+function vfscanf(__restrict:PFILE; __restrict1:Pchar; _para3:va_list):longint;cdecl;external libc_nlm name 'vfscanf';
+function vprintf(__restrict:Pchar; _para2:va_list):longint;cdecl;external libc_nlm name 'vprintf';
+function vscanf(__restrict:Pchar; _para2:va_list):longint;cdecl;external libc_nlm name 'vscanf';
+function vsnprintf(__restrict:Pchar; n:size_t; __restrict1:Pchar; _para4:va_list):longint;cdecl;external libc_nlm name 'vsnprintf';
+function vsprintf(__restrict:Pchar; __restrict1:Pchar; _para3:va_list):longint;cdecl;external libc_nlm name 'vsprintf';
+
+function vsscanf(__restrict:Pchar; __restrict1:Pchar; _para3:va_list):longint;cdecl;external libc_nlm name 'vsscanf';
+{ functions underlying macro support... }
+function ___stdin:PPFILE;cdecl;external libc_nlm name '___stdin';
+function ___stdout:PPFILE;cdecl;external libc_nlm name '___stdout';
+function ___stderr:PPFILE;cdecl;external libc_nlm name '___stderr';
+function ___cin:PPFILE;cdecl;external libc_nlm name '___cin';
+function ___cout:PPFILE;cdecl;external libc_nlm name '___cout';
+{ POSIX-defined and other additions... }
+
+function fdopen(_para1:longint; __restrict:Pchar):PFILE;cdecl;external libc_nlm name 'fdopen';
+function fileno(_para1:PFILE):longint;cdecl;external libc_nlm name 'fileno';
+procedure flockfile(_para1:PFILE);cdecl;external libc_nlm name 'flockfile';
+function ftrylockfile(_para1:PFILE):longint;cdecl;external libc_nlm name 'ftrylockfile';
+procedure funlockfile(_para1:PFILE);cdecl;external libc_nlm name 'funlockfile';
+function getc_unlocked(_para1:PFILE):longint;cdecl;external libc_nlm name 'getc_unlocked';
+function getchar_unlocked:longint;cdecl;external libc_nlm name 'getchar_unlocked';
+function getw(_para1:PFILE):longint;cdecl;external libc_nlm name 'getw';
+function pclose(stream:PFILE):longint;cdecl;external libc_nlm name 'pclose';
+function popen(command:Pchar; mode:Pchar):PFILE;cdecl;external libc_nlm name 'popen';
+function putc_unlocked(c:longint; _para2:PFILE):longint;cdecl;external libc_nlm name 'putc_unlocked';
+function putchar_unlocked(c:longint):longint;cdecl;external libc_nlm name 'putchar_unlocked';
+function tempnam(dirpath:Pchar; prefix:Pchar):Pchar;cdecl;external libc_nlm name 'tempnam';
+{ nonstandard (transitional) addtions for 64-bit file I/O... }
+function fgetpos64(_para1:PFILE; _para2:Pfpos64_t):longint;cdecl;external libc_nlm name 'fgetpos64';
+function fseek64(fp:PFILE; offset:fpos64_t; whence:longint):longint;cdecl;external libc_nlm name 'fseek64';
+function fsetpos64(_para1:PFILE; _para2:Pfpos64_t):longint;cdecl;external libc_nlm name 'fsetpos64';
+function ftell64(_para1:PFILE):off64_t;cdecl;external libc_nlm name 'ftell64';
+{ hard-wired console I/O support (cannot be redirected)... }
+function cgetc:longint;cdecl;external libc_nlm name 'cgetc';
+function cgets(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'cgets';
+
+{$ifndef DisableArrayOfConst}
+function cprintf(_para1:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'cprintf';
+{$endif}
+function cprintf(_para1:Pchar):longint;cdecl;external libc_nlm name 'cprintf';
+function cputc(_para1:longint):longint;cdecl;external libc_nlm name 'cputc';
+function cputs(_para1:Pchar):longint;cdecl;external libc_nlm name 'cputs';
+{$ifndef DisableArrayOfConst}
+function cscanf(__restrict:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'cscanf';
+{$endif}
+function cscanf(__restrict:Pchar):longint;cdecl;external libc_nlm name 'cscanf';
+function vcprintf(__restrict:Pchar; _para2:va_list):longint;cdecl;external libc_nlm name 'vcprintf';
+function vcscanf(__restrict:Pchar; _para2:va_list):longint;cdecl;external libc_nlm name 'vcscanf';
+function vasprintf(__restrict:PPchar; __restrict1:Pchar; _para3:va_list):longint;cdecl;external libc_nlm name 'vasprintf';
+{ defined as macros in both C and C++... }
+{ UNIX 98/POSIX.1-2002 defined additions }
+
+
+// stdlib.h
+{ pshpack1.h }
+{ turn on 1-byte packing... }
+
+ const
+ EXIT_FAILURE = -(1);
+ EXIT_SUCCESS = 0;
+ RAND_MAX = 32767;
+
+
+type
+ Pdiv_t = ^div_t;
+ div_t = record
+ quot : longint;
+ rem : longint;
+ end;
+
+ Pldiv_t = ^ldiv_t;
+ ldiv_t = record
+ quot : longint;
+ rem : longint;
+ end;
+
+ Plldiv_t = ^lldiv_t;
+ lldiv_t = record
+ quot : Tint64;
+ rem : Tint64;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+type TCDeclProcedure = procedure; cdecl;
+
+procedure abort;cdecl;external libc_nlm name 'abort';
+// function {$ifdef INCLUDED_FROM_SYSTEM}libc_abs{$else}abs{$endif}(_para1:longint):longint;cdecl;external libc_nlm name 'abs';
+function atexit(_para1:TCDeclProcedure ):longint;cdecl;external libc_nlm name 'atexit';
+function atof(_para1:Pchar):double;cdecl;external libc_nlm name 'atof';
+function atoi(_para1:Pchar):longint;cdecl;external libc_nlm name 'atoi';
+function atol(_para1:Pchar):longint;cdecl;external libc_nlm name 'atol';
+function atoll(_para1:Pchar):Tint64;cdecl;external libc_nlm name 'atoll';
+
+//!! function bsearch(_para1:pointer; _para2:pointer; _para3:size_t; _para4:size_t; _para5:function (_para1:pointer; _para2:pointer):longint):pointer;cdecl;external libc_nlm name 'bsearch';
+function calloc(_para1:size_t; _para2:size_t):pointer;cdecl;external libc_nlm name 'calloc';
+function __CW_div(_para1:longint; _para2:longint):div_t;cdecl;external libc_nlm name '__CW_div';
+procedure libc_exit(status:longint);cdecl;external libc_nlm name 'exit';
+procedure free(_para1:pointer);cdecl;external libc_nlm name 'free';
+function getenv(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'getenv';
+function labs(_para1:longint):longint;cdecl;external libc_nlm name 'labs';
+function __CW_ldiv(_para1:longint; _para2:longint):ldiv_t;cdecl;external libc_nlm name '__CW_ldiv';
+function llabs(_para1:Tint64):Tint64;cdecl;external libc_nlm name 'llabs';
+function __CW_lldiv(_para1:Tint64; _para2:Tint64):lldiv_t;cdecl;external libc_nlm name '__CW_lldiv';
+function malloc(_para1:size_t):pointer;cdecl;external libc_nlm name 'malloc';
+function mblen(_para1:Pchar; _para2:size_t):longint;cdecl;external libc_nlm name 'mblen';
+function mbstowcs(_para1:Pwchar_t; _para2:Pchar; _para3:size_t):size_t;cdecl;external libc_nlm name 'mbstowcs';
+function mbtowc(_para1:Pwchar_t; _para2:Pchar; _para3:size_t):longint;cdecl;external libc_nlm name 'mbtowc';
+
+type TQSortFunc = function (_para1:pointer; _para2:pointer):longint; cdecl;
+procedure qsort(_para1:pointer; _para2:size_t; _para3:size_t; _para4:TQSortFunc);cdecl;external libc_nlm name 'qsort';
+function rand:longint;cdecl;external libc_nlm name 'rand';
+function realloc(_para1:pointer; _para2:size_t):pointer;cdecl;external libc_nlm name 'realloc';
+procedure srand(_para1:dword);cdecl;external libc_nlm name 'srand';
+function strtod(__restrict:Pchar; __restrict1:PPchar):double;cdecl;external libc_nlm name 'strtod';
+function strtol(__restrict:Pchar; __restrict1:PPchar; _para3:longint):longint;cdecl;external libc_nlm name 'strtol';
+function strtoll(__restrict:Pchar; __restrict1:PPchar; _para3:longint):Tint64;cdecl;external libc_nlm name 'strtoll';
+function strtoul(__restrict:Pchar; __restrict1:PPchar; _para3:longint):dword;cdecl;external libc_nlm name 'strtoul';
+function strtoull(__restrict:Pchar; __restrict1:PPchar; _para3:longint):Tuint64;cdecl;external libc_nlm name 'strtoull';
+function system(_para1:Pchar):longint;cdecl;external libc_nlm name 'system';
+function wcstombs(__restrict:Pchar; __restrict1:Pwchar_t; _para3:size_t):size_t;cdecl;external libc_nlm name 'wcstombs';
+function wctomb(_para1:Pchar; _para2:wchar_t):longint;cdecl;external libc_nlm name 'wctomb';
+function alloca(_para1:size_t):pointer;cdecl;external libc_nlm name 'alloca';
+function clearenv:longint;cdecl;external libc_nlm name 'clearenv';
+function getcmd(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'getcmd';
+function flushenv(_para1:Pchar; _para2:longint):longint;cdecl;external libc_nlm name 'flushenv';
+function getbsize(_para1:Plongint; _para2:Plongint):Pchar;cdecl;external libc_nlm name 'getbsize';
+function htol(_para1:Pchar):dword;cdecl;external libc_nlm name 'htol';
+function itoa(_para1:longint; _para2:Pchar; _para3:longint):Pchar;cdecl;external libc_nlm name 'itoa';
+function itoab(_para1:dword; _para2:Pchar):Pchar;cdecl;external libc_nlm name 'itoab';
+function ltoa(_para1:longint; _para2:Pchar; _para3:longint):Pchar;cdecl;external libc_nlm name 'ltoa';
+function lltoa(_para1:Tint64; _para2:Pchar; _para3:longint):Pchar;cdecl;external libc_nlm name 'lltoa';
+function _lrotr(_para1:dword; _para2:dword):dword;cdecl;external libc_nlm name '_lrotr';
+function _lrotl(_para1:dword; _para2:dword):dword;cdecl;external libc_nlm name '_lrotl';
+function mkdtemp(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'mkdtemp';
+function mkstemp(_para1:Pchar):longint;cdecl;external libc_nlm name 'mkstemp';
+function mktemp(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'mktemp';
+function msize(_para1:pointer):size_t;cdecl;external libc_nlm name 'msize';
+function multibyte:longint;cdecl;external libc_nlm name 'multibyte';
+function mvalidrange(_para1:pointer; _para2:size_t):longint;cdecl;external libc_nlm name 'mvalidrange';
+function nextmb(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'nextmb';
+function prevmb(_para1:Pchar):Pchar;cdecl;external libc_nlm name 'prevmb';
+function putenv(_para1:Pchar):longint;cdecl;external libc_nlm name 'putenv';
+function rand_r(_para1:Pdword):longint;cdecl;external libc_nlm name 'rand_r';
+function _rotr(_para1:dword; _para2:dword):dword;cdecl;external libc_nlm name '_rotr';
+function _rotl(_para1:dword; _para2:dword):dword;cdecl;external libc_nlm name '_rotl';
+function rotl8(_para1:byte; _para2:longint):byte;cdecl;external libc_nlm name 'rotl8';
+function rotl16(_para1:word; _para2:longint):word;cdecl;external libc_nlm name 'rotl16';
+function rotl32(_para1:dword; _para2:longint):dword;cdecl;external libc_nlm name 'rotl32';
+function rotl64(_para1:Tuint64; _para2:longint):Tuint64;cdecl;external libc_nlm name 'rotl64';
+function rotr8(_para1:byte; _para2:longint):byte;cdecl;external libc_nlm name 'rotr8';
+function rotr16(_para1:word; _para2:longint):word;cdecl;external libc_nlm name 'rotr16';
+function rotr32(_para1:dword; _para2:longint):dword;cdecl;external libc_nlm name 'rotr32';
+function rotr64(_para1:Tuint64; _para2:longint):Tuint64;cdecl;external libc_nlm name 'rotr64';
+function setenv(_para1:Pchar; _para2:Pchar; _para3:longint):longint;cdecl;external libc_nlm name 'setenv';
+procedure setkey(_para1:Pchar);cdecl;external libc_nlm name 'setkey';
+function stackavail:size_t;cdecl;external libc_nlm name 'stackavail';
+function stackbase:pointer;cdecl;external libc_nlm name 'stackbase';
+function stackwatermark:size_t;cdecl;external libc_nlm name 'stackwatermark';
+function strtoi(_para1:Pchar; _para2:longint):longint;cdecl;external libc_nlm name 'strtoi';
+function truncmb(_para1:Pchar; _para2:size_t):Pchar;cdecl;external libc_nlm name 'truncmb';
+function ultoa(_para1:dword; _para2:Pchar; _para3:longint):Pchar;cdecl;external libc_nlm name 'ultoa';
+function ulltoa(_para1:Tuint64; _para2:Pchar; _para3:longint):Pchar;cdecl;external libc_nlm name 'ulltoa';
+function unsetenv(name:Pchar):longint;cdecl;external libc_nlm name 'unsetenv';
+function utoa(_para1:dword; _para2:Pchar; _para3:longint):Pchar;cdecl;external libc_nlm name 'utoa';
+function valuemb(_para1:Pchar):longint;cdecl;external libc_nlm name 'valuemb';
+{ atomic functions... }
+procedure atomic_add(addr:Pdword; value:dword);cdecl;external libc_nlm name 'atomic_add';
+function atomic_bts(addr:Pdword; offset:dword):dword;cdecl;external libc_nlm name 'atomic_bts';
+function atomic_btr(addr:Pdword; offset:dword):dword;cdecl;external libc_nlm name 'atomic_btr';
+procedure atomic_dec(addr:Pdword);cdecl;external libc_nlm name 'atomic_dec';
+procedure atomic_inc(addr:Pdword);cdecl;external libc_nlm name 'atomic_inc';
+procedure atomic_sub(addr:Pdword; value:dword);cdecl;external libc_nlm name 'atomic_sub';
+function atomic_xchg(addr:Pdword; value:dword):dword;cdecl;external libc_nlm name 'atomic_xchg';
+procedure atomic_or(addr:Pdword; value:dword);cdecl;external libc_nlm name 'atomic_or';
+procedure atomic_xor(addr:Pdword; value:dword);cdecl;external libc_nlm name 'atomic_xor';
+procedure atomic_and(addr:Pdword; value:dword);cdecl;external libc_nlm name 'atomic_and';
+function atomic_xchgadd(addr:Pdword; value:dword):dword;cdecl;external libc_nlm name 'atomic_xchgadd';
+function atomic_cmpxchg(addr:Pdword; cmpvalue:dword; newvalue:dword):dword;cdecl;external libc_nlm name 'atomic_cmpxchg';
+procedure atomic64_inc(addr:Puint64);cdecl;external libc_nlm name 'atomic64_inc';
+procedure atomic64_dec(addr:Puint64);cdecl;external libc_nlm name 'atomic64_dec';
+procedure atomic64_add(addr:Puint64; value:tuint64);cdecl;external libc_nlm name 'atomic64_add';
+procedure atomic64_sub(addr:Puint64; value:tuint64);cdecl;external libc_nlm name 'atomic64_sub';
+function atomic64_xchg(addr:Puint64; value:tuint64):Tuint64;cdecl;external libc_nlm name 'atomic64_xchg';
+function atomic64_xchgadd(addr:Puint64; value:Tuint64):Tuint64;cdecl;external libc_nlm name 'atomic64_xchgadd';
+function atomic64_cmpxchg(addr:Puint64; cmpvalue:Tuint64; newvalue:Tuint64):Tuint64;cdecl;external libc_nlm name 'atomic64_cmpxchg';
+{ compiler-specific implementations of alloca()... }
+function max(a:longint; b:longint):longint;cdecl;external libc_nlm name 'max';
+function min(a:longint; b:longint):longint;cdecl;external libc_nlm name 'min';
+
+
+// stropts.h
+// sys/ioctl.h
+// unistd.h
+// sys/types.h
+
+type
+ Puchar_t = ^uchar_t;
+ uchar_t = byte;
+
+ Pushort_t = ^ushort_t;
+ ushort_t = word;
+
+ Puint_t = ^uint_t;
+ uint_t = dword;
+
+ Pulong_t = ^ulong_t;
+ ulong_t = dword;
+
+ Pu_char = ^u_char;
+ u_char = byte;
+
+ Pu_short = ^u_short;
+ u_short = word;
+
+ Pu_int = ^u_int;
+ u_int = dword;
+
+ Pu_long = ^u_long;
+ u_long = dword;
+
+ Pcaddr_t = ^caddr_t;
+ caddr_t = char;
+
+ Puseconds_t = ^useconds_t;
+ useconds_t = Tuint64;
+
+ Psuseconds_t = ^suseconds_t;
+ suseconds_t = Tint64;
+
+ Pu_int8_t = ^u_int8_t;
+ u_int8_t = byte;
+
+ Pu_int16_t = ^u_int16_t;
+ u_int16_t = word;
+
+ Pu_int32_t = ^u_int32_t;
+ u_int32_t = dword;
+
+ Pu_int64_t = ^u_int64_t;
+ u_int64_t = Tuint64;
+
+function getpid:pid_t;cdecl;external libc_nlm name 'getpid';
+function getppid:pid_t;cdecl;external libc_nlm name 'getppid';
+function getuid:uid_t;cdecl;external libc_nlm name 'getuid';
+function geteuid:uid_t;cdecl;external libc_nlm name 'geteuid';
+function getgid:gid_t;cdecl;external libc_nlm name 'getgid';
+function getegid:gid_t;cdecl;external libc_nlm name 'getegid';
+function setuid(uid:uid_t):longint;cdecl;external libc_nlm name 'setuid';
+function setgid(gid:gid_t):longint;cdecl;external libc_nlm name 'setgid';
+function getpgrp:pid_t;cdecl;external libc_nlm name 'getpgrp';
+function setsid:pid_t;cdecl;external libc_nlm name 'setsid';
+function setpgid(pid:pid_t; pgid:pid_t):longint;cdecl;external libc_nlm name 'setpgid';
+
+function FpGetpid:pid_t;cdecl;external libc_nlm name 'getpid';
+function FpGetppid:pid_t;cdecl;external libc_nlm name 'getppid';
+function FpGetuid:uid_t;cdecl;external libc_nlm name 'getuid';
+function FpGeteuid:uid_t;cdecl;external libc_nlm name 'geteuid';
+function FpGetgid:gid_t;cdecl;external libc_nlm name 'getgid';
+function FpGetegid:gid_t;cdecl;external libc_nlm name 'getegid';
+function FpSetuid(uid:uid_t):longint;cdecl;external libc_nlm name 'setuid';
+function FpSetgid(gid:gid_t):longint;cdecl;external libc_nlm name 'setgid';
+function FpSetpgrp:pid_t;cdecl;external libc_nlm name 'getpgrp';
+function FpSetsid:pid_t;cdecl;external libc_nlm name 'setsid';
+function FpSetpgid(pid:pid_t; pgid:pid_t):longint;cdecl;external libc_nlm name 'setpgid';
+
+
+// sys/unistd.h
+
+type
+ TFilDes = Array [0..1] of cInt;
+ pFilDes = ^TFilDes;
+
+ const
+ R_OK = 1;
+ { test for write permission }
+ W_OK = 2;
+ { test for execute permission }
+ X_OK = 4;
+ { test for existence of file }
+ F_OK = 8;
+ { values for 'whence' in lseek()... }
+ { set file pointer to 'offset' }
+ // SEEK_SET = 0;
+ { set file pointer to current plus 'offset' }
+ // SEEK_CUR = 1;
+ { set file pointer to EOF plus 'offset' }
+ // SEEK_END = 2;
+ { old Berkeley names... }
+ L_SET = SEEK_SET;
+ L_INCR = SEEK_CUR;
+ L_XTND = SEEK_END;
+ { test using effective ids }
+ EFF_ONLY_OK = 8;
+ { descriptor underlying 'stdin' }
+ STDIN_FILENO = 0;
+ { ibid for 'stdout' }
+ STDOUT_FILENO = 1;
+ { ibid for 'stderr' }
+ STDERR_FILENO = 2;
+ _POSIX_THREAD_SAFE_FUNCTIONS = 1;
+ _POSIX_THREAD_ATTR_STACKADDR = 1;
+ _POSIX_THREAD_ATTR_STACKSIZE = 1;
+ _POSIX_MAPPED_FILES = 1;
+ _POSIX_MEMLOCK = 1;
+ _POSIX_MEMLOCK_RANGE = 1;
+ _POSIX_MEMORY_PROTECTION = 1;
+ _POSIX_SYNCHRONIZED_IO = 1;
+ _POSIX_FSYNC = 1;
+ _POSIX_ASYNC_IO = -(1);
+ _POSIX_CHOWN_RESTRICTED = -(1);
+ _POSIX_NO_TRUNC = -(1);
+ _POSIX_PRIO_IO = -(1);
+ _POSIX_SYNC_IO = 1;
+ _POSIX_VDISABLE = 0;
+
+
+function access(path:Pchar; mode:longint):longint;cdecl;external libc_nlm name 'access';
+function FpAccess(path:Pchar; mode:longint):longint;cdecl;external libc_nlm name 'access';
+function alarm(seconds:dword):dword;cdecl;external libc_nlm name 'alarm';
+function FpChdir(path:Pchar):longint;cdecl;external libc_nlm name 'chdir';
+function {$ifdef INCLUDED_FROM_SYSTEM}libc_chsize{$else}chsize{$endif}(fildes:longint; size:size_t):longint;cdecl;external libc_nlm name 'chsize';
+function FpChsize(fildes:longint; size:size_t):longint;cdecl;external libc_nlm name 'chsize';
+function FpClose(fildes:longint):longint;cdecl;external libc_nlm name 'close';
+function crypt(key:Pchar; salt:Pchar):Pchar;cdecl;external libc_nlm name 'crypt';
+function dup(fildes:longint):longint;cdecl;external libc_nlm name 'dup';
+function Fpdup(fildes:longint):longint;cdecl;external libc_nlm name 'dup';
+function dup2(fildes1:longint; fildes2:longint):longint;cdecl;external libc_nlm name 'dup2';
+function Fpdup2(fildes1:longint; fildes2:longint):longint;cdecl;external libc_nlm name 'dup2';
+type TArr064char = array [0..63] of char;
+procedure encrypt(block:TArr064char; edflag:longint);cdecl;external libc_nlm name 'encrypt';
+procedure _exit(status:longint);cdecl;external libc_nlm name '_exit';
+procedure FpExit(status:longint);cdecl;external libc_nlm name '_exit';
+function fchdir(fildes:longint):longint;cdecl;external libc_nlm name 'fchdir';
+function fdatasync(fildes:longint):longint;cdecl;external libc_nlm name 'fdatasync';
+function fork:pid_t;cdecl;external libc_nlm name 'fork';
+function fsync(fildes:longint):longint;cdecl;external libc_nlm name 'fsync';
+function fpathconf(fildes:longint; name:longint):longint;cdecl;external libc_nlm name 'fpathconf';
+function ftruncate(fildes:longint; len:off_t):longint;cdecl;external libc_nlm name 'ftruncate';
+function getcwd(path:Pchar; len:size_t):Pchar;cdecl;external libc_nlm name 'getcwd';
+function gethostid:longint;cdecl;external libc_nlm name 'gethostid';
+(* Const before declarator ignored *)
+
+function getopt(argc:longint; argv:array of Pchar; optstr:Pchar):longint;cdecl;external libc_nlm name 'getopt';
+{$ifndef DisableArrayOfConst}
+function Fpioctl(_para1:longint; _para2:longint; args:array of const):longint;cdecl;external libc_nlm name 'ioctl';
+{$endif}
+function Fpioctl(_para1:longint; _para2:longint):longint;cdecl;external libc_nlm name 'ioctl';
+function Fpisatty(fildes:longint):longint;cdecl;external libc_nlm name 'isatty';
+//function lseek(fildes:longint; offset:off_t; whence:longint):off_t;cdecl;external libc_nlm name 'lseek';
+function fplseek(fildes:longint; offset:off_t; whence:longint):off_t;cdecl;external libc_nlm name 'lseek';
+
+function pathconf(path:Pchar; name:longint):longint;cdecl;external libc_nlm name 'pathconf';
+//!!function pipe(fildes:array[0..1] of longint):longint;cdecl;external libc_nlm name 'pipe';
+function FpPipe(var fildes:TFilDes):cInt;cdecl;external libc_nlm name 'pipe';
+function pread(fildes:longint; buf:pointer; nbytes:size_t; off:off_t):ssize_t;cdecl;external libc_nlm name 'pread';
+function pwrite(fildes:longint; buf:pointer; nbytes:size_t; off:off_t):ssize_t;cdecl;external libc_nlm name 'pwrite';
+function FpRead(fildes:longint; buf:pointer; nbytes:size_t):ssize_t;cdecl;external libc_nlm name 'read';
+function FpRead(fildes:longint; var buf; nbytes:size_t):ssize_t;cdecl;external libc_nlm name 'read';
+function Fprmdir(path:Pchar):longint;cdecl;external libc_nlm name 'rmdir';
+procedure sync;cdecl;external libc_nlm name 'sync';
+function sysconf(name:longint):longint;cdecl;external libc_nlm name 'sysconf';
+function unlink(path:Pchar):longint;cdecl;external libc_nlm name 'unlink';
+function FpUnlink(path:Pchar):longint;cdecl;external libc_nlm name 'unlink';
+function FpWrite(fildes:longint; buf:pointer; nbytes:size_t):ssize_t;cdecl;external libc_nlm name 'write';
+function FpWrite(fildes:longint; var buf; nbytes:size_t):ssize_t;cdecl;external libc_nlm name 'write';
+{ appeared in BSD... }
+function brk(endds:pointer):longint;cdecl;external libc_nlm name 'brk';
+function getdtablehi:longint;cdecl;external libc_nlm name 'getdtablehi';
+function getdtablesize:longint;cdecl;external libc_nlm name 'getdtablesize';
+function getpagesize:longint;cdecl;external libc_nlm name 'getpagesize';
+
+function readlink(path:Pchar; buf:Pchar; bufsize:size_t):longint;cdecl;external libc_nlm name 'readlink';
+function FpReadlink(path:Pchar; buf:Pchar; bufsize:size_t):longint;cdecl;external libc_nlm name 'readlink';
+function sbrk(incr:intptr_t):pointer;cdecl;external libc_nlm name 'sbrk';
+{ nonstandard additions (see also fsio.h)... }
+function cancel(t_id:longint):longint;cdecl;external libc_nlm name 'cancel';
+function confstr(name:longint; buf:Pchar; len:size_t):size_t;cdecl;external libc_nlm name 'confstr';
+function delay(milliseconds:dword):longint;cdecl;external libc_nlm name 'delay';
+function _delay(milliseconds:dword):longint;cdecl;external libc_nlm name 'delay';
+function sethostid(hostid:longint):longint;cdecl;external libc_nlm name 'sethostid';
+function setmode(fildes:longint; oflag:longint):longint;cdecl;external libc_nlm name 'setmode';
+function sleep(seconds:dword):dword;cdecl;external libc_nlm name 'sleep';
+function FpSleep(seconds:dword):dword;cdecl;external libc_nlm name 'sleep';
+function usleep(useconds:useconds_t):longint;cdecl;external libc_nlm name 'usleep';
+{ nonstandard (transitional) addtions for 64-bit file I/O... }
+function chsize64(fildes:longint; size:size64_t):longint;cdecl;external libc_nlm name 'chsize64';
+function Fpchsize64(fildes:longint; size:size64_t):longint;cdecl;external libc_nlm name 'chsize64';
+function ftruncate64(fildes:longint; len:off64_t):longint;cdecl;external libc_nlm name 'ftruncate64';
+function Fpftruncate64(fildes:longint; len:off64_t):longint;cdecl;external libc_nlm name 'ftruncate64';
+function lseek64(fildes:longint; offset:off64_t; whence:longint):off64_t;cdecl;external libc_nlm name 'lseek64';
+function Fplseek64(fildes:longint; offset:off64_t; whence:longint):off64_t;cdecl;external libc_nlm name 'lseek64';
+function pread64(fildes:longint; buf:pointer; nbytes:size_t; off:off64_t):ssize_t;cdecl;external libc_nlm name 'pread64';
+function pwrite64(fildes:longint; buf:pointer; nbytes:size_t; off:off64_t):ssize_t;cdecl;external libc_nlm name 'pwrite64';
+function tell64(fildes:longint):off64_t;cdecl;external libc_nlm name 'tell64';
+function Fptell64(fildes:longint):off64_t;cdecl;external libc_nlm name 'tell64';
+function ____environ:PPPchar;cdecl;external libc_nlm name '____environ';
+function ___optarg:PPchar;cdecl;external libc_nlm name '___optarg';
+function ___optind:Plongint;cdecl;external libc_nlm name '___optind';
+function ___opterr:Plongint;cdecl;external libc_nlm name '___opterr';
+function ___optopt:Plongint;cdecl;external libc_nlm name '___optopt';
+function ___optreset:Plongint;cdecl;external libc_nlm name '___optreset';
+function want_posix_semantics(timestamp:longint):longint;cdecl;external libc_nlm name 'want_posix_semantics';
+{
+** Prototype for libraries writing their own start-up and shut-down code. This
+** is not an interface, but only a prototype for code furnished by the UNIX-
+** style NLM library. The presence of these is noted by the prelude object.
+ }
+function _init:longint;cdecl;external libc_nlm name '_init';
+function _fini:longint;cdecl;external libc_nlm name '_fini';
+{ globals for getopt() implementation... }
+{ the prototype for ioctl() is in unistd.h... }
+
+
+// sys/byteorder.h
+function htonl(_para1:dword):dword;cdecl;external libc_nlm name 'htonl';
+function htons(_para1:word):word;cdecl;external libc_nlm name 'htons';
+function ntohl(_para1:dword):dword;cdecl;external libc_nlm name 'ntohl';
+function ntohs(_para1:word):word;cdecl;external libc_nlm name 'ntohs';
+
+
+// sys/cdefs.h
+// sys/dir.h
+// dirent.h
+// sys/mode.h
+
+{ POSIX file types... }
+{ POSIX file modes: owner (user) permission... }
+{ POSIX file modes: group permission... }
+{ POSIX file modes: other permission... }
+{ POSIX setuid(), setgid(), and sticky... }
+{ for use with stat(), readdir(), chmod(), mkdir(), etc. }
+{ NetWare-specific additions to the upper half of mode_t... }
+{ values for field 'd_type'... }
+
+{ pshpack1.h }
+{ turn on 1-byte packing... }
+
+ const
+ S_IFMT = $F000;
+ { first-in/first-out (FIFO/pipe) }
+ S_IFIFO = $1000;
+ { character-special file (tty/console) }
+ S_IFCHR = $2000;
+ { directory }
+ S_IFDIR = $4000;
+ { blocking device (unused) }
+ S_IFBLK = $6000;
+ { regular }
+ S_IFREG = $8000;
+ { symbolic link (unused) }
+ S_IFLNK = $A000;
+ { Berkeley socket }
+ S_IFSOCK = $C000;
+ S_IRWXU = $01C0;
+ S_IRUSR = $0100;
+ S_IWUSR = $0080;
+ S_IXUSR = $0040;
+ S_IREAD = S_IRUSR;
+ S_IWRITE = S_IWUSR;
+ S_IEXEC = S_IXUSR;
+ { POSIX file modes: group permission... }
+ S_IRWXG = $0038;
+ S_IRGRP = $0020;
+ S_IWGRP = $0010;
+ S_IXGRP = $0008;
+ { POSIX file modes: other permission... }
+ S_IRWXO = $0007;
+ S_IROTH = $0004;
+ S_IWOTH = $0002;
+ S_IXOTH = $0001;
+ { POSIX setuid(), setgid(), and sticky... }
+ S_ISUID = $0800;
+ S_ISGID = $0400;
+ S_ISVTX = $0200;
+ { for use with stat(), readdir(), chmod(), mkdir(), etc. }
+ { NetWare-specific additions to the upper half of mode_t... }
+ M_A_RDONLY = $00010000; // read-only entry
+ M_A_HIDDEN = $00020000; // hidden entry
+ M_A_SYSTEM = $00040000; // system entry
+ M_A_SUBDIR = $00080000; // is Subdir
+ M_A_ARCH = $00100000; // file has been archived
+ M_A_SHARE = $00200000; // file is shared
+ M_A_TRANS = $00400000; // file transactions are tracked
+ M_A_IMMPURG = $00800000; // purge deleted file immediately
+ M_A_NORENAM = $01000000; // inhibit renaming
+ M_A_NODELET = $02000000; // inhibit deletion
+ M_A_NOCOPY = $04000000; // inhibit copying
+ M_A_IMMCOMPRESS = $08000000; // compress immediately
+ M_A_FILE_COMPRESSED = $10000000; // file is compressed
+ M_A_DONT_COMPRESS = $20000000; // inhibit compression
+ M_A_CANT_COMPRESS = $40000000; // file cannot be compressed
+ M_A_BITS_SIGNIFICANT= $80000000; // these M_A_- bits are important
+
+ DT_UNKNOWN = 0;
+ DT_TTY = 1; { console (won't occur) }
+ DT_REG = S_IFREG; { normal file }
+ DT_DIR = S_IFDIR; { subdirectory }
+ DT_FIFO = S_IFIFO; { first-in/first-out (FIFO/pipe) }
+ DT_SOCK = S_IFSOCK; { socket (won't occur) }
+ DT_CHR = S_IFCHR; { character-special file (unused)}
+ DT_BLK = S_IFBLK; { blocking device (unused) }
+ DT_LNK = S_IFLNK; { symbolic or hard link (won't occur) }
+
+type
+ Pdirent = ^Tdirent;
+ Tdirent = record
+ d_userspec : dword;
+ d_flags : dword;
+ d_type : mode_t;
+ d_mode : mode_t;
+ d_ino : ino_t;
+ d_size : off64_t;
+ d_spare : array[0..54] of dword;
+ d_pad1 : byte;
+ d_pad2 : byte;
+ d_pad3 : byte;
+ d_namelen : byte;
+ d_name : array[0..(255 + 1)-1] of char;
+ end;
+ PPdirent = ^Pdirent;
+ //DIR = dirent;
+ //PDIR = ^DIR;
+ //TDir = Dir;
+{ sizeof(struct dirent) == 0x200 (512.) }
+
+(** unsupported pragma#pragma pack()*)
+
+
+function closedir(dirp:Pdirent):longint;cdecl;external libc_nlm name 'closedir';
+function opendir(pathName:Pchar):Pdirent;cdecl;external libc_nlm name 'opendir';
+function readdir(dirp:Pdirent):Pdirent;cdecl;external libc_nlm name 'readdir';
+function readdir_r(dirp:Pdirent; entry:Pdirent; result:PPdirent):longint;cdecl;external libc_nlm name 'readdir_r';
+procedure rewinddir(dirp:Pdirent);cdecl;external libc_nlm name 'rewinddir';
+
+function Fpclosedir(dirp:Pdirent):longint;cdecl;external libc_nlm name 'closedir';
+function Fpopendir(pathName:Pchar):Pdirent;cdecl;external libc_nlm name 'opendir';
+function Fpreaddir(dirp:Pdirent):Pdirent;cdecl;external libc_nlm name 'readdir';
+function Fpreaddir_r(dirp:Pdirent; entry:Pdirent; result:PPdirent):longint;cdecl;external libc_nlm name 'readdir_r';
+procedure Fprewinddir(dirp:Pdirent);cdecl;external libc_nlm name 'rewinddir';
+
+// sys/file.h
+// fcntl.h
+
+{ 'cmd' values for fcntl()... }
+const
+ F_GETFL = 1; // get file status flags
+ F_SETFL = 2; // set file status flags
+ F_DUPFD = 3; // duplicate file descriptor
+ F_GETFD = 4; // get file descriptor flags
+ F_SETFD = 5; // set file descriptor flags
+ F_SETLK = 6; // set record locking info
+ F_SETLK64 = 16; // set record locking info (64-bit)
+ F_GETLK = 7; // get record locking info
+ F_GETLK64 = 17; // get record locking info (64-bit)
+ F_SETLKW = 8; // get record locking info; wait if blocked
+ F_SETLKW64 = 18; // get record locking info (64-bit)
+ F_CLOEXEC = 9; // close on execute
+
+// values for 'l_type' field of 'struct flock'...
+ F_RDLCK = 1; // shared or read lock
+ F_WRLCK = 2; // exclusive or write lock
+ F_UNLCK = 3; // unlock
+
+// values for 'oflag' in open()...
+ O_RDONLY =$00000000; // open for read only
+ O_WRONLY =$00000001; // open for write only
+ O_RDWR =$00000002; // open for read and write
+ O_ACCMODE =$00000003; // access flags mask
+ O_reserved1 =$00000004; // reserved
+ O_reserved2 =$00000008; // reserved
+ O_APPEND =$00000010; // writes done at end of file
+ O_CREAT =$00000020; // create new file
+ O_TRUNC =$00000040; // truncate existing file
+ O_EXCL =$00000080; // exclusive open
+ O_NOCTTY =$00000100; // no controlling terminal--unsupported
+ O_BINARY =$00000200; // binary file--all files
+ O_NDELAY =$00000400; // nonblocking flag
+ O_reserved3 =$00000800; // reserved
+ O_SYNC =$00001000; // synchronized I/O file integrity
+ O_DSYNC =$00002000; // synchronized I/O data integrity
+ O_RSYNC =$00004000; // synchronized read I/O
+ O_NONBLOCK = O_NDELAY; // alias
+ FD_CLOEXEC =$00008000; // parent closes after call to process()
+ O_UPDATE =$00010000; // keep legacy files updated
+ O_FIFO =$00100000; // opening one end of a FIFO [non-standard]
+
+// value for third argument when 'cmd' is F_SETFL in fcntl()...
+ FNDELAY = O_NDELAY; // fcntl() non-blocking I/O
+
+// 'shflag' values for sopen()...
+ SH_DENYRW = $00000010; // deny read/write mode
+ SH_DENYWR = $00000020; // deny write mode
+ SH_DENYRD = $00000030; // deny read mode
+ SH_DENYNO = $00000040; // deny none mode
+
+type
+ Pflock = ^flock;
+ flock = record
+ l_pid : pid_t; { process ID of owner, get with F_GETLK }
+ l_tid : pid_t; { thread ID of owner, get with F_GETLK }
+ l_type : smallint; { F_RDLCK or F_WRLCK }
+ l_whence : smallint; { flag for starting offset }
+ ________spare : longint; { unused }
+ ________reserved1 : longint; { padding to resemble 64-bit structure }
+ l_start : off_t; { relative offset in bytes }
+ ________reserved2 : longint; { padding to resemble 64-bit structure }
+ l_len : off_t; { size; if 0, then until EOF }
+ end;
+
+ Pflock64 = ^flock64;
+ flock64 = record { with F_GETLK64, F_SETLK64, FSETLKW64 }
+ l_pid : pid_t; { process ID of owner, get with F_GETLK }
+ l_tid : pid_t; { thread ID of owner, get with F_GETLK }
+ l_type : smallint; { F_RDLCK or F_WRLCK }
+ l_whence : smallint; { flag for starting offset }
+ ________spare : longint; { unused }
+ l_start : off64_t; { relative offset in bytes }
+ l_len : off64_t; { size; if 0, then until EOF }
+ end;
+
+function creat(path:Pchar; mode:mode_t):longint;cdecl;external libc_nlm name 'creat';
+{$ifndef DisableArrayOfConst}
+function fcntl(fildes:longint; cmd:longint; args:array of const):longint;cdecl;external libc_nlm name 'fcntl';
+{$endif}
+function fcntl(fildes:longint; cmd:longint):longint;cdecl;external libc_nlm name 'fcntl';
+{$ifndef DisableArrayOfConst}
+function open(path:Pchar; oflag:longint; args:array of const):longint;cdecl;external libc_nlm name 'open';
+{$endif}
+function open(path:Pchar; oflag:longint):longint;cdecl;external libc_nlm name 'open';
+function open(path:Pchar; oflag,mode:longint):longint;cdecl;external libc_nlm name 'open';
+function FpOpen(path:Pchar; oflag:longint):longint;cdecl;external libc_nlm name 'open';
+function FpOpen(path:Pchar; oflag,mode:longint):longint;cdecl;external libc_nlm name 'open';
+
+function pipe_open(path:Pchar; oflag:longint):longint;cdecl;external libc_nlm name 'pipe_open';
+function pipe_open(path:Pchar; oflag,mode:longint):longint;cdecl;external libc_nlm name 'pipe_open';
+{$ifndef DisableArrayOfConst}
+function sopen(path:Pchar; oflag:longint; shflag:longint; args:array of const):longint;cdecl;external libc_nlm name 'sopen';
+{$endif}
+function sopen(path:Pchar; oflag:longint; shflag:longint):longint;cdecl;external libc_nlm name 'sopen';
+
+
+// sys/filio.h
+{ defines for ioctl()... }
+// sys/ipc.h
+
+{ mode bits... }
+{ keys... }
+{ control commands for semctl() and shmctl()... }
+type
+ Pkey_t = ^key_t;
+ key_t = longint;
+ Pipc_perm = ^ipc_perm;
+ ipc_perm = record
+ uid : uid_t; // owner
+ gid : gid_t; // owner
+ cuid : uid_t; // creator
+ cgid : gid_t; // creator
+ mode : mode_t; // read write permission
+ end;
+
+
+
+function ftok(path:Pchar; id:longint):key_t;cdecl;external libc_nlm name 'ftok';
+
+
+// sys/mman.h
+
+{ return value of mmap() in case of error... }
+{ 'flags' values for mlockall()... }
+{ 'protection' values for mmap()... }
+{ 'flags' values for mmap()... }
+{ 'flags' values for msync()... }
+{ 'advice' to madvice()... }
+{ effectual dummies that will never do anything... }
+
+function mlock(addr:pointer; len:size_t):longint;cdecl;external libc_nlm name 'mlock';
+function mlockall(flags:longint):longint;cdecl;external libc_nlm name 'mlockall';
+function munlock(addr:pointer; len:size_t):longint;cdecl;external libc_nlm name 'munlock';
+function munlockall:longint;cdecl;external libc_nlm name 'munlockall';
+function mprotect(addr:pointer; len:size_t; prot:longint):longint;cdecl;external libc_nlm name 'mprotect';
+function madvise(addr:pointer; len:size_t; advice:longint):longint;cdecl;external libc_nlm name 'madvise';
+
+
+
+// sys/param.h
+// sys/stat.h
+// time.h
+type
+
+ Pclock_t = ^clock_t;
+ clock_t = dword;
+ TClock = clock_t;
+
+ Ptime_t = ^time_t;
+ time_t = longint;
+ Ttime = time_t;
+
+{ turn on 1-byte packing... }
+
+type
+ Ptm = ^Ttm;
+ Ttm = record // ANSI/ISO 'broken-down' time
+ tm_sec : longint; // seconds after the minute [0..59]
+ tm_min : longint; // minutes after the hour [0..59]
+ tm_hour : longint; // hours since midnight [0..23]
+ tm_mday : longint; // days of the month [1..31]
+ tm_mon : longint; // months since January [0..11]
+ tm_year : longint; // years since 1900 [0..ì]
+ tm_wday : longint; // days since Sunday [0..6]
+ tm_yday : longint; // days since first of January [0..365]
+ tm_isdst: longint; // on summer time (-1 unknown, 0 no, !0 yes)
+ end;
+
+ Ptimespec = ^Ttimespec;
+ Ttimespec = record // time expressed in seconds and nanoseconds
+ tv_sec : time_t; // seconds
+ tv_nsec : longint; // nanoseconds
+ end;
+ timespec_t = Ttimespec;
+ Ptimespec_t = ^timespec_t;
+ timestrc_t = Ttimespec;
+ Ptimestrc_t = ^timestrc_t;
+
+ Pitimerspec = ^Titimerspec;
+ Titimerspec = record
+ it_interval : Ttimespec; // timer period
+ it_value : Ttimespec; // expiration
+ end;
+ itimerspec_t = Titimerspec;
+ Pitimerspec_t = ^itimerspec_t;
+{ DOS 'broken-down' time }
+{ two-second increments only }
+{ 0-59 }
+{ 0-23 }
+{ 1-31 }
+{ 1-12 }
+{ years since 1980 (limit: 0-119) }
+ Pdos_tm = ^Tdos_tm;
+ Tdos_tm = record
+ flag0 : longint;
+ end;
+
+
+const
+ bm_dos_tm_bisecond = $1F;
+ bp_dos_tm_bisecond = 0;
+ bm_dos_tm_minute = $7E0;
+ bp_dos_tm_minute = 5;
+ bm_dos_tm_hour = $F800;
+ bp_dos_tm_hour = 11;
+ bm_dos_tm_day = $1F0000;
+ bp_dos_tm_day = 16;
+ bm_dos_tm_month = $1E00000;
+ bp_dos_tm_month = 21;
+ bm_dos_tm_year = $FE000000;
+ bp_dos_tm_year = 25;
+
+{$ifndef INCLUDED_FROM_SYSTEM}
+function bisecond(var a : Tdos_tm) : word;
+procedure set_bisecond(var a : Tdos_tm; __bisecond : word);
+function minute(var a : Tdos_tm) : word;
+procedure set_minute(var a : Tdos_tm; __minute : word);
+function hour(var a : Tdos_tm) : word;
+procedure set_hour(var a : Tdos_tm; __hour : word);
+function day(var a : Tdos_tm) : word;
+procedure set_day(var a : Tdos_tm; __day : word);
+function month(var a : Tdos_tm) : word;
+procedure set_month(var a : Tdos_tm; __month : word);
+function year(var a : Tdos_tm) : word;
+procedure set_year(var a : Tdos_tm; __year : word);
+{$endif}
+
+
+type
+ Pdos_d = ^Tdos_d;
+ Tdos_d = packed record // DOS date separated from time
+ time : word; // time fields
+ date : word; // date fields
+ end;
+
+{ utility for passing DOS time }
+{ scalar for passing as argument }
+{ separated-out DOS time and date }
+{ broken-down DOS time and date }
+ Pdos_tm_u = ^Tdos_tm_u;
+ Tdos_tm_u = record
+ case longint of
+ 0 : ( long_dt : dword );
+ 1 : ( struct_dt : Tdos_d );
+ 2 : ( struct_tm : Tdos_tm );
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+
+function asctime(localtime:Ptm):Pchar;cdecl;external libc_nlm name 'asctime';
+function asctime(var localtime:Ttm):Pchar;cdecl;external libc_nlm name 'asctime';
+function clock:clock_t;cdecl;external libc_nlm name 'clock';
+function ctime(calendar:Ptime_t):Pchar;cdecl;external libc_nlm name 'ctime';
+function ctime(var calendar:Ttime):Pchar;cdecl;external libc_nlm name 'ctime';
+function difftime(t1, t2:Ttime):double;cdecl;external libc_nlm name 'difftime';
+function gmtime(calendar:Ptime_t):Ptm;cdecl;external libc_nlm name 'gmtime';
+function gmtime(var calendar:Ttime):Ptm;cdecl;external libc_nlm name 'gmtime';
+function localtime(calendar:Ptime_t):Ptm;cdecl;external libc_nlm name 'localtime';
+function localtime(var calendar:Ttime):Ptm;cdecl;external libc_nlm name 'localtime';
+function mktime(localtime:Ptm):time_t;cdecl;external libc_nlm name 'mktime';
+function mktime(var localtime:Ttm):time_t;cdecl;external libc_nlm name 'mktime';
+
+//size_t strftime ( char * __restrict s, size_t, const char * __restrict format,
+//size_t strftime ( char * __restrict s, size_t, const char * __restrict format,
+// const tm * __restrict localtime );
+
+function time(calendar:Ptime_t):time_t;cdecl;external libc_nlm name 'time';
+function time(var calendar:Ttime):time_t;cdecl;external libc_nlm name 'time';
+function ___clocks_per_sec:longint;cdecl;external libc_nlm name '___clocks_per_sec';
+{ POSIX data and helper functions... }
+function ___daylight:Plongint;cdecl;external libc_nlm name '___daylight';
+function ___daylightOnOff:Plongint;cdecl;external libc_nlm name '___daylightOnOff';
+function ___daylightOffset:Ptime_t;cdecl;external libc_nlm name '___daylightOffset';
+function ___timezone:Ptime_t;cdecl;external libc_nlm name '___timezone';
+function ___tzname:PPchar;cdecl;external libc_nlm name '___tzname';
+function __isleap(year:longint):longint;cdecl;external libc_nlm name '__isleap';
+procedure tzset;cdecl;external libc_nlm name 'tzset';
+{ POSIX-defined reentrant additions... }
+
+function asctime_r(localtime:Ptm; timestr:Pchar):Pchar;cdecl;external libc_nlm name 'asctime_r';
+function asctime_r(var localtime:Ttm; timestr:Pchar):Pchar;cdecl;external libc_nlm name 'asctime_r';
+function ctime_r(calendar:Ptime_t; timestr:Pchar):Pchar;cdecl;external libc_nlm name 'ctime_r';
+function ctime_r(var calendar:Ttime; timestr:Pchar):Pchar;cdecl;external libc_nlm name 'ctime_r';
+function gmtime_r(calendar:Ptime_t; localtime:Ptm):Ptm;cdecl;external libc_nlm name 'gmtime_r';
+function gmtime_r(var calendar:Ttime; localtime:Ptm):Ptm;cdecl;external libc_nlm name 'gmtime_r';
+function localtime_r(calendar:Ptime_t; localtime:Ptm):Ptm;cdecl;external libc_nlm name 'localtime_r';
+function localtime_r(var calendar:Ttime; var localtime:Ttm):Ptm;cdecl;external libc_nlm name 'localtime_r';
+{ Single UNIX Specification additions... }
+function nanosleep(rqtp, rmtp:Ptimespec):longint;cdecl;external libc_nlm name 'nanosleep';
+function nanosleep(var rqtp, rmtp:Ttimespec):longint;cdecl;external libc_nlm name 'nanosleep';
+{ Novell-defined additions... }
+function ltime(calendar:Ptime_t):time_t;cdecl;external libc_nlm name 'ltime';
+function ltime(var calendar:Ttime):time_t;cdecl;external libc_nlm name 'ltime';
+function mkgmtime(gmtime:Ptm):time_t;cdecl;external libc_nlm name 'mkgmtime';
+function mkgmtime(var gmtime:Ttm):time_t;cdecl;external libc_nlm name 'mkgmtime';
+function dos2calendar(dostime:Tdos_d):time_t;cdecl;external libc_nlm name 'dos2calendar';
+function calendar2dos(calendar:time_t):Tdos_d;cdecl;external libc_nlm name 'calendar2dos';
+
+
+// sys/time.h
+// sys/timeval.h
+// sys/times.h
+
+type
+ Ptms = ^Ttms;
+ Ttms = record { describes CPU time used by process, children }
+ tms_utime : clock_t; { user CPU time }
+ tms_stime : clock_t; { system CPU time (identical to 'tms_utime') }
+ tms_cutime : clock_t; { unimplemented }
+ tms_cstime : clock_t; { unimplemented }
+ end;
+
+ Ptimezone = ^Ttimezone;
+ TTimezone = record { returned by gettimeofday() }
+ tz_secondswest : time_t; { seconds west of UTC }
+ tz_minuteswest : longint; { minutes west of UTC (GMT) }
+ tz_dsttime : longint; { nonzero if DST is ever in effect }
+ end;
+ Timezone = TTimezone;
+
+{
+** Normally this functions fills struct tms with several time values. Most of
+** the time it is very important to have only the return value, that is the
+** realtime that has been elapsed.
+ }
+
+function times(__buffer:Ptms):clock_t;cdecl;external libc_nlm name 'times';
+function times(var __buffer:Ttms):clock_t;cdecl;external libc_nlm name 'times';
+{ turn on 1-byte packing... }
+
+{ this structure is returned by gettimeofday() and used in select()... }
+type
+ Ptimeval = ^Ttimeval;
+ Ttimeval = record
+ tv_sec : longint;
+ tv_usec : longint;
+ end;
+ Timeval = TTimeval;
+
+(** unsupported pragma#pragma pack()*)
+{ operations on struct timeval; note timercmp() does not work for >= or <= }
+
+function gettimeofday(tp:Ptimeval; tpz:Ptimezone):longint;cdecl;external libc_nlm name 'gettimeofday';
+function Fpgettimeofday(tp:Ptimeval; tpz:Ptimezone):longint;cdecl;external libc_nlm name 'gettimeofday';
+function settimeofday(tp:Ptimeval; tpz:Ptimezone):longint;cdecl;external libc_nlm name 'settimeofday';
+function gettimeofday(var tp:Ttimeval; var tpz:Ttimezone):longint;cdecl;external libc_nlm name 'gettimeofday';
+function settimeofday(var tp:Ttimeval; var tpz:Ttimezone):longint;cdecl;external libc_nlm name 'settimeofday';
+function Fpgettimeofday(var tp:Ttimeval; var tpz:Ttimezone):longint;cdecl;external libc_nlm name 'gettimeofday';
+function Fpsettimeofday(var tp:Ttimeval; var tpz:Ttimezone):longint;cdecl;external libc_nlm name 'settimeofday';
+
+{ turn on 1-byte packing... }
+type
+ Pstat = ^Tstat;
+ Tstat = record
+ st_userspec: dword; // untouched by stat()
+ st_flags : dword; // flags for this entry
+ st_mode : mode_t; // emulated file mode
+ st_spare1 : dword;
+ st_gen : Tuint64; // generation number of inode
+ st_ino : ino_t; // directory entry number
+ st_dev : dev_t; // volume number
+ st_rdev : dev_t; // device type (always 0)
+ st_size : off64_t; // total file size
+ st_spare2 : Tuint64;
+ st_blocks : blkcnt_t; // count of blocks allocated to file
+ st_blksize : blksize_t; // block size for allocation--files only
+ st_nlink : nlink_t; // count of hard links (always 1)
+ st_spare3 : array[0..2] of dword;
+ st_uid : uid_t; // owner (object) identity
+ st_gid : gid_t; // group-id (always 0)
+ st_bid : uid_t; // identity of last archiver
+ st_mid : uid_t; // identity of last updator
+ st_atim : timespec_t; // last access date--files only
+ st_mtim : timespec_t; // last modify date and time
+ st_ctim : timespec_t; // last file attributes modification
+ st_btim : timespec_t; // last archived date and time
+ // NOT returned by stat() or fstat()...
+ st_rights : dword; // NetWare rights
+ st_spare4 : array[0..2] of dword;
+ st_name : array[0..(255 + 1)-1] of char; // object name as if from readdir()
+ st_spare5 : array[0..19] of dword;
+ end;
+
+{ sizeof(struct stat) == 0x200 (512.) }
+
+(** unsupported pragma#pragma pack()*)
+
+
+function Fpchmod(path:Pchar; mode:mode_t):longint;cdecl;external libc_nlm name 'chmod';
+function Fpfchmod(fildes:longint; mode:mode_t):longint;cdecl;external libc_nlm name 'fchmod';
+function Fpfstat(fildes:longint; buf:Pstat):longint;cdecl;external libc_nlm name 'fstat';
+function Fpfstat(fildes:longint; var buf:Tstat):longint;cdecl;external libc_nlm name 'fstat';
+function Fplstat(path:Pchar; buf:Pstat):longint;cdecl;external libc_nlm name 'lstat';
+function Fplstat(path:Pchar; var buf:Tstat):longint;cdecl;external libc_nlm name 'lstat';
+function Fpmkdir(pathname:Pchar; mode:mode_t):longint;cdecl;external libc_nlm name 'mkdir';
+function Fpmkfifo(pathname:Pchar; mode:mode_t):longint;cdecl;external libc_nlm name 'mkfifo';
+function Fpmknod(path:Pchar; mode:mode_t; dev:dev_t):longint;cdecl;external libc_nlm name 'mknod';
+function Fprealname(pathname:Pchar; name:Pchar):longint;cdecl;external libc_nlm name 'realname';
+function Fpstat(path:Pchar; buf:Pstat):longint;cdecl;external libc_nlm name 'stat';
+function Fpstat(path:Pchar; var buf:Tstat):longint;cdecl;external libc_nlm name 'stat';
+function Fpumask(cmask:mode_t):mode_t;cdecl;external libc_nlm name 'umask';
+{
+** The following value is not really correct, but it is a value that has been
+** used for a long time seems to be usable. Normally, NOFILE should not be used
+** anyway.
+ }
+{ bit map related macros... }
+{ macros for counting and rounding... }
+{ supplementary macros for min/max... }
+{ unit of sys/stat.h `st_blocks'... }
+
+
+// sys/select.h
+
+{
+** Including file may make this bigger or smaller as long as the FD_- macros
+** are faithfully used.
+ }
+type
+
+ Pfd_set = ^Tfd_set;
+ Tfd_set = record
+ fd_count : longint;
+ fd_array : array[0..63] of longint;
+ end;
+{ heterogeneous select calls (socket+pipe) unsupported on NetWare... }
+
+
+function Fppipe_select(nfds:longint; readfds, writefds, exceptfds:Pfd_set; timeout:Ptimeval):longint;cdecl;external libc_nlm name 'pipe_select';
+function Fppipe_select(nfds:longint; var readfds, writefds, exceptfds:Tfd_set; var timeout:Ttimeval):longint;cdecl;external libc_nlm name 'pipe_select';
+
+//function select(nfds:longint; readfds:Pfd_set; writefds:Pfd_set; exceptfds:Pfd_set; timeout:Ptimeval):longint;cdecl;external libc_nlm name 'select';
+//function select(nfds:longint; var readfds, writefds, exceptfds:Tfd_set; var timeout:Ttimeval):longint;cdecl;external libc_nlm name 'select';
+function FpSelect(nfds:longint; readfds:Pfd_set; writefds:Pfd_set; exceptfds:Pfd_set; timeout:Ptimeval):longint;cdecl;external libc_nlm name 'select';
+function FpSelect(nfds:longint; var readfds, writefds, exceptfds:Tfd_set; var timeout:Ttimeval):longint;cdecl;external libc_nlm name 'select';
+function ___fd_isset(fd:longint; _set:Pfd_set):longint;cdecl;external libc_nlm name '___fd_isset';
+function ___fd_isset(fd:longint; var _set:Tfd_set):longint;cdecl;external libc_nlm name '___fd_isset';
+
+
+// sys/sem.h
+
+{ semctl() command definitions... }
+{ semaphore text map address }
+{ pid of last operation }
+{ count awaiting (semval > cval) }
+{ count awaiting (semval == 0) }
+type
+ Psem = ^Tsem;
+ Tsem = record
+ semval : ushort_t;
+ semadj : ushort_t;
+ sempid : pid_t;
+ semncnt : ushort_t;
+ semzcnt : ushort_t;
+ semptr : pointer; // semaphore on which this is based
+ end;
+ TSemaphore = Tsem;
+ PSemaphore = Psem;
+
+ Psemid_ds = ^Tsemid_ds;
+ Tsemid_ds = record
+ sem_perm : ipc_perm;
+ sem_base : Psem; // pointer to first semaphore in set
+ sem_nsems : word; // number of semaphores in set
+ sem_otime : time_t; // last semop time
+ sem_ctime : time_t; // last change time
+ sem_ptr : pointer; // actual underlying semaphore
+ sem_realkey : longint; // 'real' semaphore key
+ end;
+
+ Psembuf = ^Tsembuf;
+ Tsembuf = record
+ sem_num : word; // Number
+ sem_op : smallint; // operation
+ sem_flg : smallint; // flags
+ end;
+
+ Psemun = ^Tsemun;
+ Tsemun = record
+ case longint of
+ 0 : ( val : longint );
+ 1 : ( buf : Psemid_ds );
+ 2 : ( _array : Pword );
+ end;
+
+{$ifndef DisableArrayOfConst}
+function semctl(semid:longint; semnum:longint; cmd:longint; args:array of const):longint;cdecl;external libc_nlm name 'semctl';
+{$endif}
+function semctl(semid:longint; semnum:longint; cmd:longint):longint;cdecl;external libc_nlm name 'semctl';
+function semget(key:key_t; nsems:longint; semflag:longint):longint;cdecl;external libc_nlm name 'semget';
+function semop(semid:longint; sops:Psembuf; nsops:size_t):longint;cdecl;external libc_nlm name 'semop';
+function semop(semid:longint; var sops:Tsembuf; nsops:size_t):longint;cdecl;external libc_nlm name 'semop';
+
+
+// sys/sendfile.h
+
+function sendfile(out_fd,in_fd:longint; offset:Poff_t; count:size_t):ssize_t;cdecl;external libc_nlm name 'sendfile';
+function sendfile64(out_fd,in_fd:longint; offset:Poff64_t; count:size_t):ssize_t;cdecl;external libc_nlm name 'sendfile64';
+
+
+// sys/shm.h
+
+type
+
+ Pshmatt_t = ^shmatt_t;
+ shmatt_t = dword;
+{ turn on 1-byte packing... }
+
+{ size of segment in bytes }
+{ process ID of last shared operation }
+{ process ID of creator }
+{ number of current attaches }
+{ time of last shmat() }
+{ time of last shmdt() }
+{ time of last change by shmctl() }
+{ operation permission structure }
+type
+ Pshmid_ds = ^shmid_ds;
+ shmid_ds = record
+ shm_segsz : size_t;
+ shm_lpid : pid_t;
+ shm_cpid : pid_t;
+ shm_nattch : shmatt_t;
+ shm_atime : time_t;
+ shm_dtime : time_t;
+ shm_ctime : time_t;
+ shm_spare1 : longint;
+ shm_perm : ipc_perm;
+ shm_spare2 : array[0..2] of longint;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+
+function shmat(shmid:longint; shmaddr:pointer; shmflag:longint):pointer;cdecl;external libc_nlm name 'shmat';
+function shmctl(shmid:longint; cmd:longint; buf:Pshmid_ds):longint;cdecl;external libc_nlm name 'shmctl';
+
+function shmdt(shmaddr:pointer):longint;cdecl;external libc_nlm name 'shmdt';
+function shmget(key:key_t; size:size_t; shmflag:longint):longint;cdecl;external libc_nlm name 'shmget';
+
+// signal.h
+
+ const
+ SIGABRT = 1;
+ SIGFPE = 2;
+ SIGILL = 3;
+ SIGINT = 4;
+ SIGSEGV = 5;
+ SIGTERM = 6;
+ SIGPOLL = 7;
+ { currently unimplemented POSIX-mandated signals }
+ SIGKILL = 11;
+ SIGSPARE = 12;
+ SIGALRM = 13;
+ SIGCHILD = 14;
+ SIGCHLD = SIGCHILD;
+ SIGCONT = 15;
+ SIGHUP = 16;
+ SIGPIPE = 17;
+ SIGQUIT = 18;
+ SIGSTOP = 19;
+ SIGTSTP = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGUSR1 = 23;
+ SIGUSR2 = 24;
+ SIGUSR3 = 25;
+ SIGUSR4 = 26;
+ SIGUSR5 = 27;
+ SIGUSR6 = 28;
+ SIGUSR7 = 29;
+ { Novell-defined signals }
+ SIG_FINI = 30;
+ SIG_LOCALECHANGE = 31;
+ NSIG = 32;
+ SIG_BLOCK = $00000000;
+ SIG_UNBLOCK = $00000001;
+ SIG_SETMASK = $FFFFFFFF;
+// SIGEMPTYSET = $0000000000000000;
+ SIGFULLSET = $FFFFFFFFFFFFFFFF;
+
+
+type
+ Psig_atomic_t = ^sig_atomic_t;
+ sig_atomic_t = longint;
+
+ Psigset_t = ^sigset_t;
+ sigset_t = Tuint64;
+{ flags for sa_flags in struct sigaction }
+ Psigaction = ^sigaction;
+ sigaction = record
+ sa_handler : procedure (_para1:longint);cdecl;
+ sa_mask : sigset_t;
+ sa_flags : longint;
+ end;
+
+type TCDeclProc1LIntPara = procedure (_para1:longint); cdecl;
+function Fpraise(_para1:longint):longint;cdecl;external libc_nlm name 'raise';
+function Fpsignal(sig:longint; func:TCDeclProc1LIntPara):TCDeclProc1LIntPara;cdecl;external libc_nlm name 'signal';
+function Fpsigwait(_set:Psigset_t; sig:Plongint):longint;cdecl;external libc_nlm name 'sigwait';
+{ signal vector functions... }
+
+//!! function sigaction(sig:longint; act:Psigaction; oact:Psigaction):longint;cdecl;external libc_nlm name 'sigaction';
+
+function Fpsigaddset(_para1:Psigset_t; _para2:longint):longint;cdecl;external libc_nlm name 'sigaddset';
+function Fpsigdelset(_para1:Psigset_t; _para2:longint):longint;cdecl;external libc_nlm name 'sigdelset';
+function Fpsigismember(_para1:Psigset_t; _para2:longint):longint;cdecl;external libc_nlm name 'sigismember';
+function Fpsigfillset(_para1:Psigset_t):longint;cdecl;external libc_nlm name 'sigfillset';
+function Fpsigemptyset(_para1:Psigset_t):longint;cdecl;external libc_nlm name 'sigemptyset';
+function Fpsigpending(_set:Psigset_t):longint;cdecl;external libc_nlm name 'sigpending';
+function Fpsigsuspend(mask:Psigset_t):longint;cdecl;external libc_nlm name 'sigsuspend';
+function Fpsigprocmask(how:longint; act:Psigset_t; oldact:Psigset_t):longint;cdecl;external libc_nlm name 'sigprocmask';
+function Fpkill(pid:pid_t; sig:longint):longint;cdecl;external libc_nlm name 'kill';
+
+
+// sys/socket.h
+// sys/uio.h
+{ turn on 1-byte packing... }
+
+type
+ Piovec = ^iovec;
+ iovec = record
+ iov_base : caddr_t;
+ iov_len : longint;
+ end;
+ iovec_t = iovec;
+ Piovec_t = ^iovec_t;
+
+(** unsupported pragma#pragma pack()*)
+
+
+function Fpreadv(fildes:longint; iov:Piovec; iovcnt:longint):ssize_t;cdecl;external libc_nlm name 'readv';
+function Fpwritev(fildes:longint; iov:Piovec; iovcnt:longint):ssize_t;cdecl;external libc_nlm name 'writev';
+{ socket types... }
+{ option flags per-socket... }
+{ additional options, not kept in so_options... }
+{ additional option to be used with level IPPROTO_TCP... }
+{ level number for get/setsockopt() to apply to socket itself... }
+{ address families }
+{ protocol families, same as address families for now... }
+{ values for shutdown() 'how'... }
+
+{
+** Note:
+**
+** The Novell NDK headers for NKS/LibC contain structures that are explicitly
+** hand-packed for best use on the platform in question (usually IA32). To
+** avoid the impredictability encountered when compiling with different
+** compilers, these headers rely on 1-byte packing.
+ }
+{ this header sets packing to 1 for different compilers }
+{ save off the previous packing directive in a compiler specific way... }
+{ turn on 1-byte packing... }
+
+{ structure used for manipulating linger option... }
+{ option on/off }
+{ linger time }
+type
+ Plinger = ^linger;
+ linger = record
+ l_onoff : longint;
+ l_linger : longint;
+ end;
+
+{ structure used to define addresses for bind(), connect(), etc... }
+
+ Psa_family_t = ^sa_family_t;
+ sa_family_t = word;
+{ address family }
+{ up to 14 bytes of direct address }
+ Psockaddr = ^sockaddr;
+ sockaddr = record
+ sa_family : sa_family_t;
+ sa_data : array[0..13] of char;
+ end;
+
+{ used by kernel to pass protocol info. }
+{ in raw sockets }
+{ address family }
+{ protocol }
+ Psockproto = ^sockproto;
+ sockproto = packed record
+ sp_family : word;
+ sp_protocol : word;
+ end;
+
+
+ Psocklen_t = ^socklen_t;
+ socklen_t = dword;
+{
+** SUS' and BSD 4.4 message passing. struct msghdr has an additional field
+** (msg_flags) and slightly different fieldnames over what we used to
+** promote. msg_accrights(len) is done differently.
+ }
+{ optional address }
+{ size of address }
+{ scatter/gather array }
+{ count of elements in msg_iov }
+{ access rights sent/received }
+ Pmsghdr = ^msghdr;
+ msghdr = record
+ msg_name : caddr_t;
+ msg_namelen : socklen_t;
+ msg_iov : Piovec;
+ msg_iovlen : longint;
+ msg_accrights : caddr_t;
+ msg_accrightslen : socklen_t;
+ msg_flags : longint;
+ end;
+
+{
+** POSIX 1003.1g: Ancillary data object information consisting of a sequence
+** of pairs of (cmsghdr, cmsg_data[1]).
+ }
+{ data byte count including header }
+{ originating protocol }
+{ protocol-specific type }
+ Pcmsghdr = ^cmsghdr;
+ cmsghdr = record
+ cmsg_len : socklen_t;
+ cmsg_level : longint;
+ cmsg_type : longint;
+ end;
+
+
+(** unsupported pragma#pragma pack()*)
+
+function Fpaccept(s:longint; addr:Psockaddr; len:Psize_t):longint;cdecl;external libc_nlm name 'accept';
+function Fpbind(s:longint; addr:Psockaddr; _para3:size_t):longint;cdecl;external libc_nlm name 'bind';
+function Fpconnect(s:longint; addr:Psockaddr; len:size_t):longint;cdecl;external libc_nlm name 'connect';
+function Fpgetpeername(s:longint; addr:Psockaddr; len:Psize_t):longint;cdecl;external libc_nlm name 'getpeername';
+function Fpgetsockname(s:longint; addr:Psockaddr; len:Psize_t):longint;cdecl;external libc_nlm name 'getsockname';
+function Fpgetsockopt(s:longint; level:longint; optname:longint; optval:pointer; optlen:Psize_t):longint;cdecl;external libc_nlm name 'getsockopt';
+function Fplisten(s:longint; backlog:longint):longint;cdecl;external libc_nlm name 'listen';
+function Fprecv(s:longint; buf:pointer; len:size_t; flags:longint):ssize_t;cdecl;external libc_nlm name 'recv';
+function Fprecvfrom(s:longint; buf:pointer; len:size_t; flags:longint; from:Psockaddr;
+ fromlen:Psize_t):ssize_t;cdecl;external libc_nlm name 'recvfrom';
+function Fprecvmsg(s:longint; msg:Pmsghdr; flags:longint):ssize_t;cdecl;external libc_nlm name 'recvmsg';
+function Fpsend(s:longint; msg:pointer; len:size_t; flags:longint):ssize_t;cdecl;external libc_nlm name 'send';
+function Fpsendmsg(s:longint; _para2:Pmsghdr; flags:longint):ssize_t;cdecl;external libc_nlm name 'sendmsg';
+function Fpsendto(s:longint; msg:pointer; len:size_t; flags:longint; _to:Psockaddr;
+ tolen:size_t):ssize_t;cdecl;external libc_nlm name 'sendto';
+function Fpsetsockopt(s:longint; level:longint; optname:longint; optval:pointer; optlen:size_t):longint;cdecl;external libc_nlm name 'setsockopt';
+function Fpshutdown(s:longint; how:longint):longint;cdecl;external libc_nlm name 'shutdown';
+function Fpsocket(domain:longint; _type:longint; protocol:longint):longint;cdecl;external libc_nlm name 'socket';
+
+
+// sys/sockio.h
+// sys/stat.h
+{ turn on 1-byte packing... }
+
+{ file system type }
+{ fragment size }
+{ block size }
+{ total number of blocks }
+{ count of free blocks }
+{ total number of file nodes }
+{ count of free file nodes }
+{ server name }
+{ volume name }
+{ pack name }
+type
+ Pstatfs = ^Tstatfs;
+ Tstatfs = record
+ f_fstyp : longint;
+ f_frsize : size_t;
+ f_bsize : blksize_t;
+ f_blocks : blkcnt_t;
+ f_bfree,
+ f_files,
+ f_ffree : Tuint64;
+ f_fspare : array[0..1] of Tuint64;
+ f_fserver: array[0..(48 + 4)-1] of char;
+ f_fname : array[0..(16 + 4)-1] of char;
+ f_fpack : array[0..19] of char;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+
+function Fpstatfs(path:Pchar; buf:Pstatfs):longint;cdecl;external libc_nlm name 'statfs';
+function Fpstatfs(path:Pchar; var buf:Tstatfs):longint;cdecl;external libc_nlm name 'statfs';
+function Fpfstatfs(fildes:longint; buf:Pstatfs):longint;cdecl;external libc_nlm name 'fstatfs';
+function Fpfstatfs(fildes:longint; var buf:Tstatfs):longint;cdecl;external libc_nlm name 'fstatfs';
+
+// sys/ttydefaults.h
+
+{ system wide defaults for terminal state, mostly for porting help }
+{ defaults on "first" open... }
+{ control character defaults... }
+{ compatibility: }
+// sys/un.h
+
+{ used in place of struct sockaddr_t to define addresses for UNIX domain... }
+type
+ Psockaddr_un = ^sockaddr_un;
+ sockaddr_un = record
+ sun_family : sa_family_t;
+ sun_path : array[0..510] of char;
+ end;
+
+// ======= sys/utsname.h ===============================================
+
+{ turn on 1-byte packing... }
+
+// (request) bits for uname2()...
+const
+ UNAME_NLMMODULE = $00000001; // nlmmodule (if it can be gotten)
+ UNAME_POSIXFIELDS = $00000002; // POSIX fields (see sys/utsname.h)
+ UNAME_LIBVERSION = $00000004; // libminor/major/revision/threshold
+ UNAME_FSVERSION = $00000008; // major/minor/revision/service pack
+ UNAME_NETWAREVERSION = $00000010; // netware_major/minor/revision
+ UNAME_SERVERNAME = $00000020; // servername
+ UNAME_CLUSTERNAME = $00000040; // clustername
+ UNAME_LANGINFO = $00000080; // languagename/alt/id/altid/codepage
+ UNAME_NLMMESSAGES = $00000100; // nlmmessagecount/table
+ UNAME_NLMVERSION = $00000200; // nlmmajor/minor/revision
+ UNAME_NLMINFO = $00000400; // nlmtimer/loadflags
+ UNAME_NLMNAME = $00000800; // nlmname
+ UNAME_NLMLOADPATH = $00001000; // nlmloadpath
+ UNAME_NLMCOPYRIGHT = $00002000; // nlmcopyright
+ UNAME_NLMDESCRIPTION = $00004000; // nlmdescription
+ UNAME_NLMCOMMANDLINE = $00008000; // nlmcommandline
+ UNAME_NDSTREENAME = $00010000; // treename
+ UNAME_NLMCODEANDDATA = $00020000; // code and datastart/-length
+
+type
+ Putsname = ^Tutsname;
+ Tutsname = record
+ userspec : longint; // untouched by uname()
+ // Novell fields
+ // Standard C Library implementation:
+ libmajor : longint; // major version number
+ libminor : longint; // minor version number
+ librevision : longint; // revision number
+ // NetWare OS implementation
+ major : longint; // major version number
+ minor : longint; // minor version number
+ revision : longint; // revision number
+ // NetWare C Library implementation
+ libthreshold : longint; // functionality and semantics timestamp
+ // NetWare product distribution
+ servicepack : longint;
+ netware_major : longint;
+ netware_minor : longint;
+ netware_revision : longint;
+ servername : array[0..63] of char;
+ clustername : array[0..63] of char;
+ languagename : array[0..31] of char; // Server current language name
+ altlanguagename : array[0..31] of char; // NLM's current language name
+ languageid : longint;
+ altlanguageid : longint;
+ codepage : longint;
+ reserved1 : longint;
+ reserved2 : array[0..3] of longint;
+ nlmmodule : pointer; // NetWare-loadable module (NLM) handle
+ nlmmajor : longint;
+ nlmminor : longint;
+ nlmrevision : longint;
+ nlmtimer : time_t; // module's date and time stamp in UTC
+ nlmcommandline : Pchar;
+ nlmmessagecount : dword;
+ nlmmessagetable : ^Pchar;
+ nlmname : array[0..35] of char;
+ nlmloadpath : array[0..255] of char;
+ nlmcopyright : array[0..255] of char;
+ nlmdescription : array[0..127] of char;
+ nlmloadflags : longint;
+ reserved3 : longint;
+ release : array[0..15] of char;
+ version : array[0..15] of char;
+ sysname : array[0..15] of char;
+ machine : array[0..15] of char;
+ nodename : array[0..15] of char;
+ treename : array[0..95] of char; // name of NDS tree
+ codeoffset : pointer;
+ codelength : dword;
+ dataoffset : pointer;
+ datalength : dword;
+ reserved4 : array[0..27] of longint;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+function Fpuname(name:Putsname):longint;cdecl;external libc_nlm name 'uname';
+function Fpuname(var name:Tutsname):longint;cdecl;external libc_nlm name 'uname';
+function Fpuname2(handle:pointer; info:Putsname; bits:dword):longint;cdecl;external libc_nlm name 'uname2';
+function Fpuname2(handle:pointer; var info:Tutsname; bits:dword):longint;cdecl;external libc_nlm name 'uname2';
+
+
+// sys/wait.h
+
+function Fpwait(stat_loc:Plongint):pid_t;cdecl;external libc_nlm name 'wait';
+function Fpwait(var stat_loc:longint):pid_t;cdecl;external libc_nlm name 'wait';
+function Fpwaitpid(pid:pid_t; stat_loc:Plongint; options:longint):pid_t;cdecl;external libc_nlm name 'waitpid';
+function Fpwaitpid(pid:pid_t; var stat_loc:longint; options:longint):pid_t;cdecl;external libc_nlm name 'waitpid';
+
+// arpa/inet.h
+// netinet/in.h
+
+{ protocols... }
+{ port/socket numbers: network standard functions }
+{ port/socket numbers: host specific functions... }
+{ UNIX TCP sockets... }
+{ UNIX UDP sockets... }
+{
+** Ports numbered less than IPPORT_RESERVED are reserved for privileged
+** processes like 'root.'
+ }
+{ link numbers... }
+{
+** Definitions of bits in Internet address integers. On subnets, the
+** decomposition of addresses to host and net parts is done according
+** to subnet mask, not the masks here.
+ }
+{ options for use with [gs]etsockopt at IP level... }
+{ macro to stuff the loopback address into an Internet address... }
+{ address testing macros... }
+{ type definitions... }
+type
+ Pin_addr = ^in_addr;
+ in_addr = record
+ S_un : record
+ case longint of
+ 0 : ( S_un_b : record
+ s_b1 : byte;
+ s_b2 : byte;
+ s_b3 : byte;
+ s_b4 : byte;
+ end );
+ 1 : ( S_un_w : record
+ s_w1 : word;
+ s_w2 : word;
+ end );
+ 2 : ( S_addr : dword );
+ end;
+ end;
+
+ //!! in_addr = in_addr_t;
+{ socket address, internet style }
+ Psockaddr_in = ^sockaddr_in;
+ sockaddr_in = record
+ sin_family : smallint;
+ sin_port : u_short;
+ sin_addr : in_addr;
+ sin_zero : array[0..7] of char;
+ end;
+
+ //!! sockaddr_in = sockaddr_in_t;
+ Pin6_addr = ^in6_addr;
+ in6_addr = record
+ in6a_u : record
+ case longint of
+ 0 : ( bytes : array[0..15] of u_char );
+ 1 : ( shorts : array[0..7] of u_short );
+ 2 : ( words : array[0..3] of u_long );
+ end;
+ end;
+
+ Psockaddr_in6 = ^sockaddr_in6;
+ sockaddr_in6 = record
+ sin6_family : smallint;
+ sin6_port : u_short;
+ sin6_flowinfo : u_long;
+ sin6_addr : in6_addr;
+ sin6_scope_id : u_long;
+ end;
+
+{ for IP_ADD_MEMBERSHIP and IP_DROP_MEMBERSHIP... }
+{ IP multicast address of group }
+{ local IP address of interface }
+ Pip_mreq = ^ip_mreq;
+ ip_mreq = record
+ imr_multiaddr : in_addr;
+ imr_interface : in_addr;
+ end;
+
+{ data... }
+
+// var
+// in6addr_any : in6_addr;cvar;external;
+// in6addr_loopback : in6_addr;cvar;external;
+
+
+function inet_addr(_string:Pchar):dword;cdecl;external libc_nlm name 'inet_addr';
+function inet_aton(cp:Pchar; addr:Pin_addr):longint;cdecl;external libc_nlm name 'inet_aton';
+function inet_makeaddr(net_num:in_addr; loc_addr:in_addr):in_addr;cdecl;external libc_nlm name 'inet_makeaddr';
+function inet_network(_string:Pchar):in_addr;cdecl;external libc_nlm name 'inet_network';
+function inet_ntoa(addr:in_addr):Pchar;cdecl;external libc_nlm name 'inet_ntoa';
+function inet_ntop(af:longint; src:pointer; dst:Pchar; size:size_t):Pchar;cdecl;external libc_nlm name 'inet_ntop';
+function inet_pton(af:longint; cp:Pchar; ap:pointer):longint;cdecl;external libc_nlm name 'inet_pton';
+
+
+// netinet/in.h
+
+{ User-settable options (used with setsockopt). }
+
+
+// nks/defs.h
+
+ const
+ NX_MAX_KEYS = 64;
+ NX_MAX_OBJECT_NAME_LEN = 31;
+ NX_INTR1 = 0;
+ NX_INTR2 = 1;
+ NX_INTR3 = 2;
+ NX_INTR4 = 3;
+ NX_INTR5 = 4;
+ NX_INTR6 = 5;
+ NX_INTR7 = 6;
+ NX_INTR8 = 7;
+ NX_INTR9 = 8;
+ NX_INTR10 = 9;
+ NX_INTR11 = 10;
+ NX_INTR12 = 11;
+ NX_INTR13 = 12;
+ NX_INTR14 = 13;
+ NX_INTR15 = 14;
+ NX_INTR16 = 15;
+ NX_INTR17 = 16;
+ NX_INTR18 = 17;
+ NX_INTR19 = 18;
+ NX_INTR20 = 19;
+ NX_INTR21 = 20;
+ NX_INTR22 = 21;
+ NX_INTR23 = 22;
+ NX_INTR24 = 23;
+ NX_INTR25 = 24;
+ NX_INTR26 = 25;
+ NX_INTR27 = 26;
+ NX_INTR28 = 27;
+ NX_INTR29 = 28;
+ NX_INTR30 = 29;
+ NX_INTR31 = 30;
+ NX_INTR32 = 31;
+ NX_INTR33 = 32;
+ NX_INTR34 = 33;
+ NX_INTR35 = 34;
+ NX_INTR36 = 35;
+ NX_INTR37 = 36;
+ NX_INTR38 = 37;
+ NX_INTR39 = 38;
+ NX_INTR40 = 39;
+ NX_INTR41 = 40;
+ NX_INTR42 = 41;
+ NX_INTR43 = 42;
+ NX_INTR44 = 43;
+ NX_INTR45 = 44;
+ NX_INTR46 = 45;
+ NX_INTR47 = 46;
+ NX_INTR48 = 47;
+ NX_INTR49 = 48;
+ NX_INTR50 = 49;
+ NX_INTR51 = 50;
+ NX_INTR52 = 51;
+ NX_INTR53 = 52;
+ NX_INTR54 = 53;
+ NX_INTR55 = 54;
+ NX_INTR56 = 55;
+ NX_INTR57 = 56;
+ NX_INTR58 = 57;
+ NX_INTR59 = 58;
+ NX_INTR60 = 59;
+ NX_INTR61 = 60;
+ NX_INTR62 = 61;
+ NX_INTR63 = 62;
+ NX_INTR64 = 63;
+
+
+type
+
+ PNXBool_t = ^NXBool_t;
+ NXBool_t = longint;
+
+ PNXVmId_t = ^NXVmId_t;
+ NXVmId_t = longint;
+{ values for NXInterruptId_t... }
+
+
+// nks/dirio.h
+// nks/fsio.h
+// unilib.h
+
+ const
+ UNI_ERR_MEM_ALLOC = -(494);
+ { nonexistant rule table handle }
+ UNI_ERR_BAD_HANDLE = -(496);
+ { table corruption detected }
+ UNI_ERR_TABLE_CORRUPT = -(498);
+ { insufficient room in string }
+ UNI_ERR_TOO_FEW_BYTES = -(500);
+ { unable to open data file }
+ UNI_ERR_FILE_OPEN = -(501);
+ { }
+ UNI_ERR_FILE_EXIST = -(502);
+ { unable to read data file }
+ UNI_ERR_FILE_READ = -(504);
+ { functional stub only }
+ UNI_ERR_UNIMPLEMENTED = -(505);
+ { premature end-of-string }
+ UNI_ERR_PREMATURE_END = -(506);
+ { discovered during translation }
+ UNI_ERR_UNMAPPABLE_CHAR = -(532);
+ { invalid UTF-8 character sequence }
+ UNI_ERR_INVALID_UTF8_SEQ = $FFFF;
+ { the local, default rule table for argument 'table' below... }
+ { respective to local codepage }
+ UNI_LOCAL_DEFAULT = -(1);
+ { 'noMapFlag' values; when no mapping found... }
+ { return UNI_ERR_UNMAPPABLE_CHAR }
+ UNI_MAP_NO_CHAR = 0;
+ { use value in 'noMapChar' unless 0 }
+ UNI_MAP_CHAR = 1;
+ { use 'noMapFunc' if non-nil }
+ UNI_MAP_BY_FUNC = 1;
+ { use character itself }
+ UNI_MAP_SELF = 2;
+ { no-map character if 'noMapChar' 0 }
+ UNI_NOMAP_DEFAULT = '?';
+ { character classification (UniClass_t)... }
+ { no classification }
+ UNI_UNDEF = $00000000;
+ { control character }
+ UNI_CNTRL = $00000001;
+ { non-printing space }
+ UNI_SPACE = $00000002;
+ { printing (visible) character }
+ UNI_PRINT = $00000004;
+ { dingbats, special symbols, et al. }
+ UNI_SPECIAL = $00000008;
+ { general punctuation }
+ UNI_PUNCT = $00000010;
+ { decimal digit }
+ UNI_DIGIT = $00000020;
+ { hexadecimal digit }
+ UNI_XDIGIT = $00000040;
+ { reserved for future use }
+ UNI_RESERVED1 = $00000080;
+ { lower-case if applicable }
+ UNI_LOWER = $00000100;
+ { upper-case if applicable }
+ UNI_UPPER = $00000200;
+ { reserved for future use }
+ UNI_RESERVED2 = $00000400;
+ { non-number, non-punctuation including: }
+ UNI_ALPHA = $00000800;
+ { Latin-based }
+ UNI_LATIN = $00001000;
+ { Greek }
+ UNI_GREEK = $00002000;
+ { Cyrillic }
+ UNI_CYRILLIC = $00004000;
+ { Hebrew }
+ UNI_HEBREW = $00008000;
+ { Arabic }
+ UNI_ARABIC = $00010000;
+ { Chinese/Japanese/Korean characters }
+ UNI_CJK = $00020000;
+ { Devanagari, Bengali, Tamil, et al. }
+ UNI_INDIAN = $00040000;
+ { southeast Asia: Thai, Lao }
+ UNI_SEASIA = $00080000;
+ { cent. Asia: Armenian Tibetain, Georg. }
+ UNI_CENASIA = $00100000;
+ { none of the above }
+ UNI_OTHER = $80000000;
+
+
+type
+ Punicode_t = ^unicode_t;
+ unicode_t = wchar_t;
+ PPunicode_t = ^Punicode_t;
+
+ PUniRuleTable_t = ^UniRuleTable_t;
+ UniRuleTable_t = longint;
+{ more a cookie than anything else }
+
+ PUniClass_t = ^UniClass_t;
+ UniClass_t = dword;
+{ Unicode character classification }
+{ for uni2mono(), unicase(), et al. }
+{ default monocasing as implemented }
+{ character is not 'alphabetic' }
+{ character has no case }
+{ emphatically upper case }
+{ emphatically lower case }
+
+ PUniCase_t = ^UniCase_t;
+ UniCase_t = Longint;
+ Const
+ UNI_CASE_DEFAULT = $FFFFFFFD;
+ UNI_CASE_NONE = $FFFFFFFE;
+ UNI_CASE_AMBIGUOUS = $FFFFFFFF;
+ UNI_CASE_UPPER = $00000000;
+ UNI_CASE_LOWER = $00000001;
+ UNI_CASE_TITLE = $00000002;
+
+{ unmappable character handling function types... }
+
+type
+
+ Loc2UniNoMapFunc_t = function (dest:PPunicode_t; remaining:size_t; src:PPchar; userParm:pointer):longint;cdecl;
+
+
+ Loc2Utf8NoMapFunc_t = function (dest:PPchar; remaining:size_t; src:PPchar; userParm:pointer):longint;cdecl;
+
+
+ Utf82LocNoMapFunc_t = function (dest:PPchar; remaining:size_t; src:PPchar; userParm:pointer):longint;cdecl;
+
+
+ Utf82UniNoMapFunc_t = function (dest:PPchar; remaining:size_t; src:PPunicode_t; userParm:pointer):longint;cdecl;
+
+
+ Uni2LocNoMapFunc_t = function (dest:PPchar; remaining:size_t; src:PPunicode_t; userParm:pointer):longint;cdecl;
+
+
+ Uni2Utf8NoMapFunc_t = function (dest:PPchar; remaining:size_t; src:PPunicode_t; userParm:pointer):longint;cdecl;
+{ rule table management... }
+
+function UniGetTable(codePage:longint; table:PUniRuleTable_t):longint;cdecl;external libc_nlm name 'UniGetTable';
+
+function UniGetMacintoshTable(name:Pchar; table:PUniRuleTable_t):longint;cdecl;external libc_nlm name 'UniGetMacintoshTable';
+function UniSetDefault(table:UniRuleTable_t):longint;cdecl;external libc_nlm name 'UniSetDefault';
+function UniDisposeTable(table:UniRuleTable_t):longint;cdecl;external libc_nlm name 'UniDisposeTable';
+function UniGetHostCodePage:longint;cdecl;external libc_nlm name 'UniGetHostCodePage';
+{ translation between local and other codepages, Unicode and UTF-8... }
+
+function loc2uni(table:UniRuleTable_t; dest:Punicode_t; src:Pchar; noMapCh:unicode_t; noMapFlag:longint):longint;cdecl;external libc_nlm name 'loc2uni';
+
+function loc2unipath(table:UniRuleTable_t; dest:Punicode_t; src:Pchar; dryRunSize:Psize_t):longint;cdecl;external libc_nlm name 'loc2unipath';
+
+function locn2uni(table:UniRuleTable_t; dest:Punicode_t; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapCh:unicode_t; noMapFlag:longint):longint;cdecl;external libc_nlm name 'locn2uni';
+function locnp2uni(table:UniRuleTable_t; target:PPunicode_t; destLen:Psize_t; source:PPchar; srcLen:size_t;
+ noMapCh:unicode_t; noMapFlag:longint):longint;cdecl;external libc_nlm name 'locnp2uni';
+
+function locnx2uni(table:UniRuleTable_t; dest:Punicode_t; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapFunc:Loc2UniNoMapFunc_t; noMapFuncParm:pointer; noMapFlag:longint):longint;cdecl;external libc_nlm name 'locnx2uni';
+
+function locnx2unipath(table:UniRuleTable_t; dest:Punicode_t; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapFunc:Loc2UniNoMapFunc_t; noMapFuncParm:pointer; noMapFlag:longint; dryRunSize:Psize_t):longint;cdecl;external libc_nlm name 'locnx2unipath';
+
+function locn2unispecial(handle:UniRuleTable_t; dest:Punicode_t; destLen:Psize_t; src:Pchar; srcLen:size_t):longint;cdecl;external libc_nlm name 'locn2unispecial';
+
+function loc2utf8(handle:UniRuleTable_t; dest:Pchar; src:Pchar; noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'loc2utf8';
+
+function loc2utf8path(table:UniRuleTable_t; dest:Pchar; src:Pchar; dryRunSize:Psize_t):longint;cdecl;external libc_nlm name 'loc2utf8path';
+
+function locn2utf8(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'locn2utf8';
+
+function locnx2utf8(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapFunc:Loc2Utf8NoMapFunc_t; noMapFuncParm:pointer; noMapFlag:longint):longint;cdecl;external libc_nlm name 'locnx2utf8';
+
+function uni2loc(table:UniRuleTable_t; dest:Pchar; src:Punicode_t; noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'uni2loc';
+
+function uni2locpath(table:UniRuleTable_t; dest:Pchar; src:Punicode_t; dryRunSize:Psize_t):longint;cdecl;external libc_nlm name 'uni2locpath';
+
+function unin2loc(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Punicode_t; srcLen:size_t;
+ noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'unin2loc';
+function uninp2loc(table:UniRuleTable_t; target:PPchar; destLen:Psize_t; source:PPunicode_t; srcLen:size_t;
+ noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'uninp2loc';
+
+function uninx2loc(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Punicode_t; srcLen:size_t;
+ noMapFunc:Uni2LocNoMapFunc_t; noMapFuncParm:pointer; noMapFlag:longint):longint;cdecl;external libc_nlm name 'uninx2loc';
+
+function uninx2locpath(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Punicode_t; srcLen:size_t;
+ noMapFunc:Uni2LocNoMapFunc_t; noMapFuncParm:pointer; noMapFlag:longint; dryRunSize:Psize_t):longint;cdecl;external libc_nlm name 'uninx2locpath';
+
+function unin2locspecial(handle:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Punicode_t; srcLen:size_t):longint;cdecl;external libc_nlm name 'unin2locspecial';
+
+function uni2utf8(dest:Pchar; src:Punicode_t):longint;cdecl;external libc_nlm name 'uni2utf8';
+
+function uni2utf8path(dest:Pchar; src:Punicode_t; dryRunSize:Psize_t):longint;cdecl;external libc_nlm name 'uni2utf8path';
+
+function unin2utf8(dest:Pchar; destLen:Psize_t; src:Punicode_t; srcLen:size_t):longint;cdecl;external libc_nlm name 'unin2utf8';
+
+function utf82loc(handle:UniRuleTable_t; dest:Pchar; src:Pchar; noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'utf82loc';
+
+function utf8n2loc(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapCh:char; noMapFlag:longint):longint;cdecl;external libc_nlm name 'utf8n2loc';
+
+function utf8nx2loc(table:UniRuleTable_t; dest:Pchar; destLen:Psize_t; src:Pchar; srcLen:size_t;
+ noMapFunc:Utf82LocNoMapFunc_t; noMapFuncParm:pointer; noMapFlag:longint):longint;cdecl;external libc_nlm name 'utf8nx2loc';
+
+function utf82uni(dest:Punicode_t; src:Pchar):longint;cdecl;external libc_nlm name 'utf82uni';
+
+function utf8n2uni(dest:Punicode_t; destLen:Psize_t; src:Pchar; srcLen:size_t):longint;cdecl;external libc_nlm name 'utf8n2uni';
+{ quick, 7-bit ASCII-capable translations--not preferred set... }
+
+function asc2uni(dest:Punicode_t; src:Pchar):Punicode_t;cdecl;external libc_nlm name 'asc2uni';
+
+function ascn2uni(dest:Punicode_t; src:Pchar; nbytes:size_t):Punicode_t;cdecl;external libc_nlm name 'ascn2uni';
+
+function uni2asc(dest:Pchar; src:Punicode_t):Pchar;cdecl;external libc_nlm name 'uni2asc';
+
+function unin2asc(dest:Pchar; src:Punicode_t; nchars:size_t):Pchar;cdecl;external libc_nlm name 'unin2asc';
+{ default 'noMapFunc' for X-translation to ensure round-trip conversion... }
+
+function LocToUniTagFunc(dest:PPunicode_t; remaining:size_t; src:PPchar; userParm:pointer):longint;cdecl;external libc_nlm name 'LocToUniTagFunc';
+
+function UniToLocTagFunc(dest:PPchar; remaining:size_t; src:PPunicode_t; userParm:pointer):longint;cdecl;external libc_nlm name 'UniToLocTagFunc';
+{ string size calculation... }
+
+function LocToUniSize(table:UniRuleTable_t; str:Pchar; unmappedCharSize:size_t; noMapFlag:longint; uniBufSize:Psize_t):longint;cdecl;external libc_nlm name 'LocToUniSize';
+
+function LocToUtf8Size(table:UniRuleTable_t; str:Pchar; unmappedCharSize:size_t; noMapFlag:longint; utf8BufSize:Psize_t):longint;cdecl;external libc_nlm name 'LocToUtf8Size';
+
+function UniToLocSize(table:UniRuleTable_t; str:Punicode_t; unmappedCharSize:size_t; noMapFlag:longint; locBufSize:Psize_t):longint;cdecl;external libc_nlm name 'UniToLocSize';
+
+function UniToUtf8Size(str:Punicode_t; utf8BufSize:Psize_t):longint;cdecl;external libc_nlm name 'UniToUtf8Size';
+
+function Utf8ToLocSize(table:UniRuleTable_t; str:Pchar; unmappedCharSize:size_t; noMapFlag:longint; locBufSize:Psize_t):longint;cdecl;external libc_nlm name 'Utf8ToLocSize';
+
+function Utf8ToUniSize(str:Pchar; uniBufSize:Psize_t):longint;cdecl;external libc_nlm name 'Utf8ToUniSize';
+{-----------------------------------------------------------------------------
+** Little utility functions. These are not to be preferred over the interfaces
+** from wchar.h.
+ }
+{ utility to measure width of a character in a codepage... }
+
+function dbcs_width(codepage:longint; str:Pchar):longint;cdecl;external libc_nlm name 'dbcs_width';
+{ classification... }
+function unitype(ch:unicode_t):UniClass_t;cdecl;external libc_nlm name 'unitype';
+{ collation... }
+
+
+function unicoll(s1:Punicode_t; s2:Punicode_t):longint;cdecl;external libc_nlm name 'unicoll';
+
+
+function unincoll(s1:Punicode_t; s2:Punicode_t; n:size_t):longint;cdecl;external libc_nlm name 'unincoll';
+{ casing... }
+function unicase(ch:unicode_t):UniCase_t;cdecl;external libc_nlm name 'unicase';
+
+function uni2mono(dest:Punicode_t; src:Punicode_t; casing:UniCase_t):Punicode_t;cdecl;external libc_nlm name 'uni2mono';
+
+function unin2mono(dest:Punicode_t; src:Punicode_t; casing:UniCase_t; destLen:size_t):Punicode_t;cdecl;external libc_nlm name 'unin2mono';
+function chr2upr(ch:unicode_t):unicode_t;cdecl;external libc_nlm name 'chr2upr';
+function chr2lwr(ch:unicode_t):unicode_t;cdecl;external libc_nlm name 'chr2lwr';
+function chr2title(ch:unicode_t):unicode_t;cdecl;external libc_nlm name 'chr2title';
+function unilwr(_string:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unilwr';
+function uniupr(_string:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'uniupr';
+
+function uni2lwr(dest:Punicode_t; src:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'uni2lwr';
+
+function unin2lwr(dest:Punicode_t; src:Punicode_t; destLen:size_t):Punicode_t;cdecl;external libc_nlm name 'unin2lwr';
+
+function uni2upr(dest:Punicode_t; src:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'uni2upr';
+
+function unin2upr(dest:Punicode_t; src:Punicode_t; destLen:size_t):Punicode_t;cdecl;external libc_nlm name 'unin2upr';
+
+function uni2title(dest:Punicode_t; src:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'uni2title';
+
+function unin2title(dest:Punicode_t; src:Punicode_t; destLen:size_t):Punicode_t;cdecl;external libc_nlm name 'unin2title';
+{ length... }
+
+function unilen(_string:Punicode_t):size_t;cdecl;external libc_nlm name 'unilen';
+
+function uninlen(_string:Punicode_t; max:size_t):size_t;cdecl;external libc_nlm name 'uninlen';
+
+function unisize(_string:Punicode_t):size_t;cdecl;external libc_nlm name 'unisize';
+{ copying... }
+
+function unicpy(tgt:Punicode_t; src:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unicpy';
+
+function unincpy(tgt:Punicode_t; src:Punicode_t; n:size_t):Punicode_t;cdecl;external libc_nlm name 'unincpy';
+function uniset(base:Punicode_t; ch:unicode_t):Punicode_t;cdecl;external libc_nlm name 'uniset';
+function uninset(base:Punicode_t; ch:unicode_t; n:size_t):Punicode_t;cdecl;external libc_nlm name 'uninset';
+{ concatenation... }
+
+function unicat(tgt:Punicode_t; src:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unicat';
+
+function unincat(tgt:Punicode_t; src:Punicode_t; n:size_t):Punicode_t;cdecl;external libc_nlm name 'unincat';
+
+{$ifndef DisableArrayOfConst}
+function unilist(tgt:Punicode_t; s1:Punicode_t; args:array of const):Punicode_t;cdecl;external libc_nlm name 'unilist';
+{$endif}
+function unilist(tgt:Punicode_t; s1:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unilist';
+{ comparison... }
+
+
+function unicmp(s1:Punicode_t; s2:Punicode_t):longint;cdecl;external libc_nlm name 'unicmp';
+
+
+function uniicmp(s1:Punicode_t; s2:Punicode_t):longint;cdecl;external libc_nlm name 'uniicmp';
+
+
+function unincmp(s1:Punicode_t; s2:Punicode_t; n:size_t):longint;cdecl;external libc_nlm name 'unincmp';
+
+
+function uninicmp(s1:Punicode_t; s2:Punicode_t; n:size_t):longint;cdecl;external libc_nlm name 'uninicmp';
+{ character matching, indexing and miscellaneous... }
+
+function unichr(_string:Punicode_t; ch:unicode_t):Punicode_t;cdecl;external libc_nlm name 'unichr';
+function unirchr(_string:Punicode_t; ch:unicode_t):Punicode_t;cdecl;external libc_nlm name 'unirchr';
+function uniindex(_string:Punicode_t; search:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'uniindex';
+function unistr(as1:Punicode_t; as2:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unistr';
+function unirev(base:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unirev';
+function unispn(_string:Punicode_t; charset:Punicode_t):size_t;cdecl;external libc_nlm name 'unispn';
+function unicspn(_string:Punicode_t; charset:Punicode_t):size_t;cdecl;external libc_nlm name 'unicspn';
+function unipbrk(s1:Punicode_t; s2:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unipbrk';
+function unitok(_string:Punicode_t; sepset:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unitok';
+function unitok_r(_string:Punicode_t; sepset:Punicode_t; lasts:PPunicode_t):Punicode_t;cdecl;external libc_nlm name 'unitok_r';
+function unidup(s1:Punicode_t):Punicode_t;cdecl;external libc_nlm name 'unidup';
+// nks/time.h
+
+{ values for 'epoch' for NXGetTime()... }
+{ values for 'units' for NXGetTime()... }
+{ turn on 1-byte packing... }
+
+type
+
+ PNXTime_t = ^NXTime_t;
+ NXTime_t = Tuint64;
+
+ PNXTimerVal_t = ^NXTimerVal_t;
+ NXTimerVal_t = record
+ tvPeriod : dword;
+ tvCurrent : dword;
+ end;
+
+ PNXTimeOut_t = ^NXTimeOut_t;
+ NXTimeOut_t = record
+ reserved1 : array[0..3] of dword;
+ toRoutine : procedure (_para1:pointer);cdecl;
+ toArg : pointer;
+ toTimerVal : NXTimerVal_t;
+ reserved2 : array[0..15] of dword;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ Time and time-out... }
+
+function NXTimeOutCancel(tout:PNXTimeOut_t; wait:NXBool_t; status:PNXBool_t):longint;cdecl;external libc_nlm name 'NXTimeOutCancel';
+function NXTimeOutSchedule(tout:PNXTimeOut_t):longint;cdecl;external libc_nlm name 'NXTimeOutSchedule';
+function NXGetTime(epoch:longint; units:longint; time:PNXTime_t):longint;cdecl;external libc_nlm name 'NXGetTime';
+
+
+// nks/thread.h
+// nks/plat.h
+type
+
+ PNXCpuId_t = ^NXCpuId_t;
+ NXCpuId_t = longint;
+{ Platform-specific services... }
+
+function NXGetCacheLineSize:size_t;cdecl;external libc_nlm name 'NXGetCacheLineSize';
+function NXGetCpuCount:dword;cdecl;external libc_nlm name 'NXGetCpuCount';
+function NXGetCpuId:NXCpuId_t;cdecl;external libc_nlm name 'NXGetCpuId';
+function NXGetPageSize:size_t;cdecl;external libc_nlm name 'NXGetPageSize';
+function NXSeedRandom(width:size_t; seed:pointer):longint;cdecl;external libc_nlm name 'NXSeedRandom';
+function NXGetSystemTick:dword;cdecl;external libc_nlm name 'NXGetSystemTick';
+{ values for thread priority... }
+{ values for thread context flags... }
+{ values for thread flags... }
+{ value returned that specifies that the thread is unbound }
+{ value passed to NXThreadBind to bind it to the current CPU }
+{ return from NXThreadGetId indicating no-context or other error }
+
+{ turn on 1-byte packing... }
+
+type
+
+ PNXContext_t = ^NXContext_t;
+ NXContext_t = void;
+
+ PNXWorkId_t = ^NXWorkId_t;
+ NXWorkId_t = longint;
+
+ PNXKey_t = ^NXKey_t;
+ NXKey_t = longint;
+
+ PNXThreadId_t = ^NXThreadId_t;
+ NXThreadId_t = longint;
+
+ PNXInterruptId_t = ^NXInterruptId_t;
+ NXInterruptId_t = longint;
+
+ PNXInterruptSet_t = ^NXInterruptSet_t;
+ NXInterruptSet_t = Tuint64;
+
+ PNXContextState_t = ^NXContextState_t;
+ NXContextState_t = Longint;
+ Const
+ NX_CTXSTATE_INIT = $FFFFFFFF;
+ NX_CTXSTATE_BOUND = $00000001;
+ NX_CTXSTATE_UNBOUND = $00000000;
+
+type
+
+ PNXContextInfo_t = ^NXContextInfo_t;
+ NXContextInfo_t = record
+ ciState : NXContextState_t;
+ ciFunc : procedure (_para1:pointer);cdecl;
+ ciArg : pointer;
+ ciPriority : longint;
+ ciStackSize : size_t;
+ ciFlags : dword;
+ end;
+
+ PlwWork = ^lwWork;
+ lwWork = record
+ reserved : array[0..6] of pointer;
+ lwWorkFunc : procedure (_para1:PlwWork; _para2:pointer);cdecl;
+ lwAppRef : pointer;
+ end;
+ NXLwWork_t = lwWork;
+ PNXLwWork_t = ^NXLwWork_t;
+
+(** unsupported pragma#pragma pack()*)
+{ Context management... }
+
+type TCDeclProc1PtrArg = procedure (_para1:pointer); cdecl;
+
+function NXContextAlloc(start_routine:TCDeclProc1PtrArg; arg:pointer; priority:longint; stackSize:size_t; flags:dword;
+ error:Plongint):NXContext_t;cdecl;external libc_nlm name 'NXContextAlloc';
+function NXContextFree(ctx:NXContext_t):longint;cdecl;external libc_nlm name 'NXContextFree';
+function NXContextGet:NXContext_t;cdecl;external libc_nlm name 'NXContextGet';
+function NXContextGetInfo(ctx:NXContext_t; info:PNXContextInfo_t):longint;cdecl;external libc_nlm name 'NXContextGetInfo';
+function NXContextGetName(ctx:NXContext_t; name:Pchar; len:size_t):longint;cdecl;external libc_nlm name 'NXContextGetName';
+function NXContextReinit(ctx:NXContext_t; start_routine:TCDeclProc1PtrArg; arg:pointer; priority:longint; flags:dword):longint;cdecl;external libc_nlm name 'NXContextReinit';
+
+function NXContextSetName(ctx:NXContext_t; name:Pchar):longint;cdecl;external libc_nlm name 'NXContextSetName';
+{ Key-value pairs (per-context data)... }
+type TCdeclProc = procedure; cdecl;
+function NXKeyCreate(_destructor: TCDeclProc; value:pointer; key:PNXKey_t):longint;cdecl;external libc_nlm name 'NXKeyCreate';
+function NXKeyDelete(key:NXKey_t):longint;cdecl;external libc_nlm name 'NXKeyDelete';
+function NXKeyGetValue(key:NXKey_t; value:Ppointer):longint;cdecl;external libc_nlm name 'NXKeyGetValue';
+function NXKeySetValue(key:NXKey_t; value:pointer):longint;cdecl;external libc_nlm name 'NXKeySetValue';
+{ Thread management... }
+function NXThreadBind(cpu_id:NXCpuId_t):longint;cdecl;external libc_nlm name 'NXThreadBind';
+function NXThreadContinue(tid:NXThreadId_t):longint;cdecl;external libc_nlm name 'NXThreadContinue';
+function NXThreadCreate(ctx:NXContext_t; flags:dword; idp:PNXThreadId_t):longint;cdecl;external libc_nlm name 'NXThreadCreate';
+function NXThreadCreateSx(start_routine:TCDeclProc1PtrArg; arg:pointer; thread_flags:dword; ctx:PNXContext_t; thr:PNXThreadId_t):longint;cdecl;external libc_nlm name 'NXThreadCreateSx';
+procedure NXThreadDelay(delay:dword);cdecl;external libc_nlm name 'NXThreadDelay';
+function NXThreadDestroy(tid:NXThreadId_t):longint;cdecl;external libc_nlm name 'NXThreadDestroy';
+function NXThreadDetach(tid:NXThreadId_t):longint;cdecl;external libc_nlm name 'NXThreadDetach';
+procedure NXThreadExit(status:pointer);cdecl;external libc_nlm name 'NXThreadExit';
+function NXThreadGetBinding:NXCpuId_t;cdecl;external libc_nlm name 'NXThreadGetBinding';
+function NXThreadGetContext(tid:NXThreadId_t; ctx:PNXContext_t):longint;cdecl;external libc_nlm name 'NXThreadGetContext';
+function NXThreadGetId:NXThreadId_t;cdecl;external libc_nlm name 'NXThreadGetId';
+function NXThreadGetPriority(tid:NXThreadId_t; priority:Plongint):longint;cdecl;external libc_nlm name 'NXThreadGetPriority';
+function NXThreadInterrupt(tid:NXThreadId_t; interId:NXInterruptId_t):longint;cdecl;external libc_nlm name 'NXThreadInterrupt';
+function NXThreadIsInterrupted(_set:PNXInterruptSet_t):NXBool_t;cdecl;external libc_nlm name 'NXThreadIsInterrupted';
+function NXThreadJoin(wait_for:NXThreadId_t; departed_thread:PNXThreadId_t; status:Ppointer):longint;cdecl;external libc_nlm name 'NXThreadJoin';
+function NXThreadSetPriority(tid:NXThreadId_t; priority:longint):longint;cdecl;external libc_nlm name 'NXThreadSetPriority';
+function NXThreadSuspend(tid:NXThreadId_t):longint;cdecl;external libc_nlm name 'NXThreadSuspend';
+function NXThreadSwapContext(newctx:NXContext_t; prevctx:PNXContext_t):longint;cdecl;external libc_nlm name 'NXThreadSwapContext';
+function NXThreadUnbind:longint;cdecl;external libc_nlm name 'NXThreadUnbind';
+procedure NXThreadYield;cdecl;external libc_nlm name 'NXThreadYield';
+function nxThreadCreate(start_routine:TCDeclProc1PtrArg; flags:dword; arg:pointer; ctxp:PNXContext_t; idp:PNXThreadId_t):longint;cdecl;external libc_nlm name 'nxThreadCreate';
+{ Work-to-dos... }
+function NXDelayedWorkSchedule(ctx:NXContext_t; timerval:PNXTimerVal_t; bind:NXBool_t; wid:PNXWorkId_t):longint;cdecl;external libc_nlm name 'NXDelayedWorkSchedule';
+function NXLwWorkCancel(work:PNXLwWork_t):longint;cdecl;external libc_nlm name 'NXLwWorkCancel';
+function NXLwWorkSchedule(reserved:pointer; work:PNXLwWork_t; bind:NXBool_t):longint;cdecl;external libc_nlm name 'NXLwWorkSchedule';
+function NXWorkCancel(wid:NXWorkId_t; wait:NXBool_t; status:PNXBool_t):longint;cdecl;external libc_nlm name 'NXWorkCancel';
+function NXWorkSchedule(context:NXContext_t; bind:NXBool_t; wid:PNXWorkId_t):longint;cdecl;external libc_nlm name 'NXWorkSchedule';
+{ Miscellaneous... }
+function NXProcessInterruptSet(_set:PNXInterruptSet_t; id:NXInterruptId_t; processed_id:PNXInterruptId_t):NXBool_t;cdecl;external libc_nlm name 'NXProcessInterruptSet';
+{ values and masks for file modes... }
+{ values and masks for file operations... }
+{ for NXDeviceOpen() and NXConsoleOpen()... }
+{ aliases for above... }
+{ open flags... }
+{ sharing flags... }
+{ delegation type... }
+{ flush flags... }
+{ values and masks for access flags... }
+{ values for setting file length... }
+{ values for file byte-range locking flags... }
+
+
+{ turn on 1-byte packing... }
+
+ const
+ NX_MAX_NAME_LEN = 255;
+ { (big! --this isn't used yet) }
+{$define NX_MAX_FILESIZE}
+ { values and masks for file modes... }
+ NX_O_RDONLY = $00000000;
+ NX_O_WRONLY = $00000001;
+ NX_O_RDWR = $00000002;
+ NX_O_ACCMODE = $00000003;
+ { values and masks for file operations... }
+ NX_O_APPEND = $00000010;
+ NX_O_CREAT = $00000020;
+ NX_O_TRUNC = $00000040;
+ NX_O_EXCL = $00000080;
+ NX_O_TRANS = $00000100;
+ NX_O_NONBLOCK = $00000400;
+ NX_O_OPMODE = $000005E0;
+ { for NXDeviceOpen() and NXConsoleOpen()... }
+ NX_O_SCROLLABLE = $00000800;
+ { aliases for above... }
+ NX_O_CREATE = NX_O_CREAT;
+ NX_O_TRUNCATE = NX_O_TRUNC;
+ NX_O_EXCLUSIVE = NX_O_EXCL;
+ { open flags... }
+ NX_OFLAG_DIRECTIO = $00010000;
+ NX_OFLAG_CRONLY = $00020000;
+ NX_OFLAG_BACKUP = $00040000;
+ NX_OFLAG_RESTORE = $00080000;
+ NX_OFLAG_EXTEND = $00100000;
+ NX_OFLAG_SYNCWR = $00200000;
+ NX_OFLAG_ATOMIC_RW = $00400000;
+ NX_OFLAG_NOTRAVERSE_LINK = $00800000;
+ NX_OFLAG_MASK = $00FF0000;
+ { sharing flags... }
+ NX_SHARE_DENYNO = $00000000;
+ NX_SHARE_DENYRD = $00100000;
+ NX_SHARE_DENYWR = $00200000;
+ NX_SHARE_DENYALL = $00400000;
+ NX_SHARE_MASK = $00700000;
+ { delegation type... }
+ NX_DELEG_NONE = $00000000;
+ { flush flags... }
+ NX_FLUSH_DATA = $00000001;
+ NX_FLUSH_METADATA = $00000002;
+ NX_FLUSH_ASYNC = $00000004;
+ { values and masks for access flags... }
+ NX_R_OK = $00000001;
+ NX_W_OK = $00000002;
+ NX_X_OK = $00000004;
+ NX_F_OK = $00000008;
+ { values for setting file length... }
+ NX_FOP_RETURN_EXTEND = $00000001;
+ NX_FOP_RETURN_TRUNC_FREE = $00000002;
+ NX_FOP_RETURN_SPARSE = $00000004;
+ { values for file byte-range locking flags... }
+ NX_RANGE_LOCK_SHARED = $00000001;
+ NX_RANGE_LOCK_EXCL = $00000002;
+ NX_RANGE_LOCK_CHECK = $00000004;
+ NX_RANGE_LOCK_TRYLOCK = $00000008;
+ NX_RANGE_LOCK_COURTESY = $00000010;
+ NX_RANGE_LOCK_CANCEL = $00000020;
+ NX_RANGE_LOCK_POSIX = $00000040;
+
+
+
+type
+ //Pfsio = ^fsio;
+ //fsio = record
+ {undefined structure}
+ // end;
+
+
+ PNXMode_t = ^NXMode_t;
+ NXMode_t = dword;
+
+ PNXOFlags_t = ^NXOFlags_t;
+ NXOFlags_t = dword;
+
+ PNXShareMode_t = ^NXShareMode_t;
+ NXShareMode_t = dword;
+
+ PNXOffset_t = ^NXOffset_t;
+ NXOffset_t = Tuint64;
+{ (file offsets and lengths) }
+
+ PNXSOffset_t = ^NXSOffset_t;
+ NXSOffset_t = Tint64;
+
+ PNXLockToken_t = ^NXLockToken_t;
+ NXLockToken_t = Tuint64;
+
+ PNXHandle_t = ^NXHandle_t;
+ NXHandle_t = longint;
+
+ PNXPathCtx_t = ^NXPathCtx_t;
+ NXPathCtx_t = longint;
+
+ PNXDelegType_t = ^NXDelegType_t;
+ NXDelegType_t = longint;
+
+ PNXAsyncId_t = ^NXAsyncId_t;
+ NXAsyncId_t = void;
+{ I/O objects supported... }
+
+ PNXObjType_t = ^NXObjType_t;
+ NXObjType_t = Longint;
+ Const
+ NX_OBJ_UNKNOWN = $FFFFFFFF;
+ NX_OBJ_DEFAULT = $FFFFFFFE;
+ NX_OBJ_FILE = $FFFFFFFD;
+ NX_OBJ_DIR = $FFFFFFFC;
+ NX_OBJ_FIFO = $FFFFFFFB;
+ NX_OBJ_DEVICE = $FFFFFFFA;
+ NX_OBJ_CONSOLE = $FFFFFFF9;
+ NX_OBJ_SYMLINK = $FFFFFFF8;
+
+type
+
+ PNXGuid_t = ^NXGuid_t;
+ NXGuid_t = record
+ case longint of
+ 0 : ( guid_field : array[0..1] of Tuint64 );
+ end;
+
+ PNXFid_t = ^NXFid_t;
+ NXFid_t = record
+ fidFsId : NXGuid_t;
+ fidFileId : array[0..1] of Tuint64;
+ end;
+
+ PNXUpCallReason_t = ^NXUpCallReason_t;
+ NXUpCallReason_t = Longint;
+ Const
+ NX_UPCALL_UNKNOWN = $FFFFFFFF;
+ NX_UPCALL_DELEGRECALL = $00000000;
+ NX_UPCALL_BACKUPIMMINENT = $00000001;
+
+ Const
+ NX_LOCK_RANGE_UNKNOWN = 2147483647;
+ NX_LOCK_RANGE_FORWARD = 1;
+ NX_LOCK_RANGE_BACKWARD = 2;
+
+type
+
+ NXFsUpCall_t = procedure (fileHandle:NXHandle_t; reason:NXUpCallReason_t; parm:pointer);cdecl;
+{ generic filesystem name if used }
+{ Macintosh data stream (data or resource) }
+
+ PNXDataStream_t = ^NXDataStream_t;
+ NXDataStream_t = record
+ case longint of
+ 0 : ( name : pointer );
+ 1 : ( macintoshId : dword );
+ end;
+{ based on which 'fosPathname' is understood }
+
+{ relative to 'fosPathCtx' }
+{ NX_O_RDONLY, NX_O_RDWR, etc. }
+{ NX_OFLAG_SYNCWR, NX_OFLAG_DIRECTIO, etc. }
+{ NX_SHARE_DENYRD, NX_DENY_ALL, etc. }
+{ contiguous file block allocation hint }
+{ contiguous file block allocation hint }
+{ delegation type: NX_DELEG_NONE }
+{ data stream (if not part of fosPathname) }
+{ called to warn of delegation revocation }
+{ description of successful conclusion }
+{ actual grant of delegation }
+{ returns FID of opened file }
+{ time of last access }
+{ time of last modification }
+{ time of file creation }
+{ time of last back-up }
+{ length of file at open }
+{ create/open operation results }
+
+ PNXFileOpenSpec_t = ^NXFileOpenSpec_t;
+ NXFileOpenSpec_t = record
+ fosPathCtx : NXPathCtx_t;
+ fosPathname : pointer;
+ fosMode : NXMode_t;
+ fosOFlags : NXOFlags_t;
+ fosShareMode : NXShareMode_t;
+ fosExtentSize : size_t;
+ reserved1 : dword;
+ fosDelegType : NXDelegType_t;
+ fosDataStream : NXDataStream_t;
+ fosUpCallFunc : NXFsUpCall_t;
+ fosResult : record
+ actionTaken : NXMode_t;
+ delegType : NXDelegType_t;
+ fid : NXFid_t;
+ accessTime : NXTime_t;
+ modifyTime : NXTime_t;
+ creationTime : NXTime_t;
+ archiveTime : NXTime_t;
+ length : NXOffset_t;
+ end;
+ reserved2 : dword;
+ reserved3 : dword;
+ end;
+ Pfsio = ^fsio;
+ NXIoComp_t = function (ioInfo:Pfsio):longint;cdecl;
+{ length of I/O buffer }
+{ pointer to data for I/O operation }
+{ application-maintained reference }
+
+ PNXIoVec_t = ^NXIoVec_t;
+ NXIoVec_t = record
+ ivLength : size_t;
+ reserved : dword;
+ ivBuffer : pointer;
+ ivOpRef : pointer;
+ end;
+{ I/O objects supported... }
+{ For Internal Use Only }
+
+ PNXLockRange_t = ^NXLockRange_t;
+ NXLockRange_t = Longint;
+
+
+{ application-maintained reference }
+{ file, FIFO, console, device, etc. handle }
+{ I/O flags and hints }
+{ hint as to remaining number of bytes }
+{ from NXFileRangeLockEx() }
+{ completion function if asynchronous }
+{ only for non-file system operations }
+{ offset at which to begin I/O }
+{ number of records in vector }
+{ IN/OUT: I/O operation record vector }
+{ OUT: asynchronous transaction ID }
+{ OUT: for asynchronous use }
+{ OUT: total bytes written or read }
+
+ fsio = record
+ ioAppRef : pointer;
+ ioHandle : NXHandle_t;
+ ioFlags : dword;
+ reserved : dword;
+ ioRemainingHint : NXOffset_t;
+ ioLockToken : NXLockToken_t;
+ ioCompletion : NXIoComp_t;
+ ioTimeOut : dword;
+ ioOffset : NXOffset_t;
+ ioVecCount : longint;
+ ioVector : PNXIoVec_t;
+ ioAsyncID : NXAsyncId_t;
+ ioStatus : longint;
+ ioProcessed : NXOffset_t;
+ end;
+ NXIo_t = fsio;
+ PNXIo_t = ^NXIo_t;
+{ in file (0-based) }
+{ magnitude of range }
+{ NX_LOCK_RANGE_FORWARD, ... }
+{ usually 0; reserved to server apps }
+{ in use only with NX_RANGE_LOCK_NETWARE }
+
+ PNXFileLockDesc_t = ^NXFileLockDesc_t;
+ NXFileLockDesc_t = record
+ ldOffset : NXOffset_t;
+ ldLength : NXOffset_t;
+ ldDirection : NXLockRange_t;
+ ldToken : NXLockToken_t;
+ ldHandle : NXHandle_t;
+ reserved : dword;
+ end;
+
+ NXLockUpCall_t = procedure (fileHandle:NXHandle_t; appRef:pointer; lockDesc:PNXFileLockDesc_t);cdecl;
+{ application-maintained reference }
+{ handle on which file was opened }
+{ mandatory (TRUE) or merely advisory? }
+{ NX_RANGE_LOCK_EXCL, etc. }
+{ maximum time to wait for lock }
+{ call-back by file system to release lock }
+{ info. on existing conflicting lock }
+{ info. for VM holding conflicting lock }
+{ count of locks described in array }
+{ array of lock descriptions }
+
+ PNXFileRangeLockSpec_t = ^NXFileRangeLockSpec_t;
+ NXFileRangeLockSpec_t = record
+ rlsAppRef : pointer;
+ rlsHandle : NXHandle_t;
+ rlsMandatory : NXBool_t;
+ rlsFlags : dword;
+ rlsTimeOut : dword;
+ rlsUpCall : NXLockUpCall_t;
+ rlsConflictLockVm : NXVmId_t;
+ rlsConflictLock : NXFileLockDesc_t;
+ rlsVecCount : longint;
+ rlsDescVec : PNXFileLockDesc_t;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ File I/O... }
+
+function NXClose(handle:NXHandle_t):longint;cdecl;external libc_nlm name 'NXClose';
+function NXFileAllocExtentWithHandle(fileHandle:NXHandle_t; offset:NXOffset_t; length:NXOffset_t; flags:dword):longint;cdecl;external libc_nlm name 'NXFileAllocExtentWithHandle';
+function NXFileCancelIo(async_id:NXAsyncId_t; wait:NXBool_t; status:PNXBool_t):longint;cdecl;external libc_nlm name 'NXFileCancelIo';
+function NXFileFlushBuffers(fileHandle:NXHandle_t; flags:dword; offset:NXOffset_t; length:NXOffset_t):longint;cdecl;external libc_nlm name 'NXFileFlushBuffers';
+
+function NXFileGetLength(pathCtx:NXPathCtx_t; pathname:pointer; length:PNXOffset_t):longint;cdecl;external libc_nlm name 'NXFileGetLength';
+function NXFileGetLengthWithHandle(fileHandle:NXHandle_t; length:PNXOffset_t):longint;cdecl;external libc_nlm name 'NXFileGetLengthWithHandle';
+
+function NXFileOpen(pathCtx:NXPathCtx_t; pathname:pointer; mode:NXMode_t; fileHandle:PNXHandle_t):longint;cdecl;external libc_nlm name 'NXFileOpen';
+function NXFileOpenEx(openSpec:PNXFileOpenSpec_t; fileHandle:PNXHandle_t):longint;cdecl;external libc_nlm name 'NXFileOpenEx';
+function NXFileRangeLock(fileHandle:NXHandle_t; flags:dword; offset:NXOffset_t; length:NXSOffset_t):longint;cdecl;external libc_nlm name 'NXFileRangeLock';
+function NXFileRangeLockEx(lockSpec:NXFileRangeLockSpec_t):longint;cdecl;external libc_nlm name 'NXFileRangeLockEx';
+function NXFileRangeUnlock(fileHandle:NXHandle_t; flags:dword; offset:NXOffset_t; length:NXSOffset_t):longint;cdecl;external libc_nlm name 'NXFileRangeUnlock';
+function NXFileRangeUnlockEx(lockSpec:NXFileRangeLockSpec_t):longint;cdecl;external libc_nlm name 'NXFileRangeUnlockEx';
+function NXFileRemoveWithHandle(handle:NXHandle_t):longint;cdecl;external libc_nlm name 'NXFileRemoveWithHandle';
+
+function NXFileRenameWithHandle(fileHandle:NXHandle_t; targetPathCtx:NXPathCtx_t; newname:pointer; overwrite:NXBool_t):longint;cdecl;external libc_nlm name 'NXFileRenameWithHandle';
+function NXFileSetLength(pathCtx:NXPathCtx_t; pathname:pointer; length:NXOffset_t; flags:dword):longint;cdecl;external libc_nlm name 'NXFileSetLength';
+function NXFileSetLengthWithHandle(fileHandle:NXHandle_t; length:NXOffset_t; flags:dword):longint;cdecl;external libc_nlm name 'NXFileSetLengthWithHandle';
+function NXRead(handle:NXHandle_t; offset:NXOffset_t; length:size_t; address:pointer; flags:dword;
+ bytesRead:Psize_t):longint;cdecl;external libc_nlm name 'NXRead';
+function NXReadEx(ioInfo:PNXIo_t; ioAsyncId:PNXAsyncId_t):longint;cdecl;external libc_nlm name 'NXReadEx';
+
+function NXRemove(pathCtx:NXPathCtx_t; pathname:pointer):longint;cdecl;external libc_nlm name 'NXRemove';
+
+
+function NXRename(sourcePathCtx:NXPathCtx_t; oldname:pointer; targetPathCtx:NXPathCtx_t; newname:pointer; overwrite:NXBool_t):longint;cdecl;external libc_nlm name 'NXRename';
+
+function NXWrite(handle:NXHandle_t; offset:NXOffset_t; length:size_t; address:pointer; flags:dword;
+ bytesWritten:Psize_t):longint;cdecl;external libc_nlm name 'NXWrite';
+function NXWriteEx(ioInfo:PNXIo_t; ioAsyncId:PNXAsyncId_t):longint;cdecl;external libc_nlm name 'NXWriteEx';
+{ Additional I/O (including FIFOs, devices, etc.)... }
+
+function NXDeviceOpen(pathCtx:NXPathCtx_t; name:pointer; mode:NXMode_t; shareMode:NXShareMode_t; flags:dword;
+ ioBlockSize:Psize_t; deviceHandle:PNXHandle_t):longint;cdecl;external libc_nlm name 'NXDeviceOpen';
+
+function NXFifoOpen(pathCtx:NXPathCtx_t; pathname:pointer; mode:NXMode_t; fifoSize:size_t; fifoHandle:PNXHandle_t):longint;cdecl;external libc_nlm name 'NXFifoOpen';
+function NXIoSetBlockingState(handle:NXHandle_t; blocking:NXBool_t):longint;cdecl;external libc_nlm name 'NXIoSetBlockingState';
+function NXIoGetOpenMode(handle:NXHandle_t; mode:PNXMode_t):longint;cdecl;external libc_nlm name 'NXIoGetOpenMode';
+
+
+function NXLinkCreate(srcPathCtx:NXPathCtx_t; source:pointer; tgtPathCtx:PNXPathCtx_t; target:pointer; _type:longint):longint;cdecl;external libc_nlm name 'NXLinkCreate';
+
+
+function NXLinkCreateSymbolic(srcPathCtx:NXPathCtx_t; linkname:pointer; target:pointer):longint;cdecl;external libc_nlm name 'NXLinkCreateSymbolic';
+{ macro for useful alias... }
+{ basic change bits for NXSetAttr()... }
+{ flag values for NXDirAttr_t and NXDeEnum_t, etc... }
+{ deEffectiveRights bits }
+
+{ turn on 1-byte packing... }
+
+ { basic change bits for NXSetAttr()... }
+
+ const
+ NX_DIRENT_EFFECTIVERIGHTS = $0000000000000001;
+ NX_DIRENT_FLAGS = $0000000000000002;
+ NX_DIRENT_OWNERID = $0000000000000004;
+ NX_DIRENT_CREATETIME = $0000000000000008;
+ NX_DIRENT_CHANGETIME = $0000000000000010;
+ NX_DIRENT_ACCESSTIME = $0000000000000020;
+ NX_DIRENT_MODIFYTIME = $0000000000000040;
+ NX_DIRENT_ATTRIBUTES = $0000000000000080;
+ NX_DIRENT_RESERVED1 = $0000000000000100;
+ NX_DIRENT_RESERVED2 = $0000000000000200;
+ NX_DIRENT_RESERVED3 = $0000000000000400;
+ NX_DIRENT_RESERVED4 = $0000000000000800;
+ { flag values for NXDirAttr_t and NXDeEnum_t, etc... }
+ NX_DEFLAGS_COMPRESSED = $00000001;
+ NX_DEFLAGS_ENCRYPTED = $00000002;
+ NX_DEFLAGS_TEMPORARY = $00000004;
+ NX_DEFLAGS_MIGRATED = $00000008;
+ NX_DEFLAGS_DELETED = $00000010;
+ NX_DEFLAGS_SPARSE = $00000020;
+ { deEffectiveRights bits }
+ NX_READ_EXISTING_FILE = $00000001;
+ NX_WRITE_EXISTING_FILE = $00000002;
+ NX_CREATE_NEW_ENTRY = $00000008;
+ NX_DELETE_EXISTING_ENTRY = $00000010;
+ NX_CHANGE_ACCESS_CONTROL = $00000020;
+ NX_SEE_FILES = $00000040;
+ NX_MODIFY_ENTRY = $00000080;
+ NX_SUPERVISOR_PRIVILEGES = $00000100;
+ NX_ACCESS_RIGHTS_MASK = $000001FB;
+
+
+
+type
+
+ PNXChangeBits_t = ^NXChangeBits_t;
+ NXChangeBits_t = Tuint64;
+ TNXChangeBits = NXChangeBits_t;
+ PNXChangeBits = PNXChangeBits_t;
+{ pathname format (PNF) enumeration }
+{ use PNF in effect at open }
+{ generic NKS pathname format }
+{ DOS }
+{ Macintosh/AFP 3.0 }
+{ UNIX/NFS }
+{ Windows NT, OS/2 }
+{ Novell Storage Services (NSS) }
+
+ PNXPathFormat_t = ^NXPathFormat_t;
+ NXPathFormat_t = Longint;
+ Const
+ NX_PNF_DEFAULT = 2147483647;
+ NX_PNF_NKS = 0;
+ NX_PNF_DOS = 1;
+ NX_PNF_MAC = 2;
+ NX_PNF_UNIX = 4;
+ NX_PNF_WIN = 5;
+ NX_PNF_NSS = 7;
+
+{ basic attribute information }
+{ filename }
+{ extended file system information }
+type
+
+ PNXDeLevel_t = ^NXDeLevel_t;
+ NXDeLevel_t = Longint;
+ Const
+ NX_DELEVEL_BASIC = $7FFFFFFF;
+ NX_DELEVEL_NAME_ONLY = $80000000;
+ NX_DELEVEL_EXTENDED = $80000001;
+
+{ marking place in directory enumeration }
+{ all private to implementation }
+type
+
+ PNXDirMark_t = ^NXDirMark_t;
+ NXDirMark_t = record
+ mark : array[0..43] of byte;
+ pathCtx : pointer;
+ entryInfo : pointer;
+ end;
+{ structure size is 52 bytes on NetWare }
+{ information common to all PNF structures }
+{ total length of entry including any }
+{ type of entry (file, FIFO, etc.) }
+{ file system yielding information }
+{ level specified in NXDirEnumStart() }
+
+ PNXDeHeader_t = ^NXDeHeader_t;
+ NXDeHeader_t = record
+ length : size_t;
+ objectType : NXObjType_t;
+ pathFormat : NXPathFormat_t;
+ infoLevel : NXDeLevel_t;
+ end;
+ PNXDeHeader = PNXDeHeader_t;
+ TNDDeHeader = NXDeHeader_t;
+{ common information }
+{ }
+{ length of file }
+{ compressed, sparse, encrypted, etc. }
+{ timestamp of last attribute change }
+{ timestamp of last write+attribute change }
+{ timestamp of last write }
+{ preferred I/O blocksize }
+
+ PNXDirAttr_t = ^NXDirAttr_t;
+ NXDirAttr_t = record
+ deHeader : NXDeHeader_t;
+ deFid : NXFid_t;
+ deEffectiveRights : dword;
+ deFileSize : NXOffset_t;
+ deFlags : Tuint64;
+ deAttrChangeTime : NXTime_t;
+ deAccessTime : NXTime_t;
+ deModifyTime : NXTime_t;
+ deIoBlockSize : size_t;
+ end;
+{ plus name }
+
+ PNXDirAttrWithName_t = ^NXDirAttrWithName_t;
+ NXDirAttrWithName_t = record
+ deHeader : NXDeHeader_t;
+ deName : pointer;
+ end;
+{ information fields }
+{ NXDirEnum- navigational mark }
+
+ PNXDirEnum_t = ^NXDirEnum_t;
+ NXDirEnum_t = record
+ deDirAttr : NXDirAttr_t;
+ deDirMark : NXDirMark_t;
+ deName : pointer;
+ end;
+{ generic NKS (NX_PNF_NKS) attributes }
+
+ PNXDirAttrNks_t = ^NXDirAttrNks_t;
+ NXDirAttrNks_t = record
+ xdeHeader : NXDeHeader_t;
+ xdeFid : NXFid_t;
+ xdeEffectiveRights : dword;
+ xdeFileSize : NXOffset_t;
+ xdeFlags : Tuint64;
+ xdeChangeTime : NXTime_t;
+ xdeAccessTime : NXTime_t;
+ xdeModifyTime : NXTime_t;
+ xdeCreateTime : NXTime_t;
+ xdeOwnerId : NXGuid_t;
+ end;
+{ generic NKS (NX_PNF_NKS) information... }
+{ ...including name }
+
+ PNXDirEnumNks_t = ^NXDirEnumNks_t;
+ NXDirEnumNks_t = record
+ deNksDirAttr : NXDirAttrNks_t;
+ deDirMark : NXDirMark_t;
+ deName : pointer;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ Path context... }
+
+function NXFreePathContext(pathCtx:NXPathCtx_t):longint;cdecl;external libc_nlm name 'NXFreePathContext';
+
+function NXCreatePathContext(pathCtx:NXPathCtx_t; pathname:pchar; format:NXPathFormat_t; securityBadge:pointer; newPathCtx:PNXPathCtx_t):longint;cdecl;external libc_nlm name 'NXCreatePathContext';
+function NXCreatePathContext(pathCtx:NXPathCtx_t; pathname:pchar; format:NXPathFormat_t; securityBadge:pointer; var newPathCtx:NXPathCtx_t):longint;cdecl;external libc_nlm name 'NXCreatePathContext';
+function NXCreatePathContextWithFid(fid:NXFid_t; format:NXPathFormat_t; securityBadge:pointer; newPathCtx:PNXPathCtx_t):longint;cdecl;external libc_nlm name 'NXCreatePathContextWithFid';
+{ Directory I/O... }
+
+function NXDirCreate(pathCtx:NXPathCtx_t; pathname:pointer; reserved:pointer; newPathCtx:PNXPathCtx_t):longint;cdecl;external libc_nlm name 'NXDirCreate';
+
+function NXDirRemove(pathCtx:NXPathCtx_t; pathname:pointer):longint;cdecl;external libc_nlm name 'NXDirRemove';
+{ Directory entry attributes... }
+
+function NXGetAttr(pathCtx:NXPathCtx_t; pathname:pointer; level:NXDeLevel_t; buffer:pointer; length:size_t;
+ flags:dword):longint;cdecl;external libc_nlm name 'NXGetAttr';
+function NXGetAttrWithHandle(handle:NXHandle_t; format:NXPathFormat_t; level:NXDeLevel_t; buffer:pointer; length:size_t;
+ flags:dword):longint;cdecl;external libc_nlm name 'NXGetAttrWithHandle';
+
+
+function NXSetAttr(pathCtx:NXPathCtx_t; pathname:pointer; level:NXDeLevel_t; buffer:pointer; changeBits:NXChangeBits_t):longint;cdecl;external libc_nlm name 'NXSetAttr';
+
+function NXSetAttrWithHandle(handle:NXHandle_t; format:NXPathFormat_t; level:NXDeLevel_t; buffer:pointer; changeBits:NXChangeBits_t):longint;cdecl;external libc_nlm name 'NXSetAttrWithHandle';
+{ Subdirectory enumeration... }
+function NXDirMarkInit(handle:NXHandle_t; dirMark:PNXDirMark_t):longint;cdecl;external libc_nlm name 'NXDirMarkInit';
+function NXDirMarkInit(handle:NXHandle_t; var dirMark:NXDirMark_t):longint;cdecl;external libc_nlm name 'NXDirMarkInit';
+function NXDirEnumEnd(handle:NXHandle_t):longint;cdecl;external libc_nlm name 'NXDirEnumEnd';
+function NXDirEnumGetEntries(handle:NXHandle_t; start:PNXDirMark_t; buffer:pointer; length:size_t; entriesReturned:Psize_t;
+ next:PNXDirMark_t; sequenceGuarantee:PNXBool_t):longint;cdecl;external libc_nlm name 'NXDirEnumGetEntries';
+
+function NXDirEnumStart(pathCtx:NXPathCtx_t; pathname:pchar; level:NXDeLevel_t; handle:PNXHandle_t):longint;cdecl;external libc_nlm name 'NXDirEnumStart';
+function NXDirEnumStart(pathCtx:NXPathCtx_t; pathname:pchar; level:NXDeLevel_t; var handle:NXHandle_t):longint;cdecl;external libc_nlm name 'NXDirEnumStart';
+
+
+// nks/doswin.h
+// wchar.h
+{ turn on 1-byte packing... }
+
+type
+
+ Pwint_t = ^wint_t;
+ wint_t = longint;
+
+ Pwuchar_t = ^wuchar_t;
+ wuchar_t = word;
+
+ Pmbstate_t = ^mbstate_t;
+ mbstate_t = longint;
+
+(** unsupported pragma#pragma pack()*)
+
+
+function mbsrtowcs(__restrict:Pwchar_t; __restrict1:PPchar; _para3:size_t; __restrict2:Pmbstate_t):size_t;cdecl;external libc_nlm name 'mbsrtowcs';
+
+{$ifndef DisableArrayOfConst}
+function fwprintf(__restrict:P_iobuf; __restrict1:Pwchar_t; args:array of const):longint;cdecl;external libc_nlm name 'fwprintf';
+{$endif}
+function fwprintf(__restrict:P_iobuf; __restrict1:Pwchar_t):longint;cdecl;external libc_nlm name 'fwprintf';
+
+{$ifndef DisableArrayOfConst}
+function fwscanf(__restrict:P_iobuf; __restrict1:Pwchar_t; args:array of const):longint;cdecl;external libc_nlm name 'fwscanf';
+{$endif}
+function fwscanf(__restrict:P_iobuf; __restrict1:Pwchar_t):longint;cdecl;external libc_nlm name 'fwscanf';
+
+{$ifndef DisableArrayOfConst}
+function swprintf(__restrict:Pwchar_t; _para2:size_t; __restrict1:Pwchar_t; args:array of const):longint;cdecl;external libc_nlm name 'swprintf';
+{$endif}
+function swprintf(__restrict:Pwchar_t; _para2:size_t; __restrict1:Pwchar_t):longint;cdecl;external libc_nlm name 'swprintf';
+
+{$ifndef DisableArrayOfConst}
+function swscanf(__restrict:Pwchar_t; __restrict1:Pwchar_t; args:array of const):longint;cdecl;external libc_nlm name 'swscanf';
+{$endif}
+function swscanf(__restrict:Pwchar_t; __restrict1:Pwchar_t):longint;cdecl;external libc_nlm name 'swscanf';
+
+function vfwprintf(__restrict:P_iobuf; __restrict1:Pwchar_t; _para3:va_list):longint;cdecl;external libc_nlm name 'vfwprintf';
+
+function vfwscanf(_para1:P_iobuf; _para2:Pwchar_t; _para3:va_list):longint;cdecl;external libc_nlm name 'vfwscanf';
+
+function vwscanf(_para1:Pwchar_t; _para2:va_list):longint;cdecl;external libc_nlm name 'vwscanf';
+function vswscanf(_para1:Pwchar_t; _para2:Pwchar_t; _para3:va_list):longint;cdecl;external libc_nlm name 'vswscanf';
+function wcrtomb(__restrict:Pchar; _para2:wchar_t; __restrict1:Pmbstate_t):size_t;cdecl;external libc_nlm name 'wcrtomb';
+function wcscat(__restrict:Pwchar_t; __restrict1:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcscat';
+function wcschr(_para1:Pwchar_t; _para2:wchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcschr';
+function wcscmp(_para1:Pwchar_t; _para2:Pwchar_t):longint;cdecl;external libc_nlm name 'wcscmp';
+function wcscoll(_para1:Pwchar_t; _para2:Pwchar_t):longint;cdecl;external libc_nlm name 'wcscoll';
+function wcscpy(__restrict:Pwchar_t; __restrict1:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcscpy';
+function wcscspn(_para1:Pwchar_t; _para2:Pwchar_t):size_t;cdecl;external libc_nlm name 'wcscspn';
+function wcsftime(__restrict:Pwchar_t; _para2:size_t; __restrict1:Pwchar_t; __restrict2:Ptm):size_t;cdecl;external libc_nlm name 'wcsftime';
+function wcslen(_para1:Pwchar_t):size_t;cdecl;external libc_nlm name 'wcslen';
+function wcsncat(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wcsncat';
+function wcsncmp(_para1:Pwchar_t; _para2:Pwchar_t; _para3:size_t):longint;cdecl;external libc_nlm name 'wcsncmp';
+function wcsncpy(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wcsncpy';
+function wcspbrk(_para1:Pwchar_t; _para2:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcspbrk';
+function wcsrchr(_para1:Pwchar_t; _para2:wchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcsrchr';
+function wcsrtombs(__restrict:Pchar; __restrict1:PPwchar_t; _para3:size_t; __restrict2:Pmbstate_t):size_t;cdecl;external libc_nlm name 'wcsrtombs';
+function wcsspn(_para1:Pwchar_t; _para2:Pwchar_t):size_t;cdecl;external libc_nlm name 'wcsspn';
+function wcsstr(_para1:Pwchar_t; _para2:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcsstr';
+function wcstod(__restrict:Pwchar_t; __restrict1:PPwchar_t):double;cdecl;external libc_nlm name 'wcstod';
+function wcstof(__restrict:Pwchar_t; __restrict1:PPwchar_t):double;cdecl;external libc_nlm name 'wcstof';
+function wcstok(__restrict:Pwchar_t; __restrict1:Pwchar_t; __restrict2:PPwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcstok';
+function wcstok_r(__restrict:Pwchar_t; __restrict1:Pwchar_t; __restrict2:PPwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcstok_r';
+function wcstol(__restrict:Pwchar_t; __restrict1:PPwchar_t; xx:longint):longint;cdecl;external libc_nlm name 'wcstol';
+
+// long double wcstold(const wchar_t * __restrict1, wchar_t ** __restrict);
+// long double wcstold(const wchar_t * __restrict1, wchar_t ** __restrict);
+
+function wcstoll(__restrict:Pwchar_t; __restrict1:PPwchar_t; xx:longint):Tint64;cdecl;external libc_nlm name 'wcstoll';
+function wcstoul(__restrict:Pwchar_t; __restrict1:PPwchar_t; _para3:longint):dword;cdecl;external libc_nlm name 'wcstoul';
+function wcstoull(__restrict:Pwchar_t; __restrict1:PPwchar_t; _para3:longint):Tuint64;cdecl;external libc_nlm name 'wcstoull';
+function wcsxfrm(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):size_t;cdecl;external libc_nlm name 'wcsxfrm';
+function wctob(_para1:wint_t):longint;cdecl;external libc_nlm name 'wctob';
+function wmemchr(ws:Pwchar_t; wc:wchar_t; n:size_t):Pwchar_t;cdecl;external libc_nlm name 'wmemchr';
+function wmemcmp(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):longint;cdecl;external libc_nlm name 'wmemcmp';
+function wmemcpy(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wmemcpy';
+function wmemmove(_para1:Pwchar_t; _para2:Pwchar_t; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wmemmove';
+function wmemset(ws:Pwchar_t; wc:wchar_t; n:size_t):Pwchar_t;cdecl;external libc_nlm name 'wmemset';
+function putwc(_para1:wchar_t; _para2:P_iobuf):wint_t;cdecl;external libc_nlm name 'putwc';
+function putwchar(_para1:wchar_t):wint_t;cdecl;external libc_nlm name 'putwchar';
+function fwide(_para1:P_iobuf; _para2:longint):longint;cdecl;external libc_nlm name 'fwide';
+function fputwc(_para1:wchar_t; _para2:P_iobuf):wint_t;cdecl;external libc_nlm name 'fputwc';
+function fputws(__restrict:Pwchar_t; __restrict1:P_iobuf):longint;cdecl;external libc_nlm name 'fputws';
+function fgetwc(_para1:P_iobuf):wint_t;cdecl;external libc_nlm name 'fgetwc';
+function fgetws(__restrict:Pwchar_t; _para2:longint; __restrict1:P_iobuf):Pwchar_t;cdecl;external libc_nlm name 'fgetws';
+function getwc(_para1:P_iobuf):wint_t;cdecl;external libc_nlm name 'getwc';
+function getwchar:wint_t;cdecl;external libc_nlm name 'getwchar';
+function ungetwc(_para1:wint_t; __restrict:P_iobuf):wint_t;cdecl;external libc_nlm name 'ungetwc';
+
+{$ifndef DisableArrayOfConst}
+function wprintf(__restrict:Pwchar_t; args:array of const):longint;cdecl;external libc_nlm name 'wprintf';
+{$endif}
+function wprintf(__restrict:Pwchar_t):longint;cdecl;external libc_nlm name 'wprintf';
+
+{$ifndef DisableArrayOfConst}
+function wscanf(__restrict:Pwchar_t; args:array of const):longint;cdecl;external libc_nlm name 'wscanf';
+{$endif}
+function wscanf(__restrict:Pwchar_t):longint;cdecl;external libc_nlm name 'wscanf';
+function vwprintf(__restrict:Pwchar_t; _para2:va_list):longint;cdecl;external libc_nlm name 'vwprintf';
+function vswprintf(__restrict:Pwchar_t; _para2:size_t; __restrict1:Pwchar_t; _para4:va_list):longint;cdecl;external libc_nlm name 'vswprintf';
+function wcscasecmp(_para1:Pwchar_t; _para2:Pwchar_t):longint;cdecl;external libc_nlm name 'wcscasecmp';
+function wcserror(_para1:longint):Pwchar_t;cdecl;external libc_nlm name 'wcserror';
+function wcsicmp(_para1:Pwchar_t; _para2:Pwchar_t):longint;cdecl;external libc_nlm name 'wcsicmp';
+function wcsindex(_para1:Pwchar_t; _para2:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcsindex';
+
+{$ifndef DisableArrayOfConst}
+function wcslist(_para1:Pwchar_t; _para2:Pwchar_t; args:array of const):Pwchar_t;cdecl;external libc_nlm name 'wcslist';
+{$endif}
+function wcslist(_para1:Pwchar_t; _para2:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcslist';
+function wcslwr(_para1:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcslwr';
+function wcsmemcmp(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):longint;cdecl;external libc_nlm name 'wcsmemcmp';
+function wcsmemcpy(__restrict:Pwchar_t; __restrict1:Pwchar_t; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wcsmemcpy';
+function wcsmemmove(_para1:Pwchar_t; _para2:Pwchar_t; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wcsmemmove';
+function wcsncasecmp(_para1:Pwchar_t; _para2:Pwchar_t; _para3:size_t):longint;cdecl;external libc_nlm name 'wcsncasecmp';
+function wcsnicmp(_para1:Pwchar_t; _para2:Pwchar_t; _para3:size_t):longint;cdecl;external libc_nlm name 'wcsnicmp';
+function wcsnset(_para1:Pwchar_t; _para2:longint; _para3:size_t):Pwchar_t;cdecl;external libc_nlm name 'wcsnset';
+function wcsrev(_para1:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcsrev';
+function wcsrindex(_para1:Pwchar_t; _para2:size_t; _para3:longint):Pwchar_t;cdecl;external libc_nlm name 'wcsrindex';
+function wcsset(_para1:Pwchar_t; _para2:longint):Pwchar_t;cdecl;external libc_nlm name 'wcsset';
+function wcsupr(_para1:Pwchar_t):Pwchar_t;cdecl;external libc_nlm name 'wcsupr';
+procedure wungettok(__restrict:Pwchar_t; __restrict1:Pwchar_t; __restrict2:PPwchar_t);cdecl;external libc_nlm name 'wungettok';
+procedure wungettok_r(__restrict:Pwchar_t; __restrict1:Pwchar_t; __restrict2:PPwchar_t);cdecl;external libc_nlm name 'wungettok_r';
+function btowc(_para1:longint):wint_t;cdecl;external libc_nlm name 'btowc';
+function mbrlen(__restrict:Pchar; _para2:size_t; __restrict1:Pmbstate_t):longint;cdecl;external libc_nlm name 'mbrlen';
+function mbrtowc(__restrict:Pwchar_t; __restrict1:Pchar; _para3:size_t; __restrict2:Pmbstate_t):longint;cdecl;external libc_nlm name 'mbrtowc';
+function mbsinit(_para1:Pmbstate_t):longint;cdecl;external libc_nlm name 'mbsinit';
+function wcwidth(_para1:wchar_t):longint;cdecl;external libc_nlm name 'wcwidth';
+function wcswidth(_para1:Pwchar_t; _para2:size_t):longint;cdecl;external libc_nlm name 'wcswidth';
+{ macros that overcome implementation's function call overhead... }
+{ attributes for NXDirAttrDos_t 'attrib' field... }
+
+
+// fsio.h
+// netware.h
+ const
+ LD_MODULE_REENTRANT_BIT = $00000001;
+ LD_MODULE_MULTIPLE_LOAD = $00000002; { multiple load }
+ LD_SYNCHRONIZE_START = $00000004; { uses SynchronizeStart() }
+ LD_PSEUDOPREEMPTION_BIT = $00000008; { accept preemption }
+ LD_KERNEL_LOAD = $00000010; { ring 0-only }
+ LD_DONT_SHARE_CODE = $00000020;
+ { once dependencies gone }
+ LD_AUTO_UNLOAD = $00000040;
+ LD_HIDDEN_MODULE = $00000080;
+ LD_DIGITALLY_SIGNED_FILE = $00000100;
+ LD_PROTECTED_LOAD = $00000200; { protected address space }
+ LD_SHARED_LIBRARY = $00000400;
+ LD_RESTARTABLE = $00000800;
+ LD_MODULE_HAS_MPK_STUBS = $00001000;
+ LD_NOT_MULTIPROCESSOR_SAFE = $00002000;
+ LD_PREEMPTABLE = $00004000;
+ LD_HAS_SYSTEM_CALLS = $00008000;
+ LD_VIRTUAL_MEMORY = $00010000;
+ LD_ALL_EXPORTS_SAFE = $00020000;
+ LD_RESERVED_1 = $00040000;
+ LD_RESERVED_2 = $00080000;
+ LD_RESERVED_3 = $00100000;
+ LD_RESERVED_4 = $00200000;
+ LD_WANT_POSIX_SEMANTICS = $00400000; { assume POSIX semantics }
+ LD_UTF8_STRINGS = $00800000; { UTF-8 strings }
+ LD_TSR = $01000000; { terminate-stay-resident }
+ LD_PROMPT_USER_AND_PASSWORD = $02000000; { with LD_WANT_POSIX... }
+ LD_HOTSWAP_DRIVER = $04000000;
+ LD_STARTUP_DEVICE_NLM_BIT = $08000000;
+ LD_BOUND_NLM_BIT = $10000000;
+ LD_DONT_UNLOAD_BIT = $20000000; { never unload }
+ LD_MODULE_BEING_DEBUGGED = $40000000; { (debugging) }
+ LD_MEMORY_ON_4K_BOUNDRIES_BIT = $80000000; { (debugging) }
+ { Note LD_UNICODE_STRINGS mostly obsolete--used only by NKS applications: }
+ LD_UNICODE_STRINGS = $02000000; { Unicode strings }
+
+
+type
+ Prtag_t = ^rtag_t;
+ rtag_t = pointer;
+ Trtag = rtag_t;
+ Prtag = Prtag_t;
+
+ {this is from the lan driver sdk () cmsm.h
+
+ but be warned, like the ScanScreen function available in
+ clib, there is no MP save way to access netware screens, a
+ comment from Russell Bateman (libc developer @ novell) dated
+ way to do screen discovery on NetWare. }
+
+ PScreenStruct = ^TScreenStruct;
+ TScreenStruct = packed record
+ previousScreen : PScreenStruct;
+ nextScreen : PScreenStruct;
+ popUpOriginalScreen : PScreenStruct;
+ CLIBScreenStructure : pdword;
+ currentPalette : byte;
+ _Filler1 : byte;
+ popUpCount : byte;
+ _Filler2 : byte;
+ screenList : byte;
+ _Filler3 : byte;
+ activeCount : byte;
+ _Filler4 : byte;
+ resourceTag : Prtag_t;
+ screenName : pchar;
+ screenMemory : pointer;
+ flags : dword;
+ state : dword;
+ outputCursorPosition : word;
+ inputCursorPosition : word;
+ end;
+
+ Pscr_t = ^scr_t;
+ scr_t = PScreenStruct;
+ TScr = scr_t;
+ PScr = Pscr_t;
+
+// event.h
+// screen.h
+
+ const
+ MAX_SCREEN_STRING_LEN = 255;
+ { screen mode flags... }
+ SCR_NO_MODE = $00000000;
+ SCR_AUTOCLOSE_ON_EXIT = $00000001; // default
+ SCR_COLOR_ATTRS = $00000002;
+ { key types... }
+ NORMAL_KEY = $00;
+ FUNCTION_KEY = $01;
+ ENTER_KEY = $02;
+ ESCAPE_KEY = $03;
+ BACKSPACE_KEY = $04;
+ DELETE_KEY = $05;
+ INSERT_KEY = $06;
+ CURSOR_UP_KEY = $07;
+ CURSOR_DOWN_KEY = $08;
+ CURSOR_RIGHT_KEY = $09;
+ CURSOR_LEFT_KEY = $0A;
+ CURSOR_HOME_KEY = $0B;
+ CURSOR_END_KEY = $0C;
+ CURSOR_PUP_KEY = $0D;
+ CURSOR_PDOWN_KEY = $0E;
+ { some name equivalents... }
+ ENTER = $0D;
+ ESCAPE = $1B;
+ BACKSPACE = $08;
+ { modifier code constituents... }
+ SHIFT_KEY_HELD = $01;
+ CTRL_KEY_HELD = $04;
+ ALT_KEY_HELD = $08;
+ CAPS_LOCK_IS_ON = $40;
+ NUM_LOCK_IS_ON = $20;
+ SCROLL_LOCK_IS_ON = $10;
+ _PASSWORD_LEN = 128; // suggested 'maxlen' argument for getpassword()...
+ { string-embeddable color representations... }
+ COLOR_STR_BLACK = '\x1B[0;30m';
+ COLOR_STR_MAROON = '\x1B[0;31m';
+ COLOR_STR_GREEN = '\x1B[0;32m';
+ COLOR_STR_OLIVE = '\x1B[0;33m';
+ COLOR_STR_NAVY = '\x1B[0;34m';
+ COLOR_STR_PURPLE = '\x1B[0;35m';
+ COLOR_STR_TEAL = '\x1B[0;36m';
+ COLOR_STR_SILVER = '\x1B[0;37m';
+ COLOR_STR_GREY = '\x1B[1;30m';
+ COLOR_STR_RED = '\x1B[1;31m';
+ COLOR_STR_LIME = '\x1B[1;32m';
+ COLOR_STR_YELLOW = '\x1B[1;33m';
+ COLOR_STR_BLUE = '\x1B[1;34m';
+ COLOR_STR_MAGENTA = '\x1B[1;35m';
+ COLOR_STR_CYAN = '\x1B[1;36m';
+ COLOR_STR_WHITE = '\x1B[1;37m';
+
+ COLOR_STR_NORMAL = COLOR_STR_SILVER; // dim/unhighlighted white
+ COLOR_STR_GRAY = COLOR_STR_GREY;
+ { attributes for OutputToScreenWithAttributes(); cf. HTML color names }
+
+ COLOR_ATTR_NONE = 0; // black, no color at all
+ COLOR_ATTR_NAVY = 1; // dim blue
+ COLOR_ATTR_BLUE = $01 or 8;
+ COLOR_ATTR_GREEN = 2;
+ COLOR_ATTR_LIME = 2 or 8; // bright green
+ COLOR_ATTR_TEAL = 3; // dim cyan
+ COLOR_ATTR_CYAN = 3 or 8;
+ COLOR_ATTR_MAROON = 4; // dim red
+ COLOR_ATTR_RED = 4 or 8;
+ COLOR_ATTR_PURPLE = 5;
+ COLOR_ATTR_MAGENTA= 5 or 8; // bright purple
+ COLOR_ATTR_OLIVE = 6; // brown, dim yellow
+ COLOR_ATTR_YELLOW = 6 or 8;
+ COLOR_ATTR_SILVER = 7; // normal white, dim/unhighlighted
+ COLOR_ATTR_GREY = 8; // dimmed white
+ COLOR_ATTR_WHITE = 15; // bright, highlighted white
+
+ const
+// OutputToScreenWithVaList = OutputToScreenWithPointer;
+ { return and default values for Prompt functions... }
+ SCR_PROMPT_ANSWER_NO = 0;
+ SCR_PROMPT_ANSWER_YES = 1;
+ SCR_PROMPT_ANSWER_SKIP = 2;
+ SCR_PROMPT_ANSWER_ALL = 3;
+
+ { cursor types... }
+ CURSOR_NORMAL = $0C0B;
+ CURSOR_THICK = $0C09;
+ CURSOR_BLOCK = $0C00;
+ CURSOR_TOP = $0400;
+ { screen types... }
+ SCREEN_TYPE_TTY = $00000000;
+ SCREEN_TYPE_MONOCHROME = $00000001;
+ SCREEN_TYPE_DUAL_MODE = $00000002;
+ SCREEN_TYPE_CGA = $00000003;
+ SCREEN_TYPE_EGA = $00000004;
+ SCREEN_TYPE_VGA = $00000005;
+ { screen modes... }
+ SCREEN_MODE_TTY = $00000000;
+ SCREEN_MODE_80X25 = $00000001;
+ SCREEN_MODE_80X43 = $00000002;
+ SCREEN_MODE_80X50 = $00000003;
+ SCREEN_MODE_D = $0000000D;
+ SCREEN_MODE_E = $0000000E;
+ SCREEN_MODE_F = $0000000F;
+ SCREEN_MODE_10 = $00000010;
+ SCREEN_MODE_11 = $00000011;
+ SCREEN_MODE_12 = $00000012;
+ SCREEN_MODE_13 = $00000013;
+ { voracious for memory! }
+ SCREEN_MODE_SCROLLABLE = $80000000;
+ { screen state... }
+ SCREEN_NON_SWITCHABLE = $00000001;
+ SCREEN_DUMMY = $00000100;
+ SCREEN_HIDDEN = $00000200;
+
+procedure clearscreen;cdecl;external libc_nlm name 'clearscreen';
+
+{$ifndef DisableArrayOfConst}
+function consoleprintf(txt:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'consoleprintf';
+function consoleprintf(txt:Pchar):longint;cdecl;external libc_nlm name 'consoleprintf';
+{$endif}
+function __consoleprintfl1(txt:Pchar;p1:longint):longint;cdecl;external libc_nlm name 'consoleprintf';
+function __consoleprintfl2(txt:Pchar;p1,p2:longint):longint;cdecl;external libc_nlm name 'consoleprintf';
+function __consoleprintfl3(txt:Pchar;p1,p2,p3:longint):longint;cdecl;external libc_nlm name 'consoleprintf';
+function getscreenmode(mode:Pdword):longint;cdecl;external libc_nlm name 'getscreenmode';
+function getscreenmode(var mode:dword):longint;cdecl;external libc_nlm name 'getscreenmode';
+function getcharacter:longint;cdecl;external libc_nlm name 'getcharacter';
+function getkey(keytype,modifer,scancode:Plongint):longint;cdecl;external libc_nlm name 'getkey';
+function getkey(var keytype, modifer, scancode:longint):longint;cdecl;external libc_nlm name 'getkey';
+function getalternateconsole:scr_t;cdecl;external libc_nlm name 'getalternateconsole';
+function getnetwareconsole:scr_t;cdecl;external libc_nlm name 'getnetwareconsole';
+function getnetwarelogger:scr_t;cdecl;external libc_nlm name 'getnetwarelogger';
+
+function getpassword(prompt,password:Pchar; maxlen:size_t):Pchar;cdecl;external libc_nlm name 'getpassword';
+function getscreenhandle:scr_t;cdecl;external libc_nlm name 'getscreenhandle';
+function getstring(_string:Pchar; max:size_t; display:longint):Pchar;cdecl;external libc_nlm name 'getstring';
+function gotorowcol(row, col:longint):longint;cdecl;external libc_nlm name 'gotorowcol';
+function kbhit:longint;cdecl;external libc_nlm name 'kbhit';
+function pressanykey:longint;cdecl;external libc_nlm name 'pressanykey';
+function pressanykeytocontinue:longint;cdecl;external libc_nlm name 'pressanykey';
+function pressescape:longint;cdecl;external libc_nlm name 'pressescape';
+function pressenter:longint;cdecl;external libc_nlm name 'pressenter';
+function putcharacter(ch:longint):longint;cdecl;external libc_nlm name 'putcharacter';
+
+function putstring(_string:Pchar):longint;cdecl;external libc_nlm name 'putstring';
+
+{$ifndef DisableArrayOfConst}
+function screenprintf(_para1:scr_t; _para2:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'screenprintf';
+{$endif}
+function screenprintf(_para1:scr_t; _para2:Pchar):longint;cdecl;external libc_nlm name 'screenprintf';
+function screenprintf(_para1:scr_t; _para2:Pchar; l1:longint):longint;cdecl;external libc_nlm name 'screenprintf';
+function screenprintf(_para1:scr_t; _para2:Pchar; l1,l2:longint):longint;cdecl;external libc_nlm name 'screenprintf';
+function screenprintf(_para1:scr_t; _para2:Pchar; l1,l2,l3:longint):longint;cdecl;external libc_nlm name 'screenprintf';
+
+function setscreenmode(mode:dword):longint;cdecl;external libc_nlm name 'setscreenmode';
+
+function renamescreen(name:Pchar):longint;cdecl;external libc_nlm name 'renamescreen';
+procedure ringbell;cdecl;external libc_nlm name 'ringbell';
+function ungetcharacter(ch:longint):longint;cdecl;external libc_nlm name 'ungetcharacter';
+function ungetkey(keytype:longint; modifer:longint; scancode:longint):longint;cdecl;external libc_nlm name 'ungetkey';
+
+function vconsoleprintf(_para1:Pchar; _para2:va_list):longint;cdecl;external libc_nlm name 'vconsoleprintf';
+
+function vscreenprintf(_para1:scr_t; _para2:Pchar; _para3:va_list):longint;cdecl;external libc_nlm name 'vscreenprintf';
+function wherecol:longint;cdecl;external libc_nlm name 'wherecol';
+function whererow:longint;cdecl;external libc_nlm name 'whererow';
+function whererowcol(row,col:Plongint):longint;cdecl;external libc_nlm name 'whererowcol';
+function whererowcol(var row,col:longint):longint;cdecl;external libc_nlm name 'whererowcol';
+{ obsolete... }
+function getconsolehandle:scr_t;cdecl;external libc_nlm name 'getconsolehandle';
+{ direct NetWare OS interfaces... }
+type
+
+ Pscroll_t = ^scroll_t;
+ scroll_t = Longint;
+ Const
+ SCROLL_DOWN = 0;
+ SCROLL_UP = 1;
+ SCROLL_NONE = 2147483647;
+
+
+procedure ActivatePopUpScreen(scrID:scr_t);cdecl;external libc_nlm name 'ActivatePopUpScreen';
+procedure ActivateScreen(scrID:scr_t);cdecl;external libc_nlm name 'ActivateScreen';
+procedure ChangeToSystemConsoleScreen;cdecl;external libc_nlm name 'ChangeToSystemConsoleScreen';
+function CheckIfScreenActive(scrID:scr_t; waitFlag:dword):longint;cdecl;external libc_nlm name 'CheckIfScreenActive';
+function CheckKeyStatus(scrID:scr_t):longint;cdecl;external libc_nlm name 'CheckKeyStatus';
+procedure ClearScreen(scrID:scr_t);cdecl;external libc_nlm name 'ClearScreen';
+procedure CloseScreen(scrID:scr_t);cdecl;external libc_nlm name 'CloseScreen';
+procedure ConsoleHungMenu;cdecl;external libc_nlm name 'ConsoleHungMenu';
+procedure DisableInputCursor(scrID:scr_t);cdecl;external libc_nlm name 'DisableInputCursor';
+function DisplayScreenLine(scrID:scr_t; line:dword; col:dword; length:dword; textAndAttr:Pbyte):longint;cdecl;external libc_nlm name 'DisplayScreenLine';
+function DisplayScreenText(scrID:scr_t; line:dword; col:dword; length:dword; text:Pchar):longint;cdecl;external libc_nlm name 'DisplayScreenText';
+function DisplayScreenTextWithAttribute(scrID:scr_t; line:dword; col:dword; length:dword; lineAttr:byte;
+ text:Pchar):longint;cdecl;external libc_nlm name 'DisplayScreenTextWithAttribute';
+procedure EnableInputCursor(scrID:scr_t);cdecl;external libc_nlm name 'EnableInputCursor';
+procedure EndPopUpScreen(scr:scr_t);cdecl;external libc_nlm name 'EndPopUpScreen';
+function FillScreenArea(scrID:scr_t; line:dword; col:dword; height:dword; width:dword;
+ character:char; attr:byte):longint;cdecl;external libc_nlm name 'FillScreenArea';
+function FillScreenAreaAttribute(scrID:scr_t; line:dword; col:dword; height:dword; width:dword;
+ attr:byte):longint;cdecl;external libc_nlm name 'FillScreenAreaAttribute';
+function GetActiveScreen:scr_t;cdecl;external system_nlm name 'GetActiveScreen';
+function GetActualScreenSize(scrID:scr_t; height:Pdword; width:Pdword; bufferSize:Psize_t):longint;cdecl;external system_nlm name 'GetActualScreenSize';
+function GetConsoleSecuredFlag:longint;cdecl;external libc_nlm name 'GetConsoleSecuredFlag';
+procedure GetCursorStyle(scrID:scr_t; cursorStyle:Pword);cdecl;external system_nlm name 'GetCursorStyle';
+procedure GetCursorStyle(scrID:scr_t; var cursorStyle:word);cdecl;external system_nlm name 'GetCursorStyle';
+procedure GetInputCursorPosition(scrID:scr_t; row:Pword; col:Pword);cdecl;external system_nlm name 'GetInputCursorPosition';
+procedure GetKey(scrID:scr_t; _type,value,status,scancode:Pbyte;linesToProtect:size_t);cdecl;external system_nlm name 'GetKey';
+procedure GetKey(scrID:scr_t; var _type,value,status,scancode:byte;linesToProtect:size_t);cdecl;external system_nlm name 'GetKey';
+procedure GetOutputCursorPosition(scrID:scr_t; row,col:Pword);cdecl;external system_nlm name 'GetOutputCursorPosition';
+procedure GetOutputCursorPosition(scrID:scr_t; var row,col:word);cdecl;external system_nlm name 'GetOutputCursorPosition';
+function GetRawKeyWithScreen(scrID:scr_t; _type,value,status,scancode:Pbyte):longint;cdecl;external libc_nlm name 'GetRawKeyWithScreen';
+function GetRawKeyWithScreen(scrID:scr_t; var _type,value,status,scancode:byte):longint;cdecl;external libc_nlm name 'GetRawKeyWithScreen';
+function GetScreenAddress:pointer;cdecl;external system_nlm name 'GetScreenAddress'; // not in protected mode
+function GetScreenName(scrID:scr_t; nameBuffer:Pchar):longint;cdecl;external system_nlm name 'GetScreenName';
+function GetScreenPhysicalAddress:pointer;cdecl;external libc_nlm name 'GetScreenPhysicalAddress';
+procedure GetScreenSize(height,width:Pword);cdecl;external system_nlm name 'GetScreenSize';
+procedure GetScreenSize(var height,width:word);cdecl;external system_nlm name 'GetScreenSize';
+
+{$ifndef DisableArrayOfConst}
+function InputFromScreen(scrID:scr_t; allowedCharacterSet:Pchar; bufferLength:size_t; editWidth:size_t; buffer:Pchar;
+ linesToProtect:longint; hasDefaultString:longint; defaultString:Pchar; promptText:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'InputFromScreen';
+{$endif}
+function InputFromScreen(scrID:scr_t; allowedCharacterSet:Pchar; bufferLength:size_t; editWidth:size_t; buffer:Pchar;
+ linesToProtect:longint; hasDefaultString:longint; defaultString:Pchar; promptText:Pchar):longint;cdecl;external libc_nlm name 'InputFromScreen';
+function IsScreenModeSupported(screenMode:dword):longint;cdecl;external system_nlm name 'IsScreenModeSupported';
+
+function OpenCustomScreen(name:Pchar; rTag:rtag_t; newScrID:Pscr_t; mode:longint):longint;cdecl;external libc_nlm name 'OpenCustomScreen';
+
+function OpenPopUpScreen(name:Pchar; rTag:rtag_t; newScrID:Pscr_t):longint;cdecl;external libc_nlm name 'OpenPopUpScreen';
+
+function OpenScreen(name:Pchar; rTag:rtag_t; newScrID:Pscr_t):longint;cdecl;external system_nlm name 'OpenScreen';
+
+{$ifndef DisableArrayOfConst}
+function OutputToScreen(scrID:scr_t; format:Pchar; args:array of const):longint;cdecl;external system_nlm name 'OutputToScreen';
+{$endif}
+function OutputToScreen(scrID:scr_t; format:Pchar):longint;cdecl;external system_nlm name 'OutputToScreen';
+
+{$ifndef DisableArrayOfConst}
+function OutputToScreenWithAttribute(scrID:scr_t; attr:byte; format:Pchar; args:array of const):longint;cdecl;external system_nlm name 'OutputToScreenWithAttribute';
+{$endif}
+function OutputToScreenWithAttribute(scrID:scr_t; attr:byte; format:Pchar):longint;cdecl;external system_nlm name 'OutputToScreenWithAttribute';
+
+
+function OutputToScreenWithPointer(scrID:scr_t; format:Pchar; arguments:va_list):longint;cdecl;external system_nlm name 'OutputToScreenWithPointer';
+procedure Pause(scrID:scr_t);cdecl;external system_nlm name 'Pause';
+function PauseWithEscape(scrID:scr_t):longint;cdecl;external system_nlm name 'PauseWithEscape';
+procedure PositionInputCursor(scrID:scr_t; row:word; col:word);cdecl;external system_nlm name 'PositionInputCursor';
+function PositionOutputCursor(scrID:scr_t; row:word; col:word):longint;cdecl;external system_nlm name 'PositionOutputCursor';
+
+function PromptForString(scr:scr_t; length:size_t; editWidth:size_t; _string:Pchar; hasDefaultValue:longint;
+ defaultValue:Pchar; linesToProtect:longint; promptText:pointer):Pchar;cdecl;external libc_nlm name 'PromptForString';
+
+function PromptForPassword(scr:scr_t; prompt:Pchar; blotOutChar:longint; password:Pchar; maxlen:size_t):Pchar;cdecl;external libc_nlm name 'PromptForPassword';
+
+{$ifndef DisableArrayOfConst}
+function PromptForUnsignedNumber(scrID:scr_t; result:Pdword; minValue:dword; maxValue:dword; radix:longint;
+ linesToProtect:longint; hasDefaultValue:byte; defaultValue:dword; promptText:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'PromptForUnsignedNumber';
+{$endif}
+function PromptForUnsignedNumber(scrID:scr_t; result:Pdword; minValue:dword; maxValue:dword; radix:longint;
+ linesToProtect:longint; hasDefaultValue:byte; defaultValue:dword; promptText:Pchar):longint;cdecl;external libc_nlm name 'PromptForUnsignedNumber';
+
+{$ifndef DisableArrayOfConst}
+function PromptForYesOrNo(scrID:scr_t; linesToProtect,defaultValue:longint; promptText:pointer; args:array of const):longint;cdecl;external libc_nlm name 'PromptForYesOrNo';
+{$endif}
+function PromptForYesOrNo(scrID:scr_t; linesToProtect,defaultValue:longint; promptText:pointer):longint;cdecl;external libc_nlm name 'PromptForYesOrNo';
+
+{$ifndef DisableArrayOfConst}
+function PromptForYesNoAllOrSkip(scrID:scr_t; linesToProtect:longint; defaultValue:dword; promptText:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'PromptForYesNoAllOrSkip';
+{$endif}
+function PromptForYesNoAllOrSkip(scrID:scr_t; linesToProtect:longint; defaultValue:dword; promptText:Pchar):longint;cdecl;external libc_nlm name 'PromptForYesNoAllOrSkip';
+function ReadScreenCharacter(scrID:scr_t; line,col:dword; character:Pchar):longint;cdecl;external system_nlm name 'ReadScreenCharacter';
+
+function RenameScreen(scrID:scr_t; name:Pchar):longint;cdecl;external system_nlm name 'RenameScreen';
+function RestoreFullScreen(scrID:scr_t; buffer:pointer):longint;cdecl;external system_nlm name 'RestoreFullScreen';
+function RestoreScreenArea(scrID:scr_t; line,col,height,width:dword; buffer:pointer):longint;cdecl;external system_nlm name 'RestoreScreenArea';
+procedure ReturnScreenType(_type,colorFlag:Pdword);cdecl;external system_nlm name 'ReturnScreenType';
+procedure ReturnScreenType(var _type,colorFlag:dword);cdecl;external system_nlm name 'ReturnScreenType';
+procedure RingTheBell;cdecl;external system_nlm name 'RingTheBell';
+function SaveFullScreen(scrID:scr_t; buffer:pointer):longint;cdecl;external system_nlm name 'SaveFullScreen';
+function SaveScreenArea(scrID:scr_t; line,col,height,width:dword; buffer:pointer):longint;cdecl;external system_nlm name 'SaveScreenArea';
+procedure SetConsoleSecuredFlag(value:byte);cdecl;external system_nlm name 'SetConsoleSecuredFlag';
+procedure SetCursorStyle(scrID:scr_t; newStyle:word);cdecl;external system_nlm name 'SetCursorStyle';
+procedure SetInputToOutputCursorPosition(scrID:scr_t);cdecl;external system_nlm name 'SetInputToOutputCursorPosition';
+function ScrollScreenArea(scrID:scr_t; line,col,height,width,count:dword; newLineAttribute:byte; direction:scroll_t):longint;cdecl;external system_nlm name 'ScrollScreenArea';
+
+procedure ShowTitleBarText(screenMemoryAddress:pointer; titleBarText:Pchar; textLength:size_t);cdecl;external system_nlm name 'ShowTitleBarText';
+function UngetKey(scrID:scr_t; _type,value,status,scancode:byte):longint;cdecl;external system_nlm name 'UngetKey';
+function ValidateScreenHandle(scrID:scr_t):longint;cdecl;external system_nlm name 'ValidateScreenHandle';
+procedure WaitForKey(scrID:scr_t);cdecl;external system_nlm name 'WaitForKey';
+function WriteScreenCharacter(scrID:scr_t; line,col:dword; character:char):longint;cdecl;external system_nlm name 'WriteScreenCharacter';
+function WriteScreenCharacterAttribute(scrID:scr_t; line,col:dword; character:char; attr:byte):longint;cdecl;external system_nlm name 'WriteScreenCharacterAttribute';
+
+{ turn on 1-byte packing... }
+
+
+
+{ file server event notification interfaces... }
+const
+ EVENT_VOL_SYS_MOUNT = 0;
+ EVENT_VOL_SYS_DISMOUNT = 1;
+ EVENT_ANY_VOL_MOUNT = 2;
+ EVENT_ANY_VOL_DISMOUNT = 3;
+ EVENT_DOWN_SERVER = 4; { (see EVENT_PRE_DOWN_SERVER) }
+ EVENT_EXIT_TO_DOS = 7;
+ EVENT_MODULE_UNLOAD = 8;
+ EVENT_MODULE_UNLOAD_POST_EXIT = 115;
+ EVENT_CLEAR_CONNECTION = 9;
+ EVENT_LOGIN_USER = 10;
+ EVENT_CREATE_BINDERY_OBJ = 11;
+ EVENT_DELETE_BINDERY_OBJ = 12;
+ EVENT_CHANGE_SECURITY = 13;
+ EVENT_CHANGE_SECURITY_ADD_EQUIVALENCE = 1;
+ EVENT_ACTIVATE_SCREEN = 14;
+ EVENT_UPDATE_SCREEN = 15;
+ EVENT_UPDATE_CURSOR = 16;
+ EVENT_KEY_WAS_PRESSED = 17;
+ EVENT_DEACTIVATE_SCREEN = 18;
+ EVENT_TRUSTEE_CHANGE = 19;
+ EVENT_NO_RELINQUISH_CONTROL = 23;
+ EVENT_THREAD_SWITCH = 25;
+ EVENT_MODULE_LOAD = 27;
+ EVENT_CREATE_PROCESS = 28;
+ EVENT_DESTROY_PROCESS = 29;
+ EVENT_NEW_PUBLIC = 32;
+ EVENT_PROTOCOL_BIND = 33;
+ EVENT_PROTOCOL_UNBIND = 34;
+ EVENT_ALLOCATE_CONNECTION = 37;
+ EVENT_LOGOUT_CONNECTION = 38;
+ EVENT_MLID_REGISTER = 39;
+ EVENT_MLID_DEREGISTER = 40;
+ EVENT_DATA_MIGRATION = 41;
+ EVENT_DATA_DEMIGRATION = 42;
+ EVENT_CREATE_OBJECT = 46;
+ EVENT_DELETE_OBJECT = 47;
+ EVENT_RENAME_OBJECT = 48;
+ EVENT_VALUE_CHANGE = 49;
+ EVENT_MOVE_OBJECT = 52;
+ EVENT_VALUE_ADD = 53;
+ EVENT_VALUE_DEL = 54;
+ EVENT_CHANGE_TIME = 51;
+ EVENT_DM_KEY_MODIFIED = 55;
+ EVENT_MODULE_UNLOADED = 56;
+ EVENT_REMOVE_PUBLIC = 57;
+ EVENT_UNICODE = 59;
+ EVENT_SFT3_SERVER_STATE = 60;
+ EVENT_SFT3_IMAGE_STATE = 61;
+ EVENT_SFT3_PRESYNC_STATE = 62;
+ EVENT_ALTERNATE_MOUNT_VOLUME = 63;
+ EVENT_CONSOLE_CONFIG_COMMAND = 64;
+ EVENT_CONSOLE_VERSION_COMMAND = 65;
+ EVENT_PRE_LOAD_NLM = 66;
+ EVENT_LOW_MEMORY = 67;
+ EVENT_PRE_DOWN_SERVER = 129; // called before NDS disappears
+ EVENT_GET_KEY_INFORMATION = 148;
+ EGKStructVersion = $00000001;
+ EVENT_PRIORITY_APPLICATION = 20;
+ EVENT_PRIORITY_DEVICE = 40; // lowest
+
+ {** A consumer registering for an event sets this flag in the event type to
+ ** denote that the consumer is multiprocessor safe. This allows us to
+ ** distinguish multiprocessor safe consumers from unsafe ones. }
+ EVENT_CONSUMER_MT_SAFE = $40000000;
+ { ** Values for fields of EventNetWareAlertStruct_t. }
+ QueueThisAlertMask = $00000001;
+ AlertIDValidMask = $00000002;
+ AlertLocusValidMask = $00000004;
+ AlertEventNotifyOnlyMask = $00000008;
+ AlertNoEventNotifyMask = $00000010;
+ AlertMessageNumberValid = $00010000;
+ NoDisplayAlertUID = $00200000;
+ AlertNoRingBell = $00400000;
+ AlertIDNotUniqueBit = $00800000;
+ OldStyleSystemAlertMask = $01000000;
+ OldStyleINWSystemAlertMask = $02000000;
+ { can be pointer or number }
+ OverloadMessageNumFieldBit = $04000000;
+ NoDisplayLocusBit = $10000000;
+ NoDisplayAlertIDBit = $20000000;
+ OverrideNotificationBits = $40000000;
+ TargetStationIsAPointer = $80000000;
+ Alert300Mask = (AlertIDValidMask or AlertLocusValidMask) or OldStyleSystemAlertMask;
+ Alert311Mask = AlertIDValidMask or OldStyleINWSystemAlertMask;
+ //Alert320Mask = ((AlertIDValidMask or AlertMessageNumberValid) or AlertLocusValidMask) or NoDisp
+ //QAlertMask = ((AlertIDValidMask or AlertLocusValidMask) or NoDisplayAlertIDBit) or QueueThisAle
+ //QAlert320Mask = Alert320Mask or QueueThisAlertMask;
+ { allotted ModuleNumbers for 'alertID' in EventNetWareAlertStruct_t... }
+ ALERT_BINDERY = $01020000; // Bindary
+ ALERT_OS = $01030000; // OS Event Subject
+ ALERT_LLC = $01040000; // LLC
+ ALERT_SDLC = $01050000; // SDLC Stack
+ ALERT_REMOTE = $01060000; // RConsole
+ ALERT_MLID = $01070000; // MLID Lan Drivers
+ ALERT_QLLC = $01080000; // QLLC
+ ALERT_UPS = $01090000; // UPS Monitor
+ ALERT_DS = $010a0000; // Directory Service
+ ALERT_RSPX = $010c0000; // RSPX
+ ALERT_R232 = $010d0000; // Serial
+ ALERT_TIME_SYNC = $010e0000; // TimeSync
+ ALERT_CLIB = $010f0000; // Clib
+ ALERT_PRINT = $01100000; // Print
+ ALERT_NRS = $01200000; // Novell Replication Services
+ ALERT_DNS = $01300000; // IP/Domain Name Services
+ ALERT_DHCP = $01400000; // DHCP Services
+ ALERT_MM = $01500000; // Media Manager
+{
+ ** OS-defined AlertNumber values for 'alertID' in EventNetWareAlertStruct_t
+ ** structure.
+ }
+ { starting with NetWare 4... }
+ nmAllocFailed = 1;
+ nmErrWrtExtDir = 2;
+ nmSysErrWrtDSnoFN = 3;
+ nmStaErrWrtDSnoFN = 4;
+ nmSysErrWrtDSwithFN = 5;
+ nmStaErrWrtDSwithFN = 6;
+ nmSysErrRdDSnoFN = 7;
+ nmStaErrRdDSnoFN = 8;
+ nmSysErrRdDSwithFN = 9;
+ nmStaErrRdDSwithFN = 10;
+ nmSysWrtPreRDnoFN = 11;
+ nmStaWrtPreRDnoFN = 12;
+ nmSysWrtPreRDwithFN = 13;
+ nmStaWrtPreRDwithFN = 14;
+ nmCacheMemLimitExceded = 15;
+ nmCacheMemOutOfMem = 16;
+ nmCacheBufsGetLo = 17;
+ nmDskSpcNoDelFiles = 18;
+ nmDskSpcNoLimbo = 19;
+ nmVolSpcAlmostGone = 20;
+ nmFATWrtErr = 21;
+ nmDirWrtErr = 22;
+ nmDirCopyRdErr = 23;
+ nmDirDblRdErr = 24;
+ nmAllocDirWrtErr = 25;
+ nmDirExpansionErr = 26;
+ nmDirTooLarge = 27;
+ nmErrExpandingDir = 28;
+ nmErrExpandingMem = 29;
+ nmErrDirGetTooLarge = 30;
+ nmDskBottleneck = 31;
+ nmWDClearedConn = 32;
+ nmCpyrtViolation = 33;
+ nmReadFault = 35;
+ nmPktTooSmall = 36;
+ nmCreatingVolLog = 37;
+ nmWrtVolLog = 38;
+ nmVolDmtDevDeact = 39;
+ nmLoginDisabled = 40;
+ nmLoginEnabled = 41;
+ nmClrSta = 42;
+ nmClrStaByUsr = 43;
+ nmFSDownByUser = 44;
+ nmRIPAlreadyOpn = 45;
+ nmRouterConfigErr = 46;
+ nmLANLoopbackErr = 47;
+ nmRouterConfigErrNoInfo = 48;
+ nmIPXUnreachable = 49;
+ nmIPXUnbind = 50;
+ nmSAPAlreadyOpn = 51;
+ nmRouterConfigErrNameInfo = 52;
+ nmSpuriousInt = 53;
+ nmChecksumInvalidAlert = 54;
+ nmPrimaryPicLostInt = 55;
+ nmSecondaryPicLostInt = 56;
+ nmCompErrHoleCountMismatch = 57;
+ nmInvalidScreen = 58;
+ nmRelinquishControl = 59;
+ nmFSUserDeleted = 60;
+ nmAccDelByUser = 61;
+ nmInvalidRTag = 62;
+ nmDeactUnknown = 63;
+ nmDeactDriveUnld = 64;
+ nmDeactDevFailure = 65;
+ nmDeactUsrRequest = 66;
+ nmDeactMediaDismount = 67;
+ nmDeactMediaEject = 68;
+ nmDeactServerDown = 69;
+ nmDeactServerFailure = 70;
+ nmResourceRelErr = 71;
+ nmMirrorsNotSync = 72;
+ nmMirrorsSyncUp = 73;
+ nmPartMirrorSync = 74;
+ nmPartMirrorNotSync = 75;
+ nmReMirroringPart = 76;
+ nmReMirroringPartAborted = 77;
+ nmLogPartMirrorInconsist = 78;
+ nmSysFileLockThresh = 79;
+ nmStaFileLockThresh = 80;
+ nmSysRecLockThresh = 81;
+ nmStaRecLockThresh = 82;
+ nmOpnNETACCTFailed = 83;
+ nmNCPSearchLimitSys = 84;
+ nmNCPSearchLimitSta = 85;
+ nmInsMediaAck = 86;
+ nmInsMediaAborted = 87;
+ nmRemMediaAck = 88;
+ nmRemMediaAbort = 89;
+ nmInsMediaInto = 90;
+ nmRemMediaFrom = 91;
+ nmReDirectedBlockPart = 92;
+ nmReDirectedBlockPartErr = 93;
+ nmOutOfHotFixBlocks = 94;
+ nmLowWarningHotFixBlocks = 95;
+ nmReDirectInconsistNoFix = 96;
+ nmReDirectInconsistFixed = 97;
+ nmInvalidRTagHOptions = 98;
+ nmCheckAndAddHWNoGetRTag = 99;
+ nmRemHWBadPtr = 100;
+ nmErrUnldNLM = 101;
+ nmIvldRTagCrProc = 102;
+ nmCrProcStkTooSmall = 103;
+ nmCrProcNoPCB = 104;
+ nmDelToLimboFileErr = 105;
+ nmDelToLimboNoSpace = 106;
+ nmMLIDResetLanBd = 107;
+ nmRouterReset = 108;
+ nmVolWrongDOSType = 109;
+ nmNoOwnerNSfound = 110;
+ nmRTDMDefSMchanged = 111;
+ nmErrOpnTTSLOG = 112;
+ nmErrWrtTTSLOG = 113;
+ nmTTSdownVolDismount = 114;
+ nmTTSdisableByStaUsr = 115;
+ nmTTSdisByOp = 116;
+ nmTTSdisErrRdBackFile = 117;
+ nmTTSdisErrWrBackFile = 118;
+ nmTTSdisTooManyDefVol = 119;
+ nmTTSdisWrtVolDefInfo = 120;
+ nmTTSdisErrRdBkFlRecGen = 121;
+ nmTTSdisGrowMemTables = 122;
+ nmTTSdisErrAllDiskSp = 123;
+ nmTTSdisDirErrOnBkFile = 124;
+ nmTTSEnableByStaUsr = 125;
+ nmTTStransAbortedForSta = 126;
+ nmTTStooManyTransDelaying = 127;
+ nmTTSNoMemForExpTransNodes = 128;
+ nmAuditEvent = 129;
+ nmAuditDisNoAuditCfg = 130;
+ nmInvldConnTypeToAllocConn = 131;
+ nmInvldRTagToAllocConn = 132;
+ nmOutOfServerConns = 133;
+ nmConnTermAfter5Min = 134;
+ nmUsrAccDisableBySta = 135;
+ nmUnEncryptPwdNotAllowed = 136;
+ nmSuperAccLockedByConsole = 137;
+ nmSystemTimeChangedByCon = 138;
+ nmSystemTimeChangedBySta = 139;
+ nmVolStillActWithError = 140;
+ nmRouterFalsehood = 141;
+ nmServerAddressChanged = 142;
+ nmExtFileNoOwnerCharge = 143;
+ nmRouterConfigErrNode = 144;
+ nmRouterConfigErrMyAddr = 145;
+ nmNoMigratorLd = 146;
+ nmNoSMLd = 147;
+ nmNotEnoughRamForCompression = 148;
+ nmDiskErrorCompressing = 149;
+ nmUnknownErrorCompressing = 150;
+ nmInsufficientSpaceForDeCompression = 151;
+ nmDecompressUnknownCompressionVersion = 152;
+ nmUnknownDecompressError = 153;
+ nmInsufficientRAMToDecompress = 154;
+ nmCompressedFileIsCorrupt = 155;
+ nmStaAttemptedToUseBadPckt = 156;
+ nmStaUsedABadPckt = 157;
+ nmStaAttemptedToUseBadSFL = 158;
+ nmStaUsedABadSFL = 159;
+ nmCorruptCompFileWithName = 160;
+ nmCorruptCompFileWithNameAndStation = 161;
+ nmLowPriThreadsNotRun = 162;
+ nmWorkToDoNotRun = 163;
+ nmCompressErrorTempFileError = 164;
+ nmCompressErrorLengthTotalsMismatch = 165;
+ nmCompressErrorOffsetTotalsMismatch = 166;
+ nmCompressErrorDataCodeCountMismatch = 167;
+ nmCompressErrorLengthCountMismatch = 168;
+ nmCompressErrorLargeLengthCountMismatch = 169;
+ nmCompressErrorReadZeroBytesOrg = 170;
+ nmCompressErrorTreeTooBig = 171;
+ nmCompressErrorMatchSizeFail = 172;
+ nmSignatureInvalidAlert = 173;
+ nmLicenseIsInvalid = 174;
+ nmDeactHotFixError = 175;
+ nmUnknownDecompressErrorFN = 176;
+ nmInsufficientRAMToDecompressFN = 177;
+ nmDecompressUnderFreePercentage = 178;
+ nmNegPktTriedLargeBuffer = 179;
+ nmLoginDisabledByConsole = 180;
+ nmLoginEnabledByConsole = 181;
+ nmGrwStkNotAvail = 182;
+ nmLicenseFileIsMissing = 183;
+ nmFailedToDeletedMigratedFile = 184;
+ nmNoMemForAuditing = 185;
+ nmAuditFileWriteError = 186;
+ nmAuditFileFull = 187;
+ nmAuditFileThresholdOverflow = 188;
+ nmCompressErrorReadZeroBytesInt = 189;
+ nmEASpaceLimit = 190;
+ nmThreadAreaNotEmpty = 191;
+ nmErrMovingLogToMSEngine = 192;
+ nmFaultInConsoleCmdHandler = 193;
+ nmServerToServerComLinkActivated = 194;
+ nmServerToServerComLinkFailure = 195;
+ nmServerToServerComLinkDeact = 196;
+ nmOtherServerAttemptedToSync = 197;
+ nmServerToServerComLinkBrokeOK = 198;
+ nmServerSyncStartingIAmSecondary = 199;
+ nmBadSvrInitMsgFromOtherSvr = 200;
+ nmSvrToSvrCommLinkInitFailed = 201;
+ nmFailedDuringSyncWithReason = 202;
+ nmCommDrvLdDuringActivateWait = 203;
+ nmErrWritingStatusDump = 204;
+ nmComDrvFailureOnPrimary = 205;
+ nmComDrvFailureOnSecondary = 206;
+ nmErrFinishingGenStatusDump = 207;
+ nmSFTIIWhatToDoWithReasonString = 208;
+ nmSFTIIErrorUnexpected = 209;
+ nmSyncErrFromCustomServerNLM = 210;
+ nmSvrLinkHasPluggedPacket = 211;
+ nmSvrToBeRevived = 212;
+ nmServersAreSyncPri = 213;
+ nmSvrCantRouteIPXSec = 214;
+ nmSrvIPXRouteInfoSec = 215;
+ nmErrGivingRAMtoMS = 216;
+ nmMoreRAMgivenToMS = 217;
+ nmServersAreSyncSec = 218;
+ nmSvrCantRouteIPXPri = 219;
+ nmSrvIPXRouteInfoPri = 220;
+ nmPriSvrFailedButSecDown = 221;
+ nmPriSvrFailedNewPri = 222;
+ nmNumMemSegsExceedLimit = 223;
+ nmNumScreenExceedsLimit = 224;
+ nmIOVersionMismatch = 225;
+ nmOtherSvrProtectLvlNoMatch = 226;
+ nmOtherSvrScrAddrMismatch = 227;
+ nmIOEngNotAtSameAddr = 228;
+ nmBothSvrHaveMSEng = 229;
+ nmNoMSEngOnServers = 230;
+ nmSecSvrMissingRAM = 231;
+ nmBothSrvHaveSameIPXAddr = 232;
+ nmIOEngIPXAddrMatchMSEng = 233;
+ nmIOEngsMismatchRxSizes = 234;
+ nmIOEngsHaveSameName = 235;
+ nmNoMemForIOEngName = 236;
+ nmSrvToSvrLinkBeginSync = 237;
+ nmMSEngActivated = 238;
+ nmMSEngActNowSyncOther = 239;
+ nmIOtoMSComMisMatchUnload = 240;
+ nmSFTIIIOutOfMsgCodes = 241;
+ nmErrXferDumpToSystem = 242;
+ nmFailureChkPrimary = 243;
+ nmNoMemForOtherIOEngScr = 244;
+ nmErrStarting2ndProc = 245;
+ nmSrvFailureMsg = 246;
+ nmSecIOEngSupModNotLd = 247;
+ nmMSLBdNumHasConn = 248;
+ nmSecSvrLANIsBetter = 249;
+ nmIPXrtnStatusPckts = 250;
+ nmIPXnotRtnStatChkPckts = 251;
+ nmIPXnotRtnStatLANJam = 252;
+ nmFailReasonByOtherSrv = 253;
+ nmIPXMayBeTooSlowForSecSrv = 254;
+ nmIPXToOtherSrvTooManyHops = 255;
+ nmIPXappearsDown = 256;
+ nmIPXFoundRouteToOtherSrv = 257;
+ nmIPXLostRoute = 258;
+ nmSecSrvGoingToDie = 259;
+ nmPriSrcDyingTimerStart = 260;
+ nmPriSrvDying = 261;
+ nmIPXInternetIsJammed = 262;
+ nmIPXNewRouteToSecSvr = 263;
+ nmSrvsSyncing = 264;
+ nmFSHookRegistered = 265;
+ nmFSHookDeRegistered = 266;
+ nmIOEngCantBorrowMemory = 267;
+ nmDecompressNoCompressionOnVolume = 268;
+ nmMkProcessUsingTooSmallStk = 269;
+ nmQueueEventReportNoMemory = 270;
+ nmServerPartMirrorNotSync = 271;
+ nmStaWithoutRightsConsoleRPC = 272;
+ nmAuditOverflowFileThreshold = 273;
+ nmAuditOverflowFileFull = 274;
+ nmSwitchStacksGrwStk = 275;
+ nmConsoleCommandProcRestarted = 276;
+ nmGrowableStackGrew = 278;
+ nmOtherSvrIOLogSpaceNoMatch = 279;
+ nmDFSLogicalStackRead = 280;
+ nmDFSLogicalStackWrite = 281;
+ nmSecureEraseFailure = 282;
+ nmDropBadPktBurstConn = 283;
+ nmOutOfIPXSockets = 284;
+ nmVolumeObjectIDChanged = 285;
+ nmAbendRecovery = 286;
+ nmOpLockTimeout = 287;
+ nmAbendRecovered = 288;
+ nmUnknownSetCmd = 289; { starting with NetWare 5... }
+ nmAddressSpaceProtectionFault = 290;
+ nmAddressSpaceFailedToRestart = 291;
+ nmAddressSpaceRestarted = 292;
+ nmCorruptMemoryNodeDetected = 293;
+ nmAddressSpaceCleanupFailure = 294;
+ nmInvalidParameter = 295;
+ nmInvalidObjectHandle = 296;
+ nmNullPointer = 297;
+ nmVolDmtMedDmt = 298;
+ nmVolDmtmedChgd = 299;
+ nmAccDelByUsrActConn = 300;
+ nmResourcesRelErr = 301;
+ nmDemoVersion = 302;
+ nmDemoVersionTooLong = 303;
+ nmLicenseReSellerFileIsMissing = 304;
+ nmLicenseUpgradeIsMissing = 305;
+ nmLicenseVersionInvalid = 306;
+ nmLicenseProductInvalid = 307;
+ nmLicenseNoMoreFiles = 308;
+ nmLicensePIDInvalid = 309;
+ nmLicenseContentInalid = 310;
+ nmLicenseBadUpgrade = 311;
+ nmLicensePrevMaxConnMisMatch = 312;
+ nmLicenseContentResellerBad = 313;
+ nmLicenseSNMisMatch = 314;
+ nmLicenseUIDMisMatch = 315;
+ nmLicenseOpenError = 316;
+ nmLicenseCompanionErr = 317;
+ nmLicenseSNUpgradeMisMatch = 318;
+ nmLicenseUnableToRemMSL = 319;
+ nmLicenseUnableToRemULF = 320;
+ nmLicenseUnableToRemRLF = 321;
+ nmLicenseUnableToGetFileSize = 322;
+ nmLicenseUnkLicenseType = 323;
+ nmLicenseReadErr = 324;
+ nmLicenseFileSizeMisMatch = 325;
+ nmLicenseDupServerLic = 326;
+ nmLicenseNeedUpgrade = 327;
+ nmLicenseMirrorNeedUpgrade = 328;
+ nmLicenseDupLicDiscovered = 329;
+ nmLicenseDupLicDiscoveredDel = 330;
+ nmLicenseCpyRightViolated = 331;
+ nmLicenseExpired = 332;
+ nmVolDmtDevMedChgd = 333;
+ nmVolDmtDevMedDmt = 334;
+ nmInsMediaAckDS = 335;
+ nmInsMediaAckMag = 336;
+ nmInsMediaAbortedDS = 337;
+ nmInsMediaAbortedMag = 338;
+ nmRemMediaAckDS = 339;
+ nmRemMediaAckMag = 340;
+ nmRemMediaAbortDS = 341;
+ nmRemMediaAbortMag = 342;
+ nmInsMediaIntoDS = 343;
+ nmInsMediaIntoMag = 344;
+ nmRemMediaFromDS = 345;
+ nmRemMediaFromMag = 346;
+ nmServAddr = 347;
+ nmSwapInError = 348;
+ nmSwapOutError = 349;
+ nmAveragePageInThresholdExceeded = 350;
+ nmIllegalRequest = 351;
+ nmTTSThrottleDelayError = 352;
+ nmTTSLackOfResourcesError = 353;
+ nmTTSLackOfResourcesNoReason = 354;
+ nmDelayedWTDNotRunning = 355;
+ nmInvalidCharacterInName = 356;
+ { starting with NetWare 6... }
+ nmMPKBadThreadState = 357;
+ nmPoolSeriousError = 358;
+ nmPoolSeriousReadError = 359;
+ nmVolSeriousError = 360;
+ nmVolSeriousReadError = 361;
+ nmVolDeactSeriousIOError = 362;
+ nmVolDeactSeriousNonIOError = 363;
+ nmPoolDeactSeriousIOError = 364;
+ nmPoolDeactSeriousNonIOError = 365;
+ nmTaskZeroCheck = 366;
+ { values for 'alertLocus' in EventNetWareAlertStruct_t... }
+ LOCUS_UNKNOWN = 0;
+ LOCUS_MEMORY = 1;
+ LOCUS_FILESYSTEM = 2;
+ LOCUS_DISKS = 3;
+ LOCUS_LANBOARDS = 4;
+ LOCUS_COMSTACKS = 5;
+ LOCUS_TTS = 7;
+ LOCUS_BINDERY = 8;
+ LOCUS_STATION = 9;
+ LOCUS_ROUTER = 10;
+ LOCUS_LOCKS = 11;
+ LOCUS_KERNEL = 12;
+ LOCUS_UPS = 13;
+ LOCUS_SERVICE_PROTOCOL = 14;
+ LOCUS_SFT_III = 15;
+ LOCUS_RESOURCE_TRACKING = 16;
+ LOCUS_NLM = 17;
+ LOCUS_OS_INFORMATION = 18;
+ LOCUS_CACHE = 19;
+ { values for 'alertClass' in EventNetWareAlertStruct_t... }
+ CLASS_UNKNOWN = 0;
+ CLASS_OUT_OF_RESOURCE = 1;
+ CLASS_TEMP_SITUATION = 2;
+ CLASS_AUTHORIZATION_FAILURE = 3;
+ CLASS_INTERNAL_ERROR = 4;
+ CLASS_HARDWARE_FAILURE = 5;
+ CLASS_SYSTEM_FAILURE = 6;
+ CLASS_REQUEST_ERROR = 7;
+ CLASS_NOT_FOUND = 8;
+ CLASS_BAD_FORMAT = 9;
+ CLASS_LOCKED = 10;
+ CLASS_MEDIA_FAILURE = 11;
+ CLASS_ITEM_EXISTS = 12;
+ CLASS_STATION_FAILURE = 13;
+ CLASS_LIMIT_EXCEEDED = 14;
+ CLASS_CONFIGURATION_ERROR = 15;
+ CLASS_LIMIT_ALMOST_EXCEEDED = 16;
+ CLASS_SECURITY_AUDIT_INFO = 17;
+ CLASS_DISK_INFORMATION = 18;
+ CLASS_GENERAL_INFORMATION = 19;
+ CLASS_FILE_COMPRESSION = 20;
+ CLASS_PROTECTION_VIOLATION = 21;
+ CLASS_VIRTUAL_MEMORY = 22;
+ { values for 'alertSeverity' in EventNetWareAlertStruct_t... }
+ { counters reached thresholds }
+ SEVERITY_INFORMATIONAL = 0;
+ { config errors, etc. no damage }
+ SEVERITY_WARNING = 1;
+ { hot fix disk, etc. worked around }
+ SEVERITY_RECOVERABLE = 2;
+ { disk mirror failure, etc. fix-up attempted }
+ SEVERITY_CRITICAL = 3;
+ { resource fatally affected--shut down }
+ SEVERITY_FATAL = 4;
+ { cannot complete--result unknown }
+ SEVERITY_OPERATION_ABORTED = 5;
+ { cannot complete--will not affect OS }
+ SEVERITY_NONOS_UNRECOVERABLE = 6;
+ { values for 'targetNotificationBits' in EventNetWareAlertStruct_t... }
+ NOTIFY_CONNECTION_BIT = $00000001;
+ NOTIFY_EVERYONE_BIT = $00000002;
+ NOTIFY_ERROR_LOG_BIT = $00000004;
+ NOTIFY_CONSOLE_BIT = $00000008;
+ { use if alert to be queued }
+ NOTIFY_QUEUE_MESSAGE = $10000000;
+ NOTIFY_DONT_NOTIFY_NMAGENT = $80000000;
+
+type
+ TnwAlertDataFreeProc = procedure (nwAlertDataPtr:pointer);cdecl;
+ PNetWareAlertStructure = ^TNetWareAlertStructure;
+ TNetWareAlertStructure = record
+ pNetworkManagementAttribute : pointer;
+ nwAlertFlags,
+ nwTargetStation,
+ nwTargetNotificationBits,
+ nwAlertID,
+ nwAlertLocus,
+ nwAlertClass,
+ nwAlertSeverity : longint;
+ nwAlertDataPtr : pointer;
+ nwAlertDataFree : TnwAlertDataFreeProc;
+ nwControlString : pchar;
+ nwControlStringMessageNumber : longint;
+ end;
+
+{$ifndef INCLUDED_FROM_SYSTEM}
+procedure NetWareAlert(nlmHandle : TNLMHandle;
+ nwAlert : PNetWareAlertStructure;
+ parameterCount : longint;
+ args : array of const); cdecl; external system_nlm name 'NetWareAlert';
+{$endif}
+
+procedure NetWareAlert(nlmHandle : TNLMHandle;
+ nwAlert : PNetWareAlertStructure;
+ parameterCount : longint); cdecl; external system_nlm name 'NetWareAlert';
+
+type
+
+ PEventSecurityChange_t = ^EventSecurityChange_t;
+ EventSecurityChange_t = record
+ objectID : dword;
+ equivalentID : dword;
+ changeFlags : dword;
+ end;
+
+ PEventTrusteeChange_t = ^EventTrusteeChange_t;
+ EventTrusteeChange_t = record
+ objectID : dword;
+ entryID : dword;
+ volumeNumber : longint;
+ changeFlags : dword;
+ newRights : dword;
+ end;
+
+ PEventModifyDirEntry_t = ^EventModifyDirEntry_t;
+ EventModifyDirEntry_t = record
+ primaryDirectoryEntry : dword;
+ nameSpace : longint;
+ modifyBits : dword;
+ modifyVector : pointer;
+ volumeNumber : longint;
+ directoryEntry : dword;
+ end;
+
+ PEventProtocolBind_t = ^EventProtocolBind_t;
+ EventProtocolBind_t = record
+ boardNumber : longint;
+ protocolNumber : longint;
+ end;
+
+ PEventDateMigrationInfo_t = ^EventDateMigrationInfo_t;
+ EventDateMigrationInfo_t = record
+ FileSystemTypeID : dword;
+ Volume : longint;
+ DOSDirEntry : dword;
+ OwnerDirEntry : dword;
+ OwnerNameSpace : longint;
+ OwnerFileName : array[0..(1 + 255)-1] of char;
+ end;
+
+ PEventQueueNote_t = ^EventQueueNote_t;
+ EventQueueNote_t = record
+ QAction : longint;
+ QID : dword;
+ QName : array[0..(49 + 1)-1] of char;
+ end;
+
+ PEventNetWareAlert_t = ^EventNetWareAlert_t;
+ EventNetWareAlert_t = record
+ alertFlags : dword;
+ alertId : dword;
+ alertLocus : dword;
+ alertClass : dword;
+ alertSeverity : dword;
+ targetStationCount : longint;
+ targetStationList : array[0..31] of dword;
+ targetNotificationBits : dword;
+ alertParmCount : longint;
+ alertDataPtr : pointer;
+ NetWorkManagementAttributePointer : pointer;
+ alertUnused : array[0..1] of dword;
+ alertControlStringMessageNumber : longint;
+ alertControlString : array[0..255] of char;
+ alertParameters : array[0..(256 + 256)-1] of char;
+ alertModuleName : array[0..35] of char;
+ alertModuleMajorVersion : longint;
+ alertModuleMinorVersion : longint;
+ alertModuleRevision : longint;
+ end;
+
+ PEventBinderyObject_t = ^EventBinderyObject_t;
+ EventBinderyObject_t = record
+ EventObjectSignature : dword;
+ ObjectID : dword;
+ ObjectType : dword;
+ end;
+
+function DSAllocateEventTag(signature:dword):pointer;cdecl;external libc_nlm name 'DSAllocateEventTag';
+
+type
+
+ PEventDSObject_t = ^EventDSObject_t;
+ EventDSObject_t = record
+ EventObjectSignature : dword;
+ EventType : dword;
+ entry : pointer;
+ end;
+
+ PEventCloseFileInfo_t = ^EventCloseFileInfo_t;
+ EventCloseFileInfo_t = record
+ fileHandle : dword;
+ station : longint;
+ task : longint;
+ fileHandleFlags : dword;
+ completionCode : longint;
+ end;
+
+ PEventCheckKeyInfo_t = ^EventCheckKeyInfo_t;
+ EventCheckKeyInfo_t = record
+ structVersion : dword;
+ keyData : dword;
+ scrID : scr_t;
+ end;
+{
+** A consumer registering for an event sets this flag in the event type to
+** denote that the consumer is multiprocessor safe. This allows us to
+** distinguish multiprocessor safe consumers from unsafe ones.
+ }
+{
+** Values for fields of EventNetWareAlertStruct_t.
+ }
+{
+** Values for 'alertID' in EventNetWareAlertStruct_t comprised of two parts,
+** the ModuleNumber (upper 16 bits) and AlertNumber (lower 16 bits).
+** AlertNumber is under the control of the module specified by ModuleNumber.
+**
+** ModuleNumber specifies which module is generating the alert and AlertNumber
+** can then be used for a specific alert generated by that module.
+**
+** Any ModuleNumber in the range 0x8000xxxx to 0xFFFFxxxx. Range 0x0001xxxx
+** through 0x7fffxxxx is reserved for Novell. Value 0x0000xxxx is considered
+** invalid and is used for all legacy alerts.
+ }
+{ allotted ModuleNumbers for 'alertID' in EventNetWareAlertStruct_t... }
+{
+** OS-defined AlertNumber values for 'alertID' in EventNetWareAlertStruct_t
+** structure. }
+
+ Pevent_handle_t = ^event_handle_t;
+ event_handle_t = longint;
+
+ Report_t = procedure (parm:pointer; userParm:pointer);cdecl;
+
+ Warn_t = function (printf:pointer; parm:pointer; userParm:pointer):longint;cdecl;
+
+function RegisterForEventNotification(rtag:rtag_t; _type:longint; priority:longint; warn:Warn_t; report:Report_t;
+ userParm:pointer):event_handle_t;cdecl;external system_nlm name 'RegisterForEventNotification';
+function UnRegisterEventNotification(handle:event_handle_t):longint;cdecl;external system_nlm name 'UnRegisterEventNotification';
+function CanEventBlock(_type:longint):longint;cdecl;external system_nlm name 'CanEventBlock';
+function CheckForRegisteredEvent(_type:longint):longint;cdecl;external system_nlm name 'CheckForRegisteredEvent';
+function EventCheck(_type:longint; printf:pointer; parm:pointer):longint;cdecl;external system_nlm name 'EventCheck';
+function EventReport(_type:longint; parm:pointer):longint;cdecl;external system_nlm name 'EventReport';
+
+
+{ server interfaces... }
+{ ShutdownServer() 'flags'... }
+
+ const
+ NW_POST65_MAX_CMDLINE_LEN = 2048 + 1;
+ SHUTDOWN_RESET = $00000001; { ShutdownServer() 'flags'... }
+ SHUTDOWN_POWEROFF = $00000002; { unimplemented }
+
+
+procedure RestartServer(commandLine:Pchar);cdecl;external system_nlm name 'RestartServer';
+function ShutdownServer(scrID:scr_t; forceDown:byte; alternateMessage:Pchar; flags:dword):longint;cdecl;external system_nlm name 'ShutdownServer';
+function ShutdownServer(scrID:scr_t; forceDown:boolean; alternateMessage:Pchar; flags:dword):longint;cdecl;external system_nlm name 'ShutdownServer';
+function StopServer(scrID:scr_t; forceDown:byte; reserved1:dword; reserved2:pointer; alternateMessage:Pchar;
+ reserved3:dword):longint;cdecl;external system_nlm name 'StopServer';
+function StopServer(scrID:scr_t; forceDown:boolean; reserved1:dword; reserved2:pointer; alternateMessage:Pchar;
+ reserved3:dword):longint;cdecl;external system_nlm name 'StopServer';
+
+{ resource tag interfaces... }
+const
+ AllocSignature = $54524C41;
+ BreakpointSignature = $54504B42;
+ ConsoleCommandSignature = $4D4F4343;
+ CommandLineServicesSignature = $5043574E;
+ DebugCommandSignature = $53504344;
+ DebuggerSignature = $47554244;
+ EventSignature = $544E5645;
+ ScreenSignature = $4E524353;
+ SettableParameterSignature = $4D505453;
+ RTAG_DESC_LEN = 63;
+
+
+type
+ Cleanup_t = procedure (rTag:rtag_t; forceFlag:longint);cdecl;
+
+ Prtag_info = ^rtag_info;
+ rtag_info = record
+ tag : rtag_t;
+ signature : dword;
+ NLMHandle : TNLMHandle;
+ use_count : longint;
+ description : array[0..(63 + 1)-1] of char;
+ end;
+ rtag_info_t = rtag_info;
+ Prtag_info_t = ^rtag_info_t;
+
+
+function AllocateResourceTag(NLMHandle:TNLMHandle; description:Pchar; signature:dword):rtag_t;cdecl;external system_nlm name 'AllocateResourceTag';
+function GetModuleResourceTagInfo(rTag:rtag_t; NLMHandle:TNLMHandle; info:Prtag_info_t):longint;cdecl;external system_nlm name 'GetModuleResourceTagInfo';
+function ReturnResourceTag(rTag:rtag_t; displayErrorsFlag:longint):longint;cdecl;external system_nlm name 'ReturnResourceTag';
+function RegisterTrackedResource(NLMHandle:TNLMHandle; signature:dword; cleanup:Cleanup_t; description:Pchar):longint;cdecl;external system_nlm name 'RegisterTrackedResource';
+function UnRegisterTrackedResource(NLMHandle:TNLMHandle; signature:dword):longint;cdecl;external system_nlm name 'UnRegisterTrackedResource';
+function AddPollingProcedureRTag(proc:TCDeclProcedure ; rTag:rtag_t):longint;cdecl;external system_nlm name 'AddPollingProcedureRTag';
+procedure RemovePollingProcedure(proc:TCDeclProcedure);cdecl;external system_nlm name 'RemovePollingProcedure';
+
+{ NetWare-loader interfaces... }
+const
+ MAX_SYMBOL_NAME_LEN = 80;
+
+function ExportPublicObject(NLMHandle:TNLMHandle; name:Pchar; _object:pointer):longint;cdecl;external system_nlm name 'ExportPublicObject';
+function ImportPublicObject(NLMHandle:TNLMHandle; name:Pchar):pointer;cdecl;external system_nlm name 'ImportPublicObject';
+
+ const
+ LO_NORMAL = $00000000;
+ LO_PROTECT = $00000002;
+ LO_LOAD_LOW = $00000020;
+ LO_RETURN_HANDLE = $00000040;
+ LO_LOAD_SILENT = $00000080;
+ LO_RESTART = $00000200;
+ LO_DONT_DISPLAY_ERROR = $00002000;
+ LO_MEMORY_DEBUG = $00010000; { debug only; no production use }
+ LO_RELAXED_MEMORY_DEBUG = $00020000; { debug only; no production use }
+ ERR_LOADER_COULD_NOT_FIND_FILE = 1; { error returns from LoadModule() }
+ ERR_LOADER_ERROR_READING_FILE = 2;
+ ERR_LOADER_NOT_NLM_FILE_FORMAT = 3;
+ ERR_LOADER_WRONG_NLM_FILE_VERSION = 4;
+ ERR_LOADER_REENTRANT_INITIALIZE_FAILURE = 5;
+ ERR_LOADER_CAN_NOT_LOAD_MULTIPLE_COPIES = 6;
+ ERR_LOADER_ALREADY_IN_PROGRESS = 7;
+ ERR_LOADER_NOT_ENOUGH_MEMORY = 8;
+ ERR_LOADER_INITIALIZE_FAILURE = 9;
+ ERR_LOADER_INCONSISTENT_FILE_FORMAT = 10;
+ ERR_LOADER_CAN_NOT_LOAD_AT_STARTUP = 11;
+ ERR_LOADER_AUTO_LOAD_MODULES_NOT_LOADED = 12;
+ ERR_LOADER_UNRESOLVED_EXTERNAL = 13;
+ ERR_LOADER_PUBLIC_ALREADY_DEFINED = 14;
+ ERR_LOADER_XDC_DATA_ERROR = 15;
+ ERR_LOADER_NOT_KERNEL = 16;
+ ERR_LOADER_NIOS_ONLY_NLM = 17;
+ ERR_LOADER_ADDRESS_SPACE_CREATION = 18;
+ ERR_LOADER_INITIALIZE_FAULT = 19;
+type
+ TLoadModulePath = record
+ case longint of
+ 0 : (NLMHandle : TNLMHandle);
+ 1 : (path : array [0..1024] of char);
+ end;
+
+
+function GetNLMNames(NLMHandle:TNLMHandle; name:Pchar; description:Pchar):longint;cdecl;external system_nlm name 'GetNLMNames';
+procedure KillMe(NLMHandle:TNLMHandle);cdecl;external system_nlm name 'KillMe';
+function ReturnMessageInformation(NLMHandle:TNLMHandle; table:PPPchar; stringCount:Psize_t; languageID:Plongint; helpFile:pointer):longint;cdecl;external system_nlm name 'ReturnMessageInformation';
+function SetAutoUnloadFlag(NLMHandle:TNLMHandle):longint;cdecl;external system_nlm name 'SetAutoUnloadFlag';
+
+function UnImportPublicObject(NLMHandle:TNLMHandle; name:Pchar):longint;cdecl;external system_nlm name 'UnImportPublicObject';
+function AddSearchPathAtEnd(scrID:scr_t; path:Pchar):longint;cdecl;external system_nlm name 'AddSearchPathAtEnd';
+function DeleteSearchPath(scrID:scr_t; searchPathNumber:longint):longint;cdecl;external system_nlm name 'DeleteSearchPath';
+function GetSearchPathElement(index:longint; isDOSFlag:Pdword; path:Pchar):longint;cdecl;external system_nlm name 'GetSearchPathElement';
+function GetSearchPathElement(index:longint; var isDOSFlag:dword; path:Pchar):longint;cdecl;external system_nlm name 'GetSearchPathElement';
+function GetSearchPathElement(index:longint; var isDOSFlag:longint; path:Pchar):longint;cdecl;external system_nlm name 'GetSearchPathElement';
+function InsertSearchPath(scrID:scr_t; searchPathNumber:longint; path:Pchar):longint;cdecl;external system_nlm name 'InsertSearchPath';
+function LoadModule(scrID:scr_t; path:Pchar; options:dword):longint;cdecl;external system_nlm name 'LoadModule';
+function LoadModule(scrID:scr_t; var path:TLoadModulePath; options:dword):longint;cdecl;external system_nlm name 'LoadModule';
+function UnloadModule(scrID:scr_t; commandline:Pchar):longint;cdecl;external system_nlm name 'UnloadModule';
+{ memory management interfaces }
+function _Alloc(size:size_t; rTag:rtag_t):pointer;cdecl;external system_nlm name 'Alloc';
+function Alloc(size:size_t; rTag:rtag_t):pointer;cdecl;external system_nlm name 'Alloc';
+function _AllocSleepOK(size:size_t; rTag:rtag_t; slept:Plongint):pointer;cdecl;external system_nlm name 'AllocSleepOK';
+function AllocSleepOK(size:size_t; rTag:rtag_t; slept:Plongint):pointer;cdecl;external system_nlm name 'AllocSleepOK';
+function _AllocSleepOK(size:size_t; rTag:rtag_t; var slept:longint):pointer;cdecl;external system_nlm name 'AllocSleepOK';
+function AllocSleepOK(size:size_t; rTag:rtag_t; var slept:longint):pointer;cdecl;external system_nlm name 'AllocSleepOK';
+procedure NWGarbageCollect(NLMHandle:TNLMHandle);cdecl;external system_nlm name 'NWGarbageCollect';
+function NWGetAvailableMemory:size_t;cdecl;external system_nlm name 'NWGetAvailableMemory';
+function NWGetPageSize:size_t;cdecl;external system_nlm name 'NWGetPageSize';
+function NWMemorySizeAddressable(addr:pointer; size:size_t):longint;cdecl;external system_nlm name 'NWMemorySizeAddressable';
+function _ReallocSleepOK(addr:pointer; size:size_t; rTag:rtag_t; slept:Plongint):pointer;cdecl;external system_nlm name 'ReallocSleepOK';
+function _ReallocSleepOK(addr:pointer; size:size_t; rTag:rtag_t; var slept:longint):pointer;cdecl;external system_nlm name 'ReallocSleepOK';
+function ReallocSleepOK(addr:pointer; size:size_t; rTag:rtag_t; slept:Plongint):pointer;cdecl;external system_nlm name 'ReallocSleepOK';
+function ReallocSleepOK(addr:pointer; size:size_t; rTag:rtag_t; var slept:longint):pointer;cdecl;external system_nlm name 'ReallocSleepOK';
+procedure _Free(addr:pointer);cdecl;external system_nlm name 'Free';
+
+ const
+ CMD_CONFIG_INFO = $00000001;
+ CMD_CONVERT_UPPER = $00000002; { convert command line to upper case? }
+ CMD_SERVER_RUNNING = $00000004; { server need to be running? }
+ CMD_LEGAL_SERVER = $00000008; { command legal on regular server? }
+ CMD_HIDDEN_CMD = $00200000; { don't display this command }
+ CMD_SUB_CMDS_AVAIL = $00100000; { command has sub commands }
+ CMD_NO_CMD_CHAIN = $00010000; { disallow chaining of command keyword }
+ CMD_PASS_ON_ERROR = $00020000; { ignore error }
+ CMD_ANY_PROCESS = $80000000; { can run on any process with keyboard }
+ { keyword flags for RegisterCommand()... }
+ CMD_MSG_NUMBER = $80000000; { pointer to keyword is number }
+ CMD_LENGTH_PREC = $40000000; { keyword is length-preceeded }
+ { insertion flags for RegisterCommand()... }
+ CMD_INSERT_AT_HEAD = $00000001; { insert at head }
+ CMD_INSERT_AT_TAIL = $00000002; { insert at tail }
+ CMD_PERM_POSITION = $80000000; { leave in place (head or tail) }
+ { valid error returns from command handler... }
+ CMD_CMD_EXECUTED = $00000000; { processed, go to next handler }
+ CMD_HALT_CMD_CHAIN = $70000000; { processed, but don't go on to next }
+ CMD_BAD_CMD_SYNTAX = $70000010; { not processed, syntax error }
+ CMD_NOT_RUNNING = $70000011; { won't execute until server up }
+ CMD_LINE_FAULT = $70000012; { command line fault--no error display }
+ CMD_BAD_MOD_HANDLE = $70000021; { NLM handle is invalid }
+ CMD_BAD_RTAG = $70000022; { invalid resource tag }
+ CMD_BAD_KEY = $70000023; { keyword is invalid }
+ CMD_RTAG_AND_MOD = $70000024; { resource tag doesn't match NLM }
+ CMD_NO_HANDLER = $70000025; { handler is missing }
+ CMD_KEY_TOO_LONG = $70000026; { keyword is too long }
+ CMD_INVAL_PERM = $70000027; { invalid syntax to make permanent }
+ CMD_NO_MEMORY = $70000028; { unable to allocate memory }
+ CMD_NOT_REGISTERED = $70000029; { unregistered command }
+ CMD_HAS_CHAIN = $7000002A; { command has a chain }
+ CMD_CANT_MAKE_HEAD = $7000002B; { cannot make command permanent head }
+ CMD_CANT_MAKE_TAIL = $7000002C; { cannot make command permanent tail }
+ CMD_PASS_TO_NEXT = $7000002D; { not processed, go to next handler }
+ CMD_PRIV_ON_ALT = $7000002E; { no privilege on alternate handler }
+ CMD_STOP_CMDS = $7000002F; { system no longer parsing commands }
+ { simplified versions of returns from command handler... }
+ CMD_PROCESSED_OK = CMD_HALT_CMD_CHAIN;
+ CMD_CHAIN_NEXT_CMD = CMD_CMD_EXECUTED;
+ CMD_SYNTAX_ERROR = CMD_BAD_CMD_SYNTAX;
+ CMD_NOT_MY_COMMAND = CMD_PASS_TO_NEXT;
+ { command handler function codes... }
+ CMD_HELP_ON_CMD = $00000000;
+ CMD_GET_SUB_CMDS = $00000001;
+ CMD_PROCESS_CMD = $00000002;
+ //CMD_MAX_HELP_CMDS = ProcessCommand;
+ { error codes... }
+ ERR_INVALID_MODULE = $00000001;
+ ERR_INVALID_RTAG = $00000002;
+ ERR_INVALID_KEYWORD = $00000003;
+ ERR_MODULE_RTAG_MIX = $00000004;
+ ERR_MISSING_HANDLER = $00000005;
+ ERR_KEYWORD_TOO_LONG = $00000006;
+ ERR_INVALID_REQUEST = $00000007;
+ ERR_OUT_OF_MEMORY = $00000008;
+ ERR_FAILED_TO_REGISTER = $00000009;
+ ERR_ALREADY_REGISTERED = $0000000A;
+ ERR_CANT_GRANT_TOP = $0000000B;
+ ERR_CANT_GRANT_END = $0000000C;
+
+function SizeOfAllocBlock(addr:pointer):size_t;cdecl;external system_nlm name 'SizeOfAllocBlock';
+
+type
+ CommandHandler_t = function (funcCode:longint; scrID:pointer; command:Pchar; upperCaseCommand:Pchar; callerReference:pointer):longint;cdecl;
+
+
+function DeRegisterCommand(NLMHandle:TNLMHandle; rTag:rtag_t; keywordFlags:dword; keyword:Pchar):longint;cdecl;external system_nlm name 'DeRegisterCommand';
+
+function RegisterCommand(NLMHandle:TNLMHandle; rTag:rtag_t; keywordFlags:dword; keyword:Pchar; handlerFlags:dword;
+ insertionFlags:dword; handler:CommandHandler_t; callerReference:pointer):longint;cdecl;external system_nlm name 'RegisterCommand';
+{ legacy command parsing; uses ConsoleCommandSignature... }
+
+type
+ TCommandParserFunc = function (scrID:scr_t; commandline:Pchar):longint;cdecl;
+
+{ allocate with ConsoleCommandSignature }
+
+ PCommandParserStructure = ^TCommandParserStructure;
+ TCommandParserStructure = record
+ link : pointer;
+ case longint of
+ 0 : (parser : TCommandParserFunc; rTag : rtag_t);
+ 1 : (parseRoutine : TCommandParserFunc; rTag2 : rtag_t);
+ end;
+ TCommandParser = TCommandParserStructure;
+ PCommandParser = PCommandParserStructure;
+
+const
+ HANDLEDCOMMAND = 0;
+ NOTMYCOMMAND = 1;
+
+function ParseCommand(commandLine:Pchar):longint;cdecl;external system_nlm name 'ParseCommand';
+function RegisterConsoleCommand(cmdParser:PCommandParser):longint;cdecl;external system_nlm name 'RegisterConsoleCommand';
+function RegisterConsoleCommand(var cmdParser:TCommandParser):longint;cdecl;external system_nlm name 'RegisterConsoleCommand';
+function UnRegisterConsoleCommand(cmdParser:PCommandParser):longint;cdecl;external libc_nlm name 'UnRegisterConsoleCommand';
+function UnRegisterConsoleCommand(var cmdParser:TCommandParser):longint;cdecl;external libc_nlm name 'UnRegisterConsoleCommand';
+
+ const
+ SP_TYPE_NUMBER = 0;
+ { 'value' points to DWORD (0 or !0) }
+ SP_TYPE_BOOLEAN = 1;
+ SP_TYPE_TICKS = 2;
+ SP_TYPE_BLOCK_SHIFT = 3;
+ { [+|-]hh:mm:ss converted to seconds }
+ SP_TYPE_TIME_OFFSET = 4;
+ { 'value' points to char buffer }
+ SP_TYPE_STRING = 5;
+ SP_TYPE_TRIGGER = 6;
+ { settable parameter flags... }
+ SP_STARTUP_ONLY = $01;
+ SP_HIDE = $02;
+ SP_ADVANCED = $04;
+ SP_STARTUP_OR_LATER = $08;
+ { can't be done on secured console }
+ SP_NOT_SECURED_CONSOLE = $10;
+ { lock console RPC from changing value }
+ SP_RPC_LOCKOUT = $20;
+ { settable parameter categories... }
+ SP_COMMUNICATIONS = 0;
+ SP_MEMORY = 1;
+ SP_FILE_CACHE = 2;
+ SP_DIR_CACHE = 3;
+ SP_FILE_SYSTEM = 4;
+ SP_LOCKS = 5;
+ SP_TRANS_TRACKING = 6;
+ SP_DISK = 7;
+ SP_TIME = 8;
+ SP_NCP = 9;
+ { recommended most common }
+ SP_MISCELLANEOUS = 10;
+ SP_ERRORS = 11;
+ SP_DIRECTORY_SERVICES = 12;
+ SP_MULTIPROCESSOR = 13;
+ { type depends on 'type' field }
+ { for parameter name }
+ { for parameter description }
+
+
+type
+
+ Psettableparms_t = ^Tsettableparms;
+ Tsettableparms = record
+ link : pointer;
+ value : pointer;
+ rTag : rtag_t;
+ name : Pchar;
+ _type : byte;
+ flags : byte;
+ category : byte;
+ reserved : byte;
+ lower_limit : dword;
+ upper_limit : dword;
+ callback : procedure (oldValue:dword);cdecl;
+ description : Pchar;
+ msg_namenum : word;
+ msg_descnum : word;
+ end;
+ Psettableparms = Psettableparms_t;
+
+function RegisterSetableParameter(setparms:Psettableparms_t):longint;cdecl;external system_nlm name 'RegisterSetableParameter';
+function RegisterSetableParameter(var setparms:Tsettableparms):longint;cdecl;external system_nlm name 'RegisterSetableParameter';
+function DeRegisterSetableParameter(setparms:Psettableparms_t):longint;cdecl;external system_nlm name 'DeRegisterSetableParameter';
+function DeRegisterSetableParameter(var setparms:Tsettableparms):longint;cdecl;external system_nlm name 'DeRegisterSetableParameter';
+
+function GetSetableParameterValue(slot:longint; name:Pchar; value:pointer):longint;cdecl;external system_nlm name 'GetSetableParameterValue';
+function GetSetableParameterValue(slot:longint; name:Pchar; var value):longint;cdecl;external system_nlm name 'GetSetableParameterValue';
+
+function ScanSetableParameters(scanCategory:longint; scanSequence:Pdword; name:Pchar; _type:Plongint; flags:Pdword;
+ category:Plongint; description:pointer; value:pointer; lowerLimit:Plongint; upperLimit:Plongint):longint;cdecl;external system_nlm name 'ScanSetableParameters';
+function ScanSetableParameters(scanCategory:longint; var scanSequence:dword; name:Pchar; var _type:longint; var flags:dword;
+ var category:longint; var description, value; var lowerLimit,upperLimit:longint):longint;cdecl;external system_nlm name 'ScanSetableParameters';
+
+function SetSetableParameterValue(slot:longint; name:Pchar; newValue:pointer):longint;cdecl;external system_nlm name 'SetSetableParameterValue';
+function SetSetableParameterValue(slot:longint; name:Pchar; var newValue):longint;cdecl;external system_nlm name 'SetSetableParameterValue';
+{ NLM start-up synchronization... }
+procedure SynchronizeStart;cdecl;external system_nlm name 'SynchronizeStart';
+{ message table loading... }
+function LoadLanguageMessageTable(table:PPPchar; count:Plongint; languageID:Plongint):longint;cdecl;external system_nlm name 'LoadLanguageMessageTable';
+{ timer interfaces... }
+function GetHighResolutionTimer:dword;cdecl;external system_nlm name 'GetHighResolutionTimer';
+function GetSuperHighResolutionTimer:dword;cdecl;external system_nlm name 'GetSuperHighResolutionTimer';
+
+{ spin locks for use in the kernel (not from a protected address space)... }
+type
+ Pspinlock_t = ^spinlock_t;
+ spinlock_t = pointer;
+ TSpinlock = spinlock_T;
+ PSpinlock = Pspinlock_t;
+
+function KernelSpinLockInit(lock:Pspinlock_t):longint;cdecl;external system_nlm name 'KernelSpinLockInit';
+procedure KernelSpinLock(lock:Pspinlock_t);cdecl;external system_nlm name 'KernelSpinLock';
+function KernelSpinTryLock(lock:Pspinlock_t):longint;cdecl;external system_nlm name 'KernelSpinTryLock';
+procedure KernelSpinUnlock(lock:Pspinlock_t);cdecl;external system_nlm name 'KernelSpinUnlock';
+function KernelSpinLockDisable(lock:Pspinlock_t):dword;cdecl;external system_nlm name 'KernelSpinLockDisable';
+function KernelSpinTryLockDisable(lock:Pspinlock_t; flags:Pdword):longint;cdecl;external system_nlm name 'KernelSpinTryLockDisable';
+procedure KernelSpinUnlockRestore(lock:Pspinlock_t; flags:dword);cdecl;external system_nlm name 'KernelSpinUnlockRestore';
+
+function KernelSpinLockInit(var lock:spinlock_t):longint;cdecl;external system_nlm name 'KernelSpinLockInit';
+procedure KernelSpinLock(var lock:spinlock_t);cdecl;external system_nlm name 'KernelSpinLock';
+function KernelSpinTryLock(var lock:spinlock_t):longint;cdecl;external system_nlm name 'KernelSpinTryLock';
+procedure KernelSpinUnlock(var lock:spinlock_t);cdecl;external system_nlm name 'KernelSpinUnlock';
+function KernelSpinLockDisable(var lock:spinlock_t):dword;cdecl;external system_nlm name 'KernelSpinLockDisable';
+function KernelSpinTryLockDisable(var lock:spinlock_t; flags:Pdword):longint;cdecl;external system_nlm name 'KernelSpinTryLockDisable';
+procedure KernelSpinUnlockRestore(var lock:spinlock_t; flags:dword);cdecl;external system_nlm name 'KernelSpinUnlockRestore';
+
+
+{ nonpreferred locale interfaces... }
+type
+ Pcountryinfo_t = ^Tcountryinfo;
+ Tcountryinfo = record
+ infoID : byte;
+ size : word;
+ countryID : word;
+ codePage : word;
+ dateFormat : word;
+ currencySymbol : array[0..4] of char;
+ thousandSeparator : array[0..1] of char;
+ decimalSeparator : array[0..1] of char;
+ dateSeparator : array[0..1] of char;
+ timeSeparator : array[0..1] of char;
+ currencyFormatFlags : char;
+ digitsInCurrency : char;
+ timeFormat : char;
+ UpperCase : procedure ;cdecl;
+ dataListSeparator : array[0..1] of char;
+ spare : array[0..9] of char;
+ end;
+ Pcountryinfo = Pcountryinfo_t;
+
+function OSGetCodePage:longint;cdecl;external libc_nlm name 'OSGetCodePage';
+procedure OSGetCountryInfo(_para1:Pcountryinfo_t);cdecl;external system_nlm name 'OSGetCountryInfo';
+procedure OSGetCountryInfo(var _para1:Tcountryinfo);cdecl;external system_nlm name 'OSGetCountryInfo';
+
+ const
+ EXCEPTION_HANDLED = 0;
+ EXCEPTION_NOT_HANDLED = 1; // chain to next handler
+ { registered debugger parser returns: }
+ NEXT_DEBUG_PARSER = -(2); // call next debug parser
+ NEXT_ALT_DEBUG_PARSER = -(1); // call next registered debug parser
+ COMMAND_HANDLED = 0; // call no other parser
+ INTERNAL_DEBUGGER = 1; // pass to NetWare System Debugger
+
+
+type
+ Pexceptionframe = ^exceptionframe;
+ exceptionframe = record
+ xfReserved : array[0..6] of dword;
+ xfCR3 : Pdword;
+ xfEIP : dword;
+ xfSystemFlags : dword;
+ xfEAX : dword;
+ xfECX : dword;
+ xfEDX : dword;
+ xfEBX : dword;
+ xfESP : dword;
+ xfEBP : dword;
+ xfESI : dword;
+ xfEDI : dword;
+ xfES : array[0..1] of word;
+ xfCS : array[0..1] of word;
+ xfSS : array[0..1] of word;
+ xfDS : array[0..1] of word;
+ xfFS : array[0..1] of word;
+ xfGS : array[0..1] of word;
+ xfLDT : array[0..1] of word;
+ xfSpecial : array[0..1] of word;
+ xfNumber : dword;
+ xfDescription : Pchar;
+ xfFlags : dword;
+ xfErrorCode : dword;
+ xfPageFaultCR2 : dword;
+ xfFPUState : dword;
+ xfHistogram : dword;
+ xfProcessorID : dword;
+ end;
+ xframe_t = exceptionframe;
+ Pxframe_t = ^xframe_t;
+
+ SoftBPHandler_t = function (number:longint; address:pointer; frame:Pxframe_t):longint;cdecl;
+ DebugParser_t = function (scr:scr_t; command:Pchar; frame:Pxframe_t):longint;cdecl;
+
+
+procedure Abend(message:Pchar);cdecl;external system_nlm name 'Abend';
+function AddressOfSoftBreakpoint(number:longint):pointer;cdecl;external system_nlm name 'AddressOfSoftBreakpoint';
+function AddSoftBreakpoint(addr:pointer; handler:SoftBPHandler_t):longint;cdecl;external system_nlm name 'AddSoftBreakpoint';
+function CSetABreakpoint(number:longint; addr:pointer; _type:byte; length:byte):longint;cdecl;external system_nlm name 'CSetABreakpoint';
+procedure EnterDebugger;cdecl;external system_nlm name 'EnterDebugger';
+function GetDebuggerActiveCount:longint;cdecl;external system_nlm name 'GetDebuggerActiveCount';
+function RegisterDebugCommandParser(parseRoutine:DebugParser_t; rTag:rtag_t):longint;cdecl;external system_nlm name 'RegisterDebugCommandParser';
+function RemoveSoftBreakpoint(number:longint):longint;cdecl;external system_nlm name 'RemoveSoftBreakpoint';
+function ReserveABreakpointRTag(_para1:rtag_t):longint;cdecl;external system_nlm name 'ReserveABreakpointRTag';
+function UnRegisterDebugCommandParser(parseRoutine:DebugParser_t):longint;cdecl;external system_nlm name 'UnRegisterDebugCommandParser';
+function UnReserveABreakpoint(_para1:longint):longint;cdecl;external system_nlm name 'UnReserveABreakpoint';
+
+
+//?? dont know what this is: (exported by system)
+//var preferredModule : pointer;cvar;external;
+
+{ Prototypes for libraries and drivers writing their own start-up and shut-
+ down code. (DllMain() is also part of this list and defined in windows.h.)
+ These are not interfaces, but only prototypes for code furnished by the
+ NLM application, library, driver, etc. }
+
+function _NonAppCheckUnload:longint;cdecl;external libc_nlm name '_NonAppCheckUnload';
+
+type TReadRoutine = function (conn:longint; fileHandle:pointer; offset,nbytes,bytesRead:Psize_t; buffer:pointer):longint; cdecl;
+function _NonAppStart(NLMHandle:TNLMHandle; errorScreen:pointer; commandLine:Pchar; loadDirPath:Pchar; uninitializedDataLength:size_t;
+ NLMFileHandle:pointer; readRoutineP:TReadRoutine; customDataOffset:size_t; customDataSize:size_t; messageCount:longint;
+ messages:PPchar):longint;cdecl;external libc_nlm name '_NonAppStart';
+procedure _NonAppStop;cdecl;external libc_nlm name '_NonAppStop';
+
+ const
+ CTX_ACTUAL_CWD = $01;
+ { for set_pathname_format(), namespace appellations... }
+ SHORT_NAMES = 0; { 8.3 format }
+ MACINTOSH_NAMES = 1;
+ NFS_NAMES = 2;
+ FTAM_NAMES = 3;
+ LONG_NAMES = 4; { default long-name format }
+ NT_NAMES = 5;
+ { definitions useful to fshooks.h (attribute-match) and others... }
+
+ ATTR_NORMAL = $00000000; { no read/write restrictions }
+ ATTR_READ_ONLY = $00000001; { read-only file }
+ ATTR_HIDDEN = $00000002; { hidden file }
+ ATTR_SYSTEM = $00000004; { system file }
+ ATTR_EXECUTE = $00000008; { execute only file }
+ ATTR_VOLUME_ID = $00000008; { file system label }
+ ATTR_DIRECTORY = $00000010; { subdirectory }
+ ATTR_ARCHIVE = $00000020; { archive file }
+ ATTR_SHARE = $00000080; { Sharable file }
+ ATTR_NO_SUBALLOC = $00000800; { don't sub allocate file }
+ ATTR_TRANS = $00001000; { trans'l file, TTS-usable }
+ ATTR_READAUD = $00004000; { read audit }
+ ATTR_WRITAUD = $00008000; { write audit }
+ ATTR_IMMPURG = $00010000; { immediate purge }
+ ATTR_NORENAM = $00020000; { rename inhibit }
+ ATTR_NODELET = $00040000; { delete inhibit }
+ ATTR_NOCOPY = $00080000; { copy inhibit }
+
+ ATTR_FILE_MIGRATED = $00400000; { file has been migrated }
+ ATTR_DONT_MIGRATE = $00800000; { don't migrate this file }
+ ATTR_IMMEDIATE_COMPRESS = $02000000; { compress file immediately }
+ ATTR_FILE_COMPRESSED = $04000000; { file is compressed }
+ ATTR_DONT_COMPRESS = $08000000; { don't compress this file }
+ ATTR_CANT_COMPRESS = $20000000; { can't compress this file }
+ ATTR_ATTR_ARCHIVE = $40000000; { entry has been modified }
+ { Faster, better when getstat() or fgetstat() used with request bit map... }
+ ST_NONE = $00000000;
+ ST_FLAGS_BIT = $00000001;
+ ST_MODE_BIT = $00000002;
+ ST_GEN_BIT = $00000004;
+ ST_INO_BIT = $00000008;
+ ST_DEV_BIT = $00000010;
+ ST_RDEV_BIT = $00000020;
+ ST_SIZE_BIT = $00000040;
+ ST_BLOCKS_BIT = $00000080;
+ ST_BLKSIZE_BIT = $00000100;
+ ST_NLINK_BIT = $00000200;
+ ST_UID_BIT = $00000400;
+ ST_GID_BIT = $00000800;
+ ST_BID_BIT = $00001000;
+ ST_MID_BIT = $00002000;
+ ST_ATIME_BIT = $00004000;
+ ST_MTIME_BIT = $00008000;
+ ST_CTIME_BIT = $00010000;
+ ST_BTIME_BIT = $00020000;
+ ST_STAT_BITS = $0003FFFF; { bits for normal stat call }
+ { the following are not returned by a normal stat call }
+ ST_RIGHTS_BIT = $00040000;
+ ST_NAME_BIT = $00080000;
+ ST_NS_BIT = $00100000; { return name in specified namespace }
+ { path analysis/parsing 'type' and 'flags' arguments for [de]construct() }
+ PATH_UNDEF = $00000000;
+
+ PATH_DOS = PATH_UNDEF; { indicates potential DOS path }
+ PATH_UNC = $00000001; { double slash found at beginning }
+ PATH_UNIX = $00000002; { forward slashes only }
+ PATH_NETWARE = $00000004; { slash and colon followed by slashes }
+ PATH_MACINTOSH = $00000008; { only colons }
+ PATH_ROOTED = $00000010; { starts with delimiter }
+ PATH_VOLROOTED = $00000020; { volume plus colon appears }
+ PATH_EXTENSION = $00000040; { contains period }
+ PATH_HIERARCHY = $00000080; { at least one subdirectory element }
+ PATH_SHORTNAME = $00000100; { 8.3 names only }
+ PATH_LONGNAME = $00000200; { at least one element greater than 8.3 }
+ PATH_ENDED = $00000400; { ends in delimiter }
+ PATH_DOSDRIVE = $00001000; { single-letter drive, colon and path }
+ PATH_MIXEDCASE = $00002000; { at least one element in mixed case }
+ PATH_DOTS = $00004000; { path contains dots }
+ PATH_SLASH = $00008000; { path contains a slash }
+ PATH_BACKSLASH = $00010000; { path contains a backslash }
+ PATH_COLON = $00020000; { path contains a colon }
+ PATH_ILLEGAL = $80000000; { illegal character or combination }
+ //PATH_MIXED = PATH_SHORT or PATH_LONG;
+{ d_cdatetime = d_cdatetim.tv_sec;
+ d_adatetime = d_adatetim.tv_sec;
+ d_bdatetime = d_bdatetim.tv_sec;
+ d_ddatetime = d_ddatetim.tv_sec;}
+ FSKEY_NONE = -(1);
+ FSKEY_TRAD = 0;
+ FSKEY_NSS = 1;
+ { values returned by _fildes_type(): see sys/mode.h }
+ { values returned by _fs_type()... }
+ { 'fildes' is not a file }
+ FS_NOT_FS = $00000000;
+ FS_LFS = $00000100; { file in local, traditional file system }
+ FS_REMOTE = $00000200; { file in remote file system }
+ FS_DOS = $00000400; { file in local, DOS file system }
+ FS_NSS = $00000800; { file in Novell Storage Services }
+
+
+
+
+{ for getcwdpath(), get NKS context for current working directory... }
+{ for set_pathname_format(), namespace appellations... }
+{ definitions useful to fshooks.h (attribute-match) and others... }
+{ Faster, better when getstat() or fgetstat() used with request bit map... }
+{ the following are not returned by a normal stat call }
+{ path analysis/parsing 'type' and 'flags' arguments for [de]construct() }
+{ d_ddatetim & d_deletedID valid only in scanerasedfiles }
+{ c.f. these fields in struct dirent... }
+{ untouched by scanerasedfiles() }
+
+type
+ Pnwdirent = ^Tnwdirent;
+ Tnwdirent = record
+ d_userspec : dword;
+ d_flags : dword; // flags for this entry
+ d_type : mode_t; // type of entry
+ d_mode : mode_t; // emulated file mode
+ d_ino : ino_t; // directory entry number of d_name
+ d_size : off64_t; // size of file
+ d_spare : array[0..38] of dword;
+ d_cdatetim : timespec_t; // creation date and time
+ d_adatetim : timespec_t; // last access date--files only
+ d_bdatetim : timespec_t; // last archive date and time
+ d_ddatetim : timespec_t; // deleted date/time
+ d_uid : uid_t; // owner id (object id)
+ d_archivedID : uid_t; // object ID that last archived file
+ d_updatedID : uid_t; // object ID that last updated file
+ d_deletedID : uid_t; // deleted ID
+ d_pad1 : byte;
+ d_pad2 : byte;
+ d_pad3 : byte;
+ d_namelen : byte; // lenght of following name:
+ d_name : array[0..(255 + 1)-1] of char; // only portable field in this structure
+ end;
+ TNWDIR = Tnwdirent;
+ PNWDIR = ^TNWDIR;
+{ sizeof(struct nwdirent)==0x200 (512.) }
+{ extensions of unistd.h path parsing functions... }
+
+
+function deconstruct(path:Pchar; server:Pchar; volume:Pchar; directory:Pchar; name:Pchar;
+ extension:Pchar; elements:Plongint; flags:Plongint):longint;cdecl;external libc_nlm name 'deconstruct';
+function construct(path:Pchar; server:Pchar; volume:Pchar; directory:Pchar; name:Pchar;
+ extension:Pchar; flags:longint):longint;cdecl;external libc_nlm name 'construct';
+{ extensions of client.h identity functions... }
+function get_identity(pathctx:NXPathCtx_t; identity:Plongint):longint;cdecl;external libc_nlm name 'get_identity';
+{ extensions of unistd.h current working directory I/O functions... }
+function getcwdpath(buf:Pchar; pathCtx:PNXPathCtx_t; flags:dword):Pchar;cdecl;external libc_nlm name 'getcwdpath';
+
+function chdir2(path:Pchar):longint;cdecl;external libc_nlm name 'chdir2';
+function setcwd(pathCtx:NXPathCtx_t):longint;cdecl;external libc_nlm name 'setcwd';
+function setcwd2(pathCtx:NXPathCtx_t):longint;cdecl;external libc_nlm name 'setcwd2';
+{ extensions of unistd.h file I/O functions... }
+function Fpeof(fildes:longint):longint;cdecl;external libc_nlm name 'eof';
+function tell(fildes:longint):off_t;cdecl;external libc_nlm name 'tell';
+function Fptell(fildes:longint):off_t;cdecl;external libc_nlm name 'tell';
+{ extensions of sys/stat.h functions... }
+function fgetstat(fildes:longint; buf:Pstat; requestmap:dword):longint;cdecl;external libc_nlm name 'fgetstat';
+
+function getstat(ctx:NXPathCtx_t; path:Pchar; buf:Pstat; requestmap:dword):longint;cdecl;external libc_nlm name 'getstat';
+function fgetstat_with_namespace(fildes:longint; buf:Pstat; requestmap:dword; _namespace:longint):longint;cdecl;external libc_nlm name 'fgetstat_with_namespace';
+
+function getstat_with_namespace(ctx:NXPathCtx_t; path:Pchar; buf:Pstat; requestmap:dword; _namespace:longint):longint;cdecl;external libc_nlm name 'getstat_with_namespace';
+{ pathname format (namespace) state... }
+function set_pathname_format(newformat:longint; oldformat:Plongint):longint;cdecl;external libc_nlm name 'set_pathname_format';
+{ for use with Novell Clustering... }
+
+function isclusteredvirtualserver(servername:Pchar):longint;cdecl;external libc_nlm name 'isclusteredvirtualserver';
+{ equivalent to CLib's FileServerFileCopy()... }
+function fscopy(fildes1:longint; fildes2:longint; offset1:off64_t; offset2:off64_t; length:size_t;
+ nbytes:Psize_t):longint;cdecl;external libc_nlm name 'fscopy';
+{ equivalent to similarly named calls in CLib... }
+
+function purgeerasedfile(path:Pchar; sequence:longint):longint;cdecl;external libc_nlm name 'purgeerasedfile';
+
+
+function salvageerasedfile(pathName:Pchar; sequence:longint; newFileName:Pchar):longint;cdecl;external libc_nlm name 'salvageerasedfile';
+
+function scanerasedfiles(path:Pchar; nextEntryNumber:Plongint; deletedFileInfo:PNWDIR):longint;cdecl;external libc_nlm name 'scanerasedfiles';
+function _fs_type(fildes:longint):longint;cdecl;external libc_nlm name '_fs_type';
+function _fildes_type(fildes:longint):longint;cdecl;external libc_nlm name '_fildes_type';
+function _fildes_from_nsskey(key:Tuint64; oflag:longint):longint;cdecl;external libc_nlm name '_fildes_from_nsskey';
+function _key_from_fildes(fildes:longint; _type:Plongint; err:Plongint):Tuint64;cdecl;external libc_nlm name '_key_from_fildes';
+{ fast type of a file descriptor--st_mode in fstat()... }
+{ equates to move between NKS file handles and POSIX descriptors... }
+{ derivation of POSIX descriptor from NSS open file key... }
+{ back-derivation of file system key... }
+{ types returned in back-derivation... }
+{ values returned by _fildes_type(): see sys/mode.h }
+{ values returned by _fs_type()... }
+{ attributes for NXDirAttrWin_t 'dwFileAttributes' field... }
+
+
+{ turn on 1-byte packing... }
+
+ const
+ FILE_ATTRIBUTE_READONLY = $00000001;
+ FILE_ATTRIBUTE_HIDDEN = $00000002;
+ FILE_ATTRIBUTE_SYSTEM = $00000004;
+ FILE_ATTRIBUTE_DIRECTORY = $00000010;
+ FILE_ATTRIBUTE_ARCHIVE = $00000020;
+ FILE_ATTRIBUTE_ENCRYPTED = $00000040;
+ FILE_ATTRIBUTE_NORMAL = $00000080;
+ FILE_ATTRIBUTE_TEMPORARY = $00000100;
+ FILE_ATTRIBUTE_SPARSE_FILE = $00000200;
+ FILE_ATTRIBUTE_REPARSE_POINT = $00000400;
+ FILE_ATTRIBUTE_COMPRESSED = $00000800;
+ FILE_ATTRIBUTE_OFFLINE = $00001000;
+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000;
+
+
+type
+ PNXDirAttrDos_t = ^NXDirAttrDos_t;
+ NXDirAttrDos_t = record { DOS/FAT32 (NX_PNF_DOS) attributes }
+ xdeHeader : NXDeHeader_t;
+ xdeFid : NXFid_t;
+ xdeEffectiveRights : dword;
+ { FAT32 File System Spec., p. 22 }
+ xdeAttr : dword;
+ xdeCrtDate : word;
+ xdeCrtTime : word;
+ xdeCrtTimeTenth : word;
+ xdeLastAccDate : word;
+ xdeWrtDate : word;
+ xdeWrtTime : word;
+ xdeFileSize : dword;
+ Reserved1 : dword;
+ Reserved2 : dword;
+ end;
+{ DOS/FAT32 (NX_PNF_DOS) information.. }
+{ ...including name }
+{ maximum length is 255 characters }
+
+ PNXDirEnumDos_t = ^NXDirEnumDos_t;
+ NXDirEnumDos_t = record
+ deDosDirAttr : NXDirAttrDos_t;
+ deDirMark : NXDirMark_t;
+ deShortName : array[0..15] of char;
+ deName : pointer;
+ end;
+{ Win32 (NX_PNF_WIN) attributes }
+{ see WIN32_FIND_DATA... }
+{ FILE_ATTRIBUTE_NORMAL, etc. }
+{ date and time of creation or -1 }
+{ date and time of last access }
+{ date and time of last modification }
+{ date and time of last attr change }
+{ see BY_HANDLE_FILE_INFORMATION... }
+{ always 1 for FAT }
+{ unique identifier }
+{ CIFS Specification 0.9, 4.2.16.8... }
+{ file system block size }
+{ (currently) Ramesh-invented fields... }
+{ not in Win32 docs, but exists }
+{ Boolean flag fields for CIFS }
+{ total size of extended attributes }
+{ size of compressed file }
+{ format of of compression }
+
+ PNXDirAttrWin_t = ^NXDirAttrWin_t;
+ NXDirAttrWin_t = record
+ xdeHeader : NXDeHeader_t;
+ xdeFid : NXFid_t;
+ xdeEffectiveRights : dword;
+ xdeFileAttributes : dword;
+ xdeCreateTime : Tuint64;
+ xdeLastAccessTime : Tuint64;
+ xdeLastWriteTime : Tuint64;
+ xdeLastChangeTime : Tuint64;
+ xdeFileSize : Tuint64;
+ Reserved0 : dword;
+ Reserved1 : dword;
+ Reserved2 : dword;
+ Reserved3 : dword;
+ xdeNumberOfLinks : dword;
+ xdeVolumeSerialNumber : dword;
+ Reserved4 : dword;
+ Reserved5 : dword;
+ xdeFileIndex : Tuint64;
+ Reserved6 : Tuint64;
+ xdeAllocationSize : dword;
+ xdeAccessFlags : dword;
+ xdeMiscFlags : dword;
+ Reserved7 : dword;
+ xdeEaSize : Tuint64;
+ xdeCompressedFileSize : Tuint64;
+ xdeCompressionFormat : word;
+ Reserved8 : word;
+ Reserved9 : dword;
+ Reserved10 : Tuint64;
+ end;
+{ Win32 (NX_PNF_WIN) information... }
+{ ...including name }
+{ see WIN32_FIND_DATA... }
+{ maximum length is 255 characters }
+
+ PNXDirEnumWin_t = ^NXDirEnumWin_t;
+ NXDirEnumWin_t = record
+ deWinDirAttr : NXDirAttrWin_t;
+ deDirMark : NXDirMark_t;
+ deAlternativeFileName : array[0..15] of char;
+ deName : pointer;
+ end;
+
+// nks/errno.h
+
+ const
+ NX_EOF = -(1);
+ NX_ENOENT = 1; { no such file or directory }
+ NX_E2BIG = 2; { argument list too big }
+ NX_ENOEXEC = 3; { exec format error }
+ NX_EBADF = 4; { bad file number (descriptor or handle) }
+ NX_ENOMEM = 5; { not enough memory }
+ NX_EACCES = 6; { permission denied }
+ NX_EEXIST = 7; { file exists }
+ NX_EXDEV = 8; { cross-device link }
+ NX_EINVAL = 9; { invalid argument }
+ NX_ENFILE = 10; { file table overflow }
+ NX_EMFILE = 11; { too many open files }
+ NX_ENOSPC = 12; { no space left on device }
+ NX_ERANGE = 14; { result too large }
+ NX_EDEADLK = 15; { resource deadlock would occur }
+ NX_EINUSE = 16; { resource(s) in use }
+ NX_ESERVER = 17; { server error (memory out, I/O error, etc.) }
+ NX_ENOSERVR = 18; { no server (queue server, file server, etc.) }
+ NX_EWRNGKND = 19; { wrong kind--an operation is being... }
+ { ...attempted on the wrong kind of object }
+ NX_ETRNREST = 20; { transaction restarted }
+ NX_ERESOURCE = 21; { resources unavailable (maybe permanently) }
+ NX_EBADHNDL = 22; { bad non-file handle (screen, semaphore, etc.) }
+ NX_EAGAIN = 24; { resource temporarily unavailable }
+ NX_EIO = 28; { physical I/O error }
+ NX_EPIPE = 32; { broken pipe }
+ NX_EALREADY = 37; { operation already in progress }
+ NX_ETIMEDOUT = 60; { connection timed out }
+ NX_EBUSY = 62; { resource busy }
+ NX_EINTR = 63; { interrupted function call }
+ NX_EISDIR = 64; { is a directory (not a file) }
+ NX_ENAMETOOLONG = 65; { filename too long }
+ NX_ENOSYS = 66; { function not implemented }
+ NX_ENOTDIR = 67; { not a directory }
+ NX_ENOTEMPTY = 68; { directory is not empty }
+ NX_EPERM = 69; { operation not permitted }
+ NX_ECHILD = 70; { no child process }
+ NX_EFBIG = 71; { file too large }
+ NX_EMLINK = 72; { too many links }
+ NX_ENOLCK = 74; { no locks available }
+ NX_ESRCH = 77; { no such object }
+ NX_ENOTSUP = 79; { this optional functionality not supported }
+ NX_EBADTYPE = 80; { bad type for operation }
+ NX_EOVERFLOW = 81; { operation would overflow }
+ NX_EHOSTDOWN = 82; { host is down }
+ NX_EHOSTUNREACH = 83; { no route to host }
+ NX_EPROCLIM = 84; { too many processes }
+ NX_EUNKNOWN = 99; { unknown error occurring }
+ NX_ENLMDATA = 100; { anomaly in NLM data structure }
+ NX_EILSEQ = 101; { illegal character sequence in multibyte }
+ NX_EINCONSIS = 102; { internal library inconsistency }
+ NX_EDOSTEXTEOL = 103; { DOS-text file inconsistency--no newline... }
+ { ...after carriage return }
+ NX_ENONEXTANT = 104; { object doesn't exist }
+ NX_ENOCONTEXT = 105; { the caller is not an NKS thread }
+ NX_ENAMESPACE = 106; { invalid namespace or namespace operation }
+ NX_EBADCONN = 107; { invalid connection }
+ NX_EEXHAUSTED = 108; { end of search }
+ NX_EFILESYS = 111; { generic file system error }
+ NX_ESUFFICIENT = 112; { insufficient space for any operation result }
+ NX_EPARTONLY = 113; { partial result only for lack of space }
+ NX_EBADIDENT = 114; { invalid user or other identity }
+ { aliases... }
+ NX_ENOSUPPORT = NX_ENOTSUP;
+ //NX_ENORESOURCE = NX_BADIDENT;
+
+
+procedure NXGetNKSVersion(major:Plongint; minor:Plongint; revision:Plongint; platformName:pointer; maxNameLength:size_t);cdecl;external libc_nlm name 'NXGetNKSVersion';
+procedure NXGetNKSVersion(var major, minor, revision:longint; platformName:pchar; maxNameLength:size_t);cdecl;external libc_nlm name 'NXGetNKSVersion';
+function NXStrError(errornumber:longint):Pchar;cdecl;external libc_nlm name 'NXStrError';
+
+
+// nks/mac.h
+{ turn on 1-byte packing... }
+
+ { values for 'fdFlags' (Inside Macintosh IV-105)... }
+
+const
+ fOnDesk = 1;
+ fHasBundle = 8192;
+ fInvisible = 16384;
+ { values for 'fdLocation' (Inside Macintosh IV-105)... }
+ fDisk = 0;
+ fDesktop = -(2);
+ fTrash = -(3);
+ { 'ioFlAttrib' values... }
+ flLocked = $01;
+ flResOpen = $04;
+ flDatOpen = $08;
+ flIsDir = $10;
+ flBothOpen = $80;
+
+type
+ POSType = ^OSType;
+ OSType = char;
+{ (Inside Macintosh II-373) }
+{ (Inside Macintosh I-139) }
+
+ PPoint = ^Point;
+ Point = record
+ v : word;
+ h : word;
+ end;
+{ (Inside Macintosh I-141) }
+
+ PRect = ^Rect;
+ Rect = record
+ case longint of
+ 0 : ( corner : record
+ topLeft : Point;
+ botRight : Point;
+ end );
+ 1 : ( point : record
+ top : word;
+ left : word;
+ bottom : word;
+ right : word;
+ end );
+ end;
+{ (Inside Macintosh IV-104) }
+{ window }
+
+ PFInfo = ^FInfo;
+ FInfo = record
+ fdType : OSType;
+ fdCreator : OSType;
+ fdFlags : word;
+ fdLocation : Point;
+ fdFldr : word;
+ end;
+{ (Inside Macintosh IV-105) }
+{ Finder (Desktop) comment ID }
+{ home directory ID }
+
+ PFXInfo = ^FXInfo;
+ FXInfo = record
+ fdIconID : word;
+ fdUnused : array[0..3] of word;
+ fdComment : word;
+ fdPutAway : dword;
+ end;
+{ (Inside Macintosh IV-105) }
+{ folder's rectangle }
+
+ PDInfo = ^DInfo;
+ DInfo = record
+ frRect : Rect;
+ frFlags : word;
+ frLocation : Point;
+ frView : word;
+ end;
+{ scroll position }
+{ directory ID chain of open folders }
+{ directory ID }
+
+ PDXInfo = ^DXInfo;
+ DXInfo = record
+ frScroll : Point;
+ frOpenChain : dword;
+ frUnused : word;
+ frComment : word;
+ frPutAway : dword;
+ end;
+{ information used by the Finder }
+{ directory ID or file number }
+{ first allocation block of data fork }
+{ logical end-of-file of data fork }
+{ physical end-of-file of data fork }
+{ first allocation block of resource fork }
+{ logical end-of-file of resource fork }
+{ physical end-of-file of resource fork }
+{ date and time of creation }
+{ date and time of last modification }
+{ date and time of last back-up }
+{ additional information used by the Finder }
+{ file's parent directory ID }
+{ file's clump size }
+
+ PhFileInfo = ^hFileInfo;
+ hFileInfo = record
+ ioFlFndrInfo : FInfo;
+ ioDirID : dword;
+ ioFlStBlk : word;
+ ioFlLgLen : dword;
+ ioFlPyLen : dword;
+ ioFlRStBlk : word;
+ ioFlRLgLen : dword;
+ ioFlRPyLen : dword;
+ ioFlCrDat : dword;
+ ioFlMdDat : dword;
+ ioFlBkDat : dword;
+ ioFlXFndrInfo : FXInfo;
+ ioFlParID : dword;
+ ioFlClpSiz : dword;
+ end;
+{ information used by the Finder }
+{ number of files in directory }
+{ date and time of creation }
+{ date and time of last modification }
+{ date and time of last backup }
+{ additional information used by the Finder }
+{ directory's parent directory ID }
+
+ PdirInfo = ^dirInfo;
+ dirInfo = record
+ ioDrUsrWds : DInfo;
+ ioDrDirID : dword;
+ ioDrNmFls : word;
+ filler3 : array[0..8] of word;
+ ioDrCrDat : dword;
+ ioDrMdDat : dword;
+ ioDrBkDat : dword;
+ ioDrFndrInfo : DXInfo;
+ ioDrParID : dword;
+ end;
+
+ PCInfoPBRec = ^CInfoPBRec;
+ CInfoPBRec = record
+ case longint of
+ 0 : ( _file : hFileInfo );
+ 1 : ( dir : dirInfo );
+ end;
+{ Macintosh (NX_PNF_MAC) attributes }
+{ (Inside Macintosh IV-125) }
+{ path reference number }
+
+ PNXDirAttrMac_t = ^NXDirAttrMac_t;
+ NXDirAttrMac_t = record
+ xdeHeader : NXDeHeader_t;
+ xdeFid : NXFid_t;
+ xdeEffectRights : dword;
+ xdeIoFRefNum : word;
+ xdeIofVersNum : int8_t;
+ filler1 : int8_t;
+ xdeIoFDirIndex : word;
+ xdeIoFlAttrib : int8_t;
+ filler2 : int8_t;
+ filler3 : dword;
+ xdeInfo : CInfoPBRec;
+ end;
+{ Macintosh (NX_PNF_MAC) information... }
+{ ...including }
+{ maximum length is 255 characters }
+
+ PNXDirEnumMac_t = ^NXDirEnumMac_t;
+ NXDirEnumMac_t = record
+ deMacDirAttr : NXDirAttrMac_t;
+ deDirMark : NXDirMark_t;
+ deName : pointer;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+// nks/memory.h
+
+ { deprecated values for memory control flags... }
+
+ const
+ NX_PAGE_UNLOCK = $00000000;
+ NX_PAGE_LOCK = $00000001;
+ NX_PAGE_RESERVE = $00000020;
+ NX_PAGE_COMMIT = $00000040;
+ NX_PAGE_PHYSICAL = $00000080;
+ NX_PAGE_RESERVE_ONLY = $00000100;
+ { final values for memory control flags... }
+ NX_MEM_UNLOCK = $00000000;
+ NX_MEM_LOCK = $00000001;
+ NX_MEM_DECOMMIT = $00000020;
+ NX_MEM_COMMIT = $00000040;
+ NX_MEM_RESERVE = $00000100;
+
+function NXMemAlloc(size:size_t; alignment:size_t):pointer;cdecl;external libc_nlm name 'NXMemAlloc';
+function NXMemCtl(start:pointer; size:size_t; flags:dword):longint;cdecl;external libc_nlm name 'NXMemCtl';
+procedure NXMemFree(memory:pointer);cdecl;external libc_nlm name 'NXMemFree';
+function NXMemRealloc(old:pointer; newSize:size_t; alignment:size_t):pointer;cdecl;external libc_nlm name 'NXMemRealloc';
+function NXPageAlloc(pageCount:size_t; flags:dword):pointer;cdecl;external libc_nlm name 'NXPageAlloc';
+procedure NXPageFree(memory:pointer);cdecl;external libc_nlm name 'NXPageFree';
+
+
+{ nks/netware.h =============================================================}
+{ turn on 1-byte packing... }
+
+type
+
+ PnxTrustees_t = ^nxTrustees_t;
+ nxTrustees_t = record
+ trObjectID,
+ trRights : dword;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{----------------------------------------------------------------------------
+ The following are unofficial NKS interfaces and can only be used on NetWare.
+ ----------------------------------------------------------------------------}
+
+procedure nxCancelCheck;cdecl;external libc_nlm name 'nxCancelCheck';
+procedure nxCancelDisable;cdecl;external libc_nlm name 'nxCancelDisable';
+procedure nxCancelEnable;cdecl;external libc_nlm name 'nxCancelEnable';
+function nxContextFlushName(context:PNXContext_t):longint;cdecl;external libc_nlm name 'nxContextFlushName';
+
+function nxExportInterface(funcAddr:pointer; funcName:Pchar):longint;cdecl;external libc_nlm name 'nxExportInterface';
+
+function nxExportInterfaceWrapped(funcAddr:pointer; stackWords:longint; funcName:Pchar; reference:Ppointer):longint;cdecl;external libc_nlm name 'nxExportInterfaceWrapped';
+function nxGetEnviron:PPchar;cdecl;external libc_nlm name 'nxGetEnviron';
+function nxIsLoadedProtected:NXBool_t;cdecl;external libc_nlm name 'nxIsLoadedProtected';
+function nxIsProtectedAddress(_para1:pointer):NXBool_t;cdecl;external libc_nlm name 'nxIsProtectedAddress';
+function nxMemGetSize(block:pointer):size_t;cdecl;external libc_nlm name 'nxMemGetSize';
+procedure nxUnexportInterfaceWrapped(reference:pointer);cdecl;external libc_nlm name 'nxUnexportInterfaceWrapped';
+{ NetWare trustees... }
+
+function nxAddTrustee(pathCtx:NXPathCtx_t; pathname:Pchar; objectID:dword; rights:dword):longint;cdecl;external libc_nlm name 'nxAddTrustee';
+function nxDeleteTrustee(pathCtx:NXPathCtx_t; pathname:Pchar; objectID:dword):longint;cdecl;external libc_nlm name 'nxDeleteTrustee';
+function nxScanTrustees(pathCtx:NXPathCtx_t; pathname:Pchar; sequence:dword; count:Pdword; trusteeVector:PnxTrustees_t;
+ nextSequence:Pdword):longint;cdecl;external libc_nlm name 'nxScanTrustees';
+{ wrap/unwrap sobriquets... }
+// nks/synch.h
+
+{ turn on 1-byte packing... }
+
+type
+ PNXHierarchy_t = ^NXHierarchy_t;
+ NXHierarchy_t = longint;
+
+ PNXMutex_t = ^NXMutex_t;
+ NXMutex_t = record
+ reserved1 : Tuint64;
+ reserved2 : array[0..9] of pointer;
+ end;
+
+ PNXRwLock_t = ^NXRwLock_t;
+ NXRwLock_t = record
+ reserved1 : Tuint64;
+ reserved2 : array[0..9] of pointer;
+ end;
+
+ PNXSema_t = ^NXSema_t;
+ NXSema_t = record
+ reserved1 : Tuint64;
+ reserved2 : array[0..4] of pointer;
+ end;
+
+ PNXCond_t = ^NXCond_t;
+ NXCond_t = record
+ reserved1 : Tuint64;
+ reserved2 : array[0..4] of pointer;
+ end;
+
+ PNXLockInfo_t = ^NXLockInfo_t;
+ NXLockInfo_t = record
+ liName : array[0..(31 + 1)-1] of char;
+ liFlags : dword;
+ liPad : array[0..1] of dword;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ Mutexes... }
+
+
+function NXMutexAlloc(flags:dword; hierarchy:NXHierarchy_t; info:PNXLockInfo_t):PNXMutex_t;cdecl;external libc_nlm name 'NXMutexAlloc';
+procedure NXMutexDeinit(mutex:PNXMutex_t);cdecl;external libc_nlm name 'NXMutexDeinit';
+function NXMutexDepth(mutex:PNXMutex_t):longint;cdecl;external libc_nlm name 'NXMutexDepth';
+procedure NXMutexFree(mutex:PNXMutex_t);cdecl;external libc_nlm name 'NXMutexFree';
+function NXMutexInit(mutex:PNXMutex_t; flags:dword; hierarchy:NXHierarchy_t; info:PNXLockInfo_t):longint;cdecl;external libc_nlm name 'NXMutexInit';
+function NXMutexIsOwned(mutex:PNXMutex_t):NXBool_t;cdecl;external libc_nlm name 'NXMutexIsOwned';
+function NXMutexTestFlag(mutex:PNXMutex_t; flag:dword):NXBool_t;cdecl;external libc_nlm name 'NXMutexTestFlag';
+function NXLock(mutex:PNXMutex_t):longint;cdecl;external libc_nlm name 'NXLock';
+function NXTryLock(mutex:PNXMutex_t):NXBool_t;cdecl;external libc_nlm name 'NXTryLock';
+function NXUnlock(mutex:PNXMutex_t):longint;cdecl;external libc_nlm name 'NXUnlock';
+
+{ Reader-writer locks... }
+function NXRwLockAlloc(hierarchy:NXHierarchy_t; info:PNXLockInfo_t):PNXRwLock_t;cdecl;external libc_nlm name 'NXRwLockAlloc';
+procedure NXRwLockDeinit(lock:PNXRwLock_t);cdecl;external libc_nlm name 'NXRwLockDeinit';
+procedure NXRwLockFree(lock:PNXRwLock_t);cdecl;external libc_nlm name 'NXRwLockFree';
+function NXRwLockInit(lock:PNXRwLock_t; hierarchy:NXHierarchy_t; info:PNXLockInfo_t):longint;cdecl;external libc_nlm name 'NXRwLockInit';
+function NXRwLockIsOwned(lock:PNXRwLock_t; mode:dword):NXBool_t;cdecl;external libc_nlm name 'NXRwLockIsOwned';
+procedure NXRdLock(lock:PNXRwLock_t);cdecl;external libc_nlm name 'NXRdLock';
+procedure NXWrLock(lock:PNXRwLock_t);cdecl;external libc_nlm name 'NXWrLock';
+function NXTryRdLock(lock:PNXRwLock_t):NXBool_t;cdecl;external libc_nlm name 'NXTryRdLock';
+function NXTryWrLock(lock:PNXRwLock_t):NXBool_t;cdecl;external libc_nlm name 'NXTryWrLock';
+procedure NXRwUnlock(lock:PNXRwLock_t);cdecl;external libc_nlm name 'NXRwUnlock';
+function NXRwLockUpgrade(lock:PNXRwLock_t):longint;cdecl;external libc_nlm name 'NXRwLockUpgrade';
+function NXRwLockDowngrade(lock:PNXRwLock_t):longint;cdecl;external libc_nlm name 'NXRwLockDowngrade';
+{ Semaphores... }
+function NXSemaAlloc(count:dword; arg:pointer):PNXSema_t;cdecl;external libc_nlm name 'NXSemaAlloc';
+procedure NXSemaDeinit(sema:PNXSema_t);cdecl;external libc_nlm name 'NXSemaDeinit';
+procedure NXSemaFree(sema:PNXSema_t);cdecl;external libc_nlm name 'NXSemaFree';
+function NXSemaInit(sema:PNXSema_t; count:dword; arg:pointer):longint;cdecl;external libc_nlm name 'NXSemaInit';
+procedure NXSemaPost(sema:PNXSema_t);cdecl;external libc_nlm name 'NXSemaPost';
+function NXSemaTryWait(sema:PNXSema_t):NXBool_t;cdecl;external libc_nlm name 'NXSemaTryWait';
+procedure NXSemaWait(sema:PNXSema_t);cdecl;external libc_nlm name 'NXSemaWait';
+{ Condition variables... }
+function NXCondAlloc(arg:pointer):PNXCond_t;cdecl;external libc_nlm name 'NXCondAlloc';
+procedure NXCondBroadcast(cond:PNXCond_t);cdecl;external libc_nlm name 'NXCondBroadcast';
+procedure NXCondDeinit(cond:PNXCond_t);cdecl;external libc_nlm name 'NXCondDeinit';
+procedure NXCondFree(cond:PNXCond_t);cdecl;external libc_nlm name 'NXCondFree';
+function NXCondInit(cond:PNXCond_t; arg:pointer):longint;cdecl;external libc_nlm name 'NXCondInit';
+procedure NXCondSignal(cond:PNXCond_t);cdecl;external libc_nlm name 'NXCondSignal';
+function NXCondWait(cond:PNXCond_t; mutex:PNXMutex_t):longint;cdecl;external libc_nlm name 'NXCondWait';
+function NXCondTimedWait(cond:PNXCond_t; mutex:PNXMutex_t; interval:dword):longint;cdecl;external libc_nlm name 'NXCondTimedWait';
+
+
+
+
+// assert.h
+
+procedure _assert(_para1,_para2, _para3:Pchar; ActionCode:longint);cdecl;external libc_nlm name '_assert';
+procedure FpAssert(_para1,_para2, _para3:Pchar; ActionCode:longint);cdecl;external libc_nlm name '_assert';
+
+type
+ Taction_code = Longint;
+Const // modifications to behavior of assert()
+ __IGNORE = -(1); // assert() prints but returns -1
+ __NOERR = 0; // (value returned for no assertion)
+ __ABORT = 1; // assert() aborts (normal, default action)
+ __DEBUGGER = 2; // assert() prints and drops into the debugger
+
+function assert_action(_para1:Taction_code):longint;cdecl;external libc_nlm name 'assert_action';
+function _assert_expr(_para1:longint; _para2,_para3,_para4:Pchar; _para5:longint):longint;cdecl;external libc_nlm name '_assert_expr';
+
+// nks/unix.h
+
+{ turn on 1-byte packing... }
+
+{ UNIX (NX_PNF_UNIX) attributes }
+{ file mode }
+{ number of links }
+{ last access time (files only) }
+{ last modify time }
+{ last archive time }
+{ last attribute change time (or 0) }
+{ generation; bumped when file modified }
+{ entry serial number }
+{ file system (device) containing entry }
+{ ID of raw device containing this entry }
+{ user ID of the owner of this entry }
+{ group ID of the group of this entry }
+{ length of file in bytes }
+{ number of 512-byte blocks allocated }
+{ preferred I/O block size }
+type
+
+ PNXDirAttrUnix_t = ^NXDirAttrUnix_t;
+ NXDirAttrUnix_t = record
+ xdeHeader : NXDeHeader_t;
+ xdeFid : NXFid_t;
+ xdeEffectiveRights : dword;
+ xde_mode : dword;
+ xde_nlink : dword;
+ spare1 : dword;
+ xde_atime : time_t;
+ xde_mtime : time_t;
+ xde_btime : time_t;
+ xde_ctime : time_t;
+ xde_change : Tuint64;
+ xde_ino : Tuint64;
+ xde_dev : array[0..1] of Tuint64;
+ xde_rdev : array[0..1] of Tuint64;
+ xde_uid : Tuint64;
+ xde_gid : Tuint64;
+ xde_size : Tuint64;
+ xde_blocks : Tuint64;
+ xde_blksize : dword;
+ spare2 : dword;
+ spare3 : Tuint64;
+ spare4 : Tuint64;
+ spare5 : Tuint64;
+ spare6 : Tuint64;
+ spare7 : Tuint64;
+ spare8 : Tuint64;
+ end;
+{ UNIX (NX_PNF_UNIX) information... }
+{ ...including name }
+{ maximum length is 255 characters }
+
+ PNXDirEnumUnix_t = ^NXDirEnumUnix_t;
+ NXDirEnumUnix_t = record
+ deUnixDirAttr : NXDirAttrUnix_t;
+ deDirMark : NXDirMark_t;
+ deName : pointer;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+// nks/vm.h
+
+{ value for 'wait_for' in NXVmJoin()... }
+{ values for 'flags' in NXVmSpawn()... }
+{ returned in newVm if NXVmSpawn() is passed NX_VM_DETACHED or if it fails }
+
+{ turn on 1-byte packing... }
+
+type
+ PNXStrType_t = ^NXStrType_t;
+ NXStrType_t = Longint;
+Const
+ NX_STR_ASCII = $FFFFFFFF;
+ NX_STR_UTF8 = $00000000;
+ NX_STR_UNICODE = $00000001;
+
+{ NX_OBJ_FILE, NX_OBJ_CONSOLE, NX_OBJ_FIFO, etc. }
+{ set to 0 }
+{ ancestor of 'ssPath' }
+{ relative to 'ssPathCtx' }
+type
+ PNXNameSpec_t = ^NXNameSpec_t;
+ NXNameSpec_t = record
+ ssType : NXObjType_t;
+ ssReserved : longint;
+ ssPathCtx : NXPathCtx_t;
+ ssPath : pointer;
+ end;
+ NXStreamSpec_t = NXNameSpec_t;
+ PNXStreamSpec_t = ^NXStreamSpec_t;
+{ unused; set to 0 }
+{ count of arguments in 'esArgv' }
+{ command-line arguments to spawned VM }
+{ starting environment of spawned VM }
+{ wiring of standard input for spawned VM }
+{ wiring of standard output for spawned VM }
+{ wiring of standard error for spawned VM }
+
+ PNXExecEnvSpec_t = ^NXExecEnvSpec_t;
+ NXExecEnvSpec_t = record
+ esFlags : longint;
+ esArgc : longint;
+ esArgv : ^pointer;
+ esEnv : ^pointer;
+ esStdin : NXStreamSpec_t;
+ esStdout : NXStreamSpec_t;
+ esStderr : NXStreamSpec_t;
+ end;
+{ maxmimum number of threads in worker pool }
+{ implementation-reserved }
+
+ PNXVmWorkerThreadConfig_t = ^NXVmWorkerThreadConfig_t;
+ NXVmWorkerThreadConfig_t = record
+ wtcThreads : size_t;
+ reserved : array[0..4] of longint;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ Virtual machine management... }
+
+function NXVmDestroy(id:NXVmId_t):longint;cdecl;external libc_nlm name 'NXVmDestroy';
+procedure NXVmExit(status:longint);cdecl;external libc_nlm name 'NXVmExit';
+function NXVmGetId:NXVmId_t;cdecl;external libc_nlm name 'NXVmGetId';
+function NXVmGetWorkerThreadConfig(reserved:pointer; config:PNXVmWorkerThreadConfig_t):longint;cdecl;external libc_nlm name 'NXVmGetWorkerThreadConfig';
+function NXVmGetStringType(_type:PNXStrType_t):longint;cdecl;external libc_nlm name 'NXVmGetStringType';
+function NXVmJoin(wait_for:NXVmId_t; departed_vm:PNXVmId_t; status:Plongint):longint;cdecl;external libc_nlm name 'NXVmJoin';
+function NXVmRegisterExitHandler(cleanup:TCDeclProc1PtrArg; arg:pointer):longint;cdecl;external libc_nlm name 'NXVmRegisterExitHandler';
+function NXVmSetWorkerThreadConfig(reserved:pointer; config:PNXVmWorkerThreadConfig_t):longint;cdecl;external libc_nlm name 'NXVmSetWorkerThreadConfig';
+function NXVmSpawn(name:PNXNameSpec_t; envSpec:PNXExecEnvSpec_t; flags:dword; newVm:PNXVmId_t):longint;cdecl;external libc_nlm name 'NXVmSpawn';
+function NXVmUnregisterExitHandler(func:TCDeclProc1PtrArg; arg:pointer):longint;cdecl;external libc_nlm name 'NXVmUnregisterExitHandler';
+
+
+// alloca.h
+{ Non-standard functions from stdlib.h }
+//** void *alloca( size_t );
+
+
+// client.h
+
+// stdbool.h
+
+{ origin flags... }
+{ address type flags (used in combination with ORIGIN_ADDRESS)... }
+{ transport type flags... }
+{ NMAS sequence passed... }
+{ string format flags... }
+{ suggested maximum lengths (in characters)... }
+
+{ turn on 1-byte packing... }
+
+ const
+ ORIGIN_NAME = $0010;
+ ORIGIN_ADDRESS = $0020; { interpret 'server' as 'netaddr_t' }
+ { address type flags (used in combination with ORIGIN_ADDRESS)... }
+ { address is IPX }
+ ADDR_IPX = $0100;
+ ADDR_IP = $0200; { address is Internet Protocol }
+ ADDR_IPV6 = $0400; { address is Internet Protocol version 6 }
+ { transport type flags... }
+ { transport type unspecified }
+ XPORT_WILD = $0000;
+ { prefer Novell IPX }
+ XPORT_IPX = $0001;
+ { prefer TCP }
+ XPORT_TCP = $0002;
+ { NMAS sequence passed... }
+ { alternative NMAS-based authentication }
+ NMAS_SEQUENCE = $8000;
+ { string format flags... }
+ USERNAME_ASCII = $00000;
+ USERNAME_UTF8 = $10000;
+ USERNAME_UNICODE = $20000;
+ { suggested maximum lengths (in characters)... }
+ { ASCII, Unicode or UTF-8 }
+ MAX_USERNAME_LEN = 255;
+ { (always in ASCII characters) }
+ MAX_PASSWORD_LEN = 255;
+ MAX_TREENAME_LEN = 48;
+ MAX_SERVERNAME_LEN = 48;
+
+
+type
+
+ Pnetaddr_t = ^netaddr_t;
+ netaddr_t = record
+ _type : longint;
+ length : size_t;
+ address : array[0..47] of byte;
+ end;
+
+ Pfrag_t = ^frag_t;
+ frag_t = record
+ data : pointer;
+ length : size_t;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ managing user identity... }
+
+
+{$ifndef DisableArrayOfConst}
+function build_username(max:size_t; flags:dword; username:Pchar; user:Pchar; args:array of const):longint;cdecl;external libc_nlm name 'build_username';
+{$endif}
+function build_username(max:size_t; flags:dword; username:Pchar; user:Pchar):longint;cdecl;external libc_nlm name 'build_username';
+
+
+function create_identity(treename:Pchar; username:pointer; password:Pchar; nmas_sequence:pointer; flags:dword;
+ identity:Plongint):longint;cdecl;external libc_nlm name 'create_identity';
+function create_server_identity(identity:Plongint):longint;cdecl;external libc_nlm name 'create_server_identity';
+function is_valid_identity(identity:longint; error:Plongint):longint;cdecl;external libc_nlm name 'is_valid_identity';
+procedure delete_identity(identity:longint);cdecl;external libc_nlm name 'delete_identity';
+{ managing NCP sessions with a remote server... }
+
+function open_ncp_session(identity:longint; flags:dword; servername:Pchar; session:Plongint):longint;cdecl;external libc_nlm name 'open_ncp_session';
+function close_ncp_session(session:longint):longint;cdecl;external libc_nlm name 'close_ncp_session';
+function send_ncp(session:longint; requestCode:longint; sendFragCount:longint; sendFrags:array of frag_t; replyFragCount:longint;
+ replyFrags:array of frag_t; replyFragsUsed:Plongint; ncp_error:Plongint):longint;cdecl;external libc_nlm name 'send_ncp';
+
+// complex.h
+
+{ not presently supported }
+
+
+// ctype.h
+// var __ctype : array of byte;cvar;external;
+{ standard prototypes... }
+
+function isalnum(_para1:longint):longint;cdecl;external libc_nlm name 'isalnum';
+function isalpha(_para1:longint):longint;cdecl;external libc_nlm name 'isalpha';
+function isblank(_para1:longint):longint;cdecl;external libc_nlm name 'isblank';
+function iscntrl(_para1:longint):longint;cdecl;external libc_nlm name 'iscntrl';
+function isdigit(_para1:longint):longint;cdecl;external libc_nlm name 'isdigit';
+function isgraph(_para1:longint):longint;cdecl;external libc_nlm name 'isgraph';
+function islower(_para1:longint):longint;cdecl;external libc_nlm name 'islower';
+function isprint(_para1:longint):longint;cdecl;external libc_nlm name 'isprint';
+function ispunct(_para1:longint):longint;cdecl;external libc_nlm name 'ispunct';
+function isspace(_para1:longint):longint;cdecl;external libc_nlm name 'isspace';
+function isupper(_para1:longint):longint;cdecl;external libc_nlm name 'isupper';
+function isxdigit(_para1:longint):longint;cdecl;external libc_nlm name 'isxdigit';
+function tolower(_para1:longint):longint;cdecl;external libc_nlm name 'tolower';
+function toupper(_para1:longint):longint;cdecl;external libc_nlm name 'toupper';
+function isascii(_para1:longint):longint;cdecl;external libc_nlm name 'isascii';
+function toascii(_para1:longint):longint;cdecl;external libc_nlm name 'toascii';
+function ismultibyte(_para1:Pchar):longint;cdecl;external libc_nlm name 'ismultibyte';
+function Lisalnum(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisalnum';
+function Lisalpha(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisalpha';
+function Lisblank(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisblank';
+function Liscntrl(_para1:Pchar):longint;cdecl;external libc_nlm name 'Liscntrl';
+function Lisdigit(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisdigit';
+function Lisgraph(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisgraph';
+function Lislower(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lislower';
+function Lisprint(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisprint';
+function Lispunct(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lispunct';
+function Lisspace(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisspace';
+function Lisupper(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisupper';
+function Lisxdigit(_para1:Pchar):longint;cdecl;external libc_nlm name 'Lisxdigit';
+
+
+// dfs.h
+
+{===========================================================
+ Traditional direct file system
+ These were interfaced by CLib in its NDK header, nwdfs.h
+============================================================}
+
+ const
+ DFS_FAILURE = -(1);
+ DFS_SUCCESS = 0;
+ DFS_ERR_INSUFFICIENT_SPACE = 1;
+ DFS_ERR_VOLUME_SEGMENT_DEACTIVATED = 4;
+ DFS_ERR_TRUNCATION_FAILURE = 16;
+ DFS_ERR_HOLE_IN_FILE = 17;
+ DFS_ERR_PARAMETER = 18;
+ DFS_ERR_OVERLAP = 19;
+ DFS_ERR_SEGMENT = 20;
+ DFS_ERR_BOUNDARY = 21;
+ DFS_ERR_INSUFFICIENT_LIMBO_FILE_SPACE = 22;
+ DFS_ERR_NOT_IN_DIRECT_FILE_MODE = 23;
+ DFS_ERR_OPERATION_BEYOND_EOF = 24;
+ DFS_ERR_OUT_OF_FILDES = 129;
+ DFS_ERR_HARD_IO = 131;
+ DFS_ERR_EBADF = 136;
+ DFS_ERR_CANT_READ = 147;
+ DFS_ERR_CANT_WRITE = 148;
+ DFS_ERR_FILE_DETACHED = 149;
+ DFS_ERR_ENOMEM = 150;
+ DFS_ERR_INVALID_VOLUME = 152;
+ DFS_ERR_IO_LOCK = 162;
+ { setSizeFlags }
+
+ DFS_SETSIZE_NON_SPARSE_FILE = $00000001; { to extend the file }
+ DFS_SETSIZE_NO_ZERO_FILL = $00000002; { do not zero fill }
+ DFS_SETSIZE_UNDO_ON_ERROR = $00000004; { truncate to original eof }
+ DFS_SETSIZE_PHYSICAL_ONLY = $00000008; { change physical EOF only }
+ DFS_SETSIZE_LOGICAL_ONLY = $00000010; { change only the logical EOF }
+
+
+{ type definitions... }
+type
+
+ Pdfs_filemap_t = ^dfs_filemap_t;
+ dfs_filemap_t = record
+ FileBlock : longint;
+ VolumeBlock : longint;
+ NumberOfBlocks : longint;
+ end;
+
+ Pdfs_volinfo_t = ^dfs_volinfo_t;
+ dfs_volinfo_t = record
+ VolumeAllocationUnitSizeInBytes : size_t;
+ VolumeSizeInAllocationUnits : size_t;
+ VolumeSectorSize : size_t;
+ AllocationUnitsUsed : longint;
+ AllocationUnitsFreelyAvailable : longint;
+ AllocationUnitsInDeletedFilesNotAvailable : longint;
+ AllocationUnitsInAvailableDeletedFiles : longint;
+ NumberOfPhysicalSegmentsInVolume : longint;
+ PhysicalSegmentSizeInAllocationUnits : array[0..63] of size_t;
+ end;
+
+ Pdfs_cbparms_t = ^dfs_cbparms_t;
+ dfs_cbparms_t = record
+ sema : pointer;
+ ccode : longint;
+ end;
+{ dlfcn.h
+==============================================================================
+= Interfaces from the Single UNIX Specification of the Open Group for the
+= management of imported symbols and shared (dynamic) libraries. The imple-
+= mentation on NetWare is narrower as noted by the number of features that
+= are ignored or unsupported.
+==============================================================================}
+ const
+ RTLD_LAZY = $01;
+ RTLD_NOW = $02; { ignored }
+ RTLD_GLOBAL = $04; { ignored }
+ RTLD_LOCAL = $08; { ignored }
+ RTLD_MULTIPLE = $10; { NetWare: force-load multiple times }
+ MAX_DLL_NAME_LEN = 8; { special purpose value for 'handle' in dlsym()... }
+ MAX_SYMNAME_LEN = 255; { maximim length of 'name' in dlsym()... }
+
+
+function dlopen(path:Pchar; mode:longint):pointer;cdecl;external libc_nlm name 'dlopen';
+function dlsym(handle:pointer; name:Pchar):pointer;cdecl;external libc_nlm name 'dlsym';
+function dlclose(handle:pointer):longint;cdecl;external libc_nlm name 'dlclose';
+function dlerror:Pchar;cdecl;external libc_nlm name 'dlerror';
+
+
+// endian.h
+{ defines `__BYTE_ORDER' for the hosting environment... }
+{ some environments use a different "endianness" for floating point values }
+
+ const
+ __LITTLE_ENDIAN = 1234;
+ __BIG_ENDIAN = 4321;
+ __PDP_ENDIAN = 3412;
+ { defines `__BYTE_ORDER' for the hosting environment... }
+ __BYTE_ORDER = __LITTLE_ENDIAN;
+ __FLOAT_WORD_ORDER = __BYTE_ORDER;
+ LITTLE_ENDIAN = __LITTLE_ENDIAN;
+ BIG_ENDIAN = __BIG_ENDIAN;
+ PDP_ENDIAN = __PDP_ENDIAN;
+ BYTE_ORDER = __BYTE_ORDER;
+
+
+
+// err.h
+
+{$ifndef DisableArrayOfConst}
+procedure err(_para1:longint; _para2:Pchar; args:array of const);cdecl;external libc_nlm name 'err';
+{$endif}
+procedure err(_para1:longint; _para2:Pchar);cdecl;external libc_nlm name 'err';
+procedure verr(_para1:longint; _para2:Pchar; _para3:va_list);cdecl;external libc_nlm name 'verr';
+
+{$ifndef DisableArrayOfConst}
+procedure errx(_para1:longint; _para2:Pchar; args:array of const);cdecl;external libc_nlm name 'errx';
+{$endif}
+procedure errx(_para1:longint; _para2:Pchar);cdecl;external libc_nlm name 'errx';
+procedure verrx(_para1:longint; _para2:Pchar; _para3:va_list);cdecl;external libc_nlm name 'verrx';
+
+{$ifndef DisableArrayOfConst}
+procedure warn(_para1:Pchar; args:array of const);cdecl;external libc_nlm name 'warn';
+{$endif}
+procedure warn(_para1:Pchar);cdecl;external libc_nlm name 'warn';
+procedure vwarn(_para1:Pchar; _para2:va_list);cdecl;external libc_nlm name 'vwarn';
+
+{$ifndef DisableArrayOfConst}
+procedure warnx(_para1:Pchar; args:array of const);cdecl;external libc_nlm name 'warnx';
+{$endif}
+procedure warnx(_para1:Pchar);cdecl;external libc_nlm name 'warnx';
+procedure vwarnx(_para1:Pchar; _para2:va_list);cdecl;external libc_nlm name 'vwarnx';
+
+
+
+// errno.h
+
+ const
+ ENOENT = 1;
+ E2BIG = 2; { arg list too big }
+ ENOEXEC = 3; { exec format error }
+ EBADF = 4; { bad file number }
+ ENOMEM = 5; { not enough memory }
+ EACCES = 6; { permission denied }
+ EEXIST = 7; { file exists }
+ EXDEV = 8; { cross-device link }
+ EINVAL = 9; { invalid argument }
+ ENFILE = 10; { file table overflow }
+ EMFILE = 11; { too many open files }
+ ENOSPC = 12; { no space left on device }
+ EDOM = 13; { argument too large }
+ ERANGE = 14; { result too large }
+ EDEADLK = 15; { resource deadlock would occur }
+ { -------------------------- Miscellaneous NLM Library constants ---------- }
+ EINUSE = 16; { resource(s) in use }
+ ESERVER = 17; { server error (memory out, I/O error, etc.) }
+ ENOSERVR = 18; { no server (queue server, file server, etc.) }
+ EWRNGKND = 19; { wrong kind--an operation is being... }
+ { ...attempted on the wrong kind of object }
+ ETRNREST = 20; { transaction restarted }
+ ERESOURCE = 21; { resources unavailable (maybe permanently) }
+ EBADHNDL = 22; { bad non-file handle (screen, semaphore, etc.) }
+ ENO_SCRNS = 23; { screen I/O attempted when no screens }
+ { -------------------------- Additional POSIX / traditional UNIX constants }
+ EAGAIN = 24; { resource temporarily unavailable }
+ ENXIO = 25; { no such device or address }
+ EBADMSG = 26; { not a data message }
+ EFAULT = 27; { bad address }
+ EIO = 28; { physical I/O error }
+ ENODATA = 29; { no data }
+ ENOSTRMS = 30; { streams not available }
+ { Berkeley sockets constants ------------------ }
+ EPROTO = 31; { fatal protocol error }
+ EPIPE = 32; { broken pipe }
+ ESPIPE = 33; { illegal seek }
+ { Non-blocking and interrupt I/O constants ---- }
+ ETIME = 34; { ioctl acknowledge timeout }
+ EWOULDBLOCK = 35; { operation would block }
+ EINPROGRESS = 36; { operation now in progress }
+ EALREADY = 37; { operation already in progress }
+ { IPC network argument constants -------------- }
+ ENOTSOCK = 38; { socket operation on non-socket }
+ EDESTADDRREQ = 39; { destination address required }
+ EMSGSIZE = 40; { message too long }
+ EPROTOTYPE = 41; { protocol wrong type for socket }
+ ENOPROTOOPT = 42; { protocol not available }
+ EPROTONOSUPPORT = 43;{ protocol not supported }
+ ESOCKTNOSUPPORT = 44;{ socket type not supported }
+ EOPNOTSUPP = 45; { operation not supported on socket }
+ EPFNOSUPPORT = 46; { protocol family not supported }
+ EAFNOSUPPORT = 47; { address family unsupported by protocol family }
+ EADDRINUSE = 48; { address already in use }
+ EADDRNOTAVAIL = 49; { can't assign requested address }
+ { Operational constants ----------------------- }
+ ENETDOWN = 50; { network is down }
+ ENETUNREACH = 51; { network is unreachable }
+ ENETRESET = 52; { network dropped connection on reset }
+ ECONNABORTED = 53; { software caused connection abort }
+ ECONNRESET = 54; { connection reset by peer }
+ ENOBUFS = 55; { no buffer space available }
+ EISCONN = 56; { socket is already connected }
+ ENOTCONN = 57; { socket is not connected }
+ ESHUTDOWN = 58; { can't send after socket shutdown }
+ ETOOMANYREFS = 59; { too many references: can't splice }
+ ETIMEDOUT = 60; { connection timed out }
+ ECONNREFUSED = 61; { connection refused }
+ { -------------------------- Additional POSIX-mandated constants ---------- }
+ EBUSY = 62; { resource busy }
+ EINTR = 63; { interrupted function call }
+ EISDIR = 64; { is a directory }
+ ENAMETOOLONG = 65; { filename too long }
+ ENOSYS = 66; { function not implemented }
+ ENOTDIR = 67; { not a directory }
+ ENOTEMPTY = 68; { directory not empty }
+ EPERM = 69; { operation not permitted }
+ ECHILD = 70; { no child process }
+ EFBIG = 71; { file too large }
+ EMLINK = 72; { too many links }
+ ENODEV = 73; { no such device }
+ ENOLCK = 74; { no locks available }
+ ENOTTY = 75; { inappropriate I/O control operation }
+ EFTYPE = ENOTTY; { inappropriate operation for file type }
+ EROFS = 76; { read-only file system }
+ ESRCH = 77; { no such process }
+ ECANCELED = 78; { operation was cancelled }
+ ENOTSUP = 79; { this optional functionality not supported }
+ ECANCELLED = ECANCELED;
+ EBADTYPE = 80; { bad type for operation }
+ EOVERFLOW = 81; { operation would overflow }
+ EHOSTDOWN = 82; { host is down }
+ EHOSTUNREACH = 83; { no route to host }
+ EPROCLIM = 84; { too many processes }
+ { -------------------------- Additional POSIX / traditional UNIX constants }
+ ENOMSG = 90; { message does not exist }
+ { -------------------------- LibC-implementation-specific constants ------- }
+ ENLMDATA = 100; { anomaly in NLM data structure }
+ EILSEQ = 101; { illegal character sequence in multibyte }
+ EINCONSIS = 102; { internal library inconsistency }
+ EDOSTEXTEOL = 103; { DOS-text file inconsistency--no newline... }
+ { ...after carriage return }
+ ENONEXTANT = 104; { object doesn't exist }
+ ENOCONTEXT = 105; { no thread library context present }
+ ENAMESPACE = 106; { invalid namespace or operation }
+ EBADCONN = 107; { invalid connection }
+ ENAMEINVAL = 108; { invalid NDS name }
+ EPASSINVAL = 109; { invalid password }
+ ENCPINVAL = 110; { invalid or erroneous NCP }
+ EFILESYS = 111; { generic file system error, see 'filesyserrno' }
+ ESUFFICIENT = 112; { insufficient space for any operation result }
+ EPARTONLY = 113; { partial result only for lack of space }
+ EBADIDENT = 114; { invalid user or other identity }
+ ENDS = 115; { generic eDirectory error, see 'h_errno' }
+ ENCP = 116; { generic NCP error, see 'h_errno' }
+ ELOOKUP = 117; { generic look-up error, see 'h_errno' }
+ ELASTERR = ELOOKUP;
+
+
+function ___errno:Plongint;cdecl;external libc_nlm name '___errno';
+function __errno_location:Plongint;cdecl;external libc_nlm name '___errno';
+function ___lastClientErrno:Plongint;cdecl;external libc_nlm name '___lastClientErrno';
+function ___lastFileSysErrno:Plongint;cdecl;external libc_nlm name '___lastFileSysErrno';
+
+
+// esm.h
+
+ const
+ ERR_ESM_AVAL = 1;
+ ERR_SIZE_ZERO = 2; { ESMAlloc size requested is zero }
+ ERR_TABLE_FULL = 3; { allocation table is full }
+ ERR_NOT_CONTIGUOUS = 4; { ESMAlloc request cannot be continguous }
+ ERR_INVAL_ADDRESS = 5; { already free or out of range }
+ ERR_INVAL_SRC_ADDR = 6; { bad source address (ESMCopy) }
+ ERR_INVAL_DEST_ADDR = 7; { bad destination address(ESMCopy/ESMFill) }
+ ERR_SRC_DEST_OVERLAP = 8; { buffer overlap (ESMCopy) }
+ { (will be obsolete when the overlapping buffer copy implemented...) }
+ ERR_MAP_4M_PAGE = 9; { mapping particular 4M page failed }
+ ERR_BUFFER_SIZE = 10; { buffer passed too small (ESMQuery) }
+ ERR_LOGICAL_SPACE = 11; { adequate logical/window not available }
+ ERR_ACQUIRING_LOCK = 12; { failed to acquire lock (please retry) }
+
+type
+ Paddr64_t = ^addr64_t;
+ addr64_t = Tuint64;
+
+ PESMQueryInfo_t = ^ESMQueryInfo_t;
+ ESMQueryInfo_t = record
+ TotalExtendedMemory : size64_t;
+ RemainingExtendedMemory : size64_t;
+ TotalMemoryBelow4G : size_t;
+ end;
+
+function ESMAlloc(size:size64_t; options:dword; esmAddress:Paddr64_t):longint;cdecl;external libc_nlm name 'ESMAlloc';
+function ESMAllocWindow(size:size_t; logicalAddress:Ppointer; callerID:pointer):longint;cdecl;external libc_nlm name 'ESMAllocWindow';
+function ESMCopy(source:addr64_t; destination:addr64_t; length:size64_t):longint;cdecl;external libc_nlm name 'ESMCopy';
+function ESMFill(pattern:dword; destination:addr64_t; length:size64_t):longint;cdecl;external libc_nlm name 'ESMFill';
+function ESMFree(esmAddress:addr64_t):longint;cdecl;external libc_nlm name 'ESMFree';
+function ESMFreeWindow(logicalAddress:pointer; callerID:pointer):longint;cdecl;external libc_nlm name 'ESMFreeWindow';
+function ESMMapMemory(windowAddress:pointer; memoryAddress:addr64_t; size:size_t):longint;cdecl;external libc_nlm name 'ESMMapMemory';
+function ESMQuery(bufferSize:size_t; buffer:PESMQueryInfo_t):longint;cdecl;external libc_nlm name 'ESMQuery';
+
+
+
+// float.h
+{ turn on 1-byte packing... }
+
+{
+typedef union __fp_u
+
+ unsigned char __uc[16];
+ float __f;
+ double __d;
+ long double __ld;
+ __fp_u;
+ }
+{
+typedef struct __fp_s
+
+ int __MANT_DIG;
+ int __DIG;
+ int __MIN_EXP;
+ int __MIN_10_EXP;
+ int __MAX_EXP;
+ int __MAX_10_EXP;
+ __fp_u __EPSILON[2];
+ __fp_u __MIN[2];
+ __fp_u __MAX[2];
+ __fp_s;
+ }
+
+(** unsupported pragma#pragma pack()*)
+{ extern const __fp_s __fp_characteristics[3]; }
+
+
+// fenv.h
+
+{ these interfaces not presently supported! }
+{ floating-point exception bits for 'excepts' argument }
+
+{ turn on 1-byte packing... }
+
+ { these interfaces not presently supported! }
+
+ const
+ _MAX_FPFLAGS = 8;
+ { floating-point exception bits for 'excepts' argument }
+ FE_DIVBYZERO = $00000001;
+ FE_INEXACT = $00000002;
+ FE_INVALID = $00000004;
+ FE_OVERFLOW = $00000008;
+ FE_UNDERFLOW = $00000010;
+ FE_ALL_EXCEPT = $00000020;
+ FE_DOWNWARD = $00000040;
+ FE_TONEAREST = $00000080;
+ FE_TOWARDZERO = $00000100;
+ FE_UPWARD = $00000200;
+ FE_DFL_ENV = $00000400;
+
+
+type
+ Pfexcept_t = ^fexcept_t;
+ fexcept_t = dword;
+
+ Pfenv_t = ^fenv_t;
+ fenv_t = record
+ excepts : longint;
+ flagp : fexcept_t;
+ end;
+
+
+(** unsupported pragma#pragma pack()*)
+{ not presently supported... }
+
+procedure feclearexcept(excepts:longint);cdecl;external libc_nlm name 'feclearexcept';
+procedure fegetexceptflag(flagp:Pfexcept_t; excepts:longint);cdecl;external libc_nlm name 'fegetexceptflag';
+procedure feraiseexceptflag(flagp:Pfexcept_t; excepts:longint);cdecl;external libc_nlm name 'feraiseexceptflag';
+procedure fesetexceptflag(flagp:Pfexcept_t; excepts:longint);cdecl;external libc_nlm name 'fesetexceptflag';
+function fetestexcept(excepts:longint):longint;cdecl;external libc_nlm name 'fetestexcept';
+function fegetround(round:longint):longint;cdecl;external libc_nlm name 'fegetround';
+function fesetround:longint;cdecl;external libc_nlm name 'fesetround';
+function fegetenv(envp:Pfenv_t):longint;cdecl;external libc_nlm name 'fegetenv';
+function feholdexcept(envp:Pfenv_t):longint;cdecl;external libc_nlm name 'feholdexcept';
+procedure fesetenv(envp:Pfenv_t);cdecl;external libc_nlm name 'fesetenv';
+procedure feupdateenv(envp:Pfenv_t);cdecl;external libc_nlm name 'feupdateenv';
+
+
+
+// fnmatch.h
+
+ const
+ FNM_NOMATCH = -(1); { string fails to match pattern }
+ { values for field 'flags'... }
+ FNM_NOSYS = $01; { reserved (unused) }
+ FNM_PATHNAME = $02; { slash in string must match in pattern }
+ FNM_PERIOD = $04; { leading period in string must match in pattern }
+ FNM_NOESCAPE = $08; { disable backslash escaping }
+ FNM_CASEFOLD = $10; { ignore case }
+ FNM_LEADING_DIR = $20; { Ignore `/...' after a match }
+ FNM_FILE_NAME = FNM_PATHNAME;
+
+
+
+function fnmatch(pattern, _string:Pchar; flags:longint):longint;cdecl;external libc_nlm name 'fnmatch';
+
+
+
+// fshooks.h
+
+ const
+ FSHOOK_MAY_NOT_SLEEP_BIT = $00000001;
+ FSHOOK_SORT_LOW_TO_HIGH_BIT = $00000002;
+ FSHOOK_CONSUMABLE_BIT = $00000004;
+ FSHOOK_NO_SA_BIT = $00000008;
+ FSHOOK_NO_AUDITOR_BIT = $00000010;
+ FSHOOK_NO_CHECK_BIT = $00000020;
+ FSHOOK_NESL_DATA_BIT = $00000040;
+ FSHOOK_NESL_SHIM_BIT = $00000080;
+ FSHOOK_DATA_FILTERED_BIT = $80000000;
+
+ FSHOOK_TYPE_DELETE_WARN = 0;
+ FSHOOK_TYPE_DELETE_REPORT = 1;
+ FSHOOK_TYPE_CREATE_WARN = 2;
+ FSHOOK_TYPE_CREATE_REPORT = 3;
+ FSHOOK_TYPE_OPEN_WARN = 4;
+ FSHOOK_TYPE_OPEN_REPORT = 5;
+ FSHOOK_TYPE_CLOSE_WARN = 6;
+ FSHOOK_TYPE_CLOSE_REPORT = 7;
+ FSHOOK_TYPE_RENAME_WARN = 8;
+ FSHOOK_TYPE_RENAME_REPORT = 9;
+ FSHOOK_TYPE_MODIFYINFO_WARN = 10;
+ FSHOOK_TYPE_MODIFYINFO_REPORT = 11;
+ FSHOOK_TYPE_SETDATASIZE_WARN = 12;
+ FSHOOK_TYPE_SETDATASIZE_REPORT = 13;
+ FSHOOK_TYPE_ADDTRUSTEE_WARN = 14;
+ FSHOOK_TYPE_ADDTRUSTEE_REPORT = 15;
+ FSHOOK_TYPE_REMOVETRUSTEE_WARN = 16;
+ FSHOOK_TYPE_REMOVETRUSTEE_REPORT = 17;
+ FSHOOK_TYPE_SETINHERITEDRIGHTS_WARN = 18;
+ FSHOOK_TYPE_SETINHERITEDRIGHTS_REPORT = 19;
+ FSHOOK_TYPE_CHANGEVOLSTATE_WARN = 20;
+ FSHOOK_TYPE_CHANGEVOLSTATE_REPORT = 21;
+ FSHOOK_TYPE_CHANGEPOOLSTATE_WARN = 22;
+ FSHOOK_TYPE_CHANGEPOOLSTATE_REPORT = 23;
+
+
+{==========================================================
+ NSS file system hooks
+ These are based on the Novell Event Bus, supported by NSS
+==========================================================}
+type
+ Pfse_info = ^fse_info;
+ fse_info = record
+ version : longint; // event block version
+ reserved1 : longint; // do not modify
+ reserved2 : pointer; // do not modify
+ rtag : rtag_t; // registerer's resource tag
+ link : Pfse_info; // used by registerer to link blocks
+ regID : pointer; // registerer of the event
+ regSpace : pointer; // scratch space for registerer's use
+ consID : pointer; // consumer of event if relevant
+ length : size_t; // in bytes of event data
+ data : pointer; // pointer to data
+ reserved3 : array[0..3] of pointer; // do not modify
+ _type : longint; // one of NSS_FSTYPE_-...
+ userParm : pointer; // specified at time of registration
+ parm0 : pointer; // value depends on event type
+ parm1 : pointer; // ibid
+ flags : dword; // as noted above
+ end;
+ fsevent_info_t = fse_info;
+ Pfsevent_info_t = ^fsevent_info_t;
+ Pfsevent_info = Pfsevent_info_t;
+ Tfsevent_info = fsevent_info_t;
+
+ Pzkey_t = ^zkey_t;
+ zkey_t = Tuint64;
+
+ Pzid_t = ^zid_t;
+ zid_t = Tuint64;
+
+ Pvolid_t = ^volid_t;
+ volid_t = record
+ timeLow : dword;
+ timeMid : word;
+ timeHighAndVersion : word;
+ clockSeqHighAndReserved : byte;
+ clockSeqLow : byte;
+ node : array[0..5] of byte;
+ end;
+ userid_t = volid_t;
+ Puserid_t = ^userid_t;
+ TVolId = volid_t;
+ PVolId = pvolid_t;
+ TUserId = userid_t;
+ PUserId = puserid_t;
+
+ Ptimeinfo_t = ^timeinfo_t;
+ timeinfo_t = record
+ accessedTime, // last time file was accessed
+ createdTime, // time file was created
+ modifiedTime, // last time data was changed
+ metaDataModifiedTime : time_t; // last time metadata was changed
+ end;
+ Ttimeinfo = timeinfo_t;
+ Ptimeinfo = Ptimeinfo_t;
+
+{ commonlity in call-back structures... }
+{ NSS (NetWare 6) filesystem hooks events and call-back data structures... }
+
+ Pdel_warn_t = ^del_warn_t;
+ del_warn_t = record
+ enterExitID,
+ slotID,
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ end;
+ Tdel_warn = del_warn_t;
+ Pdel_warn = Pdel_warn_t;
+
+
+ Pdel_report_t = ^del_report_t;
+ del_report_t = record
+ enterExitID : dword;
+ enterRetStatus,
+ opRetCode : longint;
+ end;
+ Tdel_report = del_report_t;
+ Pdel_report = Pdel_report_t;
+
+ Pcreate_warn_t = ^create_warn_t;
+ create_warn_t = record
+ enterExitID,
+ slotID,
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ name : Punicode_t;
+ fileType,
+ fileAttributes,
+ createFlags : dword;
+ createParms : pointer;
+ requestedRights,
+ createAndOpen : dword;
+ end;
+ Tcreate_warn = create_warn_t;
+ Pcreate_warn = Pcreate_warn_t;
+
+ Pcreate_report_t = ^create_report_t;
+ create_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ retOpenCreateAction : dword;
+ retKey : zkey_t;
+ retZid : zid_t;
+ retVolID : volid_t;
+ times : timeinfo_t;
+ end;
+ Tcreate_report = create_report_t;
+ Pcreate_report = Pcreate_report_t;
+
+ Popen_warn_t = ^open_warn_t;
+ open_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ requestedRights : dword;
+ openParms : pointer;
+ end;
+ Topen_warn = open_warn_t;
+ Popen_warn = Popen_warn_t;
+
+ Popen_report_t = ^open_report_t;
+ open_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ retKey : zkey_t;
+ retZid : zid_t;
+ retVolID : volid_t;
+ times : timeinfo_t;
+ end;
+ Topen_report = open_report_t;
+ Popen_report = Popen_report_t;
+
+ Pclose_warn_t = ^close_warn_t;
+ close_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ key : zkey_t;
+ fhState : dword;
+ times : timeinfo_t;
+ end;
+ Tclose_warn = close_warn_t;
+ Pclose_warn = Pclose_warn_t;
+
+ Pclose_report_t = ^close_report_t;
+ close_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ fileDeleted : dword;
+ end;
+ Tclose_report = close_report_t;
+ Pclose_report = Pclose_report_t;
+
+ Pren_warn_t = ^ren_warn_t;
+ ren_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ destZid : zid_t;
+ destName : Punicode_t;
+ renameFlags : dword;
+ end;
+ Tren_warn = ren_warn_t;
+ Pren_warn = Pren_warn_t;
+
+ Pren_report_t = ^ren_report_t;
+ ren_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ end;
+ Tren_report = ren_report_t;
+ Pren_report = Pren_report_t;
+
+
+ Pzinfo_t = ^zinfo_t;
+ zinfo_t = record
+ version : dword;
+ totalBytes : size_t;
+ nextByte : size_t;
+ padding : dword;
+ retMask : Tuint64;
+ std : record
+ zid : zid_t;
+ dataStreamZid : zid_t;
+ parentZid : zid_t;
+ logicalEOF : off64_t;
+ volumeID : volid_t;
+ fileType : dword;
+ fileAttributes : dword;
+ fileAttributesModMask : dword;
+ padding : dword;
+ end;
+ storageUsed : record
+ physicalEOF : size64_t;
+ dataBytes : size64_t;
+ metaDataBytes : size64_t;
+ end;
+ primaryNameSpaceID : longint;
+ nameStart : off_t;
+ names : record
+ numEntries : size_t;
+ fileNameArray : off_t;
+ end;
+ time : record
+ created : Tuint64;
+ archived : Tuint64;
+ modified : Tuint64;
+ accessed : Tuint64;
+ metaDataModified : Tuint64;
+ end;
+ id : record
+ owner : userid_t;
+ archiver : userid_t;
+ modifier : userid_t;
+ metaDataModifier : userid_t;
+ end;
+ blockSize : record
+ size : size_t;
+ sizeShift : off_t;
+ end;
+ count : record
+ open : longint;
+ hardLink : longint;
+ end;
+ dataStream : record
+ count : longint;
+ totalNameSize : size_t;
+ totalDataSize : size64_t;
+ end;
+ extAttr : record
+ count : size_t;
+ totalNameSize : size_t;
+ totalDataSize : size64_t;
+ end;
+ deleted : record
+ time : Tuint64;
+ id : userid_t;
+ end;
+ macNS : record
+ finderInfo : record
+ case longint of
+ 0 : ( generic : array[0..31] of byte );
+ 1 : ( macintosh : record
+ FInfo : record
+ fdType : longint;
+ fdCreator : longint;
+ fdFlags : Tint16;
+ fdLocation : record
+ v : Tint16;
+ h : Tint16;
+ end;
+ fdFldr : Tint16;
+ end;
+ extended : record
+ case longint of
+ 0 : ( FXInfo : record
+ fdIconID : Tint16;
+ fdUnused : Tint16;
+ fdScript : int8_t;
+ fdFlags : int8_t;
+ fdComment : Tint16;
+ fdPutAway : longint;
+ end );
+ 1 : ( DXInfo : record
+ frScroll : record
+ v : Tint16;
+ h : Tint16;
+ end;
+ frOpenChain : longint;
+ fdScript : int8_t;
+ fdFlags : int8_t;
+ fdComment : Tint16;
+ fdPutAway : longint;
+ end );
+ end;
+ end );
+ end;
+ proDOSInfo : array[0..5] of byte;
+ filler : array[0..1] of byte;
+ dirRightsMask : dword;
+ end;
+ unixNS : record
+ fMode : dword;
+ rDev : dword;
+ myFlags : dword;
+ nfsUID : dword;
+ nfsGID : dword;
+ nwUID : dword;
+ nwGID : dword;
+ nwEveryone : dword;
+ nwUIDRights : dword;
+ nwGIDRights : dword;
+ nwEveryoneRights : dword;
+ acsFlags : byte;
+ firstCreated : byte;
+ variableSize : size_t;
+ offsetToData : off_t;
+ end;
+ volumeID : volid_t;
+ ndsObjectID : userid_t;
+ volumeState : dword;
+ nameSpaceMask : dword;
+ features : record
+ enabled : Tuint64;
+ enableModMask : Tuint64;
+ supported : Tuint64;
+ end;
+ maximumFileSize : size64_t;
+ totalSpaceQuota : size64_t;
+ numUsedBytes : size64_t;
+ numObjects : size64_t;
+ numFiles : size64_t;
+ authModelID : dword;
+ dataShreddingCount : size_t;
+ salvage : record
+ purgeableBytes : size64_t;
+ nonPurgeableBytes : size64_t;
+ numDeletedFiles : size64_t;
+ oldestDeletedTime : Tuint64;
+ minKeepSeconds : size_t;
+ maxKeepSeconds : size_t;
+ lowWaterMark : size_t;
+ highWaterMark : size_t;
+ end;
+ comp : record
+ numCompressedFiles : size64_t;
+ numCompDelFiles : size64_t;
+ numUncompressibleFiles : size64_t;
+ numPreCompressedBytes : size64_t;
+ numCompressedBytes : size64_t;
+ end;
+ pool : record
+ poolID : volid_t;
+ ndsObjectID : userid_t;
+ poolState : dword;
+ nameSpaceMask : dword;
+ features : record
+ enabled : Tuint64;
+ enableModMask : Tuint64;
+ supported : Tuint64;
+ end;
+ totalSpace : size64_t;
+ numUsedBytes : size64_t;
+ purgeableBytes : size64_t;
+ nonPurgeableBytes : size64_t;
+ end;
+ extAttrUserFlags : dword;
+ variableData : array[0..0] of byte;
+ end;
+ Tzinfo = zinfo_t;
+ Pzinfo = Pzinfo_t;
+
+ Pmod_warn_t = ^mod_warn_t;
+ mod_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ modifyInfoMask : dword;
+ modifyTypeInfoMask : dword;
+ modifyInfo : Pzinfo_t;
+ modifyTypeInfo : pointer;
+ end;
+ Tmod_warn = mod_warn_t;
+ Pmod_warn = Pmod_warn_t;
+
+ Pmod_report_t = ^mod_report_t;
+ mod_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ end;
+ Tmod_report = mod_report_t;
+ Pmod_report = Pmod_report_t;
+
+ Psetsize_warn_t = ^setsize_warn_t;
+ setsize_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ key : zkey_t;
+ curEOF : Tuint64;
+ newEOF : Tuint64;
+ setSizeFlags : dword;
+ end;
+ Tsetsize_warn = setsize_warn_t;
+ Psetsize_warn = Psetsize_warn_t;
+
+ Psetsize_report_t = ^setsize_report_t;
+ setsize_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ newEOF : Tuint64;
+ end;
+ Tsetsize_report = setsize_report_t;
+ Psetsize_report = Psetsize_report_t;
+
+ Paddtrustee_warn_t = ^addtrustee_warn_t;
+ addtrustee_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ trusteeID : userid_t;
+ rights : dword;
+ attributes : dword;
+ end;
+ Taddtrustee_warn = addtrustee_warn_t;
+ Paddtrustee_warn = Paddtrustee_warn_t;
+
+ Paddtrustee_report_t = ^addtrustee_report_t;
+ addtrustee_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ end;
+
+ Taddtrustee_report = addtrustee_report_t;
+ Paddtrustee_report = Paddtrustee_report_t;
+
+ Premtrustee_warn_t = ^remtrustee_warn_t;
+ remtrustee_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ trusteeID : userid_t;
+ purgedFileFlag : dword;
+ end;
+ Tremtrustee_warn = remtrustee_warn_t;
+ Premtrustee_warn = Premtrustee_warn_t;
+
+ Premtrustee_report_t = ^remtrustee_report_t;
+ remtrustee_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ end;
+ Tremtrustee_report = remtrustee_report_t;
+ Premtrustee_report = Premtrustee_report_t;
+
+ Psetrights_warn_t = ^setrights_warn_t;
+ setrights_warn_t = record
+ enterExitID : dword;
+ slotID : dword;
+ taskID : dword;
+ zid : zid_t;
+ volID : volid_t;
+ inheritedRights : dword;
+ authorizeFlag : longint;
+ end;
+ Tsetrights_warn = setrights_warn_t;
+ Psetrights_warn = Psetrights_warn_t;
+
+ Psetrights_report_t = ^setrights_report_t;
+ setrights_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ end;
+ Tsetrights_report = setrights_report_t;
+ Psetrights_report = Psetrights_report_t;
+
+ Pxvolstate_warn_t = ^xvolstate_warn_t;
+ xvolstate_warn_t = record
+ enterExitID : dword;
+ oldState : word;
+ newState : word;
+ mode : dword;
+ volID : volid_t;
+ poolID : volid_t;
+ end;
+ Txvolstate_warn = xvolstate_warn_t;
+ Pxvolstate_warn = Pxvolstate_warn_t;
+
+ Pxvolstate_report_t = ^xvolstate_report_t;
+ xvolstate_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ oldState : word;
+ newState : word;
+ mode : dword;
+ volID : volid_t;
+ poolID : volid_t;
+ end;
+ Txvolstate_report = xvolstate_report_t;
+ Pxvolstate_report = Pxvolstate_report_t;
+
+ Pxpoolstate_warn_t = ^xpoolstate_warn_t;
+ xpoolstate_warn_t = record
+ enterExitID : dword;
+ oldState : word;
+ newState : word;
+ mode : dword;
+ poolID : volid_t;
+ end;
+ Txpoolstate_warn = xpoolstate_warn_t;
+ Pxpoolstate_warn = Pxpoolstate_warn_t;
+
+
+ Pxpoolstate_report_t = ^xpoolstate_report_t;
+ xpoolstate_report_t = record
+ enterExitID : dword;
+ enterRetStatus : longint;
+ opRetCode : longint;
+ oldState : word;
+ newState : word;
+ mode : dword;
+ poolID : volid_t;
+ end;
+ Txpoolstate_report = xpoolstate_report_t;
+ Pxpoolstate_report = Pxpoolstate_report_t;
+
+{============================================================
+ Traditional file system hooks
+ These were interfaced by CLib in its NDK header, nwfshook.h.
+============================================================}
+
+ PEraseFileCallBackStruct = ^TEraseFileCallBackStruct;
+ TEraseFileCallBackStruct = record
+ case longint of
+ 0: (slot : longint);
+ 1: (connection : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ attributeMatchBits : dword);
+ end;
+{ (see fsio.h) }
+
+ POpenFileCallBackStruct = ^TOpenFileCallBackStruct;
+ TOpenFileCallBackStruct = record
+ case longint of
+ 0: (slot : longint);
+ 1: (connection : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ attributeMatchBits : dword;
+ requestedAccessRights : dword;
+ dataStreamNumber : longint;
+ fileHandle : Plongint);
+ end;
+
+ PCreateFileCallBackStruct = ^TCreateFileCallBackStruct;
+ TCreateFileCallBackStruct = record
+ case integer of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ createAttributeBits : dword;
+ createFlagBits : dword;
+ dataStreamNumber : longint;
+ fileHandle : Plongint);
+ end;
+
+ PCreateAndOpenCallBackStruct = ^TCreateAndOpenCallBackStruct;
+ TCreateAndOpenCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ createAttributeBits : dword;
+ requestedAccessRights : dword;
+ createFlagBits : dword;
+ dataStreamNumber : longint;
+ fileHandle : Plongint);
+ end;
+
+ PRenameMoveEntryCallBackStruct = ^TRenameMoveEntryCallBackStruct;
+ TRenameMoveEntryCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ attributeMatchBits : dword;
+ subDirsOnlyFlag : longint;
+ newDirBase : longint;
+ newPathString : Pchar;
+ originalNewCount : longint;
+ compatibilityFlag : dword;
+ allowRenamesToMyselfFlag : longint);
+ end;
+
+ PCloseFileCallBackStruct = ^TCloseFileCallBackStruct;
+ TCloseFileCallBackStruct = record
+ case integer of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ fileHandle : longint);
+ end;
+
+ PCreateDirCallBackStruct = ^TCreateDirCallBackStruct;
+ TCreateDirCallBackStruct = record
+ case integer of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ directoryAccessMask : dword);
+ end;
+
+ PDeleteDirCallBackStruct = ^TDeleteDirCallBackStruct;
+ TDeleteDirCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint);
+ end;
+
+ Tmodifyvector = record
+ MModifyName : Pchar;
+ MFileAttributes : dword;
+ MFileAttributesMask : dword;
+ MCreateDate : word;
+ MCreateTime : word;
+ MOwnerID : dword;
+ MLastArchivedDate : word;
+ MLastArchivedTime : word;
+ MLastArchivedID : dword;
+ MLastUpdatedDate : word;
+ MLastUpdatedTime : word;
+ MLastUpdatedID : dword;
+ MLastAccessedDate : word;
+ MInheritanceGrantMask : word;
+ MInheritanceRevokeMask : word;
+ MMaximumSpace : size_t;
+ MLastUpdatedInSeconds : time_t;
+ end;
+ Pmodifyvector = ^Tmodifyvector;
+
+ PModifyDirEntryCallBackStruct = ^TModifyDirEntryCallBackStruct;
+ TModifyDirEntryCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ attributeMatchBits : dword;
+ targetNameSpace : longint;
+ modifyVector : Pmodifyvector;
+ modifyBits : dword;
+ allowWildCardsFlag : longint);
+ end;
+
+ PSalvageDeletedCallBackStruct = ^TSalvageDeletedCallBackStruct;
+ TSalvageDeletedCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ volume : longint;
+ dirBase : longint;
+ toBeSalvagedDirBase : longint;
+ nameSpace : longint;
+ newName : Pchar);
+ end;
+
+ PPurgeDeletedCallBackStruct = ^TPurgeDeletedCallBackStruct;
+ TPurgeDeletedCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ volume : longint;
+ dirBase : longint;
+ toBePurgedDirBase : longint;
+ nameSpace : longint);
+ end;
+
+ PRenameNSEntryCallBackStruct = ^TRenameNSEntryCallBackStruct;
+ TRenameNSEntryCallBackStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ pathComponentCount : longint;
+ nameSpace : longint;
+ matchBits : dword;
+ newName : Pchar);
+ end;
+
+ PGenericSalvageDeletedCBStruct = ^TGenericSalvageDeletedCBStruct;
+ TGenericSalvageDeletedCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ nameSpace : longint;
+ sequence : longint;
+ volume : longint;
+ dirBase : longint;
+ newName : Pchar);
+ end;
+
+ PGenericPurgeDeletedCBStruct = ^TGenericPurgeDeletedCBStruct;
+ TGenericPurgeDeletedCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ nameSpace : longint;
+ sequence : longint;
+ volume : longint;
+ dirBase : longint);
+ end;
+
+ PGenericOpenCreateCBStruct = ^TGenericOpenCreateCBStruct;
+ TGenericOpenCreateCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ pathComponentCount : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ nameSpace : longint;
+ dataStreamNumber : longint;
+ openCreateFlags : dword;
+ searchAttributes : dword;
+ createAttributes : dword;
+ requestedAccessRights : dword;
+ returnInfoMask : dword;
+ fileHandle : Plongint;
+ openCreateAction : Pchar);
+ end;
+
+ PGenericRenameCBStruct = ^TGenericRenameCBStruct;
+ TGenericRenameCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ nameSpace : longint;
+ renameFlag : longint;
+ searchAttributes : dword;
+ srcVolume : longint;
+ srcPathComponentCount : longint;
+ srcDirBase : longint;
+ srcPathString : Pchar;
+ dstVolume : longint;
+ dstPathComponentCount : longint;
+ dstDirBase : longint;
+ dstPathString : Pchar);
+ end;
+
+ PGenericEraseFileCBStruct = ^TGenericEraseFileCBStruct;
+ TGenericEraseFileCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ pathComponentCount : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ nameSpace : longint;
+ searchAttributes : dword);
+ end;
+
+ PGenericModifyDOSInfoCBStruct = ^TGenericModifyDOSInfoCBStruct;
+ TGenericModifyDOSInfoCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ volume : longint;
+ pathComponentCount : longint;
+ dirBase : longint;
+ pathString : Pchar;
+ nameSpace : longint;
+ searchAttributes : dword;
+ modifyMask : dword;
+ modifyInfo : pointer);
+ end;
+
+ PGenericModifyNSInfoCBStruct = ^TGenericModifyNSInfoCBStruct;
+ TGenericModifyNSInfoCBStruct = record
+ case longint of
+ 0: (connection : longint);
+ 1: (slot : longint;
+ task : longint;
+ dataLength : size_t;
+ srcNameSpace : longint;
+ dstNameSpace : longint;
+ volume : longint;
+ dirBase : longint;
+ modifyMask : dword;
+ modifyInfo : pointer);
+ end;
+{============================================================================
+** NSS file system hook prototypes...
+ }
+
+//type TCdeclPfsEventFunc = function (info:Pfsevent_info_t):longint; cdecl;
+type TCdeclPfsEventFunc = function (var info:Tfsevent_info):longint; cdecl;
+
+function fs_register(_type:longint; cbFunc:TCdeclPfsEventFunc; userParm:pointer):longint;cdecl;external libc_nlm name 'fs_register';
+function fs_unregister(_type:longint; cbFunc:TCdeclPfsEventFunc):longint;cdecl;external libc_nlm name 'fs_unregister';
+
+function fs_mapkeytopath(key:zkey_t; path:Punicode_t; maxpathlen:Psize_t; want_volume:longint):longint;cdecl;external libc_nlm name 'fs_mapkeytopath';
+function fs_mapkeytopath(key:zkey_t; path:Punicode_t; maxpathlen:Psize_t; want_volume:longbool):longint;cdecl;external libc_nlm name 'fs_mapkeytopath';
+function fs_mapkeytopath(key:zkey_t; path:Punicode_t; var maxpathlen:longint; want_volume:longint):longint;cdecl;external libc_nlm name 'fs_mapkeytopath';
+function fs_mapkeytopath(key:zkey_t; path:Punicode_t; var maxpathlen:longint; want_volume:longbool):longint;cdecl;external libc_nlm name 'fs_mapkeytopath';
+
+function fs_mapzidtopath(zid:zid_t; volId:Pvolid_t; path:Punicode_t; maxpathlen:Psize_t; want_volume:longint):longint;cdecl;external libc_nlm name 'fs_mapzidtopath';
+function fs_mapzidtopath(zid:zid_t; volId:Pvolid_t; path:Punicode_t; maxpathlen:Psize_t; want_volume:longbool):longint;cdecl;external libc_nlm name 'fs_mapzidtopath';
+function fs_mapzidtopath(zid:zid_t; var volId:volid_t; path:Punicode_t; var maxpathlen:longint; want_volume:longint):longint;cdecl;external libc_nlm name 'fs_mapzidtopath';
+function fs_mapzidtopath(zid:zid_t; var volId:volid_t; path:Punicode_t; var maxpathlen:longint; want_volume:longbool):longint;cdecl;external libc_nlm name 'fs_mapzidtopath';
+
+function fs_read(key:zkey_t; buf:pointer; off:off64_t; len:size_t; bytes:Pssize_t):longint;cdecl;external libc_nlm name 'fs_read';
+function fs_read(key:zkey_t; var buf; off:off64_t; len:size_t; var bytes:ssize_t):longint;cdecl;external libc_nlm name 'fs_read';
+
+function fs_write(key:zkey_t; buf:pointer; off:off64_t; len:size_t; bytes:Pssize_t):longint;cdecl;external libc_nlm name 'fs_write';
+function fs_write(key:zkey_t; var buf; off:off64_t; len:size_t; var bytes:ssize_t):longint;cdecl;external libc_nlm name 'fs_write';
+
+
+{============================================================================
+ Generic information (NEB and traditional) based on connection slot. This
+ has little to do with file system hooks, but in LibC, there is no way to
+ get a hold of a connection slot except through file system hook interfaces.}
+function fs_getslotinfo(slot:longint;
+ name:Pchar;
+ objectType:PWord;
+ objectId:Pdword;
+ loginTime:Pointer):longint;cdecl;external libc_nlm name 'fs_getslotinfo';
+function fs_getslotinfo(slot:longint;
+ name:Pchar;
+ var objectType:word;
+ var objectId:dword;
+ var loginTime):longint;cdecl;external libc_nlm name 'fs_getslotinfo';
+
+// Clib compatible function name:
+function GetConnectionInformation (connectionNumber:longint;
+ objectName :Pchar;
+ objectType :PWORD;
+ objectID :Plongint;
+ loginTime :pointer):longint;cdecl;external libc_nlm name 'fs_getslotinfo';
+function GetConnectionInformation (connectionNumber:longint;
+ objectName :Pchar;
+ var objectType :word;
+ var objectID :longint;
+ var loginTime):longint;cdecl;external libc_nlm name 'fs_getslotinfo';
+
+
+
+{==========================================
+ Traditional file system hook prototypes... }
+
+type TCDeclFunc1PtrArgLongint = function (info:pointer):longint; cdecl;
+
+function fst_register(_type:longint; cbFunc:pointer):longint;cdecl;external libc_nlm name 'fst_register';
+function fst_unregister(_type:longint; cbFunc:pointer):longint;cdecl;external libc_nlm name 'fst_unregister';
+function fst_getvoldir(slot:longint; fileHandle:longint; namespace:longint; volNum:Plongint; dirBase:Plongint):longint;cdecl;external libc_nlm name 'fst_getvoldir';
+function fst_getvoldir(slot, fileHandle, namespace:longint; var volNum, dirBase:longint):longint;cdecl;external libc_nlm name 'fst_getvoldir';
+function fst_getorignamespace(volNum, dirBase:longint; namespace:Plongint):longint;cdecl;external libc_nlm name 'fst_getorignamespace';
+function fst_getorignamespace(volNum, dirBase:longint; var namespace:longint):longint;cdecl;external libc_nlm name 'fst_getorignamespace';
+function fst_mapvoldirtopath(volNum,dirBase,namespace:longint; path:Pchar; maxPathLen:longint):longint;cdecl;external libc_nlm name 'fst_mapvoldirtopath';
+function fst_mapvoltoname(volNum:longint; name:Pchar):longint;cdecl;external libc_nlm name 'fst_mapvoltoname';
+function fst_read(slot,fileHandle:longint; buffer:pointer; offset:off64_t; length:size_t;
+ bytes:Plongint):longint;cdecl;external libc_nlm name 'fst_read';
+function fst_read(slot,fileHandle:longint; buffer:pointer; offset:off64_t; length:size_t;
+ var bytes:longint):longint;cdecl;external libc_nlm name 'fst_read';
+function fst_write(slot, fileHandle:longint; buffer:pointer; offset:off64_t; length:size_t;
+ bytes:Plongint):longint;cdecl;external libc_nlm name 'fst_write';
+function fst_write(slot, fileHandle:longint; buffer:pointer; offset:off64_t; length:size_t;
+ var bytes:longint):longint;cdecl;external libc_nlm name 'fst_write';
+function fst_size(slot, fileHandle:longint; length:Poff64_t):longint;cdecl;external libc_nlm name 'fst_size';
+function fst_flush(slot, fileHandle:longint):longint;cdecl;external libc_nlm name 'fst_flush';
+
+
+type
+ Pfst_info_t = ^fst_info_t;
+ fst_info_t = record
+ volNum,
+ DosBase,
+ dirBase,
+ namespace,
+ datastream : longint;
+ flags : dword;
+ end;
+ Tfst_info = fst_info_t;
+ Pfst_info = Pfst_info_t;
+
+function fst_getinfo(slot,fileHandle:longint; info:Pfst_info_t):longint;cdecl;external libc_nlm name 'fst_getinfo';
+function fst_getinfo(slot,fileHandle:longint; var info:fst_info_t):longint;cdecl;external libc_nlm name 'fst_getinfo';
+
+
+// getopt.h
+
+{ values for 'has_arg'... }
+const
+ no_argument = 0;
+ required_argument = 1;
+ optional_argument = 2;
+
+{ definition for getopt_long() and getopt_long_only()... }
+
+type
+ Poption = ^option;
+ option = record
+ name : Pchar;
+ has_arg : longint;
+ flag : Plongint;
+ val : longint;
+ end;
+
+function getopt_long(argc:longint; argv:array of Pchar; optstring:Pchar; longopts:Poption; longindex:Plongint):longint;cdecl;external libc_nlm name 'getopt_long';
+function getopt_long_only(argc:longint; argv:array of Pchar; optstring:Pchar; longopts:Poption; longindex:Plongint):longint;cdecl;external libc_nlm name 'getopt_long_only';
+
+// err.h
+
+ const
+ GLOB_APPEND = $0001;
+ GLOB_DOOFFS = $0002; { use gl_offs }
+ GLOB_ERR = $0004; { return on error }
+ GLOB_MARK = $0008; { append / to matching directories }
+ GLOB_NOCHECK = $0010; { return pattern itself if nothing matches }
+ GLOB_NOSORT = $0020; { don't sort }
+ GLOB_ALTDIRFUNC = $0040; { use alternately specified directory funcs }
+ GLOB_BRACE = $0080; { expand braces ala csh }
+ GLOB_MAGCHAR = $0100; { pattern had globbing characters }
+ GLOB_NOMAGIC = $0200; { GLOB_NOCHECK without magic chars (csh) }
+ GLOB_QUOTE = $0400; { quote special chars with \ }
+ GLOB_TILDE = $0800; { expand tilde names from the passwd file }
+ GLOB_NOESCAPE = $1000; { disable backslash escaping }
+ GLOB_LIMIT = $2000; { limit pattern match output to ARG_MAX }
+ { error values returned by glob(3) }
+ GLOB_NOSPACE = -(1); { malloc call failed }
+ GLOB_ABORTED = -(2); { unignored error }
+ GLOB_NOMATCH = -(3); { no match and GLOB_NOCHECK not set }
+ { function not supported }
+ GLOB_NOSYS = -(4);
+ GLOB_ABEND = GLOB_ABORTED;
+
+type
+ Pglob_t = ^glob_t;
+ glob_t = record
+ gl_pathc : longint;
+ gl_matchc : longint;
+ gl_offs : longint;
+ gl_flags : longint;
+ gl_pathv : ^Pchar;
+ gl_errfunc : function (_para1:Pchar; _para2:longint):longint;cdecl;
+ gl_closedir : procedure (_para1:pointer);
+ gl_readdir : function (_para1:pointer):Pdirent;
+ gl_opendir : function (_para1:Pchar):pointer;
+ gl_lstat : function (_para1:Pchar; _para2:Pstat):longint;
+ gl_stat : function (_para1:Pchar; _para2:Pstat):longint;
+ end;
+
+// grp.h
+
+type
+ Pgroup = ^group;
+ group = record
+ gr_name : Pchar;
+ gr_passwd : Pchar;
+ gr_gid : gid_t;
+ gr_spare : gid_t;
+ gr_mem : ^Pchar;
+ end;
+
+function getgrgid(gid:gid_t):Pgroup;cdecl;external libc_nlm name 'getgrgid';
+function getgrnam(name:Pchar):Pgroup;cdecl;external libc_nlm name 'getgrnam';
+
+// guid.h
+// iconv.h
+
+type
+ Piconv_t = ^iconv_t;
+ iconv_t = longint;
+
+function iconv_open(tocode:Pchar; fromcode:Pchar):iconv_t;cdecl;external libc_nlm name 'iconv_open';
+function iconv(cd:iconv_t; inbuf:PPchar; inbytesleft:Psize_t; outbuf:PPchar; outbytesleft:Psize_t):size_t;cdecl;external libc_nlm name 'iconv';
+function iconv_close(cd:iconv_t):longint;cdecl;external libc_nlm name 'iconv_close';
+
+
+// inttypes.h
+
+{ printf-style macros for signed and unsigned integers... }
+{ scanf-style macros for signed and unsigned integers... }
+
+
+// iso646.h
+
+// nl_types.h
+
+ const
+ NL_SETD = 1;
+ { 'oflag' value for catopen()... }
+ { base on value of environment variable "LANG" }
+ NL_CAT_DEFAULT = 0;
+ { base on LC_MESSAGES in effect }
+ NL_CAT_LOCALE = 1;
+{$define _NL_ITEM}
+
+type
+ Pnl_item = ^nl_item;
+ nl_item = longint;
+ Pnl_catd = ^nl_catd;
+ nl_catd = longint;
+
+function catclose(catd:nl_catd):longint;cdecl;external libc_nlm name 'catclose';
+function catgets(catd:nl_catd; set_id:longint; msg_id:longint; _string:Pchar):Pchar;cdecl;external libc_nlm name 'catgets';
+function catopen(name:Pchar; oflag:longint):nl_catd;cdecl;external libc_nlm name 'catopen';
+
+// langinfo.h
+
+ const
+ DAY_1 = 1; // Sunday
+ DAY_2 = 2; // Monday
+ DAY_3 = 3; // Tuesday
+ DAY_4 = 4; // Wednesday
+ DAY_5 = 5; // Thursday
+ DAY_6 = 6; // Friday
+ DAY_7 = 7; // Saturday
+ ABDAY_1 = 8; // Sun
+ ABDAY_2 = 9; // Mon
+ ABDAY_3 = 10; // Tue
+ ABDAY_4 = 11; // Wed
+ ABDAY_5 = 12; // Thu
+ ABDAY_6 = 13; // Fri
+ ABDAY_7 = 14; // Sat
+ MON_1 = 15; // January
+ MON_2 = 16; // February
+ MON_3 = 17; // March
+ MON_4 = 18; // April
+ MON_5 = 19; // May
+ MON_6 = 20; // June
+ MON_7 = 21; // July
+ MON_8 = 22; // August
+ MON_9 = 23; // September
+ MON_10 = 24; // October
+ MON_11 = 25; // November
+ MON_12 = 26; // December
+ ABMON_1 = 27; // Jan
+ ABMON_2 = 28; // Feb
+ ABMON_3 = 29; // Mar
+ ABMON_4 = 30; // Apr
+ ABMON_5 = 31; // May
+ ABMON_6 = 32; // Jun
+ ABMON_7 = 33; // Jul
+ ABMON_8 = 34; // Aug
+ ABMON_9 = 35; // Sep
+ ABMON_10 = 36; // Oct
+ ABMON_11 = 37; // Nov
+ ABMON_12 = 38; // Dec
+ RADIXCHAR = 39; // radix character (not supported)
+ THOUSEP = 40; // separator for thousand
+ CRNCYSTR = 43; // currency symbol
+ D_T_FMT = 44; // string for formatting date and time
+ D_FMT = 45; // date format
+ T_FMT = 46; // time format
+ AM_STR = 47; // am string
+ PM_STR = 48; // pm string
+ CODESET = 49; // code set name
+ T_FMT_AMPM = 50; // a.m. or p.m. time format string (not supported)
+ ERA = 51; //era description segments (not supported)
+ ERA_D_FMT = 52; // era date format string (not supported)
+ ERA_D_T_FMT = 53; // era date and time format string (not supported)
+ ERA_T_FMT = 54; // era time format string (not supported)
+ ALT_DIGITS = 55; // alternative symbols for digits (not supported)
+ _MAXSTRMSG = 57; // maximum number of strings in langinfo
+
+
+function nl_langinfo(item:nl_item):Pchar;cdecl;external libc_nlm name 'nl_langinfo';
+
+
+// libgen.h
+
+function basename(path:Pchar):Pchar;cdecl;external libc_nlm name 'basename';
+function dirname(path:Pchar):Pchar;cdecl;external libc_nlm name 'dirname';
+
+
+// library.h
+
+{ return flags for get_app_type()... }
+ const
+ LIBRARY_UNKNOWN = $01;
+ LIBRARY_LIBC = $02; { thread has specific NKS/LibC context }
+ LIBRARY_CLIB = $04; { thread has CLib context }
+ LIBRARY_JAVA = $08; { thread belongs to Java Virtual Machine }
+
+type
+ Paddrsp_t = ^addrsp_t;
+ addrsp_t = void;
+{ O_RDONLY, etc. from fcntl.h... }
+
+ Predirect_t = ^redirect_t;
+ redirect_t = record
+ pathname : Pchar;
+ oflag : longint;
+ end;
+{ traditional NetWare solution for libraries... }
+
+function get_app_data(lib_id:longint):pointer;cdecl;external libc_nlm name 'get_app_data';
+function get_app_type:longint;cdecl;external libc_nlm name 'get_app_type';
+function register_library(cleanupFunc:TCDeclFunc1PtrArgLongint):longint;cdecl;external libc_nlm name 'register_library';
+function register_destructor(libid:longint; cleanupFunc:TCDeclFunc1PtrArgLongint):longint;cdecl;external libc_nlm name 'register_destructor';
+function set_app_data(lib_id:longint; data_area:pointer):longint;cdecl;external libc_nlm name 'set_app_data';
+function unregister_library(lib_id:longint):longint;cdecl;external libc_nlm name 'unregister_library';
+{ more prototypes for library creators, debugging and other uses... }
+function cleardontunloadflag(handle:pointer):longint;cdecl;external libc_nlm name 'cleardontunloadflag';
+function findnlmhandle(name:Pchar; space:addrsp_t):TNLMHandle;cdecl;external libc_nlm name 'findnlmhandle';
+function getaddressspace:addrsp_t;cdecl;external libc_nlm name 'getaddressspace';
+function getaddressspacename(space:addrsp_t; name:Pchar):Pchar;cdecl;external libc_nlm name 'getaddressspacename';
+function getallocresourcetag:rtag_t;cdecl;external libc_nlm name 'getallocresourcetag';
+function getnativethread:pointer;cdecl;external libc_nlm name 'getnativethread';
+{ (current process) }
+function getnlmhandle:TNLMHandle;cdecl;external libc_nlm name 'getnlmhandle';
+function getnlmhandlefromthread(thread:pointer):TNLMHandle;cdecl;external libc_nlm name 'getnlmhandlefromthread';
+function getnlmname(handle:TNLMHandle; name:Pchar):Pchar;cdecl;external libc_nlm name 'getnlmname';
+function getnlmloadpath(loadpath:Pchar):Pchar;cdecl;external libc_nlm name 'getnlmloadpath';
+function getthreadname(threadid:pointer; name:Pchar; maxlen:size_t):longint;cdecl;external libc_nlm name 'getthreadname';
+function _getthreadid:pointer;cdecl;external libc_nlm name 'getthreadid';
+function library_calloc(handle:pointer; size:size_t; count:size_t):pointer;cdecl;external libc_nlm name 'library_calloc';
+procedure library_free(addr:pointer);cdecl;external libc_nlm name 'library_free';
+function library_malloc(handle:pointer; size:size_t):pointer;cdecl;external libc_nlm name 'library_malloc';
+function library_msize(addr:pointer):size_t;cdecl;external libc_nlm name 'library_msize';
+function library_realloc(handle:pointer; old:pointer; size:size_t):pointer;cdecl;external libc_nlm name 'library_realloc';
+function nlmisloadedprotected:longint;cdecl;external libc_nlm name 'nlmisloadedprotected';
+function setdontunloadflag(handle:pointer):longint;cdecl;external libc_nlm name 'setdontunloadflag';
+function setthreadname(threadid:pointer; name:Pchar):longint;cdecl;external libc_nlm name 'setthreadname';
+//!! function uname2(handle:pointer; info:Putsname; bits:dword):longint;cdecl;external libc_nlm name 'uname2';
+function validateaddressrange(addr:pointer; bytes:size_t):longint;cdecl;external libc_nlm name 'validateaddressrange';
+function verifynlmhandle(handle:pointer):pointer;cdecl;external libc_nlm name 'verifynlmhandle';
+function construct_argc_argv(command_line:Pchar; argv0:Pchar; argc:Plongint; argv:array of Pchar):longint;cdecl;external libc_nlm name 'construct_argc_argv';
+type TRedirectSpecs = array [0..2] of redirect_t;
+function detect_redirection(r:TRedirectSpecs; argc:Plongint; argv:array of Pchar):longint;cdecl;external libc_nlm name 'detect_redirection';
+{ name-logical additions to library_malloc... }
+
+
+// locale.h
+
+{ locale categories... }
+{ turn on 1-byte packing... }
+
+ { for use with LC_ALL }
+
+const
+ MAX_LOCNAME_LEN = 31 + 1;
+ { locale categories... }
+ LC_CTYPE = 0; { character classification (unsupported) }
+ LC_COLLATE = 1; { the locale's collation table (unsupported) }
+ LC_NUMERIC = 2; { the numeric part of struct lconv }
+ LC_MONETARY = 3; { the monetary part of struct lconv }
+ LC_TIME = 4; { the time and date part of struct lconv }
+ LC_MESSAGES = 5; { new starting in NetWare v4.11 (unsupported) }
+ LC_ALL = 6;
+
+
+
+{ for the current locale... }
+{ internal representations... }
+{ ibid }
+{ as returned from setlocale(LC_ALL, NULL) }
+{ -------------------------- [Numeric Conventions] --------------------- }
+{ decimal point }
+{ separator for digits left of decimal }
+{ digit grouping size }
+{ -------------------------- [Monetary Conventions] -------------------- }
+{ currency symbol }
+{ decimal point }
+{ separator for digits left of decimal }
+{ digit grouping sizes }
+{ string indicating positive quantities }
+{ string indicating negative quantities }
+{ count of digits right of decimal }
+{ for positive monetary quantities: }
+{ currency symbol precedes quantity }
+{ currency symbol separated by blank }
+{ position of positive symbol }
+{ for negative monetary quantities: }
+{ currency symbol precedes quantity }
+{ currency symbol separated by blank }
+{ position of negative symbol }
+{ (reserved for future use) }
+{ -------------------------- [International Monetary Conventions] ------ }
+{ international currency symbol and separator }
+{ (international) digits right of decimal }
+{ -------------------------- [Time and Date Conventions] --------------- }
+{ always enforce 24-hour display (Boolean) }
+{ hour and seconds separator }
+{ hour separator when no seconds displayed }
+{ month/day/year separator }
+{ hours:minutes:seconds format (hh:mm:ss) }
+{ month/day/year format (mm/dd/yyyy) }
+{ weekday, month, day and year format }
+{ delimited string indicating am and pm }
+{ delimited string indicating AM and PM }
+{ delimited string of day names }
+{ delimited string of abbreviated day names }
+{ delimited string of month names }
+{ delimited string of abbreviated month names }
+type
+ Plconv = ^lconv;
+ lconv = record
+ country : longint;//cdecl;
+ language : longint;
+ name : array[0..7] of char;
+ decimal_point : array[0..3] of char;
+ thousands_sep : array[0..3] of char;
+ grouping : array[0..3] of char;
+ currency_symbol : array[0..3] of char;
+ mon_decimal_point : array[0..3] of char;
+ mon_thousands_sep : array[0..3] of char;
+ mon_grouping : array[0..7] of char;
+ positive_sign : array[0..3] of char;
+ negative_sign : array[0..3] of char;
+ frac_digits : char;
+ p_cs_precedes : char;
+ p_sep_by_space : char;
+ p_sign_posn : char;
+ n_cs_precedes : char;
+ n_sep_by_space : char;
+ n_sign_posn : char;
+ reserved : char;
+ int_curr_symbol : array[0..14] of char;
+ int_frac_digits : char;
+ always_24 : longint;
+ hour_sep : array[0..3] of char;
+ hour_sans_sec_sep : array[0..3] of char;
+ date_sep : array[0..3] of char;
+ time_fmt : array[0..15] of char;
+ date_fmt : array[0..15] of char;
+ full_date_fmt : array[0..31] of char;
+ ampm : array[0..31] of char;
+ _AMPM : array[0..31] of char;
+ days : array[0..159] of char;
+ day_abbrevs : array[0..159] of char;
+ months : array[0..159] of char;
+ month_abbrevs : array[0..159] of char;
+ end;
+
+{ sizeof(struct lconv) == 0x360 (864.) }
+
+
+(** unsupported pragma#pragma pack()*)
+{ prototypes for functions standard and nonstandard... }
+
+function localeconv:Plconv;cdecl;external libc_nlm name 'localeconv';
+function setlocale(_para1:longint; _para2:Pchar):Pchar;cdecl;external libc_nlm name 'setlocale';
+//!! function derivelocale(_para1:Pchar; _para2:Pchar; _para3:array[0..(31 + 1)-1] of char):Pchar;cdecl;external libc_nlm name 'derivelocale';
+function setlocale_r(_para1:longint; _para2:Pchar; _para3:Plconv; _para4:Pchar):Pchar;cdecl;external libc_nlm name 'setlocale_r';
+
+
+// malloc.h
+{
+** According to ISO/IEC (ANSI) 9899:1990 and 1999, memory allocation and
+** management functions are properly the domain of stdlib.h:
+** void *calloc ( size_t, size_t );
+** void free ( void * );
+** void *malloc ( size_t );
+** void *realloc( void *, size_t );
+**
+** Non-standard functions from stdlib.h (don't define __STDC__ or these
+** disappear):
+** void *alloca ( size_t );
+** size_t msize ( void * );
+** int mvalidate ( void * );
+** size_t stackavail ( void );
+** void *stackbase ( void );
+** size_t stackwatermark( void );
+ }
+
+
+// math.h
+
+{ constants for type exception using matherr() }
+{ turn on 1-byte packing... }
+
+ const
+ DOMAIN = 1;
+ SING = 2; { argument singularity }
+ OVERFLOW = 3; { overflow range error }
+ UNDERFLOW = 4; { underflow range error }
+ TLOSS = 5; { total loss of significance }
+ PLOSS = 6; { partial loss of significance }
+
+
+{ for C++, __fp_exception; for C, exception }
+type
+ Pexception = ^Texception;
+ Texception = record
+ _type : longint;
+ name : Pchar;
+ arg1 : double;
+ arg2 : double;
+ retval : double;
+ end;
+
+{ for C++, __COMPLEX; for C, complex }
+ Pcomplex = ^complex;
+ complex = record
+ real : double;
+ imag : double;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+//var
+// ___nan_float : double;cvar;external;
+// ___huge_float : double;cvar;external;
+// ___huge_double : double;cvar;external;
+// ___huge_long_double : double;cvar;external;
+
+function acos(_para1:double):double;cdecl;external libc_nlm name 'acos';
+function asin(_para1:double):double;cdecl;external libc_nlm name 'asin';
+function atan(_para1:double):double;cdecl;external libc_nlm name 'atan';
+function atan2(_para1:double; _para2:double):double;cdecl;external libc_nlm name 'atan2';
+function cbrt(_para1:double):double;cdecl;external libc_nlm name 'cbrt';
+function ceil(_para1:double):double;cdecl;external libc_nlm name 'ceil';
+function cos(_para1:double):double;cdecl;external libc_nlm name 'cos';
+function cosh(_para1:double):double;cdecl;external libc_nlm name 'cosh';
+function exp(_para1:double):double;cdecl;external libc_nlm name 'exp';
+function fabs(_para1:double):double;cdecl;external libc_nlm name 'fabs';
+function floor(_para1:double):double;cdecl;external libc_nlm name 'floor';
+function fmod(_para1:double; _para2:double):double;cdecl;external libc_nlm name 'fmod';
+function frexp(_para1:double; _para2:Plongint):double;cdecl;external libc_nlm name 'frexp';
+function hypot(_para1:double; _para2:double):double;cdecl;external libc_nlm name 'hypot';
+function ldexp(_para1:double; _para2:longint):double;cdecl;external libc_nlm name 'ldexp';
+function log(_para1:double):double;cdecl;external libc_nlm name 'log';
+function log10(_para1:double):double;cdecl;external libc_nlm name 'log10';
+function modf(_para1:double; _para2:Pdouble):double;cdecl;external libc_nlm name 'modf';
+function pow(_para1:double; _para2:double):double;cdecl;external libc_nlm name 'pow';
+function remainder(_para1:double; _para2:double):double;cdecl;external libc_nlm name 'remainder';
+function rint(_para1:double):double;cdecl;external libc_nlm name 'rint';
+function sin(_para1:double):double;cdecl;external libc_nlm name 'sin';
+function sinh(_para1:double):double;cdecl;external libc_nlm name 'sinh';
+function sqrt(_para1:double):double;cdecl;external libc_nlm name 'sqrt';
+function tan(_para1:double):double;cdecl;external libc_nlm name 'tan';
+function tanh(_para1:double):double;cdecl;external libc_nlm name 'tanh';
+function cabs(_para1:complex):double;cdecl;external libc_nlm name 'cabs';
+function finite(_para1:double):longint;cdecl;external libc_nlm name 'finite';
+function j0(_para1:double):double;cdecl;external libc_nlm name 'j0';
+function j1(_para1:double):double;cdecl;external libc_nlm name 'j1';
+function jn(_para1:longint; _para2:double):double;cdecl;external libc_nlm name 'jn';
+function y0(_para1:double):double;cdecl;external libc_nlm name 'y0';
+function y1(_para1:double):double;cdecl;external libc_nlm name 'y1';
+function yn(_para1:longint; _para2:double):double;cdecl;external libc_nlm name 'yn';
+function matherr(_para1:Pexception):longint;cdecl;external libc_nlm name 'matherr';
+type TmathErrHandlerFunc = function (_para1:Pexception):longint; cdecl;
+function matherr_handler(_para1:TmathErrHandlerFunc):longint;cdecl;external libc_nlm name 'matherr_handler';
+function ___fpclassify_f(_para1:double):longint;cdecl;external libc_nlm name '___fpclassify_f';
+function ___fpclassify_d(_para1:double):longint;cdecl;external libc_nlm name '___fpclassify_d';
+function ___fpclassify_ld(double:longint):longint;cdecl;external libc_nlm name '___fpclassify_ld';
+function ___isfinite_f(_para1:double):longint;cdecl;external libc_nlm name '___isfinite_f';
+function ___isfinite_d(_para1:double):longint;cdecl;external libc_nlm name '___isfinite_d';
+function ___isfinite_ld(double:longint):longint;cdecl;external libc_nlm name '___isfinite_ld';
+function ___signbit_f(_para1:double):longint;cdecl;external libc_nlm name '___signbit_f';
+function ___signbit_d(_para1:double):longint;cdecl;external libc_nlm name '___signbit_d';
+function ___signbit_ld(double:longint):longint;cdecl;external libc_nlm name '___signbit_ld';
+
+
+// monitor.h
+{ turn on 1-byte packing... }
+
+type
+ Pconn_info = ^Tconn_info;
+ Tconn_info = record
+ codepage : longint;
+ spares : array[0..507] of byte;
+ end;
+
+{ additional processor information that may be available... }
+{ (may not equal 'ThreadsOnProcessor' when totalled:) }
+ Pcpu_info = ^Tcpu_info;
+ Tcpu_info = record
+ which : longint;
+ CurrentProcessor : longint;
+ ProcessorUtilization : dword;
+ ThreadsOnProcessor : dword;
+ reserved1 : dword;
+ Family : dword;
+ Model : dword;
+ Stepping : dword;
+ Revision : dword;
+ FeatureFlags : dword;
+ SerialNumber : Tuint64;
+ Speed : dword;
+ L1CacheSize : dword;
+ L2CacheSize : dword;
+ L3CacheSize : dword;
+ ReadyThreads : dword;
+ RunningThreads : dword;
+ SuspendedThreads : dword;
+ reserved2 : dword;
+ ThreadCPUTime : Tuint64;
+ reserved3 : Tuint64;
+ reserved4 : array[0..7] of dword;
+ end;
+
+ Pfilesystem_info = ^Tfilesystem_info;
+ Tfilesystem_info = record
+ OpenFileCount : longint;
+ CurrentDiskRequests : longint;
+ reserved : array[0..61] of dword;
+ end;
+
+ Prestag_info = ^Trestag_info;
+ Trestag_info = record { per-NLM resource-allocation information }
+ tag_count : longint; { count of discrete resource tags }
+ res_count : size_t; { total number of resources across tags }
+ reserved1 : longint; { used only by 'ALRT' tags }
+ signature : dword; { type of resource (see netware.h) }
+ description : array[0..79] of char; { resource tag description string }
+ end;
+
+ Pmem_restag_info = ^Tmem_restag_info;
+ Tmem_restag_info = record { per-NLM memory information }
+ tag_count : longint; { discrete memory allocation resource tags }
+ total_bytes : size_t; { total number of bytes allocated across tags }
+ allocations : longint; { total actual calls to allocator }
+ reserved2 : dword; { always signature ('ALRT') }
+ description : array[0..79] of char; { resource tag description string }
+ end;
+
+ Pmemory_info = ^Tmemory_info;
+ Tmemory_info = record
+ AllocatedMemoryPool : size64_t;
+ CacheBufferSize : size64_t;
+ CacheBufferMemory : size64_t;
+ CacheMoveableMemory : size64_t;
+ CacheNonmoveableMemory : size64_t;
+ CodeMemory : size64_t;
+ DataMemory : size64_t;
+ TotalWorkMemory : size64_t;
+ OtherCachePagesMemory : size64_t;
+ reserved1 : size64_t;
+ TotalKnownSystemMemoryUnder4Gb : size64_t;
+ TotalKnownSystemMemory : size64_t;
+ reserved : array[0..11] of dword;
+ end;
+
+ Pvmemory_info = ^Tvmemory_info;
+ Tvmemory_info = record
+ PageInCount : Tuint64;
+ PageOutCount : Tuint64;
+ SwapResvCount : Tuint64;
+ SwapPageCount : Tuint64;
+ SwapFreeCount : Tuint64;
+ PageFaultCount : Tuint64;
+ freeCachePages : Tuint64;
+ freeCleanPages : Tuint64;
+ freeDirtyPages : Tuint64;
+ VMPhysicalPageCount : Tuint64;
+ reserved : array[0..19] of dword;
+ end;
+
+ Pnet_info = ^Tnet_info;
+ Tnet_info = record
+ MaximumConnections : longint;
+ spare0 : array[0..11] of dword;
+ IPXAddr : array[0..5] of byte;
+ spare1 : array[0..1] of byte;
+ MaximumBoards : dword;
+ spare3 : array[0..11] of dword;
+ IPAddrsBound : array[0..11] of dword;
+ spare4 : array[0..23] of dword;
+ end;
+
+ Pos_info = ^Tos_info;
+ Tos_info = record
+ AbendedProcessCount : longint;
+ CurrentServerProcesses : longint;
+ reserved : array[0..61] of dword;
+ end;
+
+{ includes namespace list }
+ Pvolume_info = ^Tvolume_info;
+ Tvolume_info = record
+ which : longint;
+ flags : dword;
+ name : array[0..(31 + 1)-1] of char;
+ SectorSize : dword;
+ SectorsPerCluster : dword;
+ VolumeSizeInClusters : dword;
+ FreedClusters : dword;
+ SubAllocFreeableClusters : dword;
+ FreeableLimboSectors : dword;
+ NonFreeableLimboSectors : dword;
+ NonFreeableAvailableSubAllocSectors : dword;
+ NotUsableSubAllocSectors : dword;
+ SubAllocClusters : dword;
+ DataStreamsCount : dword;
+ LimboDataStreamsCount : dword;
+ OldestDeletedFileAgeInTicks : dword;
+ CompressedDataStreamsCount : dword;
+ CompressedLimboDataStreamsCount : dword;
+ UnCompressableDataStreamsCount : dword;
+ PreCompressedSectors : dword;
+ CompressedSectors : dword;
+ MigratedFiles : dword;
+ MigratedSectors : dword;
+ ClustersUsedByFAT : dword;
+ ClustersUsedByDirectories : dword;
+ ClustersUsedByExtendedDirectories : dword;
+ TotalDirectoryEntries : dword;
+ UnUsedDirectoryEntries : dword;
+ TotalExtendedDirectoryExtants : dword;
+ UnUsedExtendedDirectoryExtants : dword;
+ ExtendedAttributesDefined : dword;
+ ExtendedAttributeExtantsUsed : dword;
+ DirectoryServicesObjectID : dword;
+ VolumeLastModifiedDateAndTime : dword;
+ mounted : longint;
+ BlockCount : Tuint64;
+ BlocksFree : Tuint64;
+ BlockSize : dword;
+ reserved : array[0..57] of dword;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ prototypes... }
+
+function netware_conn_info(info:Pconn_info; sequence:Plongint):longint;cdecl;external libc_nlm name 'netware_conn_info';
+function netware_conn_info_from_slot(info:Pconn_info; slot:longint):longint;cdecl;external libc_nlm name 'netware_conn_info_from_slot';
+function netware_cpu_info(info:Pcpu_info; sequence:Plongint):longint;cdecl;external libc_nlm name 'netware_cpu_info';
+function netware_fs_info(info:Pfilesystem_info):longint;cdecl;external libc_nlm name 'netware_fs_info';
+function netware_net_info(info:Pnet_info):longint;cdecl;external libc_nlm name 'netware_net_info';
+//!! function netware_net_macaddr(board:longint; macAddr:array[0..5] of byte):longint;cdecl;external libc_nlm name 'netware_net_macaddr';
+function netware_mem_info(info:Pmemory_info):longint;cdecl;external libc_nlm name 'netware_mem_info';
+function netware_mem_info_for_nlm(info:Pmem_restag_info; handle:pointer):longint;cdecl;external libc_nlm name 'netware_mem_info_for_nlm';
+function netware_os_info(info:Pos_info):longint;cdecl;external libc_nlm name 'netware_os_info';
+function netware_vmem_info(info:Pvmemory_info):longint;cdecl;external libc_nlm name 'netware_vmem_info';
+function netware_vol_info(info:Pvolume_info; sequence:Plongint):longint;cdecl;external libc_nlm name 'netware_vol_info';
+function netware_vol_info_from_number(info:Pvolume_info; volNum:longint):longint;cdecl;external libc_nlm name 'netware_vol_info_from_number';
+function netware_vol_info_from_name(info:Pvolume_info; name:Pchar):longint;cdecl;external libc_nlm name 'netware_vol_info_from_name';
+function netware_restag_info_for_nlm(info:Prestag_info; handle:pointer; signature:dword; which:longint):longint;cdecl;external libc_nlm name 'netware_restag_info_for_nlm';
+
+function netware_conn_info(var info:Tconn_info; var sequence:longint):longint;cdecl;external libc_nlm name 'netware_conn_info';
+function netware_conn_info_from_slot(var info:Tconn_info; slot:longint):longint;cdecl;external libc_nlm name 'netware_conn_info_from_slot';
+function netware_cpu_info(var info:Tcpu_info; var sequence:longint):longint;cdecl;external libc_nlm name 'netware_cpu_info';
+function netware_fs_info(var info:Tfilesystem_info):longint;cdecl;external libc_nlm name 'netware_fs_info';
+function netware_net_info(var info:Tnet_info):longint;cdecl;external libc_nlm name 'netware_net_info';
+//!! function netware_net_macaddr(board:longint; macAddr:array[0..5] of byte):longint;cdecl;external libc_nlm name 'netware_net_macaddr';
+function netware_mem_info(var info:Tmemory_info):longint;cdecl;external libc_nlm name 'netware_mem_info';
+function netware_mem_info_for_nlm(var info:Tmem_restag_info; handle:pointer):longint;cdecl;external libc_nlm name 'netware_mem_info_for_nlm';
+function netware_os_info(var info:Tos_info):longint;cdecl;external libc_nlm name 'netware_os_info';
+function netware_vmem_info(var info:Tvmemory_info):longint;cdecl;external libc_nlm name 'netware_vmem_info';
+function netware_vol_info(var info:Tvolume_info; var sequence:longint):longint;cdecl;external libc_nlm name 'netware_vol_info';
+function netware_vol_info_from_number(var info:Tvolume_info; volNum:longint):longint;cdecl;external libc_nlm name 'netware_vol_info_from_number';
+function netware_vol_info_from_name(var info:Tvolume_info; name:Pchar):longint;cdecl;external libc_nlm name 'netware_vol_info_from_name';
+function netware_restag_info_for_nlm(var info:Trestag_info; handle:pointer; signature:dword; which:longint):longint;cdecl;external libc_nlm name 'netware_restag_info_for_nlm';
+
+
+// ncpx.h
+
+const
+ MAX_NCPX_NAMELEN = 33;
+ NCPX_BEGIN_SCAN = $FFFFFFFF;
+ NCPX_REPLY_IS_FRAGGED = $FFFFFFFF;
+ NCPX_BEING_RESTARTED = $01101001;
+ NCPX_BEING_KILLED = $02202002;
+ NCPX_BEING_LOGGED_OUT = $03303003;
+ NCPX_BEING_FREED = $04404004;
+
+type
+
+ Pncpx_id_t = ^ncpx_id_t;
+ ncpx_id_t = dword;
+
+ Pncpx_client_t = ^ncpx_client_t;
+ ncpx_client_t = Tuint64;
+
+ Pncpx_frag_element_t = ^ncpx_frag_element_t;
+ ncpx_frag_element_t = record
+ addr : pointer;
+ size : size_t;
+ end;
+
+ Pncpx_msgfrag_t = ^ncpx_msgfrag_t;
+ ncpx_msgfrag_t = record
+ totalMessageSize : size_t;
+ fragCount : longint;
+ fragList : array[0..3] of ncpx_frag_element_t;
+ end;
+
+ Pncpx_vers_t = ^ncpx_vers_t;
+ ncpx_vers_t = record
+ major : longint;
+ minor : longint;
+ revision : longint;
+ end;
+{ the handler that implements the extended NCP service... }
+
+ ncpx_handler_t = function (client:Pncpx_client_t; request:pointer; requestLen:size_t; reply:pointer; replyLen:Psize_t):longint;cdecl;
+{ the call-back made when the session goes away for whatever reason... }
+
+ sess_handler_t = procedure (session:longint; _type:longint);cdecl;
+{ the handler that replies to extended NCP requests (if any)... }
+
+ reply_mgr_t = procedure (client:Pncpx_client_t; repBuffer:pointer);cdecl;
+{ server registering an extended NCP service... }
+function NcpxRegister(name:Pchar; ncpHandler:ncpx_handler_t; sessionHandler:sess_handler_t; replyManager:reply_mgr_t; version:ncpx_vers_t;
+ queryData:Ppointer):longint;cdecl;external libc_nlm name 'NcpxRegister';
+function NcpxRegisterWithId(id:ncpx_id_t; name:Pchar; ncpHandler:ncpx_handler_t; sessionHandler:sess_handler_t; replyManager:reply_mgr_t;
+ version:ncpx_vers_t; queryData:Ppointer):longint;cdecl;external libc_nlm name 'NcpxRegisterWithId';
+function NcpxDeregister(queryData:pointer):longint;cdecl;external libc_nlm name 'NcpxDeregister';
+{ client getting information about extended NCP services... }
+function NcpxGetInfoByName(name:Pchar; id:Pncpx_id_t; version:ncpx_vers_t; queryData:pointer):longint;cdecl;external libc_nlm name 'NcpxGetInfoByName';
+function NcpxGetInfoById(id:ncpx_id_t; name:Pchar; version:ncpx_vers_t; queryData:pointer):longint;cdecl;external libc_nlm name 'NcpxGetInfoById';
+function NcpxScan(id:Pncpx_id_t; name:Pchar; version:ncpx_vers_t; queryData:pointer):longint;cdecl;external libc_nlm name 'NcpxScan';
+{ for the client sending extended NCP packets to a service... }
+
+function NcpxSend(id:ncpx_id_t; request:pointer; requestLen:size_t; reply:pointer; replyLen:Psize_t):longint;cdecl;external libc_nlm name 'NcpxSend';
+function NcpxSendFragged(id:ncpx_id_t; reqFrag:Pncpx_msgfrag_t; repFrag:Pncpx_msgfrag_t):longint;cdecl;external libc_nlm name 'NcpxSendFragged';
+
+// ndkvers.h
+{==============================================================================
+= This is a timestamp offered by the NDK. Calling libcthreshold() with the
+= defined value as first argument (the second argument returns that of the
+= currently loaded libc.nlm), will ensure at least the functionality and
+= semantics offered by the NDK this file accompanied or this function returns
+= an error (ENOTSUP). Whether or not this function fails, it always returns
+= the loaded library's threshold.
+==============================================================================}
+
+ const
+ CURRENT_NDK_THRESHOLD = 406230000;
+ { timestamps for known releases of LibC on NetWare... }
+ NETWARE_65_FCS = 306250000; { 25 June 2003 }
+ NETWARE_65_SP1 = 310090000; { 9 October 2003 }
+ NETWARE_CSP10 = 310070000; { 7 October 2003 }
+ NETWARE_51_SP7 = NETWARE_CSP10;
+ NETWARE_60_SP4 = NETWARE_CSP10;
+ NETWARE_CSP11 = 405260000; { 26 May 2004 }
+ NETWARE_60_SP5 = NETWARE_CSP11;
+ NETWARE_65_SP2 = NETWARE_CSP11;
+ NETWARE_CSP12 = 410310000; { 31 October 2004 (just a guess) }
+ NETWARE_51_SP8 = NETWARE_CSP12;
+ NETWARE_65_SP3 = NETWARE_CSP12;
+
+
+function libcthreshold(desiredthreshold:longint; libthreshold:Plongint):longint;cdecl;external libc_nlm name 'libcthreshold';
+function libcthreshold(desiredthreshold:longint; var libthreshold:longint):longint;cdecl;external libc_nlm name 'libcthreshold';
+
+// netdb.h
+
+ const
+ NETDB_INTERNAL = -(1);
+ NETDB_SUCCESS = 0; { no problem }
+ HOST_NOT_FOUND = 1; { authoritative answer host not found }
+ TRY_AGAIN = 2; { non authoritative host not found or SERVERFAIL }
+ NO_RECOVERY = 3; { non recoverable: FORMERR, REFUSED, NOTIMP }
+ NO_DATA = 4; { valid name, no data record of requested type }
+ NO_ADDRESS = NO_DATA; { no address, look for MX record }
+
+
+{ Addresses are supplied in host order and returned in network order. }
+type
+ Phostent = ^hostent;
+ hostent = record
+ h_name : Pchar; { official name of host }
+ h_aliases : PPchar; { alias list }
+ h_addrtype : smallint; { host address type }
+ h_length : smallint; { length of address }
+ h_addr_list : PPchar; { list of addresses }
+ end;
+
+{ It is assumed here that a network number fits in 32 bits. }
+ Pnetent = ^netent;
+ netent = record
+ n_name : Pchar; { official name of net }
+ n_aliases : PPchar; { alias list }
+ n_addrtype : smallint; { net address type }
+ n_net : u_long; { network number }
+ end;
+
+ Pservent = ^servent;
+ servent = record
+ s_name : Pchar; { official service name }
+ s_aliases : PPchar; { alias list }
+ s_port : smallint; { port number }
+ s_proto : Pchar; { protocol to use }
+ end;
+
+ Pprotoent = ^protoent;
+ protoent = record
+ p_name : Pchar; { official protocol name }
+ p_aliases : PPchar; { alias list }
+ p_proto : smallint; { protocol number }
+ end;
+
+
+function gethostbyaddr(_para1:Pchar; _para2:longint; _para3:longint):Phostent;cdecl;external libc_nlm name 'gethostbyaddr';
+function gethostbyname(_para1:Pchar):Phostent;cdecl;external libc_nlm name 'gethostbyname';
+function gethostname(_para1:Pchar; _para2:longint):longint;cdecl;external libc_nlm name 'gethostname';
+function getprotobyname(_para1:Pchar):Pprotoent;cdecl;external libc_nlm name 'getprotobyname';
+function getprotobynumber(_para1:longint):Pprotoent;cdecl;external libc_nlm name 'getprotobynumber';
+function getservbyname(_para1:Pchar; _para2:Pchar):Pservent;cdecl;external libc_nlm name 'getservbyname';
+function getservbyport(_para1:longint; _para2:Pchar):Pservent;cdecl;external libc_nlm name 'getservbyport';
+function ___h_errno:Plongint;cdecl;external libc_nlm name '___h_errno';
+
+
+// nks/nksapi.h
+// nlmformat.h
+
+{ 0x002E --------------------------- }
+{ 0x0032 --------------------------- }
+{ 0x0036 --------------------------- }
+{ 0x003A --------------------------- }
+{ 0x003E --------------------------- }
+{ 0x0042 --------------------------- }
+{ 0x0046 --------------------------- }
+{ 0x004A --------------------------- }
+{ 0x004E --------------------------- }
+{ 0x0052 --------------------------- }
+{ 0x0056 --------------------------- }
+{ 0x005A --------------------------- }
+{ 0x005E --------------------------- }
+{ 0x0062 --------------------------- }
+{ 0x0066 --------------------------- }
+{ 0x006A --------------------------- }
+{ 0x006E --------------------------- }
+{ 0x0072 --------------------------- }
+{ 0x0076 --------------------------- }
+{ 0x007A --------------------------- }
+{ 0x007E --------------------------- }
+{ 0x0082 --------------------------- }
+{ -------------------------------------------------------------------------
+ ** NB: Here begins the variable part of this structure's format; what is
+ ** shown here are the maximums. Consequently, sizeof(NLM_HEADER) is almost
+ ** always meaningless--the 400 bytes of 'otherData' actually referring to
+ ** the original size of the scratch buffer in NLMLINK set up to hold the
+ ** data before writing it to the binary file.
+ ** -------------------------------------------------------------------------
+ }
+
+const
+ MAX_DESCRIPTION_LENGTH = 127;
+ OLD_THREAD_NAME_LENGTH = 5; // (exactly " LONG")
+ MAX_SCREEN_NAME_LENGTH = 71;
+ MAX_THREAD_NAME_LENGTH = 71;
+
+
+{ 0x0083 --------------------------- }
+{ 0x0103 --------------------------- }
+{ 0x0107 --------------------------- }
+{ 0x010B --------------------------- }
+{ 0x0110 --------------------------- }
+{ 0x0111 --------------------------- }
+{ 0x0158 --------------------------- }
+{ 0x015C --------------------------- }
+{ 0x01A3 --------------------------- }
+type
+
+ PNLM_HEADER = ^NLM_HEADER;
+ NLM_HEADER = record { offset in structure -------------- }
+ signature : array[0..23] of char; { "NetWare Loadable Modulex\1A" }
+ version : dword; { 0x0018 --------------------------- }
+ moduleName : array[0..13] of char; { 0x001C --------------------------- }
+ codeImageOffset : dword; { 0x002A --------------------------- }
+ codeImageSize : dword;
+ dataImageOffset : dword;
+ dataImageSize : dword;
+ uninitializedDataSize : dword;
+ customDataOffset : dword;
+ customDataSize : dword;
+ moduleDependencyOffset : dword;
+ numberOfModuleDependencies : dword;
+ relocationFixupOffset : dword;
+ numberOfRelocationFixups : dword;
+ externalReferencesOffset : dword;
+ numberOfExternalReferences : dword;
+ publicsOffset : dword;
+ numberOfPublics : dword;
+ debugInfoOffset : dword;
+ numberOfDebugRecords : dword;
+ codeStartOffset : dword;
+ exitProcedureOffset : dword;
+ checkUnloadProcedureOffset : dword;
+ moduleType : dword;
+ flags : dword;
+ descriptionLength : byte;
+ descriptionText : array[0..126] of char;
+ stackSize : dword;
+ reserved : dword;
+ reserved2 : array[0..4] of byte;
+ screenNameLength : byte;
+ screenName : array[0..70] of char;
+ threadNameLength : byte;
+ threadName : array[0..70] of char;
+ otherData : array[0..399] of byte;
+ end;
+{ (note: length not actually 0x0333) }
+{ starts 'otherData' of NLM_HEADER }
+{ offset in structure -------------- }
+{ 0x0000 (exactly "VeRsIoN#") }
+{ 0x0008 --------------------------- }
+{ 0x000C --------------------------- }
+{ 0x0010 --------------------------- }
+{ 0x0014 --------------------------- }
+{ 0x0018 --------------------------- }
+{ 0x001A --------------------------- }
+
+ PVERSION_MASK = ^VERSION_MASK;
+ VERSION_MASK = record
+ VeRsIoN : array[0..7] of char;
+ majorVersion : dword;
+ minorVersion : dword;
+ revision : dword;
+ year : dword;
+ month : dword;
+ day : dword;
+ end; { 0x0020 (structure length) }
+
+
+ PCOPYRIGHT_MASK = ^COPYRIGHT_MASK; { immediately follows VERSION_MASK }
+ COPYRIGHT_MASK = record { offset in structure -------------- }
+ _CoPyRiGhT : array[0..9] of char; { 0x0000 (exactly "CoPyRiGhT=") }
+ copyrightLength : byte; { 0x000A --------------------------- }
+ copyright : array[0..251] of char; { 0x000B --------------------------- }
+ end;
+{ 0x0107 (structure length) }
+{ immediately follows COPYRIGHT_MASK }
+{ offset in structure -------------- }
+{ 0x0000 (exactly "MeSsAgEs") }
+{ 0x0008 --------------------------- }
+{ 0x000C --------------------------- }
+{ 0x0010 --------------------------- }
+{ 0x0014 --------------------------- }
+{ 0x0018 --------------------------- }
+{ 0x001C --------------------------- }
+{ 0x0020 --------------------------- }
+{ 0x0024 --------------------------- }
+{ 0x0028 (ignore to end of structure }
+{ 0x0030 ...all these are either }
+{ 0x0034 no longer used or never }
+{ 0x0038 really have been) }
+{ 0x003C --------------------------- }
+{ 0x0040 --------------------------- }
+{ 0x0044 --------------------------- }
+{ 0x0048 --------------------------- }
+{ 0x004C --------------------------- }
+{ 0x0050 --------------------------- }
+{ 0x0054 --------------------------- }
+{ 0x0058 --------------------------- }
+{ 0x0064 --------------------------- }
+{ 0x0068 --------------------------- }
+{ 0x006C --------------------------- }
+{ 0x0070 --------------------------- }
+{ 0x0074 --------------------------- }
+{ 0x0078 --------------------------- }
+{ 0x007C (* see CODEWARRIOR_LASTMOD) }
+
+ PEXTENDED_HEADER = ^EXTENDED_HEADER;
+ EXTENDED_HEADER = record
+ MeSsAgEs : array[0..7] of char;
+ languageID : dword;
+ messageFileOffset : dword;
+ messageFileLength : dword;
+ messageCount : dword;
+ helpFileOffset : dword;
+ helpFileLength : dword;
+ RPCDataOffset : dword;
+ RPCDataLength : dword;
+ sharedCodeOffset : dword;
+ sharedCodeLength : dword;
+ sharedDataOffset : dword;
+ sharedDataLength : dword;
+ sharedRelocationFixupOffset : dword;
+ sharedRelocationFixupLength : dword;
+ sharedExternalReferenceOffset : dword;
+ sharedExternalReferenceCount : dword;
+ sharedPublicsOffset : dword;
+ sharedPublicsCount : dword;
+ sharedDebugRecordOffset : dword;
+ sharedDebugRecordCount : dword;
+ sharedInitializationOffset : function :dword;cdecl;
+ sharedExitProcedureOffset : procedure ;
+ productID : dword;
+ reserved0 : dword;
+ reserved1 : dword;
+ reserved2 : dword;
+ reserved3 : dword;
+ reserved4 : dword;
+ reserved5 : dword;
+ end;
+{ 0x0080 (structure length) }
+{
+** The following syntagm appears only in NLMs linked with Metrowerks
+** Code Warrior. In the hexadecimal dump, it appears starting at 'reserved5'
+** in EXTENDED_HEADER above and appears thus (purely for example):
+**
+** 1C0: 4C 61 53 74 4D 6F 44 69 20 54 68 75 20 4F 63 74 "LaStMoDi Thu Oct"
+** 1D0: 20 20 39 20 31 35 3A 30 33 3A 33 30 20 32 30 30 " 9 19:22:31 200"
+** 1E0: 33 0A 00 "3.. "
+**
+** The start point shown (1C0) is variable, but LASTMOD_MASK will appear at
+** very nearly this offset.
+ }
+{ at 'reserved5' in EXTENDED_HEADER }
+{ offset in structure }
+{ 0x0000 (exactly "LaStMoDi") }
+{ 0x0009 --------------------------- }
+{ 0x000A --------------------------- }
+{ 0x000D --------------------------- }
+{ 0x000E --------------------------- }
+{ 0x0011 --------------------------- }
+{ 0x0012 (blank-padded) ------------ }
+{ 0x0014 --------------------------- }
+{ 0x0015 --------------------------- }
+{ 0x0017 --------------------------- }
+{ 0x0018 --------------------------- }
+{ 0x001A --------------------------- }
+{ 0x001B --------------------------- }
+{ 0x001D --------------------------- }
+{ 0x001E --------------------------- }
+{ 0x0022 --------------------------- }
+{ 0x0023 --------------------------- }
+
+ PLASTMOD_MASK = ^LASTMOD_MASK;
+ LASTMOD_MASK = record
+ LaStMoDi : array[0..7] of char;
+ space : char;
+ weekday : array[0..2] of char;
+ space2 : char;
+ month : array[0..2] of char;
+ space3 : char;
+ day : array[0..1] of char;
+ space4 : char;
+ hours24 : array[0..1] of char;
+ colon1 : char;
+ minutes : array[0..1] of char;
+ colon2 : char;
+ seconds : array[0..1] of char;
+ space5 : char;
+ year : array[0..3] of char;
+ newline : char;
+ null : char;
+ end;
+
+
+ PCUSTOM_HEADER_MASK = ^CUSTOM_HEADER_MASK; { 0x0024 (structure length) }
+ CUSTOM_HEADER_MASK = record { offset in structure -------------- }
+ CuStHeAd : array[0..7] of byte; { 0x0000 "CuStHeAd" }
+ end; { (note: length is custom) }
+
+// nwieeefp.h
+
+type fp_except = longint;
+const
+ FP_X_INV = $01; { invalid operation exception }
+ FP_X_DNML = $02; { denormal operation exception }
+ FP_X_DZ = $04; { divide by zero exception }
+ FP_X_OFL = $08; { overflow exception }
+ FP_X_UFL = $10; { underflow exception }
+ FP_X_IMP = $20; { inexact (precision) exception }
+
+type
+ Pfp_rnd = ^fp_rnd;
+ fp_rnd = Longint;
+Const
+ FP_RN = 0; { round to nearest representable number, tie -> even }
+ FP_RM = 1; { round toward minus infinity }
+ FP_RP = 2; { round toward plus infinity }
+ FP_RZ = 3; { round toward zero (truncate) }
+
+(** unsupported pragma#pragma pack()*)
+
+function fpgetmask:longint;cdecl;external libc_nlm name 'fpgetmask';
+function fpgetround:fp_rnd;cdecl;external libc_nlm name 'fpgetround';
+function fpgetsticky:longint;cdecl;external libc_nlm name 'fpgetsticky';
+function fpsetmask(newmask:longint):longint;cdecl;external libc_nlm name 'fpsetmask';
+function fpsetround(newround:fp_rnd):fp_rnd;cdecl;external libc_nlm name 'fpsetround';
+function fpsetsticky(newsticky:longint):longint;cdecl;external libc_nlm name 'fpsetsticky';
+
+
+(** unsupported pragma#pragma pack()*)
+
+
+// paths.h
+
+const
+ _PATH_DEFPATH = '/system';
+ _PATH_STDPATH = '/system';
+ _PATH_DEVNULL = '/dev/null';
+ _PATH_MAILDIR = '/mail';
+ _PATH_DEV = '/system/';
+ _PATH_TMP = '/tmp/';
+
+
+// proc.h
+
+const
+ PROC_DETACHED = $00000001;
+ PROC_CURRENT_SPACE = $00000004; { use current address space }
+ PROC_MEMORY_DEBUG = $00000008; { same as load -m }
+ PROC_LOAD_SILENT = $00000010; { no console messages }
+ PROC_INHERIT_CWD = $00000020; { child start in same CWD }
+ PROC_INHERIT_ID = $00000040; { child inherits identity }
+ FD_UNUSED = -1; { ignore: do not wire the console }
+
+type
+ Pwiring_t = ^wiring_t; { standard console wiring for process()... }
+ wiring_t = record
+ infd : longint; { new process' standard input, etc. }
+ outfd : longint;
+ errfd : longint;
+ end;
+ TWiring = wiring_t;
+ PWiring = Pwiring_t;
+
+{$ifndef DisableArrayOfConst}
+//function procle(path:Pchar; flags:dword; env:array of Pchar; wiring:Pwiring_t; fds:Pfd_set;
+// appdata:pointer; appdata_size:size_t; reserved:pointer; arg0:Pchar; args:array of const):pid_t;cdecl;external libc_nlm name 'procle';
+{$endif}
+{function procle(path:Pchar; flags:dword; env:array of Pchar; wiring:Pwiring_t; fds:Pfd_set;
+ appdata:pointer; appdata_size:size_t; reserved:pointer; arg0:Pchar):pid_t;cdecl;external libc_nlm name 'procle';
+function procve(path:Pchar; flags:dword; env:array of Pchar; wiring:Pwiring_t; fds:Pfd_set;
+ appdata:pointer; appdata_size:size_t; reserved:pointer; argv:array of Pchar):pid_t;cdecl;external libc_nlm name 'procve';}
+function procve(path:Pchar; flags:dword; env:pointer; wiring:Pwiring_t; fds:Pfd_set;
+ appdata:pointer; appdata_size:size_t; reserved:pointer; argv:ppchar):pid_t;cdecl;external libc_nlm name 'procve';
+function procle(path:Pchar; flags:dword; env:pointer; wiring:Pwiring_t; fds:Pfd_set;
+ appdata:pointer; appdata_size:size_t; reserved:pointer; arg0:Pchar; args:ppchar):pid_t;cdecl;external libc_nlm name 'procle';
+
+// pthread.h
+// sched.h
+{ turn on 1-byte packing... }
+
+const
+ SCHED_UNKNOWN = 0;
+ SCHED_FIFO = 1; { first-in, first-out (default NetWare MPK) }
+ SCHED_RR = 2; { round-robin (unimplemented) }
+ SCHED_SPORADIC = 3; { Single UNIX Specification (unimplemented) }
+ SCHED_OTHER = 4; { "other" policy (unimplemented) }
+
+type
+ Psched_param = ^sched_param;
+ sched_param = record
+ sched_priority : longint; { for SPORADIC (unimplemented): }
+ sched_ss_low_priority : longint; { low scheduling priority }
+ sched_ss_repl_period : Ttimespec; { replenishment period for }
+ sched_ss_init_budget : Ttimespec; { initial budget }
+ sched_ss_max_repl : longint; { maximum pending replenishments }
+ sched_policy : longint;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+
+ const
+ PTHREAD_KEYS_MAX = 64;
+ { no actual maximum }
+ PTHREAD_THREADS_MAX = 32767;
+ PTHREAD_STACK_MIN = 16384;
+ { pthread_setdetachstate, etc... }
+ PTHREAD_CREATE_DETACHED = $00000010;
+ PTHREAD_CREATE_JOINABLE = 0;
+ { values for field 'attr_scope'... }
+ PTHREAD_SCOPE_PROCESS = 0;
+ { as yet unsupported }
+ PTHREAD_SCOPE_SYSTEM = 1;
+ { values for field 'mattr_flags', 'cattr_flags' and 'rwattr_flags'... }
+ PTHREAD_PROCESS_PRIVATE = 0;
+ { as yet unsupported }
+ PTHREAD_PROCESS_SHARED = 1;
+ { pthread_setcancelstate, etc... }
+ PTHREAD_CANCELED = -(1);
+ PTHREAD_CANCEL_ASYNCHRONOUS = 1;
+ PTHREAD_CANCEL_DEFERRED = 2;
+ PTHREAD_CANCEL_DISABLE = 0;
+ PTHREAD_CANCEL_ENABLE = 1;
+ { values for field 'attr_flags'... }
+ PTHREAD_EXPLICIT_SCHED = $0002;
+ { as yet unsupported }
+ PTHREAD_INHERIT_SCHED = $0004;
+ { values for field 'mattr_protocol'... }
+ { as yet unsupported }
+ PTHREAD_PRIO_PROTECT = -(1);
+ { as yet unsupported }
+ PTHREAD_PRIO_INHERIT = 1;
+ { as yet unsupported }
+ PTHREAD_PRIO_NONE = 0;
+ PTHREAD_ONCE_INIT = 0;
+ { values for field 'mattr_kind'... }
+ PTHREAD_MUTEX_NORMAL = $0000;
+ PTHREAD_MUTEX_RECURSIVE = $0010;
+ { as yet unsupported }
+ PTHREAD_MUTEX_ERRORCHECK = $0020;
+ { as yet unsupported }
+ PTHREAD_MUTEX_DEFAULT = $0040;
+
+type
+ Ppthread_once_t = ^pthread_once_t;
+ pthread_once_t = longint;
+
+ Ppthread_key_t = ^pthread_key_t;
+ pthread_key_t = longint;
+
+ Ppthread_t = ^pthread_t;
+ pthread_t = pointer; // longint;
+
+{ turn on 1-byte packing... }
+
+ Ppthread_cond_t = ^pthread_cond_t;
+ pthread_cond_t = record
+ cond : pointer;
+ spares : array[0..5] of longint;
+ end;
+
+ Ppthread_mutex_t = PRtlCriticalSection;
+ pthread_mutex_t = TRtlCriticalSection;
+ TpthreadMutex = TRtlCriticalSection;
+
+ Ppthread_rwlock_t = ^pthread_rwlock_t;
+ pthread_rwlock_t = record
+ rwlock : pointer;
+ reserved : array[0..2] of dword;
+ end;
+
+ Ppthread_attr_t = ^pthread_attr_t;
+ pthread_attr_t = record
+ attr_flags : dword;
+ attr_scope : longint;
+ attr_priority : longint;
+ attr_detachstate : longint;
+ attr_stackaddr : pointer;
+ attr_stacksize : size_t;
+ attr_policy : longint;
+ attr_name : array[0..19] of char;
+ end;
+
+ Ppthread_condattr_t = ^pthread_condattr_t;
+ pthread_condattr_t = record
+ cattr_flags : dword;
+ cattr_arg : pointer;
+ cattr_spare1 : longint;
+ cattr_spare2 : longint;
+ end;
+
+ Ppthread_mutexattr_t = ^pthread_mutexattr_t;
+ pthread_mutexattr_t = record
+ mattr_flags : dword;
+ mattr_kind : longint;
+ mattr_priority : longint;
+ mattr_prioceiling : longint;
+ mattr_protocol : longint;
+ mattr_spares2 : array[0..5] of longint;
+ mattr_name : array[0..31] of char;
+ end;
+ Ppthread_mutex_attr_t = Ppthread_mutexattr_t;
+ pthread_mutex_attr_t = pthread_mutexattr_t;
+ TMutexAttribute = pthread_mutex_attr_t;
+
+ Ppthread_rwlockattr_t = ^pthread_rwlockattr_t;
+ pthread_rwlockattr_t = record
+ rwattr_flags : dword;
+ rwattr_spare1 : longint;
+ rwattr_priority : longint;
+ rwattr_prioceiling : longint;
+ rwattr_protocol : longint;
+ rwattr_spares2 : array[0..5] of longint;
+ rwattr_name : array[0..31] of char;
+ end;
+
+(** unsupported pragma#pragma pack()*)
+{ pthread functions... }
+
+
+type TPTThreadStartFunction = function (_para1:pointer):pointer; cdecl;
+
+function pthread_create(thread:Ppthread_t; attr:Ppthread_attr_t; start_routine:TPTThreadStartFunction; arg:pointer):longint;cdecl;external libc_nlm name 'pthread_create';
+function pthread_cancel(thread:pthread_t):longint;cdecl;external libc_nlm name 'pthread_cancel';
+function pthread_join(thread:pthread_t; status:Ppointer):longint;cdecl;external libc_nlm name 'pthread_join';
+procedure pthread_exit(status:pointer);cdecl;external libc_nlm name 'pthread_exit';
+function pthread_equal(t1:pthread_t; t2:pthread_t):longint;cdecl;external libc_nlm name 'pthread_equal';
+procedure pthread_yield;cdecl;external libc_nlm name 'pthread_yield';
+function pthread_kill(thread:pthread_t; sig:longint):longint;cdecl;external libc_nlm name 'pthread_kill';
+function pthread_detach(thread:pthread_t):longint;cdecl;external libc_nlm name 'pthread_detach';
+
+function pthread_once(once_control:Ppthread_once_t; init_routine:TCDeclProcedure ):longint;cdecl;external libc_nlm name 'pthread_once';
+function pthread_self:pthread_t;cdecl;external libc_nlm name 'pthread_self';
+function pthread_key_create(_para1:Ppthread_key_t; _destructor:TCDeclProc1PtrArg):longint;cdecl;external libc_nlm name 'pthread_key_create';
+function pthread_key_delete(key:pthread_key_t):longint;cdecl;external libc_nlm name 'pthread_key_delete';
+function pthread_getspecific(key:pthread_key_t):pointer;cdecl;external libc_nlm name 'pthread_getspecific';
+
+function pthread_setspecific(key:pthread_key_t; value:pointer):longint;cdecl;external libc_nlm name 'pthread_setspecific';
+function pthread_getschedparam(thread:pthread_t; policy:Plongint; param:Psched_param):longint;cdecl;external libc_nlm name 'pthread_getschedparam';
+
+function pthread_setschedparam(thread:pthread_t; policy:longint; param:Psched_param):longint;cdecl;external libc_nlm name 'pthread_setschedparam';
+function pthread_setcancelstate(state:longint; oldstate:Plongint):longint;cdecl;external libc_nlm name 'pthread_setcancelstate';
+function pthread_setcanceltype(_type:longint; oldtype:Plongint):longint;cdecl;external libc_nlm name 'pthread_setcanceltype';
+procedure pthread_testcancel;cdecl;external libc_nlm name 'pthread_testcancel';
+
+function pthread_sigmask(how:longint; _set:Psigset_t; oset:Psigset_t):longint;cdecl;external libc_nlm name 'pthread_sigmask';
+procedure pthread_cleanup_push(routine:TCDeclProc1PtrArg; arg:pointer);cdecl;external libc_nlm name 'pthread_cleanup_push';
+procedure pthread_cleanup_pop(execute:longint);cdecl;external libc_nlm name 'pthread_cleanup_pop';
+{ pthread attribute functions... }
+function pthread_attr_init(attr:Ppthread_attr_t):longint;cdecl;external libc_nlm name 'pthread_attr_init';
+function pthread_attr_destroy(attr:Ppthread_attr_t):longint;cdecl;external libc_nlm name 'pthread_attr_destroy';
+
+function pthread_attr_getdetachstate(attr:Ppthread_attr_t; detachstate:Plongint):longint;cdecl;external libc_nlm name 'pthread_attr_getdetachstate';
+function pthread_attr_setdetachstate(attr:Ppthread_attr_t; detachstate:longint):longint;cdecl;external libc_nlm name 'pthread_attr_setdetachstate';
+
+function pthread_attr_getinheritsched(attr:Ppthread_attr_t; inheritsched:Plongint):longint;cdecl;external libc_nlm name 'pthread_attr_getinheritsched';
+function pthread_attr_setinheritsched(attr:Ppthread_attr_t; inheritsched:longint):longint;cdecl;external libc_nlm name 'pthread_attr_setinheritsched';
+function pthread_attr_getschedparam(attr:Ppthread_attr_t; param:Psched_param):longint;cdecl;external libc_nlm name 'pthread_attr_getschedparam';
+function pthread_attr_setschedparam(attr:Ppthread_attr_t; param:Psched_param):longint;cdecl;external libc_nlm name 'pthread_attr_setschedparam';
+function pthread_attr_getschedpolicy(attr:Ppthread_attr_t; policy:Plongint):longint;cdecl;external libc_nlm name 'pthread_attr_getschedpolicy';
+function pthread_attr_setschedpolicy(attr:Ppthread_attr_t; policy:longint):longint;cdecl;external libc_nlm name 'pthread_attr_setschedpolicy';
+function pthread_attr_getscope(attr:Ppthread_attr_t; contentionscope:Plongint):longint;cdecl;external libc_nlm name 'pthread_attr_getscope';
+function pthread_attr_setscope(attr:Ppthread_attr_t; contentionscope:longint):longint;cdecl;external libc_nlm name 'pthread_attr_setscope';
+function pthread_attr_getstackaddr(attr:Ppthread_attr_t; stackaddr:Ppointer):longint;cdecl;external libc_nlm name 'pthread_attr_getstackaddr';
+function pthread_attr_setstackaddr(attr:Ppthread_attr_t; stackaddr:pointer):longint;cdecl;external libc_nlm name 'pthread_attr_setstackaddr';
+function pthread_attr_getstacksize(attr:Ppthread_attr_t; stacksize:Psize_t):longint;cdecl;external libc_nlm name 'pthread_attr_getstacksize';
+function pthread_attr_setstacksize(attr:Ppthread_attr_t; stacksize:size_t):longint;cdecl;external libc_nlm name 'pthread_attr_setstacksize';
+function pthread_attr_getname_np(attr:Ppthread_attr_t; name:Pchar; len:size_t; mbz:Ppointer):longint;cdecl;external libc_nlm name 'pthread_attr_getname_np';
+function pthread_attr_setname_np(attr:Ppthread_attr_t; name:Pchar; mbz:pointer):longint;cdecl;external libc_nlm name 'pthread_attr_setname_np';
+{ condition variable functions... }
+
+function pthread_cond_init(cond:Ppthread_cond_t; attr:Ppthread_condattr_t):longint;cdecl;external libc_nlm name 'pthread_cond_init';
+function pthread_cond_destroy(cond:Ppthread_cond_t):longint;cdecl;external libc_nlm name 'pthread_cond_destroy';
+function pthread_cond_signal(cond:Ppthread_cond_t):longint;cdecl;external libc_nlm name 'pthread_cond_signal';
+function pthread_cond_broadcast(cond:Ppthread_cond_t):longint;cdecl;external libc_nlm name 'pthread_cond_broadcast';
+function pthread_cond_wait(cond:Ppthread_cond_t; mutex:Ppthread_mutex_t):longint;cdecl;external libc_nlm name 'pthread_cond_wait';
+
+function pthread_cond_timedwait(cond:Ppthread_cond_t; mutex:Ppthread_mutex_t; abstime:Ptimespec):longint;cdecl;external libc_nlm name 'pthread_cond_timedwait';
+{ condition variable attribute functions... }
+function pthread_condattr_init(attr:Ppthread_condattr_t):longint;cdecl;external libc_nlm name 'pthread_condattr_init';
+function pthread_condattr_destroy(attr:Ppthread_condattr_t):longint;cdecl;external libc_nlm name 'pthread_condattr_destroy';
+function pthread_condattr_getpshared(attr:Ppthread_condattr_t; pshared:Plongint):longint;cdecl;external libc_nlm name 'pthread_condattr_getpshared';
+function pthread_condattr_setpshared(attr:Ppthread_condattr_t; pshared:longint):longint;cdecl;external libc_nlm name 'pthread_condattr_setpshared';
+{ mutex functions... }
+
+function pthread_mutex_init(mutex:Ppthread_mutex_t; attr:Ppthread_mutexattr_t):longint;cdecl;external libc_nlm name 'pthread_mutex_init';
+function pthread_mutex_destroy(mutex:Ppthread_mutex_t):longint;cdecl;external libc_nlm name 'pthread_mutex_destroy';
+function pthread_mutex_lock(mutex:Ppthread_mutex_t):longint;cdecl;external libc_nlm name 'pthread_mutex_lock';
+function pthread_mutex_trylock(mutex:Ppthread_mutex_t):longint;cdecl;external libc_nlm name 'pthread_mutex_trylock';
+function pthread_mutex_unlock(mutex:Ppthread_mutex_t):longint;cdecl;external libc_nlm name 'pthread_mutex_unlock';
+{ mutex attribute functions... }
+function pthread_mutexattr_init(attr:Ppthread_mutexattr_t):longint;cdecl;external libc_nlm name 'pthread_mutexattr_init';
+function pthread_mutexattr_destroy(attr:Ppthread_mutexattr_t):longint;cdecl;external libc_nlm name 'pthread_mutexattr_destroy';
+function pthread_mutexattr_getprioceiling(attr:Ppthread_mutexattr_t; prioceiling:Plongint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_getprioceiling';
+function pthread_mutexattr_setprioceiling(attr:Ppthread_mutexattr_t; prioceiling:longint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_setprioceiling';
+function pthread_mutexattr_getprotocol(attr:Ppthread_mutexattr_t; protocol:Plongint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_getprotocol';
+function pthread_mutexattr_setprotocol(attr:Ppthread_mutexattr_t; protocol:longint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_setprotocol';
+function pthread_mutexattr_getpshared(attr:Ppthread_mutexattr_t; pshared:Plongint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_getpshared';
+function pthread_mutexattr_setpshared(attr:Ppthread_mutexattr_t; pshared:longint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_setpshared';
+function pthread_mutexattr_gettype(attr:Ppthread_mutexattr_t; kind:Plongint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_gettype';
+function pthread_mutexattr_settype(attr:Ppthread_mutexattr_t; kind:longint):longint;cdecl;external libc_nlm name 'pthread_mutexattr_settype';
+{ reader-writer lock functions... }
+function pthread_rwlock_init(rwlp:Ppthread_rwlock_t; attr:Ppthread_rwlockattr_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_init';
+function pthread_rwlock_destroy(rwlp:Ppthread_rwlock_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_destroy';
+function pthread_rwlock_rdlock(rwlp:Ppthread_rwlock_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_rdlock';
+function pthread_rwlock_wrlock(rwlp:Ppthread_rwlock_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_wrlock';
+function pthread_rwlock_tryrdlock(rwlp:Ppthread_rwlock_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_tryrdlock';
+function pthread_rwlock_trywrlock(rwlp:Ppthread_rwlock_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_trywrlock';
+function pthread_rwlock_unlock(rwlp:Ppthread_rwlock_t):longint;cdecl;external libc_nlm name 'pthread_rwlock_unlock';
+function pthread_rwlock_timedrdlock(rwlock:Ppthread_rwlock_t; abs_timeout:Ptimespec):longint;cdecl;external libc_nlm name 'pthread_rwlock_timedrdlock';
+function pthread_rwlock_timedwrlock(rwlock:Ppthread_rwlock_t; abs_timeout:Ptimespec):longint;cdecl;external libc_nlm name 'pthread_rwlock_timedwrlock';
+{ reader-writer lock attribute functions... }
+function pthread_rwlockattr_init(attr:Ppthread_rwlockattr_t):longint;cdecl;external libc_nlm name 'pthread_rwlockattr_init';
+function pthread_rwlockattr_destroy(attr:Ppthread_rwlockattr_t):longint;cdecl;external libc_nlm name 'pthread_rwlockattr_destroy';
+function pthread_rwlockattr_getpshared(attr:Ppthread_rwlockattr_t; pshared:Plongint):longint;cdecl;external libc_nlm name 'pthread_rwlockattr_getpshared';
+function pthread_rwlockattr_setpshared(attr:Ppthread_rwlockattr_t; pshared:longint):longint;cdecl;external libc_nlm name 'pthread_rwlockattr_setpshared';
+{ registering functions to execute at call to fork()... }
+function pthread_atfork(prepare, parent, child:TCDeclProcedure):longint;cdecl;external libc_nlm name 'pthread_atfork';
+
+
+type
+ Ppasswd = ^passwd;
+ passwd = record
+ pw_uid : uid_t; // user id
+ pw_spare1 : uid_t;
+ pw_gid : gid_t; // group id
+ pw_spare2 : gid_t;
+ pw_name : Pchar; // username
+ pw_dir : Pchar; // home directory
+ pw_shell : Pchar; // default shell
+ pw_LDAPName: Pchar; // real name
+ pw_passwd : Pchar; // password (always nil)
+ pw_gecos : Pchar; // general information
+ pw_comment : Pchar; // commend
+ pw_change : time_t; // password change time
+ pw_expire : time_t; // account expiration
+ spare1 : array[0..2] of pointer;
+ spare2 : array[0..3] of pointer;
+ end;
+
+
+//!! function geteuid:uid_t;cdecl;external libc_nlm name 'geteuid';
+//!! function getuid:uid_t;cdecl;external libc_nlm name 'getuid';
+function posixlogin(host:Pchar; port:longint; name:Pchar; pwd:Pchar; ctx:Pchar):longint;cdecl;external libc_nlm name 'posixlogin';
+function posixlogout:longint;cdecl;external libc_nlm name 'posixlogout';
+
+{$ifdef EnableLibcRegex}
+
+
+// regex.h
+type
+ Pregoff_t = ^regoff_t;
+ regoff_t = off_t;
+
+ Preg_syntax_t = ^reg_syntax_t;
+ reg_syntax_t = dword;
+
+ Ps_reg_t = ^s_reg_t;
+ s_reg_t = longint;
+
+ Pactive_reg_t = ^active_reg_t;
+ active_reg_t = dword;
+{ number of parenthesized subexpressions }
+
+{ end pointer for REG_PEND }
+{ not visible }
+
+ Pregex_t = ^regex_t;
+ regex_t = record
+ re_magic : longint;
+ re_nsub : size_t;
+ re_endp : Pchar;
+ re_g : Pre_guts;
+ end;
+
+ const
+ REG_BASIC = 0000;
+ REG_EXTENDED = 0001;
+ REG_ICASE = 0002;
+ REG_NOSUB = 0004;
+ REG_NEWLINE = 0010;
+ REG_NOSPEC = 0020;
+ REG_PEND = 0040;
+ REG_DUMP = 0200;
+ { regerror() flags }
+ REG_NOMATCH = 1;
+ REG_BADPAT = 2;
+ REG_ECOLLATE = 3;
+ REG_ECTYPE = 4;
+ REG_EESCAPE = 5;
+ REG_ESUBREG = 6;
+ REG_EBRACK = 7;
+ REG_EPAREN = 8;
+ REG_EBRACE = 9;
+ REG_BADBR = 10;
+ REG_ERANGE = 11;
+ REG_ESPACE = 12;
+ REG_BADRPT = 13;
+ REG_EMPTY = 14;
+ REG_ASSERT = 15;
+ REG_INVARG = 16;
+ { convert name to number (!) }
+ REG_ATOI = 255;
+ { convert number to name (!) }
+ REG_ITOA = 0400;
+ { regexec() flags }
+ REG_NOTBOL = 00001;
+ REG_NOTEOL = 00002;
+ REG_STARTEND = 00004;
+ { tracing of execution }
+ REG_TRACE = 00400;
+ { force large representation }
+ REG_LARGE = 01000;
+ { force use of backref code }
+ REG_BACKR = 02000;
+
+
+ Pregmatch_t = ^regmatch_t;
+ regmatch_t = record
+ rm_so : regoff_t;
+ rm_eo : regoff_t;
+ end;
+{ regcomp() flags... }
+{ regerror() flags }
+{ regexec() flags }
+
+{$endif EnableLibcRegex}
+
+
+// ringx.h
+
+const PAGE_SIZE = 4096;
+
+
+type RxCleanup_t = procedure (addr:pointer);cdecl;
+{ preliminary (registration and clean-up)... }
+
+function RxIdentifyCode(startFuncAddr:pointer; endFuncAddrPlusOne:pointer; marshallingCodeReference:Plongint):longint;cdecl;external system_nlm name 'RxIdentifyCode';
+function RxUnidentifyCode(marshallingCodeReference:longint):longint;cdecl;external system_nlm name 'RxUnidentifyCode';
+function RxRegisterSysCall(marshalledFuncAddr:pointer; unmarshalledName:Pchar; argCount:longint):longint;cdecl;external system_nlm name 'RxRegisterSysCall';
+function RxUnregisterSysCall(unmarshalledName:Pchar):longint;cdecl;external system_nlm name 'RxUnregisterSysCall';
+{ mundane calls... }
+function RxLockMemory(addr:pointer; length:size_t):longint;cdecl;external system_nlm name 'RxLockMemory';
+function RxUnlockMemory(addr:pointer; length:size_t):longint;cdecl;external system_nlm name 'RxUnlockMemory';
+{ to handle address space fault and threads caught in kernel... }
+function RxRegisterKernelResource(_para1:pointer; _para2:RxCleanup_t):longint;cdecl;external system_nlm name 'RxRegisterKernelResource';
+function RxRegisterThreadResource(_para1:pointer; _para2:RxCleanup_t):longint;cdecl;external system_nlm name 'RxRegisterThreadResource';
+function RxUnregisterKernelResource(_para1:pointer):longint;cdecl;external system_nlm name 'RxUnregisterKernelResource';
+function RxUnregisterThreadResource(_para1:pointer):longint;cdecl;external system_nlm name 'RxUnregisterThreadResource';
+{ data; referenced to avoid compiler optimization of code including this }
+//?? var
+//?? RxTmp : longint;cvar;public;
+{ main working macros (buffers and structures, char and wide strings... }
+
+
+// semaphore.h
+
+const
+ SEM_VALUE_MAX = $7FFFFFFF;
+// #define SEM_FAILED ((sem_t *) 0)
+
+type
+ Psem_t = ^sem_t;
+ sem_t = record
+ sema : pointer;
+ spares : array[0..5] of longint;
+ end;
+
+function sem_init(sem:Psem_t; pshared:longint; value:dword):longint;cdecl;external libc_nlm name 'sem_init';
+function sem_destroy(sem:Psem_t):longint;cdecl;external libc_nlm name 'sem_destroy';
+function sem_getvalue(sem:Psem_t; sval:Plongint):longint;cdecl;external libc_nlm name 'sem_getvalue';
+function sem_post(sem:Psem_t):longint;cdecl;external libc_nlm name 'sem_post';
+function sem_wait(sem:Psem_t):longint;cdecl;external libc_nlm name 'sem_wait';
+function sem_trywait(sem:Psem_t):longint;cdecl;external libc_nlm name 'sem_trywait';
+function sem_timedwait(sem:Psem_t; abstime:Ptimespec):longint;cdecl;external libc_nlm name 'sem_timedwait';
+
+
+// setjmp.h
+
+type
+ _Pjmp_buf = ^_jmp_buf;
+ _jmp_buf = double;
+
+procedure __longjmp(_para1:_jmp_buf; _para2:longint);cdecl;external libc_nlm name '__longjmp';
+function __setjmp(_para1:_jmp_buf):longint;cdecl;external libc_nlm name '__setjmp';
+
+// synch.h
+
+const
+ USYNC_THREAD = 0;
+ USYNC_PROCESS = 1; { shared between processes (unsupported)}
+ USYNC_DESTROYED = 2; { deallocated object }
+
+type
+ //!! timespec = timestruc_t;
+ Pbarrier = ^barrier;
+ barrier = record
+ reserved : array[0..7] of longint;
+ end;
+ barrier_t = barrier;
+ Pbarrier_t = ^barrier_t;
+
+ Pcond_t = ^cond_t;
+ cond_t = pthread_cond_t;
+
+ Pmutex_t = ^mutex_t;
+ mutex_t = pthread_mutex_t;
+
+ Prwlock_t = ^rwlock_t;
+ rwlock_t = pthread_rwlock_t;
+
+ Psema_t = ^sema_t;
+ sema_t = sem_t;
+
+function barrier_init(bp:Pbarrier_t; threads:longint):longint;cdecl;external libc_nlm name 'barrier_init';
+procedure barrier_destroy(bp:Pbarrier_t);cdecl;external libc_nlm name 'barrier_destroy';
+function barrier_wait(bp:Pbarrier_t):longint;cdecl;external libc_nlm name 'barrier_wait';
+function barrier_inc(bp:Pbarrier_t):longint;cdecl;external libc_nlm name 'barrier_inc';
+function barrier_dec(bp:Pbarrier_t):longint;cdecl;external libc_nlm name 'barrier_dec';
+function cond_init(cvp:Pcond_t; _type:longint; arg:longint):longint;cdecl;external libc_nlm name 'cond_init';
+function cond_destroy(cvp:Pcond_t):longint;cdecl;external libc_nlm name 'cond_destroy';
+function cond_broadcast(cvp:Pcond_t):longint;cdecl;external libc_nlm name 'cond_broadcast';
+function cond_signal(cvp:Pcond_t):longint;cdecl;external libc_nlm name 'cond_signal';
+function cond_wait(cvp:Pcond_t; mp:Pmutex_t):longint;cdecl;external libc_nlm name 'cond_wait';
+//!! function cond_timedwait(cvp:Pcond_t; mp:Pmutex_t; abstime:Ptimestruc_t):longint;cdecl;external libc_nlm name 'cond_timedwait';
+function mutex_init(mp:Pmutex_t; _type:longint; arg:pointer):longint;cdecl;external libc_nlm name 'mutex_init';
+function mutex_destroy(mp:Pmutex_t):longint;cdecl;external libc_nlm name 'mutex_destroy';
+function mutex_lock(mp:Pmutex_t):longint;cdecl;external libc_nlm name 'mutex_lock';
+function mutex_trylock(mp:Pmutex_t):longint;cdecl;external libc_nlm name 'mutex_trylock';
+function mutex_unlock(mp:Pmutex_t):longint;cdecl;external libc_nlm name 'mutex_unlock';
+function rwlock_init(rwlp:Prwlock_t; _type:longint; arg:pointer):longint;cdecl;external libc_nlm name 'rwlock_init';
+function rwlock_destroy(rwlp:Prwlock_t):longint;cdecl;external libc_nlm name 'rwlock_destroy';
+function rw_rdlock(rwlp:Prwlock_t):longint;cdecl;external libc_nlm name 'rw_rdlock';
+function rw_wrlock(rwlp:Prwlock_t):longint;cdecl;external libc_nlm name 'rw_wrlock';
+function rw_tryrdlock(rwlp:Prwlock_t):longint;cdecl;external libc_nlm name 'rw_tryrdlock';
+function rw_trywrlock(rwlp:Prwlock_t):longint;cdecl;external libc_nlm name 'rw_trywrlock';
+function rw_unlock(rwlp:Prwlock_t):longint;cdecl;external libc_nlm name 'rw_unlock';
+function sema_init(sp:Psema_t; count:dword; _type:longint; arg:pointer):longint;cdecl;external libc_nlm name 'sema_init';
+function sema_destroy(sp:Psema_t):longint;cdecl;external libc_nlm name 'sema_destroy';
+function sema_post(sp:Psema_t):longint;cdecl;external libc_nlm name 'sema_post';
+function sema_trywait(sp:Psema_t):longint;cdecl;external libc_nlm name 'sema_trywait';
+function sema_wait(sp:Psema_t):longint;cdecl;external libc_nlm name 'sema_wait';
+
+// syslog.h
+
+{ log options for openlog()... }
+{ message facilities for openlog()... }
+{ for constructing 'maskpri' for setlogmask()... }
+{ values for priority argument of syslog()... }
+{ with no filename argument, syslogd.nlm uses this configuration file: }
+// termio.h
+// termios.h
+{
+** Note: This is a very primitive and narrow adaptation of POSIX termios.h.
+** Most of what is in this file is for completeness and to avoid locking
+** termios.h interfaces off from advancing progressively as needed.}
+
+
+ const
+ NCCS = 32;
+ { ^C }
+ INTR = $03;
+ { ^D }
+ QUIT = $04;
+ { ^Z }
+ SUSP = $1A;
+ { currently unsupported }
+ ECHO = $01;
+ { currently unsupported }
+ ECHOE = $02;
+ { currently unsupported }
+ ECHOK = $04;
+ { currently unsupported }
+ ECHONL = $08;
+ { currently unsupported }
+ ICANON = $10;
+ { currently unsupported }
+ IEXTEN = $20;
+ { check against INTR, QUIT and SUSP (default) }
+ ISIG = $40;
+ { currently unsupported }
+ NOFLSH = $80;
+ { c_iflag bits... }
+ IGNBRK = 0000001;
+ BRKINT = 0000002;
+ IGNPAR = 0000004;
+ PARMRK = 0000010;
+ INPCK = 0000020;
+ ISTRIP = 0000040;
+ INLCR = 0000100;
+ IGNCR = 0000200;
+ ICRNL = 0000400;
+ IUCLC = 0001000;
+ IXON = 0002000;
+ IXANY = 0004000;
+ IXOFF = 0010000;
+ IMAXBEL = 0020000;
+ CSIZE = 0000060;
+ CS5 = 0000000;
+ CS6 = 0000020;
+ CS7 = 0000040;
+ CS8 = 0000060;
+ CSTOPB = 0000100;
+ CREAD = 0000200;
+ PARENB = 0000400;
+ PARODD = 0001000;
+ HUPCL = 0002000;
+ CLOCAL = 0004000;
+ { 'c_cc' control characters... }
+ { ^C }
+ VINTR = 1;
+ { ^\ (unsupported) }
+ VQUIT = 2;
+ { del (unsupported) }
+ VERASE = 3;
+ { ^D }
+ VEOF = 4;
+ { @ (unsupported) }
+ VKILL = 5;
+ { currently unsupported }
+ VTIME = 6;
+ { currently unsupported }
+ VMIN = 7;
+ { ^q (unsupported) }
+ VSTART = 8;
+ { ^s (unsupported) }
+ VSTOP = 9;
+ { ^z }
+ VSUSP = 10;
+ { '\0' (unsupported) }
+ VEOL = 11;
+ { 'optional_actions' causes action to be effectuated when: }
+ { immediately }
+ TCSANOW = 1;
+ { output done (unsupported) }
+ TCSADRAIN = 2;
+ { output done and input discarded (unsupported) }
+ TCSAFLUSH = 3;
+
+
+{ c_iflag bits... }
+{ 'c_cc' control characters... }
+{ 'optional_actions' causes action to be effectuated when: }
+type
+ Ptcflag_t = ^tcflag_t;
+ tcflag_t = dword;
+
+ Pcc_t = ^cc_t;
+ cc_t = byte;
+
+ Pspeed_t = ^speed_t;
+ speed_t = Longint;
+ Const
+ B0 = 0;
+ B50 = 50;
+ B75 = 75;
+ B110 = 110;
+ B134 = 134;
+ B150 = 150;
+ B200 = 200;
+ B300 = 300;
+ B600 = 600;
+ B1200 = 1200;
+ B1800 = 1800;
+ B2400 = 2400;
+ B4800 = 4800;
+ B9600 = 9600;
+ B19200 = 19200;
+ B38400 = 38400;
+
+{ ioctl() control packet... }
+{ input modes --currently unused }
+{ output modes --currently unused }
+{ control modes --currently unused }
+{ local modes --ISIG currently supported }
+{ input speed --currently unused }
+{ output speed --currently unused }
+{ line discipline --currently unused }
+{ control chars --currently used }
+type
+ Ptermios = ^termios;
+ termios = record
+ c_iflag : tcflag_t;
+ c_oflag : tcflag_t;
+ c_cflag : tcflag_t;
+ c_lflag : tcflag_t;
+ c_ispeed : speed_t;
+ c_ospeed : speed_t;
+ c_line : cc_t;
+ c_spare1 : dword;
+ c_cc : array[0..31] of cc_t;
+ c_spare2 : dword;
+ c_spare3 : dword;
+ c_spare4 : dword;
+ c_spare5 : dword;
+ end;
+
+{ POSIX-defined functions... }
+
+function tcgetattr(fildes:longint; tp:Ptermios):longint;cdecl;external libc_nlm name 'tcgetattr';
+function tcsetattr(fildes:longint; optional_actions:longint; tp:Ptermios):longint;cdecl;external libc_nlm name 'tcsetattr';
+
+// tgmath.h
+
+{ syslog.h
+ ==============================================================================}
+ { log options for openlog()... }
+ { log the process ID with each message }
+
+ const
+ LOG_PID = $00000001;
+ LOG_CONS = $00000002; { log to the system console on error }
+ LOG_NDELAY = $00000004; { connect to syslog daemon immediately }
+ LOG_ODELAY = $00000008; { delay open until syslog() is called }
+ LOG_NOWAIT = $00000010; { do not wait for child processes }
+ { message facilities for openlog()... }
+ LOG_KERN = $00000001; { generated by system }
+ LOG_USER = $00000002; { generated by a process }
+ LOG_MAIL = $00000004; { generated by mail system }
+ LOG_NEWS = $00000008; { generated by news system }
+ LOG_UUCP = $00000010; { generated by UUCP system }
+ LOG_DAEMON = $00000020; { generated by daemon }
+ LOG_AUTH = $00000040; { generated by auth. daemon }
+ LOG_CRON = $00000080; { generated by clock daemon }
+ LOG_LPR = $00000100; { generated by printer system }
+ LOG_LOCAL0 = $00000200; { local use }
+ LOG_LOCAL1 = $00000400;
+ LOG_LOCAL2 = $00000800;
+ LOG_LOCAL3 = $00001000;
+ LOG_LOCAL4 = $00002000;
+ LOG_LOCAL5 = $00004000;
+ LOG_LOCAL6 = $00008000;
+ LOG_LOCAL7 = $00010000;
+ LOG_UNUSED1 = $00020000;
+ LOG_UNUSED2 = $00040000;
+ LOG_UNUSED3 = $00080000;
+ LOG_UNUSED4 = $00100000;
+ LOG_UNUSED5 = $00200000;
+ LOG_UNUSED6 = $00400000; { unused }
+ LOG_UNUSED7 = $00800000; { unused }
+ { for constructing 'maskpri' for setlogmask()... }
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+// function LOG_MASK(p : longint) : longint;
+ LOG_EMERG = $01000000;
+ LOG_ALERT = $02000000; { condition to correct immediately }
+ LOG_CRIT = $04000000; { critical condition }
+ LOG_ERR = $08000000; { error message }
+ LOG_WARNING = $10000000; { warning message }
+ LOG_NOTICE = $20000000; { condition requiring special handling }
+ LOG_INFO = $40000000; { general information message }
+ LOG_DEBUG = $80000000; { message useful for debugging programs }
+ P_cfgfile = 'sys:/etc/syslog.conf'; { with no filename argument, syslogd.nlm uses this configuration file: }
+
+ procedure closelog;cdecl;external libc_nlm name 'closelog';
+ procedure openlog(ident:Pchar; logopt:longint; facility:longint);cdecl;external libc_nlm;
+ function setlogmask(maskpri:longint):longint;cdecl;external libc_nlm name 'setlogmask';
+{$ifndef DisableArrayOfConst}
+ procedure syslog(priority:longint; message:Pchar; args:array of const);cdecl;external libc_nlm name 'syslog';
+{$endif}
+ procedure syslog(priority:longint; message:Pchar);cdecl;external libc_nlm name 'syslog';
+
+
+
+// thread.h
+
+ const
+ THR_BOUND = $00000080;
+ THR_DETACHED = PTHREAD_CREATE_DETACHED;
+ THR_NEW_LWP = $FFFFFFFE;
+ THR_SUSPENDED = $00000020;
+ THR_DAEMON = $00000040;
+
+
+{ type definitions... }
+type
+
+//!! Pthread_t = ^thread_t;
+ thread_t = pthread_t;
+
+//!! Pthread_key_t = ^thread_key_t;
+ thread_key_t = pthread_key_t;
+{ prototypes... }
+
+type TThrStartRoutine = function (_para1:pointer):pointer; cdecl;
+function thr_create(stack_based:pointer; stack_size:size_t;
+ start_routine:TThrStartRoutine; arg:pointer; flags:longint;
+ new_thr:Pthread_t):longint;cdecl;external libc_nlm name 'thr_create';
+function thr_self:thread_t;cdecl;external libc_nlm name 'thr_self';
+function thr_suspend(thr:thread_t):longint;cdecl;external libc_nlm name 'thr_suspend';
+function thr_continue(thr:thread_t):longint;cdecl;external libc_nlm name 'thr_continue';
+function thr_join(wait_for:thread_t; dead:Pthread_t; status:Ppointer):longint;cdecl;external libc_nlm name 'thr_join';
+procedure thr_yield;cdecl;external libc_nlm name 'thr_yield';
+procedure thr_exit(status:pointer);cdecl;external libc_nlm name 'thr_exit';
+function thr_minstack:size_t;cdecl;external libc_nlm name 'thr_minstack';
+function thr_kill(thr:thread_t; sig:longint):longint;cdecl;external libc_nlm name 'thr_kill';
+
+function thr_sigsetmask(how:longint; _set:Psigset_t; oset:Psigset_t):longint;cdecl;external libc_nlm name 'thr_sigsetmask';
+function thr_getconcurrency:longint;cdecl;external libc_nlm name 'thr_getconcurrency';
+function thr_setconcurrency(new_level:longint):longint;cdecl;external libc_nlm name 'thr_setconcurrency';
+function thr_getprio(thr:thread_t; pri:Plongint):longint;cdecl;external libc_nlm name 'thr_getprio';
+function thr_setprio(thr:thread_t; pri:longint):longint;cdecl;external libc_nlm name 'thr_setprio';
+function thr_keycreate(key:Pthread_key_t; _destructor:TCDeclProc1PtrArg):longint;cdecl;external libc_nlm name 'thr_keycreate';
+function thr_getspecific(key:thread_key_t; value:Ppointer):longint;cdecl;external libc_nlm name 'thr_getspecific';
+function thr_setspecific(key:thread_key_t; value:pointer):longint;cdecl;external libc_nlm name 'thr_setspecific';
+
+// utf8.h
+
+type
+ Putf8_t = ^utf8_t;
+ utf8_t = byte;
+ PPutf8_t = ^Putf8_t;
+// var __utf8width : array of byte;cvar;external;
+{ prototypes... }
+
+
+function utf8width(ch:Putf8_t):size_t;cdecl;external libc_nlm name 'utf8width';
+function utf8cat(tgt:Putf8_t; src:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8cat';
+function utf8chr(_string:Putf8_t; ch:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8chr';
+function utf8cmp(s1:Putf8_t; s2:Putf8_t):longint;cdecl;external libc_nlm name 'utf8cmp';
+function utf8cpy(tgt:Putf8_t; src:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8cpy';
+function utf8cspn(_string:Putf8_t; charset:Putf8_t):size_t;cdecl;external libc_nlm name 'utf8cspn';
+function utf8dup(s:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8dup';
+function utf8index(_string:Putf8_t; search:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8index';
+function utf8len(_string:Putf8_t):size_t;cdecl;external libc_nlm name 'utf8len';
+{$ifndef DisableArrayOfConst}
+function utf8list(tgt:Putf8_t; s1:Putf8_t; args:array of const):Putf8_t;cdecl;external libc_nlm name 'utf8list';
+{$endif}
+function utf8list(tgt:Putf8_t; s1:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8list';
+function utf8lwr(_string:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8lwr';
+function utf8ncat(tgt:Putf8_t; src:Putf8_t; n:size_t):Putf8_t;cdecl;external libc_nlm name 'utf8ncat';
+function utf8ncmp(s1:Putf8_t; s2:Putf8_t; n:size_t):longint;cdecl;external libc_nlm name 'utf8ncmp';
+function utf8ncpy(tgt:Putf8_t; src:Putf8_t; n:size_t):Putf8_t;cdecl;external libc_nlm name 'utf8ncpy';
+function utf8next(_string:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8next';
+function utf8nlen(_string:Putf8_t; nbytes:size_t):size_t;cdecl;external libc_nlm name 'utf8nlen';
+function utf8nset(base:Putf8_t; ch:Putf8_t; n:size_t):Putf8_t;cdecl;external libc_nlm name 'utf8nset';
+function utf8pbrk(s1:Putf8_t; s2:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8pbrk';
+function utf8prev(_string:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8prev';
+function utf8rchr(_string:Putf8_t; ch:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8rchr';
+function utf8rev(_string:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8rev';
+function utf8size(_string:Putf8_t):size_t;cdecl;external libc_nlm name 'utf8size';
+function utf8spn(_string:Putf8_t; charset:Putf8_t):size_t;cdecl;external libc_nlm name 'utf8spn';
+function utf8str(as1:Putf8_t; as2:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8str';
+function utf8tolower(_string:Putf8_t; dest:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8tolower';
+function utf8tok_r(_string:Putf8_t; sepset:Putf8_t; lasts:PPutf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8tok_r';
+function utf8toupper(_string:Putf8_t; dest:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8toupper';
+function utf8upr(_string:Putf8_t):Putf8_t;cdecl;external libc_nlm name 'utf8upr';
+function isutf8ascii(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8ascii';
+function isutf8digit(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8digit';
+function isutf8xdigit(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8xdigit';
+function isutf8space(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8space';
+function isutf8alnum(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8alnum';
+function isutf8alpha(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8alpha';
+function isutf8lower(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8lower';
+function isutf8upper(_string:Putf8_t):longint;cdecl;external libc_nlm name 'isutf8upper';
+
+
+// utime.h
+{ turn on 1-byte packing... }
+
+{ access time }
+{ modification time }
+type
+ Putimbuf = ^Tutimbuf;
+ Tutimbuf = record
+ actime : time_t;
+ modtime : time_t;
+ end;
+ utimbuf = Tutimbuf;
+
+(** unsupported pragma#pragma pack()*)
+
+
+
+function utime(path:Pchar; times:Putimbuf):longint;cdecl;external libc_nlm name 'utime';
+function utime(path:Pchar; var times:Tutimbuf):longint;cdecl;external libc_nlm name 'utime';
+
+
+// utsname.h
+// wctype.h
+type
+ Pwctype_t = ^wctype_t;
+ wctype_t = Longint;
+Const
+ WCTYPE_UNDEF = 0;
+ WCTYPE_ALNUM = 1;
+ WCTYPE_ALPHA = 2;
+ WCTYPE_BLANK = 3;
+ WCTYPE_CNTRL = 4;
+ WCTYPE_DIGIT = 5;
+ WCTYPE_GRAPH = 6;
+ WCTYPE_LOWER = 7;
+ WCTYPE_PRINT = 8;
+ WCTYPE_PUNCT = 9;
+ WCTYPE_SPACE = 10;
+ WCTYPE_UPPER = 11;
+ WCTYPE_XDIGIT = 12;
+
+type
+ Pwctrans_t = ^wctrans_t;
+ wctrans_t = wchar_t;
+
+function iswalnum(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswalnum';
+function iswalpha(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswalpha';
+function iswblank(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswblank';
+function iswcntrl(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswcntrl';
+function iswdigit(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswdigit';
+function iswgraph(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswgraph';
+function iswlower(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswlower';
+function iswprint(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswprint';
+function iswpunct(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswpunct';
+function iswspace(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswspace';
+function iswupper(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswupper';
+function iswxdigit(_para1:longint):longint;cdecl;external libc_nlm name 'iswxdigit';
+function towlower(_para1:wint_t):wint_t;cdecl;external libc_nlm name 'towlower';
+function towupper(_para1:wint_t):wint_t;cdecl;external libc_nlm name 'towupper';
+function iswctype(_para1:wint_t; _para2:wctype_t):longint;cdecl;external libc_nlm name 'iswctype';
+
+function wctype(_para1:Pchar):wctype_t;cdecl;external libc_nlm name 'wctype';
+function towctrans(_para1:wint_t; _para2:wctrans_t):wint_t;cdecl;external libc_nlm name 'towctrans';
+
+function wctrans(_para1:Pchar):wctrans_t;cdecl;external libc_nlm name 'wctrans';
+function iswascii(_para1:wint_t):longint;cdecl;external libc_nlm name 'iswascii';
+
+
+// windows.h
+
+
+ const
+ DLL_ACTUAL_DLLMAIN = 0;
+ DLL_NLM_STARTUP = 1; { start-up, 'lpvReserved' is NLM handle }
+ DLL_NLM_SHUTDOWN = 2; { unload, 'lpvReserved' is NLM handle }
+ { standard DllMain() messages... }
+ DLL_PROCESS_ATTACH = 3; { DLL "loaded" into application space }
+ DLL_THREAD_ATTACH = 4; { application creating new thread }
+ DLL_THREAD_DETACH = 5; { application thread exiting cleanly }
+ DLL_PROCESS_DETACH = 6; { DLL "unloaded" from application space }
+ TLS_MINIMUM_AVAILABLE = 64; { minumum number of keys available }
+
+
+type
+
+ PLPVOID = ^LPVOID;
+ LPVOID = void;
+
+ PBOOL = ^BOOL;
+ BOOL = longint;
+
+ PHMODULE = ^HMODULE;
+ HMODULE = void;
+
+ PLPCTSTR = ^LPCTSTR;
+ LPCTSTR = char;
+
+ PHINSTANCE = ^HINSTANCE;
+ HINSTANCE = void;
+{ Win32 DLL solutions for dynamic NLM libraries on NetWare... }
+
+function GetLastError:dword;cdecl;external libc_nlm name 'GetLastError';
+procedure SetLastError(dwErrCode:dword);cdecl;external libc_nlm name 'SetLastError';
+function FreeLibrary(hModule:HMODULE):BOOL;cdecl;external libc_nlm name 'FreeLibrary';
+function LoadLibrary(lpFileName:LPCTSTR):HMODULE;cdecl;external libc_nlm name 'LoadLibrary';
+{
+** Prototype for libraries writing their own start-up and shut-down code.
+** This is not an interface, but only a prototype for code furnished by the
+** NLM library.
+ }
+function DllMain(hinstDLL:HINSTANCE; fdwReason:dword; lpvReserve:LPVOID):BOOL;cdecl;external libc_nlm name 'DllMain';
+
+
+// xmalloc.h
+
+function xcalloc(_para1,_para2:size_t):pointer;cdecl;external libc_nlm name 'xcalloc';
+procedure xfree(_para1:pointer);cdecl;external libc_nlm name 'xfree';
+function xmalloc(_para1:size_t):pointer;cdecl;external libc_nlm name 'xmalloc';
+function xrealloc(_para1:pointer; _para2:size_t):pointer;cdecl;external libc_nlm name 'xrealloc';
+
+
+{$ifndef INCLUDED_FROM_SYSTEM}
+
+implementation
+
+function bisecond(var a : Tdos_tm) : word;
+begin
+ bisecond:=(a.flag0 and bm_dos_tm_bisecond) shr bp_dos_tm_bisecond;
+end;
+
+procedure set_bisecond(var a : Tdos_tm; __bisecond : word);
+begin
+ a.flag0:=a.flag0 or ((__bisecond shl bp_dos_tm_bisecond) and bm_dos_tm_bisecond);
+end;
+
+function minute(var a : Tdos_tm) : word;
+begin
+ minute:=(a.flag0 and bm_dos_tm_minute) shr bp_dos_tm_minute;
+end;
+
+procedure set_minute(var a : Tdos_tm; __minute : word);
+begin
+ a.flag0:=a.flag0 or ((__minute shl bp_dos_tm_minute) and bm_dos_tm_minute);
+end;
+
+function hour(var a : Tdos_tm) : word;
+begin
+ hour:=(a.flag0 and bm_dos_tm_hour) shr bp_dos_tm_hour;
+end;
+
+procedure set_hour(var a : Tdos_tm; __hour : word);
+begin
+ a.flag0:=a.flag0 or ((__hour shl bp_dos_tm_hour) and bm_dos_tm_hour);
+end;
+
+function day(var a : Tdos_tm) : word;
+begin
+ day:=(a.flag0 and bm_dos_tm_day) shr bp_dos_tm_day;
+end;
+
+procedure set_day(var a : Tdos_tm; __day : word);
+begin
+ a.flag0:=a.flag0 or ((__day shl bp_dos_tm_day) and bm_dos_tm_day);
+end;
+
+function month(var a : Tdos_tm) : word;
+begin
+ month:=(a.flag0 and bm_dos_tm_month) shr bp_dos_tm_month;
+end;
+
+procedure set_month(var a : Tdos_tm; __month : word);
+begin
+ a.flag0:=a.flag0 or ((__month shl bp_dos_tm_month) and bm_dos_tm_month);
+end;
+
+function year(var a : Tdos_tm) : word;
+begin
+ year:=(a.flag0 and bm_dos_tm_year) shr bp_dos_tm_year;
+end;
+
+procedure set_year(var a : Tdos_tm; __year : word);
+begin
+ a.flag0:=a.flag0 or ((__year shl bp_dos_tm_year) and bm_dos_tm_year);
+end;
+
+
+end.
+{$endif}
+
+{
+ $Log: libc.pp,v $
+ Revision 1.11 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.10 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.9 2005/01/04 11:25:33 armin
+ * rtl code cleanup, compat fixes between clib and libc
+
+}
diff --git a/rtl/netwlibc/libcclib.imp b/rtl/netwlibc/libcclib.imp
new file mode 100644
index 0000000000..2b5bce7a1e
--- /dev/null
+++ b/rtl/netwlibc/libcclib.imp
@@ -0,0 +1,2 @@
+ CLibLoadBroker,
+ CLibUnloadBroker
diff --git a/rtl/netwlibc/mouse.pp b/rtl/netwlibc/mouse.pp
new file mode 100644
index 0000000000..8d7a66367d
--- /dev/null
+++ b/rtl/netwlibc/mouse.pp
@@ -0,0 +1,122 @@
+{
+ $Id: mouse.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 Armin Diehl, member of the
+ Free Pascal development team
+
+ Dummy Mouse unit for netware
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{2001/04/14 armin: first version, only a dummy, i think there is no 'official' way to support
+ a mouse under netware }
+unit Mouse;
+interface
+
+{$ifdef NOMOUSE}
+{$DEFINE NOGPM}
+{$ENDIF}
+
+{const
+ MouseEventBufSize = 16; }
+
+{$i mouseh.inc}
+
+implementation
+
+
+procedure PlaceMouseCur(ofs:longint);
+begin
+end;
+
+
+procedure InitMouse;
+begin
+end;
+
+
+procedure DoneMouse;
+begin
+end;
+
+
+function DetectMouse:byte;
+begin
+ DetectMouse:=0;
+end;
+
+
+procedure ShowMouse;
+begin
+end;
+
+
+procedure HideMouse;
+begin
+end;
+
+
+function GetMouseX:word;
+begin
+ GetMouseX:=0;
+end;
+
+
+function GetMouseY:word;
+begin
+ GetMouseY:=0;
+end;
+
+
+function GetMouseButtons:word;
+begin
+ GetMouseButtons:=0;
+end;
+
+
+procedure SetMouseXY(x,y:word);
+begin
+end;
+
+
+procedure GetMouseEvent(var MouseEvent: TMouseEvent);
+begin
+ fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+end;
+
+
+procedure PutMouseEvent(const MouseEvent: TMouseEvent);
+begin
+end;
+
+
+function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+begin
+ fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+ exit(false);
+end;
+
+Procedure SetMouseDriver(Const Driver : TMouseDriver);
+{ Sets the mouse driver. }
+begin
+end;
+
+Procedure GetMouseDriver(Var Driver : TMouseDriver);
+{ Returns the currently active mouse driver }
+begin
+ FillChar (Driver, sizeof(Driver),0);
+end;
+
+end.
+{
+ $Log: mouse.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/netware.imp b/rtl/netwlibc/netware.imp
new file mode 100644
index 0000000000..c88a4efef6
--- /dev/null
+++ b/rtl/netwlibc/netware.imp
@@ -0,0 +1,123 @@
+ Abend,
+ ActivateScreen,
+ AddSearchPathAtEnd,
+ AddSoftBreakpoint,
+ AddressOfSoftBreakpoint,
+ Alloc,
+ AllocSleepOK,
+ AllocateResourceTag,
+ CSetABreakpoint,
+ CanEventBlock,
+ CheckForRegisteredEvent,
+ CheckIfScreenActive,
+ CheckKeyStatus,
+ ClearScreen,
+ CloseScreen,
+ DSAllocateEventTag,
+ DeRegisterCommand,
+ DeleteSearchPath,
+ DisableInputCursor,
+ DisplayScreenLine,
+ DisplayScreenText,
+ DisplayScreenTextWithAttribute,
+ EnableInputCursor,
+ EnterDebugger,
+ ESMAlloc,
+ ESMAllocWindow,
+ ESMCopy,
+ ESMFill,
+ ESMFree,
+ ESMFreeWindow,
+ ESMMapMemory,
+ ESMQuery,
+ EventCheck,
+ EventReport,
+ FillScreenArea,
+ FillScreenAreaAttribute,
+ Free,
+ GetActiveScreen,
+ GetActualScreenSize,
+ GetCursorStyle,
+ GetDebuggerActiveCount,
+ GetHighResolutionTimer,
+ GetInputCursorPosition,
+ GetKey,
+ GetOutputCursorPosition,
+ GetScreenAddress,
+ GetScreenName,
+ GetScreenSize,
+ GetSearchPathElement,
+ GetSetableParameterValue,
+ GetSuperHighResolutionTimer,
+ InsertSearchPath,
+ IsScreenModeSupported,
+ KernelSpinLock,
+ KernelSpinLockInit,
+ KernelSpinTryLock,
+ KernelSpinTryLockDisable,
+ KernelSpinUnlock,
+ KernelSpinUnlockRestore,
+ KillMe,
+ LoadLanguageMessageTable,
+ LoadModule,
+ NetWareAlert,
+ NVMKernelLock,
+ NVMKernelUnlock,
+ NWGarbageCollect,
+ NWGetAvailableMemory,
+ NWGetPageSize,
+ NWMemorySizeAddressable,
+ OpenScreen,
+ OutputToScreen,
+ OutputToScreenWithAttribute,
+ OutputToScreenWithPointer,
+ ParseCommand,
+ Pause,
+ PauseWithEscape,
+ PositionInputCursor,
+ PositionOutputCursor,
+ ReadScreenCharacter,
+ RegisterCommand,
+ RegisterConsoleCommand,
+ RegisterDebugCommandParser,
+ RegisterForEventNotification,
+ RegisterTrackedResource,
+ RemoveSoftBreakpoint,
+ RestartServer,
+ RestoreFullScreen,
+ RestoreScreenArea,
+ ReturnMessageInformation,
+ ReturnScreenType,
+ RingTheBell,
+ RxIdentifyCode,
+ RxRegisterKernelResource,
+ RxRegisterSyscall,
+ RxRegisterThreadResource,
+ RxUnidentifyCode,
+ RxUnregisterKernelResource,
+ RxUnregisterSyscall,
+ RxUnregisterThreadResource,
+ SaveFullScreen,
+ SaveScreenArea,
+ ScanSetableParameters,
+ ScrollScreenArea,
+ SetAutoUnloadFlag,
+ SetCursorStyle,
+ SetInputToOutputCursorPosition,
+ SetSetableParameterValue,
+ ShowTitleBarText,
+ ShutdownServer,
+ SizeOfAllocBlock,
+ StopServer,
+ SynchronizeStart,
+ UnRegisterConsoleCommand,
+ UnRegisterDebugCommandParser,
+ UnRegisterEventNotification,
+ UnRegisterTrackedResource,
+ UngetKey,
+ UnloadModule,
+ ValidateScreenHandle,
+ WaitForKey,
+ WriteScreenCharacter,
+ WriteScreenCharacterAttribute,
+ preferredModule
diff --git a/rtl/netwlibc/nwl_dlle.as b/rtl/netwlibc/nwl_dlle.as
new file mode 100644
index 0000000000..4619fb1f06
--- /dev/null
+++ b/rtl/netwlibc/nwl_dlle.as
@@ -0,0 +1,6 @@
+//for a non-library we should not have DllMain
+//link this only for libraries
+ .text
+ .globl DllMain
+DllMain:
+ jmp _FPC_DLL_Entry
diff --git a/rtl/netwlibc/nwl_main.as b/rtl/netwlibc/nwl_main.as
new file mode 100644
index 0000000000..ec17c9bdf5
--- /dev/null
+++ b/rtl/netwlibc/nwl_main.as
@@ -0,0 +1,6 @@
+//for a library we should not have main
+//link this only for non libraries
+ .text
+ .globl main
+main:
+ jmp _FPC_NLM_Entry
diff --git a/rtl/netwlibc/nwsnut.imp b/rtl/netwlibc/nwsnut.imp
new file mode 100644
index 0000000000..4457ccd1a1
--- /dev/null
+++ b/rtl/netwlibc/nwsnut.imp
@@ -0,0 +1,147 @@
+ NWSAlert,
+ NWSAlertWithHelp,
+ NWSAlloc,
+ NWSAppendBoolField,
+ NWSAppendCommentField,
+ NWSAppendGenericBoolField,
+ NWSAppendScrollableStringField,
+ NWSAppendHexField,
+ NWSAppendHotSpotField,
+ NWSAppendIntegerField,
+ NWSAppendMenuField,
+ NWSAppendPasswordField,
+ NWSAppendPromptField,
+ NWSAppendStringField,
+ NWSAppendToForm,
+ NWSAppendToList,
+ NWSAppendToMenu,
+ NWSAppendToMenuField,
+ NWSAppendUnsignedIntegerField,
+ NWSAsciiHexToInt,
+ NWSAsciiToInt,
+ NWSAsciiToLONG,
+ NWSClearPortal,
+ NWSComputePortalPosition,
+ NWSConfirm,
+ NWSCreatePortal,
+ NWSDeleteFromList,
+ NWSDeleteFromPortalList,
+ NWSDeselectPortal,
+ NWSDestroyForm,
+ NWSDestroyList,
+ NWSDestroyMenu,
+ NWSDestroyPortal,
+ NWSDisableAllFunctionKeys,
+ NWSDisableAllInterruptKeys,
+ NWSDisableFunctionKey,
+ NWSDisableInterruptKey,
+ NWSDisablePortalCursor,
+ NWSDisplayErrorCondition,
+ NWSDisplayErrorText,
+ NWSDisplayHelpScreen,
+ NWSDisplayInformation,
+ NWSDisplayInformationInPortal,
+ NWSDisplayPreHelp,
+ NWSDisplayTextInPortal,
+ NWSDisplayTextJustifiedInPortal,
+ NWSDrawPortalBorder,
+ NWSEditForm,
+ NWSEditPortalForm,
+ NWSEditPortalFormField,
+ NWSEditString,
+ NWSEditText,
+ NWSEditTextWithScrollBars,
+ NWSEnableAllFunctionKeys,
+ NWSEnableFunctionKey,
+ NWSEnableFunctionKeyList,
+ NWSEnableInterruptKey,
+ NWSEnableInterruptList,
+ NWSEnablePortalCursor,
+ NWSEndWait,
+ NWSFillPortalZone,
+ NWSFillPortalZoneAttribute,
+ NWSFree,
+ NWSGetADisk,
+ NWSGetCurrentPortal,
+ NWSGetDefaultCompare,
+ NWSGetFieldFunctionPtr,
+ NWSGetHandleCustomData,
+ NWSGetKey,
+ NWSGetLineDrawCharacter,
+ NWSGetList,
+ NWSGetListElementText,
+ NWSGetListHead,
+ NWSGetListNotifyProcedure,
+ NWSGetListSortFunction,
+ NWSGetListTail,
+ NWSGetMessage,
+ NWSGetNUTVersion,
+ NWSGetPCB,
+ NWSGetScreenPalette,
+ NWSGetSortCharacter,
+ NWSInitForm,
+ NWSInitializeNut,
+ NWSInitList,
+ NWSInitListPtr,
+ NWSInitMenu,
+ NWSInitMenuField,
+ NWSInsertInList,
+ NWSInsertInPortalList,
+ NWSIsdigit,
+ NWSIsxdigit,
+ NWSKeyStatus,
+ NWSList,
+ NWSMemmove,
+ NWSMenu,
+ NWSModifyInPortalList,
+ NWSPopHelpContext,
+ NWSPopList,
+ NWSPopMarks,
+ NWSPositionCursor,
+ NWSPositionPortalCursor,
+ NWSPromptForPassword,
+ NWSPushHelpContext,
+ NWSPushList,
+ NWSPushMarks,
+ NWSRemovePreHelp,
+ NWSRestoreDisplay,
+ NWSRestoreList,
+ NWSRestoreNut,
+ NWSRestoreZone,
+ NWSSaveFunctionKeyList,
+ NWSSaveInterruptList,
+ NWSSaveList,
+ NWSSaveZone,
+ NWSScreenSize,
+ NWSScrollPortalZone,
+ NWSScrollZone,
+ NWSSelectPortal,
+ NWSSetDefaultCompare,
+ NWSSetDynamicMessage,
+ NWSSetErrorLabelDisplayFlag,
+ NWSSetFieldFunctionPtr,
+ NWSSetFormNoWrap,
+ NWSSetHandleCustomData,
+ NWSSetHelpHelp,
+ NWSSetList,
+ NWSSetListNotifyProcedure,
+ NWSSetListSortFunction,
+ NWSSetScreenPalette,
+ NWSSetScrollableFieldInsertProc,
+ NWSShowLine,
+ NWSShowLineAttribute,
+ NWSShowPortalLine,
+ NWSShowPortalLineAttribute,
+ NWSSortList,
+ NWSStartWait,
+ NWSStrcat,
+ NWSToupper,
+ NWSTrace,
+ NWSUngetKey,
+ NWSUnmarkList,
+ NWSUpdatePortal,
+ NWSViewText,
+ NWSViewTextWithScrollBars,
+ NWSWaitForEscape,
+ NWSWaitForEscapeOrCancel,
+ NWSWaitForKeyAndValue
diff --git a/rtl/netwlibc/nwsnut.pp b/rtl/netwlibc/nwsnut.pp
new file mode 100644
index 0000000000..eda1b93c8b
--- /dev/null
+++ b/rtl/netwlibc/nwsnut.pp
@@ -0,0 +1,9 @@
+{$I ../netware/nwsnut.pp}
+
+
+{
+ $Log: nwsnut.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/qos.inc b/rtl/netwlibc/qos.inc
new file mode 100644
index 0000000000..e160343d2c
--- /dev/null
+++ b/rtl/netwlibc/qos.inc
@@ -0,0 +1 @@
+{$i ../netware/qos.inc}
diff --git a/rtl/netwlibc/sockets.pp b/rtl/netwlibc/sockets.pp
new file mode 100644
index 0000000000..5d6a9c56b9
--- /dev/null
+++ b/rtl/netwlibc/sockets.pp
@@ -0,0 +1,399 @@
+{
+ $Id: sockets.pp,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+unit Sockets;
+
+Interface
+
+{$macro on}
+{$define maybelibc:=}
+
+{$R-}
+
+Uses
+ winsock;
+
+Type
+ cushort=word;
+ cuint16=word;
+ cuint32=cardinal;
+ size_t =cuint32;
+ ssize_t=cuint16;
+ cint =longint;
+ pcint =^cint;
+ tsocklen=cint;
+ psocklen=^tsocklen;
+
+
+ Const
+ AF_MAX = WinSock.AF_MAX;
+ PF_MAX = AF_MAX;
+
+{$i socketsh.inc}
+
+Implementation
+
+{ Include filerec and textrec structures }
+{$i filerec.inc}
+{$i textrec.inc}
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+
+
+//function fprecvmsg (s:cint; msg: pmsghdr; flags:cint):ssize_t;
+//function fpsendmsg (s:cint; hdr: pmsghdr; flags:cint):ssize;
+
+//function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+ fpSocket:=WinSock.Socket(Domain,xtype,ProtoCol);
+ if fpSocket<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpSend:=WinSock.Send(S,msg,len,flags);
+ if fpSend<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ // Dubious construct, this should be checked. (IPV6 fails ?)
+ fpSendTo:=WinSock.SendTo(S,msg,Len,Flags,Winsock.TSockAddr(tox^),toLen);
+ if fpSendTo<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t;
+begin
+ fpRecv:=WinSock.Recv(S,Buf,Len,Flags);
+ if fpRecv<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+
+begin
+fpRecvFrom:=WinSock.RecvFrom(S,Buf,Len,Flags,Winsock.TSockAddr(from^),FromLen^);
+ if fpRecvFrom<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+
+begin
+ fpConnect:=WinSock.Connect(S,WinSock.TSockAddr(name^),nameLen);
+ if fpConnect<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpShutDown:=WinSock.ShutDown(S,How);
+ if fpShutDown<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ socket:=fpsocket(Domain,sockettype,protocol);
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+
+begin
+ send:=fpsend(sock,@buf,buflen,flags);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+
+begin
+ sendto:=fpsendto(sock,@buf,buflen,flags,@addr,addrlen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=fpRecv(Sock,@Buf,BufLen,Flags);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; var AddrLen : longint) : longint;
+begin
+ RecvFrom:=fpRecvFrom(Sock,@Buf,BufLen,Flags,@Addr,@AddrLen);
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+
+begin
+ fpbind:=WinSock.Bind(S,WinSock.PSockAddr(Addrx),AddrLen);
+ if fpbind<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+
+begin
+ fplisten:=WinSock.Listen(S,backlog);
+ if fplisten<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+ fpAccept:=WinSock.Accept(S,WinSock.PSockAddr(Addrx),plongint(AddrLen));
+ if fpAccept<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+
+begin
+ fpGetSockName:=WinSock.GetSockName(S,WinSock.TSockAddr(name^),nameLen^);
+ if fpGetSockName<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetPeerName:=WinSock.GetPeerName(S,WinSock.TSockAddr(name^),NameLen^);
+ if fpGetPeerName<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpGetSockOpt:=WinSock.GetSockOpt(S,Level,OptName,OptVal,OptLen^);
+ if fpGetSockOpt<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
+
+begin
+ fpSetSockOpt:=WinSock.SetSockOpt(S,Level,OptName,OptVal,OptLen);
+ if fpSetSockOpt<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+ fpSocketPair := -1;
+end;
+
+Function CloseSocket(Sock:Longint):Longint;
+var i : longint;
+begin
+ i := Winsock.CloseSocket (Sock);
+ if i <> 0 then
+ begin
+ SocketError:=WSAGetLastError;
+ CloseSocket := i;
+ end else
+ begin
+ CloseSocket := 0;
+ SocketError := 0;
+ end;
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+
+begin
+ bind:=fpBind(Sock,@Addr,AddrLen)=0;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+
+begin
+ Listen:=fplisten(Sock,MaxConnect)=0;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+
+begin
+ Accept:=FPAccept(sock,@addr,@addrlen);
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+
+begin
+ shutdown:=fpshutdown(sock,how);
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):Boolean;
+
+begin
+ connect:=fpconnect(sock,@addr,addrlen)=0;
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=fpGetSockName(sock,@addr,@addrlen);
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=fpGetPeerName(Sock,@addr,@addrlen);
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=fpGetSockOpt(sock,level,optname,@optval,@optlen);
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+
+begin
+ SetSocketOptions:=fpsetsockopt(sock,level,optname,@optval,optlen);
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ // SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+ SocketPair := -1;
+end;
+
+
+{$ifdef unix}
+{ mimic the linux fpWrite/fpRead calls for the file/text socket wrapper }
+function fpWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fpWrite := dword(WinSock.send(handle, bufptr, size, 0));
+ if fpWrite = dword(SOCKET_ERROR) then
+ begin
+ SocketError := WSAGetLastError;
+ fpWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fpRead(handle : longint;var bufptr;size : dword) : dword;
+ var
+ d : dword;
+
+ begin
+ if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+ begin
+ SocketError:=WSAGetLastError;
+ fpRead:=0;
+ exit;
+ end;
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fpRead := dword(WinSock.recv(handle, bufptr, size, 0));
+ if fpRead = dword(SOCKET_ERROR) then
+ begin
+ SocketError:= WSAGetLastError;
+ fpRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+ end;
+{$else}
+{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
+function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fdWrite := dword(WinSock.send(handle, bufptr, size, 0));
+ if fdWrite = dword(SOCKET_ERROR) then
+ begin
+ SocketError := WSAGetLastError;
+ fdWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fdRead(handle : longint;var bufptr;size : dword) : dword;
+ var
+ d : dword;
+
+ begin
+ if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+ begin
+ SocketError:=WSAGetLastError;
+ fdRead:=0;
+ exit;
+ end;
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fdRead := dword(WinSock.recv(handle, bufptr, size, 0));
+ if fdRead = dword(SOCKET_ERROR) then
+ begin
+ SocketError:= WSAGetLastError;
+ fdRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+ end;
+{$endif}
+
+{$i sockets.inc}
+
+{ winsocket stack needs an init. and cleanup code }
+var
+ wsadata : twsadata;
+
+initialization
+ WSAStartUp($2,wsadata);
+finalization
+ WSACleanUp;
+end.
+{
+ $Log: sockets.pp,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/sysdir.inc b/rtl/netwlibc/sysdir.inc
new file mode 100644
index 0000000000..a3face7508
--- /dev/null
+++ b/rtl/netwlibc/sysdir.inc
@@ -0,0 +1,101 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+var S2 : STRING;
+ Res: LONGINT;
+BEGIN
+ S2 := S;
+ IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+ S2 := S2 + #0;
+ Res := FpMkdir (@S2[1],S_IRWXU);
+ if Res = 0 then
+ InOutRes:=0
+ else
+ SetFileError (Res);
+end;
+
+procedure rmdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+ Res: LONGINT;
+BEGIN
+ S2 := S;
+ IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+ S2 := S2 + #0;
+ Res := FpRmdir (@S2[1]);
+ IF Res = 0 THEN
+ InOutRes:=0
+ ELSE
+ SetFileError (Res);
+end;
+
+procedure chdir(const s : string);[IOCheck];
+VAR S2 : STRING;
+ Res: LONGINT;
+begin
+ S2 := S;
+ IF Length (S2) = 255 THEN DEC (BYTE(S2[0]));
+ S2 := S2 + #0;
+ Res := FpChdir (@S2[1]);
+ IF Res = 0 THEN
+ InOutRes:=0
+ ELSE
+ SetFileError (Res);
+end;
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var P : array [0..255] of CHAR;
+ i : LONGINT;
+begin
+ P[0] := #0;
+ getcwdpath(@P,nil,0); // getcwd does not return volume, getcwdpath does
+ i := libc_strlen (P);
+ if i > 0 then
+ begin
+ Move (P, dir[1], i);
+ BYTE(dir[0]) := i;
+ For i := 1 to length (dir) do
+ if dir[i] = '\' then dir [i] := '/';
+ // fix / after volume, the compiler needs that
+ // normaly root of a volumes is SERVERNAME/SYS:, change that
+ // to SERVERNAME/SYS:/
+ i := pos (':',dir);
+ if (i > 0) then
+ if i = Length (dir) then dir := dir + '/' else
+ if dir [i+1] <> '/' then insert ('/',dir,i+1);
+ end else
+ InOutRes := 1;
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/netwlibc/sysfile.inc b/rtl/netwlibc/sysfile.inc
new file mode 100644
index 0000000000..c3461f891d
--- /dev/null
+++ b/rtl/netwlibc/sysfile.inc
@@ -0,0 +1,417 @@
+{
+ $Id: sysfile.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ Low level File Routines
+ All these functions can set InOutRes on errors
+ ****************************************************************************}
+
+
+PROCEDURE NW2PASErr (Err : LONGINT);
+BEGIN
+ if Err = 0 then { Else it will go through all the cases }
+ exit;
+ case Err of
+ Sys_ENFILE,
+ Sys_EMFILE : Inoutres:=4;
+ Sys_ENOENT : Inoutres:=2;
+ Sys_EBADF : Inoutres:=6;
+ Sys_ENOMEM,
+ Sys_EFAULT : Inoutres:=217;
+ Sys_EINVAL : Inoutres:=218;
+ Sys_EPIPE,
+ Sys_EINTR,
+ Sys_EIO,
+ Sys_EAGAIN,
+ Sys_ENOSPC : Inoutres:=101;
+ Sys_ENAMETOOLONG,
+ Sys_ELOOP,
+ Sys_ENOTDIR : Inoutres:=3;
+ Sys_EROFS,
+ Sys_EEXIST,
+ Sys_EACCES : Inoutres:=5;
+ Sys_EBUSY : Inoutres:=162
+ else begin
+ Writeln (stderr,'NW2PASErr: unknown error ',err);
+ libc_perror('NW2PASErr');
+ Inoutres := Err;
+ end;
+ end;
+END;
+
+
+procedure Errno2Inoutres;
+begin
+ NW2PASErr (___errno^);
+end;
+
+procedure SetFileError (VAR Err : LONGINT);
+begin
+ if Err >= 0 then
+ InOutRes := 0
+ else begin
+ // libc_perror ('SetFileError');
+ Err := ___errno^;
+ NW2PASErr (Err);
+ Err := 0;
+ end;
+end;
+
+{ close a file from the handle value }
+procedure do_close(handle : thandle);
+VAR res : LONGINT;
+begin
+ {$ifdef IOpossix}
+ res := FpClose (handle);
+ {$else}
+ res := _fclose (_TFILE(handle));
+ {$endif}
+ IF res <> 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+end;
+
+procedure do_erase(p : pchar);
+VAR res : LONGINT;
+begin
+ res := unlink (p);
+ IF Res < 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+VAR res : LONGINT;
+begin
+ res := rename (p1,p2);
+ IF Res < 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0
+end;
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+var res : LONGINT;
+begin
+ {$ifdef IOpossix}
+ res := Fpwrite (h,addr,len);
+ {$else}
+ res := _fwrite (addr,1,len,_TFILE(h));
+ {$endif}
+ if res > 0 then
+ InOutRes := 0
+ else
+ SetFileError (res);
+ do_write := res;
+ NXThreadYield;
+end;
+
+function do_read(h:thandle;addr:pointer;len : longint) : longint;
+VAR res : LONGINT;
+begin
+ {$ifdef IOpossix}
+ res := Fpread (h,addr,len);
+ {$else}
+ res := _fread (addr,1,len,_TFILE(h));
+ {$endif}
+ IF res > 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+ do_read := res;
+ NXThreadYield;
+end;
+
+
+function do_filepos(handle : thandle) : longint;
+var res : LONGINT;
+begin
+ InOutRes:=1;
+ {$ifdef IOpossix}
+ res := Fptell (handle);
+ {$else}
+ res := _ftell (_TFILE(handle));
+ {$endif}
+ if res < 0 THEN
+ SetFileError (res)
+ else
+ InOutRes := 0;
+ do_filepos := res;
+end;
+
+
+procedure do_seek(handle:thandle;pos : longint);
+VAR res : LONGINT;
+begin
+ {$ifdef IOpossix}
+ res := Fplseek (handle,pos, SEEK_SET);
+ {$else}
+ res := _fseek (_TFILE(handle),pos, SEEK_SET);
+ {$endif}
+ IF res >= 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+end;
+
+function do_seekend(handle:thandle):longint;
+VAR res : LONGINT;
+begin
+ {$ifdef IOpossix}
+ res := Fplseek (handle,0, SEEK_END);
+ {$else}
+ res := _fseek (_TFILE(handle),0, SEEK_END);
+ {$endif}
+ IF res >= 0 THEN
+ InOutRes := 0
+ ELSE
+ SetFileError (res);
+ do_seekend := res;
+end;
+
+
+function do_filesize(handle : thandle) : longint;
+VAR res : LONGINT;
+ statbuf : TStat;
+begin
+ {$ifdef IOpossix}
+ res := Fpfstat (handle, statbuf);
+ {$else}
+ res := _fstat (_fileno (_TFILE(handle)), statbuf); // was _filelength for clib
+ {$endif}
+ if res <> 0 then
+ begin
+ SetFileError (Res);
+ do_filesize := -1;
+ end else
+ begin
+ InOutRes := 0;
+ do_filesize := statbuf.st_size;
+ end;
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;pos:longint);
+VAR res : LONGINT;
+begin
+ {$ifdef IOpossix}
+ res := ftruncate (handle,pos);
+ {$else}
+ res := _ftruncate (_fileno (_TFILE(handle)),pos);
+ {$endif}
+ IF res <> 0 THEN
+ SetFileError (res)
+ ELSE
+ InOutRes := 0;
+end;
+
+{$ifdef IOpossix}
+// mostly stolen from syslinux
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $10) the file will be append
+ when (flags and $100) the file will be truncate/rewritten
+ when (flags and $1000) there is no check for close (needed for textfiles)
+}
+var
+ oflags : longint;
+Begin
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case FileRec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file Handle }
+ FileRec(f).Handle:=UnusedHandle;
+
+{ We do the conversion of filemodes here, concentrated on 1 place }
+ case (flags and 3) of
+ 0 : begin
+ oflags := O_RDONLY;
+ filerec(f).mode := fminput;
+ end;
+ 1 : begin
+ oflags := O_WRONLY;
+ filerec(f).mode := fmoutput;
+ end;
+ 2 : begin
+ oflags := O_RDWR;
+ filerec(f).mode := fminout;
+ end;
+ end;
+ if (flags and $1000)=$1000 then
+ oflags:=oflags or (O_CREAT or O_TRUNC)
+ else
+ if (flags and $100)=$100 then
+ oflags:=oflags or (O_APPEND);
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+{ real open call }
+ ___errno^ := 0;
+ FileRec(f).Handle := open(p,oflags,438);
+ { open somtimes returns > -1 but errno was set }
+ if (___errno^ <> 0) or (longint(FileRec(f).Handle) < 0) then
+ if (___errno^=Sys_EROFS) and ((OFlags and O_RDWR)<>0) then
+ begin // i.e. for cd-rom
+ Oflags:=Oflags and not(O_RDWR);
+ FileRec(f).Handle := open(p,oflags,438);
+ end;
+ if (___errno^ <> 0) or (longint(FileRec(f).Handle) < 0) then
+ Errno2Inoutres
+ else
+ InOutRes := 0;
+end;
+
+
+{$else}
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $10) the file will be append
+ when (flags and $100) the file will be truncate/rewritten
+ when (flags and $1000) there is no check for close (needed for textfiles)
+}
+var
+ oflags : string[10];
+Begin
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case FileRec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file Handle }
+ FileRec(f).Handle:=UnusedHandle;
+
+{ We do the conversion of filemodes here, concentrated on 1 place }
+ case (flags and 3) of
+ 0 : begin
+ oflags := 'rb'#0;
+ filerec(f).mode := fminput;
+ end;
+ 1 : begin
+ if (flags and $1000)=$1000 then
+ oflags := 'w+b' else
+ oflags := 'wb';
+ filerec(f).mode := fmoutput;
+ end;
+ 2 : begin
+ if (flags and $1000)=$1000 then
+ oflags := 'w+' else
+ oflags := 'r+';
+ filerec(f).mode := fminout;
+ end;
+ end;
+ {if (flags and $1000)=$1000 then
+ oflags:=oflags or (O_CREAT or O_TRUNC)
+ else
+ if (flags and $100)=$100 then
+ oflags:=oflags or (O_APPEND);}
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+{ real open call }
+ FileRec(f).Handle := THandle (_fopen (p,@oflags[1]));//_open(p,oflags,438);
+ //WriteLn ('_open (',p,') returned ',ErrNo, 'Handle: ',FileRec(f).Handle);
+ // errno does not seem to be set on succsess ??
+ {IF FileRec(f).Handle < 0 THEN
+ if (ErrNo=Sys_EROFS) and ((OFlags and O_RDWR)<>0) then
+ begin // i.e. for cd-rom
+ Oflags:=Oflags and not(O_RDWR);
+ FileRec(f).Handle := _open(p,oflags,438);
+ end;}
+ if FileRec(f).Handle = 0 then
+ Errno2Inoutres
+ else
+ InOutRes := 0;
+End;
+{$endif}
+
+function do_isdevice(handle:THandle):boolean;
+begin
+ {$ifdef IOpossix}
+ do_isdevice := (Fpisatty (handle) > 0);
+ {$else}
+ do_isdevice := (isatty (_fileno(_TFILE(handle))) > 0);
+ {$endif}
+end;
+
+
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netwlibc/sysheap.inc b/rtl/netwlibc/sysheap.inc
new file mode 100644
index 0000000000..229665070f
--- /dev/null
+++ b/rtl/netwlibc/sysheap.inc
@@ -0,0 +1,156 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Heap Management
+*****************************************************************************}
+
+{$ifdef autoHeapRelease}
+
+const HeapInitialMaxBlocks = 32;
+type THeapSbrkBlockList = array [1.. HeapInitialMaxBlocks] of pointer;
+var HeapSbrkBlockList : ^THeapSbrkBlockList = nil;
+ HeapSbrkLastUsed : dword = 0;
+ HeapSbrkAllocated : dword = 0;
+ HeapSbrkReleased : boolean = false;
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if fail }
+{ for netware all allocated blocks are saved to free them at }
+{ exit (to avoid message "Module did not release xx resources") }
+Function SysOSAlloc(size : longint):pointer;
+var P2 : POINTER;
+ i : longint;
+ Slept : longint;
+begin
+ if HeapSbrkReleased then
+ begin
+ _ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
+ exit(nil);
+ end;
+ SysOSAlloc := _Alloc (size,HeapAllocResourceTag);
+ if SysOSAlloc <> nil then begin
+ if HeapSbrkBlockList = nil then
+ begin
+ Pointer (HeapSbrkBlockList) := _Alloc (sizeof (HeapSbrkBlockList^),HeapListAllocResourceTag);
+ if HeapSbrkBlockList = nil then
+ begin
+ _free (SysOSAlloc);
+ SysOSAlloc := nil;
+ exit;
+ end;
+ fillchar (HeapSbrkBlockList^,sizeof(HeapSbrkBlockList^),0);
+ HeapSbrkAllocated := HeapInitialMaxBlocks;
+ end;
+ if (HeapSbrkLastUsed > 0) then
+ for i := 1 to HeapSbrkLastUsed do
+ if (HeapSbrkBlockList^[i] = nil) then
+ begin // reuse free slot
+ HeapSbrkBlockList^[i] := SysOSAlloc;
+ exit;
+ end;
+ if (HeapSbrkLastUsed = HeapSbrkAllocated) then
+ begin { grow }
+ slept := 0;
+ p2 := _ReallocSleepOK (HeapSbrkBlockList, (HeapSbrkAllocated + HeapInitialMaxBlocks) * sizeof(pointer),HeapListAllocResourceTag,Slept);
+ if p2 = nil then // should we better terminate with error ?
+ begin
+ _free (SysOSAlloc);
+ SysOSAlloc := nil;
+ exit;
+ end;
+ HeapSbrkBlockList := p2;
+ inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
+ end;
+ inc (HeapSbrkLastUsed);
+ HeapSbrkBlockList^[HeapSbrkLastUsed] := SysOSAlloc;
+ end;
+end;
+
+
+procedure FreeSbrkMem;
+var i : longint;
+begin
+ if HeapSbrkBlockList <> nil then
+ begin
+ for i := 1 to HeapSbrkLastUsed do
+ if (HeapSbrkBlockList^[i] <> nil) then
+ _free (HeapSbrkBlockList^[i]);
+ _free (HeapSbrkBlockList);
+ HeapSbrkAllocated := 0;
+ HeapSbrkLastUsed := 0;
+ HeapSbrkBlockList := nil;
+ end;
+ HeapSbrkReleased := true;
+ {ReturnResourceTag(HeapAllocResourceTag,1);
+ ReturnResourceTag(HeapListAllocResourceTag,1); not in netware.imp, seems to be not needed}
+end;
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+var i : longint;
+begin
+ if HeapSbrkReleased then
+ begin
+ _ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
+ end else
+ if (HeapSbrkLastUsed > 0) then
+ for i := 1 to HeapSbrkLastUsed do
+ if (HeapSbrkBlockList^[i] = p) then
+ begin
+ _free (p);
+ HeapSbrkBlockList^[i] := nil;
+ exit;
+ end;
+ HandleError (204); // invalid pointer operation
+end;
+
+{$else autoHeapRelease}
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+ _free (p);
+end;
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ SysOSAlloc := _Alloc(size,HeapAllocResourceTag);
+end;
+
+{$endif autoHeapRelease}
+
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netwlibc/sysos.inc b/rtl/netwlibc/sysos.inc
new file mode 100644
index 0000000000..87902eb4ae
--- /dev/null
+++ b/rtl/netwlibc/sysos.inc
@@ -0,0 +1,55 @@
+{
+ $Id: sysos.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ some declarations for Netware API calls }
+{ I nwlibc.inc}
+{$I errno.inc}
+{$define INCLUDED_FROM_SYSTEM}
+{$I libc.pp}
+
+var
+ {$ifdef autoHeapRelease}
+ HeapListAllocResourceTag,
+ {$endif}
+ HeapAllocResourceTag : rtag_t;
+ NLMHandle : pointer;
+ ReleaseThreadVars : TSysReleaseThreadVars = nil;
+ AllocateThreadVars: TSysReleaseThreadVars = nil;
+ SetThreadDataAreaPtr : TSysSetThreadDataAreaPtr = nil;
+ TerminatingThreadID : dword = 0;
+
+procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
+ rtv:TSysReleaseThreadVars;
+ stdata:TSysSetThreadDataAreaPtr);
+begin
+ AllocateThreadVars := atv;
+ ReleaseThreadVars := rtv;
+ SetThreadDataAreaPtr := stdata;
+end;
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netwlibc/sysosh.inc b/rtl/netwlibc/sysosh.inc
new file mode 100644
index 0000000000..feba3212ce
--- /dev/null
+++ b/rtl/netwlibc/sysosh.inc
@@ -0,0 +1,45 @@
+{
+ $Id: sysosh.inc,v 1.3 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ THandle = DWord;
+ TThreadID = THandle;
+
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = packed record
+ mutex : pointer;
+ reserved : array[0..52] of dword;
+ end;
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.3 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netwlibc/system.pp b/rtl/netwlibc/system.pp
new file mode 100644
index 0000000000..3c0f76953d
--- /dev/null
+++ b/rtl/netwlibc/system.pp
@@ -0,0 +1,578 @@
+{
+ $Id: system.pp,v 1.15 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ System.pp for Netware libc environment
+ **********************************************************************}
+{ no stack check in system }
+{$S-}
+unit system;
+
+interface
+
+{$define netware}
+{$define netware_libc}
+
+{$define StdErrToConsole}
+{$define autoHeapRelease}
+{$define IOpossix}
+{$define DisableArrayOfConst}
+
+{$ifdef SYSTEMDEBUG}
+ {$define SYSTEMEXCEPTIONDEBUG}
+{$endif SYSTEMDEBUG}
+
+{$ifdef cpui386}
+ {$define Set_i386_Exception_handler}
+{$endif cpui386}
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+
+{Platform specific information}
+const
+ LineEnding = #13#10;
+ LFNSupport : boolean = false;
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = $ffff;
+
+
+CONST
+ { Default filehandles }
+ UnusedHandle : THandle = -1;
+ StdInputHandle : THandle = 0;
+ StdOutputHandle : THandle = 0;
+ StdErrorHandle : THandle = 0;
+
+ FileNameCaseSensitive : boolean = false;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+type
+ TNWCheckFunction = procedure (var code : longint);
+ TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
+ TDLL_Entry_Hook = procedure (dllparam : longint);
+
+VAR
+ ArgC : INTEGER;
+ ArgV : ppchar;
+ NetwareCheckFunction: TNWCheckFunction;
+ NWLoggerScreen : pointer = nil;
+
+const
+ Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
+ Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
+ Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
+ Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
+ NetwareUnloadProc : pointer = nil; {like exitProc but for nlm unload only}
+ envp : ppchar = nil;
+
+
+
+type
+ //TSysCloseAllRemainingSemaphores = procedure;
+ TSysReleaseThreadVars = procedure;
+ TSysSetThreadDataAreaPtr = function (newPtr:pointer):pointer;
+
+procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
+ rtv:TSysReleaseThreadVars;
+ stdata:TSysSetThreadDataAreaPtr);
+
+
+procedure _ConsolePrintf (s :shortstring);
+procedure _ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
+procedure _ConsolePrintf (FormatStr : PCHAR; Param : pchar);
+procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
+procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
+procedure _ConsolePrintf (FormatStr : PCHAR);
+procedure __EnterDebugger;cdecl;external '!netware' name 'EnterDebugger';
+
+function NWGetCodeStart : pointer; // needed for Lineinfo
+function NWGetCodeLength : dword;
+function NWGetDataStart : pointer;
+function NWGetDataLength : dword;
+
+implementation
+{ Indicate that stack checking is taken care by OS}
+{$DEFINE NO_GENERIC_STACK_CHECK}
+
+{ include system independent routines }
+{$I system.inc}
+
+
+procedure PASCALMAIN;external name 'PASCALMAIN';
+procedure fpc_do_exit;external name 'FPC_DO_EXIT';
+
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+var SigTermHandlerActive : boolean;
+
+Procedure system_exit;
+begin
+ if TerminatingThreadID <> 0 then
+ if TerminatingThreadID <> ThreadId then
+ if TerminatingThreadID <> dword(pthread_self) then
+ begin
+ {$ifdef DEBUG_MT}
+ _ConsolePrintf ('Terminating Thread %x because halt was called while Thread %x terminates nlm'#13#10,dword(pthread_self),TerminatingThreadId);
+ {$endif}
+ pthread_exit (nil);
+ // only for the case ExitThread fails
+ while true do
+ NXThreadYield;
+ end;
+ if assigned (ReleaseThreadVars) then ReleaseThreadVars;
+
+ {$ifdef autoHeapRelease}
+ FreeSbrkMem; { free memory allocated by heapmanager }
+ {$endif}
+
+ if not SigTermHandlerActive then
+ begin
+ if Erroraddr <> nil then { otherwise we dont see runtime-errors }
+ SetScreenMode (0);
+
+ _exit (ExitCode);
+ end;
+end;
+
+{*****************************************************************************
+ Stack check code
+*****************************************************************************}
+
+const StackErr : boolean = false;
+
+procedure int_stackcheck(stack_size:Cardinal);[public,alias:'FPC_STACKCHECK'];
+{
+ called when trying to get local stack if the compiler directive $S
+ is set this function must preserve all registers
+
+ With a 5k byte safe area used to write to StdIo and some libc
+ functions without crossing the stack boundary
+}
+begin
+ if StackErr then exit; // avoid recursive calls
+ asm
+ pusha
+ end;
+ stackerr := (stackavail < stack_size + 5120); // we really need that much, at least on nw6.5
+ asm
+ popa
+ end;
+ if not StackErr then exit;
+ StackErr := true;
+ HandleError (202);
+end;
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l+1<=argc) then
+ begin
+ paramstr:=strpas(argv[l]);
+ if l = 0 then // fix nlm path
+ begin
+ for l := 1 to length (paramstr) do
+ if paramstr[l] = '\' then paramstr[l] := '/';
+ end;
+ end else
+ paramstr:='';
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+begin
+ randseed := time (NIL);
+end;
+
+
+{*****************************************************************************
+ Thread Handling
+*****************************************************************************}
+
+procedure InitFPU;assembler;
+
+ asm
+ fninit
+ fldcw fpucw
+ end;
+
+
+{ if return-value is <> 0, netware shows the message
+ Unload Anyway ?
+ To Disable unload at all, SetNLMDontUnloadFlag can be used on
+ Netware >= 4.0 }
+
+function CheckFunction : longint; CDECL; [public,alias: '_NonAppCheckUnload'];
+var oldPtr : pointer;
+begin
+ //_ConsolePrintf ('CheckFunction'#13#10);
+ if assigned (NetwareCheckFunction) then
+ begin
+ if assigned (SetThreadDataAreaPtr) then
+ oldPtr := SetThreadDataAreaPtr (NIL); { nil means main thread }
+
+ result := 0;
+ NetwareCheckFunction (result);
+
+ if assigned (SetThreadDataAreaPtr) then
+ SetThreadDataAreaPtr (oldPtr);
+
+ end else
+ result := 0;
+end;
+
+
+procedure _ConsolePrintf (s : shortstring);
+begin
+ if length(s) > 254 then
+ byte(s[0]) := 254;
+ s := s + #0;
+ _ConsolePrintf (@s[1]);
+end;
+
+procedure _ConsolePrintf (FormatStr : PCHAR);
+begin
+ if NWLoggerScreen = nil then
+ NWLoggerScreen := getnetwarelogger;
+ if NWLoggerScreen <> nil then
+ screenprintf (NWLoggerScreen,FormatStr);
+end;
+
+procedure _ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
+begin
+ if NWLoggerScreen = nil then
+ NWLoggerScreen := getnetwarelogger;
+ if NWLoggerScreen <> nil then
+ screenprintf (NWLoggerScreen,FormatStr,Param);
+end;
+
+procedure _ConsolePrintf (FormatStr : PCHAR; Param : pchar);
+begin
+ _ConsolePrintf (FormatStr,longint(Param));
+end;
+
+procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
+begin
+ if NWLoggerScreen = nil then
+ NWLoggerScreen := getnetwarelogger;
+ if NWLoggerScreen <> nil then
+ screenprintf (NWLoggerScreen,FormatStr,P1,P2);
+end;
+
+procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
+begin
+ if NWLoggerScreen = nil then
+ NWLoggerScreen := getnetwarelogger;
+ if NWLoggerScreen <> nil then
+ screenprintf (NWLoggerScreen,FormatStr,P1,P2,P3);
+end;
+
+var NWUts : Tutsname;
+
+procedure getCodeAddresses;
+begin
+ if Fpuname(NWUts) < 0 then
+ FillChar(NWuts,sizeof(NWUts),0);
+end;
+
+function NWGetCodeStart : pointer;
+begin
+ NWGetCodeStart := NWUts.codeoffset;
+ NXThreadYield;
+end;
+
+function NWGetCodeLength : dword;
+begin
+ NWGetCodeLength := NWUts.codelength;
+ NXThreadYield;
+end;
+
+function NWGetDataStart : pointer;
+begin
+ NWGetDataStart := NWUts.dataoffset;
+ NXThreadYield;
+end;
+
+function NWGetDataLength : dword;
+begin
+ NWGetDataLength := NWUts.datalength;
+ NXThreadYield;
+end;
+
+
+{$ifdef StdErrToConsole}
+var ConsoleBuff : array [0..512] of char;
+
+Function ConsoleWrite(Var F: TextRec): Integer;
+var
+ i : longint;
+Begin
+ if F.BufPos>0 then
+ begin
+ if F.BufPos>sizeof(ConsoleBuff)-1 then
+ i:=sizeof(ConsoleBuff)-1
+ else
+ i:=F.BufPos;
+ Move(F.BufPtr^,ConsoleBuff,i);
+ ConsoleBuff[i] := #0;
+ screenprintf (NWLoggerScreen,@ConsoleBuff);
+ end;
+ F.BufPos:=0;
+ ConsoleWrite := 0;
+ NXThreadYield;
+End;
+
+
+Function ConsoleClose(Var F: TextRec): Integer;
+begin
+ ConsoleClose:=0;
+end;
+
+
+Function ConsoleOpen(Var F: TextRec): Integer;
+Begin
+ TextRec(F).InOutFunc:=@ConsoleWrite;
+ TextRec(F).FlushFunc:=@ConsoleWrite;
+ TextRec(F).CloseFunc:=@ConsoleClose;
+ ConsoleOpen:=0;
+End;
+
+
+procedure AssignStdErrConsole(Var T: Text);
+begin
+ Assign(T,'');
+ TextRec(T).OpenFunc:=@ConsoleOpen;
+ Rewrite(T);
+end;
+{$endif}
+
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := SizeUInt (getnlmhandle);
+end;
+
+
+{ this will be called if the nlm is unloaded. It will NOT be
+ called if the program exits i.e. with halt.
+ Halt (or _exit) can not be called from this callback procedure }
+procedure TermSigHandler (Sig:longint); CDecl;
+var oldPtr : pointer;
+ current_exit : procedure;
+begin
+ { Threadvar Pointer will not be valid because the signal
+ handler is called by netware with a differnt thread. To avoid
+ problems in the exit routines, we set the data of the main thread
+ here }
+ if assigned (SetThreadDataAreaPtr) then
+ oldPtr := SetThreadDataAreaPtr (NIL); { nil means main thread }
+
+ TerminatingThreadID := dword(pthread_self);
+
+ {we need to finalize winock to release threads
+ waiting on a blocking socket call. If that thread
+ calls halt, we have to avoid that unit finalization
+ is called by that thread because we are doing it
+ here
+
+ like the old exitProc, mainly to allow winsock to release threads
+ blocking in a winsock calls }
+ while NetwareUnloadProc<>nil Do
+ Begin
+ InOutRes:=0;
+ current_exit:=tProcedure(NetwareUnloadProc);
+ NetwareUnloadProc:=nil;
+ current_exit();
+ NXThreadYield;
+ //hadExitProc := true;
+ End;
+
+
+ SigTermHandlerActive := true; { to avoid that system_exit calls _exit }
+ do_exit; { calls finalize units }
+ if assigned (SetThreadDataAreaPtr) then
+ SetThreadDataAreaPtr (oldPtr);
+end;
+
+
+procedure SysInitStdIO;
+begin
+{ Setup stdin, stdout and stderr }
+ {$ifdef IOpossix}
+ StdInputHandle := THandle (fileno (___stdin^)); // GetStd** returns **FILE !
+ StdOutputHandle:= THandle (fileno (___stdout^));
+ StdErrorHandle := THandle (fileno (___stderr^));
+ {$else}
+ StdInputHandle := THandle (___stdin^); // GetStd** returns **FILE !
+ StdOutputHandle:= THandle (___stdout^);
+ StdErrorHandle := THandle (___stderr^);
+ {$endif}
+
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+
+ {$ifdef StdErrToConsole}
+ AssignStdErrConsole(StdErr);
+ AssignStdErrConsole(ErrOutput);
+ {$else}
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ {$endif}
+end;
+
+// this is called by main.as, setup args and call PASCALMAIN
+procedure nlm_main (_ArgC : LONGINT; _ArgV : ppchar); cdecl; [public,alias: '_FPC_NLM_Entry'];
+BEGIN
+ ArgC := _ArgC;
+ ArgV := _ArgV;
+ isLibrary := false;
+ PASCALMAIN;
+ do_exit; // currently not needed
+END;
+
+function _DLLMain (hInstDLL:pointer; fdwReason:dword; DLLParam:longint):longbool; cdecl;
+[public, alias : '_FPC_DLL_Entry'];
+var res : longbool;
+begin
+ {$ifdef DEBUG_MT}
+ _ConsolePrintf ('_FPC_DLL_Entry called');
+ {$endif}
+ _DLLMain := false;
+ isLibrary := true;
+ case fdwReason of
+ DLL_ACTUAL_DLLMAIN : _DLLMain := true;
+ DLL_NLM_STARTUP : begin
+ //_ConsolePrintf ('DLL_NLM_STARTUP');
+ if assigned(Dll_Process_Attach_Hook) then
+ begin
+ res:=Dll_Process_Attach_Hook(DllParam);
+ if not res then
+ exit(false);
+ end;
+ PASCALMAIN;
+ _DLLMain := true;
+ end;
+ DLL_NLM_SHUTDOWN : begin
+ //_ConsolePrintf ('DLL_NLM_SHUTDOWN');
+ TermSigHandler(0);
+ _DLLMain := true;
+ end;
+ { standard DllMain() messages... }
+ DLL_THREAD_ATTACH,
+ DLL_PROCESS_ATTACH : begin
+ //__ConsolePrintf ('DLL_PROCESS/THREAD_ATTACH');
+ if assigned(AllocateThreadVars) then
+ AllocateThreadVars;
+ if assigned(Dll_Thread_Attach_Hook) then
+ Dll_Thread_Attach_Hook(DllParam);
+
+ _DLLMain := true;
+ end;
+ DLL_THREAD_DETACH,
+ DLL_PROCESS_DETACH : begin
+ //__ConsolePrintf ('DLL_PROCESS/THREAD_DETACH');
+ if assigned(Dll_Thread_Detach_Hook) then
+ Dll_Thread_Detach_Hook(DllParam);
+ if assigned(ReleaseThreadVars) then
+ ReleaseThreadVars;
+ _DLLMain := true;
+ end;
+ end;
+end;
+
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+Begin
+ getCodeAddresses;
+ StackBottom := SPtr - StackLength;
+ SigTermHandlerActive := false;
+ NetwareCheckFunction := nil;
+ {$ifdef StdErrToConsole}
+ NWLoggerScreen := getnetwarelogger;
+ {$endif}
+ CheckFunction; // avoid check function to be removed by the linker
+
+ envp := ____environ^;
+ NLMHandle := getnlmhandle;
+ { allocate resource tags to see what kind of memory i forgot to release }
+ HeapAllocResourceTag :=
+ AllocateResourceTag(NLMHandle,'Heap Memory',AllocSignature);
+ {$ifdef autoHeapRelease}
+ HeapListAllocResourceTag :=
+ AllocateResourceTag(NLMHandle,'Heap Memory List',AllocSignature);
+ {$endif}
+ FpSignal (SIGTERM, @TermSigHandler);
+
+{ Setup heap }
+ InitHeap;
+ SysInitExceptions;
+
+{ Reset IO Error }
+ InOutRes:=0;
+
+ ThreadID := dword(pthread_self);
+
+ SysInitStdIO;
+
+{Delphi Compatible}
+ IsConsole := TRUE;
+ ExitCode := 0;
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+{
+ $Log: system.pp,v $
+ Revision 1.15 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.14 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.13 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.12 2005/02/01 20:22:49 florian
+ * improved widestring infrastructure manager
+
+ Revision 1.11 2005/01/04 11:25:34 armin
+ * rtl code cleanup, compat fixes between clib and libc
+
+}
diff --git a/rtl/netwlibc/systhrd.inc b/rtl/netwlibc/systhrd.inc
new file mode 100644
index 0000000000..1fc19511c8
--- /dev/null
+++ b/rtl/netwlibc/systhrd.inc
@@ -0,0 +1,463 @@
+{
+ $Id: systhrd.inc,v 1.2 2005/02/14 17:13:30 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := ConsolePrintf} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+ const
+ threadvarblocksize : dword = 0;
+ thredvarsmainthread: pointer = nil; // to free the threadvars in the signal handler
+
+
+ var
+ TLSKey : pthread_key_t;
+ ThVarAllocResourceTag : rtag_t;
+
+ procedure SysInitThreadvar(var offset : dword;size : dword);
+ begin
+ offset:=threadvarblocksize;
+ inc(threadvarblocksize,size);
+ end;
+
+ function SysRelocateThreadvar(offset : dword) : pointer;
+ begin
+ SysRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
+ end;
+
+
+ procedure SysAllocateThreadVars;
+ var
+ dataindex : pointer;
+ begin
+ { we've to allocate the memory from system }
+ { because the FPC heap management uses }
+ { exceptions which use threadvars but }
+ { these aren't allocated yet ... }
+ { allocate room on the heap for the thread vars }
+ DataIndex:=_Alloc(threadvarblocksize,ThVarAllocResourceTag);
+ //DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+ FillChar(DataIndex^,threadvarblocksize,0);
+ pthread_setspecific(tlskey,dataindex);
+ if thredvarsmainthread = nil then
+ thredvarsmainthread := dataindex;
+ WRITE_DEBUG ('SysAllocateThreadVars'#13#10);
+ end;
+
+
+ procedure SysReleaseThreadVars;
+ begin
+ WRITE_DEBUG ('SysReleaseThreadVars'#13#10);
+ _Free (pthread_getspecific(tlskey));
+ end;
+
+ function SysSetThreadDataAreaPtr (newPtr:pointer):pointer;
+ begin
+ SysSetThreadDataAreaPtr := pthread_getspecific(tlskey); // return current
+ if newPtr = nil then // if nil
+ newPtr := thredvarsmainthread; // set main thread vars
+ pthread_setspecific(tlskey,newPtr);
+ end;
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+ Thread starting
+*****************************************************************************}
+
+ type
+ pthreadinfo = ^tthreadinfo;
+ tthreadinfo = record
+ f : tthreadfunc;
+ p : pointer;
+ stklen : cardinal;
+ end;
+
+ procedure DoneThread;
+ begin
+ { Release Threadvars }
+{$ifdef HASTHREADVAR}
+ WRITE_DEBUG('DoneThread, releasing threadvars'#13#10);
+ SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+ end;
+
+
+ function ThreadMain(param : pointer) : pointer;cdecl;
+ var
+ ti : tthreadinfo;
+ begin
+ WRITE_DEBUG('New thread started, initing threadvars'#13#10);
+{$ifdef HASTHREADVAR}
+ { Allocate local thread vars, this must be the first thing,
+ because the exception management and io depends on threadvars }
+ SysAllocateThreadVars;
+{$endif HASTHREADVAR}
+ { Copy parameter to local data }
+ WRITE_DEBUG('New thread started, initialising ...'#13#10);
+ ti:=pthreadinfo(param)^;
+ dispose(pthreadinfo(param));
+ { Initialize thread }
+ InitThread(ti.stklen);
+ { Start thread function }
+ WRITE_DEBUG('Jumping to thread function'#13#10);
+ ThreadMain:=pointer(ti.f(ti.p));
+ DoneThread;
+ //pthread_detach(pointer(pthread_self));
+ pthread_exit (nil);
+ end;
+
+
+ function SysBeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;
+ creationFlags : dword; var ThreadId : THandle) : DWord;
+ var
+ ti : pthreadinfo;
+ thread_attr : pthread_attr_t;
+ begin
+ WRITE_DEBUG('SysBeginThread: Creating new thread'#13#10);
+ { Initialize multithreading if not done }
+ if not IsMultiThread then
+ begin
+{$ifdef HASTHREADVAR}
+ { We're still running in single thread mode, setup the TLS }
+ pthread_key_create(@TLSKey,nil);
+ InitThreadVars(@SysRelocateThreadvar);
+{$endif HASTHREADVAR}
+ IsMultiThread:=true;
+ end;
+ { the only way to pass data to the newly created thread
+ in a MT safe way, is to use the heap }
+ getmem(ti,sizeof(pthreadinfo));
+ ti^.f:=ThreadFunction;
+ ti^.p:=p;
+ ti^.stklen:=stacksize;
+ { call pthread_create }
+ WRITE_DEBUG('SysBeginThread: Starting new thread'#13#10);
+ pthread_attr_init(@thread_attr);
+ pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
+
+ // will fail under linux -- apparently unimplemented
+ pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
+
+ // don't create detached, we need to be able to join (waitfor) on
+ // the newly created thread!
+ //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
+ if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
+ threadid := 0;
+ end;
+ SysBeginThread:=threadid;
+ WRITE_DEBUG('SysBeginThread returning %d'#13#10,SysBeginThread);
+ end;
+
+
+ procedure SysEndThread(ExitCode : DWord);
+ begin
+ DoneThread;
+ pthread_detach(pointer(pthread_self));
+ pthread_exit(pointer(ExitCode));
+ end;
+
+
+ function SysSuspendThread (threadHandle : dword) : dword;
+ begin
+ {$Warning SuspendThread needs to be implemented}
+ SysSuspendThread := $0FFFFFFFF;
+ end;
+
+ function SysResumeThread (threadHandle : dword) : dword;
+ begin
+ {$Warning ResumeThread needs to be implemented}
+ SysResumeThread := $0FFFFFFFF;
+ end;
+
+ procedure SysThreadSwitch; {give time to other threads}
+ begin
+ pthread_yield;
+ end;
+
+ function SysKillThread (threadHandle : dword) : dword;
+ begin
+ pthread_detach(pointer(threadHandle));
+ SysKillThread := pthread_cancel(Pointer(threadHandle));
+ end;
+
+ function SysWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout}
+ var
+ LResultP: Pointer;
+ LResult: DWord;
+ begin
+ LResult := 0;
+ LResultP := @LResult;
+ WRITE_DEBUG('SysWaitForThreadTerminate: waiting for %d, timeout %d'#13#10,threadHandle,timeoutMS);
+ pthread_join(Pointer(threadHandle), @LResultP);
+ SysWaitForThreadTerminate := LResult;
+ end;
+
+ function SysThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
+ begin
+ {priority is ignored on netware}
+ SysThreadSetPriority := true;
+ end;
+
+
+ function SysThreadGetPriority (threadHandle : dword): longint;
+ begin
+ {priority is ignored on netware}
+ SysThreadGetPriority := 0;
+ end;
+
+ function SysGetCurrentThreadId : dword;
+ begin
+ SysGetCurrentThreadId:=dword(pthread_self);
+ end;
+
+
+{*****************************************************************************
+ Delphi/Win32 compatibility
+*****************************************************************************}
+
+ procedure SysInitCriticalSection(var CS);
+
+ Var
+ P : PRTLCriticalSection;
+
+ begin
+ P:=PRTLCriticalSection(@CS);
+ FillChar (p^,sizeof(p^),0);
+ pthread_mutex_init(P,NIL);
+ end;
+
+ procedure SysEnterCriticalSection(var CS);
+ begin
+ pthread_mutex_lock(PRTLCriticalSection(@CS));
+ end;
+
+ procedure SysLeaveCriticalSection(var CS);
+ begin
+ pthread_mutex_unlock(PRTLCriticalSection(@CS));
+ end;
+
+ procedure SysDoneCriticalSection(var CS);
+ begin
+ pthread_mutex_destroy(PRTLCriticalSection(@CS));
+ end;
+
+
+{*****************************************************************************
+ Heap Mutex Protection
+*****************************************************************************}
+
+ var
+ HeapMutex : pthread_mutex_t;
+
+ procedure PThreadHeapMutexInit;
+ begin
+ pthread_mutex_init(@heapmutex,nil);
+ end;
+
+ procedure PThreadHeapMutexDone;
+ begin
+ pthread_mutex_destroy(@heapmutex);
+ end;
+
+ procedure PThreadHeapMutexLock;
+ begin
+ pthread_mutex_lock(@heapmutex);
+ end;
+
+ procedure PThreadHeapMutexUnlock;
+ begin
+ pthread_mutex_unlock(@heapmutex);
+ end;
+
+ const
+ PThreadMemoryMutexManager : TMemoryMutexManager = (
+ MutexInit : @PThreadHeapMutexInit;
+ MutexDone : @PThreadHeapMutexDone;
+ MutexLock : @PThreadHeapMutexLock;
+ MutexUnlock : @PThreadHeapMutexUnlock;
+ );
+
+ procedure InitHeapMutexes;
+ begin
+ SetMemoryMutexManager(PThreadMemoryMutexManager);
+ end;
+
+type
+ Tbasiceventstate=record
+ FSem: Pointer;
+ FManualReset: Boolean;
+ FEventSection: ppthread_mutex_t;
+ end;
+ plocaleventstate = ^tbasiceventstate;
+// peventstate=pointer;
+
+Const
+ wrSignaled = 0;
+ wrTimeout = 1;
+ wrAbandoned= 2;
+ wrError = 3;
+
+function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+var
+ MAttr : pthread_mutex_attr_t;
+ res : cint;
+
+
+begin
+ //new(plocaleventstate(result));
+ getmem (result,sizeof(plocaleventstate));
+ plocaleventstate(result)^.FManualReset:=AManualReset;
+ plocaleventstate(result)^.FSem:=New(PSemaphore); //sem_t.
+// plocaleventstate(result)^.feventsection:=nil;
+ res:=pthread_mutexattr_init(@MAttr);
+ if Res=0 then
+ try
+ Res:=pthread_mutexattr_settype(@MAttr,longint(PTHREAD_MUTEX_RECURSIVE));
+ if Res=0 then
+ Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr);
+ finally
+ pthread_mutexattr_destroy(@MAttr);
+ end;
+ sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState));
+end;
+
+procedure Intbasiceventdestroy(state:peventstate);
+
+begin
+ sem_destroy(psem_t( plocaleventstate(state)^.FSem));
+end;
+
+procedure IntbasiceventResetEvent(state:peventstate);
+
+begin
+ While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
+ ;
+end;
+
+procedure IntbasiceventSetEvent(state:peventstate);
+
+Var
+ Value : Longint;
+
+begin
+ pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+ Try
+ sem_getvalue(plocaleventstate(state)^.FSem,@value);
+ if Value=0 then
+ sem_post(psem_t( plocaleventstate(state)^.FSem));
+ finally
+ pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+ end;
+end;
+
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+ If TimeOut<>Cardinal($FFFFFFFF) then
+ result:=wrError
+ else
+ begin
+ sem_wait(psem_t(plocaleventstate(state)^.FSem));
+ result:=wrSignaled;
+ if plocaleventstate(state)^.FManualReset then
+ begin
+ pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+ Try
+ intbasiceventresetevent(State);
+ sem_post(psem_t( plocaleventstate(state)^.FSem));
+ Finally
+ pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+ end;
+ end;
+ end;
+end;
+
+Var
+ NWThreadManager : TThreadManager;
+
+Procedure InitSystemThreads;
+
+begin
+ With NWThreadManager do
+ begin
+ InitManager :=nil;
+ DoneManager :=nil;
+ BeginThread :=@SysBeginThread;
+ EndThread :=@SysEndThread;
+ SuspendThread :=@SysSuspendThread;
+ ResumeThread :=@SysResumeThread;
+ KillThread :=@SysKillThread;
+ ThreadSwitch :=@SysThreadSwitch;
+ WaitForThreadTerminate :=@SysWaitForThreadTerminate;
+ ThreadSetPriority :=@SysThreadSetPriority;
+ ThreadGetPriority :=@SysThreadGetPriority;
+ GetCurrentThreadId :=@SysGetCurrentThreadId;
+ InitCriticalSection :=@SysInitCriticalSection;
+ DoneCriticalSection :=@SysDoneCriticalSection;
+ EnterCriticalSection :=@SysEnterCriticalSection;
+ LeaveCriticalSection :=@SysLeaveCriticalSection;
+{$ifdef hasthreadvar}
+ InitThreadVar :=@SysInitThreadVar;
+ RelocateThreadVar :=@SysRelocateThreadVar;
+ AllocateThreadVars :=@SysAllocateThreadVars;
+ ReleaseThreadVars :=@SysReleaseThreadVars;
+{$endif}
+ BasicEventCreate :=@intBasicEventCreate;
+ BasicEventDestroy :=@intBasicEventDestroy;
+ BasicEventResetEvent :=@intBasicEventResetEvent;
+ BasicEventSetEvent :=@intBasicEventSetEvent;
+ BasiceventWaitFor :=@intBasiceventWaitFor;
+ end;
+ SetThreadManager(NWThreadManager);
+ InitHeapMutexes;
+ {$ifdef HASTHREADVAR}
+ ThVarAllocResourceTag := AllocateResourceTag(getnlmhandle,'Threadvar Memory',AllocSignature);
+ {$endif}
+ NWSysSetThreadFunctions (@SysAllocateThreadVars,
+ @SysReleaseThreadVars,
+ @SysSetThreadDataAreaPtr);
+end;
+
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.2 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/netwlibc/sysutils.pp b/rtl/netwlibc/sysutils.pp
new file mode 100644
index 0000000000..076720b9d0
--- /dev/null
+++ b/rtl/netwlibc/sysutils.pp
@@ -0,0 +1,712 @@
+{
+ $Id: sysutils.pp,v 1.10 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ Sysutils unit for netware (libc)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses Libc,DOS;
+
+
+TYPE
+ TNetwareLibcFindData =
+ RECORD
+ DirP : Pdirent; { used for opendir }
+ EntryP: Pdirent; { and readdir }
+ Magic : longint; { to avoid abends with uninitialized TSearchRec }
+ _mask : string; { search mask i.e. *.* }
+ _dir : string; { directory where to search }
+ _attr : longint; { specified attribute }
+ fname : string; { full pathname of found file }
+ END;
+
+{$DEFINE HAS_SLEEP}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+
+{ additional NetWare file flags}
+CONST
+ faSHARE = M_A_SHARE shr 16; // Sharable file
+
+ //faNO_SUBALLOC = $00000800; // Don't sub alloc. this file
+ faTRANS = M_A_TRANS shr 16; // Transactional file (TTS usable)
+ //faREADAUD = $00004000; // clib only: Read audit
+ //faWRITAUD = $00008000; // clib only: Write audit
+
+ faIMMPURG = M_A_IMMPURG shr 16; // Immediate purge
+ faNORENAM = M_A_NORENAM shr 16; // Rename inhibit
+ faNODELET = M_A_NODELET shr 16; // Delete inhibit
+ faNOCOPY = M_A_NOCOPY shr 16; // Copy inhibit
+
+ //faFILE_MIGRATED = $00400000; // clib only: File has been migrated
+ //faDONT_MIGRATE = $00800000; // clib only: Don't migrate this file
+ faIMMEDIATE_COMPRESS = M_A_IMMCOMPRESS shr 16; // Compress this file immediately
+ faFILE_COMPRESSED = M_A_FILE_COMPRESSED shr 16; // File is compressed
+ faDONT_COMPRESS = M_A_DONT_COMPRESS shr 16; // Don't compress this file
+ faCANT_COMPRESS = M_A_CANT_COMPRESS shr 16; // Can't compress this file
+ //faATTR_ARCHIVE = $40000000; // clib only: Entry has had an EA modified,
+ // an ownerID changed, or trustee
+ // info changed, etc.
+ faSetNetwareAttrs = M_A_BITS_SIGNIFICANT; // if this is set, netware flags are changed also
+
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+VAR NWOpenFlags : longint;
+BEGIN
+ NWOpenFlags:=0;
+ Case (Mode and 3) of
+ 0 : NWOpenFlags:=NWOpenFlags or O_RDONLY;
+ 1 : NWOpenFlags:=NWOpenFlags or O_WRONLY;
+ 2 : NWOpenFlags:=NWOpenFlags or O_RDWR;
+ end;
+ FileOpen := Fpopen (pchar(FileName),NWOpenFlags);
+
+ //!! We need to set locking based on Mode !!
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+begin
+ FileCreate:=Fpopen(Pchar(FileName),O_RdWr or O_Creat or O_Trunc or O_Binary);
+ if FileCreate >= 0 then
+ FileSetAttr (Filename, 0); // dont know why but open always sets ReadOnly flag
+end;
+
+Function FileCreate (Const FileName : String; mode:longint) : Longint;
+begin
+ FileCreate:=FileCreate (FileName);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+begin
+ FileRead:=libc.fpread (Handle,@Buffer,Count);
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+begin
+ FileWrite:=libc.fpwrite (Handle,@Buffer,Count);
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+begin
+ FileSeek:=libc.fplseek (Handle,FOffset,Origin);
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+begin
+ FileSeek:=libc.fplseek64 (Handle,FOffset,Origin);
+end;
+
+
+Procedure FileClose (Handle : Longint);
+begin
+ libc.fpclose(Handle);
+end;
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+begin
+ FileTruncate:=(libc.fpchsize(Handle,Size) = 0);
+end;
+
+Function FileLock (Handle,FOffset,FLen : Longint) : Longint;
+begin
+ {$warning FileLock not implemented}
+ //FileLock := _lock (Handle,FOffset,FLen);
+ FileLock := -1;
+end;
+
+Function FileLock (Handle : Longint; FOffset,FLen : Int64) : Longint;
+begin
+ {$warning need to add 64bit FileLock call }
+ //FileLock := FileLock (Handle, longint(FOffset),longint(FLen));
+ FileLock := -1;
+end;
+
+Function FileUnlock (Handle,FOffset,FLen : Longint) : Longint;
+begin
+ //FileUnlock := _unlock (Handle,FOffset,FLen);
+ {$warning FileUnLock not implemented}
+ FileUnlock := -1;
+end;
+
+Function FileUnlock (Handle : Longint; FOffset,FLen : Int64) : Longint;
+begin
+ {$warning need to add 64bit FileUnlock call }
+ //FileUnlock := FileUnlock (Handle, longint(FOffset),longint(FLen));
+ FileUnlock := -1;
+end;
+
+Function FileAge (Const FileName : String): Longint;
+var Info : TStat;
+ TM : TTM;
+begin
+ If Fpstat (pchar(FileName),Info) <> 0 then
+ exit(-1)
+ else
+ begin
+ localtime_r (Info.st_mtim.tv_sec,tm);
+ with TM do
+ result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+ end;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+VAR Info : TStat;
+begin
+ FileExists:=(Fpstat(pchar(filename),Info) = 0);
+end;
+
+
+Function UnixToWinAge(UnixAge : time_t): Longint;
+Var tm : TTm;
+begin
+ libc.localtime_r (UnixAge, tm);
+ with tm do
+ Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+end;
+
+
+{returns true if attributes match}
+function find_setfields (var f : TsearchRec; var AttrsOk : boolean) : longint;
+var
+ StatBuf : TStat;
+ fname : string;
+begin
+ result := 0;
+ with F do
+ begin
+ if FindData.Magic = $AD02 then
+ begin
+ attr := (Pdirent(FindData.EntryP)^.d_mode shr 16) and $ffff;
+ size := Pdirent(FindData.EntryP)^.d_size;
+ name := strpas (Pdirent(FindData.EntryP)^.d_name);
+ fname := FindData._dir + name;
+ if Fpstat (pchar(fname),StatBuf) = 0 then
+ time := UnixToWinAge (StatBuf.st_mtim.tv_sec)
+ else
+ time := 0;
+ AttrsOk := false;
+ if (f.FindData._attr and faHidden) = 0 then
+ if attr and faHidden > 0 then exit;
+ if (f.FindData._attr and faDirectory) = 0 then
+ if attr and faDirectory > 0 then exit;
+ if (f.FindData._attr and faSysFile) = 0 then
+ if attr and faSysFile > 0 then exit;
+ AttrsOk := true;
+ end else
+ begin
+ FillChar (f,sizeof(f),0);
+ result := 18;
+ end;
+ end;
+end;
+
+function findfirst(const path : string;attr : longint;var Rslt : TsearchRec) : longint;
+var
+ path0 : string;
+ p : longint;
+begin
+ IF path = '' then
+ begin
+ result := 18;
+ exit;
+ end;
+ Rslt.FindData._attr := attr;
+ p := length (path);
+ while (p > 0) and (not (path[p] in ['\','/'])) do
+ dec (p);
+ if p > 0 then
+ begin
+ Rslt.FindData._mask := copy (path,p+1,255);
+ Rslt.FindData._dir := copy (path,1,p);
+ end else
+ begin
+ Rslt.FindData._mask := path;
+ Rslt.FindData._dir := GetCurrentDir;
+ if (Rslt.FindData._dir[length(Rslt.FindData._dir)] <> '/') and
+ (Rslt.FindData._dir[length(Rslt.FindData._dir)] <> '\') then
+ Rslt.FindData._dir := Rslt.FindData._dir + '/';
+ end;
+ if Rslt.FindData._mask = '*' then Rslt.FindData._mask := '';
+ if Rslt.FindData._mask = '*.*' then Rslt.FindData._mask := '';
+ //writeln (stderr,'mask: "',Rslt._mask,'" dir:"',path0,'"');
+ Pdirent(Rslt.FindData.DirP) := opendir (pchar(Rslt.FindData._dir));
+ if Rslt.FindData.DirP = nil then
+ result := 18
+ else begin
+ Rslt.FindData.Magic := $AD02;
+ result := findnext (Rslt);
+ end;
+end;
+
+
+function findnext(var Rslt : TsearchRec) : longint;
+var attrsOk : boolean;
+begin
+ if Rslt.FindData.Magic <> $AD02 then
+ begin
+ result := 18;
+ exit;
+ end;
+ result:=0;
+ repeat
+ Pdirent(Rslt.FindData.EntryP) := readdir (Pdirent(Rslt.FindData.DirP));
+ if Rslt.FindData.EntryP = nil then
+ result := 18
+ else
+ result := find_setfields (Rslt,attrsOk);
+ if (result = 0) and (attrsOk) then
+ begin
+ if Rslt.FindData._mask = #0 then exit;
+ if fnmatch(@Rslt.FindData._mask[1],Pdirent(Rslt.FindData.EntryP)^.d_name,FNM_CASEFOLD) = 0 then
+ exit;
+ end;
+ until result <> 0;
+end;
+
+
+Procedure FindClose(Var f: TSearchRec);
+begin
+ if F.FindData.Magic <> $AD02 then exit;
+ doserror:=0;
+ closedir (Pdirent(f.FindData.DirP));
+ FillChar (f,sizeof(f),0);
+end;
+
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+Var Info : TStat;
+ _PTM : PTM;
+begin
+ If Fpfstat(Handle,Info) <> 0 then
+ Result:=-1
+ else
+ begin
+ _PTM := localtime (Info.st_mtim.tv_sec);
+ IF _PTM = NIL THEN
+ exit(-1)
+ else
+ with _PTM^ do
+ Result:=DateTimeToFileDate(EncodeDate(tm_year+1900,tm_mon+1,tm_mday)+EncodeTime(tm_hour,tm_min,tm_sec,0));
+ end;
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+Begin
+ {dont know how to do that, utime needs filename}
+ result := -1;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+Var Info : TStat;
+begin
+ If Fpstat (pchar(FileName),Info) <> 0 then
+ Result:=-1
+ Else
+ Result := (Info.st_mode shr 16) and $ffff;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+ StatBuf : TStat;
+ newMode : longint;
+begin
+ if Fpstat (pchar(Filename),StatBuf) = 0 then
+ begin
+ {what should i do here ?
+ only support sysutils-standard attributes or also support the extensions defined
+ only for netware libc ?
+ For now i allow the complete attributes if the bit faSetNetwareAttrs is set. Otherwise
+ only the standard attributes can be modified}
+ if attr and faSetNetwareAttrs > 0 then
+ begin
+ newmode := ((attr shl 16) and $ffff0000) or M_A_BITS_SIGNIFICANT;
+ end else
+ begin
+ attr := (attr and $2f) shl 16;
+ newmode := StatBuf.st_mode and ($ffff0000-M_A_RDONLY-M_A_HIDDEN- M_A_SYSTEM-M_A_SUBDIR-M_A_ARCH);
+ newmode := newmode or (attr shl 16) or M_A_BITS_SIGNIFICANT;
+ end;
+ if Fpchmod (pchar(Filename),newMode) < 0 then
+ result := ___errno^ else
+ result := 0;
+ end else
+ result := ___errno^;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+
+begin
+ Result:= (libc.UnLink (pchar(FileName)) = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+
+begin
+ RenameFile:=(libc.rename(pchar(OldName),pchar(NewName)) = 0);
+end;
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.',
+ 'a:.',
+ 'b:.',
+ 'sys:/'
+ );
+var
+ Drives : byte;
+ DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+Function DiskFree(Drive: Byte): int64;
+//var fs : Tstatfs;
+Begin
+{ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+ ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+ Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+ else
+ Diskfree:=-1;}
+ DiskFree := -1;
+ ConsolePrintf ('warning: fpc sysutils.diskfree not implemented'#13#10);
+ {$warning DiskFree not implemented (does it make sense ?) }
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+//var fs : statfs;
+Begin
+{ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+ ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+ DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+ else
+ DiskSize:=-1;}
+ DiskSize := -1;
+ ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10);
+ {$warning DiskSize not implemented (does it make sense ?) }
+End;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ Libc.FpChDir(pchar(NewDir));
+ result := (___errno^ = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ Libc.FpMkDir(pchar(NewDir),0);
+ result := (___errno^ = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ libc.FpRmDir(pchar(Dir));
+ result := (___errno^ = 0);
+end;
+
+
+function DirectoryExists (const Directory: string): boolean;
+var Info : TStat;
+begin
+ If Fpstat (pchar(Directory),Info) <> 0 then
+ exit(false)
+ else
+ Exit ((Info.st_mode and M_A_SUBDIR) <> 0);
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+ RingBell;
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var t : TTime;
+ tm: Ttm;
+begin
+ libc.time(t);
+ libc.localtime_r(t,tm);
+ with SystemTime do
+ begin
+ Hour := tm.tm_hour;
+ Minute := tm.tm_min;
+ Second := tm.tm_sec;
+ MilliSecond := 0;
+ Day := tm.tm_mday;
+ Month := tm.tm_mon+1;
+ Year := tm.tm_year+1900;
+ end;
+end;
+
+
+Procedure InitAnsi;
+Var i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=''; // only found perror that prints the message
+end;
+
+{****************************************************************************
+ OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=StrPas(libc.getenv(PChar(EnvVar)));
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ Result:=FPCCountEnvVar(EnvP);
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ Result:=FPCGetEnvStrFromP(Envp,Index);
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+var
+ params:array of AnsiString;
+ count,i: longint;
+ Buf : pchar;
+ p : pchar;
+ CLine: AnsiString;
+begin
+ cLine := ComLine;
+ buf:=pchar(CLine);
+ count:=0;
+ while(buf^<>#0) do
+ begin
+ while (buf^ in [' ',#9,#10]) do
+ inc(buf);
+ inc(count);
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+ i := 0;
+ setlength(params,count);
+ buf:=pchar(CLine);
+ while(buf^<>#0) do
+ begin
+ while (buf^ in [' ',#9,#10]) do
+ inc(buf);
+ p := buf;
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ if buf^ <> #0 then
+ begin
+ buf^ := #0;
+ inc(buf);
+ end;
+ params[i]:=p;
+ inc(i);
+ end;
+ result := ExecuteProcess (Path, params);
+end;
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+const maxargs=256;
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+var c : comstr;
+ i : integer;
+ args : array[0..maxargs+1] of pchar;
+ arg0 : string;
+ numargs,wstat : integer;
+ Wiring : TWiring;
+ newPath : string;
+ e : EOSError;
+begin
+ if pos ('.',path) = 0 then
+ arg0 := fexpand(path+'.nlm')
+ else
+ arg0 := fexpand (path);
+ args[0] := pchar(arg0);
+ numargs := 0;
+ for I := 0 to High (ComLine) do
+ if numargs < maxargs then
+ begin
+ inc(numargs);
+ args[numargs] := pchar(ComLine[i]);
+ end;
+ args[numargs+1] := nil;
+ Wiring.infd := StdInputHandle; //textrec(Stdin).Handle;
+ Wiring.outfd:= textrec(stdout).Handle;
+ Wiring.errfd:= textrec(stderr).Handle;
+ i := procve(args[0],
+ PROC_CURRENT_SPACE+PROC_INHERIT_CWD,
+ envP, // const char * env[] If passed as NULL, the child process inherits the parent.s environment at the time of the call.
+ @Wiring, // wiring_t *wiring, Pass NULL to inherit system defaults for wiring.
+ nil, // struct fd_set *fds, Not currently implemented. Pass in NULL.
+ nil, // void *appdata, Not currently implemented. Pass in NULL.
+ 0, // size_t appdata_size, Not currently implemented. Pass in 0
+ nil, // void *reserved, Reserved. Pass NULL.
+ @args); // const char *argv[]
+ if i <> -1 then
+ begin
+ Fpwaitpid(i,@wstat,0);
+ result := wstat;
+ end else
+ begin
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[arg0,___errno^]);
+ e.ErrorCode:=___errno^;
+ raise e;
+ end;
+end;
+
+
+procedure Sleep(milliseconds: Cardinal);
+begin
+ libc._delay (milliseconds);
+end;
+
+
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+{
+
+ $Log: sysutils.pp,v $
+ Revision 1.10 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.9 2005/02/14 17:13:30 peter
+ * truncate log
+
+ Revision 1.8 2005/01/04 11:25:34 armin
+ * rtl code cleanup, compat fixes between clib and libc
+
+}
diff --git a/rtl/netwlibc/tthread.inc b/rtl/netwlibc/tthread.inc
new file mode 100644
index 0000000000..7b7482b246
--- /dev/null
+++ b/rtl/netwlibc/tthread.inc
@@ -0,0 +1,410 @@
+{
+ $Id: tthread.inc,v 1.4 2005/02/25 21:41:09 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Peter Vreman
+
+ Netware Libc TThread implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ What follows, is a short description on my implementation of TThread.
+ Most information can also be found by reading the source and accompanying
+ comments.
+
+ A thread is created using BeginThread, which in turn calls
+ pthread_create. So the threads here are always posix threads.
+ Posix doesn't define anything for suspending threads as this is
+ inherintly unsafe. Just don't suspend threads at points they cannot
+ control. Therefore, I didn't implement .Suspend() if its called from
+ outside the threads execution flow (except on Linux _without_ NPTL).
+
+ The implementation for .suspend uses a semaphore, which is initialized
+ at thread creation. If the thread tries to suspend itself, we simply
+ let it wait on the semaphore until it is unblocked by someone else
+ who calls .Resume.
+
+ If a thread is supposed to be suspended (from outside its own path of
+ execution) on a system where the symbol LINUX is defined, two things
+ are possible.
+ 1) the system has the LinuxThreads pthread implementation
+ 2) the system has NPTL as the pthread implementation.
+
+ In the first case, each thread is a process on its own, which as far as
+ know actually violates posix with respect to signal handling.
+ But we can detect this case, because getpid(2) will
+ return a different PID for each thread. In that case, sending SIGSTOP
+ to the PID associated with a thread will actually stop that thread
+ only.
+ In the second case, this is not possible. But getpid(2) returns the same
+ PID across all threads, which is detected, and TThread.Suspend() does
+ nothing in that case. This should probably be changed, but I know of
+ no way to suspend a thread when using NPTL.
+
+ If the symbol LINUX is not defined, then the unimplemented
+ function SuspendThread is called.
+
+ Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+ I don't like this. It eats up 2 filedescriptors for each thread,
+ and those are a limited resource. If you have a server programm
+ handling client connections (one per thread) it will not be able
+ to handle many if we use 2 fds already for internal structures.
+ However, right now I don't see a better option unless some sem_*
+ functions are added to systhrds.
+ I encapsulated all used functions here to make it easier to
+ change them completely.
+}
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := ConsolePrintf} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+
+function SemaphoreInit: Pointer;
+begin
+ SemaphoreInit := GetMem(SizeOf(TFilDes));
+ fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+ b: byte;
+begin
+ fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+var c : char;
+begin
+ c := #0;
+ fpwrite(PFilDes(FSem)^[1], c, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+ fpclose(PFilDes(FSem)^[0]);
+ fpclose(PFilDes(FSem)^[1]);
+ FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+type
+ PThreadRec=^TThreadRec;
+ TThreadRec=record
+ thread : TThread;
+ next : PThreadRec;
+ end;
+
+var
+ ThreadRoot : PThreadRec;
+ ThreadsInited : boolean = false;
+ DisableRemoveThread : boolean;
+ ThreadCount: longint = 0;
+{$IFDEF LINUX}
+ GMainPID: LongInt = 0;
+{$ENDIF}
+
+const
+ // stupid, considering its not even implemented...
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+ if not ThreadsInited then begin
+ ThreadsInited := true;
+ {$IFDEF LINUX}
+ GMainPid := fpgetpid();
+ {$ENDIF}
+ ThreadRoot:=nil;
+ ThreadsInited:=true;
+ DisableRemoveThread:=false;
+ end;
+end;
+
+procedure DoneThreads;
+var
+ hp,next : PThreadRec;
+begin
+ DisableRemoveThread := true; {to avoid that Destroy calling RemoveThread modifies Thread List}
+ while assigned(ThreadRoot) do
+ begin
+ WRITE_DEBUG('DoneThreads: calling Destroy'#13#10);
+ ThreadRoot^.Thread.Destroy;
+ hp:=ThreadRoot;
+ ThreadRoot:=ThreadRoot^.Next;
+ dispose(hp);
+ WRITE_DEBUG('DoneThreads: called destroy, remaining threads: %d ThreadRoot: %x'#13#10,ThreadCount,longint(ThreadRoot));
+ end;
+ ThreadsInited:=false;
+end;
+
+procedure AddThread(t:TThread);
+var
+ hp : PThreadRec;
+begin
+ { Need to initialize threads ? }
+ if not ThreadsInited then
+ InitThreads;
+
+ { Put thread in the linked list }
+ new(hp);
+ hp^.Thread:=t;
+ hp^.next:=ThreadRoot;
+ ThreadRoot:=hp;
+
+ inc(ThreadCount);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+ lasthp,hp : PThreadRec;
+begin
+ if not DisableRemoveThread then {disabled while in DoneThreads}
+ begin
+ hp:=ThreadRoot;
+ lasthp:=nil;
+ while assigned(hp) do
+ begin
+ if hp^.Thread=t then
+ begin
+ if assigned(lasthp) then
+ lasthp^.next:=hp^.next
+ else
+ ThreadRoot:=hp^.next;
+ dispose(hp);
+ Dec(ThreadCount);
+ if ThreadCount = 0 then ThreadsInited := false;
+ exit;
+ end;
+ lasthp:=hp;
+ hp:=hp^.next;
+ end;
+ end else
+ dec(ThreadCount);
+end;
+
+
+
+function ThreadFunc(parameter: Pointer): LongInt;
+var
+ LThread: TThread;
+ c: char;
+begin
+ WRITE_DEBUG('ThreadFunc is here...'#13#10);
+ LThread := TThread(parameter);
+ {$IFDEF LINUX}
+ // save the PID of the "thread"
+ // this is different from the PID of the main thread if
+ // the LinuxThreads implementation is used
+ LThread.FPid := fpgetpid();
+ {$ENDIF}
+ WRITE_DEBUG('thread initing, parameter = %d'#13#10, LongInt(LThread));
+ try
+ if LThread.FInitialSuspended then begin
+ SemaphoreWait(LThread.FSem);
+ if not LThread.FInitialSuspended then begin
+ WRITE_DEBUG('going into LThread.Execute'#13#10);
+ LThread.Execute;
+ end;
+ end else begin
+ WRITE_DEBUG('going into LThread.Execute'#13#10);
+ LThread.Execute;
+ end;
+ except
+ on e: exception do begin
+ WRITE_DEBUG('got exception: %s'#13#10,pchar(e.message));
+ LThread.FFatalException := TObject(AcquireExceptionObject);
+ // not sure if we should really do this...
+ // but .Destroy was called, so why not try FreeOnTerminate?
+ if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+ end;
+ end;
+ WRITE_DEBUG('thread done running'#13#10);
+ Result := LThread.FReturnValue;
+ WRITE_DEBUG('Result is %d'#13#10,Result);
+ LThread.FFinished := True;
+ LThread.DoTerminate;
+ if LThread.FreeOnTerminate then begin
+ WRITE_DEBUG('Thread should be freed'#13#10);
+ LThread.Free;
+ WRITE_DEBUG('Thread freed'#13#10);
+ end;
+ WRITE_DEBUG('thread func exiting'#13#10);
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+ // lets just hope that the user doesn't create a thread
+ // via BeginThread and creates the first TThread Object in there!
+ InitThreads;
+ AddThread(self);
+ inherited Create;
+ FSem := SemaphoreInit;
+ FSuspended :=CreateSuspended;
+ FSuspendedExternal := false;
+ FInitialSuspended := CreateSuspended;
+ FFatalException := nil;
+ WRITE_DEBUG('creating thread, self = %d'#13#10,longint(self));
+ FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+ WRITE_DEBUG('TThread.Create done'#13#10);
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if FThreadID = GetCurrentThreadID then begin
+ raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+ end;
+ // if someone calls .Free on a thread with
+ // FreeOnTerminate, then don't crash!
+ FFreeOnTerminate := false;
+ if not FFinished and not FSuspended then begin
+ Terminate;
+ WaitFor;
+ end;
+ if (FInitialSuspended) then begin
+ // thread was created suspended but never woken up.
+ SemaphorePost(FSem);
+ WaitFor;
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ SemaphoreDestroy(FSem);
+ inherited Destroy;
+ RemoveThread(self); {remove it from the list of active threads}
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ if not FSuspended then begin
+ if FThreadID = GetCurrentThreadID then begin
+ FSuspended := true;
+ SemaphoreWait(FSem);
+ end else begin
+ FSuspendedExternal := true;
+{$IFDEF LINUX}
+ // naughty hack if the user doesn't have Linux with NPTL...
+ // in that case, the PID of threads will not be identical
+ // to the other threads, which means that our thread is a normal
+ // process that we can suspend via SIGSTOP...
+ // this violates POSIX, but is the way it works on the
+ // LinuxThreads pthread implementation. Not with NPTL, but in that case
+ // getpid(2) also behaves properly and returns the same PID for
+ // all threads. Thats actually (FINALLY!) native thread support :-)
+ if FPid <> GMainPID then begin
+ FSuspended := true;
+ fpkill(FPid, SIGSTOP);
+ end;
+{$ELSE}
+ SuspendThread(FHandle);
+{$ENDIF}
+ end;
+ end;
+end;
+
+
+procedure TThread.Resume;
+begin
+ if (not FSuspendedExternal) then begin
+ if FSuspended then begin
+ SemaphorePost(FSem);
+ FInitialSuspended := false;
+ FSuspended := False;
+ end;
+ end else begin
+{$IFDEF LINUX}
+ // see .Suspend
+ if FPid <> GMainPID then begin
+ fpkill(FPid, SIGCONT);
+ FSuspended := False;
+ end;
+{$ELSE}
+ ResumeThread(FHandle);
+{$ENDIF}
+ FSuspendedExternal := false;
+ end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+ WRITE_DEBUG('waiting for thread ',FHandle);
+ WaitFor := WaitForThreadTerminate(FHandle, 0);
+ WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ // no need to check if FOnTerminate <> nil, because
+ // thats already done in DoTerminate
+ FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.4 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.3 2005/02/14 17:13:30 peter
+ * truncate log
+
+}
diff --git a/rtl/netwlibc/varutils.pp b/rtl/netwlibc/varutils.pp
new file mode 100644
index 0000000000..e4a7bab74d
--- /dev/null
+++ b/rtl/netwlibc/varutils.pp
@@ -0,0 +1,47 @@
+{
+ $Id: varutils.pp,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netwlibc/video.pp b/rtl/netwlibc/video.pp
new file mode 100644
index 0000000000..b1ba8da4d0
--- /dev/null
+++ b/rtl/netwlibc/video.pp
@@ -0,0 +1,196 @@
+{
+ $Id: video.pp,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Armin Diehl
+ member of the Free Pascal development team
+
+ Video unit for netware libc
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+
+interface
+
+{$i videoh.inc}
+
+implementation
+
+uses
+ Libc;
+
+{$i video.inc}
+
+var
+ MaxVideoBufSize : DWord;
+ ScreenHandle : scr_t;
+ CursorIsHidden : boolean;
+
+
+procedure SysSetCursorType(NewType: Word);
+begin
+ if newType=crHidden then
+ begin
+ Libc.DisableInputCursor (ScreenHandle);
+ cursorIsHidden := true;
+ end else
+ begin
+ cursorIsHidden := false;
+ case NewType of
+ crUnderline: Libc.SetCursorStyle (ScreenHandle,CURSOR_NORMAL);
+ crHalfBlock: Libc.SetCursorStyle (ScreenHandle,CURSOR_TOP);
+ crBlock : Libc.SetCursorStyle (ScreenHandle,CURSOR_BLOCK);
+ end;
+ Libc.EnableInputCursor (ScreenHandle);
+ end;
+end;
+
+
+procedure SysInitVideo;
+VAR height,width,x,y : WORD;
+ startline, endline : BYTE;
+ sType,sColorFlag : dword;
+begin
+ DoneVideo;
+ Libc.ReturnScreenType (sType,sColorFlag);
+ ScreenColor:= (sColorFlag > 0);
+ Libc.GetScreenSize(height,width);
+ ScreenWidth := width;
+ ScreenHeight:= height;
+
+ { TDrawBuffer only has FVMaxWidth elements
+ larger values lead to crashes }
+ if ScreenWidth> FVMaxWidth then
+ ScreenWidth:=FVMaxWidth;
+ GetOutputCursorPosition(ScreenHandle,y,x);
+ CursorX := x;
+ CursorY := y;
+ SysSetCursorType (crBlock);
+end;
+
+
+procedure SysDoneVideo;
+begin
+ SetCursorType(crUnderLine);
+end;
+
+
+function SysGetCapabilities: Word;
+begin
+ SysGetCapabilities:=cpColor or cpChangeCursor;
+end;
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+begin
+ Libc.PositionInputCursor(ScreenHandle,NewCursorY,NewCursorX);
+end;
+
+
+
+function SysGetCursorType: Word;
+var style : word;
+begin
+ if cursorIsHidden then
+ begin
+ SysGetCursorType := crHidden;
+ exit;
+ end;
+ Libc.GetCursorStyle (ScreenHandle,style);
+ case style of
+ CURSOR_THICK : SysGetCursorType := crBlock;
+ CURSOR_BLOCK : SysGetCursorType := crBlock;
+ CURSOR_TOP : SysGetCursorType := crHalfBlock
+ else
+ SysGetCursorType := crUnderline;
+ end;
+end;
+
+
+procedure SysUpdateScreen(Force: Boolean);
+begin
+ if VideoBuf = nil then
+ exit;
+ if (LockUpdateScreen<>0) or (VideoBufSize = 0) then
+ exit;
+ if not force then
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl VideoBuf,%esi
+ movl OldVideoBuf,%edi
+ movl VideoBufSize,%ecx
+ shrl $2,%ecx
+ repe
+ cmpsl
+ setne force
+ popl %edi
+ popl %esi
+ end;
+ end;
+ if Force then
+ Libc.RestoreScreenArea(ScreenHandle,0,0,ScreenHeight,ScreenWidth,VideoBuf);
+end;
+
+
+Const
+ SysVideoModeCount = 1;
+ SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+ (Col: 80; Row : 25; Color : True));
+
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
+begin
+ SysSetVideoMode := ((Mode.Col = 80) AND (Mode.Row = 25) AND (Mode.Color));
+end;
+
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+begin
+ SysGetVideoModeData:=(Index<=SysVideoModeCount);
+ If SysGetVideoModeData then
+ Data:=SysVMD[Index];
+end;
+
+Function SysGetVideoModeCount : Word;
+begin
+ SysGetVideoModeCount:=SysVideoModeCount;
+end;
+
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : Nil;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities
+);
+
+
+
+initialization
+ VideoBuf := nil;
+ VideoBufSize := 0;
+ ScreenHandle := Libc.getscreenhandle;
+ SetVideoDriver (SysVideoDriver);
+end.
+
+{
+ $Log: video.pp,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.4 2005/01/10 23:34:09 armin
+ * code cleanup
+
+}
diff --git a/rtl/netwlibc/winsock.pp b/rtl/netwlibc/winsock.pp
new file mode 100644
index 0000000000..68fc51199b
--- /dev/null
+++ b/rtl/netwlibc/winsock.pp
@@ -0,0 +1,11 @@
+{winsock is the same for clib and libc on netware}
+{$define netware}
+{$i ../netware/winsock.pp}
+
+{
+ $Log: winsock.pp,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
+
diff --git a/rtl/netwlibc/ws2_32.imp b/rtl/netwlibc/ws2_32.imp
new file mode 100644
index 0000000000..d82be2cefa
--- /dev/null
+++ b/rtl/netwlibc/ws2_32.imp
@@ -0,0 +1,345 @@
+ WS2_32_bind,
+ WS2_32_closesocket,
+ WS2_32_getpeername,
+ WS2_32_getsockname,
+ WS2_32_getsockopt,
+ WS2_32_htonl,
+ WS2_32_htons,
+ WS2_32_ioctlsocket,
+ WS2_32_listen,
+ WS2_32_ntohl,
+ WS2_32_ntohs,
+ WS2_32_recv,
+ WS2_32_recvfrom,
+ WS2_32_select,
+ WS2_32_send,
+ WS2_32_sendto,
+ WS2_32_setsockopt,
+ WS2_32_shutdown,
+ WS2_32_socket,
+ WSAAccept,
+ WSACancelBlockingCall,
+ WSACleanup,
+ WSACloseEvent,
+ WSAConnect,
+ WSACreateEvent,
+ WSCEnableNSProvider,
+ WSAEnumNetworkEvents,
+ WSAEnumProtocolsA,
+ WSAEnumProtocolsW,
+ WSAEventSelect,
+ WSAGetLastError,
+ WSAGetOverlappedResult,
+ WSAGetQOSByName,
+ WSAHtonl,
+ WSAHtons,
+ WSAIoctl,
+ WSAJoinLeaf,
+ WSANtohl,
+ WSANtohs,
+ WSARecv,
+ WSARecvDisconnect,
+ WSARecvFrom,
+ WSAResetEvent,
+ WSASend,
+ WSASendDisconnect,
+ WSASendTo,
+ WSASetEvent,
+ WSASetLastError,
+ WSASocketA,
+ WSASocketW,
+ WSAStartup,
+ WSAWaitForMultipleEvents,
+ WSAAddressToStringA,
+ WSAAddressToStringW,
+ WSAEnumNameSpaceProvidersA,
+ WSAEnumNameSpaceProvidersW,
+ WSAGetServiceClassInfoA,
+ WSAGetServiceClassInfoW,
+ WSAGetServiceClassNameByClassIdA,
+ WSAGetServiceClassNameByClassIdW,
+ WSAInstallServiceClassA,
+ WSAInstallServiceClassW,
+ WSALookupServiceBeginA,
+ WSALookupServiceBeginW,
+ WSALookupServiceEnd,
+ WSALookupServiceNextA,
+ WSALookupServiceNextW,
+ WSARemoveServiceClass,
+ WSASetServiceA,
+ WSASetServiceW,
+ WSAStringToAddressA,
+ WSAStringToAddressW,
+ WSCUnInstallNameSpace,
+ WSCInstallNameSpace,
+ WS2_32_gethostbyaddr,
+ WS2_32_gethostbyname,
+ WS2_32_gethostname,
+ WS2_32_getprotobyname,
+ WS2_32_getprotobynumber,
+ WS2_32_getservbyname,
+ WS2_32_getservbyport,
+ WS2_32_inet_addr,
+ WS2_32_inet_ntoa,
+ __WSAFDIsSet,
+ NiosCancelAESEvent,
+ NiosFindNode,
+ NiosDFindNode,
+ NiosDLinkFirst,
+ NiosDLinkLast,
+ NiosDprintf,
+ NiosDUnlinkFirst,
+ NiosDUnlinkLast,
+ NiosDUnlinkNode,
+ NiosFree,
+ NiosGetTickCount,
+ NiosLinkFirst,
+ NiosLinkLast,
+ NiosLongTermAlloc,
+ NiosMemSet,
+ NiosPoll,
+ NiosPrintf,
+ NiosScheduleAESEvent,
+ NiosScheduleForegroundEvent,
+ NiosShortTermAlloc,
+ NiosUnlinkFirst,
+ NiosUnlinkNode,
+ NiosMemCpy,
+ WSDebMsg,
+ WSAssertFail,
+ WSdebugLevel,
+ WSdebugModule,
+ WSDebChar,
+ WSDebugAllocCheck,
+ WSDebugFreeCheck,
+ WSDebugAlloc,
+ WSDebugString,
+ kYieldThreadStub,
+ FreeObjectStub,
+ AllocateObjectStub,
+ DestroyObjectCacheStub,
+ CreateObjectCacheStub,
+ kRWWriteUnlockStub,
+ kRWWriteLockStub,
+ kRWReadUnlockStub,
+ kRWReadLockStub,
+ kRWLockFreeStub,
+ kRWLockAllocStub,
+ kCurrentThreadStub,
+ WaitForSingleObject,
+ CreateEvent,
+ CloseHandle,
+ WPUSetEvent,
+ bufFree,
+ WSCreateAndLinkObjectCache,
+ WSDestroyObjectCacheList,
+ WSGarbageCollectObjectCache,
+ NetWareOSMajorVersion,
+ WVT,
+ ecbFreePlatformBuffer,
+ ecbImportMsgByRef,
+ ecbImportMsgByCopy,
+ msgCreate,
+ msgReset,
+ msgIncRef,
+ msgDecRef,
+ msgForEach,
+ msgDestroy,
+ msgCopyBufAtFront,
+ msgCopyBufAtEnd,
+ msgCopyToBuf,
+ msgRefBufAtFront,
+ msgRefBufAtEnd,
+ msgCopyMsgAtFront,
+ msgRefMsgAtFront,
+ msgCopyMsgAtEnd,
+ msgImportECBByCopy,
+ msgImportECBByRef,
+ msgRefMsgAtEnd,
+ msgRemoveDataAtFront,
+ msgRemoveDataAtEnd,
+ msgSetCurrentOffset,
+ msgModifyCurrentOffset,
+ msgPushWS,
+ msgPopWS,
+ msgPeekWS,
+ msgLaunchCallback,
+ msgPushAttrib,
+ msgPopAttrib,
+ msgScanMsgForAttrib,
+ mapClose,
+ mapCreate,
+ createProto,
+ termProto,
+ new_termProto,
+ addProtoToLlpList,
+ removeProtoFromLlpList,
+ incProtoRefCount,
+ incSessnRefCount,
+ decProtoRefCount,
+ decSessnRefCount,
+ createSocket,
+ destroySocket,
+ GetDown,
+ setProtoVtbl,
+ setSessnVtbl,
+ ctlPushWS,
+ ctlPopWS,
+ ctlPeekWS,
+ ctlLaunchCallback,
+ wsSocket,
+ wsGetAcceptData,
+ wsAccept,
+ wsBind,
+ wsConnect,
+ wsListen,
+ wsRecv,
+ wsRecvDisconnect,
+ wsSend,
+ wsSendDisconnect,
+ wsCloseSocket,
+ wsEventCallBack,
+ wsRecvCallBack,
+ wsREAD_EventCallBack,
+ wsWRITE_EventCallBack,
+ wsACCEPT_EventCallBack,
+ wsFASTACCEPT_EventCallBack,
+ wsCONNECT_EventCallBack,
+ wsCLOSE_EventCallBack,
+ wsCLOSE_DONE_EventCallBack,
+ wsEventSelect,
+ wsEventPoll,
+ wsControl,
+ wsGetSockName,
+ wsGetPeerName,
+ wsGetSockOpt,
+ wsSetSockOpt,
+ wsJoinLeaf,
+ wsGetQOSByName,
+ getProtoByModuleType,
+ mergeProtoCallTable,
+ estimateTypedData,
+ addTypedDataBegin,
+ addTypedDataNext,
+ addTypedDataEnd,
+ getTypedDataPtr,
+ registerProtocolInfo,
+ deregisterProtocolInfo,
+ getModuleTypeByProtocolInfo,
+ getModuleTypeByCatalogId,
+ kSetThreadWinSockDataStub,
+ kGetThreadWinSockDataStub,
+ kScheduleWorkToDoStub,
+ kCancelWorkToDoStub,
+ kCreateExSetStub,
+ kDestroyExSetStub,
+ kGetExSetHandleStub,
+ kEnterExSetStub,
+ kExitExSetStub,
+ kEnterNetWareStub,
+ kExitNetWareStub,
+ kBindExSetStub,
+ CfwAtomicInc,
+ CfwAtomicDec,
+ destroyProto,
+ kUnbindExSetStub,
+ kCurrentExSetBindingStub,
+ kMutexAllocStub,
+ kMutexFreeStub,
+ kMutexLockStub,
+ kMutexTryLockStub,
+ kMutexTimedWaitStub,
+ kMutexUnlockStub,
+ kMutexWaitCountStub,
+ kSemaphoreAllocStub,
+ kSemaphoreFreeStub,
+ kSemaphoreWaitStub,
+ kSemaphoreTryStub,
+ kSemaphoreTimedWaitStub,
+ kSemaphoreSignalStub,
+ kSemaphoreExamineCountStub,
+ kSemaphoreWaitCountStub,
+ kRWReadTryLockStub,
+ kRWWriteTryLockStub,
+ kRWWriterToReaderStub,
+ kRWReaderToWriterStub,
+ kSpinLockInitStub,
+ kSpinLockStub,
+ kSpinTryLockStub,
+ kSpinUnlockStub,
+ kSpinLockDisableStub,
+ kSpinTryLockDisableStub,
+ kSpinUnlockRestoreStub,
+ kAllocQueStub,
+ kAllocQueNoSleepStub,
+ kFreeQueStub,
+ kQueCountStub,
+ kEnQueStub,
+ kEnQueOrderedStub,
+ kDeQueStub,
+ kDeQueWaitStub,
+ kPushQueStub,
+ kPushQueOrderedStub,
+ kDeQueByQLinkStub,
+ kDeQueAllStub,
+ kEnQueNoLockStub,
+ kEnQueOrderedNoLockStub,
+ kPushQueNoLockStub,
+ kPushQueOrderedNoLockStub,
+ kDeQueNoLockStub,
+ kDeQueByQLinkNoLockStub,
+ kDeQueWaitNoLockStub,
+ kDeQueAllNoLockStub,
+ kFirstQLINKNoLockStub,
+ atomic_incStub,
+ atomic_decStub,
+ atomic_addStub,
+ atomic_subStub,
+ kConditionAllocStub,
+ kConditionDestroyStub,
+ kConditionWaitStub,
+ kConditionTimedWaitStub,
+ kConditionSignalStub,
+ kConditionBroadcastStub,
+ gwspProto,
+ getPackedMsg,
+ putPackedMsg,
+ WS2_32_DNSQuery,
+ FreeDNSReply,
+ HostsTable,
+ HostsEntries,
+ UsedHostsEntries,
+ HostsRWLock,
+ ResizeTable,
+ WS2DNSAllocRTag,
+ WSLocalToUnicode,
+ WSUnicodeToLocal,
+ WS2getservbyname,
+ WS2getservbyport,
+ WS2gethostbyaddr,
+ WS2gethostbyname,
+ WS2_32_GetGeneralStatistics,
+ WS2_32_GetSocketStatistics,
+ WS2_32_GetDebugState,
+ WS2_32_SetDebugState,
+ GetTimerMinorTicksPerSecondStub,
+ WSStartupNLMQ,
+ WSStartupNLMQSpinLock,
+ WSPCloseSocket,
+ wsSktDiag,
+ NiosVidMessageBox,
+ NiosThreadSignalId,
+ NiosThreadBlockOnId,
+ NiosThreadArmId,
+ NiosStrLen,
+ NiosStrCmp,
+ NiosStrCat,
+ NiosGetHighResIntervalMarker,
+ NiosGetDateTime,
+ NiosMemCmp,
+ wsNewWindow,
+ INWNSPInstallServiceClass,
+ INWNSPGetServiceClassInfo,
+ INWNSPRemoveServiceClass,
+ mapReCreateTable
+
diff --git a/rtl/netwlibc/ws2nlm.imp b/rtl/netwlibc/ws2nlm.imp
new file mode 100644
index 0000000000..57da9c315a
--- /dev/null
+++ b/rtl/netwlibc/ws2nlm.imp
@@ -0,0 +1,89 @@
+ WS2_32_bind,
+ WS2_32_closesocket,
+ WS2_32_getpeername,
+ WS2_32_getsockname,
+ WS2_32_getsockopt,
+ WS2_32_htonl,
+ WS2_32_htons,
+ WS2_32_ioctlsocket,
+ WS2_32_listen,
+ WS2_32_ntohl,
+ WS2_32_ntohs,
+ WS2_32_recv,
+ WS2_32_recvfrom,
+ WS2_32_select,
+ WS2_32_send,
+ WS2_32_sendto,
+ WS2_32_setsockopt,
+ WS2_32_shutdown,
+ WS2_32_socket,
+ WSAAccept,
+ WSACancelBlockingCall,
+ WSACleanup,
+ WSACloseEvent,
+ WSAConnect,
+ WSACreateEvent,
+ WSCEnableNSProvider,
+ WSAEnumNetworkEvents,
+ WSAEnumProtocolsA,
+ WSAEnumProtocolsW,
+ WSAEventSelect,
+ WSAGetLastError,
+ WSAGetOverlappedResult,
+ WSAGetQOSByName,
+ WSAHtonl,
+ WSAHtons,
+ WSAIoctl,
+ WSAJoinLeaf,
+ WSANtohl,
+ WSANtohs,
+ WSARecv,
+ WSARecvDisconnect,
+ WSARecvFrom,
+ WSAResetEvent,
+ WSASend,
+ WSASendDisconnect,
+ WSASendTo,
+ WSASetEvent,
+ WSASetLastError,
+ WSASocketA,
+ WSASocketW,
+ WSAStartup,
+ WSAWaitForMultipleEvents,
+ WSAAddressToStringA,
+ WSAAddressToStringW,
+ WSAEnumNameSpaceProvidersA,
+ WSAEnumNameSpaceProvidersW,
+ WSAGetServiceClassInfoA,
+ WSAGetServiceClassInfoW,
+ WSAGetServiceClassNameByClassIdA,
+ WSAGetServiceClassNameByClassIdW,
+ WSAInstallServiceClassA,
+ WSAInstallServiceClassW,
+ WSALookupServiceBeginA,
+ WSALookupServiceBeginW,
+ WSALookupServiceEnd,
+ WSALookupServiceNextA,
+ WSALookupServiceNextW,
+ WSARemoveServiceClass,
+ WSASetServiceA,
+ WSASetServiceW,
+ WSAStringToAddressA,
+ WSAStringToAddressW,
+ WSCUnInstallNameSpace,
+ WSCInstallNameSpace,
+ WS2_32_gethostbyaddr,
+ WS2_32_gethostbyname,
+ WS2_32_gethostname,
+ WS2_32_getprotobyname,
+ WS2_32_getprotobynumber,
+ WS2_32_getservbyname,
+ WS2_32_getservbyport,
+ WS2_32_inet_addr,
+ WS2_32_inet_ntoa,
+ __WSAFDIsSet,
+ WS2_32_AcceptEx,
+ WS2_32_CreateIoCompletionPort,
+ WS2_32_GetQueuedCompletionStatus,
+ WS2_32_PostQueuedCompletionStatus,
+ WS2_32_DestroyIoCompletionPort
diff --git a/rtl/objpas/README b/rtl/objpas/README
new file mode 100644
index 0000000000..4e92d01ed8
--- /dev/null
+++ b/rtl/objpas/README
@@ -0,0 +1,23 @@
+This directory contains units that are part of the Object Pascal support
+of the Free Pascal Compiler.
+
+You can find here the following files:
+
+objpas.pp : makes Free Pascal more Borland Delphi compatible, data types
+ are redefined
+
+math.pp : Contains basic mathematical functions, as well as some financial
+ functions.
+
+sysutils.pp : Contains the exception support of the Free Pascal Compiler.
+
+sysutils/*h.inc : Contain parts of the sysutils unit, with function declarations.
+sysutils/*.inc : Contain parts of the sysutils unit, with implementations of:
+ dati : Date & Time handling functions.
+ fina : FileName handling functions.
+ sysstr : miscellaneous string handling functions, and conversion
+ routines.
+ syspch : miscellaneous pchar handling functions.
+
+Enjoy !
+The Free Pascal Development Team.
diff --git a/rtl/objpas/classes/action.inc b/rtl/objpas/classes/action.inc
new file mode 100644
index 0000000000..ae86518002
--- /dev/null
+++ b/rtl/objpas/classes/action.inc
@@ -0,0 +1,193 @@
+{
+ $Id: action.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************}
+{* TBasicActionLink *}
+{****************************************************************************}
+
+constructor TBasicActionLink.Create(AClient: TObject);
+begin
+ inherited Create;
+ AssignClient(AClient);
+end;
+
+
+procedure TBasicActionLink.AssignClient(AClient: TObject);
+begin
+end;
+
+
+destructor TBasicActionLink.Destroy;
+begin
+ if FAction <> nil then
+ FAction.UnRegisterChanges(Self);
+ inherited Destroy;
+end;
+
+
+procedure TBasicActionLink.Change;
+begin
+ if Assigned(OnChange) then
+ OnChange(FAction);
+end;
+
+
+function TBasicActionLink.Execute(AComponent: TComponent): Boolean;
+begin
+ FAction.ActionComponent := AComponent;
+ try
+ Result := FAction.Execute;
+ finally
+ if FAction <> nil then
+ FAction.ActionComponent := nil;
+ end;
+end;
+
+
+procedure TBasicActionLink.SetAction(Value: TBasicAction);
+begin
+ if Value <> FAction then
+ begin
+ if FAction <> nil then FAction.UnRegisterChanges(Self);
+ FAction := Value;
+ if Value <> nil then Value.RegisterChanges(Self);
+ end;
+end;
+
+
+function TBasicActionLink.IsOnExecuteLinked: Boolean;
+begin
+ Result := True;
+end;
+
+
+procedure TBasicActionLink.SetOnExecute(Value: TNotifyEvent);
+begin
+end;
+
+
+function TBasicActionLink.Update: Boolean;
+begin
+ Result := FAction.Update;
+end;
+
+{****************************************************************************}
+{* TBasicAction *}
+{****************************************************************************}
+
+constructor TBasicAction.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FClients := TList.Create;
+end;
+
+
+destructor TBasicAction.Destroy;
+begin
+ inherited Destroy;
+ while FClients.Count > 0 do
+ UnRegisterChanges(TBasicActionLink(FClients.Last));
+ FClients.Free;
+end;
+
+
+function TBasicAction.HandlesTarget(Target: TObject): Boolean;
+begin
+ Result := False;
+end;
+
+
+procedure TBasicAction.ExecuteTarget(Target: TObject);
+begin
+end;
+
+
+procedure TBasicAction.UpdateTarget(Target: TObject);
+begin
+end;
+
+
+function TBasicAction.Execute: Boolean;
+begin
+ if Assigned(FOnExecute) then
+ begin
+ FOnExecute(Self);
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+
+function TBasicAction.Update: Boolean;
+begin
+ if Assigned(FOnUpdate) then
+ begin
+ FOnUpdate(Self);
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+
+procedure TBasicAction.SetOnExecute(Value: TNotifyEvent);
+var
+ I: Integer;
+begin
+ if (TMethod(Value).Code <> TMethod(OnExecute).Code) or
+ (TMethod(Value).Data <> TMethod(OnExecute).Data) then
+ begin
+ for I := 0 to FClients.Count - 1 do
+ TBasicActionLink(FClients[I]).SetOnExecute(Value);
+ FOnExecute := Value;
+ Change;
+ end;
+end;
+
+
+procedure TBasicAction.Change;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+
+procedure TBasicAction.RegisterChanges(Value: TBasicActionLink);
+begin
+ Value.FAction := Self;
+ FClients.Add(Value);
+end;
+
+
+procedure TBasicAction.UnRegisterChanges(Value: TBasicActionLink);
+var
+ I: Integer;
+begin
+ for I := 0 to FClients.Count - 1 do
+ if TBasicActionLink(FClients[I]) = Value then
+ begin
+ Value.FAction := nil;
+ FClients.Delete(I);
+ break;
+ end;
+end;
+
+
+{
+ $Log: action.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/bits.inc b/rtl/objpas/classes/bits.inc
new file mode 100644
index 0000000000..0ef107fd04
--- /dev/null
+++ b/rtl/objpas/classes/bits.inc
@@ -0,0 +1,381 @@
+{
+ $Id: bits.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TBits *}
+{****************************************************************************}
+
+Procedure BitsError (Msg : string);
+
+begin
+{$ifdef VER1_0}
+ Raise EBitsError.Create(Msg) at longint(get_caller_addr(get_frame));
+{$else VER1_0}
+ Raise EBitsError.Create(Msg) at get_caller_addr(get_frame);
+{$endif VER1_0}
+end;
+
+Procedure BitsErrorFmt (Msg : string; const Args : array of const);
+
+begin
+{$ifdef VER1_0}
+ Raise EBitsError.CreateFmt(Msg,args) at longint(get_caller_addr(get_frame));
+{$else VER1_0}
+ Raise EBitsError.CreateFmt(Msg,args) at get_caller_addr(get_frame);
+{$endif VER1_0}
+end;
+
+procedure TBits.CheckBitIndex (Bit : longint;CurrentSize : Boolean);
+
+begin
+ if (bit<0) or (CurrentSize and (Bit>Size)) then
+ BitsErrorFmt(SErrInvalidBitIndex,[bit]);
+ if (bit>=MaxBitFlags) then
+ BitsErrorFmt(SErrIndexTooLarge,[bit])
+
+end;
+
+{ ************* functions to match TBits class ************* }
+
+function TBits.getSize : longint;
+begin
+ result := (FSize shl BITSHIFT) - 1;
+end;
+
+procedure TBits.setSize(value : longint);
+begin
+ grow(value - 1);
+end;
+
+procedure TBits.SetBit(bit : longint; value : Boolean);
+begin
+ if value = True then
+ seton(bit)
+ else
+ clear(bit);
+end;
+
+function TBits.OpenBit : longint;
+var
+ loop : longint;
+ loop2 : longint;
+ startIndex : longint;
+begin
+ result := -1; {should only occur if the whole array is set}
+ for loop := 0 to FSize - 1 do
+ begin
+ if FBits^[loop] <> $FFFFFFFF then
+ begin
+ startIndex := loop * 32;
+ for loop2 := startIndex to startIndex + 31 do
+ begin
+ if get(loop2) = False then
+ begin
+ result := loop2;
+ break; { use this as the index to return }
+ end;
+ end;
+ break; {stop looking for empty bit in records }
+ end;
+ end;
+
+ if result = -1 then
+ if FSize < MaxBitRec then
+ result := FSize * 32; {first bit of next record}
+end;
+
+{ ******************** TBits ***************************** }
+
+constructor TBits.Create(theSize : longint {$ifndef VER1_0} = 0 {$endif});
+begin
+ FSize := 0;
+ FBits := nil;
+ findIndex := -1;
+ findState := True; { no reason just setting it to something }
+ grow(theSize);
+end;
+
+destructor TBits.Destroy;
+begin
+ if FBits <> nil then
+ FreeMem(FBits, FSize * SizeOf(longint));
+ FBits := nil;
+
+ inherited Destroy;
+end;
+
+procedure TBits.grow(nbit : longint);
+var
+ newSize : longint;
+ loop : longint;
+begin
+ CheckBitindex(nbit,false);
+
+ newSize := (nbit shr BITSHIFT) + 1;
+
+ if newSize > FSize then
+ begin
+ ReAllocMem(FBits, newSize * SizeOf(longint));
+ if FBits <> nil then
+ begin
+ if newSize > FSize then
+ for loop := FSize to newSize - 1 do
+ FBits^[loop] := 0;
+ FSize := newSize;
+ end
+ else
+ BitsError(SErrOutOfMemory);
+ end;
+end;
+
+function TBits.getFSize : longint;
+begin
+ result := FSize;
+end;
+
+procedure TBits.seton(bit : longint);
+var
+ n : longint;
+begin
+ n := bit shr BITSHIFT;
+ grow(bit);
+ FBits^[n] := FBits^[n] or (longint(1) shl (bit and MASK));
+end;
+
+procedure TBits.clear(bit : longint);
+var
+ n : longint;
+begin
+ CheckBitIndex(bit,false);
+ n := bit shr BITSHIFT;
+ grow(bit);
+ FBits^[n] := FBits^[n] and not(longint(1) shl (bit and MASK));
+end;
+
+procedure TBits.clearall;
+var
+ loop : longint;
+begin
+ for loop := 0 to FSize - 1 do
+ FBits^[loop] := 0;
+end;
+
+function TBits.get(bit : longint) : Boolean;
+var
+ n : longint;
+begin
+ CheckBitIndex(bit,true);
+ result := False;
+ n := bit shr BITSHIFT;
+ if (n < FSize) then
+ result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
+end;
+
+procedure TBits.andbits(bitset : TBits);
+var
+ n : longint;
+ loop : longint;
+begin
+ if FSize < bitset.getFSize then
+ n := FSize - 1
+ else
+ n := bitset.getFSize - 1;
+
+ for loop := 0 to n do
+ FBits^[loop] := FBits^[loop] and bitset.FBits^[loop];
+
+ for loop := n + 1 to FSize - 1 do
+ FBits^[loop] := 0;
+end;
+
+procedure TBits.notbits(bitset : TBits);
+var
+ n : longint;
+ jj : longint;
+ loop : longint;
+begin
+ if FSize < bitset.getFSize then
+ n := FSize - 1
+ else
+ n := bitset.getFSize - 1;
+
+ for loop := 0 to n do
+ begin
+ jj := FBits^[loop];
+ FBits^[loop] := FBits^[loop] and (jj xor bitset.FBits^[loop]);
+ end;
+end;
+
+procedure TBits.orbits(bitset : TBits);
+var
+ n : longint;
+ loop : longint;
+begin
+ if FSize < bitset.getFSize then
+ n := bitset.getFSize - 1
+ else
+ n := FSize - 1;
+
+ grow(n shl BITSHIFT);
+
+ for loop := 0 to n do
+ FBits^[loop] := FBits^[loop] or bitset.FBits^[loop];
+end;
+
+procedure TBits.xorbits(bitset : TBits);
+var
+ n : longint;
+ loop : longint;
+begin
+ if FSize < bitset.getFSize then
+ n := bitset.getFSize - 1
+ else
+ n := FSize - 1;
+
+ grow(n shl BITSHIFT);
+
+ for loop := 0 to n do
+ FBits^[loop] := FBits^[loop] xor bitset.FBits^[loop];
+end;
+
+function TBits.equals(bitset : TBits) : Boolean;
+var
+ n : longint;
+ loop : longint;
+begin
+ result := False;
+
+ if FSize < bitset.getFSize then
+ n := FSize - 1
+ else
+ n := bitset.getFSize - 1;
+
+ for loop := 0 to n do
+ if FBits^[loop] <> bitset.FBits^[loop] then exit;
+
+ if FSize - 1 > n then
+ begin
+ for loop := n to FSize - 1 do
+ if FBits^[loop] <> 0 then exit;
+ end
+ else if bitset.getFSize - 1 > n then
+ for loop := n to bitset.getFSize - 1 do
+ if bitset.FBits^[loop] <> 0 then exit;
+
+ result := True; {passed all tests}
+end;
+
+
+{ us this in place of calling FindFirstBit. It sets the current }
+{ index used by FindNextBit and FindPrevBit }
+
+procedure TBits.SetIndex(index : longint);
+begin
+ findIndex := index;
+end;
+
+
+{ When state is set to True it looks for bits that are turned On (1) }
+{ and when it is set to False it looks for bits that are turned }
+{ off (0). }
+
+function TBits.FindFirstBit(state : boolean) : longint;
+var
+ loop : longint;
+ loop2 : longint;
+ startIndex : longint;
+ compareVal : cardinal;
+begin
+ result := -1; {should only occur if none are set}
+
+ findState := state;
+
+ if state = False then
+ compareVal := $FFFFFFFF { looking for off bits }
+ else
+ compareVal := $00000000; { looking for on bits }
+
+ for loop := 0 to FSize - 1 do
+ begin
+ if FBits^[loop] <> compareVal then
+ begin
+ startIndex := loop * 32;
+ for loop2 := startIndex to startIndex + 31 do
+ begin
+ if get(loop2) = state then
+ begin
+ result := loop2;
+ break; { use this as the index to return }
+ end;
+ end;
+ break; {stop looking for bit in records }
+ end;
+ end;
+
+ findIndex := result;
+end;
+
+function TBits.FindNextBit : longint;
+var
+ loop : longint;
+ maxVal : longint;
+begin
+ result := -1; { will occur only if no other bits set to }
+ { current findState }
+
+ if findIndex > -1 then { must have called FindFirstBit first }
+ begin { or set the start index }
+ maxVal := (FSize * 32) - 1;
+
+ for loop := findIndex + 1 to maxVal do
+ begin
+ if get(loop) = findState then
+ begin
+ result := loop;
+ break;
+ end;
+ end;
+
+ findIndex := result;
+ end;
+end;
+
+function TBits.FindPrevBit : longint;
+var
+ loop : longint;
+begin
+ result := -1; { will occur only if no other bits set to }
+ { current findState }
+
+ if findIndex > -1 then { must have called FindFirstBit first }
+ begin { or set the start index }
+ for loop := findIndex - 1 downto 0 do
+ begin
+ if get(loop) = findState then
+ begin
+ result := loop;
+ break;
+ end;
+ end;
+
+ findIndex := result;
+ end;
+end;
+
+
+{
+ $Log: bits.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc
new file mode 100644
index 0000000000..9f8065b6c2
--- /dev/null
+++ b/rtl/objpas/classes/classes.inc
@@ -0,0 +1,1587 @@
+{
+ $Id: classes.inc,v 1.27 2005/04/28 09:15:44 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{**********************************************************************
+ * Class implementations are in separate files. *
+ **********************************************************************}
+
+var
+ ClassList : TThreadlist;
+ ClassAliasList : TStringList;
+
+{
+ Include all message strings
+
+ Add a language with IFDEF LANG_NAME
+ just befor the final ELSE. This way English will always be the default.
+}
+
+{$IFDEF LANG_GERMAN}
+{$i constsg.inc}
+{$ELSE}
+{$IFDEF LANG_SPANISH}
+{$i constss.inc}
+{$ENDIF}
+{$ENDIF}
+
+{ Utility routines }
+{$i util.inc}
+
+{ TBits implementation }
+{$i bits.inc}
+
+{ All streams implementations: }
+{ Tstreams THandleStream TFileStream TResourcseStreams TStringStream }
+{ TCustomMemoryStream TMemoryStream }
+{$i streams.inc}
+
+{ TParser implementation}
+{$i parser.inc}
+
+{ TCollection and TCollectionItem implementations }
+{$i collect.inc}
+
+{ TList and TThreadList implementations }
+{$i lists.inc}
+
+{ TStrings and TStringList implementations }
+{$i stringl.inc}
+
+{$ifndef VER1_0}
+{ TThread implementation }
+
+{ system dependend code }
+{$i tthread.inc}
+
+{ system independend threading code }
+var
+ { event that happens when gui thread is done executing the method}
+ ExecuteEvent: PRtlEvent;
+ { event executed by synchronize to wake main thread if it sleeps in CheckSynchronize }
+ SynchronizeTimeoutEvent: PRtlEvent;
+ { guard for synchronization variables }
+ SynchronizeCritSect: TRtlCriticalSection;
+ { method to execute }
+ SynchronizeMethod: TThreadMethod;
+ { should we execute the method? }
+ DoSynchronizeMethod: boolean;
+ { caught exception in gui thread, to be raised in calling thread }
+ SynchronizeException: Exception;
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+ var
+ LocalSyncException: Exception;
+ begin
+ { do we really need a synchronized call? }
+ if GetCurrentThreadID=MainThreadID then
+ Method()
+ else
+ begin
+ EnterCriticalSection(SynchronizeCritSect);
+ RtlEventStartWait(ExecuteEvent);
+ SynchronizeException:=nil;
+ SynchronizeMethod:=Method;
+
+ { be careful, after this assignment Method could be already executed }
+ DoSynchronizeMethod:=true;
+
+ RtlEventSetEvent(SynchronizeTimeoutEvent);
+
+ if assigned(WakeMainThread) then
+ WakeMainThread(self);
+
+ { wait infinitely }
+ RtlEventWaitFor(ExecuteEvent);
+ LocalSyncException:=SynchronizeException;
+ LeaveCriticalSection(SynchronizeCritSect);
+ if assigned(LocalSyncException) then
+ raise LocalSyncException;
+ end;
+ end;
+
+
+procedure CheckSynchronize(timeout : longint=0);
+ { assumes being called from GUI thread }
+ begin
+ { sanity check }
+ if GetCurrentThreadID<>MainThreadID then
+ raise EThread.CreateFmt(SCheckSynchronizeError,[GetCurrentThreadID])
+ else
+ begin
+ if timeout>0 then
+ begin
+ RtlEventStartWait(SynchronizeTimeoutEvent);
+ RtlEventWaitFor(SynchronizeTimeoutEvent,timeout);
+ end
+ else
+ RtlEventResetEvent(SynchronizeTimeoutEvent);
+
+ if DoSynchronizeMethod then
+ begin
+ try
+ SynchronizeMethod;
+ except
+ SynchronizeException:=Exception(AcquireExceptionObject);
+ end;
+ DoSynchronizeMethod:=false;
+ RtlEventSetEvent(ExecuteEvent);
+ end;
+ end;
+ end;
+
+{$endif}
+
+{ TPersistent implementation }
+{$i persist.inc }
+
+{ TComponent implementation }
+{$i compon.inc}
+
+{ TBasicAction implementation }
+{$i action.inc}
+
+{ TDataModule implementation }
+{$i dm.inc}
+
+{ Class and component registration routines }
+{$I cregist.inc}
+
+
+
+{ Interface related stuff }
+{$ifdef HASINTF}
+{$I intf.inc}
+{$endif HASINTF}
+
+{**********************************************************************
+ * Miscellaneous procedures and functions *
+ **********************************************************************}
+
+{ Point and rectangle constructors }
+
+function Point(AX, AY: Integer): TPoint;
+
+begin
+ with Result do
+ begin
+ X := AX;
+ Y := AY;
+ end;
+end;
+
+
+function SmallPoint(AX, AY: SmallInt): TSmallPoint;
+
+begin
+ with Result do
+ begin
+ X := AX;
+ Y := AY;
+ end;
+end;
+
+
+function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
+
+begin
+ with Result do
+ begin
+ Left := ALeft;
+ Top := ATop;
+ Right := ARight;
+ Bottom := ABottom;
+ end;
+end;
+
+
+function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
+
+begin
+ with Result do
+ begin
+ Left := ALeft;
+ Top := ATop;
+ Right := ALeft + AWidth;
+ Bottom := ATop + AHeight;
+ end;
+end;
+
+
+
+
+
+{ Object filing routines }
+
+var
+ IntConstList: TThreadList;
+
+
+type
+ TIntConst = class
+ IntegerType: PTypeInfo; // The integer type RTTI pointer
+ IdentToIntFn: TIdentToInt; // Identifier to Integer conversion
+ IntToIdentFn: TIntToIdent; // Integer to Identifier conversion
+ constructor Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
+ AIntToIdent: TIntToIdent);
+ end;
+
+constructor TIntConst.Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
+ AIntToIdent: TIntToIdent);
+begin
+ IntegerType := AIntegerType;
+ IdentToIntFn := AIdentToInt;
+ IntToIdentFn := AIntToIdent;
+end;
+
+procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;
+ IntToIdentFn: TIntToIdent);
+begin
+ IntConstList.Add(TIntConst.Create(IntegerType, IdentToIntFn, IntToIdentFn));
+end;
+
+function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
+var
+ i: Integer;
+begin
+ with IntConstList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ if TIntConst(Items[i]).IntegerType = AIntegerType then
+ exit(TIntConst(Items[i]).IntToIdentFn);
+ Result := nil;
+ finally
+ IntConstList.UnlockList;
+ end;
+end;
+
+function FindIdentToInt(AIntegerType: Pointer): TIdentToInt;
+var
+ i: Integer;
+begin
+ with IntConstList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ with TIntConst(Items[I]) do
+ if TIntConst(Items[I]).IntegerType = AIntegerType then
+ exit(IdentToIntFn);
+ Result := nil;
+ finally
+ IntConstList.UnlockList;
+ end;
+end;
+
+function IdentToInt(const Ident: String; var Int: LongInt;
+ const Map: array of TIdentMapEntry): Boolean;
+var
+ i: Integer;
+begin
+ for i := Low(Map) to High(Map) do
+ if CompareText(Map[i].Name, Ident) = 0 then
+ begin
+ Int := Map[i].Value;
+ exit(True);
+ end;
+ Result := False;
+end;
+
+function IntToIdent(Int: LongInt; var Ident: String;
+ const Map: array of TIdentMapEntry): Boolean;
+var
+ i: Integer;
+begin
+ for i := Low(Map) to High(Map) do
+ if Map[i].Value = Int then
+ begin
+ Ident := Map[i].Name;
+ exit(True);
+ end;
+ Result := False;
+end;
+
+function GlobalIdentToInt(const Ident: String; var Int: LongInt):boolean;
+var
+ i : Integer;
+begin
+ with IntConstList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ if TIntConst(Items[I]).IdentToIntFn(Ident, Int) then
+ Exit(True);
+ Result := false;
+ finally
+ IntConstList.UnlockList;
+ end;
+end;
+
+{ TPropFixup }
+
+type
+ TPropFixup = class
+ FInstance: TPersistent;
+ FInstanceRoot: TComponent;
+ FPropInfo: PPropInfo;
+ FRootName: string;
+ FName: string;
+ constructor Create(AInstance: TPersistent; AInstanceRoot: TComponent;
+ APropInfo: PPropInfo; const ARootName, AName: String);
+ function MakeGlobalReference: Boolean;
+ end;
+
+var
+ GlobalFixupList: TThreadList;
+
+constructor TPropFixup.Create(AInstance: TPersistent; AInstanceRoot: TComponent;
+ APropInfo: PPropInfo; const ARootName, AName: String);
+begin
+ FInstance := AInstance;
+ FInstanceRoot := AInstanceRoot;
+ FPropInfo := APropInfo;
+ FRootName := ARootName;
+ FName := AName;
+end;
+
+function TPropFixup.MakeGlobalReference: Boolean;
+var
+ i: Integer;
+begin
+ i := Pos('.', FName);
+ if i = 0 then
+ exit(False);
+ FRootName := Copy(FName, 1, i - 1);
+ FName := Copy(FName, i + 1, Length(FName));
+ Result := True;
+end;
+
+Type
+ TInitHandler = Class(TObject)
+ AHandler : TInitComponentHandler;
+ AClass : TComponentClass;
+ end;
+
+Var
+ InitHandlerList : TList;
+ FindGlobalComponentList : TList;
+
+procedure RegisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
+ begin
+ if not(assigned(FindGlobalComponentList)) then
+ FindGlobalComponentList:=TList.Create;
+ if FindGlobalComponentList.IndexOf(Pointer(AFindGlobalComponent))<0 then
+ FindGlobalComponentList.Add(Pointer(AFindGlobalComponent));
+ end;
+
+
+procedure UnregisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
+ begin
+ if assigned(FindGlobalComponentList) then
+ FindGlobalComponentList.Remove(Pointer(AFindGlobalComponent));
+ end;
+
+
+function FindGlobalComponent(const Name: string): TComponent;
+ var
+ i : sizeint;
+ begin
+ FindGlobalComponent:=nil;
+ if assigned(FindGlobalComponentList) then
+ begin
+ for i:=FindGlobalComponentList.Count-1 downto 0 do
+ begin
+ FindGlobalComponent:=TFindGlobalComponent(FindGlobalComponentList[i])(name);
+ if assigned(FindGlobalComponent) then
+ break;
+ end;
+ end;
+ end;
+
+
+procedure RegisterInitComponentHandler(ComponentClass: TComponentClass; Handler: TInitComponentHandler);
+
+Var
+ I : Integer;
+ H: TInitHandler;
+
+begin
+ If (InitHandlerList=Nil) then
+ InitHandlerList:=TList.Create;
+ H:=TInitHandler.Create;
+ H.Aclass:=ComponentClass;
+ H.AHandler:=Handler;
+ With InitHandlerList do
+ begin
+ I:=0;
+ While (I<Count) and not H.AClass.InheritsFrom(TInitHandler(Items[i]).AClass) do
+ Inc(I);
+ InitHandlerList.Insert(I,H);
+ end;
+end;
+
+function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
+
+Var
+ I : Integer;
+
+begin
+ I:=0;
+ if not Assigned(InitHandlerList) then begin
+ Result := True;
+ Exit;
+ end;
+ Result:=False;
+ With InitHandlerList do
+ begin
+ I:=0;
+ // Instance is the normally the lowest one, so that one should be used when searching.
+ While Not result and (I<Count) do
+ begin
+ If (Instance.InheritsFrom(TInitHandler(Items[i]).AClass)) then
+ Result:=TInitHandler(Items[i]).AHandler(Instance,RootAncestor);
+ Inc(I);
+ end;
+ end;
+end;
+
+
+function InitComponentRes(const ResName: String; Instance: TComponent): Boolean;
+
+begin
+ { !!!: Too Win32-specific }
+ InitComponentRes := False;
+end;
+
+
+function ReadComponentRes(const ResName: String; Instance: TComponent): TComponent;
+
+begin
+ { !!!: Too Win32-specific }
+ ReadComponentRes := nil;
+end;
+
+
+function ReadComponentResEx(HInstance: THandle; const ResName: String): TComponent;
+
+begin
+ { !!!: Too Win32-specific in VCL }
+ ReadComponentResEx := nil;
+end;
+
+
+function ReadComponentResFile(const FileName: String; Instance: TComponent): TComponent;
+var
+ FileStream: TStream;
+begin
+ FileStream := TFileStream.Create(FileName, fmOpenRead {!!!:or fmShareDenyWrite});
+ try
+ Result := FileStream.ReadComponentRes(Instance);
+ finally
+ FileStream.Free;
+ end;
+end;
+
+
+procedure WriteComponentResFile(const FileName: String; Instance: TComponent);
+var
+ FileStream: TStream;
+begin
+ FileStream := TFileStream.Create(FileName, fmCreate);
+ try
+ FileStream.WriteComponentRes(Instance.ClassName, Instance);
+ finally
+ FileStream.Free;
+ end;
+end;
+
+
+procedure GlobalFixupReferences;
+var
+ GlobalList, DoneList, ToDoList: TList;
+ I, Index: Integer;
+ Root: TComponent;
+ Instance: TPersistent;
+ Reference: Pointer;
+begin
+ {!!!: GlobalNameSpace.BeginWrite;
+ try}
+ GlobalList := GlobalFixupList.LockList;
+ try
+ if GlobalList.Count > 0 then
+ begin
+ ToDoList := nil;
+ DoneList := TList.Create;
+ ToDoList := TList.Create;
+ try
+ i := 0;
+ while i < GlobalList.Count do
+ with TPropFixup(GlobalList[i]) do
+ begin
+ Root := FindGlobalComponent(FRootName);
+ if Assigned(Root) or (GetOrdProp(FInstance, FPropInfo) <> 0) then
+ begin
+ if Assigned(Root) then
+ begin
+ Reference := FindNestedComponent(Root, FName);
+ SetOrdProp(FInstance, FPropInfo, Longint(Reference));
+ end;
+ // Move component to list of done components, if necessary
+ if (DoneList.IndexOf(FInstance) < 0) and
+ (ToDoList.IndexOf(FInstance) >= 0) then
+ DoneList.Add(FInstance);
+ GlobalList.Delete(i);
+ Free; // ...the fixup
+ end else
+ begin
+ // Move component to list of components to process, if necessary
+ Index := DoneList.IndexOf(FInstance);
+ if Index <> -1 then
+ DoneList.Delete(Index);
+ if ToDoList.IndexOf(FInstance) < 0 then
+ ToDoList.Add(FInstance);
+ Inc(i);
+ end;
+ end;
+ for i := 0 to DoneList.Count - 1 do
+ begin
+ Instance := TPersistent(DoneList[I]);
+ if Instance.InheritsFrom(TComponent) then
+ Exclude(TComponent(Instance).FComponentState, csFixups);
+ end;
+ finally
+ ToDoList.Free;
+ DoneList.Free;
+ end;
+ end;
+ finally
+ GlobalFixupList.UnlockList;
+ end;
+ {finally
+ GlobalNameSpace.EndWrite;
+ end;}
+end;
+
+
+function IsStringInList(const AString: String; AList: TStrings): Boolean;
+var
+ i: Integer;
+begin
+ for i := 0 to AList.Count - 1 do
+ if CompareText(AList[i], AString) = 0 then
+ exit(True);
+ Result := False;
+end;
+
+
+procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
+var
+ i: Integer;
+ CurFixup: TPropFixup;
+begin
+ with GlobalFixupList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ begin
+ CurFixup := TPropFixup(Items[i]);
+ if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+ not IsStringInList(CurFixup.FRootName, Names) then
+ Names.Add(CurFixup.FRootName);
+ end;
+ finally
+ GlobalFixupList.UnlockList;
+ end;
+end;
+
+
+procedure GetFixupInstanceNames(Root: TComponent;
+ const ReferenceRootName: string; Names: TStrings);
+var
+ i: Integer;
+ CurFixup: TPropFixup;
+begin
+ with GlobalFixupList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ begin
+ CurFixup := TPropFixup(Items[i]);
+ if (CurFixup.FInstanceRoot = Root) and
+ (UpperCase(ReferenceRootName) = UpperCase(CurFixup.FRootName)) and
+ not IsStringInList(CurFixup.FName, Names) then
+ Names.Add(CurFixup.FName);
+ end;
+ finally
+ GlobalFixupList.UnlockList;
+ end;
+end;
+
+
+procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
+ NewRootName: string);
+var
+ i: Integer;
+ CurFixup: TPropFixup;
+begin
+ with GlobalFixupList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ begin
+ CurFixup := TPropFixup(Items[i]);
+ if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+ (UpperCase(OldRootName) = UpperCase(CurFixup.FRootName)) then
+ CurFixup.FRootName := NewRootName;
+ end;
+ GlobalFixupReferences;
+ finally
+ GlobalFixupList.Unlocklist;
+ end;
+end;
+
+
+procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
+var
+ i: Integer;
+ CurFixup: TPropFixup;
+begin
+ if not Assigned(GlobalFixupList) then
+ exit;
+
+ with GlobalFixupList.LockList do
+ try
+ for i := Count - 1 downto 0 do
+ begin
+ CurFixup := TPropFixup(Items[i]);
+ if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+ ((Length(RootName) = 0) or
+ (UpperCase(RootName) = UpperCase(CurFixup.FRootName))) then
+ begin
+ Delete(i);
+ CurFixup.Free;
+ end;
+ end;
+ finally
+ GlobalFixupList.UnlockList;
+ end;
+end;
+
+
+procedure RemoveFixups(Instance: TPersistent);
+var
+ i: Integer;
+ CurFixup: TPropFixup;
+begin
+ if not Assigned(GlobalFixupList) then
+ exit;
+
+ with GlobalFixupList.LockList do
+ try
+ for i := Count - 1 downto 0 do
+ begin
+ CurFixup := TPropFixup(Items[i]);
+ if (CurFixup.FInstance = Instance) then
+ begin
+ Delete(i);
+ CurFixup.Free;
+ end;
+ end;
+ finally
+ GlobalFixupList.UnlockList;
+ end;
+end;
+
+
+function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
+var
+ Current, Found: TComponent;
+ s, p: PChar;
+ Name: String;
+begin
+ Result := nil;
+ if Length(NamePath) > 0 then
+ begin
+ Current := Root;
+ p := PChar(NamePath);
+ while p[0] <> #0 do
+ begin
+ s := p;
+ while not (p^ in ['.', '-', #0]) do
+ Inc(p);
+ SetString(Name, s, p - s);
+ Found := Current.FindComponent(Name);
+ if (not Assigned(Found)) and (UpperCase(Name) = 'OWNER') then
+ Found := Current;
+ if not Assigned(Found) then exit;
+
+ // Remove the dereference operator from the name
+ if p[0] = '.' then
+ Inc(P);
+ if p[0] = '-' then
+ Inc(P);
+ if p[0] = '>' then
+ Inc(P);
+
+ Current := Found;
+ end;
+ end;
+ Result := Current;
+end;
+
+{!!!: Should be threadvar - doesn't work for all platforms yet!}
+var
+ GlobalLoaded, GlobalLists: TList;
+
+
+procedure BeginGlobalLoading;
+
+begin
+ if not Assigned(GlobalLists) then
+ GlobalLists := TList.Create;
+ GlobalLists.Add(GlobalLoaded);
+ GlobalLoaded := TList.Create;
+end;
+
+
+{ Notify all global components that they have been loaded completely }
+procedure NotifyGlobalLoading;
+var
+ i: Integer;
+begin
+ for i := 0 to GlobalLoaded.Count - 1 do
+ TComponent(GlobalLoaded[i]).Loaded;
+end;
+
+
+procedure EndGlobalLoading;
+begin
+ { Free the memory occupied by BeginGlobalLoading }
+ GlobalLoaded.Free;
+ GlobalLoaded := TList(GlobalLists.Last);
+ GlobalLists.Delete(GlobalLists.Count - 1);
+ if GlobalLists.Count = 0 then
+ begin
+ GlobalLists.Free;
+ GlobalLists := nil;
+ end;
+end;
+
+
+function CollectionsEqual(C1, C2: TCollection): Boolean;
+begin
+ // !!!: Implement this
+ CollectionsEqual:=false;
+end;
+
+
+
+{ Object conversion routines }
+
+type
+ CharToOrdFuncty = Function(var charpo: Pointer): Cardinal;
+
+function CharToOrd(var P: Pointer): Cardinal;
+begin
+ result:= ord(pchar(P)^);
+ inc(pchar(P));
+end;
+
+{$ifdef HASWIDESTRING}
+function WideCharToOrd(var P: Pointer): Cardinal;
+begin
+ result:= ord(pwidechar(P)^);
+ inc(pwidechar(P));
+end;
+{$endif HASWIDESTRING}
+
+function Utf8ToOrd(var P:Pointer): Cardinal;
+begin
+ // Should also check for illegal utf8 combinations
+ Result := Ord(PChar(P)^);
+ Inc(P);
+ if (Result and $80) <> 0 then
+ if (Ord(Result) and %11100000) = %11000000 then begin
+ Result := ((Result and %00011111) shl 6)
+ or (ord(PChar(P)^) and %00111111);
+ Inc(P);
+ end else if (Ord(Result) and %11110000) = %11100000 then begin
+ Result := ((Result and %00011111) shl 12)
+ or ((ord(PChar(P)^) and %00111111) shl 6)
+ or (ord((PChar(P)+1)^) and %00111111);
+ Inc(P,2);
+ end else begin
+ Result := ((ord(Result) and %00011111) shl 18)
+ or ((ord(PChar(P)^) and %00111111) shl 12)
+ or ((ord((PChar(P)+1)^) and %00111111) shl 6)
+ or (ord((PChar(P)+2)^) and %00111111);
+ Inc(P,3);
+ end;
+end;
+
+procedure ObjectBinaryToText(Input, Output: TStream);
+
+ procedure OutStr(s: String);
+ begin
+ if Length(s) > 0 then
+ Output.Write(s[1], Length(s));
+ end;
+
+ procedure OutLn(s: String);
+ begin
+ OutStr(s + #10);
+ end;
+
+ procedure Outchars(P, LastP : Pointer; CharToOrdFunc: CharToOrdFuncty);
+
+ var
+ res, NewStr: String;
+ w: Cardinal;
+ InString, NewInString: Boolean;
+ begin
+ res := '';
+ InString := False;
+ while P < LastP do begin
+ NewInString := InString;
+ w := CharToOrdfunc(P);
+ if w = ord('''') then //quote char
+ if InString then NewStr := ''''''
+ else NewStr := ''''''''
+ else if (Ord(w) >= 32) and (Ord(w) < 127) then begin //printable ascii
+ if not InString then
+ NewInString := True;
+ NewStr := char(w);
+ end else begin //ascii control chars, non ascii
+ if InString then
+ NewInString := False;
+ NewStr := '#' + IntToStr(w);
+ end;
+ if NewInString <> InString then begin
+ NewStr := '''' + NewStr;
+ InString := NewInString;
+ end;
+ res := res + NewStr;
+ end;
+ if InString then res := res + '''';
+ OutStr(res);
+ end;
+
+ procedure OutString(s: String);
+
+ begin
+ OutChars(Pointer(S),PChar(S)+Length(S),@CharToOrd);
+ end;
+
+ procedure OutWString(W: WideString);
+
+ begin
+{$ifdef HASWIDESTRING}
+ OutChars(Pointer(W),pwidechar(W)+Length(W),@WideCharToOrd);
+{$endif HASWIDESTRING}
+ end;
+
+ procedure OutUtf8Str(s: String);
+ begin
+ OutChars(Pointer(S),PChar(S)+Length(S),@Utf8ToOrd);
+ end;
+
+ function ReadInt(ValueType: TValueType): LongInt;
+ begin
+ case ValueType of
+ vaInt8: Result := ShortInt(Input.ReadByte);
+ vaInt16: Result := SmallInt(Input.ReadWord);
+ vaInt32: Result := LongInt(Input.ReadDWord);
+ end;
+ end;
+
+ function ReadInt: LongInt;
+ begin
+ Result := ReadInt(TValueType(Input.ReadByte));
+ end;
+
+ function ReadSStr: String;
+ var
+ len: Byte;
+ begin
+ len := Input.ReadByte;
+ SetLength(Result, len);
+ Input.Read(Result[1], len);
+ end;
+
+ function ReadLStr: String;
+ var
+ len: DWord;
+ begin
+ len := Input.ReadDWord;
+ SetLength(Result, len);
+ Input.Read(Result[1], len);
+ end;
+
+ function ReadWStr: WideString;
+ var
+ len: DWord;
+ begin
+{$ifdef HASWIDESTRING}
+ len := Input.ReadDWord;
+ SetLength(Result, len);
+ Input.Read(Pointer(@Result[1])^, len*2);
+{$endif HASWIDESTRING}
+ end;
+
+ procedure ReadPropList(indent: String);
+
+ procedure ProcessValue(ValueType: TValueType; Indent: String);
+
+ procedure Stop(s: String);
+ begin
+ WriteLn(s);
+ Halt;
+ end;
+
+ procedure ProcessBinary;
+ var
+ ToDo, DoNow, i: LongInt;
+ lbuf: array[0..31] of Byte;
+ s: String;
+ begin
+ ToDo := Input.ReadDWord;
+ OutLn('{');
+ while ToDo > 0 do begin
+ DoNow := ToDo;
+ if DoNow > 32 then DoNow := 32;
+ Dec(ToDo, DoNow);
+ s := Indent + ' ';
+ Input.Read(lbuf, DoNow);
+ for i := 0 to DoNow - 1 do
+ s := s + IntToHex(lbuf[i], 2);
+ OutLn(s);
+ end;
+ OutLn(indent + '}');
+ end;
+
+ var
+ s: String;
+{ len: LongInt; }
+ IsFirst: Boolean;
+ ext: Extended;
+
+ begin
+ case ValueType of
+ vaList: begin
+ OutStr('(');
+ IsFirst := True;
+ while True do begin
+ ValueType := TValueType(Input.ReadByte);
+ if ValueType = vaNull then break;
+ if IsFirst then begin
+ OutLn('');
+ IsFirst := False;
+ end;
+ OutStr(Indent + ' ');
+ ProcessValue(ValueType, Indent + ' ');
+ end;
+ OutLn(Indent + ')');
+ end;
+ vaInt8: OutLn(IntToStr(ShortInt(Input.ReadByte)));
+ vaInt16: OutLn( IntToStr(SmallInt(Input.ReadWord)));
+ vaInt32: OutLn(IntToStr(LongInt(Input.ReadDWord)));
+ vaExtended: begin
+ Input.Read(ext, SizeOf(ext));
+ OutLn(FloatToStr(ext));
+ end;
+ vaString: begin
+ OutString(ReadSStr);
+ OutLn('');
+ end;
+ vaIdent: OutLn(ReadSStr);
+ vaFalse: OutLn('False');
+ vaTrue: OutLn('True');
+ vaBinary: ProcessBinary;
+ vaSet: begin
+ OutStr('[');
+ IsFirst := True;
+ while True do begin
+ s := ReadSStr;
+ if Length(s) = 0 then break;
+ if not IsFirst then OutStr(', ');
+ IsFirst := False;
+ OutStr(s);
+ end;
+ OutLn(']');
+ end;
+ vaLString:
+ begin
+ OutString(ReadLStr);
+ OutLn('');
+ end;
+ vaWString:
+ begin
+ OutWString(ReadWStr);
+ OutLn('');
+ end;
+ vaNil:
+ OutLn('nil');
+ vaCollection: begin
+ OutStr('<');
+ while Input.ReadByte <> 0 do begin
+ OutLn(Indent);
+ Input.Seek(-1, soFromCurrent);
+ OutStr(indent + ' item');
+ ValueType := TValueType(Input.ReadByte);
+ if ValueType <> vaList then
+ OutStr('[' + IntToStr(ReadInt(ValueType)) + ']');
+ OutLn('');
+ ReadPropList(indent + ' ');
+ OutStr(indent + ' end');
+ end;
+ OutLn('>');
+ end;
+ {vaSingle: begin OutLn('!!Single!!'); exit end;
+ vaCurrency: begin OutLn('!!Currency!!'); exit end;
+ vaDate: begin OutLn('!!Date!!'); exit end;}
+ vaUTF8String: begin
+ OutUtf8Str(ReadLStr);
+ OutLn('');
+ end;
+ else
+ Stop(IntToStr(Ord(ValueType)));
+ end;
+ end;
+
+ begin
+ while Input.ReadByte <> 0 do begin
+ Input.Seek(-1, soFromCurrent);
+ OutStr(indent + ReadSStr + ' = ');
+ ProcessValue(TValueType(Input.ReadByte), Indent);
+ end;
+ end;
+
+ procedure ReadObject(indent: String);
+ var
+ b: Byte;
+ ObjClassName, ObjName: String;
+ ChildPos: LongInt;
+ begin
+ // Check for FilerFlags
+ b := Input.ReadByte;
+ if (b and $f0) = $f0 then begin
+ if (b and 2) <> 0 then ChildPos := ReadInt;
+ end else begin
+ b := 0;
+ Input.Seek(-1, soFromCurrent);
+ end;
+
+ ObjClassName := ReadSStr;
+ ObjName := ReadSStr;
+
+ OutStr(Indent);
+ if (b and 1) <> 0 then OutStr('inherited')
+ else
+ if (b and 4) <> 0 then OutStr('inline')
+ else OutStr('object');
+ OutStr(' ');
+ if ObjName <> '' then
+ OutStr(ObjName + ': ');
+ OutStr(ObjClassName);
+ if (b and 2) <> 0 then OutStr('[' + IntToStr(ChildPos) + ']');
+ OutLn('');
+
+ ReadPropList(indent + ' ');
+
+ while Input.ReadByte <> 0 do begin
+ Input.Seek(-1, soFromCurrent);
+ ReadObject(indent + ' ');
+ end;
+ OutLn(indent + 'end');
+ end;
+
+type
+ PLongWord = ^LongWord;
+const
+ signature: PChar = 'TPF0';
+begin
+ if Input.ReadDWord <> PLongWord(Pointer(signature))^ then
+ raise EReadError.Create('Illegal stream image' {###SInvalidImage});
+ ReadObject('');
+end;
+
+
+procedure ObjectTextToBinary(Input, Output: TStream);
+var
+ parser: TParser;
+
+ procedure WriteString(s: String);
+ begin
+ Output.WriteByte(Length(s));
+ if Length(s) > 0 then
+ Output.Write(s[1], Length(s));
+ end;
+
+ procedure WriteLString(Const s: String);
+ begin
+ Output.WriteDWord(Length(s));
+ if Length(s) > 0 then
+ Output.Write(s[1], Length(s));
+ end;
+
+{$ifdef HASWIDESTRING}
+ procedure WriteWString(Const s: WideString);
+ begin
+ Output.WriteDWord(Length(s));
+ if Length(s) > 0 then
+ Output.Write(s[1], Length(s)*sizeof(widechar));
+ end;
+{$endif HASWIDESTRING}
+
+ procedure WriteInteger(value: LongInt);
+ begin
+ if (value >= -128) and (value <= 127) then begin
+ Output.WriteByte(Ord(vaInt8));
+ Output.WriteByte(Byte(value));
+ end else if (value >= -32768) and (value <= 32767) then begin
+ Output.WriteByte(Ord(vaInt16));
+ Output.WriteWord(Word(value));
+ end else begin
+ Output.WriteByte(ord(vaInt32));
+ Output.WriteDWord(LongWord(value));
+ end;
+ end;
+
+ procedure ProcessProperty; forward;
+
+ procedure ProcessValue;
+ var
+ flt: Extended;
+ s: String;
+{$ifdef HASWIDESTRING}
+ ws: WideString;
+{$else}
+ ws : Ansistring;
+{$endif HASWIDESTRING}
+ stream: TMemoryStream;
+ i: Integer;
+ b: Boolean;
+ begin
+ case parser.Token of
+ toInteger:
+ begin
+ WriteInteger(parser.TokenInt);
+ parser.NextToken;
+ end;
+ toFloat:
+ begin
+ Output.WriteByte(Ord(vaExtended));
+ flt := Parser.TokenFloat;
+ Output.Write(flt, SizeOf(flt));
+ parser.NextToken;
+ end;
+ toString:
+ begin
+{$ifdef HASWIDESTRING}
+ ws := parser.TokenWideString;
+ while parser.NextToken = '+' do
+ begin
+ parser.NextToken; // Get next string fragment
+ parser.CheckToken(toString);
+ ws := ws + parser.TokenWideString;
+ end;
+ b:= false;
+ for i:= 1 to length(ws) do begin
+ if ord(ws[i]) and $ff00 <> 0 then begin
+ b:= true;
+ break;
+ end;
+ end;
+ if b then begin
+ Output.WriteByte(Ord(vaWstring));
+ WriteWString(ws);
+ end
+ else
+{$else HASWIDESTRING}
+ ws := parser.TokenString;
+ while parser.NextToken = '+' do
+ begin
+ parser.NextToken; // Get next string fragment
+ parser.CheckToken(toString);
+ ws := ws + parser.TokenString;
+ end;
+{$endif HASWIDESTRING}
+ begin
+ setlength(s,length(ws));
+ for i:= 1 to length(s) do begin
+ s[i]:= ws[i]; //cut msb
+ end;
+ if (length(S)>255) then begin
+ Output.WriteByte(Ord(vaLString));
+ WriteLString(S);
+ end
+ else begin
+ Output.WriteByte(Ord(vaString));
+ WriteString(s);
+ end;
+ end;
+ end;
+ toSymbol:
+ begin
+ if CompareText(parser.TokenString, 'True') = 0 then
+ Output.WriteByte(Ord(vaTrue))
+ else if CompareText(parser.TokenString, 'False') = 0 then
+ Output.WriteByte(Ord(vaFalse))
+ else if CompareText(parser.TokenString, 'nil') = 0 then
+ Output.WriteByte(Ord(vaNil))
+ else
+ begin
+ Output.WriteByte(Ord(vaIdent));
+ WriteString(parser.TokenComponentIdent);
+ end;
+ Parser.NextToken;
+ end;
+ // Set
+ '[':
+ begin
+ parser.NextToken;
+ Output.WriteByte(Ord(vaSet));
+ if parser.Token <> ']' then
+ while True do
+ begin
+ parser.CheckToken(toSymbol);
+ WriteString(parser.TokenString);
+ parser.NextToken;
+ if parser.Token = ']' then
+ break;
+ parser.CheckToken(',');
+ parser.NextToken;
+ end;
+ Output.WriteByte(0);
+ parser.NextToken;
+ end;
+ // List
+ '(':
+ begin
+ parser.NextToken;
+ Output.WriteByte(Ord(vaList));
+ while parser.Token <> ')' do
+ ProcessValue;
+ Output.WriteByte(0);
+ parser.NextToken;
+ end;
+ // Collection
+ '<':
+ begin
+ parser.NextToken;
+ Output.WriteByte(Ord(vaCollection));
+ while parser.Token <> '>' do
+ begin
+ parser.CheckTokenSymbol('item');
+ parser.NextToken;
+ // ConvertOrder
+ Output.WriteByte(Ord(vaList));
+ while not parser.TokenSymbolIs('end') do
+ ProcessProperty;
+ parser.NextToken; // Skip 'end'
+ Output.WriteByte(0);
+ end;
+ Output.WriteByte(0);
+ parser.NextToken;
+ end;
+ // Binary data
+ '{':
+ begin
+ Output.WriteByte(Ord(vaBinary));
+ stream := TMemoryStream.Create;
+ try
+ parser.HexToBinary(stream);
+ Output.WriteDWord(stream.Size);
+ Output.Write(Stream.Memory^, stream.Size);
+ finally
+ stream.Free;
+ end;
+ parser.NextToken;
+ end;
+ else
+ parser.Error(SInvalidProperty);
+ end;
+ end;
+
+ procedure ProcessProperty;
+ var
+ name: String;
+ begin
+ // Get name of property
+ parser.CheckToken(toSymbol);
+ name := parser.TokenString;
+ while True do begin
+ parser.NextToken;
+ if parser.Token <> '.' then break;
+ parser.NextToken;
+ parser.CheckToken(toSymbol);
+ name := name + '.' + parser.TokenString;
+ end;
+ WriteString(name);
+ parser.CheckToken('=');
+ parser.NextToken;
+ ProcessValue;
+ end;
+
+ procedure ProcessObject;
+ var
+ Flags: Byte;
+ ObjectName, ObjectType: String;
+ ChildPos: Integer;
+ begin
+ if parser.TokenSymbolIs('OBJECT') then
+ Flags :=0 { IsInherited := False }
+ else begin
+ if parser.TokenSymbolIs('INHERITED') then
+ Flags := 1 { IsInherited := True; }
+ else begin
+ parser.CheckTokenSymbol('INLINE');
+ Flags := 4;
+ end;
+ end;
+ parser.NextToken;
+ parser.CheckToken(toSymbol);
+ ObjectName := '';
+ ObjectType := parser.TokenString;
+ parser.NextToken;
+ if parser.Token = ':' then begin
+ parser.NextToken;
+ parser.CheckToken(toSymbol);
+ ObjectName := ObjectType;
+ ObjectType := parser.TokenString;
+ parser.NextToken;
+ if parser.Token = '[' then begin
+ parser.NextToken;
+ ChildPos := parser.TokenInt;
+ parser.NextToken;
+ parser.CheckToken(']');
+ parser.NextToken;
+ Flags := Flags or 2;
+ end;
+ end;
+ if Flags <> 0 then begin
+ Output.WriteByte($f0 or Flags);
+ if (Flags and 2) <> 0 then
+ WriteInteger(ChildPos);
+ end;
+ WriteString(ObjectType);
+ WriteString(ObjectName);
+
+ // Convert property list
+ while not (parser.TokenSymbolIs('END') or
+ parser.TokenSymbolIs('OBJECT') or
+ parser.TokenSymbolIs('INHERITED') or
+ parser.TokenSymbolIs('INLINE')) do
+ ProcessProperty;
+ Output.WriteByte(0); // Terminate property list
+
+ // Convert child objects
+ while not parser.TokenSymbolIs('END') do ProcessObject;
+ parser.NextToken; // Skip end token
+ Output.WriteByte(0); // Terminate property list
+ end;
+
+const
+ signature: PChar = 'TPF0';
+begin
+ parser := TParser.Create(Input);
+ try
+ Output.Write(signature[0], 4);
+ ProcessObject;
+ finally
+ parser.Free;
+ end;
+end;
+
+
+procedure ObjectResourceToText(Input, Output: TStream);
+begin
+ Input.ReadResHeader;
+ ObjectBinaryToText(Input, Output);
+end;
+
+
+procedure ObjectTextToResource(Input, Output: TStream);
+var
+ StartPos, SizeStartPos, BinSize: LongInt;
+ parser: TParser;
+ name: String;
+begin
+ // Get form type name
+ StartPos := Input.Position;
+ parser := TParser.Create(Input);
+ try
+ if not parser.TokenSymbolIs('OBJECT') then parser.CheckTokenSymbol('INHERITED');
+ parser.NextToken;
+ parser.CheckToken(toSymbol);
+ parser.NextToken;
+ parser.CheckToken(':');
+ parser.NextToken;
+ parser.CheckToken(toSymbol);
+ name := parser.TokenString;
+ finally
+ parser.Free;
+ Input.Position := StartPos;
+ end;
+
+ // Write resource header
+ name := UpperCase(name);
+ Output.WriteByte($ff);
+ Output.WriteByte(10);
+ Output.WriteByte(0);
+ Output.Write(name[1], Length(name) + 1); // Write null-terminated form type name
+ Output.WriteWord($1030);
+ SizeStartPos := Output.Position;
+ Output.WriteDWord(0); // Placeholder for data size
+ ObjectTextToBinary(Input, Output); // Convert the stuff!
+ BinSize := Output.Position - SizeStartPos - 4;
+ Output.Position := SizeStartPos;
+ Output.WriteDWord(BinSize); // Insert real resource data size
+end;
+
+
+
+{ Utility routines }
+
+function LineStart(Buffer, BufPos: PChar): PChar;
+
+begin
+ Result := BufPos;
+ while Result > Buffer do begin
+ Dec(Result);
+ if Result[0] = #10 then break;
+ end;
+end;
+
+procedure CommonInit;
+begin
+{$ifndef ver1_0}
+ InitCriticalSection(SynchronizeCritSect);
+ ExecuteEvent:=RtlEventCreate;
+ SynchronizeTimeoutEvent:=RtlEventCreate;
+ DoSynchronizeMethod:=false;
+ MainThreadID:=GetCurrentThreadID;
+{$endif ver1_0}
+ InitHandlerList:=Nil;
+ FindGlobalComponentList:=nil;
+ IntConstList := TThreadList.Create;
+ GlobalFixupList := TThreadList.Create;
+ ClassList := TThreadList.Create;
+ ClassAliasList := TStringList.Create;
+end;
+
+procedure CommonCleanup;
+var
+ i: Integer;
+begin
+ // !!!: GlobalNameSpace.BeginWrite;
+ with IntConstList.LockList do
+ try
+ for i := 0 to Count - 1 do
+ TIntConst(Items[I]).Free;
+ finally
+ IntConstList.UnlockList;
+ end;
+ IntConstList.Free;
+ ClassList.Free;
+ ClassAliasList.Free;
+ RemoveFixupReferences(nil, '');
+ GlobalFixupList.Free;
+ GlobalFixupList := nil;
+ GlobalLists.Free;
+ ComponentPages.Free;
+ {!!!: GlobalNameSpace.Free;
+ GlobalNameSpace := nil;}
+ if (InitHandlerList<>Nil) then
+ for i := 0 to InitHandlerList.Count - 1 do
+ TInitHandler(InitHandlerList.Items[I]).Free;
+ InitHandlerList.Free;
+ InitHandlerList:=Nil;
+ FindGlobalComponentList.Free;
+ FindGlobalComponentList:=nil;
+{$ifndef ver1_0}
+ DoneCriticalSection(SynchronizeCritSect);
+ RtlEventDestroy(ExecuteEvent);
+ RtlEventDestroy(SynchronizeTimeoutEvent);
+{$endif}
+end;
+
+{ TFiler implementation }
+{$i filer.inc}
+
+{ TReader implementation }
+{$i reader.inc}
+
+{ TWriter implementations }
+{$i writer.inc}
+{$i twriter.inc}
+
+
+{
+ $Log: classes.inc,v $
+ Revision 1.27 2005/04/28 09:15:44 florian
+ + variants: string -> float/int casts
+
+ Revision 1.26 2005/04/13 16:16:43 peter
+ use createfmt instead of createresfmt
+
+ Revision 1.25 2005/04/09 17:26:08 florian
+ + classes.mainthreadid is set now
+ + rtleventresetevent
+ + rtleventwairfor with timeout
+ + checksynchronize with timeout
+ * race condition in synchronize fixed
+
+ Revision 1.24 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.23 2005/03/13 10:07:01 florian
+ * another utf-8 patch by C. Western
+
+ Revision 1.22 2005/03/09 20:50:11 florian
+ * C. Western: utf-8 reading from resource files
+
+ Revision 1.21 2005/03/07 19:55:13 florian
+ * C Western: component searching in FindGlobalComponent is now done backwards
+
+ Revision 1.20 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.19 2005/03/07 16:35:19 peter
+ * Object text format of widestrings patch from Martin Schreiber
+
+ Revision 1.18 2005/02/25 23:02:05 florian
+ + implemented D7 compliant FindGlobalComponents
+
+ Revision 1.17 2005/02/25 22:10:27 florian
+ * final fix for linux (hopefully)
+
+ Revision 1.16 2005/02/25 22:02:48 florian
+ * another "transfer to linux"-commit
+
+ Revision 1.15 2005/02/25 21:52:07 florian
+ * "transfer to linux"-commit
+
+ Revision 1.14 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.13 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.12 2005/02/14 16:47:37 peter
+ * support inline
+
+ Revision 1.11 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.10 2005/01/22 20:53:02 michael
+ + Patch from Colin Western to fix reading inherited forms
+
+}
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
new file mode 100644
index 0000000000..95114a2cba
--- /dev/null
+++ b/rtl/objpas/classes/classesh.inc
@@ -0,0 +1,1842 @@
+{
+ $Id: classesh.inc,v 1.55 2005/05/07 17:03:34 florian Exp $
+ This file is part of the Free Pascal Run Time Library (rtl)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$H+}
+
+{ The 1.0 compiler cannot compile the Seek(int64) overloading correct }
+{$ifndef ver1_0}
+ {$define seek64bit}
+{$endif ver1_0}
+
+type
+ { extra types to compile with FPC }
+ HRSRC = longint;
+ TComponentName = string;
+{$ifdef ver1_0}
+ // 1.0 doesn't have threads
+ TRTLCriticalSection = record
+ locked : longint;
+ end;
+ // 1.1 and above has interfaces
+ IUnknown = class(TObject);
+ TGUID = longint;
+ THandle = longint;
+{$else}
+ THandle = System.THandle;
+{$endif ver1_0}
+
+{$ifdef ver1_0}
+ TPoint = record
+ x,y : integer;
+ end;
+ TRect = record
+ Case Integer of
+ 0 : ( Left,Top,Right,Bottom : integer);
+ 1 : ( TopLeft,BottomRight : TPoint);
+ end;
+{$else}
+ TPoint=Types.TPoint;
+ TRect=Types.TRect;
+{$endif}
+
+{$if defined(ver1_0) or not(defined(win32))}
+ TSmallPoint = record
+ x,y : smallint;
+ end;
+ HMODULE = longint;
+{$else}
+ TSmallPoint = Windows.TSmallPoint;
+ HModule = System.HModule;
+{$endif}
+
+const
+
+{ Maximum TList size }
+
+ MaxListSize = Maxint div 16;
+
+{ values for TShortCut }
+
+ scShift = $2000;
+ scCtrl = $4000;
+ scAlt = $8000;
+ scNone = 0;
+
+{ TStream seek origins }
+const
+ soFromBeginning = 0;
+ soFromCurrent = 1;
+ soFromEnd = 2;
+
+type
+ TSeekOrigin = (soBeginning, soCurrent, soEnd);
+
+{ TFileStream create mode }
+const
+ fmCreate = $FFFF;
+ fmOpenRead = 0;
+ fmOpenWrite = 1;
+ fmOpenReadWrite = 2;
+
+{ TParser special tokens }
+
+ toEOF = Char(0);
+ toSymbol = Char(1);
+ toString = Char(2);
+ toInteger = Char(3);
+ toFloat = Char(4);
+
+Const
+ FilerSignature : Array[1..4] of char = 'TPF0';
+
+type
+
+{ Text alignment types }
+
+ TAlignment = (taLeftJustify, taRightJustify, taCenter);
+
+ { TLeftRight = taLeftJustify..taRightJustify; }
+
+{ Types used by standard events }
+
+ TShiftStateEnum = (ssShift, ssAlt, ssCtrl,
+ ssLeft, ssRight, ssMiddle, ssDouble,
+ // Extra additions
+ ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,
+ ssScroll,ssTriple,ssQuad);
+
+ TShiftState = set of TShiftStateEnum;
+
+ THelpContext = -MaxLongint..MaxLongint;
+ THelpType = (htKeyword, htContext);
+
+ TShortCut = Low(Word)..High(Word);
+
+{ Standard events }
+
+
+ TNotifyEvent = procedure(Sender: TObject) of object;
+ THelpEvent = function (Command: Word; Data: Longint;
+ var CallHelp: Boolean): Boolean of object;
+ TGetStrProc = procedure(const S: string) of object;
+
+{ Exception classes }
+
+ EStreamError = class(Exception);
+ EFCreateError = class(EStreamError);
+ EFOpenError = class(EStreamError);
+ EFilerError = class(EStreamError);
+ EReadError = class(EFilerError);
+ EWriteError = class(EFilerError);
+ EClassNotFound = class(EFilerError);
+ EMethodNotFound = class(EFilerError);
+ EInvalidImage = class(EFilerError);
+ EResNotFound = class(Exception);
+ EListError = class(Exception);
+ EBitsError = class(Exception);
+ EStringListError = class(Exception);
+ EComponentError = class(Exception);
+ EParserError = class(Exception);
+ EOutOfResources = class(EOutOfMemory);
+ EInvalidOperation = class(Exception);
+
+{ Forward class declarations }
+
+ TStream = class;
+ TFiler = class;
+ TReader = class;
+ TWriter = class;
+ TComponent = class;
+
+{ TFPList class }
+
+ PPointerList = ^TPointerList;
+ TPointerList = array[0..MaxListSize - 1] of Pointer;
+ TListSortCompare = function (Item1, Item2: Pointer): Integer;
+ TListNotification = (lnAdded, lnExtracted, lnDeleted);
+
+{$inline on}
+
+ TFPList = class(TObject)
+ private
+ FList: PPointerList;
+ FCount: Integer;
+ FCapacity: Integer;
+ protected
+ function Get(Index: Integer): Pointer; {$ifdef HASINLINE} inline;{$endif}
+ procedure Put(Index: Integer; Item: Pointer); {$ifdef HASINLINE} inline;{$endif}
+ procedure SetCapacity(NewCapacity: Integer);
+ procedure SetCount(NewCount: Integer);
+ Procedure RaiseIndexError(Index : Integer);
+ public
+ destructor Destroy; override;
+ function Add(Item: Pointer): Integer; {$ifdef HASINLINE} inline;{$endif}
+ procedure Clear;
+ procedure Delete(Index: Integer); {$ifdef HASINLINE} inline;{$endif}
+ class procedure Error(const Msg: string; Data: Integer);
+ procedure Exchange(Index1, Index2: Integer);
+ function Expand: TFPList; {$ifdef HASINLINE} inline;{$endif}
+ function Extract(item: Pointer): Pointer;
+ function First: Pointer;
+ function IndexOf(Item: Pointer): Integer;
+ procedure Insert(Index: Integer; Item: Pointer); {$ifdef HASINLINE} inline;{$endif}
+ function Last: Pointer;
+ procedure Move(CurIndex, NewIndex: Integer);
+ procedure Assign(Obj:TFPList);
+ function Remove(Item: Pointer): Integer;
+ procedure Pack;
+ procedure Sort(Compare: TListSortCompare);
+ property Capacity: Integer read FCapacity write SetCapacity;
+ property Count: Integer read FCount write SetCount;
+ property Items[Index: Integer]: Pointer read Get write Put; default;
+ property List: PPointerList read FList;
+ end;
+
+{ TList class}
+
+ TList = class(TObject)
+ private
+ FList: TFPList;
+ protected
+ function Get(Index: Integer): Pointer;
+ procedure Grow; virtual;
+ procedure Put(Index: Integer; Item: Pointer);
+ procedure Notify(Ptr: Pointer; Action: TListNotification); virtual;
+ procedure SetCapacity(NewCapacity: Integer);
+ function GetCapacity: integer;
+ procedure SetCount(NewCount: Integer);
+ function GetCount: integer;
+ function GetList: PPointerList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Add(Item: Pointer): Integer;
+ procedure Clear; virtual;
+ procedure Delete(Index: Integer);
+ class procedure Error(const Msg: string; Data: Integer); virtual;
+ procedure Exchange(Index1, Index2: Integer);
+ function Expand: TList;
+ function Extract(item: Pointer): Pointer;
+ function First: Pointer;
+ function IndexOf(Item: Pointer): Integer;
+ procedure Insert(Index: Integer; Item: Pointer);
+ function Last: Pointer;
+ procedure Move(CurIndex, NewIndex: Integer);
+ procedure Assign(Obj:TList);
+ function Remove(Item: Pointer): Integer;
+ procedure Pack;
+ procedure Sort(Compare: TListSortCompare);
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Count: Integer read GetCount write SetCount;
+ property Items[Index: Integer]: Pointer read Get write Put; default;
+ property List: PPointerList read GetList;
+ end;
+
+{ TThreadList class }
+
+ TThreadList = class
+ private
+ FList: TList;
+{$ifdef FPC_THREADING}
+ FLock: TRTLCriticalSection;
+{$endif FPC_THREADING}
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(Item: Pointer);
+ procedure Clear;
+ function LockList: TList;
+ procedure Remove(Item: Pointer);
+ procedure UnlockList;
+ end;
+
+const
+ BITSHIFT = 5;
+ MASK = 31; {for longs that are 32-bit in size}
+ MaxBitRec = $FFFF Div (SizeOf(longint));
+ MaxBitFlags = MaxBitRec * 32;
+
+type
+ TBitArray = array[0..MaxBitRec - 1] of cardinal;
+
+ TBits = class(TObject)
+ private
+ { Private declarations }
+ FBits : ^TBitArray;
+ FSize : longint; { total longints currently allocated }
+ findIndex : longint;
+ findState : boolean;
+
+ { functions and properties to match TBits class }
+ procedure SetBit(bit : longint; value : Boolean);
+ function GetSize : longint;
+ procedure SetSize(value : longint);
+ procedure CheckBitIndex (Bit : longint;CurrentSize : Boolean);
+
+ public
+ { Public declarations }
+ constructor Create(TheSize : longint {$ifndef VER1_0} = 0 {$endif}); virtual;
+ destructor Destroy; override;
+ function GetFSize : longint;
+ procedure SetOn(Bit : longint);
+ procedure Clear(Bit : longint);
+ procedure Clearall;
+ procedure AndBits(BitSet : TBits);
+ procedure OrBits(BitSet : TBits);
+ procedure XorBits(BitSet : TBits);
+ procedure NotBits(BitSet : TBits);
+ function Get(Bit : longint) : boolean;
+ procedure Grow(NBit : longint);
+ function Equals(BitSet : TBits) : Boolean;
+ procedure SetIndex(Index : longint);
+ function FindFirstBit(State : boolean) : longint;
+ function FindNextBit : longint;
+ function FindPrevBit : longint;
+
+ { functions and properties to match TBits class }
+ function OpenBit: longint;
+ property Bits[Bit: longint]: Boolean read get write SetBit; default;
+ property Size: longint read getSize write setSize;
+ end;
+
+{ TPersistent abstract class }
+
+{$M+}
+
+ TPersistent = class(TObject)
+ private
+ procedure AssignError(Source: TPersistent);
+ protected
+ procedure AssignTo(Dest: TPersistent); virtual;
+ procedure DefineProperties(Filer: TFiler); virtual;
+ function GetOwner: TPersistent; dynamic;
+ public
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); virtual;
+ function GetNamePath: string; virtual; {dynamic;}
+ end;
+
+{$M-}
+
+{ TPersistent class reference type }
+
+ TPersistentClass = class of TPersistent;
+
+{ TInterfaced Persistent }
+
+{$ifdef HASINTF}
+ TInterfacedPersistent = class(TPersistent, IInterface)
+ private
+ FOwnerInterface: IInterface;
+ protected
+ { IInterface }
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+ public
+ function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+ procedure AfterConstruction; override;
+ end;
+{$endif HASINTF}
+
+{ TRecall class }
+
+ TRecall = class(TObject)
+ private
+ FStorage, FReference: TPersistent;
+ public
+ constructor Create(AStorage, AReference: TPersistent);
+ destructor Destroy; override;
+ procedure Store;
+ procedure Forget;
+ property Reference: TPersistent read FReference;
+ end;
+
+{ TCollection class }
+
+ TCollection = class;
+
+ TCollectionItem = class(TPersistent)
+ private
+ FCollection: TCollection;
+ FID: Integer;
+ FUpdateCount: Integer;
+ function GetIndex: Integer;
+ protected
+ procedure SetCollection(Value: TCollection);virtual;
+ procedure Changed(AllItems: Boolean);
+ function GetNamePath: string; override;
+ function GetOwner: TPersistent; override;
+ function GetDisplayName: string; virtual;
+ procedure SetIndex(Value: Integer); virtual;
+ procedure SetDisplayName(const Value: string); virtual;
+ property UpdateCount: Integer read FUpdateCount;
+ public
+ constructor Create(ACollection: TCollection); virtual;
+ destructor Destroy; override;
+ property Collection: TCollection read FCollection write SetCollection;
+ property ID: Integer read FID;
+ property Index: Integer read GetIndex write SetIndex;
+ property DisplayName: string read GetDisplayName write SetDisplayName;
+ end;
+
+ TCollectionItemClass = class of TCollectionItem;
+ TCollectionNotification = (cnAdded, cnExtracting, cnDeleting);
+
+ TCollection = class(TPersistent)
+ private
+ FItemClass: TCollectionItemClass;
+ FItems: TList;
+ FUpdateCount: Integer;
+ FNextID: Integer;
+ FPropName: string;
+ function GetCount: Integer;
+ function GetPropName: string;
+ procedure InsertItem(Item: TCollectionItem);
+ procedure RemoveItem(Item: TCollectionItem);
+ protected
+ { Design-time editor support }
+ function GetAttrCount: Integer; dynamic;
+ function GetAttr(Index: Integer): string; dynamic;
+ function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
+ function GetNamePath: string; override;
+ procedure Changed;
+ function GetItem(Index: Integer): TCollectionItem;
+ procedure SetItem(Index: Integer; Value: TCollectionItem);
+ procedure SetItemName(Item: TCollectionItem); virtual;
+ procedure SetPropName; virtual;
+ procedure Update(Item: TCollectionItem); virtual;
+ procedure Notify(Item: TCollectionItem;Action: TCollectionNotification); virtual;
+ property PropName: string read GetPropName write FPropName;
+ property UpdateCount: Integer read FUpdateCount;
+ public
+ constructor Create(AItemClass: TCollectionItemClass);
+ destructor Destroy; override;
+ function Owner: TPersistent;
+ function Add: TCollectionItem;
+ procedure Assign(Source: TPersistent); override;
+ procedure BeginUpdate;
+ procedure Clear;
+ procedure EndUpdate;
+ procedure Delete(Index: Integer);
+ function Insert(Index: Integer): TCollectionItem;
+ function FindItemID(ID: Integer): TCollectionItem;
+ property Count: Integer read GetCount;
+ property ItemClass: TCollectionItemClass read FItemClass;
+ property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
+ end;
+
+ TOwnedCollection = class(TCollection)
+ private
+ FOwner: TPersistent;
+ protected
+ Function GetOwner: TPersistent; override;
+ public
+ Constructor Create(AOwner: TPersistent;AItemClass: TCollectionItemClass);
+ end;
+
+
+ TStrings = class;
+
+{ IStringsAdapter interface }
+
+{$ifdef HASINTF}
+ { Maintains link between TStrings and IStrings implementations }
+ IStringsAdapter = interface ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
+ procedure ReferenceStrings(S: TStrings);
+ procedure ReleaseStrings;
+ end;
+{$else HASINTF}
+ IStringsAdapter = class(TObject);
+{$endif HASINTF}
+
+{ TStrings class }
+
+ TStrings = class(TPersistent)
+ private
+ FSpecialCharsInited : boolean;
+ FQuoteChar : Char;
+ FDelimiter : Char;
+ FNameValueSeparator : Char;
+ FUpdateCount: Integer;
+ FAdapter: IStringsAdapter;
+ function GetCommaText: string;
+ function GetName(Index: Integer): string;
+ function GetValue(const Name: string): string;
+ procedure ReadData(Reader: TReader);
+ procedure SetCommaText(const Value: string);
+ procedure SetStringsAdapter(const Value: IStringsAdapter);
+ procedure SetValue(const Name, Value: string);
+ procedure SetDelimiter(c:Char);
+ procedure SetQuoteChar(c:Char);
+ procedure SetNameValueSeparator(c:Char);
+ procedure WriteData(Writer: TWriter);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Error(const Msg: string; Data: Integer);
+ procedure Error(const Msg: pstring; Data: Integer);
+ function Get(Index: Integer): string; virtual; abstract;
+ function GetCapacity: Integer; virtual;
+ function GetCount: Integer; virtual; abstract;
+ function GetObject(Index: Integer): TObject; virtual;
+ function GetTextStr: string; virtual;
+ procedure Put(Index: Integer; const S: string); virtual;
+ procedure PutObject(Index: Integer; AObject: TObject); virtual;
+ procedure SetCapacity(NewCapacity: Integer); virtual;
+ procedure SetTextStr(const Value: string); virtual;
+ procedure SetUpdateState(Updating: Boolean); virtual;
+ property UpdateCount: Integer read FUpdateCount;
+ Function DoCompareText(const s1,s2 : string) : PtrInt; virtual;
+ Function GetDelimitedText: string;
+ Procedure SetDelimitedText(Const AValue: string);
+ Function GetValueFromIndex(Index: Integer): string;
+ Procedure SetValueFromIndex(Index: Integer; const Value: string);
+ Procedure CheckSpecialChars;
+ public
+ destructor Destroy; override;
+ function Add(const S: string): Integer; virtual;
+ function AddObject(const S: string; AObject: TObject): Integer; virtual;
+ procedure Append(const S: string);
+ procedure AddStrings(TheStrings: TStrings); virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure BeginUpdate;
+ procedure Clear; virtual; abstract;
+ procedure Delete(Index: Integer); virtual; abstract;
+ procedure EndUpdate;
+ function Equals(TheStrings: TStrings): Boolean;
+ procedure Exchange(Index1, Index2: Integer); virtual;
+ function GetText: PChar; virtual;
+ function IndexOf(const S: string): Integer; virtual;
+ function IndexOfName(const Name: string): Integer; virtual;
+ function IndexOfObject(AObject: TObject): Integer; virtual;
+ procedure Insert(Index: Integer; const S: string); virtual; abstract;
+ procedure InsertObject(Index: Integer; const S: string;
+ AObject: TObject);
+ procedure LoadFromFile(const FileName: string); virtual;
+ procedure LoadFromStream(Stream: TStream); virtual;
+ procedure Move(CurIndex, NewIndex: Integer); virtual;
+ procedure SaveToFile(const FileName: string); virtual;
+ procedure SaveToStream(Stream: TStream); virtual;
+ procedure SetText(TheText: PChar); virtual;
+ procedure GetNameValue(Index : Integer; Var AName,AValue : String);
+ property Delimiter: Char read FDelimiter write SetDelimiter;
+ property DelimitedText: string read GetDelimitedText write SetDelimitedText;
+ property QuoteChar: Char read FQuoteChar write SetQuoteChar;
+ Property NameValueSeparator : Char Read FNameValueSeparator Write SetNameValueSeparator;
+ property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property CommaText: string read GetCommaText write SetCommaText;
+ property Count: Integer read GetCount;
+ property Names[Index: Integer]: string read GetName;
+ property Objects[Index: Integer]: TObject read GetObject write PutObject;
+ property Values[const Name: string]: string read GetValue write SetValue;
+ property Strings[Index: Integer]: string read Get write Put; default;
+ property Text: string read GetTextStr write SetTextStr;
+ property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
+ end;
+
+{ TStringList class }
+
+ TDuplicates = (dupIgnore, dupAccept, dupError);
+ TStringList = class;
+
+ PStringItem = ^TStringItem;
+ TStringItem = record
+ FString: string;
+ FObject: TObject;
+ end;
+
+ PStringItemList = ^TStringItemList;
+ TStringItemList = array[0..MaxListSize] of TStringItem;
+ TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
+
+ TStringList = class(TStrings)
+ private
+ FList: PStringItemList;
+ FCount: Integer;
+ FCapacity: Integer;
+ FOnChange: TNotifyEvent;
+ FOnChanging: TNotifyEvent;
+ FDuplicates: TDuplicates;
+ FCaseSensitive : Boolean;
+ FSorted: Boolean;
+ procedure ExchangeItems(Index1, Index2: Integer);
+ procedure Grow;
+ procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
+ procedure SetSorted(Value: Boolean);
+ procedure SetCaseSensitive(b : boolean);
+ protected
+ procedure Changed; virtual;
+ procedure Changing; virtual;
+ function Get(Index: Integer): string; override;
+ function GetCapacity: Integer; override;
+ function GetCount: Integer; override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure Put(Index: Integer; const S: string); override;
+ procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetCapacity(NewCapacity: Integer); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ procedure InsertItem(Index: Integer; const S: string); virtual;
+ procedure InsertItem(Index: Integer; const S: string; O: TObject); virtual;
+ Function DoCompareText(const s1,s2 : string) : PtrInt; override;
+
+ public
+ destructor Destroy; override;
+ function Add(const S: string): Integer; override;
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ procedure Exchange(Index1, Index2: Integer); override;
+ function Find(const S: string; var Index: Integer): Boolean; virtual;
+ function IndexOf(const S: string): Integer; override;
+ procedure Insert(Index: Integer; const S: string); override;
+ procedure Sort; virtual;
+ procedure CustomSort(CompareFn: TStringListSortCompare);
+ property Duplicates: TDuplicates read FDuplicates write FDuplicates;
+ property Sorted: Boolean read FSorted write SetSorted;
+ property CaseSensitive: Boolean read FCaseSensitive write SetSorted;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
+ end;
+
+{ TStream abstract class }
+
+ TStream = class(TObject)
+ protected
+{$ifdef seek64bit}
+ function GetPosition: Int64; virtual;
+ procedure SetPosition(const Pos: Int64); virtual;
+ function GetSize: Int64; virtual;
+ procedure SetSize64(const NewSize: Int64); virtual;
+ procedure SetSize(NewSize: Longint); virtual;overload;
+ procedure SetSize(const NewSize: Int64); virtual;overload;
+{$else seek64bit}
+ function GetPosition: Longint;
+ procedure SetPosition(Pos: Longint);
+ function GetSize: Longint;
+ procedure SetSize(NewSize: Longint); virtual;
+{$endif seek64bit}
+ public
+ function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
+ function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
+{$ifdef seek64bit}
+ function Seek(Offset: Longint; Origin: Word): Longint; virtual; overload;
+ function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; virtual; overload;
+{$else seek64bit}
+ function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
+{$endif seek64bit}
+ procedure ReadBuffer(var Buffer; Count: Longint);
+ procedure WriteBuffer(const Buffer; Count: Longint);
+ function CopyFrom(Source: TStream; Count: Int64): Int64;
+ function ReadComponent(Instance: TComponent): TComponent;
+ function ReadComponentRes(Instance: TComponent): TComponent;
+ procedure WriteComponent(Instance: TComponent);
+ procedure WriteComponentRes(const ResName: string; Instance: TComponent);
+ procedure WriteDescendent(Instance, Ancestor: TComponent);
+ procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
+ procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
+ procedure FixupResourceHeader(FixupInfo: Integer);
+ procedure ReadResHeader;
+ function ReadByte : Byte;
+ function ReadWord : Word;
+ function ReadDWord : Cardinal;
+ function ReadAnsiString : String;
+ procedure WriteByte(b : Byte);
+ procedure WriteWord(w : Word);
+ procedure WriteDWord(d : Cardinal);
+ Procedure WriteAnsiString (S : String);
+{$ifdef seek64bit}
+ property Position: Int64 read GetPosition write SetPosition;
+ property Size: Int64 read GetSize write SetSize64;
+{$else seek64bit}
+ property Position: Longint read GetPosition write SetPosition;
+ property Size: Longint read GetSize write SetSize;
+{$endif seek64bit}
+ end;
+
+ { TOwnerStream }
+ TOwnerStream = Class(TStream)
+ Protected
+ FOwner : Boolean;
+ FSource : TStream;
+ Public
+ Constructor Create(ASource : TStream);
+ Destructor Destroy; override;
+ Property Source : TStream Read FSource;
+ Property SourceOwner : Boolean Read Fowner Write FOwner;
+ end;
+
+
+{$ifdef HASINTF}
+ IStreamPersist = interface ['{B8CD12A3-267A-11D4-83DA-00C04F60B2DD}']
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToStream(Stream: TStream);
+ end;
+{$endif HASINTF}
+
+{ THandleStream class }
+
+ THandleStream = class(TStream)
+ private
+ FHandle: Integer;
+ protected
+{$ifdef seek64bit}
+ procedure SetSize(NewSize: Longint); override;
+ procedure SetSize(const NewSize: Int64); override;
+{$else seek64bit}
+ procedure SetSize(NewSize: Longint); override;
+{$endif seek64bit}
+ public
+ constructor Create(AHandle: Integer);
+ function Read(var Buffer; Count: Longint): Longint; override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+{$ifdef seek64bit}
+ function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
+{$else seek64bit}
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+{$endif seek64bit}
+ property Handle: Integer read FHandle;
+ end;
+
+{ TFileStream class }
+
+ TFileStream = class(THandleStream)
+ Private
+ FFileName : String;
+ public
+ constructor Create(const AFileName: string; Mode: Word);
+ constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
+ destructor Destroy; override;
+ property FileName : String Read FFilename;
+ end;
+
+{ TCustomMemoryStream abstract class }
+
+ TCustomMemoryStream = class(TStream)
+ private
+ FMemory: Pointer;
+ FSize, FPosition: Longint;
+ protected
+ procedure SetPointer(Ptr: Pointer; ASize: Longint);
+ public
+{$ifdef seek64bit}
+ Function GetSize : Int64; Override;
+{$endif seek64bit}
+ function Read(var Buffer; Count: Longint): Longint; override;
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ procedure SaveToStream(Stream: TStream);
+ procedure SaveToFile(const FileName: string);
+ property Memory: Pointer read FMemory;
+ end;
+
+{ TMemoryStream }
+
+ TMemoryStream = class(TCustomMemoryStream)
+ private
+ FCapacity: Longint;
+ procedure SetCapacity(NewCapacity: Longint);
+ protected
+ function Realloc(var NewCapacity: Longint): Pointer; virtual;
+ property Capacity: Longint read FCapacity write SetCapacity;
+ public
+ destructor Destroy; override;
+ procedure Clear;
+ procedure LoadFromStream(Stream: TStream);
+ procedure LoadFromFile(const FileName: string);
+ procedure SetSize(NewSize: Longint); override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+ end;
+
+{ TStringStream }
+
+ TStringStream = class(TStream)
+ private
+ FDataString: string;
+ FPosition: Integer;
+ protected
+ procedure SetSize(NewSize: Longint); override;
+ public
+ constructor Create(const AString: string);
+ function Read(var Buffer; Count: Longint): Longint; override;
+ function ReadString(Count: Longint): string;
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+ procedure WriteString(const AString: string);
+ property DataString: string read FDataString;
+ end;
+
+{ TResourceStream }
+
+ TResourceStream = class(TCustomMemoryStream)
+ private
+ HResInfo: HRSRC;
+ HGlobal: THandle;
+ procedure Initialize(Instance: THandle; Name, ResType: PChar);
+ public
+ constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
+ constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
+ destructor Destroy; override;
+ function Write(const Buffer; Count: Longint): Longint; override;
+ end;
+
+{ TStreamAdapter }
+{ Implements OLE IStream on VCL TStream }
+{ we don't need that yet
+ TStreamAdapter = class(TInterfacedObject, IStream)
+ private
+ FStream: TStream;
+ public
+ constructor Create(Stream: TStream);
+ function Read(pv: Pointer; cb: Longint;
+ pcbRead: PLongint): HResult; stdcall;
+ function Write(pv: Pointer; cb: Longint;
+ pcbWritten: PLongint): HResult; stdcall;
+ function Seek(dlibMove: Largeint; dwOrigin: Longint;
+ out libNewPosition: Largeint): HResult; stdcall;
+ function SetSize(libNewSize: Largeint): HResult; stdcall;
+ function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
+ out cbWritten: Largeint): HResult; stdcall;
+ function Commit(grfCommitFlags: Longint): HResult; stdcall;
+ function Revert: HResult; stdcall;
+ function LockRegion(libOffset: Largeint; cb: Largeint;
+ dwLockType: Longint): HResult; stdcall;
+ function UnlockRegion(libOffset: Largeint; cb: Largeint;
+ dwLockType: Longint): HResult; stdcall;
+ function Stat(out statstg: TStatStg;
+ grfStatFlag: Longint): HResult; stdcall;
+ function Clone(out stm: IStream): HResult; stdcall;
+ end;
+}
+
+{ TFiler }
+
+ TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
+ vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
+ vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString, vaInt64, vaUTF8String);
+
+ TFilerFlag = (ffInherited, ffChildPos, ffInline);
+ TFilerFlags = set of TFilerFlag;
+
+ TReaderProc = procedure(Reader: TReader) of object;
+ TWriterProc = procedure(Writer: TWriter) of object;
+ TStreamProc = procedure(Stream: TStream) of object;
+
+ TFiler = class(TObject)
+ private
+ FRoot: TComponent;
+ FLookupRoot: TComponent;
+ FAncestor: TPersistent;
+ FIgnoreChildren: Boolean;
+ protected
+ procedure SetRoot(ARoot: TComponent); virtual;
+ public
+ procedure DefineProperty(const Name: string;
+ ReadData: TReaderProc; WriteData: TWriterProc;
+ HasData: Boolean); virtual; abstract;
+ procedure DefineBinaryProperty(const Name: string;
+ ReadData, WriteData: TStreamProc;
+ HasData: Boolean); virtual; abstract;
+ property Root: TComponent read FRoot write SetRoot;
+ property LookupRoot: TComponent read FLookupRoot;
+ property Ancestor: TPersistent read FAncestor write FAncestor;
+ property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
+ end;
+
+
+{ TComponent class reference type }
+
+ TComponentClass = class of TComponent;
+
+
+{ TReader }
+
+ TAbstractObjectReader = class
+ public
+ function NextValue: TValueType; virtual; abstract;
+ function ReadValue: TValueType; virtual; abstract;
+ procedure BeginRootComponent; virtual; abstract;
+ procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+ var CompClassName, CompName: String); virtual; abstract;
+ function BeginProperty: String; virtual; abstract;
+
+ { All ReadXXX methods are called _after_ the value type has been read! }
+ procedure ReadBinary(const DestData: TMemoryStream); virtual; abstract;
+ function ReadFloat: Extended; virtual; abstract;
+ function ReadSingle: Single; virtual; abstract;
+{$ifdef HASCURRENCY}
+ function ReadCurrency: Currency; virtual; abstract;
+{$endif HASCURRENCY}
+ function ReadDate: TDateTime; virtual; abstract;
+ function ReadIdent(ValueType: TValueType): String; virtual; abstract;
+ function ReadInt8: ShortInt; virtual; abstract;
+ function ReadInt16: SmallInt; virtual; abstract;
+ function ReadInt32: LongInt; virtual; abstract;
+ function ReadInt64: Int64; virtual; abstract;
+ function ReadSet(EnumType: Pointer): Integer; virtual; abstract;
+ function ReadStr: String; virtual; abstract;
+ function ReadString(StringType: TValueType): String; virtual; abstract;
+{$ifdef HASWIDESTRING}
+ function ReadWideString: WideString;virtual;abstract;
+{$endif HASWIDESTRING}
+ procedure SkipComponent(SkipComponentInfos: Boolean); virtual; abstract;
+ procedure SkipValue; virtual; abstract;
+ end;
+
+ { TBinaryObjectReader }
+
+ TBinaryObjectReader = class(TAbstractObjectReader)
+ protected
+ FStream: TStream;
+ FBuffer: Pointer;
+ FBufSize: Integer;
+ FBufPos: Integer;
+ FBufEnd: Integer;
+ procedure Read(var Buf; Count: LongInt);
+ procedure SkipProperty;
+ procedure SkipSetBody;
+ public
+ constructor Create(Stream: TStream; BufSize: Integer);
+ destructor Destroy; override;
+
+ function NextValue: TValueType; override;
+ function ReadValue: TValueType; override;
+ procedure BeginRootComponent; override;
+ procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+ var CompClassName, CompName: String); override;
+ function BeginProperty: String; override;
+
+ procedure ReadBinary(const DestData: TMemoryStream); override;
+ function ReadFloat: Extended; override;
+ function ReadSingle: Single; override;
+{$ifdef HASCURRENCY}
+ function ReadCurrency: Currency; override;
+{$endif HASCURRENCY}
+ function ReadDate: TDateTime; override;
+ function ReadIdent(ValueType: TValueType): String; override;
+ function ReadInt8: ShortInt; override;
+ function ReadInt16: SmallInt; override;
+ function ReadInt32: LongInt; override;
+ function ReadInt64: Int64; override;
+ function ReadSet(EnumType: Pointer): Integer; override;
+ function ReadStr: String; override;
+ function ReadString(StringType: TValueType): String; override;
+{$ifdef HASWIDESTRING}
+ function ReadWideString: WideString;override;
+{$endif HASWIDESTRING}
+ procedure SkipComponent(SkipComponentInfos: Boolean); override;
+ procedure SkipValue; override;
+ end;
+
+
+ TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
+ var Address: Pointer; var Error: Boolean) of object;
+ TSetMethodPropertyEvent = procedure(Reader: TReader; Instance: TPersistent;
+ PropInfo: PPropInfo; const TheMethodName: string;
+ var Handled: boolean) of object;
+ TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
+ var Name: string) of object;
+ TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
+ TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
+ ComponentClass: TPersistentClass; var Component: TComponent) of object;
+ TReadComponentsProc = procedure(Component: TComponent) of object;
+ TReaderError = procedure(Reader: TReader; const Message: string;
+ var Handled: Boolean) of object;
+ TPropertyNotFoundEvent = procedure(Reader: TReader; Instance: TPersistent;
+ var PropName: string; IsPath: boolean; var Handled, Skip: Boolean) of object;
+ TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string;
+ var ComponentClass: TComponentClass) of object;
+ TCreateComponentEvent = procedure(Reader: TReader;
+ ComponentClass: TComponentClass; var Component: TComponent) of object;
+
+ TReadWriteStringPropertyEvent = procedure(Sender:TObject;
+ const Instance: TPersistent; PropInfo: PPropInfo;
+ var Content:string) of object;
+
+
+ { TReader }
+
+ TReader = class(TFiler)
+ private
+ FDriver: TAbstractObjectReader;
+ FOwner: TComponent;
+ FParent: TComponent;
+ FFixups: TList;
+ FLoaded: TList;
+ FOnFindMethod: TFindMethodEvent;
+ FOnSetMethodProperty: TSetMethodPropertyEvent;
+ FOnSetName: TSetNameEvent;
+ FOnReferenceName: TReferenceNameEvent;
+ FOnAncestorNotFound: TAncestorNotFoundEvent;
+ FOnError: TReaderError;
+ FOnPropertyNotFound: TPropertyNotFoundEvent;
+ FOnFindComponentClass: TFindComponentClassEvent;
+ FOnCreateComponent: TCreateComponentEvent;
+ FPropName: string;
+ FCanHandleExcepts: Boolean;
+ FOnReadStringProperty:TReadWriteStringPropertyEvent;
+ procedure DoFixupReferences;
+ procedure FreeFixups;
+ function FindComponentClass(const AClassName: string): TComponentClass;
+ protected
+ function Error(const Message: string): Boolean; virtual;
+ function FindMethod(ARoot: TComponent; const AMethodName: string): Pointer; virtual;
+ procedure ReadProperty(AInstance: TPersistent);
+ procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
+ procedure PropertyError;
+ procedure ReadData(Instance: TComponent);
+ property PropName: string read FPropName;
+ property CanHandleExceptions: Boolean read FCanHandleExcepts;
+ function CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectReader; virtual;
+ public
+ constructor Create(Stream: TStream; BufSize: Integer);
+ destructor Destroy; override;
+ procedure BeginReferences;
+ procedure CheckValue(Value: TValueType);
+ procedure DefineProperty(const Name: string;
+ AReadData: TReaderProc; WriteData: TWriterProc;
+ HasData: Boolean); override;
+ procedure DefineBinaryProperty(const Name: string;
+ AReadData, WriteData: TStreamProc;
+ HasData: Boolean); override;
+ function EndOfList: Boolean;
+ procedure EndReferences;
+ procedure FixupReferences;
+ function NextValue: TValueType;
+ function ReadBoolean: Boolean;
+ function ReadChar: Char;
+ procedure ReadCollection(Collection: TCollection);
+ function ReadComponent(Component: TComponent): TComponent;
+ procedure ReadComponents(AOwner, AParent: TComponent;
+ Proc: TReadComponentsProc);
+ function ReadFloat: Extended;
+ function ReadSingle: Single;
+{$ifdef HASCURRENCY}
+ function ReadCurrency: Currency;
+{$endif HASCURRENCY}
+ function ReadDate: TDateTime;
+ function ReadIdent: string;
+ function ReadInteger: Longint;
+ function ReadInt64: Int64;
+ procedure ReadListBegin;
+ procedure ReadListEnd;
+ function ReadRootComponent(ARoot: TComponent): TComponent;
+ function ReadString: string;
+{$ifdef HASWIDESTRING}
+ function ReadWideString: WideString;
+{$endif HASWIDESTRING}
+ function ReadValue: TValueType;
+ procedure CopyValue(Writer: TWriter);
+ property Driver: TAbstractObjectReader read FDriver;
+ property Owner: TComponent read FOwner write FOwner;
+ property Parent: TComponent read FParent write FParent;
+ property OnError: TReaderError read FOnError write FOnError;
+ property OnPropertyNotFound: TPropertyNotFoundEvent read FOnPropertyNotFound write FOnPropertyNotFound;
+ property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
+ property OnSetMethodProperty: TSetMethodPropertyEvent read FOnSetMethodProperty write FOnSetMethodProperty;
+ property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
+ property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
+ property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
+ property OnCreateComponent: TCreateComponentEvent read FOnCreateComponent write FOnCreateComponent;
+ property OnFindComponentClass: TFindComponentClassEvent read FOnFindComponentClass write FOnFindComponentClass;
+ property OnReadStringProperty: TReadWriteStringPropertyEvent read FOnReadStringProperty write FOnReadStringProperty;
+ end;
+
+
+{ TWriter }
+
+ TAbstractObjectWriter = class
+ public
+ { Begin/End markers. Those ones who don't have an end indicator, use
+ "EndList", after the occurrence named in the comment. Note that this
+ only counts for "EndList" calls on the same level; each BeginXXX call
+ increases the current level. }
+ procedure BeginCollection; virtual; abstract; { Ends with the next "EndList" }
+ procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
+ ChildPos: Integer); virtual; abstract; { Ends after the second "EndList" }
+ procedure BeginList; virtual; abstract;
+ procedure EndList; virtual; abstract;
+ procedure BeginProperty(const PropName: String); virtual; abstract;
+ procedure EndProperty; virtual; abstract;
+
+ procedure WriteBinary(const Buffer; Count: Longint); virtual; abstract;
+ procedure WriteBoolean(Value: Boolean); virtual; abstract;
+ // procedure WriteChar(Value: Char);
+ procedure WriteFloat(const Value: Extended); virtual; abstract;
+ procedure WriteSingle(const Value: Single); virtual; abstract;
+{$ifdef HASCURRENCY}
+ procedure WriteCurrency(const Value: Currency); virtual; abstract;
+{$endif HASCURRENCY}
+ procedure WriteDate(const Value: TDateTime); virtual; abstract;
+ procedure WriteIdent(const Ident: string); virtual; abstract;
+ procedure WriteInteger(Value: Int64); virtual; abstract;
+ procedure WriteMethodName(const Name: String); virtual; abstract;
+ procedure WriteSet(Value: LongInt; SetType: Pointer); virtual; abstract;
+ procedure WriteString(const Value: String); virtual; abstract;
+{$ifdef HASWIDESTRING}
+ procedure WriteWideString(const Value: WideString);virtual;abstract;
+{$endif HASWIDESTRING}
+ end;
+
+ { TBinaryObjectWriter }
+
+ TBinaryObjectWriter = class(TAbstractObjectWriter)
+ protected
+ FStream: TStream;
+ FBuffer: Pointer;
+ FBufSize: Integer;
+ FBufPos: Integer;
+ FBufEnd: Integer;
+ FSignatureWritten: Boolean;
+ procedure FlushBuffer;
+ procedure Write(const Buffer; Count: Longint);
+ procedure WriteValue(Value: TValueType);
+ procedure WriteStr(const Value: String);
+ public
+ constructor Create(Stream: TStream; BufSize: Integer);
+ destructor Destroy; override;
+
+ procedure BeginCollection; override;
+ procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
+ ChildPos: Integer); override;
+ procedure BeginList; override;
+ procedure EndList; override;
+ procedure BeginProperty(const PropName: String); override;
+ procedure EndProperty; override;
+
+ procedure WriteBinary(const Buffer; Count: LongInt); override;
+ procedure WriteBoolean(Value: Boolean); override;
+ procedure WriteFloat(const Value: Extended); override;
+ procedure WriteSingle(const Value: Single); override;
+{$ifdef HASCURRENCY}
+ procedure WriteCurrency(const Value: Currency); override;
+{$endif HASCURRENCY}
+ procedure WriteDate(const Value: TDateTime); override;
+ procedure WriteIdent(const Ident: string); override;
+ procedure WriteInteger(Value: Int64); override;
+ procedure WriteMethodName(const Name: String); override;
+ procedure WriteSet(Value: LongInt; SetType: Pointer); override;
+ procedure WriteString(const Value: String); override;
+{$ifdef HASWIDESTRING}
+ procedure WriteWideString(const Value: WideString); override;
+{$endif HASWIDESTRING}
+ end;
+
+ TTextObjectWriter = class(TAbstractObjectWriter)
+ end;
+
+
+ TFindAncestorEvent = procedure (Writer: TWriter; Component: TComponent;
+ const Name: string; var Ancestor, RootAncestor: TComponent) of object;
+ TWriteMethodPropertyEvent = procedure (Writer: TWriter; Instance: TPersistent;
+ PropInfo: PPropInfo; const MethodValue: TMethod;
+ const DefMethodCodeValue: Pointer; var Handled: boolean) of object;
+
+ TWriter = class(TFiler)
+ private
+ FDriver: TAbstractObjectWriter;
+ FDestroyDriver: Boolean;
+ FRootAncestor: TComponent;
+ FPropPath: String;
+ FAncestorList: TList;
+ FAncestorPos: Integer;
+ FChildPos: Integer;
+ FOnFindAncestor: TFindAncestorEvent;
+ FOnWriteMethodProperty: TWriteMethodPropertyEvent;
+ FOnWriteStringProperty:TReadWriteStringPropertyEvent;
+ procedure AddToAncestorList(Component: TComponent);
+ procedure WriteComponentData(Instance: TComponent);
+ protected
+ procedure SetRoot(ARoot: TComponent); override;
+ procedure WriteBinary(AWriteData: TStreamProc);
+ procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
+ procedure WriteProperties(Instance: TPersistent);
+ function CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectWriter; virtual;
+ public
+ constructor Create(ADriver: TAbstractObjectWriter);
+ constructor Create(Stream: TStream; BufSize: Integer);
+ destructor Destroy; override;
+ procedure DefineProperty(const Name: string;
+ ReadData: TReaderProc; AWriteData: TWriterProc;
+ HasData: Boolean); override;
+ procedure DefineBinaryProperty(const Name: string;
+ ReadData, AWriteData: TStreamProc;
+ HasData: Boolean); override;
+ procedure WriteBoolean(Value: Boolean);
+ procedure WriteCollection(Value: TCollection);
+ procedure WriteComponent(Component: TComponent);
+ procedure WriteChar(Value: Char);
+ procedure WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
+ procedure WriteFloat(const Value: Extended);
+ procedure WriteSingle(const Value: Single);
+{$ifdef HASCURRENCY}
+ procedure WriteCurrency(const Value: Currency);
+{$endif HASCURRENCY}
+ procedure WriteDate(const Value: TDateTime);
+ procedure WriteIdent(const Ident: string);
+ procedure WriteInteger(Value: Longint); overload;
+ procedure WriteInteger(Value: Int64); overload;
+ procedure WriteListBegin;
+ procedure WriteListEnd;
+ procedure WriteRootComponent(ARoot: TComponent);
+ procedure WriteString(const Value: string);
+{$ifdef HASWIDESTRING}
+ procedure WriteWideString(const Value: WideString);
+{$endif HASWIDESTRING}
+ property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
+ property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
+ property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;
+ property OnWriteStringProperty: TReadWriteStringPropertyEvent read FOnWriteStringProperty write FOnWriteStringProperty;
+
+ property Driver: TAbstractObjectWriter read FDriver;
+ end;
+
+
+{ TParser }
+
+ TParser = class(TObject)
+ private
+ FStream: TStream;
+ FOrigin: Longint;
+ FBuffer: PChar;
+ FBufPtr: PChar;
+ FBufEnd: PChar;
+ FSourcePtr: PChar;
+ FSourceEnd: PChar;
+ FTokenPtr: PChar;
+{$ifdef HASWIDESTRING}
+ FString: widestring;
+{$else HASWIDESTRING}
+ FString: ansistring;
+{$endif HASWIDESTRING}
+ FSourceLine: Integer;
+ FSaveChar: Char;
+ FToken: Char;
+ procedure ReadBuffer;
+ procedure SkipBlanks;
+ public
+ constructor Create(Stream: TStream);
+ destructor Destroy; override;
+ procedure CheckToken(T: Char);
+ procedure CheckTokenSymbol(const S: string);
+ procedure Error(const Ident: string);
+ procedure ErrorFmt(const Ident: string; const Args: array of const);
+ procedure ErrorStr(const Message: string);
+ procedure HexToBinary(Stream: TStream);
+ function NextToken: Char;
+ function SourcePos: Longint;
+ function TokenComponentIdent: String;
+ function TokenFloat: Extended;
+ function TokenInt: Longint;
+ function TokenString: string;
+{$ifdef HASWIDESTRING}
+ function TokenWideString: widestring;
+{$endif HASWIDESTRING}
+ function TokenSymbolIs(const S: string): Boolean;
+ property SourceLine: Integer read FSourceLine;
+ property Token: Char read FToken;
+ end;
+
+
+{ TThread }
+{$ifndef VER1_0}
+
+ EThread = class(Exception);
+ EThreadDestroyCalled = class(EThread);
+ TSynchronizeProcVar = procedure;
+ TThreadMethod = procedure of object;
+
+ TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
+ tpTimeCritical);
+
+ TThread = class
+ private
+ FHandle: THandle;
+ FTerminated: Boolean;
+ FSuspended: Boolean;
+ FFreeOnTerminate: Boolean;
+ FFinished: Boolean;
+ FReturnValue: Integer;
+ FOnTerminate: TNotifyEvent;
+ FMethod: TThreadMethod;
+ FSynchronizeException: TObject;
+ FFatalException: TObject;
+ procedure CallOnTerminate;
+ function GetPriority: TThreadPriority;
+ procedure SetPriority(Value: TThreadPriority);
+ procedure SetSuspended(Value: Boolean);
+ protected
+ FThreadID: THandle; // someone might need it for pthread_* calls
+ procedure DoTerminate; virtual;
+ procedure Execute; virtual; abstract;
+ procedure Synchronize(Method: TThreadMethod);
+ property ReturnValue: Integer read FReturnValue write FReturnValue;
+ property Terminated: Boolean read FTerminated;
+{$ifdef Unix}
+ private
+ // see tthread.inc, ThreadFunc and TThread.Resume
+ FSem: Pointer;
+ FInitialSuspended: boolean;
+ FSuspendedExternal: boolean;
+ {$ifdef linux}
+ FPid: LongInt;
+ {$endif}
+{$endif}
+{$ifdef netwlibc}
+ private
+ // see tthread.inc, ThreadFunc and TThread.Resume
+ FSem: Pointer;
+ FInitialSuspended: boolean;
+ FSuspendedExternal: boolean;
+ FPid: LongInt;
+{$endif}
+ public
+ constructor Create(CreateSuspended: Boolean);
+ destructor Destroy; override;
+ procedure Resume;
+ procedure Suspend;
+ procedure Terminate;
+ function WaitFor: Integer;
+ property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
+ property Handle: THandle read FHandle;
+ property Priority: TThreadPriority read GetPriority write SetPriority;
+ property Suspended: Boolean read FSuspended write SetSuspended;
+ property ThreadID: THandle read FThreadID;
+ property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
+ property FatalException: TObject read FFatalException;
+ end;
+
+{$endif}
+
+{ TComponent class }
+
+ TOperation = (opInsert, opRemove);
+ TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
+ csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification,
+ csInline, csDesignInstance);
+ TComponentStyle = set of (csInheritable, csCheckPropAvail, csSubComponent,
+ csTransient);
+ TGetChildProc = procedure (Child: TComponent) of object;
+
+ {
+ TComponentName = type string;
+
+ IVCLComObject = interface
+ function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
+ function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
+ function GetIDsOfNames(const IID: TGUID; Names: Pointer;
+ NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
+ function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
+ Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
+ function SafeCallException(ExceptObject: TObject;
+ ExceptAddr: Pointer): Integer;
+ procedure FreeOnRelease;
+ end;
+ }
+
+{$ifdef HASINTF}
+ IDesignerNotify = interface
+ ['{B971E807-E3A6-11D1-AAB1-00C04FB16FBC}']
+ procedure Modified;
+ procedure Notification(AnObject: TPersistent; Operation: TOperation);
+ end;
+{$endif HASINTF}
+
+ TBasicAction = class;
+
+ { TComponent }
+
+ TComponent = class(TPersistent)
+ private
+ FOwner: TComponent;
+ FName: TComponentName;
+ FTag: Longint;
+ FComponents: TList;
+ FFreeNotifies: TList;
+ FDesignInfo: Longint;
+ FVCLComObject: Pointer;
+ FComponentState: TComponentState;
+ // function GetComObject: IUnknown;
+ function GetComponent(AIndex: Integer): TComponent;
+ function GetComponentCount: Integer;
+ function GetComponentIndex: Integer;
+ procedure Insert(AComponent: TComponent);
+ procedure ReadLeft(Reader: TReader);
+ procedure ReadTop(Reader: TReader);
+ procedure Remove(AComponent: TComponent);
+ procedure RemoveNotification(AComponent: TComponent);
+ procedure SetComponentIndex(Value: Integer);
+ procedure SetReference(Enable: Boolean);
+ procedure WriteLeft(Writer: TWriter);
+ procedure WriteTop(Writer: TWriter);
+ protected
+ FComponentStyle: TComponentStyle;
+ procedure ChangeName(const NewName: TComponentName);
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
+ function GetChildOwner: TComponent; dynamic;
+ function GetChildParent: TComponent; dynamic;
+ function GetNamePath: string; override;
+ function GetOwner: TPersistent; override;
+ procedure Loaded; virtual;
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); virtual;
+ procedure PaletteCreated; dynamic;
+ procedure ReadState(Reader: TReader); virtual;
+ procedure SetAncestor(Value: Boolean);
+ procedure SetDesigning(Value: Boolean);
+ procedure SetName(const NewName: TComponentName); virtual;
+ procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
+ procedure SetParentComponent(Value: TComponent); dynamic;
+ procedure Updating; dynamic;
+ procedure Updated; dynamic;
+ class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); dynamic;
+ procedure ValidateRename(AComponent: TComponent;
+ const CurName, NewName: string); virtual;
+ procedure ValidateContainer(AComponent: TComponent); dynamic;
+ procedure ValidateInsert(AComponent: TComponent); dynamic;
+{$ifdef HASINTF}
+ { IUnknown }
+ function QueryInterface(const IID: TGUID; out Obj): Hresult; virtual; stdcall;
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+{$endif HASINTF}
+ { IDispatch }
+ //!!!! function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
+ //!!!! function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
+ //!!!! function GetIDsOfNames(const IID: TGUID; Names: Pointer;
+ //!!!! NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
+ //!!!! function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
+ //!!!! Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
+ public
+ //!! Moved temporary
+ procedure WriteState(Writer: TWriter); virtual;
+ constructor Create(AOwner: TComponent); virtual;
+ procedure BeforeDestruction; override;
+ destructor Destroy; override;
+ procedure DestroyComponents;
+ procedure Destroying;
+ function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
+ function FindComponent(const AName: string): TComponent;
+ procedure FreeNotification(AComponent: TComponent);
+ procedure RemoveFreeNotification(AComponent: TComponent);
+ procedure FreeOnRelease;
+ function GetParentComponent: TComponent; dynamic;
+ function HasParent: Boolean; dynamic;
+ procedure InsertComponent(AComponent: TComponent);
+ procedure RemoveComponent(AComponent: TComponent);
+ function SafeCallException(ExceptObject: TObject;
+ ExceptAddr: Pointer): Integer; override;
+ procedure SetSubComponent(ASubComponent: Boolean);
+ function UpdateAction(Action: TBasicAction): Boolean; dynamic;
+ // property ComObject: IUnknown read GetComObject;
+ property Components[Index: Integer]: TComponent read GetComponent;
+ property ComponentCount: Integer read GetComponentCount;
+ property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
+ property ComponentState: TComponentState read FComponentState;
+ property ComponentStyle: TComponentStyle read FComponentStyle;
+ property DesignInfo: Longint read FDesignInfo write FDesignInfo;
+ property Owner: TComponent read FOwner;
+ property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
+ published
+ property Name: TComponentName read FName write SetName stored False;
+ property Tag: Longint read FTag write FTag default 0;
+ end;
+
+{ TBasicActionLink }
+
+ TBasicActionLink = class(TObject)
+ private
+ FOnChange: TNotifyEvent;
+ protected
+ FAction: TBasicAction;
+ procedure AssignClient(AClient: TObject); virtual;
+ procedure Change; virtual;
+ function IsOnExecuteLinked: Boolean; virtual;
+ procedure SetAction(Value: TBasicAction); virtual;
+ procedure SetOnExecute(Value: TNotifyEvent); virtual;
+ public
+ constructor Create(AClient: TObject); virtual;
+ destructor Destroy; override;
+ function Execute(AComponent: TComponent{$ifndef VER1_0} = nil{$endif}): Boolean; virtual;
+ function Update: Boolean; virtual;
+ property Action: TBasicAction read FAction write SetAction;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ end;
+
+ TBasicActionLinkClass = class of TBasicActionLink;
+
+{ TBasicAction }
+
+ TBasicAction = class(TComponent)
+ private
+ FActionComponent: TComponent;
+ FOnChange: TNotifyEvent;
+ FOnExecute: TNotifyEvent;
+ FOnUpdate: TNotifyEvent;
+ protected
+ FClients: TList;
+ procedure Change; virtual;
+ procedure SetOnExecute(Value: TNotifyEvent); virtual;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function HandlesTarget(Target: TObject): Boolean; virtual;
+ procedure UpdateTarget(Target: TObject); virtual;
+ procedure ExecuteTarget(Target: TObject); virtual;
+ function Execute: Boolean; dynamic;
+ procedure RegisterChanges(Value: TBasicActionLink);
+ procedure UnRegisterChanges(Value: TBasicActionLink);
+ function Update: Boolean; virtual;
+ property ActionComponent: TComponent read FActionComponent write FActionComponent;
+ property OnExecute: TNotifyEvent read FOnExecute write SetOnExecute;
+ property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
+ end;
+
+{ TBasicAction class reference type }
+
+ TBasicActionClass = class of TBasicAction;
+
+{ Component registration handlers }
+
+ TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
+
+{$ifdef HASINTF}
+ IInterfaceList = interface ['{285DEA8A-B865-11D1-AAA7-00C04FB17A72}']
+ function Get(i : Integer) : IUnknown;
+ function GetCapacity : Integer;
+ function GetCount : Integer;
+ procedure Put(i : Integer;item : IUnknown);
+ procedure SetCapacity(NewCapacity : Integer);
+ procedure SetCount(NewCount : Integer);
+ procedure Clear;
+ procedure Delete(index : Integer);
+ procedure Exchange(index1,index2 : Integer);
+ function First : IUnknown;
+ function IndexOf(item : IUnknown) : Integer;
+ function Add(item : IUnknown) : Integer;
+ procedure Insert(i : Integer;item : IUnknown);
+ function Last : IUnknown;
+ function Remove(item : IUnknown): Integer;
+ procedure Lock;
+ procedure Unlock;
+ property Capacity : Integer read GetCapacity write SetCapacity;
+ property Count : Integer read GetCount write SetCount;
+ property Items[index : Integer] : IUnknown read Get write Put;default;
+ end;
+
+ TInterfaceList = class(TInterfacedObject,IInterfaceList)
+ private
+ FList : TThreadList;
+ protected
+ function Get(i : Integer) : IUnknown;
+ function GetCapacity : Integer;
+ function GetCount : Integer;
+ procedure Put(i : Integer;item : IUnknown);
+ procedure SetCapacity(NewCapacity : Integer);
+ procedure SetCount(NewCount : Integer);
+ public
+ constructor Create;
+ destructor Destroy;
+
+ procedure Clear;
+ procedure Delete(index : Integer);
+ procedure Exchange(index1,index2 : Integer);
+ function First : IUnknown;
+ function IndexOf(item : IUnknown) : Integer;
+ function Add(item : IUnknown) : Integer;
+ procedure Insert(i : Integer;item : IUnknown);
+ function Last : IUnknown;
+ function Remove(item : IUnknown): Integer;
+ procedure Lock;
+ procedure Unlock;
+
+ function Expand : TInterfaceList;
+
+ property Capacity : Integer read GetCapacity write SetCapacity;
+ property Count : Integer read GetCount write SetCount;
+ property Items[Index : Integer] : IUnknown read Get write Put;default;
+ end;
+{$endif HASINTF}
+
+{ ---------------------------------------------------------------------
+ TDatamodule support
+ ---------------------------------------------------------------------}
+ TDataModule = class(TComponent)
+ private
+ FDPos: TPoint;
+ FDSize: TPoint;
+ FOnCreate: TNotifyEvent;
+ FOnDestroy: TNotifyEvent;
+ FOldOrder : Boolean;
+ Procedure ReadT(Reader: TReader);
+ Procedure WriteT(Writer: TWriter);
+ Procedure ReadL(Reader: TReader);
+ Procedure WriteL(Writer: TWriter);
+ Procedure ReadW(Reader: TReader);
+ Procedure WriteW(Writer: TWriter);
+ Procedure ReadH(Reader: TReader);
+ Procedure WriteH(Writer: TWriter);
+ protected
+ Procedure DoCreate; virtual;
+ Procedure DoDestroy; virtual;
+ Procedure DefineProperties(Filer: TFiler); override;
+ Procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+ Function HandleCreateException: Boolean; virtual;
+ Procedure ReadState(Reader: TReader); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ Constructor CreateNew(AOwner: TComponent);
+ Constructor CreateNew(AOwner: TComponent; CreateMode: Integer); virtual;
+ destructor Destroy; override;
+ Procedure AfterConstruction; override;
+ Procedure BeforeDestruction; override;
+ property DesignOffset: TPoint read FDPos write FDPos;
+ property DesignSize: TPoint read FDSize write FDSize;
+ published
+ property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
+ property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+ property OldCreateOrder: Boolean read FOldOrder write FOldOrder;
+ end;
+
+var
+ // IDE hooks for TDatamodule support.
+ AddDataModule : procedure (DataModule: TDataModule) of object;
+ RemoveDataModule : procedure (DataModule: TDataModule) of object;
+ ApplicationHandleException : procedure (Sender: TObject) of object;
+ ApplicationShowException : procedure (E: Exception) of object;
+
+{$ifndef VER1_0}
+{ ---------------------------------------------------------------------
+ tthread helpers
+ ---------------------------------------------------------------------}
+
+{ procedure to be called when gui thread is ready to execute method
+}
+procedure CheckSynchronize(timeout : longint=0);
+
+var
+ { method proc that is called to trigger gui thread to execute a
+method }
+ WakeMainThread : TNotifyEvent = nil;
+{$endif}
+
+{ ---------------------------------------------------------------------
+ General streaming and registration routines
+ ---------------------------------------------------------------------}
+
+
+var
+ RegisterComponentsProc: procedure(const Page: string;
+ ComponentClasses: array of TComponentClass);
+ RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass);
+{!!!! RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
+ AxRegType: TActiveXRegType) = nil;
+ CurrentGroup: Integer = -1;
+ CreateVCLComObjectProc: procedure(Component: TComponent) = nil;}
+
+{ Point and rectangle constructors }
+
+function Point(AX, AY: Integer): TPoint;
+function SmallPoint(AX, AY: SmallInt): TSmallPoint;
+function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
+function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
+
+{ Class registration routines }
+
+procedure RegisterClass(AClass: TPersistentClass);
+procedure RegisterClasses(AClasses: array of TPersistentClass);
+procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
+procedure UnRegisterClass(AClass: TPersistentClass);
+procedure UnRegisterClasses(AClasses: array of TPersistentClass);
+procedure UnRegisterModuleClasses(Module: HMODULE);
+function FindClass(const AClassName: string): TPersistentClass;
+function GetClass(const AClassName: string): TPersistentClass;
+procedure StartClassGroup(AClass: TPersistentClass);
+procedure GroupDescendentsWith(AClass, AClassGroup: TPersistentClass);
+function ActivateClassGroup(AClass: TPersistentClass): TPersistentClass;
+function ClassGroupOf(AClass: TPersistentClass): TPersistentClass;
+function ClassGroupOf(Instance: TPersistent): TPersistentClass;
+
+{ Component registration routines }
+
+procedure RegisterComponents(const Page: string;
+ ComponentClasses: array of TComponentClass);
+procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
+procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
+ AxRegType: TActiveXRegType);
+
+{$ifdef HASINTF}
+var
+ GlobalNameSpace: IReadWriteSync;
+{$endif HASINTF}
+
+{ Object filing routines }
+
+type
+ TIdentMapEntry = record
+ Value: Integer;
+ Name: String;
+ end;
+
+ TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
+ TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
+ TFindGlobalComponent = function(const Name: string): TComponent;
+ TInitComponentHandler = function(Instance: TComponent; RootAncestor : TClass): boolean;
+
+var
+ MainThreadID: TThreadID;
+
+procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;
+ IntToIdentFn: TIntToIdent);
+function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
+function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
+
+procedure RegisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
+procedure UnregisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
+function FindGlobalComponent(const Name: string): TComponent;
+
+function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
+function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
+function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
+function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
+function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
+procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
+procedure RegisterInitComponentHandler(ComponentClass: TComponentClass; Handler: TInitComponentHandler);
+
+procedure GlobalFixupReferences;
+procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
+procedure GetFixupInstanceNames(Root: TComponent;
+ const ReferenceRootName: string; Names: TStrings);
+procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
+ NewRootName: string);
+procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
+procedure RemoveFixups(Instance: TPersistent);
+function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
+
+procedure BeginGlobalLoading;
+procedure NotifyGlobalLoading;
+procedure EndGlobalLoading;
+
+function CollectionsEqual(C1, C2: TCollection): Boolean;
+
+{ Object conversion routines }
+
+procedure ObjectBinaryToText(Input, Output: TStream);
+procedure ObjectTextToBinary(Input, Output: TStream);
+
+procedure ObjectResourceToText(Input, Output: TStream);
+procedure ObjectTextToResource(Input, Output: TStream);
+
+{ Utility routines }
+
+function LineStart(Buffer, BufPos: PChar): PChar;
+procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
+function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
+
+{
+ $Log: classesh.inc,v $
+ Revision 1.55 2005/05/07 17:03:34 florian
+ + UpdateCount property
+
+ Revision 1.54 2005/05/04 06:53:06 michael
+ * Removed TFPList.grow
+
+ Revision 1.53 2005/04/15 07:21:09 michael
+ + Streaming of subcomponents added by Marc Weustink
+
+ Revision 1.52 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.51 2005/04/10 16:26:55 michael
+ + Made TCollectionItem.SetCollection Protected&virtual, as in Delphi (Reported by Uberto Barbini)
+
+ Revision 1.50 2005/04/09 20:37:08 michael
+ + Patch from Uberto Barbini to allow creating streams with different drivers
+
+ Revision 1.49 2005/04/09 17:26:08 florian
+ + classes.mainthreadid is set now
+ + rtleventresetevent
+ + rtleventwairfor with timeout
+ + checksynchronize with timeout
+ * race condition in synchronize fixed
+
+ Revision 1.48 2005/04/05 21:05:31 peter
+ * call initspecialchars if one of the specialchars is configured
+ for the first time
+
+ Revision 1.47 2005/03/25 20:07:43 peter
+ * add const to 64bit seeks
+
+ Revision 1.46 2005/03/16 20:48:03 michael
+ + Faster TList from Dean Zobec
+
+ Revision 1.45 2005/03/09 20:50:11 florian
+ * C. Western: utf-8 reading from resource files
+
+ Revision 1.44 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.43 2005/03/07 17:25:46 peter
+ * use separate boolean to initialize specialchars
+
+ Revision 1.42 2005/03/07 16:35:19 peter
+ * Object text format of widestrings patch from Martin Schreiber
+
+ Revision 1.41 2005/03/03 22:15:32 florian
+ + tcollection.insert implementation
+
+ Revision 1.40 2005/02/25 23:02:05 florian
+ + implemented D7 compliant FindGlobalComponents
+
+ Revision 1.39 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.38 2005/02/17 12:14:10 marco
+ * shiftstateenum
+
+ Revision 1.37 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.36 2005/02/06 20:31:35 florian
+ + GlobalNameSpace
+
+ Revision 1.35 2005/02/05 22:03:49 michael
+ + Implemented DelimitedText, FDelimiter etc.
+
+ Revision 1.34 2005/02/03 20:17:05 florian
+ + BinToHex and HexToBin from Marco added
+
+ Revision 1.33 2005/02/03 20:11:06 florian
+ + added case sensitivity to tstringlist
+
+ Revision 1.32 2005/02/03 19:51:48 florian
+ * made the tstrings.index* functions virtual
+
+ Revision 1.31 2005/02/03 19:10:16 florian
+ + tcollection.owner
+
+ Revision 1.30 2005/02/03 18:42:42 florian
+ * some delphi compatibility fixes
+
+ Revision 1.29 2005/02/02 20:22:15 florian
+ + TCollection nofication mechanisms added
+
+ Revision 1.28 2005/02/02 19:56:11 florian
+ + PaletteCreated added
+ + TCollectionNotification added
+
+ Revision 1.27 2005/02/02 19:39:59 florian
+ * empty class grouping functions
+
+}
diff --git a/rtl/objpas/classes/collect.inc b/rtl/objpas/classes/collect.inc
new file mode 100644
index 0000000000..76f8a353ac
--- /dev/null
+++ b/rtl/objpas/classes/collect.inc
@@ -0,0 +1,380 @@
+{
+ $Id: collect.inc,v 1.8 2005/03/03 22:15:32 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TCollectionItem *}
+{****************************************************************************}
+
+
+function TCollectionItem.GetIndex: Integer;
+
+begin
+ if FCollection<>nil then
+ Result:=FCollection.FItems.IndexOf(Pointer(Self))
+ else
+ Result:=-1;
+end;
+
+
+
+procedure TCollectionItem.SetCollection(Value: TCollection);
+
+begin
+ IF Value<>FCollection then
+ begin
+ If FCollection<>Nil then FCollection.RemoveItem(Self);
+ if Value<>Nil then Value.InsertItem(Self);
+ FCollection:=Value;
+ end;
+end;
+
+
+
+procedure TCollectionItem.Changed(AllItems: Boolean);
+
+begin
+ If (FCollection<>Nil) then
+ begin
+ If AllItems then
+ FCollection.Update(Nil)
+ else
+ FCollection.Update(Self);
+ end;
+end;
+
+
+
+function TCollectionItem.GetNamePath: string;
+
+begin
+ If FCollection<>Nil then
+ Result:=FCollection.GetNamePath+'['+IntToStr(Index)+']'
+ else
+ Result:=ClassName;
+end;
+
+
+function TCollectionItem.GetOwner: TPersistent;
+
+begin
+ Result:=FCollection;
+end;
+
+
+
+function TCollectionItem.GetDisplayName: string;
+
+begin
+ Result:=ClassName;
+end;
+
+
+
+procedure TCollectionItem.SetIndex(Value: Integer);
+
+Var Temp : Longint;
+
+begin
+ Temp:=GetIndex;
+ If (Temp>-1) and (Temp<>Value) then
+ begin
+ FCollection.FItems.Move(Temp,Value);
+ Changed(True);
+ end;
+end;
+
+
+procedure TCollectionItem.SetDisplayName(const Value: string);
+
+begin
+ Changed(False);
+end;
+
+
+
+constructor TCollectionItem.Create(ACollection: TCollection);
+
+begin
+ Inherited Create;
+ SetCollection(ACollection);
+end;
+
+
+
+destructor TCollectionItem.Destroy;
+
+begin
+ SetCollection(Nil);
+ Inherited Destroy;
+end;
+
+{****************************************************************************}
+{* TCollection *}
+{****************************************************************************}
+
+function TCollection.Owner: TPersistent;
+begin
+ result:=getowner;
+end;
+
+
+function TCollection.GetCount: Integer;
+
+begin
+ If Assigned(FItems) Then
+ Result:=FItems.Count
+ else
+ Result:=0;
+end;
+
+
+Procedure TCollection.SetPropName;
+
+begin
+ //!! Should be replaced by the proper routines.
+ FPropName:='';
+end;
+
+
+function TCollection.GetPropName: string;
+
+Var TheOWner : TPersistent;
+
+begin
+ Result:=FPropNAme;
+ TheOWner:=GetOwner;
+ If (Result<>'') or (TheOwner=Nil) Or (TheOwner.Classinfo=Nil) then exit;
+ SetPropName;
+ Result:=FPropName;
+end;
+
+
+procedure TCollection.InsertItem(Item: TCollectionItem);
+begin
+ If Not(Item Is FitemClass) then
+ exit;
+ FItems.add(Pointer(Item));
+ Item.FID:=FNextID;
+ inc(FNextID);
+ SetItemName(Item);
+ Notify(Item,cnAdded);
+ Changed;
+end;
+
+
+procedure TCollection.RemoveItem(Item: TCollectionItem);
+begin
+ Notify(Item,cnExtracting);
+ FItems.Remove(Pointer(Item));
+ Item.FCollection:=Nil;
+ Changed;
+end;
+
+
+function TCollection.GetAttrCount: Integer;
+begin
+ Result:=0;
+end;
+
+
+function TCollection.GetAttr(Index: Integer): string;
+begin
+ Result:='';
+end;
+
+
+function TCollection.GetItemAttr(Index, ItemIndex: Integer): string;
+begin
+ Result:=TCollectionItem(FItems.Items[ItemIndex]).DisplayName;
+end;
+
+
+function TCollection.GetNamePath: string;
+Var
+ OwnerName,ThePropName : String;
+begin
+ Result:=ClassName;
+ If GetOwner=Nil then Exit;
+ OwnerName:=GetOwner.GetNamePath;
+ If OwnerName='' then Exit;
+ ThePropName:=PropName;
+ if ThePropName='' then exit;
+ Result:=OwnerName+'.'+PropName;
+end;
+
+
+procedure TCollection.Changed;
+begin
+ if FUpdateCount=0 then
+ Update(Nil);
+end;
+
+
+function TCollection.GetItem(Index: Integer): TCollectionItem;
+begin
+ Result:=TCollectionItem(FItems.Items[Index]);
+end;
+
+
+procedure TCollection.SetItem(Index: Integer; Value: TCollectionItem);
+begin
+ TCollectionItem(FItems.items[Index]).Assign(Value);
+end;
+
+
+procedure TCollection.SetItemName(Item: TCollectionItem);
+begin
+end;
+
+
+
+procedure TCollection.Update(Item: TCollectionItem);
+begin
+end;
+
+
+constructor TCollection.Create(AItemClass: TCollectionItemClass);
+begin
+ inherited create;
+ FItemClass:=AItemClass;
+ FItems:=TList.Create;
+end;
+
+
+destructor TCollection.Destroy;
+begin
+ If Assigned(FItems) Then Clear;
+ FItems.Free;
+ Inherited Destroy;
+end;
+
+
+function TCollection.Add: TCollectionItem;
+begin
+ Result:=FItemClass.Create(Self);
+end;
+
+
+procedure TCollection.Assign(Source: TPersistent);
+Var I : Longint;
+begin
+ If Source is TCollection then
+ begin
+ Clear;
+ For I:=0 To TCollection(Source).Count-1 do
+ Add.Assign(TCollection(Source).Items[I]);
+ exit;
+ end
+ else
+ Inherited Assign(Source);
+end;
+
+
+procedure TCollection.BeginUpdate;
+begin
+ inc(FUpdateCount);
+end;
+
+
+procedure TCollection.Clear;
+begin
+ If Assigned(FItems) then
+ While FItems.Count>0 do TCollectionItem(FItems.Last).Free;
+end;
+
+
+procedure TCollection.EndUpdate;
+begin
+ dec(FUpdateCount);
+ if FUpdateCount=0 then
+ Changed;
+end;
+
+
+function TCollection.FindItemID(ID: Integer): TCollectionItem;
+Var
+ I : Longint;
+begin
+ Result:=Nil;
+ For I:=0 to Fitems.Count-1 do
+ begin
+ Result:=TCollectionItem(FItems.items[I]);
+ If Result.Id=Id then
+ exit;
+ end;
+end;
+
+
+procedure TCollection.Delete(Index: Integer);
+begin
+ Notify(TCollectionItem(FItems[Index]),cnDeleting);
+ TCollectionItem(FItems[Index]).Free;
+end;
+
+
+function TCollection.Insert(Index: Integer): TCollectionItem;
+begin
+ Result:=Add;
+ Result.Index:=Index;
+end;
+
+
+procedure TCollection.Notify(Item: TCollectionItem;Action: TCollectionNotification);
+begin
+end;
+
+
+{****************************************************************************}
+{* TOwnedCollection *}
+{****************************************************************************}
+
+
+
+Constructor TOwnedCollection.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
+
+Begin
+ FOwner := AOwner;
+ inherited Create(AItemClass);
+end;
+
+
+
+Function TOwnedCollection.GetOwner: TPersistent;
+
+begin
+ Result:=FOwner;
+end;
+
+
+
+{
+ $Log: collect.inc,v $
+ Revision 1.8 2005/03/03 22:15:32 florian
+ + tcollection.insert implementation
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.6 2005/02/03 19:10:16 florian
+ + tcollection.owner
+
+ Revision 1.5 2005/02/02 20:22:15 florian
+ + TCollection nofication mechanisms added
+
+ Revision 1.4 2005/02/01 21:32:55 florian
+ + tcollection.updatecount support added
+
+ Revision 1.3 2005/02/01 08:41:08 michael
+ + Added TCollection.Delete
+
+}
diff --git a/rtl/objpas/classes/compon.inc b/rtl/objpas/classes/compon.inc
new file mode 100644
index 0000000000..429c79b3bd
--- /dev/null
+++ b/rtl/objpas/classes/compon.inc
@@ -0,0 +1,607 @@
+{
+ $Id: compon.inc,v 1.9 2005/04/15 07:21:09 michael Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************}
+{* TComponent *}
+{****************************************************************************}
+
+Type
+ Longrec = Packed Record
+ Hi,lo : word;
+ end;
+
+Function TComponent.GetComponent(AIndex: Integer): TComponent;
+
+begin
+ If not assigned(FComponents) then
+ Result:=Nil
+ else
+ Result:=TComponent(FComponents.Items[Aindex]);
+end;
+
+
+Function TComponent.GetComponentCount: Integer;
+
+begin
+ If not assigned(FComponents) then
+ result:=0
+ else
+ Result:=FComponents.Count;
+end;
+
+
+Function TComponent.GetComponentIndex: Integer;
+
+begin
+ If Assigned(FOwner) and Assigned(FOwner.FComponents) then
+ Result:=FOWner.FComponents.IndexOf(Self)
+ else
+ Result:=-1;
+end;
+
+
+Procedure TComponent.Insert(AComponent: TComponent);
+
+begin
+ If not assigned(FComponents) then
+ FComponents:=TList.Create;
+ FComponents.Add(AComponent);
+ AComponent.FOwner:=Self;
+end;
+
+
+Procedure TComponent.ReadLeft(Reader: TReader);
+
+begin
+ LongRec(FDesignInfo).Lo:=Reader.ReadInteger;
+end;
+
+
+Procedure TComponent.ReadTop(Reader: TReader);
+
+begin
+ LongRec(FDesignInfo).Hi:=Reader.ReadInteger;
+end;
+
+
+Procedure TComponent.Remove(AComponent: TComponent);
+
+begin
+ AComponent.FOwner:=Nil;
+ If assigned(FCOmponents) then
+ begin
+ FComponents.Remove(AComponent);
+ IF FComponents.Count=0 then
+ begin
+ FComponents.Free;
+ FComponents:=Nil;
+ end;
+ end;
+end;
+
+
+Procedure TComponent.RemoveNotification(AComponent: TComponent);
+
+begin
+ if FFreeNotifies<>nil then
+ begin
+ FFreeNotifies.Remove(AComponent);
+ if FFreeNotifies.Count=0 then
+ begin
+ FFreeNotifies.Free;
+ FFreeNotifies:=nil;
+ Exclude(FComponentState,csFreeNotification);
+ end;
+ end;
+end;
+
+
+Procedure TComponent.SetComponentIndex(Value: Integer);
+
+Var Temp,Count : longint;
+
+begin
+ If Not assigned(Fowner) then exit;
+ Temp:=getcomponentindex;
+ If temp<0 then exit;
+ If value<0 then value:=0;
+ Count:=Fowner.FComponents.Count;
+ If Value>=Count then value:=count-1;
+ If Value<>Temp then
+ begin
+ FOWner.FComponents.Delete(Temp);
+ FOwner.FComponents.Insert(Value,Self);
+ end;
+end;
+
+
+Procedure TComponent.SetReference(Enable: Boolean);
+
+var
+ Field: ^TComponent;
+begin
+ if Assigned(Owner) then
+ begin
+ Field := Owner.FieldAddress(Name);
+ if Assigned(Field) then
+ if Enable then
+ Field^ := Self
+ else
+ Field^ := nil;
+ end;
+end;
+
+
+Procedure TComponent.WriteLeft(Writer: TWriter);
+
+begin
+ Writer.WriteInteger(LongRec(FDesignInfo).Lo);
+end;
+
+
+Procedure TComponent.WriteTop(Writer: TWriter);
+
+begin
+ Writer.WriteInteger(LongRec(FDesignInfo).Hi);
+end;
+
+
+Procedure TComponent.ChangeName(const NewName: TComponentName);
+
+begin
+ FName:=NewName;
+end;
+
+
+Procedure TComponent.DefineProperties(Filer: TFiler);
+
+Var Ancestor : TComponent;
+ Temp : longint;
+
+begin
+ Temp:=0;
+ Ancestor:=TComponent(Filer.Ancestor);
+ If Assigned(Ancestor) then Temp:=Ancestor.FDesignInfo;
+ Filer.Defineproperty('left',@readleft,@writeleft,
+ (longrec(FDesignInfo).Lo<>Longrec(temp).Lo));
+ Filer.Defineproperty('top',@readtop,@writetop,
+ (longrec(FDesignInfo).Hi<>Longrec(temp).Hi));
+end;
+
+
+Procedure TComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+begin
+ // Does nothing.
+end;
+
+
+Function TComponent.GetChildOwner: TComponent;
+
+begin
+ Result:=Nil;
+end;
+
+
+Function TComponent.GetChildParent: TComponent;
+
+begin
+ Result:=Self;
+end;
+
+
+Function TComponent.GetNamePath: string;
+
+begin
+ Result:=FName;
+end;
+
+
+Function TComponent.GetOwner: TPersistent;
+
+begin
+ Result:=FOwner;
+end;
+
+
+Procedure TComponent.Loaded;
+
+begin
+ Exclude(FComponentState,csLoading);
+end;
+
+
+Procedure TComponent.Notification(AComponent: TComponent;
+ Operation: TOperation);
+
+Var Runner : Longint;
+
+begin
+ If (Operation=opRemove) and Assigned(FFreeNotifies) then
+ begin
+ FFreeNotifies.Remove(AComponent);
+ If FFreeNotifies.Count=0 then
+ begin
+ FFreeNotifies.Free;
+ FFreenotifies:=Nil;
+ end;
+ end;
+ If assigned(FComponents) then
+ For Runner:=0 To FComponents.Count-1 do
+ TComponent(FComponents.Items[Runner]).Notification(AComponent,Operation);
+end;
+
+
+procedure TComponent.PaletteCreated;
+ begin
+ end;
+
+
+Procedure TComponent.ReadState(Reader: TReader);
+
+begin
+ Reader.ReadData(Self);
+end;
+
+
+Procedure TComponent.SetAncestor(Value: Boolean);
+
+Var Runner : Longint;
+
+begin
+ If Value then
+ Include(FComponentState,csAncestor)
+ else
+ Include(FCOmponentState,csAncestor);
+ if Assigned(FComponents) then
+ For Runner:=0 To FComponents.Count-1 do
+ TComponent(FComponents.Items[Runner]).SetAncestor(Value);
+end;
+
+
+Procedure TComponent.SetDesigning(Value: Boolean);
+
+Var Runner : Longint;
+
+begin
+ If Value then
+ Include(FComponentSTate,csDesigning)
+ else
+ Exclude(FComponentSTate,csDesigning);
+ if Assigned(FComponents) then
+ For Runner:=0 To FComponents.Count - 1 do
+ TComponent(FComponents.items[Runner]).SetDesigning(Value);
+end;
+
+
+Procedure TComponent.SetName(const NewName: TComponentName);
+
+begin
+ If FName=NewName then exit;
+ If not IsValidIdent(NewName) then
+ Raise EComponentError.CreateFmt(SInvalidName,[NewName]);
+ If Assigned(FOwner) Then
+ FOwner.ValidateRename(Self,FName,NewName)
+ else
+ ValidateRename(Nil,FName,NewName);
+ SetReference(False);
+ ChangeName(NewName);
+ Setreference(True);
+end;
+
+
+Procedure TComponent.SetChildOrder(Child: TComponent; Order: Integer);
+
+begin
+ // does nothing
+end;
+
+
+Procedure TComponent.SetParentComponent(Value: TComponent);
+
+begin
+ // Does nothing
+end;
+
+
+Procedure TComponent.Updating;
+
+begin
+ Include (FComponentState,csUpdating);
+end;
+
+
+Procedure TComponent.Updated;
+
+begin
+ Exclude(FComponentState,csUpdating);
+end;
+
+
+class Procedure TComponent.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
+
+begin
+ // For compatibility only.
+end;
+
+
+Procedure TComponent.ValidateRename(AComponent: TComponent;
+ const CurName, NewName: string);
+
+begin
+//!! This contradicts the Delphi manual.
+ If (AComponent<>Nil) and (CurName<>NewName) and (AComponent.Owner = Self) and
+ (FindComponent(NewName)<>Nil) then
+ raise EComponentError.Createfmt(SDuplicateName,[newname]);
+ If (csDesigning in FComponentState) and (FOwner<>Nil) then
+ FOwner.ValidateRename(AComponent,Curname,Newname);
+end;
+
+
+Procedure TComponent.ValidateContainer(AComponent: TComponent);
+
+begin
+end;
+
+
+Procedure TComponent.ValidateInsert(AComponent: TComponent);
+
+begin
+ // Does nothing.
+end;
+
+
+Procedure TComponent.WriteState(Writer: TWriter);
+
+begin
+ Writer.WriteComponentData(Self);
+end;
+
+
+Constructor TComponent.Create(AOwner: TComponent);
+
+begin
+ FComponentStyle:=[csInheritable];
+ If Assigned(AOwner) then AOwner.InsertComponent(Self);
+end;
+
+
+Destructor TComponent.Destroy;
+
+Var
+ I : Integer;
+ C : TComponent;
+
+begin
+ Destroying;
+ If Assigned(FFreeNotifies) then
+ begin
+ I:=FFreeNotifies.Count-1;
+ While (I>=0) do
+ begin
+ C:=TComponent(FFreeNotifies.Items[I]);
+ // Delete, so one component is not notified twice, if it is owned.
+ FFreeNotifies.Delete(I);
+ C.Notification (self,opRemove);
+ If (FFreeNotifies=Nil) then
+ I:=0
+ else if (I>FFreeNotifies.Count) then
+ I:=FFreeNotifies.Count;
+ dec(i);
+ end;
+ FreeAndNil(FFreeNotifies);
+ end;
+ DestroyComponents;
+ If FOwner<>Nil Then FOwner.RemoveComponent(Self);
+ inherited destroy;
+end;
+
+
+Procedure TComponent.BeforeDestruction;
+begin
+ if not(csDestroying in FComponentstate) then
+ Destroying;
+end;
+
+
+Procedure TComponent.DestroyComponents;
+
+Var acomponent: TComponent;
+
+begin
+ While assigned(FComponents) do
+ begin
+ aComponent:=TComponent(FComponents.Last);
+ Remove(aComponent);
+ Acomponent.Destroy;
+ end;
+end;
+
+
+Procedure TComponent.Destroying;
+
+Var Runner : longint;
+
+begin
+ If csDestroying in FComponentstate Then Exit;
+ include (FComponentState,csDestroying);
+ If Assigned(FComponents) then
+ for Runner:=0 to FComponents.Count-1 do
+ TComponent(FComponents.Items[Runner]).Destroying;
+end;
+
+
+function TComponent.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ if Action.HandlesTarget(Self) then
+ begin
+ Action.ExecuteTarget(Self);
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+
+Function TComponent.FindComponent(const AName: string): TComponent;
+
+Var I : longint;
+
+begin
+ Result:=Nil;
+ If (AName='') or Not assigned(FComponents) then exit;
+ For i:=0 to FComponents.Count-1 do
+ if TComponent(FComponents[I]).Name=AName then
+ begin
+ Result:=TComponent(FComponents.Items[I]);
+ exit;
+ end;
+end;
+
+
+Procedure TComponent.FreeNotification(AComponent: TComponent);
+
+begin
+ If (Owner<>Nil) and (AComponent=Owner) then exit;
+ if csDestroying in ComponentState then
+ AComponent.Notification(Self,opRemove)
+ else
+ begin
+ If not (Assigned(FFreeNotifies)) then
+ FFreeNotifies:=TList.Create;
+ If FFreeNotifies.IndexOf(AComponent)=-1 then
+ begin
+ FFreeNotifies.Add(AComponent);
+ AComponent.FreeNotification (self);
+ end;
+ end;
+end;
+
+
+procedure TComponent.RemoveFreeNotification(AComponent: TComponent);
+begin
+ RemoveNotification(AComponent);
+ AComponent.RemoveNotification (self);
+end;
+
+
+Procedure TComponent.FreeOnRelease;
+
+begin
+ // Delphi compatibility only at the moment.
+end;
+
+
+Function TComponent.GetParentComponent: TComponent;
+
+begin
+ Result:=Nil;
+end;
+
+
+Function TComponent.HasParent: Boolean;
+
+begin
+ Result:=False;
+end;
+
+
+Procedure TComponent.InsertComponent(AComponent: TComponent);
+
+begin
+ AComponent.ValidateContainer(Self);
+ ValidateRename(AComponent,'',AComponent.FName);
+ Insert(AComponent);
+ AComponent.SetReference(True);
+ If csDesigning in FComponentState then
+ AComponent.SetDesigning(true);
+ Notification(AComponent,opInsert);
+end;
+
+
+Procedure TComponent.RemoveComponent(AComponent: TComponent);
+
+begin
+ Notification(AComponent,opRemove);
+ AComponent.SetReference(False);
+ Remove(AComponent);
+ Acomponent.Setdesigning(False);
+ ValidateRename(AComponent,AComponent.FName,'');
+end;
+
+
+Function TComponent.SafeCallException(ExceptObject: TObject;
+ ExceptAddr: Pointer): Integer;
+
+begin
+ SafeCallException:=0;
+end;
+
+procedure TComponent.SetSubComponent(ASubComponent: Boolean);
+begin
+ if ASubComponent then
+ Include(FComponentStyle, csSubComponent)
+ else
+ Exclude(FComponentStyle, csSubComponent);
+end;
+
+
+function TComponent.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ if Action.HandlesTarget(Self) then
+ begin
+ Action.UpdateTarget(Self);
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+{$ifdef HASINTF}
+function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
+begin
+ if GetInterface(IID, Obj) then
+ result:=S_OK
+ else
+ result:=E_NOINTERFACE;
+end;
+
+function TComponent._AddRef: Integer;stdcall;
+begin
+ result:=-1;
+end;
+
+function TComponent._Release: Integer;stdcall;
+begin
+ result:=-1;
+end;
+
+{$endif HASINTF}
+
+{
+ $Log: compon.inc,v $
+ Revision 1.9 2005/04/15 07:21:09 michael
+ + Streaming of subcomponents added by Marc Weustink
+
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.7 2005/02/02 19:56:11 florian
+ + PaletteCreated added
+ + TCollectionNotification added
+
+ Revision 1.6 2005/01/31 19:41:39 peter
+ * interface additions
+
+}
diff --git a/rtl/objpas/classes/constsg.inc b/rtl/objpas/classes/constsg.inc
new file mode 100644
index 0000000000..63dfbb9f34
--- /dev/null
+++ b/rtl/objpas/classes/constsg.inc
@@ -0,0 +1,280 @@
+{
+ $Id: constsg.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ SAssignError = '%s kann nicht zu %s zugewiesen werden';
+ SFCreateError = 'Datei %s kann nicht erstellt werden';
+ SFOpenError = 'Datei %s kann nicht geöffnet werden';
+ SReadError = 'Stream-Read-Fehler';
+ SWriteError = 'Stream-Write-Fehler';
+ SMemoryStreamError = 'Expandieren des Speicher-Stream wegen Speichermangel nicht möglich';
+ SCantWriteResourceStreamError = 'In einen zum Lesen geöffneten Ressourcen-Stream kann nicht geschrieben werden';
+ SDuplicateReference = 'Zweimaliger Aufruf von WriteObject für die gleiche Instanz';
+ SClassNotFound = 'Klasse %s nicht gefunden';
+ SInvalidImage = 'Ungültiges Stream-Format';
+ SResNotFound = 'Ressource %s nicht gefunden';
+ SClassMismatch = 'Ressource %s hat die falsche Klasse';
+ SListIndexError = 'Der Index der Liste überschreitet das Maximum (%d)';
+ SListCapacityError = 'Die Kapazität der Liste ist erschöpft (%d)';
+ SListCountError = 'Zu viele Einträge in der Liste (%d)';
+ SSortedListError = 'Operation bei sortierten Stringlisten nicht erlaubt';
+ SDuplicateString = 'In der Stringliste sind Duplikate nicht erlaubt';
+ SInvalidTabIndex = 'Registerindex außerhalb des zulässigen Bereichs';
+ SDuplicateName = 'Eine Komponente mit der Bezeichnung %s existiert bereits';
+ SInvalidName = '''''%s'''' ist kein gültiger Komponentenname';
+ SDuplicateClass = 'Eine Klasse mit der Bezeichnung %s existiert bereits';
+ SNoComSupport = '%s wurde nicht als COM-Klasse registriert';
+ SInvalidInteger = '''''%s'''' ist kein gültiger Integerwert';
+ SLineTooLong = 'Zeile zu lang';
+
+ SInvalidPropertyValue = 'Ungültiger Wert der Eigenschaft';
+ SInvalidPropertyPath = 'Ungültiger Pfad für Eigenschaft';
+ SUnknownProperty = 'Eigenschaft existiert nicht';
+ SReadOnlyProperty = 'Eigenschaft kann nur gelesen werden';
+ SUnknownPropertyType = 'Unbekannter Eigenschaftstyp %d';
+ SPropertyException = 'Fehler beim Lesen von %s%s: %s';
+ SAncestorNotFound = 'Vorfahr für ''%s'' nicht gefunden';
+ SInvalidBitmap = 'Bitmap ist ungültig';
+ SInvalidIcon = 'Ungültiges Symbol';
+ SInvalidMetafile = 'Metadatei ist ungültig';
+ SInvalidPixelFormat = 'Ungültiges Pixelformat';
+ SBitmapEmpty = 'Bitmap ist leer';
+ SScanLine = 'Bereichsüberschreitung bei Zeilenindex';
+ SChangeIconSize = 'Die Größe eines Symbols kann nicht geändert werden';
+ SOleGraphic = 'Ungültige Operation für TOleGraphic';
+ SUnknownExtension = 'Unbekannte Bilddateierweiterung (.%s)';
+ SUnknownClipboardFormat = 'Format der Zwischenablage wird nicht unterstützt';
+ SOutOfResources = 'Systemressourcen erschöpft.';
+ SNoCanvasHandle = 'Leinwand/Bild erlaubt kein Zeichnen';
+ SInvalidImageSize = 'Ungültige Bildgröße';
+ STooManyImages = 'Zu viele Bilder';
+ SDimsDoNotMatch = 'Bildgröße und Bildlistengröße stimmen nicht überein';
+ SInvalidImageList = 'Ungültige ImageList';
+ SReplaceImage = 'Bild kann nicht ersetzt werden';
+ SImageIndexError = 'Ungültiger ImageList-Index';
+ SImageReadFail = 'Die ImageList-Daten konnten nicht aus dem Stream gelesen werden';
+ SImageWriteFail = 'Die ImageList-Daten konnten nicht in den Stream geschrieben werden';
+ SWindowDCError = 'Fehler beim Erstellen des Fenster-Gerätekontexts';
+ SClientNotSet = 'Client von TDrag wurde nicht initialisiert';
+ SWindowClass = 'Fehler beim Erzeugen einer Fensterklasse';
+ SWindowCreate = 'Fehler beim Erzeugen eines Fensters';
+ SCannotFocus = 'Ein deaktiviertes oder unsichtbares Fenster kann nicht den Fokus erhalten';
+ SParentRequired = 'Element ''%s'' hat kein übergeordnetes Fenster';
+ SMDIChildNotVisible = 'Ein MDI-Kindformular kann nicht verborgen werden';
+ SVisibleChanged = 'Eigenschaft Visible kann in OnShow oder OnHide nicht verändert werden';
+ SCannotShowModal = 'Aus einem sichtbaren Fenster kann kein modales gemacht werden';
+ SScrollBarRange = 'Eigenschaft Scrollbar außerhalb des zulässigen Bereichs';
+ SPropertyOutOfRange = 'Eigenschaft %s außerhalb des gültigen Bereichs';
+ SMenuIndexError = 'Menüindex außerhalb des zulässigen Bereichs';
+ SMenuReinserted = 'Menü zweimal eingefügt';
+ SMenuNotFound = 'Untermenü ist nicht im Menü';
+ SNoTimers = 'Nicht genügend Timer verfügbar';
+ SNotPrinting = 'Der Drucker ist nicht am Drucken';
+ SPrinting = 'Das Drucken ist im Gang';
+ SPrinterIndexError = 'Druckerindex außerhalb des zulässigen Bereichs';
+ SInvalidPrinter = 'Ausgewählter Drucker ist ungültig';
+ SDeviceOnPort = '%s an %s';
+ SGroupIndexTooLow = 'GroupIndex kann nicht kleiner sein als der GroupIndex eines vorhergehenden Menüelementes';
+ STwoMDIForms = 'Es ist nur ein MDI-Formular pro Anwendung möglich';
+ SNoMDIForm = 'Formular kann nicht erstellt werden. Zur Zeit sind keine MDI-Formulare aktiv';
+ SRegisterError = 'Ungültige Komponentenregistrierung';
+ SImageCanvasNeedsBitmap = 'Ein Bild kann nur geändert werden, wenn es ein Bitmap enthält';
+ SControlParentSetToSelf = 'Ein Steuerelement kann nicht sich selbst als Vorfahr haben';
+ SOKButton = 'OK';
+ SCancelButton = 'Abbrechen';
+ SYesButton = '&Ja';
+ SNoButton = '&Nein';
+ SHelpButton = '&Hilfe';
+ SCloseButton = '&Schließen';
+ SIgnoreButton = '&Ignorieren';
+ SRetryButton = '&Wiederholen';
+ SAbortButton = 'Abbruch';
+ SAllButton = '&Alles';
+
+ SFB = 'VH';
+ SFG = 'VG';
+ SBG = 'HG';
+ SOldTShape = 'Kann ältere Version von TShape nicht laden';
+ SVMetafiles = 'Metadateien';
+ SVEnhMetafiles = 'Erweiterte Metadateien';
+ SVIcons = 'Symbole';
+ SVBitmaps = 'Bitmaps';
+ SGridTooLarge = 'Gitter zu groß für Operation';
+ STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
+ SIndexOutOfRange = 'Gitterindex außerhalb des zulässigen Bereichs';
+ SFixedColTooBig = 'Die Anzahl fester Spalten muß kleiner sein als die Spaltenanzahl';
+ SFixedRowTooBig = 'Die Anzahl fester Zeilen muß kleiner sein als die Zeilenanzahl';
+ SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
+ SParseError = '%s in Zeile %d';
+
+ SIdentifierExpected = 'Bezeichner erwartet';
+ SStringExpected = 'String erwartet';
+ SNumberExpected = 'Zahl erwartet';
+
+ SCharExpected = '%s erwartet';
+
+ SSymbolExpected = '%s erwartet';
+
+ SInvalidNumber = 'Ungültiger numerischer Wert';
+ SInvalidString = 'Ungültige Stringkonstante';
+ SInvalidProperty = 'Ungültiger Wert der Eigenschaft';
+ SInvalidBinary = 'Ungültiger Binärwert';
+ SOutlineIndexError = 'Gliederungsindex nicht gefunden';
+ SOutlineExpandError = 'Elternknoten muß expandiert sein';
+ SInvalidCurrentItem = 'Ungültiger Wert';
+ SMaskErr = 'Ungültiger Eingabewert';
+ SMaskEditErr = 'Ungültiger Eingabewert. Benutzen Sie die ESC-Taste, um die Änderungen rückgängig zu machen.';
+ SOutlineError = 'Ungültiger Gliederungsindex';
+ SOutlineBadLevel = 'Ungültige Zuweisung von Ebenen';
+ SOutlineSelection = 'Ungültige Auswahl';
+ SOutlineFileLoad = 'Fehler beim Dateiladen';
+ SOutlineLongLine = 'Zeile zu lang';
+ SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
+
+ SMsgDlgWarning = 'Warnung';
+ SMsgDlgError = 'Fehler';
+ SMsgDlgInformation = 'Information';
+ SMsgDlgConfirm = 'Bestätigen';
+ SMsgDlgYes = '&Ja';
+ SMsgDlgNo = '&Nein';
+ SMsgDlgOK = 'OK';
+ SMsgDlgCancel = 'Abbrechen';
+ SMsgDlgHelp = '&Hilfe';
+ SMsgDlgHelpNone = 'Keine Hilfe verfügbar';
+ SMsgDlgHelpHelp = 'Hilfe';
+ SMsgDlgAbort = '&Abbrechen';
+ SMsgDlgRetry = '&Wiederholen';
+ SMsgDlgIgnore = '&Ignorieren';
+ SMsgDlgAll = '&Alles';
+ SMsgDlgNoToAll = '&Alle Nein';
+ SMsgDlgYesToAll = 'A&lle Ja';
+
+ SmkcBkSp = 'Rück';
+ SmkcTab = 'Tab';
+ SmkcEsc = 'Esc';
+ SmkcEnter = 'Enter';
+ SmkcSpace = 'Leertaste';
+ SmkcPgUp = 'BildAuf';
+ SmkcPgDn = 'BildAb';
+ SmkcEnd = 'Ende';
+ SmkcHome = 'Pos1';
+ SmkcLeft = 'Linksbündig';
+ SmkcUp = 'Nach oben';
+ SmkcRight = 'Rechts';
+ SmkcDown = 'Nach unten';
+ SmkcIns = 'Einfg';
+ SmkcDel = 'Entf';
+ SmkcShift = 'Umsch+';
+ SmkcCtrl = 'Strg+';
+ SmkcAlt = 'Alt+';
+
+ srUnknown = '(Unbekannt)';
+ srNone = '(Leer)';
+ SOutOfRange = 'Wert muß zwischen %d und %d liegen';
+ SCannotCreateName = 'Für eine unbenannte Komponente kann kein Standard-Methodennamen erstellt werden';
+
+ SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
+ STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
+ SInvalidDate = '''''%s'''' ist kein gültiges Datum';
+ SInvalidTime = '''''%s'''' ist keine gültige Zeit';
+ SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
+ SInsertLineError = 'Zeile kann nicht eingefügt werden';
+
+ SCannotDragForm = 'Formulare können nicht gezogen werden';
+ SPutObjectError = 'PutObject auf undefiniertes Element';
+ SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
+ SDuplicateCardId = 'Doppelte CardId gefunden';
+
+ SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert ($0%x)';
+ SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
+ SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
+ SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
+
+
+ SDefaultFilter = 'Alle Dateien (*.*)|*.*';
+ sAllFilter = 'Alle Dateien';
+ SNoVolumeLabel = ': [ - Ohne Namen - ]';
+
+ SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
+ SSelectDirCap = 'Verzeichnis auswählen';
+ SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
+ SDirNameCap = 'Verzeichnis&name:';
+ SDrivesCap = '&Laufwerke:';
+ SDirsCap = '&Verzeichnisse:';
+ SFilesCap = '&Dateien: (*.*)';
+ SNetworkCap = 'Ne&tzwerk...';
+
+ SColorPrefix = 'Farbe';
+ SColorTags = 'ABCDEFGHIJKLMNOP';
+
+ SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
+ SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
+
+ SDefault = 'Vorgabe';
+
+ SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
+ SCustomColors = 'Selbstdefinierte Farben';
+ SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
+ SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
+
+ SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
+
+ SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
+
+ SUntitled = '(Unbenannt)';
+
+ SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
+ SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
+ SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
+ SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
+
+ SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
+ SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
+
+ SPictureLabel = 'Bild:';
+ SPictureDesc = ' (%dx%d)';
+ SPreviewLabel = 'Vorschau';
+
+ SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
+
+ SNotOpenErr = 'Kein MCI-Gerät geöffnet';
+ SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
+ SMCINil = '';
+ SMCIAVIVideo = 'AVIVideo';
+ SMCICDAudio = 'CDAudio';
+ SMCIDAT = 'DAT';
+ SMCIDigitalVideo = 'DigitalVideo';
+ SMCIMMMovie = 'MMMovie';
+ SMCIOther = 'Andere';
+ SMCIOverlay = 'Overlay';
+ SMCIScanner = 'Scanner';
+ SMCISequencer = 'Sequencer';
+ SMCIVCR = 'VCR';
+ SMCIVideodisc = 'Videodisc';
+ SMCIWaveAudio = 'WaveAudio';
+ SMCIUnknownError = 'Unbekannter Fehlercode';
+
+ SBoldItalicFont = 'Fett kursiv';
+ SBoldFont = 'Fett';
+ SItalicFont = 'Kursiv';
+ SRegularFont = 'Normal';
+
+ SPropertiesVerb = 'Eigenschaften';
+
+{
+ $Log: constsg.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/constss.inc b/rtl/objpas/classes/constss.inc
new file mode 100644
index 0000000000..2fb6a4aa97
--- /dev/null
+++ b/rtl/objpas/classes/constss.inc
@@ -0,0 +1,279 @@
+{
+ $Id: constss.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ SAssignError = '%s no puede ser assignado a %s';
+ SFCreateError = 'Fichero %s no puede ser creado';
+ SFOpenError = 'Fichero %s no puede ser abierto';
+ SReadError = 'Error-Lectura-Stream';
+ SWriteError = 'Error-Escritura-Stream';
+ SMemoryStreamError = 'No es posible expandir Memoria Stream';
+ SCantWriteResourceStreamError = 'No se puede escribir en un ResourceStream de solo lectura';
+ SDuplicateReference = 'WriteObject fue llamado dos veces por una sola instancia';
+ SClassNotFound = 'Clase %s no encontrada';
+ SInvalidImage = 'Imagen stream ilegal';
+ SResNotFound = 'No se encontro el resource %s';
+ SClassMismatch = 'El resource %s tiene una clase erronea';
+ SListIndexError = 'El indice de lista excede los limites (%d)';
+ SListCapacityError = 'La maxima capacidad de lista a sido alcanzada (%d)';
+ SListCountError = 'Contador de lista demasiado grande (%d)';
+ SSortedListError = 'Operacion no permitida en StringLists ordenado';
+ SDuplicateString = 'Entradas duplicadas no permitidas en StringList';
+ SInvalidTabIndex = 'Registerindex fuera de limites';
+ SDuplicateName = 'Un componente con el nombre %s existe actualmente';
+ SInvalidName = '"%s" no es un nombre identificador valido';
+ SDuplicateClass = 'Una Clase con el nombre %s existe actualmente';
+ SNoComSupport = '%s no esta registrado como COM-Class';
+ SLineTooLong = 'Linea demasiado larga';
+
+ SInvalidPropertyValue = 'Valor de propiedad no valido';
+ SInvalidPropertyPath = 'Path de propiedad no valido';
+ SUnknownProperty = 'Propiedad desconocidad';
+ SReadOnlyProperty = 'Propiedad de solo lectura';
+{N} SUnknownPropertyType = 'Unknown property type %d';
+ SPropertyException = 'Error leyendo %s%s: %s';
+{N} SAncestorNotFound = 'Ancestor of ''%s'' not found.';
+ SInvalidBitmap = 'Bitmap no valido';
+ SInvalidIcon = 'Icono no valido';
+ SInvalidMetafile = 'MetaFile no valido';
+ SInvalidPixelFormat = 'PixelFormat no valido';
+ SBitmapEmpty = 'El bitmap esta vacio';
+ SScanLine = 'Indice de linea fuera de limites';
+ SChangeIconSize = 'No se puede cambiar el tama¤o del icono';
+ SOleGraphic = 'Operacion no valida para TOleGraphic';
+ SUnknownExtension = 'Extension desconocida (.%s)';
+ SUnknownClipboardFormat = 'Formato de Portapapeles desconocido';
+ SOutOfResources = 'Recursos de sistema agotados';
+ SNoCanvasHandle = 'El manejador Canvas no permite dibujar';
+ SInvalidImageSize = 'Tama¤o de imagen no valido';
+ STooManyImages = 'Demasiadas imagenes';
+ SDimsDoNotMatch = 'El tama¤o de la imagen no coincide';
+ SInvalidImageList = 'ImageList no valido';
+ SReplaceImage = 'La imagen no puede ser reemplazada';
+ SImageIndexError = 'ImageList-Index no valido';
+ SImageReadFail = 'Los datos de ImageList no pueden ser leido desde Stream';
+ SImageWriteFail = 'Los datos de ImageList no pueden ser escritos en Stream';
+ SWindowDCError = 'Error cuando??';
+ SClientNotSet = 'El cliente de TDrag no fue iniciado';
+ SWindowClass = 'Error inicializando Window Class';
+ SWindowCreate = 'Error creando una Ventana';
+{?} SCannotFocus = 'Una Ventana invisible or desactivada no puede obtener el foco';
+ SParentRequired = 'El elemento ''%s'' no tiene una ventana padre';
+ SMDIChildNotVisible = 'Una ventana MDI-Child no puede ser ocultada.';
+ SVisibleChanged = 'Una propiedad visual no puede ser cambiada en el manejador OnShow o OnHide';
+{?} SCannotShowModal = 'Una Ventana visible no puede ser hecha modal';
+ SScrollBarRange = 'Propiedad de Scrollbar fuera de limites';
+ SPropertyOutOfRange = 'Propiedad %s fuera de limites';
+ SMenuIndexError = 'Indice de menu fuera de rango';
+ SMenuReinserted = 'Menu reinsertado';
+ SMenuNotFound = 'Entrada de menu no encontra en menu';
+ SNoTimers = 'No hay timers disponibles';
+ SNotPrinting = 'La impresora no esta imprimiendo';
+ SPrinting = 'La impresora esta ocupada';
+ SPrinterIndexError = 'PrinterIndex fuera de rango';
+ SInvalidPrinter = 'La impresora seleccionada no es valida';
+ SDeviceOnPort = '%s en %s';
+ SGroupIndexTooLow = 'GroupIndex tiene que ser mayor que el goupindex del menu predecesor';
+ STwoMDIForms = 'Solo hay una ventana MDI disponible';
+ SNoMDIForm = 'No hay ningun MDI form disponible, none esta activado';
+ SRegisterError = 'Registro invalido';
+ SImageCanvasNeedsBitmap = 'Un Canvas solo puede ser cambiado si contiene un bitmap';
+ SControlParentSetToSelf = 'Un componente no puede tenerse a si mismo como padre';
+ SOKButton = 'Aceptar';
+ SCancelButton = 'Cancelar';
+ SYesButton = '&Si';
+ SNoButton = '&No';
+ SHelpButton = '&Ayuda';
+ SCloseButton = '&Cerrar';
+ SIgnoreButton = '&Ignorar';
+ SRetryButton = '&Reintentar';
+ SAbortButton = 'Abortar';
+ SAllButton = '&Todo';
+
+{?} SFB = 'VH';
+{?} SFG = 'VG';
+{?} SBG = 'HG';
+ SOldTShape = 'No es posible cargar versiones antiguas de TShape';
+ SVMetafiles = 'MetaFiles';
+ SVEnhMetafiles = 'MetaFiles ampliados';
+ SVIcons = 'Iconos';
+ SVBitmaps = 'Bitmaps';
+ SGridTooLarge = 'Malla demasiado grande para esta operacion';
+{?} STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
+ SIndexOutOfRange = 'Indice de malla fuera de rango';
+ SFixedColTooBig = 'El numero de columnas fijas tiene que ser menor que el contador Column';
+ SFixedRowTooBig = 'El numero de filas fijas tiene que ser menor que el contador Row';
+{?} SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
+ SParseError = '%s en Linia %d';
+
+ SIdentifierExpected = 'Falta identificador';
+ SStringExpected = 'Falta string';
+ SNumberExpected = 'Falta numero';
+
+ SCharExpected = 'Falta %s';
+
+ SSymbolExpected = 'Falta %s';
+
+ SInvalidNumber = 'Valor numerico no valido';
+ SInvalidString = 'Constante string no valida';
+ SInvalidProperty = 'Valor de propiedad no valido';
+ SInvalidBinary = 'Binario no valido';
+ SOutlineIndexError = 'Indice de nodo no encontrado';
+ SOutlineExpandError = 'El nodo padre tiene que ser expandido';
+ SInvalidCurrentItem = 'Item no valido';
+ SMaskErr = 'Mascara no valida';
+ SMaskEditErr = 'Mascara no valida. Usa la tecla ESC para deshacer los cambios.';
+ SOutlineError = 'Indice de nodo no valido';
+ SOutlineBadLevel = '???';
+{?} SOutlineSelection = 'Ungültige Auswahl';
+{?} SOutlineFileLoad = 'Fehler beim Dateiladen';
+{?} SOutlineLongLine = 'Zeile zu lang';
+{?} SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
+
+ SMsgDlgWarning = 'Atencion';
+ SMsgDlgError = 'Error';
+ SMsgDlgInformation = 'Informacion';
+ SMsgDlgConfirm = 'Confirmar';
+ SMsgDlgYes = '&Si';
+ SMsgDlgNo = '&No';
+ SMsgDlgOK = 'Aceptar';
+ SMsgDlgCancel = 'Cancelar';
+ SMsgDlgHelp = '&Ayuda';
+ SMsgDlgHelpNone = 'No hay ayuda disponible';
+ SMsgDlgHelpHelp = 'Ayuda';
+ SMsgDlgAbort = 'A&bortar';
+ SMsgDlgRetry = '&Reintentar';
+ SMsgDlgIgnore = '&Ignorar';
+ SMsgDlgAll = '&Todo';
+ SMsgDlgNoToAll = 'N&o a todo';
+ SMsgDlgYesToAll = 'Si a To&do';
+
+ SmkcBkSp = 'Backspace';
+ SmkcTab = 'Tabulador';
+ SmkcEsc = 'Esc';
+ SmkcEnter = 'Intro';
+ SmkcSpace = 'Espacio';
+ SmkcPgUp = 'Pagina arriva';
+ SmkcPgDn = 'Pagina abajo';
+ SmkcEnd = 'Fin';
+ SmkcHome = 'Inicio';
+ SmkcLeft = 'Izquierda';
+ SmkcUp = 'Arriba';
+ SmkcRight = 'Derecha';
+ SmkcDown = 'Abajo';
+ SmkcIns = 'Insertar';
+ SmkcDel = 'Suprimir';
+ SmkcShift = 'Shift+';
+ SmkcCtrl = 'Ctrl+';
+ SmkcAlt = 'Alt+';
+
+ srUnknown = '(Desconocido)';
+ srNone = '(Vacio)';
+ SOutOfRange = 'El valor tiene que estar entre %d y %d';
+ SCannotCreateName = 'No es posible use el nombre estandard para un componente desconocido';
+
+{?} SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
+{?} STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
+{?} SInvalidDate = '''''%s'''' ist kein gültiges Datum';
+{?} SInvalidTime = '''''%s'''' ist keine gültige Zeit';
+{?} SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
+{?} SInsertLineError = 'Zeile kann nicht eingefügt werden';
+
+{?} SCannotDragForm = 'Formulare können nicht gezogen werden';
+{?} SPutObjectError = 'PutObject auf undefiniertes Element';
+{?} SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
+{?} SDuplicateCardId = 'Doppelte CardId gefunden';
+
+{?} SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert ($0%x)';
+{?} SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
+{?} SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
+{?} SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
+
+
+{?} SDefaultFilter = 'Alle Dateien (*.*)|*.*';
+{?} sAllFilter = 'Alle Dateien';
+{?} SNoVolumeLabel = ': [ - Ohne Namen - ]';
+
+{?} SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
+{?} SSelectDirCap = 'Verzeichnis auswählen';
+{?} SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
+{?} SDirNameCap = 'Verzeichnis&name:';
+{?} SDrivesCap = '&Laufwerke:';
+{?} SDirsCap = '&Verzeichnisse:';
+{?} SFilesCap = '&Dateien: (*.*)';
+{?} SNetworkCap = 'Ne&tzwerk...';
+
+{?} SColorPrefix = 'Farbe';
+ SColorTags = 'ABCDEFGHIJKLMNOP';
+
+{?} SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
+{?} SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
+
+{?} SDefault = 'Vorgabe';
+
+{?} SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
+{?} SCustomColors = 'Selbstdefinierte Farben';
+{?} SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
+{?} SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
+
+{?} SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
+
+{?} SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
+
+{?} SUntitled = '(Unbenannt)';
+
+{?} SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
+{?} SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
+{?} SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
+{?} SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
+
+{?} SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
+{?} SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
+
+{?} SPictureLabel = 'Bild:';
+ SPictureDesc = ' (%dx%d)';
+{?} SPreviewLabel = 'Vorschau';
+
+{?} SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
+
+{?} SNotOpenErr = 'Kein MCI-Gerät geöffnet';
+{?} SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
+ SMCINil = '';
+ SMCIAVIVideo = 'AVIVideo';
+ SMCICDAudio = 'CDAudio';
+ SMCIDAT = 'DAT';
+ SMCIDigitalVideo = 'DigitalVideo';
+ SMCIMMMovie = 'MMMovie';
+ SMCIOther = 'Andere';
+ SMCIOverlay = 'Overlay';
+ SMCIScanner = 'Scanner';
+ SMCISequencer = 'Sequencer';
+ SMCIVCR = 'VCR';
+ SMCIVideodisc = 'Videodisc';
+ SMCIWaveAudio = 'WaveAudio';
+ SMCIUnknownError = 'Unbekannter Fehlercode';
+
+ SBoldItalicFont = 'Negrita cursiva';
+ SBoldFont = 'Negrita';
+ SItalicFont = 'Cursiva';
+ SRegularFont = 'Normal';
+
+{?} SPropertiesVerb = 'Eigenschaften';
+
+{
+ $Log: constss.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/cregist.inc b/rtl/objpas/classes/cregist.inc
new file mode 100644
index 0000000000..46fcbe3f60
--- /dev/null
+++ b/rtl/objpas/classes/cregist.inc
@@ -0,0 +1,231 @@
+{
+ $Id: cregist.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+
+{ Class registration routines }
+
+procedure RegisterClass(AClass: TPersistentClass);
+var
+aClassname : String;
+begin
+ //Classlist is created during initialization.
+ with Classlist.Locklist do
+ try
+ while Indexof(AClass) = -1 do
+ begin
+ aClassname := AClass.ClassName;
+ if GetClass(aClassName) <> nil then //class alread registered!
+ Begin
+ //raise an error
+ exit;
+ end;
+ Add(AClass);
+ if AClass = TPersistent then break;
+ AClass := TPersistentClass(AClass.ClassParent);
+ end;
+ finally
+ ClassList.UnlockList;
+ end;
+end;
+
+
+procedure RegisterClasses(AClasses: array of TPersistentClass);
+var
+I : Integer;
+begin
+for I := low(aClasses) to high(aClasses) do
+ RegisterClass(aClasses[I]);
+end;
+
+
+procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
+
+begin
+end;
+
+
+procedure UnRegisterClass(AClass: TPersistentClass);
+
+begin
+end;
+
+
+procedure UnRegisterClasses(AClasses: array of TPersistentClass);
+
+begin
+end;
+
+
+procedure UnRegisterModuleClasses(Module: HMODULE);
+begin
+end;
+
+
+function FindClass(const AClassName: string): TPersistentClass;
+
+begin
+ Result := GetClass(AClassName);
+ if not Assigned(Result) then
+ raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
+end;
+
+
+function GetClass(const AClassName: string): TPersistentClass;
+var
+I : Integer;
+begin
+ with ClassList.LockList do
+ try
+ for I := 0 to Count-1 do
+ begin
+ Result := TPersistentClass(Items[I]);
+ if Result.ClassNameIs(AClassName) then Exit;
+ end;
+ I := ClassAliasList.Indexof(AClassName);
+ if I >= 0 then //found
+ Begin
+ Result := TPersistentClass(ClassAliasList.Objects[i]);
+ exit;
+ end;
+ Result := nil;
+ finally
+ ClassList.Unlocklist;
+ end;
+end;
+
+
+procedure StartClassGroup(AClass: TPersistentClass);
+begin
+end;
+
+
+procedure GroupDescendentsWith(AClass, AClassGroup: TPersistentClass);
+begin
+end;
+
+
+function ActivateClassGroup(AClass: TPersistentClass): TPersistentClass;
+begin
+end;
+
+
+function ClassGroupOf(AClass: TPersistentClass): TPersistentClass;
+begin
+end;
+
+
+function ClassGroupOf(Instance: TPersistent): TPersistentClass;
+begin
+end;
+
+
+{ Component registration routines }
+
+type
+ TComponentPage = class(TCollectionItem)
+ public
+ Name: String;
+ Classes: TList;
+ destructor Destroy; override;
+ end;
+
+{ TComponentPage }
+
+destructor TComponentPage.Destroy;
+begin
+ Classes.Free;
+ inherited Destroy;
+end;
+
+var
+ ComponentPages: TCollection;
+
+procedure InitComponentPages;
+begin
+ ComponentPages := TCollection.Create(TComponentPage);
+ { Add a empty page which will be used for storing the NoIcon components }
+ ComponentPages.Add;
+end;
+
+procedure RegisterComponents(const Page: string;
+ ComponentClasses: array of TComponentClass);
+var
+ i: Integer;
+ pg: TComponentPage;
+begin
+ if Page = '' then exit; { prevent caller from doing nonsense }
+
+ pg := nil;
+ if not Assigned(ComponentPages) then
+ InitComponentPages
+ else
+ for i := 0 to ComponentPages.Count - 1 do
+ if TComponentPage(ComponentPages.Items[i]).Name = Page then begin
+ pg := TComponentPage(ComponentPages.Items[i]);
+ break;
+ end;
+
+ if pg = nil then begin
+ pg := TComponentPage(ComponentPages.Add);
+ pg.Name := Page;
+ end;
+
+ if pg.Classes = nil then
+ pg.Classes := TList.Create;
+
+ for i := Low(ComponentClasses) to High(ComponentClasses) do
+ pg.Classes.Add(ComponentClasses[i]);
+
+ if Assigned(RegisterComponentsProc) then
+ RegisterComponentsProc(Page, ComponentClasses);
+end;
+
+
+procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
+var
+ pg: TComponentPage;
+ i: Integer;
+begin
+ if not Assigned(ComponentPages) then
+ InitComponentPages;
+
+ pg := TComponentPage(ComponentPages.Items[0]);
+ if pg.Classes = nil then
+ pg.Classes := TList.Create;
+
+ for i := Low(ComponentClasses) to High(ComponentClasses) do
+ pg.Classes.Add(ComponentClasses[i]);
+
+ if Assigned(RegisterNoIconProc) then
+ RegisterNoIconProc(ComponentClasses);
+end;
+
+
+procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
+ AxRegType: TActiveXRegType);
+
+begin
+end;
+
+
+{
+ $Log: cregist.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/02 19:39:59 florian
+ * empty class grouping functions
+
+}
diff --git a/rtl/objpas/classes/dm.inc b/rtl/objpas/classes/dm.inc
new file mode 100644
index 0000000000..51830cbb48
--- /dev/null
+++ b/rtl/objpas/classes/dm.inc
@@ -0,0 +1,173 @@
+{
+ $Id: dm.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team
+
+ <What does this file>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Constructor TDataModule.Create(AOwner: TComponent);
+begin
+ CreateNew(AOwner);
+ if (ClassType <> TDataModule) and
+ not (csDesigning in ComponentState) then
+ begin
+ if not InitInheritedComponent(Self, TDataModule) then
+ raise EStreamError.CreateFmt(SErrNoSTreaming, [ClassName]);
+ if OldCreateOrder then
+ DoCreate;
+ end;
+end;
+
+Constructor TDataModule.CreateNew(AOwner: TComponent);
+
+begin
+ CreateNew(AOwner,0);
+end;
+
+constructor TDataModule.CreateNew(AOwner: TComponent; CreateMode: Integer);
+begin
+ inherited Create(AOwner);
+ if Assigned(AddDataModule) and (CreateMode>=0) then
+ AddDataModule(Self);
+end;
+
+Procedure TDataModule.AfterConstruction;
+begin
+ If not OldCreateOrder then
+ DoCreate;
+end;
+
+Procedure TDataModule.BeforeDestruction;
+begin
+ Destroying;
+ RemoveFixupReferences(Self, '');
+ if not OldCreateOrder then
+ DoDestroy;
+end;
+
+destructor TDataModule.Destroy;
+begin
+ if OldCreateOrder then
+ DoDestroy;
+ if Assigned(RemoveDataModule) then
+ RemoveDataModule(Self);
+ inherited Destroy;
+end;
+
+Procedure TDataModule.DoCreate;
+begin
+ if Assigned(FOnCreate) then
+ try
+ FOnCreate(Self);
+ except
+ if not HandleCreateException then
+ raise;
+ end;
+end;
+
+Procedure TDataModule.DoDestroy;
+begin
+ if Assigned(FOnDestroy) then
+ try
+ FOnDestroy(Self);
+ except
+ if Assigned(ApplicationHandleException) then
+ ApplicationHandleException(Self);
+ end;
+end;
+
+procedure TDataModule.DefineProperties(Filer: TFiler);
+
+var
+ Ancestor : TDataModule;
+ HaveData : Boolean;
+
+begin
+ inherited DefineProperties(Filer);
+ Ancestor := TDataModule(Filer.Ancestor);
+ HaveData:=(Ancestor=Nil) or
+ (FDSize.X<>Ancestor.FDSize.X) or
+ (FDSize.Y<>Ancestor.FDSize.Y) or
+ (FDPos.Y<>Ancestor.FDPos.Y) or
+ (FDPos.X<>Ancestor.FDPos.X);
+ Filer.DefineProperty('Height', @ReadH, @WriteH, HaveData);
+ Filer.DefineProperty('HorizontalOffset', @ReadL, @WriteL, HaveData);
+ Filer.DefineProperty('VerticalOffset', @ReadT,@WriteT, HaveData);
+ Filer.DefineProperty('Width', @ReadW, @WriteW, HaveData);
+end;
+
+procedure TDataModule.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+var
+ I : Integer;
+
+begin
+ inherited GetChildren(Proc, Root);
+ if (Root=Self) then
+ for I:=0 to ComponentCount-1 do
+ If Not Components[I].HasParent then
+ Proc(Components[i]);
+end;
+
+
+function TDataModule.HandleCreateException: Boolean;
+begin
+ Result:=Assigned(ApplicationHandleException);
+ if Result then
+ ApplicationHandleException(Self);
+end;
+
+Procedure TDataModule.ReadState(Reader: TReader);
+begin
+ FOldOrder := false;
+ inherited ReadState(Reader);
+end;
+
+Procedure TDataModule.ReadT(Reader: TReader);
+begin
+ FDPos.Y := Reader.ReadInteger;
+end;
+
+Procedure TDataModule.WriteT(Writer: TWriter);
+begin
+ Writer.WriteInteger(FDPos.Y);
+end;
+
+Procedure TDataModule.ReadL(Reader: TReader);
+begin
+ FDPos.X := Reader.ReadInteger;
+end;
+
+Procedure TDataModule.WriteL(Writer: TWriter);
+begin
+ Writer.WriteInteger(FDPos.X);
+end;
+
+Procedure TDataModule.ReadW(Reader: TReader);
+begin
+ FDSIze.X := Reader.ReadInteger;
+end;
+
+Procedure TDataModule.WriteW(Writer: TWriter);
+begin
+ Writer.WriteInteger(FDSIze.X);
+end;
+
+Procedure TDataModule.ReadH(Reader: TReader);
+begin
+ FDSIze.Y := Reader.ReadInteger;
+end;
+
+Procedure TDataModule.WriteH(Writer: TWriter);
+begin
+ Writer.WriteInteger(FDSIze.Y);
+end;
diff --git a/rtl/objpas/classes/filer.inc b/rtl/objpas/classes/filer.inc
new file mode 100644
index 0000000000..7a47f4d1d7
--- /dev/null
+++ b/rtl/objpas/classes/filer.inc
@@ -0,0 +1,29 @@
+{
+ $Id: filer.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ *********************************************************************
+ * TFiler *
+ *********************************************************************}
+
+procedure TFiler.SetRoot(ARoot: TComponent);
+begin
+ FRoot := ARoot;
+end;
+
+
+{
+ $Log: filer.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/filerec.inc b/rtl/objpas/classes/filerec.inc
new file mode 100644
index 0000000000..11a7c93716
--- /dev/null
+++ b/rtl/objpas/classes/filerec.inc
@@ -0,0 +1,41 @@
+{
+ $Id: filerec.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ FileRec record definition
+
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ This file contains the definition of the filerec record.
+ It is put separately, so it is available outside the system
+ unit without sacrificing TP compatibility.
+}
+
+const
+ filerecnamelength = 255;
+type
+ FileRec = Packed Record
+ Handle,
+ Mode,
+ RecSize : longint;
+ _private : array[1..32] of byte;
+ UserData : array[1..16] of byte;
+ name : array[0..filerecnamelength] of char;
+ End;
+
+{
+ $Log: filerec.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/intf.inc b/rtl/objpas/classes/intf.inc
new file mode 100644
index 0000000000..18f3e8ca3d
--- /dev/null
+++ b/rtl/objpas/classes/intf.inc
@@ -0,0 +1,120 @@
+{
+ $Id: intf.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 2002 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ constructor TInterfaceList.Create;
+ begin
+ end;
+
+
+ destructor TInterfaceList.Destroy;
+ begin
+ end;
+
+
+ function TInterfaceList.Get(i : Integer) : IUnknown;
+ begin
+ end;
+
+
+ function TInterfaceList.GetCapacity : Integer;
+ begin
+ end;
+
+
+ function TInterfaceList.GetCount : Integer;
+ begin
+ end;
+
+
+ procedure TInterfaceList.Put(i : Integer;item : IUnknown);
+ begin
+ end;
+
+
+ procedure TInterfaceList.SetCapacity(NewCapacity : Integer);
+ begin
+ end;
+
+
+ procedure TInterfaceList.SetCount(NewCount : Integer);
+ begin
+ end;
+
+
+ procedure TInterfaceList.Clear;
+ begin
+ end;
+
+
+ procedure TInterfaceList.Delete(index : Integer);
+ begin
+ end;
+
+
+ procedure TInterfaceList.Exchange(index1,index2 : Integer);
+ begin
+ end;
+
+
+ function TInterfaceList.First : IUnknown;
+ begin
+ end;
+
+
+ function TInterfaceList.IndexOf(item : IUnknown) : Integer;
+ begin
+ end;
+
+
+ function TInterfaceList.Add(item : IUnknown) : Integer;
+ begin
+ end;
+
+
+ procedure TInterfaceList.Insert(i : Integer;item : IUnknown);
+ begin
+ end;
+
+
+ function TInterfaceList.Last : IUnknown;
+ begin
+ end;
+
+
+ function TInterfaceList.Remove(item : IUnknown): Integer;
+ begin
+ end;
+
+
+ procedure TInterfaceList.Lock;
+ begin
+ end;
+
+
+ procedure TInterfaceList.Unlock;
+ begin
+ end;
+
+
+ function TInterfaceList.Expand : TInterfaceList;
+ begin
+ end;
+
+
+{
+ $Log: intf.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/lists.inc b/rtl/objpas/classes/lists.inc
new file mode 100644
index 0000000000..f9640b41be
--- /dev/null
+++ b/rtl/objpas/classes/lists.inc
@@ -0,0 +1,569 @@
+{
+ $Id: lists.inc,v 1.11 2005/05/04 06:53:06 michael Exp $
+ This file is part of the Free Pascal Run Time Library (rtl)
+ Copyright (c) 1999-2005 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Const
+ // Ratio of Pointer and Word Size.
+ WordRatio = SizeOf(Pointer) Div SizeOf(Word);
+
+{****************************************************************************}
+{* TFPList *}
+{****************************************************************************}
+
+procedure TFPList.RaiseIndexError(Index : Integer);
+begin
+ Error(SListIndexError, Index);
+end;
+
+function TFPList.Get(Index: Integer): Pointer; {$ifdef HASINLINE} inline; {$endif}
+begin
+ If (Index < 0) or (Index >= FCount) then
+ RaiseIndexError(Index);
+ Result:=FList^[Index];
+end;
+
+procedure TFPList.Put(Index: Integer; Item: Pointer); {$ifdef HASINLINE} inline; {$endif}
+begin
+ if (Index < 0) or (Index >= FCount) then
+ RaiseIndexError(Index);
+ Flist^[Index] := Item;
+end;
+
+function TFPList.Extract(item: Pointer): Pointer;
+var
+ i : Integer;
+begin
+ result := nil;
+ i := IndexOf(item);
+ if i >= 0 then
+ begin
+ Result := item;
+ FList^[i] := nil;
+ Delete(i);
+ end;
+end;
+
+procedure TFPList.SetCapacity(NewCapacity: Integer);
+begin
+ If (NewCapacity < FCount) or (NewCapacity > MaxListSize) then
+ Error (SListCapacityError, NewCapacity);
+ if NewCapacity = FCapacity then
+ exit;
+ ReallocMem(FList, SizeOf(Pointer)*NewCapacity);
+ FCapacity := NewCapacity;
+end;
+
+procedure TFPList.SetCount(NewCount: Integer);
+begin
+ if (NewCount < 0) or (NewCount > MaxListSize)then
+ Error(SListCountError, NewCount);
+ If NewCount > FCount then
+ begin
+ If NewCount > FCapacity then
+ SetCapacity(NewCount);
+ If FCount < NewCount then
+ FillWord(Flist^[FCount], (NewCount-FCount) * WordRatio, 0);
+ end;
+ FCount := Newcount;
+end;
+
+destructor TFPList.Destroy;
+begin
+ Self.Clear;
+ inherited Destroy;
+end;
+
+function TFPList.Add(Item: Pointer): Integer; {$ifdef HASINLINE} inline; {$endif}
+begin
+ if FCount = FCapacity then
+ Self.Expand;
+ FList^[FCount] := Item;
+ Result := FCount;
+ FCount := FCount + 1;
+end;
+
+procedure TFPList.Clear;
+begin
+ if Assigned(FList) then
+ begin
+ SetCount(0);
+ SetCapacity(0);
+ FList := nil;
+ end;
+end;
+
+procedure TFPList.Delete(Index: Integer); {$ifdef HASINLINE} inline; {$endif}
+begin
+ If (Index<0) or (Index>=FCount) then
+ Error (SListIndexError, Index);
+ FCount := FCount-1;
+ System.Move (FList^[Index+1], FList^[Index], (FCount - Index) * SizeOf(Pointer));
+ // Shrink the list if appropriate
+ if (FCapacity > 256) and (FCount < FCapacity shr 2) then
+ begin
+ FCapacity := FCapacity shr 1;
+ ReallocMem(FList, SizeOf(Pointer) * FCapacity);
+ end;
+end;
+
+class procedure TFPList.Error(const Msg: string; Data: Integer);
+begin
+{$ifdef VER1_0}
+ Raise EListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
+{$else VER1_0}
+ Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
+{$endif VER1_0}
+end;
+
+procedure TFPList.Exchange(Index1, Index2: Integer);
+var
+ Temp : Pointer;
+begin
+ If ((Index1 >= FCount) or (Index1 < 0)) then
+ Error(SListIndexError, Index1);
+ If ((Index2 >= FCount) or (Index2 < 0)) then
+ Error(SListIndexError, Index2);
+ Temp := FList^[Index1];
+ FList^[Index1] := FList^[Index2];
+ FList^[Index2] := Temp;
+end;
+
+function TFPList.Expand: TFPList; {$ifdef HASINLINE} inline; {$endif}
+var
+ IncSize : Longint;
+begin
+ if FCount < FCapacity then exit;
+ IncSize := 4;
+ if FCapacity > 3 then IncSize := IncSize + 4;
+ if FCapacity > 8 then IncSize := IncSize+8;
+ if FCapacity > 127 then Inc(IncSize, FCapacity shr 2);
+ SetCapacity(FCapacity + IncSize);
+ Result := Self;
+end;
+
+function TFPList.First: Pointer;
+begin
+ If FCount = 0 then
+ Result := Nil
+ else
+ Result := Items[0];
+end;
+
+function TFPList.IndexOf(Item: Pointer): Integer;
+begin
+ Result := 0;
+ while(Result < FCount) and (Flist^[Result] <> Item) do Result := Result + 1;
+ If Result = FCount then Result := -1;
+end;
+
+procedure TFPList.Insert(Index: Integer; Item: Pointer); {$ifdef HASINLINE} inline; {$endif}
+begin
+ if (Index < 0) or (Index > FCount )then
+ Error(SlistIndexError, Index);
+ iF FCount = FCapacity then Self.Expand;
+ if Index<FCount then
+ System.Move(Flist^[Index], Flist^[Index+1], (FCount - Index) * SizeOf(Pointer));
+ FList^[Index] := Item;
+ FCount := FCount + 1;
+end;
+
+function TFPList.Last: Pointer;
+begin
+{ Wouldn't it be better to return nil if the count is zero ?}
+ If FCount = 0 then
+ Result := nil
+ else
+ Result := Items[FCount - 1];
+end;
+
+procedure TFPList.Move(CurIndex, NewIndex: Integer);
+var
+ Temp : Pointer;
+begin
+ if ((CurIndex < 0) or (CurIndex > Count - 1)) then
+ Error(SListIndexError, CurIndex);
+ if (NewINdex < 0) then
+ Error(SlistIndexError, NewIndex);
+ Temp := FList^[CurIndex];
+ FList^[CurIndex] := nil;
+ Self.Delete(CurIndex);
+ Self.Insert(NewIndex, nil);
+ FList^[NewIndex] := Temp;
+end;
+
+function TFPList.Remove(Item: Pointer): Integer;
+begin
+ Result := IndexOf(Item);
+ If Result <> -1 then
+ Self.Delete(Result);
+end;
+
+procedure TFPList.Pack;
+Var
+ {Last,I,J,}
+ Runner : Longint;
+begin
+ // Not the fastest; but surely correct
+ for Runner := Fcount - 1 downto 0 do
+ if Items[Runner] = Nil then
+ Self.Delete(Runner);
+{ The following may be faster in case of large and defragmented lists
+ If count=0 then exit;
+ Runner:=0;I:=0;
+ TheLast:=Count;
+ while runner<count do
+ begin
+ // Find first Nil
+ While (FList^[Runner]<>Nil) and (Runner<Count) do Runner:=Runner+1;
+ if Runner<Count do
+ begin
+ // Start searching for non-nil from last known nil+1
+ if i<Runner then I:=Runner+1;
+ While (Flist[I]^=Nil) and (I<Count) do I:=I+1;
+ // Start looking for last non-nil of block.
+ J:=I+1;
+ While (Flist^[J]<>Nil) and (J<Count) do J:=J+1;
+ // Move block and zero out
+ Move (Flist^[I],Flist^[Runner],J*SizeOf(Pointer));
+ FillWord (Flist^[I],(J-I)*WordRatio,0);
+ // Update Runner and Last to point behind last block
+ TheLast:=Runner+(J-I);
+ If J=Count then
+ begin
+ // Shortcut, when J=Count we checked all pointers
+ Runner:=Count
+ else
+ begin
+ Runner:=TheLast;
+ I:=j;
+ end;
+ end;
+ Count:=TheLast;
+}
+end;
+
+// Needed by Sort method.
+
+Procedure QuickSort(FList: PPointerList; L, R : Longint;
+ Compare: TListSortCompare);
+var
+ I, J : Longint;
+ P, Q : Pointer;
+begin
+ repeat
+ I := L;
+ J := R;
+ P := FList^[ (L + R) div 2 ];
+ repeat
+ while Compare(P, FList^[i]) > 0 do
+ I := I + 1;
+ while Compare(P, FList^[J]) < 0 do
+ J := J - 1;
+ If I <= J then
+ begin
+ Q := FList^[I];
+ Flist^[I] := FList^[J];
+ FList^[J] := Q;
+ I := I + 1;
+ J := J - 1;
+ end;
+ until I > J;
+ if L < J then
+ QuickSort(FList, L, J, Compare);
+ L := I;
+ until I >= R;
+end;
+
+procedure TFPList.Sort(Compare: TListSortCompare);
+begin
+ if Not Assigned(FList) or (FCount < 2) then exit;
+ QuickSort(Flist, 0, FCount-1, Compare);
+end;
+
+procedure TFPList.Assign(Obj: TFPList);
+var
+ i: Integer;
+begin
+ Clear;
+ for I := 0 to Obj.Count - 1 do
+ Add(Obj[i]);
+end;
+
+
+{****************************************************************************}
+{* TList *}
+{****************************************************************************}
+
+{ TList = class(TObject)
+ private
+ FList: TFPList;
+}
+
+
+
+function TList.Get(Index: Integer): Pointer;
+begin
+ Result := FList.Get(Index);
+end;
+
+procedure TList.Grow;
+begin
+ // Only for compatibility with Delphi. Not needed.
+end;
+
+procedure TList.Put(Index: Integer; Item: Pointer);
+begin
+ FList.Put(Index, Item);
+end;
+
+function TList.Extract(item: Pointer): Pointer;
+begin
+ Result := FList.Extract(item);
+ Notify(Result, lnExtracted);
+end;
+
+procedure TList.Notify(Ptr: Pointer; Action: TListNotification);
+begin
+end;
+
+function TList.GetCapacity: integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TList.SetCapacity(NewCapacity: Integer);
+begin
+ FList.SetCapacity(NewCapacity);
+end;
+
+function TList.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TList.SetCount(NewCount: Integer);
+begin
+ FList.SetCount(NewCount);
+end;
+
+constructor TList.Create;
+begin
+ inherited Create;
+ FList := TFPList.Create;
+end;
+
+destructor TList.Destroy;
+begin
+ If (Flist<>Nil) then
+ Clear;
+ FreeAndNil(FList);
+ inherited Destroy;
+end;
+
+function TList.Add(Item: Pointer): Integer;
+begin
+ Result := FList.Add(Item);
+ if Item <> nil then
+ Notify(Item, lnAdded);
+end;
+
+procedure TList.Clear;
+
+begin
+ If Assigned(Flist) then
+ While (FList.Count>0) do
+ Delete(Count-1);
+end;
+
+procedure TList.Delete(Index: Integer);
+
+var P : pointer;
+
+begin
+ P:=FList.Get(Index);
+ FList.Delete(Index);
+ if assigned(p) then Notify(p, lnDeleted);
+end;
+
+class procedure TList.Error(const Msg: string; Data: Integer);
+begin
+{$ifdef VER1_0}
+ Raise EListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
+{$else VER1_0}
+ Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
+{$endif VER1_0}
+end;
+
+procedure TList.Exchange(Index1, Index2: Integer);
+begin
+ FList.Exchange(Index1, Index2);
+end;
+
+function TList.Expand: TList;
+begin
+ FList.Expand;
+ Result:=Self;
+end;
+
+function TList.First: Pointer;
+begin
+ Result := FList.First;
+end;
+
+function TList.IndexOf(Item: Pointer): Integer;
+begin
+ Result := FList.IndexOf(Item);
+end;
+
+procedure TList.Insert(Index: Integer; Item: Pointer);
+begin
+ FList.Insert(Index, Item);
+ if Item <> nil then
+ Notify(Item,lnAdded);
+end;
+
+function TList.Last: Pointer;
+begin
+ Result := FList.Last;
+end;
+
+procedure TList.Move(CurIndex, NewIndex: Integer);
+begin
+ FList.Move(CurIndex, NewIndex);
+end;
+
+function TList.Remove(Item: Pointer): Integer;
+begin
+ Result := IndexOf(Item);
+ If Result <> -1 then
+ Self.Delete(Result);
+end;
+
+procedure TList.Pack;
+begin
+ FList.Pack;
+end;
+
+procedure TList.Sort(Compare: TListSortCompare);
+begin
+ FList.Sort(Compare);
+end;
+
+procedure TList.Assign(Obj:TList);
+begin
+ FList.Assign(Obj.FList);
+end;
+
+function TList.GetList: PPointerList;
+begin
+ Result := FList.List;
+end;
+
+
+{****************************************************************************}
+{* TThreadList *}
+{****************************************************************************}
+
+
+constructor TThreadList.Create;
+begin
+inherited Create;
+//InitializeCriticalSection(FLock);
+FList := TList.Create;
+end;
+
+
+
+destructor TThreadList.Destroy;
+begin
+ LockList;
+ try
+ FList.Free;
+ inherited Destroy;
+ finally
+ UnlockList;
+ end;
+end;
+
+
+
+procedure TThreadList.Add(Item: Pointer);
+begin
+ Locklist;
+ try
+ //make sure it's not already in the list
+ if FList.indexof(Item) = -1 then
+ FList.Add(Item);
+ finally
+ UnlockList;
+ end;
+end;
+
+
+procedure TThreadList.Clear;
+begin
+ Locklist;
+ try
+ FList.Clear;
+ finally
+ UnLockList;
+ end;
+end;
+
+
+
+function TThreadList.LockList: TList;
+
+
+begin
+ Result := FList;
+end;
+
+
+
+procedure TThreadList.Remove(Item: Pointer);
+begin
+ LockList;
+ try
+ FList.Remove(Item);
+ finally
+ UnlockList;
+ end;
+end;
+
+
+
+procedure TThreadList.UnlockList;
+begin
+
+end;
+
+
+{
+ $Log: lists.inc,v $
+ Revision 1.11 2005/05/04 06:53:06 michael
+ * Removed TFPList.grow
+
+ Revision 1.10 2005/04/12 10:03:31 marco
+ * notifyer triggered after delete patch
+
+ Revision 1.9 2005/03/16 22:56:05 michael
+ + Fix for TList.Destroy and improved Clear
+
+ Revision 1.8 2005/03/16 20:48:03 michael
+ + Faster TList from Dean Zobec
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/parser.inc b/rtl/objpas/classes/parser.inc
new file mode 100644
index 0000000000..7f3d127ae0
--- /dev/null
+++ b/rtl/objpas/classes/parser.inc
@@ -0,0 +1,344 @@
+{
+ $Id: parser.inc,v 1.5 2005/03/07 17:57:25 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************}
+{* TParser *}
+{****************************************************************************}
+
+const
+ ParseBufSize = 4096;
+
+procedure TParser.ReadBuffer;
+var
+ Count : Integer;
+begin
+ Inc(FOrigin, FSourcePtr - FBuffer);
+
+ FSourceEnd[0] := FSaveChar;
+ Count := FBufPtr - FSourcePtr;
+ if Count <> 0 then
+ begin
+ Move(FSourcePtr[0], FBuffer[0], Count);
+ end;
+
+ FBufPtr := FBuffer + Count;
+ Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
+
+ FSourcePtr := FBuffer;
+ FSourceEnd := FBufPtr;
+ if (FSourceEnd = FBufEnd) then
+ begin
+ FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
+ if FSourceEnd = FBuffer then
+ begin
+ Error(SLineTooLong);
+ end;
+ end;
+ FSaveChar := FSourceEnd[0];
+ FSourceEnd[0] := #0;
+end;
+
+procedure TParser.SkipBlanks;
+begin
+ while FSourcePtr^ < #33 do begin
+ if FSourcePtr^ = #0 then begin
+ ReadBuffer;
+ if FSourcePtr^ = #0 then exit;
+ continue;
+ end else if FSourcePtr^ = #10 then Inc(FSourceLine);
+ Inc(FSourcePtr);
+ end;
+end;
+
+constructor TParser.Create(Stream: TStream);
+begin
+ inherited Create;
+
+ FStream := Stream;
+ GetMem(FBuffer, ParseBufSize);
+
+ FBuffer[0] := #0;
+ FBufPtr := FBuffer;
+ FBufEnd := FBuffer + ParseBufSize;
+ FSourcePtr := FBuffer;
+ FSourceEnd := FBuffer;
+ FTokenPtr := FBuffer;
+ FSourceLine := 1;
+
+ NextToken;
+end;
+
+
+destructor TParser.Destroy;
+begin
+ if Assigned(FBuffer) then
+ begin
+ FStream.Seek(Longint(FTokenPtr) - Longint(FBufPtr), 1);
+ FreeMem(FBuffer, ParseBufSize);
+ end;
+
+ inherited Destroy;
+end;
+
+procedure TParser.CheckToken(T : Char);
+begin
+ if Token <> T then
+ begin
+ case T of
+ toSymbol:
+ Error(SIdentifierExpected);
+ toString:
+ Error(SStringExpected);
+ toInteger, toFloat:
+ Error(SNumberExpected);
+ else
+ ErrorFmt(SCharExpected, [T]);
+ end;
+ end;
+end;
+
+procedure TParser.CheckTokenSymbol(const S: string);
+begin
+ if not TokenSymbolIs(S) then
+ ErrorFmt(SSymbolExpected, [S]);
+end;
+
+Procedure TParser.Error(const Ident: string);
+begin
+ ErrorStr(Ident);
+end;
+
+Procedure TParser.ErrorFmt(const Ident: string; const Args: array of const);
+begin
+ ErrorStr(Format(Ident, Args));
+end;
+
+Procedure TParser.ErrorStr(const Message: string);
+begin
+ raise EParserError.CreateFmt(SParseError, [Message, FSourceLine]);
+end;
+
+
+procedure TParser.HexToBinary(Stream: TStream);
+
+ function HexDigitToInt(c: Char): Integer;
+ begin
+ if (c >= '0') and (c <= '9') then Result := Ord(c) - Ord('0')
+ else if (c >= 'A') and (c <= 'F') then Result := Ord(c) - Ord('A') + 10
+ else if (c >= 'a') and (c <= 'f') then Result := Ord(c) - Ord('a') + 10
+ else Result := -1;
+ end;
+
+var
+ buf: array[0..255] of Byte;
+ digit1: Integer;
+ bytes: Integer;
+begin
+ SkipBlanks;
+ while FSourcePtr^ <> '}' do begin
+ bytes := 0;
+ while True do begin
+ digit1 := HexDigitToInt(FSourcePtr[0]);
+ if digit1 < 0 then break;
+ buf[bytes] := digit1 shl 4 or HexDigitToInt(FSourcePtr[1]);
+ Inc(FSourcePtr, 2);
+ Inc(bytes);
+ end;
+ if bytes = 0 then Error(SInvalidBinary);
+ Stream.Write(buf, bytes);
+ SkipBlanks;
+ end;
+ NextToken;
+end;
+
+
+Function TParser.NextToken: Char;
+var
+ CharCount : Integer;
+
+ procedure PutChar(achar: Word);
+ begin
+ inc(CharCount);
+ if length(fString) < CharCount then begin
+ setlength(fString,length(fString) + length(fString) div 4 + 64);
+ end;
+{$ifdef HASWIDESTRING}
+ fString[CharCount]:= WideChar(achar);
+{$else}
+ fString[CharCount]:= Char(achar);
+{$endif HASWIDESTRING}
+ end;
+
+var
+ I : Integer;
+ P : PChar;
+begin
+ SkipBlanks;
+ P := FSourcePtr;
+ FTokenPtr := P;
+ case P^ of
+ 'A'..'Z', 'a'..'z', '_':
+ begin
+ Inc(P);
+ while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
+ Result := toSymbol;
+ end;
+ '#', '''':
+ begin
+ CharCount:= 0;
+ while True do
+ case P^ of
+ '#':
+ begin
+ Inc(P);
+ I := 0;
+ while P^ in ['0'..'9'] do
+ begin
+ I := I * 10 + (Ord(P^) - Ord('0'));
+ Inc(P);
+ end;
+ PutChar(I)
+ end;
+ '''':
+ begin
+ Inc(P);
+ while True do
+ begin
+ case P^ of
+ #0, #10, #13:
+ Error(SInvalidString);
+ '''':
+ begin
+ Inc(P);
+ if P^ <> '''' then Break;
+ end;
+ end;
+ PutChar(Word(P^));
+ Inc(P);
+ end;
+ end;
+ else
+ Break;
+ end;
+ setlength(fString,CharCount);
+ Result := toString;
+ end;
+ '$':
+ begin
+ Inc(P);
+ while P^ in ['0'..'9', 'A'..'F', 'a'..'f'] do Inc(P);
+ Result := toInteger;
+ end;
+ '-', '0'..'9':
+ begin
+ Inc(P);
+ while P^ in ['0'..'9'] do Inc(P);
+ Result := toInteger;
+ while (P^ in ['0'..'9', '.', 'e', 'E', '+', '-']) and not
+ ((P[0] = '.') and not (P[1] in ['0'..'9', 'e', 'E'])) do
+ begin
+ Inc(P);
+ Result := toFloat;
+ end;
+ end;
+ else
+ Result := P^;
+ if Result <> toEOF then Inc(P);
+ end;
+ FSourcePtr := P;
+ FToken := Result;
+end;
+
+Function TParser.SourcePos: Longint;
+begin
+ Result := FOrigin + (FTokenPtr - FBuffer);
+end;
+
+
+Function TParser.TokenComponentIdent: String;
+var
+ P : PChar;
+begin
+ CheckToken(toSymbol);
+
+ P := FSourcePtr;
+ while P^ = '.' do
+ begin
+ Inc(P);
+ if not (P^ in ['A'..'Z', 'a'..'z', '_']) then
+ Error(SIdentifierExpected);
+ repeat
+ Inc(P)
+ until not (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+ end;
+ FSourcePtr := P;
+ Result := TokenString;
+end;
+
+Function TParser.TokenFloat: Extended;
+var
+ FloatError : Integer;
+ Back : Real;
+begin
+ Result := 0;
+ Val(TokenString, Back, FloatError);
+ Result := Back;
+end;
+
+Function TParser.TokenInt: Longint;
+begin
+ Result := StrToInt(TokenString);
+end;
+
+Function TParser.TokenString: string;
+var
+ L : Integer;
+begin
+ if FToken = toString then begin
+ result:= fString;
+ end else begin
+ L := FSourcePtr - FTokenPtr;
+ SetLength(Result,L);
+ If (L>0) then
+ Move(FTokenPtr^,Result[1],L);
+ end;
+end;
+
+{$ifdef HASWIDESTRING}
+Function TParser.TokenWideString: widestring;
+begin
+ if FToken = toString then
+ result:= fString
+ else
+ result:= TokenString
+end;
+{$endif HASWIDESTRING}
+
+
+Function TParser.TokenSymbolIs(const S: string): Boolean;
+begin
+ Result := (Token = toSymbol) and (CompareText(S, TokenString) = 0);
+end;
+{
+ $Log: parser.inc,v $
+ Revision 1.5 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.4 2005/03/07 16:35:19 peter
+ * Object text format of widestrings patch from Martin Schreiber
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/persist.inc b/rtl/objpas/classes/persist.inc
new file mode 100644
index 0000000000..44e516c38d
--- /dev/null
+++ b/rtl/objpas/classes/persist.inc
@@ -0,0 +1,166 @@
+{
+ $Id: persist.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************}
+{* TPersistent *}
+{****************************************************************************}
+
+procedure TPersistent.AssignError(Source: TPersistent);
+
+Var SourceName : String;
+
+begin
+ If Source<>Nil then
+ SourceName:=Source.ClassName
+ else
+ SourceName:='Nil';
+ Writeln ('Error assigning to ',ClassName,' from : ',SourceName);
+ raise EConvertError.CreateFmt (SAssignError,[SourceName,ClassName]);
+end;
+
+
+
+procedure TPersistent.AssignTo(Dest: TPersistent);
+
+
+begin
+ Dest.AssignError(Self);
+end;
+
+
+procedure TPersistent.DefineProperties(Filer: TFiler);
+
+begin
+end;
+
+
+function TPersistent.GetOwner: TPersistent;
+
+begin
+ Result:=Nil;
+end;
+
+destructor TPersistent.Destroy;
+
+begin
+ Inherited Destroy;
+end;
+
+
+procedure TPersistent.Assign(Source: TPersistent);
+
+begin
+ If Source<>Nil then
+ Source.AssignTo(Self)
+ else
+ AssignError(Nil);
+end;
+
+function TPersistent.GetNamePath: string;
+
+Var OwnerName :String;
+
+begin
+ Result:=ClassNAme;
+ If GetOwner<>Nil then
+ begin
+ OwnerName:=GetOwner.GetNamePath;
+ If OwnerName<>'' then Result:=OwnerName+'.'+Result;
+ end;
+end;
+
+
+{****************************************************************************}
+{* TInterfacedPersistent *}
+{****************************************************************************}
+
+{$ifdef HASINTF}
+procedure TInterfacedPersistent.AfterConstruction;
+begin
+ inherited;
+// if GetOwner<>nil then
+// GetOwner.GetInterface(IUnknown,FOwnerInterface);
+end;
+
+
+function TInterfacedPersistent._AddRef: Integer;stdcall;
+begin
+ if FOwnerInterface<>nil then
+ Result:=FOwnerInterface._AddRef
+ else
+ Result:=-1;
+end;
+
+
+function TInterfacedPersistent._Release: Integer;stdcall;
+begin
+ if FOwnerInterface <> nil then
+ Result:=FOwnerInterface._Release
+ else
+ Result:=-1;
+end;
+
+
+function TInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
+begin
+ if GetInterface(IID, Obj) then
+ Result:=0
+ else
+ Result:=HResult($80004002);
+end;
+{$endif HASINTF}
+
+
+{****************************************************************************}
+{* TRecall *}
+{****************************************************************************}
+
+constructor TRecall.Create(AStorage,AReference: TPersistent);
+begin
+ inherited Create;
+ FStorage:=AStorage;
+ FReference:=AReference;
+ Store;
+end;
+
+
+destructor TRecall.Destroy;
+begin
+ if Assigned(FReference) then
+ FReference.Assign(FStorage);
+ Forget;
+ inherited;
+end;
+
+
+procedure TRecall.Forget;
+begin
+ FReference:=nil;
+ FreeAndNil(FStorage);
+end;
+
+
+procedure TRecall.Store;
+begin
+ if Assigned(FReference) then
+ FStorage.Assign(FReference);
+end;
+
+
+{
+ $Log: persist.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/reader.inc b/rtl/objpas/classes/reader.inc
new file mode 100644
index 0000000000..731fa0cd07
--- /dev/null
+++ b/rtl/objpas/classes/reader.inc
@@ -0,0 +1,1410 @@
+{
+ $Id: reader.inc,v 1.19 2005/04/15 07:21:09 michael Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TBinaryObjectReader *}
+{****************************************************************************}
+
+constructor TBinaryObjectReader.Create(Stream: TStream; BufSize: Integer);
+begin
+ inherited Create;
+ If (Stream=Nil) then
+ Raise EReadError.Create(SEmptyStreamIllegalReader);
+ FStream := Stream;
+ FBufSize := BufSize;
+ GetMem(FBuffer, BufSize);
+end;
+
+destructor TBinaryObjectReader.Destroy;
+begin
+ { Seek back the amount of bytes that we didn't process until now: }
+ FStream.Seek(Integer(FBufPos) - Integer(FBufEnd), soFromCurrent);
+
+ if Assigned(FBuffer) then
+ FreeMem(FBuffer, FBufSize);
+
+ inherited Destroy;
+end;
+
+function TBinaryObjectReader.ReadValue: TValueType;
+begin
+ Result := vaNull; { Necessary in FPC as TValueType is larger than 1 byte! }
+ Read(Result, 1);
+end;
+
+function TBinaryObjectReader.NextValue: TValueType;
+begin
+ Result := ReadValue;
+ { We only 'peek' at the next value, so seek back to unget the read value: }
+ Dec(FBufPos);
+end;
+
+procedure TBinaryObjectReader.BeginRootComponent;
+var
+ Signature: LongInt;
+begin
+ { Read filer signature }
+ Read(Signature, 4);
+ if Signature <> LongInt(FilerSignature) then
+ raise EReadError.Create(SInvalidImage);
+end;
+
+procedure TBinaryObjectReader.BeginComponent(var Flags: TFilerFlags;
+ var AChildPos: Integer; var CompClassName, CompName: String);
+var
+ Prefix: Byte;
+ ValueType: TValueType;
+begin
+ { Every component can start with a special prefix: }
+ Flags := [];
+ if (Byte(NextValue) and $f0) = $f0 then
+ begin
+ Prefix := Byte(ReadValue);
+ Flags := TFilerFlags(longint(Prefix and $0f));
+ if ffChildPos in Flags then
+ begin
+ ValueType := ReadValue;
+ case ValueType of
+ vaInt8:
+ AChildPos := ReadInt8;
+ vaInt16:
+ AChildPos := ReadInt16;
+ vaInt32:
+ AChildPos := ReadInt32;
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+ end;
+ end;
+ end;
+
+ CompClassName := ReadStr;
+ CompName := ReadStr;
+end;
+
+function TBinaryObjectReader.BeginProperty: String;
+begin
+ Result := ReadStr;
+end;
+
+procedure TBinaryObjectReader.ReadBinary(const DestData: TMemoryStream);
+var
+ BinSize: LongInt;
+begin
+ Read(BinSize, 4);
+ DestData.Size := BinSize;
+ Read(DestData.Memory^, BinSize);
+end;
+
+function TBinaryObjectReader.ReadFloat: Extended;
+begin
+ Read(Result, SizeOf(Extended))
+end;
+
+function TBinaryObjectReader.ReadSingle: Single;
+begin
+ Read(Result, SizeOf(Single))
+end;
+
+{$ifdef HASCURRENCY}
+function TBinaryObjectReader.ReadCurrency: Currency;
+begin
+ Read(Result, SizeOf(Currency))
+end;
+{$endif HASCURRENCY}
+
+function TBinaryObjectReader.ReadDate: TDateTime;
+begin
+ Read(Result, SizeOf(TDateTime))
+end;
+
+function TBinaryObjectReader.ReadIdent(ValueType: TValueType): String;
+var
+ i: Byte;
+begin
+ case ValueType of
+ vaIdent:
+ begin
+ Read(i, 1);
+ SetLength(Result, i);
+ Read(Pointer(@Result[1])^, i);
+ end;
+ vaNil:
+ Result := 'nil';
+ vaFalse:
+ Result := 'False';
+ vaTrue:
+ Result := 'True';
+ vaNull:
+ Result := 'Null';
+ end;
+end;
+
+function TBinaryObjectReader.ReadInt8: ShortInt;
+begin
+ Read(Result, 1);
+end;
+
+function TBinaryObjectReader.ReadInt16: SmallInt;
+begin
+ Read(Result, 2);
+end;
+
+function TBinaryObjectReader.ReadInt32: LongInt;
+begin
+ Read(Result, 4);
+end;
+
+function TBinaryObjectReader.ReadInt64: Int64;
+begin
+ Read(Result, 8);
+end;
+
+function TBinaryObjectReader.ReadSet(EnumType: Pointer): Integer;
+var
+ Name: String;
+ Value: Integer;
+begin
+ try
+ Result := 0;
+ while True do
+ begin
+ Name := ReadStr;
+ if Length(Name) = 0 then
+ break;
+ Value := GetEnumValue(PTypeInfo(EnumType), Name);
+ if Value = -1 then
+ raise EReadError.Create(SInvalidPropertyValue);
+ Result := Result or (1 shl Value);
+ end;
+ except
+ SkipSetBody;
+ raise;
+ end;
+end;
+
+function TBinaryObjectReader.ReadStr: String;
+var
+ i: Byte;
+begin
+ Read(i, 1);
+ SetLength(Result, i);
+ if i > 0 then
+ Read(Pointer(@Result[1])^, i);
+end;
+
+function TBinaryObjectReader.ReadString(StringType: TValueType): String;
+var
+ i: Integer;
+begin
+ case StringType of
+ vaString:
+ begin
+ i := 0;
+ Read(i, 1);
+ end;
+ vaLString:
+ Read(i, 4);
+ end;
+ SetLength(Result, i);
+ if i > 0 then
+ Read(Pointer(@Result[1])^, i);
+end;
+
+
+{$ifdef HASWIDESTRING}
+function TBinaryObjectReader.ReadWideString: WideString;
+var
+ i: Integer;
+begin
+ Read(i, 4);
+ SetLength(Result, i);
+ if i > 0 then
+ Read(Pointer(@Result[1])^, i*2);
+end;
+{$endif HASWIDESTRING}
+
+
+procedure TBinaryObjectReader.SkipComponent(SkipComponentInfos: Boolean);
+var
+ Flags: TFilerFlags;
+ Dummy: Integer;
+ CompClassName, CompName: String;
+begin
+ if SkipComponentInfos then
+ { Skip prefix, component class name and component object name }
+ BeginComponent(Flags, Dummy, CompClassName, CompName);
+
+ { Skip properties }
+ while NextValue <> vaNull do
+ SkipProperty;
+ ReadValue;
+
+ { Skip children }
+ while NextValue <> vaNull do
+ SkipComponent(True);
+ ReadValue;
+end;
+
+procedure TBinaryObjectReader.SkipValue;
+
+ procedure SkipBytes(Count: LongInt);
+ var
+ Dummy: array[0..1023] of Byte;
+ SkipNow: Integer;
+ begin
+ while Count > 0 do
+ begin
+ if Count > 1024 then
+ SkipNow := 1024
+ else
+ SkipNow := Count;
+ Read(Dummy, SkipNow);
+ Dec(Count, SkipNow);
+ end;
+ end;
+
+var
+ Count: LongInt;
+begin
+ case ReadValue of
+ vaNull, vaFalse, vaTrue, vaNil: ;
+ vaList:
+ begin
+ while NextValue <> vaNull do
+ SkipValue;
+ ReadValue;
+ end;
+ vaInt8:
+ SkipBytes(1);
+ vaInt16:
+ SkipBytes(2);
+ vaInt32:
+ SkipBytes(4);
+ vaExtended:
+ SkipBytes(SizeOf(Extended));
+ vaString, vaIdent:
+ ReadStr;
+ vaBinary, vaLString:
+ begin
+ Read(Count, 4);
+ SkipBytes(Count);
+ end;
+ vaWString:
+ begin
+ Read(Count, 4);
+ SkipBytes(Count*sizeof(widechar));
+ end;
+ vaSet:
+ SkipSetBody;
+ vaCollection:
+ begin
+ while NextValue <> vaNull do
+ begin
+ { Skip the order value if present }
+ if NextValue in [vaInt8, vaInt16, vaInt32] then
+ SkipValue;
+ SkipBytes(1);
+ while NextValue <> vaNull do
+ SkipProperty;
+ ReadValue;
+ end;
+ ReadValue;
+ end;
+ vaSingle:
+ SkipBytes(Sizeof(Single));
+ {!!!: vaCurrency:
+ SkipBytes(SizeOf(Currency));}
+ vaDate:
+ SkipBytes(Sizeof(TDateTime));
+ vaInt64:
+ SkipBytes(8);
+ end;
+end;
+
+{ private methods }
+
+procedure TBinaryObjectReader.Read(var Buf; Count: LongInt);
+var
+ CopyNow: LongInt;
+ Dest: Pointer;
+begin
+ Dest := @Buf;
+ while Count > 0 do
+ begin
+ if FBufPos >= FBufEnd then
+ begin
+ FBufEnd := FStream.Read(FBuffer^, FBufSize);
+ if FBufEnd = 0 then
+ raise EReadError.Create(SReadError);
+ FBufPos := 0;
+ end;
+ CopyNow := FBufEnd - FBufPos;
+ if CopyNow > Count then
+ CopyNow := Count;
+ Move(PChar(FBuffer)[FBufPos], Dest^, CopyNow);
+ Inc(FBufPos, CopyNow);
+ Inc(Dest, CopyNow);
+ Dec(Count, CopyNow);
+ end;
+end;
+
+procedure TBinaryObjectReader.SkipProperty;
+begin
+ { Skip property name, then the property value }
+ ReadStr;
+ SkipValue;
+end;
+
+procedure TBinaryObjectReader.SkipSetBody;
+begin
+ while Length(ReadStr) > 0 do;
+end;
+
+
+
+{****************************************************************************}
+{* TREADER *}
+{****************************************************************************}
+
+type
+ TFieldInfo = packed record
+ FieldOffset: LongWord;
+ ClassTypeIndex: Word;
+ Name: ShortString;
+ end;
+
+ PFieldClassTable = ^TFieldClassTable;
+ TFieldClassTable =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ Count: Word;
+ Entries: array[Word] of TPersistentClass;
+ end;
+
+ PFieldTable = ^TFieldTable;
+ TFieldTable =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ FieldCount: Word;
+ ClassTable: PFieldClassTable;
+ // Fields: array[Word] of TFieldInfo; Elements have variant size!
+ end;
+
+function GetFieldClass(Instance: TObject; const ClassName: string): TPersistentClass;
+var
+ UClassName: String;
+ ClassType: TClass;
+ ClassTable: PFieldClassTable;
+ i: Integer;
+{ FieldTable: PFieldTable; }
+begin
+ // At first, try to locate the class in the class tables
+ UClassName := UpperCase(ClassName);
+ ClassType := Instance.ClassType;
+ while ClassType <> TPersistent do
+ begin
+{ FieldTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^); }
+ ClassTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^)^.ClassTable;
+ if Assigned(ClassTable) then
+ for i := 0 to ClassTable^.Count - 1 do
+ begin
+ Result := ClassTable^.Entries[i];
+ if UpperCase(Result.ClassName) = UClassName then
+ exit;
+ end;
+ // Try again with the parent class type
+ ClassType := ClassType.ClassParent;
+ end;
+ Result := Classes.GetClass(ClassName);
+end;
+
+
+constructor TReader.Create(Stream: TStream; BufSize: Integer);
+begin
+ inherited Create;
+ If (Stream=Nil) then
+ Raise EReadError.Create(SEmptyStreamIllegalReader);
+ FDriver := CreateDriver(Stream, BufSize);
+end;
+
+destructor TReader.Destroy;
+begin
+ FDriver.Free;
+ inherited Destroy;
+end;
+
+function TReader.CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectReader;
+begin
+ Result := TBinaryObjectReader.Create(Stream, BufSize);
+end;
+
+procedure TReader.BeginReferences;
+begin
+ FLoaded := TList.Create;
+ try
+ FFixups := TList.Create;
+ except
+ FLoaded.Free;
+ raise;
+ end;
+end;
+
+procedure TReader.CheckValue(Value: TValueType);
+begin
+ if FDriver.NextValue <> Value then
+ raise EReadError.Create(SInvalidPropertyValue)
+ else
+ FDriver.ReadValue;
+end;
+
+procedure TReader.DefineProperty(const Name: String; AReadData: TReaderProc;
+ WriteData: TWriterProc; HasData: Boolean);
+begin
+ if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
+ begin
+ AReadData(Self);
+ SetLength(FPropName, 0);
+ end;
+end;
+
+procedure TReader.DefineBinaryProperty(const Name: String;
+ AReadData, WriteData: TStreamProc; HasData: Boolean);
+var
+ MemBuffer: TMemoryStream;
+begin
+ if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
+ begin
+ { Check if the next property really is a binary property}
+ if FDriver.NextValue <> vaBinary then
+ begin
+ FDriver.SkipValue;
+ FCanHandleExcepts := True;
+ raise EReadError.Create(SInvalidPropertyValue);
+ end else
+ FDriver.ReadValue;
+
+ MemBuffer := TMemoryStream.Create;
+ try
+ FDriver.ReadBinary(MemBuffer);
+ FCanHandleExcepts := True;
+ AReadData(MemBuffer);
+ finally
+ MemBuffer.Free;
+ end;
+ SetLength(FPropName, 0);
+ end;
+end;
+
+function TReader.EndOfList: Boolean;
+begin
+ Result := FDriver.NextValue = vaNull;
+end;
+
+procedure TReader.EndReferences;
+begin
+ FreeFixups;
+ FLoaded.Free;
+ FLoaded := nil;
+end;
+
+function TReader.Error(const Message: String): Boolean;
+begin
+ Result := False;
+ if Assigned(FOnError) then
+ FOnError(Self, Message, Result);
+end;
+
+function TReader.FindMethod(ARoot: TComponent; const AMethodName: String): Pointer;
+var
+ ErrorResult: Boolean;
+begin
+ Result := ARoot.MethodAddress(AMethodName);
+ ErrorResult := Result = nil;
+
+ { always give the OnFindMethod callback a chance to locate the method }
+ if Assigned(FOnFindMethod) then
+ FOnFindMethod(Self, AMethodName, Result, ErrorResult);
+
+ if ErrorResult then
+ raise EReadError.Create(SInvalidPropertyValue);
+end;
+
+procedure RemoveGlobalFixup(Fixup: TPropFixup);
+var
+ i: Integer;
+begin
+ with GlobalFixupList.LockList do
+ try
+ for i := Count - 1 downto 0 do
+ with TPropFixup(Items[i]) do
+ if (FInstance = Fixup.FInstance) and
+ (FPropInfo = Fixup.FPropInfo) then
+ begin
+ Free;
+ Delete(i);
+ end;
+ finally
+ GlobalFixupList.UnlockList;
+ end;
+end;
+
+procedure TReader.DoFixupReferences;
+var
+ i: Integer;
+ CurFixup: TPropFixup;
+ CurName: String;
+ Target: Pointer;
+begin
+ if Assigned(FFixups) then
+ try
+ for i := 0 to FFixups.Count - 1 do
+ begin
+ CurFixup := TPropFixup(FFixups[i]);
+ CurName := CurFixup.FName;
+ if Assigned(FOnReferenceName) then
+ FOnReferenceName(Self, CurName);
+ Target := FindNestedComponent(CurFixup.FInstanceRoot, CurName);
+ RemoveGlobalFixup(CurFixup);
+ if (not Assigned(Target)) and CurFixup.MakeGlobalReference then
+ begin
+ GlobalFixupList.Add(CurFixup);
+ FFixups[i] := nil;
+ end else
+ SetOrdProp(CurFixup.FInstance, CurFixup.FPropInfo, LongInt(Target));
+ end;
+ finally
+ FreeFixups;
+ end;
+end;
+
+procedure TReader.FixupReferences;
+var
+ i: Integer;
+begin
+ DoFixupReferences;
+ GlobalFixupReferences;
+ for i := 0 to FLoaded.Count - 1 do
+ TComponent(FLoaded[I]).Loaded;
+end;
+
+procedure TReader.FreeFixups;
+var
+ i: Integer;
+begin
+ if Assigned(FFixups) then
+ begin
+ for i := 0 to FFixups.Count - 1 do
+ TPropFixup(FFixups[I]).Free;
+ FFixups.Free;
+ FFixups := nil;
+ end;
+end;
+
+function TReader.NextValue: TValueType;
+begin
+ Result := FDriver.NextValue;
+end;
+
+procedure TReader.PropertyError;
+begin
+ FDriver.SkipValue;
+ raise EReadError.CreateFmt(SUnknownProperty,[FPropName]);
+end;
+
+function TReader.ReadBoolean: Boolean;
+var
+ ValueType: TValueType;
+begin
+ ValueType := FDriver.ReadValue;
+ if ValueType = vaTrue then
+ Result := True
+ else if ValueType = vaFalse then
+ Result := False
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+end;
+
+function TReader.ReadChar: Char;
+var
+ s: String;
+begin
+ s := ReadString;
+ if Length(s) = 1 then
+ Result := s[1]
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+end;
+
+procedure TReader.ReadCollection(Collection: TCollection);
+var
+ Item: TPersistent;
+begin
+ Collection.BeginUpdate;
+ try
+ if not EndOfList then
+ Collection.Clear;
+ while not EndOfList do
+ begin
+ if FDriver.NextValue in [vaInt8, vaInt16, vaInt32] then
+ ReadInteger; { Skip order value }
+ Item := Collection.Add;
+ ReadListBegin;
+ while not EndOfList do
+ ReadProperty(Item);
+ ReadListEnd;
+ end;
+ ReadListEnd;
+ finally
+ Collection.EndUpdate;
+ end;
+end;
+
+function TReader.ReadComponent(Component: TComponent): TComponent;
+var
+ Flags: TFilerFlags;
+
+ function Recover(var Component: TComponent): Boolean;
+ begin
+ Result := False;
+ if ExceptObject.InheritsFrom(Exception) then
+ begin
+ if not ((ffInherited in Flags) or Assigned(Component)) then
+ Component.Free;
+ Component := nil;
+ FDriver.SkipComponent(False);
+ Result := Error(Exception(ExceptObject).Message);
+ end;
+ end;
+
+var
+ CompClassName, Name: String;
+ n, ChildPos: Integer;
+ SavedParent, SavedLookupRoot: TComponent;
+ ComponentClass: TComponentClass;
+ C, NewComponent: TComponent;
+ SubComponents: TList;
+begin
+ FDriver.BeginComponent(Flags, ChildPos, CompClassName, Name);
+ SavedParent := Parent;
+ SavedLookupRoot := FLookupRoot;
+ SubComponents := nil;
+ try
+ Result := Component;
+ if not Assigned(Result) then
+ try
+ if ffInherited in Flags then
+ begin
+ { Try to locate the existing ancestor component }
+
+ if Assigned(FLookupRoot) then
+ Result := FLookupRoot.FindComponent(Name)
+ else
+ Result := nil;
+
+ if not Assigned(Result) then
+ begin
+ if Assigned(FOnAncestorNotFound) then
+ FOnAncestorNotFound(Self, Name,
+ FindComponentClass(CompClassName), Result);
+ if not Assigned(Result) then
+ raise EReadError.CreateFmt(SAncestorNotFound, [Name]);
+ end;
+
+ Parent := Result.GetParentComponent;
+ if not Assigned(Parent) then
+ Parent := Root;
+ end else
+ begin
+ Result := nil;
+ ComponentClass := FindComponentClass(CompClassName);
+ if Assigned(FOnCreateComponent) then
+ FOnCreateComponent(Self, ComponentClass, Result);
+ if not Assigned(Result) then
+ begin
+ NewComponent := TComponent(ComponentClass.NewInstance);
+ if ffInline in Flags then
+ NewComponent.FComponentState :=
+ NewComponent.FComponentState + [csLoading, csInline];
+ NewComponent.Create(Owner);
+
+ { Don't set Result earlier because else we would come in trouble
+ with the exception recover mechanism! (Result should be NIL if
+ an error occured) }
+ Result := NewComponent;
+ end;
+ Include(Result.FComponentState, csLoading);
+ end;
+ except
+ if not Recover(Result) then
+ raise;
+ end;
+
+ if Assigned(Result) then
+ try
+ Include(Result.FComponentState, csLoading);
+
+ { create list of subcomponents and set loading}
+ SubComponents := TList.Create;
+ for n := 0 to Result.ComponentCount - 1 do
+ begin
+ C := Result.Components[n];
+ if csSubcomponent in C.ComponentStyle
+ then begin
+ SubComponents.Add(C);
+ Include(C.FComponentState, csLoading);
+ end;
+ end;
+
+ if not (ffInherited in Flags) then
+ try
+ Result.SetParentComponent(Parent);
+ if Assigned(FOnSetName) then
+ FOnSetName(Self, Result, Name);
+ Result.Name := Name;
+ if FindGlobalComponent(Name) = Result then
+ Include(Result.FComponentState, csInline);
+ except
+ if not Recover(Result) then
+ raise;
+ end;
+ if not Assigned(Result) then
+ exit;
+ if csInline in Result.ComponentState then
+ FLookupRoot := Result;
+
+ { Read the component state }
+ Include(Result.FComponentState, csReading);
+ for n := 0 to Subcomponents.Count - 1 do
+ Include(TComponent(Subcomponents[n]).FComponentState, csReading);
+
+ Result.ReadState(Self);
+
+ Exclude(Result.FComponentState, csReading);
+ for n := 0 to Subcomponents.Count - 1 do
+ Exclude(TComponent(Subcomponents[n]).FComponentState, csReading);
+
+ if ffChildPos in Flags then
+ Parent.SetChildOrder(Result, ChildPos);
+
+ { Add component to list of loaded components, if necessary }
+ if (not ((ffInherited in Flags) or (csInline in Result.ComponentState))) or
+ (FLoaded.IndexOf(Result) < 0)
+ then begin
+ for n := 0 to Subcomponents.Count - 1 do
+ FLoaded.Add(Subcomponents[n]);
+ FLoaded.Add(Result);
+ end;
+ except
+ if ((ffInherited in Flags) or Assigned(Component)) then
+ Result.Free;
+ raise;
+ end;
+ finally
+ Parent := SavedParent;
+ FLookupRoot := SavedLookupRoot;
+ Subcomponents.Free;
+ end;
+end;
+
+procedure TReader.ReadData(Instance: TComponent);
+var
+ DoFreeFixups: Boolean;
+ SavedOwner, SavedParent: TComponent;
+begin
+ if not Assigned(FFixups) then
+ begin
+ FFixups := TList.Create;
+ DoFreeFixups := True;
+ end else
+ DoFreeFixups := False;
+
+ try
+ { Read properties }
+ while not EndOfList do
+ ReadProperty(Instance);
+ ReadListEnd;
+
+ { Read children }
+ SavedOwner := Owner;
+ SavedParent := Parent;
+ try
+ Owner := Instance.GetChildOwner;
+ if not Assigned(Owner) then
+ Owner := Root;
+ Parent := Instance.GetChildParent;
+
+ while not EndOfList do
+ ReadComponent(nil);
+ ReadListEnd;
+ finally
+ Owner := SavedOwner;
+ Parent := SavedParent;
+ end;
+
+ { Fixup references if necessary (normally only if this is the root) }
+ if DoFreeFixups then
+ DoFixupReferences;
+
+ finally
+ if DoFreeFixups then
+ FreeFixups;
+ end;
+end;
+
+function TReader.ReadFloat: Extended;
+begin
+ if FDriver.NextValue = vaExtended then
+ begin
+ ReadValue;
+ Result := FDriver.ReadFloat
+ end else
+ Result := ReadInteger;
+end;
+
+function TReader.ReadSingle: Single;
+begin
+ if FDriver.NextValue = vaSingle then
+ begin
+ FDriver.ReadValue;
+ Result := FDriver.ReadSingle;
+ end else
+ Result := ReadInteger;
+end;
+
+{$ifdef HASCURRENCY}
+function TReader.ReadCurrency: Currency;
+begin
+ if FDriver.NextValue = vaCurrency then
+ begin
+ FDriver.ReadValue;
+ Result := FDriver.ReadCurrency;
+ end else
+ Result := ReadInteger;
+end;
+{$endif HASCURRENCY}
+
+
+function TReader.ReadDate: TDateTime;
+begin
+ if FDriver.NextValue = vaDate then
+ begin
+ FDriver.ReadValue;
+ Result := FDriver.ReadDate;
+ end else
+ Result := ReadInteger;
+end;
+
+function TReader.ReadIdent: String;
+var
+ ValueType: TValueType;
+begin
+ ValueType := FDriver.ReadValue;
+ if ValueType in [vaIdent, vaNil, vaFalse, vaTrue, vaNull] then
+ Result := FDriver.ReadIdent(ValueType)
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+end;
+
+
+function TReader.ReadInteger: LongInt;
+begin
+ case FDriver.ReadValue of
+ vaInt8:
+ Result := FDriver.ReadInt8;
+ vaInt16:
+ Result := FDriver.ReadInt16;
+ vaInt32:
+ Result := FDriver.ReadInt32;
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+ end;
+end;
+
+function TReader.ReadInt64: Int64;
+begin
+ if FDriver.NextValue = vaInt64 then
+ begin
+ FDriver.ReadValue;
+ Result := FDriver.ReadInt64;
+ end else
+ Result := ReadInteger;
+end;
+
+procedure TReader.ReadListBegin;
+begin
+ CheckValue(vaList);
+end;
+
+procedure TReader.ReadListEnd;
+begin
+ CheckValue(vaNull);
+end;
+
+procedure TReader.ReadProperty(AInstance: TPersistent);
+var
+ Path: String;
+ Instance: TPersistent;
+ DotPos, NextPos: PChar;
+ PropInfo: PPropInfo;
+ Obj: TObject;
+ Name: String;
+ Skip: Boolean;
+ Handled: Boolean;
+ OldPropName: String;
+
+ function HandleMissingProperty(IsPath: Boolean): boolean;
+ begin
+ Result:=true;
+ if Assigned(OnPropertyNotFound) then begin
+ // user defined property error handling
+ OldPropName:=FPropName;
+ Handled:=false;
+ Skip:=false;
+ OnPropertyNotFound(Self,Instance,FPropName,IsPath,Handled,Skip);
+ if Handled and (not Skip) and (OldPropName<>FPropName) then
+ // try alias property
+ PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+ if Skip then begin
+ FDriver.SkipValue;
+ Result:=false;
+ exit;
+ end;
+ end;
+ end;
+
+begin
+ try
+ Path := FDriver.BeginProperty;
+ try
+ Instance := AInstance;
+ FCanHandleExcepts := True;
+ DotPos := PChar(Path);
+ while True do
+ begin
+ NextPos := StrScan(DotPos, '.');
+ if Assigned(NextPos) then
+ FPropName := Copy(String(DotPos), 1, Integer(NextPos - DotPos))
+ else
+ begin
+ FPropName := DotPos;
+ break;
+ end;
+ DotPos := NextPos + 1;
+
+ PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+ if not Assigned(PropInfo) then begin
+ if not HandleMissingProperty(true) then exit;
+ if not Assigned(PropInfo) then
+ PropertyError;
+ end;
+
+ if PropInfo^.PropType^.Kind = tkClass then
+ Obj := TObject(GetObjectProp(Instance, PropInfo))
+ else
+ Obj := nil;
+
+ if not (Obj is TPersistent) then
+ begin
+ { All path elements must be persistent objects! }
+ FDriver.SkipValue;
+ raise EReadError.Create(SInvalidPropertyPath);
+ end;
+ Instance := TPersistent(Obj);
+ end;
+
+ PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+ if Assigned(PropInfo) then
+ ReadPropValue(Instance, PropInfo)
+ else
+ begin
+ FCanHandleExcepts := False;
+ Instance.DefineProperties(Self);
+ FCanHandleExcepts := True;
+ if Length(FPropName) > 0 then begin
+ if not HandleMissingProperty(false) then exit;
+ if not Assigned(PropInfo) then
+ PropertyError;
+ end;
+ end;
+ except
+ on e: Exception do
+ begin
+ SetLength(Name, 0);
+ if AInstance.InheritsFrom(TComponent) then
+ Name := TComponent(AInstance).Name;
+ if Length(Name) = 0 then
+ Name := AInstance.ClassName;
+ raise EReadError.CreateFmt(SPropertyException,
+ [Name, DotSep, Path, e.Message]);
+ end;
+ end;
+ except
+ on e: Exception do
+ if not FCanHandleExcepts or not Error(E.Message) then
+ raise;
+ end;
+end;
+
+procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
+const
+ NullMethod: TMethod = (Code: nil; Data: nil);
+var
+ PropType: PTypeInfo;
+ Value: LongInt;
+{ IdentToIntFn: TIdentToInt; }
+ Ident: String;
+ Method: TMethod;
+ Handled: Boolean;
+ TmpStr: String;
+begin
+ if not Assigned(PPropInfo(PropInfo)^.SetProc) then
+ raise EReadError.Create(SReadOnlyProperty);
+
+ PropType := PPropInfo(PropInfo)^.PropType;
+ case PropType^.Kind of
+ tkInteger:
+ if FDriver.NextValue = vaIdent then
+ begin
+ Ident := ReadIdent;
+ if GlobalIdentToInt(Ident,Value) then
+ SetOrdProp(Instance, PropInfo, Value)
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+ end else
+ SetOrdProp(Instance, PropInfo, ReadInteger);
+ tkBool:
+ SetOrdProp(Instance, PropInfo, Ord(ReadBoolean));
+ tkChar:
+ SetOrdProp(Instance, PropInfo, Ord(ReadChar));
+ tkEnumeration:
+ begin
+ Value := GetEnumValue(PropType, ReadIdent);
+ if Value = -1 then
+ raise EReadError.Create(SInvalidPropertyValue);
+ SetOrdProp(Instance, PropInfo, Value);
+ end;
+ tkFloat:
+ SetFloatProp(Instance, PropInfo, ReadFloat);
+ tkSet:
+ begin
+ CheckValue(vaSet);
+ SetOrdProp(Instance, PropInfo,
+ FDriver.ReadSet(GetTypeData(PropType)^.CompType));
+ end;
+ tkMethod:
+ if FDriver.NextValue = vaNil then
+ begin
+ FDriver.ReadValue;
+ SetMethodProp(Instance, PropInfo, NullMethod);
+ end else
+ begin
+ Handled:=false;
+ Ident:=ReadIdent;
+ if Assigned(OnSetMethodProperty) then
+ OnSetMethodProperty(Self,Instance,PPropInfo(PropInfo),Ident,
+ Handled);
+ if not Handled then begin
+ Method.Code := FindMethod(Root, Ident);
+ Method.Data := Root;
+ if Assigned(Method.Code) then
+ SetMethodProp(Instance, PropInfo, Method);
+ end;
+ end;
+{$ifndef HASWIDESTRING}
+ tkWString,
+{$endif}
+ tkSString, tkLString, tkAString:
+ begin
+ TmpStr:=ReadString;
+ if Assigned(FOnReadStringProperty) then
+ FOnReadStringProperty(Self,Instance,PropInfo,TmpStr);
+ SetStrProp(Instance, PropInfo, TmpStr);
+ end;
+{$ifdef HASWIDESTRING}
+ tkWstring:
+ SetWideStrProp(Instance,PropInfo,ReadWideString);
+{$endif}
+ {!!!: tkVariant}
+ tkClass:
+ case FDriver.NextValue of
+ vaNil:
+ begin
+ FDriver.ReadValue;
+ SetOrdProp(Instance, PropInfo, 0)
+ end;
+ vaCollection:
+ begin
+ FDriver.ReadValue;
+ ReadCollection(TCollection(GetObjectProp(Instance, PropInfo)));
+ end
+ else
+ FFixups.Add(TPropFixup.Create(Instance, Root, PropInfo, '', ReadIdent));
+ end;
+ tkInt64: SetInt64Prop(Instance, PropInfo, ReadInt64);
+ else
+ raise EReadError.CreateFmt(SUnknownPropertyType, [Ord(PropType^.Kind)]);
+ end;
+end;
+
+function TReader.ReadRootComponent(ARoot: TComponent): TComponent;
+var
+ Dummy, i: Integer;
+ Flags: TFilerFlags;
+ CompClassName, CompName, ResultName: String;
+begin
+ FDriver.BeginRootComponent;
+ Result := nil;
+ {!!!: GlobalNameSpace.BeginWrite; // Loading from stream adds to name space
+ try}
+ try
+ FDriver.BeginComponent(Flags, Dummy, CompClassName, CompName);
+ if not Assigned(ARoot) then
+ begin
+ { Read the class name and the object name and create a new object: }
+ Result := TComponentClass(FindClass(CompClassName)).Create(nil);
+ Result.Name := CompName;
+ end else
+ begin
+ Result := ARoot;
+
+ if not (csDesigning in Result.ComponentState) then
+ begin
+ Result.FComponentState :=
+ Result.FComponentState + [csLoading, csReading];
+
+ { We need an unique name }
+ i := 0;
+ { Don't use Result.Name directly, as this would influence
+ FindGlobalComponent in successive loop runs }
+ ResultName := CompName;
+ while Assigned(FindGlobalComponent(ResultName)) do
+ begin
+ Inc(i);
+ ResultName := CompName + '_' + IntToStr(i);
+ end;
+ Result.Name := ResultName;
+ end;
+ end;
+
+ FRoot := Result;
+ FLookupRoot := Result;
+ if Assigned(GlobalLoaded) then
+ FLoaded := GlobalLoaded
+ else
+ FLoaded := TList.Create;
+
+ try
+ if FLoaded.IndexOf(FRoot) < 0 then
+ FLoaded.Add(FRoot);
+ FOwner := FRoot;
+ FRoot.FComponentState := FRoot.FComponentState + [csLoading, csReading];
+ FRoot.ReadState(Self);
+ Exclude(FRoot.FComponentState, csReading);
+
+ if not Assigned(GlobalLoaded) then
+ for i := 0 to FLoaded.Count - 1 do
+ TComponent(FLoaded[i]).Loaded;
+
+ finally
+ if not Assigned(GlobalLoaded) then
+ FLoaded.Free;
+ FLoaded := nil;
+ end;
+ GlobalFixupReferences;
+ except
+ RemoveFixupReferences(ARoot, '');
+ if not Assigned(ARoot) then
+ Result.Free;
+ raise;
+ end;
+ {finally
+ GlobalNameSpace.EndWrite;
+ end;}
+end;
+
+procedure TReader.ReadComponents(AOwner, AParent: TComponent;
+ Proc: TReadComponentsProc);
+var
+ Component: TComponent;
+begin
+ Root := AOwner;
+ Owner := AOwner;
+ Parent := AParent;
+ BeginReferences;
+ try
+ while not EndOfList do
+ begin
+ FDriver.BeginRootComponent;
+ Component := ReadComponent(nil);
+ if Assigned(Proc) then
+ Proc(Component);
+ end;
+ ReadListEnd;
+ FixupReferences;
+ finally
+ EndReferences;
+ end;
+end;
+
+
+function TReader.ReadString: String;
+var
+ StringType: TValueType;
+begin
+ StringType := FDriver.ReadValue;
+ if StringType in [vaString, vaLString] then
+ Result := FDriver.ReadString(StringType)
+ else
+ raise EReadError.Create(SInvalidPropertyValue);
+end;
+
+
+{$ifdef HASWIDESTRING}
+function TReader.ReadWideString: WideString;
+var
+ s: String;
+ i: Integer;
+begin
+ if NextValue = vaWString then
+ begin
+ ReadValue;
+ Result := FDriver.ReadWideString
+ end
+ else begin
+ //data probable from ObjectTextToBinary
+ s := ReadString;
+ setlength(result,length(s));
+ for i:= 1 to length(s) do begin
+ result[i]:= s[i]; //no code conversion
+ end;
+ end;
+end;
+{$endif HASWIDESTRING}
+
+function TReader.ReadValue: TValueType;
+begin
+ Result := FDriver.ReadValue;
+end;
+
+procedure TReader.CopyValue(Writer: TWriter);
+
+ procedure CopyBytes(Count: Integer);
+{ var
+ Buffer: array[0..1023] of Byte; }
+ begin
+{!!!: while Count > 1024 do
+ begin
+ FDriver.Read(Buffer, 1024);
+ Writer.Driver.Write(Buffer, 1024);
+ Dec(Count, 1024);
+â end;
+ if Count > 0 then
+ begin
+ FDriver.Read(Buffer, Count);
+ Writer.Driver.Write(Buffer, Count);
+ end;}
+ end;
+
+{var
+ s: String;
+ Count: LongInt; }
+begin
+ case FDriver.NextValue of
+ vaNull:
+ Writer.WriteIdent('NULL');
+ vaFalse:
+ Writer.WriteIdent('FALSE');
+ vaTrue:
+ Writer.WriteIdent('TRUE');
+ vaNil:
+ Writer.WriteIdent('NIL');
+ {!!!: vaList, vaCollection:
+ begin
+ Writer.WriteValue(FDriver.ReadValue);
+ while not EndOfList do
+ CopyValue(Writer);
+ ReadListEnd;
+ Writer.WriteListEnd;
+ end;}
+ vaInt8, vaInt16, vaInt32:
+ Writer.WriteInteger(ReadInteger);
+ vaExtended:
+ Writer.WriteFloat(ReadFloat);
+ {!!!: vaString:
+ Writer.WriteStr(ReadStr);}
+ vaIdent:
+ Writer.WriteIdent(ReadIdent);
+ {!!!: vaBinary, vaLString, vaWString:
+ begin
+ Writer.WriteValue(FDriver.ReadValue);
+ FDriver.Read(Count, SizeOf(Count));
+ Writer.Driver.Write(Count, SizeOf(Count));
+ CopyBytes(Count);
+ end;}
+ {!!!: vaSet:
+ Writer.WriteSet(ReadSet);}
+ vaSingle:
+ Writer.WriteSingle(ReadSingle);
+ {!!!: vaCurrency:
+ Writer.WriteCurrency(ReadCurrency);}
+ vaDate:
+ Writer.WriteDate(ReadDate);
+ vaInt64:
+ Writer.WriteInteger(ReadInt64);
+ end;
+end;
+
+function TReader.FindComponentClass(const AClassName: String): TComponentClass;
+begin
+ TPersistentClass(Result) := GetFieldClass(Root, AClassName);
+ if not Assigned(Result) and Assigned(FLookupRoot) and (FLookupRoot <> Root) then
+ TPersistentClass(Result) := GetFieldClass(FLookupRoot, AClassName);
+ if Assigned(FOnFindComponentClass) then
+ FOnFindComponentClass(Self, AClassName, Result);
+ if not (Assigned(Result) and Result.InheritsFrom(TComponent)) then
+ raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
+end;
+
+
+{
+ $Log: reader.inc,v $
+ Revision 1.19 2005/04/15 07:21:09 michael
+ + Streaming of subcomponents added by Marc Weustink
+
+ Revision 1.18 2005/04/09 20:37:08 michael
+ + Patch from Uberto Barbini to allow creating streams with different drivers
+
+ Revision 1.17 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.16 2005/03/07 16:35:19 peter
+ * Object text format of widestrings patch from Martin Schreiber
+
+ Revision 1.15 2005/02/25 23:02:05 florian
+ + implemented D7 compliant FindGlobalComponents
+
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.13 2005/01/22 20:53:02 michael
+ + Patch from Colin Western to fix reading inherited forms
+
+ Revision 1.12 2005/01/21 15:53:17 peter
+ * fixed vaWString in skipvalue, patch by Martin Schreiber
+
+}
diff --git a/rtl/objpas/classes/streams.inc b/rtl/objpas/classes/streams.inc
new file mode 100644
index 0000000000..05258e2c2e
--- /dev/null
+++ b/rtl/objpas/classes/streams.inc
@@ -0,0 +1,835 @@
+{
+ $Id: streams.inc,v 1.9 2005/03/25 20:07:43 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TStream *}
+{****************************************************************************}
+
+{$ifdef seek64bit}
+ function TStream.GetPosition: Int64;
+
+ begin
+ Result:=Seek(0,soCurrent);
+ end;
+
+ procedure TStream.SetPosition(const Pos: Int64);
+
+ begin
+ Seek(pos,soBeginning);
+ end;
+
+ procedure TStream.SetSize64(const NewSize: Int64);
+
+ begin
+ // Required because can't use overloaded functions in properties
+ SetSize(NewSize);
+ end;
+
+ function TStream.GetSize: Int64;
+
+ var
+ p : int64;
+
+ begin
+ p:=Seek(0,soCurrent);
+ GetSize:=Seek(0,soEnd);
+ Seek(p,soBeginning);
+ end;
+
+ procedure TStream.SetSize(NewSize: Longint);
+
+ begin
+ // We do nothing. Pipe streams don't support this
+ // As wel as possible read-ony streams !!
+ end;
+
+ procedure TStream.SetSize(const NewSize: Int64);
+
+ begin
+ // Backwards compatibility that calls the longint SetSize
+ if (NewSize<Low(longint)) or
+ (NewSize>High(longint)) then
+ raise ERangeError.Create(SRangeError);
+ SetSize(longint(NewSize));
+ end;
+
+ function TStream.Seek(Offset: Longint; Origin: Word): Longint;
+
+ type
+ TSeek64 = function(const offset:Int64;Origin:TSeekorigin):Int64 of object;
+ var
+ CurrSeek,
+ TStreamSeek : TSeek64;
+ CurrClass : TClass;
+ begin
+ // Redirect calls to 64bit Seek, but we can't call the 64bit Seek
+ // from TStream, because then we end up in an infinite loop
+ CurrSeek:=nil;
+ CurrClass:=Classtype;
+ while (CurrClass<>nil) and
+ (CurrClass<>TStream) do
+ CurrClass:=CurrClass.Classparent;
+ if CurrClass<>nil then
+ begin
+ CurrSeek:=@Self.Seek;
+ TStreamSeek:=@TStream(@CurrClass).Seek;
+ if TMethod(TStreamSeek).Code=TMethod(CurrSeek).Code then
+ CurrSeek:=nil;
+ end;
+ if CurrSeek<>nil then
+ Result:=Seek(Int64(offset),TSeekOrigin(origin))
+ else
+ raise EStreamError.CreateFmt(SSeekNotImplemented,[ClassName]);
+ end;
+
+ function TStream.Seek(const Offset: Int64; Origin: TSeekorigin): Int64;
+
+ begin
+ // Backwards compatibility that calls the longint Seek
+ if (Offset<Low(longint)) or
+ (Offset>High(longint)) then
+ raise ERangeError.Create(SRangeError);
+ Result:=Seek(longint(Offset),ord(Origin));
+ end;
+
+{$else seek64bit}
+
+ function TStream.GetPosition: Longint;
+
+ begin
+ Result:=Seek(0,soFromCurrent);
+ end;
+
+ procedure TStream.SetPosition(Pos: Longint);
+
+ begin
+ Seek(pos,soFromBeginning);
+ end;
+
+ function TStream.GetSize: Longint;
+
+ var
+ p : longint;
+
+ begin
+ p:=GetPosition;
+ GetSize:=Seek(0,soFromEnd);
+ Seek(p,soFromBeginning);
+ end;
+
+ procedure TStream.SetSize(NewSize: Longint);
+
+ begin
+ // We do nothing. Pipe streams don't support this
+ // As wel as possible read-ony streams !!
+ end;
+
+{$endif seek64bit}
+
+ procedure TStream.ReadBuffer(var Buffer; Count: Longint);
+
+ begin
+ if Read(Buffer,Count)<Count then
+ Raise EReadError.Create(SReadError);
+ end;
+
+ procedure TStream.WriteBuffer(const Buffer; Count: Longint);
+
+ begin
+ if Write(Buffer,Count)<Count then
+ Raise EWriteError.Create(SWriteError);
+ end;
+
+ function TStream.CopyFrom(Source: TStream; Count: Int64): Int64;
+
+ var
+ i : Int64;
+ buffer : array[0..1023] of byte;
+
+ begin
+ CopyFrom:=0;
+ If (Count=0) then
+ begin
+ // This WILL fail for non-seekable streams...
+ Source.Position:=0;
+ Count:=Source.Size;
+ end;
+ while Count>0 do
+ begin
+ if (Count>sizeof(buffer)) then
+ i:=sizeof(Buffer)
+ else
+ i:=Count;
+ i:=Source.Read(buffer,i);
+ i:=Write(buffer,i);
+ if i=0 then break;
+ dec(count,i);
+ CopyFrom:=CopyFrom+i;
+ end;
+ end;
+
+ function TStream.ReadComponent(Instance: TComponent): TComponent;
+
+ var
+ Reader: TReader;
+
+ begin
+
+ Reader := TReader.Create(Self, 4096);
+ try
+ Result := Reader.ReadRootComponent(Instance);
+ finally
+ Reader.Free;
+ end;
+
+ end;
+
+ function TStream.ReadComponentRes(Instance: TComponent): TComponent;
+
+ begin
+
+ ReadResHeader;
+ Result := ReadComponent(Instance);
+
+ end;
+
+ procedure TStream.WriteComponent(Instance: TComponent);
+
+ begin
+
+ WriteDescendent(Instance, nil);
+
+ end;
+
+ procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
+
+ begin
+
+ WriteDescendentRes(ResName, Instance, nil);
+
+ end;
+
+ procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
+
+ var
+ Driver : TAbstractObjectWriter;
+ Writer : TWriter;
+
+ begin
+
+ Driver := TBinaryObjectWriter.Create(Self, 4096);
+ Try
+ Writer := TWriter.Create(Driver);
+ Try
+ Writer.WriteDescendent(Instance, Ancestor);
+ Finally
+ Writer.Destroy;
+ end;
+ Finally
+ Driver.Free;
+ end;
+
+ end;
+
+ procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
+
+ var
+ FixupInfo: Integer;
+
+ begin
+
+ { Write a resource header }
+ WriteResourceHeader(ResName, FixupInfo);
+ { Write the instance itself }
+ WriteDescendent(Instance, Ancestor);
+ { Insert the correct resource size into the resource header }
+ FixupResourceHeader(FixupInfo);
+
+ end;
+
+ procedure TStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
+
+ begin
+ { Numeric resource type }
+ WriteByte($ff);
+ { Application defined data }
+ WriteWord($0a);
+ { write the name as asciiz }
+ WriteBuffer(ResName[1],length(ResName));
+ WriteByte(0);
+ { Movable, Pure and Discardable }
+ WriteWord($1030);
+ { Placeholder for the resource size }
+ WriteDWord(0);
+ { Return current stream position so that the resource size can be
+ inserted later }
+ FixupInfo := Position;
+ end;
+
+ procedure TStream.FixupResourceHeader(FixupInfo: Integer);
+
+ var
+ ResSize : Integer;
+
+ begin
+
+ ResSize := Position - FixupInfo;
+
+ { Insert the correct resource size into the placeholder written by
+ WriteResourceHeader }
+ Position := FixupInfo - 4;
+ WriteDWord(ResSize);
+ { Seek back to the end of the resource }
+ Position := FixupInfo + ResSize;
+
+ end;
+
+ procedure TStream.ReadResHeader;
+
+ begin
+ try
+ { application specific resource ? }
+ if ReadByte<>$ff then
+ raise EInvalidImage.Create(SInvalidImage);
+ if ReadWord<>$000a then
+ raise EInvalidImage.Create(SInvalidImage);
+ { read name }
+ while ReadByte<>0 do
+ ;
+ { check the access specifier }
+ if ReadWord<>$1030 then
+ raise EInvalidImage.Create(SInvalidImage);
+ { ignore the size }
+ ReadDWord;
+ except
+ on EInvalidImage do
+ raise;
+ else
+ raise EInvalidImage.create(SInvalidImage);
+ end;
+ end;
+
+ function TStream.ReadByte : Byte;
+
+ var
+ b : Byte;
+
+ begin
+ ReadBuffer(b,1);
+ ReadByte:=b;
+ end;
+
+ function TStream.ReadWord : Word;
+
+ var
+ w : Word;
+
+ begin
+ ReadBuffer(w,2);
+ ReadWord:=w;
+ end;
+
+ function TStream.ReadDWord : Cardinal;
+
+ var
+ d : Cardinal;
+
+ begin
+ ReadBuffer(d,4);
+ ReadDWord:=d;
+ end;
+
+ Function TStream.ReadAnsiString : String;
+ Type
+ PByte = ^Byte;
+ Var
+ TheSize : Longint;
+ P : PByte ;
+ begin
+ ReadBuffer (TheSize,SizeOf(TheSize));
+ SetLength(Result,TheSize);
+ // Illegal typecast if no AnsiStrings defined.
+ if TheSize>0 then
+ begin
+ ReadBuffer (Pointer(Result)^,TheSize);
+ P:=Pointer(Result)+TheSize;
+ p^:=0;
+ end;
+ end;
+
+ Procedure TStream.WriteAnsiString (S : String);
+
+ Var L : Longint;
+
+ begin
+ L:=Length(S);
+ WriteBuffer (L,SizeOf(L));
+ WriteBuffer (Pointer(S)^,L);
+ end;
+
+ procedure TStream.WriteByte(b : Byte);
+
+ begin
+ WriteBuffer(b,1);
+ end;
+
+ procedure TStream.WriteWord(w : Word);
+
+ begin
+ WriteBuffer(w,2);
+ end;
+
+ procedure TStream.WriteDWord(d : Cardinal);
+
+ begin
+ WriteBuffer(d,4);
+ end;
+
+
+{****************************************************************************}
+{* THandleStream *}
+{****************************************************************************}
+
+Constructor THandleStream.Create(AHandle: Integer);
+
+begin
+ FHandle:=AHandle;
+end;
+
+
+function THandleStream.Read(var Buffer; Count: Longint): Longint;
+
+begin
+ Result:=FileRead(FHandle,Buffer,Count);
+ If Result=-1 then Result:=0;
+end;
+
+
+function THandleStream.Write(const Buffer; Count: Longint): Longint;
+
+begin
+ Result:=FileWrite (FHandle,Buffer,Count);
+ If Result=-1 then Result:=0;
+end;
+
+{$ifdef seek64bit}
+
+Procedure THandleStream.SetSize(NewSize: Longint);
+
+begin
+ SetSize(Int64(NewSize));
+end;
+
+
+Procedure THandleStream.SetSize(const NewSize: Int64);
+
+begin
+ FileTruncate(FHandle,NewSize);
+end;
+
+
+function THandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+
+begin
+ Result:=FileSeek(FHandle,Offset,ord(Origin));
+end;
+
+{$else seek64bit}
+
+Procedure THandleStream.SetSize(NewSize: Longint);
+begin
+ FileTruncate(FHandle,NewSize);
+end;
+
+
+function THandleStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+ Result:=FileSeek(FHandle,Offset,Origin);
+end;
+
+{$endif seek64bit}
+
+
+{****************************************************************************}
+{* TFileStream *}
+{****************************************************************************}
+
+constructor TFileStream.Create(const AFileName: string; Mode: Word);
+
+begin
+ FFileName:=AFileName;
+ If Mode=fmcreate then
+ FHandle:=FileCreate(AFileName)
+ else
+ FHAndle:=FileOpen(AFileName,Mode);
+ If FHandle<0 then
+ If Mode=fmcreate then
+ raise EFCreateError.createfmt(SFCreateError,[AFileName])
+ else
+ raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
+end;
+
+
+constructor TFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
+
+begin
+ FFileName:=AFileName;
+ If Mode=fmcreate then
+ FHandle:=FileCreate(AFileName)
+ else
+ FHAndle:=FileOpen(AFileName,Mode);
+ If FHandle<0 then
+ If Mode=fmcreate then
+ raise EFCreateError.createfmt(SFCreateError,[AFileName])
+ else
+ raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
+end;
+
+
+destructor TFileStream.Destroy;
+
+begin
+ FileClose(FHandle);
+end;
+
+{****************************************************************************}
+{* TCustomMemoryStream *}
+{****************************************************************************}
+
+procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; ASize: Longint);
+
+begin
+ FMemory:=Ptr;
+ FSize:=ASize;
+end;
+
+{$ifdef seek64bit}
+function TCustomMemoryStream.GetSize: Int64;
+
+begin
+ Result:=FSize;
+end;
+{$endif seek64bit}
+
+
+
+function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
+
+begin
+ Result:=0;
+ If (FSize>0) and (FPosition<Fsize) then
+ begin
+ Result:=FSize-FPosition;
+ If Result>Count then Result:=Count;
+ Move ((FMemory+FPosition)^,Buffer,Result);
+ FPosition:=Fposition+Result;
+ end;
+end;
+
+
+function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
+
+begin
+ Case Origin of
+ soFromBeginning : FPosition:=Offset;
+ soFromEnd : FPosition:=FSize+Offset;
+ soFromCurrent : FpoSition:=FPosition+Offset;
+ end;
+ Result:=FPosition;
+end;
+
+
+procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
+
+begin
+ if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
+end;
+
+
+procedure TCustomMemoryStream.SaveToFile(const FileName: string);
+
+Var S : TFileStream;
+
+begin
+ S:=TFileStream.Create (FileName,fmCreate);
+ Try
+ SaveToStream(S);
+ finally
+ S.free;
+ end;
+end;
+
+
+{****************************************************************************}
+{* TMemoryStream *}
+{****************************************************************************}
+
+
+Const TMSGrow = 4096; { Use 4k blocks. }
+
+procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
+
+begin
+ SetPointer (Realloc(NewCapacity),Fsize);
+ FCapacity:=NewCapacity;
+end;
+
+
+function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
+
+Var MoveSize : Longint;
+
+begin
+ If NewCapacity>0 Then // round off to block size.
+ NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
+ // Only now check !
+ If NewCapacity=FCapacity then
+ Result:=FMemory
+ else
+ If NewCapacity=0 then
+ FreeMem (FMemory,Fcapacity)
+ else
+ begin
+ GetMem (Result,NewCapacity);
+ If Result=Nil then
+ Raise EStreamError.Create(SMemoryStreamError);
+ If FCapacity>0 then
+ begin
+ MoveSize:=FSize;
+ If MoveSize>NewCapacity then MoveSize:=NewCapacity;
+ Move (Fmemory^,Result^,MoveSize);
+ FreeMem (FMemory,FCapacity);
+ end;
+ end;
+end;
+
+
+destructor TMemoryStream.Destroy;
+
+begin
+ Clear;
+ Inherited Destroy;
+end;
+
+
+procedure TMemoryStream.Clear;
+
+begin
+ FSize:=0;
+ FPosition:=0;
+ SetCapacity (0);
+end;
+
+
+procedure TMemoryStream.LoadFromStream(Stream: TStream);
+
+begin
+ Stream.Position:=0;
+ SetSize(Stream.Size);
+ If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
+end;
+
+
+procedure TMemoryStream.LoadFromFile(const FileName: string);
+
+Var S : TFileStream;
+
+begin
+ S:=TFileStream.Create (FileName,fmOpenRead);
+ Try
+ LoadFromStream(S);
+ finally
+ S.free;
+ end;
+end;
+
+
+procedure TMemoryStream.SetSize(NewSize: Longint);
+
+begin
+ SetCapacity (NewSize);
+ FSize:=NewSize;
+ IF FPosition>FSize then
+ FPosition:=FSize;
+end;
+
+function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
+
+Var NewPos : Longint;
+
+begin
+ If Count=0 then
+ exit(0);
+ NewPos:=FPosition+Count;
+ If NewPos>Fsize then
+ begin
+ IF NewPos>FCapacity then
+ SetCapacity (NewPos);
+ FSize:=Newpos;
+ end;
+ System.Move (Buffer,(FMemory+FPosition)^,Count);
+ FPosition:=NewPos;
+ Result:=Count;
+end;
+
+
+{****************************************************************************}
+{* TStringStream *}
+{****************************************************************************}
+
+procedure TStringStream.SetSize(NewSize: Longint);
+
+begin
+ Setlength(FDataString,NewSize);
+ If FPosition>NewSize then FPosition:=NewSize;
+end;
+
+
+constructor TStringStream.Create(const AString: string);
+
+begin
+ Inherited create;
+ FDataString:=AString;
+end;
+
+
+function TStringStream.Read(var Buffer; Count: Longint): Longint;
+
+begin
+ Result:=Length(FDataString)-FPosition;
+ If Result>Count then Result:=Count;
+ // This supposes FDataString to be of type AnsiString !
+ Move (Pchar(FDataString)[FPosition],Buffer,Result);
+ FPosition:=FPosition+Result;
+end;
+
+
+function TStringStream.ReadString(Count: Longint): string;
+
+Var NewLen : Longint;
+
+begin
+ NewLen:=Length(FDataString)-FPosition;
+ If NewLen>Count then NewLen:=Count;
+ SetLength(Result,NewLen);
+ Read (Pointer(Result)^,NewLen);
+end;
+
+
+function TStringStream.Seek(Offset: Longint; Origin: Word): Longint;
+
+begin
+ Case Origin of
+ soFromBeginning : FPosition:=Offset;
+ soFromEnd : FPosition:=Length(FDataString)+Offset;
+ soFromCurrent : FpoSition:=FPosition+Offset;
+ end;
+ If FPosition>Length(FDataString) then FPosition:=Length(FDataString);
+ If FPosition<0 then FPosition:=0;
+ Result:=FPosition;
+end;
+
+
+function TStringStream.Write(const Buffer; Count: Longint): Longint;
+
+begin
+ Result:=Count;
+ SetSize(FPosition+Count);
+ // This supposes that FDataString is of type AnsiString)
+ Move (Buffer,PCHar(FDataString)[Fposition],Count);
+ FPosition:=FPosition+Count;
+end;
+
+
+procedure TStringStream.WriteString(const AString: string);
+
+begin
+ Write (PChar(Astring)[0],Length(AString));
+end;
+
+
+
+{****************************************************************************}
+{* TResourceStream *}
+{****************************************************************************}
+
+procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
+
+begin
+end;
+
+
+constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
+
+begin
+end;
+
+
+constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
+
+begin
+end;
+
+
+destructor TResourceStream.Destroy;
+
+begin
+end;
+
+
+function TResourceStream.Write(const Buffer; Count: Longint): Longint;
+
+begin
+ Write:=0;
+end;
+
+{****************************************************************************}
+{* TOwnerStream *}
+{****************************************************************************}
+
+constructor TOwnerStream.Create(ASource: TStream);
+begin
+ FSource:=ASource;
+end;
+
+destructor TOwnerStream.Destroy;
+begin
+ If FOwner then
+ FreeAndNil(FSource);
+ inherited Destroy;
+end;
+
+{
+ $Log: streams.inc,v $
+ Revision 1.9 2005/03/25 20:07:43 peter
+ * add const to 64bit seeks
+
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.7 2005/01/20 16:37:57 peter
+ * 1.0.x fix
+
+ Revision 1.6 2005/01/19 19:57:57 michael
+ + CustomMemoryStream.getsize overridden
+
+ Revision 1.5 2005/01/19 09:09:50 michael
+ * Patch from Peter to fix 64bit issue in tstream.seek()
+
+ Revision 1.4 2005/01/18 22:31:44 michael
+ + Patch from Mattias Gaertner to fix CopyFrom
+
+ Revision 1.3 2005/01/09 13:15:37 michael
+ + Added TOwnerStream
+
+ }
diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc
new file mode 100644
index 0000000000..efb8c6de76
--- /dev/null
+++ b/rtl/objpas/classes/stringl.inc
@@ -0,0 +1,1231 @@
+{
+ $Id: stringl.inc,v 1.11 2005/04/05 21:05:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TStrings *}
+{****************************************************************************}
+
+// Function to quote text. Should move maybe to sysutils !!
+// Also, it is not clear at this point what exactly should be done.
+
+{ //!! is used to mark unsupported things. }
+
+Function QuoteString (Const S : String; Quote : String) : String;
+Var
+ I,J : Integer;
+begin
+ J:=0;
+ Result:=S;
+ for i:=1to length(s) do
+ begin
+ inc(j);
+ if S[i]=Quote then
+ begin
+ System.Insert(Quote,Result,J);
+ inc(j);
+ end;
+ end;
+ Result:=Quote+Result+Quote;
+end;
+
+{
+ For compatibility we can't add a Constructor to TSTrings to initialize
+ the special characters. Therefore we add a routine which is called whenever
+ the special chars are needed.
+}
+
+Procedure Tstrings.CheckSpecialChars;
+
+begin
+ If Not FSpecialCharsInited then
+ begin
+ FQuoteChar:='"';
+ FDelimiter:=',';
+ FNameValueSeparator:='=';
+ FSpecialCharsInited:=true;
+ end;
+end;
+
+
+procedure TStrings.SetDelimiter(c:Char);
+begin
+ CheckSpecialChars;
+ FDelimiter:=c;
+end;
+
+
+procedure TStrings.SetQuoteChar(c:Char);
+begin
+ CheckSpecialChars;
+ FQuoteChar:=c;
+end;
+
+
+procedure TStrings.SetNameValueSeparator(c:Char);
+begin
+ CheckSpecialChars;
+ FNameValueSeparator:=c;
+end;
+
+
+function TStrings.GetCommaText: string;
+
+Var
+ C1,C2 : Char;
+
+begin
+ CheckSpecialChars;
+ C1:=Delimiter;
+ C2:=QuoteChar;
+ Delimiter:=',';
+ QuoteChar:='"';
+ Try
+ Result:=GetDelimitedText;
+ Finally
+ Delimiter:=C1;
+ QuoteChar:=C2;
+ end;
+end;
+
+
+Function TStrings.GetDelimitedText: string;
+
+Var
+ I : integer;
+ p : pchar;
+begin
+ CheckSpecialChars;
+ result:='';
+ For i:=0 to count-1 do
+ begin
+ p:=pchar(strings[i]);
+ while not(p^ in [#0..' ',QuoteChar,Delimiter]) do
+ inc(p);
+ if p^<>#0 then
+ Result:=Result+QuoteString (Strings[I],QuoteChar)
+ else
+ result:=result+strings[i];
+ if I<Count-1 then Result:=Result+Delimiter;
+ end;
+ If Length(Result)=0 then
+ Result:=QuoteChar+QuoteChar;
+end;
+
+procedure TStrings.GetNameValue(Index : Integer; Var AName,AValue : String);
+
+Var L : longint;
+
+begin
+ CheckSpecialChars;
+ AValue:=Strings[Index];
+ L:=Pos(FNameValueSeparator,AValue);
+ If L<>0 then
+ begin
+ AName:=Copy(AValue,1,L-1);
+ System.Delete(AValue,1,L);
+ end
+ else
+ AName:='';
+end;
+
+function TStrings.GetName(Index: Integer): string;
+
+Var
+ V : String;
+
+begin
+ GetNameValue(Index,Result,V);
+end;
+
+Function TStrings.GetValue(const Name: string): string;
+
+Var
+ L : longint;
+ N : String;
+
+begin
+ Result:='';
+ L:=IndexOfName(Name);
+ If L<>-1 then
+ GetNameValue(L,N,Result);
+end;
+
+Function TStrings.GetValueFromIndex(Index: Integer): string;
+
+Var
+ N : String;
+
+begin
+ GetNameValue(Index,N,Result);
+end;
+
+Procedure TStrings.SetValueFromIndex(Index: Integer; const Value: string);
+
+begin
+ If (Value='') then
+ Delete(Index)
+ else
+ begin
+ If (Index<0) then
+ Index:=Add('');
+ CheckSpecialChars;
+ Strings[Index]:=GetName(Index)+FNameValueSeparator+Value;
+ end;
+end;
+
+
+procedure TStrings.ReadData(Reader: TReader);
+begin
+ Reader.ReadListBegin;
+ BeginUpdate;
+ try
+ Clear;
+ while not Reader.EndOfList do
+ Add(Reader.ReadString);
+ finally
+ EndUpdate;
+ end;
+ Reader.ReadListEnd;
+end;
+
+Function GetQuotedString (Var P : Pchar; QuoteChar : Char) : AnsiString;
+
+Var P1,L : Pchar;
+ ReplaceQuotes : boolean;
+
+begin
+ Result:='';
+ ReplaceQuotes := False;
+ P1:=P+1;
+ While P1^<>#0 do
+ begin
+ If (P1^=QuoteCHar) then
+ begin
+ if (P1[1]<>QuoteChar) then
+ break;
+ inc(p1);
+ ReplaceQuotes := True;
+ end;
+ inc(p1);
+ end;
+ // P1 points to last quote, or to #0;
+ P:=P+1;
+ If P1-P>0 then
+ begin
+ SetLength(Result,(P1-P));
+ L:=Pointer(Result);
+ Move (P^,L^,P1-P);
+ P:=P1+1;
+ end;
+ if ReplaceQuotes then
+ result := StringReplace (result, QuoteChar+QuoteChar,QuoteChar, [rfReplaceAll]);
+end;
+
+Function GetNextQuotedChar (var P : PChar; Var S : String; Delim,Quote : Char): Boolean;
+
+Var PS,L : PChar;
+
+begin
+ Result:=False;
+ S:='';
+ While (p^<>#0) and (byte(p^)<=byte(' ')) do
+ inc(p);
+ If P^=#0 then exit;
+ PS:=P;
+ If P^=Quote then
+ begin
+ S:=GetQuotedString(P,Quote);
+ While (p^<>#0) and (byte(p^)<=byte(' ')) do
+ inc(p);
+ end
+ else
+ begin
+ While (p^>' ') and (P^<>Delim) do
+ inc(p);
+ Setlength (S,P-PS);
+ L:=Pointer(S);
+ Move (PS^,L^,P-PS);
+ end;
+ if p^=Delim then
+ inc(p);
+ Result:=True;
+end;
+
+Procedure TStrings.SetDelimitedText(const AValue: string);
+
+Var
+ P : PChar;
+ S : String;
+begin
+ CheckSpecialChars;
+ BeginUpdate;
+ try
+ Clear;
+ P:=PChar(AValue);
+ if assigned(p) then
+ begin
+ While GetNextQuotedChar (P,S,FDelimiter,FQuoteChar) do
+ Add (S);
+ end;
+ finally
+ EndUpdate;
+ end;
+end;
+
+Procedure TStrings.SetCommaText(const Value: string);
+
+Var
+ C1,C2 : Char;
+
+begin
+ CheckSpecialChars;
+ C1:=Delimiter;
+ C2:=QuoteChar;
+ Delimiter:=',';
+ QuoteChar:='"';
+ Try
+ SetDelimitedText(Value);
+ Finally
+ Delimiter:=C1;
+ QuoteChar:=C2;
+ end;
+end;
+
+
+Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
+
+begin
+end;
+
+
+
+Procedure TStrings.SetValue(const Name, Value: string);
+
+Var L : longint;
+
+begin
+ CheckSpecialChars;
+ L:=IndexOfName(Name);
+ if L=-1 then
+ Add (Name+FNameValueSeparator+Value)
+ else
+ Strings[L]:=Name+FNameValueSeparator+value;
+end;
+
+
+
+procedure TStrings.WriteData(Writer: TWriter);
+var
+ i: Integer;
+begin
+ Writer.WriteListBegin;
+ for i := 0 to Count - 1 do
+ Writer.WriteString(Strings[i]);
+ Writer.WriteListEnd;
+end;
+
+
+
+procedure TStrings.DefineProperties(Filer: TFiler);
+var
+ HasData: Boolean;
+begin
+ if Assigned(Filer.Ancestor) then
+ // Only serialize if string list is different from ancestor
+ if Filer.Ancestor.InheritsFrom(TStrings) then
+ HasData := not Equals(TStrings(Filer.Ancestor))
+ else
+ HasData := True
+ else
+ HasData := Count > 0;
+ Filer.DefineProperty('Strings', @ReadData, @WriteData, HasData);
+end;
+
+
+Procedure TStrings.Error(const Msg: string; Data: Integer);
+begin
+{$ifdef VER1_0}
+ Raise EStringListError.CreateFmt(Msg,[Data]) at longint(get_caller_addr(get_frame));
+{$else VER1_0}
+ Raise EStringListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
+{$endif VER1_0}
+end;
+
+
+Procedure TStrings.Error(const Msg: pstring; Data: Integer);
+begin
+{$ifdef VER1_0}
+ Raise EStringListError.CreateFmt(Msg^,[Data]) at longint(get_caller_addr(get_frame));
+{$else VER1_0}
+ Raise EStringListError.CreateFmt(Msg^,[Data]) at get_caller_addr(get_frame);
+{$endif VER1_0}
+end;
+
+
+Function TStrings.GetCapacity: Integer;
+
+begin
+ Result:=Count;
+end;
+
+
+
+Function TStrings.GetObject(Index: Integer): TObject;
+
+begin
+ Result:=Nil;
+end;
+
+
+
+Function TStrings.GetTextStr: string;
+
+Const
+{$ifdef Unix}
+ NewLineSize=1;
+{$else}
+ NewLineSize=2;
+{$endif}
+
+Var P : Pchar;
+ I,L : Longint;
+ S : String;
+
+begin
+ // Determine needed place
+ L:=0;
+ For I:=0 to count-1 do
+ L:=L+Length(Strings[I])+NewLineSize;
+ Setlength(Result,L);
+ P:=Pointer(Result);
+ For i:=0 To count-1 do
+ begin
+ S:=Strings[I];
+ L:=Length(S);
+ if L<>0 then
+ System.Move(Pointer(S)^,P^,L);
+ P:=P+L;
+{$ifndef Unix}
+ p[0]:=#13;
+ p[1]:=#10;
+{$else}
+ p[0]:=#10;
+{$endif}
+ P:=P+NewLineSize;
+ end;
+end;
+
+
+
+Procedure TStrings.Put(Index: Integer; const S: string);
+
+Var Obj : TObject;
+
+begin
+ Obj:=Objects[Index];
+ Delete(Index);
+ InsertObject(Index,S,Obj);
+end;
+
+
+
+Procedure TStrings.PutObject(Index: Integer; AObject: TObject);
+
+begin
+ // Empty.
+end;
+
+
+
+Procedure TStrings.SetCapacity(NewCapacity: Integer);
+
+begin
+ // Empty.
+end;
+
+
+Procedure TStrings.SetTextStr(const Value: string);
+
+begin
+ SetText(PChar(Value));
+end;
+
+
+
+Procedure TStrings.SetUpdateState(Updating: Boolean);
+
+begin
+end;
+
+
+
+destructor TSTrings.Destroy;
+
+begin
+ inherited destroy;
+end;
+
+
+
+Function TStrings.Add(const S: string): Integer;
+
+begin
+ Result:=Count;
+ Insert (Count,S);
+end;
+
+
+
+Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
+
+begin
+ Result:=Add(S);
+ Objects[result]:=AObject;
+end;
+
+
+
+Procedure TStrings.Append(const S: string);
+
+begin
+ Add (S);
+end;
+
+
+
+Procedure TStrings.AddStrings(TheStrings: TStrings);
+
+Var Runner : longint;
+
+begin
+ try
+ beginupdate;
+ For Runner:=0 to TheStrings.Count-1 do
+ self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
+ finally
+ EndUpdate;
+ end;
+end;
+
+
+
+Procedure TStrings.Assign(Source: TPersistent);
+
+begin
+ Try
+ BeginUpdate;
+ If Source is TStrings then
+ begin
+ clear;
+ AddStrings(TStrings(Source));
+ exit;
+ end;
+ Inherited Assign(Source);
+ finally
+ EndUpdate;
+ end;
+end;
+
+
+
+Procedure TStrings.BeginUpdate;
+
+begin
+ inc(FUpdateCount);
+ if FUpdateCount = 1 then SetUpdateState(true);
+end;
+
+
+
+Procedure TStrings.EndUpdate;
+
+begin
+ If FUpdateCount>0 then
+ Dec(FUpdateCount);
+ if FUpdateCount=0 then
+ SetUpdateState(False);
+end;
+
+
+
+Function TStrings.Equals(TheStrings: TStrings): Boolean;
+
+Var Runner,Nr : Longint;
+
+begin
+ Result:=False;
+ Nr:=Self.Count;
+ if Nr<>TheStrings.Count then exit;
+ For Runner:=0 to Nr-1 do
+ If Strings[Runner]<>TheStrings[Runner] then exit;
+ Result:=True;
+end;
+
+
+
+Procedure TStrings.Exchange(Index1, Index2: Integer);
+
+Var
+ Obj : TObject;
+ Str : String;
+
+begin
+ Try
+ beginUpdate;
+ Obj:=Objects[Index1];
+ Str:=Strings[Index1];
+ Objects[Index1]:=Objects[Index2];
+ Strings[Index1]:=Strings[Index2];
+ Objects[Index2]:=Obj;
+ Strings[Index2]:=Str;
+ finally
+ EndUpdate;
+ end;
+end;
+
+
+
+Function TStrings.GetText: PChar;
+begin
+ Result:=StrNew(Pchar(Self.Text));
+end;
+
+
+Function TStrings.DoCompareText(const s1,s2 : string) : PtrInt;
+ begin
+ result:=CompareText(s1,s2);
+ end;
+
+
+Function TStrings.IndexOf(const S: string): Integer;
+begin
+ Result:=0;
+ While (Result<Count) and (DoCompareText(Strings[Result],S)<>0) do Result:=Result+1;
+ if Result=Count then Result:=-1;
+end;
+
+
+Function TStrings.IndexOfName(const Name: string): Integer;
+Var
+ len : longint;
+ S : String;
+begin
+ CheckSpecialChars;
+ Result:=0;
+ while (Result<Count) do
+ begin
+ S:=Strings[Result];
+ len:=pos(FNameValueSeparator,S)-1;
+ if (len>0) and (DoCompareText(Name,Copy(S,1,Len))=0) then
+ exit;
+ inc(result);
+ end;
+ result:=-1;
+end;
+
+
+Function TStrings.IndexOfObject(AObject: TObject): Integer;
+begin
+ Result:=0;
+ While (Result<count) and (Objects[Result]<>AObject) do Result:=Result+1;
+ If Result=Count then Result:=-1;
+end;
+
+
+Procedure TStrings.InsertObject(Index: Integer; const S: string;
+ AObject: TObject);
+
+begin
+ Insert (Index,S);
+ Objects[Index]:=AObject;
+end;
+
+
+
+Procedure TStrings.LoadFromFile(const FileName: string);
+Var
+ TheStream : TFileStream;
+begin
+ TheStream:=TFileStream.Create(FileName,fmOpenRead);
+ LoadFromStream(TheStream);
+ TheStream.Free;
+end;
+
+
+
+Procedure TStrings.LoadFromStream(Stream: TStream);
+{
+ Borlands method is no good, since a pipe for
+ instance doesn't have a size.
+ So we must do it the hard way.
+}
+Const
+ BufSize = 1024;
+ MaxGrow = 1 shl 29;
+
+Var
+ Buffer : Pointer;
+ BytesRead,
+ BufLen,
+ I,BufDelta : Longint;
+begin
+ // reread into a buffer
+ try
+ beginupdate;
+ Buffer:=Nil;
+ BufLen:=0;
+ I:=1;
+ Repeat
+ BufDelta:=BufSize*I;
+ ReAllocMem(Buffer,BufLen+BufDelta);
+ BytesRead:=Stream.Read((Buffer+BufLen)^,BufDelta);
+ inc(BufLen,BufDelta);
+ If I<MaxGrow then
+ I:=I shl 1;
+ Until BytesRead<>BufDelta;
+ // Null-terminate !!
+ Pchar(Buffer)[BufLen-BufDelta+BytesRead]:=#0;
+ Text:=PChar(Buffer);
+ FreeMem(Buffer);
+ finally
+ EndUpdate;
+ end;
+end;
+
+
+Procedure TStrings.Move(CurIndex, NewIndex: Integer);
+Var
+ Obj : TObject;
+ Str : String;
+begin
+ BeginUpdate;
+ Obj:=Objects[CurIndex];
+ Str:=Strings[CurIndex];
+ Delete(Curindex);
+ InsertObject(NewIndex,Str,Obj);
+ EndUpdate;
+end;
+
+
+
+Procedure TStrings.SaveToFile(const FileName: string);
+
+Var TheStream : TFileStream;
+
+begin
+ TheStream:=TFileStream.Create(FileName,fmCreate);
+ SaveToStream(TheStream);
+ TheStream.Free;
+end;
+
+
+
+Procedure TStrings.SaveToStream(Stream: TStream);
+Var
+ S : String;
+begin
+ S:=Text;
+ Stream.Write(Pointer(S)^,Length(S));
+end;
+
+
+Function GetNextLine (Var P : Pchar; Var S : String) : Boolean;
+
+Var PS : PChar;
+
+begin
+ S:='';
+ Result:=False;
+ If P^=#0 then exit;
+ PS:=P;
+ While not (P^ in [#0,#10,#13]) do P:=P+1;
+ SetLength (S,P-PS);
+ System.Move (PS^,Pointer(S)^,P-PS);
+ If P^=#13 then P:=P+1;
+ If P^=#10 then
+ P:=P+1; // Point to character after #10(#13)
+ Result:=True;
+end;
+
+
+Procedure TStrings.SetText(TheText: PChar);
+
+Var S : String;
+
+begin
+ Try
+ beginUpdate;
+ Clear;
+ While GetNextLine (TheText,S) do
+ Add(S);
+ finally
+ EndUpdate;
+ end;
+end;
+
+
+{****************************************************************************}
+{* TStringList *}
+{****************************************************************************}
+
+
+
+Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
+
+Var P1,P2 : Pointer;
+
+begin
+ P1:=Pointer(Flist^[Index1].FString);
+ P2:=Pointer(Flist^[Index1].FObject);
+ Pointer(Flist^[Index1].Fstring):=Pointer(Flist^[Index2].Fstring);
+ Pointer(Flist^[Index1].FObject):=Pointer(Flist^[Index2].FObject);
+ Pointer(Flist^[Index2].Fstring):=P1;
+ Pointer(Flist^[Index2].FObject):=P2;
+end;
+
+
+
+Procedure TStringList.Grow;
+
+Var Extra : Longint;
+
+begin
+ If FCapacity>64 then
+ Extra:=FCapacity Div 4
+ Else If FCapacity>8 Then
+ Extra:=16
+ Else
+ Extra:=4;
+ SetCapacity(FCapacity+Extra);
+end;
+
+
+
+Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
+
+Var I,J, Pivot : Longint;
+
+begin
+ Repeat
+ I:=L;
+ J:=R;
+ Pivot:=(L+R) div 2;
+ Repeat
+ While CompareFn(Self, I, Pivot)<0 do Inc(I);
+ While CompareFn(Self, J, Pivot)>0 do Dec(J);
+ If I<=J then
+ begin
+ ExchangeItems(I,J); // No check, indices are correct.
+ if Pivot=I then
+ Pivot:=J
+ else if Pivot=J then
+ Pivot := I;
+ Inc(I);
+ Dec(j);
+ end;
+ until I>J;
+ If L<J then QuickSort(L,J, CompareFn);
+ L:=I;
+ Until I>=R;
+end;
+
+
+Procedure TStringList.InsertItem(Index: Integer; const S: string);
+begin
+ Changing;
+ If FCount=Fcapacity then Grow;
+ If Index<FCount then
+ System.Move (FList^[Index],FList^[Index+1],
+ (FCount-Index)*SizeOf(TStringItem));
+ Pointer(Flist^[Index].Fstring):=Nil; // Needed to initialize...
+ Flist^[Index].FString:=S;
+ Flist^[Index].Fobject:=Nil;
+ Inc(FCount);
+ Changed;
+end;
+
+
+Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
+begin
+ Changing;
+ If FCount=Fcapacity then Grow;
+ If Index<FCount then
+ System.Move (FList^[Index],FList^[Index+1],
+ (FCount-Index)*SizeOf(TStringItem));
+ Pointer(Flist^[Index].Fstring):=Nil; // Needed to initialize...
+ Flist^[Index].FString:=S;
+ Flist^[Index].FObject:=O;
+ Inc(FCount);
+ Changed;
+end;
+
+
+Procedure TStringList.SetSorted(Value: Boolean);
+
+begin
+ If FSorted<>Value then
+ begin
+ If Value then sort;
+ FSorted:=VAlue
+ end;
+end;
+
+
+
+Procedure TStringList.Changed;
+
+begin
+ If (FUpdateCount=0) Then
+ If Assigned(FOnChange) then
+ FOnchange(Self);
+end;
+
+
+
+Procedure TStringList.Changing;
+
+begin
+ If FUpdateCount=0 then
+ if Assigned(FOnChanging) then
+ FOnchanging(Self);
+end;
+
+
+
+Function TStringList.Get(Index: Integer): string;
+
+begin
+ If (Index<0) or (INdex>=Fcount) then
+ Error (SListIndexError,Index);
+ Result:=Flist^[Index].FString;
+end;
+
+
+
+Function TStringList.GetCapacity: Integer;
+
+begin
+ Result:=FCapacity;
+end;
+
+
+
+Function TStringList.GetCount: Integer;
+
+begin
+ Result:=FCount;
+end;
+
+
+
+Function TStringList.GetObject(Index: Integer): TObject;
+
+begin
+ If (Index<0) or (INdex>=Fcount) then
+ Error (SListIndexError,Index);
+ Result:=Flist^[Index].FObject;
+end;
+
+
+
+Procedure TStringList.Put(Index: Integer; const S: string);
+
+begin
+ If Sorted then
+ Error(SSortedListError,0);
+ If (Index<0) or (INdex>=Fcount) then
+ Error (SListIndexError,Index);
+ Changing;
+ Flist^[Index].FString:=S;
+ Changed;
+end;
+
+
+
+Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
+
+begin
+ If (Index<0) or (INdex>=Fcount) then
+ Error (SListIndexError,Index);
+ Changing;
+ Flist^[Index].FObject:=AObject;
+ Changed;
+end;
+
+
+
+Procedure TStringList.SetCapacity(NewCapacity: Integer);
+
+Var NewList : Pointer;
+ MSize : Longint;
+
+begin
+ If (NewCapacity<0) then
+ Error (SListCapacityError,NewCapacity);
+ If NewCapacity>FCapacity then
+ begin
+ GetMem (NewList,NewCapacity*SizeOf(TStringItem));
+ If NewList=Nil then
+ Error (SListCapacityError,NewCapacity);
+ If Assigned(FList) then
+ begin
+ MSize:=FCapacity*Sizeof(TStringItem);
+ System.Move (FList^,NewList^,MSize);
+ FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
+ FreeMem (Flist,MSize);
+ end;
+ Flist:=NewList;
+ FCapacity:=NewCapacity;
+ end
+ else if NewCapacity<FCapacity then
+ begin
+ if NewCapacity = 0 then
+ begin
+ FreeMem(FList);
+ FList := nil;
+ end else
+ begin
+ GetMem(NewList, NewCapacity * SizeOf(TStringItem));
+ System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
+ FreeMem(FList);
+ FList := NewList;
+ end;
+ FCapacity:=NewCapacity;
+ end;
+end;
+
+
+
+Procedure TStringList.SetUpdateState(Updating: Boolean);
+
+begin
+ If Updating then
+ Changing
+ else
+ Changed
+end;
+
+
+
+destructor TStringList.Destroy;
+
+Var I : Longint;
+
+begin
+ FOnChange:=Nil;
+ FOnChanging:=Nil;
+ // This will force a dereference. Can be done better...
+ For I:=0 to FCount-1 do
+ FList^[I].FString:='';
+ FCount:=0;
+ SetCapacity(0);
+ Inherited destroy;
+end;
+
+
+
+Function TStringList.Add(const S: string): Integer;
+
+begin
+ If Not Sorted then
+ Result:=FCount
+ else
+ If Find (S,Result) then
+ Case DUplicates of
+ DupIgnore : Exit;
+ DupError : Error(SDuplicateString,0)
+ end;
+ InsertItem (Result,S);
+end;
+
+
+
+Procedure TStringList.Clear;
+
+Var I : longint;
+
+begin
+ if FCount = 0 then Exit;
+ Changing;
+ For I:=0 to FCount-1 do
+ Flist^[I].FString:='';
+ FCount:=0;
+ SetCapacity(0);
+ Changed;
+end;
+
+
+
+Procedure TStringList.Delete(Index: Integer);
+
+begin
+ If (Index<0) or (Index>=FCount) then
+ Error(SlistINdexError,Index);
+ Changing;
+ Flist^[Index].FString:='';
+ Dec(FCount);
+ If Index<FCount then
+ System.Move(Flist^[Index+1],
+ Flist^[Index],
+ (Fcount-Index)*SizeOf(TStringItem));
+ Changed;
+end;
+
+
+
+Procedure TStringList.Exchange(Index1, Index2: Integer);
+
+begin
+ If (Index1<0) or (Index1>=FCount) then
+ Error(SListIndexError,Index1);
+ If (Index2<0) or (Index2>=FCount) then
+ Error(SListIndexError,Index2);
+ Changing;
+ ExchangeItems(Index1,Index2);
+ changed;
+end;
+
+
+procedure TStringList.SetCaseSensitive(b : boolean);
+ begin
+ if b<>FCaseSensitive then
+ begin
+ FCaseSensitive:=b;
+ if FSorted then
+ sort;
+ end;
+ end;
+
+
+Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt;
+ begin
+ if FCaseSensitive then
+ result:=AnsiCompareStr(s1,s2)
+ else
+ result:=AnsiCompareText(s1,s2);
+ end;
+
+
+Function TStringList.Find(const S: string; var Index: Integer): Boolean;
+
+{ Searches for the first string <= S, returns True if exact match,
+ sets index to the index f the found string. }
+
+Var I,L,R,Temp : Longint;
+
+begin
+ Result:=False;
+ // Use binary search.
+ L:=0;
+ R:=FCount-1;
+ While L<=R do
+ begin
+ I:=(L+R) div 2;
+ Temp:=DoCompareText(FList^ [I].FString,S);
+ If Temp<0 then
+ L:=I+1
+ else
+ begin
+ R:=I-1;
+ If Temp=0 then
+ begin
+ Result:=True;
+ If Duplicates<>DupAccept then L:=I;
+ end;
+ end;
+ end;
+ Index:=L;
+end;
+
+
+
+Function TStringList.IndexOf(const S: string): Integer;
+
+begin
+ If Not Sorted then
+ Result:=Inherited indexOf(S)
+ else
+ // faster using binary search...
+ If Not Find (S,Result) then
+ Result:=-1;
+end;
+
+
+
+Procedure TStringList.Insert(Index: Integer; const S: string);
+
+begin
+ If Sorted then
+ Error (SSortedListError,0)
+ else
+ If (Index<0) or (Index>FCount) then
+ Error (SListIndexError,Index)
+ else
+ InsertItem (Index,S);
+end;
+
+
+Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
+
+begin
+ If Not Sorted and (FCount>1) then
+ begin
+ Changing;
+ QuickSort(0,FCount-1, CompareFn);
+ Changed;
+ end;
+end;
+
+function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;
+
+begin
+ Result := List.DoCompareText(List.FList^[Index1].FString,
+ List.FList^[Index].FString);
+end;
+
+Procedure TStringList.Sort;
+
+begin
+ CustomSort(@StringListAnsiCompare);
+end;
+
+
+
+{
+ $Log: stringl.inc,v $
+ Revision 1.11 2005/04/05 21:05:31 peter
+ * call initspecialchars if one of the specialchars is configured
+ for the first time
+
+ Revision 1.10 2005/03/10 22:54:01 michael
+ + Patch from Marc Weustinc to init special chars
+
+ Revision 1.9 2005/03/07 17:25:46 peter
+ * use separate boolean to initialize specialchars
+
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.7 2005/02/05 22:03:49 michael
+ + Implemented DelimitedText, FDelimiter etc.
+
+ Revision 1.6 2005/02/03 20:11:06 florian
+ + added case sensitivity to tstringlist
+
+ Revision 1.5 2005/02/03 18:42:42 florian
+ * some delphi compatibility fixes
+
+ Revision 1.4 2005/02/01 21:49:05 florian
+ + tstrings.error for resourcestrings added which are a pstring
+
+}
diff --git a/rtl/objpas/classes/twriter.inc b/rtl/objpas/classes/twriter.inc
new file mode 100644
index 0000000000..08c65a1190
--- /dev/null
+++ b/rtl/objpas/classes/twriter.inc
@@ -0,0 +1,221 @@
+{
+ $Id: twriter.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+(*Procedure TTextWriter.WriteLn(Const Msg : String);
+
+Const CRLF = #10;
+
+begin
+ Write(Msg+CRLF);
+end;
+
+Procedure TTextWriter.Write(Const Msg : String);
+
+Var S : String;
+
+begin
+ S:=FPrefix+Msg;
+ FStream.Write(Pointer(S)^,Length(S));
+end;
+
+
+Procedure TTextWriter.WriteFmt(Fmt : String; Args : Array of const);
+
+begin
+ Writeln(Format(Fmt,Args));
+end;
+
+Procedure TTextWriter.StartObject(Const AClassName, AName : String);
+
+begin
+ WriteFmt('Object %s %s',[AName,AClassName]);
+ FPrefix:=FPrefix+' ';
+end;
+
+Procedure TTextWriter.EndObject;
+
+Var L : longint;
+
+begin
+ L:=Length(FPrefix);
+ If L>2 Then
+ SetLength(FPrefix,L-2);
+ Writeln('end');
+end;
+
+Procedure TTextWriter.StartCollection(Const AName : String);
+
+begin
+ WriteFmt('%s = (',[AName]);
+ FPrefix:=FPrefix+' ';
+end;
+
+Procedure TTextWriter.StartCollectionItem;
+
+begin
+end;
+
+Procedure TTextWriter.EndCollectionItem;
+
+begin
+end;
+
+Procedure TTextWriter.EndCollection;
+
+Var L : longint;
+
+begin
+ L:=Length(FPrefix);
+ If L>2 Then
+ SetLength(FPrefix,L-2);
+ Writeln(')');
+end;
+
+
+Procedure TTextWriter.WritePropName(const PropName: string);
+
+begin
+ Writeln(PropName);
+end;
+
+Constructor TTextWriter.Create(S : TStream);
+
+begin
+ Inherited Create;
+ FStream:=S;
+ FPrefix:='';
+end;
+
+Destructor TTextWriter.Destroy;
+
+begin
+end;
+
+Procedure TTextWriter.WriteIntegerProperty(Const Name : Shortstring;Value : Longint);
+
+begin
+ WriteFmt('%s = %d',[Name,Value]);
+end;
+
+Procedure TTextWriter.WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);
+
+begin
+ //!! needs implementing.
+ WriteFmt('%s = []',[Name]);
+end;
+
+Procedure TTextWriter.WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);
+
+begin
+ WriteFmt('%s = %s',[Name,EnumName])
+end;
+
+Procedure TTextWriter.WriteStringProperty(Const Name : ShortString; Const Value : String);
+
+Type
+ TMode = (quoted,unquoted);
+
+Var
+ Mode : TMode;
+ S : String;
+ I,L : Longint;
+ c : char;
+
+ Procedure Add (A : String);
+
+ begin
+ S:=S+A;
+ end;
+
+begin
+ L:=Length(Value);
+ Mode:=unquoted;
+ S:=Name+' = ';
+ For I:=1 to L do
+ begin
+ C:=Value[i];
+ If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
+ begin
+ If mode=Quoted then
+ Add(c)
+ else
+ begin
+ Add(''''+c);
+ mode:=quoted
+ end
+ end
+ else
+ begin
+ If Mode=quoted then
+ begin
+ Add('''');
+ mode:=unquoted;
+ end;
+ Add(Format('#%d',[ord(c)]));
+ end;
+ If Length(S)>72 then
+ begin
+ if mode=quoted then
+ Add ('''');
+ Add('+');
+ Writeln(S);
+ Mode:=unQuoted;
+ end;
+ end;
+ if mode=quoted then Add('''');
+ Writeln(S);
+end;
+
+Procedure TTextWriter.WriteFloatProperty(Const Name : ShortString; Value : Extended);
+
+begin
+ WriteFmt('%s = %e',[Name,Value])
+end;
+
+Procedure TTextWriter.WriteCollectionProperty(Const Name : ShortString;Value : TCollection);
+
+begin
+
+end;
+
+Procedure TTextWriter.WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);
+
+begin
+end;
+
+Procedure TTextWriter.WriteComponentProperty(Const Name : ShortSTring; Value : TComponent);
+
+begin
+ WriteFmt ('%s = %s',[Name,Value.Name]);
+end;
+
+Procedure TTextWriter.WriteNilProperty(Const Name : Shortstring);
+
+begin
+ system.Writeln(stderr,'Nil : ',Name);
+ WriteFmt ('%s = Nil',[Name])
+end;
+
+Procedure TTextWriter.WriteMethodProperty(Const Name,AMethodName : ShortString);
+
+begin
+ WriteFmt ('%s = %s',[Name,AMethodName]);
+end;*)
+
+{
+ $Log: twriter.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/classes/util.inc b/rtl/objpas/classes/util.inc
new file mode 100644
index 0000000000..eb90028f3c
--- /dev/null
+++ b/rtl/objpas/classes/util.inc
@@ -0,0 +1,88 @@
+{
+ $Id: util.inc,v 1.4 2005/04/14 17:43:53 michael Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function IntToStr (I : Longint) : String;
+
+begin
+ Str(I,Result);
+end;
+
+function IsValidIdent(const Ident: string): Boolean;
+
+begin
+ Result:=True;
+end;
+
+
+procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
+Const
+ HexDigits='0123456789ABCDEF';
+var
+ i : longint;
+begin
+ for i:=0 to binbufsize-1 do
+ begin
+ HexValue[0]:=hexdigits[1+((ord(binvalue^) shr 4))];
+ HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
+ inc(hexvalue,2);
+ inc(binvalue);
+ end;
+end;
+
+
+function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
+// more complex, have to accept more than bintohex
+// A..F 1000001
+// a..f 1100001
+// 0..9 110000
+var i,j,h,l : integer;
+
+begin
+ i:=binbufsize;
+ while (i>0) do
+ begin
+ if hexvalue^ IN ['A'..'F','a'..'f'] then
+ h:=((ord(hexvalue^)+9) and 15)
+ else if hexvalue^ IN ['0'..'9'] then
+ h:=((ord(hexvalue^)) and 15)
+ else
+ break;
+ inc(hexvalue);
+ if hexvalue^ IN ['A'..'F','a'..'f'] then
+ l:=(ord(hexvalue^)+9) and 15
+ else if hexvalue^ IN ['0'..'9'] then
+ l:=(ord(hexvalue^)) and 15
+ else
+ break;
+ j := l + (h shl 4);
+ inc(hexvalue);
+ binvalue^:=chr(j);
+ inc(binvalue);
+ dec(i);
+ end;
+ result:=binbufsize-i;
+end;
+
+{
+ $Log: util.inc,v $
+ Revision 1.4 2005/04/14 17:43:53 michael
+ + Fix for BintoHex and hextobin by Uberto Barbini
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/03 20:17:05 florian
+ + BinToHex and HexToBin from Marco added
+
+}
diff --git a/rtl/objpas/classes/writer.inc b/rtl/objpas/classes/writer.inc
new file mode 100644
index 0000000000..ea3956d1e7
--- /dev/null
+++ b/rtl/objpas/classes/writer.inc
@@ -0,0 +1,892 @@
+{
+ $Id: writer.inc,v 1.11 2005/04/15 07:21:09 michael Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************}
+{* TBinaryObjectWriter *}
+{****************************************************************************}
+
+constructor TBinaryObjectWriter.Create(Stream: TStream; BufSize: Integer);
+begin
+ inherited Create;
+ If (Stream=Nil) then
+ Raise EWriteError.Create(SEmptyStreamIllegalWriter);
+ FStream := Stream;
+ FBufSize := BufSize;
+ GetMem(FBuffer, BufSize);
+end;
+
+destructor TBinaryObjectWriter.Destroy;
+begin
+ // Flush all data which hasn't been written yet
+ FlushBuffer;
+
+ if Assigned(FBuffer) then
+ FreeMem(FBuffer, FBufSize);
+
+ inherited Destroy;
+end;
+
+procedure TBinaryObjectWriter.BeginCollection;
+begin
+ WriteValue(vaCollection);
+end;
+
+procedure TBinaryObjectWriter.BeginComponent(Component: TComponent;
+ Flags: TFilerFlags; ChildPos: Integer);
+var
+ Prefix: Byte;
+begin
+ if not FSignatureWritten then
+ begin
+ Write(FilerSignature, SizeOf(FilerSignature));
+ FSignatureWritten := True;
+ end;
+
+ { Only write the flags if they are needed! }
+ if Flags <> [] then
+ begin
+ Prefix := Integer(Flags) or $f0;
+ Write(Prefix, 1);
+ if ffChildPos in Flags then
+ WriteInteger(ChildPos);
+ end;
+
+ WriteStr(Component.ClassName);
+ WriteStr(Component.Name);
+end;
+
+procedure TBinaryObjectWriter.BeginList;
+begin
+ WriteValue(vaList);
+end;
+
+procedure TBinaryObjectWriter.EndList;
+begin
+ WriteValue(vaNull);
+end;
+
+procedure TBinaryObjectWriter.BeginProperty(const PropName: String);
+begin
+ WriteStr(PropName);
+end;
+
+procedure TBinaryObjectWriter.EndProperty;
+begin
+end;
+
+procedure TBinaryObjectWriter.WriteBinary(const Buffer; Count: LongInt);
+begin
+ WriteValue(vaBinary);
+ Write(Count, 4);
+ Write(Buffer, Count);
+end;
+
+procedure TBinaryObjectWriter.WriteBoolean(Value: Boolean);
+begin
+ if Value then
+ WriteValue(vaTrue)
+ else
+ WriteValue(vaFalse);
+end;
+
+procedure TBinaryObjectWriter.WriteFloat(const Value: Extended);
+begin
+ WriteValue(vaExtended);
+ Write(Value, SizeOf(Value));
+end;
+
+procedure TBinaryObjectWriter.WriteSingle(const Value: Single);
+begin
+ WriteValue(vaSingle);
+ Write(Value, SizeOf(Value));
+end;
+
+{$ifdef HASCURRENCY}
+procedure TBinaryObjectWriter.WriteCurrency(const Value: Currency);
+begin
+ WriteValue(vaCurrency);
+ Write(Value, SizeOf(Value));
+end;
+{$endif HASCURRENCY}
+
+
+procedure TBinaryObjectWriter.WriteDate(const Value: TDateTime);
+begin
+ WriteValue(vaDate);
+ Write(Value, SizeOf(Value));
+end;
+
+procedure TBinaryObjectWriter.WriteIdent(const Ident: string);
+begin
+ { Check if Ident is a special identifier before trying to just write
+ Ident directly }
+ if UpperCase(Ident) = 'NIL' then
+ WriteValue(vaNil)
+ else if UpperCase(Ident) = 'FALSE' then
+ WriteValue(vaFalse)
+ else if UpperCase(Ident) = 'TRUE' then
+ WriteValue(vaTrue)
+ else if UpperCase(Ident) = 'NULL' then
+ WriteValue(vaNull) else
+ begin
+ WriteValue(vaIdent);
+ WriteStr(Ident);
+ end;
+end;
+
+procedure TBinaryObjectWriter.WriteInteger(Value: Int64);
+begin
+ { Use the smallest possible integer type for the given value: }
+ if (Value >= -128) and (Value <= 127) then
+ begin
+ WriteValue(vaInt8);
+ Write(Value, 1);
+ end else if (Value >= -32768) and (Value <= 32767) then
+ begin
+ WriteValue(vaInt16);
+ Write(Value, 2);
+ end else if (Value >= -$80000000) and (Value <= $7fffffff) then
+ begin
+ WriteValue(vaInt32);
+ Write(Value, 4);
+ end else
+ begin
+ WriteValue(vaInt64);
+ Write(Value, 8);
+ end;
+end;
+
+procedure TBinaryObjectWriter.WriteMethodName(const Name: String);
+begin
+ if Length(Name) > 0 then
+ begin
+ WriteValue(vaIdent);
+ WriteStr(Name);
+ end else
+ WriteValue(vaNil);
+end;
+
+procedure TBinaryObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
+var
+ i: Integer;
+ Mask: LongInt;
+begin
+ WriteValue(vaSet);
+ Mask := 1;
+ for i := 0 to 31 do
+ begin
+ if (Value and Mask) <> 0 then
+ WriteStr(GetEnumName(PTypeInfo(SetType), i));
+ Mask := Mask shl 1;
+ end;
+ WriteStr('');
+end;
+
+procedure TBinaryObjectWriter.WriteString(const Value: String);
+var
+ i: Integer;
+begin
+ i := Length(Value);
+ if i <= 255 then
+ begin
+ WriteValue(vaString);
+ Write(i, 1);
+ end else
+ begin
+ WriteValue(vaLString);
+ Write(i, 4);
+ end;
+ if i > 0 then
+ Write(Value[1], i);
+end;
+
+{$ifdef HASWIDESTRING}
+procedure TBinaryObjectWriter.WriteWideString(const Value: WideString);
+var
+ i: Integer;
+begin
+ WriteValue(vaWString);
+ i := Length(Value);
+ Write(i, 4);
+ Write(Pointer(Value)^, i * 2);
+end;
+{$endif HASWIDESTRING}
+
+procedure TBinaryObjectWriter.FlushBuffer;
+begin
+ FStream.WriteBuffer(FBuffer^, FBufPos);
+ FBufPos := 0;
+end;
+
+procedure TBinaryObjectWriter.Write(const Buffer; Count: LongInt);
+var
+ CopyNow: LongInt;
+ SourceBuf: PChar;
+begin
+ SourceBuf:=@Buffer;
+ while Count > 0 do
+ begin
+ CopyNow := Count;
+ if CopyNow > FBufSize - FBufPos then
+ CopyNow := FBufSize - FBufPos;
+ Move(SourceBuf^, PChar(FBuffer)[FBufPos], CopyNow);
+ Dec(Count, CopyNow);
+ Inc(FBufPos, CopyNow);
+ inc(SourceBuf, CopyNow);
+ if FBufPos = FBufSize then
+ FlushBuffer;
+ end;
+end;
+
+procedure TBinaryObjectWriter.WriteValue(Value: TValueType);
+begin
+ Write(Value, 1);
+end;
+
+procedure TBinaryObjectWriter.WriteStr(const Value: String);
+var
+ i: Integer;
+begin
+ i := Length(Value);
+ if i > 255 then
+ i := 255;
+ Write(i, 1);
+ if i > 0 then
+ Write(Value[1], i);
+end;
+
+
+
+{****************************************************************************}
+{* TWriter *}
+{****************************************************************************}
+
+
+constructor TWriter.Create(ADriver: TAbstractObjectWriter);
+begin
+ inherited Create;
+ FDriver := ADriver;
+end;
+
+constructor TWriter.Create(Stream: TStream; BufSize: Integer);
+begin
+ inherited Create;
+ If (Stream=Nil) then
+ Raise EWriteError.Create(SEmptyStreamIllegalWriter);
+ FDriver := CreateDriver(Stream, BufSize);
+ FDestroyDriver := True;
+end;
+
+destructor TWriter.Destroy;
+begin
+ if FDestroyDriver then
+ FDriver.Free;
+ inherited Destroy;
+end;
+
+function TWriter.CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectWriter;
+begin
+ Result := TBinaryObjectWriter.Create(Stream, BufSize);
+end;
+
+// Used as argument for calls to TComponent.GetChildren:
+procedure TWriter.AddToAncestorList(Component: TComponent);
+begin
+ FAncestorList.Add(Component);
+end;
+
+procedure TWriter.DefineProperty(const Name: String;
+ ReadData: TReaderProc; AWriteData: TWriterProc; HasData: Boolean);
+begin
+ if HasData and Assigned(AWriteData) then
+ begin
+ // Write the property name and then the data itself
+ Driver.BeginProperty(FPropPath + Name);
+ AWriteData(Self);
+ Driver.EndProperty;
+ end;
+end;
+
+procedure TWriter.DefineBinaryProperty(const Name: String;
+ ReadData, AWriteData: TStreamProc; HasData: Boolean);
+begin
+ if HasData and Assigned(AWriteData) then
+ begin
+ // Write the property name and then the data itself
+ Driver.BeginProperty(FPropPath + Name);
+ WriteBinary(AWriteData);
+ Driver.EndProperty;
+ end;
+end;
+
+procedure TWriter.SetRoot(ARoot: TComponent);
+begin
+ inherited SetRoot(ARoot);
+ // Use the new root as lookup root too
+ FLookupRoot := ARoot;
+end;
+
+procedure TWriter.WriteBinary(AWriteData: TStreamProc);
+var
+ MemBuffer: TMemoryStream;
+ BufferSize: Longint;
+begin
+ { First write the binary data into a memory stream, then copy this buffered
+ stream into the writing destination. This is necessary as we have to know
+ the size of the binary data in advance (we're assuming that seeking within
+ the writer stream is not possible) }
+ MemBuffer := TMemoryStream.Create;
+ try
+ AWriteData(MemBuffer);
+ BufferSize := MemBuffer.Size;
+ Driver.WriteBinary(MemBuffer.Memory^, BufferSize);
+ finally
+ MemBuffer.Free;
+ end;
+end;
+
+procedure TWriter.WriteBoolean(Value: Boolean);
+begin
+ Driver.WriteBoolean(Value);
+end;
+
+procedure TWriter.WriteChar(Value: Char);
+begin
+ WriteString(Value);
+end;
+
+procedure TWriter.WriteCollection(Value: TCollection);
+var
+ i: Integer;
+begin
+ Driver.BeginCollection;
+ if Assigned(Value) then
+ for i := 0 to Value.Count - 1 do
+ begin
+ { Each collection item needs its own ListBegin/ListEnd tag, or else the
+ reader wouldn't be able to know where an item ends and where the next
+ one starts }
+ WriteListBegin;
+ WriteProperties(Value.Items[i]);
+ WriteListEnd;
+ end;
+ WriteListEnd;
+end;
+
+procedure TWriter.WriteComponent(Component: TComponent);
+var
+ SavedAncestor: TPersistent;
+ SavedRootAncestor, AncestorComponent, CurAncestor: TComponent;
+ i: Integer;
+ s: String;
+begin
+ SavedAncestor := Ancestor;
+ SavedRootAncestor := RootAncestor;
+
+ try
+ // The component has to know that it is being written now...
+ Include(Component.FComponentState, csWriting);
+
+ // Locate the component in the ancestor list, if necessary
+ if Assigned(FAncestorList) then
+ begin
+ Ancestor := nil;
+ s := UpperCase(Component.Name);
+ for i := 0 to FAncestorList.Count - 1 do
+ begin
+ CurAncestor := TComponent(FAncestorList[i]);
+ if UpperCase(CurAncestor.Name) = s then
+ begin
+ Ancestor := CurAncestor;
+ break;
+ end;
+ end;
+ end;
+
+ // Do we have to call the OnFindAncestor callback?
+ if Assigned(FOnFindAncestor) and
+ ((not Assigned(Ancestor)) or Ancestor.InheritsFrom(TComponent)) then
+ begin
+ AncestorComponent := TComponent(Ancestor);
+ FOnFindAncestor(Self, Component, Component.Name,
+ AncestorComponent, FRootAncestor);
+ Ancestor := AncestorComponent;
+ end;
+
+ // Finally write the component state
+ Component.WriteState(Self);
+
+ // The writing has been finished now...
+ Exclude(Component.FComponentState, csWriting);
+
+ finally
+ Ancestor := SavedAncestor;
+ FRootAncestor := SavedRootAncestor;
+ end;
+end;
+
+procedure TWriter.WriteComponentData(Instance: TComponent);
+var
+ SavedAncestorList: TList;
+ SavedRoot, SavedRootAncestor: TComponent;
+ SavedAncestorPos, SavedChildPos: Integer;
+ Flags: TFilerFlags;
+begin
+ // Determine the filer flags to store
+ if Assigned(Ancestor) and ((not (csInline in Instance.ComponentState)) or
+ ((csAncestor in Instance.ComponentState) and Assigned(FAncestorList))) then
+ Flags := [ffInherited]
+ else if csInline in Instance.ComponentState then
+ Flags := [ffInline]
+ else
+ Flags := [];
+
+ if Assigned(FAncestorList) and (FAncestorPos < FAncestorList.Count) and
+ ((not Assigned(Ancestor)) or
+ (TPersistent(FAncestorList[FAncestorPos]) <> Ancestor)) then
+ Include(Flags, ffChildPos);
+
+ Driver.BeginComponent(Instance, Flags, FChildPos);
+
+ if Assigned(FAncestorList) and (FAncestorPos < FAncestorList.Count) then
+ begin
+ if Assigned(Ancestor) then
+ Inc(FAncestorPos);
+ Inc(FChildPos);
+ end;
+
+ // Write property list
+ WriteProperties(Instance);
+ WriteListEnd;
+
+ // Write children list
+ SavedAncestorList := FAncestorList;
+ SavedAncestorPos := FAncestorPos;
+ SavedChildPos := FChildPos;
+ SavedRoot := FRoot;
+ SavedRootAncestor := FRootAncestor;
+ try
+ FAncestorList := nil;
+ FAncestorPos := 0;
+ FChildPos := 0;
+ if not IgnoreChildren then
+ try
+ // Set up the ancestor list if we have an ancestor
+ if FAncestor is TComponent then
+ begin
+ if csInline in TComponent(FAncestor).ComponentState then
+ FRootAncestor := TComponent(FAncestor);
+ FAncestorList := TList.Create;
+ TComponent(FAncestor).GetChildren(@AddToAncestorList, FRootAncestor);
+ end;
+
+ if csInline in Instance.ComponentState then
+ FRoot := Instance;
+
+ Instance.GetChildren(@WriteComponent, FRoot);
+
+ finally
+ FAncestorList.Free;
+ end;
+
+ finally
+ FAncestorList := SavedAncestorList;
+ FAncestorPos := SavedAncestorPos;
+ FChildPos := SavedChildPos;
+ FRoot := SavedRoot;
+ FRootAncestor := SavedRootAncestor;
+ end;
+
+ WriteListEnd;
+end;
+
+procedure TWriter.WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
+begin
+ FRoot := ARoot;
+ FAncestor := AAncestor;
+ FRootAncestor := AAncestor;
+ FLookupRoot := ARoot;
+
+ WriteComponent(ARoot);
+end;
+
+procedure TWriter.WriteFloat(const Value: Extended);
+begin
+ Driver.WriteFloat(Value);
+end;
+
+procedure TWriter.WriteSingle(const Value: Single);
+begin
+ Driver.WriteSingle(Value);
+end;
+
+{$ifdef HASCURRENCY}
+procedure TWriter.WriteCurrency(const Value: Currency);
+begin
+ Driver.WriteCurrency(Value);
+end;
+{$endif HASCURRENCY}
+
+procedure TWriter.WriteDate(const Value: TDateTime);
+begin
+ Driver.WriteDate(Value);
+end;
+
+procedure TWriter.WriteIdent(const Ident: string);
+begin
+ Driver.WriteIdent(Ident);
+end;
+
+procedure TWriter.WriteInteger(Value: LongInt);
+begin
+ Driver.WriteInteger(Value);
+end;
+
+procedure TWriter.WriteInteger(Value: Int64);
+begin
+ Driver.WriteInteger(Value);
+end;
+
+procedure TWriter.WriteListBegin;
+begin
+ Driver.BeginList;
+end;
+
+procedure TWriter.WriteListEnd;
+begin
+ Driver.EndList;
+end;
+
+procedure TWriter.WriteProperties(Instance: TPersistent);
+var
+ i, PropCount: Integer;
+ PropInfo: PPropInfo;
+ PropList: PPropList;
+begin
+ { First step: Write the properties given by the RTTI for Instance }
+ PropCount := GetTypeData(Instance.ClassInfo)^.PropCount;
+ if PropCount > 0 then
+ begin
+ GetMem(PropList, PropCount * SizeOf(PPropInfo));
+ try
+ GetPropInfos(Instance.ClassInfo, PropList);
+ for i := 0 to PropCount - 1 do
+ begin
+ PropInfo := PropList^[i];
+ if IsStoredProp(Instance, PropInfo) then
+ WriteProperty(Instance, PropInfo);
+ end;
+ finally
+ FreeMem(PropList);
+ end;
+ end;
+
+ { Second step: Give Instance the chance to write its own private data }
+ Instance.DefineProperties(Self);
+end;
+
+procedure TWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
+var
+ HasAncestor: Boolean;
+ PropType: PTypeInfo;
+ Value, DefValue: LongInt;
+ Ident: String;
+ IntToIdentFn: TIntToIdent;
+ FloatValue, DefFloatValue: Extended;
+ MethodValue: TMethod;
+ DefMethodCodeValue: Pointer;
+{$ifdef HASWIDESTRING}
+ WStrValue, WDefStrValue: WideString;
+{$endif}
+ StrValue, DefStrValue: String;
+ AncestorObj: TObject;
+ Component: TComponent;
+ ObjValue: TObject;
+ SavedAncestor: TPersistent;
+ SavedPropPath, Name: String;
+ Int64Value, DefInt64Value: Int64;
+ BoolValue, DefBoolValue: boolean;
+ Handled: Boolean;
+
+begin
+
+ if (not Assigned(PPropInfo(PropInfo)^.SetProc)) or
+ (not Assigned(PPropInfo(PropInfo)^.GetProc)) then
+ exit;
+
+ { Check if the ancestor can be used }
+ HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
+ (Instance.ClassType = Ancestor.ClassType));
+
+ PropType := PPropInfo(PropInfo)^.PropType;
+ case PropType^.Kind of
+ tkInteger, tkChar, tkEnumeration, tkSet:
+ begin
+ Value := GetOrdProp(Instance, PropInfo);
+ if HasAncestor then
+ DefValue := GetOrdProp(Ancestor, PropInfo)
+ else
+ DefValue := PPropInfo(PropInfo)^.Default;
+
+ if Value <> DefValue then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ case PropType^.Kind of
+ tkInteger:
+ begin
+ // Check if this integer has a string identifier
+ IntToIdentFn := FindIntToIdent(PPropInfo(PropInfo)^.PropType);
+ if Assigned(IntToIdentFn) and IntToIdentFn(Value, Ident) then
+ // Integer can be written a human-readable identifier
+ WriteIdent(Ident)
+ else
+ // Integer has to be written just as number
+ WriteInteger(Value);
+ end;
+ tkChar:
+ WriteChar(Chr(Value));
+ tkSet:
+ Driver.WriteSet(Value, GetTypeData(PropType)^.CompType);
+ tkEnumeration:
+ WriteIdent(GetEnumName(PropType, Value));
+ end;
+ Driver.EndProperty;
+ end;
+ end;
+ tkFloat:
+ begin
+ FloatValue := GetFloatProp(Instance, PropInfo);
+ if HasAncestor then
+ DefFloatValue := GetFloatProp(Ancestor, PropInfo)
+ else
+ DefFloatValue := 0;
+ if FloatValue <> DefFloatValue then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ WriteFloat(FloatValue);
+ Driver.EndProperty;
+ end;
+ end;
+ tkMethod:
+ begin
+ MethodValue := GetMethodProp(Instance, PropInfo);
+ if HasAncestor then
+ DefMethodCodeValue := GetMethodProp(Ancestor, PropInfo).Code
+ else
+ DefMethodCodeValue := nil;
+
+ Handled:=false;
+ if Assigned(OnWriteMethodProperty) then
+ OnWriteMethodProperty(Self,Instance,PPropInfo(PropInfo),MethodValue,
+ DefMethodCodeValue,Handled);
+ if (not Handled) and
+ (MethodValue.Code <> DefMethodCodeValue) and
+ ((not Assigned(MethodValue.Code)) or
+ ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ if Assigned(MethodValue.Code) then
+ Driver.WriteMethodName(FLookupRoot.MethodName(MethodValue.Code))
+ else
+ Driver.WriteMethodName('');
+ Driver.EndProperty;
+ end;
+ end;
+{$ifndef HASWIDESTRING}
+ tkWString,
+{$endif}
+ tkSString, tkLString, tkAString:
+ begin
+ StrValue := GetStrProp(Instance, PropInfo);
+ if HasAncestor then
+ DefStrValue := GetStrProp(Ancestor, PropInfo)
+ else
+ SetLength(DefStrValue, 0);
+
+ if StrValue <> DefStrValue then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ if Assigned(FOnWriteStringProperty) then
+ FOnWriteStringProperty(Self,Instance,PropInfo,StrValue);
+ WriteString(StrValue);
+ Driver.EndProperty;
+ end;
+ end;
+{$ifdef HASWIDESTRING}
+ tkWString:
+ begin
+ WStrValue := GetWideStrProp(Instance, PropInfo);
+ if HasAncestor then
+ WDefStrValue := GetWideStrProp(Ancestor, PropInfo)
+ else
+ SetLength(WDefStrValue, 0);
+
+ if WStrValue <> WDefStrValue then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ WriteWideString(WStrValue);
+ Driver.EndProperty;
+ end;
+ end;
+{$endif}
+ {!!!: tkVariant:}
+ tkClass:
+ begin
+ ObjValue := TObject(GetObjectProp(Instance, PropInfo));
+ if HasAncestor then
+ begin
+ AncestorObj := TObject(GetObjectProp(Ancestor, PropInfo));
+ if Assigned(AncestorObj) then
+ if Assigned(ObjValue) and
+ (TComponent(AncestorObj).Owner = FRootAncestor) and
+ (TComponent(ObjValue).Owner = Root) and
+ (UpperCase(TComponent(AncestorObj).Name) = UpperCase(TComponent(ObjValue).Name)) then
+ AncestorObj := ObjValue
+ else
+ AncestorObj := nil;
+ end else
+ AncestorObj := nil;
+
+ if not Assigned(ObjValue) then
+ begin
+ if ObjValue <> AncestorObj then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ Driver.WriteIdent('NIL');
+ Driver.EndProperty;
+ end
+ end else if ObjValue.InheritsFrom(TPersistent) then
+ { Subcomponents are streamed the same way as persistents }
+ if ObjValue.InheritsFrom(TComponent)
+ and not (csSubComponent in TComponent(ObjValue).ComponentStyle) then
+ begin
+ Component := TComponent(ObjValue);
+ if (ObjValue <> AncestorObj)
+ and not (csTransient in Component.ComponentStyle) then
+ begin
+ { Determine the correct name of the component this property contains }
+ if Component.Owner = LookupRoot then
+ Name := Component.Name
+ else if Component = LookupRoot then
+ Name := 'Owner'
+ else if Assigned(Component.Owner) and (Length(Component.Owner.Name) > 0)
+ and (Length(Component.Name) > 0) then
+ Name := Component.Owner.Name + '.' + Component.Name
+ else if Length(Component.Name) > 0 then
+ Name := Component.Name + '.Owner'
+ else
+ SetLength(Name, 0);
+
+ if Length(Name) > 0 then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ WriteIdent(Name);
+ Driver.EndProperty;
+ end;
+ end;
+ end else if ObjValue.InheritsFrom(TCollection) then
+ begin
+ if (not HasAncestor) or (not CollectionsEqual(TCollection(ObjValue),
+ TCollection(GetObjectProp(Ancestor, PropInfo)))) then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ SavedPropPath := FPropPath;
+ try
+ SetLength(FPropPath, 0);
+ WriteCollection(TCollection(ObjValue));
+ finally
+ FPropPath := SavedPropPath;
+ Driver.EndProperty;
+ end;
+ end;
+ end else
+ begin
+ SavedAncestor := Ancestor;
+ SavedPropPath := FPropPath;
+ try
+ FPropPath := FPropPath + PPropInfo(PropInfo)^.Name + '.';
+ if HasAncestor then
+ Ancestor := TPersistent(GetObjectProp(Ancestor, PropInfo));
+ WriteProperties(TPersistent(ObjValue));
+ finally
+ Ancestor := SavedAncestor;
+ FPropPath := SavedPropPath;
+ end;
+ end;
+ end;
+ tkInt64:
+ begin
+ Int64Value := GetInt64Prop(Instance, PropInfo);
+ if HasAncestor then
+ DefInt64Value := GetInt64Prop(Ancestor, PropInfo)
+ else
+ DefInt64Value := 0;
+ if Int64Value <> DefInt64Value then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ WriteInteger(Int64Value);
+ Driver.EndProperty;
+ end;
+ end;
+ tkBool:
+ begin
+ BoolValue := GetOrdProp(Instance, PropInfo)<>0;
+ if HasAncestor then
+ DefBoolValue := GetOrdProp(Ancestor, PropInfo)<>0
+ else
+ DefBoolValue := PPropInfo(PropInfo)^.Default<>0;
+ if BoolValue <> DefBoolValue then
+ begin
+ Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+ WriteBoolean(BoolValue);
+ Driver.EndProperty;
+ end;
+ end;
+ end;
+end;
+
+procedure TWriter.WriteRootComponent(ARoot: TComponent);
+begin
+ WriteDescendent(ARoot, nil);
+end;
+
+procedure TWriter.WriteString(const Value: String);
+begin
+ Driver.WriteString(Value);
+end;
+
+{$ifdef HASWIDESTRING}
+procedure TWriter.WriteWideString(const Value: WideString);
+begin
+ Driver.WriteWideString(Value);
+end;
+{$endif HASWIDESTRING}
+
+{
+ $Log: writer.inc,v $
+ Revision 1.11 2005/04/15 07:21:09 michael
+ + Streaming of subcomponents added by Marc Weustink
+
+ Revision 1.10 2005/04/09 20:37:08 michael
+ + Patch from Uberto Barbini to allow creating streams with different drivers
+
+ Revision 1.9 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/convutil.inc b/rtl/objpas/convutil.inc
new file mode 100644
index 0000000000..586ce15aa0
--- /dev/null
+++ b/rtl/objpas/convutil.inc
@@ -0,0 +1,658 @@
+{
+ $Id: convutil.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ An implementation for unit convutils, which converts between
+ units and simple combinations of them.
+
+ Based on a guessed interface derived from some programs on the web. (Like
+ Marco Cantu's EuroConv example), so things can be a bit Delphi
+ incompatible. Also part on Delphibasics.co.uk.
+
+ Quantities are mostly taken from my HP48g/gx or the unix units program
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+unit convutils;
+
+interface
+
+{$ifndef VER1_0}
+{$mode objfpc}
+{$H+}
+
+Type TConvType = type Integer;
+ TConvFamily = type Integer;
+
+var
+
+{cbArea family}
+
+ auSquareMillimeters,
+ auSquareCentimeters,
+ auSquareDecimeters,
+ auSquareMeters,
+ auSquareDecameters,
+ auSquareHectometers,
+ auSquareKilometers,
+ auSquareInches,
+ auSquareFeet ,
+ auSquareYards ,
+ auSquareMiles,
+ auAcres ,
+ auCentares ,
+ auAres ,
+ auHectares ,
+ auSquareRods ,
+
+{cbDistance family}
+
+ duMicromicrons,
+ duAngstroms ,
+ duMillimicrons,
+ duMicrons,
+ duMillimeters,
+ duCentimeters,
+ duDecimeters,
+ duMeters,
+ duDecameters,
+ duHectometers,
+ duKilometers,
+ duMegameters,
+ duGigameters,
+ duInches,
+ duFeet,
+ duYards,
+ duMiles ,
+ duNauticalMiles,
+ duAstronomicalUnits,
+ duLightYears,
+ duParsecs,
+ duCubits,
+ duFathoms,
+ duFurlongs,
+ duHands,
+ duPaces,
+ duRods,
+ duChains,
+ duLinks,
+ duPicas,
+ duPoints,
+
+{cbMass family}
+
+ muNanograms,
+ muMicrograms,
+ muMilligrams,
+ muCentigrams,
+ muDecigrams,
+ muGrams,
+ muDecagrams,
+ muHectograms,
+ muKilograms,
+ muMetricTons,
+ muDrams,
+ muGrains,
+ muLongTons,
+ muTons,
+ muOunces,
+ muPounds,
+ muStones,
+
+{cbTemperature family}
+
+ tuCelsius,
+ tuKelvin,
+ tuFahrenheit,
+ tuRankine,
+ tuReamur,
+
+{
+cbTime family
+}
+
+ tuMilliSeconds,
+ tuSeconds,
+ tuMinutes,
+ tuHours,
+ tuDays,
+ tuWeeks,
+ tuFortnights,
+ tuMonths,
+ tuYears,
+ tuDecades,
+ tuCenturies,
+ tuMillennia,
+ tuDateTime,
+ tuJulianDate,
+ tuModifiedJulianDate,
+
+{
+cbVolume family
+}
+
+ vuCubicMillimeters,
+ vuCubicCentimeters,
+ vuCubicDecimeters,
+ vuCubicMeters,
+ vuCubicDecameters,
+ vuCubicHectometers,
+ vuCubicKilometers,
+ vuCubicInches,
+ vuCubicFeet,
+ vuCubicYards,
+ vuCubicMiles,
+ vuMilliLiters,
+ vuCentiLiters,
+ vuDeciLiters,
+ vuLiters,
+ vuDecaLiters,
+ vuHectoLiters,
+ vuKiloLiters,
+ vuAcreFeet,
+ vuAcreInches,
+ vuCords,
+ vuCordFeet,
+ vuDecisteres,
+ vuSteres,
+ vuDecasteres,
+ vuFluidGallons,
+ vuFluidQuarts,
+ vuFluidPints,
+ vuFluidCups,
+ vuFluidGills,
+ vuFluidOunces,
+ vuFluidTablespoons,
+ vuFluidTeaspoons,
+ vuDryGallons,
+ vuDryQuarts,
+ vuDryPints,
+ vuDryPecks,
+ vuDryBuckets,
+ vuDryBushels,
+ vuUKGallons,
+ vuUKPottles,
+ vuUKQuarts,
+ vuUKPints,
+ vuUKGills,
+ vuUKOunces,
+ vuUKPecks,
+ vuUKBuckets,
+ vuUKBushels : TConvType;
+
+var
+ cbArea : TConvFamily;
+ cbDistance : TConvFamily;
+ cbMass : TConvFamily;
+ cbTemperature : TConvFamily;
+ cbTime : TConvFamily;
+ cbVolume : TConvFamily;
+
+Type TConvUtilFloat = double;
+
+Function RegisterConversionFamily(Const S : String):TConvFamily;
+Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
+
+function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
+function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
+
+
+{$endif VER1_0}
+
+Implementation
+
+{$ifndef VER1_0}
+ResourceString // Note, designations for FFU's are guesses.
+
+ txtauSquareMillimeters = 'Square millimeters (mm^2)';
+ txtauSquareCentimeters = 'Square centimeters (cm^2)';
+ txtauSquareDecimeters = 'Square decimeters (dm^2)';
+ txtauSquareMeters = 'Square meters (m^2)';
+ txtauSquareDecameters = 'Square decameters (dam^2)';
+ txtauSquareHectometers = 'Square hectometers (hm^2)';
+ txtauSquareKilometers = 'Square kilometers (km^2)';
+ txtauSquareInches = 'Square inch (in^2)';
+ txtauSquareFeet = 'Square feet (ft^2)';
+ txtauSquareYards = 'Square yards (yd^2)';
+ txtauSquareMiles = 'Square miles (mi^2)';
+ txtauAcres = 'Square acres (acre^2)';
+ txtauCentares = 'Centares (care^2)';
+ txtauAres = 'Ares (are=dam^2)';
+ txtauHectares = 'Hectares (ha=hm^2)';
+ txtauSquareRods = 'Square Rods (sqr)';
+ txtduMicromicrons = 'micro microms (mumum)';
+ txtduAngstroms = 'Aengstroem (ang)';
+ txtduMillimicrons = 'millimicroms (mmum)';
+ txtduMicrons = 'microns (um)';
+ txtduMillimeters = 'millimeters (mm)';
+ txtduCentimeters = 'centimeters (cm)';
+ txtduDecimeters = 'decimeters (dm)';
+ txtduMeters = 'meters (m)';
+ txtduDecameters = 'decameters (dam)';
+ txtduHectometers = 'hectometers (hm)';
+ txtduKilometers = 'kilometers (km)';
+ txtduMegameters = 'megameters (Mm)';
+ txtduGigameters = 'gigameters (Gm)';
+ txtduInches = 'inches (in)';
+ txtduFeet = 'feet (ft)';
+ txtduYards = 'yards (yd)';
+ txtduMiles = 'miles (mi)';
+ txtduNauticalMiles = 'nautical miles (nmi)';
+ txtduAstronomicalUnits = 'astronomical units (au)';
+ txtduLightYears = 'light years (ly)';
+ txtduParsecs = 'Parsec (Ps)';
+ txtduCubits = 'Cubits (cb)';
+ txtduFathoms = 'Fathom (Fth)';
+ txtduFurlongs = 'Furlongs (furl)';
+ txtduHands = 'Hands (hnd)';
+ txtduPaces = 'Paces (pc)';
+ txtduRods = 'Rods (rd)';
+ txtduChains = 'Chains (ch)';
+ txtduLinks = 'Links (lnk)';
+ txtduPicas = 'Pica''s (pc)';
+ txtduPoints = 'Points (pnts)'; // carat/Karaat 2E-6 gram ?
+ txtmuNanograms = 'nanograms (ng)';
+ txtmuMicrograms = 'micrograms (um)';
+ txtmuMilligrams = 'milligrams (mg)';
+ txtmuCentigrams = 'centigrams (cg)';
+ txtmuDecigrams = 'decigrams (dg)';
+ txtmuGrams = 'grams (g)';
+ txtmuDecagrams = 'decagrams (dag)';
+ txtmuHectograms = 'hectograms (hg)';
+ txtmuKilograms = 'kilograms (kg)';
+ txtmuMetricTons = 'metric ton (t)';
+ txtmuDrams = 'dramgs (??)';
+ txtmuGrains = 'grains (??)';
+ txtmuLongTons = 'longton (??)';
+ txtmuTons = 'imperial ton (??)'; // calling metric ton "ton" is normal in metric countries
+ txtmuOunces = 'ounce (??)';
+ txtmuPounds = 'pounds (??)'; // what kind? Metric pound =0.5
+ txtmuStones = 'stones (??)';
+ txttuCelsius = 'degrees Celsius (degC)';
+ txttuKelvin = 'degrees Kelvin (K)';
+ txttuFahrenheit = 'degrees Fahrenheit (degF)';
+ txttuRankine = 'degrees Rankine (degR)';
+ txttuReamur = 'degrees Reamur (degReam)';
+ txttuMilliSeconds = 'milli seconds (ms)';
+ txttuSeconds = 'seconds (s)';
+ txttuMinutes = 'minutes (min)';
+ txttuHours = 'hours (hr)';
+ txttuDays = 'days (days)';
+ txttuWeeks = 'weeks (weeks)';
+ txttuFortnights = 'Fortnights (??)';
+ txttuMonths = 'Months (months)';
+ txttuYears = 'Years (years)';
+ txttuDecades = 'Decades (decades)';
+ txttuCenturies = 'Centuries (centuries)';
+ txttuMillennia = 'Millennia (millenia)';
+ txttuDateTime = 'DateTime (??)';
+ txttuJulianDate = 'JulianDate (??)';
+ txttuModifiedJulianDate = 'Modified JulianData (??)';
+
+ txtvuCubicMillimeters = 'cubic millimeters (mm^3)';
+ txtvuCubicCentimeters = 'cubic centimeters (cm^3)';
+ txtvuCubicDecimeters = 'cubic decimeters (dm^3)';
+ txtvuCubicMeters = 'cubic meters (m^3)';
+ txtvuCubicDecameters = 'cubic decameters (dam^3)';
+ txtvuCubicHectometers = 'cubic hectometers (hm^3)';
+ txtvuCubicKilometers = 'cubic kilometers (km^3)';
+ txtvuCubicInches = 'cubic inches (in^3)';
+ txtvuCubicFeet = 'cubic feet (ft^3)';
+ txtvuCubicYards = 'cubic yards (yd^3)';
+ txtvuCubicMiles = 'cubic miles (mi^3)';
+ txtvuMilliLiters = 'milliliters (ml)';
+ txtvuCentiLiters = 'centiliters (cl)';
+ txtvuDeciLiters = 'deciliters (dl)';
+ txtvuLiters = 'liters (l)';
+ txtvuDecaLiters = 'decaliters (dal)';
+ txtvuHectoLiters = 'hectoliters (hl)';
+ txtvuKiloLiters = 'kiloliters (kl)';
+ txtvuAcreFeet = 'acrefeet (acre ft)';
+ txtvuAcreInches = 'acreinches (acre in)';
+ txtvuCords = 'cords (??)';
+ txtvuCordFeet = 'cordfeet (??)';
+ txtvuDecisteres = 'decisteres (??)';
+ txtvuSteres = 'steres (??)';
+ txtvuDecasteres = 'decasteres (??)';
+ txtvuFluidGallons = 'US fluid gallons (fl gal)';
+ txtvuFluidQuarts = 'US fluid Quarts (fl Quart)';
+ txtvuFluidPints = 'US fluid Pints (fl pints)';
+ txtvuFluidCups = 'US fluid Cups (fl Cups)';
+ txtvuFluidGills = 'US fluid Gills (fl Quart)';
+ txtvuFluidOunces = 'US fluid Ounces (fl Ounces)';
+ txtvuFluidTablespoons = 'US fluid Tablespoons (fl Tablespoons)';
+ txtvuFluidTeaspoons = 'US fluid teaspoons (fl teaspoon)';
+ txtvuDryGallons = 'US dry gallons (dr gal)';
+ txtvuDryQuarts = 'US dry Quarts (dr Quart)';
+ txtvuDryPints = 'US dry Pints (dr pints)';
+ txtvuDryPecks = 'US dry pecks (dr pecks)';
+ txtvuDryBuckets = 'US dry buckets (dr buckets)';
+ txtvuDryBushels = 'US dry bushels (dr bushels)';
+ txtvuUKGallons = 'UK gallons (fl gal)';
+ txtvuUKPottles = 'UK Pottles (fl pttle)';
+ txtvuUKQuarts = 'UK Quarts (fl Quart)';
+ txtvuUKPints = 'UK Pints (fl pints)';
+ txtvuUKGills = 'UK Gills (fl Quart)';
+ txtvuUKOunces = 'UK Ounces (fl Ounces)';
+ txtvuUKPecks = 'UK pecks (dr pecks)';
+ txtvuUKBuckets = 'UK buckets (dr buckets)';
+ txtvuUKBushels = 'UK bushels (dr bushels)';
+
+Type ResourceData = record
+ Description : String;
+ Value : TConvUtilFloat;
+ Fam : TConvFamily;
+ end;
+
+
+var TheUnits : array of ResourceData =nil;
+ TheFamilies : array of string =nil;
+
+Function RegisterConversionFamily(Const S:String):TConvFamily;
+
+var i,l : Longint;
+
+begin
+ l:=Length(TheFamilies);
+ If l=0 Then
+ begin
+ SetLength(TheFamilies,1);
+ TheFamilies[0]:=S;
+ Result:=0;
+ end
+ else
+ begin
+ i:=0;
+ while (i<l) and (s<>TheFamilies[i]) do inc(i);
+ if i=l Then
+ begin
+ SetLength(TheFamilies,l+1);
+ TheFamilies[l]:=s;
+ end;
+ Result:=i;
+ end;
+end;
+
+Function CheckFamily(i:TConvFamily):Boolean;
+
+begin
+ Result:=i<Length(TheFamilies);
+end;
+
+const macheps=1E-9;
+
+Function RegisterConversionType(Fam:TConvFamily;Const S:String;Value:TConvUtilFloat):TConvType;
+
+var i,l1 : Longint;
+
+begin
+ If NOT CheckFamily(Fam) Then exit(-1); // family not registered.
+ if (value+1.0)<macheps then // not properly defined yet.
+ exit(-1);
+ l1:=length(theunits);
+ Setlength(theunits,l1+1);
+ theunits[l1].description:=s;
+ theunits[l1].value:=value;
+ theunits[l1].fam:=fam;
+ Result:=l1;
+end;
+
+function SearchConvert(TheType:TConvType; var r:ResourceData):Boolean;
+
+var i,j,l1,l2 : longint;
+
+begin
+ l1:=length(TheUnits);
+ if thetype>=l1 then
+ exit(false);
+ r:=theunits[thetype];
+ result:=true;
+end;
+
+function Convert ( const Measurement : Double; const FromType, ToType : TConvType ) :TConvUtilFloat;
+
+var
+ fromrec,torec : resourcedata;
+
+begin
+ if not SearchConvert(fromtype,fromrec) then
+ exit(-1.0); // raise exception?
+ if not SearchConvert(totype,torec) then
+ exit(-1.0); // raise except?
+ if fromrec.fam<>torec.fam then
+ exit(-1.0);
+ result:=Measurement*fromrec.value/torec.value;
+end;
+
+function Convert ( const Measurement : Double; const FromType1, FromType2, ToType1, ToType2 : TConvType ) :TConvUtilFloat;
+var
+ fromrec1,fromrec2,torec1 ,
+ torec2 : resourcedata;
+
+begin
+ if not SearchConvert(fromtype1,fromrec1) then
+ exit(-1.0); // raise exception?
+ if not SearchConvert(totype1,torec1) then
+ exit(-1.0); // raise except?
+ if not SearchConvert(fromtype2,fromrec2) then
+ exit(-1.0); // raise exception?
+ if not SearchConvert(totype2,torec2) then
+ exit(-1.0); // raise except?
+ if (fromrec1.fam<>torec1.fam) or (fromrec1.fam<>torec1.fam) then
+ exit(-1.0);
+ result:=Measurement*(fromrec1.value/fromrec2.value)/(torec1.value/torec2.value);
+end;
+
+ // initial FFU factors from a HP48g calculator and BSD units program. However after
+ // a while, the bushels/forthnight got boring, so please check.
+ // undefined/uncertain factors get -1, and convert() functions
+ // should check that and bomb on it.
+
+procedure RegisterArea;
+
+begin
+ auSquareMillimeters := RegisterConversionType(cbArea,txtauSquareMillimeters,1E-6);
+ auSquareCentimeters := RegisterConversionType(cbArea,txtauSquareCentimeters,1E-4);
+ auSquareDecimeters := RegisterConversionType(cbArea,txtauSquareDecimeters,1E-2);
+ auSquareMeters := RegisterConversionType(cbArea,txtauSquareMeters,1);
+ auSquareDecameters := RegisterConversionType(cbArea,txtauSquareDecameters,1E2);
+ auSquareHectometers := RegisterConversionType(cbArea,txtauSquareHectometers,1E4);
+ auSquareKilometers := RegisterConversionType(cbArea,txtauSquareKilometers,1E6);
+ auSquareInches := RegisterConversionType(cbArea,txtauSquareInches,0.00064516);
+ auSquareFeet := RegisterConversionType(cbArea,txtauSquareFeet,0.092903040);
+ auSquareYards := RegisterConversionType(cbArea,txtauSquareYards,0.83612736);
+ auSquareMiles := RegisterConversionType(cbArea,txtauSquareMiles,2589988.11034);
+ auAcres := RegisterConversionType(cbArea,txtauAcres,4046.87260987);
+ auCentares := RegisterConversionType(cbArea,txtauCentares,-1);
+ auAres := RegisterConversionType(cbArea,txtauAres,100);
+ auHectares := RegisterConversionType(cbArea,txtauHectares,10000);
+ auSquareRods := RegisterConversionType(cbArea,txtauSquareRods,25.2929538117);
+end;
+
+procedure RegisterLengths;
+
+begin
+ duMicromicrons := RegisterConversionType(cbDistance,txtduMicromicrons,1E-12);
+ duAngstroms := RegisterConversionType(cbDistance,txtduAngstroms,1E-10);
+ duMillimicrons := RegisterConversionType(cbDistance,txtduMillimicrons,1E-9);
+ duMicrons := RegisterConversionType(cbDistance,txtduMicrons,1E-6);
+ duMillimeters := RegisterConversionType(cbDistance,txtduMillimeters,1E-3);
+ duCentimeters := RegisterConversionType(cbDistance,txtduCentimeters,1E-2);
+ duDecimeters := RegisterConversionType(cbDistance,txtduDecimeters,1E-1);
+ duMeters := RegisterConversionType(cbDistance,txtduMeters,1);
+ duDecameters := RegisterConversionType(cbDistance,txtduDecameters,10);
+ duHectometers := RegisterConversionType(cbDistance,txtduHectometers,100);
+ duKilometers := RegisterConversionType(cbDistance,txtduKilometers,1000);
+ duMegameters := RegisterConversionType(cbDistance,txtduMegameters,1E6);
+ duGigameters := RegisterConversionType(cbDistance,txtduGigameters,1E9);
+ duInches := RegisterConversionType(cbDistance,txtduInches,0.0254);
+ duFeet := RegisterConversionType(cbDistance,txtduFeet,0.3048);
+ duYards := RegisterConversionType(cbDistance,txtduYards,0.9144);
+ duMiles := RegisterConversionType(cbDistance,txtduMiles,1609.344);
+ duNauticalMiles := RegisterConversionType(cbDistance,txtduNauticalMiles,1852);
+ duAstronomicalUnits := RegisterConversionType(cbDistance,txtduAstronomicalUnits,149597900000.0);
+ duLightYears := RegisterConversionType(cbDistance,txtduLightYears,9.46052840488E15);
+ duParsecs := RegisterConversionType(cbDistance,txtduParsecs, 3.08567818585E16);
+ duCubits := RegisterConversionType(cbDistance,txtduCubits,0.4572);
+ duFathoms := RegisterConversionType(cbDistance,txtduFathoms,1.8288);
+ duFurlongs := RegisterConversionType(cbDistance,txtduFurlongs,201.168);
+ duHands := RegisterConversionType(cbDistance,txtduHands,0.1016);
+ duPaces := RegisterConversionType(cbDistance,txtduPaces,0.9144);
+ duRods := RegisterConversionType(cbDistance,txtduRods,5.0292);
+ duChains := RegisterConversionType(cbDistance,txtduChains,20.1168);
+ duLinks := RegisterConversionType(cbDistance,txtduLinks,0.201168);
+ duPicas := RegisterConversionType(cbDistance,txtduPicas,0.0042333333);
+ duPoints := RegisterConversionType(cbDistance,txtduPoints,0.00035277778);
+end;
+
+procedure Registermass; // weight? :)
+
+begin
+ muNanograms := RegisterConversionType(cbMass,txtmuNanograms,1E-12);
+ muMicrograms := RegisterConversionType(cbMass,txtmuMicrograms,1E-9);
+ muMilligrams := RegisterConversionType(cbMass,txtmuMilligrams,1E-6);
+ muCentigrams := RegisterConversionType(cbMass,txtmuCentigrams,1E-5);
+ muDecigrams := RegisterConversionType(cbMass,txtmuDecigrams,1E-4);
+ muGrams := RegisterConversionType(cbMass,txtmuGrams,1E-3);
+ muDecagrams := RegisterConversionType(cbMass,txtmuDecagrams,1E-2);
+ muHectograms := RegisterConversionType(cbMass,txtmuHectograms,1E-1);
+ muKilograms := RegisterConversionType(cbMass,txtmuKilograms,1);
+ muMetricTons := RegisterConversionType(cbMass,txtmuMetricTons,1000);
+ muDrams := RegisterConversionType(cbMass,txtmuDrams,0.0017718452);
+ muGrains := RegisterConversionType(cbMass,txtmuGrains,6.479891E-5);
+ muLongTons := RegisterConversionType(cbMass,txtmuLongTons,1016.0469);
+ muTons := RegisterConversionType(cbMass,txtmuTons,907.18474);
+ muOunces := RegisterConversionType(cbMass,txtmuOunces,0.028349523);
+ muPounds := RegisterConversionType(cbMass,txtmuPounds,0.45359237);
+ muStones := RegisterConversionType(cbMass,txtmuStones,6.3502932);
+end;
+
+procedure RegisterTemperature;
+begin
+ tuCelsius := RegisterConversionType(cbTemperature,txttuCelsius,1);
+ tuKelvin := RegisterConversionType(cbTemperature,txttuKelvin,1);
+ tuFahrenheit := RegisterConversionType(cbTemperature,txttuFahrenheit,5/9);
+ tuRankine := RegisterConversionType(cbTemperature,txttuRankine,0.5555556);
+ tuReamur := RegisterConversionType(cbTemperature,txttuReamur,10/8); // Reaumur?
+end;
+
+Const Yearsec=365.24219879*24*3600.0; // year in seconds;
+
+procedure RegisterTimes;
+
+begin
+ tuMilliSeconds := RegisterConversionType(cbTime,txttuMilliSeconds,1E-3);
+ tuSeconds := RegisterConversionType(cbTime,txttuSeconds,1);
+ tuMinutes := RegisterConversionType(cbTime,txttuMinutes,60.0);
+ tuHours := RegisterConversionType(cbTime,txttuHours,3600.0);
+ tuDays := RegisterConversionType(cbTime,txttuDays,24*3600.0);
+ tuWeeks := RegisterConversionType(cbTime,txttuWeeks,7*24*3600.0);
+ tuFortnights := RegisterConversionType(cbTime,txttuFortnights,14*24*3600.0);
+ tuMonths := RegisterConversionType(cbTime,txttuMonths,1/12*YearSec);
+ tuYears := RegisterConversionType(cbTime,txttuYears,YearSec);
+ tuDecades := RegisterConversionType(cbTime,txttuDecades,10*YearSec);
+ tuCenturies := RegisterConversionType(cbTime,txttuCenturies,100*yearsec);
+ tuMillennia := RegisterConversionType(cbTime,txttuMillennia,1000*yearsec);
+ tuDateTime := RegisterConversionType(cbTime,txttuDateTime,-1);
+ tuJulianDate := RegisterConversionType(cbTime,txttuJulianDate,-1);
+ tuModifiedJulianDate := RegisterConversionType(cbTime,txttuModifiedJulianDate,-1);
+end;
+
+const flgal=0.0037854118;
+
+
+procedure RegisterVolumes;
+begin
+ vuCubicMillimeters := RegisterConversionType(cbVolume,txtvuCubicMillimeters,1E-9);
+ vuCubicCentimeters := RegisterConversionType(cbVolume,txtvuCubicCentimeters,1E-6);
+ vuCubicDecimeters := RegisterConversionType(cbVolume,txtvuCubicDecimeters,1E-3);
+ vuCubicMeters := RegisterConversionType(cbVolume,txtvuCubicMeters,1);
+ vuCubicDecameters := RegisterConversionType(cbVolume,txtvuCubicDecameters,1E3);
+ vuCubicHectometers := RegisterConversionType(cbVolume,txtvuCubicHectometers,1E6);
+ vuCubicKilometers := RegisterConversionType(cbVolume,txtvuCubicKilometers,1E9);
+ vuCubicInches := RegisterConversionType(cbVolume,txtvuCubicInches,1.6387064E-5);
+ vuCubicFeet := RegisterConversionType(cbVolume,txtvuCubicFeet,0.028316847);
+ vuCubicYards := RegisterConversionType(cbVolume,txtvuCubicYards,0.76455486);
+ vuCubicMiles := RegisterConversionType(cbVolume,txtvuCubicMiles,4.1681818E9);
+ vuMilliLiters := RegisterConversionType(cbVolume,txtvuMilliLiters,1E-6);
+ vuCentiLiters := RegisterConversionType(cbVolume,txtvuCentiLiters,1E-5);
+ vuDeciLiters := RegisterConversionType(cbVolume,txtvuDeciLiters,1E-4);
+ vuLiters := RegisterConversionType(cbVolume,txtvuLiters,1E-3);
+ vuDecaLiters := RegisterConversionType(cbVolume,txtvuDecaLiters,1E-2);
+ vuHectoLiters := RegisterConversionType(cbVolume,txtvuHectoLiters,1E-1);
+ vuKiloLiters := RegisterConversionType(cbVolume,txtvuKiloLiters,1);
+ vuAcreFeet := RegisterConversionType(cbVolume,txtvuAcreFeet, -1);
+ vuAcreInches := RegisterConversionType(cbVolume,txtvuAcreInches, -1);
+ vuCords := RegisterConversionType(cbVolume,txtvuCords,128*0.028316847);
+ vuCordFeet := RegisterConversionType(cbVolume,txtvuCordFeet,128*0.028316847);
+ vuDecisteres := RegisterConversionType(cbVolume,txtvuDecisteres,0.1);
+ vuSteres := RegisterConversionType(cbVolume,txtvuSteres,1);
+ vuDecasteres := RegisterConversionType(cbVolume,txtvuDecasteres,10);
+ vuFluidGallons := RegisterConversionType(cbVolume,txtvuFluidGallons,flgal);
+ vuFluidQuarts := RegisterConversionType(cbVolume,txtvuFluidQuarts,0.25*flgal);
+ vuFluidPints := RegisterConversionType(cbVolume,txtvuFluidPints,0.5*0.25*flgal);
+ vuFluidCups := RegisterConversionType(cbVolume,txtvuFluidCups, -1);
+ vuFluidGills := RegisterConversionType(cbVolume,txtvuFluidGills,-1);
+ vuFluidOunces := RegisterConversionType(cbVolume,txtvuFluidOunces,1/16*0.5*0.25*flgal);
+ vuFluidTablespoons := RegisterConversionType(cbVolume,txtvuFluidTablespoons,-1);
+ vuFluidTeaspoons := RegisterConversionType(cbVolume,txtvuFluidTeaspoons,-1);
+ vuDryGallons := RegisterConversionType(cbVolume,txtvuDryGallons,-1);
+ vuDryQuarts := RegisterConversionType(cbVolume,txtvuDryQuarts,-1);
+ vuDryPints := RegisterConversionType(cbVolume,txtvuDryPints,-1);
+ vuDryPecks := RegisterConversionType(cbVolume,txtvuDryPecks, 0.0088097675);
+ vuDryBuckets := RegisterConversionType(cbVolume,txtvuDryBuckets,-1);
+ vuDryBushels := RegisterConversionType(cbVolume,txtvuDryBushels,0.03523907);
+ vuUKGallons := RegisterConversionType(cbVolume,txtvuUKGallons,0.0045460993);
+ vuUKPottles := RegisterConversionType(cbVolume,txtvuUKPottles,-1);
+ vuUKQuarts := RegisterConversionType(cbVolume,txtvuUKQuarts,0.0011365248);
+ vuUKPints := RegisterConversionType(cbVolume,txtvuUKPints,-1);
+ vuUKGills := RegisterConversionType(cbVolume,txtvuUKGills,-1);
+ vuUKOunces := RegisterConversionType(cbVolume,txtvuUKOunces,2.8413121E-5);
+ vuUKPecks := RegisterConversionType(cbVolume,txtvuUKPecks,0.0090921986);
+ vuUKBuckets := RegisterConversionType(cbVolume,txtvuUKBuckets,-1);
+ vuUKBushels := RegisterConversionType(cbVolume,txtvuUKBushels,0.036368794);
+end;
+
+Procedure RegisterFamilies;
+Begin
+ cbArea := RegisterConversionFamily('Area');
+ cbDistance := RegisterConversionFamily('Distance');
+ cbMass := RegisterConversionFamily('Mass');
+ cbTemperature := RegisterConversionFamily('Temperature');
+ cbTime := RegisterConversionFamily('Time');
+ cbVolume := RegisterConversionFamily('Volume');
+End;
+
+
+Procedure RegisterAll;
+begin
+ RegisterFamilies;
+ RegisterVolumes;
+ RegisterTimes;
+ RegisterTemperature;
+ Registermass;
+ RegisterLengths;
+ RegisterArea;
+end;
+
+
+initialization
+ registerall;
+finalization
+ setlength(theunits,0);
+ setlength(thefamilies,0);
+{$endif VER1_0}
+end.
+
+{
+ $Log: convutil.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/convutil.pp b/rtl/objpas/convutil.pp
new file mode 100644
index 0000000000..052f1fc7e4
--- /dev/null
+++ b/rtl/objpas/convutil.pp
@@ -0,0 +1 @@
+{$I convutil.inc}
diff --git a/rtl/objpas/convutils.pp b/rtl/objpas/convutils.pp
new file mode 100644
index 0000000000..052f1fc7e4
--- /dev/null
+++ b/rtl/objpas/convutils.pp
@@ -0,0 +1 @@
+{$I convutil.inc}
diff --git a/rtl/objpas/cvarutil.inc b/rtl/objpas/cvarutil.inc
new file mode 100644
index 0000000000..48f0825978
--- /dev/null
+++ b/rtl/objpas/cvarutil.inc
@@ -0,0 +1,653 @@
+{
+ $Id: cvarutil.inc,v 1.14 2005/04/28 09:15:44 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000,2001 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$ifdef HASVARIANT}
+
+Resourcestring
+
+ SNoWidestrings = 'No widestrings supported';
+ SNoInterfaces = 'No interfaces supported';
+
+Procedure NoWidestrings;
+
+begin
+ Raise Exception.Create(SNoWideStrings);
+end;
+
+Procedure NoInterfaces;
+
+begin
+ Raise Exception.Create(SNoInterfaces);
+end;
+
+Constructor EVariantError.CreateCode (Code : longint);
+
+begin
+ ErrCode:=Code;
+end;
+
+Procedure VariantTypeMismatch;
+
+begin
+ Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
+end;
+
+Function ExceptionToVariantError (E : Exception): HResult;
+
+begin
+ If E is EoutOfMemory then
+ Result:=VAR_OUTOFMEMORY
+ else
+ Result:=VAR_EXCEPTION;
+end;
+
+{ ---------------------------------------------------------------------
+ OS-independent functions not present in Windows
+ ---------------------------------------------------------------------}
+
+Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
+
+begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Round(VSingle);
+ VarDouble : Result:=Round(VDouble);
+ VarCurrency: Result:=Round(VCurrency);
+ VarDate : Result:=Round(VDate);
+ VarOleStr : Result:=StrToInt(WideCharToString(vOleStr));
+ VarBoolean : Result:=SmallInt(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+end;
+
+Function VariantToShortInt(Const VargSrc : TVarData) : ShortInt;
+
+begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Round(VSingle);
+ VarDouble : Result:=Round(VDouble);
+ VarCurrency: Result:=Round(VCurrency);
+ VarDate : Result:=Round(VDate);
+ VarOleStr : Result:=StrToInt(WideCharToString(vOleStr));
+ VarBoolean : Result:=SmallInt(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+end;
+
+
+Function VariantToLongint(Const VargSrc : TVarData) : Longint;
+ begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Round(VSingle);
+ VarDouble : Result:=Round(VDouble);
+ VarCurrency: Result:=Round(VCurrency);
+ VarDate : Result:=Round(VDate);
+ VarOleStr :
+ if not(TryStrToInt(WideCharToString(vOleStr),Result)) then
+ VariantTypeMismatch;
+ VarString :
+ if not(TryStrToInt(ansistring(vString),Result)) then
+ VariantTypeMismatch;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ end;
+
+
+Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
+ var
+ l : longint;
+ begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Round(VSingle);
+ VarDouble : Result:=Round(VDouble);
+ VarCurrency: Result:=Round(VCurrency);
+ VarDate : Result:=Round(VDate);
+ VarOleStr :
+ begin
+ if not(TryStrToInt(WideCharToString(vOleStr),l)) then
+ VariantTypeMismatch;
+ result:=l;
+ end;
+ VarString :
+ begin
+ if not(TryStrToInt(ansistring(vString),l)) then
+ VariantTypeMismatch;
+ result:=l;
+ end;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ end;
+
+
+Function VariantToSingle(Const VargSrc : TVarData) : Single;
+ var
+ e : extended;
+ begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=VSingle;
+ VarDouble : Result:=VDouble;
+ VarCurrency: Result:=VCurrency;
+ VarDate : Result:=VDate;
+ VarOleStr :
+ begin
+ if not(TryStrToFloat(WideCharToString(vOleStr),Result)) then
+ VariantTypeMismatch;
+ result:=e;
+ end;
+ VarString :
+ begin
+ if not(TryStrToFloat(ansistring(vString),Result)) then
+ VariantTypeMismatch;
+ result:=e;
+ end;
+
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ end;
+
+
+Function VariantToDouble(Const VargSrc : TVarData) : Double;
+ var
+ e : extended;
+ begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=VSingle;
+ VarDouble : Result:=VDouble;
+ VarCurrency: Result:=VCurrency;
+ VarDate : Result:=VDate;
+ VarOleStr :
+ begin
+ if not(TryStrToFloat(WideCharToString(vOleStr),Result)) then
+ VariantTypeMismatch;
+ result:=e;
+ end;
+ VarString :
+ begin
+ if not(TryStrToFloat(ansistring(vString),Result)) then
+ VariantTypeMismatch;
+ result:=e;
+ end;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ end;
+
+
+Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
+ begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=FloatToCurr(VSingle);
+ VarDouble : Result:=FloatToCurr(VDouble);
+ VarCurrency: Result:=VCurrency;
+ VarDate : Result:=FloatToCurr(VDate);
+ VarOleStr :
+ if not(TryStrToCurr(WideCharToString(vOleStr),Result)) then
+ VariantTypeMismatch;
+ VarString :
+ if not(TryStrToCurr(ansistring(vString),Result)) then
+ VariantTypeMismatch;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+ end;
+
+
+Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
+
+begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=FloatToDateTime(VSmallInt);
+ VarShortInt: Result:=FloatToDateTime(VShortInt);
+ VarInteger : Result:=FloatToDateTime(VInteger);
+ VarSingle : Result:=FloatToDateTime(VSingle);
+ VarDouble : Result:=FloatToDateTime(VDouble);
+ VarCurrency: Result:=FloatToDateTime(VCurrency);
+ VarDate : Result:=VDate;
+ VarOleStr : NoWideStrings;
+ VarBoolean : Result:=FloatToDateTime(Longint(VBoolean));
+ VarByte : Result:=FloatToDateTime(VByte);
+ VarWord : Result:=FloatToDateTime(VWord);
+ VarLongWord : Result:=FloatToDateTime(VLongWord);
+ VarInt64 : Result:=FloatToDateTime(VInt64);
+ VarQWord : Result:=FloatToDateTime(VQword);
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+end;
+
+Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
+
+begin
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt<>0;
+ VarShortInt: Result:=VShortInt<>0;
+ VarInteger : Result:=VInteger<>0;
+ VarSingle : Result:=VSingle<>0;
+ VarDouble : Result:=VDouble<>0;
+ VarCurrency: Result:=VCurrency<>0;
+ VarDate : Result:=VDate<>0;
+ VarOleStr : NoWideStrings;
+ VarBoolean : Result:=VBoolean;
+ VarByte : Result:=VByte<>0;
+ VarWord : Result:=VWord<>0;
+ VarLongWord : Result:=VLongWord<>0;
+ VarInt64 : Result:=Vint64<>0;
+ VarQword : Result:=VQWord<>0;
+ else
+ VariantTypeMismatch;
+ end;
+end;
+
+Function VariantToByte(Const VargSrc : TVarData) : Byte;
+
+begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Round(VSingle);
+ VarDouble : Result:=Round(VDouble);
+ VarCurrency: Result:=Round(VCurrency);
+ VarDate : Result:=Round(VDate);
+ VarOleStr : NoWideStrings;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=Vint64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+end;
+
+Function VariantToInt64(Const VargSrc : TVarData) : Int64;
+
+begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallInt;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Trunc(VSingle);
+ VarDouble : Result:=Trunc(VDouble);
+{$ifdef HASCURRENCY}
+ VarCurrency: Result:=Trunc(VCurrency);
+{$else}
+ VarCurrency: Result:=VCurrency;
+{$endif}
+ VarDate : Result:=Trunc(VDate);
+ VarOleStr : NoWideStrings;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+end;
+
+Function VariantToQWord(Const VargSrc : TVarData) : QWord;
+
+begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt: Result:=VSmallint;
+ VarShortInt: Result:=VShortInt;
+ VarInteger : Result:=VInteger;
+ VarSingle : Result:=Trunc(VSingle);
+ VarDouble : Result:=Trunc(VDouble);
+{$ifdef HASCURRENCY}
+ VarCurrency: Result:=Trunc(VCurrency);
+{$else}
+ VarCurrency: Result:=VCurrency;
+{$endif}
+ VarDate : Result:=Trunc(VDate);
+ VarOleStr : NoWideStrings;
+ VarBoolean : Result:=Longint(VBoolean);
+ VarByte : Result:=VByte;
+ VarWord : Result:=VWord;
+ VarLongWord : Result:=VLongWord;
+ VarInt64 : Result:=VInt64;
+ VarQword : Result:=VQWord;
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+end;
+
+Function VariantToWideString(Const VargSrc : TVarData) : WideString;
+
+Const
+ BS : Array[Boolean] of WideString = ('False','True');
+
+begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt : Result:=IntTostr(VSmallint);
+ VarShortInt : Result:=IntToStr(VShortInt);
+ VarInteger : Result:=IntToStr(VInteger);
+ VarSingle : Result:=FloatToStr(VSingle);
+ VarDouble : Result:=FloatToStr(VDouble);
+ VarCurrency : Result:=FloatToStr(VCurrency);
+ VarDate : Result:=DateTimeToStr(VDate);
+ VarOleStr : Result:=WideString(Pointer(VOleStr));
+ VarBoolean : Result:=BS[VBoolean];
+ VarByte : Result:=IntToStr(VByte);
+ VarWord : Result:=IntToStr(VWord);
+ VarLongWord : Result:=IntToStr(VLongWord);
+ VarInt64 : Result:=IntToStr(VInt64);
+ VarQword : Result:=IntToStr(VQWord);
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+end;
+
+Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
+
+Const
+ BS : Array[Boolean] of AnsiString = ('False','True');
+
+begin
+ Try
+ With VargSrc do
+ Case (VType and VarTypeMask) of
+ VarSmallInt : Result:=IntTostr(VSmallint);
+ VarShortInt : Result:=IntToStr(VShortInt);
+ VarInteger : Result:=IntToStr(VInteger);
+ VarSingle : Result:=FloatToStr(VSingle);
+ VarDouble : Result:=FloatToStr(VDouble);
+ VarCurrency : Result:=FloatToStr(VCurrency);
+ VarDate : Result:=DateTimeToStr(VDate);
+ VarOleStr : Result:=WideCharToString(VOleStr);
+ VarBoolean : Result:=BS[VBoolean];
+ VarByte : Result:=IntToStr(VByte);
+ VarWord : Result:=IntToStr(VWord);
+ VarLongWord : Result:=IntToStr(VLongWord);
+ VarInt64 : Result:=IntToStr(VInt64);
+ VarQword : Result:=IntToStr(VQWord);
+ VarString : Result:=ansistring(VString);
+ else
+ VariantTypeMismatch;
+ end;
+ except
+ On EConvertError do
+ VariantTypeMismatch;
+ else
+ Raise;
+ end;
+end;
+
+Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
+
+Var
+ S : AnsiString;
+
+begin
+ S:=VariantToAnsiString(VArgSrc);
+ Result:=S;
+end;
+
+{ ---------------------------------------------------------------------
+ Some debug routines
+ ---------------------------------------------------------------------}
+
+
+Procedure DumpVariant(Const VArgSrc : TVarData);
+
+begin
+ DumpVariant(Output,VArgSrc);
+end;
+
+(*
+ tvardata = packed record
+ vtype : tvartype;
+ case integer of
+ 0:(res1 : word;
+ case integer of
+ 0:
+ (res2,res3 : word;
+ case word of
+ varsmallint : (vsmallint : smallint);
+ varinteger : (vinteger : longint);
+ varsingle : (vsingle : single);
+ vardouble : (vdouble : double);
+ varcurrency : (vcurrency : currency);
+ vardate : (vdate : tdatetime);
+ varolestr : (volestr : pwidechar);
+ vardispatch : (vdispatch : pointer);
+ varerror : (verror : dword);
+ varboolean : (vboolean : wordbool);
+ varunknown : (vunknown : pointer);
+ // vardecimal : ( : );
+ varshortint : (vshortint : shortint);
+ varbyte : (vbyte : byte);
+ varword : (vword : word);
+ varlongword : (vlongword : dword);
+ varint64 : (vint64 : int64);
+ varqword : (vqword : qword);
+ varword64 : (vword64 : qword);
+ varstring : (vstring : pointer);
+ varany : (vany : pointer);
+ vararray : (varray : pvararray);
+ varbyref : (vpointer : pointer);
+ );
+ 1:
+ (vlongs : array[0..2] of longint);
+ );
+ 1:(vwords : array[0..6] of word);
+ 2:(vbytes : array[0..13] of byte);
+ end;
+
+*)
+
+Const
+ VarTypeStrings : Array [varEmpty..varqword] of string = (
+ 'empty', 'null', 'smallint', 'integer', 'single', 'double',
+ 'currency', 'date', 'olestr', 'dispatch', 'error', 'boolean',
+ 'variant', 'unknown', 'unknown','decimal', 'shortint', 'byte', 'word',
+ 'longword', 'int64', 'qword');
+
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
+
+Var
+ W : WideString;
+
+begin
+ If VArgSrc.vType in [varEmpty..varqword] then
+ Writeln(F,'Variant has type : ',VarTypeStrings[VArgSrc.vType])
+ else if (VArgSrc.vType=VarArray) Then
+ begin
+ Write(F,'Variant is array.');
+ exit;
+ end
+ else if (VargSrc.vType=VarByRef) then
+ begin
+ Writeln(F,'Variant is by reference.');
+ exit;
+ end
+ else
+ begin
+ Writeln(F,'Variant has unknown type: ', VargSrc.vType);
+ Exit;
+ end;
+ If VArgSrc.vType<>varEmpty then
+ With VArgSrc do
+ begin
+ Write(F,'Value is: ') ;
+ Case vtype of
+ varnull : Write(F,'Null');
+ varsmallint : Write(F,vsmallint);
+ varinteger : Write(F,vinteger);
+ varsingle : Write(F,vsingle);
+ vardouble : Write(F,vdouble);
+ varcurrency : Write(F,vcurrency) ;
+ vardate : Write(F,vdate) ;
+ varolestr : begin
+ W:=vOleStr;
+ Write(F,W) ;
+ end;
+ vardispatch : Write(F,'Not suppordted') ;
+ varerror : Write(F,'Error') ;
+ varboolean : Write(F,vboolean) ;
+ varvariant : Write(F,'Unsupported') ;
+ varunknown : Write(F,'Unsupported') ;
+ vardecimal : Write(F,'Unsupported') ;
+ varshortint : Write(F,vshortint) ;
+ varbyte : Write(F,vbyte) ;
+ varword : Write(F,vword) ;
+ varlongword : Write(F,vlongword) ;
+ varint64 : Write(F,vint64) ;
+ varqword : Write(F,vqword) ;
+ end;
+ Writeln(f);
+ end;
+end;
+
+{$endif HASVARIANT}
+
+{
+ $Log: cvarutil.inc,v $
+ Revision 1.14 2005/04/28 09:15:44 florian
+ + variants: string -> float/int casts
+
+ Revision 1.13 2005/03/28 20:36:14 florian
+ * some variant <-> string types fixes
+
+ Revision 1.12 2005/03/10 21:05:36 florian
+ + writing of variants implemented
+
+ Revision 1.11 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/dateutil.inc b/rtl/objpas/dateutil.inc
new file mode 100644
index 0000000000..4ff606ea15
--- /dev/null
+++ b/rtl/objpas/dateutil.inc
@@ -0,0 +1,2032 @@
+{$mode objfpc}
+{$h+}
+{
+ $Id: dateutil.inc,v 1.12 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Delphi/Kylix compatibility unit, provides Date/Time handling routines.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit dateutils;
+
+interface
+
+uses
+ SysUtils, Math, Types;
+
+{ ---------------------------------------------------------------------
+ Various constants
+ ---------------------------------------------------------------------}
+
+const
+ DaysPerWeek = 7;
+ WeeksPerFortnight = 2;
+ MonthsPerYear = 12;
+ YearsPerDecade = 10;
+ YearsPerCentury = 100;
+ YearsPerMillennium = 1000;
+
+ // ISO day numbers.
+ DayMonday = 1;
+ DayTuesday = 2;
+ DayWednesday = 3;
+ DayThursday = 4;
+ DayFriday = 5;
+ DaySaturday = 6;
+ DaySunday = 7;
+
+ // Fraction of a day
+ OneHour = 1/HoursPerDay;
+ OneMinute = 1/MinsPerDay;
+ OneSecond = 1/SecsPerDay;
+ OneMillisecond = 1/MSecsPerDay;
+
+ { This is actual days per year but you need to know if it's a leap year}
+ DaysPerYear: array [Boolean] of Word = (365, 366);
+
+ { Used in RecodeDate, RecodeTime and RecodeDateTime for those datetime }
+ { fields you want to leave alone }
+ RecodeLeaveFieldAsIs = High(Word);
+
+{ ---------------------------------------------------------------------
+ Global variables used in this unit
+ ---------------------------------------------------------------------}
+
+Const
+
+ { Average over a 4 year span. Valid for next 100 years }
+ ApproxDaysPerMonth: Double = 30.4375;
+ ApproxDaysPerYear: Double = 365.25;
+
+
+
+{ ---------------------------------------------------------------------
+ Simple trimming functions.
+ ---------------------------------------------------------------------}
+
+Function DateOf(const AValue: TDateTime): TDateTime;
+Function TimeOf(const AValue: TDateTime): TDateTime;
+
+{ ---------------------------------------------------------------------
+ Identification functions.
+ ---------------------------------------------------------------------}
+
+Function IsInLeapYear(const AValue: TDateTime): Boolean;
+Function IsPM(const AValue: TDateTime): Boolean;
+Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
+Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
+Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
+Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
+Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
+Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
+
+{ ---------------------------------------------------------------------
+ Enumeration functions.
+ ---------------------------------------------------------------------}
+
+Function WeeksInYear(const AValue: TDateTime): Word;
+Function WeeksInAYear(const AYear: Word): Word;
+Function DaysInYear(const AValue: TDateTime): Word;
+Function DaysInAYear(const AYear: Word): Word;
+Function DaysInMonth(const AValue: TDateTime): Word;
+Function DaysInAMonth(const AYear, AMonth: Word): Word;
+
+
+{ ---------------------------------------------------------------------
+ Variations on current date/time.
+ ---------------------------------------------------------------------}
+
+
+Function Today: TDateTime;
+Function Yesterday: TDateTime;
+Function Tomorrow: TDateTime;
+Function IsToday(const AValue: TDateTime): Boolean;
+Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
+Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
+
+{ ---------------------------------------------------------------------
+ Extraction functions.
+ ---------------------------------------------------------------------}
+
+Function YearOf(const AValue: TDateTime): Word;
+Function MonthOf(const AValue: TDateTime): Word;
+Function WeekOf(const AValue: TDateTime): Word;
+Function DayOf(const AValue: TDateTime): Word;
+Function HourOf(const AValue: TDateTime): Word;
+Function MinuteOf(const AValue: TDateTime): Word;
+Function SecondOf(const AValue: TDateTime): Word;
+Function MilliSecondOf(const AValue: TDateTime): Word;
+
+{ ---------------------------------------------------------------------
+ Start/End of year functions.
+ ---------------------------------------------------------------------}
+
+Function StartOfTheYear(const AValue: TDateTime): TDateTime;
+Function EndOfTheYear(const AValue: TDateTime): TDateTime;
+Function StartOfAYear(const AYear: Word): TDateTime;
+Function EndOfAYear(const AYear: Word): TDateTime;
+
+{ ---------------------------------------------------------------------
+ Start/End of month functions.
+ ---------------------------------------------------------------------}
+
+Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
+Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
+Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
+Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
+
+{ ---------------------------------------------------------------------
+ Start/End of week functions.
+ ---------------------------------------------------------------------}
+
+
+Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
+Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
+Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
+Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
+
+
+{ ---------------------------------------------------------------------
+ Start/End of day functions.
+ ---------------------------------------------------------------------}
+
+Function StartOfTheDay(const AValue: TDateTime): TDateTime;
+Function EndOfTheDay(const AValue: TDateTime): TDateTime;
+Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
+Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
+Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; overload;
+Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime; overload;
+
+{ ---------------------------------------------------------------------
+ Part of year functions.
+ ---------------------------------------------------------------------}
+
+Function MonthOfTheYear(const AValue: TDateTime): Word;
+Function WeekOfTheYear(const AValue: TDateTime): Word; overload;
+Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word; overload;
+Function DayOfTheYear(const AValue: TDateTime): Word;
+Function HourOfTheYear(const AValue: TDateTime): Word;
+Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
+Function SecondOfTheYear(const AValue: TDateTime): LongWord;
+Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
+
+{ ---------------------------------------------------------------------
+ Part of month functions.
+ ---------------------------------------------------------------------}
+
+Function WeekOfTheMonth(const AValue: TDateTime): Word; overload;
+Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word; overload;
+Function DayOfTheMonth(const AValue: TDateTime): Word;
+Function HourOfTheMonth(const AValue: TDateTime): Word;
+Function MinuteOfTheMonth(const AValue: TDateTime): Word;
+Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
+Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
+
+{ ---------------------------------------------------------------------
+ Part of week functions.
+ ---------------------------------------------------------------------}
+
+Function DayOfTheWeek(const AValue: TDateTime): Word;
+Function HourOfTheWeek(const AValue: TDateTime): Word;
+Function MinuteOfTheWeek(const AValue: TDateTime): Word;
+Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
+Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
+
+{ ---------------------------------------------------------------------
+ Part of day functions.
+ ---------------------------------------------------------------------}
+
+Function HourOfTheDay(const AValue: TDateTime): Word;
+Function MinuteOfTheDay(const AValue: TDateTime): Word;
+Function SecondOfTheDay(const AValue: TDateTime): LongWord;
+Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
+
+{ ---------------------------------------------------------------------
+ Part of hour functions.
+ ---------------------------------------------------------------------}
+
+Function MinuteOfTheHour(const AValue: TDateTime): Word;
+Function SecondOfTheHour(const AValue: TDateTime): Word;
+Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
+
+{ ---------------------------------------------------------------------
+ Part of minute functions.
+ ---------------------------------------------------------------------}
+
+
+Function SecondOfTheMinute(const AValue: TDateTime): Word;
+Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
+
+{ ---------------------------------------------------------------------
+ Part of second functions.
+ ---------------------------------------------------------------------}
+
+Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
+
+
+{ ---------------------------------------------------------------------
+ Range checking functions.
+ ---------------------------------------------------------------------}
+
+Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
+Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
+Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
+Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
+Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
+Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
+Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
+Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
+
+{ ---------------------------------------------------------------------
+ Period functions.
+ ---------------------------------------------------------------------}
+
+Function YearsBetween(const ANow, AThen: TDateTime): Integer;
+Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
+Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
+Function DaysBetween(const ANow, AThen: TDateTime): Integer;
+Function HoursBetween(const ANow, AThen: TDateTime): Int64;
+Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
+Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
+Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
+
+{ ---------------------------------------------------------------------
+ Timespan in xxx functions.
+ ---------------------------------------------------------------------}
+
+{ YearSpan and MonthSpan are approximate values }
+Function YearSpan(const ANow, AThen: TDateTime): Double;
+Function MonthSpan(const ANow, AThen: TDateTime): Double;
+Function WeekSpan(const ANow, AThen: TDateTime): Double;
+Function DaySpan(const ANow, AThen: TDateTime): Double;
+Function HourSpan(const ANow, AThen: TDateTime): Double;
+Function MinuteSpan(const ANow, AThen: TDateTime): Double;
+Function SecondSpan(const ANow, AThen: TDateTime): Double;
+Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
+
+{ ---------------------------------------------------------------------
+ Increment/decrement functions.
+ ---------------------------------------------------------------------}
+
+Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
+Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
+// Function IncMonth is in SysUtils
+Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
+Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
+Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
+Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
+Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
+Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
+Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
+Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
+Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
+Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
+Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
+Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
+
+{ ---------------------------------------------------------------------
+ Encode/Decode of complete timestamp
+ ---------------------------------------------------------------------}
+
+Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
+Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
+Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
+
+{ ---------------------------------------------------------------------
+ Encode/decode date, specifying week of year and day of week
+ ---------------------------------------------------------------------}
+
+Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
+Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
+Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
+Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
+
+{ ---------------------------------------------------------------------
+ Encode/decode date, specifying day of year
+ ---------------------------------------------------------------------}
+
+Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
+Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
+Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
+
+{ ---------------------------------------------------------------------
+ Encode/decode date, specifying week of month
+ ---------------------------------------------------------------------}
+
+Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
+Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
+Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
+
+{ ---------------------------------------------------------------------
+ Replace given element with supplied value.
+ ---------------------------------------------------------------------}
+
+Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
+Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
+Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
+Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
+Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
+Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
+Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
+Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
+Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
+Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
+Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
+
+{ ---------------------------------------------------------------------
+ Comparision of date/time
+ ---------------------------------------------------------------------}
+
+Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
+Function CompareDate(const A, B: TDateTime): TValueRelationship;
+Function CompareTime(const A, B: TDateTime): TValueRelationship;
+Function SameDateTime(const A, B: TDateTime): Boolean;
+Function SameDate(const A, B: TDateTime): Boolean;
+Function SameTime(const A, B: TDateTime): Boolean;
+
+{ For a given date these Functions tell you the which day of the week of the
+ month (or year). If its a Thursday, they will tell you if its the first,
+ second, etc Thursday of the month (or year). Remember, even though its
+ the first Thursday of the year it doesn't mean its the first week of the
+ year. See ISO 8601 above for more information. }
+
+Function NthDayOfWeek(const AValue: TDateTime): Word;
+
+Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
+
+Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
+Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
+
+{ ---------------------------------------------------------------------
+ Exception throwing routines
+ ---------------------------------------------------------------------}
+
+Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
+Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
+Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
+Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
+Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
+Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
+
+{ ---------------------------------------------------------------------
+ Julian and Modified Julian Date conversion support
+ ---------------------------------------------------------------------}
+
+Function DateTimeToJulianDate(const AValue: TDateTime): Double;
+Function JulianDateToDateTime(const AValue: Double): TDateTime;
+Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
+
+Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
+Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
+Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
+
+{ ---------------------------------------------------------------------
+ Unix timestamp support.
+ ---------------------------------------------------------------------}
+
+Function DateTimeToUnix(const AValue: TDateTime): Int64;
+Function UnixToDateTime(const AValue: Int64): TDateTime;
+
+implementation
+
+uses sysconst;
+
+{ ---------------------------------------------------------------------
+ Auxiliary routines
+ ---------------------------------------------------------------------}
+
+Procedure NotYetImplemented (FN : String);
+
+begin
+ Raise Exception.CreateFmt('Function "%s" (dateutils) is not yet implemented',[FN]);
+end;
+
+{ ---------------------------------------------------------------------
+ Simple trimming functions.
+ ---------------------------------------------------------------------}
+
+Function DateOf(const AValue: TDateTime): TDateTime;
+begin
+ Result:=Trunc(AValue);
+end;
+
+
+Function TimeOf(const AValue: TDateTime): TDateTime;
+begin
+ Result:=Frac(Avalue);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Identification functions.
+ ---------------------------------------------------------------------}
+
+
+Function IsInLeapYear(const AValue: TDateTime): Boolean;
+
+Var
+ D,Y,M : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=IsLeapYear(Y);
+end;
+
+
+Function IsPM(const AValue: TDateTime): Boolean;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(H>=12);
+end;
+
+
+Function IsValidDate(const AYear, AMonth, ADay: Word): Boolean;
+begin
+ Result:=(AYear<>0) and (AYear<10000)
+ and (AMonth in [1..12])
+ and (ADay<>0) and (ADay<=MonthDays[IsleapYear(AYear),AMonth]);
+end;
+
+
+Function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
+begin
+ Result:=(AHour=HoursPerDay) and (AMinute=0) and (ASecond=0) and (AMillisecond=0);
+ Result:=Result or
+ ((AHour<HoursPerDay) and (AMinute<MinsPerHour) and (ASecond<SecsPerMin) and
+ (AMillisecond<MSecsPerSec));
+end;
+
+
+Function IsValidDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
+begin
+ Result:=IsValidDate(AYear,AMonth,ADay) and
+ IsValidTime(AHour,AMinute,ASecond,AMillisecond)
+end;
+
+
+Function IsValidDateDay(const AYear, ADayOfYear: Word): Boolean;
+begin
+ Result:=(AYear<>0) and (ADayOfYear<>0) and (AYear<10000) and
+ (ADayOfYear<=DaysPerYear[IsLeapYear(AYear)]);
+end;
+
+
+Function IsValidDateWeek(const AYear, AWeekOfYear, ADayOfWeek: Word): Boolean;
+begin
+ Result:=(AYear<>0) and (AYear<10000)
+ and (ADayOfWeek in [1..7])
+ and (AWeekOfYear<>0)
+ and (AWeekOfYear<=WeeksInaYear(AYear));
+ { should we not also check whether the day of the week is not
+ larger than the last day of the last week in the year 9999 ?? }
+end;
+
+
+Function IsValidDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): Boolean;
+
+begin
+ Result:=(AYear<>0) and (AYear<10000)
+ and (AMonth in [1..12])
+ and (AWeekOfMonth in [1..5])
+ and (ADayOfWeek in [1..7]);
+end;
+
+{ ---------------------------------------------------------------------
+ Enumeration functions.
+ ---------------------------------------------------------------------}
+
+Function WeeksInYear(const AValue: TDateTime): Word;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=WeeksInAYear(Y);
+end;
+
+
+Function WeeksInAYear(const AYear: Word): Word;
+
+Var
+ DOW : Word;
+
+begin
+ Result:=52;
+ DOW:=DayOfTheWeek(StartOfAYear(AYear));
+ If (DOW=4) or ((DOW=3) and IsLeapYear(AYear)) then
+ Inc(Result);
+end;
+
+
+Function DaysInYear(const AValue: TDateTime): Word;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=DaysPerYear[IsLeapYear(Y)];
+end;
+
+
+Function DaysInAYear(const AYear: Word): Word;
+begin
+ Result:=DaysPerYear[Isleapyear(AYear)];
+end;
+
+
+Function DaysInMonth(const AValue: TDateTime): Word;
+
+Var
+ Y,M,D : Word;
+
+begin
+ Decodedate(AValue,Y,M,D);
+ Result:=MonthDays[IsLeapYear(Y),M];
+end;
+
+
+Function DaysInAMonth(const AYear, AMonth: Word): Word;
+begin
+ Result:=MonthDays[IsLeapYear(AYear),AMonth];
+end;
+
+
+{ ---------------------------------------------------------------------
+ Variations on current date/time.
+ ---------------------------------------------------------------------}
+
+
+Function Today: TDateTime;
+begin
+ Result:=Date;
+end;
+
+
+Function Yesterday: TDateTime;
+begin
+ Result:=Date-1;
+end;
+
+
+Function Tomorrow: TDateTime;
+begin
+ Result:=Date+1;
+end;
+
+
+Function IsToday(const AValue: TDateTime): Boolean;
+begin
+ Result:=IsSameDay(AValue,Date);
+end;
+
+
+Function IsSameDay(const AValue, ABasis: TDateTime): Boolean;
+
+Var
+ D : TDateTime;
+
+begin
+ D:=AValue-Trunc(ABasis);
+ Result:=(D>=0) and (D<1);
+end;
+
+const
+ DOWMap: array [1..7] of Word = (7, 1, 2, 3, 4, 5, 6);
+
+Function PreviousDayOfWeek (DayOfWeek : Word) : Word;
+
+begin
+ If Not (DayOfWeek in [1..7]) then
+ Raise EConvertError.CreateFmt(SErrInvalidDayOfWeek,[DayOfWeek]);
+ Result:=DOWMap[DayOfWeek];
+end;
+
+
+
+{ ---------------------------------------------------------------------
+ Extraction functions.
+ ---------------------------------------------------------------------}
+
+
+Function YearOf(const AValue: TDateTime): Word;
+
+Var
+ D,M : Word;
+
+begin
+ DecodeDate(AValue,Result,D,M);
+end;
+
+
+Function MonthOf(const AValue: TDateTime): Word;
+
+Var
+ Y,D : Word;
+
+begin
+ DecodeDate(AValue,Y,Result,D);
+end;
+
+
+Function WeekOf(const AValue: TDateTime): Word;
+begin
+ Result:=WeekOfTheYear(AValue);
+end;
+
+
+Function DayOf(const AValue: TDateTime): Word;
+
+Var
+ Y,M : Word;
+
+begin
+ DecodeDate(AValue,Y,M,Result);
+end;
+
+
+Function HourOf(const AValue: TDateTime): Word;
+
+Var
+ N,S,MS : Word;
+
+begin
+ DecodeTime(AValue,Result,N,S,MS);
+end;
+
+
+Function MinuteOf(const AValue: TDateTime): Word;
+
+Var
+ H,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,Result,S,MS);
+end;
+
+
+Function SecondOf(const AValue: TDateTime): Word;
+
+Var
+ H,N,MS : Word;
+
+begin
+ DecodeTime(AVAlue,H,N,Result,MS);
+end;
+
+
+Function MilliSecondOf(const AValue: TDateTime): Word;
+
+Var
+ H,N,S : Word;
+
+begin
+ DecodeTime(AValue,H,N,S,Result);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Start/End of year functions.
+ ---------------------------------------------------------------------}
+
+
+Function StartOfTheYear(const AValue: TDateTime): TDateTime;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=EncodeDate(Y,1,1);
+end;
+
+
+Function EndOfTheYear(const AValue: TDateTime): TDateTime;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=EncodeDateTime(Y,12,31,23,59,59,999);
+end;
+
+
+Function StartOfAYear(const AYear: Word): TDateTime;
+begin
+ Result:=EncodeDate(AYear,1,1);
+end;
+
+
+Function EndOfAYear(const AYear: Word): TDateTime;
+
+begin
+ Result:=(EncodeDateTime(AYear,12,31,23,59,59,999));
+end;
+
+{ ---------------------------------------------------------------------
+ Start/End of month functions.
+ ---------------------------------------------------------------------}
+
+Function StartOfTheMonth(const AValue: TDateTime): TDateTime;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=EncodeDate(Y,M,1);
+// MonthDays[IsLeapYear(Y),M])
+end;
+
+
+Function EndOfTheMonth(const AValue: TDateTime): TDateTime;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=EncodeDateTime(Y,M,MonthDays[IsLeapYear(Y),M],23,59,59,999);
+end;
+
+
+Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
+begin
+ Result:=EncodeDate(AYear,AMonth,1);
+end;
+
+
+Function EndOfAMonth(const AYear, AMonth: Word): TDateTime;
+
+begin
+ Result:=EncodeDateTime(AYear,AMonth,MonthDays[IsLeapYear(AYear),AMonth],23,59,59,999);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Start/End of week functions.
+ ---------------------------------------------------------------------}
+
+
+Function StartOfTheWeek(const AValue: TDateTime): TDateTime;
+begin
+ Result:=Trunc(AValue)-DayOfTheWeek(AValue)+1;
+end;
+
+
+Function EndOfTheWeek(const AValue: TDateTime): TDateTime;
+begin
+ Result:=EndOfTheDay(AValue-DayOfTheWeek(AValue)+7);
+end;
+
+
+Function StartOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+begin
+ Result:=EncodeDateWeek(AYear,AWeekOfYear,ADayOfWeek);
+end;
+
+
+Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
+begin
+ Result:=StartOfAWeek(AYear,AWeekOfYear,1)
+end;
+
+
+Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+begin
+ Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
+end;
+
+
+Function EndOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // const ADayOfWeek: Word = 7
+
+
+begin
+ Result:=EndOfAWeek(AYear,AWeekOfYear,7);
+end;
+
+{ ---------------------------------------------------------------------
+ Start/End of day functions.
+ ---------------------------------------------------------------------}
+
+Function StartOfTheDay(const AValue: TDateTime): TDateTime;
+begin
+ StartOfTheDay:=Trunc(Avalue);
+end;
+
+
+Function EndOfTheDay(const AValue: TDateTime): TDateTime;
+
+Var
+ Y,M,D : Word;
+
+begin
+ DecodeDate(AValue,Y,M,D);
+ Result:=EncodeDateTime(Y,M,D,23,59,59,999);
+end;
+
+
+Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
+begin
+ Result:=EncodeDate(AYear,AMonth,ADay);
+end;
+
+
+Function StartOfADay(const AYear, ADayOfYear: Word): TDateTime;
+begin
+ Result:=StartOfAYear(AYear)+ADayOfYear-1;
+end;
+
+
+Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
+begin
+ Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
+end;
+
+
+Function EndOfADay(const AYear, ADayOfYear: Word): TDateTime;
+
+
+begin
+ Result:=StartOfAYear(AYear)+ADayOfYear-1+EncodeTime(23,59,59,999);
+end;
+
+{ ---------------------------------------------------------------------
+ Part of year functions.
+ ---------------------------------------------------------------------}
+
+
+Function MonthOfTheYear(const AValue: TDateTime): Word;
+
+Var
+ Y,D : Word;
+
+begin
+ DecodeDate(AValue,Y,Result,D);
+end;
+
+
+Function WeekOfTheYear(const AValue: TDateTime): Word;
+
+Var
+ Y,DOW : Word;
+
+begin
+ DecodeDateWeek(AValue,Y,Result,DOW)
+end;
+
+
+Function WeekOfTheYear(const AValue: TDateTime; var AYear: Word): Word;
+
+Var
+ DOW : Word;
+
+begin
+ DecodeDateWeek(AValue,AYear,Result,DOW);
+end;
+
+
+Function DayOfTheYear(const AValue: TDateTime): Word;
+begin
+ Result:=Trunc(AValue-StartOfTheYear(AValue)+1);
+end;
+
+
+Function HourOfTheYear(const AValue: TDateTime): Word;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=H+((DayOfTheYear(AValue)-1)*24);
+end;
+
+
+Function MinuteOfTheYear(const AValue: TDateTime): LongWord;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=M+(H+((DayOfTheYear(AValue)-1)*24))*60;
+end;
+
+
+Function SecondOfTheYear(const AValue: TDateTime): LongWord;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S;
+end;
+
+
+Function MilliSecondOfTheYear(const AValue: TDateTime): Int64;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=((M+(H+((DayOfTheYear(AValue)-1)*24))*60)*60+S)*1000+MS;
+end;
+
+
+{ ---------------------------------------------------------------------
+ Part of month functions.
+ ---------------------------------------------------------------------}
+
+
+Function WeekOfTheMonth(const AValue: TDateTime): Word;
+
+var
+ Y,M,DOW : word;
+
+begin
+ DecodeDateMonthWeek(AValue,Y,M,Result,DOW);
+end;
+
+
+Function WeekOfTheMonth(const AValue: TDateTime; var AYear, AMonth: Word): Word;
+
+Var
+ DOW : Word;
+
+begin
+ DecodeDateMonthWeek(AValue,AYear,AMonth,Result,DOW);
+end;
+
+
+Function DayOfTheMonth(const AValue: TDateTime): Word;
+
+Var
+ Y,M : Word;
+
+begin
+ DecodeDate(AValue,Y,M,Result);
+end;
+
+
+Function HourOfTheMonth(const AValue: TDateTime): Word;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
+ Result:=(D-1)*24+H;
+end;
+
+
+Function MinuteOfTheMonth(const AValue: TDateTime): Word;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
+ Result:=((D-1)*24+H)*60+N;
+end;
+
+
+Function SecondOfTheMonth(const AValue: TDateTime): LongWord;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
+ Result:=(((D-1)*24+H)*60+N)*60+S;
+end;
+
+
+Function MilliSecondOfTheMonth(const AValue: TDateTime): LongWord;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
+ Result:=((((D-1)*24+H)*60+N)*60+S)*1000+MS;
+end;
+
+{ ---------------------------------------------------------------------
+ Part of week functions.
+ ---------------------------------------------------------------------}
+
+
+Function DayOfTheWeek(const AValue: TDateTime): Word;
+
+begin
+ Result:=DowMAP[DayOfWeek(AValue)];
+end;
+
+
+Function HourOfTheWeek(const AValue: TDateTime): Word;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(DayOfTheWeek(AValue)-1)*24+H;
+end;
+
+
+Function MinuteOfTheWeek(const AValue: TDateTime): Word;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=((DayOfTheWeek(AValue)-1)*24+H)*60+M;
+end;
+
+
+Function SecondOfTheWeek(const AValue: TDateTime): LongWord;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S;
+end;
+
+
+Function MilliSecondOfTheWeek(const AValue: TDateTime): LongWord;
+
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=((((DayOfTheWeek(AValue)-1)*24+H)*60+M)*60+S)*1000+MS;
+end;
+
+{ ---------------------------------------------------------------------
+ Part of day functions.
+ ---------------------------------------------------------------------}
+
+
+Function HourOfTheDay(const AValue: TDateTime): Word;
+
+Var
+ M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,Result,M,S,MS);
+end;
+
+
+Function MinuteOfTheDay(const AValue: TDateTime): Word;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(H*60)+M;
+end;
+
+
+Function SecondOfTheDay(const AValue: TDateTime): LongWord;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=((H*60)+M)*60+S;
+end;
+
+
+Function MilliSecondOfTheDay(const AValue: TDateTime): LongWord;
+
+Var
+ H,M,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(((H*60)+M)*60+S)*1000+MS;
+end;
+
+{ ---------------------------------------------------------------------
+ Part of hour functions.
+ ---------------------------------------------------------------------}
+
+
+Function MinuteOfTheHour(const AValue: TDateTime): Word;
+
+Var
+ H,S,MS : Word;
+
+begin
+ DecodeTime(AValue,H,Result,S,MS);
+end;
+
+
+Function SecondOfTheHour(const AValue: TDateTime): Word;
+
+Var
+ H,S,M,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=M*60+S;
+end;
+
+
+Function MilliSecondOfTheHour(const AValue: TDateTime): LongWord;
+
+Var
+ H,S,M,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=(M*60+S)*1000+MS;
+end;
+
+{ ---------------------------------------------------------------------
+ Part of minute functions.
+ ---------------------------------------------------------------------}
+
+
+Function SecondOfTheMinute(const AValue: TDateTime): Word;
+
+Var
+ H,M,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,Result,MS);
+end;
+
+
+Function MilliSecondOfTheMinute(const AValue: TDateTime): LongWord;
+
+Var
+ H,S,M,MS : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,MS);
+ Result:=S*1000+MS;
+end;
+
+{ ---------------------------------------------------------------------
+ Part of second functions.
+ ---------------------------------------------------------------------}
+
+Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
+
+Var
+ H,M,S : Word;
+
+begin
+ DecodeTime(AValue,H,M,S,Result);
+end;
+
+{ ---------------------------------------------------------------------
+ Range checking functions.
+ ---------------------------------------------------------------------}
+
+Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
+begin
+ Result:=YearsBetween(ANow,AThen)<=AYears;
+end;
+
+
+Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
+begin
+ Result:=MonthsBetween(ANow,AThen)<=AMonths;
+end;
+
+
+Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
+begin
+ Result:=WeeksBetween(ANow,AThen)<=AWeeks;
+end;
+
+
+Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
+begin
+ Result:=DaysBetween(ANow,AThen)<=ADays;
+end;
+
+
+Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
+begin
+ Result:=HoursBetween(ANow,AThen)<=AHours;
+end;
+
+
+Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
+begin
+ Result:=MinutesBetween(ANow,AThen)<=AMinutes;
+end;
+
+
+Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
+begin
+ Result:=SecondsBetween(ANow,Athen)<=ASeconds;
+end;
+
+
+Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
+begin
+ Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
+end;
+
+
+{ ---------------------------------------------------------------------
+ Period functions.
+ ---------------------------------------------------------------------}
+
+{
+ These functions are declared as approximate by Borland.
+ A bit strange, since it can be calculated exactly ?
+}
+
+
+Function YearsBetween(const ANow, AThen: TDateTime): Integer;
+begin
+ Result:=Trunc(Abs(ANow-AThen)/ApproxDaysPerYear);
+end;
+
+
+Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
+begin
+ Result:=Trunc(Abs(ANow-Athen)/ApproxDaysPerMonth);
+end;
+
+
+Function WeeksBetween(const ANow, AThen: TDateTime): Integer;
+begin
+ Result:=Trunc(Abs(ANow-AThen)) div 7;
+end;
+
+
+Function DaysBetween(const ANow, AThen: TDateTime): Integer;
+begin
+ Result:=Trunc(Abs(ANow-AThen));
+end;
+
+
+Function HoursBetween(const ANow, AThen: TDateTime): Int64;
+begin
+ Result:=Trunc(Abs(ANow-AThen)*HoursPerDay);
+end;
+
+
+Function MinutesBetween(const ANow, AThen: TDateTime): Int64;
+begin
+ Result:=Trunc(Abs(ANow-AThen)*MinsPerDay);
+end;
+
+
+Function SecondsBetween(const ANow, AThen: TDateTime): Int64;
+begin
+ Result:=Trunc(Abs(ANow-AThen)*SecsPerDay);
+end;
+
+
+Function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;
+begin
+ Result:=Trunc(Abs(ANow-AThen)*MSecsPerDay);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Timespan in xxx functions.
+ ---------------------------------------------------------------------}
+
+Function YearSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(Anow-Athen)/ApproxDaysPerYear;
+end;
+
+
+Function MonthSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen)/ApproxDaysPerMonth;
+end;
+
+
+Function WeekSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen) / 7
+end;
+
+
+Function DaySpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen);
+end;
+
+
+Function HourSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen)*HoursPerDay;
+end;
+
+
+Function MinuteSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen)*MinsPerDay;
+end;
+
+
+Function SecondSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen)*SecsPerDay;
+end;
+
+
+Function MilliSecondSpan(const ANow, AThen: TDateTime): Double;
+begin
+ Result:=Abs(ANow-AThen)*MSecsPerDay;
+end;
+
+
+{ ---------------------------------------------------------------------
+ Increment/decrement functions.
+ ---------------------------------------------------------------------}
+
+
+Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+
+begin
+ DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
+ Y:=Y+ANumberOfYears;
+ If (M=2) and (D=29) And (Not IsLeapYear(Y)) then
+ D:=28;
+ Result:=EncodeDateTime(Y,M,D,H,N,S,MS);
+end;
+
+
+Function IncYear(const AValue: TDateTime): TDateTime; // ; const ANumberOfYears: Integer = 1)
+begin
+ Result:=IncYear(Avalue,1);
+end;
+
+
+Function IncWeek(const AValue: TDateTime; const ANumberOfWeeks: Integer): TDateTime;
+begin
+ Result:=AValue+ANumberOfWeeks*7;
+end;
+
+
+Function IncWeek(const AValue: TDateTime): TDateTime; // ; const ANumberOfWeeks: Integer = 1)
+begin
+ Result:=IncWeek(Avalue,1);
+end;
+
+
+Function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer): TDateTime;
+begin
+ Result:=AValue+ANumberOfDays;
+end;
+
+
+Function IncDay(const AValue: TDateTime): TDateTime; //; const ANumberOfDays: Integer = 1)
+begin
+ Result:=IncDay(Avalue,1);
+end;
+
+
+Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
+begin
+ Result:=AValue+ANumberOfHours/HoursPerDay;
+end;
+
+
+Function IncHour(const AValue: TDateTime): TDateTime; //; const ANumberOfHours: Int64 = 1
+begin
+ Result:=IncHour(AValue,1);
+end;
+
+
+Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
+begin
+ Result:=AValue+ANumberOfMinutes / MinsPerDay;
+end;
+
+
+Function IncMinute(const AValue: TDateTime): TDateTime; // ; const ANumberOfMinutes: Int64 = 1
+begin
+ Result:=IncMinute(AValue,1);
+end;
+
+
+Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
+begin
+ Result:=AValue+ANumberOfSeconds / SecsPerDay;
+end;
+
+
+Function IncSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfSeconds: Int64 = 1
+begin
+ Result:=IncSecond(Avalue,1);
+end;
+
+
+Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
+begin
+ Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay;
+end;
+
+
+Function IncMilliSecond(const AValue: TDateTime): TDateTime; // ; const ANumberOfMilliSeconds: Int64 = 1
+begin
+ Result:=IncMilliSecond(AValue,1);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Encode/Decode of complete timestamp
+ ---------------------------------------------------------------------}
+
+
+Function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
+begin
+ If Not TryEncodeDateTime(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond,Result) then
+ InvalidDateTimeError(AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond)
+end;
+
+
+Procedure DecodeDateTime(const AValue: TDateTime; var AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);
+begin
+ DecodeDate(AValue,AYear,AMonth,ADay);
+ DecodeTime(AValue,AHour,AMinute,ASecond,AMilliSecond);
+end;
+
+
+Function TryEncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AValue: TDateTime): Boolean;
+
+Var
+ tmp : TDateTime;
+
+begin
+ Result:=TryEncodeDate(AYear,AMonth,ADay,AValue);
+ Result:=Result and TryEncodeTime(AHour,AMinute,ASecond,Amillisecond,Tmp);
+ If Result then
+ Avalue:=AValue+Tmp;
+end;
+
+{ ---------------------------------------------------------------------
+ Encode/decode date, specifying week of year and day of week
+ ---------------------------------------------------------------------}
+
+Function EncodeDateWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+begin
+ If Not TryEncodeDateWeek(AYear,AWeekOfYear,Result,ADayOfWeek) then
+ InvalidDateWeekError(AYear,AWeekOfYear,ADayOfWeek);
+end;
+
+
+Function EncodeDateWeek(const AYear, AWeekOfYear: Word): TDateTime; //; const ADayOfWeek: Word = 1
+begin
+ Result := EncodeDateWeek(AYear,AWeekOfYear,1);
+end;
+
+
+Procedure DecodeDateWeek(const AValue: TDateTime; var AYear, AWeekOfYear, ADayOfWeek: Word);
+
+var
+ DOY : Integer;
+ D: Word;
+ YS : TDateTime;
+ YSDOW, YEDOW: Word;
+
+begin
+ AYear:=YearOf(AValue);
+ // Correct to ISO DOW
+ ADayOfWeek:=DayOfWeek(AValue)-1;
+ If ADAyOfWeek=0 then
+ ADayofweek:=7;
+ YS:=StartOfAYear(AYear);
+ DOY:=Trunc(AValue-YS)+1;
+ YSDOW:=DayOfTheWeek(YS);
+ // Correct week if later than wednesday. First week never starts later than wednesday
+ if (YSDOW<5) then
+ Inc(DOY,YSDOW-1)
+ else
+ Dec(DOY,8-YSDOW);
+ if (DOY<=0) then // Day is in last week of previous year.
+ DecodeDateWeek(YS-1,AYear,AWeekOfYear,D)
+ else
+ begin
+ AWeekOfYear:=DOY div 7;
+ if ((DOY mod 7)<>0) then
+ Inc(AWeekOfYear);
+ if (AWeekOfYear>52) then // Maybe in first week of next year ?
+ begin
+ YEDOW:=YSDOW;
+ if IsLeapYear(AYear) then
+ begin
+ Inc(YEDOW);
+ if (YEDOW>7) then
+ YEDOW:=1
+ else
+ end;
+ if (YEDOW<4) then // Really next year.
+ begin
+ Inc(AYear);
+ AWeekOfYear:=1;
+ end;
+ end;
+ end;
+end;
+
+
+
+Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime; const ADayOfWeek: Word): Boolean;
+
+Var
+ DOW : Word;
+ Rest : Integer;
+
+begin
+ Result:=IsValidDateWeek(Ayear,AWeekOfYear,ADayOfWeek);
+ If Result then
+ begin
+ AValue:=EncodeDate(AYear,1,1)+(7*(AWeekOfYear-1));
+ DOW:=DayOfTheWeek(AValue);
+ Rest:=ADayOfWeek-DOW;
+ If (DOW>4) then
+ Inc(Rest,7);
+ AValue:=AValue+Rest;
+ end;
+end;
+
+
+Function TryEncodeDateWeek(const AYear, AWeekOfYear: Word; var AValue: TDateTime): Boolean; //; const ADayOfWeek: Word = 1
+begin
+ Result:=TryEncodeDateWeek(AYear,AWeekOfYear,AValue,1);
+end;
+
+{ ---------------------------------------------------------------------
+ Encode/decode date, specifying day of year
+ ---------------------------------------------------------------------}
+
+Function EncodeDateDay(const AYear, ADayOfYear: Word): TDateTime;
+begin
+ If Not TryEncodeDateDay(AYear,ADayOfYear,Result) then
+ InvalidDateDayError(AYear,ADayOfYear);
+end;
+
+
+Procedure DecodeDateDay(const AValue: TDateTime; var AYear, ADayOfYear: Word);
+
+Var
+ M,D : Word;
+
+begin
+ DecodeDate(AValue,AYear,M,D);
+ ADayOfyear:=Trunc(AValue-EncodeDate(AYear,1,1))+1;
+end;
+
+
+Function TryEncodeDateDay(const AYear, ADayOfYear: Word; var AValue: TDateTime): Boolean;
+begin
+ Result:=(ADayOfYear<>0) and (ADayOfYear<=DaysPerYear [IsleapYear(AYear)]);
+ If Result then
+ AValue:=EncodeDate(AYear,1,1)+ADayOfYear-1;
+end;
+
+
+{ ---------------------------------------------------------------------
+ Encode/decode date, specifying week of month
+ ---------------------------------------------------------------------}
+
+
+Function EncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word): TDateTime;
+begin
+ If Not TryEncodeDateMonthWeek(Ayear,AMonth,AWeekOfMonth,ADayOfWeek,Result) then
+ InvalidDateMonthWeekError(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
+end;
+
+Procedure DecodeDateMonthWeek(const AValue: TDateTime; var AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
+
+Var
+ D,SDOM,EDOM : Word;
+ SOM : TdateTime;
+ DOM : Integer;
+begin
+ DecodeDate(AValue,AYear,AMonth,D);
+ ADayOfWeek:=DayOfTheWeek(AValue);
+ SOM:=EncodeDate(Ayear,Amonth,1);
+ SDOM:=DayOfTheWeek(SOM);
+ DOM:=D-1+SDOM;
+ If SDOM>4 then
+ Dec(DOM,7);
+ // Too early in the month. First full week is next week, day is after thursday.
+ If DOM<=0 Then
+ DecodeDateMonthWeek(SOM-1,AYear,AMonth,AWeekOfMonth,D)
+ else
+ begin
+ AWeekOfMonth:=(DOM div 7)+Ord((DOM mod 7)<>0);
+ EDOM:=DayOfTheWeek(EndOfAMonth(Ayear,AMonth));
+ // In last days of last long week, so in next month...
+ If (EDOM<4) and ((DaysInAMonth(AYear,Amonth)-D)<EDOM) then
+ begin
+ AWeekOfMonth:=1;
+ Inc(AMonth);
+ If (AMonth=13) then
+ begin
+ AMonth:=1;
+ Inc(AYear);
+ end;
+ end;
+ end;
+end;
+
+Function TryEncodeDateMonthWeek(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
+
+var
+ S : Word;
+ DOM : Integer;
+
+begin
+ Result:=IsValidDateMonthWeek(AYear,AMonth,AWeekOfMonth,ADayOfWeek);
+ if Result then
+ begin
+ AValue:=EncodeDate(AYear,AMonth,1);
+ DOM:=(AWeekOfMonth-1)*7+ADayOfWeek-1;
+ { Correct for first week in last month.}
+ S:=DayOfTheWeek(AValue);
+ Dec(DOM,S-1);
+ if S in [DayFriday..DaySunday] then
+ Inc(DOM,7);
+ AValue:=AValue+DOM;
+ end;
+end;
+
+
+{ ---------------------------------------------------------------------
+ Replace given element with supplied value.
+ ---------------------------------------------------------------------}
+
+Const
+ LFAI = RecodeLeaveFieldAsIS; // Less typing, readable code
+{
+ Note: We have little choice but to implement it like Borland did:
+ If AValue contains some 'wrong' value, it will throw an error.
+ To simulate this we'd have to check in each function whether
+ both arguments are correct. To avoid it, all is routed through
+ the 'central' RecodeDateTime function as in Borland's implementation.
+}
+
+Function RecodeYear(const AValue: TDateTime; const AYear: Word): TDateTime;
+
+begin
+ Result := RecodeDateTime(AValue,AYear,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI);
+end;
+
+
+Function RecodeMonth(const AValue: TDateTime; const AMonth: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,AMonth,LFAI,LFAI,LFAI,LFAI,LFAI);
+end;
+
+
+Function RecodeDay(const AValue: TDateTime; const ADay: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,LFAI,ADay,LFAI,LFAI,LFAI,LFAI);
+end;
+
+
+Function RecodeHour(const AValue: TDateTime; const AHour: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,LFAI,LFAI,LFAI);
+end;
+
+
+Function RecodeMinute(const AValue: TDateTime; const AMinute: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,AMinute,LFAI,LFAI);
+end;
+
+
+Function RecodeSecond(const AValue: TDateTime; const ASecond: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,ASecond,LFAI);
+end;
+
+
+Function RecodeMilliSecond(const AValue: TDateTime; const AMilliSecond: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,LFAI,LFAI,LFAI,AMilliSecond);
+end;
+
+
+Function RecodeDate(const AValue: TDateTime; const AYear, AMonth, ADay: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,AYear,AMonth,ADay,LFAI,LFAI,LFAI,LFAI);
+end;
+
+
+Function RecodeTime(const AValue: TDateTime; const AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
+begin
+ Result := RecodeDateTime(AValue,LFAI,LFAI,LFAI,AHour,AMinute,ASecond,AMilliSecond);
+end;
+
+
+Function RecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word): TDateTime;
+begin
+ If Not TryRecodeDateTime(AValue,AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,Result) then
+ InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,AValue);
+end;
+
+
+Function TryRecodeDateTime(const AValue: TDateTime; const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; var AResult: TDateTime): Boolean;
+
+ Procedure FV (Var AV : Word; Arg : Word);
+
+ begin
+ If (Arg<>LFAI) then
+ AV:=Arg;
+ end;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+
+begin
+ DecodeDateTime(AValue,Y,M,D,H,N,S,MS);
+ FV(Y,AYear);
+ FV(M,AMonth);
+ FV(D,ADay);
+ FV(H,AHour);
+ FV(N,AMinute);
+ FV(S,ASecond);
+ FV(MS,AMillisecond);
+ Result:=TryEncodeDateTime(Y,M,D,H,N,S,MS,AResult);
+end;
+
+{ ---------------------------------------------------------------------
+ Comparision of date/time
+ ---------------------------------------------------------------------}
+
+
+Function CompareDateTime(const A, B: TDateTime): TValueRelationship;
+begin
+ If SameDateTime(A,B) then
+ Result:=EqualsValue
+ else If A>B then
+ Result:=GreaterThanValue
+ else
+ Result:=LessThanValue
+end;
+
+
+Function CompareDate(const A, B: TDateTime): TValueRelationship;
+begin
+ If SameDate(A,B) then
+ Result:=EQualsValue
+ else if A<B then
+ Result:=LessThanValue
+ else
+ Result:=GreaterThanValue;
+end;
+
+
+Function CompareTime(const A, B: TDateTime): TValueRelationship;
+
+begin
+ If SameTime(A,B) then
+ Result:=EQualsValue
+ else If Frac(A)<Frac(B) then
+ Result:=LessThanValue
+ else
+ Result:=GreaterThanValue;
+end;
+
+
+Function SameDateTime(const A, B: TDateTime): Boolean;
+begin
+ Result:=Abs(A-B)<OneMilliSecond;
+end;
+
+
+Function SameDate(const A, B: TDateTime): Boolean;
+begin
+ Result:=Trunc(A)=Trunc(B);
+end;
+
+
+Function SameTime(const A, B: TDateTime): Boolean;
+
+begin
+ Result:=Frac(Abs(A-B))<OneMilliSecond;
+end;
+
+
+Function InternalNthDayOfWeek(DoM : Word) : Word;
+
+begin
+ Result:=(Dom-1) div 7 +1;
+end;
+
+Function NthDayOfWeek(const AValue: TDateTime): Word;
+
+begin
+ Result:=InternalNthDayOfWeek(DayOfTheMonth(AValue));
+end;
+
+
+Procedure DecodeDayOfWeekInMonth(const AValue: TDateTime; var AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
+
+var
+ D: Word;
+
+begin
+ DecodeDate(AValue,AYear,AMonth,D);
+ ADayOfWeek:=DayOfTheWeek(AValue);
+ ANthDayOfWeek:=InternalNthDayOfWeek(D);
+end;
+
+
+Function EncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word): TDateTime;
+begin
+ If Not TryEncodeDayOfWeekInMonth(AYear,AMonth,ANthDayOfWeek,ADayOfWeek,Result) then
+ InvalidDayOfWeekInMonthError(AYear,AMonth,ANthDayOfWeek,ADayOfWeek);
+end;
+
+
+Function TryEncodeDayOfWeekInMonth(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word; var AValue: TDateTime): Boolean;
+
+Var
+ SOM,D : Word;
+
+begin
+ SOM:=DayOfTheWeek(EncodeDate(Ayear,AMonth,1));
+ D:=1+ADayOfWeek-SOM+7*(ANthDayOfWeek-1);
+ If SOM>ADayOfWeek then
+ D:=D+7; // Clearer would have been Inc(ANthDayOfweek) but it's a const
+ Result:=TryEncodeDate(Ayear,AMonth,D,AValue);
+end;
+
+{ ---------------------------------------------------------------------
+ Exception throwing routines
+ ---------------------------------------------------------------------}
+
+
+
+Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; const ABaseDate: TDateTime);
+
+ Function DoField(Arg,Def : Word; Unknown: String) : String;
+
+ begin
+ If (Arg<>LFAI) then
+ Result:=Format('%.*d',[Length(Unknown),Arg])
+ else if (ABaseDate=0) then
+ Result:=Unknown
+ else
+ Result:=Format('%.*d',[Length(Unknown),Arg]);
+ end;
+
+Var
+ Y,M,D,H,N,S,MS : Word;
+ Msg : String;
+
+begin
+ DecodeDateTime(ABasedate,Y,M,D,H,N,S,MS);
+ Msg:=DoField(AYear,Y,'????');
+ Msg:=Msg+DateSeparator+DoField(AMonth,M,'??');
+ Msg:=Msg+DateSeparator+DoField(ADay,D,'??');
+ Msg:=Msg+' '+DoField(AHour,H,'??');
+ Msg:=Msg+TimeSeparator+DoField(AMinute,N,'??');
+ Msg:=Msg+TimeSeparator+Dofield(ASecond,S,'??');
+ Msg:=Msg+DecimalSeparator+DoField(AMilliSecond,MS,'???');
+ Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[Msg]);
+end;
+
+
+Procedure InvalidDateTimeError(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word); // const ABaseDate: TDateTime = 0
+begin
+ InvalidDateTimeError(AYear,AMonth,ADay,AHour,AMinute,ASecond,AMilliSecond,0);
+end;
+
+
+Procedure InvalidDateWeekError(const AYear, AWeekOfYear, ADayOfWeek: Word);
+begin
+ Raise EConvertError.CreateFmt(SErrInvalidDateWeek,[AYear,AWeekOfYear,ADayOfWeek]);
+end;
+
+
+Procedure InvalidDateDayError(const AYear, ADayOfYear: Word);
+begin
+ Raise EConvertError.CreateFmt(SErrInvalidDayOfYear,[AYear,ADayOfYear]);
+end;
+
+
+Procedure InvalidDateMonthWeekError(const AYear, AMonth, AWeekOfMonth, ADayOfWeek: Word);
+begin
+ Raise EConvertError.CreateFmt(SErrInvalidDateMonthWeek,[Ayear,AMonth,AWeekOfMonth,ADayOfWeek]);
+end;
+
+
+Procedure InvalidDayOfWeekInMonthError(const AYear, AMonth, ANthDayOfWeek, ADayOfWeek: Word);
+
+begin
+ Raise EConvertError.CreateFmt(SErrInvalidDayOfWeekInMonth,[AYear,AMonth,ANthDayOfWeek,ADayOfWeek]);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Julian and Modified Julian Date conversion support
+ ---------------------------------------------------------------------}
+
+
+Function DateTimeToJulianDate(const AValue: TDateTime): Double;
+begin
+ NotYetImplemented('DateTimeToJulianDate');
+end;
+
+
+Function JulianDateToDateTime(const AValue: Double): TDateTime;
+begin
+ NotYetImplemented('JulianDateToDateTime');
+end;
+
+
+Function TryJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
+
+begin
+ NotYetImplemented('TryJulianDateToDateTime');
+end;
+
+
+Function DateTimeToModifiedJulianDate(const AValue: TDateTime): Double;
+begin
+ NotYetImplemented('DateTimeToModifiedJulianDate');
+end;
+
+
+Function ModifiedJulianDateToDateTime(const AValue: Double): TDateTime;
+begin
+ NotYetImplemented('ModifiedJulianDateToDateTime');
+end;
+
+
+Function TryModifiedJulianDateToDateTime(const AValue: Double; var ADateTime: TDateTime): Boolean;
+
+begin
+ NotYetImplemented('TryModifiedJulianDateToDateTime');
+end;
+
+{ ---------------------------------------------------------------------
+ Unix timestamp support.
+ ---------------------------------------------------------------------}
+
+Function DateTimeToUnix(const AValue: TDateTime): Int64;
+begin
+ NotYetImplemented('DateTimeToUnix');
+end;
+
+
+Function UnixToDateTime(const AValue: Int64): TDateTime;
+
+begin
+ NotYetImplemented('UnixToDateTime');
+end;
+
+end.
+
+{
+ $Log: dateutil.inc,v $
+ Revision 1.12 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.11 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/dateutil.pp b/rtl/objpas/dateutil.pp
new file mode 100644
index 0000000000..ca8f34f8f2
--- /dev/null
+++ b/rtl/objpas/dateutil.pp
@@ -0,0 +1 @@
+{$I dateutil.inc}
diff --git a/rtl/objpas/dateutils.pp b/rtl/objpas/dateutils.pp
new file mode 100644
index 0000000000..ca8f34f8f2
--- /dev/null
+++ b/rtl/objpas/dateutils.pp
@@ -0,0 +1 @@
+{$I dateutil.inc}
diff --git a/rtl/objpas/freebidi.pp b/rtl/objpas/freebidi.pp
new file mode 100644
index 0000000000..d66e758b4b
--- /dev/null
+++ b/rtl/objpas/freebidi.pp
@@ -0,0 +1,337 @@
+{
+Author Mazen NEIFER
+Licence LGPL
+}
+unit FreeBIDI;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+ TCharacter = WideChar;
+ TString = WideString;
+ TDirection=(
+ drNONE,
+ drRTL,
+ drLTR
+ );
+ TVisualToLogical = Array[Byte]Of Byte;
+ TFontInfoPtr = Pointer;
+ TCharWidthRoutine = function(Character:TCharacter;FontInfo:TFontInfoPtr):Integer;
+
+var
+ FontInfoPtr:TFontInfoPtr;
+ CharWidth:TCharWidthRoutine;
+
+{****************************Logical aspects***********************************}
+{Returns the number of logical characters}
+function LLength(const Src:TString):Cardinal;
+{Converts visual position to logical position}
+function LPos(const Src:TString; vp:Integer; pDir:TDirection):Cardinal;
+{****************************Visual aspects************************************}
+{Returns the number of visual characters}
+function VLength(const Src:TString; pDir:TDirection):Cardinal;
+{Converts a logical position to a visual position}
+function VPos(const Src:TString; lp:Integer; pDir, cDir:TDirection):Cardinal;
+function VPos(UTF8Char:PChar; Len:integer; BytePos:integer):Cardinal;
+{Returns character at a given visual position according to paragraph direction}
+function VCharOf(Src:TString; vp:Integer; dir:TDirection):TCharacter;
+{Inserts a string into an other paying attention of RTL/LTR direction}
+procedure VInsert(const Src:TString; var Dest:TString; vp:Integer; pDir:TDirection);
+{Deletes a string into an other paying attention of RTL/LTR direction}
+procedure VDelete(var str:TString; vp, len:Integer; pDir:TDirection);
+{Resturns a sub string of source string}
+//function VCopy(const Src:TString; vStart, vWidth:Integer):TString;
+{Resturns the visual image of current string}
+function VStr(const Src:TString; pDir:TDirection):TString;
+{****************************Helper routines***********************************}
+{Returns direction of a character}
+function DirectionOf(Character:TCharacter):TDirection;
+{Returns contextual direction of caracter in a string}
+function DirectionOf(Src:TString; lp:Integer; pDir:TDirection):TDirection;
+{Inserts a char as if it was typed using keyboard in the most user friendly way.
+Returns the new cursor position after insersion depending on the new visual text}
+function InsertChar(Src:TCharacter; var Dest:TString; vp:Integer; pDir:TDirection):Integer;
+{Returns a table mapping each visual position to its logical position in an UTF8*
+string}
+function VisualToLogical(const Src:TString; pDir:TDirection):TVisualToLogical;
+
+implementation
+
+function DefaultCharWidth(Character:TCharacter; FontInfoPtr:TFontInfoPtr):Integer;
+begin
+ case Character of
+ #9:
+ Result := 8;
+ else
+ Result := 1;
+ end;
+end;
+function DumpStr(const Src:TString):String;
+var
+ i:Integer;
+begin
+ Result := '';
+ for i:= 1 to Length(Src) do
+ case Src[i] of
+ #0..#127:
+ Result := Result + Src[i];
+ else
+ Result := Result + '$' + HexStr(Ord(Src[i]),4);
+ end;
+end;
+function ComputeCharLength(p:PChar):Cardinal;
+begin
+ if ord(p^)<%11000000
+ then
+{regular single byte character (#0 is a normal char, this is UTF8Charascal ;)}
+ Result:=1
+ else if ((ord(p^) and %11100000) = %11000000)
+ then
+ if (ord(p[1]) and %11000000) = %10000000 then
+ Result:=2
+ else
+ Result:=1
+ else if ((ord(p^) and %11110000) = %11100000)
+ then
+ if ((ord(p[1]) and %11000000) = %10000000)
+ and ((ord(p[2]) and %11000000) = %10000000)
+ then
+ Result:=3
+ else
+ Result:=1
+ else if ((ord(p^) and %11111000) = %11110000)
+ then
+ if ((ord(p[1]) and %11000000) = %10000000)
+ and ((ord(p[2]) and %11000000) = %10000000)
+ and ((ord(p[3]) and %11000000) = %10000000)
+ then
+ Result:=4
+ else
+ Result:=1
+ else
+ Result:=1
+end;
+
+{****************************Logical aspects***********************************}
+function LLength(const Src:TString):Cardinal;
+begin
+ Result := Length(Src);
+end;
+
+function LPos(const Src:TString; vp:Integer; pDir:TDirection):Cardinal;
+var
+ v2l:TVisualToLogical;
+ i:integer;
+begin
+ v2l := VisualToLogical(Src, pDir);
+ if vp <= v2l[0]
+ then
+ Result := v2l[vp]
+ else
+ Result := Length(Src) + 1;
+end;
+
+{****************************Visual aspects************************************}
+function VLength(const Src:TString; pDir:TDirection):Cardinal;
+var
+ Count:Integer;
+begin
+ Result := 0;
+ Count := Length(Src);
+ while (Count > 0) do
+ begin
+ Result += CharWidth(Src[Count], FontInfoPtr);
+ Count -= 1;
+ end;
+end;
+
+function VPos(const Src:TString; lp:Integer; pDir, cDir:TDirection):Cardinal;
+var
+ v2l:TVisualToLogical;
+ vp:Integer;
+begin
+ v2l := VisualToLogical(Src, pDir);
+ for vp := 1 to v2l[0] do
+ if lp = v2l[vp]
+ then
+ begin
+ Exit(vp);
+ end;
+ Result := v2l[0];
+end;
+
+function VPos(UTF8Char:PChar; Len:integer; BytePos:integer):Cardinal;
+begin
+end;
+
+
+function VCharOf(Src:TString; vp:Integer; dir:TDirection):TCharacter;
+var
+ CharLen: LongInt;
+begin
+ Result := Src[LPos(Src, vp, dir)];
+end;
+
+{****************************Helper routines***********************************}
+function DirectionOf(Character:TCharacter):TDirection;
+begin
+ case Character of
+ #9,#32,
+ '/',
+ '{','}',
+ '[',']',
+ '(',')':
+ Result := drNONE;
+ #$0590..#$05FF, //Hebrew
+ #$0600..#$06FF: //Arabic
+ Result := drRTL;
+ else
+ Result := drLTR;
+ end;
+end;
+
+function DirectionOf(Src:TString; lp:Integer; pDir:TDirection):TDirection;
+var
+ c:TCharacter;
+ lDir,rDir:TDirection;
+ p:Integer;
+begin
+ if(lp <= 0)
+ then
+ lp := 1;
+{Seek for proper character direction}
+ c := Src[lp];
+ lDir := DirectionOf(c);
+{Seek for left character direction if it is neutral}
+ p := lp;
+ while(p > 1) and (lDir = drNONE)do
+ begin
+ c := Src[p - 1];
+ lDir := DirectionOf(c);
+ p := p - Length(c);
+ end;
+{Seek for right character direction if it is neutral}
+ p := lp;
+ repeat
+ c := Src[p];
+ rDir := DirectionOf(c);
+ p := p + Length(c);
+ until(p > Length(Src)) or (rDir <> drNONE);
+ if(lDir = rDir)
+ then
+ Result := rDir
+ else
+ Result := pDir;
+end;
+
+function VisualToLogical(const Src:TString; pDir:TDirection):TVisualToLogical;
+ procedure Insert(value:Byte; var v2l:TVisualToLogical; InsPos:Byte);
+ var
+ l:Byte;
+ begin
+ if v2l[0] < 255
+ then
+ Inc(InsPos);
+ if InsPos > v2l[0]
+ then
+ InsPos := v2l[0];
+ for l := v2l[0] downto InsPos do
+ v2l[l] := v2l[l-1];
+ v2l[InsPos] := Value;
+ end;
+var
+ lp, vp : Integer;
+ cDir,lDir:TDirection;
+ Character:TCharacter;
+i:Integer;
+begin
+ Result[0] := 0;
+ lp := 1;
+ vp := 1;
+ lDir := drNONE;
+ while lp <= Length(Src) do
+ begin
+ Character := Src[lp];
+ cDir := DirectionOf(Src, lp, pDir);
+ Inc(Result[0]);
+ case cDir of
+ drRTL:
+ begin
+ lDir := drRTL;
+ end;
+ drLTR:
+ begin
+ lDir := drLTR;
+ vp := Result[0];
+ end;
+ else
+ vp := Result[0];
+ end;
+ Insert(lp, Result, vp);
+ lp += 1;
+ end;
+end;
+
+function InsertChar(Src:TCharacter; var Dest:TString; vp:Integer; pDir:TDirection):Integer;
+var
+ vSrc,vDest:TString;
+begin
+ vSrc := VStr(Src,pDir);
+ vDest := VStr(Dest,pDir);
+ Insert(vSrc, vDest, vp);
+ Dest := VStr(vDest, pDir);
+ case DirectionOf(Src) of
+ drRTL:
+ Result := vp;
+ drLTR:
+ Result := vp + 1;
+ else
+ if(vp < Length(vDest)) and (DirectionOf(vDest[vp + 1]) = drRTL)
+ then
+ Result := vp
+ else
+ Result := vp + 1;
+ end;
+end;
+
+procedure VInsert(const Src:TString;var Dest:TString; vp:Integer; pDir:TDirection);
+var
+ vSrc,vDest:TString;
+begin
+ vSrc := VStr(Src,pDir);
+ vDest := VStr(Dest,pDir);
+ Insert(vSrc, vDest, vp);
+ Dest := VStr(vDest, pDir);
+end;
+
+procedure VDelete(var str:TString; vp, len:Integer; pDir:TDirection);
+var
+ v2l:TVisualToLogical;
+ i:Integer;
+begin
+ v2l := VisualToLogical(str, pDir);
+ for i := 1 to v2l[0] do
+ if(v2l[i] >= vp) and (v2l[i] < vp + len)
+ then
+ Delete(str, v2l[i], 1);
+end;
+
+function VStr(const Src:TString; pDir:TDirection):TString;
+var
+ v2lSrc:TVisualToLogical;
+ vp:Integer;
+begin
+ v2lSrc := VisualToLogical(Src,pDir);
+ SetLength(Result, v2lSrc[0]);
+ for vp := 1 to v2lSrc[0] do
+ Result[vp] := Src[v2lSrc[vp]];
+end;
+
+initialization
+
+ CharWidth := @DefaultCharWidth;
+
+end.
+
diff --git a/rtl/objpas/math.pp b/rtl/objpas/math.pp
new file mode 100644
index 0000000000..0cce6c1c40
--- /dev/null
+++ b/rtl/objpas/math.pp
@@ -0,0 +1,1415 @@
+{
+ $Id: math.pp,v 1.32 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ This unit is an equivalent to the Delphi math unit
+ (with some improvements)
+
+ What's to do:
+ o a lot of function :), search for !!!!
+ o some statistical functions
+ o all financial functions
+ o optimizations
+}
+
+unit math;
+interface
+
+{$MODE objfpc}
+{$ifdef VER1_0}
+ { we don't assume cross compiling from 1.0.x-m68k ... }
+ {$define FPC_HAS_TYPE_EXTENDED}
+{$endif VER1_0}
+
+ uses
+ sysutils;
+
+ { Ranges of the IEEE floating point types, including denormals }
+{$ifdef FPC_HAS_TYPE_SINGLE}
+ const
+ MinSingle = 1.5e-45;
+ MaxSingle = 3.4e+38;
+{$endif FPC_HAS_TYPE_SINGLE}
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+ const
+ MinDouble = 5.0e-324;
+ MaxDouble = 1.7e+308;
+{$endif FPC_HAS_TYPE_DOUBLE}
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+ const
+ MinExtended = 3.4e-4932;
+ MaxExtended = 1.1e+4932;
+{$endif FPC_HAS_TYPE_EXTENDED}
+{$ifdef FPC_HAS_TYPE_COMP}
+ const
+ MinComp = -9.223372036854775807e+18;
+ MaxComp = 9.223372036854775807e+18;
+{$endif FPC_HAS_TYPE_COMP}
+
+ { the original delphi functions use extended as argument, }
+ { but I would prefer double, because 8 bytes is a very }
+ { natural size for the processor }
+ { WARNING : changing float type will }
+ { break all assembler code PM }
+{$ifdef FPC_HAS_TYPE_FLOAT128}
+ type
+ float = float128;
+
+ const
+ MinFloat = MinFloat128;
+ MaxFloat = MaxFloat128;
+{$else FPC_HAS_TYPE_FLOAT128}
+ {$ifdef FPC_HAS_TYPE_EXTENDED}
+ type
+ float = extended;
+
+ const
+ MinFloat = MinExtended;
+ MaxFloat = MaxExtended;
+ {$else FPC_HAS_TYPE_EXTENDED}
+ {$ifdef FPC_HAS_TYPE_DOUBLE}
+ type
+ float = double;
+
+ const
+ MinFloat = MinDouble;
+ MaxFloat = MaxDouble;
+ {$else FPC_HAS_TYPE_DOUBLE}
+ {$ifdef FPC_HAS_TYPE_SINGLE}
+ type
+ float = single;
+
+ const
+ MinFloat = MinSingle;
+ MaxFloat = MaxSingle;
+ {$else FPC_HAS_TYPE_SINGLE}
+ {$fatal At least one floating point type must be supported}
+ {$endif FPC_HAS_TYPE_SINGLE}
+ {$endif FPC_HAS_TYPE_DOUBLE}
+ {$endif FPC_HAS_TYPE_EXTENDED}
+{$endif FPC_HAS_TYPE_FLOAT128}
+
+ type
+ PFloat = ^Float;
+ PInteger = ^Integer;
+
+ tpaymenttime = (ptendofperiod,ptstartofperiod);
+
+ einvalidargument = class(ematherror);
+
+ TValueRelationship = -1..1;
+
+ const
+ EqualsValue = 0;
+ LessThanValue = Low(TValueRelationship);
+ GreaterThanValue = High(TValueRelationship);
+{$ifndef ver1_0}
+{$ifopt R+}
+{$define RangeCheckWasOn}
+{$R-}
+{$endif opt R+}
+{$ifopt Q+}
+{$define OverflowCheckWasOn}
+{$Q-}
+{$endif opt Q+}
+{$ifdef CPUARM}
+ { the ARM linux emulator doesn't like 0.0/0.0 }
+ NaN = ln(-1.0);
+{$else CPUARM}
+ NaN = 0.0/0.0;
+{$endif CPUARM}
+ Infinity = 1.0/0.0;
+{$ifdef RangeCheckWasOn}
+{$R+}
+{$undef RangeCheckWasOn}
+{$endif}
+{$ifdef OverflowCheckWasOn}
+{$Q+}
+{$undef OverflowCheckWasOn}
+{$endif}
+{$endif ver1_0}
+
+{ Min/max determination }
+function MinIntValue(const Data: array of Integer): Integer;
+function MaxIntValue(const Data: array of Integer): Integer;
+
+{ Extra, not present in Delphi, but used frequently }
+function Min(a, b: Integer): Integer;
+function Max(a, b: Integer): Integer;
+function Min(a, b: Cardinal): Cardinal;
+function Max(a, b: Cardinal): Cardinal;
+function Min(a, b: Int64): Int64;
+function Max(a, b: Int64): Int64;
+{$ifdef FPC_HAS_TYPE_SINGLE}
+function Min(a, b: Single): Single;
+function Max(a, b: Single): Single;
+{$endif FPC_HAS_TYPE_SINGLE}
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function Min(a, b: Double): Double;
+function Max(a, b: Double): Double;
+{$endif FPC_HAS_TYPE_DOUBLE}
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function Min(a, b: Extended): Extended;
+function Max(a, b: Extended): Extended;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+function InRange(const AValue, AMin, AMax: Integer): Boolean;
+function InRange(const AValue, AMin, AMax: Int64): Boolean;
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function InRange(const AValue, AMin, AMax: Double): Boolean;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+function EnsureRange(const AValue, AMin, AMax: Integer): Integer;
+function EnsureRange(const AValue, AMin, AMax: Int64): Int64;
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function EnsureRange(const AValue, AMin, AMax: Double): Double;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+
+procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);
+
+
+// Sign functions
+Type
+ TValueSign = -1..1;
+
+const
+ NegativeValue = Low(TValueSign);
+ ZeroValue = 0;
+ PositiveValue = High(TValueSign);
+
+function Sign(const AValue: Integer): TValueSign;
+function Sign(const AValue: Int64): TValueSign;
+function Sign(const AValue: Double): TValueSign;
+
+function IsZero(const A: Single; Epsilon: Single): Boolean;
+function IsZero(const A: Single): Boolean;
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function IsZero(const A: Double; Epsilon: Double): Boolean;
+function IsZero(const A: Double): Boolean;
+{$endif FPC_HAS_TYPE_DOUBLE}
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function IsZero(const A: Extended; Epsilon: Extended): Boolean;
+function IsZero(const A: Extended): Boolean;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+function IsNan(const d : Double): Boolean;
+function IsInfinite(const d : Double): Boolean;
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function SameValue(const A, B: Extended): Boolean;
+{$endif}
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function SameValue(const A, B: Double): Boolean;
+{$endif}
+function SameValue(const A, B: Single): Boolean;
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function SameValue(const A, B: Extended; Epsilon: Extended): Boolean;
+{$endif}
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function SameValue(const A, B: Double; Epsilon: Double): Boolean;
+{$endif}
+function SameValue(const A, B: Single; Epsilon: Single): Boolean;
+
+
+{ angle conversion }
+
+function degtorad(deg : float) : float;
+function radtodeg(rad : float) : float;
+function gradtorad(grad : float) : float;
+function radtograd(rad : float) : float;
+function degtograd(deg : float) : float;
+function gradtodeg(grad : float) : float;
+{ one cycle are 2*Pi rad }
+function cycletorad(cycle : float) : float;
+function radtocycle(rad : float) : float;
+
+{ trigoniometric functions }
+
+function tan(x : float) : float;
+function cotan(x : float) : float;
+procedure sincos(theta : float;var sinus,cosinus : float);
+
+{ inverse functions }
+
+function arccos(x : float) : float;
+function arcsin(x : float) : float;
+
+{ calculates arctan(y/x) and returns an angle in the correct quadrant }
+function arctan2(y,x : float) : float;
+
+{ hyperbolic functions }
+
+function cosh(x : float) : float;
+function sinh(x : float) : float;
+function tanh(x : float) : float;
+
+{ area functions }
+
+{ delphi names: }
+function arccosh(x : float) : float;
+function arcsinh(x : float) : float;
+function arctanh(x : float) : float;
+{ IMHO the function should be called as follows (FK) }
+function arcosh(x : float) : float;
+function arsinh(x : float) : float;
+function artanh(x : float) : float;
+
+{ triangle functions }
+
+{ returns the length of the hypotenuse of a right triangle }
+{ if x and y are the other sides }
+function hypot(x,y : float) : float;
+
+{ logarithm functions }
+
+function log10(x : float) : float;
+function log2(x : float) : float;
+function logn(n,x : float) : float;
+
+{ returns natural logarithm of x+1 }
+function lnxp1(x : float) : float;
+
+{ exponential functions }
+
+function power(base,exponent : float) : float;
+{ base^exponent }
+function intpower(base : float;const exponent : Integer) : float;
+
+operator ** (bas,expo : float) e: float;
+operator ** (bas,expo : int64) i: int64;
+
+{ number converting }
+
+{ rounds x towards positive infinity }
+function ceil(x : float) : Integer;
+{ rounds x towards negative infinity }
+function floor(x : float) : Integer;
+
+{ misc. functions }
+
+{ splits x into mantissa and exponent (to base 2) }
+procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
+{ returns x*(2^p) }
+function ldexp(x : float; const p : Integer) : float;
+
+{ statistical functions }
+
+function mean(const data : array of float) : float;
+function sum(const data : array of float) : float;
+function mean(const data : PFloat; Const N : longint) : float;
+function sum(const data : PFloat; Const N : Longint) : float;
+function sumofsquares(const data : array of float) : float;
+function sumofsquares(const data : PFloat; Const N : Integer) : float;
+{ calculates the sum and the sum of squares of data }
+procedure sumsandsquares(const data : array of float;
+ var sum,sumofsquares : float);
+procedure sumsandsquares(const data : PFloat; Const N : Integer;
+ var sum,sumofsquares : float);
+function minvalue(const data : array of float) : float;
+function minvalue(const data : array of integer) : Integer;
+function minvalue(const data : PFloat; Const N : Integer) : float;
+function MinValue(const Data : PInteger; Const N : Integer): Integer;
+function maxvalue(const data : array of float) : float;
+function maxvalue(const data : array of integer) : Integer;
+function maxvalue(const data : PFloat; Const N : Integer) : float;
+function maxvalue(const data : PInteger; Const N : Integer) : Integer;
+{ calculates the standard deviation }
+function stddev(const data : array of float) : float;
+function stddev(const data : PFloat; Const N : Integer) : float;
+{ calculates the mean and stddev }
+procedure meanandstddev(const data : array of float;
+ var mean,stddev : float);
+procedure meanandstddev(const data : PFloat;
+ Const N : Longint;var mean,stddev : float);
+function variance(const data : array of float) : float;
+function totalvariance(const data : array of float) : float;
+function variance(const data : PFloat; Const N : Integer) : float;
+function totalvariance(const data : PFloat; Const N : Integer) : float;
+{ returns random values with gaussian distribution }
+function randg(mean,stddev : float) : float;
+
+{ I don't know what the following functions do: }
+function popnstddev(const data : array of float) : float;
+function popnstddev(const data : PFloat; Const N : Integer) : float;
+function popnvariance(const data : PFloat; Const N : Integer) : float;
+function popnvariance(const data : array of float) : float;
+procedure momentskewkurtosis(const data : array of float;
+ var m1,m2,m3,m4,skew,kurtosis : float);
+procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
+ var m1,m2,m3,m4,skew,kurtosis : float);
+
+{ geometrical function }
+
+{ returns the euclidean L2 norm }
+function norm(const data : array of float) : float;
+function norm(const data : PFloat; Const N : Integer) : float;
+
+{$ifndef ver1_0} // default params
+function ifthen(val:boolean;const iftrue:integer; const iffalse:integer= 0) :integer; {$ifdef MATHINLINE}inline; {$endif}
+function ifthen(val:boolean;const iftrue:int64 ; const iffalse:int64 = 0) :int64; {$ifdef MATHINLINE}inline; {$endif}
+function ifthen(val:boolean;const iftrue:double ; const iffalse:double =0.0):double; {$ifdef MATHINLINE}inline; {$endif}
+{$endif}
+
+{ include cpu specific stuff }
+{$i mathuh.inc}
+
+implementation
+
+{ include cpu specific stuff }
+{$i mathu.inc}
+
+ResourceString
+ SMathError = 'Math Error : %s';
+ SInvalidArgument = 'Invalid argument';
+
+Procedure DoMathError(Const S : String);
+begin
+ Raise EMathError.CreateFmt(SMathError,[S]);
+end;
+
+Procedure InvalidArgument;
+
+begin
+ Raise EInvalidArgument.Create(SInvalidArgument);
+end;
+
+
+function Sign(const AValue: Integer): TValueSign;
+
+begin
+ If Avalue<0 then
+ Result:=NegativeValue
+ else If Avalue>0 then
+ Result:=PositiveValue
+ else
+ Result:=ZeroValue;
+end;
+
+function Sign(const AValue: Int64): TValueSign;
+
+begin
+ If Avalue<0 then
+ Result:=NegativeValue
+ else If Avalue>0 then
+ Result:=PositiveValue
+ else
+ Result:=ZeroValue;
+end;
+
+function Sign(const AValue: Double): TValueSign;
+
+begin
+ If Avalue<0.0 then
+ Result:=NegativeValue
+ else If Avalue>0.0 then
+ Result:=PositiveValue
+ else
+ Result:=ZeroValue;
+end;
+
+
+function degtorad(deg : float) : float;
+
+ begin
+ degtorad:=deg*(pi/180.0);
+ end;
+
+function radtodeg(rad : float) : float;
+
+ begin
+ radtodeg:=rad*(180.0/pi);
+ end;
+
+function gradtorad(grad : float) : float;
+
+ begin
+ gradtorad:=grad*(pi/200.0);
+ end;
+
+function radtograd(rad : float) : float;
+
+ begin
+ radtograd:=rad*(200.0/pi);
+ end;
+
+function degtograd(deg : float) : float;
+
+ begin
+ degtograd:=deg*(200.0/180.0);
+ end;
+
+function gradtodeg(grad : float) : float;
+
+ begin
+ gradtodeg:=grad*(180.0/200.0);
+ end;
+
+function cycletorad(cycle : float) : float;
+
+ begin
+ cycletorad:=(2*pi)*cycle;
+ end;
+
+function radtocycle(rad : float) : float;
+
+ begin
+ { avoid division }
+ radtocycle:=rad*(1/(2*pi));
+ end;
+
+function tan(x : float) : float;
+
+ begin
+ Tan:=Sin(x)/Cos(x)
+ end;
+
+function cotan(x : float) : float;
+
+ begin
+ cotan:=Cos(X)/Sin(X);
+ end;
+
+procedure sincos(theta : float;var sinus,cosinus : float);
+
+ begin
+ sinus:=sin(theta);
+ cosinus:=cos(theta);
+ end;
+
+
+
+{ ArcSin and ArcCos from Arjan van Dijk (arjan.vanDijk@User.METAIR.WAU.NL) }
+
+
+function arcsin(x : float) : float;
+begin
+ if abs(x) > 1 then InvalidArgument
+ else if abs(x) < 0.5 then
+ arcsin := arctan(x/sqrt(1-sqr(x)))
+ else
+ arcsin := sign(x) * (pi*0.5 - arctan(sqrt(1 / sqr(x) - 1)));
+end;
+
+function Arccos(x : Float) : Float;
+begin
+ arccos := pi*0.5 - arcsin(x);
+end;
+
+
+{$ifndef FPC_MATH_HAS_ARCTAN2}
+function arctan2(y,x : float) : float;
+ begin
+ if (x=0) then
+ begin
+ if y=0 then
+ arctan2:=0.0
+ else if y>0 then
+ arctan2:=pi/2
+ else if y<0 then
+ arctan2:=-pi/2;
+ end
+ else
+ ArcTan2:=ArcTan(y/x);
+ if x<0.0 then
+ ArcTan2:=ArcTan2+pi;
+ if ArcTan2>pi then
+ ArcTan2:=ArcTan2-2*pi;
+ end;
+{$endif FPC_MATH_HAS_ARCTAN2}
+
+
+function cosh(x : float) : float;
+
+ var
+ temp : float;
+
+ begin
+ temp:=exp(x);
+ cosh:=0.5*(temp+1.0/temp);
+ end;
+
+function sinh(x : float) : float;
+
+ var
+ temp : float;
+
+ begin
+ temp:=exp(x);
+ sinh:=0.5*(temp-1.0/temp);
+ end;
+
+Const MaxTanh = 5678.22249441322; // Ln(MaxExtended)/2
+
+function tanh(x : float) : float;
+
+ var Temp : float;
+
+ begin
+ if x>MaxTanh then exit(1.0)
+ else if x<-MaxTanh then exit (-1.0);
+ temp:=exp(-2*x);
+ tanh:=(1-temp)/(1+temp)
+ end;
+
+function arccosh(x : float) : float;
+
+ begin
+ arccosh:=arcosh(x);
+ end;
+
+function arcsinh(x : float) : float;
+
+ begin
+ arcsinh:=arsinh(x);
+ end;
+
+function arctanh(x : float) : float;
+
+ begin
+ if x>1 then InvalidArgument;
+ arctanh:=artanh(x);
+ end;
+
+function arcosh(x : float) : float;
+
+ begin
+ if x<1 then InvalidArgument;
+ arcosh:=Ln(x+Sqrt(x*x-1));
+ end;
+
+function arsinh(x : float) : float;
+
+ begin
+ arsinh:=Ln(x+Sqrt(1+x*x));
+ end;
+
+function artanh(x : float) : float;
+ begin
+ If abs(x)>1 then InvalidArgument;
+ artanh:=(Ln((1+x)/(1-x)))*0.5;
+ end;
+
+function hypot(x,y : float) : float;
+
+ begin
+ hypot:=Sqrt(x*x+y*y)
+ end;
+
+function log10(x : float) : float;
+
+ begin
+ log10:=ln(x)/ln(10);
+ end;
+
+function log2(x : float) : float;
+
+ begin
+ log2:=ln(x)/ln(2)
+ end;
+
+function logn(n,x : float) : float;
+
+ begin
+ if n<0 then InvalidArgument;
+ logn:=ln(x)/ln(n);
+ end;
+
+function lnxp1(x : float) : float;
+
+ begin
+ if x<-1 then
+ InvalidArgument;
+ lnxp1:=ln(1+x);
+ end;
+
+function power(base,exponent : float) : float;
+
+ begin
+ if Exponent=0.0 then
+ if base <> 0.0 then
+ result:=1.0
+ else
+ InvalidArgument
+ else if (base=0.0) and (exponent>0.0) then
+ result:=0.0
+ else if (abs(exponent)<=maxint) and (frac(exponent)=0.0) then
+ result:=intpower(base,trunc(exponent))
+ else if base>0.0 then
+ result:=exp(exponent * ln (base))
+ else
+ InvalidArgument;
+ end;
+
+function intpower(base : float;const exponent : Integer) : float;
+
+ var
+ i : longint;
+
+ begin
+ if (base = 0.0) and (exponent = 0) then
+ InvalidArgument;
+ i:=abs(exponent);
+ intpower:=1.0;
+ while i>0 do
+ begin
+ while (i and 1)=0 do
+ begin
+ i:=i shr 1;
+ base:=sqr(base);
+ end;
+ i:=i-1;
+ intpower:=intpower*base;
+ end;
+ if exponent<0 then
+ intpower:=1.0/intpower;
+ end;
+
+
+operator ** (bas,expo : float) e: float;
+ begin
+ e:=power(bas,expo);
+ end;
+
+
+operator ** (bas,expo : int64) i: int64;
+ begin
+ i:=round(intpower(bas,expo));
+ end;
+
+
+function ceil(x : float) : integer;
+
+ begin
+ Ceil:=Trunc(x);
+ If Frac(x)>0 then
+ Ceil:=Ceil+1;
+ end;
+
+function floor(x : float) : integer;
+
+ begin
+ Floor:=Trunc(x);
+ If Frac(x)<0 then
+ Floor := Floor-1;
+ end;
+
+procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
+
+ begin
+ Exponent :=0;
+ if (abs(x)<0.5) then
+ While (abs(x)<0.5) do
+ begin
+ x := x*2;
+ Dec(Exponent);
+ end
+ else
+ While (abs(x)>1) do
+ begin
+ x := x/2;
+ Inc(Exponent);
+ end;
+ mantissa := x;
+ end;
+
+function ldexp(x : float;const p : Integer) : float;
+
+ begin
+ ldexp:=x*intpower(2.0,p);
+ end;
+
+function mean(const data : array of float) : float;
+
+ begin
+ Result:=Mean(@data[0],High(Data)+1);
+ end;
+
+function mean(const data : PFloat; Const N : longint) : float;
+
+ begin
+ mean:=sum(Data,N);
+ mean:=mean/N;
+ end;
+
+function sum(const data : array of float) : float;
+
+ begin
+ Result:=Sum(@Data[0],High(Data)+1);
+ end;
+
+function sum(const data : PFloat;Const N : longint) : float;
+
+ var
+ i : longint;
+
+ begin
+ sum:=0.0;
+ for i:=0 to N-1 do
+ sum:=sum+data[i];
+ end;
+
+ function sumofsquares(const data : array of float) : float;
+
+ begin
+ Result:=sumofsquares(@data[0],High(Data)+1);
+ end;
+
+ function sumofsquares(const data : PFloat; Const N : Integer) : float;
+
+ var
+ i : longint;
+
+ begin
+ sumofsquares:=0.0;
+ for i:=0 to N-1 do
+ sumofsquares:=sumofsquares+sqr(data[i]);
+ end;
+
+procedure sumsandsquares(const data : array of float;
+ var sum,sumofsquares : float);
+
+begin
+ sumsandsquares (@Data[0],High(Data)+1,Sum,sumofsquares);
+end;
+
+procedure sumsandsquares(const data : PFloat; Const N : Integer;
+ var sum,sumofsquares : float);
+
+ var
+ i : Integer;
+ temp : float;
+
+ begin
+ sumofsquares:=0.0;
+ sum:=0.0;
+ for i:=0 to N-1 do
+ begin
+ temp:=data[i];
+ sumofsquares:=sumofsquares+sqr(temp);
+ sum:=sum+temp;
+ end;
+ end;
+
+
+
+function stddev(const data : array of float) : float;
+
+begin
+ Result:=Stddev(@Data[0],High(Data)+1)
+end;
+
+function stddev(const data : PFloat; Const N : Integer) : float;
+
+ begin
+ StdDev:=Sqrt(Variance(Data,N));
+ end;
+
+procedure meanandstddev(const data : array of float;
+ var mean,stddev : float);
+
+begin
+ Meanandstddev(@Data[0],High(Data)+1,Mean,stddev);
+end;
+
+procedure meanandstddev(const data : PFloat;
+ Const N : Longint;var mean,stddev : float);
+
+Var I : longint;
+
+begin
+ Mean:=0;
+ StdDev:=0;
+ For I:=0 to N-1 do
+ begin
+ Mean:=Mean+Data[i];
+ StdDev:=StdDev+Sqr(Data[i]);
+ end;
+ Mean:=Mean/N;
+ StdDev:=(StdDev-N*Sqr(Mean));
+ If N>1 then
+ StdDev:=Sqrt(Stddev/(N-1))
+ else
+ StdDev:=0;
+end;
+
+function variance(const data : array of float) : float;
+
+ begin
+ Variance:=Variance(@Data[0],High(Data)+1);
+ end;
+
+function variance(const data : PFloat; Const N : Integer) : float;
+
+ begin
+ If N=1 then
+ Result:=0
+ else
+ Result:=TotalVariance(Data,N)/(N-1);
+ end;
+
+function totalvariance(const data : array of float) : float;
+
+begin
+ Result:=TotalVariance(@Data[0],High(Data)+1);
+end;
+
+function totalvariance(const data : Pfloat;Const N : Integer) : float;
+
+ var S,SS : Float;
+
+ begin
+ If N=1 then
+ Result:=0
+ else
+ begin
+ SumsAndSquares(Data,N,S,SS);
+ Result := SS-Sqr(S)/N;
+ end;
+ end;
+
+function randg(mean,stddev : float) : float;
+
+ Var U1,S2 : Float;
+
+ begin
+ repeat
+ u1:= 2*random-1;
+ S2:=Sqr(U1)+sqr(2*random-1);
+ until s2<1;
+ randg:=Sqrt(-2*ln(S2)/S2)*u1*stddev+Mean;
+ end;
+
+function popnstddev(const data : array of float) : float;
+
+ begin
+ PopnStdDev:=Sqrt(PopnVariance(@Data[0],High(Data)+1));
+ end;
+
+function popnstddev(const data : PFloat; Const N : Integer) : float;
+
+ begin
+ PopnStdDev:=Sqrt(PopnVariance(Data,N));
+ end;
+
+function popnvariance(const data : array of float) : float;
+
+begin
+ popnvariance:=popnvariance(@data[0],high(Data)+1);
+end;
+
+function popnvariance(const data : PFloat; Const N : Integer) : float;
+
+ begin
+ PopnVariance:=TotalVariance(Data,N)/N;
+ end;
+
+procedure momentskewkurtosis(const data : array of float;
+ var m1,m2,m3,m4,skew,kurtosis : float);
+
+begin
+ momentskewkurtosis(@Data[0],High(Data)+1,m1,m2,m3,m4,skew,kurtosis);
+end;
+
+procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
+ var m1,m2,m3,m4,skew,kurtosis : float);
+
+ Var S,SS,SC,SQ,invN,Acc,M1S,S2N,S3N,temp : Float;
+ I : Longint;
+
+ begin
+ invN:=1.0/N;
+ s:=0;
+ ss:=0;
+ sq:=0;
+ sc:=0;
+ for i:=0 to N-1 do
+ begin
+ temp:=Data[i]; { faster }
+ S:=S+temp;
+ acc:=temp*temp;
+ ss:=ss+acc;
+ Acc:=acc*temp;
+ Sc:=sc+acc;
+ acc:=acc*temp;
+ sq:=sq+acc;
+ end;
+ M1:=s*invN;
+ M1S:=M1*M1;
+ S2N:=SS*invN;
+ S3N:=SC*invN;
+ M2:=S2N-M1S;
+ M3:=S3N-(M1*3*S2N) + 2*M1S*M1;
+ M4:=SQ*invN - (M1 * 4 * S3N) + (M1S*6*S2N-3*Sqr(M1S));
+ Skew:=M3*power(M2,-3/2);
+ Kurtosis:=M4 / Sqr(M2);
+ end;
+
+function norm(const data : array of float) : float;
+
+ begin
+ norm:=Norm(@data[0],High(Data)+1);
+ end;
+
+function norm(const data : PFloat; Const N : Integer) : float;
+
+ begin
+ norm:=sqrt(sumofsquares(data,N));
+ end;
+
+
+function MinIntValue(const Data: array of Integer): Integer;
+var
+ I: Integer;
+begin
+ Result := Data[Low(Data)];
+ For I := Succ(Low(Data)) To High(Data) Do
+ If Data[I] < Result Then Result := Data[I];
+end;
+
+function MinValue(const Data: array of Integer): Integer;
+
+begin
+ Result:=MinValue(Pinteger(@Data[0]),High(Data)+1)
+end;
+
+function MinValue(const Data: PInteger; Const N : Integer): Integer;
+var
+ I: Integer;
+begin
+ Result := Data[0];
+ For I := 1 To N-1 do
+ If Data[I] < Result Then Result := Data[I];
+end;
+
+
+function minvalue(const data : array of float) : float;
+
+begin
+ Result:=minvalue(PFloat(@data[0]),High(Data)+1);
+end;
+
+function minvalue(const data : PFloat; Const N : Integer) : float;
+
+var
+ i : longint;
+
+begin
+ { get an initial value }
+ minvalue:=data[0];
+ for i:=1 to N-1 do
+ if data[i]<minvalue then
+ minvalue:=data[i];
+end;
+
+function MaxIntValue(const Data: array of Integer): Integer;
+var
+ I: Integer;
+begin
+ Result := Data[Low(Data)];
+ For I := Succ(Low(Data)) To High(Data) Do
+ If Data[I] > Result Then Result := Data[I];
+end;
+
+function maxvalue(const data : array of float) : float;
+
+begin
+ Result:=maxvalue(PFloat(@data[0]),High(Data)+1);
+end;
+
+function maxvalue(const data : PFloat; Const N : Integer) : float;
+
+var
+ i : longint;
+
+begin
+ { get an initial value }
+ maxvalue:=data[0];
+ for i:=1 to N-1 do
+ if data[i]>maxvalue then
+ maxvalue:=data[i];
+end;
+
+function MaxValue(const Data: array of Integer): Integer;
+
+begin
+ Result:=MaxValue(PInteger(@Data[0]),High(Data)+1)
+end;
+
+function maxvalue(const data : PInteger; Const N : Integer) : Integer;
+
+var
+ i : longint;
+
+begin
+ { get an initial value }
+ maxvalue:=data[0];
+ for i:=1 to N-1 do
+ if data[i]>maxvalue then
+ maxvalue:=data[i];
+end;
+
+
+function Min(a, b: Integer): Integer;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Max(a, b: Integer): Integer;
+begin
+ if a > b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Min(a, b: Cardinal): Cardinal;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Max(a, b: Cardinal): Cardinal;
+begin
+ if a > b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Min(a, b: Int64): Int64;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Max(a, b: Int64): Int64;
+begin
+ if a > b then
+ Result := a
+ else
+ Result := b;
+end;
+
+{$ifdef FPC_HAS_TYPE_SINGLE}
+function Min(a, b: Single): Single;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Max(a, b: Single): Single;
+begin
+ if a > b then
+ Result := a
+ else
+ Result := b;
+end;
+{$endif FPC_HAS_TYPE_SINGLE}
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function Min(a, b: Double): Double;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Max(a, b: Double): Double;
+begin
+ if a > b then
+ Result := a
+ else
+ Result := b;
+end;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function Min(a, b: Extended): Extended;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+end;
+
+function Max(a, b: Extended): Extended;
+begin
+ if a > b then
+ Result := a
+ else
+ Result := b;
+end;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+function InRange(const AValue, AMin, AMax: Integer): Boolean;
+
+begin
+ Result:=(AValue>=AMin) and (AValue<=AMax);
+end;
+
+function InRange(const AValue, AMin, AMax: Int64): Boolean;
+begin
+ Result:=(AValue>=AMin) and (AValue<=AMax);
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function InRange(const AValue, AMin, AMax: Double): Boolean;
+
+begin
+ Result:=(AValue>=AMin) and (AValue<=AMax);
+end;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+function EnsureRange(const AValue, AMin, AMax: Integer): Integer;
+
+begin
+ Result:=AValue;
+ If Result<AMin then
+ Result:=AMin
+ else if Result>AMax then
+ Result:=AMax;
+end;
+
+function EnsureRange(const AValue, AMin, AMax: Int64): Int64;
+
+begin
+ Result:=AValue;
+ If Result<AMin then
+ Result:=AMin
+ else if Result>AMax then
+ Result:=AMax;
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function EnsureRange(const AValue, AMin, AMax: Double): Double;
+
+begin
+ Result:=AValue;
+ If Result<AMin then
+ Result:=AMin
+ else if Result>AMax then
+ Result:=AMax;
+end;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+Const
+ EZeroResolution = 1E-16;
+ DZeroResolution = 1E-12;
+ SZeroResolution = 1E-4;
+
+
+function IsZero(const A: Single; Epsilon: Single): Boolean;
+
+begin
+ if (Epsilon=0) then
+ Epsilon:=SZeroResolution;
+ Result:=Abs(A)<=Epsilon;
+end;
+
+function IsZero(const A: Single): Boolean;
+
+begin
+ Result:=IsZero(A,single(SZeroResolution));
+end;
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function IsZero(const A: Double; Epsilon: Double): Boolean;
+
+begin
+ if (Epsilon=0) then
+ Epsilon:=DZeroResolution;
+ Result:=Abs(A)<=Epsilon;
+end;
+
+function IsZero(const A: Double): Boolean;
+
+begin
+ Result:=IsZero(A,DZeroResolution);
+end;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function IsZero(const A: Extended; Epsilon: Extended): Boolean;
+
+begin
+ if (Epsilon=0) then
+ Epsilon:=EZeroResolution;
+ Result:=Abs(A)<=Epsilon;
+end;
+
+function IsZero(const A: Extended): Boolean;
+
+begin
+ Result:=IsZero(A,EZeroResolution);
+end;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+
+type
+ TSplitDouble = packed record
+ cards: Array[0..1] of cardinal;
+ end;
+
+function IsNan(const d : Double): Boolean;
+ var
+ fraczero, expMaximal: boolean;
+ begin
+{$if defined(FPC_BIG_ENDIAN) or (defined(CPUARM) and defined(FPUFPA))}
+ expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
+ fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
+ (TSplitDouble(d).cards[1] = 0);
+{$else FPC_BIG_ENDIAN}
+ expMaximal := ((TSplitDouble(d).cards[1] shr 20) and $7ff) = 2047;
+ fraczero := (TSplitDouble(d).cards[1] and $fffff = 0) and
+ (TSplitDouble(d).cards[0] = 0);
+{$endif FPC_BIG_ENDIAN}
+ Result:=expMaximal and not(fraczero);
+ end;
+
+
+function IsInfinite(const d : Double): Boolean;
+ var
+ fraczero, expMaximal: boolean;
+ begin
+{$if defined(FPC_BIG_ENDIAN) or (defined(CPUARM) and defined(FPUFPA))}
+ expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
+ fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
+ (TSplitDouble(d).cards[1] = 0);
+{$else FPC_BIG_ENDIAN}
+ expMaximal := ((TSplitDouble(d).cards[1] shr 20) and $7ff) = 2047;
+ fraczero := (TSplitDouble(d).cards[1] and $fffff = 0) and
+ (TSplitDouble(d).cards[0] = 0);
+{$endif FPC_BIG_ENDIAN}
+ Result:=expMaximal and fraczero;
+ end;
+
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+function SameValue(const A, B: Extended; Epsilon: Extended): Boolean;
+
+begin
+ if (Epsilon=0) then
+ Epsilon:=Max(Min(Abs(A),Abs(B))*EZeroResolution,EZeroResolution);
+ if (A>B) then
+ Result:=((A-B)<=Epsilon)
+ else
+ Result:=((B-A)<=Epsilon);
+end;
+
+function SameValue(const A, B: Extended): Boolean;
+
+begin
+ Result:=SameValue(A,B,0);
+end;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+
+{$ifdef FPC_HAS_TYPE_DOUBLE}
+function SameValue(const A, B: Double): Boolean;
+
+begin
+ Result:=SameValue(A,B,0);
+end;
+
+function SameValue(const A, B: Double; Epsilon: Double): Boolean;
+
+begin
+ if (Epsilon=0) then
+ Epsilon:=Max(Min(Abs(A),Abs(B))*DZeroResolution,DZeroResolution);
+ if (A>B) then
+ Result:=((A-B)<=Epsilon)
+ else
+ Result:=((B-A)<=Epsilon);
+end;
+{$endif FPC_HAS_TYPE_DOUBLE}
+
+function SameValue(const A, B: Single): Boolean;
+
+begin
+ Result:=SameValue(A,B,0);
+end;
+
+function SameValue(const A, B: Single; Epsilon: Single): Boolean;
+
+begin
+ if (Epsilon=0) then
+ Epsilon:=Max(Min(Abs(A),Abs(B))*SZeroResolution,SZeroResolution);
+ if (A>B) then
+ Result:=((A-B)<=Epsilon)
+ else
+ Result:=((B-A)<=Epsilon);
+end;
+
+// Some CPUs probably allow a faster way of doing this in a single operation...
+// There weshould define CPUDIVMOD in the header mathuh.inc and implement it using asm.
+{$ifndef CPUDIVMOD}
+procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word);
+
+begin
+ Result:=Dividend Div Divisor;
+ Remainder:=Dividend Mod Divisor;
+end;
+{$endif}
+
+{$ifndef ver1_0} // default params
+function ifthen(val:boolean;const iftrue:integer; const iffalse:integer= 0) :integer;
+begin
+ if val then result:=iftrue else result:=iffalse;
+end;
+
+function ifthen(val:boolean;const iftrue:int64 ; const iffalse:int64 = 0) :int64;
+begin
+ if val then result:=iftrue else result:=iffalse;
+end;
+
+function ifthen(val:boolean;const iftrue:double ; const iffalse:double =0.0):double;
+begin
+ if val then result:=iftrue else result:=iffalse;
+end;
+{$endif}
+
+end.
+{
+ $Log: math.pp,v $
+ Revision 1.32 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.31 2005/02/08 20:49:16 florian
+ * operator **(int64,int64) returns int64 now
+
+ Revision 1.30 2005/02/08 20:25:28 florian
+ - killed power from system unit
+ * move operator ** to math unit
+
+ Revision 1.29 2005/01/31 13:59:23 marco
+ * fixed
+
+ Revision 1.28 2005/01/12 20:17:39 florian
+ * generic arctan2 for 3rd and 4th quadrand fixed
+
+ Revision 1.27 2005/01/04 16:47:05 florian
+ * compilation on ARM fixed
+
+}
diff --git a/rtl/objpas/objpas.pp b/rtl/objpas/objpas.pp
new file mode 100644
index 0000000000..e96784b6dd
--- /dev/null
+++ b/rtl/objpas/objpas.pp
@@ -0,0 +1,400 @@
+{
+ $Id: objpas.pp,v 1.14 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This unit makes Free Pascal as much as possible Delphi compatible
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$Mode ObjFpc}
+{$I-}
+{$ifndef Unix}
+ {$S-}
+{$endif}
+unit objpas;
+
+ interface
+
+ { first, in object pascal, the integer type must be redefined }
+ const
+ MaxInt = MaxLongint;
+ type
+ Integer = longint;
+ PInteger = ^Integer;
+
+ { Ansistring are the default }
+ PString = PAnsiString;
+
+ { array types }
+ IntegerArray = array[0..$effffff] of Integer;
+ TIntegerArray = IntegerArray;
+ PIntegerArray = ^IntegerArray;
+ PointerArray = array [0..512*1024*1024-2] of Pointer;
+ TPointerArray = PointerArray;
+ PPointerArray = ^PointerArray;
+{$ifdef HASINTF}
+ TBoundArray = array of integer;
+{$endif HASINTF}
+
+{****************************************************************************
+ Compatibility routines.
+****************************************************************************}
+
+ { Untyped file support }
+
+ Procedure AssignFile(Var f:File;const Name:string);
+ Procedure AssignFile(Var f:File;p:pchar);
+ Procedure AssignFile(Var f:File;c:char);
+ Procedure CloseFile(Var f:File);
+
+ { Text file support }
+ Procedure AssignFile(Var t:Text;const s:string);
+ Procedure AssignFile(Var t:Text;p:pchar);
+ Procedure AssignFile(Var t:Text;c:char);
+ Procedure CloseFile(Var t:Text);
+
+ { Typed file supoort }
+
+ Procedure AssignFile(Var f:TypedFile;const Name:string);
+ Procedure AssignFile(Var f:TypedFile;p:pchar);
+ Procedure AssignFile(Var f:TypedFile;c:char);
+
+ { ParamStr should return also an ansistring }
+ Function ParamStr(Param : Integer) : Ansistring;
+
+{****************************************************************************
+ Resource strings.
+****************************************************************************}
+
+ type
+ TResourceIterator = Function (Name,Value : AnsiString; Hash : Longint) : AnsiString;
+
+ Function Hash(S : AnsiString) : longint;
+ Procedure ResetResourceTables;
+ Procedure SetResourceStrings (SetFunction : TResourceIterator);
+ Function ResourceStringTableCount : Longint;
+ Function ResourceStringCount(TableIndex : longint) : longint;
+ Function GetResourceStringName(TableIndex,StringIndex : Longint) : Ansistring;
+ Function GetResourceStringHash(TableIndex,StringIndex : Longint) : Longint;
+ Function GetResourceStringDefaultValue(TableIndex,StringIndex : Longint) : AnsiString;
+ Function GetResourceStringCurrentValue(TableIndex,StringIndex : Longint) : AnsiString;
+ Function SetResourceStringValue(TableIndex,StringIndex : longint; Value : Ansistring) : Boolean;
+
+ { Delphi compatibility }
+ type
+ PResStringRec=^AnsiString;
+ TResStringRec=AnsiString;
+ Function LoadResString(p:PResStringRec):AnsiString;
+
+
+ implementation
+
+{****************************************************************************
+ Compatibility routines.
+****************************************************************************}
+
+{ Untyped file support }
+
+Procedure AssignFile(Var f:File;const Name:string);
+
+begin
+ System.Assign (F,Name);
+end;
+
+Procedure AssignFile(Var f:File;p:pchar);
+
+begin
+ System.Assign (F,P);
+end;
+
+Procedure AssignFile(Var f:File;c:char);
+
+begin
+ System.Assign (F,C);
+end;
+
+Procedure CloseFile(Var f:File);
+
+begin
+ { Catch Runtime error/Exception }
+ {$I+}
+ System.Close(f);
+ {$I-}
+end;
+
+{ Text file support }
+
+Procedure AssignFile(Var t:Text;const s:string);
+
+begin
+ System.Assign (T,S);
+end;
+
+Procedure AssignFile(Var t:Text;p:pchar);
+
+begin
+ System.Assign (T,P);
+end;
+
+Procedure AssignFile(Var t:Text;c:char);
+
+begin
+ System.Assign (T,C);
+end;
+
+Procedure CloseFile(Var t:Text);
+
+begin
+ { Catch Runtime error/Exception }
+ {$I+}
+ System.Close(T);
+ {$I-}
+end;
+
+{ Typed file supoort }
+
+Procedure AssignFile(Var f:TypedFile;const Name:string);
+
+begin
+ system.Assign(F,Name);
+end;
+
+Procedure AssignFile(Var f:TypedFile;p:pchar);
+
+begin
+ system.Assign (F,p);
+end;
+
+Procedure AssignFile(Var f:TypedFile;c:char);
+
+begin
+ system.Assign (F,C);
+end;
+
+Function ParamStr(Param : Integer) : Ansistring;
+
+Var Len : longint;
+
+begin
+{
+ Paramstr(0) should return the name of the binary.
+ Since this functionality is included in the system unit,
+ we fetch it from there.
+ Normally, pathnames are less than 255 chars anyway,
+ so this will work correct in 99% of all cases.
+ In time, the system unit should get a GetExeName call.
+}
+ if (Param=0) then
+ Result:=System.Paramstr(0)
+ else if (Param>0) and (Param<argc) then
+ begin
+ Len:=0;
+ While Argv[Param][Len]<>#0 do
+ Inc(len);
+ SetLength(Result,Len);
+ If Len>0 then
+ Move(Argv[Param][0],Result[1],Len);
+ end
+ else
+ paramstr:='';
+end;
+
+
+
+{ ---------------------------------------------------------------------
+ ResourceString support
+ ---------------------------------------------------------------------}
+Type
+
+ PResourceStringRecord = ^TResourceStringRecord;
+ TResourceStringRecord = Packed Record
+ DefaultValue,
+ CurrentValue : AnsiString;
+ HashValue : longint;
+ Name : AnsiString;
+ end;
+
+ TResourceStringTable = Packed Record
+ Count : longint;
+ Resrec : Array[Word] of TResourceStringRecord;
+ end;
+ PResourceStringTable = ^TResourceStringTable;
+
+ TResourceTableList = Packed Record
+ Count : longint;
+ Tables : Array[Word] of PResourceStringTable;
+ end;
+
+
+
+Var
+ ResourceStringTable : TResourceTablelist; External Name 'FPC_RESOURCESTRINGTABLES';
+
+Function Hash(S : AnsiString) : longint;
+
+Var thehash,g,I : longint;
+
+begin
+ thehash:=0;
+ For I:=1 to Length(S) do { 0 terminated }
+ begin
+ thehash:=thehash shl 4;
+ inc(theHash,Ord(S[i]));
+ g:=thehash and longint($f shl 28);
+ if g<>0 then
+ begin
+ thehash:=thehash xor (g shr 24);
+ thehash:=thehash xor g;
+ end;
+ end;
+ If theHash=0 then
+ Hash:=Not(0)
+ else
+ Hash:=TheHash;
+end;
+
+Function GetResourceString(Const TheTable: TResourceStringTable;Index : longint) : AnsiString;[Public,Alias : 'FPC_GETRESOURCESTRING'];
+begin
+ If (Index>=0) and (Index<TheTAble.Count) then
+ Result:=TheTable.ResRec[Index].CurrentValue
+ else
+ Result:='';
+end;
+
+(*
+Function SetResourceString(Hash : Longint;Const Name : ShortString; Const Value : AnsiString) : Boolean;
+
+begin
+ Hash:=FindIndex(Hash,Name);
+ Result:=Hash<>-1;
+ If Result then
+ ResourceStringTable.ResRec[Hash].CurrentValue:=Value;
+end;
+*)
+
+Procedure SetResourceStrings (SetFunction : TResourceIterator);
+
+Var I,J : longint;
+
+begin
+ With ResourceStringTable do
+ For I:=0 to Count-1 do
+ With Tables[I]^ do
+ For J:=0 to Count-1 do
+ With ResRec[J] do
+ CurrentValue:=SetFunction(Name,DefaultValue,HashValue);
+end;
+
+
+Procedure ResetResourceTables;
+
+Var I,J : longint;
+
+begin
+ With ResourceStringTable do
+ For I:=0 to Count-1 do
+ With Tables[I]^ do
+ For J:=0 to Count-1 do
+ With ResRec[J] do
+ CurrentValue:=DefaultValue;
+end;
+
+Function ResourceStringTableCount : Longint;
+
+begin
+ Result:=ResourceStringTable.Count;
+end;
+
+Function CheckTableIndex (Index: longint) : Boolean;
+begin
+ Result:=(Index<ResourceStringTable.Count) and (Index>=0)
+end;
+
+Function CheckStringIndex (TableIndex,Index: longint) : Boolean;
+begin
+ Result:=(TableIndex<ResourceStringTable.Count) and (TableIndex>=0) and
+ (Index<ResourceStringTable.Tables[TableIndex]^.Count) and (Index>=0)
+end;
+
+Function ResourceStringCount(TableIndex : longint) : longint;
+
+begin
+ If not CheckTableIndex(TableIndex) then
+ Result:=-1
+ else
+ Result:=ResourceStringTable.Tables[TableIndex]^.Count;
+end;
+
+Function GetResourceStringName(TableIndex,StringIndex : Longint) : Ansistring;
+
+begin
+ If not CheckStringIndex(Tableindex,StringIndex) then
+ Result:=''
+ else
+ result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].Name;
+end;
+
+Function GetResourceStringHash(TableIndex,StringIndex : Longint) : Longint;
+
+begin
+ If not CheckStringIndex(Tableindex,StringIndex) then
+ Result:=0
+ else
+ result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].HashValue;
+end;
+
+Function GetResourceStringDefaultValue(TableIndex,StringIndex : Longint) : AnsiString;
+
+begin
+ If not CheckStringIndex(Tableindex,StringIndex) then
+ Result:=''
+ else
+ result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].DefaultValue;
+end;
+
+Function GetResourceStringCurrentValue(TableIndex,StringIndex : Longint) : AnsiString;
+
+begin
+ If not CheckStringIndex(Tableindex,StringIndex) then
+ Result:=''
+ else
+ result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].CurrentValue;
+end;
+
+Function SetResourceStringValue(TableIndex,StringIndex : longint; Value : Ansistring) : Boolean;
+
+begin
+ Result:=CheckStringIndex(Tableindex,StringIndex);
+ If Result then
+ ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].CurrentValue:=Value;
+end;
+
+Function LoadResString(p:PResStringRec):AnsiString;
+
+begin
+ Result:=p^;
+end;
+
+
+Initialization
+ ResetResourceTables;
+finalization
+
+end.
+
+{
+ $Log: objpas.pp,v $
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.13 2005/01/24 18:03:19 peter
+ * pinteger in non-delphi/objfpc mode is psmallint
+
+}
diff --git a/rtl/objpas/rtlconst.inc b/rtl/objpas/rtlconst.inc
new file mode 100644
index 0000000000..e72069504f
--- /dev/null
+++ b/rtl/objpas/rtlconst.inc
@@ -0,0 +1,542 @@
+{
+ $Id: rtlconst.inc,v 1.2 2005/04/16 09:25:02 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+unit RtlConsts;
+
+interface
+
+ResourceString
+
+{ ---------------------------------------------------------------------
+ Various error messages.
+ ---------------------------------------------------------------------}
+
+ HNoContext = 'No context-sensitive Help installed.';
+ HNoSystem = 'No Help Manager installed.';
+ HNoTableOfContents = 'No Table of Contents found.';
+ HNothingFound = 'No help found for "%s"';
+ HNoTopics = 'No topic-based Help installed.';
+ SAbortButton = 'Abort';
+ SAllButton = '&All';
+ SAllFilter = 'All files';
+ SAncestorNotFound = 'Ancestor class for "%s" not found.';
+ SAssignError = 'Cannot assign a %s to a %s.';
+ SAsyncSocketError = 'Asynchronous socket error: %d';
+ SBG = 'BG';
+ SBitmapEmpty = 'Bitmap is empty';
+ SBitsIndexError = 'Bits index out of range.';
+ SBoldFont = 'Bold';
+ SBoldItalicFont = 'Bold Italic';
+ SBucketListLocked = 'List is locked during an active ForEach.';
+ SCancelButton = 'Cancel';
+ SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
+ SCannotCreateName = 'Cannot use standard name for and unknown component';
+ SCannotCreateSocket = 'Unable to create new socket';
+ SCannotDragForm = 'Forms cannot be dragged';
+ SCannotFocus = 'A disbled or invisible Window cannot get focus';
+ SCannotListenOnOpen = 'Listening on an open socket is not allowed';
+ SCannotOpenAVI = 'AVI can not be opened';
+ SCannotShowModal = 'A visible Window can not be made modal';
+ SCantChangeWhileActive = 'Changing value on an active socket is not allowed';
+ SCantWriteResourceStreamError = 'Can not write to read-only ResourceStream';
+ SCardDLLNotLoaded = 'CARDS library could not be loaded';
+ SChangeIconSize = 'Can not change icon size';
+ SCharExpected = '"%s" expected';
+ SCheckSynchronizeError = 'CheckSynchronize called from non-main thread "$%x"';
+ SClassMismatch = 'Resource %s has wrong class';
+ SClassNotFound = 'Class "%s" not found';
+ SClientNotSet = 'Client of TDrag was not initialized';
+ SCloseButton = '&Close';
+ SCmplxCouldNotParseImaginary = 'Failed to parse imaginary portion';
+ SCmplxCouldNotParsePlus = 'Failed to parse required "+" (or "-") symbol';
+ SCmplxCouldNotParseReal = 'Failed to parse real portion';
+ SCmplxCouldNotParseSymbol = 'Failed to parse required "%s" symbol';
+ SCmplxErrorSuffix = '%s [%s<?>%s]';
+ SCmplxUnexpectedChars = 'Unexpected characters';
+ SCmplxUnexpectedEOS = 'Unexpected end of string [%s]';
+ SColorPrefix = 'Color';
+ SColorTags = 'ABCDEFGHIJKLMNOP';
+ SComponentNameTooLong = 'Component name "%s" exceeds 64 character limit';
+ SConfirmCreateDir = 'The selected directory does not exist. Should it be created?';
+ SControlParentSetToSelf = 'A component can not have itself as parent';
+ SConvDuplicateFamily = 'Conversion family "%s" already registered';
+ SConvDuplicateType = 'Conversion type (%s) already registered in %s';
+ SConvFactorZero = '"%s" has a factor of zero';
+ SConvIllegalFamily = 'Illegal family';
+ SConvIllegalType = 'Illegal type';
+ SConvIncompatibleTypes2 = 'Incompatible conversion types (%s, %s)';
+ SConvIncompatibleTypes3 = 'Incompatible conversion types (%s, %s, %s)';
+ SConvIncompatibleTypes4 = 'Incompatible conversion types (%s - %s, %s - %s)';
+ SConvStrParseError = 'Could not parse %s';
+ SConvUnknownDescription = '[$%.8x]' ; // no longer used
+ SConvUnknownDescriptionWithPrefix = '[%s%.8x]';
+ SConvUnknownFamily = 'Unknown conversion family: "%s"';
+ SConvUnknownType = 'Unknown conversion type: "%s"';
+ SCustomColors = 'Custom colors';
+ SDateEncodeError = 'Invalid argument for date encode.';
+ SDdeConvErr = 'DDE error - conversion was not performed ($0%x)';
+ SDdeErr = 'An error was returned by DDE ($0%x)';
+ SDdeMemErr = 'An error occurred - not enough memory for DDE ($0%x)';
+ SDdeNoConnect = 'DDE-Conversation could not be started';
+ SDefault = 'Default';
+ SDefaultFilter = 'All files (*.*)|*.*';
+ SDelimiterQuoteCharError = 'Delimiter and QuoteChar properties cannot have the same value';
+ SDeviceOnPort = '%s on %s';
+ SDimsDoNotMatch = 'Image size mismatch';
+ SDirNameCap = 'Directory &name:';
+ SDirsCap = '&Directories:';
+ SDrivesCap = '&Drives:';
+ SDuplicateCardId = 'Duplicate card ID found';
+ SDuplicateClass = 'A class named "%s" already exists';
+ SDuplicateItem = 'Duplicates not allowed in this list ($0%x)';
+ SDuplicateMenus = 'Menu "%s" is used by another form';
+ SDuplicateName = 'Duplcate name: A component named "%s" already exists';
+ SDuplicateReference = 'WriteObject was called twice for one instance';
+ SDuplicateString = 'String list does not allow duplicates';
+ SEmptyStreamIllegalReader = 'Illegal Nil stream for TReader constructor';
+ SEmptyStreamIllegalWriter = 'Illegal Nil stream for TWriter constructor';
+ SErrindexTooLarge = 'Bit index exceeds array limit: %d';
+ SErrInvalidBitIndex = 'Invalid bit index : %d';
+ SErrNoStreaming = 'Failed to initialize component: No streaming method available.';
+ SErrNoVariantSupport = 'No variant support for properties. Please use the variants unit in your project and recompile';
+ SErrOutOfMemory = 'Out of memory';
+ SErrPropertyNotFound = 'Unknown property: "%s"';
+ SErrUnknownEnumValue = 'Unknown enumeration value: "%s"';
+ SFailedToCallConstructor = 'TStrings descendant "%s" failed to call inherited constructor';
+ SFB = 'FB';
+ SFCreateError = 'Unable to create file "%s"';
+ SFCreateErrorEx = 'Unable to create file "%s": %s';
+ SFG = 'FG';
+ SFilesCap = '&Files: (*.*)';
+ SFixedColTooBig = 'Fixed column count must be less than column count';
+ SFixedRowTooBig = 'Fixed row count must be less than row count';
+ SFOpenError = 'Unable to open file "%s"';
+ SFOpenErrorEx = 'Unable to open file "%s": %s';
+ SGridTooLarge = 'Grid too large for this operation';
+ SGroupIndexTooLow = 'GroupIndex must be greater than preceding menu groupindex';
+ SHelpButton = '&Help';
+ SIconToClipboard = 'Clipboard does not support Icons';
+ SIdentifierExpected = 'Identifier expected';
+ SIgnoreButton = '&Ignore';
+ SImageCanvasNeedsBitmap = 'A Canvas can only be changed if it contains a bitmap';
+ SImageIndexError = 'Invalid ImageList index';
+ SImageReadFail = 'The ImageList data could not be read from stream';
+ SImageWriteFail = 'The ImageList data could not be written to stream';
+ SIndexOutOfRange = 'Grid index out of range';
+ SIniFileWriteError = 'Unable to write to "%s"';
+ SInsertLineError = 'Line could not be inserted';
+ SInvalidActionCreation = 'Invalid action creation';
+ SInvalidActionEnumeration = 'Invalid action enumeration';
+ SInvalidActionRegistration = 'Invalid action registration';
+ SInvalidActionUnregistration = 'Invalid action unregistration';
+ SInvalidBinary = 'Invalid binary value';
+ SInvalidBitmap = 'Invalid Bitmap';
+ SInvalidClipFmt = 'Invalid clipboard format';
+ SInvalidCurrentItem = 'Invalid item';
+ SInvalidDateDay = '(%d, %d) is not a valid DateDay pair';
+ SInvalidDateMonthWeek = '(%d, %d, %d, %d) is not a valid DateMonthWeek quad';
+ SInvalidDateWeek = '(%d, %d, %d) is not a valid DateWeek triplet';
+ SInvalidDayOfWeekInMonth = '(%d, %d, %d, %d) is not a valid DayOfWeekInMonth quad';
+ SInvalidFileName = '"%s" is not a valid file name.';
+ SInvalidIcon = 'Invalid Icon';
+ SInvalidImage = 'Invalid stream format';
+ SInvalidImageList = 'Invalid ImageList';
+ SInvalidImageSize = 'Invalid image size';
+ SInvalidJulianDate = '%f Julian cannot be represented as a DateTime';
+ SInvalidMask = '"%s" is not a valid mask at (%d)';
+ SInvalidMemoSize = 'Text larger than memo capacity';
+ SInvalidMetafile = 'Invalid Metafile';
+ SInvalidName = '"%s" is not a valid component name';
+ SInvalidNumber = 'Invalid numerical value';
+ SInvalidPixelFormat = 'Invalid Pixelformat';
+ SInvalidPrinter = 'Selected printer is invalid';
+ SInvalidPrinterOp = 'Operation invalid on selected printer';
+ SInvalidProperty = 'Invalid property value';
+ SInvalidPropertyElement = 'Invalid property element: "%s"';
+ SInvalidPropertyPath = 'Invalid property path';
+ SInvalidPropertyType = 'Property type (%s) is not valid';
+ SInvalidPropertyValue = 'Invalid value for property';
+ SInvalidRegType = 'Invalid data type for "%s"';
+ SInvalidString = 'Invalid string constant';
+ SInvalidStringGridOp = 'Unable to insert rows in or delete rows from grid';
+ SInvalidTabIndex = 'Registerindex out of bounds';
+ SItalicFont = 'Italic';
+ SItemNotFound = 'Item not found ($0%x)';
+ SLineTooLong = 'Line too long';
+ SListCapacityError = 'List capacity (%d) exceeded.';
+ SListCountError = 'List count (%d) out of bounds.';
+ SListIndexError = 'List index (%d) out of bounds';
+ SMaskEditErr = 'Invalid mask input value. Use escape key to abandon changes';
+ SMaskErr = 'Invalid mask input value';
+ SMDIChildNotVisible = 'A MDI-Child Window can not be hidden.';
+ SMemoryStreamError = 'Out of memory while expanding memory stream';
+ SMenuIndexError = 'Menu Index out of range';
+ SMenuNotFound = 'Menu entry not found in menu';
+ SMenuReinserted = 'Menu reinserted';
+ SMissingDateTimeField = '?';
+ SMPOpenFilter = 'All files (*.*)|*.*|Wave-files (*.WAV)|*.WAV|Midi-files (*.MID)|*.MID|Video for Windows (*.avi)|*.avi';
+ SNetworkCap = 'Ne&twork...';
+ sNoAddress = 'No address specified';
+ SNoButton = '&No';
+ SNoCanvasHandle = 'Canvas handle does not allow drawing';
+ SNoComSupport = '"%s" has not been registered as a COM class';
+ SNoDefaultPrinter = 'No default printer was selected';
+ SNoMDIForm = 'No MDI form is available, none is active';
+ SNoTimers = 'No timers available';
+ SNotOpenErr = 'No MCI-device opened';
+ SNotPrinting = 'Printer is not currently printing';
+ SNoVolumeLabel = ': [ - No name - ]';
+ SNumberExpected = 'Number expected';
+ SOKButton = 'OK';
+ SOldTShape = 'Can not load older version of TShape';
+ SOleGraphic = 'Invalid operation for TOleGraphic';
+ SOutlineBadLevel = '???';
+ SOutlineError = 'Invalid Node index';
+ SOutlineExpandError = 'Parent node must be expanded';
+ SOutlineFileLoad = 'Error loading file';
+ SOutlineIndexError = 'Node index not found';
+ SOutlineLongLine = 'Line too long';
+ SOutlineMaxLevels = 'Maximum level exceeded';
+ SOutlineSelection = 'Invalid selection';
+ SOutOfRange = 'Value must be between %d and %d';
+ SOutOfResources = 'Out of system resources';
+ SParentRequired = 'Element ''%s'' has no parent Window';
+ SParseError = '%s on line %d';
+ SPictureDesc = ' (%dx%d)';
+ SPictureLabel = 'Image:';
+ SPreviewLabel = 'Preview';
+ SPrinterIndexError = 'Printer Index out of range';
+ SPrinting = 'Printing in progress';
+ SPropertiesVerb = 'Properties';
+ SPropertyException = 'Error reading %s%s%s: %s';
+ SPropertyOutOfRange = 'Property %s out of range';
+ SPutObjectError = 'PutObject on undefined object';
+ SRangeError = 'Range error';
+ SReadError = 'Stream read error';
+ SReadOnlyProperty = 'Property is read-only';
+ SRegCreateFailed = 'Failed to create key %s';
+ SRegGetDataFailed = 'Failed to get data for "%s"';
+ SRegisterError = 'Invalid component registration';
+ SRegSetDataFailed = 'Failed to set data for "%s"';
+ SRegularFont = 'Normal';
+ SReplaceImage = 'Image can not be replaced';
+ SResNotFound = 'Resource "%s" not found';
+ SRetryButton = '&Retry';
+ SRNone = '(Empty)';
+ SRUnknown = '(Unknown)';
+ SScanLine = 'Line index out of bounds';
+ SScrollBarRange = 'Scrollbar property out of range';
+ SSeekNotImplemented = '%s.Seek not implemented';
+ SSelectDirCap = 'Select directory';
+ SSocketAlreadyOpen = 'Socket is already open';
+ SSocketIOError = '%s error %d, %s';
+ SSocketMustBeBlocking = 'Socket must be in blocking mode';
+ SSocketRead = 'Read';
+ SSocketWrite = 'Write';
+ SSortedListError = 'Operation not allowed on sorted list';
+ SStreamSetSize = 'Error setting stream size';
+ SStringExpected = 'String expected';
+ SSymbolExpected = '%s expected';
+ SThreadCreateError = 'Thread creation error: %s';
+ SThreadError = 'Thread Error: %s (%d)';
+ STooManyDeleted = 'Too many rows or columns deleted';
+ STooManyImages = 'Too many images';
+ STwoMDIForms = 'There is only one MDI window available';
+ SUnknownClipboardFormat = 'Unknown clipboard format';
+ SUnknownConversion = 'Unknown extension for RichEdit-conversion (.%s)';
+ SUnknownExtension = 'Unknown extension (.%s)';
+ SUnknownGroup = '%s not in a class registration group';
+ SUnknownProperty = 'Unknown property: "%s"';
+ SUnknownPropertyType = 'Unknown property type %d';
+ SUntitled = '(Untitled)';
+ SVBitmaps = 'Bitmaps';
+ SVEnhMetafiles = 'Enhanced MetaFiles';
+ SVIcons = 'Icons';
+ SVisibleChanged = 'Visible property cannot be changed in OnShow or OnHide handlers';
+ SVMetafiles = 'MetaFiles';
+ SWindowClass = 'Error when initializing Window Class';
+ SWindowCreate = 'Error when creating Window';
+ SWindowDCError = 'Error when??';
+ sWindowsSocketError = 'A Windows socket error occurred: %s (%d), on API "%s"';
+ SWriteError = 'Stream write error';
+ SYesButton = '&Yes';
+
+{ ---------------------------------------------------------------------
+ Keysim Names
+ ---------------------------------------------------------------------}
+
+ SmkcAlt = 'Alt+';
+ SmkcBkSp = 'Backspace';
+ SmkcCtrl = 'Ctrl+';
+ SmkcDel = 'Delete';
+ SmkcDown = 'Down';
+ SmkcEnd = 'End';
+ SmkcEnter = 'Enter';
+ SmkcEsc = 'Esc';
+ SmkcHome = 'Home';
+ SmkcIns = 'Insert';
+ SmkcLeft = 'Left';
+ SmkcPgDn = 'Page down';
+ SmkcPgUp = 'Page up';
+ SmkcRight = 'Right';
+ SmkcShift = 'Shift+';
+ SmkcSpace = 'Space';
+ SmkcTab = 'Tab';
+ SmkcUp = 'Up';
+
+{ ---------------------------------------------------------------------
+ "Distance" family type and conversion types
+ ---------------------------------------------------------------------}
+
+ SAngstromsDescription = 'Angstroms';
+ SAstronomicalUnitsDescription = 'AstronomicalUnits';
+ SCentimetersDescription = 'Centimeters';
+ SChainsDescription = 'Chains';
+ SCubitsDescription = 'Cubits';
+ SDecametersDescription = 'Decameters';
+ SDecimetersDescription = 'Decimeters';
+ SDistanceDescription = 'Distance';
+ SFathomsDescription = 'Fathoms';
+ SFeetDescription = 'Feet';
+ SFurlongsDescription = 'Furlongs';
+ SGigametersDescription = 'Gigameters';
+ SHandsDescription = 'Hands';
+ SHectometersDescription = 'Hectometers';
+ SInchesDescription = 'Inches';
+ SKilometersDescription = 'Kilometers';
+ SLightYearsDescription = 'LightYears';
+ SLinksDescription = 'Links';
+ SMegametersDescription = 'Megameters';
+ SMetersDescription = 'Meters';
+ SMicromicronsDescription = 'Micromicrons';
+ SMicronsDescription = 'Microns';
+ SMilesDescription = 'Miles';
+ SMillimetersDescription = 'Millimeters';
+ SMillimicronsDescription = 'Millimicrons';
+ SNauticalMilesDescription = 'NauticalMiles';
+ SPacesDescription = 'Paces';
+ SParsecsDescription = 'Parsecs';
+ SPicasDescription = 'Picas';
+ SPointsDescription = 'Points';
+ SRodsDescription = 'Rods';
+ SYardsDescription = 'Yards';
+
+{ ---------------------------------------------------------------------
+ "Area" family type and conversion types
+ ---------------------------------------------------------------------}
+
+ SAcresDescription = 'Acres';
+ SAreaDescription = 'Area';
+ SAresDescription = 'Ares';
+ SCentaresDescription = 'Centares';
+ SHectaresDescription = 'Hectares';
+ SSquareCentimetersDescription = 'SquareCentimeters';
+ SSquareDecametersDescription = 'SquareDecameters';
+ SSquareDecimetersDescription = 'SquareDecimeters';
+ SSquareFeetDescription = 'SquareFeet';
+ SSquareHectometersDescription = 'SquareHectometers';
+ SSquareInchesDescription = 'SquareInches';
+ SSquareKilometersDescription = 'SquareKilometers';
+ SSquareMetersDescription = 'SquareMeters';
+ SSquareMilesDescription = 'SquareMiles';
+ SSquareMillimetersDescription = 'SquareMillimeters';
+ SSquareRodsDescription = 'SquareRods';
+ SSquareYardsDescription = 'SquareYards';
+
+{ ---------------------------------------------------------------------
+ "Volume" family type and conversion types
+ ---------------------------------------------------------------------}
+
+ SAcreFeetDescription = 'AcreFeet';
+ SAcreInchesDescription = 'AcreInches';
+ SCentiLitersDescription = 'CentiLiters';
+ SCordFeetDescription = 'CordFeet';
+ SCordsDescription = 'Cords';
+ SCubicCentimetersDescription = 'CubicCentimeters';
+ SCubicDecametersDescription = 'CubicDecameters';
+ SCubicDecimetersDescription = 'CubicDecimeters';
+ SCubicFeetDescription = 'CubicFeet';
+ SCubicHectometersDescription = 'CubicHectometers';
+ SCubicInchesDescription = 'CubicInches';
+ SCubicKilometersDescription = 'CubicKilometers';
+ SCubicMetersDescription = 'CubicMeters';
+ SCubicMilesDescription = 'CubicMiles';
+ SCubicMillimetersDescription = 'CubicMillimeters';
+ SCubicYardsDescription = 'CubicYards';
+ SDecaLitersDescription = 'DecaLiters';
+ SDecasteresDescription = 'Decasteres';
+ SDeciLitersDescription = 'DeciLiters';
+ SDecisteresDescription = 'Decisteres';
+ SHectoLitersDescription = 'HectoLiters';
+ SKiloLitersDescription = 'KiloLiters';
+ SLitersDescription = 'Liters';
+ SMilliLitersDescription = 'MilliLiters';
+ SSteresDescription = 'Steres';
+ SVolumeDescription = 'Volume';
+
+ // US Fluid Units
+ SFluidCupsDescription = 'FluidCups';
+ SFluidGallonsDescription = 'FluidGallons';
+ SFluidGillsDescription = 'FluidGills';
+ SFluidOuncesDescription = 'FluidOunces';
+ SFluidPintsDescription = 'FluidPints';
+ SFluidQuartsDescription = 'FluidQuarts';
+ SFluidTablespoonsDescription = 'FluidTablespoons';
+ SFluidTeaspoonsDescription = 'FluidTeaspoons';
+
+ // US Dry Units
+ SDryBucketsDescription = 'DryBuckets';
+ SDryBushelsDescription = 'DryBushels';
+ SDryGallonsDescription = 'DryGallons';
+ SDryPecksDescription = 'DryPecks';
+ SDryPintsDescription = 'DryPints';
+ SDryQuartsDescription = 'DryQuarts';
+
+ // UK Fluid/Dry Units
+ SUKBucketsDescription = 'UKBuckets';
+ SUKBushelsDescription = 'UKBushels';
+ SUKGallonsDescription = 'UKGallons';
+ SUKGillsDescription = 'UKGill';
+ SUKOuncesDescription = 'UKOunces';
+ SUKPecksDescription = 'UKPecks';
+ SUKPintsDescription = 'UKPints';
+ SUKPottlesDescription = 'UKPottle';
+ SUKQuartsDescription = 'UKQuarts';
+
+{ ---------------------------------------------------------------------
+ "Mass" family type and conversion types
+ ---------------------------------------------------------------------}
+
+ SCentigramsDescription = 'Centigrams';
+ SDecagramsDescription = 'Decagrams';
+ SDecigramsDescription = 'Decigrams';
+ SDramsDescription = 'Drams';
+ SGrainsDescription = 'Grains';
+ SGramsDescription = 'Grams';
+ SHectogramsDescription = 'Hectograms';
+ SKilogramsDescription = 'Kilograms';
+ SLongTonsDescription = 'LongTons';
+ SMassDescription = 'Mass';
+ SMetricTonsDescription = 'MetricTons';
+ SMicrogramsDescription = 'Micrograms';
+ SMilligramsDescription = 'Milligrams';
+ SNanogramsDescription = 'Nanograms';
+ SOuncesDescription = 'Ounces';
+ SPoundsDescription = 'Pounds';
+ SStonesDescription = 'Stones';
+ STonsDescription = 'Tons';
+
+{ ---------------------------------------------------------------------
+ "Temperature" family type and conversion types
+ ---------------------------------------------------------------------}
+
+ SCelsiusDescription = 'Celsius';
+ SFahrenheitDescription = 'Fahrenheit';
+ SKelvinDescription = 'Kelvin';
+ SRankineDescription = 'Rankine';
+ SReaumurDescription = 'Reaumur';
+ STemperatureDescription = 'Temperature';
+
+{ ---------------------------------------------------------------------
+ "Time" family type and conversion types
+ ---------------------------------------------------------------------}
+
+ SCenturiesDescription = 'Centuries';
+ SDateTimeDescription = 'DateTime';
+ SDaysDescription = 'Days';
+ SDecadesDescription = 'Decades';
+ SFortnightsDescription = 'Fortnights';
+ SHoursDescription = 'Hours';
+ SJulianDateDescription = 'JulianDate';
+ SMillenniaDescription = 'Millennia';
+ SMilliSecondsDescription = 'MilliSeconds';
+ SMinutesDescription = 'Minutes';
+ SModifiedJulianDateDescription = 'ModifiedJulianDate';
+ SMonthsDescription = 'Months';
+ SSecondsDescription = 'Seconds';
+ STimeDescription = 'Time';
+ SWeeksDescription = 'Weeks';
+ SYearsDescription = 'Years';
+
+{ ---------------------------------------------------------------------
+ Strings also found in SysConsts.pas
+ ---------------------------------------------------------------------}
+
+ SInvalidDate = '"%s" is not a valid date' ;
+ SInvalidDateTime = '"%s" is not a valid date and time' ;
+ SInvalidInteger = '"%s" is not a valid integer value' ;
+ SInvalidTime = '"%s" is not a valid time' ;
+ STimeEncodeError = 'Invalid argument to time encode' ;
+
+{ ---------------------------------------------------------------------
+ MCI subsystem constants
+ ---------------------------------------------------------------------}
+
+ SMCIAVIVideo = 'AVIVideo';
+ SMCICDAudio = 'CDAudio';
+ SMCIDAT = 'DAT';
+ SMCIDigitalVideo = 'DigitalVideo';
+ SMCIMMMovie = 'MMMovie';
+ SMCINil = '';
+ SMCIOther = 'Other';
+ SMCIOverlay = 'Overlay';
+ SMCIScanner = 'Scanner';
+ SMCISequencer = 'Sequencer';
+ SMCIUnknownError = 'Unknown error code';
+ SMCIVCR = 'VCR';
+ SMCIVideodisc = 'Videodisc';
+ SMCIWaveAudio = 'WaveAudio';
+
+{ ---------------------------------------------------------------------
+ Message Dialog constants
+ ---------------------------------------------------------------------}
+
+ SMsgDlgAbort = '&Abort';
+ SMsgDlgAll = '&All';
+ SMsgDlgCancel = 'Cancel';
+ SMsgDlgConfirm = 'Confirm';
+ SMsgDlgError = 'Error';
+ SMsgDlgHelp = '&Help';
+ SMsgDlgHelpHelp = 'Help';
+ SMsgDlgHelpNone = 'No help available';
+ SMsgDlgIgnore = '&Ignore';
+ SMsgDlgInformation = 'Information';
+ SMsgDlgNo = '&No';
+ SMsgDlgNoToAll = 'N&o to all';
+ SMsgDlgOK = 'OK';
+ SMsgDlgRetry = '&Retry';
+ SMsgDlgWarning = 'Warning';
+ SMsgDlgYes = '&Yes';
+ SMsgDlgYesToAll = 'Yes to A&lle';
+
+
+implementation
+
+end.
+{
+ $Log: rtlconst.inc,v $
+ Revision 1.2 2005/04/16 09:25:02 michael
+ + Added TypInfo unit constants
+
+ Revision 1.1 2005/04/14 21:47:27 hajny
+ * rtlconst/s fix for GO32v2 etc.
+
+ Revision 1.1 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/rtlconst.pp b/rtl/objpas/rtlconst.pp
new file mode 100644
index 0000000000..b961bec483
--- /dev/null
+++ b/rtl/objpas/rtlconst.pp
@@ -0,0 +1 @@
+{$I rtlconst.inc}
diff --git a/rtl/objpas/rtlconsts.pp b/rtl/objpas/rtlconsts.pp
new file mode 100644
index 0000000000..b961bec483
--- /dev/null
+++ b/rtl/objpas/rtlconsts.pp
@@ -0,0 +1 @@
+{$I rtlconst.inc}
diff --git a/rtl/objpas/strutils.pp b/rtl/objpas/strutils.pp
new file mode 100644
index 0000000000..4206c94d2a
--- /dev/null
+++ b/rtl/objpas/strutils.pp
@@ -0,0 +1,1702 @@
+{$mode objfpc}
+{$h+}
+{
+ $Id: strutils.pp,v 1.16 2005/04/14 17:43:35 michael Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Delphi/Kylix compatibility unit: String handling routines.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit strutils;
+
+interface
+
+uses
+ SysUtils{, Types};
+
+{ ---------------------------------------------------------------------
+ Case sensitive search/replace
+ ---------------------------------------------------------------------}
+
+Function AnsiResemblesText(const AText, AOther: string): Boolean;
+Function AnsiContainsText(const AText, ASubText: string): Boolean;
+Function AnsiStartsText(const ASubText, AText: string): Boolean;
+Function AnsiEndsText(const ASubText, AText: string): Boolean;
+Function AnsiReplaceText(const AText, AFromText, AToText: string): string;
+Function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;
+Function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
+
+{ ---------------------------------------------------------------------
+ Case insensitive search/replace
+ ---------------------------------------------------------------------}
+
+Function AnsiContainsStr(const AText, ASubText: string): Boolean;
+Function AnsiStartsStr(const ASubText, AText: string): Boolean;
+Function AnsiEndsStr(const ASubText, AText: string): Boolean;
+Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;
+Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;
+Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
+
+{ ---------------------------------------------------------------------
+ Playthingies
+ ---------------------------------------------------------------------}
+
+Function DupeString(const AText: string; ACount: Integer): string;
+Function ReverseString(const AText: string): string;
+Function AnsiReverseString(const AText: AnsiString): AnsiString;
+Function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string;
+Function RandomFrom(const AValues: array of string): string; overload;
+Function IfThen(AValue: Boolean; const ATrue: string; AFalse: string): string;
+Function IfThen(AValue: Boolean; const ATrue: string): string; // ; AFalse: string = ''
+
+{ ---------------------------------------------------------------------
+ VB emulations.
+ ---------------------------------------------------------------------}
+
+Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;
+Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;
+Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;
+Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;
+{$ifndef ver1_0}
+Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;
+Function LeftStr(const AText: WideString; const ACount: Integer): WideString;
+Function RightStr(const AText: WideString; const ACount: Integer): WideString;
+Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;
+{$endif}
+
+{ ---------------------------------------------------------------------
+ Extended search and replace
+ ---------------------------------------------------------------------}
+
+const
+ { Default word delimiters are any character except the core alphanumerics. }
+ WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];
+
+type
+ TStringSearchOption = (soDown, soMatchCase, soWholeWord);
+ TStringSearchOptions = set of TStringSearchOption;
+ TStringSeachOption = TStringSearchOption;
+
+Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar;
+Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar; // ; Options: TStringSearchOptions = [soDown]
+Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
+Function PosEx(const SubStr, S: string): Integer; // Offset: Cardinal = 1
+Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
+
+{ ---------------------------------------------------------------------
+ Soundex Functions.
+ ---------------------------------------------------------------------}
+
+type
+ TSoundexLength = 1..MaxInt;
+
+Function Soundex(const AText: string; ALength: TSoundexLength): string;
+Function Soundex(const AText: string): string; // ; ALength: TSoundexLength = 4
+
+type
+ TSoundexIntLength = 1..8;
+
+Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer;
+Function SoundexInt(const AText: string): Integer; //; ALength: TSoundexIntLength = 4
+Function DecodeSoundexInt(AValue: Integer): string;
+Function SoundexWord(const AText: string): Word;
+Function DecodeSoundexWord(AValue: Word): string;
+Function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength): Boolean;
+Function SoundexSimilar(const AText, AOther: string): Boolean; //; ALength: TSoundexLength = 4
+Function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength): Integer;
+Function SoundexCompare(const AText, AOther: string): Integer; //; ALength: TSoundexLength = 4
+Function SoundexProc(const AText, AOther: string): Boolean;
+
+type
+ TCompareTextProc = Function(const AText, AOther: string): Boolean;
+
+Const
+ AnsiResemblesProc: TCompareTextProc = @SoundexProc;
+
+{ ---------------------------------------------------------------------
+ Other functions, based on RxStrUtils.
+ ---------------------------------------------------------------------}
+
+function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
+function DelSpace(const S: string): string;
+function DelChars(const S: string; Chr: Char): string;
+function DelSpace1(const S: string): string;
+function Tab2Space(const S: string; Numb: Byte): string;
+function NPos(const C: string; S: string; N: Integer): Integer;
+Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
+Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
+Function RPos(c:char;const S : AnsiString):Integer; overload;
+Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
+function AddChar(C: Char; const S: string; N: Integer): string;
+function AddCharR(C: Char; const S: string; N: Integer): string;
+function PadLeft(const S: string; N: Integer): string;
+function PadRight(const S: string; N: Integer): string;
+function PadCenter(const S: string; Len: Integer): string;
+function Copy2Symb(const S: string; Symb: Char): string;
+function Copy2SymbDel(var S: string; Symb: Char): string;
+function Copy2Space(const S: string): string;
+function Copy2SpaceDel(var S: string): string;
+function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
+function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
+function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
+function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;
+function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
+function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string;
+function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
+function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
+function FindPart(const HelpWilds, InputStr: string): Integer;
+function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
+function XorString(const Key, Src: ShortString): ShortString;
+function XorEncode(const Key, Source: string): string;
+function XorDecode(const Key, Source: string): string;
+function GetCmdLineArg(const Switch: string; SwitchChars: TSysCharSet): string;
+function Numb2USA(const S: string): string;
+function Hex2Dec(const S: string): Longint;
+function Dec2Numb(N: Longint; Len, Base: Byte): string;
+function Numb2Dec(S: string; Base: Byte): Longint;
+function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
+function IntToRoman(Value: Longint): string;
+function RomanToInt(const S: string): Longint;
+procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
+function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
+
+const
+ DigitChars = ['0'..'9'];
+ Brackets = ['(',')','[',']','{','}'];
+ StdWordDelims = [#0..' ',',','.',';','/','\',':','''','"','`'] + Brackets;
+ StdSwitchChars = ['-','/'];
+
+implementation
+
+{ ---------------------------------------------------------------------
+ Auxiliary functions
+ ---------------------------------------------------------------------}
+
+Procedure NotYetImplemented (FN : String);
+
+begin
+ Raise Exception.CreateFmt('Function "%s" (strutils) is not yet implemented',[FN]);
+end;
+
+{ ---------------------------------------------------------------------
+ Case sensitive search/replace
+ ---------------------------------------------------------------------}
+
+Function AnsiResemblesText(const AText, AOther: string): Boolean;
+
+begin
+ if Assigned(AnsiResemblesProc) then
+ Result:=AnsiResemblesProc(AText,AOther)
+ else
+ Result:=False;
+end;
+
+Function AnsiContainsText(const AText, ASubText: string): Boolean;
+
+begin
+ AnsiContainsText:=Pos(ASubText,AText)<>0;
+end;
+
+Function AnsiStartsText(const ASubText, AText: string): Boolean;
+begin
+ Result:=Copy(AText,1,Length(AsubText))=ASubText;
+end;
+
+Function AnsiEndsText(const ASubText, AText: string): Boolean;
+begin
+ result:=Copy(AText,Length(AText)-Length(ASubText)+1,Length(ASubText))=asubtext;
+end;
+
+Function AnsiReplaceText(const AText, AFromText, AToText: string): string;
+
+var iFrom, iTo: longint;
+
+begin
+ iTo:=Pos(AFromText,AText);
+ if iTo=0 then
+ result:=AText
+ else
+ begin
+ result:='';
+ iFrom:=1;
+ while (ito<>0) do
+ begin
+ result:=Result+Copy(AText,IFrom,Ito-IFrom+1)+AToText;
+ ifrom:=ITo+Length(afromtext);
+ ito:=Posex(Afromtext,atext,ifrom);
+ end;
+ if ifrom<=length(atext) then
+ result:=result+copy(AText,ifrom, length(atext));
+ end;
+end;
+
+Function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;
+
+begin
+ Result:=(AnsiIndexText(AText,AValues)<>-1)
+end;
+
+
+
+Function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
+
+var i : longint;
+
+begin
+ result:=-1;
+ if high(AValues)=-1 Then
+ Exit;
+ for i:=low(AValues) to High(Avalues) do
+ if CompareText(avalues[i],atext)=0 Then
+ exit(i); // make sure it is the first val.
+end;
+
+
+{ ---------------------------------------------------------------------
+ Case insensitive search/replace
+ ---------------------------------------------------------------------}
+
+Function AnsiContainsStr(const AText, ASubText: string): Boolean;
+
+begin
+ Result := Pos(ASubText,AText)<>0;
+end;
+
+
+
+Function AnsiStartsStr(const ASubText, AText: string): Boolean;
+
+begin
+ Result := Pos(ASubText,AText)=1;
+end;
+
+
+
+Function AnsiEndsStr(const ASubText, AText: string): Boolean;
+
+begin
+ Result := Pos(ASubText,AText)=(length(AText)-length(ASubText)+1);
+end;
+
+
+Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;
+
+begin
+Result := StringReplace(AText,AFromText,AToText,[rfReplaceAll]);
+end;
+
+
+
+Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;
+
+begin
+ Result:=AnsiIndexStr(AText,Avalues)<>-1;
+end;
+
+
+Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
+
+var i : longint;
+
+begin
+ result:=-1;
+ if high(AValues)=-1 Then
+ Exit;
+ for i:=low(AValues) to High(Avalues) do
+ if (avalues[i]=AText) Then
+ exit(i); // make sure it is the first val.
+end;
+
+
+
+
+{ ---------------------------------------------------------------------
+ Playthingies
+ ---------------------------------------------------------------------}
+
+Function DupeString(const AText: string; ACount: Integer): string;
+
+var i,l : integer;
+
+begin
+ result:='';
+ if aCount>=0 then
+ begin
+ l:=length(atext);
+ SetLength(result,aCount*l);
+ for i:=0 to ACount-1 do
+ move(atext[1],Result[l*i+1],l);
+ end;
+end;
+
+Function ReverseString(const AText: string): string;
+
+var
+ i,j:longint;
+
+begin
+ setlength(result,length(atext));
+ i:=1; j:=length(atext);
+ while (i<=j) do
+ begin
+ result[i]:=atext[j-i+1];
+ inc(i);
+ end;
+end;
+
+
+Function AnsiReverseString(const AText: AnsiString): AnsiString;
+
+begin
+ Result:=ReverseString(AText);
+end;
+
+
+
+Function StuffString(const AText: string; AStart, ALength: Cardinal; const ASubText: string): string;
+
+var i,j : longint;
+
+begin
+ j:=length(ASubText);
+ i:=length(AText);
+ SetLength(Result,i-ALength+j);
+ move (AText[1],result[1],AStart-1);
+ move (ASubText[1],result[AStart],j);
+ move (AText[AStart+ALength], Result[AStart+j],i-AStart-ALength+1);
+end;
+
+
+
+Function RandomFrom(const AValues: array of string): string; overload;
+
+begin
+ if high(AValues)=-1 then exit('');
+ result:=Avalues[random(High(AValues)+1)];
+end;
+
+
+
+Function IfThen(AValue: Boolean; const ATrue: string; AFalse: string): string;
+
+begin
+ if avalue then
+ result:=atrue
+ else
+ result:=afalse;
+end;
+
+
+
+Function IfThen(AValue: Boolean; const ATrue: string): string; // ; AFalse: string = ''
+
+begin
+ if avalue then
+ result:=atrue
+ else
+ result:='';
+end;
+
+
+
+{ ---------------------------------------------------------------------
+ VB emulations.
+ ---------------------------------------------------------------------}
+
+Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+
+begin
+ Result:=Copy(AText,1,ACount);
+end;
+
+Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+
+var j,l:integer;
+
+begin
+ l:=length(atext);
+ j:=ACount;
+ if j>l then j:=l;
+ Result:=Copy(AText,l-j+1,j);
+end;
+
+Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;
+
+begin
+ if (ACount=0) or (AStart>length(atext)) then
+ exit('');
+ Result:=Copy(AText,AStart,ACount);
+end;
+
+
+
+Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;
+
+begin
+ Result:=LeftStr(AText,AByteCount);
+end;
+
+
+
+Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;
+
+begin
+ Result:=RightStr(Atext,AByteCount);
+end;
+
+
+
+Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;
+
+begin
+ Result:=MidStr(AText,AByteStart,AByteCount);
+end;
+
+
+
+Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+
+begin
+ Result := copy(AText,1,ACount);
+end;
+
+
+
+Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+
+begin
+ Result := copy(AText,length(AText)-ACount+1,ACount);
+end;
+
+
+
+Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;
+
+begin
+ Result:=Copy(AText,AStart,ACount);
+end;
+
+{$ifndef ver1_0}
+Function LeftStr(const AText: WideString; const ACount: Integer): WideString;
+
+begin
+ Result:=Copy(AText,1,ACount);
+end;
+
+
+
+Function RightStr(const AText: WideString; const ACount: Integer): WideString;
+
+var
+ j,l:integer;
+
+begin
+ l:=length(atext);
+ j:=ACount;
+ if j>l then j:=l;
+ Result:=Copy(AText,l-j+1,j);
+end;
+
+
+
+Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;
+
+begin
+ Result:=Copy(AText,AStart,ACount);
+end;
+{$endif}
+
+
+
+
+{ ---------------------------------------------------------------------
+ Extended search and replace
+ ---------------------------------------------------------------------}
+
+Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar;
+
+var
+ Len,I,SLen: Integer;
+ C: Char;
+ Found : Boolean;
+ Direction: Shortint;
+ CharMap: array[Char] of Char;
+
+ Function GotoNextWord(var P : PChar): Boolean;
+
+ begin
+ if (Direction=1) then
+ begin
+ // Skip characters
+ While (Len>0) and not (P^ in WordDelimiters) do
+ begin
+ Inc(P);
+ Dec(Len);
+ end;
+ // skip delimiters
+ While (Len>0) and (P^ in WordDelimiters) do
+ begin
+ Inc(P);
+ Dec(Len);
+ end;
+ Result:=Len>0;
+ end
+ else
+ begin
+ // Skip Delimiters
+ While (Len>0) and (P^ in WordDelimiters) do
+ begin
+ Dec(P);
+ Dec(Len);
+ end;
+ // skip characters
+ While (Len>0) and not (P^ in WordDelimiters) do
+ begin
+ Dec(P);
+ Dec(Len);
+ end;
+ Result:=Len>0;
+ // We're on the first delimiter. Pos back on char.
+ Inc(P);
+ Inc(Len);
+ end;
+ end;
+
+begin
+ Result:=nil;
+ Slen:=Length(SearchString);
+ if (BufLen<=0) or (Slen=0) then
+ Exit;
+ if soDown in Options then
+ begin
+ Direction:=1;
+ Inc(SelStart,SelLength);
+ Len:=BufLen-SelStart-SLen+1;
+ if (Len<=0) then
+ Exit;
+ end
+ else
+ begin
+ Direction:=-1;
+ Dec(SelStart,Length(SearchString));
+ Len:=SelStart+1;
+ end;
+ if (SelStart<0) or (SelStart>BufLen) then
+ Exit;
+ Result:=@Buf[SelStart];
+ for C:=Low(Char) to High(Char) do
+ if (soMatchCase in Options) then
+ CharMap[C]:=C
+ else
+ CharMap[C]:=Upcase(C);
+ if Not (soMatchCase in Options) then
+ SearchString:=UpCase(SearchString);
+ Found:=False;
+ while (Result<>Nil) and (Not Found) do
+ begin
+ if ((soWholeWord in Options) and
+ (Result<>@Buf[SelStart]) and
+ not GotoNextWord(Result)) then
+ Result:=Nil
+ else
+ begin
+ // try to match whole searchstring
+ I:=0;
+ while (I<Slen) and (CharMap[Result[I]]=SearchString[I+1]) do
+ Inc(I);
+ // Whole searchstring matched ?
+ if (I=SLen) then
+ Found:=(Len=0) or
+ (not (soWholeWord in Options)) or
+ (Result[SLen] in WordDelimiters);
+ if not Found then
+ begin
+ Inc(Result,Direction);
+ Dec(Len);
+ If (Len=0) then
+ Result:=Nil;
+ end;
+ end;
+ end;
+end;
+
+
+
+Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar; // ; Options: TStringSearchOptions = [soDown]
+
+begin
+ Result:=SearchBuf(Buf,BufLen,SelStart,SelLength,SearchString,[soDown]);
+end;
+
+
+
+Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
+
+var i : pchar;
+begin
+ if (offset<1) or (offset>length(s)) then exit(0);
+ i:=strpos(@s[offset],@substr[1]);
+ if i=nil then
+ PosEx:=0
+ else
+ PosEx:=succ(i-pchar(s));
+end;
+
+
+Function PosEx(const SubStr, S: string): Integer; // Offset: Cardinal = 1
+
+begin
+ posex:=posex(substr,s,1);
+end;
+
+Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
+
+var l : longint;
+begin
+ if (offset<1) or (offset>length(s)) then exit(0);
+ l:=length(s);
+{$ifndef useindexbyte}
+ while (offset<=l) and (s[offset]<>c) do inc(offset);
+ if offset>l then
+ posex:=0
+ else
+ posex:=offset;
+{$else}
+ posex:=offset+indexbyte(s[offset],l-offset+1);
+ if posex=(offset-1) then
+ posex:=0;
+{$endif}
+end;
+
+
+{ ---------------------------------------------------------------------
+ Soundex Functions.
+ ---------------------------------------------------------------------}
+Const
+SScore : array[1..255] of Char =
+ ('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', // 1..32
+ '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', // 33..64
+ '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 64..90
+ '0','0','0','0','0','0', // 91..95
+ '0','1','2','3','0','1','2','i','0','2','2','4','5','5','0','1','2','6','2','3','0','1','i','2','i','2', // 96..122
+ '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', // 123..154
+ '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', // 155..186
+ '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', // 187..218
+ '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', // 219..250
+ '0','0','0','0','0'); // 251..255
+
+
+
+Function Soundex(const AText: string; ALength: TSoundexLength): string;
+
+Var
+ S,PS : Char;
+ I,L : integer;
+
+begin
+ Result:='';
+ PS:=#0;
+ If Length(AText)>0 then
+ begin
+ Result:=Upcase(AText[1]);
+ I:=2;
+ L:=Length(AText);
+ While (I<=L) and (Length(Result)<ALength) do
+ begin
+ S:=SScore[Ord(AText[i])];
+ If Not (S in ['0','i',PS]) then
+ Result:=Result+S;
+ If (S<>'i') then
+ PS:=S;
+ Inc(I);
+ end;
+ end;
+ L:=Length(Result);
+ If (L<ALength) then
+ Result:=Result+StringOfChar('0',Alength-L);
+end;
+
+
+
+Function Soundex(const AText: string): string; // ; ALength: TSoundexLength = 4
+
+begin
+ Result:=Soundex(AText,4);
+end;
+
+Const
+ Ord0 = Ord('0');
+ OrdA = Ord('A');
+
+Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer;
+
+var
+ SE: string;
+ I: Integer;
+
+begin
+ Result:=-1;
+ SE:=Soundex(AText,ALength);
+ If Length(SE)>0 then
+ begin
+ Result:=Ord(SE[1])-OrdA;
+ if ALength > 1 then
+ begin
+ Result:=Result*26+(Ord(SE[2])-Ord0);
+ for I:=3 to ALength do
+ Result:=(Ord(SE[I])-Ord0)+Result*7;
+ end;
+ Result:=ALength+Result*9;
+ end;
+end;
+
+
+
+Function SoundexInt(const AText: string): Integer; //; ALength: TSoundexIntLength = 4
+
+begin
+ Result:=SoundexInt(AText,4);
+end;
+
+
+
+Function DecodeSoundexInt(AValue: Integer): string;
+
+var
+ I, Len: Integer;
+
+begin
+ Result := '';
+ Len := AValue mod 9;
+ AValue := AValue div 9;
+ for I:=Len downto 3 do
+ begin
+ Result:=Chr(Ord0+(AValue mod 7))+Result;
+ AValue:=AValue div 7;
+ end;
+ if Len>2 then
+ Result:=IntToStr(AValue mod 26)+Result;
+ AValue:=AValue div 26;
+ Result:=Chr(OrdA+AValue)+Result;
+end;
+
+
+
+Function SoundexWord(const AText: string): Word;
+
+Var
+ S : String;
+
+begin
+ S:=SoundEx(Atext,4);
+ Result:=Ord(S[1])-OrdA;
+ Result:=Result*26+StrToInt(S[2]);
+ Result:=Result*7+StrToInt(S[3]);
+ Result:=Result*7+StrToInt(S[4]);
+end;
+
+
+
+Function DecodeSoundexWord(AValue: Word): string;
+
+begin
+ Result := Chr(Ord0+ (AValue mod 7));
+ AValue := AValue div 7;
+ Result := Chr(Ord0+ (AValue mod 7)) + Result;
+ AValue := AValue div 7;
+ Result := IntToStr(AValue mod 26) + Result;
+ AValue := AValue div 26;
+ Result := Chr(OrdA+AValue) + Result;
+end;
+
+
+
+Function SoundexSimilar(const AText, AOther: string; ALength: TSoundexLength): Boolean;
+
+begin
+ Result:=Soundex(AText,ALength)=Soundex(AOther,ALength);
+end;
+
+
+
+Function SoundexSimilar(const AText, AOther: string): Boolean; //; ALength: TSoundexLength = 4
+
+begin
+ Result:=SoundexSimilar(AText,AOther,4);
+end;
+
+
+
+Function SoundexCompare(const AText, AOther: string; ALength: TSoundexLength): Integer;
+
+begin
+ Result:=AnsiCompareStr(Soundex(AText,ALength),Soundex(AOther,ALength));
+end;
+
+
+
+Function SoundexCompare(const AText, AOther: string): Integer; //; ALength: TSoundexLength = 4
+
+begin
+ Result:=SoundexCompare(AText,AOther,4);
+end;
+
+
+
+Function SoundexProc(const AText, AOther: string): Boolean;
+
+begin
+ Result:=SoundexSimilar(AText,AOther);
+end;
+
+{ ---------------------------------------------------------------------
+ RxStrUtils-like functions.
+ ---------------------------------------------------------------------}
+
+
+function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
+
+var
+ i,l: Integer;
+
+begin
+ l:=Length(S);
+ i:=1;
+ Result:=True;
+ while Result and (i<=l) do
+ begin
+ Result:=Not (S[i] in EmptyChars);
+ Inc(i);
+ end;
+end;
+
+function DelSpace(const S: String): string;
+
+begin
+ Result:=DelChars(S,' ');
+end;
+
+function DelChars(const S: string; Chr: Char): string;
+
+var
+ I,J: Integer;
+
+begin
+ Result:=S;
+ I:=Length(Result);
+ While I>0 do
+ begin
+ if Result[I]=Chr then
+ begin
+ J:=I-1;
+ While (J>0) and (Result[J]=Chr) do
+ Dec(j);
+ Delete(Result,J+1,I-J);
+ I:=J+1;
+ end;
+ dec(I);
+ end;
+end;
+
+function DelSpace1(const S: string): string;
+
+var
+ i: Integer;
+
+begin
+ Result:=S;
+ for i:=Length(Result) downto 2 do
+ if (Result[i]=' ') and (Result[I-1]=' ') then
+ Delete(Result,I,1);
+end;
+
+function Tab2Space(const S: string; Numb: Byte): string;
+
+var
+ I: Integer;
+
+begin
+ I:=1;
+ Result:=S;
+ while I <= Length(Result) do
+ if Result[I]<>Chr(9) then
+ inc(I)
+ else
+ begin
+ Result[I]:=' ';
+ If (Numb>1) then
+ Insert(StringOfChar('0',Numb-1),Result,I);
+ Inc(I,Numb);
+ end;
+end;
+
+function NPos(const C: string; S: string; N: Integer): Integer;
+
+var
+ i,p,k: Integer;
+
+begin
+ Result:=0;
+ if N<1 then
+ Exit;
+ k:=0;
+ i:=1;
+ Repeat
+ p:=pos(C,S);
+ Inc(k,p);
+ if p>0 then
+ delete(S,1,p);
+ Inc(i);
+ Until (i>n) or (p=0);
+ If (P>0) then
+ Result:=K;
+end;
+
+function AddChar(C: Char; const S: string; N: Integer): string;
+
+Var
+ l : Integer;
+
+begin
+ Result:=S;
+ l:=Length(Result);
+ if l<N then
+ Result:=StringOfChar(C,N-l)+Result;
+end;
+
+function AddCharR(C: Char; const S: string; N: Integer): string;
+
+Var
+ l : Integer;
+
+begin
+ Result:=S;
+ l:=Length(Result);
+ if l<N then
+ Result:=Result+StringOfChar(C,N-l);
+end;
+
+function PadRight(const S: string; N: Integer): string;
+begin
+ Result:=AddCharR(' ',S,N);
+end;
+
+function PadLeft(const S: string; N: Integer): string;
+begin
+ Result:=AddChar(' ',S,N);
+end;
+
+function Copy2Symb(const S: string; Symb: Char): string;
+
+var
+ p: Integer;
+
+begin
+ p:=Pos(Symb,S);
+ if p=0 then
+ p:=Length(S)+1;
+ Result:=Copy(S,1,p-1);
+end;
+
+function Copy2SymbDel(var S: string; Symb: Char): string;
+
+begin
+ Result:=Copy2Symb(S,Symb);
+ S:=TrimRight(Copy(S,Length(Result)+1,Length(S)));
+end;
+
+function Copy2Space(const S: string): string;
+begin
+ Result:=Copy2Symb(S,' ');
+end;
+
+function Copy2SpaceDel(var S: string): string;
+begin
+ Result:=Copy2SymbDel(S,' ');
+end;
+
+function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
+
+var
+// l : Integer;
+ P,PE : PChar;
+
+begin
+ Result:=AnsiLowerCase(S);
+ P:=PChar(Result);
+ PE:=P+Length(Result);
+ while (P<PE) do
+ begin
+ while (P<PE) and (P^ in WordDelims) do
+ inc(P);
+ if (P<PE) then
+ P^:=UpCase(P^);
+ while (P<PE) and not (P^ in WordDelims) do
+ inc(P);
+ end;
+end;
+
+function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
+
+var
+ P,PE : PChar;
+
+begin
+ Result:=0;
+ P:=Pchar(S);
+ PE:=P+Length(S);
+ while (P<PE) do
+ begin
+ while (P<PE) and (P^ in WordDelims) do
+ Inc(P);
+ if (P<PE) then
+ inc(Result);
+ while (P<PE) and not (P^ in WordDelims) do
+ inc(P);
+ end;
+end;
+
+function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
+
+var
+ PS,P,PE : PChar;
+ Count: Integer;
+
+begin
+ Result:=0;
+ Count:=0;
+ PS:=PChar(S);
+ PE:=PS+Length(S);
+ P:=PS;
+ while (P<PE) and (Count<>N) do
+ begin
+ while (P<PE) and (P^ in WordDelims) do
+ inc(P);
+ if (P<PE) then
+ inc(Count);
+ if (Count<>N) then
+ while (P<PE) and not (P^ in WordDelims) do
+ inc(P)
+ else
+ Result:=(P-PS)+1;
+ end;
+end;
+
+function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;
+
+var
+ i: Integer;
+
+begin
+ Result:=ExtractWordPos(N,S,WordDelims,i);
+end;
+
+function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
+var
+ i,j,l: Integer;
+begin
+ j:=0;
+ i:=WordPosition(N, S, WordDelims);
+ Pos:=i;
+ if (i<>0) then
+ begin
+ j:=i;
+ l:=Length(S);
+ while (j<=L) and not (S[j] in WordDelims) do
+ inc(j);
+ end;
+ SetLength(Result,j-i);
+ If ((j-i)>0) then
+ Move(S[i],Result[1],j-i);
+end;
+
+function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string;
+var
+ w,i,l,len: Integer;
+begin
+ w:=0;
+ i:=1;
+ l:=0;
+ len:=Length(S);
+ SetLength(Result, 0);
+ while (i<=len) and (w<>N) do
+ begin
+ if s[i] in Delims then
+ inc(w)
+ else
+ begin
+ if (N-1)=w then
+ begin
+ inc(l);
+ SetLength(Result,l);
+ Result[L]:=S[i];
+ end;
+ end;
+ inc(i);
+ end;
+end;
+
+function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
+
+var
+ i,l: Integer;
+
+begin
+ i:=Pos;
+ l:=Length(S);
+ while (i<=l) and not (S[i] in Delims) do
+ inc(i);
+ Result:=Copy(S,Pos,i-Pos);
+ if (i<=l) and (S[i] in Delims) then
+ inc(i);
+ Pos:=i;
+end;
+
+function isWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
+
+var
+ i,Count : Integer;
+
+begin
+ Result:=False;
+ Count:=WordCount(S, WordDelims);
+ I:=1;
+ While (Not Result) and (I<=Count) do
+ Result:=ExtractWord(i,S,WordDelims)=W;
+end;
+
+
+function Numb2USA(const S: string): string;
+var
+ i, NA: Integer;
+begin
+ i:=Length(S);
+ Result:=S;
+ NA:=0;
+ while (i > 0) do begin
+ if ((Length(Result) - i + 1 - NA) mod 3 = 0) and (i <> 1) then
+ begin
+ insert(',', Result, i);
+ inc(NA);
+ end;
+ Dec(i);
+ end;
+end;
+
+function PadCenter(const S: string; Len: Integer): string;
+begin
+ if Length(S)<Len then
+ begin
+ Result:=StringOfChar(' ',(Len div 2) -(Length(S) div 2))+S;
+ Result:=Result+StringOfChar(' ',Len-Length(Result));
+ end
+ else
+ Result:=S;
+end;
+
+function Hex2Dec(const S: string): Longint;
+var
+ HexStr: string;
+begin
+ if Pos('$',S)=0 then
+ HexStr:='$'+ S
+ else
+ HexStr:=S;
+ Result:=StrTointDef(HexStr,0);
+end;
+
+function Dec2Numb(N: Longint; Len, Base: Byte): string;
+
+var
+ C: Integer;
+ Number: Longint;
+
+begin
+ if N=0 then
+ Result:='0'
+ else
+ begin
+ Number:=N;
+ Result:='';
+ while Number>0 do
+ begin
+ C:=Number mod Base;
+ if C>9 then
+ C:=C+55
+ else
+ C:=C+48;
+ Result:=Chr(C)+Result;
+ Number:=Number div Base;
+ end;
+ end;
+ if (Result<>'') then
+ Result:=AddChar('0',Result,Len);
+end;
+
+function Numb2Dec(S: string; Base: Byte): Longint;
+
+var
+ i, P: Longint;
+
+begin
+ i:=Length(S);
+ Result:=0;
+ S:=UpperCase(S);
+ P:=1;
+ while (i>=1) do
+ begin
+ if (S[i]>'@') then
+ Result:=Result+(Ord(S[i])-55)*P
+ else
+ Result:=Result+(Ord(S[i])-48)*P;
+ Dec(i);
+ P:=P*Base;
+ end;
+end;
+
+function RomanToint(const S: string): Longint;
+
+const
+ RomanChars = ['C','D','i','L','M','V','X'];
+ RomanValues : array['C'..'X'] of Word
+ = (100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10);
+
+var
+ index, Next: Char;
+ i,l: Integer;
+ Negative: Boolean;
+
+begin
+ Result:=0;
+ i:=0;
+ Negative:=(Length(S)>0) and (S[1]='-');
+ if Negative then
+ inc(i);
+ l:=Length(S);
+ while (i<l) do
+ begin
+ inc(i);
+ index:=UpCase(S[i]);
+ if index in RomanChars then
+ begin
+ if Succ(i)<=l then
+ Next:=UpCase(S[i+1])
+ else
+ Next:=#0;
+ if (Next in RomanChars) and (RomanValues[index]<RomanValues[Next]) then
+ begin
+ inc(Result, RomanValues[Next]);
+ Dec(Result, RomanValues[index]);
+ inc(i);
+ end
+ else
+ inc(Result, RomanValues[index]);
+ end
+ else
+ begin
+ Result:=0;
+ Exit;
+ end;
+ end;
+ if Negative then
+ Result:=-Result;
+end;
+
+function intToRoman(Value: Longint): string;
+
+const
+ Arabics : Array[1..13] of Integer
+ = (1,4,5,9,10,40,50,90,100,400,500,900,1000);
+ Romans : Array[1..13] of String
+ = ('i','iV','V','iX','X','XL','L','XC','C','CD','D','CM','M');
+
+var
+ i: Integer;
+
+begin
+ for i:=13 downto 1 do
+ while (Value >= Arabics[i]) do
+ begin
+ Value:=Value-Arabics[i];
+ Result:=Result+Romans[i];
+ end;
+end;
+
+function intToBin(Value: Longint; Digits, Spaces: Integer): string;
+begin
+ Result:='';
+ if (Digits>32) then
+ Digits:=32;
+ while (Digits>0) do
+ begin
+ if (Digits mod Spaces)=0 then
+ Result:=Result+' ';
+ Dec(Digits);
+ Result:=Result+intToStr((Value shr Digits) and 1);
+ end;
+end;
+
+function FindPart(const HelpWilds, inputStr: string): Integer;
+var
+ i, J: Integer;
+ Diff: Integer;
+begin
+ Result:=0;
+ i:=Pos('?',HelpWilds);
+ if (i=0) then
+ Result:=Pos(HelpWilds, inputStr)
+ else
+ begin
+ Diff:=Length(inputStr) - Length(HelpWilds);
+ for i:=0 to Diff do
+ begin
+ for J:=1 to Length(HelpWilds) do
+ if (inputStr[i + J] = HelpWilds[J]) or (HelpWilds[J] = '?') then
+ begin
+ if (J=Length(HelpWilds)) then
+ begin
+ Result:=i+1;
+ Exit;
+ end;
+ end
+ else
+ Break;
+ end;
+ end;
+end;
+
+function isWild(inputStr, Wilds: string; ignoreCase: Boolean): Boolean;
+
+ function SearchNext(var Wilds: string): Integer;
+
+ begin
+ Result:=Pos('*', Wilds);
+ if Result>0 then
+ Wilds:=Copy(Wilds,1,Result - 1);
+ end;
+
+var
+ CWild, CinputWord: Integer; { counter for positions }
+ i, LenHelpWilds: Integer;
+ MaxinputWord, MaxWilds: Integer; { Length of inputStr and Wilds }
+ HelpWilds: string;
+begin
+ if Wilds = inputStr then begin
+ Result:=True;
+ Exit;
+ end;
+ repeat { delete '**', because '**' = '*' }
+ i:=Pos('**', Wilds);
+ if i > 0 then
+ Wilds:=Copy(Wilds, 1, i - 1) + '*' + Copy(Wilds, i + 2, Maxint);
+ until i = 0;
+ if Wilds = '*' then begin { for fast end, if Wilds only '*' }
+ Result:=True;
+ Exit;
+ end;
+ MaxinputWord:=Length(inputStr);
+ MaxWilds:=Length(Wilds);
+ if ignoreCase then begin { upcase all letters }
+ inputStr:=AnsiUpperCase(inputStr);
+ Wilds:=AnsiUpperCase(Wilds);
+ end;
+ if (MaxWilds = 0) or (MaxinputWord = 0) then begin
+ Result:=False;
+ Exit;
+ end;
+ CinputWord:=1;
+ CWild:=1;
+ Result:=True;
+ repeat
+ if inputStr[CinputWord] = Wilds[CWild] then begin { equal letters }
+ { goto next letter }
+ inc(CWild);
+ inc(CinputWord);
+ Continue;
+ end;
+ if Wilds[CWild] = '?' then begin { equal to '?' }
+ { goto next letter }
+ inc(CWild);
+ inc(CinputWord);
+ Continue;
+ end;
+ if Wilds[CWild] = '*' then begin { handling of '*' }
+ HelpWilds:=Copy(Wilds, CWild + 1, MaxWilds);
+ i:=SearchNext(HelpWilds);
+ LenHelpWilds:=Length(HelpWilds);
+ if i = 0 then begin
+ { no '*' in the rest, compare the ends }
+ if HelpWilds = '' then Exit; { '*' is the last letter }
+ { check the rest for equal Length and no '?' }
+ for i:=0 to LenHelpWilds - 1 do begin
+ if (HelpWilds[LenHelpWilds - i] <> inputStr[MaxinputWord - i]) and
+ (HelpWilds[LenHelpWilds - i]<> '?') then
+ begin
+ Result:=False;
+ Exit;
+ end;
+ end;
+ Exit;
+ end;
+ { handle all to the next '*' }
+ inc(CWild, 1 + LenHelpWilds);
+ i:=FindPart(HelpWilds, Copy(inputStr, CinputWord, Maxint));
+ if i= 0 then begin
+ Result:=False;
+ Exit;
+ end;
+ CinputWord:=i + LenHelpWilds;
+ Continue;
+ end;
+ Result:=False;
+ Exit;
+ until (CinputWord > MaxinputWord) or (CWild > MaxWilds);
+ { no completed evaluation }
+ if CinputWord <= MaxinputWord then Result:=False;
+ if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result:=False;
+end;
+
+function XorString(const Key, Src: ShortString): ShortString;
+var
+ i: Integer;
+begin
+ Result:=Src;
+ if Length(Key) > 0 then
+ for i:=1 to Length(Src) do
+ Result[i]:=Chr(Byte(Key[1 + ((i - 1) mod Length(Key))]) xor Ord(Src[i]));
+end;
+
+function XorEncode(const Key, Source: string): string;
+
+var
+ i: Integer;
+ C: Byte;
+
+begin
+ Result:='';
+ for i:=1 to Length(Source) do
+ begin
+ if Length(Key) > 0 then
+ C:=Byte(Key[1 + ((i - 1) mod Length(Key))]) xor Byte(Source[i])
+ else
+ C:=Byte(Source[i]);
+ Result:=Result+AnsiLowerCase(intToHex(C, 2));
+ end;
+end;
+
+function XorDecode(const Key, Source: string): string;
+var
+ i: Integer;
+ C: Char;
+begin
+ Result:='';
+ for i:=0 to Length(Source) div 2 - 1 do
+ begin
+ C:=Chr(StrTointDef('$' + Copy(Source, (i * 2) + 1, 2), Ord(' ')));
+ if Length(Key) > 0 then
+ C:=Chr(Byte(Key[1 + (i mod Length(Key))]) xor Byte(C));
+ Result:=Result + C;
+ end;
+end;
+
+function GetCmdLineArg(const Switch: string; SwitchChars: TSysCharSet): string;
+var
+ i: Integer;
+ S: string;
+begin
+ i:=1;
+ Result:='';
+ while (Result='') and (i<=ParamCount) do
+ begin
+ S:=ParamStr(i);
+ if (SwitchChars=[]) or ((S[1] in SwitchChars) and (Length(S) > 1)) and
+ (AnsiCompareText(Copy(S,2,Length(S)-1),Switch)=0) then
+ begin
+ inc(i);
+ if i<=ParamCount then
+ Result:=ParamStr(i);
+ end;
+ inc(i);
+ end;
+end;
+
+Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
+
+var I : Integer;
+ p,p2: pChar;
+
+Begin
+ I:=Length(S);
+ If (I<>0) and (offs<=i) Then
+ begin
+ p:=@s[offs];
+ p2:=@s[1];
+ while (p2<=p) and (p^<>c) do dec(p);
+ RPosEx:=(p-p2)+1;
+ end
+ else
+ RPosEX:=0;
+End;
+
+Function RPos(c:char;const S : AnsiString):Integer; overload;
+
+var I : Integer;
+ p,p2: pChar;
+
+Begin
+ I:=Length(S);
+ If I<>0 Then
+ begin
+ p:=@s[i];
+ p2:=@s[1];
+ while (p2<=p) and (p^<>c) do dec(p);
+ i:=p-p2+1;
+ end;
+ RPos:=i;
+End;
+
+Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
+var
+ MaxLen,llen : Integer;
+ c : char;
+ pc,pc2 : pchar;
+begin
+ rPos:=0;
+ llen:=Length(SubStr);
+ maxlen:=length(source);
+ if (llen>0) and (maxlen>0) and ( llen<=maxlen) then
+ begin
+ // i:=maxlen;
+ pc:=@source[maxlen];
+ pc2:=@source[llen-1];
+ c:=substr[llen];
+ while pc>=pc2 do
+ begin
+ if (c=pc^) and
+ (CompareChar(Substr[1],pchar(pc-llen+1)^,Length(SubStr))=0) then
+ begin
+ rPos:=pchar(pc-llen+1)-pchar(@source[1])+1;
+ exit;
+ end;
+ dec(pc);
+ end;
+ end;
+end;
+
+Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
+var
+ MaxLen,llen : Integer;
+ c : char;
+ pc,pc2 : pchar;
+begin
+ rPosex:=0;
+ llen:=Length(SubStr);
+ maxlen:=length(source);
+ if offs<maxlen then maxlen:=offs;
+ if (llen>0) and (maxlen>0) and ( llen<=maxlen) then
+ begin
+// i:=maxlen;
+ pc:=@source[maxlen];
+ pc2:=@source[llen-1];
+ c:=substr[llen];
+ while pc>=pc2 do
+ begin
+ if (c=pc^) and
+ (CompareChar(Substr[1],pchar(pc-llen+1)^,Length(SubStr))=0) then
+ begin
+ rPosex:=pchar(pc-llen+1)-pchar(@source[1])+1;
+ exit;
+ end;
+ dec(pc);
+ end;
+ end;
+end;
+
+// def from delphi.about.com:
+procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
+
+Const
+ HexDigits='0123456789ABCDEF';
+var
+ i : longint;
+begin
+ for i:=0 to binbufsize-1 do
+ begin
+ HexValue[0]:=hexdigits[1+((ord(binvalue^) shr 4))];
+ HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
+ inc(hexvalue,2);
+ inc(binvalue);
+ end;
+end;
+
+
+function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
+// more complex, have to accept more than bintohex
+// A..F    1000001
+// a..f    1100001
+// 0..9     110000
+
+var i,j,h,l : integer;
+
+begin
+ i:=binbufsize;
+ while (i>0) do
+ begin
+ if hexvalue^ IN ['A'..'F','a'..'f'] then
+ h:=((ord(hexvalue^)+9) and 15)
+ else if hexvalue^ IN ['0'..'9'] then
+ h:=((ord(hexvalue^)) and 15)
+ else
+ break;
+ inc(hexvalue);
+ if hexvalue^ IN ['A'..'F','a'..'f'] then
+ l:=(ord(hexvalue^)+9) and 15
+ else if hexvalue^ IN ['0'..'9'] then
+ l:=(ord(hexvalue^)) and 15
+ else
+ break;
+ j := l + (h shl 4);
+ inc(hexvalue);
+ binvalue^:=chr(j);
+ inc(binvalue);
+ dec(i);
+ end;
+ result:=binbufsize-i;
+end;
+
+end.
+
+{
+ $Log: strutils.pp,v $
+ Revision 1.16 2005/04/14 17:43:35 michael
+ + Fix for BintoHex and hextobin by Uberto Barbini
+
+ Revision 1.15 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.13 2005/02/03 21:38:17 marco
+ * committed bintohex and hextobin
+
+ Revision 1.12 2005/01/26 11:05:09 marco
+ * fix
+
+ Revision 1.11 2005/01/01 18:45:25 marco
+ * rpos and rposex, both two versions
+
+}
diff --git a/rtl/objpas/sysconst.pp b/rtl/objpas/sysconst.pp
new file mode 100644
index 0000000000..244e17b02d
--- /dev/null
+++ b/rtl/objpas/sysconst.pp
@@ -0,0 +1,238 @@
+{
+ $Id: sysconst.pp,v 1.17 2005/03/28 13:38:05 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$H+}
+unit sysconst;
+
+interface
+
+resourcestring
+
+{ from old str*.inc files }
+
+ SAbortError = 'Operation aborted';
+ SAbstractError = 'Abstract method called';
+ SAccessDenied = 'Access denied';
+ SAccessViolation = 'Access violation';
+ SArgumentMissing = 'Missing argument in format "%s"';
+ SAssertError = '%s (%s, line %d)';
+ SAssertionFailed = 'Assertion failed';
+ SCannotCreateEmptyDir = 'Cannot create empty directory';
+ SControlC = 'Control-C hit';
+ SDiskFull = 'Disk Full';
+ SDispatchError = 'No variant method call dispatch';
+ SDivByZero = 'Division by zero';
+ SEndOfFile = 'Read past end of file';
+ SErrInvalidDateMonthWeek = 'Year %d, month %d, Week %d and day %d is not a valid date.';
+ SErrInvalidDateWeek = '%d %d %d is not a valid dateweek';
+ SErrInvalidDayOfWeek = '%d is not a valid day of the week';
+ SErrInvalidDayOfWeekInMonth = 'Year %d Month %d NDow %d DOW %d is not a valid date';
+ SErrInvalidDayOfYear = 'Year %d does not have a day number %d';
+ SErrInvalidTimeStamp = 'Invalid date/timestamp : "%s"';
+ SExceptionErrorMessage = 'exception at %p';
+ SExceptionStack = 'Exception stack error';
+ SExecuteProcessFailed = 'Failed to execute %s : %d';
+ SExternalException = 'External exception %x';
+ SFileNotAssigned = 'File not assigned';
+ SFileNotFound = 'File not found';
+ SFileNotOpen = 'File not open';
+ SFileNotOpenForInput = 'File not open for input';
+ SFileNotOpenForOutput = 'File not open for output';
+ SInValidFileName = 'Invalid filename';
+ SIntOverflow = 'Arithmetic overflow';
+ SIntfCastError = 'Interface not supported';
+ SInvalidArgIndex = 'Invalid argument index in format "%s"';
+ SInvalidBoolean = '"%s" is not a valid boolean.';
+ SInvalidCast = 'Invalid type cast';
+ SinvalidCurrency = 'Invalid currency: "%s"';
+ SInvalidDateTime = '%f is not a valid date/time value.';
+ SInvalidDrive = 'Invalid drive specified';
+ SInvalidFileHandle = 'Invalid file handle';
+ SInvalidFloat = '"%s" is an invalid float';
+ SInvalidFormat = 'Invalid format specifier : "%s"';
+ SInvalidGUID = '"%s" is not a valid GUID value';
+ SInvalidInput = 'Invalid input';
+ SInvalidInteger = '"%s" is an invalid integer';
+ SInvalidOp = 'Invalid floating point operation';
+ SInvalidPointer = 'Invalid pointer operation';
+ SInvalidVarCast = 'Invalid variant type case';
+ SInvalidVarNullOp = 'Invalid NULL variant operation';
+ SInvalidVarOp = 'Invalid variant operation';
+ SInvalidVarOpWithHResultWithPrefix = 'Invalid variant operation (%s%.8x)'+LineEnding+'%s';
+ SNoError = 'No error.';
+ SNoThreadSupport = 'Threads not supported. Recompile program with thread driver.';
+ SOSError = 'System error, (OS Code %d):'+LineEnding+'%s';
+ SOutOfMemory = 'Out of memory';
+ SOverflow = 'Floating point overflow';
+ SPrivilege = 'Privileged instruction';
+ SRangeError = 'Range check error';
+ SSafecallException = 'Exception in safecall method';
+ STooManyOpenFiles = 'Too many open files';
+ SUnKnownRunTimeError = 'Unknown Run-Time error : %3.3d';
+ SUnderflow = 'Floating point underflow';
+ SUnkOSError = 'An operating system call failed.';
+ SUnknown = 'Unknown run-time error code: ';
+ SUnknownErrorCode = 'Unknown error code: %d';
+ SVarArrayBounds = 'Variant array bounds error';
+ SVarArrayCreate = 'Variant array cannot be created';
+ SVarArrayLocked = 'Variant array locked';
+ SVarBadType = 'Invalid variant type';
+ SVarInvalid = 'Invalid argument';
+ SVarInvalid1 = 'Invalid argument: %s';
+ SVarNotArray = 'Variant doesn''t contain an array';
+ SVarNotImplemented = 'Operation not supported';
+ SVarOutOfMemory = 'Variant operation ran out memory';
+ SVarOverflow = 'Variant overflow';
+ SVarParamNotFound = 'Variant Parameter not found';
+ SVarTypeAlreadyUsedWithPrefix = 'Custom variant type (%s%.4x) already used by %s';
+ SVarTypeConvertOverflow = 'Overflow while converting variant of type (%s) into type (%s)';
+ SVarTypeCouldNotConvert = 'Could not convert variant of type (%s) into type (%s)';
+ SVarTypeNotUsableWithPrefix = 'Custom variant type (%s%.4x) is not usable';
+ SVarTypeOutOfRangeWithPrefix = 'Custom variant type (%s%.4x) is out of range';
+ SVarTypeRangeCheck1 = 'Range check error for variant of type (%s)';
+ SVarTypeRangeCheck2 = 'Range check error while converting variant of type (%s) into type (%s)';
+ SVarTypeTooManyCustom = 'Too many custom variant types have been registered';
+ SVarUnexpected = 'Unexpected variant error';
+
+ SFallbackError = 'An error, whose error code is larger than can be returned to the OS, has occured';
+
+ SNoToolserver = 'Toolserver is not installed, cannot execute Tool';
+
+ SShortMonthNameJan = 'Jan';
+ SShortMonthNameFeb = 'Feb';
+ SShortMonthNameMar = 'Mar';
+ SShortMonthNameApr = 'Apr';
+ SShortMonthNameMay = 'May';
+ SShortMonthNameJun = 'Jun';
+ SShortMonthNameJul = 'Jul';
+ SShortMonthNameAug = 'Aug';
+ SShortMonthNameSep = 'Sep';
+ SShortMonthNameOct = 'Oct';
+ SShortMonthNameNov = 'Nov';
+ SShortMonthNameDec = 'Dec';
+
+ SLongMonthNameJan = 'January';
+ SLongMonthNameFeb = 'February';
+ SLongMonthNameMar = 'March';
+ SLongMonthNameApr = 'April';
+ SLongMonthNameMay = 'May';
+ SLongMonthNameJun = 'June';
+ SLongMonthNameJul = 'July';
+ SLongMonthNameAug = 'August';
+ SLongMonthNameSep = 'September';
+ SLongMonthNameOct = 'October';
+ SLongMonthNameNov = 'November';
+ SLongMonthNameDec = 'December';
+
+ SShortDayNameMon = 'Mon';
+ SShortDayNameTue = 'Tue';
+ SShortDayNameWed = 'Wed';
+ SShortDayNameThu = 'Thu';
+ SShortDayNameFri = 'Fri';
+ SShortDayNameSat = 'Sat';
+ SShortDayNameSun = 'Sun';
+
+ SLongDayNameMon = 'Monday';
+ SLongDayNameTue = 'Tuesday';
+ SLongDayNameWed = 'Wednesday';
+ SLongDayNameThu = 'Thursday';
+ SLongDayNameFri = 'Friday';
+ SLongDayNameSat = 'Saturday';
+ SLongDayNameSun = 'Sunday';
+
+Function GetRunError(Errno : Word) : String;
+
+Implementation
+
+Function GetRunError(Errno : Word) : String;
+
+begin
+ Case Errno Of
+ 0 : Result:=SNoError;
+ 1 : Result:=SOutOfMemory;
+ 2 : Result:=SFileNotFound;
+ 3 : Result:=SInvalidFileName;
+ 4 : Result:=STooManyOpenFiles;
+ 5 : Result:=SAccessDenied;
+ 6 : Result:=SInvalidFileHandle;
+ 15 : Result:=SInvalidDrive;
+ 100 : Result:=SEndOfFile;
+ 101 : Result:=SDiskFull;
+ 102 : Result:=SFileNotAssigned;
+ 103 : Result:=SFileNotOpen;
+ 104 : Result:=SFileNotOpenForInput;
+ 105 : Result:=SFileNotOpenForOutput;
+ 106 : Result:=SInvalidInput;
+ 200 : Result:=SDivByZero;
+ 201 : Result:=SRangeError;
+ 203 : Result:=SOutOfMemory;
+ 204 : Result:=SInvalidPointer;
+ 205 : Result:=SOverFlow;
+ 206 : Result:=SUnderFlow;
+ 207 : Result:=SInvalidOp;
+ 211 : Result:=SAbstractError;
+ 215 : Result:=SIntOverFlow;
+ 216 : Result:=SAccessViolation;
+ 217 : Result:=SPrivilege;
+ 218 : Result:=SControlC;
+ 219 : Result:=SInvalidCast;
+ 220 : Result:=SInvalidVarCast;
+ 221 : Result:=SInvalidVarOp;
+ 222 : Result:=SDispatchError;
+ 223 : Result:=SVarArrayCreate;
+ 224 : Result:=SVarNotArray;
+ 225 : Result:=SVarArrayBounds;
+ 227 : Result:=SAssertionFailed;
+ 228 : Result:=SExternalException;
+ 229 : Result:=SIntfCastError;
+ 230 : Result:=SSafecallException;
+ 231 : Result:=SExceptionStack;
+ 232 : Result:=SNoThreadSupport;
+
+ 255 : Result:=SFallbackError;
+
+ {Error codes larger than 255 cannot be returned as an exit code to the OS,
+ for some OS's. If this happens, error 255 is returned instead.
+ Errors for which it is important that they can be distinguished,
+ shall be below 255}
+
+ {Error in the range 900 - 999 is considered platform specific}
+
+ 900 : Result:=SNoToolserver; {Mac OS specific}
+
+ end;
+ If length(Result)=0 then
+ begin
+ Str(Errno:3,Result);
+ Result:=SUnknown+Result;
+ end;
+end;
+
+end.
+{
+ $Log: sysconst.pp,v $
+ Revision 1.17 2005/03/28 13:38:05 florian
+ + a lot of vararray stuff
+
+ Revision 1.16 2005/03/17 16:29:04 peter
+ * fixed str() call
+
+ Revision 1.15 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.14 2005/01/14 12:59:25 michael
+ + Implemented ForceDirectories for Delphi compatibility
+
+}
diff --git a/rtl/objpas/sysutils/dati.inc b/rtl/objpas/sysutils/dati.inc
new file mode 100644
index 0000000000..a8580f4869
--- /dev/null
+++ b/rtl/objpas/sysutils/dati.inc
@@ -0,0 +1,825 @@
+{
+ *********************************************************************
+ $Id: dati.inc,v 1.11 2005/05/08 08:03:15 florian Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+{==============================================================================}
+{ internal functions }
+{==============================================================================}
+
+const
+ DayTable: array[Boolean, 1..12] of longint =
+ ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
+ (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
+
+Function DoEncodeDate(Year, Month, Day: Word): longint;
+
+Var
+ D : TDateTime;
+
+begin
+ If TryEncodeDate(Year,Month,Day,D) then
+ Result:=Trunc(D)
+ else
+ Result:=0;
+end;
+
+function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): longint;
+
+Var
+ T : TDateTime;
+
+begin
+ If TryEncodeTime(Hour,Minute,Second,MilliSecond,T) then
+ Result:=trunc(T*MSecsPerDay)
+ else
+ Result:=0;
+end;
+
+{==============================================================================}
+{ Public functions }
+{==============================================================================}
+
+{ DateTimeToTimeStamp converts DateTime to a TTimeStamp }
+
+function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
+begin
+ result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
+ result.Date := 1 + DateDelta + Trunc(System.Int(DateTime));
+end ;
+
+{ TimeStampToDateTime converts TimeStamp to a TDateTime value }
+
+function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
+begin
+ result := (TimeStamp.Date - DateDelta - 1) + (TimeStamp.Time / MSecsPerDay);
+end ;
+
+{ MSecsToTimeStamp }
+
+function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
+begin
+ result.Date := Round(msecs / msecsperday);
+{$IFDEF VIRTUALPASCAL}
+ msecs:= msecs-result.date*msecsperday;
+{$ELSE}
+ msecs:= comp(msecs-result.date*msecsperday);
+{$ENDIF}
+ result.Time := Round(MSecs);
+end ;
+
+{ TimeStampToMSecs }
+
+function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
+begin
+ result := TimeStamp.Time + timestamp.date*msecsperday;
+end ;
+
+Function TryEncodeDate(Year,Month,Day : Word; Var Date : TDateTime) : Boolean;
+
+var
+ c, ya: cardinal;
+begin
+ Result:=(Year>0) and (Year<10000) and
+ (Month in [1..12]) and
+ (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]);
+ If Result then
+ begin
+ if month > 2 then
+ Dec(Month,3)
+ else
+ begin
+ Inc(Month,9);
+ Dec(Year);
+ end;
+ c:= Year DIV 100;
+ ya:= Year - 100*c;
+ Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*cardinal(Month)+2) DIV 5 + cardinal(Day) - 693900;
+ end
+end;
+
+function TryEncodeTime(Hour, Min, Sec, MSec:word; Var Time : TDateTime) : boolean;
+
+begin
+ Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000);
+ If Result then
+ Time:=(Hour*3600000+Min*60000+Sec*1000+MSec)/MSecsPerDay;
+end;
+
+{ EncodeDate packs three variables Year, Month and Day into a
+ TDateTime value the result is the number of days since 12/30/1899 }
+
+function EncodeDate(Year, Month, Day: word): TDateTime;
+
+begin
+ If Not TryEncodeDate(Year,Month,Day,Result) then
+ Raise Exception.CreateFmt('%d-%d-%d is not a valid date specification',
+ [Year,Month,Day]);
+end;
+
+{ EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
+ a TDateTime value }
+
+function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
+
+begin
+ If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
+ Raise Exception.CreateFmt('%d:%d:%d.%d is not a valid time specification',
+ [Hour,Minute,Second,MilliSecond]);
+end;
+
+
+{ DecodeDate unpacks the value Date into three values:
+ Year, Month and Day }
+
+procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
+var
+ ly,ld,lm,j : cardinal;
+begin
+ j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
+ ly:= j DIV 146097;
+ j:= j - 146097 * cardinal(ly);
+ ld := j SHR 2;
+ j:=(ld SHL 2 + 3) DIV 1461;
+ ld:= (cardinal(ld) SHL 2 + 7 - 1461*j) SHR 2;
+ lm:=(5 * ld-3) DIV 153;
+ ld:= (5 * ld +2 - 153*lm) DIV 5;
+ ly:= 100 * cardinal(ly) + j;
+ if lm < 10 then
+ inc(lm,3)
+ else
+ begin
+ dec(lm,9);
+ inc(ly);
+ end;
+ year:=ly;
+ month:=lm;
+ day:=ld;
+end;
+
+
+function DecodeDateFully(const DateTime: TDateTime; var Year, Month, Day, DOW: Word): Boolean;
+begin
+ DecodeDate(DateTime,Year,Month,Day);
+ DOW:=DateTimeToTimeStamp(DateTime).Date mod 7+1;
+ Result:=IsLeapYear(Year);
+end;
+
+
+{ DecodeTime unpacks Time into four values:
+ Hour, Minute, Second and MilliSecond }
+
+procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
+Var
+ l : cardinal;
+begin
+ l := Round(Frac(time) * MSecsPerDay);
+ Hour := l div 3600000;
+ l := l mod 3600000;
+ Minute := l div 60000;
+ l := l mod 60000;
+ Second := l div 1000;
+ l := l mod 1000;
+ MilliSecond := l;
+end;
+
+{ DateTimeToSystemTime converts DateTime value to SystemTime }
+
+procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);
+begin
+ DecodeDate(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day);
+ DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
+end ;
+
+{ SystemTimeToDateTime converts SystemTime to a TDateTime value }
+
+function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
+begin
+ result := DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day) +
+ DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{ DayOfWeek returns the Day of the week (sunday is day 1) }
+
+function DayOfWeek(DateTime: TDateTime): integer;
+begin
+ Result := 1 + (Abs(Trunc(DateTime) - 1) mod 7);
+end ;
+
+{ Date returns the current Date }
+
+function Date: TDateTime;
+var
+ SystemTime: TSystemTime;
+begin
+ GetLocalTime(SystemTime);
+ result := DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
+end ;
+
+{ Time returns the current Time }
+
+function Time: TDateTime;
+var
+ SystemTime: TSystemTime;
+begin
+ GetLocalTime(SystemTime);
+ Result := DoEncodeTime(SystemTime.Hour,SystemTime.Minute,SystemTime.Second,SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{ Now returns the current Date and Time }
+
+function Now: TDateTime;
+var
+ SystemTime: TSystemTime;
+begin
+ GetLocalTime(SystemTime);
+ result := DoEncodeDate(SystemTime.Year,SystemTime.Month,SystemTime.Day) +
+ DoEncodeTime(SystemTime.Hour,SystemTime.Minute,SystemTime.Second,SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{ IncMonth increments DateTime with NumberOfMonths months,
+ NumberOfMonths can be less than zero }
+
+function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer {$ifndef ver1_0} = 1 {$endif}): TDateTime;
+var
+ Year, Month, Day: word;
+ S : Integer;
+begin
+ If NumberOfMonths>=0 then
+ s:=1
+ else
+ s:=-1;
+ DecodeDate(DateTime, Year, Month, Day);
+ inc(Year,(NumberOfMonths div 12));
+ inc(Month,(NumberOfMonths mod 12)-1); // Mod result always positive
+ if Month>11 then
+ begin
+ Dec(Month, S*12);
+ Inc(Year, S);
+ end;
+ Inc(Month); { Months from 1 to 12 }
+ if (Month = 2) and (IsLeapYear(Year)) and (Day > 28) then
+ Day := 28;
+ result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);
+end ;
+
+{ IsLeapYear returns true if Year is a leap year }
+
+function IsLeapYear(Year: Word): boolean;
+begin
+ Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
+end;
+
+{ DateToStr returns a string representation of Date using ShortDateFormat }
+
+function DateToStr(Date: TDateTime): string;
+begin
+ result := FormatDateTime('ddddd', Date);
+end ;
+
+{ TimeToStr returns a string representation of Time using ShortTimeFormat }
+
+function TimeToStr(Time: TDateTime): string;
+begin
+ result := FormatDateTime('t', Time);
+end ;
+
+{ DateTimeToStr returns a string representation of DateTime using ShortDateTimeFormat }
+
+function DateTimeToStr(DateTime: TDateTime): string;
+begin
+ result := FormatDateTime('c', DateTime);
+end ;
+
+{ StrToDate converts the string S to a TDateTime value
+ if S does not represent a valid date value
+ an EConvertError will be raised }
+
+function StrToDate(const S: string): TDateTime;
+var
+ df:string;
+ d,m,y,ly:word;
+ n,i:longint;
+{$IFDEF VIRTUALPASCAL}
+ c:longint;
+{$ELSE}
+ c:word;
+{$ENDIF}
+ dp,mp,yp,which : Byte;
+ s1:string[4];
+ values:array[1..3] of longint;
+ LocalTime:tsystemtime;
+begin
+ df := UpperCase(ShortDateFormat);
+ { Determine order of D,M,Y }
+ yp:=0;
+ mp:=0;
+ dp:=0;
+ Which:=0;
+ i:=0;
+ while (i<Length(df)) and (Which<3) do
+ begin
+ inc(i);
+ Case df[i] of
+ 'Y' :
+ if yp=0 then
+ begin
+ Inc(Which);
+ yp:=which;
+ end;
+ 'M' :
+ if mp=0 then
+ begin
+ Inc(Which);
+ mp:=which;
+ end;
+ 'D' :
+ if dp=0 then
+ begin
+ Inc(Which);
+ dp:=which;
+ end;
+ end;
+ end;
+ if Which<>3 then
+ Raise EConvertError.Create('Illegal format string');
+{ Get actual values }
+ for i := 1 to 3 do
+ values[i] := 0;
+ s1 := '';
+ n := 0;
+ for i := 1 to length(s) do
+ begin
+ if (s[i] in ['0'..'9']) then
+ s1 := s1 + s[i];
+ if (s[i] in [dateseparator,' ']) or (i = length(s)) then
+ begin
+ inc(n);
+ if n>3 then
+ Raise EConvertError.Create('Invalid date format');
+ val(s1, values[n], c);
+ if c<>0 then
+ Raise EConvertError.Create('Invalid date format');
+ s1 := '';
+ end ;
+ end ;
+ // Fill in values.
+ getLocalTime(LocalTime);
+ ly := LocalTime.Year;
+ If N=3 then
+ begin
+ y:=values[yp];
+ m:=values[mp];
+ d:=values[dp];
+ end
+ Else
+ begin
+ Y:=ly;
+ If n<2 then
+ begin
+ d:=values[1];
+ m := LocalTime.Month;
+ end
+ else
+ If dp<mp then
+ begin
+ d:=values[1];
+ m:=values[2];
+ end
+ else
+ begin
+ d:=values[2];
+ m:=values[1];
+ end;
+ end;
+ if (y >= 0) and (y < 100) then
+ begin
+ ly := ly - TwoDigitYearCenturyWindow;
+ Inc(Y, ly div 100 * 100);
+ if (TwoDigitYearCenturyWindow > 0) and (Y < ly) then
+ Inc(Y, 100);
+ end;
+ Result := DoEncodeDate(y, m, d);
+end ;
+
+
+{ StrToTime converts the string S to a TDateTime value
+ if S does not represent a valid time value an
+ EConvertError will be raised }
+
+function StrToTime(const s: string): TDateTime;
+var
+ Len, Current: integer; PM: boolean;
+
+ function GetElement: integer;
+ var
+ j: integer;
+ {$IFDEF VIRTUALPASCAL}
+ c: longint;
+ {$ELSE}
+ c: word;
+ {$ENDIF}
+ begin
+ result := -1;
+ Inc(Current);
+ while (result = -1) and (Current < Len) do begin
+ if S[Current] in ['0'..'9'] then begin
+ j := Current;
+ while (Current < Len) and (s[Current + 1] in ['0'..'9']) do
+ Inc(Current);
+ val(copy(S, j, 1 + Current - j), result, c);
+ end
+ else if (S[Current] = TimeAMString[1]) or (S[Current] in ['a', 'A']) then begin
+ Current := 1 + Len;
+ end
+ else if (S[Current] = TimePMString[1]) or (S[Current] in ['p', 'P']) then begin
+ Current := 1 + Len;
+ PM := True;
+ end
+ else if (S[Current] = TimeSeparator) or (S[Current] = ' ') then
+ Inc(Current)
+ else
+ raise EConvertError.Create('Invalid Time format');
+ end ;
+ end ;
+
+var
+ i: integer;
+ TimeValues: array[0..4] of integer;
+
+begin
+Current := 0;
+Len := length(s);
+PM := False;
+for i:=0 to 4 do
+ timevalues[i]:=0;
+i := 0;
+TimeValues[i] := GetElement;
+while (i < 5) and (TimeValues[i] <> -1) do begin
+ i := i + 1;
+ TimeValues[i] := GetElement;
+ end ;
+If (i<5) and (TimeValues[I]=-1) then
+ TimeValues[I]:=0;
+if PM then Inc(TimeValues[0], 12);
+result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
+end ;
+
+{ StrToDateTime converts the string S to a TDateTime value
+ if S does not represent a valid date and time value
+ an EConvertError will be raised }
+
+function StrToDateTime(const s: string): TDateTime;
+var i: integer;
+begin
+i := pos(' ', s);
+if i > 0 then result := StrToDate(Copy(S, 1, i - 1)) + StrToTime(Copy(S, i + 1, length(S)))
+else result := StrToDate(S);
+end ;
+
+{ FormatDateTime formats DateTime to the given format string FormatStr }
+
+function FormatDateTime(FormatStr: string; DateTime: TDateTime): string;
+var
+ ResultLen: integer;
+ ResultBuffer: array[0..255] of char;
+ ResultCurrent: pchar;
+
+ procedure StoreStr(Str: pchar; Len: integer);
+ begin
+ if ResultLen + Len < SizeOf(ResultBuffer) then begin
+ StrMove(ResultCurrent, Str, Len);
+ ResultCurrent := ResultCurrent + Len;
+ ResultLen := ResultLen + Len;
+ end ;
+ end ;
+
+ procedure StoreString(const Str: string);
+ var Len: integer;
+ begin
+ Len := Length(Str);
+ if ResultLen + Len < SizeOf(ResultBuffer) then begin
+ StrMove(ResultCurrent, pchar(Str), Len);
+ ResultCurrent := ResultCurrent + Len;
+ ResultLen := ResultLen + Len;
+ end;
+ end;
+
+ procedure StoreInt(Value, Digits: integer);
+ var S: string; Len: integer;
+ begin
+ S := IntToStr(Value);
+ Len := Length(S);
+ if Len < Digits then begin
+ S := copy('0000', 1, Digits - Len) + S;
+ Len := Digits;
+ end ;
+ StoreStr(pchar(@S[1]), Len);
+ end ;
+
+ Function TimeReFormat(Const S : string) : string;
+ // Change m into n for time formatting.
+ Var i : longint;
+
+ begin
+ Result:=S;
+ For I:=1 to Length(Result) do
+ If Result[i]='m' then
+ result[i]:='n';
+ end;
+
+var
+ Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
+
+ procedure StoreFormat(const FormatStr: string);
+ var
+ Token,lastformattoken: char;
+ FormatCurrent: pchar;
+ FormatEnd: pchar;
+ Count: integer;
+ Clock12: boolean;
+ P: pchar;
+ tmp:integer;
+
+ begin
+ FormatCurrent := Pchar(FormatStr);
+ FormatEnd := FormatCurrent + Length(FormatStr);
+ Clock12 := false;
+ P := FormatCurrent;
+ while P < FormatEnd do begin
+ Token := UpCase(P^);
+ if Token in ['"', ''''] then begin
+ P := P + 1;
+ while (P < FormatEnd) and (P^ <> Token) do
+ P := P + 1;
+ end
+ else if Token = 'A' then begin
+ if (StrLIComp(P, 'A/P', 3) = 0) or
+ (StrLIComp(P, 'AMPM', 4) = 0) or
+ (StrLIComp(P, 'AM/PM', 5) = 0) then begin
+ Clock12 := true;
+ break;
+ end ;
+ end ;
+ P := P + 1;
+ end ;
+ token:=#255;
+ lastformattoken:=' ';
+ while FormatCurrent < FormatEnd do
+ begin
+ Token := UpCase(FormatCurrent^);
+ Count := 1;
+ P := FormatCurrent + 1;
+ case Token of
+ '''', '"': begin
+ while (P < FormatEnd) and (p^ <> Token) do
+ P := P + 1;
+ P := P + 1;
+ Count := P - FormatCurrent;
+ StoreStr(FormatCurrent + 1, Count - 2);
+ end ;
+ 'A': begin
+ if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then begin
+ Count := 4;
+ if Hour < 12 then StoreString(TimeAMString)
+ else StoreString(TimePMString);
+ end
+ else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then begin
+ Count := 5;
+ if Hour < 12 then StoreStr('am', 2)
+ else StoreStr('pm', 2);
+ end
+ else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then begin
+ Count := 3;
+ if Hour < 12 then StoreStr('a', 1)
+ else StoreStr('p', 1);
+ end
+ else
+ Raise EConvertError.Create('Illegal character in format string');
+ end ;
+ '/': StoreStr(@DateSeparator, 1);
+ ':': StoreStr(@TimeSeparator, 1);
+ ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y','Z' :
+ begin
+ while (P < FormatEnd) and (UpCase(P^) = Token) do
+ P := P + 1;
+ Count := P - FormatCurrent;
+ case Token of
+ ' ': StoreStr(FormatCurrent, Count);
+ 'Y': begin
+ if Count>2 then
+ StoreInt(Year, 4)
+ else
+ StoreInt(Year mod 100, 2);
+ end;
+ 'M': begin
+ if lastformattoken='H' then
+ begin
+ if Count = 1 then
+ StoreInt(Minute, 0)
+ else
+ StoreInt(Minute, 2);
+
+ end
+ else
+ begin
+ case Count of
+ 1: StoreInt(Month, 0);
+ 2: StoreInt(Month, 2);
+ 3: StoreString(ShortMonthNames[Month]);
+ 4: StoreString(LongMonthNames[Month]);
+ end;
+ end;
+ end;
+ 'D': begin
+ case Count of
+ 1: StoreInt(Day, 0);
+ 2: StoreInt(Day, 2);
+ 3: StoreString(ShortDayNames[DayOfWeek]);
+ 4: StoreString(LongDayNames[DayOfWeek]);
+ 5: StoreFormat(ShortDateFormat);
+ 6: StoreFormat(LongDateFormat);
+ end ;
+ end ;
+ 'H': begin
+ if Clock12 then begin
+ tmp:=hour mod 12;
+ if tmp=0 then tmp:=12;
+ if Count = 1 then StoreInt(tmp, 0)
+ else StoreInt(tmp, 2);
+ end
+ else begin
+ if Count = 1 then StoreInt(Hour, 0)
+ else StoreInt(Hour, 2);
+ end ;
+ end ;
+ 'N': begin
+ if Count = 1 then StoreInt(Minute, 0)
+ else StoreInt(Minute, 2);
+ end ;
+ 'S': begin
+ if Count = 1 then StoreInt(Second, 0)
+ else StoreInt(Second, 2);
+ end ;
+ 'Z': begin
+ if Count = 1 then StoreInt(MilliSecond, 0)
+ else StoreInt(MilliSecond, 3);
+ end ;
+ 'T': begin
+ if Count = 1 then StoreFormat(timereformat(ShortTimeFormat))
+ else StoreFormat(TimeReformat(LongTimeFormat));
+ end ;
+ 'C':
+ begin
+ StoreFormat(ShortDateFormat);
+ if (Hour<>0) or (Minute<>0) or (Second<>0) then
+ begin
+ StoreString(' ');
+ StoreFormat(TimeReformat(ShortTimeFormat));
+ end;
+ end;
+ end;
+ lastformattoken:=token;
+ end;
+ else
+ StoreStr(@Token, 1);
+ end ;
+ FormatCurrent := FormatCurrent + Count;
+ end ;
+ end ;
+
+begin
+ DecodeDate(DateTime, Year, Month, Day);
+ DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
+ DayOfWeek := SysUtils.DayOfWeek(DateTime);
+ ResultLen := 0;
+ ResultCurrent := @ResultBuffer;
+ StoreFormat(FormatStr);
+ ResultBuffer[ResultLen] := #0;
+ result := StrPas(@ResultBuffer);
+end ;
+
+{ DateTimeToString formats DateTime to the given format in FormatStr }
+
+procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
+begin
+ Result := FormatDateTime(FormatStr, DateTime);
+end ;
+
+
+Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
+
+Var YY,MM,DD,H,m,s,msec : Word;
+
+begin
+ Decodedate (DateTime,YY,MM,DD);
+ If (YY<1980) or (YY>2099) then
+ Result:=0
+ else
+ begin
+ DecodeTime (DateTime,h,m,s,msec);
+ Result:=(s shr 1) or (m shl 5) or (h shl 11);
+ Result:=Result or DD shl 16 or (MM shl 21) or ((YY-1980) shl 25);
+ end;
+end;
+
+
+Function FileDateToDateTime (Filedate : Longint) : TDateTime;
+
+Var Date,Time : Word;
+
+begin
+ Date:=FileDate shr 16;
+ Time:=FileDate and $ffff;
+ Result:=EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31) +
+ EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0);
+end;
+
+{$ifndef VER1_0}
+
+function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
+ begin
+ result:=true;
+ try
+ value:=StrToDate(s);
+ except
+ on EConvertError do
+ result:=false
+ end;
+ end;
+
+
+// function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
+
+
+function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
+ begin
+ result:=true;
+ try
+ value:=StrToTime(s);
+ except
+ on EConvertError do
+ result:=false
+ end;
+ end;
+
+
+// function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
+
+
+function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
+ begin
+ result:=true;
+ try
+ value:=StrToDateTime(s);
+ except
+ on EConvertError do
+ result:=false
+ end;
+ end;
+
+
+// function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
+
+{$endif VER1_0}
+
+{
+ $Log: dati.inc,v $
+ Revision 1.11 2005/05/08 08:03:15 florian
+ + cycling with 1.0.x fixed, hopefully the last fix of this for ever ;)
+
+ Revision 1.10 2005/05/07 10:23:17 florian
+ + TryStrToDate/Time functions
+
+ Revision 1.9 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.8 2005/03/17 15:21:10 marco
+ * fixed incmonths default param. Thnks nldelphi
+
+ Revision 1.7 2005/03/10 19:48:27 florian
+ * fixed compatibility problem of DateTimeToString
+
+ Revision 1.6 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/datih.inc b/rtl/objpas/sysutils/datih.inc
new file mode 100644
index 0000000000..015fa4ff94
--- /dev/null
+++ b/rtl/objpas/sysutils/datih.inc
@@ -0,0 +1,151 @@
+{
+ *********************************************************************
+ $Id: datih.inc,v 1.6 2005/05/08 08:03:15 florian Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+
+type
+ PDayTable = ^TDayTable;
+ TDayTable = array[1..12] of Word;
+
+const
+ HoursPerDay = 24;
+ MinsPerHour = 60;
+ SecsPerMin = 60;
+ MSecsPerSec = 1000;
+ MinsPerDay = HoursPerDay * MinsPerHour;
+ SecsPerDay = MinsPerDay * SecsPerMin;
+ MSecsPerDay = SecsPerDay * MSecsPerSec;
+
+ DateDelta = 693594; // Days between 1/1/0001 and 12/31/1899
+ UnixDateDelta = 25569;
+
+ { True=Leapyear }
+ MonthDays: array [Boolean] of TDayTable =
+ ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
+ (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
+
+ TwoDigitYearCenturyWindow : word= 50;
+ { Threshold to be subtracted from year before
+ age-detection.}
+
+ { date time formatting characters:
+ c : shortdateformat + ' ' + shorttimeformat
+ d : day of month
+ dd : day of month (leading zero)
+ ddd : day of week (abbreviation)
+ dddd : day of week (full)
+ ddddd : shortdateformat
+ dddddd : longdateformat
+ m : month
+ mm : month (leading zero)
+ mmm : month (abbreviation)
+ mmmm : month (full)
+ y : year (four digits)
+ yy : year (two digits)
+ yyyy : year (with century)
+ h : hour
+ hh : hour (leading zero)
+ n : minute
+ nn : minute (leading zero)
+ s : second
+ ss : second (leading zero)
+ t : shorttimeformat
+ tt : longtimeformat
+ am/pm : use 12 hour clock and display am and pm accordingly
+ a/p : use 12 hour clock and display a and p accordingly
+ / : insert date seperator
+ : : insert time seperator
+ "xx" : literal text
+ 'xx' : literal text
+ }
+
+type
+{$ifndef win32}
+ { Win32 reuses the struct from the Windows unit }
+ TSystemTime = record
+ Year, Month, Day: word;
+ Hour, Minute, Second, MilliSecond: word;
+ end ;
+{$endif win32}
+
+ TTimeStamp = record
+ Time: integer; { Number of milliseconds since midnight }
+ Date: integer; { One plus number of days since 1/1/0001 }
+ end ;
+
+
+function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
+function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
+function MSecsToTimeStamp(MSecs: Comp): TTimeStamp;
+function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
+function TryEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
+function TryEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
+function EncodeDate(Year, Month, Day :word): TDateTime;
+function EncodeTime(Hour, Minute, Second, MilliSecond:word): TDateTime;
+procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
+function DecodeDateFully(const DateTime: TDateTime; var Year, Month, Day, DOW: Word): Boolean;
+procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
+procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);
+function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
+function DayOfWeek(DateTime: TDateTime): integer;
+function Date: TDateTime;
+function Time: TDateTime;
+function Now: TDateTime;
+function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer {$ifndef ver1_0} = 1 {$endif}): TDateTime;
+function IsLeapYear(Year: Word): boolean;
+function DateToStr(Date: TDateTime): string;
+function TimeToStr(Time: TDateTime): string;
+function DateTimeToStr(DateTime: TDateTime): string;
+function StrToDate(const S: string): TDateTime;
+function StrToTime(const S: string): TDateTime;
+function StrToDateTime(const S: string): TDateTime;
+function FormatDateTime(FormatStr: string; DateTime: TDateTime):string;
+procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
+Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
+Function FileDateToDateTime (Filedate : Longint) :TDateTime;
+{$ifndef VER1_0}
+function TryStrToDate(const S: string; out Value: TDateTime): Boolean;
+// function TryStrToDate(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
+function TryStrToTime(const S: string; out Value: TDateTime): Boolean;
+// function TryStrToTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
+function TryStrToDateTime(const S: string; out Value: TDateTime): Boolean;
+// function TryStrToDateTime(const S: string; out Value: TDateTime; const FormatSettings: TFormatSettings): Boolean;
+{$endif VER1_0}
+
+{ FPC Extra }
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+
+{
+ $Log: datih.inc,v $
+ Revision 1.6 2005/05/08 08:03:15 florian
+ + cycling with 1.0.x fixed, hopefully the last fix of this for ever ;)
+
+ Revision 1.5 2005/05/07 10:23:17 florian
+ + TryStrToDate/Time functions
+
+ Revision 1.4 2005/03/17 15:21:10 marco
+ * fixed incmonths default param. Thnks nldelphi
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/diskh.inc b/rtl/objpas/sysutils/diskh.inc
new file mode 100644
index 0000000000..0b6ed202a2
--- /dev/null
+++ b/rtl/objpas/sysutils/diskh.inc
@@ -0,0 +1,33 @@
+{
+ $Id: diskh.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Disk functions from Delphi's sysutils.pas
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function DiskFree(drive: byte) : int64;
+Function DiskSize(drive: byte) : int64;
+Function GetCurrentDir : String;
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+Function CreateDir (Const NewDir : String) : Boolean;
+Function RemoveDir (Const Dir : String) : Boolean;
+Function ForceDirectories(Const Dir: string): Boolean;
+
+{
+ $Log: diskh.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/01/14 12:59:25 michael
+ + Implemented ForceDirectories for Delphi compatibility
+
+}
diff --git a/rtl/objpas/sysutils/filutilh.inc b/rtl/objpas/sysutils/filutilh.inc
new file mode 100644
index 0000000000..1b0e22fc82
--- /dev/null
+++ b/rtl/objpas/sysutils/filutilh.inc
@@ -0,0 +1,105 @@
+{
+ $Id: filutilh.inc,v 1.10 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ File utility calls
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Type
+ TSearchRec = Record
+ Time : Longint;
+ Size : Int64;
+ Attr : Longint;
+ Name : TFileName;
+ ExcludeAttr : Longint;
+{$ifdef unix}
+ FindHandle : Pointer;
+ Mode : TMode;
+{$else unix}
+ FindHandle : THandle;
+{$endif unix}
+{$ifdef Win32}
+ FindData : TWin32FindData;
+{$endif}
+{$ifdef netware_clib}
+ FindData : TNetwareFindData;
+{$endif}
+{$ifdef netware_libc}
+ FindData : TNetwareLibcFindData;
+{$endif}
+{$ifdef MacOS}
+ FindData : TMacOSFindData;
+{$endif}
+ end;
+
+Const
+ { File attributes }
+ faReadOnly = $00000001;
+ faHidden = $00000002;
+ faSysFile = $00000004;
+ faVolumeId = $00000008;
+ faDirectory = $00000010;
+ faArchive = $00000020;
+ faAnyFile = $0000003f;
+
+ { File open modes }
+ fmOpenRead = $0000;
+ fmOpenWrite = $0001;
+ fmOpenReadWrite = $0002;
+ { Share modes}
+ fmShareCompat = $0000;
+ fmShareExclusive = $0010;
+ fmShareDenyWrite = $0020;
+ fmShareDenyRead = $0030;
+ fmShareDenyNone = $0040;
+
+ { File seek origins }
+ fsFromBeginning = 0;
+ fsFromCurrent = 1;
+ fsFromEnd = 2;
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+Function FileCreate (Const FileName : String) : Longint;
+Function FileCreate (Const FileName : String; Mode : Integer) : Longint;
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+Procedure FileClose (Handle : Longint);
+Function FileTruncate (Handle,Size: Longint) : boolean;
+Function FileAge (Const FileName : String): Longint;
+Function FileExists (Const FileName : String) : Boolean;
+Function DirectoryExists (Const Directory : String) : Boolean;
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+Procedure FindClose (Var F : TSearchrec);
+Function FileGetDate (Handle : Longint) : Longint;
+Function FileSetDate (Handle,Age : Longint) : Longint;
+Function FileGetAttr (Const FileName : String) : Longint;
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+Function DeleteFile (Const FileName : String) : Boolean;
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+Function FileSearch (Const Name, DirList : String) : String;
+Function FileIsReadOnly(const FileName: String): Boolean;
+
+Function GetFileHandle(var f : File):Longint;
+Function GetFileHandle(var f : Text):Longint;
+
+{
+ $Log: filutilh.inc,v $
+ Revision 1.10 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.9 2005/01/24 18:25:46 olle
+ + a tiny bit of support for macos
+
+}
diff --git a/rtl/objpas/sysutils/fina.inc b/rtl/objpas/sysutils/fina.inc
new file mode 100644
index 0000000000..9c81b390e7
--- /dev/null
+++ b/rtl/objpas/sysutils/fina.inc
@@ -0,0 +1,255 @@
+{
+ *********************************************************************
+ $Id: fina.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+{$IFDEF VIRTUALPASCAL}
+ {$J+}
+{$ENDIF}
+
+function ChangeFileExt(const FileName, Extension: string): string;
+var i: longint;
+begin
+ I := Length(FileName);
+ while (I > 0) and not(FileName[I] in ['/', '.', '\', ':']) do
+ Dec(I);
+ if (I = 0) or (FileName[I] <> '.') then
+ I := Length(FileName)+1;
+ Result := Copy(FileName, 1, I - 1) + Extension;
+end;
+
+function ExtractFilePath(const FileName: string): string;
+var i: longint;
+begin
+i := Length(FileName);
+while (i > 0) and not (FileName[i] in ['/', '\', ':']) do Dec(i);
+If I>0 then
+ Result := Copy(FileName, 1, i)
+else
+ Result:='';
+end;
+
+function ExtractFileDir(const FileName: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['/', '\', ':']) do Dec(I);
+if (I > 1) and (FileName[I] in ['\', '/']) and
+ not (FileName[I - 1] in ['/', '\', ':']) then Dec(I);
+Result := Copy(FileName, 1, I);
+end;
+
+function ExtractFileDrive(const FileName: string): string;
+var i: longint;
+begin
+if (Length(FileName) >= 3) and (FileName[2] = ':') then
+ result := Copy(FileName, 1, 2)
+else if (Length(FileName) >= 2) and (FileName[1] in ['/', '\']) and
+ (FileName[2] in ['/', '\']) then begin
+ i := 2;
+ While (i < Length(Filename)) do begin
+ if Filename[i + 1] in ['/', '\'] then break;
+ inc(i);
+ end ;
+ Result := Copy(FileName, 1, i);
+ end
+else Result := '';
+end;
+
+function ExtractFileName(const FileName: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['/', '\', ':']) do Dec(I);
+Result := Copy(FileName, I + 1, 255);
+end;
+
+function ExtractFileExt(const FileName: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['.', '/', '\', ':']) do Dec(I);
+if (I > 0) and (FileName[I] = '.') then
+ Result := Copy(FileName, I, 255)
+else Result := '';
+end;
+
+function ExpandFileName (Const FileName : string): String;
+
+Var S : String;
+
+Begin
+ S:=FileName;
+ {$IFNDEF VIRTUALPASCAL}
+ DoDirSeparators(S);
+ {$ENDIF}
+{$ifdef HasUnix}
+ Result:=fexpand(S);
+{$else}
+ Result:=Dos.Fexpand(S);
+{$endif}
+end;
+
+function ExpandUNCFileName (Const FileName : string): String;
+begin
+ Result:=ExpandFileName (FileName);
+ //!! Here should follow code to replace the drive: part with UNC...
+end;
+
+Const MaxDirs = 129;
+
+function ExtractRelativepath (Const BaseName,DestName : String): String;
+
+Var Source, Dest : String;
+ Sc,Dc,I,J : Longint;
+ SD,DD : Array[1..MaxDirs] of PChar;
+
+Const OneLevelBack = '..'+PathDelim;
+
+begin
+ If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then
+ begin
+ Result:=DestName;
+ exit;
+ end;
+ Source:=ExtractFilePath(BaseName);
+ Dest:=ExtractFilePath(DestName);
+ SC:=GetDirs (Source,SD);
+ DC:=GetDirs (Dest,DD);
+ I:=1;
+ While (I<DC) and (I<SC) do
+ begin
+ If StrIcomp(DD[i],SD[i])=0 then
+ Inc(i)
+ else
+ Break;
+ end;
+ Result:='';
+ For J:=I to SC-1 do Result:=Result+OneLevelBack;
+ For J:=I to DC-1 do Result:=Result+DD[J]+PathDelim;
+ Result:=Result+ExtractFileName(DestNAme);
+end;
+
+Procedure DoDirSeparators (Var FileName : String);
+
+VAr I : longint;
+
+begin
+ For I:=1 to Length(FileName) do
+ If FileName[I] in DirSeparators then
+ FileName[i]:=PathDelim;
+end;
+
+
+Function SetDirSeparators (Const FileName : string) : String;
+
+begin
+ Result:=FileName;
+ DoDirSeparators (Result);
+end;
+
+{
+ DirName is split in a #0 separated list of directory names,
+ Dirs is an array of pchars, pointing to these directory names.
+ The function returns the number of directories found, or -1
+ if none were found.
+ DirName must contain only PathDelim as Directory separator chars.
+}
+
+Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint;
+
+Var I : Longint;
+
+begin
+ I:=1;
+ Result:=-1;
+ While I<=Length(DirName) do
+ begin
+ If DirName[i]=PathDelim then
+ begin
+ DirName[i]:=#0;
+ Inc(Result);
+ Dirs[Result]:=@DirName[I+1];
+ end;
+ Inc(I);
+ end;
+ If Result>-1 then inc(Result);
+end;
+
+function IncludeTrailingPathDelimiter(Const Path : String) : String;
+
+Var
+ l : Integer;
+
+begin
+ Result:=Path;
+ l:=Length(Result);
+ If (L=0) or (Result[l]<>PathDelim) then
+ Result:=Result+PathDelim;
+end;
+
+function IncludeTrailingBackslash(Const Path : String) : String;
+
+begin
+ Result:=IncludeTrailingPathDelimiter(Path);
+end;
+
+function ExcludeTrailingBackslash(Const Path: string): string;
+
+begin
+ Result:=ExcludeTrailingPathDelimiter(Path);
+end;
+
+function ExcludeTrailingPathDelimiter(Const Path: string): string;
+
+Var
+ L : Integer;
+
+begin
+ L:=Length(Path);
+ If (L>0) and (Path[L]=PathDelim) then
+ Dec(L);
+ Result:=Copy(Path,1,L);
+end;
+
+function IsPathDelimiter(Const Path: string; Index: Integer): Boolean;
+
+begin
+ Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index]=PathDelim);
+end;
+
+Function GetFileHandle(var f : File):Longint;
+
+begin
+ result:=filerec(f).handle;
+end;
+
+Function GetFileHandle(var f : Text):Longint;
+begin
+ result:=textrec(f).handle;
+end;
+
+{
+ $Log: fina.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/finah.inc b/rtl/objpas/sysutils/finah.inc
new file mode 100644
index 0000000000..3176cd9f59
--- /dev/null
+++ b/rtl/objpas/sysutils/finah.inc
@@ -0,0 +1,52 @@
+{
+ *********************************************************************
+ $Id: finah.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+Const
+ DirSeparators : set of char = ['/','\'];
+
+
+function ChangeFileExt(const FileName, Extension: string): string;
+function ExtractFilePath(const FileName: string): string;
+function ExtractFileDrive(const FileName: string): string;
+function ExtractFileName(const FileName: string): string;
+function ExtractFileExt(const FileName: string): string;
+function ExtractFileDir(Const FileName : string): string;
+function ExpandFileName (Const FileName : string): String;
+function ExpandUNCFileName (Const FileName : string): String;
+function ExtractRelativepath (Const BaseName,DestNAme : String): String;
+function IncludeTrailingPathDelimiter(Const Path : String) : String;
+function IncludeTrailingBackslash(Const Path : String) : String;
+function ExcludeTrailingBackslash(Const Path: string): string;
+function ExcludeTrailingPathDelimiter(Const Path: string): string;
+function IsPathDelimiter(Const Path: string; Index: Integer): Boolean;
+Procedure DoDirSeparators (Var FileName : String);
+Function SetDirSeparators (Const FileName : String) : String;
+Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint;
+Function SameFileName(const S1, S2: string): Boolean;
+
+{
+ $Log: finah.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/intfh.inc b/rtl/objpas/sysutils/intfh.inc
new file mode 100644
index 0000000000..d25c422dac
--- /dev/null
+++ b/rtl/objpas/sysutils/intfh.inc
@@ -0,0 +1,40 @@
+{
+ *********************************************************************
+ $Id: intfh.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 2002 Free Pascal Development Team
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean; overload;
+function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
+function Supports(const Instance: IInterface; const IID: TGUID): Boolean; overload;
+function Supports(const Instance: TObject; const IID: TGUID): Boolean; overload;
+function Supports(const AClass: TClass; const IID: TGUID): Boolean; overload;
+
+//function CreateGUID(out Guid: TGUID): HResult;
+function StringToGUID(const S: string): TGUID;
+function GUIDToString(const GUID: TGUID): string;
+function IsEqualGUID(const guid1, guid2: TGUID): Boolean;
+
+{
+ $Log: intfh.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/osutil.inc b/rtl/objpas/sysutils/osutil.inc
new file mode 100644
index 0000000000..971b5ddbc3
--- /dev/null
+++ b/rtl/objpas/sysutils/osutil.inc
@@ -0,0 +1,213 @@
+{
+ $Id: osutil.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ <What does this file>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+ Environment variable auxiliary routines
+ ---------------------------------------------------------------------}
+Const
+ FPC_EnvCount : Integer = -1;
+
+Function FPCCountEnvVar(EP : PPChar) : integer;
+
+begin
+ If (FPC_EnvCount=-1) then
+ begin
+ FPC_EnvCount:=0;
+ If (EP<>Nil) then
+ While (EP^<>Nil) do
+ begin
+ Inc(FPC_EnvCount);
+ Inc(EP);
+ end;
+ end;
+ Result:=FPC_EnvCount;
+end;
+
+Function FPCGetEnvVarFromP(EP : PPChar; EnvVar : String) : String;
+
+var
+ hp : ppchar;
+ lenvvar,hs : string;
+ eqpos : longint;
+
+begin
+ lenvvar:=upcase(envvar);
+ hp:=EP;
+ Result:='';
+ If (hp<>Nil) then
+ while assigned(hp^) do
+ begin
+ hs:=strpas(hp^);
+ eqpos:=pos('=',hs);
+ if upcase(copy(hs,1,eqpos-1))=lenvvar then
+ begin
+ Result:=copy(hs,eqpos+1,length(hs)-eqpos);
+ exit;
+ end;
+ inc(hp);
+ end;
+end;
+
+Function FPCGetEnvStrFromP(EP : PPChar; Index : Integer) : String;
+
+begin
+ Result:='';
+ while assigned(EP^) and (Index>1) do
+ begin
+ Dec(Index);
+ inc(EP);
+ end;
+ If Assigned(EP^) then
+ Result:=StrPas(EP^);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Application name
+ ---------------------------------------------------------------------}
+
+Function ApplicationName : String;
+
+begin
+ If Assigned(OnGetApplicationName) then
+ Result:=OnGetApplicationName()
+ else
+ Result:=ChangeFileExt(ExtractFileName(Paramstr(0)),'');
+end;
+
+{ ---------------------------------------------------------------------
+ Default implementations for AppConfigDir implementation.
+ ---------------------------------------------------------------------}
+
+Function DGetAppConfigDir(Global : Boolean) : String;
+
+begin
+ Result:=ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
+end;
+
+Function DGetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+ Result:=ExtractFilePath(ParamStr(0));
+ If SubDir then
+ Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
+ Result:=Result+ApplicationName+ConfigExtension;
+end;
+
+Function GetAppConfigFile(Global : Boolean) : String;
+
+begin
+ Result:=GetAppConfigFile(Global,False);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Fallback implementations for AppConfigDir implementation.
+ ---------------------------------------------------------------------}
+{
+ If a particular OS does it different:
+ - set the HAVE_OSCONFIG define before including sysutils.inc.
+ - implement the functions.
+ Default config assumes a DOS-like configuration.
+}
+
+{$ifndef HAS_OSCONFIG}
+Function GetAppConfigDir(Global : Boolean) : String;
+
+begin
+ Result:=DGetAppConfigDir(Global);
+end;
+
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+ Result:=DGetAppConfigFile(Global,Subdir);
+end;
+{$endif}
+
+{ ---------------------------------------------------------------------
+ Get temporary directory name
+ ---------------------------------------------------------------------}
+
+{$ifndef HAS_TEMPDIR}
+Function GetTempDir(Global : Boolean) : String;
+
+begin
+ If Assigned(OnGetTempDir) then
+ Result:=OnGetTempDir(Global)
+ else
+ begin
+ Result:=GetEnvironmentVariable('TEMP');
+ If (Result='') Then
+ Result:=GetEnvironmentVariable('TMP');
+ end;
+ if (Result<>'') then
+ Result:=IncludeTrailingPathDelimiter(Result);
+end;
+{$endif}
+
+Function GetTempDir : String;
+
+begin
+ Result:=GetTempDir(True);
+end;
+
+{ ---------------------------------------------------------------------
+ Get temporary file name
+ ---------------------------------------------------------------------}
+
+
+{$ifndef HAS_TEMPFILE}
+Function GetTempFileName(Const Dir,Prefix : String) : String;
+
+Var
+ I : Integer;
+ Start : String;
+
+begin
+ If Assigned(OnGetTempFile) then
+ Result:=OnGetTempFile(Dir,Prefix)
+ else
+ begin
+ If (Dir='') then
+ Start:=GetTempDir
+ else
+ Start:=IncludeTrailingPathDelimiter(Dir);
+ If (Prefix='') then
+ Start:=Start+'TMP'
+ else
+ Start:=Start+Prefix;
+ I:=0;
+ Repeat
+ Result:=Format('%s%.5d.tmp',[Start,I]);
+ Inc(I);
+ Until not FileExists(Result);
+ end;
+end;
+{$endif}
+
+Function GetTempFileName : String;
+
+begin
+ Result:=GetTempFileName('','');
+end;
+
+{
+ $Log: osutil.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/osutilsh.inc b/rtl/objpas/sysutils/osutilsh.inc
new file mode 100644
index 0000000000..b94a04b56c
--- /dev/null
+++ b/rtl/objpas/sysutils/osutilsh.inc
@@ -0,0 +1,61 @@
+{
+ $Id: osutilsh.inc,v 1.10 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ OS handling utilities }
+
+{$ifdef HAS_OSERROR}
+Function GetLastOSError : Integer;
+{$endif}
+Procedure RaiseLastOSError;
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+Function GetEnvironmentVariableCount : Integer;
+Function GetEnvironmentString(Index : Integer) : String;
+{$IFDEF HAS_SLEEP}
+procedure Sleep(milliseconds: Cardinal);
+{$ENDIF}
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
+
+
+Function GetTempDir(Global : Boolean) : String;
+Function GetTempDir : String;
+Function GetTempFileName(Const Dir,Prefix : String) : String;
+Function GetTempFileName : String;
+Function GetAppConfigDir(Global : Boolean) : String;
+Function GetAppConfigFile(Global : Boolean) : String;
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+Function ApplicationName : String;
+
+Const
+ ConfigExtension : String = '.cfg';
+ SysConfigDir : String = '';
+
+Type
+ TGetAppNameEvent = Function : String;
+ TGetTempDirEvent = Function (Global : Boolean) : String;
+ TGetTempFileEvent = Function (Const Dir,Prefix : String) : String;
+
+Var
+ OnGetApplicationName : TGetAppNameEvent;
+ OnGetTempDir : TGetTempDirEvent;
+ OnGetTempFile : TGetTempFileEvent;
+
+
+{
+ $Log: osutilsh.inc,v $
+ Revision 1.10 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/stre.inc b/rtl/objpas/sysutils/stre.inc
new file mode 100644
index 0000000000..7c28d47860
--- /dev/null
+++ b/rtl/objpas/sysutils/stre.inc
@@ -0,0 +1,83 @@
+{
+ $Id: stre.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file implements english error message strings
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ English string constants for any messages issued by the sysutils unit.
+ Please have them ordered by constant name.
+}
+
+Const
+
+ { Error messages for exceptions }
+
+ SAbortError = 'Operation aborted';
+ SAbstractError = 'Abstract method called';
+ SAccessDenied = 'Access denied';
+ SAccessViolation = 'Access violation';
+ SArgumentMissing = 'Missing argument in format "%s"';
+ SAssertError = '%s (%s, line %d)';
+ SAssertionFailed = 'Assertion failed';
+ SControlC = 'Control-C hit';
+ SDiskFull = 'Disk Full';
+ SDispatchError = 'No variant method call dispatch';
+ SDivByZero = 'Division by zero';
+ SEndOfFile = 'Read past end of file';
+ SExceptionErrorMessage = 'exception at %p: %s';
+ SExternalException = 'External exception %x';
+ SFileNotAssigned = 'File not assigned';
+ SFileNotFound = 'File not found';
+ SFileNotOpen = 'File not open';
+ SFileNotOpenForInput = 'File not open for input';
+ SFileNotOpenForOutput = 'File not open for output';
+ SInValidFileName = 'Invalid filename';
+ SIntfCastError = 'Interface not supported';
+ SIntOverflow = 'Arithmetic overflow';
+ SInvalidArgIndex = 'Invalid argument index in format "%s"';
+ SInvalidBoolean = '"%s" is not a valid boolean.';
+ SInvalidCast = 'Invalid type cast';
+ SInvalidDateTime = '%f is not a valid date/time value.';
+ SInvalidDrive = 'Invalid drive specified';
+ SInvalidFileHandle = 'Invalid file handle';
+ SInvalidFloat = '"%s" is an invalid float';
+ SInvalidFormat = 'Invalid format specifier : "%s"';
+ SInvalidGUID = '"%s" is not a valid GUID value';
+ SInvalidInput = 'Invalid input';
+ SInvalidInteger = '"%s" is an invalid integer';
+ SInvalidOp = 'Invalid floating point operation';
+ SInvalidPointer = 'Invalid pointer operation';
+ SInvalidVarCast = 'Invalid variant type case';
+ SInvalidVarOp = 'Invalid variant operation';
+ SNoThreadSupport = 'Threads not supported. Recompile program with thread driver.';
+ SOutOfMemory = 'Out of memory';
+ SOverflow = 'Floating point overflow';
+ SPrivilege = 'Privileged instruction';
+ SRangeError = 'Range check error';
+ SSafecallException = 'Exception in safecall method';
+ STooManyOpenFiles = 'Too many open files';
+ SUnKnownRunTimeError = 'Unknown Run-Time error : %3.3d';
+ SUnderflow = 'Floating point underflow';
+ SUnknownErrorCode = 'Unknown error code: %d';
+ SVarArrayBounds = 'Variant array bounds error';
+ SVarArrayCreate = 'Variant array cannot be created';
+ SVarNotArray = 'Variant doesn''t contain an array';
+
+{
+ $Log: stre.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/strg.inc b/rtl/objpas/sysutils/strg.inc
new file mode 100644
index 0000000000..3888dd256e
--- /dev/null
+++ b/rtl/objpas/sysutils/strg.inc
@@ -0,0 +1,42 @@
+{
+ $Id: strg.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file implements english error message strings
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ German string constants for any messages issued by the sysutils unit.
+ Please have them ordered by constant name.
+}
+
+Const
+
+ { Error messages for exceptions }
+
+ SAccessDenied = 'Zugriff verweigert';
+ SDiskFull = 'Plattenspeichermedium voll';
+ SEndOfFile = 'Lesezugriff hinter Dateiende';
+ SInValidFileName = 'Ungltiger Dateiname';
+ SInvalidInput = 'Ungltige Eingabe';
+ SInvalidPointer = 'Ungltiger Zeigeroperation';
+ SOutOfMemory = 'Speicher voll';
+ STooManyOpenFiles = 'Zu viele offene Dateien';
+ SUnKnownRunTimeError = 'Unbekannter Laufzeitfehler : %3.3d';
+ SFileNotFound = 'Datei nicht gefunden';
+
+{
+ $Log: strg.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/sysansi.inc b/rtl/objpas/sysutils/sysansi.inc
new file mode 100644
index 0000000000..058f69edb1
--- /dev/null
+++ b/rtl/objpas/sysutils/sysansi.inc
@@ -0,0 +1,78 @@
+{
+ *********************************************************************
+ $Id: sysansi.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 2002 by Florian Klaempfl
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+}
+
+Function AnsiCompareFileName(const S1, S2: string): SizeInt;
+
+begin
+ If FileNameCaseSensitive then
+ Result:=AnsiCompareStr(S1,S2) // Compare case sensitive
+ else
+ Result:=AnsiCompareText(S1,S2); // Compare case insensitive. No MBCS yet.
+end;
+
+Function SameFileName(const S1, S2: string): Boolean;
+
+begin
+ Result:=AnsiCompareFileName(S1,S2)=0;
+end;
+
+Function AnsiLowerCaseFileName(const S: string): string;
+
+begin
+ Result:=AnsiLowerCase(S); // No locale support or MBCS yet.
+end;
+
+Function AnsiUpperCaseFileName(const S: string): string;
+
+begin
+ Result:=AnsiUpperCase(S); // No locale support or MBCS yet.
+end;
+
+Function AnsiPos(const Substr, S: string): SizeInt;
+
+begin
+ Result:=Pos(Substr,S); // No MBCS yet.
+end;
+
+Function AnsiStrPos(Str, SubStr: PChar): PChar;
+
+begin
+ Result:=StrPos(Str,Substr);
+end;
+
+Function AnsiStrRScan(Str: PChar; Chr: Char): PChar;
+
+begin
+ Result:=StrRScan(Str,Chr);
+end;
+
+Function AnsiStrScan(Str: PChar; Chr: Char): PChar;
+
+begin
+ Result:=StrScan(Str,Chr);
+end;
+
+{
+ $Log: sysansi.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/sysansih.inc b/rtl/objpas/sysutils/sysansih.inc
new file mode 100644
index 0000000000..6800122226
--- /dev/null
+++ b/rtl/objpas/sysutils/sysansih.inc
@@ -0,0 +1,38 @@
+{
+ *********************************************************************
+ $Id: sysansih.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 2002 by Florian Klaempfl
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+}
+
+function AnsiCompareFileName(const S1, S2 : string) : SizeInt;
+function AnsiLowerCaseFileName(const s : string) : string;
+function AnsiUpperCaseFileName(const s : string) : string;
+function AnsiPos(const substr,s : string) : SizeInt;
+function AnsiStrPos(str,substr : PChar) : PChar;
+function AnsiStrRScan(Str : PChar;Chr : Char) : PChar;
+function AnsiStrScan(Str : PChar;Chr: Char) : PChar;
+
+{
+ $Log: sysansih.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.3 2005/02/03 16:21:59 peter
+ * 1.0.x fix
+
+}
diff --git a/rtl/objpas/sysutils/sysformt.inc b/rtl/objpas/sysutils/sysformt.inc
new file mode 100644
index 0000000000..41fb6923c5
--- /dev/null
+++ b/rtl/objpas/sysutils/sysformt.inc
@@ -0,0 +1,363 @@
+Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
+ Hs,ToAdd : TFormatString;
+ Index : SizeInt;
+ Width,Prec : Longint;
+ Left : Boolean;
+ Fchar : char;
+{$ifdef ver1_0}
+ vl : int64;
+{$else}
+ vq : qword;
+{$endif}
+
+ {
+ ReadFormat reads the format string. It returns the type character in
+ uppercase, and sets index, Width, Prec to their correct values,
+ or -1 if not set. It sets Left to true if left alignment was requested.
+ In case of an error, DoFormatError is called.
+ }
+
+ Function ReadFormat : Char;
+
+ Var Value : longint;
+
+ Procedure ReadInteger;
+
+{$IFDEF VIRTUALPASCAL}
+var Code: longint;
+{$ELSE}
+var Code: word;
+{$ENDIF}
+
+ begin
+ If Value<>-1 then exit; // Was already read.
+ OldPos:=chPos;
+ While (Chpos<=Len) and
+ (Pos(Fmt[chpos],'1234567890')<>0) do inc(chpos);
+ If Chpos>len then
+ DoFormatError(feInvalidFormat);
+ If Fmt[Chpos]='*' then
+ begin
+ If (Chpos>OldPos) or (ArgPos>High(Args))
+ or (Args[ArgPos].Vtype<>vtInteger) then
+ DoFormatError(feInvalidFormat);
+ Value:=Args[ArgPos].VInteger;
+ Inc(ArgPos);
+ Inc(chPos);
+ end
+ else
+ begin
+ If (OldPos<chPos) Then
+ begin
+ Val (Copy(Fmt,OldPos,ChPos-OldPos),value,code);
+ // This should never happen !!
+ If Code>0 then DoFormatError (feInvalidFormat);
+ end
+ else
+ Value:=-1;
+ end;
+ end;
+
+ Procedure ReadIndex;
+
+ begin
+ ReadInteger;
+ If Fmt[ChPos]=':' then
+ begin
+ If Value=-1 then DoFormatError(feMissingArgument);
+ Index:=Value;
+ Value:=-1;
+ Inc(Chpos);
+ end;
+{$ifdef fmtdebug}
+ Log ('Read index');
+{$endif}
+ end;
+
+ Procedure ReadLeft;
+
+ begin
+ If Fmt[chpos]='-' then
+ begin
+ left:=True;
+ Inc(chpos);
+ end
+ else
+ Left:=False;
+{$ifdef fmtdebug}
+ Log ('Read Left');
+{$endif}
+ end;
+
+ Procedure ReadWidth;
+
+ begin
+ ReadInteger;
+ If Value<>-1 then
+ begin
+ Width:=Value;
+ Value:=-1;
+ end;
+{$ifdef fmtdebug}
+ Log ('Read width');
+{$endif}
+ end;
+
+ Procedure ReadPrec;
+
+ begin
+ If Fmt[chpos]='.' then
+ begin
+ inc(chpos);
+ ReadInteger;
+ If Value=-1 then
+ Value:=0;
+ prec:=Value;
+ end;
+{$ifdef fmtdebug}
+ Log ('Read precision');
+{$endif}
+ end;
+
+{$ifdef INWIDEFORMAT}
+ var
+ FormatChar : TFormatChar;
+{$endif INWIDEFORMAT}
+
+ begin
+{$ifdef fmtdebug}
+ Log ('Start format');
+{$endif}
+ Index:=-1;
+ Width:=-1;
+ Prec:=-1;
+ Value:=-1;
+ inc(chpos);
+ If Fmt[Chpos]='%' then
+ begin
+ Result:='%';
+ exit; // VP fix
+ end;
+ ReadIndex;
+ ReadLeft;
+ ReadWidth;
+ ReadPrec;
+{$ifdef INWIDEFORMAT}
+ FormatChar:=UpCase(Fmt[ChPos])[1];
+ if word(FormatChar)>255 then
+ ReadFormat:=#255
+ else
+ ReadFormat:=FormatChar;
+{$else INWIDEFORMAT}
+ ReadFormat:=Upcase(Fmt[ChPos]);
+{$endif INWIDEFORMAT}
+{$ifdef fmtdebug}
+ Log ('End format');
+{$endif}
+end;
+
+
+{$ifdef fmtdebug}
+Procedure DumpFormat (C : char);
+begin
+ Write ('Fmt : ',fmt:10);
+ Write (' Index : ',Index:3);
+ Write (' Left : ',left:5);
+ Write (' Width : ',Width:3);
+ Write (' Prec : ',prec:3);
+ Writeln (' Type : ',C);
+end;
+{$endif}
+
+
+function Checkarg (AT : SizeInt;err:boolean):boolean;
+{
+ Check if argument INDEX is of correct type (AT)
+ If Index=-1, ArgPos is used, and argpos is augmented with 1
+ DoArg is set to the argument that must be used.
+}
+begin
+ result:=false;
+ if Index=-1 then
+ DoArg:=Argpos
+ else
+ DoArg:=Index;
+ ArgPos:=DoArg+1;
+ If (Doarg>High(Args)) or (Args[Doarg].Vtype<>AT) then
+ begin
+ if err then
+ DoFormatError(feInvalidArgindex);
+ dec(ArgPos);
+ exit;
+ end;
+ result:=true;
+end;
+
+Const Zero = '000000000000000000000000000000000000000000000000000000000000000';
+
+begin
+ Result:='';
+ Len:=Length(Fmt);
+ Chpos:=1;
+ OldPos:=1;
+ ArgPos:=0;
+ While chpos<=len do
+ begin
+ While (ChPos<=Len) and (Fmt[chpos]<>'%') do
+ inc(chpos);
+ If ChPos>OldPos Then
+ Result:=Result+Copy(Fmt,OldPos,Chpos-Oldpos);
+ If ChPos<Len then
+ begin
+ FChar:=ReadFormat;
+{$ifdef fmtdebug}
+ DumpFormat(FCHar);
+{$endif}
+ Case FChar of
+ 'D' : begin
+ if Checkarg(vtinteger,false) then
+ Str(Args[Doarg].VInteger,ToAdd)
+ {$IFNDEF VIRTUALPASCAL}
+ else if CheckArg(vtInt64,true) then
+ Str(Args[DoArg].VInt64^,toadd)
+ {$ENDIF}
+ ;
+ Width:=Abs(width);
+ Index:=Prec-Length(ToAdd);
+ If ToAdd[1]<>'-' then
+ ToAdd:=StringOfChar('0',Index)+ToAdd
+ else
+ // + 1 to accomodate for - sign in length !!
+ Insert(StringOfChar('0',Index+1),toadd,2);
+ end;
+ 'U' : begin
+ if Checkarg(vtinteger,false) then
+ Str(cardinal(Args[Doarg].VInteger),ToAdd)
+ {$IFNDEF VIRTUALPASCAL}
+ else if CheckArg(vtInt64,true) then
+ Str(qword(Args[DoArg].VInt64^),toadd)
+ {$ENDIF}
+ ;
+ Width:=Abs(width);
+ Index:=Prec-Length(ToAdd);
+ ToAdd:=StringOfChar('0',Index)+ToAdd
+ end;
+ 'E' : begin
+ CheckArg(vtExtended,true);
+ ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffexponent,Prec,3);
+ end;
+ 'F' : begin
+ CheckArg(vtExtended,true);
+ ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffFixed,9999,Prec);
+ end;
+ 'G' : begin
+ CheckArg(vtExtended,true);
+ ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffGeneral,Prec,3);
+ end;
+ 'N' : begin
+ CheckArg(vtExtended,true);
+ ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffNumber,9999,Prec);
+ end;
+ 'M' : begin
+ CheckArg(vtExtended,true);
+ ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffCurrency,9999,Prec);
+ end;
+ 'S' : begin
+ if CheckArg(vtString,false) then
+ hs:=Args[doarg].VString^
+ else
+ if CheckArg(vtChar,false) then
+ hs:=Args[doarg].VChar
+ else
+ if CheckArg(vtPChar,false) then
+ hs:=Args[doarg].VPChar
+ else
+{$ifndef VER1_0}
+ if CheckArg(vtPWideChar,false) then
+ hs:=WideString(Args[doarg].VPWideChar)
+ else
+ if CheckArg(vtWideChar,false) then
+ hs:=WideString(Args[doarg].VWideChar)
+ else
+ if CheckArg(vtWidestring,false) then
+ hs:=WideString(Args[doarg].VWideString)
+ else
+{$endif VER1_0}
+ if CheckArg(vtAnsiString,true) then
+ hs:=ansistring(Args[doarg].VAnsiString);
+ Index:=Length(hs);
+ If (Prec<>-1) and (Index>Prec) then
+ Index:=Prec;
+ ToAdd:=Copy(hs,1,Index);
+ end;
+ 'P' : Begin
+ CheckArg(vtpointer,true);
+ ToAdd:=HexStr(ptrint(Args[DoArg].VPointer),sizeof(Ptrint)*2);
+ // Insert ':'. Is this needed in 32 bit ? No it isn't.
+ // Insert(':',ToAdd,5);
+ end;
+ 'X' : begin
+{$ifdef ver1_0}
+ if Checkarg(vtinteger,false) then
+ begin
+ vl:=Args[Doarg].VInteger and int64($ffffffff);
+ index:=16;
+ end
+ else
+ begin
+ CheckArg(vtInt64,true);
+ vl:=Args[DoArg].VInt64^;
+ index:=31;
+ end;
+ If Prec>index then
+ ToAdd:=HexStr(vl,index)
+ else
+ begin
+ // determine minimum needed number of hex digits.
+ Index:=1;
+ While (DWord(1 shl (Index*4))<=DWord(Args[DoArg].VInteger)) and (index<8) do
+ inc(Index);
+ If Index>Prec then
+ Prec:=Index;
+ ToAdd:=HexStr(int64(vl),Prec);
+ end;
+{$else}
+ if Checkarg(vtinteger,false) then
+ begin
+ vq:=Cardinal(Args[Doarg].VInteger);
+ index:=16;
+ end
+ else
+ begin
+ CheckArg(vtInt64,true);
+ vq:=Qword(Args[DoArg].VInt64^);
+ index:=31;
+ end;
+ If Prec>index then
+ ToAdd:=HexStr(vq,index)
+ else
+ begin
+ // determine minimum needed number of hex digits.
+ Index:=1;
+ While (qWord(1) shl (Index*4)<=vq) and (index<16) do
+ inc(Index);
+ If Index>Prec then
+ Prec:=Index;
+ ToAdd:=HexStr(vq,Prec);
+ end;
+{$endif}
+ end;
+ '%': ToAdd:='%';
+ end;
+ If Width<>-1 then
+ If Length(ToAdd)<Width then
+ If not Left then
+ ToAdd:=Space(Width-Length(ToAdd))+ToAdd
+ else
+ ToAdd:=ToAdd+space(Width-Length(ToAdd));
+ Result:=Result+ToAdd;
+ end;
+ inc(chpos);
+ Oldpos:=chpos;
+ end;
+end;
diff --git a/rtl/objpas/sysutils/sysint.inc b/rtl/objpas/sysutils/sysint.inc
new file mode 100644
index 0000000000..be5c218dbf
--- /dev/null
+++ b/rtl/objpas/sysutils/sysint.inc
@@ -0,0 +1,50 @@
+{
+ $Id: sysint.inc,v 1.3 2005/03/13 14:30:24 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by the Free Pascal development team
+
+ International settings for Sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure InitInternationalGeneric;
+ begin
+ fillchar(SysLocale,sizeof(SysLocale),0);
+
+ { keep these routines out of the executable? }
+{$ifndef VER1_0}
+{$ifndef FPC_NOGENERICANSIROUTINES}
+ widestringmanager.UpperAnsiStringProc:=@GenericAnsiUpperCase;
+ widestringmanager.LowerAnsiStringProc:=@GenericAnsiLowerCase;
+ widestringmanager.CompareStrAnsiStringProc:=@GenericAnsiCompareStr;
+ widestringmanager.CompareTextAnsiStringProc:=@GenericAnsiCompareText;
+ widestringmanager.StrCompAnsiStringProc:=@GenericAnsiStrComp;
+ widestringmanager.StrICompAnsiStringProc:=@GenericAnsiStrIComp;
+ widestringmanager.StrLCompAnsiStringProc:=@GenericAnsiStrLComp;
+ widestringmanager.StrLICompAnsiStringProc:=@GenericAnsiStrLIComp;
+ widestringmanager.StrLowerAnsiStringProc:=@GenericAnsiStrLower;
+ widestringmanager.StrUpperAnsiStringProc:=@GenericAnsiStrUpper;
+{$endif FPC_NOGENERICANSIROUTINES}
+{$endif}
+ end;
+
+{
+ $Log: sysint.inc,v $
+ Revision 1.3 2005/03/13 14:30:24 marco
+ * some 1.0.x fixes
+
+ Revision 1.2 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.1 2005/02/26 19:25:01 florian
+ + initial commit
+} \ No newline at end of file
diff --git a/rtl/objpas/sysutils/sysinth.inc b/rtl/objpas/sysutils/sysinth.inc
new file mode 100644
index 0000000000..2f0401b3ad
--- /dev/null
+++ b/rtl/objpas/sysutils/sysinth.inc
@@ -0,0 +1,152 @@
+{
+ $Id: sysinth.inc,v 1.3 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ International settings for Sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ All the variables presented here must be set by the InitInternational
+ routine. They must be set to match the 'local' settings, although
+ most have an initial value.
+
+
+ These routines are OS-dependent.
+}
+
+{ ---------------------------------------------------------------------
+ Upper/lowercase translations
+ ---------------------------------------------------------------------}
+
+type
+ TCaseTranslationTable = array[0..255] of char;
+
+var
+ { Tables with upper and lowercase forms of character sets.
+ MUST be initialized with the correct code-pages }
+ UpperCaseTable: TCaseTranslationTable;
+ LowerCaseTable: TCaseTranslationTable;
+
+{ ---------------------------------------------------------------------
+ Date formatting settings
+ ---------------------------------------------------------------------}
+
+Const
+
+ { Character to be put between date, month and year }
+ DateSeparator: char = '-';
+
+ { Format used for short date notation }
+ ShortDateFormat: string = 'd/m/y';
+
+ { Format used for long date notation }
+ LongDateFormat: string = 'dd" "mmmm" "yyyy';
+
+
+ { Short names of months. }
+ ShortMonthNames: array[1..12] of string[128] =
+ ('Jan','Feb','Mar','Apr','May','Jun',
+ 'Jul','Aug','Sep','Oct','Nov','Dec');
+
+ { Long names of months. }
+ LongMonthNames: array[1..12] of string[128] =
+ ('January','February','March','April','May','June',
+ 'July','August','September','October','November','December');
+
+ { Short names of days }
+ ShortDayNames: array[1..7] of string[128] =
+ ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+
+ { Full names of days }
+ LongDayNames: array[1..7] of string[128] =
+ ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
+
+ { Format used for short time notation }
+ ShortTimeFormat: string[128] = 'hh:nn';
+
+ { Format used for long time notation }
+ LongTimeFormat: string[128] = 'hh:nn:ss';
+
+ { Character to be put between hours and minutes }
+ TimeSeparator: char = ':';
+
+ { String to indicate AM time when using 12 hour clock. }
+ TimeAMString: string[7] = 'AM';
+
+ { String to indicate PM time when using 12 hour clock. }
+ TimePMString: string[7] = 'PM';
+
+
+
+{ ---------------------------------------------------------------------
+ Number formatting constants
+ ---------------------------------------------------------------------}
+
+
+ { Character that comes between integer and fractional part of a number }
+ DecimalSeparator : Char = '.';
+
+ { Character that is put every 3 numbers in a currency }
+ ThousandSeparator : Char = ',';
+
+ { Number of decimals to use when formatting a currency. }
+ CurrencyDecimals : Byte = 2;
+
+ { Format to use when formatting currency :
+ 0 = $1
+ 1 = 1$
+ 2 = $ 1
+ 3 = 1 $
+ 4 = Currency string replaces decimal indicator. e.g. 1$50
+ }
+ CurrencyFormat : Byte = 1;
+
+ { Same as above, only for negative currencies:
+ 0 = ($1)
+ 1 = -$1
+ 2 = $-1
+ 3 = $1-
+ 4 = (1$)
+ 5 = -1$
+ 6 = 1-$
+ 7 = 1$-
+ 8 = -1 $
+ 9 = -$ 1
+ 10 = $ 1-
+ }
+ NegCurrFormat : Byte = 5;
+
+ { Currency notation. Default is $ for dollars. }
+ CurrencyString : String[7] = '$';
+
+type
+ TSysLocale = record
+ case byte of
+ { win32 names }
+ 1 : (FarEast: boolean; MiddleEast: Boolean);
+ { real meaning }
+ 2 : (MBCS : boolean; RightToLeft: Boolean);
+ end;
+
+var
+ SysLocale : TSysLocale;
+
+
+{
+ $Log: sysinth.inc,v $
+ Revision 1.3 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/syspch.inc b/rtl/objpas/sysutils/syspch.inc
new file mode 100644
index 0000000000..2d8b02bb58
--- /dev/null
+++ b/rtl/objpas/sysutils/syspch.inc
@@ -0,0 +1,131 @@
+{
+ *********************************************************************
+ $Id: syspch.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+{ PChar functions }
+
+type
+ pbyte = ^byte;
+ CharArray = array[0..0] of char;
+
+{ Processor dependent part, shared withs strings unit }
+{$IFNDEF VIRTUALPASCAL} // in system there
+{$ifdef FPC_USE_LIBC}
+{$i cgenstr.inc}
+{$endif FPC_USE_LIBC}
+{$i strings.inc }
+{$ENDIF}
+
+{ Read generic string functions that are not implemented for the processor }
+{$i genstr.inc}
+
+{ Processor independent part, shared with strings unit }
+{$i stringsi.inc }
+
+{ StrPas converts a PChar to a pascal string }
+
+function StrPas(Str: PChar): string;
+begin
+ Result:=Str;
+end ;
+
+{ StrAlloc allocates a buffer of Size + 4
+ the size of the allocated buffer is stored at result - 4
+ StrDispose should be used to destroy the buffer }
+
+function StrAlloc(Size: cardinal): PChar;
+begin
+ inc(size,sizeof(cardinal));
+ getmem(result,size);
+ cardinal(pointer(result)^):=size;
+ inc(result,sizeof(cardinal));
+end;
+
+
+{ Allocates a new string using StrAlloc, you need StrDispose to dispose the
+ string }
+
+function strnew(p : pchar) : pchar;
+var
+ len : longint;
+begin
+ Result:=nil;
+ if (p=nil) or (p^=#0) then
+ exit;
+ len:=strlen(p)+1;
+ Result:=StrAlloc(Len);
+ if Result<>nil then
+ strmove(Result,p,len);
+end;
+
+
+{ StrPCopy copies the pascal string Source to Dest and returns Dest }
+
+function StrPCopy(Dest: PChar; Source: string): PChar;
+begin
+ result := StrMove(Dest, PChar(Source), length(Source)+1);
+end ;
+
+{ StrPLCopy copies MaxLen or less characters from the pascal string
+ Source to Dest and returns Dest }
+
+function StrPLCopy(Dest: PChar; Source: string; MaxLen: SizeUInt): PChar;
+var Count: SizeUInt;
+begin
+result := Dest;
+if (Result <> Nil) and (MaxLen <> 0) then begin
+ Count := Length(Source);
+ if Count > MaxLen then
+ Count := MaxLen;
+ StrMove(Dest, PChar(Source), Count);
+ CharArray(result^)[Count] := #0; { terminate ! }
+ end ;
+end ;
+
+
+{ StrDispose clears the memory allocated with StrAlloc }
+
+procedure StrDispose(Str: PChar);
+begin
+ if (Str <> Nil) then
+ begin
+ dec(Str,sizeof(cardinal));
+ Freemem(str,cardinal(pointer(str)^));
+ end;
+end;
+
+{ StrBufSize returns the amount of memory allocated for pchar Str allocated with StrAlloc }
+
+function StrBufSize(Str: PChar): SizeUInt;
+begin
+ if Str <> Nil then
+ result := SizeUInt(pointer(Str - SizeOf(SizeUInt))^)-sizeof(SizeUInt)
+ else
+ result := 0;
+end ;
+
+{
+ $Log: syspch.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/syspchh.inc b/rtl/objpas/sysutils/syspchh.inc
new file mode 100644
index 0000000000..a4a0f6a7c6
--- /dev/null
+++ b/rtl/objpas/sysutils/syspchh.inc
@@ -0,0 +1,57 @@
+{
+ *********************************************************************
+ $Id: syspchh.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+{ shared with strings unit }
+function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
+function strcopy(dest,source : pchar) : pchar;
+function strlcopy(dest,source : pchar;maxlen : SizeInt) : pchar;
+function strecopy(dest,source : pchar) : pchar;
+function strend(p : pchar) : pchar;
+function strcat(dest,source : pchar) : pchar;
+function strcomp(str1,str2 : pchar) : SizeInt;
+function strlcomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
+function stricomp(str1,str2 : pchar) : SizeInt;
+function strmove(dest,source : pchar;l : SizeInt) : pchar;
+function strlcat(dest,source : pchar;l : SizeInt) : pchar;
+function strscan(p : pchar;c : char) : pchar;
+function strrscan(p : pchar;c : char) : pchar;
+function strlower(p : pchar) : pchar;
+function strupper(p : pchar) : pchar;
+function strlicomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
+function strpos(str1,str2 : pchar) : pchar;
+function strnew(p : pchar) : pchar;
+
+{ Different from strings unit - ansistrings or different behaviour }
+function StrPas(Str: PChar): string;
+function StrPCopy(Dest: PChar; Source: string): PChar;
+function StrPLCopy(Dest: PChar; Source: string; MaxLen: SizeUInt): PChar;
+function StrAlloc(Size: cardinal): PChar;
+function StrBufSize(Str: PChar): SizeUInt;
+procedure StrDispose(Str: PChar);
+
+{
+ $Log: syspchh.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc
new file mode 100644
index 0000000000..f1081ee1bf
--- /dev/null
+++ b/rtl/objpas/sysutils/sysstr.inc
@@ -0,0 +1,2156 @@
+{
+ *********************************************************************
+ $Id: sysstr.inc,v 1.38 2005/05/09 18:35:06 michael Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+{ NewStr creates a new PString and assigns S to it
+ if length(s) = 0 NewStr returns Nil }
+
+function NewStr(const S: string): PString;
+begin
+ if (S='') then
+ Result:=nil
+ else
+ begin
+ new(result);
+ if (Result<>nil) then
+ Result^:=s;
+ end;
+end;
+
+{ DisposeStr frees the memory occupied by S }
+
+procedure DisposeStr(S: PString);
+begin
+ if S <> Nil then
+ begin
+ dispose(s);
+ S:=nil;
+ end;
+end;
+
+{ AssignStr assigns S to P^ }
+
+procedure AssignStr(var P: PString; const S: string);
+begin
+ P^ := s;
+end ;
+
+{ AppendStr appends S to Dest }
+
+procedure AppendStr(var Dest: String; const S: string);
+begin
+Dest := Dest + S;
+end ;
+
+{ UpperCase returns a copy of S where all lowercase characters ( from a to z )
+ have been converted to uppercase }
+
+function UpperCase(const S: string): string;
+var i: integer;
+begin
+result := S;
+i := Length(S);
+while i <> 0 do begin
+ if (result[i] in ['a'..'z']) then result[i] := char(byte(result[i]) - 32);
+ Dec(i);
+ end;
+end;
+
+{ LowerCase returns a copy of S where all uppercase characters ( from A to Z )
+ have been converted to lowercase }
+
+function LowerCase(const S: string): string;
+var i: integer;
+begin
+result := S;
+i := Length(result);
+while i <> 0 do begin
+ if (result[i] in ['A'..'Z']) then result[i] := char(byte(result[i]) + 32);
+ dec(i);
+ end;
+end;
+
+{ CompareStr compares S1 and S2, the result is the based on
+ substraction of the ascii values of the characters in S1 and S2
+ case result
+ S1 < S2 < 0
+ S1 > S2 > 0
+ S1 = S2 = 0 }
+
+function CompareStr(const S1, S2: string): Integer;
+var count, count1, count2: integer;
+begin
+ result := 0;
+ Count1 := Length(S1);
+ Count2 := Length(S2);
+ if Count1>Count2 then
+ Count:=Count2
+ else
+ Count:=Count1;
+ result := CompareMemRange(Pointer(S1),Pointer(S2), Count);
+ if result=0 then
+ result:=Count1-Count2;
+end;
+
+{ CompareMemRange returns the result of comparison of Length bytes at P1 and P2
+ case result
+ P1 < P2 < 0
+ P1 > P2 > 0
+ P1 = P2 = 0 }
+
+function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
+
+var
+ i: cardinal;
+
+begin
+ i := 0;
+ result := 0;
+ while (result=0) and (I<length) do
+ begin
+ result:=byte(P1^)-byte(P2^);
+ P1:=pchar(P1)+1; // VP compat.
+ P2:=pchar(P2)+1;
+ i := i + 1;
+ end ;
+end ;
+
+function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
+var
+ i: cardinal;
+begin
+ Result:=True;
+ I:=0;
+ If (P1)<>(P2) then
+ While Result and (i<Length) do
+ begin
+ Result:=PByte(P1)^=PByte(P2)^;
+ Inc(I);
+ Inc(pchar(P1));
+ Inc(pchar(P2));
+ end;
+end;
+
+
+{ CompareText compares S1 and S2, the result is the based on
+ substraction of the ascii values of characters in S1 and S2
+ comparison is case-insensitive
+ case result
+ S1 < S2 < 0
+ S1 > S2 > 0
+ S1 = S2 = 0 }
+
+function CompareText(const S1, S2: string): integer;
+
+var
+ i, count, count1, count2: integer; Chr1, Chr2: byte;
+begin
+ result := 0;
+ Count1 := Length(S1);
+ Count2 := Length(S2);
+ if (Count1>Count2) then
+ Count := Count2
+ else
+ Count := Count1;
+ i := 0;
+ while (result=0) and (i<count) do
+ begin
+ inc (i);
+ Chr1 := byte(s1[i]);
+ Chr2 := byte(s2[i]);
+ if Chr1 in [97..122] then
+ dec(Chr1,32);
+ if Chr2 in [97..122] then
+ dec(Chr2,32);
+ result := Chr1 - Chr2;
+ end ;
+ if (result = 0) then
+ result:=(count1-count2);
+end;
+
+function SameText(const s1,s2:String):Boolean;
+
+begin
+ Result:=CompareText(S1,S2)=0;
+end;
+
+{==============================================================================}
+{ Ansi string functions }
+{ these functions rely on the character set loaded by the OS }
+{==============================================================================}
+
+function GenericAnsiUpperCase(const s: string): string;
+ var
+ len, i: integer;
+begin
+ len := length(s);
+ SetLength(result, len);
+ for i := 1 to len do
+ result[i] := UpperCaseTable[ord(s[i])];
+end;
+
+
+function GenericAnsiLowerCase(const s: string): string;
+ var
+ len, i: integer;
+begin
+ len := length(s);
+ SetLength(result, len);
+ for i := 1 to len do
+ result[i] := LowerCaseTable[ord(s[i])];
+end;
+
+
+function GenericAnsiCompareStr(const S1, S2: string): PtrInt;
+ Var
+ I,L1,L2 : SizeInt;
+begin
+ Result:=0;
+ L1:=Length(S1);
+ L2:=Length(S2);
+ I:=1;
+ While (Result=0) and ((I<=L1) and (I<=L2)) do
+ begin
+ Result:=Ord(S1[I])-Ord(S2[I]); //!! Must be replaced by ansi characters !!
+ Inc(I);
+ end;
+ If Result=0 Then
+ Result:=L1-L2;
+end;
+
+function GenericAnsiCompareText(const S1, S2: string): PtrInt;
+ Var
+ I,L1,L2 : SizeInt;
+begin
+ Result:=0;
+ L1:=Length(S1);
+ L2:=Length(S2);
+ I:=1;
+ While (Result=0) and ((I<=L1) and (I<=L2)) do
+ begin
+ Result:=Ord(LowerCaseTable[Ord(S1[I])])-Ord(LowerCaseTable[Ord(S2[I])]); //!! Must be replaced by ansi characters !!
+ Inc(I);
+ end;
+ If Result=0 Then
+ Result:=L1-L2;
+end;
+
+function AnsiSameText(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
+ AnsiSameText:=AnsiCompareText(S1,S2)=0;
+end;
+
+function AnsiSameStr(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
+ AnsiSameStr:=AnsiCompareStr(S1,S2)=0;
+end;
+
+function GenericAnsiStrComp(S1, S2: PChar): PtrInt;
+
+begin
+ Result:=0;
+ If S1=Nil then
+ begin
+ If S2=Nil Then Exit;
+ result:=-1;
+ exit;
+ end;
+ If S2=Nil then
+ begin
+ Result:=1;
+ exit;
+ end;
+ Repeat
+ Result:=Ord(S1[0])-Ord(S2[0]); //!! Must be replaced by ansi characters !!
+ Inc(S1);
+ Inc(S2);
+ Until (Result<>0) or ((S1[0]=#0) or (S2[0]=#0))
+end;
+
+
+function GenericAnsiStrIComp(S1, S2: PChar): PtrInt;
+
+begin
+ Result:=0;
+ If S1=Nil then
+ begin
+ If S2=Nil Then Exit;
+ result:=-1;
+ exit;
+ end;
+ If S2=Nil then
+ begin
+ Result:=1;
+ exit;
+ end;
+ Repeat
+ Result:=Ord(LowerCaseTable[Ord(S1[0])])-Ord(LowerCaseTable[Ord(S2[0])]); //!! Must be replaced by ansi characters !!
+ Inc(S1);
+ Inc(S2);
+ Until (Result<>0) or ((S1[0]=#0) or (S2[0]=#0))
+end;
+
+
+function GenericAnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+
+Var I : cardinal;
+
+begin
+ Result:=0;
+ If MaxLen=0 then exit;
+ If S1=Nil then
+ begin
+ If S2=Nil Then Exit;
+ result:=-1;
+ exit;
+ end;
+ If S2=Nil then
+ begin
+ Result:=1;
+ exit;
+ end;
+ I:=0;
+ Repeat
+ Result:=Ord(S1[0])-Ord(S2[0]); //!! Must be replaced by ansi characters !!
+ Inc(S1);
+ Inc(S2);
+ Inc(I);
+ Until (Result<>0) or ((S1[0]=#0) or (S2[0]=#0)) or (I=MaxLen)
+end;
+
+
+function GenericAnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+
+Var I : cardinal;
+
+begin
+ Result:=0;
+ If MaxLen=0 then exit;
+ If S1=Nil then
+ begin
+ If S2=Nil Then Exit;
+ result:=-1;
+ exit;
+ end;
+ If S2=Nil then
+ begin
+ Result:=1;
+ exit;
+ end;
+ I:=0;
+ Repeat
+ Result:=Ord(LowerCaseTable[Ord(S1[0])])-Ord(LowerCaseTable[Ord(S2[0])]); //!! Must be replaced by ansi characters !!
+ Inc(S1);
+ Inc(S2);
+ Inc(I);
+ Until (Result<>0) or ((S1[0]=#0) or (S2[0]=#0)) or (I=MaxLen)
+end;
+
+
+function GenericAnsiStrLower(Str: PChar): PChar;
+begin
+result := Str;
+if Str <> Nil then begin
+ while Str^ <> #0 do begin
+ Str^ := LowerCaseTable[byte(Str^)];
+ Str := Str + 1;
+ end;
+ end;
+end;
+
+
+function GenericAnsiStrUpper(Str: PChar): PChar;
+begin
+result := Str;
+if Str <> Nil then begin
+ while Str^ <> #0 do begin
+ Str^ := UpperCaseTable[byte(Str^)];
+ Str := Str + 1;
+ end ;
+ end ;
+end ;
+
+function AnsiLastChar(const S: string): PChar;
+
+begin
+ //!! No multibyte yet, so we return the last one.
+ result:=StrEnd(Pchar(S));
+ Dec(Result);
+end ;
+
+function AnsiStrLastChar(Str: PChar): PChar;
+begin
+ //!! No multibyte yet, so we return the last one.
+ result:=StrEnd(Str);
+ Dec(Result);
+end ;
+
+
+function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.UpperAnsiStringProc(s);
+ {$endif}
+ end;
+
+
+function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.LowerAnsiStringProc(s);
+ {$endif}
+ end;
+
+
+function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.CompareStrAnsiStringProc(s1,s2);
+ {$endif}
+ end;
+
+
+function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.CompareTextAnsiStringProc(s1,s2);
+ {$endif}
+ end;
+
+
+function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.StrCompAnsiStringProc(s1,s2);
+ {$endif}
+ end;
+
+
+function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.StrICompAnsiStringProc(s1,s2);
+ {$endif}
+ end;
+
+
+function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.StrLCompAnsiStringProc(s1,s2,maxlen);
+ {$endif}
+ end;
+
+
+function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.StrLICompAnsiStringProc(s1,s2,maxlen);
+ {$endif}
+ end;
+
+
+function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.StrLowerAnsiStringProc(Str);
+ {$endif}
+ end;
+
+
+function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ {$ifndef ver1_0}
+ result:=widestringmanager.StrUpperAnsiStringProc(Str);
+ {$endif}
+ end;
+
+
+{==============================================================================}
+{ End of Ansi functions }
+{==============================================================================}
+
+{ Trim returns a copy of S with blanks characters on the left and right stripped off }
+
+Const WhiteSpace = [' ',#10,#13,#9];
+
+function Trim(const S: string): string;
+var Ofs, Len: integer;
+begin
+ len := Length(S);
+ while (Len>0) and (S[Len] in WhiteSpace) do
+ dec(Len);
+ Ofs := 1;
+ while (Ofs<=Len) and (S[Ofs] in WhiteSpace) do
+ Inc(Ofs);
+ result := Copy(S, Ofs, 1 + Len - Ofs);
+end ;
+
+{ TrimLeft returns a copy of S with all blank characters on the left stripped off }
+
+function TrimLeft(const S: string): string;
+var i,l:integer;
+begin
+ l := length(s);
+ i := 1;
+ while (i<=l) and (s[i] in whitespace) do
+ inc(i);
+ Result := copy(s, i, l);
+end ;
+
+{ TrimRight returns a copy of S with all blank characters on the right stripped off }
+
+function TrimRight(const S: string): string;
+var l:integer;
+begin
+ l := length(s);
+ while (l>0) and (s[l] in whitespace) do
+ dec(l);
+ result := copy(s,1,l);
+end ;
+
+{ QuotedStr returns S quoted left and right and every single quote in S
+ replaced by two quotes }
+
+function QuotedStr(const S: string): string;
+begin
+result := AnsiQuotedStr(s, '''');
+end ;
+
+{ AnsiQuotedStr returns S quoted left and right by Quote,
+ and every single occurance of Quote replaced by two }
+
+function AnsiQuotedStr(const S: string; Quote: char): string;
+var i, j, count: integer;
+begin
+result := '' + Quote;
+count := length(s);
+i := 0;
+j := 0;
+while i < count do begin
+ i := i + 1;
+ if S[i] = Quote then begin
+ result := result + copy(S, 1 + j, i - j) + Quote;
+ j := i;
+ end ;
+ end ;
+if i <> j then
+ result := result + copy(S, 1 + j, i - j);
+result := result + Quote;
+end ;
+
+{ AnsiExtractQuotedStr returns a copy of Src with quote characters
+ deleted to the left and right and double occurances
+ of Quote replaced by a single Quote }
+
+
+function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
+var
+ P,Q,R: PChar;
+begin
+ P := Src;
+ Q := StrEnd(P);
+ result:='';
+ if P=Q then exit;
+ if P^<>quote then exit;
+ inc(p);
+
+ setlength(result,(Q-P)+1);
+ R:=@Result[1];
+ while P <> Q do
+ begin
+ R^:=P^;
+ inc(R);
+ if (P^ = Quote) then
+ begin
+ P := P + 1;
+ if (p^ <> Quote) then
+ begin
+ dec(R);
+ break;
+ end;
+ end;
+ P := P + 1;
+ end ;
+ src:=p;
+ SetLength(result, (R-pchar(@Result[1])));
+end ;
+
+
+{ AdjustLineBreaks returns S with all CR characters not followed by LF
+ replaced with CR/LF }
+// under Linux all CR characters or CR/LF combinations should be replaced with LF
+
+function AdjustLineBreaks(const S: string): string;
+
+begin
+ Result:=AdjustLineBreaks(S,DefaultTextLineBreakStyle);
+end;
+
+function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
+var
+ Source,Dest: PChar;
+ DestLen: Integer;
+ I,J,L: Longint;
+
+begin
+ Source:=Pointer(S);
+ L:=Length(S);
+ DestLen:=L;
+ I:=1;
+ while (I<=L) do
+ begin
+ case S[i] of
+ #10: if (Style=tlbsCRLF) then
+ Inc(DestLen);
+ #13: if (Style=tlbsCRLF) then
+ if (I<L) and (S[i+1]=#10) then
+ Inc(I)
+ else
+ Inc(DestLen)
+ else if (I<L) and (S[I+1]=#10) then
+ Dec(DestLen);
+ end;
+ Inc(I);
+ end;
+ if (DestLen=L) then
+ Result:=S
+ else
+ begin
+ SetLength(Result, DestLen);
+ FillChar(Result[1],DestLen,0);
+ Dest := Pointer(Result);
+ J:=0;
+ I:=0;
+ While I<L do
+ case Source[I] of
+ #10: begin
+ if Style=tlbsCRLF then
+ begin
+ Dest[j]:=#13;
+ Inc(J);
+ end;
+ Dest[J] := #10;
+ Inc(J);
+ Inc(I);
+ end;
+ #13: begin
+ if Style=tlbsCRLF then
+ begin
+ Dest[j] := #13;
+ Inc(J);
+ end;
+ Dest[j]:=#10;
+ Inc(J);
+ Inc(I);
+ if Source[I]=#10 then
+ Inc(I);
+ end;
+ else
+ Dest[j]:=Source[i];
+ Inc(J);
+ Inc(I);
+ end;
+ end;
+end;
+
+
+{ IsValidIdent returns true if the first character of Ident is in:
+ 'A' to 'Z', 'a' to 'z' or '_' and the following characters are
+ on of: 'A' to 'Z', 'a' to 'z', '0'..'9' or '_' }
+
+function IsValidIdent(const Ident: string): boolean;
+var i, len: integer;
+begin
+result := false;
+len := length(Ident);
+if len <> 0 then begin
+ result := Ident[1] in ['A'..'Z', 'a'..'z', '_'];
+ i := 1;
+ while (result) and (i < len) do begin
+ i := i + 1;
+ result := result and (Ident[i] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
+ end ;
+ end ;
+end ;
+
+{ IntToStr returns a string representing the value of Value }
+
+function IntToStr(Value: integer): string;
+begin
+ System.Str(Value, result);
+end ;
+
+
+{$IFNDEF VIRTUALPASCAL}
+function IntToStr(Value: int64): string;
+begin
+ System.Str(Value, result);
+end ;
+{$ENDIF}
+
+function IntToStr(Value: QWord): string;
+begin
+ System.Str(Value, result);
+end ;
+
+
+{ IntToHex returns a string representing the hexadecimal value of Value }
+
+const
+ HexDigits: array[0..15] of char = '0123456789ABCDEF';
+
+function IntToHex(Value: integer; Digits: integer): string;
+var i: integer;
+begin
+ SetLength(result, digits);
+ for i := 0 to digits - 1 do
+ begin
+ result[digits - i] := HexDigits[value and 15];
+ value := value shr 4;
+ end ;
+ while value <> 0 do begin
+ result := HexDigits[value and 15] + result;
+ value := value shr 4;
+ end;
+end ;
+
+{$IFNDEF VIRTUALPASCAL} // overloading
+function IntToHex(Value: int64; Digits: integer): string;
+var i: integer;
+begin
+ SetLength(result, digits);
+ for i := 0 to digits - 1 do
+ begin
+ result[digits - i] := HexDigits[value and 15];
+ value := value shr 4;
+ end ;
+ while value <> 0 do begin
+ result := HexDigits[value and 15] + result;
+ value := value shr 4;
+ end;
+end ;
+{$ENDIF}
+
+
+function TryStrToInt(const s: string; var i : integer) : boolean;
+var Error : word;
+begin
+ Val(s, i, Error);
+ TryStrToInt:=Error=0
+end;
+
+{ StrToInt converts the string S to an integer value,
+ if S does not represent a valid integer value EConvertError is raised }
+
+function StrToInt(const S: string): integer;
+{$IFDEF VIRTUALPASCAL}
+var Error: longint;
+{$ELSE}
+var Error: word;
+{$ENDIF}
+begin
+ Val(S, result, Error);
+ if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]);
+end ;
+
+
+function StrToInt64(const S: string): int64;
+{$IFDEF VIRTUALPASCAL}
+var Error: longint;
+{$ELSE}
+var Error: word;
+{$ENDIF}
+
+begin
+ Val(S, result, Error);
+ if Error <> 0 then raise EConvertError.createfmt(SInValidInteger,[S]);
+end;
+
+
+function TryStrToInt64(const s: string; var i : int64) : boolean;
+var Error : word;
+begin
+ Val(s, i, Error);
+ TryStrToInt64:=Error=0
+end;
+
+
+
+{ StrToIntDef converts the string S to an integer value,
+ Default is returned in case S does not represent a valid integer value }
+
+function StrToIntDef(const S: string; Default: integer): integer;
+{$IFDEF VIRTUALPASCAL}
+var Error: longint;
+{$ELSE}
+var Error: word;
+{$ENDIF}
+begin
+Val(S, result, Error);
+if Error <> 0 then result := Default;
+end ;
+
+{ StrToIntDef converts the string S to an integer value,
+ Default is returned in case S does not represent a valid integer value }
+
+function StrToInt64Def(const S: string; Default: int64): int64;
+{$IFDEF VIRTUALPASCAL}
+var Error: longint;
+{$ELSE}
+var Error: word;
+{$ENDIF}
+begin
+Val(S, result, Error);
+if Error <> 0 then result := Default;
+end ;
+
+
+{ LoadStr returns the string resource Ident. }
+
+function LoadStr(Ident: integer): string;
+begin
+ result:='';
+end ;
+
+{ FmtLoadStr returns the string resource Ident and formats it accordingly }
+
+
+function FmtLoadStr(Ident: integer; const Args: array of const): string;
+begin
+ result:='';
+end;
+
+Const
+ feInvalidFormat = 1;
+ feMissingArgument = 2;
+ feInvalidArgIndex = 3;
+
+{$ifdef fmtdebug}
+Procedure Log (Const S: String);
+begin
+ Writeln (S);
+end;
+{$endif}
+
+
+Procedure DoFormatError (ErrCode : Longint);
+Var
+ S : String;
+begin
+ //!! must be changed to contain format string...
+ S:='';
+ Case ErrCode of
+ feInvalidFormat : raise EConvertError.Createfmt(SInvalidFormat,[s]);
+ feMissingArgument : raise EConvertError.Createfmt(SArgumentMissing,[s]);
+ feInvalidArgIndex : raise EConvertError.Createfmt(SInvalidArgIndex,[s]);
+ end;
+end;
+
+
+{ we've no templates, but with includes we can simulate this :) }
+
+{$macro on}
+{$define INFORMAT}
+{$define TFormatString:=ansistring}
+{$define TFormatChar:=char}
+
+Function Format (Const Fmt : AnsiString; const Args : Array of const) : AnsiString;
+{$i sysformt.inc}
+
+{$undef TFormatString}
+{$undef TFormatChar}
+{$undef INFORMAT}
+{$macro off}
+
+Function FormatBuf (Var Buffer; BufLen : Cardinal;
+ Const Fmt; fmtLen : Cardinal;
+ Const Args : Array of const) : Cardinal;
+
+Var S,F : String;
+
+begin
+ Setlength(F,fmtlen);
+ if fmtlen > 0 then
+ Move(fmt,F[1],fmtlen);
+ S:=Format (F,Args);
+ If Cardinal(Length(S))<Buflen then
+ Result:=Length(S)
+ else
+ Result:=Buflen;
+ Move(S[1],Buffer,Result);
+end;
+
+Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
+
+begin
+ Res:=Format(fmt,Args);
+end;
+
+Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
+
+begin
+ Buffer[FormatBuf(Buffer^,Maxint,Fmt^,strlen(fmt),args)]:=#0;
+ Result:=Buffer;
+end;
+
+Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
+
+begin
+ Buffer[FormatBuf(Buffer^,MaxLen,Fmt^,strlen(fmt),args)]:=#0;
+ Result:=Buffer;
+end;
+
+Function StrToFloat(Const S: String): Extended;
+
+Begin
+ If Not TextToFloat(Pchar(S),Result) then
+ Raise EConvertError.createfmt(SInValidFLoat,[S]);
+End;
+
+function StrToFloatDef(const S: string; const Default: Extended): Extended;
+
+begin
+ if not TextToFloat(PChar(S),Result,fvExtended) then
+ Result:=Default;
+end;
+
+Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
+
+Var
+ E,P : Integer;
+ S : String;
+
+Begin
+ S:=StrPas(Buffer);
+ P:=Pos(DecimalSeparator,S);
+ If (P<>0) Then
+ S[P] := '.';
+ Val(trim(S),Value,E);
+ Result:=(E=0);
+End;
+
+Function TextToFloat(Buffer: PChar; Var Value; ValueType: TFloatValue): Boolean;
+
+Var
+ E,P : Integer;
+ S : String;
+
+Begin
+ S:=StrPas(Buffer);
+ P:=Pos(ThousandSeparator,S);
+ While (P<>0) do
+ begin
+ Delete(S,P,1);
+ P:=Pos(ThousandSeparator,S);
+ end;
+ P:=Pos(DecimalSeparator,S);
+ If (P<>0) Then
+ S[P] := '.';
+ case ValueType of
+ fvCurrency:
+ Val(S,Currency(Value),E);
+ fvExtended:
+ Val(S,Extended(Value),E);
+ fvDouble:
+ Val(S,Double(Value),E);
+ fvSingle:
+ Val(S,Single(Value),E);
+ fvComp:
+ Val(S,Comp(Value),E);
+ fvReal:
+ Val(S,Real(Value),E);
+ end;
+ Result:=(E=0);
+End;
+
+Function TryStrToFloat(Const S : String; Var Value: Single): Boolean;
+Begin
+ Result := TextToFloat(PChar(S), Value, fvSingle);
+End;
+
+Function TryStrToFloat(Const S : String; Var Value: Double): Boolean;
+Begin
+ Result := TextToFloat(PChar(S), Value, fvDouble);
+End;
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+Function TryStrToFloat(Const S : String; Var Value: Extended): Boolean;
+Begin
+ Result := TextToFloat(PChar(S), Value);
+End;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+Function FloatToStr(Value: Extended): String;
+Begin
+ Result := FloatToStrF(Value, ffGeneral, 15, 0);
+End;
+
+Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
+Var
+ Tmp: String[40];
+Begin
+ Tmp := FloatToStrF(Value, format, Precision, Digits);
+ Result := Length(Tmp);
+ Move(Tmp[1], Buffer[0], Result);
+End;
+
+
+Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
+Var
+ P: Integer;
+ Negative, TooSmall, TooLarge: Boolean;
+
+
+Begin
+ Case format Of
+
+ ffGeneral:
+
+ Begin
+ If (Precision = -1) Or (Precision > 15) Then Precision := 15;
+ TooSmall := (Abs(Value) < 0.00001) and (Value>0.0);
+ If Not TooSmall Then
+ Begin
+ Str(Value:digits:precision, Result);
+ P := Pos('.', Result);
+ if P<>0 then
+ Result[P] := DecimalSeparator;
+ TooLarge := P > Precision + 1;
+ End;
+
+ If TooSmall Or TooLarge Then
+ begin
+ Result := FloatToStrF(Value, ffExponent, Precision, Digits);
+ // Strip unneeded zeroes.
+ P:=Pos('E',result)-1;
+ If P<>-1 then
+ While (P>1) and (Result[P]='0') do
+ begin
+ system.Delete(Result,P,1);
+ Dec(P);
+ end;
+ end
+ else if (P<>0) then // we have a decimalseparator
+ begin
+ P := Length(Result);
+ While (P>0) and (Result[P] = '0') Do
+ Dec(P);
+ If (P>0) and (Result[P]=DecimalSeparator) Then
+ Dec(P);
+ SetLength(Result, P);
+ end;
+ End;
+
+ ffExponent:
+
+ Begin
+ If (Precision = -1) Or (Precision > 15) Then Precision := 15;
+ Str(Value:Precision + 8, Result);
+ Result[3] := DecimalSeparator;
+ P:=4;
+ While (P>0) and (Digits < P) And (Result[Precision + 5] = '0') do
+ Begin
+ If P<>1 then
+ system.Delete(Result, Precision + 5, 1)
+ else
+ system.Delete(Result, Precision + 3, 3);
+ Dec(P);
+ end;
+ If Result[1] = ' ' Then
+ System.Delete(Result, 1, 1);
+ End;
+
+ ffFixed:
+
+ Begin
+ If Digits = -1 Then Digits := 2
+ Else If Digits > 18 Then Digits := 18;
+ Str(Value:0:Digits, Result);
+ If Result[1] = ' ' Then
+ System.Delete(Result, 1, 1);
+ P := Pos('.', Result);
+ If P <> 0 Then Result[P] := DecimalSeparator;
+ End;
+
+ ffNumber:
+
+ Begin
+ If Digits = -1 Then Digits := 2
+ Else If Digits > 15 Then Digits := 15;
+ Str(Value:0:Digits, Result);
+ If Result[1] = ' ' Then System.Delete(Result, 1, 1);
+ P := Pos('.', Result);
+ If P <> 0 Then
+ Result[P] := DecimalSeparator
+ else
+ P := Length(Result)+1;
+ Dec(P, 3);
+ While (P > 1) Do
+ Begin
+ If Result[P - 1] <> '-' Then Insert(ThousandSeparator, Result, P);
+ Dec(P, 3);
+ End;
+ End;
+
+ ffCurrency:
+
+ Begin
+ If Value < 0 Then
+ Begin
+ Negative := True;
+ Value := -Value;
+ End
+ Else Negative := False;
+
+ If Digits = -1 Then Digits := CurrencyDecimals
+ Else If Digits > 18 Then Digits := 18;
+ Str(Value:0:Digits, Result);
+ If Result[1] = ' ' Then System.Delete(Result, 1, 1);
+ P := Pos('.', Result);
+ If P <> 0 Then Result[P] := DecimalSeparator;
+ Dec(P, 3);
+ While (P > 1) Do
+ Begin
+ Insert(ThousandSeparator, Result, P);
+ Dec(P, 3);
+ End;
+
+ If Not Negative Then
+ Begin
+ Case CurrencyFormat Of
+ 0: Result := CurrencyString + Result;
+ 1: Result := Result + CurrencyString;
+ 2: Result := CurrencyString + ' ' + Result;
+ 3: Result := Result + ' ' + CurrencyString;
+ End
+ End
+ Else
+ Begin
+ Case NegCurrFormat Of
+ 0: Result := '(' + CurrencyString + Result + ')';
+ 1: Result := '-' + CurrencyString + Result;
+ 2: Result := CurrencyString + '-' + Result;
+ 3: Result := CurrencyString + Result + '-';
+ 4: Result := '(' + Result + CurrencyString + ')';
+ 5: Result := '-' + Result + CurrencyString;
+ 6: Result := Result + '-' + CurrencyString;
+ 7: Result := Result + CurrencyString + '-';
+ 8: Result := '-' + Result + ' ' + CurrencyString;
+ 9: Result := '-' + CurrencyString + ' ' + Result;
+ 10: Result := CurrencyString + ' ' + Result + '-';
+ End;
+ End;
+ End;
+ End;
+End;
+
+Function FloatToDateTime (Const Value : Extended) : TDateTime;
+begin
+ If (Value<MinDateTime) or (Value>MaxDateTime) then
+ Raise EConvertError.CreateFmt (SInvalidDateTime,[Value]);
+ Result:=Value;
+end;
+
+function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
+
+begin
+{$ifndef VER1_0}
+ Result:=(Value>=MinCurrency) and (Value<=MaxCurrency);
+ if Result then
+ AResult := Value;
+{$else VER1_0}
+ Result:=false;
+{$endif VER1_0}
+end;
+
+function FloatToCurr(const Value: Extended): Currency;
+
+begin
+ if not TryFloatToCurr(Value, Result) then
+ Raise EConvertError.CreateFmt(SInvalidCurrency, [FloatToStr(Value)]);
+end;
+
+
+Function CurrToStr(Value: Currency): string;
+begin
+ Result:=FloatToStrF(Value,ffNumber,15,2);
+end;
+
+function StrToCurr(const S: string): Currency;
+begin
+ if not TextToFloat(PChar(S), Result, fvCurrency) then
+ Raise EConvertError.createfmt(SInValidFLoat,[S]);
+end;
+
+
+Function TryStrToCurr(Const S : String; Var Value: Currency): Boolean;
+Begin
+ Result := TextToFloat(PChar(S), Value, fvCurrency);
+End;
+
+
+function StrToCurrDef(const S: string; Default : Currency): Currency;
+begin
+ if not TextToFloat(PChar(S), Result, fvCurrency) then
+ Result:=Default;
+end;
+
+function StrToBool(const S: string): Boolean;
+
+Var
+ Temp : String;
+ D : Double;
+{$IFDEF VIRTUALPASCAL}
+ Code: longint;
+{$ELSE}
+ Code: word;
+{$ENDIF}
+
+begin
+ Temp:=upcase(S);
+ Val(temp,D,code);
+ If Code=0 then
+ Result:=(D<>0.0)
+ else If Temp='TRUE' then
+ result:=true
+ else if Temp='FALSE' then
+ result:=false
+ else
+ Raise EConvertError.CreateFmt(SInvalidBoolean,[S]);
+end;
+
+function BoolToStr(B: Boolean): string;
+begin
+ If B then
+ Result:='TRUE'
+ else
+ Result:='FALSE';
+end;
+
+Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
+
+Var
+ Digits: String[40]; { String Of Digits }
+ Exponent: String[8]; { Exponent strin }
+ FmtStart, FmtStop: PChar; { Start And End Of relevant part }
+ { Of format String }
+ ExpFmt, ExpSize: Integer; { Type And Length Of }
+ { exponential format chosen }
+ Placehold: Array[1..4] Of Integer; { Number Of placeholders In All }
+ { four Sections }
+ thousand: Boolean; { thousand separators? }
+ UnexpectedDigits: Integer; { Number Of unexpected Digits that }
+ { have To be inserted before the }
+ { First placeholder. }
+ DigitExponent: Integer; { Exponent Of First digit In }
+ { Digits Array. }
+
+ { Find end of format section starting at P. False, if empty }
+
+ Function GetSectionEnd(Var P: PChar): Boolean;
+ Var
+ C: Char;
+ SQ, DQ: Boolean;
+ Begin
+ Result := False;
+ SQ := False;
+ DQ := False;
+ C := P[0];
+ While (C<>#0) And ((C<>';') Or SQ Or DQ) Do
+ Begin
+ Result := True;
+ Case C Of
+ #34: If Not SQ Then DQ := Not DQ;
+ #39: If Not DQ Then SQ := Not SQ;
+ End;
+ Inc(P);
+ C := P[0];
+ End;
+ End;
+
+ { Find start and end of format section to apply. If section doesn't exist,
+ use section 1. If section 2 is used, the sign of value is ignored. }
+
+ Procedure GetSectionRange(section: Integer);
+ Var
+ Sec: Array[1..3] Of PChar;
+ SecOk: Array[1..3] Of Boolean;
+ Begin
+ Sec[1] := format;
+ SecOk[1] := GetSectionEnd(Sec[1]);
+ If section > 1 Then
+ Begin
+ Sec[2] := Sec[1];
+ If Sec[2][0] <> #0 Then
+ Inc(Sec[2]);
+ SecOk[2] := GetSectionEnd(Sec[2]);
+ If section > 2 Then
+ Begin
+ Sec[3] := Sec[2];
+ If Sec[3][0] <> #0 Then
+ Inc(Sec[3]);
+ SecOk[3] := GetSectionEnd(Sec[3]);
+ End;
+ End;
+ If Not SecOk[1] Then
+ FmtStart := Nil
+ Else
+ Begin
+ If Not SecOk[section] Then
+ section := 1
+ Else If section = 2 Then
+ Value := -Value; { Remove sign }
+ If section = 1 Then FmtStart := format Else
+ Begin
+ FmtStart := Sec[section - 1];
+ Inc(FmtStart);
+ End;
+ FmtStop := Sec[section];
+ End;
+ End;
+
+ { Find format section ranging from FmtStart to FmtStop. }
+
+ Procedure GetFormatOptions;
+ Var
+ Fmt: PChar;
+ SQ, DQ: Boolean;
+ area: Integer;
+ Begin
+ SQ := False;
+ DQ := False;
+ Fmt := FmtStart;
+ ExpFmt := 0;
+ area := 1;
+ thousand := False;
+ Placehold[1] := 0;
+ Placehold[2] := 0;
+ Placehold[3] := 0;
+ Placehold[4] := 0;
+ While Fmt < FmtStop Do
+ Begin
+ Case Fmt[0] Of
+ #34:
+ Begin
+ If Not SQ Then
+ DQ := Not DQ;
+ Inc(Fmt);
+ End;
+ #39:
+ Begin
+ If Not DQ Then
+ SQ := Not SQ;
+ Inc(Fmt);
+ End;
+ Else
+ { This was 'if not SQ or DQ'. Looked wrong... }
+ If Not SQ Or DQ Then
+ Begin
+ Case Fmt[0] Of
+ '0':
+ Begin
+ Case area Of
+ 1:
+ area := 2;
+ 4:
+ Begin
+ area := 3;
+ Inc(Placehold[3], Placehold[4]);
+ Placehold[4] := 0;
+ End;
+ End;
+ Inc(Placehold[area]);
+ Inc(Fmt);
+ End;
+
+ '#':
+ Begin
+ If area=3 Then
+ area:=4;
+ Inc(Placehold[area]);
+ Inc(Fmt);
+ End;
+ '.':
+ Begin
+ If area<3 Then
+ area:=3;
+ Inc(Fmt);
+ End;
+ ',':
+ Begin
+ thousand := True;
+ Inc(Fmt);
+ End;
+ 'e', 'E':
+ If ExpFmt = 0 Then
+ Begin
+ If (Fmt[0]='E') Then
+ ExpFmt:=1
+ Else
+ ExpFmt := 3;
+ Inc(Fmt);
+ If (Fmt<FmtStop) Then
+ Begin
+ Case Fmt[0] Of
+ '+':
+ Begin
+ End;
+ '-':
+ Inc(ExpFmt);
+ Else
+ ExpFmt := 0;
+ End;
+ If ExpFmt <> 0 Then
+ Begin
+ Inc(Fmt);
+ ExpSize := 0;
+ While (Fmt<FmtStop) And
+ (ExpSize<4) And
+ (Fmt[0] In ['0'..'9']) Do
+ Begin
+ Inc(ExpSize);
+ Inc(Fmt);
+ End;
+ End;
+ End;
+ End
+ Else
+ Inc(Fmt);
+ Else { Case }
+ Inc(Fmt);
+ End; { Case }
+ End; { Begin }
+ End; { Case }
+ End; { While .. Begin }
+ End;
+
+ Procedure FloatToStr;
+
+ Var
+ I, J, Exp, Width, Decimals, DecimalPoint, len: Integer;
+
+ Begin
+ If ExpFmt = 0 Then
+ Begin
+ { Fixpoint }
+ Decimals:=Placehold[3]+Placehold[4];
+ Width:=Placehold[1]+Placehold[2]+Decimals;
+ If (Decimals=0) Then
+ Str(Value:Width:0,Digits)
+ Else
+ Str(Value:Width+1:Decimals,Digits);
+ len:=Length(Digits);
+ { Find the decimal point }
+ If (Decimals=0) Then
+ DecimalPoint:=len+1
+ Else
+ DecimalPoint:=len-Decimals;
+ { If value is very small, and no decimal places
+ are desired, remove the leading 0. }
+ If (Abs(Value) < 1) And (Placehold[2] = 0) Then
+ Begin
+ If (Placehold[1]=0) Then
+ Delete(Digits,DecimalPoint-1,1)
+ Else
+ Digits[DecimalPoint-1]:=' ';
+ End;
+
+ { Convert optional zeroes to spaces. }
+ I:=len;
+ J:=DecimalPoint+Placehold[3];
+ While (I>J) And (Digits[I]='0') Do
+ Begin
+ Digits[I] := ' ';
+ Dec(I);
+ End;
+ { If integer value and no obligatory decimal
+ places, remove decimal point. }
+ If (DecimalPoint < len) And (Digits[DecimalPoint + 1] = ' ') Then
+ Digits[DecimalPoint] := ' ';
+ { Convert spaces left from obligatory decimal point to zeroes. }
+ I:=DecimalPoint-Placehold[2];
+ While (I<DecimalPoint) And (Digits[I]=' ') Do
+ Begin
+ Digits[I] := '0';
+ Inc(I);
+ End;
+ Exp := 0;
+ End
+ Else
+ Begin
+ { Scientific: exactly <Width> Digits With <Precision> Decimals
+ And adjusted Exponent. }
+ If Placehold[1]+Placehold[2]=0 Then
+ Placehold[1]:=1;
+ Decimals := Placehold[3] + Placehold[4];
+ Width:=Placehold[1]+Placehold[2]+Decimals;
+ Str(Value:Width+8,Digits);
+ { Find and cut out exponent. Always the
+ last 6 characters in the string.
+ -> 0000E+0000 }
+ I:=Length(Digits)-5;
+ Val(Copy(Digits,I+1,5),Exp,J);
+ Exp:=Exp+1-(Placehold[1]+Placehold[2]);
+ Delete(Digits, I, 6);
+ { Str() always returns at least one digit after the decimal point.
+ If we don't want it, we have to remove it. }
+ If (Decimals=0) And (Placehold[1]+Placehold[2]<= 1) Then
+ Begin
+ If (Digits[4]>='5') Then
+ Begin
+ Inc(Digits[2]);
+ If (Digits[2]>'9') Then
+ Begin
+ Digits[2] := '1';
+ Inc(Exp);
+ End;
+ End;
+ Delete(Digits, 3, 2);
+ DecimalPoint := Length(Digits) + 1;
+ End
+ Else
+ Begin
+ { Move decimal point at the desired position }
+ Delete(Digits, 3, 1);
+ DecimalPoint:=2+Placehold[1]+Placehold[2];
+ If (Decimals<>0) Then
+ Insert('.',Digits,DecimalPoint);
+ End;
+
+ { Convert optional zeroes to spaces. }
+ I := Length(Digits);
+ J := DecimalPoint + Placehold[3];
+ While (I > J) And (Digits[I] = '0') Do
+ Begin
+ Digits[I] := ' ';
+ Dec(I);
+ End;
+
+ { If integer number and no obligatory decimal paces, remove decimal point }
+
+ If (DecimalPoint<Length(Digits)) And
+ (Digits[DecimalPoint+1]=' ') Then
+ Digits[DecimalPoint]:=' ';
+ If (Digits[1]=' ') Then
+ Begin
+ Delete(Digits, 1, 1);
+ Dec(DecimalPoint);
+ End;
+ { Calculate exponent string }
+ Str(Abs(Exp), Exponent);
+ While Length(Exponent)<ExpSize Do
+ Insert('0',Exponent,1);
+ If Exp >= 0 Then
+ Begin
+ If (ExpFmt In [1,3]) Then
+ Insert('+', Exponent, 1);
+ End
+ Else
+ Insert('-',Exponent,1);
+ If (ExpFmt<3) Then
+ Insert('E',Exponent,1)
+ Else
+ Insert('e',Exponent,1);
+ End;
+ DigitExponent:=DecimalPoint-2;
+ If (Digits[1]='-') Then
+ Dec(DigitExponent);
+ UnexpectedDigits:=DecimalPoint-1-(Placehold[1]+Placehold[2]);
+ End;
+
+ Function PutResult: LongInt;
+
+ Var
+ SQ, DQ: Boolean;
+ Fmt, Buf: PChar;
+ Dig, N: Integer;
+
+ Begin
+ SQ := False;
+ DQ := False;
+ Fmt := FmtStart;
+ Buf := Buffer;
+ Dig := 1;
+ While (Fmt<FmtStop) Do
+ Begin
+ //Write(Fmt[0]);
+ Case Fmt[0] Of
+ #34:
+ Begin
+ If Not SQ Then
+ DQ := Not DQ;
+ Inc(Fmt);
+ End;
+ #39:
+ Begin
+ If Not DQ Then
+ SQ := Not SQ;
+ Inc(Fmt);
+ End;
+ Else
+ If Not (SQ Or DQ) Then
+ Begin
+ Case Fmt[0] Of
+ '0', '#', '.':
+ Begin
+ If (Dig=1) And (UnexpectedDigits>0) Then
+ Begin
+ { Everything unexpected is written before the first digit }
+ For N := 1 To UnexpectedDigits Do
+ Begin
+ Buf[0] := Digits[N];
+ Inc(Buf);
+ If thousand And (Digits[N]<>'-') Then
+ Begin
+ If (DigitExponent Mod 3 = 0) And (DigitExponent>0) Then
+ Begin
+ Buf[0] := ThousandSeparator;
+ Inc(Buf);
+ End;
+ Dec(DigitExponent);
+ End;
+ End;
+ Inc(Dig, UnexpectedDigits);
+ End;
+ If (Digits[Dig]<>' ') Then
+ Begin
+ If (Digits[Dig]='.') Then
+ Buf[0] := DecimalSeparator
+ Else
+ Buf[0] := Digits[Dig];
+ Inc(Buf);
+ If thousand And (DigitExponent Mod 3 = 0) And (DigitExponent > 0) Then
+ Begin
+ Buf[0] := ThousandSeparator;
+ Inc(Buf);
+ End;
+ End;
+ Inc(Dig);
+ Dec(DigitExponent);
+ Inc(Fmt);
+ End;
+ 'e', 'E':
+ Begin
+ If ExpFmt <> 0 Then
+ Begin
+ Inc(Fmt);
+ If Fmt < FmtStop Then
+ Begin
+ If Fmt[0] In ['+', '-'] Then
+ Begin
+ Inc(Fmt, ExpSize);
+ For N:=1 To Length(Exponent) Do
+ Buf[N-1] := Exponent[N];
+ Inc(Buf,Length(Exponent));
+ ExpFmt:=0;
+ End;
+ Inc(Fmt);
+ End;
+ End
+ Else
+ Begin
+ { No legal exponential format.
+ Simply write the 'E' to the result. }
+ Buf[0] := Fmt[0];
+ Inc(Buf);
+ Inc(Fmt);
+ End;
+ End;
+ Else { Case }
+ { Usual character }
+ If (Fmt[0]<>',') Then
+ Begin
+ Buf[0] := Fmt[0];
+ Inc(Buf);
+ End;
+ Inc(Fmt);
+ End; { Case }
+ End
+ Else { IF }
+ Begin
+ { Character inside single or double quotes }
+ Buf[0] := Fmt[0];
+ Inc(Buf);
+ Inc(Fmt);
+ End;
+ End; { Case }
+ End; { While .. Begin }
+ Result:=PtrInt(Buf)-PtrInt(Buffer);
+ End;
+
+Begin
+ If (Value>0) Then
+ GetSectionRange(1)
+ Else If (Value<0) Then
+ GetSectionRange(2)
+ Else
+ GetSectionRange(3);
+ If FmtStart = Nil Then
+ Begin
+ Result := FloatToText(Buffer, Value, ffGeneral, 15, 4);
+ End
+ Else
+ Begin
+ GetFormatOptions;
+ If (ExpFmt = 0) And (Abs(Value) >= 1E18) Then
+ Result := FloatToText(Buffer, Value, ffGeneral, 15, 4)
+ Else
+ Begin
+ FloatToStr;
+ Result := PutResult;
+ End;
+ End;
+End;
+
+
+
+Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
+
+Var
+ Buffer: String[24];
+ Error, N: Integer;
+
+Begin
+ Str(Value:23, Buffer);
+ Result.Negative := (Buffer[1] = '-');
+ Val(Copy(Buffer, 19, 5), Result.Exponent, Error);
+ Inc(Result. Exponent);
+ Result.Digits[0] := Buffer[2];
+ Move(Buffer[4], Result.Digits[1], 14);
+ If Decimals + Result.Exponent < Precision Then
+ N := Decimals + Result.Exponent
+ Else
+ N := Precision;
+ If N > 15 Then
+ N := 15;
+ If N = 0 Then
+ Begin
+ If Result.Digits[0] >= '5' Then
+ Begin
+ Result.Digits[0] := '1';
+ Result.Digits[1] := #0;
+ Inc(Result.Exponent);
+ End
+ Else
+ Result.Digits[0] := #0;
+ End
+ Else If N > 0 Then
+ Begin
+ If Result.Digits[N] >= '5' Then
+ Begin
+ Repeat
+ Result.Digits[N] := #0;
+ Dec(N);
+ Inc(Result.Digits[N]);
+ Until (N = 0) Or (Result.Digits[N] < ':');
+ If Result.Digits[0] = ':' Then
+ Begin
+ Result.Digits[0] := '1';
+ Inc(Result.Exponent);
+ End;
+ End
+ Else
+ Begin
+ Result.Digits[N] := '0';
+ While (Result.Digits[N] = '0') And (N > -1) Do
+ Begin
+ Result.Digits[N] := #0;
+ Dec(N);
+ End;
+ End;
+ End
+ Else
+ Result.Digits[0] := #0;
+ If Result.Digits[0] = #0 Then
+ Begin
+ Result.Exponent := 0;
+ Result.Negative := False;
+ End;
+End;
+
+Function FormatFloat(Const format: String; Value: Extended): String;
+
+Var
+ buf : Array[0..1024] of char;
+
+Begin
+ Buf[FloatToTextFmt(@Buf[0],Value,Pchar(Format))]:=#0;
+ Result:=StrPas(@Buf);
+End;
+
+function FormatCurr(const Format: string; Value: Currency): string;
+begin
+ Result := FormatFloat(Format, Value);
+end;
+
+
+{==============================================================================}
+{ extra functions }
+{==============================================================================}
+
+{ LeftStr returns Count left-most characters from S }
+
+function LeftStr(const S: string; Count: integer): string;
+begin
+ result := Copy(S, 1, Count);
+end ;
+
+{ RightStr returns Count right-most characters from S }
+
+function RightStr(const S: string; Count: integer): string;
+begin
+ If Count>Length(S) then
+ Count:=Length(S);
+ result := Copy(S, 1 + Length(S) - Count, Count);
+end;
+
+{ BCDToInt converts the BCD value Value to an integer }
+
+function BCDToInt(Value: integer): integer;
+var i, j: integer;
+begin
+result := 0;
+j := 1;
+for i := 0 to SizeOf(Value) shr 1 - 1 do begin
+ result := result + j * (Value and 15);
+ j := j * 10;
+ Value := Value shr 4;
+ end ;
+end ;
+
+Function LastDelimiter(const Delimiters, S: string): Integer;
+
+begin
+ Result:=Length(S);
+ While (Result>0) and (Pos(S[Result],Delimiters)=0) do
+ Dec(Result);
+end;
+
+Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
+
+var
+ Srch,OldP,RemS: string; // Srch and Oldp can contain uppercase versions of S,OldPattern
+ P : Integer;
+
+begin
+ Srch:=S;
+ OldP:=OldPattern;
+ if rfIgnoreCase in Flags then
+ begin
+ Srch:=UpperCase(Srch);
+ OldP:=UpperCase(OldP);
+ end;
+ RemS:=S;
+ Result:='';
+ while (Length(Srch)<>0) do
+ begin
+ P:=Pos(OldP, Srch);
+ if P=0 then
+ begin
+ Result:=Result+RemS;
+ Srch:='';
+ end
+ else
+ begin
+ Result:=Result+Copy(RemS,1,P-1)+NewPattern;
+ P:=P+Length(OldP);
+ RemS:=Copy(RemS,P,Length(RemS)-P+1);
+ if not (rfReplaceAll in Flags) then
+ begin
+ Result:=Result+RemS;
+ Srch:='';
+ end
+ else
+ Srch:=Copy(Srch,P,Length(Srch)-P+1);
+ end;
+ end;
+end;
+
+Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
+
+begin
+ Result:=False;
+ If (Index>0) and (Index<=Length(S)) then
+ Result:=Pos(S[Index],Delimiters)<>0; // Note we don't do MBCS yet
+end;
+
+Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
+
+begin
+ Result:=Length(S);
+ If Result>MaxLen then
+ Result:=MaxLen;
+end;
+
+Function ByteToCharIndex(const S: string; Index: Integer): Integer;
+
+begin
+ Result:=Index;
+end;
+
+
+Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
+
+begin
+ Result:=Length(S);
+ If Result>MaxLen then
+ Result:=MaxLen;
+end;
+
+Function CharToByteIndex(const S: string; Index: Integer): Integer;
+
+begin
+ Result:=Index;
+end;
+
+Function ByteType(const S: string; Index: Integer): TMbcsByteType;
+
+begin
+ Result:=mbSingleByte;
+end;
+
+Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
+
+begin
+ Result:=mbSingleByte;
+end;
+
+
+Function StrCharLength(const Str: PChar): Integer;
+begin
+{$ifdef HASWIDESTRING}
+ result:=widestringmanager.CharLengthPCharProc(Str);
+{$endif HASWIDESTRING}
+end;
+
+
+Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
+
+Var
+ I,L : Integer;
+ S,T : String;
+
+begin
+ Result:=False;
+ S:=Switch;
+ If IgnoreCase then
+ S:=UpperCase(S);
+ I:=ParamCount;
+ While (Not Result) and (I>0) do
+ begin
+ L:=Length(Paramstr(I));
+ If (L>0) and (ParamStr(I)[1] in Chars) then
+ begin
+ T:=Copy(ParamStr(I),2,L-1);
+ If IgnoreCase then
+ T:=UpperCase(T);
+ Result:=S=T;
+ end;
+ Dec(i);
+ end;
+end;
+
+Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
+
+begin
+ Result:=FindCmdLineSwitch(Switch,SwitchChars,IgnoreCase);
+end;
+
+Function FindCmdLineSwitch(const Switch: string): Boolean;
+
+begin
+ Result:=FindCmdLineSwitch(Switch,SwitchChars,False);
+end;
+
+function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet; MaxCol: Integer): string;
+
+const
+ Quotes = ['''', '"'];
+
+Var
+ L : String;
+ C,LQ,BC : Char;
+ P,BLen,Len : Integer;
+ HB,IBC : Boolean;
+
+begin
+ Result:='';
+ L:=Line;
+ Blen:=Length(BreakStr);
+ If (BLen>0) then
+ BC:=BreakStr[1]
+ else
+ BC:=#0;
+ Len:=Length(L);
+ While (Len>0) do
+ begin
+ P:=1;
+ LQ:=#0;
+ HB:=False;
+ IBC:=False;
+ While ((P<=Len) and ((P<=MaxCol) or not IBC)) and ((LQ<>#0) or Not HB) do
+ begin
+ C:=L[P];
+ If (C=LQ) then
+ LQ:=#0
+ else If (C in Quotes) then
+ LQ:=C;
+ If (LQ<>#0) then
+ Inc(P)
+ else
+ begin
+ HB:=((C=BC) and (BreakStr=Copy(L,P,BLen)));
+ If HB then
+ Inc(P,Blen)
+ else
+ begin
+ If (P>MaxCol) then
+ IBC:=C in BreakChars;
+ Inc(P);
+ end;
+ end;
+// Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol);
+ end;
+ Result:=Result+Copy(L,1,P-1);
+ If Not HB then
+ Result:=Result+BreakStr;
+ Delete(L,1,P-1);
+ Len:=Length(L);
+ end;
+end;
+
+function WrapText(const Line: string; MaxCol: Integer): string;
+begin
+ Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol);
+end;
+
+
+{
+ Case Translation Tables
+ Can be used in internationalization support.
+
+ Although these tables can be obtained through system calls
+ it is better to not use those, since most implementation are not 100%
+ WARNING:
+ before modifying a translation table make sure that the current codepage
+ of the OS corresponds to the one you make changes to
+}
+
+
+
+const
+ { upper case translation table for character set 850 }
+ CP850UCT: array[128..255] of char =
+ ('€', 'š', '', '¶', 'Ž', '¶', '', '€', 'Ò', 'Ó', 'Ô', 'Ø', '×', 'Þ', 'Ž', '',
+ '', '’', '’', 'â', '™', 'ã', 'ê', 'ë', 'Y', '™', 'š', '', 'œ', '', 'ž', 'Ÿ',
+ 'µ', 'Ö', 'à', 'é', '¥', '¥', '¦', '§', '¨', '©', 'ª', '«', '¬', '­', '®', '¯',
+ '°', '±', '²', '³', '´', 'µ', '¶', '·', '¸', '¹', 'º', '»', '¼', '½', '¾', '¿',
+ 'À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Ç', 'Ç', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï',
+ 'Ð', 'Ñ', 'Ò', 'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', 'Þ', 'ß',
+ 'à', 'á', 'â', 'ã', 'å', 'å', 'æ', 'í', 'è', 'é', 'ê', 'ë', 'í', 'í', 'î', 'ï',
+ 'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');
+
+ { lower case translation table for character set 850 }
+ CP850LCT: array[128..255] of char =
+ ('‡', '', '‚', 'ƒ', '„', '…', '†', '‡', 'ˆ', '‰', 'Š', '‹', 'Œ', '', '„', '†',
+ '‚', '‘', '‘', '“', '”', '•', '–', '—', '˜', '”', '', '›', 'œ', '›', 'ž', 'Ÿ',
+ ' ', '¡', '¢', '£', '¤', '¤', '¦', '§', '¨', '©', 'ª', '«', '¬', '­', '®', '¯',
+ '°', '±', '²', '³', '´', ' ', 'ƒ', '…', '¸', '¹', 'º', '»', '¼', '½', '¾', '¿',
+ 'À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Æ', 'Æ', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï',
+ 'Ð', 'Ñ', 'ˆ', '‰', 'Š', 'Õ', '¡', 'Œ', '‹', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', '', 'ß',
+ '¢', 'á', '“', '•', 'ä', 'ä', 'æ', 'í', 'è', '£', '–', '—', 'ì', 'ì', 'î', 'ï',
+ 'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');
+
+ { upper case translation table for character set ISO 8859/1 Latin 1 }
+ CPISO88591UCT: array[192..255] of char =
+ ( #192, #193, #194, #195, #196, #197, #198, #199,
+ #200, #201, #202, #203, #204, #205, #206, #207,
+ #208, #209, #210, #211, #212, #213, #214, #215,
+ #216, #217, #218, #219, #220, #221, #222, #223,
+ #192, #193, #194, #195, #196, #197, #198, #199,
+ #200, #201, #202, #203, #204, #205, #206, #207,
+ #208, #209, #210, #211, #212, #213, #214, #247,
+ #216, #217, #218, #219, #220, #221, #222, #89 );
+
+ { lower case translation table for character set ISO 8859/1 Latin 1 }
+ CPISO88591LCT: array[192..255] of char =
+ ( #224, #225, #226, #227, #228, #229, #230, #231,
+ #232, #233, #234, #235, #236, #237, #238, #239,
+ #240, #241, #242, #243, #244, #245, #246, #215,
+ #248, #249, #250, #251, #252, #253, #254, #223,
+ #224, #225, #226, #227, #228, #229, #230, #231,
+ #232, #233, #234, #235, #236, #237, #238, #239,
+ #240, #241, #242, #243, #244, #245, #246, #247,
+ #248, #249, #250, #251, #252, #253, #254, #255 );
+
+{
+ $Log: sysstr.inc,v $
+ Revision 1.38 2005/05/09 18:35:06 michael
+ + Fixed bug 3957
+
+ Revision 1.37 2005/04/28 09:15:44 florian
+ + variants: string -> float/int casts
+
+ Revision 1.36 2005/04/26 16:40:51 michael
+ + Added FormatCurr by Uberto Barbini
+
+ Revision 1.35 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.34 2005/03/13 14:30:24 marco
+ * some 1.0.x fixes
+
+ Revision 1.33 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.32 2005/03/01 19:23:03 jonas
+ * fixed newstr() and disposestr()
+
+ Revision 1.31 2005/02/28 11:12:17 jonas
+ * fixed web bug 3708
+
+ Revision 1.30 2005/02/26 10:21:17 florian
+ + implemented WideFormat
+ + some Widestring stuff implemented
+ * some Widestring stuff fixed
+
+ Revision 1.29 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.28 2005/02/07 08:29:00 michael
+ + Patch from peter to fix 1.0 compile
+
+ Revision 1.27 2005/02/06 09:38:45 florian
+ + StrCharLength infrastructure
+
+ Revision 1.26 2005/01/17 18:38:48 peter
+ * extended overload disabled for powerpc
+
+ Revision 1.25 2005/01/16 17:53:27 michael
+ + Patch from Colin Western to implemenet TryStrToFLoat
+
+}
diff --git a/rtl/objpas/sysutils/sysstrh.inc b/rtl/objpas/sysutils/sysstrh.inc
new file mode 100644
index 0000000000..1b775bce69
--- /dev/null
+++ b/rtl/objpas/sysutils/sysstrh.inc
@@ -0,0 +1,229 @@
+{
+ *********************************************************************
+ $Id: sysstrh.inc,v 1.18 2005/04/28 09:15:44 florian Exp $
+ Copyright (C) 1997, 1998 Gertjan Schouten
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+{==============================================================================}
+{ standard functions }
+{==============================================================================}
+
+type
+ PString = ^String;
+
+ { For FloatToText }
+ TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
+ TFloatValue = (fvExtended, fvCurrency, fvSingle, fvReal, fvDouble, fvComp);
+ TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
+
+ TFloatRec = Record
+ Exponent: Integer;
+ Negative: Boolean;
+ Digits: Array[0..18] Of Char;
+ End;
+
+const
+ { For floattodatetime }
+ MinDateTime: TDateTime = -657434.0; { 01/01/0100 12:00:00.000 AM }
+ MaxDateTime: TDateTime = 2958465.99999; { 12/31/9999 11:59:59.999 PM }
+
+{$ifndef VER1_0}
+{$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}
+ MinCurrency: Currency = -922337203685477.5807;
+ MaxCurrency: Currency = 922337203685477.5807;
+{$else}
+ MinCurrency: Currency = -922337203685477.0000;
+ MaxCurrency: Currency = 922337203685477.0000;
+{$endif}
+{$endif VER1_0}
+
+Type
+ TTextLineBreakStyle = (tlbsLF, tlbsCRLF,tlbsCR); // Must move to system unit, and add Mac tlbsCR too ?
+
+Const
+ DefaultTextLineBreakStyle: TTextLineBreakStyle =
+ {$ifdef unix} tlbsLF {$else} {$ifdef macos} tlbsCR {$else} tlbsCRLF {$endif} {$endif} ;
+
+
+Const
+ LeadBytes: set of Char = [];
+ EmptyStr : string = '';
+ NullStr : PString = @EmptyStr;
+
+{$IFDEF VIRTUALPASCAL}
+ EmptyWideStr : AnsiString = '';
+ NullWideStr : PString = @EmptyWideStr;
+{$ELSE}
+ EmptyWideStr : WideString = '';
+// NullWideStr : PWideString = @EmptyWideStr;
+{$ENDIF}
+
+function NewStr(const S: string): PString;
+procedure DisposeStr(S: PString);
+procedure AssignStr(var P: PString; const S: string);
+procedure AppendStr(var Dest: String; const S: string);
+function UpperCase(const s: string): string;
+function LowerCase(const s: string): string; overload;
+function CompareStr(const S1, S2: string): Integer;
+function CompareMemRange(P1, P2: Pointer; Length: cardinal): integer;
+function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
+function CompareText(const S1, S2: string): integer;
+function SameText(const s1,s2:String):Boolean;
+
+function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiSameText(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiSameStr(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function AnsiLastChar(const S: string): PChar;
+function AnsiStrLastChar(Str: PChar): PChar;
+
+function Trim(const S: string): string;
+function TrimLeft(const S: string): string;
+function TrimRight(const S: string): string;
+function QuotedStr(const S: string): string;
+function AnsiQuotedStr(const S: string; Quote: char): string;
+function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
+function AdjustLineBreaks(const S: string): string;
+function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
+function IsValidIdent(const Ident: string): boolean;
+function IntToStr(Value: integer): string;
+{$IFNDEF VIRTUALPASCAL}
+function IntToStr(Value: Int64): string;
+{$ENDIF}
+function IntToStr(Value: QWord): string;
+function IntToHex(Value: integer; Digits: integer): string;
+function IntToHex(Value: Int64; Digits: integer): string;
+function StrToInt(const s: string): integer;
+function TryStrToInt(const s: string; var i : integer) : boolean;
+{$IFNDEF VIRTUALPASCAL}
+function StrToInt64(const s: string): int64;
+function TryStrToInt64(const s: string; var i : int64) : boolean;
+{$ENDIF}
+function StrToIntDef(const S: string; Default: integer): integer;
+{$IFNDEF VIRTUALPASCAL}
+function StrToInt64Def(const S: string; Default: int64): int64;
+{$ENDIF}
+function LoadStr(Ident: integer): string;
+// function FmtLoadStr(Ident: integer; const Args: array of const): string;
+Function Format (Const Fmt : String; const Args : Array of const) : String;
+Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
+Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
+Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
+Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
+Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
+Function FloatToStr(Value: Extended): String;
+Function StrToFloat(Const S : String) : Extended;
+Function StrToFloatDef(Const S: String; Const Default: Extended): Extended;
+Function TryStrToFloat(Const S : String; Var Value: Single): Boolean;
+Function TryStrToFloat(Const S : String; Var Value: Double): Boolean;
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+Function TryStrToFloat(Const S : String; Var Value: Extended): Boolean;
+{$endif FPC_HAS_TYPE_EXTENDED}
+Function TextToFloat(Buffer: PChar; Var Value: Extended): Boolean;
+Function TextToFloat(Buffer: PChar; Var Value; ValueType: TFloatValue): Boolean;
+Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
+Function FloatToDateTime (Const Value : Extended) : TDateTime;
+Function FloattoCurr (Const Value : Extended) : Currency;
+function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
+Function CurrToStr(Value: Currency): string;
+function StrToCurr(const S: string): Currency;
+function TryStrToCurr(const S: string;Var Value : Currency): Boolean;
+function StrToCurrDef(const S: string; Default : Currency): Currency;
+function StrToBool(const S: string): Boolean;
+function BoolToStr(B: Boolean): string;
+function LastDelimiter(const Delimiters, S: string): Integer;
+function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
+Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
+Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
+Function FormatFloat(Const Format : String; Value : Extended) : String;
+Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
+function FormatCurr(const Format: string; Value: Currency): string;
+
+{// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
+Type
+ TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
+
+Function ByteType(const S: string; Index: Integer): TMbcsByteType;
+Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
+Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
+Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
+Function ByteToCharIndex(const S: string; Index: Integer): Integer;
+Function StrCharLength(const Str: PChar): Integer;
+
+
+const
+{$ifndef unix}
+ SwitchChars = ['/','-'];
+{$else}
+ SwitchChars = ['-'];
+{$endif}
+
+Type
+ TSysCharSet = Set of char;
+
+Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
+Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
+Function FindCmdLineSwitch(const Switch: string): Boolean;
+
+function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet; MaxCol: Integer): string;
+function WrapText(const Line: string; MaxCol: Integer): string;
+
+
+{==============================================================================}
+{ extra functions }
+{==============================================================================}
+
+function LeftStr(const S: string; Count: integer): string;
+function RightStr(const S: string; Count: integer): string;
+function BCDToInt(Value: integer): integer;
+
+{
+ $Log: sysstrh.inc,v $
+ Revision 1.18 2005/04/28 09:15:44 florian
+ + variants: string -> float/int casts
+
+ Revision 1.17 2005/04/26 16:40:51 michael
+ + Added FormatCurr by Uberto Barbini
+
+ Revision 1.16 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.15 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.14 2005/02/06 09:38:45 florian
+ + StrCharLength infrastructure
+
+ Revision 1.13 2005/01/17 18:38:48 peter
+ * extended overload disabled for powerpc
+
+ Revision 1.12 2005/01/16 17:53:27 michael
+ + Patch from Colin Western to implemenet TryStrToFLoat
+
+}
diff --git a/rtl/objpas/sysutils/systhrdh.inc b/rtl/objpas/sysutils/systhrdh.inc
new file mode 100644
index 0000000000..ead4a2cba1
--- /dev/null
+++ b/rtl/objpas/sysutils/systhrdh.inc
@@ -0,0 +1,41 @@
+{
+ $Id: systhrdh.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef HASINTF}
+
+type
+ IReadWriteSync = interface
+ ['{7B108C52-1D8F-4CDB-9CDF-57E071193D3F}']
+ procedure BeginRead;
+ procedure EndRead;
+ function BeginWrite : boolean;
+ procedure EndWrite;
+ end;
+
+{$endif HASINTF}
+
+function InterLockedIncrement (var Target: longint) : longint;
+function InterLockedDecrement (var Target: longint) : longint;
+function InterLockedExchange (var Target: longint;Source : longint) : longint;
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
+
+{
+ $Log: systhrdh.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.3 2005/02/06 20:31:35 florian
+ + GlobalNameSpace
+
+}
diff --git a/rtl/objpas/sysutils/sysuintf.inc b/rtl/objpas/sysutils/sysuintf.inc
new file mode 100644
index 0000000000..0f3cb0887c
--- /dev/null
+++ b/rtl/objpas/sysutils/sysuintf.inc
@@ -0,0 +1,157 @@
+{
+ *********************************************************************
+ $Id: sysuintf.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ Copyright (C) 2002 Free Pascal Development Team
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+
+ System Utilities For Free Pascal
+}
+
+function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean;
+begin
+ Result:=(Instance<>nil) and
+ (Instance.QueryInterface(IID,Intf)=0);
+end;
+
+function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean;
+var
+ LUnknown: IUnknown;
+begin
+ Result:=(Instance<>nil) and
+ ((Instance.GetInterface(IUnknown,LUnknown) and
+ Supports(LUnknown,IID,Intf)) or
+ Instance.GetInterface(IID,Intf));
+end;
+
+function Supports(const Instance: IInterface; const IID: TGUID): Boolean;
+var
+ Temp: IInterface;
+begin
+ Result:=Supports(Instance,IID,Temp);
+end;
+
+function Supports(const Instance: TObject; const IID: TGUID): Boolean;
+var
+ Temp: IInterface;
+begin
+ Result:=Supports(Instance,IID,Temp);
+end;
+
+function Supports(const AClass: TClass; const IID: TGUID): Boolean;
+begin
+ Result:=AClass.GetInterfaceEntry(IID)<>nil;
+end;
+
+
+function StringToGUID(const S: string): TGUID;
+
+ function HexChar(c: Char): Byte;
+ begin
+ case c of
+ '0'..'9':
+ Result:=Byte(c) - Byte('0');
+ 'a'..'f':
+ Result:=(Byte(c) - Byte('a')) + 10;
+ 'A'..'F':
+ Result:=(Byte(c) - Byte('A')) + 10;
+ else
+ raise EConvertError.CreateFmt(SInvalidGUID, [s]);
+ Result:=0;
+ end;
+ end;
+
+ function HexByte(p: PChar): Char;
+ begin
+ Result:=Char((HexChar(p[0]) shl 4) + HexChar(p[1]));
+ end;
+
+var
+ i: integer;
+ src, dest: PChar;
+begin
+ if ((Length(S)<>38) or
+ (s[1]<>'{')) then
+ raise EConvertError.CreateFmt(SInvalidGUID, [s]);
+ dest:=@Result;
+ src:=PChar(s);
+ inc(src);
+ for i:=0 to 3 do
+ dest[i]:=HexByte(src+(3-i)*2);
+ inc(src, 8);
+ inc(dest, 4);
+ if src[0]<>'-' then
+ raise EConvertError.CreateFmt(SInvalidGUID, [s]);
+ inc(src);
+ for i:=0 to 1 do
+ begin
+ dest^:=HexByte(src+2);
+ inc(dest);
+ dest^:=HexByte(src);
+ inc(dest);
+ inc(src, 4);
+ if src[0]<>'-' then
+ raise EConvertError.CreateFmt(SInvalidGUID, [s]);
+ inc(src);
+ end;
+ dest^:=HexByte(src);
+ inc(dest);
+ inc(src, 2);
+ dest^:=HexByte(src);
+ inc(dest);
+ inc(src, 2);
+ if src[0]<>'-' then
+ raise EConvertError.CreateFmt(SInvalidGUID, [s]);
+ inc(src);
+ for i:=0 to 5 do
+ begin
+ dest^:=HexByte(src);
+ inc(dest);
+ inc(src, 2);
+ end;
+end;
+
+
+function IsEqualGUID(const guid1, guid2: TGUID): Boolean;
+var
+ a1,a2: PIntegerArray;
+begin
+ a1:=PIntegerArray(@guid1);
+ a2:=PIntegerArray(@guid2);
+ Result:=(a1^[0]=a2^[0]) and
+ (a1^[1]=a2^[1]) and
+ (a1^[2]=a2^[2]) and
+ (a1^[3]=a2^[3]);
+end;
+
+
+function GUIDToString(const GUID: TGUID): string;
+begin
+ SetLength(Result, 38);
+ StrLFmt(PChar(Result), 38,'{%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x}',
+ [
+ GUID.D1, GUID.D2, GUID.D3,
+ GUID.D4[0], GUID.D4[1], GUID.D4[2], GUID.D4[3],
+ GUID.D4[4], GUID.D4[5], GUID.D4[6], GUID.D4[7]
+ ]);
+end;
+
+{
+ $Log: sysuintf.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/sysutils/sysutilh.inc b/rtl/objpas/sysutils/sysutilh.inc
new file mode 100644
index 0000000000..b7daa20d54
--- /dev/null
+++ b/rtl/objpas/sysutils/sysutilh.inc
@@ -0,0 +1,257 @@
+{
+ $Id: sysutilh.inc,v 1.14 2005/03/12 14:56:22 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ Using inlining for small system functions/wrappers }
+{$ifdef HASINLINE}
+ {$inline on}
+ {$define SYSUTILSINLINE}
+{$endif}
+
+ { Read date & Time function declarations }
+ {$i osutilsh.inc}
+
+ {$i datih.inc}
+
+ { Read String Handling functions declaration }
+ {$i sysstrh.inc}
+
+type
+ { some helpful data types }
+
+{$IFDEF VER1_0}
+(* System type alias cannot be used under version *)
+(* 1.0 because of different names of System unit. *)
+ THandle = longint;
+{$ELSE VER1_0}
+ THandle = System.THandle;
+{$ENDIF VER1_0}
+
+ TProcedure = procedure;
+
+ TFilename = String;
+
+ TIntegerSet = Set of 0..SizeOf(Integer)*8-1;
+
+ LongRec = packed record
+ case Integer of
+ 0 : (Lo,Hi : Word);
+ 1 : (Bytes : Array[0..3] of Byte);
+ end;
+
+ WordRec = packed record
+ Lo,Hi : Byte;
+ end;
+
+ Int64Rec = packed record
+ case integer of
+ 0 : (Lo,Hi : Cardinal);
+ 1 : (Words : Array[0..3] of Word);
+ 2 : (Bytes : Array[0..7] of Byte);
+ end;
+
+ PByteArray = ^TByteArray;
+ TByteArray = Array[0..32767] of Byte;
+
+ PWordarray = ^TWordArray;
+ TWordArray = array[0..16383] of Word;
+
+ { exceptions }
+ Exception = class(TObject)
+ private
+ fmessage : string;
+ fhelpcontext : longint;
+ public
+ constructor Create(const msg : string);
+ constructor CreateFmt(const msg : string; const args : array of const);
+ constructor CreateRes(ResString: PString);
+ constructor CreateResFmt(ResString: PString; const Args: array of const);
+ constructor CreateHelp(const Msg: string; AHelpContext: Integer);
+ constructor CreateFmtHelp(const Msg: string; const Args: array of const;
+ AHelpContext: Integer);
+ constructor CreateResHelp(ResString: PString; AHelpContext: Integer);
+ constructor CreateResFmtHelp(ResString: PString; const Args: array of const;
+ AHelpContext: Integer);
+ { !!!! }
+ property HelpContext : longint read fhelpcontext write fhelpcontext;
+ property Message : string read fmessage write fmessage;
+ end;
+
+ ExceptClass = class of Exception;
+
+ EExternal = class(Exception)
+ public
+{$ifdef win32}
+ ExceptionRecord : PExceptionRecord;
+{$endif win32}
+ end;
+
+ { integer math exceptions }
+ EInterror = Class(EExternal);
+ EDivByZero = Class(EIntError);
+ ERangeError = Class(EIntError);
+ EIntOverflow = Class(EIntError);
+
+ { General math errors }
+ EMathError = Class(EExternal);
+ EInvalidOp = Class(EMathError);
+ EZeroDivide = Class(EMathError);
+ EOverflow = Class(EMathError);
+ EUnderflow = Class(EMathError);
+
+ { Run-time and I/O Errors }
+ EInOutError = class(Exception)
+ public
+ ErrorCode : Longint;
+ end;
+
+ EHeapMemoryError = class(Exception)
+ protected
+ AllowFree : boolean;
+ procedure FreeInstance;override;
+ end;
+
+ EHeapException = EHeapMemoryError;
+
+ EExternalException = class(EExternal);
+ EInvalidPointer = Class(EHeapMemoryError);
+ EOutOfMemory = Class(EHeapMemoryError);
+ EInvalidCast = Class(Exception);
+ EVariantError = Class(Exception);
+
+ EAccessViolation = Class(EExternal);
+ EPrivilege = class(EExternal);
+ EStackOverflow = class(EExternal);
+ EControlC = class(EExternal);
+
+ { String conversion errors }
+ EConvertError = class(Exception);
+
+ { Other errors }
+ EAbort = Class(Exception);
+ EAbstractError = Class(Exception);
+ EAssertionFailed = Class(Exception);
+
+ EPropReadOnly = class(Exception);
+ EPropWriteOnly = class(Exception);
+
+ EIntfCastError = class(Exception);
+ EInvalidContainer = class(Exception);
+ EInvalidInsert = class(Exception);
+
+ EPackageError = class(Exception);
+
+ EOSError = class(Exception)
+ public
+ ErrorCode: Longint;
+ end;
+
+ ESafecallException = class(Exception);
+ ENoThreadSupport = Class(Exception);
+
+
+ { Exception handling routines }
+ function ExceptObject: TObject;
+ function ExceptAddr: Pointer;
+ function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
+ Buffer: PChar; Size: Integer): Integer;
+ procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
+ procedure Abort;
+ procedure OutOfMemoryError;
+ procedure Beep;
+ function SysErrorMessage(ErrorCode: Integer): String;
+
+type
+ TTerminateProc = Function: Boolean;
+
+ procedure AddTerminateProc(TermProc: TTerminateProc);
+ function CallTerminateProcs: Boolean;
+
+
+
+Var
+ OnShowException : Procedure (Msg : ShortString);
+
+ { FileRec/TextRec }
+ {$i filerec.inc}
+ {$i textrec.inc}
+
+Const
+ HexDisplayPrefix : string = '$';
+
+const
+// commenting is VP fix. These idents are in a different unit there.
+ PathDelim={System.}DirectorySeparator;
+ DriveDelim={System.}DriveSeparator;
+ PathSep={System.}PathSeparator;
+
+
+Type
+ TFileRec=FileRec;
+ TTextRec=TextRec;
+
+ { Read internationalization settings }
+ {$i sysinth.inc}
+
+ { Read pchar handling functions declaration }
+ {$IFNDEF VIRTUALPASCAL}
+ {$i syspchh.inc}
+ {$ENDIF}
+
+ { MCBS functions }
+ {$i sysansih.inc}
+
+{$ifndef VER1_0}
+ { wide string functions }
+ {$i syswideh.inc}
+{$endif VER1_0}
+
+ { Read filename handling functions declaration }
+ {$i finah.inc}
+
+ { Read other file handling function declarations }
+ {$i filutilh.inc}
+
+ { Read disk function declarations }
+ {$i diskh.inc}
+
+ { read thread handling }
+ {$i systhrdh.inc}
+
+ procedure FreeAndNil(var obj);
+
+{$ifdef HASINTF}
+ { interface handling }
+ {$i intfh.inc}
+{$endif HASINTF}
+
+{
+ $Log: sysutilh.inc,v $
+ Revision 1.14 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.13 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.12 2005/02/03 18:40:02 florian
+ * compilation with 1.0.x fixed
+ + infrastructure for WideCompareText implemented
+
+ Revision 1.11 2005/02/03 16:21:59 peter
+ * 1.0.x fix
+
+ Revision 1.10 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/objpas/sysutils/sysutils.inc b/rtl/objpas/sysutils/sysutils.inc
new file mode 100644
index 0000000000..26c7a177f5
--- /dev/null
+++ b/rtl/objpas/sysutils/sysutils.inc
@@ -0,0 +1,534 @@
+{
+ $Id: sysutils.inc,v 1.20 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ { Read filename handling functions implementation }
+ {$i fina.inc}
+
+ Function FileSearch (Const Name, DirList : String) : String;
+ Var
+ I : longint;
+ Temp : String;
+
+ begin
+ Result:='';
+ temp:=Dirlist;
+ repeat
+ While (Length(Temp)>0) and (Temp[1]=PathSeparator) do
+ Delete(Temp,1,1);
+ I:=pos(PathSep,Temp);
+ If I<>0 then
+ begin
+ Result:=Copy (Temp,1,i-1);
+ system.Delete(Temp,1,I);
+ end
+ else
+ begin
+ Result:=Temp;
+ Temp:='';
+ end;
+ If (Length(Result)>0) and (result[length(result)]<>DirectorySeparator) then
+ Result:=Result+DirectorySeparator;
+ Result:=Result+name;
+ If not FileExists(Result) Then
+ Result:='';
+ until (length(temp)=0) or (length(result)<>0);
+ end;
+
+ {$ifndef OS_FILEISREADONLY}
+ Function FileIsReadOnly(const FileName: String): Boolean;
+
+ begin
+ Result := (FileGetAttr(FileName) and faReadOnly) <> 0;
+ end;
+ {$endif OS_FILEISREADONLY}
+
+
+ { Read String Handling functions implementation }
+ {$i sysstr.inc}
+
+ { Read date & Time function implementations }
+ {$i dati.inc}
+
+ { Read pchar handling functions implementation }
+ {$i syspch.inc}
+
+ { generic internationalisation code }
+ {$i sysint.inc}
+
+ { MCBS functions }
+ {$i sysansi.inc}
+
+{$ifndef VER1_0}
+ { wide string functions }
+ {$i syswide.inc}
+{$endif VER1_0}
+
+ { CPU Specific code }
+ {$i sysutilp.inc}
+
+ { OS utility code }
+ {$i osutil.inc}
+
+ procedure FreeAndNil(var obj);
+ var
+ temp: tobject;
+ begin
+ temp:=tobject(obj);
+ pointer(obj):=nil;
+ temp.free;
+ end;
+
+{$ifdef HASINTF}
+ { Interfaces support }
+ {$i sysuintf.inc}
+{$endif HASINTF}
+
+ constructor Exception.Create(const msg : string);
+
+ begin
+ inherited create;
+ fmessage:=msg;
+ end;
+
+
+ constructor Exception.CreateFmt(const msg : string; const args : array of const);
+
+ begin
+ inherited create;
+ fmessage:=Format(msg,args);
+ end;
+
+
+ constructor Exception.CreateRes(ResString: PString);
+
+ begin
+ inherited create;
+ fmessage:=ResString^;
+ end;
+
+
+ constructor Exception.CreateResFmt(ResString: PString; const Args: array of const);
+
+ begin
+ inherited create;
+ fmessage:=Format(ResString^,args);
+ end;
+
+
+ constructor Exception.CreateHelp(const Msg: string; AHelpContext: Integer);
+
+ begin
+ inherited create;
+ fmessage:=Msg;
+ fhelpcontext:=AHelpContext;
+ end;
+
+
+ constructor Exception.CreateFmtHelp(const Msg: string; const Args: array of const;
+ AHelpContext: Integer);
+
+ begin
+ inherited create;
+ fmessage:=Format(Msg,args);
+ fhelpcontext:=AHelpContext;
+ end;
+
+
+ constructor Exception.CreateResHelp(ResString: PString; AHelpContext: Integer);
+
+ begin
+ inherited create;
+ fmessage:=ResString^;
+ fhelpcontext:=AHelpContext;
+ end;
+
+
+ constructor Exception.CreateResFmtHelp(ResString: PString; const Args: array of const;
+ AHelpContext: Integer);
+
+ begin
+ inherited create;
+ fmessage:=Format(ResString^,args);
+ fhelpcontext:=AHelpContext;
+ end;
+
+
+ procedure EHeapMemoryError.FreeInstance;
+ begin
+ if AllowFree then
+ inherited FreeInstance;
+ end;
+
+
+{$ifopt S+}
+{$define STACKCHECK_WAS_ON}
+{$S-}
+{$endif OPT S }
+Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION'];
+Var
+ Message : String;
+ {$IFDEF VIRTUALPASCAL}
+ stdout:text absolute output;
+ {$ENDIF}
+ i : longint;
+begin
+ Writeln(stdout,'An unhandled exception occurred at $',HexStr(Ptrint(Addr),sizeof(PtrInt)*2),' :');
+ if Obj is exception then
+ begin
+ Message:=Exception(Obj).ClassName+' : '+Exception(Obj).Message;
+ Writeln(stdout,Message);
+ end
+ else
+ Writeln(stdout,'Exception object ',Obj.ClassName,' is not of class Exception.');
+ if (FrameCount>0) then
+ begin
+ Writeln(stdout,BackTraceStrFunc(Addr));
+ for i:=0 to FrameCount-1 do
+ Writeln(stdout,BackTraceStrFunc(Frames[i]));
+ end;
+ Halt(217);
+end;
+
+
+Var OutOfMemory : EOutOfMemory;
+ InValidPointer : EInvalidPointer;
+
+
+Procedure RunErrorToExcept (ErrNo : Longint; Address,Frame : Pointer);
+
+Var E : Exception;
+ S : String;
+
+begin
+ Case Errno of
+ 1,203 : E:=OutOfMemory;
+ 204 : E:=InvalidPointer;
+ 2,3,4,5,6,100,101,102,103,105,106 : { I/O errors }
+ begin
+ Case Errno of
+ 2 : S:=SFileNotFound;
+ 3 : S:=SInvalidFileName;
+ 4 : S:=STooManyOpenFiles;
+ 5 : S:=SAccessDenied;
+ 6 : S:=SInvalidFileHandle;
+ 15 : S:=SInvalidDrive;
+ 100 : S:=SEndOfFile;
+ 101 : S:=SDiskFull;
+ 102 : S:=SFileNotAssigned;
+ 103 : S:=SFileNotOpen;
+ 104 : S:=SFileNotOpenForInput;
+ 105 : S:=SFileNotOpenForOutput;
+ 106 : S:=SInvalidInput;
+ end;
+ E:=EinOutError.Create (S);
+ EInoutError(E).ErrorCode:=IOresult; // Clears InOutRes !!
+ end;
+ // We don't set abstracterrorhandler, but we do it here.
+ // Unless the use sets another handler we'll get here anyway...
+ 200 : E:=EDivByZero.Create(SDivByZero);
+ 201 : E:=ERangeError.Create(SRangeError);
+ 205 : E:=EOverflow.Create(SOverflow);
+ 206 : E:=EOverflow.Create(SUnderflow);
+ 207 : E:=EInvalidOp.Create(SInvalidOp);
+ 211 : E:=EAbstractError.Create(SAbstractError);
+ 215 : E:=EIntOverflow.Create(SIntOverflow);
+ 216 : E:=EAccessViolation.Create(SAccessViolation);
+ 217 : E:=EPrivilege.Create(SPrivilege);
+ 218 : E:=EControlC.Create(SControlC);
+ 219 : E:=EInvalidCast.Create(SInvalidCast);
+ 220 : E:=EVariantError.Create(SInvalidVarCast);
+ 221 : E:=EVariantError.Create(SInvalidVarOp);
+ 222 : E:=EVariantError.Create(SDispatchError);
+ 223 : E:=EVariantError.Create(SVarArrayCreate);
+ 224 : E:=EVariantError.Create(SVarNotArray);
+ 225 : E:=EVariantError.Create(SVarArrayBounds);
+ 227 : E:=EAssertionFailed.Create(SAssertionFailed);
+ 228 : E:=EExternalException.Create(SExternalException);
+ 229 : E:=EIntfCastError.Create(SIntfCastError);
+ 230 : E:=ESafecallException.Create(SSafecallException);
+ 232 : E:=ENoThreadSupport.Create(SNoThreadSupport);
+ else
+ E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
+ end;
+{$ifdef VER1_0}
+ Raise E at longint(Address){$ifdef ENHANCEDRAISE},longint(Frame){$endif};
+{$else VER1_0}
+ Raise E at Address,Frame;
+{$endif VER1_0}
+end;
+
+{$IFDEF HAS_OSERROR}
+Procedure RaiseLastOSError;
+
+var
+ ECode: Cardinal;
+ E : EOSError;
+
+begin
+ ECode := GetLastOSError;
+ If (ECode<>0) then
+ E:=EOSError.CreateFmt(SOSError, [ECode, SysErrorMessage(ECode)])
+ else
+ E:=EOSError.Create(SUnkOSError);
+ E.ErrorCode:=ECode;
+ Raise E;
+end;
+{$else}
+Procedure RaiseLastOSError;
+
+begin
+ Raise Exception.Create('RaiseLastOSError not implemented on this platform.');
+end;
+{$endif}
+Procedure AssertErrorHandler (Const Msg,FN : ShortString;LineNo:longint; TheAddr : pointer);
+Var
+ S : String;
+begin
+ If Msg='' then
+ S:=SAssertionFailed
+ else
+ S:=Msg;
+ Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]); // at Pointer(theAddr);
+end;
+
+{$ifdef STACKCHECK_WAS_ON}
+{$S+}
+{$endif}
+
+Procedure InitExceptions;
+{
+ Must install uncaught exception handler (ExceptProc)
+ and install exceptions for system exceptions or signals.
+ (e.g: SIGSEGV -> ESegFault or so.)
+}
+begin
+ ExceptProc:=@CatchUnhandledException;
+ // Create objects that may have problems when there is no memory.
+ OutOfMemory:=EOutOfMemory.Create(SOutOfMemory);
+ OutOfMemory.AllowFree:=false;
+ InvalidPointer:=EInvalidPointer.Create(SInvalidPointer);
+ InvalidPointer.AllowFree:=false;
+ AssertErrorProc:=@AssertErrorHandler;
+ ErrorProc:=@RunErrorToExcept;
+ OnShowException:=Nil;
+end;
+
+
+Procedure DoneExceptions;
+begin
+ OutOfMemory.AllowFree:=true;
+ OutOfMemory.Free;
+ InValidPointer.AllowFree:=true;
+ InValidPointer.Free;
+end;
+
+
+{ Exception handling routines }
+
+function ExceptObject: TObject;
+
+begin
+ {$IFDEF VIRTUALPASCAL}
+ // vpascal does exceptions more the delphi way...
+ // this needs to be written from scratch.
+ {$ELSE}
+ If RaiseList=Nil then
+ Result:=Nil
+ else
+ Result:=RaiseList^.FObject;
+ {$ENDIF}
+end;
+
+function ExceptAddr: Pointer;
+
+begin
+ {$IFDEF VIRTUALPASCAL}
+ // vpascal does exceptions more the delphi way...
+ // this needs to be written from scratch.
+ {$ELSE}
+ If RaiseList=Nil then
+ Result:=Nil
+ else
+ Result:=RaiseList^.Addr;
+ {$ENDIF}
+end;
+
+function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
+ Buffer: PChar; Size: Integer): Integer;
+
+Var
+ S : AnsiString;
+ Len : Integer;
+
+begin
+ S:=Format(SExceptionErrorMessage,[ExceptAddr,ExceptObject.ClassName]);
+ If ExceptObject is Exception then
+ S:=Format('%s:'#10'%s',[S,Exception(ExceptObject).Message]);
+ Len:=Length(S);
+ If S[Len]<>'.' then
+ begin
+ S:=S+'.';
+ Inc(len);
+ end;
+ If Len>Size then
+ Len:=Size;
+ if Len > 0 then
+ Move(S[1],Buffer^,Len);
+ Result:=Len;
+end;
+
+procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
+
+// use shortstring. On exception, the heap may be corrupt.
+
+Var
+ Buf : ShortString;
+
+begin
+ SetLength(Buf,ExceptionErrorMessage(ExceptObject,ExceptAddr,@Buf[1],255));
+ If IsConsole Then
+ writeln(Buf)
+ else
+ If Assigned(OnShowException) Then
+ OnShowException (Buf);
+end;
+
+procedure Abort;
+
+begin
+{$ifdef VER1_0}
+ Raise EAbort.Create(SAbortError) at Longint(Get_Caller_addr(Get_Frame));
+{$else VER1_0}
+ Raise EAbort.Create(SAbortError)
+ {$IFNDEF VIRTUALPASCAL}
+ at Pointer(Get_Caller_addr(Get_Frame));
+ {$ENDIF}
+{$endif VER1_0}
+end;
+
+procedure OutOfMemoryError;
+
+begin
+ Raise OutOfMemory;
+end;
+
+{ ---------------------------------------------------------------------
+ Initialization/Finalization/exit code
+ ---------------------------------------------------------------------}
+
+Type
+ PPRecord = ^TPRecord;
+ TPRecord = Record
+ Func : TTerminateProc;
+ NextFunc : PPRecord;
+ end;
+
+Const
+ TPList : PPRecord = Nil;
+
+procedure AddTerminateProc(TermProc: TTerminateProc);
+
+Var
+ TPR : PPRecord;
+
+begin
+ New(TPR);
+ With TPR^ do
+ begin
+ NextFunc:=TPList;
+ Func:=TermProc;
+ end;
+ TPList:=TPR;
+end;
+
+function CallTerminateProcs: Boolean;
+
+Var
+ TPR : PPRecord;
+
+begin
+ Result:=True;
+ TPR:=TPList;
+ While Result and (TPR<>Nil) do
+ begin
+ Result:=TPR^.Func();
+ TPR:=TPR^.NextFunc;
+ end;
+end;
+
+{ ---------------------------------------------------------------------
+ Diskh functions, OS independent.
+ ---------------------------------------------------------------------}
+
+
+function ForceDirectories(Const Dir: string): Boolean;
+
+var
+ E: EInOutError;
+ ADir : String;
+
+begin
+ Result:=True;
+ ADir:=ExcludeTrailingPathDelimiter(Dir);
+ if (ADir='') then
+ begin
+ E:=EInOutError.Create(SCannotCreateEmptyDir);
+ E.ErrorCode:=3;
+ Raise E;
+ end;
+ if Not DirectoryExists(ADir) then
+ begin
+ Result:=ForceDirectories(ExtractFilePath(ADir));
+ If Result then
+ CreateDir(ADir);
+ end;
+end;
+
+
+{
+ Revision 1.1 2003/10/06 21:01:06 peter
+ * moved classes unit to rtl
+
+ Revision 1.17 2003/09/06 20:46:07 marco
+ * 3 small VP fixes from Noah Silva. One (OutOfMemory error) failed.
+
+ Revision 1.16 2003/04/06 11:06:39 michael
+ + Added exception classname to output of unhandled exception for better identification
+
+ Revision 1.15 2003/03/18 08:28:23 michael
+ Patch from peter for Abort routine
+
+ Revision 1.14 2003/03/17 15:11:51 armin
+ + someone AssertErrorHandler, BackTraceFunc and Dump_Stack so that pointer instead of longint is needed
+
+ Revision 1.13 2003/01/01 20:58:07 florian
+ + added invalid instruction exception
+
+ Revision 1.12 2002/10/07 19:43:24 florian
+ + empty prototypes for the AnsiStr* multi byte functions added
+
+ Revision 1.11 2002/09/07 16:01:22 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.10 2002/07/16 13:57:39 florian
+ * raise takes now a void pointer as at and frame address
+ instead of a longint, fixed
+
+ Revision 1.9 2002/01/25 17:42:03 peter
+ * interface helpers
+
+ Revision 1.8 2002/01/25 16:23:03 peter
+ * merged filesearch() fix
+}
diff --git a/rtl/objpas/sysutils/syswide.inc b/rtl/objpas/sysutils/syswide.inc
new file mode 100644
index 0000000000..ae2537005e
--- /dev/null
+++ b/rtl/objpas/sysutils/syswide.inc
@@ -0,0 +1,124 @@
+{
+ *********************************************************************
+ $Id: syswide.inc,v 1.7 2005/03/12 14:56:22 florian Exp $
+ Copyright (C) 2002-2005 by Florian Klaempfl
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+}
+
+
+function WideUpperCase(const s : WideString) : WideString;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ result:=widestringmanager.UpperWideStringProc(s);
+ end;
+
+
+function WideLowerCase(const s : WideString) : WideString;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ result:=widestringmanager.LowerWideStringProc(s);
+ end;
+
+
+function WideCompareStr(const s1, s2 : WideString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ result:=widestringmanager.CompareWideStringProc(s1,s2);
+ end;
+
+
+function WideSameStr(const s1, s2 : WideString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ result:=widestringmanager.CompareWideStringProc(s1,s2)=0;
+ end;
+
+
+function WideCompareText(const s1, s2 : WideString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ result:=widestringmanager.CompareTextWideStringProc(s1,s2);
+ end;
+
+
+function WideSameText(const s1, s2 : WideString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+ begin
+ result:=widestringmanager.CompareTextWideStringProc(s1,s2)=0;
+ end;
+
+
+{ we've no templates, but with includes we can simulate this :) }
+{$macro on}
+{$define INWIDEFORMAT}
+{$define TFormatString:=widestring}
+{$define TFormatChar:=widechar}
+
+Function WideFormat (Const Fmt : WideString; const Args : Array of const) : WideString;
+{$i sysformt.inc}
+
+{$undef TFormatString}
+{$undef TFormatChar}
+{$undef INWIDEFORMAT}
+{$macro off}
+
+
+Function WideFormatBuf (Var Buffer; BufLen : Cardinal;
+ Const Fmt; fmtLen : Cardinal;
+ Const Args : Array of const) : Cardinal;
+ Var
+ S,F : WideString;
+ begin
+ Setlength(F,fmtlen);
+ if fmtlen > 0 then
+ Move(fmt,F[1],fmtlen*sizeof(Widechar));
+ S:=WideFormat (F,Args);
+ If Cardinal(Length(S))<Buflen then
+ Result:=Length(S)
+ else
+ Result:=Buflen;
+ Move(S[1],Buffer,Result);
+ end;
+
+
+Procedure WideFmtStr(Var Res: WideString; Const Fmt : WideString; Const args: Array of const);
+ begin
+ Res:=WideFormat(fmt,Args);
+ end;
+
+
+{
+ $Log: syswide.inc,v $
+ Revision 1.7 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.6 2005/03/06 18:28:23 florian
+ + WideFormatBuf and WideFmtStr implemented
+
+ Revision 1.5 2005/02/26 15:00:14 florian
+ + WideSameStr
+
+ Revision 1.4 2005/02/26 10:21:17 florian
+ + implemented WideFormat
+ + some Widestring stuff implemented
+ * some Widestring stuff fixed
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/03 18:40:02 florian
+ * compilation with 1.0.x fixed
+ + infrastructure for WideCompareText implemented
+
+ Revision 1.1 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+}
diff --git a/rtl/objpas/sysutils/syswideh.inc b/rtl/objpas/sysutils/syswideh.inc
new file mode 100644
index 0000000000..a59fc95a6d
--- /dev/null
+++ b/rtl/objpas/sysutils/syswideh.inc
@@ -0,0 +1,59 @@
+{
+ *********************************************************************
+ $Id: syswideh.inc,v 1.6 2005/03/12 14:56:22 florian Exp $
+ Copyright (C) 2002 by Florian Klaempfl
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *********************************************************************
+}
+
+function WideUpperCase(const s : WideString) : WideString;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function WideLowerCase(const s : WideString) : WideString;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function WideCompareStr(const s1, s2 : WideString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function WideSameStr(const s1, s2 : WideString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function WideCompareText(const s1, s2 : WideString) : PtrInt;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function WideSameText(const s1, s2 : WideString) : Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+Function WideFormat (Const Fmt : WideString; const Args : Array of const) : WideString;
+Function WideFormatBuf (Var Buffer; BufLen : Cardinal;
+ Const Fmt; fmtLen : Cardinal;
+ Const Args : Array of const) : Cardinal;
+Procedure WideFmtStr(Var Res: WideString; Const Fmt : WideString; Const args: Array of const);
+
+
+{
+ $Log: syswideh.inc,v $
+ Revision 1.6 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.5 2005/03/06 18:28:23 florian
+ + WideFormatBuf and WideFmtStr implemented
+
+ Revision 1.4 2005/02/26 15:00:14 florian
+ + WideSameStr
+
+ Revision 1.3 2005/02/26 10:21:17 florian
+ + implemented WideFormat
+ + some Widestring stuff implemented
+ * some Widestring stuff fixed
+
+ Revision 1.2 2005/02/03 18:40:02 florian
+ * compilation with 1.0.x fixed
+ + infrastructure for WideCompareText implemented
+
+ Revision 1.1 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+}
diff --git a/rtl/objpas/types.pp b/rtl/objpas/types.pp
new file mode 100644
index 0000000000..a5f6f140f2
--- /dev/null
+++ b/rtl/objpas/types.pp
@@ -0,0 +1,413 @@
+{
+ $Id: types.pp,v 1.10 2005/02/26 15:11:43 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$MODE OBJFPC}
+unit types;
+
+ interface
+
+{$ifdef Win32}
+ uses
+ Windows;
+{$endif Win32}
+
+{$ifndef ver1_0}
+const
+ RT_RCDATA = PChar(10);
+
+type
+ DWORD = LongWord;
+
+ PLongint = System.PLongint;
+ PInteger = System.PInteger;
+ PSmallInt = System.PSmallInt;
+ PDouble = System.PDouble;
+ PByte = System.PByte;
+
+ TIntegerDynArray = array of Integer;
+ TCardinalDynArray = array of Cardinal;
+ TWordDynArray = array of Word;
+ TSmallIntDynArray = array of SmallInt;
+ TByteDynArray = array of Byte;
+ TShortIntDynArray = array of ShortInt;
+ TInt64DynArray = array of Int64;
+ TQWordDynArray = array of QWord;
+ TLongWordDynArray = array of LongWord;
+ TSingleDynArray = array of Single;
+ TDoubleDynArray = array of Double;
+ TBooleanDynArray = array of Boolean;
+ TStringDynArray = array of AnsiString;
+ TWideStringDynArray = array of WideString;
+
+{$ifdef Win32}
+ TPoint = Windows.TPoint;
+{$else}
+ TPoint =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ X : Longint;
+ Y : Longint;
+ end;
+{$endif}
+ PPoint = ^TPoint;
+ tagPOINT = TPoint;
+
+{$ifdef Win32}
+ TRect = Windows.TRect;
+{$else}
+ TRect =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ case Integer of
+ 0: (Left,Top,Right,Bottom : Longint);
+ 1: (TopLeft,BottomRight : TPoint);
+ end;
+{$endif Win32}
+ PRect = ^TRect;
+
+{$ifdef Win32}
+ TSize = Windows.TSize;
+{$else}
+ TSize =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ cx : Longint;
+ cy : Longint;
+ end;
+{$endif Win32}
+ PSize = ^TSize;
+ tagSIZE = TSize;
+ SIZE = TSize;
+
+
+ TSmallPoint =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ x : SmallInt;
+ y : SmallInt;
+ end;
+ PSmallPoint = ^TSmallPoint;
+
+type
+ TOleChar = WideChar;
+ POleStr = PWideChar;
+ PPOleStr = ^POleStr;
+
+{$ifndef win32}
+const
+
+ STGTY_STORAGE = 1;
+ STGTY_STREAM = 2;
+ STGTY_LOCKBYTES = 3;
+ STGTY_PROPERTY = 4;
+
+ STREAM_SEEK_SET = 0;
+ STREAM_SEEK_CUR = 1;
+ STREAM_SEEK_END = 2;
+
+ LOCK_WRITE = 1;
+ LOCK_EXCLUSIVE = 2;
+ LOCK_ONLYONCE = 4;
+
+ E_FAIL = HRESULT($80004005);
+
+ STG_E_INVALIDFUNCTION = HRESULT($80030001);
+ STG_E_FILENOTFOUND = HRESULT($80030002);
+ STG_E_PATHNOTFOUND = HRESULT($80030003);
+ STG_E_TOOMANYOPENFILES = HRESULT($80030004);
+ STG_E_ACCESSDENIED = HRESULT($80030005);
+ STG_E_INVALIDHANDLE = HRESULT($80030006);
+ STG_E_INSUFFICIENTMEMORY = HRESULT($80030008);
+ STG_E_INVALIDPOINTER = HRESULT($80030009);
+ STG_E_NOMOREFILES = HRESULT($80030012);
+ STG_E_DISKISWRITEPROTECTED = HRESULT($80030013);
+ STG_E_SEEKERROR = HRESULT($80030019);
+ STG_E_WRITEFAULT = HRESULT($8003001D);
+ STG_E_READFAULT = HRESULT($8003001E);
+ STG_E_SHAREVIOLATION = HRESULT($80030020);
+ STG_E_LOCKVIOLATION = HRESULT($80030021);
+ STG_E_FILEALREADYEXISTS = HRESULT($80030050);
+ STG_E_INVALIDPARAMETER = HRESULT($80030057);
+ STG_E_MEDIUMFULL = HRESULT($80030070);
+ STG_E_PROPSETMISMATCHED = HRESULT($800300F0);
+ STG_E_ABNORMALAPIEXIT = HRESULT($800300FA);
+ STG_E_INVALIDHEADER = HRESULT($800300FB);
+ STG_E_INVALIDNAME = HRESULT($800300FC);
+ STG_E_UNKNOWN = HRESULT($800300FD);
+ STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
+ STG_E_INVALIDFLAG = HRESULT($800300FF);
+ STG_E_INUSE = HRESULT($80030100);
+ STG_E_NOTCURRENT = HRESULT($80030101);
+ STG_E_REVERTED = HRESULT($80030102);
+ STG_E_CANTSAVE = HRESULT($80030103);
+ STG_E_OLDFORMAT = HRESULT($80030104);
+ STG_E_OLDDLL = HRESULT($80030105);
+ STG_E_SHAREREQUIRED = HRESULT($80030106);
+ STG_E_EXTANTMARSHALLINGS = HRESULT($80030108);
+ STG_E_DOCFILECORRUPT = HRESULT($80030109);
+ STG_E_BADBASEADDRESS = HRESULT($80030110);
+ STG_E_INCOMPLETE = HRESULT($80030201);
+ STG_E_TERMINATED = HRESULT($80030202);
+
+ STG_S_CONVERTED = $00030200;
+ STG_S_BLOCK = $00030201;
+ STG_S_RETRYNOW = $00030202;
+ STG_S_MONITORING = $00030203;
+
+ GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
+
+type
+ PCLSID = PGUID;
+ TCLSID = TGUID;
+
+ LARGE_INT = Int64;
+ Largeint = LARGE_INT;
+ PDWord = ^DWord;
+
+ PDisplay = Pointer;
+ PEvent = Pointer;
+
+ TXrmOptionDescRec = record
+ end;
+ XrmOptionDescRec = TXrmOptionDescRec;
+ PXrmOptionDescRec = ^TXrmOptionDescRec;
+
+ Widget = Pointer;
+ WidgetClass = Pointer;
+ ArgList = Pointer;
+ Region = Pointer;
+
+ _FILETIME =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ dwLowDateTime : DWORD;
+ dwHighDateTime : DWORD;
+ end;
+ TFileTime = _FILETIME;
+ FILETIME = _FILETIME;
+ PFileTime = ^TFileTime;
+
+ tagSTATSTG =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ pwcsName : POleStr;
+ dwType : Longint;
+ cbSize : Largeint;
+ mtime : TFileTime;
+ ctime : TFileTime;
+ atime : TFileTime;
+ grfMode : Longint;
+ grfLocksSupported : Longint;
+ clsid : TCLSID;
+ grfStateBits : Longint;
+ reserved : Longint;
+ end;
+ TStatStg = tagSTATSTG;
+ STATSTG = TStatStg;
+ PStatStg = ^TStatStg;
+
+{$ifdef HASINTF}
+ IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
+ Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
+ Function LockServer(fLock : LongBool) : HResult;StdCall;
+ End;
+
+ ISequentialStream = interface(IUnknown) ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
+ function Read(pv : Pointer;cb : DWord;pcbRead : PDWord) : HRESULT;stdcall;
+ function Write(pv : Pointer;cb : DWord;pcbWritten : PDWord) : HRESULT;stdcall;
+ end;
+
+ IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
+ function Seek(dlibMove : LargeInt; dwOrigin : Longint;
+ out libNewPosition : LargeInt) : HResult;stdcall;
+ function SetSize(libNewSize : LargeInt) : HRESULT;stdcall;
+ function CopyTo(stm: IStream;cb : LargeInt;out cbRead : LargeInt;
+ out cbWritten : LargeInt) : HRESULT;stdcall;
+ function Commit(grfCommitFlags : Longint) : HRESULT;stdcall;
+ function Revert : HRESULT;stdcall;
+ function LockRegion(libOffset : LargeInt;cb : LargeInt;
+ dwLockType : Longint) : HRESULT;stdcall;
+ function UnlockRegion(libOffset : LargeInt;cb : LargeInt;
+ dwLockType : Longint) : HRESULT;stdcall;
+ Function Stat(out statstg : TStatStg;grfStatFlag : Longint) : HRESULT;stdcall;
+ function Clone(out stm : IStream) : HRESULT;stdcall;
+ end;
+{$endif HASINTF}
+{$endif win32}
+
+function EqualRect(const r1,r2 : TRect) : Boolean;
+function Rect(Left,Top,Right,Bottom : Integer) : TRect;
+function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect;
+function Point(x,y : Integer) : TPoint;
+function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
+function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
+function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
+function IsRectEmpty(const Rect : TRect) : Boolean;
+function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
+function CenterPoint(const Rect: TRect): TPoint;
+
+{$endif ver1_0}
+
+implementation
+
+{$ifndef ver1_0}
+
+function EqualRect(const r1,r2 : TRect) : Boolean;
+
+begin
+ EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
+end;
+
+
+function Rect(Left,Top,Right,Bottom : Integer) : TRect;
+
+begin
+ Rect.Left:=Left;
+ Rect.Top:=Top;
+ Rect.Right:=Right;
+ Rect.Bottom:=Bottom;
+end;
+
+
+function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect;
+
+begin
+ Bounds.Left:=ALeft;
+ Bounds.Top:=ATop;
+ Bounds.Right:=ALeft+AWidth;
+ Bounds.Bottom:=ATop+AHeight;
+end;
+
+
+function Point(x,y : Integer) : TPoint;
+
+begin
+ Point.x:=x;
+ Point.y:=y;
+end;
+
+function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;
+
+begin
+ PtInRect:=(p.y>=Rect.Top) and
+ (p.y<Rect.Bottom) and
+ (p.x>=Rect.Left) and
+ (p.x<Rect.Right);
+end;
+
+
+function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
+
+begin
+ Rect:=R1;
+ with R2 do
+ begin
+ if Left>R1.Left then
+ Rect.Left:=Left;
+ if Top>R1.Top then
+ Rect.Top:=Top;
+ if Right<R1.Right then
+ Rect.Right:=Right;
+ if Bottom<R1.Bottom then
+ Rect.Bottom:=Bottom;
+ end;
+ if IsRectEmpty(Rect) then
+ begin
+ FillChar(Rect,SizeOf(Rect),0);
+ IntersectRect:=false;
+ end
+ else
+ IntersectRect:=true;
+end;
+
+function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
+begin
+ Rect:=R1;
+ with R2 do
+ begin
+ if Left<R1.Left then
+ Rect.Left:=Left;
+ if Top<R1.Top then
+ Rect.Top:=Top;
+ if Right>R1.Right then
+ Rect.Right:=Right;
+ if Bottom>R1.Bottom then
+ Rect.Bottom:=Bottom;
+ end;
+ if IsRectEmpty(Rect) then
+ begin
+ FillChar(Rect,SizeOf(Rect),0);
+ UnionRect:=false;
+ end
+ else
+ UnionRect:=true;
+end;
+
+function IsRectEmpty(const Rect : TRect) : Boolean;
+begin
+ IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
+end;
+
+function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
+begin
+ if assigned(@Rect) then
+ begin
+ with Rect do
+ begin
+ inc(Left,dx);
+ inc(Top,dy);
+ inc(Right,dx);
+ inc(Bottom,dy);
+ end;
+ OffsetRect:=true;
+ end
+ else
+ OffsetRect:=false;
+end;
+
+function CenterPoint(const Rect: TRect): TPoint;
+
+begin
+ With Rect do
+ begin
+ Result.X:=(Left+Right) div 2;
+ Result.Y:=(Top+Bottom) div 2;
+ end;
+end;
+
+
+{$endif ver1_0}
+
+end.
+{
+ $Log: types.pp,v $
+ Revision 1.10 2005/02/26 15:11:43 florian
+ * TSize is imported from the Windows unit on win32
+
+ Revision 1.9 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp
new file mode 100644
index 0000000000..5f050529ee
--- /dev/null
+++ b/rtl/objpas/typinfo.pp
@@ -0,0 +1,1598 @@
+{
+ $Id: typinfo.pp,v 1.45 2005/04/16 09:24:29 michael Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ This unit provides the same Functionality as the TypInfo Unit }
+{ of Delphi }
+
+unit typinfo;
+
+ interface
+
+{$MODE objfpc}
+{$h+}
+
+ uses SysUtils;
+
+
+// temporary types:
+
+ type
+{$ifndef HASVARIANT}
+ Variant = Pointer;
+{$endif}
+
+{$MINENUMSIZE 1 this saves a lot of memory }
+ // if you change one of the following enumeration types
+ // you have also to change the compiler in an appropriate way !
+ TTypeKind = (tkUnknown,tkInteger,tkChar,tkEnumeration,
+ tkFloat,tkSet,tkMethod,tkSString,tkLString,tkAString,
+ tkWString,tkVariant,tkArray,tkRecord,tkInterface,
+ tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
+ tkDynArray,tkInterfaceRaw);
+
+ TOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
+
+ TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
+ TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
+ mkClassProcedure, mkClassFunction);
+ TParamFlags = set of (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
+ TIntfFlag = (ifHasGuid,ifDispInterface,ifDispatch);
+ TIntfFlags = set of TIntfFlag;
+ TIntfFlagsBase = set of TIntfFlag;
+
+{$MINENUMSIZE DEFAULT}
+
+ const
+ ptField = 0;
+ ptStatic = 1;
+ ptVirtual = 2;
+ ptConst = 3;
+
+ tkString = tkSString;
+
+ type
+ TTypeKinds = set of TTypeKind;
+
+{$PACKRECORDS 1}
+ TTypeInfo = record
+ Kind : TTypeKind;
+ Name : ShortString;
+ // here the type data follows as TTypeData record
+ end;
+
+ PTypeInfo = ^TTypeInfo;
+ PPTypeInfo = ^PTypeInfo;
+
+{$PACKRECORDS C}
+ PTypeData = ^TTypeData;
+ TTypeData =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ case TTypeKind of
+ tkUnKnown,tkLString,tkWString,tkAString,tkVariant:
+ ();
+ tkInteger,tkChar,tkEnumeration,tkWChar:
+ (OrdType : TOrdType;
+ case TTypeKind of
+ tkInteger,tkChar,tkEnumeration,tkBool,tkWChar : (
+ MinValue,MaxValue : Longint;
+ case TTypeKind of
+ tkEnumeration:
+ (
+ BaseType : PTypeInfo;
+ NameList : ShortString)
+ );
+ tkSet:
+ (CompType : PTypeInfo)
+ );
+ tkFloat:
+ (FloatType : TFloatType);
+ tkSString:
+ (MaxLength : Byte);
+ tkClass:
+ (ClassType : TClass;
+ ParentInfo : PTypeInfo;
+ PropCount : SmallInt;
+ UnitName : ShortString
+ // here the properties follow as array of TPropInfo
+ );
+ tkMethod:
+ (MethodKind : TMethodKind;
+ ParamCount : Byte;
+ ParamList : array[0..1023] of Char
+ {in reality ParamList is a array[1..ParamCount] of:
+ record
+ Flags : TParamFlags;
+ ParamName : ShortString;
+ TypeName : ShortString;
+ end;
+ followed by
+ ResultType : ShortString}
+ );
+ tkInt64:
+ (MinInt64Value, MaxInt64Value: Int64);
+ tkQWord:
+ (MinQWordValue, MaxQWordValue: QWord);
+ tkInterface,
+ tkInterfaceRaw:
+ (
+ IntfParent: PPTypeInfo;
+ IID: PGUID;
+ IIDStr: ShortString;
+ IntfUnit: ShortString;
+ );
+ end;
+
+ // unsed, just for completeness
+ TPropData =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ record
+ PropCount : Word;
+ PropList : record _alignmentdummy : ptrint; end;
+ end;
+{$PACKRECORDS 1}
+
+ PPropInfo = ^TPropInfo;
+ TPropInfo = packed record
+ PropType : PTypeInfo;
+ GetProc : Pointer;
+ SetProc : Pointer;
+ StoredProc : Pointer;
+ Index : Integer;
+ Default : Longint;
+ NameIndex : SmallInt;
+
+ // contains the type of the Get/Set/Storedproc, see also ptxxx
+ // bit 0..1 GetProc
+ // 2..3 SetProc
+ // 4..5 StoredProc
+ // 6 : true, constant index property
+ PropProcs : Byte;
+
+ Name : ShortString;
+ end;
+
+ TProcInfoProc = Procedure(PropInfo : PPropInfo) of object;
+
+ PPropList = ^TPropList;
+ TPropList = array[0..65535] of PPropInfo;
+
+ const
+ tkAny = [Low(TTypeKind)..High(TTypeKind)];
+ tkMethods = [tkMethod];
+ tkProperties = tkAny-tkMethods-[tkUnknown];
+
+// general property handling
+Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
+
+Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
+Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string; AKinds : TTypeKinds) : PPropInfo;
+Function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
+Function GetPropInfo(Instance: TObject; const PropName: string): PPropInfo;
+Function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
+Function GetPropInfo(AClass: TClass; const PropName: string): PPropInfo;
+Function FindPropInfo(Instance: TObject; const PropName: string): PPropInfo;
+Function FindPropInfo(AClass:TClass;const PropName: string): PPropInfo;
+Procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
+{$ifdef ver1_0}
+Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; PropList : PPropList;Sorted : boolean):longint;
+Function GetPropList(TypeInfo: PTypeInfo; var PropList: PPropList): SizeInt;
+{$else}
+Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; PropList : PPropList;Sorted : boolean = true):longint;
+Function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): SizeInt;
+{$endif}
+
+
+// Property information routines.
+Function IsStoredProp(Instance: TObject;PropInfo : PPropInfo) : Boolean;
+Function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
+Function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
+Function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
+Function PropType(Instance: TObject; const PropName: string): TTypeKind;
+Function PropType(AClass: TClass; const PropName: string): TTypeKind;
+Function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean;
+Function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean;
+
+// subroutines to read/write properties
+Function GetOrdProp(Instance: TObject; PropInfo : PPropInfo) : Int64;
+Function GetOrdProp(Instance: TObject; const PropName: string): Int64;
+Procedure SetOrdProp(Instance: TObject; PropInfo : PPropInfo; Value : Int64);
+Procedure SetOrdProp(Instance: TObject; const PropName: string; Value: Int64);
+
+Function GetEnumProp(Instance: TObject; const PropName: string): string;
+Function GetEnumProp(Instance: TObject; const PropInfo: PPropInfo): string;
+Procedure SetEnumProp(Instance: TObject; const PropName: string;const Value: string);
+Procedure SetEnumProp(Instance: TObject; const PropInfo: PPropInfo;const Value: string);
+
+Function GetSetProp(Instance: TObject; const PropName: string): string;
+Function GetSetProp(Instance: TObject; const PropName: string; Brackets: Boolean): string;
+Function GetSetProp(Instance: TObject; const PropInfo: PPropInfo; Brackets: Boolean): string;
+Procedure SetSetProp(Instance: TObject; const PropName: string; const Value: string);
+Procedure SetSetProp(Instance: TObject; const PropInfo: PPropInfo; const Value: string);
+
+Function GetStrProp(Instance: TObject; PropInfo : PPropInfo) : Ansistring;
+Function GetStrProp(Instance: TObject; const PropName: string): string;
+Procedure SetStrProp(Instance: TObject; const PropName: string; const Value: AnsiString);
+Procedure SetStrProp(Instance: TObject; PropInfo : PPropInfo; const Value : Ansistring);
+
+{$ifdef HASWIDESTRING}
+Function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
+Function GetWideStrProp(Instance: TObject; const PropName: string): WideString;
+Procedure SetWideStrProp(Instance: TObject; const PropName: string; const Value: WideString);
+Procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
+{$endif HASWIDESTRING}
+
+Function GetFloatProp(Instance: TObject; PropInfo : PPropInfo) : Extended;
+Function GetFloatProp(Instance: TObject; const PropName: string): Extended;
+Procedure SetFloatProp(Instance: TObject; const PropName: string; Value: Extended);
+Procedure SetFloatProp(Instance: TObject; PropInfo : PPropInfo; Value : Extended);
+
+Function GetObjectProp(Instance: TObject; const PropName: string): TObject;
+Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
+Function GetObjectProp(Instance: TObject; PropInfo: PPropInfo): TObject;
+Function GetObjectProp(Instance: TObject; PropInfo: PPropInfo; MinClass: TClass): TObject;
+Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject);
+Procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo; Value: TObject);
+
+Function GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
+
+Function GetMethodProp(Instance: TObject; PropInfo: PPropInfo) : TMethod;
+Function GetMethodProp(Instance: TObject; const PropName: string): TMethod;
+Procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo; const Value : TMethod);
+Procedure SetMethodProp(Instance: TObject; const PropName: string; const Value: TMethod);
+
+Function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
+Function GetInt64Prop(Instance: TObject; const PropName: string): Int64;
+Procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo; const Value: Int64);
+Procedure SetInt64Prop(Instance: TObject; const PropName: string; const Value: Int64);
+
+Function GetPropValue(Instance: TObject; const PropName: string): Variant;
+Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
+Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
+Function GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant;
+Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
+Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
+Procedure SetVariantProp(Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
+
+
+// Auxiliary routines, which may be useful
+Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
+Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
+function SetToString(PropInfo: PPropInfo; Value: Integer; Brackets: Boolean) : String;
+function SetToString(PropInfo: PPropInfo; Value: Integer) : String;
+function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
+
+const
+ BooleanIdents: array[Boolean] of String = ('False', 'True');
+ DotSep: String = '.';
+
+Type
+ EPropertyError = Class(Exception);
+ TGetPropValue = Function (Instance: TObject; const PropName: string; PreferStrings: Boolean) : Variant;
+ TSetPropValue = Procedure (Instance: TObject; const PropName: string; const Value: Variant);
+ TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant;
+ TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
+
+Const
+ OnGetPropValue : TGetPropValue = Nil;
+ OnSetPropValue : TSetPropValue = Nil;
+ OnGetVariantprop : TGetVariantProp = Nil;
+ OnSetVariantprop : TSetVariantProp = Nil;
+
+Implementation
+
+uses rtlconsts;
+
+type
+ PMethod = ^TMethod;
+
+{ ---------------------------------------------------------------------
+ Auxiliary methods
+ ---------------------------------------------------------------------}
+
+function aligntoptr(p : pointer) : pointer;
+ begin
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
+ if (ptrint(p) mod sizeof(ptrint))<>0 then
+ inc(ptrint(p),sizeof(ptrint)-ptrint(p) mod sizeof(ptrint));
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ result:=p;
+ end;
+
+
+Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
+
+ Var PS : PShortString;
+ PT : PTypeData;
+
+begin
+ PT:=GetTypeData(TypeInfo);
+ // ^.BaseType);
+ // If PT^.MinValue<0 then Value:=Ord(Value<>0); {map to 0/1}
+ PS:=@PT^.NameList;
+ While Value>0 Do
+ begin
+ PS:=PShortString(pointer(PS)+PByte(PS)^+1);
+ Dec(Value);
+ end;
+ Result:=PS^;
+end;
+
+
+Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
+
+ Var PS : PShortString;
+ PT : PTypeData;
+ Count : longint;
+
+begin
+ If Length(Name)=0 then
+ exit(-1);
+ PT:=GetTypeData(TypeInfo);
+ Count:=0;
+ Result:=-1;
+ PS:=@PT^.NameList;
+ While (Result=-1) and (PByte(PS)^<>0) do
+ begin
+ If CompareText(PS^, Name) = 0 then
+ Result:=Count;
+ PS:=PShortString(pointer(PS)+PByte(PS)^+1);
+ Inc(Count);
+ end;
+end;
+
+
+Function SetToString(PropInfo: PPropInfo; Value: Integer; Brackets: Boolean) : String;
+
+Var
+ I : Integer;
+ PTI : PTypeInfo;
+
+begin
+ PTI:=GetTypeData(PropInfo^.PropType)^.CompType;
+ Result:='';
+ For I:=0 to SizeOf(Integer)*8-1 do
+ begin
+ if ((Value and 1)<>0) then
+ begin
+ If Result='' then
+ Result:=GetEnumName(PTI,i)
+ else
+ Result:=Result+','+GetEnumName(PTI,I);
+ end;
+ Value:=Value shr 1;
+ end;
+ if Brackets then
+ Result:='['+Result+']';
+end;
+
+
+Function SetToString(PropInfo: PPropInfo; Value: Integer) : String;
+
+begin
+ Result:=SetToString(PropInfo,Value,False);
+end;
+
+
+Const
+ SetDelim = ['[',']',',',' '];
+
+Function GetNextElement(Var S : String) : String;
+Var
+ J : Integer;
+begin
+ J:=1;
+ Result:='';
+ If Length(S)>0 then
+ begin
+ While (J<=Length(S)) and Not (S[j] in SetDelim) do
+ Inc(j);
+ Result:=Copy(S,1,j-1);
+ Delete(S,1,j);
+ end;
+end;
+
+
+Function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
+Var
+ S,T : String;
+ I : Integer;
+ PTI : PTypeInfo;
+
+begin
+ Result:=0;
+ PTI:=GetTypeData(PropInfo^.PropType)^.Comptype;
+ S:=Value;
+ I:=1;
+ If Length(S)>0 then
+ begin
+ While (I<=Length(S)) and (S[i] in SetDelim) do
+ Inc(I);
+ Delete(S,1,i-1);
+ end;
+ While (S<>'') do
+ begin
+ T:=GetNextElement(S);
+ if T<>'' then
+ begin
+ I:=GetEnumValue(PTI,T);
+ if (I<0) then
+ raise EPropertyError.CreateFmt(SErrUnknownEnumValue, [T]);
+ Result:=Result or (1 shl i);
+ end;
+ end;
+end;
+
+
+Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
+begin
+ GetTypeData:=PTypeData(aligntoptr(PTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^)));
+end;
+
+
+{ ---------------------------------------------------------------------
+ Basic Type information functions.
+ ---------------------------------------------------------------------}
+
+Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
+var
+ hp : PTypeData;
+ i : longint;
+ p : string;
+ pd : ^TPropData;
+begin
+ P:=UpCase(PropName);
+ while Assigned(TypeInfo) do
+ begin
+ // skip the name
+ hp:=GetTypeData(Typeinfo);
+ // the class info rtti the property rtti follows immediatly
+ pd:=aligntoptr(pointer(pointer(@hp^.UnitName)+Length(hp^.UnitName)+1));
+ Result:=@pd^.PropList;
+ for i:=1 to pd^.PropCount do
+ begin
+ // found a property of that name ?
+ if Upcase(Result^.Name)=P then
+ exit;
+ // skip to next property
+ Result:=PPropInfo(aligntoptr(pointer(@Result^.Name)+byte(Result^.Name[0])+1));
+ end;
+ // parent class
+ Typeinfo:=hp^.ParentInfo;
+ end;
+ Result:=Nil;
+end;
+
+
+Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string; Akinds : TTypeKinds) : PPropInfo;
+begin
+ Result:=GetPropInfo(TypeInfo,PropName);
+ If (Akinds<>[]) then
+ If (Result<>Nil) then
+ If Not (Result^.PropType^.Kind in AKinds) then
+ Result:=Nil;
+end;
+
+
+Function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
+begin
+ Result:=GetPropInfo(PTypeInfo(AClass.ClassInfo),PropName,AKinds);
+end;
+
+
+Function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
+begin
+ Result:=GetPropInfo(Instance.ClassType,PropName,AKinds);
+end;
+
+
+Function GetPropInfo(Instance: TObject; const PropName: string): PPropInfo;
+begin
+ Result:=GetPropInfo(Instance,PropName,[]);
+end;
+
+
+Function GetPropInfo(AClass: TClass; const PropName: string): PPropInfo;
+begin
+ Result:=GetPropInfo(AClass,PropName,[]);
+end;
+
+
+Function FindPropInfo(Instance: TObject; const PropName: string): PPropInfo;
+begin
+ result:=GetPropInfo(Instance, PropName);
+ if Result=nil then
+ Raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName]);
+end;
+
+
+Function FindPropInfo(AClass:TClass;const PropName: string): PPropInfo;
+begin
+ result:=GetPropInfo(AClass,PropName);
+ if result=nil then
+ Raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName]);
+end;
+
+
+Function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
+type
+ TBooleanFunc=function:boolean of object;
+var
+ AMethod : TMethod;
+begin
+ case (PropInfo^.PropProcs shr 4) and 3 of
+ ptfield:
+ Result:=PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^;
+ ptconst:
+ Result:=LongBool(PropInfo^.StoredProc);
+ ptstatic,
+ ptvirtual:
+ begin
+ if (PropInfo^.PropProcs shr 4) and 3=ptstatic then
+ AMethod.Code:=PropInfo^.StoredProc
+ else
+ AMethod.Code:=ppointer(Pointer(Instance.ClassType)+Longint(PropInfo^.StoredProc))^;
+ AMethod.Data:=Instance;
+ Result:=TBooleanFunc(AMethod)();
+ end;
+ end;
+end;
+
+
+Procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
+{
+ Store Pointers to property information in the list pointed
+ to by proplist. PRopList must contain enough space to hold ALL
+ properties.
+}
+Var
+ TD : PTypeData;
+ TP : PPropInfo;
+ Count : Longint;
+begin
+ TD:=GetTypeData(TypeInfo);
+ // Get this objects TOTAL published properties count
+ TP:=aligntoptr(PPropInfo(aligntoptr((@TD^.UnitName+Length(TD^.UnitName)+1))));
+ Count:=PWord(TP)^;
+ // Now point TP to first propinfo record.
+ Inc(Pointer(TP),SizeOF(Word));
+ tp:=aligntoptr(tp);
+ While Count>0 do
+ begin
+ PropList^[0]:=TP;
+ Inc(Pointer(PropList),SizeOf(Pointer));
+ // Point to TP next propinfo record.
+ // Located at Name[Length(Name)+1] !
+ TP:=aligntoptr(PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1));
+ Dec(Count);
+ end;
+ // recursive call for parent info.
+ If TD^.Parentinfo<>Nil then
+ GetPropInfos (TD^.ParentInfo,PropList);
+end;
+
+Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
+Var
+ I : Longint;
+begin
+ I:=0;
+ While (I<Count) and (PI^.Name>PL^[I]^.Name) do
+ Inc(I);
+ If I<Count then
+ Move(PL^[I], PL^[I+1], (Count - I) * SizeOf(Pointer));
+ PL^[I]:=PI;
+end;
+
+Procedure InsertPropnosort (PL : PProplist;PI : PPropInfo; Count : longint);
+begin
+ PL^[Count]:=PI;
+end;
+
+Type TInsertProp = Procedure (PL : PProplist;PI : PPropInfo; Count : longint);
+
+//Const InsertProps : array[false..boolean] of TInsertProp = (InsertPropNoSort,InsertProp);
+
+{$ifdef ver1_0}
+Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; PropList : PPropList;Sorted : boolean):longint;
+{$else}
+Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; PropList : PPropList;Sorted : boolean = true):longint;
+{$endif}
+
+{
+ Store Pointers to property information OF A CERTAIN KIND in the list pointed
+ to by proplist. PRopList must contain enough space to hold ALL
+ properties.
+}
+
+Var
+ TempList : PPropList;
+ PropInfo : PPropinfo;
+ I,Count : longint;
+ DoInsertProp : TInsertProp;
+begin
+ if sorted then
+ DoInsertProp:=@InsertProp
+ else
+ DoInsertProp:=@InsertPropnosort;
+ Result:=0;
+ Count:=GetTypeData(TypeInfo)^.Propcount;
+ If Count>0 then
+ begin
+ GetMem(TempList,Count*SizeOf(Pointer));
+ Try
+ GetPropInfos(TypeInfo,TempList);
+ For I:=0 to Count-1 do
+ begin
+ PropInfo:=TempList^[i];
+ If PropInfo^.PropType^.Kind in TypeKinds then
+ begin
+ If (PropList<>Nil) then
+ DoInsertProp(PropList,PropInfo,Result);
+ Inc(Result);
+ end;
+ end;
+ finally
+ FreeMem(TempList,Count*SizeOf(Pointer));
+ end;
+ end;
+end;
+
+
+{$ifdef ver1_0}
+Function GetPropList(TypeInfo: PTypeInfo; var PropList: PPropList): SizeInt;
+{$else}
+Function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): SizeInt;
+{$endif}
+ begin
+ result:=GetTypeData(TypeInfo)^.Propcount;
+ if result>0 then
+ begin
+ getmem(PropList,result*sizeof(pointer));
+ GetPropInfos(TypeInfo,PropList);
+ end;
+ end;
+
+
+{ ---------------------------------------------------------------------
+ Property access functions
+ ---------------------------------------------------------------------}
+
+{ ---------------------------------------------------------------------
+ Ordinal properties
+ ---------------------------------------------------------------------}
+
+Function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Int64;
+type
+ TGetInt64ProcIndex=function(index:longint):Int64 of object;
+ TGetInt64Proc=function():Int64 of object;
+ TGetIntegerProcIndex=function(index:longint):longint of object;
+ TGetIntegerProc=function:longint of object;
+ TGetWordProcIndex=function(index:longint):word of object;
+ TGetWordProc=function:word of object;
+ TGetByteProcIndex=function(index:longint):Byte of object;
+ TGetByteProc=function:Byte of object;
+var
+ TypeInfo: PTypeInfo;
+ AMethod : TMethod;
+ DataSize: Integer;
+ OrdType: TOrdType;
+ Signed: Boolean;
+begin
+ Result:=0;
+
+ TypeInfo := PropInfo^.PropType;
+ Signed := false;
+ DataSize := 4;
+ case TypeInfo^.Kind of
+ tkChar, tkBool:
+ DataSize:=1;
+ tkWChar:
+ DataSize:=2;
+ tkEnumeration,
+ tkInteger:
+ begin
+ OrdType:=GetTypeData(TypeInfo)^.OrdType;
+ case OrdType of
+ otSByte,otUByte: DataSize := 1;
+ otSWord,otUWord: DataSize := 2;
+ end;
+ Signed := OrdType in [otSByte,otSWord,otSLong];
+ end;
+ tkInt64 :
+ begin
+ DataSize:=8;
+ Signed:=true;
+ end;
+ tkQword :
+ begin
+ DataSize:=8;
+ Signed:=false;
+ end;
+ end;
+
+ case (PropInfo^.PropProcs) and 3 of
+ ptfield:
+ if Signed then begin
+ case DataSize of
+ 1: Result:=PShortInt(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ 2: Result:=PSmallInt(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ 4: Result:=PLongint(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ 8: Result:=PInt64(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ end;
+ end else begin
+ case DataSize of
+ 1: Result:=PByte(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ 2: Result:=PWord(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ 4: Result:=PLongint(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ 8: Result:=PInt64(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ end;
+ end;
+ ptstatic,
+ ptvirtual :
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.GetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then begin
+ case DataSize of
+ 1: Result:=TGetByteProcIndex(AMethod)(PropInfo^.Index);
+ 2: Result:=TGetWordProcIndex(AMethod)(PropInfo^.Index);
+ 4: Result:=TGetIntegerProcIndex(AMethod)(PropInfo^.Index);
+ 8: result:=TGetInt64ProcIndex(AMethod)(PropInfo^.Index)
+ end;
+ end else begin
+ case DataSize of
+ 1: Result:=TGetByteProc(AMethod)();
+ 2: Result:=TGetWordProc(AMethod)();
+ 4: Result:=TGetIntegerProc(AMethod)();
+ 8: result:=TGetInt64Proc(AMethod)();
+ end;
+ end;
+ if Signed then begin
+ case DataSize of
+ 1: Result:=ShortInt(Result);
+ 2: Result:=SmallInt(Result);
+ end;
+ end;
+ end;
+ end;
+end;
+
+Procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;Value : Int64);
+type
+ TSetInt64ProcIndex=procedure(index:longint;i:Int64) of object;
+ TSetInt64Proc=procedure(i:Int64) of object;
+ TSetIntegerProcIndex=procedure(index,i:longint) of object;
+ TSetIntegerProc=procedure(i:longint) of object;
+var
+ DataSize: Integer;
+ AMethod : TMethod;
+begin
+ if PropInfo^.PropType^.Kind in [tkInt64,tkQword] then
+ DataSize := 8
+ else
+ DataSize := 4;
+ if PropInfo^.PropType^.Kind <> tkClass then
+ begin
+ { cut off unnecessary stuff }
+ case GetTypeData(PropInfo^.PropType)^.OrdType of
+ otSWord,otUWord:
+ begin
+ Value:=Value and $ffff;
+ DataSize := 2;
+ end;
+ otSByte,otUByte:
+ begin
+ Value:=Value and $ff;
+ DataSize := 1;
+ end;
+ end;
+ end;
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptfield:
+ case DataSize of
+ 1: PByte(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Byte(Value);
+ 2: PWord(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Word(Value);
+ 4:PLongint(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Longint(Value);
+ 8: PInt64(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+ end;
+ ptstatic,
+ ptvirtual :
+ begin
+ if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ if datasize=8 then
+ begin
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetInt64ProcIndex(AMethod)(PropInfo^.Index,Value)
+ else
+ TSetInt64Proc(AMethod)(Value);
+ end
+ else
+ begin
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetIntegerProcIndex(AMethod)(PropInfo^.Index,Value)
+ else
+ TSetIntegerProc(AMethod)(Value);
+ end;
+ end;
+ end;
+end;
+
+
+Function GetOrdProp(Instance: TObject; const PropName: string): Int64;
+begin
+ Result:=GetOrdProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetOrdProp(Instance: TObject; const PropName: string; Value: Int64);
+begin
+ SetOrdProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+Function GetEnumProp(Instance: TObject; Const PropInfo: PPropInfo): string;
+begin
+ Result:=GetEnumName(PropInfo^.PropType, GetOrdProp(Instance, PropInfo));
+end;
+
+
+Function GetEnumProp(Instance: TObject; const PropName: string): string;
+begin
+ Result:=GetEnumProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetEnumProp(Instance: TObject; const PropName: string; const Value: string);
+begin
+ SetEnumProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+Procedure SetEnumProp(Instance: TObject; Const PropInfo : PPropInfo; const Value: string);
+Var
+ PV : Longint;
+begin
+ If PropInfo<>Nil then
+ begin
+ PV:=GetEnumValue(PropInfo^.PropType, Value);
+ if (PV<0) then
+ raise EPropertyError.CreateFmt(SErrUnknownEnumValue, [Value]);
+ SetOrdProp(Instance, PropInfo,PV);
+ end;
+end;
+
+
+{ ---------------------------------------------------------------------
+ Int64 wrappers
+ ---------------------------------------------------------------------}
+
+Function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
+begin
+ Result:=GetOrdProp(Instance,PropInfo);
+end;
+
+
+procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo; const Value: Int64);
+begin
+ SetOrdProp(Instance,PropInfo,Value);
+end;
+
+
+Function GetInt64Prop(Instance: TObject; const PropName: string): Int64;
+begin
+ Result:=GetInt64Prop(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetInt64Prop(Instance: TObject; const PropName: string; const Value: Int64);
+begin
+ SetInt64Prop(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Set properties
+ ---------------------------------------------------------------------}
+
+Function GetSetProp(Instance: TObject; const PropName: string): string;
+begin
+ Result:=GetSetProp(Instance,PropName,False);
+end;
+
+
+Function GetSetProp(Instance: TObject; const PropName: string; Brackets: Boolean): string;
+begin
+ Result:=GetSetProp(Instance,FindPropInfo(Instance,PropName),Brackets);
+end;
+
+
+Function GetSetProp(Instance: TObject; const PropInfo: PPropInfo; Brackets: Boolean): string;
+begin
+ Result:=SetToString(PropInfo,GetOrdProp(Instance,PropInfo),Brackets);
+end;
+
+
+Procedure SetSetProp(Instance: TObject; const PropName: string; const Value: string);
+begin
+ SetSetProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+Procedure SetSetProp(Instance: TObject; const PropInfo: PPropInfo; const Value: string);
+begin
+ SetOrdProp(Instance,PropInfo,StringToSet(PropInfo,Value));
+end;
+
+{ ---------------------------------------------------------------------
+ Object properties
+ ---------------------------------------------------------------------}
+
+Function GetObjectProp(Instance: TObject; const PropName: string): TObject;
+begin
+ Result:=GetObjectProp(Instance,PropName,Nil);
+end;
+
+
+Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
+begin
+ Result:=GetObjectProp(Instance,FindPropInfo(Instance,PropName),MinClass);
+end;
+
+
+Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo): TObject;
+begin
+ Result:=GetObjectProp(Instance,PropInfo,Nil);
+end;
+
+
+Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo; MinClass: TClass): TObject;
+begin
+{$ifdef cpu64}
+ Result:=TObject(GetInt64Prop(Instance,PropInfo));
+{$else cpu64}
+ Result:=TObject(PtrInt(GetOrdProp(Instance,PropInfo)));
+{$endif cpu64}
+ If (MinClass<>Nil) and (Result<>Nil) Then
+ If Not Result.InheritsFrom(MinClass) then
+ Result:=Nil;
+end;
+
+
+Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject);
+begin
+ SetObjectProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+Procedure SetObjectProp(Instance: TObject; PropInfo : PPropInfo; Value: TObject);
+begin
+{$ifdef cpu64}
+ SetInt64Prop(Instance,PropInfo,Int64(Value));
+{$else cpu64}
+ SetOrdProp(Instance,PropInfo,Integer(Value));
+{$endif cpu64}
+end;
+
+
+Function GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
+begin
+ Result:=GetTypeData(FindPropInfo(Instance,PropName)^.PropType)^.ClassType;
+end;
+
+
+{ ---------------------------------------------------------------------
+ String properties
+ ---------------------------------------------------------------------}
+
+Function GetStrProp(Instance: TObject; PropInfo: PPropInfo): AnsiString;
+type
+ TGetShortStrProcIndex=function(index:longint):ShortString of object;
+ TGetShortStrProc=function():ShortString of object;
+ TGetAnsiStrProcIndex=function(index:longint):AnsiString of object;
+ TGetAnsiStrProc=function():AnsiString of object;
+var
+ AMethod : TMethod;
+begin
+ Result:='';
+ case Propinfo^.PropType^.Kind of
+{$ifdef HASWIDESTRING}
+ tkWString:
+ Result:=GetWideStrProp(Instance,PropInfo);
+{$endif HASWIDESTRING}
+ tkSString:
+ begin
+ case (PropInfo^.PropProcs) and 3 of
+ ptField:
+ Result := PShortString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
+ ptstatic,
+ ptvirtual :
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.GetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetShortStrProcIndex(AMethod)(PropInfo^.Index)
+ else
+ Result:=TGetShortStrProc(AMethod)();
+ end;
+ end;
+ end;
+ tkAString:
+ begin
+ case (PropInfo^.PropProcs) and 3 of
+ ptField:
+ Result := PAnsiString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
+ ptstatic,
+ ptvirtual :
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.GetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetAnsiStrProcIndex(AMethod)(PropInfo^.Index)
+ else
+ Result:=TGetAnsiStrProc(AMethod)();
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+Procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo; const Value : AnsiString);
+type
+ TSetShortStrProcIndex=procedure(index:longint;const s:ShortString) of object;
+ TSetShortStrProc=procedure(const s:ShortString) of object;
+ TSetAnsiStrProcIndex=procedure(index:longint;s:AnsiString) of object;
+ TSetAnsiStrProc=procedure(s:AnsiString) of object;
+var
+ AMethod : TMethod;
+begin
+ case Propinfo^.PropType^.Kind of
+{$ifdef HASWIDESTRING}
+ tkWString:
+ SetWideStrProp(Instance,PropInfo,Value);
+{$endif HASWIDESTRING}
+ tkSString:
+ begin
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptField:
+ PShortString(Pointer(Instance) + LongWord(PropInfo^.SetProc))^:=Value;
+ ptstatic,
+ ptvirtual :
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetShortStrProcIndex(AMethod)(PropInfo^.Index,Value)
+ else
+ TSetShortStrProc(AMethod)(Value);
+ end;
+ end;
+ end;
+ tkAString:
+ begin
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptField:
+ PAnsiString(Pointer(Instance) + LongWord(PropInfo^.SetProc))^:=Value;
+ ptstatic,
+ ptvirtual :
+ begin
+ if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetAnsiStrProcIndex(AMethod)(PropInfo^.Index,Value)
+ else
+ TSetAnsiStrProc(AMethod)(Value);
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+Function GetStrProp(Instance: TObject; const PropName: string): string;
+begin
+ Result:=GetStrProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetStrProp(Instance: TObject; const PropName: string; const Value: AnsiString);
+begin
+ SetStrProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+{$ifdef HASWIDESTRING}
+Function GetWideStrProp(Instance: TObject; const PropName: string): WideString;
+begin
+ Result:=GetWideStrProp(Instance, FindPropInfo(Instance, PropName));
+end;
+
+
+procedure SetWideStrProp(Instance: TObject; const PropName: string; const Value: WideString);
+begin
+ SetWideStrProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+Function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
+type
+ TGetWideStrProcIndex=function(index:longint):WideString of object;
+ TGetWideStrProc=function():WideString of object;
+var
+ AMethod : TMethod;
+begin
+ Result:='';
+ case Propinfo^.PropType^.Kind of
+ tkSString,tkAString:
+ Result:=GetStrProp(Instance,PropInfo);
+ tkWString:
+ begin
+ case (PropInfo^.PropProcs) and 3 of
+ ptField:
+ Result := PWideString(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
+ ptstatic,
+ ptvirtual :
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.GetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetWideStrProcIndex(AMethod)(PropInfo^.Index)
+ else
+ Result:=TGetWideStrProc(AMethod)();
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+Procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
+type
+ TSetWideStrProcIndex=procedure(index:longint;s:WideString) of object;
+ TSetWideStrProc=procedure(s:WideString) of object;
+var
+ AMethod : TMethod;
+begin
+ case Propinfo^.PropType^.Kind of
+ tkSString,tkAString:
+ SetStrProp(Instance,PropInfo,Value);
+ tkWString:
+ begin
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptField:
+ PWideString(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+ ptstatic,
+ ptvirtual :
+ begin
+ if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetWideStrProcIndex(AMethod)(PropInfo^.Index,Value)
+ else
+ TSetWideStrProc(AMethod)(Value);
+ end;
+ end;
+ end;
+ end;
+end;
+
+{$endif HASWIDESTRING}
+
+
+{ ---------------------------------------------------------------------
+ Float properties
+ ---------------------------------------------------------------------}
+
+function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
+type
+ TGetExtendedProc = function:Extended of object;
+ TGetExtendedProcIndex = function(Index: integer): Extended of object;
+ TGetDoubleProc = function:Double of object;
+ TGetDoubleProcIndex = function(Index: integer): Double of object;
+ TGetSingleProc = function:Single of object;
+ TGetSingleProcIndex = function(Index: integer):Single of object;
+{$ifdef HASCURRENCY}
+ TGetCurrencyProc = function : Currency of object;
+ TGetCurrencyProcIndex = function(Index: integer) : Currency of object;
+{$endif HASCURRENCY}
+var
+ AMethod : TMethod;
+begin
+ Result:=0.0;
+ case PropInfo^.PropProcs and 3 of
+ ptField:
+ Case GetTypeData(PropInfo^.PropType)^.FloatType of
+ ftSingle:
+ Result:=PSingle(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ ftDouble:
+ Result:=PDouble(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ ftExtended:
+ Result:=PExtended(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+ ftcomp:
+ Result:=PComp(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+{$ifdef HASCURRENCY}
+ ftcurr:
+ Result:=PCurrency(Pointer(Instance)+Ptrint(PropInfo^.GetProc))^;
+{$endif HASCURRENCY}
+ end;
+ ptStatic,
+ ptVirtual:
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.GetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+ AMethod.Data:=Instance;
+ Case GetTypeData(PropInfo^.PropType)^.FloatType of
+ ftSingle:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetSingleProc(AMethod)()
+ else
+ Result:=TGetSingleProcIndex(AMethod)(PropInfo^.Index);
+ ftDouble:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetDoubleProc(AMethod)()
+ else
+ Result:=TGetDoubleProcIndex(AMethod)(PropInfo^.Index);
+ ftExtended:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetExtendedProc(AMethod)()
+ else
+ Result:=TGetExtendedProcIndex(AMethod)(PropInfo^.Index);
+ {$ifdef HASCURRENCY}
+ ftCurr:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetCurrencyProc(AMethod)()
+ else
+ Result:=TGetCurrencyProcIndex(AMethod)(PropInfo^.Index);
+ {$endif HASCURRENCY}
+ end;
+ end;
+ end;
+end;
+
+
+Procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo; Value : Extended);
+type
+ TSetExtendedProc = procedure(const AValue: Extended) of object;
+ TSetExtendedProcIndex = procedure(Index: integer; const AValue: Extended) of object;
+ TSetDoubleProc = procedure(const AValue: Double) of object;
+ TSetDoubleProcIndex = procedure(Index: integer; const AValue: Double) of object;
+ TSetSingleProc = procedure(const AValue: Single) of object;
+ TSetSingleProcIndex = procedure(Index: integer; const AValue: Single) of object;
+{$ifdef HASCURRENCY}
+ TSetCurrencyProc = procedure(const AValue: Currency) of object;
+ TSetCurrencyProcIndex = procedure(Index: integer; const AValue: Currency) of object;
+{$endif HASCURRENCY}
+Var
+ AMethod : TMethod;
+begin
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptfield:
+ Case GetTypeData(PropInfo^.PropType)^.FloatType of
+ ftSingle:
+ PSingle(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+ ftDouble:
+ PDouble(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+ ftExtended:
+ PExtended(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^:=Value;
+{$ifdef FPC_COMP_IS_INT64}
+ ftComp:
+ PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=trunc(Value);
+{$else FPC_COMP_IS_INT64}
+ ftComp:
+ PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+{$endif FPC_COMP_IS_INT64}
+{$ifdef HASCURRENCY}
+ ftCurr:
+ PCurrency(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+{$endif HASCURRENCY}
+ end;
+ ptStatic,
+ ptVirtual:
+ begin
+ if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ Case GetTypeData(PropInfo^.PropType)^.FloatType of
+ ftSingle:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetSingleProc(AMethod)(Value)
+ else
+ TSetSingleProcIndex(AMethod)(PropInfo^.Index,Value);
+ ftDouble:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetDoubleProc(AMethod)(Value)
+ else
+ TSetDoubleProcIndex(AMethod)(PropInfo^.Index,Value);
+ ftExtended:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetExtendedProc(AMethod)(Value)
+ else
+ TSetExtendedProcIndex(AMethod)(PropInfo^.Index,Value);
+ {$ifdef HASCURRENCY}
+ ftCurr:
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetCurrencyProc(AMethod)(Value)
+ else
+ TSetCurrencyProcIndex(AMethod)(PropInfo^.Index,Value);
+ {$endif HASCURRENCY}
+ end;
+ end;
+ end;
+end;
+
+
+function GetFloatProp(Instance: TObject; const PropName: string): Extended;
+begin
+ Result:=GetFloatProp(Instance,FindPropInfo(Instance,PropName))
+end;
+
+
+Procedure SetFloatProp(Instance: TObject; const PropName: string; Value: Extended);
+begin
+ SetFloatProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Method properties
+ ---------------------------------------------------------------------}
+
+
+Function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
+type
+ TGetMethodProcIndex=function(Index: Longint): TMethod of object;
+ TGetMethodProc=function(): TMethod of object;
+var
+ value: PMethod;
+ AMethod : TMethod;
+begin
+ Result.Code:=nil;
+ Result.Data:=nil;
+ case (PropInfo^.PropProcs) and 3 of
+ ptfield:
+ begin
+ Value:=PMethod(Pointer(Instance)+Ptrint(PropInfo^.GetProc));
+ if Value<>nil then
+ Result:=Value^;
+ end;
+ ptstatic,
+ ptvirtual :
+ begin
+ if (PropInfo^.PropProcs and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.GetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.GetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ Result:=TGetMethodProcIndex(AMethod)(PropInfo^.Index)
+ else
+ Result:=TGetMethodProc(AMethod)();
+ end;
+ end;
+end;
+
+
+Procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo; const Value : TMethod);
+type
+ TSetMethodProcIndex=procedure(index:longint;p:PMethod) of object;
+ TSetMethodProc=procedure(p:PMethod) of object;
+var
+ AMethod : TMethod;
+begin
+ case (PropInfo^.PropProcs shr 2) and 3 of
+ ptfield:
+ PMethod(Pointer(Instance)+Ptrint(PropInfo^.SetProc))^ := Value;
+ ptstatic,
+ ptvirtual :
+ begin
+ if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
+ AMethod.Code:=PropInfo^.SetProc
+ else
+ AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Ptrint(PropInfo^.SetProc))^;
+ AMethod.Data:=Instance;
+ if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
+ TSetMethodProcIndex(AMethod)(PropInfo^.Index,@Value)
+ else
+ TSetMethodProc(AMethod)(@Value);
+ end;
+ end;
+end;
+
+
+Function GetMethodProp(Instance: TObject; const PropName: string): TMethod;
+begin
+ Result:=GetMethodProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetMethodProp(Instance: TObject; const PropName: string; const Value: TMethod);
+begin
+ SetMethodProp(Instance,FindPropInfo(Instance,PropName),Value);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Variant properties
+ ---------------------------------------------------------------------}
+
+Procedure CheckVariantEvent(P : Pointer);
+
+begin
+ If (P=Nil) then
+ Raise Exception.Create(SErrNoVariantSupport);
+end;
+
+Function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
+begin
+ CheckVariantEvent(Pointer(OnGetVariantProp));
+ Result:=OnGetVariantProp(Instance,PropInfo);
+end;
+
+
+Procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo; const Value: Variant);
+begin
+ CheckVariantEvent(Pointer(OnSetVariantProp));
+ OnSetVariantProp(Instance,PropInfo,Value);
+end;
+
+
+Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
+begin
+ Result:=GetVariantProp(Instance,FindPropInfo(Instance,PropName));
+end;
+
+
+Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
+begin
+ SetVariantprop(instance,FindpropInfo(Instance,PropName),Value);
+end;
+
+
+{ ---------------------------------------------------------------------
+ All properties through variant.
+ ---------------------------------------------------------------------}
+
+Function GetPropValue(Instance: TObject; const PropName: string): Variant;
+begin
+ Result:=GetPropValue(Instance,PropName,True);
+end;
+
+
+Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
+
+begin
+ CheckVariantEvent(Pointer(OnGetPropValue));
+ Result:=OnGetPropValue(Instance,PropName,PreferStrings)
+end;
+
+Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
+
+begin
+ CheckVariantEvent(Pointer(OnSetPropValue));
+ OnSetPropValue(Instance,PropName,Value);
+end;
+
+
+{ ---------------------------------------------------------------------
+ Easy access methods that appeared in Delphi 5
+ ---------------------------------------------------------------------}
+
+Function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
+begin
+ Result:=GetPropInfo(Instance,PropName)<>Nil;
+end;
+
+Function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
+begin
+ Result:=GetPropInfo(AClass,PropName)<>Nil;
+end;
+
+Function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean;
+begin
+ Result:=FindPropInfo(Instance,PropName)^.PropType^.Kind=TypeKind
+end;
+
+Function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean;
+begin
+ Result:=PropType(AClass,PropName)=TypeKind
+end;
+
+Function PropType(Instance: TObject; const PropName: string): TTypeKind;
+begin
+ Result:=FindPropInfo(Instance,PropName)^.PropType^.Kind;
+end;
+
+Function PropType(AClass: TClass; const PropName: string): TTypeKind;
+begin
+ Result:=FindPropInfo(AClass,PropName)^.PropType^.Kind;
+end;
+
+Function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
+begin
+ Result:=IsStoredProp(instance,FindPropInfo(Instance,PropName));
+end;
+
+end.
+{
+ $Log: typinfo.pp,v $
+ Revision 1.45 2005/04/16 09:24:29 michael
+ + Moved constants to rtlconsts and added callbacks for variant support
+
+ Revision 1.44 2005/04/14 17:43:07 michael
+ + Added getPropValue by Uberto Barbini
+
+ Revision 1.43 2005/04/05 06:44:25 marco
+ * Currency property patch from Dean Zobec
+
+ Revision 1.42 2005/04/03 11:50:58 marco
+ * patch for 3854 added. There are probably more places that need explicit
+ currency handling.
+
+ Revision 1.41 2005/03/14 21:15:52 florian
+ * fixed compilation on i386
+
+ Revision 1.40 2005/03/14 19:16:06 peter
+ * getordprop supports int64
+
+ Revision 1.39 2005/02/26 20:59:38 florian
+ * fixed 1.0.10 issue
+
+ Revision 1.38 2005/02/26 11:37:01 florian
+ + overload of GetPropList added
+
+ Revision 1.37 2005/02/22 12:14:56 marco
+ * getproplist sorted param added.
+
+ Revision 1.36 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.35 2005/02/08 16:10:29 florian
+ * TTOrdType -> TOrdType
+
+}
diff --git a/rtl/objpas/utf8bidi.pp b/rtl/objpas/utf8bidi.pp
new file mode 100644
index 0000000000..6d22ea29d6
--- /dev/null
+++ b/rtl/objpas/utf8bidi.pp
@@ -0,0 +1,473 @@
+{
+Author Mazen NEIFER
+Licence LGPL
+}
+unit UTF8BIDI;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ FreeBIDI;
+
+type
+ TUCS32Char = Cardinal;
+ TUCS16Char = Word;
+ TUTF8Char = String[4];
+ TUTF8String = UTF8String;
+
+{****************************Conversion routines*******************************}
+{Converts an UCS 16/32 bits charcater to UTF8 character}
+function UnicodeToUTF8(aChar:TUCS32Char):TUTF8Char;
+{Converts a wide char UCS 16 bits chcarcter to UTF8 character}
+function UnicodeToUTF8(aChar:WideChar):TUTF8Char;
+{Converts a wide char UCS 16 bits string to UTF8 character}
+function UnicodeToUTF8(const Src:TString):TUTF8String;
+{Converts an UTF8 character to UCS 32 bits character}
+function UTF8ToUCS32(const UTF8Char:TUTF8Char):TUCS32Char;
+{Converts an UTF8 character to UCS 16 bits character}
+function UTF8ToUCS16(const UTF8Char:TUTF8Char):TUCS16Char;
+{Converts an UTF8 string to UCS 16 bits string}
+function UTF8ToUnicode(const Src:TUTF8String):TString;
+{Converts an UTF8 string to a double byte string}
+function UTF8ToDoubleByteString(const UTF8Str:TUTF8String):String;
+function UTF8ToDoubleByte(UTF8Str:PChar; Len:Cardinal; DBStr:PByte):Cardinal;
+{****************************Logical aspects***********************************}
+{Returns the number of logical characters}
+function LLength(const UTF8Str:TUTF8String):Cardinal;
+{Converts visual position to logical position}
+function LPos(const UTF8Str:TUTF8String; vp:Integer; pDir:TDirection):Cardinal;
+{Returns character at a given logical position according to paragraph direction}
+function LCharOf(UTF8String:TUTF8String; lp:Integer):TUTF8Char;
+{****************************Visual aspects************************************}
+{Returns the number of visual characters}
+function VLength(const Src:TUTF8String; pDir:TDirection):Cardinal;
+{Converts a logical position to a visual position}
+function VPos(const UTF8Str:TUTF8String; lp:Integer; pDir, cDir:TDirection):Cardinal;
+{Returns character at a given visual position according to paragraph direction}
+function VCharOf(UTF8Str:TUTF8String; vp:Integer; dir:TDirection):TUTF8Char;
+{Inserts a string into an other paying attention of RTL/LTR direction}
+procedure VInsert(const Src:TUTF8String; var Dest:TUTF8String; vp:Integer; pDir:TDirection);
+{Deletes a string into an other paying attention of RTL/LTR direction}
+procedure VDelete(var str:TUTF8String; vp, len:Integer; pDir:TDirection);
+{****************************Helper routines***********************************}
+{Returns direction of a character}
+function DirectionOf(Character:TUTF8Char):TDirection;
+{Returns contextual direction of caracter in a string}
+function DirectionOf(UTF8String:TUTF8String; lp:Integer; pDir:TDirection):TDirection;
+{Inserts a char as if it was typed using keyboard in the most user friendly way.
+Returns the new cursor position after insersion depending on the new visual text}
+function InsertChar(Src:TUTF8Char; var Dest:TUTF8String; vp:Integer; pDir:TDirection):Integer;
+{Returns a table mapping each visual position to its logical position in an UTF8*
+string}
+function VisualToLogical(const UTF8String:TUTF8String; pDir:TDirection):TVisualToLogical;
+
+implementation
+
+function DumpStr(const s:TUTF8String):String;
+var
+ i:Integer;
+begin
+ Result := '';
+ for i:= 1 to Length(s) do
+ case s[i] of
+ #0..#127:
+ Result := Result + s[i];
+ else
+ Result := Result + '$' + HexStr(Ord(s[i]),2);
+ end;
+end;
+function ComputeCharLength(p:PChar):Cardinal;
+begin
+ if ord(p^)<%11000000
+ then
+{regular single byte character (#0 is a normal char, this is UTF8Charascal ;)}
+ Result:=1
+ else if ((ord(p^) and %11100000) = %11000000)
+ then
+ if (ord(p[1]) and %11000000) = %10000000 then
+ Result:=2
+ else
+ Result:=1
+ else if ((ord(p^) and %11110000) = %11100000)
+ then
+ if ((ord(p[1]) and %11000000) = %10000000)
+ and ((ord(p[2]) and %11000000) = %10000000)
+ then
+ Result:=3
+ else
+ Result:=1
+ else if ((ord(p^) and %11111000) = %11110000)
+ then
+ if ((ord(p[1]) and %11000000) = %10000000)
+ and ((ord(p[2]) and %11000000) = %10000000)
+ and ((ord(p[3]) and %11000000) = %10000000)
+ then
+ Result:=4
+ else
+ Result:=1
+ else
+ Result:=1
+end;
+
+{****************************Conversion routines*******************************}
+function UnicodeToUTF8(aChar:TUCS32Char):TUTF8Char;
+begin
+ case aChar of
+ 0..$7f:
+ begin
+ Result[1]:=char(aChar);
+ SetLength(UnicodeToUTF8,1);
+ end;
+ $80..$7ff:
+ begin
+ Result[1]:=char($c0 or (aChar shr 6));
+ Result[2]:=char($80 or (aChar and $3f));
+ SetLength(UnicodeToUTF8,2);
+ end;
+ $800..$ffff:
+ begin
+ SetLength(Result,3);
+ Result[1]:=char($e0 or (aChar shr 12));
+ Result[2]:=char($80 or ((aChar shr 6) and $3f));
+ Result[3]:=char($80 or (aChar and $3f));
+ end;
+ $10000..$1fffff:
+ begin
+ SetLength(UnicodeToUTF8,4);
+ Result[1]:=char($f0 or (aChar shr 18));
+ Result[2]:=char($80 or ((aChar shr 12) and $3f));
+ Result[3]:=char($80 or ((aChar shr 6) and $3f));
+ Result[4]:=char($80 or (aChar and $3f));
+ end;
+ else
+ SetLength(UnicodeToUTF8, 0);
+ end;
+end;
+
+function UnicodeToUTF8(aChar:WideChar):TUTF8Char;
+var
+ c:TUCS16Char absolute aChar;
+begin
+ case c of
+ 0..$7f:
+ begin
+ Result[1]:=char(c);
+ SetLength(UnicodeToUTF8,1);
+ end;
+ $80..$7ff:
+ begin
+ Result[1]:=char($c0 or (c shr 6));
+ Result[2]:=char($80 or (c and $3f));
+ SetLength(UnicodeToUTF8,2);
+ end;
+ else
+ SetLength(UnicodeToUTF8, 0);
+ end;
+end;
+
+function UnicodeToUTF8(const Src:TString):TUTF8String;
+var
+ vp:Integer;
+begin
+ vp := 1;
+ Result := '';
+ for vp := 1 to Length(Src) do
+ Result += UnicodeToUTF8(Src[vp]);
+end;
+
+function UTF8ToUCS32(const UTF8Char:TUTF8Char):TUCS32Char;
+begin
+ case ComputeCharLength(@UTF8Char[1]) of
+ 1:{regular single byte character (#0 is a normal char, this is UTF8Charascal ;)}
+ Result := ord(UTF8Char[1]);
+ 2:
+ Result := ((ord(UTF8Char[1]) and %00011111) shl 6)
+ or (ord(UTF8Char[2]) and %00111111);
+ 3:
+ Result := ((ord(UTF8Char[1]) and %00011111) shl 12)
+ or ((ord(UTF8Char[1]) and %00111111) shl 6)
+ or (ord(UTF8Char[2]) and %00111111);
+ 4:
+ Result := ((ord(UTF8Char[1]) and %00011111) shl 18)
+ or ((ord(UTF8Char[2]) and %00111111) shl 12)
+ or ((ord(UTF8Char[3]) and %00111111) shl 6)
+ or (ord(UTF8Char[4]) and %00111111);
+ else
+ Result := $FFFFFFFF;
+ end
+end;
+
+function UTF8ToUCS16(const UTF8Char:TUTF8Char):TUCS16Char;
+begin
+ case Length(UTF8Char) of
+ 1:{regular single byte character (#0 is a normal char, this is UTF8Charascal ;)}
+ Result := ord(UTF8Char[1]);
+ 2:
+ Result := ((ord(UTF8Char[1]) and %00011111) shl 6)
+ or (ord(UTF8Char[2]) and %00111111);
+ else
+ Result := $FFFF;
+ end;
+end;
+
+
+function UTF8ToUnicode(const Src:TUTF8String):TString;
+var
+ lp, vp:Integer;
+ c:TUTF8Char;
+begin
+ lp := 1;
+ vp := 0;
+ SetLength(Result, Length(Src));
+ while lp <= Length(Src) do
+ begin
+ vp += 1;
+ c := LCharOf(Src, lp);
+ Result[vp] := WideChar(UTF8ToUCS16(c));
+ lp += Length(c);
+ end;
+ SetLength(Result, vp);
+end;
+
+function UTF8ToDoubleByteString(const UTF8Str: TUTF8String): string;
+var
+ Len: Integer;
+begin
+ Len:=VLength(UTF8Str, drLTR);
+ SetLength(Result,Len*2);
+ if Len=0 then exit;
+ UTF8ToDoubleByte(PChar(UTF8Str),length(UTF8Str),PByte(Result));
+end;
+
+function UTF8ToDoubleByte(UTF8Str: PChar; Len:Cardinal; DBStr: PByte):Cardinal;
+var
+ SrcPos: PChar;
+ CharLen: LongInt;
+ DestPos: PByte;
+ u: Cardinal;
+begin
+ SrcPos:=UTF8Str;
+ DestPos:=DBStr;
+ Result:=0;
+ while Len>0 do begin
+ u:=UTF8ToUCS32(SrcPos);
+ DestPos^:=byte((u shr 8) and $ff);
+ inc(DestPos);
+ DestPos^:=byte(u and $ff);
+ inc(DestPos);
+ inc(SrcPos,CharLen);
+ dec(Len,CharLen);
+ inc(Result);
+ end;
+end;
+
+{****************************Logical aspects***********************************}
+function LLength(const UTF8Str:TUTF8String):Cardinal;
+begin
+ Result := Length(UTF8Str);
+end;
+
+function LPos(const UTF8Str:TUTF8String; vp:Integer; pDir:TDirection):Cardinal;
+var
+ v2l:TVisualToLogical;
+ i:integer;
+begin
+ v2l := VisualToLogical(UTF8Str, pDir);
+ if vp <= v2l[0]
+ then
+ Result := v2l[vp]
+ else
+ Result := Length(UTF8Str) + 1;
+end;
+
+function LCharOf(UTF8String:TUTF8String; lp:Integer):TUTF8Char;
+begin
+ if lp > Length(UTF8String)
+ then
+ Exit('');
+ while(lp > 0) and ((Ord(UTF8String[lp]) and $F0) in [$80..$B0]) do
+begin
+ Dec(lp);
+end;
+ if lp = 0
+ then
+ Exit('');
+ Move(UTF8String[lp], Result[1], SizeOf(TUTF8Char) - 1);
+ SetLength(Result, ComputeCharLength(@Result[1]));
+end;
+{****************************Visual aspects************************************}
+function VLength(const Src:TUTF8String; pDir:TDirection):Cardinal;
+begin
+ Result := FreeBIDI.VLength(UTF8ToUnicode(Src), pDir);
+end;
+
+function VPos(const UTF8Str:TUTF8String; lp:Integer; pDir, cDir:TDirection):Cardinal;
+var
+ v2l:TVisualToLogical;
+ vp:Integer;
+begin
+ v2l := VisualToLogical(UTF8Str, pDir);
+ for vp := 1 to v2l[0] do
+ if lp = v2l[vp]
+ then
+ begin
+ Exit(vp);
+ end;
+ Result := v2l[0];
+end;
+
+function VPos(UTF8Char:PChar; Len:integer; BytePos:integer):Cardinal;
+begin
+end;
+
+
+function VCharOf(UTF8Str:TUTF8String; vp:Integer; dir:TDirection):TUTF8Char;
+var
+ CharLen: LongInt;
+begin
+ Result:=LCharOf(UTF8Str,LPos(UTF8Str, vp, dir));
+end;
+
+{****************************Helper routines***********************************}
+function DirectionOf(Character:TUTF8Char):TDirection;
+begin
+ case Character[1] of
+ #9,#32,
+ '/',
+ '{','}',
+ '[',']',
+ '(',')':
+ Result := drNONE;
+ #$D8,#$D9:
+ Result := drRTL;
+ else
+ Result := drLTR;
+ end;
+end;
+
+function DirectionOf(UTF8String:TUTF8String; lp:Integer; pDir:TDirection):TDirection;
+var
+ c:TUTF8Char;
+ lDir,rDir:TDirection;
+ p:Integer;
+begin
+ if(lp <= 0)
+ then
+ lp := 1;
+{Seek for proper character direction}
+ c := LCharOf(UTF8String, lp);
+ lDir := DirectionOf(c);
+{Seek for left character direction if it is neutral}
+ p := lp;
+ while(p > 1) and (lDir = drNONE)do
+ begin
+ c := LCharOf(UTF8String, p - 1);
+ lDir := DirectionOf(c);
+ p := p - Length(c);
+ end;
+{Seek for right character direction if it is neutral}
+ p := lp;
+ repeat
+ c := LCharOf(UTF8String, p);
+ rDir := DirectionOf(c);
+ p := p + Length(c);
+ until(p > Length(UTF8String)) or (rDir <> drNONE);
+ if(lDir = rDir)
+ then
+ Result := rDir
+ else
+ Result := pDir;
+end;
+
+function VisualToLogical(const UTF8String:TUTF8String; pDir:TDirection):TVisualToLogical;
+ procedure Insert(value:Byte; var v2l:TVisualToLogical; InsPos:Byte);
+ var
+ l:Byte;
+ begin
+ if v2l[0] < 255
+ then
+ Inc(InsPos);
+ if InsPos > v2l[0]
+ then
+ InsPos := v2l[0];
+ for l := v2l[0] downto InsPos do
+ v2l[l] := v2l[l-1];
+ v2l[InsPos] := Value;
+ end;
+var
+ lp, vp : Integer;
+ cDir,lDir:TDirection;
+ Character:TUTF8Char;
+i:Integer;
+begin
+ Result[0] := 0;
+ lp := 1;
+ vp := 1;
+ lDir := drNONE;
+ while lp <= Length(UTF8String) do
+ begin
+ Character := LCharOf(UTF8String, lp);
+ cDir := DirectionOf(UTF8String, lp, pDir);
+ Inc(Result[0]);
+ case cDir of
+ drRTL:
+ begin
+ lDir := drRTL;
+ end;
+ drLTR:
+ begin
+ lDir := drLTR;
+ vp := Result[0];
+ end;
+ else
+ vp := Result[0];
+ end;
+ Insert(lp, Result, vp);
+ Inc(lp, Length(Character));
+ end;
+end;
+
+function InsertChar(Src:TUTF8Char; var Dest:TUTF8String; vp:Integer; pDir:TDirection):Integer;
+var
+ temp:TString;
+ c:TCharacter;
+begin
+ temp := UTF8ToUnicode(Dest);
+ c := WideChar(UTF8ToUCS16(Src));
+ Result := FreeBIDI.InsertChar(c, temp, vp, pDir);
+ Dest := UnicodeToUTF8(temp);
+end;
+
+procedure VInsert(const Src:TUTF8String;var Dest:TUTF8String; vp:Integer; pDir:TDirection);
+ function VStr(const Src:TUTF8String; pDir:TDirection):TUTF8String;
+ var
+ v2lSrc:TVisualToLogical;
+ i:Integer;
+ begin
+ v2lSrc := VisualToLogical(Src,pDir);
+ Result := '';
+ for i := 1 to v2lSrc[0] do
+ Result := Result + LCharOf(Src,v2lSrc[i]);
+ end;
+var
+ vSrc,vDest:TUTF8String;
+begin
+ vSrc := VStr(Src,pDir);
+ vDest := VStr(Dest,pDir);
+ Insert(vSrc, vDest, vp);
+ Dest := VStr(vDest, pDir);
+end;
+
+procedure VDelete(var str:TUTF8String; vp, len:Integer; pDir:TDirection);
+var
+ temp:TString;
+begin
+ temp := UTF8ToUnicode(str);
+ FreeBIDI.VDelete(temp, vp, len, pDir);
+ str := UnicodeToUTF8(temp);
+end;
+
+end.
+
diff --git a/rtl/objpas/varutilh.inc b/rtl/objpas/varutilh.inc
new file mode 100644
index 0000000000..26d5072a92
--- /dev/null
+++ b/rtl/objpas/varutilh.inc
@@ -0,0 +1,113 @@
+{
+ $Id: varutilh.inc,v 1.10 2005/02/25 14:39:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000,2001 by the Free Pascal development team
+
+ This include file contains the implementation for variants
+ support in FPC as far as it is part of the system unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+
+ **********************************************************************}
+
+
+{$ifdef HASVARIANT}
+Type
+ EVarianterror = Class(Exception)
+ ErrCode : longint;
+ Constructor CreateCode(Code : Longint);
+ end;
+
+{ Variant functions }
+function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
+function VariantClear(var Varg: TVarData): HRESULT; stdcall;
+function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
+function VariantCopyInd(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;
+function VariantInit(var Varg: TVarData): HRESULT; stdcall;
+
+{ Variant array functions }
+
+function SafeArrayAccessData(psa: PVarArray; var ppvdata: Pointer): HRESULT; stdcall;
+function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayAllocDescriptor(DimCount: SizeInt; var psa: PVarArray): HRESULT; stdcall;
+function SafeArrayCopy(psa: PVarArray; var psaout: PVarArray): HRESULT; stdcall;
+function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT; stdcall;
+function SafeArrayCreate(VarType, Dim: SizeInt; const Bounds: TVarArrayBoundArray): PVarArray; stdcall;
+function SafeArrayDestroy(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayDestroyData(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayGetDim(psa: PVarArray): SizeInt; stdcall;
+function SafeArrayGetElemsize(psa: PVarArray): LongWord; stdcall;
+function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray; Data: Pointer): HRESULT; stdcall;
+function SafeArrayGetLBound(psa: PVarArray; Dim: SizeInt; var LBound: SizeInt): HRESULT; stdcall;
+function SafeArrayGetUBound(psa: PVarArray; Dim: SizeInt; var UBound: SizeInt): HRESULT; stdcall;
+function SafeArrayLock(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray; var Address: Pointer): HRESULT; stdcall;
+function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray; const Data: Pointer): HRESULT; stdcall;
+function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;
+function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;
+function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;
+
+{ Conversion routines NOT in windows oleaut }
+
+Function VariantToSmallInt(Const VargSrc : TVarData) : SmallInt;
+Function VariantToLongint(Const VargSrc : TVarData) : Longint;
+Function VariantToShortint(Const VargSrc : TVarData) : ShortInt;
+Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
+Function VariantToSingle(Const VargSrc : TVarData) : Single;
+Function VariantToDouble(Const VargSrc : TVarData) : Double;
+Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
+Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
+Function VariantToBoolean(Const VargSrc : TVarData) : Boolean;
+Function VariantToByte(Const VargSrc : TVarData) : Byte;
+Function VariantToInt64(Const VargSrc : TVarData ) : Int64;
+Function VariantToQWord(Const VargSrc : TVarData ) : Qword;
+Function VariantToWideString(Const VargSrc : TVarData) : WideString;
+Function VariantToAnsiString(Const VargSrc : TVarData) : AnsiString;
+Function VariantToShortString(Const VargSrc : TVarData) : ShortString;
+
+{Debug routines }
+Procedure DumpVariant(Const VArgSrc : TVarData);
+Procedure DumpVariant(Var F : Text; Const VArgSrc : TVarData);
+
+
+// Names match the ones in Borland varutils unit.
+
+const
+ VAR_OK = HRESULT($00000000);
+ VAR_PARAMNOTFOUND = HRESULT($80020004);
+ VAR_TYPEMISMATCH = HRESULT($80020005);
+ VAR_BADVARTYPE = HRESULT($80020008);
+ VAR_EXCEPTION = HRESULT($80020009);
+ VAR_OVERFLOW = HRESULT($8002000A);
+ VAR_BADINDEX = HRESULT($8002000B);
+ VAR_ARRAYISLOCKED = HRESULT($8002000D);
+ VAR_NOTIMPL = HRESULT($80004001);
+ VAR_OUTOFMEMORY = HRESULT($8007000E);
+ VAR_INVALIDARG = HRESULT($80070057);
+ VAR_UNEXPECTED = HRESULT($8000FFFF);
+
+ ARR_NONE = $0000;
+ ARR_FIXEDSIZE = $0010;
+ ARR_OLESTR = $0100;
+ ARR_UNKNOWN = $0200;
+ ARR_DISPATCH = $0400;
+ ARR_VARIANT = $0800;
+
+{$endif HASVARIANT}
+
+{
+ $Log: varutilh.inc,v $
+ Revision 1.10 2005/02/25 14:39:31 peter
+ * 64bit fixes
+
+ Revision 1.9 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/objpas/varutils.inc b/rtl/objpas/varutils.inc
new file mode 100644
index 0000000000..f7ccb25939
--- /dev/null
+++ b/rtl/objpas/varutils.inc
@@ -0,0 +1,760 @@
+{
+ $Id: varutils.inc,v 1.24 2005/03/28 21:52:43 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team
+
+ Variant routines for non-windows oses.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef HASVARIANT}
+{ ---------------------------------------------------------------------
+ Some general stuff: Error handling and so on.
+ ---------------------------------------------------------------------}
+
+
+
+Procedure SetUnlockResult (P : PVarArray; Res : HResult);
+
+begin
+ If Res=VAR_OK then
+ Res:=SafeArrayUnlock(P)
+ else
+ SafeArrayUnlock(P);
+end;
+
+Procedure MakeWideString (Var P : PWideChar; W : WideString);
+
+begin
+ P:=PWideChar(W);
+end;
+
+Procedure CopyAsWideString (Var PDest : PWideChar; PSource : PWideChar);
+
+begin
+ WideString(Pointer(PDest)):=WideString(Pointer(PSource));
+end;
+
+{ ---------------------------------------------------------------------
+ Basic variant handling.
+ ---------------------------------------------------------------------}
+
+function VariantInit(var Varg: TVarData): HRESULT;stdcall;
+begin
+ With Varg do
+ begin
+ FillChar(VBytes, SizeOf(VBytes), 0);
+ VType:=varEmpty;
+ end;
+ Result:=VAR_OK;
+end;
+
+function VariantClear(var Varg: TVarData): HRESULT;stdcall;
+begin
+ With Varg do
+ if (VType and varArray)=varArray then
+ begin
+ Exit(SafeArrayDestroy(VArray))
+ end
+ else
+ begin
+ if (VType and varByRef) = 0 then
+ case VType of
+ varEmpty, varNull, varSmallint, varInteger, varSingle, varDouble, varWord,
+ varCurrency, varDate, varError, varBoolean, varByte,VarShortInt,
+ varInt64, VarLongWord,VarQWord:
+ ;
+ varOleStr:
+ WideString(Pointer(VOleStr)):='';
+ varDispatch,
+ varUnknown:
+ iinterface(vunknown):=nil;
+ else
+ exit(VAR_BADVARTYPE)
+ end;
+ end;
+ Result:=VariantInit(Varg);
+end;
+
+function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT;stdcall;
+begin
+ if @VargSrc = @VargDest then
+ Exit(VAR_OK);
+ Result:=VariantClear(VargDest);
+ if Result<>VAR_OK then
+ exit;
+ With VargSrc do
+ begin
+ if (VType and varArray) <> 0 then
+ Result:=SafeArrayCopy(VArray,VargDest.VArray)
+ else
+ begin
+ if (VType and varByRef) <> 0 then
+ VArgDest.VPointer:=VPointer
+ else
+ case (VType and varTypeMask) of
+ varEmpty, varNull:;
+ varSmallint, varInteger, varSingle, varDouble, varCurrency, varWord,
+ varDate, varError, varBoolean, varByte,VarShortInt,
+ varInt64, VarLongWord,VarQWord:
+ Move(VBytes, VargDest.VBytes, SizeOf(VargDest.VBytes));
+ varOleStr:
+ CopyAsWideString(VargDest.VOleStr,VOleStr);
+ varDispatch:
+ IUnknown(VargDest.vdispatch):=IUnknown(VargSrc.vdispatch);
+ varUnknown:
+ IUnknown(VargDest.vunknown):=IUnknown(VargSrc.vunknown);
+ else
+ Exit(VAR_BADVARTYPE);
+ end;
+ end;
+ VargDest.VType:=VType;
+ end;
+end;
+
+function VariantCopyInd(var VargDest: TVarData; const VargSrc: TVarData): HRESULT;stdcall;
+
+begin
+ if (VargSrc.VType and varByRef) = 0 then
+ Exit(VariantCopy(VargDest, VargSrc));
+ With VargSrc do
+ begin
+ if (VType and varArray) <> 0 then
+ Exit(VAR_INVALIDARG);
+ case (VType and varTypeMask) of
+ varEmpty, varNull:;
+ varSmallint : VargDest.VSmallInt:=PSmallInt(VPointer)^;
+ varInteger : VargDest.VInteger:=PLongint(VPointer)^;
+ varSingle : VargDest.VSingle:=PSingle(VPointer)^;
+ varDouble : VargDest.VDouble:=PDouble(VPointer)^;
+ varCurrency : VargDest.VCurrency:=PCurrency(VPointer)^;
+ varDate : VargDest.VDate:=PDate(VPointer)^;
+ varBoolean : VargDest.VBoolean:=PWordBool(VPointer)^;
+ varError : VargDest.VError:=PError(VPointer)^;
+ varByte : VargDest.VByte:=PByte(VPointer)^;
+ varWord : VargDest.VWord:=PWord(VPointer)^;
+ VarShortInt : VargDest.VShortInt:=PShortInt(VPointer)^;
+ VarInt64 : VargDest.VInt64:=PInt64(VPointer)^;
+ VarLongWord : VargDest.VLongWord:=PCardinal(VPointer)^;
+ VarQWord : VargDest.VQWord:=PQWord(VPointer)^;
+ varVariant : Variant(VargDest):=Variant(PVarData(VPointer)^);
+ varOleStr : CopyAsWideString(VargDest.VOleStr,PVarData(VPointer)^.VoleStr);
+ varDispatch,
+ varUnknown : NoInterfaces;
+ else
+ Exit(VAR_BADVARTYPE);
+ end;
+ VargDest.VType:=VType and VarTypeMask;
+ end;
+ Result:=VAR_OK;
+end;
+
+Function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData;
+ LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;
+var
+ Tmp : TVarData;
+begin
+ if ((VarType and varArray) <> 0) or
+ ((VargSrc.VType and varArray) <> 0) or
+ ((VarType and varByRef) <> 0) then
+ Exit(VAR_INVALIDARG);
+ Result:=VariantCopyInd(Tmp, VargSrc);
+ if Result = VAR_OK then
+ try
+ Result:=VariantClear(VargDest);
+ {$RANGECHECKS ON}
+ if Result = VAR_OK then
+ try
+ case Vartype of
+ varSmallInt : VargDest.VSmallInt:=VariantToSmallInt(Tmp);
+ varInteger : VargDest.VInteger:=VariantToLongint(Tmp);
+ varSingle : VargDest.VSingle:=VariantToSingle(Tmp);
+ varDouble : VargDest.VDouble:=VariantToDouble(Tmp);
+ varCurrency : VargDest.VCurrency:=VariantToCurrency(Tmp);
+ varDate : VargDest.VDate:=VariantToDate(tmp);
+ varOleStr : MakeWideString(VargDest.VoleStr, VariantToWideString(tmp));
+ varDispatch : Result:=VAR_TYPEMISMATCH;
+ varUnknown : Result:=VAR_TYPEMISMATCH;
+ varBoolean : VargDest.VBoolean:=VariantToBoolean(Tmp);
+ varByte : VargDest.VByte:=VariantToByte(Tmp);
+ VarShortInt : VargDest.VShortInt:=VariantToShortInt(Tmp);
+ VarInt64 : VargDest.Vint64:=VariantToInt64(Tmp);
+ VarLongWord : VargDest.VLongWord:=VariantToCardinal(Tmp);
+ VarQWord : VargDest.VQWord:=VariantToQword(tmp);
+ else
+ Result:=VAR_BADVARTYPE;
+ end;
+ If Result = VAR_OK then
+ VargDest.VType:=VarType;
+ except
+ On E : EVariantError do
+ Result:=E.ErrCode;
+ else
+ Result:=VAR_INVALIDARG;
+ end;
+ finally
+ VariantClear(Tmp);
+ end;
+end;
+
+{ ---------------------------------------------------------------------
+ Variant array support
+ ---------------------------------------------------------------------}
+
+Function CheckArrayUnlocked (psa : PVarArray) : HResult;
+
+begin
+ If psa^.LockCount = 0 Then
+ Result:=VAR_OK
+ else
+ Result:=VAR_ARRAYISLOCKED;
+end;
+
+Function CheckVarArray(psa: PVarArray ): HRESULT;
+
+begin
+ If psa=nil then
+ Result:=VAR_INVALIDARG
+ else
+ Result:=VAR_OK;
+end;
+
+Function SafeArrayCalculateElementAddress(psa: PVarArray; aElement: SizeInt): Pointer;
+
+begin
+ Result:=Pointer(psa^.Data)+(aElement*psa^.ElementSize);
+end;
+
+Function CheckVarArrayAndCalculateAddress(psa: PVarArray;
+ Indices: PVarArrayCoorArray; var Address: Pointer; Lockit: Boolean): HRESULT;
+
+ Function CountElements(D: Longint): Longint;
+ begin
+ if (D<psa^.DimCount) then
+ Result:=CountElements(D+1)+psa^.Bounds[D-1].ElementCount
+ else
+ Result:=1;
+ end;
+
+var
+ LB,HB,I,Count : LongInt;
+
+begin
+ Result:=CheckVarArray(psa);
+ Address:=nil;
+ Count:=0;
+ If Result<>VAR_OK then
+ exit;
+ for I:=1 to psa^.DimCount do
+ begin
+ LB:=psa^.Bounds[I-1].LowBound;
+ HB:=LB+psa^.Bounds[I-1].ElementCount;
+ if (LB=HB) or ((Indices^[I-1]< LB) or(Indices^[I-1]>HB)) then
+ Exit(VAR_BADINDEX);
+ Count:=Count+(Indices^[I-1]-LB)*CountElements(I+1);
+ end;
+ Address:=SafeArrayCalculateElementAddress(psa, Count);
+ if LockIt then
+ Result:=SafeArrayLock(psa);
+end;
+
+Function SafeArrayElementTotal(psa: PVarArray): Integer;
+
+var
+ I: Integer;
+
+begin
+ Result:=1;
+ With psa^ do
+ for I:=0 to DimCount - 1 do
+ Result:=Result*Bounds[I].ElementCount;
+end;
+
+type
+ TVariantArrayType = (vatNormal, vatInterface, vatWideString);
+
+Function VariantArrayType(psa: PVarArray): TVariantArrayType;
+
+begin
+ if ((psa^.Flags and ARR_DISPATCH) <> 0) or
+ ((psa^.Flags and ARR_UNKNOWN) <> 0) then
+ Result:=vatInterface
+ else if (psa^.Flags AND ARR_OLESTR) <> 0 then
+ Result:=vatWideString
+ else
+ Result:=vatNormal;
+end;
+
+Function SafeArrayClearDataSpace(psa: PVarArray; WipeBytes: Boolean {= True}): HRESULT;
+
+var
+ vat: TVariantArrayType;
+
+begin
+ try
+ vat:=VariantArrayType(psa);
+ case vat of
+ vatNormal : FillChar(psa^.Data^,
+ SafeArrayElementTotal(psa)*psa^.ElementSize,
+ 0);
+ vatInterface : NoInterfaces;
+ vatWideString : NoWidestrings;
+ end;
+ Result:=VAR_OK;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError (E);
+ end;
+end;
+
+Function SafeArrayCopyDataSpace(psa, psaOut: PVarArray): HRESULT;
+var
+ vVargSrc, vTarget: Pointer;
+ vat: TVariantArrayType;
+begin
+ try
+ vat:=VariantArrayType(psa);
+ case vat of
+ vatNormal: Move(psa^.Data^,
+ psaOut^.Data^,
+ SafeArrayElementTotal(psa)*psa^.ElementSize);
+ vatInterface : NoInterfaces; // Copy element per element...
+ vatWideString: NoWideStrings; // here also...
+ end;
+ Result:=VAR_OK;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+end;
+
+Type
+ TVartypes = varEmpty..varByte;
+
+Const
+ Supportedpsas : set of TVarTypes =
+ [varSmallint,varInteger,varSingle,varDouble,varCurrency,varDate,varOleStr,
+ varDispatch,varError,varBoolean,varVariant,varUnknown,varByte];
+ psaElementSizes : Array [varEmpty..varByte] of Byte =
+ (0,0,2,4,4,8,8,8,4,4,4,2,16,4,0,0,0,1);
+ psaElementFlags : Array [varEmpty..varByte] of Longint =
+ (ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE,
+ ARR_OLESTR,ARR_DISPATCH,ARR_NONE,ARR_NONE,ARR_NONE,ARR_UNKNOWN,
+ ARR_NONE,ARR_NONE,ARR_NONE,ARR_NONE);
+
+Function SafeArrayCreate(VarType, Dim: SizeInt; const Bounds: TVarArrayBoundArray): PVarArray;stdcall;
+ var
+ res : HRESULT;
+ I : SizeInt;
+ begin
+ Result:=nil;
+ if Not (VarType in Supportedpsas) Then
+ exit;
+ Res:=SafeArrayAllocDescriptor(Dim, Result);
+ if Res<>VAR_OK then
+ exit;
+ Result^.DimCount:=Dim;
+ Result^.Flags:=psaElementFlags[VarType];
+ Result^.ElementSize:=psaElementSizes[VarType];
+ for i:=0 to Dim-1 do
+ begin
+ Result^.Bounds[i].LowBound:=Bounds[Dim-I-1].LowBound;
+ Result^.Bounds[I].ElementCount:=Bounds[Dim-I-1].ElementCount;
+ end;
+ res:=SafeArrayAllocData(Result);
+ if res<>VAR_OK then
+ begin
+ SafeArrayDestroyDescriptor(Result);
+ Result:=nil;
+ end;
+ end;
+
+
+Function SafeArrayAllocDescriptor(DimCount: SizeInt; var psa: PVarArray): HRESULT;stdcall;
+begin
+ try
+ psa:=GetMem(SizeOf(TVarArray) + SizeOf(TVarArrayBound) * (DimCount - 1));
+ Result:=VAR_OK;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+end;
+
+Function SafeArrayAllocData(psa: PVarArray): HRESULT;stdcall;
+begin
+ try
+ With psa^ do
+ Data:=GetMem(SafeArrayElementTotal(psa)*ElementSize);
+ Result:=VAR_OK;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+end;
+
+Function SafeArrayDestroy(psa: PVarArray): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<> VAR_OK then
+ exit;
+ Result:=CheckArrayUnlocked(psa);
+ if Result<> VAR_OK then
+ exit;
+ Result:=SafeArrayDestroyData(psa);
+ if Result<>VAR_OK then
+ exit;
+ Result:=SafeArrayDestroyDescriptor(psa);
+end;
+
+Function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ Result:=CheckArrayUnlocked(psa);
+ if Result<> VAR_OK then
+ exit;
+ try
+ FreeMem(psa);
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+end;
+
+Function SafeArrayDestroyData(psa: PVarArray): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ Result:=CheckArrayUnlocked(psa);
+ if Result<> VAR_OK then
+ exit;
+ try
+ Result:=SafeArrayClearDataSpace(psa, False);
+ if (Result=VAR_OK) and ((psa^.Flags and ARR_FIXEDSIZE)=0) then
+ begin
+ FreeMem(psa^.Data);
+ psa^.Data:=nil;
+ end;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+end;
+
+Function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT;stdcall;
+
+var
+ vat: TVariantArrayType;
+ i, D,j,count : Integer;
+ P : Pointer;
+
+begin
+ Result:=CheckVarArray(psa);
+ if Result <> VAR_OK then
+ exit;
+ if (psa^.Flags and ARR_FIXEDSIZE) <> 0 then
+ Exit(VAR_INVALIDARG);
+ Result:=SafeArrayLock(psa);
+ if Result<>VAR_OK then
+ exit;
+ try
+ D:=NewBound.ElementCount - psa^.Bounds[0].ElementCount;
+ for i:=1 to psa^.DimCount - 1 do
+ D:=D*psa^.Bounds[i].ElementCount;
+ if D<>0 then
+ begin
+ Count:=SafeArrayElementTotal(psa);
+ if D<0 then
+ begin
+ vat:=VariantArrayType(psa);
+ for j:=Count-1 downto Count+D do
+ begin
+ P:=SafeArrayCalculateElementAddress(psa,j);
+ if vat = vatInterface then
+ NoInterfaces // Set to nil
+ else
+ NoWideStrings; // Set to empty...
+ end;
+ end;
+ ReAllocMem(psa^.Data,Count+D);
+ end;
+ psa^.Bounds[0].ElementCount:=NewBound.ElementCount;
+ psa^.Bounds[0].LowBound:=NewBound.LowBound;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+ SetUnlockResult(psa,Result);
+end;
+
+Function SafeArrayCopy(psa: PVarArray; var psaOut: PVarArray): HRESULT;stdcall;
+
+var
+ i : Integer;
+
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ Result:=SafeArrayLock(psa);
+ if Result<>VAR_OK then
+ exit;
+ try
+ Result:=SafeArrayAllocDescriptor(psa^.DimCount,psaOut);
+ if Result<>VAR_OK then
+ Exit;
+ try
+ With psaOut^ do
+ begin
+ Flags:=psa^.Flags;
+ ElementSize:=psa^.ElementSize;
+ DimCount:=psa^.DimCount;
+ for i:=0 to DimCount-1 do
+ begin
+ Bounds[i].ElementCount:=psa^.Bounds[i].ElementCount;
+ Bounds[i].LowBound:=psa^.Bounds[i].LowBound;
+ end;
+ end;
+ Result:=SafeArrayAllocData(psaOut);
+ if Result<>VAR_OK then
+ exit;
+ Result:=SafeArrayCopyDataSpace(psa, psaOut);
+ finally
+ if Result<>VAR_OK then
+ begin
+ SafeArrayDestroyDescriptor(psaOut);
+ psaOut:=nil;
+ end;
+ end;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E)
+ end;
+ SetUnlockResult(psa,Result);
+end;
+
+Function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT;stdcall;
+var
+ i : Integer;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ Result:=CheckVarArray(psaOut);
+ if Result<>VAR_OK then
+ exit;
+ Result:=SafeArrayLock(psaOut);
+ if Result<>VAR_OK then
+ exit;
+ try
+ Result:=SafeArrayLock(psa);
+ if Result<>VAR_OK then
+ exit;
+ try
+ With psaOut^ do
+ begin
+ if (psa^.Flags<>Flags) or
+ (psa^.ElementSize<>ElementSize) or
+ (psa^.DimCount<>DimCount) then
+ Exit(VAR_INVALIDARG);
+ for i:=0 to psa^.DimCount - 1 do
+ if (psa^.Bounds[i].LowBound<>Bounds[i].LowBound) or
+ (psa^.Bounds[i].ElementCount<>Bounds[i].ElementCount) then
+ exit(VAR_INVALIDARG);
+ end;
+ Result:=SafeArrayClearDataSpace(psaOut,True);
+ if Result<> VAR_OK then
+ exit;
+ Result:=SafeArrayCopyDataSpace(psa, psaOut);
+ finally
+ SetUnlockResult(psa,Result);
+ end;
+ finally
+ SetUnlockResult(psaOut,Result);
+ end;
+end;
+
+Function SafeArrayGetLBound(psa: PVarArray; Dim: SizeInt; var LBound: SizeInt): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ if (Dim>0) and (Dim<=psa^.DimCount) then
+ LBound:=psa^.Bounds[Dim-1].LowBound
+ else
+ Result:=VAR_BADINDEX;
+end;
+
+Function SafeArrayGetUBound(psa: PVarArray; Dim: SizeInt; var UBound: SizeInt): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ if (Dim>0) and (Dim<=psa^.DimCount) then
+ UBound:=psa^.Bounds[Dim-1].LowBound +
+ psa^.Bounds[Dim-1].ElementCount-1
+ else
+ Result:=VAR_BADINDEX
+end;
+
+Function SafeArrayGetDim(psa: PVarArray): SizeInt;stdcall;
+begin
+ if CheckVarArray(psa)<>VAR_OK then
+ Result:=0
+ else
+ Result:=psa^.DimCount;
+end;
+
+Function SafeArrayAccessData(psa: PVarArray; var ppvData: Pointer): HRESULT;stdcall;
+begin
+ Result:=SafeArrayLock(psa);
+ if Result<>VAR_OK then
+ ppvData:=nil
+ else
+ ppvData:=psa^.Data;
+end;
+
+Function SafeArrayUnaccessData(psa: PVarArray): HRESULT;stdcall;
+begin
+ Result:=SafeArrayUnlock(psa);
+end;
+
+Function SafeArrayLock(psa: PVarArray): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if Result<>VAR_OK then
+ exit;
+ InterlockedIncrement(psa^.LockCount);
+end;
+
+Function SafeArrayUnlock(psa: PVarArray): HRESULT;stdcall;
+begin
+ Result:=CheckVarArray(psa);
+ if (Result<>VAR_OK) then
+ exit;
+ if InterlockedDecrement(psa^.LockCount)<0 then
+ begin
+ InterlockedIncrement(psa^.LockCount);
+ result:=VAR_UNEXPECTED;
+ end;
+end;
+
+
+Function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray;
+ Data: Pointer): HRESULT;stdcall;
+var
+ P: Pointer;
+begin
+ Result:=CheckVarArrayAndCalculateAddress(psa, Indices, P, True);
+ if Result<>VAR_OK then
+ exit;
+ try
+ case VariantArrayType(psa) of
+ vatNormal:
+ Move(P^, Data^, psa^.ElementSize);
+ vatInterface:
+ NoInterfaces; // Just assign...
+ vatWideString:
+ NoWideStrings; // Just assign...
+ end;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+ SetUnlockResult(psa,Result);
+end;
+
+
+Function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray;
+ const Data: Pointer): HRESULT;stdcall;
+var
+ P: Pointer;
+begin
+ Result:=CheckVarArrayAndCalculateAddress(psa,Indices,P,True);
+ if Result<>VAR_OK then
+ exit;
+ try
+ case VariantArrayType(psa) of
+ vatNormal:
+ Move(Data^,P^,psa^.ElementSize);
+ vatInterface:
+ NoInterfaces;
+ vatWideString:
+ NoWideStrings;
+ end;
+ except
+ On E : Exception do
+ Result:=ExceptionToVariantError(E);
+ end;
+ SetUnlockResult(psa,Result);
+end;
+
+
+Function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray;
+ var Address: Pointer): HRESULT;stdcall;
+begin
+ Result:=CheckVarArrayAndCalculateAddress(psa,Indices,Address,False);
+end;
+
+
+Function SafeArrayGetElemSize(psa: PVarArray): LongWord;stdcall;
+begin
+ if CheckVarArray(psa)<>VAR_OK then
+ Result:=0
+ else
+ Result:=psa^.ElementSize;
+end;
+
+{$endif HASVARIANT}
+{
+ $Log: varutils.inc,v $
+ Revision 1.24 2005/03/28 21:52:43 florian
+ * SafeCreateArray fixed
+
+ Revision 1.23 2005/03/28 17:04:58 florian
+ * compilation on non win32 fixed
+
+ Revision 1.22 2005/03/28 13:38:05 florian
+ + a lot of vararray stuff
+
+ Revision 1.21 2005/02/25 14:39:31 peter
+ * 64bit fixes
+
+ Revision 1.20 2005/02/24 22:36:36 florian
+ + some variant stuff fixed and added
+
+ Revision 1.19 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.18 2005/02/08 21:17:25 florian
+ * fixed variant copy for interfaces
+
+ Revision 1.17 2005/02/08 07:25:26 marco
+ * patch from Peter
+
+ Revision 1.16 2005/02/07 21:52:08 florian
+ + basic variant<->intf conversion
+
+ Revision 1.15 2005/01/16 16:56:32 florian
+ + some missing word handling added
+
+ Revision 1.14 2005/01/16 16:15:30 florian
+ * olestring copying fixed
+
+ Revision 1.13 2005/01/15 18:47:26 florian
+ * several variant init./final. stuff fixed
+
+ Revision 1.12 2005/01/08 16:19:42 florian
+ * made some variants stuff more readable
+
+}
diff --git a/rtl/openbsd/Makefile b/rtl/openbsd/Makefile
new file mode 100644
index 0000000000..1f4be94101
--- /dev/null
+++ b/rtl/openbsd/Makefile
@@ -0,0 +1,2031 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=openbsd
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+TARGETPROCINC=$(RTL)/netbsd/$(CPU_TARGET)
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT=
+PRT0=prt0
+else
+SYSTEMUNIT=sysbsd
+LINUXUNIT=
+override FPCOPT+=-dUNIX
+PRT0=prt0_10
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst mmx cpu
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas macpas strings syscall baseunix $(LINUXUNIT) unix initc systhrds dos crt objects printer matrix sysutils classes typinfo math varutils charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard serial variants types systhrds sysctl sysconst
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0 cprt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes sysconst
+endif
+override INSTALL_FPCPACKAGE=y y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : errno.inc $(BSDINC)/bunxtype.inc ptypes.inc $(BSDINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc $(BSDINC)/bunxmain.inc $(BSDINC)/ostypes.inc \
+ $(BSDINC)/bunxfunc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/ossysch.inc $(BSDINC)/bunxmacr.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc \
+ unixsysc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+syscall$(PPUEXT) : $(UNIXINC)/syscall.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT)
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
+ $(COMPILER): $(OBJPASDIR)/rtlconst.pp
diff --git a/rtl/openbsd/Makefile.fpc b/rtl/openbsd/Makefile.fpc
new file mode 100644
index 0000000000..469583a74f
--- /dev/null
+++ b/rtl/openbsd/Makefile.fpc
@@ -0,0 +1,244 @@
+#
+# Makefile.fpc for Free Pascal OpenBSD RTL
+#
+
+[package]
+main=rtl
+
+[install]
+fpcpackage=y
+
+[target]
+loaders=prt0 cprt0
+units=$(SYSTEMUNIT) objpas macpas strings syscall baseunix \
+ $(LINUXUNIT) unix initc systhrds \
+ dos crt objects printer matrix \
+ sysutils classes typinfo math varutils \
+ charset ucomplex getopts heaptrc lineinfo \
+ errors sockets gpm ipc terminfo \
+ video mouse keyboard serial variants types systhrds sysctl sysconst
+units_netbsd_i386=mmx cpu
+rsts=math varutils typinfo variants classes sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=openbsd
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(TARGETPROCINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC)
+
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+ unix \
+ dos crt objects printer \
+ sysutils typinfo math \
+ cpu mmx getopts heaptrc \
+ errors sockets ipc
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+BSDINC=$(RTL)/bsd
+BSDPROCINC=$(BSDINC)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+TARGETPROCINC=$(RTL)/netbsd/$(CPU_TARGET)
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+LINUXUNIT=
+PRT0=prt0
+else
+SYSTEMUNIT=sysbsd
+LINUXUNIT=
+override FPCOPT+=-dUNIX
+PRT0=prt0_10
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
+ $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+baseunix$(PPUEXT) : errno.inc $(BSDINC)/bunxtype.inc ptypes.inc $(BSDINC)/ctypes.inc \
+ signal.inc $(UNIXINC)/bunxh.inc $(BSDINC)/bunxmain.inc $(BSDINC)/ostypes.inc \
+ $(BSDINC)/bunxfunc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
+ $(BSDINC)/ostypes.inc $(BSDINC)/ossysch.inc $(BSDINC)/bunxmacr.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc \
+ unixsysc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
+
+syscall$(PPUEXT) : $(UNIXINC)/syscall.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT)
+
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
+ $(COMPILER): $(OBJPASDIR)/rtlconst.pp
+
diff --git a/rtl/openbsd/classes.pp b/rtl/openbsd/classes.pp
new file mode 100644
index 0000000000..af687997c0
--- /dev/null
+++ b/rtl/openbsd/classes.pp
@@ -0,0 +1,63 @@
+{
+ $Id: classes.pp,v 1.6 2005/04/17 17:33:40 hajny Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for OpenBSD
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ rtlconsts,
+ types,
+ typinfo;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+ baseunix,unix,Systhrds
+ ;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+
+{$ifndef ver1_0}
+ if ThreadsInited then
+ DoneThreads;
+{$endif}
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.6 2005/04/17 17:33:40 hajny
+ * more rtlconst/s fixes
+
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/errno.inc b/rtl/openbsd/errno.inc
new file mode 100644
index 0000000000..ea6e768067
--- /dev/null
+++ b/rtl/openbsd/errno.inc
@@ -0,0 +1,144 @@
+{
+ $Id: errno.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+
+ Errno.inc : define all error numbers, kernel version 1.2.13
+
+}
+Const
+
+
+ ESysEPERM = 1; { Operation not permitted }
+ ESysENOENT = 2; { No such file or directory }
+ ESysESRCH = 3; { No such process }
+ ESysEINTR = 4; { Interrupted system call }
+ ESysEIO = 5; { Input/output error }
+ ESysENXIO = 6; { Device not configured }
+ ESysE2BIG = 7; { Argument list too long }
+ ESysENOEXEC = 8; { Exec format error }
+ ESysEBADF = 9; { Bad file descriptor }
+ ESysECHILD = 10; { No child processes }
+ ESysEDEADLK = 11; { Resource deadlock avoided }
+ { 11 was EAGAIN }
+ ESysENOMEM = 12; { Cannot allocate memory }
+ ESysEACCES = 13; { Permission denied }
+ ESysEFAULT = 14; { Bad address }
+ ESysENOTBLK = 15; { Block device required }
+ ESysEBUSY = 16; { Device busy }
+ ESysEEXIST = 17; { File exists }
+ ESysEXDEV = 18; { Cross-device link }
+ ESysENODEV = 19; { Operation not supported by device }
+ ESysENOTDIR = 20; { Not a directory }
+ ESysEISDIR = 21; { Is a directory }
+ ESysEINVAL = 22; { Invalid argument }
+ ESysENFILE = 23; { Too many open files in system }
+ ESysEMFILE = 24; { Too many open files }
+ ESysENOTTY = 25; { Inappropriate ioctl for device }
+ ESysETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+ ESysEFBIG = 27; { File too large }
+ ESysENOSPC = 28; { No space left on device }
+ ESysESPIPE = 29; { Illegal seek }
+ ESysEROFS = 30; { Read-only file system }
+ ESysEMLINK = 31; { Too many links }
+ ESysEPIPE = 32; { Broken pipe }
+
+{ math software }
+ ESysEDOM = 33; { Numerical argument out of domain }
+ ESysERANGE = 34; { Result too large }
+
+{ non-blocking and interrupt i/o }
+ ESysEAGAIN = 35; { Resource temporarily unavailable }
+ ESysEWOULDBLOCK = ESysEAGAIN; { Operation would block }
+ ESysEINPROGRESS = 36; { Operation now in progress }
+ ESysEALREADY = 37; { Operation already in progress }
+
+{ ipc/network software - - argument errors }
+ ESysENOTSOCK = 38; { Socket operation on non-socket }
+ ESysEDESTADDRREQ = 39; { Destination address required }
+ ESysEMSGSIZE = 40; { Message too long }
+ ESysEPROTOTYPE = 41; { Protocol wrong type for socket }
+ ESysENOPROTOOPT = 42; { Protocol not available }
+ ESysEPROTONOSUPPORT = 43; { Protocol not supported }
+ ESysESOCKTNOSUPPORT = 44; { Socket type not supported }
+ ESysEOPNOTSUPP = 45; { Operation not supported }
+ ESysENOTSUP = ESysEOPNOTSUPP; { Operation not supported }
+ ESysEPFNOSUPPORT = 46; { Protocol family not supported }
+ ESysEAFNOSUPPORT = 47; { Address family not supported by protocol family }
+ ESysEADDRINUSE = 48; { Address already in use }
+ ESysEADDRNOTAVAIL = 49; { Can't assign requested address }
+
+{ ipc/network software - - operational errors }
+ ESysENETDOWN = 50; { Network is down }
+ ESysENETUNREACH = 51; { Network is unreachable }
+ ESysENETRESET = 52; { Network dropped connection on reset }
+ ESysECONNABORTED = 53; { Software caused connection abort }
+ ESysECONNRESET = 54; { Connection reset by peer }
+ ESysENOBUFS = 55; { No buffer space available }
+ ESysEISCONN = 56; { Socket is already connected }
+ ESysENOTCONN = 57; { Socket is not connected }
+ ESysESHUTDOWN = 58; { Can't send after socket shutdown }
+ ESysETOOMANYREFS = 59; { Too many references: can't splice }
+ ESysETIMEDOUT = 60; { Operation timed out }
+ ESysECONNREFUSED = 61; { Connection refused }
+
+ ESysELOOP = 62; { Too many levels of symbolic links }
+ ESysENAMETOOLONG = 63; { File name too long }
+
+{ should be rearranged }
+ ESysEHOSTDOWN = 64; { Host is down }
+ ESysEHOSTUNREACH = 65; { No route to host }
+ ESysENOTEMPTY = 66; { Directory not empty }
+
+{ quotas & mush }
+ ESysEPROCLIM = 67; { Too many processes }
+ ESysEUSERS = 68; { Too many users }
+ ESysEDQUOT = 69; { Disc quota exceeded }
+
+{ Network File System }
+ ESysESTALE = 70; { Stale NFS file handle }
+ ESysEREMOTE = 71; { Too many levels of remote in path }
+ ESysEBADRPC = 72; { RPC struct is bad }
+ ESysERPCMISMATCH = 73; { RPC version wrong }
+ ESysEPROGUNAVAIL = 74; { RPC prog. not avail }
+ ESysEPROGMISMATCH = 75; { Program version wrong }
+ ESysEPROCUNAVAIL = 76; { Bad procedure for program }
+
+ ESysENOLCK = 77; { No locks available }
+ ESysENOSYS = 78; { Function not implemented }
+
+ ESysEFTYPE = 79; { Inappropriate file type or format }
+ ESysEAUTH = 80; { Authentication error }
+ ESysENEEDAUTH = 81; { Need authenticator }
+ ESysEIDRM = 82; { Identifier removed }
+ ESysENOMSG = 83; { No message of desired type }
+ ESysEOVERFLOW = 84; { Value too large to be stored in data type }
+ ESysECANCELED = 85; { Operation canceled }
+ ESysEILSEQ = 86; { Illegal byte sequence }
+ ESysELAST = 86; { Must be equal largest errno }
+
+
+
+{
+ $Log: errno.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/i386/cprt0.as b/rtl/openbsd/i386/cprt0.as
new file mode 100644
index 0000000000..d5ba41023b
--- /dev/null
+++ b/rtl/openbsd/i386/cprt0.as
@@ -0,0 +1,170 @@
+ .file "crt0.c"
+gcc2_compiled.:
+.data
+ .align 32
+ .type rcsid , @object
+ .size rcsid , 58
+rcsid:
+ .string "$OpenBSD: crt0.c,v 1.11 2003/06/27 22:30:38 deraadt Exp $"
+.globl __progname
+.section .rodata
+.LC0:
+ .string ""
+.data
+ .align 4
+ .type __progname , @object
+ .size __progname , 4
+__progname:
+ .long .LC0
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+#APP
+
+ .text
+ .align 4
+ .globl __start
+ .globl _start
+_start:
+__start:
+ pushl %ebx #ps_strings
+ pushl %ecx # obj
+ pushl %edx # cleanup
+ movl 12(%esp),%eax
+ leal 20(%esp,%eax,4),%ecx
+ leal 16(%esp),%edx
+ pushl %ecx
+ pushl %edx
+ pushl %eax
+ call ___start
+
+#NO_APP
+.text
+ .align 4
+.globl ___start
+ .type ___start , @function
+___start:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $16,%esp
+ pushl %esi
+ pushl %ebx
+ movl 12(%ebp),%esi
+ movl 16(%ebp),%eax
+ movl %eax,environ
+ movl %eax,U_SYSTEM_ENVP
+ movl (%esi),%ebx
+ testl %ebx,%ebx
+ je .L3
+ addl $-8,%esp
+ pushl $47
+ pushl %ebx
+ call _strrchr
+ movl %eax,__progname
+ addl $16,%esp
+ testl %eax,%eax
+ jne .L4
+ movl %ebx,__progname
+ jmp .L5
+ .p2align 4,,7
+.L4:
+ incl %eax
+ movl %eax,__progname
+.L5:
+ movl $__progname_storage,%edx
+ jmp .L12
+ .p2align 4,,7
+.L9:
+ movb (%eax),%al
+ movb %al,(%edx)
+ incl __progname
+ incl %edx
+.L12:
+ movl __progname,%eax
+ cmpb $0,(%eax)
+ je .L7
+ cmpl $__progname_storage+255,%edx
+ jb .L9
+.L7:
+ movb $0,(%edx)
+ movl $__progname_storage,__progname
+.L3:
+ call __init
+ subl $16,%esp
+ pushl %eax
+ movl 8(%ebp),%eax
+ movl %eax,U_SYSTEM_ARGC
+ movl %esi,U_SYSTEM_ARGV
+ popl %eax
+# pushl environ
+# pushl %esi
+# pushl 8(%ebp)
+ finit
+ fwait
+ fldcw __fpucw
+ xorl %ebp,%ebp
+ call main
+ pushl %eax
+ call exit
+ .p2align 2,0x90
+
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl U_SYSTEM_EXITCODE,%ebx
+ pushl %ebx
+ call .Lactualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+.Lactualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+.Lfe1:
+
+ .size ___start , . - ___start
+ .align 4
+ .type _strrchr , @function
+_strrchr:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ movl 8(%ebp),%eax
+ movb 12(%ebp),%bl
+ xorl %ecx,%ecx
+ .p2align 4,,7
+.L14:
+ movb (%eax),%dl
+ cmpb %bl,%dl
+ jne .L17
+ movl %eax,%ecx
+.L17:
+ testb %dl,%dl
+ je .L16
+ incl %eax
+ jmp .L14
+ .p2align 4,,7
+.L16:
+ movl %ecx,%eax
+ popl %ebx
+ leave
+ ret
+ .size _strrchr , . - _strrchr
+ .comm environ,4,4
+ .comm __progname_storage,256,32
diff --git a/rtl/openbsd/i386/prt0.as b/rtl/openbsd/i386/prt0.as
new file mode 100644
index 0000000000..2b184a9f83
--- /dev/null
+++ b/rtl/openbsd/i386/prt0.as
@@ -0,0 +1,171 @@
+ .file "crt0.c"
+gcc2_compiled.:
+.data
+ .align 32
+ .type rcsid , @object
+ .size rcsid , 58
+rcsid:
+ .string "$OpenBSD: crt0.c,v 1.11 2003/06/27 22:30:38 deraadt Exp $"
+.globl __progname
+.section .rodata
+.LC0:
+ .string ""
+.data
+ .align 4
+ .type __progname , @object
+ .size __progname , 4
+__progname:
+ .long .LC0
+ .align 4
+___fpucw:
+ .long 0x1332
+
+ .globl ___fpc_brk_addr /* heap management */
+ .type ___fpc_brk_addr,@object
+ .size ___fpc_brk_addr,4
+___fpc_brk_addr:
+ .long 0
+
+#APP
+
+ .text
+ .align 4
+ .globl __start
+ .globl _start
+_start:
+__start:
+ pushl %ebx #ps_strings
+ pushl %ecx # obj
+ pushl %edx # cleanup
+ movl 12(%esp),%eax
+ leal 20(%esp,%eax,4),%ecx
+ leal 16(%esp),%edx
+ pushl %ecx
+ pushl %edx
+ pushl %eax
+ call ___start
+
+#NO_APP
+.text
+ .align 4
+.globl ___start
+ .type ___start , @function
+___start:
+ pushl %ebp
+ movl %esp,%ebp
+ subl $16,%esp
+ pushl %esi
+ pushl %ebx
+ movl 12(%ebp),%esi
+ movl 16(%ebp),%eax
+ movl %eax,environ
+ movl %eax,U_SYSTEM_ENVP
+ movl (%esi),%ebx
+ testl %ebx,%ebx
+ je .L3
+ addl $-8,%esp
+ pushl $47
+ pushl %ebx
+ call _strrchr
+ movl %eax,__progname
+ addl $16,%esp
+ testl %eax,%eax
+ jne .L4
+ movl %ebx,__progname
+ jmp .L5
+ .p2align 4,,7
+.L4:
+ incl %eax
+ movl %eax,__progname
+.L5:
+ movl $__progname_storage,%edx
+ jmp .L12
+ .p2align 4,,7
+.L9:
+ movb (%eax),%al
+ movb %al,(%edx)
+ incl __progname
+ incl %edx
+.L12:
+ movl __progname,%eax
+ cmpb $0,(%eax)
+ je .L7
+ cmpl $__progname_storage+255,%edx
+ jb .L9
+.L7:
+ movb $0,(%edx)
+ movl $__progname_storage,__progname
+.L3:
+# call __init
+ subl $16,%esp
+ pushl %eax
+ movl 8(%ebp),%eax
+ movl %eax,U_SYSTEM_ARGC
+ movl %esi,U_SYSTEM_ARGV
+ popl %eax
+# pushl environ
+# pushl %esi
+# pushl 8(%ebp)
+ finit
+ fwait
+ fldcw __fpucw
+ xorl %ebp,%ebp
+ call main
+# pushl %eax
+# call exit
+ jmp _haltproc
+ .p2align 2,0x90
+
+.globl _haltproc
+.type _haltproc,@function
+
+_haltproc:
+ mov $1,%eax
+ movzwl U_SYSTEM_EXITCODE,%ebx
+ pushl %ebx
+ call .Lactualsyscall
+ addl $4,%esp
+ jmp _haltproc
+
+.Lactualsyscall:
+ int $0x80
+ jb .LErrorcode
+ xor %ebx,%ebx
+ ret
+.LErrorcode:
+ mov %eax,%ebx
+ mov $-1,%eax
+ ret
+ .p2align 2,0x90
+.Lfe1:
+
+ .size ___start , . - ___start
+ .align 4
+ .type _strrchr , @function
+_strrchr:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ movl 8(%ebp),%eax
+ movb 12(%ebp),%bl
+ xorl %ecx,%ecx
+ .p2align 4,,7
+.L14:
+ movb (%eax),%dl
+ cmpb %bl,%dl
+ jne .L17
+ movl %eax,%ecx
+.L17:
+ testb %dl,%dl
+ je .L16
+ incl %eax
+ jmp .L14
+ .p2align 4,,7
+.L16:
+ movl %ecx,%eax
+ popl %ebx
+ leave
+ ret
+ .size _strrchr , . - _strrchr
+ .comm environ,4,4
+ .comm __progname_storage,256,32
diff --git a/rtl/openbsd/i386/sighnd.inc b/rtl/openbsd/i386/sighnd.inc
new file mode 100644
index 0000000000..8bfe41e3c2
--- /dev/null
+++ b/rtl/openbsd/i386/sighnd.inc
@@ -0,0 +1,86 @@
+{
+ $Id: sighnd.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Signalhandler for FreeBSD/i386
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+CONST FPU_ALL=$7F;
+
+function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
+begin
+ getfpustate:=0;
+end;
+procedure SignalToRunerror(Sig: longint;code:longint; var SigContext: SigContextRec); cdecl;
+
+var
+ res,fpustate : word;
+begin
+ res:=0;
+{$ifdef BSD}
+{$ifdef cpui386}
+ fpustate:=0;
+ asm
+ fnstsw fpustate
+ end;
+{$endif cpui386}
+{$endif BSD}
+ case sig of
+ SIGFPE :
+ begin
+ { this is not allways necessary but I don't know yet
+ how to tell if it is or not PM }
+ res:=200;
+ fpustate:=GetFPUState(SigContext);
+
+ if (FpuState and FPU_All) <> 0 then
+ begin
+ { first check the more precise options }
+ if (FpuState and FPU_DivisionByZero)<>0 then
+ res:=200
+ else if (FpuState and FPU_Overflow)<>0 then
+ res:=205
+ else if (FpuState and FPU_Underflow)<>0 then
+ res:=206
+ else if (FpuState and FPU_Denormal)<>0 then
+ res:=216
+ else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
+ res:=207
+ else if (FpuState and FPU_Invalid)<>0 then
+ res:=216
+ else
+ res:=207; {'Coprocessor Error'}
+ end;
+ SysResetFPU;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+ reenable_signal(sig);
+{ give runtime error at the position where the signal was raised }
+ if res<>0 then
+ begin
+{$ifdef cpui386}
+ HandleErrorAddrFrame(res,pointer(SigContext.sc_eip),pointer(SigContext.sc_ebp));
+{$endif}
+ end;
+end;
+
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/ptypes.inc b/rtl/openbsd/ptypes.inc
new file mode 100644
index 0000000000..1c535323ec
--- /dev/null
+++ b/rtl/openbsd/ptypes.inc
@@ -0,0 +1,154 @@
+{
+ $Id: ptypes.inc,v 1.7 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+{$I ctypes.inc}
+{$packrecords c}
+
+type
+
+ dev_t = cuint32; { used for device numbers }
+ TDev = dev_t;
+ pDev = ^dev_t;
+
+ gid_t = cuint32; { used for group IDs }
+ TGid = gid_t;
+ pGid = ^gid_t;
+
+ ino_t = clong; { used for file serial numbers }
+ TIno = ino_t;
+ pIno = ^ino_t;
+
+ mode_t = cuint32; { used for file attributes }
+ TMode = mode_t;
+ pMode = ^mode_t;
+
+ nlink_t = cuint32; { used for link counts }
+ TnLink = nlink_t;
+ pnLink = ^nlink_t;
+
+ off_t = cint64; { used for file sizes }
+ TOff = off_t;
+ pOff = ^off_t;
+
+ pid_t = cint32; { used as process identifier }
+ TPid = pid_t;
+ pPid = ^pid_t;
+
+ size_t = cuint32; { as definied in the C standard}
+ TSize = size_t;
+ pSize = ^size_t;
+
+ ssize_t = cint32; { used by function for returning number of bytes }
+ TsSize = ssize_t;
+ psSize = ^ssize_t;
+
+ uid_t = cuint32; { used for user ID type }
+ TUid = Uid_t;
+ pUid = ^Uid_t;
+
+ clock_t = culong;
+ TClock = clock_t;
+ pClock = ^clock_t;
+
+ time_t = clong; { used for returning the time }
+ TTime = time_t;
+ pTime = ^time_t;
+ ptime_t = ^time_t;
+
+ socklen_t= cuint32;
+ TSocklen = socklen_t;
+ pSocklen = ^socklen_t;
+
+ timeval = packed record
+ tv_sec,
+ tv_usec : clong;
+ end;
+ ptimeval= ^timeval;
+ TTimeval= timeval;
+
+ timespec = packed record
+ tv_sec : time_t;
+ tv_nsec : clong;
+ end;
+ ptimespec= ^timespec;
+ Ttimespec= timespec;
+
+ pthread_t = pointer;
+ pthread_attr_t = pointer;
+ pthread_mutex_t = pointer;
+ pthread_mutexattr_t = pointer;
+ pthread_cond_t = pointer;
+ pthread_condattr_t = pointer;
+ pthread_key_t = cint;
+ pthread_rwlock_t = pointer;
+ pthread_rwlockattr_t = pointer;
+
+ sem_t = pointer;
+
+ {
+ Mutex types (Single UNIX Specification, Version 2, 1997).
+
+ Note that a mutex attribute with one of the following types:
+
+ PTHREAD_MUTEX_NORMAL
+ PTHREAD_MUTEX_RECURSIVE
+ MUTEX_TYPE_FAST (deprecated)
+ MUTEX_TYPE_COUNTING_FAST (deprecated)
+
+ will deviate from POSIX specified semantics.
+ }
+
+ pthread_mutextype = (
+ { Default POSIX mutex }
+ _PTHREAD_MUTEX_ERRORCHECK := 1,
+ { Recursive mutex }
+ _PTHREAD_MUTEX_RECURSIVE := 2,
+ { No error checking }
+ _PTHREAD_MUTEX_NORMAL := 3,
+ _MUTEX_TYPE_MAX
+ );
+
+
+const
+ _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_ERRORCHECK;
+ _MUTEX_TYPE_FAST = _PTHREAD_MUTEX_NORMAL;
+ _MUTEX_TYPE_COUNTING_FAST = _PTHREAD_MUTEX_RECURSIVE;
+
+ _PTHREAD_KEYS_MAX = 256;
+ _PTHREAD_STACK_MIN = 1024;
+
+ { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+ ARG_MAX = 256*1024; {4096} { Maximum number of argument size }
+ NAME_MAX = 255; {14} { Maximum number of bytes in filename }
+ PATH_MAX = 1024; {255} { Maximum number of bytes in pathname }
+
+ SYS_NMLN = 32; {BSD utsname struct limit}
+
+ SIG_MAXSIG = 128; // highest signal version
+ wordsinsigset = 4; // words in sigset_t
+
+{
+ $Log: ptypes.inc,v $
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/signal.inc b/rtl/openbsd/signal.inc
new file mode 100644
index 0000000000..a475e9d006
--- /dev/null
+++ b/rtl/openbsd/signal.inc
@@ -0,0 +1,170 @@
+{
+ $Id: signal.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+Const { For sending a signal }
+
+ SA_NOCLDSTOP = 8;
+ SA_ONSTACK = $001; { take signal on signal stack }
+ SA_RESTART = $002; { restart system call on signal return }
+ SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
+ SA_NODEFER = $010; { don't mask the signal we're delivering }
+ SA_NOCLDWAIT = $020; { don't keep zombies around }
+ SA_SIGINFO = $040; { signal handler with SA_SIGINFO args }
+ SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
+
+ SIG_BLOCK = 1;
+ SIG_UNBLOCK = 2;
+ SIG_SETMASK = 3;
+
+{BSD Checked}
+ SIG_DFL = 0 ;
+ SIG_IGN = 1 ;
+ SIG_ERR = -1 ;
+
+ SIGHUP = 1;
+ SIGINT = 2;
+ SIGQUIT = 3;
+ SIGILL = 4;
+ SIGTRAP = 5;
+ SIGABRT = 6;
+ SIGIOT = 6;
+ SIGEMT = 7;
+ SIGFPE = 8;
+ SIGKILL = 9;
+ SIGBUS = 10;
+ SIGSEGV = 11;
+ SIGSYS = 12;
+ SIGPIPE = 13;
+ SIGALRM = 14;
+ SIGTERM = 15;
+ SIGURG = 16;
+ SIGSTOP = 17;
+ SIGTSTP = 18;
+ SIGCONT = 19;
+ SIGCHLD = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGIO = 23;
+ SIGXCPU = 24;
+ SIGXFSZ = 25;
+ SIGVTALRM = 26;
+ SIGPROF = 27;
+ SIGWINCH = 28;
+ SIGINFO = 29;
+ SIGUSR1 = 30;
+ SIGUSR2 = 31;
+
+
+{$packrecords C}
+const
+ SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
+
+{
+ * The sequence of the fields/registers in struct sigcontext should match
+ * those in mcontext_t.
+ }
+
+type sigset_t = array[0..3] of cardinal;
+
+ PSigContextRec = ^SigContextRec;
+ SigContextRec = record
+ sc_mask : sigset_t; { signal mask to restore }
+ sc_onstack : longint; { sigstack state to restore }
+
+ sc_gs : longint; { machine state (struct trapframe): }
+ sc_fs : longint;
+ sc_es : longint;
+ sc_ds : longint;
+ sc_edi : longint;
+ sc_esi : longint;
+ sc_ebp : longint;
+ sc_isp : longint;
+ sc_ebx : longint;
+ sc_edx : longint;
+ sc_ecx : longint;
+ sc_eax : longint;
+ sc_trapno : longint;
+ sc_err : longint;
+ sc_eip : longint;
+ sc_cs : longint;
+ sc_efl : longint;
+ sc_esp : longint;
+ sc_ss : longint;
+ {
+ * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
+ * needed here), or that + 16 * 4 bytes for emulators (probably all
+ * needed here). The "spare" bytes are mostly not spare.
+ }
+ en_cw : cardinal; { control word (16bits used) }
+ en_sw : cardinal; { status word (16bits) }
+ en_tw : cardinal; { tag word (16bits) }
+ en_fip : cardinal; { floating point instruction pointer }
+ en_fcs : word; { floating code segment selector }
+ en_opcode : word; { opcode last executed (11 bits ) }
+ en_foo : cardinal; { floating operand offset }
+ en_fos : cardinal; { floating operand segment selector }
+ fpr_acc : array[0..79] of char;
+ fpr_ex_sw : cardinal;
+ fpr_pad : array[0..63] of char;
+ end;
+
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+
+{$ifdef powerpc}
+ TSigaction= procedure(Sig: Longint); cdecl;
+{$else}
+{$define BSDHandler}
+{$ifdef BSDHandler}
+ TSigAction = procedure(Sig: Longint; code:longint;var SigContext: SigContextRec);cdecl;
+{$else}
+ TSigAction = procedure(Sig: Longint; var sininfo:tsiginfo_t;var SigContext: SigContextRec);cdecl;
+{$endif}
+{$endif}
+
+ Sigset=sigset_t;
+ TSigset=sigset_t;
+ PSigSet = ^SigSet;
+
+ SigActionRec = packed record
+// Handler : record
+ sa_handler : TSigAction;
+// case byte of
+// 0: (Sh: SignalHandler);
+// 1: (Sa: TSigAction);
+// end;
+ Sa_Flags : Longint;
+ Sa_Mask : SigSet;
+ end;
+
+ PSigActionRec = ^SigActionRec;
+
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+
+
+{
+ $Log: signal.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/syscalls.inc b/rtl/openbsd/syscalls.inc
new file mode 100644
index 0000000000..f90338a8f8
--- /dev/null
+++ b/rtl/openbsd/syscalls.inc
@@ -0,0 +1,23 @@
+{
+ $Id: syscalls.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+
+{
+ $Log: syscalls.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/sysconst.inc b/rtl/openbsd/sysconst.inc
new file mode 100644
index 0000000000..c2ff914629
--- /dev/null
+++ b/rtl/openbsd/sysconst.inc
@@ -0,0 +1,110 @@
+{
+ $Id: sysconst.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{BSD version, only the blocks with BSD in the comment are updated}
+
+const
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+ { Things for LSEEK call, same in linux and BSD }
+ Seek_set = 0;
+ Seek_Cur = 1;
+ Seek_End = 2;
+ { Things for OPEN call - after include/sys/fcntl.h, BSD updated.
+ BSD specifies these constants in hex }
+ Open_Accmode = 3;
+ Open_RdOnly = 0;
+ Open_WrOnly = 1;
+ Open_RdWr = 2;
+ Open_NonBlock = 4;
+ Open_Append = 8;
+ Open_ShLock = $10;
+ Open_ExLock = $20;
+ Open_ASync = $40;
+ Open_FSync = $80;
+ Open_NoFollow = $100;
+ Open_Create = $200; {BSD convention}
+ Open_Creat = $200; {Linux convention}
+ Open_Trunc = $400;
+ Open_Excl = $800;
+ Open_NOCTTY = $8000;
+
+ { The waitpid uses the following options:}
+ Wait_NoHang = 1;
+ Wait_UnTraced = 2;
+ Wait_Any = -1;
+ Wait_MyPGRP = 0;
+ { Constants to check stat.mode - checked all STAT constants with BSD}
+ STAT_IFMT = $f000; {00170000 }
+ STAT_IFSOCK = $c000; {0140000 }
+ STAT_IFLNK = $a000; {0120000 }
+ STAT_IFREG = $8000; {0100000 }
+ STAT_IFBLK = $6000; {0060000 }
+ STAT_IFDIR = $4000; {0040000 }
+ STAT_IFCHR = $2000; {0020000 }
+ STAT_IFIFO = $1000; {0010000 }
+ STAT_ISUID = $0800; {0004000 }
+ STAT_ISGID = $0400; {0002000 }
+ STAT_ISVTX = $0200; {0001000}
+ { Constants to check permissions all }
+ STAT_IRWXO = $7;
+ STAT_IROTH = $4;
+ STAT_IWOTH = $2;
+ STAT_IXOTH = $1;
+
+ STAT_IRWXG = STAT_IRWXO shl 3;
+ STAT_IRGRP = STAT_IROTH shl 3;
+ STAT_IWGRP = STAT_IWOTH shl 3;
+ STAT_IXGRP = STAT_IXOTH shl 3;
+
+ STAT_IRWXU = STAT_IRWXO shl 6;
+ STAT_IRUSR = STAT_IROTH shl 6;
+ STAT_IWUSR = STAT_IWOTH shl 6;
+ STAT_IXUSR = STAT_IXOTH shl 6;
+
+ { Constants to test the type of filesystem }
+ fs_old_ext2 = $ef51;
+ fs_ext2 = $ef53;
+ fs_ext = $137d;
+ fs_iso = $9660;
+ fs_minix = $137f;
+ fs_minix_30 = $138f;
+ fs_minux_V2 = $2468;
+ fs_msdos = $4d44;
+ fs_nfs = $6969;
+ fs_proc = $9fa0;
+ fs_xia = $012FD16D;
+
+ { Constansts for MMAP }
+ MAP_PRIVATE =2;
+ MAP_ANONYMOUS =$1000;
+
+ {Constansts Termios/Ioctl (used in Do_IsDevice) }
+ IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+// a type, and a wrong one. only for quick port atm.
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+
+
+{
+ $Log: sysconst.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/sysctlh.inc b/rtl/openbsd/sysctlh.inc
new file mode 100644
index 0000000000..33ccf3eee3
--- /dev/null
+++ b/rtl/openbsd/sysctlh.inc
@@ -0,0 +1,1167 @@
+{
+ $Id: sysctlh.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Marco van de Voort
+
+ The OS dependant sysctl constants.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ * Copyright (c) 1989;1993
+ * The Regents of the University of California. All rights reserved.
+ *
+ * This code is derived from software contributed to Berkeley by
+ * Mike Karels at Berkeley Software Design, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (Name:INCLUDING;CtlType: BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY;CtlType: OR TORT (Name:INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * @(Name:#)sysctl.h (and others) 8.2 (Berkeley) 3/30/95
+}
+
+CONST
+
+{
+ * Definitions for sysctl call. The sysctl call uses a hierarchical name
+ * for objects that can be examined or modified. The name is expressed as
+ * a sequence of integers. Like a file path name, the meaning of each
+ * component depends on its place in the hierarchy. The top-level and kern
+ * identifiers are defined here, and other identifiers are defined in the
+ * respective subsystem header files.
+}
+
+ CTL_MAXNAME = 12; { largest number of components supported }
+
+ CTLTYPE_NODE = 1; { name is a node }
+ CTLTYPE_INT = 2; { name describes an integer }
+ CTLTYPE_STRING = 3; { name describes a string }
+ CTLTYPE_QUAD = 4; { name describes a 64-bit number }
+ CTLTYPE_STRUCT = 5; { name describes a structure }
+
+{
+ * Top-level identifiers
+}
+ CTL_UNSPEC = 0; { unused }
+ CTL_KERN = 1; { 'high kernel': proc, limits }
+ CTL_VM = 2; { virtual memory }
+ CTL_FS = 3; { file system, mount type is next }
+ CTL_NET = 4; { network, see socket.h }
+ CTL_DEBUG = 5; { debugging parameters }
+ CTL_HW = 6; { generic cpu/io }
+ CTL_MACHDEP = 7; { machine dependent }
+ CTL_USER = 8; { user-level }
+ CTL_DDB = 9; { DDB user interface, see db_var.h }
+ CTL_VFS = 10; { VFS sysctl's }
+ CTL_MAXID = 11; { number of valid top-level ids }
+
+ CTL_NAMES : array [0..10] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'kern';CtlType: CTLTYPE_NODE ),
+ (Name: 'vm';CtlType: CTLTYPE_NODE ),
+ (Name: 'fs';CtlType: CTLTYPE_NODE ),
+ (Name: 'net';CtlType: CTLTYPE_NODE ),
+ (Name: 'debug';CtlType: CTLTYPE_NODE ),
+ (Name: 'hw';CtlType: CTLTYPE_NODE ),
+ (Name: 'machdep';CtlType: CTLTYPE_NODE ),
+ (Name: 'user';CtlType: CTLTYPE_NODE ),
+ (Name: 'ddb';CtlType: CTLTYPE_NODE ),
+ (Name: 'vfs';CtlType: CTLTYPE_NODE ));
+
+{
+ * CTL_KERN identifiers
+}
+ KERN_OSTYPE = 1; { string: system version }
+ KERN_OSRELEASE = 2; { string: system release }
+ KERN_OSREV = 3; { int: system revision }
+ KERN_VERSION = 4; { string: compile time info }
+ KERN_MAXVNODES = 5; { int: max vnodes }
+ KERN_MAXPROC = 6; { int: max processes }
+ KERN_MAXFILES = 7; { int: max open files }
+ KERN_ARGMAX = 8; { int: max arguments to exec }
+ KERN_SECURELVL = 9; { int: system security level }
+ KERN_HOSTNAME = 10; { string: hostname }
+ KERN_HOSTID = 11; { int: host identifier }
+ KERN_CLOCKRATE = 12; { struct: struct clockinfo }
+ KERN_VNODE = 13; { struct: vnode structures }
+ KERN_PROC = 14; { struct: process entries }
+ KERN_FILE = 15; { struct: file entries }
+ KERN_PROF = 16; { node: kernel profiling info }
+ KERN_POSIX1 = 17; { int: POSIX.1 version }
+ KERN_NGROUPS = 18; { int: # of supplemental group ids }
+ KERN_JOB_CONTROL = 19; { int: is job control available }
+ KERN_SAVED_IDS = 20; { int: saved set-user/group-ID }
+ KERN_BOOTTIME = 21; { struct: time kernel was booted }
+ KERN_DOMAINNAME = 22; { string: (Name:YP) domainname }
+ KERN_MAXPARTITIONS = 23; { int: number of partitions/disk }
+ KERN_RAWPARTITION = 24; { int: raw partition number }
+{ define gap 25 }
+{ define gap 26 }
+ KERN_OSVERSION = 27; { string: kernel build version }
+ KERN_SOMAXCONN = 28; { int: listen queue maximum }
+ KERN_SOMINCONN = 29; { int: half-open controllable param }
+ KERN_USERMOUNT = 30; { int: users may mount filesystems }
+ KERN_RND = 31; { struct: rnd(Name:4) statistics }
+ KERN_NOSUIDCOREDUMP = 32; { int: no setuid coredumps ever }
+ KERN_FSYNC = 33; { int: file synchronization support }
+ KERN_SYSVMSG = 34; { int: SysV message queue suppoprt }
+ KERN_SYSVSEM = 35; { int: SysV semaphore support }
+ KERN_SYSVSHM = 36; { int: SysV shared memory support }
+ KERN_ARND = 37; { int: random integer from arc4rnd }
+ KERN_MSGBUFSIZE = 38; { int: size of message buffer }
+ KERN_MALLOCSTATS = 39; { node: malloc statistics }
+ KERN_CPTIME = 40; { array: cp_time }
+ KERN_NCHSTATS = 41; { struct: vfs cache statistics }
+ KERN_FORKSTAT = 42; { struct: fork statistics }
+ KERN_NSELCOLL = 43; { int: select(Name:2) collisions }
+ KERN_TTY = 44; { node: tty information }
+ KERN_CCPU = 45; { int: ccpu }
+ KERN_FSCALE = 46; { int: fscale }
+ KERN_NPROCS = 47; { int: number of processes }
+ KERN_MSGBUF = 48; { message buffer, KERN_MSGBUFSIZE }
+ KERN_POOL = 49; { struct: pool information }
+ KERN_STACKGAPRANDOM = 50; { int: stackgap_random }
+ KERN_SYSVIPC_INFO = 51; { struct: SysV sem/shm/msg info }
+ KERN_USERCRYPTO = 52; { int: usercrypto }
+ KERN_CRYPTODEVALLOWSOFT = 53; { int: cryptodevallowsoft }
+ KERN_SPLASSERT = 54; { int: splassert }
+ KERN_PROC_ARGS = 55; { node: proc args and env }
+ KERN_NFILES = 56; { int: number of open files }
+ KERN_TTYCOUNT = 57; { int: number of tty devices }
+ KERN_NUMVNODES = 58; { int: number of vnodes in use }
+ KERN_MBSTAT = 59; { struct: mbuf statistics }
+ KERN_USERASYMCRYPTO = 60; { int: usercrypto }
+ KERN_MAXID = 61; { number of valid kern ids }
+
+ CTL_KERN_NAMES : array [0..60] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'ostype';CtlType: CTLTYPE_STRING ),
+ (Name: 'osrelease';CtlType: CTLTYPE_STRING ),
+ (Name: 'osrevision';CtlType: CTLTYPE_INT ),
+ (Name: 'version';CtlType: CTLTYPE_STRING ),
+ (Name: 'maxvnodes';CtlType: CTLTYPE_INT ),
+ (Name: 'maxproc';CtlType: CTLTYPE_INT ),
+ (Name: 'maxfiles';CtlType: CTLTYPE_INT ),
+ (Name: 'argmax';CtlType: CTLTYPE_INT ),
+ (Name: 'securelevel';CtlType: CTLTYPE_INT ),
+ (Name: 'hostname';CtlType: CTLTYPE_STRING ),
+ (Name: 'hostid';CtlType: CTLTYPE_INT ),
+ (Name: 'clockrate';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'vnode';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'proc';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'file';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'profiling';CtlType: CTLTYPE_NODE ),
+ (Name: 'posix1version';CtlType: CTLTYPE_INT ),
+ (Name: 'ngroups';CtlType: CTLTYPE_INT ),
+ (Name: 'job_control';CtlType: CTLTYPE_INT ),
+ (Name: 'saved_ids';CtlType: CTLTYPE_INT ),
+ (Name: 'boottime';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'domainname';CtlType: CTLTYPE_STRING ),
+ (Name: 'maxpartitions';CtlType: CTLTYPE_INT ),
+ (Name: 'rawpartition';CtlType: CTLTYPE_INT ),
+ (Name: 'gap';CtlType: 0 ),
+ (Name: 'gap';CtlType: 0 ),
+ (Name: 'osversion';CtlType: CTLTYPE_STRING ),
+ (Name: 'somaxconn';CtlType: CTLTYPE_INT ),
+ (Name: 'sominconn';CtlType: CTLTYPE_INT ),
+ (Name: 'usermount';CtlType: CTLTYPE_INT ),
+ (Name: 'random';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'nosuidcoredump';CtlType: CTLTYPE_INT ),
+ (Name: 'fsync';CtlType: CTLTYPE_INT ),
+ (Name: 'sysvmsg';CtlType: CTLTYPE_INT ),
+ (Name: 'sysvsem';CtlType: CTLTYPE_INT ),
+ (Name: 'sysvshm';CtlType: CTLTYPE_INT ),
+ (Name: 'arandom';CtlType: CTLTYPE_INT ),
+ (Name: 'msgbufsize';CtlType: CTLTYPE_INT ),
+ (Name: 'malloc';CtlType: CTLTYPE_NODE ),
+ (Name: 'cp_time';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'nchstats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'forkstat';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'nselcoll';CtlType: CTLTYPE_INT ),
+ (Name: 'tty';CtlType: CTLTYPE_NODE ),
+ (Name: 'ccpu';CtlType: CTLTYPE_INT ),
+ (Name: 'fscale';CtlType: CTLTYPE_INT ),
+ (Name: 'nprocs';CtlType: CTLTYPE_INT ),
+ (Name: 'msgbuf';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'pool';CtlType: CTLTYPE_NODE ),
+ (Name: 'stackgap_random';CtlType: CTLTYPE_INT ),
+ (Name: 'sysvipc_info';CtlType: CTLTYPE_INT ),
+ (Name: 'usercrypto';CtlType: CTLTYPE_INT ),
+ (Name: 'cryptodevallowsoft';CtlType: CTLTYPE_INT ),
+ (Name: 'splassert';CtlType: CTLTYPE_INT ),
+ (Name: 'procargs';CtlType: CTLTYPE_NODE ),
+ (Name: 'nfiles';CtlType: CTLTYPE_INT ),
+ (Name: 'ttycount';CtlType: CTLTYPE_INT ),
+ (Name: 'numvnodes';CtlType: CTLTYPE_INT ),
+ (Name: 'mbstat';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'userasymcrypto';CtlType: CTLTYPE_INT ));
+
+{
+ * KERN_PROC subtypes
+}
+ KERN_PROC_ALL = 0; { everything but kernel threads }
+ KERN_PROC_PID = 1; { by process id }
+ KERN_PROC_PGRP = 2; { by process group id }
+ KERN_PROC_SESSION = 3; { by session of pid }
+ KERN_PROC_TTY = 4; { by controlling tty }
+ KERN_PROC_UID = 5; { by effective uid }
+ KERN_PROC_RUID = 6; { by real uid }
+ KERN_PROC_KTHREAD = 7; { also return kernel threads }
+
+{
+ * KERN_SYSVIPC_INFO subtypes
+}
+ KERN_SYSVIPC_MSG_INFO = 1; { msginfo and msqid_ds }
+ KERN_SYSVIPC_SEM_INFO = 2; { seminfo and semid_ds }
+ KERN_SYSVIPC_SHM_INFO = 3; { shminfo and shmid_ds }
+
+{
+ * KERN_PROC_ARGS subtypes
+}
+ KERN_PROC_ARGV = 1;
+ KERN_PROC_NARGV = 2;
+ KERN_PROC_ENV = 3;
+ KERN_PROC_NENV = 4;
+
+{
+ * CTL_FS identifiers
+}
+ FS_POSIX = 1; { POSIX flags }
+ FS_MAXID = 2;
+
+ CTL_FS_NAMES : array [0..1] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'posix';CtlType: CTLTYPE_NODE ));
+
+{
+ * CTL_FS identifiers
+}
+ FS_POSIX_SETUID = 1; { int: always clear SGID/SUID bit when owner change }
+ FS_POSIX_MAXID = 2;
+
+ CTL_FS_POSIX_NAMES : array [0..1] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'setuid';CtlType: CTLTYPE_INT ));
+
+{
+ * CTL_HW identifiers
+}
+ HW_MACHINE = 1; { string: machine class }
+ HW_MODEL = 2; { string: specific machine model }
+ HW_NCPU = 3; { int: number of cpus }
+ HW_BYTEORDER = 4; { int: machine byte order }
+ HW_PHYSMEM = 5; { int: total memory }
+ HW_USERMEM = 6; { int: non-kernel memory }
+ HW_PAGESIZE = 7; { int: software page size }
+ HW_DISKNAMES = 8; { strings: disk drive names }
+ HW_DISKSTATS = 9; { struct: diskstats[] }
+ HW_DISKCOUNT = 10; { int: number of disks }
+ HW_MAXID = 11; { number of valid hw ids }
+
+ CTL_HW_NAMES : array [0..10] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'machine';CtlType: CTLTYPE_STRING ),
+ (Name: 'model';CtlType: CTLTYPE_STRING ),
+ (Name: 'ncpu';CtlType: CTLTYPE_INT ),
+ (Name: 'byteorder';CtlType: CTLTYPE_INT ),
+ (Name: 'physmem';CtlType: CTLTYPE_INT ),
+ (Name: 'usermem';CtlType: CTLTYPE_INT ),
+ (Name: 'pagesize';CtlType: CTLTYPE_INT ),
+ (Name: 'disknames';CtlType: CTLTYPE_STRING ),
+ (Name: 'diskstats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'diskcount';CtlType: CTLTYPE_INT ));
+
+{
+ * CTL_USER definitions
+}
+ USER_CS_PATH = 1; { string: _CS_PATH }
+ USER_BC_BASE_MAX = 2; { int: BC_BASE_MAX }
+ USER_BC_DIM_MAX = 3; { int: BC_DIM_MAX }
+ USER_BC_SCALE_MAX = 4; { int: BC_SCALE_MAX }
+ USER_BC_STRING_MAX = 5; { int: BC_STRING_MAX }
+ USER_COLL_WEIGHTS_MAX = 6; { int: COLL_WEIGHTS_MAX }
+ USER_EXPR_NEST_MAX = 7; { int: EXPR_NEST_MAX }
+ USER_LINE_MAX = 8; { int: LINE_MAX }
+ USER_RE_DUP_MAX = 9; { int: RE_DUP_MAX }
+ USER_POSIX2_VERSION = 10; { int: POSIX2_VERSION }
+ USER_POSIX2_C_BIND = 11; { int: POSIX2_C_BIND }
+ USER_POSIX2_C_DEV = 12; { int: POSIX2_C_DEV }
+ USER_POSIX2_CHAR_TERM = 13; { int: POSIX2_CHAR_TERM }
+ USER_POSIX2_FORT_DEV = 14; { int: POSIX2_FORT_DEV }
+ USER_POSIX2_FORT_RUN = 15; { int: POSIX2_FORT_RUN }
+ USER_POSIX2_LOCALEDEF = 16; { int: POSIX2_LOCALEDEF }
+ USER_POSIX2_SW_DEV = 17; { int: POSIX2_SW_DEV }
+ USER_POSIX2_UPE = 18; { int: POSIX2_UPE }
+ USER_STREAM_MAX = 19; { int: POSIX2_STREAM_MAX }
+ USER_TZNAME_MAX = 20; { int: POSIX2_TZNAME_MAX }
+ USER_MAXID = 21; { number of valid user ids }
+
+ CTL_USER_NAMES : array [0..20] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'cs_path';CtlType: CTLTYPE_STRING ),
+ (Name: 'bc_base_max';CtlType: CTLTYPE_INT ),
+ (Name: 'bc_dim_max';CtlType: CTLTYPE_INT ),
+ (Name: 'bc_scale_max';CtlType: CTLTYPE_INT ),
+ (Name: 'bc_string_max';CtlType: CTLTYPE_INT ),
+ (Name: 'coll_weights_max';CtlType: CTLTYPE_INT ),
+ (Name: 'expr_nest_max';CtlType: CTLTYPE_INT ),
+ (Name: 'line_max';CtlType: CTLTYPE_INT ),
+ (Name: 're_dup_max';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_version';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_c_bind';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_c_dev';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_char_term';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_fort_dev';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_fort_run';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_localedef';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_sw_dev';CtlType: CTLTYPE_INT ),
+ (Name: 'posix2_upe';CtlType: CTLTYPE_INT ),
+ (Name: 'stream_max';CtlType: CTLTYPE_INT ),
+ (Name: 'tzname_max';CtlType: CTLTYPE_INT ));
+
+{
+ * CTL_DEBUG definitions
+ *
+ * Second level identifier specifies which debug variable.
+ * Third level identifier specifies which stucture component.
+}
+ CTL_DEBUG_NAME = 0; { string: variable name }
+ CTL_DEBUG_VALUE = 1; { int: variable value }
+ CTL_DEBUG_MAXID = 20;
+
+ POOLWORDS = 1024; { Power of 2 - note that this is 32-bit words }
+
+ RND_RND = 0; { real randomness like nuclear chips }
+ RND_SRND = 1; { strong random source }
+ RND_URND = 2; { less strong random source }
+ RND_PRND = 3; { pseudo random source }
+ RND_ARND = 4; { aRC4 based random number generator }
+ RND_NODEV = 5; { First invalid minor device number }
+
+ RND_SRC_TRUE = 0;
+ RND_SRC_TIMER = 1;
+ RND_SRC_MOUSE = 2;
+ RND_SRC_TTY = 3;
+ RND_SRC_DISK = 4;
+ RND_SRC_NET = 5;
+ RND_SRC_AUDIO = 6;
+ RND_SRC_VIDEO = 7;
+ RND_SRC_NUM = 8;
+
+
+{
+ * Types
+}
+ SOCK_STREAM = 1; { stream socket }
+ SOCK_DGRAM = 2; { datagram socket }
+ SOCK_RAW = 3; { raw-protocol interface }
+ SOCK_RDM = 4; { reliably-delivered message }
+ SOCK_SEQPACKET = 5; { sequenced packet stream }
+
+{
+ * Option flags per-socket.
+}
+ SO_DEBUG = $00001; { turn on debugging info recording }
+ SO_ACCEPTCONN = $00002; { socket has had listen(Name:) }
+ SO_REUSEADDR = $00004; { allow local address reuse }
+ SO_KEEPALIVE = $00008; { keep connections alive }
+ SO_DONTROUTE = $00010; { just use interface addresses }
+ SO_BROADCAST = $00020; { permit sending of broadcast msgs }
+ SO_USELOOPBACK = $00040; { bypass hardware when possible }
+ SO_LINGER = $00080; { linger on close if data present }
+ SO_OOBINLINE = $00100; { leave received OOB data in line }
+ SO_REUSEPORT = $00200; { allow local address & port reuse }
+
+{
+ * Additional options, not kept in so_options.
+}
+ SO_SNDBUF = $01001; { send buffer size }
+ SO_RCVBUF = $01002; { receive buffer size }
+ SO_SNDLOWAT = $01003; { send low-water mark }
+ SO_RCVLOWAT = $01004; { receive low-water mark }
+ SO_SNDTIMEO = $01005; { send timeout }
+ SO_RCVTIMEO = $01006; { receive timeout }
+ SO_ERROR = $01007; { get error status and clear }
+ SO_TYPE = $01008; { get socket type }
+ SO_NETPROC = $01020; { multiplex; network processing }
+
+
+{
+ * Level number for (Name:get/set)sockopt() to apply to socket itself.
+}
+ SOL_SOCKET = $0ffff; { options for socket level }
+
+{
+ * Address families.
+}
+ AF_UNSPEC = 0; { unspecified }
+ AF_LOCAL = 1; { local to host (Name:pipes;CtlType: portals) }
+ AF_UNIX = AF_LOCAL; { backward compatibility }
+ AF_INET = 2; { internetwork: UDP, TCP, etc. }
+ AF_IMPLINK = 3; { arpanet imp addresses }
+ AF_PUP = 4; { pup protocols: e.g. BSP }
+ AF_CHAOS = 5; { mit CHAOS protocols }
+ AF_NS = 6; { XEROX NS protocols }
+ AF_ISO = 7; { ISO protocols }
+ AF_OSI = AF_ISO;
+ AF_ECMA = 8; { european computer manufacturers }
+ AF_DATAKIT = 9; { datakit protocols }
+ AF_CCITT = 10; { CCITT protocols, X.25 etc }
+ AF_SNA = 11; { IBM SNA }
+ AF_DECnet = 12; { DECnet }
+ AF_DLI = 13; { DEC Direct data link interface }
+ AF_LAT = 14; { LAT }
+ AF_HYLINK = 15; { NSC Hyperchannel }
+ AF_APPLETALK = 16; { Apple Talk }
+ AF_ROUTE = 17; { Internal Routing Protocol }
+ AF_LINK = 18; { Link layer interface }
+ pseudo_AF_XTP = 19; { eXpress Transfer Protocol (Name:no AF) }
+ AF_COIP = 20; { connection-oriented IP, aka ST II }
+ AF_CNT = 21; { Computer Network Technology }
+ pseudo_AF_RTIP = 22; { Help Identify RTIP packets }
+ AF_IPX = 23; { Novell Internet Protocol }
+ AF_INET6 = 24; { IPv6 }
+ pseudo_AF_PIP = 25; { Help Identify PIP packets }
+ AF_ISDN = 26; { Integrated Services Digital Network}
+ AF_E164 = AF_ISDN; { CCITT E.164 recommendation }
+ AF_NATM = 27; { native ATM access }
+ AF_ENCAP = 28;
+ AF_SIP = 29; { Simple Internet Protocol }
+ AF_KEY = 30;
+ pseudo_AF_HDRCMPLT = 31; { Used by BPF to not rewrite headers
+ in interface output routine }
+ AF_MAX = 32;
+
+{
+ * Protocol families, same as address families for now.
+}
+ PF_UNSPEC = AF_UNSPEC ;
+ PF_LOCAL = AF_LOCAL ;
+ PF_UNIX = PF_LOCAL ; { backward compatibility }
+ PF_INET = AF_INET ;
+ PF_IMPLINK = AF_IMPLINK ;
+ PF_PUP = AF_PUP ;
+ PF_CHAOS = AF_CHAOS ;
+ PF_NS = AF_NS ;
+ PF_ISO = AF_ISO ;
+ PF_OSI = AF_ISO ;
+ PF_ECMA = AF_ECMA ;
+ PF_DATAKIT = AF_DATAKIT ;
+ PF_CCITT = AF_CCITT ;
+ PF_SNA = AF_SNA ;
+ PF_DECnet = AF_DECnet ;
+ PF_DLI = AF_DLI ;
+ PF_LAT = AF_LAT ;
+ PF_HYLINK = AF_HYLINK ;
+ PF_APPLETALK = AF_APPLETALK ;
+ PF_ROUTE = AF_ROUTE ;
+ PF_LINK = AF_LINK ;
+ PF_XTP = pseudo_AF_XTP; { really just proto family, no AF }
+ PF_COIP = AF_COIP ;
+ PF_CNT = AF_CNT ;
+ PF_IPX = AF_IPX ; { same format as AF_NS }
+ PF_INET6 = AF_INET6 ;
+ PF_PIP = pseudo_AF_PIP;
+ PF_ISDN = AF_ISDN ;
+ PF_NATM = AF_NATM ;
+ PF_ENCAP = AF_ENCAP ;
+ PF_SIP = AF_SIP ;
+ PF_KEY = AF_KEY ;
+ PF_MAX = AF_MAX ;
+
+{
+ * These are the valid values for the 'how' field used by shutdown(Name:2).
+}
+ SHUT_RD = 0;
+ SHUT_WR = 1;
+ SHUT_RDWR = 2;
+
+{
+ * Definitions for network related sysctl, CTL_NET.
+ *
+ * Second level is protocol family.
+ * Third level is protocol number.
+ *
+ * Further levels are defined by the individual families below.
+}
+ NET_MAXID = AF_MAX;
+
+ CTL_NET_NAMES : array [0..30] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'unix';CtlType: CTLTYPE_NODE ),
+ (Name: 'inet';CtlType: CTLTYPE_NODE ),
+ (Name: 'implink';CtlType: CTLTYPE_NODE ),
+ (Name: 'pup';CtlType: CTLTYPE_NODE ),
+ (Name: 'chaos';CtlType: CTLTYPE_NODE ),
+ (Name: 'xerox_ns';CtlType: CTLTYPE_NODE ),
+ (Name: 'iso';CtlType: CTLTYPE_NODE ),
+ (Name: 'emca';CtlType: CTLTYPE_NODE ),
+ (Name: 'datakit';CtlType: CTLTYPE_NODE ),
+ (Name: 'ccitt';CtlType: CTLTYPE_NODE ),
+ (Name: 'ibm_sna';CtlType: CTLTYPE_NODE ),
+ (Name: 'decnet';CtlType: CTLTYPE_NODE ),
+ (Name: 'dec_dli';CtlType: CTLTYPE_NODE ),
+ (Name: 'lat';CtlType: CTLTYPE_NODE ),
+ (Name: 'hylink';CtlType: CTLTYPE_NODE ),
+ (Name: 'appletalk';CtlType: CTLTYPE_NODE ),
+ (Name: 'route';CtlType: CTLTYPE_NODE ),
+ (Name: 'link_layer';CtlType: CTLTYPE_NODE ),
+ (Name: 'xtp';CtlType: CTLTYPE_NODE ),
+ (Name: 'coip';CtlType: CTLTYPE_NODE ),
+ (Name: 'cnt';CtlType: CTLTYPE_NODE ),
+ (Name: 'rtip';CtlType: CTLTYPE_NODE ),
+ (Name: 'ipx';CtlType: CTLTYPE_NODE ),
+ (Name: 'inet6';CtlType: CTLTYPE_NODE ),
+ (Name: 'pip';CtlType: CTLTYPE_NODE ),
+ (Name: 'isdn';CtlType: CTLTYPE_NODE ),
+ (Name: 'natm';CtlType: CTLTYPE_NODE ),
+ (Name: 'encap';CtlType: CTLTYPE_NODE ),
+ (Name: 'sip';CtlType: CTLTYPE_NODE ),
+ (Name: 'key';CtlType: CTLTYPE_NODE ));
+
+{
+ * PF_ROUTE - Routing table
+ *
+ * Three additional levels are defined:
+ * Fourth: address family, 0 is wildcard
+ * Fifth: type of info, defined below
+ * Sixth: flag(Name:s) to mask with for NET_RT_FLAGS
+}
+ NET_RT_DUMP = 1; { dump; may limit to a.f. }
+ NET_RT_FLAGS = 2; { by flags, e.g. RESOLVING }
+ NET_RT_IFLIST = 3; { survey interface list }
+ NET_RT_MAXID = 4;
+
+ CTL_NET_RT_NAMES : array [0..3] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'dump';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'flags';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'iflist';CtlType: CTLTYPE_STRUCT ));
+
+ MSG_OOB = $01; { process out-of-band data }
+ MSG_PEEK = $02; { peek at incoming message }
+ MSG_DONTROUTE = $04; { send without using routing tables }
+ MSG_EOR = $08; { data completes record }
+ MSG_TRUNC = $010; { data discarded before delivery }
+ MSG_CTRUNC = $020; { control data lost before delivery }
+ MSG_WAITALL = $040; { wait for full request or error }
+ MSG_DONTWAIT = $080; { this message should be nonblocking }
+ MSG_BCAST = $0100; { this message rec'd as broadcast }
+ MSG_MCAST = $0200; { this message rec'd as multicast }
+
+{
+ * Possible states of profiling.
+}
+ GMON_PROF_ON = 0;
+ GMON_PROF_BUSY = 1;
+ GMON_PROF_ERROR = 2;
+ GMON_PROF_OFF = 3;
+
+{
+ * Sysctl definitions for extracting profiling information from the kernel.
+}
+ GPROF_STATE = 0; { int: profiling enabling variable }
+ GPROF_COUNT = 1; { struct: profile tick count buffer }
+ GPROF_FROMS = 2; { struct: from location hash bucket }
+ GPROF_TOS = 3; { struct: destination/count structure }
+ GPROF_GMONPARAM = 4; { struct: profiling parameters (Name:see above) }
+
+{
+ * CTL_VM identifiers
+}
+ VM_METER = 1; { struct vmmeter }
+ VM_LOADAVG = 2; { struct loadavg }
+ VM_PSSTRINGS = 3; { PSSTRINGS }
+ VM_UVMEXP = 4; { struct uvmexp }
+ VM_SWAPENCRYPT = 5; { int }
+ VM_NKMEMPAGES = 6; { int - # kmem_map pages }
+ VM_ANONMIN = 7;
+ VM_VTEXTMIN = 8;
+ VM_VNODEMIN = 9;
+ VM_MAXSLP = 10;
+ VM_USPACE = 11;
+ VM_MAXID = 12; { number of valid vm ids }
+
+ CTL_VM_NAMES : array [0..11] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'vmmeter';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'loadavg';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'psstrings';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'uvmexp';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'swapencrypt';CtlType: CTLTYPE_NODE ),
+ (Name: 'nkmempages';CtlType: CTLTYPE_INT ),
+ (Name: 'anonmin';CtlType: CTLTYPE_INT ),
+ (Name: 'vtextmin';CtlType: CTLTYPE_INT ),
+ (Name: 'vnodemin';CtlType: CTLTYPE_INT ),
+ (Name: 'maxslp';CtlType: CTLTYPE_INT ),
+ (Name: 'uspace';CtlType: CTLTYPE_INT ));
+
+ SWPENC_ENABLE = 0;
+ SWPENC_CREATED = 1;
+ SWPENC_DELETED = 2;
+ SWPENC_MAXID = 3;
+
+ CTL_SWPENC_NAMES : array [0..2] OF CtlNameRec = (
+ (Name: 'enable';CtlType: CTLTYPE_INT ),
+ (Name: 'keyscreated';CtlType: CTLTYPE_INT ),
+ (Name: 'keysdeleted';CtlType: CTLTYPE_INT ));
+
+{
+ * Protocols
+}
+ IPPROTO_IP = 0; { dummy for IP }
+ IPPROTO_HOPOPTS = IPPROTO_IP; { Hop-by-hop option header }
+ IPPROTO_ICMP = 1; { control message protocol }
+ IPPROTO_IGMP = 2; { group mgmt protocol }
+ IPPROTO_GGP = 3; { gateway^2 (Name:deprecated) }
+ IPPROTO_IPIP = 4; { IP inside IP }
+ IPPROTO_IPV4 = IPPROTO_IPIP; { IP inside IP }
+ IPPROTO_TCP = 6; { tcp }
+ IPPROTO_EGP = 8; { exterior gateway protocol }
+ IPPROTO_PUP = 12; { pup }
+ IPPROTO_UDP = 17; { user datagram protocol }
+ IPPROTO_IDP = 22; { xns idp }
+ IPPROTO_TP = 29; { tp-4 w/ class negotiation }
+ IPPROTO_IPV6 = 41; { IPv6 in IPv6 }
+ IPPROTO_ROUTING = 43; { Routing header }
+ IPPROTO_FRAGMENT = 44; { Fragmentation/reassembly header }
+ IPPROTO_RSVP = 46; { resource reservation }
+ IPPROTO_GRE = 47; { GRE encap, RFCs 1701/1702 }
+ IPPROTO_ESP = 50; { Encap. Security Payload }
+ IPPROTO_AH = 51; { Authentication header }
+ IPPROTO_MOBILE = 55; { IP Mobility, RFC 2004 }
+ IPPROTO_ICMPV6 = 58; { ICMP for IPv6 }
+ IPPROTO_NONE = 59; { No next header }
+ IPPROTO_DSTOPTS = 60; { Destination options header }
+ IPPROTO_EON = 80; { ISO cnlp }
+ IPPROTO_ETHERIP = 97; { Ethernet in IPv4 }
+ IPPROTO_ENCAP = 98; { encapsulation header }
+ IPPROTO_PIM = 103; { Protocol indep. multicast }
+ IPPROTO_IPCOMP = 108; { IP Payload Comp. Protocol }
+ IPPROTO_RAW = 255; { raw IP packet }
+
+ IPPROTO_MAX = 256;
+
+
+{
+ * Options for use with [gs]etsockopt at the IP level.
+ * First word of comment is data type; bool is stored in int.
+}
+ IP_OPTIONS = 1; { buf/ip_opts; set/get IP options }
+ IP_HDRINCL = 2; { int; header is included with data }
+ IP_TOS = 3; { int; IP type of service and preced. }
+ IP_TTL = 4; { int; IP time to live }
+ IP_RECVOPTS = 5; { bool; receive all IP opts w/dgram }
+ IP_RECVRETOPTS = 6; { bool; receive IP opts for response }
+ IP_RECVDSTADDR = 7; { bool; receive IP dst addr w/dgram }
+ IP_RETOPTS = 8; { ip_opts; set/get IP options }
+ IP_MULTICAST_IF = 9; { in_addr; set/get IP multicast i/f }
+ IP_MULTICAST_TTL = 10; { u_char; set/get IP multicast ttl }
+ IP_MULTICAST_LOOP = 11; { u_char; set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = 12; { ip_mreq; add an IP group membership }
+ IP_DROP_MEMBERSHIP = 13; { ip_mreq; drop an IP group membership }
+
+{ 14-17 left empty for future compatibility with FreeBSD }
+
+ IP_PORTRANGE = 19; { int; range to choose for unspec port }
+ IP_AUTH_LEVEL = 20; { int; authentication used }
+ IP_ESP_TRANS_LEVEL = 21; { int; transport encryption }
+ IP_ESP_NETWORK_LEVEL = 22; { int; full-packet encryption }
+ IP_IPSEC_LOCAL_ID = 23; { buf; IPsec local ID }
+ IP_IPSEC_REMOTE_ID = 24; { buf; IPsec remote ID }
+ IP_IPSEC_LOCAL_CRED = 25; { buf; IPsec local credentials }
+ IP_IPSEC_REMOTE_CRED = 26; { buf; IPsec remote credentials }
+ IP_IPSEC_LOCAL_AUTH = 27; { buf; IPsec local auth material }
+ IP_IPSEC_REMOTE_AUTH = 28; { buf; IPsec remote auth material }
+ IP_IPCOMP_LEVEL = 29; { int; compression used }
+
+{
+ * Security levels - IPsec, not IPSO
+}
+
+ IPSEC_LEVEL_BYPASS = $000; { Bypass policy altogether }
+ IPSEC_LEVEL_NONE = $000; { Send clear, accept any }
+ IPSEC_LEVEL_AVAIL = $001; { Send secure if SA available }
+ IPSEC_LEVEL_USE = $002; { Send secure, accept any }
+ IPSEC_LEVEL_REQUIRE = $003; { Require secure inbound, also use }
+ IPSEC_LEVEL_UNIQUE = $004; { Use outbound SA that is unique }
+ IPSEC_LEVEL_DEFAULT = IPSEC_LEVEL_AVAIL;
+
+
+{
+ * Defaults and limits for options
+}
+ IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
+ IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member }
+ IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf }
+
+{
+ * Argument for IP_PORTRANGE:
+ * - which range to search when port is unspecified at bind(Name:) or connect()
+}
+ IP_PORTRANGE_DEFAULT = 0; { default range }
+ IP_PORTRANGE_HIGH = 1; { 'high' - request firewall bypass }
+ IP_PORTRANGE_LOW = 2; { 'low' - vouchsafe security }
+
+{
+ * Buffer lengths for strings containing printable IP addresses
+}
+ INET_ADDRSTRLEN = 16;
+
+{
+ * Definitions for inet sysctl operations.
+ *
+ * Third level is protocol number.
+ * Fourth level is desired variable within that protocol.
+}
+ IPPROTO_MAXID = (IPPROTO_IPCOMP + 1); { don't list to IPPROTO_MAX }
+
+ CTL_IPPROTO_NAMES : array [0..108] OF CtlNameRec = (
+ (Name: 'ip';CtlType: CTLTYPE_NODE ),
+ (Name: 'icmp';CtlType: CTLTYPE_NODE ),
+ (Name: 'igmp';CtlType: CTLTYPE_NODE ),
+ (Name: 'ggp';CtlType: CTLTYPE_NODE ),
+ (Name: 'ipip';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'tcp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'egp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'pup';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'udp';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'gre';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'esp';CtlType: CTLTYPE_NODE ),
+ (Name: 'ah';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'mobileip';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'etherip';CtlType: CTLTYPE_NODE ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'ipcomp';CtlType: CTLTYPE_NODE ));
+
+{
+ * Names for IP sysctl objects
+}
+ IPCTL_FORWARDING = 1; { act as router }
+ IPCTL_SENDREDIRECTS = 2; { may send redirects when forwarding }
+ IPCTL_DEFTTL = 3; { default TTL }
+{$ifdef notyet}
+ IPCTL_DEFMTU = 4; { default MTU }
+{$endif}
+ IPCTL_SOURCEROUTE = 5; { may perform source routes }
+ IPCTL_DIRECTEDBCAST = 6; { default broadcast behavior }
+ IPCTL_IPPORT_FIRSTAUTO = 7;
+ IPCTL_IPPORT_LASTAUTO = 8;
+ IPCTL_IPPORT_HIFIRSTAUTO = 9;
+ IPCTL_IPPORT_HILASTAUTO = 10;
+ IPCTL_IPPORT_MAXQUEUE = 11;
+ IPCTL_ENCDEBUG = 12;
+{$ifdef obssolete}
+ IPCTL_GIF_TTL = 13; { default TTL for gif encap packet }
+{$endif}
+ IPCTL_IPSEC_EXPIRE_ACQUIRE = 14; { How long to wait for key mgmt. }
+ IPCTL_IPSEC_EMBRYONIC_SA_TIMEOUT = 15; { new SA lifetime }
+ IPCTL_IPSEC_REQUIRE_PFS = 16;
+ IPCTL_IPSEC_SOFT_ALLOCATIONS = 17;
+ IPCTL_IPSEC_ALLOCATIONS = 18;
+ IPCTL_IPSEC_SOFT_BYTES = 19;
+ IPCTL_IPSEC_BYTES = 20;
+ IPCTL_IPSEC_TIMEOUT = 21;
+ IPCTL_IPSEC_SOFT_TIMEOUT = 22;
+ IPCTL_IPSEC_SOFT_FIRSTUSE = 23;
+ IPCTL_IPSEC_FIRSTUSE = 24;
+ IPCTL_IPSEC_ENC_ALGORITHM = 25;
+ IPCTL_IPSEC_AUTH_ALGORITHM = 26;
+ IPCTL_MTUDISC = 27; { allow path MTU discovery }
+ IPCTL_MTUDISCTIMEOUT = 28; { allow path MTU discovery }
+ IPCTL_IPSEC_IPCOMP_ALGORITHM = 29;
+ IPCTL_MAXID = 30;
+
+ IPCTL_NAMES : array [0..29] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'forwarding';CtlType: CTLTYPE_INT ),
+ (Name: 'redirect';CtlType: CTLTYPE_INT ),
+ (Name: 'ttl';CtlType: CTLTYPE_INT ),
+ {(Name: 'mtu';CtlType: CTLTYPE_INT ), }
+ (Name: ''; CTLTYPE:0 ),
+ (Name: 'sourceroute';CtlType: CTLTYPE_INT ),
+ (Name: 'directed-broadcast';CtlType: CTLTYPE_INT ),
+ (Name: 'portfirst';CtlType: CTLTYPE_INT ),
+ (Name: 'portlast';CtlType: CTLTYPE_INT ),
+ (Name: 'porthifirst';CtlType: CTLTYPE_INT ),
+ (Name: 'porthilast';CtlType: CTLTYPE_INT ),
+ (Name: 'maxqueue';CtlType: CTLTYPE_INT ),
+ (Name: 'encdebug';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'ipsec-expire-acquire';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-invalid-life';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-pfs';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-soft-allocs';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-allocs';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-soft-bytes';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-bytes';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-timeout';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-soft-timeout';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-soft-firstuse';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-firstuse';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-enc-alg';CtlType: CTLTYPE_STRING ),
+ (Name: 'ipsec-auth-alg';CtlType: CTLTYPE_STRING ),
+ (Name: 'mtudisc';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisctimeout';CtlType: CTLTYPE_INT ),
+ (Name: 'ipsec-comp-alg';CtlType: CTLTYPE_STRING ));
+
+{
+ * Names for ICMP sysctl objects
+}
+ ICMPCTL_MASKREPL = 1; { allow replies to netmask requests }
+ ICMPCTL_BMCASTECHO = 2; { reply to icmps to broadcast/mcast }
+ ICMPCTL_ERRPPSLIMIT = 3; { ICMP error pps limitation }
+ ICMPCTL_REDIRACCEPT = 4; { Accept redirects from routers }
+ ICMPCTL_REDIRTIMEOUT = 5; { Remove routes added via redirects }
+ ICMPCTL_TSTAMPREPL = 6; { allow replies to timestamp requests }
+ ICMPCTL_MAXID = 7;
+
+ ICMPCTL_NAMES : array [0..6] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'maskrepl';CtlType: CTLTYPE_INT ),
+ (Name: 'bmcastecho';CtlType: CTLTYPE_INT ),
+ (Name: 'errppslimit';CtlType: CTLTYPE_INT ),
+ (Name: 'rediraccept';CtlType: CTLTYPE_INT ),
+ (Name: 'redirtimeout';CtlType: CTLTYPE_INT ),
+ (Name: 'tstamprepl';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for ICMP sysctl objects
+}
+ ICMPV6CTL_STATS = 1;
+ ICMPV6CTL_REDIRACCEPT = 2; { accept/process redirects }
+ ICMPV6CTL_REDIRTIMEOUT = 3; { redirect cache time }
+{$ifdef obsolete_false}
+ ICMPV6CTL_ERRRATELIMIT = 5; { ICMPv6 error rate limitation }
+{$endif}
+ ICMPV6CTL_ND6_PRUNE = 6;
+ ICMPV6CTL_ND6_DELAY = 8;
+ ICMPV6CTL_ND6_UMAXTRIES = 9;
+ ICMPV6CTL_ND6_MMAXTRIES = 10;
+ ICMPV6CTL_ND6_USELOOPBACK = 11;
+{ #define ICMPV6CTL_ND6_PROXYALL 12; obsoleted, do not reuse here }
+ ICMPV6CTL_NODEINFO = 13;
+ ICMPV6CTL_ERRPPSLIMIT = 14; { ICMPv6 error pps limitation }
+ ICMPV6CTL_ND6_MAXNUDHINT = 15;
+ ICMPV6CTL_MTUDISC_HIWAT = 16;
+ ICMPV6CTL_MTUDISC_LOWAT = 17;
+ ICMPV6CTL_ND6_DEBUG = 18;
+ ICMPV6CTL_ND6_DRLIST = 19;
+ ICMPV6CTL_ND6_PRLIST = 20;
+ ICMPV6CTL_MAXID = 21;
+
+ ICMPV6CTL_NAMES : array [0..20] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'rediraccept';CtlType: CTLTYPE_INT ),
+ (Name: 'redirtimeout';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nd6_prune';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nd6_delay';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_umaxtries';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_mmaxtries';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_useloopback';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: 'nodeinfo';CtlType: CTLTYPE_INT ),
+ (Name: 'errppslimit';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_maxnudhint';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisc_hiwat';CtlType: CTLTYPE_INT ),
+ (Name: 'mtudisc_lowat';CtlType: CTLTYPE_INT ),
+ (Name: 'nd6_debug';CtlType: CTLTYPE_INT ),
+ (Name: '';CtlType: 0 ),
+ (Name: '';CtlType: 0 ));
+
+{
+ * Names for TCP sysctl objects.
+}
+
+ TCPCTL_RFC1323 = 1; { enable/disable RFC1323 timestamps/scaling }
+ TCPCTL_KEEPINITTIME = 2; { TCPT_KEEP value }
+ TCPCTL_KEEPIDLE = 3; { allow tcp_keepidle to be changed }
+ TCPCTL_KEEPINTVL = 4; { allow tcp_keepintvl to be changed }
+ TCPCTL_SLOWHZ = 5; { return kernel idea of PR_SLOWHZ }
+ TCPCTL_BADDYNAMIC = 6; { return bad dynamic port bitmap }
+ TCPCTL_RECVSPACE = 7; { receive buffer space }
+ TCPCTL_SENDSPACE = 8; { send buffer space }
+ TCPCTL_IDENT = 9; { get connection owner }
+ TCPCTL_SACK = 10; { selective acknowledgement, rfc 2018 }
+ TCPCTL_MSSDFLT = 11; { Default maximum segment size }
+ TCPCTL_RSTPPSLIMIT = 12; { RST pps limit }
+ TCPCTL_ACK_ON_PUSH = 13; { ACK immediately on PUSH }
+ TCPCTL_ECN = 14; { RFC3168 ECN }
+ TCPCTL_MAXID = 15;
+
+ TCPCTL_NAMES : array [0..14] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'rfc1323';CtlType: CTLTYPE_INT ),
+ (Name: 'keepinittime';CtlType: CTLTYPE_INT ),
+ (Name: 'keepidle';CtlType: CTLTYPE_INT ),
+ (Name: 'keepintvl';CtlType: CTLTYPE_INT ),
+ (Name: 'slowhz';CtlType: CTLTYPE_INT ),
+ (Name: 'baddynamic';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'recvspace';CtlType: CTLTYPE_INT ),
+ (Name: 'sendspace';CtlType: CTLTYPE_INT ),
+ (Name: 'ident';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'sack';CtlType: CTLTYPE_INT ),
+ (Name: 'mssdflt';CtlType: CTLTYPE_INT ),
+ (Name: 'rstppslimit';CtlType: CTLTYPE_INT ),
+ (Name: 'ackonpush';CtlType: CTLTYPE_INT ),
+ (Name: 'ecn';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for UDP sysctl objects
+}
+ UDPCTL_CHECKSUM = 1; { checksum UDP packets }
+ UDPCTL_BADDYNAMIC = 2; { return bad dynamic port bitmap }
+ UDPCTL_RECVSPACE = 3; { receive buffer space }
+ UDPCTL_SENDSPACE = 4; { send buffer space }
+ UDPCTL_MAXID = 5;
+
+ UDPCTL_NAMES : array [0..4] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'checksum';CtlType: CTLTYPE_INT ),
+ (Name: 'baddynamic';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'recvspace';CtlType: CTLTYPE_INT ),
+ (Name: 'sendspace';CtlType: CTLTYPE_INT ));
+
+{
+ * Names for IPX sysctl objects.
+}
+
+ IPXCTL_CHECKSUM = 1;
+ IPXCTL_FORWARDING = 2;
+ IPXCTL_NETBIOS = 3;
+ IPXCTL_RECVSPACE = 4;
+ IPXCTL_SENDSPACE = 5;
+ IPXCTL_MAXID = 6;
+
+ IPXCTL_NAMES : array [0..5] OF CtlNameRec = (
+ (Name: '';CtlType: 0),
+ (Name: 'checksum';CtlType: CTLTYPE_INT ),
+ (Name: 'forwarding';CtlType: CTLTYPE_INT ),
+ (Name: 'netbios';CtlType: CTLTYPE_INT ),
+ (Name: 'recvspace';CtlType: CTLTYPE_INT ),
+ (Name: 'sendspace';CtlType: CTLTYPE_INT ));
+
+ DBCTL_RADIX = 1;
+ DBCTL_MAXWIDTH = 2;
+ DBCTL_MAXLINE = 3;
+ DBCTL_TABSTOP = 4;
+ DBCTL_PANIC = 5;
+ DBCTL_CONSOLE = 6;
+ DBCTL_MAXID = 7;
+
+ CTL_DDB_NAMES : array [0..6] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'radix';CtlType: CTLTYPE_INT ),
+ (Name: 'max_width';CtlType: CTLTYPE_INT ),
+ (Name: 'max_line';CtlType: CTLTYPE_INT ),
+ (Name: 'tab_stop_width';CtlType: CTLTYPE_INT ),
+ (Name: 'panic';CtlType: CTLTYPE_INT ),
+ (Name: 'console';CtlType: CTLTYPE_INT ));
+
+{
+ * Sysctl CTL_VFS definitions.
+ *
+ * Second level identifier specifies which filesystem. Second level
+ * identifier VFS_GENERIC returns information about all filesystems.
+}
+ VFS_GENERIC = 0; { generic filesystem information }
+{
+ * Third level identifiers for VFS_GENERIC are given below; third
+ * level identifiers for specific filesystems are given in their
+ * mount specific header files.
+}
+ VFS_MAXTYPENUM = 1; { int: highest defined filesystem type }
+ VFS_CONF = 2; { struct: vfsconf for filesystem given
+ as next argument }
+ VFSGEN_MAXID = 3; { max number of vfs.generic ids }
+
+ CTL_VFSGENCTL_NAMES : array [0..2] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'maxtypenum';CtlType: CTLTYPE_INT ),
+ (Name: 'conf';CtlType: CTLTYPE_NODE ));
+
+{
+ * fs.nfs sysctl(Name:3) identifiers
+}
+ NFS_NFSSTATS = 1; { struct: struct nfsstats }
+ NFS_NIOTHREADS = 2; { number of i/o threads }
+ NFS_MAXID = 3;
+
+ FS_NFS_NAMES : array [0..2] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'nfsstats';CtlType: CTLTYPE_STRUCT ),
+ (Name: 'iothreads';CtlType: CTLTYPE_INT ));
+
+ FFS_CLUSTERREAD = 1; { cluster reading enabled }
+ FFS_CLUSTERWRITE = 2; { cluster writing enabled }
+ FFS_REALLOCBLKS = 3; { block reallocation enabled }
+ FFS_ASYNCFREE = 4; { asynchronous block freeing enabled }
+ FFS_MAX_SOFTDEPS = 5; { maximum structs before slowdown }
+ FFS_SD_TICKDELAY = 6; { ticks to pause during slowdown }
+ FFS_SD_WORKLIST_PUSH = 7; { # of worklist cleanups }
+ FFS_SD_BLK_LIMIT_PUSH = 8; { # of times block limit neared }
+ FFS_SD_INO_LIMIT_PUSH = 9; { # of times inode limit neared }
+ FFS_SD_BLK_LIMIT_HIT = 10; { # of times block slowdown imposed }
+ FFS_SD_INO_LIMIT_HIT = 11; { # of times inode slowdown imposed }
+ FFS_SD_SYNC_LIMIT_HIT = 12; { # of synchronous slowdowns imposed }
+ FFS_SD_INDIR_BLK_PTRS = 13; { bufs redirtied as indir ptrs not written }
+ FFS_SD_INODE_BITMAP = 14; { bufs redirtied as inode bitmap not written }
+ FFS_SD_DIRECT_BLK_PTRS = 15; { bufs redirtied as direct ptrs not written }
+ FFS_SD_DIR_ENTRY = 16; { bufs redirtied as dir entry cannot write }
+ FFS_MAXID = 17; { number of valid ffs ids }
+
+ FFS_NAMES : array [0..16] OF CtlNameRec = (
+ (Name: '';CtlType: 0 ),
+ (Name: 'doclusterread';CtlType: CTLTYPE_INT ),
+ (Name: 'doclusterwrite';CtlType: CTLTYPE_INT ),
+ (Name: 'doreallocblks';CtlType: CTLTYPE_INT ),
+ (Name: 'doasyncfree';CtlType: CTLTYPE_INT ),
+ (Name: 'max_softdeps';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_tickdelay';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_worklist_push';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_blk_limit_push';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_ino_limit_push';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_blk_limit_hit';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_ino_limit_hit';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_sync_limit_hit';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_indir_blk_ptrs';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_inode_bitmap';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_direct_blk_ptrs';CtlType: CTLTYPE_INT ),
+ (Name: 'sd_dir_entry';CtlType: CTLTYPE_INT ));
+
+{
+
+ $Log: sysctlh.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/sysnr.inc b/rtl/openbsd/sysnr.inc
new file mode 100644
index 0000000000..def678b944
--- /dev/null
+++ b/rtl/openbsd/sysnr.inc
@@ -0,0 +1,215 @@
+{
+ $Id: sysnr.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ * System call numbers.
+ *
+ * created from;OpenBSD: syscalls.master,v 1.62 2003/09/07 21:00:27 miod Exp
+ * (OpenBSD/i386 3.4 release distro)
+}
+Const
+ syscall_nr_syscall = 0 ;
+ syscall_nr_exit = 1 ;
+ syscall_nr_fork = 2 ;
+ syscall_nr_read = 3 ;
+ syscall_nr_write = 4 ;
+ syscall_nr_open = 5 ;
+ syscall_nr_close = 6 ;
+ syscall_nr_wait4 = 7 ;
+ syscall_nr_waitpid = 8 ; // added: ease of notation purposes
+ syscall_nr_link = 9 ;
+ syscall_nr_unlink = 10 ;
+ syscall_nr_chdir = 12 ;
+ syscall_nr_fchdir = 13 ;
+ syscall_nr_mknod = 14 ;
+ syscall_nr_chmod = 15 ;
+ syscall_nr_chown = 16 ;
+ syscall_nr_break = 17 ;
+ syscall_nr_getpid = 20 ;
+ syscall_nr_mount = 21 ;
+ syscall_nr_unmount = 22 ;
+ syscall_nr_setuid = 23 ;
+ syscall_nr_getuid = 24 ;
+ syscall_nr_geteuid = 25 ;
+ syscall_nr_ptrace = 26 ;
+ syscall_nr_recvmsg = 27 ;
+ syscall_nr_sendmsg = 28 ;
+ syscall_nr_recvfrom = 29 ;
+ syscall_nr_accept = 30 ;
+ syscall_nr_getpeername = 31 ;
+ syscall_nr_getsockname = 32 ;
+ syscall_nr_access = 33 ;
+ syscall_nr_chflags = 34 ;
+ syscall_nr_fchflags = 35 ;
+ syscall_nr_sync = 36 ;
+ syscall_nr_kill = 37 ;
+ syscall_nr_getppid = 39 ;
+ syscall_nr_dup = 41 ;
+ syscall_nr_opipe = 42 ;
+ syscall_nr_getegid = 43 ;
+ syscall_nr_profil = 44 ;
+ syscall_nr_ktrace = 45 ;
+ syscall_nr_sigaction = 46 ;
+ syscall_nr_getgid = 47 ;
+ syscall_nr_sigprocmask = 48 ;
+ syscall_nr_getlogin = 49 ;
+ syscall_nr_setlogin = 50 ;
+ syscall_nr_acct = 51 ;
+ syscall_nr_sigpending = 52 ;
+ syscall_nr_sigaltstack = 53 ;
+ syscall_nr_ioctl = 54 ;
+ syscall_nr_reboot = 55 ;
+ syscall_nr_revoke = 56 ;
+ syscall_nr_symlink = 57 ;
+ syscall_nr_readlink = 58 ;
+ syscall_nr_execve = 59 ;
+ syscall_nr_umask = 60 ;
+ syscall_nr_chroot = 61 ;
+ syscall_nr_vfork = 66 ;
+ syscall_nr_sbrk = 69 ;
+ syscall_nr_sstk = 70 ;
+ syscall_nr_vadvise = 72 ;
+ syscall_nr_munmap = 73 ;
+ syscall_nr_mprotect = 74 ;
+ syscall_nr_madvise = 75 ;
+ syscall_nr_mincore = 78 ;
+ syscall_nr_getgroups = 79 ;
+ syscall_nr_setgroups = 80 ;
+ syscall_nr_getpgrp = 81 ;
+ syscall_nr_setpgid = 82 ;
+ syscall_nr_setitimer = 83 ;
+ syscall_nr_getitimer = 86 ;
+ syscall_nr_dup2 = 90 ;
+ syscall_nr_fcntl = 92 ;
+ syscall_nr_select = 93 ;
+ syscall_nr_fsync = 95 ;
+ syscall_nr_setpriority = 96 ;
+ syscall_nr_socket = 97 ;
+ syscall_nr_connect = 98 ;
+ syscall_nr_getpriority = 100;
+ syscall_nr_sigreturn = 103;
+ syscall_nr_bind = 104;
+ syscall_nr_setsockopt = 105;
+ syscall_nr_listen = 106;
+ syscall_nr_sigsuspend = 111;
+ syscall_nr_gettimeofday = 116;
+ syscall_nr_getrusage = 117;
+ syscall_nr_getsockopt = 118;
+ syscall_nr_readv = 120;
+ syscall_nr_writev = 121;
+ syscall_nr_settimeofday = 122;
+ syscall_nr_fchown = 123;
+ syscall_nr_fchmod = 124;
+ syscall_nr_setreuid = 126;
+ syscall_nr_setregid = 127;
+ syscall_nr_rename = 128;
+ syscall_nr_flock = 131;
+ syscall_nr_mkfifo = 132;
+ syscall_nr_sendto = 133;
+ syscall_nr_shutdown = 134;
+ syscall_nr_socketpair = 135;
+ syscall_nr_mkdir = 136;
+ syscall_nr_rmdir = 137;
+ syscall_nr_utimes = 138;
+ syscall_nr_adjtime = 140;
+ syscall_nr_setsid = 147;
+ syscall_nr_quotactl = 148;
+ syscall_nr_nfssvc = 155;
+ syscall_nr_getfh = 161;
+ syscall_nr_sysarch = 165;
+ syscall_nr_pread = 173;
+ syscall_nr_pwrite = 174;
+ syscall_nr_setgid = 181;
+ syscall_nr_setegid = 182;
+ syscall_nr_seteuid = 183;
+ syscall_nr_lfs_bmapv = 184;
+ syscall_nr_lfs_markv = 185;
+ syscall_nr_lfs_segclean = 186;
+ syscall_nr_lfs_segwait = 187;
+ syscall_nr_stat = 188;
+ syscall_nr_fstat = 189;
+ syscall_nr_lstat = 190;
+ syscall_nr_pathconf = 191;
+ syscall_nr_fpathconf = 192;
+ syscall_nr_swapctl = 193;
+ syscall_nr_getrlimit = 194;
+ syscall_nr_setrlimit = 195;
+ syscall_nr_getdirentries= 196;
+ syscall_nr_mmap = 197;
+ syscall_nr___syscall = 198;
+ syscall_nr_lseek = 199;
+ syscall_nr_truncate = 200;
+ syscall_nr_ftruncate = 201;
+ syscall_nr___sysctl = 202;
+ syscall_nr_mlock = 203;
+ syscall_nr_munlock = 204;
+ syscall_nr_undelete = 205;
+ syscall_nr_futimes = 206;
+ syscall_nr_getpgid = 207;
+ syscall_nr_xfspioctl = 208;
+ syscall_nr_semget = 221;
+ syscall_nr_semop = 222;
+ syscall_nr_msgget = 225;
+ syscall_nr_msgsnd = 226;
+ syscall_nr_msgrcv = 227;
+ syscall_nr_shmat = 228;
+ syscall_nr_shmdt = 230;
+ syscall_nr_shmget = 231;
+ syscall_nr_clock_gettime= 232;
+ syscall_nr_clock_settime= 233;
+ syscall_nr_clock_getres = 234;
+ syscall_nr_nanosleep = 240;
+ syscall_nr_minherit = 250;
+ syscall_nr_rfork = 251;
+ syscall_nr_poll = 252;
+ syscall_nr_issetugid = 253;
+ syscall_nr_lchown = 254;
+ syscall_nr_getsid = 255;
+ syscall_nr_msync = 256;
+ syscall_nr___semctl = 257;
+ syscall_nr_shmctl = 258;
+ syscall_nr_msgctl = 259;
+ syscall_nr_getfsstat = 260;
+ syscall_nr_statfs = 261;
+ syscall_nr_fstatfs = 262;
+ syscall_nr_pipe = 263;
+ syscall_nr_fhopen = 264;
+ syscall_nr_fhstat = 265;
+ syscall_nr_fhstatfs = 266;
+ syscall_nr_preadv = 267;
+ syscall_nr_pwritev = 268;
+ syscall_nr_kqueue = 269;
+ syscall_nr_kevent = 270;
+ syscall_nr_mlockall = 271;
+ syscall_nr_munlockall = 272;
+ syscall_nr_getpeereid = 273;
+ syscall_nr_extattrctl = 274;
+ syscall_nr_extattr_set_file = 275;
+ syscall_nr_extattr_get_file = 276;
+ syscall_nr_extattr_delete_file = 277;
+ syscall_nr_extattr_set_fd = 278;
+ syscall_nr_extattr_get_fd = 279;
+ syscall_nr_extattr_delete_fd = 280;
+ syscall_nr_getresuid = 281;
+ syscall_nr_setresuid = 282;
+ syscall_nr_getresgid = 283;
+ syscall_nr_setresgid = 284;
+ syscall_nr_mquery = 286;
+ syscall_nr_MAXSYSCALL = 287;
+
+{
+ $Log $
+}
+
+
diff --git a/rtl/openbsd/sysofft.inc b/rtl/openbsd/sysofft.inc
new file mode 100644
index 0000000000..aa81929aea
--- /dev/null
+++ b/rtl/openbsd/sysofft.inc
@@ -0,0 +1,108 @@
+
+
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; assembler; [public, alias : 'FPC_SYSC_LSEEK'];
+
+asm
+ stwu r1,-16(r1)
+ mflr r0
+ stw r0,20(r1)
+ mr r11,r4
+ mr r12,r5
+ mr r5,r3
+ mr r9,r6
+ li r3,0
+ mr r7,r11
+ mr r8,r12
+ li r6,0
+ li r4,199
+// crclr cr1*4+eq
+ crxor 6,6,6
+ li r0,198
+ sc
+ bso .Lcerrorlseek
+// mr r0,r3
+// mr r3,r4
+// mr r4,r0
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+ blr
+.Lcerrorlseek:
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ li r4,-1
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+end;
+
+function Fpftruncate(fd : cint; flength : off_t): cint; assembler; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+
+asm
+stwu r1,-16(r1)
+mflr r0
+stw r0,20(r1)
+mr r7,r5
+mr r8,r6
+mr r5,r3
+li r3,0
+li r4,201
+li r6,0
+
+//crclr cr1*4+eq
+crxor 6,6,6
+li r0,198
+sc
+bso .Lcerrortrunc
+mr r4,r3
+lwz r0,20(r1)
+mtlr r0
+addi r1,r1,16
+blr
+.Lcerrortrunc:
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+end;
+
+Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; assembler; [public, alias: 'FPC_SYSC_MMAP'];
+
+//Function Fpmmap(adr,len,prot,flags,fdes,off:longint):longint; assembler; [public, alias : 'FPC_SYSC_MMAP'];
+
+asm
+ stwu r1,-16(r1)
+ mflr r0
+ stw r0,20(r1)
+ mr r0,r5
+ mr r8,r6
+ stw r9,8(r1)
+ stw r10,12(r1)
+ mr r5,r3
+ mr r6,r4
+ mr r9,r7
+ li r3,0
+ mr r7,r0
+ li r4,197
+ li r10,0
+// crclr cr1*4+eq
+ crxor 6,6,6
+ li r0,198
+ sc
+ bso .Lcerrormmap
+ mr r4,r3
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+ blr
+.Lcerrormmap:
+ lis r4,Errno@ha
+ stw r3,Errno@l(r4)
+ li r3,-1
+ lwz r0,20(r1)
+ mtlr r0
+ addi r1,r1,16
+end;
diff --git a/rtl/openbsd/systypes.inc b/rtl/openbsd/systypes.inc
new file mode 100644
index 0000000000..5e90f3e677
--- /dev/null
+++ b/rtl/openbsd/systypes.inc
@@ -0,0 +1,43 @@
+{
+ $Id: systypes.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+type
+
+ TStatfs = packed record
+ spare2, { place holder}
+ bsize, { fundamental block size}
+ iosize, { optimal block size }
+ blocks, { total blocks}
+ bfree, { blocks free}
+ bavail, { block available for mortal users}
+ files, { Total file nodes}
+ ffree : longint; { file nodes free}
+ fsid : array[0..1] of longint;
+ fowner : longint; {mounter uid}
+ ftype : longint;
+ fflags : longint; {copy of mount flags}
+ spare : array [0..1] of longint; { For later use }
+ fstypename : array[0..15] of char;
+ mountpoint : array[0..89] of char;
+ mnfromname : array[0..89] of char;
+ end;
+ PStatFS=^TStatFS;
+
+
+{
+ $Log: systypes.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/termio.pp b/rtl/openbsd/termio.pp
new file mode 100644
index 0000000000..1d7fc4db68
--- /dev/null
+++ b/rtl/openbsd/termio.pp
@@ -0,0 +1,49 @@
+{
+ $Id: termio.pp,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file contains the termios interface.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit termio;
+
+interface
+
+Uses BaseUnix; // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.
+
+{
+ $Log: termio.pp,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/termios.inc b/rtl/openbsd/termios.inc
new file mode 100644
index 0000000000..adb1f5d525
--- /dev/null
+++ b/rtl/openbsd/termios.inc
@@ -0,0 +1,371 @@
+{
+ $Id: termios.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Termios header for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+CONST
+
+{
+ * Special Control Characters
+ *
+ * Index into c_cc[] character array.
+ *
+ * Name Subscript Enabled by
+ }
+ VEOF =0;
+ VEOL =1;
+ VEOL2 =2;
+ VERASE =3;
+ VWERASE =4;
+ VKILL =5;
+ VREPRINT =6;
+{ =7; spare 1 }
+ VINTR =8;
+ VQUIT =9;
+ VSUSP =10;
+ VDSUSP =11;
+ VSTART =12;
+ VSTOP =13;
+ VLNEXT =14;
+ VDISCARD =15;
+ VMIN =16;
+ VTIME =17;
+ VSTATUS =18;
+{ =19 spare 2 }
+ NCCS =20;
+
+Type
+ winsize = packed record
+ ws_row,
+ ws_col,
+ ws_xpixel,
+ ws_ypixel : word;
+ end;
+ TWinSize=winsize;
+
+
+type
+ Termios = packed record
+ c_iflag,
+ c_oflag,
+ c_cflag,
+ c_lflag : longint;
+ c_line : char;
+ c_cc : array[0..NCCS-1] of byte;
+ {$IFDEF BSD}
+ c_ispeed,
+ c_ospeed : longint;
+ {$endif}
+ end;
+ TTermios=Termios;
+
+CONST
+
+
+ POSIX_VDISABLE=Chr($ff);
+{
+
+#define CCEQ(val, c) ((c) == (val) ? (val) != _POSIX_VDISABLE : 0)
+}
+
+{ * Input flags - software input processing}
+
+ IGNBRK = $1; { ignore BREAK condition }
+ BRKINT = $2; { map BREAK to SIGINTR }
+ IGNPAR = $4; { ignore (discard) parity errors }
+ PARMRK = $8; { mark parity and framing errors }
+ INPCK = $10; { enable checking of parity errors }
+ ISTRIP = $20; { strip 8th bit off chars }
+ INLCR = $40; { map NL into CR }
+ IGNCR = $80; { ignore CR }
+ ICRNL = $100; { map CR to NL (ala CRMOD) }
+ IXON = $200; { enable output flow control }
+ IXOFF = $400; { enable input flow control }
+ IXANY = $800; { any char will restart after stop }
+ IMAXBEL = $2000; { ring bell on input queue full }
+
+{
+ * Output flags - software output processing
+}
+ OPOST = $1; { enable following output processing }
+ ONLCR = $2; { map NL to CR-NL (ala CRMOD) }
+ OXTABS = $4; { expand tabs to spaces }
+ ONOEOT = $8; { discard EOT's (^D) on output) }
+
+{
+ * Control flags - hardware control of terminal
+}
+ CIGNORE = $1; { ignore control flags }
+ CSIZE = $300; { character size mask }
+ CS5 = $0; { 5 bits (pseudo) }
+ CS6 = $100; { 6 bits }
+ CS7 = $200; { 7 bits }
+ CS8 = $300; { 8 bits }
+ CSTOPB = $400; { send 2 stop bits }
+ CREAD = $800; { enable receiver }
+ PARENB = $1000; { parity enable }
+ PARODD = $2000; { odd parity, else even }
+ HUPCL = $4000; { hang up on last close }
+ CLOCAL = $8000; { ignore modem status lines }
+ CCTS_OFLOW = $10000; { CTS flow control of output }
+ CRTS_IFLOW = $20000; { RTS flow control of input }
+ CRTSCTS = (CCTS_OFLOW or CRTS_IFLOW);
+ CDTR_IFLOW = $40000; { DTR flow control of input }
+ CDSR_OFLOW = $80000; { DSR flow control of output }
+ CCAR_OFLOW = $100000; { DCD flow control of output }
+ MDMBUF = $100000; { old name for CCAR_OFLOW }
+
+{
+ * "Local" flags - dumping ground for other state
+ *
+ * Warning: some flags in this structure begin with
+ * the letter "I" and look like they belong in the
+ * input flag.
+ }
+
+ ECHOKE = $1; { visual erase for line kill }
+ ECHOE = $2; { visually erase chars }
+ ECHOK = $4; { echo NL after line kill }
+ ECHO = $8; { enable echoing }
+ ECHONL = $10; { echo NL even if ECHO is off }
+ ECHOPRT = $20; { visual erase mode for hardcopy }
+ ECHOCTL = $40; { echo control chars as ^(Char) }
+ ISIG = $80; { enable signals INTR, QUIT, [D]SUSP }
+ ICANON = $100; { canonicalize input lines }
+ ALTWERASE = $200; { use alternate WERASE algorithm }
+ IEXTEN = $400; { enable DISCARD and LNEXT }
+ EXTPROC = $800; { external processing }
+ TOSTOP = $400000; { stop background jobs from output }
+ FLUSHO = $800000; { output being flushed (state) }
+ NOKERNINFO = $2000000; { no kernel output from VSTATUS }
+ PENDIN =$20000000; { XXX retype pending input (state) }
+ NOFLSH =$80000000; { don't flush after interrupt }
+
+
+
+{
+ * Commands passed to tcsetattr() for setting the termios structure.
+}
+
+CONST
+
+ TCSANOW =0; { make change immediate }
+ TCSADRAIN =1; { drain output, then change }
+ TCSAFLUSH =2; { drain output, flush input }
+ TCSASOFT =$10; { flag - don't alter h.w. state }
+
+{
+ * Standard speeds
+}
+ B0 = 0;
+ B50 = 50;
+ B75 = 75;
+ B110 = 110;
+ B134 = 134;
+ B150 = 150;
+ B200 = 200;
+ B300 = 300;
+ B600 = 600;
+ B1200 = 1200;
+ B1800 = 1800;
+ B2400 = 2400;
+ B4800 = 4800;
+ B9600 = 9600;
+ B19200 = 19200;
+ B38400 = 38400;
+ B7200 = 7200;
+ B14400 = 14400;
+ B28800 = 28800;
+ B57600 = 57600;
+ B76800 = 76800;
+ B115200 =115200;
+ B230400 =230400;
+ EXTA = 19200;
+ EXTB = 38400;
+
+ TCIFLUSH =1;
+ TCOFLUSH =2;
+ TCIOFLUSH =3;
+ TCOOFF =1;
+ TCOON =2;
+ TCIOFF =3;
+ TCION =4;
+
+{
+#include <sys/cdefs.h>
+
+__BEGIN_DECLS
+speed_t cfgetispeed __P((const struct termios *));
+speed_t cfgetospeed __P((const struct termios *));
+int cfsetispeed __P((struct termios *, speed_t));
+int cfsetospeed __P((struct termios *, speed_t));
+int tcgetattr __P((int, struct termios *));
+int tcsetattr __P((int, int, const struct termios *));
+int tcdrain __P((int));
+int tcflow __P((int, int));
+int tcflush __P((int, int));
+int tcsendbreak __P((int, int));
+
+#ifndef _POSIX_SOURCE
+void cfmakeraw __P((struct termios *));
+int cfsetspeed __P((struct termios *, speed_t));
+#endif { !_POSIX_SOURCE }
+__END_DECLS
+
+#endif { !_KERNEL }
+
+
+
+struct winsize {
+ unsigned short ws_row; { rows, in characters }
+ unsigned short ws_col; { columns, in characters }
+ unsigned short ws_xpixel; { horizontal size, pixels }
+ unsigned short ws_ypixel; { vertical size, pixels }
+};
+
+}
+ IOCTLREAD = $40000000;
+ IOCTLWRITE = $80000000;
+ IOCTLVOID = $20000000;
+
+ TIOCMODG = IOCTLREAD+$47400+ 3; { get modem control state }
+ TIOCMODS = IOCTLWRITE+$47400+ 4; { set modem control state }
+ TIOCM_LE =$0001; { line enable }
+ TIOCM_DTR =$0002; { data terminal ready }
+ TIOCM_RTS =$0004; { request to send }
+ TIOCM_ST =$0010; { secondary transmit }
+ TIOCM_SR =$0020; { secondary receive }
+ TIOCM_CTS =$0040; { clear to send }
+ TIOCM_CAR =$0100; { carrier detect }
+ TIOCM_CD =TIOCM_CAR;
+ TIOCM_RNG =$0200; { ring }
+ TIOCM_RI =TIOCM_RNG;
+ TIOCM_DSR =$0400; { data set ready }
+ { 8-10 compat }
+ TIOCEXCL =IOCTLVOID+$7400+ 13; { set exclusive use of tty }
+ TIOCNXCL =IOCTLVOID+$7400+ 14; { reset exclusive use of tty }
+ { 15 unused }
+ TIOCFLUSH =IOCTLWRITE+$47400+ 16; { flush buffers }
+ { 17-18 compat }
+ TIOCGETA =IOCTLREAD+$2C7400+ 19; { get termios struct }
+ TIOCSETA =IOCTLWRITE+$2C7400+ 20; { set termios struct }
+ TIOCSETAW =IOCTLWRITE+$2C7400+ 21; { drain output, set }
+ TIOCSETAF =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
+ TIOCGETD =IOCTLREAD+$47400+ 26; { get line discipline }
+ TIOCSETD =IOCTLWRITE+$47400+ 27; { set line discipline }
+ { 127-124 compat }
+ TIOCSBRK =IOCTLVOID+$7400+ 123; { set break bit }
+ TIOCCBRK =IOCTLVOID+$7400+ 122; { clear break bit }
+ TIOCSDTR =IOCTLVOID+$7400+ 121; { set data terminal ready }
+ TIOCCDTR =IOCTLVOID+$7400+ 120; { clear data terminal ready }
+ TIOCGPGRP =IOCTLREAD+$47400+ 119; { get pgrp of tty }
+ TIOCSPGRP =IOCTLWRITE+$47400+ 118; { set pgrp of tty }
+ { 117-116 compat }
+ TIOCOUTQ =IOCTLREAD+$47400+ 115; { output queue size }
+ TIOCSTI =IOCTLWRITE+$17400+ 114; { simulate terminal input }
+ TIOCNOTTY =IOCTLVOID+$7400+ 113; { void tty association }
+ TIOCPKT =IOCTLWRITE+$47400+ 112; { pty: set/clear packet mode }
+ TIOCPKT_DATA =$00; { data packet }
+ TIOCPKT_FLUSHREAD =$01; { flush packet }
+ TIOCPKT_FLUSHWRITE =$02; { flush packet }
+ TIOCPKT_STOP =$04; { stop output }
+ TIOCPKT_START =$08; { start output }
+ TIOCPKT_NOSTOP =$10; { no more ^S, ^Q }
+ TIOCPKT_DOSTOP =$20; { now do ^S ^Q }
+ TIOCPKT_IOCTL =$40; { state change of pty driver }
+ TIOCSTOP =IOCTLVOID+$7400+ 111; { stop output, like ^S }
+ TIOCSTART =IOCTLVOID+$7400+ 110; { start output, like ^Q }
+ TIOCMSET =IOCTLWRITE+$47400+ 109; { set all modem bits }
+ TIOCMBIS =IOCTLWRITE+$47400+ 108; { bis modem bits }
+ TIOCMBIC =IOCTLWRITE+$47400+ 107; { bic modem bits }
+ TIOCMGET =IOCTLREAD+$47400+ 106; { get all modem bits }
+ TIOCREMOTE =IOCTLWRITE+$47400+ 105; { remote input editing }
+ TIOCGWINSZ =IOCTLREAD+$87400+ 104; { get window size }
+ TIOCSWINSZ =IOCTLWRITE+$87400+ 103; { set window size }
+ TIOCUCNTL =IOCTLWRITE+$47400+ 102; { pty: set/clr usr cntl mode }
+ TIOCSTAT =IOCTLVOID+$7400+ 101; { simulate ^T status message }
+ // UIOCCMD(n) _IO('u', n) { usr cntl op "n" }
+ TIOCCONS =IOCTLWRITE+$47400+ 98; { become virtual console }
+ TIOCSCTTY =IOCTLVOID+$7400+ 97; { become controlling tty }
+ TIOCEXT =IOCTLWRITE+$47400+ 96; { pty: external processing }
+ TIOCSIG =IOCTLVOID+$7400+ 95; { pty: generate signal }
+ TIOCDRAIN =IOCTLVOID+$7400+ 94; { wait till output drained }
+ TIOCMSDTRWAIT =IOCTLWRITE+$47400+ 91; { modem: set wait on close }
+ TIOCMGDTRWAIT =IOCTLREAD+$47400+ 90; { modem: get wait on close }
+ TIOCTIMESTAMP =IOCTLREAD+$87400+ 89; { enable/get timestamp
+ * of last input event }
+ TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
+ * of last DCd rise }
+ TIOCSDRAINWAIT =IOCTLWRITE+$47400+ 87; { set ttywait timeout }
+ TIOCGDRAINWAIT =IOCTLREAD+$47400+ 86; { get ttywait timeout }
+
+ TTYDISC =0; { termios tty line discipline }
+ SLIPDISC =4; { serial IP discipline }
+ PPPDISC =5; { PPP discipline }
+ NETGRAPHDISC =6; { Netgraph tty node discipline }
+
+
+{
+ * Defaults on "first" open.
+ }
+ TTYDEF_IFLAG =(BRKINT or ICRNL or IMAXBEL or IXON or IXANY);
+ TTYDEF_OFLAG =(OPOST or ONLCR);
+ TTYDEF_LFLAG =(ECHO or ICANON or ISIG or IEXTEN or ECHOE or ECHOKE or ECHOCTL);
+ TTYDEF_CFLAG =(CREAD or CS8 or HUPCL);
+ TTYDEF_SPEED =(B9600);
+
+
+
+{
+ * Control Character Defaults
+ }
+ CtrlMask = $1f; {\037}
+ CEOF =chr( ORD('d') and CtrlMask);
+ CEOL =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
+ CERASE =chr( $7F and CtrlMask);
+ CINTR =chr(ORD('c') and CtrlMask);
+ CSTATUS =chr(ORD('t') and CtrlMask);
+ CKILL =chr(ORD('u') and CtrlMask);
+ CMIN =chr(1);
+ CQUIT =chr(034 and CtrlMask); { FS, ^\ }
+ CSUSP =chr(ORD('z') and CtrlMask);
+ CTIME =chr(0);
+ CDSUSP =chr(ORD('y') and CtrlMask);
+ CSTART =chr(ORD('q') and CtrlMask);
+ CSTOP =chr(ORD('s') and CtrlMask);
+ CLNEXT =chr(ORD('v') and CtrlMask);
+ CDISCARD =chr(ORD('o') and CtrlMask);
+ CWERASE =chr(ORD('w') and CtrlMask);
+ CREPRINT =chr(ORD('r') and CtrlMask);
+ CEOT =CEOF;
+{ compat }
+ CBRK =CEOL;
+ CRPRNT =CREPRINT;
+ CFLUSH =CDISCARD;
+
+
+{
+ * TTYDEFCHARS to include an array of default control characters.
+}
+ ttydefchars : array[0..NCCS-1] OF char =(
+ CEOF, CEOL, CEOL, CERASE, CWERASE, CKILL, CREPRINT,
+ POSIX_VDISABLE, CINTR, CQUIT, CSUSP, CDSUSP, CSTART, CSTOP, CLNEXT,
+ CDISCARD, CMIN, CTIME, CSTATUS, POSIX_VDISABLE);
+
+{
+ $Log: termios.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/termiosproc.inc b/rtl/openbsd/termiosproc.inc
new file mode 100644
index 0000000000..93f418d952
--- /dev/null
+++ b/rtl/openbsd/termiosproc.inc
@@ -0,0 +1,138 @@
+{
+ $Id: termiosproc.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ Termios implementation for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{******************************************************************************
+ IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+ TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+end;
+
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+ nr:cint;
+begin
+ case OptAct of
+ TCSANOW : nr:=TIOCSETA;
+ TCSADRAIN : nr:=TIOCSETAW;
+ TCSAFLUSH : nr:=TIOCSETAF;
+ else
+ begin
+ fpsetErrNo(ESysEINVAL);
+ TCSetAttr:=-1;
+ exit;
+ end;
+ end;
+ TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ tios.c_ospeed:=speed;
+end;
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+ with tios do
+ begin
+ c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
+ PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+ IGNPAR));
+ c_iflag:=c_iflag OR IGNBRK;
+ c_oflag:=c_oflag and (not OPOST);
+ c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+ ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
+ c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+end;
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+ TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+end;
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+ TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+ TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+ TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+ case act OF
+ TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
+ TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,nil);
+ TCIOFF : {N/I}
+ end;
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+ TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
+end;
+
+Function IsATTY (Handle:cint):cint;
+{
+ Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+var
+ t : Termios;
+begin
+ IsAtty:=TCGetAttr(Handle,t);
+end;
+
+
+Function IsATTY(var f: text):cint;
+{
+ Idem as previous, only now for text variables.
+}
+begin
+ IsATTY:=IsaTTY(textrec(f).handle);
+end;
+
+{
+ $Log: termiosproc.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/tthread.inc b/rtl/openbsd/tthread.inc
new file mode 100644
index 0000000000..e54f45c0a1
--- /dev/null
+++ b/rtl/openbsd/tthread.inc
@@ -0,0 +1,604 @@
+{
+ $Id: tthread.inc,v 1.5 2005/03/01 20:38:49 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ TThread implementation old (1.0) and new (pthreads) style
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{$IFDEF VER1_0} // leaving the old implementation in for now...
+type
+ PThreadRec=^TThreadRec;
+ TThreadRec=record
+ thread : TThread;
+ next : PThreadRec;
+ end;
+
+var
+ ThreadRoot : PThreadRec;
+ ThreadsInited : boolean;
+// MainThreadID: longint;
+
+Const
+ ThreadCount: longint = 0;
+
+function ThreadSelf:TThread;
+var
+ hp : PThreadRec;
+ sp : Pointer;
+begin
+ sp:=SPtr;
+ hp:=ThreadRoot;
+ while assigned(hp) do
+ begin
+ if (sp<=hp^.Thread.FStackPointer) and
+ (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+ begin
+ Result:=hp^.Thread;
+ exit;
+ end;
+ hp:=hp^.next;
+ end;
+ Result:=nil;
+end;
+
+
+//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
+procedure SIGCHLDHandler(Sig: longint); cdecl;
+
+begin
+ fpwaitpid(-1, nil, WNOHANG);
+end;
+
+procedure InitThreads;
+var
+ Act, OldAct: Baseunix.PSigActionRec;
+begin
+ ThreadRoot:=nil;
+ ThreadsInited:=true;
+
+
+// This will install SIGCHLD signal handler
+// signal() installs "one-shot" handler,
+// so it is better to install and set up handler with sigaction()
+
+ GetMem(Act, SizeOf(SigActionRec));
+ GetMem(OldAct, SizeOf(SigActionRec));
+
+ Act^.sa_handler := TSigAction(@SIGCHLDHandler);
+ Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
+ Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
+ FpSigAction(SIGCHLD, Act, OldAct);
+
+ FreeMem(Act, SizeOf(SigActionRec));
+ FreeMem(OldAct, SizeOf(SigActionRec));
+end;
+
+
+procedure DoneThreads;
+var
+ hp : PThreadRec;
+begin
+ while assigned(ThreadRoot) do
+ begin
+ ThreadRoot^.Thread.Destroy;
+ hp:=ThreadRoot;
+ ThreadRoot:=ThreadRoot^.Next;
+ dispose(hp);
+ end;
+ ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+ hp : PThreadRec;
+begin
+ { Need to initialize threads ? }
+ if not ThreadsInited then
+ InitThreads;
+
+ { Put thread in the linked list }
+ new(hp);
+ hp^.Thread:=t;
+ hp^.next:=ThreadRoot;
+ ThreadRoot:=hp;
+
+ inc(ThreadCount, 1);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+ lasthp,hp : PThreadRec;
+begin
+ hp:=ThreadRoot;
+ lasthp:=nil;
+ while assigned(hp) do
+ begin
+ if hp^.Thread=t then
+ begin
+ if assigned(lasthp) then
+ lasthp^.next:=hp^.next
+ else
+ ThreadRoot:=hp^.next;
+ dispose(hp);
+ exit;
+ end;
+ lasthp:=hp;
+ hp:=hp^.next;
+ end;
+
+ Dec(ThreadCount, 1);
+ if ThreadCount = 0 then DoneThreads;
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;cdecl;
+var
+ FreeThread: Boolean;
+ Thread : TThread absolute args;
+begin
+ while Thread.FHandle = 0 do fpsleep(1);
+ if Thread.FSuspended then Thread.suspend();
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ Result := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then
+ Thread.Free;
+ fpexit(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: Integer;
+begin
+ inherited Create;
+ AddThread(self);
+ FSuspended := CreateSuspended;
+ Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
+ { Setup 16k of stack }
+ FStackSize:=16384;
+ Getmem(FStackPointer,FStackSize);
+ inc(FStackPointer,FStackSize);
+ FCallExitProcess:=false;
+ { Clone }
+ FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
+// if FSuspended then Suspend;
+ FThreadID := FHandle;
+ IsMultiThread := TRUE;
+ FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished and not Suspended then
+ begin
+ Terminate;
+ WaitFor;
+ end;
+ if FHandle <> -1 then
+ fpkill(FHandle, SIGKILL);
+ dec(FStackPointer,FStackSize);
+ Freemem(FStackPointer);
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread(self);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+
+const
+{ I Don't know idle or timecritical, value is also 20, so the largest other
+ possibility is 19 (PFV) }
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,9,10,19,20);
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := fpGetPriority(Prio_Process,FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+ FSuspended := true;
+ fpKill(FHandle, SIGSTOP);
+end;
+
+
+procedure TThread.Resume;
+begin
+ fpKill(FHandle, SIGCONT);
+ FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+ status : longint;
+begin
+ if FThreadID = MainThreadID then
+ fpwaitpid(0,@status,0)
+ else
+ fpwaitpid(FHandle,@status,0);
+ Result:=status;
+end;
+{$ELSE}
+
+{
+ What follows, is a short description on my implementation of TThread.
+ Most information can also be found by reading the source and accompanying
+ comments.
+
+ A thread is created using BeginThread, which in turn calls
+ pthread_create. So the threads here are always posix threads.
+ Posix doesn't define anything for suspending threads as this is
+ inherintly unsafe. Just don't suspend threads at points they cannot
+ control. Therefore, I didn't implement .Suspend() if its called from
+ outside the threads execution flow (except on Linux _without_ NPTL).
+
+ The implementation for .suspend uses a semaphore, which is initialized
+ at thread creation. If the thread tries to suspend itself, we simply
+ let it wait on the semaphore until it is unblocked by someone else
+ who calls .Resume.
+
+ If a thread is supposed to be suspended (from outside its own path of
+ execution) on a system where the symbol LINUX is defined, two things
+ are possible.
+ 1) the system has the LinuxThreads pthread implementation
+ 2) the system has NPTL as the pthread implementation.
+
+ In the first case, each thread is a process on its own, which as far as
+ know actually violates posix with respect to signal handling.
+ But we can detect this case, because getpid(2) will
+ return a different PID for each thread. In that case, sending SIGSTOP
+ to the PID associated with a thread will actually stop that thread
+ only.
+ In the second case, this is not possible. But getpid(2) returns the same
+ PID across all threads, which is detected, and TThread.Suspend() does
+ nothing in that case. This should probably be changed, but I know of
+ no way to suspend a thread when using NPTL.
+
+ If the symbol LINUX is not defined, then the unimplemented
+ function SuspendThread is called.
+
+ Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+ I don't like this. It eats up 2 filedescriptors for each thread,
+ and those are a limited resource. If you have a server programm
+ handling client connections (one per thread) it will not be able
+ to handle many if we use 2 fds already for internal structures.
+ However, right now I don't see a better option unless some sem_*
+ functions are added to systhrds.
+ I encapsulated all used functions here to make it easier to
+ change them completely.
+}
+
+function SemaphoreInit: Pointer;
+begin
+ SemaphoreInit := GetMem(SizeOf(TFilDes));
+ fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+ b: byte;
+begin
+ fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+ fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+ fpclose(PFilDes(FSem)^[0]);
+ fpclose(PFilDes(FSem)^[1]);
+ FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+ ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+ GMainPID: LongInt = 0;
+{$ENDIF}
+const
+ // stupid, considering its not even implemented...
+ Priorities: array [TThreadPriority] of Integer =
+ (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+ if not ThreadsInited then begin
+ ThreadsInited := true;
+ {$IFDEF LINUX}
+ GMainPid := fpgetpid();
+ {$ENDIF}
+ end;
+end;
+
+procedure DoneThreads;
+begin
+ ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+ a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //} // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt; cdecl;
+var
+ LThread: TThread;
+ c: char;
+begin
+ WRITE_DEBUG('ThreadFunc is here...');
+ LThread := TThread(parameter);
+ {$IFDEF LINUX}
+ // save the PID of the "thread"
+ // this is different from the PID of the main thread if
+ // the LinuxThreads implementation is used
+ LThread.FPid := fpgetpid();
+ {$ENDIF}
+ WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+ try
+ if LThread.FInitialSuspended then begin
+ SemaphoreWait(LThread.FSem);
+ if not LThread.FSuspended then begin
+ LThread.FInitialSuspended := false;
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ end else begin
+ WRITE_DEBUG('going into LThread.Execute');
+ LThread.Execute;
+ end;
+ except
+ on e: exception do begin
+ WRITE_DEBUG('got exception: ',e.message);
+ LThread.FFatalException := TObject(AcquireExceptionObject);
+ // not sure if we should really do this...
+ // but .Destroy was called, so why not try FreeOnTerminate?
+ if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+ end;
+ end;
+ WRITE_DEBUG('thread done running');
+ Result := LThread.FReturnValue;
+ WRITE_DEBUG('Result is ',Result);
+ LThread.FFinished := True;
+ LThread.DoTerminate;
+ if LThread.FreeOnTerminate then begin
+ WRITE_DEBUG('Thread should be freed');
+ LThread.Free;
+ WRITE_DEBUG('Thread freed');
+ end;
+ WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+ // lets just hope that the user doesn't create a thread
+ // via BeginThread and creates the first TThread Object in there!
+ InitThreads;
+ inherited Create;
+ FSem := SemaphoreInit;
+ FSuspended := CreateSuspended;
+ FSuspendedExternal := false;
+ FInitialSuspended := CreateSuspended;
+ FFatalException := nil;
+ WRITE_DEBUG('creating thread, self = ',longint(self));
+ FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+ WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if FThreadID = GetCurrentThreadID then begin
+ raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+ end;
+ // if someone calls .Free on a thread with
+ // FreeOnTerminate, then don't crash!
+ FFreeOnTerminate := false;
+ if not FFinished and not FSuspended then begin
+ Terminate;
+ WaitFor;
+ end;
+ if (FInitialSuspended) then begin
+ // thread was created suspended but never woken up.
+ SemaphorePost(FSem);
+ WaitFor;
+ end;
+ FFatalException.Free;
+ FFatalException := nil;
+ SemaphoreDestroy(FSem);
+ inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend
+ else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ if not FSuspended then begin
+ if FThreadID = GetCurrentThreadID then begin
+ FSuspended := true;
+ SemaphoreWait(FSem);
+ end else begin
+ FSuspendedExternal := true;
+{$IFDEF LINUX}
+ // naughty hack if the user doesn't have Linux with NPTL...
+ // in that case, the PID of threads will not be identical
+ // to the other threads, which means that our thread is a normal
+ // process that we can suspend via SIGSTOP...
+ // this violates POSIX, but is the way it works on the
+ // LinuxThreads pthread implementation. Not with NPTL, but in that case
+ // getpid(2) also behaves properly and returns the same PID for
+ // all threads. Thats actually (FINALLY!) native thread support :-)
+ if FPid <> GMainPID then begin
+ FSuspended := true;
+ fpkill(FPid, SIGSTOP);
+ end;
+{$ELSE}
+ SuspendThread(FHandle);
+{$ENDIF}
+ end;
+ end;
+end;
+
+
+procedure TThread.Resume;
+begin
+ if (not FSuspendedExternal) then begin
+ if FSuspended then begin
+ FSuspended := False;
+ SemaphorePost(FSem);
+ end;
+ end else begin
+ FSuspendedExternal := false;
+ ResumeThread(FHandle);
+ end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+ WRITE_DEBUG('waiting for thread ',FHandle);
+ WaitFor := WaitForThreadTerminate(FHandle, 0);
+ WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ // no need to check if FOnTerminate <> nil, because
+ // thats already done in DoTerminate
+ FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := ThreadGetPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then
+ Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+{$ENDIF}
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.5 2005/03/01 20:38:49 jonas
+ * fixed web bug 3387: if one called resume right after creating a
+ suspended thread, it was possible that resume was executed before
+ that thread had completed its initialisation in BeginThread ->
+ FInitialSuspended was set to false in resume and nevertheless a
+ semafore was posted
+ * second problem fixed: set FSuspended to false before waking up the
+ thread, so that it doesn't get FSuspended = true right after waking
+ up. This should be done atomically to be completely correct though.
+
+ Revision 1.4 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/unixsock.inc b/rtl/openbsd/unixsock.inc
new file mode 100644
index 0000000000..56d5bb20b0
--- /dev/null
+++ b/rtl/openbsd/unixsock.inc
@@ -0,0 +1,218 @@
+{
+ $Id: unixsock.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2000-2003 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ socket call implementations for FreeBSD
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ Socket:=Do_Syscall(syscall_nr_socket,Domain,SocketType,Protocol);
+end;
+
+Function CloseSocket (Sock:Longint):Longint;
+begin
+ if fpclose(Sock)=0 then
+ CloseSocket := 0 else
+ CloseSocket := -1;
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+begin
+ Send:=do_syscall(syscall_nr_sendto,Sock,Longint(@Buf),BufLen,Flags,0,0);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+begin
+ Sendto:=do_syscall(syscall_nr_Sendto,Sock,Longint(@Buf),BufLen,Flags,Longint(@Addr),AddrLen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=do_syscall(syscall_nr_Recvfrom,Sock,Longint(@Buf),BufLen,Flags,0,0);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr ; AddrLen : Integer) : longint;
+
+begin
+ RecvFrom:=do_syscall(syscall_nr_Recvfrom,Sock,Longint(@buf),buflen,flags,Longint(@Addr),AddrLen);
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+begin
+ Bind:=(do_syscall(syscall_nr_Bind,Sock,Longint(@Addr),AddrLen)=0);
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+begin
+ Listen:=(do_syscall(syscall_nr_Listen,Sock,MaxConnect,0)=0);
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ Accept:=do_syscall(syscall_nr_accept,Sock,longint(@Addr),longint(@AddrLen));
+ If Accept<0 Then
+ Accept:=-1;
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint): boolean;
+
+begin
+ Connect:=do_syscall(syscall_nr_connect,Sock,longint(@Addr),AddrLen)=0;
+end;
+
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+ ShutDown:=do_syscall(syscall_nr_shutdown,Sock,How);
+end;
+
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=do_syscall(syscall_nr_GetSockName,Sock,longint(@Addr),longint(@AddrLen));
+end;
+
+
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=do_syscall(syscall_nr_GetPeerName,Sock,longint(@Addr),longint(@AddrLen));
+end;
+
+
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+begin
+ SetSocketOptions:=do_syscall(syscall_nr_SetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
+end;
+
+
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=do_syscall(syscall_nr_GetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
+end;
+
+
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ SocketPair:=do_syscall(syscall_nr_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+end;
+
+{******************************************************************************
+ UnixSock
+******************************************************************************}
+
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+begin
+ Move(Addr[1],t.Path,length(Addr));
+ t.Family:=AF_UNIX;
+ t.Path[length(Addr)]:=#0;
+ Len:=Length(Addr)+3;
+end;
+
+
+Function Bind(Sock:longint;const addr:string):boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ Bind(Sock,UnixAddr,AddrLen);
+ Bind:=(SocketError=0);
+end;
+
+
+
+Function DoAccept(Sock:longint;var addr:string):longint;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ AddrLen:=length(addr)+3;
+ DoAccept:=Accept(Sock,UnixAddr,AddrLen);
+ Move(UnixAddr.Path,Addr[1],AddrLen);
+ SetLength(Addr,AddrLen);
+end;
+
+
+
+Function DoConnect(Sock:longint;const addr:string):Boolean;
+var
+ UnixAddr : TUnixSockAddr;
+ AddrLen : longint;
+begin
+ Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+ DoConnect:=Connect(Sock,UnixAddr,AddrLen);
+end;
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2Text(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+var
+ s : longint;
+begin
+ S:=DoAccept(Sock,addr);
+ if S>0 then
+ begin
+ Sock2File(S,SockIn,SockOut);
+ Accept:=true;
+ end
+ else
+ Accept:=false;
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ If Connect then
+ Sock2Text(Sock,SockIn,SockOut);
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+begin
+ Connect:=DoConnect(Sock,addr);
+ if Connect then
+ Sock2File(Sock,SockIn,SockOut);
+end;
+
+{
+ $Log: unixsock.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/openbsd/unixsysc.inc b/rtl/openbsd/unixsysc.inc
new file mode 100644
index 0000000000..015803034e
--- /dev/null
+++ b/rtl/openbsd/unixsysc.inc
@@ -0,0 +1,283 @@
+{
+ $Id: unixsysc.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{
+function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+{NOT IMPLEMENTED YET UNDER BSD}
+begin // perhaps it is better to implement the hack from solaris then this msg
+ HALT;
+END;
+
+ if (pointer(func)=nil) or (sp=nil) then
+ begin
+ Lfpseterrno(EsysEInval);
+ exit(-1);
+ end;
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ pushl %ebx
+ // movl flags,%ebx
+ movl $251,%eax
+ int $0x80
+ popl %ebx
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+end;
+}
+
+{$ifndef FPC_USE_LIBC}
+Function fsync (fd : cint) : cint;
+
+begin
+ fsync:=do_syscall(syscall_nr_fsync,fd);
+end;
+
+Function Flock (fd,mode : longint) : cint;
+
+begin
+ Flock:=do_syscall(syscall_nr_flock,fd,mode);
+end;
+
+Function fStatFS(Fd:Longint;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+
+begin
+ fStatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info));
+end;
+
+Function StatFS(path:pchar;Var Info:tstatfs):cint;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+
+begin
+ StatFS:=do_syscall(syscall_nr_statfs,longint(path),longint(@info));
+end;
+
+// needs oldfpccall;
+Function intAssignPipe(var pipe_in,pipe_out:longint;var errn:cint):cint; {$ifndef ver1_0} oldfpccall;{$endif}
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+
+begin
+{$ifdef cpui386}
+ asm
+ mov $42,%eax
+ int $0x80
+ jb .Lerror
+ mov pipe_in,%ebx
+ mov %eax,(%ebx)
+ mov pipe_out,%ebx
+ mov $0,%eax
+ mov %edx,(%ebx)
+ mov %eax,%ebx
+ jmp .Lexit
+.Lerror:
+ mov %eax,%ebx
+ mov $-1,%eax
+.Lexit:
+ mov Errn,%edx
+ mov %ebx,(%edx)
+ end;
+{$endif}
+end;
+
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^longint;
+ res : longint;
+
+begin
+ do_syscall(syscall_nr_close,Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+ res : cint;
+
+begin
+ do_syscall(syscall_nr_close,filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+function MUnMap (P : Pointer; Size : size_t) : cint;
+
+begin
+ MUnMap:=do_syscall(syscall_nr_munmap,longint(P),Size);
+end;
+{$else}
+
+Function PClose(Var F:file) : cint;
+var
+ pl : ^cint;
+ res : cint;
+
+begin
+ fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+Function PClose(Var F:text) :cint;
+var
+ pl : ^longint;
+ res : longint;
+
+begin
+ fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ fpwaitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+{$endif}
+// can't have oldfpccall here, linux doesn't need it.
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ ret : longint;
+ errn : cint;
+ {$ifdef FPC_USE_LIBC}
+ fdis : array[0..1] of cint;
+ {$endif}
+begin
+{$ifndef FPC_USE_LIBC}
+ ret:=intAssignPipe(pipe_in,pipe_out,errn);
+ if ret=-1 Then
+ fpseterrno(errn);
+{$ELSE}
+ fdis[0]:=pipe_in;
+ fdis[1]:=pipe_out;
+ ret:=pipe(fdis);
+ pipe_in:=fdis[0];
+ pipe_out:=fdis[1];
+{$ENDIF}
+ AssignPipe:=ret;
+end;
+
+
+{
+function intClone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; {$ifndef ver1_0} oldfpccall; {$endif}
+
+
+var lerrno : Longint;
+ errset : Boolean;
+ Res : Longint;
+begin
+ errset:=false;
+ Res:=0;
+asm
+ pushl %esi
+ movl 12(%ebp), %esi // get stack addr
+ subl $4, %esi
+ movl 20(%ebp), %eax // get __arg
+ movl %eax, (%esi)
+ subl $4, %esi
+ movl 8(%ebp), %eax // get __fn
+ movl %eax, (%esi)
+ pushl 16(%ebp)
+ pushl %esi
+ mov syscall_nr_rfork, %eax
+ int $0x80 // call actualsyscall
+ jb .L2
+ test %edx, %edx
+ jz .L1
+ movl %esi,%esp
+ popl %eax
+ call %eax
+ addl $8, %esp
+ call halt // Does not return
+.L2:
+ mov %eax,LErrNo
+ mov $true,Errset
+ mov $-1,%eax
+// jmp .L1
+.L1:
+ addl $8, %esp
+ popl %esi
+ mov %eax,Res
+end;
+ If ErrSet Then
+ fpSetErrno(LErrno);
+ intClone:=Res;
+end;
+
+
+
+function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+
+begin
+ Clone:=
+ intclone(tclonefunc(func),sp,flags,args);
+end;
+}
+
+
+{
+ $Log: unixsysc.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/Makefile b/rtl/os2/Makefile
new file mode 100644
index 0000000000..f0320d94f7
--- /dev/null
+++ b/rtl/os2/Makefile
@@ -0,0 +1,2028 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=os2
+override CPU_TARGET_DEFAULT=i386
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysos2
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings ports os2def doscalls moncalls kbdcalls moucalls viocalls pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi dos crt objects printer matrix sysutils classes math typinfo varutils winsock charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs video mouse keyboard variants types rtlconst sysconst dateutil strutils convutil
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo variants pmhelp classes sysconst dateutil
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+%$(OEXT) : %.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)$*$(OEXT) $*.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pas
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ $(SYSTEMUNIT)$(PPUEXT)
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmstddlg$(PPUEXT) : pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmhelp$(PPUEXT) : pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmdev$(PPUEXT) : pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmspl$(PPUEXT) : pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmshl$(PPUEXT) : pmshl.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmwp$(PPUEXT) : pmwp.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmwsock$(PPUEXT) : pmwsock.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+winsock$(PPUEXT) : winsock.pas pmwsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+pmbidi$(PPUEXT) : pmbidi.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) varutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp sysutils$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT)
diff --git a/rtl/os2/Makefile.fpc b/rtl/os2/Makefile.fpc
new file mode 100644
index 0000000000..98b0facd7d
--- /dev/null
+++ b/rtl/os2/Makefile.fpc
@@ -0,0 +1,228 @@
+#
+# Makefile.fpc for Free Pascal OS/2 RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0
+units=$(SYSTEMUNIT) ctypes objpas macpas strings \
+ ports os2def doscalls moncalls kbdcalls moucalls viocalls \
+ pmbitmap pmwin pmgpi pmstddlg pmhelp pmdev pmspl pmshl pmwp pmwsock pmbidi \
+ dos crt objects printer matrix \
+ sysutils classes math typinfo varutils winsock \
+ charset ucomplex cpu mmx getopts heaptrc lineinfo dynlibs \
+ video mouse keyboard variants types rtlconst sysconst dateutil \
+ strutils convutil
+rsts=math varutils typinfo variants pmhelp classes sysconst dateutil
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=os2
+cpu=i386
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysos2
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+%$(OEXT) : %.as
+ $(AS) -o $(UNITTARGETDIRPREFIX)$*$(OEXT) $*.as
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pas
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
+
+moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
+
+moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
+
+pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
+
+pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmstddlg$(PPUEXT) : pmstddlg.pas os2def$(PPUEXT) doscalls$(PPUEXT) pmwin$(PPUEXT) pmgpi$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmhelp$(PPUEXT) : pmhelp.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmdev$(PPUEXT) : pmdev.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmspl$(PPUEXT) : pmspl.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmshl$(PPUEXT) : pmshl.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmwp$(PPUEXT) : pmwp.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmwsock$(PPUEXT) : pmwsock.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+winsock$(PPUEXT) : winsock.pas pmwsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+pmbidi$(PPUEXT) : pmbidi.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
+
+#graph$(PPUEXT) : graph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) varutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+
+convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp sysutils$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+#
+# Other system-dependent RTL Units
+#
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT) \ No newline at end of file
diff --git a/rtl/os2/classes.pp b/rtl/os2/classes.pp
new file mode 100644
index 0000000000..ca3132ff47
--- /dev/null
+++ b/rtl/os2/classes.pp
@@ -0,0 +1,57 @@
+{
+ $Id: classes.pp,v 1.6 2005/03/07 17:57:25 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2002 by the Free Pascal development team
+
+ Classes unit for OS/2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ rtlconsts,
+ types,
+ typinfo;
+
+{$i classesh.inc}
+
+
+implementation
+
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.6 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/crt.pas b/rtl/os2/crt.pas
new file mode 100644
index 0000000000..8e33921535
--- /dev/null
+++ b/rtl/os2/crt.pas
@@ -0,0 +1,405 @@
+{****************************************************************************
+
+ $Id: crt.pas,v 1.13 2005/05/14 14:40:45 hajny Exp $
+
+ Standard CRT unit.
+ Free Pascal runtime library for OS/2.
+ Copyright (c) 1997 Daniel Mantione.
+
+ This file may be reproduced and modified under the same conditions
+ as all other Free Pascal source code.
+
+****************************************************************************}
+
+unit crt;
+
+interface
+
+{$IFNDEF VER1_0}
+ {$INLINE ON}
+{$ENDIF VER1_0}
+
+
+{$i crth.inc}
+
+procedure Window32 (X1, Y1, X2, Y2: dword);
+procedure GotoXY32 (X, Y: dword);
+function WhereX32: dword;
+function WhereY32: dword;
+
+
+var
+ ScreenHeight, ScreenWidth: dword;
+(* API *)
+
+
+implementation
+
+{uses keyboard, video;}
+
+
+{$i textrec.inc}
+
+const
+ VioHandle: word = 0;
+
+
+type
+ TKbdKeyInfo = record
+ CharCode, ScanCode: char;
+ fbStatus, bNlsShift: byte;
+ fsState: word;
+ Time: longint;
+ end;
+
+ VioModeInfo = record
+ cb: word; { length of the entire data
+ structure }
+ fbType, { bit mask of mode being set}
+ Color: byte; { number of colors (power of 2) }
+ Col, { number of text columns }
+ Row, { number of text rows }
+ HRes, { horizontal resolution }
+ VRes: word; { vertical resolution }
+ fmt_ID, { attribute format }
+ Attrib: byte; { number of attributes }
+ Buf_Addr, { physical address of
+ videobuffer, e.g. $0b800}
+ Buf_Length, { length of a videopage (bytes)}
+ Full_Length, { total video-memory on video-
+ card (bytes)}
+ Partial_Length: longint; { ????? info wanted !}
+ Ext_Data_Addr: pointer; { ????? info wanted !}
+ end;
+
+ TVioCursorInfo=record
+ case boolean of
+ false: (
+ yStart: word; {Cursor start (top) scan line (0-based)}
+ cEnd: word; {Cursor end (bottom) scan line}
+ cx: word; {Cursor width (0=default width)}
+ Attr: word); {Cursor colour attribute (-1=hidden)}
+ true:(
+ yStartInt: integer; {integer variants can be used to specify negative}
+ cEndInt: integer; {negative values (interpreted as percentage by OS/2)}
+ cxInt: integer;
+ AttrInt: integer);
+ end;
+ PVioCursorInfo = ^TVioCursorInfo;
+
+
+function KbdCharIn (var AKeyRec: TKbdKeyInfo; Wait, KbdHandle: longint):
+ word; cdecl;
+ external 'EMXWRAP' index 204;
+function KbdPeek (var AKeyRec: TKbdKeyInfo; KbdHandle: longint): word; cdecl;
+ external 'EMXWRAP' index 222;
+
+function DosSleep (Time: cardinal): word; cdecl;
+ external 'DOSCALLS' index 229;
+function VioScrollUp (Top, Left, Bottom, Right, Lines: longint;
+ var ScrEl: word; VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 107;
+{$WARNING ScrEl as word not DBCS safe!}
+function VioScrollDn (Top, Left, Bottom, Right, Lines: longint;
+ var ScrEl: word; VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 147;
+function VioScrollRight (Top, Left, Bottom, Right, Columns: word;
+ var ScrEl: word; VioHandle: word): word; cdecl;
+external 'EMXWRAP' index 112;
+{external 'VIOCALLS' index 12;}
+function VioGetCurPos (var Row, Column: word; VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 109;
+function VioSetCurPos (Row, Column, VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 115;
+function VioWrtCharStrAtt (S: PChar; Len, Row, Col: longint; var Attr: byte;
+ VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 148;
+function VioGetMode (var AModeInfo: VioModeInfo; VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 121;
+function VioSetMode (var AModeInfo: VioModeInfo; VioHandle: word): word; cdecl;
+ external 'EMXWRAP' index 122;
+function VioSetCurType (var CurData: TVioCursorInfo; VioHandle: word): word;
+ cdecl;
+external 'EMXWRAP' index 132;
+{external 'VIOCALLS' index 32;}
+function VioGetCurType (var CurData: TVioCursorInfo; VioHandle: word): word;
+ cdecl;
+external 'EMXWRAP' index 127;
+{external 'VIOCALLS' index 27;}
+function VioCreatePS (var VPS: word; Depth, Width, Format, Attrs: integer;
+ Reserved: word): word; cdecl;
+external 'EMXWRAP' index 156;
+{external 'VIOCALLS' index 56;}
+function DosBeep (Freq, MS: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 286;
+
+
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ ExtKeyCode: char;
+
+
+
+function KeyPressed: boolean;
+{Checks if a key is pressed.}
+var
+ AKeyRec: TKbdKeyinfo;
+begin
+ if ExtKeyCode <> #0 then
+ KeyPressed := true
+ else
+ KeyPressed := (KbdPeek (AKeyRec, 0) = 0)
+ and ((AKeyRec.fbStatus and $40) <> 0);
+end;
+
+
+function ReadKey: char;
+{Reads the next character from the keyboard.}
+var
+ AKeyRec: TKbdKeyInfo;
+ C, S: char;
+begin
+ if ExtKeyCode <> #0 then
+ begin
+ ReadKey := ExtKeyCode;
+ ExtKeyCode := #0
+ end
+ else
+ begin
+ KbdCharIn (AKeyRec, 0, 0);
+ C := AKeyRec.CharCode;
+ S := AKeyRec.ScanCode;
+ if (C = #224) and (S <> #0) then
+ C := #0;
+ if C = #0 then
+ ExtKeyCode := S;
+ ReadKey := C;
+ end;
+end;
+
+
+procedure GetScreenCursor (var X, Y: dword);
+{$IFNDEF VER1_0}
+ inline;
+{$ENDIF VER1_0}
+(* Return current cursor postion - 0-based. *)
+var
+ X0, Y0: word;
+begin
+ X := 0;
+ Y := 0;
+ if VioGetCurPos (Y0, X0, VioHandle) = 0 then
+ begin
+ X := X0;
+ Y := Y0;
+ end;
+end;
+
+
+procedure SetScreenCursor (X, Y: dword);
+{$IFNDEF VER1_0}
+ inline;
+{$ENDIF VER1_0}
+(* Set current cursor postion - 0-based. *)
+begin
+ VioSetCurPos (Y, X, VioHandle);
+end;
+
+
+procedure RemoveLines (Row: dword; Cnt: dword);
+{$IFNDEF VER1_0}
+ inline;
+{$ENDIF VER1_0}
+(* Remove Cnt lines from screen starting with (0-based) Row. *)
+var
+ ScrEl: word;
+begin
+ ScrEl := $20 or (TextAttr shl 8);
+ VioScrollUp (Row + WindMinY, WindMinX, WindMaxY, WindMaxX, Cnt, ScrEl,
+ VioHandle);
+end;
+
+
+procedure ClearCells (X, Y, Cnt: dword);
+{$IFNDEF VER1_0}
+ inline;
+{$ENDIF VER1_0}
+(* Clear Cnt cells in line Y (0-based) starting with position X (0-based). *)
+var
+ ScrEl: word;
+begin
+ ScrEl := $20 or (TextAttr shl 8);
+ VioScrollRight (Y, X, Y, X + Pred (Cnt), Cnt, ScrEl, VioHandle);
+end;
+
+
+procedure InsLine;
+(* Inserts a line at cursor position. *)
+var
+ ScrEl: word;
+begin
+ ScrEl := $20 or (TextAttr shl 8);
+ VioScrollDn (Pred (WhereY32) + WindMinY, WindMinX, WindMaxY, WindMaxX, 1,
+ ScrEl, VioHandle);
+end;
+
+
+procedure SetScreenMode (Mode: word);
+var
+ NewMode: VioModeInfo;
+begin
+ NewMode.cb := 8;
+ VioGetMode (NewMode, VioHandle);
+ NewMode.fbType := 1; {Non graphics colour mode.}
+ NewMode.Color := 4; {We want 16 colours, 2^4=16 - requests for BW ignored.}
+ case Mode and $FF of
+ BW40, CO40: NewMode.Col := 40;
+ BW80, CO80: NewMode.Col := 80;
+ else
+ begin
+(* Keep current amount of columns! *)
+ end;
+ end;
+ case Mode and $100 of
+ 0: NewMode.Row := 25;
+ $100: NewMode.Row := 50
+ else
+ begin
+(* Keep current amount of rows! *)
+ end;
+ end;
+ VioSetMode (NewMode, VioHandle);
+ ScreenWidth := NewMode.Col;
+ ScreenHeight := NewMode.Row;
+end;
+
+
+procedure Delay (Ms: word);
+{Waits ms milliseconds.}
+begin
+ DosSleep (Ms)
+end;
+
+
+procedure WriteNormal (C: char; X, Y: dword);
+{$IFNDEF VER1_0}
+ inline;
+{$ENDIF VER1_0}
+(* Write C to console at X, Y (0-based). *)
+begin
+ VioWrtCharStrAtt (@C, 1, Y, X, TextAttr, VioHandle);
+end;
+
+
+procedure WriteBell;
+{$IFNDEF VER1_0}
+ inline;
+{$ENDIF VER1_0}
+(* Write character #7 - beep. *)
+begin
+ DosBeep (800, 250);
+end;
+
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+
+procedure CursorOn;
+var
+ I: TVioCursorInfo;
+begin
+ VioGetCurType (I, VioHandle);
+ with I do
+ begin
+ yStartInt := -90;
+ cEndInt := -100;
+ Attr := 15;
+ end;
+ VioSetCurType (I, VioHandle);
+end;
+
+
+procedure CursorOff;
+var
+ I: TVioCursorInfo;
+begin
+ VioGetCurType (I, VioHandle);
+ I.AttrInt := -1;
+ VioSetCurType (I, VioHandle);
+end;
+
+
+procedure CursorBig;
+var
+ I: TVioCursorInfo;
+begin
+ VioGetCurType (I, VioHandle);
+ with I do
+ begin
+ yStart := 0;
+ cEndInt := -100;
+ Attr := 15;
+ end;
+ VioSetCurType (I, VioHandle);
+end;
+
+
+(* Include common, platform independent part. *)
+{$I crt.inc}
+
+
+{Initialization.}
+
+var
+ CurMode: VioModeInfo;
+begin
+ if not (IsConsole) then
+ VioCreatePS (VioHandle, 25, 80, 1, 1, 0);
+{ InitVideo;}
+ CurMode.cb := SizeOf (CurMode);
+ VioGetMode (CurMode, VioHandle);
+ ScreenWidth := CurMode.Col;
+ ScreenHeight := CurMode.Row;
+ LastMode := 0;
+ case ScreenWidth of
+ 40: LastMode := CO40;
+ 80: LastMode := CO80
+ else
+ LastMode := 255
+ end;
+ case ScreenHeight of
+ 50: LastMode := LastMode + $100
+ else
+ LastMode := LastMode + $FF00;
+ end;
+ CrtInit;
+end.
+
+{
+ $Log: crt.pas,v $
+ Revision 1.13 2005/05/14 14:40:45 hajny
+ * fix for bug 3713 and other - basis for future common implementation prepared
+
+ Revision 1.12 2005/03/30 23:11:35 hajny
+ * OS/2 fixes merged to EMX
+
+ Revision 1.11 2005/03/30 22:42:49 hajny
+ * fix for InsLine
+
+ Revision 1.10 2005/03/30 22:40:25 hajny
+ * fix for 3792
+
+ Revision 1.9 2005/03/30 22:11:55 hajny
+ * patch from Sterling Bates for bug 3762 (with additional enhancements for better compatibility)
+
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/dos.pas b/rtl/os2/dos.pas
new file mode 100644
index 0000000000..ba8c28585e
--- /dev/null
+++ b/rtl/os2/dos.pas
@@ -0,0 +1,540 @@
+{****************************************************************************
+
+ $Id: dos.pas,v 1.45 2005/02/14 17:13:31 peter Exp $
+
+ Free Pascal Runtime-Library
+ DOS unit for OS/2
+ Copyright (c) 1997,1999-2000 by Daniel Mantione,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+
+unit dos;
+
+{$ASMMODE ATT}
+
+{***************************************************************************}
+
+interface
+
+{***************************************************************************}
+
+{$PACKRECORDS 1}
+
+uses Strings, DosCalls;
+
+Type
+ {Search record which is used by findfirst and findnext:}
+ SearchRec = record
+ case boolean of
+ false: (Handle: THandle; {Used in os_OS2 mode}
+ FStat: PFileFindBuf3;
+ Fill: array [1..21 - SizeOf (THandle) - SizeOf (pointer)]
+ of byte;
+ Attr: byte;
+ Time: longint;
+ Size: longint;
+ Name: string); {Filenames can be long in OS/2!}
+ true: (Fill2: array [1..21] of byte;
+ Attr2: byte;
+ Time2: longint;
+ Size2: longint;
+ Name2: string); {Filenames can be long in OS/2!}
+ end;
+
+ {Flags for the exec procedure:
+ }
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+(* For compatibility with VP/2, used for runflags in Exec procedure. *)
+ ExecFlags: cardinal;
+
+{$i dosh.inc}
+
+{OS/2 specific functions}
+
+function GetEnvPChar (EnvVar: string): PChar;
+
+function DosErrorModuleName: string;
+(* In case of an error in Dos.Exec returns the name of the module *)
+(* causing the problem - e.g. name of a missing or corrupted DLL. *)
+
+
+
+implementation
+
+{$DEFINE HAS_GETMSCOUNT}
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+{$DEFINE FPC_FEXPAND_GETENV_PCHAR}
+
+{$I dos.inc}
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ LastDosErrorModuleName: string;
+
+
+const FindResvdMask = $00003737; {Allowed bits in attribute
+ specification for DosFindFirst call.}
+
+
+function GetMsCount: int64;
+var
+ L: cardinal;
+begin
+ DosQuerySysInfo (svMsCount, svMsCount, L, 4);
+ GetMsCount := L;
+end;
+
+
+function fsearch(path:pathstr;dirlist:string):pathstr;
+Var
+ A: array [0..255] of char;
+ D, P: AnsiString;
+begin
+ P:=Path;
+ D:=DirList;
+ DosError := DosSearchPath (dsIgnoreNetErrs, PChar(D), PChar(P), @A, 255);
+ fsearch := StrPas (@A);
+end;
+
+
+procedure getftime(var f;var time:longint);
+var
+ FStat: TFileStatus3;
+begin
+ DosError := DosQueryFileInfo (FileRec (F).Handle, ilStandard, @FStat,
+ SizeOf (FStat));
+ if DosError=0 then
+ begin
+ Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
+ if Time = 0 then
+ Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
+ end else
+ Time:=0;
+end;
+
+
+procedure SetFTime (var F; Time: longint);
+var FStat: TFileStatus3;
+ RC: cardinal;
+begin
+ RC := DosQueryFileInfo (FileRec (F).Handle, ilStandard, @FStat,
+ SizeOf (FStat));
+ if RC = 0 then
+ begin
+ FStat.DateLastAccess := Hi (Time);
+ FStat.DateLastWrite := Hi (Time);
+ FStat.TimeLastAccess := Lo (Time);
+ FStat.TimeLastWrite := Lo (Time);
+ RC := DosSetFileInfo (FileRec (F).Handle, ilStandard, @FStat,
+ SizeOf (FStat));
+ end;
+ DosError := integer (RC);
+end;
+
+
+procedure Exec (const Path: PathStr; const ComLine: ComStr);
+{Execute a program.}
+var Args: PByteArray;
+ ArgSize: word;
+ Res: TResultCodes;
+ ObjName: string;
+ RC: longint;
+ HQ: THandle;
+ SPID, STID, QName: string;
+ SD: TStartData;
+ SID, PID: cardinal;
+ RD: TRequestData;
+ PCI: PChildInfo;
+ CISize: cardinal;
+ Prio: byte;
+const
+ MaxArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
+begin
+{ LastDosExitCode := Exec (Path, ExecRunFlags (ExecFlags), efDefault, ComLine);}
+ QName := FExpand (Path);
+ if ComLine = '' then
+ Args := nil
+ else
+ begin
+ GetMem (Args, MaxArgsSize);
+ ArgSize := 0;
+ Move (QName [1], Args^ [ArgSize], Length (QName));
+ Inc (ArgSize, Length (QName));
+ Args^ [ArgSize] := 0;
+ Inc (ArgSize);
+ {Now do the real arguments.}
+ Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
+ Inc (ArgSize, Length (ComLine));
+ Args^ [ArgSize] := 0;
+ Inc (ArgSize);
+ Args^ [ArgSize] := 0;
+ end;
+ RC := DosExecPgm (ObjName, cardinal (ExecFlags), Args, nil, Res, Path);
+ if RC = 0 then
+ begin
+ LastDosExitCode := Res.ExitCode;
+ LastDosErrorModuleName := '';
+ end
+ else
+ if (RC = 190) or (RC = 191) then
+ begin
+ FillChar (SD, SizeOf (SD), 0);
+ SD.Length := 24;
+ SD.Related := ssf_Related_Child;
+ if Args = nil then
+(* No parameters passed, Args not allocated for DosExecPgm, so allocate now. *)
+ begin
+ GetMem (Args, MaxArgsSize);
+ Move (QName [1], Args^ [0], Length (QName));
+ Args^ [Length (QName)] := 0;
+ end
+ else
+ SD.PgmInputs := PChar (@Args^ [Length (QName) + 1]);
+ SD.PgmName := PChar (Args);
+ SD.InheritOpt := ssf_InhertOpt_Parent;
+ Str (GetProcessID, SPID);
+ Str (ThreadID, STID);
+ QName := '\QUEUES\FPC_Dos_Exec_p' + SPID + 't' + STID + '.QUE'#0;
+ SD.TermQ := @QName [1];
+ RC := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
+ if RC = 0 then
+ begin
+ RC := DosStartSession (SD, SID, PID);
+ if (RC = 0) or (RC = 457) then
+ begin
+ RC := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
+ if RC = 0 then
+ begin
+ LastDosExitCode := PCI^.Return;
+ DosCloseQueue (HQ);
+ DosFreeMem (PCI);
+ end
+ else
+ DosCloseQueue (HQ);
+ end
+ else
+ DosCloseQueue (HQ);
+ end;
+ end
+ else
+ LastDosErrorModuleName := ObjName;
+ if RC <> 0 then
+ LastDosExitCode := 0; (* Needed for TP/BP compatibility *)
+ DosError := RC;
+ if Args <> nil then
+ FreeMem (Args, MaxArgsSize);
+end;
+
+
+function DosErrorModuleName: string;
+begin
+ DosErrorModuleName := LastDosErrorModuleName;
+end;
+
+
+function dosversion:word;
+{Returns OS/2 version}
+var
+ Minor, Major: Cardinal;
+begin
+ DosQuerySysInfo(svMajorVersion, svMajorVersion, Major, 4);
+ DosQuerySysInfo(svMinorVersion, svMinorVersion, Minor, 4);
+ DosVersion:=Major or Minor shl 8;
+end;
+
+
+procedure GetDate (var Year, Month, MDay, WDay: word);
+Var
+ dt: TDateTime;
+begin
+ DosGetDateTime(dt);
+ Year:=dt.year;
+ Month:=dt.month;
+ MDay:=dt.Day;
+ WDay:=dt.Weekday;
+end;
+
+
+procedure SetDate (Year, Month, Day: word);
+var
+ DT: TDateTime;
+begin
+ DosGetDateTime (DT);
+ DT.Year := Year;
+ DT.Month := byte (Month);
+ DT.Day := byte (Day);
+ DosSetDateTime (DT);
+end;
+
+
+procedure GetTime (var Hour, Minute, Second, Sec100: word);
+var
+ dt: TDateTime;
+begin
+ DosGetDateTime(dt);
+ Hour:=dt.Hour;
+ Minute:=dt.Minute;
+ Second:=dt.Second;
+ Sec100:=dt.Hundredths;
+end;
+
+
+procedure SetTime (Hour, Minute, Second, Sec100: word);
+var
+ DT: TDateTime;
+begin
+ DosGetDateTime (DT);
+ DT.Hour := byte (Hour);
+ DT.Minute := byte (Minute);
+ DT.Second := byte (Second);
+ DT.Sec100 := byte (Sec100);
+ DosSetDateTime (DT);
+end;
+
+function DiskFree (Drive: byte): int64;
+var FI: TFSinfo;
+ RC: cardinal;
+begin
+ {In OS/2, we use the filesystem information.}
+ RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskFree := int64 (FI.Free_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskFree := -1;
+end;
+
+
+function DiskSize (Drive: byte): int64;
+var FI: TFSinfo;
+ RC: cardinal;
+begin
+ RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskSize := int64 (FI.Total_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskSize := -1;
+end;
+
+
+procedure DosSearchRec2SearchRec (var F: SearchRec);
+type
+ TRec = record
+ T, D: word;
+ end;
+begin
+ with F do
+ begin
+ Name := FStat^.Name;
+ Size := FStat^.FileSize;
+ Attr := byte(FStat^.AttrFile and $FF);
+ TRec (Time).T := FStat^.TimeLastWrite;
+ TRec (Time).D := FStat^.DateLastWrite;
+ end;
+end;
+
+
+procedure FindFirst (const Path: PathStr; Attr: word; var F: SearchRec);
+
+
+var Count: cardinal;
+
+begin
+ {No error.}
+ DosError := 0;
+ New (F.FStat);
+ F.Handle := THandle ($FFFFFFFF);
+ Count := 1;
+ DosError := integer (DosFindFirst (Path, F.Handle,
+ Attr and FindResvdMask, F.FStat, SizeOf (F.FStat^),
+ Count, ilStandard));
+ if (DosError = 0) and (Count = 0) then DosError := 18;
+ DosSearchRec2SearchRec (F);
+end;
+
+
+procedure FindNext (var F: SearchRec);
+var
+ Count: cardinal;
+begin
+ {No error}
+ DosError := 0;
+ Count := 1;
+ DosError := integer (DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^),
+ Count));
+ if (DosError = 0) and (Count = 0) then DosError := 18;
+ DosSearchRec2SearchRec (F);
+end;
+
+
+procedure FindClose (var F: SearchRec);
+begin
+ if F.Handle <> THandle ($FFFFFFFF) then DosError := DosFindClose (F.Handle);
+ Dispose (F.FStat);
+end;
+
+
+function envcount:longint;
+begin
+ envcount:=envc;
+end;
+
+
+function envstr (index : longint) : string;
+
+var hp:Pchar;
+
+begin
+ if (index<=0) or (index>envcount) then
+ begin
+ envstr:='';
+ exit;
+ end;
+ hp:=EnvP[index-1];
+ envstr:=strpas(hp);
+end;
+
+
+function GetEnvPChar (EnvVar: string): PChar;
+(* The assembler version is more than three times as fast as Pascal. *)
+var
+ P: PChar;
+begin
+ EnvVar := UpCase (EnvVar);
+{$ASMMODE INTEL}
+ asm
+ cld
+ mov edi, Environment
+ lea esi, EnvVar
+ xor eax, eax
+ lodsb
+@NewVar:
+ cmp byte ptr [edi], 0
+ jz @Stop
+ push eax { eax contains length of searched variable name }
+ push esi { esi points to the beginning of the variable name }
+ mov ecx, -1 { our character ('=' - see below) _must_ be found }
+ mov edx, edi { pointer to beginning of variable name saved in edx }
+ mov al, '=' { searching until '=' (end of variable name) }
+ repne
+ scasb { scan until '=' not found }
+ neg ecx { what was the name length? }
+ dec ecx { corrected }
+ dec ecx { exclude the '=' character }
+ pop esi { restore pointer to beginning of variable name }
+ pop eax { restore length of searched variable name }
+ push eax { and save both of them again for later use }
+ push esi
+ cmp ecx, eax { compare length of searched variable name with name }
+ jnz @NotEqual { ... of currently found variable, jump if different }
+ xchg edx, edi { pointer to current variable name restored in edi }
+ repe
+ cmpsb { compare till the end of variable name }
+ xchg edx, edi { pointer to beginning of variable contents in edi }
+ jz @Equal { finish if they're equal }
+@NotEqual:
+ xor eax, eax { look for 00h }
+ mov ecx, -1 { it _must_ be found }
+ repne
+ scasb { scan until found }
+ pop esi { restore pointer to beginning of variable name }
+ pop eax { restore length of searched variable name }
+ jmp @NewVar { ... or continue with new variable otherwise }
+@Stop:
+ xor eax, eax
+ mov P, eax { Not found - return nil }
+ jmp @End
+@Equal:
+ pop esi { restore the stack position }
+ pop eax
+ mov P, edi { place pointer to variable contents in P }
+@End:
+ end ['eax','ecx','edx','esi','edi'];
+ GetEnvPChar := P;
+end;
+{$ASMMODE ATT}
+
+
+Function GetEnv(envvar: string): string;
+(* The assembler version is more than three times as fast as Pascal. *)
+begin
+ GetEnv := StrPas (GetEnvPChar (EnvVar));
+end;
+
+
+procedure GetFAttr (var F; var Attr: word);
+var
+ PathInfo: TFileStatus3;
+ RC: cardinal;
+begin
+ Attr := 0;
+ RC := DosQueryPathInfo (@FileRec (F).Name, ilStandard,
+ @PathInfo, SizeOf (PathInfo));
+ DosError := integer (RC);
+ if RC = 0 then
+ Attr := PathInfo.AttrFile;
+end;
+
+
+procedure SetFAttr (var F; Attr: word);
+var
+ PathInfo: TFileStatus3;
+ RC: cardinal;
+begin
+ RC := DosQueryPathInfo (@FileRec (F).Name, ilStandard,
+ @PathInfo, SizeOf (PathInfo));
+ if RC = 0 then
+ begin
+ PathInfo.AttrFile := Attr;
+ RC := DosSetPathInfo (@FileRec (F).Name, ilStandard, @PathInfo,
+ SizeOf (PathInfo), doWriteThru);
+ end;
+ DosError := integer (RC);
+end;
+
+
+{function GetShortName(var p : String) : boolean;
+begin
+ GetShortName:=true;}
+{$WARNING EA .shortname support (see FAT32 driver) should be probably added here!}
+{end;
+
+function GetLongName(var p : String) : boolean;
+begin
+ GetLongName:=true;}
+{$WARNING EA .longname support should be probably added here!}
+{end;}
+
+
+
+begin
+ LastDosExitCode := 0;
+ LastDosErrorModuleName := '';
+ ExecFlags := 0;
+end.
+
+{
+ $Log: dos.pas,v $
+ Revision 1.45 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/doscalls.pas b/rtl/os2/doscalls.pas
new file mode 100644
index 0000000000..c00857f815
--- /dev/null
+++ b/rtl/os2/doscalls.pas
@@ -0,0 +1,5320 @@
+{
+ $Id: doscalls.pas,v 1.30 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2002 by the Free Pascal development team.
+
+ Basic OS/2 constants, types and functions
+ implemented (mostly) in DOSCALL1.DLL.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit DosCalls;
+
+{***************************************************************************}
+interface
+{***************************************************************************}
+
+uses Strings;
+
+type PString = PShortString;
+
+{$PACKRECORDS 1}
+
+type TByteArray=array[0..$fff0] of byte;
+ PByteArray=^TByteArray;
+ TCharArray=array[0..$fff0] of char;
+ PCharArray=^TCharArray;
+ TWordArray=array[0..$7ff8] of word;
+ PWordArray=^TWordArray;
+
+{****************************************************************************
+ Thread related routines.
+****************************************************************************}
+
+type TThreadEntry = function (Param: pointer): cardinal; cdecl;
+ ThreadEntry = TThreadEntry;
+
+
+const dtSuspended =1; {Thread is started suspended instead of
+ started at once.}
+ dtStack_Commited =2; {Allocate all stack space at once. The
+ operating system normally allocates more
+ memory to the stack if the stack grows with
+ the given stacksize as limit. This has the
+ restriction that you cannot create a stack
+ frame > 4 kb. at once. If you want to do
+ this, or for other reasons you can allocate
+ the complete stack at once with this flag.}
+(* The following for compatibility only *)
+ CREATE_READY =0; { defect 65437 }
+ CREATE_SUSPENDED =dtSuspended;
+ STACK_SPARSE =0;
+ STACK_COMMITTED =dtStack_Commited;
+
+ { Wait option values }
+ dtWait =0; {Wait until termination.}
+ dtNoWait =1; {Do not wait. Return with error if not yet
+ terminated.}
+(* The following for compatibility only *)
+ DCWW_WAIT =dtWait;
+ DCWW_NOWAIT =dtNoWait;
+
+
+{Create a new thread.
+ TID = Thread ID of new thread is returned here.
+ Address = Thread entry point. The new thread starts executing here.
+ AParam = This one is passed to the thread entry procedure.
+ Flags = Flags. Either dtsuspended or dt_stackcommited.
+ StackSize = Size of the stack of the new thread.}
+function DosCreateThread(var TID:longint;Address:TThreadEntry;
+ AParam:pointer;Flags,StackSize:longint):cardinal;cdecl;
+function DosCreateThread (var TID: cardinal; Address: TThreadEntry;
+ AParam: pointer; Flags, StackSize: cardinal): cardinal; cdecl;
+
+(* Overloaded version for compatibility. *)
+function DosCreateThread(var TID:longint;Address:pointer;
+ AParam:Pointer;Flags,StackSize:longint):cardinal;cdecl;
+function DosCreateThread (var TID: cardinal; Address: pointer;
+ AParam: Pointer; Flags, StackSize: cardinal): cardinal; cdecl;
+
+
+{Suspend a running thread.}
+function DosSuspendThread(TID:cardinal):cardinal; cdecl;
+
+{Resume a suspended thread.}
+function DosResumeThread(TID:cardinal):cardinal; cdecl;
+
+{Terminate a specific thread.}
+function DosKillThread(TID:cardinal):cardinal; cdecl;
+
+{Wait until a specific thread has ended.
+ TID = Thread to terminate. Can also be zero. In that case we
+ wait until the next thread terminates. Its thread ID is
+ returned back.
+ Option = Flags. Either dtWait or dtNoWait.}
+function DosWaitThread(var TID:longint;Option:longint):cardinal; cdecl;
+function DosWaitThread(var TID:cardinal;Option:cardinal):cardinal; cdecl;
+
+{All other threads in the same process are suspended until a
+DosExitCritSec.}
+function DosEnterCritSec: cardinal; cdecl;
+
+{Resume the other threads again.}
+function DosExitCritSec: cardinal; cdecl;
+
+{ DosExit codes }
+const deThread=0; {Terminate thread only.}
+ deProcess=1; {Terminate the whole process.}
+(* The following for compatibility only *)
+ Exit_Thread = deThread;
+ Exit_Process = deProcess;
+
+{Terminate the thread or the program. Never returns, so it's defined as
+ procedure.}
+procedure DosExit(Action,Result:cardinal); cdecl;
+
+type PThreadInfoBlock=^TThreadInfoBlock;
+ PPThreadInfoBlock=^PThreadInfoBlock;
+ PSysThreadIB=^TSysThreadIB;
+ PProcessInfoBlock=^TProcessInfoBlock;
+ PPProcessInfoBlock=^PProcessInfoBlock;
+
+ TThreadInfoBlock=record
+ Exh_Chain, {Head of exeption handler chain.}
+ Stack, {Pointer to the thread's stack.}
+ StackLimit:pointer; {Pointer to the thread's stack-end.}
+ TIB2:PSysThreadIB; {Pointer to system specific thread info.}
+ Version, {Version of this datastructure.}
+ Ordinal:cardinal; {Thread ordinal number.}
+ end;
+ ThreadInfoBlock=TThreadInfoBlock;
+
+ TSysThreadIB=record
+ TID, {Thread ID.}
+ Priority, {Low byte of low word: thread priority.
+ High byte of low word: thread class
+ 1 = Idle
+ 2 = Regular
+ 3 = Time critical
+ 4 = Server}
+ Version:cardinal; {Version of this datastructure.}
+ MCCount, {Must complete count. ??? Info wanted!}
+ MCForceFlag:word; {Must complete force flag. Info wanted!}
+ end;
+ SysThreadIB=TSysThreadIB;
+
+ TProcessInfoBlock=record
+ PID, {Process ID.}
+ ParentPID, {Parent's process ID.}
+ HMTE:cardinal; {Module handle of executable program.
+ ??? Info wanted!}
+ Cmd, {Command line options.}
+ Env:PByteArray; {Environment strings.}
+ flStatus, {1 means that the process is in exit list
+ processing.}
+ tType:cardinal; {Type of process:
+ 0: Full screen protected mode.
+ 1: DOS emulation.
+ 2: Windowable full screen protected
+ mode program.
+ 3: Presentation manager program.
+ 4: Detached mode process.}
+ end;
+ ProcessInfoBlock=TProcessInfoBlock;
+
+{OS/2 keeps information about the current process and the current thread
+ is the datastructures TProcessInfoBlock and TThreadInfoBlock. All data
+ can both be read and be changed. Use DosGetInfoBlocks to get their
+ address. The service cannot fail, so it is defined as procedure. The
+ second version of the call might be useful if you only want address of one
+ of those datastructures, since you can supply nil for the other parameter
+ then - beware, omitting one of these parameters (passing nil) is only
+ supported on newer OS/2 versions, and causes SIGSEGV on e.g. OS/2 v2.1!!!}
+
+procedure DosGetInfoBlocks(var ATIB:PThreadInfoBlock;
+ var APIB:PProcessInfoBlock); cdecl;
+procedure DosGetInfoBlocks(PATIB:PPThreadInfoBlock;
+ PAPIB:PPProcessInfoBlock); cdecl;
+
+{Wait a number of milliseconds. Cannot fail, so it is defined as procedure.}
+procedure DosSleep (MSec:cardinal); cdecl;
+
+{Beep the speaker. You do not need to check for an error if you can
+ guarantee that the frequency is correct.}
+function DosBeep(Freq,MS:cardinal):cardinal; cdecl;
+
+{****************************************************************************
+
+ Process handling routines.
+
+****************************************************************************}
+
+{ User's Debug Buffer structure }
+
+type PDbgBuf = ^TDbgBuf;
+ TDbgBuf = record
+ Pid: cardinal; { Debuggee Process id }
+ Tid: cardinal; { Debuggee Thread id }
+ Cmd: longint; { Command or Notification }
+ Value: longint; { Generic Data Value }
+ Addr: pointer; { Debuggee Address }
+ Buffer: pointer; { Debugger Buffer Address }
+ Len: cardinal; { Length of Range }
+ index: cardinal; { Generic Identifier Index }
+ MTE: cardinal; { Module Table Entry Handle }
+ EAX: cardinal; { Register Set }
+ ECX: cardinal;
+ EDX: cardinal;
+ EBX: cardinal;
+ ESP: cardinal;
+ EBP: cardinal;
+ ESI: cardinal;
+ EDI: cardinal;
+ EFlags: cardinal;
+ EIP: cardinal;
+ CSLim: cardinal;
+ CSBase: cardinal;
+ CSAcc: byte;
+ CSAtr: byte;
+ CS: word;
+ DSLim: cardinal;
+ DSBase: cardinal;
+ DSAcc: byte;
+ DSAtr: byte;
+ DS: word;
+ ESLim: cardinal;
+ ESBase: cardinal;
+ ESAcc: byte;
+ ESAtr: byte;
+ ES: word;
+ FSLim: cardinal;
+ FSBase: cardinal;
+ FSAcc: byte;
+ FSAtr: byte;
+ FS: word;
+ GSLim: cardinal;
+ GSBase: cardinal;
+ GSAcc: byte;
+ GSAtr: byte;
+ GS: word;
+ SSLim: cardinal;
+ SSBase: cardinal;
+ SSAcc: byte;
+ SSAtr: byte;
+ SS: word;
+ end;
+
+
+{ DosDebug Command Numbers
+ *
+ * These numbers are placed in the Cmd field of the uDB on
+ * entry to DosDebug.
+ *
+ * These numbers identify which command DosDebug is requested
+ * to perform.
+ *
+ }
+
+const DBG_C_Null = 0; { Null }
+ DBG_C_ReadMem = 1; { Read Word }
+ DBG_C_ReadMem_I = 1; { Read Word }
+ DBG_C_ReadMem_D = 2; { Read Word (same as 1) }
+ DBG_C_ReadReg = 3; { Read Register Set }
+ DBG_C_WriteMem = 4; { Write Word }
+ DBG_C_WriteMem_I = 4; { Write Word }
+ DBG_C_WriteMem_D = 5; { Write Word (same as 4) }
+ DBG_C_WriteReg = 6; { Write Register Set }
+ DBG_C_Go = 7; { Go }
+ DBG_C_Term = 8; { Terminate }
+ DBG_C_SStep = 9; { Single Step }
+ DBG_C_Stop = 10; { Stop }
+ DBG_C_Freeze = 11; { Freeze Thread }
+ DBG_C_Resume = 12; { Resume Thread }
+ DBG_C_NumToAddr = 13; { Object Number to Address }
+ DBG_C_ReadCoRegs = 14; { Read Coprocessor Registers }
+ DBG_C_WriteCoRegs = 15; { Write Coprocessor Registers }
+ { 16 is reserved }
+ DBG_C_ThrdStat = 17; { Get Thread Status }
+ DBG_C_MapROAlias = 18; { Map read-only alias }
+ DBG_C_MapRWAlias = 19; { Map read-write alias }
+ DBG_C_UnMapAlias = 20; { Unmap Alias }
+ DBG_C_Connect = 21; { Connect to Debuggee }
+ DBG_C_ReadMemBuf = 22; { Read Memory Buffer }
+ DBG_C_WriteMemBuf = 23; { Write Memory Buffer }
+ DBG_C_SetWatch = 24; { Set Watchpoint }
+ DBG_C_ClearWatch = 25; { Clear Watchpoint }
+ DBG_C_RangeStep = 26; { Range Step }
+ DBG_C_Continue = 27; { Continue after an Exception }
+ DBG_C_AddrToObject = 28; { Address to Object }
+ DBG_C_XchgOpcode = 29; { Exchange opcode and go }
+ DBG_C_LinToSel = 30; { 32 to 16 conversion A001}
+ DBG_C_SelToLin = 31; { 16 to 32 conversion A001}
+
+ {------ Constants -------------------}
+ DBG_L_386 = 1;
+ DBG_O_OBJMTE = $10000000;
+
+ {------ Notifications ---------------}
+ DBG_N_SUCCESS = 0;
+ DBG_N_ERROR = -1;
+ DBG_N_ProcTerm = -6;
+ DBG_N_Exception = -7;
+ DBG_N_ModuleLoad = -8;
+ DBG_N_CoError = -9;
+ DBG_N_ThreadTerm = -10;
+ DBG_N_AsyncStop = -11;
+ DBG_N_NewProc = -12;
+ DBG_N_AliasFree = -13;
+ DBG_N_Watchpoint = -14;
+ DBG_N_ThreadCreate = -15;
+ DBG_N_ModuleFree = -16;
+ DBG_N_RangeStep = -17;
+
+ DBG_X_PRE_FIRST_CHANCE = 0;
+ DBG_X_FIRST_CHANCE = 1;
+ DBG_X_LAST_CHANCE = 2;
+ DBG_X_STACK_INVALID = 3;
+
+ DBG_W_Local = $0000001;
+ DBG_W_Global = $0000002;
+ DBG_W_Execute = $00010000;
+ DBG_W_Write = $00020000;
+ DBG_W_ReadWrite = $00030000;
+
+{You need a heavy manual if you want to know how this procedure works. Used
+for writing debuggers.}
+function DosDebug (DebugBuf: PDbgBuf):cardinal; cdecl;
+
+function DosDebug (var APDbgBuf: TDbgBuf): cardinal; cdecl;
+
+{ codeTerminate values (also passed to ExitList routines) }
+const TC_exit = 0;
+ TC_harderror = 1;
+ TC_trap = 2;
+ TC_killprocess = 3;
+ TC_exception = 4;
+
+{ DosExitList options }
+const ExLst_Add = 1;
+ ExLst_Remove = 2;
+ ExLst_Exit = 3;
+
+type TExitProc=procedure(Reason:cardinal); cdecl;
+
+{Add/remove an exitprocedure to the exit list. Also used to terminate an
+ exit procedure. An exit procedure will be called on exiting of the program.
+
+ OrderCode = One of the EXLST_XXXX constants.
+ Proc = Address of the exit procedure.
+
+An exit procedure is called with one of the TC_XXXX constants. When it is
+done it must call DosExitList with ExLst_Exit.
+
+Exit procedures are called in random order.}
+function DosExitList(OrderCode:cardinal;Proc:TExitProc):cardinal; cdecl;
+
+{ DosExecPgm options }
+const deSync = 0; {Wait until program terminates.}
+ deAsync = 1; {Do not wait.}
+ deAsyncResult = 2; {Do not wait. DosWaitChild will follow to
+ check if process has been terminated. If
+ you use this, you must use DosWaitChild,
+ because OS/2 will not free memory that is
+ allocated for the result codes if you don't.}
+ deTrace = 3; {For debugging.}
+ deBackground = 4; {Do not run as child. Run in a separate
+ session.}
+ deSuspended = 5; {Child will be loaded, but not executed.}
+ deAsyncResultDb = 6; {Similar to deAsyncResult, but for debugging.}
+
+(* The following for compatibility only *)
+ EXEC_SYNC =deSync;
+ EXEC_ASYNC =deAsync;
+ EXEC_ASYNCRESULT =deAsyncResult;
+ EXEC_TRACE =deTrace;
+ EXEC_BACKGROUND =deBackground;
+ EXEC_LOAD =deSuspended;
+ EXEC_ASYNCRESULTDB =deAsyncResultDb;
+
+type TResultCodes=record
+ TerminateReason, {0 = Normal termionation.
+ 1 = Critical error.
+ 2 = Trapped. (GPE, etc.)
+ 3 = Killed by DosKillProcess.}
+ ExitCode:cardinal; {Exit code of child.}
+ end;
+
+{Execute a program.
+
+ ObjName = If a DLL cannot be found, its name will be returned here.
+ ObjLen = Size of your ObjName buffer.
+ ExecFlag = One of the deXXXX constants.
+ Res = See TResultcodes.
+ Args = Arguments. ASCIIZ strings. End of Args given by an empty
+ string (#0). First arg must be filename without path and
+ extension. nil is also allowed.
+ Env = Environment. ASCIIZ strings. A variable has the format
+ NAME=CONTENTS. End of Env given by an empty string (#0).
+ nil is also allowed meaning inherit parent's environment.
+ FileName = Filename with full path and extension. Is not sensitive
+ for the PATH environment variable.}
+function DosExecPgm(ObjName:PChar;ObjLen:longint;ExecFlag:cardinal;
+ Args,Env:PByteArray;var Res:TResultCodes;
+ FileName:PChar):cardinal; cdecl;
+function DosExecPgm(var ObjName:string;ExecFlag:cardinal;
+ Args,Env:PByteArray;var Res:TResultCodes;
+ const FileName:string):cardinal;
+
+{Wait until a child process terminated. Sometimes called DosCWait.
+
+Action = 0 = Wait until child terminates.
+ 1 = Wait until child and all its childs terminate.
+Option = Flags. Either dtWait or dtNoWait.
+Res = See TResultCodes.
+TermPID = Process ID that has been terminated. Usefull when
+ terminating a random process.
+PID = Process ID of process to terminate. Use a zero to
+ terminate a random process.}
+function DosWaitChild(Action,Option:longint;var Res:TResultCodes;
+ var TermPID:longint;PID:longint):cardinal; cdecl;
+function DosWaitChild(Action,Option:cardinal;var Res:TResultCodes;
+ var TermPID:cardinal;PID:cardinal):cardinal; cdecl;
+
+const dpProcess = 0;
+ dpProcessChilds = 1;
+ dpThread = 2;
+
+ dpSameClass = 0;
+ dpIdleClass = 1;
+ dpRegular = 2;
+ dpTimeCritical = 3;
+
+{Set priority of a thread or all threads in another process.
+
+ Scope = 0 = Set for all threads of a process.
+ 1 = Set for all threads of a process and its childs.
+ 2 = Set for a thread of the current process.
+ TrClass = 0 = Do not change class.
+ 1 = Change to idle time class.
+ 2 = Change to regular class.
+ 3 = Change to time-critical class.
+ Delta = Value to add to priority. Resulting priority must be in
+ the range 0..31 (Delta itself must be within -31..31).
+ PortID = Process ID when Scope=0 or 1, thread ID when Scope=2.}
+function DosSetPriority(Scope,TrClass: cardinal;Delta:longint;PortID:cardinal):cardinal; cdecl;
+
+{Terminate a process. If the process isn't a child process, it can refuse
+ to terminate.
+
+ Action = 0 = Terminate process and all its childs.
+ 1 = Terminate process only.
+ PID = Process ID of process to terminate.}
+function DosKillProcess(Action,PID:cardinal):cardinal; cdecl;
+
+const AppTyp_NotSpec = $0000; {Apptype is unknown.}
+ AppTyp_NotWindowCompat = $0001; {App cannot run in a window.}
+ AppTyp_WindowCompat = $0002; {App can run in a window.}
+ AppTyp_WindowAPI = $0003; {App uses PM}
+ AppTyp_Bound = $0008; {App uses Family API.}
+ AppTyp_DLL = $0010; {File is a DLL.}
+ AppTyp_DOS = $0020; {App is a PC-DOS program.}
+ AppTyp_PhysDrv = $0040; {App is a physical device driver.}
+ AppTyp_VirtDrv = $0080; {App is virtual device driver.}
+ AppTyp_ProtDLL = $0100; {File is a protected mode DLL.}
+ AppTyp_WindowsReal = $0200; {M$ Winslows app, real mode.}
+ AppTyp_WindowsProt = $0400; {M$ Winslows app, protected mode.}
+ AppTyp_32bit = $4000; {App is 32 bit.}
+
+{Get the application type of an executable file on disk.
+ FileName = Name of file to get type from.
+ Flags = Receives a bitfield using the AppTyp constants.}
+function DosQueryAppType(FileName:PChar;var Flags:longint):cardinal; cdecl;
+function DosQueryAppType (FileName: PChar; var Flags: cardinal): cardinal;
+ cdecl;
+
+const diPrinter = 0; {Get number of printer (parallel) ports.}
+ diRS232 = 1; {Get number of serial ports.}
+ diFloppy = 2; {Get number of floppy drives.}
+ diCopro = 3; {Get number of FPU's installed (either 0 or 1).}
+ diSubModel = 4; {??? System submodel type?}
+ diModel = 5; {??? System model type?}
+ diAdapter = 6; {0=Monochrome display, 1=other. ??? Does OS/2
+ support monochrome displays?}
+
+{Get information about attached devices.
+ DevInfo = Receives requested information.
+ Item = One of the dixxxx constants.}
+function DosDevConfig(var DevInfo:byte;Item:cardinal):cardinal; cdecl;
+
+{****************************************************************************
+
+ File handling related routines.
+
+****************************************************************************}
+
+const MaxPathLength=260;
+ MaxPathComponent=256;
+
+type TFileLock=record
+ Offset,Range:longint;
+ end;
+ PFileLock=^TFileLock;
+ FileLock=TFileLock;
+
+{Lock or unlock an area of a file. Other processes may not access that part
+ of the file.
+
+ Unlock = Area to unlock. (0,0) = Do not unlock.
+ Lock = Area to lock. (0,0) = Do not lock.
+ Timeout = Number of miliseconds to wait if another process has locked
+ the file.
+ Flags = Bitfield:
+ Bit 0: 0 = Other processes are denied access.
+ 1 = Other processes may still read from the area.
+ Bit 1: 0 = Normal locking mode.
+ 1 = Atomic mode. Refer IBM's documentation.}
+function DosSetFileLocks(Handle:THandle;var Unlock,Lock:TFileLock;
+ Timeout,Flags: cardinal):cardinal; cdecl;
+
+function DosProtectSetFileLocks (Handle: THandle; var Unlock, Lock: TFileLock;
+ Timeout, Flags: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Cancel a filelock area.
+
+Handle = File handle.
+Lock = Area that is locked now.}
+function DosCancelLockRequest(Handle:THandle;var Lock:TFileLock):cardinal;
+ cdecl;
+
+{Data structures for extended attributes. Reading IBM's documentation is
+ highly recommended before experimenting with EAs.}
+
+const fEA_needEA=$80;
+
+ eaBinary = $fffe;
+ eaASCII = $fffd;
+ eaBitmap = $fffb;
+ eaMetaFile = $fffa;
+ eaIcon = $fff9;
+ eaEA = $ffee;
+ eaMVMT = $ffdf;
+ eaMVST = $ffde;
+ eaASN1 = $ffdd;
+
+type TgEA = record
+ case byte of
+ 1: (NameLen: byte;
+ Name: array [0..0] of char);
+ 2: (cbName: byte; { name length not including NULL }
+ szName: char); { attribute name }
+ end;
+ PgEA = ^TgEA;
+ GEA = TgEA;
+
+ TgEAList = record
+ ListLen: cardinal; { total bytes of structure including full list }
+ List: array [0..0] of TgEA; { variable length GEA structures }
+ end;
+ PgEAList = ^TgEAList;
+ GEAList = TgEAList;
+
+ TfEA = record
+ case byte of
+ 1: (EA,
+ NameLen: byte;
+ Value: word);
+ 2: (fEA: byte; { flags }
+ cbName: byte; { name length not including NULL }
+ cbValue: word); { value length }
+ end;
+ PfEA = ^TfEA;
+ FEA=TfEA;
+
+ TfEAList = record
+ Size: cardinal; { total bytes of structure including full list }
+ List: array [0..0] of TfEA; { variable length FEA structures }
+ end;
+ PfEAList = ^TfEAlist;
+ FEAList = TfEAList;
+
+ TEAOp = record
+ case byte of
+ 1: (gEAList: PgEAList;
+ fEAList: PfEAList;
+ Error: cardinal);
+ 2: (fpGEAList: PGEAList; { general EA list }
+ fpFEAList: PFEAList; { full EA list }
+ oError: cardinal);
+ end;
+ PEAOp = ^TEAOp;
+ EAOp = TEAOp;
+
+ TfEA2 = record
+ NextEntry: cardinal;
+ Flags,
+ NameLen: byte;
+ Value: word;
+ szName: array [0..0] of char;
+ end;
+ PfEA2 = ^TfEA2;
+ FEA2 = TfEA2;
+
+ TfEA2List = record
+ ListLen: cardinal;
+ List: array [0..0] of TfEA2;
+ end;
+ PfEA2List = ^TfEA2List;
+ FEA2List = TfEA2List;
+
+ TgEA2 = record
+ case byte of
+ 1: (NextEntry: cardinal;
+ NameLen: byte;
+ Name: array [0..0] of char);
+ 2: (oNextEntryOffset: cardinal; { new field }
+ cbName: byte;
+ szName: array [0..0] of byte); { new field }
+ end;
+ PgEA2 = ^TgEA2;
+ GEA2 = TgEA2;
+
+ TgEA2list = record
+ ListLen: cardinal;
+ List: array [0..0] of TgEA2;
+ end;
+ PgEA2List = ^TgEA2List;
+ GEA2List = TgEAList;
+
+ TEAOp2 = record
+ case byte of
+ 1: (gEA2List: PgEA2List;
+ fEA2List: PfEA2List;
+ Error: cardinal);
+ 2: (fpGEA2List: PGEA2List; { GEA set }
+ fpFEA2List: PFEA2List; { FEA set }
+ oError: cardinal); { offset of FEA error }
+ end;
+ PEAOp2 = ^TEAOp2;
+ EAOp2 = TEAOp2;
+
+ TEASizeBuf = record { struct for FSCTL fn 2 - max ea size }
+ case byte of
+ 1: (MaxEASize: word;
+ MaxEAListSize: cardinal);
+ 2: (cbMaxEASize: word; { max size of one EA }
+ cbMaxEAListSize: cardinal);{ max size of the full EA list }
+ end;
+ PEASizeBuf = ^TEASizeBuf;
+ EASizeBuf = TEASizeBuf;
+
+
+{*******************End of extented attribute datastructures.***************}
+
+{Usefull constanst for Action parameter.}
+ { DosOpen() actions }
+const doOpened = 1;
+ doCreated = 2;
+ doOverwritten = 3;
+
+ FILE_EXISTED = doOpened;
+ FILE_CREATED = doCreated;
+ FILE_TRUNCATED = doOverwritten;
+
+{Usefull constants for OpenFlags parameter.}
+ { DosOpen() open flags }
+const doFail = 0;
+ doOpen = 1;
+ doOverwrite = 2;
+ (*
+ fixed by KO M.H. on 1999.07.04
+ contents : Creation flags is 10 hex not 10 dec.
+ *)
+ doCreate = 16;
+
+ FILE_OPEN = doOpen;
+ FILE_TRUNCATE = doOverwrite;
+ FILE_CREATE = doCreate;
+
+{ this nibble applies if file already exists xxxx }
+ OPEN_ACTION_FAIL_IF_EXISTS =doFail; { ---- ---- ---- 0000 }
+ OPEN_ACTION_OPEN_IF_EXISTS =doOpen; { ---- ---- ---- 0001 }
+ OPEN_ACTION_REPLACE_IF_EXISTS =doOverwrite; { ---- ---- ---- 0010 }
+
+{ this nibble applies if file does not exist xxxx }
+ OPEN_ACTION_FAIL_IF_NEW =doFail; { ---- ---- 0000 ---- }
+ OPEN_ACTION_CREATE_IF_NEW =DoCreate; { ---- ---- 0001 ---- }
+
+{Usefull constants for openmode parameter.}
+
+const doRead = 0;
+ doWrite = 1;
+ doReadWrite = 2;
+ doDenyRW = 16;
+ doDenyWrite = 32;
+ doDenyRead = 48;
+ doDenyNone = 64;
+ doNoInherit = 128;
+ doSequential = 256;
+ doRandom = 512;
+ doNoCache = 4096;
+ doFailOnErr = 8192;
+ doWriteThru = 16384;
+ doDASD = 32768;
+
+
+ { DosOpen/DosSetFHandState flags }
+ OPEN_ACCESS_READONLY =doRead; { ---- ---- ---- -000 }
+ OPEN_ACCESS_WRITEONLY =doWrite; { ---- ---- ---- -001 }
+ OPEN_ACCESS_READWRITE =doReadWrite; { ---- ---- ---- -010 }
+ OPEN_SHARE_DENYREADWRITE =doDenyRW; { ---- ---- -001 ---- }
+ OPEN_SHARE_DENYWRITE =doDenyWrite; { ---- ---- -010 ---- }
+ OPEN_SHARE_DENYREAD =doDenyRead; { ---- ---- -011 ---- }
+ OPEN_SHARE_DENYNONE =doDenyNone; { ---- ---- -100 ---- }
+ OPEN_FLAGS_NOINHERIT =doNoInherit; { ---- ---- 1--- ---- }
+ OPEN_FLAGS_NO_LOCALITY =$0000; { ---- -000 ---- ---- }
+ OPEN_FLAGS_SEQUENTIAL =doSequential; { ---- -001 ---- ---- }
+ OPEN_FLAGS_RANDOM =doRandom; { ---- -010 ---- ---- }
+ OPEN_FLAGS_RANDOMSEQUENTIAL =doSequential
+ or doRandom; { ---- -011 ---- ---- }
+ OPEN_FLAGS_NO_CACHE =doNoCache; { ---1 ---- ---- ---- }
+ OPEN_FLAGS_FAIL_ON_ERROR =doFailOnErr; { --1- ---- ---- ---- }
+ OPEN_FLAGS_WRITE_THROUGH =doWriteThru; { -1-- ---- ---- ---- }
+ OPEN_FLAGS_DASD =doDASD; { 1--- ---- ---- ---- }
+
+ OPEN_FLAGS_NONSPOOLED =$00040000;
+ OPEN_FLAGS_PROTECTED_HANDLE =$40000000;
+
+
+{ Open a file.
+
+ FileName = Name of file.
+ Handle = Receives filehandle.
+ Action = Receives result of opening.
+ 1 = Existing file opened.
+ 2 = File did not exist. Created.
+ 3 = File existed. Overwritten.
+ InitSize = Initial size of file when creating or overwriting.
+ Ignored when you do not. Must be zero when the file is
+ created or overwritten in read-only mode.
+ Attrib = Attributes when creating or overwriting files.
+ OpenFlags = Bitfield describing what to do when file exists or doesn't
+ exist.
+ OpenMode = Bitfield describing describing how to open a file.
+ EA = Extended attributes to give file when created. Use a nil
+ pointer if you don't want to give it extended attributes.
+ Use it only when creating or overwriting file. Use nil
+ when not. Only the FEA list will be used.
+
+The bits in the openflags parameter have the following meanings:
+
+ Bit 0-3: Action to take when file exists. 0000 = Return with error.
+ 0001 = Open it.
+ 0010 = Overwrite it.
+ Bit 4-7: Action to take when file does not 0000 = Return with error.
+ exist. 0001 = Create it.
+
+The bits in the filemode parameter have the following meanings:
+
+ Bit 0-2: Access mode: 000 = Read-only
+ 001 = Write-only
+ 010 = Read/Write
+ Bit 3: Reserved.
+ Bit 4-6: Sharing mode. 001 = Deny all
+ 010 = Deny write
+ 011 = Deny read
+ 100 = Deny none
+ Bit 7: Inheritance. 0 = Handle will be inherited by childs.
+ 1 = Handle will not be inherited.
+ Bit 8-11: Reserved.
+ Bit 12: Cache flag. 0 = Use caching.
+ 1 = Disable both read and write caching.
+ Bit 13: Error handling. 0 = Use critical error handler.
+ 1 = Return just an error code.
+ Bit 14: Write cache flag. 0 = Write operations may be cached.
+ 1 = Write operations must be executed
+ before write operation functions return.
+ Bit 15: DASD flag. 0 = Open a file or device.
+ 1 = Open a drive as file.
+
+When the DASD flag is set, the whole drive is read as a single file. The
+file starts with 512 bytes of bootsector, then 512 bytes of the second sector etc.
+The filename must consist of the driveletter followed by a semicolon.}
+function DosOpen(FileName:PChar;var Handle: longint; var Action:longint;
+ InitSize:longint;Attrib,OpenFlags,FileMode:longint;
+ EA:PEAOp2):cardinal; cdecl;
+function DosOpen(FileName:PChar;var Handle: THandle;var Action:cardinal;
+ InitSize,Attrib,OpenFlags,FileMode:cardinal;
+ EA:PEAOp2):cardinal; cdecl;
+{This variant of DosOpen always creates or overwrites a file.}
+function DosCreate(FileName:PChar;var Handle: THandle;
+ Attrib,OpenMode:cardinal):cardinal;
+{This variant of DosOpen always opens an existing file.}
+function DosOpen(FileName:PChar;var Handle: THandle;
+ Attrib,OpenMode:cardinal):cardinal;
+{There are also string variants.}
+function DosOpen(const FileName:string;var Handle: longint; var Action:longint;
+ InitSize,Attrib,OpenFlags,OpenMode:longint;
+ ea:PEAOp2):cardinal;
+function DosOpen(const FileName:string;var Handle: THandle;var Action:cardinal;
+ InitSize,Attrib,OpenFlags,OpenMode:cardinal;
+ ea:PEAOp2):cardinal;
+function DosCreate(const FileName:string;var Handle: THandle;
+ Attrib,OpenMode:cardinal):cardinal;
+function DosOpen(const FileName:string;var Handle: THandle;
+ Attrib,OpenMode:cardinal):cardinal;
+
+function DosProtectOpen (FileName: PChar; var Handle: longint;
+ var Action: longint; InitSize, Attrib,
+ OpenFlags, OpenMode: longint; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal; cdecl;
+
+function DosProtectOpen (FileName: PChar; var Handle: THandle;
+ var Action: cardinal; InitSize, Attrib,
+ OpenFlags, OpenMode: cardinal; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal; cdecl;
+
+function DosProtectOpen (const FileName: string; var Handle: longint;
+ var Action: longint; InitSize, Attrib,
+ OpenFlags, OpenMode: longint; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal;
+
+function DosProtectOpen (const FileName: string; var Handle: THandle;
+ var Action: cardinal; InitSize, Attrib,
+ OpenFlags, OpenMode: cardinal; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal;
+
+{Close a file.
+Cannot fail if handle does exist.}
+function DosClose (Handle: THandle): cardinal; cdecl;
+
+function DosProtectClose (Handle: THandle;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Read from a file or other type of handle.
+
+ Handle = File handle.
+ Buffer = The read data is stored here.
+ Count = Number of bytes to read.
+ ActCount = Number of bytes actually read.}
+function DosRead (Handle: longint; var Buffer; Count: longint;
+ var ActCount:longint):cardinal; cdecl;
+
+function DosRead (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount:cardinal):cardinal; cdecl;
+
+function DosProtectRead (Handle: longint; var Buffer; Count: longint;
+ var ActCount: longint; FileHandleLockID: cardinal): cardinal; cdecl;
+
+function DosProtectRead (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal; FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Write to a file or other type of handle.
+
+ Handle = File handle.
+ Buffer = The data to be written.
+ Count = Number of bytes to write.
+ ActCount = Number of bytes actually written.}
+function DosWrite (Handle: longint; var Buffer; Count: longint;
+ var ActCount:longint):cardinal; cdecl;
+
+function DosWrite (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount:cardinal):cardinal; cdecl;
+
+function DosProtectWrite (Handle: longint; var Buffer; Count: longint;
+ var ActCount: longint;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+function DosProtectWrite (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+const dsZeroBased=0; {Set filepointer from begin of file.}
+ dsRelative=1; {Set filepointer relative to the current one.}
+ dsEndBased=2; {Set filepointer from end of file.}
+(* The following for compatibility only *)
+ FILE_BEGIN = dsZeroBased; { Move relative to beginning of file }
+ FILE_CURRENT = dsRelative; { Move relative to current fptr position }
+ FILE_END = dsEndBased; { Move relative to end of file }
+
+{Change the filepointer of a file.}
+function DosSetFilePtr (Handle: longint; Pos: longint; Method: cardinal;
+ var PosActual: longint): cardinal; cdecl;
+function DosSetFilePtr (Handle: THandle; Pos: longint; Method: cardinal;
+ var PosActual: cardinal): cardinal; cdecl;
+function DosProtectSetFilePtr (Handle: longint; Pos, Method: longint;
+ var PosActual: longint;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+function DosProtectSetFilePtr (Handle: THandle; Pos: longint; Method: cardinal;
+ var PosActual: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{This variant seeks always from begin of file and does not return the
+ actual position.}
+function DosSetFilePtr (Handle: THandle; Pos: longint): cardinal;
+function DosProtectSetFilePtr (Handle: THandle; Pos: longint;
+ FileHandleLockID: cardinal): cardinal;
+{This variant returns the current filepointer.}
+function DosGetFilePtr (Handle: longint; var PosActual: longint): cardinal;
+
+function DosGetFilePtr (Handle: THandle; var PosActual: cardinal): cardinal;
+
+function DosProtectGetFilePtr (Handle: longint;
+ var PosActual: longint; FileHandleLockID: cardinal): cardinal;
+
+function DosProtectGetFilePtr (Handle: THandle;
+ var PosActual: cardinal; FileHandleLockID: cardinal): cardinal;
+
+{Use DosQueryFileInfo or DosQueryPathInfo to get the size of a file.}
+
+{Change the size of a file.}
+function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
+
+function DosProtectSetFileSize (Handle: THandle; Size: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Flush update the changes to a file to disk.}
+function DosResetBuffer (Handle: THandle): cardinal; cdecl;
+
+{Duplicate or redirect a handle.
+To duplicate a handle: Fill handle with source handle and duplicate with -1.
+ Copy of handle will be returned in duplicate.
+To redirect a handle: Fill handle with handle to which the handle to
+ redirect will be redirected. The handle that will be
+ redirected should be placed in duplicate.}
+function DosDupHandle (Handle: THandle; var Duplicate: THandle): cardinal;
+ cdecl;
+
+{Return information about a specific handle. See DosOpen for a
+ description of FileMode.}
+function DosQueryFHState (Handle: longint; var FileMode: longint): cardinal;
+ cdecl;
+function DosQueryFHState (Handle: THandle; var FileMode: cardinal): cardinal;
+ cdecl;
+
+function DosProtectQueryFHState (Handle: THandle; var FileMode: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Set information about a specific handle. See DosOpen for a description
+ of FileMode.}
+function DosSetFHState (Handle: THandle; FileMode: cardinal): cardinal; cdecl;
+
+function DosProtectSetFHState (Handle: THandle; FileMode: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Useful constants for the handle type.}
+const dhFile = 0;
+ dhDevice = 1;
+ dhPipe = 2;
+ dhNetwork = 8192;
+
+{Determine if a handle belongs to a file, a device or a pipe.
+ Handle = Handle tp query info about.
+ HandType = Bits 0-1: 00 = File
+ 01 = Device
+ 02 = Pipe
+ Bit 15: 0 = Local.
+ 1 = On network.}
+function DosQueryHType (Handle: longint; var HandType: longint;
+ var Attr: longint): cardinal; cdecl;
+function DosQueryHType (Handle: THandle; var HandType:cardinal;
+ var Attr:cardinal):cardinal; cdecl;
+
+{****************************************************************************
+
+ File management related routines.
+
+****************************************************************************}
+
+
+{Edit a filename using wildcard.
+
+Example editing CONFIG.SYS with *.BAK becomes CONFIG.BAK.
+Usefull when parsing commands like 'copy config.sys *.bak'.
+All filename characters are casemapped.'
+
+MetaLevel = 0 Use modern semantics
+MetaLevel = 1 Use OS/2 1.2 semantics
+Source = string to edit
+Edit = editstring
+Target = destination buffer
+TargetLen = size of the destination buffer}
+function DosEditName(MetaLevel:cardinal;Source,Edit:PChar;
+ Target:PChar;TargetLen:cardinal):cardinal; cdecl;
+function DosEditName(MetaLevel:cardinal;const Source,Edit:string;
+ var Target:string):cardinal;
+
+{Move or rename a file.
+ OldFile = old name of file
+ NewFile = new name of file}
+function DosMove(OldFile,NewFile:PChar):cardinal; cdecl;
+function DosMove(const OldFile,NewFile:string):cardinal;
+
+
+const dcExisting=1; {Overwrite existing files.}
+ dcAppend=2; {Append to existing file.}
+ dcFailAs=4; {?? Info wanted!}
+
+{Copy a file.
+ OldFile = source file
+ NewFile = destination file}
+function DosCopy(OldFile,NewFile:PChar;Option:cardinal):cardinal; cdecl;
+function DosCopy(const OldFile,NewFile:string;Option:cardinal):cardinal;
+
+{Delete a file from disk.}
+function DosDelete(FileName:PChar):cardinal; cdecl;
+function DosDelete(const FileName:string):cardinal;
+
+{Destroy a file on disk. DosForceDelete makes sure that the file cannot
+ be unerased anymore.}
+function DosForceDelete(FileName:PChar):cardinal; cdecl;
+function DosForceDelete(const FileName:string):cardinal;
+
+{Create a new directory.
+
+Name = Name of directory to create.
+EA = Extented attributes to give the directory. Use nil if you
+ do not want do give it extented attributes. Only the FEA
+ list is used.}
+function DosCreateDir(Name:PChar;EA:PEAOp2):cardinal; cdecl;
+function DosCreateDir(const Name:string;EA:PEAOp2):cardinal;
+{Variants without the EA parameter (nil is used).}
+function DosCreateDir(Name:PChar):cardinal;
+function DosCreateDir(const Name:string):cardinal;
+
+{Remove a directory.}
+function DosDeleteDir(Name:PChar):cardinal; cdecl;
+function DosDeleteDir(const Name:string):cardinal;
+
+{Set the current drive. Cannot fail if the driveletter is correct.}
+function DosSetDefaultDisk(DiskNum:cardinal):cardinal; cdecl;
+
+{Get the current drive. Because it cannot fail, it is declared as procedure.}
+procedure DosQueryCurrentDisk(var DiskNum:longint;var Logical:longint); cdecl;
+procedure DosQueryCurrentDisk(var DiskNum:cardinal;var Logical:cardinal); cdecl;
+
+{Set the current directory.}
+function DosSetCurrentDir(Name:PChar):cardinal; cdecl;
+function DosSetCurrentDir(const Name:string):cardinal;
+
+{Get the current directory.}
+function DosQueryCurrentDir(DiskNum:longint;var Buffer;
+ var BufLen:longint):cardinal; cdecl;
+function DosQueryCurrentDir(DiskNum:cardinal;var Buffer:string):cardinal;
+function DosQueryCurrentDir(DiskNum:cardinal;var Buffer;
+ var BufLen:cardinal):cardinal; cdecl;
+
+{Send/receive information to a device.
+
+ Handle = A file handle to a device, instead of a file.
+ Category = The category of functions the function is in.
+ Func = Function to call.
+ Params = Parameters for the function.
+ ParamLen = Size of the params buffer.
+ ParamSize = Size of the parametrs to send to the device
+ Receives size of the returned parameters.
+ Data = Data to send to device.
+ DataLen = Size of your data buffer.
+ DataSize = Size of the data to send to device.
+ Receives size of the data returned by the device.}
+function DosDevIOCtl(Handle,Category,Func:longint;var Params;
+ ParamLen:longint;var ParamSize:longint;
+ var Data;DataLen:longint;var DataSize:
+ longint):cardinal; cdecl;
+function DosDevIOCtl (Handle: THandle; Category,Func:cardinal;var Params;
+ ParamLen:cardinal;var ParamSize:cardinal;
+ var Data;DataLen:cardinal;var DataSize:cardinal):cardinal; cdecl;
+
+{****************************************************************************
+
+ File searching related routines.
+
+****************************************************************************}
+
+const faReadOnly = 1;
+ faHidden = 2;
+ faSystem = 4;
+ faReserve = 8;
+ faDirectory = 16;
+ faArchive = 32;
+
+ ilStandard = 1;
+ ilQueryEAsize = 2;
+ ilQueryEAs = 3;
+ ilQueryFullName = 5;
+
+{Format of date records:
+
+ Bit 0..4: day
+ Bit 5..8: month
+ Bit 9..15: year minus 1980
+
+ Format of time records:
+
+ Bit 0..4: seconds divided by 2
+ Bit 5..10: minutes
+ Bit 11..15: hours}
+
+type
+ TFileStatus = object
+ end;
+ PFileStatus = ^TFileStatus;
+
+ TFileStatus3 = object (TFileStatus)
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ end;
+ PFileStatus3=^TFileStatus3;
+
+ TFileStatus4=object(TFileStatus3)
+ cbList:cardinal; {Length of entire EA set.}
+ end;
+ PFileStatus4=^TFileStatus4;
+
+ TFileFindBuf3=object(TFileStatus)
+ NextEntryOffset: cardinal; {Offset of next entry}
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ Name:string; {Also possible to use as ASCIIZ.
+ The byte following the last string
+ character is always zero.}
+ end;
+ PFileFindBuf3=^TFileFindBuf3;
+
+ TFileFindBuf4=object(TFileStatus)
+ NextEntryOffset: cardinal; {Offset of next entry}
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ cbList:longint; {Size of the file's extended attributes.}
+ Name:string; {Also possible to use as ASCIIZ.
+ The byte following the last string
+ character is always zero.}
+ end;
+ PFileFindBuf4=^TFileFindBuf4;
+
+{Find first file matching a filemask. In contradiction to DOS, a search
+ handle is returned which should be closed with FindClose when done.
+ FileMask = Filemask to search.
+ Handle = Search handle will be returned here, fill with -1 before
+ call.
+ Attrib = File attributes to search for.
+ AFileStatus = Return buffer.
+ FileStatusLen = Size of return buffer.
+ Count = Fill with maximum number of files to search for, the
+ actual number of matching files found is returned here.
+ InfoLevel = One of the ilXXXX constants. Consult IBM documentation
+ for exact meaning. For normal use: Use ilStandard and
+ use PFileFindBuf3 for AFileStatus.}
+function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+ cdecl;
+function DosFindFirst (const FileMask: string; var Handle: THandle;
+ Attrib: cardinal; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal; var Count: cardinal;
+ InfoLevel: cardinal): cardinal;
+
+{Find next matching file.}
+function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal; var Count: cardinal): cardinal;
+ cdecl;
+
+{Close a search handle. Cannot fail if handle does exist.}
+function DosFindClose (Handle: THandle): cardinal; cdecl;
+
+{Get info about a file.
+
+ Handle = Handle of file.
+ InfoLevel = One of the ilXXXX constants. Consult IBM documentation
+ for exect meaning. For normal use: Use ilStandard and
+ PFileFindBuf3 for AFileStatus.
+ AFileStatus = An info return buffer.
+ FileStatusLen = Size of info buffer.}
+function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
+
+function DosProtectQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Set info about a file. File must be opened with write permissions. See
+ above fo the parameters.}
+function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
+
+function DosProtectSetFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+{Return info about a file. In contradiction to the above functions, the
+ file does not have to be open.}
+function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
+ AFileStatus:PFileStatus;FileStatusLen:cardinal):cardinal; cdecl;
+function DosQueryPathInfo(const FileName:string;InfoLevel:cardinal;
+ AFileStatus:PFileStatus;FileStatusLen:cardinal):cardinal;
+
+{Set information about a file.}
+function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
+ AFileStatus:PFileStatus;FileStatusLen,
+ Options:cardinal):cardinal; cdecl;
+
+{Get info about the names and lengths of the EA's for a file or directory.
+
+ RefType = 0 = AFile is a pointer to a file-handle.
+ 1 = AFile is a pointer to an ASCIIZ string.
+ AFile = Pointer file's name or handle.
+ Entry = Number of EA to query inof about. (1 = first EA).
+ Buf = Buffer where requested info is returned. For InfoLevel
+ 1, the buffer is a TfEA2 datastructure.
+ BufLen = Size of buf in bytes.
+ Count = Number of EA's to return info for. Number of EA's that
+ actually fitted in buf is returned here.
+ InfoLevel = Level of information to return. Only level 1 is
+ currently allowed.}
+
+function DosEnumAttribute(RefType:longint;AFile:pointer;
+ Entry:longint;var Buf;BufSize:longint;
+ var Count:longint;InfoLevel:longint):cardinal; cdecl;
+
+function DosEnumAttribute(RefType:cardinal;AFile:pointer;
+ Entry:cardinal;var Buf;BufSize:cardinal;
+ var Count:cardinal;InfoLevel:cardinal):cardinal; cdecl;
+
+function DosEnumAttribute (RefType: cardinal; AFile: PChar;
+ Entry: cardinal; var Buf; BufSize:cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
+
+function DosEnumAttribute(RefType: cardinal; const AFile: THandle;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
+
+function DosProtectEnumAttribute (RefType: cardinal; AFile: pointer;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+
+function DosEnumAttribute (Handle: longint; Entry: longint; var Buf;
+ BufSize: longint; var Count: longint; InfoLevel: longint): cardinal;
+
+function DosEnumAttribute (Handle: THandle; Entry: cardinal; var Buf;
+ BufSize: cardinal; var Count: cardinal; InfoLevel: cardinal): cardinal;
+
+function DosProtectEnumAttribute (Handle: THandle; Entry: cardinal; var Buf;
+ BufSize: cardinal; var Count: cardinal;
+ InfoLevel: cardinal;
+ FileHandleLockID: cardinal): cardinal;
+
+function DosEnumAttribute (const FileName: string;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+
+function DosProtectEnumAttribute (const FileName: string; Entry: cardinal;
+ var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal;
+ FileHandleLockID: cardinal): cardinal;
+
+
+{Get an environment variable.
+ Name = Name of environment variable to get.
+ Value = Receives pointer to environment string.}
+function DosScanEnv(Name:PChar;var Value:PChar):cardinal; cdecl;
+{There is, of course a string variant.}
+function DosScanEnv(const Name:string;var Value:string):cardinal;
+
+const dsPathOnly = 0; {Do not search current dir. (Unless it is
+ in the directory list.)}
+ dsCurrentDir = 1; {Search in the current direcotry and in the
+ directory list.}
+ dsEnvironment = 2; {The dirlist parameter is not a directory
+ list, but an environment variable
+ containing one.}
+ dsIgnoreNetErrs = 4; {Ignore network errors when searching.}
+
+{Search for a file in a given number of directories.
+ Flags = A combination of the dsXXXX constants.
+ DirList = Directory list or environment variable containing list
+ to search in.
+ FileName = Filename to search for. May contain wildcards.
+ FullName = Receives filename found, including path.
+ FullLen = Length of your fullname buffer.}
+function DosSearchPath(Flag:cardinal;DirList,FileName:PChar;
+ FullName:PChar;FullLen:cardinal):cardinal; cdecl;
+function DosSearchPath(Flag:cardinal;const DirList,FileName:string;
+ var FullName:string):cardinal;
+
+{****************************************************************************
+
+ File system related routines.
+
+****************************************************************************}
+
+type TFSInfo=record
+ case word of
+ 1:
+ (File_Sys_ID,
+ Sectors_Per_Cluster,
+ Total_Clusters,
+ Free_Clusters:cardinal;
+ Bytes_Per_Sector:word);
+ 2: {For date/time description,
+ see file searching realted
+ routines.}
+ (Label_Date, {Date when volumelabel created.}
+ Label_Time:word; {Time when volumelabel created.}
+ VolumeLabel:string); {Volume label. Can also be used
+ as ASCIIZ, because the byte
+ following the last character of
+ the string is always zero.}
+ end;
+ PFSInfo=^TFSInfo;
+
+ TAttachData=record
+ case integer of {Flag in [0,1,2].}
+ 0,1: {Flag = 0.}
+ (Count:word;
+ Data:TCharArray);
+ 2: {Flag = 2.}
+ (PipeHandle: THandle;
+ {Handle of named pipe opened by spooler.}
+ SpoolName:string);
+ {Name of spooler object. Can also be used
+ as ASCIIZ, because the bute following
+ the last character is always zero.}
+ end;
+ PAttachData=^TAttachData;
+
+ TFSQBuffer2=record
+ _Type:word;
+ NameLen:word;
+ FSDNameLen:word;
+ FSADataLen:word;
+ Name:char;
+ Nul1:byte;
+ FSDName:char;
+ Nul2:byte;
+ FSAData:char;
+ Nul3:byte;
+ end;
+ PFSQBuffer2=^TFSQBuffer2;
+
+const fsAttach = 0; {Attach a drive.}
+ fsDetach = 1; {Detach a drive.}
+ fsSpoolAttach = 2; {Attach a spool device.}
+ fsSpoolDetach = 3; {Detach a spool device.}
+
+{IBM DOCS: "DosFSAttach attaches or detaches a drive to or from a remote file
+ system driver (FSD), or a pseudocharacter device name to or from a local or
+ remote FSD."
+
+ DevName = When flag is 0 or 1, the name of a drive or a pseudo-
+ character device. When using a drivename use the drive-
+ letter followed by a colon.
+ When flag is 2 or 3, the name of a spooled device.
+ FileSystem = Name of the driver that should be attached or detached
+ to DevName. Use nil when flag is 2 or 3.
+ Data = Should contain a number of ASCIIZ strings that will
+ be passed to the filesystem driver when flag is 0 or 1.
+ Should contain de pipehandle and spoolname when flag is
+ 2. Should be nil when flag is 3.
+ DataLen = Number of bytes in data parameter.
+ Flag = One of the dsXXXX constants. See above}
+function DosFSAttach(DevName,FileSystem:PChar;var Data:TAttachData;
+ DataLen,Flag:cardinal):cardinal; cdecl;
+function DosFSAttach(const DevName,FileSystem:string;var Data:TAttachData;
+ DataLen,Flag:cardinal):cardinal;
+
+{IBMDOCS: "DosQueryFSAttach obtains information about an attached file system
+ (local or remote), or about a character device or pseudocharacter device
+ attached to the file system."
+
+ DevName = Name info drive or pseudo character device to query
+ info about. Ignored for InfoLevels 2 and 3.
+ Ordinal = Index into list of character/pseudo-character
+ devices. Starts at 1. Ignored for infolevel 1.
+ InfoLevel = 1 = Return information about a drive or device named
+ by DevName.
+ 2 = Return information about a (pseudo) charachter
+ device numbered by Ordinal.
+ 3 = Return information about a drive numbered by
+ Ordinal.
+ Buffer = Will be filled with infomation.
+ BufLen = Size of your buffer in bytes. Number of bytes filled
+ in your buffer is returned here.}
+function DosQueryFSAttach(DevName:PChar;Ordinal,InfoLevel:longint;
+ var Buffer:TFSQBuffer2;var BufLen:longint):cardinal; cdecl;
+function DosQueryFSAttach(const DevName:string;Ordinal,InfoLevel:longint;
+ var Buffer:TFSQBuffer2;var BufLen:longint):cardinal;
+function DosQueryFSAttach(DevName:PChar;Ordinal,InfoLevel:cardinal;
+ var Buffer:TFSQBuffer2;var BufLen:cardinal):cardinal; cdecl;
+function DosQueryFSAttach(const DevName:string;Ordinal,InfoLevel:cardinal;
+ var Buffer:TFSQBuffer2;var BufLen:cardinal):cardinal;
+
+const FSCtl_Handle=1;
+ FSCtl_PathName=2;
+ FSCtl_FSDName=3;
+ FSCtl_Error_Info=1;
+ FSCtl_Max_EASize=2;
+
+{IBMDOCS: "DosFSCtl provides an extended standard interface between an
+ application and a file-system driver (FSD).
+
+ Consult IBM documentation about this function..}
+function DosFSCtl (Data: pointer; DataLen: longint; var ResDataLen: longint;
+ Parms: pointer; ParmsLen: longint; var ResParmsLen: longint;
+ _Function: longint; Route: PChar;
+ Handle, Method: longint): cardinal; cdecl;
+function DosFSCtl (Data: pointer; DataLen: longint; var ResDataLen: longint;
+ Parms: pointer;ParmsLen: longint; var ResParmsLen: longint;
+ _Function: longint; const Route: string;
+ Handle, Method: longint): cardinal;
+function DosFSCtl (Data: pointer; DataLen: cardinal; var ResDataLen: cardinal;
+ Parms: pointer; ParmsLen: cardinal; var ResParmsLen: cardinal;
+ _Function: cardinal; Route: PChar;
+ Handle: THandle;Method: cardinal): cardinal; cdecl;
+function DosFSCtl (Data: pointer; DataLen: cardinal; var ResDataLen: cardinal;
+ Parms: pointer; ParmsLen: cardinal; var ResParmsLen: cardinal;
+ _Function: cardinal; const Route: string;
+ Handle: THandle; Method: cardinal): cardinal;
+
+{Get information about a drive.
+InfoLevels:
+ 1 Get total/free space etc.
+ 2 Get volumelabel.}
+function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
+ BufLen: cardinal): cardinal; cdecl;
+
+{Set information about a drive.}
+function DosSetFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSinfo;
+ BufLen: cardinal): cardinal; cdecl;
+
+{Check if verify mode is enabled.}
+function DosQueryVerify (var Enabled: longint): cardinal; cdecl;
+function DosQueryVerify (var Enabled: cardinal): cardinal; cdecl;
+function DosQueryVerify (var Enabled: boolean): cardinal; cdecl;
+
+{Turn the verify mode on or off.}
+function DosSetVerify (Enable: cardinal): cardinal; cdecl;
+function DosSetVerify (Enable: boolean): cardinal; cdecl;
+
+{Change the number of filehandles our program can open. (Default=50). It
+ won't hurt if there are files open when you are calling this.}
+function DosSetMaxFH (Count: cardinal): cardinal; cdecl;
+
+{Ask for more filehandles (or dump filehandles). It won't hurt if there are
+ files open when you are calling this.
+ ReqCount = Number of filehandles to ask for. (Negative to dump them.)
+ CurMaxFH = Receives the total number of filehandles your program has
+ access to.}
+function DosSetRelMaxFH (var ReqCount: longint; var CurMaxFH: longint):
+ cardinal; cdecl;
+function DosSetRelMaxFH (var ReqCount: longint; var CurMaxFH: cardinal):
+ cardinal; cdecl;
+
+const dsFull=0; {IBM DOCS: "Perform full system shutdown and
+ file-system lock."}
+ dsQuiescient=1; {IBM DOCS: "Perform buffer and cache flushing to
+ make system quiescent."}
+
+{Prepare the system for shutdown.}
+function DosShutdown (Flags: cardinal): cardinal; cdecl;
+
+
+{Parameters (system variables) for DosQuerySysInfo.}
+const svMaxPathLength = 1; {Maximum length of a pathname.}
+ svMaxTextSessions = 2; {Maximum number of text sessions.}
+ svMaxPMSessions = 3; {Maximum number of PM sessions.}
+ svMaxVDMSessions = 4; {Maximum number of DOS sessions.}
+ svBootDrive = 5; {Get the boot drive. (A=1, B=2 etc.)}
+ svDynPriVariation = 6; {Dynamic priority variation flag
+ (0 = absolute priority, 1 means
+ dynamic priority).}
+ svMaxWait = 7; {Maximum wait time in seconds.}
+ svMinSlice = 8; {Minimum time slice in milliseconds.}
+ svMaxSlice = 9; {Maximum time slice in milliseconds.}
+ svPageSize = 10; {Size of a page (always 4096 bytes for
+ x86).}
+ svVersionMajor = 11; {Major version number of kernel:
+ 10 for OS/2 1.0 and 1.1,
+ 20 for OS/2 2.0 .. OS/2 4.0.}
+ svVersionMinor = 12; {Minor version of kernel:
+ OS/2 2.0: 00, 2.1: 10, 2.11: 11,
+ 3.0: 30, 4.0: 40.}
+ svVersionRevision = 13; {Revision of kernel. Until now all
+ OS/2 versions return 0.}
+ svMsCount = 14; {Uptime in milliseconds.}
+ svTimeLow = 15; {System time in seconds since
+ 1 January 1970 0:00:00, low dword.}
+ svTimeHigh = 16; {System time in seconds since
+ 1 January 1970 0:00:00, high dword.}
+ svTotPhysMem = 17; {Amount in bytes of physical memory
+ in system.}
+ svTotResMem = 18; {Amount in bytes of resident memory
+ in system.}
+ svTotAvailMem = 19; {Amount in bytes of available
+ memory.}
+ svMaxPrMem = 20; {Maximum amount of memory the current
+ process can request for its
+ private use.}
+ svMaxShMem = 21; {Maximum amount of shared memory
+ the current process can request.}
+ svTimerInterval = 22; {Timer interval in tenths of a
+ millisecond.}
+ svMaxCompLength = 23; {Maximum length of a component in a
+ pathname.}
+ svForegroundFSSession = 24; {Session ID of the foreground
+ full-screen session. Presentation
+ Manager and all sessions running under
+ PM (including PM, windowed VIO, VDM
+ and seamless Win 3.x) return ID 1.}
+ svForegroundProcess = 25; {Process ID of the current foreground
+ process.}
+ svNumProcessors = 26; {Number of CPUs in machine - supported
+ since WarpServer Advanced SMP.}
+{The following parameters are only supported in WSeB/MCP/eCS
+ or OS/2 Warp 4.0 with FP14 and above.}
+ svMaxHPrMem = 27; {Maximum amount of high memory the
+ process can request for its private
+ use in total (not necessarily at once
+ because of potential fragmentation).}
+ svMaxHShMem = 28; {Maximum amount of high shared memory
+ the process can request.}
+ svMaxProcesses = 29; {Maximum number of concurrent processes
+ supported.}
+ svVirtualAddressLimit = 30; {Size of the user address space in MB
+ (i.e. the value of the rounded
+ VIRTUALADDRESSLIMIT as specified in
+ CONFIG.SYS, or the default value of
+ 512).}
+ svMax = 30; {The maximum parameter number
+ for WSeB/MCP/eCS.}
+
+{Aliases for compatibility...}
+ QSV_MAX_PATH_LENGTH = svMaxPathLength;
+ QSV_MAX_TEXT_SESSIONS = svMaxTextSessions;
+ QSV_MAX_PM_SESSIONS = svMaxPMSessions;
+ QSV_MAX_VDM_SESSIONS = svMaxVDMSessions;
+ QSV_BOOT_DRIVE = svBootDrive;
+ QSV_DYN_PRI_VARIATION = svDynPriVariation;
+ QSV_MAX_WAIT = svMaxWait;
+ QSV_MIN_SLICE = svMinSlice;
+ QSV_MAX_SLICE = svMaxSlice;
+ QSV_PAGE_SIZE = svPageSize;
+ svMajorVersion = svVersionMajor;
+ QSV_VERSION_MAJOR = svVersionMajor;
+ svMinorVersion = svVersionMinor;
+ QSV_VERSION_MINOR = svVersionMinor;
+ svRevision = svVersionRevision;
+ QSV_VERSION_REVISION = svVersionRevision;
+ QSV_MS_COUNT = svMsCount;
+ QSV_TIME_LOW = svTimeLow;
+ QSV_TIME_HIGH = svTimeHigh;
+ svPhysMem = svTotPhysMem;
+ QSV_TOTPHYSMEM = svTotPhysMem;
+ svResMem = svTotResMem;
+ QSV_TOTRESMEM = svTotResMem;
+ svAvailMem = svTotAvailMem;
+ QSV_TOTAVAILMEM = svTotAvailMem;
+ svPrMem = svMaxPrMem;
+ svShMem = svMaxShMem;
+ QSV_MAXPRMEM = svMaxPrMem;
+ QSV_MAXSHMEM = svMaxShMem;
+ QSV_TIMER_INTERVAL = svTimerInterval;
+ QSV_MAX_COMP_LENGTH = svMaxCompLength;
+ QSV_FOREGROUND_FS_SESSION = svForegroundFSSession;
+ svForegroundSession = svForegroundFSSession;
+ QSV_FOREGROUND_PROCESS = svForegroundProcess;
+ QSV_NUMPROCESSORS = svNumProcessors;
+ QSV_MAXHPRMEM = svMaxHPrMem;
+ QSV_MAXHSHMEM = svMaxHShMem;
+ QSV_MAXPROCESSES = svMaxProcesses;
+ QSV_VIRTUALADDRESSLIMIT = svVirtualAddressLimit;
+ QSV_MAX = svMax;
+
+{Get one or more system variables.
+ First = First variable to get.
+ Last = Last variable to get.
+ Buf = Receives variables.
+ BufSize = Size of the buffer (every system variable is a cardinal).}
+function DosQuerySysInfo(First,Last:cardinal;var Buf;BufSize:cardinal):cardinal;
+ cdecl;
+type
+ TQSVValues = array [1..svMax] of cardinal;
+ PQSVValues = ^TQSVValues;
+
+function DosQuerySysInfo(First,Last:cardinal;Buf:PQSVValues;
+ BufSize:cardinal):cardinal;cdecl;
+
+{Return information about a partitionable disk.}
+function DosPhysicalDisk(Func:cardinal;Buf:pointer;BufSize:cardinal;
+ Params:pointer;ParamSize:cardinal):cardinal; cdecl;
+
+{****************************************************************************
+
+ Memory allocation related routines.
+
+****************************************************************************}
+
+const mfPag_Read = $00001; {Give read access to memory.}
+ mfPag_Write = $00002; {Give write access to memory.}
+ mfPag_Execute = $00004; {Allow code execution in memory.}
+ mfPag_Guard = $00008; {Used for dynamic memory growing. Create
+ uncommitted memory and make the first
+ page guarded. Once it is accessed it
+ will be made committed, and the next
+ uncommitted page will be made guarded.}
+ mfPag_Commit = $00010; {Make the memory committed.}
+ mfPag_Decommit = $00020; {Decommit the page.}
+ mfObj_Tile = $00040; {Also allocate 16-bit segments of 64k
+ which map the memory. (Makes 16<>32 bit
+ pointer conversion possible.}
+ mfObj_Protected = $00080;
+ mfObj_Gettable = $00100;
+ mfObj_Giveable = $00200;
+ mfObj_Any = $00400; {Allow using high memory (> 512 MB).}
+ mfPag_Default = $00400;
+ mfPag_Shared = $02000;
+ mfPag_Free = $04000;
+ mfPag_Base = $10000;
+
+ mfSub_Init = $00001; {Use base, if not set, choose a base
+ address yourself.}
+ mfSub_Grow = $00002; {Grow the specified heap, instead of
+ allocating it. Ignore mfSub_Init.}
+ mfSub_Sparse = $00004;
+ mfSub_Serialize = $00008;
+
+(* Plus a little bit compatibility... *)
+ pag_Read = mfPag_Read;
+ pag_Write = mfPag_Write;
+ pag_Execute = mfPag_Execute;
+ pag_Guard = mfPag_Guard;
+ pag_Commit = mfPag_Commit;
+ pag_Decommit = mfPag_Decommit;
+ obj_Tile = mfObj_Tile;
+ obj_Protected = mfObj_Protected;
+ obj_Gettable = mfObj_Gettable;
+ obj_Giveable = mfObj_Giveable;
+ obj_Any = mfObj_Any;
+ pag_Default = mfPag_Default;
+ pag_Shared = mfPag_Shared;
+ pag_Free = mfPag_Free;
+ pag_Base = mfPag_Base;
+ sub_Init = mfSub_Init;
+ sub_Grow = mfSub_Grow;
+ sub_Sparse = mfSub_Sparse;
+ sub_Serialize = mfSub_Serialize;
+
+{Get some memory.
+ P = Pointer to memory will be returned here.
+ Size = Number of bytes to get. The size is rounded up to a multiple
+ of 4096. This is probably not the case on non-intel 386
+ versions of OS/2.
+ Flags = One or more of the mfXXXX constants.}
+function DosAllocMem(var P:pointer;Size,Flag:cardinal):cardinal; cdecl;
+
+{Free a memory block.}
+function DosFreeMem(P:pointer):cardinal; cdecl;
+
+{Set settings for a block of memory.
+ P = Pointer to the memory. Doesn't need to be the start of the
+ memory block allocated with DosAllocMem, but must be a multiple
+ of 4096.
+ Size = Number of bytes to change settings for. Is rounded up to a
+ multile of 4096.
+ Flags = New flags for the memory.}
+function DosSetMem(P:pointer;Size,Flag:cardinal):cardinal; cdecl;
+
+{Give another process access to a shared memory block.
+
+ P = Pointer to the shared memory object.
+ PID = Process of destination process.
+ Flag = Permissions the the destination process gets.}
+function DosGiveSharedMem(P:pointer;PID,Flag:cardinal):cardinal; cdecl;
+
+{Get access to a shared memory object.
+
+ P = Pointer to shared memory object.
+ Flag = Permissions to ask.}
+function DosGetSharedMem(P:pointer;Flag:cardinal):cardinal; cdecl;
+
+{Get access to a shared memory object that has a name.
+
+ P = Pointer to shared memory object.
+ Name = Name of the memory object. (Starting with '\SHAREMEM\'.
+ Flag = Permissions to ask.}
+function DosGetNamedSharedMem(var P:pointer;Name:PChar;Flag:cardinal):cardinal;
+ cdecl;
+function DosGetNamedSharedMem(var P:pointer;const Name:string;
+ Flag:cardinal):cardinal;
+
+{Allocate memory so that it can later be shared with another program.
+ P = Reveives pointer to memory.
+ Name = Optional: name to give memory. Must start with '\SHAREMEM\'.
+ Use nil for the PChar or '' for the string variant for no name.
+ Size = Number of bytes to allocate.}
+function DosAllocSharedMem(var P:pointer;Name:PChar;
+ Size,Flag:cardinal):cardinal; cdecl;
+function DosAllocSharedMem(var P:pointer;const Name:string;Size,
+ Flag:cardinal):cardinal;
+
+{Get the size and flags of a block of memory.
+
+ P = Pointer to the block of memory.
+ Size = Receives block size.
+ Flag = Receives the flags.}
+function DosQueryMem(P:pointer;var Size,Flag:longint):cardinal; cdecl;
+function DosQueryMem (P: pointer; var Size, Flag: cardinal): cardinal; cdecl;
+
+{Allocate a block of memory in a heap.
+ Base = Pointer to the start of the heap.
+ P = Receives pointer to the memory bock.
+ Size = Number of bytes to allocate.}
+function DosSubAllocMem(Base:pointer;var P:pointer;Size:cardinal):cardinal;
+ cdecl;
+
+{Free a block of memory in a heap.
+ Base = Pointer to the start of the heap.
+ P = Pointer to memory block to free.
+ Size = Number of bytes to free.}
+function DosSubFreeMem(Base,P:pointer;Size:cardinal):cardinal; cdecl;
+
+{Turn a block of memory into a heap.
+
+Base = Pointer to memory block to turn into a heap.
+Flag = One or more of the mfSub_XXXX flags.
+Size = Size of the requested heap.}
+function DosSubSetMem(Base:pointer;Flag,Size:cardinal):cardinal; cdecl;
+
+{Destroy a heap. (Memory remains allocated).
+
+Base = Pointer to the heap to destroy.}
+function DosSubUnsetMem(Base:pointer):cardinal; cdecl;
+
+{****************************************************************************
+
+ Semaphore related routines
+
+****************************************************************************}
+
+const smShared = $0001; {Semaphore is shared.}
+ smMWWaitAny = $0002; {MuxWait only: Wait until a semaphore
+ is cleared.}
+ smMWWaitAll = $0004; {MuxWait only: Wait until all semaphores
+ are cleared.}
+ Sem_Indefinite_Wait = -1; {DosRequestMutExSem blocks the calling
+ thread indefinitely.}
+ Sem_Immediate_Return = 0; {DosRequestMutExSem returns immediately
+ without blocking the calling thread.}
+(* The following two flag values are only available
+ on Warp 3 FP 29, Warp 4 FP 5 and above. *)
+ dce_AutoReset = $1000; {This will cause the (event) semaphore
+ to be reset automatically at the time
+ it is posted.}
+ dce_PostOne = $0800; {This will cause only one thread to be
+ posted where multiple threads are
+ waiting on an event semaphore created
+ with this attribute. dce_PostOne also
+ causes the semaphore to be reset
+ automatically when it is posted.}
+(* The following just for compatibility. *)
+ dcMW_Wait_Any = smMWWaitAny;
+ dcMW_Wait_All = smMWWaitAll;
+
+type PSemRecord=^TSemRecord;
+ TSemRecord=record
+ Semaphore: THandle; {Handle of semaphore to link.}
+ User: cardinal;
+ end;
+
+ PSemArray=^TSemArray;
+ TSemArray=array[0..$ffff] of TSemRecord;
+
+{Create an event semaphore.
+ Name = Optional: Name of semaphore to create. Must start with '\SEM32\.
+ Use nil for PChar or '' for string variant for noname. An
+ unnamed semaphore is not shared unless the sm_Shared flag is
+ set.
+ Handle = Receives handle of semaphore.
+ Attr = One or more of the smXXXX constants.
+ State = Initial state: 0 = Reset (false), 1 = Posted (true).}
+function DosCreateEventSem (Name: PChar;var Handle: THandle;
+ Attr, State: cardinal): cardinal; cdecl;
+function DosCreateEventSem (const Name: string; var Handle: THandle;
+ Attr, State: cardinal): cardinal;
+function DosCreateEventSem (Name: PChar;var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal; cdecl;
+function DosCreateEventSem (const Name: string; var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal;
+
+{Open a semaphore created by another process or thread.
+
+ Name = Name of semaphore.
+ Handle = Receives handle of semaphore.}
+function DosOpenEventSem (Name: PChar; var Handle: THandle): cardinal; cdecl;
+function DosOpenEventSem (const Name: string; var Handle: THandle): cardinal;
+
+{Close an event semaphore.
+ Handle = Handle of a semaphore to close.}
+function DosCloseEventSem (Handle: THandle): cardinal; cdecl;
+
+{Reset an event semaphore: *** probeer *** operation.
+ Handle = Handle of semaphore.
+ PostCount = Number of times DosPostEventSem has been called since last
+ reset.
+
+ Note: Returns errorcode 300 if semaphore is already reset.}
+function DosResetEventSem(Handle:longint;var PostCount:longint):cardinal;
+ cdecl;
+function DosResetEventSem (Handle: THandle; var PostCount: cardinal): cardinal;
+ cdecl;
+
+{Post an event semaphore: *** verhoog *** operation.
+ Handle = Handle of semaphore.
+
+Note: Returns errorcode 299 if semaphore is already posted.}
+function DosPostEventSem (Handle: THandle): cardinal; cdecl;
+
+{Wait until an event semaphore is posted (wait until *** verhoog *** operation).
+ Handle = Handle of semaphore.
+ Timeout = Return with errorcode if timeout milliseconds have past and the
+ semaphore is still reset. To return immediately use 0,
+ to wait forever use -1.}
+function DosWaitEventSem (Handle: THandle; Timeout: cardinal): cardinal; cdecl;
+
+{Check if an event semaphore is posted (if a *** verhoog *** operation has been done).
+ Handle = Handle of semaphore.
+ Posted = Receives number of times DosPostEventSem was called since
+ the last reset.}
+function DosQueryEventSem (Handle: longint; var Posted: longint): cardinal;
+ cdecl;
+function DosQueryEventSem (Handle: THandle; var Posted: cardinal): cardinal;
+ cdecl;
+
+{Create a Mutual Exclusion semaphore (mutex).
+ Name = Optional: Name to give to semaphore. Must start with '\SEM32\'.
+ Use nil for PChar or '' for string variant to use no name.
+ If a name if used the semaphore is shared.
+ Handle = Receives handle of semaphore.
+ Attr = One or more of the smXXXX constants.
+ State = Initial state: (0/false=Not owned, 1/true=Owned.)}
+function DosCreateMutExSem (Name: PChar; var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal; cdecl;
+function DosCreateMutExSem (const Name: string; var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal;
+function DosCreateMutExSem (Name: PChar; var Handle: THandle;
+ Attr, State: cardinal): cardinal; cdecl;
+function DosCreateMutExSem (const Name: string; var Handle: THandle;
+ Attr, State: cardinal): cardinal;
+
+{Open a shared mutex semaphore.
+ Name = Name of semaphore to open, always starts with '\SEM32\'.
+ Handle = Receives handle to semaphore.}
+function DosOpenMutExSem (Name: PChar; var Handle: THandle): cardinal; cdecl;
+function DosOpenMutExSem (const Name: string; var Handle: THandle): cardinal;
+
+{Close a mutex semaphore.
+ handle = Handle of semaphore to close.}
+function DosCloseMutExSem (Handle: THandle): cardinal; cdecl;
+
+{Request ownership of a mutex semaphore. If the semaphore is already owned the
+ process is halted until the semaphore is released.
+ Handle = Handle of semaphore.
+ Timeout = Return with errorcode if the semaphore is still owned after
+ timeout milliseconds; special values are Sem_Indefinite_Wait
+ and Sem_Immediate_Return.}
+function DosRequestMutExSem (Handle: THandle; Timeout: cardinal): cardinal;
+ cdecl;
+
+{Release the ownership of a mutex semaphore.
+ Handle = Handle of semaphore to release.}
+function DosReleaseMutExSem (Handle: THandle): cardinal; cdecl;
+
+{Query the PID and TIB of the owner of a mutex semaphore.
+ Handle = Handle of semaphore.
+ PID = Receives process ID of owner.
+ TID = Receives thread ID of owner.
+ Count = Number of threads (within and outside current process) waiting
+ for ownership of semaphore.}
+function DosQueryMutExSem(Handle:longint;var PID,TID,Count:longint):
+ cardinal; cdecl;
+function DosQueryMutExSem (Handle: THandle; var PID, TID, Count: cardinal):
+ cardinal; cdecl;
+
+{Create a Multiple Wait (MuxWait) semaphore.
+ Name = Optional: Name to give semaphore. Must start with '\SEM32\'.
+ Use nil for PChar or '' for string variant to use no name.
+ If a name if used the semaphore is shared.
+ Handle = Receives handle of semaphore.
+ CSemRec = Number of semaphores to link muxwait semaphore with.
+ SemArray = Array of semaphore records to link with muxwait semaphore.
+ Attr = One or more of the smXXXX constants.}
+function DosCreateMuxWaitSem (Name: PChar; var Handle: THandle;
+ CSemRec: cardinal; var SemArray: TSemArray; Attr: cardinal): cardinal; cdecl;
+function DosCreateMuxWaitSem (const Name: string; var Handle: THandle;
+ CSemRec: cardinal; var SemArray: TSemArray;
+ Attr: cardinal): cardinal;
+
+{Open a MuxWait semaphore.
+ Name = Name of semaphore to open.
+ Handle = Receives handle of semaphore.}
+function DosOpenMuxWaitSem (Name: PChar; var Handle: THandle): cardinal; cdecl;
+function DosOpenMuxWaitSem (const Name: string; var Handle: THandle): cardinal;
+
+{Close a MuxWait semaphore.}
+function DosCloseMuxWaitSem (Handle: THandle): cardinal; cdecl;
+
+{Wait for the MuxWait semaphore to be cleared.
+ Handle = Handle of semaphore.
+ Timeout = Timeout. See above.
+ User = Receives user value of the semaphore that caused the muxwait
+ semaphore to be cleared.}
+function DosWaitMuxWaitSem(Handle:longint;Timeout:longint;
+ var User:longint):cardinal;cdecl;
+function DosWaitMuxWaitSem (Handle: THandle; Timeout: cardinal;
+ var User: cardinal): cardinal; cdecl;
+
+{Add a semaphore to the MuxWait semaphore.
+
+ Handle = Handle of semaphore.
+ SemRec = The semaphore to add.}
+function DosAddMuxWaitSem (Handle: THandle; var SemRec: TSemRecord): cardinal;
+ cdecl;
+
+{Remove a semaphore from the MuxWait semaphore.
+ Handle = Handle of muxwait semaphore.
+ Sem = Handle of semaphore to remove.}
+function DosDeleteMuxWaitSem (Handle, Sem: THandle): cardinal; cdecl;
+
+{Query the semaphores from a MuxWait semaphore.
+ Handle = Handle of semaphore.
+ CSemRec = Input: Size of our array. Output: Number of items in array.
+ SemRecs = Array where TSemRecords are stored.
+ Attr = Flags used by creation of semaphore.}
+function DosQueryMuxWaitSem (Handle: longint; var CSemRec: longint;
+ var SemRecs: TSemArray; var Attr: longint): cardinal; cdecl;
+function DosQueryMuxWaitSem (Handle: THandle; var CSemRec: cardinal;
+ var SemRecs: TSemArray; var Attr: cardinal): cardinal; cdecl;
+
+{****************************************************************************
+
+ Timing related routines.
+
+****************************************************************************}
+
+
+type TDateTime=packed record
+ case byte of
+ 1:
+ (Hour,
+ Minute,
+ Second,
+ Sec100,
+ Day,
+ Month: byte;
+ Year: word;
+ TimeZone: smallint;
+ WeekDay: byte);
+ 2: (* For compatibility *)
+ (Hours,
+ Minutes,
+ Seconds,
+ Hundredths,
+ _Day,
+ _Month: byte;
+ _Year: word;
+ _TimeZone: smallint;
+ _WeekDay: byte);
+ end;
+ PDateTime=^TDateTime;
+
+
+{Get the date and time.}
+function DosGetDateTime(var Buf:TDateTime):cardinal; cdecl;
+
+{Set the date and time.}
+function DosSetDateTime(var Buf:TDateTime):cardinal; cdecl;
+
+{Start a one shot timer.
+ MSec = Number of miliseconds the timer will run.
+ HSem = Handle of event semaphore that is posted when time has expired.
+ TimHandle = Receives timer handle.}
+function DosAsyncTimer (MSec: cardinal; HSem: THandle;
+ var TimHandle: THandle): cardinal; cdecl;
+
+{Start a cyclic timer.
+ MSec = Number of miliseconds the timer will run.
+ HSem = Handle of event semaphore that is posted when time has expired.
+ TimHandle = Receives timer handle.}
+function DosStartTimer (MSec: cardinal; HSem: THandle;
+ var TimHandle: THandle): cardinal; cdecl;
+
+{Stop a timer and destroy its handle. There is no need to check for an
+ error code if you know your timer handle is correct.}
+function DosStopTimer (TimHandle: THandle): cardinal; cdecl;
+
+{Get the frequency of the high resolution timer.}
+function DosTmrQueryFreq(var Freq:longint):cardinal; cdecl;
+function DosTmrQueryFreq(var Freq:cardinal):cardinal; cdecl;
+
+{Get the current value of the high resolution timer.}
+function DosTmrQueryTime(var Time:comp):cardinal; cdecl;
+function DosTmrQueryTime (var Time: QWord): cardinal; cdecl;
+
+{****************************************************************************
+
+ DLL specific routines.
+
+****************************************************************************}
+
+{Load a DLL in memory if it is not yet loaded.
+ ObjName = When the DLL cannot be found, or one of the DLL's it needs
+ cannot be found, the name of the DLL will be put here.
+ ObjLen = Size of the ObjName result buffer.
+ DLLName = Name of DLL to load. Do not give an extension or a path,
+ just the name. OS/2 will automatically search through the
+ LIBPATH for the DLL.
+ Handle = Receives DLL handle.}
+function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
+ var Handle: THandle): cardinal; cdecl;
+function DosLoadModule (var ObjName: string; ObjLen: cardinal;
+ const DLLName: string; var Handle: THandle): cardinal;
+
+{Let OS/2 know that we do not need a DLL anymore. If we were the only process
+ using the DLL, it is unloaded.}
+function DosFreeModule (Handle: THandle): cardinal; cdecl;
+
+{Get the address of a procedure.
+ Handle = DLL handle,
+ Ordinal = Procedure to get address for. 0=Use its name.
+ ProcName = Name of the procedure to query address for. Must be nil
+ for PChar or '' for string variant if Ordinal is nonzero.
+ Address = Receives address of procedure.}
+function DosQueryProcAddr (Handle: THandle; Ordinal: cardinal; ProcName: PChar;
+ var Address: pointer): cardinal; cdecl;
+function DosQueryProcAddr (Handle: THandle; Ordinal: cardinal;
+ const ProcName: string; var Address: pointer): cardinal;
+
+{Get the handle of a loaded DLL or a loaded executable.
+ DLLName = Name of DLL.
+ Handle = Receives DLL handle if present.}
+function DosQueryModuleHandle (DLLName: PChar; var Handle: THandle): cardinal;
+ cdecl;
+function DosQueryModuleHandle (const DLLName: string;
+ var Handle: THandle): cardinal;
+
+{Get the pathname of a loaded DLL or a loaded executable.
+
+ Handle = Handle of DLL.
+ NameLen = Maximum length of char array.
+ Name = PChar (or string) where name is returned.}
+function DosQueryModuleName (Handle: THandle; NameLen: cardinal;
+ Name: Pchar): cardinal; cdecl;
+{function DosQueryModuleName(Handle:THandle;var Name:OpenString):cardinal;}
+
+const pt16bit=0;
+ pt32bit=1;
+
+{Return if a procedure is either 16 or 32 bit.
+ Handle = Handle of DLL.
+ Ordinal = DLL index number. 0 means use Name.
+ Name = Must be nil for PChar or '' for string variant if Ordinal
+ is zero. Otherwise it contains the procedure name.
+ ProcType = One of the ptXXXX constants.}
+function DosQueryProcType (Handle,Ordinal:longint;Name:PChar;
+ var ProcType:longint):cardinal; cdecl;
+function DosQueryProcType(Handle,Ordinal:longint;const Name:string;
+ var ProcType:longint):cardinal;
+function DosQueryProcType (Handle: THandle; Ordinal: cardinal; Name:PChar;
+ var ProcType: cardinal): cardinal; cdecl;
+function DosQueryProcType (Handle: THandle; Ordinal: cardinal; const Name: string;
+ var ProcType: cardinal): cardinal;
+
+{****************************************************************************
+
+ Resource related routines.
+
+****************************************************************************}
+
+{Possible resource types:}
+
+const rtPointer = 1; {Mouse pointer.}
+ rtBitmap = 2; {Bitmap}
+ rtMenu = 3; {Menu template.}
+ rtDialog = 4; {Dialog template.}
+ rtString = 5; {A string table.}
+ rtFontDir = 6; {Font directory.}
+ rtFont = 7; {A font.}
+ rtAccelTable = 8; {Accelerator table.}
+ rtRcData = 9; {Binary data.}
+ rtMessage = 10; {Error message table.}
+ rtDlgInclude = 11; {Dialog include filename.}
+ rtVKeyTbl = 12; {Key to vkey tables.}
+ rtKeyTbl = 13; {Key to ugl tables.}
+ rtCharTbl = 14; {Glyph to character tables.}
+ rtDisplayInfo = 15; {Screen display information.}
+ rtFKAShort = 16; {Function key area short form.}
+ rtFKALong = 17; {Function key area long form.}
+ rtHelpTable = 18; {Help table.}
+ rtHelpSubTable = 19; {Sub help table.}
+ rtFDDir = 20; {DBCS unique/font driver directory.}
+ rtFD = 21; {DBCS unique/font driver.}
+
+{Get the address of a resource object.
+ Handle = Handle of DLL (or executable) to get resource from.
+ ResType = One of the rtXXXX constants.
+ ResName = Number associated to resource object by resource compiler.}
+function DosGetResource (Handle: THandle; ResType, ResName: cardinal;
+ var P: pointer): cardinal; cdecl;
+
+{Remove a resource object from memory.
+ P = Pointer to resource.}
+function DosFreeResource (P: pointer): cardinal; cdecl;
+
+{Get the size of a resource object.
+ Handle = Handle to DLL (or executable).
+ IDT = One of the rtXXXX constants.
+ IDN = Number associated to resource object by resource compiler.
+ Size = Receives resource size.}
+function DosQueryResourceSize (Handle,IDT,IDN:longint;var Size:longint):cardinal;
+ cdecl;
+function DosQueryResourceSize (Handle: THandle; IDT, IDN: cardinal;
+ var Size: cardinal): cardinal; cdecl;
+
+
+{****************************************************************************
+
+ Country and codepage specific routines.
+
+****************************************************************************}
+
+type TCountryCode=record
+ Country, {Country to query info about (0=current).}
+ CodePage:cardinal; {Code page to query info about (0=current).}
+ end;
+ PCountryCode=^TCountryCode;
+ CountryCode=TCountryCode;
+
+ TTimeFmt=(Clock12,Clock24);
+
+ TCountryInfo=record
+ Country,CodePage:cardinal; {Country and codepage requested.}
+ case byte of
+ 0:(
+ DateFormat:cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
+ CurrencyUnit:array[0..4] of char;
+ ThousandSeparator:char; {Thousands separator.}
+ Zero1:byte; {Always zero.}
+ DecimalSeparator:char; {Decimals separator,}
+ Zero2:byte;
+ DateSeparator:char; {Date separator.}
+ Zero3:byte;
+ TimeSeparator:char; {Time separator.}
+ Zero4:byte;
+ CurrencyFormat, {Bit field:
+ Bit 0: 0=indicator before value
+ 1=indicator after value
+ Bit 1: 1=insert space after
+ indicator.
+ Bit 2: 1=Ignore bit 0&1, replace
+ decimal separator with
+ indicator.}
+ DecimalPlace:byte; {Number of decimal places used in
+ currency indication.}
+ TimeFormat:TTimeFmt; {12/24 hour.}
+ Reserve1:array[0..1] of word;
+ DataSeparator:char; {Data list separator}
+ Zero5:byte;
+ Reserve2:array[0..4] of word);
+ 1:(
+ fsDateFmt:cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
+ szCurrency:array[0..4] of char; {null terminated currency symbol}
+ szThousandsSeparator:array[0..1] of char;
+ {Thousands separator + #0}
+ szDecimal:array[0..1] of char; {Decimals separator + #0}
+ szDateSeparator:array[0..1] of char;
+ {Date separator + #0}
+ szTimeSeparator:array[0..1] of char;
+ {Time separator + #0}
+ fsCurrencyFmt, {Bit field:
+ Bit 0: 0=indicator before value
+ 1=indicator after value
+ Bit 1: 1=insert space after
+ indicator.
+ Bit 2: 1=Ignore bit 0&1, replace
+ decimal separator with
+ indicator}
+ cDecimalPlace:byte; {Number of decimal places used in
+ currency indication}
+ fsTimeFmt:byte; {0=12,1=24 hours}
+ abReserved1:array[0..1] of word;
+ szDataSeparator:array[0..1] of char;
+ {Data list separator + #0}
+ abReserved2:array[0..4] of word);
+ end;
+ PCountryInfo=^TCountryInfo;
+ CountryInfo=TCountryInfo;
+
+ TDBCSRange=record
+ Start,Stop:byte;
+ end;
+
+ TDBCSArray=array[0..$ffff] of TDBCSRange;
+ PDBCSArray=^TDBCSArray;
+
+const CurrentCountry:TCountryCode=(Country:0;CodePage:0);
+
+{Get country specific information.
+ Size = Size of our datastructure. (SizeOf(TCountryInfo))
+ ActualSize = Size of OS/2's datastructure. ActualSize bytes of
+ our TCountryInfo have been filled.}
+function DosQueryCtryInfo(Size:longint;var Country:TCountryCode;
+ var Res:TCountryInfo;var ActualSize:longint):cardinal; cdecl;
+function DosQueryCtryInfo(Size:cardinal;var Country:TCountryCode;
+ var Res:TCountryInfo;var ActualSize:cardinal):cardinal; cdecl;
+
+{Get info about a code page with a DBCS character set.}
+function DosQueryDBCSEnv(Size:cardinal;var Country:TCountryCode;
+ Buf:PChar):cardinal; cdecl;
+
+{Convert a string to uppercase.
+ Size = Length of string.
+ Country = Country and codepage for converting.
+ AString = String to convert.}
+function DosMapCase(Size:cardinal;var Country:TCountryCode;
+ AString:PChar):cardinal; cdecl;
+function DosMapCase(var Country:TCountryCode;
+ var AString:string):cardinal;
+
+{Get a collate table (a table for comparing which character is smaller and
+ which one is greater).
+ Size = Length of the databuffer the program has.
+ Country = Country to query table for. (0,0) is default country and
+ codepage.
+ Buf = Buffer to return table in. It's filled with the sort
+ weights of the ascii code. For example the 128th byte
+ contains the weight for ascii code 128.
+ TableLen = Length of collating table.}
+function DosQueryCollate(Size:longint;var Country:TCountryCode;
+ Buf:PByteArray;var TableLen:longint):cardinal; cdecl;
+function DosQueryCollate (Size: cardinal; var Country: TCountryCode;
+ Buf:PByteArray; var TableLen: cardinal): cardinal; cdecl;
+
+{Get the current codepage. The PWordArray is filled with the current code
+ page followed by alternative codepages.}
+function DosQueryCP(Size:longint;CodePages:PWordArray;
+ var ActSize:longint):cardinal; cdecl;
+function DosQueryCP (Size: cardinal; CodePages: PWordArray;
+ var ActSize: cardinal): cardinal; cdecl;
+
+{Change the codepage, but only for the current process.}
+function DosSetProcessCP (CP: cardinal): cardinal; cdecl;
+
+{****************************************************************************
+
+ Exception handling related functions
+
+****************************************************************************}
+
+
+{Exception constants.}
+const XCPT_Continue_Search = $00000000;
+ XCPT_Continue_Execution = $ffffffff;
+ XCPT_Continue_Stop = $00716668;
+
+ XCPT_Signal_Intr = $1;
+ XCPT_Signal_KillProc = $3;
+ XCPT_Signal_Break = $4;
+
+ XCPT_Fatal_Exception = $c0000000;
+ XCPT_Severity_Code = $c0000000;
+ XCPT_Customer_Code = $20000000;
+ XCPT_Facility_Code = $1fff0000;
+ XCPT_Exception_Code = $0000ffff;
+
+ XCPT_Unknown_Access = $00000000;
+ XCPT_Read_Access = $00000001;
+ XCPT_Write_Access = $00000002;
+ XCPT_Execute_Access = $00000004;
+ XCPT_Space_Access = $00000008;
+ XCPT_Limit_Access = $00000010;
+ XCPT_Data_Unknown = $ffffffff;
+
+ XCPT_Guard_Page_Violation = $80000001;
+ XCPT_Unable_To_Grow_Stack = $80010001;
+ XCPT_Access_Violation = $c0000005;
+ XCPT_In_Page_Error = $c0000006;
+ XCPT_Illegal_Instruction = $c000001c;
+ XCPT_Invalid_Lock_Sequence = $c000001d;
+ XCPT_Noncontinuable_Exception = $c0000024;
+ XCPT_Invalid_Disposition = $c0000025;
+ XCPT_Unwind = $c0000026;
+ XCPT_Bad_Stack = $c0000027;
+ XCPT_Invalid_Unwind_Target = $c0000028;
+ XCPT_Array_Bounds_Exceeded = $c0000093;
+ XCPT_Float_Denormal_Operand = $c0000094;
+ XCPT_Float_Divide_By_Zero = $c0000095;
+ XCPT_Float_Inexact_Result = $c0000096;
+ XCPT_Float_Invalid_Operation = $c0000097;
+ XCPT_Float_Overflow = $c0000098;
+ XCPT_Float_Stack_Check = $c0000099;
+ XCPT_Float_Underflow = $c000009a;
+ XCPT_Integer_Divide_By_Zero = $c000009b;
+ XCPT_Integer_Overflow = $c000009c;
+ XCPT_Privileged_Instruction = $c000009d;
+ XCPT_Datatype_Misalignment = $c000009e;
+ XCPT_Breakpoint = $c000009f;
+ XCPT_Single_Step = $c00000a0;
+ XCPT_Process_Terminate = $c0010001;
+ XCPT_Async_Process_Terminate = $c0010002;
+ XCPT_Signal = $c0010003;
+
+const
+ MaxExceptionParameters = 4; { Enough for all system exceptions. }
+
+type PExceptionRegistrationRecord=^TExceptionRegistrationRecord;
+ PExceptionReportRecord=^TExceptionReportRecord;
+ PContextRecord=^TContextRecord;
+
+ TExceptionHandler=procedure(Report:PExceptionReportRecord;
+ RegRec:PExceptionRegistrationRecord;
+ Context:PContextRecord;
+ DispContext:pointer); cdecl;
+
+ TExceptionRegistrationRecord=record
+ Prev_Structure:PExceptionRegistrationRecord;
+ ExceptionHandler:TExceptionHandler;
+ end;
+
+ TExceptionReportRecord=record
+ Exception_Num,
+ HandlerFlags:cardinal;
+ Nested_RepRec:PExceptionReportRecord;
+ Address:pointer;
+ ParamCount:cardinal;
+ Parameters:array [0..MaxExceptionParameters] of cardinal;
+ end;
+
+ TContextRecord=record
+ ContextFlags:cardinal;
+ Env:array[1..7] of cardinal;
+ FPUStack:array[0..7] of extended;
+ Reg_GS,
+ Reg_FS,
+ Reg_ES,
+ Reg_DS,
+ Reg_EDI,
+ Reg_ESI,
+ Reg_EAX,
+ Reg_EBX,
+ Reg_ECX,
+ Reg_EDX,
+ Reg_EBP,
+ Reg_EIP,
+ Reg_CS,
+ Flags,
+ Reg_ESP,
+ Reg_SS:cardinal;
+ end;
+
+{Warning!!! Never use Presentation Manager functions from exception
+ handlers!}
+
+{Install an exceptionhandler. The Prev_Structure field of RegRec should be
+nil, it will be filled in be OS/2. RegRec must be on the stack: It must be a
+local variable.}
+function DosSetExceptionHandler(var RegRec:TExceptionRegistrationRecord):cardinal;
+ cdecl;
+
+{Uninstall an exception handler.}
+function DosUnSetExceptionHandler(var RegRec:TExceptionRegistrationRecord
+ ):cardinal; cdecl;
+
+{Trigger an exception.}
+function DosRaiseException(var Excpt:TExceptionReportRecord):cardinal; cdecl;
+
+{Send a signal to a process.}
+function DosSendSignalException(PID,Exception:cardinal):cardinal; cdecl;
+
+{Call and remove a set of exceptionhandlers}
+function DosUnwindException(var Handler:TExceptionRegistrationRecord;
+ TargetIP:pointer;
+ var RepRec:TExceptionReportRecord):cardinal; cdecl;
+
+{Full screen applications can get Ctrl-C and Ctrl-Break focus. For all
+ processes sharing one screen, only one can have Ctrl-C focus.
+ Enable = 0 = Release focus, 1 = Get focus.
+ Times = Number of times focus has been get minus number of times it
+ has been released.}
+function DosSetSignalExceptionFocus(Enable:longint;var Times:longint):cardinal;
+ cdecl;
+function DosSetSignalExceptionFocus (Enable: cardinal;
+ var Times: cardinal): cardinal; cdecl;
+function DosSetSignalExceptionFocus (Enable: boolean;
+ var Times: cardinal): cardinal; cdecl;
+
+{Tell OS/2 that if an exception occurs, it must queue it up, until a
+ DosExitMustComplete follows. Urgent exceptions still occur. The only
+ possible error is that the nesting becomes too high, so error checking
+ is only needed in seldom cases.
+ Nesting = Number of DosEnterMustComplete calls minus number of
+ DosExitMustComplete calls.}
+function DosEnterMustComplete(var Nesting:longint):cardinal; cdecl;
+function DosEnterMustComplete(var Nesting:cardinal):cardinal; cdecl;
+
+{Tell OS/2 that it can send exceptions again. See above}
+function DosExitMustComplete(var Nesting:longint):cardinal; cdecl;
+function DosExitMustComplete(var Nesting:cardinal):cardinal; cdecl;
+
+{Tell we want further signal exceptions.
+ SignalNum = Signal nummer to acknowlegde.}
+function DosAcknowledgeSignalException (SignalNum: cardinal): cardinal; cdecl;
+
+
+{****************************************************************************
+
+ Queue related routines.
+
+****************************************************************************}
+
+type
+ TRequestData = record
+ case boolean of
+ false: (PID0:longint; {ID of process that wrote element.}
+ Data0:longint); {Information from process
+ writing the data.}
+ true: (PID, Data: cardinal);
+ end;
+ PRequestData = ^TRequestData;
+
+{Useful constants for priority parameters.}
+const quFIFO=0;
+ quLIFO=1;
+ quPriority=2;
+ quNoConvert_Address=0;
+ quConvert_Address=4;
+
+{Close a queue. If the calling process has created the queue, it is
+ destroyed. If you can guarantee the handle is correct, there is no need
+ to check for error codes.}
+function DosCloseQueue (Handle: THandle): cardinal; cdecl;
+
+{Create a queue. The process that creates a queue, owns that queue, and is
+ the only one who can read from that queue. Other processes can only write
+ to that queue. The queuename must have the format '\QUEUES\name.ext' .
+
+ Handle = Receives queue handle.
+ Priority = 0 = Use FIFO system.
+ 1 = Use LIFO system.
+ 2 = Use priority system.
+ Add 4 to convert addresses of data inserted by 16-bit
+ processes to 32 bit pointers.
+ Name = Name of queue to create.}
+function DosCreateQueue (var Handle: THandle; Priority: cardinal;
+ Name: PChar): cardinal; cdecl;
+function DosCreateQueue (var Handle: THandle; Priority: cardinal;
+ const Name: string): cardinal;
+
+{Open an existing queue. You cannot read from the queue unless you are the
+ process that created it. The name must have the format '\QUEUES\name.ext'}
+function DosOpenQueue(var Parent_PID:longint;var Handle:longint;
+ Name:PChar):cardinal; cdecl;
+function DosOpenQueue(var Parent_PID:longint;var Handle:longint;
+ const Name:string):cardinal;
+
+function DosOpenQueue (var Parent_PID: cardinal; var Handle: THandle;
+ Name: PChar): cardinal; cdecl;
+function DosOpenQueue (var Parent_PID: cardinal; var Handle: THandle;
+ const Name: string): cardinal;
+
+{Read a record from a queue, but do not remove it from the queue.
+ Handle = Handle of queue to read from.
+ ReqBuffer = Receives information about read data.
+ DataLen = Receives length of data read.
+ DataPtr = Receives the address of the data.
+ Element = 0 = Return first element in queue.
+ 1 = Return next element in queue. Can be repeated.
+ Current element number is returned here, for use
+ with DosReadQueue.
+ Wait = 0 = Wait until there is a queue element available.
+ 1 = Return with an error when queue is empty.
+ Priority = Receives priority of queue record (1..15).
+ ASem = Use NIL if Wait=0, give a handle of a semaphore when
+ Wait=1. The semaphore will be cleared when there is an
+ element inserted it the queue.
+ !! event queue}
+function DosPeekQueue(Handle:longint;var ReqBuffer:TRequestData;
+ var DataLen:longint;var DataPtr:pointer;
+ var Element:longint;Wait:longint;
+ var Priority:byte;ASem:longint):cardinal; cdecl;
+function DosPeekQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ var Element: cardinal; Wait: boolean;
+ var Priority: byte; ASem: THandle): cardinal; cdecl;
+function DosPeekQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ var Element: cardinal; Wait: cardinal;
+ var Priority: byte; ASem: THandle): cardinal; cdecl;
+
+{Empty a queue. You must be the process the created the queue.}
+function DosPurgeQueue (Handle: THandle): cardinal; cdecl;
+
+{Return the number of elements in the queue.}
+function DosQueryQueue(Handle:longint;var Count:longint):cardinal; cdecl;
+function DosQueryQueue (Handle: THandle; var Count: cardinal): cardinal; cdecl;
+
+{Read a record from a queue, but do not remove it from the queue.
+ Handle = Handle of queue to read from.
+ ReqBuffer = Receives information about read data.
+ DataLen = Receives length of data read.
+ DataPtr = Receives the address of the data.
+ Element = 0 = Return first element in queue.
+ Otherwise: Return the element numbered with this.
+ Wait = 0 = Wait until there is a queue element available.
+ 1 = Return with an error when queue is empty.
+ Priority = Receives priority of queue record (1..15).
+ ASem = Use NIL if Wait=0, give a handle of a semaphore when
+ Wait=1. The semaphore will be cleared when there is an
+ element inserted it the queue.
+ !! event queue}
+function DosReadQueue(Handle:longint;var ReqBuffer:TRequestData;
+ var DataLen:longint;var DataPtr:pointer;
+ Element,Wait:longint;var Priority:byte;
+ ASem:longint):cardinal; cdecl;
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ Element, Wait: cardinal; var Priority: byte;
+ ASem: THandle): cardinal; cdecl;
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ Element: cardinal; Wait: boolean; var Priority: byte;
+ ASem: THandle): cardinal; cdecl;
+
+{Write a data record to a queue.
+ Handle = Handle of queue to write to.
+ Request = Value that will be inserted in the RequestData field when
+ element is read from queue.
+ DataLen = Size of data to write.
+ DataBuf = Data to write.
+ Priority = Priority of data in buffer. Only relevant when queue is
+ created with priority support.}
+function DosWriteQueue (Handle: THandle; Request, Datalen: cardinal;
+ var DataBuf; Priority: cardinal): cardinal; cdecl;
+
+{****************************************************************************
+
+ Error handling related routines.
+
+****************************************************************************}
+
+const deHardErr = 1; {Hard errors are enabled, to disable
+ do not give this switch.}
+ deDisableExceptions = 2; {Exceptions are disabled, to enable
+ do not give this switch.}
+{For compatibility with VP:}
+ ferr_DisableHardErr = 0; {Disable hard error popups.}
+ ferr_EnableHardErr = deHardErr;
+ ferr_EnableException = 0; {Enable exception popups.}
+ ferr_DisableException = deDisableExceptions;
+
+{Disable the end user notification of hardware errors and exceptions. Users
+ can overide this in config.sys. By default, notification is enabled.
+ There is no need for error checking if you can guarantee the parameter is
+ correct.}
+function DosError (Error: cardinal): cardinal; cdecl;
+
+{Get information about an error code.
+ It cannot fail, so it is written as procedure.
+
+Code = Error code to get info about.
+_Class = Receives the error class.
+Action = Receives the recommended action you should take.
+Locus = Receives what could have caused the error.}
+procedure DosErrClass(Code:longint;var _Class,Action,Locus:longint); cdecl;
+procedure DosErrClass (Code: cardinal; var _Class, Action, Locus: cardinal);
+ cdecl;
+
+
+{****************************************************************************
+
+ Message file specific routines.
+
+****************************************************************************}
+
+
+type PInsertTable=^TInsertTable;
+ TInsertTable=array[1..9] of PChar;
+
+{Get a message from a messagefile.
+ Table = Table of strings to insert.
+ TableSize = Number of strings in table.
+ Buf = Address of buffer to store message in.
+ BufSize = Size of buffer to store message in.
+ MsgNumber = Number of message to get.
+ FileName = Name of file to get message from.
+ MsgSize = The size of the message returned.}
+function DosGetMessage(Table:PInsertTable;TableSize:longint;Buf:PChar;
+ BufSize,MsgNumber:longint;FileName:PChar;
+ var MsgSize:longint):cardinal;
+function DosGetMessage (Table: PInsertTable; TableSize: cardinal; Buf: PChar;
+ BufSize, MsgNumber: cardinal; FileName: PChar;
+ var MsgSize: cardinal): cardinal;
+{And a variant using strings and open arrays.
+function DosGetMessage(const Table:array of PString;var Buf:string;
+ BufSize,MsgNumber:longint;const FileName:PChar):cardinal;}
+
+{And a variant using strings, but with a PChar buffer, because of long
+ messages, and open arrays.
+function DosGetMessage(const Table:array of PString;Buf:PChar;
+ BufSize,MsgNumber:longint;const FileName:string;
+ MsgSize:longint):cardinal;}
+
+{Insert textstrings into a message. The message must be loaded before with
+ DosGetMessage. This function is used when the insert strings are not yet
+ known when the message was loaded.
+ Table = Table of strings to insert.
+ TableSize = Number of struings to insert.
+ Message = Message to insert strings into.
+ SrcMessageSize = Size of message to insert strings into.
+ Buf = Receives adjusted message.
+ BufSize = Size of your buffer.
+ DstMessageSize = Receives size of adjusted message.}
+function DosInsertMessage(Table:PInsertTable;TableSize:longint;
+ Message:PChar;SrcMessageSize:longint;
+ Buf:PChar;BufSize:longint;
+ var DstMessageSize:longint):cardinal; cdecl;
+function DosInsertMessage (Table: PInsertTable; TableSize: cardinal;
+ Message: PChar; SrcMessageSize: cardinal;
+ Buf: PChar; BufSize: cardinal;
+ var DstMessageSize: cardinal): cardinal; cdecl;
+{And a variant using strings and open arrays.
+function DosInsertMessage(Table:array of PString;
+ const Message:string;
+ var Buf:openstring):cardinal;}
+
+{And a variant using strings, but with a PChar buffer, because of long
+ messages, and open arrays.
+function DosInsertMessage(Table:array of PString;
+ Message:PChar;SrcMessageSize:longint;
+ Buf:PChar;BufSize:longint;
+ var DstMessageSize:longint):cardinal;}
+
+{Write a message to a file.
+ Handle = Handle of file.
+ Size = Size of message.
+ Buf = Buffer where message is located.}
+function DosPutMessage (Handle: THandle; Size: cardinal; Buf: PChar): cardinal;
+ cdecl;
+function DosPutMessage (Handle: THandle; const Buf: string): cardinal;
+
+{Get info about which codepages and languages a messagefile supports.
+ Buf = Receives information.
+ BufSize = Size of buffer.
+ FileName = Filename of message file.
+ InfoSize = Receives size in bytes of the returned info.}
+function DosQueryMessageCP(var Buf;BufSize:longint;FileName:PChar;
+ var InfoSize:longint):cardinal;
+function DosQueryMessageCP(var Buf;BufSize:longint;const FileName:string;
+ var InfoSize:longint):cardinal;
+function DosQueryMessageCP (var Buf; BufSize: cardinal; FileName: PChar;
+ var InfoSize: cardinal): cardinal;
+function DosQueryMessageCP (var Buf; BufSize: cardinal; const FileName: string;
+ var InfoSize: cardinal): cardinal;
+
+{****************************************************************************
+
+ Session specific routines.
+
+****************************************************************************}
+
+const
+{Start the new session independent or as a child.}
+ ssf_Related_Independent = 0; {Start new session independent
+ of the calling session.}
+ ssf_Related_Child = 1; {Start new session as a child
+ session to the calling session.}
+
+{Start the new session in the foreground or in the background.}
+ ssf_FgBg_Fore = 0; {Start new session in foreground.}
+ ssf_FgBg_Back = 1; {Start new session in background.}
+
+{Should the program started in the new session
+ be executed under conditions for tracing?}
+ ssf_TraceOpt_None = 0; {No trace.}
+ ssf_TraceOpt_Trace = 1; {Trace with no notification
+ of descendants.}
+ ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
+ A termination queue must be
+ supplied and Related must be
+ ssf_Related_Child (=1).}
+
+{Will the new session inherit open file handles
+ and environment from the calling process.}
+ ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
+ ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
+
+{Specifies the type of session to start.}
+ ssf_Type_Default = 0; {Use program's type.}
+ ssf_Type_FullScreen = 1; {OS/2 full screen.}
+ ssf_Type_WindowableVIO = 2; {OS/2 window.}
+ ssf_Type_PM = 3; {Presentation Manager.}
+ ssf_Type_VDM = 4; {DOS full screen.}
+ ssf_Type_WindowedVDM = 7; {DOS window.}
+{Additional values for Windows programs}
+ Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
+ own windowed session.}
+ Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
+ common windowed session.}
+ Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
+ compatibility mode in its own
+ windowed session.}
+ Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
+ compatibility mode in a common
+ windowed session.}
+ Prog_31_Enh = 19; {Windows 3.1 program in enhanced
+ compatibility mode in a full
+ screen session.}
+ Prog_31_Std = 20; {Windows 3.1 program in a full
+ screen session.}
+
+{Specifies the initial attributes for a OS/2 window or DOS window session.}
+ ssf_Control_Visible = 0; {Window is visible.}
+ ssf_Control_Invisible = 1; {Window is invisible.}
+ ssf_Control_Maximize = 2; {Window is maximized.}
+ ssf_Control_Minimize = 4; {Window is minimized.}
+ ssf_Control_NoAutoClose = 8; {Window will not close after
+ the program has ended.}
+ ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
+ InitXSize, and InitYSize for
+ the size and placement.}
+
+type TStatusData=record
+ Length:word; {Length, in bytes, of datastructure.}
+ SelectIND:word; {Determines if the session can be
+ selected: Don't change/selectable/
+ not selectable (0/1/2).}
+ BondIND:word; {Determines which section will come
+ to the foreground when it is
+ selected: Don't change/child to
+ foreground when parent selected/
+ parent to foreground when parent
+ selected.}
+ end;
+ PStatusData=^TStatusData;
+
+{Queue data structure for synchronously started sessions.}
+ TChildInfo = record
+ case boolean of
+ false:
+ (SessionID,
+ Return: word); {Return code from the child process.}
+ true:
+ (usSessionID,
+ usReturn: word); {Return code from the child process.}
+ end;
+ PChildInfo = ^TChildInfo;
+
+
+ TStartData=record
+ {Note: to omit some fields, use a length smaller than
+ SizeOf(TStartData).}
+ Length:word; {Length, in bytes, of datastructure
+ (24/30/32/50/60).}
+ Related:word; {Independent/child session (0/1).}
+ FgBg:word; {Foreground/background (0/1).}
+ TraceOpt:word; {No trace/trace this/trace all
+ (0/1/2).}
+ PgmTitle:PChar; {Program title.}
+ PgmName:PChar; {Filename to program.}
+ PgmInputs:PChar; {Command parameters (nil allowed).}
+ TermQ:PChar; {System queue. (nil allowed).}
+ Environment:PChar; {Environment to pass (nil allowed).}
+ InheritOpt:word; {Inherit enviroment from shell/
+ inherit environment from parent
+ (0/1).}
+ SessionType:word; {Auto/full screen/window/presentation
+ manager/full screen Dos/windowed Dos
+ (0/1/2/3/4/5/6/7).}
+ Iconfile:PChar; {Icon file to use (nil allowed).}
+ PgmHandle:cardinal; {0 or the program handle.}
+ PgmControl:word; {Bitfield describing initial state
+ of windowed sessions.}
+ InitXPos,InitYPos:word; {Initial top coordinates.}
+ InitXSize,InitYSize:word; {Initial size.}
+ Reserved:word;
+ ObjectBuffer:PChar; {If a module cannot be loaded, its
+ name will be returned here.}
+ ObjectBuffLen:cardinal; {Size of your buffer.}
+ end;
+ PStartData=^TStartData;
+ StartData=TStartData;
+
+{Start a new session.
+ AStartData = A startdata record.
+ SesID = Receives session ID of session created.
+ PID = Receives process ID of process created.}
+function DosStartSession(var AStartData:TStartData;
+ var SesID,PID:longint):cardinal;cdecl;
+function DosStartSession (var AStartData: TStartData;
+ var SesID, PID: cardinal): cardinal; cdecl;
+
+{Set the status of a child session.
+ SesID = ID of session.
+ AStatus = Status to set.}
+function DosSetSession (SesID: cardinal; var AStatus: TStatusData): cardinal;
+ cdecl;
+
+{Bring a child session to the foreground.
+ SesID = ID of session.}
+function DosSelectSession (SesID: cardinal): cardinal; cdecl;
+
+{Terminate (a) child session(s).
+ Scope = 0 = Terminate specified session.
+ 1 = Terminate all child sessions.
+ SesID = ID of session to terminate (ignored when terminating
+ all).}
+function DosStopSession (Scope, SesID: cardinal): cardinal; cdecl;
+
+{****************************************************************************
+
+ Named/unnamed pipe specific routines.
+
+****************************************************************************}
+
+type TAvailData=record
+ cbPipe, {Number of bytes in pipe.}
+ cbMessage:word; {Number of bytes in current message.}
+ end;
+
+ TPipeInfo=record
+ cbOut:word; {Size of outbound data.}
+ cbIn:word; {Size of inbound data.}
+ MaxInst:byte; {Maximum number of instances.}
+ CurInst:byte; {Current number of instances.}
+ Name:string; {Name of the pipe. You can use @Name[1] if
+ you need a PChar to the name; the string is
+ always followed by a zero.}
+ end;
+
+ TPipeSemState=record
+ Status:byte;
+ Flag:byte;
+ Key:word;
+ Avail:word;
+ end;
+
+{Create an unnamed pipe.
+ ReadHandle = Receives handle for reading from pipe.
+ WriteHandle = Receives handle to write to pipe.
+ Size = Size of pipe to create. 0 means default size. If data is
+ written into a pipe that is smaller than the sent data, the
+ writing thread is suspended until the data has been read
+ from the pipe, thus making room for more data to send.}
+function DosCreatePipe (var ReadHandle, WriteHandle: THandle;
+ Size: cardinal): cardinal; cdecl;
+
+const {np_XXXX constants for openmode.}
+ np_Access_Inbound = $0000; {Client to server connection.}
+ np_Access_Outbound = $0001; {Server to client access.}
+ np_Access_Duplex = $0002; {Two way access.}
+ np_Inherit = $0000; {Pipe handle is inherited by
+ child processes.}
+ np_NoInherit = $0080; {Pipe handle is _not_ inherited by
+ child processes.}
+ np_No_Write_Behind = $4000; {Don't allow write behind for
+ remote pipes.}
+ {np_XXXX constants for pipemode.}
+ np_Unlimited_Instances = $00ff; {Unlimited instances.}
+ np_ReadMode_Mesg = $0100; {Read the pipe as a message
+ stream instead of as a byte
+ stream.}
+ np_ReadMode_Message = np_ReadMode_Mesg;
+ np_WriteMode_Mesg = $0400; {Write the pipe as a message
+ stream instead of as a byte
+ stream.}
+ np_WriteMode_Message = np_WriteMode_Mesg;
+ np_Type_Message = np_WriteMode_Mesg;
+ np_NoWait = $8000; {Dosread and Doswrite do not
+ wait is no data can be read or
+ written; they return with an
+ error message.}
+
+{Create a named pipe.
+ Name = Name of pipe to create.
+ Handle = Receives handle to pipe.
+ OpenMode = A combination of np_XXXX constants for openmode.
+ PipeMode = A combination of np_XXXX constants for pipemode,
+ plus a number within [1..254] which determines the number
+ of instances that can be created to the pipe, or,
+ np_Unlimited_Instance for an unlimited number of
+ instances.
+ OutBufSize = The number of bytes to allocate for the output buffer.
+ InBufSize = The number of bytes to allocate for the input buffer.
+ MSec = The maximum time to wait for an available instance.}
+function DosCreateNPipe (Name: PChar; var Handle: THandle; OpenMode, PipeMode,
+ OutBufSize, InBufSize, MSec: cardinal): cardinal;
+ cdecl;
+function DosCreateNPipe (const Name: string; var Handle: THandle; OpenMode,
+ PipeMode, OutBufSize, InBufSize, MSec: cardinal):
+ cardinal;
+
+{Makes a procedure call to a duplex message pipe.
+ Name = Name of pipe.
+ Input = Buffer that contains data to be written to the pipe.
+ InputSize = Size of the inputdata.
+ Output = Buffer that contains data to be read from the pipe.
+ OutputSize = Size of the outputbuffer.
+ ReadBytes = Receives number of bytes actually read.
+ MSec = The maximum time to wait for an available instance.}
+function DosCallNPipe(Name:PChar;var Input;InputSize:longint;
+ var Output;OutputSize:longint;var ReadBytes:longint;
+ MSec:longint):cardinal; cdecl;
+function DosCallNPipe(const Name:string;var Input;InputSize:longint;
+ var Output;OutputSize:longint;var ReadBytes:longint;
+ MSec:longint):cardinal;
+function DosCallNPipe (Name: PChar; var Input; InputSize: cardinal;
+ var Output; OutputSize: cardinal;
+ var ReadBytes: cardinal; MSec: cardinal): cardinal;
+ cdecl;
+function DosCallNPipe (const Name: string; var Input; InputSize: cardinal;
+ var Output; OutputSize: cardinal;
+ var ReadBytes: cardinal; MSec: cardinal): cardinal;
+
+{Prepare a named pipe for a client process.
+ Handle = Handle that was returned when pipe was created.}
+function DosConnectNPipe (Handle: THandle): cardinal; cdecl;
+
+{Acknowledges that a client process has closed a named pipe.
+ Handle = Handle that was returned when pipe was created.}
+function DosDisconnectNPipe (Handle: THandle): cardinal; cdecl;
+
+const np_State_Disconnected = 1; {Pipe is disconnected.}
+ np_State_Listening = 2; {Pipe is listening.}
+ np_State_Connected = 3; {Pipe is connected.}
+ np_State_Closing = 4; {Pipe is closing.}
+
+{Preview data in a pipe: Read data without removing it.
+ Handle = Handle to named pipe.
+ Buffer = Buffer to receive data in.
+ BufSize = Size of the buffer.
+ ReadBytes = Receives number of bytes put in buffer.
+ Avail = Receives size of available data.
+ State = One of the np_xxxx constants for states.}
+function DosPeekNPipe(Handle:longint;var Buffer;BufSize:longint;
+ var ReadBytes:longint;var Avail:TAvailData;
+ var State:longint):cardinal; cdecl;
+function DosPeekNPipe (Handle: THandle; var Buffer; BufSize: cardinal;
+ var ReadBytes: cardinal; var Avail: TAvailData;
+ var State: cardinal): cardinal; cdecl;
+
+{Get information about a named pipe handle.
+ Handle = Handle to pipe.
+ State = A combination of np_XXXX constants for (!!!) pipemode.}
+function DosQueryNPHState(Handle:longint;var State:longint):cardinal; cdecl;
+function DosQueryNPHState (Handle: THandle; var State: cardinal): cardinal;
+ cdecl;
+
+{Return information about a named pipe.
+ Handle = Handle to pipe.
+ InfoLevel = Level of information wanted (1 or 2 allowed).
+ Buffer = TPipeInfo datastructure for level 1.
+ Unique 4 byte identifier of the client for level 2. Only
+ used for LAN based pipe servers.}
+function DosQueryNPipeInfo (Handle: THandle; InfoLevel: cardinal; var Buffer;
+ BufSize: cardinal): cardinal; cdecl;
+
+{Return information of local named pipes that are attached to a semaphore.
+ SemHandle = Handle to a shared event or MuxWait semaphore that is
+ attached to a named pipe.
+ SemArray = Array in which for each pipe attached to the semaphore.
+ BufSize = Size of SemArray, in bytes.}
+function DosQueryNPipeSemState (SemHandle: THandle; var SemArray;
+ BufSize: cardinal): cardinal; cdecl;
+
+{Resets the blocking mode and state of a named pipe.
+ Handle = Handle to named pipe.
+ State = One of the np_XXXX constants for pipemode.}
+function DosSetNPHState (Handle: THandle; State: cardinal): cardinal; cdecl;
+
+{Attach a shared event semaphore to a local named pipe.
+ PipeHandle = Handle to named pipe.
+ SemHandle = Handle to semaphore.
+ Key = A key that must be different for each named pipe that is
+ attached to the semaphore.}
+function DosSetNPipeSem (PipeHandle, SemHandle: THandle; Key: cardinal):
+ cardinal; cdecl;
+
+{Write to a duplex named pipe; then read from it.
+ Handle = Handle to named pipe.
+ OutBuf = The data to write.
+ OutSize = Size of the data to write.
+ InBuf = Receives the read data.
+ InSize = Size of the input buffer.
+ ReadBytes = Number of bytes read from the pipe.}
+function DosTransactNPipe(Handle:longint;var OutBuf;OutSize:longint;
+ var InBuf;InSize:longint;
+ var ReadBytes:longint):cardinal; cdecl;
+function DosTransactNPipe (Handle: THandle; var OutBuf; OutSize: cardinal;
+ var InBuf; InSize: cardinal;
+ var ReadBytes: cardinal): cardinal; cdecl;
+
+{Waits until an instance of a named pipe becomes available.
+ Name = Name of named pipe (always starts with '\PIPE\').
+ MSec = Return with an error code if this time has elapsed.}
+function DosWaitNPipe (Name: PChar; MSec: cardinal): cardinal; cdecl;
+function DosWaitNPipe (const Name: string; MSec: cardinal): cardinal;
+
+{****************************************************************************
+
+ Virtual device driver related routines.
+
+****************************************************************************}
+
+{Open a virtual device driver.
+ Name = Name of virtual device driver.
+ Handle = Receives handle to virtual device driver.}
+function DosOpenVDD (Name: PChar; var Handle: THandle): cardinal; cdecl;
+
+{Request to talk with a virtual device driver.
+ Handle = Handle to virtual device driver.
+ SGroup = Handle to the screen group of a DOS session (may be nil).
+ Cmd = A number which indicates the service you call.
+ InSize = Size of the data to send to the VDD.
+ InBuffer = Buffer which contains the data to send to the VDD.
+ OutSize = Size of the buffer in which the VDD will return data.
+ OutBuffer = Receives the data that the VDD returns.}
+function DosRequestVDD (Handle: THandle; SGroup, Cmd: cardinal;
+ InSize: cardinal; var InBuffer;
+ OutSize: cardinal; var OutBuffer): cardinal; cdecl;
+
+{Close a virtual device driver.}
+function DosCloseVDD (Handle: THandle): cardinal; cdecl;
+
+{****************************************************************************
+
+ 16 <=> 32 bit support related routines
+
+****************************************************************************}
+
+{Convert a 16 bit far pointer to a 32 bit near pointer.
+ This procedure needs to be called from assembler.
+ This procedure works by mapping an area in your flat address space onto the
+ same physical memory address as the selector of the 16 bit far pointer.
+
+In:
+ eax Pointer to convert in selector:offset format.
+
+Out:
+ eax Returned 32 bit near pointer.}
+procedure DosSelToFlat; cdecl;
+
+type
+ TFarPtr = record
+ Sel, Offset: word;
+ end;
+
+function SelToFlat (AFarPtr: TFarPtr): pointer;
+function SelToFlat (AFarPtr: cardinal): pointer;
+{The second variant can make use of the register calling convention.}
+
+{Convert a 32 bit near pointer to a 16 bit far pointer.
+ This procedure needs to be called from assembler.
+ This procedure works by allocating a selector at the same physical address
+ as the pointer you pass points to.
+
+In:
+ eax Pointer to convert in 32 bit near format.
+
+Out:
+ eax Returned 16 bit far pointer in selector:offset format.}
+procedure DosFlatToSel; cdecl;
+
+{typecast result to TFarPtr}
+function FlatToSel (APtr: pointer): cardinal;
+
+{Allocate Count dwords in a memory block unique in each thread. A maximum
+ of 8 dwords can be allocated at a time, the total size of the thread local
+ memory area is 128 bytes; FPC 1.1+ uses one dword from this for internal
+ multi-threading support, leaving 124 bytes to programmers.}
+function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): cardinal;
+ cdecl;
+
+{Deallocate a previously allocated space in the thread local memory area.}
+function DosFreeThreadLocalMemory (P: pointer): cardinal; cdecl;
+
+const
+{ Values for DosQueryRASInfo Index parameter }
+ sis_MMIOAddr = 0;
+ sis_MEC_Table = 1;
+ sis_Sys_Log = 2;
+{ The following one for compatibility only }
+ SPU_SIS_MEC_TABLE = sis_MEC_Table;
+
+{ Bit flags for the SYSLOG status word. }
+ lf_LogEnable = 1; { Logging enabled }
+ lf_LogAvailable = 2; { Logging available }
+
+{ DosQueryRASInfo returns information about active trace event recording
+ and System Logging facility from the Global Information Segment (InfoSegGDT)
+ dump.}
+{ Parameters
+ * Index - one of the sis_* values:
+ sis_MEC_Table - return the address of the table of actively traced major
+ event codes in the InfoSegGDT. The table is 32 bytes long, each bit
+ represents each major event code from 0 to 255.
+ sis_Sys_Log - return the address of the SYSLOG status word from
+ the InfoSegGDT. The status may contain a combination of lf_Log* flags
+ defined above.}
+{ Possible return codes:
+ 0 - No_Error
+ 5 - Error_Access_Denied
+ 87 - Error_Invalid_Parameter}
+function DosQueryRASInfo (Index: cardinal; var PBuffer: pointer): cardinal;
+ cdecl;
+
+const
+{ Logging constants }
+ ErrLog_Service = 1;
+ ErrLog_Version = 1;
+
+{ LogRecord status bits }
+ lf_Bit_ProcName = 1; {used to indicate whether the current error log}
+ {entry packet contains space in which the error}
+ {logging facility can place a long process name}
+ {("on" indicates YES, "off" indicates NO) }
+ lf_Bit_Origin_256 = 2; {used to indicate whether the current error log }
+ {entry packet contains an 8 byte originator name}
+ {or a 256 byte originator name ("on" indicates }
+ {a 256 byte originator name, "off" indicates an }
+ {8 byte originator name) }
+ lf_Bit_DateTime = 4; {used to indicate that the caller has placed time}
+ {and date values in the Error Log entry packet }
+ {and does not wish to have those values modified }
+ {during the logging process ("on" indicates that }
+ {the error log entry packet already contains time}
+ {and date values, "off" indicates the packet does}
+ {not already contain time and date values) }
+ lf_Bit_Suspend = 8;
+ lf_Bit_Resume = 16;
+ lf_Bit_Redirect = 32;
+ lf_Bit_GetStatus = 64;
+ lf_Bit_Register = 128;
+ lf_Bit_Remote_Fail = 256;
+
+type
+{ Log entry record header for OS/2 2.x and above used }
+{ by 32-bit device drivers and callers of LogAddEntries. }
+ TLogRecord = record
+ Len: word; { length of this record (including the Len field) }
+ Rec_ID: word; { record ID }
+ Status: cardinal; { record status bits (see lf_Bit_* constants) }
+ Qualifier: array [1..4] of char; { qualifier tag }
+ Reserved: cardinal;
+ Time: cardinal; { hours, minutes, seconds, hundreds }
+ Date: cardinal; { day, month, year (stored as word) }
+ case byte of
+ 0: (Data: array [1..3400] of char); { variable data (up to 3400 bytes); }
+ { beginning of this area must match }
+ { one of the following patterns }
+ 1: (Originator256: array [0..255] of char; {Originator - if the flag }
+ {lf_Bit_Origin_256 is set }
+ ProcessName_O256: array [1..260] of char; {if lf_Bit_ProcName is set}
+ FormatDLLName_O256_ProcName: array [1..12] of char; {ASCIIZ DLL name}
+ Data_O256_ProcName: array [1..3400] of char); {Variable data }
+ 2: (Originator256b: array [0..255] of char;
+ FormatDLLName_O256: array [1..12] of char;
+ Data_O256: array [1..3400] of char);
+ 3: (Originator8: array [0..7] of char; {Originator - if flag }
+ {lf_Bit_Origin_256 clear }
+ ProcessName_O8: array [1..260] of char; {if lf_Bit_ProcName is set}
+ FormatDLLName_O8_ProcName: array [1..12] of char;
+ Data_O8_ProcName: array [1..3400] of char);
+ 4: (Originator8b: array [0..7] of char;
+ FormatDLLName_O8: array [1..12] of char;
+ Data_O8: array [1..3400] of char);
+ end;
+ LogRecord = TLogRecord;
+ PLogRecord = ^TLogRecord;
+
+{ Format of buffer sent to LogAddEntries }
+ TLogEntryRec = record
+ Version: word; {this version is 1}
+ Count: word; {number of log records in this buffer}
+ LogRec: array [0..0] of TLogRecord; {repeated count times}
+ end;
+ LogEntryRec = TLogEntryRec;
+ PLogEntryRec = ^TLogEntryRec;
+
+{ Logging facility functions }
+{ Open a connection to the system error logging facility (through the system
+ logging service device driver). }
+{ Possible return codes:
+ 0 .......... success
+ non-zero ... facility not available }
+function LogOpen (var Handle: cardinal): cardinal; cdecl;
+
+{ Close the connection to the to the system error logging facility. }
+{ Possible return codes:
+ 0 .......... success
+ non-zero ... failure (possible reason - facility not open)}
+function LogClose (Handle: cardinal): cardinal; cdecl;
+
+{ Add error log entries to the internal error log buffer maintained by
+ the system logging service device driver.}
+{ Parameters:
+ Handle - handle returned by previous LogOpen
+ Service - specifies the class of logging facility:
+ 0 ........... reserved
+ 1 ........... error logging
+ 2 - $FFFF ... reserved
+ LogEntries - buffer containing a variable length error log entry. The first
+ word of the buffer contains the number of packets in the error log entry.
+ Multiple error log packets (LogRec structure) can be included within
+ a single error log entry buffer. If multiple packets are included within
+ a buffer, each individual packet should be aligned on a double word
+ boundary.
+
+ Version - packet revision number. Can be used to distinguish error logging
+ packets that are intended to be handled by different revisions
+ of the LogAddEntries API. For the initial version of the API
+ (all OS/2 versions from OS/2 v2.0 up to WSeB and eComStation),
+ this field should be set to a value of 1. This field is included
+ in the packet to support future backward compatibility.
+ Count - number of separate error log entry packets contained within
+ the user's buffer
+ Len - length of this error log entry packet (LogRec) within the user's
+ error log entry buffer in bytes (this length includes the length
+ of all the error log entry packet control fields and the size
+ of the error log entry text). To support efficient logging execution,
+ this length should be a multiple of 4 bytes (i.e. if necessary
+ the user should pad the error log entry packet).
+ Rec_ID - error log record ID for the current error log entry
+ (ID registration will be statically registered by the OS/2
+ development organization)
+ Status - status flags (two byte flag holder containing three single bit
+ flags lf_Bit_* - all the other 29 bits in status flags
+ are considered reserved at this time and will be zeroed by
+ the LogAddEntries API)
+ Qualifier - qualifier name is a secondary name field that is provided
+ by the caller
+ Reserved - four byte reserved field
+ Time - time of logging, filled in by the system error logging facility
+ (unless lf_Bit_DateTime status flag is set to "on", indicating
+ that the caller has preset a time value)
+ Date - date of logging, filled in by the system error logging facility
+ (unless lf_Bit_DateTime status flag is set to "on", indicating
+ that the caller has preset a date value)
+ Originator* - originator name (8 or 256 characters depending on Status),
+ a primary name field provided by the caller
+ ProcName* - process name (0 or 260 characters), an optional long process
+ name field that will be filled in by the error logging facility
+ if the field is provided by the caller in the error log entry
+ packet
+ FormatDLLName* - formatting DLL module name (optional); the optional name
+ of a DLL module that houses a formatting routine that
+ recognizes this type of error log entry and can format it
+ for display by the SYSLOG utility. The name is specified
+ as an ASCIIZ string that can be up to eight characters
+ in length. If no module name is specified in this field,
+ then SYSLOG will display the data portion of the error log
+ entry as a hexadecimal dump.
+ Data* - error log entry data (up to 3400 characters / bytes); an optional
+ variable length set of data that can be supplied by the caller
+ (the format of the string is under the control of the caller)
+}
+{ Possible return codes:
+ 0 - success
+ non-zero - failure (invalid log type, facility unavailable, facility
+ suspended, facility not open, error log buffer temporarily full)
+}
+function LogAddEntries (Handle: cardinal; Service: cardinal;
+ LogEntries: PLogEntryRec): cardinal; cdecl;
+
+function LogAddEntries (Handle: cardinal; Service: cardinal;
+ var LogEntries: TLogEntryRec): cardinal; cdecl;
+
+{***************************************************************************}
+implementation
+{***************************************************************************}
+
+function DosCreateThread(var TID:longint;Address:TThreadEntry;
+ aParam:pointer;Flags:longint;
+ StackSize:longint):cardinal; cdecl;
+external 'DOSCALLS' index 311;
+
+function DosCreateThread (var TID: cardinal; Address: TThreadEntry;
+ aParam: pointer; Flags: cardinal;
+ StackSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 311;
+
+function DosCreateThread(var TID:longint;Address:pointer;
+ AParam:Pointer;Flags,StackSize:longint):cardinal;cdecl;
+external 'DOSCALLS' index 311;
+
+function DosCreateThread (var TID: cardinal; Address: pointer;
+ AParam: Pointer; Flags, StackSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 311;
+
+function DosSuspendThread (TID:cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 238;
+
+function DosResumeThread (TID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 237;
+
+function DosKillThread (TID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 111;
+
+function DosWaitThread(var TID:longint;Option:longint):cardinal; cdecl;
+external 'DOSCALLS' index 349;
+
+function DosWaitThread (var TID: cardinal; Option: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 349;
+
+function DosEnterCritSec: cardinal; cdecl;
+external 'DOSCALLS' index 232;
+
+function DosExitCritSec: cardinal; cdecl;
+external 'DOSCALLS' index 233;
+
+procedure DosExit (Action, Result: cardinal); cdecl;
+external 'DOSCALLS' index 234;
+
+procedure DosGetInfoBlocks(var ATIB:PThreadInfoBlock;
+ var APIB:PProcessInfoBlock); cdecl;
+external 'DOSCALLS' index 312;
+
+procedure DosGetInfoBlocks(PATIB:PPThreadInfoBlock;
+ PAPIB:PPProcessInfoBlock); cdecl;
+external 'DOSCALLS' index 312;
+
+procedure DosSleep (MSec: cardinal); cdecl;
+external 'DOSCALLS' index 229;
+
+function DosBeep (Freq, MS: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 286;
+
+function DosDebug (DebugBuf: PDbgBuf): cardinal; cdecl;
+external 'DOSCALLS' index 317;
+
+function DosDebug (var APDbgBuf: TDbgBuf): cardinal; cdecl;
+external 'DOSCALLS' index 317;
+
+function DosExitList (OrderCode: cardinal; Proc: TExitProc): cardinal; cdecl;
+external 'DOSCALLS' index 296;
+
+function DosExecPgm (ObjName: PChar; ObjLen: longint; ExecFlag: cardinal;
+ Args, Env: PByteArray; var Res: TResultCodes;
+ FileName:PChar): cardinal; cdecl;
+external 'DOSCALLS' index 283;
+
+function DosExecPgm (var ObjName: string; Execflag: cardinal;
+ Args, Env: PByteArray; var Res: TResultCodes;
+ const FileName: string): cardinal;
+var T,T2:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosExecPgm:=DosExecPgm(@T2,SizeOf(T2),ExecFlag,Args,Env,Res,@T);;
+ ObjName:=StrPas(@T2);
+end;
+
+function DosWaitChild(Action,Option:longint;var Res:TResultCodes;
+ var TermPID:longint;PID:longint):cardinal; cdecl;
+external 'DOSCALLS' index 280;
+
+function DosWaitChild (Action, Option: cardinal; var Res: TResultCodes;
+ var TermPID: cardinal; PID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 280;
+
+function DosSetPriority (Scope, TrClass: cardinal; Delta: longint;
+ PortID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 236;
+
+function DosKillProcess (Action, PID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 235;
+
+function DosQueryAppType(FileName:PChar;var Flags:longint):cardinal; cdecl;
+external 'DOSCALLS' index 323;
+
+function DosQueryAppType (FileName: PChar; var Flags: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 323;
+
+function DosDevConfig (var DevInfo: byte; Item: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 231;
+
+function DosSetFileLocks (Handle: THandle; var Unlock, Lock: TFileLock;
+ Timeout, Flags: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 428;
+
+function DosProtectSetFileLocks (Handle: THandle; var Unlock, Lock: TFileLock;
+ Timeout, Flags: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 639;
+
+function DosCancelLockRequest (Handle: THandle; var Lock: TFileLock): cardinal;
+ cdecl;
+external 'DOSCALLS' index 429;
+
+function DosOpen(FileName:PChar;var Handle,Action:longint;
+ InitSize,Attrib,OpenFlags,FileMode:longint;
+ EA:PEAOp2):cardinal; cdecl;
+external 'DOSCALLS' index 273;
+
+function DosOpen (FileName: PChar; var Handle: THandle; var Action: cardinal;
+ InitSize, Attrib, OpenFlags, FileMode: cardinal;
+ EA: PEAOp2): cardinal; cdecl;
+external 'DOSCALLS' index 273;
+
+function DosCreate (FileName: PChar; var Handle: THandle;
+ Attrib, OpenMode: cardinal): cardinal;
+
+var Action: cardinal;
+
+begin
+ DosCreate:=DosOpen(FileName,Handle,Action,0,Attrib,18,OpenMode,nil);
+end;
+
+function DosOpen (FileName: PChar; var Handle: THandle;
+ Attrib, OpenMode: cardinal): cardinal;
+
+var Action: cardinal;
+
+begin
+ DosOpen:=DosOpen(FileName,Handle,Action,0,Attrib,1,OpenMode,nil);
+end;
+
+function DosOpen(const FileName:string;var Handle,Action:longint;
+ InitSize,Attrib,OpenFlags,OpenMode:longint;
+ EA:PEAOp2):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosOpen:=DosOpen(@T,Handle,Action,InitSize,Attrib,OpenFlags,OpenMode,EA);
+end;
+
+function DosOpen (const FileName: string; var Handle: THandle;
+ var Action: cardinal; InitSize, Attrib, OpenFlags: cardinal;
+ OpenMode: cardinal; EA: PEAOp2): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosOpen:=DosOpen(@T,Handle,Action,InitSize,Attrib,OpenFlags,OpenMode,EA);
+end;
+
+function DosCreate (const FileName: string; var Handle: THandle;
+ Attrib, OpenMode: cardinal): cardinal;
+
+var T:array[0..255] of char;
+ Action:cardinal;
+
+begin
+ StrPCopy(@T,FileName);
+ DosCreate:=DosOpen(@T,Handle,Action,0,Attrib,18,OpenMode,nil);
+end;
+
+function DosOpen (const FileName: string; var Handle: THandle;
+ Attrib, OpenMode: cardinal): cardinal;
+
+var T:array[0..255] of char;
+ Action:cardinal;
+
+begin
+ StrPCopy(@T,FileName);
+ DosOpen:=DosOpen(@T,Handle,Action,0,Attrib,1,OpenMode,nil);
+end;
+
+function DosProtectOpen (FileName: PChar; var Handle: longint;
+ var Action: longint; InitSize, Attrib,
+ OpenFlags, OpenMode: longint; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 637;
+
+function DosProtectOpen (FileName: PChar; var Handle: THandle;
+ var Action: cardinal; InitSize, Attrib,
+ OpenFlags, OpenMode: cardinal; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 637;
+
+function DosProtectOpen (const FileName: string; var Handle: longint;
+ var Action: longint; InitSize, Attrib,
+ OpenFlags, OpenMode: longint; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosProtectOpen:=DosProtectOpen(@T,Handle,Action,InitSize,Attrib,OpenFlags,OpenMode,EA,FileHandleLockID);
+end;
+
+function DosProtectOpen (const FileName: string; var Handle: THandle;
+ var Action: cardinal; InitSize, Attrib,
+ OpenFlags, OpenMode: cardinal; ea: PEAOp2;
+ var FileHandleLockID: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosProtectOpen:=DosProtectOpen(@T,Handle,Action,InitSize,Attrib,OpenFlags,OpenMode,EA,FileHandleLockID);
+end;
+
+function DosClose (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 257;
+
+function DosProtectClose (Handle: THandle;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 638;
+
+function DosRead(Handle:longint;var Buffer;Count:longint;
+ var ActCount:longint):cardinal; cdecl;
+external 'DOSCALLS' index 281;
+
+function DosRead (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 281;
+
+function DosProtectRead (Handle: longint; var Buffer; Count: longint;
+ var ActCount: longint; FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 641;
+
+function DosProtectRead (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal; FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 641;
+
+function DosWrite(Handle:longint;var Buffer;Count:longint;
+ var ActCount:longint):cardinal; cdecl;
+external 'DOSCALLS' index 282;
+
+function DosWrite (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 282;
+
+function DosProtectWrite (Handle: longint; var Buffer; Count: longint;
+ var ActCount: longint;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 642;
+
+function DosProtectWrite (Handle: THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 642;
+
+function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal;
+ var PosActual:longint):cardinal; cdecl;
+external 'DOSCALLS' index 256;
+
+function DosSetFilePtr (Handle: THandle; Pos: longint; Method: cardinal;
+ var PosActual: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 256;
+
+function DosSetFilePtr (Handle: THandle; Pos: longint): cardinal;
+
+var PosActual: cardinal;
+
+begin
+ DosSetFilePtr:=DosSetFilePtr(Handle,Pos,0,PosActual);
+end;
+
+function DosProtectSetFilePtr (Handle: longint; Pos, Method: longint;
+ var PosActual: longint;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 621;
+
+function DosProtectSetFilePtr (Handle: THandle; Pos: longint; Method: cardinal;
+ var PosActual: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 621;
+
+function DosProtectSetFilePtr (Handle: THandle; Pos: longint;
+ FileHandleLockID: cardinal): cardinal;
+
+var PosActual:cardinal;
+
+begin
+ DosProtectSetFilePtr:=DosProtectSetFilePtr(Handle,Pos,0,PosActual,
+ FileHandleLockID);
+end;
+
+function DosGetFilePtr(Handle:longint;var PosActual:longint):cardinal;
+
+begin
+ DosGetFilePtr:=DosSetFilePtr(Handle,0,1,PosActual);
+end;
+
+function DosGetFilePtr (Handle: THandle; var PosActual: cardinal): cardinal;
+
+begin
+ DosGetFilePtr:=DosSetFilePtr(Handle,0,1,PosActual);
+end;
+
+function DosProtectGetFilePtr (Handle: longint;
+ var PosActual: longint; FileHandleLockID: cardinal): cardinal;
+
+begin
+ DosProtectGetFilePtr := DosProtectSetFilePtr (Handle, 0, 1, PosActual,
+ FileHandleLockID);
+end;
+
+function DosProtectGetFilePtr (Handle: THandle;
+ var PosActual: cardinal; FileHandleLockID: cardinal): cardinal;
+
+begin
+ DosProtectGetFilePtr := DosProtectSetFilePtr (Handle, 0, 1, PosActual,
+ FileHandleLockID);
+end;
+
+function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 272;
+
+function DosProtectSetFileSize (Handle: THandle; Size: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 640;
+
+function DosResetBuffer (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 254;
+
+function DosDupHandle (Handle: THandle; var Duplicate: THandle): cardinal;
+ cdecl;
+external 'DOSCALLS' index 260;
+
+function DosQueryFHState(Handle:longint;var FileMode:longint):cardinal; cdecl;
+external 'DOSCALLS' index 276;
+
+function DosQueryFHState (Handle: THandle; var FileMode: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 276;
+
+function DosProtectQueryFHState (Handle: THandle; var FileMode: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 645;
+
+function DosSetFHState (Handle: THandle; FileMode: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 221;
+
+function DosProtectSetFHState (Handle: THandle; FileMode: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 644;
+
+function DosQueryHType(Handle:longint;var HandType:longint;
+ var Attr:longint):cardinal; cdecl;
+external 'DOSCALLS' index 224;
+
+function DosQueryHType (Handle: THandle; var HandType: cardinal;
+ var Attr: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 224;
+
+function DosEditName (MetaLevel: cardinal; Source, Edit: PChar;
+ Target: PChar; TargetLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 261;
+
+function DosEditName (MetaLevel: cardinal; const Source, Edit: string;
+ var Target: string): cardinal;
+
+var T,T2,T3:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Source);
+ StrPCopy(@T2,Edit);
+ DosEditName:=DosEditName(MetaLevel,@T,@T2,@T3,SizeOf(T3));
+ Target:=StrPas(@T3);
+end;
+
+function DosMove(OldFile,NewFile:PChar):cardinal; cdecl;
+external 'DOSCALLS' index 271;
+
+function DosMove(const OldFile,NewFile:string):cardinal;
+
+var T,T2:array[0..255] of char;
+
+begin
+ StrPCopy(@T,OldFile);
+ StrPCopy(@T2,NewFile);
+ DosMove:=DosMove(@T,@T2);
+end;
+
+function DosCopy (OldFile, NewFile: PChar; Option: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 258;
+
+function DosCopy (const OldFile, NewFile: string; Option: cardinal): cardinal;
+
+var T,T2:array[0..255] of char;
+
+begin
+ StrPCopy(@T,OldFile);
+ StrPCopy(@T2,NewFile);
+ DosCopy:=DosCopy(@T,@T2,Option);
+end;
+
+function DosDelete(FileName:PChar):cardinal; cdecl;
+external 'DOSCALLS' index 259;
+
+function DosDelete(const FileName:string):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosDelete:=DosDelete(@T);
+end;
+
+function DosForceDelete(FileName:PChar):cardinal; cdecl;
+external 'DOSCALLS' index 110;
+
+function DosForceDelete(const FileName:string):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosForceDelete:=DosForceDelete(@T);
+end;
+
+function DosCreateDir(Name:PChar;EA:PEAOp2):cardinal; cdecl;
+external 'DOSCALLS' index 270;
+
+function DosCreateDir(Name:PChar):cardinal;
+
+begin
+ DosCreateDir:=DosCreateDir(Name,nil);
+end;
+
+function DosCreateDir(const Name:string;EA:PEAOp2):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosCreateDir:=DosCreateDir(@T,EA);
+end;
+
+function DosCreateDir(const Name:string):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosCreateDir:=DosCreateDir(@T,nil);
+end;
+
+function DosDeleteDir(Name:PChar):cardinal; cdecl;
+external 'DOSCALLS' index 226;
+
+function DosDeleteDir(const Name:string):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosDeleteDir:=DosDeleteDir(@T);
+end;
+
+function DosSetDefaultDisk(DiskNum:cardinal):cardinal; cdecl;
+external 'DOSCALLS' index 220;
+
+procedure DosQueryCurrentDisk(var DiskNum:longint;var Logical:longint); cdecl;
+external 'DOSCALLS' index 275;
+
+procedure DosQueryCurrentDisk (var DiskNum: cardinal; var Logical: cardinal);
+ cdecl;
+external 'DOSCALLS' index 275;
+
+function DosSetCurrentDir(Name:PChar):cardinal; cdecl;
+external 'DOSCALLS' index 255;
+
+function DosSetCurrentDir(const Name:string):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosSetCurrentDir:=DosSetCurrentDir(@T);
+end;
+
+function DosQueryCurrentDir(DiskNum:longint;var Buffer;
+ var BufLen:longint):cardinal; cdecl;
+external 'DOSCALLS' index 274;
+
+function DosQueryCurrentDir (DiskNum: cardinal; var Buffer;
+ var BufLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 274;
+
+function DosQueryCurrentDir (DiskNum: cardinal; var Buffer: string): cardinal;
+
+var T:array[0..255] of char;
+ L: cardinal;
+
+begin
+ L:=255;
+ DosQueryCurrentDir:=DosQueryCurrentDir(DiskNum,T,L);
+ Buffer:=StrPas(@T);
+end;
+
+function DosDevIOCtl(Handle,Category,Func:longint;var Params;
+ ParamLen:longint;var ParamSize:longint;
+ var Data;DataLen:longint;var DataSize:longint):cardinal; cdecl;
+external 'DOSCALLS' index 284;
+
+function DosDevIOCtl (Handle: THandle; Category, Func: cardinal; var Params;
+ ParamLen: cardinal; var ParamSize: cardinal;
+ var Data; DataLen: cardinal; var DataSize: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 284;
+
+function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 264;
+
+function DosFindFirst (const FileMask: string; var Handle: THandle;
+ Attrib: cardinal; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal; var Count: cardinal;
+ InfoLevel: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileMask);
+ DosFindFirst:=DosFindFirst(@T,Handle,Attrib,AFileStatus,FileStatusLen,
+ Count,InfoLevel);
+end;
+
+function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal; var Count: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 265;
+
+function DosFindClose (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 263;
+
+function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus;
+ FileStatusLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 279;
+
+function DosProtectQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus;
+ FileStatusLen: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 646;
+
+function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus;
+ FileStatusLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 218;
+
+function DosProtectSetFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus;
+ FileStatusLen: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 643;
+
+function DosQueryPathInfo (FileName: PChar; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 223;
+
+function DosQueryPathInfo (const FileName: string; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosQueryPathInfo:=DosQueryPathInfo(@T,InfoLevel,AFileStatus,
+ FileStatusLen);
+end;
+
+function DosSetPathInfo (FileName: PChar; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen,
+ Options: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 219;
+
+function DosEnumAttribute(RefType:longint;AFile:pointer;
+ Entry:longint;var Buf;BufSize:longint;
+ var Count:longint;InfoLevel:longint):cardinal; cdecl;
+external 'DOSCALLS' index 372;
+
+function DosEnumAttribute (RefType: cardinal; AFile: pointer;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 372;
+
+function DosEnumAttribute (RefType: cardinal; AFile: PChar;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 372;
+
+function DosEnumAttribute (RefType: cardinal; const AFile: THandle;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 372;
+
+function DosProtectEnumAttribute (RefType: cardinal; AFile: pointer;
+ Entry: cardinal; var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal;
+ FileHandleLockID: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 636;
+
+function DosEnumAttribute (Handle: longint; Entry: longint; var Buf;
+ BufSize: longint;
+ var Count: longint; InfoLevel: longint): cardinal;
+
+begin
+ DosEnumAttribute:=DosEnumAttribute(0,@Handle,Entry,Buf,BufSize,Count,
+ InfoLevel);
+end;
+
+function DosEnumAttribute (Handle: THandle; Entry: cardinal; var Buf;
+ BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+
+begin
+ DosEnumAttribute:=DosEnumAttribute(0,@Handle,Entry,Buf,BufSize,Count,
+ InfoLevel);
+end;
+
+function DosProtectEnumAttribute (Handle: THandle; Entry: cardinal; var Buf;
+ BufSize: cardinal; var Count: cardinal;
+ InfoLevel: cardinal;
+ FileHandleLockID: cardinal): cardinal;
+
+begin
+ DosProtectEnumAttribute := DosProtectEnumAttribute (0, @Handle, Entry, Buf,
+ BufSize, Count, InfoLevel, FileHandleLockID);
+end;
+
+function DosEnumAttribute (const FileName: string;
+ Entry: cardinal;var Buf;BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosEnumAttribute:=DosEnumAttribute(1,@T,Entry,Buf,BufSize,Count,
+ InfoLevel);
+end;
+
+function DosProtectEnumAttribute (const FileName: string; Entry: cardinal;
+ var Buf; BufSize: cardinal;
+ var Count: cardinal; InfoLevel: cardinal;
+ FileHandleLockID: cardinal): cardinal;
+
+var T: array [0..255] of char;
+
+begin
+ StrPCopy (@T, FileName);
+ DosProtectEnumAttribute := DosProtectEnumAttribute (1, @T, Entry, Buf,
+ BufSize, Count, InfoLevel, FileHandleLockID);
+end;
+
+function DosScanEnv(Name:PChar;var Value:PChar):cardinal; cdecl;
+external 'DOSCALLS' index 227;
+
+function DosScanEnv(const Name:string;var Value:string):cardinal;
+
+var T:array[0..255] of char;
+ P:PChar;
+
+begin
+ StrPCopy(@T,Name);
+ DosScanEnv:=DosScanEnv(@T,P);
+ Value:=StrPas(P);
+end;
+
+function DosSearchPath (Flag: cardinal; DirList, FileName: PChar;
+ FullName: PChar; FullLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 228;
+
+function DosSearchPath (Flag: cardinal; const DirList, FileName: string;
+ var FullName: string): cardinal;
+
+var T1,T2,T3:array[0..255] of char;
+
+begin
+ StrPCopy(@T1,DirList);
+ StrPCopy(@T2,FileName);
+ DosSearchPath:=DosSearchPath(Flag,@T1,@T2,@T3,SizeOf(T3));
+ FullName:=StrPas(@T3);
+end;
+
+function DosFSAttach (DevName, FileSystem: PChar; var Data: TAttachData;
+ DataLen, Flag: cardinal):cardinal; cdecl;
+external 'DOSCALLS' index 269;
+
+function DosFSAttach (const DevName, FileSystem: string; var Data: TAttachData;
+ DataLen, Flag: cardinal): cardinal;
+
+var T1,T2:array[0..255] of char;
+
+begin
+ StrPCopy(@T1,DevName);
+ StrPCopy(@T2,FileSystem);
+ DosFSAttach:=DosFSAttach(@T1,@T2,Data,DataLen,Flag);
+end;
+
+function DosQueryFSAttach(DevName:PChar;Ordinal,InfoLevel:longint;
+ var Buffer:TFSQBuffer2;var BufLen:longint):cardinal; cdecl;
+external 'DOSCALLS' index 277;
+
+function DosQueryFSAttach (DevName: PChar; Ordinal, InfoLevel: cardinal;
+ var Buffer: TFSQBuffer2; var BufLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 277;
+
+function DosQueryFSAttach(const DevName:string;Ordinal,InfoLevel:longint;
+ var Buffer:TFSQBuffer2;var BufLen:longint):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,DevName);
+ DosQueryFSAttach:=DosQueryFSAttach(@T,Ordinal,InfoLevel,Buffer,BufLen);
+end;
+
+function DosQueryFSAttach (const DevName: string; Ordinal, InfoLevel: cardinal;
+ var Buffer: TFSQBuffer2; var BufLen: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,DevName);
+ DosQueryFSAttach:=DosQueryFSAttach(@T,Ordinal,InfoLevel,Buffer,BufLen);
+end;
+
+function DosFSCtl(Data:pointer;DataLen:longint;var ResDataLen:longint;
+ Parms:pointer;ParmsLen:longint;var ResParmsLen:longint;
+ _Function:longint;Route:PChar;
+ Handle,Method:longint):cardinal; cdecl;
+external 'DOSCALLS' index 285;
+
+function DosFSCtl (Data: pointer; DataLen: cardinal; var ResDataLen: cardinal;
+ Parms: pointer; ParmsLen: cardinal;
+ var ResParmsLen: cardinal; _Function: cardinal;
+ Route: PChar; Handle: THandle; Method: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 285;
+
+function DosFSCtl(Data:pointer;DataLen:longint;var ResDataLen:longint;
+ Parms:pointer;ParmsLen:longint;var ResParmsLen:longint;
+ _Function:longint;const Route:string;
+ Handle,Method:longint):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Route);
+ DosFSCtl:=DosFSCtl(Data,Datalen,ResDataLen,Parms,ParmsLen,ResParmsLen,
+ _Function,Route,Handle,Method);
+end;
+
+function DosFSCtl (Data: pointer; DataLen: cardinal; var ResDataLen: cardinal;
+ Parms: pointer; ParmsLen: cardinal;
+ var ResParmsLen: cardinal; _Function: cardinal;
+ const Route: string; Handle: THandle; Method: cardinal):
+ cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Route);
+ DosFSCtl:=DosFSCtl(Data,Datalen,ResDataLen,Parms,ParmsLen,ResParmsLen,
+ _Function,Route,Handle,Method);
+end;
+
+function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
+ BufLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 278;
+
+function DosSetFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
+ BufLen: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 222;
+
+function DosQueryVerify(var Enabled:longint):cardinal; cdecl;
+external 'DOSCALLS' index 225;
+
+function DosQueryVerify (var Enabled: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 225;
+
+function DosQueryVerify (var Enabled: boolean): cardinal; cdecl;
+external 'DOSCALLS' index 225;
+
+function DosSetVerify (Enable: boolean): cardinal; cdecl;
+external 'DOSCALLS' index 210;
+
+function DosSetVerify (Enable: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 210;
+
+function DosSetMaxFH (Count: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 209;
+
+function DosSetRelMaxFH(var ReqCount,CurMaxFH:longint):cardinal; cdecl;
+external 'DOSCALLS' index 382;
+
+function DosSetRelMaxFH (var ReqCount: longint; var CurMaxFH: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 382;
+
+function DosShutDown (Flags: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 415;
+
+function DosQuerySysInfo (First, Last: cardinal; var Buf; BufSize: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 348;
+
+function DosQuerySysInfo(First,Last:cardinal;Buf:PQSVValues;
+ BufSize:cardinal):cardinal;cdecl;
+external 'DOSCALLS' index 348;
+
+function DosPhysicalDisk (Func: cardinal; Buf: pointer; BufSize: cardinal;
+ Params: pointer; ParamSize: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 287;
+
+function DosAllocMem (var P: pointer; Size, Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 299;
+
+function DosFreeMem (P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 304;
+
+function DosSetMem (P: pointer; Size, Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 305;
+
+function DosGiveSharedMem (P: pointer; PID, Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 303;
+
+function DosGetSharedMem (P: pointer; Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 302;
+
+function DosGetNamedSharedMem (var P: pointer; Name: PChar; Flag: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 301;
+
+function DosGetNamedSharedMem (var P: pointer; const Name: string;
+ Flag: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosGetNamedSharedMem:=DosGetNamedSharedMem(P,@T,Flag);
+end;
+
+function DosAllocSharedMem (var P: pointer; Name: PChar;
+ Size, Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 300;
+
+function DosAllocSharedMem (var P: pointer; const Name: string;
+ Size, Flag: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ if Name<>'' then
+ begin
+ StrPCopy(@T,Name);
+ DosAllocSharedMem:=DosAllocSharedMem(P,@T,Size,Flag);
+ end
+ else
+ DosAllocSharedMem:=DosAllocSharedMem(P,nil,Size,Flag);
+end;
+
+function DosQueryMem(P:pointer;var Size,Flag:longint):cardinal; cdecl;
+external 'DOSCALLS' index 306;
+
+function DosQueryMem (P: pointer; var Size, Flag: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 306;
+
+function DosSubAllocMem (Base: pointer; var P: pointer; Size: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 345;
+
+function DosSubFreeMem (Base, P: pointer; Size: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 346;
+
+function DosSubSetMem (Base: pointer; Flag, Size: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 344;
+
+function DosSubUnSetMem (Base: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 347;
+
+function DosCreateEventSem (Name: PChar; var Handle: THandle;
+ Attr, State: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 324;
+
+function DosCreateEventSem (Name: PChar; var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal; cdecl;
+external 'DOSCALLS' index 324;
+
+function DosCreateEventSem (const Name: string; var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ if Name<>'' then
+ begin
+ StrPCopy(@T,Name);
+ DosCreateEventSem:=DosCreateEventSem(@T,Handle,Attr,State);
+ end
+ else
+ DosCreateEventSem:=DosCreateEventSem(nil,Handle,Attr,State);
+end;
+
+function DosCreateEventSem (const Name: string; var Handle: THandle;
+ Attr, State: cardinal): cardinal;
+
+begin
+ DosCreateEventSem:=DosCreateEventSem(Name,Handle,Attr,boolean(State));
+end;
+
+function DosOpenEventSem (Name: PChar; var Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 325;
+
+function DosOpenEventSem (const Name: string; var Handle: THandle): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosOpenEventSem:=DosOpenEventSem(@T,Handle);
+end;
+
+function DosCloseEventSem (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 326;
+
+function DosResetEventSem(Handle:longint;var PostCount:longint):cardinal; cdecl;
+external 'DOSCALLS' index 327;
+
+function DosResetEventSem (Handle: THandle; var PostCount: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 327;
+
+function DosPostEventSem (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 328;
+
+function DosWaitEventSem (Handle: THandle; Timeout: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 329;
+
+function DosQueryEventSem(Handle:longint;var Posted:longint):cardinal; cdecl;
+external 'DOSCALLS' index 330;
+
+function DosQueryEventSem (Handle: THandle; var Posted: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 330;
+
+function DosCreateMutExSem (Name: PChar; var Handle: THandle;
+ Attr: cardinal; State:boolean): cardinal; cdecl;
+external 'DOSCALLS' index 331;
+
+function DosCreateMutExSem (Name: PChar; var Handle: THandle;
+ Attr, State: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 331;
+
+function DosCreateMutExSem (const Name: string; var Handle: THandle;
+ Attr: cardinal; State: boolean): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ if Name<>'' then
+ begin
+ StrPCopy(@T,Name);
+ DosCreateMutExSem:=DosCreateMutExSem(@T,Handle,Attr,State);
+ end
+ else
+ DosCreateMutExSem:=DosCreateMutExSem(nil,Handle,Attr,State);
+end;
+
+function DosCreateMutExSem (const Name: string; var Handle: THandle;
+ Attr, State: cardinal): cardinal;
+
+begin
+ DosCreateMutExSem:=DosCreateMutExSem(Name,Handle,Attr,boolean(State));
+end;
+
+function DosOpenMutExSem (Name: PChar; var Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 332;
+
+function DosOpenMutExSem (const Name: string; var Handle: THandle): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosOpenMutExSem:=DosOpenMutExSem(@T,Handle);
+end;
+
+function DosCloseMutExSem (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 333;
+
+function DosRequestMutExSem (Handle: THandle; Timeout: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 334;
+
+function DosReleaseMutExSem (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 335;
+
+function DosQueryMutExSem(Handle:longint;var PID,TID,Count:longint):cardinal;
+ cdecl;
+external 'DOSCALLS' index 336;
+
+function DosQueryMutExSem (Handle: THandle; var PID, TID, Count: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 336;
+
+function DosCreateMuxWaitSem (Name: PChar; var Handle: THandle;
+ CSemRec: cardinal; var SemArray: TSemArray;
+ Attr: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 337;
+
+function DosCreateMuxWaitSem (const Name: string; var Handle: THandle;
+ CSemRec: cardinal; var SemArray: TSemArray;
+ Attr: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ if Name<>'' then
+ begin
+ StrPCopy(@T,Name);
+ DosCreateMuxWaitSem:=DosCreateMuxWaitSem(@T,Handle,CSemRec,
+ SemArray,Attr);
+ end
+ else
+ DosCreateMuxWaitSem:=DosCreateMuxWaitSem(nil,Handle,CSemRec,SemArray,
+ Attr);
+end;
+
+function DosOpenMuxWaitSem (Name: PChar; var Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 338;
+
+function DosOpenMuxWaitSem (const Name: string; var Handle: THandle): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosOpenMuxWaitSem:=DosOpenMuxWaitSem(@T,Handle);
+end;
+
+function DosCloseMuxWaitSem (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 339;
+
+function DosWaitMuxWaitSem(Handle,Timeout:longint;var User:longint):cardinal;
+ cdecl;
+external 'DOSCALLS' index 340;
+
+function DosWaitMuxWaitSem (Handle: THandle; Timeout: cardinal;
+ var User: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 340;
+
+function DosAddMuxWaitSem (Handle: THandle; var SemRec: TSemRecord): cardinal;
+ cdecl;
+external 'DOSCALLS' index 341;
+
+function DosDeleteMuxWaitSem (Handle, Sem: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 342;
+
+function DosQueryMuxWaitSem(Handle:longint;var CSemRec:longint;
+ var SemRecs:TSemArray;var Attr:longint):cardinal; cdecl;
+external 'DOSCALLS' index 343;
+
+function DosQueryMuxWaitSem (Handle: THandle; var CSemRec: cardinal;
+ var SemRecs: TSemArray; var Attr: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 343;
+
+function DosGetDateTime (var Buf: TDateTime): cardinal; cdecl;
+external 'DOSCALLS' index 230;
+
+function DosSetDateTime (var Buf: TDateTime): cardinal; cdecl;
+external 'DOSCALLS' index 292;
+
+function DosAsyncTimer (MSec: cardinal; HSem: THandle;
+ var TimHandle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 350;
+
+function DosStartTimer (MSec: cardinal; HSem: THandle;
+ var TimHandle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 351;
+
+function DosStopTimer (TimHandle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 290;
+
+function DosTmrQueryFreq(var Freq:longint):cardinal; cdecl;
+external 'DOSCALLS' index 362;
+
+function DosTmrQueryFreq (var Freq: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 362;
+
+function DosTmrQueryTime (var Time: comp): cardinal; cdecl;
+external 'DOSCALLS' index 363;
+
+function DosTmrQueryTime (var Time: qword): cardinal; cdecl;
+external 'DOSCALLS' index 363;
+
+function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
+ var Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 318;
+
+function DosLoadModule (var ObjName: string; ObjLen: cardinal;
+ const DLLName: string; var Handle: THandle): cardinal;
+
+var T1,T2:array[0..255] of char;
+
+begin
+ StrPCopy(@T2,DLLName);
+ DosLoadModule:=DosLoadModule(@T1,ObjLen,@T2,Handle);
+ ObjName:=StrPas(@T1);
+end;
+
+function DosFreeModule (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 322;
+
+function DosQueryProcAddr (Handle: THandle; Ordinal: cardinal; ProcName: PChar;
+ var Address: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 321;
+
+function DosQueryProcAddr (Handle: THandle; Ordinal: cardinal;
+ const ProcName: string; var Address: pointer): cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ if ProcName<>'' then
+ begin
+ StrPCopy(@T1,ProcName);
+ DosQueryProcAddr:=DosQueryProcAddr(Handle,Ordinal,@T1,Address);
+ end
+ else
+ DosQueryProcAddr:=DosQueryProcAddr(Handle,Ordinal,nil,Address);
+end;
+
+function DosQueryModuleHandle (DLLName: PChar; var Handle: THandle): cardinal;
+ cdecl;
+external 'DOSCALLS' index 319;
+
+function DosQueryModuleHandle (const DLLName: string; var Handle: THandle):
+ cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ StrPCopy(@T1,DLLName);
+ DosQueryModuleHandle:=DosQueryModuleHandle(@T1,Handle);
+end;
+
+function DosQueryModuleName (Handle: THandle; NameLen: cardinal; Name: PChar):
+ cardinal; cdecl;
+external 'DOSCALLS' index 320;
+
+{function DosQueryModuleName(Handle:longint;var Name:openstring):cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ DosQueryModuleName:=DosQueryModuleName(Handle,High(Name),@T1);
+ Name:=StrPas(@T1);
+end;}
+
+function DosQueryProcType(Handle,Ordinal:longint;Name:PChar;
+ var ProcType:longint):cardinal; cdecl;
+external 'DOSCALLS' index 586;
+
+function DosQueryProcType (Handle: THandle; Ordinal: cardinal; Name: PChar;
+ var ProcType: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 586;
+
+function DosQueryProcType(Handle,Ordinal:longint;const Name:string;
+ var ProcType:longint):cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ if Name<>'' then
+ begin
+ StrPCopy(@T1,Name);
+ DosQueryProcType:=DosQueryProcType(Handle,Ordinal,@T1,ProcType);
+ end
+ else
+ DosQueryProcType:=DosQueryProcType(Handle,Ordinal,nil,ProcType);
+end;
+
+function DosQueryProcType (Handle: THandle; Ordinal: cardinal;
+ const Name: string; var ProcType: cardinal): cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ if Name<>'' then
+ begin
+ StrPCopy(@T1,Name);
+ DosQueryProcType:=DosQueryProcType(Handle,Ordinal,@T1,ProcType);
+ end
+ else
+ DosQueryProcType:=DosQueryProcType(Handle,Ordinal,nil,ProcType);
+end;
+
+function DosGetResource (Handle: THandle; ResType, ResName: cardinal;
+ var P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 352;
+
+function DosFreeResource (P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 353;
+
+function DosQueryResourceSize(Handle,IDT,IDN:longint;var Size:longint):cardinal;
+ cdecl;
+external 'DOSCALLS' index 572;
+
+function DosQueryResourceSize (Handle: THandle; IDT, IDN: cardinal;
+ var Size: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 572;
+
+function DosQueryCtryInfo(Size:longint;var Country:TCountryCode;
+ var Res:TCountryInfo;var ActualSize:longint):cardinal; cdecl;
+external 'NLS' index 5;
+
+function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
+ var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
+external 'NLS' index 5;
+
+function DosQueryDBCSEnv (Size: cardinal; var Country: TCountryCode;
+ Buf: PChar): cardinal; cdecl;
+external 'NLS' index 6;
+
+function DosMapCase (Size: cardinal; var Country: TCountryCode;
+ AString: PChar): cardinal; cdecl;
+external 'NLS' index 7;
+
+function DosMapCase (var Country: TCountryCode; var AString: string): cardinal;
+
+var T1:string;
+
+begin
+ StrPCopy(@T1,AString);
+ DosMapCase:=DosMapCase(length(AString),Country,@T1);
+ AString:=StrPas(@T1);
+end;
+
+function DosQueryCollate(Size:longint;var Country:TCountryCode;
+ buf:PByteArray;var TableLen:longint):cardinal; cdecl;
+external 'NLS' index 8;
+
+function DosQueryCollate (Size: cardinal; var Country: TCountryCode;
+ Buf: PByteArray; var TableLen: cardinal): cardinal; cdecl;
+external 'NLS' index 8;
+
+function DosQueryCP(Size:longint;CodePages:PWordArray;
+ var ActSize:longint):cardinal; cdecl;
+external 'DOSCALLS' index 291;
+
+function DosQueryCP (Size: cardinal; CodePages: PWordArray;
+ var ActSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 291;
+
+function DosSetProcessCP (CP: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 289;
+
+function DosSetExceptionHandler (var RegRec: TExceptionRegistrationRecord):
+ cardinal; cdecl;
+external 'DOSCALLS' index 354;
+
+function DosUnsetExceptionHandler (var RegRec: TExceptionRegistrationRecord):
+ cardinal; cdecl;
+external 'DOSCALLS' index 355;
+
+function DosRaiseException (var Excpt: TExceptionReportRecord): cardinal;
+ cdecl;
+external 'DOSCALLS' index 356;
+
+function DosSendSignalException (PID, Exception: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 379;
+
+function DosUnwindException (var Handler: TExceptionRegistrationRecord;
+ TargetIP: pointer;
+ var RepRec: TExceptionReportRecord): cardinal; cdecl;
+external 'DOSCALLS' index 357;
+
+function DosSetSignalExceptionFocus(Enable:longint;var Times:longint):cardinal;
+ cdecl;
+external 'DOSCALLS' index 378;
+
+function DosSetSignalExceptionFocus (Enable: cardinal;
+ var Times: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 378;
+
+function DosSetSignalExceptionFocus (Enable: boolean;
+ var Times: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 378;
+
+function DosEnterMustComplete(var Nesting:longint):cardinal; cdecl;
+external 'DOSCALLS' index 380;
+
+function DosEnterMustComplete (var Nesting: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 380;
+
+function DosExitMustComplete(var Nesting:longint):cardinal; cdecl;
+external 'DOSCALLS' index 381;
+
+function DosExitMustComplete (var Nesting: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 381;
+
+function DosAcknowledgeSignalException (SignalNum: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 418;
+
+function DosCloseQueue (Handle: THandle): cardinal; cdecl;
+external 'QUECALLS' index 11;
+
+function DosCreateQueue (var Handle: THandle; Priority: cardinal;
+ Name: PChar): cardinal; cdecl;
+external 'QUECALLS' index 16;
+
+function DosCreateQueue (var Handle: THandle; Priority: cardinal;
+ const Name: string): cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ StrPCopy(@T1,Name);
+ DosCreateQueue:=DosCreateQueue(Handle,Priority,@T1);
+end;
+
+function DosOpenQueue(var Parent_PID:longint;var Handle:longint;
+ Name:PChar):cardinal; cdecl;
+external 'QUECALLS' index 15;
+
+function DosOpenQueue (var Parent_PID: cardinal; var Handle: THandle;
+ Name: PChar): cardinal; cdecl;
+external 'QUECALLS' index 15;
+
+function DosOpenQueue(var Parent_PID:longint;var Handle:longint;
+ const Name:string):cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ StrPCopy(@T1,Name);
+ DosOpenQueue:=DosOpenQueue(Parent_PID,Handle,@T1);
+end;
+
+function DosOpenQueue (var Parent_PID: cardinal; var Handle: THandle;
+ const Name: string): cardinal;
+
+var T1:array[0..255] of char;
+
+begin
+ StrPCopy(@T1,Name);
+ DosOpenQueue:=DosOpenQueue(Parent_PID,Handle,@T1);
+end;
+
+function DosPeekQueue(Handle:longint;var ReqBuffer:TRequestData;
+ var DataLen:longint;var DataPtr:pointer;
+ var Element:longint;Wait:longint;
+ var Priority:byte;ASem:longint):cardinal; cdecl;
+external 'QUECALLS' index 13;
+
+function DosPeekQueue (Handle: THandle; var ReqBuffer:TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ var Element: cardinal; Wait: cardinal;
+ var Priority: byte; ASem: THandle): cardinal; cdecl;
+external 'QUECALLS' index 13;
+
+function DosPeekQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ var Element: cardinal; Wait: boolean;
+ var Priority: byte; ASem: THandle): cardinal; cdecl;
+external 'QUECALLS' index 13;
+
+function DosPurgeQueue (Handle: THandle): cardinal; cdecl;
+external 'QUECALLS' index 10;
+
+function DosQueryQueue(Handle:longint;var Count:longint):cardinal; cdecl;
+external 'QUECALLS' index 12;
+
+function DosQueryQueue (Handle: THandle; var Count: cardinal): cardinal; cdecl;
+external 'QUECALLS' index 12;
+
+function DosReadQueue(Handle:longint;var ReqBuffer:TRequestData;
+ var DataLen:longint;var DataPtr:pointer;
+ Element,Wait:longint;var Priority:byte;
+ ASem:longint):cardinal; cdecl;
+external 'QUECALLS' index 9;
+
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ Element, Wait: cardinal; var Priority: byte;
+ ASem: THandle): cardinal; cdecl;
+external 'QUECALLS' index 9;
+
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ Element: cardinal; Wait: boolean; var Priority: byte;
+ ASem: THandle): cardinal; cdecl;
+external 'QUECALLS' index 9;
+
+function DosWriteQueue (Handle: THandle; Request, DataLen: cardinal;
+ var DataBuf; Priority: cardinal): cardinal; cdecl;
+external 'QUECALLS' index 14;
+
+function DosError (Error: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 212;
+
+procedure DosErrClass(Code:longint;var _Class,Action,Locus:longint); cdecl;
+external 'DOSCALLS' index 211;
+
+procedure DosErrClass (Code: cardinal; var _Class, Action, Locus: cardinal);
+ cdecl;
+external 'DOSCALLS' index 211;
+
+function DosTrueGetMessage (MsgSeg: pointer; Table: PInsertTable;
+ TableSize: cardinal; Buf: PChar;
+ BufSize, MsgNumber: cardinal; FileName: PChar;
+ var MsgSize: cardinal): cardinal; cdecl;
+external 'MSG' index 6;
+
+function DosTrueGetMessage (MsgSeg: pointer; Table: PInsertTable;
+ TableSize: longint; Buf: PChar;
+ BufSize, MsgNumber: longint; FileName: PChar;
+ var MsgSize: longint): cardinal; cdecl;
+external 'MSG' index 6;
+
+function DosIQueryMessageCP (var Buf; BufSize: cardinal; FileName: PChar;
+ var InfoSize: cardinal; MesSeg: pointer): cardinal; cdecl;
+external 'MSG' index 8;
+
+function DosIQueryMessageCP (var Buf; BufSize: longint; FileName: PChar;
+ var InfoSize: longint; MesSeg: pointer): cardinal; cdecl;
+external 'MSG' index 8;
+
+procedure MagicHeaderEnd; assembler; forward;
+
+{$ASMMODE INTEL}
+
+{start of _MSGSEG32 segment}
+procedure MagicHeaderStart; assembler;
+asm
+ db $0FF
+ db $4D,$53,$47,$53,$45,$47,$33,$32, 0 //'MSGSEG32'
+ dd $8001
+ dd MAGICHEADEREND
+end;
+
+function DosGetMessage (Table: PInsertTable; TableSize: cardinal; Buf: PChar;
+ BufSize, MsgNumber: cardinal; FileName: PChar;
+ var MsgSize: cardinal): cardinal;
+begin
+ DosGetMessage := DosTrueGetMessage(@MagicHeaderStart,Table,TableSize,
+ Buf,BufSize,MsgNumber,FileName,MsgSize);
+end;
+
+function DosGetMessage (Table: PInsertTable; TableSize:longint;Buf:PChar;
+ BufSize,MsgNumber:longint;FileName:PChar;
+ var MsgSize:longint):cardinal;
+begin
+ DosGetMessage := DosTrueGetMessage(@MagicHeaderStart,Table,TableSize,
+ Buf,BufSize,MsgNumber,FileName,MsgSize);
+end;
+
+function DosQueryMessageCP (var Buf; BufSize: cardinal; FileName: PChar;
+ var InfoSize: cardinal): cardinal;
+begin
+ DosQueryMessageCP := DosIQueryMessageCP(Buf, BufSize, FileName, InfoSize,
+ @MagicHeaderStart);
+end;
+
+function DosQueryMessageCP(var Buf;BufSize:longint;FileName:PChar;
+ var InfoSize:longint):cardinal;
+begin
+ DosQueryMessageCP := DosIQueryMessageCP(Buf, BufSize, FileName, InfoSize,
+ @MagicHeaderStart);
+end;
+
+procedure MagicHeaderEnd; assembler;
+asm
+ dd $0FFFF0000
+end;
+{$ASMMODE DEFAULT}
+
+(*function DosGetMessage(const Table:array of PString;var Buf:openstring;
+ MsgNumber:longint;const FileName:string):cardinal;
+
+{Hmm. This takes too much stackspace. Let's use the
+ heap instead.}
+
+type TTableBuffer=record
+ IT:TinsertTable;
+ Strings:TByteArray;
+ end;
+ PTableBuffer=^TTableBuffer;
+
+var Buffer:PTableBuffer;
+ I,S:word;
+ BufPtr:pointer;
+ T1,T2:array[0..255] of char;
+
+begin
+ {Check if there are more than nine items in the table.}
+ if High(Table)>8 then
+ DosGetMessage:=87
+ else
+ begin
+ {Step 1: Calculate the space we need on the heap.}
+ S:=SizeOf(TInsertTable);
+ for I:=Low(Table) to High(Table) do
+ S:=S+Length(Table[I])+1;
+
+ {Step 2: Allocate the buffer.}
+ GetMem(Buffer,S);
+
+ {Step 3: Fill the buffer.}
+ BufPtr:=@(S^.Strings);
+ for I:=Low(Table) to High(Table) do
+ begin
+ S^.IT[I+1]:=bufptr;
+ StrPCopy(BufPtr,Table[I]);
+ Inc(longint(BufPtr),Length(Table[I])+1);
+ end;
+
+ {Step 4: Convert the filename.}
+ StrPCopy(@T2,FileName);
+
+ {Step 5: Get the message.}
+ DosGetMessage:=DosGetMessage(@(S^.IT),High(Table)+1,@T1,
+ High(Buf),MsgNumber,@T2,I);
+
+ {Step 6: Convert the returned message.}
+ Buf[0]:=Char(I);
+ Move(T1,Buf[1],I);
+
+ {Step 7: Free the memory.}
+ FreeMem(Buffer,S);
+ end;
+end;*)
+
+{function DosGetMessage(const Table:array of PString;Buf:PChar;
+ BufSize,MsgNumber:longint;const FileName:string;
+ MsgSize:longint):cardinal;}
+
+function DosQueryMessageCP(var Buf;BufSize:longint;const FileName:string;
+ var InfoSize:longint):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosQueryMessageCP:=DosQueryMessageCP(Buf,BufSize,@T,InfoSize);
+end;
+
+function DosQueryMessageCP (var Buf; BufSize: cardinal; const FileName: string;
+ var InfoSize: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,FileName);
+ DosQueryMessageCP:=DosQueryMessageCP(Buf,BufSize,@T,InfoSize);
+end;
+
+function DosInsertMessage(Table:PInsertTable;TableSize:longint;
+ Message:PChar;SrcMessageSize:longint;
+ Buf:PChar;BufSize:longint;
+ var DstMessageSize:longint):cardinal; cdecl;
+external 'MSG' index 4;
+
+function DosInsertMessage (Table: PInsertTable; TableSize: cardinal;
+ Message: PChar; SrcMessageSize: cardinal;
+ Buf: PChar; BufSize: cardinal;
+ var DstMessageSize: cardinal): cardinal; cdecl;
+external 'MSG' index 4;
+
+{function DosInsertMessage(Table:array of PString;
+ const Message:string;
+ var Buf:openstring):cardinal;
+
+function DosInsertMessage(Table:array of PString;
+ Message:PChar;SrcMessageSize:longint;
+ Buf:PChar;BufSize:longint;
+ var DstMessageSize:longint):cardinal;}
+
+function DosPutMessage (Handle: THandle; Size: cardinal; Buf: PChar): cardinal;
+ cdecl;
+external 'MSG' index 5;
+
+function DosPutMessage (Handle: THandle; const Buf: string): cardinal;
+
+begin
+ DosPutMessage:=DosPutMessage(Handle,Length(Buf),@Buf[1]);
+end;
+
+function DosStartSession (var AStartData:TStartData;
+ var SesID,PID:longint):cardinal; cdecl;
+external 'SESMGR' index 37;
+
+function DosStartSession (var AStartData: TStartData;
+ var SesID, PID: cardinal): cardinal; cdecl;
+external 'SESMGR' index 37;
+
+function DosSetSession (SesID: cardinal; var AStatus: TStatusData): cardinal;
+ cdecl;
+external 'SESMGR' index 39;
+
+function DosSelectSession (SesID: cardinal): cardinal; cdecl;
+external 'SESMGR' index 38;
+
+function DosStopSession (Scope, SesID: cardinal): cardinal; cdecl;
+external 'SESMGR' index 40;
+
+function DosCreatePipe (var ReadHandle, WriteHandle: THandle;
+ Size: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 239;
+
+function DosCreateNPipe (Name: PChar; var Handle: THandle; OpenMode, PipeMode,
+ OutBufSize, InBufSize, MSec: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 243;
+
+function DosCreateNPipe (const Name: string; var Handle: THandle; OpenMode,
+ PipeMode, OutBufSize, InBufSize, MSec: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosCreateNPipe:=DosCreateNPipe(@T,Handle,OpenMode,PipeMode,OutBufSize,
+ InBufSize,MSec);
+end;
+
+function DosCallNPipe(Name:PChar;var Input;InputSize:longint;
+ var Output;OutputSize:longint;var ReadBytes:longint;
+ MSec:longint):cardinal; cdecl;
+external 'DOSCALLS' index 240;
+
+function DosCallNPipe (Name: PChar; var Input; InputSize: cardinal;
+ var Output; OutputSize: cardinal;
+ var ReadBytes: cardinal; MSec: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 240;
+
+function DosCallNPipe(const Name:string;var Input;InputSize:longint;
+ var Output;OutputSize:longint;var ReadBytes:longint;
+ MSec:longint):cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosCallNPipe:=DosCallNPipe(@T,Input,InputSize,Output,OutputSize,
+ ReadBytes,MSec);
+end;
+
+function DosCallNPipe (const Name: string; var Input; InputSize: cardinal;
+ var Output; OutputSize: cardinal;
+ var ReadBytes: cardinal; MSec: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosCallNPipe:=DosCallNPipe(@T,Input,InputSize,Output,OutputSize,
+ ReadBytes,MSec);
+end;
+
+function DosConnectNPipe (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 241;
+
+function DosDisconnectNPipe (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 242;
+
+function DosPeekNPipe(Handle:longint;var Buffer;BufSize:longint;
+ var ReadBytes:longint;var Avail:TAvailData;
+ var State:longint):cardinal; cdecl;
+external 'DOSCALLS' index 244;
+
+function DosPeekNPipe (Handle: THandle; var Buffer; BufSize: cardinal;
+ var ReadBytes: cardinal; var Avail: TAvailData;
+ var State: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 244;
+
+function DosQueryNPHState(Handle:longint;var State:longint):cardinal; cdecl;
+external 'DOSCALLS' index 245;
+
+function DosQueryNPHState (Handle: THandle; var State: cardinal): cardinal;
+ cdecl;
+external 'DOSCALLS' index 245;
+
+function DosQueryNPipeInfo (Handle: THandle; InfoLevel: cardinal; var Buffer;
+ BufSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 248;
+
+function DosQueryNPipeSemState (SemHandle: THandle; var SemArray;
+ BufSize: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 249;
+
+function DosSetNPHState (Handle: THandle; State: cardinal):cardinal; cdecl;
+external 'DOSCALLS' index 250;
+
+function DosSetNPipeSem(PipeHandle,SemHandle: THandle; Key: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 251;
+
+function DosTransactNPipe(Handle:longint;var OutBuf;OutSize:longint;
+ var InBuf;InSize:longint;
+ var ReadBytes:longint):cardinal; cdecl;
+external 'DOSCALLS' index 252;
+
+function DosTransactNPipe (Handle: THandle; var OutBuf; OutSize: cardinal;
+ var InBuf; InSize: cardinal;
+ var ReadBytes: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 252;
+
+function DosWaitNPipe (Name: PChar; MSec: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 253;
+
+function DosWaitNPipe (const Name: string; MSec: cardinal): cardinal;
+
+var T:array[0..255] of char;
+
+begin
+ StrPCopy(@T,Name);
+ DosWaitNPipe:=DosWaitNPipe(@T,MSec);
+end;
+
+function DosOpenVDD (Name: PChar; var Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 308;
+
+function DosRequestVDD (Handle: THandle; SGroup, Cmd: cardinal;
+ InSize: cardinal; var InBuffer;
+ OutSize: cardinal; var OutBuffer): cardinal; cdecl;
+external 'DOSCALLS' index 309;
+
+function DosCloseVDD (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 310;
+
+procedure DosSelToFlat; cdecl;
+external 'DOSCALLS' index 426;
+
+procedure DosFlatToSel; cdecl;
+external 'DOSCALLS' index 425;
+
+{$ASMMODE INTEL}
+function SelToFlat (AFarPtr: cardinal): pointer; assembler;
+ asm
+ push ebx
+ push esi
+ push edi
+{$IFNDEF REGCALL}
+ mov eax, AFarPtr
+{$ENDIF REGCALL}
+ call DosSelToFlat
+ pop edi
+ pop esi
+ pop ebx
+ end;
+
+function SelToFlat (AFarPtr: TFarPtr): pointer; assembler;
+ asm
+ push ebx
+ push esi
+ push edi
+ mov eax, AFarPtr
+ call DosSelToFlat
+ pop edi
+ pop esi
+ pop ebx
+ end;
+
+function FlatToSel (APtr: pointer): cardinal; assembler;
+ asm
+ push ebx
+ push esi
+ push edi
+{$IFNDEF REGCALL}
+ mov eax, APtr
+{$ENDIF REGCALL}
+ call DosFlatToSel
+ pop edi
+ pop esi
+ pop ebx
+ end;
+
+function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): cardinal;
+ cdecl;
+external 'DOSCALLS' index 454;
+
+function DosFreeThreadLocalMemory (P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 455;
+
+function DosQueryRASInfo (Index: cardinal; var PBuffer: pointer): cardinal;
+ cdecl; external 'DOSCALLS' index 112;
+
+function LogOpen (var Handle: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 430;
+
+function LogClose (Handle: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 431;
+
+function LogAddEntries (Handle: cardinal; Service: cardinal;
+ LogEntries: PLogEntryRec): cardinal; cdecl; external 'DOSCALLS' index 432;
+
+function LogAddEntries (Handle: cardinal; Service: cardinal;
+ var LogEntries: TLogEntryRec): cardinal; cdecl; external 'DOSCALLS' index 432;
+
+(* Todo:
+
+function DosRawReadNPipe ...; cdecl;
+external 'DOSCALLS' index 246;
+
+function DosRawWriteNPipe ...; cdecl;
+external 'DOSCALLS' index 247;
+
+function DosSetCP ...; cdecl;
+external 'DOSCALLS' index 288;
+
+function DosDynamicTrace ...; cdecl;
+external 'DOSCALLS' index 316;
+
+function DosRegisterPerfCtrs ...; cdecl;
+external 'DOSCALLS' index 367;
+
+function DosQueryDOSProperty ...; cdecl;
+external 'DOSCALLS' index 373;
+
+function DosSetDOSProperty ...; cdecl;
+external 'DOSCALLS' index 374;
+
+function DosProfile ...; cdecl;
+external 'DOSCALLS' index 377;
+
+function DosReplaceModule ...; cdecl;
+external 'DOSCALLS' index 417;
+
+function DosTIB ...; cdecl;
+external 'DOSCALLS' index 419;
+
+function DosOpenChangeNotify ...; cdecl;
+external 'DOSCALLS' index 440;
+
+function DosResetChangeNotify ...; cdecl;
+external 'DOSCALLS' index 441;
+
+function DosCloseChangeNotify ...; cdecl;
+external 'DOSCALLS' index 442;
+
+function DosInitializePorthole ...; cdecl;
+external 'DOSCALLS' index 580;
+
+function DosQueryHeaderInfo ...; cdecl;
+external 'DOSCALLS' index 582;
+
+WSeB/eCS APIs:
+ Creates a private Read/Write alias or an LDT code segment alias to part
+ of an existing memory object. The alias object is accessible only to the
+ process that created it. The original object must be accessible to the caller
+ of DosAliasMem.
+
+ An alias is removed by calling DosFreeMem with the alias address.
+
+ Although it is possible to create a Read/Write alias to a code segment
+ to allow code modification, this is not recommended. On Pentium processors,
+ and later, pipe-lining techniques used by the processor might allow
+ the processor not to be aware of the modified code, if appropriate
+ pipe-line serialization is not performed by the programmer. For further
+ information see the processor documentation.
+
+ Possible return values:
+ 0 No_Error
+ 8 Error_Not_Enough_Memory
+ 87 Error_Invalid_Parameter
+ 95 Error_Interrupt
+ 32798 Error_Crosses_Object_Boundary
+
+pMem = Pointer to the memory to be aliased. It must be on a page boundary
+ (i.e. aligned to 4 kB), but may specify an address within a memory
+ object.
+Size = Specifies size in bytes for the memory to alias. The entire range
+ must lie within a single memory object and must be committed
+ if OBJ_SELMAPALL is specified.
+Alias = Pointer where the address of the aliased memory is returned.
+ The corresponding LDT selector is not explicitly returned but may be
+ calculated by using the Compatibility Mapping Algorithm
+ ((Alias shr 13) or 7).
+Flags = Combination of the following values:
+ obj_SelMapAll = $800 (Create a Read/Write 32 bit alias
+ to the address specified. The entire range
+ must be committed, start on page boundary
+ and be within the extent of a single memory
+ object. An LDT selector is created to map
+ the entire range specified. If obj_SelMapAll
+ is not specified, then size is rounded up
+ to a 4K multiple and the alias created
+ inherits the permissions from the pages
+ of the original object.)
+ obj_Tile = $40 (Obj_Tile may be specified, but currently
+ this is enforced whether or not specified.
+ This forces LDT selectors to be based
+ on 64K boundaries.)
+ sel_Code = 1 (Marks the LDT alias selector(s)
+ Read-Executable code selectors.)
+ sel_Use32 = 2 (Used with obj_SelMapAll, otherwise ignored.
+ Marks the first alias LDT selector
+ as a 32 bit selector by setting the BIG/C32
+ bit.)
+functionDosAliasMem (pMem: pointer; Size: cardinal; var Alias: pointer; Flags: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 298;
+
+ DosCancelLockRequestL cancels an outstanding DosSetFileLocksL request.
+ If two threads in a process are waiting on a lock file range, and another
+ thread issues DosCancelLockRequestL for that lock file range, then both
+ waiting threads are released.
+ Not all file-system drivers (FSDs) can cancel an outstanding lock request.
+ Local Area Network (LAN) servers cannot cancel an outstanding lock request
+ if they use a version of the operating system prior to OS/2 Version 2.00.
+
+Possible return values:
+ 0 No_Error
+ 6 Error_Invalid_Handle
+ 87 Error_Invalid_Parameter
+ 173 Error_Cancel_Violation
+
+hFile = File handle used in the DosSetFileLocksL function
+ that is to be cancelled.
+pflLockL = Address of the structure describing the lock request to cancel.
+
+function DosCancelLockRequestL (hFile: THandle; pflLock: PFileLockL): cardinal; cdecl;
+external 'DOSCALLS' index ???;
+
+function DosCancelLockRequestL (hFile: THandle; const Lock: TFileLockL): cardinal; cdecl;
+external 'DOSCALLS' index ???;
+
+DosCreateThread2
+DosDumpProcess
+DosForceSystemDump
+
+functionDosGetProcessorStatus (...): cardinal; cdecl;
+external 'DOSCALLS' index 447;
+
+function DosQueryPageUsage (...): cardinal; cdecl;
+external 'DOSCALLS' index 358;
+
+
+DosSetProcessorStatus = DOSCALLS.448
+DosCreateSpinLock = DOSCALLS.449
+DosAcquireSpinLock = DOSCALLS.450
+DosReleaseSpinLock = DOSCALLS.451
+DosFreeSpinLock = DOSCALLS.452
+DosListIO
+DosListIOL
+DosOpenL
+DosPerfSystemCall
+DosProtectOpenL
+DosProtectSetFileLocksL
+DosProtectSetFilePrtL
+DosProtectSetFileSizeL
+DosQueryABIOSSuport
+
+functionDosQueryMemState (...): cardinal; cdecl;
+external 'DOSCALLS' index 307;
+
+___ functionDos16QueryModFromCS (...): ...
+external 'DOSCALLS' index 359;
+
+DosQueryModFromEIP
+
+functionDosQuerySysState (): cardinal; cdecl;
+external 'DOSCALLS' index 368;
+
+DosQueryThreadAffinity
+DosSetFileLocksL
+DosSetFilePtrL
+DosSetFileSizeL
+DosSetThreadAffinity
+Dos16SysTrace
+DosVerifyPidTid
+*)
+
+
+end.
+{
+ $Log: doscalls.pas,v $
+ Revision 1.30 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/dynlibs.inc b/rtl/os2/dynlibs.inc
new file mode 100644
index 0000000000..cd64c430b7
--- /dev/null
+++ b/rtl/os2/dynlibs.inc
@@ -0,0 +1,68 @@
+{
+ $Id: dynlibs.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Implements OS dependent part for loading of dynamic libraries.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$ifdef readinterface}
+
+{ ---------------------------------------------------------------------
+ Interface declarations
+ ---------------------------------------------------------------------}
+
+type
+ TLibHandle = longint;
+
+const
+ NilHandle = 0;
+
+{$else}
+
+{ ---------------------------------------------------------------------
+ Implementation section
+ ---------------------------------------------------------------------}
+
+uses
+ DosCalls;
+
+function LoadLibrary (Name: AnsiString): TLibHandle;
+var
+ ErrPath: array [0..259] of char;
+ Handle: longint;
+begin
+ if DosLoadModule (@ErrPath, SizeOf (ErrPath), PChar (Name), Handle) = 0
+ then Result := Handle else Result := NilHandle;
+end;
+
+function GetProcedureAddress (Lib: TLibHandle; ProcName: AnsiString): pointer;
+var
+ P: pointer;
+begin
+ if DosQueryProcAddr (Lib, 0, PChar (ProcName), P) = 0 then Result := P
+ else Result := nil;
+end;
+
+function UnloadLibrary (Lib: TLibHandle): boolean;
+begin
+ Result := DosFreeModule (Lib) = 0;
+end;
+
+{$endif}
+
+{
+ $Log: dynlibs.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/exe.pas b/rtl/os2/exe.pas
new file mode 100644
index 0000000000..7b85de1928
--- /dev/null
+++ b/rtl/os2/exe.pas
@@ -0,0 +1,243 @@
+unit Exe;
+
+ interface
+
+ type
+ exe = record
+ eid : word;
+ elast : word;
+ epagsiz : word;
+ erelcnt : word;
+ ehdrsiz : word;
+ eminfre : word;
+ emaxfre : word;
+ eiSS : word;
+ eiSP : word;
+ enegsum : word;
+ eiIP : word;
+ eiCS : word;
+ ereloff : word;
+ eovlnum : word;
+ ever : word;
+ dumy : word;
+ ebb : word;
+ dumy2 : array[0..6] of word;
+ end;
+
+ const
+ EXEID = $5A4D;
+
+{ Declarations specific for LX-type executables follow }
+ const
+ BITPERword = 16;
+ BITPERBYTE = 8;
+ OBJPAGELEN = 4096;
+ E32MAGIC = $584C;
+ E32RESBYTES1 = 0;
+ E32RESBYTES2 = 0;
+ E32RESBYTES3 = 24;
+ E32LEBO = $00;
+ E32BEBO = $01;
+ E32LEWO = $00;
+ E32BEWO = $01;
+ E32LEVEL = 0;
+ E32CPU286 = $001;
+ E32CPU386 = $002;
+ E32CPU486 = $003;
+
+ type
+ e32_exe = record
+ e32_magic : array[0..1] of byte;
+ e32_border : byte;
+ e32_worder : byte;
+ e32_level : longint;
+ e32_cpu : word;
+ e32_os : word;
+ e32_ver : longint;
+ e32_mflags : longint;
+ e32_mpages : longint;
+ e32_startobj : longint;
+ e32_eip : longint;
+ e32_stackobj : longint;
+ e32_esp : longint;
+ e32_pagesize : longint;
+ e32_pageshift : longint;
+ e32_fixupsize : longint;
+ e32_fixupsum : longint;
+ e32_ldrsize : longint;
+ e32_ldrsum : longint;
+ e32_objtab : longint;
+ e32_objcnt : longint;
+ e32_objmap : longint;
+ e32_itermap : longint;
+ e32_rsrctab : longint;
+ e32_rsrccnt : longint;
+ e32_restab : longint;
+ e32_enttab : longint;
+ e32_dirtab : longint;
+ e32_dircnt : longint;
+ e32_fpagetab : longint;
+ e32_frectab : longint;
+ e32_impmod : longint;
+ e32_impmodcnt : longint;
+ e32_impproc : longint;
+ e32_pagesum : longint;
+ e32_datapage : longint;
+ e32_preload : longint;
+ e32_nrestab : longint;
+ e32_cbnrestab : longint;
+ e32_nressum : longint;
+ e32_autodata : longint;
+ e32_debuginfo : longint;
+ e32_debuglen : longint;
+ e32_instpreload : longint;
+ e32_instdemand : longint;
+ e32_heapsize : longint;
+ e32_res3 : array[0..E32RESBYTES3-1] of byte;
+ end;
+
+ const
+ E32NOTP = $8000;
+ E32NOLOAD = $2000;
+ E32PMAPI = $0300;
+ E32PMW = $0200;
+ E32NOPMW = $0100;
+ E32NOEXTFIX = $0020;
+ E32NOINTFIX = $0010;
+ E32LIBINIT = $0004;
+ E32LIBTERM = $40000000;
+ E32APPMASK = $0700;
+ E32PROTDLL = $10000;
+ E32DEVICE = $20000;
+ E32MODEXE = $00000;
+ E32MODDLL = $08000;
+ E32MODPROTDLL = $18000;
+ E32MODPDEV = $20000;
+ E32MODVDEV = $28000;
+ E32MODMASK = $38000;
+ RINTSIZE16 = 8;
+ RINTSIZE32 = 10;
+ RORDSIZE = 8;
+ RNAMSIZE16 = 8;
+ RNAMSIZE32 = 10;
+ RADDSIZE16 = 10;
+ RADDSIZE32 = 12;
+ NRSTYP = $0f;
+ NRSBYT = $00;
+ NRSSEG = $02;
+ NRSPTR = $03;
+ NRSOFF = $05;
+ NRPTR48 = $06;
+ NROFF32 = $07;
+ NRSOFF32 = $08;
+ NRSRCMASK = $0f;
+ NRALIAS = $10;
+ NRCHAIN = $20;
+ NRRTYP = $03;
+ NRRINT = $00;
+ NRRORD = $01;
+ NRRNAM = $02;
+ NRADD = $04;
+ NRRENT = $03;
+ NR32BITOFF = $10;
+ NR32BITADD = $20;
+ NR16OBJMOD = $40;
+ NR8BITORD = $80;
+ PAGEPERDIR = 62;
+ LG2DIR = 7;
+
+ type
+ OBJPAGEDIR = record
+ next : longint;
+ ht : array[0..PAGEPERDIR-1] of word;
+ end;
+
+ e32_obj = record
+ o32_size : longint;
+ o32_base : longint;
+ o32_flags : longint;
+ o32_pagemap : longint;
+ o32_mapsize : longint;
+ o32_reserved : longint;
+ end;
+
+ const
+ OBJREAD = $0001;
+ OBJWRITE = $0002;
+ OBJRSRC = $0008;
+ OBJINVALID = $0080;
+ LNKNONPERM = $0600;
+ OBJNONPERM = $0000;
+ OBJPERM = $0100;
+ OBJRESIDENT = $0200;
+ OBJCONTIG = $0300;
+ OBJDYNAMIC = $0400;
+ OBJTYPEMASK = $0700;
+ OBJALIAS16 = $1000;
+ OBJBIGDEF = $2000;
+ OBJIOPL = $8000;
+ NSDISCARD = $0010;
+ NSMOVE = NSDISCARD;
+ NSSHARED = $0020;
+ NSPRELOAD = $0040;
+ NSEXRD = $0004;
+ NSCONFORM = $4000;
+
+ type
+ o32_map = record
+ o32_pagedataoffset : longint;
+ o32_pagesize : word;
+ o32_pageflags : word;
+ end;
+
+ const
+ VALID = $0000;
+ ITERDATA = $0001;
+ INVALID = $0002;
+ ZEROED = $0003;
+ RANGE = $0004;
+ ITERDATA2 = $0005;
+
+ type
+ rsrc32 = record
+ _type : word;
+ name : word;
+ cb : longint;
+ obj : word;
+ offset : longint;
+ end;
+
+{$PACKRECORDS 1}
+
+ LX_Iter = record
+ LX_nIter : word;
+ LX_nBytes : word;
+ LX_Iterdata : byte;
+ end;
+
+ b32_bundle = record
+ b32_cnt : byte;
+ b32_type : byte;
+ b32_obj : word;
+ end;
+
+{$PACKRECORDS NORMAL}
+ const
+ FIXENT16 = 3;
+ FIXENT32 = 5;
+ GATEENT16 = 5;
+ FWDENT = 7;
+ EMPTY = $00;
+ ENTRY16 = $01;
+ GATE16 = $02;
+ ENTRY32 = $03;
+ ENTRYFWD = $04;
+ TYPEINFO = $80;
+ E32EXPORT = $01;
+ E32SHARED = $02;
+ E32PARAMS = $f8;
+ FWD_ORDINAL = $01;
+
+ implementation
+
+end.
diff --git a/rtl/os2/kbdcalls.pas b/rtl/os2/kbdcalls.pas
new file mode 100644
index 0000000000..0208310aad
--- /dev/null
+++ b/rtl/os2/kbdcalls.pas
@@ -0,0 +1,1738 @@
+{Set tabsize to 4.}
+{****************************************************************************
+
+ $Id: kbdcalls.pas,v 1.3 2005/02/14 17:13:31 peter Exp $
+
+ KBDCALLS interface unit
+ Free Pascal Runtime Library for OS/2
+ Copyright (c) 1999-2000 by Florian Kl„mpfl
+ Copyright (c) 1999-2000 by Daniel Mantione
+ Copyright (c) 1999-2000 by Tomas Hajny
+
+ The Free Pascal runtime library is distributed under the Library GNU Public
+ License v2. So is this unit. The Library GNU Public License requires you to
+ distribute the source code of this unit with any product that uses it.
+ Because the EMX library isn't under the LGPL, we grant you an exception to
+ this, and that is, when you compile a program with the Free Pascal Compiler,
+ you do not need to ship source code with that program, AS LONG AS YOU ARE
+ USING UNMODIFIED CODE! If you modify this code, you MUST change the next
+ line:
+
+ <This is an official, unmodified Free Pascal source code file.>
+
+ Send us your modified files, we can work together if you want!
+
+ Free Pascal is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ Library GNU General Public License for more details.
+
+ You should have received a copy of the Library GNU General Public License
+ along with Free Pascal; see the file COPYING.LIB. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+****************************************************************************}
+
+unit KbdCalls;
+
+{ Interface library to KBDCALLS.DLL (through EMXWRAP.DLL)
+
+Variant records and aliases for some record types created to maintain highest
+possible level of compatibility with other existing OS/2 compilers.
+
+Changelog:
+
+ People:
+
+ TH - Tomas Hajny (xhajt03@mbox.vol.cz on Internet)
+
+ Date: Description of change: Changed by:
+
+ - First released version 1.0 TH
+
+Coding style:
+
+ I have tried to use the same coding style as Daniel Mantione in unit
+ DOSCALLS, although I can't say I would write it the same way otherwise
+ (I would write much more spaces myself, at least). Try to use it as well,
+ please. Original note by Daniel Mantione follows:
+
+
+ It may be well possible that coding style feels a bit strange to you.
+ Nevertheless I friendly ask you to try to make your changes not look all
+ to different. To make life easier, set your IDE to use tab characters,
+ turn optimal fill, autoindent and backspace unindents on and set a
+ tabsize of 4.}
+
+{***************************************************************************}
+interface
+{***************************************************************************}
+
+{$IFDEF FPC}
+ {$PACKRECORDS 1}
+{$ENDIF FPC}
+
+const
+{return codes / error constants (those marked with * shouldn't occur under
+normal conditions)}
+ No_Error = 0;
+ Error_Invalid_Parameter = 87;
+ Error_Sem_TimeOut =121;
+ Error_Kbd_Parameter =373;
+ Error_Kbd_No_Device =374; {*}
+ Error_Kbd_Invalid_IOWait =375; {*}
+ Error_Kbd_Invalid_Length =376;
+ Error_Kbd_Invalid_Echo_Mask =377;
+ Error_Kbd_Invalid_Input_Mask =378;
+ Error_Kbd_Smg_Only =407; {*}
+ Error_Kbd_Invalid_ASCIIZ =408;
+ Error_Kbd_Invalid_Mask =409;
+ Error_Kbd_Register =410;
+ Error_Kbd_Deregister =411;
+ Error_Kbd_Invalid_Handle =439;
+ Error_Kbd_No_more_Handle =440;
+ Error_Kbd_Cannot_Create_KCB =441;
+ Error_Kbd_Codepage_Load_Incompl =442; {*}
+ Error_Kbd_Invalid_CodePage_ID =443; {*}
+ Error_Kbd_No_CodePage_Support =444; {*}
+ Error_Kbd_Focus_Required =445;
+ Error_Kbd_Focus_Already_Active =446; {*}
+ Error_Kbd_Keyboard_Busy =447;
+ Error_Kbd_Invalid_CodePage =448;
+ Error_Kbd_Unable_To_Focus =449; {*}
+ Error_Kbd_Detached =464;
+ Error_Kbd_No_Console =500; {*}
+ Error_Kbd_Extended_SG =504;
+
+{FnMask}
+ kr_KbdCharIn =$00000001;
+ kr_KbdPeek =$00000002;
+ kr_KbdFlushBuffer =$00000004;
+ kr_KbdGetStatus =$00000008;
+ kr_KbdSetStatus =$00000010;
+ kr_KbdStringIn =$00000020;
+ kr_KbdOpen =$00000040;
+ kr_KbdClose =$00000080;
+ kr_KbdGetFocus =$00000100;
+ kr_KbdFreeFocus =$00000200;
+ kr_KbdGetCP =$00000400;
+ kr_KbdSetCP =$00000800;
+ kr_KbdXLate =$00001000;
+ kr_KbdSetCustXT =$00002000;
+
+{WaitFlag}
+ IO_Wait =0;
+ {KbdCharIn: wait for a character if one is not available}
+ {KbdGetFocus: wait for the focus}
+ {KbdStringIn: in binary input mode, wait until CharBuf is full, in }
+ { ASCII input mode wait until a carriage return is pressed}
+ IO_NoWait =1;
+ {KbdCharIn: immediate return if no character is available}
+ {KbdGetFocus: do not wait for the focus}
+ {KbdStringIn: send an immediate return if no characters are available,}
+ { if characters available, send them (up to the maximum }
+ { length); not supported in ASCII input mode }
+
+{TKbdInfo.fsMask}
+ Keyboard_Echo_On =$0001; {echo is on}
+ Keyboard_Echo_Off =$0002; {echo is off}
+ Keyboard_Binary_Mode =$0004; {binary mode is on}
+ Keyboard_ASCII_Mode =$0008; {ASCII mode is on}
+ Keyboard_Modify_State =$0010; {shift state is modified}
+ Keyboard_Modify_Interim =$0020; {interim character flags are modified}
+ Keyboard_Modify_TurnAround =$0040; {turn-around character is modified}
+ Keyboard_2B_TurnAround =$0080; {length of the turn-around character }
+ {(meaningful only if }
+ {Keyboard_Modify_TurnAround bit is on)}
+ Keyboard_Shift_Report =$0100; {shift return is on}
+
+{TKbdInfo.fsState/TKbdKeyInfo.fsState/TKbdTrans.fsState}
+ KbdStF_RightShift =$0001;
+ KbdStF_LeftShift =$0002;
+ KbdStF_Control =$0004;
+ KbdStF_Alt =$0008;
+ KbdStF_ScrollLock_On =$0010;
+ KbdStF_Numlock_On =$0020;
+ KbdStF_Capslock_On =$0040;
+ KbdStF_Insert_On =$0080;
+ KbdStF_LeftControl =$0100;
+ KbdStF_LeftAlt =$0200;
+ KbdStF_RightControl =$0400;
+ KbdStF_RightAlt =$0800;
+ KbdStF_ScrollLock =$1000;
+ KbdStF_NumLock =$2000;
+ KbdStF_CapsLock =$4000;
+ KbdStF_SysReq =$8000;
+
+{TKbdTrans.fbStatus}
+ KbdTrF_Shift_Key_In =$01; {shift status returned}
+ {without character }
+ KbdTrF_Extended_Key_In =$02; {extended key code }
+ {from the keyboard,}
+ {not a character }
+ KbdTrF_Conversion_Request =$20; {immediate conversion}
+ {requested }
+ KbdTrF_Final_Char_In =$40; {either $40 or $80 or both}
+ KbdTrF_Interim_Char_In =$80; {must be present }
+
+{TKbdHWID.idKbd}
+ Keyboard_Undetermined =$0000; {undetermined keyboard type}
+ Keyboard_AT_Compatible =$0001; {PC-AT Standard Keyboard}
+ Keyboard_Enhanced_101 =$AB41; {101 Key Enhanced Keyboard}
+ Keyboard_Enhanced_102 =$AB41; {102 Key Enhanced Keyboard}
+ Keyboard_Enhanced_88_89 =$AB54; {88 and 89 Key Enhanced Keyboards}
+ Keyboard_Enhanced_122 =$AB85; {122 Key Enhanced Keyboard}
+ Keyboard_AT_Compatable=Keyboard_AT_Compatible;
+ Keyboard_SpaceSaver=Keyboard_Enhanced_88_89;
+
+
+type
+{TKbdKeyInfo - record type for character data for KbdCharIn and KbdPeek}
+(* #pragma pack(2) ??? *)
+ TKbdKeyInfo=record
+ chChar:char; {ASCII character code; the scan code received}
+ {from the keyboard is translated to the ASCII}
+ {character code }
+ case boolean of
+ false:(
+ chScan:byte; {scan Code received from the keyboard}
+ fbStatus:byte; {state of the keystroke event, see KbdTrF_* constants}
+ bNlsShift:byte; {NLS shift status (always 0?)}
+ fsState:word; {shift key status, see KbdStF_* constants}
+ Time:cardinal); {time stamp indicating when a key was pressed,}
+ {specified in milliseconds from the time }
+ {the system was started }
+ true:(
+ chScan2:char; (* should be chScan, fbStatus and bNlsShift, *)
+ fbStatus2:byte; (* but this construct is unsupported currently *)
+ bNlsShift2:char);
+ end;
+ PKbdKeyInfo=^TKbdKeyInfo;
+ KbdKeyInfo=TKbdKeyInfo; {for better compatibility with other compilers}
+
+{record type for KbdStringIn}
+ TStringInBuf=record
+ cb:word; {length of the input buffer, maximum length is 255}
+ cchIn:word; {number of bytes actually read into the buffer}
+ end;
+ PStringInBuf=^TStringInBuf;
+ StringInBuf=TStringInBuf;
+
+{TKbdInfo record type, for KbdSet/GetStatus}
+ TKbdInfo=record
+ cb, {total length in bytes, 10 is the only valid value }
+ fsMask, {see TKbdInfo.fsMask constants, higher bits reserved}
+ {and set to 0 }
+ chTurnAround, {definition of the turn-around character, in ASCII }
+ {and extended-ASCII format, the turn-around character}
+ {is defined as the carriage return, in ASCII format }
+ {only, the turn-around character is defined in the }
+ {low-order byte; usually $000D }
+ fsInterim, {interim character flags: bits 0-4 and 6 - reserved }
+ { and set to 0,}
+ { bit 5 - application}
+ { requested }
+ { immediate }
+ { conversion }
+ { bit 7 - interim }
+ { character }
+ { flag is on }
+ { bits 8-15 - NLS shift }
+ { state }
+ fsState:word; {shift state, see TKbdInfo.fsState constants}
+ end;
+ PKbdInfo=^TKbdInfo;
+ KbdInfo=TKbdInfo;
+
+{record type for KbdGetHWID}
+ TKbdHWID=record
+ cb, {length in bytes, on input length of the TKbdHWID}
+ {record (at least 2), on output the actual number}
+ {of bytes returned }
+ idKbd, {keyboard type: $0000 = undetermined keyboard type}
+ { $0001 = PC-AT Standard Keyboard }
+ { $AB41 = 101 Key Enhanced Keyboard }
+ { $AB41 = 102 Key Enhanced Keyboard }
+ { $AB54 = 88 and 89 Key Enhanced }
+ { Keyboards }
+ { $AB85 = 122 Key Enhanced Keyboard }
+ {- see Keyboard_* constants }
+ usReserved1, {reserved, returned set to zero (secondary ID?)}
+ usReserved2:word; {reserved, returned set to zero}
+ end;
+ PKbdHWID=^TKbdHWID;
+ KbdHWID=TKbdHWID;
+
+{record type for KbdXlate}
+(* #pragma pack(2) ???*)
+ TKbdTrans=record
+ case boolean of
+ false:(
+ CharData:TKbdKeyInfo);
+ true:(
+ chChar:char; {ASCII character code; the scan code received}
+ {from the keyboard is translated to the ASCII}
+ {character code }
+ case boolean of
+ false:(
+ chScan, {scan Code received from the keyboard}
+ fbStatus, {state of the keystroke event,}
+ {see KbdTrF_* constants }
+ bNlsShift:byte; {NLS shift status (always 0?)}
+ fsState:word; {shift key status, see KbdStF_* constants}
+ Time:cardinal; {time stamp indicating when a key was pressed,}
+ {specified in milliseconds from the time }
+ {the system was started }
+ fsDD:word; {device driver returned flag, }
+ {see KbdDDFlagWord notes below}
+ fsXlate:word; {translation flag: 0 - translation incomplete,}
+ { 1 - translation complete }
+ fsShift:word; {identifies the state of translation across }
+ {successive calls, initially the value should }
+ {be zero; it may take several calls to this }
+ {function to complete a character, the value }
+ {should not be changed unless a new translation}
+ {is required (that is, reset value to zero) }
+ sZero:word); {reserved, set to 0}
+ true:(
+ chScan2, (* should be chScan, fbStatus and bNlsShift, *)
+ fbStatus2, (* but this construct is unsupported currently *)
+ bNlsShift2:char));
+ end;
+ PKbdTrans=^TKbdTrans;
+ KbdTrans=TKbdTrans;
+
+{KbdDDFlagWord notes:
+ bits 15-14 Available. These bits are available for communication between
+ monitors; they are not used by the physical device driver. The
+ monitor applications coordinate the use of these flags.
+ Bits 13-10 Reserved, set to zero. Monitors must pass these flags as is.
+ They must set these flags to 0 in packets they create.
+ Bit 9 Accented. This key is translated using the previous key passed,
+ which is an accent key. Where an accent key is pressed, and the
+ following key does not use the accent, a packet containing the
+ accent character itself is first passed with this bit set. The
+ scan code field of MonFlagWord (see above) would be 0,
+ indicating a non-key generated record. A valid packet
+ containing that following keystroke is then passed without this
+ bit set.
+ Bit 8 Multimake. The translation process sees this scan code as
+ a typematic repeat of a toggle key or a shift key. Because
+ toggle and shift keys only change state on the first make after
+ each key-break, no state information is changed. For example,
+ the NumLock toggle bit in the shift status word is not changed,
+ even though this can be the NumLock key. If this key is a valid
+ character, it does not go into the Keyboard Input Buffer (KIB)
+ once this bit is set.
+ Bit 7 Secondary. The scan code prior to the one in this packet was
+ the Secondary Key Prefix (see below).
+ Bit 6 Key break. This record is generated by the release (the break)
+ of the key involved.
+ Bits 5-0 Key type. This numeric field flags the physical device driver
+ and reports that this is a key that requires action. The number
+ in this field is filled in during the translation of the scan
+ code. The value allows the driver to act on keystrokes without
+ regard for what scan codes the keyboard uses or character codes
+ that the current translation process may be using. The
+ following values are currently defined:
+
+ - Value for keys that are always placed in the KIB.
+ Zero = no special action, always place in KIB.
+
+ - Values acted on prior to passing packet to monitors.
+ Except for the final keystroke of the DUMP key sequences,
+ all of these values are passed on to the monitors. They
+ are not placed in the KIB. The XlatedChar and XlatedScan
+ fields are undefined for these values:
+ 01h ACK. This scan code is a keyboard acknowledge.
+ Personal Computer IBM* AT* attached keyboards
+ set this value on an FAh scan code.
+ 02h Secondary key prefix. This scan code is a prefix
+ generated by the Enhanced Keyboard. It indicates
+ that the next scan code coming is one of the
+ secondary keys that exists on that keyboard.
+ Usually set on an E0h scan code or an E1h scan
+ code.
+ 03h Kbd overrun. This scan code is an overrun
+ indication from the keyboard. On an IBM Personal
+ Computer AT-attached keyboard, this value would be
+ set on an FFh scan code.
+ 04h Resend. This scan code is a resend request from the
+ keyboard. On an IBM Personal Computer AT-attached
+ keyboard, this value would be set on an FEh scan
+ code.
+ 05h Reboot key. This scan code completes the multi-key
+ restart sequence. On an IBM Personal Computer AT
+ attached-keyboard, this value would be used when
+ the Ctrl+Alt+Delete sequence is used.
+ 06h Dump key. This scan code completes the multi-key
+ Stand Alone Dump request sequence. On an IBM
+ Personal Computer AT-attached keyboard, this value
+ would be used on completion of the second
+ consecutive press of Ctrl+Alt+NumLock or
+ Ctrl+Alt+F10 without other keystrokes between the
+ two presses.
+ 07h-
+ 0Ah See entries below.
+
+ 0Bh Invalid accent combination. This scan code follows
+ an accent scan code but the combination is not
+ valid, and neither key is put in the KIB.
+ (Note: This is set if the Canadian-French code
+ pages are in use.)
+ 0Ch System-defined hot keys.
+ 0Dh
+ -0Fh Reserved. Treated as undefined. See entry 3Fh.
+ - Values acted on after passing packet to monitors. Except
+ where noted, these values are placed in the KIB when the
+ physical device driver is in binary mode; they are not
+ placed in the KIB when the physical device driver is in
+ ASCII mode. (Also listed are those that never get placed
+ in the KIB.)
+ 07h Shift key. This scan code translates as a shift key
+ and affects the shift status fields of the CharData
+ record, but does not generate a defined character.
+ It is not placed in the KIB. The XlatedChar field
+ is undefined. The scan code field is 0.
+ 08h Pause key. This scan code is translated as the key
+ sequence meaning pause. On an IBM Personal Computer
+ AT-attached keyboard, this value is used when the
+ Ctrl+NumLock sequence is used. The key itself is
+ not placed in the KIB.
+ 09h Pseudo-Pause key. This scan code is translated into
+ the value that is treated as the Pause key when the
+ physical device driver is in ASCII mode. On most
+ keyboards, this would be when the Ctrl+S
+ combination is used. The key itself is not placed
+ in the KIB.
+ 0Ah Wake-up key. This scan code follows a Pause key or
+ Pseudo-Pause key, which causes the Pause state to
+ end. The key itself is not placed in the KIB.
+ 10h Accent key. This scan code is translated and used
+ as a key to alter the translation of the next key
+ to come in. The packet containing this value is
+ passed when the accent key is pressed, but it is
+ not put into the KIB, unless the Accented bit is
+ ON. The next key determines this decision. If the
+ next key is one that can be accented, then it is
+ passed by itself with the Accented bit ON. If that
+ next key cannot be accented by this accent, then
+ two packets are passed. The first contains the
+ character to print for the accent itself. It has
+ the Accent key value and the Accented flag (which
+ allows the packet to be put in the KIB). The second
+ packet contains a regular translation of that
+ following key.
+ (Note: The two packets get passed for every
+ language except Canadian-French - see entry 0Bh.)
+ 11h Break key. This scan code is translated as the key
+ sequence meaning break. On the IBM Personal
+ Computer AT-attached keyboard, this value is used
+ where the Ctrl+Break sequence is used.
+ 12h Pseudo-Break key. This scan code is translated into
+ the value that is treated as the Break key when the
+ physical device driver is in ASCII mode. On most
+ keyboards, this would be when the Ctrl+C
+ combination is used. Notice that the event
+ generated by this key is separate from the one
+ generated by the Break key when in the binary mode.
+ 13h Print Screen key. This scan code is translated as
+ the key sequence meaning Print Screen. On an IBM
+ Personal Computer AT-attached keyboard, this value
+ is used where the Shift+PrtSc sequence is used.
+ 14h Print Echo key. This scan code is translated as the
+ key sequence meaning Print Echo. This value is used
+ where the Ctrl+PrtSc sequence is used.
+ 15h Pseudo-Print Echo key. This scan code is translated
+ into the value that is treated as the Print Echo
+ key when the physical device driver is in ASCII
+ mode. On most keyboards, this would show as the
+ Ctrl+P combination.
+ 16h Print-Flush key. This scan code is translated into
+ the key sequence Print-Flush. This value is used
+ where the Ctrl+Alt+PrtSc sequence is used.
+ 17h
+ -2Fh Reserved, set to zero. Treated as undefined. See
+ entry 3Fh.
+ - Values for packets not generated by a keystroke:
+ 30h
+ -37h Reserved.
+ 38h
+ -3Eh Reserved. Treated as undefined. See entry 3Fh.
+ - Value for keys the translation process does not recognize:
+ 3Fh Undefined. This scan code, or its combination with
+ the current shift state, is not recognized in the
+ translation process.
+}
+
+{header of TXLateTbl}
+ TXHeader=record
+ XTableID:word; {code page number}
+ XTableFlags1:word; {bits 0-2 determine which shift key or key }
+ {combination affects Char3 of each TXLateKeyDef }
+ {element, bits 7-10 determine which shift key or}
+ {key combination causes Char5 to be used in each}
+ {TXLateKeyDef element }
+ {bit 0 - ShiftAlt (use Shift+Alt instead of }
+ { Ctrl+Alt) }
+ {bit 1 - AltGrafL (use left Alt key as }
+ { Alt+Graphics) }
+ {bit 2 - AltGrafR (use right Alt key as }
+ { Alt+Graphics) }
+ {bit 3 - ShiftLock (treat Caps Lock as }
+ { ShiftLock) }
+ {bit 4 - DefaultTable (default table for the }
+ { language) }
+ {bit 5 - ShiftToggle (1 = toggle ShiftLock, }
+ { 0 = latch it) }
+ {bit 6 - AccentPass (pass accent and non-accent }
+ { key through; 1 = pass on accent keys}
+ { and beep, 0 = beep only }
+ {bit 7 - CapsShift (Caps+Shift uses Char5) }
+ {bit 8 - MachDep (machine-dependent table) }
+ {bits 9-10 reserved }
+ {bits 11-15 reserved }
+ XTableFlags2:word; {reserved, set to zero}
+ KbdType:word; {keyboard type, 1 for extended (all common types)}
+ KbdSubType:word; {reserved}
+ XtableLen:word; {length of table}
+ EntryCount:word; {number of KeyDef entries}
+ EntryWidth:word; {width of KeyDef entries}
+ Country:word; {language ID}
+ TableTypeID:word; {the table type; 1st byte (type): 01X 00X }
+ { 2nd byte (sub-type): 00X reserved}
+ SubCountryID:cardinal;
+ {sub-language identifier}
+ Reserved:array[1..8] of word;
+ end;
+ PXHeader=^TXHeader;
+
+{element of TXLateTbl, not all entries are used (unused entries are zero)}
+ TXLateKeyDef=record
+ XlateOp:word; {translate operation specifier; }
+ {bits 0- 6 - AccentFlags (see Notes 1 and 8)}
+ {bits 7-15 - KeyType (see Note 2) }
+ Char1:char;
+ Char2:char;
+ Char3:char;
+ Char4:char;
+ Char5:char;
+ end;
+ PXLateKeyDef=^TXLateKeyDef;
+
+{record type for character definition in TAccentEntry}
+ TKeyCode=record
+ CharCode:char;
+ ScanCode:byte;
+ end;
+
+{accent entry definitions for TAccentTable, see Notes 1 and 9}
+ TAccentEntry=record
+ NonAccent:TKeyCode; {char/scan code when}
+ {not used as accent }
+ CtlAccent:TKeyCode; {char/scan code when}
+ {used with Ctrl key }
+ AltAccent:TKeyCode; {char/scan code when}
+ {used with Alt key }
+ Maps:array[1..20] of TKeyCode; {from char-to-char for translation}
+ end;
+ PAccentEntry=^TAccentEntry;
+
+{table of accent key definitions for TXLateTbl}
+ TAccentTable=array[1..7] of TAccentEntry;
+ PAccentTable=^TAccentTable;
+
+{record type for SetCustXT, one element for each possible scan code
+(entries are in scan code order, based on the remapped scan codes
+returned by the keyboard controller)}
+ TXLateTbl=record
+ XHeader:TXHeader;
+ KeyDefs:array [1..127] of TXLateKeyDef;
+ AccentTbl:TAccentTable;
+ end;
+ PXLateTbl=^TXLateTbl;
+
+{Remarks for TXLateTbl record type:
+
+ The request changes the device driver resident code page for the system
+ and updates the zero entry of the Code Page Control Block.
+
+* Note 1
+ The AccentFlags field of the KeyDef record has seven flags that are
+ individually set if a corresponding entry in the accent table applies to this
+ scan code. If the key pressed immediately before the current one was an
+ accent key and the bit for that accent is set in the AccentFlags field for
+ the current key, the corresponding AccentTable entry is searched for the
+ replacement character value to use. If no replacement is found and bit 6 of
+ the XlateFlags1 field is set, the not-an-accent beep is sounded and the
+ accent character and current character are passed as two separate
+ characters. Also see Note 8.
+
+* Note 2
+
+ The KeyType field of the KeyDef record currently has the following values
+ defined. The remaining values up to 1Fh are undefined. The effect of each
+ type of shift is defined below. Except where otherwise noted, when no
+ shifts are active, Char1 is the translated character. (See Note 3.) Notice
+ that any of the Alt, Alt+Char, Alt+Shift, or Alt+Gr keys (or all of them) can
+ be present on a keyboard based on the AltGrafL and AltGrafR bits in the
+ XTableFlags1 flag word in the table header.
+
+ 01h AlphaKey. Alphabetical character key:
+
+ Shift Uses Char2. If Caps Lock, uses Char1.
+ Caps Lock Uses Char2. If Shift, uses Char1.
+ Ctrl Set standard control code for this key's Char1 value.
+ See Note 4.
+ Alt Standard extended code. See Note 7.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 02h SpecKey. Special nonalphabetic character key, no Caps Lock or Alt:
+
+ Shift Uses Char2.
+ Caps Lock No effect, only depends on Shift, or Ctrl.
+ Ctrl See Note 4.
+ Alt Marked undefined.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 03h SpecKeyC. Special nonalphabetic character key with Caps Lock. See
+ Note 15.
+
+ Shift Uses Char2. If Caps Lock, uses Char1.
+ Caps Lock Uses Char2. If Shift, uses Char1.
+ Ctrl See Note 4.
+ Alt Uses Char4, if not zero. See Note 7.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 04h SpecKeyA. Special nonalphabetic character key with Alt (no Caps
+ Lock):
+
+ Shift Uses Char2.
+ Caps Lock No effect; depends on Shift, Ctrl, or Alt only.
+ Ctrl See Notes 5 and 9.
+ Alt See Notes 7 and 10.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 05h SpecKeyCA. Special nonalphabetic character key with Caps Lock and
+ Alt:
+
+ Shift Uses Char2. If Caps Lock, uses Char1.
+ Caps Lock Uses Char2. If Shift, uses Char1.
+ Ctrl See Note 4.
+ Alt See Note 7.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 06h FuncKey. Function keys. Char1 = n in Fn; Char2 ignored. Sets
+ extended codes 58+Char1, if no shift; if F11 or F12, uses 139 and 140.
+
+ Shift Sets extended codes 83+Char1. F11 and F12 use 141
+ and 142, respectively.
+ Caps Lock No effect on function keys.
+ Ctrl Sets extended codes 93+Char1. F11 and F12 use 143
+ and 144, respectively.
+ Alt Sets extended codes 103+Char1. F11 and F12 use 145
+ and 146, respectively.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 07h PadKey. Keypad keys (see Note 5 for definition of Char1). Note that
+ nonshifted use of these keys is fixed to the extended codes:
+
+ Shift Uses Char2, unless Num Lock. See Note 5.
+ Caps Lock No effect on pad keys, unless Num Lock. See Note 5.
+ Ctrl Sets extended codes. See Note 5.
+ Alt Used to build a character. See Note 5.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 08h SpecCtlKey. Special action keys, when used with Ctrl pressed:
+
+ Shift No effect on these keys.
+ Caps Lock No effect on these keys.
+ Ctrl Uses Char2.
+ Alt See Note 7.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 09h PrtSc. Print Screen key; sets Char1 normally (see Note 17):
+
+ Shift Signal the Print Screen function.
+ Caps Lock No effect on this key.
+ Ctrl Sets extended code and signals the Print Echo function.
+ Alt Marked undefined.
+ Alt+Char Uses Char3, if it is not 0.
+ Alt+Shift Uses Char3, if it is not 0.
+ Alt+Gr Uses Char3, if it is not 0.
+
+ 0Ah SysReq. System Request key; treated like a shift key. See Note 6.
+
+ 0Bh AccentKey. Keys that affect the next key pressed (also known as
+ dead keys). Char1 is an index into the AccentTbl field of the
+ XlateTable, selecting the AccentEntry that corresponds to this key.
+ Char2 and Char3 do the same for the shifted Accent character. See
+ Note 15.
+
+ Shift Uses Char2 to index to applicable AccentEntry.
+ Caps Lock No effect on this key.
+ Ctrl Uses CtlAccent character from AccentEntry. See Note 8.
+ Alt Uses AltAccent character from AccentEntry. See Note 8.
+ Alt+Char Uses Char3 to index to applicable AccentEntry.
+ Alt+Shift Uses Char3 to index to applicable AccentEntry.
+ Alt+Gr Uses Char3 to index to applicable AccentEntry.
+
+ Note: Key types 0Ch - 13h set Char1 and Char2 to mask values as defined
+ in Note 6.
+
+ 0Ch ShiftKeys. Shift or Ctrl key, sets and clears flags. Char1 holds the
+ bits in the lower byte of the shift status word to set when the
+ key is down and clear when the key is released. Char2 does the
+ same thing for the upper byte of the shift status word unless the
+ secondary key prefix (hex E0) is seen immediately prior to this key,
+ in which case Char3 is used in place of Char2.
+
+ 0Dh ToggleKey. General toggle key (like Caps Lock). Char1 holds the
+ bits in the lower byte of the shift status word to toggle on the
+ first make of the key after it is pressed. Char2 holds the bits in
+ the upper byte of the shift status word to set when the key is
+ down and clear when the key is released unless the secondary key
+ prefix (hex E0) is seen immediately prior to this key, in which case
+ Char3 is used in place of Char2.
+
+ 0Eh AltKey. Treated just like ShiftKeys above, but has its own key
+ type, because when seen, the accumulator used for Alt+PadKey
+ entry is zeroed to prepare such entry (see Note 5). Sometimes this
+ key is treated as the AltC/S/G key (that is, either Alt+Char,
+ Alt+Shift, or Alt+Gr) if one of the AltGraf bits is on in XTableFlags1.
+
+ 0Fh Num Lock. Normally behaves like ToggleKey, but the physical
+ keyboard device driver sets a pause screen indication when this
+ key is used with the Ctrl key pressed. The pause is cleared on the
+ following keystroke if that stroke is a character-generating key.
+
+ 10h Caps Lock. This key is treated as a type 0Dh toggle key. It has a
+ separate entry here so that it can be processed like a Shift Lock
+ key when that flag is set in the XTableFlags1 word in the header.
+ When treated as a Shift Lock, the Caps Lock flag in the shift
+ status word is set on on any make of this key, and only cleared
+ when the left or right shift key is pressed. Char2 and Char3 are
+ processed the same as ToggleKey.
+
+ 11h Scroll Lock. Normally behaves like ToggleKey but has a separate
+ entry here. When used with Ctrl, it can be recognized as
+ Ctrl+Break.
+
+ 12h XShiftKey. Extended Shift Key (for Country support). See Note 9.
+
+ 13h XToggleKey. Extended Toggle Key (for Country support). See Note 9.
+
+ 14h SpecKeyCS. Special key 1 for country keyboard processing. See Note 15.
+
+ Shift Uses Char2.
+ Caps Lock Uses Char4.
+ Ctrl See Note 4.
+ Alt See Note 7.
+ Alt+Char Uses Char3.
+ Alt+Shift Uses Char3.
+ Alt+Gr Uses Char3.
+ Caps+Shift Uses Char5.
+
+ 15h SpecKeyAS. Special key 2 for country keyboard processing. See Note 15.
+
+ Shift Uses Char2.
+ Caps Lock No effect on this key.
+ Ctrl See Note 4.
+ Alt Uses Char 4. See Note 14.
+ Alt+Char Uses Char 3. See Note 14.
+ Alt+Shift Uses Char 3. See Note 14.
+ Alt+Gr Uses Char 3. See Note 14.
+
+ 1Ah Extended Extended key. This corresponds to the BIOS level support
+ provided for INT 16h, Functions 20h, 21h, and 22h.
+
+ Shift Uses Char2.
+ Caps Lock No effect on this key.
+ Ctrl Uses Char4.
+ Alt Uses Char5.
+ Alt+Char Uses Char 3, if not 0.
+ Alt+Shift Uses Char 3, if not 0.
+ Alt+Gr Uses Char 3, if not 0.
+ 16h-
+ 1FFh Reserved, except for 1Ah, the Extended Extended key (see above).
+
+* Note 3
+
+ Undefined Character Code. Any key combination that does not fall into any
+ of the defined categories. For example, the Ctrl key pressed along with a
+ key that has no defined control mapping is mapped to the value 0, and the
+ key type is set in the KeyPacket record indicating undefined translation.
+ The KeyPacket record passed to the monitors, if installed, contain the
+ original scan code in the ScanCode field and the 0 in the Character field for
+ this key. Notice that no character data records with an undefined character
+ code are placed in the keyboard input buffer.
+
+* Note 4
+
+ Ctrl Key. The six possible situations that can occur when a key is pressed
+ with only the Ctrl+shift key are shown below:
+
+ - The key pressed is an AlphaKey character. In this case, the Ctrl plus
+ Char1 combination defines one of the standard defined control codes
+ (all numbers are decimal):
+
+ Ctrl- Mapping Code Name Ctrl- Mapping Code Name
+ ----- ------- --------- ----- ------- ---------
+ a 1 SOH n 14 SO
+ b 2 STX o 15 SI
+ c 3 ETX p 16 DLE
+ d 4 EOT q 17 DC1
+ e 5 ENQ r 18 DC2
+ f 6 ACK s 19 DC3
+ g 7 BEL t 20 DC4
+ h 8 BS u 21 NAK
+ i 9 HT v 22 SYN
+ j 10 LF w 23 ETB
+ k 11 VT x 24 CAN
+ l 12 FF y 25 EM
+ m 13 CR z 26 SUB
+
+ Notice that any key defined as AlphaKey uses the Char1 code value
+ minus 96 (ASCII code for a) plus 1 to set the mapping shown above.
+ Any scan code defined as AlphaKey must assign to Char1 one of the
+ allowed lower case letters.
+
+ - The key pressed is a nonalpha character, such as [, but is not an action
+ key, such as Enter, Backspace, or an arrow key. This is a
+ SpecKey[C][A] in the list of key types in the previous example. In this
+ case, with one exception, the mapping is based on the scan code of the
+ key. Though the key can be relabeled, the Ctrl+Char combination is
+ always mapped based on the scan code of the key using the following
+ table (all numbers are decimal):
+}(*
+ Scan US Kbd Mapped Name of
+ Code Legend Value New Code
+ ---- ------ ------ --------
+ 3 2 @ 0 Null
+ 7 6 ^ 30 RS
+ 12 - _ 31 US (see Note below)
+ 26 [ { 27 Esc
+ 27 ] } 29 GS
+ 43 \ | 28 FS
+*){
+ Note: The mapping for the hyphen character (-) is the one exception.
+ The scan code for it is ignored; only the ASCII code for hyphen
+ (decimal 45) is looked for in Char1 when mapping the Ctrl+-
+ combination. This is because there can be more than one
+ occurrence of the hyphen (-) key on the keyboard. The Ctrl+-
+ (PadKey minus) combination produces character/scan code values
+ of 00/8Eh, respectively.
+
+ - The key pressed is an action key such as Enter, Backspace, or an arrow
+ key. These keys generate special values when used in conjunction with
+ the Ctrl key. Those actions are defined in other notes where they
+ apply. Two particular keys in this category are:
+
+ Ctrl+Enter = LF(010)
+ Ctrl+Backspace = Del(127)
+
+ - The key pressed is a function key, F1 - F12. See the FuncKey
+ description in Note 2.
+
+ - The key pressed is an accent key. See Note 8.
+
+ - The key is not defined in conjunction with Ctrl. In this case, the key
+ is treated as undefined, as described in Note 3.
+
+* Note 5
+
+ PadKey. The pad keys have several uses that depend on various shift
+ states. Some of them are based on their position on the keyboard. Because
+ keyboard layouts change, the hard-coded assumed positions of the keypad
+ keys, with the offset value that must be coded into Char1, are defined
+ below. Any remapping must use the Char1 values shown below for the keys
+ that correspond to the pad keys given by the Legend or Char2 values:
+
+ US Kbd Scan Char1 Char2
+ Legend Code Required US Kbd With Ctrl
+ ------- ---- --------- ------- -----------
+ Home 7 71 Decimal 0 ASCII 7 Decimal 119
+ Up 8 72 " 1 " 8 " 141
+ PgUp 9 73 " 2 " 9 " 132
+ - 74 " 3 " - " 142
+ Left 4 75 " 4 " 4 " 115
+ 5 76 " 5 " 5 " 143
+ Right 6 77 " 6 " 6 " 116
+ + 78 " 7 " + " 144
+ End 1 79 " 8 " 1 " 117
+ Down 2 80 " 9 " 2 " 145
+ PgDn 3 81 " 10 " 3 " 118
+ Ins 0 82 " 11 " 0 " 146
+ Del . 83 " 12 " . " 147
+
+ Notice that when Num Lock is off, or if Shift is active and Num Lock on, the
+ code returned is the extended code. The code returned corresponds to the
+ Legends above (Home, PgUp, and so forth). When Num Lock is on, or if
+ Shift is active and Num Lock is off, the code returned is Char2. Notice that
+ the + and - keys also return Char2 when the shift key is down.
+
+ When the Alt key is used with the PadKeys, the absolute value of the
+ pressed key (looked up using the required Char1 value) is added to the
+ accumulated value of any of the previous numeric keys pressed, without
+ releasing the Alt key. Before adding the new number to the accumulated
+ value, that accumulation is multiplied by ten, with overflow beyond 255
+ ignored. When Alt is released, the accumulation becomes a Character code
+ and is passed along with a scan code of zero. Notice that if any key other
+ than the 10 numeric keys is pressed, the accumulated value is reset to zero.
+ When the keypad *, -, or + keys are pressed while the Alt key is down, the
+ extended characters 55, 74, and 78 (decimal) are returned, respectively.
+
+ When AltGraphics is used with the PadKeys, the Char3 value is returned if it
+ is nonzero, and if an AltGraf bit is set in XTableFlags1; otherwise, it is
+ treated the same as the Alt key.
+
+ On the Enhanced keyboard, the secondary keypad keys return, as an
+ extended character, the scan code of the key plus 80 (decimal) when
+ pressed in conjunction with the Alt key. The secondary / key returns an
+ extended character of 164, when pressed in conjunction with the Alt key.
+
+* Note 6
+
+ State Key. Each state key entry has Char1, Char2, and Char3 defined as
+ follows:
+
+ - Char1. A mask to set the appropriate bit in the low byte of the
+ keyboard Shift Flags when the state key is pressed. When the state
+ key is a toggle key, the set bit is toggled each additional time the key
+ is pressed. When the state key is not a toggle key, the set bit is
+ cleared when the key is released.
+
+ - Char2. A mask to set the appropriate bit in the high byte of the
+ Keyboard Shift Flags when the key is pressed.
+
+ - Char3. Used in place of Char2 when the secondary key prefix is seen
+ immediately prior to this key.
+
+ The masks are shown below (numbers are in hex):
+
+ Key Char1 Char2 Char3
+ ----------- ----- ----- -----
+ Right Shift 01 00 00
+ Left Shift 02 00 00
+ Ctrl Shift 04 01 04
+ Alt Shift 08 02 08
+ Scroll Lock 10 10 10
+ Num Lock 20 20 20
+ Caps Lock 40 40 40
+ SysReq 00 80 80
+
+ Notice that the INS key is not treated as a state key, but as a pad key.
+ Also, SysReq is included here because it is treated as a shift key.
+
+* Note 7
+
+ Alt Character. Most of the keys defined in a category that allows the Alt
+ key (AlphaKey, SpecKeyA, SpecKeyCA) return a value called an extended
+ character. This value is a character code of 00H or E0H, with a second byte
+ (using the ScanCode field of the CharData record) defining the extended
+ code. In most cases, this value is the scan code of the key. Since the
+ legend on these keys can be remapped on a foreign language keyboard, the
+ Alt-based extended code is hard to define in a general sense. The following
+ rules are used:
+
+ - AlphaKey. The extended code is derived from Char1 (the lower-case
+ character) as it was originally mapped on the PC keyboard. The
+ original scan code value is the extended code that a character returns.
+ These keys can be moved and will still return their original Alt
+ extended codes.
+
+ - SpecKeyA and SpecKeyCA. This category is used for all keys that are
+ not an alphabetic character or an action code (like Enter or Backspace,
+ the only exception being the Tab key, which is treated as a character).
+ On foreign keyboards, these keys can be moved around and can have
+ new values assigned to them, such as special punctuation symbols.
+ Therefore, the Alt mappings must be based on the real scan code as
+ any keys defined by the SpecKey_ classification will have only an Alt
+ mapping, if it is in one of the positions defined below. In that case,
+ the Alt extended code is as shown:
+}(*
+ Scan US Kbd Alt Scan US Kbd Alt
+ Code Legend Value Code Legend Value
+ ---- ------ ----- ---- ------ -----
+ 2 1 ! 120 15 Tab 165
+ 3 2 @ 121 26 [ { 26
+ 4 3 # 122 27 ] } 27
+ 5 4 $ 123 28 Enter 28
+ 6 5 % 124 39 ; : 39
+ 7 6 ^ 125 40 ' " 40
+ 8 7 & 126 41 ' ~ 41
+ 9 8 * 127 43 \ | 43 (equals W.T.C. key number 42)
+ 10 9 ( 128 51 , < 51
+ 11 0 ) 129 52 . > 52
+ 12 - _ 130 53 / ? 53
+ 13 = + 131
+*){
+ The secondary / key returns an extended character of 164 when
+ pressed while Alt is down.
+
+ - FuncKey. Defined in Note 2.
+
+ - SpecCtlKey. The Alt+ values of the Escape, Backspace, and Enter keys
+ are extended characters equaling 1, 14, and 28 (decimal), respectively.
+
+ When AltGraphics is used, the Char3 value is returned if it is nonzero and if
+ an AltGraf bit is set in XTableFlags1. Otherwise, it is treated the same as
+ the Alt key.
+
+* Note 8
+
+ Accent Key. When an accent key is pressed with Ctrl or Alt, it is treated as
+ a regular key. The character it translates to is the one in the CtlAccent or
+ AltAccent field of the AccentEntry pointed to by the Char5 value of the
+ KeyDef. If the key being defined has no defined value with Ctrl or Alt, it
+ should have zeros in the field of the undefined combination.
+
+ When an accent key is pressed by itself (or with Right Shift, Left Shift, or
+ AltGraphics), it is not translated immediately. The Char1 (or Char2, when
+ Left or Right Shift or AltGraphics is used) index in the KeyDef record is
+ used with the next key received to check if the next key has an accent
+ mapping. If that next key has no mapping for this accent (that is, if it has
+ no bit set in its AccentFlags), or if that next key is not found in this
+ accent's AccentEntry, then the character value in the NonAccent field of the
+ AccentEntry is used as the character to display. It is followed by the
+ translation of that next key after the not-an-accent beep is sounded.
+
+ Notice that if a key doesn't change when a Left or Right Shift key is
+ pressed, it should use the same value for Char1 and Char2 so the accent
+ applies in both the shifted and nonshifted cases. If the accent value is
+ undefined when used with a shift key or AltGraphics, the value in Char2 or
+ Char3 should be 0.
+
+ Any accent key that doesn't have an Alt or Ctrl mapping should put zeros in
+ the AltAccent and CtlAccent fields of its AccentEntry. If the value in the
+ table is between 1 and 7, then the key is considered an accent key and
+ further accent key processing is indicated. See Note 1 for more information.
+
+* Note 9
+
+ Extended State Key. For special Country support, the keyboard device
+ driver maintains another byte of shift status. Key types 12h and 13h are
+ provided for manipulation of that byte. The other fields of the KeyDef are:
+
+ - Char1. A mask in which bits that are on define the field being used for
+ the Char2 value. Only bits in the NLS shift status byte that correspond
+ to the bits in this byte are altered by the Char2 value.
+
+ - Char2. For KeyType 12h (Extended Shift), the value to OR into the
+ byte when the make code is seen. Also, the inverted value is ANDed
+ when the break code is seen. For KeyType 13h (Extended Toggle), the
+ value XORed into the byte on each make code seen (break code
+ ignored).
+
+ - Char3. Use in place of the Char2 when the secondary key prefix (hex
+ E0) is seen immediately prior to this key.
+
+ For example, Char1 or Char2 can define single shift status bits to
+ set/clear/toggle. Char2 can be a set of coded bits, delineated by Char1, that
+ are set to a numeric value when the key is pressed and cleared to zero
+ when released (or on the next press, if toggled). The whole byte can be
+ set to Char2 when Char1 has all bits on.
+
+* Note 10
+
+ Space Key. The key treated as the space character should have a flag set
+ in its AccentFlags field for each possible accent (that is, for each defined
+ AccentEntry in the AccentTable). And each AccentEntry should have the
+ Space character defined as one of its accented characters, with the
+ translation having the same value as the accent character itself. The reason
+ for this is that, by definition, an Accent Key followed by the space
+ character maps to the accent character alone. If the table is not set up as
+ just described, a not-an-accent beep is sounded whenever the accent key
+ followed by a space is pressed.
+
+ Notice that the space key is defined as a SpecKeyA (type 4) because its
+ use, in conjunction with the Alt key, is allowed. In this case, and when
+ used with the Ctrl key, it returns the ASCII space character. This works
+ correctly, except in the case of the diaresis accent (double-dot) in code
+ page 437. The space is treated as an invalid character and the beep result
+ occurs, with the diaresis represented by double quotation marks. The
+ characters displayed depend upon the language in effect when the invalid
+ diaresis is encountered. For some languages, the character substituted is
+ the double-quotation marks; for others, the character used is the F9h
+ character.
+
+* Note 11
+
+ KbdType identifies the hardware-specific keyboard used by this table. The
+ values and allowable types are the same as those specified in IOCTL call
+ KBD_GETKEYBDTYPE (1 means extended keyboard, which is used for all common
+ keyboard types).
+
+* Note 12
+
+ The DefaultTable flag in XtableFlags1 is used by the KEYB utility in loading
+ code pages when changing from one language to another. It identifies the
+ default code page to KEYB, should KEYB not find one or both CODEPAGE=
+ defined code pages.
+
+* Note 13
+
+ The Language IDs and Subcountry IDs used are as follows:
+
+ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
+ ³Keyboard Layout ³Keyboard Layout ³Country ³
+ ³Country Code ³SubCountry Code ³ ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ AR ³ 785 ³Arabic-speaking ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ BE ³ 120 ³Belgium ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ CF ³ 058 ³Canadian-French ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ CS ³ 243 ³Czech Republic ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ CS ³ 245 ³Czech Republic ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ DK ³ 159 ³Denmark ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ SU ³ 153 ³Finland ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ FR ³ 120 ³France ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ FR ³ 189 ³France ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ GR ³ 129 ³Germany ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ HE ³ 972 ³Hebrew-speaking ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ HU ³ 208 ³Hungary ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ IS ³ 197 ³Iceland ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ IT ³ 141 ³Italy ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ IT ³ 142 ³Italy ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ LA ³ 171 ³Latin-American ³
+ ³ ³ ³Spanish ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ NL ³ 143 ³Netherlands ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ NO ³ 155 ³Norway ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ PL ³ 214 ³Poland ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ PO ³ 163 ³Portugal ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ SP ³ 172 ³Spain ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ SV ³ 153 ³Sweden ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ SF ³ 150F ³Swiss-French ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ SG ³ 150G ³Swiss-German ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ TR ³ 179 ³Turkey ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ UK ³ 166 ³United Kingdom ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ UK ³ 168 ³United Kingdom ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ US ³ 103 ³United States ³
+ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+ ³ YU ³ 234 ³Former Yugoslavia ³
+ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
+
+* Note 14
+
+ Keytype 15. When the Alt or Alt+Shift keys are pressed, both XlatedChar
+ and XlatedScan in the CharData record will have the same value.
+
+* Note 15
+
+ If the Charx value is in the range of 1-7, then Charx identifies an accent
+ key. Otherwise, Charx is treated as a valid ASCII character. This does not
+ apply to Ctrl+Charx sequences.
+
+ Note 16
+
+ If Alt+Gr, Alt+Shift, or Alt+Ctrl are pressed, and Char3 is 0, the Alt key is
+ used to translate to a valid result.
+
+ Note 17
+
+ The * key on the keypad of the Enhanced keyboard, although producing the
+ same scan code/character as that of the IBM Personal Computer AT*
+ keyboard, is treated differently because a dedicated Print Screen key exists
+ on the Enhanced keyboard. The following scan codes/characters are
+ returned by the physical keyboard device driver for the Enhanced keyboard
+ * key on the keypad:
+
+ Unshifted 37H/2AH
+ Shifted 37H/2AH
+ Ctrl 96H/00
+ Alt 37H/00
+
+* Note 18
+
+ Size. The code page described here has the following dimensions:
+
+ Xlate Header = 40
+ 127 KeyDefs @ 7 bytes = 889
+ 7 AccentEntries @ 46 bytes = 322
+ ----
+ 1251 bytes
+
+ If more than 6 AccentEntries are needed, then the following format is used:
+ In the first 6 AccentEntries, the length is set at 20, with unused elements
+ set to zero. For each AccentEntry of 7 and greater, up to 120 element pairs
+ may exist, and the length is dynamic.
+
+ For each AccentEntry of 7 and greater, the first byte in the record will
+ contain the LENGTH of the AccentEntry record. The LENGTH value is defined
+ as the total length in bytes of the AccentEntry record including the LENGTH
+ byte.
+
+ The record is defined as follows:
+
+ AccEnt <l,a,b,c,d,e,f,c1,s1,c2,s2..c120,s120>
+ where....
+ l is the total length in bytes of the AccEnt including itself.
+ a &b are the scan code &char to use when the key following this accent
+ is not affected by the accent so the accent itself must be used.
+ c &d are the scan code &char to use when Ctl+[accent] is pressed.
+ e &f do the same for Alt+[accent].
+ c1,s1 - c120,s120 are the char/scan code mapping for accented translation.
+
+ Adding more than 7 accents will make the standard 1251-byte table an
+ extended variable size.
+}
+
+
+
+{Register a keyboard subsystem within a session.}
+{ModuleName - dynamic link module name, maximum length is 8 bytes, ProcName is
+a dynamic link entry point name of a routine that receives control when any of
+the registered functions are called. Maximum length is 32 bytes, FnMask - see
+KR_* constants}
+{Possible return codes:
+ 0 No_Error
+ 408 Error_Kbd_Invalid_ASCIIZ
+ 409 Error_Kbd_Invalid_Mask
+ 410 Error_Kbd_Register
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* There can be only one KbdRegister call outstanding for each session without
+ an intervening KbdDeRegister. KbdDeRegister must be issued by the same
+ process that issued the KbdRegister.}
+function KbdRegister(ModuleName,ProcName:PChar;FnMask:cardinal):word; cdecl;
+function KbdRegister(ModuleName,ProcName:string;FnMask:cardinal):word;
+
+{Deregister a keyboard subsystem previously registered within a session - only
+the process that issued the KbdRegister may issue KbdDeRegister.}
+{Possible return codes:
+ 0 No_Error
+ 411 Error_Kbd_Deregister
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+function KbdDeRegister:word; cdecl;
+
+{Return a character data record from the keyboard.}
+{Key - see TKbdKeyInfo record type, WaitFlag - see IO_Wait and IO_NoWait
+constants, KbdHandle is the default keyboard (0) or a logical keyboard.}
+{Possible return codes are:
+ 0 No_Error
+ 375 Error_Kbd_Invalid_IOWait
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* On an enhanced keyboard, the secondary enter key returns the normal
+ character 0Dh and a scan code of E0h.
+* Double-byte character codes (DBCS) require two function calls to obtain the
+ entire code.
+* If shift report is set with KbdSetStatus, the CharData record returned
+ reflects changed shift information only.
+* Extended ASCII codes are identified with the status byte, bit 1 on and the
+ ASCII character code being either 00h or E0h. Both conditions must be
+ satisfied for the character to be an extended keystroke. For extended
+ ASCII codes, the scan code byte returned is the second code (extended
+ code). Usually the extended ASCII code is the scan code of the primary key
+ that was pressed.
+* A thread in the foreground session that repeatedly polls the keyboard with
+ KbdCharIn (with no wait), can prevent all regular priority class threads
+ from executing. If polling must be used and a minimal amount of other
+ processing is being performed, the thread should periodically yield to the
+ CPU by issuing a DosSleep call for an interval of at least 5 milliseconds.}
+function KbdCharIn(var Key:TKbdKeyInfo;WaitFlag,KbdHandle:word):word; cdecl;
+
+{Return any available character data record from the keyboard
+without removing it from the buffer.}
+{Key - see TKbdKeyInfo record type, KbdHandle is the default keyboard (0)
+or a logical keyboard.}
+{Possible return codes are:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* On an enhanced keyboard, the secondary enter key returns the normal
+ character 0Dh and a scan code of E0h.
+* Double-byte character codes (DBCS) require two function calls to obtain the
+ entire code.
+* If shift report is set with KbdSetStatus the CharData record returned,
+ reflects changed shift information only.
+* Extended ASCII codes are identified with the status byte, bit 1 on and the
+ ASCII character code being either 00h or E0h. Both conditions must be
+ satisfied for the character to be an extended keystroke. For extended
+ ASCII codes, the scan code byte returned is the second code (extended
+ code). Usually the extended ASCII code is the scan code of the primary key
+ that was pressed.
+* A thread in the foreground session that repeatedly polls the keyboard with
+ KbdCharIn (with no wait), can prevent all regular priority class threads
+ from executing. If polling must be used and a minimal amount of other
+ processing is being performed, the thread should periodically yield the CPU
+ by issuing a DosSleep call for an interval of at least 5 milliseconds.}
+function KbdPeek(var Key:TKbdKeyInfo;KbdHandle:word):word; cdecl;
+
+{Read a character string (character codes only) from the keyboard.}
+{CharBuf is a buffer for returned characters, LenInOut - see TStringInBuf
+record type, WaitFlag - see IO_Wait and IO_NoWait constants, KbdHandle is the
+default keyboard (0) or a logical keyboard.}
+{Possible return codes are:
+ 0 No_Error
+ 375 Error_Kbd_Invalid_IOWait
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* The character strings may be optionally echoed on the display if echo mode
+ is set. When echo is on each character is echoed as it is read from the
+ keyboard. Echo mode and binary mode are mutually exclusive. Reference
+ KbdSetStatus and KbdGetStatus for more information.
+* The default input mode is ASCII. In ASCII mode, 2-byte character codes only
+ return in complete form. An extended ASCII code is returned in a 2-byte
+ string. The first byte is 0Dh or E0h and the next byte is an extended code.
+* In input mode (binary, ASCII), the following returns can be set and
+ retrieved with KbdSetStatus and KbdGetStatus:
+ Turnaround Character
+ Echo Mode
+ Interim Character Flag
+ Shift State
+* The received input length is also used by the KbdStringIn line edit
+ functions for re-displaying and entering a caller specified string. On the
+ next KbdStringIn call the received input length indicates the length of the
+ input buffer that may be recalled by the user using the line editing keys.
+ A value of 0 inhibits the line editing function for the current KbdStringIn
+ request.
+* KbdStringIn completes when the handle has access to the physical keyboard
+ (focus), or is equal to zero and no other handle has the focus.}
+function KbdStringIn(var CharBuf;var LenInOut:TStringInBuf;WaitFlag:word;
+ KbdHandle:word):word; cdecl;
+function KbdStringIn(CharBuf:PChar;LenInOutP:PStringInBuf;WaitFlag:word;
+ KbdHandle:word):word; cdecl;
+
+{Clear the keystroke buffer.}
+{KbdHandle is the default keyboard (0) or a logical keyboard.}
+{Possible return codes are:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* KbdFlushBuffer completes when the handle has access to the physical
+ keyboard (focus), or is equal to zero and no other handle has the focus.}
+function KbdFlushBuffer(KbdHandle:word):word; cdecl;
+
+{Set the characteristics of the keyboard.}
+{Status - see TKbdInfo record type, KbdHandle is the default keyboard (0) or
+a logical keyboard.}
+{Possible return codes are:
+ 0 No_Error
+ 376 Error_Kbd_Invalid_length
+ 377 Error_Kbd_Invalid_Echo_Mask
+ 378 Error_Kbd_Invalid_Input_Mask
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* Shift return (bit 8 in sysstate) must be disabled in ASCII mode.
+* KbdSetStatus is ignored for a Vio-windowed application.}
+function KbdSetStatus(var Status:TKbdInfo;KbdHandle:word):word; cdecl;
+
+{Get the current state of the keyboard.}
+{Status - see TKbdInfo record type, KbdHandle is the default keyboard (0) or
+a logical keyboard.}
+{Possible return codes:
+ 0 No_Error
+ 376 Error_Kbd_Invalid_Length
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* The initial state of the keyboard is established by the system at
+ application load time. Some default states may be modified by the
+ application through KbdSetStatus. KbdGetStatus returns only those keyboard
+ parameters initially set by KbdSetStatus. The returned parameters are:
+ Input Mode, Interim Character Flags, Shift State, Echo State, TurnAround
+ Character
+* KbdGetStatus completes only when the handle has access to the physical
+ keyboard (focus) or the handle is 0 and no other handle has the focus.}
+function KbdGetStatus(var Status:TKbdInfo;KbdHandle:word):word; cdecl;
+
+{Set the code page used to translate key strokes received from the keyboard for
+current process.}
+{Reserved - reserved, must be set to 0, CodePage - code-page ID in the
+application's data area, must be equivalent to one of the code-page IDs
+specified on the CONFIG.SYS CODEPAGE= statement or 0, an error results
+otherwise, KbdHandle is the default keyboard (0) or a logical keyboard.}
+{Possible return codes:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 448 Error_Kbd_Invalid_CodePage
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* Keyboard code page support is not available without the DEVINFO=KBD
+ statement in the CONFIG.SYS file.}
+function KbdSetCp(Reserved,CodePage,KbdHandle:word):word; cdecl;
+
+{Query the code page being used to translate scan codes to ASCII characters.}
+{Reserved must be set to 0. The keyboard support returns the current code
+page for a specified keyboard handle in CodePage, it is one of the code page
+IDs specified in the CONFIG.SYS CODEPAGE= statement or 0000. KbdHandle is
+the default keyboard (0) or a logical keyboard.}
+{Possible return codes:
+ 0 No_Error
+ 373 Error_Kbd_Parameter
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* CodePage is set to the currently active keyboard code page. A value of 0
+ indicates the code page translation table in use is the ROM code page
+ translation table provided by the hardware.}
+function KbdGetCp(Reserved:cardinal;var CodePage:word;KbdHandle:word):word;
+ cdecl;
+
+{Create a new logical keyboard.}
+{Handle for the new logical keyboard returned in KbdHandle.}
+{Possible return codes:
+ 0 No_Error
+ 440 Error_Kbd_No_More_Handle
+ 441 Error_Kbd_Cannot_Create_KCB
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* KbdOpen blocks while another thread has the keyboard focus (by way of
+ KbdGetFocus) until the thread with the focus issues KbdFreeFocus.
+ Therefore, to prevent KbdOpen from blocking, it is recommended that KbdOpen
+ be issued only while the current thread has the focus. For example:
+ KbdGetFocus wait until focus available on handle 0
+ KbdOpen get a logical keyboard handle
+ KbdFreeFocus give up the focus on handle 0}
+function KbdOpen(var KbdHandle:word):word; cdecl;
+
+{Close the existing logical keyboard identified by the keyboard handle}
+{KbdHandle is the default keyboard (0) or a logical keyboard}
+{Possible return codes:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* KbdClose blocks while another thread has the keyboard focus (by way of
+ KbdGetFocus) until the thread with the focus issues KbdFreeFocus.
+ Therefore, to prevent KbdClose from blocking, it is recommended that
+ KbdClose be issued only while the current thread has the focus. For
+ example:
+ KbdGetFocus wait until focus available on handle 0
+ KbdClose close a logical keyboard handle
+ KbdFreeFocus give up the focus on handle 0}
+function KbdClose(KbdHandle:word):word; cdecl;
+
+{Bind the logical keyboard to the physical keyboard.}
+{KbdHandle is the default keyboard (0) or a logical keyboard}
+{Possible return codes:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+function KbdGetFocus(WaitFlag,KbdHandle:word):word; cdecl;
+
+{Free the logical-to-physical keyboard bond created by KbdGetFocus.}
+{KbdHandle is the default keyboard (0) or a logical keyboard}
+{Possible return codes:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* KbdFreeFocus may be replaced by issuing KbdRegister. Unlike other keyboard
+ subsystem functions, the replaced KbdFreeFocus is called only if there is
+ an outstanding focus.}
+function KbdFreeFocus(KbdHandle:word):word; cdecl;
+
+{Synchronize access from a keyboard subsystem to the keyboard device driver.}
+{WaitFlag - see IO_Wait and IO_NoWait constants (wait / don't wait for access
+to the device driver.}
+{Possible return codes:
+ 0 No_Error
+ 121 Error_Sem_TimeOut}
+{Remarks:
+* KbdSynch blocks all other threads within a session until return from the
+ subsystem to the router. To ensure proper synchronization, KbdSynch should
+ be issued by a keyboard subsystem if it intends to issue a DosDevIOCtl or
+ access dynamically shared data. KbdSynch does not protect globally shared
+ data from threads in other sessions.}
+function KbdSynch (WaitFlag:word):word; cdecl;
+
+{Raise the priority of the foreground keyboard's thread.}
+{Possible return codes:
+ 0 No_Error
+ 447 Error_Kbd_Keyboard_Busy
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* KbdSetFgnd marks the current process that owns the keyboard. Threads in
+ this process receive a priority boost. The previous foreground keyboard
+ threads lose their priority boost.
+* This function should only be issued by a Keyboard Subsystem during
+ KbdCharIn or KbdStringIn processing.}
+function KbdSetFgnd:word; cdecl;
+
+{Return the attached keyboard's hardware-generated identification value.}
+{HWID is a pointer to the caller's data area, see TKbdHWID, KbdHandle is the
+default keyboard (0) or a logical keyboard.}
+{Possible return codes:
+ 0 No_Error
+ 373 Error_Kbd_Parameter
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* In past OS/2 releases, all keyboards could be supported by knowing the
+ hardware family information available with keyboard IOCTL 77h. However,
+ with the addition of the 122-key keyboard, recognition was not containable
+ by hardware family information alone. The 122-key keyboard has a number of
+ differences from other keyboards. Therefore, applications performing
+ keystroke specific functions may need to determine specifically which
+ keyboard is attached.
+* This function is of particular usefulness for applications providing Custom
+ Translate Tables and mapping keyboard layouts.}
+function KbdGetHWID(var HWID:TKbdHWID;KbdHandle:word):word; cdecl;
+
+{Undocumented in official IBM documentation}
+function KbdSetHWID(var HWID:TKbdHWID;KbdHandle:word):word; cdecl;
+function KbdSetHWID(HWIDP:PKbdHWID;KbdHandle:word):word; cdecl;
+
+{Translate scan codes with shift states into ASCII codes.}
+{TransData - see TKbdTransData, KbdHandle is the default keyboard (0) or a
+logical keyboard.}
+{Possible return codes:
+ 0 No_Error
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* It may take several calls to complete a translation because of accent key
+ combinations, or other complex operations.
+* The fsShift and sZero are for use by the keyboard translation routines.
+ These fields are reserved and must only be accessed by the caller prior
+ to starting a translation sequence and then they must be set to zero.
+ The KbdXlate function is intended to be used for translating a particular
+ scan code for a given shift state. The KbdXlate function is not intended
+ to be a replacement for the OS/2 system keystroke translation function.}
+function KbdXlate(var TransData:TKbdTrans;KbdHandle:word):word; cdecl;
+
+{Install, on the specified handle, the translate table which this call points
+to. This translate table affects only this handle.}
+{XLateTbl is the translation table used to translate scan code to ASCII code
+for a specified handle (the format of the translation table is documented in
+the Set Code Page IOCTL 50h), KbdHandle is the default keyboard (0) or a
+logical keyboard.}
+{Possible return codes:
+ 0 No_Error
+ 377 Error_Kbd_Invalid_Echo_Mask
+ 378 Error_Kbd_Invalid_Input_Mask
+ 439 Error_Kbd_Invalid_Handle
+ 445 Error_Kbd_Focus_Required
+ 447 Error_Kbd_Keyboard_Busy
+ 464 Error_Kbd_Detached
+ 504 Error_Kbd_Extended_SG}
+{Remarks:
+* The translate table must be maintained in the caller's memory. No copy of
+ the translate table is made by KbdSetCustXt.
+* KbdSetCp reverses the action of KbdSetCustXt and sets the handle equal to
+ one of the system translate tables. If memory is dynamically allocated by
+ the caller for the translate table and is freed before the KbdSetCp is
+ performed, KbdSetCp and future translations may fail.}
+function KbdSetCustXt(var XLateTbl:TXLateTbl;KbdHandle:word):word; cdecl;
+function KbdSetCustXt(var CodePage:word;KbdHandle:word):word; cdecl;
+function KbdSetCustXt(var XLateTblP:pointer;KbdHandle:word):word; cdecl;
+
+
+(* Following routines are not supported
+ (just have a look in some C header
+ file - you probably won't find it there either).
+KbdInit (index 2)
+KbdLoadInstance (index 6)
+KbdSwitchFgnd (index 15)
+KbdShellInit (index 16)
+KbdFree (index 19)
+*)
+
+
+{***************************************************************************}
+implementation
+{***************************************************************************}
+
+
+function KbdRegister(ModuleName,ProcName:PChar;FnMask:cardinal):word; cdecl;
+external 'EMXWRAP' index 208;
+{external 'KBDCALLS' index 8;}
+
+function KbdRegister(ModuleName,ProcName:string;FnMask:cardinal):word;
+begin
+ if byte(ModuleName[0])>8 then byte(ModuleName[0]):=8;
+ ModuleName[Succ(byte(ModuleName[0]))]:=#0;
+ if byte(ProcName[0])>32 then byte(ProcName[0]):=32;
+ ProcName[Succ(byte(ProcName[0]))]:=#0;
+ KbdRegister:=KbdRegister(@ModuleName[1],@ProcName[1],FnMask);
+end;
+
+function KbdDeRegister:word; cdecl;
+external 'EMXWRAP' index 220;
+{external 'KBDCALLS' index 20;}
+
+function KbdCharIn(var Key:TKbdKeyInfo;WaitFlag,KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 204;
+{external 'KBDCALLS' index 4;}
+
+function KbdPeek(var Key:TKbdKeyInfo;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 222;
+{external 'KBDCALLS' index 22;}
+
+function KbdStringIn(var CharBuf;var LenInOut:TStringInBuf;WaitFlag:word;
+ KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 209;
+{external 'KBDCALLS' index 9;}
+
+function KbdStringIn(CharBuf:PChar;LenInOutP:PStringInBuf;WaitFlag:word;
+ KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 209;
+{external 'KBDCALLS' index 9;}
+
+function KbdFlushBuffer(KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 213;
+{external 'KBDCALLS' index 13;}
+
+function KbdSetStatus(var Status:TKbdInfo;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 211;
+{external 'KBDCALLS' index 11;}
+
+function KbdGetStatus(var Status:TKbdInfo;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 210;
+{external 'KBDCALLS' index 10;}
+
+function KbdSetCp(Reserved,CodePage,KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 205;
+{external 'KBDCALLS' index 5;}
+
+function KbdGetCp(Reserved:cardinal;var CodePage:word;KbdHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 203;
+{external 'KBDCALLS' index 3;}
+
+function KbdOpen(var KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 223;
+{external 'KBDCALLS' index 23;}
+
+function KbdClose(KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 217;
+{external 'KBDCALLS' index 17;}
+
+function KbdGetFocus(WaitFlag,KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 212;
+{external 'KBDCALLS' index 12;}
+
+function KbdFreeFocus(KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 218;
+{external 'KBDCALLS' index 18;}
+
+function KbdSynch (WaitFlag:word):word; cdecl;
+external 'EMXWRAP' index 207;
+{external 'KBDCALLS' index 7;}
+
+function KbdSetFgnd:word; cdecl;
+external 'EMXWRAP' index 221;
+{external 'KBDCALLS' index 21;}
+
+function KbdGetHWID(var HWID:TKbdHWID;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 224;
+{external 'KBDCALLS' index 24;}
+
+function KbdSetHWID(var HWID:TKbdHWID;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 225;
+{external 'KBDCALLS' index 25;}
+
+function KbdSetHWID(HWIDP:PKbdHWID;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 225;
+{external 'KBDCALLS' index 25;}
+
+function KbdXlate(var TransData:TKbdTrans;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 214;
+{external 'KBDCALLS' index 14;}
+
+function KbdSetCustXt(var XLateTbl:TXLateTbl;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 201;
+{external 'KBDCALLS' index 1;}
+
+function KbdSetCustXt(var CodePage:word;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 201;
+{external 'KBDCALLS' index 1;}
+
+function KbdSetCustXt(var XLateTblP:pointer;KbdHandle:word):word; cdecl;
+external 'EMXWRAP' index 201;
+{external 'KBDCALLS' index 1;}
+
+
+end.
+
+{
+ $Log: kbdcalls.pas,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/keyboard.pp b/rtl/os2/keyboard.pp
new file mode 100644
index 0000000000..3dd1fe1e1f
--- /dev/null
+++ b/rtl/os2/keyboard.pp
@@ -0,0 +1,136 @@
+{
+ $Id: keyboard.pp,v 1.7 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Keyboard unit for OS/2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Keyboard;
+interface
+
+{$i keybrdh.inc}
+
+implementation
+
+uses
+ KbdCalls, DosCalls;
+
+{$i keyboard.inc}
+
+const
+ DefaultKeyboard = 0;
+ Handle: word = DefaultKeyboard;
+
+procedure SysInitKeyboard;
+var
+ K: TKbdInfo;
+begin
+ if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
+ begin
+ if KbdOpen (Handle) <> No_Error then
+ Handle := DefaultKeyboard;
+ KbdFlushBuffer (Handle);
+ KbdFreeFocus (DefaultKeyboard);
+ KbdGetFocus (IO_Wait, Handle);
+ K.cb := SizeOf (K);
+ KbdGetStatus (K, Handle);
+ K.fsMask := $14;
+ KbdSetStatus (K, Handle);
+ end;
+end;
+
+procedure SysDoneKeyboard;
+begin
+ KbdFreeFocus (Handle);
+ if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
+ begin
+ KbdClose (Handle);
+ Handle := DefaultKeyboard;
+ KbdFreeFocus (DefaultKeyboard);
+ end;
+end;
+
+function SysGetKeyEvent: TKeyEvent;
+var
+ K: TKbdKeyInfo;
+begin
+ KbdGetFocus (IO_Wait, Handle);
+ while (KbdCharIn (K, IO_Wait, Handle) <> No_Error)
+ or (K.fbStatus and $40 = 0) do
+ DosSleep (5);
+ with K do
+ begin
+ if (byte (chChar) = $E0) and (fbStatus and 2 <> 0) then chChar := #0;
+ SysGetKeyEvent := cardinal ($0300 or fsState and $F) shl 16 or
+ cardinal (byte (chScan)) shl 8 or byte (chChar);
+ end;
+end;
+
+function SysPollKeyEvent: TKeyEvent;
+var
+ K: TKbdKeyInfo;
+ Key : TKeyEvent;
+
+begin
+ Key:=0;
+ KbdGetFocus (IO_NoWait, Handle);
+ if (KbdPeek (K, Handle) <> No_Error) or
+ (K.fbStatus and $40 = 0) then
+ FillChar (K, SizeOf (K), 0)
+ else
+ with K do
+ begin
+ if (byte (chChar) = $E0) and (fbStatus and 2 <> 0) then
+ chChar := #0;
+ Key:= cardinal ($0300 or fsState and $F) shl 16 or
+ cardinal (byte (chScan)) shl 8 or byte (chChar);
+ end;
+ if (Key and $FFFF)=0 then
+ Key := 0;
+ SysPollKeyEvent:=Key;
+end;
+
+function SysGetShiftState: Byte;
+
+var
+ K: TKbdInfo;
+ L: cardinal;
+begin
+ KbdGetFocus (IO_NoWait, Handle);
+ K.cb := SizeOf (K);
+ if KbdGetStatus (K, Handle) = No_Error then
+ SysGetShiftState := (K.fsState and $F)
+ else
+ SysGetShiftState := 0;
+end;
+
+Const
+ SysKeyboardDriver : TKeyboardDriver = (
+ InitDriver : @SysInitKeyBoard;
+ DoneDriver : @SysDoneKeyBoard;
+ GetKeyevent : @SysGetKeyEvent;
+ PollKeyEvent : @SysPollKeyEvent;
+ GetShiftState : @SysGetShiftState;
+ TranslateKeyEvent : Nil;
+ TranslateKeyEventUnicode : Nil;
+ );
+
+
+begin
+ SetKeyBoardDriver(SysKeyBoardDriver);
+end.
+{
+ $Log: keyboard.pp,v $
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/moncalls.pas b/rtl/os2/moncalls.pas
new file mode 100644
index 0000000000..7e05294c2d
--- /dev/null
+++ b/rtl/os2/moncalls.pas
@@ -0,0 +1,281 @@
+{Set tabsize to 4.}
+{****************************************************************************
+
+ $Id: moncalls.pas,v 1.4 2005/02/14 17:13:31 peter Exp $
+
+ MONCALLS interface unit
+ Free Pascal Runtime Library for OS/2
+ Copyright (c) 1999-2000 by Florian Kl„mpfl
+ Copyright (c) 1999-2000 by Daniel Mantione
+ Copyright (c) 1999-2000 by Tomas Hajny
+
+ The Free Pascal runtime library is distributed under the Library GNU Public
+ License v2. So is this unit. The Library GNU Public License requires you to
+ distribute the source code of this unit with any product that uses it.
+ Because the EMX library isn't under the LGPL, we grant you an exception to
+ this, and that is, when you compile a program with the Free Pascal Compiler,
+ you do not need to ship source code with that program, AS LONG AS YOU ARE
+ USING UNMODIFIED CODE! If you modify this code, you MUST change the next
+ line:
+
+ <This is an official, unmodified Free Pascal source code file.>
+
+ Send us your modified files, we can work together if you want!
+
+ Free Pascal is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ Library GNU General Public License for more details.
+
+ You should have received a copy of the Library GNU General Public License
+ along with Free Pascal; see the file COPYING.LIB. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+****************************************************************************}
+
+unit MonCalls;
+
+{ Interface library to MONCALLS.DLL (through EMXWRAP.DLL)
+
+Please, note, that monitors are supported for OS/2 v2.1 and above only
+(not for v2.0) and that they cannot be used in PM applications.
+
+Changelog:
+
+ People:
+
+ TH - Tomas Hajny
+
+ Date: Description of change: Changed by:
+
+ - First released version 1.0 TH
+
+Coding style:
+
+ I have tried to use the same coding style as Daniel Mantione in unit
+ DOSCALLS, although I can't say I would write it the same way otherwise
+ (I would write much more spaces myself, at least). Try to use it as well,
+ please. Original note by Daniel Mantione follows:
+
+
+ It may be well possible that coding style feels a bit strange to you.
+ Nevertheless I friendly ask you to try to make your changes not look all
+ to different. To make life easier, set your IDE to use tab characters,
+ turn optimal fill, autoindent and backspace unindents on and set a
+ tabsize of 4.}
+
+{***************************************************************************}
+interface
+{***************************************************************************}
+
+{$IFDEF FPC}
+ {$PACKRECORDS 1}
+{$ENDIF FPC}
+
+const
+{return codes / error constants (those marked with * shouldn't occur)}
+ No_Error = 0;
+ Error_Not_Enough_Memory = 8;
+ Error_Open_Failed = 110;
+ Error_Monitors_Not_Supported = 165;
+ Error_Mon_Invalid_Parms = 379;
+ Error_Mon_Invalid_DevName = 380;
+ Error_Mon_Invalid_Handle = 381;
+ Error_Mon_Buffer_Too_Small = 382;
+ Error_Mon_Buffer_Empty = 383;
+ Error_Mon_Data_Too_Large = 384;
+ Error_Mon_Bad_Buffer = 730; {*}
+ Error_Mon_Chain_Handle = 32784; {*}
+ Error_Mon_Not_Registered = 32785; {*}
+
+{WaitFlag}
+ IO_Wait =0; {The monitor thread that issues DosMonRead wishes to block}
+ {until a data record is available in its input buffer.}
+ IO_NoWait =1; {The monitor thread that issues DosMonRead does not wish}
+ {to block when its input buffer is empty.}
+
+
+{Terminate character device monitoring. All monitor buffers associated with
+this process are flushed and closed.}
+{MonHandle - device handle returned from a previous DosMonOpen call.}
+{Possible return codes:
+ 0 No_Error
+ 381 Error_Mon_Invalid_Handle}
+{Remarks:
+* A single process may register one or more monitors with a character device
+ using the same device handle returned from a previous DosMonOpen call.
+ When DosMonClose is issued for a specific, opened device handle, all
+ monitors for the current process registered with this handle terminate.
+* When DosMonClose is issued, the monitor loses access to the device data
+ stream. Before issuing DosMonClose, monitor threads calling DosMonRead and
+ DosMonWrite should be terminated. After DosMonClose has been called,
+ DosMonRead calls return an ERROR_MON_BUFFER_EMPTY return code and
+ DosMonWrite calls return an ERROR_NOT_ENOUGH_MEMORY return code.
+* Data area containing monitor buffers should not be freed until after
+ DosMonClose is called. If data area containing monitor buffers is freed
+ before DosMonClose is called, a GP fault occurs when DosMonClose is called
+ and the process is terminated.
+* For a detailed description of this call see the chapter "Character Device
+ Monitors" in the IBM Operating System/2 Version 1.2 I/O Subsystems And
+ Device Support Volume 1.}
+function DosMonClose(MonHandle:word):word; cdecl;
+
+{Gain access to a character device data stream.}
+{DevName - device name, monitor handle returned in MonHandle.}
+{Possible return codes:
+ 0 No_Error
+ 110 Error_Open_Failed
+ 379 Error_Mon_Invalid_Parms
+ 380 Error_Mon_Invalid_DevName}
+{Remarks:
+* Only one DosMonOpen call is necessary per device per process. That is,
+ several DosMonReg calls can be made using the same monitor handle to the
+ same device. This allows monitors to be registered using different values
+ for Index from the same process and going to the same device. When the
+ DosMonClose is issued, all of the monitors registered on the handle are
+ closed.
+* For a detailed description of this call see the chapter "Character Device
+ Monitors" in the IBM Operating System/2 Version 1.2 I/O Subsystems And
+ Device Support Volume 1.}
+function DosMonOpen(DevName:PChar;var MonHandle:word):word; cdecl;
+function DosMonOpen(DevName:string;var MonHandle:word):word;
+
+{Wait for a data record, move it from the input buffer of a registered
+character device monitor and place it in a private data area where the monitor
+can freely access it.}
+{InBuf - monitor input buffer, WaitFlag - see IO_WAIT and IO_NOWAIT constants,
+DataBuf - data area in the calling process address space that the data from the
+monitor's input buffer is read into, ByteCount - on input size of the DataBuf,
+on return number of bytes of data moved.}
+{Possible return codes:
+ 0 No_Error
+ 379 Error_Mon_Invalid_Parms
+ 382 Error_Mon_Buffer_Too_Small
+ 383 Error_Mon_Buffer_Empty}
+{Remarks:
+* For a detailed description of this call see the chapter "Character Device
+ Monitors" in the IBM Operating System/2 Version 1.2 I/O Subsystems And
+ Device Support Volume 1.}
+function DosMonRead(var InBuf;WaitFlag:word;var DataBuf;
+ var ByteCount:word):word; cdecl;
+
+{Establish an input and output buffers to monitor an I/O stream for a character
+device.}
+{MonHandle - device handle returned from a previous DosMonOpen call, InBuf -
+monitor input buffer, the monitor dispatcher moves data records into this
+buffer from the device driver (if the monitor is the first one in the monitor
+chain) or from the previous monitor in the chain, monitor then takes data from
+this buffer for filtering by calling DosMonRead, OutBuf - monitor output
+buffer, monitor places filtered data into this buffer by calling DosMonWrite,
+the monitor dispatcher moves data records from this buffer to the device driver
+(if the monitor is the last one in the monitor chain) or to the next monitor in
+the chain, PosCode - used to specify placement of a monitor's buffers with the
+monitor chain (FIRST, LAST or DEFAULT) and whether one or two threads are
+created by the monitor dispatcher to handle data movement (see explanation
+bellow), Index - device specific value, for the keyboard it pertains to the
+session you wish to register a monitor on, for the printer it pertains to the
+data or code page monitor chain.}
+{Possible return codes:
+ 0 No_Error
+ 8 Error_Not_Enough_Memory
+ 165 Error_Monitors_Not_Supported
+ 379 Error_Mon_Invalid_Parms
+ 381 Error_Mon_Invalid_Handle
+ 382 Error_Mon_Buffer_Too_Small}
+{Remarks:
+* PosCode meaning:
+ 0 DEFAULT (no position preference) and one thread for data movement
+ 1 FIRST (monitor placed at beginning of monitor chain) and one thread for
+ data movement
+ 2 LAST (monitor placed at the end of monitor chain) and one thread for
+ data movement
+ 3 DEFAULT with two threads for data movement
+ 4 FIRST with two threads for data movement
+ 5 LAST with two threads for data movement
+ The first monitor in a monitor chain that registers as FIRST is placed at the
+ head of the monitor chain. The next monitor that registers as FIRST follows
+ the last monitor registered as FIRST, and so on. Similarly, the first monitor
+ that registers as LAST is placed at the end of the monitor chain. The next
+ monitor that registers as LAST is placed before the last monitor that
+ registered as LAST, and so on. The first monitor that registers as DEFAULT is
+ placed before the last monitor, if any, that registered as LAST. The next
+ monitor that registers as DEFAULT is placed before the last monitor that
+ registered as DEFAULT, and so on.
+* For a detailed description of this call see the chapter "Character Device
+ Monitors" in the IBM Operating System/2 Version 1.2 I/O Subsystems And
+ Device Support Volume 1.}
+function DosMonReg(MonHandle:word;var InBuf,OutBuf;PosCode,Index:word):word;
+ cdecl;
+
+{Move a filtered data record from the monitor's private data area into the
+monitor's output buffer.}
+{OutBuf - monitor output buffer, DataBuf - monitor's private data area
+containing a filtered data record of length ByteCount, this filtered data
+record is moved into the monitor's output buffer by this call, ByteCount - size
+of the data record.}
+{Possible return codes:
+ 0 No_Error
+ 8 Error_Not_Enough_Memory
+ 379 Error_Mon_Invalid_Parms
+ 384 Error_Mon_Data_Too_Large}
+{Remarks:
+* For a detailed description of the use of this call see the chapter
+ "Character Device Monitors" in the IBM Operating System/2 Version 1.2 I/O
+ Subsystems And Device Support Volume 1.}
+function DosMonWrite(var OutBuf,DataBuf;ByteCount:word):word; cdecl;
+
+
+{***************************************************************************}
+implementation
+{***************************************************************************}
+
+
+function DosMonClose(MonHandle:word):word; cdecl;
+external 'EMXWRAP' index 403;
+{external 'MONCALLS' index 3;}
+
+function DosMonOpen(DevName:PChar;var MonHandle:word):word; cdecl;
+external 'EMXWRAP' index 404;
+{external 'MONCALLS' index 4;}
+
+function DosMonOpen(DevName:string;var MonHandle:word):word;
+var
+ i : byte;
+begin
+ if DevName[0]=#255 then
+ begin
+ I:=byte(DevName[0]);
+ Move(DevName[1],DevName[0],255);
+ DevName[255]:=#0;
+ DosMonOpen:=DosMonOpen(@DevName,MonHandle);
+ end else
+ begin
+ DevName[Succ(byte(DevName[0]))]:=#0;
+ DosMonOpen:=DosMonOpen(@DevName[1],MonHandle);
+ end;
+end;
+
+function DosMonRead(var InBuf;WaitFlag:word;var DataBuf;
+ var ByteCount:word):word; cdecl;
+external 'EMXWRAP' index 402;
+{external 'MONCALLS' index 2;}
+
+function DosMonReg(MonHandle:word;var InBuf,OutBuf;PosCode,Index:word):word;
+ cdecl;
+external 'EMXWRAP' index 405;
+{external 'MONCALLS' index 5;}
+
+function DosMonWrite(var OutBuf,DataBuf;ByteCount:word):word; cdecl;
+external 'EMXWRAP' index 401;
+{external 'MONCALLS' index 1;}
+
+
+end.
+
+{
+ $Log: moncalls.pas,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/moucalls.pas b/rtl/os2/moucalls.pas
new file mode 100644
index 0000000000..cb3e84b762
--- /dev/null
+++ b/rtl/os2/moucalls.pas
@@ -0,0 +1,1096 @@
+{Set tabsize to 4.}
+{****************************************************************************
+
+ $Id: moucalls.pas,v 1.3 2005/02/14 17:13:31 peter Exp $
+
+ MOUCALLS interface unit
+ Free Pascal Runtime Library for OS/2
+ Copyright (c) 1999-2000 by Florian Kl„mpfl
+ Copyright (c) 1999-2000 by Daniel Mantione
+ Copyright (c) 1999-2000 by Tomas Hajny
+
+ The Free Pascal runtime library is distributed under the Library GNU Public
+ License v2. So is this unit. The Library GNU Public License requires you to
+ distribute the source code of this unit with any product that uses it.
+ Because the EMX library isn't under the LGPL, we grant you an exception to
+ this, and that is, when you compile a program with the Free Pascal Compiler,
+ you do not need to ship source code with that program, AS LONG AS YOU ARE
+ USING UNMODIFIED CODE! If you modify this code, you MUST change the next
+ line:
+
+ <This is an official, unmodified Free Pascal source code file.>
+
+ Send us your modified files, we can work together if you want!
+
+ Free Pascal is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ Library GNU General Public License for more details.
+
+ You should have received a copy of the Library GNU General Public License
+ along with Free Pascal; see the file COPYING.LIB. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+****************************************************************************}
+
+unit MouCalls;
+
+{ Interface library to MOUCALLS.DLL (through EMXWRAP.DLL; C calling convention
+ - cdecl - must be used for EMXWRAP, whereas direct MOUCALLS calls would need
+ 16-bit Pascal calling convention with thunking instead).
+
+Variant records and aliases for some record types created to maintain highest
+possible level of compatibility with other existing OS/2 compilers.
+
+Changelog:
+
+ People:
+
+ TH - Tomas Hajny (xhajt03@mbox.vol.cz on Internet)
+
+ Date: Description of change: Changed by:
+
+ - First released version 1.0 TH
+
+Coding style:
+
+ I have tried to use the same coding style as Daniel Mantione in unit
+ DOSCALLS, although I can't say I would write it the same way otherwise
+ (I would write much more spaces myself, at least). Try to use it as well,
+ please. Original note by Daniel Mantione follows:
+
+
+ It may be well possible that coding style feels a bit strange to you.
+ Nevertheless I friendly ask you to try to make your changes not look all
+ to different. To make life easier, set your IDE to use tab characters,
+ turn optimal fill, autoindent and backspace unindents on and set a
+ tabsize of 4.}
+
+{***************************************************************************}
+interface
+{***************************************************************************}
+
+{$IFDEF FPC}
+ {$PACKRECORDS 1}
+{$ENDIF FPC}
+
+const
+{return codes / error constants (those marked with * shouldn't occur under
+normal conditions)}
+ NO_ERROR = 0;
+ Error_Invalid_Parameter = 87;
+ ERROR_SEM_TIMEOUT =121;
+ ERROR_MOUSE_NO_DEVICE =385;
+ ERROR_MOUSE_INV_HANDLE =386; {*}
+ ERROR_MOUSE_INV_PARMS =387;
+ ERROR_MOUSE_CANT_RESET =388; {*}
+ ERROR_MOUSE_DISPLAY_PARMS =389; {*}
+ ERROR_MOUSE_INV_MODULE =390;
+ ERROR_MOUSE_INV_ENTRY_PT =391; {*}
+ ERROR_MOUSE_INV_MASK =392; {*}
+ NO_ERROR_MOUSE_NO_DATA =393;
+ NO_ERROR_MOUSE_PTR_DRAWN =394; {*}
+ ERROR_MOUSE_SMG_ONLY =412;
+ ERROR_MOUSE_INVALID_ASCIIZ =413;
+ ERROR_MOUSE_INVALID_MASK =414;
+ ERROR_MOUSE_REGISTER =415;
+ ERROR_MOUSE_DEREGISTER =416;
+ ERROR_MOUSE_INVALID_IOWAIT =435; {*}
+ ERROR_MOU_DETACHED =466;
+ ERROR_MOUSE_NO_CONSOLE =501;
+ ERROR_MOUSE_INVALID_HANDLE =502; {*}
+ ERROR_MOU_EXTENDED_SG =505;
+ ERROR_MOU_NOT_INITIALIZED =530; {*}
+ ERROR_MOUINITREAL_DONE =531; {*}
+ ERROR_MOUSE_CALLER_NOT_SUBSYS =533; {*}
+
+{constants for FnMask in MouRegister}
+ MR_MOUGETNUMBUTTONS =$00000001;
+ MR_MOUGETNUMMICKEYS =$00000002;
+ MR_MOUGETDEVSTATUS =$00000004;
+ MR_MOUGETNUMQUEEL =$00000008;
+ MR_MOUREADEVENTQUE =$00000010;
+ MR_MOUGETSCALEFACT =$00000020;
+ MR_MOUGETEVENTMASK =$00000040;
+ MR_MOUSETSCALEFACT =$00000080;
+ MR_MOUSETEVENTMASK =$00000100;
+ MR_MOUOPEN =$00000800;
+ MR_MOUCLOSE =$00001000;
+ MR_MOUGETPTRSHAPE =$00002000;
+ MR_MOUSETPTRSHAPE =$00004000;
+ MR_MOUDRAWPTR =$00008000;
+ MR_MOUREMOVEPTR =$00010000;
+ MR_MOUGETPTRPOS =$00020000;
+ MR_MOUSETPTRPOS =$00040000;
+ MR_MOUINITREAL =$00080000;
+ MR_MOUSETDEVSTATUS =$00100000;
+
+{constants for mouse hot key bits in MouGetHotKey/MouSetHotKey}
+ MHK_BUTTON1 =1;
+ MHK_BUTTON2 =2;
+ MHK_BUTTON3 =4;
+
+{MouGetDevStatus/MouSetDevStatus device status constants}
+ MOUSE_QUEUEBUSY =$0001; {event queue busy with I/O}
+ MOUSE_BLOCKREAD =$0002; {block read in progress}
+ MOUSE_FLUSH =$0004; {flush in progress}
+ MOUSE_UNSUPPORTED_MODE =$0008; {pointer draw routine disabled}
+ {by unsupported mode }
+ MOUSE_DISABLED =$0100; {drawing operations for pointer}
+ {draw routine are disabled }
+ MOUSE_MICKEYS =$0200; {mouse data returned in mickeys, not pels}
+
+{constants for WaitFlag in MouReadEventQue and MouSynch}
+ MOU_NOWAIT =$0000; {MouReadEventQue: don't wait for data }
+ { on empty queue (return a null record)}
+ {MouSynch: control immediately}
+ { returned to requestor }
+ MOU_WAIT =$0001; {MouReadEventQue: wait for data on empty queue}
+ {MouSynch: requestor waits until}
+ { mouse device driver is free }
+
+{constants for MouGetEventMask/MouSetEventMask events}
+ MOUSE_MOTION =$0001; {report mouse motion events with}
+ {no button press/release events }
+ MOUSE_MOTION_WITH_BN1_DOWN =$0002; {report button 1 press/release}
+ {events, with mouse motion }
+ MOUSE_BN1_DOWN =$0004; {report button 1 press/release}
+ {events, without mouse motion }
+ MOUSE_MOTION_WITH_BN2_DOWN =$0008; {report button 2 press/release}
+ {events, with mouse motion }
+ MOUSE_BN2_DOWN =$0010; {report button 2 press/release}
+ {events, without mouse motion }
+ MOUSE_MOTION_WITH_BN3_DOWN =$0020; {report button 3 press/release}
+ {events, with mouse motion }
+ MOUSE_BN3_DOWN =$0040; {report button 3 press/release}
+ {events, without mouse motion }
+
+{constants for Status in MouSetDevStatus}
+ MOU_DRAW =0;
+ MOU_NODRAW =1;
+
+ MOU_PELS =0;
+ MOU_MICKEYS =2;
+
+type
+{unnecessary, just FYI}
+ THMOU=word;
+ PHMOU=^THMOU;
+
+{record type for MouGetPtrPos/MouSetPtrPos}
+ TPtrLoc=record
+ Row, {mouse pointer row coordinate (in pels or characters)}
+ Col:word; {mouse pointer column coordinate (in pels or characters)}
+ end;
+ PPtrLoc=^TPtrLoc;
+ PtrLoc=TPtrLoc;
+
+{record type for MouGetPtrShape/MouSetPtrShape}
+ TPtrShape=record
+ cb, {length of image buffer in bytes}
+ Col, {pointer width in characters (in text}
+ {modes; always 1) or pixels (>= 1) }
+ Row, {pointer height in characters (in text}
+ {modes; always 1) or pixels (>=1) }
+ ColHot, {hotspot offset from the left}
+ {side, in characters or pels }
+ {(must be 0 in text modes) }
+ RowHot:word; {hotspot offset from the top,}
+ {in characters or pels }
+ {(must be 0 in text modes) }
+ end;
+ PPtrShape=^TPtrShape;
+ PtrShape=TPtrShape;
+
+{record type for MouReadEventQue}
+(* #pragma pack(2) ??? *)
+ TMouEventInfo=record
+ fs:word; {event bits (state of the mouse at the time }
+ {of the event) - see MOUSE_MOTION, }
+ {MOUSE_MOTION_WITH_BN1_DOWN, MOUSE_BN1_DOWN, }
+ {MOUSE_MOTION_WITH_BN2_DOWN, MOUSE_BN2_DOWN, }
+ {MOUSE_MOTION_WITH_BN3_DOWN and MOUSE_BN3_DOWN }
+ {constants (other bits reserved and set to zero)}
+ Time:cardinal; {event timestamp - unique number of milliseconds}
+ {(since the system was started }
+ Row, {pointer current row position (absolute or relative)}
+ Col:integer; {pointer current column position}
+ {(absolute or relative) }
+ end;
+ PMouEventInfo=^TMouEventInfo;
+ MouEventInfo=TMouEventInfo;
+
+{record type for MouGetNumQueEl}
+ TMouQueInfo=record
+ cEvents, {current number of elements in event}
+ {queue, between 0 and cmaxEvents }
+ cmaxEvents:word; {maximum queue size in elements, as specified }
+ {in the QSIZE=NN parameter in DEVICE=MOUSExxx.SYS}
+ {statement in CONFIG.SYS }
+ end;
+ PMouQueInfo=^TMouQueInfo;
+ MouQueInfo=TMouQueInfo;
+
+{record type for MouGetScaleFact/MouSetScaleFact}
+ TScaleFact=record
+ RowScale, {current row scaling factor}
+ ColScale:word; {current column scaling factor}
+ end;
+ PScaleFact=^TScaleFact;
+ ScaleFact=TScaleFact;
+
+{record type for MouRemovePtr}
+ TNoPtrRect=record
+ Row, {upper row of the rectangle (pels or characters)}
+ Col, {column of the left edge (pels or characters)}
+ cRow, {bottom row of the rectangle (pels or characters)}
+ cCol:word; {column of the right edge (pels or characters)}
+ end;
+ PNoPtrRect=^TNoPtrRect;
+ NoPtrRect=TNoPtrRect;
+
+ TThreshold=record
+ case boolean of
+ false:(Length:word; {length of data in bytes}
+ Level1, {first movement level}
+ Lev1Mult, {first level multiplier}
+ Level2, {second movement level}
+ Lev2Mult:word); {second level multiplier}
+ true:(aLength:word);
+ end;
+ PThreshold=^TThreshold;
+ Threshold=TThreshold;
+
+
+{Register a mouse subsystem within a session.}
+{ModuleName is name of the dynamic link module (the maximum length
+is 8 characters - plus the final #0 character in the PChar version of this
+call), ProcName is the dynamic link entry point name of a routine that receives
+control when any of the registered functions are called (the maximum length
+is 32 bytes - plus the final #0 character in the PChar version of this call),
+FnMask is a mask of bits, where each bit set to 1 identifies a mouse function
+being registered - see MR_MOU* constants.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 413 ERROR_MOUSE_INVALID_ASCIIZ
+ 414 ERROR_MOUSE_INVALID_MASK
+ 415 ERROR_MOUSE_REGISTER
+ 466 ERROR_MOU_DETACHED
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The Base Mouse Subsystem is the default mouse subsystem. There can be only
+ one MouRegister outstanding for each session without an intervening
+ MouDeRegister. MouDeRegister must be issued by the same process that issued
+ MouRegister.
+* When any registered function is called, control is routed to EntryName.
+ When this routine is entered, four additional values are pushed onto the
+ stack. The first is the index number (Word) of the function being called.
+ The second is a near pointer (Word). The third is the caller's DS register
+ (Word). The fourth is the return address (DWord) to the mouse router. For
+ example, if MouGetNumMickeys were called and control routed to EntryName,
+ the stack would appear as if the following instructions were executed:
+
+ PUSH@ WORD MickeyCnt
+ PUSH WORD MouHandle
+ CALL FAR MouGetNumMickeys
+ PUSH WORD Function Code
+ CALL NEAR Entry point in Mouse Router
+ PUSH DS
+ CALL FAR EntryName
+
+
+* When a registered function returns to the Mouse Router, AX is interpreted
+ as follows:
+ AX = 0 - no error, do not invoke the Base Mouse Subsystem routine,
+ return AX = 0
+ AX = -1 - invoke the BaseMouse Subsystem routine, return AX = return code
+ from the Base Mouse Subsystem
+ AX = error (if not 0 or -1) - do not invoke the Base Mouse Subsystem
+ Routine, return AX = error
+* When the mouse router receives a mouse call, it routes it to the Base Mouse
+ Subsystem unless an application or other mouse subsystem has previously
+ issued MouRegister for that call. If the call was registered, the subsystem
+ is entered at the EntryName specified, and provided with the applicable
+ function code.
+* The registered function mask is used to determine whether a requested
+ function is performed by the registered mouse subsystem or default to the
+ Base Mouse Subsystem.
+* The following list shows the relationship of the mouse API calls and the
+ Function Code passed to either the Base Mouse Subsystem or a registered
+ mouse subsystem.
+
+ MOU API calls Function Code
+ MouGetNumButtons 00h
+ MouGetNumMickeys 01h
+ MouGetDevStatus 02h
+ MouGetNumQueEl 03h
+ MouReadEventQue 04h
+ MouGetScaleFact 05h
+ MouGetEventMask 06h
+ MouSetScaleFact 07h
+ MouSetEventMask 08h
+ Reserved 09h
+ Reserved 0Ah
+ MouOpen 0Bh
+ MouClose 0Ch
+ MouGetPtrShape 0Dh
+ MouSetPtrShape 0Eh
+ MouDrawPtr 0Fh
+ MouRemovePtr 10h
+ MouGetPtrPos 11h
+ MouSetPtrPos 12h
+ MouInitReal 13h
+ MouFlushQue 14h
+ MouSetDevStatus 15h
+* A registered mouse sybsystem must leave the stack, on exit, in the exact
+ state it was received.}
+function MouRegister(ModuleName,ProcName:PChar;FnMask:cardinal):word; cdecl;
+function MouRegister(ModuleName,ProcName:string;FnMask:cardinal):word;
+
+{Deregister a mouse subsystem previously registered within a session.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 416 ERROR_MOUSE_DEREGISTER
+ 466 ERROR_MOU_DETACHED
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The process that issued the MouRegister must release the session
+ (by a MouDeRegister call) from the registered subsystem before another PID
+ may issue MouRegister.
+* The process that issued the MouRegister is the only process that may
+ issue MouDeRegister against the currently registered subsystem.
+* After the owning process has released the subsystem with a MouDeRegister
+ call, any other process in the session may issue a MouRegister and therefore
+ modify the mouse support for the entire session.}
+function MouDeRegister:word; cdecl;
+
+{Direct the mouse driver to flush (empty) the mouse event queue and the monitor
+chain data for the session.}
+{MouHandle is the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+function MouFlushQue(MouHandle:word):word; cdecl;
+
+{Query the mouse driver to determine the current row and column coordinate
+position of the mouse pointer.}
+{Mouse pointer position returned in MouPtr, MouHandle is the mouse device
+handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* For a text window (VIO) application, the text window is a view on the
+ larger logical video buffer (LVB). The mouse pointer can be outside that
+ view and still be within the extent of the LVB. MouGetPtrPos then returns
+ the coordinates of the cell under the mouse pointer. If the pointer is
+ outside the LVB image extent, the coordinates of the nearest LVB cell are
+ returned. In either case, the LVB is scrolled until the reported LVB cell
+ appears within the view window.}
+function MouGetPtrPos(var MouPtr:TPtrLoc;MouHandle:word):word; cdecl;
+
+{Direct the mouse driver to set a new row and column coordinate position for
+the mouse pointer.}
+{MouPtr contains the new pointer coordinates, MouHandle is the mouse device
+handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The application must ensure that the coordinate position specified conforms
+ to the current display mode orientation for the session. Pel values must
+ be used for graphics modes and character values for text modes.
+* This function has no effect on the display's current collision area
+ definition as specified by the MouDrawPtr call. If the mouse pointer image
+ is directed into a defined collision area, the pointer image is not drawn
+ until either the pointer is moved outside the collision area or the collision
+ area is released by the MouDrawPtr call.}
+function MouSetPtrPos(const MouPtr:TPtrLoc;MouHandle:word):word; cdecl;
+
+{Set the pointer shape and size to be used as the mouse device pointer image
+for all applications in a session.}
+{ImageBuf contains the bit image used by the mouse device driver as the pointer
+shape for that session. The buffer consists of AND and XOR pointer masks
+in a format meaningful to the pointer draw device driver (see remarks bellow),
+ImageInfo contains the necessary data for the pointer draw device driver to
+build a row-by-column image for each bit plan for the current display mode,
+MouHandle is the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* An application passes a data image to the mouse device driver that the mouse
+ driver applies to the screen whenever the logical pointer position is not
+ located in the application-defined collision area. The application
+ synchronizes use of the screen with the mouse driver by way of MouRemovePtr
+ and MouDrawPtr.
+* The pointer shape is dependent on the display device driver used to support
+ the display device. OS/2 supports text and graphics modes. These modes are
+ restricted to modes 0 through 7, depending on the display device. Character
+ modes (modes 0, 1, 2, 3, and 7) support the pointer cursor only as a reverse
+ block character. This reverse block character has a character height
+ and width equal to 1.
+* The pointer shape is mapped by the Pointer Draw Device Driver and determined
+ completely by the application. The height and width may vary from 1 through
+ the pel size of the display screen. For restrictions concerning the Pointer
+ Draw Device Driver, see IBM Operating System/2 Version 1.2 I/O Subsystems And
+ Device Support Volume 1.
+* For CGA compatible text modes (0, 1, 2, and 3) the following describes
+ the AND and XOR pointer mask bit definitions for each character cell
+ of the masks. Bit values are:
+ Bit Description
+ 15 Blinking
+ 14-12 Background color
+ 11 Intensity
+ 10-8 Foreground color
+ 7-0 Character
+* For other custom displays and for the extended modes of the EGA attachment,
+ it is possible to set the display to modes that require multiple bit planes.
+ In these cases, the area sized by the row and column limits must be repeated
+ for each bit plane supported in that mode. Consequently, the calling process
+ must supply enough data to allow the mouse device driver to draw the pointer
+ shape on all currently supported bit planes in that session. For text modes,
+ row and column offset must equal 0.}
+function MouSetPtrShape(var ImageBuf;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+function MouSetPtrShape(ImageBuf:pointer;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+
+{Get (copy) the mouse pointer shape for the session.}
+{The pointer bit image is returned in ImageBuf (see MouSetPtrShape description
+for information about the resulting content of this buffer), the size of the
+pointer image buffer must be supplied in ImageInfo.cb (if the value is too
+small, the true length is placed in this field and an error is returned),
+on return, ImageInfo is filled with mouse pointer information, MouHandle is
+the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The application passes a parameter list with the same meaning as defined
+ for MouSetPtrShape to the mouse device driver. The mouse device driver
+ copies the parameters that describe the pointer shape and attributes into
+ the pointer definition control block pointed to by the PtrDefRec parameter.
+ The word 0 (buffer length = cb) pointer definition record parameter field
+ must contain the size in bytes of the application buffer where the device
+ driver is to insert the session's pointer image. All other words in
+ the parameter list are returned to the application by MouGetPtrShape.
+* For all OS/2 system-supported modes, size of the pointer image buffer
+ is specified in bytes and is equal to:
+ 1) Mono & Text Modes:
+ For text mode, height and width must be 1, so length is always 4.
+
+ size = (height in chars) * (width in chars) * 2 * 2 = 1 * 1 * 2 * 2 = 4
+
+ 2) Graphics Mode:
+ Width-in-pels must be a multiple of 8.
+
+ size = (height in pels) * (width in pels) * (bits per pel) * 2 / 8
+
+ a) Modes 4 and 5 (320 X 200)
+
+ size = (height) * (width) * 2 * 2 / 8
+
+ b) Mode 6 (640 X 200)
+
+ size = (height) * (width) * 1 * 2 / 8
+* If the buffer size is insufficient, the cb field contains the actual size
+ in bytes of the returned pointer image.
+* The pointer shape may be set by the application with MouSetPtrShape or may
+ be the default image provided by the installed Pointer Device Driver.}
+function MouGetPtrShape(var ImageBuf;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+function MouGetPtrShape(ImageBuf:pointer;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+
+{Return status flags for the installed mouse device driver.}
+{The current status flag settings for the installed mouse device driver are
+returned in Status - see MOUSE_QUEUEBUSY, MOUSE_BLOCKREAD, MOUSE_FLUSH,
+MOUSE_UNSUPPORTED_MODE, MOUSE_DISABLED and MOUSE_MICKEYS constants (other bits
+are reserved and set to zero), MouHandle is the mouse device handle from
+a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+function MouGetDevStatus(var Status:word;MouHandle:word):word; cdecl;
+
+{Return the number of buttons supported on the installed mouse driver.}
+{Number of physical buttons (1..3) returned in ButtonCount, MouHandle is
+the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+function MouGetNumButtons(var ButtonCount:word;MouHandle:word):word; cdecl;
+
+{Return the number of mickeys in each centimeter for the installed mouse
+driver.}
+{Number of physical mouse motion units (mickeys) in each centimeter (a constant
+based upon the attached mouse device) returned in MickeyCnt, MouHandle is
+the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+function MouGetNumMickeys(var MickeyCnt:word;MouHandle:word):word; cdecl;
+
+{Read an event from the mouse device FIFO event queue.}
+{The mouse event queue is returned in Event, WaitFlag determines the action to
+take when MouReadEventQue is issued and no event is available (the mouse event
+queue is empty) - see MOU_NOWAIT and MOU_WAIT constants, MouHandle is the mouse
+device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 393 ERROR_MOUSE_NO_DATA
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The types of queued events are directly affected by the current value of
+ the Mouse EventMask. MouSetEventMask is used to indicate the types of events
+ desired, and MouGetEventMask is used to query the current value of the mask.
+ Refer to these functions for further explanation of the masking of events.
+ Recognition of the mouse transition depends on the use of MouState returned
+ in the event record. The application should focus on bit transitions that
+ occur in this word. It is important to properly set the event mask with
+ MouSetEventMask for reporting the state transitions.
+ Event.fs reports the state of the mouse that resulted from the action that
+ caused the event. The action can be pressing or releasing a button, and/or
+ moving the mouse. All status is given, regardless of the EventMask that
+ was used to determine whether or not to report the event.
+ For example, assume the EventMask indicates that the application wishes only
+ button 1 events. The EventMask has only bits 1 and 2 set in this case. Also
+ assume the current state of the mouse is no buttons down, and mouse is not
+ moving. At this point, button 1 is pressed causing an event; the status shows
+ button 1 down (bit 2 set). Next the mouse is moved, thereby causing more
+ events; status shows bit 1 set. Finally, mouse is stopped and button 1 is
+ released. The event shows status with no bits set.
+ Next, button 2 is pressed. No event occurs. Mouse is then moved; again,
+ no event. Then, while mouse is still in motion, button 1 is pressed; an event
+ is generated with bits 1 and 3 set in the state word. While mouse is still
+ in motion, both buttons are released. Because button 1 changes states,
+ an event occurs. The state word has bit 0 set. Finally, mouse is stopped.
+ No event occurs, again because no button 1 transition has taken place.
+* The Event.Row and Event.Col fields may contain either absolute display
+ coordinates or relative mouse motion in mickeys. See MouSetDevStatus for
+ additional information.}
+function MouReadEventQue(var Event:TMouEventInfo;var WaitFlag:word;
+ MouHandle:word):word; cdecl;
+
+{Return the current status for the mouse device driver event queue.}
+{Mouse queue status returned in MouseQInfo, MouHandle is the mouse device
+handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+function MouGetNumQueEl(var MouseQInfo:TMouQueInfo;MouHandle:word):word; cdecl;
+
+{Return the current value of the mouse event queue mask.}
+{The current mouse device driver's event mask (as previously set by
+MouSetEventMask call) is returned in EventMask - see MOUSE_MOTION,
+MOUSE_MOTION_WITH_BN1_DOWN, MOUSE_BN1_DOWN, MOUSE_MOTION_WITH_BN2_DOWN,
+MOUSE_BN2_DOWN, MOUSE_MOTION_WITH_BN3_DOWN and MOUSE_BN3_DOWN constants (other
+bits are reserved and set to zero, MouHandle is the mouse device handle from
+a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* Buttons are logically numbered from left to right.}
+function MouGetEventMask(var EventMask:word;MouHandle:word):word; cdecl;
+
+{Assign a new event mask to the current mouse device driver.}
+{EventMask contains the mask indicating what mouse events are to be placed on
+the event queue (see MouReadEventQue) and which events are to be ignored - see
+MOUSE_MOTION, MOUSE_MOTION_WITH_BN1_DOWN, MOUSE_BN1_DOWN,
+MOUSE_MOTION_WITH_BN2_DOWN, MOUSE_BN2_DOWN, MOUSE_MOTION_WITH_BN3_DOWN and
+MOUSE_BN3_DOWN constants (other bits reserved and set to zero; a bit set to
+zero means that the associated type of event is not reported to the
+application, mouse buttons are always numbered from left to right - when the
+mouse is properly positioned for use, the left-hand button is button 1),
+MouHandle is the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* Setting a bit in the event mask means that the associated event is reported
+ on the mouse FIFO event queue. See MouReadEventQue for examples of event
+ mask use.}
+function MouSetEventMask(var EventMask:word;MouHandle:word):word; cdecl;
+
+{Return scaling factors for the current mouse device (a pair of 1-word
+values).}
+{Current row and column coordinate scaling factors (1 <= factor <= 32767)
+returned in Scale (see MouSetScaleFact for more information), MouHandle is
+the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The units of the scale factor depend on the mode of the display screen
+ for the session. If the screen is operating in text mode, the scaling units
+ are relative to characters. If the screen is operating in graphics mode,
+ the scaling units are relative to pels.}
+function MouGetScaleFact(var Scale:TScaleFact;MouHandle:word):word; cdecl;
+
+{Assign to the current mouse device driver a new pair of 1-word scaling
+factors.}
+{Scale contains the new row and column coordinate scaling factors (1 <= factor
+<= 32767), MouHandle is the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* MouSetScaleFact sets the mickey-to-pixel ratio for mouse motion. The row
+ scale and column scale ratios specify a number of mickeys for each 8 pixels.
+ The default value for the row scale is 16 mickeys for each 8 pixels. The
+ default value for the column scale is 8 mickeys to 8 pixels.
+* The number of pixels moved does not have to correspond 1-to-1 with the number
+ of mickeys the mouse moves. The scaling factor defines a sensitivity
+ for the mouse that is a ratio of the number of mickeys required to move
+ the cursor 8 pixels on the screen. The sensitivity determines at what rate
+ the cursor moves on the screen.}
+function MouSetScaleFact(const Scale:TScaleFact;MouHandle:word):word; cdecl;
+
+{Open the mouse device for the current session.}
+{DriverName contains the name of the pointer draw device driver to be used as
+the pointer-image drawing routine for this session (such device driver must be
+included in the CONFIG.SYS file at system start-up time) or is nil (the default
+pointer draw device driver supplied by the system is used then), mouse device
+handle is returned in MouHandle.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 390 ERROR_MOUSE_INV_MODULE_PT
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* MouOpen initializes the mouse functions to a known state. The application
+ may have to issue additional mouse functions to establish the environment
+ it desires. For example, after the MouOpen, the collision area is defined
+ to be the size of the entire display. Therefore, to get the pointer to be
+ displayed, the application must issue a MouDrawPtr to remove the collision
+ area.
+* The state of the mouse after the first MouOpen is:
+ - Row/Col scale factors set to 16/8 (see MouSetScaleFact)
+ - all events reported (see MouSetEventMask)
+ - empty event queue (see MouReadEventQue and MouGetNumQueEl)
+ - all user settable Device Status bits reset (set to zero;
+ see MouSetDevStatus)
+ - pointer set to center of screen if valid display mode is set (see
+ MouSetPtrPos)
+ - pointer shape set to the default for the pointer device driver currently
+ registered in the session (see MouSetPtrShape)
+ - collision area equal to full screen (see MouDrawPtr and MouRemovePtr)
+* DriverName has a different definition when the caller is the Base Video
+ Subsystem (BVS). However, this implies direct calling of the 16-bit routine,
+ which is not supported currently. In such case the selector portion
+ of the pointer is zero, the offset portion is non-zero and contains a display
+ configuration number (sequentially numbered where 1 is the first display
+ configuration). The MouOpen call issued by BVS is executed on the VioSetMode
+ path. Using the display configuration number passed on the MouOpen call, the
+ Base Mouse Subsystem can detect a change in display configurations. This form
+ of the MouOpen call is not recommended for applications. Applications should
+ either send the name of the pointer draw device driver or nil.}
+function MouOpen(DriverName:PChar;var MouHandle:word):word; cdecl;
+function MouOpen(DriverName:string;var MouHandle:word):word;
+
+{Close the mouse device for the current session.}
+{MouHandle is the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* MouClose closes the mouse device for the current session and removes the
+ mouse device driver handle from the list of valid open mouse device
+ handles.}
+function MouClose(MouHandle:word):word; cdecl;
+
+{Notify the mouse device driver that the area defined by the passed parameters
+if for exclusive use of the application. This area is defined as the
+"collision" area and is not available to the mouse device driver when drawing
+pointer images.}
+{ProtectArea is the pointer shape collision area, MouHandle is the mouse device
+handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* MouRemovePtr may be issued by any process in the session. However, only one
+ collision area is active at a time. Each MouRemovePtr command has the effect
+ of resetting the collision area to the location and area specified
+ by the current command.
+* If the logical pointer position is outside of the collision area specified
+ by the latest MouRemovePtr command, the pointer image is drawn.
+* The MouDrawPtr command effectively cancels the MouRemovePtr command
+ and allows the pointer to be drawn anywhere on the screen, until a new
+ MouRemovePtr command is issued.}
+function MouRemovePtr(var ProtectArea:TNoPtrRect;MouHandle:word):word; cdecl;
+
+{Notify the mouse device driver that an area previously restricted
+to the pointer image is now available to the mouse device driver.}
+{MouHandle is the mouse device handle from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* The collision area (the pointer image restricted area) is established by
+ MouOpen and by MouRemovePtr. MouDrawPtr nullifies the effect of the
+ MouRemovePtr command. If there was no previous MouDrawPtr command or if a
+ previous MouDrawPtr command has already nullified the collision area, the
+ MouRemovePtr command is effectively a null operation.
+* This call is required to begin session pointer image drawing. Immediately
+ after MouOpen is issued, the collision area is defined as the size of the
+ display. A MouDrawPtr is issued to begin pointer drawing after the
+ MouOpen.}
+function MouDrawPtr(MouHandle:word):word; cdecl;
+
+{Set the mouse device driver status flags for the installed mouse device
+driver.}
+{Status contains the desired status flag settings (2-byte set, only the
+high-order byte has meaning - see MOUSE_DISABLED and MOUSE_MICKEYS constants;
+other bits are reserved and set to zero). MouHandle is the mouse device handle
+from a previous MouOpen call.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 387 ERROR_MOUSE_INV_PARMS
+ 466 ERROR_MOU_DETACHED
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* MouSetDevStatus is the complement to MouGetDevStatus. However, not all status
+ flags may be set with MouSetDevStatus. Only the flags corresponding
+ to the following functions may be modified:
+ - Return data in mickeys
+ Normally, mouse data is returned to the application with the absolute
+ display mode coordinates of the pointer image position on the display
+ screen. By setting this status flag, mouse data is returned in relative
+ mickeys, a unit of mouse movement.
+ - Don't call pointer draw device
+ Normally, the pointer draw device driver is called for all drawing
+ operations. By setting this status flag, the mouse device driver does not
+ call the pointer draw device driver. The application must draw any required
+ pointer image on the screen.}
+function MouSetDevStatus(var Status:word;MouHandle:word):word; cdecl;
+
+{Initialize mouse pointer draw support for DOS mode.}
+{Name of the Pointer Draw Device Driver used as the pointer-image drawing
+routine for the DOS mode session must sent in DriverName; the name of the
+device driver must be included in the CONFIG.SYS file at system start-up time.}
+{Possible return codes:
+ 0 NO_ERROR
+ 385 ERROR_MOUSE_NO_DEVICE
+ 466 ERROR_MOU_DETACHED
+ 412 ERROR_MOUSE_SMG_ONLY
+ 501 ERROR_MOUSE_NO_CONSOLE
+ 505 ERROR_MOU_EXTENDED_SG}
+{Remarks:
+* MouInitReal is issued by the Base Video Subsystem at system initialization
+ time.
+* The DOS mode mouse API (INT 33h), in contrast to the OS/2 mode Mouse API,
+ does not contain an OPEN command. In addition, there is only one session
+ for DOS mode.
+* The default pointer draw routine for DOS mode is located in the same pointer
+ draw device driver, POINTER$, that is used for OS/2 mode. Establishing
+ addressability to the pointer draw routine must be done during system
+ initialization. This requires passing the entry point of the DOS mode pointer
+ draw routine to the mouse device driver. This is the purpose
+ of the MouInitReal call. It passes the address of the default, power-up
+ pointer draw routine for DOS mode to the mouse device driver. This
+ initialization is transparent to applications.
+* This call is for use only by the Base Video Subsystem when invoked during
+ system initialization under the shell/session manager PID.
+* The error code ERROR_MOUSE_SMG_ONLY is valid from shell process only.
+* When using direct calls to the 16-bit routine, another version of this call
+ is supported as well - if the selector part of the far pointer is zero
+ and the offset portion is non-zero, the offset portion identifies the
+ power-up display configuration. However, this isn't possible in the current
+ implementation (using 32-bit wrap-around function supplied in EMXWRAP.DLL).}
+function MouInitReal(DriverName:PChar):word; cdecl;
+function MouInitReal(DriverName:string):word;
+
+{Synchronize the mouse subsystem with the mouse device driver.}
+{WaitFlag specifies whether the routine should wait for the mouse device driver
+being free - see MOU_NOWAIT and MOU_WAIT constants.}
+{Possible return codes:
+ 0 NO_ERROR
+ 121 ERROR_SEM_TIMEOUT}
+{Remarks:
+* MouSynch blocks all other threads within a session until the semaphore
+ clears (returns from the subsystem to the router). To ensure proper
+ synchronization, MouSynch should be issued by a mouse subsystem if it intends
+ to access dynamically modifiable shared data for each session or if it
+ intends to issue a DosDevIOCtl. MouSynch does not protect globally shared
+ data from threads in other sessions.}
+function MouSynch(WaitFlag:word):word; cdecl;
+
+function MouGetThreshold(var MouThreshold:TThreshold;MouHandle:word):word;
+ cdecl;
+
+function MouSetThreshold(var MouThreshold:TThreshold;MouHandle:word):word;
+ cdecl;
+
+(*
+following two functions are undocumented and not present within C header files:
+
+function MouGetHotKey(var ButtonBits:word;MouHandle:word):word;
+
+function MouSetHotKey(var ButtonBits:word;MouHandle:word):word;
+*)
+
+(* Following routines are not supported
+ (just have a look in some C header
+ file - you probably won't find it there either).
+MouFree (index 4)
+MouShellInit (index 12)
+*)
+
+{***************************************************************************}
+implementation
+{***************************************************************************}
+
+
+function MouRegister(ModuleName,ProcName:PChar;FnMask:cardinal):word; cdecl;
+external 'EMXWRAP' index 324;
+{external 'MOUCALLS' index 24;}
+
+function MouRegister(ModuleName,ProcName:string;FnMask:cardinal):word;
+begin
+ if byte(ModuleName[0])>8 then byte(ModuleName[0]):=8;
+ ModuleName[Succ(byte(ModuleName[0]))]:=#0;
+ if byte(ProcName[0])>32 then byte(ProcName[0]):=32;
+ ProcName[Succ(byte(ProcName[0]))]:=#0;
+ MouRegister:=MouRegister(@ModuleName[1],@ProcName[1],FnMask);
+end;
+
+function MouDeRegister:word; cdecl;
+external 'EMXWRAP' index 314;
+{external 'MOUCALLS' index 14;}
+
+function MouFlushQue(MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 307;
+{external 'MOUCALLS' index 7;}
+
+function MouGetPtrPos(var MouPtr:TPtrLoc;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 319;
+{external 'MOUCALLS' index 19;}
+
+function MouSetPtrPos(const MouPtr:TPtrLoc;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 321;
+{external 'MOUCALLS' index 21;}
+
+function MouSetPtrShape(ImageBuf:pointer;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 302;
+{external 'MOUCALLS' index 2;}
+
+function MouSetPtrShape(var ImageBuf;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 302;
+{external 'MOUCALLS' index 2;}
+
+function MouGetPtrShape(var ImageBuf;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 301;
+{external 'MOUCALLS' index 1;}
+
+function MouGetPtrShape(ImageBuf:pointer;var ImageInfo:TPtrShape;
+ MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 301;
+{external 'MOUCALLS' index 1;}
+
+function MouGetDevStatus(var Status:word;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 322;
+{external 'MOUCALLS' index 22;}
+
+function MouGetNumButtons(var ButtonCount:word;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 308;
+{external 'MOUCALLS' index 8;}
+
+function MouGetNumMickeys(var MickeyCnt:word;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 303;
+{external 'MOUCALLS' index 3;}
+
+function MouReadEventQue(var Event:TMouEventInfo;var WaitFlag:word;
+ MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 320;
+{external 'MOUCALLS' index 20;}
+
+function MouGetNumQueEl(var MouseQInfo:TMouQueInfo;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 313;
+{external 'MOUCALLS' index 13;}
+
+function MouGetEventMask(var EventMask:word;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 315;
+{external 'MOUCALLS' index 15;}
+
+function MouSetEventMask(var EventMask:word;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 316;
+{external 'MOUCALLS' index 16;}
+
+function MouGetScaleFact(var Scale:TScaleFact;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 306;
+{external 'MOUCALLS' index 6;}
+
+function MouSetScaleFact(const Scale:TScaleFact;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 311;
+{external 'MOUCALLS' index 11;}
+
+function MouOpen(DriverName:PChar;var MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 317;
+{external 'MOUCALLS' index 17;}
+
+function MouOpen(DriverName:string;var MouHandle:word):word;
+
+var B:byte;
+
+begin
+ B:=byte(DriverName[0]);
+ if B=0 then MouOpen:=MouOpen(nil,MouHandle) else
+ begin
+ if B<>255 then
+ begin
+ DriverName[Succ(B)]:=#0;
+ MouOpen:=MouOpen(@DriverName[1],MouHandle);
+ end else
+ begin
+ Move(DriverName[1],DriverName[0],B);
+ DriverName[B]:=#0;
+ MouOpen:=MouOpen(@DriverName,MouHandle);
+ end;
+ end;
+end;
+
+function MouClose(MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 309;
+{external 'MOUCALLS' index 9;}
+
+function MouRemovePtr(var ProtectArea:TNoPtrRect;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 318;
+{external 'MOUCALLS' index 18;}
+
+function MouDrawPtr(MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 326;
+{external 'MOUCALLS' index 26;}
+
+function MouSetDevStatus(var Status:word;MouHandle:word):word; cdecl;
+external 'EMXWRAP' index 326;
+{external 'MOUCALLS' index 26;}
+
+function MouInitReal(DriverName:PChar):word; cdecl;
+external 'EMXWRAP' index 327;
+{external 'MOUCALLS' index 27;}
+
+function MouInitReal(DriverName:string):word;
+
+var B:byte;
+
+begin
+ B:=byte(DriverName[0]);
+ if B=0 then MouInitReal:=MouInitReal(nil) else
+ begin
+ if B<>255 then
+ begin
+ DriverName[Succ(B)]:=#0;
+ MouInitReal:=MouInitReal(@DriverName[1]);
+ end else
+ begin
+ Move(DriverName[1],DriverName[0],B);
+ DriverName[B]:=#0;
+ MouInitReal:=MouInitReal(@DriverName);
+ end;
+ end;
+end;
+
+function MouSynch(WaitFlag:word):word; cdecl;
+external 'EMXWRAP' index 323;
+{external 'MOUCALLS' index 23;}
+
+function MouGetThreshold(var MouThreshold:TThreshold;MouHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 329;
+{external 'MOUCALLS' index 29;}
+
+function MouSetThreshold(var MouThreshold:TThreshold;MouHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 330;
+{external 'MOUCALLS' index 30;}
+
+
+(*
+following two functions are undocumented and not present within C header files:
+
+function MouGetHotKey(var ButtonBits:word;MouHandle:word):word;
+external 'MOUCALLS' index 4;
+
+function MouSetHotKey(var ButtonBits:word;MouHandle:word):word;
+external 'MOUCALLS' index 10;
+*)
+
+
+end.
+
+{
+ $Log: moucalls.pas,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/mouse.pp b/rtl/os2/mouse.pp
new file mode 100644
index 0000000000..22460152e9
--- /dev/null
+++ b/rtl/os2/mouse.pp
@@ -0,0 +1,416 @@
+{
+ $Id: mouse.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Mouse unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Mouse;
+interface
+
+{$i mouseh.inc}
+
+implementation
+
+uses
+ Video,
+ MouCalls, DosCalls;
+
+{$i mouse.inc}
+
+var
+ PendingMouseEventOrder: array [0..MouseEventBufSize-1] of cardinal;
+ MouseEventOrderHead, MouseEventOrderTail: cardinal;
+
+const
+ NoMouse = $FFFF;
+ DefaultMouse = 0;
+ Handle: word = DefaultMouse;
+ HideCounter: cardinal = 0;
+ OldEventMask: longint = -1;
+
+procedure SysInitMouse;
+var
+ Loc: TPtrLoc;
+ SetPrev: boolean;
+ SysEvent: TMouEventInfo;
+ QI: TMouQueInfo;
+ W: word;
+begin
+ SetPrev := MouGetPtrPos (Loc, DefaultMouse) = 0;
+ if MouGetEventMask (W, DefaultMouse) = 0 then OldEventMask := W;
+ MouseEventOrderTail := 0;
+ MouseEventOrderHead := 0;
+ HideCounter := 0;
+ if MouOpen (nil, Handle) = Error_Mouse_No_Device then Handle := NoMouse else
+ begin
+ W := Mou_NoWait;
+ repeat
+ MouGetNumQueEl (QI, Handle);
+ if QI.cEvents <> 0 then MouReadEventQue (SysEvent, W, Handle);
+ until QI.cEvents = 0;
+ W := $FFFF;
+ MouSetEventMask (W, Handle);
+ if SetPrev then MouSetPtrPos (Loc, Handle);
+
+(*
+ It would be possible to issue a MouRegister call here to hook our own mouse
+ handler, but such handler would have to be in a DLL and it is questionable,
+ whether there would be so many advantages in doing so.
+*)
+
+ MouDrawPtr (Handle);
+ end;
+end;
+
+procedure SysDoneMouse;
+var
+ W: word;
+begin
+ if (Handle <> NoMouse) and (Handle <> DefaultMouse) then
+ begin
+
+(*
+ If our own mouse handler would be installed in InitMouse, MouDeregister would
+ have appeared here.
+*)
+
+ HideCounter := 0;
+ HideMouse;
+ MouClose (Handle);
+ end;
+ if OldEventMask <> -1 then
+ begin
+ W := OldEventMask;
+ MouSetEventMask (W, 0);
+ end;
+end;
+
+function SysDetectMouse:byte;
+var
+ Buttons: word;
+ RC: longint;
+ TempHandle: word;
+begin
+ MouOpen (nil, TempHandle);
+ if MouGetNumButtons (Buttons, TempHandle) = 0 then
+ SysDetectMouse := Buttons
+ else
+ SysDetectMouse := 0;
+ MouClose (TempHandle);
+end;
+
+procedure SysShowMouse;
+begin
+ if Handle <> NoMouse then
+ begin
+ if HideCounter <> 0 then
+ begin
+ Dec (HideCounter);
+ if HideCounter = 0 then MouDrawPtr (Handle);
+ end;
+ end;
+end;
+
+procedure SysHideMouse;
+var
+ PtrRect: TNoPtrRect;
+begin
+ if Handle <> NoMouse then
+ begin
+ Inc (HideCounter);
+ case HideCounter of
+ 0: Dec (HideCounter); (* HideCounter overflowed - stay at the maximum *)
+ 1: begin
+ PtrRect.Row := 0;
+ PtrRect.Col := 0;
+ PtrRect.cRow := Pred (ScreenHeight);
+ PtrRect.cCol := Pred (ScreenWidth);
+ MouRemovePtr (PtrRect, Handle);
+ end;
+ end;
+ end;
+end;
+
+function SysGetMouseX: word;
+var
+ Event: TMouseEvent;
+begin
+ if Handle = NoMouse then
+ SysGetMouseX := 0
+ else
+ begin
+ PollMouseEvent (Event);
+ SysGetMouseX := Event.X;
+ end;
+end;
+
+function SysGetMouseY: word;
+var
+ Event: TMouseEvent;
+begin
+ if Handle = NoMouse then
+ SysGetMouseY := 0
+ else
+ begin
+ PollMouseEvent (Event);
+ SysGetMouseY := Event.Y;
+ end;
+end;
+
+procedure SysGetMouseXY (var X: word; var Y: word);
+var
+ Loc: TPtrLoc;
+begin
+ if Handle = NoMouse then
+ begin
+ X := 0;
+ Y := 0;
+ end else if MouGetPtrPos (Loc, Handle) <> 0 then
+ begin
+ X := $FFFF;
+ Y := $FFFF;
+ end else
+ begin
+ X := Loc.Col;
+ Y := Loc.Row;
+ end;
+end;
+
+procedure SysSetMouseXY (X, Y: word);
+var
+ Loc: TPtrLoc;
+begin
+ if Handle <> NoMouse then
+ begin
+ Loc.Row := Y;
+ Loc.Col := X;
+ MouSetPtrPos (Loc, Handle);
+ end;
+end;
+
+procedure TranslateEvents (const SysEvent: TMouEventInfo;
+ var Event: TMouseEvent);
+begin
+ Event.Buttons := 0;
+ Event.Action := 0;
+ if SysEvent.fs and (Mouse_Motion_With_BN1_Down or Mouse_BN1_Down) <> 0 then
+ Event.Buttons := Event.Buttons or MouseLeftButton;
+ if SysEvent.fs and (Mouse_Motion_With_BN2_Down or Mouse_BN2_Down) <> 0 then
+ Event.Buttons := Event.Buttons or MouseRightButton;
+ if SysEvent.fs and (Mouse_Motion_With_BN3_Down or Mouse_BN3_Down) <> 0 then
+ Event.Buttons := Event.Buttons or MouseMiddleButton;
+ Event.X := SysEvent.Col;
+ Event.Y := SysEvent.Row;
+ if Event.Buttons <> LastMouseEvent.Buttons then
+ if (Event.Buttons and MouseLeftButton = 0) and
+ (LastMouseEvent.Buttons and MouseLeftButton = MouseLeftButton)
+ then Event.Action := MouseActionUp else
+ if (Event.Buttons and MouseRightButton = 0) and
+ (LastMouseEvent.Buttons and MouseRightButton = MouseRightButton)
+ then Event.Action := MouseActionUp else
+ if (Event.Buttons and MouseMiddleButton = 0) and
+ (LastMouseEvent.Buttons and MouseMiddleButton = MouseMiddleButton)
+ then Event.Action := MouseActionUp
+ else Event.Action := MouseActionDown
+ else if (Event.X <> LastMouseEvent.X) or (Event.Y <> LastMouseEvent.Y)
+ then Event.Action := MouseActionMove;
+ LastMouseEvent := Event;
+end;
+
+procedure NullOrder;
+var
+ I: cardinal;
+begin
+ if PendingMouseEvents > 0 then
+ begin
+ I := MouseEventOrderHead;
+ repeat
+ PendingMouseEventOrder [I] := 0;
+ if I = Pred (MouseEventBufSize) then I := 0 else Inc (I);
+ until (I <> MouseEventOrderTail);
+ end;
+end;
+
+procedure LowerOrder;
+var
+ I: cardinal;
+begin
+ if PendingMouseEvents > 0 then
+ begin
+ I := MouseEventOrderHead;
+ repeat
+ if PendingMouseEventOrder [I] <> 0 then
+ begin
+ Dec (PendingMouseEventOrder [I]);
+ if I = Pred (MouseEventBufSize) then I := 0 else Inc (I);
+ end;
+ until (I <> MouseEventOrderTail) or (PendingMouseEventOrder [I] = 0);
+ end;
+end;
+
+function SysPollMouseEvent (var MouseEvent: TMouseEvent) :boolean;
+var
+ SysEvent: TMouEventInfo;
+ P, Q: PMouseEvent;
+ Event: TMouseEvent;
+ WF: word;
+ QI: TMouQueInfo;
+begin
+ if (PendingMouseEvents = 0) or
+ (PendingMouseEventOrder [MouseEventOrderHead] <> 0) and
+ (PendingMouseEvents < MouseEventBufSize) then
+ begin
+ MouGetNumQueEl (QI, Handle);
+ if QI.cEvents = 0 then NullOrder else
+ begin
+ LowerOrder;
+ WF := Mou_NoWait;
+ if (MouReadEventQue (SysEvent, WF, Handle) = 0) then
+ begin
+ if PendingMouseHead = @PendingMouseEvent then
+ P := @PendingMouseEvent [MouseEventBufSize - 1] else
+ begin
+ P := PendingMouseHead;
+ Dec (P);
+ end;
+ TranslateEvents (SysEvent, P^);
+ if P^.Action <> 0 then
+ begin
+ if PendingMouseEvents < MouseEventBufSize then
+ begin
+ Q := P;
+ WF := Mou_NoWait;
+ while (P^.Action = MouseActionMove) and
+ (PendingMouseEventOrder [MouseEventOrderHead] <> 0) and
+ (MouReadEventQue (SysEvent, WF, Handle) = 0) and
+ ((SysEvent.fs <> 0) or (LastMouseEvent.Buttons <> 0)) do
+ begin
+ LowerOrder;
+ TranslateEvents (SysEvent, Event);
+ if Event.Action <> MouseActionMove then
+ begin
+ if Q = @PendingMouseEvent then
+ Q := @PendingMouseEvent [MouseEventBufSize - 1] else Dec (Q);
+ if MouseEventOrderHead = 0 then
+ MouseEventOrderHead := MouseEventBufSize - 1 else
+ Dec (MouseEventOrderHead);
+ PendingMouseEventOrder [MouseEventOrderHead] := 0;
+ Q^ := P^;
+ Inc (PendingMouseEvents);
+ if MouseEventOrderHead = 0 then
+ MouseEventOrderHead := MouseEventBufSize - 1 else
+ Dec (MouseEventOrderHead);
+ PendingMouseEventOrder [MouseEventOrderHead] := 0;
+ end else WF := Mou_NoWait;
+ P^ := Event;
+ end;
+ P := Q;
+ end;
+ Inc (PendingMouseEvents);
+ if MouseEventOrderHead = 0 then
+ MouseEventOrderHead := MouseEventBufSize - 1 else
+ Dec (MouseEventOrderHead);
+ PendingMouseEventOrder [MouseEventOrderHead] := 0;
+ PendingMouseHead := P;
+ end;
+ end else NullOrder;
+ end;
+ end;
+ if PendingMouseEvents <> 0 then
+ begin
+ MouseEvent := PendingMouseHead^;
+ LastMouseEvent := MouseEvent;
+ SysPollMouseEvent := true;
+ end else
+ begin
+ SysPollMouseEvent := false;
+ MouseEvent := LastMouseEvent;
+ MouseEvent.Action := 0;
+ end;
+end;
+
+function SysGetMouseButtons: word;
+var
+ Event: TMouseEvent;
+begin
+ PollMouseEvent (Event);
+ SysGetMouseButtons := Event.Buttons;
+end;
+
+procedure SysGetMouseEvent (var MouseEvent: TMouseEvent);
+var
+ Event: TMouEventInfo;
+begin
+ if (PendingMouseEvents = 0) or
+ (PendingMouseEventOrder [MouseEventOrderHead] <> 0) then
+ repeat
+ DosSleep (1);
+ PollMouseEvent (MouseEvent);
+ until (PendingMouseEvents <> 0) and
+ (PendingMouseEventOrder [MouseEventOrderHead] = 0) else
+ begin
+ MouseEvent := PendingMouseHead^;
+ LastMouseEvent := MouseEvent;
+ end;
+ Inc (PendingMouseHead);
+ if longint (PendingMouseHead) = longint (@PendingMouseEvent)
+ + SizeOf (PendingMouseEvent) then PendingMouseHead := @PendingMouseEvent;
+ Inc (MouseEventOrderHead);
+ if MouseEventOrderHead = MouseEventBufSize then MouseEventOrderHead := 0;
+ Dec (PendingMouseEvents);
+end;
+
+procedure SysPutMouseEvent (const MouseEvent: TMouseEvent);
+var
+ QI: TMouQueInfo;
+begin
+ if PendingMouseEvents < MouseEventBufSize then
+ begin
+ PendingMouseTail^ := MouseEvent;
+ Inc (PendingMouseTail);
+ if longint (PendingMouseTail) = longint (@PendingMouseEvent) +
+ SizeOf (PendingMouseEvent) then PendingMouseTail := @PendingMouseEvent;
+ MouGetNumQueEl (QI, Handle);
+ PendingMouseEventOrder [MouseEventOrderTail] := QI.cEvents;
+ Inc (MouseEventOrderTail);
+ if MouseEventOrderTail = MouseEventBufSize then MouseEventOrderTail := 0;
+ Inc (PendingMouseEvents);
+ end;
+end;
+
+Const
+ SysMouseDriver : TMouseDriver = (
+ UseDefaultQueue : False;
+ InitDriver : @SysInitMouse;
+ DoneDriver : @SysDoneMouse;
+ DetectMouse : @SysDetectMouse;
+ ShowMouse : @SysShowMouse;
+ HideMouse : @SysHideMouse;
+ GetMouseX : @SysGetMouseX;
+ GetMouseY : @SysGetMouseY;
+ GetMouseButtons : @SysGetMouseButtons;
+ SetMouseXY : @SysSetMouseXY;
+ GetMouseEvent : @SysGetMouseEvent;
+ PollMouseEvent : @SysPollMouseEvent;
+ PutMouseEvent : @SysPutMouseEvent;
+ );
+
+Begin
+ SetMouseDriver(SysMouseDriver);
+end.
+{
+ $Log: mouse.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/newexe.pas b/rtl/os2/newexe.pas
new file mode 100644
index 0000000000..9097d742b4
--- /dev/null
+++ b/rtl/os2/newexe.pas
@@ -0,0 +1,189 @@
+unit NEWEXE;
+
+ interface
+
+ const
+ EMAGIC = $5A4D;
+ ENEWEXE = 8*5;
+ ENEWHDR = $003C;
+ ERESWDS = $0010;
+ ERES1WDS = $0004;
+ ERES2WDS = $000A;
+ ECP = $0004;
+ ECBLP = $0002;
+ EMINALLOC = $000A;
+
+ type
+ exe_hdr = record
+ e_magic : word;
+ e_cblp : word;
+ e_cp : word;
+ e_crlc : word;
+ e_cparhdr : word;
+ e_minalloc : word;
+ e_maxalloc : word;
+ e_ss : word;
+ e_sp : word;
+ e_csum : word;
+ e_ip : word;
+ e_cs : word;
+ e_lfarlc : word;
+ e_ovno : word;
+ e_res : array[0..ERES1WDS-1] of word;
+ e_oemid : word;
+ e_oeminfo : word;
+ e_res2 : array[0..ERES2WDS-1] of word;
+ e_lfanew : longint;
+ end;
+
+ const
+ NEMAGIC = $454E;
+ NERESBYTES = 8;
+ NECRC = 8;
+
+ type
+ new_exe = record
+ ne_magic : word;
+ ne_ver : byte;
+ ne_rev : byte;
+ ne_enttab : word;
+ ne_cbenttab : word;
+ ne_crc : longint;
+ ne_flags : word;
+ ne_autodata : word;
+ ne_heap : word;
+ ne_stack : word;
+ ne_csip : longint;
+ ne_sssp : longint;
+ ne_cseg : word;
+ ne_cmod : word;
+ ne_cbnrestab : word;
+ ne_segtab : word;
+ ne_rsrctab : word;
+ ne_restab : word;
+ ne_modtab : word;
+ ne_imptab : word;
+ ne_nrestab : longint;
+ ne_cmovent : word;
+ ne_align : word;
+ ne_cres : word;
+ ne_exetyp : byte;
+ ne_flagsothers : byte;
+ ne_res : array[0..NERESBYTES-1] of char;
+ end;
+
+ const
+ NE_UNKNOWN = $0;
+ NE_OS2 = $1;
+ NE_WINDOWS = $2;
+ NE_DOS4 = $3;
+ NE_DEV386 = $4;
+ NENOTP = $8000;
+ NEIERR = $2000;
+ NEBOUND = $0800;
+ NEAPPTYP = $0700;
+ NENOTWINCOMPAT = $0100;
+ NEWINCOMPAT = $0200;
+ NEWINAPI = $0300;
+ NEFLTP = $0080;
+ NEI386 = $0040;
+ NEI286 = $0020;
+ NEI086 = $0010;
+ NEPROT = $0008;
+ NEPPLI = $0004;
+ NEINST = $0002;
+ NESOLO = $0001;
+ NElongintNAMES = $01;
+ NEWINISPROT = $02;
+ NEWINGETPROPFON = $04;
+ NEWLOAPPL = $80;
+
+ type
+ new_seg = record
+ ns_sector : word;
+ ns_cbseg : word;
+ ns_flags : word;
+ ns_minalloc : word;
+ end;
+
+ const
+ NSTYPE = $0007;
+ NSCODE = $0000;
+ NSDATA = $0001;
+ NSITER = $0008;
+ NSMOVE = $0010;
+ NSSHARED = $0020;
+ NSPRELOAD = $0040;
+ NSEXRD = $0080;
+ NSRELOC = $0100;
+ NSCONFORM = $0200;
+ NSEXPDOWN = $0200;
+ NSDPL = $0C00;
+ SHIFTDPL = 10;
+ NSDISCARD = $1000;
+ NS32BIT = $2000;
+ NSHUGE = $4000;
+ NSGDT = $8000;
+ NSPURE = NSSHARED;
+ NSALIGN = 9;
+ NSLOADED = $0004;
+
+ type
+ new_rlcinfo = record
+ nr_nreloc : word;
+ end;
+
+{$PACKRECORDS NORMAL}
+ const
+ NRSTYP = $0f;
+ NRSBYT = $00;
+ NRSSEG = $02;
+ NRSPTR = $03;
+ NRSOFF = $05;
+ NRPTR48 = $06;
+ NROFF32 = $07;
+ NRSOFF32 = $08;
+ NRADD = $04;
+ NRRTYP = $03;
+ NRRINT = $00;
+ NRRORD = $01;
+ NRRNAM = $02;
+ NRROSF = $03;
+
+ type
+ rsrc_string = record
+ rs_len : char;
+ rs_string : array[0..1-1] of char;
+ end;
+
+ rsrc_typeinfo = record
+ rt_id : word;
+ rt_nres : word;
+ rt_proc : longint;
+ end;
+
+ rsrc_nameinfo = record
+ rn_offset : word;
+ rn_length : word;
+ rn_flags : word;
+ rn_id : word;
+ rn_handle : word;
+ rn_usage : word;
+ end;
+
+ const
+ RSORDID = $8000;
+ RNMOVE = $0010;
+ RNPURE = $0020;
+ RNPRELOAD = $0040;
+ RNDISCARD = $F000;
+
+ type
+ new_rsrc = record
+ rs_align : word;
+ rs_typeinfo : rsrc_typeinfo;
+ end;
+
+ implementation
+
+end.
diff --git a/rtl/os2/os2def.pas b/rtl/os2/os2def.pas
new file mode 100644
index 0000000000..85281eed16
--- /dev/null
+++ b/rtl/os2/os2def.pas
@@ -0,0 +1,3412 @@
+{****************************************************************************
+
+ $Id: os2def.pas,v 1.9 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2002 by the Free Pascal development team.
+
+ Common OS/2 types and constants (including error codes)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+unit OS2Def;
+
+interface
+
+// Common Error definitions
+
+type
+ ERRORID=Cardinal; // errid
+ PERRORID=^ERRORID;
+
+const
+ Severity_NoError = $0;
+ Severity_Warning = $4;
+ Severity_Error = $8;
+ Severity_Severe = $C;
+ Severity_Unrecoverable = $10;
+
+ WinErr_Base = $1000;
+ GPIErr_Base = $2000;
+ DevErr_Base = $3000;
+ SplErr_Base = $4000;
+
+ Address = 0;
+ Driver_Name = 1;
+ Driver_Data = 2;
+ Data_Type = 3;
+ Comment = 4;
+ Proc_Name = 5;
+ Proc_Params = 6;
+ Spl_Params = 7;
+ Network_Params = 8;
+
+ PD_Job_Property = $0001;
+ FAttr_Sel_Italic = $0001;
+ FAttr_Sel_Underscore = $0002;
+ FAttr_Sel_Outline = $0008;
+ FAttr_Sel_Strikeout = $0010;
+ FAttr_Sel_Bold = $0020;
+ FAttr_Type_Kerning = $0004;
+ FAttr_Type_MBCS = $0008;
+ FAttr_Type_DBCS = $0010;
+ FAttr_Type_Antialiased = $0020;
+ FAttr_FontUse_NoMix = $0002;
+ FAttr_FontUse_Outline = $0004;
+ FAttr_FontUse_Transformable = $0008;
+ FaceSize = 32;
+
+ FM_Type_Fixed = $0001;
+ FM_Type_Licensed = $0002;
+ FM_Type_Kerning = $0004;
+ FM_Type_DBCS = $0010;
+ FM_Type_MBCS = $0018;
+ FM_Type_64K = $8000;
+ FM_Type_Atoms = $4000;
+ FM_Type_FamTrunc = $2000;
+ FM_Type_FaceTrunc = $1000;
+ FM_Defn_Outline = $0001;
+ FM_Defn_IFI = $0002;
+ FM_Defn_Win = $0004;
+ FM_Defn_Generic = $8000;
+ FM_Sel_Italic = $0001;
+ FM_Sel_Underscore = $0002;
+ FM_Sel_Negative = $0004;
+ FM_Sel_Outline = $0008;
+ FM_Sel_Strikeout = $0010;
+ FM_Sel_Bold = $0020;
+ FM_Cap_NoMix = $0001;
+
+ type
+ PCardinal = ^cardinal;
+ PLongint = ^longint;
+ PInteger = ^integer;
+ PShortint = ^shortint;
+ PPointer = ^pointer;
+ PByte = ^byte;
+
+ PointL = record
+ X: longint;
+ Y: longint;
+ end;
+
+ PPointL = ^PointL;
+
+ PointS = record
+ X: integer;
+ Y: integer;
+ end;
+
+ PPointS = ^PointS;
+
+ RectL = record
+ xLeft: longint;
+ yBottom: longint;
+ xRight: longint;
+ yTop: longint;
+ end;
+
+ PRectL = ^RectL;
+
+ NPrectL = ^RectL;
+
+ Str8 = array[0..7] of char;
+
+ PStr8 = ^Str8;
+
+ DrivData = record
+ cb: longint;
+ lVersion: longint;
+ szDeviceName: array[0..31] of char;
+ abGeneralData: array[0..0] of char;
+ end;
+
+ PDrivData = ^DrivData;
+
+ DevOpenStruc = record
+ pszLogAddress: PChar;
+ pszDriverName: PChar;
+ pdriv: PDrivData;
+ pszDataType: PChar;
+ pszComment: PChar;
+ pszQueueProcName: PChar;
+ pszQueueProcParams: PChar;
+ pszSpoolerParams: PChar;
+ pszNetworkParams: PChar;
+ end;
+
+ PDevOpenStruc = ^DevOpenStruc;
+
+ PDevOpenData = PDevOpenStruc;
+
+ PrintDest = record
+ cb: cardinal;
+ lType: longint;
+ pszToken: PChar;
+ lCount: longint;
+ pdopData: PDevOpenData;
+ fl: cardinal;
+ pszPrinter: PChar;
+ end;
+
+ PPrintDest = ^PrintDest;
+
+ FAttrs = record
+ usRecordLength: word;
+ fsSelection: word;
+ lMatch: longint;
+ szFacename: array[0..FaceSize-1] of char;
+ idRegistry: word;
+ usCodePage: word;
+ lMaxBaselineExt: longint;
+ lAveCharWidth: longint;
+ fsType: word;
+ fsFontUse: word;
+ end;
+
+ PFAttrs = ^FAttrs;
+
+ Panose = record
+ bFamilyType: byte;
+ bSerifStyle: byte;
+ bWeight: byte;
+ bProportion: byte;
+ bContrast: byte;
+ bStrokeVariation: byte;
+ bArmStyle: byte;
+ bLetterform: byte;
+ bMidline: byte;
+ bXHeight: byte;
+ abReserved: array[0..1] of byte;
+ end;
+
+ FontMetrics = record
+ szFamilyname: array[0..FaceSize-1] of char;
+ szFacename: array[0..FaceSize-1] of char;
+ idRegistry: word;
+ usCodePage: word;
+ lEmHeight: longint;
+ lXHeight: longint;
+ lMaxAscender: longint;
+ lMaxDescender: longint;
+ lLowerCaseAscent: longint;
+ lLowerCaseDescent: longint;
+ lInternalLeading: longint;
+ lExternalLeading: longint;
+ lAveCharWidth: longint;
+ lMaxCharInc: longint;
+ lEmInc: longint;
+ lMaxBaselineExt: longint;
+ sCharSlope: integer;
+ sInlineDir: integer;
+ sCharRot: integer;
+ usWeightClass: word;
+ usWidthClass: word;
+ sXDeviceRes: integer;
+ sYDeviceRes: integer;
+ sFirstChar: integer;
+ sLastChar: integer;
+ sDefaultChar: integer;
+ sBreakChar: integer;
+ sNominalPointSize: integer;
+ sMinimumPointSize: integer;
+ sMaximumPointSize: integer;
+ fsType: word;
+ fsDefn: word;
+ fsSelection: word;
+ fsCapabilities: word;
+ lSubscriptXSize: longint;
+ lSubscriptYSize: longint;
+ lSubscriptXOffset: longint;
+ lSubscriptYOffset: longint;
+ lSuperscriptXSize: longint;
+ lSuperscriptYSize: longint;
+ lSuperscriptXOffset: longint;
+ lSuperscriptYOffset: longint;
+ lUnderscoreSize: longint;
+ lUnderscorePosition: longint;
+ lStrikeoutSize: longint;
+ lStrikeoutPosition: longint;
+ sKerningPairs: integer;
+ sFamilyClass: integer;
+ lMatch: longint;
+ FamilyNameAtom: longint;
+ FaceNameAtom: longint;
+ _Panose: Panose;
+ end;
+
+ PFontMetrics = ^FontMetrics;
+
+ { Null terminated strings are often declared as array[0..0] of byte }
+ { in header files, the following type makes type conversion possible }
+ CharArray = array[0..0] of char;
+
+{Names beginning with T for compatibility}
+ TPointL = PointL;
+ TPointS = PointS;
+ TRectL = RectL;
+ TStr8 = Str8;
+ TDrivData = DrivData;
+ TDevOpenStruc = DevOpenStruc;
+ TPrintDest = PrintDest;
+ TFAttrs = FAttrs;
+ TPanose = Panose;
+ TFontMetrics = FontMetrics;
+ TCharArray = CharArray;
+
+{Another bunch of compatibility things}
+ HWnd = cardinal;
+ THWnd = HWnd;
+ PHWnd = ^HWnd;
+ HAB = cardinal;
+ THAB = HAB;
+ PHAB = ^HAB;
+ HMQ = cardinal;
+ THMQ = HMQ;
+ PHMQ = ^HMQ;
+ HPS = cardinal;
+ THPS = HPS;
+ PHPS = ^HPS;
+ HRGN = cardinal;
+ THRGN = HRGN;
+ PHRGN = ^HRGN;
+ HBitmap = cardinal;
+ THBitmap = HBitmap;
+ PHBitmap = ^HBitmap;
+ HEv = cardinal;
+ THEv = HEv;
+ PHEv = ^HEv;
+ HMtx = cardinal;
+ THMtx = HMtx;
+ PHMtx = ^HMtx;
+ ULONG = cardinal;
+ MParam = cardinal;
+ MResult = cardinal;
+ Fixed = longint;
+ Fixed88 = integer;
+
+{ Constants from bseord.h header file (ordinal numbers of API functions) }
+
+ const
+ Ord_AnsiINJECT = 1;
+ Ord_AnsiKEYDEF = 2;
+ Ord_AnsiINTERP = 3;
+ Ord_NlsCONVERTBIDINUMERICS = 1;
+ Ord_NlsCONVERTBIDISTRING = 2;
+ Ord_NlsSETBIDIATT = 5;
+ Ord_NlsQUERYBIDIATT = 6;
+ Ord_NlsINVERSESTRING = 7;
+ Ord_NlsSETBIDIPRINT = 8;
+ Ord_NlsEDITSHAPE = 9;
+ Ord_NlsSHAPEBIDISTRING = 10;
+ Ord_NlsINTSETBIDIATT = 3;
+ Ord_NlsINTQUERYBIDIATT = 4;
+ Ord_NLPOPUP = 11;
+ Ord_BksMAIN = 1;
+ Ord_DrgACCESSDRAGINFO = 1;
+ Ord_DrgADDSTRHANDLE = 2;
+ Ord_DrgALLOCDRAGINFO = 3;
+ Ord_DrgALLOCDRAGTRANSFER = 4;
+ Ord_DrgDELETEDRAGINFOSTRHANDLES = 5;
+ Ord_DrgDELETESTRHANDLE = 6;
+ Ord_DrgDRAG = 7;
+ Ord_DrgFREEDRAGINFO = 8;
+ Ord_DrgFREEDRAGTRANSFER = 9;
+ Ord_DrgGETPS = 10;
+ Ord_DrgPOSTTRANSFERMSG = 11;
+ Ord_DrgPUSHDRAGINFO = 12;
+ Ord_DrgQUERYDRAGITEM = 13;
+ Ord_DrgQUERYDRAGITEMCOUNT = 14;
+ Ord_DrgQUERYDRAGITEMPTR = 15;
+ Ord_DrgQUERYNATIVERMF = 16;
+ Ord_DrgQUERYNATIVERMFLEN = 17;
+ Ord_DrgQUERYSTRNAME = 18;
+ Ord_DrgQUERYSTRNAMELEN = 19;
+ Ord_DrgQUERYTRUETYPE = 20;
+ Ord_DrgQUERYTRUETYPELEN = 21;
+ Ord_DrgRELEASEPS = 22;
+ Ord_DrgSENDTRANSFERMSG = 23;
+ Ord_DrgSETDRAGPOINTER = 24;
+ Ord_DrgSETDRAGIMAGE = 25;
+ Ord_DrgSETDRAGITEM = 26;
+ Ord_DrgVERIFYNATIVERMF = 27;
+ Ord_DrgVERIFYRMF = 28;
+ Ord_DrgVERIFYTRUETYPE = 29;
+ Ord_DrgVERIFYTYPE = 30;
+ Ord_DrgVERIFYTYPESET = 31;
+ Ord_DrgDRAGFILES = 63;
+ Ord_DrgACCEPTDROPPEDFILES = 64;
+ Ord_Drg32ACCESSDRAGINFO = 32;
+ Ord_Drg32ADDSTRHANDLE = 33;
+ Ord_Drg32ALLOCDRAGINFO = 34;
+ Ord_Drg32ALLOCDRAGTRANSFER = 35;
+ Ord_Drg32DELETEDRAGINFOSTRHANDLES = 36;
+ Ord_Drg32DELETESTRHANDLE = 37;
+ Ord_Drg32DRAG = 38;
+ Ord_Drg32FREEDRAGINFO = 39;
+ Ord_Drg32FREEDRAGTRANSFER = 40;
+ Ord_Drg32GETPS = 41;
+ Ord_Drg32POSTTRANSFERMSG = 42;
+ Ord_Drg32PUSHDRAGINFO = 43;
+ Ord_Drg32QUERYDRAGITEM = 44;
+ Ord_Drg32QUERYDRAGITEMCOUNT = 45;
+ Ord_Drg32QUERYDRAGITEMPTR = 46;
+ Ord_Drg32QUERYNATIVERMF = 47;
+ Ord_Drg32QUERYNATIVERMFLEN = 48;
+ Ord_Drg32QUERYSTRNAME = 49;
+ Ord_Drg32QUERYSTRNAMELEN = 50;
+ Ord_Drg32QUERYTRUETYPE = 51;
+ Ord_Drg32QUERYTRUETYPELEN = 52;
+ Ord_Drg32RELEASEPS = 53;
+ Ord_Drg32SENDTRANSFERMSG = 54;
+ Ord_Drg32SETDRAGPOINTER = 55;
+ Ord_Drg32SETDRAGIMAGE = 56;
+ Ord_Drg32SETDRAGITEM = 57;
+ Ord_Drg32VERIFYNATIVERMF = 58;
+ Ord_Drg32VERIFYRMF = 59;
+ Ord_Drg32VERIFYTRUETYPE = 60;
+ Ord_Drg32VERIFYTYPE = 61;
+ Ord_Drg32VERIFYTYPESET = 62;
+ Ord_Drg32DRAGFILES = 65;
+ Ord_Drg32ACCEPTDROPPEDFILES = 66;
+ Ord_FKAINIT = 64;
+ Ord_QUERYFKADISPLAYDETAILS = 65;
+ Ord_WinFKAWNDPROC = 66;
+ Ord_WinLOADFKA = 67;
+ Ord_WinCREATEFKA = 68;
+ Ord_WinSETFKAFORM = 69;
+ Ord_WinQUERYFKAFORM = 70;
+ Ord_WinGOTOFKA = 71;
+ Ord_WinGOFROMFKA = 72;
+ Ord_WinCREATEHELPINSTANCE = 1;
+ Ord_WinDESTROYHELPINSTANCE = 2;
+ Ord_WinQUERYHELPINSTANCE = 3;
+ Ord_WinASSOCIATEHELPINSTANCE = 4;
+ Ord_WinLOADHELPTABLE = 5;
+ Ord_WinCREATEHELPTABLE = 6;
+ Ord_Win32CREATEHELPINSTANCE = 51;
+ Ord_Win32DESTROYHELPINSTANCE = 52;
+ Ord_Win32QUERYHELPINSTANCE = 53;
+ Ord_Win32ASSOCIATEHELPINSTANCE = 54;
+ Ord_Win32LOADHELPTABLE = 55;
+ Ord_Win32CREATEHELPTABLE = 56;
+ Ord_DDFINITIALIZE = 74;
+ Ord_DDFPARA = 75;
+ Ord_DDFSETFORMAT = 76;
+ Ord_DDFSETTEXTALIGN = 77;
+ Ord_DDFSETCOLOR = 78;
+ Ord_DDFINFORM = 79;
+ Ord_DDFSETFONTSTYLE = 80;
+ Ord_DDFHYPERTEXT = 81;
+ Ord_DDFBEGINLIST = 82;
+ Ord_DDFLISTITEM = 83;
+ Ord_DDFENDLIST = 84;
+ Ord_DDFTEXT = 85;
+ Ord_DDFMETAFILE = 86;
+ Ord_DDFSETFONT = 87;
+ Ord_DDFBITMAP = 88;
+ Ord_KbdSETCUSTXT = 1;
+ Ord_KbdGETCP = 3;
+ Ord_KbdCHARIN = 4;
+ Ord_KbdSETCP = 5;
+ Ord_KbdSYNCH = 7;
+ Ord_KbdREGISTER = 8;
+ Ord_KbdSTRINGIN = 9;
+ Ord_KbdGETSTATUS = 10;
+ Ord_KbdSETSTATUS = 11;
+ Ord_KbdGETFOCUS = 12;
+ Ord_KbdFLUSHBUFFER = 13;
+ Ord_KbdXLATE = 14;
+ Ord_KbdCLOSE = 17;
+ Ord_KbdFREEFOCUS = 18;
+ Ord_KbdDEREGISTER = 20;
+ Ord_KbdSETFGND = 21;
+ Ord_KbdPEEK = 22;
+ Ord_KbdOPEN = 23;
+ Ord_KbdGETHWID = 24;
+ Ord_KbdSETHWID = 25;
+ Ord_DosMONOPEN = 4;
+ Ord_DosMONCLOSE = 3;
+ Ord_DosMONREAD = 2;
+ Ord_DosMONWRITE = 1;
+ Ord_DosMONREG = 5;
+ Ord_MouGETPTRSHAPE = 1;
+ Ord_MouSETPTRSHAPE = 2;
+ Ord_MouGETNUMMICKEYS = 3;
+ Ord_MouGETHOTKEY = 4;
+ Ord_MouGETSCALEFACT = 6;
+ Ord_MouFLUSHQUE = 7;
+ Ord_MouGETNUMBUTTONS = 8;
+ Ord_MouCLOSE = 9;
+ Ord_MouSETHOTKEY = 10;
+ Ord_MouSETSCALEFACT = 11;
+ Ord_MouGETNUMQUEEL = 13;
+ Ord_MouDEREGISTER = 14;
+ Ord_MouGETEVENTMASK = 15;
+ Ord_MouSETEVENTMASK = 16;
+ Ord_MouOPEN = 17;
+ Ord_MouREMOVEPTR = 18;
+ Ord_MouGETPTRPOS = 19;
+ Ord_MouREADEVENTQUE = 20;
+ Ord_MouSETPTRPOS = 21;
+ Ord_MouGETDEVSTATUS = 22;
+ Ord_MouSYNCH = 23;
+ Ord_MouREGISTER = 24;
+ Ord_MouSETDEVSTATUS = 25;
+ Ord_MouDRAWPTR = 26;
+ Ord_MouINITREAL = 27;
+ Ord_MouGETTHRESHOLD = 29;
+ Ord_MouSETTHRESHOLD = 30;
+ Ord_DosPUTMESSAGE = 1;
+ Ord_DosTRUEGETMESSAGE = 2;
+ Ord_DosINSMESSAGE = 3;
+ Ord_Dos32INSERTMESSAGE = 4;
+ Ord_Dos32PUTMESSAGE = 5;
+ Ord_Dos32TRUEGETMESSAGE = 6;
+ Ord_DosIQUERYMESSAGECP = 7;
+ Ord_Dos32IQUERYMESSAGECP = 8;
+ Ord_DosCASEMAP = 1;
+ Ord_DosGETCOLLATE = 2;
+ Ord_DosGETCTRYINFO = 3;
+ Ord_DosGETDBCSEV = 4;
+ Ord_Dos32QUERYCTRYINFO = 5;
+ Ord_Dos32QUERYDBCSENV = 6;
+ Ord_Dos32MAPCASE = 7;
+ Ord_Dos32QUERYCOLLATE = 8;
+ Ord_DosMAKENMPIPE = 1;
+ Ord_DosQNMPIPEINFO = 2;
+ Ord_DosCONNECTNMPIPE = 3;
+ Ord_DosDISCONNECTNMPIPE = 4;
+ Ord_DosQNMPHANDSTATE = 5;
+ Ord_DosSETNMPHANDSTATE = 6;
+ Ord_DosPEEKNMPIPE = 7;
+ Ord_DosWAITNMPIPE = 8;
+ Ord_DosTRANSACTNMPIPE = 9;
+ Ord_DosCALLNMPIPE = 10;
+ Ord_DosRAWREADNMPIPE = 11;
+ Ord_DosRAWWRITENMPIPE = 12;
+ Ord_DosSETNMPIPESEM = 13;
+ Ord_DosQNMPIPESEMSTATE = 14;
+ Ord_DosCWAIT = 2;
+ Ord_DosENTERCRITSEC = 3;
+ Ord_DosEXIT = 5;
+ Ord_DosEXITCRITSEC = 6;
+ Ord_DosEXITLIST = 7;
+ Ord_DosGETINFOSEG = 8;
+ Ord_DosGETPRTY = 9;
+ Ord_DosKILLPROCESS = 10;
+ Ord_DosSETPRTY = 11;
+ Ord_DosPTRACE = 12;
+ Ord_DosHOLDSIGNAL = 13;
+ Ord_DosSETSIGHANDLER = 14;
+ Ord_DosFLAGPROCESS = 15;
+ Ord_DosMAKEPIPE = 16;
+ Ord_DosSEMSETWAIT = 20;
+ Ord_DosMUXSEMWAIT = 22;
+ Ord_DosCLOSESEM = 23;
+ Ord_DosCREATESEM = 24;
+ Ord_DosOPENSEM = 25;
+ Ord_DosRESUMETHREAD = 26;
+ Ord_DosSUSPENDTHREAD = 27;
+ Ord_DosSETDATETIME = 28;
+ Ord_DosTIMERASYNC = 29;
+ Ord_DosTIMERSTART = 30;
+ Ord_DosTIMERSTOP = 31;
+ Ord_DosSLEEP = 32;
+ Ord_DosGETDATETIME = 33;
+ Ord_DosALLOCSEG = 34;
+ Ord_DosALLOCSHRSEG = 35;
+ Ord_DosGETSHRSEG = 36;
+ Ord_DosGIVESEG = 37;
+ Ord_DosREALLOCSEG = 38;
+ Ord_DosFREESEG = 39;
+ Ord_DosALLOCHUGE = 40;
+ Ord_DosGETHUGESHIFT = 41;
+ Ord_DosREALLOCHUGE = 42;
+ Ord_DosCREATECSALIAS = 43;
+ Ord_DosLOADMODULE = 44;
+ Ord_DosGETPROCADDR = 45;
+ Ord_DosFREEMODULE = 46;
+ Ord_DosGETMODHANDLE = 47;
+ Ord_DosGETMODNAME = 48;
+ Ord_DosGETMACHINEMODE = 49;
+ Ord_DosBEEP = 50;
+ Ord_DosCLIACCESS = 51;
+ Ord_DosDEVCONFIG = 52;
+ Ord_DosDEVIOCTL = 53;
+ Ord_DosBUFRESET = 56;
+ Ord_DosCHDIR = 57;
+ Ord_DosCHGFILEPTR = 58;
+ Ord_DosCLOSE = 59;
+ Ord_DosDELETE = 60;
+ Ord_DosDUPHANDLE = 61;
+ Ord_DosFILELOCKS = 62;
+ Ord_DosFINDCLOSE = 63;
+ Ord_DosFINDFIRST = 64;
+ Ord_DosFINDNEXT = 65;
+ Ord_DosMKDIR = 66;
+ Ord_DosMOVE = 67;
+ Ord_DosNEWSIZE = 68;
+ Ord_DosPORTACCESS = 69;
+ Ord_DosOPEN = 70;
+ Ord_DosQCURDIR = 71;
+ Ord_DosQCURDISK = 72;
+ Ord_DosQFHANDSTATE = 73;
+ Ord_DosQFILEINFO = 74;
+ Ord_DosQFILEMODE = 75;
+ Ord_DosQFSINFO = 76;
+ Ord_DosQHANDTYPE = 77;
+ Ord_DosQVERIFY = 78;
+ Ord_DosRMDIR = 80;
+ Ord_DosSELECTDISK = 81;
+ Ord_DosSETFHANDSTATE = 82;
+ Ord_DosSETFILEINFO = 83;
+ Ord_DosSETFILEMODE = 84;
+ Ord_DosSETMAXFH = 85;
+ Ord_DosSETVERIFY = 86;
+ Ord_DosSYSTEMSERVICE = 88;
+ Ord_DosSETVEC = 89;
+ Ord_DosSYSTRACE = 90;
+ Ord_DosGETENV = 91;
+ Ord_DosGETVERSION = 92;
+ Ord_DosGETPID = 94;
+ Ord_DosOPEN2 = 95;
+ Ord_DosLIBINIT = 96;
+ Ord_DosSETFSINFO = 97;
+ Ord_DosQPATHINFO = 98;
+ Ord_DosDEVIOCTL2 = 99;
+ Ord_DosSETPATHINFO = 104;
+ Ord_DosISETRELMAXFH = 108;
+ Ord_DosIDEVIOCTL = 109;
+ Ord_Dos32FORCEDELETE = 110;
+ Ord_Dos32KILLTHREAD = 111;
+ Ord_DosQUERYRASINFO = 112;
+ Ord_DosERROR = 120;
+ Ord_DosGETSEG = 121;
+ Ord_DosLOCKSEG = 122;
+ Ord_DosUNLOCKSEG = 123;
+ Ord_DosSIZESEG = 126;
+ Ord_DosMEMAVAIL = 127;
+ Ord_DosPHYSICALDISK = 129;
+ Ord_DosGETCP = 130;
+ Ord_DosSENDSIGNAL = 134;
+ Ord_DosHUGESHIFT = 135;
+ Ord_DosHUGEINCR = 136;
+ Ord_DosREAD = 137;
+ Ord_DosWRITE = 138;
+ Ord_DosERRCLASS = 139;
+ Ord_DosSEMREQUEST = 140;
+ Ord_DosSEMCLEAR = 141;
+ Ord_DosSEMWAIT = 142;
+ Ord_DosSEMSET = 143;
+ Ord_DosEXECPGM = 144;
+ Ord_DosCREATETHREAD = 145;
+ Ord_DosSUBSET = 146;
+ Ord_DosSUBALLOC = 147;
+ Ord_DosSUBFREE = 148;
+ Ord_DosREADASYNC = 149;
+ Ord_DosWRITEASYNC = 150;
+ Ord_DosSEARCHPATH = 151;
+ Ord_DosSCANENV = 152;
+ Ord_DosSETCP = 153;
+ Ord_DosGETRESOURCE = 155;
+ Ord_DosGETPPID = 156;
+ Ord_DosCALLBACK = 157;
+ Ord_DosR2STACKREALLOC = 160;
+ Ord_DosFSRAMSEMREQUEST = 161;
+ Ord_DosFSRAMSEMCLEAR = 162;
+ Ord_DosQAPPTYPE = 163;
+ Ord_DosSETPROCCP = 164;
+ Ord_DosDYNAMICTRACE = 165;
+ Ord_DosQSYSINFO = 166;
+ Ord_DosFSATTACH = 181;
+ Ord_DosQFSATTACH = 182;
+ Ord_DosFSCTL = 183;
+ Ord_DosFINDFIRST2 = 184;
+ Ord_DosMKDIR2 = 185;
+ Ord_DosFILEIO = 186;
+ Ord_DosFINDNOTIFYCLOSE = 187;
+ Ord_DosFINDNOTIFYFIRST = 188;
+ Ord_DosFINDNOTIFYNEXT = 189;
+ Ord_DosEDITNAME = 191;
+ Ord_DosCOPY = 201;
+ Ord_DosFORCEDELETE = 203;
+ Ord_DosENUMATTRIBUTE = 204;
+ Ord_DosSHUTDOWN = 206;
+ Ord_DosGETRESOURCE2 = 207;
+ Ord_DosFREERESOURCE = 208;
+ Ord_Dos32SETMAXFH = 209;
+ Ord_Dos32SETVERIFY = 210;
+ Ord_Dos32ERRCLASS = 211;
+ Ord_Dos32ERROR = 212;
+ Ord_DosMAXPATHLEN = 214;
+ Ord_DosPAGESIZE = 215;
+ Ord_DosLOCALINFO = 216;
+ Ord_DosGLOBALINFO = 217;
+ Ord_Dos32SETFILEINFO = 218;
+ Ord_Dos32SETPATHINFO = 219;
+ Ord_Dos32SETDEFAULTDISK = 220;
+ Ord_Dos32SETFHSTATE = 221;
+ Ord_Dos32SETFSINFO = 222;
+ Ord_Dos32QUERYPATHINFO = 223;
+ Ord_Dos32QUERYHTYPE = 224;
+ Ord_Dos32QUERYVERIFY = 225;
+ Ord_Dos32DELETEDIR = 226;
+ Ord_Dos32SCANENV = 227;
+ Ord_Dos32SEARCHPATH = 228;
+ Ord_Dos32SLEEP = 229;
+ Ord_Dos32GETDATETIME = 230;
+ Ord_Dos32DEVCONFIG = 231;
+ Ord_Dos32ENTERCRITSEC = 232;
+ Ord_Dos32EXITCRITSEC = 233;
+ Ord_Dos32EXIT = 234;
+ Ord_Dos32KILLPROCESS = 235;
+ Ord_Dos32SETPRIORITY = 236;
+ Ord_Dos32RESUMETHREAD = 237;
+ Ord_Dos32SUSPENDTHREAD = 238;
+ Ord_Dos32CREATEPIPE = 239;
+ Ord_Dos32CALLNPIPE = 240;
+ Ord_Dos32CONNECTNPIPE = 241;
+ Ord_Dos32DISCONNECTNPIPE = 242;
+ Ord_Dos32CREATENPIPE = 243;
+ Ord_Dos32PEEKNPIPE = 244;
+ Ord_Dos32QUERYNPHSTATE = 245;
+ Ord_Dos32RAWREADNPIPE = 246;
+ Ord_Dos32RAWWRITENPIPE = 247;
+ Ord_Dos32QUERYNPIPEINFO = 248;
+ Ord_Dos32QUERYNPIPESEMSTATE = 249;
+ Ord_Dos32SETNPHSTATE = 250;
+ Ord_Dos32SETNPIPESEM = 251;
+ Ord_Dos32TRANSACTNPIPE = 252;
+ Ord_Dos32WAITNPIPE = 253;
+ Ord_Dos32RESETBUFFER = 254;
+ Ord_Dos32SETCURRENTDIR = 255;
+ Ord_Dos32SETFILEPTR = 256;
+ Ord_Dos32CLOSE = 257;
+ Ord_Dos32COPY = 258;
+ Ord_Dos32DELETE = 259;
+ Ord_Dos32DUPHANDLE = 260;
+ Ord_Dos32EDITNAME = 261;
+ Ord_Dos32FINDCLOSE = 263;
+ Ord_Dos32FINDFIRST = 264;
+ Ord_Dos32FINDNEXT = 265;
+ Ord_DosOPENVDD = 266;
+ Ord_DosREQUESTVDD = 267;
+ Ord_DosCLOSEVDD = 268;
+ Ord_Dos32FSATTACH = 269;
+ Ord_Dos32CREATEDIR = 270;
+ Ord_Dos32MOVE = 271;
+ Ord_Dos32SETFILESIZE = 272;
+ Ord_Dos32OPEN = 273;
+ Ord_Dos32QUERYCURRENTDIR = 274;
+ Ord_Dos32QUERYCURRENTDISK = 275;
+ Ord_Dos32QUERYFHSTATE = 276;
+ Ord_Dos32QUERYFSATTACH = 277;
+ Ord_Dos32QUERYFSINFO = 278;
+ Ord_Dos32QUERYFILEINFO = 279;
+ Ord_Dos32WAITCHILD = 280;
+ Ord_Dos32READ = 281;
+ Ord_Dos32WRITE = 282;
+ Ord_Dos32EXECPGM = 283;
+ Ord_Dos32DEVIOCTL = 284;
+ Ord_Dos32FSCTL = 285;
+ Ord_Dos32BEEP = 286;
+ Ord_Dos32PHYSICALDISK = 287;
+ Ord_Dos32SETCP = 288;
+ Ord_Dos32SETPROCESSCP = 289;
+ Ord_Dos32STOPTIMER = 290;
+ Ord_Dos32QUERYCP = 291;
+ Ord_Dos32SETDATETIME = 292;
+ Ord_Dos32EXITLIST = 296;
+ Ord_Dos32ALLOCMEM = 299;
+ Ord_Dos32ALLOCSHAREDMEM = 300;
+ Ord_Dos32GETNAMEDSHAREDMEM = 301;
+ Ord_Dos32GETSHAREDMEM = 302;
+ Ord_Dos32GIVESHAREDMEM = 303;
+ Ord_Dos32FREEMEM = 304;
+ Ord_Dos32SETMEM = 305;
+ Ord_Dos32QUERYMEM = 306;
+ Ord_Dos32OPENVDD = 308;
+ Ord_Dos32REQUESTVDD = 309;
+ Ord_Dos32CLOSEVDD = 310;
+ Ord_Dos32CREATETHREAD = 311;
+ Ord_Dos32GETINFOBLOCKS = 312;
+ Ord_Dos32DYNAMICTRACE = 316;
+ Ord_Dos32DEBUG = 317;
+ Ord_Dos32LOADMODULE = 318;
+ Ord_Dos32QUERYMODULEHANDLE = 319;
+ Ord_Dos32QUERYMODULENAME = 320;
+ Ord_Dos32QUERYPROCADDR = 321;
+ Ord_Dos32FREEMODULE = 322;
+ Ord_Dos32QUERYAPPTYPE = 323;
+ Ord_Dos32CREATEEVENTSEM = 324;
+ Ord_Dos32OPENEVENTSEM = 325;
+ Ord_Dos32CLOSEEVENTSEM = 326;
+ Ord_Dos32RESETEVENTSEM = 327;
+ Ord_Dos32POSTEVENTSEM = 328;
+ Ord_Dos32WAITEVENTSEM = 329;
+ Ord_Dos32QUERYEVENTSEM = 330;
+ Ord_Dos32CREATEMUTEXSEM = 331;
+ Ord_Dos32OPENMUTEXSEM = 332;
+ Ord_Dos32CLOSEMUTEXSEM = 333;
+ Ord_Dos32REQUESTMUTEXSEM = 334;
+ Ord_Dos32RELEASEMUTEXSEM = 335;
+ Ord_Dos32QUERYMUTEXSEM = 336;
+ Ord_Dos32CREATEMUXWAITSEM = 337;
+ Ord_Dos32OPENMUXWAITSEM = 338;
+ Ord_Dos32CLOSEMUXWAITSEM = 339;
+ Ord_Dos32WAITMUXWAITSEM = 340;
+ Ord_Dos32ADDMUXWAITSEM = 341;
+ Ord_Dos32DELETEMUXWAITSEM = 342;
+ Ord_Dos32QUERYMUXWAITSEM = 343;
+ Ord_Dos32SUBSETMEM = 344;
+ Ord_Dos32SUBALLOCMEM = 345;
+ Ord_Dos32SUBFREEMEM = 346;
+ Ord_Dos32SUBUNSETMEM = 347;
+ Ord_Dos32QUERYSYSINFO = 348;
+ Ord_Dos32WAITTHREAD = 349;
+ Ord_Dos32ASYNCTIMER = 350;
+ Ord_Dos32STARTTIMER = 351;
+ Ord_Dos32GETRESOURCE = 352;
+ Ord_Dos32FREERESOURCE = 353;
+ Ord_Dos32SETEXCEPTIONHANDLER = 354;
+ Ord_Dos32UNSETEXCEPTIONHANDLER = 355;
+ Ord_Dos32RAISEEXCEPTION = 356;
+ Ord_Dos32UNWINDEXCEPTION = 357;
+ Ord_Dos32TMRQUERYFREQ = 362;
+ Ord_Dos32TMRQUERYTIME = 363;
+ Ord_Dos32REGISTERPERFCTRS = 367;
+ Ord_Dos32ENUMATTRIBUTE = 372;
+ Ord_Dos32QUERYDOSPROPERTY = 373;
+ Ord_Dos32SETDOSPROPERTY = 374;
+ Ord_DosQUERYDOSPROPERTY = 375;
+ Ord_DosSETDOSPROPERTY = 376;
+ Ord_Dos32PROFILE = 377;
+ Ord_Dos32SETSIGNALEXCEPTIONFOC = 378;
+ Ord_Dos32SENDSIGNALEXCEPTION = 379;
+ Ord_Dos32ENTERMUSTCOMPLETE = 380;
+ Ord_Dos32EXITMUSTCOMPLETE = 381;
+ Ord_Dos32SETRELMAXFH = 382;
+ Ord_Dos32SHUTDOWN = 415;
+ Ord_Dos32REPLACEMODULE = 417;
+ Ord_Dos32ACKNOWLEDGESIGNALEXC = 418;
+ Ord_Dos32TIB = 419;
+ Ord_DosTMRQUERYFREQ = 420;
+ Ord_DosTMRQUERYTIME = 421;
+ Ord_DosREGISTERPERFCTRS = 422;
+ Ord_DosFLATTOSEL = 423;
+ Ord_DosSELTOFLAT = 424;
+ Ord_Dos32FLATTOSEL = 425;
+ Ord_Dos32SELTOFLAT = 426;
+ Ord_Dos32SETFILELOCKS = 428;
+ Ord_Dos32CANCELLOCKREQUEST = 429;
+ Ord_DosOPENCHANGENOTIFY = 437;
+ Ord_DosRESETCHANGENOTIFY = 438;
+ Ord_DosCLOSECHANGENOTIFY = 439;
+ Ord_Dos32OPENCHANGENOTIFY = 440;
+ Ord_Dos32RESETCHANGENOTIFY = 441;
+ Ord_Dos32CLOSECHANGENOTIFY = 442;
+ Ord_Dos32QUERYRESOURCESIZE = 572;
+ Ord_DosQUERYRESOURCESIZE = 573;
+ Ord_Dos32INITIALIZEPORTHOLE = 580;
+ Ord_Dos32QUERYHEADERINFO = 582;
+ Ord_DosINITIALIZEPORTHOLE = 583;
+ Ord_DosQUERYHEADERINFO = 584;
+ Ord_Dos32QUERYPROCTYPE = 586;
+ Ord_DosQUERYPROCTYPE = 587;
+ Ord_DevOPENDC = 1;
+ Ord_DevCLOSEDC = 2;
+ Ord_DevPOSTDEVICEMODES = 3;
+ Ord_DevESCAPE = 4;
+ Ord_DevQUERYHARDCOPYCAPS = 5;
+ Ord_DevQUERYCAPS = 6;
+ Ord_GpiCREATEPS = 7;
+ Ord_GpiQUERYPS = 9;
+ Ord_GpiDESTROYPS = 10;
+ Ord_GpiRESETPS = 11;
+ Ord_GpiSAVEPS = 12;
+ Ord_GpiRESTOREPS = 13;
+ Ord_GpiASSOCIATE = 14;
+ Ord_GpiERRORSEGMENTDATA = 15;
+ Ord_GpiERASE = 16;
+ Ord_GpiSETDRAWCONTROL = 17;
+ Ord_GpiQUERYDRAWCONTROL = 18;
+ Ord_GpiDRAWCHAIN = 19;
+ Ord_GpiDRAWFROM = 20;
+ Ord_GpiDRAWSEGMENT = 21;
+ Ord_GpiSETSTOPDRAW = 22;
+ Ord_GpiQUERYSTOPDRAW = 23;
+ Ord_GpiREMOVEDYNAMICS = 24;
+ Ord_GpiDRAWDYNAMICS = 25;
+ Ord_GpiSETDRAWINGMODE = 26;
+ Ord_GpiQUERYDRAWINGMODE = 27;
+ Ord_GpiGETDATA = 28;
+ Ord_GpiPUTDATA = 29;
+ Ord_GpiSETPICKAPERTURESIZE = 30;
+ Ord_GpiQUERYPICKAPERTURESIZE = 31;
+ Ord_GpiSETPICKAPERTUREPOSITION = 32;
+ Ord_GpiQUERYPICKAPERTUREPOSITION = 33;
+ Ord_GpiSETTAG = 34;
+ Ord_GpiQUERYTAG = 35;
+ Ord_GpiCORRELATECHAIN = 36;
+ Ord_GpiCORRELATEFROM = 37;
+ Ord_GpiCORRELATESEGMENT = 38;
+ Ord_GpiRESETBOUNDARYDATA = 42;
+ Ord_GpiQUERYBOUNDARYDATA = 43;
+ Ord_GpiOPENSEGMENT = 44;
+ Ord_GpiCLOSESEGMENT = 46;
+ Ord_GpiDELETESEGMENT = 47;
+ Ord_GpiDELETESEGMENTS = 48;
+ Ord_GpiQUERYSEGMENTNAMES = 49;
+ Ord_GpiSETINITIALSEGMENTATTRS = 51;
+ Ord_GpiQUERYINITIALSEGMENTATTRS = 52;
+ Ord_GpiSETSEGMENTATTRS = 53;
+ Ord_GpiQUERYSEGMENTATTRS = 54;
+ Ord_GpiSETSEGMENTPRIORITY = 55;
+ Ord_GpiQUERYSEGMENTPRIORITY = 56;
+ Ord_GpiSETEDITMODE = 57;
+ Ord_GpiQUERYEDITMODE = 58;
+ Ord_GpiSETELEMENTPOINTER = 59;
+ Ord_GpiQUERYELEMENTPOINTER = 60;
+ Ord_GpiOFFSETELEMENTPOINTER = 61;
+ Ord_GpiDELETEELEMENT = 62;
+ Ord_GpiDELETEELEMENTRANGE = 63;
+ Ord_GpiLABEL = 64;
+ Ord_GpiSETELEMENTPOINTERATLABEL = 65;
+ Ord_GpiDELETEELEMENTSBETWEENLABELS = 66;
+ Ord_GpiQUERYELEMENTTYPE = 67;
+ Ord_GpiQUERYELEMENT = 68;
+ Ord_GpiELEMENT = 69;
+ Ord_GpiBEGINELEMENT = 70;
+ Ord_GpiENDELEMENT = 71;
+ Ord_GpiSETSEGMENTTRANSFORMMATRIX = 78;
+ Ord_GpiQUERYSEGMENTTRANSFORMMATRIX = 79;
+ Ord_GpiSETMODELTRANSFORMMATRIX = 80;
+ Ord_GpiQUERYMODELTRANSFORMMATRIX = 81;
+ Ord_GpiCALLSEGMENTMATRIX = 82;
+ Ord_GpiSETDEFAULTVIEWMATRIX = 83;
+ Ord_GpiQUERYDEFAULTVIEWMATRIX = 84;
+ Ord_GpiSETPAGEVIEWPORT = 85;
+ Ord_GpiQUERYPAGEVIEWPORT = 86;
+ Ord_GpiSETVIEWINGTRANSFORMMATRIX = 87;
+ Ord_GpiQUERYVIEWINGTRANSFORMMATRIX = 88;
+ Ord_GpiSETGRAPHICSFIELD = 89;
+ Ord_GpiQUERYGRAPHICSFIELD = 90;
+ Ord_GpiSETVIEWINGLIMITS = 91;
+ Ord_GpiQUERYVIEWINGLIMITS = 92;
+ Ord_GpiCONVERT = 93;
+ Ord_GpiSETATTRMODE = 94;
+ Ord_GpiQUERYATTRMODE = 95;
+ Ord_GpiPOP = 96;
+ Ord_GpiSETATTRS = 97;
+ Ord_GpiQUERYATTRS = 98;
+ Ord_GpiCREATELOGCOLORTABLE = 99;
+ Ord_GpiREALIZECOLORTABLE = 100;
+ Ord_GpiUNREALIZECOLORTABLE = 101;
+ Ord_GpiQUERYCOLORDATA = 102;
+ Ord_GpiQUERYLOGCOLORTABLE = 103;
+ Ord_GpiQUERYREALCOLORS = 104;
+ Ord_GpiQUERYNEARESTCOLOR = 105;
+ Ord_GpiQUERYCOLORINDEX = 106;
+ Ord_GpiQUERYRGBCOLOR = 107;
+ Ord_GpiSETCOLOR = 108;
+ Ord_GpiQUERYCOLOR = 109;
+ Ord_GpiSETBACKCOLOR = 110;
+ Ord_GpiQUERYBACKCOLOR = 111;
+ Ord_GpiSETMIX = 112;
+ Ord_GpiQUERYMIX = 113;
+ Ord_GpiSETBACKMIX = 114;
+ Ord_GpiQUERYBACKMIX = 115;
+ Ord_GpiSETLINETYPE = 116;
+ Ord_GpiQUERYLINETYPE = 117;
+ Ord_GpiSETLINEWIDTH = 118;
+ Ord_GpiQUERYLINEWIDTH = 119;
+ Ord_GpiSETLINEWIDTHGEOM = 120;
+ Ord_GpiQUERYLINEWIDTHGEOM = 121;
+ Ord_GpiSETLINEEND = 122;
+ Ord_GpiQUERYLINEEND = 123;
+ Ord_GpiSETLINEJOIN = 124;
+ Ord_GpiQUERYLINEJOIN = 125;
+ Ord_GpiSETCURRENTPOSITION = 126;
+ Ord_GpiQUERYCURRENTPOSITION = 127;
+ Ord_GpiMOVE = 128;
+ Ord_GpiLINE = 129;
+ Ord_GpiPOLYLINE = 130;
+ Ord_GpiBOX = 131;
+ Ord_GpiPTVISIBLE = 132;
+ Ord_GpiRECTVISIBLE = 133;
+ Ord_GpiSETARCPARAMS = 134;
+ Ord_GpiQUERYARCPARAMS = 135;
+ Ord_GpiPOINTARC = 136;
+ Ord_GpiFULLARC = 137;
+ Ord_GpiPARTIALARC = 138;
+ Ord_GpiPOLYFILLET = 139;
+ Ord_GpiPOLYFILLETSHARP = 140;
+ Ord_GpiPOLYSPLINE = 141;
+ Ord_GpiSETBITMAPID = 142;
+ Ord_GpiQUERYBITMAPHANDLE = 143;
+ Ord_GpiSETPATTERNSET = 144;
+ Ord_GpiQUERYPATTERNSET = 145;
+ Ord_GpiSETPATTERN = 146;
+ Ord_GpiQUERYPATTERN = 147;
+ Ord_GpiSETPATTERNREFPOINT = 148;
+ Ord_GpiQUERYPATTERNREFPOINT = 149;
+ Ord_GpiBEGINAREA = 150;
+ Ord_GpiENDAREA = 151;
+ Ord_GpiLOADFONTS = 152;
+ Ord_GpiUNLOADFONTS = 153;
+ Ord_GpiCREATELOGFONT = 154;
+ Ord_GpiDELETESETID = 155;
+ Ord_GpiQUERYNUMBERSETIDS = 156;
+ Ord_GpiQUERYSETIDS = 157;
+ Ord_GpiQUERYFONTS = 158;
+ Ord_GpiQUERYFONTMETRICS = 159;
+ Ord_GpiQUERYKERNINGPAIRS = 160;
+ Ord_GpiQUERYWIDTHTABLE = 161;
+ Ord_GpiSETCP = 162;
+ Ord_GpiQUERYCP = 163;
+ Ord_GpiQUERYTEXTBOX = 164;
+ Ord_DevQUERYDEVICENAMES = 165;
+ Ord_GpiQUERYDEFCHARBOX = 166;
+ Ord_GpiQUERYFONTFILEDESCRIPTIONS = 167;
+ Ord_GpiSETCHARSET = 168;
+ Ord_GpiQUERYCHARSET = 169;
+ Ord_GpiSETCHARBOX = 170;
+ Ord_GpiQUERYCHARBOX = 171;
+ Ord_GpiSETCHARANGLE = 172;
+ Ord_GpiQUERYCHARANGLE = 173;
+ Ord_GpiSETCHARSHEAR = 174;
+ Ord_GpiQUERYCHARSHEAR = 175;
+ Ord_GpiSETCHARDIRECTION = 176;
+ Ord_GpiQUERYCHARDIRECTION = 177;
+ Ord_GpiSETCHARMODE = 178;
+ Ord_GpiQUERYCHARMODE = 179;
+ Ord_GpiCHARSTRING = 180;
+ Ord_GpiCHARSTRINGAT = 181;
+ Ord_GpiCHARSTRINGPOS = 182;
+ Ord_GpiCHARSTRINGPOSAT = 183;
+ Ord_GpiSETMARKERSET = 184;
+ Ord_GpiQUERYMARKERSET = 185;
+ Ord_GpiSETMARKER = 186;
+ Ord_GpiQUERYMARKER = 187;
+ Ord_GpiSETMARKERBOX = 188;
+ Ord_GpiQUERYMARKERBOX = 189;
+ Ord_GpiMARKER = 190;
+ Ord_GpiPOLYMARKER = 191;
+ Ord_GpiIMAGE = 192;
+ Ord_GpiCREATEBITMAP = 196;
+ Ord_GpiDELETEBITMAP = 197;
+ Ord_GpiSETBITMAP = 198;
+ Ord_GpiSETBITMAPDIMENSION = 199;
+ Ord_GpiQUERYBITMAPDIMENSION = 200;
+ Ord_GpiQUERYDEVICEBITMAPFORMATS = 201;
+ Ord_GpiQUERYBITMAPPARAMETERS = 202;
+ Ord_GpiSETBITMAPBITS = 203;
+ Ord_GpiQUERYBITMAPBITS = 204;
+ Ord_GpiBITBLT = 205;
+ Ord_GpiSETPEL = 206;
+ Ord_GpiQUERYPEL = 207;
+ Ord_GpiCREATEREGION = 208;
+ Ord_GpiSETREGION = 209;
+ Ord_GpiDESTROYREGION = 210;
+ Ord_GpiCOMBINEREGION = 211;
+ Ord_GpiEQUALREGION = 212;
+ Ord_GpiOFFSETREGION = 213;
+ Ord_GpiPTINREGION = 214;
+ Ord_GpiRECTINREGION = 215;
+ Ord_GpiQUERYREGIONBOX = 216;
+ Ord_GpiQUERYREGIONRECTS = 217;
+ Ord_GpiSETCLIPREGION = 218;
+ Ord_GpiQUERYCLIPREGION = 219;
+ Ord_GpiQUERYCLIPBOX = 220;
+ Ord_GpiINTERSECTCLIPRECTANGLE = 221;
+ Ord_GpiEXCLUDECLIPRECTANGLE = 222;
+ Ord_GpiOFFSETCLIPREGION = 223;
+ Ord_GpiPAINTREGION = 224;
+ Ord_GpiLOADMETAFILE = 225;
+ Ord_GpiCOPYMETAFILE = 226;
+ Ord_GpiPLAYMETAFILE = 227;
+ Ord_GpiSAVEMETAFILE = 228;
+ Ord_GpiDELETEMETAFILE = 229;
+ Ord_GpiQUERYMETAFILEBITS = 230;
+ Ord_GpiSETMETAFILEBITS = 231;
+ Ord_GpiQUERYMETAFILELENGTH = 232;
+ Ord_GpiSETCLIPPATH = 233;
+ Ord_GpiBEGINPATH = 234;
+ Ord_GpiENDPATH = 235;
+ Ord_GpiCLOSEFIGURE = 236;
+ Ord_GpiMODIFYPATH = 237;
+ Ord_GpiFILLPATH = 238;
+ Ord_GpiSTARTREQUEST = 239;
+ Ord_GpiQUERYDEVICE = 240;
+ Ord_DevSTDOPEN = 244;
+ Ord_GpiQUERYCHARSTRINGPOS = 245;
+ Ord_GpiQUERYCHARSTRINGPOSAT = 246;
+ Ord_GpiSETPS = 248;
+ Ord_SEGSGWOPENSEGMENTWINDOW = 249;
+ Ord_MTENDREADREQUEST = 250;
+ Ord_MTGETDESCRIPTION = 251;
+ Ord_FMTORDERTABLE = 252;
+ Ord_MTGETCODEPAGE = 253;
+ Ord_MTGETLCT = 254;
+ Ord_MTGETGDDINFO = 255;
+ Ord_FMTCONVERTGOCAPOLY = 256;
+ Ord_MTGETFIRSTFONT = 257;
+ Ord_SEGSGWNEWPARTDATA = 258;
+ Ord_MTSTARTREADREQUEST = 259;
+ Ord_MTGETFIRSTGRAPHICSDATA = 260;
+ Ord_MTGETNEXTFONT = 261;
+ Ord_MTGETNEXTGRAPHICSDATA = 262;
+ Ord_GpiLOADPUBLICFONTS = 263;
+ Ord_GpiUNLOADPUBLICFONTS = 264;
+ Ord_GpiCOMMENT = 268;
+ Ord_GpiWCBITBLT = 269;
+ Ord_GpiSTROKEPATH = 270;
+ Ord_SEGSGWNEXTORDERF = 271;
+ Ord_GpiOUTLINEPATH = 274;
+ Ord_GpiSETDEFTAG = 275;
+ Ord_GpiQUERYDEFTAG = 276;
+ Ord_GpiSETDEFATTRS = 277;
+ Ord_GpiQUERYDEFATTRS = 278;
+ Ord_GpiSETDEFVIEWINGLIMITS = 279;
+ Ord_GpiQUERYDEFVIEWINGLIMITS = 280;
+ Ord_GpiSETDEFARCPARAMS = 281;
+ Ord_GpiQUERYDEFARCPARAMS = 282;
+ Ord_GpiTRANSLATE = 283;
+ Ord_GpiSCALE = 284;
+ Ord_GpiROTATE = 285;
+ Ord_GpiPOLYLINEDISJOINT = 286;
+ Ord_GpiPATHTOREGION = 287;
+ Ord_GpiFLOODFILL = 289;
+ Ord_GpiDRAWBITS = 290;
+ Ord_GpiQUERYBITMAPINFOHEADER = 291;
+ Ord_GpiQUERYLOGICALFONT = 292;
+ Ord_GpiQUERYFACESTRING = 293;
+ Ord_GpiQUERYFONTACTION = 294;
+ Ord_GpiCREATEPALETTE = 295;
+ Ord_GpiDELETEPALETTE = 296;
+ Ord_GpiSELECTPALETTE = 297;
+ Ord_GpiANIMATEPALETTE = 298;
+ Ord_GpiSETPALETTEENTRIES = 299;
+ Ord_GpiQUERYPALETTE = 300;
+ Ord_GpiQUERYPALETTEINFO = 301;
+ Ord_GpiQUERYCHAREXTRA = 302;
+ Ord_GpiSETCHAREXTRA = 303;
+ Ord_GpiQUERYCHARBREAKEXTRA = 304;
+ Ord_GpiSETCHARBREAKEXTRA = 305;
+ Ord_GpiFRAMEREGION = 306;
+ Ord_GpiCONVERTWITHMATRIX = 307;
+ Ord_Gpi32ASSOCIATE = 351;
+ Ord_Gpi32BEGINAREA = 352;
+ Ord_Gpi32BEGINELEMENT = 353;
+ Ord_Gpi32BEGINPATH = 354;
+ Ord_Gpi32BITBLT = 355;
+ Ord_Gpi32BOX = 356;
+ Ord_Gpi32CALLSEGMENTMATRIX = 357;
+ Ord_Gpi32CHARSTRING = 358;
+ Ord_Gpi32CHARSTRINGAT = 359;
+ Ord_Gpi32CLOSEFIGURE = 360;
+ Ord_Gpi32CLOSESEGMENT = 361;
+ Ord_Gpi32COMBINEREGION = 362;
+ Ord_Gpi32COMMENT = 363;
+ Ord_Gpi32CONVERT = 364;
+ Ord_Gpi32COPYMETAFILE = 365;
+ Ord_Gpi32CORRELATECHAIN = 366;
+ Ord_Gpi32CORRELATEFROM = 367;
+ Ord_Gpi32CREATELOGFONT = 368;
+ Ord_Gpi32CREATEPS = 369;
+ Ord_Gpi32CREATEREGION = 370;
+ Ord_Gpi32DELETEBITMAP = 371;
+ Ord_Gpi32DELETEELEMENT = 372;
+ Ord_Gpi32DELETEELEMENTRANGE = 373;
+ Ord_Gpi32DELETEELEMENTSBETWEENLABE = 374;
+ Ord_Gpi32DELETEMETAFILE = 375;
+ Ord_Gpi32DELETESEGMENT = 376;
+ Ord_Gpi32DELETESEGMENTS = 377;
+ Ord_Gpi32DELETESETID = 378;
+ Ord_Gpi32DESTROYPS = 379;
+ Ord_Gpi32DRAWCHAIN = 380;
+ Ord_Gpi32DRAWDYNAMICS = 381;
+ Ord_Gpi32DRAWFROM = 382;
+ Ord_Gpi32DRAWSEGMENT = 383;
+ Ord_Gpi32ELEMENT = 384;
+ Ord_Gpi32ENDAREA = 385;
+ Ord_Gpi32ENDELEMENT = 386;
+ Ord_Gpi32ENDPATH = 387;
+ Ord_Gpi32EQUALREGION = 388;
+ Ord_Gpi32ERASE = 389;
+ Ord_Gpi32ERRORSEGMENTDATA = 390;
+ Ord_Gpi32EXCLUDECLIPRECTANGLE = 391;
+ Ord_Gpi32FILLPATH = 392;
+ Ord_Gpi32FULLARC = 393;
+ Ord_Gpi32GETDATA = 394;
+ Ord_Gpi32IMAGE = 395;
+ Ord_Gpi32INTERSECTCLIPRECTANGLE = 396;
+ Ord_Gpi32LABEL = 397;
+ Ord_Gpi32LINE = 398;
+ Ord_Gpi32LOADBITMAP = 399;
+ Ord_Gpi32LOADFONTS = 400;
+ Ord_Gpi32LOADMETAFILE = 401;
+ Ord_Gpi32MARKER = 402;
+ Ord_Gpi32MODIFYPATH = 403;
+ Ord_Gpi32MOVE = 404;
+ Ord_Gpi32OFFSETCLIPREGION = 405;
+ Ord_Gpi32OFFSETELEMENTPOINTER = 406;
+ Ord_Gpi32OFFSETREGION = 407;
+ Ord_Gpi32OPENSEGMENT = 408;
+ Ord_Gpi32PAINTREGION = 409;
+ Ord_Gpi32PLAYMETAFILE = 411;
+ Ord_Gpi32POINTARC = 412;
+ Ord_Gpi32POLYFILLET = 413;
+ Ord_Gpi32POLYFILLETSHARP = 414;
+ Ord_Gpi32POLYLINE = 415;
+ Ord_Gpi32POLYMARKER = 416;
+ Ord_Gpi32POLYSPLINE = 417;
+ Ord_Gpi32POP = 418;
+ Ord_Gpi32PTINREGION = 419;
+ Ord_Gpi32PTVISIBLE = 420;
+ Ord_Gpi32PUTDATA = 421;
+ Ord_Gpi32QUERYARCPARAMS = 422;
+ Ord_Gpi32QUERYATTRMODE = 423;
+ Ord_Gpi32QUERYBACKCOLOR = 424;
+ Ord_Gpi32QUERYBACKMIX = 425;
+ Ord_Gpi32QUERYBITMAPDIMENSION = 426;
+ Ord_Gpi32QUERYBITMAPHANDLE = 427;
+ Ord_Gpi32QUERYBOUNDARYDATA = 428;
+ Ord_Gpi32QUERYCHARANGLE = 429;
+ Ord_Gpi32QUERYCHARBOX = 430;
+ Ord_Gpi32QUERYCHARDIRECTION = 431;
+ Ord_Gpi32QUERYCHARMODE = 432;
+ Ord_Gpi32QUERYCHARSET = 433;
+ Ord_Gpi32QUERYCHARSHEAR = 434;
+ Ord_Gpi32QUERYCLIPBOX = 435;
+ Ord_Gpi32QUERYCLIPREGION = 436;
+ Ord_Gpi32QUERYCOLOR = 437;
+ Ord_Gpi32QUERYCOLORDATA = 438;
+ Ord_Gpi32QUERYCOLORINDEX = 439;
+ Ord_Gpi32QUERYCP = 440;
+ Ord_Gpi32QUERYCURRENTPOSITION = 441;
+ Ord_Gpi32QUERYDEFCHARBOX = 442;
+ Ord_Gpi32QUERYDEFAULTVIEWMATRIX = 443;
+ Ord_Gpi32QUERYDEVICE = 444;
+ Ord_Gpi32QUERYDEVICEBITMAPFORMATS = 445;
+ Ord_Gpi32QUERYDRAWCONTROL = 446;
+ Ord_Gpi32QUERYDRAWINGMODE = 447;
+ Ord_Gpi32QUERYEDITMODE = 448;
+ Ord_Gpi32QUERYELEMENT = 449;
+ Ord_Gpi32QUERYELEMENTPOINTER = 450;
+ Ord_Gpi32QUERYELEMENTTYPE = 451;
+ Ord_Gpi32QUERYFONTFILEDESCRIPTIONS = 452;
+ Ord_Gpi32QUERYFONTMETRICS = 453;
+ Ord_Gpi32QUERYGRAPHICSFIELD = 454;
+ Ord_Gpi32QUERYINITIALSEGMENTATTRS = 455;
+ Ord_Gpi32QUERYKERNINGPAIRS = 456;
+ Ord_Gpi32QUERYLINEEND = 457;
+ Ord_Gpi32QUERYLINEJOIN = 458;
+ Ord_Gpi32QUERYLINETYPE = 459;
+ Ord_Gpi32QUERYLINEWIDTH = 460;
+ Ord_Gpi32QUERYLINEWIDTHGEOM = 461;
+ Ord_Gpi32QUERYMARKER = 462;
+ Ord_Gpi32QUERYMARKERBOX = 463;
+ Ord_Gpi32QUERYMARKERSET = 464;
+ Ord_Gpi32QUERYMETAFILEBITS = 465;
+ Ord_Gpi32QUERYMETAFILELENGTH = 466;
+ Ord_Gpi32QUERYMIX = 467;
+ Ord_Gpi32QUERYMODELTRANSFORMMATRIX = 468;
+ Ord_Gpi32QUERYNEARESTCOLOR = 469;
+ Ord_Gpi32QUERYNUMBERSETIDS = 470;
+ Ord_Gpi32QUERYPS = 471;
+ Ord_Gpi32QUERYPAGEVIEWPORT = 472;
+ Ord_Gpi32QUERYPATTERN = 473;
+ Ord_Gpi32QUERYPATTERNREFPOINT = 474;
+ Ord_Gpi32QUERYPATTERNSET = 475;
+ Ord_Gpi32QUERYPEL = 476;
+ Ord_Gpi32QUERYPICKAPERTUREPOSITION = 477;
+ Ord_Gpi32QUERYPICKAPERTURESIZE = 478;
+ Ord_Gpi32QUERYRGBCOLOR = 479;
+ Ord_Gpi32QUERYREALCOLORS = 480;
+ Ord_Gpi32QUERYREGIONBOX = 481;
+ Ord_Gpi32QUERYSEGMENTATTRS = 482;
+ Ord_Gpi32QUERYSEGMENTNAMES = 483;
+ Ord_Gpi32QUERYSEGMENTPRIORITY = 484;
+ Ord_Gpi32QUERYSEGMENTTRANSFORMMATR = 485;
+ Ord_Gpi32QUERYSETIDS = 486;
+ Ord_Gpi32QUERYSTOPDRAW = 487;
+ Ord_Gpi32QUERYTAG = 488;
+ Ord_Gpi32QUERYTEXTBOX = 489;
+ Ord_Gpi32QUERYVIEWINGLIMITS = 490;
+ Ord_Gpi32QUERYVIEWINGTRANSFORMMATR = 491;
+ Ord_Gpi32QUERYWIDTHTABLE = 492;
+ Ord_Gpi32RECTINREGION = 494;
+ Ord_Gpi32RECTVISIBLE = 495;
+ Ord_Gpi32REMOVEDYNAMICS = 496;
+ Ord_Gpi32RESETBOUNDARYDATA = 497;
+ Ord_Gpi32RESETPS = 498;
+ Ord_Gpi32RESTOREPS = 499;
+ Ord_Gpi32SAVEMETAFILE = 500;
+ Ord_Gpi32SAVEPS = 501;
+ Ord_Gpi32SETARCPARAMS = 502;
+ Ord_Gpi32SETATTRMODE = 503;
+ Ord_Gpi32SETBACKCOLOR = 504;
+ Ord_Gpi32SETBACKMIX = 505;
+ Ord_Gpi32SETBITMAP = 506;
+ Ord_Gpi32SETBITMAPDIMENSION = 507;
+ Ord_Gpi32SETBITMAPID = 508;
+ Ord_Gpi32SETCHARANGLE = 509;
+ Ord_Gpi32SETCHARBOX = 510;
+ Ord_Gpi32SETCHARDIRECTION = 511;
+ Ord_Gpi32SETCHARMODE = 512;
+ Ord_Gpi32SETCHARSET = 513;
+ Ord_Gpi32SETCHARSHEAR = 514;
+ Ord_Gpi32SETCLIPPATH = 515;
+ Ord_Gpi32SETCLIPREGION = 516;
+ Ord_Gpi32SETCOLOR = 517;
+ Ord_Gpi32SETCP = 518;
+ Ord_Gpi32SETCURRENTPOSITION = 519;
+ Ord_Gpi32SETDEFAULTVIEWMATRIX = 520;
+ Ord_Gpi32SETDRAWCONTROL = 521;
+ Ord_Gpi32SETDRAWINGMODE = 522;
+ Ord_Gpi32SETEDITMODE = 523;
+ Ord_Gpi32SETELEMENTPOINTER = 524;
+ Ord_Gpi32SETELEMENTPOINTERATLABEL = 525;
+ Ord_Gpi32SETGRAPHICSFIELD = 526;
+ Ord_Gpi32SETINITIALSEGMENTATTRS = 527;
+ Ord_Gpi32SETLINEEND = 528;
+ Ord_Gpi32SETLINEJOIN = 529;
+ Ord_Gpi32SETLINETYPE = 530;
+ Ord_Gpi32SETLINEWIDTH = 531;
+ Ord_Gpi32SETLINEWIDTHGEOM = 532;
+ Ord_Gpi32SETMARKER = 533;
+ Ord_Gpi32SETMARKERBOX = 534;
+ Ord_Gpi32SETMARKERSET = 535;
+ Ord_Gpi32SETMETAFILEBITS = 536;
+ Ord_Gpi32SETMIX = 537;
+ Ord_Gpi32SETMODELTRANSFORMMATRIX = 538;
+ Ord_Gpi32SETPS = 539;
+ Ord_Gpi32SETPAGEVIEWPORT = 540;
+ Ord_Gpi32SETPATTERN = 541;
+ Ord_Gpi32SETPATTERNREFPOINT = 542;
+ Ord_Gpi32SETPATTERNSET = 543;
+ Ord_Gpi32SETPEL = 544;
+ Ord_Gpi32SETPICKAPERTUREPOSITION = 545;
+ Ord_Gpi32SETREGION = 546;
+ Ord_Gpi32SETSEGMENTATTRS = 547;
+ Ord_Gpi32SETSEGMENTPRIORITY = 548;
+ Ord_Gpi32SETSEGMENTTRANSFORMMATRIX = 549;
+ Ord_Gpi32SETSTOPDRAW = 550;
+ Ord_Gpi32SETTAG = 551;
+ Ord_Gpi32SETVIEWINGLIMITS = 552;
+ Ord_Gpi32SETVIEWINGTRANSFORMMATRIX = 553;
+ Ord_Gpi32STROKEPATH = 554;
+ Ord_Gpi32UNLOADFONTS = 555;
+ Ord_Gpi32WCBITBLT = 557;
+ Ord_Gpi32POLYLINEDISJOINT = 558;
+ Ord_Gpi32PATHTOREGION = 559;
+ Ord_Gpi32FLOODFILL = 560;
+ Ord_Gpi32SUSPENDPLAY = 561;
+ Ord_Gpi32RESUMEPLAY = 562;
+ Ord_Gpi32OUTLINEPATH = 563;
+ Ord_Gpi32TRANSLATE = 564;
+ Ord_Gpi32SCALE = 565;
+ Ord_Gpi32ROTATE = 566;
+ Ord_Gpi32QUERYDEFARCPARAMS = 567;
+ Ord_Gpi32QUERYDEFTAG = 568;
+ Ord_Gpi32QUERYDEFVIEWINGLIMITS = 569;
+ Ord_Gpi32SETDEFARCPARAMS = 570;
+ Ord_Gpi32SETDEFTAG = 571;
+ Ord_Gpi32SETDEFVIEWINGLIMITS = 572;
+ Ord_Gpi32QUERYBITMAPPARAMETERS = 573;
+ Ord_Gpi32QUERYLOGICALFONT = 574;
+ Ord_Gpi32QUERYFACESTRING = 575;
+ Ord_Gpi32QUERYFONTACTION = 576;
+ Ord_Gpi32DELETEPALETTE = 577;
+ Ord_Gpi32SELECTPALETTE = 578;
+ Ord_Gpi32QUERYPALETTE = 579;
+ Ord_Gpi32CHARSTRINGPOS = 580;
+ Ord_Gpi32CHARSTRINGPOSAT = 581;
+ Ord_Gpi32CORRELATESEGMENT = 582;
+ Ord_Gpi32QUERYATTRS = 583;
+ Ord_Gpi32QUERYCHARSTRINGPOS = 584;
+ Ord_Gpi32QUERYCHARSTRINGPOSAT = 585;
+ Ord_Gpi32QUERYFONTS = 586;
+ Ord_Gpi32QUERYREGIONRECTS = 587;
+ Ord_Gpi32SETATTRS = 588;
+ Ord_Gpi32SETPICKAPERTURESIZE = 589;
+ Ord_Gpi32QUERYDEFATTRS = 590;
+ Ord_Gpi32SETDEFATTRS = 591;
+ Ord_Gpi32CREATELOGCOLORTABLE = 592;
+ Ord_Gpi32QUERYLOGCOLORTABLE = 593;
+ Ord_Gpi32CREATEPALETTE = 594;
+ Ord_Gpi32ANIMATEPALETTE = 595;
+ Ord_Gpi32SETPALETTEENTRIES = 596;
+ Ord_Gpi32QUERYPALETTEINFO = 597;
+ Ord_Gpi32CREATEBITMAP = 598;
+ Ord_Gpi32QUERYBITMAPBITS = 599;
+ Ord_Gpi32QUERYBITMAPINFOHEADER = 601;
+ Ord_Gpi32SETBITMAPBITS = 602;
+ Ord_Gpi32DRAWBITS = 603;
+ Ord_Dev32CLOSEDC = 604;
+ Ord_Dev32ESCAPE = 605;
+ Ord_Dev32QUERYCAPS = 606;
+ Ord_Dev32QUERYDEVICENAMES = 607;
+ Ord_Dev32QUERYHARDCOPYCAPS = 608;
+ Ord_Dev32POSTDEVICEMODES = 609;
+ Ord_Dev32OPENDC = 610;
+ Ord_Gpi32DESTROYREGION = 611;
+ Ord_Gpi32PARTIALARC = 612;
+ Ord_Gpi32QUERYCHAREXTRA = 613;
+ Ord_Gpi32SETCHAREXTRA = 614;
+ Ord_Gpi32QUERYCHARBREAKEXTRA = 615;
+ Ord_Gpi32SETCHARBREAKEXTRA = 616;
+ Ord_Gpi32FRAMEREGION = 617;
+ Ord_Gpi32CONVERTWITHMATRIX = 618;
+ Ord_Gpi32LOADPUBLICFONTS = 622;
+ Ord_Gpi32UNLOADPUBLICFONTS = 623;
+ Ord_WinQUERYDESKTOPWINDOW = 1;
+ Ord_WinQUERYOBJECTWINDOW = 2;
+ Ord_WinREGISTERCLASS = 3;
+ Ord_WinQUERYCLASSNAME = 4;
+ Ord_WinQUERYCLASSINFO = 5;
+ Ord_WinCREATEWINDOW = 6;
+ Ord_WinDESTROYWINDOW = 7;
+ Ord_WinSETWINDOWPOS = 8;
+ Ord_WinSETMULTWINDOWPOS = 9;
+ Ord_WinQUERYWINDOWPOS = 10;
+ Ord_WinENABLEWINDOW = 11;
+ Ord_WinISWINDOWENABLED = 12;
+ Ord_WinSHOWWINDOW = 13;
+ Ord_WinENABLEWINDOWUPDATE = 14;
+ Ord_WinISWINDOWVISIBLE = 15;
+ Ord_WinSETWINDOWTEXT = 16;
+ Ord_WinQUERYWINDOWTEXT = 17;
+ Ord_WinQUERYWINDOWTEXTLENGTH = 18;
+ Ord_WinWINDOWFROMID = 19;
+ Ord_WinMULTWINDOWFROMIDS = 20;
+ Ord_WinISWINDOW = 21;
+ Ord_WinISCHILD = 22;
+ Ord_WinSETPARENT = 23;
+ Ord_WinSETOWNER = 24;
+ Ord_WinQUERYWINDOW = 25;
+ Ord_WinQUERYWINDOWRECT = 26;
+ Ord_WinQUERYWINDOWPROCESS = 27;
+ Ord_WinSETWINDOWUSHORT = 28;
+ Ord_WinQUERYWINDOWUSHORT = 29;
+ Ord_WinSETWINDOWULONG = 30;
+ Ord_WinQUERYWINDOWULONG = 31;
+ Ord_WinBEGINENUMWINDOWS = 32;
+ Ord_WinGETNEXTWINDOW = 33;
+ Ord_WinENDENUMWINDOWS = 34;
+ Ord_WinWINDOWFROMPOINT = 35;
+ Ord_WinMAPWINDOWPOINTS = 36;
+ Ord_WinSUBCLASSWINDOW = 37;
+ Ord_WinLOCKWINDOW = 38;
+ Ord_WinQUERYWINDOWLOCKCOUNT = 39;
+ Ord_WinREGISTERWINDOWDESTROY = 40;
+ Ord_WinOPENWINDOWDC = 41;
+ Ord_WinGETSCREENPS = 42;
+ Ord_WinGETPS = 43;
+ Ord_WinRELEASEPS = 44;
+ Ord_WinBEGINPAINT = 45;
+ Ord_WinENDPAINT = 46;
+ Ord_WinINVALIDATERECT = 47;
+ Ord_WinINVALIDATEREGION = 48;
+ Ord_WinVALIDATERECT = 49;
+ Ord_WinVALIDATEREGION = 50;
+ Ord_WinQUERYUPDATERECT = 51;
+ Ord_WinQUERYUPDATEREGION = 52;
+ Ord_WinUPDATEWINDOW = 53;
+ Ord_WinEXCLUDEUPDATEREGION = 54;
+ Ord_WinLOCKWINDOWUPDATE = 55;
+ Ord_WinLOCKVISREGIONS = 56;
+ Ord_WinWINDOWFROMDC = 57;
+ Ord_WinCREATEMSGQUEUE = 58;
+ Ord_WinDESTROYMSGQUEUE = 59;
+ Ord_WinQUERYQUEUESTATUS = 60;
+ Ord_WinSENDMSG = 61;
+ Ord_WinBROADCASTMSG = 63;
+ Ord_WinINSENDMSG = 64;
+ Ord_WinGETMSG = 65;
+ Ord_WinPEEKMSG = 66;
+ Ord_WinWAITMSG = 67;
+ Ord_WinDISPATCHMSG = 68;
+ Ord_WinPOSTMSG = 69;
+ Ord_WinPOSTQUEUEMSG = 70;
+ Ord_WinQUERYMSGPOS = 71;
+ Ord_WinQUERYMSGTIME = 72;
+ Ord_WinCALLMSGFILTER = 73;
+ Ord_WinSETMSGINTEREST = 74;
+ Ord_WinSETCAPTURE = 75;
+ Ord_WinQUERYCAPTURE = 76;
+ Ord_WinSETFOCUS = 77;
+ Ord_WinQUERYFOCUS = 78;
+ Ord_WinSETACTIVEWINDOW = 79;
+ Ord_WinQUERYACTIVEWINDOW = 80;
+ Ord_WinSETSYSMODALWINDOW = 81;
+ Ord_WinQUERYSYSMODALWINDOW = 82;
+ Ord_WinISTHREADACTIVE = 83;
+ Ord_WinSTARTTIMER = 84;
+ Ord_WinSTOPTIMER = 85;
+ Ord_WinGETCURRENTTIME = 86;
+ Ord_WinLOADPOINTER = 87;
+ Ord_WinCREATEPOINTER = 88;
+ Ord_WinDESTROYPOINTER = 89;
+ Ord_OldWinQUERYPOINTERINFO = 90;
+ Ord_WinQUERYSYSPOINTER = 91;
+ Ord_WinSETPOINTER = 92;
+ Ord_WinQUERYPOINTER = 93;
+ Ord_WinSHOWPOINTER = 94;
+ Ord_WinSETPOINTERPOS = 95;
+ Ord_WinQUERYPOINTERPOS = 96;
+ Ord_WinGETSYSBITMAP = 97;
+ Ord_WinCREATECURSOR = 98;
+ Ord_WinDESTROYCURSOR = 99;
+ Ord_WinSHOWCURSOR = 100;
+ Ord_WinQUERYCURSORINFO = 101;
+ Ord_WinLOADACCELTABLE = 102;
+ Ord_WinCREATEACCELTABLE = 103;
+ Ord_WinDESTROYACCELTABLE = 104;
+ Ord_WinTRANSLATEACCEL = 105;
+ Ord_WinSETACCELTABLE = 106;
+ Ord_WinQUERYACCELTABLE = 107;
+ Ord_WinCOPYACCELTABLE = 108;
+ Ord_WinSETHOOK = 109;
+ Ord_WinRELEASEHOOK = 110;
+ Ord_WinOPENCLIPBRD = 111;
+ Ord_WinCLOSECLIPBRD = 112;
+ Ord_WinEMPTYCLIPBRD = 113;
+ Ord_WinSETCLIPBRDOWNER = 114;
+ Ord_WinQUERYCLIPBRDOWNER = 115;
+ Ord_WinSETCLIPBRDDATA = 116;
+ Ord_WinQUERYCLIPBRDDATA = 117;
+ Ord_WinENUMCLIPBRDFMTS = 118;
+ Ord_WinQUERYCLIPBRDFMTINFO = 119;
+ Ord_WinSETCLIPBRDVIEWER = 120;
+ Ord_WinQUERYCLIPBRDVIEWER = 121;
+ Ord_WinLOADDLG = 122;
+ Ord_WinCREATEDLG = 123;
+ Ord_WinPROCESSDLG = 124;
+ Ord_WinDLGBOX = 125;
+ Ord_WinDISMISSDLG = 126;
+ Ord_WinSENDDLGITEMMSG = 127;
+ Ord_WinSETDLGITEMSHORT = 128;
+ Ord_WinQUERYDLGITEMSHORT = 129;
+ Ord_WinMAPDLGPOINTS = 130;
+ Ord_WinSUBSTITUTESTRINGS = 132;
+ Ord_WinENUMDLGITEM = 133;
+ Ord_WinSETDLGITEMTEXT = 134;
+ Ord_WinQUERYDLGITEMTEXT = 135;
+ Ord_WinLOADMENU = 136;
+ Ord_WinCREATEMENU = 137;
+ Ord_WinALARM = 138;
+ Ord_WinMESSAGEBOX = 139;
+ Ord_WinCREATESTDWINDOW = 140;
+ Ord_WinCREATEFRAMECONTROLS = 141;
+ Ord_WinCALCFRAMERECT = 143;
+ Ord_WinFLASHWINDOW = 144;
+ Ord_WinGETMINPOSITION = 146;
+ Ord_WinGETMAXPOSITION = 147;
+ Ord_WinQUERYSYSVALUE = 149;
+ Ord_WinSETSYSVALUE = 150;
+ Ord_WinSETSYSCOLORS = 151;
+ Ord_WinQUERYSYSCOLOR = 152;
+ Ord_WinSCROLLWINDOW = 153;
+ Ord_WinTRACKRECT = 154;
+ Ord_WinSHOWTRACKRECT = 155;
+ Ord_GpiLOADBITMAP = 156;
+ Ord_WinLOADSTRING = 157;
+ Ord_WinLOADMESSAGE = 158;
+ Ord_WinSETRECTEMPTY = 159;
+ Ord_WinSETRECT = 160;
+ Ord_WinCOPYRECT = 161;
+ Ord_WinISRECTEMPTY = 162;
+ Ord_WinEQUALRECT = 163;
+ Ord_WinPTINRECT = 164;
+ Ord_WinOFFSETRECT = 165;
+ Ord_WinINFLATERECT = 166;
+ Ord_WinINTERSECTRECT = 167;
+ Ord_WinUNIONRECT = 168;
+ Ord_WinSUBTRACTRECT = 169;
+ Ord_WinMAKERECT = 170;
+ Ord_WinMAKEPOINTS = 171;
+ Ord_WinINVERTRECT = 172;
+ Ord_WinFILLRECT = 173;
+ Ord_KbdPACKET = 174;
+ Ord_WinDRAWPOINTER = 177;
+ Ord_WinDEFWINDOWPROC = 178;
+ Ord_WinDEFDLGPROC = 179;
+ Ord_WinGETKEYSTATE = 211;
+ Ord_WinGETPHYSKEYSTATE = 212;
+ Ord_WinSETKEYBOARDSTATETABLE = 213;
+ Ord_WinENABLEPHYSINPUT = 214;
+ Ord_WinSETCP = 215;
+ Ord_WinQUERYCP = 216;
+ Ord_WinQUERYCPLIST = 217;
+ Ord_WinCPTRANSLATESTRING = 218;
+ Ord_WinCPTRANSLATECHAR = 219;
+ Ord_WinCOMPARESTRINGS = 220;
+ Ord_WinUPPER = 221;
+ Ord_WinUPPERCHAR = 222;
+ Ord_WinNEXTCHAR = 223;
+ Ord_WinPREVCHAR = 224;
+ Ord_WinCREATEHEAP = 225;
+ Ord_WinDESTROYHEAP = 226;
+ Ord_WinAVAILMEM = 227;
+ Ord_WinALLOCMEM = 228;
+ Ord_WinREALLOCMEM = 229;
+ Ord_WinFREEMEM = 230;
+ Ord_WinLOCKHEAP = 231;
+ Ord_WinCREATEATOMTABLE = 233;
+ Ord_WinDESTROYATOMTABLE = 234;
+ Ord_WinADDATOM = 235;
+ Ord_WinFINDATOM = 236;
+ Ord_WinDELETEATOM = 237;
+ Ord_WinQUERYATOMUSAGE = 238;
+ Ord_WinQUERYATOMLENGTH = 239;
+ Ord_WinQUERYATOMNAME = 240;
+ Ord_WinQUERYSYSTEMATOMTABLE = 241;
+ Ord_WinGETLASTERROR = 243;
+ Ord_WinGETERRORINFO = 244;
+ Ord_WinFREEERRORINFO = 245;
+ Ord_WinINITIALIZE = 246;
+ Ord_WinTERMINATE = 247;
+ Ord_WinCATCH = 248;
+ Ord_WinTHROW = 249;
+ Ord_WinQUERYVERSION = 250;
+ Ord__WinSETERRORINFO = 263;
+ Ord_WinISPHYSINPUTENABLED = 264;
+ Ord_WinQUERYWINDOWDC = 265;
+ Ord_WinDRAWBORDER = 266;
+ Ord_WinDRAWTEXT = 267;
+ Ord_WinDRAWBITMAP = 268;
+ Ord_WinQUERYWINDOWPTR = 269;
+ Ord_WinSETWINDOWPTR = 270;
+ Ord_WinMSGSEMWAIT = 274;
+ Ord_WinMSGMUXSEMWAIT = 275;
+ Ord_WinCANCELSHUTDOWN = 277;
+ Ord_WinSETWINDOWBITS = 278;
+ Ord_WinGETCLIPPS = 279;
+ Ord_WinSAVEWINDOWPOS = 285;
+ Ord_WinFOCUSCHANGE = 286;
+ Ord_WinQUERYQUEUEINFO = 287;
+ Ord_WinSETCLASSMSGINTEREST = 292;
+ Ord_WinQUERYDLGITEMTEXTLENGTH = 294;
+ Ord_WinDDEINITIATE = 297;
+ Ord_WinDDERESPOND = 298;
+ Ord_WinDDEPOSTMSG = 299;
+ Ord_WinSETPRESPARAM = 301;
+ Ord_WinQUERYPRESPARAM = 302;
+ Ord_WinREMOVEPRESPARAM = 303;
+ Ord_DumWinCREATEHELPINSTANCE = 311;
+ Ord_DumWinDESTROYHELPINSTANCE = 312;
+ Ord_DumWinASSOCIATEHELPINSTANCE = 313;
+ Ord_DumWinCREATEHELPTABLE = 314;
+ Ord_DumWinLOADHELPTABLE = 315;
+ Ord_DumWinQUERYHELPINSTANCE = 316;
+ Ord_DummyHelpEntry = 322;
+ Ord_WinSETCLASSTHUNKPROC = 959;
+ Ord_WinQUERYCLASSTHUNKPROC = 960;
+ Ord_WinSETWINDOWTHUNKPROC = 961;
+ Ord_WinQUERYWINDOWTHUNKPROC = 962;
+ Ord_WinQUERYWINDOWMODEL = 317;
+ Ord_WinSETDESKTOPBKGND = 318;
+ Ord_WinQUERYDESKTOPBKGND = 319;
+ Ord_WinPOPUPMENU = 320;
+ Ord_WinREALIZEPALETTE = 321;
+ Ord_WinDELETELIBRARY = 602;
+ Ord_WinLOADPROCEDURE = 603;
+ Ord_WinDELETEPROCEDURE = 604;
+ Ord_WinSETMSGMODE = 605;
+ Ord_WinSETSYNCHROMODE = 606;
+ Ord_WinGETDLGMSG = 607;
+ Ord_WinREGISTERUSERMSG = 608;
+ Ord_WinQUERYANCHORBLOCK = 609;
+ Ord_WinREGISTERUSERDATATYPE = 612;
+ Ord_WinISWINDOWSHOWING = 614;
+ Ord_WinLOADLIBRARY = 615;
+ Ord_WinCREATEPOINTERINDIRECT = 616;
+ Ord_WinQUERYPOINTERINFO = 617;
+ Ord_WinGETERASEPS = 624;
+ Ord_WinRELEASEERASEPS = 625;
+ Ord_WinSTRETCHPOINTER = 632;
+ Ord_WinSETPOINTEROWNER = 633;
+ Ord_Win32ADDATOM = 700;
+ Ord_Win32ALARM = 701;
+ Ord_Win32BEGINENUMWINDOWS = 702;
+ Ord_Win32BEGINPAINT = 703;
+ Ord_Win32CALCFRAMERECT = 704;
+ Ord_Win32CANCELSHUTDOWN = 705;
+ Ord_Win32CLOSECLIPBRD = 707;
+ Ord_Win32COMPARESTRINGS = 708;
+ Ord_Win32COPYACCELTABLE = 709;
+ Ord_Win32COPYRECT = 710;
+ Ord_Win32CPTRANSLATECHAR = 711;
+ Ord_Win32CPTRANSLATESTRING = 712;
+ Ord_Win32CREATEACCELTABLE = 713;
+ Ord_Win32CREATEATOMTABLE = 714;
+ Ord_Win32CREATECURSOR = 715;
+ Ord_Win32CREATEMSGQUEUE = 716;
+ Ord_Win32CREATEPOINTER = 717;
+ Ord_Win32DDEINITIATE = 718;
+ Ord_Win32DDEPOSTMSG = 719;
+ Ord_Win32DDERESPOND = 720;
+ Ord_Win32DELETEATOM = 721;
+ Ord_Win32DELETELIBRARY = 722;
+ Ord_Win32DESTROYACCELTABLE = 723;
+ Ord_Win32DESTROYATOMTABLE = 724;
+ Ord_Win32DESTROYCURSOR = 725;
+ Ord_Win32DESTROYMSGQUEUE = 726;
+ Ord_Win32DESTROYPOINTER = 727;
+ Ord_Win32DESTROYWINDOW = 728;
+ Ord_Win32DISMISSDLG = 729;
+ Ord_Win32DRAWBITMAP = 730;
+ Ord_Win32DRAWBORDER = 731;
+ Ord_Win32DRAWPOINTER = 732;
+ Ord_Win32EMPTYCLIPBRD = 733;
+ Ord_Win32ENABLEPHYSINPUT = 734;
+ Ord_Win32ENABLEWINDOW = 735;
+ Ord_Win32ENABLEWINDOWUPDATE = 736;
+ Ord_Win32ENDENUMWINDOWS = 737;
+ Ord_Win32ENDPAINT = 738;
+ Ord_Win32ENUMCLIPBRDFMTS = 739;
+ Ord_Win32ENUMDLGITEM = 740;
+ Ord_Win32EQUALRECT = 741;
+ Ord_Win32EXCLUDEUPDATEREGION = 742;
+ Ord_Win32FILLRECT = 743;
+ Ord_Win32FINDATOM = 744;
+ Ord_Win32FLASHWINDOW = 745;
+ Ord_Win32FOCUSCHANGE = 746;
+ Ord_Win32FREEERRORINFO = 748;
+ Ord_Win32GETCLIPPS = 749;
+ Ord_Win32GETCURRENTTIME = 750;
+ Ord_Win32GETERRORINFO = 751;
+ Ord_Win32GETKEYSTATE = 752;
+ Ord_Win32GETLASTERROR = 753;
+ Ord_Win32GETMAXPOSITION = 754;
+ Ord_Win32GETMINPOSITION = 755;
+ Ord_Win32GETNEXTWINDOW = 756;
+ Ord_Win32GETPS = 757;
+ Ord_Win32GETPHYSKEYSTATE = 758;
+ Ord_Win32GETSCREENPS = 759;
+ Ord_Win32GETSYSBITMAP = 760;
+ Ord_Win32INSENDMSG = 761;
+ Ord_Win32INFLATERECT = 762;
+ Ord_Win32INITIALIZE = 763;
+ Ord_Win32INTERSECTRECT = 764;
+ Ord_Win32INVALIDATERECT = 765;
+ Ord_Win32INVALIDATEREGION = 766;
+ Ord_Win32INVERTRECT = 767;
+ Ord_Win32ISCHILD = 768;
+ Ord_Win32ISPHYSINPUTENABLED = 769;
+ Ord_Win32ISRECTEMPTY = 770;
+ Ord_Win32ISTHREADACTIVE = 771;
+ Ord_Win32ISWINDOW = 772;
+ Ord_Win32ISWINDOWENABLED = 773;
+ Ord_Win32ISWINDOWSHOWING = 774;
+ Ord_Win32ISWINDOWVISIBLE = 775;
+ Ord_Win32LOADACCELTABLE = 776;
+ Ord_Win32LOADLIBRARY = 777;
+ Ord_Win32LOADMENU = 778;
+ Ord_Win32LOADMESSAGE = 779;
+ Ord_Win32LOADPOINTER = 780;
+ Ord_Win32LOADSTRING = 781;
+ Ord_Win32LOCKVISREGIONS = 782;
+ Ord_Win32LOCKWINDOWUPDATE = 784;
+ Ord_Win32MAKEPOINTS = 785;
+ Ord_Win32MAKERECT = 786;
+ Ord_Win32MAPDLGPOINTS = 787;
+ Ord_Win32MAPWINDOWPOINTS = 788;
+ Ord_Win32MESSAGEBOX = 789;
+ Ord_Win32MSGSEMWAIT = 790;
+ Ord_Win32NEXTCHAR = 791;
+ Ord_Win32OFFSETRECT = 792;
+ Ord_Win32OPENCLIPBRD = 793;
+ Ord_Win32OPENWINDOWDC = 794;
+ Ord_Win32PREVCHAR = 795;
+ Ord_Win32PROCESSDLG = 796;
+ Ord_Win32PTINRECT = 797;
+ Ord_Win32QUERYACCELTABLE = 798;
+ Ord_Win32QUERYACTIVEWINDOW = 799;
+ Ord_Win32QUERYANCHORBLOCK = 800;
+ Ord_Win32QUERYATOMLENGTH = 801;
+ Ord_Win32QUERYATOMNAME = 802;
+ Ord_Win32QUERYATOMUSAGE = 803;
+ Ord_Win32QUERYCAPTURE = 804;
+ Ord_Win32QUERYCLASSNAME = 805;
+ Ord_Win32QUERYCLIPBRDDATA = 806;
+ Ord_Win32QUERYCLIPBRDFMTINFO = 807;
+ Ord_Win32QUERYCLIPBRDOWNER = 808;
+ Ord_Win32QUERYCLIPBRDVIEWER = 809;
+ Ord_Win32QUERYCP = 810;
+ Ord_Win32QUERYCPLIST = 811;
+ Ord_Win32QUERYCURSORINFO = 812;
+ Ord_Win32QUERYDESKTOPWINDOW = 813;
+ Ord_Win32QUERYDLGITEMSHORT = 814;
+ Ord_Win32QUERYDLGITEMTEXT = 815;
+ Ord_Win32QUERYDLGITEMTEXTLENGTH = 816;
+ Ord_Win32QUERYFOCUS = 817;
+ Ord_Win32QUERYMSGPOS = 818;
+ Ord_Win32QUERYMSGTIME = 819;
+ Ord_Win32QUERYOBJECTWINDOW = 820;
+ Ord_Win32QUERYPOINTER = 821;
+ Ord_Win32QUERYPOINTERINFO = 822;
+ Ord_Win32QUERYPOINTERPOS = 823;
+ Ord_Win32QUERYQUEUEINFO = 824;
+ Ord_Win32QUERYQUEUESTATUS = 825;
+ Ord_Win32QUERYSYSCOLOR = 826;
+ Ord_Win32QUERYSYSMODALWINDOW = 827;
+ Ord_Win32QUERYSYSPOINTER = 828;
+ Ord_Win32QUERYSYSVALUE = 829;
+ Ord_Win32QUERYSYSTEMATOMTABLE = 830;
+ Ord_Win32QUERYUPDATERECT = 831;
+ Ord_Win32QUERYUPDATEREGION = 832;
+ Ord_Win32QUERYVERSION = 833;
+ Ord_Win32QUERYWINDOW = 834;
+ Ord_Win32QUERYWINDOWDC = 835;
+ Ord_Win32QUERYWINDOWPOS = 837;
+ Ord_Win32QUERYWINDOWPROCESS = 838;
+ Ord_Win32QUERYWINDOWPTR = 839;
+ Ord_Win32QUERYWINDOWRECT = 840;
+ Ord_Win32QUERYWINDOWTEXT = 841;
+ Ord_Win32QUERYWINDOWTEXTLENGTH = 842;
+ Ord_Win32QUERYWINDOWULONG = 843;
+ Ord_Win32QUERYWINDOWUSHORT = 844;
+ Ord_Win32REGISTERUSERDATATYPE = 845;
+ Ord_Win32REGISTERUSERMSG = 846;
+ Ord_Win32RELEASEPS = 848;
+ Ord_Win32SCROLLWINDOW = 849;
+ Ord_Win32SETACCELTABLE = 850;
+ Ord_Win32SETACTIVEWINDOW = 851;
+ Ord_Win32SETCAPTURE = 852;
+ Ord_Win32SETCLASSMSGINTEREST = 853;
+ Ord_Win32SETCLIPBRDDATA = 854;
+ Ord_Win32SETCLIPBRDOWNER = 855;
+ Ord_Win32SETCLIPBRDVIEWER = 856;
+ Ord_Win32SETCP = 857;
+ Ord_Win32SETDLGITEMSHORT = 858;
+ Ord_Win32SETDLGITEMTEXT = 859;
+ Ord_Win32SETFOCUS = 860;
+ Ord_Win32SETMSGINTEREST = 861;
+ Ord_Win32SETMSGMODE = 862;
+ Ord_Win32SETMULTWINDOWPOS = 863;
+ Ord_Win32SETOWNER = 864;
+ Ord_Win32SETPARENT = 865;
+ Ord_Win32SETPOINTER = 866;
+ Ord_Win32SETPOINTERPOS = 867;
+ Ord_Win32SETRECT = 868;
+ Ord_Win32SETRECTEMPTY = 869;
+ Ord_Win32SETSYNCHROMODE = 870;
+ Ord_Win32SETSYSCOLORS = 871;
+ Ord_Win32SETSYSMODALWINDOW = 872;
+ Ord_Win32SETSYSVALUE = 873;
+ Ord_Win32SETWINDOWBITS = 874;
+ Ord_Win32SETWINDOWPOS = 875;
+ Ord_Win32SETWINDOWPTR = 876;
+ Ord_Win32SETWINDOWTEXT = 877;
+ Ord_Win32SETWINDOWULONG = 878;
+ Ord_Win32SETWINDOWUSHORT = 879;
+ Ord_Win32SHOWCURSOR = 880;
+ Ord_Win32SHOWPOINTER = 881;
+ Ord_Win32SHOWTRACKRECT = 882;
+ Ord_Win32SHOWWINDOW = 883;
+ Ord_Win32STARTTIMER = 884;
+ Ord_Win32STOPTIMER = 885;
+ Ord_Win32SUBSTITUTESTRINGS = 886;
+ Ord_Win32SUBTRACTRECT = 887;
+ Ord_Win32TERMINATE = 888;
+ Ord_Win32TRACKRECT = 890;
+ Ord_Win32UNIONRECT = 891;
+ Ord_Win32UPDATEWINDOW = 892;
+ Ord_Win32UPPER = 893;
+ Ord_Win32UPPERCHAR = 894;
+ Ord_Win32VALIDATERECT = 895;
+ Ord_Win32VALIDATEREGION = 896;
+ Ord_Win32WAITMSG = 897;
+ Ord_Win32WINDOWFROMDC = 898;
+ Ord_Win32WINDOWFROMID = 899;
+ Ord_Win32WINDOWFROMPOINT = 900;
+ Ord_Win32BROADCASTMSG = 901;
+ Ord_Win32POSTQUEUEMSG = 902;
+ Ord_Win32SENDDLGITEMMSG = 903;
+ Ord_Win32TRANSLATEACCEL = 904;
+ Ord_Win32CALLMSGFILTER = 905;
+ Ord_Win32CREATEFRAMECONTROLS = 906;
+ Ord_Win32CREATEMENU = 907;
+ Ord_Win32CREATESTDWINDOW = 908;
+ Ord_Win32CREATEWINDOW = 909;
+ Ord_Win32DEFDLGPROC = 910;
+ Ord_Win32DEFWINDOWPROC = 911;
+ Ord_Win32DISPATCHMSG = 912;
+ Ord_Win32DRAWTEXT = 913;
+ Ord_Win32GETDLGMSG = 914;
+ Ord_Win32GETMSG = 915;
+ Ord_Win32MSGMUXSEMWAIT = 916;
+ Ord_Win32MULTWINDOWFROMIDS = 917;
+ Ord_Win32PEEKMSG = 918;
+ Ord_Win32POSTMSG = 919;
+ Ord_Win32SENDMSG = 920;
+ Ord_Win32SETKEYBOARDSTATETABLE = 921;
+ Ord_Win32CREATEDLG = 922;
+ Ord_Win32DLGBOX = 923;
+ Ord_Win32LOADDLG = 924;
+ Ord_Win32QUERYCLASSINFO = 925;
+ Ord_Win32REGISTERCLASS = 926;
+ Ord_Win32RELEASEHOOK = 927;
+ Ord_Win32SETHOOK = 928;
+ Ord_Win32SUBCLASSWINDOW = 929;
+ Ord_Win32SETCLASSTHUNKPROC = 930;
+ Ord_Win32QUERYCLASSTHUNKPROC = 931;
+ Ord_Win32SETWINDOWTHUNKPROC = 932;
+ Ord_Win32QUERYWINDOWTHUNKPROC = 933;
+ Ord_Win32QUERYWINDOWMODEL = 934;
+ Ord_Win32SETDESKTOPBKGND = 935;
+ Ord_Win32QUERYDESKTOPBKGND = 936;
+ Ord_Win32POPUPMENU = 937;
+ Ord_Win32SETPRESPARAM = 938;
+ Ord_Win32QUERYPRESPARAM = 939;
+ Ord_Win32REMOVEPRESPARAM = 940;
+ Ord_Win32REALIZEPALETTE = 941;
+ Ord_Win32CREATEPOINTERINDIRECT = 942;
+ Ord_Win32SAVEWINDOWPOS = 943;
+ Ord_Win32GETERASEPS = 952;
+ Ord_Win32RELEASEERASEPS = 953;
+ Ord_Win32SETPOINTEROWNER = 971;
+ Ord_Win32STRETCHPOINTER = 968;
+ Ord_Win32SETERRORINFO = 977;
+ Ord_Win32WAITEVENTSEM = 978;
+ Ord_Win32REQUESTMUTEXSEM = 979;
+ Ord_Win32WAITMUXWAITSEM = 980;
+ Ord_PicPRINT = 1;
+ Ord_PicICHG = 2;
+ Ord_Pic32PRINT = 11;
+ Ord_Pic32ICHG = 12;
+ Ord_Prf32PIF2MET = 13;
+ Ord_WinQUERYPROFILEINT = 2;
+ Ord_WinQUERYPROFILESTRING = 3;
+ Ord_WinWRITEPROFILESTRING = 4;
+ Ord_WinQUERYPROFILESIZE = 5;
+ Ord_WinQUERYPROFILEDATA = 6;
+ Ord_WinWRITEPROFILEDATA = 7;
+ Ord_WinINITSESSIONMGR = 8;
+ Ord_WinSETFGNDWINDOW = 9;
+ Ord_WinADDPROGRAM = 12;
+ Ord_WinREMOVEPROGRAM = 13;
+ Ord_WinCHANGEPROGRAM = 14;
+ Ord_WinQUERYDEFINITION = 15;
+ Ord_WinQUERYPROGRAMTITLES = 16;
+ Ord_WinCREATEGROUP = 17;
+ Ord_WinADDTOGROUP = 19;
+ Ord_WinQUERYPROGRAMUSE = 20;
+ Ord_WinREMOVEFROMGROUP = 21;
+ Ord_WinDESTROYGROUP = 23;
+ Ord_WinQUERYFILEEXTOPTS = 24;
+ Ord_WinSETFILEEXTOPTS = 25;
+ Ord_WinQUERYPROGRAMTYPE = 26;
+ Ord_PrfQUERYPROFILEINT = 32;
+ Ord_PrfQUERYPROFILESTRING = 33;
+ Ord_PrfWRITEPROFILESTRING = 34;
+ Ord_PrfQUERYPROFILESIZE = 35;
+ Ord_PrfQUERYPROFILEDATA = 36;
+ Ord_PrfWRITEPROFILEDATA = 37;
+ Ord_PrfOPENPROFILE = 38;
+ Ord_PrfCLOSEPROFILE = 39;
+ Ord_PrfRESET = 42;
+ Ord_PrfQUERYPROFILE = 43;
+ Ord_WinINSTSTARTAPP = 44;
+ Ord_WinTERMINATEAPP = 45;
+ Ord_WinCREATESWITCHENTRY = 46;
+ Ord_WinQUERYSESSIONTITLE = 47;
+ Ord_WinADDSWITCHENTRY = 48;
+ Ord_WinCHANGESWITCHENTRY = 49;
+ Ord_PrfADDPROGRAM = 50;
+ Ord_PrfREMOVEPROGRAM = 51;
+ Ord_PrfCHANGEPROGRAM = 52;
+ Ord_PrfQUERYDEFINITION = 53;
+ Ord_PrfQUERYPROGRAMTITLES = 54;
+ Ord_PrfCREATEGROUP = 55;
+ Ord_WinQUERYSWITCHENTRY = 56;
+ Ord_WinQUERYSWITCHHANDLE = 57;
+ Ord_PrfQUERYPROGRAMHANDLE = 58;
+ Ord_PrfQUERYPROGRAMCATEGORY = 59;
+ Ord_PrfDESTROYGROUP = 60;
+ Ord_WinQUERYTASKTITLE = 65;
+ Ord_WinQUERYTASKSIZEPOS = 66;
+ Ord_WinQUERYSWITCHLIST = 67;
+ Ord_WinREMOVESWITCHENTRY = 68;
+ Ord_WinSWITCHTOPROGRAM = 69;
+ Ord_WinSWITCHPROGRAMREGISTER = 70;
+ Ord_WinENDPROGRAM = 73;
+ Ord_WinSTOPPROGRAM = 74;
+ Ord_WinENDWINDOWSESSION = 75;
+ Ord_WinSWITCHTOTASKMANAGER = 78;
+ Ord_WinSWITCHTOPROGRAM2 = 80;
+ Ord_WinPROCESSHOTKEY = 81;
+ Ord_WinINITSESSION = 82;
+ Ord_WinENDSESSION = 83;
+ Ord_WinINITSWENTRY = 84;
+ Ord_WinSETSWENTRY = 85;
+ Ord_WinQUERYEXTIDFOCUS = 86;
+ Ord_WinSETEXTIDFOCUS = 87;
+ Ord_WinNOSHUTDOWN = 91;
+ Ord_WinSETTITLE = 93;
+ Ord_WinSETTITLEANDICON = 97;
+ Ord_Prf32QUERYPROFILESIZE = 101;
+ Ord_Prf32OPENPROFILE = 102;
+ Ord_Prf32CLOSEPROFILE = 103;
+ Ord_Prf32REMOVEPROGRAM = 104;
+ Ord_Prf32DESTROYGROUP = 106;
+ Ord_Prf32QUERYPROFILE = 107;
+ Ord_Prf32RESET = 108;
+ Ord_Prf32ADDPROGRAM = 109;
+ Ord_Prf32CHANGEPROGRAM = 110;
+ Ord_Prf32QUERYDEFINITION = 111;
+ Ord_Prf32QUERYPROGRAMTITLES = 113;
+ Ord_Prf32QUERYPROFILEINT = 114;
+ Ord_Prf32QUERYPROFILESTRING = 115;
+ Ord_Prf32WRITEPROFILESTRING = 116;
+ Ord_Prf32QUERYPROFILEDATA = 117;
+ Ord_Prf32WRITEPROFILEDATA = 118;
+ Ord_Win32STARTAPP = 119;
+ Ord_Win32ADDSWITCHENTRY = 120;
+ Ord_Win32CREATESWITCHENTRY = 121;
+ Ord_Win32QUERYSESSIONTITLE = 122;
+ Ord_Win32CHANGESWITCHENTRY = 123;
+ Ord_Win32QUERYSWITCHENTRY = 124;
+ Ord_Win32QUERYSWITCHHANDLE = 125;
+ Ord_Win32QUERYSWITCHLIST = 126;
+ Ord_Win32QUERYTASKSIZEPOS = 127;
+ Ord_Win32QUERYTASKTITLE = 128;
+ Ord_Win32REMOVESWITCHENTRY = 129;
+ Ord_Win32TERMINATEAPP = 130;
+ Ord_Win32SWITCHTOPROGRAM = 131;
+ Ord_Win32SWITCHPROGRAMREGISTER = 156;
+ Ord_WinSTARTAPP = 201;
+ Ord_WinHAPPFROMPID = 208;
+ Ord_WinHSWITCHFROMHAPP = 209;
+ Ord_DosREADQUEUE = 1;
+ Ord_DosPURGEQUEUE = 2;
+ Ord_DosCLOSEQUEUE = 3;
+ Ord_DosQUERYQUEUE = 4;
+ Ord_DosPEEKQUEUE = 5;
+ Ord_DosWRITEQUEUE = 6;
+ Ord_DosOPENQUEUE = 7;
+ Ord_DosCREATEQUEUE = 8;
+ Ord_Dos32READQUEUE = 9;
+ Ord_Dos32PURGEQUEUE = 10;
+ Ord_Dos32CLOSEQUEUE = 11;
+ Ord_Dos32QUERYQUEUE = 12;
+ Ord_Dos32PEEKQUEUE = 13;
+ Ord_Dos32WRITEQUEUE = 14;
+ Ord_Dos32OPENQUEUE = 15;
+ Ord_Dos32CREATEQUEUE = 16;
+ Ord_DosSTOPSESSION = 8;
+ Ord_DosSELECTSESSION = 9;
+ Ord_DosSETSESSION = 14;
+ Ord_DosSTARTSESSION = 17;
+ Ord_DosSMREGISTERDD = 29;
+ Ord_Dos32STARTSESSION = 37;
+ Ord_Dos32SELECTSESSION = 38;
+ Ord_Dos32SETSESSION = 39;
+ Ord_Dos32STOPSESSION = 40;
+ Ord_WinFONTDLG = 2;
+ Ord_WinDEFFONTDLGPROC = 3;
+ Ord_WinFILEDLG = 4;
+ Ord_WinDEFFILEDLGPROC = 5;
+ Ord_WinFREEFILEDLGLIST = 6;
+ Ord_VioENDPOPUP = 1;
+ Ord_VioGETPHYSBUF = 2;
+ Ord_VioGETANSI = 3;
+ Ord_VioSETANSI = 5;
+ Ord_VioDEREGISTER = 6;
+ Ord_VioSCROLLUP = 7;
+ Ord_VioPRTSC = 8;
+ Ord_VioGETCURPOS = 9;
+ Ord_VioWRTCELLSTR = 10;
+ Ord_VioPOPUP = 11;
+ Ord_VioSCROLLRT = 12;
+ Ord_VioWRTCHARSTR = 13;
+ Ord_VioSETCURPOS = 15;
+ Ord_VioSCRUNLOCK = 18;
+ Ord_VioWRTTTY = 19;
+ Ord_VioGETMODE = 21;
+ Ord_VioSETMODE = 22;
+ Ord_VioSCRLOCK = 23;
+ Ord_VioREADCELLSTR = 24;
+ Ord_VioSAVREDRAWWAIT = 25;
+ Ord_VioWRTNATTR = 26;
+ Ord_VioGETCURTYPE = 27;
+ Ord_VioSAVREDRAWUNDO = 28;
+ Ord_VioGETFONT = 29;
+ Ord_VioREADCHARSTR = 30;
+ Ord_VioGETBUF = 31;
+ Ord_VioSETCURTYPE = 32;
+ Ord_VioSETFONT = 33;
+ Ord_VioMODEUNDO = 35;
+ Ord_VioMODEWAIT = 37;
+ Ord_VioGETCP = 40;
+ Ord_VioSETCP = 42;
+ Ord_VioSHOWBUF = 43;
+ Ord_VioSCROLLLF = 44;
+ Ord_VioREGISTER = 45;
+ Ord_VioGETCONFIG = 46;
+ Ord_VioSCROLLDN = 47;
+ Ord_VioWRTCHARSTRATT = 48;
+ Ord_VioGETSTATE = 49;
+ Ord_VioPRTSCTOGGLE = 50;
+ Ord_VioSETSTATE = 51;
+ Ord_VioWRTNCELL = 52;
+ Ord_VioWRTNCHAR = 53;
+ Ord_VioASSOCIATE = 55;
+ Ord_VioCREATEPS = 56;
+ Ord_VioDELETESETID = 57;
+ Ord_VioGETDEVICECELLSIZE = 58;
+ Ord_VioGETORG = 59;
+ Ord_VioCREATELOGFONT = 60;
+ Ord_VioDESTROYPS = 61;
+ Ord_VioQUERYSETIDS = 62;
+ Ord_VioSETORG = 63;
+ Ord_VioQUERYFONTS = 64;
+ Ord_VioSETDEVICECELLSIZE = 65;
+ Ord_VioSHOWPS = 66;
+ Ord_VioGETPSADDRESS = 67;
+ Ord_VioGLOBALREG = 70;
+ Ord_XVioSETCASTATE = 71;
+ Ord_XVioCHECKCHARTYPE = 72;
+ Ord_XVioDESTROYCA = 73;
+ Ord_XVioCREATECA = 74;
+ Ord_VioCHECKCHARTYPE = 75;
+ Ord_XVioGETCASTATE = 76;
+ Ord_WinDefAVioWindowProc = 30;
+
+{ Declarations from bsedev.h header file (low-level device access) }
+ const
+ IOCTL_ASYNC = $0001;
+ IOCTL_SCR_AND_PTRDRAW = $0003;
+ IOCTL_KEYBOARD = $0004;
+ IOCTL_PRINTER = $0005;
+ IOCTL_LIGHTPEN = $0006;
+ IOCTL_POINTINGDEVICE = $0007;
+ IOCTL_DISK = $0008;
+ IOCTL_PHYSICALDISK = $0009;
+ IOCTL_MONITOR = $000A;
+ IOCTL_GENERAL = $000B;
+ ASYNC_SETBAUDRATE = $0041;
+ ASYNC_SETLINECTRL = $0042;
+ ASYNC_EXTSETBAUDRATE = $0043;
+ ASYNC_SETEXTBAUDRATE = $0043;
+ ASYNC_TRANSMITIMM = $0044;
+ ASYNC_SETBREAKOFF = $0045;
+ ASYNC_SETMODEMCTRL = $0046;
+ ASYNC_SETBREAKON = $004B;
+ ASYNC_STOPTRANSMIT = $0047;
+ ASYNC_STARTTRANSMIT = $0048;
+ ASYNC_SETDCBINFO = $0053;
+ ASYNC_GETBAUDRATE = $0061;
+ ASYNC_GETLINECTRL = $0062;
+ ASYNC_EXTGETBAUDRATE = $0063;
+ ASYNC_GETEXTBAUDRATE = $0063;
+ ASYNC_GETCOMMSTATUS = $0064;
+ ASYNC_GETLINESTATUS = $0065;
+ ASYNC_GETMODEMOUTPUT = $0066;
+ ASYNC_GETMODEMINPUT = $0067;
+ ASYNC_GETINQUECOUNT = $0068;
+ ASYNC_GETOUTQUECOUNT = $0069;
+ ASYNC_GETCOMMERROR = $006D;
+ ASYNC_GETCOMMEVENT = $0072;
+ ASYNC_GETDCBINFO = $0073;
+ SCR_ALLOCLDT = $0070;
+ SCR_DEALLOCLDT = $0071;
+ PTR_GETPTRDRAWADDRESS = $0072;
+ SCR_ALLOCLDTOFF = $0075;
+ KBD_SETTRANSTABLE = $0050;
+ KBD_SETINPUTMODE = $0051;
+ KBD_SETINTERIMFLAG = $0052;
+ KBD_SETSHIFTSTATE = $0053;
+ KBD_SETTYPAMATICRATE = $0054;
+ KBD_SETFGNDSCREENGRP = $0055;
+ KBD_SETSESMGRHOTKEY = $0056;
+ KBD_SETFOCUS = $0057;
+ KBD_SETKCB = $0058;
+ KBD_SETNLS = $005C;
+ KBD_CREATE = $005D;
+ KBD_DESTROY = $005E;
+ KBD_GETINPUTMODE = $0071;
+ KBD_GETINTERIMFLAG = $0072;
+ KBD_GETSHIFTSTATE = $0073;
+ KBD_READCHAR = $0074;
+ KBD_PEEKCHAR = $0075;
+ KBD_GETSESMGRHOTKEY = $0076;
+ KBD_GETKEYBDTYPE = $0077;
+ KBD_GETCODEPAGEID = $0078;
+ KBD_XLATESCAN = $0079;
+ PRT_QUERYJOBHANDLE = $0021;
+ PRT_SETFRAMECTL = $0042;
+ PRT_SETINFINITERETRY = $0044;
+ PRT_INITPRINTER = $0046;
+ PRT_ACTIVATEFONT = $0048;
+ PRT_GETFRAMECTL = $0062;
+ PRT_GETINFINITERETRY = $0064;
+ PRT_GETPRINTERSTATUS = $0066;
+ PRT_QUERYACTIVEFONT = $0069;
+ PRT_VERIFYFONT = $006A;
+ MOU_ALLOWPTRDRAW = $0050;
+ MOU_UPDATEDISPLAYMODE = $0051;
+ MOU_SCREENSWITCH = $0052;
+ MOU_SETSCALEFACTORS = $0053;
+ MOU_SETEVENTMASK = $0054;
+ MOU_SETHOTKEYBUTTON = $0055;
+ MOU_SETPTRSHAPE = $0056;
+ MOU_DRAWPTR = $0057;
+ MOU_REMOVEPTR = $0058;
+ MOU_SETPTRPOS = $0059;
+ MOU_SETPROTDRAWADDRESS = $005A;
+ MOU_SETREALDRAWADDRESS = $005B;
+ MOU_SETMOUSTATUS = $005C;
+ MOU_DISPLAYMODECHANGE = $005D;
+ MOU_GETBUTTONCOUNT = $0060;
+ MOU_GETMICKEYCOUNT = $0061;
+ MOU_GETMOUSTATUS = $0062;
+ MOU_READEVENTQUE = $0063;
+ MOU_GETQUESTATUS = $0064;
+ MOU_GETEVENTMASK = $0065;
+ MOU_GETSCALEFACTORS = $0066;
+ MOU_GETPTRPOS = $0067;
+ MOU_GETPTRSHAPE = $0068;
+ MOU_GETHOTKEYBUTTON = $0069;
+ MOU_VER = $006A;
+ DSK_LOCKDRIVE = $0000;
+ DSK_UNLOCKDRIVE = $0001;
+ DSK_REDETERMINEMEDIA = $0002;
+ DSK_SETLOGICALMAP = $0003;
+ DSK_BLOCKREMOVABLE = $0020;
+ DSK_GETLOGICALMAP = $0021;
+ DSK_SETDEVICEPARAMS = $0043;
+ DSK_WRITETRACK = $0044;
+ DSK_FORMATVERIFY = $0045;
+ DSK_GETDEVICEPARAMS = $0063;
+ DSK_READTRACK = $0064;
+ DSK_VERIFYTRACK = $0065;
+ PDSK_LOCKPHYSDRIVE = $0000;
+ PDSK_UNLOCKPHYSDRIVE = $0001;
+ PDSK_WRITEPHYSTRACK = $0044;
+ PDSK_GETPHYSDEVICEPARAMS = $0063;
+ PDSK_READPHYSTRACK = $0064;
+ PDSK_VERIFYPHYSTRACK = $0065;
+ MON_REGISTERMONITOR = $0040;
+ DEV_FLUSHINPUT = $0001;
+ DEV_FLUSHOUTPUT = $0002;
+ DEV_QUERYMONSUPPORT = $0060;
+ RX_QUE_OVERRUN = $0001;
+ RX_HARDWARE_OVERRUN = $0002;
+ PARITY_ERROR = $0004;
+ FRAMING_ERROR = $0008;
+ CHAR_RECEIVED = $0001;
+ LAST_CHAR_SENT = $0004;
+ CTS_CHANGED = $0008;
+ DSR_CHANGED = $0010;
+ DCD_CHANGED = $0020;
+ BREAK_DETECTED = $0040;
+ ERROR_OCCURRED = $0080;
+ RI_DETECTED = $0100;
+ TX_WAITING_FOR_CTS = $0001;
+ TX_WAITING_FOR_DSR = $0002;
+ TX_WAITING_FOR_DCD = $0004;
+ TX_WAITING_FOR_XON = $0008;
+ TX_WAITING_TO_SEND_XON = $0010;
+ TX_WAITING_WHILE_BREAK_ON = $0020;
+ TX_WAITING_TO_SEND_IMM = $0040;
+ RX_WAITING_FOR_DSR = $0080;
+ WRITE_REQUEST_QUEUED = $0001;
+ DATA_IN_TX_QUE = $0002;
+ HARDWARE_TRANSMITTING = $0004;
+ CHAR_READY_TO_SEND_IMM = $0008;
+ WAITING_TO_SEND_XON = $0010;
+ WAITING_TO_SEND_XOFF = $0020;
+ CTS_ON = $10;
+ DSR_ON = $20;
+ RI_ON = $40;
+ DCD_ON = $80;
+ BUILD_BPB_FROM_MEDIUM = $00;
+ REPLACE_BPB_FOR_DEVICE = $01;
+ REPLACE_BPB_FOR_MEDIUM = $02;
+ ASCII_MODE = $00;
+ BINARY_MODE = $80;
+ CONVERSION_REQUEST = $20;
+ INTERIM_CHAR = $80;
+ HOTKEY_MAX_COUNT = $0000;
+ HOTKEY_CURRENT_COUNT = $0001;
+ KBD_DATA_RECEIVED = $0001;
+ KBD_DATA_BINARY = $8000;
+ KBD_READ_WAIT = $0000;
+ KBD_READ_NOWAIT = $8000;
+ SHIFT_REPORT_MODE = $01;
+ MOUSE_MOTION = $0001;
+ MOUSE_MOTION_WITH_BN1_DOWN = $0002;
+ MOUSE_BN1_DOWN = $0004;
+ MOUSE_MOTION_WITH_BN2_DOWN = $0008;
+ MOUSE_BN2_DOWN = $0010;
+ MOUSE_MOTION_WITH_BN3_DOWN = $0020;
+ MOUSE_BN3_DOWN = $0040;
+ MHK_BUTTON1 = $0001;
+ MHK_BUTTON2 = $0002;
+ MHK_BUTTON3 = $0004;
+ MOU_NOWAIT = $0000;
+ MOU_WAIT = $0001;
+ MHK_NO_HOTKEY = $0000;
+ MOUSE_QUEUEBUSY = $0001;
+ MOUSE_BLOCKREAD = $0002;
+ MOUSE_FLUSH = $0004;
+ MOUSE_UNSUPPORTED_MODE = $0008;
+ MOUSE_DISABLED = $0100;
+ MOUSE_MICKEYS = $0200;
+ PRINTER_TIMEOUT = $0001;
+ PRINTER_IO_ERROR = $0008;
+ PRINTER_SELECTED = $0010;
+ PRINTER_OUT_OF_PAPER = $0020;
+ PRINTER_ACKNOWLEDGED = $0040;
+ PRINTER_NOT_BUSY = $0080;
+ MODE_DTR_CONTROL = $01;
+ MODE_DTR_HANDSHAKE = $02;
+ MODE_CTS_HANDSHAKE = $08;
+ MODE_DSR_HANDSHAKE = $10;
+ MODE_DCD_HANDSHAKE = $20;
+ MODE_DSR_SENSITIVITY = $40;
+ MODE_AUTO_TRANSMIT = $01;
+ MODE_AUTO_RECEIVE = $02;
+ MODE_ERROR_CHAR = $04;
+ MODE_NULL_STRIPPING = $08;
+ MODE_BREAK_CHAR = $10;
+ MODE_RTS_CONTROL = $40;
+ MODE_RTS_HANDSHAKE = $80;
+ MODE_TRANSMIT_TOGGLE = $C0;
+ MODE_NO_WRITE_TIMEOUT = $01;
+ MODE_READ_TIMEOUT = $02;
+ MODE_WAIT_READ_TIMEOUT = $04;
+ MODE_NOWAIT_READ_TIMEOUT = $06;
+
+ type
+ DCBINFO = record
+ usWriteTimeout : word;
+ usReadTimeout : word;
+ fbCtlHndShake : byte;
+ fbFlowReplace : byte;
+ fbTimeout : byte;
+ bErrorReplacementChar : byte;
+ bBreakReplacementChar : byte;
+ bXONChar : byte;
+ bXOFFChar : byte;
+ end;
+
+ PDCBINFO = ^DCBINFO;
+ TDCBInfo = DCBInfo;
+
+ const
+ DEVTYPE_48TPI = $0000;
+ DEVTYPE_96TPI = $0001;
+ DEVTYPE_35 = $0002;
+ DEVTYPE_8SD = $0003;
+ DEVTYPE_8DD = $0004;
+ DEVTYPE_FIXED = $0005;
+ DEVTYPE_TAPE = $0006;
+ DEVTYPE_UNKNOWN = $0007;
+
+{$PACKRECORDS 1}
+
+ type
+ BIOSPARAMETERBLOCK = record
+ usBytesPerSector : word;
+ bSectorsPerCluster : byte;
+ usReservedSectors : word;
+ cFATs : byte;
+ cRootEntries : word;
+ cSectors : word;
+ bMedia : byte;
+ usSectorsPerFAT : word;
+ usSectorsPerTrack : word;
+ cHeads : word;
+ cHiddenSectors : cardinal;
+ cLargeSectors : cardinal;
+ abReserved : array[0..6-1] of byte;
+ cCylinders : word;
+ bDeviceType : byte;
+ fsDeviceAttr : word;
+ end;
+
+ PBIOSPARAMETERBLOCK = ^BIOSPARAMETERBLOCK;
+ TBIOSParameterBlock = BiosParameterBlock;
+
+ SCREENGROUP = record
+ idScreenGrp : word;
+ fTerminate : word;
+ end;
+
+ PSCREENGROUP = ^SCREENGROUP;
+ TScreenGroup = ScreenGroup;
+
+ FRAME = record
+ bCharsPerLine : byte;
+ bLinesPerInch : byte;
+ end;
+
+ PFRAME = ^FRAME;
+ TFrame = Frame;
+
+ KBDTYPE = record
+ usType : word;
+ reserved1 : word;
+ reserved2 : word;
+ end;
+
+ PKBDTYPE = ^KBDTYPE;
+ TKbdType = KbdType;
+
+ LINECONTROL = record
+ bDataBits : byte;
+ bParity : byte;
+ bStopBits : byte;
+ fTransBreak : byte;
+ end;
+
+ PLINECONTROL = ^LINECONTROL;
+ TLineControl = LineControl;
+
+ const
+ DTR_ON = $01;
+ RTS_ON = $02;
+ DTR_OFF = $FE;
+ RTS_OFF = $FD;
+
+ type
+ MODEMSTATUS = record
+ fbModemOn : byte;
+ fbModemOff : byte;
+ end;
+
+ PMODEMSTATUS = ^MODEMSTATUS;
+ TModemStatus = ModemStatus;
+
+ RXQUEUE = record
+ cch : word;
+ cb : word;
+ end;
+
+ PRXQUEUE = ^RXQUEUE;
+ TRxQueue = RxQueue;
+
+ DEVICEPARAMETERBLOCK = record
+ reserved1 : word;
+ cCylinders : word;
+ cHeads : word;
+ cSectorsPerTrack : word;
+ reserved2 : word;
+ reserved3 : word;
+ reserved4 : word;
+ reserved5 : word;
+ end;
+
+ PDEVICEPARAMETERBLOCK = ^DEVICEPARAMETERBLOCK;
+ TDeviceParameterBlock = DeviceParameterBlock;
+
+{$PACKRECORDS 2}
+
+ PTRDRAWFUNCTION = record
+ usReturnCode : word;
+ pfnDraw : pointer;
+ {!!!!!!!! pfnDraw : PFN; }
+ pchDataSeg : pointer;
+ end;
+
+ PPTRDRAWFUNCTION = ^PTRDRAWFUNCTION;
+ TPtrDrawFunction = PtrDrawFunction;
+
+ PTRDRAWADDRESS = record
+ reserved : word;
+ ptrdfnc : PTRDRAWFUNCTION;
+ end;
+
+ PPTRDRAWADDRESS = ^PTRDRAWADDRESS;
+ TPtrDrawAddress = PtrDrawAddress;
+
+ SHIFTSTATE = record
+ fsState : word;
+ fNLS : byte;
+ end;
+
+ PSHIFTSTATE = ^SHIFTSTATE;
+ TShiftState = ShiftState;
+
+ const
+ RIGHTSHIFT = $0001;
+ LEFTSHIFT = $0002;
+ CONTROL = $0004;
+ ALT = $0008;
+ SCROLLLOCK_ON = $0010;
+ NUMLOCK_ON = $0020;
+ CAPSLOCK_ON = $0040;
+ INSERT_ON = $0080;
+ LEFTCONTROL = $0100;
+ LEFTALT = $0200;
+ RIGHTCONTROL = $0400;
+ RIGHTALT = $0800;
+ SCROLLLOCK = $1000;
+ NUMLOCK = $2000;
+ CAPSLOCK = $4000;
+ SYSREQ = $8000;
+
+ type
+ HOTKEY = record
+ fsHotKey : word;
+ uchScancodeMake : byte;
+ uchScancodeBreak : byte;
+ idHotKey : word;
+ end;
+
+ PHOTKEY = ^HOTKEY;
+ THotKey = HotKey;
+
+ MONITORPOSITION = record
+ fPosition : word;
+ index : word;
+ pbInBuf : cardinal;
+ offOutBuf : word;
+ end;
+
+ PMONITORPOSITION = ^MONITORPOSITION;
+ TMonitorPosition = MonitorPosition;
+
+ RATEDELAY = record
+ usDelay : word;
+ usRate : word;
+ end;
+
+ PRATEDELAY = ^RATEDELAY;
+ TRateDelay = RateDelay;
+
+ CODEPAGEINFO = record
+ pbTransTable : PByte;
+ idCodePage : word;
+ idTable : word;
+ end;
+
+ PCODEPAGEINFO = ^CODEPAGEINFO;
+ TCodePageInfo = CodePageInfo;
+
+ CPID = record
+ idCodePage : word;
+ Reserved : word;
+ end;
+
+ PCPID = ^CPID;
+ TCPID = CPID;
+
+ LDTADDRINFO = record
+ pulPhysAddr : PCardinal;
+ cb : word;
+ end;
+
+ PLDTADDRINFO = ^LDTADDRINFO;
+ TLDTAddrInfo = LDTAddrInfo;
+
+ PTRDRAWDATA = record
+ cb : word;
+ usConfig : word;
+ usFlag : word;
+ end;
+
+ PPTRDRAWDATA = ^PTRDRAWDATA;
+ TPtrDrawData = PtrDrawData;
+
+{$PACKRECORDS NORMAL}
+
+Type
+ ICONINFO=record
+ cb: Cardinal; // size of ICONINFO structure
+ fFormat: Cardinal;
+ pszFileName: PChar; //use when fFormat = ICON_FILE
+ hmod: Cardinal; // use when fFormat = ICON_RESOURCE
+ resid: Cardinal; // use when fFormat = ICON_RESOURCE
+ cbIconData: Cardinal; // use when fFormat = ICON_DATA
+ pIconData: Pointer; // use when fFormat = ICON_DATA
+ end;
+ PIconInfo=^IconInfo;
+
+const
+ ICON_FILE =1; // flags for fFormat
+ ICON_RESOURCE =2;
+ ICON_DATA =3;
+ ICON_CLEAR =4;
+
+{ Error constants from bseerr.h header file }
+CONST
+ NO_ERROR =0; { MSG%RESPONSE_DATA }
+ ERROR_INVALID_FUNCTION =1; { MSG%INVALID_FUNCTION }
+ ERROR_FILE_NOT_FOUND =2; { MSG%FILE_NOT_FOUND }
+ ERROR_PATH_NOT_FOUND =3; { MSG%PATH_NOT_FOUND }
+ ERROR_TOO_MANY_OPEN_FILES=4; { MSG%OUT_OF_HANDLES }
+ ERROR_ACCESS_DENIED =5; { MSG%ACCESS_DENIED }
+ ERROR_INVALID_HANDLE =6; { MSG%INVALID_HANDLE }
+ ERROR_ARENA_TRASHED =7; { MSG%MEMORY_BLOCKS_BAD }
+ ERROR_NOT_ENOUGH_MEMORY =8; { MSG%NO_MEMORY }
+ ERROR_INVALID_BLOCK =9; { MSG%INVALID_MEM_ADDR }
+ ERROR_BAD_ENVIRONMENT =10; { MSG%INVALID_ENVIRON }
+ ERROR_BAD_FORMAT =11; { MSG%INVALID_FORMAT }
+ ERROR_INVALID_ACCESS =12; { MSG%INVALID_ACC_CODE }
+ ERROR_INVALID_DATA =13; { MSG%INVALID_DATA }
+ ERROR_INVALID_DRIVE =15; { MSG%INVALID_DRIVE }
+ ERROR_CURRENT_DIRECTORY =16; { MSG%ATT_RD_CURDIR }
+ ERROR_NOT_SAME_DEVICE =17; { MSG%NOT_SAME_DEVICE }
+ ERROR_NO_MORE_FILES =18; { MSG%NO_MORE_FILES }
+ ERROR_WRITE_PROTECT =19; { MSG%ATT_WRITE_PROT }
+ ERROR_BAD_UNIT =20; { MSG%UNKNOWN_UNIT }
+ ERROR_NOT_READY =21; { MSG%DRIVE_NOT_READY }
+ ERROR_BAD_COMMAND =22; { MSG%UNKNOWN_COMMAND }
+ ERROR_CRC =23; { MSG%DATA_ERROR }
+ ERROR_BAD_LENGTH =24; { MSG%BAD_REQ_STRUCTURE }
+ ERROR_SEEK =25; { MSG%SEEK_ERROR }
+ ERROR_NOT_DOS_DISK =26; { MSG%UNKNOWN_MEDIA }
+ ERROR_SECTOR_NOT_FOUND =27; { MSG%SECTOR_NOT_FOUND }
+ ERROR_OUT_OF_PAPER =28; { MSG%OUT_OF_PAPER }
+ ERROR_WRITE_FAULT =29; { MSG%WRITE_FAULT }
+ ERROR_READ_FAULT =30; { MSG%READ_FAULT }
+ ERROR_GEN_FAILURE =31; { MSG%GENERAL_FAILURE }
+ ERROR_SHARING_VIOLATION =32; { MSG%SHARING_VIOLATION }
+{ =32%msg%SHAR_VIOLAT_FIND }
+ ERROR_LOCK_VIOLATION =33; { MSG%LOCK_VIOLATION }
+ ERROR_WRONG_DISK =34; { MSG%INVALID_DISK_CHANGE }
+ ERROR_FCB_UNAVAILABLE =35; { MSG%35;}
+ ERROR_SHARING_BUFFER_EXCEEDED=36;{ MSG%SHARING_BUFF_OFLOW }
+ ERROR_CODE_PAGE_MISMATCHED=37; { MSG%ERROR_WRITE_PROTECT }
+ ERROR_HANDLE_EOF =38; { MSG%ERROR_BAD_UNIT }
+ ERROR_HANDLE_DISK_FULL =39; { MSG%ERROR_NOT_READY }
+{ =40%msg%ERROR_BAD_COMMAND }
+{ =41%msg%ERROR_CRC }
+{ =42%msg%ERROR_BAD_LENGTH }
+{ =43%msg%ERROR_SEEK }
+{ =44%msg%ERROR_NOT_DOS_DISK }
+{ =45%msg%ERROR_SECTOR_NOT_FOUND }
+{ =46%msg%ERROR_OUT_OF_PAPER }
+{ =47%msg%ERROR_WRITE_FAULT }
+{ =48%msg%ERROR_READ_FAULT }
+{ =49%msg%ERROR_GEN_FAILURE }
+ ERROR_NOT_SUPPORTED =50; { MSG%NET_REQ_NOT_SUPPORT }
+ ERROR_REM_NOT_LIST =51; { MSG%NET_REMOTE_NOT_ONLINE }
+ ERROR_DUP_NAME =52; { MSG%NET_DUP_FILENAME }
+ ERROR_BAD_NETPATH =53; { MSG%NET_PATH_NOT_FOUND }
+ ERROR_NETWORK_BUSY =54; { MSG%NET_BUSY }
+ ERROR_DEV_NOT_EXIST =55; { MSG%NET_DEV_NOT_INSTALLED }
+ ERROR_TOO_MANY_CMDS =56; { MSG%NET_BIOS_LIMIT_REACHED }
+ ERROR_ADAP_HDW_ERR =57; { MSG%NET_ADAPT_HRDW_ERROR }
+ ERROR_BAD_NET_RESP =58; { MSG%NET_INCORRECT_RESPONSE }
+ ERROR_UNEXP_NET_ERR =59; { MSG%NET_UNEXPECT_ERROR }
+ ERROR_BAD_REM_ADAP =60; { MSG%NET_REMOT_ADPT_INCOMP }
+ ERROR_PRINTQ_FULL =61; { MSG%NET_PRINT_Q_FULL }
+ ERROR_NO_SPOOL_SPACE =62; { MSG%NET_NO_SPACE_TO_PRINT_FL }
+ ERROR_PRINT_CANCELLED =63; { MSG%NET_PRINT_FILE_DELETED }
+ ERROR_NETNAME_DELETED =64; { MSG%NET_NAME_DELETED }
+ ERROR_NETWORK_ACCESS_DENIED=65; { MSG%NET_ACCESS_DENIED }
+ ERROR_BAD_DEV_TYPE =66; { MSG%NET_DEV_TYPE_INVALID }
+ ERROR_BAD_NET_NAME =67; { MSG%NET_NAME_NOT_FOUND }
+ ERROR_TOO_MANY_NAMES =68; { MSG%NET_NAME_LIMIT_EXCEED }
+ ERROR_TOO_MANY_SESS =69; { MSG%NET_BIOS_LIMIT_EXCEED }
+ ERROR_SHARING_PAUSED =70; { MSG%NET_TEMP_PAUSED }
+ ERROR_REQ_NOT_ACCEP =71; { MSG%NET_REQUEST_DENIED }
+ ERROR_REDIR_PAUSED =72; { MSG%NET_PRT_DSK_REDIR_PAUSE }
+ ERROR_SBCS_ATT_WRITE_PROT=73; { Attempted write on protected disk }
+ ERROR_SBCS_GENERAL_FAILURE=74; { General failure }
+ ERROR_XGA_OUT_MEMORY =75; { MSG%XGA_OUT_MEMORY }
+ ERROR_FILE_EXISTS =80; { MSG%FILE_EXISTS }
+ ERROR_DUP_FCB =81; { MSG%none }
+ ERROR_CANNOT_MAKE =82; { MSG%CANNOT_MAKE }
+ ERROR_FAIL_I24 =83; { MSG%NET_FAIL_INT_TWO_FOUR }
+ ERROR_OUT_OF_STRUCTURES =84; { MSG%NET_TOO_MANY_REDIRECT }
+ ERROR_ALREADY_ASSIGNED =85; { MSG%NET_DUP_REDIRECTION }
+ ERROR_INVALID_PASSWORD =86; { MSG%NET_INVALID_PASSWORD }
+ ERROR_INVALID_PARAMETER =87; { MSG%NET_INCORR_PARAMETER }
+ ERROR_NET_WRITE_FAULT =88; { MSG%NET_DATA_FAULT }
+ ERROR_NO_PROC_SLOTS =89; { MSG%NO_PROC_SLOTS }
+ ERROR_NOT_FROZEN =90; { MSG%none }
+ ERROR_SYS_COMP_NOT_LOADED=ERROR_NOT_FROZEN;
+ ERR_TSTOVFL =91; { MSG%none }
+ ERR_TSTDUP =92; { MSG%none }
+ ERROR_NO_ITEMS =93; { MSG%none }
+ ERROR_INTERRUPT =95; { MSG%none }
+ ERROR_DEVICE_IN_USE =99; { MSG%DEVICE_IN_USE }
+ ERROR_TOO_MANY_SEMAPHORES=100; { MSG%TOO_MANY_SEMAPHORES }
+ ERROR_EXCL_SEM_ALREADY_OWNED=101;{ MSG%EXCL_SEM_ALREADY_OWNED }
+ ERROR_SEM_IS_SET =102; { MSG%SEM_IS_SET }
+ ERROR_TOO_MANY_SEM_REQUESTS=103; { MSG%TOO_MANY_SEM_REQUESTS }
+ ERROR_INVALID_AT_INTERRUPT_TIME=104; { MSG%INVALID_AT_INTERRUPT_TIME }
+ ERROR_SEM_OWNER_DIED =105; { MSG%SEM_OWNER_DIED }
+ ERROR_SEM_USER_LIMIT =106; { MSG%ERROR_DISK_CHANGE }
+ ERROR_DISK_CHANGE =107; { MSG%DISK_CHANGE }
+ ERROR_DRIVE_LOCKED =108; { MSG%DRIVE_LOCKED }
+ ERROR_BROKEN_PIPE =109; { MSG%BROKEN_PIPE }
+ ERROR_OPEN_FAILED =110; { MSG%ERROR_OPEN_FAILED }
+ ERROR_BUFFER_OVERFLOW =111; { MSG%ERROR_FILENAME_LONG }
+ ERROR_DISK_FULL =112; { MSG%DISK_FULL }
+ ERROR_NO_MORE_SEARCH_HANDLES=113;{ MSG%NO_SEARCH_HANDLES }
+ ERROR_INVALID_TARGET_HANDLE=114; { MSG%ERR_INV_TAR_HANDLE }
+ ERROR_PROTECTION_VIOLATION=115; { MSG%none }
+ ERROR_VIOKBD_REQUEST =116; { MSG%none }
+ ERROR_INVALID_CATEGORY =117; { MSG%INVALID_CATEGORY }
+ ERROR_INVALID_VERIFY_SWITCH=118; { MSG%INVALID_VERIFY_SWITCH }
+ ERROR_BAD_DRIVER_LEVEL =119; { MSG%BAD_DRIVER_LEVEL }
+ ERROR_CALL_NOT_IMPLEMENTED=120; { MSG%BAD_DYNALINK }
+ ERROR_SEM_TIMEOUT =121; { MSG%SEM_TIMEOUT }
+ ERROR_INSUFFICIENT_BUFFER=122; { MSG%INSUFFICIENT_BUFFER }
+ ERROR_INVALID_NAME =123; { MSG%INVALID_NAME }
+{ =123%msg%HPFS_INVALID_VOLUME_CHAR }
+ ERROR_INVALID_LEVEL =124; { MSG%INVALID_LEVEL }
+ ERROR_NO_VOLUME_LABEL =125; { MSG%NO_VOLUME_LABEL }
+ ERROR_MOD_NOT_FOUND =126; { MSG%MOD_NOT_FOUND }
+ ERROR_PROC_NOT_FOUND =127; { MSG%PROC_NOT_FOUND }
+ ERROR_WAIT_NO_CHILDREN =128; { MSG%none }
+ ERROR_CHILD_NOT_COMPLETE=129; { MSG%PROT_MODE_ONLY }
+ ERROR_DIRECT_ACCESS_HANDLE=130; { MSG%APPL_SINGLEFRAMECHAR }
+ ERROR_NEGATIVE_SEEK =131; { MSG%APPL_DOUBLEFRAMECHAR }
+ ERROR_SEEK_ON_DEVICE =132; { MSG%APPL_ARROWCHAR }
+ ERROR_IS_JOIN_TARGET =133; { MSG%JOIN_ON_DRIV_IS_TAR }
+ ERROR_IS_JOINED =134; { MSG%JOIN_DRIVE_IS }
+ ERROR_IS_SUBSTED =135; { MSG%SUB_DRIVE_IS }
+ ERROR_NOT_JOINED =136; { MSG%DRIVE_IS_NOT_JOINED }
+ ERROR_NOT_SUBSTED =137; { MSG%DRIVE_NOT_SUBSTED }
+ ERROR_JOIN_TO_JOIN =138; { MSG%JOIN_CANNOT_JOIN_DRIVE }
+ ERROR_SUBST_TO_SUBST =139; { MSG%SUB_CANNOT_SUBST_DRIVE }
+ ERROR_JOIN_TO_SUBST =140; { MSG%JOIN_CANNOT_SUB_DRIVE }
+ ERROR_SUBST_TO_JOIN =141; { MSG%SUB_CANNOT_JOIN_DRIVE }
+ ERROR_BUSY_DRIVE =142; { MSG%DRIVE_IS_BUSY }
+ ERROR_SAME_DRIVE =143; { MSG%JOIN_SUB_SAME_DRIVE }
+ ERROR_DIR_NOT_ROOT =144; { MSG%DIRECT_IS_NOT_SUBDIR }
+ ERROR_DIR_NOT_EMPTY =145; { MSG%DIRECT_IS_NOT_EMPTY }
+ ERROR_IS_SUBST_PATH =146; { MSG%PATH_USED_SUBST_JOIN }
+ ERROR_IS_JOIN_PATH =147; { MSG%NO_NEEDED_RESOURCES }
+ ERROR_PATH_BUSY =148; { MSG%PATH_BUSY }
+ ERROR_IS_SUBST_TARGET =149; { MSG%SUB_ON_DRIVE_IS_JOIN }
+ ERROR_SYSTEM_TRACE =150; { MSG%SYSTEM_TRACE }
+ ERROR_INVALID_EVENT_COUNT=151; { MSG%INVALID_EVENT_COUNT }
+ ERROR_TOO_MANY_MUXWAITERS=152; { MSG%TOO_MANY_MUXWAITERS }
+ ERROR_INVALID_LIST_FORMAT=153; { MSG%INVALID_LIST_FORMAT }
+ ERROR_LABEL_TOO_LONG =154; { MSG%VOLUME_TOO_LONG }
+{ =154%msg%HPFS_VOL_LABEL_LONG }
+ ERROR_TOO_MANY_TCBS =155; { MSG%TOO_MANY_TCBS }
+ ERROR_SIGNAL_REFUSED =156; { MSG%SIGNAL_REFUSED }
+ ERROR_DISCARDED =157; { MSG%DISCARDED }
+ ERROR_NOT_LOCKED =158; { MSG%NOT_LOCKED }
+ ERROR_BAD_THREADID_ADDR =159; { MSG%BAD_THREADID_ADDR }
+ ERROR_BAD_ARGUMENTS =160; { MSG%BAD_ARGUMENTS }
+ ERROR_BAD_PATHNAME =161; { MSG%none }
+ ERROR_SIGNAL_PENDING =162; { MSG%SIGNAL_PENDING }
+ ERROR_UNCERTAIN_MEDIA =163; { MSG%none }
+ ERROR_MAX_THRDS_REACHED =164; { MSG%MAX_THRDS_REACHED }
+ ERROR_MONITORS_NOT_SUPPORTED=165;{ MSG%none }
+ ERROR_UNC_DRIVER_NOT_INSTALLED=166;{ MSG%UNC_DRIVER_NOT_INSTALLED }
+ ERROR_LOCK_FAILED =167; { MSG%LOCK_FAILED }
+ ERROR_SWAPIO_FAILED =168; { MSG%SWAPIO_FAILED }
+ ERROR_SWAPIN_FAILED =169; { MSG%SWAPIN_ATTEMPT_FAILED }
+ ERROR_BUSY =170; { MSG%SEGMENT_BUSY }
+{ =171%msg%INT_TOO_LONG }
+ ERROR_CANCEL_VIOLATION =173; { MSG%UNLOCK_VIOLATION }
+ ERROR_ATOMIC_LOCK_NOT_SUPPORTED=174;{ MSG%none }
+ ERROR_READ_LOCKS_NOT_SUPPORTED=175;{ MSG%none }
+ ERROR_INVALID_SEGMENT_NUMBER=180;{ MSG%INVALID_SEGMENT_NUM }
+ ERROR_INVALID_CALLGATE =181; { MSG%none }
+ ERROR_INVALID_ORDINAL =182; { MSG%INVALID_ORDINAL }
+ ERROR_ALREADY_EXISTS =183; { MSG%none }
+ ERROR_NO_CHILD_PROCESS =184; { MSG%none }
+ ERROR_CHILD_ALIVE_NOWAIT=185; { MSG%none }
+ ERROR_INVALID_FLAG_NUMBER=186; { MSG%INVALID_FLAG_NUMBER }
+ ERROR_SEM_NOT_FOUND =187; { MSG%SEM_NOT_FOUND }
+ ERROR_INVALID_STARTING_CODESEG=188;{ MSG%INVALID_STARTING_CODESEG }
+ ERROR_INVALID_STACKSEG =189; { MSG%INVALID_STACKSEG }
+ ERROR_INVALID_MODULETYPE=190; { MSG%INVALID_MODULETYPE }
+ ERROR_INVALID_EXE_SIGNATURE=191; { MSG%INVALID_EXE_SIGNATURE }
+ ERROR_EXE_MARKED_INVALID=192; { MSG%EXE_MARKED_INVALID }
+ ERROR_BAD_EXE_FORMAT =193; { MSG%BAD_EXE_FORMAT }
+ ERROR_ITERATED_DATA_EXCEEDS_64k=194;{ MSG%ITERATED_DATA_EXCEEDS_64K }
+ ERROR_INVALID_MINALLOCSIZE=195; { MSG%INVALID_MINALLOCSIZE }
+ ERROR_DYNLINK_FROM_INVALID_RING=196;{ MSG%DYNLINK_FROM_INVALID_RING }
+ ERROR_IOPL_NOT_ENABLED =197; { MSG%IOPL_NOT_ENABLED }
+ ERROR_INVALID_SEGDPL =198; { MSG%INVALID_SEGDPL }
+ ERROR_AUTODATASEG_EXCEEDS_64k=199;{ MSG%AUTODATASEG_EXCEEDS_64K }
+ ERROR_RING2SEG_MUST_BE_MOVABLE=200;{ MSG%CODESEG_CANNOT_BE_64K }
+ ERROR_RELOC_CHAIN_XEEDS_SEGLIM=201;{ MSG%RELOC_CHAIN_XEEDS_SEGMENT }
+ ERROR_INFLOOP_IN_RELOC_CHAIN=202; { MSG%INFLOOP_IN_RELOC_CHAIN }
+ ERROR_ENVVAR_NOT_FOUND =203; { MSG%ENVVAR_NOT_FOUND }
+ ERROR_NOT_CURRENT_CTRY =204; { MSG%none }
+ ERROR_NO_SIGNAL_SENT =205; { MSG%SIGNAL_NOT_SENT }
+ ERROR_FILENAME_EXCED_RANGE=206; { MSG%NAME_TOO_LONG }
+ ERROR_RING2_STACK_IN_USE=207; { MSG%RING2_STACK_IN_USE }
+ ERROR_META_EXPANSION_TOO_LONG=208; { MSG%WILD_CARD_NAME }
+ ERROR_INVALID_SIGNAL_NUMBER=209; { MSG%INVALID_SIGNAL_NUMBER }
+ ERROR_THREAD_1_INACTIVE =210; { MSG%THREAD_1_INACTIVE }
+ ERROR_INFO_NOT_AVAIL =211; { MSG%none }
+ ERROR_LOCKED =212; { MSG%LOCKED }
+ ERROR_BAD_DYNALINK =213; { MSG%none }
+ ERROR_TOO_MANY_MODULES =214; { MSG%TOO_MANY_MODULES }
+ ERROR_NESTING_NOT_ALLOWED=215; { MSG%none }
+ ERROR_CANNOT_SHRINK =216; { MSG%CANNOT_SHRINK }
+ ERROR_ZOMBIE_PROCESS =217; { MSG%none }
+ ERROR_STACK_IN_HIGH_MEMORY=218; { MSG%none }
+ ERROR_INVALID_EXITROUTINE_RING=219; { MSG%INVALID_EXITROUTINE_RING }
+ ERROR_GETBUF_FAILED =220; { MSG%none }
+ ERROR_FLUSHBUF_FAILED =221; { MSG%none }
+ ERROR_TRANSFER_TOO_LONG =222; { MSG%none }
+ ERROR_FORCENOSWAP_FAILED=223; { MSG%none }
+ ERROR_SMG_NO_TARGET_WINDOW=224; { PM ID can't be selected }
+ ERROR_NO_CHILDREN =228; { MSG%NO_CHILDREN }
+ ERROR_INVALID_SCREEN_GROUP=229; { MSG%none }
+ ERROR_BAD_PIPE =230; { MSG%ERROR_BAD_PIPE }
+ ERROR_PIPE_BUSY =231; { MSG%ERROR_PIPE_BUSY }
+ ERROR_NO_DATA =232; { MSG%ERROR_NO_DATA }
+ ERROR_PIPE_NOT_CONNECTED=233; { MSG%ERROR_PIPE_NOT_CONNECTED }
+ ERROR_MORE_DATA =234; { MSG%ERROR_MORE_DATA }
+ ERROR_VC_DISCONNECTED =240; { MSG%ERROR_VC_DISCONNECTED }
+ ERROR_CIRCULARITY_REQUESTED=250; { MSG%CIRCULARITY_REQUESTED }
+ ERROR_DIRECTORY_IN_CDS =251; { MSG%DIRECTORY_IN_CDS }
+ ERROR_INVALID_FSD_NAME =252; { MSG%INVALID_FSD_NAME }
+ ERROR_INVALID_PATH =253; { MSG%INVALID_PATH }
+ ERROR_INVALID_EA_NAME =254; { MSG%INVALID_EA_NAME }
+ ERROR_EA_LIST_INCONSISTENT=255; { MSG%EA_LIST_INCONSISTENT }
+ ERROR_EA_LIST_TOO_LONG =256; { MSG%EA_LIST_TOO_LONG }
+ ERROR_NO_META_MATCH =257; { MSG%NO_META_MATCH }
+ ERROR_FINDNOTIFY_TIMEOUT=258; { MSG%FINDNOTIFY_TIMEOUT }
+ ERROR_NO_MORE_ITEMS =259; { MSG%NO_MORE_ITEMS }
+ ERROR_SEARCH_STRUC_REUSED=260; { MSG%SEARCH_STRUC_REUSED }
+ ERROR_CHAR_NOT_FOUND =261; { MSG%CHAR_NOT_FOUND }
+ ERROR_TOO_MUCH_STACK =262; { MSG%TOO_MUCH_STACK }
+ ERROR_INVALID_ATTR =263; { MSG%INVALID_ATTR }
+ ERROR_INVALID_STARTING_RING=264; { MSG%INVALID_STARTING_RING }
+ ERROR_INVALID_DLL_INIT_RING=265; { MSG%INVALID_DLL_INIT_RING }
+ ERROR_CANNOT_COPY =266; { MSG%CANNOT_COPY }
+ ERROR_DIRECTORY =267; { MSG%DIRECTORY }
+ ERROR_OPLOCKED_FILE =268; { MSG%OPLOCKED_FILE }
+ ERROR_OPLOCK_THREAD_EXISTS=269; { MSG%OPLOCK_THREAD_EXISTS }
+ ERROR_VOLUME_CHANGED =270; { MSG%none }
+ ERROR_FINDNOTIFY_HANDLE_IN_USE=271; { MSG%none }
+ ERROR_FINDNOTIFY_HANDLE_CLOSED=272; { MSG%none }
+ ERROR_NOTIFY_OBJECT_REMOVED=273; { MSG%none }
+ ERROR_ALREADY_SHUTDOWN =274; { MSG%none }
+ ERROR_EAS_DIDNT_FIT =275; { MSG%none }
+ ERROR_EA_FILE_CORRUPT =276; { MSG%ERROR_EAS_CORRUPT }
+ ERROR_EA_TABLE_FULL =277; { MSG%EA_TABLE_FULL }
+ ERROR_INVALID_EA_HANDLE =278; { MSG%INVALID_EA_HANDLE }
+ ERROR_NO_CLUSTER =279; { MSG%NO_CLUSTER }
+ ERROR_CREATE_EA_FILE =280; { MSG%ERROR_CREATE_EA_FILE }
+ ERROR_CANNOT_OPEN_EA_FILE=281; { MSG%CANNOT_OPEN_FILE }
+ ERROR_EAS_NOT_SUPPORTED =282; { MSG%EAS_NOT_SUPPORTED }
+ ERROR_NEED_EAS_FOUND =283; { MSG%NEED_EAS_FOUND }
+ ERROR_DUPLICATE_HANDLE =284; { MSG%EAS_DISCARDED }
+ ERROR_DUPLICATE_NAME =285; { MSG%DUPLICATE_SEM_NAME }
+ ERROR_EMPTY_MUXWAIT =286; { MSG%EMPTY_MUXWAIT_SEM }
+ ERROR_MUTEX_OWNED =287; { MSG%MUTEX_SEM_OWNED }
+ ERROR_NOT_OWNER =288; { MSG%NOT_MUTEX_SEM_OWNER }
+ ERROR_PARAM_TOO_SMALL =289; { MSG%QUERY_MUX_PARAM_TOO_SMALL }
+ ERROR_TOO_MANY_HANDLES =290; { MSG%TOO_MANY_SEM_HANDLES }
+ ERROR_TOO_MANY_OPENS =291; { MSG%TOO_MANY_SEM_OPENS }
+ ERROR_WRONG_TYPE =292; { MSG%SEM_WRONG_TYPE }
+ ERROR_UNUSED_CODE =293; { MSG%none }
+ ERROR_THREAD_NOT_TERMINATED=294; { MSG%none }
+ ERROR_INIT_ROUTINE_FAILED=295; { MSG%none }
+ ERROR_MODULE_IN_USE =296; { MSG%none }
+ ERROR_NOT_ENOUGH_WATCHPOINTS=297;{ MSG%none }
+ ERROR_TOO_MANY_POSTS =298; { MSG%TOO_MANY_EVENT_SEM_POSTS }
+ ERROR_ALREADY_POSTED =299; { MSG%EVENT_SEM_ALREADY_POSTED }
+ ERROR_ALREADY_RESET =300; { MSG%EVENT_SEM_ALREADY_RESET }
+ ERROR_SEM_BUSY =301; { MSG%SEM_BUSY }
+
+{ end of set 0;- 302;}
+
+ ERROR_USER_DEFINED_BASE =$FF00;
+
+ ERROR_I24_WRITE_PROTECT =0;
+ ERROR_I24_BAD_UNIT =1;
+ ERROR_I24_NOT_READY =2;
+ ERROR_I24_BAD_COMMAND =3;
+ ERROR_I24_CRC =4;
+ ERROR_I24_BAD_LENGTH =5;
+ ERROR_I24_SEEK =6;
+ ERROR_I24_NOT_DOS_DISK =7;
+ ERROR_I24_SECTOR_NOT_FOUND =8;
+ ERROR_I24_OUT_OF_PAPER =9;
+ ERROR_I24_WRITE_FAULT =10;
+ ERROR_I24_READ_FAULT =11;
+ ERROR_I24_GEN_FAILURE =12;
+ ERROR_I24_DISK_CHANGE =13;
+ ERROR_I24_WRONG_DISK =15;
+ ERROR_I24_UNCERTAIN_MEDIA =16;
+ ERROR_I24_CHAR_CALL_INTERRUPTED =17;
+ ERROR_I24_NO_MONITOR_SUPPORT =18;
+ ERROR_I24_INVALID_PARAMETER =19;
+ ERROR_I24_DEVICE_IN_USE =20;
+ ERROR_I24_QUIET_INIT_FAIL =21;
+
+ ALLOWED_FAIL =$0001;
+ ALLOWED_ABORT =$0002;
+ ALLOWED_RETRY =$0004;
+ ALLOWED_IGNORE =$0008;
+ ALLOWED_ACKNOWLEDGE =$0010;
+ ALLOWED_DISPATCH =$8000;
+ ALLOWED_REGDUMP =$0020;
+ ALLOWED_DETACHED =ALLOWED_DISPATCH;
+ ALLOWED_RESERVED =NOT (ALLOWED_FAIL OR ALLOWED_ABORT OR
+ ALLOWED_RETRY OR ALLOWED_IGNORE OR
+ ALLOWED_ACKNOWLEDGE);
+
+ I24_OPERATION =$01;
+ I24_AREA =$06;
+ I24_CLASS =$80;
+
+{ Values for error CLASS }
+ ERRCLASS_OUTRES =1; { Out of Resource }
+ ERRCLASS_TEMPSIT =2; { Temporary Situation }
+ ERRCLASS_AUTH =3; { Permission problem }
+ ERRCLASS_INTRN =4; { Internal System Error }
+ ERRCLASS_HRDFAIL =5; { Hardware Failure }
+ ERRCLASS_SYSFAIL =6; { System Failure }
+ ERRCLASS_APPERR =7; { Application Error }
+ ERRCLASS_NOTFND =8; { Not Found }
+ ERRCLASS_BADFMT =9; { Bad Format }
+ ERRCLASS_LOCKED =10; { Locked }
+ ERRCLASS_MEDIA =11; { Media Failure }
+ ERRCLASS_ALREADY =12; { Collision with Existing Item }
+ ERRCLASS_UNK =13; { Unknown/other }
+ ERRCLASS_CANT =14;
+ ERRCLASS_TIME =15;
+
+{ Values for error ACTION }
+ ERRACT_RETRY =1; { Retry }
+ ERRACT_DLYRET =2; { Delay Retry, retry after pause }
+ ERRACT_USER =3; { Ask user to regive information }
+ ERRACT_ABORT =4; { abort with clean up }
+ ERRACT_PANIC =5; { abort immediately }
+ ERRACT_IGNORE =6; { ignore }
+ ERRACT_INTRET =7; { Retry after User Intervention }
+
+{ Values for error LOCUS }
+ ERRLOC_UNK =1; { No appropriate value }
+ ERRLOC_DISK =2; { Random Access Mass Storage }
+ ERRLOC_NET =3; { Network }
+ ERRLOC_SERDEV =4; { Serial Device }
+ ERRLOC_MEM =5; { Memory }
+
+{ Abnormal termination codes }
+ TC_NORMAL =0;
+ TC_HARDERR =1;
+ TC_GP_TRAP =2;
+ TC_SIGNAL =3;
+ TC_XCPT =4;
+
+
+ ERROR_INVALID_PROCID =303; { MSG%none }
+ ERROR_INVALID_PDELTA =304; { MSG%none }
+ ERROR_NOT_DESCENDANT =305; { MSG%none }
+ ERROR_NOT_SESSION_MANAGER=306; { MSG%none }
+ ERROR_INVALID_PCLASS =307; { MSG%none }
+ ERROR_INVALID_SCOPE =308; { MSG%none }
+ ERROR_INVALID_THREADID =309; { MSG%none }
+ ERROR_DOSSUB_SHRINK =310; { MSG%none }
+ ERROR_DOSSUB_NOMEM =311; { MSG%none }
+ ERROR_DOSSUB_OVERLAP =312; { MSG%none }
+ ERROR_DOSSUB_BADSIZE =313; { MSG%none }
+ ERROR_DOSSUB_BADFLAG =314; { MSG%none }
+ ERROR_DOSSUB_BADSELECTOR=315; { MSG%none }
+ ERROR_MR_MSG_TOO_LONG =316; { MSG%MR_MSG_TOO_LONG }
+ MGS_MR_MSG_TOO_LONG =316;
+ ERROR_MR_MID_NOT_FOUND =317; { MSG%MR_CANT_FORMAT }
+ ERROR_MR_UN_ACC_MSGF =318; { MSG%MR_NOT_FOUND }
+ ERROR_MR_INV_MSGF_FORMAT=319; { MSG%MR_READ_ERROR }
+ ERROR_MR_INV_IVCOUNT =320; { MSG%MR_IVCOUNT_ERROR }
+ ERROR_MR_UN_PERFORM =321; { MSG%MR_UN_PERFORM }
+ ERROR_TS_WAKEUP =322; { MSG%none }
+ ERROR_TS_SEMHANDLE =323; { MSG%none }
+ ERROR_TS_NOTIMER =324; { MSG%none }
+ ERROR_TS_HANDLE =326; { MSG%none }
+ ERROR_TS_DATETIME =327; { MSG%none }
+ ERROR_SYS_INTERNAL =328; { MSG%none }
+ ERROR_QUE_CURRENT_NAME =329; { MSG%none }
+ ERROR_QUE_PROC_NOT_OWNED=330; { MSG%QUE_PROC_NOT_OWNED }
+ ERROR_QUE_PROC_OWNED =331; { MSG%none }
+ ERROR_QUE_DUPLICATE =332; { MSG%QUE_DUPLICATE }
+ ERROR_QUE_ELEMENT_NOT_EXIST=333; { MSG%QUE_ELEMENT_NOT_EXIST }
+ ERROR_QUE_NO_MEMORY =334; { MSG%QUE_NO_MEMORY }
+ ERROR_QUE_INVALID_NAME =335; { MSG%none }
+ ERROR_QUE_INVALID_PRIORITY=336; { MSG%none }
+ ERROR_QUE_INVALID_HANDLE=337; { MSG%none }
+ ERROR_QUE_LINK_NOT_FOUND=338; { MSG%none }
+ ERROR_QUE_MEMORY_ERROR =339; { MSG%none }
+ ERROR_QUE_PREV_AT_END =340; { MSG%none }
+ ERROR_QUE_PROC_NO_ACCESS=341; { MSG%none }
+ ERROR_QUE_EMPTY =342; { MSG%none }
+ ERROR_QUE_NAME_NOT_EXIST=343; { MSG%none }
+ ERROR_QUE_NOT_INITIALIZED=344; { MSG%none }
+ ERROR_QUE_UNABLE_TO_ACCESS=345; { MSG%none }
+ ERROR_QUE_UNABLE_TO_ADD =346; { MSG%none }
+ ERROR_QUE_UNABLE_TO_INIT=347; { MSG%none }
+ ERROR_VIO_INVALID_MASK =349; { MSG%VIO_INVALID_MASK }
+ ERROR_VIO_PTR =350; { MSG%VIO_PTR }
+ ERROR_VIO_APTR =351; { MSG%none }
+ ERROR_VIO_RPTR =352; { MSG%none }
+ ERROR_VIO_CPTR =353; { MSG%none }
+ ERROR_VIO_LPTR =354; { MSG%none }
+ ERROR_VIO_MODE =355; { MSG%DIS_ERROR }
+ ERROR_VIO_WIDTH =356; { MSG%VIO_WIDTH }
+ ERROR_VIO_ATTR =357; { MSG%none }
+ ERROR_VIO_ROW =358; { MSG%VIO_ROW }
+ ERROR_VIO_COL =359; { MSG%VIO_COL }
+ ERROR_VIO_TOPROW =360; { MSG%none }
+ ERROR_VIO_BOTROW =361; { MSG%none }
+ ERROR_VIO_RIGHTCOL =362; { MSG%none }
+ ERROR_VIO_LEFTCOL =363; { MSG%none }
+ ERROR_SCS_CALL =364; { MSG%none }
+ ERROR_SCS_VALUE =365; { MSG%none }
+ ERROR_VIO_WAIT_FLAG =366; { MSG%VIO_WAIT_FLAG }
+ ERROR_VIO_UNLOCK =367; { MSG%VIO_UNLOCK }
+ ERROR_SGS_NOT_SESSION_MGR=368; { MSG%none }
+ ERROR_SMG_INVALID_SGID =369; { MSG%SMG_INVALID_SESSION_ID }
+ ERROR_SMG_INVALID_SESSION_ID=ERROR_SMG_INVALID_SGID;
+ ERROR_SMG_NOSG =370; { MSG%none }
+ ERROR_SMG_NO_SESSIONS =370; { MSG%none }
+ ERROR_SMG_GRP_NOT_FOUND =371; { MSG%SMG_GRP_NOT_FOUND }
+ ERROR_SMG_SESSION_NOT_FOUND=ERROR_SMG_GRP_NOT_FOUND;
+{ =371%msg%SMG_SESSION_NOT_FOUND }
+ ERROR_SMG_SET_TITLE =372; { MSG%SMG_SET_TITLE }
+ ERROR_KBD_PARAMETER =373; { MSG%KBD_PARAMETER }
+ ERROR_KBD_NO_DEVICE =374; { MSG%none }
+ ERROR_KBD_INVALID_IOWAIT=375; { MSG%KBD_INVALID_IOWAIT }
+ ERROR_KBD_INVALID_LENGTH=376; { MSG%KBD_INVALID_LENGTH }
+ ERROR_KBD_INVALID_ECHO_MASK=377; { MSG%KBD_INVALID_ECHO_MASK }
+{ =377%msg%KBD_INVALID_INPUT_MASK }
+ ERROR_KBD_INVALID_INPUT_MASK=378;{ MSG%none }
+ ERROR_MON_INVALID_PARMS =379; { MSG%MON_INVALID_PARMS }
+ ERROR_MON_INVALID_DEVNAME=380; { MSG%MON_INVALID_DEVNAME }
+ ERROR_MON_INVALID_HANDLE=381; { MSG%MON_INVALID_HANDLE }
+ ERROR_MON_BUFFER_TOO_SMALL=382; { MSG%MON_BUFFER_TOO_SMALL }
+ ERROR_MON_BUFFER_EMPTY =383; { MSG%MON_BUFFER_EMPTY }
+ ERROR_MON_DATA_TOO_LARGE=384; { MSG%MON_DATA_TOO_LARGE }
+ ERROR_MOUSE_NO_DEVICE =385; { MSG%MOUSE_NO_DEVICE }
+ ERROR_MOUSE_INV_HANDLE =386; { MSG%MOUSE_INV_HANDLE }
+ ERROR_MOUSE_INV_PARMS =387; { MSG%MOUSE_CALLER_NOT_SYBSYS }
+ ERROR_MOUSE_CANT_RESET =388; { MSG%none }
+ ERROR_MOUSE_DISPLAY_PARMS=389; { MSG%none }
+ ERROR_MOUSE_INV_MODULE =390; { MSG%none }
+ ERROR_MOUSE_INV_ENTRY_PT=391; { MSG%none }
+ ERROR_MOUSE_INV_MASK =392; { MSG%none }
+ NO_ERROR_MOUSE_NO_DATA =393; { MSG%none }
+ NO_ERROR_MOUSE_PTR_DRAWN=394; { MSG%none }
+ ERROR_INVALID_FREQUENCY =395; { MSG%none }
+ ERROR_NLS_NO_COUNTRY_FILE=396; { MSG%NLS_NO_COUNTRY_FILE }
+{ =396%msg%NO_COUNTRY_SYS }
+ ERROR_NLS_OPEN_FAILED =397; { MSG%NLS_OPEN_FAILED }
+{ =397%msg%OPEN_COUNTRY_SYS }
+ ERROR_NLS_NO_CTRY_CODE =398; { MSG%NLS_NO_CTRY_CODE }
+ ERROR_NO_COUNTRY_OR_CODEPAGE=398;{ MSG%NO_COUNTRY_OR_CODEPAGE }
+ ERROR_NLS_TABLE_TRUNCATED=399; { MSG%NLS_TABLE_TRUNCATED }
+ ERROR_NLS_BAD_TYPE =400; { MSG%NLS_BAD_TYPE }
+ ERROR_NLS_TYPE_NOT_FOUND=401; { MSG%NLS_TYPE_NOT_FOUND }
+{ =401%msg%COUNTRY_NO_TYPE }
+ ERROR_VIO_SMG_ONLY =402; { MSG%SWAPIN_FAILED }
+ ERROR_VIO_INVALID_ASCIIZ=403; { MSG%SEGVALIDATE_FAILURE }
+ ERROR_VIO_DEREGISTER =404; { MSG%VIO_DEREGISTER }
+ ERROR_VIO_NO_POPUP =405; { MSG%VIO_NO_POPUP }
+ ERROR_VIO_EXISTING_POPUP=406; { MSG%VIO_EXISTING_POPUP }
+ ERROR_KBD_SMG_ONLY =407; { MSG%KBD_SMG_ONLY }
+ ERROR_KBD_INVALID_ASCIIZ=408; { MSG%KBD_INVALID_ASCIIZ }
+ ERROR_KBD_INVALID_MASK =409; { MSG%KBD_INVALID_MASK }
+ ERROR_KBD_REGISTER =410; { MSG%KBD_REGISTER }
+ ERROR_KBD_DEREGISTER =411; { MSG%KBD_DEREGISTER }
+ ERROR_MOUSE_SMG_ONLY =412; { MSG%MOUSE_SMG_ONLY }
+ ERROR_MOUSE_INVALID_ASCIIZ=413; { MSG%MOUSE_INVALID_ASCIIZ }
+ ERROR_MOUSE_INVALID_MASK=414; { MSG%MOUSE_INVALID_MASK }
+ ERROR_MOUSE_REGISTER =415; { MSG%MOUSE_REGISTER }
+ ERROR_MOUSE_DEREGISTER =416; { MSG%MOUSE_DEREGISTER }
+ ERROR_SMG_BAD_ACTION =417; { MSG%SMG_BAD_ACTION }
+ ERROR_SMG_INVALID_CALL =418; { MSG%SMG_INVALID_CALL }
+ ERROR_SCS_SG_NOTFOUND =419; { MSG%none }
+ ERROR_SCS_NOT_SHELL =420; { MSG%none }
+ ERROR_VIO_INVALID_PARMS =421; { MSG%VIO_INVALID_PARMS }
+ ERROR_VIO_FUNCTION_OWNED=422; { MSG%VIO_FUNCTION_OWNED }
+ ERROR_VIO_RETURN =423; { MSG%none }
+ ERROR_SCS_INVALID_FUNCTION=424; { MSG%none }
+ ERROR_SCS_NOT_SESSION_MGR=425; { MSG%none }
+ ERROR_VIO_REGISTER =426; { MSG%VIO_REGISTER }
+ ERROR_VIO_NO_MODE_THREAD=427; { MSG%none }
+ ERROR_VIO_NO_SAVE_RESTORE_THD=428;{ MSG%VIO_NO_SAVE_RESTORE_THD }
+ ERROR_VIO_IN_BG =429; { MSG%VIO_IN_BG }
+ ERROR_VIO_ILLEGAL_DURING_POPUP=430; { MSG%VIO_ILLEGAL_DURING_POPUP }
+ ERROR_SMG_NOT_BASESHELL =431; { MSG%SMG_NOT_BASESHELL }
+ ERROR_SMG_BAD_STATUSREQ =432; { MSG%SMG_BAD_STATUSREQ }
+ ERROR_QUE_INVALID_WAIT =433; { MSG%none }
+ ERROR_VIO_LOCK =434; { MSG%VIO_LOCK }
+ ERROR_MOUSE_INVALID_IOWAIT=435; { MSG%MOUSE_INVALID_IOWAIT }
+ ERROR_VIO_INVALID_HANDLE=436; { MSG%VIO_INVALID_HANDLE }
+ ERROR_VIO_ILLEGAL_DURING_LOCK=437; { MSG%none }
+ ERROR_VIO_INVALID_LENGTH=438; { MSG%VIO_INVALID_LENGTH }
+ ERROR_KBD_INVALID_HANDLE=439; { MSG%KBD_INVALID_HANDLE }
+ ERROR_KBD_NO_MORE_HANDLE=440; { MSG%KBD_NO_MORE_HANDLE }
+ ERROR_KBD_CANNOT_CREATE_KCB=441; { MSG%KBD_CANNOT_CREATE_KCB }
+ ERROR_KBD_CODEPAGE_LOAD_INCOMPL=442; { MSG%KBD_CODEPAGE_LOAD_INCOMPL }
+ ERROR_KBD_INVALID_CODEPAGE_ID=443; { MSG%KBD_INVALID_CODEPAGE_ID }
+ ERROR_KBD_NO_CODEPAGE_SUPPORT=444; { MSG%KBD_NO_CODEPAGE_SUPPORT }
+ ERROR_KBD_FOCUS_REQUIRED=445; { MSG%KBD_FOCUS_REQUIRED }
+ ERROR_KBD_FOCUS_ALREADY_ACTIVE=446; { MSG%KBD_FOCUS_ALREADY_ACTIVE }
+ ERROR_KBD_KEYBOARD_BUSY =447; { MSG%KBD_KEYBOARD_BUSY }
+ ERROR_KBD_INVALID_CODEPAGE=448; { MSG%KBD_INVALID_CODEPAGE }
+ ERROR_KBD_UNABLE_TO_FOCUS=449; { MSG%KBD_UNABLE_TO_FOCUS }
+ ERROR_SMG_SESSION_NON_SELECT=450;{ MSG%SMG_SESSION_NON_SELECT }
+ ERROR_SMG_SESSION_NOT_FOREGRND=451; { MSG%SMG_SESSION_NOT_FOREGRND }
+ ERROR_SMG_SESSION_NOT_PARENT=452; { MSG%SMG_SESSION_NOT_PARENT }
+ ERROR_SMG_INVALID_START_MODE=453; { MSG%SMG_INVALID_START_MODE }
+ ERROR_SMG_INVALID_RELATED_OPT=454;{ MSG%SMG_INVALID_RELATED_OPT }
+ ERROR_SMG_INVALID_BOND_OPTION=455; { MSG%SMG_INVALID_BOND_OPTION }
+ ERROR_SMG_INVALID_SELECT_OPT=456;{ MSG%SMG_INVALID_SELECT_OPT }
+ ERROR_SMG_START_IN_BACKGROUND=457;{ MSG%SMG_START_IN_BACKGROUND }
+ ERROR_SMG_INVALID_STOP_OPTION=458;{ MSG%SMG_INVALID_STOP_OPTION }
+ ERROR_SMG_BAD_RESERVE =459; { MSG%SMG_BAD_RESERVE }
+ ERROR_SMG_PROCESS_NOT_PARENT=460;{ MSG%SMG_PROCESS_NOT_PARENT }
+ ERROR_SMG_INVALID_DATA_LENGTH=461; { MSG%SMG_INVALID_DATA_LENGTH }
+ ERROR_SMG_NOT_BOUND =462; { MSG%SMG_NOT_BOUND }
+ ERROR_SMG_RETRY_SUB_ALLOC=463; { MSG%SMG_RETRY_SUB_ALLOC }
+ ERROR_KBD_DETACHED =464; { MSG%KBD_DETACHED }
+ ERROR_VIO_DETACHED =465; { MSG%VIO_DETACHED }
+ ERROR_MOU_DETACHED =466; { MSG%MOU_DETACHED }
+ ERROR_VIO_FONT =467; { MSG%VIO_FONT }
+ ERROR_VIO_USER_FONT =468; { MSG%VIO_USER_FONT }
+ ERROR_VIO_BAD_CP =469; { MSG%VIO_BAD_CP }
+ ERROR_VIO_NO_CP =470; { MSG%none }
+ ERROR_VIO_NA_CP =471; { MSG%VIO_NA_CP }
+ ERROR_INVALID_CODE_PAGE =472; { MSG%none }
+ ERROR_CPLIST_TOO_SMALL =473; { MSG%none }
+ ERROR_CP_NOT_MOVED =474; { MSG%none }
+ ERROR_MODE_SWITCH_INIT =475; { MSG%none }
+ ERROR_CODE_PAGE_NOT_FOUND=476; { MSG%none }
+ ERROR_UNEXPECTED_SLOT_RETURNED=477; { MSG%none }
+ ERROR_SMG_INVALID_TRACE_OPTION=478; { MSG%SMG_INVALID_TRACE_OPTION }
+ ERROR_VIO_INTERNAL_RESOURCE=479; { MSG%none }
+ ERROR_VIO_SHELL_INIT =480; { MSG%VIO_SHELL_INIT }
+ ERROR_SMG_NO_HARD_ERRORS=481; { MSG%SMG_NO_HARD_ERRORS }
+ ERROR_CP_SWITCH_INCOMPLETE=482; { MSG%none }
+ ERROR_VIO_TRANSPARENT_POPUP=483; { MSG%VIO_TRANSPARENT_POPUP }
+ ERROR_CRITSEC_OVERFLOW =484; { MSG%none }
+ ERROR_CRITSEC_UNDERFLOW =485; { MSG%none }
+ ERROR_VIO_BAD_RESERVE =486; { MSG%VIO_BAD_RESERVE }
+ ERROR_INVALID_ADDRESS =487; { MSG%INVALID_ADDRESS }
+ ERROR_ZERO_SELECTORS_REQUESTED=488; { MSG%ZERO_SELECTORS_REQUESTED }
+ ERROR_NOT_ENOUGH_SELECTORS_AVA=489; { MSG%NOT_ENOUGH_SELECTORS_AVA }
+ ERROR_INVALID_SELECTOR =490; { MSG%INVALID_SELECTOR }
+ ERROR_SMG_INVALID_PROGRAM_TYPE=491; { MSG%SMG_INVALID_PROGRAM_TYPE }
+ ERROR_SMG_INVALID_PGM_CONTROL=492; { MSG%SMG_INVALID_PGM_CONTROL }
+ ERROR_SMG_INVALID_INHERIT_OPT=493; { MSG%SMG_INVALID_INHERIT_OPT }
+ ERROR_VIO_EXTENDED_SG =494; { MSG%VIO_EXTENDED_SG }
+ ERROR_VIO_NOT_PRES_MGR_SG=495; { MSG%VIO_NOT_PRES_MGR_SG }
+ ERROR_VIO_SHIELD_OWNED =496; { MSG%VIO_SHIELD_OWNED }
+ ERROR_VIO_NO_MORE_HANDLES=497; { MSG%VIO_NO_MORE_HANDLES }
+ ERROR_VIO_SEE_ERROR_LOG =498; { MSG%none }
+ ERROR_VIO_ASSOCIATED_DC =499; { MSG%none }
+ ERROR_KBD_NO_CONSOLE =500; { MSG%KBD_NO_CONSOLE }
+ ERROR_MOUSE_NO_CONSOLE =501; { MSG%DOS_STOPPED }
+ ERROR_MOUSE_INVALID_HANDLE=502; { MSG%MOUSE_INVALID_HANDLE }
+ ERROR_SMG_INVALID_DEBUG_PARMS=503;{ MSG%SMG_INVALID_DEBUG_PARMS }
+ ERROR_KBD_EXTENDED_SG =504; { MSG%KBD_EXTENDED_SG }
+ ERROR_MOU_EXTENDED_SG =505; { MSG%MOU_EXTENDED_SG }
+ ERROR_SMG_INVALID_ICON_FILE=506; { MSG%none }
+ ERROR_TRC_PID_NON_EXISTENT=507; { MSG%TRC_PID_NON_EXISTENT }
+ ERROR_TRC_COUNT_ACTIVE =508; { MSG%TRC_COUNT_ACTIVE }
+ ERROR_TRC_SUSPENDED_BY_COUNT=509;{ MSG%TRC_SUSPENDED_BY_COUNT }
+ ERROR_TRC_COUNT_INACTIVE=510; { MSG%TRC_COUNT_INACTIVE }
+ ERROR_TRC_COUNT_REACHED =511; { MSG%TRC_COUNT_REACHED }
+ ERROR_NO_MC_TRACE =512; { MSG%NO_MC_TRACE }
+ ERROR_MC_TRACE =513; { MSG%MC_TRACE }
+ ERROR_TRC_COUNT_ZERO =514; { MSG%TRC_COUNT_ZERO }
+ ERROR_SMG_TOO_MANY_DDS =515; { MSG%SMG_TOO_MANY_DDS }
+ ERROR_SMG_INVALID_NOTIFICATION=516; { MSG%SMG_INVALID_NOTIFICATION }
+ ERROR_LF_INVALID_FUNCTION=517; { MSG%LF_INVALID_FUNCTION }
+ ERROR_LF_NOT_AVAIL =518; { MSG%LF_NOT_AVAIL }
+ ERROR_LF_SUSPENDED =519; { MSG%LF_SUSPENDED }
+ ERROR_LF_BUF_TOO_SMALL =520; { MSG%LF_BUF_TOO_SMALL }
+ ERROR_LF_BUFFER_CORRUPTED=521; { MSG%none }
+ ERROR_LF_BUFFER_FULL =521; { MSG%LF_BUF_FULL }
+ ERROR_LF_INVALID_DAEMON =522; { MSG%none }
+ ERROR_LF_INVALID_RECORD =522; { MSG%LF_INVAL_RECORD }
+ ERROR_LF_INVALID_TEMPL =523; { MSG%none }
+ ERROR_LF_INVALID_SERVICE=523; { MSG%LF_INVAL_SERVICE }
+ ERROR_LF_GENERAL_FAILURE=524; { MSG%LF_GENERAL_FAILURE }
+ ERROR_LF_INVALID_ID =525; { MSG%HPFS_DISK_ALREADY_INUSE }
+ ERROR_LF_INVALID_HANDLE =526; { MSG%HPFS_CANNOT_FORMAT_DISK }
+ ERROR_LF_NO_ID_AVAIL =527; { MSG%HPFS_CANNOT_COPY_SYS_DATA }
+ ERROR_LF_TEMPLATE_AREA_FULL=528; { MSG%HPFS_FORMAT_NOT_DONE }
+ ERROR_LF_ID_IN_USE =529; { MSG%HPFS_FMT_NOT_ENOUGH_MEM }
+ ERROR_MOU_NOT_INITIALIZED=530; { MSG%HPFS_SPECIFY_FIXDSK }
+ ERROR_MOUINITREAL_DONE =531; { MSG%HPFS_SPECIFY_ONE_DRIVE }
+ ERROR_DOSSUB_CORRUPTED =532; { MSG%HPFS_UNKNOWN_ERR_NO_FORMAT }
+ ERROR_MOUSE_CALLER_NOT_SUBSYS=533; { MSG%HPFS_SYNTAX_HELP }
+ ERROR_ARITHMETIC_OVERFLOW=534; { MSG%HPFS_DISK_FORMATING }
+ ERROR_TMR_NO_DEVICE =535; { MSG%HPFS_AVAIL_DISK_SPACE }
+ ERROR_TMR_INVALID_TIME =536; { MSG%HPFS_BAD_BLOCKS }
+ ERROR_PVW_INVALID_ENTITY=537; { MSG%HPFS_DISK_SPACE_AVAIL }
+ ERROR_PVW_INVALID_ENTITY_TYPE=538; { MSG%HPFS_SPACE_FORMATTED }
+ ERROR_PVW_INVALID_SPEC =539; { MSG%HPFS_TYPE_CUR_VOLUME_LABEL }
+ ERROR_PVW_INVALID_RANGE_TYPE=540;{ MSG%HPFS_DRIVER_NOT_LOADED }
+ ERROR_PVW_INVALID_COUNTER_BLK=541; { MSG%HPFS_DRIVER_LOADER }
+ ERROR_PVW_INVALID_TEXT_BLK=542; { MSG%HPFS_CACHE_BUF_SPECIFIED }
+ ERROR_PRF_NOT_INITIALIZED=543; { MSG%HPFS_CHKDSK_PARM_ERROR }
+ ERROR_PRF_ALREADY_INITIALIZED=544; { MSG%HPFS_CHKDSK_NOACCESS_DRIVE }
+ ERROR_PRF_NOT_STARTED =545; { MSG%HPFS_UNKNOWN_ERR_NO_CHKDSK }
+ ERROR_PRF_ALREADY_STARTED=546; { MSG%HPFS_CHKDSK_NOT_ENOUGH_MEM }
+ ERROR_PRF_TIMER_OUT_OF_RANGE=547;{ MSG%HPFS_CHKDSK_NOWRITEODATA }
+ ERROR_PRF_TIMER_RESET =548; { MSG%HPFS_CHKDSK_NORECOVER_DATA }
+{ =549%msg%HPFS_CHKDSK_NO_PARM_SPACE }
+{ =550%msg%HPFS_CHKDSK_NORECOGNIZE }
+{ =551%msg%HPFS_CHKDSK_NOROOT_FIND }
+{ =552%msg%HPFS_CHKDSK_NOFIX_FS_ERROR }
+{ =553%msg%HPFS_CHKDSK_CORRECT_FS_ERR }
+{ =554%msg%HPFS_CHKDSK_ORGAN_FIX }
+{ =555%msg%HPFS_CHKDSK_RELOC_BBPDATA }
+{ =556%msg%HPFS_CHKDSK_REM_CORRU_BLOC }
+{ =557%msg%HPFS_CHKDSK_REM_CORRUP_FIL }
+{ =558%msg%HPFS_CHKDSK_FIX_SPACE_ALLO }
+{ =559%msg%HPFS_NOT_FORMATTED_DISK }
+{ =560%msg%HPFS_CHKDSK_COR_ALLOC }
+{ =561%msg%HPFS_CHKDSK_SEARC_UNALLOC }
+{ =562%msg%HPFS_CHKDSK_DET_LOST_DATA }
+{ =563%msg%HPFS_CHKDSK_PERCENT_SEARC }
+{ =564%msg%HPFS_CHKDSK_LOST_DATASEARC }
+{ =565%msg%HPFS_CHKDSK_CRIT_NOREAD }
+{ =566%msg%HPFS_CHKDSK_DISK_INUSE }
+{ =567%msg%HPFS_CHKDSK_RECOVTEMP_RELOC }
+{ =568%msg%HPFS_TOTAL_DISK_SPACE }
+{ =569%msg%HPFS_DIR_KBYTES }
+{ =570%msg%HPFS_FILE_KBYTES }
+{ =571%msg%HPFS_KBYTES_AVAILABLE }
+{ =572%msg%HPFS_CHKDSK_PLACE_REC_FILE }
+{ =573%msg%HPFS_CHKDSK_RECO_DIR_AS }
+{ =574%msg%HPFS_CHKDSK_PLACEED_DATA }
+{ =575%msg%HPFS_CHKDSK_RECOV_EA }
+{ =576%msg%HPFS_CHKDSK_FIND_EA_INTEM }
+{ =577%msg%HPFS_CHKDSK_RELOC_TEMP_EA }
+{ =578%msg%HPFS_CHKDSK_RELOC_AC_LIST }
+{ =579%msg%HPFS_CHKDSK_LIST_NORELOC }
+{ =580%msg%HPFS_CHKDSK_TRUN_EA_LIST }
+{ =581%msg%HPFS_CHKDSK_TRUN_EA_NAME }
+{ =582%msg%HPFS_CHKDSK_TRUN_EA_BBLOCK }
+{ =583%msg%HPFS_CHKDSK_REM_INVALID_EA }
+{ =584%msg%HPFS_CHKDSK_FIX_EA_ALLOC }
+{ =585%msg%HPFS_CHKDSK_FIX_ALACCCTRL }
+{ =586%msg%HPFS_CHKDSK_ACCTR_LIST_BBL }
+{ =587%msg%HPFS_CHKDSK_REM_ACLIST }
+{ =588%msg%HPFS_CHKDSK_FOUND_DATANORL }
+{ =589%msg%HPFS_WRONG_VERSION }
+{ =590%msg%HPFS_CHKDSK_FOUND_DATATEMP }
+{ =591%msg%HPFS_CHKDSK_FIX_TEMPSTATUS }
+{ =592%msg%HPFS_CHKDSK_FIX_NEEDEADATA }
+{ =593%msg%HPFS_RECOVER_PARM_ERROR }
+{ =594%msg%HPFS_RECOV_FILE_NOT_FOUND }
+{ =595%msg%HPFS_RECOV_UNKNOWN_ERROR }
+{ =596%msg%HPFS_RECOV_NOT_ENOUGH_MEM }
+{ =597%msg%HPFS_RECOV_NOWRITE_DATA }
+{ =598%msg%HPFS_RECOV_NOTEMP_CREATE }
+{ =599%msg%HPFS_RECOV_EA_NOREAD }
+{ =600%msg%HPFS_RECOV_FILE_BYTES }
+{ =601%msg%HPFS_RECOV_BAD_BYTES_RECOV }
+{ =602%msg%HPFS_RECOV_FILEBYTES_NOREC }
+{ =603%msg%HPFS_RECOV_DISK_INUSE }
+{ =604%msg%HPFS_RECOV_FILE_NODELETE }
+{ =605%msg%HPFS_RECOV_NOCREATE_NEWFILE }
+{ =606%msg%HPFS_RECOV_SYSTEM_ERROR }
+{ =607%msg%HPFS_SYS_PARM_ERROR }
+{ =608%msg%HPFS_SYS_CANNOT_INSTALL }
+{ =609%msg%HPFS_SYS_DRIVE_NOTFORMATED }
+{ =610%msg%HPFS_SYS_FILE_NOCREATE }
+{ =611%msg%HPFS_SIZE_EXCEED }
+{ =612%msg%HPFS_SYNTAX_ERR }
+{ =613%msg%HPFS_NOTENOUGH_MEM }
+{ =614%msg%HPFS_WANT_MEM }
+{ =615%msg%HPFS_GET_RETURNED }
+{ =616%msg%HPFS_SET_RETURNED }
+{ =617%msg%HPFS_BOTH_RETURNED }
+{ =618%msg%HPFS_STOP_RETURNED }
+{ =619%msg%HPFS_SETPRTYRETURNED }
+{ =620%msg%HPFS_ALCSG_RETURNED }
+{ =621%msg%HPFS_MSEC_SET }
+{ =622%msg%HPFS_OPTIONS }
+{ =623%msg%HPFS_POS_NUM_VALUE }
+{ =624%msg%HPFS_VALUE_TOO_LARGE }
+{ =625%msg%HPFS_LAZY_NOT_VALID }
+{ =626%msg%HPFS_VOLUME_ERROR }
+{ =627%msg%HPFS_VOLUME_DIRTY }
+{ =628%msg%HPFS_NEW_SECTOR }
+{ =629%msg%HPFS_FORMAT_PARM_ERROR }
+{ =630%msg%HPFS_CANNOT_ACCESS_CONFIG }
+{ =631%msg%HPFS_RECOV_FILE }
+{ =632%msg%HPFS_CHKDSK_KBYTES_RESERVE }
+{ =633%msg%HPFS_CHKDSK_KBYTES_IN_EA }
+{ =634%msg%HPFS_BYTEBUF_SET }
+{ =635%msg%HPFS_FORMATTING_COMPLETE }
+{ =636%msg%HPFS_WRONG_VOLUME_LABEL }
+{ =637%msg%HPFS_FMAT_TOO_MANY_DRS }
+{ =638%msg%VDD_UNSUPPORTED_ACCESS }
+ ERROR_VDD_LOCK_USEAGE_DENIED=639;{ KP.COM not supported in DOS }
+ ERROR_TIMEOUT =640; { MSG%none }
+ ERROR_VDM_DOWN =641; { MSG%none }
+ ERROR_VDM_LIMIT =642; { MSG%none }
+ ERROR_VDD_NOT_FOUND =643; { MSG%none }
+ ERROR_INVALID_CALLER =644; { MSG%none }
+ ERROR_PID_MISMATCH =645; { MSG%none }
+ ERROR_INVALID_VDD_HANDLE=646; { MSG%none }
+ ERROR_VLPT_NO_SPOOLER =647; { MSG%none }
+ ERROR_VCOM_DEVICE_BUSY =648; { MSG%none }
+ ERROR_VLPT_DEVICE_BUSY =649; { MSG%none }
+ ERROR_NESTING_TOO_DEEP =650; { MSG%none }
+ ERROR_VDD_MISSING =651; { MSG%VDD_MISSING }
+
+{ INVALID BIDI API PARAMETERS 671;- 684;no msg's required }
+
+ ERROR_BIDI_INVALID_LENGTH =671; { MSG%none }
+ ERROR_BIDI_INVALID_INCREMENT =672; { MSG%none }
+ ERROR_BIDI_INVALID_COMBINATION =673; { MSG%none }
+ ERROR_BIDI_INVALID_RESERVED =674; { MSG%none }
+ ERROR_BIDI_INVALID_EFFECT =675; { MSG%none }
+ ERROR_BIDI_INVALID_CSDREC =676; { MSG%none }
+ ERROR_BIDI_INVALID_CSDSTATE =677; { MSG%none }
+ ERROR_BIDI_INVALID_LEVEL =678; { MSG%none }
+ ERROR_BIDI_INVALID_TYPE_SUPPORT =679; { MSG%none }
+ ERROR_BIDI_INVALID_ORIENTATION =680; { MSG%none }
+ ERROR_BIDI_INVALID_NUM_SHAPE =681; { MSG%none }
+ ERROR_BIDI_INVALID_CSD =682; { MSG%none }
+ ERROR_BIDI_NO_SUPPORT =683; { MSG%none }
+ NO_ERROR_BIDI_RW_INCOMPLETE =684; { MSG%none }
+
+{ =689%msg%HPFS_LAZY_ON }
+{ =690%msg%HPFS_LAZY_OFF }
+ ERROR_IMP_INVALID_PARM =691; { MSG%none }
+ ERROR_IMP_INVALID_LENGTH =692; { MSG%none }
+ MSG_HPFS_DISK_ERROR_WARN =693; { MSG%HPFS_DISK_ERROR_WARN }
+ ERROR_MON_BAD_BUFFER =730; { MSG%BAD_MON_BUFFER }
+
+ ERROR_MODULE_CORRUPTED =731; { MSG%MODULE_CORRUPTED }
+
+ ERROR_SM_OUTOF_SWAPFILE =1477; { MSG%SM_OUT_OF_SWAFILE }
+
+ ERROR_LF_TIMEOUT =2055; { MSG%LF_TIMEOUT }
+ ERROR_LF_SUSPEND_SUCCESS =2057; { MSG%LF_SUSP_SUCCESS }
+ ERROR_LF_RESUME_SUCCESS =2058; { MSG%LF_RESUM_SUCCESS }
+ ERROR_LF_REDIRECT_SUCCESS =2059; { MSG%LF_REDIR_SUCCESS }
+ ERROR_LF_REDIRECT_FAILURE =2060; { MSG%LF_REDIR_FAILURE }
+
+
+ ERROR_SWAPPER_NOT_ACTIVE =32768;
+ ERROR_INVALID_SWAPID =32769;
+ ERROR_IOERR_SWAP_FILE =32770;
+ ERROR_SWAP_TABLE_FULL =32771;
+ ERROR_SWAP_FILE_FULL =32772;
+ ERROR_CANT_INIT_SWAPPER =32773;
+ ERROR_SWAPPER_ALREADY_INIT =32774;
+ ERROR_PMM_INSUFFICIENT_MEMORY =32775;
+ ERROR_PMM_INVALID_FLAGS =32776;
+ ERROR_PMM_INVALID_ADDRESS =32777;
+ ERROR_PMM_LOCK_FAILED =32778;
+ ERROR_PMM_UNLOCK_FAILED =32779;
+ ERROR_PMM_MOVE_INCOMPLETE =32780;
+ ERROR_UCOM_DRIVE_RENAMED =32781;
+ ERROR_UCOM_FILENAME_TRUNCATED =32782;
+ ERROR_UCOM_BUFFER_LENGTH =32783;
+ ERROR_MON_CHAIN_HANDLE =32784;
+ ERROR_MON_NOT_REGISTERED =32785;
+ ERROR_SMG_ALREADY_TOP =32786;
+ ERROR_PMM_ARENA_MODIFIED =32787;
+ ERROR_SMG_PRINTER_OPEN =32788;
+ ERROR_PMM_SET_FLAGS_FAILED =32789;
+ ERROR_INVALID_DOS_DD =32790;
+ ERROR_BLOCKED =32791;
+ ERROR_NOBLOCK =32792;
+ ERROR_INSTANCE_SHARED =32793;
+ ERROR_NO_OBJECT =32794;
+ ERROR_PARTIAL_ATTACH =32795;
+ ERROR_INCACHE =32796;
+ ERROR_SWAP_IO_PROBLEMS =32797;
+ ERROR_CROSSES_OBJECT_BOUNDARY =32798;
+ ERROR_LONGLOCK =32799;
+ ERROR_SHORTLOCK =32800;
+ ERROR_UVIRTLOCK =32801;
+ ERROR_ALIASLOCK =32802;
+ ERROR_ALIAS =32803;
+ ERROR_NO_MORE_HANDLES =32804;
+ ERROR_SCAN_TERMINATED =32805;
+ ERROR_TERMINATOR_NOT_FOUND =32806;
+ ERROR_NOT_DIRECT_CHILD =32807;
+ ERROR_DELAY_FREE =32808;
+ ERROR_GUARDPAGE =32809;
+ ERROR_SWAPERROR =32900;
+ ERROR_LDRERROR =32901;
+ ERROR_NOMEMORY =32902;
+ ERROR_NOACCESS =32903;
+ ERROR_NO_DLL_TERM =32904;
+ ERROR_CPSIO_CODE_PAGE_INVALID =65026;
+ ERROR_CPSIO_NO_SPOOLER =65027;
+ ERROR_CPSIO_FONT_ID_INVALID =65028;
+ ERROR_CPSIO_INTERNAL_ERROR =65033;
+ ERROR_CPSIO_INVALID_PTR_NAME =65034;
+ ERROR_CPSIO_NOT_ACTIVE =65037;
+ ERROR_CPSIO_PID_FULL =65039;
+ ERROR_CPSIO_PID_NOT_FOUND =65040;
+ ERROR_CPSIO_READ_CTL_SEQ =65043;
+ ERROR_CPSIO_READ_FNT_DEF =65045;
+ ERROR_CPSIO_WRITE_ERROR =65047;
+ ERROR_CPSIO_WRITE_FULL_ERROR =65048;
+ ERROR_CPSIO_WRITE_HANDLE_BAD =65049;
+ ERROR_CPSIO_SWIT_LOAD =65074;
+ ERROR_CPSIO_INV_COMMAND =65077;
+ ERROR_CPSIO_NO_FONT_SWIT =65078;
+ ERROR_ENTRY_IS_CALLGATE =65079;
+
+{ Constants from bsememf.h header file (memory management) }
+
+ const
+ PAG_READ = $00000001;
+ PAG_WRITE = $00000002;
+ PAG_EXECUTE = $00000004;
+ PAG_GUARD = $00000008;
+ PAG_COMMIT = $00000010;
+ PAG_DECOMMIT = $00000020;
+ OBJ_TILE = $00000040;
+ OBJ_PROTECTED = $00000080;
+ OBJ_GETTABLE = $00000100;
+ OBJ_GIVEABLE = $00000200;
+ PAG_DEFAULT = $00000400;
+ PAG_SHARED = $00002000;
+ PAG_FREE = $00004000;
+ PAG_BASE = $00010000;
+
+ fPERM = (PAG_EXECUTE or PAG_READ or PAG_WRITE);
+ fSHARE = (OBJ_GETTABLE or OBJ_GIVEABLE);
+ fALLOC = (OBJ_TILE or PAG_COMMIT or fPERM);
+ fALLOCSHR = (OBJ_TILE or PAG_COMMIT or fSHARE or fPERM);
+ fGETNMSHR = (fPERM);
+ fGETSHR = (fPERM);
+ fGIVESHR = (fPERM);
+ fSET = (PAG_COMMIT+PAG_DECOMMIT+PAG_DEFAULT+fPERM);
+
+ DOSSUB_INIT = $01;
+ DOSSUB_GROW = $02;
+ DOSSUB_SPARSE_OBJ = $04;
+ DOSSUB_SERIALIZE = $08;
+
+
+ implementation
+
+Function LOUSHORT(var l): Word;
+Begin
+ LOUSHORT:=Lo(Cardinal(l));
+End;
+
+end.
+{
+ $Log: os2def.pas,v $
+ Revision 1.9 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmbidi.pas b/rtl/os2/pmbidi.pas
new file mode 100644
index 0000000000..d85821c594
--- /dev/null
+++ b/rtl/os2/pmbidi.pas
@@ -0,0 +1,601 @@
+{
+ $Id: pmbidi.pas,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Yuri Prokushev (prokushev@freemail.ru).
+
+ OS/2 Presentation Manager Window Manager - Bidirectional
+ support include file.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Warning: This code is alfa. Future versions
+ of this unit might not be compatible.}
+
+unit pmbidi;
+
+interface
+
+uses os2def, pmwin;
+
+
+{$PACKRECORDS C}
+
+ { }
+ { Bidirectional languages support window messages }
+ { }
+
+ const
+ WM_SETBIDIATTR = $0BD0;
+ WM_QUERYBIDIATTR = $0BD1;
+ WM_SETBIDISTAT = $0BD2;
+ WM_QUERYBIDISTAT = $0BD3;
+ WM_KBDLAYERCHANGED = $0BD4;
+ { }
+ { Language Viewer messages }
+ { }
+ WM_LANGVIEWINFOCHANGED = $0BE0;
+ WM_LANG_OPTIONS_DIALOG = $0BE2;
+ WM_LANGOPTIONSDIALOG = $0BE2;
+ { LVI values - indicating which Bidi information has changed }
+ LVI_WND_BIDI_ATTR = 1;
+ LVI_WND_BIDI_STAT = 2;
+ LVI_FOCUS_CHANGE = 3;
+ LVI_KBD_LAYER = 4;
+ LVI_CSD = 5;
+ LVI_SET_KBD_LAYER = 6;
+ LVI_ALL = -(1);
+ { Possible return values from WM_SETBIDIATTR/WM_SETBIDISTAT }
+ SBI_MSG_NOT_PROCESSED = 0;
+ SBI_MSG_PROCESSED = 1;
+ SBI_MSG_PROCESSED_SELF = 2;
+ { }
+ { Bidirectional attributes masks }
+ { }
+ BDAM_INIT = $80000000;
+ BDAM_LEVEL = $70000000;
+ BDAM_NATIVE = $08000000;
+ BDAM_TEXTTYPE = $01000000;
+ BDAM_TEXT_ORIENTATION = $00030000;
+ BDAM_WND_ORIENTATION = $00100000;
+ BDAM_NUMERALS = $00003000;
+ BDAM_SYM_SWAP = $00000100;
+ BDAM_WORD_BREAK = $00000200;
+ BDAM_TEXT_SHAPE = $000000FF;
+ BDAM_ALL=(BDAM_INIT or
+ BDAM_LEVEL or
+ BDAM_TEXTTYPE or
+ BDAM_NATIVE or
+ BDAM_TEXT_ORIENTATION or
+ BDAM_WND_ORIENTATION or
+ BDAM_NUMERALS or
+ BDAM_SYM_SWAP or
+ BDAM_WORD_BREAK or
+ BDAM_TEXT_SHAPE );
+ { }
+ { Bidirectional attributes values (in Bidi attributes word) }
+ { }
+ { Note: Value of the attributes must match the values in layout.h. }
+ { }
+ BDA_INIT = $80000000;
+ BDA_LEVEL = $30000000;
+ BDA_NATIVE_OFF = $00000000;
+ BDA_NATIVE_ON = $08000000;
+ BDA_TEXTTYPE_VISUAL = $00000000;
+ BDA_TEXTTYPE_IMPLICIT = $01000000;
+ BDA_WND_ORIENT_LTR = $00000000;
+ BDA_WND_ORIENT_RTL = $00100000;
+ BDA_TEXT_ORIENT_LTR = $00000000;
+ BDA_TEXT_ORIENT_RTL = $00010000;
+ BDA_TEXT_ORIENT_DYNAMIC = $00020000;
+ BDA_TEXT_ORIENT_CONTEXT = $00020000;
+ BDA_NUMERALS_NOMINAL = $00000000;
+ BDA_NUMERALS_PASSTHRU = $00001000;
+ BDA_NUMERALS_NATIONAL = $00002000;
+ BDA_NUMERALS_CONTEXTUAL = $00003000;
+ BDA_SYM_SWAP_OFF = $00000000;
+ BDA_SYM_SWAP_ON = $00000100;
+ BDA_WORD_BREAK_OFF = $00000000;
+ BDA_WORD_BREAK_ON = $00000200;
+ BDA_TEXT_DISPLAY_SHAPED = $00000000;
+ BDA_TEXT_SAVE_SHAPED = $00000001;
+ BDA_TEXT_NOMINAL = $00000010;
+ BDA_TEXT_INITIAL = $00000011;
+ BDA_TEXT_MIDDLE = $00000012;
+ BDA_TEXT_FINAL = $00000013;
+ BDA_TEXT_ISOLATED = $00000014;
+ { }
+ { Bidirectional attribute (BIDIATTR) as specified in a window template }
+ { or in the resource script. }
+ { }
+type
+ BIDIPARAM = PRESPARAMS;
+
+const
+ { First BidiAttr PresParam }
+ PP_BDATTR_FIRST = $100;
+ { }
+ { Set ALL Bidi attrs }
+ PP_BDATTR_ALL = $101;
+ { }
+ { Text/Data type }
+ PP_BDATTR_TEXTTYPE = $102;
+ { Text Orientation }
+ PP_BDATTR_TEXT_ORIENTATION = $103;
+ { Window Orientation }
+ PP_BDATTR_WND_ORIENTATION = $104;
+ { Arabic/Hindi Numerals }
+ PP_BDATTR_NUMERALS = $105;
+ { Symetric Swapping }
+ PP_BDATTR_SYM_SWAP = $106;
+ { Word break }
+ PP_BDATTR_WORD_BREAK = $107;
+ { Char Shape Determination }
+ PP_BDATTR_TEXT_SHAPE = $108;
+ { }
+ { Last BidiAttr PresParam }
+ PP_BDATTR_LAST = $108;
+ { }
+ { Bidirectional status flags }
+ PP_BDSTATUS = $110;
+ { }
+ { Values used in Set/Query Bidirectional status word }
+ { }
+ BDS_HKFLAG_ENG_LAYER = $00010000;
+ BDS_HKFLAG_NAT_LAYER = $00020000;
+ BDS_HKFLAG_PUSH = $00040000;
+ BDS_HKFLAG_END_PUSH = $00080000;
+ BDS_HKFLAG_AUTO_PUSH = $00100000;
+ BDS_HKFLAG_FIELD_REV = $00200000;
+ BDS_HKFLAG_SCREEN_REV = $00400000;
+ BDS_HKFLAG_STATUS_INDICATOR = $02000000;
+ BDS_HKFLAG_DISPLAY_SHAPED = $04000000;
+ BDS_HKFLAG_INITIAL = $08000000;
+ BDS_HKFLAG_MIDDLE = $10000000;
+ BDS_HKFLAG_FINAL = $20000000;
+ BDS_HKFLAG_ISOLATED = $40000000;
+ BDS_HKFLAG_SAVE_SHAPED = $80000000;
+ BDS_HKFLAG_ENTRY_SWITCH_UI = $00800000;
+ BDS_FAUTOPUSH_RTL_ON = $00000001;
+ BDS_FAUTOPUSH_LTR_ON = $00000002;
+ BDS_FPUSH_ON = $00000004;
+ BDS_DISABLE_INPUT_PROCESSING = $00000020;
+ { }
+ { Bidirectional status masks }
+ { }
+ BDSM_HKFLAGS = $FE7F0000;
+ BDSM_AUTOPUSH_RTL = $00000001;
+ BDSM_AUTOPUSH_LTR = $00000002;
+ BDSM_PUSH_ON = $00000004;
+ BDSM_DISABLE_INPUT_PROCESSING = $00000020;
+ BDSM_ALL = ( BDSM_HKFLAGS or
+ BDSM_AUTOPUSH_RTL or
+ BDSM_AUTOPUSH_LTR or
+ BDSM_PUSH_ON or
+ BDSM_DISABLE_INPUT_PROCESSING );
+ { }
+ { Functions to Set/Query Bidirectional Langugage Information }
+ { }
+ { Process Bidi attributes }
+ LI_BD_PROCESS_ATTR = $00000010;
+ { Process Bidi attributes }
+ LI_BD_PROCESS_STAT = $00000011;
+ { Window Bidi Attributes }
+ LI_BD_WND_ATTR = $00000020;
+ { Window Bidi Status }
+ LI_BD_WND_STAT = $00000021;
+ { Clipboard Bidi Attributes }
+ LI_BD_CLIP_ATTR = $00000030;
+ { Clipboard Conversion Bidi Attributes }
+ LI_BD_CLIP_CONV_ATTR = $00000031;
+ { Values used in WinSet/QueryLangInfo (in flFlags); }
+ { No message is sent to the }
+ LIF_NO_SENDMSG = $00000001;
+ { window to inform it of the }
+ { change }
+ { Send SetBidiAttr msg to }
+ LIF_CHILD_INHERIT = $00000002;
+ { all child windows. }
+ { Refresh all windows whose }
+ LIF_WND_REFRESH = $00000004;
+ { bidi attributes are set }
+ { directly by the API (and }
+ { not by a sent message. }
+ { }
+ { Flags for WinSetKbdLayer }
+ { }
+ SKLF_SENDMSG = $00000001;
+ { }
+ { Keyboard layers for WinSetKbdLayer }
+ { }
+ KL_LATIN = $00000000;
+ KL_NATIONAL = $00000001;
+ { }
+ { Keyboard layouts for WinSetKbdLayout }
+ { }
+ { VKey }
+ KBDL_VKEY = 1;
+ { Belgium - 120 }
+ KBDL_BE = 2;
+ { Canadian - 058 French }
+ KBDL_CF = 3;
+ { Denmark - 159 }
+ KBDL_DK = 4;
+ { France - 189 }
+ KBDL_FR = 5;
+ { Germany - 129 }
+ KBDL_GR = 6;
+ { Germany - 129 }
+ KBDL_DE = 6;
+ { Italy - 141 }
+ KBDL_IT = 7;
+ { Latin America - 171 }
+ KBDL_LA = 8;
+ { Netherlands - 143 }
+ KBDL_NL = 9;
+ { Norway - 155 }
+ KBDL_NO = 10;
+ { Portugal - 163 }
+ KBDL_PO = 11;
+ { Swiss-French - 150f }
+ KBDL_SF = 12;
+ { Swiss-German - 150d }
+ KBDL_SG = 13;
+ { Spain - 172 }
+ KBDL_ES = 14;
+ { Finland - 153 }
+ KBDL_FI = 15;
+ { Sweden - 153 }
+ KBDL_SV = 16;
+ { United Kingdom - 166 }
+ KBDL_UK = 17;
+ { United States - 103p }
+ KBDL_US = 18;
+ { French - 120 }
+ KBDL_FR120 = 19;
+ { Italian - 142 }
+ KBDL_IT142 = 20;
+ { United Kingdom - 168 }
+ KBDL_UK168W = 21;
+ { Turkey - 179 }
+ KBDL_TR = 22;
+ { Czech - 243 }
+ KBDL_CZ = 23;
+ { Slovakia - 245 }
+ KBDL_SK = 24;
+ { Hungarian - 208 }
+ KBDL_HU = 25;
+ { Croatia - 234 }
+ KBDL_HR = 26;
+ { Poland - 163 }
+ KBDL_PL = 27;
+ { Iceland - 197 }
+ KBDL_IS = 28;
+ { Brazil - 275 }
+ KBDL_BR = 29;
+ { Hebrew - 212 Latin }
+ KBDL_HE_LATIN = 30;
+ { Hebrew - 212 Hebrew }
+ KBDL_HE_NATIONAL = 31;
+ { Arabic - 238 Latin }
+ KBDL_AR_LATIN = 32;
+ { Arabic - 238 Arabic }
+ KBDL_AR_NATIONAL = 33;
+ { Brazil - 274 }
+ KBDL_BR274 = 34;
+ { Greek - 319 Latin }
+ KBDL_GK_LAT319 = 35;
+ { Greek - 319 Greek }
+ KBDL_GK_NAT319 = 36;
+ { Greek - 220 Latin }
+ KBDL_GK_LAT220 = 37;
+ { Greek - 220 Greek }
+ KBDL_GK_NAT220 = 38;
+ { Arabic - 470 Latin }
+ KBDL_AR_LAT470 = 39;
+ { Arabic - 470 Arabic }
+ KBDL_AR_NAT470 = 40;
+ { Turkey - 440 }
+ KBDL_TR440 = 41;
+ { Slovenia - 234 }
+ KBDL_SL = 42;
+ { Romania - 446 }
+ KBDL_RO = 43;
+ { Bulgaria - 442 Cyrillic }
+ KBDL_BG_NATIONAL = 44;
+ { Bulgaria - 442 Latin }
+ KBDL_BG_LATIN = 45;
+ { Macedonia - 449 Cyrillic }
+ KBDL_MK_NATIONAL = 46;
+ { Macedonia - 449 Latin }
+ KBDL_MK_LATIN = 47;
+ { Serbia - 450 Cyrillic }
+ KBDL_SR_NATIONAL = 48;
+ { Serbia - 450 Latin }
+ KBDL_SR_LATIN = 49;
+ { Russia - 441 Cyrillic }
+ KBDL_RU_NATIONAL = 50;
+ { Russia - 441 Latin }
+ KBDL_RU_LATIN = 51;
+ { Poland - 274 Programmer }
+ KBDL_PL274 = 52;
+ { Russia - 443 Cyrillic }
+ KBDL_RU_NAT443 = 53;
+ { Russia - 443 Latin }
+ KBDL_RU_LAT443 = 54;
+ { Bosnia - 234 }
+ KBDL_BA = 55;
+ { Albania - 452 }
+ KBDL_SQ = 56;
+ { International - 103 }
+ KBDL_US_INTER = 57;
+ { Canadian - 445 }
+ KBDL_CA = 58;
+ { Canadian - 501 }
+ KBDL_CA_EXTRA = 59;
+ { German - 453 }
+ KBDL_DE453 = 60;
+ { German - 500 }
+ KBDL_DE_EXTRA = 61;
+ { Iceland - 458 }
+ KBDL_IS458 = 62;
+ { Estonia - 454 }
+ KBDL_EE = 63;
+ { Thai Kbd - Latin for 874 }
+ KBDL_TH_LATIN = 64;
+ { Thai Kbd - Pattachot for 874 }
+ KBDL_TH_PAT = 65;
+ { Thai Kbd }
+ KBDL_TH_PAT_CAP = 66;
+ { Thai Kbd - Kesmanee for 874 }
+ KBDL_TH_KES = 67;
+ { Thai Kbd }
+ KBDL_TH_KES_CAP = 68;
+ { Thai Kbd - Pattachot for 850 }
+ KBDL_TH_COMP_PAT = 69;
+ { Thai Kbd }
+ KBDL_TH_COMP_PAT_CAP = 70;
+ { Thai Kbd - Kesmanee for 850 }
+ KBDL_TH_COMP_KES = 71;
+ { Thai Kbd }
+ KBDL_TH_COMP_KES_CAP = 72;
+ { US Dvorak - }
+ KBDL_US_DV = 73;
+ { US Left - }
+ KBDL_US_LEFT = 74;
+ { US Right - }
+ KBDL_US_RIGHT = 75;
+ { Lithuania - 456 - National }
+ KBDL_LTL = 76;
+ { Lithuania - 456 - Programmer }
+ KBDL_LTP = 77;
+ { Latvia 455 - 455 - National }
+ KBDL_LVL = 78;
+ { Latvia 455 - 455 - Programmer }
+ KBDL_LVP = 79;
+ { Japan Latin }
+ KBDL_JALPHANUMERIC = 80;
+ KBDL_JP = 80;
+ { Japan Katakana }
+ KBDL_JKATAKANA = 81;
+ { Japan Katakana Romanji }
+ KBDL_JKATAKANAROMAN = 82;
+ { Japan Hiragana }
+ KBDL_JHIRAGANA = 83;
+ { Japan Hiragana Romanji }
+ KBDL_JHIRAGANAROMAN = 84;
+ KBDL_JCAPSALPHANUMERIC = 85;
+ { Korean }
+ KBDL_KALPHANUMERIC = 86;
+ KBDL_KR = 86;
+ { Korean national layer }
+ KBDL_KJAMO = 87;
+ { Simplified Chinese }
+ KBDL_SALPHANUMERIC = 88;
+ { Traditional Chinese }
+ KBDL_TALPHANUMERIC = 89;
+ KBDL_TW = 89;
+ { Belarus 463 - 463 - Latin }
+ KBDL_BYL = 90;
+ { Belarus 463 - 463 - Cyrillic }
+ KBDL_BYC = 91;
+ { Ukraine 465 - 465 - Latin }
+ KBDL_UAL = 92;
+ { Ukraine 465 - 465 - Ukraine }
+ KBDL_UAU = 93;
+ { }
+ { Defines for use in WinQueryCpType }
+ { }
+ { Latin 1 }
+ CPTYPE_OTHER = 1;
+ CPTYPE_ARABIC = 2;
+ CPTYPE_BALTIC = 3;
+ CPTYPE_CYRILLIC = 4;
+ CPTYPE_GREEK = 5;
+ CPTYPE_HEBREW = 6;
+ CPTYPE_JAPANESE = 7;
+ CPTYPE_KOREAN = 8;
+ CPTYPE_LATIN2 = 9;
+ CPTYPE_SCHINESE = 10;
+ CPTYPE_TCHINESE = 11;
+ CPTYPE_THAI = 12;
+ CPTYPE_TURKISH = 13;
+ CPTYPE_UNICODE = 14;
+ { was #define dname def_expr }
+ function HMQ_SYSTEM : THMQ;
+
+ { }
+ { PM Bidirectional support - function prototypes. }
+ { }
+
+Function WinSetLangInfo(aHWND: HWND; ulEffect, ulData, flMask, flFlags,
+ ulReserved: Cardinal ): Cardinal; cdecl;
+ external 'pmbidi' index 20;
+
+Function WinQueryLangInfo(ahwnd: HWND; ulEffect, flFlags, ulReserved: Cardinal): Cardinal; cdecl;
+ external 'pmbidi' index 21;
+
+Function WinSetKbdLayer(ahwnd: HWND; idKbdLayer, flFlags: Cardinal): Cardinal; cdecl;
+ external 'pmbidi' index 22;
+
+Function WinQueryKbdLayer(ahwnd: HWND): Cardinal; cdecl;
+ external 'pmbidi' index 23;
+
+Function WinQueryKbdLayout(hwndDesktop: HWND): Cardinal; cdecl;
+ external 'pmbidi' index 23;
+
+//Function WinSetKbdLayout(hwndDesktop: HWND; idKbdLayout: Cardinal): Longbool; cdecl;
+// external '???';
+
+Function WinSetLangViewer(ahab, hwndLangViewer: HAB; Codepage: Cardinal): HWND; cdecl;
+ external 'pmbidi' index 24;
+
+Function WinQueryLangViewer(ahab: HAB; Codepage: Cardinal): HWND; cdecl;
+ external 'pmbidi' index 25;
+
+Function GpiSetBidiAttr(ahps: HPS; BidiAttr: Cardinal): Cardinal; cdecl;
+ external 'pmbidi' index 50;
+
+Function GpiQueryBidiAttr(ahps: HPS): Cardinal; cdecl;
+ external 'pmbidi' index 51;
+
+Function WinQueryCpType(ahmq: HMQ): Cardinal; cdecl;
+ external 'pmbidi' index 60;
+
+ { }
+ { Macros to manipulate Bidi values }
+ { }
+ {
+ Macro to make a BidiAttribute/Status ULONG from several fields
+
+ Example : SET_BD_VALUE(BidiAtts,
+ BDA_TEXT_ORIENT_RTL | BDA_TEXTTYPE_IMPLICIT,
+ BDAM_TEXT_ORIENTATION | BDAM_TEXTTYPE)
+
+ }
+// #define SET_BD_VALUE(BidiValue,NewBidiValue,Mask) \
+// (BidiValue = ((BidiValue & (~(Mask))) | (NewBidiValue & (Mask))))
+
+ {
+ Macro to extract one or more fields from a BidiAttribute/Status ULONG
+
+ Example : Orientation = QUERY_BD_VALUE(BidiAtts,BDAM_TEXT_ORIENTATION)
+
+ }
+// ( ((ULONG)BidiValue) & ((ULONG)Mask) )
+const
+ { }
+ { New CURSOR flags for Left-To-Right and Right-To-Left cursors }
+ { These are in addtion to those in the CURSOR section in PMWIN.H }
+ { }
+ CURSOR_DIR_LTR = $0100;
+ CURSOR_DIR_RTL = $0300;
+ { }
+ { PM Bidi Error codes. }
+ { }
+ PMERR_BIDI_FIRST = $10F0;
+ PMERR_BIDI_TEXT_CONV_FAILED = $10F0;
+ PMERR_BIDI_LAST = $10FF;
+ { }
+ { Bidi virtual key definitions }
+ { }
+ VK_BIDI_FIRST = $E0;
+ VK_START_PUSH = $E0;
+ VK_END_PUSH = $E1;
+ VK_REVERSE_FIELD = $E2;
+ VK_REVERSE_WINDOW = $E3;
+ VK_AUTOPUSH = $E4;
+ VK_STATUS_INDICATOR = $E5;
+ VK_TEXT_DISPLAY_SHAPED = $E6;
+ VK_TEXT_INITIAL = $E7;
+ VK_TEXT_MIDDLE = $E8;
+ VK_TEXT_FINAL = $E9;
+ VK_TEXT_ISOLATED = $EA;
+ VK_TEXT_SAVE_SHAPED = $EB;
+ VK_REQUIRED_SPACE = $EC;
+ VK_LTR_MARKER = $ED;
+ VK_RTL_MARKER = $EE;
+ VK_ENTRY_SWITCH_UI = $EF;
+ VK_LAYER0 = $F0;
+ VK_LAYER1 = $F1;
+ VK_LAYER2 = $F2;
+ VK_LAYER3 = $F3;
+ VK_LATIN_LAYER = VK_LAYER0;
+ VK_NATIONAL_LAYER = VK_LAYER1;
+ VK_BIDI_LAST = $FF;
+ { }
+ { Language-sensitive definition for standard File and Font dialogs. }
+ { }
+ { Use National Language }
+
+ const
+ FNTS_NATIONAL_LANGUAGE = $80000000;
+ { Use National Language }
+ FDS_NATIONAL_LANGUAGE = $80000000;
+ { }
+ { WM_ messages related to bidirectional language support for }
+ { CUATOOLS components. }
+ { }
+ CM_SETITEMBIDIATTR = $0390;
+ CM_SETFIELDBIDIATTR = $0391;
+ CM_QUERYITEMBIDIATTR = $0392;
+ CM_QUERYFIELDBIDIATTR = $0393;
+ BKM_SETSTATUSLINEBIDIATTR = $0394;
+ BKM_QUERYSTATUSLINEBIDIATTR = $0395;
+ BKM_SETTABTEXTBIDIATTR = $0396;
+ BKM_QUERYTABTEXTBIDIATTR = $0397;
+ VM_SETITEMBIDIATTR = $0398;
+ VM_QUERYITEMBIDIATTR = $0399;
+ { bam }
+ { Bidirectional Attributes word }
+ { Bitmask to define which bidi }
+
+ type
+
+ TBD_ATTR_MASK = record
+ ulBdAttr : Cardinal;
+ ulBdMask : Cardinal;
+ end;
+ { attributes are to be used. }
+
+ PBD_ATTR_MASK = ^TBD_ATTR_MASK;
+ { }
+ { BOOKPAGEBIDIINFO structure is pointed to from the BOOKPAGEINFO }
+ { structure (BKM_SETPAGEINFO notebook message) }
+ { }
+ { bkpgbdi }
+ { Major Tab Text BD_ATTR_MASK struct. }
+ { Minor Tab Text BD_ATTR_MASK struct. }
+ { Status Line Text BD_ATTR_MASK struct. }
+
+ TBOOKPAGEBIDIINFO = record
+ bamMajorTab : TBD_ATTR_MASK;
+ bamMinorTab : TBD_ATTR_MASK;
+ bamStatusLine : TBD_ATTR_MASK;
+ end;
+
+ PBOOKPAGEBIDIINFO = ^TBOOKPAGEBIDIINFO;
+
+implementation
+
+ { was #define dname def_expr }
+ function HMQ_SYSTEM : THMQ;
+ begin
+ HMQ_SYSTEM:=THMQ(0);
+ end;
+
+
+end.
+
+{
+$Log: pmbidi.pas,v $
+Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmbitmap.pas b/rtl/os2/pmbitmap.pas
new file mode 100644
index 0000000000..ad7443dc37
--- /dev/null
+++ b/rtl/os2/pmbitmap.pas
@@ -0,0 +1,224 @@
+{****************************************************************************
+
+ $Id: pmbitmap.pas,v 1.5 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2002 by the Free Pascal development team.
+ Copyright (c) 1999-2000 by Ramon Bosque
+
+ Types and constants for bitmap images manipulation
+ plus functions implemented in PMPIC.DLL.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+unit PMBitmap;
+
+interface
+
+{$PACKRECORDS 1}
+
+type TBitmapInfoHeader=record
+ cbFix:cardinal;
+ cx:word;
+ cy:word;
+ cPlanes:word;
+ cBitCount:word;
+ end;
+ PBitmapInfoHeader=^TBitmapInfoHeader;
+ BitmapInfoHeader=TBitmapInfoHeader;
+
+ TRgb=record
+ bBlue,
+ bGreen,
+ bRed:byte;
+ end;
+ PRgb=^TRgb;
+ Rgb=TRgb;
+
+ TBitmapInfo=record
+ cbFix:cardinal;
+ cx:word;
+ cy:word;
+ cPlanes:word;
+ cBitCount:word;
+ aRgbColor:array[0..0] of TRgb;
+ end;
+ PBitmapInfo=^TBitmapInfo;
+ BitmapInfo=TBitmapInfo;
+
+ TBitmapInfoHeader2=record
+ cbFix:cardinal; { Length of structure }
+ cx:cardinal; { Bitmap width in pels }
+ cy:cardinal; { Bitmap height in pels }
+ cPlanes:word; { Number of bit planes }
+ cBitCount:word; { Number of bits per pel within a plane }
+ ulCompression:cardinal; { Compression scheme used
+ to store the bitmap }
+ cbImage:cardinal; { Length of bitmap storage data in bytes }
+ cxResolution:cardinal; { X resolution of target device }
+ cyResolution:cardinal; { Y resolution of target device }
+ cClrUsed:cardinal; { Number of color indices used }
+ cClrImportant:cardinal; { Number of important color indices }
+ usUnits:word; { Units of measure }
+ usReserved:word;
+ usRecording:word; { Recording algorithm }
+ usRendering:word; { Halftoning algorithm }
+ cSize1:cardinal; { Size value 1 }
+ cSize2:cardinal; { Size value 2 }
+ ulColorEncoding:cardinal; { Color encoding }
+ ulIdentifier:cardinal; { Reserved for application use }
+ end;
+ PBitmapInfoHeader2=^TBitmapInfoHeader2;
+ BitmapInfoHeader2=TBitmapInfoHeader2;
+
+ TRgb2=record
+ bBlue,
+ bGreen,
+ bRed,
+ fcOptions:byte; { Reserved, must be zero }
+ end;
+ PRgb2=^TRgb2;
+ Rgb2=TRgb2;
+
+ TBitmapInfo2=record
+ cbFix:cardinal;
+ cx:cardinal;
+ cy:cardinal;
+ cPlanes:word;
+ cBitCount:word;
+ ulCompression:cardinal;
+ cbImage:cardinal;
+ cxResolution:cardinal;
+ cyResolution:cardinal;
+ cClrUsed:cardinal;
+ cClrImportant:cardinal;
+ usUnits:word;
+ usReserved:word;
+ usRecording:word;
+ usRendering:word;
+ cSize1:cardinal;
+ cSize2:cardinal;
+ ulColorEncoding:cardinal;
+ ulIdentifier:cardinal;
+ aRgbColor:array[0..0] of TRgb2;
+ end;
+ PBitmapInfo2=^TBitmapInfo2;
+ BitmapInfo2=TBitmapInfo2;
+
+ TBitmapFileHeader=record
+ usType:word;
+ cbSize:cardinal;
+ xHotspot:integer;
+ yHotspot:integer;
+ offBits:cardinal;
+ bmp:TBitmapInfoHeader;
+ end;
+ PBitmapFileHeader=^TBitmapFileHeader;
+ BitmapFileHeader=TBitmapFileHeader;
+
+ TBitmapArrayFileHeader=record
+ usType:word;
+ cbSize:cardinal;
+ offNext:cardinal;
+ cxDisplay:word;
+ cyDisplay:word;
+ bfh:TBitmapFileHeader;
+ end;
+ PBitmapArrayFileHeader=^TBitmapArrayFileHeader;
+ BitmapArrayFileHeader=TBitmapArrayFileHeader;
+
+ TBitmapFileHeader2=record
+ usType:word;
+ cbSize:cardinal;
+ xHotspot:integer;
+ yHotspot:integer;
+ offBits:cardinal;
+ bmp2:TBitmapInfoHeader2;
+ end;
+ PBitmapFileHeader2=^TBitmapFileHeader2;
+ BitmapFileHeader2=TBitmapFileHeader2;
+
+ TBitmapArrayFileHeader2=record
+ usType:word;
+ cbSize:cardinal;
+ offNext:cardinal;
+ cxDisplay:word;
+ cyDisplay:word;
+ bfh2:TBitmapFileHeader2;
+ end;
+ PBitmapArrayFileHeader2=^TBitmapArrayFileHeader2;
+ BitmapArrayFileHeader2=TBitmapArrayFileHeader2;
+
+{ Constants for compression/decompression command }
+const CBD_COMPRESSION = 1;
+ CBD_DECOMPRESSION = 2;
+ CBD_BITS = 0;
+
+{ Flags for compression/decompression option }
+ CBD_COLOR_CONVERSION =$0000001;
+
+{ Compression scheme in the ulCompression field of the bitmapinfo structure }
+ BCA_UNCOMP = 0;
+ BCA_HUFFMAN1D = 3;
+ BCA_RLE4 = 2;
+ BCA_RLE8 = 1;
+ BCA_RLE24 = 4;
+
+ BRU_METRIC = 0;
+
+ BRA_BOTTOMUP = 0;
+
+ BRH_NOTHALFTONED = 0;
+ BRH_ERRORDIFFUSION = 1;
+ BRH_PANDA = 2;
+ BRH_SUPERCIRCLE = 3;
+
+ BCE_PALETTE = -1;
+ BCE_RGB = 0;
+
+{ Values identifying bitmap types used in usType field
+ of BITMAPFILEHEADER(2) and BITMAPARRAYFILEHEADER(2).
+ (BFT_ => Bitmap File Type) }
+ BFT_ICON = $4349;
+ BFT_BMAP = $4d42;
+ BFT_POINTER = $5450;
+ BFT_COLORICON = $4943;
+ BFT_COLORPOINTER = $5043;
+ BFT_BITMAPARRAY = $4142;
+
+{ type of picture to print }
+const PIP_MF = 1;
+ PIP_PIF = 2;
+
+{ type of conversion required }
+ PIC_PIFTOMET = 0;
+ PIC_SSTOFONT = 2;
+
+function PicPrint (ahab: longint; var pszFilename: PChar; lType: longint;
+ var pszParams: PChar): Longbool; cdecl;
+
+function PicIchg (ahab: longint; var pszFilename1, pszFilename2: PChar;
+ lType: longint): Longbool; cdecl;
+
+
+implementation
+
+function PicPrint (ahab: longint; var pszFilename: PChar; lType: longint;
+ var pszParams: PChar): Longbool; cdecl; external 'PMPIC' index 11;
+
+function PicIchg (ahab: longint; var pszFilename1, pszFilename2: PChar;
+ lType: longint): Longbool; cdecl; external 'PMPIC' index 12;
+
+end.
+{
+ $Log: pmbitmap.pas,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmdev.pas b/rtl/os2/pmdev.pas
new file mode 100644
index 0000000000..8cdd1da3ce
--- /dev/null
+++ b/rtl/os2/pmdev.pas
@@ -0,0 +1,1033 @@
+{
+ $Id: pmdev.pas,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Yuri Prokushev (prokushev@freemail.ru).
+
+ OS/2 Presentation Manager Device Context constants, types and
+ function declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Warning: This code is alfa. Future versions
+ of this unit might not be compatible.}
+
+unit pmdev;
+
+interface
+
+uses
+ os2def;
+
+//General DEV return values
+const
+ DEV_ERROR =0;
+ DEV_OK =1;
+
+//DC type for DevOpenDC
+
+ OD_QUEUED =2;
+ OD_DIRECT =5;
+ OD_INFO =6;
+ OD_METAFILE =7;
+ OD_MEMORY =8;
+ OD_METAFILE_NOQUERY =9;
+
+//codes for DevQueryCaps
+ CAPS_FAMILY =0;
+ CAPS_IO_CAPS =1;
+ CAPS_TECHNOLOGY =2;
+ CAPS_DRIVER_VERSION =3;
+ CAPS_WIDTH =4; //pels
+ CAPS_HEIGHT =5; //pels
+ CAPS_WIDTH_IN_CHARS =6;
+ CAPS_HEIGHT_IN_CHARS =7;
+ CAPS_HORIZONTAL_RESOLUTION =8; //pels per meter
+ CAPS_VERTICAL_RESOLUTION =9; //pels per meter
+ CAPS_CHAR_WIDTH =10; //pels
+ CAPS_CHAR_HEIGHT =11; //pels
+ CAPS_SMALL_CHAR_WIDTH =12; //pels
+ CAPS_SMALL_CHAR_HEIGHT =13; //pels
+ CAPS_COLORS =14;
+ CAPS_COLOR_PLANES =15;
+ CAPS_COLOR_BITCOUNT =16;
+ CAPS_COLOR_TABLE_SUPPORT =17;
+ CAPS_MOUSE_BUTTONS =18;
+ CAPS_FOREGROUND_MIX_SUPPORT =19;
+ CAPS_BACKGROUND_MIX_SUPPORT =20;
+ CAPS_DEVICE_WINDOWING =31;
+ CAPS_ADDITIONAL_GRAPHICS =32;
+ CAPS_VIO_LOADABLE_FONTS =21;
+ CAPS_WINDOW_BYTE_ALIGNMENT =22;
+ CAPS_BITMAP_FORMATS =23;
+ CAPS_RASTER_CAPS =24;
+ CAPS_MARKER_HEIGHT =25; //pels
+ CAPS_MARKER_WIDTH =26; //pels
+ CAPS_DEVICE_FONTS =27;
+ CAPS_GRAPHICS_SUBSET =28;
+ CAPS_GRAPHICS_VERSION =29;
+ CAPS_GRAPHICS_VECTOR_SUBSET =30;
+ CAPS_PHYS_COLORS =33;
+ CAPS_COLOR_INDEX =34;
+ CAPS_GRAPHICS_CHAR_WIDTH =35;
+ CAPS_GRAPHICS_CHAR_HEIGHT =36;
+ CAPS_HORIZONTAL_FONT_RES =37;
+ CAPS_VERTICAL_FONT_RES =38;
+ CAPS_DEVICE_FONT_SIM =39;
+ CAPS_LINEWIDTH_THICK =40;
+ CAPS_DEVICE_POLYSET_POINTS =41;
+
+//Constants for CAPS_IO_CAPS
+ CAPS_IO_DUMMY =1;
+ CAPS_IO_SUPPORTS_OP =2;
+ CAPS_IO_SUPPORTS_IP =3;
+ CAPS_IO_SUPPORTS_IO =4;
+
+//Constants for CAPS_TECHNOLOGY
+ CAPS_TECH_UNKNOWN =0;
+ CAPS_TECH_VECTOR_PLOTTER =1;
+ CAPS_TECH_RASTER_DISPLAY =2;
+ CAPS_TECH_RASTER_PRINTER =3;
+ CAPS_TECH_RASTER_CAMERA =4;
+ CAPS_TECH_POSTSCRIPT =5;
+
+//Constants for CAPS_COLOR_TABLE_SUPPORT
+ CAPS_COLTABL_RGB_8 =1;
+ CAPS_COLTABL_RGB_8_PLUS =2;
+ CAPS_COLTABL_TRUE_MIX =4;
+ CAPS_COLTABL_REALIZE =8;
+
+//Constants for CAPS_FOREGROUND_MIX_SUPPORT
+ CAPS_FM_OR =1;
+ CAPS_FM_OVERPAINT =2;
+ CAPS_FM_XOR =8;
+ CAPS_FM_LEAVEALONE =16;
+ CAPS_FM_AND =32;
+ CAPS_FM_GENERAL_BOOLEAN =64;
+
+//Constants for CAPS_BACKGROUND_MIX_SUPPORT
+ CAPS_BM_OR =1;
+ CAPS_BM_OVERPAINT =2;
+ CAPS_BM_XOR =8;
+ CAPS_BM_LEAVEALONE =16;
+ CAPS_BM_AND =32;
+ CAPS_BM_GENERAL_BOOLEAN =64;
+ CAPS_BM_SRCTRANSPARENT =128;
+ CAPS_BM_DESTTRANSPARENT =256;
+
+//Constants for CAPS_DEVICE_WINDOWING
+ CAPS_DEV_WINDOWING_SUPPORT =1;
+
+//Constants for CAPS_ADDITIONAL_GRAPHICS
+ CAPS_VDD_DDB_TRANSFER =1;
+ CAPS_GRAPHICS_KERNING_SUPPORT =2;
+ CAPS_FONT_OUTLINE_DEFAULT =4;
+ CAPS_FONT_IMAGE_DEFAULT =8;
+//bits represented by values 16L and 32L are reserved
+ CAPS_SCALED_DEFAULT_MARKERS =64;
+ CAPS_COLOR_CURSOR_SUPPORT =128;
+ CAPS_PALETTE_MANAGER =256;
+ CAPS_COSMETIC_WIDELINE_SUPPORT =512;
+ CAPS_DIRECT_FILL =1024;
+ CAPS_REBUILD_FILLS =2048;
+ CAPS_CLIP_FILLS =$00001000; //4096L
+ CAPS_ENHANCED_FONTMETRICS =$00002000; //8192L
+ CAPS_TRANSFORM_SUPPORT =$00004000; //16384L
+
+//Constants for CAPS_WINDOW_BYTE_ALIGNMENT
+ CAPS_BYTE_ALIGN_REQUIRED =0;
+ CAPS_BYTE_ALIGN_RECOMMENDED =1;
+ CAPS_BYTE_ALIGN_NOT_REQUIRED =2;
+
+//Constants for CAPS_RASTER_CAPS
+ CAPS_RASTER_BITBLT =1;
+ CAPS_RASTER_BANDING =2;
+ CAPS_RASTER_BITBLT_SCALING =4;
+ CAPS_RASTER_SET_PEL =16;
+ CAPS_RASTER_FONTS =32;
+ CAPS_RASTER_FLOOD_FILL =64;
+
+//structures for DEVESC_QUERYVIOCELLSIZES
+
+type
+ PVioSizeCount=^VioSizeCount;
+ VioSizeCount=record
+ maxcount: Longint;
+ count: Longint;
+ end;
+
+ PVioFontCellSize=^VioFontCellSize;
+ VioFontCellSize=record
+ cx: Longint;
+ cy: Longint;
+ end;
+
+//structure for DEVESC_GETSCALINGFACTOR
+ PSFactors=^SFactors;
+ SFactors=record
+ x: Longint;
+ y: Longint;
+ end;
+
+//structure for DEVESC_NEXTBAND
+ PBandRect=^BandRect;
+ BandRect=record
+ xleft: Longint;
+ ybottom: Longint;
+ xright: Longint;
+ ytop: Longint;
+ end;
+
+//return codes for DevEscape
+const
+ DEVESC_ERROR =-1;
+ DEVESC_NOTIMPLEMENTED =0;
+
+//codes for DevEscape
+ DEVESC_QUERYESCSUPPORT = 0;
+ DEVESC_GETSCALINGFACTOR = 1;
+ DEVESC_QUERYVIOCELLSIZES = 2;
+ DEVESC_GETCP =8000;
+
+ DEVESC_STARTDOC =8150;
+ DEVESC_ENDDOC =8151;
+ DEVESC_NEXTBAND =8152;
+ DEVESC_ABORTDOC =8153;
+
+ DEVESC_NEWFRAME =16300;
+ DEVESC_DRAFTMODE =16301;
+ DEVESC_FLUSHOUTPUT =16302;
+ DEVESC_RAWDATA =16303;
+ DEVESC_SETMODE =16304;
+
+ DEVESC_DBE_FIRST =24450;
+ DEVESC_DBE_LAST =24455;
+
+//DevEscape codes for adding extra space to character strings
+ DEVESC_CHAR_EXTRA =16998;
+ DEVESC_BREAK_EXTRA =16999;
+
+//codes for DevEscape PM_Q_ESC spool files
+ DEVESC_STD_JOURNAL =32600;
+
+//structure for DEVESC_SETMODE
+type
+ PEscMode=^EscMode;
+ EscMode=record
+ mode: cardinal;
+ modedata: byte;
+ end;
+
+//return codes for DevPostDeviceModes
+const
+ DPDM_ERROR =-1;
+ DPDM_NONE =0;
+
+//codes for DevPostDeviceModes
+ DPDM_POSTJOBPROP =0;
+ DPDM_CHANGEPROP =1;
+ DPDM_QUERYJOBPROP =2;
+
+//string types for DevQueryDeviceNames
+type
+ Str16= string [15];
+ Str32= string [31];
+ Str64= string [63];
+
+//return code for DevQueryHardcopyCaps
+const
+ DQHC_ERROR =-1;
+
+//codes for DevQueryHardcopyCaps
+const
+ HCAPS_CURRENT =1;
+ HCAPS_SELECTABLE =2;
+
+//structure for DevQueryHardcopyCaps
+type
+ PHCInfo=^HCInfo;
+ HCInfo=record
+ szFormname: Str32;
+ cx: Longint;
+ cy: Longint;
+ xLeftClip: Longint;
+ yBottomClip: Longint;
+ xRightClip: Longint;
+ yTopClip: Longint;
+ xPels: Longint;
+ yPels: Longint;
+ flAttributes: Longint;
+ end;
+
+ { -----------------------------------------------------------------
+ Tuple Item used for QUERYSIZE
+ }
+ { djpQRT }
+ { I - Property }
+ { I - type (DJP_ALL or DJP_CURRENT) }
+ { }
+
+ type
+
+ TdjpQueryTuple = record
+ ulProperty : Cardinal;
+ lType : Longint;
+ end;
+ TQUERYTUPLE = TdjpQueryTuple;
+ TPQUERYTUPLE = ^TdjpQueryTuple;
+ { -----------------------------------------------------------------
+ Query Size Structure for DEVESC_QUERYSIZE
+ }
+ { djpQRS }
+ { I - Size of entire structure }
+ { O - Size returned; }
+ { I - Start of tuple list }
+ { use DJP_NONE for end of list }
+
+ TdjpQuerySize = record
+ cb : Cardinal;
+ ulSizeNeeded : Cardinal;
+ aTuples : array[0..0] of TQUERYTUPLE;
+ end;
+ TQUERYSIZE = TdjpQuerySize;
+ TPQUERYSIZE = ^TdjpQuerySize;
+ { was #define dname def_expr }
+// function QUERYSIZE_HEADER_SIZE : longint;
+ { return type might be wrong }
+
+ { -----------------------------------------------------------------
+ Dynamic Job Property Item
+ }
+ { djpITM }
+ { I/O - sizeof DJP_ITEM structure }
+ { I - Which property }
+ { I/O - DJP_ALL or DJP_CURRENT. }
+ { DJP_ERROR_XXX if error. }
+ { O - How many elements have been }
+ { returned }
+ { O - Variably sized based on }
+ { ulProperty. The smallest }
+ { is a ULONG in size }
+
+ type
+
+ TdjpItem = record
+ cb : Cardinal;
+ ulProperty : Cardinal;
+ lType : Longint;
+ ulNumReturned : Cardinal;
+ ulValue : Cardinal;
+ end;
+ TDJP_ITEM = TdjpItem;
+ TPDJP_ITEM = ^TdjpItem;
+ { was #define dname def_expr }
+// function DJP_HEADER_SIZE : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+// function DJP_NEXT_STRUCTP(p : longint) : TPDJP_ITEM;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+// function DJP_ELEMENTP(s,t : longint) : ^Tt;
+
+(* error
+ #define DJP_SET_ELEMENT(s,t,e) ( *DJP_ELEMENTP (s,t) = (e))
+in define line 83 *)
+ { -----------------------------------------------------------------
+ Types of Dynamic Job Properties
+
+ To see if the driver is enabled use,
+ DevEscape (DEVESC_QUERYESCSUPPORT,
+ DEVESC_STARTDOC_WPROP, ...)
+ and DevQueryDevice (DEVQRY_QUERYSUPPORT,
+ DEVESC_QUERYJOBPROPERTIES, ...)
+
+ NOTE: The C/S in the defines indicate the complexity or size of
+ the information. If it is s, then the size is ULONG sized
+ and no special processing for the next element needs to be
+ done.
+ The J/P in the defines indicate the class. J stands for job
+ properties and P stands for printer properties.
+ }
+ { also End Of List marker }
+
+ const
+ DJP_NONE = 0;
+ DJP_SJ_ORIENTATION = 1;
+ DJP_CJ_RESOLUTION = 2;
+ DJP_SJ_BITSPERPEL = 3;
+ DJP_SJ_COLOR = 4;
+ DJP_SJ_PRINTQUALITY = 5;
+ DJP_SJ_PAPERSIZE = 6;
+ DJP_SJ_TRAYTYPE = 7;
+ DJP_SJ_MEDIA = 8;
+ DJP_SJ_MEDIA_COLOR = 9;
+ DJP_CJ_FORM = 10;
+ DJP_CJ_MIXEDFORMS = 11;
+ DJP_SJ_FONTDOWNLOADING = 12;
+ DJP_SJ_DUPLEX = 13;
+ DJP_SJ_COLLATE = 14;
+ DJP_SJ_FEED = 15;
+ DJP_SJ_COPIES = 16;
+ DJP_SJ_SCALING = 17;
+ DJP_SJ_FORMFEEDCONTROL = 18;
+ DJP_SJ_N_UP = 19;
+ DJP_CJ_OUTPUTBIN = 20;
+ DJP_CJ_TRAYNAME = 21;
+ { Types for DEVESC_QUERYJOBPROPERTIES / DEVESC_SETJOBPROPERTIES
+ }
+ { enumerate the property }
+ DJP_ALL = 1;
+ { from job properties }
+ DJP_CURRENT = 2;
+ { Errors for DEVESC_QUERYJOBPROPERTIES / DEVESC_SETJOBPROPERTIES
+ }
+ { driver doesnt support that property }
+ DJP_ERROR_NOT_SUPPORTED = -(1);
+ { not in the valid range }
+ DJP_ERROR_OUT_OF_RANGE = -(2);
+ { not enumerateable }
+ DJP_ERROR_NOT_ENUM = -(3);
+ { field not proper value }
+ DJP_ERROR_INV_PARMS = -(4);
+ { -----------------------------------------------------------------
+ DJP_SJ_ORIENTATION
+ }
+ DJP_ORI_PORTRAIT = 1;
+ DJP_ORI_LANDSCAPE = 2;
+ DJP_ORI_REV_PORTRAIT = 3;
+ DJP_ORI_REV_LANDSCAPE = 4;
+
+ type
+
+ TDJPT_ORIENTATION = Cardinal;
+
+ TPDJPT_ORIENTATION = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_CJ_RESOLUTION
+ }
+ { djpRES }
+ { X resolution (in dots per inch) }
+ { Y resolution (in dots per inch) }
+
+ TdjpResolution = record
+ usXResolution : Word;
+ usYResolution : Word;
+ end;
+ TDJPT_RESOLUTION = TdjpResolution;
+ TPDJPT_RESOLUTION = ^TdjpResolution;
+ { -----------------------------------------------------------------
+ DJP_SJ_BITSPERPEL
+ }
+
+ TDJPT_BITSPERPEL = Cardinal;
+
+ TPDJPT_BITSPERPEL = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_COLOR
+ }
+
+ const
+ DJP_CLR_MONOCHROME = 1;
+ DJP_CLR_COLOR = 2;
+
+ type
+
+ TDJPT_COLOR = Cardinal;
+
+ TPDJPT_COLOR = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_PRINTQUALITY
+
+ Note: DJP_PQL_DRAFT is the worst quality. In the future, there
+ may be better qualities (such as DJP_PQL_ULTRA_HIGH) which
+ will be numerically greater than DJP_PQL_HIGH.
+ }
+
+ const
+ DJP_PQL_DRAFT = 1;
+ DJP_PQL_LOW = 2;
+ DJP_PQL_MEDIUM = 3;
+ DJP_PQL_HIGH = 4;
+ DJP_PQL_LAST = DJP_PQL_HIGH;
+
+ type
+
+ TDJPT_PRINTQUALITY = Cardinal;
+
+ TPDJPT_PRINTQUALITY = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_PAPERSIZE
+
+ Note: it is recommended to use DJP_CJ_FORM to chage the papersize.
+ approximate size
+ }
+ { inches millimeters }
+
+ const
+ DJP_PSI_NONE = 0;
+ { 8.5 x 11 216 x 279 }
+ DJP_PSI_LETTER = 1;
+ { 8.5 x 14 216 x 356 }
+ DJP_PSI_LEGAL = 2;
+ { 13.58 x 11 345 x 279 }
+ DJP_PSI_WIDE = 3;
+ { 17 x 22 431 x 558 }
+ DJP_PSI_CSHEET = 4;
+ { 22 x 34 558 x 863 }
+ DJP_PSI_DSHEET = 5;
+ { 34 x 44 863 x 1117 }
+ DJP_PSI_ESHEET = 6;
+ { }
+ DJP_PSI_LETTERSMALL = 7;
+ { 11 x 17 279 x 431 }
+ DJP_PSI_TABLOID = 8;
+ { 17 x 11 431 x 279 }
+ DJP_PSI_LEDGER = 9;
+ { 5.5 x 8.5 139 x 216 }
+ DJP_PSI_STATEMENT = 10;
+ { 7.25 x 10.5 184 x 266 }
+ DJP_PSI_EXECUTIVE = 11;
+ { 33.11 x 46.81 841 x 1189 }
+ DJP_PSI_A0 = 12;
+ { 23.39 x 33.11 594 x 841 }
+ DJP_PSI_A1 = 13;
+ { 16.54 x 23.39 420 x 594 }
+ DJP_PSI_A2 = 14;
+ { 11.7 x 16.54 297 x 420 }
+ DJP_PSI_A3 = 15;
+ { 8.3 x 11.7 210 x 297 }
+ DJP_PSI_A4 = 16;
+ { }
+ DJP_PSI_A4_SMALL = 17;
+ { 5.83 x 8.27 148 x 210 }
+ DJP_PSI_A5 = 18;
+ { 9.84 x 13.94 250 x 354 }
+ DJP_PSI_B4 = 19;
+ { 7.17 x 10.12 182 x 257 }
+ DJP_PSI_B5 = 20;
+ { 8.5 x 13 216 x 330 }
+ DJP_PSI_FOLIO = 21;
+ { 8.46 x 10.83 215 x 275 }
+ DJP_PSI_QUATRO = 22;
+ { 10 x 14 254 x 355 }
+ DJP_PSI_10X14 = 23;
+ { 11 x 17 279 x 431 }
+ DJP_PSI_11X17 = 24;
+ { }
+ DJP_PSI_NOTE = 25;
+ { }
+ DJP_PSI_ENV_9 = 26;
+ { }
+ DJP_PSI_ENV_10 = 27;
+ { }
+ DJP_PSI_ENV_11 = 28;
+ { }
+ DJP_PSI_ENV_12 = 29;
+ { }
+ DJP_PSI_ENV_14 = 30;
+ { }
+ DJP_PSI_ENV_DL = 31;
+ { }
+ DJP_PSI_ENV_A2 = 32;
+ { }
+ DJP_PSI_ENV_C3 = 33;
+ { }
+ DJP_PSI_ENV_C4 = 34;
+ { }
+ DJP_PSI_ENV_C5 = 35;
+ { }
+ DJP_PSI_ENV_C6 = 36;
+ { }
+ DJP_PSI_ENV_C65 = 37;
+ { }
+ DJP_PSI_ENV_C9 = 38;
+ { }
+ DJP_PSI_ENV_C10 = 39;
+ { }
+ DJP_PSI_ENV_B4 = 40;
+ { }
+ DJP_PSI_ENV_B5 = 41;
+ { }
+ DJP_PSI_ENV_B6 = 42;
+ { }
+ DJP_PSI_ENV_ITALY = 43;
+ { }
+ DJP_PSI_ENV_MONARCH = 44;
+ { }
+ DJP_PSI_ENV_PERSONAL = 45;
+ { }
+ DJP_PSI_FANFOLD_US = 46;
+ { }
+ DJP_PSI_FANFOLD_STD_GERMAN = 47;
+ { }
+ DJP_PSI_FANFOLD_LGL_GERMAN = 48;
+ { }
+ DJP_PSI_ARCHITECT_BSHEET = 49;
+ { }
+ DJP_PSI_ARCHITECT_CSHEET = 50;
+ { }
+ DJP_PSI_ARCHITECT_DSHEET = 51;
+ { }
+ DJP_PSI_ARCHITECT_ESHEET = 52;
+ { }
+ DJP_PSI_CARD_A6 = 53;
+ { }
+ DJP_PSI_CARD_4X6 = 54;
+ { }
+ DJP_PSI_CARD_5X8 = 55;
+ { }
+ DJP_PSI_CARD_HAGAKI = 56;
+ { 1.10 x 3.50 28 x 89 }
+ DJP_PSI_LABEL_STANDARD = 57;
+ { 3.98 x 2.13 101 x 54 }
+ DJP_PSI_LABEL_SHIPPING = 58;
+ { 2.76 x 2.13 70 x 54 }
+ DJP_PSI_LABEL_DISK = 59;
+ { 3.50 x 1.42 89 x 36 }
+ DJP_PSI_LABEL_EURO = 60;
+ { }
+ DJP_PSI_CARD_OUFUKU_HAGAKI = 61;
+ { }
+ DJP_PSI_B0 = 62;
+ { }
+ DJP_PSI_B1 = 63;
+ { }
+ DJP_PSI_B2 = 64;
+ { }
+ DJP_PSI_B3 = 65;
+ { }
+ DJP_PSI_B6 = 66;
+ { }
+ DJP_PSI_B7 = 67;
+ { }
+ DJP_PSI_B8 = 68;
+ { }
+ DJP_PSI_B9 = 69;
+ { }
+ DJP_PSI_B10 = 70;
+ { }
+ DJP_PSI_B0_JIS = 71;
+ { }
+ DJP_PSI_B1_JIS = 72;
+ { }
+ DJP_PSI_B2_JIS = 73;
+ { }
+ DJP_PSI_B3_JIS = 74;
+ { }
+ DJP_PSI_B4_JIS = 75;
+ { }
+ DJP_PSI_B5_JIS = 76;
+ { }
+ DJP_PSI_B6_JIS = 77;
+ { }
+ DJP_PSI_B7_JIS = 78;
+ { }
+ DJP_PSI_B8_JIS = 79;
+ { }
+ DJP_PSI_B9_JIS = 80;
+ { }
+ DJP_PSI_B10_JIS = 81;
+ DJP_PSI_LAST = DJP_PSI_B10_JIS;
+
+ type
+
+ TDJPT_PAPERSIZE = Longint;
+
+ TPDJPT_PAPERSIZE = Longint;
+ { -----------------------------------------------------------------
+ DJP_SJ_TRAYTYPE
+
+ Note: it is recommended to use DJP_CJ_FORM to chage the tray type.
+ }
+
+ const
+ DJP_TRY_NONE = 0;
+ DJP_TRY_UPPER = 1;
+ DJP_TRY_ONLYONE = DJP_TRY_UPPER;
+ DJP_TRY_LOWER = 2;
+ DJP_TRY_MIDDLE = 3;
+ DJP_TRY_MANUAL = 4;
+ DJP_TRY_ENVELOPE = 5;
+ DJP_TRY_ENVMANUAL = 6;
+ DJP_TRY_AUTO = 7;
+ DJP_TRY_TRACTOR = 8;
+ DJP_TRY_SMALLFMT = 9;
+ DJP_TRY_LARGEFMT = 10;
+ DJP_TRY_LARGECAPACITY = 11;
+ DJP_TRY_CASSETTE = 12;
+ DJP_TRY_LAST = DJP_TRY_CASSETTE;
+
+ type
+
+ TDJPT_TRAYTYPE = Cardinal;
+
+ TPDJPT_TRAYTYPE = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_MEDIA
+
+ Note: it is recommended to use DJP_CJ_FORM to chage the media type.
+ }
+
+ const
+ DJP_MED_NONE = 0;
+ DJP_MED_PLAIN = 1;
+ DJP_MED_TRANSPARENCY = 2;
+ DJP_MED_GLOSSY = 3;
+ DJP_MED_SPECIAL = 4;
+ DJP_MED_COATED = 5;
+ DJP_MED_BACKPRINT = 6;
+ DJP_MED_CLOTH = 7;
+ DJP_MED_THICK = 8;
+ DJP_MED_STATIONARY = 9;
+ DJP_MED_ENVELOPE = 10;
+ DJP_MED_CONTINUOUS_LONG = 11;
+ DJP_MED_CONTINUOUS_SHORT = 12;
+ DJP_MED_TAB_STOCK = 13;
+ DJP_MED_MULTI_PART_FORM = 14;
+ DJP_MED_LABELS = 15;
+ DJP_MED_LAST = DJP_MED_LABELS;
+
+ type
+
+ TDJPT_MEDIA = Cardinal;
+
+ TPDJPT_MEDIA = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_MEDIA_COLOR
+
+ Select the media color (for the same media types).
+ }
+
+ const
+ DJP_MDC_BLUE = 1;
+ DJP_MDC_BLUFF = 2;
+ DJP_MDC_GOLDENROD = 3;
+ DJP_MDC_GREEN = 4;
+ DJP_MDC_PINK = 5;
+ DJP_MDC_TRANSPARENT = 6;
+ DJP_MDC_WHITE = 7;
+ DJP_MDC_YELLOW = 8;
+ DJP_MDC_LAST = DJP_MDC_YELLOW;
+
+ type
+
+ TDJPT_MEDIA_COLOR = Cardinal;
+
+ TPDJPT_MEDIA_COLOR = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_CJ_FORM
+
+ Setting will match all three fields. If szTrayname or szMedianame
+ is null then it will be defaulted to the first one found.
+
+ Querying will return all fields filled in.
+ }
+ { djpFRM }
+ { System Form name }
+ { System Tray name }
+ { System Media name }
+ { v-= Informational only =-v }
+ { Corresponding hard copy info }
+ { Display Form name (translated) }
+ { Display Tray name (translated) }
+ { Display Media name (translated) }
+ { Simple form id (if not DJP_NONE) }
+ { Simple tray id (if not DJP_NONE) }
+ { Simple media id (if not DJP_NONE) }
+
+ TdjpForm = record
+ szFormname : Str32;
+ szTrayname : Str32;
+ szMedianame : Str32;
+ ahcInfo : HCINFO;
+ szDisplayFormname : Str64;
+ szDisplayTrayname : Str64;
+ szDisplayMedianame : Str64;
+ djppsFormID : TDJPT_PAPERSIZE;
+ djpttTrayID : TDJPT_TRAYTYPE;
+ djpmdMediaID : TDJPT_MEDIA;
+ end;
+ TDJPT_FORM = TdjpForm;
+ TPDJPT_FORM = ^TdjpForm;
+ { -----------------------------------------------------------------
+ DJP_CJ_MIXEDFORMS
+
+ This is unique in that both setting and querying can have multiple
+ elements. Both the first page and the last page are DJP_MXF_INFINITY
+ (which is the separator for individual elements).
+ Some examples are:
+
+ - Only one form (form1) for the entire job.
+ (DJP_MXF_INFINITY, DJP_MXF_INFINITY, form1)
+
+ - Page 1 has form1, then pages 2 ... n have form2.
+ (DJP_MXF_INFINITY, 1, form1) (2, DJP_MXF_INFINITY, form2)
+
+ - Even pages have form1 and odd pages have form2
+ (DJP_MXF_INFINITY, DJP_MXF_ODD, form1) (DJP_MXF_EVEN, DJP_MXF_INFINITY, form2)
+ or (DJP_MXF_INFINITY, DJP_MXF_EVEN, form2) (DJP_MXF_ODD, DJP_MXF_INFINITY, form1)
+
+ - First page has form1, even pages have form2 and odd pages have form3
+ (DJP_MXF_INFINITY, 1, form1) (DJP_MXF_ODD, DJP_MXF_ODD, form1) (DJP_MXF_EVEN, DJP_MXF_INFINITY, form2)
+ or (DJP_MXF_INFINITY, 1, form1) (DJP_MXF_EVEN, DJP_MXF_EVEN, form2) (DJP_MXF_ODD, DJP_MXF_INFINITY, form1)
+
+ }
+
+ const
+ DJP_MXF_INFINITY = -(1);
+ DJP_MXF_ODD = -(2);
+ DJP_MXF_EVEN = -(3);
+ { djpMXF }
+ { Starting page number }
+ { Ending page number }
+ { Form associated with the range }
+
+ type
+
+ TdjpMixedForms = record
+ lStartRange : Longint;
+ lEndRange : Longint;
+ djpfmForm : TDJPT_FORM;
+ end;
+ TDJPT_MIXEDFORMS = TdjpMixedForms;
+ TPDJPT_MIXEDFORMS = ^TdjpMixedForms;
+ { -----------------------------------------------------------------
+ DJP_SJ_FONTDOWNLOADING
+ }
+ { Device does not support downloading }
+
+ const
+ DJP_FDL_NONE = 0;
+ { Download fonts to printer }
+ DJP_FDL_DOWNLOAD = 1;
+ { Rasterize fonts }
+ DJP_FDL_BITMAP = 2;
+ { Substitute device fonts for system }
+ DJP_FDL_SUBSTITUTE = 3;
+
+ type
+
+ TDJPT_FONTDOWNLOADING = Cardinal;
+
+ TPDJPT_FONTDOWNLOADING = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_DUPLEX
+ }
+ { Device does not support duplex }
+
+ const
+ DJP_DUP_NONE = 0;
+ { Duplex is turned off }
+ DJP_DUP_OFF = 1;
+ DJP_DUP_BOOK = 2;
+ DJP_DUP_FLIP = 3;
+
+ type
+
+ TDJPT_DUPLEX = Cardinal;
+
+ TPDJPT_DUPLEX = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_COLLATE
+ }
+ { Device does not support collation }
+
+ const
+ DJP_COL_NONE = 0;
+ DJP_COL_OFF = 1;
+ DJP_COL_ON = 2;
+ { more for printer dialogs than }
+ DJP_COL_PRINTER_SETTING = 3;
+ { programmatic control. Use }
+ { the setting on the printer panel. }
+
+ type
+
+ TDJPT_COLLATE = Cardinal;
+
+ TPDJPT_COLLATE = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_FEED
+ }
+
+ const
+ DJP_FED_MANUAL = 1;
+ DJP_FED_AUTOMATIC = 2;
+
+ type
+
+ TDJPT_FEED = Cardinal;
+
+ TPDJPT_FEED = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_COPIES
+
+ This is the number of copies on a per page basis. This is not
+ enumerateable.
+ }
+
+ TDJPT_COPIES = Cardinal;
+
+ TPDJPT_COPIES = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_SCALING
+
+ This is a percentage value. This is not enumerateable.
+ }
+
+ TDJPT_SCALING = Longint;
+
+ TPDJPT_SCALING = Longint;
+ { -----------------------------------------------------------------
+ DJP_SJ_FORMFEEDCONTROL
+
+ This is a property that effects raw data jobs (print from the
+ command line, DOS print jobs, Windows print jobs). This checks
+ the very last byte of the data stream to see if it is a form
+ feed control character.
+ }
+ { Never add }
+
+ const
+ DJP_FFC_NONE = 1;
+ { Add if not seen }
+ DJP_FFC_CONDITIONAL = 2;
+ { Always add }
+ DJP_FFC_COMPULSORY = 3;
+
+ type
+
+ TDJPT_FORMFEEDCONTROL = Cardinal;
+
+ TPDJPT_FORMFEEDCONTROL = Cardinal;
+ { -----------------------------------------------------------------
+ DJP_SJ_N_UP
+
+ Number of logical pages per physical page (ex: 2-up, 4-up)
+ }
+
+ TDJPT_NUP = Longint;
+
+ TPDJPT_NUP = Longint;
+ { -----------------------------------------------------------------
+ DJP_CJ_OUTPUTBIN
+
+ Setting will only use szBinname.
+
+ Querying will return all fields filled in.
+ }
+ { djpOBN }
+ { System Bin name }
+ { v-= Informational only =-v }
+ { Display Bin name (translated) }
+ { Bin id # (-1 for no id) }
+
+ TdjpOutputBin = record
+ szBinname : Str32;
+ szDisplayBinname : Str64;
+ lBinId : Longint;
+ end;
+ TDJPT_OUTPUTBIN = TdjpOutputBin;
+ TPDJPT_OUTPUTBIN = ^TdjpOutputBin;
+ { -----------------------------------------------------------------
+ DJP_CJ_TRAYNAME
+
+ Setting will match only szTrayname. The perfered way to set which
+ tray to use is DJP_CJ_FORM. Otherwise, you are not guaranteed a
+ unique match for all three form, tray, and media possibilities.
+
+ Querying will return all fields filled in.
+ }
+ { djpTry }
+ { System Tray name }
+ { v-= Informational only =-v }
+ { Display Tray name (translated) }
+ { Simple tray id (if not DJP_NONE) }
+
+ TdjpInputTray = record
+ szTrayname : Str32;
+ szDisplayTrayname : Str64;
+ djpttTrayID : TDJPT_TRAYTYPE;
+ end;
+ TDJPT_TRAYNAME = TdjpInputTray;
+ TPDJPT_TRAYNAME = ^TdjpInputTray;
+
+
+function DevOpenDC(ahab: HAB; lType: Longint; pszToken: PChar; lCount: Longint; var pdopData: DevOpenStruc; hdcComp: cardinal): cardinal; cdecl;
+function DevCloseDC(ahdc: cardinal): cardinal; cdecl;
+function DevEscape(ahdc: cardinal; lCode, lInCount: Longint; var pbInData; var plOutCount: Longint; var pbOutData): Longint; cdecl;
+function DevQueryCaps(ahdc: cardinal; lStart, lCount: Longint; var alArray: Longint): Longbool; cdecl;
+function DevQueryDeviceNames(ahab: HAB; pszDriverName: PChar; var pldn: Longint; aDeviceName: Str32; aDeviceDesc: Str64; var pldt: Longint; aDataType: Str16): Longbool; cdecl;
+function DevQueryHardcopyCaps(ahdc: cardinal; lStartForm, lForms: Longint; var phciHcInfo: HCInfo): Longint; cdecl;
+function DevPostDeviceModes(ahab: HAB; var pdrivDriverData: DrivData; pszDriverName, pszDeviceName, pszName: PChar; flOptions: cardinal): Longint; cdecl;
+
+implementation
+
+function DevOpenDC(ahab: HAB; lType: Longint; pszToken: PChar; lCount: Longint; var pdopData: DevOpenStruc; hdcComp: cardinal): cardinal; cdecl;
+ external 'PMGPI' index 610;
+function DevCloseDC(ahdc: cardinal): cardinal; cdecl;
+ external 'PMGPI' index 604;
+function DevEscape(ahdc: cardinal; lCode, lInCount: Longint; var pbInData; var plOutCount: Longint; var pbOutData): Longint; cdecl;
+ external 'PMGPI' index 605;
+function DevQueryCaps(ahdc: cardinal; lStart, lCount: Longint;var alArray: Longint): Longbool; cdecl;
+ external 'PMGPI' index 606;
+function DevQueryDeviceNames(ahab: HAB; pszDriverName: PChar; var pldn: Longint; aDeviceName: Str32; aDeviceDesc: Str64; var pldt: Longint; aDataType: Str16): Longbool; cdecl;
+ external 'PMGPI' index 607;
+function DevQueryHardcopyCaps(ahdc: cardinal; lStartForm, lForms: Longint; var phciHcInfo: HCInfo): Longint; cdecl;
+ external 'PMGPI' index 608;
+function DevPostDeviceModes(ahab: HAB; var pdrivDriverData: DrivData; pszDriverName, pszDeviceName, pszName: PChar; flOptions: cardinal): Longint; cdecl;
+ external 'PMGPI' index 609;
+
+ { was
+ #define QUERYSIZE_HEADER_SIZE (sizeof (QUERYSIZE) - sizeof (((PQUERYSIZE)NULL)->aTuples))
+ }
+// function QUERYSIZE_HEADER_SIZE : longint;
+// { return type might be wrong }
+// begin
+// QUERYSIZE_HEADER_SIZE:=(sizeof(QUERYSIZE)) - (sizeof((TPQUERYSIZE(NULL))^.aTuples));
+// end;
+
+// #define DJP_HEADER_SIZE (sizeof (DJP_ITEM) - sizeof (((PDJP_ITEM)NULL)->ulValue))
+// #define DJP_NEXT_STRUCTP(p) ((PDJP_ITEM)((PBYTE)(p) + (p)->cb))
+// #define DJP_ELEMENTP(s,t) ((t*)&((s).ulValue))
+// #define DJP_SET_ELEMENT(s,t,e) (*DJP_ELEMENTP (s,t) = (e))
+
+ { was #define dname def_expr }
+// function DJP_HEADER_SIZE : longint;
+// { return type might be wrong }
+// begin
+// DJP_HEADER_SIZE:=(sizeof(DJP_ITEM)) - (sizeof((TPDJP_ITEM(NULL))^.ulValue));
+// end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+// function DJP_NEXT_STRUCTP(p : longint) : TPDJP_ITEM;
+// begin
+// DJP_NEXT_STRUCTP:=TPDJP_ITEM((TPBYTE(p)) + (p^.cb));
+// end;
+
+ { was #define dname(params) para_def_expr }
+ { argument types are unknown }
+// function DJP_ELEMENTP(s,t : longint) : ^Tt;
+// begin
+// DJP_ELEMENTP:=^Tt(@(s.ulValue));
+// end;
+
+end.
+
+{
+
+$Log: pmdev.pas,v $
+Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmgpi.pas b/rtl/os2/pmgpi.pas
new file mode 100644
index 0000000000..67ad6b3980
--- /dev/null
+++ b/rtl/os2/pmgpi.pas
@@ -0,0 +1,2173 @@
+{****************************************************************************
+
+ $Id: pmgpi.pas,v 1.6 2005/02/14 17:13:31 peter Exp $
+
+ PMGPI interface unit
+ FPC Pascal Runtime Library for OS/2
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ Copyright (c) 1999-2000 by Ramon Bosque
+
+ The Free Pascal runtime library is distributed under the Library GNU Public
+ License v2. So is this unit. The Library GNU Public License requires you to
+ distribute the source code of this unit with any product that uses it.
+ Because the EMX library isn't under the LGPL, we grant you an exception to
+ this, and that is, when you compile a program with the Free Pascal Compiler,
+ you do not need to ship source code with that program, AS LONG AS YOU ARE
+ USING UNMODIFIED CODE! If you modify this code, you MUST change the next
+ line:
+
+ <This an official, unmodified Free Pascal source code file.>
+
+ Send us your modified files, we can work together if you want!
+
+ Free Pascal is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ Library GNU General Public License for more details.
+
+ You should have received a copy of the Library GNU General Public License
+ along with Free Pascal; see the file COPYING.LIB. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+ ****************************************************************************}
+
+{Warning: This code is alfa. Future versions of this unit will propably
+ not be compatible.}
+
+unit pmgpi;
+
+interface
+
+{$MACRO ON}
+
+uses os2def,pmbitmap;
+
+const GPI_ERROR = 0;
+ GPI_OK = 1;
+ GPI_ALTERROR = (-1);
+
+ CLR_NOINDEX = (-254);
+
+ PU_ARBITRARY = $0004;
+ PU_PELS = $0008;
+ PU_LOMETRIC = $000C;
+ PU_HIMETRIC = $0010;
+ PU_LOENGLISH = $0014;
+ PU_HIENGLISH = $0018;
+ PU_TWIPS = $001C;
+ GPIF_DEFAULT = 0;
+ GPIF_SHORT = $0100;
+ GPIF_LONG = $0200;
+ GPIT_NORMAL = 0;
+ GPIT_MICRO = $1000;
+ GPIA_NOASSOC = 0;
+ GPIA_ASSOC = $4000;
+ HDC_ERROR = -1;
+
+ GRES_ATTRS = $0001;
+ GRES_SEGMENTS = $0002;
+ GRES_ALL = $0004;
+ PS_UNITS = $00FC;
+ PS_FORMAT = $0F00;
+ PS_TYPE = $1000;
+ PS_MODE = $2000;
+ PS_ASSOCIATE = $4000;
+ PS_NORESET = $8000;
+ GPIE_SEGMENT = 0;
+ GPIE_ELEMENT = 1;
+ GPIE_DATA = 2;
+ DCTL_ERASE = 1;
+ DCTL_DISPLAY = 2;
+ DCTL_BOUNDARY = 3;
+ DCTL_DYNAMIC = 4;
+ DCTL_CORRELATE = 5;
+ DCTL_ERROR = -1;
+ DCTL_OFF = 0;
+ DCTL_ON = 1;
+ SDW_ERROR = -1;
+ SDW_OFF = 0;
+ SDW_ON = 1;
+ DM_ERROR = 0;
+ DM_DRAW = 1;
+ DM_RETAIN = 2;
+ DM_DRAWANDRETAIN = 3;
+
+ PICKAP_DEFAULT = 0;
+ PICKAP_REC = 2;
+ PICKSEL_VISIBLE = 0;
+ PICKSEL_ALL = 1;
+ GPI_HITS = 2;
+
+ DFORM_NOCONV = 0;
+ DFORM_S370SHORT = 1;
+ DFORM_PCSHORT = 2;
+ DFORM_PCLONG = 4;
+ ATTR_ERROR = (-1);
+ ATTR_DETECTABLE = 1;
+ ATTR_VISIBLE = 2;
+ ATTR_CHAINED = 6;
+ ATTR_DYNAMIC = 8;
+ ATTR_FASTCHAIN = 9;
+ ATTR_PROP_DETECTABLE = 10;
+ ATTR_PROP_VISIBLE = 11;
+ ATTR_OFF = 0;
+ ATTR_ON = 1;
+ LOWER_PRI = (-1);
+ HIGHER_PRI = 1;
+
+ SEGEM_ERROR = 0;
+ SEGEM_INSERT = 1;
+ SEGEM_REPLACE = 2;
+
+ CVTC_WORLD = 1;
+ CVTC_MODEL = 2;
+ CVTC_DEFAULTPAGE = 3;
+ CVTC_PAGE = 4;
+ CVTC_DEVICE = 5;
+ TRANSFORM_REPLACE = 0;
+ TRANSFORM_ADD = 1;
+ TRANSFORM_PREEMPT = 2;
+
+ MPATH_STROKE = 6;
+ FPATH_ALTERNATE = 0;
+ FPATH_WINDING = 2;
+ FPATH_EXCL = 0;
+ FPATH_INCL = 8;
+ SCP_ALTERNATE = 0;
+ SCP_WINDING = 2;
+ SCP_AND = 4;
+ SCP_RESET = 0;
+ SCP_EXCL = 0;
+ SCP_INCL = 8;
+
+ LCOL_RESET = $0001;
+ LCOL_REALIZABLE = $0002;
+ LCOL_PURECOLOR = $0004;
+ LCOL_OVERRIDE_DEFAULT_COLORS = $0008;
+ LCOL_REALIZED = $0010;
+ LCOLF_DEFAULT = 0;
+ LCOLF_INDRGB = 1;
+ LCOLF_CONSECRGB = 2;
+ LCOLF_RGB = 3;
+ LCOLF_PALETTE = 4;
+ LCOLOPT_REALIZED = $0001;
+ LCOLOPT_INDEX = $0002;
+ QLCT_ERROR = (-1);
+ QLCT_RGB = (-2);
+ QLCT_NOTLOADED = (-1);
+ QCD_LCT_FORMAT = 0;
+ QCD_LCT_LOINDEX = 1;
+ QCD_LCT_HIINDEX = 2;
+ QCD_LCT_OPTIONS = 3;
+ PAL_ERROR = (-1);
+ PC_RESERVED = $01;
+ PC_EXPLICIT = $02;
+ PC_NOCOLLAPSE = $04;
+
+ CLR_false = (-5);
+ CLR_true = (-4);
+ CLR_error = (-255);
+ CLR_default = (-3);
+ CLR_white = (-2);
+ CLR_black = (-1);
+ CLR_background = 0;
+ CLR_blue = 1;
+ CLR_red = 2;
+ CLR_pink = 3;
+ CLR_green = 4;
+ CLR_cyan = 5;
+ CLR_yellow = 6;
+ CLR_neutral = 7;
+ CLR_darkgray = 8;
+ CLR_darkblue = 9;
+ CLR_darkred = 10;
+ CLR_darkpink = 11;
+ CLR_darkgreen = 12;
+ CLR_darkcyan = 13;
+ CLR_brown = 14;
+ CLR_palegray = 15;
+
+ RGB_error = (-255);
+ RGB_black = $00000000;
+ RGB_blue = $000000FF;
+ RGB_green = $0000FF00;
+ RGB_cyan = $0000FFFF;
+ RGB_red = $00FF0000;
+ RGB_pink = $00FF00FF;
+ RGB_yellow = $00FFFF00;
+ RGB_white = $00FFFFFF;
+
+ BA_NOBOUNDARY = 0;
+ BA_BOUNDARY = $0001;
+ BA_ALTERNATE = 0;
+ BA_WINDING = $0002;
+ BA_EXCL = 0;
+ BA_INCL = 8;
+ DRO_FILL = 1;
+ DRO_OUTLINE = 2;
+ DRO_OUTLINEFILL = 3;
+ PATSYM_ERROR = (-1);
+ PATSYM_DEFAULT = 0;
+ PATSYM_DENSE1 = 1;
+ PATSYM_DENSE2 = 2;
+ PATSYM_DENSE3 = 3;
+ PATSYM_DENSE4 = 4;
+ PATSYM_DENSE5 = 5;
+ PATSYM_DENSE6 = 6;
+ PATSYM_DENSE7 = 7;
+ PATSYM_DENSE8 = 8;
+ PATSYM_VERT = 9;
+ PATSYM_HORIZ = 10;
+ PATSYM_DIAG1 = 11;
+ PATSYM_DIAG2 = 12;
+ PATSYM_DIAG3 = 13;
+ PATSYM_DIAG4 = 14;
+ PATSYM_NOSHADE = 15;
+ PATSYM_SOLID = 16;
+ PATSYM_HALFTONE = 17;
+ PATSYM_HATCH = 18;
+ PATSYM_DIAGHATCH = 19;
+ PATSYM_BLANK = 64;
+ LCID_ERROR = (-1);
+ LCID_DEFAULT = 0;
+
+ AM_ERROR = (-1);
+ AM_PRESERVE = 0;
+ AM_NOPRESERVE = 1;
+ FM_ERROR = (-1);
+ FM_DEFAULT = 0;
+ FM_OR = 1;
+ FM_OVERPAINT = 2;
+ FM_LEAVEALONE = 5;
+ FM_XOR = 4;
+ FM_AND = 6;
+ FM_SUBTRACT = 7;
+ FM_MASKSRCNOT = 8;
+ FM_ZERO = 9;
+ FM_NOTMERGESRC = 10;
+ FM_NOTXORSRC = 11;
+ FM_INVERT = 12;
+ FM_MERGESRCNOT = 13;
+ FM_NOTCOPYSRC = 14;
+ FM_MERGENOTSRC = 15;
+ FM_NOTMASKSRC = 16;
+ FM_ONE = 17;
+ BM_ERROR = (-1);
+ BM_DEFAULT = 0;
+ BM_OR = 1;
+ BM_OVERPAINT = 2;
+ BM_LEAVEALONE = 5;
+ BM_XOR = 4;
+ BM_AND = 6;
+ BM_SUBTRACT = 7;
+ BM_MASKSRCNOT = 8;
+ BM_ZERO = 9;
+ BM_NOTMERGESRC = 10;
+ BM_NOTXORSRC = 11;
+ BM_INVERT = 12;
+ BM_MERGESRCNOT = 13;
+ BM_NOTCOPYSRC = 14;
+ BM_MERGENOTSRC = 15;
+ BM_NOTMASKSRC = 16;
+ BM_ONE = 17;
+ BM_SRCTRANSPARENT = 18;
+ BM_DESTTRANSPARENT = 19;
+ LINETYPE_ERROR = (-1);
+ LINETYPE_DEFAULT = 0;
+ LINETYPE_DOT = 1;
+ LINETYPE_SHORTDASH = 2;
+ LINETYPE_DASHDOT = 3;
+ LINETYPE_DOUBLEDOT = 4;
+ LINETYPE_LONGDASH = 5;
+ LINETYPE_DASHDOUBLEDOT = 6;
+ LINETYPE_SOLID = 7;
+ LINETYPE_INVISIBLE = 8;
+ LINETYPE_ALTERNATE = 9;
+ LINEWIDTH_ERROR = (-1);
+ LINEWIDTH_DEFAULT = 0;
+ LINEWIDTH_NORMAL = $00010000;
+ LINEWIDTH_THICK = $00020000;
+ LINEWIDTHGEOM_ERROR = (-1);
+ LINEEND_ERROR = (-1);
+ LINEEND_DEFAULT = 0;
+ LINEEND_FLAT = 1;
+ LINEEND_SQUARE = 2;
+ LINEEND_ROUND = 3;
+ LINEJOIN_ERROR = (-1);
+ LINEJOIN_DEFAULT = 0;
+ LINEJOIN_BEVEL = 1;
+ LINEJOIN_ROUND = 2;
+ LINEJOIN_MITRE = 3;
+ CHDIRN_ERROR = (-1);
+ CHDIRN_DEFAULT = 0;
+ CHDIRN_LEFTRIGHT = 1;
+ CHDIRN_TOPBOTTOM = 2;
+ CHDIRN_RIGHTLEFT = 3;
+ CHDIRN_BOTTOMTOP = 4;
+ TA_NORMAL_HORIZ = $0001;
+ TA_LEFT = $0002;
+ TA_CENTER = $0003;
+ TA_RIGHT = $0004;
+ TA_STANDARD_HORIZ = $0005;
+ TA_NORMAL_VERT = $0100;
+ TA_TOP = $0200;
+ TA_HALF = $0300;
+ TA_BASE = $0400;
+ TA_BOTTOM = $0500;
+ TA_STANDARD_VERT = $0600;
+ CM_ERROR = (-1);
+ CM_DEFAULT = 0;
+ CM_MODE1 = 1;
+ CM_MODE2 = 2;
+ CM_MODE3 = 3;
+ MARKSYM_ERROR = (-1);
+ MARKSYM_DEFAULT = 0;
+ MARKSYM_CROSS = 1;
+ MARKSYM_PLUS = 2;
+ MARKSYM_DIAMOND = 3;
+ MARKSYM_SQUARE = 4;
+ MARKSYM_SIXPOINTSTAR = 5;
+ MARKSYM_EIGHTPOINTSTAR = 6;
+ MARKSYM_SOLIDDIAMOND = 7;
+ MARKSYM_SOLIDSQUARE = 8;
+ MARKSYM_DOT = 9;
+ MARKSYM_SMALLCIRCLE = 10;
+ MARKSYM_BLANK = 64;
+ CHS_OPAQUE = $0001;
+ CHS_VECTOR = $0002;
+ CHS_LEAVEPOS = $0008;
+ CHS_CLIP = $0010;
+ CHS_UNDERSCORE = $0200;
+ CHS_STRIKEOUT = $0400;
+ PRIM_LINE = 1;
+ PRIM_CHAR = 2;
+ PRIM_MARKER = 3;
+ PRIM_AREA = 4;
+ PRIM_IMAGE = 5;
+ LBB_COLOR = $0001;
+ LBB_BACK_COLOR = $0002;
+ LBB_MIX_MODE = $0004;
+ LBB_BACK_MIX_MODE = $0008;
+ LBB_WIDTH = $0010;
+ LBB_GEOM_WIDTH = $0020;
+ LBB_TYPE = $0040;
+ LBB_END = $0080;
+ LBB_JOIN = $0100;
+ CBB_COLOR = $0001;
+ CBB_BACK_COLOR = $0002;
+ CBB_MIX_MODE = $0004;
+ CBB_BACK_MIX_MODE = $0008;
+ CBB_SET = $0010;
+ CBB_MODE = $0020;
+ CBB_BOX = $0040;
+ CBB_ANGLE = $0080;
+ CBB_SHEAR = $0100;
+ CBB_DIRECTION = $0200;
+ CBB_TEXT_ALIGN = $0400;
+ CBB_EXTRA = $0800;
+ CBB_BREAK_EXTRA = $1000;
+ MBB_COLOR = $0001;
+ MBB_BACK_COLOR = $0002;
+ MBB_MIX_MODE = $0004;
+ MBB_BACK_MIX_MODE = $0008;
+ MBB_SET = $0010;
+ MBB_SYMBOL = $0020;
+ MBB_BOX = $0040;
+ ABB_COLOR = $0001;
+ ABB_BACK_COLOR = $0002;
+ ABB_MIX_MODE = $0004;
+ ABB_BACK_MIX_MODE = $0008;
+ ABB_SET = $0010;
+ ABB_SYMBOL = $0020;
+ ABB_REF_POINT = $0040;
+ IBB_COLOR = $0001;
+ IBB_BACK_COLOR = $0002;
+ IBB_MIX_MODE = $0004;
+ IBB_BACK_MIX_MODE = $0008;
+
+ TXTBOX_TOPLEFT = 0;
+ TXTBOX_BOTTOMLEFT = 1;
+ TXTBOX_TOPRIGHT = 2;
+ TXTBOX_BOTTOMRIGHT = 3;
+ TXTBOX_CONCAT = 4;
+ TXTBOX_COUNT = 5;
+ PVIS_ERROR = 0;
+ PVIS_INVISIBLE = 1;
+ PVIS_VISIBLE = 2;
+ RVIS_ERROR = 0;
+ RVIS_INVISIBLE = 1;
+ RVIS_PARTIAL = 2;
+ RVIS_VISIBLE = 3;
+
+ FONT_DEFAULT = 1;
+ FONT_MATCH = 2;
+ LCIDT_FONT = 6;
+ LCIDT_BITMAP = 7;
+ LCID_ALL = (-1);
+
+ FWEIGHT_DONT_CARE = 0;
+ FWEIGHT_ULTRA_LIGHT = 1;
+ FWEIGHT_EXTRA_LIGHT = 2;
+ FWEIGHT_LIGHT = 3;
+ FWEIGHT_SEMI_LIGHT = 4;
+ FWEIGHT_NORMAL = 5;
+ FWEIGHT_SEMI_BOLD = 6;
+ FWEIGHT_BOLD = 7;
+ FWEIGHT_EXTRA_BOLD = 8;
+ FWEIGHT_ULTRA_BOLD = 9;
+ FWIDTH_DONT_CARE = 0;
+ FWIDTH_ULTRA_CONDENSED = 1;
+ FWIDTH_EXTRA_CONDENSED = 2;
+ FWIDTH_CONDENSED = 3;
+ FWIDTH_SEMI_CONDENSED = 4;
+ FWIDTH_NORMAL = 5;
+ FWIDTH_SEMI_EXPANDED = 6;
+ FWIDTH_EXPANDED = 7;
+ FWIDTH_EXTRA_EXPANDED = 8;
+ FWIDTH_ULTRA_EXPANDED = 9;
+ FTYPE_ITALIC = $0001;
+ FTYPE_ITALIC_DONT_CARE = $0002;
+ FTYPE_OBLIQUE = $0004;
+ FTYPE_OBLIQUE_DONT_CARE = $0008;
+ FTYPE_ROUNDED = $0010;
+ FTYPE_ROUNDED_DONT_CARE = $0020;
+ QFA_PUBLIC = 1;
+ QFA_PRIVATE = 2;
+ QFA_ERROR =GPI_ALTERROR;
+ QF_PUBLIC = $0001;
+ QF_PRIVATE = $0002;
+ QF_NO_GENERIC = $0004;
+ QF_NO_DEVICE = $0008;
+
+ ROP_SRCCOPY = $00CC;
+ ROP_SRCPAINT = $00EE;
+ ROP_SRCAND = $0088;
+ ROP_SRCINVERT = $0066;
+ ROP_SRCERASE = $0044;
+ ROP_NOTSRCCOPY = $0033;
+ ROP_NOTSRCERASE = $0011;
+ ROP_MERGECOPY = $00C0;
+ ROP_MERGEPAINT = $00BB;
+ ROP_PATCOPY = $00F0;
+ ROP_PATPAINT = $00FB;
+ ROP_PATINVERT = $005A;
+ ROP_DSTINVERT = $0055;
+ ROP_ZERO = $0000;
+ ROP_ONE = $00FF;
+ BBO_OR = 0;
+ BBO_AND = 1;
+ BBO_IGNORE = 2;
+ BBO_PAL_COLORS = 4;
+ BBO_NO_COLOR_INFO = 8;
+ FF_BOUNDARY = 0;
+ FF_SURFACE = 1;
+ HBM_ERROR = -1;
+
+ {Bitmaps}
+ CBM_INIT = $0004;
+ BMB_ERROR = (-1);
+
+ {Regions}
+ CRGN_OR = 1;
+ CRGN_COPY = 2;
+ CRGN_XOR = 4;
+ CRGN_AND = 6;
+ CRGN_DIFF = 7;
+ RECTDIR_LFRT_TOPBOT = 1;
+ RECTDIR_RTLF_TOPBOT = 2;
+ RECTDIR_LFRT_BOTTOP = 3;
+ RECTDIR_RTLF_BOTTOP = 4;
+ RGN_ERROR = 0;
+ RGN_NULL = 1;
+ RGN_RECT = 2;
+ RGN_COMPLEX = 3;
+ PRGN_ERROR = 0;
+ PRGN_OUTSIDE = 1;
+ PRGN_INSIDE = 2;
+ RRGN_ERROR = 0;
+ RRGN_OUTSIDE = 1;
+ RRGN_PARTIAL = 2;
+ RRGN_INSIDE = 3;
+ EQRGN_ERROR = 0;
+ EQRGN_NOTEQUAL = 1;
+ EQRGN_EQUAL = 2;
+ HRGN_ERROR = -1;
+
+ {Metafiles}
+ PMF_SEGBASE = 0;
+ PMF_LOADTYPE = 1;
+ PMF_RESOLVE = 2;
+ PMF_LCIDS = 3;
+ PMF_RESET = 4;
+ PMF_SUPPRESS = 5;
+ PMF_COLORTABLES = 6;
+ PMF_COLORREALIZABLE = 7;
+ PMF_DEFAULTS = 8;
+ PMF_DELETEOBJECTS = 9;
+ RS_DEFAULT = 0;
+ RS_NODISCARD = 1;
+ LC_DEFAULT = 0;
+ LC_NOLOAD = 1;
+ LC_LOADDISC = 3;
+ LT_DEFAULT = 0;
+ LT_NOMODIFY = 1;
+ LT_ORIGINALVIEW = 4;
+ RES_DEFAULT = 0;
+ RES_NORESET = 1;
+ RES_RESET = 2;
+ SUP_DEFAULT = 0;
+ SUP_NOSUPPRESS = 1;
+ SUP_SUPPRESS = 2;
+ CTAB_DEFAULT = 0;
+ CTAB_NOMODIFY = 1;
+ CTAB_REPLACE = 3;
+ CTAB_REPLACEPALETTE = 4;
+ CREA_DEFAULT = 0;
+ CREA_REALIZE = 1;
+ CREA_NOREALIZE = 2;
+ CREA_DOREALIZE = 3;
+ DDEF_DEFAULT = 0;
+ DDEF_IGNORE = 1;
+ DDEF_LOADDISC = 3;
+ DOBJ_DEFAULT = 0;
+ DOBJ_NODELETE = 1;
+ DOBJ_DELETE = 2;
+ RSP_DEFAULT = 0;
+ RSP_NODISCARD = 1;
+
+ {Polygons}
+ POLYGON_NOBOUNDARY = 0;
+ POLYGON_BOUNDARY = $0001;
+ POLYGON_ALTERNATE = 0;
+ POLYGON_WINDING = $0002;
+ POLYGON_EXCL = 0;
+ POLYGON_INCL = $0008;
+
+type SizeL=record
+ cx,cy:longint;
+ end;
+ PSizeL=^SizeL;
+ TSizeL=SizeL;
+
+ MatrixLF=record
+ fxm11:longint;
+ fxm12:longint;
+ lm13:longint;
+ fxm21:longint;
+ fxm22:longint;
+ lm23:longint;
+ lm31:longint;
+ lm32:longint;
+ lm33:longint;
+ end;
+ PMatrixLF=^MatrixLF;
+ TMatrixLF=MatrixLF;
+
+ ArcParams=record
+ lp,lq,lr,ls:longint;
+ end;
+ PArcParams=^ArcParams;
+ TArcParams=ArcParams;
+
+ SizeF=record
+ cx,cy:longint;
+ end;
+ PSizeF=^SizeF;
+ TSizeF=SizeF;
+
+ GradientL=record
+ x,y:longint;
+ end;
+ PGradientL=^GradientL;
+ TGradientL=GradientL;
+
+ LineBundle=record
+ lColor:longint;
+ lBackColor:longint;
+ usMixMode:word;
+ usBackMixMode:word;
+ fxWidth:longint;
+ lGeomWidth:longint;
+ usType:word;
+ usEnd:word;
+ usJoin:word;
+ usReserved:word;
+ end;
+ PLineBundle=^LineBundle;
+ TLineBundle=LineBundle;
+
+ CharBundle=record
+ lColor:longint;
+ lBackColor:longint;
+ usMixMode:word;
+ usBackMixMode:word;
+ usSet:word;
+ usPrecision:word;
+ sizfxCell:sizef;
+ ptlAngle:pointl;
+ ptlShear:pointl;
+ usDirection:word;
+ usTextAlign:word;
+ fxExtra:longint;
+ fxBreakExtra:longint;
+ end;
+ PCharBundle=^CharBundle;
+ TCharBundle=CharBundle;
+
+ MarkerBundle=record
+ lColor:longint;
+ lBackColor:longint;
+ usMixMode:word;
+ usBackMixMode:word;
+ usSet:word;
+ usSymbol:word;
+ sizFxCell:SizeF;
+ end;
+ PMarkerBundle=^MarkerBundle;
+ TMarkerBundle=MarkerBundle;
+
+ AreaBundle=record
+ lColor:longint;
+ lBackColor:longint;
+ usMixMode:word;
+ usBackMixMode:word;
+ usSet:word;
+ usSymbol:word;
+ ptlRefPoint:pointl;
+ end;
+ PAreaBundle=^AreaBundle;
+ TAreaBundle=AreaBundle;
+
+ ImageBundle=record
+ lColor:longint;
+ lBackColor:longint;
+ usMixMode:word;
+ usBackMixMode:word;
+ end;
+ PImageBundle=^ImageBundle;
+ TImageBundle=ImageBundle;
+
+ KerningPairs=record
+ sFirstChar:integer;
+ sSecondChar:integer;
+ lKerningAmount:longint;
+ end;
+ PKerningPairs=^KerningPairs;
+ TKerningPairs=KerningPairs;
+
+ FaceNameDesc=record
+ usSize:word;
+ usWeightClass:word;
+ usWidthClass:word;
+ usReserved:word;
+ flOptions:cardinal;
+ end;
+ PFaceNameDesc=^FaceNameDesc;
+ TFaceNameDesc=FaceNameDesc;
+
+ FFDescs=array[0..1,0..FaceSize-1] of char;
+ PFFDescs=^FFDescs;
+ TFFDescs = FFDescs;
+
+ FFDescs2=record
+ cbLength:cardinal;
+ cbFacenameOffset:cardinal;
+ abFamilyName:array[0..1-1] of byte;
+ end;
+ PFFDescs2=^FFDescs2;
+ TFFDescs2=FFDescs2;
+
+ RgnRect=record
+ ircStart:cardinal;
+ crc:cardinal;
+ crcReturned:cardinal;
+ ulDirection:cardinal;
+ end;
+ PRgnRect=^RgnRect;
+ TRgnRect=RgnRect;
+
+ Polygon=record
+ ulPoints:cardinal;
+ aPointl:Ppointl;
+ end;
+ PPolygon=^Polygon;
+ TPolygon=Polygon;
+
+ Polyset=record
+ ulPolys:cardinal;
+ aPolygon:array[0..1-1] of TPolygon;
+ end;
+ PPolyset=^Polyset;
+ TPolyset=Polyset;
+
+// ===========================================================================
+//*
+//* The orders fall into 4 categories :-
+//*
+//* 1) 1-byte orders
+//*
+//* 2) 2-byte orders - second byte contains the value
+//*
+//* 3) Long orders - second byte gives the order length, subsequent bytes
+//* contain the values (up to 256 bytes long)
+//*
+//* 4) Very long orders - third and fourth bytes gives the order length,
+//* subsequent bytes contain the values (up to 64K long)
+//*
+//* ===========================================================================
+
+//#pragma pack(1) /* pack on byte boundary */
+
+//***************************************************************************\
+//*
+//* Miscellaneous structures used in this file
+//*
+//***************************************************************************/
+
+// form of RECTL with shorts instead of longs
+type
+ RECT1S=record // rcs
+ xLeft: Integer;
+ yBottom: Integer;
+ xRight: Integer;
+ yTop: Integer;
+ end;
+
+// form of POINTL with 1 byte offsets instead of longs
+ ODPOINT=record // odpt
+ dx: Char;
+ dy: Char;
+ end;
+
+// form of SIZEL with shorts instead of longs
+ SIZES=record // sizs
+ cx: Integer;
+ cy: Integer;
+ end;
+
+// unsigned two-byte swapped integer
+ SWPUSHORT=record // swpus
+ HiByte: Byte;
+ LoByte: Byte;
+ end;
+
+//***************************************************************************\
+//*
+//* 1-byte orders
+//*
+//***************************************************************************/
+
+// macro to tell whether this is a 1-byte order
+{$define BYTE_ORDER(oc):=((oc)=OCODE_GNOP1 or (oc)=OCODE_GESD)}
+
+// 1-byte order codes
+const
+ OCODE_GNOP1 =$00; // No-operation
+ OCODE_GESD =$FF; // End symbol definition
+
+//***************************************************************************\
+//
+// 2-byte orders
+//
+//***************************************************************************/
+
+// definitions to help determine whether an order code is a 2-byte order
+const
+ OCODE2_1 =$80;
+ OCODE2_2 =$88;
+
+{$define SHORT_ORDER(oc):=((((oc) xor OCODE2_1) and OCODE2_2)=OCODE2_2)}
+
+// General 2-byte order structure
+type
+ ORDER=record // ord
+ idCode: Byte;
+ uchData: Byte;
+ end;
+
+// 2-byte order codes
+const
+ OCODE_GBAR =$68; // Begin area
+ OCODE_GCFIG =$7D; // Close figure
+ OCODE_GEEL =$49; // End element
+ OCODE_GEPTH =$7F; // End path
+ OCODE_GEPROL =$3E; // End prologue
+ OCODE_GPOP =$3F; // Pop
+ OCODE_GSBMX =$0D; // Set background mix
+ OCODE_GPSBMX =$4D; // Push & set b/g mix
+ OCODE_GSCD =$3A; // Set char direction
+ OCODE_GPSCD =$7A; // Push & set char direction
+ OCODE_GSCR =$39; // Set char precision
+ OCODE_GPSCR =$79; // Push & set char precision
+ OCODE_GSCS =$38; // Set char set
+ OCODE_GPSCS =$78; // Push & set char set
+ OCODE_GSCOL =$0A; // Set color
+ OCODE_GPSCOL =$4A; // Push & set color
+ OCODE_GSLE =$1A; // Set line end
+ OCODE_GPSLE =$5A; // Push & set line end
+ OCODE_GSLJ =$1B; // Set line join
+ OCODE_GPSLJ =$5B; // Push & set line join
+ OCODE_GSLT =$18; // Set line type
+ OCODE_GPSLT =$58; // Push & set line type
+ OCODE_GSLW =$19; // Set line width
+ OCODE_GPSLW =$59; // Push & set line width
+ OCODE_GSMP =$3B; // Set marker precision
+ OCODE_GPSMP =$7B; // Push & set marker precision
+ OCODE_GSMS =$3C; // Set marker set
+ OCODE_GPSMS =$7C; // Push & set marker set
+ OCODE_GSMT =$29; // Set marker symbol
+ OCODE_GPSMT =$69; // Push & set marker symbol
+ OCODE_GSMX =$0C; // Set mix
+ OCODE_GPSMX =$4C; // Push & set mix
+ OCODE_GSPS =$08; // Set pattern set
+ OCODE_GPSPS =$48; // Push & set pattern set
+ OCODE_GSPT =$28; // Set pattern symbol
+ OCODE_GPSPT =$09; // Push & set pattern symbol
+
+// constants for 2-byte orders
+
+// Begin area
+const
+ GBAR_RESERVED =$80;
+ GBAR_BOUNDARY =$C0;
+ GBAR_NOBOUNDARY =$80;
+ GBAR_WINDING =$A0;
+ GBAR_ALTERNATE =$80;
+
+// Set Character Precision
+const
+ GSCR_PRECISION =$0F;
+
+//***************************************************************************\
+//*
+//* Long orders
+//*
+//***************************************************************************/
+
+// definitions to help determine whether an order code is a long order
+const
+ OCODE_VLONG =$FE;
+
+{$define LONG_ORDER(oc):=(not((oc)=OCODE_VLONG or BYTE_ORDER(oc) or SHORT_ORDER(oc)))}
+
+// long order structure
+const
+ LORDER_ML=253;
+
+type
+ LORDER=record // lord
+ idCode: Byte;
+ uchLength: Byte;
+ uchData: Array[0..LORDER_ML-1] of Byte;
+ end;
+
+// Long orders for which the length of data is normally zero
+const
+ OCODE_GEAR =$60; // End Area
+ OCODE_GEIMG =$93; // End Image
+
+// Long orders for which the data is contained in a type already defined
+
+// Character String
+const
+ OCODE_GCCHST = $83; // char string at curr posn
+ GCCHST_MC = 255; // Max len of string in bytes
+
+ OCODE_GCHST = $C3; // char string at given pos
+ GCHST_SMC = 251; // Max len of string (S)
+ GCHST_LMC = 247; // Max len of string (L)
+
+// Character String Move
+ OCODE_GCCHSTM = $B1; // char string move at c.p.
+ GCCHSTM_MC = 255; // Max len of string in byte
+
+ OCODE_GCHSTM = $F1; // char string move at g.p.
+ GCHSTM_SMC = 251; // Max len of string (S)
+ GCHSTM_LMC = 247; // Max len of string (L)
+
+// Comment
+ OCODE_GCOMT = $01; // Comment
+ GCOMT_ML = 255; // Maximum len of comment data
+
+// Image
+ OCODE_GIMD = $92; // Image data
+ GIMD_ML = 255; // Maximum len of image data
+
+// Full Arc
+ OCODE_GCFARC = $87; // full arc at current posn
+ OCODE_GFARC = $C7; // full arc at given posn
+
+// Label
+ OCODE_GLABL = $D3; // Label
+
+// Set Current Position
+ OCODE_GSCP = $21; // Set current position
+ OCODE_GPSCP = $61; // Push and set curr posn
+
+// Bezier spline
+ OCODE_GCBEZ = $A5; // Bezier spline at curr pos
+ GCBEZ_SMB = 21; // Max number of splines (S)
+ GCBEZ_LMB = 10; // Max number of splines (L)
+
+ OCODE_GBEZ = $E5; // Bezier spline at given pos
+ GBEZ_SMB = 20; // Max number of splines (S)
+ GBEZ_LMB = 10; // Max number of splines (L)
+
+// Fillet
+ OCODE_GCFLT = $85; // fillet at current posn
+ GCFLT_SMP = 63; // Max number of points (S)
+ GCFLT_LMP = 31; // Max number of points (L)
+
+ OCODE_GFLT = $C5; // fillet at given position
+ GFLT_SMP = 62; // Max number of points (S)
+ GFLT_LMP = 30; // Max number of points (L)
+
+// Polyline
+ OCODE_GCLINE = $81; // polyline at current posn
+ GCLINE_SMP = 63; // Max number of points (S)
+ GCLINE_LMP = 31; // Max number of points (L)
+
+ OCODE_GLINE = $C1; // polyline at given posn
+ GLINE_SMP = 62; // Max number of points (S)
+ GLINE_LMP = 30; // Max number of points (L)
+
+// Polymarker
+ OCODE_GCMRK = $82; // marker at current posn
+ GCMRK_SMP = 63; // Max number of points (S)
+ GCMRK_LMP = 31; // Max number of points (L)
+
+ OCODE_GMRK = $C2; // marker at given posn
+ GMRK_SMP = 62; // Max number of points (S)
+ GMRK_LMP = 30; // Max number of points (L)
+
+// Relative Line
+ OCODE_GCRLINE =$A1; // Relative line at curr pos
+ GCRLINE_MP =127; // Max number of points
+
+ OCODE_GRLINE = $E1; // Relative line at givn pos
+ GRLINE_SMP = 125; // Max number of points (S)
+ GRLINE_LMP = 123; // Max number of points (L)
+
+// Set Background Color
+ OCODE_GSBCOL = $25; // Set background color
+ OCODE_GPSBCOL = $65; // Push and set b/g color
+
+// Set Extended Color
+ OCODE_GSECOL = $26; // Set extended color
+ OCODE_GPSECOL = $66; // Push and set ext color
+
+// Extended Color values
+ SECOL_DEFAULT0 =$0000;
+ SECOL_DEFAULT1 =$FF00;
+ SECOL_NEUTRAL =$FF07;
+ SECOL_RESET =$FF08;
+
+// Set Character Angle
+ OCODE_GSCA = $34; // Set character angle
+ OCODE_GPSCA = $74; // Push and set char angle
+
+// Set Character Shear
+ OCODE_GSCH = $35; // Set character shear
+ OCODE_GPSCH = $75; // Push and set char shear
+
+// Set Fractional Line Width
+ OCODE_GSFLW = $11; // Set fractional line width
+ OCODE_GPSFLW = $51; // Push and set frac l width
+
+// Set Pick Identifier
+ OCODE_GSPIK = $43; // Set pick identifier
+ OCODE_GPSPIK = $23; // Push and set pick id
+
+
+// Long Orders for which a structure can be defined for the data
+
+// Arc
+ OCODE_GCARC = $86; // Arc at Current Position
+ OCODE_GARC = $C6; // Arc at Given Position
+
+type
+ ORDERS_GCARC=record // osgcarc
+ ptInter: POINTS;
+ ptEnd: POINTS;
+ end;
+
+ ORDERL_GCARC=record // olgcarc
+ ptInter: POINTL;
+ ptEnd: POINTL;
+ end;
+
+// Begin Element
+const
+ OCODE_GBEL = $D2; // Begin Element
+
+ GBEL_DL = 251;
+
+type
+ ORDER_GBEL=record // ogbel
+ lElementType: Longint;
+ achDesc: Array[0..GBEL_DL-1] of Char;
+ end;
+
+// Begin Image
+const
+ OCODE_GCBIMG = $91; // Begin Image at curr posn
+ OCODE_GBIMG = $D1; // Begin Image at given posn
+
+type
+ ORDER_GCBIMG=record // ogbimg
+ uchFormat: Byte;
+ uchReserved: Byte;
+ cx: SWPUSHORT;
+ cy: SWPUSHORT;
+ end;
+
+// Begin Path
+const
+ OCODE_GBPTH = $D0; // Begin Path
+
+type
+ ORDER_GBPTH=record // ogbpth
+ usReserved: Word;
+ idPath: Longint;
+ end;
+
+// Box
+const
+ OCODE_GCBOX =$80; // Box at current position
+ OCODE_GBOX =$C0; // Box at given position
+
+type
+ ORDERS_GCBOX=record // osgcbox
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptCorner: POINTS;
+ hAxis: Integer;
+ vAxis: Integer;
+ end;
+
+ ORDERL_GCBOX=record // olgcbox
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptCorner: POINTL;
+ hAxis: Longint;
+ vAxis: Longint;
+ end;
+
+const
+ GCBOX_FILL =$40;
+ GCBOX_BOUNDARY =$20;
+
+// Call Segment
+ OCODE_GCALLS =$07; // call segment
+
+type
+ ORDER_GCALLS=record // ogcalls
+ sReserved: Word;
+ idSegment: Longint;
+ end;
+
+// Fill Path
+const
+ OCODE_GFPTH =$D7; // Fill path
+
+type
+ ORDER_GFPTH=record // ogfpth
+ fbFlags: Byte;
+ uchReserved: Byte;
+ idPath: Longint;
+ end;
+
+const
+ GFPTH_ALTERNATE =$00;
+ GFPTH_WINDING =$40;
+ GFPTH_MODIFY =$20;
+
+// Outline Path
+ OCODE_GOPTH =$D4; // Outline Path
+
+type
+ ORDER_GOPTH=record // ogopth
+ fbFlags: Byte;
+ uchReserved: Byte;
+ idPath: Longint;
+ end;
+
+// Modify Path
+const
+ OCODE_GMPTH =$D8; // modify path
+
+type
+ ORDER_GMPTH=record // ogmpth
+ uchMode: Byte;
+ uchReserved: Byte;
+ idPath: Longint;
+ end;
+
+const
+ GMPTH_STROKE =$06;
+
+// Partial Arc
+ OCODE_GCPARC =$A3; // Partial arc at curr posn
+ OCODE_GPARC =$E3; // Partial arc at given posn
+
+type
+ ORDERS_GCPARC=record // osgcparc
+ ptCenter: POINTS;
+ ufx88Multiplier: FIXED88;
+ usStartAngle: Longint;
+ usSweepAngle: Longint;
+ end;
+
+ ORDERL_GCPARC=record // olgcparc
+ ptCenter: POINTL;
+ ufxMultiplier: FIXED;
+ usStartAngle: Longint;
+ usSweepAngle: Longint;
+ end;
+
+// Set Clip Path
+const
+ OCODE_GSCPTH =$B4; // Set clip path
+
+type
+ ORDER_GSCPTH=record // ogscpth
+ fbFlags: Byte;
+ uchReserved: Byte;
+ idPath: Longint;
+ end;
+
+const
+ GSCPTH_ALTERNATE =$00;
+ GSCPTH_WINDING =$40;
+ GSCPTH_RESET =$00;
+ GSCPTH_INTERSECT =$20;
+
+// Set Arc Parameters
+ OCODE_GSAP =$22; // Set arc parameters
+ OCODE_GPSAP =$62; // Push and set arc params
+
+type
+ ORDERS_GSAP=record // osgsap
+ p: Integer;
+ q: Integer;
+ r: Integer;
+ s: Integer;
+ end;
+
+ ORDERL_GSAP=record // olgsap
+ p: Longint;
+ q: Longint;
+ r: Longint;
+ s: Longint;
+ end;
+
+// Set Background Indexed Color
+const
+ OCODE_GSBICOL =$A7; // Set b/g indexed color
+ OCODE_GPSBICOL =$E7; // Push and set b/g ind color
+ OCODE_GSICOL =$A6; // Set indexed color
+ OCODE_GPSICOL =$E6; // Push and set indexd color
+
+
+type
+ ORDER_GSBICOL=record // ogbicol
+ fbFlags: Byte;
+ auchColor: Array[0..3-1] of Byte;
+ end;
+
+const
+ SICOL_SPECIFY =$00;
+ SICOL_SPECIAL =$40;
+ SICOL_DEFAULT =$80;
+ SICOL_BLACK =1;
+ SICOL_WHITE =2;
+ SICOL_ONES =4;
+ SICOL_ZEROES =5;
+
+// Set Character Cell
+ OCODE_GSCC =$33; // Set character cell
+ OCODE_GPSCC =$03; // Push and set char cell
+
+type
+ ORDERS_GSCC=record // osgscc
+ cxInt: Integer;
+ cyInt: Integer;
+ cxFract: Word;
+ cyFract: Word;
+ fbFlags: Byte;
+ uchReserved: Byte;
+ end;
+
+ ORDERL_GSCC=record // olgscc
+ cxInt: Longint;
+ cyInt: Longint;
+ cxFract: Word;
+ cyFract: Word;
+ fbFlags: Byte;
+ uchReserved: Byte;
+ end;
+
+const
+ GSCC_ZERODEF =$00;
+ GSCC_ZEROZERO =$80;
+
+// Set Marker Cell
+ OCODE_GSMC =$37; // Set marker cell
+ OCODE_GPSMC =$77; // Push and set marker cell
+
+type
+ ORDERS_GSMC=record // osgsmc
+ cx: Integer;
+ cy: Integer;
+ fbFlags: Byte;
+ uchReserved: Byte;
+ end;
+
+ ORDERL_GSMC=record // olgsmc
+ cx: Longint;
+ cy: Longint;
+ fbFlags: Byte;
+ uchReserved: Byte;
+ end;
+
+const
+ GSMC_ZERODEF =$00;
+ GSMC_ZEROZERO =$80;
+
+// Set Pattern Reference Point
+ OCODE_GSPRP =$A0; // Set pattern ref point
+ OCODE_GPSPRP =$E0; // Push and set patt ref pt
+
+type
+ ORDERS_GSPRP=record // osgsprp
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptPos: POINTS;
+ end;
+
+ ORDERL_GSPRP=record // olgsprp
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptPos: POINTL;
+ end;
+
+const
+ GSPRP_DEFAULT =$80;
+ GSPRP_SPECIFY =$00;
+
+
+// Set Individual Attribute
+ OCODE_GSIA =$14; // Set individual attribute
+ OCODE_GPSIA =$54; // Push and set ind attr
+
+ GSIA_VL=3;
+
+type
+ ORDER_GSIA=record // ogsia
+ uchAttrType: Byte;
+ uchPrimType: Byte;
+ fbFlags: Byte;
+ auchValue: Array[0..GSIA_VL-1] of Byte;
+ end;
+
+const
+ GSIA_COLOR =$01;
+ GSIA_BCOLOR =$02;
+ GSIA_MIX =$03;
+ GSIA_BMIX =$04;
+ GSIA_LINE =$01;
+ GSIA_CHAR =$02;
+ GSIA_MARKER =$03;
+ GSIA_PATTERN =$04;
+ GSIA_IMAGE =$05;
+ GSIA_SPECIFY =$00;
+ GSIA_SPECIAL =$40;
+ GSIA_DEFAULT =$80;
+ GSIA_BLACK =1;
+ GSIA_WHITE =2;
+ GSIA_ONES =4;
+ GSIA_ZEROES =5;
+
+
+// Set Model /Viewing Transform
+ OCODE_GSTM =$24; // Set model transform
+ OCODE_GPSTM =$64; // Push and set model tfm
+
+ OCODE_GSTV =$31; // Set Viewing Transform
+
+ GSTM_ML =16;
+
+type
+ ORDERS_GSTM=record // osgstm
+ uchReserved: Byte;
+ fbFlags: Byte;
+ fsMask: Word;
+ asMatrix: Array[0..GSTM_ML-1] of Integer;
+ end;
+
+ ORDERL_GSTM=record // olgstm
+ uchReserved: Byte;
+ fbFlags: Byte;
+ fsMask: Word;
+ alMatrix: Array[0..GSTM_ML-1] of Longint;
+ end;
+
+const
+ GSTM_M11 =$8000;
+ GSTM_M12 =$4000;
+ GSTM_M13 =$2000;
+ GSTM_M14 =$1000;
+ GSTM_M21 =$0800;
+ GSTM_M22 =$0400;
+ GSTM_M23 =$0200;
+ GSTM_M24 =$0100;
+ GSTM_M31 =$0080;
+ GSTM_M32 =$0040;
+ GSTM_M33 =$0020;
+ GSTM_M34 =$0010;
+ GSTM_M41 =$0008;
+ GSTM_M42 =$0004;
+ GSTM_M43 =$0002;
+ GSTM_M44 =$0001;
+
+ GSTM_UNITY =$00;
+ GSTM_AFTER =$01;
+ GSTM_BEFORE =$02;
+ GSTM_OVERWRITE =$03;
+
+ GSTV_OVERWRITE =$00;
+ GSTV_AFTER =$04;
+
+// Set Segment Boundary, Viewing Window
+ OCODE_GSSB =$32; // Set segment boundary
+ OCODE_GSVW =$27; // Set viewing window
+ OCODE_GPSVW =$67; // Push and set view window
+
+ GSSB_ML =4;
+
+type
+ ORDERS_GSSB=record // osgssb
+ fbFlags: Byte;
+ fbMask: Byte;
+ alMatrix: Array[0..GSSB_ML-1] of Integer;
+ end;
+
+ ORDERL_GSSB=record // olgssb
+ fbFLags: Byte;
+ fbMask: Byte;
+ alMatrix: Array[0..GSSB_ML-1] of Longint;
+ end;
+
+const
+ GSSB_XLEFT =$20;
+ GSSB_XRIGHT =$10;
+ GSSB_YBOTTOM =$08;
+ GSSB_YTOP =$04;
+
+ GSVW_INTERSECT =$00;
+ GSVW_REPLACE =$80;
+
+// Set Segment Characteristics
+ OCODE_GSGCH =$04; // Set segment characteristics
+
+ GSGCH_ML =254;
+
+type
+ ORDER_GSGCH=record // ogsgch
+ uchIdent: Byte;
+ auchData: Array[0..GSGCH_ML-1] of Byte;
+ end;
+
+// Set Stroke Line Width
+const
+ OCODE_GSSLW =$15; // Set stroke line width
+ OCODE_GPSSLW =$55; // Push and set strk l width
+
+type
+ ORDERS_GSSLW=record // osgsslw
+ fbFlags: Byte;
+ uchReserved: Byte;
+ LineWidth: Integer;
+ end;
+
+type
+ ORDERL_GSSLW=record // olgsslw
+ fbFlags: Byte;
+ uchReserved: Byte;
+ LineWidth: Longint;
+ end;
+
+const
+ GSSLW_DEFAULT =$80;
+ GSSLW_SPECIFY =$00;
+
+// Sharp Fillet at Current Position
+ OCODE_GCSFLT =$A4; // Sharp fillet at curr pos
+ OCODE_GSFLT =$E4; // Sharp fillet at given pos
+
+ GCSFLT_SMF =21;
+ GSFLT_SMF =20;
+
+type
+ ORDERS_GCSFLT=record // osgcsflt
+ apt: Array[0..2*GCSFLT_SMF-1] of POINTS;
+ afxSharpness: Array[0..GCSFLT_SMF-1] of FIXED;
+ end;
+
+const
+ GCSFLT_LMF = 12;
+ GSFLT_LMF = 12;
+
+type
+ ORDERL_GCSFLT=record // olgcsflt
+ apt: Array[0..2*GCSFLT_SMF-1] of POINTL;
+ afxSharpness: Array[0..GCSFLT_SMF-1] of FIXED;
+ end;
+
+// Bitblt
+const
+ OCODE_GBBLT =$D6; // Bitblt
+
+type
+ ORDERS_GBBLT=record // osgbblt
+ fsFlags: Word;
+ usMix: Word;
+ hbmSrc: HBITMAP;
+ lOptions: Longint;
+ rcsTargetRect: RECT1S;
+ rclSourceRect: RECTL;
+ end;
+
+ ORDERL_GBBLT=record // olgbblt
+ fsFlags: Word;
+ usMix: Word;
+ hbmSrc: HBITMAP;
+ lOptions: Longint;
+ rclTargetRect: RECTL;
+ rclSourceRect: RECTL;
+ end;
+
+// Char & break extra
+const
+ OCODE_GSCE =$17; // Set char extra
+ OCODE_GPSCE =$57; // Push and set char extra
+ OCODE_GSCBE =$05; // Set char break extra
+ OCODE_GPSCBE =$45; // Push and set char break extra
+
+type
+ ORDER_GSCBE=record // osgsce
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ufxextra: FIXED;
+ end;
+ ORDER_GSCE=ORDER_GSCBE;
+ ORDER_GPSCE=ORDER_GSCBE;
+ ORDER_GPSCBE=ORDER_GSCBE;
+
+// Escape
+const
+ OCODE_GESCP =$D5; // Escape
+
+
+//* type describes type of escape order, identifier gives the escape
+//* order if the type is registered
+const
+ GESCP_ML = 253;
+
+type
+ ORDER_GESCP=record // ogescp
+ uchType: Byte;
+ uchIdent: Byte;
+ auchData: Array[0..GESCP_ML-1] of Byte; // Escape data
+ end;
+
+const
+ GESCP_REG =$80; // identifier is registered
+
+// Escape (Bitblt)
+const
+ GEBB_REGID =$02; // uchIdent - Bitblt
+
+ ETYPE_GEBB =$800200D5;
+
+ GEBB_LMP =29;
+
+type
+ ORDERL_GEBB=record // olgebb
+ fbFlags: Byte;
+ usMix: Word;
+ cPoints: Byte;
+ hbmSrc: HBITMAP;
+ lReserved: Longint;
+ lOptions: Longint;
+ aptPoints: Array[0..GEBB_LMP-1] of POINTL;
+ end;
+
+// Escape (Set Pel)
+const
+ GEPEL_REGID =$01; // uchIdent - Set Pel
+
+ ETYPE_GEPEL =$800100D5;
+
+// Escape (DrawBits)
+ GEDB_REGID =$04; // uchIdent - DrawBits
+
+ ETYPE_GEDB =$800400D5;
+
+type
+ ORDERL_GEDB=record // olgedb
+ fsFlags: Word;
+ usMix: Word;
+ pBits: Pointer;
+ pbmi: PBITMAPINFO2;
+ lOptions: Longint;
+ rclTargetRect: RECTL;
+ rclSourceRect: RECTL;
+ end;
+
+// Escape (FloodFill)
+const
+ GEFF_REGID =$03; // uchIdent - FloodFill
+
+ ETYPE_GEFF =$800300D5;
+
+type
+ ORDERL_GEFF=record // olgeff
+ fsFlags: Byte;
+ auchColor: Array[0..3-1] of Byte;
+ end;
+
+// Element Types for attribute bundles
+const
+ ETYPE_LINEBUNDLE =$0000FD01;
+ ETYPE_CHARBUNDLE =$0000FD02;
+ ETYPE_MARKERBUNDLE =$0000FD03;
+ ETYPE_AREABUNDLE =$0000FD04;
+ ETYPE_IMAGEBUNDLE =$0000FD05;
+
+//***************************************************************************\
+//*
+//* Very long orders
+//*
+//***************************************************************************/
+
+// macro to tell whether this is a very long order
+{$define VLONG_ORDER(oc):=((oc)=OCODE_VLONG)}
+
+// Very long order structure
+const
+ VORDER_ML =65531;
+
+type
+ VORDER=record // vord
+ idCode: Byte;
+ uchQualifier: Byte;
+ uchLength: SWPUSHORT;
+ uchData: Array[0..VORDER_ML-1] of Byte;
+ end;
+
+// Character String Extended
+const
+ OCODEQ_GCCHSTE =$B0; // Qualifier - current posn
+ OCODEQ_GCHSTE =$F0; // Qualifier - given position
+ OCODEQ_GTCHSPA =$F4; // Tabbed Char String At
+
+ ETYPE_GCCHSTE =$0000FEB0;
+ ETYPE_GCHSTE =$0000FEF0;
+
+type
+ ORDERS_GCCHSTE=record // osgcchste
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptRect: Array[0..2-1] of POINTS;
+ cchString: SWPUSHORT;
+ achString: Array[0..1-1] of Char;
+ adx: Array[0..1-1] of Integer;
+ end;
+
+ ORDERL_GCCHSTE=record // olgcchste
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptRect: Array[0..2-1] of POINTL;
+ cchString: SWPUSHORT;
+ achString: Array[0..1-1] of Char;
+ adx: Array[0..1-1] of Longint;
+ end;
+
+ ORDERL_GTCHSPA=record // olgcchspa
+ fbFlags: Byte;
+ uchReserved: Byte;
+ ptRect: Array[0..2-1] of POINTL;
+ cchString: SWPUSHORT;
+ achString: Array[0..1-1] of Char;
+ adx: Array[0..2-1] of Longint;
+ tabs: Array[0..1-1] of Longint;
+ end;
+
+const
+ GCCHSTE_DRAWRECT =$80;
+ GCCHSTE_NORECT =$00;
+ GCCHSTE_CLIP =$40;
+ GCCHSTE_NOCLIP =$00;
+ GCCHSTE_DEEMPHASIZE =$20; // Reserved
+ GCCHSTE_NODEEMPHASIZE =$00;
+ GCCHSTE_LEAVEPOS =$10;
+ GCCHSTE_MOVEPOS =$00;
+ GCCHSTE_UNDERSCORE =$08;
+ GCCHSTE_NOUNDERSCORE =$00;
+ GCCHSTE_STRIKEOUT =$04;
+ GCCHSTE_NOSTRIKEOUT =$00;
+ GTCHSPA_STARTPOS =$02;
+ GTCHSPA_NOSTARTPOS =$00;
+
+// Extended Escape
+ OCODEQ_GEESCP =$D5; // Qualifier - extended escape
+
+ GEESCP_ML =65533;
+
+type
+ ORDER_GEESCP=record // ogeescp
+ uchType: Byte;
+ uchIdent: Byte;
+ auchData: Array[0..GEESCP_ML-1] of Byte;
+ end;
+
+//#pragma pack() /* reset to default packing */
+
+
+
+function GpiCreatePS(hab,hdc : cardinal;var psizlSize : SIZEL;flOptions : cardinal) : cardinal;cdecl;
+function GpiDestroyPS(hps : cardinal) : longbool;cdecl;
+function GpiAssociate(hps,hdc : cardinal) : longbool;cdecl;
+function GpiRestorePS(hps : cardinal;lPSid : longint) : longbool;cdecl;
+function GpiSavePS(hps : cardinal) : longint;cdecl;
+function GpiErase(hps : cardinal) : longbool;cdecl;
+function GpiQueryDevice(hps : cardinal) : cardinal;cdecl;
+function GpiResetPS(hps,flOptions : cardinal) : longbool;cdecl;
+function GpiSetPS(hps : cardinal;var psizlsize : SIZEL;flOptions : cardinal) : longbool;cdecl;
+function GpiQueryPS(hps : cardinal;var psizlSize : SIZEL) : cardinal;cdecl;
+function GpiErrorSegmentData(hps : cardinal;var plSegment,plContext : longint) : longint; cdecl;
+function GpiQueryDrawControl(hps : cardinal;lControl : longint) : longint;cdecl;
+function GpiSetDrawControl(hps : cardinal;lControl,lValue : longint) : longbool;cdecl;
+function GpiQueryDrawingMode(hps : cardinal) : longint;cdecl;
+function GpiSetDrawingMode(hps : cardinal;lMode : longint) : longbool;cdecl;
+function GpiQueryStopDraw(hps : cardinal) : longint;cdecl;
+function GpiSetStopDraw(hps : cardinal;lValue : longint) : longbool;cdecl;
+function GpiCorrelateChain(hps : cardinal;lType : longint;var pptlPick : POINTL;lMaxHits,lMaxDepth : longint;var pl2 : longint) : longint;cdecl;
+function GpiQueryTag(hps : cardinal;var plTag : longint) : longbool;cdecl;
+function GpiSetTag(hps : cardinal;lTag : longint) : longbool;cdecl;
+function GpiQueryPickApertureSize(hps : cardinal;var psizlSize : SIZEL) : longbool; cdecl;
+function GpiSetPickApertureSize(hps : cardinal;lOptions : longint;var psizlSize : SIZEL) : longbool; cdecl;
+function GpiQueryPickAperturePosition(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl;
+function GpiSetPickAperturePosition(hps : cardinal;var pptlPick : POINTL) : longbool; cdecl;
+function GpiQueryBoundaryData(hps : cardinal;var prclBoundary : RECTL) : longbool; cdecl;
+function GpiResetBoundaryData(hps : cardinal) : longbool; cdecl;
+function GpiCorrelateFrom(hps : cardinal;lFirstSegment,lLastSegment,lType : longint;var pptlPick : POINTL;lMaxHits,lMaxDepth : longint;var plSegTag : longint) : longint; cdecl;
+function GpiCorrelateSegment(hps : cardinal;lSegment,lType : longint;var pptlPick : POINTL;lMaxHits,lMaxDepth : longint;var alSegTag : longint) : longint; cdecl;
+function GpiOpenSegment(hps : cardinal;lSegment : longint) : longbool; cdecl;
+function GpiCloseSegment(hps : cardinal) : longbool; cdecl;
+function GpiDeleteSegment(hps : cardinal;lSegid : longint) : longbool; cdecl;
+function GpiQueryInitialSegmentAttrs(hps : cardinal;lAttribute : longint) : longint; cdecl;
+function GpiSetInitialSegmentAttrs(hps : cardinal;lAttribute,lValue : longint) : longbool; cdecl;
+function GpiQuerySegmentAttrs(hps : cardinal;lSegid,lAttribute : longint) : longint; cdecl;
+function GpiSetSegmentAttrs(hps : cardinal;lSegid,lAttribute,lValue : longint) : longbool; cdecl;
+function GpiQuerySegmentPriority(hps : cardinal;lRefSegid,lOrder : longint) : longint; cdecl;
+function GpiSetSegmentPriority(hps : cardinal;lSegid,lRefSegid,lOrder : longint) : longbool; cdecl;
+function GpiDeleteSegments(hps : cardinal;lFirstSegment,lLastSegment : longint) : longbool; cdecl;
+function GpiQuerySegmentNames(hps : cardinal;lFirstSegid,lLastSegid,lMax : longint;var alSegids : longint) : longint; cdecl;
+function GpiGetData(hps : cardinal;lSegid : longint;var plOffset : longint;lFormat,lLength : longint;var pbData : BYTE) : longint; cdecl;
+function GpiPutData(hps : cardinal;lFormat : longint;var plCount : longint;var pbData : BYTE) : longint; cdecl;
+function GpiDrawChain(hps : cardinal) : longbool; cdecl;
+function GpiDrawFrom(hps : cardinal;lFirstSegment,lLastSegment : longint) : longbool; cdecl;
+function GpiDrawSegment(hps : cardinal;lSegment : longint) : longbool; cdecl;
+function GpiDrawDynamics(hps : cardinal) : longbool; cdecl;
+function GpiRemoveDynamics(hps : cardinal;lFirstSegid,lLastSegid : longint) : longbool; cdecl;
+function GpiBeginElement(hps : cardinal;lType : longint;pszDesc : pchar) : longbool; cdecl;
+function GpiEndElement(hps : cardinal) : longbool; cdecl;
+function GpiLabel(hps : cardinal;lLabel : longint) : longbool; cdecl;
+function GpiElement(hps : cardinal;lType : longint;pszDesc : pchar;lLength : longint;var pbData : BYTE) : longint; cdecl;
+function GpiQueryElement(hps : cardinal;lOff,lMaxLength : longint;var pbData : BYTE) : longint; cdecl;
+function GpiDeleteElement(hps : cardinal) : longbool; cdecl;
+function GpiDeleteElementRange(hps : cardinal;lFirstElement,lLastElement : longint) : longbool; cdecl;
+function GpiDeleteElementsBetweenLabels(hps : cardinal;lFirstLabel,lLastLabel : longint) : longbool; cdecl;
+function GpiQueryEditMode(hps : cardinal) : longint; cdecl;
+function GpiSetEditMode(hps : cardinal;lMode : longint) : longbool; cdecl;
+function GpiQueryElementPointer(hps : cardinal) : longint; cdecl;
+function GpiSetElementPointer(hps : cardinal;lElement : longint) : longbool; cdecl;
+function GpiOffsetElementPointer(hps : cardinal;loffset : longint) : longbool; cdecl;
+function GpiQueryElementType(hps : cardinal;var plType : longint;lLength : longint;pszData : pchar) : longint; cdecl;
+function GpiSetElementPointerAtLabel(hps : cardinal;lLabel : longint) : longbool; cdecl;
+function GpiQuerySegmentTransformMatrix(hps : cardinal;lSegid,lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl;
+function GpiSetSegmentTransformMatrix(hps : cardinal;lSegid,lCount : longint;var pmatlfarray : MATRIXLF;lOptions : longint) : longbool; cdecl;
+function GpiConvert(hps : cardinal;lSrc,lTarg,lCount : longint;var aptlPoints : POINTL) : longbool; cdecl;
+function GpiConvertWithMatrix(hps : cardinal;lCountp : longint;var aptlPoints : POINTL;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl;
+function GpiQueryModelTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl;
+function GpiSetModelTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF;lOptions : longint) : longbool; cdecl;
+function GpiCallSegmentMatrix(hps : cardinal;lSegment,lCount : longint;var pmatlfArray : MATRIXLF;lOptions : longint) : longint; cdecl;
+function GpiQueryDefaultViewMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl;
+function GpiSetDefaultViewMatrix(hps : cardinal;lCount : longint;var pmatlfarray : MATRIXLF;lOptions : longint) : longbool; cdecl;
+function GpiQueryPageViewport(hps : cardinal;var prclViewport : RECTL) : longbool; cdecl;
+function GpiSetPageViewport(hps : cardinal;var prclViewport : RECTL) : longbool; cdecl;
+function GpiQueryViewingTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl;
+function GpiSetViewingTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF;lOptions : longint) : longbool; cdecl;
+function GpiTranslate(hps : cardinal;var pmatrixlf : MATRIXLF;long : longint;var ppointl : POINTL) : longbool; cdecl;
+function GpiScale(hps : cardinal;var p1 : MATRIXLF;p2 : longint;var p3 : longint;var p4 : POINTL) : longbool; cdecl;
+function GpiRotate(p1 : cardinal;var p2 : MATRIXLF;p3,p4 : longint;var p5 : POINTL) : longbool; cdecl;
+function GpiSetGraphicsField(hps : cardinal;var prclField : RECTL) : longbool; cdecl;
+function GpiQueryGraphicsField(hps : cardinal;var prclField : RECTL) : longbool; cdecl;
+function GpiSetViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl;
+function GpiQueryViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl;
+function GpiBeginPath(hps : cardinal;lPath : longint) : longbool; cdecl;
+function GpiEndPath(hps : cardinal) : longbool; cdecl;
+function GpiCloseFigure(hps : cardinal) : longbool; cdecl;
+function GpiModifyPath(hps : cardinal;lPath,lMode : longint) : longbool; cdecl;
+function GpiFillPath(hps : cardinal;lPath,lOptions : longint) : longint; cdecl;
+function GpiSetClipPath(hps : cardinal;lPath,lOptions : longint) : longbool; cdecl;
+function GpiOutlinePath(hps : cardinal;lPath,lOptions : longint) : longint; cdecl;
+function GpiPathToRegion(GpiH : cardinal;lPath,lOptions : longint) : cardinal; cdecl;
+function GpiStrokePath(hps : cardinal;lPath : longint;flOptions : cardinal) : longint; cdecl;
+function GpiCreateLogColorTable(hps,flOptions : cardinal;lFormat,lStart,lCount : longint;var alTable : longint) : longbool; cdecl;
+function GpiQueryColorData(hps : cardinal;lCount : longint;var alArray : longint) : longbool; cdecl;
+function GpiQueryLogColorTable(hps,flOptions : cardinal;lStart,lCount : longint;var alArray : longint) : longint; cdecl;
+function GpiQueryRealColors(hps,flOptions : cardinal;lStart,lCount : longint;var alColors : longint) : longint; cdecl;
+function GpiQueryNearestColor(hps,flOptions : cardinal;lRgbIn : longint) : longint; cdecl;
+function GpiQueryColorIndex(hps,flOptions : cardinal;lRgbColor : longint) : longint; cdecl;
+function GpiQueryRGBColor(hps,flOptions : cardinal;lColorIndex : longint) : longint; cdecl;
+function GpiCreatePalette(hab,flOptions,ulFormat,ulCount : cardinal;var aulTable) : cardinal; cdecl;
+function GpiDeletePalette(hpal : cardinal) : longbool; cdecl;
+function GpiSelectPalette(hps,hpal : cardinal) : cardinal; cdecl;
+function GpiAnimatePalette(hpal,ulFormat,ulStart,ulCount : cardinal;var aulTable) : longint; cdecl;
+function GpiSetPaletteEntries(hpal,ulFormat,ulStart,ulCount : cardinal;var aulTable) : longbool; cdecl;
+function GpiQueryPalette(hps : cardinal) : cardinal; cdecl;
+function GpiQueryPaletteInfo(hpal,hps,flOptions,ulStart,ulCount : cardinal;var aulArray) : longint; cdecl;
+function GpiSetColor(hps : cardinal;lColor : longint) : longbool; cdecl;
+function GpiQueryColor(hps : cardinal) : longint; cdecl;
+function GpiBox(hps : cardinal;lControl : longint;var pptlPoint : POINTL;lHRound,lVRound : longint) : longint; cdecl;
+function GpiMove(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl;
+function GpiLine(hps : cardinal;var pptlEndPoint : POINTL) : longint; cdecl;
+function GpiPolyLine(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl;
+function GpiPolyLineDisjoint(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl;
+function GpiSetPattern(hps : cardinal;lPatternSymbol : longint) : longbool; cdecl;
+function GpiQueryPattern(hps : cardinal) : longint; cdecl;
+function GpiBeginArea(hps,flOptions : cardinal) : longbool; cdecl;
+function GpiEndArea(hps : cardinal) : longint; cdecl;
+function GpiCharString(hps : cardinal;lCount : longint;pchString : pchar) : longint; cdecl;
+function GpiCharStringAt(hps : cardinal;var pptlPoint : POINTL;lCount : longint;pchString : pchar) : longint; cdecl;
+function GpiSetAttrMode(hps : cardinal;lMode : longint) : longbool; cdecl;
+function GpiQueryAttrMode(hps : cardinal) : longint; cdecl;
+function GpiSetAttrs(hps : cardinal;lPrimType : longint;flAttrMask,flDefMask : cardinal;ppbunAttrs : pointer) : longbool; cdecl;
+function GpiQueryAttrs(hps : cardinal;lPrimType : longint;flAttrMask : cardinal;ppbunAttrs : pointer) : longint; cdecl;
+function GpiSetBackColor(hps : cardinal;lColor : longint) : longbool; cdecl;
+function GpiQueryBackColor(hps : cardinal) : longint; cdecl;
+function GpiSetMix(hps : cardinal;lMixMode : longint) : longbool; cdecl;
+function GpiQueryMix(hps : cardinal) : longint; cdecl;
+function GpiSetBackMix(hps : cardinal;lMixMode : longint) : longbool; cdecl;
+function GpiQueryBackMix(hps : cardinal) : longint; cdecl;
+function GpiSetLineType(hps : cardinal;lLineType : longint) : longbool; cdecl;
+function GpiQueryLineType(hps : cardinal) : longint; cdecl;
+function GpiSetLineWidth(hps : cardinal;fxLineWidth : longint) : longbool; cdecl;
+function GpiQueryLineWidth(hps : cardinal) : longint; cdecl;
+function GpiSetLineWidthGeom(hps : cardinal;lLineWidth : longint) : longbool; cdecl;
+function GpiQueryLineWidthGeom(hps : cardinal) : longint; cdecl;
+function GpiSetLineEnd(hps : cardinal;lLineEnd : longint) : longbool; cdecl;
+function GpiQueryLineEnd(hps : cardinal) : longint; cdecl;
+function GpiSetLineJoin(hps : cardinal;lLineJoin : longint) : longbool; cdecl;
+function GpiQueryLineJoin(hps : cardinal) : longint; cdecl;
+function GpiSetCurrentPosition(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl;
+function GpiQueryCurrentPosition(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl;
+function GpiSetArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl;
+function GpiQueryArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl;
+function GpiPointArc(hps : cardinal;var pptl2 : POINTL) : longint; cdecl;
+function GpiFullArc(hps : cardinal;lControl,fxMultiplier : longint) : longint; cdecl;
+function GpiPartialArc(hps : cardinal;var pptlCenter : POINTL;fxMultiplier,fxStartAngle,fxSweepAngle : longint) : longint; cdecl;
+function GpiPolyFillet(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl;
+function GpiPolySpline(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl;
+function GpiPolyFilletSharp(hps : cardinal;lCount : longint;var aptlPoints : POINTL;var afxPoints : longint) : longint; cdecl;
+function GpiSetPatternSet(hps : cardinal;lSet : longint) : longbool; cdecl;
+function GpiQueryPatternSet(hps : cardinal) : longint; cdecl;
+function GpiSetPatternRefPoint(hps : cardinal;var pptlRefPoint : POINTL) : longbool; cdecl;
+function GpiQueryPatternRefPoint(hps : cardinal;var pptlRefPoint : POINTL) : longbool; cdecl;
+function GpiQueryCharStringPos(hps,flOptions : cardinal;lCount : longint;pchString : pchar;var alXincrements : longint;var aptlPositions : POINTL) : longbool; cdecl;
+function GpiQueryCharStringPosAt(hps : cardinal;var pptlStart : POINTL;flOptions : cardinal;lCount : longint;pchString : pchar;var alXincrements : longint;var aptlPositions : POINTL) : longbool; cdecl;
+function GpiQueryTextBox(hps : cardinal;lCount1 : longint;pchString : pchar;lCount2 : longint;var aptlPoints : POINTL) : longbool; cdecl;
+function GpiQueryDefCharBox(hps : cardinal;var psizlSize : SIZEL) : longbool; cdecl;
+function GpiSetCharSet(hps : cardinal;llcid : longint) : longbool; cdecl;
+function GpiQueryCharSet(hps : cardinal) : longint; cdecl;
+function GpiSetCharBox(hps : cardinal;var psizfxBox : SIZEF) : longbool; cdecl;
+function GpiQueryCharBox(hps : cardinal;var psizfxSize : SIZEF) : longbool; cdecl;
+function GpiSetCharAngle(hps : cardinal;var pgradlAngle : GRADIENTL) : longbool; cdecl;
+function GpiQueryCharAngle(hps : cardinal;var pgradlAngle : GRADIENTL) : longbool; cdecl;
+function GpiSetCharShear(hps : cardinal;var pptlAngle : POINTL) : longbool; cdecl;
+function GpiQueryCharShear(hps : cardinal;var pptlShear : POINTL) : longbool; cdecl;
+function GpiSetCharDirection(hps : cardinal;lDirection : longint) : longbool; cdecl;
+function GpiQueryCharDirection(hps : cardinal) : longint; cdecl;
+function GpiSetCharMode(hps : cardinal;lMode : longint) : longbool; cdecl;
+function GpiQueryCharMode(hps : cardinal) : longint; cdecl;
+function GpiSetTextAlignment(hps : cardinal;lHoriz,lVert : longint) : longbool; cdecl;
+function GpiQueryTextAlignment(hps : cardinal;var plHoriz,plVert : longint) : longbool; cdecl;
+function GpiCharStringPos(hps : cardinal;var prclRect : RECTL;flOptions : cardinal;lCount : longint;pchString : pchar;var alAdx : longint) : longint; cdecl;
+function GpiCharStringPosAt(hps : cardinal;var pptlStart : POINTL;var prclRect : RECTL;flOptions : cardinal;lCount : longint;pchString : pchar;var alAdx : longint) : longint; cdecl;
+function GpiSetCharExtra(hps : cardinal;Extra : longint) : longbool; cdecl;
+function GpiSetCharBreakExtra(hps : cardinal;BreakExtra : longint) : longbool; cdecl;
+function GpiQueryCharExtra(hps : cardinal;var Extra : longint) : longbool; cdecl;
+function GpiQueryCharBreakExtra(hps : cardinal;var BreakExtra : longint) : longbool; cdecl;
+function GpiMarker(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl;
+function GpiPolyMarker(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl;
+function GpiSetMarker(hps : cardinal;lSymbol : longint) : longbool; cdecl;
+function GpiSetMarkerBox(hps : cardinal;var psizfxSize : SIZEF) : longbool; cdecl;
+function GpiSetMarkerSet(hps : cardinal;lSet : longint) : longbool; cdecl;
+function GpiQueryMarker(hps : cardinal) : longint; cdecl;
+function GpiQueryMarkerBox(hps : cardinal;var psizfxSize : SIZEF) : longbool; cdecl;
+function GpiQueryMarkerSet(hps : cardinal) : longint; cdecl;
+function GpiImage(hps : cardinal;lFormat : longint;var psizlImageSize : SIZEL;lLength : longint;var pbData : BYTE) : longint; cdecl;
+function GpiPop(hps : cardinal;lCount : longint) : longbool; cdecl;
+function GpiPtVisible(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl;
+function GpiRectVisible(hps : cardinal;var prclRectangle : RECTL) : longint; cdecl;
+function GpiComment(hps : cardinal;lLength : longint;var pbData : BYTE) : longbool; cdecl;
+function GpiCreateLogFont(hps : cardinal;var pName : STR8;lLcid : longint;var pfatAttrs : FATTRS) : longint; cdecl;
+function GpiDeleteSetId(hps : cardinal;lLcid : longint) : longbool; cdecl;
+function GpiLoadFonts(hab : cardinal;pszFilename : pchar) : longbool; cdecl;
+function GpiUnloadFonts(hab : cardinal;pszFilename : pchar) : longbool; cdecl;
+function GpiQueryFonts(hps,flOptions : cardinal;pszFacename : pchar;var plReqFonts : longint;lMetricsLength : longint;var afmMetrics : FONTMETRICS) : longint; cdecl;
+function GpiQueryFontMetrics(hps : cardinal;lMetricsLength : longint;var pfmMetrics : FONTMETRICS) : longbool; cdecl;
+function GpiQueryKerningPairs(hps : cardinal;lCount : longint;var akrnprData : KERNINGPAIRS) : longint; cdecl;
+function GpiQueryWidthTable(hps : cardinal;lFirstChar,lCount : longint;var alData : longint) : longbool; cdecl;
+function GpiQueryNumberSetIds(hps : cardinal) : longint; cdecl;
+function GpiQuerySetIds(hps : cardinal;lCount : longint;var alTypes : longint;var aNames : STR8;var allcids : longint) : longbool; cdecl;
+function GpiQueryFaceString(PS : cardinal;FamilyName : pchar;var attrs : FACENAMEDESC;length : longint;CompoundFaceName : pchar) : cardinal; cdecl;
+function GpiQueryLogicalFont(PS : cardinal;lcid : longint;var name : STR8;var attrs : FATTRS;length : longint) : longbool; cdecl;
+function GpiQueryFontAction(anchor,options : cardinal) : cardinal; cdecl;
+function GpiLoadPublicFonts(p1 : cardinal;p2 : pchar):longbool; cdecl;
+function GpiUnloadPublicFonts(p1 : cardinal;p2 : pchar) : longbool; cdecl;
+function GpiSetCp(hps,ulCodePage : cardinal) : longbool; cdecl;
+function GpiQueryCp(hps : cardinal) : cardinal; cdecl;
+function GpiQueryFontFileDescriptions(hab : cardinal;pszFilename : pchar;var plCount : longint;var affdescsNames : FFDESCS) : longint; cdecl;
+function GpiQueryFullFontFileDescs(hab : cardinal;pszFilename : pchar;var plCount : longint;pNames : pointer;var plNamesBuffLength : longint) : longint; cdecl;
+function GpiBitBlt(hpsTarget,hpsSource : cardinal;lCount : longint;var aptlPoints : POINTL;lRop : longint;flOptions : cardinal) : longint; cdecl;
+function GpiDeleteBitmap(hbm : cardinal) : longbool; cdecl;
+function GpiLoadBitmap(hps,Resource,idBitmap : cardinal;lWidth,lHeight : longint) : cardinal; cdecl;
+function GpiSetBitmap(hps,hbm : cardinal) : cardinal; cdecl;
+function GpiWCBitBlt(hpsTarget,hbmSource : cardinal;lCount : longint;var aptlPoints : POINTL;lRop : longint;flOptions : cardinal) : longint; cdecl;
+function GpiCreateBitmap(hps : cardinal;var pbmpNew : Tbitmapinfoheader2;flOptions : cardinal;var pbInitData : BYTE;var pbmiInfoTable : Tbitmapinfo2) : cardinal; cdecl;
+function GpiSetBitmapBits(hps : cardinal;lScanStart,lScans : longint;var pbBuffer : BYTE;var pbmiInfoTable : Tbitmapinfo2) : longint; cdecl;
+function GpiSetBitmapDimension(hbm : cardinal;var psizlBitmapDimension : SIZEL) : longbool; cdecl;
+function GpiSetBitmapId(hps,hbm : cardinal;lLcid : longint) : longbool; cdecl;
+function GpiQueryBitmapBits(hps : cardinal;lScanStart,lScans : longint;var pbBuffer : BYTE;var pbmiInfoTable :Tbitmapinfo2) : longint; cdecl;
+function GpiQueryBitmapDimension(hbm : cardinal;var psizlBitmapDimension : SIZEL) : longbool; cdecl;
+function GpiQueryBitmapHandle(hps : cardinal;lLcid : longint) : cardinal; cdecl;
+function GpiQueryBitmapParameters(hbm : cardinal;var pbmpData : Tbitmapinfoheader) : longbool; cdecl;
+function GpiQueryBitmapInfoHeader(hbm : cardinal;var pbmpData : Tbitmapinfoheader2) : longbool; cdecl;
+function GpiQueryDeviceBitmapFormats(hps : cardinal;lCount : longint;var alArray : longint) : longbool; cdecl;
+function GpiSetPel(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl;
+function GpiQueryPel(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl;
+function GpiFloodFill(hps : cardinal;lOptions,lColor : longint) : longint; cdecl;
+function GpiDrawBits(hps : cardinal;pBits : pointer;var pbmiInfoTable :Tbitmapinfo2;lCount : longint;var aptlPoints : POINTL;lRop : longint;flOptions : cardinal) : longint; cdecl;
+function GpiCombineRegion(hps,hrgnDest,hrgnSrc1,hrgnSrc2 : cardinal;lMode : longint) : longint; cdecl;
+function GpiCreateRegion(hps : cardinal;lCount : longint;var arclRectangles : RECTL) : cardinal; cdecl;
+function GpiDestroyRegion(hps,hrgn : cardinal) : longbool; cdecl;
+function GpiEqualRegion(hps,hrgnSrc1,hrgnSrc2 : cardinal) : longint; cdecl;
+function GpiOffsetRegion(hps,Hrgn : cardinal;var pptlOffset : POINTL) : longbool; cdecl;
+function GpiPaintRegion(hps,hrgn : cardinal) : longint; cdecl;
+function GpiFrameRegion(hps,hrgn : cardinal;var thickness : SIZEL) : longint; cdecl;
+function GpiPtInRegion(hps,hrgn : cardinal;var pptlPoint : POINTL) : longint; cdecl;
+function GpiQueryRegionBox(hps,hrgn : cardinal;var prclBound : RECTL) : longint; cdecl;
+function GpiQueryRegionRects(hps,hrgn : cardinal;var prclBound : RECTL;var prgnrcControl : RGNRECT;var prclRect : RECTL) : longbool; cdecl;
+function GpiRectInRegion(hps,hrgn : cardinal;var prclRect : RECTL) : longint; cdecl;
+function GpiSetRegion(hps,hrgn : cardinal;lcount : longint;var arclRectangles : RECTL) : longbool;cdecl;
+function GpiSetClipRegion(hps,hrgn : cardinal;var phrgnOld : cardinal) : longint; cdecl;
+function GpiQueryClipRegion(hps : cardinal) : cardinal; cdecl;
+function GpiQueryClipBox(hps : cardinal;var prclBound : RECTL) : longint; cdecl;
+function GpiExcludeClipRectangle(hps : cardinal;var prclRectangle : RECTL) : longint; cdecl;
+function GpiIntersectClipRectangle(hps : cardinal;var prclRectangle : RECTL) : longint; cdecl;
+function GpiOffsetClipRegion(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl;
+function GpiCopyMetaFile(hmf : cardinal) : cardinal; cdecl;
+function GpiDeleteMetaFile(hmf : cardinal) : longbool; cdecl;
+function GpiLoadMetaFile(hab : cardinal;pszFilename : pchar) : cardinal; cdecl;
+function GpiPlayMetaFile(hps,hmf : cardinal;lCount1 : longint;var alOptarray,plSegCount : longint;lCount2 : longint;pszDesc : pchar) : longint; cdecl;
+function GpiQueryMetaFileBits(hmf : cardinal;lOffset,lLength : longint;var pbData : BYTE) : longbool; cdecl;
+function GpiQueryMetaFileLength(hmf : cardinal) : longint; cdecl;
+function GpiSaveMetaFile(hmf : cardinal;pszFilename : pchar) : longbool; cdecl;
+function GpiSetMetaFileBits(hmf : cardinal;lOffset,lLength : longint;var pbBuffer : BYTE) : longbool; cdecl;
+function GpiQueryDefArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl;
+function GpiQueryDefAttrs(hps : cardinal;lPrimType : longint;flAttrMask : cardinal;ppbunAttrs : pointer) : longbool; cdecl;
+function GpiQueryDefTag(hps : cardinal;var plTag : longint) : longbool; cdecl;
+function GpiQueryDefViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl;
+function GpiSetDefArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl;
+function GpiSetDefAttrs(hps : cardinal;lPrimType : longint;flAttrMask : cardinal;ppbunAttrs : pointer) : longbool;cdecl;
+function GpiSetDefTag(hps : cardinal;lTag : longint) : longbool; cdecl;
+function GpiSetDefViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl;
+function GpiPolygons(hps,ulCount : cardinal;var paplgn : POLYGON;flOptions,flModel : cardinal) : longint; cdecl;
+
+implementation
+
+function GpiCreatePS(hab,hdc : cardinal;var psizlSize : SIZEL;flOptions : cardinal) : cardinal;cdecl;external 'pmgpi' index 369;
+function GpiDestroyPS(hps : cardinal) : longbool;cdecl;external 'pmgpi' index 379;
+function GpiAssociate(hps,hdc : cardinal) : longbool;cdecl;external 'pmgpi' index 351;
+function GpiRestorePS(hps : cardinal;lPSid : longint) : longbool;cdecl;external 'pmgpi' index 499;
+function GpiSavePS(hps : cardinal) : longint;cdecl;external 'pmgpi' index 501;
+function GpiErase(hps : cardinal) : longbool;cdecl;external 'pmgpi' index 389;
+function GpiQueryDevice(hps : cardinal) : cardinal;cdecl;external 'pmgpi' index 444;
+function GpiResetPS(hps,flOptions : cardinal) : longbool;cdecl;external 'pmgpi' index 498;
+function GpiSetPS(hps : cardinal;var psizlsize : SIZEL;flOptions : cardinal) : longbool;cdecl;external 'pmgpi' index 539;
+function GpiQueryPS(hps : cardinal;var psizlSize : SIZEL) : cardinal;cdecl;external 'pmgpi' index 471;
+function GpiErrorSegmentData(hps : cardinal;var plSegment,plContext : longint) : longint;cdecl;external 'pmgpi' index 390;
+function GpiQueryDrawControl(hps : cardinal;lControl : longint) : longint;cdecl;external 'pmgpi' index 446;
+function GpiSetDrawControl(hps : cardinal;lControl,lValue : longint) : longbool;cdecl;external 'pmgpi' index 521;
+function GpiQueryDrawingMode(hps : cardinal) : longint;cdecl;external 'pmgpi' index 447;
+function GpiSetDrawingMode(hps : cardinal;lMode : longint) : longbool;cdecl;external 'pmgpi' index 522;
+function GpiQueryStopDraw(hps : cardinal) : longint;cdecl; external 'pmgpi' index 487;
+function GpiSetStopDraw(hps : cardinal;lValue : longint) : longbool; cdecl; external 'pmgpi' index 550;
+function GpiCorrelateChain(hps : cardinal;lType : longint;var pptlPick : POINTL;lMaxHits : longint;lMaxDepth : longint;var pl2 : longint) : longint; cdecl; external 'pmgpi' index 366;
+function GpiQueryTag(hps : cardinal;var plTag : longint) : longbool; cdecl; external 'pmgpi' index 488;
+function GpiSetTag(hps : cardinal;lTag : longint) : longbool; cdecl; external 'pmgpi' index 551;
+function GpiQueryPickApertureSize(hps : cardinal;var psizlSize : SIZEL) : longbool; cdecl; external 'pmgpi' index 478;
+function GpiSetPickApertureSize(hps : cardinal;lOptions : longint;var psizlSize : SIZEL) : longbool; cdecl; external 'pmgpi' index 589;
+function GpiQueryPickAperturePosition(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl; external 'pmgpi' index 477;
+function GpiSetPickAperturePosition(hps : cardinal;var pptlPick : POINTL) : longbool; cdecl; external 'pmgpi' index 545;
+function GpiQueryBoundaryData(hps : cardinal;var prclBoundary : RECTL) : longbool; cdecl; external 'pmgpi' index 428;
+function GpiResetBoundaryData(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 497;
+function GpiCorrelateFrom(hps : cardinal;lFirstSegment,lLastSegment,lType : longint;var pptlPick : POINTL;lMaxHits,lMaxDepth : longint;var plSegTag : longint) : longint; cdecl; external 'pmgpi' index 367;
+function GpiCorrelateSegment(hps : cardinal;lSegment,lType : longint;var pptlPick : POINTL;lMaxHits,lMaxDepth : longint;var alSegTag : longint) : longint; cdecl; external 'pmgpi' index 582;
+function GpiOpenSegment(hps : cardinal;lSegment : longint) : longbool; cdecl; external 'pmgpi' index 408;
+function GpiCloseSegment(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 361;
+function GpiDeleteSegment(hps : cardinal;lSegid : longint) : longbool; cdecl; external 'pmgpi' index 376;
+function GpiQueryInitialSegmentAttrs(hps : cardinal;lAttribute : longint) : longint; cdecl; external 'pmgpi' index 455;
+function GpiSetInitialSegmentAttrs(hps : cardinal;lAttribute,lValue : longint) : longbool; cdecl; external 'pmgpi' index 527;
+function GpiQuerySegmentAttrs(hps : cardinal;lSegid,lAttribute : longint) : longint; cdecl; external 'pmgpi' index 482;
+function GpiSetSegmentAttrs(hps : cardinal;lSegid,lAttribute,lValue : longint) : longbool; cdecl; external 'pmgpi' index 547;
+function GpiQuerySegmentPriority(hps : cardinal;lRefSegid,lOrder : longint) : longint; cdecl; external 'pmgpi' index 484;
+function GpiSetSegmentPriority(hps : cardinal;lSegid,lRefSegid,lOrder : longint) : longbool; cdecl; external 'pmgpi' index 548;
+function GpiDeleteSegments(hps : cardinal;lFirstSegment,lLastSegment : longint) : longbool; cdecl; external 'pmgpi' index 377;
+function GpiQuerySegmentNames(hps : cardinal;lFirstSegid,lLastSegid,lMax : longint;var alSegids : longint) : longint; cdecl; external 'pmgpi' index 483;
+function GpiGetData(hps : cardinal;lSegid : longint;var plOffset : longint;lFormat,lLength : longint;var pbData : BYTE) : longint; cdecl; external 'pmgpi' index 394;
+function GpiPutData(hps : cardinal;lFormat : longint;var plCount : longint;var pbData : BYTE) : longint; cdecl; external 'pmgpi' index 421;
+function GpiDrawChain(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 380;
+function GpiDrawFrom(hps : cardinal;lFirstSegment,lLastSegment : longint) : longbool; cdecl; external 'pmgpi' index 382;
+function GpiDrawSegment(hps : cardinal;lSegment : longint) : longbool; cdecl; external 'pmgpi' index 383;
+function GpiDrawDynamics(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 381;
+function GpiRemoveDynamics(hps : cardinal;lFirstSegid,lLastSegid : longint) : longbool; cdecl; external 'pmgpi' index 496;
+function GpiBeginElement(hps : cardinal;lType : longint;pszDesc : pchar) : longbool; cdecl; external 'pmgpi' index 353;
+function GpiEndElement(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 386;
+function GpiLabel(hps : cardinal;lLabel : longint) : longbool; cdecl; external 'pmgpi' index 397;
+function GpiElement(hps : cardinal;lType : longint;pszDesc : pchar;lLength : longint;var pbData : BYTE) : longint; cdecl; external 'pmgpi' index 384;
+function GpiQueryElement(hps : cardinal;lOff,lMaxLength : longint;var pbData : BYTE) : longint; cdecl; external 'pmgpi' index 449;
+function GpiDeleteElement(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 372;
+function GpiDeleteElementRange(hps : cardinal;lFirstElement,lLastElement : longint) : longbool; cdecl; external 'pmgpi' index 373;
+function GpiDeleteElementsBetweenLabels(hps : cardinal;lFirstLabel,lLastLabel : longint) : longbool; cdecl; external 'pmgpi' index 374;
+function GpiQueryEditMode(hps : cardinal) : longint; cdecl; external 'pmgpi' index 448;
+function GpiSetEditMode(hps : cardinal;lMode : longint) : longbool; cdecl; external 'pmgpi' index 523;
+function GpiQueryElementPointer(hps : cardinal) : longint; cdecl; external 'pmgpi' index 450;
+function GpiSetElementPointer(hps : cardinal;lElement : longint) : longbool; cdecl; external 'pmgpi' index 524;
+function GpiOffsetElementPointer(hps : cardinal;loffset : longint) : longbool; cdecl; external 'pmgpi' index 406;
+function GpiQueryElementType(hps : cardinal;var plType : longint;lLength : longint;pszData : pchar) : longint; cdecl; external 'pmgpi' index 451;
+function GpiSetElementPointerAtLabel(hps : cardinal;lLabel : longint) : longbool; cdecl; external 'pmgpi' index 525;
+function GpiQuerySegmentTransformMatrix(hps : cardinal;lSegid,lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl; external 'pmgpi' index 485;
+function GpiSetSegmentTransformMatrix(hps : cardinal;lSegid,lCount : longint;var pmatlfarray : MATRIXLF;lOptions : longint) : longbool; cdecl; external 'pmgpi' index 549;
+function GpiConvert(hps : cardinal;lSrc,lTarg,lCount : longint;var aptlPoints : POINTL) : longbool; cdecl; external 'pmgpi' index 364;
+function GpiConvertWithMatrix(hps : cardinal;lCountp : longint;var aptlPoints : POINTL;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl; external 'pmgpi' index 618;
+function GpiQueryModelTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl; external 'pmgpi' index 468;
+function GpiSetModelTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF;lOptions : longint) : longbool; cdecl; external 'pmgpi' index 538;
+function GpiCallSegmentMatrix(hps : cardinal;lSegment,lCount : longint;var pmatlfArray : MATRIXLF;lOptions : longint) : longint; cdecl; external 'pmgpi' index 357;
+function GpiQueryDefaultViewMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl; external 'pmgpi' index 443;
+function GpiSetDefaultViewMatrix(hps : cardinal;lCount : longint;var pmatlfarray : MATRIXLF;lOptions : longint) : longbool; cdecl; external 'pmgpi' index 520;
+function GpiQueryPageViewport(hps : cardinal;var prclViewport : RECTL) : longbool; cdecl; external 'pmgpi' index 472;
+function GpiSetPageViewport(hps : cardinal;var prclViewport : RECTL) : longbool; cdecl; external 'pmgpi' index 540;
+function GpiQueryViewingTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF) : longbool; cdecl; external 'pmgpi' index 491;
+function GpiSetViewingTransformMatrix(hps : cardinal;lCount : longint;var pmatlfArray : MATRIXLF;lOptions : longint) : longbool; cdecl; external 'pmgpi' index 553;
+function GpiTranslate(hps : cardinal;var pmatrixlf : MATRIXLF;long : longint;var ppointl : POINTL) : longbool; cdecl; external 'pmgpi' index 564;
+function GpiScale(hps : cardinal;var p1 : MATRIXLF;p2 : longint;var p3 : longint;var p4 : POINTL) : longbool; cdecl; external 'pmgpi' index 565;
+function GpiRotate(p1 : cardinal;var p2 : MATRIXLF;p3,p4 : longint;var p5 : POINTL) : longbool; cdecl; external 'pmgpi' index 566;
+function GpiSetGraphicsField(hps : cardinal;var prclField : RECTL) : longbool; cdecl; external 'pmgpi' index 526;
+function GpiQueryGraphicsField(hps : cardinal;var prclField : RECTL) : longbool; cdecl; external 'pmgpi' index 454;
+function GpiSetViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl; external 'pmgpi' index 552;
+function GpiQueryViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl; external 'pmgpi' index 490;
+function GpiBeginPath(hps : cardinal;lPath : longint) : longbool; cdecl; external 'pmgpi' index 354;
+function GpiEndPath(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 387;
+function GpiCloseFigure(hps : cardinal) : longbool; cdecl; external 'pmgpi' index 360;
+function GpiModifyPath(hps : cardinal;lPath,lMode : longint) : longbool; cdecl; external 'pmgpi' index 403;
+function GpiFillPath(hps : cardinal;lPath,lOptions : longint) : longint; cdecl; external 'pmgpi' index 392;
+function GpiSetClipPath(hps : cardinal;lPath,lOptions : longint) : longbool; cdecl; external 'pmgpi' index 515;
+function GpiOutlinePath(hps : cardinal;lPath,lOptions : longint) : longint; cdecl; external 'pmgpi' index 563;
+function GpiPathToRegion(GpiH : cardinal;lPath,lOptions : longint) : cardinal; cdecl; external 'pmgpi' index 559;
+function GpiStrokePath(hps : cardinal;lPath : longint;flOptions : cardinal) : longint; cdecl; external 'pmgpi' index 554;
+function GpiCreateLogColorTable(hps,flOptions : cardinal;lFormat,lStart,lCount : longint;var alTable : longint) : longbool; cdecl; external 'pmgpi' index 592;
+function GpiQueryColorData(hps : cardinal;lCount : longint;var alArray : longint) : longbool; cdecl; external 'pmgpi' index 438;
+function GpiQueryLogColorTable(hps,flOptions : cardinal;lStart,lCount : longint;var alArray : longint) : longint; cdecl; external 'pmgpi' index 593;
+function GpiQueryRealColors(hps,flOptions : cardinal;lStart,lCount : longint;var alColors : longint) : longint; cdecl; external 'pmgpi' index 480;
+function GpiQueryNearestColor(hps,flOptions : cardinal;lRgbIn : longint) : longint; cdecl; external 'pmgpi' index 469;
+function GpiQueryColorIndex(hps,flOptions : cardinal;lRgbColor : longint) : longint; cdecl; external 'pmgpi' index 439;
+function GpiQueryRGBColor(hps,flOptions : cardinal;lColorIndex : longint) : longint; cdecl; external 'pmgpi' index 479;
+function GpiCreatePalette(hab,flOptions,ulFormat,ulCount : cardinal;var aulTable) : cardinal; cdecl; external 'pmgpi' index 594;
+function GpiDeletePalette(hpal : cardinal) : longbool; cdecl; external 'pmgpi' index 577;
+function GpiSelectPalette(hps,hpal : cardinal) : cardinal; cdecl; external 'pmgpi' index 578;
+function GpiAnimatePalette(hpal,ulFormat,ulStart,ulCount : cardinal;var aulTable) : longint; cdecl; external 'pmgpi' index 595;
+function GpiSetPaletteEntries(hpal,ulFormat,ulStart,ulCount : cardinal;var aulTable) : longbool; cdecl; external 'pmgpi' index 596;
+function GpiQueryPalette(hps : cardinal) : cardinal; cdecl; external 'pmgpi' index 579;
+function GpiQueryPaletteInfo(hpal,hps,flOptions,ulStart,ulCount : cardinal;var aulArray) : longint; cdecl; external 'pmgpi' index 597;
+function GpiSetColor(hps : cardinal;lColor : longint) : longbool; cdecl; external 'pmgpi' index 517;
+function GpiQueryColor(hps : cardinal) : longint; cdecl; external 'pmgpi' index 437;
+function GpiBox(hps : cardinal;lControl : longint;var pptlPoint : POINTL;lHRound,lVRound : longint) : longint; cdecl; external 'pmgpi' index 356;
+function GpiMove(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl; external 'pmgpi' index 404;
+function GpiLine(hps : cardinal;var pptlEndPoint : POINTL) : longint; cdecl; external 'pmgpi' index 398;
+function GpiPolyLine(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl; external 'pmgpi' index 415;
+function GpiPolyLineDisjoint(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl; external 'pmgpi' index 558;
+function GpiSetPattern(hps : cardinal;lPatternSymbol : longint) : longbool; cdecl; external 'pmgpi' index 541;
+function GpiQueryPattern(hps : cardinal) : longint; cdecl; external 'pmgpi' index 473;
+function GpiBeginArea(hps,flOptions : cardinal) : longbool; cdecl; external 'pmgpi' index 352;
+function GpiEndArea(hps : cardinal) : longint; cdecl; external 'pmgpi' index 385;
+function GpiCharString(hps : cardinal;lCount : longint;pchString : pchar) : longint; cdecl; external 'pmgpi' index 358;
+function GpiCharStringAt(hps : cardinal;var pptlPoint : POINTL;lCount : longint;pchString : pchar) : longint; cdecl; external 'pmgpi' index 359;
+function GpiSetAttrMode(hps : cardinal;lMode : longint) : longbool; cdecl; external 'pmgpi' index 503;
+function GpiQueryAttrMode(hps : cardinal) : longint; cdecl; external 'pmgpi' index 423;
+function GpiSetAttrs(hps : cardinal;lPrimType : longint;flAttrMask,flDefMask : cardinal;ppbunAttrs : pointer) : longbool; cdecl; external 'pmgpi' index 588;
+function GpiQueryAttrs(hps : cardinal;lPrimType : longint;flAttrMask : cardinal;ppbunAttrs : pointer) : longint; cdecl; external 'pmgpi' index 583;
+function GpiSetBackColor(hps : cardinal;lColor : longint) : longbool; cdecl; external 'pmgpi' index 504;
+function GpiQueryBackColor(hps : cardinal) : longint; cdecl; external 'pmgpi' index 424;
+function GpiSetMix(hps : cardinal;lMixMode : longint) : longbool; cdecl; external 'pmgpi' index 537;
+function GpiQueryMix(hps : cardinal) : longint; cdecl; external 'pmgpi' index 467;
+function GpiSetBackMix(hps : cardinal;lMixMode : longint) : longbool; cdecl; external 'pmgpi' index 505;
+function GpiQueryBackMix(hps : cardinal) : longint; cdecl; external 'pmgpi' index 425;
+function GpiSetLineType(hps : cardinal;lLineType : longint) : longbool; cdecl; external 'pmgpi' index 530;
+function GpiQueryLineType(hps : cardinal) : longint; cdecl; external 'pmgpi' index 459;
+function GpiSetLineWidth(hps : cardinal;fxLineWidth : longint) : longbool; cdecl; external 'pmgpi' index 531;
+function GpiQueryLineWidth(hps : cardinal) : longint; cdecl; external 'pmgpi' index 460;
+function GpiSetLineWidthGeom(hps : cardinal;lLineWidth : longint) : longbool; cdecl; external 'pmgpi' index 532;
+function GpiQueryLineWidthGeom(hps : cardinal) : longint; cdecl; external 'pmgpi' index 461;
+function GpiSetLineEnd(hps : cardinal;lLineEnd : longint) : longbool; cdecl; external 'pmgpi' index 528;
+function GpiQueryLineEnd(hps : cardinal) : longint; cdecl; external 'pmgpi' index 457;
+function GpiSetLineJoin(hps : cardinal;lLineJoin : longint) : longbool; cdecl; external 'pmgpi' index 529;
+function GpiQueryLineJoin(hps : cardinal) : longint; cdecl; external 'pmgpi' index 458;
+function GpiSetCurrentPosition(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl; external 'pmgpi' index 519;
+function GpiQueryCurrentPosition(hps : cardinal;var pptlPoint : POINTL) : longbool; cdecl; external 'pmgpi' index 441;
+function GpiSetArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl; external 'pmgpi' index 502;
+function GpiQueryArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl; external 'pmgpi' index 422;
+function GpiPointArc(hps : cardinal;var pptl2 : POINTL) : longint; cdecl; external 'pmgpi' index 412;
+function GpiFullArc(hps : cardinal;lControl,fxMultiplier : longint) : longint; cdecl; external 'pmgpi' index 393;
+function GpiPartialArc(hps : cardinal;var pptlCenter : POINTL;fxMultiplier,fxStartAngle,fxSweepAngle : longint) : longint; cdecl; external 'pmgpi' index 612;
+function GpiPolyFillet(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl; external 'pmgpi' index 413;
+function GpiPolySpline(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl; external 'pmgpi' index 417;
+function GpiPolyFilletSharp(hps : cardinal;lCount : longint;var aptlPoints : POINTL;var afxPoints : longint) : longint; cdecl; external 'pmgpi' index 414;
+function GpiSetPatternSet(hps : cardinal;lSet : longint) : longbool; cdecl; external 'pmgpi' index 543;
+function GpiQueryPatternSet(hps : cardinal) : longint; cdecl; external 'pmgpi' index 475;
+function GpiSetPatternRefPoint(hps : cardinal;var pptlRefPoint : POINTL) : longbool; cdecl; external 'pmgpi' index 542;
+function GpiQueryPatternRefPoint(hps : cardinal;var pptlRefPoint : POINTL) : longbool; cdecl; external 'pmgpi' index 474;
+function GpiQueryCharStringPos(hps,flOptions : cardinal;lCount : longint;pchString : pchar;var alXincrements : longint;var aptlPositions : POINTL) : longbool; cdecl; external 'pmgpi' index 584;
+function GpiQueryCharStringPosAt(hps : cardinal;var pptlStart : POINTL;flOptions : cardinal;lCount : longint;pchString : pchar;var alXincrements : longint;var aptlPositions : POINTL) : longbool; cdecl; external 'pmgpi' index 585;
+function GpiQueryTextBox(hps : cardinal;lCount1 : longint;pchString : pchar;lCount2 : longint;var aptlPoints : POINTL) : longbool; cdecl; external 'pmgpi' index 489;
+function GpiQueryDefCharBox(hps : cardinal;var psizlSize : SIZEL) : longbool; cdecl; external 'pmgpi' index 442;
+function GpiSetCharSet(hps : cardinal;llcid : longint) : longbool; cdecl; external 'pmgpi' index 513;
+function GpiQueryCharSet(hps : cardinal) : longint; cdecl; external 'pmgpi' index 433;
+function GpiSetCharBox(hps : cardinal;var psizfxBox : SIZEF) : longbool; cdecl; external 'pmgpi' index 510;
+function GpiQueryCharBox(hps : cardinal;var psizfxSize : SIZEF) : longbool; cdecl; external 'pmgpi' index 430;
+function GpiSetCharAngle(hps : cardinal;var pgradlAngle : GRADIENTL) : longbool; cdecl; external 'pmgpi' index 509;
+function GpiQueryCharAngle(hps : cardinal;var pgradlAngle : GRADIENTL) : longbool; cdecl; external 'pmgpi' index 429;
+function GpiSetCharShear(hps : cardinal;var pptlAngle : POINTL) : longbool; cdecl; external 'pmgpi' index 514;
+function GpiQueryCharShear(hps : cardinal;var pptlShear : POINTL) : longbool; cdecl; external 'pmgpi' index 434;
+function GpiSetCharDirection(hps : cardinal;lDirection : longint) : longbool; cdecl; external 'pmgpi' index 511;
+function GpiQueryCharDirection(hps : cardinal) : longint; cdecl; external 'pmgpi' index 431;
+function GpiSetCharMode(hps : cardinal;lMode : longint) : longbool; cdecl; external 'pmgpi' index 512;
+function GpiQueryCharMode(hps : cardinal) : longint; cdecl; external 'pmgpi' index 432;
+function GpiSetTextAlignment(hps : cardinal;lHoriz,lVert : longint) : longbool; cdecl; external 'pmgpi' index 649;
+function GpiQueryTextAlignment(hps : cardinal;var plHoriz,plVert : longint) : longbool; cdecl; external 'pmgpi' index 648;
+function GpiCharStringPos(hps : cardinal;var prclRect : RECTL;flOptions : cardinal;lCount : longint;pchString : pchar;var alAdx : longint) : longint; cdecl; external 'pmgpi' index 580;
+function GpiCharStringPosAt(hps : cardinal;var pptlStart : POINTL;var prclRect : RECTL;flOptions : cardinal;lCount : longint;pchString : pchar;var alAdx : longint) : longint; cdecl; external 'pmgpi' index 581;
+function GpiSetCharExtra(hps : cardinal;Extra : longint) : longbool; cdecl; external 'pmgpi' index 614;
+function GpiSetCharBreakExtra(hps : cardinal;BreakExtra : longint) : longbool; cdecl; external 'pmgpi' index 616;
+function GpiQueryCharExtra(hps : cardinal;var Extra : longint) : longbool; cdecl; external 'pmgpi' index 613;
+function GpiQueryCharBreakExtra(hps : cardinal;var BreakExtra : longint) : longbool; cdecl; external 'pmgpi' index 615;
+function GpiMarker(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl; external 'pmgpi' index 402;
+function GpiPolyMarker(hps : cardinal;lCount : longint;var aptlPoints : POINTL) : longint; cdecl; external 'pmgpi' index 416;
+function GpiSetMarker(hps : cardinal;lSymbol : longint) : longbool; cdecl; external 'pmgpi' index 533;
+function GpiSetMarkerBox(hps : cardinal;var psizfxSize : SIZEF) : longbool; cdecl; external 'pmgpi' index 534;
+function GpiSetMarkerSet(hps : cardinal;lSet : longint) : longbool; cdecl; external 'pmgpi' index 535;
+function GpiQueryMarker(hps : cardinal) : longint; cdecl; external 'pmgpi' index 462;
+function GpiQueryMarkerBox(hps : cardinal;var psizfxSize : SIZEF) : longbool; cdecl; external 'pmgpi' index 463;
+function GpiQueryMarkerSet(hps : cardinal) : longint; cdecl; external 'pmgpi' index 464;
+function GpiImage(hps : cardinal;lFormat : longint;var psizlImageSize : SIZEL;lLength : longint;var pbData : BYTE) : longint; cdecl; external 'pmgpi' index 395;
+function GpiPop(hps : cardinal;lCount : longint) : longbool; cdecl; external 'pmgpi' index 418;
+function GpiPtVisible(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl; external 'pmgpi' index 420;
+function GpiRectVisible(hps : cardinal;var prclRectangle : RECTL) : longint; cdecl; external 'pmgpi' index 495;
+function GpiComment(hps : cardinal;lLength : longint;var pbData : BYTE) : longbool; cdecl; external 'pmgpi' index 363;
+function GpiCreateLogFont(hps : cardinal;var pName : STR8;lLcid : longint;var pfatAttrs : FATTRS) : longint; cdecl; external 'pmgpi' index 368;
+function GpiDeleteSetId(hps : cardinal;lLcid : longint) : longbool; cdecl; external 'pmgpi' index 378;
+function GpiLoadFonts(hab : cardinal;pszFilename : pchar) : longbool; cdecl; external 'pmgpi' index 400;
+function GpiUnloadFonts(hab : cardinal;pszFilename : pchar) : longbool; cdecl; external 'pmgpi' index 555;
+function GpiQueryFonts(hps,flOptions : cardinal;pszFacename : pchar;var plReqFonts : longint;lMetricsLength : longint;var afmMetrics : FONTMETRICS) : longint; cdecl; external 'pmgpi' index 586;
+function GpiQueryFontMetrics(hps : cardinal;lMetricsLength : longint;var pfmMetrics : FONTMETRICS) : longbool; cdecl; external 'pmgpi' index 453;
+function GpiQueryKerningPairs(hps : cardinal;lCount : longint;var akrnprData : KERNINGPAIRS) : longint; cdecl; external 'pmgpi' index 456;
+function GpiQueryWidthTable(hps : cardinal;lFirstChar,lCount : longint;var alData : longint) : longbool; cdecl; external 'pmgpi' index 492;
+function GpiQueryNumberSetIds(hps : cardinal) : longint; cdecl; external 'pmgpi' index 470;
+function GpiQuerySetIds(hps : cardinal;lCount : longint;var alTypes : longint;var aNames : STR8;var allcids : longint) : longbool; cdecl; external 'pmgpi' index 486;
+function GpiQueryFaceString(PS : cardinal;FamilyName : pchar;var attrs : FACENAMEDESC;length : longint;CompoundFaceName : pchar) : cardinal; cdecl; external 'pmgpi' index 575;
+function GpiQueryLogicalFont(PS : cardinal;lcid : longint;var name : STR8;var attrs : FATTRS;length : longint) : longbool; cdecl; external 'pmgpi' index 574;
+function GpiQueryFontAction(anchor,options : cardinal) : cardinal; cdecl; external 'pmgpi' index 576;
+function GpiLoadPublicFonts(p1 : cardinal;p2 : pchar) : longbool; cdecl; external 'pmgpi' index 622;
+function GpiUnloadPublicFonts(p1 : cardinal;p2 : pchar) : longbool; cdecl; external 'pmgpi' index 623;
+function GpiSetCp(hps,ulCodePage : cardinal) : longbool; cdecl; external 'pmgpi' index 518;
+function GpiQueryCp(hps : cardinal) : cardinal; cdecl; external 'pmgpi' index 440;
+function GpiQueryFontFileDescriptions(hab : cardinal;pszFilename : pchar;var plCount : longint;var affdescsNames : FFDESCS) : longint; cdecl; external 'pmgpi' index 452;
+function GpiQueryFullFontFileDescs(hab : cardinal;pszFilename : pchar;var plCount : longint;pNames : pointer;var plNamesBuffLength : longint) : longint; cdecl; external 'pmgpi' index 657;
+function GpiBitBlt(hpsTarget,hpsSource : cardinal;lCount : longint;var aptlPoints : POINTL;lRop : longint;flOptions : cardinal) : longint; cdecl; external 'pmgpi' index 355;
+function GpiDeleteBitmap(hbm : cardinal) : longbool; cdecl; external 'pmgpi' index 371;
+function GpiLoadBitmap(hps,Resource,idBitmap:cardinal;lWidth,lHeight : longint) : cardinal; cdecl; external 'pmgpi' index 399;
+function GpiSetBitmap(hps,hbm : cardinal) : cardinal; cdecl; external 'pmgpi' index 506;
+function GpiWCBitBlt(hpsTarget,hbmSource : cardinal;lCount : longint;var aptlPoints : POINTL;lRop : longint;flOptions : cardinal) : longint; cdecl; external 'pmgpi' index 557;
+function GpiCreateBitmap(hps : cardinal;var pbmpNew :Tbitmapinfoheader2;flOptions : cardinal;var pbInitData : BYTE;var pbmiInfoTable :Tbitmapinfo2) : cardinal; cdecl; external 'pmgpi' index 598;
+function GpiSetBitmapBits(hps : cardinal;lScanStart,lScans : longint;var pbBuffer : BYTE;var pbmiInfoTable :Tbitmapinfo2) : longint; cdecl; external 'pmgpi' index 602;
+function GpiSetBitmapDimension(hbm : cardinal;var psizlBitmapDimension : SIZEL) : longbool; cdecl; external 'pmgpi' index 507;
+function GpiSetBitmapId(hps,hbm : cardinal;lLcid : longint) : longbool; cdecl; external 'pmgpi' index 508;
+function GpiQueryBitmapBits(hps : cardinal;lScanStart,lScans : longint;var pbBuffer : BYTE;var pbmiInfoTable :Tbitmapinfo2) : longint; cdecl; external 'pmgpi' index 599;
+function GpiQueryBitmapDimension(hbm : cardinal;var psizlBitmapDimension : SIZEL) : longbool; cdecl; external 'pmgpi' index 426;
+function GpiQueryBitmapHandle(hps : cardinal;lLcid : longint) : cardinal; cdecl; external 'pmgpi' index 427;
+function GpiQueryBitmapParameters(hbm : cardinal;var pbmpData :Tbitmapinfoheader) : longbool; cdecl; external 'pmgpi' index 573;
+function GpiQueryBitmapInfoHeader(hbm : cardinal;var pbmpData :Tbitmapinfoheader2) : longbool; cdecl; external 'pmgpi' index 601;
+function GpiQueryDeviceBitmapFormats(hps : cardinal;lCount : longint;var alArray : longint) : longbool; cdecl; external 'pmgpi' index 445;
+function GpiSetPel(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl; external 'pmgpi' index 544;
+function GpiQueryPel(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl; external 'pmgpi' index 476;
+function GpiFloodFill(hps : cardinal;lOptions,lColor : longint) : longint; cdecl; external 'pmgpi' index 560;
+function GpiDrawBits(hps : cardinal;pBits : pointer;var pbmiInfoTable :Tbitmapinfo2;lCount : longint;var aptlPoints : POINTL;lRop : longint;flOptions : cardinal) : longint; cdecl; external 'pmgpi' index 603;
+function GpiCombineRegion(hps,hrgnDest,hrgnSrc1,hrgnSrc2 : cardinal;lMode : longint) : longint; cdecl; external 'pmgpi' index 362;
+function GpiCreateRegion(hps : cardinal;lCount : longint;var arclRectangles : RECTL) : cardinal; cdecl; external 'pmgpi' index 370;
+function GpiDestroyRegion(hps,hrgn : cardinal) : longbool; cdecl; external 'pmgpi' index 611;
+function GpiEqualRegion(hps,hrgnSrc1,hrgnSrc2 : cardinal) : longint; cdecl; external 'pmgpi' index 388;
+function GpiOffsetRegion(hps,Hrgn : cardinal;var pptlOffset : POINTL) : longbool; cdecl; external 'pmgpi' index 407;
+function GpiPaintRegion(hps,hrgn : cardinal) : longint; cdecl; external 'pmgpi' index 409;
+function GpiFrameRegion(hps,hrgn : cardinal;var thickness : SIZEL) : longint; cdecl; external 'pmgpi' index 617;
+function GpiPtInRegion(hps,hrgn : cardinal;var pptlPoint : POINTL) : longint; cdecl; external 'pmgpi' index 419;
+function GpiQueryRegionBox(hps,hrgn : cardinal;var prclBound : RECTL) : longint; cdecl; external 'pmgpi' index 481;
+function GpiQueryRegionRects(hps,hrgn : cardinal;var prclBound : RECTL;var prgnrcControl : RGNRECT;var prclRect : RECTL) : longbool; cdecl; external 'pmgpi' index 587;
+function GpiRectInRegion(hps,hrgn : cardinal;var prclRect : RECTL) : longint; cdecl; external 'pmgpi' index 494;
+function GpiSetRegion(hps,hrgn : cardinal;lcount : longint;var arclRectangles : RECTL) : longbool; cdecl; external 'pmgpi' index 546;
+function GpiSetClipRegion(hps,hrgn : cardinal;var phrgnOld : cardinal) : longint; cdecl; external 'pmgpi' index 516;
+function GpiQueryClipRegion(hps : cardinal) : cardinal; cdecl; external 'pmgpi' index 436;
+function GpiQueryClipBox(hps : cardinal;var prclBound : RECTL) : longint; cdecl; external 'pmgpi' index 435;
+function GpiExcludeClipRectangle(hps : cardinal;var prclRectangle : RECTL) : longint; cdecl; external 'pmgpi' index 391;
+function GpiIntersectClipRectangle(hps : cardinal;var prclRectangle : RECTL) : longint; cdecl; external 'pmgpi' index 396;
+function GpiOffsetClipRegion(hps : cardinal;var pptlPoint : POINTL) : longint; cdecl; external 'pmgpi' index 405;
+function GpiCopyMetaFile(hmf : cardinal) : cardinal; cdecl; external 'pmgpi' index 365;
+function GpiDeleteMetaFile(hmf : cardinal) : longbool; cdecl; external 'pmgpi' index 375;
+function GpiLoadMetaFile(hab : cardinal;pszFilename : pchar) : cardinal; cdecl; external 'pmgpi' index 401;
+function GpiPlayMetaFile(hps,hmf : cardinal;lCount1 : longint;var alOptarray,plSegCount : longint;lCount2 : longint;pszDesc : pchar) : longint; cdecl; external 'pmgpi' index 411;
+function GpiQueryMetaFileBits(hmf : cardinal;lOffset,lLength : longint;var pbData : BYTE) : longbool; cdecl; external 'pmgpi' index 465;
+function GpiQueryMetaFileLength(hmf : cardinal) : longint; cdecl; external 'pmgpi' index 466;
+function GpiSaveMetaFile(hmf : cardinal;pszFilename : pchar) : longbool; cdecl; external 'pmgpi' index 500;
+function GpiSetMetaFileBits(hmf : cardinal;lOffset,lLength : longint;var pbBuffer : BYTE) : longbool; cdecl; external 'pmgpi' index 536;
+function GpiQueryDefArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl; external 'pmgpi' index 567;
+function GpiQueryDefAttrs(hps : cardinal;lPrimType : longint;flAttrMask : cardinal;ppbunAttrs : pointer) : longbool; cdecl; external 'pmgpi' index 590;
+function GpiQueryDefTag(hps : cardinal;var plTag : longint) : longbool; cdecl; external 'pmgpi' index 568;
+function GpiQueryDefViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl; external 'pmgpi' index 569;
+function GpiSetDefArcParams(hps : cardinal;var parcpArcParams : ARCPARAMS) : longbool; cdecl; external 'pmgpi' index 570;
+function GpiSetDefAttrs(hps : cardinal;lPrimType : longint;flAttrMask : cardinal;ppbunAttrs : pointer) : longbool; cdecl; external 'pmgpi' index 591;
+function GpiSetDefTag(hps : cardinal;lTag : longint) : longbool; cdecl; external 'pmgpi' index 571;
+function GpiSetDefViewingLimits(hps : cardinal;var prclLimits : RECTL) : longbool; cdecl; external 'pmgpi' index 572;
+function GpiPolygons(hps,ulCount : cardinal;var paplgn : POLYGON;flOptions,flModel : cardinal) : longint; cdecl; external 'pmgpi' index 650;
+
+end.
+
+{
+ $Log: pmgpi.pas,v $
+ Revision 1.6 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmhelp.pas b/rtl/os2/pmhelp.pas
new file mode 100644
index 0000000000..463df0b7fe
--- /dev/null
+++ b/rtl/os2/pmhelp.pas
@@ -0,0 +1,506 @@
+{
+ $Id: pmhelp.pas,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Yuri Prokushev (prokushev@freemail.ru).
+
+ OS/2 Presentation Manager Information Presentation Facility,
+ Help Manager declarations.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Warning: This code is alfa. Future versions
+ of this unit might not be compatible.}
+
+unit pmhelp;
+
+interface
+
+{$MODE OBJFPC}
+
+uses
+ os2def;
+
+resourcestring
+ msg_failedtodisplay='Failed to display help panel.';
+ msg_failedtoload='Failed to load help manager.';
+
+//************************************************************************/
+//* HelpSubTable entry structure */
+//************************************************************************/
+type
+ HelpSubTable=Word;
+ PHelpSubTable=^HelpSubTable;
+
+//************************************************************************/
+//* HelpTable entry structure */
+//* */
+//* Pack the structure HELPTABLE so that it is identical in the 32-Bit */
+//* and 16-Bit world. We have to do this because the HelpTable can */
+//* reside either in memory or in the application's resources. */
+//************************************************************************/
+type
+{$PACKRECORDS 2}
+ PHelpTable=^HelpTable;
+ HelpTable=record
+ idAppWindow: Word;
+ phstHelpSubTable: PHelpSubTable;
+ idExtPanel: Word;
+ End;
+
+
+//************************************************************************/
+//* IPF Initialization Structure used on the */
+//* WinCreateHelpInstance() call. */
+//************************************************************************/
+
+type
+ PHelpInit=^HelpInit;
+ HelpInit=record
+ cb: cardinal;
+ ulReturnCode: cardinal;
+ pszTutorialName: PChar;
+ phtHelpTable: PHelpTable;
+ hmodHelpTableModule: cardinal;
+ hmodAccelActionBarModule: cardinal;
+ idAccelTable: cardinal;
+ idActionBar: cardinal;
+ pszHelpWindowTitle: PChar;
+ fShowPanelId: cardinal;
+ pszHelpLibraryName: PChar;
+ End;
+
+//************************************************************************/
+//* Search parent chain indicator for HM_SET_ACTIVE_WINDOW message. */
+//************************************************************************/
+
+const
+ HWnd_Parent = 0;
+
+//************************************************************************/
+//* Constants used to define whether user wants to display panel using */
+//* panel number or panel name. */
+//************************************************************************/
+
+const
+ HM_ResourceID = 0;
+ HM_PanelName = 1;
+
+ HMPanelType_Number =0;
+ HMPanelType_Name =1;
+
+//************************************************************************/
+//* Constants used to define how the panel IDs are displayed on */
+//* help panels. */
+//************************************************************************/
+
+const
+ CMIC_Hide_Panel_ID =$0000;
+ CMIC_Show_Panel_ID =$0001;
+ CMIC_Toggle_Panel_ID =$0002;
+
+
+//************************************************************************/
+//* IPF message base. */
+//************************************************************************/
+const
+ HM_Msg_Base =$0220;
+
+//************************************************************************/
+//* Messages applications can send to the IPF. */
+//************************************************************************/
+const
+ HM_Dismiss_Window =HM_Msg_Base+$0001;
+ HM_Display_Help =HM_Msg_Base+$0002;
+ HM_Ext_Help =HM_Msg_Base+$0003;
+ HM_General_Help =HM_Ext_Help;
+ HM_Set_Active_Window =HM_Msg_Base+$0004;
+ HM_Load_Help_Table =HM_Msg_Base+$0005;
+ HM_Create_Help_Table =HM_Msg_Base+$0006;
+ HM_Set_Help_Window_Title =HM_Msg_Base+$0007;
+ HM_Set_Show_Panel_ID =HM_Msg_Base+$0008;
+ HM_Replace_Help_For_Help =HM_Msg_Base+$0009;
+ HM_Replace_Using_Help =HM_Replace_Help_For_Help;
+ HM_Help_Index =HM_Msg_Base+$000a;
+ HM_Help_Contents =HM_Msg_Base+$000b;
+ HM_Keys_Help =HM_Msg_Base+$000c;
+ HM_Set_Help_Library_Name =HM_Msg_Base+$000d;
+
+ HM_Set_OBJCOM_Window =HM_Msg_Base+$0018;
+ HM_Upadte_OBJCOM_Window_Chain =HM_Msg_Base+$0019;
+ HM_Query_DDF_Data =HM_Msg_Base+$001a;
+ HM_Invalidate_DDF_Data =HM_Msg_Base+$001b;
+ HM_Query =HM_Msg_Base+$001c;
+ HM_Set_CoverPage_Size =HM_Msg_Base+$001d;
+
+//************************************************************************/
+//* Constants used to query the info from IPF in HM_QUERY message */
+//************************************************************************/
+
+//* Hi word in lParam 1 */
+const
+ HMQW_COVERPAGE =$0001;
+ HMQW_INDEX =$0002;
+ HMQW_TOC =$0003;
+ HMQW_SEARCH =$0004;
+ HMQW_VIEWPAGES =$0005;
+ HMQW_LIBRARY =$0006;
+ HMQW_VIEWPORT =$0007;
+ HMQW_OBJCOM_WINDOW =$0008;
+ HMQW_INSTANCE =$0009;
+ HMQW_ACTIVEVIEWPORT =$000a;
+ CONTROL_SELECTED =$000b;
+
+ HMQW_GROUP_VIEWPORT =$00f1;
+ HMQW_RES_VIEWPORT =$00f2;
+ USERDATA =$00f3;
+
+//* Lo word in lParam1 of HMQW_VIEWPORT */
+ HMQVP_NUMBER =$0001;
+ HMQVP_NAME =$0002;
+ HMQVP_GROUP =$0003;
+
+//************************************************************************/
+//* Predefined Control IDs */
+//************************************************************************/
+
+const
+ CTRL_PREVIOUS_ID =$0001;
+ CTRL_SEARCH_ID =$0002;
+ CTRL_PRINT_ID =$0003;
+ CTRL_INDEX_ID =$0004;
+ CTRL_CONTENTS_ID =$0005;
+ CTRL_BACK_ID =$0006;
+ CTRL_FORWARD_ID =$0007;
+ CTRL_TUTORIAL_ID =$00FF;
+
+ CTRL_USER_ID_BASE =257;
+
+//************************************************************************/
+//* Messages the IPF sends to the applications active window */
+//* as defined by the IPF. */
+//************************************************************************/
+
+const
+ HM_ERROR =HM_Msg_Base+$000e;
+ HM_HELPSUBITEM_NOT_FOUND =HM_Msg_Base+$000f;
+ HM_QUERY_KEYS_HELP =HM_Msg_Base+$0010;
+ HM_TUTORIAL =HM_Msg_Base+$0011;
+ HM_EXT_HELP_UNDEFINED =HM_Msg_Base+$0012;
+ HM_GENERAL_HELP_UNDEFINED =HM_EXT_HELP_UNDEFINED;
+ HM_ACTIONBAR_COMMAND =HM_Msg_Base+$0013;
+ HM_INFORM =HM_Msg_Base+$0014;
+ HM_NOTIFY =HM_Msg_Base+$0022;
+ HM_SET_USERDATA =HM_Msg_Base+$0023;
+ HM_CONTROL =HM_Msg_Base+$0024;
+
+//**********************************************************************/
+//* notify information for HM_NOTIFY */
+//**********************************************************************/
+const
+ OPEN_COVERPAGE =$0001;
+ OPEN_PAGE =$0002;
+ SWAP_PAGE =$0003;
+ OPEN_TOC =$0004;
+ OPEN_INDEX =$0005;
+ OPEN_HISTORY =$0006;
+ OPEN_SEARCH_HIT_LIST =$0007;
+ OPEN_LIBRARY =$0008;
+ HELP_REQUESTED =$0009;
+
+//**********************************************************************/
+//* HMERR_NO_FRAME_WND_IN_CHAIN - There is no frame window in the */
+//* window chain from which to find or set the associated help */
+//* instance. */
+//**********************************************************************/
+const
+ HMERR_NO_FRAME_WND_IN_CHAIN =$00001001;
+
+//*********************************************************************/
+//* HMERR_INVALID_ASSOC_APP_WND - The application window handle */
+//* specified on the WinAssociateHelpInstance() call is not a valid */
+//* window handle. */
+//*********************************************************************/
+const
+ HMERR_INVALID_ASSOC_APP_WND =$00001002;
+
+//**********************************************************************/
+//* HMERR_INVALID_ASSOC_HELP_INST - The help instance handle specified */
+//* on the WinAssociateHelpInstance() call is not a valid */
+//* window handle. */
+//**********************************************************************/
+const
+ HMERR_INVALID_ASSOC_HELP_INST =$00001003;
+
+//**********************************************************************/
+//* HMERR_INVALID_DESTROY_HELP_INST - The window handle specified */
+//* as the help instance to destroy is not of the help instance class. */
+//**********************************************************************/
+const
+ HMERR_INVALID_DESTROY_HELP_INST =$00001004;
+
+//**********************************************************************/
+//* HMERR_NO_HELP_INST_IN_CHAIN - The parent or owner chain of the */
+//* application window specified does not have a help instance */
+//* associated with it. */
+//**********************************************************************/
+const
+ HMERR_NO_HELP_INST_IN_CHAIN =$00001005;
+
+//**********************************************************************/
+//* HMERR_INVALID_HELP_INSTANCE_HDL - The handle specified to be a */
+//* help instance does not have the class name of a IPF */
+//* help instance. */
+//**********************************************************************/
+const
+ HMERR_INVALID_HELP_INSTANCE_HDL =$00001006;
+
+//*********************************************************************/
+//* HMERR_INVALID_QUERY_APP_WND - The application window specified on */
+//* a WinQueryHelpInstance() call is not a valid window handle. */
+//*********************************************************************/
+const
+ HMERR_INVALID_QUERY_APP_WND =$00001007;
+
+//*********************************************************************/
+//* HMERR_HELP_INST_CALLED_INVALID - The handle of the help instance */
+//* specified on an API call to the IPF does not have the */
+//* class name of an IPF help instance. */
+//*********************************************************************/
+const
+ HMERR_HELP_INST_CALLED_INVALID =$00001008;
+
+ HMERR_HELPTABLE_UNDEFINE =$00001009;
+ HMERR_HELP_INSTANCE_UNDEFINE =$0000100a;
+ HMERR_HELPITEM_NOT_FOUND =$0000100b;
+ HMERR_INVALID_HELPSUBITEM_SIZE =$0000100c;
+ HMERR_HELPSUBITEM_NOT_FOUND =$0000100d;
+
+//*********************************************************************/
+//* HMERR_INDEX_NOT_FOUND - No index in library file. */
+//*********************************************************************/
+const
+ HMERR_INDEX_NOT_FOUND =$00002001;
+
+//**********************************************************************/
+//* HMERR_CONTENT_NOT_FOUND - Library file does not have any contents. */
+//**********************************************************************/
+const
+ HMERR_CONTENT_NOT_FOUND =$00002002;
+
+//*********************************************************************/
+//* HMERR_OPEN_LIB_FILE - Cannot open library file */
+//*********************************************************************/
+const
+ HMERR_OPEN_LIB_FILE =$00002003;
+
+//*********************************************************************/
+//* HMERR_READ_LIB_FILE - Cannot read library file */
+//*********************************************************************/
+const
+ HMERR_READ_LIB_FILE =$00002004;
+
+//*********************************************************************/
+//* HMERR_CLOSE_LIB_FILE - Cannot close library file */
+//*********************************************************************/
+const
+ HMERR_CLOSE_LIB_FILE =$00002005;
+
+//*********************************************************************/
+//* HMERR_INVALID_LIB_FILE - Improper library file provided */
+//*********************************************************************/
+const
+ HMERR_INVALID_LIB_FILE =$00002006;
+
+//************************************************************************/
+//* HMERR_NO_MEMORY - Unable to allocate the requested amount of memory. */
+//************************************************************************/
+const
+ HMERR_NO_MEMORY =$00002007;
+
+//*********************************************************************/
+//* HMERR_ALLOCATE_SEGMENT - Unable */
+//* to allocate a segment of memory for memory allocation requested */
+//* from the IPF. */
+//*********************************************************************/
+const
+ HMERR_ALLOCATE_SEGMENT =$00002008;
+
+//*********************************************************************/
+//* HMERR_FREE_MEMORY - Unable to free allocated memory */
+//*********************************************************************/
+const
+ HMERR_FREE_MEMORY =$00002009;
+
+//*********************************************************************/
+//* HMERR_PANEL_NOT_FOUND - Unable */
+//* to find a help panel requested to help manager */
+//*********************************************************************/
+const
+ HMERR_PANEL_NOT_FOUND =$00002010;
+
+//*********************************************************************/
+//* HMERR_DATABASE_NOT_OPEN - Unable to read the unopened database */
+//*********************************************************************/
+const
+ HMERR_DATABASE_NOT_OPEN =$00002011;
+
+//*********************************************************************/
+//* HMERR_DDL_ERROR - Unable to load resource dll */
+//*********************************************************************/
+const
+ HMERR_LOAD_DLL =$00002013;
+
+//********************************************************************/
+//* AC Viewport stucture definitions */
+//********************************************************************/
+type
+ PACVP=^ACVP;
+ ACVP=record
+ cb: cardinal;
+ hAB: HAB;
+ hmq: HMQ;
+ ObjectID: cardinal; // object identifier
+ hWndParent: HWND; // IPF viewport client handle
+ hWndOwner: HWND; // IPF viewport client handle
+ hWndACVP: HWND; // applications frame window hwnd
+ end;
+
+//*******************************************************************/
+//* Define Handle to DDF */
+//*******************************************************************/
+Type
+ HDDF=pointer;
+
+// DdfHyperText Flags
+const
+ REFERENCE_BY_ID =0;
+ REFERENCE_BY_RES =1;
+
+// DdfBeginList formatting flags
+ HMBT_NONE =1;
+ HMBT_ALL =2;
+ HMBT_FIT =3;
+
+ HMLS_SINGLELINE =1;
+ HMLS_DOUBLELINE =2;
+
+// DdfBitmap alignment flags
+ ART_RUNIN =$10;
+ ART_LEFT =$01;
+ ART_RIGHT =$02;
+ ART_CENTER =$04;
+
+// DdfSetColor Color Flag
+ CLR_UNCHANGED =-6;
+
+//*******************************************************************/
+// error codes returned by DDF API functions */
+//*******************************************************************/
+const
+ HMERR_DDF_MEMORY =$3001;
+ HMERR_DDF_ALIGN_TYPE =$3002;
+ HMERR_DDF_BACKCOLOR =$3003;
+ HMERR_DDF_FORECOLOR =$3004;
+ HMERR_DDF_FONTSTYLE =$3005;
+ HMERR_DDF_REFTYPE =$3006;
+ HMERR_DDF_LIST_UNCLOSED =$3007;
+ HMERR_DDF_LIST_UNINITIALIZED =$3008;
+ HMERR_DDF_LIST_BREAKTYPE =$3009;
+ HMERR_DDF_LIST_SPACING =$300A;
+ HMERR_DDF_HINSTANCE =$300B;
+ HMERR_DDF_EXCEED_MAX_LENGTH =$300C;
+ HMERR_DDF_EXCEED_MAX_INC =$300D;
+ HMERR_DDF_INVALID_DDF =$300E;
+ HMERR_DDF_FORMAT_TYPE =$300F;
+ HMERR_DDF_INVALID_PARM =$3010;
+ HMERR_DDF_INVALID_FONT =$3011;
+ HMERR_DDF_SEVERE =$3012;
+
+//************************************************************************/
+//* Window Help API declarations. */
+//************************************************************************/
+
+function WinDestroyHelpInstance(hwndHelpInstance: HWND): Longbool; cdecl;
+function WinCreateHelpInstance(ahab: HAB; var phinitHMInitStructure: HELPINIT): HWND; cdecl;
+function WinAssociateHelpInstance(hwndHelpInstance, hwndApp: HWND): Longbool; cdecl;
+function WinQueryHelpInstance(hwndApp: HWND): HWND; cdecl;
+function WinLoadHelpTable(hwndHelpInstance: HWND; idHelpTable: cardinal; Module: cardinal): Longbool; cdecl;
+function WinCreateHelpTable(hwndHelpInstance: HWND; var phtHelpTable: HELPTABLE): Longbool; cdecl;
+function DdfInitialize(hwndHelpInstance: HWND; cbBuffer, ulIncrement: cardinal): HDDF; cdecl;
+function DdfPara(ahddf: HDDF):Longbool; cdecl;
+function DdfSetFormat(ahddf: HDDF; fFormatType: cardinal): Longbool; cdecl;
+function DdfSetTextAlign(ahddf: HDDF; fAlign: cardinal): Longbool; cdecl;
+function DdfSetColor(ahddf: HDDF; fBackColor, fForColor: Longint): Longbool; cdecl;
+function DdfInform(ahddf: HDDF; var pszText: PChar; resInformNumber: cardinal): Longbool; cdecl;
+function DdfSetFontStyle(ahddf: HDDF; fFontStyle: cardinal): Longbool; cdecl;
+function DdfHyperText(ahddf: HDDF; var pszText, pszReference: PChar; fReferenceType: cardinal): Longbool; cdecl;
+function DdfBeginList(ahddf: HDDF; ulWidthDT, fBreakType, fSpacing: cardinal): Longbool; cdecl;
+function DdfListItem(ahddf: HDDF; var pszTerm, pszDescription: PChar): Longbool; cdecl;
+function DdfEndList(ahddf: HDDF): Longbool; cdecl;
+function DdfMetafile(ahddf: HDDF; ahmf: cardinal; var prclRect: RECTL): Longbool; cdecl;
+function DdfText(ahddf: HDDF; var pszText: PChar): Longbool; cdecl;
+function DdfSetFont(ahddf: HDDF; var pszFaceName: PChar; ulWidth, ulHeight: cardinal): Longbool; cdecl;
+function DdfBitmap(ahddf: HDDF; hbm: HBITMAP; fAlign: cardinal): Longbool; cdecl;
+
+implementation
+
+const
+ HELPMGRDLL='HELPMGR';
+
+function WinDestroyHelpInstance(hwndHelpInstance: HWND): Longbool; cdecl;
+ external HELPMGRDLL index 52;
+function WinCreateHelpInstance(ahab: HAB; var phinitHMInitStructure: HELPINIT): HWND; cdecl;
+ external HELPMGRDLL index 51;
+function WinAssociateHelpInstance(hwndHelpInstance, hwndApp: HWND): Longbool; cdecl;
+ external HELPMGRDLL index 54;
+function WinQueryHelpInstance(hwndApp: HWND): HWND; cdecl;
+ external HELPMGRDLL index 53;
+function WinLoadHelpTable(hwndHelpInstance: HWND; idHelpTable: cardinal; Module: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 55;
+function WinCreateHelpTable(hwndHelpInstance: HWND; var phtHelpTable: HELPTABLE): Longbool; cdecl;
+ external HELPMGRDLL index 56;
+function DdfInitialize(hwndHelpInstance: HWND; cbBuffer, ulIncrement: cardinal): HDDF; cdecl;
+ external HELPMGRDLL index 74;
+function DdfPara (ahddf: HDDF): Longbool; cdecl;
+ external HELPMGRDLL index 75;
+function DdfSetFormat(ahddf: HDDF; fFormatType: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 76;
+function DdfSetTextAlign (ahddf: HDDF; fAlign: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 77;
+function DdfSetColor(ahddf: HDDF; fBackColor, fForColor: Longint): Longbool; cdecl;
+ external HELPMGRDLL index 78;
+function DdfInform(ahddf: HDDF; var pszText: PChar; resInformNumber: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 79;
+function DdfSetFontStyle(ahddf: HDDF; fFontStyle: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 80;
+function DdfHyperText(ahddf: HDDF; var pszText, pszReference: PChar; fReferenceType: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 81;
+function DdfBeginList(ahddf: HDDF; ulWidthDT, fBreakType, fSpacing: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 82;
+function DdfListItem(ahddf: HDDF; var pszTerm, pszDescription: PChar): Longbool; cdecl;
+ external HELPMGRDLL index 83;
+function DdfEndList(ahddf: HDDF): Longbool; cdecl;
+ external HELPMGRDLL index 84;
+function DdfMetafile(ahddf: HDDF; ahmf: cardinal; var prclRect: RECTL): Longbool; cdecl;
+ external HELPMGRDLL index 86;
+function DdfText(ahddf: HDDF; var pszText: PChar): Longbool; cdecl;
+ external HELPMGRDLL index 85;
+function DdfSetFont(ahddf: HDDF; var pszFaceName: PChar; ulWidth, ulHeight: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 87;
+function DdfBitmap(ahddf: HDDF; hbm: HBITMAP; fAlign: cardinal): Longbool; cdecl;
+ external HELPMGRDLL index 88;
+
+end.
+{
+ $Log: pmhelp.pas,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmshl.pas b/rtl/os2/pmshl.pas
new file mode 100644
index 0000000000..4004c602d4
--- /dev/null
+++ b/rtl/os2/pmshl.pas
@@ -0,0 +1,385 @@
+{
+ $Id: pmshl.pas,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Yuri Prokushev (prokushev@freemail.ru).
+
+ OS/2 Presentation Manager Shell constants, types, messages and
+ function declarations.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Warning: This code is alfa. Future versions
+ of this unit might not be compatible.}
+unit pmshl;
+
+Interface
+
+uses
+ Os2Def, PmWin;
+
+
+
+// common types, constants and function declarations
+
+// maximum title length
+const
+ MaxNameL=60;
+
+// program handle
+type
+ HProgram=Cardinal; // hprog
+ PHProgram=^HProgram;
+ HAPP=Cardinal;
+
+// ini file handle
+type
+ HINI=Cardinal; // hini
+ PHINI=^HINI;
+
+const
+ HINI_PROFILE = 0;
+ HINI_USERPROFILE =-1;
+ HINI_SYSTEMPROFILE =-2;
+ HINI_USER = HINI_USERPROFILE;
+ HINI_SYSTEM = HINI_SYSTEMPROFILE;
+
+type
+ PPrfProfile=^PrfProfile;
+ PrfProfile=record // prfpro
+ cchUserName: Cardinal;
+ pszUserName: PChar;
+ cchSysName: Cardinal;
+ pszSysName: PChar;
+ end;
+
+// program list section
+
+// maximum path length
+const
+ MAXPATHL=128;
+
+// root group handle
+const
+ SGH_ROOT = -1;
+
+type
+ PHPROGARRAY=^HPROGARRAY;
+ HPROGARRAY=record // hpga
+ ahprog: Array[1..1] of HProgram;
+ end;
+
+ PROGCATEGORY=Cardinal; // progc
+
+ PPROGCATEGORY=^PROGCATEGORY;
+
+// values acceptable for PROGCATEGORY for PM groups
+const
+ PROG_DEFAULT =0;
+ PROG_FULLSCREEN =1;
+ PROG_WINDOWABLEVIO =2;
+ PROG_PM =3;
+ PROG_GROUP =5;
+ PROG_REAL =4;
+ PROG_VDM =4;
+ PROG_WINDOWEDVDM =7;
+ PROG_DLL =6;
+ PROG_PDD =8;
+ PROG_VDD =9;
+ PROG_WINDOW_REAL =10;
+ PROG_WINDOW_PROT =11;
+ PROG_30_STD =11;
+ PROG_WINDOW_AUTO =12;
+ PROG_SEAMLESSVDM =13;
+ PROG_30_STDSEAMLESSVDM =13;
+ PROG_SEAMLESSCOMMON =14;
+ PROG_30_STDSEAMLESSCOMMON =14;
+ PROG_31_STDSEAMLESSVDM =15;
+ PROG_31_STDSEAMLESSCOMMON =16;
+ PROG_31_ENHSEAMLESSVDM =17;
+ PROG_31_ENHSEAMLESSCOMMON =18;
+ PROG_31_ENH =19;
+ PROG_31_STD =20;
+ PROG_DOS_GAME =21;
+ PROG_WIN_GAME =22;
+ PROG_DOS_MODE =23;
+ PROG_RESERVED =255;
+
+type
+ PProgType=^ProgType;
+ ProgType=record // progt
+ progc: ProgCategory;
+ fbVisible: Cardinal;
+ end;
+
+// visibility flag for PROGTYPE structure
+const
+ SHE_VISIBLE = $00;
+ SHE_INVISIBLE = $01;
+ SHE_RESERVED = $FF;
+
+// Protected group flag for PROGTYPE structure
+const
+ SHE_UNPROTECTED =$00;
+ SHE_PROTECTED =$02;
+
+// Structures associated with 'Prf' calls
+type
+ PPROGDETAILS=^PROGDETAILS;
+ PROGDETAILS=record // progde
+ Length: Cardinal; // set this to sizeof(PROGDETAILS)
+ progt: ProgType;
+ pszTitle: PChar; // any of the pointers can be NULL
+ pszExecutable: PChar;
+ pszParameters: PChar;
+ pszStartupDir: PChar;
+ pszIcon: PChar;
+ pszEnvironment: PChar; // this is terminated by /0/0
+ swpInitial: SWP; // this replaces XYWINSIZE
+ end;
+
+ PPROGTITLE=^PROGTITLE;
+ PROGTITLE=record // progti
+ hprog: HProgram;
+ progt: ProgType;
+ pszTitle: PChar;
+ End;
+
+// Program List API Function Definitions
+
+// Program List API available 'Prf' calls
+
+Function PrfQueryProgramTitles(ahini: HINI; hprogGroup: HProgram;
+ var pTitles: PROGTITLE; cchBufferMax: Cardinal;
+ var pulCount: Cardinal): Cardinal; cdecl;
+ external 'PMSHAPI' index 113;
+
+//*********************************************************************/
+//* NOTE: string information is concatanated after the array of */
+//* PROGTITLE structures so you need to allocate storage */
+//* greater than sizeof(PROGTITLE)*cPrograms to query programs */
+//* in a group. */
+//* */
+//* PrfQueryProgramTitles recommended usage to obtain titles of all */
+//* programs in a group (Hgroup=SGH_ROOT is for all groups): */
+//* */
+//* BufLen = PrfQueryProgramTitles(Hini, Hgroup, */
+//* (PPROGTITLE)NULL, 0, &Count); */
+//* */
+//* Alocate buffer of Buflen */
+//* */
+//* Len = PrfQueryProgramTitles(Hini, Hgroup, (PPROGTITLE)pBuffer, */
+//* BufLen, pCount); */
+//* */
+//*********************************************************************/
+
+Function PrfAddProgram(ahini: HINI; var pDetails: PROGDETAILS;
+ hprogGroup: HProgram): HProgram; cdecl;
+ external 'PMSHAPI' index 109;
+
+Function PrfChangeProgram(ahini: HINI;hprog: HProgram;
+ var pDetails: PROGDETAILS): Longbool; cdecl;
+ external 'PMSHAPI' index 110;
+
+Function PrfQueryDefinition(ahini: HINI; hprog: HProgram;
+ var pDetails: PROGDETAILS;
+ cchBufferMax: Cardinal): Cardinal; cdecl;
+ external 'PMSHAPI' index 111;
+
+//*********************************************************************/
+//* NOTE: string information is concatanated after the PROGDETAILS */
+//* field structure so you need to allocate storage greater */
+//* than sizeof(PROGDETAILS) to query programs */
+//* */
+//* PrfQueryDefinition recomended usage: */
+//* */
+//* bufferlen = PrfQueryDefinition(Hini,Hprog,(PPROGDETAILS)NULL,0) */
+//* */
+//* Alocate buffer of bufferlen bytes */
+//* set Length field (0 will be supported) */
+//* */
+//* (PPROGDETAILS)pBuffer->Length=sizeof(PPROGDETAILS) */
+//* */
+//* len = PrfQueryDefinition(Hini, Hprog, (PPROGDETAILS)pBuffer, */
+//* bufferlen) */
+//*********************************************************************/
+
+Function PrfRemoveProgram(ahini: HINI; hprog: HProgram): Longbool; cdecl;
+ external 'PMSHAPI' index 104;
+
+Function PrfQueryProgramHandle(ahini: HINI; const pszExe: PChar;
+ aphprogArray: HPROGARRAY; cchBufferMax: Cardinal;
+ var pulCount: Cardinal): Longbool; cdecl;
+ external 'PMSHAPI' index 58;
+
+Function PrfCreateGroup(ahini: HINI; const pszTitle: PChar;
+ chVisibility: Byte): HProgram; cdecl;
+ external 'PMSHAPI' index 55;
+
+Function PrfDestroyGroup(ahini: HINI; hprogGroup: HProgram): Longbool; cdecl;
+ external 'PMSHAPI' index 106;
+
+Function PrfQueryProgramCategory(ahini: HINI; const pszExe: PChar): PROGCATEGORY; cdecl;
+ external 'PMSHAPI' index 59;
+
+Function WinStartApp(hwndNotify: HWND; var pDetails: PROGDETAILS; const pszParams: PChar;
+ Reserved: Pointer; fbOptions: Cardinal): HAPP; cdecl;
+ external 'PMSHAPI' index 119;
+
+// bit values for Options parameter
+const
+ SAF_VALIDFLAGS =$001F;
+
+ SAF_INSTALLEDCMDLINE =$0001; // use installed parameters
+ SAF_STARTCHILDAPP =$0002; // related application
+ SAF_MAXIMIZED =$0004; // Start App maximized
+ SAF_MINIMIZED =$0008; // Start App minimized, if !SAF_MAXIMIZED
+ SAF_BACKGROUND =$0010; // Start app in the background
+
+
+Function WinTerminateApp(ahapp: HAPP): Longbool; cdecl;
+ external 'PMSHAPI' index 130;
+
+
+
+// switch list section
+type
+ HSWITCH=Cardinal; // hsw
+ PHSWITCH=^HSWITCH;
+
+ PSWCNTRL=^SWCNTRL;
+ SWCNTRL=record // swctl
+ hwnd_: HWND;
+ hwndIcon: HWND;
+ hprog: HProgram;
+ idProcess: Cardinal;
+ idSession: Cardinal;
+ uchVisibility: Cardinal;
+ fbJump: Cardinal;
+ szSwtitle: Array[1..MaxNameL+4] of Char;
+ bProgType: Cardinal;
+ end;
+
+// visibility flag for SWCNTRL structure
+const
+ SWL_VISIBLE =$04;
+ SWL_INVISIBLE =$01;
+ SWL_GRAYED =$02;
+
+// jump flag for SWCNTRL structure
+const
+ SWL_JUMPABLE =$02;
+ SWL_NOTJUMPABLE =$01;
+
+// Switching Program functions
+Function WinAddSwitchEntry(VAR aps: SWCNTRL): HSWITCH; cdecl;
+ external 'PMSHAPI' index 120;
+Function WinRemoveSwitchEntry(ah:HSWITCH): Cardinal; cdecl;
+ external 'PMSHAPI' index 129;
+
+type
+ PSWENTRY=^SWENTRY;
+ SWENTRY=record // swent
+ hswitch_: HSWITCH;
+ swctl: SWCNTRL;
+ end;
+
+ PSWBLOCK=^SWBLOCK;
+ SWBLOCK=record // swblk
+ cswentry: Cardinal;
+ aswentry: Array[1..1] of SWENTRY;
+ End;
+
+// 32-bit versions of these APIs have 32-bit parameters
+Function WinChangeSwitchEntry(hswitchSwitch: HSWITCH;
+ var pswctlSwitchData: SWCNTRL): Cardinal; cdecl;
+ external 'PMSHAPI' index 123;
+
+Function WinCreateSwitchEntry(ahab: HAB; var pswctlSwitchData: SWCNTRL): HSWITCH; cdecl;
+ external 'PMSHAPI' index 121;
+
+Function WinQuerySessionTitle(ahab: HAB; usSession: Cardinal;
+ var pszTitle: PChar;
+ usTitlelen: Cardinal): Cardinal; cdecl;
+ external 'PMSHAPI' index 122;
+
+Function WinQuerySwitchEntry(hswitchSwitch: HSWITCH;
+ var pswctlSwitchData: SWCNTRL): Cardinal; cdecl;
+ external 'PMSHAPI' index 124;
+
+
+Function WinQuerySwitchHandle(ahwnd: HWND; pidProcess: Cardinal): HSWITCH; cdecl;
+ external 'PMSHAPI' index 125;
+
+Function WinQuerySwitchList(ahab: HAB;var pswblkSwitchEntries: SWBLOCK;
+ usDataLength: Cardinal): Cardinal; cdecl;
+ external 'PMSHAPI' index 126;
+
+Function WinQueryTaskSizePos(ahab: HAB; usScreenGroup: Cardinal;
+ var pswpPositionData: SWP): Cardinal; cdecl;
+ external 'PMSHAPI' index 127;
+
+Function WinQueryTaskTitle(usSession: Cardinal; var pszTitle: PChar;
+ usTitlelen: Cardinal): Cardinal; cdecl;
+ external 'PMSHAPI' index 128;
+
+Function WinSwitchToProgram(hswitchSwHandle: HSWITCH): Cardinal; cdecl;
+ external 'PMSHAPI' index 131;
+
+// OS2.INI Access functions
+
+Function PrfQueryProfileInt(ahini: HINI; const pszApp, pszKey: PChar;
+ sDefault: Longint): Longint; cdecl;
+ external 'PMSHAPI' index 114;
+
+Function PrfQueryProfileString(ahini: HINI; const pszApp, pszKey, pszDefault: PChar;
+ var pBuffer; cchBufferMax: Cardinal): Cardinal; cdecl;
+ external 'PMSHAPI' index 115;
+
+Function PrfWriteProfileString(ahini: HINI; const pszApp, pszKey, pszData: PChar): Longbool; cdecl;
+ external 'PMSHAPI' index 116;
+
+Function PrfQueryProfileSize(ahini: HINI; const pszApp, pszKey: PChar;
+ var pulReqLen: Cardinal): Longbool; cdecl;
+ external 'PMSHAPI' index 101;
+
+Function PrfQueryProfileData(ahini: HINI; const pszApp, pszKey: PChar; var pBuffer;
+ var pulBuffLen: Cardinal): Longbool; cdecl;
+ external 'PMSHAPI' index 117;
+
+Function PrfWriteProfileData(ahini: HINI; const pszApp, pszKey: PChar; var pData;
+ cchDataLen: Cardinal): Longbool; cdecl;
+ external 'PMSHAPI' index 118;
+
+Function PrfOpenProfile(ahab: HAB;const pszFileName: PChar): HINI; cdecl;
+ external 'PMSHAPI' index 102;
+
+Function PrfCloseProfile(ahini: HINI): Longbool; cdecl;
+ external 'PMSHAPI' index 103;
+
+Function PrfReset(ahab: HAB; var apPrfProfile: PrfProfile): Longbool; cdecl;
+ external 'PMSHAPI' index 108;
+
+Function PrfQueryProfile(ahab: HAB; var apPrfProfile: PrfProfile): Longbool; cdecl;
+ external 'PMSHAPI' index 107;
+
+// public message, broadcast on WinReset
+const
+ PL_ALTERED=$008E; // WM_SHELLFIRST + 0E
+
+Implementation
+
+End.
+
+{
+$Log: pmshl.pas,v $
+Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmspl.pas b/rtl/os2/pmspl.pas
new file mode 100644
index 0000000000..027172de59
--- /dev/null
+++ b/rtl/os2/pmspl.pas
@@ -0,0 +1,777 @@
+{****************************************************************************
+
+ $Id: pmspl.pas,v 1.3 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by the Free Pascal development team.
+
+ OS/2 Presentation Manager spooler constants, types
+ and functions implemented in PMSPL.DLL.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+
+unit PMSpl;
+
+interface
+
+{$MODE OBJFPC}
+
+uses OS2Def;
+
+const
+ SPL_INI_SPOOLER = 'PM_SPOOLER';
+ SPL_INI_QUEUE = 'PM_SPOOLER_QUEUE';
+ SPL_INI_PRINTER = 'PM_SPOOLER_PRINTER';
+ SPL_INI_PRINTERDESCR = 'PM_SPOOLER_PRINTER_DESCR';
+ SPL_INI_QUEUEDESCR = 'PM_SPOOLER_QUEUE_DESCR';
+ SPL_INI_QUEUEDD = 'PM_SPOOLER_QUEUE_DD';
+ SPL_INI_QUEUEDDDATA = 'PM_SPOOLER_QUEUE_DDDATA';
+
+{ General SPL return values }
+ SPL_ERROR = 0;
+ SPL_OK = 1;
+
+type
+{ Handle to a spool file }
+ HSpl = cardinal;
+
+{ Used in recording of PM_Q_STD data via SplStdxxx calls }
+ HStd = cardinal;
+ PHStd = ^HStd;
+
+{ Spooler manager open data }
+ QMOpenData = PChar;
+ PQMOpenData = ^PChar;
+
+{ Spooler Queue Processor interface }
+
+const
+{ Control codes for SplQpControl }
+ SPLC_ABORT = 1;
+ SPLC_PAUSE = 2;
+ SPLC_CONTINUE = 3;
+
+{ Flag defines for optional SplQpQueryFlags }
+{ Set this to allow spooler to bypass Queue Processor for PM_Q_Raw
+ jobs. This allows print while a job is still spooling. }
+ QP_RawData_Bypass = $00000001;
+
+type
+{ Handle to a spooler queue processor }
+ HProc = cardinal;
+
+ PQPOpenData = ^PChar;
+
+const
+{ Definition for elements within the PQPOpenData block }
+ QPDAT_ADDRESS = 0;
+ QPDAT_DRIVER_NAME = 1;
+ QPDAT_DRIVER_DATA = 2;
+ QPDAT_DATA_TYPE = 3;
+ QPDAT_COMMENT = 4;
+ QPDAT_PROC_PARAMS = 5;
+ QPDAT_SPL_PARAMS = 6; { SplQmOpen Spooler params }
+ QPDAT_NET_PARAMS = 7; { SplQmOpen Network params }
+ QPDAT_DOC_NAME = 8; { SplQmStartDoc name }
+ QPDAT_QUEUE_NAME = 9; { Queue name for job }
+ QPDAT_TOKEN = 10; { SplQmOpen token name }
+ QPDAT_JOBID = 11; { SQM job identity }
+
+type
+ TSQPOpenData = record
+ pszLogAddress: PChar;
+ pszDriverName: PChar;
+ pdriv: PDrivData;
+ pszDataType: PChar;
+ pszComment: PChar;
+ pszProcParams: PChar;
+ pszSpoolParams: PChar;
+ pszNetworkParams: PChar;
+ pszDocName: PChar;
+ pszQueueName: PChar;
+ pszToken: PChar;
+ idJobId: word;
+ end;
+ PSQPOpenData = ^TSQPOpenData;
+ SQPOpenData = TSQPOpenData;
+
+{ Error information and return codes }
+const
+{ Error information for SplMessageBox }
+ SPLINFO_QPERROR = $0001;
+ SPLINFO_DDERROR = $0002;
+ SPLINFO_SPLERROR = $0004;
+ SPLINFO_OTHERERROR = $0080;
+ SPLINFO_INFORMATION = $0100;
+ SPLINFO_WARNING = $0200;
+ SPLINFO_ERROR = $0400;
+ SPLINFO_SEVERE = $0800;
+ SPLINFO_USERINTREQD = $1000;
+
+{ Error Data for SplMessageBox }
+ SPLDATA_PRINTERJAM = $0001;
+ SPLDATA_FORMCHGREQD = $0002;
+ SPLDATA_CARTCHGREQD = $0004;
+ SPLDATA_PENCHGREQD = $0008;
+ SPLDATA_DATAERROR = $0010;
+ SPLDATA_UNEXPECTERROR= $0020;
+ SPLDATA_OTHER = $8000;
+
+{ Return code for fSplStdQueryLength }
+ SSQL_ERROR = -1;
+
+type
+ SPLERR = cardinal;
+
+const
+{ length for character arrays in structs (excluding zero terminator) }
+ CNLEN = 15; { Computer name length }
+ UNLEN = 20; { Maximum user name length }
+ QNLEN = 12; { Queue name maximum length }
+ PDLEN = 8; { Print destination length }
+ DTLEN = 9; { Spool file data type }
+ { e.g. PM_Q_STD,PM_Q_RAW }
+ QP_DATATYPE_SIZE = 15; { returned by SplQpQueryDt }
+ DRIV_DEVICENAME_SIZE = 31; { see DRIVDATA struc }
+ DRIV_NAME_SIZE = 8; { name of device driver }
+ PRINTERNAME_SIZE = 32; { max printer name length }
+ FORMNAME_SIZE = 31; { max form name length }
+ MAXCOMMENTSZ = 48; { queue comment length }
+
+type
+ TDrivProps = record
+ pszKeyName: PChar;
+ cbBuf: cardinal;
+ pBuf: pointer;
+ end;
+ PDrivProps =^TDrivProps;
+ DrivProps = TDrivProps;
+ NPDrivProps = ^DrivProps;
+
+ TPrJInfo = record
+ uJobId: word;
+ szUserName: array [0..UNLen] of char;
+ pad_1: char;
+ szNotifyName: array [0..CNLen] of char;
+ szDataType: array [0..DTLen] of char;
+ pszParms: PChar;
+ uPosition: word;
+ fsStatus: word;
+ pszStatus: PChar;
+ ulSubmitted: cardinal;
+ ulSize: cardinal;
+ pszComment: PChar;
+ end;
+ PPrJInfo = ^TPrJInfo;
+ PrJInfo = TPrJInfo;
+ NPPrJInfo = ^TPrJInfo;
+
+ TPrJInfo2 = record
+ uJobId: word;
+ uPriority: word;
+ pszUserName: PChar;
+ uPosition: word;
+ fsStatus: word;
+ ulSubmitted: cardinal;
+ ulSize: cardinal;
+ pszComment: PChar;
+ pszDocument: PChar;
+ end;
+ PPrJInfo2 = ^TPrJInfo2;
+ PrJInfo2 = TPrJInfo2;
+ NPPrJInfo2 = ^TPrJInfo2;
+
+ TPrJInfo3 = record
+ uJobId: word;
+ uPriority: word;
+ pszUserName: PChar;
+ uPosition: word;
+ fsStatus: word;
+ ulSubmitted: cardinal;
+ ulSize: cardinal;
+ pszComment: PChar;
+ pszDocument: PChar;
+ pszNotifyName: PChar;
+ pszDataType: PChar;
+ pszParms: PChar;
+ pszStatus: PChar;
+ pszQueue: PChar;
+ pszQProcName: PChar;
+ pszQProcParms: PChar;
+ pszDriverName: PChar;
+ pDriverData: PDrivData;
+ pszPrinterName: PChar;
+ end;
+ PPrJInfo3 = ^TPrJInfo3;
+ PrJInfo3 = TPrJInfo3;
+ NPPrJInfo3 = ^TPrJInfo3;
+
+ TPrDInfo = record
+ szName: array [0..PDLen] of char;
+ szUserName: array [0..UNLen] of char;
+ uJobId: word;
+ fsStatus: word;
+ pszStatus: PChar;
+ time: word;
+ end;
+ PPrDInfo = ^TPrDInfo;
+ PrDInfo = TPrDInfo;
+ NPPrDInfo = ^TPrDInfo;
+
+ TPrDInfo3 = record
+ pszPrinterName: PChar;
+ pszUserName: PChar;
+ pszLogAddr: PChar;
+ uJobId: word;
+ fsStatus: word;
+ pszStatus: PChar;
+ pszComment: PChar;
+ pszDrivers: PChar;
+ time: word;
+ usTimeOut: word;
+ end;
+ PPrDInfo3 = ^TPrDInfo3;
+ PrDInfo3 = TPrDInfo3;
+ NPPrDInfo3 = ^TPrDInfo3;
+
+ TPrQInfo = record
+ szName: array [0..QNLen] of char;
+ pad_1: char;
+ uPriority: word;
+ uStartTime: word;
+ uUntilTime: word;
+ pszSepFile: PChar;
+ pszPrProc: PChar;
+ pszDestinations: PChar;
+ pszParms: PChar;
+ pszComment: PChar;
+ fsStatus: word;
+ cJobs: word;
+ end;
+ PPrQInfo = ^TPrQInfo;
+ PrQInfo = TPrQInfo;
+ NPPrQInfo = ^TPrQInfo;
+
+ TPrQInfo3 = record
+ pszName: PChar;
+ uPriority: word;
+ uStartTime: word;
+ uUntilTime: word;
+ fsType: word;
+ pszSepFile: PChar;
+ pszPrProc: PChar;
+ pszParms: PChar;
+ pszComment: PChar;
+ fsStatus: word;
+ cJobs: word;
+ pszPrinters: PChar;
+ pszDriverName: PChar;
+ pDriverData: PDrivData;
+ end;
+ PPrQInfo3 = ^TPrQInfo3;
+ PrQInfo3 = TPrQInfo3;
+ NPPrQInfo3 = ^TPrQInfo3;
+
+ TPrQInfo6 = record
+ pszName: PChar;
+ uPriority: word;
+ uStartTime: word;
+ uUntilTime: word;
+ fsType: word;
+ pszSepFile: PChar;
+ pszPrProc: PChar;
+ pszParms: PChar;
+ pszComment: PChar;
+ fsStatus: word;
+ cJobs: word;
+ pszPrinters: PChar;
+ pszDriverName: PChar;
+ pDriverData: PDrivData;
+ pszRemoteComputerName: PChar;
+ pszRemoteQueueName: PChar;
+ end;
+ PPrQInfo6 = ^TPrQInfo6;
+ PrQInfo6 = TPrQInfo6;
+ NPPrQInfo6 = ^TPrQInfo6;
+
+{ Structure for DosPrintJobGetId }
+ TPrIDInfo = record
+ uJobId: word;
+ szComputerName: array [0..CNLen] of char;
+ szQueueName: array [0..QNLen] of char;
+ pad_1: char;
+ end;
+ PPrIDInfo = ^TPrIDInfo;
+ PrIDInfo = TPrIDInfo;
+ NPPrIDInfo = ^TPrIDInfo;
+
+{ Structure for DosPrintDriverEnum }
+ TPrDrivInfo = record
+ szDrivName: array [0..Driv_Name_Size+1+Driv_DeviceName_Size] of char;
+ end;
+ PPrDrivInfo = ^TPrDrivInfo;
+ PrDrivInfo = TPrDrivInfo;
+ NPPrDrivInfo = ^TPrDrivInfo;
+
+{ Structure for DosPrintQProcessorEnum }
+ TPrQProcInfo = record
+ szQProcName: array [0..QNLen] of char;
+ end;
+ PPrQProcInfo = ^TPrQProcInfo;
+ PrQProcInfo = TPrQProcInfo;
+ NPPrQProcInfo = ^TPrQProcInfo;
+
+{ Structure for DosPrintPortEnum Level 0 }
+ TPrPortInfo = record
+ szPortName: array [0..PDLen] of char;
+ end;
+ PPrPortInfo = ^TPrPortInfo;
+ PrPortInfo = TPrPortInfo;
+ NPPrPortInfo = ^TPrPortInfo;
+
+{ Structure for DosPrintPortEnum Level 1 }
+ TPrPortInfo1 = record
+ pszPortName : PChar;
+ pszPortDriverName : PChar;
+ pszPortDriverPathName : PChar;
+ end;
+ PPrPortInfo1 = ^TPrPortInfo1;
+ PrPortInfo1 = TPrPortInfo1;
+ NPPrPortInfo1 = ^TPrPortInfo1;
+
+
+const
+{ Values for parmnum in DosPrintQSetInfo/SplSetQueue }
+ PRQ_PRIORITY_PARMNUM = 2;
+ PRQ_STARTTIME_PARMNUM = 3;
+ PRQ_UNTILTIME_PARMNUM = 4;
+ PRQ_SEPARATOR_PARMNUM = 5;
+ PRQ_PROCESSOR_PARMNUM = 6;
+ PRQ_DESTINATIONS_PARMNUM = 7;
+ PRQ_PARMS_PARMNUM = 8;
+ PRQ_COMMENT_PARMNUM = 9;
+ PRQ_TYPE_PARMNUM = 10;
+ PRQ_PRINTERS_PARMNUM = 12;
+ PRQ_DRIVERNAME_PARMNUM = 13;
+ PRQ_DRIVERDATA_PARMNUM = 14;
+ PRQ_REMOTE_COMPUTER_PARMNUM = 15;
+ PRQ_REMOTE_QUEUE_PARMNUM = 16;
+ PRQ_MAXPARMNUM = 16;
+
+{ Print queue priority }
+ PRQ_MAX_PRIORITY = 1; { highest priority }
+ PRQ_DEF_PRIORITY = 5; { default priority }
+ PRQ_MIN_PRIORITY = 9; { lowest priority }
+ PRQ_NO_PRIORITY = 0;
+
+{ Print queue status bitmask and values for level 1 }
+ PRQ_STATUS_MASK = 3;
+ PRQ_ACTIVE = 0;
+ PRQ_PAUSED = 1; { queue is held }
+ PRQ_ERROR = 2;
+ PRQ_PENDING = 3; { pending deletion }
+
+{ Print queue status bits for level 3 }
+ PRQ3_PAUSED = 1; { queue is held }
+ PRQ3_PENDING = 2; { pending deletion }
+
+{ Print queue type bits for level 3 }
+ PRQ3_TYPE_RAW = 1; { spools printer-specific data }
+ PRQ3_TYPE_BYPASS = 2; { allow print while spooling }
+ PRQ3_TYPE_APPDEFAULT = 4; { set for application }
+ { default queue }
+
+{ Values for parmnum in DosPrintJobSetInfo/SplSetJob }
+ PRJ_NOTIFYNAME_PARMNUM = 3;
+ PRJ_DATATYPE_PARMNUM = 4;
+ PRJ_PARMS_PARMNUM = 5;
+ PRJ_POSITION_PARMNUM = 6;
+ PRJ_JOBFILEINUSE_PARMNUM = 7;
+ PRJ_COMMENT_PARMNUM = 11;
+ PRJ_DOCUMENT_PARMNUM = 12;
+ PRJ_STATUSCOMMENT_PARMNUM = 13;
+ PRJ_PRIORITY_PARMNUM = 14;
+ PRJ_PROCPARMS_PARMNUM = 16;
+ PRJ_DRIVERDATA_PARMNUM = 18;
+ PRJ_MAXPARMNUM = 18;
+
+{ Bitmap masks for status field of TPrJInfo }
+{ Bits 2-7 also used in device status }
+ PRJ_QSTATUS = $0003; { bits 0,1 }
+ PRJ_DEVSTATUS = $0ffc; { bits 2-11 }
+ PRJ_COMPLETE = $0004; { bit 2 }
+ PRJ_INTERV = $0008; { bit 3 }
+ PRJ_ERROR = $0010; { bit 4 }
+ PRJ_DESTOFFLINE = $0020; { bit 5 }
+ PRJ_DESTPAUSED = $0040; { bit 6 }
+ PRJ_NOTIFY = $0080; { bit 7 }
+ PRJ_DESTNOPAPER = $0100; { bit 8 }
+ PRJ_DESTFORMCHG = $0200; { bit 9 }
+ PRJ_DESTCRTCHG = $0400; { bit 10 }
+ PRJ_DESTPENCHG = $0800; { bit 11 }
+ PRJ_JOBFILEINUSE = $4000; { bit 14 }
+ PRJ_DELETED = $8000; { bit 15 }
+
+{ Values of PRJ_QSTATUS bits in fsStatus field of TPrJInfo }
+ PRJ_QS_QUEUED = 0;
+ PRJ_QS_PAUSED = 1;
+ PRJ_QS_SPOOLING = 2;
+ PRJ_QS_PRINTING = 3;
+
+{ Print Job Priority }
+ PRJ_MAX_PRIORITY = 99; { lowest priority }
+ PRJ_MIN_PRIORITY = 1; { highest priority }
+ PRJ_NO_PRIORITY = 0;
+
+{ Bitmap masks for status field of TPrDInfo }
+ PRD_STATUS_MASK = $0003; { bits 0,1 }
+ PRD_DEVSTATUS = $0ffc; { bits 2-11 }
+
+{ Values of PRD_STATUS_MASK bits in fsStatus field of TPrDInfo }
+ PRD_ACTIVE = 0;
+ PRD_PAUSED = 1;
+
+{ Control codes used in DosPrintDestControl/SplControlDevice }
+ PRD_DELETE = 0;
+ PRD_PAUSE = 1;
+ PRD_CONT = 2;
+ PRD_RESTART = 3;
+
+{ Values for parmnum in DosPrintDestSetInfo/SplSetDevice }
+ PRD_LOGADDR_PARMNUM = 3;
+ PRD_COMMENT_PARMNUM = 7;
+ PRD_DRIVERS_PARMNUM = 8;
+ PRD_TIMEOUT_PARMNUM = 10;
+
+type
+{ Structure for SplEnumPrinter }
+ TPrinterInfo = record
+ fltype: cardinal;
+ pszComputerName: PChar;
+ pszPrintDestinationName: PChar;
+ pszDescription: PChar;
+ pszLocalName: PChar;
+ end;
+ PrinterInfo = TPrinterInfo;
+ PPrinterInfo = ^TPrinterInfo;
+
+const
+{ Flags for fltype in PRINTERINFO and SplEnumPrinter }
+ SPL_PR_QUEUE = $00000001; { include queues }
+ SPL_PR_DIRECT_DEVICE = $00000002; { unattached devices }
+ SPL_PR_QUEUED_DEVICE = $00000004; { queued devices }
+ SPL_PR_LOCAL_ONLY = $00000100; { exclude remote queues }
+
+
+function SplQueryDevice (const pszComputerName, pszPrintDeviceName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcbNeeded: cardinal): longint; cdecl;
+
+function SplQueryQueue (const pszComputerName, pszQueueName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcbNeeded: cardinal): longint; cdecl;
+
+function SplEnumQueue (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): longint; cdecl;
+
+function SplQmOpen (const pszToken: PChar; lCount: longint;
+ var pqmdopData: PChar): cardinal; cdecl;
+
+function SplQmStartDoc (ahspl: cardinal; const pszDocName: PChar): longbool;
+ cdecl;
+
+function SplQmWrite (ahspl: cardinal; lCount: longint; var pData): longbool;
+ cdecl;
+
+function SplQmEndDoc (ahspl: cardinal): longbool; cdecl;
+
+function SplQmClose(ahspl: cardinal): longbool; cdecl;
+
+function SplQmAbort(ahspl: cardinal): longbool; cdecl;
+
+function SplQmAbortDoc (ahspl: cardinal): longbool; cdecl;
+
+function SplMessageBox (const pszLogAddr: PChar; fErrInfo, fErrData: cardinal;
+ const pszText, pszCaption: PChar;
+ idWindow, fStyle: cardinal): cardinal; cdecl;
+
+function PrtOpen (const pszDeviceName: PChar; var phDevice: cardinal;
+ var pActionTaken: cardinal;cbFileSize,uFileAttr: cardinal;
+ openFlag,openMode,reserved: cardinal): cardinal;
+ cdecl;
+
+function PrtClose (hDevice: cardinal): cardinal; cdecl;
+
+function PrtWrite (hDevice: cardinal; var pchData; cbData: cardinal;
+ var pcbWritten: cardinal): cardinal; cdecl;
+
+function PrtDevIOCtl (var pData; var pParms; ufunction, uCategory: cardinal;
+ hDevice: cardinal): cardinal; cdecl;
+
+procedure PrtAbort (hDevice: cardinal); cdecl;
+
+function SplStdOpen (ahdc: cardinal): longbool; cdecl;
+
+function SplStdClose (ahdc: cardinal): longbool; cdecl;
+
+function SplStdStart(ahdc: cardinal): longbool; cdecl;
+
+function SplStdStop (ahdc: cardinal): cardinal; cdecl;
+
+function SplStdDelete (hMetaFile: cardinal): longbool; cdecl;
+
+function SplStdGetBits (hMetaFile: cardinal; offData, cbData: longint;
+ var pchData): longbool; cdecl;
+
+function SplStdQueryLength (hMetaFile: cardinal): longint; cdecl;
+
+function SplCreateDevice (const pszComputerName: PChar;ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal): cardinal; cdecl;
+
+function SplControlDevice (const pszComputerName, pszPortName: PChar;
+ ulControl: cardinal): cardinal; cdecl;
+
+function SplDeleteDevice (const pszComputerName,
+ pszPrintDeviceName: PChar): cardinal; cdecl;
+
+function SplEnumDevice (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl;
+
+function SplSetDevice (const pszComputerName, pszPrintDeviceName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf, ulParmNum: cardinal): cardinal; cdecl;
+
+function SplReleaseJob (const pszComputerName, pszQueueName: PChar;
+ ulJob: cardinal): cardinal; cdecl;
+
+function SplDeleteJob (const pszComputerName, pszQueueName: PChar;
+ ulJob: cardinal): cardinal; cdecl;
+
+function SplEnumJob (const pszComputerName, pszQueueName: PChar;
+ ulLevel: cardinal; var pBuf;cbBuf: cardinal;
+ var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl;
+
+function SplQueryJob (const pszComputerName, pszQueueName: PChar;
+ ulJob, ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcbNeeded: cardinal): cardinal; cdecl;
+
+function SplHoldJob (const pszComputerName, pszQueueName: PChar;
+ ulJob: cardinal): cardinal; cdecl;
+
+function SplSetJob (const pszComputerName, pszQueueName: PChar;
+ ulJob, ulLevel: cardinal; var pBuf;
+ cbBuf, ulParmNum: cardinal): cardinal; cdecl;
+
+function SplCreateQueue (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal): cardinal; cdecl;
+
+function SplReleaseQueue (const pszComputerName,
+ pszQueueName: PChar): cardinal; cdecl;
+
+function SplDeleteQueue (const pszComputerName, pszQueueName: PChar): cardinal;
+ cdecl;
+
+function SplHoldQueue (const pszComputerName, pszQueueName: PChar): cardinal;
+ cdecl;
+
+function SplPurgeQueue (const pszComputerName, pszQueueName: PChar): cardinal;
+ cdecl;
+
+function SplSetQueue (const pszComputerName, pszQueueName: PChar;
+ ulLevel: cardinal; var pBuf;cbBuf,ulParmNum: cardinal): cardinal; cdecl;
+
+function SplEnumDriver (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned,pcTotal,pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl;
+
+function SplEnumPort (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl;
+
+function SplEnumQueueProcessor (const pszComputerName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf: cardinal; var pcReturned, pcTotal,
+ pcbNeeded: cardinal; var pReserved): cardinal; cdecl;
+
+function SplEnumPrinter (const pszComputerName: PChar;
+ uLevel, fltype: cardinal; var pBuf; cbbuf: cardinal; var pcReturned,
+ pcTotal, pcbNeeded: cardinal; var pReserved): cardinal; cdecl;
+
+function SplCopyJob (const pszSrcComputerName, pszSrcQueueName: PChar;
+ ulSrcJob: cardinal; const pszTrgComputerName, pszTrgQueueName: PChar;
+ var pulTrgJob: cardinal): cardinal; cdecl;
+
+
+implementation
+
+function SplQueryDevice (const pszComputerName, pszPrintDeviceName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcbNeeded: cardinal): longint;
+ cdecl; external 'PMSPL' index 381;
+
+function SplQueryQueue (const pszComputerName, pszQueueName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcbNeeded: cardinal): longint;
+ cdecl; external 'PMSPL' index 397;
+
+function SplEnumQueue (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): longint; cdecl; external 'PMSPL' index 399;
+
+function SplQmOpen (const pszToken: PChar; lCount: longint;
+ var pqmdopData: PChar): cardinal; cdecl; external 'PMSPL' index 301;
+
+function SplQmStartDoc (ahspl: cardinal; const pszDocName: PChar): longbool;
+ cdecl; external 'PMSPL' index 302;
+
+function SplQmWrite (ahspl: cardinal; lCount: longint; var pData): longbool;
+ cdecl; external 'PMSPL' index 304;
+
+function SplQmEndDoc (ahspl: cardinal): longbool;
+ cdecl; external 'PMSPL' index 303;
+
+function SplQmClose (ahspl: cardinal): longbool;
+ cdecl; external 'PMSPL' index 306;
+
+function SplQmAbort (ahspl: cardinal): longbool;
+ cdecl; external 'PMSPL' index 305;
+
+function SplQmAbortDoc (ahspl: cardinal): longbool;
+ cdecl; external 'PMSPL' index 308;
+
+function SplMessageBox (const pszLogAddr: PChar; fErrInfo, fErrData: cardinal;
+ const pszText, pszCaption: PChar; idWindow, fStyle: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 307;
+
+function PrtOpen (const pszDeviceName: PChar; var phDevice: cardinal;
+ var pActionTaken: cardinal; cbFileSize, uFileAttr: cardinal;
+ openFlag, openMode, reserved: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 370;
+
+function PrtClose (hDevice: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 373;
+
+function PrtWrite (hDevice: cardinal; var pchData; cbData: cardinal;
+ var pcbWritten: cardinal): cardinal; cdecl; external 'PMSPL' index 371;
+
+function PrtDevIOCtl (var pData; var pParms; ufunction, uCategory: cardinal;
+ hDevice: cardinal): cardinal; cdecl; external 'PMSPL' index 372;
+
+procedure PrtAbort (hDevice: cardinal); cdecl; external 'PMSPL' index 375;
+
+function SplStdOpen (ahdc: cardinal): longbool;
+ cdecl; external 'PMSPL' index 350;
+
+function SplStdClose (ahdc: cardinal): longbool;
+ cdecl; external 'PMSPL' index 351;
+
+function SplStdStart (ahdc: cardinal): longbool;
+ cdecl; external 'PMSPL' index 352;
+
+function SplStdStop (ahdc: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 353;
+
+function SplStdDelete (hMetaFile: cardinal): longbool;
+ cdecl; external 'PMSPL' index 354;
+
+function SplStdGetBits (hMetaFile: cardinal; offData, cbData: longint;
+ var pchData): longbool; cdecl; external 'PMSPL' index 355;
+
+function SplStdQueryLength (hMetaFile: cardinal): longint;
+ cdecl; external 'PMSPL' index 356;
+
+function SplCreateDevice (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal): cardinal; cdecl; external 'PMSPL' index 401;
+
+function SplControlDevice (const pszComputerName, pszPortName: PChar;
+ ulControl: cardinal): cardinal; cdecl; external 'PMSPL' index 380;
+
+function SplDeleteDevice (const pszComputerName,
+ pszPrintDeviceName: PChar): cardinal; cdecl; external 'PMSPL' index 403;
+
+function SplEnumDevice (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned,pcTotal,pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl; external 'PMSPL' index 382;
+
+function SplSetDevice (const pszComputerName, pszPrintDeviceName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf, ulParmNum: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 402;
+
+function SplReleaseJob (const pszComputerName, pszQueueName: PChar;
+ ulJob: cardinal): cardinal; cdecl; external 'PMSPL' index 384;
+
+function SplDeleteJob (const pszComputerName, pszQueueName: PChar;
+ ulJob: cardinal): cardinal; cdecl; external 'PMSPL' index 386;
+
+function SplEnumJob (const pszComputerName, pszQueueName: PChar;
+ ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl; external 'PMSPL' index 392;
+
+function SplQueryJob (const pszComputerName, pszQueueName: PChar;
+ ulJob, ulLevel: cardinal; var pBuf; cbBuf: cardinal;
+ var pcbNeeded: cardinal): cardinal; cdecl; external 'PMSPL' index 390;
+
+function SplHoldJob (const pszComputerName, pszQueueName: PChar;
+ ulJob: cardinal): cardinal; cdecl; external 'PMSPL' index 385;
+
+function SplSetJob (const pszComputerName, pszQueueName: PChar;
+ ulJob, ulLevel: cardinal; var pBuf;cbBuf,ulParmNum: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 391;
+
+function SplCreateQueue (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal): cardinal; cdecl; external 'PMSPL' index 393;
+
+function SplReleaseQueue (const pszComputerName,
+ pszQueueName: PChar): cardinal; cdecl; external 'PMSPL' index 395;
+
+function SplDeleteQueue (const pszComputerName, pszQueueName: PChar): cardinal;
+ cdecl; external 'PMSPL' index 396;
+
+function SplHoldQueue (const pszComputerName, pszQueueName: PChar): cardinal;
+ cdecl; external 'PMSPL' index 394;
+
+function SplPurgeQueue (const pszComputerName, pszQueueName: PChar): cardinal;
+ cdecl; external 'PMSPL' index 404;
+
+function SplSetQueue (const pszComputerName, pszQueueName: PChar;
+ ulLevel: cardinal; var pBuf;cbBuf,ulParmNum: cardinal): cardinal;
+ cdecl; external 'PMSPL' index 398;
+
+function SplEnumDriver (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl; external 'PMSPL' index 406;
+
+function SplEnumPort (const pszComputerName: PChar; ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned,pcTotal,pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl; external 'PMSPL' index 408;
+
+function SplEnumQueueProcessor (const pszComputerName: PChar;ulLevel: cardinal;
+ var pBuf; cbBuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl; external 'PMSPL' index 407;
+
+function SplEnumPrinter (const pszComputerName: PChar;uLevel, fltype: cardinal;
+ var pBuf; cbbuf: cardinal; var pcReturned, pcTotal, pcbNeeded: cardinal;
+ var pReserved): cardinal; cdecl; external 'PMSPL' index 441;
+
+function SplCopyJob (const pszSrcComputerName, pszSrcQueueName: PChar;
+ ulSrcJob: cardinal; const pszTrgComputerName, pszTrgQueueName: PChar;
+ var pulTrgJob: cardinal): cardinal; cdecl; external 'PMSPL' index 442;
+
+
+end.
+
+{
+ $Log: pmspl.pas,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmstddlg.pas b/rtl/os2/pmstddlg.pas
new file mode 100644
index 0000000000..d59ad80c65
--- /dev/null
+++ b/rtl/os2/pmstddlg.pas
@@ -0,0 +1,1293 @@
+{****************************************************************************
+
+ $Id: pmstddlg.pas,v 1.5 2005/02/14 17:13:31 peter Exp $
+
+ PMSTDDLG interface unit
+ FPC Pascal Runtime Library for OS/2
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ Copyright (c) 2002 by Yuri Prokushev
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+
+{Warning: This code is alfa. Future versions of this unit will propably
+ not be compatible.}
+
+unit PMStdDlg;
+
+ interface
+
+ uses
+ os2def,doscalls,pmwin,pmgpi;
+
+ const
+ FDS_CENTER = $00000001;
+ FDS_CUSTOM = $00000002;
+ FDS_FILTERUNION = $00000004;
+ FDS_HELPBUTTON = $00000008;
+ FDS_APPLYBUTTON = $00000010;
+ FDS_PRELOAD_VOLINFO = $00000020;
+ FDS_MODELESS = $00000040;
+ FDS_INCLUDE_EAS = $00000080;
+ FDS_OPEN_DIALOG = $00000100;
+ FDS_SAVEAS_DIALOG = $00000200;
+ FDS_MULTIPLESEL = $00000400;
+ FDS_ENABLEFILELB = $00000800;
+ FDS_EFSELECTION = 0;
+ FDS_LBSELECTION = 1;
+ FDS_SUCCESSFUL = 0;
+ FDS_ERR_DEALLOCATE_MEMORY = 1;
+ FDS_ERR_FILTER_TRUNC = 2;
+ FDS_ERR_INVALID_DIALOG = 3;
+ FDS_ERR_INVALID_DRIVE = 4;
+ FDS_ERR_INVALID_FILTER = 5;
+ FDS_ERR_INVALID_PATHFILE = 6;
+ FDS_ERR_OUT_OF_MEMORY = 7;
+ FDS_ERR_PATH_TOO_LONG = 8;
+ FDS_ERR_TOO_MANY_FILE_TYPES = 9;
+ FDS_ERR_INVALID_VERSION = 10;
+ FDS_ERR_INVALID_CUSTOM_HANDLE = 11;
+ FDS_ERR_DIALOG_LOAD_ERROR = 12;
+ FDS_ERR_DRIVE_ERROR = 13;
+ FDM_FILTER = WM_USER+40;
+ FDM_VALIDATE = WM_USER+41;
+ FDM_ERROR = WM_USER+42;
+
+ type
+ APSZ = array [0..0] of PChar;
+
+ PAPSZ = ^APSZ;
+
+ FileDlg = record
+ cbSize : cardinal;
+ fl : cardinal;
+ ulUser : cardinal;
+ lReturn : longint;
+ lSRC : longint;
+ pszTitle : PChar;
+ pszOKButton : PChar;
+ pfnDlgProc : Pointer;
+ pszIType : PChar;
+ papszITypeList : PAPSZ;
+ pszIDrive : PChar;
+ papszIDriveList : PAPSZ;
+ hMod : cardinal;
+ szFullFile : array [0..MaxPathLength-1] of char;
+ papszFQFilename : PAPSZ;
+ ulFQFCount : cardinal;
+ usDlgId : word;
+ x : integer;
+ y : integer;
+ sEAType : integer;
+ end;
+
+ PFileDlg = ^FileDlg;
+
+
+ function WinFileDlg (hwndP: HWnd; hwndO: HWnd; pfild: PFileDlg) : HWnd; cdecl;
+
+ function WinDefFileDlgProc (hwnd : HWnd;msg : cardinal;mp1 : MPARAM;mp2 : MPARAM) : MRESULT; cdecl;
+
+ function WinFreeFileDlgList(papszFQFilename : PAPSZ) : Longbool; cdecl;
+
+ const
+ DID_FILE_DIALOG = 256;
+ DID_FILENAME_TXT = 257;
+ DID_FILENAME_ED = 258;
+ DID_DRIVE_TXT = 259;
+ DID_DRIVE_CB = 260;
+ DID_FILTER_TXT = 261;
+ DID_FILTER_CB = 262;
+ DID_DIRECTORY_TXT = 263;
+ DID_DIRECTORY_LB = 264;
+ DID_FILES_TXT = 265;
+ DID_FILES_LB = 266;
+ DID_HELP_PB = 267;
+ DID_APPLY_PB = 268;
+ DID_OK_PB = DID_OK;
+ DID_CANCEL_PB = DID_CANCEL;
+ IDS_FILE_ALL_FILES_SELECTOR = 1000;
+ IDS_FILE_BACK_CUR_PATH = 1001;
+ IDS_FILE_BACK_PREV_PATH = 1002;
+ IDS_FILE_BACK_SLASH = 1003;
+ IDS_FILE_BASE_FILTER = 1004;
+ IDS_FILE_BLANK = 1005;
+ IDS_FILE_COLON = 1006;
+ IDS_FILE_DOT = 1007;
+ IDS_FILE_DRIVE_LETTERS = 1008;
+ IDS_FILE_FWD_CUR_PATH = 1009;
+ IDS_FILE_FWD_PREV_PATH = 1010;
+ IDS_FILE_FORWARD_SLASH = 1011;
+ IDS_FILE_PARENT_DIR = 1012;
+ IDS_FILE_Q_MARK = 1013;
+ IDS_FILE_SPLAT = 1014;
+ IDS_FILE_SPLAT_DOT = 1015;
+ IDS_FILE_SAVEAS_TITLE = 1016;
+ IDS_FILE_SAVEAS_FILTER_TXT = 1017;
+ IDS_FILE_SAVEAS_FILENM_TXT = 1018;
+ IDS_FILE_DUMMY_FILE_NAME = 1019;
+ IDS_FILE_DUMMY_FILE_EXT = 1020;
+ IDS_FILE_DUMMY_DRIVE = 1021;
+ IDS_FILE_DUMMY_ROOT_DIR = 1022;
+ IDS_FILE_PATH_PTR = 1023;
+ IDS_FILE_VOLUME_PREFIX = 1024;
+ IDS_FILE_VOLUME_SUFFIX = 1025;
+ IDS_FILE_PATH_PTR2 = 1026;
+ IDS_FILE_INVALID_CHARS = 1027;
+ IDS_FILE_BAD_DRIVE_NAME = 1100;
+ IDS_FILE_BAD_DRIVE_OR_PATH_NAME = 1101;
+ IDS_FILE_BAD_FILE_NAME = 1102;
+ IDS_FILE_BAD_FQF = 1103;
+ IDS_FILE_BAD_NETWORK_NAME = 1104;
+ IDS_FILE_BAD_SUB_DIR_NAME = 1105;
+ IDS_FILE_DRIVE_NOT_AVAILABLE = 1106;
+ IDS_FILE_FQFNAME_TOO_LONG = 1107;
+ IDS_FILE_OPEN_DIALOG_NOTE = 1108;
+ IDS_FILE_PATH_TOO_LONG = 1109;
+ IDS_FILE_SAVEAS_DIALOG_NOTE = 1110;
+ IDS_FILE_DRIVE_DISK_CHANGE = 1120;
+ IDS_FILE_DRIVE_NOT_READY = 1122;
+ IDS_FILE_DRIVE_LOCKED = 1123;
+ IDS_FILE_DRIVE_NO_SECTOR = 1124;
+ IDS_FILE_DRIVE_SOME_ERROR = 1125;
+ IDS_FILE_DRIVE_INVALID = 1126;
+ IDS_FILE_INSERT_DISK_NOTE = 1127;
+ IDS_FILE_OK_WHEN_READY = 1128;
+
+ type
+ FontDlg = record
+ cbSize : cardinal;
+ hpsScreen : HPS;
+ hpsPrinter : HPS;
+ pszTitle : PChar;
+ pszPreview : PChar;
+ pszPtSizeList : PChar;
+ pfnDlgProc : Pointer;
+ pszFamilyname : PChar;
+ fxPointSize : longint;
+ fl : cardinal;
+ flFlags : cardinal;
+ flType : cardinal;
+ flTypeMask : cardinal;
+ flStyle : cardinal;
+ flStyleMask : cardinal;
+ clrFore : longint;
+ clrBack : longint;
+ ulUser : cardinal;
+ lReturn : longint;
+ lSRC : longint;
+ lEmHeight : longint;
+ lXHeight : longint;
+ lExternalLeading : longint;
+ hMod : cardinal;
+ _fAttrs : FATTRS;
+ sNominalPointSize : integer;
+ usWeight : word;
+ usWidth : word;
+ x : integer;
+ y : integer;
+ usDlgId : word;
+ usFamilyBufLen : word;
+ usReserved : word;
+ end;
+
+ PFontDlg = ^FontDlg;
+
+ const
+ FNTS_CENTER = $00000001;
+ FNTS_CUSTOM = $00000002;
+ FNTS_OWNERDRAWPREVIEW = $00000004;
+ FNTS_HELPBUTTON = $00000008;
+ FNTS_APPLYBUTTON = $00000010;
+ FNTS_RESETBUTTON = $00000020;
+ FNTS_MODELESS = $00000040;
+ FNTS_INITFROMFATTRS = $00000080;
+ FNTS_BITMAPONLY = $00000100;
+ FNTS_VECTORONLY = $00000200;
+ FNTS_FIXEDWIDTHONLY = $00000400;
+ FNTS_PROPORTIONALONLY = $00000800;
+ FNTS_NOSYNTHESIZEDFONTS = $00001000;
+ FNTF_NOVIEWSCREENFONTS = 1;
+ FNTF_NOVIEWPRINTERFONTS = 2;
+ FNTF_SCREENFONTSELECTED = 4;
+ FNTF_PRINTERFONTSELECTED = 8;
+ CLRC_FOREGROUND = 1;
+ CLRC_BACKGROUND = 2;
+ FNTI_BITMAPFONT = $0001;
+ FNTI_VECTORFONT = $0002;
+ FNTI_FIXEDWIDTHFONT = $0004;
+ FNTI_PROPORTIONALFONT = $0008;
+ FNTI_SYNTHESIZED = $0010;
+ FNTI_DEFAULTLIST = $0020;
+ FNTI_FAMILYNAME = $0100;
+ FNTI_STYLENAME = $0200;
+ FNTI_POINTSIZE = $0400;
+ FNTS_SUCCESSFUL = 0;
+ FNTS_ERR_INVALID_DIALOG = 3;
+ FNTS_ERR_ALLOC_SHARED_MEM = 4;
+ FNTS_ERR_INVALID_PARM = 5;
+ FNTS_ERR_OUT_OF_MEMORY = 7;
+ FNTS_ERR_INVALID_VERSION = 10;
+ FNTS_ERR_DIALOG_LOAD_ERROR = 12;
+ FNTM_FACENAMECHANGED = WM_USER+50;
+ FNTM_POINTSIZECHANGED = WM_USER+51;
+ FNTM_STYLECHANGED = WM_USER+52;
+ FNTM_COLORCHANGED = WM_USER+53;
+ FNTM_UPDATEPREVIEW = WM_USER+54;
+ FNTM_FILTERLIST = WM_USER+55;
+
+ type
+ StyleChange = record
+ usWeight : word;
+ usWeightOld : word;
+ usWidth : word;
+ usWidthOld : word;
+ flType : cardinal;
+ flTypeOld : cardinal;
+ flTypeMask : cardinal;
+ flTypeMaskOld : cardinal;
+ flStyle : cardinal;
+ flStyleOld : cardinal;
+ flStyleMask : cardinal;
+ flStyleMaskOld : cardinal;
+ end;
+
+ PStyleChange = ^StyleChange;
+
+
+ function WinFontDlg(hwndP : HWnd;hwndO : HWnd;pfntd : PFontDlg) : HWnd; cdecl;
+
+ function WinDefFontDlgProc(_hwnd : HWnd;msg : cardinal;mp1 : MParam;mp2 : MParam) : MResult; cdecl;
+
+ const
+ DID_FONT_DIALOG = 300;
+ DID_NAME = 301;
+ DID_STYLE = 302;
+ DID_DISPLAY_FILTER = 303;
+ DID_PRINTER_FILTER = 304;
+ DID_SIZE = 305;
+ DID_SAMPLE = 306;
+ DID_OUTLINE = 307;
+ DID_UNDERSCORE = 308;
+ DID_STRIKEOUT = 309;
+ DID_HELP_BUTTON = 310;
+ DID_APPLY_BUTTON = 311;
+ DID_RESET_BUTTON = 312;
+ DID_OK_BUTTON = DID_OK;
+ DID_CANCEL_BUTTON = DID_CANCEL;
+ DID_NAME_PREFIX = 313;
+ DID_STYLE_PREFIX = 314;
+ DID_SIZE_PREFIX = 315;
+ DID_SAMPLE_GROUPBOX = 316;
+ DID_EMPHASIS_GROUPBOX = 317;
+ IDS_FONT_SAMPLE = 350;
+ IDS_FONT_BLANK = 351;
+ IDS_FONT_KEY_0 = 352;
+ IDS_FONT_KEY_9 = 353;
+ IDS_FONT_KEY_SEP = 354;
+ IDS_FONT_DISP_ONLY = 355;
+ IDS_FONT_PRINTER_ONLY = 356;
+ IDS_FONT_COMBINED = 357;
+ IDS_FONT_WEIGHT1 = 358;
+ IDS_FONT_WEIGHT2 = 359;
+ IDS_FONT_WEIGHT3 = 360;
+ IDS_FONT_WEIGHT4 = 361;
+ IDS_FONT_WEIGHT5 = 362;
+ IDS_FONT_WEIGHT6 = 363;
+ IDS_FONT_WEIGHT7 = 364;
+ IDS_FONT_WEIGHT8 = 365;
+ IDS_FONT_WEIGHT9 = 366;
+ IDS_FONT_WIDTH1 = 367;
+ IDS_FONT_WIDTH2 = 368;
+ IDS_FONT_WIDTH3 = 369;
+ IDS_FONT_WIDTH4 = 370;
+ IDS_FONT_WIDTH5 = 371;
+ IDS_FONT_WIDTH6 = 372;
+ IDS_FONT_WIDTH7 = 373;
+ IDS_FONT_WIDTH8 = 374;
+ IDS_FONT_WIDTH9 = 375;
+ IDS_FONT_OPTION0 = 376;
+ IDS_FONT_OPTION1 = 377;
+ IDS_FONT_OPTION2 = 378;
+ IDS_FONT_OPTION3 = 379;
+ IDS_FONT_POINT_SIZE_LIST = 380;
+ SPBS_ALLCHARACTERS = $00000000;
+ SPBS_NUMERICONLY = $00000001;
+ SPBS_READONLY = $00000002;
+ SPBS_MASTER = $00000010;
+ SPBS_SERVANT = $00000000;
+ SPBS_JUSTDEFAULT = $00000000;
+ SPBS_JUSTLEFT = $00000008;
+ SPBS_JUSTRIGHT = $00000004;
+ SPBS_JUSTCENTER = $0000000C;
+ SPBS_NOBORDER = $00000020;
+ SPBS_FASTSPIN = $00000100;
+ SPBS_PADWITHZEROS = $00000080;
+ SPBN_UPARROW = $20A;
+ SPBN_DOWNARROW = $20B;
+ SPBN_ENDSPIN = $20C;
+ SPBN_CHANGE = $20D;
+ SPBN_SETFOCUS = $20E;
+ SPBN_KILLFOCUS = $20F;
+ SPBM_OVERRIDESETLIMITS = $200;
+ SPBM_QUERYLIMITS = $201;
+ SPBM_SETTEXTLIMIT = $202;
+ SPBM_SPINUP = $203;
+ SPBM_SPINDOWN = $204;
+ SPBM_QUERYVALUE = $205;
+ SPBQ_UPDATEIFVALID = 0;
+ SPBQ_ALWAYSUPDATE = 1;
+ SPBQ_DONOTUPDATE = 3;
+ SPBM_SETARRAY = $206;
+ SPBM_SETLIMITS = $207;
+ SPBM_SETCURRENTVALUE = $208;
+ SPBM_SETMASTER = $209;
+ PMERR_NOT_DRAGGING = $1f00;
+ PMERR_ALREADY_DRAGGING = $1f01;
+ MSGF_DRAG = $0010;
+ WM_DRAGFIRST = $0310;
+ WM_DRAGLAST = $032f;
+ DM_DROP = $032f;
+ DM_DRAGOVER = $032e;
+ DM_DRAGLEAVE = $032d;
+ DM_DROPHELP = $032c;
+ DM_ENDCONVERSATION = $032b;
+ DM_PRINT = $032a;
+ DM_RENDER = $0329;
+ DM_RENDERCOMPLETE = $0328;
+ DM_RENDERPREPARE = $0327;
+ DM_DRAGFILECOMPLETE = $0326;
+ DM_EMPHASIZETARGET = $0325;
+ DM_DRAGERROR = $0324;
+ DM_FILERENDERED = $0323;
+ DM_RENDERFILE = $0322;
+ DM_DRAGOVERNOTIFY = $0321;
+ DM_PRINTOBJECT = $0320;
+ DM_DISCARDOBJECT = $031f;
+ DRT_ASM = 'Assembler Code';
+ DRT_BASIC = 'BASIC Code';
+ DRT_BINDATA = 'Binary Data';
+ DRT_BITMAP = 'Bitmap';
+ DRT_C = 'C Code';
+ DRT_COBOL = 'COBOL Code';
+ DRT_DLL = 'Dynamic Link Library';
+ DRT_DOSCMD = 'DOS Command File';
+ DRT_EXE = 'Executable';
+ DRT_FORTRAN = 'FORTRAN Code';
+ DRT_ICON = 'Icon';
+ DRT_LIB = 'Library';
+ DRT_METAFILE = 'Metafile';
+ DRT_OS2CMD = 'OS/2 Command File';
+ DRT_PASCAL = 'Pascal Code';
+ DRT_RESOURCE = 'Resource File';
+ DRT_TEXT = 'Plain Text';
+ DRT_UNKNOWN = 'Unknown';
+ DOR_NODROP = $0000;
+ DOR_DROP = $0001;
+ DOR_NODROPOP = $0002;
+ DOR_NEVERDROP = $0003;
+ DO_COPYABLE = $0001;
+ DO_MOVEABLE = $0002;
+ DO_LINKABLE = $0004;
+ DC_OPEN = $0001;
+ DC_REF = $0002;
+ DC_GROUP = $0004;
+ DC_CONTAINER = $0008;
+ DC_PREPARE = $0010;
+ DC_REMOVEABLEMEDIA = $0020;
+ DO_DEFAULT = $BFFE;
+ DO_UNKNOWN = $BFFF;
+ DO_COPY = $0010;
+ DO_MOVE = $0020;
+ DO_LINK = $0018;
+ DO_CREATE = $0040;
+ DMFL_TARGETSUCCESSFUL = $0001;
+ DMFL_TARGETFAIL = $0002;
+ DMFL_NATIVERENDER = $0004;
+ DMFL_RENDERRETRY = $0008;
+ DMFL_RENDEROK = $0010;
+ DMFL_RENDERFAIL = $0020;
+ DRG_ICON = $00000001;
+ DRG_BITMAP = $00000002;
+ DRG_POLYGON = $00000004;
+ DRG_STRETCH = $00000008;
+ DRG_TRANSPARENT = $00000010;
+ DRG_CLOSED = $00000020;
+ DME_IGNOREABORT = 1;
+ DME_IGNORECONTINUE = 2;
+ DME_REPLACE = 3;
+ DME_RETRY = 4;
+ DF_MOVE = $0001;
+ DF_SOURCE = $0002;
+ DF_SUCCESSFUL = $0004;
+ DRR_SOURCE = 1;
+ DRR_TARGET = 2;
+ DRR_ABORT = 3;
+ DFF_MOVE = 1;
+ DFF_COPY = 2;
+ DFF_DELETE = 3;
+
+ type
+ HStr = cardinal;
+
+ DragItem = record
+ hwndItem : HWnd;
+ ulItemID : cardinal;
+ hstrType : HStr;
+ hstrRMF : HStr;
+ hstrContainerName : HStr;
+ hstrSourceName : HStr;
+ hstrTargetName : HStr;
+ cxOffset : integer;
+ cyOffset : integer;
+ fsControl : word;
+ fsSupportedOps : word;
+ end;
+
+ PDragItem = ^DragItem;
+
+ DragInfo = record
+ cbDraginfo : cardinal;
+ cbDragitem : word;
+ usOperation : word;
+ hwndSource : HWnd;
+ xDrop : integer;
+ yDrop : integer;
+ cditem : word;
+ usReserved : word;
+ end;
+
+ PDragInfo = ^DragInfo;
+
+ DragImage = record
+ cb : word;
+ cptl : word;
+ hImage : cardinal;
+ sizlStretch : SizeL;
+ fl : cardinal;
+ cxOffset : integer;
+ cyOffset : integer;
+ end;
+
+ PDragImage = ^DragImage;
+
+ DragTransfer = record
+ cb : cardinal;
+ hwndClient : HWnd;
+ pditem : PDragItem;
+ hstrSelectedRMF : HStr;
+ hstrRenderToName : HStr;
+ ulTargetInfo : cardinal;
+ usOperation : word;
+ fsReply : word;
+ end;
+
+ PDragTransfer = ^DragTransfer;
+
+ RenderFile = record
+ hwndDragFiles : HWnd;
+ hstrSource : HStr;
+ hstrTarget : HStr;
+ fMove : word;
+ usRsvd : word;
+ end;
+
+ PRenderFile = ^RenderFile;
+
+
+ function DrgAcceptDroppedFiles(hwnd : HWnd;pszPath : PChar;pszTypes : PChar;ulDefaultOp : cardinal;ulRsvd : cardinal) : Longbool; cdecl;
+
+ function DrgAllocDraginfo(cditem : cardinal) : PDragInfo; cdecl;
+
+ function DrgAllocDragtransfer(cdxfer : cardinal) : PDragTransfer; cdecl;
+
+ function DrgDrag(hwndSource : HWnd;pdinfo : PDragInfo;pdimg : PDragImage;cdimg : cardinal;vkTerminate : longint; var pRsvd) : HWnd; cdecl;
+
+ type
+ PPSZ = ^PChar;
+
+
+ function DrgDragFiles(hwnd : HWnd;apszFiles : PPSZ;apszTypes : PPSZ;apszTargets : PPSZ;cFiles : cardinal;hptrDrag : cardinal;vkTerm : cardinal;fSourceRender : Longbool;ulRsvd : cardinal) : Longbool; cdecl;
+
+ function DrgPostTransferMsg(hwnd : HWnd;msg : cardinal;pdxfer : PDragTransfer;fl : cardinal;ulRsvd : cardinal;fRetry : Longbool) : Longbool; cdecl;
+
+ function DrgQueryDragitem(pdinfo : PDragInfo;cbBuffer : cardinal;pditem : PDragItem;iItem : cardinal) : Longbool; cdecl;
+
+ function DrgQueryDragitemCount(pdinfo : PDragInfo) : cardinal; cdecl;
+
+ function DrgQueryDragitemPtr(pdinfo : PDragInfo;i : cardinal) : PDragItem; cdecl;
+
+ function DrgQueryNativeRMF(pditem : PDragItem;cbBuffer : cardinal;pBuffer : PChar) : Longbool; cdecl;
+
+ function DrgQueryNativeRMFLen(pditem : PDragItem) : cardinal; cdecl;
+
+ function DrgQueryStrName(hstr : HStr;cbBuffer : cardinal;pBuffer : PChar) : cardinal; cdecl;
+
+ function DrgQueryStrNameLen(hstr : HStr) : cardinal; cdecl;
+
+ function DrgQueryTrueType(pditem : PDragItem;cbBuffer : cardinal;pBuffer : PChar) : Longbool; cdecl;
+
+ function DrgQueryTrueTypeLen(pditem : PDragItem) : cardinal; cdecl;
+
+ function DrgSendTransferMsg(hwnd : HWnd;msg : cardinal;mp1 : MParam;mp2 : MParam) : MResult; cdecl;
+
+ function DrgSetDragitem(pdinfo : PDragInfo;pditem : PDragItem;cbBuffer : cardinal;iItem : cardinal) : Longbool; cdecl;
+
+ function DrgSetDragImage(pdinfo : PDragInfo;pdimg : PDragImage;cdimg : cardinal; var pRsvd) : Longbool; cdecl;
+
+ function DrgVerifyTypeSet(pditem : PDragItem;pszType : PChar;cbMatch : cardinal;pszMatch : PChar) : Longbool; cdecl;
+
+ function DrgAccessDraginfo(pdinfo : PDragInfo) : Longbool; cdecl;
+
+ function DrgAddStrHandle(psz : PChar) : HStr; cdecl;
+
+ function DrgDeleteDraginfoStrHandles(pdinfo : PDragInfo) : Longbool; cdecl;
+
+ function DrgDeleteStrHandle(hstr : HStr) : Longbool; cdecl;
+
+ function DrgFreeDraginfo(pdinfo : PDragInfo) : Longbool; cdecl;
+
+ function DrgFreeDragtransfer(pdxfer : PDragTransfer) : Longbool; cdecl;
+
+ function DrgGetPS(hwnd : HWnd) : HPS; cdecl;
+
+ function DrgPushDraginfo(pdinfo : PDragInfo;hwndDest : HWnd) : Longbool; cdecl;
+
+ function DrgReleasePS(hps : HPS) : Longbool; cdecl;
+
+ function DrgSetDragPointer(pdinfo : PDragInfo;hptr : cardinal) : Longbool; cdecl;
+
+ function DrgVerifyNativeRMF(pditem : PDragItem;pszRMF : PChar) : Longbool; cdecl;
+
+ function DrgVerifyRMF(pditem : PDragItem;pszMech : PChar;pszFmt : PChar) : Longbool; cdecl;
+
+ function DrgVerifyTrueType(pditem : PDragItem;pszType : PChar) : Longbool; cdecl;
+
+ function DrgVerifyType(pditem : PDragItem;pszType : PChar) : Longbool; cdecl;
+
+ const
+ PMERR_NOFILTERED_ITEMS = $1f02;
+ PMERR_COMPARISON_FAILED = $1f03;
+ PMERR_RECORD_CURRENTLY_INSERTED = $1f04;
+ PMERR_FI_CURRENTLY_INSERTED = $1f05;
+ CCS_EXTENDSEL = $00000001;
+ CCS_MULTIPLESEL = $00000002;
+ CCS_SINGLESEL = $00000004;
+ CCS_AUTOPOSITION = $00000008;
+ CCS_VERIFYPOINTERS = $00000010;
+ CCS_READONLY = $00000020;
+ CCS_MINIRECORDCORE = $00000040;
+ CV_TEXT = $00000001;
+ CV_NAME = $00000002;
+ CV_ICON = $00000004;
+ CV_DETAIL = $00000008;
+ CV_FLOW = $00000010;
+ CV_MINI = $00000020;
+ CV_TREE = $00000040;
+ CA_CONTAINERTITLE = $00000200;
+ CA_TITLESEPARATOR = $00000400;
+ CA_TITLELEFT = $00000800;
+ CA_TITLERIGHT = $00001000;
+ CA_TITLECENTER = $00002000;
+ CA_OWNERDRAW = $00004000;
+ CA_DETAILSVIEWTITLES = $00008000;
+ CA_ORDEREDTARGETEMPH = $00010000;
+ CA_DRAWBITMAP = $00020000;
+ CA_DRAWICON = $00040000;
+ CA_TITLEREADONLY = $00080000;
+ CA_OWNERPAINTBACKGROUND = $00100000;
+ CA_MIXEDTARGETEMPH = $00200000;
+ CA_TREELINE = $00400000;
+ CID_LEFTCOLTITLEWND = $7FF0;
+ CID_RIGHTCOLTITLEWND = $7FF1;
+ CID_BLANKBOX = $7FF2;
+ CID_HSCROLL = $7FF3;
+ CID_RIGHTHSCROLL = $7FF4;
+ CID_CNRTITLEWND = $7FF5;
+ CID_LEFTDVWND = $7FF7;
+ CID_RIGHTDVWND = $7FF8;
+ CID_VSCROLL = $7FF9;
+ CID_MLE = $7FFA;
+
+ type
+ TreeItemDesc = record
+ hbmExpanded : HBitmap;
+ hbmCollapsed : HBitmap;
+ hptrExpanded : cardinal;
+ hptrCollapsed : cardinal;
+ end;
+
+ PTreeItemDesc = ^TreeItemDesc;
+
+ PFieldInfo = ^FieldInfo;
+
+ FieldInfo = record
+ cb : cardinal;
+ flData : cardinal;
+ flTitle : cardinal;
+ pTitleData : Pointer;
+ offStruct : cardinal;
+ pUserData : Pointer;
+ pNextFieldInfo : PFieldInfo;
+ cxWidth : cardinal;
+ end;
+
+ PRecordCore = ^RecordCore;
+
+ RecordCore = record
+ cb : cardinal;
+ flRecordAttr : cardinal;
+ ptlIcon : PointL;
+ preccNextRecord : PRecordCore;
+ pszIcon : PChar;
+ hptrIcon : cardinal;
+ hptrMiniIcon : cardinal;
+ hbmBitmap : HBitmap;
+ hbmMiniBitmap : HBitmap;
+ pTreeItemDesc : PTreeItemDesc;
+ pszText : PChar;
+ pszName : PChar;
+ pszTree : PChar;
+ end;
+
+ PMiniRecordCore = ^MiniRecordCore;
+
+ MINIRECORDCORE = record
+ cb : cardinal;
+ flRecordAttr : cardinal;
+ ptlIcon : PointL;
+ preccNextRecord : PMiniRecordCore;
+ pszIcon : PChar;
+ hptrIcon : cardinal;
+ end;
+
+ CNRInfo = record
+ cb : cardinal;
+ pSortRecord : Pointer;
+ pFieldInfoLast : PFieldInfo;
+ pFieldInfoObject : PFieldInfo;
+ pszCnrTitle : PChar;
+ flWindowAttr : cardinal;
+ ptlOrigin : PointL;
+ cDelta : cardinal;
+ cRecords : cardinal;
+ slBitmapOrIcon : SizeL;
+ slTreeBitmapOrIcon : SizeL;
+ hbmExpanded : HBitmap;
+ hbmCollapsed : HBitmap;
+ hptrExpanded : cardinal;
+ hptrCollapsed : cardinal;
+ cyLineSpacing : longint;
+ cxTreeIndent : longint;
+ cxTreeLine : longint;
+ cFields : cardinal;
+ xVertSplitbar : longint;
+ end;
+
+ PCNRInfo = ^CNRInfo;
+
+ CDate = record
+ day : Byte;
+ month : Byte;
+ year : word;
+ end;
+
+ PCDate = ^CDate;
+
+ CTime = record
+ hours : Byte;
+ minutes : Byte;
+ seconds : Byte;
+ ucReserved : Byte;
+ end;
+
+ PCTime = ^CTime;
+
+ const
+ CFA_LEFT = $00000001;
+ CFA_RIGHT = $00000002;
+ CFA_CENTER = $00000004;
+ CFA_TOP = $00000008;
+ CFA_VCENTER = $00000010;
+ CFA_BOTTOM = $00000020;
+ CFA_INVISIBLE = $00000040;
+ CFA_BITMAPORICON = $00000100;
+ CFA_SEPARATOR = $00000200;
+ CFA_HORZSEPARATOR = $00000400;
+ CFA_STRING = $00000800;
+ CFA_OWNER = $00001000;
+ CFA_DATE = $00002000;
+ CFA_TIME = $00004000;
+ CFA_FIREADONLY = $00008000;
+ CFA_FITITLEREADONLY = $00010000;
+ CFA_ULONG = $00020000;
+ CRA_SELECTED = $00000001;
+ CRA_TARGET = $00000002;
+ CRA_CURSORED = $00000004;
+ CRA_INUSE = $00000008;
+ CRA_FILTERED = $00000010;
+ CRA_DROPONABLE = $00000020;
+ CRA_RECORDREADONLY = $00000040;
+ CRA_EXPANDED = $00000080;
+ CRA_COLLAPSED = $00000100;
+ CM_ALLOCDETAILFIELDINFO = $0330;
+ CM_ALLOCRECORD = $0331;
+ CM_ARRANGE = $0332;
+ CM_ERASERECORD = $0333;
+ CM_FILTER = $0334;
+ CM_FREEDETAILFIELDINFO = $0335;
+ CM_FREERECORD = $0336;
+ CM_HORZSCROLLSPLITWINDOW = $0337;
+ CM_INSERTDETAILFIELDINFO = $0338;
+ CM_INSERTRECORD = $0339;
+ CM_INVALIDATEDETAILFIELDINFO = $033a;
+ CM_INVALIDATERECORD = $033b;
+ CM_PAINTBACKGROUND = $033c;
+ CM_QUERYCNRINFO = $033d;
+ CM_QUERYDETAILFIELDINFO = $033e;
+ CM_QUERYDRAGIMAGE = $033f;
+ CM_QUERYRECORD = $0340;
+ CM_QUERYRECORDEMPHASIS = $0341;
+ CM_QUERYRECORDFROMRECT = $0342;
+ CM_QUERYRECORDRECT = $0343;
+ CM_QUERYVIEWPORTRECT = $0344;
+ CM_REMOVEDETAILFIELDINFO = $0345;
+ CM_REMOVERECORD = $0346;
+ CM_SCROLLWINDOW = $0347;
+ CM_SEARCHSTRING = $0348;
+ CM_SETCNRINFO = $0349;
+ CM_SETRECORDEMPHASIS = $034a;
+ CM_SORTRECORD = $034b;
+ CM_OPENEDIT = $034c;
+ CM_CLOSEEDIT = $034d;
+ CM_COLLAPSETREE = $034e;
+ CM_EXPANDTREE = $034f;
+ CM_QUERYRECORDINFO = $0350;
+ CN_DRAGAFTER = 101;
+ CN_DRAGLEAVE = 102;
+ CN_DRAGOVER = 103;
+ CN_DROP = 104;
+ CN_DROPHELP = 105;
+ CN_ENTER = 106;
+ CN_INITDRAG = 107;
+ CN_EMPHASIS = 108;
+ CN_KILLFOCUS = 109;
+ CN_SCROLL = 110;
+ CN_QUERYDELTA = 111;
+ CN_SETFOCUS = 112;
+ CN_REALLOCPSZ = 113;
+ CN_BEGINEDIT = 114;
+ CN_ENDEDIT = 115;
+ CN_COLLAPSETREE = 116;
+ CN_EXPANDTREE = 117;
+ CN_HELP = 118;
+ CN_CONTEXTMENU = 119;
+
+ type
+ CNRDragInit = record
+ hwndCnr : HWnd;
+ pRecord : PRecordCore;
+ x : longint;
+ y : longint;
+ cx : longint;
+ cy : longint;
+ end;
+
+ PCNRDragInit = ^CNRDragInit;
+
+ FieldInfoInsert = record
+ cb : cardinal;
+ pFieldInfoOrder : PFieldInfo;
+ fInvalidateFieldInfo : cardinal;
+ cFieldInfoInsert : cardinal;
+ end;
+
+ PFieldInfoInsert = ^FieldInfoInsert;
+
+ RecordInsert = record
+ cb : cardinal;
+ pRecordOrder : PRecordCore;
+ pRecordParent : PRecordCore;
+ fInvalidateRecord : cardinal;
+ zOrder : cardinal;
+ cRecordsInsert : cardinal;
+ end;
+
+ PRecordInsert = ^RecordInsert;
+
+ QueryRecFromRect = record
+ cb : cardinal;
+ rect : RectL;
+ fsSearch : cardinal;
+ end;
+
+ PQueryRecFromRect = ^QueryRecFromRect;
+
+ QueryRecordRect = record
+ cb : cardinal;
+ pRecord : PRecordCore;
+ fRightSplitWindow : cardinal;
+ fsExtent : cardinal;
+ end;
+
+ PQueryRecordRect = ^QueryRecordRect;
+
+ SearchString = record
+ cb : cardinal;
+ pszSearch : PChar;
+ fsPrefix : cardinal;
+ fsCaseSensitive : cardinal;
+ usView : cardinal;
+ end;
+
+ PSearchString = ^SearchString;
+
+ CNRDragInfo = record
+ pDragInfo : PDragInfo;
+ pRecord : PRecordCore;
+ end;
+
+ PCNRDragInfo = ^CNRDragInfo;
+
+ NotifyRecordEmphasis = record
+ hwndCnr : HWnd;
+ pRecord : PRecordCore;
+ fEmphasisMask : cardinal;
+ end;
+
+ PNotifyRecordEmphasis = ^NotifyRecordEmphasis;
+
+ NotifyRecordEnter = record
+ hwndCnr : HWnd;
+ fKey : cardinal;
+ pRecord : PRecordCore;
+ end;
+
+ PNotifyRecordEnter = ^NotifyRecordEnter;
+
+ NotifyDelta = record
+ hwndCnr : HWnd;
+ fDelta : cardinal;
+ end;
+
+ PNotifyDelta = ^NotifyDelta;
+
+ NotifyScroll = record
+ hwndCnr : HWnd;
+ lScrollInc : longint;
+ fScroll : cardinal;
+ end;
+
+ PNotifyScroll = ^NotifyScroll;
+
+ CNREditData = record
+ cb : cardinal;
+ hwndCnr : HWnd;
+ pRecord : PRecordCore;
+ pFieldInfo : PFieldInfo;
+ ppszText : PPSZ;
+ cbText : cardinal;
+ id : cardinal;
+ end;
+
+ PCNREditData = ^CNREditData;
+
+ OwnerBackground = record
+ hwnd : HWnd;
+ hps : HPS;
+ rclBackground : RectL;
+ idWindow : longint;
+ end;
+
+ POwnerBackground = ^OwnerBackground;
+
+ CNRDrawItemInfo = record
+ pRecord : PRecordCore;
+ pFieldInfo : PFieldInfo;
+ end;
+
+ PCNRDrawItemInfo = ^CNRDrawItemInfo;
+
+ const
+ CMA_TOP = $0001;
+ CMA_BOTTOM = $0002;
+ CMA_LEFT = $0004;
+ CMA_RIGHT = $0008;
+ CMA_FIRST = $0010;
+ CMA_LAST = $0020;
+ CMA_END = $0040;
+ CMA_PREV = $0080;
+ CMA_NEXT = $0100;
+ CMA_HORIZONTAL = $0200;
+ CMA_VERTICAL = $0400;
+ CMA_ICON = $0800;
+ CMA_TEXT = $1000;
+ CMA_PARTIAL = $2000;
+ CMA_COMPLETE = $4000;
+ CMA_PARENT = $0001;
+ CMA_FIRSTCHILD = $0002;
+ CMA_LASTCHILD = $0004;
+ CMA_CNRTITLE = $0001;
+ CMA_DELTA = $0002;
+ CMA_FLWINDOWATTR = $0004;
+ CMA_LINESPACING = $0008;
+ CMA_PFIELDINFOLAST = $0010;
+ CMA_PSORTRECORD = $0020;
+ CMA_PTLORIGIN = $0040;
+ CMA_SLBITMAPORICON = $0080;
+ CMA_XVERTSPLITBAR = $0100;
+ CMA_PFIELDINFOOBJECT = $0200;
+ CMA_TREEICON = $0400;
+ CMA_TREEBITMAP = $0800;
+ CMA_CXTREEINDENT = $1000;
+ CMA_CXTREELINE = $2000;
+ CMA_SLTREEBITMAPORICON = $4000;
+ CMA_ITEMORDER = $0001;
+ CMA_WINDOW = $0002;
+ CMA_WORKSPACE = $0004;
+ CMA_ZORDER = $0008;
+ CMA_DELTATOP = $0001;
+ CMA_DELTABOT = $0002;
+ CMA_DELTAHOME = $0004;
+ CMA_DELTAEND = $0008;
+ CMA_NOREPOSITION = $0001;
+ CMA_REPOSITION = $0002;
+ CMA_TEXTCHANGED = $0004;
+ CMA_ERASE = $0008;
+ CMA_FREE = $0001;
+ CMA_INVALIDATE = $0002;
+ SLM_ADDDETENT = $0369;
+ SLM_QUERYDETENTPOS = $036a;
+ SLM_QUERYSCALETEXT = $036b;
+ SLM_QUERYSLIDERINFO = $036c;
+ SLM_QUERYTICKPOS = $036d;
+ SLM_QUERYTICKSIZE = $036e;
+ SLM_REMOVEDETENT = $036f;
+ SLM_SETSCALETEXT = $0370;
+ SLM_SETSLIDERINFO = $0371;
+ SLM_SETTICKSIZE = $0372;
+ SLN_CHANGE = 1;
+ SLN_SLIDERTRACK = 2;
+ SLN_SETFOCUS = 3;
+ SLN_KILLFOCUS = 4;
+
+ type
+ SLDCData = record
+ cbSize : cardinal;
+ usScale1Increments : word;
+ usScale1Spacing : word;
+ usScale2Increments : word;
+ usScale2Spacing : word;
+ end;
+
+ PSLDCData = ^SLDCData;
+
+ const
+ SLS_HORIZONTAL = $00000000;
+ SLS_VERTICAL = $00000001;
+ SLS_CENTER = $00000000;
+ SLS_BOTTOM = $00000002;
+ SLS_TOP = $00000004;
+ SLS_LEFT = $00000002;
+ SLS_RIGHT = $00000004;
+ SLS_SNAPTOINCREMENT = $00000008;
+ SLS_BUTTONSBOTTOM = $00000010;
+ SLS_BUTTONSTOP = $00000020;
+ SLS_BUTTONSLEFT = $00000010;
+ SLS_BUTTONSRIGHT = $00000020;
+ SLS_OWNERDRAW = $00000040;
+ SLS_READONLY = $00000080;
+ SLS_RIBBONSTRIP = $00000100;
+ SLS_HOMEBOTTOM = $00000000;
+ SLS_HOMETOP = $00000200;
+ SLS_HOMELEFT = $00000000;
+ SLS_HOMERIGHT = $00000200;
+ SLS_PRIMARYSCALE1 = $00000000;
+ SLS_PRIMARYSCALE2 = $00000400;
+ SMA_SCALE1 = $0001;
+ SMA_SCALE2 = $0002;
+ SMA_SHAFTDIMENSIONS = $0000;
+ SMA_SHAFTPOSITION = $0001;
+ SMA_SLIDERARMDIMENSIONS = $0002;
+ SMA_SLIDERARMPOSITION = $0003;
+ SMA_RANGEVALUE = $0000;
+ SMA_INCREMENTVALUE = $0001;
+ SMA_SETALLTICKS = $FFFF;
+ SDA_RIBBONSTRIP = $0001;
+ SDA_SLIDERSHAFT = $0002;
+ SDA_BACKGROUND = $0003;
+ SDA_SLIDERARM = $0004;
+ PMERR_UPDATE_IN_PROGRESS = $1f06;
+ SLDERR_INVALID_PARAMETERS = -1;
+ VM_QUERYITEM = $0375;
+ VM_QUERYITEMATTR = $0376;
+ VM_QUERYMETRICS = $0377;
+ VM_QUERYSELECTEDITEM = $0378;
+ VM_SELECTITEM = $0379;
+ VM_SETITEM = $037a;
+ VM_SETITEMATTR = $037b;
+ VM_SETMETRICS = $037c;
+ VN_SELECT = 120;
+ VN_ENTER = 121;
+ VN_DRAGLEAVE = 122;
+ VN_DRAGOVER = 123;
+ VN_DROP = 124;
+ VN_DROPHELP = 125;
+ VN_INITDRAG = 126;
+ VN_SETFOCUS = 127;
+ VN_KILLFOCUS = 128;
+ VN_HELP = 129;
+
+ type
+ VSCData = record
+ cbSize : cardinal;
+ usRowCount : word;
+ usColumnCount : word;
+ end;
+
+ PVSCData = ^VSCData;
+
+ VSDragInit = record
+ hwnd : HWnd;
+ x : longint;
+ y : longint;
+ cx : longint;
+ cy : longint;
+ usRow : word;
+ usColumn : word;
+ end;
+
+ PVSDragInit = ^VSDragInit;
+
+ VSDragInfo = record
+ pDragInfo : PDragInfo;
+ usRow : word;
+ usColumn : word;
+ end;
+
+ PVSDragInfo = ^VSDragInfo;
+
+ VSText = record
+ pszItemText : PChar;
+ ulBufLen : cardinal;
+ end;
+
+ PVSText = ^VSText;
+
+ const
+ VS_BITMAP = $0001;
+ VS_ICON = $0002;
+ VS_TEXT = $0004;
+ VS_RGB = $0008;
+ VS_COLORINDEX = $0010;
+ VS_BORDER = $0020;
+ VS_ITEMBORDER = $0040;
+ VS_SCALEBITMAPS = $0080;
+ VS_RIGHTTOLEFT = $0100;
+ VS_OWNERDRAW = $0200;
+ VIA_BITMAP = $0001;
+ VIA_ICON = $0002;
+ VIA_TEXT = $0004;
+ VIA_RGB = $0008;
+ VIA_COLORINDEX = $0010;
+ VIA_OWNERDRAW = $0020;
+ VIA_DISABLED = $0040;
+ VIA_DRAGGABLE = $0080;
+ VIA_DROPONABLE = $0100;
+ VMA_ITEMSIZE = $0001;
+ VMA_ITEMSPACING = $0002;
+ VDA_ITEM = $0001;
+ VDA_ITEMBACKGROUND = $0002;
+ VDA_SURROUNDING = $0003;
+ VDA_BACKGROUND = $0004;
+ VSERR_INVALID_PARAMETERS = -1;
+ BKM_CALCPAGERECT = $0353;
+ BKM_DELETEPAGE = $0354;
+ BKM_INSERTPAGE = $0355;
+ BKM_INVALIDATETABS = $0356;
+ BKM_TURNTOPAGE = $0357;
+ BKM_QUERYPAGECOUNT = $0358;
+ BKM_QUERYPAGEID = $0359;
+ BKM_QUERYPAGEDATA = $035a;
+ BKM_QUERYPAGEWINDOWHWND = $035b;
+ BKM_QUERYTABBITMAP = $035c;
+ BKM_QUERYTABTEXT = $035d;
+ BKM_SETDIMENSIONS = $035e;
+ BKM_SETPAGEDATA = $035f;
+ BKM_SETPAGEWINDOWHWND = $0360;
+ BKM_SETSTATUSLINETEXT = $0361;
+ BKM_SETTABBITMAP = $0362;
+ BKM_SETTABTEXT = $0363;
+ BKM_SETNOTEBOOKCOLORS = $0364;
+ BKM_QUERYPAGESTYLE = $0365;
+ BKM_QUERYSTATUSLINETEXT = $0366;
+ BKN_PAGESELECTED = 130;
+ BKN_NEWPAGESIZE = 131;
+ BKN_HELP = 132;
+ BKN_PAGEDELETED = 133;
+ BKA_ALL = $0001;
+ BKA_SINGLE = $0002;
+ BKA_TAB = $0004;
+ BKA_LAST = $0002;
+ BKA_FIRST = $0004;
+ BKA_NEXT = $0008;
+ BKA_PREV = $0010;
+ BKA_TOP = $0020;
+ BKA_MAJORTAB = $0001;
+ BKA_MINORTAB = $0002;
+ BKA_PAGEBUTTON = $0100;
+ BKA_STATUSTEXTON = $0001;
+ BKA_MAJOR = $0040;
+ BKA_MINOR = $0080;
+ BKA_AUTOPAGESIZE = $0100;
+ BKA_END = $0200;
+ BKA_TEXT = $0400;
+ BKA_BITMAP = $0800;
+ BKS_BACKPAGESBR = $00000001;
+ BKS_BACKPAGESBL = $00000002;
+ BKS_BACKPAGESTR = $00000004;
+ BKS_BACKPAGESTL = $00000008;
+ BKS_MAJORTABRIGHT = $00000010;
+ BKS_MAJORTABLEFT = $00000020;
+ BKS_MAJORTABTOP = $00000040;
+ BKS_MAJORTABBOTTOM = $00000080;
+ BKS_SQUARETABS = $00000000;
+ BKS_ROUNDEDTABS = $00000100;
+ BKS_POLYGONTABS = $00000200;
+ BKS_SOLIDBIND = $00000000;
+ BKS_SPIRALBIND = $00000400;
+ BKS_STATUSTEXTLEFT = $00000000;
+ BKS_STATUSTEXTRIGHT = $00001000;
+ BKS_STATUSTEXTCENTER = $00002000;
+ BKS_TABTEXTLEFT = $00000000;
+ BKS_TABTEXTRIGHT = $00004000;
+ BKS_TABTEXTCENTER = $00008000;
+ BKA_BACKGROUNDPAGECOLORINDEX = $0001;
+ BKA_BACKGROUNDPAGECOLOR = $0002;
+ BKA_BACKGROUNDMAJORCOLORINDEX = $0003;
+ BKA_BACKGROUNDMAJORCOLOR = $0004;
+ BKA_BACKGROUNDMINORCOLORINDEX = $0005;
+ BKA_BACKGROUNDMINORCOLOR = $0006;
+ BKA_FOREGROUNDMAJORCOLORINDEX = $0007;
+ BKA_FOREGROUNDMAJORCOLOR = $0008;
+ BKA_FOREGROUNDMINORCOLORINDEX = $0009;
+ BKA_FOREGROUNDMINORCOLOR = $000A;
+ BOOKERR_INVALID_PARAMETERS = -1;
+
+ type
+ BookText = record
+ pString : PChar;
+ textLen : cardinal;
+ end;
+
+ PBookText = ^BookText;
+
+ DeleteNotify = record
+ hwndBook : HWnd;
+ hwndPage : HWnd;
+ ulAppPageData : cardinal;
+ hbmTab : HBitmap;
+ end;
+
+ PDeleteNotify = ^DeleteNotify;
+
+ PageSelectNotify = record
+ hwndBook : HWnd;
+ ulPageIdCur : cardinal;
+ ulPageIdNew : cardinal;
+ end;
+
+ PPageSelectNotify = ^PageSelectNotify;
+
+ implementation
+
+ function WinFileDlg(hwndP : HWnd;hwndO : HWnd;pfild : PFileDlg) : HWnd; cdecl;
+ external 'PMCTLS' index 4;
+ function WinDefFileDlgProc(hwnd : HWnd;msg : cardinal;mp1 : MParam;mp2 : MParam) : MResult; cdecl;
+ external 'PMCTLS' index 5;
+ function WinFreeFileDlgList(papszFQFilename : PAPSZ) : Longbool; cdecl;
+ external 'PMCTLS' index 6;
+ function WinFontDlg(hwndP : HWnd;hwndO : HWnd;pfntd : PFontDlg) : HWnd; cdecl;
+ external 'PMCTLS' index 2;
+ function WinDefFontDlgProc(_hwnd : HWnd;msg : cardinal;mp1 : MParam;mp2 : MParam) : MResult; cdecl;
+ external 'PMCTLS' index 3;
+ function DrgAcceptDroppedFiles(hwnd : HWnd;pszPath : PChar;pszTypes : PChar;ulDefaultOp : cardinal;ulRsvd : cardinal) : Longbool; cdecl;
+ external 'PMDRAG' index 66;
+ function DrgAllocDraginfo(cditem : cardinal) : PDragInfo; cdecl;
+ external 'PMDRAG' index 34;
+ function DrgAllocDragtransfer(cdxfer : cardinal) : PDragTransfer; cdecl;
+ external 'PMDRAG' index 35;
+ function DrgDrag(hwndSource : HWnd;pdinfo : PDragInfo;pdimg : PDragImage;cdimg : cardinal;vkTerminate : longint; var pRsvd) : HWnd; cdecl;
+ external 'PMDRAG' index 38;
+ function DrgDragFiles(hwnd : HWnd;apszFiles : PPSZ;apszTypes : PPSZ;apszTargets : PPSZ;cFiles : cardinal;hptrDrag : cardinal;vkTerm : cardinal;fSourceRender : Longbool;ulRsvd : cardinal) : Longbool; cdecl;
+ external 'PMDRAG' index 65;
+ function DrgPostTransferMsg(hwnd : HWnd;msg : cardinal;pdxfer : PDragTransfer;fl : cardinal;ulRsvd : cardinal;fRetry : Longbool) : Longbool; cdecl;
+ external 'PMDRAG' index 42;
+ function DrgQueryDragitem(pdinfo : PDragInfo;cbBuffer : cardinal;pditem : PDragItem;iItem : cardinal) : Longbool; cdecl;
+ external 'PMDRAG' index 44;
+ function DrgQueryDragitemCount(pdinfo : PDragInfo) : cardinal; cdecl;
+ external 'PMDRAG' index 45;
+ function DrgQueryDragitemPtr(pdinfo : PDragInfo;i : cardinal) : PDragItem; cdecl;
+ external 'PMDRAG' index 46;
+ function DrgQueryNativeRMF(pditem : PDragItem;cbBuffer : cardinal;pBuffer : PCHAR) : Longbool; cdecl;
+ external 'PMDRAG' index 47;
+ function DrgQueryNativeRMFLen(pditem : PDragItem) : cardinal; cdecl;
+ external 'PMDRAG' index 48;
+ function DrgQueryStrName(hstr : HStr;cbBuffer : cardinal;pBuffer : PChar) : cardinal; cdecl;
+ external 'PMDRAG' index 49;
+ function DrgQueryStrNameLen(hstr : HStr) : cardinal; cdecl;
+ external 'PMDRAG' index 50;
+ function DrgQueryTrueType(pditem : PDragItem;cbBuffer : cardinal;pBuffer : PChar) : Longbool; cdecl;
+ external 'PMDRAG' index 51;
+ function DrgQueryTrueTypeLen(pditem : PDragItem) : cardinal; cdecl;
+ external 'PMDRAG' index 52;
+ function DrgSendTransferMsg(hwnd : HWnd;msg : cardinal;mp1 : MParam;mp2 : MParam) : MResult; cdecl;
+ external 'PMDRAG' index 54;
+ function DrgSetDragitem(pdinfo : PDragInfo;pditem : PDragItem;cbBuffer : cardinal;iItem : cardinal) : Longbool; cdecl;
+ external 'PMDRAG' index 57;
+ function DrgSetDragImage(pdinfo : PDragInfo;pdimg : PDragImage;cdimg : cardinal; var pRsvd) : Longbool; cdecl;
+ external 'PMDRAG' index 56;
+ function DrgVerifyTypeSet(pditem : PDragItem;pszType : PChar;cbMatch : cardinal;pszMatch : PChar) : Longbool; cdecl;
+ external 'PMDRAG' index 62;
+ function DrgAccessDraginfo(pdinfo : PDragInfo) : Longbool; cdecl;
+ external 'PMDRAG' index 32;
+ function DrgAddStrHandle(PSZ : PChar) : HStr; cdecl;
+ external 'PMDRAG' index 33;
+ function DrgDeleteDraginfoStrHandles(pdinfo : PDragInfo) : Longbool; cdecl;
+ external 'PMDRAG' index 36;
+ function DrgDeleteStrHandle(hstr : HStr) : Longbool; cdecl;
+ external 'PMDRAG' index 37;
+ function DrgFreeDraginfo(pdinfo : PDragInfo) : Longbool; cdecl;
+ external 'PMDRAG' index 39;
+ function DrgFreeDragtransfer(pdxfer : PDragTransfer) : Longbool; cdecl;
+ external 'PMDRAG' index 40;
+ function DrgGetPS(hwnd : HWnd) : HPS; cdecl;
+ external 'PMDRAG' index 41;
+ function DrgPushDraginfo(pdinfo : PDragInfo;hwndDest : HWnd) : Longbool; cdecl;
+ external 'PMDRAG' index 43;
+ function DrgReleasePS(hps : HPS) : Longbool; cdecl;
+ external 'PMDRAG' index 53;
+ function DrgSetDragPointer(pdinfo : PDragInfo;hptr : cardinal) : Longbool; cdecl;
+ external 'PMDRAG' index 55;
+ function DrgVerifyNativeRMF(pditem : PDragItem;pszRMF : PChar) : Longbool; cdecl;
+ external 'PMDRAG' index 58;
+ function DrgVerifyRMF(pditem : PDragItem;pszMech : PChar;pszFmt : PChar) : Longbool; cdecl;
+ external 'PMDRAG' index 59;
+ function DrgVerifyTrueType(pditem : PDragItem;pszType : PChar) : Longbool; cdecl;
+ external 'PMDRAG' index 60;
+ function DrgVerifyType(pditem : PDragItem;pszType : PChar) : Longbool; cdecl;
+ external 'PMDRAG' index 61;
+
+end.
+{
+ $Log: pmstddlg.pas,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmwin.pas b/rtl/os2/pmwin.pas
new file mode 100644
index 0000000000..702d27b64a
--- /dev/null
+++ b/rtl/os2/pmwin.pas
@@ -0,0 +1,3789 @@
+{****************************************************************************
+
+ $Id: pmwin.pas,v 1.14 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ Copyright (c) 1999-2000 by Ramon Bosque
+ Copyrigth (c) 2003 by Yuri Prokushev
+
+ OS/2 Presentation Manager windowing functions, plus common
+ PM constants and types (PMWIN.DLL interface unit).
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+
+unit pmwin;
+
+{$mode objfpc}
+
+{$MACRO ON}
+
+ interface
+
+ uses
+ os2def;
+
+const
+ MaxMB2DText = 70;
+
+ type
+ proc=function (hwnd,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;
+ QVERSDATA = record
+ environment : word;
+ version : word;
+ end;
+ PQVERSDATA = ^QVERSDATA;
+ SWP = record
+ fl : cardinal;
+ cy : longint;
+ cx : longint;
+ y : longint;
+ x : longint;
+ hwndInsertBehind : cardinal;
+ hwnd : cardinal;
+ ulReserved1 : cardinal;
+ ulReserved2 : cardinal;
+ end;
+ PSWP = ^SWP;
+ CREATESTRUCT = record
+ pPresParams : pointer;
+ pCtlData : pointer;
+ id : cardinal;
+ hwndInsertBehind : cardinal;
+ hwndOwner : cardinal;
+ cy : longint;
+ cx : longint;
+ y : longint;
+ x : longint;
+ flStyle : cardinal;
+ pszText : pchar;
+ pszClass : pchar;
+ hwndParent : cardinal;
+ end;
+ PCREATESTRUCT = ^CREATESTRUCT;
+ CLASSINFO = record
+ flClassStyle : cardinal;
+ pfnWindowProc : proc;
+ cbWindowData : cardinal;
+ end;
+ PCLASSINFO = ^CLASSINFO;
+ QMSG = record
+ hwnd : cardinal;
+ msg : cardinal;
+ mp1 : pointer;
+ mp2 : pointer;
+ time : cardinal;
+ ptl : POINTL;
+ reserved : cardinal;
+ end;
+ PQMSG = ^QMSG;
+ MQINFO = record
+ cb : cardinal;
+ pid : cardinal;
+ tid : cardinal;
+ cmsgs : cardinal;
+ pReserved : pointer;
+ end;
+ PMQINFO = ^MQINFO;
+ WNDPARAMS = record
+ fsStatus : cardinal;
+ cchText : cardinal;
+ pszText : pchar;
+ cbPresParams : cardinal;
+ pPresParams : pointer;
+ cbCtlData : cardinal;
+ pCtlData : pointer;
+ end;
+ PWNDPARAMS = ^WNDPARAMS;
+ USERBUTTON = record
+ hwnd : cardinal;
+ hps : cardinal;
+ fsState : cardinal;
+ fsStateOld : cardinal;
+ end;
+ PUSERBUTTON = ^USERBUTTON;
+ OWNERITEM = record
+ hwnd : cardinal;
+ hps : cardinal;
+ fsState : cardinal;
+ fsAttribute : cardinal;
+ fsStateOld : cardinal;
+ fsAttributeOld : cardinal;
+ rclItem : TRectl;
+ idItem : longint;
+ hItem : cardinal;
+ end;
+ POWNERITEM = ^OWNERITEM;
+ PARAM = record
+ id : cardinal;
+ cb : cardinal;
+ ab : array[0..1-1] of BYTE;
+ end;
+ PPARAM = ^PARAM;
+ PRESPARAMS = record
+ cb : cardinal;
+ aparam : array[0..1-1] of PARAM;
+ end;
+ PPRESPARAMS = ^PRESPARAMS;
+ TRACKINFO = record
+ cxBorder : longint;
+ cyBorder : longint;
+ cxGrid : longint;
+ cyGrid : longint;
+ cxKeyboard : longint;
+ cyKeyboard : longint;
+ rclTrack : TRectl;
+ rclBoundary : TRectl;
+ ptlMinTrackSize : POINTL;
+ ptlMaxTrackSize : POINTL;
+ fs : cardinal;
+ end;
+ PTRACKINFO = ^TRACKINFO;
+ CURSORINFO = record
+ hwnd : cardinal;
+ x : longint;
+ y : longint;
+ cx : longint;
+ cy : longint;
+ fs : cardinal;
+ rclClip : TRectl;
+ end;
+ PCURSORINFO = ^CURSORINFO;
+ POINTERINFO = record
+ fPointer : cardinal;
+ xHotspot : longint;
+ yHotspot : longint;
+ hbmPointer : cardinal;
+ hbmColor : cardinal;
+ hbmMiniPointer : cardinal;
+ hbmMiniColor : cardinal;
+ end;
+ PPOINTERINFO = ^POINTERINFO;
+ SMHSTRUCT = record
+ mp2 : pointer;
+ mp1 : pointer;
+ msg : cardinal;
+ hwnd : cardinal;
+ model : cardinal;
+ end;
+ PSMHSTRUCT = ^SMHSTRUCT;
+ ERRINFO = record
+ cbFixedErrInfo : cardinal;
+ idError : cardinal;
+ cDetailLevel : cardinal;
+ offaoffszMsg : cardinal;
+ offBinaryData : cardinal;
+ end;
+ PERRINFO = ^ERRINFO;
+ CONVCONTEXT = record
+ cb : cardinal;
+ fsContext : cardinal;
+ idCountry : cardinal;
+ usCodepage : cardinal;
+ usLangID : cardinal;
+ usSubLangID : cardinal;
+ end;
+ PCONVCONTEXT = ^CONVCONTEXT;
+ DDEINIT = record
+ cb : cardinal;
+ pszAppName : pchar;
+ pszTopic : pchar;
+ offConvContext : cardinal;
+ end;
+ PDDEINIT = ^DDEINIT;
+ DDESTRUCT = record
+ cbData : cardinal;
+ fsStatus : word;
+ usFormat : word;
+ offszItemName : word;
+ offabData : word;
+ end;
+ PDDESTRUCT = ^DDESTRUCT;
+ DESKTOP = record
+ cbSize : cardinal;
+ hbm : cardinal;
+ x : longint;
+ y : longint;
+ fl : cardinal;
+ lTileCount : longint;
+ szFile : array[0..260-1] of shortint;
+ end;
+ PDESKTOP = ^DESKTOP;
+{$PACKRECORDS 1}
+ CMDMSG = record
+ cmd : word;
+ unused : word;
+ source : word;
+ fMouse : word;
+ end;
+ PCMDMSG = ^CMDMSG;
+ MSEMSG = record
+ x : integer;
+ y : integer;
+ codeHitTest : word;
+ fsInp : word;
+ end;
+ PMSEMSG = ^MSEMSG;
+ CHRMSG = record
+ fs : word;
+ cRepeat : byte;
+ scancode : byte;
+ chr : word;
+ vkey : word;
+ end;
+ PCHRMSG = ^CHRMSG;
+{$PACKRECORDS NORMAL}
+
+{$PACKRECORDS 2}
+ DLGTITEM = record
+ fsItemStatus : word;
+ cChildren : word;
+ cchClassName : word;
+ offClassName : word;
+ cchText : word;
+ offText : word;
+ flStyle : cardinal;
+ x : integer;
+ y : integer;
+ cx : integer;
+ cy : integer;
+ id : word;
+ offPresParams : word;
+ offCtlData : word;
+ end;
+ PDLGTITEM = ^DLGTITEM;
+ DLGTEMPLATE = record
+ cbTemplate : word;
+ _type : word;
+ codepage : word;
+ offadlgti : word;
+ fsTemplateStatus : word;
+ iItemFocus : word;
+ coffPresParams : word;
+ adlgti : array[0..0] of DLGTITEM;
+ end;
+ PDLGTEMPLATE = ^DLGTEMPLATE;
+ BTNCDATA = record
+ cb : word;
+ fsCheckState : word;
+ fsHiliteState : word;
+ hImage : cardinal;
+ end;
+ PBTNCDATA = ^BTNCDATA;
+ ENTRYFDATA = record
+ cb : word;
+ cchEditLimit : word;
+ ichMinSel : word;
+ ichMaxSel : word;
+ end;
+ PENTRYFDATA = ^ENTRYFDATA;
+ MENUITEM = record
+ iPosition : integer;
+ afStyle : word;
+ afAttribute : word;
+ id : word;
+ hwndSubMenu : cardinal;
+ hItem : cardinal;
+ end;
+ PMENUITEM = ^MENUITEM;
+ SBCDATA = record
+ cb : word;
+ sHilite : word;
+ posFirst : integer;
+ posLast : integer;
+ posThumb : integer;
+ cVisible : integer;
+ cTotal : integer;
+ end;
+ PSBCDATA = ^SBCDATA;
+ FRAMECDATA = record
+ cb : word;
+ flCreateFlags : cardinal;
+ hmodResources : word;
+ idResources : word;
+ end;
+ PFRAMECDATA = ^FRAMECDATA;
+ ACCEL = record
+ fs : word;
+ key : word;
+ cmd : word;
+ end;
+ PACCEL = ^ACCEL;
+ ACCELTABLE = record
+ cAccel : word;
+ codepage : word;
+ aaccel : array[0..1-1] of ACCEL;
+ end;
+ PACCELTABLE = ^ACCELTABLE;
+ MFP = record
+ sizeBounds : POINTL;
+ sizeMM : POINTL;
+ cbLength : cardinal;
+ mapMode : word;
+ reserved : word;
+ abData : array[0..1-1] of BYTE;
+ end;
+ PMFP = ^MFP;
+ CPTEXT = record
+ idCountry : word;
+ usCodepage : word;
+ usLangID : word;
+ usSubLangID : word;
+ abText : array[0..1-1] of BYTE;
+ end;
+ PCPTEXT = ^CPTEXT;
+
+(* Type definitions for WinMessageBox2 *)
+ MB2D = record
+ achText: array [0..MaxMB2DText] of char;
+ idButtons: cardinal;
+ flStyle: cardinal;
+ end;
+ TMB2D = MB2D;
+ PMB2D = ^TMB2D;
+
+ MB2Info = record
+ cb: cardinal; (* size of data *)
+ hIcon: cardinal; (* icon handle *)
+ cButtons: cardinal; (* number of buttons *)
+ flStyle: cardinal; (* icon style flags *)
+ hwndNotify: cardinal; (* owner notification handle *)
+ MB2D: array [0..0] of TMB2D; (* button definitions *)
+ end;
+ TMB2Info = MB2Info;
+ PMB2Info = ^TMB2Info;
+
+//***************************************************************************\
+//* FontRangeEntry
+//*
+//* ulRun = number of consecutive glyphs contained in the font
+//* ulSkip = number of consecutive glyphs skipped in the font,
+//* ulSkip == 0 --> Last FontRangeEntry in table
+//***************************************************************************/
+type
+ FONTRANGEENTRY=record // fre
+ ulRun: Cardinal;
+ ulSkip: Cardinal;
+ end;
+ PFONTRANGEENTRY=^FONTRANGEENTRY;
+
+//***************************************************************************\
+//* FontCharDef
+//*
+//* ulGlyphOffset = offset to rendered character bitmap (0 from driver)
+//* sAspace = pre-character space
+//* sBspace = character width (always non-zero)
+//* sCspace = post-character space
+//***************************************************************************/
+type
+ FONTCHARDEF=record // fcd
+ ulGlyphOffset: Cardinal;
+ sAspace: Integer;
+ sBspace: Word;
+ sCspace: integer;
+ end;
+ PFONTCHARDEF=^FONTCHARDEF;
+
+//***************************************************************************\
+//* FocaMetricsExtension
+//***************************************************************************/
+type
+ FOCAMETRICSEXT=record // fme
+ ulSize: Cardinal; // Total size of extension
+ ulFlags: Cardinal; // Reserved, must be 0
+ ulGlyphCount: Cardinal;
+ ulDefaultIndex: Cardinal;
+ ulRangeTableEntries: Cardinal;
+ afreRangeTable: Array[1..1] of FONTRANGEENTRY;
+ end;
+ PFOCAMETRICSEXT=^FOCAMETRICSEXT;
+
+//**************************************************************************
+type
+ FOCAMETRICS=record // foca
+ ulIdentity: Cardinal;
+ ulSize: Cardinal;
+ szFamilyname: Array[1..32] of Char;
+ szFacename: Array[1..32] of Char;
+ usRegistryId: Integer;
+ usCodePage: Integer;
+ yEmHeight: Integer;
+ yXHeight: Integer;
+ yMaxAscender: Integer;
+ yMaxDescender: Integer;
+ yLowerCaseAscent: Integer;
+ yLowerCaseDescent: Integer;
+ yInternalLeading: Integer;
+ yExternalLeading: Integer;
+ xAveCharWidth: Integer;
+ xMaxCharInc: Integer;
+ xEmInc: Integer;
+ yMaxBaselineExt: Integer;
+ sCharSlope: Integer;
+ sInlineDir: Integer;
+ sCharRot: Integer;
+ usWeightClass: Word;
+ usWidthClass: Word;
+ xDeviceRes: Integer;
+ yDeviceRes: Integer;
+ usFirstChar: Integer;
+ usLastChar: Integer;
+ usDefaultChar: Integer;
+ usBreakChar: Integer;
+ usNominalPointSize: Integer;
+ usMinimumPointSize: Integer;
+ usMaximumPointSize: Integer;
+ fsTypeFlags: Integer;
+ fsDefn: Integer;
+ fsSelectionFlags: Integer;
+ fsCapabilities: Integer;
+ ySubscriptXSize: Integer;
+ ySubscriptYSize: Integer;
+ ySubscriptXOffset: Integer;
+ ySubscriptYOffset: Integer;
+ ySuperscriptXSize: Integer;
+ ySuperscriptYSize: Integer;
+ ySuperscriptXOffset: Integer;
+ ySuperscriptYOffset: Integer;
+ yUnderscoreSize: Integer;
+ yUnderscorePosition: Integer;
+ yStrikeoutSize: Integer;
+ yStrikeoutPosition: Integer;
+ usKerningPairs: Integer;
+ sFamilyClass: Integer;
+ pszDeviceNameOffset: PChar;
+ end;
+ PFOCAMETRICS=^FOCAMETRICS;
+
+// REUSE - long offset to extension relative to FocaMetrics
+{$define loffExtension:=pszDeviceNameOffset}
+
+type
+ FONTFILEMETRICS=record // ffm
+ ulIdentity: Cardinal;
+ ulSize: Cardinal;
+ szFamilyname: Array[0..32-1] of Char;
+ szFacename: Array[0..32-1] of Char;
+ usRegistryId: Integer;
+ usCodePage: Integer;
+ yEmHeight: Integer;
+ yXHeight: Integer;
+ yMaxAscender: Integer;
+ yMaxDescender: Integer;
+ yLowerCaseAscent: Integer;
+ yLowerCaseDescent: Integer;
+ yInternalLeading: Integer;
+ yExternalLeading: Integer;
+ xAveCharWidth: Integer;
+ xMaxCharInc: Integer;
+ xEmInc: Integer;
+ yMaxBaselineExt: Integer;
+ sCharSlope: Integer;
+ sInlineDir: Integer;
+ sCharRot: Integer;
+ usWeightClass: Word;
+ usWidthClass: Word;
+ xDeviceRes: Integer;
+ yDeviceRes: Integer;
+ usFirstChar: Integer;
+ usLastChar: Integer;
+ usDefaultChar: Integer;
+ usBreakChar: Integer;
+ usNominalPointSize: Integer;
+ usMinimumPointSize: Integer;
+ usMaximumPointSize: Integer;
+ fsTypeFlags: Integer;
+ fsDefn: Integer;
+ fsSelectionFlags: Integer;
+ fsCapabilities: Integer;
+ ySubscriptXSize: Integer;
+ ySubscriptYSize: Integer;
+ ySubscriptXOffset: Integer;
+ ySubscriptYOffset: Integer;
+ ySuperscriptXSize: Integer;
+ ySuperscriptYSize: Integer;
+ ySuperscriptXOffset: Integer;
+ ySuperscriptYOffset: Integer;
+ yUnderscoreSize: Integer;
+ yUnderscorePosition: Integer;
+ yStrikeoutSize: Integer;
+ yStrikeoutPosition: Integer;
+ usKerningPairs: Integer;
+ sFamilyClass: Integer;
+ ulReserved: Cardinal;
+ anose: PANOSE;
+ end;
+ PFONTFILEMETRICS=^FONTFILEMETRICS;
+
+ FONTDEFINITIONHEADER=record // fdh
+ ulIdentity: Cardinal;
+ ulSize: Cardinal;
+ fsFontdef: Integer;
+ fsChardef: Integer;
+ usCellSize: Integer;
+ xCellWidth: Integer;
+ yCellHeight: Integer;
+ xCellIncrement: Integer;
+ xCellA: Integer;
+ xCellB: Integer;
+ xCellC: Integer;
+ pCellBaseOffset: Integer;
+ end;
+ PFONTDEFINITIONHEADER=^FONTDEFINITIONHEADER;
+
+const
+ FONTDEFFONT1 =$0047; // set width, height, inc. & base offset
+ FONTDEFFONT2 =$0042; // set height & base offset
+ FONTDEFFONT3 =$0042; // set height & base offset
+ FONTDEFCHAR1 =$0081; // set char offset and width
+ FONTDEFCHAR2 =$0081; // set char offset and width
+ FONTDEFCHAR3 =$00b8; // set char offset, A, B, and C space
+ SPACE_UNDEF =$8000; // space undefined = take default
+ FONTDEFFOCA32 =$4000;
+ FONTDEFDEVFONT =$2000; // Device or Downloadable font
+
+type
+ FONTSIGNATURE=record // fs
+ ulIdentity: Cardinal;
+ ulSize: Cardinal;
+ achSignature: Array[0..12-1] of Char;
+ end;
+ PFONTSIGNATURE=^FONTSIGNATURE;
+
+ ADDITIONALMETRICS=record // am
+ ulIdentity: Cardinal;
+ ulSize: Cardinal;
+ anose: PANOSE;
+ end;
+ PADDITIONALMETRICS=^ADDITIONALMETRICS;
+
+ FOCAFONT=record // ff
+ fsSignature: FONTSIGNATURE;
+ fmMetrics: FOCAMETRICS;
+ fdDefinitions: FONTDEFINITIONHEADER;
+ end;
+ PFOCAFONT=^FOCAFONT;
+
+const
+ FONT_SIGNATURE =$fffffffe;// Identity header start
+ FONT_METRICS =$00000001;// Identity metrics
+ FONT_DEFINITION =$00000002;// Identity definition
+ FONT_KERNPAIRS =$00000003;// Identity Kern Pairs
+ FONT_ADDITIONALMETRICS =$00000004;// Identity Additional Metrics
+ FONT_ENDRECORD =$ffffffff;// Identity record end
+
+type
+ FOCAFONT32=FOCAFONT;
+ PFOCAFONT32=^FOCAFONT32;
+
+// Options for QueryFonts
+const
+ QUERY_PUBLIC_FONTS =$0001;
+ QUERY_PRIVATE_FONTS =$0002;
+
+ CDEF_GENERIC =$0001;
+ CDEF_BOLD =$0002;
+ CDEF_ITALIC =$0004;
+ CDEF_UNDERSCORE =$0008;
+ CDEF_STRIKEOUT =$0010;
+ CDEF_OUTLINE =$0020;
+
+const
+ //*************************************************************************
+ //* MLE Window styles ( in addition to WS_* )
+ //*************************************************************************/
+ MLS_WORDWRAP = $00000001;
+ MLS_BORDER = $00000002;
+ MLS_VSCROLL = $00000004;
+ MLS_HSCROLL = $00000008;
+ MLS_READONLY = $00000010;
+ MLS_IGNORETAB = $00000020;
+ MLS_DISABLEUNDO = $00000040;
+ MLS_LIMITVSCROLL = $00000080;
+
+ //*************************************************************************
+ //* MLE External Data Types
+ //*************************************************************************/
+type
+ IPT=Longint; // insertion point
+ PIPT=^IPT; // insertion point
+ PIX=Longint; // pixel
+ LINE=Cardinal; // Line number
+
+ FORMATRECT=record // MLEFRD
+ cxFormat: Longint; // format rectangle width
+ cyFormat: Longint; // format rectangle height
+ end;
+ PMLEFORMATRECT=^FORMATRECT;
+
+ MLECTLDATA=record // MLECTL
+ cbCtlData: Word; // Length of the MLECTLDATA structure
+ afIEFormat: Word; // import/export format
+ cchText: Cardinal; // text limit
+ iptAnchor: IPT; // beginning of selection
+ iptCursor: IPT; // ending of selection
+ cxFormat: Longint; // format rectangle width
+ cyFormat: Longint; // format rectangle height
+ afFormatFlags: Cardinal; // formatting rectangle flags
+ pHWXCtlData: Pointer; // reserved for Pen CtlData (penpm.h)
+ end;
+ PMLECTLDATA=^MLECTLDATA;
+
+ //*************************************************************************
+ //* afFormatFlags mask
+ //*************************************************************************/
+const
+ MLFFMTRECT_LIMITHORZ =$00000001;
+ MLFFMTRECT_LIMITVERT =$00000002;
+ MLFFMTRECT_MATCHWINDOW =$00000004;
+ MLFFMTRECT_FORMATRECT =$00000007;
+
+ //************************************************************************
+ //* afIEFormat - Import/Export Format flags
+ //************************************************************************
+ MLFIE_CFTEXT = 0;
+ MLFIE_NOTRANS = 1;
+ MLFIE_WINFMT = 2;
+ MLFIE_RTF = 3;
+
+ //*************************************************************************
+ //* MLE color types: MLM_QUERY(TEXT/BACK)COLOR, MLM_SET(TEXT/BACK)COLOR
+ //*************************************************************************/
+ MLE_INDEX = 0;
+ MLE_RGB = 1;
+
+ //*************************************************************************
+ //* MLN_OVERFLOW structure
+ //*************************************************************************/
+type
+ MLEOVERFLOW=record // overflow
+ afErrInd: Cardinal; // see mask below
+ nBytesOver: Longint; // number of bytes overflowed
+ pixHorzOver: Longint; // number of pixels horizontally overflow
+ pixVertOver: Longint; // number of pixels vertically overflowed
+ end;
+ POVERFLOW=^MLEOVERFLOW;
+
+ //*************************************************************************
+ //* afErrInd - error format rectangle flags
+ //*************************************************************************/
+const
+ MLFEFR_RESIZE = $00000001;
+ MLFEFR_TABSTOP = $00000002;
+ MLFEFR_FONT = $00000004;
+ MLFEFR_TEXT = $00000008;
+ MLFEFR_WORDWRAP = $00000010;
+ MLFETL_TEXTBYTES = $00000020;
+
+ //*************************************************************************
+ //* MLN_MARGIN structure
+ //*************************************************************************/
+type
+ MLEMARGSTRUCT=record // margin
+ afMargins: Word; // margin indicator
+ usMouMsg: Word; // mouse message
+ iptNear: IPT; // the geometrically nearest insertion point
+ end;
+ PMARGSTRUCT=^MLEMARGSTRUCT;
+
+ //*************************************************************************
+ //* afFlags - margin notification indicators
+ //*************************************************************************/
+const
+ MLFMARGIN_LEFT =$0001;
+ MLFMARGIN_BOTTOM =$0002;
+ MLFMARGIN_RIGHT =$0003;
+ MLFMARGIN_TOP =$0004;
+
+ //*************************************************************************
+ // MLM_QUERYSELECTION flags
+ //************************************************************************/
+ MLFQS_MINMAXSEL = 0;
+ MLFQS_MINSEL = 1;
+ MLFQS_MAXSEL = 2;
+ MLFQS_ANCHORSEL = 3;
+ MLFQS_CURSORSEL = 4;
+
+ //*************************************************************************
+ //* MLN_CLPBDFAIL flags
+ //*************************************************************************/
+ MLFCLPBD_TOOMUCHTEXT =$00000001;
+ MLFCLPBD_ERROR =$00000002;
+
+ //*************************************************************************
+ //* MLM_SEARCH structure
+ //*************************************************************************/
+type
+ MLE_SEARCHDATA=record // search
+ cb: Word; // size of search spec structure
+ pchFind: PChar; // string to search for
+ pchReplace: PChar; // string to replace with
+ cchFind: Integer; // length of pchFindString
+ cchReplace: Integer; // length of replace string
+ iptStart: IPT; // point at which to start search
+ // (negative indicates cursor pt)
+ // becomes pt where string found
+ iptStop: IPT; // point at which to stop search
+ // (negative indicates EOT)
+ cchFound: Word; // Length of found string at iptStart
+ end;
+ PMLE_SEARCHDATA=^MLE_SEARCHDATA;
+
+ //*************************************************************************
+ //* MLM_SEARCH style flags
+ //*************************************************************************/
+const
+ MLFSEARCH_CASESENSITIVE =$00000001;
+ MLFSEARCH_SELECTMATCH =$00000002;
+ MLFSEARCH_CHANGEALL =$00000004;
+
+ //*************************************************************************
+ //* MLE messages - MLM from 0x01b0 to 0x01de; MLN from 0x0001 to 0x000f
+ //*************************************************************************/
+ // formatting messages
+ MLM_SETTEXTLIMIT =$01b0;
+ MLM_QUERYTEXTLIMIT =$01b1;
+ MLM_SETFORMATRECT =$01b2;
+ MLM_QUERYFORMATRECT =$01b3;
+ MLM_SETWRAP =$01b4;
+ MLM_QUERYWRAP =$01b5;
+ MLM_SETTABSTOP =$01b6;
+ MLM_QUERYTABSTOP =$01b7;
+ MLM_SETREADONLY =$01b8;
+ MLM_QUERYREADONLY =$01b9;
+
+ // text content manipulation and queries messages
+ MLM_QUERYCHANGED =$01ba;
+ MLM_SETCHANGED =$01bb;
+ MLM_QUERYLINECOUNT =$01bc;
+ MLM_CHARFROMLINE =$01bd;
+ MLM_LINEFROMCHAR =$01be;
+ MLM_QUERYLINELENGTH =$01bf;
+ MLM_QUERYTEXTLENGTH =$01c0;
+
+ // text import and export messages
+ MLM_FORMAT =$01c1;
+ MLM_SETIMPORTEXPORT =$01c2;
+ MLM_IMPORT =$01c3;
+ MLM_EXPORT =$01c4;
+ MLM_DELETE =$01c6;
+ MLM_QUERYFORMATLINELENGTH =$01c7;
+ MLM_QUERYFORMATTEXTLENGTH =$01c8;
+ MLM_INSERT =$01c9;
+
+ // selection messages
+ MLM_SETSEL =$01ca;
+ MLM_QUERYSEL =$01cb;
+ MLM_QUERYSELTEXT =$01cc;
+
+ // undo and redo messages
+ MLM_QUERYUNDO =$01cd;
+ MLM_UNDO =$01ce;
+ MLM_RESETUNDO =$01cf;
+
+ // text attributes messages
+ MLM_QUERYFONT =$01d0;
+ MLM_SETFONT =$01d1;
+ MLM_SETTEXTCOLOR =$01d2;
+ MLM_QUERYTEXTCOLOR =$01d3;
+ MLM_SETBACKCOLOR =$01d4;
+ MLM_QUERYBACKCOLOR =$01d5;
+
+ // scrolling messages
+ MLM_QUERYFIRSTCHAR =$01d6;
+ MLM_SETFIRSTCHAR =$01d7;
+
+ // clipboard messages
+ MLM_CUT =$01d8;
+ MLM_COPY =$01d9;
+ MLM_PASTE =$01da;
+ MLM_CLEAR =$01db;
+
+ // display manipulation messages
+ MLM_ENABLEREFRESH =$01dc;
+ MLM_DISABLEREFRESH =$01dd;
+
+ // search message
+ MLM_SEARCH =$01de;
+ MLM_QUERYIMPORTEXPORT =$01df;
+
+ // notification messages
+ MLN_OVERFLOW =$0001;
+ MLN_PIXHORZOVERFLOW =$0002;
+ MLN_PIXVERTOVERFLOW =$0003;
+ MLN_TEXTOVERFLOW =$0004;
+ MLN_VSCROLL =$0005;
+ MLN_HSCROLL =$0006;
+ MLN_CHANGE =$0007;
+ MLN_SETFOCUS =$0008;
+ MLN_KILLFOCUS =$0009;
+ MLN_MARGIN =$000a;
+ MLN_SEARCHPAUSE =$000b;
+ MLN_MEMERROR =$000c;
+ MLN_UNDOOVERFLOW =$000d;
+ MLN_CLPBDFAIL =$000f;
+
+
+const
+ DTYP_USER =(16384);
+
+ DTYP_CTL_ARRAY =(1);
+ DTYP_CTL_PARRAY =(-1);
+ DTYP_CTL_OFFSET =(2);
+ DTYP_CTL_LENGTH =(3);
+
+//**********************************************************************/
+//* Ordinary datatypes */
+//**********************************************************************/
+ DTYP_ACCEL =(28);
+ DTYP_ACCELTABLE =(29);
+ DTYP_ARCPARAMS =(38);
+ DTYP_AREABUNDLE =(139);
+ DTYP_ATOM =(90);
+ DTYP_BITMAPINFO =(60);
+ DTYP_BITMAPINFOHEADER =(61);
+ DTYP_BITMAPINFO2 =(170);
+ DTYP_BITMAPINFOHEADER2 =(171);
+ DTYP_BIT16 =(20);
+ DTYP_BIT32 =(21);
+ DTYP_BIT8 =(19);
+ DTYP_BOOL =(18);
+ DTYP_BTNCDATA =(35);
+ DTYP_BYTE =(13);
+ DTYP_CATCHBUF =(141);
+ DTYP_CHAR =(15);
+ DTYP_CHARBUNDLE =(135);
+ DTYP_CLASSINFO =(95);
+ DTYP_COUNT2 =(93);
+ DTYP_COUNT2B =(70);
+ DTYP_COUNT2CH =(82);
+ DTYP_COUNT4 =(152);
+ DTYP_COUNT4B =(42);
+ DTYP_CPID =(57);
+ DTYP_CREATESTRUCT =(98);
+ DTYP_CURSORINFO =(34);
+ DTYP_DEVOPENSTRUC =(124);
+ DTYP_DLGTEMPLATE =(96);
+ DTYP_DLGTITEM =(97);
+ DTYP_ENTRYFDATA =(127);
+ DTYP_ERRORID =(45);
+ DTYP_FATTRS =(75);
+ DTYP_FFDESCS =(142);
+ DTYP_FIXED =(99);
+ DTYP_FONTMETRICS =(74);
+ DTYP_FRAMECDATA =(144);
+ DTYP_GRADIENTL =(48);
+ DTYP_HAB =(10);
+ DTYP_HACCEL =(30);
+ DTYP_HAPP =(146);
+ DTYP_HATOMTBL =(91);
+ DTYP_HBITMAP =(62);
+ DTYP_HCINFO =(46);
+ DTYP_HDC =(132);
+ DTYP_HENUM =(117);
+ DTYP_HHEAP =(109);
+ DTYP_HINI =(53);
+ DTYP_HLIB =(147);
+ DTYP_HMF =(85);
+ DTYP_HMQ =(86);
+ DTYP_HPOINTER =(106);
+ DTYP_HPROGRAM =(131);
+ DTYP_HPS =(12);
+ DTYP_HRGN =(116);
+ DTYP_HSEM =(140);
+ DTYP_HSPL =(32);
+ DTYP_HSWITCH =(66);
+ DTYP_HVPS =(58);
+ DTYP_HWND =(11);
+ DTYP_IDENTITY =(133);
+ DTYP_IDENTITY4 =(169);
+ DTYP_IMAGEBUNDLE =(136);
+ DTYP_INDEX2 =(81);
+ DTYP_IPT =(155);
+ DTYP_KERNINGPAIRS =(118);
+ DTYP_LENGTH2 =(68);
+ DTYP_LENGTH4 =(69);
+ DTYP_LINEBUNDLE =(137);
+ DTYP_LONG =(25);
+ DTYP_MARKERBUNDLE =(138);
+ DTYP_MATRIXLF =(113);
+ DTYP_MLECTLDATA =(161);
+ DTYP_MLEMARGSTRUCT =(157);
+ DTYP_MLEOVERFLOW =(158);
+ DTYP_OFFSET2B =(112);
+ DTYP_OWNERITEM =(154);
+ DTYP_PID =(92);
+ DTYP_PIX =(156);
+ DTYP_POINTERINFO =(105);
+ DTYP_POINTL =(77);
+ DTYP_PROGCATEGORY =(129);
+ DTYP_PROGRAMENTRY =(128);
+ DTYP_PROGTYPE =(130);
+ DTYP_PROPERTY2 =(88);
+ DTYP_PROPERTY4 =(89);
+ DTYP_QMSG =(87);
+ DTYP_RECTL =(121);
+ DTYP_RESID =(125);
+ DTYP_RGB =(111);
+ DTYP_RGNRECT =(115);
+ DTYP_SBCDATA =(159);
+ DTYP_SEGOFF =(126);
+ DTYP_SHORT =(23);
+ DTYP_SIZEF =(101);
+ DTYP_SIZEL =(102);
+ DTYP_STRL =(17);
+ DTYP_STR16 =(40);
+ DTYP_STR32 =(37);
+ DTYP_STR64 =(47);
+ DTYP_STR8 =(33);
+ DTYP_SWBLOCK =(63);
+ DTYP_SWCNTRL =(64);
+ DTYP_SWENTRY =(65);
+ DTYP_SWP =(31);
+ DTYP_TID =(104);
+ DTYP_TIME =(107);
+ DTYP_TRACKINFO =(73);
+ DTYP_UCHAR =(22);
+ DTYP_ULONG =(26);
+ DTYP_USERBUTTON =(36);
+ DTYP_USHORT =(24);
+ DTYP_WIDTH4 =(108);
+ DTYP_WNDPARAMS =(83);
+ DTYP_WNDPROC =(84);
+ DTYP_WPOINT =(59);
+ DTYP_WRECT =(55);
+ DTYP_XYWINSIZE =(52);
+
+
+//**********************************************************************/
+//* Pointer datatypes */
+//**********************************************************************/
+ DTYP_PACCEL =(-28);
+ DTYP_PACCELTABLE =(-29);
+ DTYP_PARCPARAMS =(-38);
+ DTYP_PAREABUNDLE =(-139);
+ DTYP_PATOM =(-90);
+ DTYP_PBITMAPINFO =(-60);
+ DTYP_PBITMAPINFOHEADER =(-61);
+ DTYP_PBITMAPINFO2 =(-170);
+ DTYP_PBITMAPINFOHEADER2=(-171);
+ DTYP_PBIT16 =(-20);
+ DTYP_PBIT32 =(-21);
+ DTYP_PBIT8 =(-19);
+ DTYP_PBOOL =(-18);
+ DTYP_PBTNCDATA =(-35);
+ DTYP_PBYTE =(-13);
+ DTYP_PCATCHBUF =(-141);
+ DTYP_PCHAR =(-15);
+ DTYP_PCHARBUNDLE =(-135);
+ DTYP_PCLASSINFO =(-95);
+ DTYP_PCOUNT2 =(-93);
+ DTYP_PCOUNT2B =(-70);
+ DTYP_PCOUNT2CH =(-82);
+ DTYP_PCOUNT4 =(-152);
+ DTYP_PCOUNT4B =(-42);
+ DTYP_PCPID =(-57);
+ DTYP_PCREATESTRUCT =(-98);
+ DTYP_PCURSORINFO =(-34);
+ DTYP_PDEVOPENSTRUC =(-124);
+ DTYP_PDLGTEMPLATE =(-96);
+ DTYP_PDLGTITEM =(-97);
+ DTYP_PENTRYFDATA =(-127);
+ DTYP_PERRORID =(-45);
+ DTYP_PFATTRS =(-75);
+ DTYP_PFFDESCS =(-142);
+ DTYP_PFIXED =(-99);
+ DTYP_PFONTMETRICS =(-74);
+ DTYP_PFRAMECDATA =(-144);
+ DTYP_PGRADIENTL =(-48);
+ DTYP_PHAB =(-10);
+ DTYP_PHACCEL =(-30);
+ DTYP_PHAPP =(-146);
+ DTYP_PHATOMTBL =(-91);
+ DTYP_PHBITMAP =(-62);
+ DTYP_PHCINFO =(-46);
+ DTYP_PHDC =(-132);
+ DTYP_PHENUM =(-117);
+ DTYP_PHHEAP =(-109);
+ DTYP_PHINI =(-53);
+ DTYP_PHLIB =(-147);
+ DTYP_PHMF =(-85);
+ DTYP_PHMQ =(-86);
+ DTYP_PHPOINTER =(-106);
+ DTYP_PHPROGRAM =(-131);
+ DTYP_PHPS =(-12);
+ DTYP_PHRGN =(-116);
+ DTYP_PHSEM =(-140);
+ DTYP_PHSPL =(-32);
+ DTYP_PHSWITCH =(-66);
+ DTYP_PHVPS =(-58);
+ DTYP_PHWND =(-11);
+ DTYP_PIDENTITY =(-133);
+ DTYP_PIDENTITY4 =(-169);
+ DTYP_PIMAGEBUNDLE =(-136);
+ DTYP_PINDEX2 =(-81);
+ DTYP_PIPT =(-155);
+ DTYP_PKERNINGPAIRS =(-118);
+ DTYP_PLENGTH2 =(-68);
+ DTYP_PLENGTH4 =(-69);
+ DTYP_PLINEBUNDLE =(-137);
+ DTYP_PLONG =(-25);
+ DTYP_PMARKERBUNDLE =(-138);
+ DTYP_PMATRIXLF =(-113);
+ DTYP_PMLECTLDATA =(-161);
+ DTYP_PMLEMARGSTRUCT =(-157);
+ DTYP_PMLEOVERFLOW =(-158);
+ DTYP_POFFSET2B =(-112);
+ DTYP_POWNERITEM =(-154);
+ DTYP_PPID =(-92);
+ DTYP_PPIX =(-156);
+ DTYP_PPOINTERINFO =(-105);
+ DTYP_PPOINTL =(-77);
+ DTYP_PPROGCATEGORY =(-129);
+ DTYP_PPROGRAMENTRY =(-128);
+ DTYP_PPROGTYPE =(-130);
+ DTYP_PPROPERTY2 =(-88);
+ DTYP_PPROPERTY4 =(-89);
+ DTYP_PQMSG =(-87);
+ DTYP_PRECTL =(-121);
+ DTYP_PRESID =(-125);
+ DTYP_PRGB =(-111);
+ DTYP_PRGNRECT =(-115);
+ DTYP_PSBCDATA =(-159);
+ DTYP_PSEGOFF =(-126);
+ DTYP_PSHORT =(-23);
+ DTYP_PSIZEF =(-101);
+ DTYP_PSIZEL =(-102);
+ DTYP_PSTRL =(-17);
+ DTYP_PSTR16 =(-40);
+ DTYP_PSTR32 =(-37);
+ DTYP_PSTR64 =(-47);
+ DTYP_PSTR8 =(-33);
+ DTYP_PSWBLOCK =(-63);
+ DTYP_PSWCNTRL =(-64);
+ DTYP_PSWENTRY =(-65);
+ DTYP_PSWP =(-31);
+ DTYP_PTID =(-104);
+ DTYP_PTIME =(-107);
+ DTYP_PTRACKINFO =(-73);
+ DTYP_PUCHAR =(-22);
+ DTYP_PULONG =(-26);
+ DTYP_PUSERBUTTON =(-36);
+ DTYP_PUSHORT =(-24);
+ DTYP_PWIDTH4 =(-108);
+ DTYP_PWNDPARAMS =(-83);
+ DTYP_PWNDPROC =(-84);
+ DTYP_PWPOINT =(-59);
+ DTYP_PWRECT =(-55);
+ DTYP_PXYWINSIZE =(-52);
+
+{$PACKRECORDS NORMAL}
+
+{Names beginning with T for compatibility}
+type
+ TQVERSDATA = QVERSDATA;
+ TSWP = SWP;
+ TCREATESTRUCT = CREATESTRUCT;
+ TCLASSINFO = CLASSINFO;
+ TQMSG = QMSG;
+ TMQINFO = MQINFO;
+ TWNDPARAMS = WNDPARAMS;
+ TUSERBUTTON = USERBUTTON;
+ TOWNERITEM = OWNERITEM;
+ TPARAM = PARAM;
+ TPRESPARAMS = PRESPARAMS;
+ TTRACKINFO = TRACKINFO;
+ TCURSORINFO = CURSORINFO;
+ TPOINTERINFO = POINTERINFO;
+ TSMHSTRUCT = SMHSTRUCT;
+ TERRINFO = ERRINFO;
+ TCONVCONTEXT = CONVCONTEXT;
+ TDDEINIT = DDEINIT;
+ TDDESTRUCT = DDESTRUCT;
+ TDESKTOP = DESKTOP;
+ TCMDMSG = CMDMSG;
+ TMSEMSG = MSEMSG;
+ TCHRMSG = CHRMSG;
+ TDLGTITEM = DLGTITEM;
+ TDLGTEMPLATE = DLGTEMPLATE;
+ TBTNCDATA = BTNCDATA;
+ TENTRYFDATA = ENTRYFDATA;
+ TMENUITEM = MENUITEM;
+ TSBCDATA = SBCDATA;
+ TFRAMECDATA = FRAMECDATA;
+ TACCEL = ACCEL;
+ TACCELTABLE = ACCELTABLE;
+ TMPF = MFP;
+ TCPTEXT = CPTEXT;
+const
+ WS_VISIBLE = $80000000;
+ WS_DISABLED = $40000000;
+ WS_CLIPCHILDREN = $20000000;
+ WS_CLIPSIBLINGS = $10000000;
+ WS_PARENTCLIP = $08000000;
+ WS_SAVEBITS = $04000000;
+ WS_SYNCPAINT = $02000000;
+ WS_MINIMIZED = $01000000;
+ WS_MAXIMIZED = $00800000;
+ WS_ANIMATE = $00400000;
+ WS_GROUP = $00010000;
+ WS_TABSTOP = $00020000;
+ WS_MULTISELECT = $00040000;
+ CS_MOVENOTIFY = $00000001;
+ CS_SIZEREDRAW = $00000004;
+ CS_HITTEST = $00000008;
+ CS_PUBLIC = $00000010;
+ CS_FRAME = $00000020;
+ CS_CLIPCHILDREN = $20000000;
+ CS_CLIPSIBLINGS = $10000000;
+ CS_PARENTCLIP = $08000000;
+ CS_SAVEBITS = $04000000;
+ CS_SYNCPAINT = $02000000;
+
+ HWND_DESKTOP = 1;
+ HWND_OBJECT = 2;
+ HWND_TOP = 3;
+ HWND_BOTTOM = 4;
+ HWND_THREADCAPTURE = 5;
+
+ PSF_LOCKWINDOWUPDATE = $0001;
+ PSF_CLIPUPWARDS = $0002;
+ PSF_CLIPDOWNWARDS = $0004;
+ PSF_CLIPSIBLINGS = $0008;
+ PSF_CLIPCHILDREN = $0010;
+ PSF_PARENTCLIP = $0020;
+ SW_SCROLLCHILDREN = $0001;
+ SW_INVALIDATERGN = $0002;
+
+ QV_OS2 = $0000;
+ QV_CMS = $0001;
+ QV_TSO = $0002;
+ QV_TSOBATCH = $0003;
+ QV_OS400 = $0004;
+
+ QW_NEXT = 0;
+ QW_PREV = 1;
+ QW_TOP = 2;
+ QW_BOTTOM = 3;
+ QW_OWNER = 4;
+ QW_PARENT = 5;
+ QW_NEXTTOP = 6;
+ QW_PREVTOP = 7;
+ QW_FRAMEOWNER = 8;
+
+ AWP_MINIMIZED = $00010000;
+ AWP_MAXIMIZED = $00020000;
+ AWP_RESTORED = $00040000;
+ AWP_ACTIVATE = $00080000;
+ AWP_DEACTIVATE = $00100000;
+ SWP_SIZE = $0001;
+ SWP_MOVE = $0002;
+ SWP_ZORDER = $0004;
+ SWP_SHOW = $0008;
+ SWP_HIDE = $0010;
+ SWP_NOREDRAW = $0020;
+ SWP_NOADJUST = $0040;
+ SWP_ACTIVATE = $0080;
+ SWP_DEACTIVATE = $0100;
+ SWP_EXTSTATECHANGE = $0200;
+ SWP_MINIMIZE = $0400;
+ SWP_MAXIMIZE = $0800;
+ SWP_RESTORE = $1000;
+ SWP_FOCUSACTIVATE = $2000;
+ SWP_FOCUSDEACTIVATE = $4000;
+ SWP_NOAUTOCLOSE = $8000;
+
+ DBM_NORMAL = $0000;
+ DBM_INVERT = $0001;
+ DBM_HALFTONE = $0002;
+ DBM_STRETCH = $0004;
+ DBM_IMAGEATTRS = $0008;
+
+ DT_LEFT = $0000;
+ DT_QUERYEXTENT = $0002;
+ DT_UNDERSCORE = $0010;
+ DT_STRIKEOUT = $0020;
+ DT_TEXTATTRS = $0040;
+ DT_EXTERNALLEADING = $0080;
+ DT_CENTER = $0100;
+ DT_RIGHT = $0200;
+ DT_TOP = $0000;
+ DT_VCENTER = $0400;
+ DT_BOTTOM = $0800;
+ DT_HALFTONE = $1000;
+ DT_MNEMONIC = $2000;
+ DT_WORDBREAK = $4000;
+ DT_ERASERECT = $8000;
+
+ DB_PATCOPY = $0000;
+ DB_PATINVERT = $0001;
+ DB_DESTINVERT = $0002;
+ DB_AREAMIXMODE = $0003;
+ DB_ROP = $0007;
+ DB_INTERIOR = $0008;
+ DB_AREAATTRS = $0010;
+ DB_STANDARD = $0100;
+ DB_DLGBORDER = $0200;
+
+ QWS_USER = 0;
+ QWS_ID = -1;
+ QWS_MIN = -1;
+ QWL_USER = 0;
+ QWL_STYLE = -2;
+ QWP_PFNWP = -3;
+ QWL_HMQ = -4;
+ QWL_RESERVED = -5;
+ QWL_MIN = -6;
+ QWL_HHEAP = $0004;
+ QWL_HWNDFOCUSSAVE = $0018;
+ QWL_DEFBUTTON = $0040;
+ QWL_PSSCBLK = $0048;
+ QWL_PFEPBLK = $004c;
+ QWL_PSTATBLK = $0050;
+ QWS_FLAGS = $0008;
+ QWS_RESULT = $000a;
+ QWS_XRESTORE = $000c;
+ QWS_YRESTORE = $000e;
+ QWS_CXRESTORE = $0010;
+ QWS_CYRESTORE = $0012;
+ QWS_XMINIMIZE = $0014;
+ QWS_YMINIMIZE = $0016;
+
+ WM_NULL = $0000;
+ WM_CREATE = $0001;
+ WM_DESTROY = $0002;
+ WM_ENABLE = $0004;
+ WM_SHOW = $0005;
+ WM_MOVE = $0006;
+ WM_SIZE = $0007;
+ WM_ADJUSTWINDOWPOS = $0008;
+ WM_CALCVALIDRECTS = $0009;
+ WM_SETWINDOWPARAMS = $000a;
+ WM_QUERYWINDOWPARAMS = $000b;
+ WM_HITTEST = $000c;
+ WM_ACTIVATE = $000d;
+ WM_SETFOCUS = $000f;
+ WM_SETSELECTION = $0010;
+ WM_PPAINT = $0011;
+ WM_PSETFOCUS = $0012;
+ WM_PSYSCOLORCHANGE = $0013;
+ WM_PSIZE = $0014;
+ WM_PACTIVATE = $0015;
+ WM_PCONTROL = $0016;
+ WM_COMMAND = $0020;
+ WM_SYSCOMMAND = $0021;
+ WM_HELP = $0022;
+ WM_PAINT = $0023;
+ WM_TIMER = $0024;
+ WM_SEM1 = $0025;
+ WM_SEM2 = $0026;
+ WM_SEM3 = $0027;
+ WM_SEM4 = $0028;
+ WM_CLOSE = $0029;
+ WM_QUIT = $002a;
+ WM_SYSCOLORCHANGE = $002b;
+ WM_SYSVALUECHANGED = $002d;
+ WM_APPTERMINATENOTIFY = $002e;
+ WM_PRESPARAMCHANGED = $002f;
+ WM_CONTROL = $0030;
+ WM_VSCROLL = $0031;
+ WM_HSCROLL = $0032;
+ WM_INITMENU = $0033;
+ WM_MENUSELECT = $0034;
+ WM_MENUEND = $0035;
+ WM_DRAWITEM = $0036;
+ WM_MEASUREITEM = $0037;
+ WM_CONTROLPOINTER = $0038;
+ WM_QUERYDLGCODE = $003a;
+ WM_INITDLG = $003b;
+ WM_SUBSTITUTESTRING = $003c;
+ WM_MATCHMNEMONIC = $003d;
+ WM_SAVEAPPLICATION = $003e;
+ WM_HELPBASE = $0F00;
+ WM_HELPTOP = $0FFF;
+ WM_USER = $1000;
+ CMDSRC_PUSHBUTTON = 1;
+ CMDSRC_MENU = 2;
+ CMDSRC_ACCELERATOR = 3;
+ CMDSRC_FONTDLG = 4;
+ CMDSRC_FILEDLG = 5;
+ CMDSRC_PRINTDLG = 6;
+ CMDSRC_COLORDLG = 7;
+ CMDSRC_OTHER = 0;
+
+ PM_REMOVE = $0001;
+ PM_NOREMOVE = $0000;
+ RUM_IN = 1;
+ RUM_OUT = 2;
+ RUM_INOUT = 3;
+ SMD_DELAYED = $0001;
+ SMD_IMMEDIATE = $0002;
+ SSM_SYNCHRONOUS = $0001;
+ SSM_ASYNCHRONOUS = $0002;
+ SSM_MIXED = $0003;
+ CVR_ALIGNLEFT = $0001;
+ CVR_ALIGNBOTTOM = $0002;
+ CVR_ALIGNRIGHT = $0004;
+ CVR_ALIGNTOP = $0008;
+ CVR_REDRAW = $0010;
+ HT_NORMAL = 0;
+ HT_TRANSPARENT = (-1);
+ HT_DISCARD = (-2);
+ HT_ERROR = (-3);
+
+ WPM_TEXT = $0001;
+ WPM_CTLDATA = $0002;
+ WPM_PRESPARAMS = $0004;
+ WPM_CCHTEXT = $0008;
+ WPM_CBCTLDATA = $0010;
+ WPM_CBPRESPARAMS = $0020;
+
+ BMSG_POST = $0000;
+ BMSG_SEND = $0001;
+ BMSG_POSTQUEUE = $0002;
+ BMSG_DESCENDANTS = $0004;
+ BMSG_FRAMEONLY = $0008;
+
+ QS_KEY = $0001;
+ QS_MOUSEBUTTON = $0002;
+ QS_MOUSEMOVE = $0004;
+ QS_MOUSE = $0006;
+ QS_TIMER = $0008;
+ QS_PAINT = $0010;
+ QS_POSTMSG = $0020;
+ QS_SEM1 = $0040;
+ QS_SEM2 = $0080;
+ QS_SEM3 = $0100;
+ QS_SEM4 = $0200;
+ QS_SENDMSG = $0400;
+
+ SMIM_ALL = $0EFF;
+ SMI_NOINTEREST = $0001;
+ SMI_INTEREST = $0002;
+ SMI_RESET = $0004;
+ SMI_AUTODISPATCH = $0008;
+
+ FC_NOSETFOCUS = $0001;
+ FC_NOBRINGTOTOP = FC_NOSETFOCUS;
+ FC_NOLOSEFOCUS = $0002;
+ FC_NOBRINGTOPFIRSTWINDOW = FC_NOLOSEFOCUS;
+ FC_NOSETACTIVE = $0004;
+ FC_NOLOSEACTIVE = $0008;
+ FC_NOSETSELECTION = $0010;
+ FC_NOLOSESELECTION = $0020;
+ QFC_NEXTINCHAIN = $0001;
+ QFC_ACTIVE = $0002;
+ QFC_FRAME = $0003;
+ QFC_SELECTACTIVE = $0004;
+ QFC_PARTOFCHAIN = $0005;
+
+ WM_MOUSEFIRST = $0070;
+ WM_MOUSELAST = $0079;
+ WM_BUTTONCLICKFIRST = $0071;
+ WM_BUTTONCLICKLAST = $0079;
+ WM_MOUSEMOVE = $0070;
+ WM_BUTTON1DOWN = $0071;
+ WM_BUTTON1UP = $0072;
+ WM_BUTTON1DBLCLK = $0073;
+ WM_BUTTON2DOWN = $0074;
+ WM_BUTTON2UP = $0075;
+ WM_BUTTON2DBLCLK = $0076;
+ WM_BUTTON3DOWN = $0077;
+ WM_BUTTON3UP = $0078;
+ WM_BUTTON3DBLCLK = $0079;
+ WM_EXTMOUSEFIRST = $0410;
+ WM_EXTMOUSELAST = $0419;
+ WM_CHORD = $0410;
+ WM_BUTTON1MOTIONSTART = $0411;
+ WM_BUTTON1MOTIONEND = $0412;
+ WM_BUTTON1CLICK = $0413;
+ WM_BUTTON2MOTIONSTART = $0414;
+ WM_BUTTON2MOTIONEND = $0415;
+ WM_BUTTON2CLICK = $0416;
+ WM_BUTTON3MOTIONSTART = $0417;
+ WM_BUTTON3MOTIONEND = $0418;
+ WM_BUTTON3CLICK = $0419;
+ WM_MOUSETRANSLATEFIRST = $0420;
+ WM_MOUSETRANSLATELAST = $0428;
+ WM_BEGINDRAG = $0420;
+ WM_ENDDRAG = $0421;
+ WM_SINGLESELECT = $0422;
+ WM_OPEN = $0423;
+ WM_CONTEXTMENU = $0424;
+ WM_CONTEXTHELP = $0425;
+ WM_TEXTEDIT = $0426;
+ WM_BEGINSELECT = $0427;
+ WM_ENDSELECT = $0428;
+
+ WM_CHAR = $007a;
+ WM_VIOCHAR = $007b;
+ KC_NONE = $0000;
+ KC_CHAR = $0001;
+ KC_VIRTUALKEY = $0002;
+ KC_SCANCODE = $0004;
+ KC_SHIFT = $0008;
+ KC_CTRL = $0010;
+ KC_ALT = $0020;
+ KC_KEYUP = $0040;
+ KC_PREVDOWN = $0080;
+ KC_LONEKEY = $0100;
+ KC_DEADKEY = $0200;
+ KC_COMPOSITE = $0400;
+ KC_INVALIDCOMP = $0800;
+ KC_TOGGLE = $1000;
+ KC_INVALIDCHAR = $2000;
+ KC_DBCSRSRVD1 = $4000;
+ KC_DBCSRSRVD2 = $8000;
+
+ INP_NONE = $0000;
+ INP_KBD = $0001;
+ INP_MULT = $0002;
+ INP_RES2 = $0004;
+ INP_SHIFT = $0008;
+ INP_CTRL = $0010;
+ INP_ALT = $0020;
+ INP_RES3 = $0040;
+ INP_RES4 = $0080;
+ INP_IGNORE = $FFFF;
+ VK_BUTTON1 = $01;
+ VK_BUTTON2 = $02;
+ VK_BUTTON3 = $03;
+ VK_BREAK = $04;
+ VK_BACKSPACE = $05;
+ VK_TAB = $06;
+ VK_BACKTAB = $07;
+ VK_NEWLINE = $08;
+ VK_SHIFT = $09;
+ VK_CTRL = $0A;
+ VK_ALT = $0B;
+ VK_ALTGRAF = $0C;
+ VK_PAUSE = $0D;
+ VK_CAPSLOCK = $0E;
+ VK_ESC = $0F;
+ VK_SPACE = $10;
+ VK_PAGEUP = $11;
+ VK_PAGEDOWN = $12;
+ VK_END = $13;
+ VK_HOME = $14;
+ VK_LEFT = $15;
+ VK_UP = $16;
+ VK_RIGHT = $17;
+ VK_DOWN = $18;
+ VK_PRINTSCRN = $19;
+ VK_INSERT = $1A;
+ VK_DELETE = $1B;
+ VK_SCRLLOCK = $1C;
+ VK_NUMLOCK = $1D;
+ VK_ENTER = $1E;
+ VK_SYSRQ = $1F;
+ VK_F1 = $20;
+ VK_F2 = $21;
+ VK_F3 = $22;
+ VK_F4 = $23;
+ VK_F5 = $24;
+ VK_F6 = $25;
+ VK_F7 = $26;
+ VK_F8 = $27;
+ VK_F9 = $28;
+ VK_F10 = $29;
+ VK_F11 = $2A;
+ VK_F12 = $2B;
+ VK_F13 = $2C;
+ VK_F14 = $2D;
+ VK_F15 = $2E;
+ VK_F16 = $2F;
+ VK_F17 = $30;
+ VK_F18 = $31;
+ VK_F19 = $32;
+ VK_F20 = $33;
+ VK_F21 = $34;
+ VK_F22 = $35;
+ VK_F23 = $36;
+ VK_F24 = $37;
+ VK_ENDDRAG = $38;
+ VK_MENU = VK_F10;
+ VK_DBCSFIRST = $0080;
+ VK_DBCSLAST = $00ff;
+ VK_USERFIRST = $0100;
+ VK_USERLAST = $01ff;
+
+ WM_JOURNALNOTIFY = $007c;
+ JRN_QUEUESTATUS = $00000001;
+ JRN_PHYSKEYSTATE = $00000002;
+
+ DID_OK = 1;
+ DID_CANCEL = 2;
+ DID_ERROR = $ffff;
+
+ WA_WARNING = 0;
+ WA_NOTE = 1;
+ WA_ERROR = 2;
+ WA_CWINALARMS = 3;
+
+ MB_OK = $0000;
+ MB_OKCANCEL = $0001;
+ MB_RETRYCANCEL = $0002;
+ MB_ABORTRETRYIGNORE = $0003;
+ MB_YESNO = $0004;
+ MB_YESNOCANCEL = $0005;
+ MB_CANCEL = $0006;
+ MB_ENTER = $0007;
+ MB_ENTERCANCEL = $0008;
+ MB_NOICON = $0000;
+ MB_CUANOTIFICATION = $0000;
+ MB_ICONQUESTION = $0010;
+ MB_ICONEXCLAMATION = $0020;
+ MB_CUAWARNING = $0020;
+ MB_ICONASTERISK = $0030;
+ MB_ICONHAND = $0040;
+ MB_CUACRITICAL = $0040;
+ MB_QUERY = MB_ICONQUESTION;
+ MB_WARNING = MB_CUAWARNING;
+ MB_INFORMATION = MB_ICONASTERISK;
+ MB_CRITICAL = MB_CUACRITICAL;
+ MB_ERROR = MB_CRITICAL;
+ MB_DEFBUTTON1 = $0000;
+ MB_DEFBUTTON2 = $0100;
+ MB_DEFBUTTON3 = $0200;
+ MB_APPLMODAL = $0000;
+ MB_SYSTEMMODAL = $1000;
+ MB_HELP = $2000;
+ MB_MOVEABLE = $4000;
+ MBID_OK = 1;
+ MBID_CANCEL = 2;
+ MBID_ABORT = 3;
+ MBID_RETRY = 4;
+ MBID_IGNORE = 5;
+ MBID_YES = 6;
+ MBID_NO = 7;
+ MBID_HELP = 8;
+ MBID_ENTER = 9;
+ MBID_ERROR = $ffff;
+ DLGC_ENTRYFIELD = $0001;
+ DLGC_BUTTON = $0002;
+ DLGC_RADIOBUTTON = $0004;
+ DLGC_STATIC = $0008;
+ DLGC_DEFAULT = $0010;
+ DLGC_PUSHBUTTON = $0020;
+ DLGC_CHECKBOX = $0040;
+ DLGC_SCROLLBAR = $0080;
+ DLGC_MENU = $0100;
+ DLGC_TABONCLICK = $0200;
+ DLGC_MLE = $0400;
+
+ EDI_FIRSTTABITEM = 0;
+ EDI_LASTTABITEM = 1;
+ EDI_NEXTTABITEM = 2;
+ EDI_PREVTABITEM = 3;
+ EDI_FIRSTGROUPITEM = 4;
+ EDI_LASTGROUPITEM = 5;
+ EDI_NEXTGROUPITEM = 6;
+ EDI_PREVGROUPITEM = 7;
+
+ SS_TEXT = $0001;
+ SS_GROUPBOX = $0002;
+ SS_ICON = $0003;
+ SS_BITMAP = $0004;
+ SS_FGNDRECT = $0005;
+ SS_HALFTONERECT = $0006;
+ SS_BKGNDRECT = $0007;
+ SS_FGNDFRAME = $0008;
+ SS_HALFTONEFRAME = $0009;
+ SS_BKGNDFRAME = $000a;
+ SS_SYSICON = $000b;
+ SS_AUTOSIZE = $0040;
+ SM_SETHANDLE = $0100;
+ SM_QUERYHANDLE = $0101;
+ BS_PUSHBUTTON = 0;
+ BS_CHECKBOX = 1;
+ BS_AUTOCHECKBOX = 2;
+ BS_RADIOBUTTON = 3;
+ BS_AUTORADIOBUTTON = 4;
+ BS_3STATE = 5;
+ BS_AUTO3STATE = 6;
+ BS_USERBUTTON = 7;
+ BS_PRIMARYSTYLES = $000f;
+ BS_BITMAP = $0040;
+ BS_ICON = $0080;
+ BS_HELP = $0100;
+ BS_SYSCOMMAND = $0200;
+ BS_DEFAULT = $0400;
+ BS_NOPOINTERFOCUS = $0800;
+ BS_NOBORDER = $1000;
+ BS_NOCURSORSELECT = $2000;
+ BS_AUTOSIZE = $4000;
+
+ BM_CLICK = $0120;
+ BM_QUERYCHECKINDEX = $0121;
+ BM_QUERYHILITE = $0122;
+ BM_SETHILITE = $0123;
+ BM_QUERYCHECK = $0124;
+ BM_SETCHECK = $0125;
+ BM_SETDEFAULT = $0126;
+ BN_CLICKED = 1;
+ BN_DBLCLICKED = 2;
+ BN_PAINT = 3;
+ BDS_HILITED = $0100;
+ BDS_DISABLED = $0200;
+ BDS_DEFAULT = $0400;
+ ES_LEFT = $00000000;
+ ES_CENTER = $00000001;
+ ES_RIGHT = $00000002;
+ ES_AUTOSCROLL = $00000004;
+ ES_MARGIN = $00000008;
+ ES_AUTOTAB = $00000010;
+ ES_READONLY = $00000020;
+ ES_COMMAND = $00000040;
+ ES_UNREADABLE = $00000080;
+ ES_AUTOSIZE = $00000200;
+ ES_ANY = $00000000;
+ ES_SBCS = $00001000;
+ ES_DBCS = $00002000;
+ ES_MIXED = $00003000;
+ CBS_SIMPLE = $0001;
+ CBS_DROPDOWN = $0002;
+ CBS_DROPDOWNLIST = $0004;
+ CBS_COMPATIBLE = $0008;
+ CBID_LIST = $029A;
+ CBID_EDIT = $029B;
+ CBM_SHOWLIST = $0170;
+ CBM_HILITE = $0171;
+ CBM_ISLISTSHOWING = $0172;
+ CBN_EFCHANGE = 1;
+ CBN_EFSCROLL = 2;
+ CBN_MEMERROR = 3;
+ CBN_LBSELECT = 4;
+ CBN_LBSCROLL = 5;
+ CBN_SHOWLIST = 6;
+ CBN_ENTER = 7;
+
+ EM_QUERYCHANGED = $0140;
+ EM_QUERYSEL = $0141;
+ EM_SETSEL = $0142;
+ EM_SETTEXTLIMIT = $0143;
+ EM_CUT = $0144;
+ EM_COPY = $0145;
+ EM_CLEAR = $0146;
+ EM_PASTE = $0147;
+ EM_QUERYFIRSTCHAR = $0148;
+ EM_SETFIRSTCHAR = $0149;
+ EM_QUERYREADONLY = $014a;
+ EM_SETREADONLY = $014b;
+ EM_SETINSERTMODE = $014c;
+ EN_SETFOCUS = $0001;
+ EN_KILLFOCUS = $0002;
+ EN_CHANGE = $0004;
+ EN_SCROLL = $0008;
+ EN_MEMERROR = $0010;
+ EN_OVERFLOW = $0020;
+ EN_INSERTMODETOGGLE = $0040;
+ LS_MULTIPLESEL = $00000001;
+ LS_OWNERDRAW = $00000002;
+ LS_NOADJUSTPOS = $00000004;
+ LS_HORZSCROLL = $00000008;
+ LS_EXTENDEDSEL = $00000010;
+ LN_SELECT = 1;
+ LN_SETFOCUS = 2;
+ LN_KILLFOCUS = 3;
+ LN_SCROLL = 4;
+ LN_ENTER = 5;
+ LM_QUERYITEMCOUNT = $0160;
+ LM_INSERTITEM = $0161;
+ LM_SETTOPINDEX = $0162;
+ LM_DELETEITEM = $0163;
+ LM_SELECTITEM = $0164;
+ LM_QUERYSELECTION = $0165;
+ LM_SETITEMTEXT = $0166;
+ LM_QUERYITEMTEXTLENGTH = $0167;
+ LM_QUERYITEMTEXT = $0168;
+ LM_SETITEMHANDLE = $0169;
+ LM_QUERYITEMHANDLE = $016a;
+ LM_SEARCHSTRING = $016b;
+ LM_SETITEMHEIGHT = $016c;
+ LM_QUERYTOPINDEX = $016d;
+ LM_DELETEALL = $016e;
+ LIT_CURSOR = (-4);
+ LIT_ERROR = (-3);
+ LIT_MEMERROR = (-2);
+ LIT_NONE = (-1);
+ LIT_FIRST = (-1);
+ LIT_END = (-1);
+ LIT_SORTASCENDING = (-2);
+ LIT_SORTDESCENDING = (-3);
+ LSS_SUBSTRING = $0001;
+ LSS_PREFIX = $0002;
+ LSS_CASESENSITIVE = $0004;
+ MS_ACTIONBAR = $00000001;
+ MS_TITLEBUTTON = $00000002;
+ MS_VERTICALFLIP = $00000004;
+ MS_CONDITIONALCASCADE = $00000040;
+
+// Menu control messages
+ MM_INSERTITEM = $0180;
+ MM_DELETEITEM = $0181;
+ MM_QUERYITEM = $0182;
+ MM_SETITEM = $0183;
+ MM_QUERYITEMCOUNT = $0184;
+ MM_STARTMENUMODE = $0185;
+ MM_ENDMENUMODE = $0186;
+ MM_REMOVEITEM = $0188;
+ MM_SELECTITEM = $0189;
+ MM_QUERYSELITEMID = $018a;
+ MM_QUERYITEMTEXT = $018b;
+ MM_QUERYITEMTEXTLENGTH = $018c;
+ MM_SETITEMHANDLE = $018d;
+ MM_SETITEMTEXT = $018e;
+ MM_ITEMPOSITIONFROMID = $018f;
+ MM_ITEMIDFROMPOSITION = $0190;
+ MM_QUERYITEMATTR = $0191;
+ MM_SETITEMATTR = $0192;
+ MM_ISITEMVALID = $0193;
+ MM_QUERYITEMRECT = $0194;
+ MM_DELETEITEMBYPOS = $01f1; //UNDOCUMENTED
+ MM_QUERYDEFAULTITEMID = $0431;
+ MM_SETDEFAULTITEMID = $0432;
+
+ MIT_END = (-1);
+ MIT_NONE = (-1);
+ MIT_MEMERROR = (-1);
+ MIT_ERROR = (-1);
+ MIT_FIRST = (-2);
+ MIT_LAST = (-3);
+ MID_NONE = MIT_NONE;
+ MID_ERROR = (-1);
+ MIS_TEXT = $0001;
+ MIS_BITMAP = $0002;
+ MIS_SEPARATOR = $0004;
+ MIS_OWNERDRAW = $0008;
+ MIS_SUBMENU = $0010;
+ MIS_MULTMENU = $0020;
+ MIS_SYSCOMMAND = $0040;
+ MIS_HELP = $0080;
+ MIS_STATIC = $0100;
+ MIS_BUTTONSEPARATOR = $0200;
+ MIS_BREAK = $0400;
+ MIS_BREAKSEPARATOR = $0800;
+ MIS_GROUP = $1000;
+ MIS_SINGLE = $2000;
+ MIA_NODISMISS = $0020;
+ MIA_FRAMED = $1000;
+ MIA_CHECKED = $2000;
+ MIA_DISABLED = $4000;
+ MIA_HILITED = $8000;
+
+ PU_POSITIONONITEM = $0001;
+ PU_HCONSTRAIN = $0002;
+ PU_VCONSTRAIN = $0004;
+ PU_NONE = $0000;
+ PU_MOUSEBUTTON1DOWN = $0008;
+ PU_MOUSEBUTTON2DOWN = $0010;
+ PU_MOUSEBUTTON3DOWN = $0018;
+ PU_SELECTITEM = $0020;
+ PU_MOUSEBUTTON1 = $0040;
+ PU_MOUSEBUTTON2 = $0080;
+ PU_MOUSEBUTTON3 = $0100;
+ PU_KEYBOARD = $0200;
+ SBS_HORZ = 0;
+ SBS_VERT = 1;
+ SBS_THUMBSIZE = 2;
+ SBS_AUTOTRACK = 4;
+ SBS_AUTOSIZE = $2000;
+ SBM_SETSCROLLBAR = $01a0;
+ SBM_SETPOS = $01a1;
+ SBM_QUERYPOS = $01a2;
+ SBM_QUERYRANGE = $01a3;
+ SBM_SETTHUMBSIZE = $01a6;
+ SB_LINEUP = 1;
+ SB_LINEDOWN = 2;
+ SB_LINELEFT = 1;
+ SB_LINERIGHT = 2;
+ SB_PAGEUP = 3;
+ SB_PAGEDOWN = 4;
+ SB_PAGELEFT = 3;
+ SB_PAGERIGHT = 4;
+ SB_SLIDERTRACK = 5;
+ SB_SLIDERPOSITION = 6;
+ SB_ENDSCROLL = 7;
+
+ FCF_TITLEBAR = $00000001;
+ FCF_SYSMENU = $00000002;
+ FCF_MENU = $00000004;
+ FCF_SIZEBORDER = $00000008;
+ FCF_MINBUTTON = $00000010;
+ FCF_MAXBUTTON = $00000020;
+ FCF_MINMAX = $00000030;
+ FCF_VERTSCROLL = $00000040;
+ FCF_HORZSCROLL = $00000080;
+ FCF_DLGBORDER = $00000100;
+ FCF_BORDER = $00000200;
+ FCF_SHELLPOSITION = $00000400;
+ FCF_TASKLIST = $00000800;
+ FCF_NOBYTEALIGN = $00001000;
+ FCF_NOMOVEWITHOWNER = $00002000;
+ FCF_ICON = $00004000;
+ FCF_ACCELTABLE = $00008000;
+ FCF_SYSMODAL = $00010000;
+ FCF_SCREENALIGN = $00020000;
+ FCF_MOUSEALIGN = $00040000;
+ FCF_HIDEBUTTON = $01000000;
+ FCF_HIDEMAX = $01000020;
+ FCF_DBE_APPSTAT = $80000000;
+ FCF_AUTOICON = $40000000;
+ FCF_STANDARD = $0000CC3F;
+ FS_ICON = $00000001;
+ FS_ACCELTABLE = $00000002;
+ FS_SHELLPOSITION = $00000004;
+ FS_TASKLIST = $00000008;
+ FS_NOBYTEALIGN = $00000010;
+ FS_NOMOVEWITHOWNER = $00000020;
+ FS_SYSMODAL = $00000040;
+ FS_DLGBORDER = $00000080;
+ FS_BORDER = $00000100;
+ FS_SCREENALIGN = $00000200;
+ FS_MOUSEALIGN = $00000400;
+ FS_SIZEBORDER = $00000800;
+ FS_AUTOICON = $00001000;
+ FS_DBE_APPSTAT = $00008000;
+ FS_STANDARD = $0000000F;
+ FF_FLASHWINDOW = $0001;
+ FF_ACTIVE = $0002;
+ FF_FLASHHILITE = $0004;
+ FF_OWNERHIDDEN = $0008;
+ FF_DLGDISMISSED = $0010;
+ FF_OWNERDISABLED = $0020;
+ FF_SELECTED = $0040;
+ FF_NOACTIVATESWP = $0080;
+
+ WM_FLASHWINDOW = $0040;
+ WM_FORMATFRAME = $0041;
+ WM_UPDATEFRAME = $0042;
+ WM_FOCUSCHANGE = $0043;
+ WM_SETBORDERSIZE = $0044;
+ WM_TRACKFRAME = $0045;
+ WM_MINMAXFRAME = $0046;
+ WM_SETICON = $0047;
+ WM_QUERYICON = $0048;
+ WM_SETACCELTABLE = $0049;
+ WM_QUERYACCELTABLE = $004a;
+ WM_TRANSLATEACCEL = $004b;
+ WM_QUERYTRACKINFO = $004c;
+ WM_QUERYBORDERSIZE = $004d;
+ WM_NEXTMENU = $004e;
+ WM_ERASEBACKGROUND = $004f;
+ WM_QUERYFRAMEINFO = $0050;
+ WM_QUERYFOCUSCHAIN = $0051;
+ WM_OWNERPOSCHANGE = $0052;
+ WM_CALCFRAMERECT = $0053;
+ WM_WINDOWPOSCHANGED = $0055;
+ WM_ADJUSTFRAMEPOS = $0056;
+ WM_QUERYFRAMECTLCOUNT = $0059;
+ WM_QUERYHELPINFO = $005B;
+ WM_SETHELPINFO = $005C;
+ WM_ERROR = $005D;
+ WM_REALIZEPALETTE = $005E;
+ FI_FRAME = $00000001;
+ FI_OWNERHIDE = $00000002;
+ FI_ACTIVATEOK = $00000004;
+ FI_NOMOVEWITHOWNER = $00000008;
+
+ FID_SYSMENU = $8002;
+ FID_TITLEBAR = $8003;
+ FID_MINMAX = $8004;
+ FID_MENU = $8005;
+ FID_VERTSCROLL = $8006;
+ FID_HORZSCROLL = $8007;
+ FID_CLIENT = $8008;
+ FID_DBE_APPSTAT = $8010;
+ FID_DBE_KBDSTAT = $8011;
+ FID_DBE_PECIC = $8012;
+ FID_DBE_KKPOPUP = $8013;
+ SC_SIZE = $8000;
+ SC_MOVE = $8001;
+ SC_MINIMIZE = $8002;
+ SC_MAXIMIZE = $8003;
+ SC_CLOSE = $8004;
+ SC_NEXT = $8005;
+ SC_APPMENU = $8006;
+ SC_SYSMENU = $8007;
+ SC_RESTORE = $8008;
+ SC_NEXTFRAME = $8009;
+ SC_NEXTWINDOW = $8010;
+ SC_TASKMANAGER = $8011;
+ SC_HELPKEYS = $8012;
+ SC_HELPINDEX = $8013;
+ SC_HELPEXTENDED = $8014;
+ SC_SWITCHPANELIDS = $8015;
+ SC_DBE_FIRST = $8018;
+ SC_DBE_LAST = $801F;
+ SC_BEGINDRAG = $8020;
+ SC_ENDDRAG = $8021;
+ SC_SELECT = $8022;
+ SC_OPEN = $8023;
+ SC_CONTEXTMENU = $8024;
+ SC_CONTEXTHELP = $8025;
+ SC_TEXTEDIT = $8026;
+ SC_BEGINSELECT = $8027;
+ SC_ENDSELECT = $8028;
+ SC_WINDOW = $8029;
+ SC_HIDE = $802a;
+ TBM_SETHILITE = $01e3;
+ TBM_QUERYHILITE = $01e4;
+
+ SV_SWAPBUTTON = 0;
+ SV_DBLCLKTIME = 1;
+ SV_CXDBLCLK = 2;
+ SV_CYDBLCLK = 3;
+ SV_CXSIZEBORDER = 4;
+ SV_CYSIZEBORDER = 5;
+ SV_ALARM = 6;
+ SV_RESERVEDFIRST1 = 7;
+ SV_RESERVEDLAST1 = 8;
+ SV_CURSORRATE = 9;
+ SV_FIRSTSCROLLRATE = 10;
+ SV_SCROLLRATE = 11;
+ SV_NUMBEREDLISTS = 12;
+ SV_WARNINGFREQ = 13;
+ SV_NOTEFREQ = 14;
+ SV_ERRORFREQ = 15;
+ SV_WARNINGDURATION = 16;
+ SV_NOTEDURATION = 17;
+ SV_ERRORDURATION = 18;
+ SV_RESERVEDFIRST = 19;
+ SV_RESERVEDLAST = 19;
+ SV_CXSCREEN = 20;
+ SV_CYSCREEN = 21;
+ SV_CXVSCROLL = 22;
+ SV_CYHSCROLL = 23;
+ SV_CYVSCROLLARROW = 24;
+ SV_CXHSCROLLARROW = 25;
+ SV_CXBORDER = 26;
+ SV_CYBORDER = 27;
+ SV_CXDLGFRAME = 28;
+ SV_CYDLGFRAME = 29;
+ SV_CYTITLEBAR = 30;
+ SV_CYVSLIDER = 31;
+ SV_CXHSLIDER = 32;
+ SV_CXMINMAXBUTTON = 33;
+ SV_CYMINMAXBUTTON = 34;
+ SV_CYMENU = 35;
+ SV_CXFULLSCREEN = 36;
+ SV_CYFULLSCREEN = 37;
+ SV_CXICON = 38;
+ SV_CYICON = 39;
+ SV_CXPOINTER = 40;
+ SV_CYPOINTER = 41;
+ SV_DEBUG = 42;
+ SV_CMOUSEBUTTONS = 43;
+ SV_CPOINTERBUTTONS = 43;
+ SV_POINTERLEVEL = 44;
+ SV_CURSORLEVEL = 45;
+ SV_TRACKRectlEVEL = 46;
+ SV_CTIMERS = 47;
+ SV_MOUSEPRESENT = 48;
+ SV_CXBYTEALIGN = 49;
+ SV_CXALIGN = 49;
+ SV_CYBYTEALIGN = 50;
+ SV_CYALIGN = 50;
+ SV_NOTRESERVED = 56;
+ SV_EXTRAKEYBEEP = 57;
+ SV_SETLIGHTS = 58;
+ SV_INSERTMODE = 59;
+ SV_MENUROLLDOWNDELAY = 64;
+ SV_MENUROLLUPDELAY = 65;
+ SV_ALTMNEMONIC = 66;
+ SV_TASKLISTMOUSEACCESS = 67;
+ SV_CXICONTEXTWIDTH = 68;
+ SV_CICONTEXTLINES = 69;
+ SV_CHORDTIME = 70;
+ SV_CXCHORD = 71;
+ SV_CYCHORD = 72;
+ SV_CXMOTION = 73;
+ SV_CYMOTION = 74;
+ SV_BEGINDRAG = 75;
+ SV_ENDDRAG = 76;
+ SV_SINGLESELECT = 77;
+ SV_OPEN = 78;
+ SV_CONTEXTMENU = 79;
+ SV_CONTEXTHELP = 80;
+ SV_TEXTEDIT = 81;
+ SV_BEGINSELECT = 82;
+ SV_ENDSELECT = 83;
+ SV_BEGINDRAGKB = 84;
+ SV_ENDDRAGKB = 85;
+ SV_SELECTKB = 86;
+ SV_OPENKB = 87;
+ SV_CONTEXTMENUKB = 88;
+ SV_CONTEXTHELPKB = 89;
+ SV_TEXTEDITKB = 90;
+ SV_BEGINSELECTKB = 91;
+ SV_ENDSELECTKB = 92;
+ SV_ANIMATION = 93;
+ SV_ANIMATIONSPEED = 94;
+ SV_MONOICONS = 95;
+ SV_KBDALTERED = 96;
+ SV_PRINTSCREEN = 97;
+ SV_CSYSVALUES = 98;
+
+ PP_FOREGROUNDCOLOR = 1;
+ PP_FOREGROUNDCOLORINDEX = 2;
+ PP_BACKGROUNDCOLOR = 3;
+ PP_BACKGROUNDCOLORINDEX = 4;
+ PP_HILITEFOREGROUNDCOLOR = 5;
+ PP_HILITEFOREGROUNDCOLORINDEX = 6;
+ PP_HILITEBACKGROUNDCOLOR = 7;
+ PP_HILITEBACKGROUNDCOLORINDEX = 8;
+ PP_DISABLEDFOREGROUNDCOLOR = 9;
+ PP_DISABLEDFOREGROUNDCOLORINDEX = 10;
+ PP_DISABLEDBACKGROUNDCOLOR = 11;
+ PP_DISABLEDBACKGROUNDCOLORINDEX = 12;
+ PP_BORDERCOLOR = 13;
+ PP_BORDERCOLORINDEX = 14;
+ PP_FONTNAMESIZE = 15;
+ PP_FONTHANDLE = 16;
+ PP_RESERVED = 17;
+ PP_ACTIVECOLOR = 18;
+ PP_ACTIVECOLORINDEX = 19;
+ PP_INACTIVECOLOR = 20;
+ PP_INACTIVECOLORINDEX = 21;
+ PP_ACTIVETEXTFGNDCOLOR = 22;
+ PP_ACTIVETEXTFGNDCOLORINDEX = 23;
+ PP_ACTIVETEXTBGNDCOLOR = 24;
+ PP_ACTIVETEXTBGNDCOLORINDEX = 25;
+ PP_INACTIVETEXTFGNDCOLOR = 26;
+ PP_INACTIVETEXTFGNDCOLORINDEX = 27;
+ PP_INACTIVETEXTBGNDCOLOR = 28;
+ PP_INACTIVETEXTBGNDCOLORINDEX = 29;
+ PP_SHADOW = 30;
+ PP_MENUFOREGROUNDCOLOR = 31;
+ PP_MENUFOREGROUNDCOLORINDEX = 32;
+ PP_MENUBACKGROUNDCOLOR = 33;
+ PP_MENUBACKGROUNDCOLORINDEX = 34;
+ PP_MENUHILITEFGNDCOLOR = 35;
+ PP_MENUHILITEFGNDCOLORINDEX = 36;
+ PP_MENUHILITEBGNDCOLOR = 37;
+ PP_MENUHILITEBGNDCOLORINDEX = 38;
+ PP_MENUDISABLEDFGNDCOLOR = 39;
+ PP_MENUDISABLEDFGNDCOLORINDEX = 40;
+ PP_MENUDISABLEDBGNDCOLOR = 41;
+ PP_MENUDISABLEDBGNDCOLORINDEX = 42;
+ PP_USER = $8000;
+ QPF_NOINHERIT = $0001;
+ QPF_ID1COLORINDEX = $0002;
+ QPF_ID2COLORINDEX = $0004;
+ QPF_PURERGBCOLOR = $0008;
+ QPF_VALIDFLAGS = $000F;
+
+ SYSCLR_SHADOWHILITEBGND = (-50);
+ SYSCLR_SHADOWHILITEFGND = (-49);
+ SYSCLR_SHADOWTEXT = (-48);
+ SYSCLR_ENTRYFIELD = (-47);
+ SYSCLR_MENUDISABLEDTEXT = (-46);
+ SYSCLR_MENUHILITE = (-45);
+ SYSCLR_MENUHILITEBGND = (-44);
+ SYSCLR_PAGEBACKGROUND = (-43);
+ SYSCLR_FIELDBACKGROUND = (-42);
+ SYSCLR_BUTTONLIGHT = (-41);
+ SYSCLR_BUTTONMIDDLE = (-40);
+ SYSCLR_BUTTONDARK = (-39);
+ SYSCLR_BUTTONDEFAULT = (-38);
+ SYSCLR_TITLEBOTTOM = (-37);
+ SYSCLR_SHADOW = (-36);
+ SYSCLR_ICONTEXT = (-35);
+ SYSCLR_DIALOGBACKGROUND = (-34);
+ SYSCLR_HILITEFOREGROUND = (-33);
+ SYSCLR_HILITEBACKGROUND = (-32);
+ SYSCLR_INACTIVETITLETEXTBGND = (-31);
+ SYSCLR_ACTIVETITLETEXTBGND = (-30);
+ SYSCLR_INACTIVETITLETEXT = (-29);
+ SYSCLR_ACTIVETITLETEXT = (-28);
+ SYSCLR_OUTPUTTEXT = (-27);
+ SYSCLR_WINDOWSTATICTEXT = (-26);
+ SYSCLR_SCROLLBAR = (-25);
+ SYSCLR_BACKGROUND = (-24);
+ SYSCLR_ACTIVETITLE = (-23);
+ SYSCLR_INACTIVETITLE = (-22);
+ SYSCLR_MENU = (-21);
+ SYSCLR_WINDOW = (-20);
+ SYSCLR_WINDOWFRAME = (-19);
+ SYSCLR_MENUTEXT = (-18);
+ SYSCLR_WINDOWTEXT = (-17);
+ SYSCLR_TITLETEXT = (-16);
+ SYSCLR_ACTIVEBORDER = (-15);
+ SYSCLR_INACTIVEBORDER = (-14);
+ SYSCLR_APPWORKSPACE = (-13);
+ SYSCLR_HELPBACKGROUND = (-12);
+ SYSCLR_HELPTEXT = (-11);
+ SYSCLR_HELPHILITE = (-10);
+ SYSCLR_CSYSCOLORS = 41;
+
+ TID_CURSOR = $ffff;
+ TID_SCROLL = $fffe;
+ TID_FLASHWINDOW = $fffd;
+ TID_USERMAX = $7fff;
+
+ AF_CHAR = $0001;
+ AF_VIRTUALKEY = $0002;
+ AF_SCANCODE = $0004;
+ AF_SHIFT = $0008;
+ AF_CONTROL = $0010;
+ AF_ALT = $0020;
+ AF_LONEKEY = $0040;
+ AF_SYSCOMMAND = $0100;
+ AF_HELP = $0200;
+
+ EAF_DEFAULTOWNER = $0001;
+ EAF_UNCHANGEABLE = $0002;
+ EAF_REUSEICON = $0004;
+
+ TF_LEFT = $0001;
+ TF_TOP = $0002;
+ TF_RIGHT = $0004;
+ TF_BOTTOM = $0008;
+ TF_MOVE = $000F;
+ TF_SETPOINTERPOS = $0010;
+ TF_GRID = $0020;
+ TF_STANDARD = $0040;
+ TF_ALLINBOUNDARY = $0080;
+ TF_VALIDATETRACKRECT = $0100;
+ TF_PARTINBOUNDARY = $0200;
+ WM_RENDERFMT = $0060;
+ WM_RENDERALLFMTS = $0061;
+ WM_DESTROYCLIPBOARD = $0062;
+ WM_PAINTCLIPBOARD = $0063;
+ WM_SIZECLIPBOARD = $0064;
+ WM_HSCROLLCLIPBOARD = $0065;
+ WM_VSCROLLCLIPBOARD = $0066;
+ WM_DRAWCLIPBOARD = $0067;
+ CF_TEXT = 1;
+ CF_BITMAP = 2;
+ CF_DSPTEXT = 3;
+ CF_DSPBITMAP = 4;
+ CF_METAFILE = 5;
+ CF_DSPMETAFILE = 6;
+ CF_PALETTE = 9;
+ SZFMT_TEXT = '#1';
+ SZFMT_BITMAP = '#2';
+ SZFMT_DSPTEXT = '#3';
+ SZFMT_DSPBITMAP = '#4';
+ SZFMT_METAFILE = '#5';
+ SZFMT_DSPMETAFILE = '#6';
+ SZFMT_PALETTE = '#9';
+ SZFMT_SYLK = 'Sylk';
+ SZFMT_DIF = 'Dif';
+ SZFMT_TIFF = 'Tiff';
+ SZFMT_OEMTEXT = 'OemText';
+ SZFMT_DIB = 'Dib';
+ SZFMT_OWNERDISPLAY = 'OwnerDisplay';
+ SZFMT_LINK = 'Link';
+ SZFMT_METAFILEPICT = 'MetaFilePict';
+ SZFMT_DSPMETAFILEPICT = 'DspMetaFilePict';
+ SZFMT_CPTEXT = 'Codepage Text';
+ SZDDEFMT_RTF = 'Rich Text Format';
+ SZDDEFMT_PTRPICT = 'Printer_Picture';
+
+ CFI_OWNERFREE = $0001;
+ CFI_OWNERDISPLAY = $0002;
+ CFI_POINTER = $0400;
+ CFI_HANDLE = $0200;
+
+ CURSOR_SOLID = $0000;
+ CURSOR_HALFTONE = $0001;
+ CURSOR_FRAME = $0002;
+ CURSOR_FLASH = $0004;
+ CURSOR_SETPOS = $8000;
+
+ SPTR_ARROW = 1;
+ SPTR_TEXT = 2;
+ SPTR_WAIT = 3;
+ SPTR_SIZE = 4;
+ SPTR_MOVE = 5;
+ SPTR_SIZENWSE = 6;
+ SPTR_SIZENESW = 7;
+ SPTR_SIZEWE = 8;
+ SPTR_SIZENS = 9;
+ SPTR_APPICON = 10;
+ SPTR_ICONINFORMATION = 11;
+ SPTR_ICONQUESTION = 12;
+ SPTR_ICONERROR = 13;
+ SPTR_ICONWARNING = 14;
+ SPTR_CPTR = 14;
+ SPTR_ILLEGAL = 18;
+ SPTR_FILE = 19;
+ SPTR_FOLDER = 20;
+ SPTR_MULTFILE = 21;
+ SPTR_PROGRAM = 22;
+ SPTR_HANDICON = SPTR_ICONERROR;
+ SPTR_QUESICON = SPTR_ICONQUESTION;
+ SPTR_BANGICON = SPTR_ICONWARNING;
+ SPTR_NOTEICON = SPTR_ICONINFORMATION;
+
+ DP_NORMAL = $0000;
+ DP_HALFTONED = $0001;
+ DP_INVERTED = $0002;
+
+ SBMP_OLD_SYSMENU = 1;
+ SBMP_OLD_SBUPARROW = 2;
+ SBMP_OLD_SBDNARROW = 3;
+ SBMP_OLD_SBRGARROW = 4;
+ SBMP_OLD_SBLFARROW = 5;
+ SBMP_MENUCHECK = 6;
+ SBMP_OLD_CHECKBOXES = 7;
+ SBMP_BTNCORNERS = 8;
+ SBMP_OLD_MINBUTTON = 9;
+ SBMP_OLD_MAXBUTTON = 10;
+ SBMP_OLD_RESTOREBUTTON = 11;
+ SBMP_OLD_CHILDSYSMENU = 12;
+ SBMP_DRIVE = 15;
+ SBMP_FILE = 16;
+ SBMP_FOLDER = 17;
+ SBMP_TREEPLUS = 18;
+ SBMP_TREEMINUS = 19;
+ SBMP_PROGRAM = 22;
+ SBMP_MENUATTACHED = 23;
+ SBMP_SIZEBOX = 24;
+ SBMP_SYSMENU = 25;
+ SBMP_MINBUTTON = 26;
+ SBMP_MAXBUTTON = 27;
+ SBMP_RESTOREBUTTON = 28;
+ SBMP_CHILDSYSMENU = 29;
+ SBMP_SYSMENUDEP = 30;
+ SBMP_MINBUTTONDEP = 31;
+ SBMP_MAXBUTTONDEP = 32;
+ SBMP_RESTOREBUTTONDEP = 33;
+ SBMP_CHILDSYSMENUDEP = 34;
+ SBMP_SBUPARROW = 35;
+ SBMP_SBDNARROW = 36;
+ SBMP_SBLFARROW = 37;
+ SBMP_SBRGARROW = 38;
+ SBMP_SBUPARROWDEP = 39;
+ SBMP_SBDNARROWDEP = 40;
+ SBMP_SBLFARROWDEP = 41;
+ SBMP_SBRGARROWDEP = 42;
+ SBMP_SBUPARROWDIS = 43;
+ SBMP_SBDNARROWDIS = 44;
+ SBMP_SBLFARROWDIS = 45;
+ SBMP_SBRGARROWDIS = 46;
+ SBMP_COMBODOWN = 47;
+ SBMP_CHECKBOXES = 48;
+
+ HK_SENDMSG = 0;
+ HK_INPUT = 1;
+ HK_MSGFILTER = 2;
+ HK_JOURNALRECORD = 3;
+ HK_JOURNALPLAYBACK = 4;
+ HK_HELP = 5;
+ HK_LOADER = 6;
+ HK_REGISTERUSERMSG = 7;
+ HK_MSGCONTROL = 8;
+ HK_PLIST_ENTRY = 9;
+ HK_PLIST_EXIT = 10;
+ HK_FINDWORD = 11;
+ HK_CODEPAGECHANGED = 12;
+ HK_WINDOWDC = 15;
+ HK_DESTROYWINDOW = 16;
+ HK_CHECKMSGFILTER = 20;
+ HMQ_CURRENT = 1;
+ MSGF_DIALOGBOX = 1;
+ MSGF_MESSAGEBOX = 2;
+ MSGF_TRACK = 8;
+ MSGF_DDEPOSTMSG = 3;
+ HLPM_FRAME = (-1);
+ HLPM_WINDOW = (-2);
+ HLPM_MENU = (-3);
+ PM_MODEL_1X = 0;
+ PM_MODEL_2X = 1;
+
+ LHK_DELETEPROC = 1;
+ LHK_DELETELIB = 2;
+ LHK_LOADPROC = 3;
+ LHK_LOADLIB = 4;
+ MCHK_MSGINTEREST = 1;
+ MCHK_CLASSMSGINTEREST = 2;
+ MCHK_SYNCHRONISATION = 3;
+ MCHK_MSGMODE = 4;
+ RUMHK_DATATYPE = 1;
+ RUMHK_MSG = 2;
+
+ {WinCompareStrings}
+ WCS_ERROR = 0;
+ WCS_EQ = 1;
+ WCS_LT = 2;
+ WCS_GT = 3;
+
+ WINDBG_HWND_NOT_DESTROYED = $1022;
+ WINDBG_HPTR_NOT_DESTROYED = $1023;
+ WINDBG_HACCEL_NOT_DESTROYED = $1024;
+ WINDBG_HENUM_NOT_DESTROYED = $1025;
+ WINDBG_VISRGN_SEM_BUSY = $1026;
+ WINDBG_USER_SEM_BUSY = $1027;
+ WINDBG_DC_CACHE_BUSY = $1028;
+ WINDBG_HOOK_STILL_INSTALLED = $1029;
+ WINDBG_WINDOW_STILL_LOCKED = $102a;
+ WINDBG_UPDATEPS_ASSERTION_FAIL = $102b;
+ WINDBG_SENDMSG_WITHIN_USER_SEM = $102c;
+ WINDBG_USER_SEM_NOT_ENTERED = $102d;
+ WINDBG_PROC_NOT_EXPORTED = $102e;
+ WINDBG_BAD_SENDMSG_cardinal = $102f;
+ WINDBG_ABNORMAL_EXIT = $1030;
+ WINDBG_INTERNAL_REVISION = $1031;
+ WINDBG_INITSYSTEM_FAILED = $1032;
+ WINDBG_HATOMTBL_NOT_DESTROYED = $1033;
+ WINDBG_WINDOW_UNLOCK_WAIT = $1035;
+
+ SZDDESYS_TOPIC = 'System';
+ SZDDESYS_ITEM_TOPICS = 'Topics';
+ SZDDESYS_ITEM_SYSITEMS = 'SysItems';
+ SZDDESYS_ITEM_RTNMSG = 'ReturnMessage';
+ SZDDESYS_ITEM_STATUS = 'Status';
+ SZDDESYS_ITEM_FORMATS = 'Formats';
+ SZDDESYS_ITEM_SECURITY = 'Security';
+ SZDDESYS_ITEM_ITEMFORMATS = 'ItemFormats';
+ SZDDESYS_ITEM_HELP = 'Help';
+ SZDDESYS_ITEM_PROTOCOLS = 'Protocols';
+ SZDDESYS_ITEM_RESTART = 'Restart';
+
+ DDECTXT_CASESENSITIVE = $0001;
+
+ {DDE}
+ DDE_FACK = $0001;
+ DDE_FBUSY = $0002;
+ DDE_FNODATA = $0004;
+ DDE_FACKREQ = $0008;
+ DDE_FRESPONSE = $0010;
+ DDE_NOTPROCESSED = $0020;
+ DDE_FRESERVED = $00C0;
+ DDE_FAPPSTATUS = $FF00;
+ DDEFMT_TEXT = $0001;
+ DDEPM_RETRY = $00000001;
+ DDEPM_NOFREE = $00000002;
+ WM_DDE_FIRST = $00A0;
+ WM_DDE_INITIATE = $00A0;
+ WM_DDE_REQUEST = $00A1;
+ WM_DDE_ACK = $00A2;
+ WM_DDE_DATA = $00A3;
+ WM_DDE_ADVISE = $00A4;
+ WM_DDE_UNADVISE = $00A5;
+ WM_DDE_POKE = $00A6;
+ WM_DDE_EXECUTE = $00A7;
+ WM_DDE_TERMINATE = $00A8;
+ WM_DDE_INITIATEACK = $00A9;
+ WM_DDE_LAST = $00AF;
+ WM_QUERYCONVERTPOS = $00b0;
+ QCP_CONVERT = $0001;
+ QCP_NOCONVERT = $0000;
+
+ SDT_DESTROY = $0001;
+ SDT_NOBKGND = $0002;
+ SDT_TILE = $0004;
+ SDT_SCALE = $0008;
+ SDT_PATTERN = $0010;
+ SDT_CENTER = $0020;
+ SDT_RETAIN = $0040;
+ SDT_LOADFILE = $0080;
+
+ STR_DLLNAME = 'keyremap';
+ WM_DBCSFIRST = $00b0;
+ WM_DBCSLAST = $00cf;
+
+{ Standard Window Classes - for WinCreateWCWindow }
+ WC_FRAME =$ffff0001;
+ WC_COMBOBOX =$ffff0002;
+ WC_BUTTON =$ffff0003;
+ WC_MENU =$ffff0004;
+ WC_STATIC =$ffff0005;
+ WC_ENTRYFIELD =$ffff0006;
+ WC_LISTBOX =$ffff0007;
+ WC_SCROLLBAR =$ffff0008;
+ WC_TITLEBAR =$ffff0009;
+ WC_MLE =$ffff000A;
+ { 000B to 000F reserved }
+ WC_APPSTAT =$ffff0010;
+ WC_KBDSTAT =$ffff0011;
+ WC_PECIC =$ffff0012;
+ WC_DBE_KKPOPUP =$ffff0013;
+ { 0014 to 001F reserved }
+ WC_SPINBUTTON =$ffff0020;
+ { 0021 to 0024 reserved }
+ WC_CONTAINER =$ffff0025;
+ WC_SLIDER =$ffff0026;
+ WC_VALUESET =$ffff0027;
+ WC_NOTEBOOK =$ffff0028;
+ { 0029 to 002C used by PEN }
+ WC_PENFIRST =$ffff0029;
+ WC_PENLAST =$ffff002C;
+ { 002D to 0030 reserved }
+ { 0030 to 003F reserved }
+ WC_MMPMFIRST =$ffff0040;
+ WC_MMPMLAST =$ffff004f;
+
+{ PM error constants }
+ PMERR_INVALID_HWND = $1001;
+ PMERR_INVALID_HMQ = $1002;
+ PMERR_PARAMETER_OUT_OF_RANGE = $1003;
+ PMERR_WINDOW_LOCK_UNDERFLOW = $1004;
+ PMERR_WINDOW_LOCK_OVERFLOW = $1005;
+ PMERR_BAD_WINDOW_LOCK_COUNT = $1006;
+ PMERR_WINDOW_NOT_LOCKED = $1007;
+ PMERR_INVALID_SELECTOR = $1008;
+ PMERR_CALL_FROM_WRONG_THREAD = $1009;
+ PMERR_RESOURCE_NOT_FOUND = $100A;
+ PMERR_INVALID_STRING_PARM = $100B;
+ PMERR_INVALID_HHEAP = $100C;
+ PMERR_INVALID_HEAP_POINTER = $100D;
+ PMERR_INVALID_HEAP_SIZE_PARM = $100E;
+ PMERR_INVALID_HEAP_SIZE = $100F;
+ PMERR_INVALID_HEAP_SIZE_WORD = $1010;
+ PMERR_HEAP_OUT_OF_MEMORY = $1011;
+ PMERR_HEAP_MAX_SIZE_REACHED = $1012;
+ PMERR_INVALID_HATOMTBL = $1013;
+ PMERR_INVALID_ATOM = $1014;
+ PMERR_INVALID_ATOM_NAME = $1015;
+ PMERR_INVALID_INTEGER_ATOM = $1016;
+ PMERR_ATOM_NAME_NOT_FOUND = $1017;
+ PMERR_QUEUE_TOO_LARGE = $1018;
+ PMERR_INVALID_FLAG = $1019;
+ PMERR_INVALID_HACCEL = $101A;
+ PMERR_INVALID_HPTR = $101B;
+ PMERR_INVALID_HENUM = $101C;
+ PMERR_INVALID_SRC_CODEPAGE = $101D;
+ PMERR_INVALID_DST_CODEPAGE = $101E;
+ PMERR_UNKNOWN_COMPONENT_ID = $101f;
+ PMERR_UNKNOWN_ERROR_CODE = $1020;
+ PMERR_SEVERITY_LEVELS = $1021;
+ PMERR_INVALID_RESOURCE_FORMAT = $1034;
+ PMERR_NO_MSG_QUEUE = $1036;
+ PMERR_WIN_DEBUGMSG = $1037;
+ PMERR_QUEUE_FULL = $1038;
+ PMERR_LIBRARY_LOAD_FAILED = $1039;
+ PMERR_PROCEDURE_LOAD_FAILED = $103A;
+ PMERR_LIBRARY_DELETE_FAILED = $103B;
+ PMERR_PROCEDURE_DELETE_FAILED = $103C;
+ PMERR_ARRAY_TOO_LARGE = $103D;
+ PMERR_ARRAY_TOO_SMALL = $103E;
+ PMERR_DATATYPE_ENTRY_BAD_INDEX = $103F;
+ PMERR_DATATYPE_ENTRY_CTL_BAD = $1040;
+ PMERR_DATATYPE_ENTRY_CTL_MISS = $1041;
+ PMERR_DATATYPE_ENTRY_INVALID = $1042;
+ PMERR_DATATYPE_ENTRY_NOT_NUM = $1043;
+ PMERR_DATATYPE_ENTRY_NOT_OFF = $1044;
+ PMERR_DATATYPE_INVALID = $1045;
+ PMERR_DATATYPE_NOT_UNIQUE = $1046;
+ PMERR_DATATYPE_TOO_LONG = $1047;
+ PMERR_DATATYPE_TOO_SMALL = $1048;
+ PMERR_DIRECTION_INVALID = $1049;
+ PMERR_INVALID_HAB = $104A;
+ PMERR_INVALID_HSTRUCT = $104D;
+ PMERR_LENGTH_TOO_SMALL = $104E;
+ PMERR_MSGID_TOO_SMALL = $104F;
+ PMERR_NO_HANDLE_ALLOC = $1050;
+ PMERR_NOT_IN_A_PM_SESSION = $1051;
+ PMERR_MSG_QUEUE_ALREADY_EXISTS = $1052;
+ PMERR_OLD_RESOURCE = $1055;
+ PMERR_INVALID_PIB = $1101;
+ PMERR_INSUFF_SPACE_TO_ADD = $1102;
+ PMERR_INVALID_GROUP_HANDLE = $1103;
+ PMERR_DUPLICATE_TITLE = $1104;
+ PMERR_INVALID_TITLE = $1105;
+ PMERR_HANDLE_NOT_IN_GROUP = $1107;
+ PMERR_INVALID_TARGET_HANDLE = $1106;
+ PMERR_INVALID_PATH_STATEMENT = $1108;
+ PMERR_NO_PROGRAM_FOUND = $1109;
+ PMERR_INVALID_BUFFER_SIZE = $110A;
+ PMERR_BUFFER_TOO_SMALL = $110B;
+ PMERR_PL_INITIALISATION_FAIL = $110C;
+ PMERR_CANT_DESTROY_SYS_GROUP = $110D;
+ PMERR_INVALID_TYPE_CHANGE = $110E;
+ PMERR_INVALID_PROGRAM_HANDLE = $110F;
+ PMERR_NOT_CURRENT_PL_VERSION = $1110;
+ PMERR_INVALID_CIRCULAR_REF = $1111;
+ PMERR_MEMORY_ALLOCATION_ERR = $1112;
+ PMERR_MEMORY_DEALLOCATION_ERR = $1113;
+ PMERR_TASK_HEADER_TOO_BIG = $1114;
+ PMERR_INVALID_INI_FILE_HANDLE = $1115;
+ PMERR_MEMORY_SHARE = $1116;
+ PMERR_OPEN_QUEUE = $1117;
+ PMERR_CREATE_QUEUE = $1118;
+ PMERR_WRITE_QUEUE = $1119;
+ PMERR_READ_QUEUE = $111A;
+ PMERR_CALL_NOT_EXECUTED = $111B;
+ PMERR_UNKNOWN_APIPKT = $111C;
+ PMERR_INITHREAD_EXISTS = $111D;
+ PMERR_CREATE_THREAD = $111E;
+ PMERR_NO_HK_PROFILE_INSTALLED = $111F;
+ PMERR_INVALID_DIRECTORY = $1120;
+ PMERR_WILDCARD_IN_FILENAME = $1121;
+ PMERR_FILENAME_BUFFER_FULL = $1122;
+ PMERR_FILENAME_TOO_LONG = $1123;
+ PMERR_INI_FILE_IS_SYS_OR_USER = $1124;
+ PMERR_BROADCAST_PLMSG = $1125;
+ PMERR_190_INIT_DONE = $1126;
+ PMERR_HMOD_FOR_PMSHAPI = $1127;
+ PMERR_SET_HK_PROFILE = $1128;
+ PMERR_API_NOT_ALLOWED = $1129;
+ PMERR_INI_STILL_OPEN = $112A;
+ PMERR_PROGDETAILS_NOT_IN_INI = $112B;
+ PMERR_PIBSTRUCT_NOT_IN_INI = $112C;
+ PMERR_INVALID_DISKPROGDETAILS = $112D;
+ PMERR_PROGDETAILS_READ_FAILURE = $112E;
+ PMERR_PROGDETAILS_WRITE_FAILURE = $112F;
+ PMERR_PROGDETAILS_QSIZE_FAILURE = $1130;
+ PMERR_INVALID_PROGDETAILS = $1131;
+ PMERR_SHEPROFILEHOOK_NOT_FOUND = $1132;
+ PMERR_190PLCONVERTED = $1133;
+ PMERR_FAILED_TO_CONVERT_INI_PL = $1134;
+ PMERR_PMSHAPI_NOT_INITIALISED = $1135;
+ PMERR_INVALID_SHELL_API_HOOK_ID = $1136;
+ PMERR_DOS_ERROR = $1200;
+ PMERR_NO_SPACE = $1201;
+ PMERR_INVALID_SWITCH_HANDLE = $1202;
+ PMERR_NO_HANDLE = $1203;
+ PMERR_INVALID_PROCESS_ID = $1204;
+ PMERR_NOT_SHELL = $1205;
+ PMERR_INVALID_WINDOW = $1206;
+ PMERR_INVALID_POST_MSG = $1207;
+ PMERR_INVALID_PARAMETERS = $1208;
+ PMERR_INVALID_PROGRAM_TYPE = $1209;
+ PMERR_NOT_EXTENDED_FOCUS = $120A;
+ PMERR_INVALID_SESSION_ID = $120B;
+ PMERR_SMG_INVALID_ICON_FILE = $120C;
+ PMERR_SMG_ICON_NOT_CREATED = $120D;
+ PMERR_SHL_DEBUG = $120E;
+ PMERR_OPENING_INI_FILE = $1301;
+ PMERR_INI_FILE_CORRUPT = $1302;
+ PMERR_INVALID_PARM = $1303;
+ PMERR_NOT_IN_IDX = $1304;
+ PMERR_NO_ENTRIES_IN_GROUP = $1305;
+ PMERR_INI_WRITE_FAIL = $1306;
+ PMERR_IDX_FULL = $1307;
+ PMERR_INI_PROTECTED = $1308;
+ PMERR_MEMORY_ALLOC = $1309;
+ PMERR_INI_INIT_ALREADY_DONE = $130A;
+ PMERR_INVALID_INTEGER = $130B;
+ PMERR_INVALID_ASCIIZ = $130C;
+ PMERR_CAN_NOT_CALL_SPOOLER = $130D;
+ PMERR_VALIDATION_REJECTED = PMERR_CAN_NOT_CALL_SPOOLER;
+ PMERR_WARNING_WINDOW_NOT_KILLED = $1401;
+ PMERR_ERROR_INVALID_WINDOW = $1402;
+ PMERR_ALREADY_INITIALIZED = $1403;
+ PMERR_MSG_PROG_NO_MOU = $1405;
+ PMERR_MSG_PROG_NON_RECOV = $1406;
+ PMERR_WINCONV_INVALID_PATH = $1407;
+ PMERR_PI_NOT_INITIALISED = $1408;
+ PMERR_PL_NOT_INITIALISED = $1409;
+ PMERR_NO_TASK_MANAGER = $140A;
+ PMERR_SAVE_NOT_IN_PROGRESS = $140B;
+ PMERR_NO_STACK_SPACE = $140C;
+ PMERR_INVALID_COLR_FIELD = $140d;
+ PMERR_INVALID_COLR_VALUE = $140e;
+ PMERR_COLR_WRITE = $140f;
+ PMERR_TARGET_FILE_EXISTS = $1501;
+ PMERR_SOURCE_SAME_AS_TARGET = $1502;
+ PMERR_SOURCE_FILE_NOT_FOUND = $1503;
+ PMERR_INVALID_NEW_PATH = $1504;
+ PMERR_TARGET_FILE_NOT_FOUND = $1505;
+ PMERR_INVALID_DRIVE_NUMBER = $1506;
+ PMERR_NAME_TOO_LONG = $1507;
+ PMERR_NOT_ENOUGH_ROOM_ON_DISK = $1508;
+ PMERR_NOT_ENOUGH_MEM = $1509;
+ PMERR_LOG_DRV_DOES_NOT_EXIST = $150B;
+ PMERR_INVALID_DRIVE = $150C;
+ PMERR_ACCESS_DENIED = $150D;
+ PMERR_NO_FIRST_SLASH = $150E;
+ PMERR_READ_ONLY_FILE = $150F;
+ PMERR_GROUP_PROTECTED = $151F;
+ PMERR_INVALID_PROGRAM_CATEGORY = $152F;
+ PMERR_INVALID_APPL = $1530;
+ PMERR_CANNOT_START = $1531;
+ PMERR_STARTED_IN_BACKGROUND = $1532;
+ PMERR_INVALID_HAPP = $1533;
+ PMERR_CANNOT_STOP = $1534;
+ PMERR_INTERNAL_ERROR_1 = $1601;
+ PMERR_INTERNAL_ERROR_2 = $1602;
+ PMERR_INTERNAL_ERROR_3 = $1603;
+ PMERR_INTERNAL_ERROR_4 = $1604;
+ PMERR_INTERNAL_ERROR_5 = $1605;
+ PMERR_INTERNAL_ERROR_6 = $1606;
+ PMERR_INTERNAL_ERROR_7 = $1607;
+ PMERR_INTERNAL_ERROR_8 = $1608;
+ PMERR_INTERNAL_ERROR_9 = $1609;
+ PMERR_INTERNAL_ERROR_10 = $160A;
+ PMERR_INTERNAL_ERROR_11 = $160B;
+ PMERR_INTERNAL_ERROR_12 = $160C;
+ PMERR_INTERNAL_ERROR_13 = $160D;
+ PMERR_INTERNAL_ERROR_14 = $160E;
+ PMERR_INTERNAL_ERROR_15 = $160F;
+ PMERR_INTERNAL_ERROR_16 = $1610;
+ PMERR_INTERNAL_ERROR_17 = $1611;
+ PMERR_INTERNAL_ERROR_18 = $1612;
+ PMERR_INTERNAL_ERROR_19 = $1613;
+ PMERR_INTERNAL_ERROR_20 = $1614;
+ PMERR_INTERNAL_ERROR_21 = $1615;
+ PMERR_INTERNAL_ERROR_22 = $1616;
+ PMERR_INTERNAL_ERROR_23 = $1617;
+ PMERR_INTERNAL_ERROR_24 = $1618;
+ PMERR_INTERNAL_ERROR_25 = $1619;
+ PMERR_INTERNAL_ERROR_26 = $161A;
+ PMERR_INTERNAL_ERROR_27 = $161B;
+ PMERR_INTERNAL_ERROR_28 = $161C;
+ PMERR_INTERNAL_ERROR_29 = $161D;
+ PMERR_INVALID_FREE_MESSAGE_ID = $1630;
+ PMERR_FUNCTION_NOT_SUPPORTED = $1641;
+ PMERR_INVALID_ARRAY_COUNT = $1642;
+ PMERR_INVALID_LENGTH = $1643;
+ PMERR_INVALID_BUNDLE_TYPE = $1644;
+ PMERR_INVALID_PARAMETER = $1645;
+ PMERR_INVALID_NUMBER_OF_PARMS = $1646;
+ PMERR_GREATER_THAN_64K = $1647;
+ PMERR_INVALID_PARAMETER_TYPE = $1648;
+ PMERR_NEGATIVE_STRCOND_DIM = $1649;
+ PMERR_INVALID_NUMBER_OF_TYPES = $164A;
+ PMERR_INCORRECT_HSTRUCT = $164B;
+ PMERR_INVALID_ARRAY_SIZE = $164C;
+ PMERR_INVALID_CONTROL_DATATYPE = $164D;
+ PMERR_INCOMPLETE_CONTROL_SEQU = $164E;
+ PMERR_INVALID_DATATYPE = $164F;
+ PMERR_INCORRECT_DATATYPE = $1650;
+ PMERR_NOT_SELF_DESCRIBING_DTYP = $1651;
+ PMERR_INVALID_CTRL_SEQ_INDEX = $1652;
+ PMERR_INVALID_TYPE_FOR_LENGTH = $1653;
+ PMERR_INVALID_TYPE_FOR_OFFSET = $1654;
+ PMERR_INVALID_TYPE_FOR_MPARAM = $1655;
+ PMERR_INVALID_MESSAGE_ID = $1656;
+ PMERR_C_LENGTH_TOO_SMALL = $1657;
+ PMERR_APPL_STRUCTURE_TOO_SMALL = $1658;
+ PMERR_INVALID_ERRORINFO_HANDLE = $1659;
+ PMERR_INVALID_CHARACTER_INDEX = $165A;
+ WPERR_PROTECTED_CLASS = $1700;
+ WPERR_INVALID_CLASS = $1701;
+ WPERR_INVALID_SUPERCLASS = $1702;
+ WPERR_NO_MEMORY = $1703;
+ WPERR_SEMAPHORE_ERROR = $1704;
+ WPERR_BUFFER_TOO_SMALL = $1705;
+ WPERR_CLSLOADMOD_FAILED = $1706;
+ WPERR_CLSPROCADDR_FAILED = $1707;
+ WPERR_OBJWORD_LOCATION = $1708;
+ WPERR_INVALID_OBJECT = $1709;
+ WPERR_MEMORY_CLEANUP = $170A;
+ WPERR_INVALID_MODULE = $170B;
+ WPERR_INVALID_OLDCLASS = $170C;
+ WPERR_INVALID_NEWCLASS = $170D;
+ WPERR_NOT_IMMEDIATE_CHILD = $170E;
+ WPERR_NOT_WORKPLACE_CLASS = $170F;
+ WPERR_CANT_REPLACE_METACLS = $1710;
+ WPERR_INI_FILE_WRITE = $1711;
+ WPERR_INVALID_FOLDER = $1712;
+ WPERR_BUFFER_OVERFLOW = $1713;
+ WPERR_OBJECT_NOT_FOUND = $1714;
+ WPERR_INVALID_HFIND = $1715;
+ WPERR_INVALID_COUNT = $1716;
+ WPERR_INVALID_BUFFER = $1717;
+ WPERR_ALREADY_EXISTS = $1718;
+ WPERR_INVALID_FLAGS = $1719;
+ WPERR_INVALID_OBJECTID = $1720;
+ PMERR_OK = $0000;
+ PMERR_ALREADY_IN_AREA = $2001;
+ PMERR_ALREADY_IN_ELEMENT = $2002;
+ PMERR_ALREADY_IN_PATH = $2003;
+ PMERR_ALREADY_IN_SEG = $2004;
+ PMERR_AREA_INCOMPLETE = $2005;
+ PMERR_BASE_ERROR = $2006;
+ PMERR_BITBLT_LENGTH_EXCEEDED = $2007;
+ PMERR_BITMAP_IN_USE = $2008;
+ PMERR_BITMAP_IS_SELECTED = $2009;
+ PMERR_BITMAP_NOT_FOUND = $200A;
+ PMERR_BITMAP_NOT_SELECTED = $200B;
+ PMERR_BOUNDS_OVERFLOW = $200C;
+ PMERR_CALLED_SEG_IS_CHAINED = $200D;
+ PMERR_CALLED_SEG_IS_CURRENT = $200E;
+ PMERR_CALLED_SEG_NOT_FOUND = $200F;
+ PMERR_CANNOT_DELETE_ALL_DATA = $2010;
+ PMERR_CANNOT_REPLACE_ELEMENT_0 = $2011;
+ PMERR_COL_TABLE_NOT_REALIZABLE = $2012;
+ PMERR_COL_TABLE_NOT_REALIZED = $2013;
+ PMERR_COORDINATE_OVERFLOW = $2014;
+ PMERR_CORR_FORMAT_MISMATCH = $2015;
+ PMERR_DATA_TOO_LONG = $2016;
+ PMERR_DC_IS_ASSOCIATED = $2017;
+ PMERR_DESC_STRING_TRUNCATED = $2018;
+ PMERR_DEVICE_DRIVER_ERROR_1 = $2019;
+ PMERR_DEVICE_DRIVER_ERROR_2 = $201A;
+ PMERR_DEVICE_DRIVER_ERROR_3 = $201B;
+ PMERR_DEVICE_DRIVER_ERROR_4 = $201C;
+ PMERR_DEVICE_DRIVER_ERROR_5 = $201D;
+ PMERR_DEVICE_DRIVER_ERROR_6 = $201E;
+ PMERR_DEVICE_DRIVER_ERROR_7 = $201F;
+ PMERR_DEVICE_DRIVER_ERROR_8 = $2020;
+ PMERR_DEVICE_DRIVER_ERROR_9 = $2021;
+ PMERR_DEVICE_DRIVER_ERROR_10 = $2022;
+ PMERR_DEV_FUNC_NOT_INSTALLED = $2023;
+ PMERR_DOSOPEN_FAILURE = $2024;
+ PMERR_DOSREAD_FAILURE = $2025;
+ PMERR_DRIVER_NOT_FOUND = $2026;
+ PMERR_DUP_SEG = $2027;
+ PMERR_DYNAMIC_SEG_SEQ_ERROR = $2028;
+ PMERR_DYNAMIC_SEG_ZERO_INV = $2029;
+ PMERR_ELEMENT_INCOMPLETE = $202A;
+ PMERR_ESC_CODE_NOT_SUPPORTED = $202B;
+ PMERR_EXCEEDS_MAX_SEG_LENGTH = $202C;
+ PMERR_FONT_AND_MODE_MISMATCH = $202D;
+ PMERR_FONT_FILE_NOT_LOADED = $202E;
+ PMERR_FONT_NOT_LOADED = $202F;
+ PMERR_FONT_TOO_BIG = $2030;
+ PMERR_HARDWARE_INIT_FAILURE = $2031;
+ PMERR_HBITMAP_BUSY = $2032;
+ PMERR_HDC_BUSY = $2033;
+ PMERR_HRGN_BUSY = $2034;
+ PMERR_HUGE_FONTS_NOT_SUPPORTED = $2035;
+ PMERR_ID_HAS_NO_BITMAP = $2036;
+ PMERR_IMAGE_INCOMPLETE = $2037;
+ PMERR_INCOMPAT_COLOR_FORMAT = $2038;
+ PMERR_INCOMPAT_COLOR_OPTIONS = $2039;
+ PMERR_INCOMPATIBLE_BITMAP = $203A;
+ PMERR_INCOMPATIBLE_METAFILE = $203B;
+ PMERR_INCORRECT_DC_TYPE = $203C;
+ PMERR_INSUFFICIENT_DISK_SPACE = $203D;
+ PMERR_INSUFFICIENT_MEMORY = $203E;
+ PMERR_INV_ANGLE_PARM = $203F;
+ PMERR_INV_ARC_CONTROL = $2040;
+ PMERR_INV_AREA_CONTROL = $2041;
+ PMERR_INV_ARC_POINTS = $2042;
+ PMERR_INV_ATTR_MODE = $2043;
+ PMERR_INV_BACKGROUND_COL_ATTR = $2044;
+ PMERR_INV_BACKGROUND_MIX_ATTR = $2045;
+ PMERR_INV_BITBLT_MIX = $2046;
+ PMERR_INV_BITBLT_STYLE = $2047;
+ PMERR_INV_BITMAP_DIMENSION = $2048;
+ PMERR_INV_BOX_CONTROL = $2049;
+ PMERR_INV_BOX_ROUNDING_PARM = $204A;
+ PMERR_INV_CHAR_ANGLE_ATTR = $204B;
+ PMERR_INV_CHAR_DIRECTION_ATTR = $204C;
+ PMERR_INV_CHAR_MODE_ATTR = $204D;
+ PMERR_INV_CHAR_POS_OPTIONS = $204E;
+ PMERR_INV_CHAR_SET_ATTR = $204F;
+ PMERR_INV_CHAR_SHEAR_ATTR = $2050;
+ PMERR_INV_CLIP_PATH_OPTIONS = $2051;
+ PMERR_INV_CODEPAGE = $2052;
+ PMERR_INV_COLOR_ATTR = $2053;
+ PMERR_INV_COLOR_DATA = $2054;
+ PMERR_INV_COLOR_FORMAT = $2055;
+ PMERR_INV_COLOR_INDEX = $2056;
+ PMERR_INV_COLOR_OPTIONS = $2057;
+ PMERR_INV_COLOR_START_INDEX = $2058;
+ PMERR_INV_COORD_OFFSET = $2059;
+ PMERR_INV_COORD_SPACE = $205A;
+ PMERR_INV_COORDINATE = $205B;
+ PMERR_INV_CORRELATE_DEPTH = $205C;
+ PMERR_INV_CORRELATE_TYPE = $205D;
+ PMERR_INV_CURSOR_BITMAP = $205E;
+ PMERR_INV_DC_DATA = $205F;
+ PMERR_INV_DC_TYPE = $2060;
+ PMERR_INV_DEVICE_NAME = $2061;
+ PMERR_INV_DEV_MODES_OPTIONS = $2062;
+ PMERR_INV_DRAW_CONTROL = $2063;
+ PMERR_INV_DRAW_VALUE = $2064;
+ PMERR_INV_DRAWING_MODE = $2065;
+ PMERR_INV_DRIVER_DATA = $2066;
+ PMERR_INV_DRIVER_NAME = $2067;
+ PMERR_INV_DRAW_BORDER_OPTION = $2068;
+ PMERR_INV_EDIT_MODE = $2069;
+ PMERR_INV_ELEMENT_OFFSET = $206A;
+ PMERR_INV_ELEMENT_POINTER = $206B;
+ PMERR_INV_END_PATH_OPTIONS = $206C;
+ PMERR_INV_ESC_CODE = $206D;
+ PMERR_INV_ESCAPE_DATA = $206E;
+ PMERR_INV_EXTENDED_LCID = $206F;
+ PMERR_INV_FILL_PATH_OPTIONS = $2070;
+ PMERR_INV_FIRST_CHAR = $2071;
+ PMERR_INV_FONT_ATTRS = $2072;
+ PMERR_INV_FONT_FILE_DATA = $2073;
+ PMERR_INV_FOR_THIS_DC_TYPE = $2074;
+ PMERR_INV_FORMAT_CONTROL = $2075;
+ PMERR_INV_FORMS_CODE = $2076;
+ PMERR_INV_FONTDEF = $2077;
+ PMERR_INV_GEOM_LINE_WIDTH_ATTR = $2078;
+ PMERR_INV_GETDATA_CONTROL = $2079;
+ PMERR_INV_GRAPHICS_FIELD = $207A;
+ PMERR_INV_HBITMAP = $207B;
+ PMERR_INV_HDC = $207C;
+ PMERR_INV_HJOURNAL = $207D;
+ PMERR_INV_HMF = $207E;
+ PMERR_INV_HPS = $207F;
+ PMERR_INV_HRGN = $2080;
+ PMERR_INV_ID = $2081;
+ PMERR_INV_IMAGE_DATA_LENGTH = $2082;
+ PMERR_INV_IMAGE_DIMENSION = $2083;
+ PMERR_INV_IMAGE_FORMAT = $2084;
+ PMERR_INV_IN_AREA = $2085;
+ PMERR_INV_IN_CALLED_SEG = $2086;
+ PMERR_INV_IN_CURRENT_EDIT_MODE = $2087;
+ PMERR_INV_IN_DRAW_MODE = $2088;
+ PMERR_INV_IN_ELEMENT = $2089;
+ PMERR_INV_IN_IMAGE = $208A;
+ PMERR_INV_IN_PATH = $208B;
+ PMERR_INV_IN_RETAIN_MODE = $208C;
+ PMERR_INV_IN_SEG = $208D;
+ PMERR_INV_IN_VECTOR_SYMBOL = $208E;
+ PMERR_INV_INFO_TABLE = $208F;
+ PMERR_INV_JOURNAL_OPTION = $2090;
+ PMERR_INV_KERNING_FLAGS = $2091;
+ PMERR_INV_LENGTH_OR_COUNT = $2092;
+ PMERR_INV_LINE_END_ATTR = $2093;
+ PMERR_INV_LINE_JOIN_ATTR = $2094;
+ PMERR_INV_LINE_TYPE_ATTR = $2095;
+ PMERR_INV_LINE_WIDTH_ATTR = $2096;
+ PMERR_INV_LOGICAL_ADDRESS = $2097;
+ PMERR_INV_MARKER_BOX_ATTR = $2098;
+ PMERR_INV_MARKER_SET_ATTR = $2099;
+ PMERR_INV_MARKER_SYMBOL_ATTR = $209A;
+ PMERR_INV_MATRIX_ELEMENT = $209B;
+ PMERR_INV_MAX_HITS = $209C;
+ PMERR_INV_METAFILE = $209D;
+ PMERR_INV_METAFILE_LENGTH = $209E;
+ PMERR_INV_METAFILE_OFFSET = $209F;
+ PMERR_INV_MICROPS_DRAW_CONTROL = $20A0;
+ PMERR_INV_MICROPS_FUNCTION = $20A1;
+ PMERR_INV_MICROPS_ORDER = $20A2;
+ PMERR_INV_MIX_ATTR = $20A3;
+ PMERR_INV_MODE_FOR_OPEN_DYN = $20A4;
+ PMERR_INV_MODE_FOR_REOPEN_SEG = $20A5;
+ PMERR_INV_MODIFY_PATH_MODE = $20A6;
+ PMERR_INV_MULTIPLIER = $20A7;
+ PMERR_INV_NESTED_FIGURES = $20A8;
+ PMERR_INV_OR_INCOMPAT_OPTIONS = $20A9;
+ PMERR_INV_ORDER_LENGTH = $20AA;
+ PMERR_INV_ORDERING_PARM = $20AB;
+ PMERR_INV_OUTSIDE_DRAW_MODE = $20AC;
+ PMERR_INV_PAGE_VIEWPORT = $20AD;
+ PMERR_INV_PATH_ID = $20AE;
+ PMERR_INV_PATH_MODE = $20AF;
+ PMERR_INV_PATTERN_ATTR = $20B0;
+ PMERR_INV_PATTERN_REF_PT_ATTR = $20B1;
+ PMERR_INV_PATTERN_SET_ATTR = $20B2;
+ PMERR_INV_PATTERN_SET_FONT = $20B3;
+ PMERR_INV_PICK_APERTURE_OPTION = $20B4;
+ PMERR_INV_PICK_APERTURE_POSN = $20B5;
+ PMERR_INV_PICK_APERTURE_SIZE = $20B6;
+ PMERR_INV_PICK_NUMBER = $20B7;
+ PMERR_INV_PLAY_METAFILE_OPTION = $20B8;
+ PMERR_INV_PRIMITIVE_TYPE = $20B9;
+ PMERR_INV_PS_SIZE = $20BA;
+ PMERR_INV_PUTDATA_FORMAT = $20BB;
+ PMERR_INV_QUERY_ELEMENT_NO = $20BC;
+ PMERR_INV_RECT = $20BD;
+ PMERR_INV_REGION_CONTROL = $20BE;
+ PMERR_INV_REGION_MIX_MODE = $20BF;
+ PMERR_INV_REPLACE_MODE_FUNC = $20C0;
+ PMERR_INV_RESERVED_FIELD = $20C1;
+ PMERR_INV_RESET_OPTIONS = $20C2;
+ PMERR_INV_RGBCOLOR = $20C3;
+ PMERR_INV_SCAN_START = $20C4;
+ PMERR_INV_SEG_ATTR = $20C5;
+ PMERR_INV_SEG_ATTR_VALUE = $20C6;
+ PMERR_INV_SEG_CH_LENGTH = $20C7;
+ PMERR_INV_SEG_NAME = $20C8;
+ PMERR_INV_SEG_OFFSET = $20C9;
+ PMERR_INV_SETID = $20CA;
+ PMERR_INV_SETID_TYPE = $20CB;
+ PMERR_INV_SET_VIEWPORT_OPTION = $20CC;
+ PMERR_INV_SHARPNESS_PARM = $20CD;
+ PMERR_INV_SOURCE_OFFSET = $20CE;
+ PMERR_INV_STOP_DRAW_VALUE = $20CF;
+ PMERR_INV_TRANSFORM_TYPE = $20D0;
+ PMERR_INV_USAGE_PARM = $20D1;
+ PMERR_INV_VIEWING_LIMITS = $20D2;
+ PMERR_JFILE_BUSY = $20D3;
+ PMERR_JNL_FUNC_DATA_TOO_LONG = $20D4;
+ PMERR_KERNING_NOT_SUPPORTED = $20D5;
+ PMERR_LABEL_NOT_FOUND = $20D6;
+ PMERR_MATRIX_OVERFLOW = $20D7;
+ PMERR_METAFILE_INTERNAL_ERROR = $20D8;
+ PMERR_METAFILE_IN_USE = $20D9;
+ PMERR_METAFILE_LIMIT_EXCEEDED = $20DA;
+ PMERR_NAME_STACK_FULL = $20DB;
+ PMERR_NOT_CREATED_BY_DEVOPENDC = $20DC;
+ PMERR_NOT_IN_AREA = $20DD;
+ PMERR_NOT_IN_DRAW_MODE = $20DE;
+ PMERR_NOT_IN_ELEMENT = $20DF;
+ PMERR_NOT_IN_IMAGE = $20E0;
+ PMERR_NOT_IN_PATH = $20E1;
+ PMERR_NOT_IN_RETAIN_MODE = $20E2;
+ PMERR_NOT_IN_SEG = $20E3;
+ PMERR_NO_BITMAP_SELECTED = $20E4;
+ PMERR_NO_CURRENT_ELEMENT = $20E5;
+ PMERR_NO_CURRENT_SEG = $20E6;
+ PMERR_NO_METAFILE_RECORD_HANDLE = $20E7;
+ PMERR_ORDER_TOO_BIG = $20E8;
+ PMERR_OTHER_SET_ID_REFS = $20E9;
+ PMERR_OVERRAN_SEG = $20EA;
+ PMERR_OWN_SET_ID_REFS = $20EB;
+ PMERR_PATH_INCOMPLETE = $20EC;
+ PMERR_PATH_LIMIT_EXCEEDED = $20ED;
+ PMERR_PATH_UNKNOWN = $20EE;
+ PMERR_PEL_IS_CLIPPED = $20EF;
+ PMERR_PEL_NOT_AVAILABLE = $20F0;
+ PMERR_PRIMITIVE_STACK_EMPTY = $20F1;
+ PMERR_PROLOG_ERROR = $20F2;
+ PMERR_PROLOG_SEG_ATTR_NOT_SET = $20F3;
+ PMERR_PS_BUSY = $20F4;
+ PMERR_PS_IS_ASSOCIATED = $20F5;
+ PMERR_RAM_JNL_FILE_TOO_SMALL = $20F6;
+ PMERR_REALIZE_NOT_SUPPORTED = $20F7;
+ PMERR_REGION_IS_CLIP_REGION = $20F8;
+ PMERR_RESOURCE_DEPLETION = $20F9;
+ PMERR_SEG_AND_REFSEG_ARE_SAME = $20FA;
+ PMERR_SEG_CALL_RECURSIVE = $20FB;
+ PMERR_SEG_CALL_STACK_EMPTY = $20FC;
+ PMERR_SEG_CALL_STACK_FULL = $20FD;
+ PMERR_SEG_IS_CURRENT = $20FE;
+ PMERR_SEG_NOT_CHAINED = $20FF;
+ PMERR_SEG_NOT_FOUND = $2100;
+ PMERR_SEG_STORE_LIMIT_EXCEEDED = $2101;
+ PMERR_SETID_IN_USE = $2102;
+ PMERR_SETID_NOT_FOUND = $2103;
+ PMERR_STARTDOC_NOT_ISSUED = $2104;
+ PMERR_STOP_DRAW_OCCURRED = $2105;
+ PMERR_TOO_MANY_METAFILES_IN_USE = $2106;
+ PMERR_TRUNCATED_ORDER = $2107;
+ PMERR_UNCHAINED_SEG_ZERO_INV = $2108;
+ PMERR_UNSUPPORTED_ATTR = $2109;
+ PMERR_UNSUPPORTED_ATTR_VALUE = $210A;
+ PMERR_ENDDOC_NOT_ISSUED = $210B;
+ PMERR_PS_NOT_ASSOCIATED = $210C;
+ PMERR_INV_FLOOD_FILL_OPTIONS = $210D;
+ PMERR_INV_FACENAME = $210E;
+ PMERR_PALETTE_SELECTED = $210F;
+ PMERR_NO_PALETTE_SELECTED = $2110;
+ PMERR_INV_HPAL = $2111;
+ PMERR_PALETTE_BUSY = $2112;
+ PMERR_START_POINT_CLIPPED = $2113;
+ PMERR_NO_FILL = $2114;
+ PMERR_INV_FACENAMEDESC = $2115;
+ PMERR_INV_BITMAP_DATA = $2116;
+ PMERR_INV_CHAR_ALIGN_ATTR = $2117;
+ PMERR_INV_HFONT = $2118;
+ PMERR_HFONT_IS_SELECTED = $2119;
+ PMERR_SPL_DRIVER_ERROR = $4001;
+ PMERR_SPL_DEVICE_ERROR = $4002;
+ PMERR_SPL_DEVICE_NOT_INSTALLED = $4003;
+ PMERR_SPL_QUEUE_ERROR = $4004;
+ PMERR_SPL_INV_HSPL = $4005;
+ PMERR_SPL_NO_DISK_SPACE = $4006;
+ PMERR_SPL_NO_MEMORY = $4007;
+ PMERR_SPL_PRINT_ABORT = $4008;
+ PMERR_SPL_SPOOLER_NOT_INSTALLED = $4009;
+ PMERR_SPL_INV_FORMS_CODE = $400A;
+ PMERR_SPL_INV_PRIORITY = $400B;
+ PMERR_SPL_NO_FREE_JOB_ID = $400C;
+ PMERR_SPL_NO_DATA = $400D;
+ PMERR_SPL_INV_TOKEN = $400E;
+ PMERR_SPL_INV_DATATYPE = $400F;
+ PMERR_SPL_PROCESSOR_ERROR = $4010;
+ PMERR_SPL_INV_JOB_ID = $4011;
+ PMERR_SPL_JOB_NOT_PRINTING = $4012;
+ PMERR_SPL_JOB_PRINTING = $4013;
+ PMERR_SPL_QUEUE_ALREADY_EXISTS = $4014;
+ PMERR_SPL_INV_QUEUE_NAME = $4015;
+ PMERR_SPL_QUEUE_NOT_EMPTY = $4016;
+ PMERR_SPL_DEVICE_ALREADY_EXISTS = $4017;
+ PMERR_SPL_DEVICE_LIMIT_REACHED = $4018;
+ PMERR_SPL_STATUS_STRING_TRUNC = $4019;
+ PMERR_SPL_INV_LENGTH_OR_COUNT = $401A;
+ PMERR_SPL_FILE_NOT_FOUND = $401B;
+ PMERR_SPL_CANNOT_OPEN_FILE = $401C;
+ PMERR_SPL_DRIVER_NOT_INSTALLED = $401D;
+ PMERR_SPL_INV_PROCESSOR_DATTYPE = $401E;
+ PMERR_SPL_INV_DRIVER_DATATYPE = $401F;
+ PMERR_SPL_PROCESSOR_NOT_INST = $4020;
+ PMERR_SPL_NO_SUCH_LOG_ADDRESS = $4021;
+ PMERR_SPL_PRINTER_NOT_FOUND = $4022;
+ PMERR_SPL_DD_NOT_FOUND = $4023;
+ PMERR_SPL_QUEUE_NOT_FOUND = $4024;
+ PMERR_SPL_MANY_QUEUES_ASSOC = $4025;
+ PMERR_SPL_NO_QUEUES_ASSOCIATED = $4026;
+ PMERR_SPL_INI_FILE_ERROR = $4027;
+ PMERR_SPL_NO_DEFAULT_QUEUE = $4028;
+ PMERR_SPL_NO_CURRENT_FORMS_CODE = $4029;
+ PMERR_SPL_NOT_AUTHORISED = $402A;
+ PMERR_SPL_TEMP_NETWORK_ERROR = $402B;
+ PMERR_SPL_HARD_NETWORK_ERROR = $402C;
+ PMERR_DEL_NOT_ALLOWED = $402D;
+ PMERR_CANNOT_DEL_QP_REF = $402E;
+ PMERR_CANNOT_DEL_QNAME_REF = $402F;
+ PMERR_CANNOT_DEL_PRINTER_DD_REF = $4030;
+ PMERR_CANNOT_DEL_PRN_NAME_REF = $4031;
+ PMERR_CANNOT_DEL_PRN_ADDR_REF = $4032;
+ PMERR_SPOOLER_QP_NOT_DEFINED = $4033;
+ PMERR_PRN_NAME_NOT_DEFINED = $4034;
+ PMERR_PRN_ADDR_NOT_DEFINED = $4035;
+ PMERR_PRINTER_DD_NOT_DEFINED = $4036;
+ PMERR_PRINTER_QUEUE_NOT_DEFINED = $4037;
+ PMERR_PRN_ADDR_IN_USE = $4038;
+ PMERR_SPL_TOO_MANY_OPEN_FILES = $4039;
+ PMERR_SPL_CP_NOT_REQD = $403A;
+ PMERR_UNABLE_TO_CLOSE_DEVICE = $4040;
+ PMERR_SPL_ERROR_1 = (SPLERR_BASE+4001);
+ PMERR_SPL_ERROR_2 = (SPLERR_BASE+4002);
+ PMERR_SPL_ERROR_3 = (SPLERR_BASE+4003);
+ PMERR_SPL_ERROR_4 = (SPLERR_BASE+4004);
+ PMERR_SPL_ERROR_5 = (SPLERR_BASE+4005);
+ PMERR_SPL_ERROR_6 = (SPLERR_BASE+4006);
+ PMERR_SPL_ERROR_7 = (SPLERR_BASE+4007);
+ PMERR_SPL_ERROR_8 = (SPLERR_BASE+4008);
+ PMERR_SPL_ERROR_9 = (SPLERR_BASE+4009);
+ PMERR_SPL_ERROR_10 = (SPLERR_BASE+4010);
+ PMERR_SPL_ERROR_11 = (SPLERR_BASE+4011);
+ PMERR_SPL_ERROR_12 = (SPLERR_BASE+4012);
+ PMERR_SPL_ERROR_13 = (SPLERR_BASE+4013);
+ PMERR_SPL_ERROR_14 = (SPLERR_BASE+4014);
+ PMERR_SPL_ERROR_15 = (SPLERR_BASE+4015);
+ PMERR_SPL_ERROR_16 = (SPLERR_BASE+4016);
+ PMERR_SPL_ERROR_17 = (SPLERR_BASE+4017);
+ PMERR_SPL_ERROR_18 = (SPLERR_BASE+4018);
+ PMERR_SPL_ERROR_19 = (SPLERR_BASE+4019);
+ PMERR_SPL_ERROR_20 = (SPLERR_BASE+4020);
+ PMERR_SPL_ERROR_21 = (SPLERR_BASE+4021);
+ PMERR_SPL_ERROR_22 = (SPLERR_BASE+4022);
+ PMERR_SPL_ERROR_23 = (SPLERR_BASE+4023);
+ PMERR_SPL_ERROR_24 = (SPLERR_BASE+4024);
+ PMERR_SPL_ERROR_25 = (SPLERR_BASE+4025);
+ PMERR_SPL_ERROR_26 = (SPLERR_BASE+4026);
+ PMERR_SPL_ERROR_27 = (SPLERR_BASE+4027);
+ PMERR_SPL_ERROR_28 = (SPLERR_BASE+4028);
+ PMERR_SPL_ERROR_29 = (SPLERR_BASE+4029);
+ PMERR_SPL_ERROR_30 = (SPLERR_BASE+4030);
+ PMERR_SPL_ERROR_31 = (SPLERR_BASE+4031);
+ PMERR_SPL_ERROR_32 = (SPLERR_BASE+4032);
+ PMERR_SPL_ERROR_33 = (SPLERR_BASE+4033);
+ PMERR_SPL_ERROR_34 = (SPLERR_BASE+4034);
+ PMERR_SPL_ERROR_35 = (SPLERR_BASE+4035);
+ PMERR_SPL_ERROR_36 = (SPLERR_BASE+4036);
+ PMERR_SPL_ERROR_37 = (SPLERR_BASE+4037);
+ PMERR_SPL_ERROR_38 = (SPLERR_BASE+4038);
+ PMERR_SPL_ERROR_39 = (SPLERR_BASE+4039);
+ PMERR_SPL_ERROR_40 = (SPLERR_BASE+4040);
+ PMERR_SPLMSGBOX_INFO_CAPTION = (SPLERR_BASE+4041);
+ PMERR_SPLMSGBOX_WARNING_CAPTION = (SPLERR_BASE+4042);
+ PMERR_SPLMSGBOX_ERROR_CAPTION = (SPLERR_BASE+4043);
+ PMERR_SPLMSGBOX_SEVERE_CAPTION = (SPLERR_BASE+4044);
+ PMERR_SPLMSGBOX_JOB_DETAILS = (SPLERR_BASE+4045);
+ PMERR_SPLMSGBOX_ERROR_ACTION = (SPLERR_BASE+4046);
+ PMERR_SPLMSGBOX_SEVERE_ACTION = (SPLERR_BASE+4047);
+ PMERR_SPLMSGBOX_BIT_0_TEXT = (SPLERR_BASE+4048);
+ PMERR_SPLMSGBOX_BIT_1_TEXT = (SPLERR_BASE+4049);
+ PMERR_SPLMSGBOX_BIT_2_TEXT = (SPLERR_BASE+4050);
+ PMERR_SPLMSGBOX_BIT_3_TEXT = (SPLERR_BASE+4051);
+ PMERR_SPLMSGBOX_BIT_4_TEXT = (SPLERR_BASE+4052);
+ PMERR_SPLMSGBOX_BIT_5_TEXT = (SPLERR_BASE+4053);
+ PMERR_SPLMSGBOX_BIT_15_TEXT = (SPLERR_BASE+4054);
+ PMERR_SPL_NOPATHBUFFER = (SPLERR_BASE+4055);
+ PMERR_SPL_ALREADY_INITIALISED = (SPLERR_BASE+4093);
+ PMERR_SPL_ERROR = (SPLERR_BASE+4095);
+ PMERR_INV_TYPE = $5001;
+ PMERR_INV_CONV = $5002;
+ PMERR_INV_SEGLEN = $5003;
+ PMERR_DUP_SEGNAME = $5004;
+ PMERR_INV_XFORM = $5005;
+ PMERR_INV_VIEWLIM = $5006;
+ PMERR_INV_3DCOORD = $5007;
+ PMERR_SMB_OVFLOW = $5008;
+ PMERR_SEG_OVFLOW = $5009;
+ PMERR_PIC_DUP_FILENAME = $5010;
+
+ function WinRegisterClass(hab : cardinal;pszClassName : pchar;pfnWndProc : proc;flStyle,cbWindowData : cardinal) : longbool; cdecl;
+ function WinDefWindowProc(hwnd,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;
+ function WinDestroyWindow(hwnd : cardinal) : longbool; cdecl;
+ function WinShowWindow(hwnd : cardinal;fShow : longbool) : longbool; cdecl;
+ function WinQueryWindowRect(hwnd : cardinal;var rclDest : TRectl) : longbool; cdecl;
+ function WinQueryWindowRect(hwnd : cardinal;prclDest : PRectl) : longbool; cdecl;
+ function WinGetPS(hwnd : cardinal) : cardinal; cdecl;
+ function WinReleasePS(hps : cardinal) : longbool; cdecl;
+ function WinEndPaint(hps : cardinal) : longbool; cdecl;
+ function WinGetClipPS(hwnd,hwndClip,fl : cardinal) : cardinal; cdecl;
+ function WinIsWindowShowing(hwnd : cardinal) : longbool; cdecl;
+ function WinBeginPaint(hwnd,hps : cardinal;var rclPaint : TRectl) : cardinal; cdecl;
+ function WinBeginPaint(hwnd,hps : cardinal;prclPaint: PRectl) : cardinal; cdecl;
+ function WinOpenWindowDC(hwnd : cardinal) : cardinal; cdecl;
+ function WinScrollWindow(hwnd : cardinal;dx,dy : longint;var rclScroll,rclClip : TRectl;hrgnUpdate : cardinal;var rclUpdate : TRectl;rgfsw : cardinal) : longint; cdecl;
+ function WinScrollWindow(hwnd : cardinal;dx,dy : longint;prclScroll,prclClip : PRectl;hrgnUpdate : cardinal;prclUpdate : PRectl;rgfsw : cardinal) : longint; cdecl;
+ function WinFillRect(hps : cardinal;var rcl : TRectl;lColor : longint) : longbool; cdecl;
+ function WinFillRect(hps : cardinal;prcl : PRectl;lColor : longint) : longbool; cdecl;
+ function WinQueryVersion(hab : cardinal) : cardinal; cdecl;
+ function WinInitialize(flOptions : cardinal) : cardinal; cdecl;
+ function WinTerminate(hab : cardinal) : longbool; cdecl;
+ function WinQueryAnchorBlock(hwnd : cardinal) : cardinal; cdecl;
+ function WinCreateWindow(hwndParent : cardinal;pszClass,pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;pCtlData,pPresParams : pointer) : cardinal; cdecl;
+ function WinCreateWindow(hwndParent : cardinal;pszClass : cardinal;pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;pCtlData,pPresParams : pointer) : cardinal; cdecl;
+ function WinCreateWCWindow(hwndParent : cardinal;pszClass : cardinal;pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;pCtlData,pPresParams : pointer) : cardinal; cdecl;
+ function WinEnableWindow(hwnd : cardinal;fEnable : longbool) : longbool; cdecl;
+ function WinIsWindowEnabled(hwnd : cardinal) : longbool; cdecl;
+ function WinEnableWindowUpdate(hwnd : cardinal;fEnable : longbool) : longbool; cdecl;
+ function WinIsWindowVisible(hwnd : cardinal) : longbool; cdecl;
+ function WinQueryWindowText(hwnd : cardinal;cchBufferMax : longint;pchBuffer : pchar) : longint; cdecl;
+ function WinSetWindowText(hwnd : cardinal;pszText : pchar) : longbool; cdecl;
+ function WinQueryWindowTextLength(hwnd : cardinal) : longint; cdecl;
+ function WinWindowFromID(hwndParent,id : cardinal) : cardinal; cdecl;
+ function WinIsWindow(hab,hwnd : cardinal) : longbool; cdecl;
+ function WinQueryWindow(hwnd : cardinal;cmd : longint) : cardinal; cdecl;
+ function WinMultWindowFromIDs(hwndParent : cardinal;var prghwnd : cardinal;idFirst,idLast : cardinal) : longint; cdecl;
+ function WinMultWindowFromIDs(hwndParent : cardinal;prghwnd : PCardinal;idFirst,idLast : cardinal) : longint; cdecl;
+ function WinSetParent(hwnd,hwndNewParent : cardinal;fRedraw : longbool) : longbool; cdecl;
+ function WinIsChild(hwnd,hwndParent : cardinal) : longbool; cdecl;
+ function WinSetOwner(hwnd,hwndNewOwner : cardinal) : longbool; cdecl;
+ function WinQueryWindowProcess(hwnd : cardinal;var _pid,_tid : cardinal) : longbool; cdecl;
+ function WinQueryWindowProcess(hwnd : cardinal;_ppid,_ptid : PCardinal) : longbool; cdecl;
+ function WinQueryObjectWindow(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinQueryDesktopWindow(hab,hdc : cardinal) : cardinal; cdecl;
+ function WinSetWindowPos(hwnd,hwndInsertBehind : cardinal;x,y,cx,cy : longint;fl : cardinal) : longbool; cdecl;
+ function WinSetMultWindowPos(hab : cardinal;var _swp : TSWP;cswp : cardinal) : longbool; cdecl;
+ function WinSetMultWindowPos(hab : cardinal;_pswp : PSWP;cswp : cardinal) : longbool; cdecl;
+ function WinQueryWindowPos(hwnd : cardinal;var _swp : TSWP) : longbool; cdecl;
+ function WinQueryWindowPos(hwnd : cardinal;_pswp : PSWP) : longbool; cdecl;
+ function WinUpdateWindow(hwnd : cardinal) : longbool; cdecl;
+ function WinInvalidateRect(hwnd : cardinal;var wrc : TRectl;fIncludeChildren : longbool) : longbool; cdecl;
+ function WinInvalidateRect(hwnd : cardinal;pwrc : PRectl;fIncludeChildren : longbool) : longbool; cdecl;
+ function WinInvalidateRegion(hwnd,hrgn : cardinal;fIncludeChildren : longbool) : longbool; cdecl;
+ function WinInvertRect(hps : cardinal;var rcl : TRectl) : longbool; cdecl;
+ function WinInvertRect(hps : cardinal;prcl : PRectl) : longbool; cdecl;
+ function WinDrawBitmap(hpsDst,hbm : cardinal;var wrcSrc : TRectl;var ptlDst : POINTL;clrFore : longint;clrBack : longint;fl : cardinal) : longbool; cdecl;
+ function WinDrawBitmap(hpsDst,hbm : cardinal;pwrcSrc : PRectl;pptlDst : PPOINTL;clrFore : longint;clrBack : longint;fl : cardinal) : longbool; cdecl;
+ function WinDrawText(hps : cardinal;cchText : longint;lpchText : pchar;var rcl : TRectl;clrFore,clrBack : longint;flCmd : cardinal) : longint; cdecl;
+ function WinDrawText(hps : cardinal;cchText : longint;lpchText : pchar;prcl : PRectl;clrFore,clrBack : longint;flCmd : cardinal) : longint; cdecl;
+ function WinDrawBorder(hps : cardinal;var rcl : TRectl;cx,cy : longint;clrFore,clrBack : longint;flCmd : cardinal) : longbool; cdecl;
+ function WinDrawBorder(hps : cardinal;prcl : PRectl;cx,cy : longint;clrFore,clrBack : longint;flCmd : cardinal) : longbool; cdecl;
+ function WinLoadString(hab,hmod,id : cardinal;cchMax : longint;pchBuffer : pchar) : longint; cdecl;
+ function WinLoadMessage(hab,hmod,id : cardinal;cchMax : longint;pchBuffer : pchar) : longint; cdecl;
+ function WinSetActiveWindow(hwndDesktop,hwnd : cardinal) : longbool; cdecl;
+ function WinSubclassWindow(hwnd : cardinal;pfnwp : proc) : proc; cdecl;
+ function WinQueryClassName(hwnd : cardinal;cchMax : longint;pch : pchar) : longint; cdecl;
+ function WinQueryClassInfo(hab : cardinal;pszClassName : pchar;var _ClassInfo : TClassInfo) : longbool; cdecl;
+ function WinQueryClassInfo(hab : cardinal;pszClassName : pchar;_PClassInfo : PClassInfo) : longbool; cdecl;
+ function WinQueryActiveWindow(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinIsThreadActive(hab : cardinal) : longbool; cdecl;
+ function WinQuerySysModalWindow(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinSetSysModalWindow(hwndDesktop,hwnd : cardinal) : longbool; cdecl;
+ function WinQueryWindowUShort(hwnd : cardinal;index : longint) : word; cdecl;
+ function WinSetWindowUShort(hwnd : cardinal;index : longint;us : word) : longbool; cdecl;
+ function WinQueryWindowULong(hwnd : cardinal;index : longint) : cardinal; cdecl;
+ function WinSetWindowULong(hwnd : cardinal;index : longint;ul : cardinal) : longbool; cdecl;
+ function WinQueryWindowPtr(hwnd : cardinal;index : longint) : pointer; cdecl;
+ function WinSetWindowPtr(hwnd : cardinal;index : longint;p : pointer) : longbool; cdecl;
+ function WinSetWindowBits(hwnd : cardinal;index : longint;flData,flMask : cardinal) : longbool; cdecl;
+ function WinBeginEnumWindows(hwnd : cardinal) : cardinal; cdecl;
+ function WinGetNextWindow(henum : cardinal) : cardinal; cdecl;
+ function WinEndEnumWindows(henum : cardinal) : longbool; cdecl;
+ function WinWindowFromPoint(hwnd : cardinal;var ptl : TPointL;fChildren : longbool) : cardinal; cdecl;
+ function WinWindowFromPoint(hwnd : cardinal;pptl : PPointL;fChildren : longbool) : cardinal; cdecl;
+ function WinMapWindowPoints(hwndFrom,hwndTo : cardinal;var prgptl : TPointL;cwpt : longint) : longbool; cdecl;
+ function WinMapWindowPoints(hwndFrom,hwndTo : cardinal;prgptl : PPointL;cwpt : longint) : longbool; cdecl;
+ function WinValidateRect(hwnd : cardinal;var rcl : TRectl;fIncludeChildren : longbool) : longbool; cdecl;
+ function WinValidateRect(hwnd : cardinal;prcl : PRectl;fIncludeChildren : longbool) : longbool; cdecl;
+ function WinValidateRegion(hwnd,hrgn : cardinal;fIncludeChildren : longbool) : longbool; cdecl;
+ function WinWindowFromDC(hdc : cardinal) : cardinal; cdecl;
+ function WinQueryWindowDC(hwnd : cardinal) : cardinal; cdecl;
+ function WinGetScreenPS(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinLockWindowUpdate(hwndDesktop,hwndLockUpdate : cardinal) : longbool; cdecl;
+ function WinLockVisRegions(hwndDesktop : cardinal;fLock : longbool) : longbool; cdecl;
+ function WinQueryUpdateRect(hwnd : cardinal;var rcl : TRectl) : longbool; cdecl;
+ function WinQueryUpdateRect(hwnd : cardinal;prcl : PRectl) : longbool; cdecl;
+ function WinQueryUpdateRegion(hwnd,hrgn : cardinal) : longint; cdecl;
+ function WinExcludeUpdateRegion(hps,hwnd : cardinal) : longint; cdecl;
+ function WinSendMsg(hwnd,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;
+ function WinCreateMsgQueue(hab : cardinal;cmsg : longint) : cardinal; cdecl;
+ function WinDestroyMsgQueue(hmq : cardinal) : longbool; cdecl;
+ function WinQueryQueueInfo(hmq : cardinal;var mqi : TMQInfo;cbCopy : cardinal) : longbool; cdecl;
+ function WinQueryQueueInfo(hmq : cardinal;pmqi : PMQInfo;cbCopy : cardinal) : longbool; cdecl;
+ function WinCancelShutdown(hmq : cardinal;fCancelAlways : longbool) : longbool; cdecl;
+ function WinGetMsg(hab : cardinal;var _qmsg : TQMsg;hwndFilter,msgFilterFirst,msgFilterLast : cardinal) : longbool; cdecl;
+ function WinGetMsg(hab : cardinal;_pqmsg : PQMsg;hwndFilter,msgFilterFirst,msgFilterLast : cardinal) : longbool; cdecl;
+ function WinPeekMsg(hab : cardinal;var _qmsg : TQMsg;hwndFilter,msgFilterFirst,msgFilterLast,fl : cardinal) : longbool; cdecl;
+ function WinPeekMsg(hab : cardinal;_pqmsg : PQMsg;hwndFilter,msgFilterFirst,msgFilterLast,fl : cardinal) : longbool; cdecl;
+ function WinDispatchMsg(hab : cardinal;var _qmsg : TQMsg) : pointer; cdecl;
+ function WinDispatchMsg(hab : cardinal;_pqmsg : PQMsg) : pointer; cdecl;
+ function WinPostMsg(hwnd,msg : cardinal;mp1,mp2 : pointer) : longbool; cdecl;
+ function WinRegisterUserMsg(hab,msgid : cardinal;datatype1,dir1,datatype2,dir2,datatyper : longint) : longbool; cdecl;
+ function WinRegisterUserDatatype(hab : cardinal;datatype,count : longint;var types : longint) : longbool; cdecl;
+ function WinSetMsgMode(hab : cardinal;classname : pchar;control : longint) : longbool; cdecl;
+ function WinSetSynchroMode(hab : cardinal;mode : longint) : longbool; cdecl;
+ function WinInSendMsg(hab : cardinal) : longbool; cdecl;
+ function WinBroadcastMsg(hwnd,msg : cardinal;mp1,mp2 : pointer;rgf : cardinal) : longbool; cdecl;
+ function WinWaitMsg(hab,msgFirst,msgLast : cardinal) : longbool; cdecl;
+ function WinQueryQueueStatus(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinQueryMsgPos(hab : cardinal;var ptl : TPointL) : longbool; cdecl;
+ function WinQueryMsgPos(hab : cardinal;pptl : PPointL) : longbool; cdecl;
+ function WinQueryMsgTime(hab : cardinal) : cardinal; cdecl;
+ function WinWaitEventSem(hev,ulTimeout : cardinal) : cardinal; cdecl;
+ function WinRequestMutexSem(hmtx,ulTimeout : cardinal) : cardinal; cdecl;
+ function WinWaitMuxWaitSem(hmux,ulTimeout:cardinal;var ulUser : cardinal) : cardinal; cdecl;
+ function WinWaitMuxWaitSem(hmux,ulTimeout:cardinal;pulUser : PCardinal) : cardinal; cdecl;
+ function WinPostQueueMsg(hmq,msg : cardinal;mp1,mp2 : pointer) : longbool; cdecl;
+ function WinSetMsgInterest(hwnd,msg_class : cardinal;control : longint) : longbool; cdecl;
+ function WinSetClassMsgInterest(hab : cardinal;pszClassName : pchar;msg_class : cardinal;control : longint) : longbool; cdecl;
+ function WinSetFocus(hwndDesktop,hwndSetFocus : cardinal) : longbool; cdecl;
+ function WinFocusChange(hwndDesktop,hwndSetFocus,flFocusChange : cardinal) : longbool; cdecl;
+ function WinSetCapture(hwndDesktop,hwnd : cardinal) : longbool; cdecl;
+ function WinQueryCapture(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinQueryFocus(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinGetKeyState(hwndDesktop : cardinal;vkey : longint) : longint; cdecl;
+ function WinGetPhysKeyState(hwndDesktop : cardinal;sc : longint) : longint; cdecl;
+ function WinEnablePhysInput(hwndDesktop : cardinal;fEnable : longbool) : longbool; cdecl;
+ function WinIsPhysInputEnabled(hwndDesktop : cardinal) : longbool; cdecl;
+ function WinSetKeyboardStateTable(hwndDesktop : cardinal;var KeyStateTable;fSet : longbool) : longbool; cdecl;
+ function WinSetKeyboardStateTable(hwndDesktop : cardinal;pKeyStateTable : pointer;fSet : longbool) : longbool; cdecl;
+ function WinGetDlgMsg(hwndDlg : cardinal;var _qmsg : TQMsg) : longbool; cdecl;
+ function WinGetDlgMsg(hwndDlg : cardinal;_pqmsg : PQMsg) : longbool; cdecl;
+ function WinLoadDlg(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;hmod,idDlg : cardinal;pCreateParams : pointer) : cardinal; cdecl;
+ function WinDlgBox(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;hmod,idDlg : cardinal;pCreateParams : pointer) : cardinal; cdecl;
+ function WinDismissDlg(hwndDlg,usResult : cardinal) : longbool; cdecl;
+ function WinQueryDlgItemShort(hwndDlg,idItem : cardinal;var _Result : integer;fSigned : longbool) : longbool; cdecl;
+ function WinQueryDlgItemShort(hwndDlg,idItem : cardinal;PResult : PInteger;fSigned : longbool) : longbool; cdecl;
+ function WinSetDlgItemShort(hwndDlg,idItem : cardinal;usValue : word;fSigned : longbool) : longbool; cdecl;
+ function WinSetDlgItemText(hwndDlg,idItem : cardinal;pszText : pchar) : longbool; cdecl;
+ function WinQueryDlgItemText(hwndDlg,idItem : cardinal;cchBufferMax : longint;pchBuffer : pchar) : cardinal; cdecl;
+ function WinQueryDlgItemTextLength(hwndDlg,idItem : cardinal) : longint; cdecl;
+ function WinDefDlgProc(hwndDlg,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;
+ function WinAlarm(hwndDesktop,rgfType : cardinal) : longbool; cdecl;
+ function WinMessageBox(hwndParent,hwndOwner : cardinal;pszText,pszCaption : pchar;idWindow,flStyle : cardinal) : cardinal; cdecl;
+(*
+ function WinMessageBox2(hwndParent,hwndOwner: cardinal;pszText,pszCaption: PChar; idWindow: cardinal; MBInfo: PMB2Info): cardinal; cdecl;
+*)
+ function WinProcessDlg(hwndDlg : cardinal) : cardinal; cdecl;
+ function WinSendDlgItemMsg(hwndDlg,idItem,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;
+ function WinMapDlgPoints(hwndDlg : cardinal;var prgwptl : TPointL;cwpt : cardinal;fCalcWindowCoords : longbool) : longbool; cdecl;
+ function WinMapDlgPoints(hwndDlg : cardinal;prgwptl : PPointL;cwpt : cardinal;fCalcWindowCoords : longbool) : longbool; cdecl;
+ function WinEnumDlgItem(hwndDlg,hwnd,code : cardinal) : cardinal; cdecl;
+ function WinSubstituteStrings(hwnd : cardinal;pszSrc : pchar;cchDstMax : longint;pszDst : pchar) : longint; cdecl;
+ function WinCreateDlg(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;var dlgt : TDlgTemplate;pCreateParams : pointer) : cardinal; cdecl;
+ function WinCreateDlg(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;pdlgt : PDlgTemplate;pCreateParams : pointer) : cardinal; cdecl;
+ function WinLoadMenu(hwndFrame,hmod,idMenu : cardinal) : cardinal; cdecl;
+ function WinCreateMenu(hwndParent : cardinal;lpmt : pointer) : cardinal; cdecl;
+ function WinPopupMenu(hwndParent,hwndOwner,hwndMenu : cardinal;x,y,idItem : longint;fs : cardinal) : longbool; cdecl;
+ function WinCreateStdWindow(hwndParent,flStyle : cardinal;var flCreateFlags : cardinal;pszClientClass,pszTitle : pchar;styleClient,hmod,idResources : cardinal;var hwndClient : cardinal) : cardinal; cdecl;
+ function WinCreateStdWindow(hwndParent,flStyle : cardinal;pflCreateFlags : PCardinal;pszClientClass,pszTitle : pchar;styleClient,hmod,idResources : cardinal;phwndClient : PCardinal) : cardinal; cdecl;
+ function WinFlashWindow(hwndFrame : cardinal;fFlash : longbool) : longbool; cdecl;
+ function WinCreateFrameControls(hwndFrame : cardinal;var fcdata : TFrameCData;pszTitle : pchar) : longbool; cdecl;
+ function WinCreateFrameControls(hwndFrame : cardinal;pfcdata : PFrameCData;pszTitle : pchar) : longbool; cdecl;
+ function WinCalcFrameRect(hwndFrame : cardinal;var rcl : TRectl;fClient : longbool) : longbool; cdecl;
+ function WinCalcFrameRect(hwndFrame : cardinal;prcl : PRectl;fClient : longbool) : longbool; cdecl;
+ function WinGetMinPosition(hwnd : cardinal;var _swp : TSWP;var pptl : POINTL) : longbool; cdecl;
+ function WinGetMinPosition(hwnd : cardinal;_pswp : PSWP;var pptl : POINTL) : longbool; cdecl;
+ function WinGetMaxPosition(hwnd : cardinal;var _swp : TSWP) : longbool; cdecl;
+ function WinGetMaxPosition(hwnd : cardinal;_pswp : PSWP) : longbool; cdecl;
+ function WinSaveWindowPos(hsvwp : cardinal;var _swp : TSWP;cswp : cardinal) : longbool; cdecl;
+ function WinSaveWindowPos(hsvwp : cardinal;_pswp : PSWP;cswp : cardinal) : longbool; cdecl;
+ function WinCopyRect(hab : cardinal;var rclDst, rclSrc : TRectl) : longbool; cdecl;
+ function WinCopyRect(hab : cardinal;prclDst, prclSrc : PRectl) : longbool; cdecl;
+ function WinSetRect(hab : cardinal;var rcl : TRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;
+ function WinSetRect(hab : cardinal;_prcl : PRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;
+ function WinIsRectEmpty(hab : cardinal;var rcl : TRectl) : longbool; cdecl;
+ function WinIsRectEmpty(hab : cardinal;prcl : PRectl) : longbool; cdecl;
+ function WinEqualRect(hab : cardinal;var rcl1,rcl2 : TRectl) : longbool; cdecl;
+ function WinEqualRect(hab : cardinal;prcl1,prcl2 : PRectl) : longbool; cdecl;
+ function WinSetRectEmpty(hab : cardinal;var rcl : TRectl) : longbool; cdecl;
+ function WinSetRectEmpty(hab : cardinal;prcl : PRectl) : longbool; cdecl;
+ function WinOffsetRect(hab : cardinal;var rcl : TRectl;cx,cy : longint) : longbool; cdecl;
+ function WinOffsetRect(hab : cardinal;prcl : PRectl;cx,cy : longint) : longbool; cdecl;
+ function WinInflateRect(hab : cardinal;var rcl : TRectl;cx,cy : longint) : longbool; cdecl;
+ function WinInflateRect(hab : cardinal;prcl : PRectl;cx,cy : longint) : longbool; cdecl;
+ function WinPtInRect(hab : cardinal;var rcl : TRectl;var ptl : TPointL) : longbool; cdecl;
+ function WinPtInRect(hab : cardinal;prcl : PRectl;pptl : PPointL) : longbool; cdecl;
+ function WinIntersectRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;
+ function WinIntersectRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;
+ function WinUnionRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;
+ function WinUnionRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;
+ function WinSubtractRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;
+ function WinSubtractRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;
+ function WinMakeRect(hab : cardinal;var wrc : TRectl) : longbool; cdecl;
+ function WinMakeRect(hab : cardinal;pwrc : PRectl) : longbool; cdecl;
+ function WinMakePoints(hab : cardinal;var wpt : TPointL;cwpt : cardinal) : longbool; cdecl;
+ function WinMakePoints(hab : cardinal;pwpt : PPointL;cwpt : cardinal) : longbool; cdecl;
+ function WinQuerySysValue(hwndDesktop : cardinal;iSysValue : longint) : longint; cdecl;
+ function WinSetSysValue(hwndDesktop : cardinal;iSysValue,lValue : longint) : longbool; cdecl;
+ function WinSetPresParam(hwnd,id,cbParam : cardinal;pbParam : pointer) : longbool; cdecl;
+ function WinQueryPresParam(hwnd,id1,id2 : cardinal;var ulId : cardinal;cbBuf : cardinal;pbBuf : pointer;fs : cardinal) : cardinal; cdecl;
+ function WinQueryPresParam(hwnd,id1,id2 : cardinal;pulId : PCardinal;cbBuf : cardinal;pbBuf : pointer;fs : cardinal) : cardinal; cdecl;
+ function WinRemovePresParam(hwnd,id : cardinal) : longbool; cdecl;
+ function WinQuerySysColor(hwndDesktop : cardinal;clr,lReserved : longint) : longint; cdecl;
+ function WinSetSysColors(hwndDesktop,flOptions,flFormat : cardinal;clrFirst : longint;cclr : cardinal;var clr : longint) : longbool; cdecl;
+ function WinSetSysColors(hwndDesktop,flOptions,flFormat : cardinal;clrFirst : longint;cclr : cardinal;pclr : PLongint) : longbool; cdecl;
+ function WinStartTimer(hab,hwnd,idTimer,dtTimeout : cardinal) : cardinal; cdecl;
+ function WinStopTimer(hab,hwnd,idTimer : cardinal) : longbool; cdecl;
+ function WinGetCurrentTime(hab : cardinal) : cardinal; cdecl;
+ function WinLoadAccelTable(hab,hmod,idAccelTable : cardinal) : cardinal; cdecl;
+ function WinCopyAccelTable(haccel : cardinal;var _AccelTable : TAccelTable;cbCopyMax : cardinal) : cardinal; cdecl;
+ function WinCopyAccelTable(haccel : cardinal;_pAccelTable : PAccelTable;cbCopyMax : cardinal) : cardinal; cdecl;
+ function WinCreateAccelTable(hab : cardinal;var _AccelTable : TAccelTable) : cardinal; cdecl;
+ function WinCreateAccelTable(hab : cardinal;_pAccelTable : PAccelTable) : cardinal; cdecl;
+ function WinDestroyAccelTable(haccel : cardinal) : longbool; cdecl;
+ function WinTranslateAccel(hab,hwnd,haccel : cardinal;var _qmsg : TQMsg) : longbool; cdecl;
+ function WinTranslateAccel(hab,hwnd,haccel : cardinal;_pqmsg : PQMsg) : longbool; cdecl;
+ function WinSetAccelTable(hab,haccel,hwndFrame : cardinal) : longbool; cdecl;
+ function WinQueryAccelTable(hab,hwndFrame : cardinal) : cardinal; cdecl;
+ function WinTrackRect(hwnd,hps : cardinal;var ti : TTrackInfo) : longbool; cdecl;
+ function WinTrackRect(hwnd,hps : cardinal;pti : PTrackInfo) : longbool; cdecl;
+ function WinShowTrackRect(hwnd : cardinal;fShow : longbool) : longbool; cdecl;
+ function WinSetClipbrdOwner(hab,hwnd : cardinal) : longbool; cdecl;
+ function WinSetClipbrdData(hab,ulData,fmt,rgfFmtInfo : cardinal) : longbool; cdecl;
+ function WinQueryClipbrdData(hab,fmt : cardinal) : cardinal; cdecl;
+ function WinQueryClipbrdFmtInfo(hab,fmt : cardinal;var prgfFmtInfo : cardinal) : longbool; cdecl;
+ function WinQueryClipbrdFmtInfo(hab,fmt : cardinal;prgfFmtInfo : PCardinal) : longbool; cdecl;
+ function WinSetClipbrdViewer(hab,hwndNewClipViewer : cardinal) : longbool; cdecl;
+ function WinEnumClipbrdFmts(hab,fmt : cardinal) : cardinal; cdecl;
+ function WinEmptyClipbrd(hab : cardinal) : longbool; cdecl;
+ function WinOpenClipbrd(hab : cardinal) : longbool; cdecl;
+ function WinCloseClipbrd(hab : cardinal) : longbool; cdecl;
+ function WinQueryClipbrdOwner(hab : cardinal) : cardinal; cdecl;
+ function WinQueryClipbrdViewer(hab : cardinal) : cardinal; cdecl;
+ function WinDestroyCursor(hwnd : cardinal) : longbool; cdecl;
+ function WinShowCursor(hwnd : cardinal;fShow : longbool) : longbool; cdecl;
+ function WinCreateCursor(hwnd : cardinal;x,y,cx,cy : longint;fs : cardinal;var rclClip : TRectl) : longbool; cdecl;
+ function WinCreateCursor(hwnd : cardinal;x,y,cx,cy : longint;fs : cardinal;prclClip : PRectl) : longbool; cdecl;
+ function WinQueryCursorInfo(hwndDesktop : cardinal;var _CursorInfo : TCursorInfo) : longbool; cdecl;
+ function WinQueryCursorInfo(hwndDesktop : cardinal;_pCursorInfo : PCursorInfo) : longbool; cdecl;
+ function WinSetPointer(hwndDesktop,hptrNew : cardinal) : longbool; cdecl;
+ function WinSetPointerOwner(hptr,pid : cardinal;fDestroy : longbool) : longbool; cdecl;
+ function WinShowPointer(hwndDesktop : cardinal;fShow : longbool) : longbool; cdecl;
+ function WinQuerySysPointer(hwndDesktop : cardinal;iptr : longint;fLoad : longbool) : cardinal; cdecl;
+ function WinLoadPointer(hwndDesktop,hmod,idres : cardinal) : cardinal; cdecl;
+ function WinCreatePointer(hwndDesktop,hbmPointer : cardinal;fPointer : longbool;xHotspot,yHotspot : longint) : cardinal; cdecl;
+ function WinSetPointerPos(hwndDesktop : cardinal;x,y : longint) : longbool; cdecl;
+ function WinDestroyPointer(hptr : cardinal) : longbool; cdecl;
+ function WinQueryPointer(hwndDesktop : cardinal) : cardinal; cdecl;
+ function WinQueryPointerPos(hwndDesktop : cardinal;var ptl : TPointL) : longbool; cdecl;
+ function WinQueryPointerPos(hwndDesktop : cardinal;pptl : PPointL) : longbool; cdecl;
+ function WinCreatePointerIndirect(hwndDesktop : cardinal;var ptri : TPointerInfo) : cardinal; cdecl;
+ function WinCreatePointerIndirect(hwndDesktop : cardinal;pptri : PPointerInfo) : cardinal; cdecl;
+ function WinQueryPointerInfo(hptr : cardinal;var _PointerInfo : TPointerInfo) : longbool; cdecl;
+ function WinQueryPointerInfo(hptr : cardinal;_pPointerInfo : PPointerInfo) : longbool; cdecl;
+ function WinDrawPointer(hps : cardinal;x,y : longint;hptr,fs : cardinal) : longbool; cdecl;
+ function WinGetSysBitmap(hwndDesktop,ibm : cardinal) : cardinal; cdecl;
+ function WinSetHook(hab : cardinal;hmq : cardinal;iHook : longint;pfnHook : pointer;hmod : cardinal) : longbool; cdecl;
+ function WinReleaseHook(hab,hmq : cardinal;iHook : longint;pfnHook : pointer;hmod : cardinal) : longbool; cdecl;
+ function WinCallMsgFilter(hab : cardinal;var _qmsg : TQMsg;msgf : cardinal) : longbool; cdecl;
+ function WinCallMsgFilter(hab : cardinal;_pqmsg : PQMsg;msgf : cardinal) : longbool; cdecl;
+ function WinSetClassThunkProc(pszClassname : pchar;pfnThunkProc : pointer) : longbool; cdecl;
+ function WinQueryClassThunkProc(pszClassname : pchar) : pointer; cdecl;
+ function WinSetWindowThunkProc(hwnd : cardinal;pfnThunkProc : pointer) : longbool; cdecl;
+ function WinQueryWindowThunkProc(hwnd : cardinal) : pointer; cdecl;
+ function WinQueryWindowModel(hwnd : cardinal) : longint; cdecl;
+ function WinQueryCp(hmq : cardinal) : cardinal; cdecl;
+ function WinSetCp(hmq,idCodePage : cardinal) : longbool; cdecl;
+ function WinQueryCpList(hab,ccpMax : cardinal;var prgcp : cardinal) : cardinal; cdecl;
+ function WinQueryCpList(hab,ccpMax : cardinal;prgcp : PCardinal) : cardinal; cdecl;
+ function WinCpTranslateString(hab,cpSrc : cardinal;pszSrc : pchar;cpDst,cchDestMax : cardinal;pchDest : pchar) : longbool; cdecl;
+ function WinCpTranslateChar(hab,cpSrc : cardinal;chSrc : byte;cpDst : cardinal) : byte; cdecl;
+ function WinUpper(hab,idcp,idcc : cardinal;psz : pchar) : cardinal; cdecl;
+ function WinUpperChar(hab,idcp,idcc,c : cardinal) : cardinal; cdecl;
+ function WinNextChar(hab,idcp,idcc : cardinal;psz : pchar) : pchar; cdecl;
+ function WinPrevChar(hab,idcp,idcc : cardinal;pszStart,psz : pchar) : pchar; cdecl;
+ function WinCompareStrings(hab,idcp,idcc : cardinal;psz1,psz2 : pchar;reserved : cardinal) : cardinal; cdecl;
+ function WinCreateAtomTable(cbInitial,cBuckets : cardinal) : cardinal; cdecl;
+ function WinDestroyAtomTable(hAtomTbl : cardinal) : cardinal; cdecl;
+ function WinAddAtom(hAtomTbl : cardinal;pszAtomName : pchar) : cardinal; cdecl;
+ function WinFindAtom(hAtomTbl : cardinal;pszAtomName : pchar) : cardinal; cdecl;
+ function WinDeleteAtom(hAtomTbl,atom : cardinal) : cardinal; cdecl;
+ function WinQueryAtomUsage(hAtomTbl,atom : cardinal) : cardinal; cdecl;
+ function WinQueryAtomLength(hAtomTbl,atom : cardinal) : cardinal; cdecl;
+ function WinQueryAtomName(hAtomTbl,atom : cardinal;pchBuffer : pchar;cchBufferMax : cardinal) : cardinal; cdecl;
+ function WinGetLastError(hab : cardinal) : cardinal; cdecl;
+ function WinGetErrorInfo(hab : cardinal) : PERRINFO; cdecl;
+ function WinFreeErrorInfo(var perrinfo : ERRINFO) : longbool; cdecl;
+ {DDE Functions}
+ function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;var cctxt : TConvContext) : longbool; cdecl;
+ function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;pcctxt : PConvContext) : longbool; cdecl;
+ function WinDdeRespond(hwndClient,hwndServer : cardinal;pszAppName,pszTopicName : pchar;var cctxt : TConvContext) : pointer; cdecl;
+ function WinDdeRespond(hwndClient,hwndServer : cardinal;pszAppName,pszTopicName : pchar;pcctxt : PConvContext) : pointer; cdecl;
+ function WinDdePostMsg(hwndTo,hwndFrom,wm : cardinal;var ddest : TDDEStruct;flOptions : cardinal) : longbool; cdecl;
+ function WinDdePostMsg(hwndTo,hwndFrom,wm : cardinal;pddest : PDDEStruct;flOptions : cardinal) : longbool; cdecl;
+ {Library related functions}
+ function WinDeleteProcedure(hab : cardinal;wndproc : proc) : longbool; cdecl;
+ function WinDeleteLibrary(hab,libhandle : cardinal) : longbool; cdecl;
+ function WinLoadProcedure(hab,libhandle : cardinal;procname : pchar) : proc; cdecl;
+ function WinLoadLibrary(hab : cardinal;libname : pchar) : cardinal; cdecl;
+ function WinSetDesktopBkgnd(hwndDesktop : cardinal;var dskNew : TDesktop) : cardinal; cdecl;
+ function WinSetDesktopBkgnd(hwndDesktop : cardinal;pdskNew : PDesktop) : cardinal; cdecl;
+ function WinQueryDesktopBkgnd(hwndDesktop : cardinal;var dsk : TDesktop) : longbool; cdecl;
+ function WinQueryDesktopBkgnd(hwndDesktop : cardinal;pdsk : PDesktop) : longbool; cdecl;
+ function WinRealizePalette(hwnd,hps : cardinal;var cclr : cardinal) : longint; cdecl;
+ function WinRealizePalette(hwnd,hps : cardinal;pcclr : PCardinal) : longint; cdecl;
+ function WinQuerySystemAtomTable: cardinal; cdecl;
+ function CardinalFromMP (MP: pointer): cardinal; cdecl;
+ function Integer1FromMP (MP: pointer): word; cdecl;
+ function Integer2FromMP (MP: pointer): word; cdecl;
+
+const
+ SEI_BREAKPOINT =$8000; // Always enter an INT 3 breakpt
+ SEI_NOBEEP =$4000; // Do not call DosBeep
+ SEI_NOPROMPT =$2000; // Do not prompt the user
+ SEI_DBGRSRVD =$1000; // Reserved for debug use
+
+ SEI_STACKTRACE =$0001; // save the stack trace
+ SEI_REGISTERS =$0002; // save the registers
+ SEI_ARGCOUNT =$0004; // first USHORT in args is arg count
+ SEI_DOSERROR =$0008; // first USHORT in args is OS2 error code
+ SEI_RESERVED =$0FE0; // Reserved for future use
+
+ SEI_DEBUGONLY = (SEI_BREAKPOINT or SEI_NOBEEP or SEI_NOPROMPT or SEI_RESERVED);
+
+//****************************************************************************
+//* Note that when SEI_ARGCOUNT, SEI_DOSERROR are specified
+//* together, then the implied order of the parameters is:
+//*
+//*
+//* WinSetErrorInfo( MAKEERRORID( .... ),
+//* SEI_ARGCOUNT | SEI_DOSERROR,
+//* argCount,
+//* dosErrorCode);
+//*
+//****************************************************************************/
+
+//ERRORID APIENTRY WinSetErrorInfo(ERRORID, ULONG, ...);
+Function WinSetErrorInfo(ErrID: ErrorID; Flags: Cardinal; Params: Array of const): ErrorID; external 'pmwin' index 263;
+
+ implementation
+
+ function WinRegisterClass(hab : cardinal;pszClassName : pchar;pfnWndProc : proc;flStyle,cbWindowData : cardinal) : longbool; cdecl;external 'pmwin' index 926;
+ function WinDefWindowProc(hwnd,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;external 'pmwin' index 911;
+ function WinDestroyWindow(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 728;
+ function WinShowWindow(hwnd : cardinal;fShow : longbool) : longbool; cdecl;external 'pmwin' index 883;
+ function WinQueryWindowRect(hwnd : cardinal;var rclDest : TRectl) : longbool; cdecl;external 'pmwin' index 840;
+ function WinQueryWindowRect(hwnd : cardinal;prclDest : PRectl) : longbool; cdecl;external 'pmwin' index 840;
+ function WinGetPS(hwnd : cardinal) : cardinal; cdecl;external 'pmwin' index 757;
+ function WinReleasePS(hps : cardinal) : longbool; cdecl;external 'pmwin' index 848;
+ function WinEndPaint(hps : cardinal) : longbool; cdecl;external 'pmwin' index 738;
+ function WinGetClipPS(hwnd,hwndClip,fl : cardinal) : cardinal; cdecl;external 'pmwin' index 749;
+ function WinIsWindowShowing(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 774;
+ function WinBeginPaint(hwnd,hps : cardinal; var rclPaint : TRectl) : cardinal; cdecl;external 'pmwin' index 703;
+ function WinBeginPaint(hwnd,hps : cardinal; prclPaint : PRectl) : cardinal; cdecl;external 'pmwin' index 703;
+ function WinOpenWindowDC(hwnd : cardinal) : cardinal; cdecl;external 'pmwin' index 794;
+ function WinScrollWindow(hwnd : cardinal;dx,dy : longint;var rclScroll,rclClip : TRectl;hrgnUpdate : cardinal;var rclUpdate : TRectl;rgfsw : cardinal) : longint; cdecl;external 'pmwin' index 849;
+ function WinScrollWindow(hwnd : cardinal;dx,dy : longint;prclScroll,prclClip : PRectl;hrgnUpdate : cardinal;prclUpdate : PRectl;rgfsw : cardinal) : longint; cdecl;external 'pmwin' index 849;
+ function WinFillRect(hps : cardinal;var rcl : TRectl;lColor : longint) : longbool; cdecl;external 'pmwin' index 743;
+ function WinFillRect(hps : cardinal;prcl : PRectl;lColor : longint) : longbool; cdecl;external 'pmwin' index 743;
+ function WinQueryVersion(hab : cardinal) : cardinal; cdecl;external 'pmwin' index 833;
+ function WinInitialize(flOptions : cardinal) : cardinal; cdecl;external 'pmwin' index 763;
+ function WinTerminate(hab : cardinal) : longbool; cdecl;external 'pmwin' index 888;
+ function WinQueryAnchorBlock(hwnd : cardinal) : cardinal; cdecl;external 'pmwin' index 800;
+ function WinCreateWindow(hwndParent : cardinal;pszClass,pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;pCtlData,pPresParams : pointer) : cardinal; cdecl;external 'pmwin' index 909;
+ function WinCreateWindow(hwndParent : cardinal;pszClass : cardinal;pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;pCtlData,pPresParams : pointer) : cardinal; cdecl;external 'pmwin' index 909;
+ function WinCreateWCWindow(hwndParent : cardinal;pszClass : cardinal;pszName : pchar;flStyle : cardinal;x,y,cx,cy : longint;hwndOwner,hwndInsertBehind,id : cardinal;pCtlData,pPresParams : pointer) : cardinal; cdecl;external 'pmwin' index 909;
+ function WinEnableWindow(hwnd : cardinal;fEnable : longbool) : longbool; cdecl;external 'pmwin' index 735;
+ function WinIsWindowEnabled(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 773;
+ function WinEnableWindowUpdate(hwnd : cardinal;fEnable : longbool) : longbool; cdecl;external 'pmwin' index 736;
+ function WinIsWindowVisible(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 775;
+ function WinQueryWindowText(hwnd : cardinal;cchBufferMax : longint; pchBuffer : pchar) : longint; cdecl;external 'pmwin' index 841;
+ function WinSetWindowText(hwnd : cardinal;pszText : pchar) : longbool; cdecl;external 'pmwin' index 877;
+ function WinQueryWindowTextLength(hwnd : cardinal) : longint; cdecl;external 'pmwin' index 842;
+ function WinWindowFromID(hwndParent,id : cardinal) : cardinal; cdecl;external 'pmwin' index 899;
+ function WinIsWindow(hab,hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 772;
+ function WinQueryWindow(hwnd : cardinal;cmd : longint) : cardinal; cdecl;external 'pmwin' index 834;
+ function WinMultWindowFromIDs(hwndParent : cardinal;var prghwnd : cardinal;idFirst,idLast : cardinal) : longint; cdecl;external 'pmwin' index 917;
+ function WinMultWindowFromIDs(hwndParent : cardinal;prghwnd : PCardinal;idFirst,idLast : cardinal) : longint; cdecl;external 'pmwin' index 917;
+ function WinSetParent(hwnd,hwndNewParent : cardinal;fRedraw : longbool) : longbool; cdecl;external 'pmwin' index 865;
+ function WinIsChild(hwnd,hwndParent : cardinal) : longbool; cdecl;external 'pmwin' index 768;
+ function WinSetOwner(hwnd,hwndNewOwner : cardinal) : longbool; cdecl;external 'pmwin' index 864;
+ function WinQueryWindowProcess(hwnd : cardinal;var _pid,_tid : cardinal) : longbool; cdecl;external 'pmwin' index 838;
+ function WinQueryWindowProcess(hwnd : cardinal;_ppid,_ptid : PCardinal) : longbool; cdecl;external 'pmwin' index 838;
+ function WinQueryObjectWindow(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 820;
+ function WinQueryDesktopWindow(hab,hdc : cardinal) : cardinal; cdecl;external 'pmwin' index 813;
+ function WinSetWindowPos(hwnd,hwndInsertBehind : cardinal;x,y,cx,cy : longint;fl : cardinal) : longbool; cdecl;external 'pmwin' index 875;
+ function WinSetMultWindowPos(hab : cardinal;var _swp : TSWP;cswp : cardinal) : longbool; cdecl;external 'pmwin' index 863;
+ function WinSetMultWindowPos(hab : cardinal;_pswp : PSWP;cswp : cardinal) : longbool; cdecl;external 'pmwin' index 863;
+ function WinQueryWindowPos(hwnd : cardinal;var _swp : TSWP) : longbool; cdecl;external 'pmwin' index 837;
+ function WinQueryWindowPos(hwnd : cardinal;_pswp : PSWP) : longbool; cdecl;external 'pmwin' index 837;
+ function WinUpdateWindow(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 892;
+ function WinInvalidateRect(hwnd : cardinal;var wrc : TRectl;fIncludeChildren : longbool) : longbool; cdecl;external 'pmwin' index 765;
+ function WinInvalidateRect(hwnd : cardinal;pwrc : PRectl;fIncludeChildren : longbool) : longbool; cdecl;external 'pmwin' index 765;
+ function WinInvalidateRegion(hwnd,hrgn : cardinal;fIncludeChildren : longbool) : longbool; cdecl;external 'pmwin' index 766;
+ function WinInvertRect(hps : cardinal;var rcl : TRectl) : longbool; cdecl;external 'pmwin' index 767;
+ function WinInvertRect(hps : cardinal;prcl : PRectl) : longbool; cdecl;external 'pmwin' index 767;
+ function WinDrawBitmap(hpsDst,hbm : cardinal;var wrcSrc : TRectl;var ptlDst : TPointL;clrFore,clrBack : longint;fl : cardinal) : longbool; cdecl;external 'pmwin' index 730;
+ function WinDrawBitmap(hpsDst,hbm : cardinal;pwrcSrc : PRectl;pptlDst : PPointL;clrFore,clrBack : longint;fl : cardinal) : longbool; cdecl;external 'pmwin' index 730;
+ function WinDrawText(hps : cardinal;cchText : longint;lpchText : pchar;var rcl : TRectl;clrFore,clrBack : longint;flCmd : cardinal) : longint; cdecl;external 'pmwin' index 913;
+ function WinDrawText(hps : cardinal;cchText : longint;lpchText : pchar;prcl : PRectl;clrFore,clrBack : longint;flCmd : cardinal) : longint; cdecl;external 'pmwin' index 913;
+ function WinDrawBorder(hps : cardinal;var rcl : TRectl;cx,cy,clrFore,clrBack : longint;flCmd : cardinal) : longbool; cdecl;external 'pmwin' index 731;
+ function WinDrawBorder(hps : cardinal;prcl : PRectl;cx,cy,clrFore,clrBack : longint;flCmd : cardinal) : longbool; cdecl;external 'pmwin' index 731;
+ function WinLoadString(hab,hmod,id : cardinal;cchMax : longint;pchBuffer : pchar) : longint; cdecl;external 'pmwin' index 781;
+ function WinLoadMessage(hab,hmod,id : cardinal;cchMax : longint;pchBuffer : pchar) : longint; cdecl;external 'pmwin' index 779;
+ function WinSetActiveWindow(hwndDesktop,hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 851;
+ function WinSubclassWindow(hwnd : cardinal;pfnwp : proc) : proc; cdecl;external 'pmwin' index 929;
+ function WinQueryClassName(hwnd : cardinal;cchMax : longint; pch : pchar) : longint; cdecl;external 'pmwin' index 805;
+ function WinQueryClassInfo(hab : cardinal;pszClassName : pchar;var _ClassInfo : TClassInfo) : longbool; cdecl;external 'pmwin' index 925;
+ function WinQueryClassInfo(hab : cardinal;pszClassName : pchar;_pClassInfo : PClassInfo) : longbool; cdecl;external 'pmwin' index 925;
+ function WinQueryActiveWindow(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 799;
+ function WinIsThreadActive(hab : cardinal) : longbool; cdecl;external 'pmwin' index 771;
+ function WinQuerySysModalWindow(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 827;
+ function WinSetSysModalWindow(hwndDesktop,hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 872;
+ function WinQueryWindowUShort(hwnd : cardinal;index : longint) : word; cdecl;external 'pmwin' index 844;
+ function WinSetWindowUShort(hwnd : cardinal;index : longint;us : word) : longbool; cdecl;external 'pmwin' index 879;
+ function WinQueryWindowULong(hwnd : cardinal;index : longint) : cardinal; cdecl;external 'pmwin' index 843;
+ function WinSetWindowULong(hwnd : cardinal;index : longint;ul : cardinal) : longbool; cdecl;external 'pmwin' index 878;
+ function WinQueryWindowPtr(hwnd : cardinal;index : longint) : pointer; cdecl;external 'pmwin' index 839;
+ function WinSetWindowPtr(hwnd : cardinal;index : longint;p : pointer) : longbool; cdecl;external 'pmwin' index 876;
+ function WinSetWindowBits(hwnd : cardinal;index : longint;flData,flMask : cardinal) : longbool; cdecl;external 'pmwin' index 874;
+ function WinBeginEnumWindows(hwnd : cardinal) : cardinal; cdecl;external 'pmwin' index 702;
+ function WinGetNextWindow(henum : cardinal) : cardinal; cdecl;external 'pmwin' index 756;
+ function WinEndEnumWindows(henum : cardinal) : longbool; cdecl;external 'pmwin' index 737;
+ function WinWindowFromPoint(hwnd : cardinal;var ptl : TPointL;fChildren : longbool) : cardinal; cdecl;external 'pmwin' index 900;
+ function WinWindowFromPoint(hwnd : cardinal;pptl : PPointL;fChildren : longbool) : cardinal; cdecl;external 'pmwin' index 900;
+ function WinMapWindowPoints(hwndFrom,hwndTo : cardinal;var prgptl : TPointL;cwpt : longint) : longbool; cdecl;external 'pmwin' index 788;
+ function WinMapWindowPoints(hwndFrom,hwndTo : cardinal;prgptl : PPointL;cwpt : longint) : longbool; cdecl;external 'pmwin' index 788;
+ function WinValidateRect(hwnd : cardinal;var rcl : TRectl;fIncludeChildren : longbool) : longbool; cdecl;external 'pmwin' index 895;
+ function WinValidateRect(hwnd : cardinal;prcl : PRectl;fIncludeChildren : longbool) : longbool; cdecl;external 'pmwin' index 895;
+ function WinValidateRegion(hwnd,hrgn : cardinal;fIncludeChildren : longbool) : longbool; cdecl;external 'pmwin' index 896;
+ function WinWindowFromDC(hdc : cardinal) : cardinal; cdecl;external 'pmwin' index 898;
+ function WinQueryWindowDC(hwnd : cardinal) : cardinal; cdecl;external 'pmwin' index 835;
+ function WinGetScreenPS(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 759;
+ function WinLockWindowUpdate(hwndDesktop,hwndLockUpdate : cardinal) : longbool; cdecl;external 'pmwin' index 784;
+ function WinLockVisRegions(hwndDesktop : cardinal;fLock : longbool) : longbool; cdecl;external 'pmwin' index 782;
+ function WinQueryUpdateRect(hwnd : cardinal;var rcl : TRectl) : longbool; cdecl;external 'pmwin' index 831;
+ function WinQueryUpdateRect(hwnd : cardinal;prcl : PRectl) : longbool; cdecl;external 'pmwin' index 831;
+ function WinQueryUpdateRegion(hwnd,hrgn : cardinal) : longint; cdecl;external 'pmwin' index 832;
+ function WinExcludeUpdateRegion(hps,hwnd : cardinal) : longint; cdecl;external 'pmwin' index 742;
+ function WinSendMsg(hwnd,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;external 'pmwin' index 920;
+ function WinCreateMsgQueue(hab : cardinal;cmsg : longint) : cardinal; cdecl;external 'pmwin' index 716;
+ function WinDestroyMsgQueue(hmq : cardinal) : longbool; cdecl;external 'pmwin' index 726;
+ function WinQueryQueueInfo(hmq : cardinal;var mqi : TMQInfo;cbCopy : cardinal) : longbool; cdecl;external 'pmwin' index 824;
+ function WinQueryQueueInfo(hmq : cardinal;pmqi : PMQInfo;cbCopy : cardinal) : longbool; cdecl;external 'pmwin' index 824;
+ function WinCancelShutdown(hmq : cardinal;fCancelAlways : longbool) : longbool; cdecl;external 'pmwin' index 705;
+ function WinGetMsg(hab : cardinal;var _qmsg : TQMsg;hwndFilter,msgFilterFirst,msgFilterLast : cardinal) : longbool; cdecl;external 'pmwin' index 915;
+ function WinGetMsg(hab : cardinal;_pqmsg : PQMsg;hwndFilter,msgFilterFirst,msgFilterLast : cardinal) : longbool; cdecl;external 'pmwin' index 915;
+ function WinPeekMsg(hab : cardinal;var _qmsg : TQMsg;hwndFilter,msgFilterFirst,msgFilterLast,fl : cardinal) : longbool; cdecl;external 'pmwin' index 918;
+ function WinPeekMsg(hab : cardinal;_pqmsg : PQMsg;hwndFilter,msgFilterFirst,msgFilterLast,fl : cardinal) : longbool; cdecl;external 'pmwin' index 918;
+ function WinDispatchMsg(hab : cardinal;var _qmsg : TQMsg) : pointer; cdecl;external 'pmwin' index 912;
+ function WinDispatchMsg(hab : cardinal;_pqmsg : PQMsg) : pointer; cdecl;external 'pmwin' index 912;
+ function WinPostMsg(hwnd,msg : cardinal;mp1,mp2 : pointer) : longbool; cdecl;external 'pmwin' index 919;
+ function WinRegisterUserMsg(hab,msgid : cardinal;datatype1,dir1,datatype2,dir2,datatyper : longint) : longbool; cdecl;external 'pmwin' index 846;
+ function WinRegisterUserDatatype(hab : cardinal;datatype,count : longint;var types : longint) : longbool; cdecl;external 'pmwin' index 845;
+ function WinSetMsgMode(hab : cardinal;classname :pchar;control : longint) : longbool; cdecl;external 'pmwin' index 862;
+ function WinSetSynchroMode(hab : cardinal;mode : longint) : longbool; cdecl;external 'pmwin' index 870;
+ function WinInSendMsg(hab : cardinal) : longbool; cdecl;external 'pmwin' index 761;
+ function WinBroadcastMsg(hwnd,msg : cardinal;mp1,mp2 : pointer;rgf : cardinal) : longbool; cdecl;external 'pmwin' index 901;
+ function WinWaitMsg(hab,msgFirst,msgLast : cardinal) : longbool; cdecl;external 'pmwin' index 897;
+ function WinQueryQueueStatus(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 825;
+ function WinQueryMsgPos(hab : cardinal;var ptl : TPointL) : longbool; cdecl;external 'pmwin' index 818;
+ function WinQueryMsgPos(hab : cardinal;pptl : PPointL) : longbool; cdecl;external 'pmwin' index 818;
+ function WinQueryMsgTime(hab : cardinal) : cardinal; cdecl;external 'pmwin' index 819;
+ function WinWaitEventSem(hev,ulTimeout : cardinal) : cardinal; cdecl;external 'pmwin' index 978;
+ function WinRequestMutexSem(hmtx,ulTimeout : cardinal) : cardinal; cdecl;external 'pmwin' index 979;
+ function WinWaitMuxWaitSem(hmux,ulTimeout : cardinal;var ulUser : cardinal) : cardinal; cdecl;external 'pmwin' index 980;
+ function WinWaitMuxWaitSem(hmux,ulTimeout : cardinal;pulUser : PCardinal) : cardinal; cdecl;external 'pmwin' index 980;
+ function WinPostQueueMsg(hmq,msg : cardinal;mp1,mp2 : pointer) : longbool; cdecl;external 'pmwin' index 902;
+ function WinSetMsgInterest(hwnd,msg_class : cardinal;control : longint) : longbool; cdecl;external 'pmwin' index 861;
+ function WinSetClassMsgInterest(hab : cardinal;pszClassName : pchar;msg_class : cardinal;control : longint) : longbool; cdecl;external 'pmwin' index 853;
+ function WinSetFocus(hwndDesktop,hwndSetFocus : cardinal) : longbool; cdecl;external 'pmwin' index 860;
+ function WinFocusChange(hwndDesktop,hwndSetFocus,flFocusChange : cardinal) : longbool; cdecl;external 'pmwin' index 746;
+ function WinSetCapture(hwndDesktop,hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 852;
+ function WinQueryCapture(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 804;
+ function WinQueryFocus(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 817;
+ function WinGetKeyState(hwndDesktop : cardinal;vkey : longint) : longint; cdecl;external 'pmwin' index 752;
+ function WinGetPhysKeyState(hwndDesktop : cardinal;sc : longint) : longint; cdecl;external 'pmwin' index 758;
+ function WinEnablePhysInput(hwndDesktop : cardinal;fEnable : longbool) : longbool; cdecl;external 'pmwin' index 734;
+ function WinIsPhysInputEnabled(hwndDesktop : cardinal) : longbool; cdecl;external 'pmwin' index 769;
+ function WinSetKeyboardStateTable(hwndDesktop : cardinal;var KeyStateTable;fSet : longbool) : longbool; cdecl;external 'pmwin' index 921;
+ function WinSetKeyboardStateTable(hwndDesktop : cardinal;pKeyStateTable : pointer;fSet : longbool) : longbool; cdecl;external 'pmwin' index 921;
+ function WinGetDlgMsg(hwndDlg : cardinal;var _qmsg : TQMsg) : longbool; cdecl;external 'pmwin' index 914;
+ function WinGetDlgMsg(hwndDlg : cardinal;_pqmsg : PQMsg) : longbool; cdecl;external 'pmwin' index 914;
+ function WinLoadDlg(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;hmod,idDlg : cardinal;pCreateParams : pointer) : cardinal; cdecl;external 'pmwin' index 924;
+ function WinDlgBox(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;hmod,idDlg : cardinal;pCreateParams : pointer) : cardinal; cdecl;external 'pmwin' index 923;
+ function WinDismissDlg(hwndDlg,usResult : cardinal) : longbool; cdecl;external 'pmwin' index 729;
+ function WinQueryDlgItemShort(hwndDlg,idItem : cardinal;var _Result : integer;fSigned : longbool) : longbool; cdecl;external 'pmwin' index 814;
+ function WinQueryDlgItemShort(hwndDlg,idItem : cardinal;pResult : PInteger;fSigned : longbool) : longbool; cdecl;external 'pmwin' index 814;
+ function WinSetDlgItemShort(hwndDlg,idItem : cardinal;usValue : word;fSigned : longbool) : longbool; cdecl;external 'pmwin' index 858;
+ function WinSetDlgItemText(hwndDlg,idItem : cardinal;pszText : pchar) : longbool; cdecl;external 'pmwin' index 859;
+ function WinQueryDlgItemText(hwndDlg,idItem : cardinal;cchBufferMax : longint;pchBuffer : pchar) : cardinal; cdecl;external 'pmwin' index 815;
+ function WinQueryDlgItemTextLength(hwndDlg,idItem : cardinal) : longint; cdecl;external 'pmwin' index 816;
+ function WinDefDlgProc(hwndDlg,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;external 'pmwin' index 910;
+ function WinAlarm(hwndDesktop,rgfType : cardinal) : longbool; cdecl;external 'pmwin' index 701;
+ function WinMessageBox(hwndParent,hwndOwner : cardinal;pszText,pszCaption : pchar;idWindow,flStyle : cardinal) : cardinal; cdecl;external 'pmwin' index 789;
+(* Only available in later OS/2 versions probably???
+ function WinMessageBox2(hwndParent,hwndOwner: cardinal;pszText,pszCaption: PChar; idWindow: cardinal; MBInfo: PMB2Info): cardinal; cdecl; external 'pmwin' index 1015;
+*)
+ function WinProcessDlg(hwndDlg : cardinal) : cardinal; cdecl;external 'pmwin' index 796;
+ function WinSendDlgItemMsg(hwndDlg,idItem,msg : cardinal;mp1,mp2 : pointer) : pointer; cdecl;external 'pmwin' index 903;
+ function WinMapDlgPoints(hwndDlg : cardinal;var prgwptl : TPointL;cwpt : cardinal;fCalcWindowCoords : longbool) : longbool; cdecl;external 'pmwin' index 787;
+ function WinMapDlgPoints(hwndDlg : cardinal;prgwptl : PPointL;cwpt : cardinal;fCalcWindowCoords : longbool) : longbool; cdecl;external 'pmwin' index 787;
+ function WinEnumDlgItem(hwndDlg,hwnd,code : cardinal) : cardinal; cdecl;external 'pmwin' index 740;
+ function WinSubstituteStrings(hwnd : cardinal;pszSrc : pchar;cchDstMax : longint;pszDst : pchar) : longint; cdecl;external 'pmwin' index 886;
+ function WinCreateDlg(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;var dlgt : TDlgTemplate;pCreateParams : pointer) : cardinal; cdecl;external 'pmwin' index 922;
+ function WinCreateDlg(hwndParent,hwndOwner : cardinal;pfnDlgProc : proc;pdlgt : PDlgTemplate;pCreateParams : pointer) : cardinal; cdecl;external 'pmwin' index 922;
+ function WinLoadMenu(hwndFrame,hmod,idMenu : cardinal) : cardinal; cdecl;external 'pmwin' index 778;
+ function WinCreateMenu(hwndParent : cardinal;lpmt : pointer) : cardinal; cdecl;external 'pmwin' index 907;
+ function WinPopupMenu(hwndParent,hwndOwner,hwndMenu : cardinal;x,y,idItem : longint;fs : cardinal) : longbool; cdecl;external 'pmwin' index 937;
+ function WinCreateStdWindow(hwndParent,flStyle : cardinal;var flCreateFlags : cardinal;pszClientClass,pszTitle : pchar;styleClient,hmod,idResources : cardinal;var hwndClient : cardinal) : cardinal; cdecl;external 'pmwin' index 908;
+ function WinCreateStdWindow(hwndParent,flStyle : cardinal;pflCreateFlags : PCardinal;pszClientClass,pszTitle : pchar;styleClient,hmod,idResources : cardinal;phwndClient : PCardinal) : cardinal; cdecl;external 'pmwin' index 908;
+ function WinFlashWindow(hwndFrame : cardinal;fFlash : longbool) : longbool; cdecl;external 'pmwin' index 745;
+ function WinCreateFrameControls(hwndFrame : cardinal;var fcdata : TFrameCData;pszTitle : pchar) : longbool; cdecl;external 'pmwin' index 906;
+ function WinCreateFrameControls(hwndFrame : cardinal;pfcdata : PFrameCData;pszTitle : pchar) : longbool; cdecl;external 'pmwin' index 906;
+ function WinCalcFrameRect(hwndFrame : cardinal;var rcl : TRectl;fClient : longbool) : longbool; cdecl;external 'pmwin' index 704;
+ function WinCalcFrameRect(hwndFrame : cardinal;prcl : PRectl;fClient : longbool) : longbool; cdecl;external 'pmwin' index 704;
+ function WinGetMinPosition(hwnd : cardinal;var _swp : TSWP;var pptl : POINTL) : longbool; cdecl;external 'pmwin' index 755;
+ function WinGetMinPosition(hwnd : cardinal;_pswp : PSWP;var pptl : POINTL) : longbool; cdecl;external 'pmwin' index 755;
+ function WinGetMaxPosition(hwnd : cardinal;var _swp : TSWP) : longbool; cdecl;external 'pmwin' index 754;
+ function WinGetMaxPosition(hwnd : cardinal;_pswp : PSWP) : longbool; cdecl;external 'pmwin' index 754;
+ function WinSaveWindowPos(hsvwp : cardinal;var _swp : TSWP;cswp : cardinal) : longbool; cdecl;external 'pmwin' index 943;
+ function WinSaveWindowPos(hsvwp : cardinal;_pswp : PSWP;cswp : cardinal) : longbool; cdecl;external 'pmwin' index 943;
+ function WinCopyRect(hab : cardinal;var rclDst,rclSrc : TRectl) : longbool; cdecl;external 'pmwin' index 710;
+ function WinCopyRect(hab : cardinal;prclDst,prclSrc : PRectl) : longbool; cdecl;external 'pmwin' index 710;
+ function WinSetRect(hab : cardinal;var rcl : TRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;external 'pmwin' index 868;
+ function WinSetRect(hab : cardinal;_prcl : PRectl;xLeft,yBottom,xRight,yTop : longint) : longbool; cdecl;external 'pmwin' index 868;
+ function WinIsRectEmpty(hab : cardinal;var rcl : TRectl) : longbool; cdecl;external 'pmwin' index 770;
+ function WinIsRectEmpty(hab : cardinal;prcl : PRectl) : longbool; cdecl;external 'pmwin' index 770;
+ function WinEqualRect(hab : cardinal;var rcl1,rcl2 : TRectl) : longbool; cdecl;external 'pmwin' index 741;
+ function WinEqualRect(hab : cardinal;prcl1,prcl2 : PRectl) : longbool; cdecl;external 'pmwin' index 741;
+ function WinSetRectEmpty(hab : cardinal;var rcl : TRectl) : longbool; cdecl;external 'pmwin' index 869;
+ function WinSetRectEmpty(hab : cardinal;prcl : PRectl) : longbool; cdecl;external 'pmwin' index 869;
+ function WinOffsetRect(hab : cardinal;var rcl : TRectl;cx,cy : longint) : longbool; cdecl;external 'pmwin' index 792;
+ function WinOffsetRect(hab : cardinal;prcl : PRectl;cx,cy : longint) : longbool; cdecl;external 'pmwin' index 792;
+ function WinInflateRect(hab : cardinal;var rcl : TRectl;cx,cy : longint) : longbool; cdecl;external 'pmwin' index 762;
+ function WinInflateRect(hab : cardinal;prcl : PRectl;cx,cy : longint) : longbool; cdecl;external 'pmwin' index 762;
+ function WinPtInRect(hab : cardinal;var rcl : TRectl;var ptl : TPointL) : longbool; cdecl;external 'pmwin' index 797;
+ function WinPtInRect(hab : cardinal;prcl : PRectl;pptl : PPointL) : longbool; cdecl;external 'pmwin' index 797;
+ function WinIntersectRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;external 'pmwin' index 764;
+ function WinIntersectRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;external 'pmwin' index 764;
+ function WinUnionRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;external 'pmwin' index 891;
+ function WinUnionRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;external 'pmwin' index 891;
+ function WinSubtractRect(hab : cardinal;var rclDst,rclSrc1,rclSrc2 : TRectl) : longbool; cdecl;external 'pmwin' index 887;
+ function WinSubtractRect(hab : cardinal;prclDst,prclSrc1,prclSrc2 : PRectl) : longbool; cdecl;external 'pmwin' index 887;
+ function WinMakeRect(hab : cardinal;var wrc : TRectl) : longbool; cdecl;external 'pmwin' index 786;
+ function WinMakeRect(hab : cardinal;pwrc : PRectl) : longbool; cdecl;external 'pmwin' index 786;
+ function WinMakePoints(hab : cardinal;var wpt : TPointL;cwpt : cardinal) : longbool; cdecl;external 'pmwin' index 785;
+ function WinMakePoints(hab : cardinal;pwpt : PPointL;cwpt : cardinal) : longbool; cdecl;external 'pmwin' index 785;
+ function WinQuerySysValue(hwndDesktop : cardinal;iSysValue : longint) : longint; cdecl;external 'pmwin' index 829;
+ function WinSetSysValue(hwndDesktop : cardinal;iSysValue,lValue : longint) : longbool; cdecl;external 'pmwin' index 873;
+ function WinSetPresParam(hwnd,id,cbParam : cardinal;pbParam : pointer) : longbool; cdecl;external 'pmwin' index 938;
+ function WinQueryPresParam(hwnd,id1,id2 : cardinal;var ulId : cardinal;cbBuf : cardinal;pbBuf : pointer;fs : cardinal) : cardinal; cdecl;external 'pmwin' index 939;
+ function WinQueryPresParam(hwnd,id1,id2 : cardinal;pulId : PCardinal;cbBuf : cardinal;pbBuf : pointer;fs : cardinal) : cardinal; cdecl;external 'pmwin' index 939;
+ function WinRemovePresParam(hwnd,id : cardinal) : longbool; cdecl;external 'pmwin' index 940;
+ function WinQuerySysColor(hwndDesktop : cardinal;clr,lReserved : longint) : longint; cdecl;external 'pmwin' index 826;
+ function WinSetSysColors(hwndDesktop,flOptions,flFormat : cardinal;clrFirst : longint;cclr : cardinal;var clr : longint) : longbool; cdecl;external 'pmwin' index 871;
+ function WinSetSysColors(hwndDesktop,flOptions,flFormat : cardinal;clrFirst : longint;cclr : cardinal;pclr : PLongint) : longbool; cdecl;external 'pmwin' index 871;
+ function WinStartTimer(hab,hwnd,idTimer,dtTimeout : cardinal) : cardinal; cdecl;external 'pmwin' index 884;
+ function WinStopTimer(hab,hwnd,idTimer : cardinal) : longbool; cdecl;external 'pmwin' index 885;
+ function WinGetCurrentTime(hab : cardinal) : cardinal; cdecl;external 'pmwin' index 750;
+ function WinLoadAccelTable(hab,hmod,idAccelTable : cardinal) : cardinal; cdecl;external 'pmwin' index 776;
+ function WinCopyAccelTable(haccel : cardinal;var _AccelTable : TAccelTable;cbCopyMax : cardinal) : cardinal; cdecl;external 'pmwin' index 709;
+ function WinCopyAccelTable(haccel : cardinal;_pAccelTable : PAccelTable;cbCopyMax : cardinal) : cardinal; cdecl;external 'pmwin' index 709;
+ function WinCreateAccelTable(hab : cardinal;var _AccelTable : TAccelTable) : cardinal; cdecl;external 'pmwin' index 713;
+ function WinCreateAccelTable(hab : cardinal;_pAccelTable : PAccelTable) : cardinal; cdecl;external 'pmwin' index 713;
+ function WinDestroyAccelTable(haccel : cardinal) : longbool; cdecl;external 'pmwin' index 723;
+ function WinTranslateAccel(hab,hwnd,haccel : cardinal;var _qmsg : TQMsg) : longbool; cdecl;external 'pmwin' index 904;
+ function WinTranslateAccel(hab,hwnd,haccel : cardinal;_pqmsg : PQMsg) : longbool; cdecl;external 'pmwin' index 904;
+ function WinSetAccelTable(hab,haccel,hwndFrame : cardinal) : longbool; cdecl;external 'pmwin' index 850;
+ function WinQueryAccelTable(hab,hwndFrame : cardinal) : cardinal; cdecl;external 'pmwin' index 798;
+ function WinTrackRect(hwnd,hps : cardinal;var ti : TTrackInfo) : longbool; cdecl;external 'pmwin' index 890;
+ function WinTrackRect(hwnd,hps : cardinal;pti : PTrackInfo) : longbool; cdecl;external 'pmwin' index 890;
+ function WinShowTrackRect(hwnd : cardinal;fShow : longbool) : longbool; cdecl;external 'pmwin' index 882;
+ function WinSetClipbrdOwner(hab,hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 855;
+ function WinSetClipbrdData(hab,ulData,fmt,rgfFmtInfo : cardinal) : longbool; cdecl;external 'pmwin' index 854;
+ function WinQueryClipbrdData(hab,fmt : cardinal) : cardinal; cdecl;external 'pmwin' index 806;
+ function WinQueryClipbrdFmtInfo(hab,fmt : cardinal;var prgfFmtInfo : cardinal) : longbool; cdecl;external 'pmwin' index 807;
+ function WinQueryClipbrdFmtInfo(hab,fmt : cardinal;prgfFmtInfo : PCardinal) : longbool; cdecl;external 'pmwin' index 807;
+ function WinSetClipbrdViewer(hab,hwndNewClipViewer : cardinal) : longbool; cdecl;external 'pmwin' index 856;
+ function WinEnumClipbrdFmts(hab,fmt : cardinal) : cardinal; cdecl;external 'pmwin' index 739;
+ function WinEmptyClipbrd(hab : cardinal) : longbool; cdecl;external 'pmwin' index 733;
+ function WinOpenClipbrd(hab : cardinal) : longbool; cdecl;external 'pmwin' index 793;
+ function WinCloseClipbrd(hab : cardinal) : longbool; cdecl;external 'pmwin' index 707;
+ function WinQueryClipbrdOwner(hab : cardinal) : cardinal; cdecl;external 'pmwin' index 808;
+ function WinQueryClipbrdViewer(hab : cardinal) : cardinal; cdecl;external 'pmwin' index 809;
+ function WinDestroyCursor(hwnd : cardinal) : longbool; cdecl;external 'pmwin' index 725;
+ function WinShowCursor(hwnd : cardinal;fShow : longbool) : longbool; cdecl;external 'pmwin' index 880;
+ function WinCreateCursor(hwnd : cardinal;x,y,cx,cy : longint;fs : cardinal;var rclClip : TRectl) : longbool; cdecl;external 'pmwin' index 715;
+ function WinCreateCursor(hwnd : cardinal;x,y,cx,cy : longint;fs : cardinal;prclClip : PRectl) : longbool; cdecl;external 'pmwin' index 715;
+ function WinQueryCursorInfo(hwndDesktop : cardinal;var _CursorInfo : TCursorInfo) : longbool; cdecl;external 'pmwin' index 812;
+ function WinQueryCursorInfo(hwndDesktop : cardinal;_pCursorInfo : PCursorInfo) : longbool; cdecl;external 'pmwin' index 812;
+ function WinSetPointer(hwndDesktop,hptrNew : cardinal) : longbool; cdecl;external 'pmwin' index 866;
+ function WinSetPointerOwner(hptr,pid : cardinal;fDestroy : longbool) : longbool; cdecl;external 'pmwin' index 971;
+ function WinShowPointer(hwndDesktop : cardinal;fShow : longbool) : longbool; cdecl;external 'pmwin' index 881;
+ function WinQuerySysPointer(hwndDesktop : cardinal;iptr : longint;fLoad : longbool) : cardinal; cdecl;external 'pmwin' index 828;
+ function WinLoadPointer(hwndDesktop,hmod,idres : cardinal) : cardinal; cdecl;external 'pmwin' index 780;
+ function WinCreatePointer(hwndDesktop,hbmPointer : cardinal;fPointer : longbool;xHotspot,yHotspot : longint) : cardinal; cdecl;external 'pmwin' index 717;
+ function WinSetPointerPos(hwndDesktop : cardinal;x,y : longint) : longbool; cdecl;external 'pmwin' index 867;
+ function WinDestroyPointer(hptr : cardinal) : longbool; cdecl;external 'pmwin' index 727;
+ function WinQueryPointer(hwndDesktop : cardinal) : cardinal; cdecl;external 'pmwin' index 821;
+ function WinQueryPointerPos(hwndDesktop : cardinal;var ptl : TPointL) : longbool; cdecl;external 'pmwin' index 823;
+ function WinQueryPointerPos(hwndDesktop : cardinal;pptl : PPointL) : longbool; cdecl;external 'pmwin' index 823;
+ function WinCreatePointerIndirect(hwndDesktop : cardinal;var ptri : TPointerInfo) : cardinal; cdecl;external 'pmwin' index 942;
+ function WinCreatePointerIndirect(hwndDesktop : cardinal;pptri : PPointerInfo) : cardinal; cdecl;external 'pmwin' index 942;
+ function WinQueryPointerInfo(hptr : cardinal;var _PointerInfo : TPointerInfo) : longbool; cdecl;external 'pmwin' index 822;
+ function WinQueryPointerInfo(hptr : cardinal;_pPointerInfo : PPointerInfo) : longbool; cdecl;external 'pmwin' index 822;
+ function WinDrawPointer(hps : cardinal;x,y : longint;hptr,fs : cardinal) : longbool; cdecl;external 'pmwin' index 732;
+ function WinGetSysBitmap(hwndDesktop,ibm : cardinal) : cardinal; cdecl;external 'pmwin' index 760;
+ function WinSetHook(hab,hmq : cardinal;iHook : longint;pfnHook : pointer;hmod : cardinal) : longbool; cdecl;external 'pmwin' index 928;
+ function WinReleaseHook(hab,hmq : cardinal;iHook : longint;pfnHook : pointer;hmod : cardinal) : longbool; cdecl;external 'pmwin' index 927;
+ function WinCallMsgFilter(hab : cardinal;var _qmsg : TQMsg;msgf : cardinal) : longbool; cdecl;external 'pmwin' index 905;
+ function WinCallMsgFilter(hab : cardinal;_pqmsg : PQMsg;msgf : cardinal) : longbool; cdecl;external 'pmwin' index 905;
+ function WinSetClassThunkProc(pszClassname : pchar;pfnThunkProc : pointer) : longbool; cdecl;external 'pmwin' index 959;
+ function WinQueryClassThunkProc(pszClassname : pchar) : pointer; cdecl;external 'pmwin' index 960;
+ function WinSetWindowThunkProc(hwnd : cardinal;pfnThunkProc : pointer) : longbool; cdecl;external 'pmwin' index 961;
+ function WinQueryWindowThunkProc(hwnd : cardinal) : pointer; cdecl;external 'pmwin' index 962;
+ function WinQueryWindowModel(hwnd : cardinal) : longint; cdecl;external 'pmwin' index 934;
+ function WinQueryCp(hmq : cardinal) : cardinal; cdecl;external 'pmwin' index 810;
+ function WinSetCp(hmq,idCodePage : cardinal) : longbool; cdecl;external 'pmwin' index 857;
+ function WinQueryCpList(hab,ccpMax : cardinal;var prgcp : cardinal) : cardinal; cdecl;external 'pmwin' index 811;
+ function WinQueryCpList(hab,ccpMax : cardinal;prgcp : PCardinal) : cardinal; cdecl;external 'pmwin' index 811;
+ function WinCpTranslateString(hab,cpSrc : cardinal;pszSrc : pchar;cpDst,cchDestMax : cardinal;pchDest : pchar) : longbool; cdecl;external 'pmwin' index 712;
+ function WinCpTranslateChar(hab,cpSrc : cardinal;chSrc : byte;cpDst : cardinal) : byte; cdecl;external 'pmwin' index 711;
+ function WinUpper(hab,idcp,idcc : cardinal;psz : pchar) : cardinal; cdecl;external 'pmwin' index 893;
+ function WinUpperChar(hab,idcp,idcc,c : cardinal) : cardinal; cdecl;external 'pmwin' index 894;
+ function WinNextChar(hab,idcp,idcc : cardinal;psz : pchar) : pchar; cdecl;external 'pmwin' index 791;
+ function WinPrevChar(hab,idcp,idcc : cardinal;pszStart,psz : pchar) : pchar; cdecl;external 'pmwin' index 795;
+ function WinCompareStrings(hab,idcp,idcc : cardinal;psz1,psz2 : pchar;reserved : cardinal) : cardinal; cdecl;external 'pmwin' index 708;
+ function WinCreateAtomTable(cbInitial,cBuckets : cardinal) : cardinal; cdecl;external 'pmwin' index 714;
+ function WinDestroyAtomTable(hAtomTbl : cardinal) : cardinal; cdecl;external 'pmwin' index 724;
+ function WinAddAtom(hAtomTbl : cardinal;pszAtomName : pchar) : cardinal; cdecl;external 'pmwin' index 700;
+ function WinFindAtom(hAtomTbl : cardinal;pszAtomName : pchar) : cardinal; cdecl;external 'pmwin' index 744;
+ function WinDeleteAtom(hAtomTbl,atom : cardinal) : cardinal; cdecl;external 'pmwin' index 721;
+ function WinQueryAtomUsage(hAtomTbl,atom : cardinal) : cardinal; cdecl;external 'pmwin' index 803;
+ function WinQueryAtomLength(hAtomTbl,atom : cardinal) : cardinal; cdecl;external 'pmwin' index 801;
+ function WinQueryAtomName(hAtomTbl,atom : cardinal;pchBuffer : pchar;cchBufferMax : cardinal) : cardinal; cdecl;external 'pmwin' index 802;
+ function WinGetLastError(hab : cardinal) : cardinal; cdecl;external 'pmwin' index 753;
+ function WinGetErrorInfo(hab : cardinal) : PERRINFO; cdecl;external 'pmwin' index 751;
+ function WinFreeErrorInfo(var perrinfo : ERRINFO) : longbool; cdecl;external 'pmwin' index 748;
+ function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;var cctxt : TConvContext) : longbool; cdecl;external 'pmwin' index 718;
+ function WinDdeInitiate(hwndClient : cardinal;pszAppName,pszTopicName : pchar;pcctxt : PConvContext) : longbool; cdecl;external 'pmwin' index 718;
+ function WinDdeRespond(hwndClient,hwndServer : cardinal;pszAppName,pszTopicName : pchar;var cctxt : TConvContext) : pointer; cdecl;external 'pmwin' index 720;
+ function WinDdeRespond(hwndClient,hwndServer : cardinal;pszAppName,pszTopicName : pchar;pcctxt : PConvContext) : pointer; cdecl;external 'pmwin' index 720;
+ function WinDdePostMsg(hwndTo,hwndFrom,wm : cardinal;var ddest : DDEStruct;flOptions : cardinal) : longbool; cdecl;external 'pmwin' index 719;
+ function WinDdePostMsg(hwndTo,hwndFrom,wm : cardinal;pddest : PDDEStruct;flOptions : cardinal) : longbool; cdecl;external 'pmwin' index 719;
+ function WinDeleteProcedure(hab : cardinal;wndproc : proc) : longbool; cdecl;external 'pmwin' index 987;
+ function WinDeleteLibrary(hab,libhandle : cardinal) : longbool; cdecl;external 'pmwin' index 722;
+ function WinLoadProcedure(hab,libhandle : cardinal;procname : pchar) : proc; cdecl;external 'pmwin' index 986;
+ function WinLoadLibrary(hab : cardinal;libname : pchar) : cardinal; cdecl;external 'pmwin' index 777;
+ function WinSetDesktopBkgnd(hwndDesktop : cardinal;var dskNew : TDesktop) : cardinal; cdecl;external 'pmwin' index 935;
+ function WinSetDesktopBkgnd(hwndDesktop : cardinal;pdskNew : PDesktop) : cardinal; cdecl;external 'pmwin' index 935;
+ function WinQueryDesktopBkgnd(hwndDesktop : cardinal;var dsk : TDesktop) : longbool; cdecl;external 'pmwin' index 936;
+ function WinQueryDesktopBkgnd(hwndDesktop : cardinal;pdsk : PDesktop) : longbool; cdecl;external 'pmwin' index 936;
+ function WinRealizePalette(hwnd,hps : cardinal;var cclr : cardinal) : longint; cdecl;external 'pmwin' index 941;
+ function WinRealizePalette(hwnd,hps : cardinal;pcclr : PCardinal) : longint; cdecl;external 'pmwin' index 941;
+ function WinQuerySystemAtomTable: cardinal; cdecl; external 'pmwin' index 830;
+
+ function CardinalFromMP (MP: pointer): cardinal; cdecl;
+ begin
+ CardinalFromMP := cardinal (MP);
+ end;
+
+ function Integer1FromMP (MP: pointer): word; cdecl;
+ begin
+ Integer1FromMP := Lo (cardinal (MP));
+ end;
+
+ function Integer2FromMP (MP: pointer): word; cdecl;
+ begin
+ Integer2FromMP := Hi (cardinal (MP));
+ end;
+
+end.
+
+{
+ $Log: pmwin.pas,v $
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmwp.pas b/rtl/os2/pmwp.pas
new file mode 100644
index 0000000000..8130437a34
--- /dev/null
+++ b/rtl/os2/pmwp.pas
@@ -0,0 +1,242 @@
+{****************************************************************************
+
+ $Id: pmwp.pas,v 1.2 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyrigth (c) 2003 by Yuri Prokushev (prokushev@freemail.ru)
+
+ OS/2 Presentation Manager Workplace functions and types.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+unit pmwp;
+
+interface
+
+uses
+ os2def, pmwin;
+
+//*** Common types *******************************************************/
+
+type
+ HOBJECT=Cardinal;
+
+//*** Object management calls ********************************************/
+
+//*** Standard object classes *****************************************/
+
+const
+ CCHMAXCLASS = 3; // Length of a classname
+
+ QC_First = 0; // Codes for OA_QueryContent
+ QC_Next = 1;
+ QC_Last = 2;
+
+ LOCATION_DESKTOP = PChar($FFFF0001); // Current Desktop
+ // use instead of <WP_DESKTOP>
+
+//*** An object's appearance (icon or bitmap or outline) **************/
+
+type
+ OBJECTIMAGE=record // oimg
+ hptrObject: Cardinal;
+ end;
+ POBJECTIMAGE=^OBJECTIMAGE;
+
+//*** Class info structure returned by WinEnumObjectClasses ***********/
+type
+ POBJCLASS=^OBJCLASS;
+ OBJCLASS=record // ocls
+ pNext: POBJCLASS; // Null for the last structure..
+ pszClassName: PChar; // Class name
+ pszModName: PChar; // Module name
+ end;
+
+//*** Workplace object management functions ***************************/
+
+Function WinRegisterObjectClass(pszClassName,
+ pszModName: PChar): Longbool; cdecl;
+ external 'PMWP' index 200;
+
+Function WinDeRegisterObjectClass(pszClassName: PChar): Longbool; cdecl;
+ external 'PMWP' index 201;
+
+Function WinReplaceObjectClass(pszOldClassName,
+ pszNewClassName: PChar;
+ fReplace: Longbool): Longbool; cdecl;
+ external 'PMWP' index 219;
+
+Function WinEnumObjectClasses(VAR apObjClass: OBJCLASS;
+ VAR pulSize: Cardinal): Longbool; cdecl;
+ external 'PMWP' index 205;
+
+Function WinCreateObject(pszClassName,
+ pszTitle,
+ pszSetupString,
+ pszLocation: PChar;
+ ulFlags: Cardinal): HObject; cdecl;
+ external 'PMWP' index 281;
+
+const
+ CO_FAILIFEXISTS = 0;
+ CO_REPLACEIFEXISTS = 1;
+ CO_UPDATEIFEXISTS = 2;
+
+Function WinSetObjectData(aobject: HOBJECT;
+ pszSetupString: PChar): Longbool; cdecl;
+ external 'PMWP' index 250;
+
+Function WinDestroyObject(aobject: HOBJECT): Longbool; cdecl;
+ external 'PMWP' index 251;
+
+Function WinQueryObject(pszObjectID: PChar): HObject; cdecl;
+ external 'PMWP' index 252;
+
+Function WinSaveObject(ahObject: HOBJECT;
+ fAsync: Longbool): Longbool; cdecl;
+ external 'PMWP' index 285;
+
+Function WinOpenObject(ahObject: HOBJECT;
+ ulView: Cardinal;
+ Flag: Longbool): Longbool; cdecl;
+ external 'PMWP' index 286;
+
+Function WinMoveObject(hObjectofObject: HOBJECT;
+ hObjectofDest: HOBJECT;
+ ulReserved: Cardinal): HObject; cdecl;
+ external 'PMWP' index 287;
+
+Function WinCopyObject(hObjectofObject: HOBJECT;
+ hObjectofDest: HOBJECT;
+ ulReserved: Cardinal): HObject; cdecl;
+ external 'PMWP' index 288;
+
+Function WinCreateShadow(hObjectofObject: HOBJECT;
+ hObjectofDest: HOBJECT;
+ ulReserved: Cardinal): HObject; cdecl;
+ external 'PMWP' index 289;
+
+Function WinQueryActiveDesktopPathname(pszPathName: PChar;
+ ulSize: Cardinal): Longbool; cdecl;
+ external 'PMWP' index 262;
+
+Function WinQueryObjectPath(ahobject: HOBJECT;
+ pszPathName: PChar;
+ ulSize: Cardinal): Longbool; cdecl;
+ external 'PMWP' index 263;
+
+Function WinRestartWPDServer(fState: Longbool): Cardinal; cdecl;
+ external 'PMWP' index 463;
+
+Function WinIsWPDServerReady: Longbool; cdecl;
+ external 'PMWP' index 465;
+
+Function WinRestartSOMDD(fState: Longbool): Cardinal; cdecl;
+ external 'PMWP' index 464;
+
+Function WinIsSOMDDReady: Longbool; cdecl;
+ external 'PMWP' index 480;
+
+//*** Object settings notebook page insertion structure ******************/
+
+type
+ PAGEINFO=record // pginf
+ cb: Cardinal;
+ hwndPage: HWnd;
+ pfnwp: proc;
+ resid: Cardinal;
+ pCreateParams: Pointer;
+ dlgid: Word;
+ usPageStyleFlags: Word;
+ usPageInsertFlags: Word;
+ usSettingsFlags: Word;
+ pszName: PChar;
+ idDefaultHelpPanel: Word;
+ usReserved2: Word;
+ pszHelpLibraryName: PChar;
+ pHelpSubtable: ^Word; // PHELPSUBTABLE when PMHELP.H is included
+ hmodHelpSubtable: Cardinal;
+ ulPageInsertId: Cardinal;
+ end;
+ PPAGEINFO=^PAGEINFO;
+
+const
+ SETTINGS_PAGE_NUMBERS = $01;
+
+//*** Utility apis +******************************************************/
+
+type
+ ICONPOS=record // icp
+ ptlIcon: POINTL; // Location
+ szIdentity: Array[0..1-1] of Char; // Object identity string
+ end;
+ PICONPOS=^ICONPOS;
+
+//*********************************************************************/
+Function WinSetFileIcon(pszFileName: PChar;
+ var pIcon: ICONINFO): Longbool; cdecl;
+ external 'PMWP' index 210;
+
+Function WinFreeFileIcon(hptr: Cardinal): Longbool; cdecl;
+ external 'PMWP' index 216;
+
+Function WinLoadFileIcon(pszFileName: PChar;
+ fPrivate: Longbool): Cardinal; cdecl;
+ external 'PMWP' index 209;
+
+Function WinStoreWindowPos(pszAppName,
+ pszKeyName: PChar;
+ ahwnd: HWND): Longbool; cdecl;
+ external 'PMWP' index 207;
+
+Function WinRestoreWindowPos(pszAppName,
+ pszKeyName: PChar;
+ ahwnd: HWND): Longbool; cdecl;
+ external 'PMWP' index 208;
+
+Function WinShutdownSystem(ahab: HAB;
+ ahmq: HMQ): Longbool; cdecl;
+ external 'PMWP' index 149;
+
+implementation
+
+end.
+
+{
+// Not implemented/not documented APIs
+WinShutdownAndReboot PMWP 152 ?
+WinShutdown PMWP 153 ?
+OldWinCreateObject PMWP 202 ?
+WinRestartWorkplace PMWP 221 ?
+ShlGetUserWordPtr PMWP 224 ?
+WinUnlockSystem PMWP 282 ?
+WinLockupSystem PMWP 283 ?
+WinNotebookButtonFromID PMWP 511 ?
+WinWaitForShell PMWP 512 ?
+}
+
+{
+// Not founded indexes
+Function WinSetFileIconN(pszFileName: PChar
+ pIcnInfo: PICONINFO;
+ ulIconIndex: Cardinal): Longbool; cdecl;
+ external 'PMWP' index ???;
+
+Function WinLoadFileIconN(pszFileName: PChar;
+ fPrivate: Longbool,
+ ulIconIndex: Cardinal): Cardinal; cdecl;
+ external 'PMWP' index ???;
+}
+
+{
+$Log: pmwp.pas,v $
+Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/pmwsock.pas b/rtl/os2/pmwsock.pas
new file mode 100644
index 0000000000..3ecb7a5361
--- /dev/null
+++ b/rtl/os2/pmwsock.pas
@@ -0,0 +1,1064 @@
+{****************************************************************************
+
+ $Id: pmwsock.pas,v 1.5 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyrigth (c) 2003 by Yuri Prokushev (prokushev@freemail.ru)
+
+ This file corresponds to version 1.1 of the Windows Sockets
+ specification.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+{$ifndef winsock}
+unit pmwsock;
+{$endif}
+
+{$PACKRECORDS 1}
+{$MACRO ON}
+Interface
+
+Uses OS2Def;
+
+// The new type to be used in all instances which refer to sockets.
+type
+ TSocket=Cardinal;
+
+type
+ PLongint=^Longint;
+ PCardinal=^Cardinal;
+
+// Select uses arrays of TSockets. These macros manipulate such
+// arrays. FD_SETSIZE may be defined by the user before including
+// this file, but the default here should be >= 64.
+//
+// CAVEAT IMPLEMENTOR and USER: THESE MACROS AND TYPES MUST BE
+// INCLUDED IN WINSOCK.H EXACTLY AS SHOWN HERE.
+const
+ FD_SETSIZE = 64;
+
+type
+ fdset=record
+ fd_count: Word; // how many are SET?
+ fd_array: Array[0..FD_SETSIZE-1] of TSocket; // an array of TSockets
+ end;
+ TFDSet = fdset;
+ PFDSet = ^fdset;
+
+
+Function __WSAFDIsSet(a: TSocket;var b: fdset): Longint; cdecl;
+ external 'PMWSock' name '__WSAFDIsSet';
+Function __WSAFDIsSet_(s:TSocket; var FDSet:TFDSet): Longint; cdecl;
+ external 'PMWSock' name '__WSAFDIsSet';
+
+Function FD_ISSET(a: TSocket;var b: fdset): Longint; cdecl;
+ external 'PMWSock' name '__WSAFDIsSet';
+
+Procedure FD_CLR(ASocket: TSocket; var aset: fdset);
+Procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
+
+// Structure used in select() call, taken from the BSD file sys/time.h.
+type
+ timeval=record
+ tv_sec: LongInt; // seconds
+ tv_usec: LongInt; // and microseconds
+ end;
+
+ TTimeVal = timeval;
+ PTimeVal = ^TTimeVal;
+
+ { found no reference to this type in c header files and here. AlexS }
+ { minutes west of Greenwich }
+ { type of dst correction }
+ timezone = record
+ tz_minuteswest : longint;
+ tz_dsttime : longint;
+ end;
+ TTimeZone = timezone;
+ PTimeZone = ^TTimeZone;
+
+// Operations on timevals.
+// timercmp does not work for >= or <=.
+
+Function timerisset(tvp: timeval): Boolean;
+//Function timercmp(tvp, uvp, cmp);
+Procedure timerclear(var tvp: timeval);
+
+// Commands for ioctlsocket(), taken from the BSD file fcntl.h.
+//
+// Ioctl's have the command encoded in the lower word,
+// and the size of any in or out parameters in the upper
+// word. The high 2 bits of the upper word are used
+// to encode the in/out status of the parameter; for now
+// we restrict parameters to at most 128 bytes.
+
+const
+ IOCPARM_MASK = $7f; // parameters must be < 128 bytes
+ IOC_VOID = $20000000; // no parameters
+ IOC_OUT = $40000000; // copy out parameters
+ IOC_IN = $80000000; // copy in parameters
+ IOC_INOUT = IOC_IN or IOC_OUT; // 0x20000000 distinguishes new &
+ // old ioctl's
+const
+ // get # bytes to read
+ FIONREAD=(IOC_OUT or ((Longint (sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('f') shl 8) or 127);
+ // set/clear non-blocking i/o
+ FIONBIO=(IOC_IN or ((Longint(sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('f') shl 8) or 126);
+ // set/clear async i/o
+ FIOASYNC=(IOC_IN or ((Longint(sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('f') shl 8) or 125);
+
+// Socket I/O Controls
+const
+ // set high watermark
+ SIOCSHIWAT=(IOC_IN or ((Longint(sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('s') shl 8) or 0);
+ // get high watermark
+ SIOCGHIWAT=(IOC_OUT or ((Longint (sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('s') shl 8) or 1);
+ // set low watermark
+ SIOCSLOWAT=(IOC_IN or ((Longint(sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('s') shl 8) or 2);
+ // get low watermark
+ SIOCGLOWAT=(IOC_OUT or ((Longint (sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('s') shl 8) or 3);
+ // at oob mark?
+ SIOCATMARK=(IOC_OUT or ((Longint (sizeof(Cardinal)) and IOCPARM_MASK) shl 16) or (Ord('s') shl 8) or 7);
+
+// Structures returned by network data base library, taken from the
+// BSD file netdb.h. All addresses are supplied in host order, and
+// returned in network order (suitable for use in system calls).
+
+type
+ hostent=record
+ h_name: PChar; // official name of host
+ h_aliases: PPChar; // alias list
+ h_addrtype: LongInt; // host address type
+ h_length: LongInt; // length of address
+ case byte of
+ 0: (h_addr_list: ppchar); // list of addresses from name server
+ 1: (h_addr: ppchar) // address, for backward compatiblity
+ end;
+ phostent=^hostent;
+ THostEnt = hostent;
+
+// It is assumed here that a network number
+// fits in 32 bits.
+type
+ netent=record
+ n_name: PChar; // official name of net
+ n_aliases: PPChar; // alias list
+ n_addrtype: Longint; // net address type
+ n_net: Cardinal; // network #
+ End;
+ pnetent=^netent;
+ TNetEnt = netent;
+
+type
+ servent=record
+ s_name: PChar; // official service name
+ s_aliases: PPChar; // alias list
+ s_port: LongInt; // port #
+ s_proto: PChar; // protocol to use
+ end;
+ TServEnt = servent;
+ pservent=^servent;
+
+ protoent=record
+ p_name: PChar; // official protocol name
+ p_aliases: PPChar; // alias list
+ p_proto: LongInt; // protocol #
+ end;
+ TProtoEnt = protoent;
+ pprotoent=^protoent;
+
+// Constants and structures defined by the internet system,
+// Per RFC 790, September 1981, taken from the BSD file netinet/in.h.
+
+// Protocols
+const
+ IPPROTO_IP =0; // dummy for IP
+ IPPROTO_ICMP =1; // control message protocol
+ IPPROTO_GGP =2; // gateway^2 (deprecated)
+ IPPROTO_TCP =6; // tcp
+ IPPROTO_PUP =12; // pup
+ IPPROTO_UDP =17; // user datagram protocol
+ IPPROTO_IDP =22; // xns idp
+ IPPROTO_ND =77; // UNOFFICIAL net disk proto
+ IPPROTO_RAW =255; // raw IP packet
+ IPPROTO_MAX =256;
+
+// Port/socket numbers: network standard functions
+
+ IPPORT_ECHO =7;
+ IPPORT_DISCARD =9;
+ IPPORT_SYSTAT =11;
+ IPPORT_DAYTIME =13;
+ IPPORT_NETSTAT =15;
+ IPPORT_FTP =21;
+ IPPORT_TELNET =23;
+ IPPORT_SMTP =25;
+ IPPORT_TIMESERVER =37;
+ IPPORT_NAMESERVER =42;
+ IPPORT_WHOIS =43;
+ IPPORT_MTP =57;
+
+// Port/socket numbers: host specific functions
+
+ IPPORT_TFTP =69;
+ IPPORT_RJE =77;
+ IPPORT_FINGER =79;
+ IPPORT_TTYLINK =87;
+ IPPORT_SUPDUP =95;
+
+// UNIX TCP sockets
+
+ IPPORT_EXECSERVER =512;
+ IPPORT_LOGINSERVER =513;
+ IPPORT_CMDSERVER =514;
+ IPPORT_EFSSERVER =520;
+
+// UNIX UDP sockets
+
+ IPPORT_BIFFUDP =512;
+ IPPORT_WHOSERVER =513;
+ IPPORT_ROUTESERVER =520;
+ // 520+1 also used
+
+// Ports < IPPORT_RESERVED are reserved for
+// privileged processes (e.g. root).
+
+ IPPORT_RESERVED =1024;
+
+// Link numbers
+
+ IMPLINK_IP =155;
+ IMPLINK_LOWEXPER =156;
+ IMPLINK_HIGHEXPER =158;
+
+// Internet address (old style... should be updated)
+
+type
+ in_addr=record
+ case Integer of
+ 1:(S_un_b:record s_b1,s_b2,s_b3,s_b4: Byte; end;);
+ 2:(s_un_w:record s_w1,s_w2: Word; end;);
+ 3:(s_addr: Cardinal);
+ end;
+ TInAddr = in_addr;
+ PInAddr = ^TInAddr;
+
+{$define s_addr:=in_addr.S_addr} // can be used for most tcp & ip code
+{$define s_host:=in_addr.S_un_b.s_b2} // host on imp
+{$define s_net:=in_addr.S_un_b.s_b1} // network
+{$define s_imp:=in_addr.S_un_w.s_w2} // imp
+{$define s_impno:=in_addr.S_un_b.s_b4} // imp #
+{$define s_lh:=in_addr.S_un_b.s_b3} // logical host
+
+// Definitions of bits in internet address integers.
+// On subnets, the decomposition of addresses to host and net parts
+// is done according to subnet mask, not the masks here.
+const
+{$define IN_CLASSA(i):=((Longint(i) and $80000000) = 0)}
+ IN_CLASSA_NET =$ff000000;
+ IN_CLASSA_NSHIFT =24;
+ IN_CLASSA_HOST =$00ffffff;
+ IN_CLASSA_MAX =128;
+
+{$define IN_CLASSB(i):=((Longint(i) and $c0000000) = $80000000)}
+ IN_CLASSB_NET =$ffff0000;
+ IN_CLASSB_NSHIFT =16;
+ IN_CLASSB_HOST =$0000ffff;
+ IN_CLASSB_MAX =65536;
+
+{$define IN_CLASSC(i):=((Longint(i) and $e0000000) = $c0000000)}
+ IN_CLASSC_NET =$ffffff00;
+ IN_CLASSC_NSHIFT =8;
+ IN_CLASSC_HOST =$000000ff;
+
+ INADDR_ANY =$00000000;
+ INADDR_LOOPBACK =$7f000001;
+ INADDR_BROADCAST =$ffffffff;
+ INADDR_NONE =$ffffffff;
+
+// Socket address, internet style.
+
+Type
+ sockaddr_in=Record
+ case integer of
+ 0 : ( (* equals to sockaddr_in, size is 16 byte *)
+ sin_family : SmallInt; (* 2 byte *)
+ sin_port : Word; (* 2 byte *)
+ sin_addr : TInAddr; (* 4 byte *)
+ sin_zero : array[0..8-1] of char; (* 8 byte *)
+ );
+ 1 : ((* equals to sockaddr, size is 16 byte *)
+ sa_family : Smallint; (* 2 byte *)
+ sa_data : array[0..14-1] of char; (* 14 byte *)
+ );
+ end;
+ TSockAddrIn = sockaddr_in;
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddr = sockaddr_in;
+ PSockAddr = ^TSockAddr;
+
+const
+ WSADESCRIPTION_LEN =256;
+ WSASYS_STATUS_LEN =128;
+
+Type
+ WSAData=Record
+ wVersion:Word;
+ wHighVersion:Word;
+ szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+ szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+ iMaxSockets:Word;
+ iMaxUdpDg:Word;
+ // in OS/2 no such entry
+ // pad1 : SmallInt; { 2 byte, ofs 394 } { ensure right packaging }
+ lpVendorInfo:PChar;
+ End;
+ PWSADATA=^WSAData;
+ LPWSADATA=^WSAData;
+ TWSAData = WSADATA;
+
+// Options for use with [gs]etsockopt at the IP level.
+
+Const
+ IP_OPTIONS =1; // set/get IP per-packet options
+
+ IP_MULTICAST_IF = 2;
+ IP_MULTICAST_TTL = 3;
+ IP_MULTICAST_LOOP = 4;
+ IP_ADD_MEMBERSHIP = 5;
+ IP_DROP_MEMBERSHIP = 6;
+ IP_DEFAULT_MULTICAST_TTL = 1;
+ IP_DEFAULT_MULTICAST_LOOP = 1;
+ IP_MAX_MEMBERSHIPS = 20;
+
+type
+ ip_mreq = record
+ imr_multiaddr : in_addr;
+ imr_interface : in_addr;
+ end;
+
+// Definitions related to sockets: types, address families, options,
+// taken from the BSD file sys/socket.h.
+
+// This is used instead of -1, since the
+// TSocket type is unsigned.
+Const
+ INVALID_SOCKET = -1;
+ SOCKET_ERROR = -1;
+
+// Types
+
+Const
+ SOCK_STREAM =1; // stream socket
+ SOCK_DGRAM =2; // datagram socket
+ SOCK_RAW =3; // raw-protocol interface
+ SOCK_RDM =4; // reliably-delivered message
+ SOCK_SEQPACKET =5; // sequenced packet stream
+
+// Option flags per-socket.
+
+Const
+ SO_DEBUG =$0001; // turn on debugging info recording
+ SO_ACCEPTCONN =$0002; // socket has had listen()
+ SO_REUSEADDR =$0004; // allow local address reuse
+ SO_KEEPALIVE =$0008; // keep connections alive
+ SO_DONTROUTE =$0010; // just use interface addresses
+ SO_BROADCAST =$0020; // permit sending of broadcast msgs
+ SO_USELOOPBACK =$0040; // bypass hardware when possible
+ SO_LINGER =$0080; // linger on close if data present
+ SO_OOBINLINE =$0100; // leave received OOB data in line
+ SO_DONTLINGER =NOT SO_LINGER; // dont linger
+
+// Additional options.
+
+ SO_SNDBUF =$1001; // send buffer size
+ SO_RCVBUF =$1002; // receive buffer size
+ SO_SNDLOWAT =$1003; // send low-water mark
+ SO_RCVLOWAT =$1004; // receive low-water mark
+ SO_SNDTIMEO =$1005; // send timeout
+ SO_RCVTIMEO =$1006; // receive timeout
+ SO_ERROR =$1007; // get error status and clear
+ SO_TYPE =$1008; // get socket type
+
+ {
+ Options for connect and disconnect data and options. Used only by
+ non-TCP/IP transports such as DECNet, OSI TP4, etc.
+ }
+ SO_CONNDATA = $7000;
+ SO_CONNOPT = $7001;
+ SO_DISCDATA = $7002;
+ SO_DISCOPT = $7003;
+ SO_CONNDATALEN = $7004;
+ SO_CONNOPTLEN = $7005;
+ SO_DISCDATALEN = $7006;
+ SO_DISCOPTLEN = $7007;
+
+ {
+ Option for opening sockets for synchronous access.
+ }
+ SO_OPENTYPE = $7008;
+ SO_SYNCHRONOUS_ALERT = $10;
+ SO_SYNCHRONOUS_NONALERT = $20;
+
+ {
+ Other NT-specific options.
+ }
+ SO_MAXDG = $7009;
+ SO_MAXPATHDG = $700A;
+ SO_UPDATE_ACCEPT_CONTEXT = $700B;
+ SO_CONNECT_TIME = $700C;
+
+// TCP options.
+
+Const
+ TCP_NODELAY = $0001;
+ TCP_BSDURGENT = $7000;
+
+// Address families.
+
+Const
+ AF_UNSPEC =0; // unspecified
+ AF_UNIX =1; // local to host (pipes, portals)
+ AF_INET =2; // internetwork: UDP, TCP, etc.
+ AF_IMPLINK =3; // arpanet imp addresses
+ AF_PUP =4; // pup protocols: e.g. BSP
+ AF_CHAOS =5; // mit CHAOS protocols
+ AF_NS =6; // XEROX NS protocols
+ AF_ISO =7; // ISO protocols
+ AF_OSI =AF_ISO; // OSI is ISO
+ AF_ECMA =8; // european computer manufacturers
+ AF_DATAKIT =9; // datakit protocols
+ AF_CCITT =10; // CCITT protocols, X.25 etc
+ AF_SNA =11; // IBM SNA
+ AF_DECnet =12; // DECnet
+ AF_DLI =13; // Direct data link interface
+ AF_LAT =14; // LAT
+ AF_HYLINK =15; // NSC Hyperchannel
+ AF_APPLETALK =16; // AppleTalk
+ AF_NETBIOS =17; // NetBios-style addresses
+
+
+ { FireFox }
+ AF_FIREFOX = 19;
+ { Somebody is using this! }
+ AF_UNKNOWN1 = 20;
+ { Banyan }
+ AF_BAN = 21;
+
+ AF_MAX =22;
+
+// Structure used by kernel to store most
+// addresses.
+
+Type
+ sockaddr=Record
+ sa_family:Word; // address family
+ sa_data:Array[0..13] of char; // up to 14 bytes of direct address
+ End;
+
+// Structure used by kernel to pass protocol
+// information in raw sockets.
+
+ sockproto=Record
+ sp_family:Word; // address family
+ sp_protocol:Word; // protocol
+ End;
+
+ TSockProto = sockproto;
+ PSockProto = ^TSockProto;
+
+
+// Protocol families, same as address families for now.
+
+Const
+ PF_UNSPEC =AF_UNSPEC;
+ PF_UNIX =AF_UNIX;
+ PF_INET =AF_INET;
+ PF_IMPLINK =AF_IMPLINK;
+ PF_PUP =AF_PUP;
+ PF_CHAOS =AF_CHAOS;
+ PF_NS =AF_NS;
+ PF_ISO =AF_ISO;
+ PF_OSI =AF_OSI;
+ PF_ECMA =AF_ECMA;
+ PF_DATAKIT =AF_DATAKIT;
+ PF_CCITT =AF_CCITT;
+ PF_SNA =AF_SNA;
+ PF_DECnet =AF_DECnet;
+ PF_DLI =AF_DLI;
+ PF_LAT =AF_LAT;
+ PF_HYLINK =AF_HYLINK;
+ PF_APPLETALK =AF_APPLETALK;
+
+ PF_FIREFOX = AF_FIREFOX;
+ PF_UNKNOWN1 = AF_UNKNOWN1;
+ PF_BAN = AF_BAN;
+ PF_MAX = AF_MAX;
+
+
+// Structure used for manipulating linger option.
+
+Type
+ linger=Record
+ l_onoff:LongInt; // option on/off
+ l_linger:LongInt; // linger time
+ End;
+ TLinger = linger;
+ PLinger = ^TLinger;
+
+// Level number for (get/set)sockopt() to apply to socket itself.
+
+Const
+ SOL_SOCKET =$ffff; // options for socket level
+
+// Maximum queue length specifiable by listen.
+
+ SOMAXCONN =5;
+
+ MSG_OOB =1; // process out-of-band data
+ MSG_PEEK =2; // peek at incoming message
+ MSG_DONTROUTE =4; // send without using routing tables
+ MSG_MAXIOVLEN =16;
+
+// Define constant based on rfc883, used by gethostbyxxxx() calls.
+
+ MAXGETHOSTSTRUCT =1024;
+ MAXHOSTNAMELEN = MAXGETHOSTSTRUCT;
+
+// Define flags to be used with the WSAAsyncSelect() call.
+
+ FD_READ =$01;
+ FD_WRITE =$02;
+ FD_OOB =$04;
+ FD_ACCEPT =$08;
+ FD_CONNECT =$10;
+ FD_CLOSE =$20;
+
+// All Windows Sockets error constants are biased by WSABASEERR from
+// the "normal"
+
+ WSABASEERR =10000;
+
+
+// Windows Sockets definitions of regular Microsoft C error constants
+
+ WSAEINTR =(WSABASEERR+4);
+ WSAEBADF =(WSABASEERR+9);
+ WSAEACCES =(WSABASEERR+13);
+ WSAEFAULT =(WSABASEERR+14);
+ WSAEINVAL =(WSABASEERR+22);
+ WSAEMFILE =(WSABASEERR+24);
+
+// Windows Sockets definitions of regular Berkeley error constants
+
+ WSAEWOULDBLOCK =(WSABASEERR+35);
+ WSAEINPROGRESS =(WSABASEERR+36);
+ WSAEALREADY =(WSABASEERR+37);
+ WSAENOTSOCK =(WSABASEERR+38);
+ WSAEDESTADDRREQ =(WSABASEERR+39);
+ WSAEMSGSIZE =(WSABASEERR+40);
+ WSAEPROTOTYPE =(WSABASEERR+41);
+ WSAENOPROTOOPT =(WSABASEERR+42);
+ WSAEPROTONOSUPPORT =(WSABASEERR+43);
+ WSAESOCKTNOSUPPORT =(WSABASEERR+44);
+ WSAEOPNOTSUPP =(WSABASEERR+45);
+ WSAEPFNOSUPPORT =(WSABASEERR+46);
+ WSAEAFNOSUPPORT =(WSABASEERR+47);
+ WSAEADDRINUSE =(WSABASEERR+48);
+ WSAEADDRNOTAVAIL =(WSABASEERR+49);
+ WSAENETDOWN =(WSABASEERR+50);
+ WSAENETUNREACH =(WSABASEERR+51);
+ WSAENETRESET =(WSABASEERR+52);
+ WSAECONNABORTED =(WSABASEERR+53);
+ WSAECONNRESET =(WSABASEERR+54);
+ WSAENOBUFS =(WSABASEERR+55);
+ WSAEISCONN =(WSABASEERR+56);
+ WSAENOTCONN =(WSABASEERR+57);
+ WSAESHUTDOWN =(WSABASEERR+58);
+ WSAETOOMANYREFS =(WSABASEERR+59);
+ WSAETIMEDOUT =(WSABASEERR+60);
+ WSAECONNREFUSED =(WSABASEERR+61);
+ WSAELOOP =(WSABASEERR+62);
+ WSAENAMETOOLONG =(WSABASEERR+63);
+ WSAEHOSTDOWN =(WSABASEERR+64);
+ WSAEHOSTUNREACH =(WSABASEERR+65);
+ WSAENOTEMPTY =(WSABASEERR+66);
+ WSAEPROCLIM =(WSABASEERR+67);
+ WSAEUSERS =(WSABASEERR+68);
+ WSAEDQUOT =(WSABASEERR+69);
+ WSAESTALE =(WSABASEERR+70);
+ WSAEREMOTE =(WSABASEERR+71);
+ WSAEDISCON = WSABASEERR + 101;
+
+// Extended Windows Sockets error constant definitions
+
+ WSASYSNOTREADY =(WSABASEERR+91);
+ WSAVERNOTSUPPORTED =(WSABASEERR+92);
+ WSANOTINITIALISED =(WSABASEERR+93);
+
+// Error return codes from gethostbyname() and gethostbyaddr()
+// (when using the resolver). Note that these errors are
+// retrieved via WSAGetLastError() and must therefore follow
+// the rules for avoiding clashes with error numbers from
+// specific implementations or language run-time systems.
+// For this reason the codes are based at WSABASEERR+1001.
+// Note also that [WSA]NO_ADDRESS is defined only for
+// compatibility purposes.
+
+{$define h_errno:=WSAGetLastError()}
+
+// Authoritative Answer: Host not found
+
+ WSAHOST_NOT_FOUND =(WSABASEERR+1001);
+ HOST_NOT_FOUND =WSAHOST_NOT_FOUND;
+
+// Non-Authoritative: Host not found, or SERVERFAIL
+
+ WSATRY_AGAIN =(WSABASEERR+1002);
+ TRY_AGAIN =WSATRY_AGAIN;
+
+// Non recoverable errors, FORMERR, REFUSED, NOTIMP
+
+ WSANO_RECOVERY =(WSABASEERR+1003);
+ NO_RECOVERY =WSANO_RECOVERY;
+
+// Valid name, no data record of requested type
+
+ WSANO_DATA =(WSABASEERR+1004);
+ NO_DATA =WSANO_DATA;
+
+// no address, look for MX record
+
+ WSANO_ADDRESS =WSANO_DATA;
+ NO_ADDRESS =WSANO_ADDRESS;
+
+// Windows Sockets errors redefined as regular Berkeley error constants
+
+Const
+ EWOULDBLOCK =WSAEWOULDBLOCK;
+ EINPROGRESS =WSAEINPROGRESS;
+ EALREADY =WSAEALREADY;
+ ENOTSOCK =WSAENOTSOCK;
+ EDESTADDRREQ =WSAEDESTADDRREQ;
+ EMSGSIZE =WSAEMSGSIZE;
+ EPROTOTYPE =WSAEPROTOTYPE;
+ ENOPROTOOPT =WSAENOPROTOOPT;
+ EPROTONOSUPPORT =WSAEPROTONOSUPPORT;
+ ESOCKTNOSUPPORT =WSAESOCKTNOSUPPORT;
+ EOPNOTSUPP =WSAEOPNOTSUPP;
+ EPFNOSUPPORT =WSAEPFNOSUPPORT;
+ EAFNOSUPPORT =WSAEAFNOSUPPORT;
+ EADDRINUSE =WSAEADDRINUSE;
+ EADDRNOTAVAIL =WSAEADDRNOTAVAIL;
+ ENETDOWN =WSAENETDOWN;
+ ENETUNREACH =WSAENETUNREACH;
+ ENETRESET =WSAENETRESET;
+ ECONNABORTED =WSAECONNABORTED;
+ ECONNRESET =WSAECONNRESET;
+ ENOBUFS =WSAENOBUFS;
+ EISCONN =WSAEISCONN;
+ ENOTCONN =WSAENOTCONN;
+ ESHUTDOWN =WSAESHUTDOWN;
+ ETOOMANYREFS =WSAETOOMANYREFS;
+ ETIMEDOUT =WSAETIMEDOUT;
+ ECONNREFUSED =WSAECONNREFUSED;
+ ELOOP =WSAELOOP;
+ ENAMETOOLONG =WSAENAMETOOLONG;
+ EHOSTDOWN =WSAEHOSTDOWN;
+ EHOSTUNREACH =WSAEHOSTUNREACH;
+ ENOTEMPTY =WSAENOTEMPTY;
+ EPROCLIM =WSAEPROCLIM;
+ EUSERS =WSAEUSERS;
+ EDQUOT =WSAEDQUOT;
+ ESTALE =WSAESTALE;
+ EREMOTE =WSAEREMOTE;
+
+ TF_DISCONNECT = $01;
+ TF_REUSE_SOCKET = $02;
+ TF_WRITE_BEHIND = $04;
+
+ {
+ Options for use with [gs]etsockopt at the IP level.
+ }
+ IP_TTL = 7;
+ IP_TOS = 8;
+ IP_DONTFRAGMENT = 9;
+
+ type
+ _TRANSMIT_FILE_BUFFERS = record
+ Head : Pointer;
+ HeadLength : Cardinal;
+ Tail : Pointer;
+ TailLength : Cardinal;
+ end;
+ TRANSMIT_FILE_BUFFERS = _TRANSMIT_FILE_BUFFERS;
+ TTransmitFileBuffers = _TRANSMIT_FILE_BUFFERS;
+ PTransmitFileBuffers = ^TTransmitFileBuffers;
+
+// Socket function prototypes
+
+Function accept(s: TSocket; Var addr; Var addrlen: LongInt): TSocket; cdecl;
+ external 'PMWSock' name 'accept';
+Function accept(s:TSocket; addr: PSockAddr; addrlen : PLongint) : TSocket; cdecl;
+ external 'PMWSock' name 'accept';
+Function accept(s:TSocket; addr: PSockAddr; var addrlen : Longint) : TSocket; cdecl;
+ external 'PMWSock' name 'accept';
+
+Function bind(s: TSocket; Const addr; namelen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'bind';
+Function bind(s:TSocket; addr: PSockaddr;namelen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'bind';
+
+Function closesocket(s: TSocket): LongInt; cdecl;
+ external 'PMWSock' name 'closesocket';
+
+Function connect(s: TSocket; Const name: sockaddr; namelen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'connect';
+Function connect(s:TSocket; addr:PSockAddr; namelen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'connect';
+
+Function ioctlsocket(s: TSocket; cmd: LongInt; Var argp: Cardinal): LongInt; cdecl;
+ external 'PMWSock' name 'ioctlsocket';
+Function ioctlsocket(s: TSocket; cmd: longint; var arg:longint): Longint; cdecl;
+ external 'PMWSock' name 'ioctlsocket';
+Function ioctlsocket(s: TSocket; cmd: longint; argp: PCardinal): Longint; cdecl;
+ external 'PMWSock' name 'ioctlsocket';
+
+Function getpeername(s: TSocket; Var name: sockaddr; Var nameLen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'getpeername';
+
+Function getsockname(s: TSocket;Var name: sockaddr; Var namelen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'getsockname';
+
+Function getsockopt(s: TSocket; level, optname: LongInt;Var optval; Var optlen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'getsockopt';
+Function getsockopt(s: TSocket; level: Longint; optname: Longint; optval:pchar;var optlen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'getsockopt';
+
+Function htonl(hostlong: Cardinal): Cardinal; cdecl;
+ external 'PMWSock' name 'htonl';
+
+Function htons(hostshort: Word): Word; cdecl;
+ external 'PMWSock' name 'htons';
+
+Function inet_addr(cp: pchar): Cardinal; cdecl;
+ external 'PMWSock' name 'inet_addr';
+
+Function inet_ntoa(Var _in: in_addr): PChar; cdecl;
+ external 'PMWSock' name 'inet_ntoa';
+Function inet_ntoa(i: PInAddr): pchar; cdecl;
+ external 'PMWSock' name 'inet_ntoa';
+
+Function listen(s: TSocket; backlog: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'listen';
+
+Function ntohl(netlong: Cardinal): Cardinal; cdecl;
+ external 'PMWSock' name 'ntohl';
+
+Function ntohs(netshort: Word): Word; cdecl;
+ external 'PMWSock' name 'ntohs';
+
+Function recv(s: TSocket;Var Buf; len, flags: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'recv';
+Function recv(s: TSocket; buf:pchar; len: Longint; flags: Longint): Longint; cdecl;
+ external 'PMWSock' name 'recv';
+
+Function recvfrom(s: TSocket; Var Buf: PChar; len, flags:LongInt;
+ Var from: sockaddr; Var fromLen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'recvfrom';
+Function recvfrom(s: TSocket; buf:pchar; len: Longint; flags: Longint;
+ from: PSockAddr; fromlen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'recvfrom';
+Function recvfrom(s: TSocket; var buf; len: Longint; flags: Longint;
+ Const from: TSockAddr; var fromlen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'recvfrom';
+
+Function select(nfds: LongInt; Var readfds, writefds, exceptfds: fdset;
+ Const timeout: timeval): LongInt; cdecl;
+ external 'PMWSock' name 'select';
+Function select(nfds: Longint; readfds, writefds, exceptfds : PFDSet;
+ timeout: PTimeVal): Longint; cdecl;
+ external 'PMWSock' name 'select';
+
+Function send(s: TSocket; Const Buf: PChar; len, flags: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'send';
+
+Function sendto(s: TSocket; Const Buf: PChar; len, flags: LongInt;
+ Const _to: sockaddr; tolen: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'sendto';
+Function sendto(s: TSocket; buf: pchar; len: Longint; flags: Longint;
+ toaddr: PSockAddr; tolen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'sendto';
+
+Function setsockopt(s: TSocket; level: Longint; optname: Longint;
+ optval: pchar; optlen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'setsockopt';
+
+Function shutdown(s: TSocket; how: LongInt): LongInt; cdecl;
+ external 'PMWSock' name 'shutdown';
+
+Function socket(af, typ, protocol: LongInt): TSocket; cdecl;
+ external 'PMWSock' name 'socket';
+
+// Database function prototypes
+
+Function gethostbyaddr(addr: pchar; len: Longint; t: Longint): PHostEnt; cdecl;
+ external 'PMWSock' name 'gethostbyaddr';
+
+Function gethostbyname(name: pchar): PHostEnt; cdecl;
+ external 'PMWSock' name 'gethostbyname';
+
+Function gethostname(name: pchar; namelen: Longint): Longint; cdecl;
+ external 'PMWSock' name 'gethostname';
+
+Function getservbyport(port: Longint; proto: pchar): PServEnt; cdecl;
+ external 'PMWSock' name 'getservbyport';
+
+Function getservbyname(name: pchar; proto: pchar): PServEnt; cdecl;
+ external 'PMWSock' name 'getservbyname';
+
+Function getprotobynumber(proto: LongInt): pprotoent; cdecl;
+ external 'PMWSock' name 'getprotobynumber';
+
+Function getprotobyname(name: pchar): PProtoEnt; cdecl;
+ external 'PMWSock' name 'getprotobyname';
+
+// Microsoft Windows Extension function prototypes
+
+Function WSAStartup(wVersionRequired: Word;Var aWSAData: WSAData): LongInt; cdecl;
+ external 'PMWSock' name 'WSAStartup';
+
+Function WSACleanup: LongInt; cdecl;
+ external 'PMWSock' name 'WSACleanup';
+
+Procedure WSASetLastError(iError: LongInt); cdecl;
+ external 'PMWSock' name 'WSASetLastError';
+
+Function WSAGetLastError: LongInt; cdecl;
+ external 'PMWSock' name 'WSAGetLastError';
+
+Function WSAIsBlocking: Longbool; cdecl;
+ external 'PMWSock' name 'WSAIsBlocking';
+
+Function WSAUnhookBlockingHook: LongInt; cdecl;
+ external 'PMWSock' name 'WSAUnhookBlockingHook';
+
+Function WSASetBlockingHook(lpBlockFunc: Pointer): Pointer; cdecl;
+ external 'PMWSock' name 'WSASetBlockingHook';
+
+Function WSACancelBlockingCall: LongInt; cdecl;
+ external 'PMWSock' name 'WSACancelBlockingCall';
+
+Function WSAAsyncGetServByName(hWnd: HWND; wMsg: Cardinal;
+ name: pchar; proto: pchar;
+ buf: pchar;
+ buflen: Longint): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncGetServByName';
+
+Function WSAAsyncGetServByPort(hWnd: HWND; wMsg: Cardinal;
+ port: Longint;
+ proto: pchar; buf: pchar;
+ buflen: Longint): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncGetServByPort';
+
+Function WSAAsyncGetProtoByName(hWnd: HWND; wMsg: Cardinal;
+ name: pchar; buf: pchar;
+ buflen: Longint): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncGetProtoByName';
+
+Function WSAAsyncGetProtoByNumber(hWnd: HWND; wMsg: Cardinal;
+ number: Longint;
+ buf: pchar;
+ buflen: Longint): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncGetProtoByNumber';
+
+Function WSAAsyncGetHostByName(hWnd: HWND; wMsg: Cardinal;
+ name: pchar; buf: pchar;
+ buflen: Longint): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncGetHostByName';
+
+Function WSAAsyncGetHostByAddr(hWnd: HWND; wMsg: Cardinal;
+ addr: pchar; len: Longint; t: Longint;
+ buf: pchar; buflen: Longint): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncGetHostByAddr';
+
+Function WSACancelAsyncRequest(hAsyncTaskHandle: Cardinal): LongInt; cdecl;
+ external 'PMWSock' name 'WSACancelAsyncRequest';
+
+Function WSAAsyncSelect(s: TSocket; ahWnd: HWND; wMsg: Cardinal; lEvent: LongInt): Cardinal; cdecl;
+ external 'PMWSock' name 'WSAAsyncSelect';
+
+// Windows message parameter composition and decomposition
+// macros.
+//
+// WSAMAKEASYNCREPLY is intended for use by the Windows Sockets implementation
+// when constructing the response to a WSAAsyncGetXByY() routine.
+
+Function WSAMakeAsyncReply(Buflen,Error:Word):dword;
+// Seems to be error in rtl\win32\winsock.pp
+Function WSAMakeSyncReply(Buflen,Error:Word):dword;
+
+// WSAMAKESELECTREPLY is intended for use by the Windows Sockets implementation
+// when constructing the response to WSAAsyncSelect().
+
+Function WSAMakeSelectReply(Event,Error:Word):dword;
+
+// WSAGETASYNCBUFLEN is intended for use by the Windows Sockets application
+// to extract the buffer length from the lParam in the response
+// to a WSAGetXByY().
+
+Function WSAGetAsyncBuflen(Param:dword):Word;
+
+//
+// WSAGETASYNCERROR is intended for use by the Windows Sockets application
+// to extract the error code from the lParam in the response
+// to a WSAGetXByY().
+
+Function WSAGetAsyncError(Param:dword):Word;
+
+// WSAGETSELECTEVENT is intended for use by the Windows Sockets application
+// to extract the event code from the lParam in the response
+// to a WSAAsyncSelect().
+
+Function WSAGetSelectEvent(Param:dword):Word;
+
+// WSAGETSELECTERROR is intended for use by the Windows Sockets application
+// to extract the error code from the lParam in the response
+// to a WSAAsyncSelect().
+
+Function WSAGetSelectError(Param:dword):Word;
+
+Procedure FD_ZERO(var aset: fdset);
+
+// Following functions not found in PMWSock
+{
+ function WSARecvEx(s:TSocket;var buf; len:tOS_INT; flags:ptOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'WSARecvEx';
+ function TransmitFile(hSocket:TSocket; hFile:THandle; nNumberOfBytesToWrite:dword;
+ nNumberOfBytesPerSend:DWORD; lpOverlapped:POverlapped;
+ lpTransmitBuffers:PTransmitFileBuffers; dwReserved:dword):Bool;stdcall;
+ external winsockdll name 'TransmitFile';
+
+ function AcceptEx(sListenSocket,sAcceptSocket:TSocket;
+ lpOutputBuffer:Pointer; dwReceiveDataLength,dwLocalAddressLength,
+ dwRemoteAddressLength:dword; var lpdwBytesReceived:dword;
+ lpOverlapped:POverlapped):Bool;stdcall;
+ external winsockdll name 'AcceptEx';
+
+ procedure GetAcceptExSockaddrs(lpOutputBuffer:Pointer;
+ dwReceiveDataLength,dwLocalAddressLength,dwRemoteAddressLength:dword;
+ var LocalSockaddr:TSockAddr; var LocalSockaddrLength:tOS_INT;
+ var RemoteSockaddr:TSockAddr; var RemoteSockaddrLength:tOS_INT);stdcall;
+ external winsockdll name 'GetAcceptExSockaddrs';
+}
+
+Implementation
+
+Procedure FD_CLR(ASocket: TSocket; var aset: fdset);
+var
+ I: Cardinal;
+begin
+ I := 0;
+ while I <= aset.fd_count do
+ begin
+ if (aset.fd_array[i] = ASocket) then
+ begin
+ while (i < (aset.fd_count-1)) do
+ begin
+ aset.fd_array[I]:=aset.fd_array[i+1];
+ Inc(I);
+ end;
+ Dec(aset.fd_count);
+ break;
+ end;
+ Inc (I);
+ end;
+end;
+
+Procedure FD_ZERO(var aset: fdset);
+Begin
+ aset.fd_count:=0;
+End;
+
+procedure FD_SET(Socket: TSocket; var FDSet: tfdset);
+begin
+ if FDSet.fd_count < FD_SETSIZE then
+ begin
+ FDSet.fd_array[FDSet.fd_count] := Socket;
+ Inc(FDSet.fd_count);
+ end;
+end;
+
+Function MAKELONG(a,b : longint) : LONGINT;
+begin
+ MAKELONG:=LONGINT((WORD(a)) or ((CARDINAL(WORD(b))) shl 16));
+end;
+
+Function WSAMakeAsyncReply(Buflen,Error:Word):dword;
+begin
+ WSAMakeAsyncReply:=MakeLong(Buflen, Error);
+end;
+
+Function WSAMakeSyncReply(Buflen,Error:Word):dword;
+begin
+ WSAMakeSyncReply:=WSAMakeAsyncReply(Buflen,Error);
+end;
+
+Function WSAMakeSelectReply(Event,Error:Word):dword;
+begin
+ WSAMakeSelectReply:=MakeLong(Event,Error);
+end;
+
+Function WSAGetAsyncBuflen(Param:dword):Word;
+begin
+ WSAGetAsyncBuflen:=lo(Param);
+end;
+
+Function WSAGetAsyncError(Param:dword):Word;
+begin
+ WSAGetAsyncError:=hi(Param);
+end;
+
+Function WSAGetSelectEvent(Param:dword):Word;
+begin
+ WSAGetSelectEvent:=lo(Param);
+end;
+
+Function WSAGetSelectError(Param:dword):Word;
+begin
+ WSAGetSelectError:=hi(Param);
+end;
+
+Function timerisset(tvp: timeval): Boolean;
+Begin
+ TimerIsSet:=Boolean(tvp.tv_sec or tvp.tv_usec);
+End;
+
+(*
+Function timercmp(tvp, uvp, cmp): Boolean;
+Begin
+ ((tvp)->tv_sec cmp (uvp)->tv_sec || \
+ (tvp)->tv_sec == (uvp)->tv_sec && (tvp)->tv_usec cmp (uvp)->tv_usec)
+End;
+*)
+
+Procedure timerclear(var tvp: timeval);
+begin
+ tvp.tv_sec:=0;
+ tvp.tv_usec:=0;
+end;
+
+end.
+
+{
+$Log: pmwsock.pas,v $
+Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/ports.pas b/rtl/os2/ports.pas
new file mode 100644
index 0000000000..7709ad7e39
--- /dev/null
+++ b/rtl/os2/ports.pas
@@ -0,0 +1,214 @@
+{
+ $Id: ports.pas,v 1.7 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ These files adds support for TP styled port accesses (port[],
+ portw[] and portl[] constructs) using Delphi classes.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+(*
+ Warning:
+ 1) You have to enable port access in your CONFIG.SYS (IOPL directive),
+ either globally (IOPL=YES), or just for particular application/-s with
+ a need for port access (IOPL=app_name1, appname2, ...).
+ 2) Once you access some port, access to this port is enabled all the time
+ for all EMX applications until EMX.DLL is unloaded from memory (i.e.
+ all applications using this library finish).
+*)
+
+unit Ports;
+
+{ This unit uses classes so ObjFpc mode is required. }
+{$Mode ObjFpc}
+
+interface
+
+type
+ TPort = class
+ protected
+ procedure WritePort (P: word; Data: byte);
+ function ReadPort (P: word): byte;
+ public
+ property PP [W: word]: byte read readport write writeport; default;
+ end;
+
+ TPortW = class
+ protected
+ procedure WritePort (P: word; Data: word);
+ function ReadPort (P: word): word;
+ public
+ property PP [W: word]: word read readport write writeport; default;
+ end;
+
+ TPortL = class
+ protected
+ procedure WritePort (P: word; Data: longint);
+ function ReadPort (P: word): longint;
+ public
+ property PP [W: word]: longint read readport write writeport; default;
+ end;
+
+ { Non-instantiated vars. As yet, they don't have to be instantiated,
+ because neither member variables nor virtual methods are accessed }
+
+var
+ Port, PortB: TPort;
+ PortW: TPortW;
+ PortL: TPortL;
+
+implementation
+
+{Import syscall to call it nicely from assembler procedures.}
+
+procedure syscall; external name '___SYSCALL';
+{$WARNING Still using EMX - has to be updated once native linking available!}
+
+
+{$AsmMode ATT}
+
+procedure TPort.WritePort (P: word; Data: byte); assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %edx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+ popl %eax
+{$ELSE REGCALL}
+ movw P, %dx
+ movb Data, %al
+{$ENDIF REGCALL}
+ outb %al, %dx
+end {['eax', 'ecx', 'edx']};
+
+function TPort.ReadPort (P: word): byte; assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+{$ELSE REGCALL}
+ movw P, %cx
+ pushl %ecx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+{$ELSE REGCALL}
+ movw P, %dx
+{$ENDIF REGCALL}
+ inb %dx, %al
+end {['eax', 'ecx', 'edx']};
+
+procedure TPortW.WritePort (P: word; Data : word); assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %edx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+ popl %eax
+{$ELSE REGCALL}
+ movw P, %dx
+ movw Data, %ax
+{$ENDIF REGCALL}
+ outw %ax, %dx
+end {['eax', 'ecx', 'edx']};
+
+function TPortW.ReadPort (P: word): word; assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+{$ELSE REGCALL}
+ movw P, %dx
+{$ENDIF REGCALL}
+ inw %dx, %ax
+end {['eax', 'ecx', 'edx']};
+
+procedure TPortL.WritePort (P: word; Data: longint); assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %edx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+ popl %eax
+{$ELSE REGCALL}
+ movw P, %dx
+ movl Data, %eax
+{$ENDIF REGCALL}
+ outl %eax, %dx
+end {['eax', 'ecx', 'edx']};
+
+function TPortL.ReadPort (P: word): longint; assembler;
+asm
+ xorl %ecx, %ecx
+{$IFDEF REGCALL}
+ movw %ax, %cx
+ pushl %ecx
+{$ELSE REGCALL}
+ movw P, %cx
+{$ENDIF REGCALL}
+ movl %ecx, %edx
+ movw $0x7F12, %ax
+ call syscall
+{$IFDEF REGCALL}
+ popl %edx
+{$ELSE REGCALL}
+ movw P, %dx
+{$ENDIF REGCALL}
+ inl %dx, %eax
+end {['eax', 'ecx', 'edx']};
+
+end.
+
+{
+ $Log: ports.pas,v $
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/printer.pas b/rtl/os2/printer.pas
new file mode 100644
index 0000000000..6e83ce2ee1
--- /dev/null
+++ b/rtl/os2/printer.pas
@@ -0,0 +1,35 @@
+{
+ $Id: printer.pas,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Printer unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit printer;
+interface
+
+{$I printerh.inc}
+
+implementation
+
+{$I printer.inc}
+
+begin
+ InitPrinter ('PRN');
+ SetPrinterExit;
+end.
+{
+ $Log: printer.pas,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/prt0.as b/rtl/os2/prt0.as
new file mode 100644
index 0000000000..bc3cdbd560
--- /dev/null
+++ b/rtl/os2/prt0.as
@@ -0,0 +1,87 @@
+/ prt0.s (emx+fpc) -- Made from crt0.s,
+/ Copyright (c) 1990-1999-2001 by Eberhard Mattes.
+/ Changed for Free Pascal in 1997 Daniel Mantione.
+/ This code is _not_ under the Library GNU Public
+/ License, because the original is not. See copying.emx
+/ for details. You should have received it with this
+/ product, write the author if you haven't.
+
+ .globl __text
+ .globl ___SYSCALL
+ .globl __data
+ .globl __init
+ .globl __dos_init
+ .globl __dos_syscall
+
+ .text
+
+__text:
+ push $__data
+ call __dos_init
+ jmp __init
+
+___SYSCALL:
+ call __dos_syscall
+ ret
+
+ .space 6, 0x90
+
+__init: cld
+
+ call _main
+ movb $0x4c,%ah
+ call ___SYSCALL
+2: jmp 2b
+
+/ In executables created with emxbind, the call to _dos_init will
+/ be fixed up at load time to _emx_init of emx.dll. Under DOS,
+/ this dummy is called instead as there is no fixup. This module
+/ must be linked statically to avoid having two fixups for the
+/ same location.
+
+__dos_init:
+ ret $4
+
+ .align 2, 0x90
+
+__dos_syscall:
+ int $0x21
+ ret
+
+ .data
+
+/ The data segment starts with a table containing the start and end
+/ addresses of the text, data and bss segments
+
+__data:
+ .long __text
+ .long __etext
+ .long __data
+ .long __edata
+ .long __edata
+ .long __end
+__heap_base:
+ .long 0
+__heap_end:
+ .long 0
+__heap_brk:
+ .long 0
+ .long 0
+ .long __os2dll
+ .long 0
+ .long 0
+ .long 0x02000000
+ .long 0
+ .long 0
+ .byte 0
+ .space 63, 0
+
+/ Don't touch this. It's EMX vodoo. In short, this causes the __os2dll symbol
+/ point to table of DLL data that the linker includes in the executable.
+
+ .stabs "__os2dll", 21, 0, 0, 0xffffffff
+ .stabs "___CTOR_LIST__", 21, 0, 0, 0xffffffff
+ .stabs "___DTOR_LIST__", 21, 0, 0, 0xffffffff
+ .stabs "___crtinit1__", 21, 0, 0, 0xffffffff
+ .stabs "___crtexit1__", 21, 0, 0, 0xffffffff
+ .stabs "___eh_frame__", 21, 0, 0, 0xffffffff
diff --git a/rtl/os2/so32dll.pas b/rtl/os2/so32dll.pas
new file mode 100644
index 0000000000..ca6c055fd5
--- /dev/null
+++ b/rtl/os2/so32dll.pas
@@ -0,0 +1,1587 @@
+{
+ $Id: so32dll.pas,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000, 2001 by madded2 (madded@vao.udmnet.ru).
+ Copyright (c) 2002, 2004 Yuri Prokushev (prokushev@freemail.ru).
+
+ Interface to OS/2 32-bit sockets library
+
+ **********************************************************************
+
+ Inet & Sockets Unit v1.04.
+ /c/ 2000, 2001 by madded2 (madded@vao.udmnet.ru).
+ based on units from SIBYL & infos from Toolkit 4.0.
+
+ for help use tcppr.inf and C samples from toolkit.
+
+ without res_* and dh_* funcs, and have very
+ bad support for select() and ioctl() funcs
+
+ new in ver 1.04 : little ioctl() & iptrace support + errors SOCE* constants
+ new in ver 1.03 : used inet_lib.lib file for fixing VP linker bug
+ new in ver 1.02 : $saves sections, need for correct registers operations
+ new in ver 1.01 : ip header struct
+}
+{
+@abstract(a unit to handle sockets)
+@author(Yuri Prokushev (prokushev@freemail.ru))
+@author(madded2 (madded@vao.udmnet.ru))
+@created(3 Sep 2002)
+@lastmod(23 Sep 2002)
+@todo(sys/ioctl.h, sys/ioctlos2.h, sys/itypes.h)
+This is functions from SO32DLL.DLL. These functions allows to use
+protocol-independed sockets. Equal to SYS\SOCKET.H, NERRNO.H, SYS\SYSCTL.H.
+}
+unit SO32Dll;
+
+interface
+
+{$MODE ObjFPC}
+{$ASMMODE Intel}
+
+(***************************************************************************)
+(* *)
+(* Types *)
+(* *)
+(***************************************************************************)
+const
+ // stream socket
+ SOCK_STREAM = 1;
+ // datagram socket
+ SOCK_DGRAM = 2;
+ // raw-protocol interface
+ SOCK_RAW = 3;
+ // reliably-delivered message
+ SOCK_RDM = 4;
+ // sequenced packet stream
+ SOCK_SEQPACKET = 5;
+
+(***************************************************************************)
+(* *)
+(* Option flags per-socket *)
+(* *)
+(***************************************************************************)
+const
+ // turn on debugging info recording
+ SO_DEBUG = $0001;
+ // socket has had listen()
+ SO_ACCEPTCONN = $0002;
+ // allow local address reuse
+ SO_REUSEADDR = $0004;
+ // keep connections alive
+ SO_KEEPALIVE = $0008;
+ // just use interface addresses
+ SO_DONTROUTE = $0010;
+ // permit sending of broadcast msgs
+ SO_BROADCAST = $0020;
+ // bypass hardware when possible
+ SO_USELOOPBACK = $0040;
+ // linger on close if data present
+ SO_LINGER = $0080;
+ // leave received OOB data in line
+ SO_OOBINLINE = $0100;
+ // limited broadcast sent on all IFs
+ SO_L_BROADCAST = $0200;
+ // set if shut down called for rcv
+ SO_RCV_SHUTDOWN = $0400;
+ // set if shutdown called for send
+ SO_SND_SHUTDOWN = $0800;
+ // allow local address & port reuse
+ SO_REUSEPORT = $1000;
+ // allow t/tcp on socket
+ SO_TTCP = $2000;
+
+(***************************************************************************)
+(* *)
+(* Additional options, not kept in so_options *)
+(* *)
+(***************************************************************************)
+const
+ // send buffer size
+ SO_SNDBUF = $1001;
+ // receive buffer size
+ SO_RCVBUF = $1002;
+ // send low-water mark
+ SO_SNDLOWAT = $1003;
+ // receive low-water mark
+ SO_RCVLOWAT = $1004;
+ // send timeout
+ SO_SNDTIMEO = $1005;
+ // receive timeout
+ SO_RCVTIMEO = $1006;
+ // get error status and clear
+ SO_ERROR = $1007;
+ // get socket type
+ SO_TYPE = $1008;
+ // get socket options
+ SO_OPTIONS = $1010;
+
+(***************************************************************************)
+(* *)
+(* Structure used for manipulating linger option *)
+(* *)
+(***************************************************************************)
+type
+ //Structure used for manipulating linger option
+ linger = record
+ l_onoff : Longint; // option on/off
+ l_linger : Longint; // linger time
+ end;
+
+(***************************************************************************)
+(* *)
+(* Level number for (get/set)sockopt() to apply to socket itself *)
+(* *)
+(***************************************************************************)
+const
+ // options for socket level
+ SOL_SOCKET = $ffff;
+
+(***************************************************************************)
+(* *)
+(* Address families *)
+(* *)
+(***************************************************************************)
+const
+ // unspecified
+ AF_UNSPEC = 0;
+ // local to host (pipes, portals)
+ AF_LOCAL = 1;
+ // backward compatibility
+ AF_UNIX = AF_LOCAL;
+ AF_OS2 = AF_UNIX;
+ // internetwork: UDP, TCP, etc.
+ AF_INET = 2;
+ // arpanet imp addresses
+ AF_IMPLINK = 3;
+ // pup protocols: e.g. BSP
+ AF_PUP = 4;
+ // mit CHAOS protocols
+ AF_CHAOS = 5;
+ // XEROX NS protocols
+ AF_NS = 6;
+ // ISO protocols
+ AF_ISO = 7;
+ // ISO protocols
+ AF_OSI = AF_ISO;
+ // european computer manufacturers
+ AF_ECMA = 8;
+ // datakit protocols
+ AF_DATAKIT = 9;
+ // CCITT protocols, X.25 etc
+ AF_CCITT = 10;
+ // IBM SNA
+ AF_SNA = 11;
+ // DECnet
+ AF_DECnet = 12;
+ // DEC Direct data link interface
+ AF_DLI = 13;
+ // LAT
+ AF_LAT = 14;
+ // NSC Hyperchannel
+ AF_HYLINK = 15;
+ // Apple Talk
+ AF_APPLETALK = 16;
+ // Netbios
+ AF_NB = 17;
+ // Netbios
+ AF_NETBIOS = AF_NB;
+ // Link layer interface
+ AF_LINK = 18;
+ // eXpress Transfer Protocol (no AF)
+ pseudo_AF_XTP = 19;
+ // connection-oriented IP, aka ST II
+ AF_COIP = 20;
+ // Computer Network Technology
+ AF_CNT = 21;
+ // Help Identify RTIP packets
+ pseudo_AF_RTIP = 22;
+ // Novell Internet Protocol
+ AF_IPX = 23;
+ // Simple Internet Protocol
+ AF_SIP = 24;
+ AF_INET6 = 24;
+ // Help Identify PIP packets
+ pseudo_AF_PIP = 25;
+ // Internal Routing Protocol
+ AF_ROUTE = 39;
+ // firewall support
+ AF_FWIP = 40;
+ // IPSEC and encryption techniques
+ AF_IPSEC = 41;
+ // DES
+ AF_DES = 42;
+ AF_MD5 = 43;
+ AF_CDMF = 44;
+
+ AF_MAX = 45;
+
+(***************************************************************************)
+(* *)
+(* Structure used by kernel to store most addresses *)
+(* *)
+(***************************************************************************)
+type
+ // Structure used by kernel to store most addresses
+ sockaddr = record
+ sa_len: Byte; // total length
+ sa_family: Byte; // address family
+ sa_data: array [0..13] of Byte; // up to 14 bytes of direct address
+ end;
+ psockaddr = ^sockaddr;
+
+(***************************************************************************)
+(* *)
+(* Structure used by kernel to pass protocol information in raw sockets *)
+(* *)
+(***************************************************************************)
+type
+ // Structure used by kernel to pass protocol information in raw sockets
+ sockproto = record
+ sp_family: Word; // address family
+ sp_protocol: Word; // protocol
+ end;
+
+
+(***************************************************************************)
+(* *)
+(* Protocol families, same as address families for now *)
+(* *)
+(***************************************************************************)
+const
+ PF_UNSPEC = AF_UNSPEC;
+ PF_LOCAL = AF_LOCAL;
+ PF_UNIX = AF_UNIX;
+ PF_OS2 = AF_OS2;
+ PF_INET = AF_INET;
+ PF_IMPLINK = AF_IMPLINK;
+ PF_PUP = AF_PUP;
+ PF_CHAOS = AF_CHAOS;
+ PF_NS = AF_NS;
+ PF_ISO = AF_ISO;
+ PF_OSI = AF_OSI;
+ PF_ECMA = AF_ECMA;
+ PF_DATAKIT = AF_DATAKIT;
+ PF_CCITT = AF_CCITT;
+ PF_SNA = AF_SNA;
+ PF_DECnet = AF_DECnet;
+ PF_DLI = AF_DLI;
+ PF_LAT = AF_LAT;
+ PF_HYLINK = AF_HYLINK;
+ PF_APPLETALK = AF_APPLETALK;
+ PF_NETBIOS = AF_NB;
+ PF_NB = AF_NB;
+ PF_ROUTE = AF_ROUTE;
+ PF_LINK = AF_LINK;
+ // really just proto family, no AF
+ PF_XTP = pseudo_AF_XTP;
+ PF_COIP = AF_COIP;
+ PF_CNT = AF_CNT;
+ PF_SIP = AF_SIP;
+ PF_INET6 = AF_INET6;
+ // same format as AF_NS
+ PF_IPX = AF_IPX;
+ // same format as AF_INET
+ PF_RTIP = pseudo_AF_RTIP;
+ PF_PIP = pseudo_AF_PIP;
+
+ PF_MAX = AF_MAX;
+
+
+(***************************************************************************)
+(* *)
+(* Definitions for sysctl call. The sysctl call uses a hierarchical name *)
+(* for objects that can be examined or modified. The name is expressed as *)
+(* a sequence of integers. Like a file path name, the meaning of each *)
+(* component depends on its place in the hierarchy. The top-level and kern *)
+(* identifiers are defined here, and other identifiers are defined in the *)
+(* respective subsystem header files. *)
+(* *)
+(***************************************************************************)
+
+const
+// largest number of components supported
+ CTL_MAXNAME = 12;
+
+(***************************************************************************)
+(* *)
+(* Each subsystem defined by sysctl defines a list of variables *)
+(* for that subsystem. Each name is either a node with further *)
+(* levels defined below it, or it is a leaf of some particular *)
+(* type given below. Each sysctl level defines a set of name/type *)
+(* pairs to be used by sysctl(1) in manipulating the subsystem. *)
+(* *)
+(***************************************************************************)
+
+type
+ ctlname=record
+ ctl_name: PChar; // subsystem name
+ ctl_type: Longint; // type of name
+ end;
+
+const
+ // name is a node
+ CTLTYPE_NODE =1;
+ // name describes an integer
+ CTLTYPE_INT =2;
+ // name describes a string
+ CTLTYPE_STRING =3;
+ // name describes a 64-bit number
+ CTLTYPE_QUAD =4;
+ // name describes a structure
+ CTLTYPE_STRUCT =5;
+ // inetcfg sysctl code
+ CTLTYPE_INETCFG =6;
+ // inetver sysctl code
+ CTLTYPE_INEVER =7;
+
+(*
+ * Top-level identifiers
+ *)
+const
+ // "high kernel": proc, limits
+ CTL_KERN = 1;
+ // network, see socket.h
+ CTL_NET = 4;
+ // OS/2 specific codes
+ CTL_OS2 = 9;
+
+(*
+
+#define CTL_NAMES { \
+ { 0, 0 }, \
+ { "kern", CTLTYPE_NODE }, \
+ { "net", CTLTYPE_NODE }, \
+ { "os2", CTLTYPE_NODE }, \
+}
+
+/*
+ * CTL_KERN identifiers
+ */
+#define KERN_MAXFILES 7 /* int: max open files */
+#define KERN_HOSTNAME 10 /* string: hostname */
+#define KERN_HOSTID 11 /* int: host identifier */
+
+#define CTL_KERN_NAMES { \
+ { 0, 0 }, \
+ { "ostype", CTLTYPE_STRING }, \
+ { "osrelease", CTLTYPE_STRING }, \
+ { "osrevision", CTLTYPE_INT }, \
+ { "version", CTLTYPE_STRING }, \
+ { "maxvnodes", CTLTYPE_INT }, \
+ { "maxproc", CTLTYPE_INT }, \
+ { "maxfiles", CTLTYPE_INT }, \
+ { "argmax", CTLTYPE_INT }, \
+ { "securelevel", CTLTYPE_INT }, \
+ { "hostname", CTLTYPE_STRING }, \
+ { "hostid", CTLTYPE_INT }, \
+ { "clockrate", CTLTYPE_STRUCT }, \
+ { "vnode", CTLTYPE_STRUCT }, \
+ { "proc", CTLTYPE_STRUCT }, \
+ { "file", CTLTYPE_STRUCT }, \
+ { "profiling", CTLTYPE_NODE }, \
+ { "posix1version", CTLTYPE_INT }, \
+ { "ngroups", CTLTYPE_INT }, \
+ { "job_control", CTLTYPE_INT }, \
+ { "saved_ids", CTLTYPE_INT }, \
+ { "boottime", CTLTYPE_STRUCT }, \
+}
+
+/*
+ * KERN_SYSCTL objects
+ */
+#define KERNCTL_INETVER 70 /* Sysctl code for sockets Inetversion */
+#define OS2_MEMMAPIO 1 /* memory map io */
+#define OS2_QUERY_MEMMAPIO 2 /* Query if mapped memory usable */
+
+/* Generic Structure for Inetcfg calls */
+struct inetcfg_ctl{
+ unsigned long var_name;
+ unsigned long var_cur_val;
+ unsigned long var_max_val;
+ unsigned long var_def_val;
+ unsigned long var_min_val;
+};
+
+/* Inetversion */
+struct inetvers_ctl {
+ float version;
+ char versionstr[10]; /* Less than 10 chars in version string */
+};
+
+#include <sys/cdefs.h>
+#ifndef KERNEL
+__BEGIN_DECLS
+int _System sysctl __TCPPROTO((int *, u_int, void *, size_t *, void *, size_t));
+__END_DECLS
+#endif
+*)
+
+(* !!TODO!! Not finished yet!!
+/*
+ * Definitions for network related sysctl, CTL_NET.
+ *
+ * Second level is protocol family.
+ * Third level is protocol number.
+ *
+ * Further levels are defined by the individual families below.
+ */
+const
+ NET_MAXID = AF_MAX;
+
+#define CTL_NET_NAMES { \
+ { 0, 0 }, \
+ { "local", CTLTYPE_NODE }, \
+ { "inet", CTLTYPE_NODE }, \
+ { "implink", CTLTYPE_NODE }, \
+ { "pup", CTLTYPE_NODE }, \
+ { "chaos", CTLTYPE_NODE }, \
+ { "xerox_ns", CTLTYPE_NODE }, \
+ { "iso", CTLTYPE_NODE }, \
+ { "emca", CTLTYPE_NODE }, \
+ { "datakit", CTLTYPE_NODE }, \
+ { "ccitt", CTLTYPE_NODE }, \
+ { "ibm_sna", CTLTYPE_NODE }, \
+ { "decnet", CTLTYPE_NODE }, \
+ { "dec_dli", CTLTYPE_NODE }, \
+ { "lat", CTLTYPE_NODE }, \
+ { "hylink", CTLTYPE_NODE }, \
+ { "appletalk", CTLTYPE_NODE }, \
+ { "netbios", CTLTYPE_NODE }, \
+ { "route", CTLTYPE_NODE }, \
+ { "link_layer", CTLTYPE_NODE }, \
+ { "xtp", CTLTYPE_NODE }, \
+ { "coip", CTLTYPE_NODE }, \
+ { "cnt", CTLTYPE_NODE }, \
+ { "rtip", CTLTYPE_NODE }, \
+ { "ipx", CTLTYPE_NODE }, \
+ { "sip", CTLTYPE_NODE }, \
+ { "pip", CTLTYPE_NODE }, \
+}
+
+/*
+ * PF_ROUTE - Routing table
+ *
+ * Three additional levels are defined:
+ * Fourth: address family, 0 is wildcard
+ * Fifth: type of info, defined below
+ * Sixth: flag(s) to mask with for NET_RT_FLAGS
+ */
+const
+ // dump; may limit to a.f.
+ NET_RT_DUMP = 1;
+ // by flags, e.g. RESOLVING
+ NET_RT_FLAGS = 2;
+ // survey interface list
+ NET_RT_IFLIST = 3;
+ NET_RT_MAXID = 4;
+
+#define CTL_NET_RT_NAMES { \
+ { 0, 0 }, \
+ { "dump", CTLTYPE_STRUCT }, \
+ { "flags", CTLTYPE_STRUCT }, \
+ { "iflist", CTLTYPE_STRUCT }, \
+}
+
+*)
+
+(***************************************************************************)
+(* *)
+(* Maximum queue length specifiable by listen *)
+(* *)
+(***************************************************************************)
+const
+ // Maximum queue length specifiable by listen
+ SOMAXCONN = 1024;
+
+(***************************************************************************)
+(* *)
+(* Message header for recvmsg and sendmsg calls *)
+(* Used value-result for recvmsg, value only for sendmsg *)
+(* *)
+(***************************************************************************)
+type
+ iovec = record
+ iov_base : Pointer;
+ iov_len : Longint;
+ end;
+
+ // Message header for recvmsg and sendmsg calls
+ msghdr = record
+ msg_name: pChar; // optional address
+ msg_namelen: Longint; // size of address
+ msg_iov: ^iovec; // scatter/gather array
+ msg_iovlen: Longint; // # elements in msg_iov (max 1024)
+ msg_control: pChar; // ancillary data, see below
+ msg_controllen: Longint; // ancillary data buffer len
+ msg_flags: Longint; // flags on received message
+ end;
+
+const
+ // process out-of-band data
+ MSG_OOB = $1;
+ // peek at incoming message
+ MSG_PEEK = $2;
+ // send without using routing tables
+ MSG_DONTROUTE = $4;
+ // send without using routing tables
+ MSG_FULLREAD = $8;
+ // data completes record
+ MSG_EOR = $10;
+ // data discarded before delivery
+ MSG_TRUNC = $20;
+ // control data lost before delivery
+ MSG_CTRUNC = $40;
+ // wait for full request or error
+ MSG_WAITALL = $80;
+ // this message should be nonblocking
+ MSG_DONTWAIT = $100;
+ MSG_EOF = $200;
+ // mem mapped io
+ MSG_MAPIO = $400;
+
+(***************************************************************************)
+(* *)
+(* Header for ancillary data objects in msg_control buffer *)
+(* Used for additional information with/about a datagram *)
+(* not expressible by flags. The format is a sequence *)
+(* of message elements headed by cmsghdr structures *)
+(* *)
+(***************************************************************************)
+type
+ // Header for ancillary data objects in msg_control buffer
+ cmsghdr = record
+ cmsg_len: Longint; // data byte count, including hdr
+ cmsg_level: Longint; // originating protocol
+ cmsg_type: Longint; // protocol-specific type
+ end;
+
+ cmsg = record
+ cmsg_hdr: cmsghdr;
+ cmsg_data: array [0..0] of Byte;
+ end;
+
+(***************************************************************************)
+(* *)
+(* "Socket"-level control message types *)
+(* *)
+(***************************************************************************)
+const
+ // access rights (array of int)
+ SCM_RIGHTS = $01;
+
+(***************************************************************************)
+(* *)
+(* 4.3 compat sockaddr, move to compat file later *)
+(* *)
+(***************************************************************************)
+type
+ // 4.3 compat sockaddr
+ osockaddr = record
+ sa_family: Word; // address family
+ sa_data: array [0..13] of Byte; // up to 14 bytes of direct address
+ end;
+
+(***************************************************************************)
+(* *)
+(* 4.3-compat message header (move to compat file later) *)
+(* *)
+(***************************************************************************)
+type
+ // 4.3-compat message header
+ omsghdr = record
+ msg_name: pChar; // optional address
+ msg_namelen: Longint; // size of address
+ msg_iov: ^iovec; // scatter/gather array
+ msg_iovlen: Longint; // # elements in msg_iov
+ msg_accrights: pChar; // access rights sent/received
+ msg_accrightslen: Longint;
+ end;
+
+
+(* !!TODO
+/*
+ * send_file parameter structure
+ */
+struct sf_parms {
+ void *header_data; /* ptr to header data */
+ size_t header_length; /* size of header data */
+ int file_handle; /* file handle to send from */
+ size_t file_size; /* size of file */
+ int file_offset; /* byte offset in file to send from */
+ size_t file_bytes; /* bytes of file to be sent */
+ void *trailer_data; /* ptr to trailer data */
+ size_t trailer_length; /* size of trailer data */
+ size_t bytes_sent; /* bytes sent in this send_file call */
+};
+*)
+
+{ !!TODO Check is all this functions defined
+__BEGIN_DECLS
+int _System accept_and_recv __TCPPROTO((long, long*, struct sockaddr *, long*, struct sockaddr*, long*, caddr_t, size_t));
+ssize_t _System recvfrom __TCPPROTO((int, void *, size_t, int, struct sockaddr *, int *));
+ssize_t _System recvmsg __TCPPROTO((int, struct msghdr *, int));
+ssize_t _System send __TCPPROTO((int, const void *, size_t, int));
+ssize_t _System sendto __TCPPROTO((int, const void *, size_t, int, const struct sockaddr *, int));
+ssize_t _System sendmsg __TCPPROTO((int, const struct msghdr *, int));
+ssize_t _System send_file __TCPPROTO((int *, struct sf_parms *, int ));
+int _System setsockopt __TCPPROTO((int, int, int, const void *, int));
+int _System shutdown __TCPPROTO((int, int));
+int _System socket __TCPPROTO((int, int, int));
+int _System socketpair __TCPPROTO((int, int, int, int *));
+
+/* OS/2 additions */
+int _System sock_init __TCPPROTO((void));
+int _System sock_errno __TCPPROTO((void));
+void _System psock_errno __TCPPROTO((const char *));
+char * _System sock_strerror __TCPPROTO((int));
+int _System soabort __TCPPROTO((int));
+int _System so_cancel __TCPPROTO((int));
+int _System getinetversion __TCPPROTO((char *));
+void _System addsockettolist __TCPPROTO((int));
+int _System removesocketfromlist __TCPPROTO((int));
+/*int _System removesocketfromlist __TCPPROTO((long *));*/ /*changed on 09-30-98 for corresponding change in sockets.c file*/
+
+/* SOCKS additions */
+int _System Raccept __TCPPROTO((int, struct sockaddr *, int *));
+int _System Rbind __TCPPROTO((int, struct sockaddr *, int, struct sockaddr *));
+int _System Rconnect __TCPPROTO((int, const struct sockaddr *, int));
+int _System Rgetsockname __TCPPROTO((int, struct sockaddr *, int *));
+int _System Rlisten __TCPPROTO((int, int));
+__END_DECLS
+
+
+/* more OS/2 stuff */
+
+const
+ // should be on free list
+ MT_FREE = 0;
+ // dynamic (data) allocation
+ MT_DATA = 1;
+ // packet header
+ MT_HEADER = 2;
+ // socket structure
+ MT_SOCKET = 3;
+ // protocol control block
+ MT_PCB = 4;
+ // routing tables
+ MT_RTABLE = 5;
+ // IMP host tables
+ MT_HTABLE = 6;
+ // address resolution tables
+ MT_ATABLE = 7;
+ // socket name
+ MT_SONAME = 8;
+ // zombie proc status
+ MT_ZOMBIE = 9;
+ // socket options
+ MT_SOOPTS = 10;
+ // fragment reassembly header
+ MT_FTABLE = 11;
+ // access rights
+ MT_RIGHTS = 12;
+ // interface address
+ MT_IFADDR = 13;
+
+Type
+ sostats=record
+ count: integer;
+ socketdata: array[0..13*MAXSOCKETS-1] of integer;
+ end;
+
+}
+
+(***************************************************************************)
+(* *)
+(* SOCE* constants - socket errors from NERRNO.H *)
+(* All OS/2 SOCKET API error constants are biased by SOCBASEERR from the *)
+(* "normal" *)
+(* *)
+(***************************************************************************)
+
+const
+ SOCBASEERR = 10000;
+
+ // Not owner
+ SOCEPERM = (SOCBASEERR+1);
+ // No such file or directory
+ SOCENOENT = (SOCBASEERR+2);
+ // No such process
+ SOCESRCH = (SOCBASEERR+3);
+ // Interrupted system call
+ SOCEINTR = (SOCBASEERR+4);
+ // Input/output error
+ SOCEIO = (SOCBASEERR+5);
+ SOCENXIO = (SOCBASEERR+6); // No such device or address
+ SOCE2BIG = (SOCBASEERR+7); // Argument list too long
+ SOCENOEXEC = (SOCBASEERR+8); // Exec format error
+ SOCEBADF = (SOCBASEERR+9); // Bad file number
+ SOCECHILD = (SOCBASEERR+10); // No child processes
+ SOCEDEADLK = (SOCBASEERR+11); // Resource deadlock avoided
+ SOCENOMEM = (SOCBASEERR+12); // Cannot allocate memory
+ SOCEACCES = (SOCBASEERR+13); // Permission denied
+ SOCEFAULT = (SOCBASEERR+14); // Bad address
+ SOCENOTBLK = (SOCBASEERR+15); // Block device required
+ SOCEBUSY = (SOCBASEERR+16); // Device busy
+ SOCEEXIST = (SOCBASEERR+17); // File exists
+ SOCEXDEV = (SOCBASEERR+18); // Cross-device link
+ SOCENODEV = (SOCBASEERR+19); // Operation not supported by device
+ SOCENOTDIR = (SOCBASEERR+20); // Not a directory
+ SOCEISDIR = (SOCBASEERR+21); // Is a directory
+ SOCEINVAL = (SOCBASEERR+22); // Invalid argument
+ SOCENFILE = (SOCBASEERR+23); // Too many open files in system
+ SOCEMFILE = (SOCBASEERR+24); // Too many open files
+ SOCENOTTY = (SOCBASEERR+25); // Inappropriate ioctl for device
+ SOCETXTBSY = (SOCBASEERR+26); // Text file busy
+ SOCEFBIG = (SOCBASEERR+27); // File too large
+ SOCENOSPC = (SOCBASEERR+28); // No space left on device
+ SOCESPIPE = (SOCBASEERR+29); // Illegal seek
+ SOCEROFS = (SOCBASEERR+30); // Read-only file system
+ SOCEMLINK = (SOCBASEERR+31); // Too many links
+ SOCEPIPE = (SOCBASEERR+32); // Broken pipe
+
+// math software
+ SOCEDOM = (SOCBASEERR+33); // Numerical argument out of domain
+ SOCERANGE = (SOCBASEERR+34); // Result too large
+
+// non-blocking and interrupt i/o
+ SOCEAGAIN = (SOCBASEERR+35); // Resource temporarily unavailable
+ SOCEWOULDBLOCK = SOCEAGAIN; // Operation would block
+ SOCEINPROGRESS = (SOCBASEERR+36); // Operation now in progress
+ SOCEALREADY = (SOCBASEERR+37); // Operation already in progress
+
+// ipc/network software -- argument errors
+ SOCENOTSOCK = (SOCBASEERR+38); // Socket operation on non-socket
+ SOCEDESTADDRREQ = (SOCBASEERR+39); // Destination address required
+ SOCEMSGSIZE = (SOCBASEERR+40); // Message too long
+ SOCEPROTOTYPE = (SOCBASEERR+41); // Protocol wrong type for socket
+ SOCENOPROTOOPT = (SOCBASEERR+42); // Protocol not available
+ SOCEPROTONOSUPPORT = (SOCBASEERR+43); // Protocol not supported
+ SOCESOCKTNOSUPPORT = (SOCBASEERR+44); // Socket type not supported
+ SOCEOPNOTSUPP = (SOCBASEERR+45); // Operation not supported
+ SOCEPFNOSUPPORT = (SOCBASEERR+46); // Protocol family not supported
+ SOCEAFNOSUPPORT = (SOCBASEERR+47); // Address family not supported by protocol family
+ SOCEADDRINUSE = (SOCBASEERR+48); // Address already in use
+ SOCEADDRNOTAVAIL = (SOCBASEERR+49); // Can't assign requested address
+
+// ipc/network software -- operational errors
+ SOCENETDOWN = (SOCBASEERR+50); // Network is down
+ SOCENETUNREACH = (SOCBASEERR+51); // Network is unreachable
+ SOCENETRESET = (SOCBASEERR+52); // Network dropped connection on reset
+ SOCECONNABORTED = (SOCBASEERR+53); // Software caused connection abort
+ SOCECONNRESET = (SOCBASEERR+54); // Connection reset by peer
+ SOCENOBUFS = (SOCBASEERR+55); // No buffer space available
+ SOCEISCONN = (SOCBASEERR+56); // Socket is already connected
+ SOCENOTCONN = (SOCBASEERR+57); // Socket is not connected
+ SOCESHUTDOWN = (SOCBASEERR+58); // Can't send after socket shutdown
+ SOCETOOMANYREFS = (SOCBASEERR+59); // Too many references: can't splice
+ SOCETIMEDOUT = (SOCBASEERR+60); // Operation timed out
+ SOCECONNREFUSED = (SOCBASEERR+61); // Connection refused
+
+ SOCELOOP = (SOCBASEERR+62); // Too many levels of symbolic links
+ SOCENAMETOOLONG = (SOCBASEERR+63); // File name too long
+
+// should be rearranged
+ SOCEHOSTDOWN = (SOCBASEERR+64); // Host is down
+ SOCEHOSTUNREACH = (SOCBASEERR+65); // No route to host
+ SOCENOTEMPTY = (SOCBASEERR+66); // Directory not empty
+
+// quotas & mush
+ SOCEPROCLIM = (SOCBASEERR+67); // Too many processes
+ SOCEUSERS = (SOCBASEERR+68); // Too many users
+ SOCEDQUOT = (SOCBASEERR+69); // Disc quota exceeded
+
+// Network File System
+ SOCESTALE = (SOCBASEERR+70); // Stale NFS file handle
+ SOCEREMOTE = (SOCBASEERR+71); // Too many levels of remote in path
+ SOCEBADRPC = (SOCBASEERR+72); // RPC struct is bad
+ SOCERPCMISMATCH = (SOCBASEERR+73); // RPC version wrong
+ SOCEPROGUNAVAIL = (SOCBASEERR+74); // RPC prog. not avail
+ SOCEPROGMISMATCH = (SOCBASEERR+75); // Program version wrong
+ SOCEPROCUNAVAIL = (SOCBASEERR+76); // Bad procedure for program
+
+ SOCENOLCK = (SOCBASEERR+77); // No locks available
+ SOCENOSYS = (SOCBASEERR+78); // Function not implemented
+
+ SOCEFTYPE = (SOCBASEERR+79); // Inappropriate file type or format
+ SOCEAUTH = (SOCBASEERR+80); // Authentication error
+ SOCENEEDAUTH = (SOCBASEERR+81); // Need authenticator
+
+ SOCEOS2ERR = (SOCBASEERR+100); // OS/2 Error
+ SOCELAST = (SOCBASEERR+100); // Must be equal largest errno
+
+(* !!TODO Add this consts
+/*
+ * OS/2 SOCKET API errors redefined as regular BSD error constants
+ */
+
+#ifndef ENOENT
+#define ENOENT SOCENOENT
+#endif
+
+#ifndef EFAULT
+#define EFAULT SOCEFAULT
+#endif
+
+#ifndef EBUSY
+#define EBUSY SOCEBUSY
+#endif
+
+#ifndef ENXIO
+#define ENXIO SOCENXIO
+#endif
+
+#ifndef EACCES
+#define EACCES SOCEACCES
+#endif
+
+#ifndef ENOMEM
+#define ENOMEM SOCENOMEM
+#endif
+
+#ifndef ENOTDIR
+#define ENOTDIR SOCENOTDIR
+#endif
+
+#ifndef EPERM
+#define EPERM SOCEPERM
+#endif
+
+#ifndef ESRCH
+#define ESRCH SOCESRCH
+#endif
+
+#ifndef EDQUOT
+#define EDQUOT SOCEDQUOT
+#endif
+
+#ifndef EEXIST
+#define EEXIST SOCEEXIST
+#endif
+
+#ifndef EBUSY
+#define EBUSY SOCEBUSY
+#endif
+
+#ifndef EWOULDBLOCK
+#define EWOULDBLOCK SOCEWOULDBLOCK
+#endif
+
+#ifndef EINPROGRESS
+#define EINPROGRESS SOCEINPROGRESS
+#endif
+
+#ifndef EALREADY
+#define EALREADY SOCEALREADY
+#endif
+
+#ifndef ENOTSOCK
+#define ENOTSOCK SOCENOTSOCK
+#endif
+
+#ifndef EDESTADDRREQ
+#define EDESTADDRREQ SOCEDESTADDRREQ
+#endif
+
+#ifndef EMSGSIZE
+#define EMSGSIZE SOCEMSGSIZE
+#endif
+
+#ifndef EPROTOTYPE
+#define EPROTOTYPE SOCEPROTOTYPE
+#endif
+
+#ifndef ENOPROTOOPT
+#define ENOPROTOOPT SOCENOPROTOOPT
+#endif
+
+#ifndef EPROTONOSUPPORT
+#define EPROTONOSUPPORT SOCEPROTONOSUPPORT
+#endif
+
+#ifndef ESOCKTNOSUPPORT
+#define ESOCKTNOSUPPORT SOCESOCKTNOSUPPORT
+#endif
+
+#ifndef EOPNOTSUPP
+#define EOPNOTSUPP SOCEOPNOTSUPP
+#endif
+
+#ifndef EPFNOSUPPORT
+#define EPFNOSUPPORT SOCEPFNOSUPPORT
+#endif
+
+#ifndef EAFNOSUPPORT
+#define EAFNOSUPPORT SOCEAFNOSUPPORT
+#endif
+
+#ifndef EADDRINUSE
+#define EADDRINUSE SOCEADDRINUSE
+#endif
+
+#ifndef EADDRNOTAVAIL
+#define EADDRNOTAVAIL SOCEADDRNOTAVAIL
+#endif
+
+#ifndef ENETDOWN
+#define ENETDOWN SOCENETDOWN
+#endif
+
+#ifndef ENETUNREACH
+#define ENETUNREACH SOCENETUNREACH
+#endif
+
+#ifndef ENETRESET
+#define ENETRESET SOCENETRESET
+#endif
+
+#ifndef ECONNABORTED
+#define ECONNABORTED SOCECONNABORTED
+#endif
+
+#ifndef ECONNRESET
+#define ECONNRESET SOCECONNRESET
+#endif
+
+#ifndef ENOBUFS
+#define ENOBUFS SOCENOBUFS
+#endif
+
+#ifndef EISCONN
+#define EISCONN SOCEISCONN
+#endif
+
+#ifndef ENOTCONN
+#define ENOTCONN SOCENOTCONN
+#endif
+
+#ifndef ESHUTDOWN
+#define ESHUTDOWN SOCESHUTDOWN
+#endif
+
+#ifndef ETOOMANYREFS
+#define ETOOMANYREFS SOCETOOMANYREFS
+#endif
+
+#ifndef ETIMEDOUT
+#define ETIMEDOUT SOCETIMEDOUT
+#endif
+
+#ifndef ECONNREFUSED
+#define ECONNREFUSED SOCECONNREFUSED
+#endif
+
+#ifndef ELOOP
+#define ELOOP SOCELOOP
+#endif
+
+#ifndef ENAMETOOLONG /* Borland and Watcom define this */
+#define ENAMETOOLONG SOCENAMETOOLONG
+#endif
+
+#ifndef EHOSTDOWN
+#define EHOSTDOWN SOCEHOSTDOWN
+#endif
+
+#ifndef EHOSTUNREACH
+#define EHOSTUNREACH SOCEHOSTUNREACH
+#endif
+
+#ifndef ENOTEMPTY /* Watcom defines this */
+#define ENOTEMPTY SOCENOTEMPTY
+#endif
+
+#ifndef EINVAL
+#define EINVAL SOCEINVAL
+#endif
+
+#ifndef EINTR
+#define EINTR SOCEINTR
+#endif
+
+#ifndef EMFILE
+#define EMFILE SOCEMFILE
+#endif
+
+#ifndef EPIPE
+#define EPIPE SOCEPIPE
+#endif
+*)
+
+// * bsd select definitions
+
+const
+{
+ * Select uses bit masks of file descriptors in longs. These macros
+ * manipulate such bit fields (the filesystem macros use chars).
+ * FD_SETSIZE may be defined by the user, but the default here should
+ * be enough for most uses.
+}
+ FD_SETSIZE = 64;
+
+type
+
+ fd_set = record
+ fd_count : Word; // how many are SET?
+ fd_array : array[0..FD_SETSIZE-1] of Longint; // an array of SOCKETs
+ end;
+
+ timeval = record
+ tv_sec : Longint; // Number of seconds
+ tv_usec : Longint; // Number of microseconds
+ end;
+
+
+
+
+(* !!TODO Check all macros from sys/itypes.h
+function LSwap(a:Longint):Longint;
+function WSwap(a:Word):Word;
+
+{ host -> network for long (4 bytes) }
+function htonl(a:Longint):Longint;
+
+{ network -> host for long (4 bytes) }
+function ntohl(a:Longint):Longint;
+
+{ host -> network for small (2 bytes) }
+function htons(a:Word):Word;
+
+{ network -> host for small (2 bytes) }
+function ntohs(a:Word):Word;
+
+*)
+
+{ * init / misc funcs }
+
+{ init sockets system }
+function sock_init:Longint; cdecl;
+
+{ get inet version. version - buffer of ?? size for returned string. }
+function getinetversion(var version):Longint; cdecl;
+
+
+{ * sockets errors reporting funcs }
+
+{ last err code for this thread }
+function sock_errno:Longint; cdecl;
+
+{ print last err string + str if not NIL }
+procedure psock_errno(const str:PChar); cdecl;
+
+
+{ * sockets creation / close funcs }
+
+{ create new socket }
+function socket(domain,stype,protocol:Longint):Longint; cdecl;
+
+{ close socket }
+function soclose(sock:Longint):Longint; cdecl;
+
+{ cancel socket }
+function so_cancel(sock:Longint):Longint; cdecl;
+
+{ shutdown socket. howto: 0/1/2 }
+function shutdown(sock,howto:Longint):Longint; cdecl;
+
+{ abort socket. no docs found about it :( }
+function soabort(sock:Longint):Longint; cdecl;
+
+(***************************************************************************)
+(* *)
+(* sockets connection funcs *)
+(* *)
+(***************************************************************************)
+
+{ accept a connection from remote host. returns s_addr & s_addr_len if not nil }
+function accept(sock:Longint; var s_addr:sockaddr; s_addr_len:Longint):Longint; cdecl;
+
+{ bind a local name to the socket }
+function bind(sock:Longint; const s_addr: sockaddr; s_addr_len:Longint):Longint; cdecl;
+
+{ connect socket to remote host }
+function connect(sock:Longint; const s_addr:sockaddr; s_addr_len:Longint):Longint; cdecl;
+
+{ listen on socket. max_conn - queue size of listen. }
+function listen(sock,max_conn:Longint):Longint; cdecl;
+
+(***************************************************************************)
+(* *)
+(* sockets read/write funcs *)
+(* *)
+(***************************************************************************)
+
+{ read data from socket. ! return N of readed bytes, or 0 (closed) or -1 }
+function recv(sock:Longint; var buf; buf_len,flags:Longint):Longint; cdecl;
+
+{ send data to socket. ! return N of sent bytes. -1 - err }
+function send(sock:Longint; const buf; buf_len,flags:Longint):Longint; cdecl;
+
+{ read data from socket. ! return N of readed bytes, or 0 (closed) or -1 }
+function recvfrom(sock:Longint; var buf; buf_len,flags:Longint; var s_addr:sockaddr; var s_addr_len:Longint):Longint; cdecl;
+
+{ send data to socket. ! return N of sent bytes. -1 - err }
+function sendto(sock:Longint; const buf; buf_len,flags:Longint; var s_addr:sockaddr; s_addr_len:Longint):Longint; cdecl;
+
+{ read data into iov_count number of buffers iov.
+ ! return N of readed bytes, or 0 (closed) or -1 }
+function readv(sock:Longint; var iov:iovec; iov_count:Longint):LONGINT; cdecl;
+
+{ write data from iov_count number of buffers iov.
+ ! return N of writed bytes, or -1 }
+function writev(sock:Longint; var iov:iovec; iov_count:Longint):LONGINT; cdecl;
+
+{ read data + control info from socket
+ ! return N of readed bytes, or 0 (closed) or -1 }
+function recvmsg(sock:Longint; var msgbuf:msghdr; flags:Longint):Longint; cdecl;
+
+{ send data + control info to socket
+ ! return N of sended bytes, or -1 }
+function sendmsg(sock:Longint; var msgbuf:msghdr; flags:Longint):Longint; cdecl;
+
+(***************************************************************************)
+(* *)
+(* select funcs *)
+(* *)
+(***************************************************************************)
+
+{ OS/2 select. 0 - timeout. -1 - err. XX - N of sockets worked. }
+function os2_select(var sockets; N_reads, N_writes, N_exepts, timeout:Longint):Longint; cdecl;
+
+{ bsd select here. heavy voodoo.. }
+function select(nfds:Longint; const readfds,writefds,exceptfds:fd_set; const timeout:timeval):Longint; cdecl;
+
+(***************************************************************************)
+(* *)
+(* misc info *)
+(* *)
+(***************************************************************************)
+
+{ get host ip addr - addr of primary interface }
+function gethostid:Longint; cdecl;
+
+{ get connected to socket hostname }
+function getpeername(sock:Longint; var s_addr:sockaddr; var s_addr_len:Longint):Longint; cdecl;
+
+{ get local socket name }
+function getsockname(sock:Longint; var s_addr:sockaddr; var s_addr_len:Longint):Longint; cdecl;
+
+(***************************************************************************)
+(* *)
+(* options & ioctls *)
+(* *)
+(***************************************************************************)
+
+{ get socket options }
+function getsockopt(sock,level,optname:Longint; var buf; var buf_len:Longint):Longint; cdecl;
+
+{ set socket options }
+function setsockopt(sock,level,optname:Longint; const buf; buf_len:Longint):Longint; cdecl;
+
+{ f@$king ioctl. use sys/ioctl.h }
+function os2_ioctl(sock,cmd:Longint; var data; data_len:Longint):Longint; cdecl;
+
+(***************************************************************************)
+(* *)
+(* functions only for 4.1+ ip stacks (but also found in 4.02w ;)) *)
+(* *)
+(***************************************************************************)
+
+
+function addsockettolist(sock:Longint):Longint; cdecl;
+
+function removesocketfromlist(sock:Longint):Longint; cdecl;
+
+implementation
+
+function LSwap(a:Longint):Longint; assembler;
+asm
+ mov eax,a
+ xchg ah,al
+ ror eax,16
+ xchg ah,al
+end;
+
+function WSwap(a:Word):Word; assembler;
+asm
+ mov ax,a
+ xchg ah,al
+end;
+
+function accept(sock:Longint; var s_addr: sockaddr; s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 1;
+function bind(sock:Longint; const s_addr: sockaddr; s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 2;
+function connect(sock:Longint; const s_addr:sockaddr; s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 3;
+function gethostid: Longint; cdecl; external 'SO32DLL' index 4;
+function getpeername(sock:Longint; var s_addr:sockaddr; var s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 5;
+function getsockname(sock:Longint; var s_addr:sockaddr; var s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 6;
+function getsockopt(sock,level,optname:Longint; var buf; var buf_len:Longint):Longint; cdecl; external 'SO32DLL' index 7;
+function os2_ioctl(sock,cmd:Longint; var data; data_len:Longint):Longint; cdecl; external 'SO32DLL' index 8;
+function listen(sock,max_conn:Longint):Longint; cdecl; external 'SO32DLL' index 9;
+function recv(sock:Longint; var buf; buf_len,flags:Longint):Longint; cdecl; external 'SO32DLL' index 10;
+function recvfrom(sock:Longint; var buf; buf_len,flags:Longint;var s_addr:sockaddr; var s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 11;
+function os2_select(var sockets; N_reads, N_writes, N_exepts, timeout:Longint):Longint; cdecl; external 'SO32DLL' index 12;
+function send(sock:Longint; const buf; buf_len,flags:Longint):Longint; cdecl; external 'SO32DLL' index 13;
+function sendto(sock:Longint; const buf; buf_len,flags:Longint;var s_addr:sockaddr; s_addr_len:Longint):Longint; cdecl; external 'SO32DLL' index 14;
+function setsockopt(sock,level,optname:Longint; const buf; buf_len:Longint):Longint; cdecl; external 'SO32DLL' index 15;
+function socket(domain,stype,protocol:Longint):Longint; cdecl; external 'SO32DLL' index 16;
+function soclose(sock:Longint):Longint; cdecl; external 'SO32DLL' index 17;
+function so_cancel(sock:Longint):Longint; cdecl; external 'SO32DLL' index 18;
+function soabort(sock:Longint):Longint; cdecl; external 'SO32DLL' index 19;
+function sock_errno:Longint; cdecl; external 'SO32DLL' index 20;
+function recvmsg(sock:Longint; var msgbuf:msghdr; flags:Longint):Longint; cdecl; external 'SO32DLL' index 21;
+function sendmsg(sock:Longint; var msgbuf:msghdr; flags:Longint):Longint; cdecl; external 'SO32DLL' index 22;
+function readv(sock:Longint; var iov:iovec; iov_count:Longint):LONGINT; cdecl; external 'SO32DLL' index 23;
+function writev(sock:Longint; var iov:iovec; iov_count:Longint):LONGINT; cdecl; external 'SO32DLL' index 24;
+function shutdown(sock,howto:Longint):Longint; cdecl; external 'SO32DLL' index 25;
+function sock_init:Longint; cdecl; external 'SO32DLL' index 26;
+function addsockettolist(sock:Longint):Longint; cdecl; external 'SO32DLL' index 27;
+function removesocketfromlist(sock:Longint):Longint; cdecl; external 'SO32DLL' index 28;
+{ entry 29 not used }
+procedure psock_errno(const str:PChar); cdecl; external 'SO32DLL' index 30;
+function getinetversion(var version):Longint; cdecl; external 'SO32DLL' index 31;
+function select(nfds:Longint;
+ const readfds,writefds,exceptfds:fd_set;
+ const timeout:timeval):Longint; cdecl; external 'SO32DLL' index 32;
+
+
+function htonl(a:Longint):Longint;
+begin Result:=LSwap(a); end;
+{ host -> network for long (4 bytes) }
+
+function ntohl(a:Longint):Longint;
+begin Result:=LSwap(a); end;
+{ network -> host for long (4 bytes) }
+
+function htons(a:Word):Word;
+begin Result:=WSwap(a); end;
+{ host -> network for small (2 bytes) }
+
+function ntohs(a:Word):Word;
+begin Result:=WSwap(a); end;
+{ network -> host for small (2 bytes) }
+
+end.
+
+(* !!TODO Following code not revised as yet
+
+{*
+ * User-settable options (used with setsockopt).
+ *}
+ TCP_NODELAY = $01; // don't delay send to coalesce packets
+ TCP_MAXSEG = $02; // set maximum segment size
+ TCP_MSL = $03; // MSL HACK
+ TCP_TIMESTMP = $04; // RFC 1323 (RTTM TimeStamp)
+ TCP_WINSCALE = $05; // RFC 1323 (Window Scale)
+ TCP_CC = $06; // RFC 1644 (Connection Count)
+
+
+
+
+
+
+{
+ * Structures returned by network data base library. All addresses are
+ * supplied in host order, and returned in network order (suitable for
+ * use in system calls).
+}
+
+type
+
+ PLongint = ^Longint;
+
+ { struct for gethostbyname() and gethostbyaddr() }
+ hostent = record
+ h_name : PChar; // official name of host
+ h_aliases : ^PChar; // alias list
+ h_addrtype : Longint; // host address type
+ h_length : Longint; // length of address
+ h_addr_list : ^PLongint; // list of addresses from name server
+ end;
+
+ phostent = ^hostent;
+
+{
+ * Error return codes from gethostbyname(), gethostbyaddr() and res_* funcs
+ * (left in extern int h_errno).
+}
+
+const
+
+ NETDB_INTERNAL = -1; // see errno
+ NETDB_SUCCESS = 0; // no problem
+ HOST_NOT_FOUND = 1; // Authoritative Answer Host not found
+ TRY_AGAIN = 2; // Non-Authoritive Host not found, or SERVERFAIL
+ NO_RECOVERY = 3; // Non recoverable errors, FORMERR, REFUSED, NOTIMP
+ NO_DATA = 4; // Valid name, no data record of requested type
+ NO_ADDRESS = NO_DATA; // no address, look for MX record
+
+type
+
+ { struct for getprotobyname() and getprotobynumber() }
+ protoent = record
+ p_name : PChar; // official protocol name
+ p_aliases : ^PChar; // alias list
+ p_proto : Longint; // protocol #
+ end;
+
+ pprotoent = ^protoent;
+
+type
+
+ { struct for getservbyname() and getservbyport() }
+ servent = record
+ s_name : PChar; // official service name
+ s_aliases : ^PChar; // alias list
+ s_port : Longint; // port # (need ntohl() !!)
+ s_proto : PChar; // protocol to use
+ end;
+
+ pservent = ^servent;
+
+{
+ * ioctl & ip trace support
+}
+const
+ SIOCGIFFLAGS = $6900 + 17; // get interface flags
+
+ { Interface Tracing Support }
+ SIOCGIFEFLAGS = $6900 + 150; // get interface enhanced flags
+ SIOCSIFEFLAGS = $6900 + 151; // set interface enhanced flags
+ SIOCGIFTRACE = $6900 + 152; // get interface trace data
+ SIOCSIFTRACE = $6900 + 153; // set interface trace data
+ { sorry, i skip other ioctl commands, see SYS\ioctl.h from toolkit for it.. }
+
+ IFF_UP = $1; // interface is up
+ IFF_BROADCAST = $2; // broadcast address valid
+ IFF_DEBUG = $4; // turn on debugging
+ IFF_LOOPBACK = $8; // is a loopback net
+ IFF_POINTOPOINT = $10; // interface is point-to-point link
+ IFF_LINK2 = $20; // was trailers, not used
+ IFF_NOTRAILERS = IFF_LINK2;
+ IFF_RUNNING = $40; // resources allocated
+ IFF_NOARP = $80; // no address resolution protocol
+ IFF_PROMISC = $100; // receive all packets
+ IFF_ALLMULTI = $200; // receive all multicast packets
+ IFF_BRIDGE = $1000; // support token ring routine field
+ IFF_SNAP = $2000; // support extended SAP header
+ IFF_DEFMTU = $400; // default mtu of 1500
+ IFF_RFC1469_BC = 1; // using broadcast
+ IFF_RFC1469_FA = 2; // using functional
+ IFF_RFC1469_MA = 3; // using multicast
+ IFF_ETHER = $4000; // Ethernet interface
+ IFF_LOOPBRD = $8000; // loop back broadcasts
+ IFF_MULTICAST = $800; // supports multicast
+
+ IFF_SIMPLEX = $10000; // can't hear own transmissions
+ IFF_OACTIVE = $20000; // transmission in progress
+ IFF_802_3 = $40000;
+ IFF_CANONICAL = $80000;
+ IFF_RUNNINGBLK = $100000; // threads waited for intf running
+
+ { Interface enhanced flags }
+ IFFE_PKTTRACE = $00000001; // trace datalink where possible
+ IFFE_IPTRACE = $00000002; // trace ONLY IP packets
+
+type
+ { trace buffer struct }
+ pkt_trace_hdr = record
+ pt_htype : Word; // header type
+ pt_len : Word; // in: pt_buf len, out: packet len
+ pt_data : Pointer; // packet
+ pt_tstamp : Longint; // time stamp in milliseconds
+ end;
+
+const
+ { physical protocols IDs }
+ HT_IP = $01; // IP
+ HT_ETHER = $06; // Ethernet
+ HT_ISO88023 = $07; // CSMA CD
+ HT_ISO88025 = $09; // Token Ring
+ HT_SLIP = $1c; // Serial Line IP
+ HT_PPP = $18; // PPP IP
+
+const
+ IFNAMSIZ = 16; // interface name length
+
+type
+{
+* Interface request structure used for socket
+* ioctl's. All interface ioctl's must have parameter
+* definitions which begin with ifr_name. The
+* remainder may be interface specific.
+}
+ ifreq = record
+ ifr_name : array[0..IFNAMSIZ-1] of Char;
+ case Byte of
+ 0: (ifr_addr : sockaddr); // address
+ 1: (ifr_dstaddr : sockaddr); // other end of p-to-p link
+ 2: (ifr_broadaddr : sockaddr); // broadcast address
+ 3: (ifr_flags : Word); // flags
+ 4: (ifr_metric : Longint); // metric
+ 5: (ifr_data : Pointer); // for use by interface
+ 6: (ifr_eflags : Longint); // eflags
+ end;
+
+
+{
+ * Structure of an internet header, naked of options.
+}
+type
+ ip = record
+ hlen_ver : Byte; { lo 4 bits = header len/4
+ hi 4 bits = ip ver (4) }
+ ip_tos : Byte; { type of service }
+ ip_len : Word; { total packet length }
+ ip_id : Word; { identification }
+ ip_off : Word; { fragment offset field }
+ ip_ttl : Byte; { time to live }
+ ip_p : Byte; { protocol (see IPPROTO_* ) }
+ ip_sum : Word; { header checksum }
+ ip_src, ip_dst : Longint; { ip from / to addr }
+ end;
+
+
+{ in.h / inet.h const & func }
+
+{
+ * Protocols
+}
+const
+ IPPROTO_IP = 0; { dummy for IP }
+ IPPROTO_ICMP = 1; { control message protocol }
+ IPPROTO_GGP = 3; { gateway^2 (deprecated) }
+ IPPROTO_TCP = 6; { tcp }
+ IPPROTO_EGP = 8; { exterior gateway protocol }
+ IPPROTO_PUP = 12; { pup }
+ IPPROTO_UDP = 17; { user datagram protocol }
+ IPPROTO_IDP = 22; { xns idp }
+
+ IPPROTO_RAW = 255; { raw IP packet }
+ IPPROTO_MAX = 256;
+
+{
+ * Ports < IPPORT_RESERVED are reserved for
+ * privileged processes (e.g. root).
+ * Ports > IPPORT_USERRESERVED are reserved
+ * for servers, not necessarily privileged.
+}
+const
+ IPPORT_RESERVED = 1024;
+ IPPORT_USERRESERVED = 5000;
+
+{
+ * Link numbers
+}
+const
+ IMPLINK_IP = 155;
+ IMPLINK_LOWEXPER = 156;
+ IMPLINK_HIGHEXPER = 158;
+
+{
+ * Definitions of bits in internet address integers.
+ * On subnets, the decomposition of addresses to host and net parts
+ * is done according to subnet mask, not the masks here.
+}
+const
+ IN_CLASSA_NET = $ff000000;
+ IN_CLASSA_NSHIFT = 24;
+ IN_CLASSA_HOST = $00ffffff;
+ IN_CLASSA_MAX = 128;
+
+ IN_CLASSB_NET = $ffff0000;
+ IN_CLASSB_NSHIFT = 16;
+ IN_CLASSB_HOST = $0000ffff;
+ IN_CLASSB_MAX = 65536;
+
+ IN_CLASSC_NET = $ffffff00;
+ IN_CLASSC_NSHIFT = 8;
+ IN_CLASSC_HOST = $000000ff;
+
+ INADDR_ANY = $00000000;
+ INADDR_BROADCAST = $ffffffff; { must be masked }
+ INADDR_NONE = $ffffffff; { -1 return }
+
+ IN_LOOPBACKNET = 127; { official! }
+
+{
+ * Socket address, internet style.
+}
+type
+ sockaddr_in = record
+ sin_family : Word;
+ sin_port : Word; { htons first!! }
+ sin_addr : Longint; {in_addr; hist reasons :)) }
+ sin_zero : array[0..7] of Byte; {must be zero}
+ end;
+
+{ * Internet address (a structure for historical reasons) }
+type
+ in_addr = record
+ s_addr : Longint;
+ end;
+
+{*
+ * Options for use with [gs]etsockopt at the IP level.
+ * }
+const
+
+ IP_OPTIONS = 1; // buf/ip_opts; set/get IP options
+ IP_MULTICAST_IF = 2; // u_char; set/get IP multicast i/f
+ IP_MULTICAST_TTL = 3; // u_char; set/get IP multicast ttl
+ IP_MULTICAST_LOOP = 4; // u_char; set/get IP multicast loopback
+ IP_ADD_MEMBERSHIP = 5; // ip_mreq; add an IP group membership
+ IP_DROP_MEMBERSHIP = 6; // ip_mreq; drop an IP group membership
+ IP_HDRINCL = 7; // int; header is included with data
+ IP_TOS = 8; // int; IP type of service and preced.
+ IP_TTL = 9; // int; IP time to live
+ IP_RECVOPTS = 10; // bool; receive all IP opts w/dgram
+ IP_RECVRETOPTS = 11; // bool; receive IP opts for response
+ IP_RECVDSTADDR = 12; // bool; receive IP dst addr w/dgram
+ IP_RETOPTS = 13; // ip_opts; set/get IP options
+ IP_RECVTRRI = 14; // bool; receive token ring routing inf
+
+{*
+ * Defaults and limits for options
+ * }
+ IP_DEFAULT_MULTICAST_TTL = 1; // normally limit m'casts to 1 hop
+ IP_DEFAULT_MULTICAST_LOOP = 1; // normally hear sends if a member
+ IP_MAX_MEMBERSHIPS = 20; // per socket; must fit in one mbuf
+ MAX_IN_MULTI = 16*IP_MAX_MEMBERSHIPS; // 320 max per os2
+
+*)
+
+
+(* List of not checked functions from SO32DLL.DLL
+³ 00011 ³ RECVFROM
+³ 00012 ³ SELECT
+³ 00013 ³ SEND
+³ 00014 ³ SENDTO
+³ 00015 ³ SETSOCKOPT
+³ 00016 ³ SOCKET
+³ 00017 ³ SOCLOSE
+³ 00018 ³ SO_CANCEL
+³ 00019 ³ SOABORT
+³ 00020 ³ SOCK_ERRNO
+³ 00021 ³ RECVMSG
+³ 00022 ³ SENDMSG
+³ 00023 ³ READV
+³ 00024 ³ WRITEV
+³ 00025 ³ SHUTDOWN
+³ 00026 ³ SOCK_INIT
+³ 00027 ³ ADDSOCKETTOLIST
+³ 00028 ³ REMOVESOCKETFROMLIST
+³ 00030 ³ PSOCK_ERRNO
+³ 00031 ³ GETINETVERSION
+³ 00032 ³ BSDSELECT
+³ 00035 ³ SET_ERRNO
+³ 00038 ³ WINSOCKCLEANUPSOCKETS
+³ 00039 ³ GETSOCKETFROMLIST
+À´Done
+*)
+
+{
+ $Log: so32dll.pas,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/sockets.pas b/rtl/os2/sockets.pas
new file mode 100644
index 0000000000..7025cb17bb
--- /dev/null
+++ b/rtl/os2/sockets.pas
@@ -0,0 +1,314 @@
+{
+ $Id: sockets.pas,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 Yuri Prokushev
+
+ Sockets implementation for OS/2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+unit Sockets;
+
+Interface
+
+Uses
+ so32dll;
+
+Const
+ AF_LOCAL = so32dll.AF_LOCAL;
+ AF_OS2 = so32dll.AF_OS2;
+ AF_IMPLINK = so32dll.AF_IMPLINK; // arpanet imp addresses
+ AF_PUP = so32dll.AF_PUP; // pup protocols: e.g. BSP
+ AF_CHAOS = so32dll.AF_CHAOS; // mit CHAOS protocols
+ AF_NS = so32dll.AF_NS; // XEROX NS protocols
+ AF_ISO = so32dll.AF_ISO; // ISO protocols
+ AF_OSI = so32dll.AF_OSI;
+ AF_ECMA = so32dll.AF_ECMA; // european computer manufacturers
+ AF_DATAKIT = so32dll.AF_DATAKIT; // datakit protocols
+ AF_CCITT = so32dll.AF_CCITT; // CCITT protocols, X.25 etc
+ AF_SNA = so32dll.AF_SNA; // IBM SNA
+ AF_DECnet = so32dll.AF_DECnet; // DECnet
+ AF_DLI = so32dll.AF_DLI; // DEC Direct data link interface
+ AF_LAT = so32dll.AF_LAT; // LAT
+ AF_HYLINK = so32dll.AF_HYLINK; // NSC Hyperchannel
+ AF_APPLETALK = so32dll.AF_APPLETALK; // Apple Talk
+ AF_NB = so32dll.AF_NB; // Netbios
+ AF_NETBIOS = so32dll.AF_NETBIOS; // Netbios
+ AF_LINK = so32dll.AF_LINK; // Link layer interface
+ pseudo_AF_XTP = so32dll.pseudo_AF_XTP; // eXpress Transfer Protocol (no AF)
+ AF_COIP = so32dll.AF_COIP; // connection-oriented IP, aka ST II
+ AF_CNT = so32dll.AF_CNT; // Computer Network Technology
+ pseudo_AF_RTIP = so32dll.pseudo_AF_RTIP; // Help Identify RTIP packets
+ AF_IPX = so32dll.AF_IPX; // Novell Internet Protocol
+ AF_SIP = so32dll.AF_SIP; // Simple Internet Protocol
+ AF_INET6 = so32dll.AF_INET6;
+ pseudo_AF_PIP = so32dll.pseudo_AF_PIP; // Help Identify PIP packets
+ AF_ROUTE = so32dll.AF_ROUTE; // Internal Routing Protocol
+ AF_FWIP = so32dll.AF_FWIP; // firewall support
+ AF_IPSEC = so32dll.AF_IPSEC; // IPSEC and encryption techniques
+ AF_DES = so32dll.AF_DES; // DES
+ AF_MD5 = so32dll.AF_MD5;
+ AF_CDMF = so32dll.AF_CDMF;
+
+ AF_MAX = so32dll.AF_MAX;
+
+ PF_LOCAL = so32dll.PF_LOCAL;
+ PF_OS2 = so32dll.PF_OS2;
+ PF_IMPLINK = so32dll.PF_IMPLINK;
+ PF_PUP = so32dll.PF_PUP;
+ PF_CHAOS = so32dll.PF_CHAOS;
+ PF_NS = so32dll.PF_NS;
+ PF_ISO = so32dll.PF_ISO;
+ PF_OSI = so32dll.PF_OSI;
+ PF_ECMA = so32dll.PF_ECMA;
+ PF_DATAKIT = so32dll.PF_DATAKIT;
+ PF_CCITT = so32dll.PF_CCITT;
+ PF_SNA = so32dll.PF_SNA;
+ PF_DECnet = so32dll.PF_DECnet;
+ PF_DLI = so32dll.PF_DLI;
+ PF_LAT = so32dll.PF_LAT;
+ PF_HYLINK = so32dll.PF_HYLINK;
+ PF_APPLETALK = so32dll.PF_APPLETALK;
+ PF_NETBIOS = so32dll.PF_NB;
+ PF_NB = so32dll.PF_NB;
+ PF_ROUTE = so32dll.PF_ROUTE;
+ PF_LINK = so32dll.PF_LINK;
+ PF_XTP = so32dll.PF_XTP; // really just proto family, no AF
+ PF_COIP = so32dll.PF_COIP;
+ PF_CNT = so32dll.PF_CNT;
+ PF_SIP = so32dll.PF_SIP;
+ PF_INET6 = so32dll.PF_INET6;
+ PF_IPX = so32dll.PF_IPX; // same format as AF_NS
+ PF_RTIP = so32dll.PF_RTIP; // same format as AF_INET
+ PF_PIP = so32dll.PF_PIP;
+
+ PF_MAX = so32dll.PF_MAX;
+
+
+// OS/2 stack based on BSD stack
+{$DEFINE BSD}
+{$I socketsh.inc}
+
+Implementation
+
+{Include filerec and textrec structures}
+{$I filerec.inc}
+{$I textrec.inc}
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ Socket:=so32dll.Socket(Domain,SocketType,ProtoCol);
+ if Socket<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+begin
+ Send:=so32dll.Send(Sock,Buf,BufLen,Flags);
+ if Send<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+begin
+ SendTo:=so32dll.SendTo(Sock,Buf,BufLen,Flags,so32dll.SockAddr(Addr),AddrLen);
+ if SendTo<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=so32dll.Recv(Sock,Buf,BufLen,Flags);
+ if Recv<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; AddrLen : Integer) : longint;
+
+begin
+ RecvFrom:=so32dll.RecvFrom(Sock,Buf,BufLen,Flags,so32dll.SockAddr(Addr),AddrLen);
+ if RecvFrom<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+var
+ l : longint;
+begin
+ l:=so32dll.Bind(Sock,so32dll.sockaddr(Addr),AddrLen);
+ if l<0 then
+ begin
+ SocketError:=so32dll.sock_errno;
+ Bind:=false;
+ end
+ else
+ begin
+ SocketError:=0;
+ Bind:=true;
+ end;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+var
+ l : longint;
+begin
+ l:=so32dll.Listen(Sock,MaxConnect);
+ if l<0 then
+ begin
+ SocketError:=so32dll.sock_errno;
+ Listen:=false;
+ end
+ else
+ begin
+ SocketError:=0;
+ Listen:=true;
+ end;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ Accept:=so32dll.Accept(Sock,so32dll.SockAddr(Addr), AddrLen);
+ if Accept<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):Boolean;
+begin
+ Connect:=so32dll.Connect(Sock,so32dll.SockAddr(Addr),AddrLen)=0;
+ if not Connect then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+ ShutDown:=so32dll.ShutDown(Sock,How);
+ if ShutDown<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=so32dll.GetSockName(Sock, so32dll.SockAddr(Addr),AddrLen);
+ if GetSocketName<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=so32dll.GetPeerName(Sock,so32dll.SockAddr(Addr),AddrLen);
+ if GetPeerName<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+begin
+ SetSocketOptions:=so32dll.SetSockOpt(Sock,Level,OptName,OptVal,OptLen);
+ if SetSocketOptions<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=so32dll.GetSockOpt(Sock,Level,OptName,OptVal,OptLen);
+ if GetSocketOptions<0 then
+ SocketError:=so32dll.sock_errno
+ else
+ SocketError:=0;
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+
+{!!TODO!!
+ SocketPair:=so32dll.socketpair(Domain,SocketType,Protocol,Pair);}
+ //SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+end;
+
+{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
+function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fdWrite := so32dll.send(handle, bufptr, size, 0);
+ if fdWrite = -1 then
+ begin
+ SocketError := so32dll.sock_errno;
+ fdWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fdRead(handle : longint;var bufptr;size : dword) : dword;
+var
+ d : dword;
+begin
+{!!TODO!!
+ if so32dll.ioctlsocket(handle,FIONREAD,@d) = -1 then
+ begin
+ SocketError:=so32dll.sock_errno;
+ fdRead:=0;
+ exit;
+ end;
+}
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fdRead := so32dll.recv(handle, bufptr, size, 0);
+ if fdRead = -1 then
+ begin
+ SocketError:= so32dll.sock_errno;
+ fdRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+end;
+
+{$i sockets.inc}
+
+Begin
+ so32dll.sock_init;
+End.
+
+{
+ $Log: sockets.pas,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/sysdir.inc b/rtl/os2/sysdir.inc
new file mode 100644
index 0000000000..3eb55bd791
--- /dev/null
+++ b/rtl/os2/sysdir.inc
@@ -0,0 +1,160 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+procedure MkDir (const S: string);[IOCHECK];
+var buffer:array[0..255] of char;
+ Rc : word;
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ allowslash(Pchar(@buffer));
+ Rc := DosCreateDir(buffer,nil);
+ if Rc <> 0 then
+ begin
+ InOutRes := Rc;
+ Errno2Inoutres;
+ end;
+end;
+
+
+procedure rmdir(const s : string);[IOCHECK];
+var buffer:array[0..255] of char;
+ Rc : word;
+begin
+ if (s = '.' ) then
+ InOutRes := 16;
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ allowslash(Pchar(@buffer));
+ Rc := DosDeleteDir(buffer);
+ if Rc <> 0 then
+ begin
+ InOutRes := Rc;
+ Errno2Inoutres;
+ end;
+end;
+
+{$ASMMODE INTEL}
+
+procedure ChDir (const S: string);[IOCheck];
+
+var RC: cardinal;
+ Buffer: array [0..255] of char;
+
+begin
+ If (s='') or (InOutRes <> 0) then exit;
+ if (Length (S) >= 2) and (S [2] = ':') then
+ begin
+ RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
+ if RC <> 0 then
+ InOutRes := RC
+ else
+ if Length (S) > 2 then
+ begin
+ Move (S [1], Buffer, Length (S));
+ Buffer [Length (S)] := #0;
+ AllowSlash (PChar (@Buffer));
+ RC := DosSetCurrentDir (@Buffer);
+ if RC <> 0 then
+ begin
+ InOutRes := RC;
+ Errno2InOutRes;
+ end;
+ end;
+ end else begin
+ Move (S [1], Buffer, Length (S));
+ Buffer [Length (S)] := #0;
+ AllowSlash (PChar (@Buffer));
+ RC := DosSetCurrentDir (@Buffer);
+ if RC <> 0 then
+ begin
+ InOutRes:= RC;
+ Errno2InOutRes;
+ end;
+ end;
+end;
+
+{$ASMMODE ATT}
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+{Written by Michael Van Canneyt.}
+var sof: Pchar;
+ i:byte;
+ l,l2:cardinal;
+begin
+ Dir [4] := #0;
+ { Used in case the specified drive isn't available }
+ sof:=pchar(@dir[4]);
+ { dir[1..3] will contain '[drivenr]:\', but is not }
+ { supplied by DOS, so we let dos string start at }
+ { dir[4] }
+ { Get dir from drivenr : 0=default, 1=A etc... }
+ l:=255-3;
+ InOutRes:=longint (DosQueryCurrentDir(DriveNr, sof^, l));
+{$WARNING Result code should be translated in some cases!}
+ { Now Dir should be filled with directory in ASCIIZ, }
+ { starting from dir[4] }
+ dir[0]:=#3;
+ dir[2]:=':';
+ dir[3]:='\';
+ i:=4;
+ {Conversion to Pascal string }
+ while (dir[i]<>#0) do
+ begin
+ { convert path name to DOS }
+ if dir[i]='/' then
+ dir[i]:='\';
+ dir[0]:=char(i);
+ inc(i);
+ end;
+ { upcase the string (FPC function) }
+ if drivenr<>0 then { Drive was supplied. We know it }
+ dir[1]:=chr(64+drivenr)
+ else
+ begin
+ { We need to get the current drive from DOS function 19H }
+ { because the drive was the default, which can be unknown }
+ DosQueryCurrentDisk(l, l2);
+ dir[1]:=chr(64+l);
+ end;
+ if not (FileNameCaseSensitive) then dir:=upcase(dir);
+end;
+
+
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/os2/sysfile.inc b/rtl/os2/sysfile.inc
new file mode 100644
index 0000000000..f73d42f433
--- /dev/null
+++ b/rtl/os2/sysfile.inc
@@ -0,0 +1,273 @@
+{
+ $Id: sysfile.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+
+ Low Level File Routines
+
+****************************************************************************}
+
+procedure allowslash(p:Pchar);
+{Allow slash as backslash.}
+var i:longint;
+begin
+ for i:=0 to strlen(p) do
+ if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close(h:thandle);
+begin
+{ Only three standard handles under real OS/2 }
+ if h>2 then
+ begin
+ InOutRes:=DosClose(h);
+ end;
+{$ifdef IODEBUG}
+ writeln('do_close: handle=', H, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+procedure do_erase(p:Pchar);
+begin
+ allowslash(p);
+ inoutres:=DosDelete(p);
+end;
+
+procedure do_rename(p1,p2:Pchar);
+begin
+ allowslash(p1);
+ allowslash(p2);
+ inoutres:=DosMove(p1, p2);
+end;
+
+function do_read(h:thandle;addr:pointer;len:longint):longint;
+Var
+ T: cardinal;
+begin
+{$ifdef IODEBUG}
+ write('do_read: handle=', h, ', addr=', ptrint(addr), ', length=', len);
+{$endif}
+ InOutRes:=DosRead(H, Addr, Len, T);
+ do_read:= longint (T);
+{$ifdef IODEBUG}
+ writeln(', actual_len=', t, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function do_write(h:thandle;addr:pointer;len:longint) : longint;
+Var
+ T: cardinal;
+begin
+{$ifdef IODEBUG}
+ write('do_write: handle=', h, ', addr=', ptrint(addr), ', length=', len);
+{$endif}
+ InOutRes:=DosWrite(H, Addr, Len, T);
+ do_write:= longint (T);
+{$ifdef IODEBUG}
+ writeln(', actual_len=', t, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function do_filepos(handle:thandle): longint;
+var
+ PosActual: cardinal;
+begin
+ InOutRes:=DosSetFilePtr(Handle, 0, 1, PosActual);
+ do_filepos:=longint (PosActual);
+{$ifdef IODEBUG}
+ writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+procedure do_seek(handle:thandle;pos:longint);
+var
+ PosActual: cardinal;
+begin
+ InOutRes:=DosSetFilePtr(Handle, Pos, 0 {ZeroBased}, PosActual);
+{$ifdef IODEBUG}
+ writeln('do_seek: handle=', Handle, ', pos=', pos, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function do_seekend(handle:thandle):longint;
+var
+ PosActual: cardinal;
+begin
+ InOutRes:=DosSetFilePtr(Handle, 0, 2 {EndBased}, PosActual);
+ do_seekend:=longint (PosActual);
+{$ifdef IODEBUG}
+ writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function do_filesize(handle:thandle):longint;
+var aktfilepos: cardinal;
+begin
+ aktfilepos:=do_filepos(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,aktfilepos);
+end;
+
+procedure do_truncate(handle:thandle;pos:longint);
+begin
+ InOutRes:=DosSetFileSize(Handle, Pos);
+ do_seekend(handle);
+end;
+
+const
+ FileHandleCount: cardinal = 20;
+
+function Increase_File_Handle_Count: boolean;
+var Err: word;
+ L1: longint;
+ L2: cardinal;
+begin
+ L1 := 10;
+ if DosSetRelMaxFH (L1, L2) <> 0 then
+ Increase_File_Handle_Count := false
+ else
+ if L2 > FileHandleCount then
+ begin
+ FileHandleCount := L2;
+ Increase_File_Handle_Count := true;
+ end
+ else
+ Increase_File_Handle_Count := false;
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+ Action, Attrib, OpenFlags, FM: Cardinal;
+begin
+ // convert unix slashes to normal slashes
+ allowslash(p);
+
+ // close first if opened
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed:;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+
+ // reset file handle
+ filerec(f).handle := UnusedHandle;
+
+ Attrib:=0;
+ OpenFlags:=0;
+
+ // convert filesharing
+ FM := Flags and $FF and not (8);
+(* DenyNone if sharing not specified. *)
+ if FM and 112 = 0 then
+ FM := FM or 64;
+ // convert filemode to filerec modes and access mode
+ case (FM and 3) of
+ 0: filerec(f).mode:=fminput;
+ 1: filerec(f).mode:=fmoutput;
+ 2: filerec(f).mode:=fminout;
+ end;
+
+ if (flags and $1000)<>0 then
+ OpenFlags:=OpenFlags or 2 {doOverwrite} or 16 {doCreate} // Create/overwrite
+ else
+ OpenFlags:=OpenFlags or 1 {doOpen}; // Open existing
+
+ // Handle Std I/O
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, // this is set by rewrite
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; // fool fmappend
+ end;
+ end;
+ exit;
+ end;
+
+ Attrib:=32 {faArchive};
+
+ InOutRes:=DosOpen(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+
+ // If too many open files try to set more file handles and open again
+ if (InOutRes = 4) then
+ if Increase_File_Handle_Count then
+ InOutRes:=DosOpen(p, FileRec(F).Handle, Action, 0, Attrib, OpenFlags, FM, nil);
+
+ If InOutRes<>0 then FileRec(F).Handle:=UnusedHandle;
+
+ // If Handle created -> make some things
+ if (FileRec(F).Handle <> UnusedHandle) then
+ begin
+
+ // Move to end of file for Append command
+ if ((Flags and $100) <> 0) then
+ begin
+ do_seekend(FileRec(F).Handle);
+ FileRec(F).Mode := fmOutput;
+ end;
+
+ end;
+
+{$ifdef IODEBUG}
+ writeln('do_open,', filerec(f).handle, ',', filerec(f).name, ',', filerec(f).mode, ', InOutRes=', InOutRes);
+{$endif}
+end;
+
+function do_isdevice (Handle: THandle): boolean;
+var
+ HT, Attr: cardinal;
+begin
+ do_isdevice:=false;
+ If DosQueryHType(Handle, HT, Attr)<>0 then exit;
+ if ht=1 then do_isdevice:=true;
+end;
+{$ASMMODE ATT}
+
+
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/os2/sysheap.inc b/rtl/os2/sysheap.inc
new file mode 100644
index 0000000000..eb31a3259d
--- /dev/null
+++ b/rtl/os2/sysheap.inc
@@ -0,0 +1,175 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+
+ Heap management releated routines.
+
+****************************************************************************}
+
+{Get some memory.
+ P = Pointer to memory will be returned here.
+ Size = Number of bytes to get. The size is rounded up to a multiple
+ of 4096. This is probably not the case on non-intel 386
+ versions of OS/2.
+ Flags = One or more of the mfXXXX constants.}
+
+function DosAllocMem(var P:pointer;Size,Flag:cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 299;
+
+function DosSetMem(P:pointer;Size,Flag:cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 305;
+
+function DosFreeMem (P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 304;
+
+{$IFDEF DUMPGROW}
+ {$DEFINE EXTDUMPGROW}
+{$ENDIF DUMPGROW}
+
+{$IFDEF EXTDUMPGROW}
+var
+ Int_HeapSize: cardinal;
+{$ENDIF EXTDUMPGROW}
+
+{function GetHeapSize: longint; assembler;
+asm
+ movl Int_HeapSize, %eax
+end ['EAX'];
+}
+
+
+function SysOSAlloc (Size: PtrInt): pointer;
+var
+ P: pointer;
+ RC: cardinal;
+begin
+{$IFDEF EXTDUMPGROW}
+ if Int_HeapSize <> high (cardinal) then
+{
+ if Int_HeapSize = high (cardinal) then
+ WriteLn ('Trying to allocate first heap of size ', Size)
+ else
+}
+ WriteLn ('Trying to grow heap by ', Size, ' to ', Int_HeapSize);
+{$ENDIF}
+
+ if UseHighMem then
+ RC := DosAllocMem (P, Size, $403)
+ else
+ RC := DosAllocMem (P, Size, 3);
+ if RC = 0 then
+ begin
+{$IFDEF EXTDUMPGROW}
+ if Int_HeapSize <> high (cardinal) then
+ WriteLn ('DosAllocMem returned memory at ', cardinal (P));
+{$ENDIF}
+ RC := DosSetMem (P, Size, $410);
+ if RC = 0 then
+ begin
+{$IFDEF EXTDUMPGROW}
+ if Int_HeapSize <> high (cardinal) then
+ WriteLn ('New heap at ', cardinal (P));
+{$ENDIF EXTDUMPGROW}
+ SysOSAlloc := P;
+{$IFDEF EXTDUMPGROW}
+ if Int_HeapSize = high (cardinal) then
+ Int_HeapSize := Size
+ else
+ Inc (Int_HeapSize, Size);
+{$ENDIF EXTDUMPGROW}
+ end
+ else
+ begin
+{$IFDEF EXTDUMPGROW}
+ if Int_HeapSize <> high (cardinal) then
+ begin
+ WriteLn ('Error ', RC, ' in DosSetMem while trying to commit memory!');
+{ if Int_HeapSize = high (cardinal) then
+ WriteLn ('No allocated memory comitted yet!')
+ else
+}
+ WriteLn ('Total allocated memory is ', Int_HeapSize);
+ end;
+{$ENDIF EXTDUMPGROW}
+ RC := DosFreeMem (P);
+ SysOSAlloc := nil;
+ end;
+ end
+ else
+ begin
+ SysOSAlloc := nil;
+{$IFDEF EXTDUMPGROW}
+ if Int_HeapSize <> high (cardinal) then
+ begin
+ WriteLn ('Error ', RC, ' during additional memory allocation (DosAllocMem)!');
+{ if Int_HeapSize = high (cardinal) then
+ WriteLn ('No memory allocated yet!')
+ else
+}
+ WriteLn ('Total allocated memory is ', Int_HeapSize);
+ end;
+{$ENDIF EXTDUMPGROW}
+ end;
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree (P: pointer; Size: PtrInt);
+var
+ RC: cardinal;
+begin
+{$IFDEF EXTDUMPGROW}
+ WriteLn ('Trying to free memory!');
+ WriteLn ('Total allocated memory is ', Int_HeapSize);
+ Dec (Int_HeapSize, Size);
+{$ENDIF EXTDUMPGROW}
+ RC := DosSetMem (P, Size, $20);
+ if RC = 0 then
+ begin
+ RC := DosFreeMem (P);
+{$IFDEF EXTDUMPGROW}
+ if RC <> 0 then
+ begin
+ WriteLn ('Error ', RC, ' during memory deallocation (DosFreeMem)!');
+ WriteLn ('Total allocated memory is ', Int_HeapSize);
+ end;
+{$ENDIF EXTDUMPGROW}
+ end
+{$IFDEF EXTDUMPGROW}
+ else
+ begin
+ WriteLn ('Error ', RC, ' in DosSetMem while trying to decommit memory!');
+ WriteLn ('Total allocated memory is ', Int_HeapSize);
+ end;
+{$ENDIF EXTDUMPGROW}
+end;
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/os2/sysos.inc b/rtl/os2/sysos.inc
new file mode 100644
index 0000000000..e625684c45
--- /dev/null
+++ b/rtl/os2/sysos.inc
@@ -0,0 +1,316 @@
+{
+ $Id: sysos.inc,v 1.1 2005/02/06 16:57:18 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+var
+ ProcessID: SizeUInt;
+
+function GetProcessID:SizeUInt;
+begin
+ GetProcessID := ProcessID;
+end;
+
+procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
+ PAPIB: PPProcessInfoBlock); cdecl;
+ external 'DOSCALLS' index 312;
+
+function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
+ var Handle: cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 318;
+
+function DosQueryProcAddr (Handle, Ordinal: cardinal; ProcName: PChar;
+ var Address: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 321;
+
+function DosSetRelMaxFH (var ReqCount: longint; var CurMaxFH: cardinal):
+ cardinal; cdecl;
+external 'DOSCALLS' index 382;
+
+function DosSetCurrentDir (Name:PChar): cardinal; cdecl;
+external 'DOSCALLS' index 255;
+
+procedure DosQueryCurrentDisk(var DiskNum:cardinal;var Logical:cardinal); cdecl;
+external 'DOSCALLS' index 275;
+
+function DosSetDefaultDisk (DiskNum:cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 220;
+
+{ This is not real prototype, but is close enough }
+{ for us (the 2nd parameter is actually a pointer }
+{ to a structure). }
+function DosCreateDir (Name: PChar; P: pointer): cardinal; cdecl;
+external 'DOSCALLS' index 270;
+
+function DosDeleteDir (Name: PChar): cardinal; cdecl;
+external 'DOSCALLS' index 226;
+
+function DosQueryCurrentDir(DiskNum:cardinal;var Buffer;
+ var BufLen:cardinal): cardinal; cdecl;
+external 'DOSCALLS' index 274;
+
+function DosMove(OldFile,NewFile:PChar):cardinal; cdecl;
+ external 'DOSCALLS' index 271;
+
+function DosDelete(FileName:PChar):cardinal; cdecl;
+ external 'DOSCALLS' index 259;
+
+procedure DosExit(Action, Result: cardinal); cdecl;
+ external 'DOSCALLS' index 234;
+
+// EAs not used in System unit
+function DosOpen(FileName:PChar;var Handle: THandle;var Action:cardinal;
+ InitSize,Attrib,OpenFlags,FileMode:cardinal;
+ EA:Pointer): cardinal; cdecl;
+ external 'DOSCALLS' index 273;
+
+function DosClose(Handle: THandle): cardinal; cdecl;
+ external 'DOSCALLS' index 257;
+
+function DosRead(Handle: THandle; Buffer: Pointer; Count: cardinal;
+ var ActCount: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 281;
+
+function DosWrite(Handle: THandle; Buffer: Pointer;Count: cardinal;
+ var ActCount: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 282;
+
+function DosSetFilePtr(Handle: THandle; Pos:longint; Method:cardinal;
+ var PosActual: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 256;
+
+function DosSetFileSize(Handle: THandle; Size: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 272;
+
+function DosQueryHType(Handle: THandle; var HandType: cardinal;
+ var Attr: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 224;
+
+type
+ TSysDateTime=packed record
+ Hour,
+ Minute,
+ Second,
+ Sec100,
+ Day,
+ Month: byte;
+ Year: word;
+ TimeZone: smallint;
+ WeekDay: byte;
+ end;
+
+function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
+ external 'DOSCALLS' index 230;
+
+ { converts an OS/2 error code to a TP compatible error }
+ { code. Same thing exists under most other supported }
+ { systems. }
+ { Only call for OS/2 DLL imported routines }
+ Procedure Errno2InOutRes;
+ Begin
+ { errors 1..18 are the same as in DOS }
+ case InOutRes of
+ { simple offset to convert these error codes }
+ { exactly like the error codes in Win32 }
+ 19..31 : InOutRes := InOutRes + 131;
+ { gets a bit more complicated ... }
+ 32..33 : InOutRes := 5;
+ 38 : InOutRes := 100;
+ 39 : InOutRes := 101;
+ 112 : InOutRes := 101;
+ 110 : InOutRes := 5;
+ 114 : InOutRes := 6;
+ 290 : InOutRes := 290;
+ end;
+ { all other cases ... we keep the same error code }
+ end;
+
+
+{$IFDEF OS2EXCEPTIONS}
+(*
+The operating system defines a class of error conditions called exceptions, and specifies the default actions that are taken when these exceptions occur. The system default action in most cases is to terminate the thread that caused the exception.
+
+Exception values have the following 32-bit format:
+
+ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
+ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+ÚÄÄÄÂÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
+³Sev³C³ Facility ³ Code ³
+ÀÄÄÄÁÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
+
+
+Sev Severity code. Possible values are described in the following list:
+
+00 Success
+01 Informational
+10 Warning
+11 Error
+
+C Customer code flag.
+
+Facility Facility code.
+
+Code Facility's status code.
+
+Exceptions that are specific to OS/2 Version 2.X (for example, XCPT_SIGNAL)
+have a facility code of 1.
+
+System exceptions include both synchronous and asynchronous exceptions.
+Synchronous exceptions are caused by events that are internal to a thread's
+execution. For example, synchronous exceptions could be caused by invalid
+parameters, or by a thread's request to end its own execution.
+
+Asynchronous exceptions are caused by events that are external to a thread's
+execution. For example, an asynchronous exception can be caused by a user's
+entering a Ctrl+C or Ctrl+Break key sequence, or by a process' issuing
+DosKillProcess to end the execution of another process.
+
+The Ctrl+Break and Ctrl+C exceptions are also known as signals, or as signal
+exceptions.
+
+The following tables show the symbolic names of system exceptions, their
+numerical values, and related information fields.
+
+Portable, Non-Fatal, Software-Generated Exceptions
+
+ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿
+³Exception Name ³Value ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_GUARD_PAGE_VIOLATION ³0x80000001³
+³ ExceptionInfo[0] - R/W flag ³ ³
+³ ExceptionInfo[1] - FaultAddr ³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_UNABLE_TO_GROW_STACK ³0x80010001³
+ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ
+
+
+Portable, Fatal, Hardware-Generated Exceptions
+
+ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
+³Exception Name ³Value ³Related Trap ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_ACCESS_VIOLATION ³0xC0000005³0x09, 0x0B, ³
+³ ExceptionInfo[0] - Flags ³ ³0x0C, 0x0D, ³
+³ XCPT_UNKNOWN_ACCESS 0x0 ³ ³0x0E ³
+³ XCPT_READ_ACCESS 0x1 ³ ³ ³
+³ XCPT_WRITE_ACCESS 0x2 ³ ³ ³
+³ XCPT_EXECUTE_ACCESS 0x4 ³ ³ ³
+³ XCPT_SPACE_ACCESS 0x8 ³ ³ ³
+³ XCPT_LIMIT_ACCESS 0x10 ³ ³ ³
+³ ExceptionInfo[1] - FaultAddr ³ ³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_INTEGER_DIVIDE_BY_ZERO ³0xC000009B³0 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_DIVIDE_BY_ZERO ³0xC0000095³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_INVALID_OPERATION ³0xC0000097³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_ILLEGAL_INSTRUCTION ³0xC000001C³0x06 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_PRIVILEGED_INSTRUCTION ³0xC000009D³0x0D ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_INTEGER_OVERFLOW ³0xC000009C³0x04 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_OVERFLOW ³0xC0000098³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_UNDERFLOW ³0xC000009A³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_DENORMAL_OPERAND ³0xC0000094³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_INEXACT_RESULT ³0xC0000096³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_FLOAT_STACK_CHECK ³0xC0000099³0x10 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_DATATYPE_MISALIGNMENT ³0xC000009E³0x11 ³
+³ ExceptionInfo[0] - R/W flag ³ ³ ³
+³ ExceptionInfo[1] - Alignment ³ ³ ³
+³ ExceptionInfo[2] - FaultAddr ³ ³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_BREAKPOINT ³0xC000009F³0x03 ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_SINGLE_STEP ³0xC00000A0³0x01 ³
+ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
+
+
+Portable, Fatal, Software-Generated Exceptions
+
+ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
+³Exception Name ³Value ³Related Trap ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_IN_PAGE_ERROR ³0xC0000006³0x0E ³
+³ ExceptionInfo[0] - FaultAddr ³ ³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_PROCESS_TERMINATE ³0xC0010001³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_ASYNC_PROCESS_TERMINATE ³0xC0010002³ ³
+³ ExceptionInfo[0] - TID of ³ ³ ³
+³ terminating thread ³ ³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_NONCONTINUABLE_EXCEPTION ³0xC0000024³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_INVALID_DISPOSITION ³0xC0000025³ ³
+ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
+
+
+Non-Portable, Fatal Exceptions
+
+ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
+³Exception Name ³Value ³Related Trap ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_INVALID_LOCK_SEQUENCE ³0xC000001D³ ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_ARRAY_BOUNDS_EXCEEDED ³0xC0000093³0x05 ³
+ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
+
+
+Unwind Operation Exceptions
+
+ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿
+³Exception Name ³Value ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_UNWIND ³0xC0000026³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_BAD_STACK ³0xC0000027³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_INVALID_UNWIND_TARGET ³0xC0000028³
+ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ
+
+
+Fatal Signal Exceptions
+
+ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿
+³Exception Name ³Value ³
+ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´
+³XCPT_SIGNAL ³0xC0010003³
+³ ExceptionInfo[ 0 ] - Signal ³ ³
+³ Number ³ ³
+ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ
+*)
+{$ENDIF OS2EXCEPTIONS}
+
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/os2/sysos2.pas b/rtl/os2/sysos2.pas
new file mode 100644
index 0000000000..08777b8a3e
--- /dev/null
+++ b/rtl/os2/sysos2.pas
@@ -0,0 +1 @@
+{$i system.pas}
diff --git a/rtl/os2/sysosh.inc b/rtl/os2/sysosh.inc
new file mode 100644
index 0000000000..0ea605e040
--- /dev/null
+++ b/rtl/os2/sysosh.inc
@@ -0,0 +1,54 @@
+{
+ $Id: sysosh.inc,v 1.3 2005/04/14 21:17:51 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+ THandle = Longint;
+ TThreadID = cardinal;
+
+ { the fields of this record are os dependent }
+ { and they shouldn't be used in a program }
+ { only the type TCriticalSection is important }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = packed record
+ DebugInfo : pointer;
+ LockCount : longint;
+ RecursionCount : longint;
+ OwningThread : DWord;
+ LockSemaphore : DWord;
+ Reserved : DWord;
+ end;
+
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.3 2005/04/14 21:17:51 hajny
+ * TThreadID changed to cardinal
+
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/os2/system.pas b/rtl/os2/system.pas
new file mode 100644
index 0000000000..d94b2dae3f
--- /dev/null
+++ b/rtl/os2/system.pas
@@ -0,0 +1,800 @@
+{
+ $Id: system.pas,v 1.85 2005/05/03 22:17:26 hajny Exp $
+ ****************************************************************************
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2002 by Free Pascal development team
+
+ Free Pascal - OS/2 runtime library
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+****************************************************************************}
+
+unit {$ifdef VER1_0}sysos2{$else}System{$endif};
+
+interface
+
+{$ifdef SYSTEMDEBUG}
+ {$define SYSTEMEXCEPTIONDEBUG}
+ {.$define IODEBUG}
+ {.$define DEBUGENVIRONMENT}
+ {.$define DEBUGARGUMENTS}
+{$endif SYSTEMDEBUG}
+
+{ $DEFINE OS2EXCEPTIONS}
+
+{$I systemh.inc}
+
+{$IFDEF OS2EXCEPTIONS}
+(* Types and constants for exception handler support *)
+type
+{x} PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
+{x} TEXCEPTION_FRAME = record
+{x} next : PEXCEPTION_FRAME;
+{x} handler : pointer;
+{x} end;
+
+{$ENDIF OS2EXCEPTIONS}
+
+const
+ LineEnding = #13#10;
+{ LFNSupport is defined separately below!!! }
+ DirectorySeparator = '\';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ MaxExitCode = 65535;
+
+type Tos=(osDOS,osOS2,osDPMI);
+
+const os_mode: Tos = osOS2;
+ first_meg: pointer = nil;
+
+{$IFDEF OS2EXCEPTIONS}
+{x} System_exception_frame : PEXCEPTION_FRAME =nil;
+{$ENDIF OS2EXCEPTIONS}
+
+type TByteArray = array [0..$ffff] of byte;
+ PByteArray = ^TByteArray;
+
+ TSysThreadIB = record
+ TID,
+ Priority,
+ Version: cardinal;
+ MCCount,
+ MCForceFlag: word;
+ end;
+ PSysThreadIB = ^TSysThreadIB;
+
+ TThreadInfoBlock = record
+ PExChain,
+ Stack,
+ StackLimit: pointer;
+ TIB2: PSysThreadIB;
+ Version,
+ Ordinal: cardinal;
+ end;
+ PThreadInfoBlock = ^TThreadInfoBlock;
+ PPThreadInfoBlock = ^PThreadInfoBlock;
+
+ TProcessInfoBlock = record
+ PID,
+ ParentPid,
+ Handle: cardinal;
+ Cmd,
+ Env: PByteArray;
+ Status,
+ ProcType: cardinal;
+ end;
+ PProcessInfoBlock = ^TProcessInfoBlock;
+ PPProcessInfoBlock = ^PProcessInfoBlock;
+
+const UnusedHandle=-1;
+ StdInputHandle=0;
+ StdOutputHandle=1;
+ StdErrorHandle=2;
+
+ LFNSupport: boolean = true;
+ FileNameCaseSensitive: boolean = false;
+ CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+var
+{ C-compatible arguments and environment }
+ argc : longint;
+ argv : ppchar;
+ envp : ppchar;
+ EnvC: cardinal;
+
+(* Pointer to the block of environment variables - used e.g. in unit Dos. *)
+ Environment: PChar;
+
+
+var
+(* Type / run mode of the current process: *)
+(* 0 .. full screen OS/2 session *)
+(* 1 .. DOS session *)
+(* 2 .. VIO windowable OS/2 session *)
+(* 3 .. Presentation Manager OS/2 session *)
+(* 4 .. detached (background) OS/2 process *)
+ ApplicationType: cardinal;
+
+(* Is allocation of memory above 512 MB address limit allowed? Initialized *)
+(* during initialization of system unit according to capabilities of the *)
+(* underlying OS/2 version, can be overridden by user - heap is allocated *)
+(* for all threads, so the setting isn't declared as a threadvar and *)
+(* should be only changed at the beginning of the main thread if needed. *)
+ UseHighMem: boolean;
+
+
+
+procedure SetDefaultOS2FileType (FType: ShortString);
+
+procedure SetDefaultOS2Creator (Creator: ShortString);
+
+
+
+implementation
+
+{$I system.inc}
+
+
+{****************************************************************************
+
+ Miscellaneous related routines.
+
+****************************************************************************}
+
+
+procedure system_exit;
+begin
+ DosExit (1{process}, exitcode);
+end;
+
+{$ASMMODE ATT}
+
+function paramcount:longint;assembler;
+asm
+ movl argc,%eax
+ decl %eax
+end {['EAX']};
+
+function args:pointer;assembler;
+asm
+ movl argv,%eax
+end {['EAX']};
+
+
+function paramstr(l:longint):string;
+
+var p:^Pchar;
+
+begin
+ if (l>=0) and (l<=paramcount) then
+ begin
+ p:=args;
+ paramstr:=strpas(p[l]);
+ end
+ else paramstr:='';
+end;
+
+procedure randomize;
+var
+ dt: TSysDateTime;
+begin
+ // Hmm... Lets use timer
+ DosGetDateTime(dt);
+ randseed:=dt.hour+(dt.minute shl 8)+(dt.second shl 16)+(dt.sec100 shl 32);
+end;
+
+{$ASMMODE ATT}
+
+
+{*****************************************************************************
+
+ System unit initialization.
+
+****************************************************************************}
+
+{****************************************************************************
+ Error Message writing using messageboxes
+****************************************************************************}
+
+type
+ TWinMessageBox = function (Parent, Owner: cardinal;
+ BoxText, BoxTitle: PChar; Identity, Style: cardinal): cardinal; cdecl;
+ TWinInitialize = function (Options: cardinal): cardinal; cdecl;
+ TWinCreateMsgQueue = function (Handle: cardinal; cmsg: longint): cardinal;
+ cdecl;
+
+const
+ ErrorBufferLength = 1024;
+ mb_OK = $0000;
+ mb_Error = $0040;
+ mb_Moveable = $4000;
+ MBStyle = mb_OK or mb_Error or mb_Moveable;
+ WinInitialize: TWinInitialize = nil;
+ WinCreateMsgQueue: TWinCreateMsgQueue = nil;
+ WinMessageBox: TWinMessageBox = nil;
+ EnvSize: cardinal = 0;
+
+var
+ ErrorBuf: array [0..ErrorBufferLength] of char;
+ ErrorLen: longint;
+ PMWinHandle: cardinal;
+
+function ErrorWrite (var F: TextRec): integer;
+{
+ An error message should always end with #13#10#13#10
+}
+var
+ P: PChar;
+ I: longint;
+begin
+ if F.BufPos > 0 then
+ begin
+ if F.BufPos + ErrorLen > ErrorBufferLength then
+ I := ErrorBufferLength - ErrorLen
+ else
+ I := F.BufPos;
+ Move (F.BufPtr^, ErrorBuf [ErrorLen], I);
+ Inc (ErrorLen, I);
+ ErrorBuf [ErrorLen] := #0;
+ end;
+ if ErrorLen > 3 then
+ begin
+ P := @ErrorBuf [ErrorLen];
+ for I := 1 to 4 do
+ begin
+ Dec (P);
+ if not (P^ in [#10, #13]) then
+ break;
+ end;
+ end;
+ if ErrorLen = ErrorBufferLength then
+ I := 4;
+ if (I = 4) then
+ begin
+ WinMessageBox (0, 0, @ErrorBuf, PChar ('Error'), 0, MBStyle);
+ ErrorLen := 0;
+ end;
+ F.BufPos := 0;
+ ErrorWrite := 0;
+end;
+
+function ErrorClose (var F: TextRec): integer;
+begin
+ if ErrorLen > 0 then
+ begin
+ WinMessageBox (0, 0, @ErrorBuf, PChar ('Error'), 0, MBStyle);
+ ErrorLen := 0;
+ end;
+ ErrorLen := 0;
+ ErrorClose := 0;
+end;
+
+function ErrorOpen (var F: TextRec): integer;
+begin
+ TextRec(F).InOutFunc := @ErrorWrite;
+ TextRec(F).FlushFunc := @ErrorWrite;
+ TextRec(F).CloseFunc := @ErrorClose;
+ ErrorOpen := 0;
+end;
+
+
+procedure AssignError (var T: Text);
+begin
+ Assign (T, '');
+ TextRec (T).OpenFunc := @ErrorOpen;
+ Rewrite (T);
+end;
+
+procedure SysInitStdIO;
+begin
+ { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+ displayed in a messagebox }
+(*
+ StdInputHandle := longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
+ StdOutputHandle := longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
+ StdErrorHandle := longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
+
+ if not IsConsole then
+ begin
+ if (DosLoadModule (nil, 0, 'PMWIN', PMWinHandle) = 0) and
+ (DosQueryProcAddr (PMWinHandle, 789, nil, pointer (WinMessageBox)) = 0)
+ and
+ (DosQueryProcAddr (PMWinHandle, 763, nil, pointer (WinInitialize)) = 0)
+ and
+ (DosQueryProcAddr (PMWinHandle, 716, nil, pointer (WinCreateMsgQueue))
+ = 0)
+ then
+ begin
+ WinInitialize (0);
+ WinCreateMsgQueue (0, 0);
+ end
+ else
+ HandleError (2);
+ AssignError (StdErr);
+ AssignError (StdOut);
+ Assign (Output, '');
+ Assign (Input, '');
+ end
+ else
+ begin
+*)
+ OpenStdIO (Input, fmInput, StdInputHandle);
+ OpenStdIO (Output, fmOutput, StdOutputHandle);
+ OpenStdIO (ErrOutput, fmOutput, StdErrorHandle);
+ OpenStdIO (StdOut, fmOutput, StdOutputHandle);
+ OpenStdIO (StdErr, fmOutput, StdErrorHandle);
+(*
+ end;
+*)
+end;
+
+
+function strcopy(dest,source : pchar) : pchar;assembler;
+var
+ saveeax,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,%edi
+{$else}
+ movl source,%edi
+{$endif}
+ testl %edi,%edi
+ jz .LStrCopyDone
+ leal 3(%edi),%ecx
+ andl $-4,%ecx
+ movl %edi,%esi
+ subl %edi,%ecx
+{$ifdef REGCALL}
+ movl %eax,%edi
+{$else}
+ movl dest,%edi
+{$endif}
+ jz .LStrCopyAligned
+.LStrCopyAlignLoop:
+ movb (%esi),%al
+ incl %edi
+ incl %esi
+ testb %al,%al
+ movb %al,-1(%edi)
+ jz .LStrCopyDone
+ decl %ecx
+ jnz .LStrCopyAlignLoop
+ .balign 16
+.LStrCopyAligned:
+ movl (%esi),%eax
+ movl %eax,%edx
+ leal 0x0fefefeff(%eax),%ecx
+ notl %edx
+ addl $4,%esi
+ andl %edx,%ecx
+ andl $0x080808080,%ecx
+ jnz .LStrCopyEndFound
+ movl %eax,(%edi)
+ addl $4,%edi
+ jmp .LStrCopyAligned
+.LStrCopyEndFound:
+ testl $0x0ff,%eax
+ jz .LStrCopyByte
+ testl $0x0ff00,%eax
+ jz .LStrCopyWord
+ testl $0x0ff0000,%eax
+ jz .LStrCopy3Bytes
+ movl %eax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopy3Bytes:
+ xorb %dl,%dl
+ movw %ax,(%edi)
+ movb %dl,2(%edi)
+ jmp .LStrCopyDone
+.LStrCopyWord:
+ movw %ax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopyByte:
+ movb %al,(%edi)
+.LStrCopyDone:
+{$ifdef REGCALL}
+ movl saveeax,%eax
+{$else}
+ movl dest,%eax
+{$endif}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+{$ifdef HASTHREADVAR}
+threadvar
+{$else HASTHREADVAR}
+var
+{$endif HASTHREADVAR}
+ DefaultCreator: ShortString;
+ DefaultFileType: ShortString;
+
+
+procedure SetDefaultOS2FileType (FType: ShortString);
+begin
+{$WARNING Not implemented yet!}
+ DefaultFileType := FType;
+end;
+
+
+procedure SetDefaultOS2Creator (Creator: ShortString);
+begin
+{$WARNING Not implemented yet!}
+ DefaultCreator := Creator;
+end;
+
+
+procedure InitEnvironment;
+var env_count : longint;
+ dos_env,cp : pchar;
+begin
+ env_count:=0;
+ cp:=environment;
+ while cp ^ <> #0 do
+ begin
+ inc(env_count);
+ while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
+ inc(longint(cp)); { skip to next character }
+ end;
+ envp := sysgetmem((env_count+1) * sizeof(pchar));
+ envc := env_count;
+ if (envp = nil) then exit;
+ cp:=environment;
+ env_count:=0;
+ while cp^ <> #0 do
+ begin
+ envp[env_count] := sysgetmem(strlen(cp)+1);
+ strcopy(envp[env_count], cp);
+{$IfDef DEBUGENVIRONMENT}
+ Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
+{$EndIf}
+ inc(env_count);
+ while (cp^ <> #0) do
+ inc(longint(cp)); { skip to NUL }
+ inc(longint(cp)); { skip to next character }
+ end;
+ envp[env_count]:=nil;
+end;
+
+procedure InitArguments;
+var
+ arglen,
+ count : PtrInt;
+ argstart,
+ pc,arg : pchar;
+ quote : char;
+ argvlen : PtrInt;
+
+ procedure allocarg(idx,len: PtrInt);
+ var
+ oldargvlen : PtrInt;
+ begin
+ if idx>=argvlen then
+ begin
+ oldargvlen:=argvlen;
+ argvlen:=(idx+8) and (not 7);
+ sysreallocmem(argv,argvlen*sizeof(pointer));
+ fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
+ end;
+ { use realloc to reuse already existing memory }
+ { always allocate, even if length is zero, since }
+ { the arg. is still present! }
+{ sysreallocmem(argv[idx],len+1);}
+ ArgV [Idx] := SysAllocMem (Succ (Len));
+ end;
+
+begin
+ count:=0;
+ argv:=nil;
+ argvlen:=0;
+
+ // Get argv[0]
+ pc:=cmdline;
+ Arglen:=0;
+ repeat
+ Inc(Arglen);
+ until (pc[Arglen] = #0);
+ allocarg(count,arglen);
+ move(pc^,argv[count]^,arglen);
+
+ { ReSetup cmdline variable }
+ repeat
+ Inc(Arglen);
+ until (pc[Arglen]=#0);
+ Inc(Arglen);
+ pc:=GetMem(ArgLen);
+ move(cmdline^, pc^, arglen);
+ Arglen:=0;
+ repeat
+ Inc(Arglen);
+ until (pc[Arglen]=#0);
+ pc[Arglen]:=' '; // combine argv[0] and command line
+ CmdLine:=pc;
+
+ { process arguments }
+ pc:=cmdline;
+{$IfDef DEBUGARGUMENTS}
+ Writeln(stderr,'GetCommandLine is #',pc,'#');
+{$EndIf }
+ while pc^<>#0 do
+ begin
+ { skip leading spaces }
+ while pc^ in [#1..#32] do
+ inc(pc);
+ if pc^=#0 then
+ break;
+ { calc argument length }
+ quote:=' ';
+ argstart:=pc;
+ arglen:=0;
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ inc(arglen)
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ else
+ inc(arglen);
+ end;
+ inc(pc);
+ end;
+ { copy argument }
+ { Don't copy the first one, it is already there.}
+ If Count<>0 then
+ begin
+ allocarg(count,arglen);
+ quote:=' ';
+ pc:=argstart;
+ arg:=argv[count];
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ inc(pc);
+ end;
+ arg^:=#0;
+ end;
+ {$IfDef DEBUGARGUMENTS}
+ Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
+ {$EndIf}
+ inc(count);
+ end;
+ { get argc and create an nil entry }
+ argc:=count;
+ allocarg(argc,0);
+ { free unused memory }
+ sysreallocmem(argv,(argc+1)*sizeof(pointer));
+end;
+
+function GetFileHandleCount: longint;
+var L1: longint;
+ L2: cardinal;
+begin
+ L1 := 0; (* Don't change the amount, just check. *)
+ if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
+ else GetFileHandleCount := L2;
+end;
+
+var TIB: PThreadInfoBlock;
+ PIB: PProcessInfoBlock;
+ RC: cardinal;
+ ErrStr: string;
+ P: pointer;
+
+begin
+ IsLibrary := FALSE;
+
+ (* Initialize the amount of file handles *)
+ FileHandleCount := GetFileHandleCount;
+ DosGetInfoBlocks (@TIB, @PIB);
+ StackBottom := TIB^.Stack;
+
+ {Set type of application}
+ ApplicationType := PIB^.ProcType;
+ ProcessID := PIB^.PID;
+ ThreadID := TIB^.TIB2^.TID;
+ IsConsole := ApplicationType <> 3;
+
+ ExitProc := nil;
+
+ {Initialize the heap.}
+ (* Logic is following:
+ The heap is initially restricted to low address space (< 512 MB).
+ If underlying OS/2 version allows using more than 512 MB per process
+ (OS/2 WarpServer for e-Business, eComStation, possibly OS/2 Warp 4.0
+ with FP13 and above as well), use of this high memory is allowed for
+ future memory allocations at the end of System unit initialization.
+ The consequences are that the compiled application can allocate more
+ memory, but it must make sure to use direct DosAllocMem calls if it
+ needs a memory block for some system API not supporting high memory.
+ This is probably no problem for direct calls to these APIs, but
+ there might be situations when a memory block needs to be passed
+ to a 3rd party DLL which in turn calls such an API call. In case
+ of problems usage of high memory can be turned off by setting
+ UseHighMem to false - the program should change the setting at its
+ very beginning (e.g. in initialization section of the first unit
+ listed in the "uses" section) to avoid having preallocated memory
+ from the high memory region before changing value of this variable. *)
+ InitHeap;
+
+ { ... and exceptions }
+ SysInitExceptions;
+
+ { ... and I/O }
+ SysInitStdIO;
+
+ { no I/O-Error }
+ inoutres:=0;
+
+ {Initialize environment (must be after InitHeap because allocates memory)}
+ Environment := pointer (PIB^.Env);
+ InitEnvironment;
+
+ CmdLine := pointer (PIB^.Cmd);
+ InitArguments;
+ DefaultCreator := '';
+ DefaultFileType := '';
+
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+
+{$IFDEF EXTDUMPGROW}
+{ Int_HeapSize := high (cardinal);}
+{$ENDIF EXTDUMPGROW}
+ RC := DosAllocMem (P, 4096, $403);
+ if RC = 87 then
+(* Using of high memory address space (> 512 MB) *)
+(* is not supported on this system. *)
+ UseHighMem := false
+ else
+ begin
+ UseHighMem := true;
+ if RC <> 0 then
+ begin
+ Str (RC, ErrStr);
+ ErrStr := 'Error during heap initialization (DosAllocMem - ' + ErrStr + ')!!'#13#10;
+ DosWrite (2, @ErrStr [1], Length (ErrStr), RC);
+ HandleError (204);
+ end
+ else
+ DosFreeMem (P);
+ end;
+end.
+{
+ $Log: system.pas,v $
+ Revision 1.85 2005/05/03 22:17:26 hajny
+ * SysAllocMem used for ArgV [Idx] allocation again
+
+ Revision 1.84 2005/05/01 13:01:03 peter
+ use fillchar after reallocmem, fix taken from win32
+
+ Revision 1.83 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.82 2005/03/27 20:50:35 hajny
+ * correction of previous mistyping
+
+ Revision 1.81 2005/03/27 20:40:54 hajny
+ * fix for allocarg
+
+ Revision 1.80 2005/03/01 21:59:14 hajny
+ * compilation fix
+
+ Revision 1.79 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.78 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+}
diff --git a/rtl/os2/systhrd.inc b/rtl/os2/systhrd.inc
new file mode 100644
index 0000000000..122c254d6d
--- /dev/null
+++ b/rtl/os2/systhrd.inc
@@ -0,0 +1,562 @@
+{
+ $Id: systhrd.inc,v 1.3 2005/04/20 21:52:16 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002-5 by Tomas Hajny,
+ member of the Free Pascal development team.
+
+ OS/2 threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Local Api imports
+*****************************************************************************}
+
+const
+ pag_Read = 1;
+ pag_Write = 2;
+ pag_Execute = 4;
+ pag_Guard = 8;
+ pag_Commit = $10;
+ obj_Tile = $40;
+ sem_Indefinite_Wait = -1;
+ dtSuspended = 1;
+ dtStack_Commited = 2;
+
+
+{ import the necessary stuff from the OS }
+function DosAllocThreadLocalMemory (Count: cardinal; var P: pointer): cardinal;
+ cdecl; external 'DOSCALLS' index 454;
+
+function DosFreeThreadLocalMemory (P: pointer): cardinal; cdecl;
+ external 'DOSCALLS' index 455;
+
+function DosCreateThread (var TID: cardinal; Address: pointer;
+(* TThreadFunc *)
+ aParam: pointer; Flags: cardinal; StackSize: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 311;
+
+function DosCreateMutExSem (Name: PChar; var Handle: longint; Attr: cardinal;
+ State: boolean): cardinal; cdecl; external 'DOSCALLS' index 331;
+
+function DosCloseMutExSem (Handle: longint): cardinal; cdecl;
+ external 'DOSCALLS' index 333;
+
+function DosQueryMutExSem (Handle: longint; var PID, TID, Count: cardinal):
+ cardinal; cdecl; external 'DOSCALLS' index 336;
+
+function DosRequestMutExSem (Handle:longint; Timeout: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 334;
+
+function DosReleaseMutExSem (Handle: longint): cardinal; cdecl;
+ external 'DOSCALLS' index 335;
+
+{
+function DosEnterCritSec:cardinal; cdecl; external 'DOSCALLS' index 232;
+
+function DosExitCritSec:cardinal; cdecl; external 'DOSCALLS' index 233;
+}
+
+procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
+
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+const
+ ThreadVarBlockSize: dword = 0;
+
+var
+(* Pointer to an allocated dword space within the local thread *)
+(* memory area. Pointer to the real memory block allocated for *)
+(* thread vars in this block is then stored in this dword. *)
+ DataIndex: PPointer;
+
+procedure SysInitThreadvar (var Offset: dword; Size: dword);
+begin
+ Offset := ThreadVarBlockSize;
+ Inc (ThreadVarBlockSize, Size);
+end;
+
+function SysRelocateThreadVar (Offset: dword): pointer;
+begin
+ SysRelocateThreadVar := DataIndex^ + Offset;
+end;
+
+procedure SysAllocateThreadVars;
+begin
+ { we've to allocate the memory from the OS }
+ { because the FPC heap management uses }
+ { exceptions which use threadvars but }
+ { these aren't allocated yet ... }
+ { allocate room on the heap for the thread vars }
+ if DosAllocMem (DataIndex^, ThreadVarBlockSize, pag_Read or pag_Write
+ or pag_Commit) <> 0 then HandleError (8);
+end;
+
+procedure SysReleaseThreadVars;
+begin
+ { release thread vars }
+ DosFreeMem (DataIndex^);
+ DosFreeThreadLocalMemory (DataIndex);
+end;
+
+(* procedure InitThreadVars;
+ begin
+ { allocate one ThreadVar entry from the OS, we use this entry }
+ { for a pointer to our threadvars }
+ if DosAllocThreadLocalMemory (1, DataIndex) <> 0 then HandleError (8);
+ { initialize threadvars }
+ init_all_unit_threadvars;
+ { allocate mem for main thread threadvars }
+ SysAllocateThreadVars;
+ { copy main thread threadvars }
+ copy_all_unit_threadvars;
+ { install threadvar handler }
+ fpc_threadvar_relocate_proc := @SysRelocateThreadvar;
+ end;
+*)
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+ Thread starting
+*****************************************************************************}
+
+ type
+ pthreadinfo = ^tthreadinfo;
+ tthreadinfo = record
+ f : tthreadfunc;
+ p : pointer;
+ stklen : cardinal;
+ end;
+
+(* procedure InitThread(stklen:cardinal);
+ begin
+ SysResetFPU;
+ { ExceptAddrStack and ExceptObjectStack are threadvars }
+ { so every thread has its on exception handling capabilities }
+ SysInitExceptions;
+ { Open all stdio fds again }
+ SysInitStdio;
+ InOutRes:=0;
+ // ErrNo:=0;
+ { Stack checking }
+ StackLength:=stklen;
+ StackBottom:=Sptr - StackLength;
+ end;
+*)
+
+
+ procedure DoneThread;
+ begin
+ { Release Threadvars }
+{$ifdef HASTHREADVAR}
+ SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+ end;
+
+
+ function ThreadMain(param : pointer) : pointer;cdecl;
+ var
+ ti : tthreadinfo;
+ begin
+{$ifdef HASTHREADVAR}
+ { Allocate local thread vars, this must be the first thing,
+ because the exception management and io depends on threadvars }
+ SysAllocateThreadVars;
+{$endif HASTHREADVAR}
+ { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+ writeln('New thread started, initialising ...');
+{$endif DEBUG_MT}
+ ti:=pthreadinfo(param)^;
+ dispose(pthreadinfo(param));
+ { Initialize thread }
+ InitThread(ti.stklen);
+ { Start thread function }
+{$ifdef DEBUG_MT}
+ writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+ ThreadMain:=pointer(ti.f(ti.p));
+ end;
+
+
+ function SysBeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;
+ creationFlags : dword; var ThreadId : TThreadID) : DWord;
+ var
+ TI: PThreadInfo;
+ begin
+{$ifdef DEBUG_MT}
+ writeln('Creating new thread');
+{$endif DEBUG_MT}
+ { Initialize multithreading if not done }
+ if not IsMultiThread then
+ begin
+{$ifdef HASTHREADVAR}
+ if DosAllocThreadLocalMemory (1, DataIndex) <> 0
+ then RunError (8);
+ InitThreadVars(@SysRelocateThreadVar);
+{$endif HASTHREADVAR}
+ IsMultiThread:=true;
+ end;
+ { the only way to pass data to the newly created thread
+ in a MT safe way, is to use the heap }
+ New (TI);
+ TI^.F := ThreadFunction;
+ TI^.P := P;
+ TI^.StkLen := StackSize;
+ { call pthread_create }
+{$ifdef DEBUG_MT}
+ writeln('Starting new thread');
+{$endif DEBUG_MT}
+ SysBeginThread := DosCreateThread (DWord (ThreadID), @ThreadMain, SA,
+ CreationFlags, StackSize);
+ end;
+
+
+ procedure SysEndThread (ExitCode : DWord);
+ begin
+ DoneThread;
+ DosExit (1, ExitCode);
+ end;
+
+
+ procedure SysThreadSwitch;
+ begin
+ DosSleep (0);
+ end;
+
+
+ function SysSuspendThread (ThreadHandle: dword): dword;
+ begin
+ {$WARNING TODO!}
+{ SysSuspendThread := WinSuspendThread(threadHandle);
+}
+ end;
+
+
+ function SysResumeThread (ThreadHandle: dword): dword;
+ begin
+{$WARNING TODO!}
+{ SysResumeThread := WinResumeThread(threadHandle);
+}
+ end;
+
+
+ function SysKillThread (ThreadHandle: dword): dword;
+ var
+ ExitCode: dword;
+ begin
+{$WARNING TODO!}
+{
+ if not TerminateThread (ThreadHandle, ExitCode) then
+ SysKillThread := GetLastError
+ else
+ SysKillThread := 0;
+}
+ end;
+
+ function SysWaitForThreadTerminate (ThreadHandle: dword;
+ TimeoutMs: longint): dword;
+ begin
+{$WARNING TODO!}
+{
+ if TimeoutMs = 0 then dec (timeoutMs); // $ffffffff is INFINITE
+ SysWaitForThreadTerminate := WaitForSingleObject(threadHandle, TimeoutMs);
+}
+ end;
+
+
+ function SysThreadSetPriority (ThreadHandle: dword;
+ Prio: longint): boolean;
+ {-15..+15, 0=normal}
+ begin
+{$WARNING TODO!}
+{
+ SysThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio);
+}
+ end;
+
+
+ function SysThreadGetPriority (ThreadHandle: dword): longint;
+ begin
+{$WARNING TODO!}
+{
+ SysThreadGetPriority:=WinThreadGetPriority(threadHandle);
+}
+ end;
+
+
+ function SysGetCurrentThreadID: dword;
+ begin
+{$WARNING TODO!}
+{
+ SysGetCurrentThreadId:=WinGetCurrentThreadId;
+}
+ end;
+
+
+
+{*****************************************************************************
+ Delphi/Win32 compatibility
+*****************************************************************************}
+
+{ DosEnter/ExitCritSec have quite a few limitations, so let's try to avoid
+ them. I'm not sure whether mutex semaphores are SMP-safe, though... :-( }
+
+procedure SysInitCriticalSection(var CS);
+begin
+{$WARNING TODO!}
+end;
+
+
+procedure SysDoneCriticalSection (var CS);
+begin
+{$WARNING TODO!}
+end;
+
+procedure SysEnterCriticalSection (var CS);
+begin
+{$WARNING TODO!}
+end;
+
+procedure SysLeaveCriticalSection (var CS);
+begin
+{$WARNING TODO!}
+end;
+
+
+
+{*****************************************************************************
+ Heap Mutex Protection
+*****************************************************************************}
+
+ var
+ HeapMutex: TRTLCriticalSection;
+
+
+ procedure OS2HeapMutexInit;
+ begin
+ InitCriticalSection (HeapMutex);
+ end;
+
+
+ procedure OS2HeapMutexDone;
+ begin
+ DoneCriticalSection (HeapMutex);
+ end;
+
+
+ procedure OS2HeapMutexLock;
+ begin
+ EnterCriticalSection (HeapMutex);
+ end;
+
+
+ procedure OS2HeapMutexUnlock;
+ begin
+ LeaveCriticalSection (HeapMutex);
+ end;
+
+
+ const
+ OS2MemoryMutexManager : TMemoryMutexManager = (
+ MutexInit : @OS2HeapMutexInit;
+ MutexDone : @OS2HeapMutexDone;
+ MutexLock : @OS2HeapMutexLock;
+ MutexUnlock : @OS2HeapMutexUnlock;
+ );
+
+
+ procedure InitHeapMutexes;
+ begin
+ SetMemoryMutexManager (OS2MemoryMutexManager);
+ end;
+
+
+type
+ TBasicEventState = record
+ FHandle: THandle;
+ FLastError: longint;
+ end;
+ PLocalEventRec = ^TBasicEventState;
+
+
+function IntBasicEventCreate (EventAttributes: Pointer;
+ AManualReset, InitialState: Boolean; const Name: ansistring): PEventState;
+begin
+ New (PLocalEventRec (Result));
+{$WARNING TODO!}
+{
+ PLocalEventrec (Result)^.FHandle :=
+ CreateEvent (EventAttributes, AManualReset, InitialState,PChar(Name));
+}
+end;
+
+
+procedure IntBasicEventDestroy (State: PEventState);
+begin
+{$WARNING TODO!}
+{
+ closehandle(plocaleventrec(state)^.fhandle);
+}
+ Dispose (PLocalEventRec (State));
+end;
+
+
+procedure IntBasicEventResetEvent (State: PEventState);
+begin
+{$WARNING TODO!}
+{
+ ResetEvent(plocaleventrec(state)^.FHandle)
+}
+end;
+
+
+procedure IntBasicEventSetEvent (State: PEventState);
+begin
+{$WARNING TODO!}
+{
+ SetEvent(plocaleventrec(state)^.FHandle);
+}
+end;
+
+
+function IntBasicEventWaitFor (Timeout: Cardinal; State: PEventState): longint;
+begin
+{$WARNING TODO!}
+{
+ case WaitForSingleObject(plocaleventrec(state)^.fHandle, Timeout) of
+ WAIT_ABANDONED: Result := wrAbandoned;
+ WAIT_OBJECT_0: Result := wrSignaled;
+ WAIT_TIMEOUT: Result := wrTimeout;
+ WAIT_FAILED:
+ begin
+ Result := wrError;
+ plocaleventrec(state)^.FLastError := GetLastError;
+ end;
+ else
+ Result := wrError;
+ end;
+}
+end;
+
+
+function IntRTLEventCreate: PRTLEvent;
+begin
+{$WARNING TODO!}
+{
+ Result := PRTLEVENT(CreateEvent(nil, false, false, nil));
+}
+end;
+
+
+procedure IntRTLEventDestroy (AEvent: PRTLEvent);
+begin
+{$WARNING TODO!}
+{
+ CloseHandle(THANDLE(AEvent));
+}
+end;
+
+
+procedure IntRTLEventSetEvent (AEvent: PRTLEvent);
+begin
+{$WARNING TODO!}
+{
+ PulseEvent(THANDLE(AEvent));
+}
+end;
+
+
+CONST INFINITE=-1;
+
+procedure IntRTLEventStartWait (AEvent: PRTLEvent);
+begin
+{$WARNING TODO!}
+ // nothing to do, win32 events stay signalled after being set
+end;
+
+procedure IntRTLEventWaitFor (AEvent: PRTLEvent);
+begin
+{$WARNING TODO!}
+{
+ WaitForSingleObject(THANDLE(AEvent), INFINITE);
+}
+end;
+
+
+
+var
+ OS2ThreadManager: TThreadManager;
+
+
+procedure InitSystemThreads;
+begin
+ with OS2ThreadManager do
+ begin
+ InitManager :=Nil;
+ DoneManager :=Nil;
+ BeginThread :=@SysBeginThread;
+ EndThread :=@SysEndThread;
+ SuspendThread :=@SysSuspendThread;
+ ResumeThread :=@SysResumeThread;
+ KillThread :=@SysKillThread;
+ ThreadSwitch :=@SysThreadSwitch;
+ WaitForThreadTerminate :=@SysWaitForThreadTerminate;
+ ThreadSetPriority :=@SysThreadSetPriority;
+ ThreadGetPriority :=@SysThreadGetPriority;
+ GetCurrentThreadId :=@SysGetCurrentThreadId;
+ InitCriticalSection :=@SysInitCriticalSection;
+ DoneCriticalSection :=@SysDoneCriticalSection;
+ EnterCriticalSection :=@SysEnterCriticalSection;
+ LeaveCriticalSection :=@SysLeaveCriticalSection;
+{$ifdef HASTHREADVAR}
+ InitThreadVar :=@SysInitThreadVar;
+ RelocateThreadVar :=@SysRelocateThreadVar;
+ AllocateThreadVars :=@SysAllocateThreadVars;
+ ReleaseThreadVars :=@SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+ BasicEventCreate :=@IntBasicEventCreate;
+ BasicEventDestroy :=@IntBasicEventDestroy;
+ BasicEventResetEvent :=@IntBasicEventResetEvent;
+ BasicEventSetEvent :=@IntBasicEventSetEvent;
+ BasiceventWaitFor :=@IntBasiceventWaitFor;
+ RTLEventCreate :=@IntRTLEventCreate;
+ RTLEventDestroy :=@IntRTLEventDestroy;
+ RTLEventSetEvent :=@IntRTLEventSetEvent;
+ RTLEventStartWait :=@IntRTLEventStartWait;
+ RTLEventWaitFor :=@IntRTLEventWaitFor;
+ end;
+ SetThreadManager (OS2ThreadManager);
+ InitHeapMutexes;
+end;
+
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.3 2005/04/20 21:52:16 hajny
+ * TThreadID fix
+
+ Revision 1.2 2005/03/20 22:33:27 hajny
+ * thread local memory freed
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/os2/sysutils.pp b/rtl/os2/sysutils.pp
new file mode 100644
index 0000000000..47d131d5d9
--- /dev/null
+++ b/rtl/os2/sysutils.pp
@@ -0,0 +1,1043 @@
+{
+ $Id: sysutils.pp,v 1.50 2005/03/01 23:27:57 hajny Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for OS/2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ Dos;
+
+{$DEFINE HAS_SLEEP}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ System (imported) calls
+****************************************************************************}
+
+(* "uses DosCalls" could not be used here due to type *)
+(* conflicts, so needed parts had to be redefined here). *)
+
+type
+ TFileStatus = object
+ end;
+ PFileStatus = ^TFileStatus;
+
+ TFileStatus3 = object (TFileStatus)
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ end;
+ PFileStatus3=^TFileStatus3;
+
+ TFileStatus4=object(TFileStatus3)
+ cbList:cardinal; {Length of entire EA set.}
+ end;
+ PFileStatus4=^TFileStatus4;
+
+ TFileFindBuf3=object(TFileStatus)
+ NextEntryOffset: cardinal; {Offset of next entry}
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ Name:shortstring; {Also possible to use as ASCIIZ.
+ The byte following the last string
+ character is always zero.}
+ end;
+ PFileFindBuf3=^TFileFindBuf3;
+
+ TFileFindBuf4=object(TFileStatus)
+ NextEntryOffset: cardinal; {Offset of next entry}
+ DateCreation, {Date of file creation.}
+ TimeCreation, {Time of file creation.}
+ DateLastAccess, {Date of last access to file.}
+ TimeLastAccess, {Time of last access to file.}
+ DateLastWrite, {Date of last modification of file.}
+ TimeLastWrite:word; {Time of last modification of file.}
+ FileSize, {Size of file.}
+ FileAlloc:cardinal; {Amount of space the file really
+ occupies on disk.}
+ AttrFile:cardinal; {Attributes of file.}
+ cbList:longint; {Size of the file's extended attributes.}
+ Name:shortstring; {Also possible to use as ASCIIZ.
+ The byte following the last string
+ character is always zero.}
+ end;
+ PFileFindBuf4=^TFileFindBuf4;
+
+ TFSInfo = record
+ case word of
+ 1:
+ (File_Sys_ID,
+ Sectors_Per_Cluster,
+ Total_Clusters,
+ Free_Clusters: cardinal;
+ Bytes_Per_Sector: word);
+ 2: {For date/time description,
+ see file searching realted
+ routines.}
+ (Label_Date, {Date when volume label was created.}
+ Label_Time: word; {Time when volume label was created.}
+ VolumeLabel: ShortString); {Volume label. Can also be used
+ as ASCIIZ, because the byte
+ following the last character of
+ the string is always zero.}
+ end;
+ PFSInfo = ^TFSInfo;
+
+ TCountryCode=record
+ Country, {Country to query info about (0=current).}
+ CodePage: cardinal; {Code page to query info about (0=current).}
+ end;
+ PCountryCode=^TCountryCode;
+
+ TTimeFmt = (Clock12, Clock24);
+
+ TCountryInfo=record
+ Country, CodePage: cardinal; {Country and codepage requested.}
+ case byte of
+ 0:
+ (DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
+ CurrencyUnit: array [0..4] of char;
+ ThousandSeparator: char; {Thousands separator.}
+ Zero1: byte; {Always zero.}
+ DecimalSeparator: char; {Decimals separator,}
+ Zero2: byte;
+ DateSeparator: char; {Date separator.}
+ Zero3: byte;
+ TimeSeparator: char; {Time separator.}
+ Zero4: byte;
+ CurrencyFormat, {Bit field:
+ Bit 0: 0=indicator before value
+ 1=indicator after value
+ Bit 1: 1=insert space after
+ indicator.
+ Bit 2: 1=Ignore bit 0&1, replace
+ decimal separator with
+ indicator.}
+ DecimalPlace: byte; {Number of decimal places used in
+ currency indication.}
+ TimeFormat: TTimeFmt; {12/24 hour.}
+ Reserve1: array [0..1] of word;
+ DataSeparator: char; {Data list separator}
+ Zero5: byte;
+ Reserve2: array [0..4] of word);
+ 1:
+ (fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
+ szCurrency: array [0..4] of char;
+ {null terminated currency symbol}
+ szThousandsSeparator: array [0..1] of char;
+ {Thousands separator + #0}
+ szDecimal: array [0..1] of char;
+ {Decimals separator + #0}
+ szDateSeparator: array [0..1] of char;
+ {Date separator + #0}
+ szTimeSeparator: array [0..1] of char;
+ {Time separator + #0}
+ fsCurrencyFmt, {Bit field:
+ Bit 0: 0=indicator before value
+ 1=indicator after value
+ Bit 1: 1=insert space after
+ indicator.
+ Bit 2: 1=Ignore bit 0&1, replace
+ decimal separator with
+ indicator}
+ cDecimalPlace: byte; {Number of decimal places used in
+ currency indication}
+ fsTimeFmt: byte; {0=12,1=24 hours}
+ abReserved1: array [0..1] of word;
+ szDataSeparator: array [0..1] of char;
+ {Data list separator + #0}
+ abReserved2: array [0..4] of word);
+ end;
+ PCountryInfo=^TCountryInfo;
+
+ TRequestData=record
+ PID, {ID of process that wrote element.}
+ Data: cardinal; {Information from process writing the data.}
+ end;
+ PRequestData=^TRequestData;
+
+{Queue data structure for synchronously started sessions.}
+ TChildInfo = record
+ case boolean of
+ false:
+ (SessionID,
+ Return: word); {Return code from the child process.}
+ true:
+ (usSessionID,
+ usReturn: word); {Return code from the child process.}
+ end;
+ PChildInfo = ^TChildInfo;
+
+ TStartData=record
+ {Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
+ Length:word; {Length, in bytes, of datastructure
+ (24/30/32/50/60).}
+ Related:word; {Independent/child session (0/1).}
+ FgBg:word; {Foreground/background (0/1).}
+ TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
+ PgmTitle:PChar; {Program title.}
+ PgmName:PChar; {Filename to program.}
+ PgmInputs:PChar; {Command parameters (nil allowed).}
+ TermQ:PChar; {System queue. (nil allowed).}
+ Environment:PChar; {Environment to pass (nil allowed).}
+ InheritOpt:word; {Inherit enviroment from shell/
+ inherit environment from parent (0/1).}
+ SessionType:word; {Auto/full screen/window/presentation
+ manager/full screen Dos/windowed Dos
+ (0/1/2/3/4/5/6/7).}
+ Iconfile:PChar; {Icon file to use (nil allowed).}
+ PgmHandle:cardinal; {0 or the program handle.}
+ PgmControl:word; {Bitfield describing initial state
+ of windowed sessions.}
+ InitXPos,InitYPos:word; {Initial top coordinates.}
+ InitXSize,InitYSize:word; {Initial size.}
+ Reserved:word;
+ ObjectBuffer:PChar; {If a module cannot be loaded, its
+ name will be returned here.}
+ ObjectBuffLen:cardinal; {Size of your buffer.}
+ end;
+ PStartData=^TStartData;
+
+ TResultCodes=record
+ TerminateReason, {0 = Normal termionation.
+ 1 = Critical error.
+ 2 = Trapped. (GPE, etc.)
+ 3 = Killed by DosKillProcess.}
+ ExitCode:cardinal; {Exit code of child.}
+ end;
+
+const
+ ilStandard = 1;
+ ilQueryEAsize = 2;
+ ilQueryEAs = 3;
+ ilQueryFullName = 5;
+
+ quFIFO = 0;
+ quLIFO = 1;
+ quPriority = 2;
+
+ quNoConvert_Address = 0;
+ quConvert_Address = 4;
+
+{Start the new session independent or as a child.}
+ ssf_Related_Independent = 0; {Start new session independent
+ of the calling session.}
+ ssf_Related_Child = 1; {Start new session as a child
+ session to the calling session.}
+
+{Start the new session in the foreground or in the background.}
+ ssf_FgBg_Fore = 0; {Start new session in foreground.}
+ ssf_FgBg_Back = 1; {Start new session in background.}
+
+{Should the program started in the new session
+ be executed under conditions for tracing?}
+ ssf_TraceOpt_None = 0; {No trace.}
+ ssf_TraceOpt_Trace = 1; {Trace with no notification
+ of descendants.}
+ ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
+ A termination queue must be
+ supplied and Related must be
+ ssf_Related_Child (=1).}
+
+{Will the new session inherit open file handles
+ and environment from the calling process.}
+ ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
+ ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
+
+{Specifies the type of session to start.}
+ ssf_Type_Default = 0; {Use program's type.}
+ ssf_Type_FullScreen = 1; {OS/2 full screen.}
+ ssf_Type_WindowableVIO = 2; {OS/2 window.}
+ ssf_Type_PM = 3; {Presentation Manager.}
+ ssf_Type_VDM = 4; {DOS full screen.}
+ ssf_Type_WindowedVDM = 7; {DOS window.}
+{Additional values for Windows programs}
+ Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
+ own windowed session.}
+ Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
+ common windowed session.}
+ Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
+ compatibility mode in its own
+ windowed session.}
+ Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
+ compatibility mode in a common
+ windowed session.}
+ Prog_31_Enh = 19; {Windows 3.1 program in enhanced
+ compatibility mode in a full
+ screen session.}
+ Prog_31_Std = 20; {Windows 3.1 program in a full
+ screen session.}
+
+{Specifies the initial attributes for a OS/2 window or DOS window session.}
+ ssf_Control_Visible = 0; {Window is visible.}
+ ssf_Control_Invisible = 1; {Window is invisible.}
+ ssf_Control_Maximize = 2; {Window is maximized.}
+ ssf_Control_Minimize = 4; {Window is minimized.}
+ ssf_Control_NoAutoClose = 8; {Window will not close after
+ the program has ended.}
+ ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
+ InitXSize, and InitYSize for
+ the size and placement.}
+
+
+function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
+
+function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
+ BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
+
+function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 279;
+
+function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
+ external 'DOSCALLS' index 227;
+
+function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
+ AFileStatus: PFileStatus; FileStatusLen: cardinal;
+ var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 264;
+
+function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
+ FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 265;
+
+function DosFindClose (Handle: THandle): cardinal; cdecl;
+ external 'DOSCALLS' index 263;
+
+function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
+ var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
+ external 'NLS' index 5;
+
+function DosMapCase (Size: cardinal; var Country: TCountryCode;
+ AString: PChar): cardinal; cdecl; external 'NLS' index 7;
+
+function DosDelete(FileName:PChar): cardinal; cdecl;
+ external 'DOSCALLS' index 259;
+
+function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
+ external 'DOSCALLS' index 271;
+
+function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
+ AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 223;
+
+function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
+ AFileStatus:PFileStatus;FileStatusLen,
+ Options:cardinal):cardinal; cdecl;
+ external 'DOSCALLS' index 219;
+
+function DosOpen(FileName:PChar;var Handle: THandle; var Action: cardinal;
+ InitSize,Attrib,OpenFlags,FileMode:cardinal;
+ EA:Pointer):cardinal; cdecl;
+ external 'DOSCALLS' index 273;
+
+function DosClose(Handle: THandle): cardinal; cdecl;
+ external 'DOSCALLS' index 257;
+
+function DosRead(Handle:THandle; var Buffer; Count: cardinal;
+ var ActCount: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 281;
+
+function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
+ var ActCount: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 282;
+
+function DosSetFilePtr(Handle: THandle; Pos: longint; Method: cardinal;
+ var PosActual: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 256;
+
+function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 272;
+
+procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
+
+function DosCreateQueue (var Handle: THandle; Priority:longint;
+ Name: PChar): cardinal; cdecl;
+ external 'QUECALLS' index 16;
+
+function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
+ var DataLen: cardinal; var DataPtr: pointer;
+ Element, Wait: cardinal; var Priority: byte;
+ ASem: THandle): cardinal; cdecl;
+ external 'QUECALLS' index 9;
+
+function DosCloseQueue (Handle: THandle): cardinal; cdecl;
+ external 'QUECALLS' index 11;
+
+function DosStartSession (var AStartData: TStartData;
+ var SesID, PID: cardinal): cardinal; cdecl;
+ external 'SESMGR' index 37;
+
+function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
+
+function DosExecPgm (ObjName: PChar; ObjLen: longint; ExecFlag: cardinal;
+ Args, Env: PByteArray; var Res: TResultCodes;
+ FileName:PChar): cardinal; cdecl;
+ external 'DOSCALLS' index 283;
+
+type
+ TDT=packed record
+ Hour,
+ Minute,
+ Second,
+ Sec100,
+ Day,
+ Month: byte;
+ Year: word;
+ TimeZone: smallint;
+ WeekDay: byte;
+ end;
+
+function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
+ external 'DOSCALLS' index 230;
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+const
+ ofRead = $0000; {Open for reading}
+ ofWrite = $0001; {Open for writing}
+ ofReadWrite = $0002; {Open for reading/writing}
+ doDenyRW = $0010; {DenyAll (no sharing)}
+ faCreateNew = $00010000; {Create if file does not exist}
+ faOpenReplace = $00040000; {Truncate if file exists}
+ faCreate = $00050000; {Create if file does not exist, truncate otherwise}
+
+ FindResvdMask = $00003737; {Allowed bits in attribute
+ specification for DosFindFirst call.}
+
+function FileOpen (const FileName: string; Mode: integer): longint;
+Var
+ Handle: THandle;
+ Rc, Action: cardinal;
+begin
+(* DenyNone if sharing not specified. *)
+ if Mode and 112 = 0 then Mode:=Mode or 64;
+ Rc:=DosOpen(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil);
+ If Rc=0 then
+ FileOpen:=Handle
+ else
+ FileOpen:=-RC;
+end;
+
+function FileCreate (const FileName: string): longint;
+Const
+ Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
+Var
+ Handle: THandle;
+ RC, Action: cardinal;
+Begin
+ RC:=DosOpen(PChar (FileName), Handle, Action, 0, 0, $12, Mode, Nil);
+ If RC=0 then
+ FileCreate:=Handle
+ else
+ FileCreate:=-RC;
+End;
+
+function FileCreate (const FileName: string; Mode: integer): longint;
+begin
+ FileCreate := FileCreate(FileName);
+end;
+
+
+function FileRead (Handle: longint; var Buffer; Count: longint): longint;
+Var
+ T: cardinal;
+begin
+ DosRead(Handle, Buffer, Count, T);
+ FileRead := longint (T);
+end;
+
+function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
+Var
+ T: cardinal;
+begin
+ DosWrite (Handle, @Buffer, Count, T);
+ FileWrite := longint (T);
+end;
+
+function FileSeek (Handle, FOffset, Origin: longint): longint;
+var
+ npos: cardinal;
+begin
+ if DosSetFilePtr (Handle, FOffset, Origin, npos) = 0 Then
+ FileSeek:= longint (npos)
+ else
+ FileSeek:=-1;
+end;
+
+function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
+begin
+ {$warning need to add 64bit call }
+ Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
+end;
+
+procedure FileClose (Handle: longint);
+begin
+ DosClose(Handle);
+end;
+
+function FileTruncate (Handle, Size: longint): boolean;
+begin
+ FileTruncate:=DosSetFileSize(Handle, Size)=0;
+ FileSeek(Handle, 0, 2);
+end;
+
+function FileAge (const FileName: string): longint;
+var Handle: longint;
+begin
+ Handle := FileOpen (FileName, 0);
+ if Handle <> -1 then
+ begin
+ Result := FileGetDate (Handle);
+ FileClose (Handle);
+ end
+ else
+ Result := -1;
+end;
+
+
+function FileExists (const FileName: string): boolean;
+var
+ SR: TSearchRec;
+ RC: longint;
+begin
+ FileExists:=False;
+ if FindFirst (FileName, faAnyFile, SR)=0 then FileExists:=True;
+ FindClose(SR);
+end;
+
+type TRec = record
+ T, D: word;
+ end;
+ PSearchRec = ^SearchRec;
+
+function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;
+
+var SR: PSearchRec;
+ FStat: PFileFindBuf3;
+ Count: cardinal;
+ Err: cardinal;
+ I: cardinal;
+
+begin
+ New (FStat);
+ Rslt.FindHandle := $FFFFFFFF;
+ Count := 1;
+ Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
+ Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
+ if (Err = 0) and (Count = 0) then Err := 18;
+ FindFirst := -Err;
+ if Err = 0 then
+ begin
+ Rslt.Name := FStat^.Name;
+ Rslt.Size := FStat^.FileSize;
+ Rslt.Attr := FStat^.AttrFile;
+ Rslt.ExcludeAttr := 0;
+ TRec (Rslt.Time).T := FStat^.TimeLastWrite;
+ TRec (Rslt.Time).D := FStat^.DateLastWrite;
+ end;
+ Dispose (FStat);
+end;
+
+
+function FindNext (var Rslt: TSearchRec): longint;
+var
+ SR: PSearchRec;
+ FStat: PFileFindBuf3;
+ Count: cardinal;
+ Err: cardinal;
+begin
+ New (FStat);
+ Count := 1;
+ Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
+ Count);
+ if (Err = 0) and (Count = 0) then Err := 18;
+ FindNext := -Err;
+ if Err = 0 then
+ begin
+ Rslt.Name := FStat^.Name;
+ Rslt.Size := FStat^.FileSize;
+ Rslt.Attr := FStat^.AttrFile;
+ Rslt.ExcludeAttr := 0;
+ TRec (Rslt.Time).T := FStat^.TimeLastWrite;
+ TRec (Rslt.Time).D := FStat^.DateLastWrite;
+ end;
+ Dispose (FStat);
+end;
+
+
+procedure FindClose (var F: TSearchrec);
+var
+ SR: PSearchRec;
+begin
+ DosFindClose (F.FindHandle);
+ F.FindHandle := 0;
+end;
+
+function FileGetDate (Handle: longint): longint;
+var
+ FStat: TFileStatus3;
+ Time: Longint;
+begin
+ DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
+ if DosError=0 then
+ begin
+ Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
+ if Time = 0 then
+ Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
+ end else
+ Time:=0;
+ FileGetDate:=Time;
+end;
+
+function FileSetDate (Handle, Age: longint): longint;
+var
+ FStat: PFileStatus3;
+ RC: cardinal;
+begin
+ New (FStat);
+ RC := DosQueryFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
+ if RC <> 0 then
+ FileSetDate := -1
+ else
+ begin
+ FStat^.DateLastAccess := Hi (Age);
+ FStat^.DateLastWrite := Hi (Age);
+ FStat^.TimeLastAccess := Lo (Age);
+ FStat^.TimeLastWrite := Lo (Age);
+ RC := DosSetFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^));
+ if RC <> 0 then
+ FileSetDate := -1
+ else
+ FileSetDate := 0;
+ end;
+ Dispose (FStat);
+end;
+
+function FileGetAttr (const FileName: string): longint;
+var
+ FS: PFileStatus3;
+begin
+ New(FS);
+ Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^));
+ If Result=0 Then Result:=FS^.attrFile;
+ Dispose(FS);
+end;
+
+function FileSetAttr (const Filename: string; Attr: longint): longint;
+Var
+ FS: PFileStatus3;
+Begin
+ New(FS);
+ FillChar(FS, SizeOf(FS^), 0);
+ FS^.AttrFile:=Attr;
+ Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0);
+ Dispose(FS);
+end;
+
+
+function DeleteFile (const FileName: string): boolean;
+Begin
+ Result:=(DosDelete(PChar (FileName))=0);
+End;
+
+function RenameFile (const OldName, NewName: string): boolean;
+Begin
+ Result:=(DosMove(PChar (OldName), PChar (NewName))=0);
+End;
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+function DiskFree (Drive: byte): int64;
+
+var FI: TFSinfo;
+ RC: cardinal;
+
+begin
+ {In OS/2, we use the filesystem information.}
+ RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskFree := int64 (FI.Free_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskFree := -1;
+end;
+
+function DiskSize (Drive: byte): int64;
+
+var FI: TFSinfo;
+ RC: cardinal;
+
+begin
+ {In OS/2, we use the filesystem information.}
+ RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+ if RC = 0 then
+ DiskSize := int64 (FI.Total_Clusters) *
+ int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+ else
+ DiskSize := -1;
+end;
+
+
+function GetCurrentDir: string;
+begin
+ GetDir (0, Result);
+end;
+
+
+function SetCurrentDir (const NewDir: string): boolean;
+begin
+{$I-}
+{$WARNING Should be rewritten to avoid unit dos dependancy!}
+ ChDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function CreateDir (const NewDir: string): boolean;
+begin
+{$I-}
+{$WARNING Should be rewritten to avoid unit dos dependancy!}
+ MkDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function RemoveDir (const Dir: string): boolean;
+begin
+{$I-}
+{$WARNING Should be rewritten to avoid unit dos dependancy!}
+ RmDir (Dir);
+ Result := (IOResult = 0);
+ {$I+}
+end;
+
+
+function DirectoryExists (const Directory: string): boolean;
+var
+ SR: TSearchRec;
+begin
+ DirectoryExists:=FindFirst(Directory, faDirectory, SR)=0;
+ FindClose(SR);
+end;
+
+{****************************************************************************
+ Time Functions
+****************************************************************************}
+
+procedure GetLocalTime (var SystemTime: TSystemTime);
+var
+ DT: TDT;
+begin
+ DosGetDateTime(DT);
+ with SystemTime do
+ begin
+ Year:=DT.Year;
+ Month:=DT.Month;
+ Day:=DT.Day;
+ Hour:=DT.Hour;
+ Minute:=DT.Minute;
+ Second:=DT.Second;
+ MilliSecond:=DT.Sec100;
+ end;
+end;
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+procedure InitAnsi;
+var I: byte;
+ Country: TCountryCode;
+begin
+ for I := 0 to 255 do
+ UpperCaseTable [I] := Chr (I);
+ Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
+ FillChar (Country, SizeOf (Country), 0);
+ DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
+ for I := 0 to 255 do
+ if UpperCaseTable [I] <> Chr (I) then
+ LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
+end;
+
+
+procedure InitInternational;
+var Country: TCountryCode;
+ CtryInfo: TCountryInfo;
+ Size: cardinal;
+ RC: cardinal;
+begin
+ Size := 0;
+ FillChar (Country, SizeOf (Country), 0);
+ FillChar (CtryInfo, SizeOf (CtryInfo), 0);
+ RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
+ if RC = 0 then
+ begin
+ DateSeparator := CtryInfo.DateSeparator;
+ case CtryInfo.DateFormat of
+ 1: begin
+ ShortDateFormat := 'd/m/y';
+ LongDateFormat := 'dd" "mmmm" "yyyy';
+ end;
+ 2: begin
+ ShortDateFormat := 'y/m/d';
+ LongDateFormat := 'yyyy" "mmmm" "dd';
+ end;
+ 3: begin
+ ShortDateFormat := 'm/d/y';
+ LongDateFormat := 'mmmm" "dd" "yyyy';
+ end;
+ end;
+ TimeSeparator := CtryInfo.TimeSeparator;
+ DecimalSeparator := CtryInfo.DecimalSeparator;
+ ThousandSeparator := CtryInfo.ThousandSeparator;
+ CurrencyFormat := CtryInfo.CurrencyFormat;
+ CurrencyString := PChar (CtryInfo.CurrencyUnit);
+ end;
+ InitAnsi;
+ InitInternationalGeneric;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+
+{****************************************************************************
+ OS Utils
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
+end;
+
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+(* Result:=FPCCountEnvVar(EnvP); - the amount is already known... *)
+ GetEnvironmentVariableCount := EnvC;
+end;
+
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ Result:=FPCGetEnvStrFromP (EnvP, Index);
+end;
+
+
+procedure Sleep (Milliseconds: cardinal);
+
+begin
+ DosSleep (Milliseconds);
+end;
+
+
+function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
+ integer;
+var
+ HQ: THandle;
+ SPID, STID, QName: shortstring;
+ SD: TStartData;
+ SID, PID: cardinal;
+ RD: TRequestData;
+ PCI: PChildInfo;
+ CISize: cardinal;
+ Prio: byte;
+ E: EOSError;
+ CommandLine: ansistring;
+ Args: PByteArray;
+ ObjNameBuf: PChar;
+ ArgSize: word;
+ Res: TResultCodes;
+ ObjName: shortstring;
+
+const
+ MaxArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
+ ObjBufSize = 512;
+
+begin
+ ObjName := '';
+ GetMem (ObjNameBuf, ObjBufSize);
+ FillChar (ObjNameBuf^, ObjBufSize, 0);
+ if ComLine = '' then
+ Args := nil
+ else
+ begin
+ GetMem (Args, MaxArgsSize);
+ ArgSize := 0;
+ Move (Path [1], Args^ [ArgSize], Length (Path));
+ Inc (ArgSize, Length (Path));
+ Args^ [ArgSize] := 0;
+ Inc (ArgSize);
+ {Now do the real arguments.}
+ Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
+ Inc (ArgSize, Length (ComLine));
+ Args^ [ArgSize] := 0;
+ Inc (ArgSize);
+ Args^ [ArgSize] := 0;
+ end;
+ Result := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res, PChar (Path));
+ if Args <> nil then
+ FreeMem (Args, MaxArgsSize);
+ if Result = 0 then
+ begin
+ Result := Res.ExitCode;
+ FreeMem (ObjNameBuf, ObjBufSize);
+ end
+ else
+ begin
+ if (Result = 190) or (Result = 191) then
+ begin
+ FillChar (SD, SizeOf (SD), 0);
+ SD.Length := 24;
+ SD.Related := ssf_Related_Child;
+ CommandLine := FExpand (Path); (* Needed for other session types... *)
+ SD.PgmName := PChar (CommandLine);
+ if ComLine <> '' then
+ SD.PgmInputs := PChar (ComLine);
+ SD.InheritOpt := ssf_InhertOpt_Parent;
+ Str (GetProcessID, SPID);
+ Str (ThreadID, STID);
+ QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
+ SD.TermQ := @QName [1];
+ Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
+ if Result = 0 then
+ begin
+ Result := DosStartSession (SD, SID, PID);
+ if (Result = 0) or (Result = 457) then
+ begin
+ Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
+ if Result = 0 then
+ begin
+ Result := PCI^.Return;
+ DosCloseQueue (HQ);
+ DosFreeMem (PCI);
+ Exit;
+ end;
+ end;
+ DosCloseQueue (HQ);
+ end;
+ end
+ else
+ ObjName := StrPas (ObjNameBuf);
+ FreeMem (ObjNameBuf, ObjBufSize);
+ if ComLine = '' then
+ CommandLine := Path
+ else
+ CommandLine := Path + ' ' + ComLine;
+ if ObjName = '' then
+ E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result])
+ else
+ E := EOSError.CreateFmt (SExecuteProcessFailed + '(' + ObjName + ')', [CommandLine, Result]);
+ E.ErrorCode := Result;
+ raise E;
+ end;
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+Finalization
+ DoneExceptions;
+end.
+
+{
+ $Log: sysutils.pp,v $
+ Revision 1.50 2005/03/01 23:27:57 hajny
+ * SysLocale initialized to empty for OS/2 too - probably wrong for DBCS versions
+
+ Revision 1.49 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/tests/atx.pas b/rtl/os2/tests/atx.pas
new file mode 100644
index 0000000000..2b7b0c549e
--- /dev/null
+++ b/rtl/os2/tests/atx.pas
@@ -0,0 +1,15 @@
+program atx;
+
+var f:text;
+ s:string;
+
+begin
+ assign(f,'c:\autoexec.bat');
+ reset(f);
+ while not eof(f) do
+ begin
+ readln(f,s);
+ writeln(s);
+ end;
+ close(f);
+end.
diff --git a/rtl/os2/tests/basicpm.pas b/rtl/os2/tests/basicpm.pas
new file mode 100644
index 0000000000..4d34f76843
--- /dev/null
+++ b/rtl/os2/tests/basicpm.pas
@@ -0,0 +1,62 @@
+program BasicPM;
+
+uses
+ Os2Def, PMWin;
+
+function ClientWindowProc (Window, Msg: cardinal; MP1, MP2: pointer): pointer;
+ cdecl; export;
+var
+ Li: longint;
+ Ps: cardinal;
+ R: TRectL;
+ P: TPointL;
+ Rgn: cardinal;
+begin
+ ClientWindowProc := nil;
+ case Msg of
+ wm_Paint: begin
+ PS := WinBeginPaint (Window, 0, @R);
+ WinFillRect (PS, @R, SYSCLR_WINDOW);
+ WinEndPaint (PS);
+ end;
+ else ClientWindowProc := WinDefWindowProc (Window, Msg, MP1, MP2);
+ end;
+end;
+
+const
+ idClientWindow = 11000;
+ WinFlags: cardinal = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder +
+ fcf_MinMax + fcf_TaskList + fcf_NoByteAlign;
+ ClassName = 'MYVIEW';
+
+var
+ Anchor, MsgQue: cardinal;
+ Message: TQMsg;
+ Frame, Client: cardinal;
+begin
+ Anchor := WinInitialize(0);
+ { It might be beneficial to set the second parameter of the following }
+ { call to something large, such as 1000. The OS/2 documentation does }
+ { not recommend this, however } MsgQue := WinCreateMsgQueue (Anchor, 0);
+ if MsgQue = 0 then Halt (254);
+
+ WinMessageBox (HWND_DESKTOP, HWND_DESKTOP, 'FPC test', 'BASIC PM', 0,
+ MB_OK or MB_INFORMATION);
+
+ WinRegisterClass (Anchor, ClassName, proc (@ClientWindowProc), cs_SizeRedraw,
+ SizeOf (pointer));
+ Frame := WinCreateStdWindow (hwnd_Desktop, 0, WinFlags, ClassName,
+ 'BASIC PM', 0, 0, idClientWindow, Client);
+ if (Frame <> 0) then
+ begin
+ WinSetWindowPos (Frame, 0, 0, WinQuerySysValue (hwnd_Desktop,
+ sv_CyScreen) - 200, 200, 200, swp_Move + swp_Size + swp_Activate +
+ swp_Show);
+ while WinGetMsg (Anchor, Message, 0, 0, 0) do
+ WinDispatchMsg (Anchor, Message);
+
+ WinDestroyWindow (Frame);
+ end;
+ WinDestroyMsgQueue (MsgQue);
+ WinTerminate (Anchor);
+end.
diff --git a/rtl/os2/tests/calc_e.pas b/rtl/os2/tests/calc_e.pas
new file mode 100644
index 0000000000..28165f700f
--- /dev/null
+++ b/rtl/os2/tests/calc_e.pas
@@ -0,0 +1,15 @@
+program calc_e;
+
+{Calculate the number e.}
+
+const fac:array[0..7] of word=(1,1,2,6,24,120,720,5040);
+
+var e:fixed;
+ i:byte;
+
+begin
+ e:=0;
+ for i:=0 to 7 do
+ e:=e+fixed(1)/fac[i];
+ writeln(e);
+end.
diff --git a/rtl/os2/tests/generic.pas b/rtl/os2/tests/generic.pas
new file mode 100644
index 0000000000..1ae17d027b
--- /dev/null
+++ b/rtl/os2/tests/generic.pas
@@ -0,0 +1,61 @@
+{****************************************************************************
+
+ Copyright (c) 1999-2000 by Florian Kl„mpfl
+
+ ****************************************************************************}
+
+{ Generisches OS/2-Programm }
+
+program generic;
+
+ uses
+ os2def,pmwin,bsedos;
+
+ function clientwndproc(window : HWND;msg : longint;mp1,mp2 : MParam) :
+ MResult;export;
+
+ var
+ ps : HPS;
+ rcl : RECTL;
+
+ begin
+ clientwndproc:=nil;
+ case msg of
+ WM_CREATE : ;
+ WM_PAINT : ;
+ WM_COMMAND : ;
+ else clientwndproc:=WinDefWindowProc(window,msg,mp1,mp2);
+ end;
+ end;
+
+ var
+ frame,client : HWND;
+ ab : HAB;
+ mq : HMQ;
+ msg : QMSG;
+
+ const
+ frameflags : longint = FCF_TITLEBAR+
+ FCF_SYSMENU+
+ FCF_SIZEBORDER+
+ FCF_MINBUTTON+
+ FCF_MAXBUTTON+
+ FCF_SHELLPOSITION+
+ FCF_TASKLIST+
+ FCF_MENU;
+
+ winclass = 'GENERIC';
+ wintitle = '';
+
+ begin
+ ab:=WinInitialize(0);
+ mq:=WinCreateMsgQueue(ab,0);
+ WinRegisterClass(ab,winclass,@clientwndproc,4,0);
+ frame:=WinCreateStdWindow(HWND(1),WS_VISIBLE,@frameflags,winclass,
+ wintitle,WS_VISIBLE,0,1,@client);
+ while (WinGetMsg(ab,@msg,0,0,0)<>0) do
+ WinDispatchMsg(ab,@msg);
+ WinDestroyWindow(frame);
+ WinDestroyMsgQueue(mq);
+ WinTerminate(ab);
+ end.
diff --git a/rtl/os2/tests/getctry.pas b/rtl/os2/tests/getctry.pas
new file mode 100644
index 0000000000..aa3c733788
--- /dev/null
+++ b/rtl/os2/tests/getctry.pas
@@ -0,0 +1,62 @@
+program GetCountryInfo;
+
+{$IFNDEF OS2}
+ Sorry, this code is for OS/2 only...
+{$ENDIF}
+
+uses
+{$IFDEF FPC}
+ DosCalls;
+{$ELSE}
+ Os2Def,
+ {$IFDEF VIRTUALPASCAL}
+ Os2Base;
+ {$ELSE}
+ {$IFDEF SPEED}
+ BseDos;
+ {$ELSE}
+ DosProcs, DosTypes;
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+type
+ cardinal = longint;
+
+{$IFDEF FPC}
+const
+ NO_ERROR = 0;
+{$ENDIF}
+
+var
+{$IFDEF VER70} (* patched Borland Pascal *)
+ Country: TCountryCode;
+ CtryInfo: TCountryInfo;
+ Size: longint;
+{$ELSE}
+ Country: COUNTRYCODE; (* Country code info (0 = current country) *)
+ CtryInfo: COUNTRYINFO; (* Buffer for country-specific information *)
+ Size: cardinal; (* Real size of returned data *)
+{$ENDIF}
+ W: word;
+
+begin
+ WriteLn;
+ Size := 0;
+ FillChar (Country, SizeOf (Country), 0);
+ FillChar (CtryInfo, SizeOf (CtryInfo), 0);
+ W :=
+{$IFDEF VER70}
+ DosGetCtryInfo
+{$ELSE}
+ DosQueryCtryInfo
+{$ENDIF}
+ (SizeOf (CtryInfo), Country, CtryInfo, Size);
+ if (W <> NO_ERROR) then
+ begin
+ WriteLn ('DosQueryCtryInfo error: return code = ', W);
+ Halt (1);
+ end;
+ WriteLn ('Code of the country is ', CtryInfo.Country,
+ ', current codepage is ', CtryInfo.CodePage);
+end.
diff --git a/rtl/os2/tests/heapsize.pas b/rtl/os2/tests/heapsize.pas
new file mode 100644
index 0000000000..3df5e17834
--- /dev/null
+++ b/rtl/os2/tests/heapsize.pas
@@ -0,0 +1,25 @@
+program heapsize;
+
+var a:longint;
+
+procedure writeheapsize;
+
+begin
+ asm
+ movl $0x7f00,%ax
+ xorl %edx,%edx
+ call ___syscall
+ mov %eax,_A
+ end;
+ writeln(a);
+end;
+
+begin
+ writeheapsize;
+ asm
+ movl $0x7f00,%ax
+ movl $327680,%edx
+ call ___syscall
+ end;
+ writeheapsize;
+end.
diff --git a/rtl/os2/tests/helloos2.pas b/rtl/os2/tests/helloos2.pas
new file mode 100644
index 0000000000..82fdc4bf99
--- /dev/null
+++ b/rtl/os2/tests/helloos2.pas
@@ -0,0 +1,25 @@
+program HelloOS2;
+
+var A,B: ^word;
+
+begin
+ WriteLn ('Hello World.');
+ case os_mode of
+ osDOS: WriteLn ('Running under DOS.');
+ osDPMI: WriteLn ('Running under DPMI (RSX extender).');
+ else WriteLn ('Running under OS/2.');
+ end;
+ WriteLn ('Free memory: ', MemAvail);
+ WriteLn ('Largest block: ', MaxAvail);
+ WriteLn ('Heap start: ',longint(heaporg));
+ WriteLn ('Heap end: ',longint(heapend));
+ WriteLn ('Memory allocation.');
+ GetMem (A, 1000);
+ GetMem (B, 2000);
+ A^ := 2;
+ B^ := 10;
+ WriteLn ('Free memory: ', MemAvail);
+ WriteLn ('Largest block: ', MaxAvail);
+ FreeMem (A, 1000);
+ FreeMem (B, 2000);
+end.
diff --git a/rtl/os2/tests/modeinfo.pas b/rtl/os2/tests/modeinfo.pas
new file mode 100644
index 0000000000..0832b6deee
--- /dev/null
+++ b/rtl/os2/tests/modeinfo.pas
@@ -0,0 +1,42 @@
+program modeinfo;
+
+type viomodeinfo=record
+ cb:word; { length of the entire data structure }
+ fbType, { bit mask of mode being set }
+ color: byte; { number of colors (power of 2) }
+ col, { number of text columns }
+ row, { number of text rows }
+ hres, { horizontal resolution }
+ vres: word; { vertical resolution }
+ fmt_ID, { attribute format }
+ attrib: byte; { number of attributes }
+ buf_addr,
+ buf_length,
+ full_length,
+ partial_length:longint;
+ ext_data_addr:pointer;
+ end;
+ Pviomodeinfo=^viomodeinfo;
+
+function _VioGetMode (var Amodeinfo:viomodeinfo;viohandle:word):word;[C];
+function _VioSetMode (var Amodeinfo:viomodeinfo;viohandle:word):word;[C];
+
+var mode:viomodeinfo;
+
+begin
+ mode.cb:=sizeof(mode);
+ writeln('getmode= ',_viogetmode(mode,0));
+ writeln('cb= ',mode.cb);
+ writeln('fbtype= ',mode.fbtype);
+ writeln('color= ',mode.color);
+ writeln('col= ',mode.col);
+ writeln('row= ',mode.row);
+ writeln('hres= ',mode.hres);
+ writeln('vres= ',mode.vres);
+ writeln('fmt_ID= ',mode.fmt_ID);
+ writeln('attrib= ',mode.attrib);
+ writeln('buf_addr= ',mode.buf_addr);
+ writeln('buf_length= ',mode.buf_length);
+ writeln('full_length= ',mode.full_length);
+ writeln('partial_length= ',mode.partial_length);
+end.
diff --git a/rtl/os2/tests/o2rtlb1.pas b/rtl/os2/tests/o2rtlb1.pas
new file mode 100644
index 0000000000..1c399213b0
--- /dev/null
+++ b/rtl/os2/tests/o2rtlb1.pas
@@ -0,0 +1,83 @@
+program testread;
+{uses crt;}
+var
+ cadena,cadena2 : string;
+ number : real;
+begin
+ {clrscr;}
+ cadena2 := 'Previous string';
+ write ('Enter the string ');
+ readln (cadena);
+ writeln ('You entered ',cadena);
+ writeln ('Previous string was ',cadena2);
+ write ('Enter a number ');
+ readln (number);
+ writeln ('Number entered was ',number);
+ readln;
+end.
+
+{(I have retyped now because my computer is not connected to the net, but I
+think that there are no errors).
+
+Now you can do some tests:
+
+1- Compile and run the program as is (that is, using crt). You will find that
+ a) the program does not erase the screen (that is normal because we have
+commented clrscr), but the cursor goes to the first line, thus overwriting the
+screen.
+ b) While the program is expecting the string to be entered, some of the keys
+do not work correctly: Backspace advances some spaces (just like tab), tab key
+does not work and the cursor keys write garbage. (however this is only in the
+screen, because if you have erased a part of the string it will be actually
+erased).
+ c) Once you have press return, the message 'You entered...' appears in the
+same line as the text entered.
+
+2- Uncomment the clrscr call, cokpile and execute. Point a of test 1 will be
+solved (the screen is erased, so nothing is overwritten), but points b and c
+persist.
+
+3- Comment 'uses crt' and 'clrscr'. Now you will not be using crt. Now:
+ a) Point a of test 1 does not appear: the program begins to write in the
+next line, it does not overwrite anything.
+ b) Now all the keys (tab, backspace..) work as expected.
+ c) Now the message 'You entered...' appears in the following line, so point
+c of test 1 is also solved.
+ d) BUT it writes only 'You entered', WITHOUT writing the string cadena (!).
+It writes also 'Previous string was previous string', so the problem is in
+readln and not in writeln.
+
+4- To see if the problem is only in the string vars, uncomment the definition
+of number, and also the three lines at the end that deal with number. Now ld
+gives the following error message:
+
+testread.pp:0 (testread.o): undefined symbol READ_TEXT_INTEGER referenced from
+text segment.
+
+This error happens with 'uses crt' and also without it.
+
+5- Define number as word. Regardless of crt we get the following error from ld:
+
+testread.pp:0 (testread.o): undefined symbol READ_TEXT_WORD referenced from
+text segment.
+
+6- Uncomment 'uses crt' if it was commented, and change the definition of
+number as real. The program will compile, and it will print the number,
+although in the same line as the input.
+
+7- Finally, comment 'uses crt' again. This time it will also compile and link,
+but it gives a runtime error!
+
+Laufzeitfehler 106 bei 66422
+
+This error is shown before printing the number.
+
+I expect that these bug report will be useful to debug the RTL. Tonight I will
+try to work in the blockwrite problem.
+
+Best regards
+
+Ramon
+
+--
+}
diff --git a/rtl/os2/tests/pmdemo1.def b/rtl/os2/tests/pmdemo1.def
new file mode 100644
index 0000000000..ee1c91c04f
--- /dev/null
+++ b/rtl/os2/tests/pmdemo1.def
@@ -0,0 +1,12 @@
+NAME PMDEMO1 WINDOWAPI
+
+PROTMODE
+
+DESCRIPTION 'Compiled by Free Pascal'
+
+DATA MULTIPLE
+
+STACKSIZE 8096
+HEAPSIZE 8096
+
+EXPORTS _CLIENTWNDPROC$HWND$LONGINT$MPARAM$MPARAM
diff --git a/rtl/os2/tests/pmdemo1.h b/rtl/os2/tests/pmdemo1.h
new file mode 100644
index 0000000000..d13fe3ab89
--- /dev/null
+++ b/rtl/os2/tests/pmdemo1.h
@@ -0,0 +1,16 @@
+/*******************************************
+
+ Header fr den Ressourcecompiler
+
+********************************************/
+#define ID_ClientWindow 1
+
+/*
+ $Log: pmdemo1.h,v $
+ Revision 1.3 2002/11/30 18:43:02 hajny
+ * fix for missing end of comment block
+
+ Revision 1.2 2002/09/07 16:01:25 peter
+ * old logs removed and tabs fixed
+
+*/
diff --git a/rtl/os2/tests/pmdemo1.mak b/rtl/os2/tests/pmdemo1.mak
new file mode 100644
index 0000000000..c72c0bf1dc
--- /dev/null
+++ b/rtl/os2/tests/pmdemo1.mak
@@ -0,0 +1,5 @@
+pmdemo1.exe: pmdemo1.pp pmdemo1.res
+ ppc -Dow -Ch8096 -Cs8096 pmdemo1.pp
+
+pmdemo1.res: pmdemo1.rc
+ rc -r pmdemo1
diff --git a/rtl/os2/tests/pmdemo1.pp b/rtl/os2/tests/pmdemo1.pp
new file mode 100644
index 0000000000..70cc09c178
--- /dev/null
+++ b/rtl/os2/tests/pmdemo1.pp
@@ -0,0 +1,81 @@
+{****************************************************************************
+
+ $Id: pmdemo1.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+
+ Copyright (c) 1999-2000 by Florian Klaempfl
+
+ ****************************************************************************}
+
+{ Sample program for FPC under OS/2 }
+{ Classic Hello world in PM version }
+
+{$R pmdemo1.res}
+
+(* PMDEMO1.RES has to be compiled from PMDEMO1.RC using "rc -r PMDEMO1.RC". *)
+
+program pmdemo1;
+
+ uses
+ os2def,pmwin;
+
+ var
+ frame,client : cardinal;
+ ab : cardinal;
+ mq : cardinal;
+ msg : QMSG;
+
+ const
+ frameflags : longint = FCF_TITLEBAR+FCF_SYSMENU+FCF_SIZEBORDER+
+ FCF_MINBUTTON+FCF_MAXBUTTON+FCF_SHELLPOSITION+
+ FCF_TASKLIST+FCF_MENU;
+
+ function clientwndproc(window : cardinal;msg : longint;mp1,mp2 : pointer) :
+ pointer; cdecl; export;
+
+ const
+ text = 'Hello world by OS/2 and FPC';
+
+ var
+ ps : cardinal;
+ rcl : RECTL;
+
+ begin
+ {clientwndproc:=nil; }
+ case msg of
+{ WM_CREATE : DosBeep(200,500);}
+ WM_PAINT : begin
+ ps:=WinBeginPaint(window,0,nil);
+ WinQueryWindowRect(window,@rcl);
+ WinDrawText(ps,-1,text,@rcl,0,7,$8500);
+ WinEndPaint(ps);
+ end;
+ WM_COMMAND : case lo(longint(mp1)) of
+ {101 : DosBeep(4500,1000);}
+ 109 : WinPostMsg(0,WM_QUIT,nil,nil);
+ 201 : WinMessageBox(cardinal(1),cardinal(1),
+ 'HelloPM from FPC',
+ 'About',0,MB_ICONEXCLAMATION+MB_MOVEABLE);
+ end;
+ else
+ clientwndproc:=WinDefWindowProc(window,msg,mp1,mp2);
+ end;
+ end;
+
+ begin
+ ab:=WinInitialize(0);
+ mq:=WinCreateMsgQueue(ab,0);
+ WinRegisterClass(ab,'HELLOPM',proc(@clientwndproc),4,0);
+ frame:=WinCreateStdWindow(cardinal(1),WS_VISIBLE,@frameflags,'HELLOPM',
+ 'PMDemo 1',WS_VISIBLE,0,1,@client);
+ while WinGetMsg(ab,@msg,0,0,0) do
+ WinDispatchMsg(ab,@msg);
+ WinDestroyWindow(frame);
+ WinDestroyMsgQueue(mq);
+ WinTerminate(ab);
+ end.
+{
+ $Log: pmdemo1.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/tests/pmdemo1.rc b/rtl/os2/tests/pmdemo1.rc
new file mode 100644
index 0000000000..9371255803
--- /dev/null
+++ b/rtl/os2/tests/pmdemo1.rc
@@ -0,0 +1,23 @@
+/******************
+ * Name : TEXT.RC *
+ ******************/
+
+#include "PMDEMO1.H"
+
+MENU ID_ClientWindow
+ BEGIN
+ SUBMENU "~File",100
+ BEGIN
+ MENUITEM "~Open...",101
+ MENUITEM "~Exit",109
+ END
+ SUBMENU "~Help",200
+ BEGIN
+ MENUITEM "~About...",201
+ END
+ END
+/*
+ $Log: pmdemo1.rc,v $
+ Revision 1.2 2002/09/07 16:01:25 peter
+ * old logs removed and tabs fixed
+
diff --git a/rtl/os2/tests/testkbd.pas b/rtl/os2/tests/testkbd.pas
new file mode 100644
index 0000000000..095ab8dce1
--- /dev/null
+++ b/rtl/os2/tests/testkbd.pas
@@ -0,0 +1,49 @@
+program TestKBD;
+{$X+}
+
+{$IFNDEF OS2}
+ Sorry, this code is for OS/2 only...
+{$ENDIF}
+
+uses
+{$IFDEF FPC}
+ KbdCalls;
+{$ELSE}
+ {$IFDEF VIRTUALPASCAL}
+ Os2Base;
+ {$ELSE}
+ {$IFDEF SPEED}
+ BseSub;
+ {$ELSE}
+ Os2Subs;
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+function ExtKeyPressed: boolean; (* 'key' is here as well e.g. a shift *)
+var
+{$IFNDEF VER70} (* patched Borland Pascal *)
+ KI: KbdKeyInfo;
+ K: KbdInfo;
+{$ELSE}
+ KI: TKbdKeyInfo;
+ K: TKbdInfo;
+{$ENDIF}
+ B: boolean;
+begin
+ B := false;
+ K.cb := SizeOf (K);
+ KbdGetStatus (K, 0);
+ KbdPeek (KI, 0);
+ if (KI.fbStatus and $FE <> 0) or (K.fsState and $FF0F <> 0) then
+ begin
+ ExtKeyPressed := true;
+ if KI.fbStatus and $FE <> 0 then KbdCharIn (KI, IO_NOWAIT, 0);
+ end else ExtKeyPressed := false;
+end;
+
+begin
+ repeat until not (ExtKeyPressed);
+ WriteLn (#13#10'Press _any_ key to continue (including shifts etc.) ...');
+ repeat until ExtKeyPressed;
+end.
diff --git a/rtl/os2/todo-os2.txt b/rtl/os2/todo-os2.txt
new file mode 100644
index 0000000000..d0eba88f7e
--- /dev/null
+++ b/rtl/os2/todo-os2.txt
@@ -0,0 +1,177 @@
+Todo list for OS/2 version of FPC (Free Pascal Compiler).
+Please indent tasks which are done with 8 spaces.
+
+Persons:
+
+DM - Daniel Mantione (as daniel)
+TH - Tomas Hajny (as hajny)
+RB - Ramon Bosque
+KB - Karoly Balogh (as karoly)
+YP - Yuri Prokushev (as yuri)
+AS - Andry Svirgunov
+
+Item Priority Implemented by
+-----------------------------------------------------------------------------
+ - Free Vision.............................................TH/YP
+ - Presentation Manager....................................RB/TH/YP
+
+ - PMDdi
+
+RTL high
+ - sockets
+ - winsock.................................................YP
+ - graph
+ - pass dos compatibility tests
+ - exception handler
+ - WriteLn support for PM apps (message boxes)
+
+libgdb medium
+
+OS/2 native rtl high
+ - system.pas..............................................YP/TH
+ - crt.pas.................................................YP
+ - dos.pas.................................................YP
+ - sysutils.pp.............................................YP/TH
+ - ports.pas
+ - thread.inc..............................................YP
+ - linker (LINK386, Internal, ...)
+ - loader (prt*) for EXEs
+ - loader (prt*) for DLLs
+ - autothunking for 16-bit calls
+ - compiler support
+ - kbdcalls
+ - moncalls
+ - moucalls
+ - viocalls
+ - smartlinking
+ - {$linklib dllname} (autolinking like for win32/linux)
+ - interfaces support (SOM/DSOM)
+ - move emx.pas to emx rtl.................................YP
+ - move emx.imp to emx rtl.................................YP
+ - move wrap.imp to emx rtl as emxwrap.imp.................YP
+ - external variables import
+ - new place for exe.pas/newexe.pas
+
+FCL medium
+ - disk.inc................................................TH
+ - filutil.inc.............................................TH
+ - thread.inc..............................................TH
+ - pipes.inc...............................................TH
+ - eventlog.inc............................................TH
+ - process.inc
+ - ? unit SyncObjs
+ - ? unit HTTPApp
+
+native packages medium
+ - NetAPI (NetBIOS)
+ - Unicode
+ - LAN Manager
+ - Web Explorer (obsolete since OS/2 4.5)
+ - EPM
+ - LVM (new since OS/2 4.5)................................YP
+ - MMOS/2..................................................AS/YP/KB
+ - remove mmos2\buildall.pas
+ - WarpOverlay!(os2.kiev.ua)...............................YP
+ - TCP/IP
+ - Sockets (so32dll)
+ - tcp32dll
+ - FTP API.................................................YP
+ - LibC (Which lib to use? Native libc or EMX or Innotek or all of them?
+ Anyway, interface must be compatible with libc package)
+ - SOM (SOM2, not SOM3, because all current OS/2 implementations based on SOM2)
+ - Base API
+ - SOM
+ - DSOM
+ - SOMIR
+ - Base classes
+ - WPS
+ - Base classes
+ - CW BubblePad class
+ - IBM MM classes (obsolete since eCS 1.2)
+ - CW MM classes (new since eCS 1.2)
+ - eWorkplace/XWorkplace classes (new since eCS 1.1)
+ - OpenDoc classes (obsolete since OS/2 4.5)
+ - Security/2 (os2.kiev.ua)
+ - UniAud/2 (os2.kiev.ua)
+ - WPS Toolkit (wpstk.netlabs.org)
+
+cross-platform packages low
+ - SVGAlib (?)
+ - Xlib (Everblue, XFreeOS/2)
+ - Base....................................................YP
+ - GTK
+ - glib....................................................YP
+ - gdk.....................................................YP
+ - gtk.....................................................YP
+ - gtkgl
+ - fpgtk...................................................YP
+ - fix display detection bug
+ - Gnome
+ - art_lgpl
+ - gnome
+ - gnomeui
+ - zvt
+ - gconf
+ - gconfclient
+ - libgd
+ - tcl.....................................................YP
+ - libpng..................................................YP
+ - imlib...................................................YP
+ - OpenGL/MesaGL/Mesa3D/WarpMesaGL
+ - REXX
+ - rxstrings.pp (overloaded functions like len, pos, etc.)
+ - rexxsaa.pp..............................................YP
+ - SciTech SNAP SDK
+ - SciTech MGL
+ - Twain (STi/CFM/Win32)
+
+Odin32 target (as fast as native fpc/2 will be ready) low
+ - New compiler target (t_odin32.pas)
+ - Add Win32 units compiltation to Makefiles
+
+documentation (fpdoc) low
+ - TeX to INF converter
+ - Inf support for fpdoc
+ - RTL
+ - CPI
+ - os2defs
+ - doscalls
+ - kbdcalls
+ - moucalls
+ - moncalls
+ - PM
+ - PMWin
+ - PMGPI
+ - PMBitmap
+ - PMStdDlg
+ - PMHelp
+ - PMDev
+ - PMSpl
+ - PMShl
+ - PMWP
+ - PMWSock
+ - native packages
+ - TCP/IP
+ - ftpapi
+ - so32dll
+ - tcp32dll
+ - MMOS/2
+ - mmbase.pas
+ - mci.pas
+ - mciapi.pas
+ - mcidrv.pas
+ - mmio.pas
+ - dive.pas
+ - sw.pas
+ - WarpOverlay!
+ - hwvideo.pas
+ - cross-platform packages
+ - REXX
+ - rexxsaa.pp
+ - rxstrings.pp
+
+sample programs low
+
+installation (PM installer with WarpIN DB) low
+ - Warpin database unit
+ - PM interface to standard FPC installer
diff --git a/rtl/os2/tthread.inc b/rtl/os2/tthread.inc
new file mode 100644
index 0000000000..f0c0a887e5
--- /dev/null
+++ b/rtl/os2/tthread.inc
@@ -0,0 +1,246 @@
+{
+ $Id: tthread.inc,v 1.6 2005/02/25 21:41:09 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2002 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{* TThread *}
+{****************************************************************************}
+
+(* OS/2 specific declarations - see unit DosCalls for descriptions *)
+
+type
+ TByteArray = array [0..$fff0] of byte;
+ PByteArray = ^TByteArray;
+
+ TThreadEntry = function (Param: pointer): longint; cdecl;
+
+ TSysThreadIB = record
+ TID, Priority, Version: longint;
+ MCCount, MCForceFlag: word;
+ end;
+ PSysThreadIB = ^TSysThreadIB;
+
+ TThreadInfoBlock = record
+ Exh_Chain, Stack, StackLimit: pointer;
+ TIB2: PSysThreadIB;
+ Version, Ordinal: longint;
+ end;
+ PThreadInfoBlock = ^TThreadInfoBlock;
+ PPThreadInfoBlock = ^PThreadInfoBlock;
+
+ TProcessInfoBlock = record
+ PID, ParentPID, HMTE: longint;
+ Cmd, Env: PByteArray;
+ flStatus, tType: longint;
+ end;
+ PProcessInfoBlock = ^TProcessInfoBlock;
+ PPProcessInfoBlock = ^PProcessInfoBlock;
+
+
+const
+ deThread = 0;
+ deProcess = 1;
+
+ dtSuspended = 1;
+ dtStack_Commited = 2;
+
+ dtWait = 0;
+ dtNoWait = 1;
+
+
+procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock;
+ PAPIB: PPProcessInfoBlock); cdecl; external 'DOSCALLS' index 312;
+
+function DosSetPriority (Scope, TrClass: cardinal; Delta: longint;
+ PortID: cardinal): cardinal; cdecl; external 'DOSCALLS' index 236;
+
+procedure DosExit (Action, Result: cardinal); cdecl;
+ external 'DOSCALLS' index 233;
+
+function DosCreateThread (var TID: cardinal; Address: TThreadEntry;
+ aParam: pointer; Flags: cardinal; StackSize: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 311;
+
+function DosKillThread (TID: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 111;
+
+function DosResumeThread (TID: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 237;
+
+function DosSuspendThread (TID: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 238;
+
+function DosWaitThread (var TID: cardinal; Option: cardinal): cardinal; cdecl;
+ external 'DOSCALLS' index 349;
+
+
+const
+ Priorities: array [TThreadPriority] of word = ($100, $200, $207, $20F, $217,
+ $21F, $300);
+ ThreadCount: longint = 0;
+
+(* Implementation of exported functions *)
+
+procedure AddThread (T: TThread);
+begin
+ Inc (ThreadCount);
+end;
+
+
+procedure RemoveThread (T: TThread);
+begin
+ Dec (ThreadCount);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate (Self);
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+var
+ PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
+ I: TThreadPriority;
+begin
+ DosGetInfoBlocks (@PTIB, @PPIB);
+ with PTIB^.TIB2^ do
+ if Priority >= $300 then GetPriority := tpTimeCritical else
+ if Priority < $200 then GetPriority := tpIdle else
+ begin
+ I := Succ (Low (TThreadPriority));
+ while (I < High (TThreadPriority)) and
+ (Priority - Priorities [I] <= Priorities [Succ (I)] - Priority) do Inc (I);
+ GetPriority := I;
+ end;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+var
+ PTIB: PThreadInfoBlock;
+ PPIB: PProcessInfoBlock;
+begin
+ DosGetInfoBlocks (@PTIB, @PPIB);
+(*
+ PTIB^.TIB2^.Priority := Priorities [Value];
+*)
+ DosSetPriority (2, High (Priorities [Value]),
+ Low (Priorities [Value]) - PTIB^.TIB2^.Priority, FHandle);
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ begin
+ if Value then Suspend else Resume;
+ end;
+end;
+
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned (FOnTerminate) then Synchronize (@CallOnTerminate);
+end;
+
+
+function ThreadProc(Args: pointer): Integer; cdecl;
+var
+ FreeThread: Boolean;
+ Thread: TThread absolute Args;
+begin
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ Result := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then Thread.Free;
+ DosExit (deThread, Result);
+end;
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: cardinal;
+begin
+ inherited Create;
+ AddThread (Self);
+ FSuspended := CreateSuspended;
+ Flags := dtStack_Commited;
+ if FSuspended then Flags := Flags or dtSuspended;
+ if DosCreateThread (cardinal (FThreadID), @ThreadProc, pointer (Self),
+ Flags, 16384) <> 0 then
+ begin
+ FFinished := true;
+ Destroy;
+ end else FHandle := FThreadID;
+ IsMultiThread := true;
+ FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished and not Suspended then
+ begin
+ Terminate;
+ WaitFor;
+ end;
+ if FHandle <> -1 then DosKillThread (cardinal (FHandle));
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread (Self);
+end;
+
+procedure TThread.Resume;
+begin
+ FSuspended := not (DosResumeThread (cardinal (FHandle)) = 0);
+end;
+
+
+procedure TThread.Suspend;
+begin
+ FSuspended := DosSuspendThread (cardinal (FHandle)) = 0;
+end;
+
+
+procedure TThread.Terminate;
+begin
+ FTerminated := true;
+end;
+
+
+function TThread.WaitFor: Integer;
+var
+ FH: cardinal;
+begin
+ WaitFor := DosWaitThread (FH, dtWait);
+end;
+
+
+{
+ $Log: tthread.inc,v $
+ Revision 1.6 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/varutils.pp b/rtl/os2/varutils.pp
new file mode 100644
index 0000000000..9dcb838944
--- /dev/null
+++ b/rtl/os2/varutils.pp
@@ -0,0 +1,47 @@
+{
+ $Id: varutils.pp,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
+
diff --git a/rtl/os2/video.pp b/rtl/os2/video.pp
new file mode 100644
index 0000000000..7325e2c1a3
--- /dev/null
+++ b/rtl/os2/video.pp
@@ -0,0 +1,478 @@
+{
+ $Id: video.pp,v 1.13 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Video unit for OS/2
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+
+interface
+
+{$i videoh.inc}
+
+implementation
+
+uses
+ DosCalls, VioCalls;
+
+{$i video.inc}
+
+
+const
+ LastCursorType: word = crUnderline;
+ EmptyCell: cardinal = $0720;
+ OrigScreen: PVideoBuf = nil;
+ OrigScreenSize: cardinal = 0;
+
+var OrigCurType: TVioCursorInfo;
+ OrigVioMode: TVioModeInfo;
+ OrigHighBit: TVioIntensity;
+ OrigCurRow: word;
+ OrigCurCol: word;
+ CellHeight: byte;
+
+procedure CheckCellHeight;
+
+var OldCD, CD: TVioCursorInfo;
+
+begin
+ VioGetCurType (OldCD, 0);
+ Move (OldCD, CD, SizeOf (CD));
+ with CD do
+ begin
+ Attr := 0;
+ yStart := word (-90);
+ cEnd := word (-100);
+ end;
+ VioSetCurType (CD, 0);
+ VioGetCurType (CD, 0);
+ CellHeight := CD.cEnd;
+ VioSetCurType (OldCD, 0);
+end;
+
+
+
+
+procedure SetHighBitBlink (Blink: boolean);
+
+var VI: TVioIntensity;
+
+begin
+ with VI do
+ begin
+ cb := 6;
+ rType := 2;
+ fs := byte (not (Blink));
+ end;
+ VioSetState (VI, 0);
+end;
+
+
+Var
+ SysVideoBuf : PVideoBuf;
+
+procedure SysInitVideo;
+
+var MI: TVioModeInfo;
+
+begin
+ MI.cb := SizeOf (MI);
+ VioGetMode (MI, 0);
+ with MI do
+ begin
+ ScreenWidth := Col;
+ ScreenHeight := Row;
+ ScreenColor := Color >= Colors_16;
+ end;
+ VioGetCurPos (CursorY, CursorX, 0);
+ LowAscii := true;
+ SetCursorType (LastCursorType);
+{ Get the address of the videobuffer.}
+ if VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
+ begin
+ SysVideoBuf := SelToFlat (cardinal (SysVideoBuf));
+ SetHighBitBlink (true);
+ end
+ else
+ ErrorHandler (errVioInit, nil);
+end;
+
+
+procedure SysSetCursorPos (NewCursorX, NewCursorY: word);
+
+begin
+ if VioSetCurPos (NewCursorY, NewCursorX, 0) = 0 then
+ begin
+ CursorX := NewCursorX;
+ CursorY := NewCursorY;
+ end
+ else
+ {Do not set an error code; people should fix invalid NewCursorX
+ or NewCursorY values when designing, there is no need for detecting
+ these errors at runtime.}
+ RunError (225);
+end;
+
+
+function SysGetCursorType: word;
+
+var CD: TVioCursorInfo;
+
+begin
+ VioGetCurType (CD, 0); {Never fails, because handle is default handle.}
+ with CD do
+ begin
+ CursorLines := Succ (cEnd) - yStart;
+ if Attr = word (-1) then
+ SysGetCursorType := crHidden
+ else
+ {Because the cursor's start and end lines are returned, we'll have
+ to guess heuristically what cursor type we have.}
+ if CursorLines = 0 then
+ {Probably this does not occur, but you'll never know.}
+ SysGetCursorType := crHidden
+ else if CursorLines <= Succ (CellHeight div 4) then
+ SysGetCursorType := crUnderline
+ else if CursorLines <= Succ (CellHeight div 2) then
+ SysGetCursorType := crHalfBlock
+ else
+ SysGetCursorType := crBlock;
+ end;
+end;
+
+
+procedure SysSetCursorType (NewType: word);
+
+var CD: TVioCursorInfo;
+
+begin
+ VioGetCurType (CD, 0);
+ with CD do
+ begin
+ case NewType of
+ crHidden: Attr := word (-1);
+ crUnderline:
+ begin
+ Attr := 0;
+ yStart := word (-90);
+ cEnd := word (-100);
+ end;
+ crHalfBlock:
+ begin
+ Attr := 0;
+ yStart := word (-50);
+ cEnd := word (-100);
+ end;
+ crBlock:
+ begin
+ Attr := 0;
+ yStart := 0;
+ cEnd := word (-100);
+ end;
+ end;
+ VioSetCurType (CD, 0);
+ VioGetCurType (CD, 0);
+ CursorLines := Succ (cEnd) - yStart;
+ end;
+end;
+
+
+procedure SysClearScreen;
+
+begin
+ VioScrollDn (0, 0, word (-1), word (-1), word (-1), PWord (@EmptyCell)^, 0);
+ FillWord (SysVideoBuf^, VideoBufSize shr 1, PWord (@EmptyCell)^);
+end;
+
+
+procedure SysDoneVideo;
+
+var PScr: pointer;
+ ScrSize: cardinal;
+
+begin
+ LastCursorType := GetCursorType;
+ SysClearScreen;
+ {Restore original settings}
+ VioSetMode (OrigVioMode, 0);
+ CheckCellHeight;
+{Set CursorX and CursorY}
+ SetCursorPos (0, 0);
+ VioSetState (OrigHighBit, 0);
+ VioSetCurType (OrigCurType, 0);
+ VioSetCurPos (OrigCurRow, OrigCurCol, 0);
+ if (OrigScreenSize <> 0) and (OrigScreen <> nil) then
+ begin
+ ScrSize := 0;
+ if (VioGetBuf (PScr, PWord (@ScrSize)^, 0) = 0) and
+ (ScrSize = OrigScreenSize) then
+ begin
+ PScr := SelToFlat (cardinal (PScr));
+ Move (OrigScreen^, PScr^, OrigScreenSize);
+ VioShowBuf (0, ScrSize, 0);
+ end;
+ end;
+end;
+
+
+function SysGetCapabilities: word;
+
+begin
+ SysGetCapabilities := $3F;
+end;
+
+
+function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;
+
+var OldMI, MI: TVioModeInfo;
+
+begin
+ OldMI.cb := SizeOf (OldMI);
+ if VioGetMode (OldMI, 0) <> 0 then
+ SysVideoModeSelector := false
+ else
+ begin
+ with MI do
+ begin
+ cb := 8;
+ fbType := 1;
+ if VideoMode.Color then
+ Color := Colors_16
+ else
+ Color := Colors_2;
+ Col := VideoMode.Col;
+ Row := VideoMode.Row;
+ end;
+ if VioSetMode (MI, 0) = 0 then
+ if VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0) = 0 then
+ begin
+ SysVideoBuf := SelToFlat (cardinal (SysVideoBuf));
+ SysVideoModeSelector := true;
+ SetHighBitBlink (true);
+ CheckCellHeight;
+ SetCursorType (LastCursorType);
+ SysClearScreen;
+ end
+ else
+ begin
+ SysVideoModeSelector := false;
+ VioSetMode (OldMI, 0);
+ VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0);
+ SysVideoBuf := SelToFlat (cardinal (SysVideoBuf));
+ SetHighBitBlink (true);
+ CheckCellHeight;
+ SetCursorType (LastCursorType);
+ SysClearScreen;
+ end
+ else
+ begin
+ SysVideoModeSelector := false;
+ VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0);
+ SysVideoBuf := SelToFlat (cardinal (SysVideoBuf));
+ SetHighBitBlink (true);
+ SetCursorType (LastCursorType);
+ end;
+ end;
+end;
+
+Const
+ SysVideoModeCount = 6;
+ SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+ (Col: 40; Row: 25; Color: True),
+ (Col: 80; Row: 25; Color: True),
+ (Col: 80; Row: 30; Color: True),
+ (Col: 80; Row: 43; Color: True),
+ (Col: 80; Row: 50; Color: True),
+ (Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
+ );
+
+{ .MVC. were commented:
+ BW modes are rejected on my (colour) configuration. I can't imagine
+ OS/2 running on MCGA anyway... ;-)
+ (Col: 40; Row: 25;Color: False),
+ (Col: 80; Row: 25;Color: False),
+ The following modes wouldn't work on plain VGA; is it useful to check
+ for their availability on the program startup?
+ (Col: 132;Row: 25;Color: True),
+ (Col: 132;Row: 30;Color: True),
+ (Col: 132;Row: 43;Color: True),
+ (Col: 132;Row: 50;Color: True),
+}
+
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
+
+Var
+ I : Integer;
+
+begin
+ I:=SysVideoModeCount-1;
+ SysSetVideoMode:=False;
+ While (I>=0) and Not SysSetVideoMode do
+ If (Mode.col=SysVMD[i].col) and
+ (Mode.Row=SysVMD[i].Row) and
+ (Mode.Color=SysVMD[i].Color) then
+ SysSetVideoMode:=True
+ else
+ Dec(I);
+ If SysSetVideoMode then
+ begin
+ if SysVideoModeSelector(Mode) then
+ begin;
+ ScreenWidth:=SysVMD[I].Col;
+ ScreenHeight:=SysVMD[I].Row;
+ ScreenColor:=SysVMD[I].Color;
+ end else SysSetVideoMode := false;
+ end;
+end;
+
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+
+begin
+ SysGetVideoModeData:=(Index<=SysVideoModeCount);
+ If SysGetVideoModeData then
+ Data:=SysVMD[Index];
+end;
+
+Function SysGetVideoModeCount : Word;
+
+begin
+ SysGetVideoModeCount:=SysVideoModeCount;
+end;
+
+{$ASMMODE INTEL}
+
+procedure SysUpdateScreen (Force: boolean);
+
+var SOfs, CLen: cardinal;
+
+begin
+ if not (Force) then
+ asm
+ push ebx
+ push esi
+ push edi
+ cld
+ mov esi, VideoBuf
+ mov edi, OldVideoBuf
+ mov eax, VideoBufSize
+ mov ecx, eax
+ shr ecx, 1
+ shr ecx, 1
+ repe
+ cmpsd
+ je @no_update
+ inc ecx
+ mov edx, eax
+ mov ebx, ecx
+ shl ebx, 1
+ shl ebx, 1
+ sub edx, ebx
+ mov SOfs, edx
+ mov Force, 1
+ std
+ mov edi, eax
+ mov esi, VideoBuf
+ add eax, esi
+ sub eax, 4
+ mov esi, eax
+ mov eax, OldVideoBuf
+ add eax, edi
+ sub eax, 4
+ mov edi, eax
+ repe
+ cmpsd
+ inc ecx
+ shl ecx, 1
+ shl ecx, 1
+ mov CLen, ecx
+@no_update:
+ pop edi
+ pop esi
+ pop ebx
+ end ['eax', 'ecx', 'edx']
+ else
+ begin
+ SOfs := 0;
+ CLen := VideoBufSize;
+ end;
+ // .MVC. Move video buffer to system video buffer.
+ Move(VideoBuf^,SysVideoBuf^,VideoBufSize);
+ if Force then
+ begin
+ VioShowBuf (SOfs, CLen, 0);
+ Move (VideoBuf^ [SOfs div SizeOf (TVideoCell)],
+ OldVideoBuf^ [SOfs div SizeOf (TVideoCell)], CLen);
+ end;
+end;
+
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : @SysClearScreen;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModedata;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities
+ );
+
+procedure TargetEntry;
+
+var
+ PScr: pointer;
+
+begin
+{Remember original video mode, cursor type and high bit behaviour setting}
+ OrigVioMode.cb := SizeOf (OrigVioMode);
+ VioGetMode (OrigVioMode, 0);
+ VioGetCurType (OrigCurType, 0);
+ VioGetCurPos (OrigCurRow, OrigCurCol, 0);
+ with OrigHighBit do
+ begin
+ cb := 6;
+ rType := 2;
+ end;
+ VioGetState (OrigHighBit, 0);
+ { Register the curent video mode in reserved slot in System Modes}
+ with OrigVioMode do
+ begin
+ {Assume we have at least 16 colours available in "colour" modes}
+ SysVMD[SysVideoModeCount-1].Col:=Col;
+ SysVMD[SysVideoModeCount-1].Row:=Row;
+ SysVMD[SysVideoModeCount-1].Color:=(Color >= Colors_16);
+ end;
+ {Get the address of the original videobuffer and size.}
+ if VioGetBuf (PScr, PWord (@OrigScreenSize)^, 0) = 0 then
+ begin
+ PScr := SelToFlat (cardinal (PScr));
+ GetMem (OrigScreen, OrigScreenSize);
+ Move (PScr^, OrigScreen^, OrigScreenSize);
+ end;
+end;
+
+
+initialization
+ SetVideoDriver(SysVideoDriver);
+ TargetEntry;
+end.
+
+{
+ $Log: video.pp,v $
+ Revision 1.13 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/viocalls.imp b/rtl/os2/viocalls.imp
new file mode 100644
index 0000000000..9b747d502c
--- /dev/null
+++ b/rtl/os2/viocalls.imp
@@ -0,0 +1,61 @@
+;
+; vio16.imp
+;
+Vio16Associate viocalls 55 F
+Vio16CheckCharType viocalls 75 F
+Vio16CreateLogFont viocalls 60 F
+Vio16CreatePS viocalls 56 F
+Vio16DeleteSetId viocalls 57 F
+Vio16DeRegister viocalls 6 F
+Vio16DestroyPS viocalls 61 F
+Vio16EndPopUp viocalls 1 F
+Vio16GetAnsi viocalls 3 F
+Vio16GetBuf viocalls 31 F
+Vio16GetConfig viocalls 46 F
+Vio16GetCp viocalls 40 F
+Vio16GetCurPos viocalls 9 F
+Vio16GetCurType viocalls 27 F
+Vio16GetDeviceCellSize viocalls 58 F
+Vio16GetFont viocalls 29 F
+Vio16GetMode viocalls 21 F
+Vio16GetOrg viocalls 59 F
+Vio16GetPhysBuf viocalls 2 F
+Vio16GetPSAddress viocalls 67 F
+Vio16GetState viocalls 49 F
+Vio16GlobalReg viocalls 70 F
+Vio16ModeUndo viocalls 35 F
+Vio16ModeWait viocalls 37 F
+Vio16PopUp viocalls 11 F
+Vio16PrtSc viocalls 8 F
+Vio16PrtScToggle viocalls 50 F
+Vio16QueryFonts viocalls 64 F
+Vio16QuerySetIds viocalls 62 F
+Vio16ReadCellStr viocalls 24 F
+Vio16ReadCharStr viocalls 30 F
+Vio16Register viocalls 45 F
+Vio16SavRedrawUndo viocalls 28 F
+Vio16SavRedrawWait viocalls 25 F
+Vio16ScrLock viocalls 23 F
+Vio16ScrollDn viocalls 47 F
+Vio16ScrollLf viocalls 44 F
+Vio16ScrollRt viocalls 12 F
+Vio16ScrollUp viocalls 7 F
+Vio16ScrUnLock viocalls 18 F
+Vio16SetAnsi viocalls 5 F
+Vio16SetCp viocalls 42 F
+Vio16SetCurPos viocalls 15 F
+Vio16SetCurType viocalls 32 F
+Vio16SetDeviceCellSize viocalls 65 F
+Vio16SetFont viocalls 33 F
+Vio16SetMode viocalls 22 F
+Vio16SetOrg viocalls 63 F
+Vio16SetState viocalls 51 F
+Vio16ShowBuf viocalls 43 F
+Vio16ShowPS viocalls 66 F
+Vio16WrtCellStr viocalls 10 F
+Vio16WrtCharStr viocalls 13 F
+Vio16WrtCharStrAtt viocalls 48 F
+Vio16WrtNAttr viocalls 26 F
+Vio16WrtNCell viocalls 52 F
+Vio16WrtNChar viocalls 53 F
+Vio16WrtTTY viocalls 19 F
diff --git a/rtl/os2/viocalls.pas b/rtl/os2/viocalls.pas
new file mode 100644
index 0000000000..b64c8b0cef
--- /dev/null
+++ b/rtl/os2/viocalls.pas
@@ -0,0 +1,1156 @@
+{Set tabsize to 4.}
+{****************************************************************************
+
+ $Id: viocalls.pas,v 1.4 2005/02/14 17:13:31 peter Exp $
+
+ VIOCALLS interface unit
+ Free Pascal Runtime Library for OS/2
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ Copyright (c) 1999-2000 by Daniel Mantione
+ Copyright (c) 1999-2000 by Tomas Hajny
+
+ The Free Pascal runtime library is distributed under the Library GNU Public
+ License v2. So is this unit. The Library GNU Public License requires you to
+ distribute the source code of this unit with any product that uses it.
+ Because the EMX library isn't under the LGPL, we grant you an exception to
+ this, and that is, when you compile a program with the Free Pascal Compiler,
+ you do not need to ship source code with that program, AS LONG AS YOU ARE
+ USING UNMODIFIED CODE! If you modify this code, you MUST change the next
+ line:
+
+ <This is an official, unmodified Free Pascal source code file.>
+
+ Send us your modified files, we can work together if you want!
+
+ Free Pascal is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ Library GNU General Public License for more details.
+
+ You should have received a copy of the Library GNU General Public License
+ along with Free Pascal; see the file COPYING.LIB. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+****************************************************************************}
+
+unit VioCalls;
+
+{ Interface library to VIOCALLS.DLL (through EMXWRAP.DLL)
+
+Variant records and aliases for some record types created to maintain highest
+possible level of compatibility with other existing OS/2 compilers.
+
+Changelog:
+
+ People:
+
+ TH - Tomas Hajny (xhajt03@mbox.vol.cz on Internet)
+
+ Date: Description of change: Changed by:
+
+ - First released version 0.50 TH
+ 00/09/24 TVioCursorInfo definition extended,
+ new names for VioScroll* added TH
+
+Coding style:
+
+ I have tried to use the same coding style as Daniel Mantione in unit
+ DOSCALLS, although I can't say I would write it the same way otherwise
+ (I would write much more spaces myself, at least). Try to use it as well,
+ please. Original note by Daniel Mantione follows:
+
+
+ It may be well possible that coding style feels a bit strange to you.
+ Nevertheless I friendly ask you to try to make your changes not look all
+ to different. To make life easier, set your IDE to use tab characters,
+ turn optimal fill, autoindent and backspace unindents on and set a
+ tabsize of 4.}
+
+
+{***************************************************************************}
+interface
+{***************************************************************************}
+
+{$IFDEF FPC}
+ {$PACKRECORDS 1}
+{$ENDIF FPC}
+
+
+const
+{return codes / error constants}
+ NO_ERROR = 0;
+ Error_Invalid_Parameter = 87;
+ ERROR_VIO_INVALID_MASK =349;
+ ERROR_VIO_PTR =350;
+ ERROR_VIO_APTR =351;
+ ERROR_VIO_RPTR =352;
+ ERROR_VIO_CPTR =353;
+ ERROR_VIO_LPTR =354;
+ ERROR_VIO_MODE =355;
+ ERROR_VIO_WIDTH =356;
+ ERROR_VIO_ATTR =357;
+ ERROR_VIO_ROW =358;
+ ERROR_VIO_COL =359;
+ ERROR_VIO_TOPROW =360;
+ ERROR_VIO_BOTROW =361;
+ ERROR_VIO_RIGHTCOL =362;
+ ERROR_VIO_LEFTCOL =363;
+ ERROR_VIO_WAIT_FLAG =366;
+ ERROR_VIO_UNLOCK =367;
+ ERROR_VIO_SMG_ONLY =402;
+ ERROR_VIO_INVALID_ASCIIZ =403;
+ ERROR_VIO_DEREGISTER =404;
+ ERROR_VIO_NO_POPUP =405;
+ ERROR_VIO_EXISTING_POPUP =406;
+ ERROR_VIO_INVALID_PARMS =421;
+ ERROR_VIO_FUNCTION_OWNED =422;
+ ERROR_VIO_RETURN =423;
+ ERROR_VIO_REGISTER =426;
+ ERROR_VIO_NO_MODE_THREAD =427;
+ ERROR_VIO_NO_SAVE_RESTORE_THD =428;
+ ERROR_VIO_IN_BG =429;
+ ERROR_VIO_ILLEGAL_DURING_POPUP =430;
+ ERROR_VIO_LOCK =434;
+ ERROR_VIO_INVALID_HANDLE =436;
+ ERROR_VIO_ILLEGAL_DURING_LOCK =437;
+ ERROR_VIO_INVALID_LENGTH =438;
+ ERROR_VIO_DETACHED =465;
+ ERROR_VIO_FONT =467;
+ ERROR_VIO_USER_FONT =468;
+ ERROR_VIO_BAD_CP =469;
+ ERROR_VIO_NO_CP =470;
+ ERROR_VIO_NA_CP =471;
+ ERROR_VIO_INTERNAL_RESOURCE =479;
+ ERROR_VIO_SHELL_INIT =480;
+ ERROR_VIO_TRANSPARENT_POPUP =483;
+ ERROR_VIO_BAD_RESERVE =486;
+ ERROR_VIO_EXTENDED_SG =494;
+ ERROR_VIO_NOT_PRES_MGR_SG =495;
+ ERROR_VIO_SHIELD_OWNED =496;
+ ERROR_VIO_NO_MORE_HANDLES =497;
+ ERROR_VIO_SEE_ERROR_LOG =498;
+ ERROR_VIO_ASSOCIATED_DC =499;
+
+{severity codes}
+ SEVERITY_NOERROR =$0000;
+ SEVERITY_WARNING =$0004;
+ SEVERITY_ERROR =$0008;
+ SEVERITY_SEVERE =$000C;
+ SEVERITY_UNRECOVERABLE =$0010;
+
+{base component error values}
+ WINERR_BASE =$1000; {Window Manager}
+ GPIERR_BASE =$2000; {Graphics Presentation Interface}
+ DEVERR_BASE =$3000; {Device Manager}
+ SPLERR_BASE =$4000; {Spooler}
+
+
+{first parameter registration constants}
+ VR_VIOGETCURPOS =$00000001;
+ VR_VIOGETCURTYPE =$00000002;
+ VR_VIOGETMODE =$00000004;
+ VR_VIOGETBUF =$00000008;
+ VR_VIOGETPHYSBUF =$00000010;
+ VR_VIOSETCURPOS =$00000020;
+ VR_VIOSETCURTYPE =$00000040;
+ VR_VIOSETMODE =$00000080;
+ VR_VIOSHOWBUF =$00000100;
+ VR_VIOREADCHARSTR =$00000200;
+ VR_VIOREADCELLSTR =$00000400;
+ VR_VIOWRTNCHAR =$00000800;
+ VR_VIOWRTNATTR =$00001000;
+ VR_VIOWRTNCELL =$00002000;
+ VR_VIOWRTTTY =$00004000;
+ VR_VIOWRTCHARSTR =$00008000;
+ VR_VIOWRTCHARSTRATT =$00010000;
+ VR_VIOWRTCELLSTR =$00020000;
+ VR_VIOSCROLLUP =$00040000;
+ VR_VIOSCROLLDN =$00080000;
+ VR_VIOSCROLLLF =$00100000;
+ VR_VIOSCROLLRT =$00200000;
+ VR_VIOSETANSI =$00400000;
+ VR_VIOGETANSI =$00800000;
+ VR_VIOPRTSC =$01000000;
+ VR_VIOSCRLOCK =$02000000;
+ VR_VIOSCRUNLOCK =$04000000;
+ VR_VIOSAVREDRAWWAIT =$08000000;
+ VR_VIOSAVREDRAWUNDO =$10000000;
+ VR_VIOPOPUP =$20000000;
+ VR_VIOENDPOPUP =$40000000;
+ VR_VIOPRTSCTOGGLE =$80000000;
+
+{second parameter registration constants}
+ VR_VIOMODEWAIT =$00000001;
+ VR_VIOMODEUNDO =$00000002;
+ VR_VIOGETFONT =$00000004;
+ VR_VIOGETCONFIG =$00000008;
+ VR_VIOSETCP =$00000010;
+ VR_VIOGETCP =$00000020;
+ VR_VIOSETFONT =$00000040;
+ VR_VIOGETSTATE =$00000080;
+ VR_VIOSETSTATE =$00000100;
+
+{constants for TVioModeInfo.Color}
+ COLORS_2 =$0001;
+ COLORS_4 =$0002;
+ COLORS_16 =$0004;
+
+{constants for TVioModeInfo.fbType}
+ VGMT_OTHER =$01;
+ VGMT_GRAPHICS =$02;
+ VGMT_DISABLEBURST =$04;
+
+{constants for CharType in VioCheckCharType}
+ VCC_SBCSCHAR =0;
+ VCC_DBCSFULLCHAR =1;
+ VCC_DBCS1STHALF =2;
+ VCC_DBCS2NDHALF =3;
+
+{constants for Mode in VioGetAnsi/VioSetAnsi}
+ ANSI_ON =1;
+ ANSI_OFF =0;
+
+{constants for RequestType in VioSavRedrawWait}
+ VSRWI_SAVEANDREDRAW =0;
+ VSRWI_REDRAW =1;
+
+{constants for NotifyType in VioSavRedrawWait}
+ VSRWN_SAVE =0;
+ VSRWN_REDRAW =1;
+
+{constants for Ownership in VioSavRedrawUndo}
+ UNDOI_GETOWNER =0;
+ UNDOI_RELEASEOWNER =1;
+
+{constants for KillThread in VioSavRedrawUndo}
+ UNDOK_ERRORCODE =0;
+ UNDOK_TERMINATE =1;
+
+ VMWR_POPUP =0;
+ VMWN_POPUP =0;
+
+{constants for WaitFlag in VioScrLock}
+ LOCKIO_NOWAIT =0;
+ LOCKIO_WAIT =1;
+
+{constants for Status in VioScrLock}
+ LOCK_SUCCESS =0;
+ LOCK_FAIL =1;
+
+{constants for OptionFlags in VioPopup}
+ VP_NOWAIT =$0000;
+ VP_WAIT =$0001;
+ VP_OPAQUE =$0000;
+ VP_TRANSPARENT =$0002;
+
+{constants for TVioConfigInfo.Adapter}
+ DISPLAY_MONOCHROME =$0000;
+ DISPLAY_CGA =$0001;
+ DISPLAY_EGA =$0002;
+ DISPLAY_VGA =$0003;
+ DISPLAY_8514A =$0007;
+ DISPLAY_IMAGEADAPTER =$0008;
+ DISPLAY_XGA =$0009;
+
+{constants for TVioConfigInfo.Display}
+ MONITOR_MONOCHROME =$0000;
+ MONITOR_COLOR =$0001;
+ MONITOR_ENHANCED =$0002;
+ MONITOR_8503 =$0003;
+ MONITOR_851X_COLOR =$0004;
+ MONITOR_8514 =$0009;
+ MONITOR_FLATPANEL =$000A;
+ MONITOR_8507_8604 =$000B;
+ MONITOR_8515 =$000C;
+ MONITOR_9515 =$000F;
+ MONITOR_9517 =$0011;
+ MONITOR_9518 =$0012;
+
+{constants for TVioConfigInfo.Configuration, TVioSetTarget.DefaultAlgorithm
+and usConfigID in VioGetConfig}
+ VIO_CONFIG_CURRENT =0;
+ VIO_CONFIG_PRIMARY =1;
+ VIO_CONFIG_SECONDARY =2;
+
+{constants for TVioFontInfo.rType}
+ VGFI_GETCURFONT =0;
+ VGFI_GETROMFONT =1;
+
+{constants for TFAttrs.fsSelection}
+ FATTR_SEL_ITALIC =$0001;
+ FATTR_SEL_UNDERSCORE =$0002;
+ FATTR_SEL_OUTLINE =$0008;
+ FATTR_SEL_STRIKEOUT =$0010;
+ FATTR_SEL_BOLD =$0020;
+
+{constants for TFAttrs.fsType}
+ FATTR_TYPE_KERNING =$0004;
+ FATTR_TYPE_MBCS =$0008;
+ FATTR_TYPE_DBCS =$0010;
+ FATTR_TYPE_ANTIALIASED =$0020;
+
+{constants for TFAttrs.fsFontUse}
+ FATTR_FONTUSE_NOMIX =$0002;
+ FATTR_FONTUSE_OUTLINE =$0004;
+ FATTR_FONTUSE_TRANSFORMABLE =$0008;
+
+{size for fields in the font records}
+ FACESIZE =32;
+
+{constants for TFontMetrics.fsType}
+ FM_TYPE_FIXED =$0001;
+ FM_TYPE_LICENSED =$0002;
+ FM_TYPE_KERNING =$0004;
+ FM_TYPE_DBCS =$0010;
+ FM_TYPE_MBCS =$0018;
+ FM_TYPE_64K =$8000;
+ FM_TYPE_ATOMS =$4000;
+ FM_TYPE_FAMTRUNC =$2000;
+ FM_TYPE_FACETRUNC =$1000;
+
+{constants for TFontMetrics.fsDefn}
+ FM_DEFN_OUTLINE =$0001;
+ FM_DEFN_IFI =$0002;
+ FM_DEFN_WIN =$0004;
+ FM_DEFN_GENERIC =$8000;
+
+{constants for TFontMetrics.fsSelection}
+ FM_SEL_ITALIC =$0001;
+ FM_SEL_UNDERSCORE =$0002;
+ FM_SEL_NEGATIVE =$0004;
+ FM_SEL_OUTLINE =$0008; { Hollow Outline Font }
+ FM_SEL_STRIKEOUT =$0010;
+ FM_SEL_BOLD =$0020;
+ FM_SEL_ISO9241_TESTED =$0040;
+{ISO 9241 is an international standard covering health and safety
+in the work place for users of visual display terminals. Part 3 of
+this standard covers clarity and legibility of text displayed on
+computer screens, it places requirements on minimum sizes and
+luminance contrast. The presence of FM_SEL_ISO9241_TESTED flag in the
+font metrics indicates that the font has been tested for compliance
+to the standard. The FM_ISO_XXX flags indicate the results of the
+test on the IBM 9515, 9517 and 9518 color displays at the supported
+dimensions of 640x480 and 1024x768. To ensure compliance the
+sXDeviceRes and sYDeviceRes must also match the target display
+resolution.}
+
+{constants for TPanose.fbPassedISO and TPanose.fbFailedISO}
+ FM_ISO_9518_640 =$01;
+ FM_ISO_9515_640 =$02;
+ FM_ISO_9515_1024 =$04;
+ FM_ISO_9517_640 =$08;
+ FM_ISO_9517_1024 =$10;
+
+{constant for TFontMetrics.fsCapabilities}
+ FM_CAP_NOMIX =$0001;
+
+
+type
+{unnecessary, just FYI}
+ THVio=word;
+ PHVio=^THVio;
+ THVPS=word;
+ PHVPS=^THVPS;
+
+ TQWord=record
+ Lo:cardinal;
+ Hi:cardinal;
+ end;
+ PQWord=^TQWord;
+
+{Record type for VioSetCurType/VioGetCurType; the second variant makes the use
+ of percentage-based (negative) and hidden cursor type (-1) specification
+ a bit easier}
+ TVioCursorInfo=record
+ case boolean of
+ false:(
+ yStart:word; {Cursor start (top) scan line (0-based)}
+ cEnd:word; {Cursor end (bottom) scan line}
+ cx:word; {Cursor width (0=default width)}
+ Attr:word); {Cursor colour attribute (-1=hidden)}
+ true:(
+ yStartInt: integer;
+ cEndInt:integer;
+ cxInt:integer;
+ AttrInt:integer);
+ end;
+ PVioCursorInfo=^TVioCursorInfo;
+ VioCursorInfo=TVioCursorInfo;
+
+{Record type for VioSetMode/GetMode}
+ TVioModeInfo=record
+ cb:word; {Size of the record}
+ case boolean of
+ false:(
+ fbType, {8-bit mask identifying the mode}
+ {- see VGMT_* constants }
+ Color:byte; {Number of colour bits available}
+ {(1=>2 colours, 2=>4,...) - see }
+ {COLORS_* constants }
+ Col, {Number of text character columns}
+ Row, {Number of text character rows}
+ HRes, {Display width in pixels}
+ VRes:word; {Display height in pixels}
+ fmt_ID, {Format of the attributes}
+ Attrib:byte; {Number of attributes in fmt_ID field}
+ Buf_Addr, {Address of the physical display buffer}
+ Buf_Length, {Length of the physical display buffer}
+ Full_Length, {Size of the buffer needed to save}
+ {the whole physical buffer }
+ Partial_Length:cardinal; {Size of the buffer needed to save}
+ {the part of the physical buffer }
+ {overwritten with VioPopup }
+ Ext_Data_Addr:pointer); {Address of an extended-mode data}
+ true:(
+ fbType2, (* should be fbType, Color, etc., but this *)
+ Color2:char; (* construct is unsupported currently *)
+ Col2,
+ Row2,
+ HRes2,
+ VRes2:word;
+ fmt_ID2,
+ Attrib2:char);
+ end;
+ PVioModeInfo=^TVioModeInfo;
+ VioModeInfo=TVioModeInfo;
+
+{record type for VioGetPhysBuf}
+ TVioPhysBuf=record
+ pBuf:pointer; {Absolute screen address}
+ cb:cardinal; {Length of the buffer in bytes}
+ case boolean of
+ false:(Sel:word); {Selector for video access}
+ true:(aSel:array[0..0] of word);
+ end;
+ PVioPhysBuf=^TVioPhysBuf;
+ VioPhysBuf=TVioPhysBuf;
+
+{record type for VioGetConfig}
+(* #pragma pack(2) ??? *)
+ type
+ TVioConfigInfo=record
+ cb:word; {Size of the record}
+ Adapter:word; {Adapter type (see DISPLAY_* constants)}
+ Display:word; {Display type (see MONITOR_* constants)}
+ cbMemory:cardinal; {Amount of RAM in bytes on the adapter}
+ Configuration:word; {Configuration ID (see }
+ {VIO_CONFIG_* constants)}
+ VDHVersion:word; {Reserved, set to zero}
+ Flags:word; {Flags; 1 sets the default}
+ {power-on configuration }
+ HWBufferSize:cardinal; {Size of the buffer needed to save}
+ {the full adapter state (not }
+ {including the physical buffer) }
+ FullSaveSize:cardinal; {Size of the buffer needed to}
+ {save the full adapter state }
+ PartSaveSize:cardinal; {Size of the buffer needed to save}
+ {the part of the physical buffer }
+ {overwritten with VioPopup }
+ EmAdaptersOff:word; {Offset of the information }
+ {about emulated adapter types}
+ EmDisplaysOff:word; {Offset of the information }
+ {about emulated display types}
+ end;
+ PVioConfigInfo=^TVioConfigInfo;
+ VioConfigInfo=TVioConfigInfo;
+
+{record type for VioGetFont/VioSetFont}
+ TVioFontInfo=record
+ cb:word; {Size of the data record}
+ case byte of
+ 1:(
+ rType, {Request type}
+ cxCell, {Columns per cell (cell width)}
+ cyCell:word; {Rows per cell (cell height)}
+ pbData:pointer; {Address of caller's buffer}
+ cbData:word); {Size of caller's buffer in bytes}
+ 2:(
+ aType,
+ cxCell2,
+ cyCell2:word;
+ pbData2:longint); (* should be pbData, but this construct *)
+ 3:(_type:word); (* is not supported currently *)
+ end;
+ PVioFontInfo=^TVioFontInfo;
+ VioFontInfo=TVioFontInfo; (* *)
+
+{record types for VioGetState/VioSetState}
+ TVioPalState=record
+ cb:word; {Size of the record}
+ rtype:word; {0=palette}
+ iFirst:word; {The first register}
+ AColor:array[0..15] of word; {Up to 16 register values}
+ end;
+ PVioPalState=^TVioPalState;
+ VioPalState=TVioPalState;
+
+ TVioOverscan=record
+ cb:word; {Size of the record}
+ rType:word; {1=border colour}
+ Color:word; {The colour of the border area}
+ end;
+ PVioOverscan=^TVioOverscan;
+ VioOverScan=TVioOverScan;
+
+ TVioIntensity=record
+ cb:word; {Size of the record}
+ rType:word; {2=blink/bold settings}
+ fs:word; {The flink/bold background switch}
+ end;
+ PVioIntensity=^TVioIntensity;
+ VioIntensity=TVioIntensity;
+
+ TVioColorReg=record
+ cb:word; {Size of the record}
+ rType:word; {3=colour registers}
+ FirstColorReg:word; {The first colour register}
+ NumColorRegs:word; {Number of colour registers}
+ ColorRegAddr:pointer; {pointer to an array with colour values}
+ end;
+ PVioColorReg=^TVioColorReg;
+ VioColorReg=TVioColorReg;
+
+ TVioSetULineLoc=record
+ cb:word; {Size of the record}
+ rType:word; {5=underline}
+ ScanLine:word; {Location of the underline (32=no underline)}
+ end;
+ PVioSetULineLoc=^TVioSetULineLoc;
+ VioSetULineLoc=TVioSetULineLoc;
+
+ TVioSetTarget=record
+ cb:word; {Size of the record}
+ rType:word; {6=target for VioSetMode}
+ DefaultAlgorithm:word; {Default/primary/secondary }
+ {(see VIO_CONFIG_* constants)}
+ end;
+ PVioSetTarget=^TVioSetTarget;
+ VioSetTarget=TVioSetTarget;
+
+ TStr8=array[0..7] of char;
+ PStr8=^TStr8;
+
+{font record type for Vio/GpiCreateLogFont}
+ TFAttrs=record
+ usRecordLength:word;
+ fsSelection:word;
+ lMatch:longint;
+ szFacename:array[0..FACESIZE-1] of char;
+ idRegistry:word;
+ usCodePage:word;
+ lMaxBaselineExt:longint;
+ lAveCharWidth:longint;
+ fsType:word;
+ fsFontUse:word;
+ end;
+ PFAttrs=^TFAttrs;
+ FAttrs=TFAttrs;
+
+{font metrics returned by GpiQueryFonts and others}
+ TPanose=record
+ bFamilyType:byte;
+ bSerifStyle:byte;
+ bWeight:byte;
+ bProportion:byte;
+ bContrast:byte;
+ bStrokeVariation:byte;
+ bArmStyle:byte;
+ bLetterform:byte;
+ bMidline:byte;
+ bXHeight:byte;
+ fbPassedISO:byte;
+ fbFailedISO:byte;
+ end;
+ PPanose=^TPanose;
+
+ TFontMetrics=record
+ szFamilyname:array[0..FACESIZE-1] of char;
+ szFacename:array[0..FACESIZE-1] of char;
+ idRegistry:word;
+ usCodePage:word;
+ lEmHeight:longint;
+ lXHeight:longint;
+ lMaxAscender:longint;
+ lMaxDescender:longint;
+ lLowerCaseAscent:longint;
+ lLowerCaseDescent:longint;
+ lInternalLeading:longint;
+ lExternalLeading:longint;
+ lAveCharWidth:longint;
+ lMaxCharInc:longint;
+ lEmInc:longint;
+ lMaxBaselineExt:longint;
+ sCharSlope:longint;
+ sInlineDir:integer;
+ sCharRot:integer;
+ usWeightClass:word;
+ usWidthClass:word;
+ sXDeviceRes:integer;
+ sYDeviceRes:integer;
+ sFirstChar:integer;
+ sLastChar:integer;
+ sDefaultChar:integer;
+ sBreakChar:integer;
+ sNominalPointSize:integer;
+ sMinimumPointSize:integer;
+ sMaximumPointSize:integer;
+ fsType:word;
+ fsDefn:word;
+ fsSelection:word;
+ fsCapabilities:word;
+ lSubscriptXSize:longint;
+ lSubscriptYSize:longint;
+ lSubscriptXOffset:longint;
+ lSubscriptYOffset:longint;
+ lSuperscriptXSize:longint;
+ lSuperscriptYSize:longint;
+ lSuperscriptXOffset:longint;
+ lSuperscriptYOffset:longint;
+ lUnderscoreSize:longint;
+ lUnderscorePosition:longint;
+ lStrikeoutSize:longint;
+ lStrikeoutPosition:longint;
+ sKerningPairs:integer;
+ sFamilyClass:integer;
+ lMatch:longint;
+ FamilyNameAtom:longint;
+ FaceNameAtom:longint;
+ Panose:TPanose;
+ end;
+ PFontMetrics=^TFontMetrics;
+ FontMetrics=TFontMetrics;
+
+
+function VioRegister(ModuleName,ProcName:PChar;FnMask1,FnMask2:cardinal):word;
+ cdecl;
+
+function VioRegister(ModuleName,ProcName:string;FnMask1,FnMask2:cardinal):word;
+
+function VioGlobalReg(ModuleName,ProcName:PChar;FnMask1,FnMask2:cardinal;
+ Return:word):word; cdecl;
+
+function VioGlobalReg(ModuleName,ProcName:string;FnMask1,FnMask2:cardinal;
+ Return:word):word;
+
+function VioDeRegister:word; cdecl;
+
+function VioGetBuf(var LVBAddr:pointer;var LVBLength:word;VioHandle:word):word;
+ cdecl;
+
+function VioGetCurPos(var Row,Column:word;VioHandle:word):word; cdecl;
+
+function VioSetCurPos(Row,Column,VioHandle:word):word; cdecl;
+
+function VioGetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl;
+
+function VioSetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl;
+
+function VioGetMode(var Mode:TVioModeInfo;VioHandle:word):word; cdecl;
+
+function VioSetMode(var Mode:TVioModeInfo;VioHandle:word):word; cdecl;
+
+function VioGetPhysBuf(var PBData:TVioPhysBuf;Reserved:word):word; cdecl;
+
+function VioReadCellStr(var Buf;var BufLen:word;
+ Row,Column,VioHandle:word):word; cdecl;
+
+function VioReadCharStr(var Buf;var BufLen:word;
+ Row,Column,VioHandle:word):word; cdecl;
+
+function VioWrtCellStr(CellStr:pointer;Len,Row,Column,VioHandle:word):word;
+ cdecl;
+
+function VioWrtCharStr(CharStr:pointer;Len,Row,Column,VioHandle:word):word;
+ cdecl;
+
+function VioScrollDn(TopRow,LeftCol,BotRow,RightCol,Lines:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioScrollDown(TopRow,LeftCol,BotRow,RightCol,Lines:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioScrollUp(TopRow,LeftCol,BotRow,RightCol,Lines:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioScrollLf(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioScrollLeft(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioScrollRt(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioScrollRight(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+
+function VioWrtNAttr(var Attr:byte;Times,Row,Column,VioHandle:word):word;
+ cdecl;
+
+function VioWrtNCell(var Cell:word;Times,Row,Column,VioHandle:word):word;
+ cdecl;
+
+function VioWrtNChar(var Ch:byte;Times,Row,Column,VioHandle:word):word; cdecl;
+
+function VioWrtNChar(var Ch:char;Times,Row,Column,VioHandle:word):word; cdecl;
+
+function VioWrtTTY(CharStr:pointer;Len,VioHandle:word):word; cdecl;
+
+function VioWrtCharStrAtt(CharStr:pointer;Len,Row,Column:word;var Attr:byte;
+ VioHandle:word):word; cdecl;
+
+function VioCheckCharType(var CharType:word;Row,Column,VioHandle:word):word;
+ cdecl;
+
+function VioShowBuf(BufOfs,Len,VioHandle:word):word; cdecl;
+
+function VioSetAnsi(Mode,VioHandle:word):word; cdecl;
+
+function VioGetAnsi(var Mode:word;VioHandle:word):word; cdecl;
+
+function VioPrtSc(VioHandle:word):word; cdecl;
+
+function VioPrtScToggle(VioHandle:word):word; cdecl;
+
+(*
+function VioRedrawSize(var RedrawSize:cardinal):word;
+*)
+
+function VioSavRedrawWait(RequestType:word;var NotifyType:word;
+ Reserved:word):word; cdecl;
+
+function VioSavRedrawUndo(Ownership,KillThread,Reserved:word):word; cdecl;
+
+function VioModeWait(RequestType:word;var NotifyType:word;Reserved:word):word;
+ cdecl;
+
+function VioModeUndo(Ownership,KillThread,Reserved:word):word; cdecl;
+
+function VioScrLock(WaitFlag:word;var Status:word;VioHandle:word):word; cdecl;
+
+function VioScrUnLock(VioHandle:word):word; cdecl;
+
+function VioPopUp(var OptionFlags:word;VioHandle:word):word; cdecl;
+
+function VioEndPopUp(VioHandle:word):word; cdecl;
+
+function VioGetConfig(ConfigId:word;var VideoConfig:TVioConfigInfo;
+ VioHandle:word):word; cdecl;
+
+function VioGetFont(var FontData:TVioFontInfo;VioHandle:word):word; cdecl;
+
+function VioSetFont(var FontData:TVioFontInfo;VioHandle:word):word; cdecl;
+
+function VioGetCp(Reserved:word;var CodePage:word;VioHandle:word):word; cdecl;
+
+function VioSetCp(Reserved:word;CodePage:word;VioHandle:word):word; cdecl;
+
+function VioGetState(var State;VioHandle:word):word; cdecl;
+
+function VioSetState(var State;VioHandle:word):word; cdecl;
+
+function VioAssociate(DC:cardinal;VPS:word):word; cdecl;
+
+function VioCreateLogFont(var FAtAttrs:TFAttrs;LLCId:longint;var Name:TStr8;
+ VPS:word):word; cdecl;
+
+function VioCreatePS(var VPS:word;Depth,Width,Format,Attrs:integer;
+ Reserved:word):word; cdecl;
+
+function VioDeleteSetId(LLCId:longint;VPS:word):word; cdecl;
+
+function VioDestroyPS(VPS:word):word; cdecl;
+
+function VioGetDeviceCellSize(var Height,Width:integer;VPS:word):word; cdecl;
+
+function VioGetOrg(var Row,Column:integer;VPS:word):word; cdecl;
+
+function VioQueryFonts(var Remfonts:longint;var fmMetrics:TFontMetrics;
+ MetricsLength:longint;var Fonts:longint;FaceName:PChar;
+ flOptions:cardinal;VPS:word):word; cdecl;
+
+function VioQueryFonts(var Remfonts:longint;var fmMetrics:TFontMetrics;
+ MetricsLength:longint;var Fonts:longint;FaceName:string;
+ flOptions:cardinal;VPS:word):word;
+
+function VioQuerySetIds(var allCIds:longint;var Names:TStr8;
+ var alTypes:longint;Count:longint;VPS:word):word; cdecl;
+
+function VioSetDeviceCellSize(Height,Width:integer;VPS:word):word; cdecl;
+
+function VioSetOrg(Row,Column:integer;VPS:word):word; cdecl;
+
+function VioShowPS(Depth,Width,offCell:integer;VPS:word):word; cdecl;
+
+{Default message processing for AVio PS's - imported from PMVIOP.DLL}
+function WinDefAVioWindowProc(WND:cardinal;Msg:word;mp1,mp2:cardinal):pointer;
+ cdecl;
+
+
+(* Following routines are not supported
+ (just have a look in some C header
+ file - you probably won't find it there either).
+VioFree (index 4)
+Avs_Prtsc (index 14)
+VioSrfUnblock (index 16)
+VioSrfBlock (index 17)
+VioSave (index 20)
+VioHetInit (index 34)
+VioSswSwitch (index 36)
+Avs_PrtscToggle (index 38)
+VioInit (index 39)
+VioRestore (index 41)
+VioShellInit (index 54)
+VioGetPSAddress (index 67)
+VioQueryConsole (index 68)
+XVioSetCAState (index 71)
+XVioCheckCharType (index 72)
+XVioDestroyCA (index 73)
+XVioCreateCA (index 74)
+XVioGetCAState (index 76)
+*)
+
+
+{***************************************************************************}
+implementation
+{***************************************************************************}
+
+
+function VioRegister(ModuleName,ProcName:PChar;FnMask1,FnMask2:cardinal):word;
+ cdecl;
+external 'EMXWRAP' index 145;
+{external 'VIOCALLS' index 45;}
+
+function VioRegister(ModuleName,ProcName:string;FnMask1,FnMask2:cardinal):word;
+begin
+ if byte(ModuleName[0])>8 then byte(ModuleName[0]):=8;
+ ModuleName[Succ(byte(ModuleName[0]))]:=#0;
+ if byte(ProcName[0])>32 then byte(ProcName[0]):=32;
+ ProcName[Succ(byte(ProcName[0]))]:=#0;
+ VioRegister:=VioRegister(@ModuleName[1],@ProcName[1],FnMask1,FnMask2);
+end;
+
+function VioGlobalReg(ModuleName,ProcName:PChar;FnMask1,FnMask2:cardinal;
+ Return:word):word; cdecl;
+external 'EMXWRAP' index 170;
+{external 'VIOCALLS' index 70;}
+
+function VioGlobalReg(ModuleName,ProcName:string;FnMask1,FnMask2:cardinal;
+ Return:word):word;
+begin
+ if byte(ModuleName[0])>8 then byte(ModuleName[0]):=8;
+ ModuleName[Succ(byte(ModuleName[0]))]:=#0;
+ if byte(ProcName[0])>32 then byte(ProcName[0]):=32;
+ ProcName[Succ(byte(ProcName[0]))]:=#0;
+ VioGlobalReg:=VioGlobalReg(@ModuleName[1],@ProcName[1],FnMask1,FnMask2,
+ Return);
+end;
+
+function VioDeRegister:word; cdecl;
+external 'EMXWRAP' index 106;
+{external 'VIOCALLS' index 6;}
+
+function VioGetBuf(var LVBAddr:pointer;var LVBLength:word;VioHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 131;
+{external 'VIOCALLS' index 31;}
+
+function VioGetCurPos(var Row,Column:word;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 109;
+{external 'VIOCALLS' index 9;}
+
+function VioSetCurPos(Row,Column,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 115;
+{external 'VIOCALLS' index 15;}
+
+function VioGetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 127;
+{external 'VIOCALLS' index 27;}
+
+function VioSetCurType(var CurData:TVioCursorInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 132;
+{external 'VIOCALLS' index 32;}
+
+function VioGetMode(var Mode:TVioModeInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 121;
+{external 'VIOCALLS' index 21;}
+
+function VioSetMode(var Mode:TVioModeInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 122;
+{external 'VIOCALLS' index 22;}
+
+function VioGetPhysBuf(var PBData:TVioPhysBuf;Reserved:word):word; cdecl;
+external 'EMXWRAP' index 102;
+{external 'VIOCALLS' index 2;}
+
+function VioReadCellStr(var Buf;var BufLen:word;
+ Row,Column,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 124;
+{external 'VIOCALLS' index 24;}
+
+function VioReadCharStr(var Buf;var BufLen:word;
+ Row,Column,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 130;
+{external 'VIOCALLS' index 30;}
+
+function VioWrtCellStr(CellStr:pointer;Len,Row,Column,VioHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 110;
+{external 'VIOCALLS' index 10;}
+
+function VioWrtCharStr(CharStr:pointer;Len,Row,Column,VioHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 113;
+{external 'VIOCALLS' index 13;}
+
+function VioScrollDn(TopRow,LeftCol,BotRow,RightCol,Lines:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 147;
+{external 'VIOCALLS' index 47;}
+
+function VioScrollDown(TopRow,LeftCol,BotRow,RightCol,Lines:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 147;
+{external 'VIOCALLS' index 47;}
+
+function VioScrollUp(TopRow,LeftCol,BotRow,RightCol,Lines:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 107;
+{external 'VIOCALLS' index 7;}
+
+function VioScrollLf(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 144;
+{external 'VIOCALLS' index 44;}
+
+function VioScrollLeft(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 144;
+{external 'VIOCALLS' index 44;}
+
+function VioScrollRt(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 112;
+{external 'VIOCALLS' index 12;}
+
+function VioScrollRight(TopRow,LeftCol,BotRow,RightCol,Col:word;var Cell:word;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 112;
+{external 'VIOCALLS' index 12;}
+
+function VioWrtNAttr(var Attr:byte;Times,Row,Column,VioHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 126;
+{external 'VIOCALLS' index 26;}
+
+function VioWrtNCell(var Cell:word;Times,Row,Column,VioHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 152;
+{external 'VIOCALLS' index 52;}
+
+function VioWrtNChar(var Ch:byte;Times,Row,Column,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 153;
+{external 'VIOCALLS' index 53;}
+
+function VioWrtNChar(var Ch:char;Times,Row,Column,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 153;
+{external 'VIOCALLS' index 53;}
+
+function VioWrtTTY(CharStr:pointer;Len,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 119;
+{external 'VIOCALLS' index 19;}
+
+function VioWrtCharStrAtt(CharStr:pointer;Len,Row,Column:word;var Attr:byte;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 148;
+{external 'VIOCALLS' index 48;}
+
+function VioCheckCharType(var CharType:word;Row,Column,VioHandle:word):word;
+ cdecl;
+external 'EMXWRAP' index 175;
+{external 'VIOCALLS' index 75;}
+
+function VioShowBuf(BufOfs,Len,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 143;
+{external 'VIOCALLS' index 43;}
+
+function VioSetAnsi(Mode,VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 105;
+{external 'VIOCALLS' index 5;}
+
+function VioGetAnsi(var Mode:word;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 103;
+{external 'VIOCALLS' index 3;}
+
+function VioPrtSc(VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 108;
+{external 'VIOCALLS' index 8;}
+
+function VioPrtScToggle(VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 150;
+{external 'VIOCALLS' index 50;}
+
+(*
+function VioRedrawSize(var RedrawSize:cardinal):word;
+!!!not defined in EMXWRAP.DLL!!!
+{external 'VIOCALLS' index 69;}
+*)
+
+function VioSavRedrawWait(RequestType:word;var NotifyType:word;
+ Reserved:word):word; cdecl;
+external 'EMXWRAP' index 125;
+{external 'VIOCALLS' index 25;}
+
+function VioSavRedrawUndo(Ownership,KillThread,Reserved:word):word; cdecl;
+external 'EMXWRAP' index 128;
+{external 'VIOCALLS' index 28;}
+
+function VioModeWait(RequestType:word;var NotifyType:word;Reserved:word):word;
+ cdecl;
+external 'EMXWRAP' index 137;
+{external 'VIOCALLS' index 37;}
+
+function VioModeUndo(Ownership,KillThread,Reserved:word):word; cdecl;
+external 'EMXWRAP' index 135;
+{external 'VIOCALLS' index 35;}
+
+function VioScrLock(WaitFlag:word;var Status:word;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 123;
+{external 'VIOCALLS' index 23;}
+
+function VioScrUnLock(VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 118;
+{external 'VIOCALLS' index 18;}
+
+function VioPopUp(var OptionFlags:word;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 111;
+{external 'VIOCALLS' index 11;}
+
+function VioEndPopUp(VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 101;
+{external 'VIOCALLS' index 1;}
+
+function VioGetConfig(ConfigId:word;var VideoConfig:TVioConfigInfo;
+ VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 146;
+{external 'VIOCALLS' index 46;}
+
+function VioGetFont(var FontData:TVioFontInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 129;
+{external 'VIOCALLS' index 29;}
+
+function VioSetFont(var FontData:TVioFontInfo;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 133;
+{external 'VIOCALLS' index 33;}
+
+function VioGetCp(Reserved:word;var CodePage:word;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 140;
+{external 'VIOCALLS' index 40;}
+
+function VioSetCp(Reserved:word;CodePage:word;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 142;
+{external 'VIOCALLS' index 42;}
+
+function VioGetState(var State;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 149;
+{external 'VIOCALLS' index 49;}
+
+function VioSetState(var State;VioHandle:word):word; cdecl;
+external 'EMXWRAP' index 151;
+{external 'VIOCALLS' index 51;}
+
+
+{Extended functions for windowed VIO follow.}
+function VioAssociate(DC:cardinal;VPS:word):word; cdecl;
+external 'EMXWRAP' index 155;
+{external 'VIOCALLS' index 55;}
+
+function VioCreateLogFont(var FAtAttrs:TFAttrs;LLCId:longint;var Name:TStr8;
+ VPS:word):word; cdecl;
+external 'EMXWRAP' index 160;
+{external 'VIOCALLS' index 60;}
+
+function VioCreatePS(var VPS:word;Depth,Width,Format,Attrs:integer;
+ Reserved:word):word; cdecl;
+external 'EMXWRAP' index 156;
+{external 'VIOCALLS' index 56;}
+
+function VioDeleteSetId(LLCId:longint;VPS:word):word; cdecl;
+external 'EMXWRAP' index 157;
+{external 'VIOCALLS' index 57;}
+
+function VioDestroyPS(VPS:word):word; cdecl;
+external 'EMXWRAP' index 161;
+{external 'VIOCALLS' index 61;}
+
+function VioGetDeviceCellSize(var Height,Width:integer;VPS:word):word; cdecl;
+external 'EMXWRAP' index 158;
+{external 'VIOCALLS' index 58;}
+
+function VioGetOrg(var Row,Column:integer;VPS:word):word; cdecl;
+external 'EMXWRAP' index 159;
+{external 'VIOCALLS' index 59;}
+
+function VioQueryFonts(var Remfonts:longint;var fmMetrics:TFontMetrics;
+ MetricsLength:longint;var Fonts:longint;FaceName:PChar;
+ flOptions:cardinal;VPS:word):word; cdecl;
+external 'EMXWRAP' index 164;
+{external 'VIOCALLS' index 64;}
+
+function VioQueryFonts(var Remfonts:longint;var fmMetrics:TFontMetrics;
+ MetricsLength:longint;var Fonts:longint;FaceName:string;
+ flOptions:cardinal;VPS:word):word;
+
+var B:byte;
+
+begin
+ B:=byte(FaceName[0]);
+ if B=0 then VioQueryFonts:=VioQueryFonts(RemFonts,fmMetrics,MetricsLength,
+ Fonts,nil,flOptions,VPS) else
+ begin
+ if B<>255 then
+ begin
+ FaceName[Succ(B)]:=#0;
+ VioQueryFonts:=VioQueryFonts(RemFonts,fmMetrics,MetricsLength,
+ Fonts,@FaceName[1],flOptions,VPS);
+ end else
+ begin
+ Move(FaceName[1],FaceName[0],B);
+ FaceName[B]:=#0;
+ VioQueryFonts:=VioQueryFonts(RemFonts,fmMetrics,MetricsLength,
+ Fonts,@FaceName,flOptions,VPS);
+ end;
+ end;
+end;
+
+function VioQuerySetIds(var allCIds:longint;var Names:TStr8;
+ var alTypes:longint;Count:longint;VPS:word):word; cdecl;
+external 'EMXWRAP' index 162;
+{external 'VIOCALLS' index 62;}
+
+function VioSetDeviceCellSize(Height,Width:integer;VPS:word):word; cdecl;
+external 'EMXWRAP' index 165;
+{external 'VIOCALLS' index 65;}
+
+function VioSetOrg(Row,Column:integer;VPS:word):word; cdecl;
+external 'EMXWRAP' index 163;
+{external 'VIOCALLS' index 63;}
+
+function VioShowPS(Depth,Width,offCell:integer;VPS:word):word; cdecl;
+external 'EMXWRAP' index 166;
+{external 'VIOCALLS' index 66;}
+
+function WinDefAVioWindowProc(WND:cardinal;Msg:word;mp1,mp2:cardinal):pointer;
+ cdecl;
+external 'EMXWRAP' index 30;
+{external 'PMVIOP' index 30;}
+
+end.
+
+{
+ $Log: viocalls.pas,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/os2/winsock.pas b/rtl/os2/winsock.pas
new file mode 100644
index 0000000000..87b5f26603
--- /dev/null
+++ b/rtl/os2/winsock.pas
@@ -0,0 +1,28 @@
+{****************************************************************************
+
+ $Id: winsock.pas,v 1.2 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyrigth (c) 2003 by Yuri Prokushev (prokushev@freemail.ru)
+
+ This file corresponds to version 1.1 of the Windows Sockets
+ specification.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************}
+unit winsock;
+{$define winsock}
+{$i pmwsock.pas}
+
+{
+$Log: winsock.pas,v $
+Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/Makefile b/rtl/palmos/Makefile
new file mode 100644
index 0000000000..bb39828981
--- /dev/null
+++ b/rtl/palmos/Makefile
@@ -0,0 +1,247 @@
+#
+# $Id: Makefile,v 1.2 2002/09/07 16:01:25 peter Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Michael van Canneyt
+#
+# Makefile for the Free Pascal PalmOS Runtime Library
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+
+#####################################################################
+# Start of configurable section.
+# Please note that all these must be set in the main makefile, and
+# should be set there.
+# Don't remove the indef statements. They serve to avoid conflicts
+# with the main makefile.
+#####################################################################
+
+# What is the Operating System ?
+ifndef OS_SOURCE
+OS_SOURCE=dos
+endif
+
+# What is the target operating system ?
+ifndef OS_TARGET
+override OS_TARGET=palmos
+endif
+
+# What compiler to use ?
+ifndef PP
+PP=ppc68k
+endif
+
+# What options to pass to the compiler ?
+# You may want to specify a config file or error definitions file here.
+ifndef OPT
+OPT=
+endif
+
+# Use smartlinking ?
+ifndef SMARTLINK
+SMARTLINK=NO
+endif
+
+# Name of library ?
+# If this is set, all units will be put in the same library.
+# If it is empty (default), the units will be left in separate files.
+ifndef LIBNAME
+LIBNAME=
+#LIBNAME=fpc
+endif
+
+# Should the library be shared or static (only if LIBNAME is set).
+# Set this to 'shared' or 'static' to create a librrary
+# Setting this to shared will disable smart linking.
+ifndef LIBTYPE
+LIBTYPE=
+#LIBTYPE=static
+endif
+
+# Where is the PPUMOVE program ?
+ifndef PPUMOVE
+PPUMOVE=ppumove
+endif
+
+#####################################################################
+# End of configurable section.
+# Do not edit after this line.
+#####################################################################
+override OS_TARGET=palmos
+override CPU=m68k
+
+#####################################################################
+# System independent
+#####################################################################
+
+# Where are the include files
+RTL=..
+CFG=$(RTL)/cfg
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU)
+OBJPASDIR=$(RTL)/objpas
+
+# Get some defaults for Programs and OSes.
+# This will set the following variables :
+# inlinux indos COPY REPLACE DEL INSTALL INSTALLEXE MKDIR
+# It will also set OPT for cross-compilation, and add required options.
+# also checks for config file.
+# it expects INC PROCINC to be set !!
+include $(CFG)/makefile.cfg
+
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+#####################################################################
+# System dependent
+#####################################################################
+
+# Check if we need C library.
+ifeq ($(LINK_TO_C),YES)
+override OPT:=$(OPT) -dCRTLIB
+endif
+
+# Define PalmOS units
+SYSTEMPPU = syspalm.ppu
+OBJECTS=syspalm
+
+PRT=prt0
+LOADERAS=$(PRT).as
+
+# Define Loaders
+LOADERS=
+
+# Add Prefix and Suffixes
+OBJLOADERS=$(addsuffix $(OEXT), $(LOADERS))
+PPUOBJECTS=$(addsuffix $(PPUEXT), $(OBJECTS))
+
+.PHONY : all install clean \
+ libs libsclean \
+ diffs diffclean \
+
+all : $(OBJLOADERS) $(PPUOBJECTS)
+
+install : all
+ $(MKDIR) $(UNITINSTALLDIR)
+ $(INSTALL) *$(PPUEXT) *$(OEXT) $(UNITINSTALLDIR)
+
+clean :
+ -$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) *.PPS log
+
+#####################################################################
+# Files
+#####################################################################
+
+#
+# Loaders
+#
+
+#prt0$(OEXT) : $(LOADERAS)
+# -as $(LOADERAS) -o prt0$(OEXT)
+
+#gprt0$(OEXT) : $(GLOADERAS)
+# -as $(GLOADERAS) -o gprt0$(OEXT)
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMPPU) : syspalm.pp $(SYSLINUXDEPS) $(SYSDEPS)
+ $(COMPILER) -Us -Sg syspalm.pp $(REDIR)
+
+# strings$(PPUEXT) : ../template/strings.pp $(SYSTEMPPU)
+# $(COPY) ../template/strings.pp .
+# $(PP) $(OPT) strings $(REDIR)
+# $(DEL) strings.pp
+
+#
+# Delphi Object Model
+#
+
+# objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp $(SYSTEMPPU)
+# $(COPY) $(OBJPASDIR)/objpas.pp .
+# $(PP) $(OPT) objpas $(REDIR)
+# $(DEL) objpas.pp
+
+#
+# System Dependent Units
+#
+
+#
+# TP7 Compatible RTL Units
+#
+
+#dos$(PPUEXT) : $(DOSDEPS) $(SYSTEMPPU)
+# $(PP) $(OPT) dos $(REDIR)
+
+#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(INC)/filerec.inc $(SYSTEMPPU)
+# $(PP) $(OPT) crt $(REDIR)
+
+#objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+# $(COPY) $(INC)/objects.pp .
+# $(PP) $(OPT) objects $(REDIR)
+# $(DEL) objects.pp
+
+#
+# Other RTL Units
+#
+
+#####################################################################
+# Libs
+#####################################################################
+
+staticlib:
+ make clean
+ make all SMARTLINK=YES LIBNAME=fpc LIBTYPE=static
+
+sharedlib:
+ make clean
+ make all
+ $(PPUMOVE) -o fpc $(SHAREDLIBFILES)
+
+staticlibinstall: staticlib
+ $(MKDIR) $(STATIC_LIBINSTALLDIR)
+ $(MKDIR) $(STATIC_UNITINSTALLDIR)
+ $(INSTALLEXE) libfpc$(STATICLIBEXT) $(STATIC_LIBINSTALLDIR)
+ $(INSTALL) *$(PPUEXT) *$(OEXT) $(STATIC_UNITINSTALLDIR)
+
+sharedlibinstall: sharedlib
+ $(MKDIR) $(SHARED_LIBINSTALLDIR)
+ $(MKDIR) $(SHARED_UNITINSTALLDIR)
+ $(INSTALLEXE) libfpc$(SHAREDLIBEXT) $(SHARED_LIBINSTALLDIR)
+ $(INSTALL) *$(PPUEXT) *$(OEXT) $(SHARED_UNITINSTALLDIR)
+ ldconfig
+
+libinstall: staticlibinstall sharedlibinstall
+
+libsclean : clean
+ -$(DEL) *$(SMARTLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+
+#####################################################################
+# Default targets
+#####################################################################
+
+include $(CFG)/makefile.def
+
+#
+# $Log: Makefile,v $
+# Revision 1.2 2002/09/07 16:01:25 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/palmos/api/common.inc b/rtl/palmos/api/common.inc
new file mode 100644
index 0000000000..d7083c0192
--- /dev/null
+++ b/rtl/palmos/api/common.inc
@@ -0,0 +1,109 @@
+{
+Copyright © 1995 - 1998, 3Com Corporation or its subsidiaries ("3Com").
+All rights reserved.
+
+This software may be copied and used solely for developing products for
+the Palm Computing platform and for archival and backup purposes. Except
+for the foregoing, no part of this software may be reproduced or transmitted
+in any form or by any means or used to make any derivative work (such as
+translation, transformation or adaptation) without express written consent
+from 3Com.
+
+3Com reserves the right to revise this software and to make changes in content
+from time to time without obligation on the part of 3Com to provide notification
+of such revision or changes.
+3COM MAKES NO REPRESENTATIONS OR WARRANTIES THAT THE SOFTWARE IS FREE OF ERRORS
+OR THAT THE SOFTWARE IS SUITABLE FOR YOUR USE. THE SOFTWARE IS PROVIDED ON AN
+"AS IS" BASIS. 3COM MAKES NO WARRANTIES, TERMS OR CONDITIONS, EXPRESS OR IMPLIED,
+EITHER IN FACT OR BY OPERATION OF LAW, STATUTORY OR OTHERWISE, INCLUDING WARRANTIES,
+TERMS, OR CONDITIONS OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
+SATISFACTORY QUALITY.
+
+TO THE FULL EXTENT ALLOWED BY LAW, 3COM ALSO EXCLUDES FOR ITSELF AND ITS SUPPLIERS
+ANY LIABILITY, WHETHER BASED IN CONTRACT OR TORT (INCLUDING NEGLIGENCE), FOR
+DIRECT, INCIDENTAL, CONSEQUENTIAL, INDIRECT, SPECIAL, OR PUNITIVE DAMAGES OF
+ANY KIND, OR FOR LOSS OF REVENUE OR PROFITS, LOSS OF BUSINESS, LOSS OF INFORMATION
+OR DATA, OR OTHER FINANCIAL LOSS ARISING OUT OF OR IN CONNECTION WITH THIS SOFTWARE,
+EVEN IF 3COM HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+3Com, HotSync, Palm Computing, and Graffiti are registered trademarks, and
+Palm III and Palm OS are trademarks of 3Com Corporation or its subsidiaries.
+
+IF THIS SOFTWARE IS PROVIDED ON A COMPACT DISK, THE OTHER SOFTWARE AND
+DOCUMENTATION ON THE COMPACT DISK ARE SUBJECT TO THE LICENSE AGREEMENT
+ACCOMPANYING THE COMPACT DISK.
+
+ -------------------------------------------------------------------
+ FileName:
+ Common.inc
+
+ Description:
+ Common include file for all Pilot routines.
+ Contains elementary data types
+
+ History:
+ 10/19/94 RM - Created by Ron Marianetti
+ 4/24/97 SL - Changes for PalmOS 2.0 SDK
+ 8/05/98 Converted to pascal by Florian Klaempfl
+
+}
+ { Elementary data types }
+
+ { Fixed size data types }
+ type
+ SByte = char; // I'am not sure about that (FK)
+ UInt16 = word;
+ UInt32 = cardinal;
+ SWord = integer;
+ Int16 = integer;
+ SDWord = longint;
+ Int32 = longint;
+ DWord = cardinal;
+ UChar = char; // I'am not sure about that (FK)
+ Short = integer;
+ UShort = word;
+ Int = integer;
+ UInt = word;
+ Long = longint;
+ ULong = cardinal;
+ Err = integer;
+ LocalID = DWord;
+
+ { Pointer Types }
+ VoidPtr = pointer;
+ VoidHand = ^VoidPtr;
+ SBytePtr = ^SByte;
+ BytePtr = ^Byte;
+ SWordPtr = ^SWord;
+ WordPtr = ^Word;
+ UInt16Ptr = ^word;
+ SDWordPtr = ^SDWord;
+ DWordPtr = ^DWord;
+
+ { Logical data types }
+ BooleanPtr = ^Boolean;
+
+ CharPtr = ^Char;
+ UCharPtr = ^UChar;
+ ShortPtr = ^Short;
+ UShortPtr = ^UShort;
+ IntPtr = ^Int;
+ UIntPtr = ^UInt;
+ LongPtr = ^Long;
+ ULongPtr = ^ULong;
+
+ { Generic Pointer types used by Memory Manager }
+ { We have to define Ptr as char* because that's what the Mac includes do. }
+ { global pointer }
+ Ptr = ^char;
+
+ { global handle }
+ Handle = ^Ptr;
+
+ { Function types }
+ ProcPtr = function : Long;cdecl;
+ $Log: common.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/common.pp b/rtl/palmos/api/common.pp
new file mode 100644
index 0000000000..839e9ece6d
--- /dev/null
+++ b/rtl/palmos/api/common.pp
@@ -0,0 +1,31 @@
+{
+ $Id: common.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 1998 Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit common;
+
+ interface
+
+ {$I common.inc}
+
+ implementation
+
+end.
+{
+ $Log: common.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/font.imn b/rtl/palmos/api/font.imn
new file mode 100644
index 0000000000..04a3e081ec
--- /dev/null
+++ b/rtl/palmos/api/font.imn
@@ -0,0 +1,5 @@
+ function FntIsAppDefined(fnt : FontID) : boolean;
+
+ begin
+ FntIsAppDefined:=longint(fnt)>=longint(fntAppFontCustomBase);
+ end;
diff --git a/rtl/palmos/api/font.inc b/rtl/palmos/api/font.inc
new file mode 100644
index 0000000000..60f7c58274
--- /dev/null
+++ b/rtl/palmos/api/font.inc
@@ -0,0 +1,57 @@
+ type
+ FontCharInfoType = record
+ offset : SByte;
+ width : SByte;
+ end;
+
+ FontType = record
+ fontType : SWord;
+ firstChar : SWord;
+ lastChar : SWord;
+ maxWidth : SWord;
+ kernMax : SWord;
+ nDescent : SWord;
+ fRectWidth : SWord;
+ fRectHeight : SWord;
+ owTLoc : SWord;
+ ascent : SWord;
+ descent : SWord;
+ leading : SWord;
+ rowWords : SWord;
+ end;
+
+ FontPtr = ^FontType;
+
+ FontTablePtr = ^FontPtr;
+
+ fontID = (stdFont := $00,boldFont,largeFont,symbolFont,
+ symbol11Font,symbol7Font,ledFont,largeBoldFont,
+ fntAppFontCustomBase := $80);
+
+ const
+ checkboxFont = symbol11Font;
+
+ function FntIsAppDefined(fnt : FontID) : boolean;
+
+ function FntGetFont:FontID;systrap sysTrapFntGetFont;
+ function FntSetFont(font:FontID):FontID;systrap sysTrapFntSetFont;
+ function FntGetFontPtr:FontPtr;systrap sysTrapFntGetFontPtr;
+ function FntBaseLine:SWord;systrap sysTrapFntBaseLine;
+ function FntCharHeight:SWord;systrap sysTrapFntCharHeight;
+ function FntLineHeight:SWord;systrap sysTrapFntLineHeight;
+ function FntAverageCharWidth:SWord;systrap sysTrapFntAverageCharWidth;
+ function FntCharWidth(ch:Char):SWord;systrap sysTrapFntCharWidth;
+ function FntCharsWidth(chars:pChar; len:Word):SWord;systrap sysTrapFntCharsWidth;
+ procedure FntCharsInWidth(string:pChar; stringWidthP:pSWord; stringLengthP:pSWord; fitWithinWidth:pBoolean);systrap sysTrapFntCharsInWidth;
+ function FntDescenderHeight:SWord;systrap sysTrapFntDescenderHeight;
+ function FntLineWidth(pChars:pChar; length:Word):SWord;systrap sysTrapFntLineWidth;
+ function FntWordWrap(chars:pChar; maxWidth:Word):Word;systrap sysTrapFntWordWrap;
+ procedure FntWordWrapReverseNLines(chars:pChar; maxWidth:Word; linesToScrollP:WordPtr; scrollPosP:WordPtr);systrap sysTrapFntWordWrapReverseNLines;
+ procedure FntGetScrollValues(chars:pChar; width:Word; scrollPos:Word; linesP:WordPtr; topLine:WordPtr);systrap sysTrapFntGetScrollValues;
+ function FntDefineFont(font:FontID; fontP:FontPtr):Err;systrap sysTrapFntDefineFont;
+
+ $Log: font.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/fontsel.inc b/rtl/palmos/api/fontsel.inc
new file mode 100644
index 0000000000..b7afe9b61c
--- /dev/null
+++ b/rtl/palmos/api/fontsel.inc
@@ -0,0 +1,6 @@
+ function FontSelect(fontID:FontID):FontID;systrap sysTrapFontSelect;
+ $Log: fontsel.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/init.inc b/rtl/palmos/api/init.inc
new file mode 100644
index 0000000000..9fb91a39d7
--- /dev/null
+++ b/rtl/palmos/api/init.inc
@@ -0,0 +1,7 @@
+ procedure UIInitialize;systrap sysTrapUIInitialize;
+ procedure UIReset;systrap sysTrapUIReset;
+ $Log: init.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/readme b/rtl/palmos/api/readme
new file mode 100644
index 0000000000..4a077b72dc
--- /dev/null
+++ b/rtl/palmos/api/readme
@@ -0,0 +1,6 @@
+This directory contains the interface units for the PalmOS.
+
+Renaming scheme (because of the 8.3 DOS limitation):
+---------------------------------------------------
+systemmgr --> sysmgr
+fontselect --> fontsel
diff --git a/rtl/palmos/api/rect.inc b/rtl/palmos/api/rect.inc
new file mode 100644
index 0000000000..8a1eea9bf5
--- /dev/null
+++ b/rtl/palmos/api/rect.inc
@@ -0,0 +1,32 @@
+ type
+ AbsRectType = record
+ left : SWord;
+ top : SWord;
+ right : SWord;
+ bottom : SWord;
+ end;
+
+ PointType = record
+ x : SWord;
+ y : SWord;
+ end;
+
+ RectangleType = record
+ topLeft : PointType;
+ extent : PointType;
+ end;
+
+ RectanglePtr = ^RectangleType;
+
+ procedure RctSetRectangle(r:RectanglePtr; left:SWord; top:SWord; width:SWord; height:SWord);systrap sysTrapRctSetRectangle;
+ procedure RctCopyRectangle(srcRect:RectanglePtr; dstRect:RectanglePtr);systrap sysTrapRctCopyRectangle;
+ procedure RctInsetRectangle(r:RectanglePtr; insetAmt:SWord);systrap sysTrapRctInsetRectangle;
+ procedure RctOffsetRectangle(r:RectanglePtr; deltaX:SWord; deltaY:SWord);systrap sysTrapRctOffsetRectangle;
+ function RctPtInRectangle(x:SWord; y:SWord; r:RectanglePtr):Boolean;systrap sysTrapRctPtInRectangle;
+ procedure RctGetIntersection(r1:RectanglePtr; r2:RectanglePtr; r3:RectanglePtr);systrap sysTrapRctGetIntersection;
+
+ $Log: rect.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/sysall.pp b/rtl/palmos/api/sysall.pp
new file mode 100644
index 0000000000..c4bbb3c400
--- /dev/null
+++ b/rtl/palmos/api/sysall.pp
@@ -0,0 +1,37 @@
+{
+ $Id: sysall.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 1998 Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit sysall;
+
+ interface
+
+ { include common definitions }
+ {$I common.inc}
+
+ { include trap number definitions }
+ {$I systraps.inc}
+
+ {$I sysmgr.inc}
+
+ implementation
+
+end.
+{
+ $Log: sysall.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/systraps.inc b/rtl/palmos/api/systraps.inc
new file mode 100644
index 0000000000..8509bab971
--- /dev/null
+++ b/rtl/palmos/api/systraps.inc
@@ -0,0 +1,482 @@
+{
+Copyright © 1995 - 1998, 3Com Corporation or its subsidiaries ("3Com").
+All rights reserved.
+
+This software may be copied and used solely for developing products for
+the Palm Computing platform and for archival and backup purposes. Except
+for the foregoing, no part of this software may be reproduced or transmitted
+in any form or by any means or used to make any derivative work (such as
+translation, transformation or adaptation) without express written consent
+from 3Com.
+
+3Com reserves the right to revise this software and to make changes in content
+from time to time without obligation on the part of 3Com to provide notification
+of such revision or changes.
+3COM MAKES NO REPRESENTATIONS OR WARRANTIES THAT THE SOFTWARE IS FREE OF ERRORS
+OR THAT THE SOFTWARE IS SUITABLE FOR YOUR USE. THE SOFTWARE IS PROVIDED ON AN
+"AS IS" BASIS. 3COM MAKES NO WARRANTIES, TERMS OR CONDITIONS, EXPRESS OR IMPLIED,
+EITHER IN FACT OR BY OPERATION OF LAW, STATUTORY OR OTHERWISE, INCLUDING WARRANTIES,
+TERMS, OR CONDITIONS OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
+SATISFACTORY QUALITY.
+
+TO THE FULL EXTENT ALLOWED BY LAW, 3COM ALSO EXCLUDES FOR ITSELF AND ITS SUPPLIERS
+ANY LIABILITY, WHETHER BASED IN CONTRACT OR TORT (INCLUDING NEGLIGENCE), FOR
+DIRECT, INCIDENTAL, CONSEQUENTIAL, INDIRECT, SPECIAL, OR PUNITIVE DAMAGES OF
+ANY KIND, OR FOR LOSS OF REVENUE OR PROFITS, LOSS OF BUSINESS, LOSS OF INFORMATION
+OR DATA, OR OTHER FINANCIAL LOSS ARISING OUT OF OR IN CONNECTION WITH THIS SOFTWARE,
+EVEN IF 3COM HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+3Com, HotSync, Palm Computing, and Graffiti are registered trademarks, and
+Palm III and Palm OS are trademarks of 3Com Corporation or its subsidiaries.
+
+IF THIS SOFTWARE IS PROVIDED ON A COMPACT DISK, THE OTHER SOFTWARE AND
+DOCUMENTATION ON THE COMPACT DISK ARE SUBJECT TO THE LICENSE AGREEMENT
+ACCOMPANYING THE COMPACT DISK.
+
+ -------------------------------------------------------------------
+ FileName:
+ SysTraps.inc
+
+ Description:
+ Pilot Traps
+
+ History:
+ 6/13/95 RM - Created by Ron Marianetti
+ 8/05/98 converted to pascal by Florian Klaempfl
+}
+ const
+ sysTrapBase = $A000;
+
+ type
+ SysTrapNumber = (sysTrapMemInit := sysTrapBase,sysTrapMemInitHeapTable,
+ sysTrapMemStoreInit,sysTrapMemCardFormat,
+ sysTrapMemCardInfo,sysTrapMemStoreInfo,
+ sysTrapMemStoreSetInfo,sysTrapMemNumHeaps,
+ sysTrapMemNumRAMHeaps,sysTrapMemHeapID,
+ sysTrapMemHeapPtr,sysTrapMemHeapFreeBytes,
+ sysTrapMemHeapSize,sysTrapMemHeapFlags,
+ sysTrapMemHeapCompact,sysTrapMemHeapInit,
+ sysTrapMemHeapFreeByOwnerID,sysTrapMemChunkNew,
+ sysTrapMemChunkFree,sysTrapMemPtrNew,
+ sysTrapMemPtrRecoverHandle,sysTrapMemPtrFlags,
+ sysTrapMemPtrSize,sysTrapMemPtrOwner,
+ sysTrapMemPtrHeapID,sysTrapMemPtrCardNo,
+ sysTrapMemPtrToLocalID,sysTrapMemPtrSetOwner,
+ sysTrapMemPtrResize,sysTrapMemPtrResetLock,
+ sysTrapMemHandleNew,sysTrapMemHandleLockCount,
+ sysTrapMemHandleToLocalID,sysTrapMemHandleLock,
+ sysTrapMemHandleUnlock,sysTrapMemLocalIDToGlobal,
+ sysTrapMemLocalIDKind,sysTrapMemLocalIDToPtr,
+ sysTrapMemMove,sysTrapMemSet,sysTrapMemStoreSearch,
+ sysTrapMemPtrDataStorage,sysTrapMemKernelInit,
+ sysTrapMemHandleFree,sysTrapMemHandleFlags,
+ sysTrapMemHandleSize,sysTrapMemHandleOwner,
+ sysTrapMemHandleHeapID,sysTrapMemHandleDataStorage,
+ sysTrapMemHandleCardNo,sysTrapMemHandleSetOwner,
+ sysTrapMemHandleResize,sysTrapMemHandleResetLock,
+ sysTrapMemPtrUnlock,sysTrapMemLocalIDToLockedPtr,
+ sysTrapMemSetDebugMode,sysTrapMemHeapScramble,
+ sysTrapMemHeapCheck,sysTrapMemNumCards,
+ sysTrapMemDebugMode,sysTrapMemSemaphoreReserve,
+ sysTrapMemSemaphoreRelease,sysTrapMemHeapDynamic,
+ sysTrapMemNVParams,sysTrapDmInit,sysTrapDmCreateDatabase,
+ sysTrapDmDeleteDatabase,sysTrapDmNumDatabases,
+ sysTrapDmGetDatabase,sysTrapDmFindDatabase,
+ sysTrapDmDatabaseInfo,sysTrapDmSetDatabaseInfo,
+ sysTrapDmDatabaseSize,sysTrapDmOpenDatabase,
+ sysTrapDmCloseDatabase,sysTrapDmNextOpenDatabase,
+ sysTrapDmOpenDatabaseInfo,sysTrapDmResetRecordStates,
+ sysTrapDmGetLastErr,sysTrapDmNumRecords,
+ sysTrapDmRecordInfo,sysTrapDmSetRecordInfo,
+ sysTrapDmAttachRecord,sysTrapDmDetachRecord,
+ sysTrapDmMoveRecord,sysTrapDmNewRecord,
+ sysTrapDmRemoveRecord,sysTrapDmDeleteRecord,
+ sysTrapDmArchiveRecord,sysTrapDmNewHandle,
+ sysTrapDmRemoveSecretRecords,sysTrapDmQueryRecord,
+ sysTrapDmGetRecord,sysTrapDmResizeRecord,
+ sysTrapDmReleaseRecord,sysTrapDmGetResource,
+ sysTrapDmGet1Resource,sysTrapDmReleaseResource,
+ sysTrapDmResizeResource,sysTrapDmNextOpenResDatabase,
+ sysTrapDmFindResourceType,sysTrapDmFindResource,
+ sysTrapDmSearchResource,sysTrapDmNumResources,
+ sysTrapDmResourceInfo,sysTrapDmSetResourceInfo,
+ sysTrapDmAttachResource,sysTrapDmDetachResource,
+ sysTrapDmNewResource,sysTrapDmRemoveResource,
+ sysTrapDmGetResourceIndex,sysTrapDmQuickSort,
+ sysTrapDmQueryNextInCategory,sysTrapDmNumRecordsInCategory,
+ sysTrapDmPositionInCategory,sysTrapDmSeekRecordInCategory,
+ sysTrapDmMoveCategory,sysTrapDmOpenDatabaseByTypeCreator,
+ sysTrapDmWrite,sysTrapDmStrCopy,sysTrapDmGetNextDatabaseByTypeCreator,
+ sysTrapDmWriteCheck,sysTrapDmMoveOpenDBContext,
+ sysTrapDmFindRecordByID,sysTrapDmGetAppInfoID,
+ sysTrapDmFindSortPositionV10,sysTrapDmSet,
+ sysTrapDmCreateDatabaseFromImage,sysTrapDbgSrcMessage,
+ sysTrapDbgMessage,sysTrapDbgGetMessage,
+ sysTrapDbgCommSettings,sysTrapErrDisplayFileLineMsg,
+ sysTrapErrSetJump,sysTrapErrLongJump,
+ sysTrapErrThrow,sysTrapErrExceptionList,
+ sysTrapSysBroadcastActionCode,sysTrapSysUnimplemented,
+ sysTrapSysColdBoot,sysTrapSysReset,sysTrapSysDoze,
+ sysTrapSysAppLaunch,sysTrapSysAppStartup,
+ sysTrapSysAppExit,sysTrapSysSetA5,sysTrapSysSetTrapAddress,
+ sysTrapSysGetTrapAddress,sysTrapSysTranslateKernelErr,
+ sysTrapSysSemaphoreCreate,sysTrapSysSemaphoreDelete,
+ sysTrapSysSemaphoreWait,sysTrapSysSemaphoreSignal,
+ sysTrapSysTimerCreate,sysTrapSysTimerWrite,
+ sysTrapSysTaskCreate,sysTrapSysTaskDelete,
+ sysTrapSysTaskTrigger,sysTrapSysTaskID,
+ sysTrapSysTaskUserInfoPtr,sysTrapSysTaskDelay,
+ sysTrapSysTaskSetTermProc,sysTrapSysUILaunch,
+ sysTrapSysNewOwnerID,sysTrapSysSemaphoreSet,
+ sysTrapSysDisableInts,sysTrapSysRestoreStatus,
+ sysTrapSysUIAppSwitch,sysTrapSysCurAppInfoPV20,
+ sysTrapSysHandleEvent,sysTrapSysInit,
+ sysTrapSysQSort,sysTrapSysCurAppDatabase,
+ sysTrapSysFatalAlert,sysTrapSysResSemaphoreCreate,
+ sysTrapSysResSemaphoreDelete,sysTrapSysResSemaphoreReserve,
+ sysTrapSysResSemaphoreRelease,sysTrapSysSleep,
+ sysTrapSysKeyboardDialogV10,sysTrapSysAppLauncherDialog,
+ sysTrapSysSetPerformance,sysTrapSysBatteryInfoV20,
+ sysTrapSysLibInstall,sysTrapSysLibRemove,
+ sysTrapSysLibTblEntry,sysTrapSysLibFind,
+ sysTrapSysBatteryDialog,sysTrapSysCopyStringResource,
+ sysTrapSysKernelInfo,sysTrapSysLaunchConsole,
+ sysTrapSysTimerDelete,sysTrapSysSetAutoOffTime,
+ sysTrapSysFormPointerArrayToStrings,
+ sysTrapSysRandom,sysTrapSysTaskSwitching,
+ sysTrapSysTimerRead,sysTrapStrCopy,sysTrapStrCat,
+ sysTrapStrLen,sysTrapStrCompare,sysTrapStrIToA,
+ sysTrapStrCaselessCompare,sysTrapStrIToH,
+ sysTrapStrChr,sysTrapStrStr,sysTrapStrAToI,
+ sysTrapStrToLower,sysTrapSerReceiveISP,
+ sysTrapSlkOpen,sysTrapSlkClose,sysTrapSlkOpenSocket,
+ sysTrapSlkCloseSocket,sysTrapSlkSocketRefNum,
+ sysTrapSlkSocketSetTimeout,sysTrapSlkFlushSocket,
+ sysTrapSlkSetSocketListener,sysTrapSlkSendPacket,
+ sysTrapSlkReceivePacket,sysTrapSlkSysPktDefaultResponse,
+ sysTrapSlkProcessRPC,sysTrapConPutS,
+ sysTrapConGetS,sysTrapFplInit,sysTrapFplFree,
+ sysTrapFplFToA,sysTrapFplAToF,sysTrapFplBase10Info,
+ sysTrapFplLongToFloat,sysTrapFplFloatToLong,
+ sysTrapFplFloatToULong,sysTrapFplMul,
+ sysTrapFplAdd,sysTrapFplSub,sysTrapFplDiv,
+ sysTrapScrInit,sysTrapScrCopyRectangle,
+ sysTrapScrDrawChars,sysTrapScrLineRoutine,
+ sysTrapScrRectangleRoutine,sysTrapScrScreenInfo,
+ sysTrapScrDrawNotify,sysTrapScrSendUpdateArea,
+ sysTrapScrCompressScanLine,sysTrapScrDeCompressScanLine,
+ sysTrapTimGetSeconds,sysTrapTimSetSeconds,
+ sysTrapTimGetTicks,sysTrapTimInit,sysTrapTimSetAlarm,
+ sysTrapTimGetAlarm,sysTrapTimHandleInterrupt,
+ sysTrapTimSecondsToDateTime,sysTrapTimDateTimeToSeconds,
+ sysTrapTimAdjust,sysTrapTimSleep,sysTrapTimWake,
+ sysTrapCategoryCreateListV10,sysTrapCategoryFreeListV10,
+ sysTrapCategoryFind,sysTrapCategoryGetName,
+ sysTrapCategoryEditV10,sysTrapCategorySelectV10,
+ sysTrapCategoryGetNext,sysTrapCategorySetTriggerLabel,
+ sysTrapCategoryTruncateName,sysTrapClipboardAddItem,
+ sysTrapClipboardCheckIfItemExist,sysTrapClipboardGetItem,
+ sysTrapCtlDrawControl,sysTrapCtlEraseControl,
+ sysTrapCtlHideControl,sysTrapCtlShowControl,
+ sysTrapCtlGetValue,sysTrapCtlSetValue,
+ sysTrapCtlGetLabel,sysTrapCtlSetLabel,
+ sysTrapCtlHandleEvent,sysTrapCtlHitControl,
+ sysTrapCtlSetEnabled,sysTrapCtlSetUsable,
+ sysTrapCtlEnabled,sysTrapEvtInitialize,
+ sysTrapEvtAddEventToQueue,sysTrapEvtCopyEvent,
+ sysTrapEvtGetEvent,sysTrapEvtGetPen,
+ sysTrapEvtSysInit,sysTrapEvtGetSysEvent,
+ sysTrapEvtProcessSoftKeyStroke,sysTrapEvtGetPenBtnList,
+ sysTrapEvtSetPenQueuePtr,sysTrapEvtPenQueueSize,
+ sysTrapEvtFlushPenQueue,sysTrapEvtEnqueuePenPoint,
+ sysTrapEvtDequeuePenStrokeInfo,sysTrapEvtDequeuePenPoint,
+ sysTrapEvtFlushNextPenStroke,sysTrapEvtSetKeyQueuePtr,
+ sysTrapEvtKeyQueueSize,sysTrapEvtFlushKeyQueue,
+ sysTrapEvtEnqueueKey,sysTrapEvtDequeueKeyEvent,
+ sysTrapEvtWakeup,sysTrapEvtResetAutoOffTimer,
+ sysTrapEvtKeyQueueEmpty,sysTrapEvtEnableGraffiti,
+ sysTrapFldCopy,sysTrapFldCut,sysTrapFldDrawField,
+ sysTrapFldEraseField,sysTrapFldFreeMemory,
+ sysTrapFldGetBounds,sysTrapFldGetTextPtr,
+ sysTrapFldGetSelection,sysTrapFldHandleEvent,
+ sysTrapFldPaste,sysTrapFldRecalculateField,
+ sysTrapFldSetBounds,sysTrapFldSetText,
+ sysTrapFldGetFont,sysTrapFldSetFont,
+ sysTrapFldSetSelection,sysTrapFldGrabFocus,
+ sysTrapFldReleaseFocus,sysTrapFldGetInsPtPosition,
+ sysTrapFldSetInsPtPosition,sysTrapFldSetScrollPosition,
+ sysTrapFldGetScrollPosition,sysTrapFldGetTextHeight,
+ sysTrapFldGetTextAllocatedSize,sysTrapFldGetTextLength,
+ sysTrapFldScrollField,sysTrapFldScrollable,
+ sysTrapFldGetVisibleLines,sysTrapFldGetAttributes,
+ sysTrapFldSetAttributes,sysTrapFldSendChangeNotification,
+ sysTrapFldCalcFieldHeight,sysTrapFldGetTextHandle,
+ sysTrapFldCompactText,sysTrapFldDirty,
+ sysTrapFldWordWrap,sysTrapFldSetTextAllocatedSize,
+ sysTrapFldSetTextHandle,sysTrapFldSetTextPtr,
+ sysTrapFldGetMaxChars,sysTrapFldSetMaxChars,
+ sysTrapFldSetUsable,sysTrapFldInsert,
+ sysTrapFldDelete,sysTrapFldUndo,sysTrapFldSetDirty,
+ sysTrapFldSendHeightChangeNotification,
+ sysTrapFldMakeFullyVisible,sysTrapFntGetFont,
+ sysTrapFntSetFont,sysTrapFntGetFontPtr,
+ sysTrapFntBaseLine,sysTrapFntCharHeight,
+ sysTrapFntLineHeight,sysTrapFntAverageCharWidth,
+ sysTrapFntCharWidth,sysTrapFntCharsWidth,
+ sysTrapFntDescenderHeight,sysTrapFntCharsInWidth,
+ sysTrapFntLineWidth,sysTrapFrmInitForm,
+ sysTrapFrmDeleteForm,sysTrapFrmDrawForm,
+ sysTrapFrmEraseForm,sysTrapFrmGetActiveForm,
+ sysTrapFrmSetActiveForm,sysTrapFrmGetActiveFormID,
+ sysTrapFrmGetUserModifiedState,sysTrapFrmSetNotUserModified,
+ sysTrapFrmGetFocus,sysTrapFrmSetFocus,
+ sysTrapFrmHandleEvent,sysTrapFrmGetFormBounds,
+ sysTrapFrmGetWindowHandle,sysTrapFrmGetFormId,
+ sysTrapFrmGetFormPtr,sysTrapFrmGetNumberOfObjects,
+ sysTrapFrmGetObjectIndex,sysTrapFrmGetObjectId,
+ sysTrapFrmGetObjectType,sysTrapFrmGetObjectPtr,
+ sysTrapFrmHideObject,sysTrapFrmShowObject,
+ sysTrapFrmGetObjectPosition,sysTrapFrmSetObjectPosition,
+ sysTrapFrmGetControlValue,sysTrapFrmSetControlValue,
+ sysTrapFrmGetControlGroupSelection,
+ sysTrapFrmSetControlGroupSelection,
+ sysTrapFrmCopyLabel,sysTrapFrmSetLabel,
+ sysTrapFrmGetLabel,sysTrapFrmSetCategoryLabel,
+ sysTrapFrmGetTitle,sysTrapFrmSetTitle,
+ sysTrapFrmAlert,sysTrapFrmDoDialog,sysTrapFrmCustomAlert,
+ sysTrapFrmHelp,sysTrapFrmUpdateScrollers,
+ sysTrapFrmGetFirstForm,sysTrapFrmVisible,
+ sysTrapFrmGetObjectBounds,sysTrapFrmCopyTitle,
+ sysTrapFrmGotoForm,sysTrapFrmPopupForm,
+ sysTrapFrmUpdateForm,sysTrapFrmReturnToForm,
+ sysTrapFrmSetEventHandler,sysTrapFrmDispatchEvent,
+ sysTrapFrmCloseAllForms,sysTrapFrmSaveAllForms,
+ sysTrapFrmGetGadgetData,sysTrapFrmSetGadgetData,
+ sysTrapFrmSetCategoryTrigger,sysTrapUIInitialize,
+ sysTrapUIReset,sysTrapInsPtInitialize,
+ sysTrapInsPtSetLocation,sysTrapInsPtGetLocation,
+ sysTrapInsPtEnable,sysTrapInsPtEnabled,
+ sysTrapInsPtSetHeight,sysTrapInsPtGetHeight,
+ sysTrapInsPtCheckBlink,sysTrapLstSetDrawFunction,
+ sysTrapLstDrawList,sysTrapLstEraseList,
+ sysTrapLstGetSelection,sysTrapLstGetSelectionText,
+ sysTrapLstHandleEvent,sysTrapLstSetHeight,
+ sysTrapLstSetSelection,sysTrapLstSetListChoices,
+ sysTrapLstMakeItemVisible,sysTrapLstGetNumberOfItems,
+ sysTrapLstPopupList,sysTrapLstSetPosition,
+ sysTrapMenuInit,sysTrapMenuDispose,sysTrapMenuHandleEvent,
+ sysTrapMenuDrawMenu,sysTrapMenuEraseStatus,
+ sysTrapMenuGetActiveMenu,sysTrapMenuSetActiveMenu,
+ sysTrapRctSetRectangle,sysTrapRctCopyRectangle,
+ sysTrapRctInsetRectangle,sysTrapRctOffsetRectangle,
+ sysTrapRctPtInRectangle,sysTrapRctGetIntersection,
+ sysTrapTblDrawTable,sysTrapTblEraseTable,
+ sysTrapTblHandleEvent,sysTrapTblGetItemBounds,
+ sysTrapTblSelectItem,sysTrapTblGetItemInt,
+ sysTrapTblSetItemInt,sysTrapTblSetItemStyle,
+ sysTrapTblUnhighlightSelection,sysTrapTblSetRowUsable,
+ sysTrapTblGetNumberOfRows,sysTrapTblSetCustomDrawProcedure,
+ sysTrapTblSetRowSelectable,sysTrapTblRowSelectable,
+ sysTrapTblSetLoadDataProcedure,sysTrapTblSetSaveDataProcedure,
+ sysTrapTblGetBounds,sysTrapTblSetRowHeight,
+ sysTrapTblGetColumnWidth,sysTrapTblGetRowID,
+ sysTrapTblSetRowID,sysTrapTblMarkRowInvalid,
+ sysTrapTblMarkTableInvalid,sysTrapTblGetSelection,
+ sysTrapTblInsertRow,sysTrapTblRemoveRow,
+ sysTrapTblRowInvalid,sysTrapTblRedrawTable,
+ sysTrapTblRowUsable,sysTrapTblReleaseFocus,
+ sysTrapTblEditing,sysTrapTblGetCurrentField,
+ sysTrapTblSetColumnUsable,sysTrapTblGetRowHeight,
+ sysTrapTblSetColumnWidth,sysTrapTblGrabFocus,
+ sysTrapTblSetItemPtr,sysTrapTblFindRowID,
+ sysTrapTblGetLastUsableRow,sysTrapTblGetColumnSpacing,
+ sysTrapTblFindRowData,sysTrapTblGetRowData,
+ sysTrapTblSetRowData,sysTrapTblSetColumnSpacing,
+ sysTrapWinCreateWindow,sysTrapWinCreateOffscreenWindow,
+ sysTrapWinDeleteWindow,sysTrapWinInitializeWindow,
+ sysTrapWinAddWindow,sysTrapWinRemoveWindow,
+ sysTrapWinSetActiveWindow,sysTrapWinSetDrawWindow,
+ sysTrapWinGetDrawWindow,sysTrapWinGetActiveWindow,
+ sysTrapWinGetDisplayWindow,sysTrapWinGetFirstWindow,
+ sysTrapWinEnableWindow,sysTrapWinDisableWindow,
+ sysTrapWinGetWindowFrameRect,sysTrapWinDrawWindowFrame,
+ sysTrapWinEraseWindow,sysTrapWinSaveBits,
+ sysTrapWinRestoreBits,sysTrapWinCopyRectangle,
+ sysTrapWinScrollRectangle,sysTrapWinGetDisplayExtent,
+ sysTrapWinGetWindowExtent,sysTrapWinDisplayToWindowPt,
+ sysTrapWinWindowToDisplayPt,sysTrapWinGetClip,
+ sysTrapWinSetClip,sysTrapWinResetClip,
+ sysTrapWinClipRectangle,sysTrapWinDrawLine,
+ sysTrapWinDrawGrayLine,sysTrapWinEraseLine,
+ sysTrapWinInvertLine,sysTrapWinFillLine,
+ sysTrapWinDrawRectangle,sysTrapWinEraseRectangle,
+ sysTrapWinInvertRectangle,sysTrapWinDrawRectangleFrame,
+ sysTrapWinDrawGrayRectangleFrame,sysTrapWinEraseRectangleFrame,
+ sysTrapWinInvertRectangleFrame,sysTrapWinGetFramesRectangle,
+ sysTrapWinDrawChars,sysTrapWinEraseChars,
+ sysTrapWinInvertChars,sysTrapWinGetPattern,
+ sysTrapWinSetPattern,sysTrapWinSetUnderlineMode,
+ sysTrapWinDrawBitmap,sysTrapWinModal,
+ sysTrapWinGetWindowBounds,sysTrapWinFillRectangle,
+ sysTrapWinDrawInvertedChars,sysTrapPrefOpenPreferenceDBV10,
+ sysTrapPrefGetPreferences,sysTrapPrefSetPreferences,
+ sysTrapPrefGetAppPreferencesV10,sysTrapPrefSetAppPreferencesV10,
+ sysTrapSndInit,sysTrapSndSetDefaultVolume,
+ sysTrapSndGetDefaultVolume,sysTrapSndDoCmd,
+ sysTrapSndPlaySystemSound,sysTrapAlmInit,
+ sysTrapAlmCancelAll,sysTrapAlmAlarmCallback,
+ sysTrapAlmSetAlarm,sysTrapAlmGetAlarm,
+ sysTrapAlmDisplayAlarm,sysTrapAlmEnableNotification,
+ sysTrapHwrGetRAMMapping,sysTrapHwrMemWritable,
+ sysTrapHwrMemReadable,sysTrapHwrDoze,
+ sysTrapHwrSleep,sysTrapHwrWake,sysTrapHwrSetSystemClock,
+ sysTrapHwrSetCPUDutyCycle,sysTrapHwrLCDInit,
+ sysTrapHwrLCDSleep,sysTrapHwrTimerInit,
+ sysTrapHwrCursor,sysTrapHwrBatteryLevel,
+ sysTrapHwrDelay,sysTrapHwrEnableDataWrites,
+ sysTrapHwrDisableDataWrites,sysTrapHwrLCDBaseAddr,
+ sysTrapHwrLCDDrawBitmap,sysTrapHwrTimerSleep,
+ sysTrapHwrTimerWake,sysTrapHwrLCDWake,
+ sysTrapHwrIRQ1Handler,sysTrapHwrIRQ2Handler,
+ sysTrapHwrIRQ3Handler,sysTrapHwrIRQ4Handler,
+ sysTrapHwrIRQ5Handler,sysTrapHwrIRQ6Handler,
+ sysTrapHwrDockSignals,sysTrapHwrPluggedIn,
+ sysTrapCrc16CalcBlock,sysTrapSelectDayV10,
+ sysTrapSelectTime,sysTrapDayDrawDaySelector,
+ sysTrapDayHandleEvent,sysTrapDayDrawDays,
+ sysTrapDayOfWeek,sysTrapDaysInMonth,
+ sysTrapDayOfMonth,sysTrapDateDaysToDate,
+ sysTrapDateToDays,sysTrapDateAdjust,
+ sysTrapDateSecondsToDate,sysTrapDateToAscii,
+ sysTrapDateToDOWDMFormat,sysTrapTimeToAscii,
+ sysTrapFind,sysTrapFindStrInStr,sysTrapFindSaveMatch,
+ sysTrapFindGetLineBounds,sysTrapFindDrawHeader,
+ sysTrapPenOpen,sysTrapPenClose,sysTrapPenGetRawPen,
+ sysTrapPenCalibrate,sysTrapPenRawToScreen,
+ sysTrapPenScreenToRaw,sysTrapPenResetCalibration,
+ sysTrapPenSleep,sysTrapPenWake,sysTrapResLoadForm,
+ sysTrapResLoadMenu,sysTrapFtrInit,sysTrapFtrUnregister,
+ sysTrapFtrGet,sysTrapFtrSet,sysTrapFtrGetByIndex,
+ sysTrapGrfInit,sysTrapGrfFree,sysTrapGrfGetState,
+ sysTrapGrfSetState,sysTrapGrfFlushPoints,
+ sysTrapGrfAddPoint,sysTrapGrfInitState,
+ sysTrapGrfCleanState,sysTrapGrfMatch,
+ sysTrapGrfGetMacro,sysTrapGrfFilterPoints,
+ sysTrapGrfGetNumPoints,sysTrapGrfGetPoint,
+ sysTrapGrfFindBranch,sysTrapGrfMatchGlyph,
+ sysTrapGrfGetGlyphMapping,sysTrapGrfGetMacroName,
+ sysTrapGrfDeleteMacro,sysTrapGrfAddMacro,
+ sysTrapGrfGetAndExpandMacro,sysTrapGrfProcessStroke,
+ sysTrapGrfFieldChange,sysTrapGetCharSortValue,
+ sysTrapGetCharAttr,sysTrapGetCharCaselessValue,
+ sysTrapPwdExists,sysTrapPwdVerify,sysTrapPwdSet,
+ sysTrapPwdRemove,sysTrapGsiInitialize,
+ sysTrapGsiSetLocation,sysTrapGsiEnable,
+ sysTrapGsiEnabled,sysTrapGsiSetShiftState,
+ sysTrapKeyInit,sysTrapKeyHandleInterrupt,
+ sysTrapKeyCurrentState,sysTrapKeyResetDoubleTap,
+ sysTrapKeyRates,sysTrapKeySleep,sysTrapKeyWake,
+ sysTrapDlkControl,sysTrapDlkStartServer,
+ sysTrapDlkGetSyncInfo,sysTrapDlkSetLogEntry,
+ sysTrapUnused2,sysTrapSysLibLoad,sysTrapSndPlaySmf,
+ sysTrapSndCreateMidiList,sysTrapAbtShowAbout,
+ sysTrapMdmDial,sysTrapMdmHangUp,sysTrapDmSearchRecord,
+ sysTrapSysInsertionSort,sysTrapDmInsertionSort,
+ sysTrapLstSetTopItem,sysTrapSclSetScrollBar,
+ sysTrapSclDrawScrollBar,sysTrapSclHandleEvent,
+ sysTrapSysMailboxCreate,sysTrapSysMailboxDelete,
+ sysTrapSysMailboxFlush,sysTrapSysMailboxSend,
+ sysTrapSysMailboxWait,sysTrapSysTaskWait,
+ sysTrapSysTaskWake,sysTrapSysTaskWaitClr,
+ sysTrapSysTaskSuspend,sysTrapSysTaskResume,
+ sysTrapCategoryCreateList,sysTrapCategoryFreeList,
+ sysTrapCategoryEditV20,sysTrapCategorySelect,
+ sysTrapDmDeleteCategory,sysTrapSysEvGroupCreate,
+ sysTrapSysEvGroupSignal,sysTrapSysEvGroupRead,
+ sysTrapSysEvGroupWait,sysTrapEvtEventAvail,
+ sysTrapEvtSysEventAvail,sysTrapStrNCopy,
+ sysTrapKeySetMask,sysTrapSelectDay,sysTrapPrefGetPreference,
+ sysTrapPrefSetPreference,sysTrapPrefGetAppPreferences,
+ sysTrapPrefSetAppPreferences,sysTrapFrmPointInTitle,
+ sysTrapStrNCat,sysTrapMemCmp,sysTrapTblSetColumnEditIndicator,
+ sysTrapFntWordWrap,sysTrapFldGetScrollValues,
+ sysTrapSysCreateDataBaseList,sysTrapSysCreatePanelList,
+ sysTrapDlkDispatchRequest,sysTrapStrPrintF,
+ sysTrapStrVPrintF,sysTrapPrefOpenPreferenceDB,
+ sysTrapSysGraffitiReferenceDialog,sysTrapSysKeyboardDialog,
+ sysTrapFntWordWrapReverseNLines,sysTrapFntGetScrollValues,
+ sysTrapTblSetRowStaticHeight,sysTrapTblHasScrollBar,
+ sysTrapSclGetScrollBar,sysTrapFldGetNumberOfBlankLines,
+ sysTrapSysTicksPerSecond,sysTrapHwrBacklight,
+ sysTrapDmDatabaseProtect,sysTrapTblSetBounds,
+ sysTrapStrNCompare,sysTrapStrNCaselessCompare,
+ sysTrapPhoneNumberLookup,sysTrapFrmSetMenu,
+ sysTrapEncDigestMD5,sysTrapDmFindSortPosition,
+ sysTrapSysBinarySearch,sysTrapSysErrString,
+ sysTrapSysStringByIndex,sysTrapEvtAddUniqueEventToQueue,
+ sysTrapStrLocalizeNumber,sysTrapStrDelocalizeNumber,
+ sysTrapLocGetNumberSeparators,sysTrapMenuSetActiveMenuRscID,
+ sysTrapLstScrollList,sysTrapCategoryInitialize,
+ sysTrapEncDigestMD4,sysTrapEncDES,sysTrapLstGetVisibleItems,
+ sysTrapWinSetWindowBounds,sysTrapCategorySetName,
+ sysTrapFldSetInsertionPoint,sysTrapFrmSetObjectBounds,
+ sysTrapWinSetColors,sysTrapFlpDispatch,
+ sysTrapFlpEmDispatch,sysTrapExgInit,
+ sysTrapExgConnect,sysTrapExgPut,sysTrapExgGet,
+ sysTrapExgAccept,sysTrapExgDisconnect,
+ sysTrapExgSend,sysTrapExgReceive,sysTrapExgRegisterData,
+ sysTrapExgNotifyReceive,sysTrapExgControl,
+ sysTrapPrgStartDialog,sysTrapPrgStopDialog,
+ sysTrapPrgUpdateDialog,sysTrapPrgHandleEvent,
+ sysTrapImcReadFieldNoSemicolon,sysTrapImcReadFieldQuotablePrintable,
+ sysTrapImcReadPropertyParameter,sysTrapImcSkipAllPropertyParameters,
+ sysTrapImcReadWhiteSpace,sysTrapImcWriteQuotedPrintable,
+ sysTrapImcWriteNoSemicolon,sysTrapImcStringIsAscii,
+ sysTrapTblGetItemFont,sysTrapTblSetItemFont,
+ sysTrapFontSelect,sysTrapFntDefineFont,
+ sysTrapCategoryEdit,sysTrapSysGetOSVersionString,
+ sysTrapSysBatteryInfo,sysTrapSysUIBusy,
+ sysTrapWinValidateHandle,sysTrapFrmValidatePtr,
+ sysTrapCtlValidatePointer,sysTrapWinMoveWindowAddr,
+ sysTrapFrmAddSpaceForObject,sysTrapFrmNewForm,
+ sysTrapCtlNewControl,sysTrapFldNewField,
+ sysTrapLstNewList,sysTrapFrmNewLabel,
+ sysTrapFrmNewBitmap,sysTrapFrmNewGadget,
+ sysTrapFileOpen,sysTrapFileClose,sysTrapFileDelete,
+ sysTrapFileReadLow,sysTrapFileWrite,
+ sysTrapFileSeek,sysTrapFileTell,sysTrapFileTruncate,
+ sysTrapFileControl,sysTrapFrmActiveState,
+ sysTrapSysGetAppInfo,sysTrapSysGetStackInfo,
+ sysTrapScrDisplayMode,sysTrapHwrLCDGetDepth,
+ sysTrapHwrGetROMToken,sysTrapDbgControl,
+ sysTrapExgDBRead,sysTrapExgDBWrite,sysTrapSysGremlins,
+ sysTrapFrmRemoveObject,sysTrapSysReserved1,
+ sysTrapSysReserved2,sysTrapSysReserved3,
+ sysTrapSysReserved4,sysTrapLastTrapNumber
+ );
+
+ const
+ sysNumTraps = longint(sysTrapLastTrapNumber)-sysTrapBase;
+ sysLibTrapBase = $A800;
+
+ type
+ SysLibTrapNumber = (sysLibTrapName := sysLibTrapBase,sysLibTrapOpen,
+ sysLibTrapClose,sysLibTrapSleep,sysLibTrapWake,
+ sysLibTrapCustom);
+
+ const
+ { Pilot specific TRAP instruction numbers }
+ { For soft breakpoints }
+ sysDbgBreakpointTrapNum = 0;
+
+ { For compiled breakpoints }
+ sysDbgTrapNum = 8;
+
+ { Trap dispatcher }
+ sysDispatchTrapNum = 15;
+
+ $Log: systraps.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/systraps.pp b/rtl/palmos/api/systraps.pp
new file mode 100644
index 0000000000..d5d03b3854
--- /dev/null
+++ b/rtl/palmos/api/systraps.pp
@@ -0,0 +1,31 @@
+{
+ $Id: systraps.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 1998 Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit systraps;
+
+ interface
+
+ {$I systraps.inc}
+
+ implementation
+
+end.
+{
+ $Log: systraps.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/api/ui.pp b/rtl/palmos/api/ui.pp
new file mode 100644
index 0000000000..7b219b6bb1
--- /dev/null
+++ b/rtl/palmos/api/ui.pp
@@ -0,0 +1,36 @@
+{
+ $Id: ui.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 1998 Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit ui;
+
+ interface
+
+ {$I init.inc}
+ {$I rect.inc}
+ {$I font.inc}
+ {$I fontsel.inc}
+
+ implementation
+
+ {$I font.imn}
+
+end.
+{
+ $Log: ui.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/os.inc b/rtl/palmos/os.inc
new file mode 100644
index 0000000000..dda11b7eca
--- /dev/null
+++ b/rtl/palmos/os.inc
@@ -0,0 +1,28 @@
+{
+ $Id: os.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$define palmos}
+{$undef atari}
+{$undef go32v2}
+{$undef os2}
+{$undef linux}
+{$undef win32}
+{$undef amiga}
+{$undef macos}
+
+{
+ $Log: os.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/pilot.pp b/rtl/palmos/pilot.pp
new file mode 100644
index 0000000000..e2cd66ceda
--- /dev/null
+++ b/rtl/palmos/pilot.pp
@@ -0,0 +1,694 @@
+{
+ $Id: pilot.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by H.M. Swartjes
+ Parts Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface unit for PalmOS calls
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit Pilot;
+
+interface
+ uses
+ SysTraps;
+
+ const
+
+ BTRUE = 256;
+ BFALSE = 0;
+{events.h}
+ nilEvent = 0;
+ penDownEvent = 1;
+ penUpEvent = 2;
+ penMoveEvent = 3;
+ keyDownEvent = 4;
+ winEnterEvent = 5;
+ winExitEvent = 6;
+ ctlEnterEvent = 7;
+ ctlExitEvent = 8;
+ ctlSelectEvent = 9;
+ ctlRepeatEvent = 10;
+ lstEnterEvent = 11;
+ lstSelectEvent = 12;
+ lstExitEvent = 13;
+ popSelectEvent = 14;
+ fldEnterEvent = 15;
+ fldHeightChangedEvent = 16;
+ fldChangedEvent = 17;
+ tblEnterEvent = 18;
+ tblSelectEvent = 19;
+ daySelectEvent = 20;
+ menuEvent = 21;
+ appStopEvent = 22;
+ frmLoadEvent = 23;
+ frmOpenEvent = 24;
+ frmGotoEvent = 25;
+ frmUpdateEvent = 26;
+ frmSaveEvent = 27;
+ frmCloseEvent = 28;
+ frmTitleEnterEvent = 29;
+ frmTitleSelectEvent = 30;
+ tblExitEvent = 31;
+ sclEnterEvent = 32;
+ sclExitEvent = 33;
+ sclRepeatEvent = 34;
+
+{table.h}
+ checkboxTableItem = 0;
+ customTableItem = 256;
+ dateTableItem = 512;
+ labelTableItem = 768;
+ numericTableItem = 1024;
+ popupTriggerTableItem = 1280;
+ textTableItem = 1536;
+ textWithNoteTableItem = 2048;
+ timeTableItem = 2303;
+
+ AsmTrap = $4e4f;
+ AsmCleanup = $4fef;
+ AsmPushInteger = $3e80;
+ AsmPushLong = $2e80;
+ AsmPushPtr = $2e88;
+
+ NinetySix = -1391668096; { This is the number of seconds on January 1, 1996. Think Pascal doesn't }
+{ know about unsigned longints, so I use this value regularly to put theSeconds in the positive range. }
+
+ type
+ Handle = ^Pointer;
+ UInt = word;
+ OsType = UInt;
+
+ Cstring = packed array[1..32] of char;
+ Cstr16 = packed array[1..16] of char;
+ Cstr8 = packed array[1..8] of char;
+ PString = packed record
+ case boolean of
+ true: (
+ p: String;
+ );
+ false: (
+ c: array[0..255] of char
+ );
+ end;
+
+ DmSearchStateType = packed array[1..8] of Integer;
+
+ SystemPreferencesType = packed record
+ version: Integer;
+ country: byte;
+ dateFormat: byte;
+ longDateFormat: byte;
+ weekStartDay: byte;
+ timeFormat: byte;
+ numberFormat: byte;
+ autoOffDuration: byte;
+ sysSoundLevel: byte;
+ alarmSoundLevel: byte;
+ hideSecretRecords: byte;
+ deviceLocked: byte;
+ sysPrefFlags: Integer;
+ sysBatteryKind: byte;
+ end;
+
+ RectangleType = record
+ left: Integer;
+ top: Integer;
+ width: Integer;
+ Height: Integer;
+ end;
+
+ DateTimeType = packed record
+ second: Integer;
+ minute: Integer;
+ hour: Integer;
+ day: Integer;
+ month: Integer;
+ year: Integer;
+ weekDay: Integer;
+ end;
+
+ TimeType = packed record
+ hours: Byte;
+ Minues: Byte;
+ end;
+
+ SysAppInfoType = packed record
+ cmd: Integer;
+ cmdPBP: Ptr;
+ launchFlags: Integer;
+ taskID: Longint;
+ codeH: Handle;
+ dbP: Integer;
+ stackP: Ptr;
+ globalsChunkP: Ptr;
+ memOwnerID: Integer;
+ dmAccessP: Ptr;
+ dmLastErr: Integer;
+ errExceptionP: Ptr
+ end;
+
+ SysAppInfoPtr = ^SySAppInfoType;
+
+ ListType = packed record
+ id: integer;
+ Left: Integer;
+ Top: Integer;
+ Width: Integer;
+ Height: Integer;
+ attr: byte;
+ padding: byte;
+ itemsText: longint;
+ numItems: integer;
+ currentItem: integer;
+ topItem: integer;
+ font: integer;
+ popupWin: longint;
+ drawItemsCallback: longint;
+ end;
+
+ ListPtr = ^ListType;
+
+ ControlType = packed record
+ id: integer;
+ Left: Integer;
+ Top: Integer;
+ Width: Integer;
+ Height: Integer;
+ text: Longint;
+ attr: integer;
+ style: byte;
+ font: byte;
+ group: byte;
+ padding: byte;
+ end;
+
+ ControlPtr = ^ControlType;
+
+ eventType = packed record
+ eType: Integer;
+ penDown: Boolean;
+ screenX: Integer;
+ screenY: Integer;
+ case Integer of
+ 0: (
+ data1, data2, data3, data4, data5, data6, data7, data8: Integer
+ );
+ penUpEvent: (
+ startX, startY, endX, endY: Integer
+ );
+ ctlSelectEvent: (
+ controlID: Integer;
+ pControl: Ptr;
+ on: Boolean
+ );
+ menuEvent: (
+ itemID: Integer;
+ );
+ frmLoadEvent: (
+ formID: Integer
+ );
+ lstEnterEvent: (
+ listID: Integer;
+ pList: Ptr;
+ selection: Integer;
+ );
+ tblSelectEvent: (
+ tableID: Integer;
+ pTable: Ptr;
+ row: Integer;
+ column: Integer;
+ );
+ popSelectEvent: (
+ popControlID: Integer;
+ controlP: Ptr;
+ popListID: Integer;
+ listP: Ptr;
+ popSelection: Integer;
+ priorSelection: Integer;
+ );
+ keyDownEvent: (
+ chr: Integer;
+ keyCode: Integer;
+ modifiers: Integer;
+ );
+ sclEnterEvent, sclExitEvent, sclRepeatEvent: (
+ scrollBarID: Integer;
+ scrollBar: Ptr;
+ value, newValue: Integer;
+ time: LongInt;
+ );
+ end;
+
+ CustomPatternType = array[1..2] of LongInt;
+
+{ ------------- Alm ------------- }
+
+ function AlmGetAlarm (var ref: LongInt; id: LongInt; card: Integer): Longint;
+ syscall SysTrapAlmGetAlarm;
+
+ procedure AlmSetAlarm (quiet: Integer; theSeconds: Longint; ref: LongInt; id: Longint; card: Integer);
+ syscall SysTrapAlmSetAlarm;
+
+{ ------------- Ctl ------------- }
+ function CtlGetLabel (ControlP: Ptr): Ptr;
+ syscall SysTrapCtlGetLabel;
+
+ function CtlGetValue (ControlP: Ptr): Integer;
+ syscall SysTrapCtlGetValue;
+
+ procedure CtlHideControl (ControlP: Ptr);
+ syscall SysTrapCtlHideControl;
+
+ procedure CtlSetLabel (newLabel: Ptr; ControlP: Ptr);
+ syscall SysTrapCtlSetLabel;
+
+ procedure CtlSetUsable (status: Integer; ControlP: Ptr);
+ syscall SysTrapCtlSetUsable;
+
+ procedure CtlSetValue (newValue: Integer; ControlP: Ptr);
+ syscall SysTrapCtlSetValue;
+
+ procedure CtlShowControl (ControlP: Ptr);
+ syscall SysTrapCtlShowControl;
+
+{ ------------- Dm ------------- }
+
+ procedure DmCloseDatabase (db: Ptr);
+ syscall SysTrapDmCloseDatabase;
+
+ function DmCreateDatabase (resDB: Integer; theType, theCreator: OSType; theName: Ptr; cardNo: Integer): Integer;
+ syscall SysTrapDmCreateDatabase;
+
+ function DmDatabaseInfo (theCreator, theType, sortInfoID, appInfoID, modNum, bckUpDate, modDate, crDate, version, attributes, theName: Ptr; dbID: LongInt; cardNo: Integer): Integer;
+ syscall SysTrapDmDatabaseInfo;
+
+ function DmDeleteDatabase (localID: LongInt; cardNo: Integer): Integer;
+ syscall SysTrapDmDeleteDatabase;
+
+ procedure DmDeleteRecord (index: Integer; db: Ptr);
+ syscall SysTrapDmDeleteRecord;
+
+ function DmFindDatabase (theName: Ptr; cardNo: Integer): LongInt;
+ syscall SysTrapDmFindDatabase;
+
+ function DmGetNextDatabaseByTypeCreator (var dbID: LongInt; var cardNo: Integer; onlyLatestVersion: Integer; creator, myType: OSType; stateInfo: DmSearchStateType; newSearch: Integer): Integer;
+ syscall SysTrapDmGetNextDatabaseByTypeCreator;
+
+ function DmGetRecord (index: Integer; db: Ptr): Ptr;
+ syscall SysTrapDmGetRecord;
+
+ function DmGet1Resource (ID: Integer; ResType: OSType): Ptr;
+ syscall SysTrapDmGet1Resource;
+
+ function DmNewRecord (size: Longint; var at: Integer; db: Ptr): Ptr;
+ syscall SysTrapDmNewRecord;
+
+ function DmNumRecords (db: Ptr): Integer;
+ syscall SysTrapDmNumRecords;
+
+ function DmNumRecordsInCategory (category: Integer; db: Ptr): Integer;
+ syscall SysTrapDmNumRecordsInCategory;
+
+ function DmOpenDatabase (mode: Integer; dbID: Ptr; cardNo: Integer): Ptr;
+ syscall SysTrapDmOpenDatabase;
+
+ function DmOpenDatabaseByTypeCreator (mode: Integer; theCreator, theType: OSType): Ptr;
+ syscall SysTrapDmOpenDatabaseByTypeCreator;
+
+{mode=1:read, 2:write; 3:readWrite}
+
+ function DmOpenDatabaseInfo (resDB, cardNo, mode, openCount, dbID, db: Ptr): Integer;
+ syscall SysTrapDmOpenDatabaseInfo;
+
+ function DmQueryNextInCategory (category: Integer; var index: Integer; db: Ptr): Ptr;
+ syscall SysTrapDmQueryNextInCategory;
+
+ function DmQueryRecord (index: Integer; db: Ptr): Ptr;
+ syscall SysTrapDmQueryRecord;
+
+ function DmRecordInfo (localIDP, chunkIDP: Ptr; var attr: Integer; index: Integer; db: Ptr): Integer;
+ syscall SysTrapDmRecordInfo;
+
+ procedure DmReleaseRecord (dirty, index: Integer; db: Ptr);
+ syscall SysTrapDmReleaseRecord;
+
+ procedure DmRemoveRecord (index: Integer; db: Ptr);
+ syscall SysTrapDmRemoveRecord;
+
+ function DmSeekRecordInCategory (Category, Direction, Offset: Integer; var Index: Integer; dbRef: Ptr): Integer;
+ syscall SysTrapDmSeekRecordInCategory;
+
+ function DmSet (byteValue: Integer; bytes, offset: LongInt; recordP: Ptr): Integer;
+ syscall SysTrapDmSet;
+
+ function DmSetDatabaseInfo (theCreator, theType, sortInfoID, appInfoID, modNum, bckUpDate, modDate, crDate, version, attributes, theName: Ptr; dbID: LongInt; cardNo: Integer): Integer;
+ syscall SysTrapDmSetDatabaseInfo;
+
+ function DmSetRecordInfo (localIDP: Ptr; var attr: Integer; index: Integer; db: Ptr): Integer;
+ syscall SysTrapDmSetRecordInfo;
+
+ function DmWrite (bytes: LongInt; src: Ptr; offset: LongInt; recordP: Ptr): Integer;
+ syscall SysTrapDmWrite;
+
+{ ------------- Evt ------------- }
+
+ procedure EvtGetEvent (timeOut: LongInt; var event: EventType);
+ syscall SysTrapEvtGetEvent;
+
+ procedure EvtFlushPenQueue;
+ syscall SysTrapEvtFlushPenQueue;
+
+{ ------------- Fld ------------- }
+
+ procedure FldCopy (fld: Ptr);
+ syscall SysTrapFldCopy;
+
+ procedure FldCut (fld: Ptr);
+ syscall SysTrapFldCut;
+
+ procedure FldDelete (last, first: Integer; fld: Ptr);
+ syscall SysTrapFldDelete;
+
+ procedure FldEraseField (fld: Ptr);
+ syscall SysTrapFldEraseField;
+
+ function FldGetTextHandle (fld: Ptr): Ptr;
+ syscall SysTrapFldGetTextHandle;
+
+ function FldGetTextLength (fld: Ptr): Integer;
+ syscall SysTrapFldGetTextLength;
+
+ function FldGetTextPtr (fld: Ptr): Ptr;
+ syscall SysTrapFldGetTextPtr;
+
+ procedure FldGrabFocus (fld: Ptr);
+ syscall SysTrapFldGrabFocus;
+
+ function FldInsert (insertLen: Integer; insertChars, FieldPtr: Ptr): Integer;
+ syscall SysTrapFldInsert;
+
+ procedure FldPaste (fld: Ptr);
+ syscall SysTrapFldPaste;
+
+ procedure FldSetInsPtPosition (pos: Integer; fld: Ptr);
+ syscall SysTrapFldSetInsPtPosition;
+
+ procedure FldSetTextPtr (textPtr, fld: Ptr);
+ syscall SysTrapFldSetTextPtr;
+
+ procedure FldSetTextHandle (textHandle, fld: Ptr);
+ syscall SysTrapFldSetTextHandle;
+
+ procedure FldSetSelection (endPosition: Integer; startPosition: Integer; fld: Ptr);
+ syscall SysTrapFldSetSelection;
+
+ procedure FldUndo (fld: Ptr);
+ syscall SysTrapFldUndo;
+
+{ ------------- Fnt ------------- }
+
+ procedure FntCharsInWidth (fit, textLen, width, recText: Ptr);
+ syscall SysTrapFntCharsInWidth;
+
+ function FntCharsWidth (theLength: Integer; theString: Ptr): Integer;
+ syscall SysTrapFntCharsWidth;
+
+ function FntDefineFont (fontP: Ptr; FontID: Integer): Integer;
+ syscall SysTrapFntDefineFont;
+
+ function FntSetFont (fontID: Integer): Integer;
+ syscall SysTrapFntSetFont;
+
+{ ------------- Frm ------------- }
+
+ function FrmAlert (alertID: Integer): Integer;
+ syscall SysTrapFrmAlert;
+
+ procedure FrmCloseAllForms;
+ syscall SysTrapFrmCloseAllForms;
+
+ procedure FrmDeleteForm (frm: Ptr);
+ syscall SysTrapFrmDeleteForm;
+
+ procedure FrmDoDialog (theForm: Ptr);
+ syscall SysTrapFrmDoDialog;
+
+ procedure FrmDrawForm (theForm: Ptr);
+ syscall SysTrapFrmDrawForm;
+
+ function FrmGetActiveForm: Ptr;
+ syscall SysTrapFrmGetActiveForm;
+
+ function FrmGetActiveFormID: Integer;
+ syscall SysTrapFrmGetActiveFormID;
+
+ function FrmGetFocus (theForm: Ptr): Integer;
+ syscall sysTrapFrmGetFocus;
+
+ function FrmGetFormPtr (id: Integer): Ptr;
+ syscall SysTrapFrmGetFormPtr;
+
+ function FrmGetObjectID (ObjIndex: Integer; frm: Ptr): Integer;
+ syscall SysTrapFrmGetObjectID;
+
+ function FrmGetObjectIndex (ObjID: Integer; frm: Ptr): Integer;
+ syscall SysTrapFrmGetObjectIndex;
+
+ function FrmGetObjectPtr (ObjIndex: Integer; frm: Ptr): Ptr;
+ syscall SysTrapFrmGetObjectPtr;
+
+ procedure FrmGotoForm (frmID: integer);
+ syscall SysTrapFrmGotoForm;
+
+ function FrmHandleEvent (event: eventType; frm: Ptr): Integer;
+ syscall SysTrapFrmHandleEvent;
+
+ procedure FrmHideObject (objIndex: Integer; frm: Ptr);
+ syscall SysTrapFrmHideObject;
+
+ function FrmInitForm (frmID: integer): Ptr;
+ syscall SysTrapFrmInitForm;
+
+ procedure FrmPopupForm (frmID: integer);
+ syscall SysTrapFrmPopupForm;
+
+ procedure FrmReturnToForm (frmID: integer);
+ syscall SysTrapFrmReturnToForm;
+
+ procedure FrmSetActiveForm (theForm: Ptr);
+ syscall SysTrapFrmSetActiveForm;
+
+ procedure FrmSetFocus (fieldIndex: Integer; frm: Ptr);
+ syscall sysTrapFrmSetFocus;
+
+ procedure FrmShowObject (objIndex: Integer; frm: Ptr);
+ syscall SysTrapFrmShowObject;
+
+{ ------------- Grf ------------- }
+
+ procedure GrfSetState (upperShift, numLock, capsLock: Integer);
+ syscall sysTrapGrfSetState;
+
+{ ------------- Lst ------------- }
+
+ function LstGetSelection (theList: Ptr): Integer;
+ syscall SysTrapLstGetSelection;
+
+ function LstGetSelectionText (itemNum: Integer; theList: Ptr): Ptr;
+ syscall SysTrapLstGetSelectionText;
+
+ procedure LstSetHeight (visibleItems: Integer; theList: Ptr);
+ syscall SysTrapLstSetHeight;
+
+ procedure LstSetListChoices (numItems: Integer; LstArray: Ptr; theList: Ptr);
+ syscall SysTrapLstSetListChoices;
+
+ procedure LstSetPosition (y, x: Integer; theList: Ptr);
+ syscall SysTrapLstSetPosition;
+
+ procedure LstSetSelection (itemNum: Integer; theList: Ptr);
+ syscall SysTrapLstSetSelection;
+
+{ ------------- Mem ------------- }
+
+ function MemHandleLock (h: Ptr): Ptr;
+ syscall SysTrapMemHandleLock;
+
+ function MemHandleNew (size: LongInt): Ptr;
+ syscall SysTrapMemHandleNew;
+
+ function MemHandleResize (size: LongInt; h: Ptr): Integer;
+ syscall SysTrapMemHandleResize;
+
+ procedure MemMove (length: LongInt; source, dest: Ptr);
+ syscall SysTrapMemMove;
+
+ function MemHandleUnLock (h: Ptr): Integer;
+ syscall SysTrapMemHandleUnLock;
+
+ function MemPtrUnlock (p: Ptr): Integer;
+ syscall SysTrapMemPtrUnlock;
+
+{ ------------- Menu ------------- }
+
+ procedure MenuDispose (theMenu: Ptr);
+ syscall SysTrapMenuDispose;
+
+ function MenuGetActiveMenu: Ptr;
+ syscall SysTrapMenuGetActiveMenu;
+
+ procedure MenuEraseStatus (theMenu: Ptr);
+ syscall SysTrapMenuEraseStatus;
+
+ function MenuHandleEvent (var error: Integer; event: eventType; menuP: Ptr): Integer;
+ syscall SysTrapMenuHandleEvent;
+
+ function MenuInit (menuID: Integer): Ptr;
+ syscall SysTrapMenuInit;
+
+ function MenuSetActiveMenu (theMenu: Ptr): Ptr;
+ syscall SysTrapMenuSetActiveMenu;
+
+{ ------------- Pref ------------- }
+
+ procedure PrefGetPreferences (var prefs: SystemPreferencesType);
+ syscall SysTrapPrefGetPreferences;
+
+ function PrefGetAppPreferencesV10 (prefsSize: Integer; prefs: Ptr; version: Integer; Creator: OSType): Integer;
+ syscall SysTrapPrefGetAppPreferencesV10;
+
+ procedure PrefSetAppPreferencesV10 (prefsSize: Integer; prefs: Ptr; version: Integer; Creator: OSType);
+ syscall SysTrapPrefSetAppPreferencesV10;
+
+{ ------------- Scroll ------------- }
+
+ procedure SclDrawScrollBar (theBar: Ptr);
+ syscall sysTrapSclDrawScrollBar;
+
+ function SclHandleEvent (event: eventType; ScrollBar: Ptr): Integer;
+ syscall SysTrapSclHandleEvent;
+
+ procedure SclSetScrollBar (pageSize, max, min, value: Integer; theBar: Ptr);
+ syscall sysTrapSclSetScrollBar;
+
+{ ------------- Snd ------------- }
+
+ procedure SndPlaySystemSound (beepID: Byte);
+ syscall SysTrapSndPlaySystemSound;
+
+{ ------------- Str ------------- }
+
+ procedure StrCopy (s, d: Ptr);
+ syscall SysTrapStrCopy;
+
+ procedure StrIToA (i: Longint; s: Ptr);
+ syscall SysTrapStrIToA;
+
+ function StrLen (s: Ptr): Integer;
+ syscall SysTrapStrLen;
+
+{ ------------- Sys ------------- }
+
+ procedure SysCurAppDatabase (var id: Longint; var card: Integer);
+ syscall SysTrapSysCurAppDatabase;
+
+ function SysFormPointerArrayToStrings (numFields: Integer; p: Ptr): Ptr;
+ syscall SysTrapSysFormPointerArrayToStrings;
+
+ function SysHandleEvent (event: eventType): Integer;
+ syscall SysTrapSysHandleEvent;
+
+ procedure SysKeyboardDialog;
+ syscall SysTrapSysKeyboardDialog;
+
+ function SysUIAppSwitch (cmdPBP: Ptr; cmd: Integer; dbID: LongInt; cardNo: Integer): Integer;
+ syscall SysTrapSysUIAppSwitch;
+
+{ ------------- Tbl ------------- }
+
+ procedure TblDrawTable (table: Ptr);
+ syscall SysTrapTblDrawTable;
+
+ function TblGetItemInt (column, row: Integer; table: Ptr): Integer;
+ syscall SysTrapTblGetItemInt;
+
+ function TblGetNumberOfRows (table: Ptr): Integer;
+ syscall SysTrapTblGetNumberOfRows;
+
+ procedure TblSetColumnUsable (usable, row: Integer; table: Ptr);
+ syscall SysTrapTblSetColumnUsable;
+
+ procedure TblSetItemInt (value, column, row: Integer; table: Ptr);
+ syscall SysTrapTblSetItemInt;
+
+ procedure TblSetItemPtr (thePtr: Ptr; column, row: Integer; table: Ptr);
+ syscall SysTrapTblSetItemPtr;
+
+ procedure TblSetItemStyle (style, column, row: Integer; table: Ptr);
+ syscall SysTrapTblSetItemStyle;
+
+ procedure TblSetRowSelectable (selectable, row: Integer; table: Ptr);
+ syscall SysTrapTblSetRowSelectable;
+
+ procedure TblSetRowUsable (usable, row: Integer; table: Ptr);
+ syscall SysTrapTblSetRowUsable;
+
+{ ------------- Tim ------------- }
+
+ function DaysInMonth (year, month: Integer): Integer;
+ syscall SysTrapDaysInMonth;
+
+ function DayOfWeek (year, day, month: Integer): Integer;
+ syscall SysTrapDayOfWeek;
+
+ function TimDateTimeToSeconds (var dt: DateTimeType): LongInt;
+ syscall SysTrapTimDateTimeToSeconds;
+
+ function TimGetSeconds: LongInt;
+ syscall SysTrapTimGetSeconds;
+
+ procedure TimSetSeconds (theSeconds: LongInt);
+ syscall SysTrapTimSetSeconds;
+
+ procedure TimSecondsToDateTime (var dt: DateTimeType; theSecs: Longint);
+ syscall SysTrapTimSecondsToDateTime;
+
+{ ------------- Win ------------- }
+
+ procedure WinDrawChars (y, x, len: Integer; theString: Ptr);
+ syscall SysTrapWinDrawChars;
+
+ procedure WinDrawGrayRectangleFrame (var theRect: Rectangletype; frameType: Integer);
+ syscall SysTrapWinDrawGrayRectangleFrame;
+
+ procedure WinDrawRectangle (cornerDiam: Integer; var theRect: Rectangletype);
+ syscall SysTrapWinDrawRectangle;
+
+ procedure WinEraseRectangle (corenerDiam: Integer; var theRect: Rectangletype);
+ syscall SysTrapWinEraseRectangle;
+
+ procedure WinFillRectangle (cornerDiam: Integer; var theRect: Rectangletype);
+ syscall SysTrapWinFillRectangle;
+
+ procedure WinSetPattern (var pattern: CustomPatternType);
+ syscall SysTrapWinSetPattern;
+
+
+implementation
+
+end.
+{
+ $Log: pilot.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/readme b/rtl/palmos/readme
new file mode 100644
index 0000000000..196c6b645c
--- /dev/null
+++ b/rtl/palmos/readme
@@ -0,0 +1,7 @@
+This unit contains the run time library for the PalmOS.
+
+Currently, no makefile is available, so you have to create
+the system unit by hand.
+
+The system unit contains only the really necessary declarations
+and the startup code.
diff --git a/rtl/palmos/syspalm.pp b/rtl/palmos/syspalm.pp
new file mode 100644
index 0000000000..4d342eaddd
--- /dev/null
+++ b/rtl/palmos/syspalm.pp
@@ -0,0 +1 @@
+{$i system.pp}
diff --git a/rtl/palmos/system.pp b/rtl/palmos/system.pp
new file mode 100644
index 0000000000..c01bdb4ee9
--- /dev/null
+++ b/rtl/palmos/system.pp
@@ -0,0 +1,119 @@
+{
+ $Id: system.pp,v 1.8 2005/04/03 21:10:59 hajny Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define PALMOS}
+{$ASMMODE DIRECT}
+unit {$ifdef VER1_0}syspalm{$else}system{$endif};
+
+{$I os.inc}
+
+ Interface
+
+{Platform specific information}
+const
+ LineEnding = #10;
+ LFNSupport = false;
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+ FileNameCaseSensitive = false;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+ maxExitCode = 255; {$ERROR TODO: CONFIRM THIS}
+
+ Type
+ { type and constant declartions doesn't hurt }
+ LongInt = $80000000..$7fffffff;
+ Integer = -32768..32767;
+ ShortInt = -128..127;
+ Byte = 0..255;
+ Word = 0..65535;
+
+ { !!!!
+ DWord = Cardinal;
+ LongWord = Cardinal;
+ }
+
+ { The Cardinal data type isn't currently implemented for the m68k }
+ DWord = LongInt;
+ LongWord = LongInt;
+
+ { Zero - terminated strings }
+ PChar = ^Char;
+ PPChar = ^PChar;
+
+ { procedure type }
+ TProcedure = Procedure;
+
+ const
+ { max. values for longint and int }
+ MaxLongint = High(LongInt);
+ MaxInt = High(Integer);
+
+ { Must be determined at startup for both }
+ Test68000 : byte = 0;
+ Test68881 : byte = 0;
+
+ { Palm specific data types }
+ type
+ Ptr = ^Char;
+
+ var
+ ExitCode : DWord;
+ { this variables are passed to PilotMain by the PalmOS }
+ cmd : Word;
+ cmdPBP : Ptr;
+ launchFlags : Word;
+
+ implementation
+
+ { mimic the C start code }
+ function PilotMain(_cmd : Word;_cmdPBP : Ptr;_launchFlags : Word) : DWord;cdecl;public;
+
+ begin
+ cmd:=_cmd;
+ cmdPBP:=_cmdPBP;
+ launchFlags:=_launchFlags;
+ asm
+ bsr PASCALMAIN
+ end;
+ PilotMain:=ExitCode;
+ end;
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+Procedure system_exit;
+begin
+end;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := 1;
+end;
+
+begin
+ ExitCode:=0;
+end.
+
+{
+ $Log: system.pp,v $
+ Revision 1.8 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/palmos/systraps.pp b/rtl/palmos/systraps.pp
new file mode 100644
index 0000000000..6a472777d6
--- /dev/null
+++ b/rtl/palmos/systraps.pp
@@ -0,0 +1,866 @@
+{ $Id: systraps.pp,v 1.4 2005/02/14 17:13:31 peter Exp $
+ adapted for use with Free Pascal by Florian Klaempfl
+}
+{ -------------------------------------------------- }
+{ Copyright 1999-2000 by H.M. Swartjes }
+{ Part of project Leave, release 17-8-98 }
+
+unit SysTraps;
+
+interface
+ const
+ sysTrapMemInit = $A000;
+ sysTrapMemInitHeapTable = $A001;
+ sysTrapMemStoreInit = $A002;
+ sysTrapMemCardFormat = $A003;
+ sysTrapMemCardInfo = $A004;
+ sysTrapMemStoreInfo = $A005;
+ sysTrapMemStoreSetInfo = $A006;
+ sysTrapMemNumHeaps = $A007;
+ sysTrapMemNumRAMHeaps = $A008;
+ sysTrapMemHeapID = $A009;
+ sysTrapMemHeapPtr = $A00A;
+ sysTrapMemHeapFreeBytes = $A00B;
+ sysTrapMemHeapSize = $A00C;
+ sysTrapMemHeapFlags = $A00D;
+ sysTrapMemHeapCompact = $A00E;
+ sysTrapMemHeapInit = $A00F;
+ sysTrapMemHeapFreeByOwnerID = $A010;
+ sysTrapMemChunkNew = $A011;
+ sysTrapMemChunkFree = $A012;
+ sysTrapMemPtrNew = $A013;
+ sysTrapMemPtrRecoverHandle = $A014;
+ sysTrapMemPtrFlags = $A015;
+ sysTrapMemPtrSize = $A016;
+ sysTrapMemPtrOwner = $A017;
+ sysTrapMemPtrHeapID = $A018;
+ sysTrapMemPtrCardNo = $A019;
+ sysTrapMemPtrToLocalID = $A01A;
+ sysTrapMemPtrSetOwner = $A01B;
+ sysTrapMemPtrResize = $A01C;
+ sysTrapMemPtrResetLock = $A01D;
+ sysTrapMemHandleNew = $A01E;
+ sysTrapMemHandleLockCount = $A01F;
+ sysTrapMemHandleToLocalID = $A020;
+ sysTrapMemHandleLock = $A021;
+ sysTrapMemHandleUnlock = $A022;
+ sysTrapMemLocalIDToGlobal = $A023;
+ sysTrapMemLocalIDKind = $A024;
+ sysTrapMemLocalIDToPtr = $A025;
+ sysTrapMemMove = $A026;
+ sysTrapMemSet = $A027;
+ sysTrapMemStoreSearch = $A028;
+ sysTrapMemPtrDataStorage = $A029;
+ sysTrapMemKernelInit = $A02A;
+ sysTrapMemHandleFree = $A02B;
+ sysTrapMemHandleFlags = $A02C;
+ sysTrapMemHandleSize = $A02D;
+ sysTrapMemHandleOwner = $A02E;
+ sysTrapMemHandleHeapID = $A02F;
+ sysTrapMemHandleDataStorage = $A030;
+ sysTrapMemHandleCardNo = $A031;
+ sysTrapMemHandleSetOwner = $A032;
+ sysTrapMemHandleResize = $A033;
+ sysTrapMemHandleResetLock = $A034;
+ sysTrapMemPtrUnlock = $A035;
+ sysTrapMemLocalIDToLockedPtr = $A036;
+ sysTrapMemSetDebugMode = $A037;
+ sysTrapMemHeapScramble = $A038;
+ sysTrapMemHeapCheck = $A039;
+ sysTrapMemNumCards = $A03A;
+ sysTrapMemDebugMode = $A03B;
+ sysTrapMemSemaphoreReserve = $A03C;
+ sysTrapMemSemaphoreRelease = $A03D;
+ sysTrapMemHeapDynamic = $A03E;
+ sysTrapMemNVParams = $A03F;
+ sysTrapDmInit = $A040;
+ sysTrapDmCreateDatabase = $A041;
+ sysTrapDmDeleteDatabase = $A042;
+ sysTrapDmNumDatabases = $A043;
+ sysTrapDmGetDatabase = $A044;
+ sysTrapDmFindDatabase = $A045;
+ sysTrapDmDatabaseInfo = $A046;
+ sysTrapDmSetDatabaseInfo = $A047;
+ sysTrapDmDatabaseSize = $A048;
+ sysTrapDmOpenDatabase = $A049;
+ sysTrapDmCloseDatabase = $A04A;
+ sysTrapDmNextOpenDatabase = $A04B;
+ sysTrapDmOpenDatabaseInfo = $A04C;
+ sysTrapDmResetRecordStates = $A04D;
+ sysTrapDmGetLastErr = $A04E;
+ sysTrapDmNumRecords = $A04F;
+ sysTrapDmRecordInfo = $A050;
+ sysTrapDmSetRecordInfo = $A051;
+ sysTrapDmAttachRecord = $A052;
+ sysTrapDmDetachRecord = $A053;
+ sysTrapDmMoveRecord = $A054;
+ sysTrapDmNewRecord = $A055;
+ sysTrapDmRemoveRecord = $A056;
+ sysTrapDmDeleteRecord = $A057;
+ sysTrapDmArchiveRecord = $A058;
+ sysTrapDmNewHandle = $A059;
+ sysTrapDmRemoveSecretRecords = $A05A;
+ sysTrapDmQueryRecord = $A05B;
+ sysTrapDmGetRecord = $A05C;
+ sysTrapDmResizeRecord = $A05D;
+ sysTrapDmReleaseRecord = $A05E;
+ sysTrapDmGetResource = $A05F;
+ sysTrapDmGet1Resource = $A060;
+ sysTrapDmReleaseResource = $A061;
+ sysTrapDmResizeResource = $A062;
+ sysTrapDmNextOpenResDatabase = $A063;
+ sysTrapDmFindResourceType = $A064;
+ sysTrapDmFindResource = $A065;
+ sysTrapDmSearchResource = $A066;
+ sysTrapDmNumResources = $A067;
+ sysTrapDmResourceInfo = $A068;
+ sysTrapDmSetResourceInfo = $A069;
+ sysTrapDmAttachResource = $A06A;
+ sysTrapDmDetachResource = $A06B;
+ sysTrapDmNewResource = $A06C;
+ sysTrapDmRemoveResource = $A06D;
+ sysTrapDmGetResourceIndex = $A06E;
+ sysTrapDmQuickSort = $A06F;
+ sysTrapDmQueryNextInCategory = $A070;
+ sysTrapDmNumRecordsInCategory = $A071;
+ sysTrapDmPositionInCategory = $A072;
+ sysTrapDmSeekRecordInCategory = $A073;
+ sysTrapDmMoveCategory = $A074;
+ sysTrapDmOpenDatabaseByTypeCreator = $A075;
+ sysTrapDmWrite = $A076;
+ sysTrapDmStrCopy = $A077;
+ sysTrapDmGetNextDatabaseByTypeCreator = $A078;
+ sysTrapDmWriteCheck = $A079;
+ sysTrapDmMoveOpenDBContext = $A07A;
+ sysTrapDmFindRecordByID = $A07B;
+ sysTrapDmGetAppInfoID = $A07C;
+ sysTrapDmFindSortPositionV10 = $A07D;
+ sysTrapDmSet = $A07E;
+ sysTrapDmCreateDatabaseFromImage = $A07F;
+ sysTrapDbgSrcMessage = $A080;
+ sysTrapDbgMessage = $A081;
+ sysTrapDbgGetMessage = $A082;
+ sysTrapDbgCommSettings = $A083;
+ sysTrapErrDisplayFileLineMsg = $A084;
+ sysTrapErrSetJump = $A085;
+ sysTrapErrLongJump = $A086;
+ sysTrapErrThrow = $A087;
+ sysTrapErrExceptionList = $A088;
+ sysTrapSysBroadcastActionCode = $A089;
+ sysTrapSysUnimplemented = $A08A;
+ sysTrapSysColdBoot = $A08B;
+ sysTrapSysReset = $A08C;
+ sysTrapSysDoze = $A08D;
+ sysTrapSysAppLaunch = $A08E;
+ sysTrapSysAppStartup = $A08F;
+ sysTrapSysAppExit = $A090;
+ sysTrapSysSetA5 = $A091;
+ sysTrapSysSetTrapAddress = $A092;
+ sysTrapSysGetTrapAddress = $A093;
+ sysTrapSysTranslateKernelErr = $A094;
+ sysTrapSysSemaphoreCreate = $A095;
+ sysTrapSysSemaphoreDelete = $A096;
+ sysTrapSysSemaphoreWait = $A097;
+ sysTrapSysSemaphoreSignal = $A098;
+ sysTrapSysTimerCreate = $A099;
+ sysTrapSysTimerWrite = $A09A;
+ sysTrapSysTaskCreate = $A09B;
+ sysTrapSysTaskDelete = $A09C;
+ sysTrapSysTaskTrigger = $A09D;
+ sysTrapSysTaskID = $A09E;
+ sysTrapSysTaskUserInfoPtr = $A09F;
+ sysTrapSysTaskDelay = $A0A0;
+ sysTrapSysTaskSetTermProc = $A0A1;
+ sysTrapSysUILaunch = $A0A2;
+ sysTrapSysNewOwnerID = $A0A3;
+ sysTrapSysSemaphoreSet = $A0A4;
+ sysTrapSysDisableInts = $A0A5;
+ sysTrapSysRestoreStatus = $A0A6;
+ sysTrapSysUIAppSwitch = $A0A7;
+ sysTrapSysCurAppInfoPV20 = $A0A8;
+ sysTrapSysHandleEvent = $A0A9;
+ sysTrapSysInit = $A0AA;
+ sysTrapSysQSort = $A0AB;
+ sysTrapSysCurAppDatabase = $A0AC;
+ sysTrapSysFatalAlert = $A0AD;
+ sysTrapSysResSemaphoreCreate = $A0AE;
+ sysTrapSysResSemaphoreDelete = $A0AF;
+ sysTrapSysResSemaphoreReserve = $A0B0;
+ sysTrapSysResSemaphoreRelease = $A0B1;
+ sysTrapSysSleep = $A0B2;
+ sysTrapSysKeyboardDialogV10 = $A0B3;
+ sysTrapSysAppLauncherDialog = $A0B4;
+ sysTrapSysSetPerformance = $A0B5;
+ sysTrapSysBatteryInfoV20 = $A0B6;
+ sysTrapSysLibInstall = $A0B7;
+ sysTrapSysLibRemove = $A0B8;
+ sysTrapSysLibTblEntry = $A0B9;
+ sysTrapSysLibFind = $A0BA;
+ sysTrapSysBatteryDialog = $A0BB;
+ sysTrapSysCopyStringResource = $A0BC;
+ sysTrapSysKernelInfo = $A0BD;
+ sysTrapSysLaunchConsole = $A0BE;
+ sysTrapSysTimerDelete = $A0BF;
+ sysTrapSysSetAutoOffTime = $A0C0;
+ sysTrapSysFormPointerArrayToStrings = $A0C1;
+ sysTrapSysRandom = $A0C2;
+ sysTrapSysTaskSwitching = $A0C3;
+ sysTrapSysTimerRead = $A0C4;
+ sysTrapStrCopy = $A0C5;
+ sysTrapStrCat = $A0C6;
+ sysTrapStrLen = $A0C7;
+ sysTrapStrCompare = $A0C8;
+ sysTrapStrIToA = $A0C9;
+ sysTrapStrCaselessCompare = $A0CA;
+ sysTrapStrIToH = $A0CB;
+ sysTrapStrChr = $A0CC;
+ sysTrapStrStr = $A0CD;
+ sysTrapStrAToI = $A0CE;
+ sysTrapStrToLower = $A0CF;
+ sysTrapSerReceiveISP = $A0D0;
+ sysTrapSlkOpen = $A0D1;
+ sysTrapSlkClose = $A0D2;
+ sysTrapSlkOpenSocket = $A0D3;
+ sysTrapSlkCloseSocket = $A0D4;
+ sysTrapSlkSocketRefNum = $A0D5;
+ sysTrapSlkSocketSetTimeout = $A0D6;
+ sysTrapSlkFlushSocket = $A0D7;
+ sysTrapSlkSetSocketListener = $A0D8;
+ sysTrapSlkSendPacket = $A0D9;
+ sysTrapSlkReceivePacket = $A0DA;
+ sysTrapSlkSysPktDefaultResponse = $A0DB;
+ sysTrapSlkProcessRPC = $A0DC;
+ sysTrapConPutS = $A0DD;
+ sysTrapConGetS = $A0DE;
+ sysTrapFplInit = $A0DF;
+ sysTrapFplFree = $A0E0;
+ sysTrapFplFToA = $A0E1;
+ sysTrapFplAToF = $A0E2;
+ sysTrapFplBase10Info = $A0E3;
+ sysTrapFplLongToFloat = $A0E4;
+ sysTrapFplFloatToLong = $A0E5;
+ sysTrapFplFloatToULong = $A0E6;
+ sysTrapFplMul = $A0E7;
+ sysTrapFplAdd = $A0E8;
+ sysTrapFplSub = $A0E9;
+ sysTrapFplDiv = $A0EA;
+ sysTrapScrInit = $A0EB;
+ sysTrapScrCopyRectangle = $A0EC;
+ sysTrapScrDrawChars = $A0ED;
+ sysTrapScrLineRoutine = $A0EE;
+ sysTrapScrRectangleRoutine = $A0EF;
+ sysTrapScrScreenInfo = $A0F0;
+ sysTrapScrDrawNotify = $A0F1;
+ sysTrapScrSendUpdateArea = $A0F2;
+ sysTrapScrCompressScanLine = $A0F3;
+ sysTrapScrDeCompressScanLine = $A0F4;
+ sysTrapTimGetSeconds = $A0F5;
+ sysTrapTimSetSeconds = $A0F6;
+ sysTrapTimGetTicks = $A0F7;
+ sysTrapTimInit = $A0F8;
+ sysTrapTimSetAlarm = $A0F9;
+ sysTrapTimGetAlarm = $A0FA;
+ sysTrapTimHandleInterrupt = $A0FB;
+ sysTrapTimSecondsToDateTime = $A0FC;
+ sysTrapTimDateTimeToSeconds = $A0FD;
+ sysTrapTimAdjust = $A0FE;
+ sysTrapTimSleep = $A0FF;
+ sysTrapTimWake = $A100;
+ sysTrapCategoryCreateListV10 = $A101;
+ sysTrapCategoryFreeListV10 = $A102;
+ sysTrapCategoryFind = $A103;
+ sysTrapCategoryGetName = $A104;
+ sysTrapCategoryEditV10 = $A105;
+ sysTrapCategorySelectV10 = $A106;
+ sysTrapCategoryGetNext = $A107;
+ sysTrapCategorySetTriggerLabel = $A108;
+ sysTrapCategoryTruncateName = $A109;
+ sysTrapClipboardAddItem = $A10A;
+ sysTrapClipboardCheckIfItemExist = $A10B;
+ sysTrapClipboardGetItem = $A10C;
+ sysTrapCtlDrawControl = $A10D;
+ sysTrapCtlEraseControl = $A10E;
+ sysTrapCtlHideControl = $A10F;
+ sysTrapCtlShowControl = $A110;
+ sysTrapCtlGetValue = $A111;
+ sysTrapCtlSetValue = $A112;
+ sysTrapCtlGetLabel = $A113;
+ sysTrapCtlSetLabel = $A114;
+ sysTrapCtlHandleEvent = $A115;
+ sysTrapCtlHitControl = $A116;
+ sysTrapCtlSetEnabled = $A117;
+ sysTrapCtlSetUsable = $A118;
+ sysTrapCtlEnabled = $A119;
+ sysTrapEvtInitialize = $A11A;
+ sysTrapEvtAddEventToQueue = $A11B;
+ sysTrapEvtCopyEvent = $A11C;
+ sysTrapEvtGetEvent = $A11D;
+ sysTrapEvtGetPen = $A11E;
+ sysTrapEvtSysInit = $A11F;
+ sysTrapEvtGetSysEvent = $A120;
+ sysTrapEvtProcessSoftKeyStroke = $A121;
+ sysTrapEvtGetPenBtnList = $A122;
+ sysTrapEvtSetPenQueuePtr = $A123;
+ sysTrapEvtPenQueueSize = $A124;
+ sysTrapEvtFlushPenQueue = $A125;
+ sysTrapEvtEnqueuePenPoint = $A126;
+ sysTrapEvtDequeuePenStrokeInfo = $A127;
+ sysTrapEvtDequeuePenPoint = $A128;
+ sysTrapEvtFlushNextPenStroke = $A129;
+ sysTrapEvtSetKeyQueuePtr = $A12A;
+ sysTrapEvtKeyQueueSize = $A12B;
+ sysTrapEvtFlushKeyQueue = $A12C;
+ sysTrapEvtEnqueueKey = $A12D;
+ sysTrapEvtDequeueKeyEvent = $A12E;
+ sysTrapEvtWakeup = $A12F;
+ sysTrapEvtResetAutoOffTimer = $A130;
+ sysTrapEvtKeyQueueEmpty = $A131;
+ sysTrapEvtEnableGraffiti = $A132;
+ sysTrapFldCopy = $A133;
+ sysTrapFldCut = $A134;
+ sysTrapFldDrawField = $A135;
+ sysTrapFldEraseField = $A136;
+ sysTrapFldFreeMemory = $A137;
+ sysTrapFldGetBounds = $A138;
+ sysTrapFldGetTextPtr = $A139;
+ sysTrapFldGetSelection = $A13A;
+ sysTrapFldHandleEvent = $A13B;
+ sysTrapFldPaste = $A13C;
+ sysTrapFldRecalculateField = $A13D;
+ sysTrapFldSetBounds = $A13E;
+ sysTrapFldSetText = $A13F;
+ sysTrapFldGetFont = $A140;
+ sysTrapFldSetFont = $A141;
+ sysTrapFldSetSelection = $A142;
+ sysTrapFldGrabFocus = $A143;
+ sysTrapFldReleaseFocus = $A144;
+ sysTrapFldGetInsPtPosition = $A145;
+ sysTrapFldSetInsPtPosition = $A146;
+ sysTrapFldSetScrollPosition = $A147;
+ sysTrapFldGetScrollPosition = $A148;
+ sysTrapFldGetTextHeight = $A149;
+ sysTrapFldGetTextAllocatedSize = $A14A;
+ sysTrapFldGetTextLength = $A14B;
+ sysTrapFldScrollField = $A14C;
+ sysTrapFldScrollable = $A14D;
+ sysTrapFldGetVisibleLines = $A14E;
+ sysTrapFldGetAttributes = $A14F;
+ sysTrapFldSetAttributes = $A150;
+ sysTrapFldSendChangeNotification = $A151;
+ sysTrapFldCalcFieldHeight = $A152;
+ sysTrapFldGetTextHandle = $A153;
+ sysTrapFldCompactText = $A154;
+ sysTrapFldDirty = $A155;
+ sysTrapFldWordWrap = $A156;
+ sysTrapFldSetTextAllocatedSize = $A157;
+ sysTrapFldSetTextHandle = $A158;
+ sysTrapFldSetTextPtr = $A159;
+ sysTrapFldGetMaxChars = $A15A;
+ sysTrapFldSetMaxChars = $A15B;
+ sysTrapFldSetUsable = $A15C;
+ sysTrapFldInsert = $A15D;
+ sysTrapFldDelete = $A15E;
+ sysTrapFldUndo = $A15F;
+ sysTrapFldSetDirty = $A160;
+ sysTrapFldSendHeightChangeNotification = $A161;
+ sysTrapFldMakeFullyVisible = $A162;
+ sysTrapFntGetFont = $A163;
+ sysTrapFntSetFont = $A164;
+ sysTrapFntGetFontPtr = $A165;
+ sysTrapFntBaseLine = $A166;
+ sysTrapFntCharHeight = $A167;
+ sysTrapFntLineHeight = $A168;
+ sysTrapFntAverageCharWidth = $A169;
+ sysTrapFntCharWidth = $A16A;
+ sysTrapFntCharsWidth = $A16B;
+ sysTrapFntDescenderHeight = $A16C;
+ sysTrapFntCharsInWidth = $A16D;
+ sysTrapFntLineWidth = $A16E;
+ sysTrapFrmInitForm = $A16F;
+ sysTrapFrmDeleteForm = $A170;
+ sysTrapFrmDrawForm = $A171;
+ sysTrapFrmEraseForm = $A172;
+ sysTrapFrmGetActiveForm = $A173;
+ sysTrapFrmSetActiveForm = $A174;
+ sysTrapFrmGetActiveFormID = $A175;
+ sysTrapFrmGetUserModifiedState = $A176;
+ sysTrapFrmSetNotUserModified = $A177;
+ sysTrapFrmGetFocus = $A178;
+ sysTrapFrmSetFocus = $A179;
+ sysTrapFrmHandleEvent = $A17A;
+ sysTrapFrmGetFormBounds = $A17B;
+ sysTrapFrmGetWindowHandle = $A17C;
+ sysTrapFrmGetFormId = $A17D;
+ sysTrapFrmGetFormPtr = $A17E;
+ sysTrapFrmGetNumberOfObjects = $A17F;
+ sysTrapFrmGetObjectIndex = $A180;
+ sysTrapFrmGetObjectId = $A181;
+ sysTrapFrmGetObjectType = $A182;
+ sysTrapFrmGetObjectPtr = $A183;
+ sysTrapFrmHideObject = $A184;
+ sysTrapFrmShowObject = $A185;
+ sysTrapFrmGetObjectPosition = $A186;
+ sysTrapFrmSetObjectPosition = $A187;
+ sysTrapFrmGetControlValue = $A188;
+ sysTrapFrmSetControlValue = $A189;
+ sysTrapFrmGetControlGroupSelection = $A18A;
+ sysTrapFrmSetControlGroupSelection = $A18B;
+ sysTrapFrmCopyLabel = $A18C;
+ sysTrapFrmSetLabel = $A18D;
+ sysTrapFrmGetLabel = $A18E;
+ sysTrapFrmSetCategoryLabel = $A18F;
+ sysTrapFrmGetTitle = $A190;
+ sysTrapFrmSetTitle = $A191;
+ sysTrapFrmAlert = $A192;
+ sysTrapFrmDoDialog = $A193;
+ sysTrapFrmCustomAlert = $A194;
+ sysTrapFrmHelp = $A195;
+ sysTrapFrmUpdateScrollers = $A196;
+ sysTrapFrmGetFirstForm = $A197;
+ sysTrapFrmVisible = $A198;
+ sysTrapFrmGetObjectBounds = $A199;
+ sysTrapFrmCopyTitle = $A19A;
+ sysTrapFrmGotoForm = $A19B;
+ sysTrapFrmPopupForm = $A19C;
+ sysTrapFrmUpdateForm = $A19D;
+ sysTrapFrmReturnToForm = $A19E;
+ sysTrapFrmSetEventHandler = $A19F;
+ sysTrapFrmDispatchEvent = $A1A0;
+ sysTrapFrmCloseAllForms = $A1A1;
+ sysTrapFrmSaveAllForms = $A1A2;
+ sysTrapFrmGetGadgetData = $A1A3;
+ sysTrapFrmSetGadgetData = $A1A4;
+ sysTrapFrmSetCategoryTrigger = $A1A5;
+ sysTrapUIInitialize = $A1A6;
+ sysTrapUIReset = $A1A7;
+ sysTrapInsPtInitialize = $A1A8;
+ sysTrapInsPtSetLocation = $A1A9;
+ sysTrapInsPtGetLocation = $A1AA;
+ sysTrapInsPtEnable = $A1AB;
+ sysTrapInsPtEnabled = $A1AC;
+ sysTrapInsPtSetHeight = $A1AD;
+ sysTrapInsPtGetHeight = $A1AE;
+ sysTrapInsPtCheckBlink = $A1AF;
+ sysTrapLstSetDrawFunction = $A1B0;
+ sysTrapLstDrawList = $A1B1;
+ sysTrapLstEraseList = $A1B2;
+ sysTrapLstGetSelection = $A1B3;
+ sysTrapLstGetSelectionText = $A1B4;
+ sysTrapLstHandleEvent = $A1B5;
+ sysTrapLstSetHeight = $A1B6;
+ sysTrapLstSetSelection = $A1B7;
+ sysTrapLstSetListChoices = $A1B8;
+ sysTrapLstMakeItemVisible = $A1B9;
+ sysTrapLstGetNumberOfItems = $A1BA;
+ sysTrapLstPopupList = $A1BB;
+ sysTrapLstSetPosition = $A1BC;
+ sysTrapMenuInit = $A1BD;
+ sysTrapMenuDispose = $A1BE;
+ sysTrapMenuHandleEvent = $A1BF;
+ sysTrapMenuDrawMenu = $A1C0;
+ sysTrapMenuEraseStatus = $A1C1;
+ sysTrapMenuGetActiveMenu = $A1C2;
+ sysTrapMenuSetActiveMenu = $A1C3;
+ sysTrapRctSetRectangle = $A1C4;
+ sysTrapRctCopyRectangle = $A1C5;
+ sysTrapRctInsetRectangle = $A1C6;
+ sysTrapRctOffsetRectangle = $A1C7;
+ sysTrapRctPtInRectangle = $A1C8;
+ sysTrapRctGetIntersection = $A1C9;
+ sysTrapTblDrawTable = $A1CA;
+ sysTrapTblEraseTable = $A1CB;
+ sysTrapTblHandleEvent = $A1CC;
+ sysTrapTblGetItemBounds = $A1CD;
+ sysTrapTblSelectItem = $A1CE;
+ sysTrapTblGetItemInt = $A1CF;
+ sysTrapTblSetItemInt = $A1D0;
+ sysTrapTblSetItemStyle = $A1D1;
+ sysTrapTblUnhighlightSelection = $A1D2;
+ sysTrapTblSetRowUsable = $A1D3;
+ sysTrapTblGetNumberOfRows = $A1D4;
+ sysTrapTblSetCustomDrawProcedure = $A1D5;
+ sysTrapTblSetRowSelectable = $A1D6;
+ sysTrapTblRowSelectable = $A1D7;
+ sysTrapTblSetLoadDataProcedure = $A1D8;
+ sysTrapTblSetSaveDataProcedure = $A1D9;
+ sysTrapTblGetBounds = $A1DA;
+ sysTrapTblSetRowHeight = $A1DB;
+ sysTrapTblGetColumnWidth = $A1DC;
+ sysTrapTblGetRowID = $A1DD;
+ sysTrapTblSetRowID = $A1DE;
+ sysTrapTblMarkRowInvalid = $A1DF;
+ sysTrapTblMarkTableInvalid = $A1E0;
+ sysTrapTblGetSelection = $A1E1;
+ sysTrapTblInsertRow = $A1E2;
+ sysTrapTblRemoveRow = $A1E3;
+ sysTrapTblRowInvalid = $A1E4;
+ sysTrapTblRedrawTable = $A1E5;
+ sysTrapTblRowUsable = $A1E6;
+ sysTrapTblReleaseFocus = $A1E7;
+ sysTrapTblEditing = $A1E8;
+ sysTrapTblGetCurrentField = $A1E9;
+ sysTrapTblSetColumnUsable = $A1EA;
+ sysTrapTblGetRowHeight = $A1EB;
+ sysTrapTblSetColumnWidth = $A1EC;
+ sysTrapTblGrabFocus = $A1ED;
+ sysTrapTblSetItemPtr = $A1EE;
+ sysTrapTblFindRowID = $A1EF;
+ sysTrapTblGetLastUsableRow = $A1F0;
+ sysTrapTblGetColumnSpacing = $A1F1;
+ sysTrapTblFindRowData = $A1F2;
+ sysTrapTblGetRowData = $A1F3;
+ sysTrapTblSetRowData = $A1F4;
+ sysTrapTblSetColumnSpacing = $A1F5;
+ sysTrapWinCreateWindow = $A1F6;
+ sysTrapWinCreateOffscreenWindow = $A1F7;
+ sysTrapWinDeleteWindow = $A1F8;
+ sysTrapWinInitializeWindow = $A1F9;
+ sysTrapWinAddWindow = $A1FA;
+ sysTrapWinRemoveWindow = $A1FB;
+ sysTrapWinSetActiveWindow = $A1FC;
+ sysTrapWinSetDrawWindow = $A1FD;
+ sysTrapWinGetDrawWindow = $A1FE;
+ sysTrapWinGetActiveWindow = $A1FF;
+ sysTrapWinGetDisplayWindow = $A200;
+ sysTrapWinGetFirstWindow = $A201;
+ sysTrapWinEnableWindow = $A202;
+ sysTrapWinDisableWindow = $A203;
+ sysTrapWinGetWindowFrameRect = $A204;
+ sysTrapWinDrawWindowFrame = $A205;
+ sysTrapWinEraseWindow = $A206;
+ sysTrapWinSaveBits = $A207;
+ sysTrapWinRestoreBits = $A208;
+ sysTrapWinCopyRectangle = $A209;
+ sysTrapWinScrollRectangle = $A20A;
+ sysTrapWinGetDisplayExtent = $A20B;
+ sysTrapWinGetWindowExtent = $A20C;
+ sysTrapWinDisplayToWindowPt = $A20D;
+ sysTrapWinWindowToDisplayPt = $A20E;
+ sysTrapWinGetClip = $A20F;
+ sysTrapWinSetClip = $A210;
+ sysTrapWinResetClip = $A211;
+ sysTrapWinClipRectangle = $A212;
+ sysTrapWinDrawLine = $A213;
+ sysTrapWinDrawGrayLine = $A214;
+ sysTrapWinEraseLine = $A215;
+ sysTrapWinInvertLine = $A216;
+ sysTrapWinFillLine = $A217;
+ sysTrapWinDrawRectangle = $A218;
+ sysTrapWinEraseRectangle = $A219;
+ sysTrapWinInvertRectangle = $A21A;
+ sysTrapWinDrawRectangleFrame = $A21B;
+ sysTrapWinDrawGrayRectangleFrame = $A21C;
+ sysTrapWinEraseRectangleFrame = $A21D;
+ sysTrapWinInvertRectangleFrame = $A21E;
+ sysTrapWinGetFramesRectangle = $A21F;
+ sysTrapWinDrawChars = $A220;
+ sysTrapWinEraseChars = $A221;
+ sysTrapWinInvertChars = $A222;
+ sysTrapWinGetPattern = $A223;
+ sysTrapWinSetPattern = $A224;
+ sysTrapWinSetUnderlineMode = $A225;
+ sysTrapWinDrawBitmap = $A226;
+ sysTrapWinModal = $A227;
+ sysTrapWinGetWindowBounds = $A228;
+ sysTrapWinFillRectangle = $A229;
+ sysTrapWinDrawInvertedChars = $A22A;
+ sysTrapPrefOpenPreferenceDBV10 = $A22B;
+ sysTrapPrefGetPreferences = $A22C;
+ sysTrapPrefSetPreferences = $A22D;
+ sysTrapPrefGetAppPreferencesV10 = $A22E;
+ sysTrapPrefSetAppPreferencesV10 = $A22F;
+ sysTrapSndInit = $A230;
+ sysTrapSndSetDefaultVolume = $A231;
+ sysTrapSndGetDefaultVolume = $A232;
+ sysTrapSndDoCmd = $A233;
+ sysTrapSndPlaySystemSound = $A234;
+ sysTrapAlmInit = $A235;
+ sysTrapAlmCancelAll = $A236;
+ sysTrapAlmAlarmCallback = $A237;
+ sysTrapAlmSetAlarm = $A238;
+ sysTrapAlmGetAlarm = $A239;
+ sysTrapAlmDisplayAlarm = $A23A;
+ sysTrapAlmEnableNotification = $A23B;
+ sysTrapHwrGetRAMMapping = $A23C;
+ sysTrapHwrMemWritable = $A23D;
+ sysTrapHwrMemReadable = $A23E;
+ sysTrapHwrDoze = $A23F;
+ sysTrapHwrSleep = $A240;
+ sysTrapHwrWake = $A241;
+ sysTrapHwrSetSystemClock = $A242;
+ sysTrapHwrSetCPUDutyCycle = $A243;
+ sysTrapHwrLCDInit = $A244;
+ sysTrapHwrLCDSleep = $A245;
+ sysTrapHwrTimerInit = $A246;
+ sysTrapHwrCursor = $A247;
+ sysTrapHwrBatteryLevel = $A248;
+ sysTrapHwrDelay = $A249;
+ sysTrapHwrEnableDataWrites = $A24A;
+ sysTrapHwrDisableDataWrites = $A24B;
+ sysTrapHwrLCDBaseAddr = $A24C;
+ sysTrapHwrLCDDrawBitmap = $A24D;
+ sysTrapHwrTimerSleep = $A24E;
+ sysTrapHwrTimerWake = $A24F;
+ sysTrapHwrLCDWake = $A250;
+ sysTrapHwrIRQ1Handler = $A251;
+ sysTrapHwrIRQ2Handler = $A252;
+ sysTrapHwrIRQ3Handler = $A253;
+ sysTrapHwrIRQ4Handler = $A254;
+ sysTrapHwrIRQ5Handler = $A255;
+ sysTrapHwrIRQ6Handler = $A256;
+ sysTrapHwrDockSignals = $A257;
+ sysTrapHwrPluggedIn = $A258;
+ sysTrapCrc16CalcBlock = $A259;
+ sysTrapSelectDayV10 = $A25A;
+ sysTrapSelectTime = $A25B;
+ sysTrapDayDrawDaySelector = $A25C;
+ sysTrapDayHandleEvent = $A25D;
+ sysTrapDayDrawDays = $A25E;
+ sysTrapDayOfWeek = $A25F;
+ sysTrapDaysInMonth = $A260;
+ sysTrapDayOfMonth = $A261;
+ sysTrapDateDaysToDate = $A262;
+ sysTrapDateToDays = $A263;
+ sysTrapDateAdjust = $A264;
+ sysTrapDateSecondsToDate = $A265;
+ sysTrapDateToAscii = $A266;
+ sysTrapDateToDOWDMFormat = $A267;
+ sysTrapTimeToAscii = $A268;
+ sysTrapFind = $A269;
+ sysTrapFindStrInStr = $A26A;
+ sysTrapFindSaveMatch = $A26B;
+ sysTrapFindGetLineBounds = $A26C;
+ sysTrapFindDrawHeader = $A26D;
+ sysTrapPenOpen = $A26E;
+ sysTrapPenClose = $A26F;
+ sysTrapPenGetRawPen = $A270;
+ sysTrapPenCalibrate = $A271;
+ sysTrapPenRawToScreen = $A272;
+ sysTrapPenScreenToRaw = $A273;
+ sysTrapPenResetCalibration = $A274;
+ sysTrapPenSleep = $A275;
+ sysTrapPenWake = $A276;
+ sysTrapResLoadForm = $A277;
+ sysTrapResLoadMenu = $A278;
+ sysTrapFtrInit = $A279;
+ sysTrapFtrUnregister = $A27A;
+ sysTrapFtrGet = $A27B;
+ sysTrapFtrSet = $A27C;
+ sysTrapFtrGetByIndex = $A27D;
+ sysTrapGrfInit = $A27E;
+ sysTrapGrfFree = $A27F;
+ sysTrapGrfGetState = $A280;
+ sysTrapGrfSetState = $A281;
+ sysTrapGrfFlushPoints = $A282;
+ sysTrapGrfAddPoint = $A283;
+ sysTrapGrfInitState = $A284;
+ sysTrapGrfCleanState = $A285;
+ sysTrapGrfMatch = $A286;
+ sysTrapGrfGetMacro = $A287;
+ sysTrapGrfFilterPoints = $A288;
+ sysTrapGrfGetNumPoints = $A289;
+ sysTrapGrfGetPoint = $A28A;
+ sysTrapGrfFindBranch = $A28B;
+ sysTrapGrfMatchGlyph = $A28C;
+ sysTrapGrfGetGlyphMapping = $A28D;
+ sysTrapGrfGetMacroName = $A28E;
+ sysTrapGrfDeleteMacro = $A28F;
+ sysTrapGrfAddMacro = $A290;
+ sysTrapGrfGetAndExpandMacro = $A291;
+ sysTrapGrfProcessStroke = $A292;
+ sysTrapGrfFieldChange = $A293;
+ sysTrapGetCharSortValue = $A294;
+ sysTrapGetCharAttr = $A295;
+ sysTrapGetCharCaselessValue = $A296;
+ sysTrapPwdExists = $A297;
+ sysTrapPwdVerify = $A298;
+ sysTrapPwdSet = $A299;
+ sysTrapPwdRemove = $A29A;
+ sysTrapGsiInitialize = $A29B;
+ sysTrapGsiSetLocation = $A29C;
+ sysTrapGsiEnable = $A29D;
+ sysTrapGsiEnabled = $A29E;
+ sysTrapGsiSetShiftState = $A29F;
+ sysTrapKeyInit = $A2A0;
+ sysTrapKeyHandleInterrupt = $A2A1;
+ sysTrapKeyCurrentState = $A2A2;
+ sysTrapKeyResetDoubleTap = $A2A3;
+ sysTrapKeyRates = $A2A4;
+ sysTrapKeySleep = $A2A5;
+ sysTrapKeyWake = $A2A6;
+ sysTrapDlkControl = $A2A7;
+ sysTrapDlkStartServer = $A2A8;
+ sysTrapDlkGetSyncInfo = $A2A9;
+ sysTrapDlkSetLogEntry = $A2AA;
+ sysTrapUnused2 = $A2AB;
+ sysTrapSysLibLoad = $A2AC;
+ sysTrapSndPlaySmf = $A2AD;
+ sysTrapSndCreateMidiList = $A2AE;
+ sysTrapAbtShowAbout = $A2AF;
+ sysTrapMdmDial = $A2B0;
+ sysTrapMdmHangUp = $A2B1;
+ sysTrapDmSearchRecord = $A2B2;
+ sysTrapSysInsertionSort = $A2B3;
+ sysTrapDmInsertionSort = $A2B4;
+ sysTrapLstSetTopItem = $A2B5;
+ sysTrapSclSetScrollBar = $A2B6;
+ sysTrapSclDrawScrollBar = $A2B7;
+ sysTrapSclHandleEvent = $A2B8;
+ sysTrapSysMailboxCreate = $A2B9;
+ sysTrapSysMailboxDelete = $A2BA;
+ sysTrapSysMailboxFlush = $A2BB;
+ sysTrapSysMailboxSend = $A2BC;
+ sysTrapSysMailboxWait = $A2BD;
+ sysTrapSysTaskWait = $A2BE;
+ sysTrapSysTaskWake = $A2BF;
+ sysTrapSysTaskWaitClr = $A2C0;
+ sysTrapSysTaskSuspend = $A2C1;
+ sysTrapSysTaskResume = $A2C2;
+ sysTrapCategoryCreateList = $A2C3;
+ sysTrapCategoryFreeList = $A2C4;
+ sysTrapCategoryEditV20 = $A2C5;
+ sysTrapCategorySelect = $A2C6;
+ sysTrapDmDeleteCategory = $A2C7;
+ sysTrapSysEvGroupCreate = $A2C8;
+ sysTrapSysEvGroupSignal = $A2C9;
+ sysTrapSysEvGroupRead = $A2CA;
+ sysTrapSysEvGroupWait = $A2CB;
+ sysTrapEvtEventAvail = $A2CC;
+ sysTrapEvtSysEventAvail = $A2CD;
+ sysTrapStrNCopy = $A2CE;
+ sysTrapKeySetMask = $A2CF;
+ sysTrapSelectDay = $A2D0;
+ sysTrapPrefGetPreference = $A2D1;
+ sysTrapPrefSetPreference = $A2D2;
+ sysTrapPrefGetAppPreferences = $A2D3;
+ sysTrapPrefSetAppPreferences = $A2D4;
+ sysTrapFrmPointInTitle = $A2D5;
+ sysTrapStrNCat = $A2D6;
+ sysTrapMemCmp = $A2D7;
+ sysTrapTblSetColumnEditIndicator = $A2D8;
+ sysTrapFntWordWrap = $A2D9;
+ sysTrapFldGetScrollValues = $A2DA;
+ sysTrapSysCreateDataBaseList = $A2DB;
+ sysTrapSysCreatePanelList = $A2DC;
+ sysTrapDlkDispatchRequest = $A2DD;
+ sysTrapStrPrintF = $A2DE;
+ sysTrapStrVPrintF = $A2DF;
+ sysTrapPrefOpenPreferenceDB = $A2E0;
+ sysTrapSysGraffitiReferenceDialog = $A2E1;
+ sysTrapSysKeyboardDialog = $A2E2;
+ sysTrapFntWordWrapReverseNLines = $A2E3;
+ sysTrapFntGetScrollValues = $A2E4;
+ sysTrapTblSetRowStaticHeight = $A2E5;
+ sysTrapTblHasScrollBar = $A2E6;
+ sysTrapSclGetScrollBar = $A2E7;
+ sysTrapFldGetNumberOfBlankLines = $A2E8;
+ sysTrapSysTicksPerSecond = $A2E9;
+ sysTrapHwrBacklight = $A2EA;
+ sysTrapDmDatabaseProtect = $A2EB;
+ sysTrapTblSetBounds = $A2EC;
+ sysTrapStrNCompare = $A2ED;
+ sysTrapStrNCaselessCompare = $A2EE;
+ sysTrapPhoneNumberLookup = $A2EF;
+ sysTrapFrmSetMenu = $A2F0;
+ sysTrapEncDigestMD5 = $A2F1;
+ sysTrapDmFindSortPosition = $A2F2;
+ sysTrapSysBinarySearch = $A2F3;
+ sysTrapSysErrString = $A2F4;
+ sysTrapSysStringByIndex = $A2F5;
+ sysTrapEvtAddUniqueEventToQueue = $A2F6;
+ sysTrapStrLocalizeNumber = $A2F7;
+ sysTrapStrDelocalizeNumber = $A2F8;
+ sysTrapLocGetNumberSeparators = $A2F9;
+ sysTrapMenuSetActiveMenuRscID = $A2FA;
+ sysTrapLstScrollList = $A2FB;
+ sysTrapCategoryInitialize = $A2FC;
+ sysTrapEncDigestMD4 = $A2FD;
+ sysTrapEncDES = $A2FE;
+ sysTrapLstGetVisibleItems = $A2FF;
+ sysTrapWinSetWindowBounds = $A300;
+ sysTrapCategorySetName = $A301;
+ sysTrapFldSetInsertionPoint = $A302;
+ sysTrapFrmSetObjectBounds = $A303;
+ sysTrapWinSetColors = $A304;
+ sysTrapFlpDispatch = $A305;
+ sysTrapFlpEmDispatch = $A306;
+ sysTrapExgInit = $A307;
+ sysTrapExgConnect = $A308;
+ sysTrapExgPut = $A309;
+ sysTrapExgGet = $A30A;
+ sysTrapExgAccept = $A30B;
+ sysTrapExgDisconnect = $A30C;
+ sysTrapExgSend = $A30D;
+ sysTrapExgReceive = $A30E;
+ sysTrapExgRegisterData = $A30F;
+ sysTrapExgNotifyReceive = $A310;
+ sysTrapExgControl = $A311;
+ sysTrapPrgStartDialog = $A312;
+ sysTrapPrgStopDialog = $A313;
+ sysTrapPrgUpdateDialog = $A314;
+ sysTrapPrgHandleEvent = $A315;
+ sysTrapImcReadFieldNoSemicolon = $A316;
+ sysTrapImcReadFieldQuotablePrintable = $A317;
+ sysTrapImcReadPropertyParameter = $A318;
+ sysTrapImcSkipAllPropertyParameters = $A319;
+ sysTrapImcReadWhiteSpace = $A31A;
+ sysTrapImcWriteQuotedPrintable = $A31B;
+ sysTrapImcWriteNoSemicolon = $A31C;
+ sysTrapImcStringIsAscii = $A31D;
+ sysTrapTblGetItemFont = $A31E;
+ sysTrapTblSetItemFont = $A31F;
+ sysTrapFontSelect = $A320;
+ sysTrapFntDefineFont = $A321;
+ sysTrapCategoryEdit = $A322;
+ sysTrapSysGetOSVersionString = $A323;
+ sysTrapSysBatteryInfo = $A324;
+ sysTrapSysUIBusy = $A325;
+ sysTrapWinValidateHandle = $A326;
+ sysTrapFrmValidatePtr = $A327;
+ sysTrapCtlValidatePointer = $A328;
+ sysTrapWinMoveWindowAddr = $A329;
+ sysTrapFrmAddSpaceForObject = $A32A;
+ sysTrapFrmNewForm = $A32B;
+ sysTrapCtlNewControl = $A32C;
+ sysTrapFldNewField = $A32D;
+ sysTrapLstNewList = $A32E;
+ sysTrapFrmNewLabel = $A32F;
+ sysTrapFrmNewBitmap = $A330;
+ sysTrapFrmNewGadget = $A331;
+ sysTrapFileOpen = $A332;
+ sysTrapFileClose = $A333;
+ sysTrapFileDelete = $A334;
+ sysTrapFileReadLow = $A335;
+ sysTrapFileWrite = $A336;
+ sysTrapFileSeek = $A337;
+ sysTrapFileTell = $A338;
+ sysTrapFileTruncate = $A339;
+ sysTrapFileControl = $A33A;
+ sysTrapFrmActiveState = $A33B;
+ sysTrapSysGetAppInfo = $A33C;
+ sysTrapSysGetStackInfo = $A33D;
+ sysTrapScrDisplayMode = $A33E;
+ sysTrapHwrLCDGetDepth = $A33F;
+ sysTrapHwrGetROMToken = $A340;
+ sysTrapDbgControl = $A341;
+ sysTrapExgDBRead = $A342;
+ sysTrapExgDBWrite = $A343;
+ sysTrapSysGremlins = $A344;
+ sysTrapFrmRemoveObject = $A345;
+ sysTrapSysReserved1 = $A346;
+ sysTrapSysReserved2 = $A347;
+ sysTrapSysReserved3 = $A348;
+ sysTrapSysReserved4 = $A349;
+ sysTrapLastTrapNumber = $A34A;
+
+
+
+implementation
+
+end.
+{
+ $Log: systraps.pp,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/int64p.inc b/rtl/powerpc/int64p.inc
new file mode 100644
index 0000000000..1ac21f36e9
--- /dev/null
+++ b/rtl/powerpc/int64p.inc
@@ -0,0 +1,215 @@
+{
+ $Id: int64p.inc,v 1.9 2005/03/11 12:41:41 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains some helper routines for int64 and qword
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define FPC_SYSTEM_HAS_DIV_QWORD}
+ function fpc_div_qword(n,z : qword) : qword;assembler;[public,alias: 'FPC_DIV_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ { from the ppc compiler writers guide }
+ assembler; nostackframe;
+ asm
+ // (R5:R6) = (R5:R6) / (R3:R4) (64b) = (64b / 64b)
+ // quo dvd dvs
+ //
+ // Remainder is returned in R3:R4.
+ //
+ // Code comment notation:
+ // msw = most-significant (high-order) word, i.e. bits 0..31
+ // lsw = least-significant (low-order) word, i.e. bits 32..63
+ // LZ = Leading Zeroes
+ // SD = Significant Digits
+ //
+ // R5:R6 = dvd (input dividend); quo (output quotient)
+ // R3:R4 = dvs (input divisor); rem (output remainder)
+ //
+ // R7:R8 = tmp
+ // count the number of leading 0s in the dividend
+ or. R0,R3,R4 // dvs = 0?
+ cmpwi cr1,R5,0 // dvd.msw == 0?
+ cntlzw R0,R5 // R0 = dvd.msw.LZ
+ cntlzw R9,R6 // R9 = dvd.lsw.LZ
+ bne+ .LNoDivByZero
+ b FPC_DIVBYZERO
+ .LNoDivByZero:
+ bne cr1,.Llab1 // if(dvd.msw == 0) dvd.LZ = dvd.msw.LZ
+ addi R0,R9,32 // dvd.LZ = dvd.lsw.LZ + 32
+ .Llab1:
+ // count the number of leading 0s in the divisor
+ cmpwi cr0,R3,0 // dvd.msw == 0?
+ cntlzw R9,R3 // R9 = dvs.msw.LZ
+ cntlzw R10,R4 // R10 = dvs.lsw.LZ
+ bne cr0,.Llab2 // if(dvs.msw == 0) dvs.LZ = dvs.msw.LZ
+ addi R9,R10,32 // dvs.LZ = dvs.lsw.LZ + 32
+ .Llab2:
+ // determine shift amounts to minimize the number of iterations
+ cmpw cr0,R0,R9 // compare dvd.LZ to dvs.LZ
+ subfic R10,R0,64 // R10 = dvd.SD
+ bgt cr0,.Llab9 // if(dvs > dvd) quotient = 0
+ addi R9,R9,1 // ++dvs.LZ (or --dvs.SD)
+ subfic R9,R9,64 // R9 = dvs.SD
+ add R0,R0,R9 // (dvd.LZ + dvs.SD) = left shift of dvd for
+ // initial dvd
+ subf R9,R9,R10 // (dvd.SD - dvs.SD) = right shift of dvd for
+ // initial tmp
+ mtctr R9 // number of iterations = dvd.SD - dvs.SD
+ // R7:R8 = R5:R6 >> R9
+ cmpwi cr0,R9,32 // compare R9 to 32
+ addi R7,R9,-32
+ blt cr0,.Llab3 // if(R9 < 32) jump to .Llab3
+ srw R8,R5,R7 // tmp.lsw = dvd.msw >> (R9 - 32)
+ li R7,0 // tmp.msw = 0
+ b .Llab4
+ .Llab3:
+ srw R8,R6,R9 // R8 = dvd.lsw >> R9
+ subfic R7,R9,32
+ slw R7,R5,R7 // R7 = dvd.msw << 32 - R9
+ or R8,R8,R7 // tmp.lsw = R8 | R7
+ srw R7,R5,R9 // tmp.msw = dvd.msw >> R9
+ .Llab4:
+ // R5:R6 = R5:R6 << R0
+ cmpwi cr0,R0,32 // compare R0 to 32
+ addic R9,R0,-32
+ blt cr0,.Llab5 // if(R0 < 32) jump to .Llab5
+ slw R5,R6,R9 // dvd.msw = dvd.lsw << R9
+ li R6,0 // dvd.lsw = 0
+ b .Llab6
+ .Llab5:
+ slw R5,R5,R0 // R5 = dvd.msw << R0
+ subfic R9,R0,32
+ srw R9,R6,R9 // R9 = dvd.lsw >> 32 - R0
+ or R5,R5,R9 // dvd.msw = R5 | R9
+ slw R6,R6,R0 // dvd.lsw = dvd.lsw << R0
+ .Llab6:
+ // restoring division shift and subtract loop
+ li R10,-1 // R10 = -1
+ addic R7,R7,0 // clear carry bit before loop starts
+ .Llab7:
+ // tmp:dvd is considered one large register
+ // each portion is shifted left 1 bit by adding it to itself
+ // adde sums the carry from the previous and creates a new carry
+ adde R6,R6,R6 // shift dvd.lsw left 1 bit
+ adde R5,R5,R5 // shift dvd.msw to left 1 bit
+ adde R8,R8,R8 // shift tmp.lsw to left 1 bit
+ adde R7,R7,R7 // shift tmp.msw to left 1 bit
+ subfc R0,R4,R8 // tmp.lsw - dvs.lsw
+ subfe. R9,R3,R7 // tmp.msw - dvs.msw
+ blt cr0,.Llab8 // if(result < 0) clear carry bit
+ mr R8,R0 // move lsw
+ mr R7,R9 // move msw
+ addic R0,R10,1 // set carry bit
+ .Llab8:
+ bdnz .Llab7
+ // write quotient and remainder
+ adde R4,R6,R6 // quo.lsw (lsb = CA)
+ adde R3,R5,R5 // quo.msw (lsb from lsw)
+ mr R6,R8 // rem.lsw
+ mr R5,R7 // rem.msw
+ b .Lqworddivdone // return
+ .Llab9:
+ // Quotient is 0 (dvs > dvd)
+ li R4,0 // dvd.lsw = 0
+ li R3,0 // dvd.msw = 0
+ .Lqworddivdone:
+ end;
+
+
+{$define FPC_SYSTEM_HAS_MOD_QWORD}
+ function int_div_qword(n,z : qword) : qword;external name 'FPC_DIV_QWORD';
+
+ function fpc_mod_qword(n,z : qword) : qword;assembler;[public,alias: 'FPC_MOD_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ assembler;
+ var
+ oldlr: pointer;
+ asm
+ mflr r0
+ stw r0,oldlr
+ bl INT_DIV_QWORD
+ lwz r0,oldlr
+ mtlr r0
+ mr R3,R5
+ mr R4,R6
+ end;
+
+{$define FPC_SYSTEM_HAS_MUL_QWORD}
+ { multiplies two qwords
+ the longbool for checkoverflow avoids a misaligned stack
+ }
+ function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword;[public,alias: 'FPC_MUL_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
+ assembler; nostackframe;
+ asm
+ // (r3:r4) = (r3:r4) * (r5:r6), checkoverflow is in r7
+ // res f1 f2
+
+ or. r10,r3,r5 // are both msw's 0?
+ mulhwu r8,r4,r6 // msw of product of lsw's
+ subi r0,r7,1 // if no overflowcheck, r0 := $ffffffff, else r0 := 0;
+ beq .LDone // if both msw's are zero, skip cross products
+ mullw r9,r4,r5 // lsw of first cross-product
+ cntlzw r11,r3 // count leading zeroes of msw1
+ cntlzw r12,r5 // count leading zeroes of msw2
+ mullw r7,r3,r6 // lsw of second cross-product
+ add r12,r11,r12 // sum of leading zeroes
+ mr r10,r8
+ or r0,r12,r0 // maximise sum if no overflow checking, otherwise it remains
+ add r8,r8,r9 // add
+ cmplwi cr1,r0,64 // >= 64 leading zero bits in total? If so, no overflow
+ add r8,r8,r7 // add
+ bge+ cr1,.LDone // if the sum of leading zero's >= 64 (or checkoverflow was 0)
+ // there's no overflow, otherwise more thorough check
+ add r7,r7,r9
+ mulhwu r3,r6,r3
+ addc r7,r7,r10 // add the msw of the product of the lsw's, record carry
+ cntlzw r9,r5
+ cntlzw r10,r4 // get leading zeroes count of lsw f1
+ mulhwu r5,r4,r5
+ addze r3,r3
+ subfic r0,r11,31 // if msw f1 = 0, then r0 := -1, else r0 >= 0
+ cntlzw r7,r6
+ subfic r11,r9,31 // same for f2
+ srawi r0,r0,31 // if msw f1 = 0, then r0 := 1, else r0 := 0
+ srawi r11,r11,31
+ and r10,r10,r0 // if msw f1 <> 0, the leading zero count lsw f1 := 0
+ and r9,r7,r11 // same for f2
+ or. r5,r5,r3
+ add r9,r9,r10 // add leading zero counts of lsw's to sum if appropriate
+ add r9,r9,r12
+ cmplwi cr7,r9,64 // is the sum now >= 64?
+ cmplwi cr1,r9,62 // or <= 62?
+ bge+ cr7,.LDone // >= 64 leading zeroes -> no overflow
+ ble+ cr1,.LOverflow // <= 62 leading zeroes -> overflow
+ // for 63 zeroes, we need additional checks
+ // sum of lsw's cross products can't have produced a carry,
+ // because the sum of leading zeroes is 63 -> at least
+ // one of these cross products is 0
+ beq+ .LDone
+ .LOverflow:
+ b FPC_OVERFLOW
+ .LDone:
+ mullw r4,r4,r6 // lsw of product of lsw's
+ mr r3,r8 // get msw of product in correct register
+ end;
+
+
+{
+ $Log: int64p.inc,v $
+ Revision 1.9 2005/03/11 12:41:41 jonas
+ * mini scheduling optimization
+
+ Revision 1.8 2005/02/19 14:16:02 jonas
+ * fixed overflow detection, + some small optimizations
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/makefile.cpu b/rtl/powerpc/makefile.cpu
new file mode 100644
index 0000000000..fa8b2c758c
--- /dev/null
+++ b/rtl/powerpc/makefile.cpu
@@ -0,0 +1,16 @@
+# $Id: makefile.cpu,v 1.2 2002/09/07 16:01:26 peter Exp $
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=powerpc math set
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
+#
+# $Log: makefile.cpu,v $
+# Revision 1.2 2002/09/07 16:01:26 peter
+# * old logs removed and tabs fixed
+#
+# Revision 1.1 2002/07/26 16:54:48 florian
+# + initial version
+#
+#
diff --git a/rtl/powerpc/math.inc b/rtl/powerpc/math.inc
new file mode 100644
index 0000000000..8e9081602b
--- /dev/null
+++ b/rtl/powerpc/math.inc
@@ -0,0 +1,355 @@
+{
+ $Id: math.inc,v 1.39 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ Implementation of mathematical Routines (only for real)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+const
+ longint_to_real_helper: int64 = $4330000080000000;
+ cardinal_to_real_helper: int64 = $4330000000000000;
+ int_to_real_factor: double = double(high(cardinal))+1.0;
+
+
+{****************************************************************************
+ EXTENDED data type routines
+ ****************************************************************************}
+
+{$ifdef INTERNCONSTINTF}
+ {$define FPC_SYSTEM_HAS_PI}
+ function fpc_pi_real : valreal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+
+ {$define FPC_SYSTEM_HAS_ABS}
+ function fpc_abs_real(d : valreal) : valreal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+
+ {$define FPC_SYSTEM_HAS_SQR}
+ function fpc_sqr_real(d : valreal) : valreal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+
+{$else}
+ {$define FPC_SYSTEM_HAS_PI}
+ function pi : double;[internproc:fpc_in_pi];
+
+ {$define FPC_SYSTEM_HAS_ABS}
+ function abs(d : extended) : extended;[internproc:fpc_in_abs_real];
+
+ {$define FPC_SYSTEM_HAS_SQR}
+ function sqr(d : extended) : extended;[internproc:fpc_in_sqr_real];
+{$endif ndef INTERNCONSTINTF}
+
+ const
+ factor: double = double(int64(1) shl 32);
+ factor2: double = double(int64(1) shl 31);
+
+{$ifndef FPC_SYSTEM_HAS_TRUNC}
+ {$define FPC_SYSTEM_HAS_TRUNC}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_trunc_real(d : valreal) : int64;assembler;compilerproc;
+ {$else}
+ function trunc(d : extended) : int64;assembler;[internconst:fpc_in_const_trunc];
+ {$endif}
+ { input: d in fr1 }
+ { output: result in r3 }
+ assembler;
+ var
+ temp: packed record
+ case byte of
+ 0: (l1,l2: longint);
+ 1: (d: double);
+ end;
+ asm
+ // store d in temp
+ stfd f1,temp
+ // extract sign bit (record in cr0)
+ lwz r3,temp
+ rlwinm. r3,r3,1,31,31
+ // make d positive
+ fabs f1,f1
+ // load 2^32 in f2
+ {$ifndef macos}
+ lis r4,factor@ha
+ lfd f2,factor@l(r4)
+ {$else}
+ lwz r4,factor(r2)
+ lfd f2,0(r4)
+ {$endif}
+ // check if value is < 0
+ // f3 := d / 2^32;
+ fdiv f3,f1,f2
+ // round
+ fctiwz f4,f3
+ // store
+ stfd f4,temp
+ // and load into r4
+ lwz r3,temp+4
+ // convert back to float
+ lis r0,0x4330
+ stw r0,temp
+ xoris r0,r3,0x8000
+ stw r0,temp+4
+ {$ifndef macos}
+ lis r4,longint_to_real_helper@ha
+ lfd f0,longint_to_real_helper@l(r4)
+ {$else}
+ lwz r4,longint_to_real_helper(r2)
+ lfd f0,0(r4)
+ {$endif}
+ lfd f3,temp
+ fsub f3,f3,f0
+
+
+ // f4 := d "mod" 2^32 ( = d - ((d / 2^32) * 2^32))
+ fnmsub f4,f3,f2,f1
+
+ // now, convert to unsigned 32 bit
+
+ // load 2^31 in f2
+ {$ifndef macos}
+ lis r4,factor2@ha
+ lfd f2,factor2@l(r4)
+ {$else}
+ lwz r4,factor2(r2)
+ lfd f2,0(r4)
+ {$endif}
+
+ // subtract 2^31
+ fsub f3,f4,f2
+ // was the value > 2^31?
+ fcmpu cr1,f4,f2
+ // use diff if >= 2^31
+ fsel f4,f3,f3,f4
+
+ // next part same as conversion to signed integer word
+ fctiwz f4,f4
+ stfd f4,temp
+ lwz r4,temp+4
+ // add 2^31 if value was >=2^31
+ blt cr1, .LTruncNoAdd
+ xoris r4,r4,0x8000
+.LTruncNoAdd:
+ // negate value if it was negative to start with
+ beq cr0,.LTruncPositive
+ subfic r4,r4,0
+ subfze r3,r3
+.LTruncPositive:
+ end;
+{$endif not FPC_SYSTEM_HAS_TRUNC}
+
+
+(*
+{$ifndef FPC_SYSTEM_HAS_ROUND}
+ {$define FPC_SYSTEM_HAS_ROUND}
+{$ifdef hascompilerproc}
+ function round(d : extended) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round, external name 'FPC_ROUND'];{$endif}
+
+ function fpc_round(d : extended) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+{$else}
+ function round(d : extended) : int64;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
+{$endif hascompilerproc}
+ { exactly the same as trunc, except that one fctiwz has become fctiw }
+ { input: d in fr1 }
+ { output: result in r3 }
+ assembler;
+ var
+ temp: packed record
+ case byte of
+ 0: (l1,l2: longint);
+ 1: (d: double);
+ end;
+ asm
+ // store d in temp
+ stfd f1, temp
+ // extract sign bit (record in cr0)
+ lwz r4,temp
+ rlwinm. r4,r4,1,31,31
+ // make d positive
+ fabs f1,f1
+ // load 2^32 in f2
+ {$ifndef macos}
+ lis r4,factor@ha
+ lfd f2,factor@l(r4)
+ {$else}
+ lwz r4,factor(r2)
+ lfd f2,0(r4)
+ {$endif}
+ // check if value is < 0
+ // f3 := d / 2^32;
+ fdiv f3,f1,f2
+ // round
+ fctiwz f4,f3
+ // store
+ stfd f4,temp
+ // and load into r4
+ lwz r3,temp+4
+ // convert back to float
+ lis r0,0x4330
+ stw r0,temp
+ xoris r0,r3,0x8000
+ stw r0,temp+4
+ {$ifndef macos}
+ lis r4,longint_to_real_helper@ha
+ lfd f0,longint_to_real_helper@l(r4)
+ {$else}
+ lwz r4,longint_to_real_helper(r2)
+ lfd f0,0(r4)
+ {$endif}
+ lfd f3,temp
+ fsub f3,f3,f0
+
+
+ // f4 := d "mod" 2^32 ( = d - ((d / 2^32) * 2^32))
+ fnmsub f4,f3,f2,f1
+
+ // now, convert to unsigned 32 bit
+
+ // load 2^31 in f2
+ {$ifndef macos}
+ lis r4,factor2@ha
+ lfd f2,factor2@l(r4)
+ {$else}
+ lwz r4,factor2(r2)
+ lfd f2,0(r4)
+ {$endif}
+
+ // subtract 2^31
+ fsub f3,f4,f2
+ // was the value > 2^31?
+ fcmpu cr1,f4,f2
+ // use diff if >= 2^31
+ fsel f4,f3,f3,f4
+
+ // next part same as conversion to signed integer word
+ fctiw f4,f4
+ stfd f4,temp
+ lwz r4,temp+4
+ // add 2^31 if value was >=2^31
+ blt cr1, .LRoundNoAdd
+ xoris r4,r4,0x8000
+.LRoundNoAdd:
+ // negate value if it was negative to start with
+ beq cr0,.LRoundPositive
+ subfic r4,r4,0
+ subfze r3,r3
+.LRoundPositive:
+ end;
+{$endif not FPC_SYSTEM_HAS_ROUND}
+*)
+
+
+{****************************************************************************
+ Int to real helpers
+ ****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
+function fpc_int64_to_double(i: int64): double; compilerproc;
+assembler;
+{ input: high(i) in r4, low(i) in r3 }
+{ output: double(i) in f0 }
+var
+ temp: packed record
+ case byte of
+ 0: (l1,l2: cardinal);
+ 1: (d: double);
+ end;
+asm
+ lis r0,0x4330
+ stw r0,temp
+ xoris r3,r3,0x8000
+ stw r3,temp+4
+ {$ifndef macos}
+ lis r3,longint_to_real_helper@ha
+ lfd f1,longint_to_real_helper@l(r3)
+ {$else}
+ lwz r3,longint_to_real_helper(r2)
+ lfd f1,0(r3)
+ {$endif}
+ lfd f0,temp
+ stw r4,temp+4
+ fsub f0,f0,f1
+ {$ifndef macos}
+ lis r4,cardinal_to_real_helper@ha
+ lfd f1,cardinal_to_real_helper@l(r4)
+ lis r4,int_to_real_factor@ha
+ lfd f3,temp
+ lfd f2,int_to_real_factor@l(r4)
+ {$else}
+ lwz r4,cardinal_to_real_helper(r2)
+ lwz r3,int_to_real_factor(r2)
+ lfd f3,temp
+ lfd f1,0(r4)
+ lfd f2,0(r3)
+ {$endif}
+ fsub f3,f3,f1
+ fmadd f1,f0,f2,f3
+end;
+
+
+{$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
+function fpc_qword_to_double(q: qword): double; compilerproc;
+assembler;
+{ input: high(q) in r4, low(q) in r3 }
+{ output: double(q) in f0 }
+var
+ temp: packed record
+ case byte of
+ 0: (l1,l2: cardinal);
+ 1: (d: double);
+ end;
+asm
+ lis r0,0x4330
+ stw r0,temp
+ stw r3,temp+4
+ lfd f0,temp
+ {$ifndef macos}
+ lis r3,cardinal_to_real_helper@ha
+ lfd f1,cardinal_to_real_helper@l(r3)
+ {$else}
+ lwz r3,longint_to_real_helper(r2)
+ lfd f1,0(r3)
+ {$endif}
+ stw r4,temp+4
+ fsub f0,f0,f1
+ lfd f3,temp
+ {$ifndef macos}
+ lis r4,int_to_real_factor@ha
+ lfd f2,int_to_real_factor@l(r4)
+ {$else}
+ lwz r4,int_to_real_factor(r2)
+ lfd f2,0(r4)
+ {$endif}
+ fsub f3,f3,f1
+ fmadd f1,f0,f2,f3
+end;
+
+
+{
+ $Log: math.inc,v $
+ Revision 1.39 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/mathu.inc b/rtl/powerpc/mathu.inc
new file mode 100644
index 0000000000..63f0bb8303
--- /dev/null
+++ b/rtl/powerpc/mathu.inc
@@ -0,0 +1,20 @@
+{
+ $Id: mathu.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ $Log: mathu.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/mathuh.inc b/rtl/powerpc/mathuh.inc
new file mode 100644
index 0000000000..443c10d23a
--- /dev/null
+++ b/rtl/powerpc/mathuh.inc
@@ -0,0 +1,20 @@
+{
+ $Id: mathuh.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ $Log: mathuh.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/powerpc.inc b/rtl/powerpc/powerpc.inc
new file mode 100644
index 0000000000..c2c96d0a50
--- /dev/null
+++ b/rtl/powerpc/powerpc.inc
@@ -0,0 +1,1169 @@
+{
+ $Id: powerpc.inc,v 1.76 2005/04/28 18:29:01 olle Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000-2001 by the Free Pascal development team.
+
+ Portions Copyright (c) 2000 by Casey Duncan (casey.duncan@state.co.us)
+
+ Processor dependent implementation for the system unit for
+ PowerPC
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ PowerPC specific stuff
+****************************************************************************}
+{
+
+const
+ ppc_fpu_overflow = (1 shl (32-3));
+ ppc_fpu_underflow = (1 shl (32-4));
+ ppc_fpu_divbyzero = (1 shl (32-5));
+ ppc_fpu_inexact = (1 shl (32-6));
+ ppc_fpu_invalid_snan = (1 shl (32-7));
+}
+
+procedure fpc_enable_ppc_fpu_exceptions;
+assembler; nostackframe;
+asm
+ { clear all "exception happened" flags we care about}
+ mtfsfi 0,0
+ mtfsfi 1,0
+ mtfsfi 2,0
+ mtfsfi 3,0
+{$ifdef fpc_mtfsb0_corrected}
+ mtfsb0 21
+ mtfsb0 22
+ mtfsb0 23
+
+{$endif fpc_mtfsb0_corrected}
+
+ { enable invalid operations and division by zero exceptions. }
+ { No overflow/underflow, since those give some spurious }
+ { exceptions }
+ mtfsfi 6,9
+end;
+
+
+procedure fpc_cpuinit;
+begin
+ fpc_enable_ppc_fpu_exceptions;
+end;
+
+
+function fpc_get_ppc_fpscr: cardinal;
+assembler;
+var
+ temp: record a,b:longint; end;
+asm
+ mffs f0
+ stfd f0,temp
+ lwz r3,temp.b
+ { clear all exception flags }
+{
+ rlwinm r4,r3,0,16,31
+ stw r4,temp.b
+ lfd f0,temp
+ a_mtfsf f0
+}
+end;
+
+{ This function is never called directly, it's a dummy to hold the register save/
+ load subroutines
+}
+{$ifndef MACOS}
+label
+ _restfpr_14_x,
+ _restfpr_15_x,
+ _restfpr_16_x,
+ _restfpr_17_x,
+ _restfpr_18_x,
+ _restfpr_19_x,
+ _restfpr_20_x,
+ _restfpr_21_x,
+ _restfpr_22_x,
+ _restfpr_23_x,
+ _restfpr_24_x,
+ _restfpr_25_x,
+ _restfpr_26_x,
+ _restfpr_27_x,
+ _restfpr_28_x,
+ _restfpr_29_x,
+ _restfpr_30_x,
+ _restfpr_31_x,
+ _restfpr_14_l,
+ _restfpr_15_l,
+ _restfpr_16_l,
+ _restfpr_17_l,
+ _restfpr_18_l,
+ _restfpr_19_l,
+ _restfpr_20_l,
+ _restfpr_21_l,
+ _restfpr_22_l,
+ _restfpr_23_l,
+ _restfpr_24_l,
+ _restfpr_25_l,
+ _restfpr_26_l,
+ _restfpr_27_l,
+ _restfpr_28_l,
+ _restfpr_29_l,
+ _restfpr_30_l,
+ _restfpr_31_l;
+
+procedure saverestorereg;assembler; nostackframe;
+asm
+{ exit }
+.globl _restfpr_14_x
+_restfpr_14_x: lfd f14, -144(r11)
+.globl _restfpr_15_x
+_restfpr_15_x: lfd f15, -136(r11)
+.globl _restfpr_16_x
+_restfpr_16_x: lfd f16, -128(r11)
+.globl _restfpr_17_x
+_restfpr_17_x: lfd f17, -120(r11)
+.globl _restfpr_18_x
+_restfpr_18_x: lfd f18, -112(r11)
+.globl _restfpr_19_x
+_restfpr_19_x: lfd f19, -104(r11)
+.globl _restfpr_20_x
+_restfpr_20_x: lfd f20, -96(r11)
+.globl _restfpr_21_x
+_restfpr_21_x: lfd f21, -88(r11)
+.globl _restfpr_22_x
+_restfpr_22_x: lfd f22, -80(r11)
+.globl _restfpr_23_x
+_restfpr_23_x: lfd f23, -72(r11)
+.globl _restfpr_24_x
+_restfpr_24_x: lfd f24, -64(r11)
+.globl _restfpr_25_x
+_restfpr_25_x: lfd f25, -56(r11)
+.globl _restfpr_26_x
+_restfpr_26_x: lfd f26, -48(r11)
+.globl _restfpr_27_x
+_restfpr_27_x: lfd f27, -40(r11)
+.globl _restfpr_28_x
+_restfpr_28_x: lfd f28, -32(r11)
+.globl _restfpr_29_x
+_restfpr_29_x: lfd f29, -24(r11)
+.globl _restfpr_30_x
+_restfpr_30_x: lfd f30, -16(r11)
+.globl _restfpr_31_x
+_restfpr_31_x: lwz r0, 4(r11)
+ lfd f31, -8(r11)
+ mtlr r0
+ ori r1, r11, 0
+ blr
+
+{ exit with restoring lr }
+.globl _restfpr_14_l
+_restfpr_14_l: lfd f14, -144(r11)
+.globl _restfpr_15_l
+_restfpr_15_l: lfd f15, -136(r11)
+.globl _restfpr_16_l
+_restfpr_16_l: lfd f16, -128(r11)
+.globl _restfpr_17_l
+_restfpr_17_l: lfd f17, -120(r11)
+.globl _restfpr_18_l
+_restfpr_18_l: lfd f18, -112(r11)
+.globl _restfpr_19_l
+_restfpr_19_l: lfd f19, -104(r11)
+.globl _restfpr_20_l
+_restfpr_20_l: lfd f20, -96(r11)
+.globl _restfpr_21_l
+_restfpr_21_l: lfd f21, -88(r11)
+.globl _restfpr_22_l
+_restfpr_22_l: lfd f22, -80(r11)
+.globl _restfpr_23_l
+_restfpr_23_l: lfd f23, -72(r11)
+.globl _restfpr_24_l
+_restfpr_24_l: lfd f24, -64(r11)
+.globl _restfpr_25_l
+_restfpr_25_l: lfd f25, -56(r11)
+.globl _restfpr_26_l
+_restfpr_26_l: lfd f26, -48(r11)
+.globl _restfpr_27_l
+_restfpr_27_l: lfd f27, -40(r11)
+.globl _restfpr_28_l
+_restfpr_28_l: lfd f28, -32(r11)
+.globl _restfpr_29_l
+_restfpr_29_l: lfd f29, -24(r11)
+.globl _restfpr_30_l
+_restfpr_30_l: lfd f30, -16(r11)
+.globl _restfpr_31_l
+_restfpr_31_l: lwz r0, 4(r11)
+ lfd f31, -8(r11)
+ mtlr r0
+ ori r1, r11, 0
+ blr
+end;
+{$endif MACOS}
+
+{****************************************************************************
+ Move / Fill
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe;
+asm
+ { count <= 0 ? }
+ cmpwi cr0,r5,0
+ { check if we have to do the move backwards because of overlap }
+ sub r10,r4,r3
+ { carry := boolean(dest-source < count) = boolean(overlap) }
+ subc r10,r10,r5
+
+ { count < 15 ? (to decide whether we will move dwords or bytes }
+ cmpwi cr1,r5,15
+
+ { if overlap, then r10 := -1 else r10 := 0 }
+ subfe r10,r10,r10
+
+ { count < 63 ? (32 + max. alignment (31) }
+ cmpwi cr7,r5,63
+
+ { if count <= 0, stop }
+ ble cr0,.LMoveDone
+
+ { load the begin of the source in the data cache }
+ dcbt 0,r3
+ { and the dest as well }
+ dcbtst 0,r4
+
+ { if overlap, then r0 := count else r0 := 0 }
+ and r0,r5,r10
+ { if overlap, then point source and dest to the end }
+ add r3,r3,r0
+ add r4,r4,r0
+ { if overlap, then r6 := 0, else r6 := -1 }
+ not r6,r10
+ { if overlap, then r10 := -2, else r10 := 0 }
+ slwi r10,r10,1
+ { if overlap, then r10 := -1, else r10 := 1 }
+ addi r10,r10,1
+
+ { if count < 15, copy everything byte by byte }
+ blt cr1,.LMoveBytes
+
+ { if no overlap, then source/dest += -1, otherwise they stay }
+ { After the next instruction, r3/r4 + r10 = next position to }
+ { load/store from/to }
+ add r3,r3,r6
+ add r4,r4,r6
+
+ { otherwise, guarantee 4 byte alignment for dest for starters }
+.LMove4ByteAlignLoop:
+ lbzux r0,r3,r10
+ stbux r0,r4,r10
+ { is dest now 4 aligned? }
+ andi. r0,r4,3
+ subi r5,r5,1
+ { while not aligned, continue }
+ bne cr0,.LMove4ByteAlignLoop
+
+{$ifndef ppc603}
+ { check for 32 byte alignment }
+ andi. r7,r4,31
+{$endif non ppc603}
+ { we are going to copy one byte again (the one at the newly }
+ { aligned address), so increase count byte 1 }
+ addi r5,r5,1
+ { count div 4 for number of dwords to copy }
+ srwi r0,r5,2
+ { if 11 <= count < 63, copy using dwords }
+ blt cr7,.LMoveDWords
+
+{$ifndef ppc603}
+ { # of dwords to copy to reach 32 byte alignment (*4) }
+ { (depends on forward/backward copy) }
+
+ { if forward copy, r6 = -1 -> r8 := 32 }
+ { if backward copy, r6 = 0 -> r8 := 0 }
+ rlwinm r8,r6,0,31-6+1,31-6+1
+ { if forward copy, we have to copy 32 - unaligned count bytes }
+ { if backward copy unaligned count bytes }
+ sub r7,r8,r7
+ { if backward copy, the calculated value is now negate -> }
+ { make it positive again }
+ not r8, r6
+ add r7, r7, r8
+ xor r7, r7, r8
+{$endif not ppc603}
+
+ { multiply the update count with 4 }
+ slwi r10,r10,2
+ slwi r6,r6,2
+ { and adapt the source and dest }
+ add r3,r3,r6
+ add r4,r4,r6
+
+{$ifndef ppc603}
+ beq cr0,.LMove32BytesAligned
+.L32BytesAlignMoveLoop:
+ { count >= 39 -> align to 8 byte boundary and then use the FPU }
+ { since we're already at 4 byte alignment, use dword store }
+ subic. r7,r7,4
+ lwzux r0,r3,r10
+ subi r5,r5,4
+ stwux r0,r4,r10
+ bne .L32BytesAlignMoveLoop
+
+.LMove32BytesAligned:
+ { count div 32 ( >= 1, since count was >=63 }
+ srwi r0,r5,5
+ { remainder }
+ andi. r5,r5,31
+ { to decide if we will do some dword stores (instead of only }
+ { byte stores) afterwards or not }
+{$else not ppc603}
+ srwi r0,r5,4
+ andi. r5,r5,15
+{$endif not ppc603}
+ cmpwi cr1,r5,11
+ mtctr r0
+
+ { r0 := count div 4, will be moved to ctr when copying dwords }
+ srwi r0,r5,2
+
+{$ifndef ppc603}
+ { adjust the update count: it will now be 8 or -8 depending on overlap }
+ slwi r10,r10,1
+
+ { adjust source and dest pointers: because of the above loop, dest is now }
+ { aligned to 8 bytes. So if we add r6 we will still have an 8 bytes }
+ { aligned address) }
+ add r3,r3,r6
+ add r4,r4,r6
+
+ slwi r6,r6,1
+
+ { the dcbz offset must give a 32 byte aligned address when added }
+ { to the current dest address and its address must point to the }
+ { bytes that will be overwritten in the current iteration. In case }
+ { of a forward loop, the dest address has currently an offset of }
+ { -8 compared to the bytes that will be overwritten (and r6 = -8). }
+ { In case of a backward of a loop, the dest address currently has }
+ { an offset of +32 compared to the bytes that will be overwritten }
+ { (and r6 = 0). So the forward dcbz offset must become +8 and the }
+ { backward -32 -> (-r6 * 5) - 32 gives the correct offset }
+ slwi r7,r6,2
+ add r7,r7,r6
+ neg r7,r7
+ subi r7,r7,32
+
+.LMove32ByteDcbz:
+ lfdux f0,r3,r10
+ lfdux f1,r3,r10
+ lfdux f2,r3,r10
+ lfdux f3,r3,r10
+ { must be done only now, in case source and dest are less than }
+ { 32 bytes apart! }
+ dcbz r4,r7
+ stfdux f0,r4,r10
+ stfdux f1,r4,r10
+ stfdux f2,r4,r10
+ stfdux f3,r4,r10
+ bdnz .LMove32ByteDcbz
+.LMove32ByteLoopDone:
+{$else not ppc603}
+.LMove16ByteLoop:
+ lwzux r11,r3,r10
+ lwzux r7,r3,r10
+ lwzux r8,r3,r10
+ lwzux r9,r3,r10
+ stwux r11,r4,r10
+ stwux r7,r4,r10
+ stwux r8,r4,r10
+ stwux r9,r4,r10
+ bdnz .LMove16ByteLoop
+{$endif not ppc603}
+
+ { cr0*4+eq is true if "count and 31" = 0 }
+ beq cr0,.LMoveDone
+
+ { make r10 again -1 or 1, but first adjust source/dest pointers }
+ sub r3,r3,r6
+ sub r4,r4,r6
+{$ifndef ppc603}
+ srawi r10,r10,3
+ srawi r6,r6,3
+{$else not ppc603}
+ srawi r10,r10,2
+ srawi r6,r6,2
+{$endif not ppc603}
+
+ { cr1 contains whether count <= 11 }
+ ble cr1,.LMoveBytes
+
+.LMoveDWords:
+ mtctr r0
+ andi. r5,r5,3
+ { r10 * 4 }
+ slwi r10,r10,2
+ slwi r6,r6,2
+ add r3,r3,r6
+ add r4,r4,r6
+
+.LMoveDWordsLoop:
+ lwzux r0,r3,r10
+ stwux r0,r4,r10
+ bdnz .LMoveDWordsLoop
+
+ beq cr0,.LMoveDone
+ { make r10 again -1 or 1 }
+ sub r3,r3,r6
+ sub r4,r4,r6
+ srawi r10,r10,2
+ srawi r6,r6,2
+.LMoveBytes:
+ add r3,r3,r6
+ add r4,r4,r6
+ mtctr r5
+.LMoveBytesLoop:
+ lbzux r0,r3,r10
+ stbux r0,r4,r10
+ bdnz .LMoveBytesLoop
+.LMoveDone:
+end;
+{$endif FPC_SYSTEM_HAS_MOVE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+
+Procedure FillChar(var x;count:longint;value:byte);assembler;
+{ input: x in r3, count in r4, value in r5 }
+
+{$ifndef FPC_ABI_AIX}
+{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
+{ to explicitely allocate room }
+var
+ temp : packed record
+ case byte of
+ 0: (l1,l2: longint);
+ 1: (d: double);
+ end;
+{$endif FPC_ABI_AIX}
+asm
+ { no bytes? }
+ cmpwi cr6,r4,0
+ { less than 15 bytes? }
+ cmpwi cr7,r4,15
+ { less than 64 bytes? }
+ cmpwi cr1,r4,64
+ { fill r5 with ValueValueValueValue }
+ rlwimi r5,r5,8,16,23
+ { setup for aligning x to multiple of 4}
+ rlwinm r10,r3,0,31-2+1,31
+ rlwimi r5,r5,16,0,15
+ ble cr6,.LFillCharDone
+ { get the start of the data in the cache (and mark it as "will be }
+ { modified") }
+ dcbtst 0,r3
+ subfic r10,r10,4
+ blt cr7,.LFillCharVerySmall
+ { just store 4 bytes instead of using a loop to align (there are }
+ { plenty of other instructions now to keep the processor busy }
+ { while it handles the (possibly unaligned) store) }
+ stw r5,0(r3)
+ { r3 := align(r3,4) }
+ add r3,r3,r10
+ { decrease count with number of bytes already stored }
+ sub r4,r4,r10
+ blt cr1,.LFillCharSmall
+ { if we have to fill with 0 (which happens a lot), we can simply use }
+ { dcbz for the most part, which is very fast, so make a special case }
+ { for that }
+ cmplwi cr1,r5,0
+ { align to a multiple of 32 (and immediately check whether we aren't }
+ { already 32 byte aligned) }
+ rlwinm. r10,r3,0,31-5+1,31
+ { setup r3 for using update forms of store instructions }
+ subi r3,r3,4
+ { get number of bytes to store }
+ subfic r10,r10,32
+ { if already 32byte aligned, skip align loop }
+ beq .L32ByteAlignLoopDone
+ { substract from the total count }
+ sub r4,r4,r10
+.L32ByteAlignLoop:
+ { we were already aligned to 4 byres, so this will count down to }
+ { exactly 0 }
+ subic. r10,r10,4
+ stwu r5,4(r3)
+ bne .L32ByteAlignLoop
+.L32ByteAlignLoopDone:
+ { get the amount of 32 byte blocks }
+ srwi r10,r4,5
+ { and keep the rest in r4 (recording whether there is any rest) }
+ rlwinm. r4,r4,0,31-5+1,31
+ { move to ctr }
+ mtctr r10
+ { check how many rest there is (to decide whether we'll use }
+ { FillCharSmall or FillCharVerySmall) }
+ cmplwi cr7,r4,11
+ { if filling with zero, only use dcbz }
+ bne cr1, .LFillCharNoZero
+ { make r3 point again to the actual store position }
+ addi r3,r3,4
+.LFillCharDCBZLoop:
+ dcbz 0,r3
+ addi r3,r3,32
+ bdnz .LFillCharDCBZLoop
+ { if there was no rest, we're finished }
+ beq .LFillCharDone
+ b .LFillCharVerySmall
+.LFillCharNoZero:
+{$ifdef FPC_ABI_AIX}
+ stw r5,-4(r1)
+ stw r5,-8(r1)
+ lfd f0,-8(r1)
+{$else FPC_ABI_AIX}
+ stw r5,temp
+ stw r5,temp+4
+ lfd f0,temp
+{$endif FPC_ABI_AIX}
+ { make r3 point to address-8, so we're able to use fp double stores }
+ { with update (it's already -4 now) }
+ subi r3,r3,4
+ { load r10 with 8, so that dcbz uses the correct address }
+ li r10, 8
+.LFillChar32ByteLoop:
+ dcbz r3,r10
+ stfdu f0,8(r3)
+ stfdu f0,8(r3)
+ stfdu f0,8(r3)
+ stfdu f0,8(r3)
+ bdnz .LFillChar32ByteLoop
+ { if there was no rest, we're finished }
+ beq .LFillCharDone
+ { make r3 point again to the actual next byte that must be written }
+ addi r3,r3,8
+ b .LFillCharVerySmall
+.LFillCharSmall:
+ { when we arrive here, we're already 4 byte aligned }
+ { get count div 4 to store dwords }
+ srwi r10,r4,2
+ { get ready for use of update stores }
+ subi r3,r3,4
+ mtctr r10
+ rlwinm. r4,r4,0,31-2+1,31
+.LFillCharSmallLoop:
+ stwu r5,4(r3)
+ bdnz .LFillCharSmallLoop
+ { if nothing left, stop }
+ beq .LFillCharDone
+ { get ready to store bytes }
+ addi r3,r3,4
+.LFillCharVerySmall:
+ mtctr r4
+ subi r3,r3,1
+.LFillCharVerySmallLoop:
+ stbu r5,1(r3)
+ bdnz .LFillCharVerySmallLoop
+.LFillCharDone:
+end;
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
+{$define FPC_SYSTEM_HAS_FILLDWORD}
+procedure filldword(var x;count : longint;value : dword);
+assembler; nostackframe;
+asm
+{ registers:
+ r3 x
+ r4 count
+ r5 value
+}
+ cmpwi cr0,r4,0
+ mtctr r4
+ subi r3,r3,4
+ ble .LFillDWordEnd //if count<=0 Then Exit
+.LFillDWordLoop:
+ stwu r5,4(r3)
+ bdnz .LFillDWordLoop
+.LFillDWordEnd:
+end;
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+ { load the begin of the buffer in the data cache }
+ dcbt 0,r3
+ cmplwi r4,0
+ mtctr r4
+ subi r10,r3,1
+ mr r0,r3
+ { assume not found }
+ li r3,-1
+ ble .LIndexByteDone
+.LIndexByteLoop:
+ lbzu r9,1(r10)
+ cmplw r9,r5
+ bdnzf cr0*4+eq,.LIndexByteLoop
+ { r3 still contains -1 here }
+ bne .LIndexByteDone
+ sub r3,r10,r0
+.LIndexByteDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
+{$define FPC_SYSTEM_HAS_INDEXWORD}
+function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+ { load the begin of the buffer in the data cache }
+ dcbt 0,r3
+ cmplwi r4,0
+ mtctr r4
+ subi r10,r3,2
+ mr r0,r3
+ { assume not found }
+ li r3,-1
+ ble .LIndexWordDone
+.LIndexWordLoop:
+ lhzu r9,2(r10)
+ cmplw r9,r5
+ bdnzf cr0*4+eq,.LIndexWordLoop
+ { r3 still contains -1 here }
+ bne .LIndexWordDone
+ sub r3,r10,r0
+ srawi r3,r3,1
+.LIndexWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
+{$define FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+ { load the begin of the buffer in the data cache }
+ dcbt 0,r3
+ cmplwi r4,0
+ mtctr r4
+ subi r10,r3,4
+ mr r0,r3
+ { assume not found }
+ li r3,-1
+ ble .LIndexDWordDone
+.LIndexDWordLoop:
+ lwzu r9,4(r10)
+ cmplw r9,r5
+ bdnzf cr0*4+eq, .LIndexDWordLoop
+ { r3 still contains -1 here }
+ bne .LIndexDWordDone
+ sub r3,r10,r0
+ srawi r3,r3,2
+.LIndexDWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe;
+{ input: r3 = buf1, r4 = buf2, r5 = len }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc }
+asm
+ { load the begin of the first buffer in the data cache }
+ dcbt 0,r3
+ { use r0 instead of r3 for buf1 since r3 contains result }
+ cmplwi r5,0
+ mtctr r5
+ subi r11,r3,1
+ subi r4,r4,1
+ li r3,0
+ ble .LCompByteDone
+.LCompByteLoop:
+ { load next chars }
+ lbzu r9,1(r11)
+ lbzu r10,1(r4)
+ { calculate difference }
+ sub. r3,r9,r10
+ { if chars not equal or at the end, we're ready }
+ bdnzt cr0*4+eq, .LCompByteLoop
+.LCompByteDone:
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
+{$define FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
+{ input: r3 = buf1, r4 = buf2, r5 = len }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc }
+asm
+ { load the begin of the first buffer in the data cache }
+ dcbt 0,r3
+ { use r0 instead of r3 for buf1 since r3 contains result }
+ cmplwi r5,0
+ mtctr r5
+ subi r11,r3,2
+ subi r4,r4,2
+ li r3,0
+ ble .LCompWordDone
+.LCompWordLoop:
+ { load next chars }
+ lhzu r9,2(r11)
+ lhzu r10,2(r4)
+ { calculate difference }
+ sub. r3,r9,r10
+ { if chars not equal or at the end, we're ready }
+ bdnzt cr0*4+eq, .LCompWordLoop
+.LCompWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
+{$define FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
+{ input: r3 = buf1, r4 = buf2, r5 = len }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc }
+asm
+ { load the begin of the first buffer in the data cache }
+ dcbt 0,r3
+ { use r0 instead of r3 for buf1 since r3 contains result }
+ cmplwi r5,0
+ mtctr r5
+ subi r11,r3,4
+ subi r4,r4,4
+ li r3,0
+ ble .LCompDWordDone
+.LCompDWordLoop:
+ { load next chars }
+ lwzu r9,4(r11)
+ lwzu r10,4(r4)
+ { calculate difference }
+ sub. r3,r9,r10
+ { if chars not equal or at the end, we're ready }
+ bdnzt cr0*4+eq, .LCompDWordLoop
+.LCompDWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
+{$define FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b }
+{ output: r3 = position of found position (-1 if not found) }
+asm
+ { load the begin of the buffer in the data cache }
+ dcbt 0,r3
+ { length = 0? }
+ cmplwi r4,0
+ mtctr r4
+ subi r9,r3,1
+ subi r0,r3,1
+ { assume not found }
+ li r3,-1
+ { if yes, do nothing }
+ ble .LIndexChar0Done
+.LIndexChar0Loop:
+ lbzu r10,1(r9)
+ cmplwi cr1,r10,0
+ cmplw r10,r5
+ beq cr1,.LIndexChar0Done
+ bdnzf cr0*4+eq, .LIndexChar0Loop
+ bne .LIndexChar0Done
+ sub r3,r9,r0
+.LIndexChar0Done:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
+
+
+{****************************************************************************
+ String
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{ input: r3: pointer to result, r4: len, r5: sstr }
+asm
+ { load length source }
+ lbz r10,0(r5)
+ { load the begin of the dest buffer in the data cache }
+ dcbtst 0,r3
+
+ { put min(length(sstr),len) in r4 }
+ subfc r7,r10,r4 { r0 := r4 - r10 }
+ subfe r4,r4,r4 { if r3 >= r4 then r3' := 0 else r3' := -1 }
+ and r7,r7,r4 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+ add r4,r10,r7 { if r3 >= r4 then r3' := r10 else r3' := r3 }
+
+ cmplwi r4,0
+ { put length in ctr }
+ mtctr r4
+ stb r4,0(r3)
+ beq .LShortStrCopyDone
+.LShortStrCopyLoop:
+ lbzu r0,1(r5)
+ stbu r0,1(r3)
+ bdnz .LShortStrCopyLoop
+.LShortStrCopyDone:
+end;
+
+
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
+{$else}
+procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+{$endif}
+assembler; nostackframe;
+{ input: r3: len, r4: sstr, r5: dstr }
+asm
+ { load length source }
+ lbz r10,0(r4)
+ { load the begin of the dest buffer in the data cache }
+ dcbtst 0,r5
+
+ { put min(length(sstr),len) in r3 }
+ subc r0,r3,r10 { r0 := r3 - r10 }
+ subfe r3,r3,r3 { if r3 >= r4 then r3' := 0 else r3' := -1 }
+ and r3,r0,r3 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+ add r3,r3,r10 { if r3 >= r4 then r3' := r10 else r3' := r3 }
+
+ cmplwi r3,0
+ { put length in ctr }
+ mtctr r3
+ stb r3,0(r5)
+ beq .LShortStrCopyDone2
+.LShortStrCopyLoop2:
+ lbzu r0,1(r4)
+ stbu r0,1(r5)
+ bdnz .LShortStrCopyLoop2
+.LShortStrCopyDone2:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+
+(*
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT'];
+{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 }
+assembler;
+asm
+ { load length s1 }
+ lbz r6, 0(r4)
+ { load length s2 }
+ lbz r10, 0(r5)
+ { length 0 for s1? }
+ cmplwi cr7,r6,0
+ { length 255 for s1? }
+ subfic. r7,r6,255
+ { length 0 for s2? }
+ cmplwi cr1,r10,0
+ { calculate min(length(s2),255-length(s1)) }
+ subc r8,r7,r10 { r8 := r7 - r10 }
+ cror 4*6+2,4*1+2,4*7+2
+ subfe r7,r7,r7 { if r7 >= r10 then r7' := 0 else r7' := -1 }
+ mtctr r6
+ and r7,r8,r7 { if r7 >= r10 then r7' := 0 else r7' := r7-r10 }
+ add r7,r7,r10 { if r7 >= r10 then r7' := r10 else r7' := r7 }
+
+ mr r9,r3
+
+ { calculate length of final string }
+ add r8,r7,r6
+ stb r8,0(r3)
+ beq cr7, .Lcopys1loopDone
+ .Lcopys1loop:
+ lbzu r0,1(r4)
+ stbu r0,1(r9)
+ bdnz .Lcopys1loop
+ .Lcopys1loopDone:
+ mtctr r7
+ beq cr6, .LconcatDone
+ .Lcopys2loop:
+ lbzu r0,1(r5)
+ stbu r0,1(r9)
+ bdnz .Lcopys2loop
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+*)
+
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc;
+{ expects that results (r3) contains a pointer to the current string s1, r4 }
+{ high(s1) and (r5) a pointer to the one that has to be concatenated }
+assembler; nostackframe;
+asm
+ { load length s1 }
+ lbz r6, 0(r3)
+ { load length s2 }
+ lbz r10, 0(r5)
+ { length 0? }
+ cmplw cr1,r6,r4
+ cmplwi r10,0
+
+ { calculate min(length(s2),high(result)-length(result)) }
+ sub r9,r4,r6
+ subc r8,r9,r10 { r8 := r9 - r10 }
+ cror 4*7+2,4*0+2,4*1+2
+ subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 }
+ and r9,r8,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r10 }
+ add r9,r9,r10 { if r9 >= r10 then r9' := r10 else r9' := r9 }
+
+ { calculate new length }
+ add r10,r6,r9
+ { load value to copy in ctr }
+ mtctr r9
+ { store new length }
+ stb r10,0(r3)
+ { go to last current character of result }
+ add r3,r6,r3
+
+ { if nothing to do, exit }
+ beq cr7, .LShortStrAppendDone
+ { and concatenate }
+.LShortStrAppendLoop:
+ lbzu r10,1(r5)
+ stbu r10,1(r3)
+ bdnz .LShortStrAppendLoop
+.LShortStrAppendDone:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+(*
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
+assembler;
+asm
+ { load length sstr }
+ lbz r9,0(r4)
+ { load length dstr }
+ lbz r10,0(r3)
+ { save their difference for later and }
+ { calculate min(length(sstr),length(dstr)) }
+ subfc r7,r10,r9 { r0 := r9 - r10 }
+ subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 }
+ and r7,r7,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+ add r9,r10,r7 { if r9 >= r10 then r9' := r10 else r9' := r9 }
+
+ { first compare dwords (length/4) }
+ srwi. r5,r9,2
+ { keep length mod 4 for the ends }
+ rlwinm r9,r9,0,30,31
+ { already check whether length mod 4 = 0 }
+ cmplwi cr1,r9,0
+ { so we can load r3 with 0, in case the strings both have length 0 }
+ mr r8,r3
+ li r3, 0
+ { length div 4 in ctr for loop }
+ mtctr r5
+ { if length < 3, goto byte comparing }
+ beq LShortStrCompare1
+ { setup for use of update forms of load/store with dwords }
+ subi r4,r4,3
+ subi r8,r8,3
+LShortStrCompare4Loop:
+ lwzu r3,4(r4)
+ lwzu r10,4(r8)
+ sub. r3,r3,r10
+ bdnzt cr0+eq,LShortStrCompare4Loop
+ { r3 contains result if we stopped because of "ne" flag }
+ bne LShortStrCompareDone
+ { setup for use of update forms of load/store with bytes }
+ addi r4,r4,3
+ addi r8,r8,3
+LShortStrCompare1:
+ { if comparelen mod 4 = 0, skip this and return the difference in }
+ { lengths }
+ beq cr1,LShortStrCompareLen
+ mtctr r9
+LShortStrCompare1Loop:
+ lbzu r3,1(r4)
+ lbzu r10,1(r8)
+ sub. r3,r3,r10
+ bdnzt cr0+eq,LShortStrCompare1Loop
+ bne LShortStrCompareDone
+LShortStrCompareLen:
+ { also return result in flags, maybe we can use this in the CG }
+ mr. r3,r3
+LShortStrCompareDone:
+end;
+*)
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{$include strpas.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} nostackframe;
+{$include strlen.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ { all abi's I know use r1 as stack pointer }
+ mr r3, r1
+end;
+
+{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager,
+(even in the OS in system 9). The pointer to the switching stack frame is then
+indicated by the first bit set to 1. This is checked below.}
+
+{Both routines below assumes that framebp is a valid framepointer or nil.}
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ cmplwi r3,0
+ beq .Lcaller_addr_invalid
+ lwz r3,0(r3)
+ cmplwi r3,0
+ beq .Lcaller_addr_invalid
+{$ifdef MACOS}
+ rlwinm r4,r3,0,31,31
+ cmpwi r4,0
+ bne cr0,.Lcaller_addr_invalid
+{$endif MACOS}
+{$ifdef FPC_ABI_AIX}
+ lwz r3,8(r3)
+{$else FPC_ABI_AIX}
+ lwz r3,4(r3)
+{$endif FPC_ABI_AIX}
+ blr
+.Lcaller_addr_invalid:
+ li r3,0
+end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ cmplwi r3,0
+ beq .Lcaller_frame_invalid
+ lwz r3,0(r3)
+{$ifdef MACOS}
+ rlwinm r4,r3,0,31,31
+ cmpwi r4,0
+ bne cr0,.Lcaller_frame_invalid
+{$endif MACOS}
+ blr
+.Lcaller_frame_invalid:
+ li r3,0
+end;
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ srawi r0,r3,31
+ add r3,r0,r3
+ xor r3,r3,r0
+end;
+
+
+{****************************************************************************
+ Math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ODD_LONGINT}
+function odd(l:longint):boolean;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ rlwinm r3,r3,0,31,31
+end;
+
+
+{$define FPC_SYSTEM_HAS_SQR_LONGINT}
+function sqr(l:longint):longint;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ mullw r3,r3,r3
+end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+ mr r3,r1
+end;
+
+
+{****************************************************************************
+ Str()
+****************************************************************************}
+
+{ int_str: generic implementation is used for now }
+
+
+{****************************************************************************
+ Multithreading
+****************************************************************************}
+
+{ do a thread save inc/dec }
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+function declocked(var l : longint) : boolean;assembler;nostackframe;
+{ input: address of l in r3 }
+{ output: boolean indicating whether l is zero after decrementing }
+asm
+.LDecLockedLoop:
+ lwarx r10,0,r3
+ subi r10,r10,1
+ stwcx. r10,0,r3
+ bne- .LDecLockedLoop
+ cntlzw r3,r10
+ srwi r3,r3,5
+end;
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l : longint);assembler;nostackframe;
+asm
+.LIncLockedLoop:
+ lwarx r10,0,r3
+ addi r10,r10,1
+ stwcx. r10,0,r3
+ bne- .LIncLockedLoop
+end;
+
+
+{
+ $Log: powerpc.inc,v $
+ Revision 1.76 2005/04/28 18:29:01 olle
+ * Fixed bug in stack crawling routines for macos
+
+ Revision 1.75 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.74 2005/01/31 20:57:41 olle
+ * Fixed stack frame access for macos
+
+}
diff --git a/rtl/powerpc/set.inc b/rtl/powerpc/set.inc
new file mode 100644
index 0000000000..500d6c293d
--- /dev/null
+++ b/rtl/powerpc/set.inc
@@ -0,0 +1,529 @@
+{
+ $Id: set.inc,v 1.24 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Include file with set operations called by the compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc;
+{
+ load a normal set p from a smallset l
+
+ on entry: p in r3, l in r4
+}
+asm
+ stw r4,0(r3)
+ li r0,0
+ stw r0,4(r3)
+ stw r0,8(r3)
+ stw r0,12(r3)
+ stw r0,16(r3)
+ stw r0,20(r3)
+ stw r0,24(r3)
+ stw r0,28(r3)
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+{ checked 2001/09/28 (JM) }
+function fpc_set_create_element(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; compilerproc;
+{
+ create a new set in p from an element b
+
+ on entry: pointer to result in r3, b in r4
+}
+asm
+ li r0,0
+ stw r0,0(r3)
+ stw r0,4(r3)
+ stw r0,8(r3)
+ stw r0,12(r3)
+ stw r0,16(r3)
+ stw r0,20(r3)
+ stw r0,24(r3)
+ stw r0,28(r3)
+
+ // r0 := 1 shl r4[27-31] -> bit index in dword (rotate instructions
+ // with count in register only consider lower 5 bits of this register)
+ li r0,1
+ rlwnm r0,r0,r4,0,31
+
+ // get the index of the correct *dword* in the set
+ // (((b div 8) div 4)*4= (b div 8) and not(3))
+ // r5 := (r4 rotl(32-3)) and (0x01ffffff8)
+ rlwinm r4,r4,31-3+1,3,31-2
+
+ // store the result
+ stwx r0,r3,r4
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+ add the element b to the set pointed by p
+
+ on entry: result in r3, source in r4, b in r5
+}
+asm
+ // copy source to result
+ lfd f0,0(r4)
+ lfd f1,8(r4)
+ lfd f2,16(r4)
+ lfd f3,24(r4)
+ stfd f0,0(r3)
+ stfd f1,8(r3)
+ stfd f2,16(r3)
+ stfd f3,24(r3)
+
+ // get the index of the correct *dword* in the set
+ // r0 := (r5 rotl(32-3)) and (0x0fffffff8)
+ rlwinm r0,r5,31-3+1,3,31-2
+ // load dword in which the bit has to be set (and update r3 to this address)
+ lwzux r4,r3,r0
+ li r0,1
+ // generate bit which has to be inserted
+ // (can't use rlwimi, since that one only works for constants)
+ rlwnm r5,r0,r5,0,31
+ // insert it
+ or r5,r4,r5
+ // store result
+ stw r5,0(r3)
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+ suppresses the element b to the set pointed by p
+ used for exclude(set,element)
+
+ on entry: p in r3, b in r4
+}
+asm
+ // copy source to result
+ lfd f0,0(r4)
+ lfd f1,8(r4)
+ lfd f2,16(r4)
+ lfd f3,24(r4)
+ stfd f0,0(r3)
+ stfd f1,8(r3)
+ stfd f2,16(r3)
+ stfd f3,24(r3)
+ // get the index of the correct *dword* in the set
+ // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
+ rlwinm r0,r5,31-3+1,3,31-2
+ // load dword in which the bit has to be set (and update r3 to this address)
+ lwzux r4,r3,r0
+ li r0,1
+ // generate bit which has to be removed
+ rlwnm r5,r0,r5,0,31
+ // remove it
+ andc r5,r4,r5
+ // store result
+ stw r4,0(r3)
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set;assembler; compilerproc;
+{
+ on entry: result in r3, l in r4, h in r5
+
+ on entry: result in r3, ptr to orgset in r4, l in r5, h in r6
+}
+asm
+ // copy source to result
+ lfd f0,0(r4)
+ lfd f1,8(r4)
+ lfd f2,16(r4)
+ lfd f3,24(r4)
+ stfd f0,0(r3)
+ stfd f1,8(r3)
+ stfd f2,16(r3)
+ stfd f3,24(r3)
+
+ cmplw cr0,r5,r6
+ bgt cr0,.Lset_range_exit
+ rlwinm r4,r5,31-3+1,3,31-2 // divide by 8 to get starting and ending byte-
+ { load the set the data cache }
+ dcbtst r3,r4
+ rlwinm r9,r6,31-3+1,3,31-2 // address and clear two lowest bits to get
+ // start/end longint address
+ sub. r9,r9,r4 // are bit lo and hi in the same longint?
+ rlwinm r6,r6,0,31-5+1,31 // hi := hi mod 32 (= "hi and 31", but the andi
+ // instr. only exists in flags modifying form)
+ rlwinm r5,r5,0,31-5+1,31 // lo := lo mod 32 (= "lo and 31", but the andi
+ // instr. only exists in flags modifying form)
+ li r10,-1 // r10 = $0x0ffffffff = bitmask to be inserted
+ subfic r6,r6,31 // hi := 31 - (hi mod 32) = shift count for later
+ slw r10,r10,r5 // shift bitmask to clear bits below lo
+ lwzux r5,r3,r4 // go to starting pos in set and load value
+ // (lo is not necessary anymore)
+ beq .Lset_range_hi // if bit lo and hi in same longint, keep
+ // current mask and adjust for hi bit
+ subic. r9,r9,4 // bit hi in next longint?
+ or r5,r5,r10 // merge and
+ stw r5,0(r3) // store current mask
+ li r10,-1 // new mask
+ lwzu r5,4(r3) // load next longint of set
+ beq .Lset_range_hi // bit hi in this longint -> go to adjust for hi
+ subi r3,r3,4
+.Lset_range_loop:
+ subic. r9,r9,4
+ stwu r10,4(r3) // fill longints in between with full mask
+ bne .Lset_range_loop
+ lwzu r5,4(r3) // load next value from set
+.Lset_range_hi: // in all cases, r3 here contains the address of
+ // the longint which contains the hi bit and r4
+ // contains this longint
+ srw r9,r10,r6 // r9 := bitmask shl (31 - (hi mod 32)) =
+ // bitmask with bits higher than hi cleared
+ // (r8 = $0xffffffff unless the first beq was
+ // taken)
+ and r10,r9,r10 // combine lo and hi bitmasks for this longint
+ or r5,r5,r10 // and combine with existing set
+ stw r5,0(r3) // store to set
+.Lset_range_exit:
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
+function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;[public,alias:'FPC_SET_IN_BYTE'];
+{
+ tests if the element b is in the set p, the **zero** flag is cleared if it's present
+
+ on entry: p in r3, b in r4
+}
+asm
+ // get the index of the correct *dword* in the set
+ // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
+ rlwinm r0,r4,31-3+1,3,31-2
+
+ // load dword in which the bit has to be tested
+ lwzx r3,r3,r0
+
+ // r4 := 32 - r4 (no problem if r4 > 32, the rlwnm next does a mod 32)
+ subfic r4,r4,32
+ // r3 := (r3 shr (r4 mod 32)) and 1
+ rlwnm r3,r3,r4,31,31
+end;
+
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+{
+ adds set1 and set2 into set dest
+ on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+ { load the begin of the result set in the data cache }
+ dcbtst 0,r3
+ li r0,8
+ mtctr r0
+ subi r5,r5,4
+ subi r4,r4,4
+ subi r3,r3,4
+ .LMADDSETS1:
+ lwzu r0,4(r4)
+ lwzu r10,4(r5)
+ or r0,r0,r10
+ stwu r0,4(r3)
+ bdnz .LMADDSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+{
+ multiplies (takes common elements of) set1 and set2 result put in dest
+ on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+ { load the begin of the result set in the data cache }
+ dcbtst 0,r3
+ li r0,8
+ mtctr r0
+ subi r5,r5,4
+ subi r4,r4,4
+ subi r3,r3,4
+ .LMMULSETS1:
+ lwzu r0,4(r4)
+ lwzu r10,4(r5)
+ and r0,r0,r10
+ stwu r0,4(r3)
+ bdnz .LMMULSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+{
+ computes the diff from set1 to set2 result in dest
+ on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+ { load the begin of the result set in the data cache }
+ dcbtst 0,r3
+ li r0,8
+ mtctr r0
+ subi r5,r5,4
+ subi r4,r4,4
+ subi r3,r3,4
+ .LMSUBSETS1:
+ lwzu r0,4(r4)
+ lwzu r10,4(r5)
+ andc r0,r0,r10
+ stwu r0,4(r3)
+ bdnz .LMSUBSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+{
+ computes the symetric diff from set1 to set2 result in dest
+ on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+ { load the begin of the result set in the data cache }
+ dcbtst 0,r3
+ li r0,8
+ mtctr r0
+ subi r5,r5,4
+ subi r4,r4,4
+ subi r3,r3,4
+ .LMSYMDIFSETS1:
+ lwzu r0,4(r4)
+ lwzu r10,4(r5)
+ xor r0,r0,r10
+ stwu r0,4(r3)
+ bdnz .LMSYMDIFSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
+function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_COMP_SETS']; compilerproc;
+{
+ compares set1 and set2 zeroflag is set if they are equal
+ on entry: set1 in r3, set2 in r4
+}
+asm
+ li r0,8
+ mtctr r0
+ subi r3,r3,4
+ subi r4,r4,4
+ .LMCOMPSETS1:
+ lwzu r0,4(r3)
+ lwzu r10,4(r4)
+ sub. r0,r0,r10
+ bdnzt cr0*4+eq,.LMCOMPSETS1
+ cntlzw r3,r0
+ srwi. r3,r3,5
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
+function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; compilerproc;
+{
+ on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+ on entry: set1 in r3, set2 in r4
+}
+asm
+ li r0,8
+ mtctr r0
+ subi r3,r3,4
+ subi r4,r4,4
+ .LMCONTAINSSETS1:
+ lwzu r0,4(r3)
+ lwzu r10,4(r4)
+ { set1 and not(set2) = 0? }
+ andc. r0,r0,r10
+ bdnzt cr0*4+eq,.LMCONTAINSSETS1
+ cntlzw r3,r0
+ srwi. r3,r3,5
+end;
+
+
+
+{$ifdef LARGESETS}
+
+procedure do_set(p : pointer;b : word);assembler;[public,alias:'FPC_SET_SET_WORD'];
+{
+ sets the element b in set p works for sets larger than 256 elements
+ not yet use by the compiler so
+}
+asm
+ pushl %eax
+ movl p,%edi
+ movw b,%ax
+ andl $0xfff8,%eax
+ shrl $3,%eax
+ addl %eax,%edi
+ movb 12(%ebp),%al
+ andl $7,%eax
+ btsl %eax,(%edi)
+ popl %eax
+end;
+
+
+procedure do_in(p : pointer;b : word);assembler;[public,alias:'FPC_SET_IN_WORD'];
+{
+ tests if the element b is in the set p the carryflag is set if it present
+ works for sets larger than 256 elements
+}
+asm
+ pushl %eax
+ movl p,%edi
+ movw b,%ax
+ andl $0xfff8,%eax
+ shrl $3,%eax
+ addl %eax,%edi
+ movb 12(%ebp),%al
+ andl $7,%eax
+ btl %eax,(%edi)
+ popl %eax
+end;
+
+
+procedure add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_ADD_SETS_SIZE'];
+{
+ adds set1 and set2 into set dest size is the number of bytes in the set
+}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMADDSETSIZES1:
+ lodsl
+ orl (%ebx),%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMADDSETSIZES1
+end;
+
+
+procedure mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_MUL_SETS_SIZE'];
+{
+ multiplies (i.E. takes common elements of) set1 and set2 result put in
+ dest size is the number of bytes in the set
+}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMMULSETSIZES1:
+ lodsl
+ andl (%ebx),%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMMULSETSIZES1
+end;
+
+
+procedure sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SUB_SETS_SIZE'];
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMSUBSETSIZES1:
+ lodsl
+ movl (%ebx),%edx
+ notl %edx
+ andl %edx,%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz .LMSUBSETSIZES1
+end;
+
+
+procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SYMDIF_SETS_SIZE'];
+{
+ computes the symetric diff from set1 to set2 result in dest
+}
+asm
+ movl set1,%esi
+ movl set2,%ebx
+ movl dest,%edi
+ movl size,%ecx
+ .LMSYMDIFSETSIZE1:
+ lodsl
+ movl (%ebx),%edx
+ xorl %edx,%eax
+ stosl
+ addl $4,%ebx
+ decl %ecx
+ jnz LMSYMDIFSETSIZE1
+end;
+
+
+procedure comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias:'FPC_SET_COMP_SETS_SIZE'];
+asm
+ movl set1,%esi
+ movl set2,%edi
+ movl size,%ecx
+ LMCOMPSETSIZES1:
+ lodsl
+ movl (%edi),%edx
+ cmpl %edx,%eax
+ jne LMCOMPSETSIZEEND
+ addl $4,%edi
+ decl %ecx
+ jnz LMCOMPSETSIZES1
+ { we are here only if the two sets are equal
+ we have zero flag set, and that what is expected }
+ LMCOMPSETSIZEEND:
+end;
+
+{$IfNDef NoSetInclusion}
+procedure contains_sets(set1,set2 : pointer; size: longint);assembler;[public,alias:'FPC_SET_CONTAINS_SETS'];
+{
+ on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+}
+asm
+ movl set1,%esi
+ movl set2,%edi
+ movl size,%ecx
+ LMCONTAINSSETS2:
+ movl (%esi),%eax
+ movl (%edi),%edx
+ andl %eax,%edx
+ cmpl %edx,%eax {set1 and set2 = set1?}
+ jne LMCONTAINSSETEND2
+ addl $4,%esi
+ addl $4,%edi
+ decl %ecx
+ jnz LMCONTAINSSETS2
+ { we are here only if set2 contains set1
+ we have zero flag set, and that what is expected }
+ LMCONTAINSSETEND2:
+end;
+{$EndIf NoSetInclusion}
+
+
+{$endif LARGESET}
+
+{
+ $Log: set.inc,v $
+ Revision 1.24 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/setjump.inc b/rtl/powerpc/setjump.inc
new file mode 100644
index 0000000000..cdcc2c1b7b
--- /dev/null
+++ b/rtl/powerpc/setjump.inc
@@ -0,0 +1,117 @@
+{
+ $Id: setjump.inc,v 1.10 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ SetJmp and LongJmp implementation for exception handling
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; nostackframe;
+ asm
+ stw r1,0(r3)
+ mflr r0
+ stw r2,4(r3)
+ stw r14,12(r3)
+ stfd f14,88(r3)
+ stw r0,8(r3)
+ stw r15,16(r3)
+ stfd f15,96(r3)
+ mfcr r0
+ stw r16,20(r3)
+ stfd f16,104(r3)
+ stw r0,84(r3)
+ stw r17,24(r3)
+ stfd f17,112(r3)
+ stw r18,28(r3)
+ stfd f18,120(r3)
+ stw r19,32(r3)
+ stfd f19,128(r3)
+ stw r20,36(r3)
+ stfd f20,136(r3)
+ stw r21,40(r3)
+ stfd f21,144(r3)
+ stw r22,44(r3)
+ stfd f22,152(r3)
+ stw r23,48(r3)
+ stfd f23,160(r3)
+ stw r24,52(r3)
+ stfd f24,168(r3)
+ stw r25,56(r3)
+ stfd f25,176(r3)
+ stw r26,60(r3)
+ stfd f26,184(r3)
+ stw r27,64(r3)
+ stfd f27,192(r3)
+ stw r28,68(r3)
+ stfd f28,200(r3)
+ stw r29,72(r3)
+ stfd f29,208(r3)
+ stw r30,76(r3)
+ stfd f30,216(r3)
+ stw r31,80(r3)
+ stfd f31,224(r3)
+ li r3,0
+ end;
+
+procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; nostackframe;
+ asm
+ lwz r1,0(r3)
+ lwz r2,4(r3)
+ lwz r0,8(r3)
+ lwz r14,12(r3)
+ lfd f14,88(r3)
+ lwz r15,16(r3)
+ lfd f15,96(r3)
+ lwz r16,20(r3)
+ lfd f16,104(r3)
+ lwz r17,24(r3)
+ lfd f17,112(r3)
+ lwz r18,28(r3)
+ lfd f18,120(r3)
+ lwz r19,32(r3)
+ lfd f19,128(r3)
+ lwz r20,36(r3)
+ lfd f20,136(r3)
+ mtlr r0
+ lwz r21,40(r3)
+ lfd f21,144(r3)
+ lwz r22,44(r3)
+ lfd f22,152(r3)
+ lwz r0,84(r3)
+ lwz r23,48(r3)
+ lfd f23,160(r3)
+ lwz r24,52(r3)
+ lfd f24,168(r3)
+ lwz r25,56(r3)
+ lfd f25,176(r3)
+ mtcrf 0xff,r0
+ lwz r26,60(r3)
+ lfd f26,184(r3)
+ lwz r27,64(r3)
+ lfd f27,192(r3)
+ lwz r28,68(r3)
+ lfd f28,200(r3)
+ lwz r29,72(r3)
+ lfd f29,208(r3)
+ lwz r30,76(r3)
+ lfd f30,216(r3)
+ lwz r31,80(r3)
+ lfd f31,224(r3)
+ mr r3,r4
+ end;
+
+{
+ $Log: setjump.inc,v $
+ Revision 1.10 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/setjumph.inc b/rtl/powerpc/setjumph.inc
new file mode 100644
index 0000000000..b8becaddee
--- /dev/null
+++ b/rtl/powerpc/setjumph.inc
@@ -0,0 +1,33 @@
+{
+ $Id: setjumph.inc,v 1.7 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000-2002 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ SetJmp/Longjmp declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ jmp_buf = packed record
+ r1,r2,lr,r14,r15,r16,r17,r18,r19,r20,r21,r22,r23,r24,r25,r26,r27,r28,r29,r30,r31,cr : dword;
+ f14,f15,f16,f17,f18,f19,f20,f21,f22,f23,f24,f25,f26,f27,f28,f29,f30,f31 : double;
+ end;
+ pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : longint;
+procedure longjmp(var S : jmp_buf;value : longint);
+
+{
+ $Log: setjumph.inc,v $
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/strings.inc b/rtl/powerpc/strings.inc
new file mode 100644
index 0000000000..476bafef92
--- /dev/null
+++ b/rtl/powerpc/strings.inc
@@ -0,0 +1,508 @@
+{
+ $Id: strings.inc,v 1.29 2005/04/28 18:22:34 olle Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, that can be shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ Note: the implementation of these routines is for BIG ENDIAN only!! (JM) }
+
+{$ifndef FPC_UNIT_HAS_STRCOPY}
+{$define FPC_UNIT_HAS_STRCOPY}
+function strcopy(dest,source : pchar) : pchar;assembler;
+{ in: dest in r3, source in r4 }
+{ out: result (dest) in r3 }
+asm
+{ in: dest in r3, source in r4 }
+{ out: result (dest) in r3 }
+ { load the begin of the source string in the data cache }
+ dcbt 0,r4
+ { get # of misaligned bytes }
+ rlwinm. r10,r4,0,31-2+1,31
+ subfic r10,r10,4
+ mtctr r10
+ { since we have to return dest intact, use another register for }
+ { dest in the copy loop }
+ subi r9,r3,1
+ subi r4,r4,1
+ beq .LStrCopyAligned
+.LStrCopyAlignLoop:
+ { load next byte }
+ lbzu r0,1(r4)
+ { end of string? }
+ cmplwi cr0,r0,0
+ { store byte }
+ stbu r0,1(r9)
+ { loop if misaligned bytes left and not end of string found }
+ bdnzf cr0*4+eq,.LStrCopyAlignLoop
+ beq .LStrCopyDone
+.LStrCopyAligned:
+ subi r4,r4,3
+ subi r9,r9,3
+ { setup magic constants }
+ {$ifdef macos}
+ { load constant 0xfefefeff }
+ lis r8,0xfefe
+ ori r8,r8,0xfeff
+ { load constant 0x80808080}
+ lis r7,0x8080
+ ori r7,r7,0x8080
+ {$else}
+ lis r8,(0xfefefeff)@ha
+ addi r8,r8,(0xfefefeff)@l
+ lis r7,(0x80808080)@ha
+ addi r7,r7,(0x80808080)@l
+ {$endif}
+ { load first 4 bytes }
+ lwzu r0,4(r4)
+
+.LStrCopyAlignedLoop:
+ { test for zero byte }
+ add r10,r0,r8
+ andc r10,r10,r0
+ and. r10,r10,r7
+ bne .LStrCopyEndFound
+ stwu r0,4(r9)
+ { load next 4 bytes (do it here so the load can begin while the }
+ { the branch is processed) }
+ lwzu r0,4(r4)
+ b .LStrCopyAlignedLoop
+.LStrCopyEndFound:
+ { adjust for possible $01 bytes coming before the terminating 0 byte }
+ rlwinm r8,r0,7,0,31
+ andc r10,r10,r8
+ { result is either 0, 8, 16 or 24 depending on which byte is zero }
+ cntlzw r10,r10
+ addi r9,r9,3
+.LStrCopyWrapUpLoop:
+ subic. r10,r10,8
+ rlwinm r0,r0,8,0,31
+ stbu r0,1(r9)
+ bge .LStrCopyWrapUpLoop
+.LStrCopyDone:
+ { r3 still contains dest here }
+end;
+{$endif FPC_UNIT_HAS_STRCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRECOPY}
+{$define FPC_UNIT_HAS_STRECOPY}
+function strecopy(dest,source : pchar) : pchar;assembler;
+{ in: dest in r3, source in r4 }
+{ out: result (end of new dest) in r3 }
+asm
+ { load the begin of the source string in the data cache }
+ dcbt 0,r4
+ { get # of misaligned bytes }
+ rlwinm. r10,r4,0,31-2+1,31
+ subfic r10,r10,4
+ mtctr r10
+ subi r3,r3,1
+ subi r4,r4,1
+ beq .LStrECopyAligned
+.LStrECopyAlignLoop:
+ { load next byte }
+ lbzu r0,1(r4)
+ { end of string? }
+ cmplwi cr0,r0,0
+ { store byte }
+ stbu r0,1(r3)
+ { loop if misaligned bytes left and not end of string found }
+ bdnzf cr0*4+eq,.LStrECopyAlignLoop
+ beq .LStrECopyDone
+.LStrECopyAligned:
+ subi r4,r4,3
+ subi r3,r3,3
+ { setup magic constants }
+ {$ifdef macos}
+ { load constant 0xfefefeff }
+ lis r8,0xfefe
+ ori r8,r8,0xfeff
+ { load constant 0x80808080}
+ lis r7,0x8080
+ ori r7,r7,0x8080
+ {$else}
+ lis r8,(0xfefefeff)@ha
+ addi r8,r8,(0xfefefeff)@l
+ lis r7,(0x80808080)@ha
+ addi r7,r7,(0x80808080)@l
+ {$endif}
+.LStrECopyAlignedLoop:
+
+ { load next 4 bytes }
+ lwzu r0,4(r4)
+
+ { test for zero byte }
+ add r10,r0,r8
+ andc r10,r10,r0
+ and. r10,r10,r7
+ bne .LStrECopyEndFound
+ stwu r0,4(r3)
+ b .LStrECopyAlignedLoop
+.LStrECopyEndFound:
+ { adjust for possible $01 bytes coming before the terminating 0 byte }
+ rlwinm r8,r0,7,0,31
+ andc r10,r10,r8
+ { result is either 0, 8, 16 or 24 depending on which byte is zero }
+ cntlzw r10,r10
+ addi r3,r3,3
+.LStrECopyWrapUpLoop:
+ subic. r10,r10,8
+ rlwinm r0,r0,8,0,31
+ stbu r0,1(r3)
+ bge .LStrECopyWrapUpLoop
+.LStrECopyDone:
+ { r3 contains new dest here }
+end;
+{$endif FPC_UNIT_HAS_STRECOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOPY}
+{$define FPC_UNIT_HAS_STRLCOPY}
+function strlcopy(dest,source : pchar;maxlen : longint) : pchar;assembler;
+{ in: dest in r3, source in r4, maxlen in r5 }
+{ out: result (dest) in r3 }
+asm
+ { load the begin of the source string in the data cache }
+ dcbt 0,r4
+ mtctr r5
+ subi r4,r4,1
+ subi r10,r3,1
+.LStrlCopyLoop:
+ lbzu r0,1(r4)
+ cmplwi r0,0
+ stbu r0,1(r10)
+ bdnzf cr0*4+eq, .LStrlCopyLoop
+ { if we stopped because we copied a #0, we're done }
+ beq .LStrlCopyDone
+ { otherwise add the #0 }
+ li r0,0
+ stb r0,1(r10)
+.LStrlCopyDone:
+end;
+{$endif FPC_UNIT_HAS_STRLCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STREND}
+{$define FPC_UNIT_HAS_STREND}
+function strend(p : pchar) : pchar;assembler;
+{ in: p in r3 }
+{ out: result (end of p) in r3 }
+asm
+ { load the begin of the string in the data cache }
+ dcbt 0,r3
+ { empty/invalid string? }
+ cmplwi r3,0
+ { if yes, do nothing }
+ beq .LStrEndDone
+ subi r3,r3,1
+.LStrEndLoop:
+ lbzu r0,1(r3)
+ cmplwi r0,0
+ bne .LStrEndLoop
+.LStrEndDone:
+end;
+{$endif FPC_UNIT_HAS_STREND}
+
+
+{$ifndef FPC_UNIT_HAS_STRCOMP}
+{$define FPC_UNIT_HAS_STRCOMP}
+function strcomp(str1,str2 : pchar) : longint;assembler;
+{ in: str1 in r3, str2 in r4 }
+{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 }
+{ in r3 }
+asm
+ { use r0 instead of r3 for str1 since r3 contains result }
+ subi r9,r3,1
+ subi r4,r4,1
+.LStrCompLoop:
+ { load next chars }
+ lbzu r0,1(r9)
+ { check if one is zero }
+ cmplwi cr1,r0,0
+ lbzu r10,1(r4)
+ { calculate difference }
+ sub. r3,r0,r10
+ { if chars not equal, we're ready }
+ bne .LStrCompDone
+ { if they are equal and one is zero, then the other one is zero too }
+ { and we're done as well (r3 also contains 0 then) }
+ { otherwise loop }
+ bne cr1,.LStrCompLoop
+.LStrCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOMP}
+{$define FPC_UNIT_HAS_STRLCOMP}
+function strlcomp(str1,str2 : pchar;l : longint) : longint;assembler;
+{ (same as strcomp, but maximally compare until l'th character) }
+{ in: str1 in r3, str2 in r4, l in r5 }
+{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 }
+{ in r3 }
+asm
+ { load the begin of one of the strings in the data cache }
+ dcbt 0,r3
+ { use r0 instead of r3 for str1 since r3 contains result }
+ cmplwi r5,0
+ subi r9,r3,1
+ li r3,0
+ beq .LStrlCompDone
+ mtctr r5
+ subi r4,r4,1
+.LStrlCompLoop:
+ { load next chars }
+ lbzu r0,1(r9)
+ { check if one is zero }
+ cmplwi cr1,r0,0
+ lbzu r10,1(r4)
+ { calculate difference }
+ sub. r3,r0,r10
+ { if chars not equal, we're ready }
+ bne .LStrlCompDone
+ { if they are equal and one is zero, then the other one is zero too }
+ { and we're done as well (r3 also contains 0 then) }
+ { otherwise loop (if ctr <> 0) }
+ bdnzf cr1*4+eq,.LStrlCompLoop
+.LStrlCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRLCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRICOMP}
+{$define FPC_UNIT_HAS_STRICOMP}
+function stricomp(str1,str2 : pchar) : longint;assembler;
+{ in: str1 in r3, str2 in r4 }
+{ out: result of case insensitive comparison (< 0, = 0, > 0) }
+asm
+ { use r5 instead of r3 for str1 since r3 contains result }
+ subi r5,r3,1
+ subi r4,r4,1
+.LStriCompLoop:
+ { load next chars }
+ lbzu r6,1(r5)
+ { check if one is zero }
+ cmplwi cr1,r6,0
+ lbzu r7,1(r4)
+ { calculate difference }
+ sub. r3,r6,r7
+ { if chars are equal, no further test is necessary }
+ beq+ .LStriCompEqual
+
+ { make both lowercase, no branches }
+
+ { r3 := pred('A') - r6 }
+ subfic r3,r6,64
+ { if r6 < 'A' then r8 := 0 else r8 := $ffffffff }
+ subfe r8,r8,r8
+ { same for r7 }
+ subfic r3,r7,64
+ subfe r9,r9,r9
+
+ { r3 := r6 - succ('Z') }
+ subic r3,r6,91
+ { if r6 < 'A' then r8 := 0 else r8 := $20 }
+ andi. r8,r8,0x020
+ { if r6 > Z then r10 := 0 else r10 := $ffffffff }
+ subfe r10,r10,r10
+ { same for r7 }
+ subic r3,r7,91
+ andi. r9,r9,0x020
+ subfe r11,r11,r11
+
+ { if (r6 in ['A'..'Z'] then r8 := $20 else r8 := 0 }
+ and r8,r8,r10
+ { same for r7 }
+ and r9,r9,r11
+
+ { make lowercase }
+ add r6,r6,r8
+ { same for r7 }
+ add r7,r7,r9
+
+ { compare again }
+ sub. r3,r6,r7
+ bne- .LStriCompDone
+.LStriCompEqual:
+ { if they are equal and one is zero, then the other one is zero too }
+ { and we're done as well (r3 also contains 0 then) }
+ { otherwise loop }
+ bne cr1,.LStriCompLoop
+.LStriCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRICOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLICOMP}
+{$define FPC_UNIT_HAS_STRLICOMP}
+function strlicomp(str1,str2 : pchar;l : longint) : longint;assembler;
+{ (same as stricomp, but maximally compare until l'th character) }
+{ in: str1 in r3, str2 in r4, l in r5 }
+{ out: result of case insensitive comparison (< 0, = 0, > 0) }
+asm
+ { load the begin of one of the string in the data cache }
+ dcbt 0,r3
+ { use r0 instead of r3 for str1 since r3 contains result }
+ cmplwi r5,0
+ subi r9,r3,1
+ li r3,0
+ beq- .LStrliCompDone
+ mtctr r5
+ subi r4,r4,1
+.LStrliCompLoop:
+ { load next chars }
+ lbzu r0,1(r9)
+ { check if one is zero }
+ cmplwi cr1,r0,0
+ lbzu r10,1(r4)
+ { calculate difference }
+ sub. r3,r0,r10
+ { if chars are equal, no further test is necessary }
+ beq .LStrliCompEqual
+
+ { see stricomp for explanation }
+
+ subfic r3,r0,64
+ subfe r8,r8,r8
+ subfic r3,r10,64
+ subfe r5,r5,r5
+
+ subic r3,r0,91
+ andi. r8,r8,0x020
+ subfe r7,r7,r7
+ subic r3,r10,91
+ andi. r5,r5,0x020
+ subfe r11,r11,r11
+
+ and r8,r8,r7
+ and r5,r5,r11
+ add r0,r0,r8
+ add r10,r10,r5
+
+ { compare again }
+ sub. r3,r0,r10
+ bne .LStrliCompDone
+.LStrliCompEqual:
+ { if they are equal and one is zero, then the other one is zero too }
+ { and we're done as well (r3 also contains 0 then) }
+ { otherwise loop (if ctr <> 0) }
+ bdnzf cr1*4+eq,.LStrliCompLoop
+.LStrliCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRLICOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRSCAN}
+{$define FPC_UNIT_HAS_STRSCAN}
+function strscan(p : pchar;c : char) : pchar;assembler;
+asm
+ { empty/invalid string? }
+ cmplwi r3,0
+ { if yes, do nothing }
+ beq .LStrScanDone
+ subi r3,r3,1
+.LStrScanLoop:
+ lbzu r0,1(r3)
+ cmplw cr1,r0,r4
+ cmplwi r0,0
+ beq cr1,.LStrScanDone
+ bne .LStrScanLoop
+ li r3, 0
+.LStrScanDone:
+end;
+{$endif FPC_UNIT_HAS_STRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRRSCAN}
+{$define FPC_UNIT_HAS_STRRSCAN}
+function strrscan(p : pchar;c : char) : pchar;assembler;
+asm
+ { empty/invalid string? }
+ cmplwi r3,0
+ { if yes, do nothing }
+ beq .LStrrScanDone
+ { make r5 will be walking through the string }
+ subi r5,r3,1
+ { assume not found }
+ li r3,0
+.LStrrScanLoop:
+ lbzu r10,1(r5)
+ cmplw cr1,r10,r4
+ cmplwi cr0,r10,0
+ bne+ cr1,.LStrrScanNotFound
+ { store address of found position }
+ mr r3,r5
+.LStrrScanNotFound:
+ bne .LStrrScanLoop
+.LStrrScanDone:
+end;
+{$endif FPC_UNIT_HAS_STRRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRUPPER}
+{$define FPC_UNIT_HAS_STRUPPER}
+function strupper(p : pchar) : pchar;assembler;
+asm
+ cmplwi r3,0
+ beq .LStrUpperNil
+ subi r9,r3,1
+.LStrUpperLoop:
+ lbzu r10,1(r9)
+ { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
+ subi r0,r10,97
+ cmplwi r0,122-97
+ cmplwi cr1,r10,0
+ subi r10,r10,0x20
+ bgt .LStrUpper1
+ stb r10,0(r9)
+.LStrUpper1:
+ bne cr1,.LStrUpperLoop
+.LStrUpperNil:
+end;
+{$endif FPC_UNIT_HAS_STRUPPER}
+
+
+{$ifndef FPC_UNIT_HAS_STRLOWER}
+{$define FPC_UNIT_HAS_STRLOWER}
+function strlower(p : pchar) : pchar;assembler;
+asm
+ cmplwi r3,0
+ beq .LStrLowerNil
+ subi r9,r3,1
+.LStrLowerLoop:
+ lbzu r10,1(r9)
+ { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
+ subi r0,r10,65
+ cmplwi r0,90-65
+ cmplwi cr1,r10,0
+ addi r10,r10,0x20
+ bgt .LStrLower1
+ stb r10,0(r9)
+.LStrLower1:
+ bne cr1,.LStrLowerLoop
+.LStrLowerNil:
+end;
+{$endif FPC_UNIT_HAS_STRLOWER}
+
+
+{
+ $Log: strings.inc,v $
+ Revision 1.29 2005/04/28 18:22:34 olle
+ * Fixed loding of magic constant for macos
+
+ Revision 1.28 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/stringss.inc b/rtl/powerpc/stringss.inc
new file mode 100644
index 0000000000..eac245e054
--- /dev/null
+++ b/rtl/powerpc/stringss.inc
@@ -0,0 +1,47 @@
+{
+ $Id: stringss.inc,v 1.14 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, not shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifndef FPC_UNIT_HAS_STRPCOPY}
+{$define FPC_UNIT_HAS_STRPCOPY}
+function strpcopy(d : pchar;const s : string) : pchar;assembler;
+asm
+ { get length }
+ lbz r0,0(r4)
+ { put in counter }
+ cmplwi r0,0
+ mtctr r0
+ subi r10,r3,1
+ beq .LStrPCopyEmpty
+.LStrPCopyLoop:
+ { copy everything }
+ lbzu r0,1(r4)
+ stbu r0,1(r10)
+ bdnz .LStrPCopyLoop
+ { add terminating #0 }
+ li r0,0
+.LStrPCopyEmpty:
+ stb r0,1(r10)
+end;
+{$endif FPC_UNIT_HAS_STRPCOPY}
+
+{
+ $Log: stringss.inc,v $
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/strlen.inc b/rtl/powerpc/strlen.inc
new file mode 100644
index 0000000000..3fa4fe7a23
--- /dev/null
+++ b/rtl/powerpc/strlen.inc
@@ -0,0 +1,40 @@
+{
+ $Id: strlen.inc,v 1.10 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor specific implementation of strlen
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ in: p in r3 }
+{ out: result (length) in r3 }
+asm
+ { load the begin of the string in the data cache }
+ dcbt 0,r3
+ { empty/invalid string? }
+ cmplwi cr0,r3,0
+ { if yes, do nothing }
+ beq .LStrLenDone
+ subi r9,r3,1
+.LStrLenLoop:
+ lbzu r10,1(r9)
+ cmplwi cr0,r10,0
+ bne .LStrLenLoop
+ sub r3,r9,r3
+.LStrLenDone:
+end;
+
+{
+ $Log: strlen.inc,v $
+ Revision 1.10 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/strpas.inc b/rtl/powerpc/strpas.inc
new file mode 100644
index 0000000000..ccf934b8dc
--- /dev/null
+++ b/rtl/powerpc/strpas.inc
@@ -0,0 +1,61 @@
+{
+ $Id: strpas.inc,v 1.12 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor specific implementation of strpas
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ r3: result address
+ r4: src
+}
+asm
+ { nil? }
+ cmplwi r4, 0
+ { load the begin of the string in the data cache }
+ dcbt 0,r4
+ { maxlength }
+ li r10,255
+ mtctr r10
+ { at LStrPasDone, we set the length of the result to 255 - r10 - r4 }
+ { = 255 - 255 - 0 if the soure = nil -> perfect :) }
+ beq .LStrPasDone
+ { save address for at the end and use r5 in loop }
+ mr r5,r3
+ { no "subi r5,r5,1" because the first byte = length byte }
+ subi r4,r4,1
+.LStrPasLoop:
+ lbzu r10,1(r4)
+ cmplwi cr0,r10,0
+ stbu r10,1(r5)
+ bdnzf cr0*4+eq, .LStrPasLoop
+
+ { if we stopped because of a terminating #0, decrease the length by 1 }
+ cntlzw r4,r10
+ { get remaining count for length }
+ mfctr r10
+ { if r10 was zero (-> stopped because of zero byte), then r4 will be 32 }
+ { (32 leading zero bits) -> shr 5 = 1, otherwise this will be zero }
+ srwi r4,r4,5
+.LStrPasDone:
+ subfic r10,r10,255
+ sub r10,r10,r4
+
+ { store length }
+ stb r10,0(r3)
+end;
+
+{
+ $Log: strpas.inc,v $
+ Revision 1.12 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/powerpc/sysutilp.inc b/rtl/powerpc/sysutilp.inc
new file mode 100644
index 0000000000..d4e236f435
--- /dev/null
+++ b/rtl/powerpc/sysutilp.inc
@@ -0,0 +1,81 @@
+{
+ $Id: sysutilp.inc,v 1.9 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 2001 by Jonas Maebe,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+ This include contains cpu-specific routines
+ ---------------------------------------------------------------------}
+
+function InterLockedDecrement (var Target: longint) : longint; assembler;
+{ input: address of target in r3 }
+{ output: target-1 in r3 }
+{ side-effect: target := target-1 }
+asm
+.LInterLockedDecLoop:
+ lwarx r10,0,r3
+ subi r10,r10,1
+ stwcx. r10,0,r3
+ bne .LInterLockedDecLoop
+ mr r3,r10
+end;
+
+
+function InterLockedIncrement (var Target: longint) : longint; assembler;
+{ input: address of target in r3 }
+{ output: target+1 in r3 }
+{ side-effect: target := target+1 }
+asm
+.LInterLockedIncLoop:
+ lwarx r10,0,r3
+ addi r10,r10,1
+ stwcx. r10,0,r3
+ bne .LInterLockedIncLoop
+ mr r3,r10
+end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
+{ input: address of target in r3, source in r4 }
+{ output: target in r3 }
+{ side-effect: target := source }
+asm
+.LInterLockedXchgLoop:
+ lwarx r10,0,r3
+ stwcx. r4,0,r3
+ bne .LInterLockedXchgLoop
+ mr r3,r10
+end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
+{ input: address of target in r3, source in r4 }
+{ output: target in r3 }
+{ side-effect: target := target+source }
+asm
+.LInterLockedXchgAddLoop:
+ lwarx r10,0,r3
+ add r10,r10,r4
+ stwcx. r10,0,r3
+ bne .LInterLockedXchgAddLoop
+ sub r3,r10,r4
+end;
+
+
+{
+ $Log: sysutilp.inc,v $
+ Revision 1.9 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/solaris/Makefile b/rtl/solaris/Makefile
new file mode 100644
index 0000000000..bdf273a0e3
--- /dev/null
+++ b/rtl/solaris/Makefile
@@ -0,0 +1,1907 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=solaris
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+OSPROCINC=$(RTL)/solaris/$(CPU_TARGET)
+POSIXINC=$(RTL)/posix
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+SYSTEMUNIT=system
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+override FPCOPT+=-dFPC_USE_LIBC
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(UNIXINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
+objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+dateutils$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) sysutils$(PPUEXT) math$(PPUEXT) types$(PPUEXT) sysconst$(PPUEXT) $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+strings$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : unixtype$(PPUEXT) sysctl$(PPUEXT) errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ signal.inc bunxh.inc bunxmain.inc \
+ bunxfunc.inc ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+unixtype$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(PPUEXT) $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc \
+ unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+dos$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unix$(PPUEXT) termio$(PPUEXT) $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+objects$(PPUEXT) : dos$(PPUEXT) $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+printer$(PPUEXT) : unix$(PPUEXT) strings$(PPUEXT) baseunix$(PPUEXT) $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sysutils$(PPUEXT) : objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+classes$(PPUEXT) : sysutils$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) typinfo$(PPUEXT) unix$(PPUEXT) systhrds$(PPUEXT) classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+gettext$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+varutils$(PPUEXT) : sysutils$(PPUEXT) $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconst.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+video$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/video.inc $(INC)/videoh.inc $(UNIXINC)/video.pp baseunix$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT)
+keyboard$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/keyboard.inc $(INC)/keybrdh.inc $(UNIXINC)/keyboard.pp mouse$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT) baseunix$(PPUEXT)
+matrix$(PPUEXT) : $(INC)/matrix.pp $(SYSTEMUNIT)$(PPUEXT)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) math$(PPUEXT)
+termio$(PPUEXT) : baseunix$(PPUEXT)
+mouse$(PPUEXT) : baseunix$(PPUEXT) video$(PPUEXT)
+dl$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT) baseunix$(PPUEXT) initc$(PPUEXT)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT) syscall$(PPUEXT)
+terminfo$(PPUEXT) : terminfo.pp baseunix$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT) unix$(PPUEXT) sysutils$(PPUEXT)
+initc$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+console$(PPUEXT) : baseunix$(PPUEXT) termio$(PPUEXT)
diff --git a/rtl/solaris/Makefile.fpc b/rtl/solaris/Makefile.fpc
new file mode 100644
index 0000000000..2e35699d72
--- /dev/null
+++ b/rtl/solaris/Makefile.fpc
@@ -0,0 +1,256 @@
+#
+# Makefile.fpc for Free Pascal solaris RTL
+#
+
+[package]
+main=rtl
+
+# disabled units: serial ipc
+[target]
+loaders=
+units=$(SYSTEMUNIT) objpas
+
+# macpas strings sysctl baseunix unixtype unixutil \
+# unix initc cmem matrix \
+# dos dl objects printer sockets \
+# sysutils typinfo systhrds classes math varutils \
+# charset ucomplex getopts heaptrc lineinfo \
+# errors terminfo termio video crt mouse keyboard console \
+# variants types sysctl dateutils \
+# sysconst cthreads strutils rtlconst
+
+rsts=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=solaris
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(OSPROCINC) $(POSIXINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC)
+
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+ unix \
+ dos crt objects printer \
+ sysutils typinfo math \
+ cpu mmx getopts heaptrc \
+ errors sockets ipc
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+OSPROCINC=$(RTL)/solaris/$(CPU_TARGET)
+POSIXINC=$(RTL)/posix
+UNIXINC=$(RTL)/unix
+UNITPREFIX=rtl
+
+SYSTEMUNIT=system
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Darwin requires libc, no syscalls
+override FPCOPT+=-dFPC_USE_LIBC
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Use new graph unit ?
+# NEWGRAPH=YES
+# Use LibGGI ?
+# Use
+#
+ifndef USELIBGGI
+USELIBGGI=NO
+endif
+
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
+
+objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+
+dateutils$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) sysutils$(PPUEXT) math$(PPUEXT) types$(PPUEXT) sysconst$(PPUEXT) $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+
+strings$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+baseunix$(PPUEXT) : unixtype$(PPUEXT) sysctl$(PPUEXT) errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+ signal.inc bunxh.inc bunxmain.inc \
+ bunxfunc.inc ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \
+ $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
+
+unixtype$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
+
+unix$(PPUEXT) : unixtype$(PPUEXT) baseunix$(PPUEXT) unixutil$(PPUEXT) strings$(PPUEXT) $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+ unxconst.inc $(UNIXINC)/timezone.inc \
+ unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+unixutil$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) unix$(PPUEXT) $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unix$(PPUEXT) termio$(PPUEXT) $(UNIXINC)/crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+objects$(PPUEXT) : dos$(PPUEXT) $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+printer$(PPUEXT) : unix$(PPUEXT) strings$(PPUEXT) baseunix$(PPUEXT) $(UNIXINC)/printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : sysutils$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) typinfo$(PPUEXT) unix$(PPUEXT) systhrds$(PPUEXT) classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : sysutils$(PPUEXT) $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/rtlconst.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+video$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/video.inc $(INC)/videoh.inc $(UNIXINC)/video.pp baseunix$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT)
+
+keyboard$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) $(INC)/keyboard.inc $(INC)/keybrdh.inc $(UNIXINC)/keyboard.pp mouse$(PPUEXT) strings$(PPUEXT) terminfo$(PPUEXT) termio$(PPUEXT) baseunix$(PPUEXT)
+
+matrix$(PPUEXT) : $(INC)/matrix.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) math$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+termio$(PPUEXT) : baseunix$(PPUEXT)
+
+mouse$(PPUEXT) : baseunix$(PPUEXT) video$(PPUEXT)
+
+dl$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+ unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT) baseunix$(PPUEXT) initc$(PPUEXT)
+
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT) syscall$(PPUEXT)
+
+terminfo$(PPUEXT) : terminfo.pp baseunix$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT) unix$(PPUEXT) sysutils$(PPUEXT)
+
+initc$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT)
+
+console$(PPUEXT) : baseunix$(PPUEXT) termio$(PPUEXT)
+
diff --git a/rtl/solaris/errno.inc b/rtl/solaris/errno.inc
new file mode 100644
index 0000000000..f276591859
--- /dev/null
+++ b/rtl/solaris/errno.inc
@@ -0,0 +1,192 @@
+{
+ $Id: errno.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+
+ Errno.inc : define all error numbers, kernel version 1.2.13
+
+ With advent of Solaris target specific. From Unix to Linux and FreeBSD
+ dirs.
+}
+
+
+{MvdV:
+
+The variable Errno was also moved here, but I undid that. The conventions
+ for the FPC Errno and the libc errno differ too much
+
+var
+ Errno : longint; external name 'errno';}
+
+// These are Linux ErrNo - NOT TRANSLATED
+// Most shoul be equal
+// There seem to be some translation, because from 35 upward it is differnt
+
+Const
+
+ESysEPERM = 1; { Operation not permitted }
+ESysENOENT = 2; { No such file or directory }
+ESysESRCH = 3; { No such process }
+ESysEINTR = 4; { Interrupted system call }
+ESysEIO = 5; { I/O error }
+ESysENXIO = 6; { No such device or address }
+ESysE2BIG = 7; { Arg list too long }
+ESysENOEXEC = 8; { Exec format error }
+ESysEBADF = 9; { Bad file number }
+ESysECHILD = 10; { No child processes }
+ESysEAGAIN = 11; { Try again }
+ESysENOMEM = 12; { Out of memory }
+ESysEACCES = 13; { Permission denied }
+ESysEFAULT = 14; { Bad address }
+ESysENOTBLK = 15; { Block device required }
+ESysEBUSY = 16; { Device or resource busy }
+ESysEEXIST = 17; { File exists }
+ESysEXDEV = 18; { Cross-device link }
+ESysENODEV = 19; { No such device }
+ESysENOTDIR = 20; { Not a directory }
+ESysEISDIR = 21; { Is a directory }
+ESysEINVAL = 22; { Invalid argument }
+ESysENFILE = 23; { File table overflow }
+ESysEMFILE = 24; { Too many open files }
+ESysENOTTY = 25; { Not a typewriter }
+ESysETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+ESysEFBIG = 27; { File too large }
+ESysENOSPC = 28; { No space left on device }
+ESysESPIPE = 29; { Illegal seek }
+ESysEROFS = 30; { Read-only file system }
+ESysEMLINK = 31; { Too many links }
+ESysEPIPE = 32; { Broken pipe }
+ESysEDOM = 33; { Math argument out of domain of func }
+ESysERANGE = 34; { Math result not representable }
+
+ESysENOMSG = 35; { No message of desired type }
+ESysEIDRM = 36; { Identifier removed }
+ESysECHRNG = 37; { Channel number out of range }
+ESysEL2NSYNC = 38; { Level 2 not synchronized }
+ESysEL3HLT = 39; { Level 3 halted }
+ESysEL3RST = 40; { Level 3 reset }
+ESysELNRNG = 41; { Link number out of range }
+ESysEUNATCH = 42; { Protocol driver not attached }
+ESysENOCSI = 43; { No CSI structure available }
+ESysEL2HLT = 44; { Level 2 halted }
+ESysEDEADLK = 45; { Resource deadlock would occur }
+ESysENOLCK = 46; { No record locks available }
+ESysECANCELED = 47;
+ESysENOTSUP = 48;
+ESysEDQUOT = 49;
+ESysEBADE = 50; { Invalid exchange }
+ESysEBADR = 51; { Invalid request descriptor }
+ESysEXFULL = 52; { Exchange full }
+ESysENOANO = 53; { No anode }
+ESysEBADRQC = 54; { Invalid request code }
+ESysEBADSLT = 55; { Invalid slot }
+ESysEDEADLOCK = 56; { File locking deadlock error }
+ESysEBFONT = 57; { Bad font file format }
+ESysEOWNERDEAD = 58;
+ESysENOTRECOVERABLE = 59;
+ESysENOSTR = 60; { Device not a stream }
+ESysENODATA = 61; { No data available }
+ESysETIME = 62; { Timer expired }
+ESysENOSR = 63; { Out of streams resources }
+ESysENONET = 64; { Machine is not on the network }
+ESysENOPKG = 65; { Package not installed }
+ESysEREMOTE = 66; { Object is remote }
+ESysENOLINK = 67; { Link has been severed }
+ESysEADV = 68; { Advertise error }
+ESysESRMNT = 69; { Srmount error }
+ESysECOMM = 70; { Communication error on send }
+ESysEPROTO = 71; { Protocol error }
+ESysELOCKUNMAPPED = 72;
+ESysENOTACTIVE = 73;
+ESysEMULTIHOP = 74; { Multihop attempted }
+ESysEBADMSG = 77; { Not a data message }
+
+ESysENAMETOOLONG= 78;
+ESysEOVERFLOW = 79; { Value too large for defined data type }
+ESysENOTUNIQ = 80; { Name not unique on network }
+ESysEBADFD = 81; { File descriptor in bad state }
+ESysEREMCHG = 82; { Remote address changed }
+ESysELIBACC = 83; { Can not access a needed shared library }
+ESysELIBBAD = 84; { Accessing a corrupted shared library }
+ESysELIBSCN = 85; { .lib section in a.out corrupted }
+ESysELIBMAX = 86; { Attempting to link in too many shared libraries }
+ESysELIBEXEC = 87; { Cannot exec a shared library directly }
+ESysEILSEQ = 88; { Illegal byte sequence }
+ESysELOOP = 90; { Too many symbolic links encountered }
+ESysERESTART = 91; { Interrupted system call should be restarted }
+ESysESTRPIPE = 92; { Streams pipe error }
+ESysENOTEMPTY = 93; { Directory not empty }
+ESysEUSERS = 94; { Too many users }
+ESysENOTSOCK = 95; { Socket operation on non-socket }
+ESysEDESTADDRREQ= 96; { Destination address required }
+ESysEMSGSIZE = 97; { Message too long }
+ESysEPROTOTYPE = 98; { Protocol wrong type for socket }
+ESysENOPROTOOPT = 99; { Protocol not available }
+ESysEPROTONOSUPPORT= 120; { Protocol not supported }
+ESysESOCKTNOSUPPORT= 121; { Socket type not supported }
+ESysEOPNOTSUPP = 122; { Operation not supported on transport endpoint }
+ESysEPFNOSUPPORT= 123; { Protocol family not supported }
+ESysEAFNOSUPPORT= 124; { Address family not supported by protocol }
+ESysEADDRINUSE = 125; { Address already in use }
+ESysEADDRNOTAVAIL= 126; { Cannot assign requested address }
+ESysENETDOWN = 127; { Network is down }
+ESysENETUNREACH = 128; { Network is unreachable }
+ESysENETRESET = 129; { Network dropped connection because of reset }
+ESysECONNABORTED= 130; { Software caused connection abort }
+ESysECONNRESET = 131; { Connection reset by peer }
+ESysENOBUFS = 132; { No buffer space available }
+ESysEISCONN = 133; { Transport endpoint is already connected }
+ESysENOTCONN = 134; { Transport endpoint is not connected }
+ESysESHUTDOWN = 143; { Cannot send after transport endpoint shutdown }
+ESysETOOMANYREFS= 144; { Too many references: cannot splice }
+ESysETIMEDOUT = 145; { Connection timed out }
+ESysECONNREFUSED= 146; { Connection refused }
+ESysEHOSTDOWN = 147; { Host is down }
+ESysEHOSTUNREACH= 148; { No route to host }
+ESysEWOULDBLOCK = ESysEAGAIN; { Operation would block }
+ESysEALREADY = 149; { Operation already in progress }
+ESysEINPROGRESS = 150; { Operation now in progress }
+ESysESTALE = 151; { Stale NFS file handle }
+
+
+(* Linux Errors not supported in Solaris:
+ESysENAMETOOLONG= 36; { File name too long }
+ESysENOSYS = 38; { Function not implemented }
+ESysEDOTDOT = 73; { RFS specific error }
+ESysEUCLEAN = 117; { Structure needs cleaning }
+ESysENOTNAM = 118; { Not a XENIX named type file }
+ESysENAVAIL = 119; { No XENIX semaphores available }
+ESysEISNAM = 120; { Is a named type file }
+ESysEREMOTEIO = 121; { Remote I/O error }
+ESysEDQUOT = 122; { Quota exceeded }
+*)
+
+{
+ $Log: errno.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/10 17:30:54 peter
+ * renamed to solaris
+
+ Revision 1.4 2005/02/07 22:17:26 peter
+ * updated for 1.9.x unix rtl
+
+}
diff --git a/rtl/solaris/i386/sighnd.inc b/rtl/solaris/i386/sighnd.inc
new file mode 100644
index 0000000000..66ad2ab67a
--- /dev/null
+++ b/rtl/solaris/i386/sighnd.inc
@@ -0,0 +1,73 @@
+{
+ $Id: sighnd.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+ res,fpustate : word;
+begin
+ res:=0;
+ case sig of
+ SIGFPE :
+ begin
+ res:=200;
+(*
+ fpustate:=GetFPUState(SigContext^);
+ if (FpuState and FPU_All) <> 0 then
+ begin
+ { first check the more precise options }
+ if (FpuState and FPU_DivisionByZero)<>0 then
+ res:=200
+ else if (FpuState and FPU_Overflow)<>0 then
+ res:=205
+ else if (FpuState and FPU_Underflow)<>0 then
+ res:=206
+ else if (FpuState and FPU_Denormal)<>0 then
+ res:=216
+ else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
+ res:=207
+ else
+ res:=207; {'Coprocessor Error'}
+ end;
+*)
+ sysResetFPU;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ res:=216;
+ end;
+{ give runtime error at the position where the signal was raised }
+ if res<>0 then
+ HandleErrorAddrFrame(res,pointer(SigContext^.eip),pointer(SigContext^.ebp));
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.5 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/solaris/i386/sighndh.inc b/rtl/solaris/i386/sighndh.inc
new file mode 100644
index 0000000000..433f3dcd29
--- /dev/null
+++ b/rtl/solaris/i386/sighndh.inc
@@ -0,0 +1,39 @@
+{
+ $Id: sighndh.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ Sigcontext and Sigaction
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+ PSigContext = ^TSigContext;
+ TSigContext = record
+ end;
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/solaris/osdefs.inc b/rtl/solaris/osdefs.inc
new file mode 100644
index 0000000000..83f35b683c
--- /dev/null
+++ b/rtl/solaris/osdefs.inc
@@ -0,0 +1,37 @@
+{
+ $Id: osdefs.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ Copyright (c) 2000-2002 by Marco van de Voort
+
+ Target dependent defines used when compileing the baseunix unit
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+{$define usedomain} // Allow uname with "domain" entry.
+ // (which is a GNU extension)
+
+{
+ $Log: osdefs.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:14:36 peter
+ * new files
+
+ Revision 1.1 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/solaris/osmacro.inc b/rtl/solaris/osmacro.inc
new file mode 100644
index 0000000000..56bcfb3cf8
--- /dev/null
+++ b/rtl/solaris/osmacro.inc
@@ -0,0 +1,106 @@
+{
+ $Id: osmacro.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ Copyright (c) 2000-2002 by Marco van de Voort
+
+ The "linux" posixy macro's that are used both in the Baseunx unit as the
+ system unit. Not aliased via public names because I want these to be
+ inlined as much as possible in the future.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by the
+ Free Software Foundation; either version 2 of the License, or (at your
+ option) any later version.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program; if not, write to the Free Software Foundation, Inc.,
+ 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+function FpS_ISDIR(m : TMode): boolean;
+
+begin
+ FpS_ISDIR:=((m and S_IFMT) = S_IFDIR);
+end;
+
+function FpS_ISCHR(m : TMode): boolean;
+begin
+ FpS_ISCHR:=((m and S_IFMT) = S_IFCHR);
+end;
+
+function FpS_ISBLK(m : TMode): boolean;
+begin
+ FpS_ISBLK:=((m and S_IFMT) = S_IFBLK);
+end;
+
+function FpS_ISREG(m : TMode): boolean;
+begin
+ FpS_ISREG:=((m and S_IFMT) = S_IFREG);
+end;
+
+function FpS_ISFIFO(m : TMode): boolean;
+begin
+ FpS_ISFIFO:=((m and S_IFMT) = S_IFIFO);
+end;
+
+Function FPS_ISLNK(m:TMode):boolean;
+
+begin
+ FPS_ISLNK:=((m and S_IFMT) = S_IFLNK);
+end;
+
+Function FPS_ISSOCK(m:TMode):boolean;
+
+begin
+ FPS_ISSOCK:=((m and S_IFMT) = S_IFSOCK);
+end;
+
+function wifexited(status : cint): boolean;
+begin
+ wifexited:=(status AND $7f) =0;
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=(status and $FF00) shr 8;
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=(status and $FF00) shr 8;
+end;
+
+const wstopped=127;
+
+function wifsignaled(status : cint): boolean;
+begin
+ wifsignaled:=((status and $FF)<>wstopped) and ((status and 127)<>0);
+end;
+
+function wtermsig(status : cint):cint;
+
+begin
+ wtermsig:=cint(status and 127);
+end;
+
+{
+ $Log: osmacro.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.2 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.4 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/solaris/ostypes.inc b/rtl/solaris/ostypes.inc
new file mode 100644
index 0000000000..896cb6657f
--- /dev/null
+++ b/rtl/solaris/ostypes.inc
@@ -0,0 +1,208 @@
+{
+ $Id: ostypes.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Types and structures for the BaseUnix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+{***********************************************************************}
+{ Base Unix Structures }
+{***********************************************************************}
+
+{$IFDEF FPC_IS_SYSTEM}
+ {$i ptypes.inc}
+{$ENDIF}
+
+CONST
+ FD_MAXFDSET = 1024;
+ BITSINWORD = 8*sizeof(longint);
+ wordsinsigset = SIG_MAXSIG DIV BITSINWORD; // words in sigset_t
+ wordsinfdset = FD_MAXFDSET DIV BITSINWORD; // words in fdset_t
+ ln2bitsinword = 5; { 32bit : ln(32)/ln(2)=5 }
+ ln2bitmask = 1 shl ln2bitsinword - 1;
+
+ UTSNAME_LENGTH = 256; { 256 + 1 in pchar format }
+ UTSNAME_NODENAME_LENGTH = 256;
+
+ ST_FSTYPSZ = 16; {* array size for file system type name *}
+
+TYPE
+ blksize_t = longint;
+ blkcnt_t = longint;
+
+ { file characteristics services }
+ stat = packed record { verify the alignment of the members }
+ st_dev : dev_t;
+ st_pad1 : array[1..3] of longint; { reserve for dev expansion }
+ st_ino : ino_t;
+ st_mode : mode_t;
+ st_nlink : nlink_t;
+ st_uid : uid_t;
+ st_gid : gid_t;
+ st_rdev : dev_t;
+ st_pad2 : array[1..2] of longint;
+ st_size : off_t;
+ st_pad3 : longint; {* reserve pad for future off_t expansion *}
+ st_atime : time_t;
+ st_atimens : longint; { access time nanosecond field }
+ st_mtime : time_t;
+ st_mtimens : longint; { modification time nanosecond field }
+ st_ctime : time_t;
+ st_ctimens : longint; { modification time nanosecond field }
+ st_blksize : blksize_t;
+ st_blocks : blkcnt_t;
+ st_fstype : array[0..ST_FSTYPSZ-1] of char;
+ st_pad4 : array[1..8] of longint;
+ end;
+ TStat = Stat;
+ PStat = ^Stat;
+
+ flock = record
+ {$ifdef 64bitfs}
+ l_start : off64_t; { starting offset }
+ l_len : off64_t; { len = 0 means until end of file }
+ {$else}
+ l_start : off_t; { starting offset }
+ l_len : off_t; { len = 0 means until end of file }
+ {$endif}
+ l_pid : pid_t; { lock owner }
+ l_type : cshort; { lock type: read/write, etc. }
+ l_whence: cshort; { type of l_start }
+ end;
+ TFlock = flock;
+ pFlock = ^flock;
+
+ TFDSet = array[0..(FD_MAXFDSET div 32)-1] of Cardinal;
+ pFDSet = ^TFDSet;
+
+ timezone = packed record
+ tz_minuteswest,tz_dsttime:cint;
+ end;
+ ptimezone =^timezone;
+ TTimeZone = timezone;
+
+ { system information services }
+ utsname = packed record { don't forget to verify the alignment }
+ sysname : array[0..UTSNAME_LENGTH] of char;
+ nodename : array[0..UTSNAME_LENGTH] of char;
+ release : array[0..UTSNAME_LENGTH] of char;
+ version : array[0..UTSNAME_LENGTH] of char;
+ machine : array[0..UTSNAME_LENGTH] of char;
+ end;
+
+ UTimBuf = Record
+ actime : time_t;
+ modtime : time_t;
+ end;
+ TUtimBuf = UtimBuf;
+ pUtimBuf = ^UtimBuf;
+
+ { directory services }
+ pdirent = ^dirent;
+ dirent = packed record { directory entry record - verify alignment }
+ d_ino : ino_t; {* "inode number" of entry *}
+ d_off : off_t; {* offset of disk directory entry *}
+ d_reclen : word; {* length of this record *}
+ d_name : array[0..255] of char; { name of file }
+ end;
+
+
+ pdir = ^dir;
+ dir = packed record
+ d_fd : cint; {* file descriptor *}
+ d_loc : cint; {* offset in block *}
+ d_size : cint; {* amount of valid data *}
+ d_buf : pchar; { directory block }
+ end;
+
+
+
+{***********************************************************************}
+{ POSIX CONSTANT ROUTINE DEFINITIONS }
+{***********************************************************************}
+CONST
+ { access routine - these maybe OR'ed together }
+ F_OK = 0; { test for existence of file }
+ R_OK = 4; { test for read permission on file }
+ W_OK = 2; { test for write permission on file }
+ X_OK = 1; { test for execute or search permission }
+ { seek routine }
+ SEEK_SET = 0; { seek from beginning of file }
+ SEEK_CUR = 1; { seek from current position }
+ SEEK_END = 2; { seek from end of file }
+ { open routine }
+ { File access modes for `open' and `fcntl'. }
+ O_RDONLY = 0; { Open read-only. }
+ O_WRONLY = 1; { Open write-only. }
+ O_RDWR = 2; { Open read/write. }
+ { Bits OR'd into the second argument to open. }
+ O_CREAT = $100; { Create file if it doesn't exist. }
+ O_EXCL = $400; { Fail if file already ??????. }
+ O_TRUNC = $200; { Truncate file to zero length. }
+ O_NOCTTY = $800; { Don't assign a controlling terminal. }
+ { File status flags for `open' and `fcntl'. }
+ O_APPEND = $08; { Writes append to the file. }
+ O_NONBLOCK = $80; { Non-blocking I/O. }
+
+
+ { mode_t possible values }
+ S_IRUSR = $100; { Read permission for owner }
+ S_IWUSR = $080; { Write permission for owner }
+ S_IXUSR = $040; { Exec permission for owner }
+ S_IRGRP = $020; { Read permission for group }
+ S_IWGRP = $010; { Write permission for group }
+ S_IXGRP = $008; { Exec permission for group }
+ S_IROTH = $004; { Read permission for world }
+ S_IWOTH = $002; { Write permission for world }
+ S_IXOTH = $001; { Exec permission for world }
+
+ { Used for waitpid }
+ WNOHANG = $40; { don't block waiting }
+ WUNTRACED = $04; { report status of stopped children }
+
+Const
+ S_IFMT = 61440;
+ S_IFIFO = 4096;
+ S_IFCHR = 8192;
+ S_IFDIR = 16384;
+ S_IFBLK = 24576;
+ S_IFREG = 32768;
+ S_IFLNK = 40960;
+ S_IFSOCK= 49152;
+ S_IFWHT = 57344;
+ S_ISVTX = 512;
+
+CONST
+ { Constansts for MMAP }
+ MAP_PRIVATE =2;
+ MAP_ANONYMOUS =$1000;
+
+
+
+{$i signal.inc}
+
+
+{
+ $Log: ostypes.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.3 2005/02/14 16:32:41 peter
+ * solaris updates
+
+ Revision 1.2 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.1 2005/02/10 17:30:54 peter
+ * renamed to solaris
+
+}
diff --git a/rtl/solaris/ptypes.inc b/rtl/solaris/ptypes.inc
new file mode 100644
index 0000000000..59b054572d
--- /dev/null
+++ b/rtl/solaris/ptypes.inc
@@ -0,0 +1,248 @@
+{
+ $Id: ptypes.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+{ Introduced defines
+ - 64bitfs (should be on if libc switches to a 64-bit system.
+
+All three tested systems (PPC,Alpha,2x i386) gave the same POSIX limits,
+and all three 32-bit systems returned completely identical types too
+(everything 32-bit except dev_t, which is assumed to be a result of devfs
+introduction)
+}
+
+{$I ctypes.inc}
+{$packrecords c}
+
+Type
+
+{$ifndef VER_1_0} // maybe wrong (kernel vs libc)
+ dev_t = cuint64; { used for device numbers }
+{$else}
+ dev_t = int64;
+{$endif}
+ TDev = dev_t;
+ pDev = ^dev_t;
+
+ kDev_t = cushort; // Linux has two different device conventions
+ TkDev = KDev_t; // kernel and glibc. This is kernel.
+ pkDev = ^kdev_t;
+
+ gid_t = cuint32; { used for group IDs }
+ TGid = gid_t;
+ pGid = ^gid_t;
+
+ ino_t = clong; { used for file serial numbers }
+ TIno = ino_t;
+ pIno = ^ino_t;
+
+ mode_t = cuint32; { used for file attributes }
+ TMode = mode_t;
+ pMode = ^mode_t;
+
+ nlink_t = cuint32; { used for link counts }
+ TnLink = nlink_t;
+ pnLink = ^nlink_t;
+
+{$ifdef cpu64}
+ off_t = cint64; { used for file sizes }
+{$else}
+ {$ifdef 64BitFS}
+ off_t = cint64;
+ {$else}
+ off_t = cint;
+ {$endif}
+{$endif}
+ TOff = off_t;
+ pOff = ^off_t;
+
+ pid_t = cint32; { used as process identifier }
+ TPid = pid_t;
+ pPid = ^pid_t;
+
+{$ifdef cpu64}
+ size_t = cuint64; { as definied in the C standard}
+ ssize_t = cint64; { used by function for returning number of bytes }
+ clock_t = cuint64;
+ time_t = cint64; { used for returning the time }
+{$else}
+ size_t = cuint32; { as definied in the C standard}
+ ssize_t = cint32; { used by function for returning number of bytes }
+ clock_t = culong;
+ time_t = clong; { used for returning the time }
+{$endif}
+ TSize = size_t;
+ pSize = ^size_t;
+ TSSize = ssize_t;
+ pSSize = ^ssize_t;
+ TClock = clock_t;
+ pClock = ^clock_t;
+ TTime = time_t;
+ pTime = ^time_t;
+ ptime_t = ^time_t;
+
+ uid_t = cuint32; { used for user ID type }
+ TUid = uid_t;
+ pUid = ^uid_t;
+
+ socklen_t= cuint32;
+ TSockLen = socklen_t;
+ pSockLen = ^socklen_t;
+
+ timeval = packed record
+ tv_sec,
+ tv_usec:clong;
+ end;
+ ptimeval = ^timeval;
+ TTimeVal = timeval;
+
+ timespec = packed record
+ tv_sec : time_t;
+ tv_nsec : clong;
+ end;
+ ptimespec = ^timespec;
+ TTimeSpec = timespec;
+
+ TStatfs = packed record
+ fstype, { File system type }
+ bsize : cint; { Optimal block trensfer size }
+ blocks, { Data blocks in system }
+ bfree, { free blocks in system }
+ bavail, { Available free blocks to non-root users }
+ files, { File nodes in system }
+ ffree : clong; { Free file nodes in system }
+ fsid : array[0..1] of cint; { File system ID }
+ namelen : clong; { Maximum name length in system }
+ spare : array [0..5] of clong; { For later use }
+ end;
+ PStatFS=^TStatFS;
+
+ pthread_t = culong;
+
+ sched_param = record
+ __sched_priority: cint;
+ end;
+
+ pthread_attr_t = record
+ __detachstate: cint;
+ __schedpolicy: cint;
+ __schedparam: sched_param;
+ __inheritsched: cint;
+ __scope: cint;
+ __guardsize: size_t;
+ __stackaddr_set: cint;
+ __stackaddr: pointer;
+ __stacksize: size_t;
+ end;
+
+ _pthread_fastlock = record
+ __status: clong;
+ __spinlock: cint;
+ end;
+
+ pthread_mutex_t = record
+ __m_reserved: cint;
+ __m_count: cint;
+ __m_owner: pointer;
+ __m_kind: cint;
+ __m_lock: _pthread_fastlock;
+ end;
+
+ pthread_mutexattr_t = record
+ __mutexkind: cint;
+ end;
+
+ pthread_cond_t = record
+ __c_lock: _pthread_fastlock;
+ __c_waiting: pointer;
+ __padding: array[0..48-1-sizeof(_pthread_fastlock)-sizeof(pointer)-sizeof(clonglong)] of byte;
+ __align: clonglong;
+ end;
+
+ pthread_condattr_t = record
+ __dummy: cint;
+ end;
+
+ pthread_key_t = cuint;
+
+ pthread_rwlock_t = record
+ __rw_readers: cint;
+ __rw_writer: pointer;
+ __rw_read_waiting: pointer;
+ __rw_write_waiting: pointer;
+ __rw_kind: cint;
+ __rw_pshared: cint;
+ end;
+
+ pthread_rwlockattr_t = record
+ __lockkind: cint;
+ __pshared: cint;
+ end;
+
+ sem_t = record
+ __sem_lock: _pthread_fastlock;
+ __sem_value: cint;
+ __sem_waiting: pointer;
+ end;
+
+
+
+CONST
+ _PTHREAD_MUTEX_TIMED_NP = 0;
+ _PTHREAD_MUTEX_RECURSIVE_NP = 1;
+ _PTHREAD_MUTEX_ERRORCHECK_NP = 2;
+ _PTHREAD_MUTEX_ADAPTIVE_NP = 3;
+
+ _PTHREAD_MUTEX_NORMAL = _PTHREAD_MUTEX_TIMED_NP;
+ _PTHREAD_MUTEX_RECURSIVE = _PTHREAD_MUTEX_RECURSIVE_NP;
+ _PTHREAD_MUTEX_ERRORCHECK = _PTHREAD_MUTEX_ERRORCHECK_NP;
+ _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_NORMAL;
+ _PTHREAD_MUTEX_FAST_NP = _PTHREAD_MUTEX_ADAPTIVE_NP;
+
+
+ { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+ { took idefix' values}
+
+ ARG_MAX = 131072; {4096} { Maximum number of argument size }
+ NAME_MAX = 255; {14} { Maximum number of bytes in filename }
+ PATH_MAX = 4095; {255} { Maximum number of bytes in pathname }
+ SYS_NMLN = 65;
+{$ifdef FPC_USE_LIBC}
+ SIG_MAXSIG = 1024; // highest signal version
+{$else}
+ SIG_MAXSIG = 128; // highest signal version
+{$endif}
+
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+{
+ $Log: ptypes.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:14:36 peter
+ * new files
+
+}
+
diff --git a/rtl/solaris/signal.inc b/rtl/solaris/signal.inc
new file mode 100644
index 0000000000..44eab333dc
--- /dev/null
+++ b/rtl/solaris/signal.inc
@@ -0,0 +1,173 @@
+{
+ $Id: signal.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the types/constants related
+ to signal for Solaris.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ {************************ signals *****************************}
+ { more can be provided. Herein are only included the required }
+ { values. }
+ {**************************************************************}
+ SIGABRT = 6; { abnormal termination }
+ SIGALRM = 14; { alarm clock (used with alarm() }
+ SIGFPE = 8; { illegal arithmetic operation }
+ SIGHUP = 1; { Hangup }
+ SIGILL = 4; { Illegal instruction }
+ SIGINT = 2; { Interactive attention signal }
+ SIGKILL = 9; { Kill, cannot be caught }
+ SIGPIPE = 13; { Broken pipe signal }
+ SIGQUIT = 3; { Interactive termination signal }
+ SIGSEGV = 11; { Detection of invalid memory reference }
+ SIGTERM = 15; { Termination request }
+ SIGUSR1 = 16; { Application defined signal 1 }
+ SIGUSR2 = 17; { Application defined signal 2 }
+ SIGCHLD = 18; { Child process terminated / stopped }
+ SIGCONT = 25; { Continue if stopped }
+ SIGSTOP = 23; { Stop signal. cannot be cuaght }
+ SIGSTP = 24; { Interactive stop signal }
+ SIGTTIN = 26; { Background read from TTY }
+ SIGTTOU = 27; { Background write to TTY }
+ SIGBUS = 10; { Access to undefined memory }
+
+ { Solaris specific signals }
+
+ SIGTRAP = 5; { trace trap (not reset when caught) }
+ SIGIOT = 6; { IOT instruction }
+ SIGEMT = 7; { EMT instruction }
+ SIGSYS = 12; { bad argument to system call }
+ SIGCLD = 18; { child status change }
+ SIGPWR = 19; { power-fail restart }
+ SIGWINCH = 20; { window size change }
+ SIGURG = 21; { urgent socket condition }
+ SIGPOLL = 22; { pollable event occured }
+ SIGIO = SIGPOLL;{ socket I/O possible (SIGPOLL alias) }
+ SIGVTALRM = 28; { virtual timer expired }
+ SIGPROF = 29; { profiling timer expired }
+ SIGXCPU = 30; { exceeded cpu limit }
+ SIGXFSZ = 31; { exceeded file size limit }
+ SIGWAITING = 32; { process's lwps are blocked }
+ SIGLWP = 33; { special signal used by thread library }
+ SIGFREEZE = 34; { special signal used by CPR }
+ SIGTHAW = 35; { special signal used by CPR }
+ SIGCANCEL = 36; { thread cancellation signal used by libthread }
+ SIGLOST = 37; { resource lost (eg, record-lock lost) }
+
+ SIG_BLOCK = 0;
+ SIG_UNBLOCK = 1;
+ SIG_SETMASK = 2;
+
+ SIG_DFL = 0 ;
+ SIG_IGN = 1 ;
+ SIG_ERR = -1 ;
+
+ { definitions for the sa_flags field }
+ SA_ONSTACK = $00000001;
+ SA_RESETHAND = $00000002;
+ SA_RESTART = $00000004;
+ SA_SIGINFO = $00000008;
+ SA_NODEFER = $00000010;
+ SA_NOCLDWAIT = $00010000;
+ SA_WAITSIG = $00010000;
+
+{$ifdef cpu64}
+ SI_PAD_SIZE = ((256 div sizeof(cint)) - 4);
+{$else}
+ SI_PAD_SIZE = ((128 div sizeof(cint)) - 3);
+{$endif}
+
+type
+ SigSet = array[0..wordsinsigset-1] of cint;
+ sigset_t= SigSet;
+ PSigSet = ^SigSet;
+ psigset_t=psigset;
+ TSigSet = SigSet;
+
+ psiginfo = ^tsiginfo;
+ tsiginfo = record
+ si_signo : cint;
+ si_errno : cint;
+ si_code : cint;
+{$ifdef cpu64}
+ si_pad : cint;
+{$endif cpu64}
+ _sifields : record
+ case longint of
+ 0 : ( _pad : array[0..(SI_PAD_SIZE)-1] of longint );
+ 1 : ( _kill : record
+ _pid : pid_t;
+ _uid : uid_t;
+ end );
+ 2 : ( _timer : record
+ _timer1 : dword;
+ _timer2 : dword;
+ end );
+ 3 : ( _rt : record
+ _pid : pid_t;
+ _uid : uid_t;
+ _sigval : pointer;
+ end );
+ 4 : ( _sigchld : record
+ _pid : pid_t;
+ _uid : uid_t;
+ _status : longint;
+ _utime : clock_t;
+ _stime : clock_t;
+ end );
+ 5 : ( _sigfault : record
+ _addr : pointer;
+ _trapno : cint;
+ _pc : pointer;
+ end );
+ 6 : ( _sigpoll : record
+ _band : longint;
+ _fd : longint;
+ end );
+ end;
+ end;
+
+{ CPU dependent TSigContext }
+{$i sighndh.inc}
+
+type
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+ SigActionHandler = procedure(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+
+ SigActionRec = packed record // this is temporary for the migration
+ Sa_Flags : cuint;
+ sa_handler : SigActionHandler;
+ Sa_Mask : SigSet;
+ sa_resv : array[1..2] of cint; { for non-_LP64 platforms only }
+ end;
+ TSigActionRec = SigActionRec;
+ PSigActionRec = ^SigActionRec;
+
+{
+ $Log: signal.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.4 2005/02/14 16:32:41 peter
+ * solaris updates
+
+ Revision 1.3 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.2 2005/02/10 17:30:54 peter
+ * renamed to solaris
+
+}
diff --git a/rtl/solaris/sparc/sighnd.inc b/rtl/solaris/sparc/sighnd.inc
new file mode 100644
index 0000000000..d3fac531bc
--- /dev/null
+++ b/rtl/solaris/sparc/sighnd.inc
@@ -0,0 +1,94 @@
+{
+ $Id: sighnd.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Signal handler is arch dependant due to processor to language
+ exception conversion.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ FPE_INTDIV = 1;
+ FPE_INTOVF = 2;
+ FPE_FLTDIV = 3;
+ FPE_FLTOVF = 4;
+ FPE_FLTUND = 5;
+ FPE_FLTRES = 6;
+ FPE_FLTINV = 7;
+ FPE_FLTSUB = 8;
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+ res : word;
+ addr : pointer;
+begin
+ res:=0;
+ addr:=nil;
+ case sig of
+ SIGFPE :
+ begin
+ addr := siginfo^._sifields._sigfault._addr;
+ res := 207;
+ case siginfo^.si_code of
+ FPE_INTDIV:
+ res:=200;
+ FPE_INTOVF:
+ res:=205;
+ FPE_FLTDIV:
+ res:=200;
+ FPE_FLTOVF:
+ res:=205;
+ FPE_FLTUND:
+ res:=206;
+ FPE_FLTRES,
+ FPE_FLTINV,
+ FPE_FLTSUB:
+ res:=216;
+ else
+ res:=207;
+ end;
+ end;
+ SIGILL,
+ SIGBUS,
+ SIGSEGV :
+ begin
+ addr := siginfo^._sifields._sigfault._addr;
+ res:=216;
+ end;
+ end;
+ { give runtime error at the position where the signal was raised }
+ if res<>0 then
+ HandleErrorAddrFrame(res,addr,nil);
+end;
+
+{
+ $Log: sighnd.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.8 2005/02/05 23:46:12 peter
+ * set addr:=nil for other signals
+
+ Revision 1.7 2005/02/05 23:45:38 peter
+ * sigcontext is invalid, use siginfo only
+
+ Revision 1.6 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/solaris/sparc/sighndh.inc b/rtl/solaris/sparc/sighndh.inc
new file mode 100644
index 0000000000..433f3dcd29
--- /dev/null
+++ b/rtl/solaris/sparc/sighndh.inc
@@ -0,0 +1,39 @@
+{
+ $Id: sighndh.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe,
+ member of the Free Pascal development team.
+
+ Sigcontext and Sigaction
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+ PSigContext = ^TSigContext;
+ TSigContext = record
+ end;
+
+{
+ $Log: sighndh.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.1 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/solaris/sparc/start.inc b/rtl/solaris/sparc/start.inc
new file mode 100644
index 0000000000..266a87e0b4
--- /dev/null
+++ b/rtl/solaris/sparc/start.inc
@@ -0,0 +1,126 @@
+{
+ $Id: start.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ Program startup
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ TCdeclProcedure = procedure; cdecl;
+function atexit(proc:TCdeclProcedure):longint;cdecl;external 'c' name 'atexit';
+procedure _cleanup;cdecl;external 'c' name '_cleanup';
+procedure _DYNAMIC;cdecl;external 'c' name '_DYNAMIC';
+procedure __fpstart;cdecl;external 'c' name '__fpstart';
+procedure PascalMain;cdecl;external name 'PASCALMAIN';
+
+procedure _start;assembler;nostackframe;public name '_start';
+asm
+ // Terminate the stack frame, and reserve space for functions to
+ // drop their arguments.
+ mov %g0, %fp
+ sub %sp, 6*4, %sp
+
+ // Extract the arguments and environment as encoded on the stack. The
+ // argument info starts after one register window (16 words) past the SP.
+ ld [%sp+22*4], %o2
+ sethi %hi(argc),%o1
+ or %o1,%lo(argc),%o1
+ st %o2, [%o1]
+
+ add %sp, 23*4, %o0
+ sethi %hi(argv),%o1
+ or %o1,%lo(argv),%o1
+ st %o0, [%o1]
+
+ // envp=(argc+1)*4+argv
+ inc %o2
+ sll %o2, 2, %o2
+ add %o2, %o0, %o2
+ sethi %hi(envp),%o1
+ or %o1,%lo(envp),%o1
+ st %o2, [%o1]
+
+ // Check to see if there is an _cleanup() function linked in, and if
+ // so, register it with atexit() as the last thing to be run by
+ // atexit().
+ sethi %hi(_cleanup), %o0
+ or %o0, %lo(_cleanup), %o0
+ cmp %o0,%g0
+ be .L1
+ nop
+ call atexit
+ nop
+.L1:
+
+ // Now check to see if we have an _DYNAMIC table, and if so then
+ // we need to register the function pointer previously in %edx, but
+ // now conveniently saved on the stack as the argument to pass to
+ // atexit().
+ sethi %hi(_DYNAMIC), %o0
+ or %o0, %lo(_DYNAMIC), %o0
+ cmp %o0,%g0
+ be .L2
+ nop
+ call atexit
+ nop
+.L2:
+
+ // Register _fini() with atexit(). We will take care of calling _init()
+ // directly.
+ //
+ // sethi %hi(_fini), %o0
+ // or %o0, %lo(_fini), %o0
+ // call atexit
+
+ // Call _init(argc, argv, environ), _fpstart(argc, argv, environ), and
+ // main(argc, argv, environ).
+ ld [%sp+22*4], %o0
+ add %sp, 23*4, %o1
+ add %o0, 1, %o2
+ sll %o2, 2, %o2
+ add %o2, %o1, %o2
+
+ call __fpstart
+ nop
+
+ call PASCALMAIN
+ nop
+
+ // Die very horribly if exit returns
+ unimp
+end;
+
+{
+ $Log: start.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/14 16:32:41 peter
+ * solaris updates
+
+ Revision 1.1 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.8 2005/02/05 23:46:12 peter
+ * set addr:=nil for other signals
+
+ Revision 1.7 2005/02/05 23:45:38 peter
+ * sigcontext is invalid, use siginfo only
+
+ Revision 1.6 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
+
diff --git a/rtl/solaris/sysos.inc b/rtl/solaris/sysos.inc
new file mode 100644
index 0000000000..2799160151
--- /dev/null
+++ b/rtl/solaris/sysos.inc
@@ -0,0 +1,125 @@
+{
+ $Id: sysos.inc,v 1.2 2005/02/13 22:13:20 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const clib = 'c';
+
+type libcint=longint;
+ plibcint=^libcint;
+
+function geterrnolocation: Plibcint; cdecl;external clib name'__errno_location';
+
+function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ geterrno:=geterrnolocation^;
+end;
+
+procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
+begin
+ geterrnolocation^:=err;
+end;
+
+{ OS dependant parts }
+
+{$I errno.inc} // error numbers
+{$I ostypes.inc} // c-types, unix base types, unix base structures
+{$I osmacro.inc}
+
+{$Linklib c}
+{$i oscdeclh.inc}
+
+{*****************************************************************************
+ Error conversion
+*****************************************************************************}
+
+Function PosixToRunError (PosixErrno : longint) : longint;
+{
+ Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+ if PosixErrNo=0 then { Else it will go through all the cases }
+ exit(0);
+ case PosixErrNo of
+ ESysENFILE,
+ ESysEMFILE : Inoutres:=4;
+ ESysENOENT : Inoutres:=2;
+ ESysEBADF : Inoutres:=6;
+ ESysENOMEM,
+ ESysEFAULT : Inoutres:=217;
+ ESysEINVAL : Inoutres:=218;
+ ESysEPIPE,
+ ESysEINTR,
+ ESysEIO,
+ ESysEAGAIN,
+ ESysENOSPC : Inoutres:=101;
+ ESysENAMETOOLONG : Inoutres := 3;
+ ESysEROFS,
+ ESysEEXIST,
+ ESysENOTEMPTY,
+ ESysEACCES : Inoutres:=5;
+ ESysEISDIR : InOutRes:=5;
+ else
+ begin
+ InOutRes := Integer(PosixErrno);
+ end;
+ end;
+ PosixToRunError:=InOutRes;
+end;
+
+Function Errno2InoutRes : longint;
+
+begin
+ Errno2InoutRes:=PosixToRunError(getErrno);
+ InoutRes:=Errno2InoutRes;
+end;
+
+
+
+{*****************************************************************************
+ Low Level File Routines
+*****************************************************************************}
+
+function do_isdevice(handle:longint):boolean;
+begin
+ do_isdevice:= (handle=StdInputHandle) or
+ (handle=StdOutputHandle) or
+ (handle=StdErrorHandle);
+end;
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.2 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.1 2005/02/10 17:30:54 peter
+ * renamed to solaris
+
+ Revision 1.1 2005/02/07 22:17:26 peter
+ * updated for 1.9.x unix rtl
+
+ Revision 1.2 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/solaris/sysosh.inc b/rtl/solaris/sysosh.inc
new file mode 100644
index 0000000000..2b408163fe
--- /dev/null
+++ b/rtl/solaris/sysosh.inc
@@ -0,0 +1,48 @@
+{
+ $Id: sysosh.inc,v 1.2 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ THandle = Longint;
+ TThreadID = THandle;
+
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = record
+ {$warning TODO TRTLCriticalSection}
+ Locked: boolean
+ end;
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.2 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.1 2005/02/10 17:30:54 peter
+ * renamed to solaris
+
+ Revision 1.1 2005/02/07 22:17:26 peter
+ * updated for 1.9.x unix rtl
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/solaris/system.pp b/rtl/solaris/system.pp
new file mode 100644
index 0000000000..742c3b1739
--- /dev/null
+++ b/rtl/solaris/system.pp
@@ -0,0 +1,259 @@
+{
+ $Id: system.pp,v 1.6 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Solaris system unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit System;
+
+interface
+
+{$define FPC_IS_SYSTEM}
+
+{ include system-independent routine headers }
+
+{$I sysunixh.inc}
+
+var argc:longint;
+ argv:PPchar;
+ envp:PPchar;
+
+
+implementation
+
+{ OS independant parts}
+
+{$I system.inc}
+
+{*****************************************************************************
+ Misc. System Dependent Functions
+*****************************************************************************}
+
+{$i start.inc}
+
+procedure System_exit;
+begin
+ Fpexit(cint(ExitCode));
+End;
+
+
+Function ParamCount: Longint;
+Begin
+ Paramcount:=argc-1
+End;
+
+
+function BackPos(c:char; const s: shortstring): integer;
+var
+ i: integer;
+Begin
+ for i:=length(s) downto 0 do
+ if s[i] = c then break;
+ if i=0 then
+ BackPos := 0
+ else
+ BackPos := i;
+end;
+
+
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit. }
+var
+ execpathstr : shortstring;
+
+function paramstr(l: longint) : string;
+ var
+ s: string;
+ s1: string;
+ begin
+ { stricly conforming POSIX applications }
+ { have the executing filename as argv[0] }
+// if l=0 then
+// begin
+// paramstr := execpathstr;
+// end
+// else
+ paramstr:=strpas(argv[l]);
+ end;
+
+Procedure Randomize;
+Begin
+ randseed:=longint(Fptime(nil));
+End;
+
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+function reenable_signal(sig : longint) : boolean;
+var
+ e,oe : TSigSet;
+ i,j : byte;
+begin
+ fillchar(e,sizeof(e),#0);
+ fillchar(oe,sizeof(oe),#0);
+ { set is 1 based PM }
+ dec(sig);
+ i:=sig mod 32;
+ j:=sig div 32;
+ e[j]:=1 shl i;
+ fpsigprocmask(SIG_UNBLOCK,@e,@oe);
+ reenable_signal:=geterrno=0;
+end;
+
+{$i sighnd.inc}
+
+var
+ act: SigActionRec;
+
+Procedure InstallSignals;
+var
+ oldact: SigActionRec;
+begin
+ { Initialize the sigaction structure }
+ { all flags and information set to zero }
+ FillChar(act, sizeof(SigActionRec),0);
+ { initialize handler }
+ act.sa_handler :=@SignalToRunError;
+ act.sa_flags:=SA_SIGINFO;
+ FpSigAction(SIGFPE,act,oldact);
+ FpSigAction(SIGSEGV,act,oldact);
+ FpSigAction(SIGBUS,act,oldact);
+ FpSigAction(SIGILL,act,oldact);
+end;
+
+
+procedure SetupCmdLine;
+var
+ bufsize,
+ len,j,
+ size,i : longint;
+ found : boolean;
+ buf : pchar;
+
+ procedure AddBuf;
+ begin
+ reallocmem(cmdline,size+bufsize);
+ move(buf^,cmdline[size],bufsize);
+ inc(size,bufsize);
+ bufsize:=0;
+ end;
+
+begin
+ GetMem(buf,ARG_MAX);
+ size:=0;
+ bufsize:=0;
+ i:=0;
+ while (i<argc) do
+ begin
+ len:=strlen(argv[i]);
+ if len>ARG_MAX-2 then
+ len:=ARG_MAX-2;
+ found:=false;
+ for j:=1 to len do
+ if argv[i][j]=' ' then
+ begin
+ found:=true;
+ break;
+ end;
+ if bufsize+len>=ARG_MAX-2 then
+ AddBuf;
+ if found then
+ begin
+ buf[bufsize]:='"';
+ inc(bufsize);
+ end;
+ move(argv[i]^,buf[bufsize],len);
+ inc(bufsize,len);
+ if found then
+ begin
+ buf[bufsize]:='"';
+ inc(bufsize);
+ end;
+ if i<argc then
+ buf[bufsize]:=' '
+ else
+ buf[bufsize]:=#0;
+ inc(bufsize);
+ inc(i);
+ end;
+ AddBuf;
+ FreeMem(buf,ARG_MAX);
+end;
+
+
+procedure SysInitStdIO;
+begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := SizeUInt (fpGetPID);
+end;
+
+
+Begin
+ IsConsole := TRUE;
+ IsLibrary := FALSE;
+ StackLength := InitialStkLen;
+ StackBottom := Sptr - StackLength;
+{ Set up signals handlers }
+ InstallSignals;
+{ Setup heap }
+ InitHeap;
+ SysInitExceptions;
+{ Arguments }
+ SetupCmdLine;
+{ Setup stdin, stdout and stderr }
+ SysInitStdIO;
+{ Reset IO Error }
+ InOutRes:=0;
+ InitSystemThreads;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+
+{
+ $Log: system.pp,v $
+ Revision 1.6 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.5 2005/02/14 16:32:41 peter
+ * solaris updates
+
+ Revision 1.4 2005/02/13 22:13:20 peter
+ * get solaris back in shape
+
+ Revision 1.3 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.2 2005/02/10 17:30:54 peter
+ * renamed to solaris
+
+ Revision 1.5 2005/02/07 22:17:26 peter
+ * updated for 1.9.x unix rtl
+
+ Revision 1.4 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/sparc/int64p.inc b/rtl/sparc/int64p.inc
new file mode 100644
index 0000000000..22a6853d76
--- /dev/null
+++ b/rtl/sparc/int64p.inc
@@ -0,0 +1,22 @@
+{
+ $Id: int64p.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains some helper routines for int64 and qword
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: int64p.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/sparc/makefile.cpu b/rtl/sparc/makefile.cpu
new file mode 100644
index 0000000000..0de7cf0dd7
--- /dev/null
+++ b/rtl/sparc/makefile.cpu
@@ -0,0 +1,17 @@
+# $Id: makefile.cpu,v 1.1 2002/11/16 20:10:31 florian Exp $
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=sparc
+# not yet: math set
+
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
+
+#
+# $Log: makefile.cpu,v $
+# Revision 1.1 2002/11/16 20:10:31 florian
+# + sparc specific rtl skeleton added
+#
+#
+#
diff --git a/rtl/sparc/math.inc b/rtl/sparc/math.inc
new file mode 100644
index 0000000000..bb24c6aca5
--- /dev/null
+++ b/rtl/sparc/math.inc
@@ -0,0 +1,71 @@
+{
+ $Id: math.inc,v 1.14 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ Implementation of mathamatical Routines (only for real)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef INTERNCONSTINTF}
+
+{$ifndef FPC_SYSTEM_HAS_ABS}
+ {$define FPC_SYSTEM_HAS_ABS}
+ function fpc_abs_real(d : valreal) : valreal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_SQR}
+ {$define FPC_SYSTEM_HAS_SQR}
+ function fpc_sqr_real(d : valreal) : valreal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+{$endif}
+
+{$ifndef FPC_SYSTEM_HAS_SQRT}
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function fpc_sqrt_real(d : valreal) : valreal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+{$endif}
+
+{$else}
+
+ {$define FPC_SYSTEM_HAS_ABS}
+ function abs(d : extended) : extended;[internproc:fpc_in_abs_real];
+
+ {$define FPC_SYSTEM_HAS_SQR}
+ function sqr(d : extended) : extended;[internproc:fpc_in_sqr_real];
+
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function sqrt(d : extended) : extended;[internproc:fpc_in_sqrt_real];
+
+{$endif}
+
+{
+ $Log: math.inc,v $
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.13 2005/02/14 16:32:41 peter
+ * solaris updates
+
+}
diff --git a/rtl/sparc/mathu.inc b/rtl/sparc/mathu.inc
new file mode 100644
index 0000000000..2217bc7134
--- /dev/null
+++ b/rtl/sparc/mathu.inc
@@ -0,0 +1,128 @@
+{
+ $Id: mathu.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ exported by the system unit }
+function get_fsr : dword;external name 'FPC_GETFSR';
+procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
+
+function GetRoundMode: TFPURoundingMode;
+ begin
+ result:=TFPURoundingMode(get_fsr shr 30);
+ end;
+
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+ begin
+ set_fsr((get_fsr and $3fffffff) or (dword(RoundMode) shl 30));
+ result:=TFPURoundingMode(get_fsr shr 30);
+ end;
+
+
+function GetPrecisionMode: TFPUPrecisionMode;
+ begin
+ result:=pmDouble;
+ end;
+
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+ begin
+ result:=pmDouble;
+ end;
+
+
+function GetExceptionMask: TFPUExceptionMask;
+ var
+ fsr : dword;
+ begin
+ fsr:=get_fsr;
+ result:=[];
+ { invalid operation: bit 27 }
+ if (fsr and (1 shl 27))=0 then
+ include(result,exInvalidOp);
+
+ { zero divide: bit 24 }
+ if (fsr and (1 shl 24))=0 then
+ include(result,exInvalidOp);
+
+ { overflow: bit 26 }
+ if (fsr and (1 shl 26))=0 then
+ include(result,exInvalidOp);
+
+ { underflow: bit 25 }
+ if (fsr and (1 shl 25))=0 then
+ include(result,exUnderflow);
+
+ { Precision (inexact result): bit 23 }
+ if (fsr and (1 shl 23))=0 then
+ include(result,exPrecision);
+ end;
+
+
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+ var
+ fsr : dword;
+ begin
+ fsr:=get_fsr;
+
+ { invalid operation: bit 27 }
+ if (exInvalidOp in mask) then
+ fsr:=fsr and not(1 shl 27)
+ else
+ fsr:=fsr or (1 shl 27);
+
+ { zero divide: bit 24 }
+ if (exZeroDivide in mask) then
+ fsr:=fsr and not(1 shl 24)
+ else
+ fsr:=fsr or (1 shl 24);
+
+ { overflow: bit 26 }
+ if (exOverflow in mask) then
+ fsr:=fsr and not(1 shl 26)
+ else
+ fsr:=fsr or (1 shl 26);
+
+ { underflow: bit 25 }
+ if (exUnderflow in mask) then
+ fsr:=fsr and not(1 shl 25)
+ else
+ fsr:=fsr or (1 shl 25);
+
+ { Precision (inexact result): bit 23 }
+ if (exPrecision in mask) then
+ fsr:=fsr and not(1 shl 23)
+ else
+ fsr:=fsr or (1 shl 23);
+
+ { update control register contents }
+ set_fsr(fsr);
+ end;
+
+
+procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
+ begin
+ set_fsr(get_fsr and $fffffc1f);
+ end;
+
+{
+ $Log: mathu.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/13 18:58:27 florian
+ + FPU controll routines in math unit
+
+}
diff --git a/rtl/sparc/mathuh.inc b/rtl/sparc/mathuh.inc
new file mode 100644
index 0000000000..3b3304ace7
--- /dev/null
+++ b/rtl/sparc/mathuh.inc
@@ -0,0 +1,39 @@
+{
+ $Id: mathuh.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+ type
+ TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
+ TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
+ TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
+ exOverflow, exUnderflow, exPrecision);
+ TFPUExceptionMask = set of TFPUException;
+
+function GetRoundMode: TFPURoundingMode;
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+function GetPrecisionMode: TFPUPrecisionMode;
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+function GetExceptionMask: TFPUExceptionMask;
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
+
+{
+ $Log: mathuh.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/13 18:58:27 florian
+ + FPU controll routines in math unit
+
+}
diff --git a/rtl/sparc/set.inc b/rtl/sparc/set.inc
new file mode 100644
index 0000000000..78a5022c1c
--- /dev/null
+++ b/rtl/sparc/set.inc
@@ -0,0 +1,23 @@
+{
+ $Id: set.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Include file with set operations called by the compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: set.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/sparc/setjump.inc b/rtl/sparc/setjump.inc
new file mode 100644
index 0000000000..635677d2c7
--- /dev/null
+++ b/rtl/sparc/setjump.inc
@@ -0,0 +1,109 @@
+{
+ $Id: setjump.inc,v 1.13 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ SetJmp and LongJmp implementation for exception handling
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{#define ENV(base,reg) [%base + (reg * 4)]
+#define ST_FLUSH_WINDOWS 3
+#define RW_FP [%fp + 0x48]
+}
+
+procedure longjmp(var s : jmp_buf;value:longint);assembler;nostackframe;[Public,alias:'FPC_LONGJMP'];
+ asm
+ // Store our arguments in global registers so we can still
+ // use them while unwinding frames and their register windows.
+
+ ld [%o0+4], %g3 // Cache target FP in register %g3.
+ mov %o0, %g1 // s in %g1
+ orcc %o1, %g0, %g2 // value in %g2
+ be,a .L0 // Branch if zero; else skip delay slot.
+ mov 1, %g2 // Delay slot only hit if zero: VAL = 1.
+.L0:
+ xor %fp, %g3, %o0
+ add %fp, 512, %o1
+ andncc %o0, 4095, %o0
+ bne .Lthread
+ cmp %o1, %g3
+ bl .Lthread
+
+ // Now we will loop, unwinding the register windows up the stack
+ // until the restored %fp value matches the target value in %g3.
+
+.Lloop:
+ cmp %fp, %g3 // Have we reached the target frame?
+ bl,a .Lloop // Loop while current fp is below target.
+ restore // Unwind register window in delay slot.
+ be,a .Lfound // Better have hit it exactly.
+ ld [%g1], %o0 // Delay slot: extract target SP.
+
+.Lthread:
+ {
+ * Do a "flush register windows trap". The trap handler in the
+ * kernel writes all the register windows to their stack slots, and
+ * marks them all as invalid (needing to be sucked up from the
+ * stack when used). This ensures that all information needed to
+ * unwind to these callers is in memory, not in the register
+ * windows.
+ }
+
+ ta 3
+ mov %g1,%o1 // use %o1, since %g1 will be destroyed by the call below
+
+ ld [%o1], %fp // Set saved SP on restore below.
+ sub %fp, 64, %sp // Allocate a register frame.
+ st %g3, [%fp+48] // Set saved FP on restore below.
+
+ ld [%o1+8], %o7 // Set return PC.
+
+ retl
+ restore %g2, 0, %o0 // Restore values from above register frame.
+
+.Lfound:
+ // We have unwound register windows so %fp matches the target.
+ mov %o0, %sp // OK, install new SP.
+
+.Lsp_ok:
+ ld [%g1+8], %o0 // Extract target return PC.
+ jmp %o0+8 // Return there.
+ mov %g2, %o0 // Delay slot: set return value.
+ end;
+
+
+function setjmp(var S:jmp_buf):longint;assembler;nostackframe;[Public,alias:'FPC_SETJMP'];
+ asm
+ // We don't create a stackframe so we can save PC,SP and FP of the caller
+ st %o7, [%o0+8]
+ st %sp, [%o0]
+ st %fp, [%o0+4]
+
+ ld [%o0+8], %o7
+ mov %g0, %o0
+ end;
+
+{
+ $Log: setjump.inc,v $
+ Revision 1.13 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.12 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.11 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+ Revision 1.10 2005/01/20 16:38:28 peter
+ * restore sigprocmask for linux
+
+}
diff --git a/rtl/sparc/setjumph.inc b/rtl/sparc/setjumph.inc
new file mode 100644
index 0000000000..46561073a5
--- /dev/null
+++ b/rtl/sparc/setjumph.inc
@@ -0,0 +1,66 @@
+{******************************************************************************
+ $Id: setjumph.inc,v 1.8 2005/04/24 21:19:22 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000-2002 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ SetJmp/Longjmp declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This file was adapted from
+Guardian:/usr/local/src/glibc-2.2.3/sysdeps/sparc/sparc32# more setjmp.S
+Guardian:/usr/local/src/glibc-2.2.3/sysdeps/sparc/sparc32# more __longjmp.S
+ Copyright (C) 1991, 93, 94, 96, 97, 98 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation; either version 2 of the
+ License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with the GNU C Library; see the file COPYING.LIB. If not,
+ write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+******************************************************************************}
+{@Define the machine-dependent type `jmp_buf'. SPARC version.}
+
+
+type
+ jmp_buf=packed record
+ {stack pointer}
+ JB_SP,
+ {frame pointer}
+ JB_FP,
+ {program counter}
+ JB_PV:Pointer;
+ end;
+ Pjmp_buf=^jmp_buf;
+
+function setjmp(var S:jmp_buf):longint;
+procedure longjmp(var S:jmp_buf;value:longint);
+{
+ $Log: setjumph.inc,v $
+ Revision 1.8 2005/04/24 21:19:22 peter
+ * unblock signal in signalhandler, remove the sigprocmask call
+ from setjmp
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.6 2005/01/20 16:38:28 peter
+ * restore sigprocmask for linux
+
+}
diff --git a/rtl/sparc/sparc.inc b/rtl/sparc/sparc.inc
new file mode 100644
index 0000000000..f4eb7bad5c
--- /dev/null
+++ b/rtl/sparc/sparc.inc
@@ -0,0 +1,380 @@
+{
+ $Id: sparc.inc,v 1.21 2005/02/14 17:13:31 peter Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002-2004 by the Free Pascal development team.
+
+ Processor dependent implementation for the system unit for
+ Sparc
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+ SPARC specific stuff
+****************************************************************************}
+function get_fsr : dword;assembler;nostackframe;[public, alias: 'FPC_GETFSR'];
+ var
+ fsr : dword;
+ asm
+ st %fsr,fsr
+ ld fsr,%o0
+ end;
+
+
+procedure set_fsr(fsr : dword);assembler;[public, alias: 'FPC_SETFSR'];
+ var
+ _fsr : dword;
+ asm
+ // force memory location
+ st fsr,_fsr
+ ld _fsr,%fsr
+ end;
+
+
+function get_got : pointer;assembler;nostackframe;[public, alias: 'FPC_GETGOT'];
+ asm
+ retl
+ add %o7,%l7,%l7
+ end;
+
+
+procedure fpc_cpuinit;
+ begin
+ { enable div by 0 and invalid operation fpu exceptions }
+ { round towards zero; ieee compliant arithmetics }
+ set_fsr((get_fsr and $3fbfffff) or $09000000);
+ end;
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;nostackframe;
+ asm
+ mov %fp,%o0
+ end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
+ asm
+ { framebp = %o0 }
+ { flush register windows, so they are stored in the stack }
+ ta 3
+ ld [%o0+60],%o0
+ { add 8 to skip jmpl and delay slot }
+ add %o0,8,%o0
+ end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;nostackframe;
+ asm
+ { flush register windows, so they are stored in the stack }
+ ta 3
+ { framebp = %o0 }
+ ld [%o0+56],%o0
+ end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+function Sptr:Pointer;assembler;nostackframe;
+ asm
+ mov %sp,%o0
+ end;
+
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;
+{
+ Registers:
+ %l0 temp. to do copying
+ %l1 inc/decrement
+ %l2/l3/l4/l5 qword move
+}
+ asm
+ // count < 0 ?
+ cmp %g0,%i2
+ bge .Lmoveexit
+ nop
+
+ // possible overlap?
+ cmp %i0,%i1
+ bcc .Lnopossibleoverlap
+ nop
+ // source < dest ....
+ add %i0,%i2,%l0
+ // overlap?
+ cmp %l0,%i1
+ // source+count < dest ?
+ bcs .Lnopossibleoverlap
+ nop
+
+ .Lcopybackward:
+ // check alignment of source and dest
+ or %i0,%i1,%l0
+
+ // move src and dest to the end of the blocks
+ // assuming 16 byte block size
+ sub %i2,1,%l1
+ add %i0,%l1,%i0
+ add %i1,%l1,%i1
+{
+ // everything 16 byte aligned ?
+ andcc %l0,15,%l0
+ be .Lmovetwordwise
+ // load direction in delay slot
+ mov -16,%l1
+
+ // adjust according to block size
+ add %i0,8,%i0
+ add %i1,8,%i1
+ andcc %l0,7,%l0
+ be .Lmoveqwordwise
+ mov -8,%l1
+
+// adjust according to block size
+ add %i0,4,%i0
+ add %i1,4,%i1
+ andcc %l0,3,%l0
+ be .Lmovedwordwise
+ mov -4,%l1
+
+// adjust according to block size
+ add %i0,2,%i0
+ add %i1,2,%i1
+ andcc %l0,1,%l0
+ be .Lmovewordwise
+ mov -2,%l1
+
+// adjust according to block size
+ add %i0,1,%i0
+ add %i1,1,%i1
+}
+ ba .Lmovebytewise
+ mov -1,%l1
+
+ .Lnopossibleoverlap:
+ // check alignment of source and dest
+ or %i0,%i1,%l0
+
+ // everything 16 byte aligned ?
+ andcc %l0,15,%l0
+ be .Lmovetwordwise
+ // load direction in delay slot
+ mov 16,%l1
+ andcc %l0,7,%l0
+ be .Lmoveqwordwise
+ mov 8,%l1
+ andcc %l0,3,%l0
+ be .Lmovedwordwise
+ mov 4,%l1
+ andcc %l0,1,%l0
+ be .Lmovewordwise
+ mov 2,%l1
+ ba .Lmovebytewise
+ mov 1,%l1
+
+ .Lmovetwordwise:
+ srl %i2,4,%l6
+ cmp %g0,%l6
+ sll %l6,4,%l7
+ be .Lmoveqwordwise_shift
+ nop
+
+ .Lmovetwordwise_loop:
+ ld [%i0],%l2
+ ld [%i0+4],%l3
+ subcc %l6,1,%l6
+ ld [%i0+8],%l4
+ ld [%i0+12],%l5
+ add %i0,%l1,%i0
+ st %l2,[%i1]
+ st %l3,[%i1+4]
+ st %l4,[%i1+8]
+ st %l5,[%i1+12]
+ add %i1,%l1,%i1
+ bne .Lmovetwordwise_loop
+ nop
+ subcc %i2,%l7,%i2
+ be .Lmoveexit
+ nop
+
+ .Lmoveqwordwise_shift:
+ sra %l1,1,%l1
+ .Lmoveqwordwise:
+ srl %i2,3,%l6
+ cmp %g0,%l6
+ sll %l6,3,%l7
+ be .Lmovedwordwise_shift
+ nop
+
+ .Lmoveqwordwise_loop:
+ ld [%i0],%l2
+ ld [%i0+4],%l3
+ subcc %l6,1,%l6
+ add %i0,%l1,%i0
+ st %l2,[%i1]
+ st %l3,[%i1+4]
+ add %i1,%l1,%i1
+ bne .Lmoveqwordwise_loop
+ nop
+ subcc %i2,%l7,%i2
+ be .Lmoveexit
+ nop
+
+ .Lmovedwordwise_shift:
+ sra %l1,1,%l1
+ .Lmovedwordwise:
+ srl %i2,2,%l6
+ cmp %g0,%l6
+ sll %l6,2,%l7
+ be .Lmovewordwise_shift
+ nop
+
+ .Lmovedwordwise_loop:
+ ld [%i0],%l0
+ subcc %l6,1,%l6
+ add %i0,%l1,%i0
+ st %l0,[%i1]
+ add %i1,%l1,%i1
+ bne .Lmovedwordwise_loop
+ nop
+ subcc %i2,%l7,%i2
+ be .Lmoveexit
+ nop
+
+ .Lmovewordwise_shift:
+ sra %l1,1,%l1
+ .Lmovewordwise:
+ srl %i2,1,%l6
+ cmp %g0,%l6
+ sll %l6,1,%l7
+ be .Lmovebytewise_shift
+ nop
+
+ .Lmovewordwise_loop:
+ lduh [%i0],%l0
+ subcc %l6,1,%l6
+ add %i0,%l1,%i0
+ sth %l0,[%i1]
+ add %i1,%l1,%i1
+ bne .Lmovewordwise_loop
+ nop
+ subcc %i2,%l7,%i2
+ be .Lmoveexit
+ nop
+
+ .Lmovebytewise_shift:
+ sra %l1,1,%l1
+ .Lmovebytewise:
+ cmp %g0,%i2
+ be .Lmoveexit
+ nop
+
+ ldub [%i0],%l0
+ subcc %i2,1,%i2
+ add %i0,%l1,%i0
+ stb %l0,[%i1]
+ add %i1,%l1,%i1
+ bne .Lmovebytewise
+ nop
+ .Lmoveexit:
+ end;
+{$endif FPC_SYSTEM_HAS_MOVE}
+
+
+{****************************************************************************
+ Integer math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}nostackframe;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}
+asm
+ sra %o0,31,%g1
+ add %o0,%g1,%o0
+ xor %o0,%g1,%o0
+end;
+
+var
+ fpc_system_lock : byte;export name 'fpc_system_lock';
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+function declocked(var l : longint) : boolean;assembler;nostackframe;
+asm
+ { usually, we shouldn't lock here so saving the stack frame for these extra intructions is
+ worse the effort, especially while waiting :)
+ }
+.Ldeclocked1:
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ ldstub [%g1],%g1
+ cmp %g1,0
+ bne .Ldeclocked1
+ nop
+
+ ld [%o0],%g1
+ sub %g1,1,%g1
+ st %g1,[%o0]
+
+ subcc %g1,1,%g0
+ addx %g0,%g0,%o0
+
+ { unlock }
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ stb %g0,[%g1]
+end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l : longint);assembler;nostackframe;
+asm
+ { usually, we shouldn't lock here so saving the stack frame for these extra intructions is
+ worse the effort, especially while waiting :)
+ }
+.Linclocked1:
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ ldstub [%g1],%g1
+ cmp %g1,0
+ bne .Linclocked1
+ nop
+
+ ld [%o0],%g1
+ add %g1,1,%g1
+ st %g1,[%o0]
+
+ { unlock }
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ stb %g0,[%g1]
+end;
+
+
+{
+ $Log: sparc.inc,v $
+ Revision 1.21 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.20 2005/02/13 18:58:27 florian
+ + FPU controll routines in math unit
+
+ Revision 1.19 2005/02/07 22:17:48 peter
+ * add $ifdef for move
+
+ Revision 1.18 2005/01/27 21:26:39 florian
+ + getgot function added
+
+ Revision 1.17 2005/01/18 20:37:26 florian
+ * set floating point precision and ieee compliance
+
+}
diff --git a/rtl/sparc/strings.inc b/rtl/sparc/strings.inc
new file mode 100644
index 0000000000..3a8376e09e
--- /dev/null
+++ b/rtl/sparc/strings.inc
@@ -0,0 +1,25 @@
+{
+ $Id: strings.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, that can be shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+ $Log: strings.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/sparc/stringss.inc b/rtl/sparc/stringss.inc
new file mode 100644
index 0000000000..2283d853c6
--- /dev/null
+++ b/rtl/sparc/stringss.inc
@@ -0,0 +1,25 @@
+{
+ $Id: stringss.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, not shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+ $Log: stringss.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/sparc/sysutilp.inc b/rtl/sparc/sysutilp.inc
new file mode 100644
index 0000000000..baf5d5147e
--- /dev/null
+++ b/rtl/sparc/sysutilp.inc
@@ -0,0 +1,134 @@
+{
+ $Id: sysutilp.inc,v 1.5 2005/03/12 18:45:15 florian Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 2003 by Peter Vreman,
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+ This include contains cpu-specific routines
+ ---------------------------------------------------------------------}
+
+var
+ fpc_system_lock : byte;external name 'fpc_system_lock';
+
+function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
+asm
+ { usually, we shouldn't lock here so saving the stack frame for these extra intructions is
+ worse the effort, especially while waiting :)
+ }
+.LInterLockedDecrement1:
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ ldstub [%g1],%g1
+ cmp %g1,0
+ bne .LInterLockedDecrement1
+ nop
+
+ ld [%o0],%g1
+ sub %g1,1,%g1
+ st %g1,[%o0]
+
+ mov %g1,%o0
+
+ { unlock }
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ stb %g0,[%g1]
+end;
+
+function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
+asm
+ { usually, we shouldn't lock here so saving the stack frame for these extra intructions is
+ worse the effort, especially while waiting :)
+ }
+.LInterLockedIncrement1:
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ ldstub [%g1],%g1
+ cmp %g1,0
+ bne .LInterLockedIncrement1
+ nop
+
+ ld [%o0],%g1
+ add %g1,1,%g1
+ st %g1,[%o0]
+
+ mov %g1,%o0
+
+ { unlock }
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ stb %g0,[%g1]
+end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+asm
+ { usually, we shouldn't lock here so saving the stack frame for these extra intructions is
+ worse the effort, especially while waiting :)
+ }
+.LInterLockedExchange1:
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ ldstub [%g1],%g1
+ cmp %g1,0
+ bne .LInterLockedExchange1
+ nop
+
+ ld [%o0],%g1
+ st %o1,[%o0]
+
+ mov %g1,%o0
+
+ { unlock }
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ stb %g0,[%g1]
+end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
+asm
+ { usually, we shouldn't lock here so saving the stack frame for these extra intructions is
+ worse the effort, especially while waiting :)
+ }
+.LInterLockedExchangeAdd1:
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ ldstub [%g1],%g1
+ cmp %g1,0
+ bne .LInterLockedExchangeAdd1
+ nop
+
+ ld [%o0],%g1
+ add %g1,%o1,%o1
+ st %o1,[%o0]
+
+ mov %g1,%o0
+
+ { unlock }
+ sethi %hi(fpc_system_lock), %g1
+ or %g1,%lo(fpc_system_lock), %g1
+ stb %g0,[%g1]
+end;
+
+
+{
+ $Log: sysutilp.inc,v $
+ Revision 1.5 2005/03/12 18:45:15 florian
+ * InterlockedDecrement fixed
+
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/ucmaps/8859-1.txt b/rtl/ucmaps/8859-1.txt
new file mode 100644
index 0000000000..473ecabc17
--- /dev/null
+++ b/rtl/ucmaps/8859-1.txt
@@ -0,0 +1,303 @@
+#
+# Name: ISO/IEC 8859-1:1998 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-1:1998 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-1 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-1 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x00A1 # INVERTED EXCLAMATION MARK
+0xA2 0x00A2 # CENT SIGN
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x00A4 # CURRENCY SIGN
+0xA5 0x00A5 # YEN SIGN
+0xA6 0x00A6 # BROKEN BAR
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAA 0x00AA # FEMININE ORDINAL INDICATOR
+0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC # NOT SIGN
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x00AE # REGISTERED SIGN
+0xAF 0x00AF # MACRON
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x00B1 # PLUS-MINUS SIGN
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x00B4 # ACUTE ACCENT
+0xB5 0x00B5 # MICRO SIGN
+0xB6 0x00B6 # PILCROW SIGN
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x00B8 # CEDILLA
+0xB9 0x00B9 # SUPERSCRIPT ONE
+0xBA 0x00BA # MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC # VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD # VULGAR FRACTION ONE HALF
+0xBE 0x00BE # VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF # INVERTED QUESTION MARK
+0xC0 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 # LATIN CAPITAL LETTER AE
+0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 # LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC # LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x00D0 # LATIN CAPITAL LETTER ETH (Icelandic)
+0xD1 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 # LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 # LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x00DE # LATIN CAPITAL LETTER THORN (Icelandic)
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S (German)
+0xE0 0x00E0 # LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 # LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 # LATIN SMALL LETTER AE
+0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 # LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA # LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC # LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x00F0 # LATIN SMALL LETTER ETH (Icelandic)
+0xF1 0x00F1 # LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 # LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x00FE # LATIN SMALL LETTER THORN (Icelandic)
+0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS
diff --git a/rtl/ucmaps/8859-10.txt b/rtl/ucmaps/8859-10.txt
new file mode 100644
index 0000000000..374a42b1a5
--- /dev/null
+++ b/rtl/ucmaps/8859-10.txt
@@ -0,0 +1,303 @@
+#
+# Name: ISO/IEC 8859-10:1998 to Unicode
+# Unicode version: 3.0
+# Table version: 1.1
+# Table format: Format A
+# Date: 1999 October 11
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-10:1998 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-10 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-10 order.
+#
+# Version history
+# 1.0 version new.
+# 1.1 corrected mistake in mapping of 0xA4
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK
+0xA2 0x0112 # LATIN CAPITAL LETTER E WITH MACRON
+0xA3 0x0122 # LATIN CAPITAL LETTER G WITH CEDILLA
+0xA4 0x012A # LATIN CAPITAL LETTER I WITH MACRON
+0xA5 0x0128 # LATIN CAPITAL LETTER I WITH TILDE
+0xA6 0x0136 # LATIN CAPITAL LETTER K WITH CEDILLA
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x013B # LATIN CAPITAL LETTER L WITH CEDILLA
+0xA9 0x0110 # LATIN CAPITAL LETTER D WITH STROKE
+0xAA 0x0160 # LATIN CAPITAL LETTER S WITH CARON
+0xAB 0x0166 # LATIN CAPITAL LETTER T WITH STROKE
+0xAC 0x017D # LATIN CAPITAL LETTER Z WITH CARON
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x016A # LATIN CAPITAL LETTER U WITH MACRON
+0xAF 0x014A # LATIN CAPITAL LETTER ENG
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x0105 # LATIN SMALL LETTER A WITH OGONEK
+0xB2 0x0113 # LATIN SMALL LETTER E WITH MACRON
+0xB3 0x0123 # LATIN SMALL LETTER G WITH CEDILLA
+0xB4 0x012B # LATIN SMALL LETTER I WITH MACRON
+0xB5 0x0129 # LATIN SMALL LETTER I WITH TILDE
+0xB6 0x0137 # LATIN SMALL LETTER K WITH CEDILLA
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x013C # LATIN SMALL LETTER L WITH CEDILLA
+0xB9 0x0111 # LATIN SMALL LETTER D WITH STROKE
+0xBA 0x0161 # LATIN SMALL LETTER S WITH CARON
+0xBB 0x0167 # LATIN SMALL LETTER T WITH STROKE
+0xBC 0x017E # LATIN SMALL LETTER Z WITH CARON
+0xBD 0x2015 # HORIZONTAL BAR
+0xBE 0x016B # LATIN SMALL LETTER U WITH MACRON
+0xBF 0x014B # LATIN SMALL LETTER ENG
+0xC0 0x0100 # LATIN CAPITAL LETTER A WITH MACRON
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 # LATIN CAPITAL LETTER AE
+0xC7 0x012E # LATIN CAPITAL LETTER I WITH OGONEK
+0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x0116 # LATIN CAPITAL LETTER E WITH DOT ABOVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x00D0 # LATIN CAPITAL LETTER ETH (Icelandic)
+0xD1 0x0145 # LATIN CAPITAL LETTER N WITH CEDILLA
+0xD2 0x014C # LATIN CAPITAL LETTER O WITH MACRON
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x0168 # LATIN CAPITAL LETTER U WITH TILDE
+0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x0172 # LATIN CAPITAL LETTER U WITH OGONEK
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x00DE # LATIN CAPITAL LETTER THORN (Icelandic)
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S (German)
+0xE0 0x0101 # LATIN SMALL LETTER A WITH MACRON
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 # LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 # LATIN SMALL LETTER AE
+0xE7 0x012F # LATIN SMALL LETTER I WITH OGONEK
+0xE8 0x010D # LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x0119 # LATIN SMALL LETTER E WITH OGONEK
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x0117 # LATIN SMALL LETTER E WITH DOT ABOVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x00F0 # LATIN SMALL LETTER ETH (Icelandic)
+0xF1 0x0146 # LATIN SMALL LETTER N WITH CEDILLA
+0xF2 0x014D # LATIN SMALL LETTER O WITH MACRON
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x0169 # LATIN SMALL LETTER U WITH TILDE
+0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xF9 0x0173 # LATIN SMALL LETTER U WITH OGONEK
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x00FE # LATIN SMALL LETTER THORN (Icelandic)
+0xFF 0x0138 # LATIN SMALL LETTER KRA
diff --git a/rtl/ucmaps/8859-13.txt b/rtl/ucmaps/8859-13.txt
new file mode 100644
index 0000000000..cd11b53fd7
--- /dev/null
+++ b/rtl/ucmaps/8859-13.txt
@@ -0,0 +1,299 @@
+#
+# Name: ISO/IEC 8859-13:1998 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-13:1998 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-13 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-13 order.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x201D # RIGHT DOUBLE QUOTATION MARK
+0xA2 0x00A2 # CENT SIGN
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x00A4 # CURRENCY SIGN
+0xA5 0x201E # DOUBLE LOW-9 QUOTATION MARK
+0xA6 0x00A6 # BROKEN BAR
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAA 0x0156 # LATIN CAPITAL LETTER R WITH CEDILLA
+0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC # NOT SIGN
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x00AE # REGISTERED SIGN
+0xAF 0x00C6 # LATIN CAPITAL LETTER AE
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x00B1 # PLUS-MINUS SIGN
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x201C # LEFT DOUBLE QUOTATION MARK
+0xB5 0x00B5 # MICRO SIGN
+0xB6 0x00B6 # PILCROW SIGN
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xB9 0x00B9 # SUPERSCRIPT ONE
+0xBA 0x0157 # LATIN SMALL LETTER R WITH CEDILLA
+0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC # VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD # VULGAR FRACTION ONE HALF
+0xBE 0x00BE # VULGAR FRACTION THREE QUARTERS
+0xBF 0x00E6 # LATIN SMALL LETTER AE
+0xC0 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK
+0xC1 0x012E # LATIN CAPITAL LETTER I WITH OGONEK
+0xC2 0x0100 # LATIN CAPITAL LETTER A WITH MACRON
+0xC3 0x0106 # LATIN CAPITAL LETTER C WITH ACUTE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK
+0xC7 0x0112 # LATIN CAPITAL LETTER E WITH MACRON
+0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0179 # LATIN CAPITAL LETTER Z WITH ACUTE
+0xCB 0x0116 # LATIN CAPITAL LETTER E WITH DOT ABOVE
+0xCC 0x0122 # LATIN CAPITAL LETTER G WITH CEDILLA
+0xCD 0x0136 # LATIN CAPITAL LETTER K WITH CEDILLA
+0xCE 0x012A # LATIN CAPITAL LETTER I WITH MACRON
+0xCF 0x013B # LATIN CAPITAL LETTER L WITH CEDILLA
+0xD0 0x0160 # LATIN CAPITAL LETTER S WITH CARON
+0xD1 0x0143 # LATIN CAPITAL LETTER N WITH ACUTE
+0xD2 0x0145 # LATIN CAPITAL LETTER N WITH CEDILLA
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x014C # LATIN CAPITAL LETTER O WITH MACRON
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x0172 # LATIN CAPITAL LETTER U WITH OGONEK
+0xD9 0x0141 # LATIN CAPITAL LETTER L WITH STROKE
+0xDA 0x015A # LATIN CAPITAL LETTER S WITH ACUTE
+0xDB 0x016A # LATIN CAPITAL LETTER U WITH MACRON
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x017B # LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xDE 0x017D # LATIN CAPITAL LETTER Z WITH CARON
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S (German)
+0xE0 0x0105 # LATIN SMALL LETTER A WITH OGONEK
+0xE1 0x012F # LATIN SMALL LETTER I WITH OGONEK
+0xE2 0x0101 # LATIN SMALL LETTER A WITH MACRON
+0xE3 0x0107 # LATIN SMALL LETTER C WITH ACUTE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x0119 # LATIN SMALL LETTER E WITH OGONEK
+0xE7 0x0113 # LATIN SMALL LETTER E WITH MACRON
+0xE8 0x010D # LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x017A # LATIN SMALL LETTER Z WITH ACUTE
+0xEB 0x0117 # LATIN SMALL LETTER E WITH DOT ABOVE
+0xEC 0x0123 # LATIN SMALL LETTER G WITH CEDILLA
+0xED 0x0137 # LATIN SMALL LETTER K WITH CEDILLA
+0xEE 0x012B # LATIN SMALL LETTER I WITH MACRON
+0xEF 0x013C # LATIN SMALL LETTER L WITH CEDILLA
+0xF0 0x0161 # LATIN SMALL LETTER S WITH CARON
+0xF1 0x0144 # LATIN SMALL LETTER N WITH ACUTE
+0xF2 0x0146 # LATIN SMALL LETTER N WITH CEDILLA
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x014D # LATIN SMALL LETTER O WITH MACRON
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x0173 # LATIN SMALL LETTER U WITH OGONEK
+0xF9 0x0142 # LATIN SMALL LETTER L WITH STROKE
+0xFA 0x015B # LATIN SMALL LETTER S WITH ACUTE
+0xFB 0x016B # LATIN SMALL LETTER U WITH MACRON
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x017C # LATIN SMALL LETTER Z WITH DOT ABOVE
+0xFE 0x017E # LATIN SMALL LETTER Z WITH CARON
+0xFF 0x2019 # RIGHT SINGLE QUOTATION MARK
diff --git a/rtl/ucmaps/8859-14.txt b/rtl/ucmaps/8859-14.txt
new file mode 100644
index 0000000000..36038f413a
--- /dev/null
+++ b/rtl/ucmaps/8859-14.txt
@@ -0,0 +1,301 @@
+#
+# Name: ISO/IEC 8859-14:1998 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Markus Kuhn <mkuhn@acm.org>
+# Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-14:1998 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-14 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-14 order.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x1E02 # LATIN CAPITAL LETTER B WITH DOT ABOVE
+0xA2 0x1E03 # LATIN SMALL LETTER B WITH DOT ABOVE
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x010A # LATIN CAPITAL LETTER C WITH DOT ABOVE
+0xA5 0x010B # LATIN SMALL LETTER C WITH DOT ABOVE
+0xA6 0x1E0A # LATIN CAPITAL LETTER D WITH DOT ABOVE
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x1E80 # LATIN CAPITAL LETTER W WITH GRAVE
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAA 0x1E82 # LATIN CAPITAL LETTER W WITH ACUTE
+0xAB 0x1E0B # LATIN SMALL LETTER D WITH DOT ABOVE
+0xAC 0x1EF2 # LATIN CAPITAL LETTER Y WITH GRAVE
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x00AE # REGISTERED SIGN
+0xAF 0x0178 # LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xB0 0x1E1E # LATIN CAPITAL LETTER F WITH DOT ABOVE
+0xB1 0x1E1F # LATIN SMALL LETTER F WITH DOT ABOVE
+0xB2 0x0120 # LATIN CAPITAL LETTER G WITH DOT ABOVE
+0xB3 0x0121 # LATIN SMALL LETTER G WITH DOT ABOVE
+0xB4 0x1E40 # LATIN CAPITAL LETTER M WITH DOT ABOVE
+0xB5 0x1E41 # LATIN SMALL LETTER M WITH DOT ABOVE
+0xB6 0x00B6 # PILCROW SIGN
+0xB7 0x1E56 # LATIN CAPITAL LETTER P WITH DOT ABOVE
+0xB8 0x1E81 # LATIN SMALL LETTER W WITH GRAVE
+0xB9 0x1E57 # LATIN SMALL LETTER P WITH DOT ABOVE
+0xBA 0x1E83 # LATIN SMALL LETTER W WITH ACUTE
+0xBB 0x1E60 # LATIN CAPITAL LETTER S WITH DOT ABOVE
+0xBC 0x1EF3 # LATIN SMALL LETTER Y WITH GRAVE
+0xBD 0x1E84 # LATIN CAPITAL LETTER W WITH DIAERESIS
+0xBE 0x1E85 # LATIN SMALL LETTER W WITH DIAERESIS
+0xBF 0x1E61 # LATIN SMALL LETTER S WITH DOT ABOVE
+0xC0 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 # LATIN CAPITAL LETTER AE
+0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 # LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC # LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x0174 # LATIN CAPITAL LETTER W WITH CIRCUMFLEX
+0xD1 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 # LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x1E6A # LATIN CAPITAL LETTER T WITH DOT ABOVE
+0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 # LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x0176 # LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 # LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 # LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 # LATIN SMALL LETTER AE
+0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 # LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA # LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC # LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x0175 # LATIN SMALL LETTER W WITH CIRCUMFLEX
+0xF1 0x00F1 # LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 # LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x1E6B # LATIN SMALL LETTER T WITH DOT ABOVE
+0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x0177 # LATIN SMALL LETTER Y WITH CIRCUMFLEX
+0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS
+
diff --git a/rtl/ucmaps/8859-15.txt b/rtl/ucmaps/8859-15.txt
new file mode 100644
index 0000000000..1e319707d4
--- /dev/null
+++ b/rtl/ucmaps/8859-15.txt
@@ -0,0 +1,303 @@
+#
+# Name: ISO/IEC 8859-15:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Markus Kuhn <mkuhn@acm.org>
+# Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-15:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-15 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-15 order.
+#
+# Version history
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x00A1 # INVERTED EXCLAMATION MARK
+0xA2 0x00A2 # CENT SIGN
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x20AC # EURO SIGN
+0xA5 0x00A5 # YEN SIGN
+0xA6 0x0160 # LATIN CAPITAL LETTER S WITH CARON
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x0161 # LATIN SMALL LETTER S WITH CARON
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAA 0x00AA # FEMININE ORDINAL INDICATOR
+0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC # NOT SIGN
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x00AE # REGISTERED SIGN
+0xAF 0x00AF # MACRON
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x00B1 # PLUS-MINUS SIGN
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x017D # LATIN CAPITAL LETTER Z WITH CARON
+0xB5 0x00B5 # MICRO SIGN
+0xB6 0x00B6 # PILCROW SIGN
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x017E # LATIN SMALL LETTER Z WITH CARON
+0xB9 0x00B9 # SUPERSCRIPT ONE
+0xBA 0x00BA # MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x0152 # LATIN CAPITAL LIGATURE OE
+0xBD 0x0153 # LATIN SMALL LIGATURE OE
+0xBE 0x0178 # LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xBF 0x00BF # INVERTED QUESTION MARK
+0xC0 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 # LATIN CAPITAL LETTER AE
+0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 # LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC # LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x00D0 # LATIN CAPITAL LETTER ETH
+0xD1 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 # LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 # LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x00DE # LATIN CAPITAL LETTER THORN
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 # LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 # LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 # LATIN SMALL LETTER AE
+0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 # LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA # LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC # LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x00F0 # LATIN SMALL LETTER ETH
+0xF1 0x00F1 # LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 # LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x00FE # LATIN SMALL LETTER THORN
+0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS
+
diff --git a/rtl/ucmaps/8859-2.txt b/rtl/ucmaps/8859-2.txt
new file mode 100644
index 0000000000..e45df25eb8
--- /dev/null
+++ b/rtl/ucmaps/8859-2.txt
@@ -0,0 +1,303 @@
+#
+# Name: ISO 8859-2:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-2:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-2 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-2 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK
+0xA2 0x02D8 # BREVE
+0xA3 0x0141 # LATIN CAPITAL LETTER L WITH STROKE
+0xA4 0x00A4 # CURRENCY SIGN
+0xA5 0x013D # LATIN CAPITAL LETTER L WITH CARON
+0xA6 0x015A # LATIN CAPITAL LETTER S WITH ACUTE
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x0160 # LATIN CAPITAL LETTER S WITH CARON
+0xAA 0x015E # LATIN CAPITAL LETTER S WITH CEDILLA
+0xAB 0x0164 # LATIN CAPITAL LETTER T WITH CARON
+0xAC 0x0179 # LATIN CAPITAL LETTER Z WITH ACUTE
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x017D # LATIN CAPITAL LETTER Z WITH CARON
+0xAF 0x017B # LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x0105 # LATIN SMALL LETTER A WITH OGONEK
+0xB2 0x02DB # OGONEK
+0xB3 0x0142 # LATIN SMALL LETTER L WITH STROKE
+0xB4 0x00B4 # ACUTE ACCENT
+0xB5 0x013E # LATIN SMALL LETTER L WITH CARON
+0xB6 0x015B # LATIN SMALL LETTER S WITH ACUTE
+0xB7 0x02C7 # CARON
+0xB8 0x00B8 # CEDILLA
+0xB9 0x0161 # LATIN SMALL LETTER S WITH CARON
+0xBA 0x015F # LATIN SMALL LETTER S WITH CEDILLA
+0xBB 0x0165 # LATIN SMALL LETTER T WITH CARON
+0xBC 0x017A # LATIN SMALL LETTER Z WITH ACUTE
+0xBD 0x02DD # DOUBLE ACUTE ACCENT
+0xBE 0x017E # LATIN SMALL LETTER Z WITH CARON
+0xBF 0x017C # LATIN SMALL LETTER Z WITH DOT ABOVE
+0xC0 0x0154 # LATIN CAPITAL LETTER R WITH ACUTE
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x0102 # LATIN CAPITAL LETTER A WITH BREVE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x0139 # LATIN CAPITAL LETTER L WITH ACUTE
+0xC6 0x0106 # LATIN CAPITAL LETTER C WITH ACUTE
+0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x011A # LATIN CAPITAL LETTER E WITH CARON
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x010E # LATIN CAPITAL LETTER D WITH CARON
+0xD0 0x0110 # LATIN CAPITAL LETTER D WITH STROKE
+0xD1 0x0143 # LATIN CAPITAL LETTER N WITH ACUTE
+0xD2 0x0147 # LATIN CAPITAL LETTER N WITH CARON
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x0150 # LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x0158 # LATIN CAPITAL LETTER R WITH CARON
+0xD9 0x016E # LATIN CAPITAL LETTER U WITH RING ABOVE
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x0170 # LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x0162 # LATIN CAPITAL LETTER T WITH CEDILLA
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S
+0xE0 0x0155 # LATIN SMALL LETTER R WITH ACUTE
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x0103 # LATIN SMALL LETTER A WITH BREVE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x013A # LATIN SMALL LETTER L WITH ACUTE
+0xE6 0x0107 # LATIN SMALL LETTER C WITH ACUTE
+0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x010D # LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x0119 # LATIN SMALL LETTER E WITH OGONEK
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x011B # LATIN SMALL LETTER E WITH CARON
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x010F # LATIN SMALL LETTER D WITH CARON
+0xF0 0x0111 # LATIN SMALL LETTER D WITH STROKE
+0xF1 0x0144 # LATIN SMALL LETTER N WITH ACUTE
+0xF2 0x0148 # LATIN SMALL LETTER N WITH CARON
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x0151 # LATIN SMALL LETTER O WITH DOUBLE ACUTE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x0159 # LATIN SMALL LETTER R WITH CARON
+0xF9 0x016F # LATIN SMALL LETTER U WITH RING ABOVE
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x0171 # LATIN SMALL LETTER U WITH DOUBLE ACUTE
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x0163 # LATIN SMALL LETTER T WITH CEDILLA
+0xFF 0x02D9 # DOT ABOVE
diff --git a/rtl/ucmaps/8859-3.txt b/rtl/ucmaps/8859-3.txt
new file mode 100644
index 0000000000..9b6ac69dd8
--- /dev/null
+++ b/rtl/ucmaps/8859-3.txt
@@ -0,0 +1,296 @@
+#
+# Name: ISO/IEC 8859-3:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-3:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-3 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-3 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x0126 # LATIN CAPITAL LETTER H WITH STROKE
+0xA2 0x02D8 # BREVE
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x00A4 # CURRENCY SIGN
+0xA6 0x0124 # LATIN CAPITAL LETTER H WITH CIRCUMFLEX
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x0130 # LATIN CAPITAL LETTER I WITH DOT ABOVE
+0xAA 0x015E # LATIN CAPITAL LETTER S WITH CEDILLA
+0xAB 0x011E # LATIN CAPITAL LETTER G WITH BREVE
+0xAC 0x0134 # LATIN CAPITAL LETTER J WITH CIRCUMFLEX
+0xAD 0x00AD # SOFT HYPHEN
+0xAF 0x017B # LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x0127 # LATIN SMALL LETTER H WITH STROKE
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x00B4 # ACUTE ACCENT
+0xB5 0x00B5 # MICRO SIGN
+0xB6 0x0125 # LATIN SMALL LETTER H WITH CIRCUMFLEX
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x00B8 # CEDILLA
+0xB9 0x0131 # LATIN SMALL LETTER DOTLESS I
+0xBA 0x015F # LATIN SMALL LETTER S WITH CEDILLA
+0xBB 0x011F # LATIN SMALL LETTER G WITH BREVE
+0xBC 0x0135 # LATIN SMALL LETTER J WITH CIRCUMFLEX
+0xBD 0x00BD # VULGAR FRACTION ONE HALF
+0xBF 0x017C # LATIN SMALL LETTER Z WITH DOT ABOVE
+0xC0 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x010A # LATIN CAPITAL LETTER C WITH DOT ABOVE
+0xC6 0x0108 # LATIN CAPITAL LETTER C WITH CIRCUMFLEX
+0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 # LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC # LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD1 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 # LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x0120 # LATIN CAPITAL LETTER G WITH DOT ABOVE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x011C # LATIN CAPITAL LETTER G WITH CIRCUMFLEX
+0xD9 0x00D9 # LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x016C # LATIN CAPITAL LETTER U WITH BREVE
+0xDE 0x015C # LATIN CAPITAL LETTER S WITH CIRCUMFLEX
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 # LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x010B # LATIN SMALL LETTER C WITH DOT ABOVE
+0xE6 0x0109 # LATIN SMALL LETTER C WITH CIRCUMFLEX
+0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 # LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA # LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC # LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS
+0xF1 0x00F1 # LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 # LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x0121 # LATIN SMALL LETTER G WITH DOT ABOVE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x011D # LATIN SMALL LETTER G WITH CIRCUMFLEX
+0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x016D # LATIN SMALL LETTER U WITH BREVE
+0xFE 0x015D # LATIN SMALL LETTER S WITH CIRCUMFLEX
+0xFF 0x02D9 # DOT ABOVE
diff --git a/rtl/ucmaps/8859-4.txt b/rtl/ucmaps/8859-4.txt
new file mode 100644
index 0000000000..662e698ab2
--- /dev/null
+++ b/rtl/ucmaps/8859-4.txt
@@ -0,0 +1,303 @@
+#
+# Name: ISO/IEC 8859-4:1998 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-4:1998 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-4 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-4 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK
+0xA2 0x0138 # LATIN SMALL LETTER KRA
+0xA3 0x0156 # LATIN CAPITAL LETTER R WITH CEDILLA
+0xA4 0x00A4 # CURRENCY SIGN
+0xA5 0x0128 # LATIN CAPITAL LETTER I WITH TILDE
+0xA6 0x013B # LATIN CAPITAL LETTER L WITH CEDILLA
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x0160 # LATIN CAPITAL LETTER S WITH CARON
+0xAA 0x0112 # LATIN CAPITAL LETTER E WITH MACRON
+0xAB 0x0122 # LATIN CAPITAL LETTER G WITH CEDILLA
+0xAC 0x0166 # LATIN CAPITAL LETTER T WITH STROKE
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x017D # LATIN CAPITAL LETTER Z WITH CARON
+0xAF 0x00AF # MACRON
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x0105 # LATIN SMALL LETTER A WITH OGONEK
+0xB2 0x02DB # OGONEK
+0xB3 0x0157 # LATIN SMALL LETTER R WITH CEDILLA
+0xB4 0x00B4 # ACUTE ACCENT
+0xB5 0x0129 # LATIN SMALL LETTER I WITH TILDE
+0xB6 0x013C # LATIN SMALL LETTER L WITH CEDILLA
+0xB7 0x02C7 # CARON
+0xB8 0x00B8 # CEDILLA
+0xB9 0x0161 # LATIN SMALL LETTER S WITH CARON
+0xBA 0x0113 # LATIN SMALL LETTER E WITH MACRON
+0xBB 0x0123 # LATIN SMALL LETTER G WITH CEDILLA
+0xBC 0x0167 # LATIN SMALL LETTER T WITH STROKE
+0xBD 0x014A # LATIN CAPITAL LETTER ENG
+0xBE 0x017E # LATIN SMALL LETTER Z WITH CARON
+0xBF 0x014B # LATIN SMALL LETTER ENG
+0xC0 0x0100 # LATIN CAPITAL LETTER A WITH MACRON
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 # LATIN CAPITAL LETTER AE
+0xC7 0x012E # LATIN CAPITAL LETTER I WITH OGONEK
+0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x0116 # LATIN CAPITAL LETTER E WITH DOT ABOVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x012A # LATIN CAPITAL LETTER I WITH MACRON
+0xD0 0x0110 # LATIN CAPITAL LETTER D WITH STROKE
+0xD1 0x0145 # LATIN CAPITAL LETTER N WITH CEDILLA
+0xD2 0x014C # LATIN CAPITAL LETTER O WITH MACRON
+0xD3 0x0136 # LATIN CAPITAL LETTER K WITH CEDILLA
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x0172 # LATIN CAPITAL LETTER U WITH OGONEK
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x0168 # LATIN CAPITAL LETTER U WITH TILDE
+0xDE 0x016A # LATIN CAPITAL LETTER U WITH MACRON
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S
+0xE0 0x0101 # LATIN SMALL LETTER A WITH MACRON
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 # LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 # LATIN SMALL LETTER AE
+0xE7 0x012F # LATIN SMALL LETTER I WITH OGONEK
+0xE8 0x010D # LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x0119 # LATIN SMALL LETTER E WITH OGONEK
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x0117 # LATIN SMALL LETTER E WITH DOT ABOVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x012B # LATIN SMALL LETTER I WITH MACRON
+0xF0 0x0111 # LATIN SMALL LETTER D WITH STROKE
+0xF1 0x0146 # LATIN SMALL LETTER N WITH CEDILLA
+0xF2 0x014D # LATIN SMALL LETTER O WITH MACRON
+0xF3 0x0137 # LATIN SMALL LETTER K WITH CEDILLA
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xF9 0x0173 # LATIN SMALL LETTER U WITH OGONEK
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x0169 # LATIN SMALL LETTER U WITH TILDE
+0xFE 0x016B # LATIN SMALL LETTER U WITH MACRON
+0xFF 0x02D9 # DOT ABOVE
diff --git a/rtl/ucmaps/8859-5.txt b/rtl/ucmaps/8859-5.txt
new file mode 100644
index 0000000000..a7ed1ce2ab
--- /dev/null
+++ b/rtl/ucmaps/8859-5.txt
@@ -0,0 +1,303 @@
+#
+# Name: ISO 8859-5:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-5:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-5 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-5 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x0401 # CYRILLIC CAPITAL LETTER IO
+0xA2 0x0402 # CYRILLIC CAPITAL LETTER DJE
+0xA3 0x0403 # CYRILLIC CAPITAL LETTER GJE
+0xA4 0x0404 # CYRILLIC CAPITAL LETTER UKRAINIAN IE
+0xA5 0x0405 # CYRILLIC CAPITAL LETTER DZE
+0xA6 0x0406 # CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
+0xA7 0x0407 # CYRILLIC CAPITAL LETTER YI
+0xA8 0x0408 # CYRILLIC CAPITAL LETTER JE
+0xA9 0x0409 # CYRILLIC CAPITAL LETTER LJE
+0xAA 0x040A # CYRILLIC CAPITAL LETTER NJE
+0xAB 0x040B # CYRILLIC CAPITAL LETTER TSHE
+0xAC 0x040C # CYRILLIC CAPITAL LETTER KJE
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x040E # CYRILLIC CAPITAL LETTER SHORT U
+0xAF 0x040F # CYRILLIC CAPITAL LETTER DZHE
+0xB0 0x0410 # CYRILLIC CAPITAL LETTER A
+0xB1 0x0411 # CYRILLIC CAPITAL LETTER BE
+0xB2 0x0412 # CYRILLIC CAPITAL LETTER VE
+0xB3 0x0413 # CYRILLIC CAPITAL LETTER GHE
+0xB4 0x0414 # CYRILLIC CAPITAL LETTER DE
+0xB5 0x0415 # CYRILLIC CAPITAL LETTER IE
+0xB6 0x0416 # CYRILLIC CAPITAL LETTER ZHE
+0xB7 0x0417 # CYRILLIC CAPITAL LETTER ZE
+0xB8 0x0418 # CYRILLIC CAPITAL LETTER I
+0xB9 0x0419 # CYRILLIC CAPITAL LETTER SHORT I
+0xBA 0x041A # CYRILLIC CAPITAL LETTER KA
+0xBB 0x041B # CYRILLIC CAPITAL LETTER EL
+0xBC 0x041C # CYRILLIC CAPITAL LETTER EM
+0xBD 0x041D # CYRILLIC CAPITAL LETTER EN
+0xBE 0x041E # CYRILLIC CAPITAL LETTER O
+0xBF 0x041F # CYRILLIC CAPITAL LETTER PE
+0xC0 0x0420 # CYRILLIC CAPITAL LETTER ER
+0xC1 0x0421 # CYRILLIC CAPITAL LETTER ES
+0xC2 0x0422 # CYRILLIC CAPITAL LETTER TE
+0xC3 0x0423 # CYRILLIC CAPITAL LETTER U
+0xC4 0x0424 # CYRILLIC CAPITAL LETTER EF
+0xC5 0x0425 # CYRILLIC CAPITAL LETTER HA
+0xC6 0x0426 # CYRILLIC CAPITAL LETTER TSE
+0xC7 0x0427 # CYRILLIC CAPITAL LETTER CHE
+0xC8 0x0428 # CYRILLIC CAPITAL LETTER SHA
+0xC9 0x0429 # CYRILLIC CAPITAL LETTER SHCHA
+0xCA 0x042A # CYRILLIC CAPITAL LETTER HARD SIGN
+0xCB 0x042B # CYRILLIC CAPITAL LETTER YERU
+0xCC 0x042C # CYRILLIC CAPITAL LETTER SOFT SIGN
+0xCD 0x042D # CYRILLIC CAPITAL LETTER E
+0xCE 0x042E # CYRILLIC CAPITAL LETTER YU
+0xCF 0x042F # CYRILLIC CAPITAL LETTER YA
+0xD0 0x0430 # CYRILLIC SMALL LETTER A
+0xD1 0x0431 # CYRILLIC SMALL LETTER BE
+0xD2 0x0432 # CYRILLIC SMALL LETTER VE
+0xD3 0x0433 # CYRILLIC SMALL LETTER GHE
+0xD4 0x0434 # CYRILLIC SMALL LETTER DE
+0xD5 0x0435 # CYRILLIC SMALL LETTER IE
+0xD6 0x0436 # CYRILLIC SMALL LETTER ZHE
+0xD7 0x0437 # CYRILLIC SMALL LETTER ZE
+0xD8 0x0438 # CYRILLIC SMALL LETTER I
+0xD9 0x0439 # CYRILLIC SMALL LETTER SHORT I
+0xDA 0x043A # CYRILLIC SMALL LETTER KA
+0xDB 0x043B # CYRILLIC SMALL LETTER EL
+0xDC 0x043C # CYRILLIC SMALL LETTER EM
+0xDD 0x043D # CYRILLIC SMALL LETTER EN
+0xDE 0x043E # CYRILLIC SMALL LETTER O
+0xDF 0x043F # CYRILLIC SMALL LETTER PE
+0xE0 0x0440 # CYRILLIC SMALL LETTER ER
+0xE1 0x0441 # CYRILLIC SMALL LETTER ES
+0xE2 0x0442 # CYRILLIC SMALL LETTER TE
+0xE3 0x0443 # CYRILLIC SMALL LETTER U
+0xE4 0x0444 # CYRILLIC SMALL LETTER EF
+0xE5 0x0445 # CYRILLIC SMALL LETTER HA
+0xE6 0x0446 # CYRILLIC SMALL LETTER TSE
+0xE7 0x0447 # CYRILLIC SMALL LETTER CHE
+0xE8 0x0448 # CYRILLIC SMALL LETTER SHA
+0xE9 0x0449 # CYRILLIC SMALL LETTER SHCHA
+0xEA 0x044A # CYRILLIC SMALL LETTER HARD SIGN
+0xEB 0x044B # CYRILLIC SMALL LETTER YERU
+0xEC 0x044C # CYRILLIC SMALL LETTER SOFT SIGN
+0xED 0x044D # CYRILLIC SMALL LETTER E
+0xEE 0x044E # CYRILLIC SMALL LETTER YU
+0xEF 0x044F # CYRILLIC SMALL LETTER YA
+0xF0 0x2116 # NUMERO SIGN
+0xF1 0x0451 # CYRILLIC SMALL LETTER IO
+0xF2 0x0452 # CYRILLIC SMALL LETTER DJE
+0xF3 0x0453 # CYRILLIC SMALL LETTER GJE
+0xF4 0x0454 # CYRILLIC SMALL LETTER UKRAINIAN IE
+0xF5 0x0455 # CYRILLIC SMALL LETTER DZE
+0xF6 0x0456 # CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+0xF7 0x0457 # CYRILLIC SMALL LETTER YI
+0xF8 0x0458 # CYRILLIC SMALL LETTER JE
+0xF9 0x0459 # CYRILLIC SMALL LETTER LJE
+0xFA 0x045A # CYRILLIC SMALL LETTER NJE
+0xFB 0x045B # CYRILLIC SMALL LETTER TSHE
+0xFC 0x045C # CYRILLIC SMALL LETTER KJE
+0xFD 0x00A7 # SECTION SIGN
+0xFE 0x045E # CYRILLIC SMALL LETTER SHORT U
+0xFF 0x045F # CYRILLIC SMALL LETTER DZHE
diff --git a/rtl/ucmaps/8859-6.txt b/rtl/ucmaps/8859-6.txt
new file mode 100644
index 0000000000..69ac7f5894
--- /dev/null
+++ b/rtl/ucmaps/8859-6.txt
@@ -0,0 +1,260 @@
+#
+# Name: ISO 8859-6:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-6:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-6 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-6 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+# 0x30..0x39 remapped to the ASCII digits (U+0030..U+0039) instead
+# of the Arabic digits (U+0660..U+0669).
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA4 0x00A4 # CURRENCY SIGN
+0xAC 0x060C # ARABIC COMMA
+0xAD 0x00AD # SOFT HYPHEN
+0xBB 0x061B # ARABIC SEMICOLON
+0xBF 0x061F # ARABIC QUESTION MARK
+0xC1 0x0621 # ARABIC LETTER HAMZA
+0xC2 0x0622 # ARABIC LETTER ALEF WITH MADDA ABOVE
+0xC3 0x0623 # ARABIC LETTER ALEF WITH HAMZA ABOVE
+0xC4 0x0624 # ARABIC LETTER WAW WITH HAMZA ABOVE
+0xC5 0x0625 # ARABIC LETTER ALEF WITH HAMZA BELOW
+0xC6 0x0626 # ARABIC LETTER YEH WITH HAMZA ABOVE
+0xC7 0x0627 # ARABIC LETTER ALEF
+0xC8 0x0628 # ARABIC LETTER BEH
+0xC9 0x0629 # ARABIC LETTER TEH MARBUTA
+0xCA 0x062A # ARABIC LETTER TEH
+0xCB 0x062B # ARABIC LETTER THEH
+0xCC 0x062C # ARABIC LETTER JEEM
+0xCD 0x062D # ARABIC LETTER HAH
+0xCE 0x062E # ARABIC LETTER KHAH
+0xCF 0x062F # ARABIC LETTER DAL
+0xD0 0x0630 # ARABIC LETTER THAL
+0xD1 0x0631 # ARABIC LETTER REH
+0xD2 0x0632 # ARABIC LETTER ZAIN
+0xD3 0x0633 # ARABIC LETTER SEEN
+0xD4 0x0634 # ARABIC LETTER SHEEN
+0xD5 0x0635 # ARABIC LETTER SAD
+0xD6 0x0636 # ARABIC LETTER DAD
+0xD7 0x0637 # ARABIC LETTER TAH
+0xD8 0x0638 # ARABIC LETTER ZAH
+0xD9 0x0639 # ARABIC LETTER AIN
+0xDA 0x063A # ARABIC LETTER GHAIN
+0xE0 0x0640 # ARABIC TATWEEL
+0xE1 0x0641 # ARABIC LETTER FEH
+0xE2 0x0642 # ARABIC LETTER QAF
+0xE3 0x0643 # ARABIC LETTER KAF
+0xE4 0x0644 # ARABIC LETTER LAM
+0xE5 0x0645 # ARABIC LETTER MEEM
+0xE6 0x0646 # ARABIC LETTER NOON
+0xE7 0x0647 # ARABIC LETTER HEH
+0xE8 0x0648 # ARABIC LETTER WAW
+0xE9 0x0649 # ARABIC LETTER ALEF MAKSURA
+0xEA 0x064A # ARABIC LETTER YEH
+0xEB 0x064B # ARABIC FATHATAN
+0xEC 0x064C # ARABIC DAMMATAN
+0xED 0x064D # ARABIC KASRATAN
+0xEE 0x064E # ARABIC FATHA
+0xEF 0x064F # ARABIC DAMMA
+0xF0 0x0650 # ARABIC KASRA
+0xF1 0x0651 # ARABIC SHADDA
+0xF2 0x0652 # ARABIC SUKUN
diff --git a/rtl/ucmaps/8859-7.txt b/rtl/ucmaps/8859-7.txt
new file mode 100644
index 0000000000..52c42d08a7
--- /dev/null
+++ b/rtl/ucmaps/8859-7.txt
@@ -0,0 +1,302 @@
+#
+# Name: ISO 8859-7:1987 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO 8859-7:1987 characters map into Unicode.
+#
+# ISO 8859-7:1987 is equivalent to ISO-IR-126, ELOT 928,
+# and ECMA 118.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO 8859-7 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO 8859-7 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+# Remap 0xA1 to U+2018 (instead of 0x02BD) to match text of 8859-7
+# Remap 0xA2 to U+2019 (instead of 0x02BC) to match text of 8859-7
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x2018 # LEFT SINGLE QUOTATION MARK
+0xA2 0x2019 # RIGHT SINGLE QUOTATION MARK
+0xA3 0x00A3 # POUND SIGN
+0xA6 0x00A6 # BROKEN BAR
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC # NOT SIGN
+0xAD 0x00AD # SOFT HYPHEN
+0xAF 0x2015 # HORIZONTAL BAR
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x00B1 # PLUS-MINUS SIGN
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x0384 # GREEK TONOS
+0xB5 0x0385 # GREEK DIALYTIKA TONOS
+0xB6 0x0386 # GREEK CAPITAL LETTER ALPHA WITH TONOS
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x0388 # GREEK CAPITAL LETTER EPSILON WITH TONOS
+0xB9 0x0389 # GREEK CAPITAL LETTER ETA WITH TONOS
+0xBA 0x038A # GREEK CAPITAL LETTER IOTA WITH TONOS
+0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x038C # GREEK CAPITAL LETTER OMICRON WITH TONOS
+0xBD 0x00BD # VULGAR FRACTION ONE HALF
+0xBE 0x038E # GREEK CAPITAL LETTER UPSILON WITH TONOS
+0xBF 0x038F # GREEK CAPITAL LETTER OMEGA WITH TONOS
+0xC0 0x0390 # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+0xC1 0x0391 # GREEK CAPITAL LETTER ALPHA
+0xC2 0x0392 # GREEK CAPITAL LETTER BETA
+0xC3 0x0393 # GREEK CAPITAL LETTER GAMMA
+0xC4 0x0394 # GREEK CAPITAL LETTER DELTA
+0xC5 0x0395 # GREEK CAPITAL LETTER EPSILON
+0xC6 0x0396 # GREEK CAPITAL LETTER ZETA
+0xC7 0x0397 # GREEK CAPITAL LETTER ETA
+0xC8 0x0398 # GREEK CAPITAL LETTER THETA
+0xC9 0x0399 # GREEK CAPITAL LETTER IOTA
+0xCA 0x039A # GREEK CAPITAL LETTER KAPPA
+0xCB 0x039B # GREEK CAPITAL LETTER LAMDA
+0xCC 0x039C # GREEK CAPITAL LETTER MU
+0xCD 0x039D # GREEK CAPITAL LETTER NU
+0xCE 0x039E # GREEK CAPITAL LETTER XI
+0xCF 0x039F # GREEK CAPITAL LETTER OMICRON
+0xD0 0x03A0 # GREEK CAPITAL LETTER PI
+0xD1 0x03A1 # GREEK CAPITAL LETTER RHO
+0xD3 0x03A3 # GREEK CAPITAL LETTER SIGMA
+0xD4 0x03A4 # GREEK CAPITAL LETTER TAU
+0xD5 0x03A5 # GREEK CAPITAL LETTER UPSILON
+0xD6 0x03A6 # GREEK CAPITAL LETTER PHI
+0xD7 0x03A7 # GREEK CAPITAL LETTER CHI
+0xD8 0x03A8 # GREEK CAPITAL LETTER PSI
+0xD9 0x03A9 # GREEK CAPITAL LETTER OMEGA
+0xDA 0x03AA # GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+0xDB 0x03AB # GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+0xDC 0x03AC # GREEK SMALL LETTER ALPHA WITH TONOS
+0xDD 0x03AD # GREEK SMALL LETTER EPSILON WITH TONOS
+0xDE 0x03AE # GREEK SMALL LETTER ETA WITH TONOS
+0xDF 0x03AF # GREEK SMALL LETTER IOTA WITH TONOS
+0xE0 0x03B0 # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+0xE1 0x03B1 # GREEK SMALL LETTER ALPHA
+0xE2 0x03B2 # GREEK SMALL LETTER BETA
+0xE3 0x03B3 # GREEK SMALL LETTER GAMMA
+0xE4 0x03B4 # GREEK SMALL LETTER DELTA
+0xE5 0x03B5 # GREEK SMALL LETTER EPSILON
+0xE6 0x03B6 # GREEK SMALL LETTER ZETA
+0xE7 0x03B7 # GREEK SMALL LETTER ETA
+0xE8 0x03B8 # GREEK SMALL LETTER THETA
+0xE9 0x03B9 # GREEK SMALL LETTER IOTA
+0xEA 0x03BA # GREEK SMALL LETTER KAPPA
+0xEB 0x03BB # GREEK SMALL LETTER LAMDA
+0xEC 0x03BC # GREEK SMALL LETTER MU
+0xED 0x03BD # GREEK SMALL LETTER NU
+0xEE 0x03BE # GREEK SMALL LETTER XI
+0xEF 0x03BF # GREEK SMALL LETTER OMICRON
+0xF0 0x03C0 # GREEK SMALL LETTER PI
+0xF1 0x03C1 # GREEK SMALL LETTER RHO
+0xF2 0x03C2 # GREEK SMALL LETTER FINAL SIGMA
+0xF3 0x03C3 # GREEK SMALL LETTER SIGMA
+0xF4 0x03C4 # GREEK SMALL LETTER TAU
+0xF5 0x03C5 # GREEK SMALL LETTER UPSILON
+0xF6 0x03C6 # GREEK SMALL LETTER PHI
+0xF7 0x03C7 # GREEK SMALL LETTER CHI
+0xF8 0x03C8 # GREEK SMALL LETTER PSI
+0xF9 0x03C9 # GREEK SMALL LETTER OMEGA
+0xFA 0x03CA # GREEK SMALL LETTER IOTA WITH DIALYTIKA
+0xFB 0x03CB # GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+0xFC 0x03CC # GREEK SMALL LETTER OMICRON WITH TONOS
+0xFD 0x03CD # GREEK SMALL LETTER UPSILON WITH TONOS
+0xFE 0x03CE # GREEK SMALL LETTER OMEGA WITH TONOS
diff --git a/rtl/ucmaps/8859-8.txt b/rtl/ucmaps/8859-8.txt
new file mode 100644
index 0000000000..bc8da4c7fd
--- /dev/null
+++ b/rtl/ucmaps/8859-8.txt
@@ -0,0 +1,270 @@
+#
+# Name: ISO/IEC 8859-8:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.1
+# Table format: Format A
+# Date: 2000-Jan-03
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-8:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-8 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-8 order.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+# 1.1 version updates to the published 8859-8:1999, correcting
+# the mapping of 0xAF and adding mappings for LRM and RLM.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA2 0x00A2 # CENT SIGN
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x00A4 # CURRENCY SIGN
+0xA5 0x00A5 # YEN SIGN
+0xA6 0x00A6 # BROKEN BAR
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAA 0x00D7 # MULTIPLICATION SIGN
+0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC # NOT SIGN
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x00AE # REGISTERED SIGN
+0xAF 0x00AF # MACRON
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x00B1 # PLUS-MINUS SIGN
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x00B4 # ACUTE ACCENT
+0xB5 0x00B5 # MICRO SIGN
+0xB6 0x00B6 # PILCROW SIGN
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x00B8 # CEDILLA
+0xB9 0x00B9 # SUPERSCRIPT ONE
+0xBA 0x00F7 # DIVISION SIGN
+0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC # VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD # VULGAR FRACTION ONE HALF
+0xBE 0x00BE # VULGAR FRACTION THREE QUARTERS
+0xDF 0x2017 # DOUBLE LOW LINE
+0xE0 0x05D0 # HEBREW LETTER ALEF
+0xE1 0x05D1 # HEBREW LETTER BET
+0xE2 0x05D2 # HEBREW LETTER GIMEL
+0xE3 0x05D3 # HEBREW LETTER DALET
+0xE4 0x05D4 # HEBREW LETTER HE
+0xE5 0x05D5 # HEBREW LETTER VAV
+0xE6 0x05D6 # HEBREW LETTER ZAYIN
+0xE7 0x05D7 # HEBREW LETTER HET
+0xE8 0x05D8 # HEBREW LETTER TET
+0xE9 0x05D9 # HEBREW LETTER YOD
+0xEA 0x05DA # HEBREW LETTER FINAL KAF
+0xEB 0x05DB # HEBREW LETTER KAF
+0xEC 0x05DC # HEBREW LETTER LAMED
+0xED 0x05DD # HEBREW LETTER FINAL MEM
+0xEE 0x05DE # HEBREW LETTER MEM
+0xEF 0x05DF # HEBREW LETTER FINAL NUN
+0xF0 0x05E0 # HEBREW LETTER NUN
+0xF1 0x05E1 # HEBREW LETTER SAMEKH
+0xF2 0x05E2 # HEBREW LETTER AYIN
+0xF3 0x05E3 # HEBREW LETTER FINAL PE
+0xF4 0x05E4 # HEBREW LETTER PE
+0xF5 0x05E5 # HEBREW LETTER FINAL TSADI
+0xF6 0x05E6 # HEBREW LETTER TSADI
+0xF7 0x05E7 # HEBREW LETTER QOF
+0xF8 0x05E8 # HEBREW LETTER RESH
+0xF9 0x05E9 # HEBREW LETTER SHIN
+0xFA 0x05EA # HEBREW LETTER TAV
+0xFD 0x200E # LEFT-TO-RIGHT MARK
+0xFE 0x200F # RIGHT-TO-LEFT MARK
+
diff --git a/rtl/ucmaps/8859-9.txt b/rtl/ucmaps/8859-9.txt
new file mode 100644
index 0000000000..22901f1077
--- /dev/null
+++ b/rtl/ucmaps/8859-9.txt
@@ -0,0 +1,307 @@
+#
+# Name: ISO/IEC 8859-9:1999 to Unicode
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler <kenw@sybase.com>
+#
+# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on magnetic media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# ISO/IEC 8859-9:1999 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the ISO/IEC 8859-9 code (in hex as 0xXX)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 the Unicode name (follows a comment sign, '#')
+#
+# The entries are in ISO/IEC 8859-9 order.
+#
+# ISO/IEC 8859-9 is also equivalent to ISO-IR-148.
+#
+# Version history
+# 1.0 version updates 0.1 version by adding mappings for all
+# control characters.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 # NULL
+0x01 0x0001 # START OF HEADING
+0x02 0x0002 # START OF TEXT
+0x03 0x0003 # END OF TEXT
+0x04 0x0004 # END OF TRANSMISSION
+0x05 0x0005 # ENQUIRY
+0x06 0x0006 # ACKNOWLEDGE
+0x07 0x0007 # BELL
+0x08 0x0008 # BACKSPACE
+0x09 0x0009 # HORIZONTAL TABULATION
+0x0A 0x000A # LINE FEED
+0x0B 0x000B # VERTICAL TABULATION
+0x0C 0x000C # FORM FEED
+0x0D 0x000D # CARRIAGE RETURN
+0x0E 0x000E # SHIFT OUT
+0x0F 0x000F # SHIFT IN
+0x10 0x0010 # DATA LINK ESCAPE
+0x11 0x0011 # DEVICE CONTROL ONE
+0x12 0x0012 # DEVICE CONTROL TWO
+0x13 0x0013 # DEVICE CONTROL THREE
+0x14 0x0014 # DEVICE CONTROL FOUR
+0x15 0x0015 # NEGATIVE ACKNOWLEDGE
+0x16 0x0016 # SYNCHRONOUS IDLE
+0x17 0x0017 # END OF TRANSMISSION BLOCK
+0x18 0x0018 # CANCEL
+0x19 0x0019 # END OF MEDIUM
+0x1A 0x001A # SUBSTITUTE
+0x1B 0x001B # ESCAPE
+0x1C 0x001C # FILE SEPARATOR
+0x1D 0x001D # GROUP SEPARATOR
+0x1E 0x001E # RECORD SEPARATOR
+0x1F 0x001F # UNIT SEPARATOR
+0x20 0x0020 # SPACE
+0x21 0x0021 # EXCLAMATION MARK
+0x22 0x0022 # QUOTATION MARK
+0x23 0x0023 # NUMBER SIGN
+0x24 0x0024 # DOLLAR SIGN
+0x25 0x0025 # PERCENT SIGN
+0x26 0x0026 # AMPERSAND
+0x27 0x0027 # APOSTROPHE
+0x28 0x0028 # LEFT PARENTHESIS
+0x29 0x0029 # RIGHT PARENTHESIS
+0x2A 0x002A # ASTERISK
+0x2B 0x002B # PLUS SIGN
+0x2C 0x002C # COMMA
+0x2D 0x002D # HYPHEN-MINUS
+0x2E 0x002E # FULL STOP
+0x2F 0x002F # SOLIDUS
+0x30 0x0030 # DIGIT ZERO
+0x31 0x0031 # DIGIT ONE
+0x32 0x0032 # DIGIT TWO
+0x33 0x0033 # DIGIT THREE
+0x34 0x0034 # DIGIT FOUR
+0x35 0x0035 # DIGIT FIVE
+0x36 0x0036 # DIGIT SIX
+0x37 0x0037 # DIGIT SEVEN
+0x38 0x0038 # DIGIT EIGHT
+0x39 0x0039 # DIGIT NINE
+0x3A 0x003A # COLON
+0x3B 0x003B # SEMICOLON
+0x3C 0x003C # LESS-THAN SIGN
+0x3D 0x003D # EQUALS SIGN
+0x3E 0x003E # GREATER-THAN SIGN
+0x3F 0x003F # QUESTION MARK
+0x40 0x0040 # COMMERCIAL AT
+0x41 0x0041 # LATIN CAPITAL LETTER A
+0x42 0x0042 # LATIN CAPITAL LETTER B
+0x43 0x0043 # LATIN CAPITAL LETTER C
+0x44 0x0044 # LATIN CAPITAL LETTER D
+0x45 0x0045 # LATIN CAPITAL LETTER E
+0x46 0x0046 # LATIN CAPITAL LETTER F
+0x47 0x0047 # LATIN CAPITAL LETTER G
+0x48 0x0048 # LATIN CAPITAL LETTER H
+0x49 0x0049 # LATIN CAPITAL LETTER I
+0x4A 0x004A # LATIN CAPITAL LETTER J
+0x4B 0x004B # LATIN CAPITAL LETTER K
+0x4C 0x004C # LATIN CAPITAL LETTER L
+0x4D 0x004D # LATIN CAPITAL LETTER M
+0x4E 0x004E # LATIN CAPITAL LETTER N
+0x4F 0x004F # LATIN CAPITAL LETTER O
+0x50 0x0050 # LATIN CAPITAL LETTER P
+0x51 0x0051 # LATIN CAPITAL LETTER Q
+0x52 0x0052 # LATIN CAPITAL LETTER R
+0x53 0x0053 # LATIN CAPITAL LETTER S
+0x54 0x0054 # LATIN CAPITAL LETTER T
+0x55 0x0055 # LATIN CAPITAL LETTER U
+0x56 0x0056 # LATIN CAPITAL LETTER V
+0x57 0x0057 # LATIN CAPITAL LETTER W
+0x58 0x0058 # LATIN CAPITAL LETTER X
+0x59 0x0059 # LATIN CAPITAL LETTER Y
+0x5A 0x005A # LATIN CAPITAL LETTER Z
+0x5B 0x005B # LEFT SQUARE BRACKET
+0x5C 0x005C # REVERSE SOLIDUS
+0x5D 0x005D # RIGHT SQUARE BRACKET
+0x5E 0x005E # CIRCUMFLEX ACCENT
+0x5F 0x005F # LOW LINE
+0x60 0x0060 # GRAVE ACCENT
+0x61 0x0061 # LATIN SMALL LETTER A
+0x62 0x0062 # LATIN SMALL LETTER B
+0x63 0x0063 # LATIN SMALL LETTER C
+0x64 0x0064 # LATIN SMALL LETTER D
+0x65 0x0065 # LATIN SMALL LETTER E
+0x66 0x0066 # LATIN SMALL LETTER F
+0x67 0x0067 # LATIN SMALL LETTER G
+0x68 0x0068 # LATIN SMALL LETTER H
+0x69 0x0069 # LATIN SMALL LETTER I
+0x6A 0x006A # LATIN SMALL LETTER J
+0x6B 0x006B # LATIN SMALL LETTER K
+0x6C 0x006C # LATIN SMALL LETTER L
+0x6D 0x006D # LATIN SMALL LETTER M
+0x6E 0x006E # LATIN SMALL LETTER N
+0x6F 0x006F # LATIN SMALL LETTER O
+0x70 0x0070 # LATIN SMALL LETTER P
+0x71 0x0071 # LATIN SMALL LETTER Q
+0x72 0x0072 # LATIN SMALL LETTER R
+0x73 0x0073 # LATIN SMALL LETTER S
+0x74 0x0074 # LATIN SMALL LETTER T
+0x75 0x0075 # LATIN SMALL LETTER U
+0x76 0x0076 # LATIN SMALL LETTER V
+0x77 0x0077 # LATIN SMALL LETTER W
+0x78 0x0078 # LATIN SMALL LETTER X
+0x79 0x0079 # LATIN SMALL LETTER Y
+0x7A 0x007A # LATIN SMALL LETTER Z
+0x7B 0x007B # LEFT CURLY BRACKET
+0x7C 0x007C # VERTICAL LINE
+0x7D 0x007D # RIGHT CURLY BRACKET
+0x7E 0x007E # TILDE
+0x7F 0x007F # DELETE
+0x80 0x0080 # <control>
+0x81 0x0081 # <control>
+0x82 0x0082 # <control>
+0x83 0x0083 # <control>
+0x84 0x0084 # <control>
+0x85 0x0085 # <control>
+0x86 0x0086 # <control>
+0x87 0x0087 # <control>
+0x88 0x0088 # <control>
+0x89 0x0089 # <control>
+0x8A 0x008A # <control>
+0x8B 0x008B # <control>
+0x8C 0x008C # <control>
+0x8D 0x008D # <control>
+0x8E 0x008E # <control>
+0x8F 0x008F # <control>
+0x90 0x0090 # <control>
+0x91 0x0091 # <control>
+0x92 0x0092 # <control>
+0x93 0x0093 # <control>
+0x94 0x0094 # <control>
+0x95 0x0095 # <control>
+0x96 0x0096 # <control>
+0x97 0x0097 # <control>
+0x98 0x0098 # <control>
+0x99 0x0099 # <control>
+0x9A 0x009A # <control>
+0x9B 0x009B # <control>
+0x9C 0x009C # <control>
+0x9D 0x009D # <control>
+0x9E 0x009E # <control>
+0x9F 0x009F # <control>
+0xA0 0x00A0 # NO-BREAK SPACE
+0xA1 0x00A1 # INVERTED EXCLAMATION MARK
+0xA2 0x00A2 # CENT SIGN
+0xA3 0x00A3 # POUND SIGN
+0xA4 0x00A4 # CURRENCY SIGN
+0xA5 0x00A5 # YEN SIGN
+0xA6 0x00A6 # BROKEN BAR
+0xA7 0x00A7 # SECTION SIGN
+0xA8 0x00A8 # DIAERESIS
+0xA9 0x00A9 # COPYRIGHT SIGN
+0xAA 0x00AA # FEMININE ORDINAL INDICATOR
+0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC # NOT SIGN
+0xAD 0x00AD # SOFT HYPHEN
+0xAE 0x00AE # REGISTERED SIGN
+0xAF 0x00AF # MACRON
+0xB0 0x00B0 # DEGREE SIGN
+0xB1 0x00B1 # PLUS-MINUS SIGN
+0xB2 0x00B2 # SUPERSCRIPT TWO
+0xB3 0x00B3 # SUPERSCRIPT THREE
+0xB4 0x00B4 # ACUTE ACCENT
+0xB5 0x00B5 # MICRO SIGN
+0xB6 0x00B6 # PILCROW SIGN
+0xB7 0x00B7 # MIDDLE DOT
+0xB8 0x00B8 # CEDILLA
+0xB9 0x00B9 # SUPERSCRIPT ONE
+0xBA 0x00BA # MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC # VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD # VULGAR FRACTION ONE HALF
+0xBE 0x00BE # VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF # INVERTED QUESTION MARK
+0xC0 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 # LATIN CAPITAL LETTER AE
+0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 # LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC # LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x011E # LATIN CAPITAL LETTER G WITH BREVE
+0xD1 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 # LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 # MULTIPLICATION SIGN
+0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 # LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x0130 # LATIN CAPITAL LETTER I WITH DOT ABOVE
+0xDE 0x015E # LATIN CAPITAL LETTER S WITH CEDILLA
+0xDF 0x00DF # LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 # LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 # LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 # LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 # LATIN SMALL LETTER AE
+0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 # LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA # LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC # LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x011F # LATIN SMALL LETTER G WITH BREVE
+0xF1 0x00F1 # LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 # LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 # LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 # DIVISION SIGN
+0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 # LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x0131 # LATIN SMALL LETTER DOTLESS I
+0xFE 0x015F # LATIN SMALL LETTER S WITH CEDILLA
+0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS
+
+
diff --git a/rtl/ucmaps/cp1250.txt b/rtl/ucmaps/cp1250.txt
new file mode 100644
index 0000000000..081d7763b3
--- /dev/null
+++ b/rtl/ucmaps/cp1250.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1250 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1250 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1250 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 #UNDEFINED
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 #UNDEFINED
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x015A #LATIN CAPITAL LETTER S WITH ACUTE
+0x8D 0x0164 #LATIN CAPITAL LETTER T WITH CARON
+0x8E 0x017D #LATIN CAPITAL LETTER Z WITH CARON
+0x8F 0x0179 #LATIN CAPITAL LETTER Z WITH ACUTE
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0161 #LATIN SMALL LETTER S WITH CARON
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x015B #LATIN SMALL LETTER S WITH ACUTE
+0x9D 0x0165 #LATIN SMALL LETTER T WITH CARON
+0x9E 0x017E #LATIN SMALL LETTER Z WITH CARON
+0x9F 0x017A #LATIN SMALL LETTER Z WITH ACUTE
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x02C7 #CARON
+0xA2 0x02D8 #BREVE
+0xA3 0x0141 #LATIN CAPITAL LETTER L WITH STROKE
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x0104 #LATIN CAPITAL LETTER A WITH OGONEK
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x015E #LATIN CAPITAL LETTER S WITH CEDILLA
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x017B #LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x02DB #OGONEK
+0xB3 0x0142 #LATIN SMALL LETTER L WITH STROKE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x0105 #LATIN SMALL LETTER A WITH OGONEK
+0xBA 0x015F #LATIN SMALL LETTER S WITH CEDILLA
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x013D #LATIN CAPITAL LETTER L WITH CARON
+0xBD 0x02DD #DOUBLE ACUTE ACCENT
+0xBE 0x013E #LATIN SMALL LETTER L WITH CARON
+0xBF 0x017C #LATIN SMALL LETTER Z WITH DOT ABOVE
+0xC0 0x0154 #LATIN CAPITAL LETTER R WITH ACUTE
+0xC1 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x0102 #LATIN CAPITAL LETTER A WITH BREVE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x0139 #LATIN CAPITAL LETTER L WITH ACUTE
+0xC6 0x0106 #LATIN CAPITAL LETTER C WITH ACUTE
+0xC7 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x010C #LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0118 #LATIN CAPITAL LETTER E WITH OGONEK
+0xCB 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x011A #LATIN CAPITAL LETTER E WITH CARON
+0xCD 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x010E #LATIN CAPITAL LETTER D WITH CARON
+0xD0 0x0110 #LATIN CAPITAL LETTER D WITH STROKE
+0xD1 0x0143 #LATIN CAPITAL LETTER N WITH ACUTE
+0xD2 0x0147 #LATIN CAPITAL LETTER N WITH CARON
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x0150 #LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x0158 #LATIN CAPITAL LETTER R WITH CARON
+0xD9 0x016E #LATIN CAPITAL LETTER U WITH RING ABOVE
+0xDA 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x0170 #LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD #LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x0162 #LATIN CAPITAL LETTER T WITH CEDILLA
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x0155 #LATIN SMALL LETTER R WITH ACUTE
+0xE1 0x00E1 #LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x0103 #LATIN SMALL LETTER A WITH BREVE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x013A #LATIN SMALL LETTER L WITH ACUTE
+0xE6 0x0107 #LATIN SMALL LETTER C WITH ACUTE
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x010D #LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x0119 #LATIN SMALL LETTER E WITH OGONEK
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x011B #LATIN SMALL LETTER E WITH CARON
+0xED 0x00ED #LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x010F #LATIN SMALL LETTER D WITH CARON
+0xF0 0x0111 #LATIN SMALL LETTER D WITH STROKE
+0xF1 0x0144 #LATIN SMALL LETTER N WITH ACUTE
+0xF2 0x0148 #LATIN SMALL LETTER N WITH CARON
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x0151 #LATIN SMALL LETTER O WITH DOUBLE ACUTE
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x0159 #LATIN SMALL LETTER R WITH CARON
+0xF9 0x016F #LATIN SMALL LETTER U WITH RING ABOVE
+0xFA 0x00FA #LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x0171 #LATIN SMALL LETTER U WITH DOUBLE ACUTE
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD #LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x0163 #LATIN SMALL LETTER T WITH CEDILLA
+0xFF 0x02D9 #DOT ABOVE
diff --git a/rtl/ucmaps/cp1251.txt b/rtl/ucmaps/cp1251.txt
new file mode 100644
index 0000000000..37eadbdbc9
--- /dev/null
+++ b/rtl/ucmaps/cp1251.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1251 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1251 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1251 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x0402 #CYRILLIC CAPITAL LETTER DJE
+0x81 0x0403 #CYRILLIC CAPITAL LETTER GJE
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0453 #CYRILLIC SMALL LETTER GJE
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x20AC #EURO SIGN
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0409 #CYRILLIC CAPITAL LETTER LJE
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x040A #CYRILLIC CAPITAL LETTER NJE
+0x8D 0x040C #CYRILLIC CAPITAL LETTER KJE
+0x8E 0x040B #CYRILLIC CAPITAL LETTER TSHE
+0x8F 0x040F #CYRILLIC CAPITAL LETTER DZHE
+0x90 0x0452 #CYRILLIC SMALL LETTER DJE
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0459 #CYRILLIC SMALL LETTER LJE
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x045A #CYRILLIC SMALL LETTER NJE
+0x9D 0x045C #CYRILLIC SMALL LETTER KJE
+0x9E 0x045B #CYRILLIC SMALL LETTER TSHE
+0x9F 0x045F #CYRILLIC SMALL LETTER DZHE
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x040E #CYRILLIC CAPITAL LETTER SHORT U
+0xA2 0x045E #CYRILLIC SMALL LETTER SHORT U
+0xA3 0x0408 #CYRILLIC CAPITAL LETTER JE
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x0490 #CYRILLIC CAPITAL LETTER GHE WITH UPTURN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x0401 #CYRILLIC CAPITAL LETTER IO
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x0404 #CYRILLIC CAPITAL LETTER UKRAINIAN IE
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x0407 #CYRILLIC CAPITAL LETTER YI
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x0406 #CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
+0xB3 0x0456 #CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+0xB4 0x0491 #CYRILLIC SMALL LETTER GHE WITH UPTURN
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x0451 #CYRILLIC SMALL LETTER IO
+0xB9 0x2116 #NUMERO SIGN
+0xBA 0x0454 #CYRILLIC SMALL LETTER UKRAINIAN IE
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x0458 #CYRILLIC SMALL LETTER JE
+0xBD 0x0405 #CYRILLIC CAPITAL LETTER DZE
+0xBE 0x0455 #CYRILLIC SMALL LETTER DZE
+0xBF 0x0457 #CYRILLIC SMALL LETTER YI
+0xC0 0x0410 #CYRILLIC CAPITAL LETTER A
+0xC1 0x0411 #CYRILLIC CAPITAL LETTER BE
+0xC2 0x0412 #CYRILLIC CAPITAL LETTER VE
+0xC3 0x0413 #CYRILLIC CAPITAL LETTER GHE
+0xC4 0x0414 #CYRILLIC CAPITAL LETTER DE
+0xC5 0x0415 #CYRILLIC CAPITAL LETTER IE
+0xC6 0x0416 #CYRILLIC CAPITAL LETTER ZHE
+0xC7 0x0417 #CYRILLIC CAPITAL LETTER ZE
+0xC8 0x0418 #CYRILLIC CAPITAL LETTER I
+0xC9 0x0419 #CYRILLIC CAPITAL LETTER SHORT I
+0xCA 0x041A #CYRILLIC CAPITAL LETTER KA
+0xCB 0x041B #CYRILLIC CAPITAL LETTER EL
+0xCC 0x041C #CYRILLIC CAPITAL LETTER EM
+0xCD 0x041D #CYRILLIC CAPITAL LETTER EN
+0xCE 0x041E #CYRILLIC CAPITAL LETTER O
+0xCF 0x041F #CYRILLIC CAPITAL LETTER PE
+0xD0 0x0420 #CYRILLIC CAPITAL LETTER ER
+0xD1 0x0421 #CYRILLIC CAPITAL LETTER ES
+0xD2 0x0422 #CYRILLIC CAPITAL LETTER TE
+0xD3 0x0423 #CYRILLIC CAPITAL LETTER U
+0xD4 0x0424 #CYRILLIC CAPITAL LETTER EF
+0xD5 0x0425 #CYRILLIC CAPITAL LETTER HA
+0xD6 0x0426 #CYRILLIC CAPITAL LETTER TSE
+0xD7 0x0427 #CYRILLIC CAPITAL LETTER CHE
+0xD8 0x0428 #CYRILLIC CAPITAL LETTER SHA
+0xD9 0x0429 #CYRILLIC CAPITAL LETTER SHCHA
+0xDA 0x042A #CYRILLIC CAPITAL LETTER HARD SIGN
+0xDB 0x042B #CYRILLIC CAPITAL LETTER YERU
+0xDC 0x042C #CYRILLIC CAPITAL LETTER SOFT SIGN
+0xDD 0x042D #CYRILLIC CAPITAL LETTER E
+0xDE 0x042E #CYRILLIC CAPITAL LETTER YU
+0xDF 0x042F #CYRILLIC CAPITAL LETTER YA
+0xE0 0x0430 #CYRILLIC SMALL LETTER A
+0xE1 0x0431 #CYRILLIC SMALL LETTER BE
+0xE2 0x0432 #CYRILLIC SMALL LETTER VE
+0xE3 0x0433 #CYRILLIC SMALL LETTER GHE
+0xE4 0x0434 #CYRILLIC SMALL LETTER DE
+0xE5 0x0435 #CYRILLIC SMALL LETTER IE
+0xE6 0x0436 #CYRILLIC SMALL LETTER ZHE
+0xE7 0x0437 #CYRILLIC SMALL LETTER ZE
+0xE8 0x0438 #CYRILLIC SMALL LETTER I
+0xE9 0x0439 #CYRILLIC SMALL LETTER SHORT I
+0xEA 0x043A #CYRILLIC SMALL LETTER KA
+0xEB 0x043B #CYRILLIC SMALL LETTER EL
+0xEC 0x043C #CYRILLIC SMALL LETTER EM
+0xED 0x043D #CYRILLIC SMALL LETTER EN
+0xEE 0x043E #CYRILLIC SMALL LETTER O
+0xEF 0x043F #CYRILLIC SMALL LETTER PE
+0xF0 0x0440 #CYRILLIC SMALL LETTER ER
+0xF1 0x0441 #CYRILLIC SMALL LETTER ES
+0xF2 0x0442 #CYRILLIC SMALL LETTER TE
+0xF3 0x0443 #CYRILLIC SMALL LETTER U
+0xF4 0x0444 #CYRILLIC SMALL LETTER EF
+0xF5 0x0445 #CYRILLIC SMALL LETTER HA
+0xF6 0x0446 #CYRILLIC SMALL LETTER TSE
+0xF7 0x0447 #CYRILLIC SMALL LETTER CHE
+0xF8 0x0448 #CYRILLIC SMALL LETTER SHA
+0xF9 0x0449 #CYRILLIC SMALL LETTER SHCHA
+0xFA 0x044A #CYRILLIC SMALL LETTER HARD SIGN
+0xFB 0x044B #CYRILLIC SMALL LETTER YERU
+0xFC 0x044C #CYRILLIC SMALL LETTER SOFT SIGN
+0xFD 0x044D #CYRILLIC SMALL LETTER E
+0xFE 0x044E #CYRILLIC SMALL LETTER YU
+0xFF 0x044F #CYRILLIC SMALL LETTER YA
diff --git a/rtl/ucmaps/cp1252.txt b/rtl/ucmaps/cp1252.txt
new file mode 100644
index 0000000000..2ca4486eb8
--- /dev/null
+++ b/rtl/ucmaps/cp1252.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1252 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1252 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1252 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D #UNDEFINED
+0x8E 0x017D #LATIN CAPITAL LETTER Z WITH CARON
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0161 #LATIN SMALL LETTER S WITH CARON
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D #UNDEFINED
+0x9E 0x017E #LATIN SMALL LETTER Z WITH CARON
+0x9F 0x0178 #LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00AA #FEMININE ORDINAL INDICATOR
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00BA #MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x00C0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 #LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 #LATIN CAPITAL LETTER AE
+0xC7 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC #LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x00D0 #LATIN CAPITAL LETTER ETH
+0xD1 0x00D1 #LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 #LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 #LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x00DD #LATIN CAPITAL LETTER Y WITH ACUTE
+0xDE 0x00DE #LATIN CAPITAL LETTER THORN
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 #LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 #LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 #LATIN SMALL LETTER AE
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC #LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED #LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x00F0 #LATIN SMALL LETTER ETH
+0xF1 0x00F1 #LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 #LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 #LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA #LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x00FD #LATIN SMALL LETTER Y WITH ACUTE
+0xFE 0x00FE #LATIN SMALL LETTER THORN
+0xFF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS
diff --git a/rtl/ucmaps/cp1253.txt b/rtl/ucmaps/cp1253.txt
new file mode 100644
index 0000000000..2ba51a0c8f
--- /dev/null
+++ b/rtl/ucmaps/cp1253.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1253 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1253 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1253 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 #UNDEFINED
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C #UNDEFINED
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C #UNDEFINED
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x0385 #GREEK DIALYTIKA TONOS
+0xA2 0x0386 #GREEK CAPITAL LETTER ALPHA WITH TONOS
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA #UNDEFINED
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x2015 #HORIZONTAL BAR
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x0384 #GREEK TONOS
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x0388 #GREEK CAPITAL LETTER EPSILON WITH TONOS
+0xB9 0x0389 #GREEK CAPITAL LETTER ETA WITH TONOS
+0xBA 0x038A #GREEK CAPITAL LETTER IOTA WITH TONOS
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x038C #GREEK CAPITAL LETTER OMICRON WITH TONOS
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x038E #GREEK CAPITAL LETTER UPSILON WITH TONOS
+0xBF 0x038F #GREEK CAPITAL LETTER OMEGA WITH TONOS
+0xC0 0x0390 #GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+0xC1 0x0391 #GREEK CAPITAL LETTER ALPHA
+0xC2 0x0392 #GREEK CAPITAL LETTER BETA
+0xC3 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xC4 0x0394 #GREEK CAPITAL LETTER DELTA
+0xC5 0x0395 #GREEK CAPITAL LETTER EPSILON
+0xC6 0x0396 #GREEK CAPITAL LETTER ZETA
+0xC7 0x0397 #GREEK CAPITAL LETTER ETA
+0xC8 0x0398 #GREEK CAPITAL LETTER THETA
+0xC9 0x0399 #GREEK CAPITAL LETTER IOTA
+0xCA 0x039A #GREEK CAPITAL LETTER KAPPA
+0xCB 0x039B #GREEK CAPITAL LETTER LAMDA
+0xCC 0x039C #GREEK CAPITAL LETTER MU
+0xCD 0x039D #GREEK CAPITAL LETTER NU
+0xCE 0x039E #GREEK CAPITAL LETTER XI
+0xCF 0x039F #GREEK CAPITAL LETTER OMICRON
+0xD0 0x03A0 #GREEK CAPITAL LETTER PI
+0xD1 0x03A1 #GREEK CAPITAL LETTER RHO
+0xD2 #UNDEFINED
+0xD3 0x03A3 #GREEK CAPITAL LETTER SIGMA
+0xD4 0x03A4 #GREEK CAPITAL LETTER TAU
+0xD5 0x03A5 #GREEK CAPITAL LETTER UPSILON
+0xD6 0x03A6 #GREEK CAPITAL LETTER PHI
+0xD7 0x03A7 #GREEK CAPITAL LETTER CHI
+0xD8 0x03A8 #GREEK CAPITAL LETTER PSI
+0xD9 0x03A9 #GREEK CAPITAL LETTER OMEGA
+0xDA 0x03AA #GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+0xDB 0x03AB #GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+0xDC 0x03AC #GREEK SMALL LETTER ALPHA WITH TONOS
+0xDD 0x03AD #GREEK SMALL LETTER EPSILON WITH TONOS
+0xDE 0x03AE #GREEK SMALL LETTER ETA WITH TONOS
+0xDF 0x03AF #GREEK SMALL LETTER IOTA WITH TONOS
+0xE0 0x03B0 #GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+0xE1 0x03B1 #GREEK SMALL LETTER ALPHA
+0xE2 0x03B2 #GREEK SMALL LETTER BETA
+0xE3 0x03B3 #GREEK SMALL LETTER GAMMA
+0xE4 0x03B4 #GREEK SMALL LETTER DELTA
+0xE5 0x03B5 #GREEK SMALL LETTER EPSILON
+0xE6 0x03B6 #GREEK SMALL LETTER ZETA
+0xE7 0x03B7 #GREEK SMALL LETTER ETA
+0xE8 0x03B8 #GREEK SMALL LETTER THETA
+0xE9 0x03B9 #GREEK SMALL LETTER IOTA
+0xEA 0x03BA #GREEK SMALL LETTER KAPPA
+0xEB 0x03BB #GREEK SMALL LETTER LAMDA
+0xEC 0x03BC #GREEK SMALL LETTER MU
+0xED 0x03BD #GREEK SMALL LETTER NU
+0xEE 0x03BE #GREEK SMALL LETTER XI
+0xEF 0x03BF #GREEK SMALL LETTER OMICRON
+0xF0 0x03C0 #GREEK SMALL LETTER PI
+0xF1 0x03C1 #GREEK SMALL LETTER RHO
+0xF2 0x03C2 #GREEK SMALL LETTER FINAL SIGMA
+0xF3 0x03C3 #GREEK SMALL LETTER SIGMA
+0xF4 0x03C4 #GREEK SMALL LETTER TAU
+0xF5 0x03C5 #GREEK SMALL LETTER UPSILON
+0xF6 0x03C6 #GREEK SMALL LETTER PHI
+0xF7 0x03C7 #GREEK SMALL LETTER CHI
+0xF8 0x03C8 #GREEK SMALL LETTER PSI
+0xF9 0x03C9 #GREEK SMALL LETTER OMEGA
+0xFA 0x03CA #GREEK SMALL LETTER IOTA WITH DIALYTIKA
+0xFB 0x03CB #GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+0xFC 0x03CC #GREEK SMALL LETTER OMICRON WITH TONOS
+0xFD 0x03CD #GREEK SMALL LETTER UPSILON WITH TONOS
+0xFE 0x03CE #GREEK SMALL LETTER OMEGA WITH TONOS
+0xFF #UNDEFINED
diff --git a/rtl/ucmaps/cp1254.txt b/rtl/ucmaps/cp1254.txt
new file mode 100644
index 0000000000..ca1a1ebdb8
--- /dev/null
+++ b/rtl/ucmaps/cp1254.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1254 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1254 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1254 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0161 #LATIN SMALL LETTER S WITH CARON
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F 0x0178 #LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00AA #FEMININE ORDINAL INDICATOR
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00BA #MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x00C0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 #LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 #LATIN CAPITAL LETTER AE
+0xC7 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC #LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x011E #LATIN CAPITAL LETTER G WITH BREVE
+0xD1 0x00D1 #LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 #LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 #LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x0130 #LATIN CAPITAL LETTER I WITH DOT ABOVE
+0xDE 0x015E #LATIN CAPITAL LETTER S WITH CEDILLA
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 #LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 #LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 #LATIN SMALL LETTER AE
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC #LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED #LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x011F #LATIN SMALL LETTER G WITH BREVE
+0xF1 0x00F1 #LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 #LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 #LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA #LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x0131 #LATIN SMALL LETTER DOTLESS I
+0xFE 0x015F #LATIN SMALL LETTER S WITH CEDILLA
+0xFF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS
diff --git a/rtl/ucmaps/cp1255.txt b/rtl/ucmaps/cp1255.txt
new file mode 100644
index 0000000000..341517f119
--- /dev/null
+++ b/rtl/ucmaps/cp1255.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1255 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 1/7/2000
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1255 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1255 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C #UNDEFINED
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C #UNDEFINED
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x20AA #NEW SHEQEL SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00D7 #MULTIPLICATION SIGN
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00F7 #DIVISION SIGN
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x05B0 #HEBREW POINT SHEVA
+0xC1 0x05B1 #HEBREW POINT HATAF SEGOL
+0xC2 0x05B2 #HEBREW POINT HATAF PATAH
+0xC3 0x05B3 #HEBREW POINT HATAF QAMATS
+0xC4 0x05B4 #HEBREW POINT HIRIQ
+0xC5 0x05B5 #HEBREW POINT TSERE
+0xC6 0x05B6 #HEBREW POINT SEGOL
+0xC7 0x05B7 #HEBREW POINT PATAH
+0xC8 0x05B8 #HEBREW POINT QAMATS
+0xC9 0x05B9 #HEBREW POINT HOLAM
+0xCA #UNDEFINED
+0xCB 0x05BB #HEBREW POINT QUBUTS
+0xCC 0x05BC #HEBREW POINT DAGESH OR MAPIQ
+0xCD 0x05BD #HEBREW POINT METEG
+0xCE 0x05BE #HEBREW PUNCTUATION MAQAF
+0xCF 0x05BF #HEBREW POINT RAFE
+0xD0 0x05C0 #HEBREW PUNCTUATION PASEQ
+0xD1 0x05C1 #HEBREW POINT SHIN DOT
+0xD2 0x05C2 #HEBREW POINT SIN DOT
+0xD3 0x05C3 #HEBREW PUNCTUATION SOF PASUQ
+0xD4 0x05F0 #HEBREW LIGATURE YIDDISH DOUBLE VAV
+0xD5 0x05F1 #HEBREW LIGATURE YIDDISH VAV YOD
+0xD6 0x05F2 #HEBREW LIGATURE YIDDISH DOUBLE YOD
+0xD7 0x05F3 #HEBREW PUNCTUATION GERESH
+0xD8 0x05F4 #HEBREW PUNCTUATION GERSHAYIM
+0xD9 #UNDEFINED
+0xDA #UNDEFINED
+0xDB #UNDEFINED
+0xDC #UNDEFINED
+0xDD #UNDEFINED
+0xDE #UNDEFINED
+0xDF #UNDEFINED
+0xE0 0x05D0 #HEBREW LETTER ALEF
+0xE1 0x05D1 #HEBREW LETTER BET
+0xE2 0x05D2 #HEBREW LETTER GIMEL
+0xE3 0x05D3 #HEBREW LETTER DALET
+0xE4 0x05D4 #HEBREW LETTER HE
+0xE5 0x05D5 #HEBREW LETTER VAV
+0xE6 0x05D6 #HEBREW LETTER ZAYIN
+0xE7 0x05D7 #HEBREW LETTER HET
+0xE8 0x05D8 #HEBREW LETTER TET
+0xE9 0x05D9 #HEBREW LETTER YOD
+0xEA 0x05DA #HEBREW LETTER FINAL KAF
+0xEB 0x05DB #HEBREW LETTER KAF
+0xEC 0x05DC #HEBREW LETTER LAMED
+0xED 0x05DD #HEBREW LETTER FINAL MEM
+0xEE 0x05DE #HEBREW LETTER MEM
+0xEF 0x05DF #HEBREW LETTER FINAL NUN
+0xF0 0x05E0 #HEBREW LETTER NUN
+0xF1 0x05E1 #HEBREW LETTER SAMEKH
+0xF2 0x05E2 #HEBREW LETTER AYIN
+0xF3 0x05E3 #HEBREW LETTER FINAL PE
+0xF4 0x05E4 #HEBREW LETTER PE
+0xF5 0x05E5 #HEBREW LETTER FINAL TSADI
+0xF6 0x05E6 #HEBREW LETTER TSADI
+0xF7 0x05E7 #HEBREW LETTER QOF
+0xF8 0x05E8 #HEBREW LETTER RESH
+0xF9 0x05E9 #HEBREW LETTER SHIN
+0xFA 0x05EA #HEBREW LETTER TAV
+0xFB #UNDEFINED
+0xFC #UNDEFINED
+0xFD 0x200E #LEFT-TO-RIGHT MARK
+0xFE 0x200F #RIGHT-TO-LEFT MARK
+0xFF #UNDEFINED
diff --git a/rtl/ucmaps/cp1256.txt b/rtl/ucmaps/cp1256.txt
new file mode 100644
index 0000000000..0edd081b92
--- /dev/null
+++ b/rtl/ucmaps/cp1256.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1256 to Unicode table
+# Unicode version: 2.1
+# Table version: 2.01
+# Table format: Format A
+# Date: 01/5/99
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1256 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1256 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 0x067E #ARABIC LETTER PEH
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0679 #ARABIC LETTER TTEH
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D 0x0686 #ARABIC LETTER TCHEH
+0x8E 0x0698 #ARABIC LETTER JEH
+0x8F 0x0688 #ARABIC LETTER DDAL
+0x90 0x06AF #ARABIC LETTER GAF
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x06A9 #ARABIC LETTER KEHEH
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0691 #ARABIC LETTER RREH
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D 0x200C #ZERO WIDTH NON-JOINER
+0x9E 0x200D #ZERO WIDTH JOINER
+0x9F 0x06BA #ARABIC LETTER NOON GHUNNA
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x060C #ARABIC COMMA
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x06BE #ARABIC LETTER HEH DOACHASHMEE
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x061B #ARABIC SEMICOLON
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x061F #ARABIC QUESTION MARK
+0xC0 0x06C1 #ARABIC LETTER HEH GOAL
+0xC1 0x0621 #ARABIC LETTER HAMZA
+0xC2 0x0622 #ARABIC LETTER ALEF WITH MADDA ABOVE
+0xC3 0x0623 #ARABIC LETTER ALEF WITH HAMZA ABOVE
+0xC4 0x0624 #ARABIC LETTER WAW WITH HAMZA ABOVE
+0xC5 0x0625 #ARABIC LETTER ALEF WITH HAMZA BELOW
+0xC6 0x0626 #ARABIC LETTER YEH WITH HAMZA ABOVE
+0xC7 0x0627 #ARABIC LETTER ALEF
+0xC8 0x0628 #ARABIC LETTER BEH
+0xC9 0x0629 #ARABIC LETTER TEH MARBUTA
+0xCA 0x062A #ARABIC LETTER TEH
+0xCB 0x062B #ARABIC LETTER THEH
+0xCC 0x062C #ARABIC LETTER JEEM
+0xCD 0x062D #ARABIC LETTER HAH
+0xCE 0x062E #ARABIC LETTER KHAH
+0xCF 0x062F #ARABIC LETTER DAL
+0xD0 0x0630 #ARABIC LETTER THAL
+0xD1 0x0631 #ARABIC LETTER REH
+0xD2 0x0632 #ARABIC LETTER ZAIN
+0xD3 0x0633 #ARABIC LETTER SEEN
+0xD4 0x0634 #ARABIC LETTER SHEEN
+0xD5 0x0635 #ARABIC LETTER SAD
+0xD6 0x0636 #ARABIC LETTER DAD
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x0637 #ARABIC LETTER TAH
+0xD9 0x0638 #ARABIC LETTER ZAH
+0xDA 0x0639 #ARABIC LETTER AIN
+0xDB 0x063A #ARABIC LETTER GHAIN
+0xDC 0x0640 #ARABIC TATWEEL
+0xDD 0x0641 #ARABIC LETTER FEH
+0xDE 0x0642 #ARABIC LETTER QAF
+0xDF 0x0643 #ARABIC LETTER KAF
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x0644 #ARABIC LETTER LAM
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x0645 #ARABIC LETTER MEEM
+0xE4 0x0646 #ARABIC LETTER NOON
+0xE5 0x0647 #ARABIC LETTER HEH
+0xE6 0x0648 #ARABIC LETTER WAW
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x0649 #ARABIC LETTER ALEF MAKSURA
+0xED 0x064A #ARABIC LETTER YEH
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x064B #ARABIC FATHATAN
+0xF1 0x064C #ARABIC DAMMATAN
+0xF2 0x064D #ARABIC KASRATAN
+0xF3 0x064E #ARABIC FATHA
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x064F #ARABIC DAMMA
+0xF6 0x0650 #ARABIC KASRA
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x0651 #ARABIC SHADDA
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x0652 #ARABIC SUKUN
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x200E #LEFT-TO-RIGHT MARK
+0xFE 0x200F #RIGHT-TO-LEFT MARK
+0xFF 0x06D2 #ARABIC LETTER YEH BARREE
diff --git a/rtl/ucmaps/cp1257.txt b/rtl/ucmaps/cp1257.txt
new file mode 100644
index 0000000000..97979d9319
--- /dev/null
+++ b/rtl/ucmaps/cp1257.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1257 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1257 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1257 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 #UNDEFINED
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 #UNDEFINED
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C #UNDEFINED
+0x8D 0x00A8 #DIAERESIS
+0x8E 0x02C7 #CARON
+0x8F 0x00B8 #CEDILLA
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C #UNDEFINED
+0x9D 0x00AF #MACRON
+0x9E 0x02DB #OGONEK
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 #UNDEFINED
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 #UNDEFINED
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x0156 #LATIN CAPITAL LETTER R WITH CEDILLA
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00C6 #LATIN CAPITAL LETTER AE
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x0157 #LATIN SMALL LETTER R WITH CEDILLA
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00E6 #LATIN SMALL LETTER AE
+0xC0 0x0104 #LATIN CAPITAL LETTER A WITH OGONEK
+0xC1 0x012E #LATIN CAPITAL LETTER I WITH OGONEK
+0xC2 0x0100 #LATIN CAPITAL LETTER A WITH MACRON
+0xC3 0x0106 #LATIN CAPITAL LETTER C WITH ACUTE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x0118 #LATIN CAPITAL LETTER E WITH OGONEK
+0xC7 0x0112 #LATIN CAPITAL LETTER E WITH MACRON
+0xC8 0x010C #LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0179 #LATIN CAPITAL LETTER Z WITH ACUTE
+0xCB 0x0116 #LATIN CAPITAL LETTER E WITH DOT ABOVE
+0xCC 0x0122 #LATIN CAPITAL LETTER G WITH CEDILLA
+0xCD 0x0136 #LATIN CAPITAL LETTER K WITH CEDILLA
+0xCE 0x012A #LATIN CAPITAL LETTER I WITH MACRON
+0xCF 0x013B #LATIN CAPITAL LETTER L WITH CEDILLA
+0xD0 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0xD1 0x0143 #LATIN CAPITAL LETTER N WITH ACUTE
+0xD2 0x0145 #LATIN CAPITAL LETTER N WITH CEDILLA
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x014C #LATIN CAPITAL LETTER O WITH MACRON
+0xD5 0x00D5 #LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x0172 #LATIN CAPITAL LETTER U WITH OGONEK
+0xD9 0x0141 #LATIN CAPITAL LETTER L WITH STROKE
+0xDA 0x015A #LATIN CAPITAL LETTER S WITH ACUTE
+0xDB 0x016A #LATIN CAPITAL LETTER U WITH MACRON
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x017B #LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xDE 0x017D #LATIN CAPITAL LETTER Z WITH CARON
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x0105 #LATIN SMALL LETTER A WITH OGONEK
+0xE1 0x012F #LATIN SMALL LETTER I WITH OGONEK
+0xE2 0x0101 #LATIN SMALL LETTER A WITH MACRON
+0xE3 0x0107 #LATIN SMALL LETTER C WITH ACUTE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x0119 #LATIN SMALL LETTER E WITH OGONEK
+0xE7 0x0113 #LATIN SMALL LETTER E WITH MACRON
+0xE8 0x010D #LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x017A #LATIN SMALL LETTER Z WITH ACUTE
+0xEB 0x0117 #LATIN SMALL LETTER E WITH DOT ABOVE
+0xEC 0x0123 #LATIN SMALL LETTER G WITH CEDILLA
+0xED 0x0137 #LATIN SMALL LETTER K WITH CEDILLA
+0xEE 0x012B #LATIN SMALL LETTER I WITH MACRON
+0xEF 0x013C #LATIN SMALL LETTER L WITH CEDILLA
+0xF0 0x0161 #LATIN SMALL LETTER S WITH CARON
+0xF1 0x0144 #LATIN SMALL LETTER N WITH ACUTE
+0xF2 0x0146 #LATIN SMALL LETTER N WITH CEDILLA
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x014D #LATIN SMALL LETTER O WITH MACRON
+0xF5 0x00F5 #LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x0173 #LATIN SMALL LETTER U WITH OGONEK
+0xF9 0x0142 #LATIN SMALL LETTER L WITH STROKE
+0xFA 0x015B #LATIN SMALL LETTER S WITH ACUTE
+0xFB 0x016B #LATIN SMALL LETTER U WITH MACRON
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x017C #LATIN SMALL LETTER Z WITH DOT ABOVE
+0xFE 0x017E #LATIN SMALL LETTER Z WITH CARON
+0xFF 0x02D9 #DOT ABOVE
diff --git a/rtl/ucmaps/cp1258.txt b/rtl/ucmaps/cp1258.txt
new file mode 100644
index 0000000000..392310a8ca
--- /dev/null
+++ b/rtl/ucmaps/cp1258.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp1258 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1258 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1258 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F 0x0178 #LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00AA #FEMININE ORDINAL INDICATOR
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00BA #MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x00C0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x0102 #LATIN CAPITAL LETTER A WITH BREVE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 #LATIN CAPITAL LETTER AE
+0xC7 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x0300 #COMBINING GRAVE ACCENT
+0xCD 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x0110 #LATIN CAPITAL LETTER D WITH STROKE
+0xD1 0x00D1 #LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x0309 #COMBINING HOOK ABOVE
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x01A0 #LATIN CAPITAL LETTER O WITH HORN
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x01AF #LATIN CAPITAL LETTER U WITH HORN
+0xDE 0x0303 #COMBINING TILDE
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 #LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x0103 #LATIN SMALL LETTER A WITH BREVE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 #LATIN SMALL LETTER AE
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x0301 #COMBINING ACUTE ACCENT
+0xED 0x00ED #LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x0111 #LATIN SMALL LETTER D WITH STROKE
+0xF1 0x00F1 #LATIN SMALL LETTER N WITH TILDE
+0xF2 0x0323 #COMBINING DOT BELOW
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x01A1 #LATIN SMALL LETTER O WITH HORN
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA #LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x01B0 #LATIN SMALL LETTER U WITH HORN
+0xFE 0x20AB #DONG SIGN
+0xFF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS
diff --git a/rtl/ucmaps/cp437.txt b/rtl/ucmaps/cp437.txt
new file mode 100644
index 0000000000..ae38e17ab9
--- /dev/null
+++ b/rtl/ucmaps/cp437.txt
@@ -0,0 +1,273 @@
+#
+# Name: cp437_DOSLatinUS to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp437_DOSLatinUS code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp437_DOSLatinUS order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00e5 #LATIN SMALL LETTER A WITH RING ABOVE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00ef #LATIN SMALL LETTER I WITH DIAERESIS
+0x8c 0x00ee #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0x8d 0x00ec #LATIN SMALL LETTER I WITH GRAVE
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x00c5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00e6 #LATIN SMALL LIGATURE AE
+0x92 0x00c6 #LATIN CAPITAL LIGATURE AE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x00f2 #LATIN SMALL LETTER O WITH GRAVE
+0x96 0x00fb #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0x97 0x00f9 #LATIN SMALL LETTER U WITH GRAVE
+0x98 0x00ff #LATIN SMALL LETTER Y WITH DIAERESIS
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00a2 #CENT SIGN
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00a5 #YEN SIGN
+0x9e 0x20a7 #PESETA SIGN
+0x9f 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00f1 #LATIN SMALL LETTER N WITH TILDE
+0xa5 0x00d1 #LATIN CAPITAL LETTER N WITH TILDE
+0xa6 0x00aa #FEMININE ORDINAL INDICATOR
+0xa7 0x00ba #MASCULINE ORDINAL INDICATOR
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x2310 #REVERSED NOT SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b1 #GREEK SMALL LETTER ALPHA
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xe3 0x03c0 #GREEK SMALL LETTER PI
+0xe4 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xe5 0x03c3 #GREEK SMALL LETTER SIGMA
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x03c4 #GREEK SMALL LETTER TAU
+0xe8 0x03a6 #GREEK CAPITAL LETTER PHI
+0xe9 0x0398 #GREEK CAPITAL LETTER THETA
+0xea 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xeb 0x03b4 #GREEK SMALL LETTER DELTA
+0xec 0x221e #INFINITY
+0xed 0x03c6 #GREEK SMALL LETTER PHI
+0xee 0x03b5 #GREEK SMALL LETTER EPSILON
+0xef 0x2229 #INTERSECTION
+0xf0 0x2261 #IDENTICAL TO
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x2320 #TOP HALF INTEGRAL
+0xf5 0x2321 #BOTTOM HALF INTEGRAL
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
diff --git a/rtl/ucmaps/cp737.txt b/rtl/ucmaps/cp737.txt
new file mode 100644
index 0000000000..0fc572fc35
--- /dev/null
+++ b/rtl/ucmaps/cp737.txt
@@ -0,0 +1,273 @@
+#
+# Name: cp737_DOSGreek to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp737_DOSGreek code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp737_DOSGreek order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x0391 #GREEK CAPITAL LETTER ALPHA
+0x81 0x0392 #GREEK CAPITAL LETTER BETA
+0x82 0x0393 #GREEK CAPITAL LETTER GAMMA
+0x83 0x0394 #GREEK CAPITAL LETTER DELTA
+0x84 0x0395 #GREEK CAPITAL LETTER EPSILON
+0x85 0x0396 #GREEK CAPITAL LETTER ZETA
+0x86 0x0397 #GREEK CAPITAL LETTER ETA
+0x87 0x0398 #GREEK CAPITAL LETTER THETA
+0x88 0x0399 #GREEK CAPITAL LETTER IOTA
+0x89 0x039a #GREEK CAPITAL LETTER KAPPA
+0x8a 0x039b #GREEK CAPITAL LETTER LAMDA
+0x8b 0x039c #GREEK CAPITAL LETTER MU
+0x8c 0x039d #GREEK CAPITAL LETTER NU
+0x8d 0x039e #GREEK CAPITAL LETTER XI
+0x8e 0x039f #GREEK CAPITAL LETTER OMICRON
+0x8f 0x03a0 #GREEK CAPITAL LETTER PI
+0x90 0x03a1 #GREEK CAPITAL LETTER RHO
+0x91 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0x92 0x03a4 #GREEK CAPITAL LETTER TAU
+0x93 0x03a5 #GREEK CAPITAL LETTER UPSILON
+0x94 0x03a6 #GREEK CAPITAL LETTER PHI
+0x95 0x03a7 #GREEK CAPITAL LETTER CHI
+0x96 0x03a8 #GREEK CAPITAL LETTER PSI
+0x97 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0x98 0x03b1 #GREEK SMALL LETTER ALPHA
+0x99 0x03b2 #GREEK SMALL LETTER BETA
+0x9a 0x03b3 #GREEK SMALL LETTER GAMMA
+0x9b 0x03b4 #GREEK SMALL LETTER DELTA
+0x9c 0x03b5 #GREEK SMALL LETTER EPSILON
+0x9d 0x03b6 #GREEK SMALL LETTER ZETA
+0x9e 0x03b7 #GREEK SMALL LETTER ETA
+0x9f 0x03b8 #GREEK SMALL LETTER THETA
+0xa0 0x03b9 #GREEK SMALL LETTER IOTA
+0xa1 0x03ba #GREEK SMALL LETTER KAPPA
+0xa2 0x03bb #GREEK SMALL LETTER LAMDA
+0xa3 0x03bc #GREEK SMALL LETTER MU
+0xa4 0x03bd #GREEK SMALL LETTER NU
+0xa5 0x03be #GREEK SMALL LETTER XI
+0xa6 0x03bf #GREEK SMALL LETTER OMICRON
+0xa7 0x03c0 #GREEK SMALL LETTER PI
+0xa8 0x03c1 #GREEK SMALL LETTER RHO
+0xa9 0x03c3 #GREEK SMALL LETTER SIGMA
+0xaa 0x03c2 #GREEK SMALL LETTER FINAL SIGMA
+0xab 0x03c4 #GREEK SMALL LETTER TAU
+0xac 0x03c5 #GREEK SMALL LETTER UPSILON
+0xad 0x03c6 #GREEK SMALL LETTER PHI
+0xae 0x03c7 #GREEK SMALL LETTER CHI
+0xaf 0x03c8 #GREEK SMALL LETTER PSI
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03c9 #GREEK SMALL LETTER OMEGA
+0xe1 0x03ac #GREEK SMALL LETTER ALPHA WITH TONOS
+0xe2 0x03ad #GREEK SMALL LETTER EPSILON WITH TONOS
+0xe3 0x03ae #GREEK SMALL LETTER ETA WITH TONOS
+0xe4 0x03ca #GREEK SMALL LETTER IOTA WITH DIALYTIKA
+0xe5 0x03af #GREEK SMALL LETTER IOTA WITH TONOS
+0xe6 0x03cc #GREEK SMALL LETTER OMICRON WITH TONOS
+0xe7 0x03cd #GREEK SMALL LETTER UPSILON WITH TONOS
+0xe8 0x03cb #GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+0xe9 0x03ce #GREEK SMALL LETTER OMEGA WITH TONOS
+0xea 0x0386 #GREEK CAPITAL LETTER ALPHA WITH TONOS
+0xeb 0x0388 #GREEK CAPITAL LETTER EPSILON WITH TONOS
+0xec 0x0389 #GREEK CAPITAL LETTER ETA WITH TONOS
+0xed 0x038a #GREEK CAPITAL LETTER IOTA WITH TONOS
+0xee 0x038c #GREEK CAPITAL LETTER OMICRON WITH TONOS
+0xef 0x038e #GREEK CAPITAL LETTER UPSILON WITH TONOS
+0xf0 0x038f #GREEK CAPITAL LETTER OMEGA WITH TONOS
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x03aa #GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+0xf5 0x03ab #GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
diff --git a/rtl/ucmaps/cp775.txt b/rtl/ucmaps/cp775.txt
new file mode 100644
index 0000000000..1ad4e4e58c
--- /dev/null
+++ b/rtl/ucmaps/cp775.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp775_DOSBaltRim to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp775_DOSBaltRim code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp775_DOSBaltRim order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x0106 #LATIN CAPITAL LETTER C WITH ACUTE
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x0101 #LATIN SMALL LETTER A WITH MACRON
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x0123 #LATIN SMALL LETTER G WITH CEDILLA
+0x86 0x00e5 #LATIN SMALL LETTER A WITH RING ABOVE
+0x87 0x0107 #LATIN SMALL LETTER C WITH ACUTE
+0x88 0x0142 #LATIN SMALL LETTER L WITH STROKE
+0x89 0x0113 #LATIN SMALL LETTER E WITH MACRON
+0x8a 0x0156 #LATIN CAPITAL LETTER R WITH CEDILLA
+0x8b 0x0157 #LATIN SMALL LETTER R WITH CEDILLA
+0x8c 0x012b #LATIN SMALL LETTER I WITH MACRON
+0x8d 0x0179 #LATIN CAPITAL LETTER Z WITH ACUTE
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x00c5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00e6 #LATIN SMALL LIGATURE AE
+0x92 0x00c6 #LATIN CAPITAL LIGATURE AE
+0x93 0x014d #LATIN SMALL LETTER O WITH MACRON
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x0122 #LATIN CAPITAL LETTER G WITH CEDILLA
+0x96 0x00a2 #CENT SIGN
+0x97 0x015a #LATIN CAPITAL LETTER S WITH ACUTE
+0x98 0x015b #LATIN SMALL LETTER S WITH ACUTE
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00f8 #LATIN SMALL LETTER O WITH STROKE
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d8 #LATIN CAPITAL LETTER O WITH STROKE
+0x9e 0x00d7 #MULTIPLICATION SIGN
+0x9f 0x00a4 #CURRENCY SIGN
+0xa0 0x0100 #LATIN CAPITAL LETTER A WITH MACRON
+0xa1 0x012a #LATIN CAPITAL LETTER I WITH MACRON
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x017b #LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xa4 0x017c #LATIN SMALL LETTER Z WITH DOT ABOVE
+0xa5 0x017a #LATIN SMALL LETTER Z WITH ACUTE
+0xa6 0x201d #RIGHT DOUBLE QUOTATION MARK
+0xa7 0x00a6 #BROKEN BAR
+0xa8 0x00a9 #COPYRIGHT SIGN
+0xa9 0x00ae #REGISTERED SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x0141 #LATIN CAPITAL LETTER L WITH STROKE
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x0104 #LATIN CAPITAL LETTER A WITH OGONEK
+0xb6 0x010c #LATIN CAPITAL LETTER C WITH CARON
+0xb7 0x0118 #LATIN CAPITAL LETTER E WITH OGONEK
+0xb8 0x0116 #LATIN CAPITAL LETTER E WITH DOT ABOVE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x012e #LATIN CAPITAL LETTER I WITH OGONEK
+0xbe 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x0172 #LATIN CAPITAL LETTER U WITH OGONEK
+0xc7 0x016a #LATIN CAPITAL LETTER U WITH MACRON
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x017d #LATIN CAPITAL LETTER Z WITH CARON
+0xd0 0x0105 #LATIN SMALL LETTER A WITH OGONEK
+0xd1 0x010d #LATIN SMALL LETTER C WITH CARON
+0xd2 0x0119 #LATIN SMALL LETTER E WITH OGONEK
+0xd3 0x0117 #LATIN SMALL LETTER E WITH DOT ABOVE
+0xd4 0x012f #LATIN SMALL LETTER I WITH OGONEK
+0xd5 0x0161 #LATIN SMALL LETTER S WITH CARON
+0xd6 0x0173 #LATIN SMALL LETTER U WITH OGONEK
+0xd7 0x016b #LATIN SMALL LETTER U WITH MACRON
+0xd8 0x017e #LATIN SMALL LETTER Z WITH CARON
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x00d3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xe1 0x00df #LATIN SMALL LETTER SHARP S (GERMAN)
+0xe2 0x014c #LATIN CAPITAL LETTER O WITH MACRON
+0xe3 0x0143 #LATIN CAPITAL LETTER N WITH ACUTE
+0xe4 0x00f5 #LATIN SMALL LETTER O WITH TILDE
+0xe5 0x00d5 #LATIN CAPITAL LETTER O WITH TILDE
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x0144 #LATIN SMALL LETTER N WITH ACUTE
+0xe8 0x0136 #LATIN CAPITAL LETTER K WITH CEDILLA
+0xe9 0x0137 #LATIN SMALL LETTER K WITH CEDILLA
+0xea 0x013b #LATIN CAPITAL LETTER L WITH CEDILLA
+0xeb 0x013c #LATIN SMALL LETTER L WITH CEDILLA
+0xec 0x0146 #LATIN SMALL LETTER N WITH CEDILLA
+0xed 0x0112 #LATIN CAPITAL LETTER E WITH MACRON
+0xee 0x0145 #LATIN CAPITAL LETTER N WITH CEDILLA
+0xef 0x2019 #RIGHT SINGLE QUOTATION MARK
+0xf0 0x00ad #SOFT HYPHEN
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x201c #LEFT DOUBLE QUOTATION MARK
+0xf3 0x00be #VULGAR FRACTION THREE QUARTERS
+0xf4 0x00b6 #PILCROW SIGN
+0xf5 0x00a7 #SECTION SIGN
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x201e #DOUBLE LOW-9 QUOTATION MARK
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x00b9 #SUPERSCRIPT ONE
+0xfc 0x00b3 #SUPERSCRIPT THREE
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp850.txt b/rtl/ucmaps/cp850.txt
new file mode 100644
index 0000000000..590b1afe50
--- /dev/null
+++ b/rtl/ucmaps/cp850.txt
@@ -0,0 +1,273 @@
+#
+# Name: cp850_DOSLatin1 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp850_DOSLatin1 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp850_DOSLatin1 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00e5 #LATIN SMALL LETTER A WITH RING ABOVE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00ef #LATIN SMALL LETTER I WITH DIAERESIS
+0x8c 0x00ee #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0x8d 0x00ec #LATIN SMALL LETTER I WITH GRAVE
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x00c5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00e6 #LATIN SMALL LIGATURE AE
+0x92 0x00c6 #LATIN CAPITAL LIGATURE AE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x00f2 #LATIN SMALL LETTER O WITH GRAVE
+0x96 0x00fb #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0x97 0x00f9 #LATIN SMALL LETTER U WITH GRAVE
+0x98 0x00ff #LATIN SMALL LETTER Y WITH DIAERESIS
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00f8 #LATIN SMALL LETTER O WITH STROKE
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d8 #LATIN CAPITAL LETTER O WITH STROKE
+0x9e 0x00d7 #MULTIPLICATION SIGN
+0x9f 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00f1 #LATIN SMALL LETTER N WITH TILDE
+0xa5 0x00d1 #LATIN CAPITAL LETTER N WITH TILDE
+0xa6 0x00aa #FEMININE ORDINAL INDICATOR
+0xa7 0x00ba #MASCULINE ORDINAL INDICATOR
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x00ae #REGISTERED SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x00c1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xb6 0x00c2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xb7 0x00c0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xb8 0x00a9 #COPYRIGHT SIGN
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x00a2 #CENT SIGN
+0xbe 0x00a5 #YEN SIGN
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x00e3 #LATIN SMALL LETTER A WITH TILDE
+0xc7 0x00c3 #LATIN CAPITAL LETTER A WITH TILDE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x00a4 #CURRENCY SIGN
+0xd0 0x00f0 #LATIN SMALL LETTER ETH
+0xd1 0x00d0 #LATIN CAPITAL LETTER ETH
+0xd2 0x00ca #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xd3 0x00cb #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xd4 0x00c8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xd5 0x0131 #LATIN SMALL LETTER DOTLESS I
+0xd6 0x00cd #LATIN CAPITAL LETTER I WITH ACUTE
+0xd7 0x00ce #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xd8 0x00cf #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x00a6 #BROKEN BAR
+0xde 0x00cc #LATIN CAPITAL LETTER I WITH GRAVE
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x00d3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x00d4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xe3 0x00d2 #LATIN CAPITAL LETTER O WITH GRAVE
+0xe4 0x00f5 #LATIN SMALL LETTER O WITH TILDE
+0xe5 0x00d5 #LATIN CAPITAL LETTER O WITH TILDE
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x00fe #LATIN SMALL LETTER THORN
+0xe8 0x00de #LATIN CAPITAL LETTER THORN
+0xe9 0x00da #LATIN CAPITAL LETTER U WITH ACUTE
+0xea 0x00db #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xeb 0x00d9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xec 0x00fd #LATIN SMALL LETTER Y WITH ACUTE
+0xed 0x00dd #LATIN CAPITAL LETTER Y WITH ACUTE
+0xee 0x00af #MACRON
+0xef 0x00b4 #ACUTE ACCENT
+0xf0 0x00ad #SOFT HYPHEN
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2017 #DOUBLE LOW LINE
+0xf3 0x00be #VULGAR FRACTION THREE QUARTERS
+0xf4 0x00b6 #PILCROW SIGN
+0xf5 0x00a7 #SECTION SIGN
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x00b8 #CEDILLA
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x00a8 #DIAERESIS
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x00b9 #SUPERSCRIPT ONE
+0xfc 0x00b3 #SUPERSCRIPT THREE
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
diff --git a/rtl/ucmaps/cp852.txt b/rtl/ucmaps/cp852.txt
new file mode 100644
index 0000000000..2f2dabaeb9
--- /dev/null
+++ b/rtl/ucmaps/cp852.txt
@@ -0,0 +1,273 @@
+#
+# Name: cp852_DOSLatin2 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp852_DOSLatin2 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp852_DOSLatin2 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x016f #LATIN SMALL LETTER U WITH RING ABOVE
+0x86 0x0107 #LATIN SMALL LETTER C WITH ACUTE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x0142 #LATIN SMALL LETTER L WITH STROKE
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x0150 #LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+0x8b 0x0151 #LATIN SMALL LETTER O WITH DOUBLE ACUTE
+0x8c 0x00ee #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0x8d 0x0179 #LATIN CAPITAL LETTER Z WITH ACUTE
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x0106 #LATIN CAPITAL LETTER C WITH ACUTE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x0139 #LATIN CAPITAL LETTER L WITH ACUTE
+0x92 0x013a #LATIN SMALL LETTER L WITH ACUTE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x013d #LATIN CAPITAL LETTER L WITH CARON
+0x96 0x013e #LATIN SMALL LETTER L WITH CARON
+0x97 0x015a #LATIN CAPITAL LETTER S WITH ACUTE
+0x98 0x015b #LATIN SMALL LETTER S WITH ACUTE
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x0164 #LATIN CAPITAL LETTER T WITH CARON
+0x9c 0x0165 #LATIN SMALL LETTER T WITH CARON
+0x9d 0x0141 #LATIN CAPITAL LETTER L WITH STROKE
+0x9e 0x00d7 #MULTIPLICATION SIGN
+0x9f 0x010d #LATIN SMALL LETTER C WITH CARON
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x0104 #LATIN CAPITAL LETTER A WITH OGONEK
+0xa5 0x0105 #LATIN SMALL LETTER A WITH OGONEK
+0xa6 0x017d #LATIN CAPITAL LETTER Z WITH CARON
+0xa7 0x017e #LATIN SMALL LETTER Z WITH CARON
+0xa8 0x0118 #LATIN CAPITAL LETTER E WITH OGONEK
+0xa9 0x0119 #LATIN SMALL LETTER E WITH OGONEK
+0xaa 0x00ac #NOT SIGN
+0xab 0x017a #LATIN SMALL LETTER Z WITH ACUTE
+0xac 0x010c #LATIN CAPITAL LETTER C WITH CARON
+0xad 0x015f #LATIN SMALL LETTER S WITH CEDILLA
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x00c1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xb6 0x00c2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xb7 0x011a #LATIN CAPITAL LETTER E WITH CARON
+0xb8 0x015e #LATIN CAPITAL LETTER S WITH CEDILLA
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x017b #LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xbe 0x017c #LATIN SMALL LETTER Z WITH DOT ABOVE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x0102 #LATIN CAPITAL LETTER A WITH BREVE
+0xc7 0x0103 #LATIN SMALL LETTER A WITH BREVE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x00a4 #CURRENCY SIGN
+0xd0 0x0111 #LATIN SMALL LETTER D WITH STROKE
+0xd1 0x0110 #LATIN CAPITAL LETTER D WITH STROKE
+0xd2 0x010e #LATIN CAPITAL LETTER D WITH CARON
+0xd3 0x00cb #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xd4 0x010f #LATIN SMALL LETTER D WITH CARON
+0xd5 0x0147 #LATIN CAPITAL LETTER N WITH CARON
+0xd6 0x00cd #LATIN CAPITAL LETTER I WITH ACUTE
+0xd7 0x00ce #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xd8 0x011b #LATIN SMALL LETTER E WITH CARON
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x0162 #LATIN CAPITAL LETTER T WITH CEDILLA
+0xde 0x016e #LATIN CAPITAL LETTER U WITH RING ABOVE
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x00d3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x00d4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xe3 0x0143 #LATIN CAPITAL LETTER N WITH ACUTE
+0xe4 0x0144 #LATIN SMALL LETTER N WITH ACUTE
+0xe5 0x0148 #LATIN SMALL LETTER N WITH CARON
+0xe6 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0xe7 0x0161 #LATIN SMALL LETTER S WITH CARON
+0xe8 0x0154 #LATIN CAPITAL LETTER R WITH ACUTE
+0xe9 0x00da #LATIN CAPITAL LETTER U WITH ACUTE
+0xea 0x0155 #LATIN SMALL LETTER R WITH ACUTE
+0xeb 0x0170 #LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+0xec 0x00fd #LATIN SMALL LETTER Y WITH ACUTE
+0xed 0x00dd #LATIN CAPITAL LETTER Y WITH ACUTE
+0xee 0x0163 #LATIN SMALL LETTER T WITH CEDILLA
+0xef 0x00b4 #ACUTE ACCENT
+0xf0 0x00ad #SOFT HYPHEN
+0xf1 0x02dd #DOUBLE ACUTE ACCENT
+0xf2 0x02db #OGONEK
+0xf3 0x02c7 #CARON
+0xf4 0x02d8 #BREVE
+0xf5 0x00a7 #SECTION SIGN
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x00b8 #CEDILLA
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x00a8 #DIAERESIS
+0xfa 0x02d9 #DOT ABOVE
+0xfb 0x0171 #LATIN SMALL LETTER U WITH DOUBLE ACUTE
+0xfc 0x0158 #LATIN CAPITAL LETTER R WITH CARON
+0xfd 0x0159 #LATIN SMALL LETTER R WITH CARON
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
diff --git a/rtl/ucmaps/cp855.txt b/rtl/ucmaps/cp855.txt
new file mode 100644
index 0000000000..d43daf039a
--- /dev/null
+++ b/rtl/ucmaps/cp855.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp855_DOSCyrillic to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp855_DOSCyrillic code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp855_DOSCyrillic order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x0452 #CYRILLIC SMALL LETTER DJE
+0x81 0x0402 #CYRILLIC CAPITAL LETTER DJE
+0x82 0x0453 #CYRILLIC SMALL LETTER GJE
+0x83 0x0403 #CYRILLIC CAPITAL LETTER GJE
+0x84 0x0451 #CYRILLIC SMALL LETTER IO
+0x85 0x0401 #CYRILLIC CAPITAL LETTER IO
+0x86 0x0454 #CYRILLIC SMALL LETTER UKRAINIAN IE
+0x87 0x0404 #CYRILLIC CAPITAL LETTER UKRAINIAN IE
+0x88 0x0455 #CYRILLIC SMALL LETTER DZE
+0x89 0x0405 #CYRILLIC CAPITAL LETTER DZE
+0x8a 0x0456 #CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+0x8b 0x0406 #CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
+0x8c 0x0457 #CYRILLIC SMALL LETTER YI
+0x8d 0x0407 #CYRILLIC CAPITAL LETTER YI
+0x8e 0x0458 #CYRILLIC SMALL LETTER JE
+0x8f 0x0408 #CYRILLIC CAPITAL LETTER JE
+0x90 0x0459 #CYRILLIC SMALL LETTER LJE
+0x91 0x0409 #CYRILLIC CAPITAL LETTER LJE
+0x92 0x045a #CYRILLIC SMALL LETTER NJE
+0x93 0x040a #CYRILLIC CAPITAL LETTER NJE
+0x94 0x045b #CYRILLIC SMALL LETTER TSHE
+0x95 0x040b #CYRILLIC CAPITAL LETTER TSHE
+0x96 0x045c #CYRILLIC SMALL LETTER KJE
+0x97 0x040c #CYRILLIC CAPITAL LETTER KJE
+0x98 0x045e #CYRILLIC SMALL LETTER SHORT U
+0x99 0x040e #CYRILLIC CAPITAL LETTER SHORT U
+0x9a 0x045f #CYRILLIC SMALL LETTER DZHE
+0x9b 0x040f #CYRILLIC CAPITAL LETTER DZHE
+0x9c 0x044e #CYRILLIC SMALL LETTER YU
+0x9d 0x042e #CYRILLIC CAPITAL LETTER YU
+0x9e 0x044a #CYRILLIC SMALL LETTER HARD SIGN
+0x9f 0x042a #CYRILLIC CAPITAL LETTER HARD SIGN
+0xa0 0x0430 #CYRILLIC SMALL LETTER A
+0xa1 0x0410 #CYRILLIC CAPITAL LETTER A
+0xa2 0x0431 #CYRILLIC SMALL LETTER BE
+0xa3 0x0411 #CYRILLIC CAPITAL LETTER BE
+0xa4 0x0446 #CYRILLIC SMALL LETTER TSE
+0xa5 0x0426 #CYRILLIC CAPITAL LETTER TSE
+0xa6 0x0434 #CYRILLIC SMALL LETTER DE
+0xa7 0x0414 #CYRILLIC CAPITAL LETTER DE
+0xa8 0x0435 #CYRILLIC SMALL LETTER IE
+0xa9 0x0415 #CYRILLIC CAPITAL LETTER IE
+0xaa 0x0444 #CYRILLIC SMALL LETTER EF
+0xab 0x0424 #CYRILLIC CAPITAL LETTER EF
+0xac 0x0433 #CYRILLIC SMALL LETTER GHE
+0xad 0x0413 #CYRILLIC CAPITAL LETTER GHE
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x0445 #CYRILLIC SMALL LETTER HA
+0xb6 0x0425 #CYRILLIC CAPITAL LETTER HA
+0xb7 0x0438 #CYRILLIC SMALL LETTER I
+0xb8 0x0418 #CYRILLIC CAPITAL LETTER I
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x0439 #CYRILLIC SMALL LETTER SHORT I
+0xbe 0x0419 #CYRILLIC CAPITAL LETTER SHORT I
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x043a #CYRILLIC SMALL LETTER KA
+0xc7 0x041a #CYRILLIC CAPITAL LETTER KA
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x00a4 #CURRENCY SIGN
+0xd0 0x043b #CYRILLIC SMALL LETTER EL
+0xd1 0x041b #CYRILLIC CAPITAL LETTER EL
+0xd2 0x043c #CYRILLIC SMALL LETTER EM
+0xd3 0x041c #CYRILLIC CAPITAL LETTER EM
+0xd4 0x043d #CYRILLIC SMALL LETTER EN
+0xd5 0x041d #CYRILLIC CAPITAL LETTER EN
+0xd6 0x043e #CYRILLIC SMALL LETTER O
+0xd7 0x041e #CYRILLIC CAPITAL LETTER O
+0xd8 0x043f #CYRILLIC SMALL LETTER PE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x041f #CYRILLIC CAPITAL LETTER PE
+0xde 0x044f #CYRILLIC SMALL LETTER YA
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x042f #CYRILLIC CAPITAL LETTER YA
+0xe1 0x0440 #CYRILLIC SMALL LETTER ER
+0xe2 0x0420 #CYRILLIC CAPITAL LETTER ER
+0xe3 0x0441 #CYRILLIC SMALL LETTER ES
+0xe4 0x0421 #CYRILLIC CAPITAL LETTER ES
+0xe5 0x0442 #CYRILLIC SMALL LETTER TE
+0xe6 0x0422 #CYRILLIC CAPITAL LETTER TE
+0xe7 0x0443 #CYRILLIC SMALL LETTER U
+0xe8 0x0423 #CYRILLIC CAPITAL LETTER U
+0xe9 0x0436 #CYRILLIC SMALL LETTER ZHE
+0xea 0x0416 #CYRILLIC CAPITAL LETTER ZHE
+0xeb 0x0432 #CYRILLIC SMALL LETTER VE
+0xec 0x0412 #CYRILLIC CAPITAL LETTER VE
+0xed 0x044c #CYRILLIC SMALL LETTER SOFT SIGN
+0xee 0x042c #CYRILLIC CAPITAL LETTER SOFT SIGN
+0xef 0x2116 #NUMERO SIGN
+0xf0 0x00ad #SOFT HYPHEN
+0xf1 0x044b #CYRILLIC SMALL LETTER YERU
+0xf2 0x042b #CYRILLIC CAPITAL LETTER YERU
+0xf3 0x0437 #CYRILLIC SMALL LETTER ZE
+0xf4 0x0417 #CYRILLIC CAPITAL LETTER ZE
+0xf5 0x0448 #CYRILLIC SMALL LETTER SHA
+0xf6 0x0428 #CYRILLIC CAPITAL LETTER SHA
+0xf7 0x044d #CYRILLIC SMALL LETTER E
+0xf8 0x042d #CYRILLIC CAPITAL LETTER E
+0xf9 0x0449 #CYRILLIC SMALL LETTER SHCHA
+0xfa 0x0429 #CYRILLIC CAPITAL LETTER SHCHA
+0xfb 0x0447 #CYRILLIC SMALL LETTER CHE
+0xfc 0x0427 #CYRILLIC CAPITAL LETTER CHE
+0xfd 0x00a7 #SECTION SIGN
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp856.txt b/rtl/ucmaps/cp856.txt
new file mode 100644
index 0000000000..3a6000bcb7
--- /dev/null
+++ b/rtl/ucmaps/cp856.txt
@@ -0,0 +1,303 @@
+#
+# Name: cp856_Hebrew_PC to Unicode table
+# Unicode version: 3.0
+# Table version: 1.0
+# Table format: Format A
+# Date: 1999 July 27
+# Authors: Ken Whistler (kenw@sybase.com)
+#
+# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved.
+#
+# This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
+# No claims are made as to fitness for any particular purpose. No
+# warranties of any kind are expressed or implied. The recipient
+# agrees to determine applicability of information provided. If this
+# file has been provided on optical media by Unicode, Inc., the sole
+# remedy for any claim will be exchange of defective media within 90
+# days of receipt.
+#
+# Unicode, Inc. hereby grants the right to freely use the information
+# supplied in this file in the creation of products supporting the
+# Unicode Standard, and to make copies of this file in any form for
+# internal or external distribution as long as this notice remains
+# attached.
+#
+# General notes:
+#
+# This table contains the data the Unicode Consortium has on how
+# CP424 characters map into Unicode.
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp856_Hebrew_PC code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp856_Hebrew_PC order
+#
+# Version history
+# 1.0 version new.
+#
+# Updated versions of this file may be found in:
+# <ftp://ftp.unicode.org/Public/MAPPINGS/>
+#
+# Any comments or problems, contact <errata@unicode.org>
+# Please note that <errata@unicode.org> is an archival address;
+# notices will be checked, but do not expect an immediate response.
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x05D0 #HEBREW LETTER ALEF
+0x81 0x05D1 #HEBREW LETTER BET
+0x82 0x05D2 #HEBREW LETTER GIMEL
+0x83 0x05D3 #HEBREW LETTER DALET
+0x84 0x05D4 #HEBREW LETTER HE
+0x85 0x05D5 #HEBREW LETTER VAV
+0x86 0x05D6 #HEBREW LETTER ZAYIN
+0x87 0x05D7 #HEBREW LETTER HET
+0x88 0x05D8 #HEBREW LETTER TET
+0x89 0x05D9 #HEBREW LETTER YOD
+0x8A 0x05DA #HEBREW LETTER FINAL KAF
+0x8B 0x05DB #HEBREW LETTER KAF
+0x8C 0x05DC #HEBREW LETTER LAMED
+0x8D 0x05DD #HEBREW LETTER FINAL MEM
+0x8E 0x05DE #HEBREW LETTER MEM
+0x8F 0x05DF #HEBREW LETTER FINAL NUN
+0x90 0x05E0 #HEBREW LETTER NUN
+0x91 0x05E1 #HEBREW LETTER SAMEKH
+0x92 0x05E2 #HEBREW LETTER AYIN
+0x93 0x05E3 #HEBREW LETTER FINAL PE
+0x94 0x05E4 #HEBREW LETTER PE
+0x95 0x05E5 #HEBREW LETTER FINAL TSADI
+0x96 0x05E6 #HEBREW LETTER TSADI
+0x97 0x05E7 #HEBREW LETTER QOF
+0x98 0x05E8 #HEBREW LETTER RESH
+0x99 0x05E9 #HEBREW LETTER SHIN
+0x9A 0x05EA #HEBREW LETTER TAV
+0x9B #UNDEFINED
+0x9C 0x00A3 #POUND SIGN
+0x9D #UNDEFINED
+0x9E 0x00D7 #MULTIPLICATION SIGN
+0x9F #UNDEFINED
+0xA0 #UNDEFINED
+0xA1 #UNDEFINED
+0xA2 #UNDEFINED
+0xA3 #UNDEFINED
+0xA4 #UNDEFINED
+0xA5 #UNDEFINED
+0xA6 #UNDEFINED
+0xA7 #UNDEFINED
+0xA8 #UNDEFINED
+0xA9 0x00AE #REGISTERED SIGN
+0xAA 0x00AC #NOT SIGN
+0xAB 0x00BD #VULGAR FRACTION ONE HALF
+0xAC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xAD #UNDEFINED
+0xAE 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAF 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xB0 0x2591 #LIGHT SHADE
+0xB1 0x2592 #MEDIUM SHADE
+0xB2 0x2593 #DARK SHADE
+0xB3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xB4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xB5 #UNDEFINED
+0xB6 #UNDEFINED
+0xB7 #UNDEFINED
+0xB8 0x00A9 #COPYRIGHT SIGN
+0xB9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xBA 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xBB 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xBC 0x255D #BOX DRAWINGS DOUBLE UP AND LEFT
+0xBD 0x00A2 #CENT SIGN
+0xBE 0x00A5 #YEN SIGN
+0xBF 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xC0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xC1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xC2 0x252C #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xC3 0x251C #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xC4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xC5 0x253C #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xC6 #UNDEFINED
+0xC7 #UNDEFINED
+0xC8 0x255A #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xC9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xCA 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xCB 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xCC 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xCD 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xCE 0x256C #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xCF 0x00A4 #CURRENCY SIGN
+0xD0 #UNDEFINED
+0xD1 #UNDEFINED
+0xD2 #UNDEFINED
+0xD3 #UNDEFINEDS
+0xD4 #UNDEFINED
+0xD5 #UNDEFINED
+0xD6 #UNDEFINEDE
+0xD7 #UNDEFINED
+0xD8 #UNDEFINED
+0xD9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xDA 0x250C #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xDB 0x2588 #FULL BLOCK
+0xDC 0x2584 #LOWER HALF BLOCK
+0xDD 0x00A6 #BROKEN BAR
+0xDE #UNDEFINED
+0xDF 0x2580 #UPPER HALF BLOCK
+0xE0 #UNDEFINED
+0xE1 #UNDEFINED
+0xE2 #UNDEFINED
+0xE3 #UNDEFINED
+0xE4 #UNDEFINED
+0xE5 #UNDEFINED
+0xE6 0x00B5 #MICRO SIGN
+0xE7 #UNDEFINED
+0xE8 #UNDEFINED
+0xE9 #UNDEFINED
+0xEA #UNDEFINED
+0xEB #UNDEFINED
+0xEC #UNDEFINED
+0xED #UNDEFINED
+0xEE 0x00AF #MACRON
+0xEF 0x00B4 #ACUTE ACCENT
+0xF0 0x00AD #SOFT HYPHEN
+0xF1 0x00B1 #PLUS-MINUS SIGN
+0xF2 0x2017 #DOUBLE LOW LINE
+0xF3 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xF4 0x00B6 #PILCROW SIGN
+0xF5 0x00A7 #SECTION SIGN
+0xF6 0x00F7 #DIVISION SIGN
+0xF7 0x00B8 #CEDILLA
+0xF8 0x00B0 #DEGREE SIGN
+0xF9 0x00A8 #DIAERESIS
+0xFA 0x00B7 #MIDDLE DOT
+0xFB 0x00B9 #SUPERSCRIPT ONE
+0xFC 0x00B3 #SUPERSCRIPT THREE
+0xFD 0x00B2 #SUPERSCRIPT TWO
+0xFE 0x25A0 #BLACK SQUARE
+0xFF 0x00A0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp857.txt b/rtl/ucmaps/cp857.txt
new file mode 100644
index 0000000000..3059383960
--- /dev/null
+++ b/rtl/ucmaps/cp857.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp857_DOSTurkish to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp857_DOSTurkish code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp857_DOSTurkish order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00e5 #LATIN SMALL LETTER A WITH RING ABOVE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00ef #LATIN SMALL LETTER I WITH DIAERESIS
+0x8c 0x00ee #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0x8d 0x0131 #LATIN SMALL LETTER DOTLESS I
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x00c5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00e6 #LATIN SMALL LIGATURE AE
+0x92 0x00c6 #LATIN CAPITAL LIGATURE AE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x00f2 #LATIN SMALL LETTER O WITH GRAVE
+0x96 0x00fb #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0x97 0x00f9 #LATIN SMALL LETTER U WITH GRAVE
+0x98 0x0130 #LATIN CAPITAL LETTER I WITH DOT ABOVE
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00f8 #LATIN SMALL LETTER O WITH STROKE
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d8 #LATIN CAPITAL LETTER O WITH STROKE
+0x9e 0x015e #LATIN CAPITAL LETTER S WITH CEDILLA
+0x9f 0x015f #LATIN SMALL LETTER S WITH CEDILLA
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00f1 #LATIN SMALL LETTER N WITH TILDE
+0xa5 0x00d1 #LATIN CAPITAL LETTER N WITH TILDE
+0xa6 0x011e #LATIN CAPITAL LETTER G WITH BREVE
+0xa7 0x011f #LATIN SMALL LETTER G WITH BREVE
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x00ae #REGISTERED SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x00c1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xb6 0x00c2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xb7 0x00c0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xb8 0x00a9 #COPYRIGHT SIGN
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x00a2 #CENT SIGN
+0xbe 0x00a5 #YEN SIGN
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x00e3 #LATIN SMALL LETTER A WITH TILDE
+0xc7 0x00c3 #LATIN CAPITAL LETTER A WITH TILDE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x00a4 #CURRENCY SIGN
+0xd0 0x00ba #MASCULINE ORDINAL INDICATOR
+0xd1 0x00aa #FEMININE ORDINAL INDICATOR
+0xd2 0x00ca #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xd3 0x00cb #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xd4 0x00c8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xd5 #UNDEFINED
+0xd6 0x00cd #LATIN CAPITAL LETTER I WITH ACUTE
+0xd7 0x00ce #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xd8 0x00cf #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x00a6 #BROKEN BAR
+0xde 0x00cc #LATIN CAPITAL LETTER I WITH GRAVE
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x00d3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x00d4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xe3 0x00d2 #LATIN CAPITAL LETTER O WITH GRAVE
+0xe4 0x00f5 #LATIN SMALL LETTER O WITH TILDE
+0xe5 0x00d5 #LATIN CAPITAL LETTER O WITH TILDE
+0xe6 0x00b5 #MICRO SIGN
+0xe7 #UNDEFINED
+0xe8 0x00d7 #MULTIPLICATION SIGN
+0xe9 0x00da #LATIN CAPITAL LETTER U WITH ACUTE
+0xea 0x00db #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xeb 0x00d9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xec 0x00ec #LATIN SMALL LETTER I WITH GRAVE
+0xed 0x00ff #LATIN SMALL LETTER Y WITH DIAERESIS
+0xee 0x00af #MACRON
+0xef 0x00b4 #ACUTE ACCENT
+0xf0 0x00ad #SOFT HYPHEN
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 #UNDEFINED
+0xf3 0x00be #VULGAR FRACTION THREE QUARTERS
+0xf4 0x00b6 #PILCROW SIGN
+0xf5 0x00a7 #SECTION SIGN
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x00b8 #CEDILLA
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x00a8 #DIAERESIS
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x00b9 #SUPERSCRIPT ONE
+0xfc 0x00b3 #SUPERSCRIPT THREE
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp860.txt b/rtl/ucmaps/cp860.txt
new file mode 100644
index 0000000000..d7f2cb7374
--- /dev/null
+++ b/rtl/ucmaps/cp860.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp860_DOSPortuguese to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp860_DOSPortuguese code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp860_DOSPortuguese order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e3 #LATIN SMALL LETTER A WITH TILDE
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00c1 #LATIN CAPITAL LETTER A WITH ACUTE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00ca #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00cd #LATIN CAPITAL LETTER I WITH ACUTE
+0x8c 0x00d4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0x8d 0x00ec #LATIN SMALL LETTER I WITH GRAVE
+0x8e 0x00c3 #LATIN CAPITAL LETTER A WITH TILDE
+0x8f 0x00c2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00c0 #LATIN CAPITAL LETTER A WITH GRAVE
+0x92 0x00c8 #LATIN CAPITAL LETTER E WITH GRAVE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f5 #LATIN SMALL LETTER O WITH TILDE
+0x95 0x00f2 #LATIN SMALL LETTER O WITH GRAVE
+0x96 0x00da #LATIN CAPITAL LETTER U WITH ACUTE
+0x97 0x00f9 #LATIN SMALL LETTER U WITH GRAVE
+0x98 0x00cc #LATIN CAPITAL LETTER I WITH GRAVE
+0x99 0x00d5 #LATIN CAPITAL LETTER O WITH TILDE
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00a2 #CENT SIGN
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d9 #LATIN CAPITAL LETTER U WITH GRAVE
+0x9e 0x20a7 #PESETA SIGN
+0x9f 0x00d3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00f1 #LATIN SMALL LETTER N WITH TILDE
+0xa5 0x00d1 #LATIN CAPITAL LETTER N WITH TILDE
+0xa6 0x00aa #FEMININE ORDINAL INDICATOR
+0xa7 0x00ba #MASCULINE ORDINAL INDICATOR
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x00d2 #LATIN CAPITAL LETTER O WITH GRAVE
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b1 #GREEK SMALL LETTER ALPHA
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xe3 0x03c0 #GREEK SMALL LETTER PI
+0xe4 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xe5 0x03c3 #GREEK SMALL LETTER SIGMA
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x03c4 #GREEK SMALL LETTER TAU
+0xe8 0x03a6 #GREEK CAPITAL LETTER PHI
+0xe9 0x0398 #GREEK CAPITAL LETTER THETA
+0xea 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xeb 0x03b4 #GREEK SMALL LETTER DELTA
+0xec 0x221e #INFINITY
+0xed 0x03c6 #GREEK SMALL LETTER PHI
+0xee 0x03b5 #GREEK SMALL LETTER EPSILON
+0xef 0x2229 #INTERSECTION
+0xf0 0x2261 #IDENTICAL TO
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x2320 #TOP HALF INTEGRAL
+0xf5 0x2321 #BOTTOM HALF INTEGRAL
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp861.txt b/rtl/ucmaps/cp861.txt
new file mode 100644
index 0000000000..fe0f02bb51
--- /dev/null
+++ b/rtl/ucmaps/cp861.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp861_DOSIcelandic to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp861_DOSIcelandic code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp861_DOSIcelandic order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00e5 #LATIN SMALL LETTER A WITH RING ABOVE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00d0 #LATIN CAPITAL LETTER ETH
+0x8c 0x00f0 #LATIN SMALL LETTER ETH
+0x8d 0x00de #LATIN CAPITAL LETTER THORN
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x00c5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00e6 #LATIN SMALL LIGATURE AE
+0x92 0x00c6 #LATIN CAPITAL LIGATURE AE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x00fe #LATIN SMALL LETTER THORN
+0x96 0x00fb #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0x97 0x00dd #LATIN CAPITAL LETTER Y WITH ACUTE
+0x98 0x00fd #LATIN SMALL LETTER Y WITH ACUTE
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00f8 #LATIN SMALL LETTER O WITH STROKE
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d8 #LATIN CAPITAL LETTER O WITH STROKE
+0x9e 0x20a7 #PESETA SIGN
+0x9f 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00c1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xa5 0x00cd #LATIN CAPITAL LETTER I WITH ACUTE
+0xa6 0x00d3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xa7 0x00da #LATIN CAPITAL LETTER U WITH ACUTE
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x2310 #REVERSED NOT SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b1 #GREEK SMALL LETTER ALPHA
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xe3 0x03c0 #GREEK SMALL LETTER PI
+0xe4 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xe5 0x03c3 #GREEK SMALL LETTER SIGMA
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x03c4 #GREEK SMALL LETTER TAU
+0xe8 0x03a6 #GREEK CAPITAL LETTER PHI
+0xe9 0x0398 #GREEK CAPITAL LETTER THETA
+0xea 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xeb 0x03b4 #GREEK SMALL LETTER DELTA
+0xec 0x221e #INFINITY
+0xed 0x03c6 #GREEK SMALL LETTER PHI
+0xee 0x03b5 #GREEK SMALL LETTER EPSILON
+0xef 0x2229 #INTERSECTION
+0xf0 0x2261 #IDENTICAL TO
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x2320 #TOP HALF INTEGRAL
+0xf5 0x2321 #BOTTOM HALF INTEGRAL
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp862.txt b/rtl/ucmaps/cp862.txt
new file mode 100644
index 0000000000..963110518a
--- /dev/null
+++ b/rtl/ucmaps/cp862.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp862_DOSHebrew to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp862_DOSHebrew code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp862_DOSHebrew order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x05d0 #HEBREW LETTER ALEF
+0x81 0x05d1 #HEBREW LETTER BET
+0x82 0x05d2 #HEBREW LETTER GIMEL
+0x83 0x05d3 #HEBREW LETTER DALET
+0x84 0x05d4 #HEBREW LETTER HE
+0x85 0x05d5 #HEBREW LETTER VAV
+0x86 0x05d6 #HEBREW LETTER ZAYIN
+0x87 0x05d7 #HEBREW LETTER HET
+0x88 0x05d8 #HEBREW LETTER TET
+0x89 0x05d9 #HEBREW LETTER YOD
+0x8a 0x05da #HEBREW LETTER FINAL KAF
+0x8b 0x05db #HEBREW LETTER KAF
+0x8c 0x05dc #HEBREW LETTER LAMED
+0x8d 0x05dd #HEBREW LETTER FINAL MEM
+0x8e 0x05de #HEBREW LETTER MEM
+0x8f 0x05df #HEBREW LETTER FINAL NUN
+0x90 0x05e0 #HEBREW LETTER NUN
+0x91 0x05e1 #HEBREW LETTER SAMEKH
+0x92 0x05e2 #HEBREW LETTER AYIN
+0x93 0x05e3 #HEBREW LETTER FINAL PE
+0x94 0x05e4 #HEBREW LETTER PE
+0x95 0x05e5 #HEBREW LETTER FINAL TSADI
+0x96 0x05e6 #HEBREW LETTER TSADI
+0x97 0x05e7 #HEBREW LETTER QOF
+0x98 0x05e8 #HEBREW LETTER RESH
+0x99 0x05e9 #HEBREW LETTER SHIN
+0x9a 0x05ea #HEBREW LETTER TAV
+0x9b 0x00a2 #CENT SIGN
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00a5 #YEN SIGN
+0x9e 0x20a7 #PESETA SIGN
+0x9f 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00f1 #LATIN SMALL LETTER N WITH TILDE
+0xa5 0x00d1 #LATIN CAPITAL LETTER N WITH TILDE
+0xa6 0x00aa #FEMININE ORDINAL INDICATOR
+0xa7 0x00ba #MASCULINE ORDINAL INDICATOR
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x2310 #REVERSED NOT SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b1 #GREEK SMALL LETTER ALPHA
+0xe1 0x00df #LATIN SMALL LETTER SHARP S (GERMAN)
+0xe2 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xe3 0x03c0 #GREEK SMALL LETTER PI
+0xe4 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xe5 0x03c3 #GREEK SMALL LETTER SIGMA
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x03c4 #GREEK SMALL LETTER TAU
+0xe8 0x03a6 #GREEK CAPITAL LETTER PHI
+0xe9 0x0398 #GREEK CAPITAL LETTER THETA
+0xea 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xeb 0x03b4 #GREEK SMALL LETTER DELTA
+0xec 0x221e #INFINITY
+0xed 0x03c6 #GREEK SMALL LETTER PHI
+0xee 0x03b5 #GREEK SMALL LETTER EPSILON
+0xef 0x2229 #INTERSECTION
+0xf0 0x2261 #IDENTICAL TO
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x2320 #TOP HALF INTEGRAL
+0xf5 0x2321 #BOTTOM HALF INTEGRAL
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp863.txt b/rtl/ucmaps/cp863.txt
new file mode 100644
index 0000000000..cc4eae1863
--- /dev/null
+++ b/rtl/ucmaps/cp863.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp863_DOSCanadaF to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp863_DOSCanadaF code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp863_DOSCanadaF order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00c2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00b6 #PILCROW SIGN
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00ef #LATIN SMALL LETTER I WITH DIAERESIS
+0x8c 0x00ee #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0x8d 0x2017 #DOUBLE LOW LINE
+0x8e 0x00c0 #LATIN CAPITAL LETTER A WITH GRAVE
+0x8f 0x00a7 #SECTION SIGN
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00c8 #LATIN CAPITAL LETTER E WITH GRAVE
+0x92 0x00ca #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00cb #LATIN CAPITAL LETTER E WITH DIAERESIS
+0x95 0x00cf #LATIN CAPITAL LETTER I WITH DIAERESIS
+0x96 0x00fb #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0x97 0x00f9 #LATIN SMALL LETTER U WITH GRAVE
+0x98 0x00a4 #CURRENCY SIGN
+0x99 0x00d4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00a2 #CENT SIGN
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d9 #LATIN CAPITAL LETTER U WITH GRAVE
+0x9e 0x00db #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0x9f 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0xa0 0x00a6 #BROKEN BAR
+0xa1 0x00b4 #ACUTE ACCENT
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00a8 #DIAERESIS
+0xa5 0x00b8 #CEDILLA
+0xa6 0x00b3 #SUPERSCRIPT THREE
+0xa7 0x00af #MACRON
+0xa8 0x00ce #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xa9 0x2310 #REVERSED NOT SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00be #VULGAR FRACTION THREE QUARTERS
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b1 #GREEK SMALL LETTER ALPHA
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xe3 0x03c0 #GREEK SMALL LETTER PI
+0xe4 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xe5 0x03c3 #GREEK SMALL LETTER SIGMA
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x03c4 #GREEK SMALL LETTER TAU
+0xe8 0x03a6 #GREEK CAPITAL LETTER PHI
+0xe9 0x0398 #GREEK CAPITAL LETTER THETA
+0xea 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xeb 0x03b4 #GREEK SMALL LETTER DELTA
+0xec 0x221e #INFINITY
+0xed 0x03c6 #GREEK SMALL LETTER PHI
+0xee 0x03b5 #GREEK SMALL LETTER EPSILON
+0xef 0x2229 #INTERSECTION
+0xf0 0x2261 #IDENTICAL TO
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x2320 #TOP HALF INTEGRAL
+0xf5 0x2321 #BOTTOM HALF INTEGRAL
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp864.txt b/rtl/ucmaps/cp864.txt
new file mode 100644
index 0000000000..7aa055fbaf
--- /dev/null
+++ b/rtl/ucmaps/cp864.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp864_DOSArabic to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp864_DOSArabic code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp864_DOSArabic order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x066a #ARABIC PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00b0 #DEGREE SIGN
+0x81 0x00b7 #MIDDLE DOT
+0x82 0x2219 #BULLET OPERATOR
+0x83 0x221a #SQUARE ROOT
+0x84 0x2592 #MEDIUM SHADE
+0x85 0x2500 #FORMS LIGHT HORIZONTAL
+0x86 0x2502 #FORMS LIGHT VERTICAL
+0x87 0x253c #FORMS LIGHT VERTICAL AND HORIZONTAL
+0x88 0x2524 #FORMS LIGHT VERTICAL AND LEFT
+0x89 0x252c #FORMS LIGHT DOWN AND HORIZONTAL
+0x8a 0x251c #FORMS LIGHT VERTICAL AND RIGHT
+0x8b 0x2534 #FORMS LIGHT UP AND HORIZONTAL
+0x8c 0x2510 #FORMS LIGHT DOWN AND LEFT
+0x8d 0x250c #FORMS LIGHT DOWN AND RIGHT
+0x8e 0x2514 #FORMS LIGHT UP AND RIGHT
+0x8f 0x2518 #FORMS LIGHT UP AND LEFT
+0x90 0x03b2 #GREEK SMALL BETA
+0x91 0x221e #INFINITY
+0x92 0x03c6 #GREEK SMALL PHI
+0x93 0x00b1 #PLUS-OR-MINUS SIGN
+0x94 0x00bd #FRACTION 1/2
+0x95 0x00bc #FRACTION 1/4
+0x96 0x2248 #ALMOST EQUAL TO
+0x97 0x00ab #LEFT POINTING GUILLEMET
+0x98 0x00bb #RIGHT POINTING GUILLEMET
+0x99 0xfef7 #ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE ISOLATED FORM
+0x9a 0xfef8 #ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE FINAL FORM
+0x9b #UNDEFINED
+0x9c #UNDEFINED
+0x9d 0xfefb #ARABIC LIGATURE LAM WITH ALEF ISOLATED FORM
+0x9e 0xfefc #ARABIC LIGATURE LAM WITH ALEF FINAL FORM
+0x9f #UNDEFINED
+0xa0 0x00a0 #NON-BREAKING SPACE
+0xa1 0x00ad #SOFT HYPHEN
+0xa2 0xfe82 #ARABIC LETTER ALEF WITH MADDA ABOVE FINAL FORM
+0xa3 0x00a3 #POUND SIGN
+0xa4 0x00a4 #CURRENCY SIGN
+0xa5 0xfe84 #ARABIC LETTER ALEF WITH HAMZA ABOVE FINAL FORM
+0xa6 #UNDEFINED
+0xa7 #UNDEFINED
+0xa8 0xfe8e #ARABIC LETTER ALEF FINAL FORM
+0xa9 0xfe8f #ARABIC LETTER BEH ISOLATED FORM
+0xaa 0xfe95 #ARABIC LETTER TEH ISOLATED FORM
+0xab 0xfe99 #ARABIC LETTER THEH ISOLATED FORM
+0xac 0x060c #ARABIC COMMA
+0xad 0xfe9d #ARABIC LETTER JEEM ISOLATED FORM
+0xae 0xfea1 #ARABIC LETTER HAH ISOLATED FORM
+0xaf 0xfea5 #ARABIC LETTER KHAH ISOLATED FORM
+0xb0 0x0660 #ARABIC-INDIC DIGIT ZERO
+0xb1 0x0661 #ARABIC-INDIC DIGIT ONE
+0xb2 0x0662 #ARABIC-INDIC DIGIT TWO
+0xb3 0x0663 #ARABIC-INDIC DIGIT THREE
+0xb4 0x0664 #ARABIC-INDIC DIGIT FOUR
+0xb5 0x0665 #ARABIC-INDIC DIGIT FIVE
+0xb6 0x0666 #ARABIC-INDIC DIGIT SIX
+0xb7 0x0667 #ARABIC-INDIC DIGIT SEVEN
+0xb8 0x0668 #ARABIC-INDIC DIGIT EIGHT
+0xb9 0x0669 #ARABIC-INDIC DIGIT NINE
+0xba 0xfed1 #ARABIC LETTER FEH ISOLATED FORM
+0xbb 0x061b #ARABIC SEMICOLON
+0xbc 0xfeb1 #ARABIC LETTER SEEN ISOLATED FORM
+0xbd 0xfeb5 #ARABIC LETTER SHEEN ISOLATED FORM
+0xbe 0xfeb9 #ARABIC LETTER SAD ISOLATED FORM
+0xbf 0x061f #ARABIC QUESTION MARK
+0xc0 0x00a2 #CENT SIGN
+0xc1 0xfe80 #ARABIC LETTER HAMZA ISOLATED FORM
+0xc2 0xfe81 #ARABIC LETTER ALEF WITH MADDA ABOVE ISOLATED FORM
+0xc3 0xfe83 #ARABIC LETTER ALEF WITH HAMZA ABOVE ISOLATED FORM
+0xc4 0xfe85 #ARABIC LETTER WAW WITH HAMZA ABOVE ISOLATED FORM
+0xc5 0xfeca #ARABIC LETTER AIN FINAL FORM
+0xc6 0xfe8b #ARABIC LETTER YEH WITH HAMZA ABOVE INITIAL FORM
+0xc7 0xfe8d #ARABIC LETTER ALEF ISOLATED FORM
+0xc8 0xfe91 #ARABIC LETTER BEH INITIAL FORM
+0xc9 0xfe93 #ARABIC LETTER TEH MARBUTA ISOLATED FORM
+0xca 0xfe97 #ARABIC LETTER TEH INITIAL FORM
+0xcb 0xfe9b #ARABIC LETTER THEH INITIAL FORM
+0xcc 0xfe9f #ARABIC LETTER JEEM INITIAL FORM
+0xcd 0xfea3 #ARABIC LETTER HAH INITIAL FORM
+0xce 0xfea7 #ARABIC LETTER KHAH INITIAL FORM
+0xcf 0xfea9 #ARABIC LETTER DAL ISOLATED FORM
+0xd0 0xfeab #ARABIC LETTER THAL ISOLATED FORM
+0xd1 0xfead #ARABIC LETTER REH ISOLATED FORM
+0xd2 0xfeaf #ARABIC LETTER ZAIN ISOLATED FORM
+0xd3 0xfeb3 #ARABIC LETTER SEEN INITIAL FORM
+0xd4 0xfeb7 #ARABIC LETTER SHEEN INITIAL FORM
+0xd5 0xfebb #ARABIC LETTER SAD INITIAL FORM
+0xd6 0xfebf #ARABIC LETTER DAD INITIAL FORM
+0xd7 0xfec1 #ARABIC LETTER TAH ISOLATED FORM
+0xd8 0xfec5 #ARABIC LETTER ZAH ISOLATED FORM
+0xd9 0xfecb #ARABIC LETTER AIN INITIAL FORM
+0xda 0xfecf #ARABIC LETTER GHAIN INITIAL FORM
+0xdb 0x00a6 #BROKEN VERTICAL BAR
+0xdc 0x00ac #NOT SIGN
+0xdd 0x00f7 #DIVISION SIGN
+0xde 0x00d7 #MULTIPLICATION SIGN
+0xdf 0xfec9 #ARABIC LETTER AIN ISOLATED FORM
+0xe0 0x0640 #ARABIC TATWEEL
+0xe1 0xfed3 #ARABIC LETTER FEH INITIAL FORM
+0xe2 0xfed7 #ARABIC LETTER QAF INITIAL FORM
+0xe3 0xfedb #ARABIC LETTER KAF INITIAL FORM
+0xe4 0xfedf #ARABIC LETTER LAM INITIAL FORM
+0xe5 0xfee3 #ARABIC LETTER MEEM INITIAL FORM
+0xe6 0xfee7 #ARABIC LETTER NOON INITIAL FORM
+0xe7 0xfeeb #ARABIC LETTER HEH INITIAL FORM
+0xe8 0xfeed #ARABIC LETTER WAW ISOLATED FORM
+0xe9 0xfeef #ARABIC LETTER ALEF MAKSURA ISOLATED FORM
+0xea 0xfef3 #ARABIC LETTER YEH INITIAL FORM
+0xeb 0xfebd #ARABIC LETTER DAD ISOLATED FORM
+0xec 0xfecc #ARABIC LETTER AIN MEDIAL FORM
+0xed 0xfece #ARABIC LETTER GHAIN FINAL FORM
+0xee 0xfecd #ARABIC LETTER GHAIN ISOLATED FORM
+0xef 0xfee1 #ARABIC LETTER MEEM ISOLATED FORM
+0xf0 0xfe7d #ARABIC SHADDA MEDIAL FORM
+0xf1 0x0651 #ARABIC SHADDAH
+0xf2 0xfee5 #ARABIC LETTER NOON ISOLATED FORM
+0xf3 0xfee9 #ARABIC LETTER HEH ISOLATED FORM
+0xf4 0xfeec #ARABIC LETTER HEH MEDIAL FORM
+0xf5 0xfef0 #ARABIC LETTER ALEF MAKSURA FINAL FORM
+0xf6 0xfef2 #ARABIC LETTER YEH FINAL FORM
+0xf7 0xfed0 #ARABIC LETTER GHAIN MEDIAL FORM
+0xf8 0xfed5 #ARABIC LETTER QAF ISOLATED FORM
+0xf9 0xfef5 #ARABIC LIGATURE LAM WITH ALEF WITH MADDA ABOVE ISOLATED FORM
+0xfa 0xfef6 #ARABIC LIGATURE LAM WITH ALEF WITH MADDA ABOVE FINAL FORM
+0xfb 0xfedd #ARABIC LETTER LAM ISOLATED FORM
+0xfc 0xfed9 #ARABIC LETTER KAF ISOLATED FORM
+0xfd 0xfef1 #ARABIC LETTER YEH ISOLATED FORM
+0xfe 0x25a0 #BLACK SQUARE
+0xff #UNDEFINED
+
diff --git a/rtl/ucmaps/cp865.txt b/rtl/ucmaps/cp865.txt
new file mode 100644
index 0000000000..67705f46af
--- /dev/null
+++ b/rtl/ucmaps/cp865.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp865_DOSNordic to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp865_DOSNordic code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp865_DOSNordic order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x00c7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0x81 0x00fc #LATIN SMALL LETTER U WITH DIAERESIS
+0x82 0x00e9 #LATIN SMALL LETTER E WITH ACUTE
+0x83 0x00e2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0x84 0x00e4 #LATIN SMALL LETTER A WITH DIAERESIS
+0x85 0x00e0 #LATIN SMALL LETTER A WITH GRAVE
+0x86 0x00e5 #LATIN SMALL LETTER A WITH RING ABOVE
+0x87 0x00e7 #LATIN SMALL LETTER C WITH CEDILLA
+0x88 0x00ea #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0x89 0x00eb #LATIN SMALL LETTER E WITH DIAERESIS
+0x8a 0x00e8 #LATIN SMALL LETTER E WITH GRAVE
+0x8b 0x00ef #LATIN SMALL LETTER I WITH DIAERESIS
+0x8c 0x00ee #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0x8d 0x00ec #LATIN SMALL LETTER I WITH GRAVE
+0x8e 0x00c4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0x8f 0x00c5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0x90 0x00c9 #LATIN CAPITAL LETTER E WITH ACUTE
+0x91 0x00e6 #LATIN SMALL LIGATURE AE
+0x92 0x00c6 #LATIN CAPITAL LIGATURE AE
+0x93 0x00f4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0x94 0x00f6 #LATIN SMALL LETTER O WITH DIAERESIS
+0x95 0x00f2 #LATIN SMALL LETTER O WITH GRAVE
+0x96 0x00fb #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0x97 0x00f9 #LATIN SMALL LETTER U WITH GRAVE
+0x98 0x00ff #LATIN SMALL LETTER Y WITH DIAERESIS
+0x99 0x00d6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0x9a 0x00dc #LATIN CAPITAL LETTER U WITH DIAERESIS
+0x9b 0x00f8 #LATIN SMALL LETTER O WITH STROKE
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x00d8 #LATIN CAPITAL LETTER O WITH STROKE
+0x9e 0x20a7 #PESETA SIGN
+0x9f 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0xa0 0x00e1 #LATIN SMALL LETTER A WITH ACUTE
+0xa1 0x00ed #LATIN SMALL LETTER I WITH ACUTE
+0xa2 0x00f3 #LATIN SMALL LETTER O WITH ACUTE
+0xa3 0x00fa #LATIN SMALL LETTER U WITH ACUTE
+0xa4 0x00f1 #LATIN SMALL LETTER N WITH TILDE
+0xa5 0x00d1 #LATIN CAPITAL LETTER N WITH TILDE
+0xa6 0x00aa #FEMININE ORDINAL INDICATOR
+0xa7 0x00ba #MASCULINE ORDINAL INDICATOR
+0xa8 0x00bf #INVERTED QUESTION MARK
+0xa9 0x2310 #REVERSED NOT SIGN
+0xaa 0x00ac #NOT SIGN
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x00bc #VULGAR FRACTION ONE QUARTER
+0xad 0x00a1 #INVERTED EXCLAMATION MARK
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00a4 #CURRENCY SIGN
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b1 #GREEK SMALL LETTER ALPHA
+0xe1 0x00df #LATIN SMALL LETTER SHARP S
+0xe2 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xe3 0x03c0 #GREEK SMALL LETTER PI
+0xe4 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xe5 0x03c3 #GREEK SMALL LETTER SIGMA
+0xe6 0x00b5 #MICRO SIGN
+0xe7 0x03c4 #GREEK SMALL LETTER TAU
+0xe8 0x03a6 #GREEK CAPITAL LETTER PHI
+0xe9 0x0398 #GREEK CAPITAL LETTER THETA
+0xea 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xeb 0x03b4 #GREEK SMALL LETTER DELTA
+0xec 0x221e #INFINITY
+0xed 0x03c6 #GREEK SMALL LETTER PHI
+0xee 0x03b5 #GREEK SMALL LETTER EPSILON
+0xef 0x2229 #INTERSECTION
+0xf0 0x2261 #IDENTICAL TO
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x2265 #GREATER-THAN OR EQUAL TO
+0xf3 0x2264 #LESS-THAN OR EQUAL TO
+0xf4 0x2320 #TOP HALF INTEGRAL
+0xf5 0x2321 #BOTTOM HALF INTEGRAL
+0xf6 0x00f7 #DIVISION SIGN
+0xf7 0x2248 #ALMOST EQUAL TO
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x207f #SUPERSCRIPT LATIN SMALL LETTER N
+0xfd 0x00b2 #SUPERSCRIPT TWO
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp866.txt b/rtl/ucmaps/cp866.txt
new file mode 100644
index 0000000000..880fb70e36
--- /dev/null
+++ b/rtl/ucmaps/cp866.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp866_DOSCyrillicRussian to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp866_DOSCyrillicRussian code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp866_DOSCyrillicRussian order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 0x0410 #CYRILLIC CAPITAL LETTER A
+0x81 0x0411 #CYRILLIC CAPITAL LETTER BE
+0x82 0x0412 #CYRILLIC CAPITAL LETTER VE
+0x83 0x0413 #CYRILLIC CAPITAL LETTER GHE
+0x84 0x0414 #CYRILLIC CAPITAL LETTER DE
+0x85 0x0415 #CYRILLIC CAPITAL LETTER IE
+0x86 0x0416 #CYRILLIC CAPITAL LETTER ZHE
+0x87 0x0417 #CYRILLIC CAPITAL LETTER ZE
+0x88 0x0418 #CYRILLIC CAPITAL LETTER I
+0x89 0x0419 #CYRILLIC CAPITAL LETTER SHORT I
+0x8a 0x041a #CYRILLIC CAPITAL LETTER KA
+0x8b 0x041b #CYRILLIC CAPITAL LETTER EL
+0x8c 0x041c #CYRILLIC CAPITAL LETTER EM
+0x8d 0x041d #CYRILLIC CAPITAL LETTER EN
+0x8e 0x041e #CYRILLIC CAPITAL LETTER O
+0x8f 0x041f #CYRILLIC CAPITAL LETTER PE
+0x90 0x0420 #CYRILLIC CAPITAL LETTER ER
+0x91 0x0421 #CYRILLIC CAPITAL LETTER ES
+0x92 0x0422 #CYRILLIC CAPITAL LETTER TE
+0x93 0x0423 #CYRILLIC CAPITAL LETTER U
+0x94 0x0424 #CYRILLIC CAPITAL LETTER EF
+0x95 0x0425 #CYRILLIC CAPITAL LETTER HA
+0x96 0x0426 #CYRILLIC CAPITAL LETTER TSE
+0x97 0x0427 #CYRILLIC CAPITAL LETTER CHE
+0x98 0x0428 #CYRILLIC CAPITAL LETTER SHA
+0x99 0x0429 #CYRILLIC CAPITAL LETTER SHCHA
+0x9a 0x042a #CYRILLIC CAPITAL LETTER HARD SIGN
+0x9b 0x042b #CYRILLIC CAPITAL LETTER YERU
+0x9c 0x042c #CYRILLIC CAPITAL LETTER SOFT SIGN
+0x9d 0x042d #CYRILLIC CAPITAL LETTER E
+0x9e 0x042e #CYRILLIC CAPITAL LETTER YU
+0x9f 0x042f #CYRILLIC CAPITAL LETTER YA
+0xa0 0x0430 #CYRILLIC SMALL LETTER A
+0xa1 0x0431 #CYRILLIC SMALL LETTER BE
+0xa2 0x0432 #CYRILLIC SMALL LETTER VE
+0xa3 0x0433 #CYRILLIC SMALL LETTER GHE
+0xa4 0x0434 #CYRILLIC SMALL LETTER DE
+0xa5 0x0435 #CYRILLIC SMALL LETTER IE
+0xa6 0x0436 #CYRILLIC SMALL LETTER ZHE
+0xa7 0x0437 #CYRILLIC SMALL LETTER ZE
+0xa8 0x0438 #CYRILLIC SMALL LETTER I
+0xa9 0x0439 #CYRILLIC SMALL LETTER SHORT I
+0xaa 0x043a #CYRILLIC SMALL LETTER KA
+0xab 0x043b #CYRILLIC SMALL LETTER EL
+0xac 0x043c #CYRILLIC SMALL LETTER EM
+0xad 0x043d #CYRILLIC SMALL LETTER EN
+0xae 0x043e #CYRILLIC SMALL LETTER O
+0xaf 0x043f #CYRILLIC SMALL LETTER PE
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x2561 #BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+0xb6 0x2562 #BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+0xb7 0x2556 #BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+0xb8 0x2555 #BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x255c #BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+0xbe 0x255b #BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x255e #BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+0xc7 0x255f #BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x2567 #BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+0xd0 0x2568 #BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+0xd1 0x2564 #BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+0xd2 0x2565 #BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+0xd3 0x2559 #BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+0xd4 0x2558 #BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+0xd5 0x2552 #BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+0xd6 0x2553 #BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+0xd7 0x256b #BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+0xd8 0x256a #BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x258c #LEFT HALF BLOCK
+0xde 0x2590 #RIGHT HALF BLOCK
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x0440 #CYRILLIC SMALL LETTER ER
+0xe1 0x0441 #CYRILLIC SMALL LETTER ES
+0xe2 0x0442 #CYRILLIC SMALL LETTER TE
+0xe3 0x0443 #CYRILLIC SMALL LETTER U
+0xe4 0x0444 #CYRILLIC SMALL LETTER EF
+0xe5 0x0445 #CYRILLIC SMALL LETTER HA
+0xe6 0x0446 #CYRILLIC SMALL LETTER TSE
+0xe7 0x0447 #CYRILLIC SMALL LETTER CHE
+0xe8 0x0448 #CYRILLIC SMALL LETTER SHA
+0xe9 0x0449 #CYRILLIC SMALL LETTER SHCHA
+0xea 0x044a #CYRILLIC SMALL LETTER HARD SIGN
+0xeb 0x044b #CYRILLIC SMALL LETTER YERU
+0xec 0x044c #CYRILLIC SMALL LETTER SOFT SIGN
+0xed 0x044d #CYRILLIC SMALL LETTER E
+0xee 0x044e #CYRILLIC SMALL LETTER YU
+0xef 0x044f #CYRILLIC SMALL LETTER YA
+0xf0 0x0401 #CYRILLIC CAPITAL LETTER IO
+0xf1 0x0451 #CYRILLIC SMALL LETTER IO
+0xf2 0x0404 #CYRILLIC CAPITAL LETTER UKRAINIAN IE
+0xf3 0x0454 #CYRILLIC SMALL LETTER UKRAINIAN IE
+0xf4 0x0407 #CYRILLIC CAPITAL LETTER YI
+0xf5 0x0457 #CYRILLIC SMALL LETTER YI
+0xf6 0x040e #CYRILLIC CAPITAL LETTER SHORT U
+0xf7 0x045e #CYRILLIC SMALL LETTER SHORT U
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x2219 #BULLET OPERATOR
+0xfa 0x00b7 #MIDDLE DOT
+0xfb 0x221a #SQUARE ROOT
+0xfc 0x2116 #NUMERO SIGN
+0xfd 0x00a4 #CURRENCY SIGN
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp869.txt b/rtl/ucmaps/cp869.txt
new file mode 100644
index 0000000000..4c77ffd6c7
--- /dev/null
+++ b/rtl/ucmaps/cp869.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp869_DOSGreek2 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.00
+# Table format: Format A
+# Date: 04/24/96
+# Authors: Lori Brownell <loribr@microsoft.com>
+# K.D. Chang <a-kchang@microsoft.com>
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp869_DOSGreek2 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp869_DOSGreek2 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0a 0x000a #LINE FEED
+0x0b 0x000b #VERTICAL TABULATION
+0x0c 0x000c #FORM FEED
+0x0d 0x000d #CARRIAGE RETURN
+0x0e 0x000e #SHIFT OUT
+0x0f 0x000f #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1a 0x001a #SUBSTITUTE
+0x1b 0x001b #ESCAPE
+0x1c 0x001c #FILE SEPARATOR
+0x1d 0x001d #GROUP SEPARATOR
+0x1e 0x001e #RECORD SEPARATOR
+0x1f 0x001f #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2a 0x002a #ASTERISK
+0x2b 0x002b #PLUS SIGN
+0x2c 0x002c #COMMA
+0x2d 0x002d #HYPHEN-MINUS
+0x2e 0x002e #FULL STOP
+0x2f 0x002f #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3a 0x003a #COLON
+0x3b 0x003b #SEMICOLON
+0x3c 0x003c #LESS-THAN SIGN
+0x3d 0x003d #EQUALS SIGN
+0x3e 0x003e #GREATER-THAN SIGN
+0x3f 0x003f #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4a 0x004a #LATIN CAPITAL LETTER J
+0x4b 0x004b #LATIN CAPITAL LETTER K
+0x4c 0x004c #LATIN CAPITAL LETTER L
+0x4d 0x004d #LATIN CAPITAL LETTER M
+0x4e 0x004e #LATIN CAPITAL LETTER N
+0x4f 0x004f #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5a 0x005a #LATIN CAPITAL LETTER Z
+0x5b 0x005b #LEFT SQUARE BRACKET
+0x5c 0x005c #REVERSE SOLIDUS
+0x5d 0x005d #RIGHT SQUARE BRACKET
+0x5e 0x005e #CIRCUMFLEX ACCENT
+0x5f 0x005f #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6a 0x006a #LATIN SMALL LETTER J
+0x6b 0x006b #LATIN SMALL LETTER K
+0x6c 0x006c #LATIN SMALL LETTER L
+0x6d 0x006d #LATIN SMALL LETTER M
+0x6e 0x006e #LATIN SMALL LETTER N
+0x6f 0x006f #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7a 0x007a #LATIN SMALL LETTER Z
+0x7b 0x007b #LEFT CURLY BRACKET
+0x7c 0x007c #VERTICAL LINE
+0x7d 0x007d #RIGHT CURLY BRACKET
+0x7e 0x007e #TILDE
+0x7f 0x007f #DELETE
+0x80 #UNDEFINED
+0x81 #UNDEFINED
+0x82 #UNDEFINED
+0x83 #UNDEFINED
+0x84 #UNDEFINED
+0x85 #UNDEFINED
+0x86 0x0386 #GREEK CAPITAL LETTER ALPHA WITH TONOS
+0x87 #UNDEFINED
+0x88 0x00b7 #MIDDLE DOT
+0x89 0x00ac #NOT SIGN
+0x8a 0x00a6 #BROKEN BAR
+0x8b 0x2018 #LEFT SINGLE QUOTATION MARK
+0x8c 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x8d 0x0388 #GREEK CAPITAL LETTER EPSILON WITH TONOS
+0x8e 0x2015 #HORIZONTAL BAR
+0x8f 0x0389 #GREEK CAPITAL LETTER ETA WITH TONOS
+0x90 0x038a #GREEK CAPITAL LETTER IOTA WITH TONOS
+0x91 0x03aa #GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+0x92 0x038c #GREEK CAPITAL LETTER OMICRON WITH TONOS
+0x93 #UNDEFINED
+0x94 #UNDEFINED
+0x95 0x038e #GREEK CAPITAL LETTER UPSILON WITH TONOS
+0x96 0x03ab #GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+0x97 0x00a9 #COPYRIGHT SIGN
+0x98 0x038f #GREEK CAPITAL LETTER OMEGA WITH TONOS
+0x99 0x00b2 #SUPERSCRIPT TWO
+0x9a 0x00b3 #SUPERSCRIPT THREE
+0x9b 0x03ac #GREEK SMALL LETTER ALPHA WITH TONOS
+0x9c 0x00a3 #POUND SIGN
+0x9d 0x03ad #GREEK SMALL LETTER EPSILON WITH TONOS
+0x9e 0x03ae #GREEK SMALL LETTER ETA WITH TONOS
+0x9f 0x03af #GREEK SMALL LETTER IOTA WITH TONOS
+0xa0 0x03ca #GREEK SMALL LETTER IOTA WITH DIALYTIKA
+0xa1 0x0390 #GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+0xa2 0x03cc #GREEK SMALL LETTER OMICRON WITH TONOS
+0xa3 0x03cd #GREEK SMALL LETTER UPSILON WITH TONOS
+0xa4 0x0391 #GREEK CAPITAL LETTER ALPHA
+0xa5 0x0392 #GREEK CAPITAL LETTER BETA
+0xa6 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xa7 0x0394 #GREEK CAPITAL LETTER DELTA
+0xa8 0x0395 #GREEK CAPITAL LETTER EPSILON
+0xa9 0x0396 #GREEK CAPITAL LETTER ZETA
+0xaa 0x0397 #GREEK CAPITAL LETTER ETA
+0xab 0x00bd #VULGAR FRACTION ONE HALF
+0xac 0x0398 #GREEK CAPITAL LETTER THETA
+0xad 0x0399 #GREEK CAPITAL LETTER IOTA
+0xae 0x00ab #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xaf 0x00bb #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xb0 0x2591 #LIGHT SHADE
+0xb1 0x2592 #MEDIUM SHADE
+0xb2 0x2593 #DARK SHADE
+0xb3 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0xb4 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0xb5 0x039a #GREEK CAPITAL LETTER KAPPA
+0xb6 0x039b #GREEK CAPITAL LETTER LAMDA
+0xb7 0x039c #GREEK CAPITAL LETTER MU
+0xb8 0x039d #GREEK CAPITAL LETTER NU
+0xb9 0x2563 #BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+0xba 0x2551 #BOX DRAWINGS DOUBLE VERTICAL
+0xbb 0x2557 #BOX DRAWINGS DOUBLE DOWN AND LEFT
+0xbc 0x255d #BOX DRAWINGS DOUBLE UP AND LEFT
+0xbd 0x039e #GREEK CAPITAL LETTER XI
+0xbe 0x039f #GREEK CAPITAL LETTER OMICRON
+0xbf 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0xc0 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0xc1 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0xc2 0x252c #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0xc3 0x251c #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0xc4 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0xc5 0x253c #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0xc6 0x03a0 #GREEK CAPITAL LETTER PI
+0xc7 0x03a1 #GREEK CAPITAL LETTER RHO
+0xc8 0x255a #BOX DRAWINGS DOUBLE UP AND RIGHT
+0xc9 0x2554 #BOX DRAWINGS DOUBLE DOWN AND RIGHT
+0xca 0x2569 #BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+0xcb 0x2566 #BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+0xcc 0x2560 #BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+0xcd 0x2550 #BOX DRAWINGS DOUBLE HORIZONTAL
+0xce 0x256c #BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+0xcf 0x03a3 #GREEK CAPITAL LETTER SIGMA
+0xd0 0x03a4 #GREEK CAPITAL LETTER TAU
+0xd1 0x03a5 #GREEK CAPITAL LETTER UPSILON
+0xd2 0x03a6 #GREEK CAPITAL LETTER PHI
+0xd3 0x03a7 #GREEK CAPITAL LETTER CHI
+0xd4 0x03a8 #GREEK CAPITAL LETTER PSI
+0xd5 0x03a9 #GREEK CAPITAL LETTER OMEGA
+0xd6 0x03b1 #GREEK SMALL LETTER ALPHA
+0xd7 0x03b2 #GREEK SMALL LETTER BETA
+0xd8 0x03b3 #GREEK SMALL LETTER GAMMA
+0xd9 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0xda 0x250c #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0xdb 0x2588 #FULL BLOCK
+0xdc 0x2584 #LOWER HALF BLOCK
+0xdd 0x03b4 #GREEK SMALL LETTER DELTA
+0xde 0x03b5 #GREEK SMALL LETTER EPSILON
+0xdf 0x2580 #UPPER HALF BLOCK
+0xe0 0x03b6 #GREEK SMALL LETTER ZETA
+0xe1 0x03b7 #GREEK SMALL LETTER ETA
+0xe2 0x03b8 #GREEK SMALL LETTER THETA
+0xe3 0x03b9 #GREEK SMALL LETTER IOTA
+0xe4 0x03ba #GREEK SMALL LETTER KAPPA
+0xe5 0x03bb #GREEK SMALL LETTER LAMDA
+0xe6 0x03bc #GREEK SMALL LETTER MU
+0xe7 0x03bd #GREEK SMALL LETTER NU
+0xe8 0x03be #GREEK SMALL LETTER XI
+0xe9 0x03bf #GREEK SMALL LETTER OMICRON
+0xea 0x03c0 #GREEK SMALL LETTER PI
+0xeb 0x03c1 #GREEK SMALL LETTER RHO
+0xec 0x03c3 #GREEK SMALL LETTER SIGMA
+0xed 0x03c2 #GREEK SMALL LETTER FINAL SIGMA
+0xee 0x03c4 #GREEK SMALL LETTER TAU
+0xef 0x0384 #GREEK TONOS
+0xf0 0x00ad #SOFT HYPHEN
+0xf1 0x00b1 #PLUS-MINUS SIGN
+0xf2 0x03c5 #GREEK SMALL LETTER UPSILON
+0xf3 0x03c6 #GREEK SMALL LETTER PHI
+0xf4 0x03c7 #GREEK SMALL LETTER CHI
+0xf5 0x00a7 #SECTION SIGN
+0xf6 0x03c8 #GREEK SMALL LETTER PSI
+0xf7 0x0385 #GREEK DIALYTIKA TONOS
+0xf8 0x00b0 #DEGREE SIGN
+0xf9 0x00a8 #DIAERESIS
+0xfa 0x03c9 #GREEK SMALL LETTER OMEGA
+0xfb 0x03cb #GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+0xfc 0x03b0 #GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+0xfd 0x03ce #GREEK SMALL LETTER OMEGA WITH TONOS
+0xfe 0x25a0 #BLACK SQUARE
+0xff 0x00a0 #NO-BREAK SPACE
+
diff --git a/rtl/ucmaps/cp874.txt b/rtl/ucmaps/cp874.txt
new file mode 100644
index 0000000000..1eb71dfe1b
--- /dev/null
+++ b/rtl/ucmaps/cp874.txt
@@ -0,0 +1,274 @@
+#
+# Name: cp874 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 02/28/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp874 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp874 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 #UNDEFINED
+0x83 #UNDEFINED
+0x84 #UNDEFINED
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 #UNDEFINED
+0x87 #UNDEFINED
+0x88 #UNDEFINED
+0x89 #UNDEFINED
+0x8A #UNDEFINED
+0x8B #UNDEFINED
+0x8C #UNDEFINED
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 #UNDEFINED
+0x9A #UNDEFINED
+0x9B #UNDEFINED
+0x9C #UNDEFINED
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x0E01 #THAI CHARACTER KO KAI
+0xA2 0x0E02 #THAI CHARACTER KHO KHAI
+0xA3 0x0E03 #THAI CHARACTER KHO KHUAT
+0xA4 0x0E04 #THAI CHARACTER KHO KHWAI
+0xA5 0x0E05 #THAI CHARACTER KHO KHON
+0xA6 0x0E06 #THAI CHARACTER KHO RAKHANG
+0xA7 0x0E07 #THAI CHARACTER NGO NGU
+0xA8 0x0E08 #THAI CHARACTER CHO CHAN
+0xA9 0x0E09 #THAI CHARACTER CHO CHING
+0xAA 0x0E0A #THAI CHARACTER CHO CHANG
+0xAB 0x0E0B #THAI CHARACTER SO SO
+0xAC 0x0E0C #THAI CHARACTER CHO CHOE
+0xAD 0x0E0D #THAI CHARACTER YO YING
+0xAE 0x0E0E #THAI CHARACTER DO CHADA
+0xAF 0x0E0F #THAI CHARACTER TO PATAK
+0xB0 0x0E10 #THAI CHARACTER THO THAN
+0xB1 0x0E11 #THAI CHARACTER THO NANGMONTHO
+0xB2 0x0E12 #THAI CHARACTER THO PHUTHAO
+0xB3 0x0E13 #THAI CHARACTER NO NEN
+0xB4 0x0E14 #THAI CHARACTER DO DEK
+0xB5 0x0E15 #THAI CHARACTER TO TAO
+0xB6 0x0E16 #THAI CHARACTER THO THUNG
+0xB7 0x0E17 #THAI CHARACTER THO THAHAN
+0xB8 0x0E18 #THAI CHARACTER THO THONG
+0xB9 0x0E19 #THAI CHARACTER NO NU
+0xBA 0x0E1A #THAI CHARACTER BO BAIMAI
+0xBB 0x0E1B #THAI CHARACTER PO PLA
+0xBC 0x0E1C #THAI CHARACTER PHO PHUNG
+0xBD 0x0E1D #THAI CHARACTER FO FA
+0xBE 0x0E1E #THAI CHARACTER PHO PHAN
+0xBF 0x0E1F #THAI CHARACTER FO FAN
+0xC0 0x0E20 #THAI CHARACTER PHO SAMPHAO
+0xC1 0x0E21 #THAI CHARACTER MO MA
+0xC2 0x0E22 #THAI CHARACTER YO YAK
+0xC3 0x0E23 #THAI CHARACTER RO RUA
+0xC4 0x0E24 #THAI CHARACTER RU
+0xC5 0x0E25 #THAI CHARACTER LO LING
+0xC6 0x0E26 #THAI CHARACTER LU
+0xC7 0x0E27 #THAI CHARACTER WO WAEN
+0xC8 0x0E28 #THAI CHARACTER SO SALA
+0xC9 0x0E29 #THAI CHARACTER SO RUSI
+0xCA 0x0E2A #THAI CHARACTER SO SUA
+0xCB 0x0E2B #THAI CHARACTER HO HIP
+0xCC 0x0E2C #THAI CHARACTER LO CHULA
+0xCD 0x0E2D #THAI CHARACTER O ANG
+0xCE 0x0E2E #THAI CHARACTER HO NOKHUK
+0xCF 0x0E2F #THAI CHARACTER PAIYANNOI
+0xD0 0x0E30 #THAI CHARACTER SARA A
+0xD1 0x0E31 #THAI CHARACTER MAI HAN-AKAT
+0xD2 0x0E32 #THAI CHARACTER SARA AA
+0xD3 0x0E33 #THAI CHARACTER SARA AM
+0xD4 0x0E34 #THAI CHARACTER SARA I
+0xD5 0x0E35 #THAI CHARACTER SARA II
+0xD6 0x0E36 #THAI CHARACTER SARA UE
+0xD7 0x0E37 #THAI CHARACTER SARA UEE
+0xD8 0x0E38 #THAI CHARACTER SARA U
+0xD9 0x0E39 #THAI CHARACTER SARA UU
+0xDA 0x0E3A #THAI CHARACTER PHINTHU
+0xDB #UNDEFINED
+0xDC #UNDEFINED
+0xDD #UNDEFINED
+0xDE #UNDEFINED
+0xDF 0x0E3F #THAI CURRENCY SYMBOL BAHT
+0xE0 0x0E40 #THAI CHARACTER SARA E
+0xE1 0x0E41 #THAI CHARACTER SARA AE
+0xE2 0x0E42 #THAI CHARACTER SARA O
+0xE3 0x0E43 #THAI CHARACTER SARA AI MAIMUAN
+0xE4 0x0E44 #THAI CHARACTER SARA AI MAIMALAI
+0xE5 0x0E45 #THAI CHARACTER LAKKHANGYAO
+0xE6 0x0E46 #THAI CHARACTER MAIYAMOK
+0xE7 0x0E47 #THAI CHARACTER MAITAIKHU
+0xE8 0x0E48 #THAI CHARACTER MAI EK
+0xE9 0x0E49 #THAI CHARACTER MAI THO
+0xEA 0x0E4A #THAI CHARACTER MAI TRI
+0xEB 0x0E4B #THAI CHARACTER MAI CHATTAWA
+0xEC 0x0E4C #THAI CHARACTER THANTHAKHAT
+0xED 0x0E4D #THAI CHARACTER NIKHAHIT
+0xEE 0x0E4E #THAI CHARACTER YAMAKKAN
+0xEF 0x0E4F #THAI CHARACTER FONGMAN
+0xF0 0x0E50 #THAI DIGIT ZERO
+0xF1 0x0E51 #THAI DIGIT ONE
+0xF2 0x0E52 #THAI DIGIT TWO
+0xF3 0x0E53 #THAI DIGIT THREE
+0xF4 0x0E54 #THAI DIGIT FOUR
+0xF5 0x0E55 #THAI DIGIT FIVE
+0xF6 0x0E56 #THAI DIGIT SIX
+0xF7 0x0E57 #THAI DIGIT SEVEN
+0xF8 0x0E58 #THAI DIGIT EIGHT
+0xF9 0x0E59 #THAI DIGIT NINE
+0xFA 0x0E5A #THAI CHARACTER ANGKHANKHU
+0xFB 0x0E5B #THAI CHARACTER KHOMUT
+0xFC #UNDEFINED
+0xFD #UNDEFINED
+0xFE #UNDEFINED
+0xFF #UNDEFINED
diff --git a/rtl/ucmaps/cp932.txt b/rtl/ucmaps/cp932.txt
new file mode 100644
index 0000000000..36bfdbfaba
--- /dev/null
+++ b/rtl/ucmaps/cp932.txt
@@ -0,0 +1,7998 @@
+#
+# Name: cp932 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: cpxlate@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp932 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp932 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 #UNDEFINED
+0x81 #DBCS LEAD BYTE
+0x82 #DBCS LEAD BYTE
+0x83 #DBCS LEAD BYTE
+0x84 #DBCS LEAD BYTE
+0x85 #DBCS LEAD BYTE
+0x86 #DBCS LEAD BYTE
+0x87 #DBCS LEAD BYTE
+0x88 #DBCS LEAD BYTE
+0x89 #DBCS LEAD BYTE
+0x8A #DBCS LEAD BYTE
+0x8B #DBCS LEAD BYTE
+0x8C #DBCS LEAD BYTE
+0x8D #DBCS LEAD BYTE
+0x8E #DBCS LEAD BYTE
+0x8F #DBCS LEAD BYTE
+0x90 #DBCS LEAD BYTE
+0x91 #DBCS LEAD BYTE
+0x92 #DBCS LEAD BYTE
+0x93 #DBCS LEAD BYTE
+0x94 #DBCS LEAD BYTE
+0x95 #DBCS LEAD BYTE
+0x96 #DBCS LEAD BYTE
+0x97 #DBCS LEAD BYTE
+0x98 #DBCS LEAD BYTE
+0x99 #DBCS LEAD BYTE
+0x9A #DBCS LEAD BYTE
+0x9B #DBCS LEAD BYTE
+0x9C #DBCS LEAD BYTE
+0x9D #DBCS LEAD BYTE
+0x9E #DBCS LEAD BYTE
+0x9F #DBCS LEAD BYTE
+0xA0 #UNDEFINED
+0xA1 0xFF61 #HALFWIDTH IDEOGRAPHIC FULL STOP
+0xA2 0xFF62 #HALFWIDTH LEFT CORNER BRACKET
+0xA3 0xFF63 #HALFWIDTH RIGHT CORNER BRACKET
+0xA4 0xFF64 #HALFWIDTH IDEOGRAPHIC COMMA
+0xA5 0xFF65 #HALFWIDTH KATAKANA MIDDLE DOT
+0xA6 0xFF66 #HALFWIDTH KATAKANA LETTER WO
+0xA7 0xFF67 #HALFWIDTH KATAKANA LETTER SMALL A
+0xA8 0xFF68 #HALFWIDTH KATAKANA LETTER SMALL I
+0xA9 0xFF69 #HALFWIDTH KATAKANA LETTER SMALL U
+0xAA 0xFF6A #HALFWIDTH KATAKANA LETTER SMALL E
+0xAB 0xFF6B #HALFWIDTH KATAKANA LETTER SMALL O
+0xAC 0xFF6C #HALFWIDTH KATAKANA LETTER SMALL YA
+0xAD 0xFF6D #HALFWIDTH KATAKANA LETTER SMALL YU
+0xAE 0xFF6E #HALFWIDTH KATAKANA LETTER SMALL YO
+0xAF 0xFF6F #HALFWIDTH KATAKANA LETTER SMALL TU
+0xB0 0xFF70 #HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK
+0xB1 0xFF71 #HALFWIDTH KATAKANA LETTER A
+0xB2 0xFF72 #HALFWIDTH KATAKANA LETTER I
+0xB3 0xFF73 #HALFWIDTH KATAKANA LETTER U
+0xB4 0xFF74 #HALFWIDTH KATAKANA LETTER E
+0xB5 0xFF75 #HALFWIDTH KATAKANA LETTER O
+0xB6 0xFF76 #HALFWIDTH KATAKANA LETTER KA
+0xB7 0xFF77 #HALFWIDTH KATAKANA LETTER KI
+0xB8 0xFF78 #HALFWIDTH KATAKANA LETTER KU
+0xB9 0xFF79 #HALFWIDTH KATAKANA LETTER KE
+0xBA 0xFF7A #HALFWIDTH KATAKANA LETTER KO
+0xBB 0xFF7B #HALFWIDTH KATAKANA LETTER SA
+0xBC 0xFF7C #HALFWIDTH KATAKANA LETTER SI
+0xBD 0xFF7D #HALFWIDTH KATAKANA LETTER SU
+0xBE 0xFF7E #HALFWIDTH KATAKANA LETTER SE
+0xBF 0xFF7F #HALFWIDTH KATAKANA LETTER SO
+0xC0 0xFF80 #HALFWIDTH KATAKANA LETTER TA
+0xC1 0xFF81 #HALFWIDTH KATAKANA LETTER TI
+0xC2 0xFF82 #HALFWIDTH KATAKANA LETTER TU
+0xC3 0xFF83 #HALFWIDTH KATAKANA LETTER TE
+0xC4 0xFF84 #HALFWIDTH KATAKANA LETTER TO
+0xC5 0xFF85 #HALFWIDTH KATAKANA LETTER NA
+0xC6 0xFF86 #HALFWIDTH KATAKANA LETTER NI
+0xC7 0xFF87 #HALFWIDTH KATAKANA LETTER NU
+0xC8 0xFF88 #HALFWIDTH KATAKANA LETTER NE
+0xC9 0xFF89 #HALFWIDTH KATAKANA LETTER NO
+0xCA 0xFF8A #HALFWIDTH KATAKANA LETTER HA
+0xCB 0xFF8B #HALFWIDTH KATAKANA LETTER HI
+0xCC 0xFF8C #HALFWIDTH KATAKANA LETTER HU
+0xCD 0xFF8D #HALFWIDTH KATAKANA LETTER HE
+0xCE 0xFF8E #HALFWIDTH KATAKANA LETTER HO
+0xCF 0xFF8F #HALFWIDTH KATAKANA LETTER MA
+0xD0 0xFF90 #HALFWIDTH KATAKANA LETTER MI
+0xD1 0xFF91 #HALFWIDTH KATAKANA LETTER MU
+0xD2 0xFF92 #HALFWIDTH KATAKANA LETTER ME
+0xD3 0xFF93 #HALFWIDTH KATAKANA LETTER MO
+0xD4 0xFF94 #HALFWIDTH KATAKANA LETTER YA
+0xD5 0xFF95 #HALFWIDTH KATAKANA LETTER YU
+0xD6 0xFF96 #HALFWIDTH KATAKANA LETTER YO
+0xD7 0xFF97 #HALFWIDTH KATAKANA LETTER RA
+0xD8 0xFF98 #HALFWIDTH KATAKANA LETTER RI
+0xD9 0xFF99 #HALFWIDTH KATAKANA LETTER RU
+0xDA 0xFF9A #HALFWIDTH KATAKANA LETTER RE
+0xDB 0xFF9B #HALFWIDTH KATAKANA LETTER RO
+0xDC 0xFF9C #HALFWIDTH KATAKANA LETTER WA
+0xDD 0xFF9D #HALFWIDTH KATAKANA LETTER N
+0xDE 0xFF9E #HALFWIDTH KATAKANA VOICED SOUND MARK
+0xDF 0xFF9F #HALFWIDTH KATAKANA SEMI-VOICED SOUND MARK
+0xE0 #DBCS LEAD BYTE
+0xE1 #DBCS LEAD BYTE
+0xE2 #DBCS LEAD BYTE
+0xE3 #DBCS LEAD BYTE
+0xE4 #DBCS LEAD BYTE
+0xE5 #DBCS LEAD BYTE
+0xE6 #DBCS LEAD BYTE
+0xE7 #DBCS LEAD BYTE
+0xE8 #DBCS LEAD BYTE
+0xE9 #DBCS LEAD BYTE
+0xEA #DBCS LEAD BYTE
+0xEB #DBCS LEAD BYTE
+0xEC #DBCS LEAD BYTE
+0xED #DBCS LEAD BYTE
+0xEE #DBCS LEAD BYTE
+0xEF #DBCS LEAD BYTE
+0xF0 #DBCS LEAD BYTE
+0xF1 #DBCS LEAD BYTE
+0xF2 #DBCS LEAD BYTE
+0xF3 #DBCS LEAD BYTE
+0xF4 #DBCS LEAD BYTE
+0xF5 #DBCS LEAD BYTE
+0xF6 #DBCS LEAD BYTE
+0xF7 #DBCS LEAD BYTE
+0xF8 #DBCS LEAD BYTE
+0xF9 #DBCS LEAD BYTE
+0xFA #DBCS LEAD BYTE
+0xFB #DBCS LEAD BYTE
+0xFC #DBCS LEAD BYTE
+0xFD #UNDEFINED
+0xFE #UNDEFINED
+0xFF #UNDEFINED
+0x8140 0x3000 #IDEOGRAPHIC SPACE
+0x8141 0x3001 #IDEOGRAPHIC COMMA
+0x8142 0x3002 #IDEOGRAPHIC FULL STOP
+0x8143 0xFF0C #FULLWIDTH COMMA
+0x8144 0xFF0E #FULLWIDTH FULL STOP
+0x8145 0x30FB #KATAKANA MIDDLE DOT
+0x8146 0xFF1A #FULLWIDTH COLON
+0x8147 0xFF1B #FULLWIDTH SEMICOLON
+0x8148 0xFF1F #FULLWIDTH QUESTION MARK
+0x8149 0xFF01 #FULLWIDTH EXCLAMATION MARK
+0x814A 0x309B #KATAKANA-HIRAGANA VOICED SOUND MARK
+0x814B 0x309C #KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
+0x814C 0x00B4 #ACUTE ACCENT
+0x814D 0xFF40 #FULLWIDTH GRAVE ACCENT
+0x814E 0x00A8 #DIAERESIS
+0x814F 0xFF3E #FULLWIDTH CIRCUMFLEX ACCENT
+0x8150 0xFFE3 #FULLWIDTH MACRON
+0x8151 0xFF3F #FULLWIDTH LOW LINE
+0x8152 0x30FD #KATAKANA ITERATION MARK
+0x8153 0x30FE #KATAKANA VOICED ITERATION MARK
+0x8154 0x309D #HIRAGANA ITERATION MARK
+0x8155 0x309E #HIRAGANA VOICED ITERATION MARK
+0x8156 0x3003 #DITTO MARK
+0x8157 0x4EDD #CJK UNIFIED IDEOGRAPH
+0x8158 0x3005 #IDEOGRAPHIC ITERATION MARK
+0x8159 0x3006 #IDEOGRAPHIC CLOSING MARK
+0x815A 0x3007 #IDEOGRAPHIC NUMBER ZERO
+0x815B 0x30FC #KATAKANA-HIRAGANA PROLONGED SOUND MARK
+0x815C 0x2015 #HORIZONTAL BAR
+0x815D 0x2010 #HYPHEN
+0x815E 0xFF0F #FULLWIDTH SOLIDUS
+0x815F 0xFF3C #FULLWIDTH REVERSE SOLIDUS
+0x8160 0xFF5E #FULLWIDTH TILDE
+0x8161 0x2225 #PARALLEL TO
+0x8162 0xFF5C #FULLWIDTH VERTICAL LINE
+0x8163 0x2026 #HORIZONTAL ELLIPSIS
+0x8164 0x2025 #TWO DOT LEADER
+0x8165 0x2018 #LEFT SINGLE QUOTATION MARK
+0x8166 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x8167 0x201C #LEFT DOUBLE QUOTATION MARK
+0x8168 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x8169 0xFF08 #FULLWIDTH LEFT PARENTHESIS
+0x816A 0xFF09 #FULLWIDTH RIGHT PARENTHESIS
+0x816B 0x3014 #LEFT TORTOISE SHELL BRACKET
+0x816C 0x3015 #RIGHT TORTOISE SHELL BRACKET
+0x816D 0xFF3B #FULLWIDTH LEFT SQUARE BRACKET
+0x816E 0xFF3D #FULLWIDTH RIGHT SQUARE BRACKET
+0x816F 0xFF5B #FULLWIDTH LEFT CURLY BRACKET
+0x8170 0xFF5D #FULLWIDTH RIGHT CURLY BRACKET
+0x8171 0x3008 #LEFT ANGLE BRACKET
+0x8172 0x3009 #RIGHT ANGLE BRACKET
+0x8173 0x300A #LEFT DOUBLE ANGLE BRACKET
+0x8174 0x300B #RIGHT DOUBLE ANGLE BRACKET
+0x8175 0x300C #LEFT CORNER BRACKET
+0x8176 0x300D #RIGHT CORNER BRACKET
+0x8177 0x300E #LEFT WHITE CORNER BRACKET
+0x8178 0x300F #RIGHT WHITE CORNER BRACKET
+0x8179 0x3010 #LEFT BLACK LENTICULAR BRACKET
+0x817A 0x3011 #RIGHT BLACK LENTICULAR BRACKET
+0x817B 0xFF0B #FULLWIDTH PLUS SIGN
+0x817C 0xFF0D #FULLWIDTH HYPHEN-MINUS
+0x817D 0x00B1 #PLUS-MINUS SIGN
+0x817E 0x00D7 #MULTIPLICATION SIGN
+0x8180 0x00F7 #DIVISION SIGN
+0x8181 0xFF1D #FULLWIDTH EQUALS SIGN
+0x8182 0x2260 #NOT EQUAL TO
+0x8183 0xFF1C #FULLWIDTH LESS-THAN SIGN
+0x8184 0xFF1E #FULLWIDTH GREATER-THAN SIGN
+0x8185 0x2266 #LESS-THAN OVER EQUAL TO
+0x8186 0x2267 #GREATER-THAN OVER EQUAL TO
+0x8187 0x221E #INFINITY
+0x8188 0x2234 #THEREFORE
+0x8189 0x2642 #MALE SIGN
+0x818A 0x2640 #FEMALE SIGN
+0x818B 0x00B0 #DEGREE SIGN
+0x818C 0x2032 #PRIME
+0x818D 0x2033 #DOUBLE PRIME
+0x818E 0x2103 #DEGREE CELSIUS
+0x818F 0xFFE5 #FULLWIDTH YEN SIGN
+0x8190 0xFF04 #FULLWIDTH DOLLAR SIGN
+0x8191 0xFFE0 #FULLWIDTH CENT SIGN
+0x8192 0xFFE1 #FULLWIDTH POUND SIGN
+0x8193 0xFF05 #FULLWIDTH PERCENT SIGN
+0x8194 0xFF03 #FULLWIDTH NUMBER SIGN
+0x8195 0xFF06 #FULLWIDTH AMPERSAND
+0x8196 0xFF0A #FULLWIDTH ASTERISK
+0x8197 0xFF20 #FULLWIDTH COMMERCIAL AT
+0x8198 0x00A7 #SECTION SIGN
+0x8199 0x2606 #WHITE STAR
+0x819A 0x2605 #BLACK STAR
+0x819B 0x25CB #WHITE CIRCLE
+0x819C 0x25CF #BLACK CIRCLE
+0x819D 0x25CE #BULLSEYE
+0x819E 0x25C7 #WHITE DIAMOND
+0x819F 0x25C6 #BLACK DIAMOND
+0x81A0 0x25A1 #WHITE SQUARE
+0x81A1 0x25A0 #BLACK SQUARE
+0x81A2 0x25B3 #WHITE UP-POINTING TRIANGLE
+0x81A3 0x25B2 #BLACK UP-POINTING TRIANGLE
+0x81A4 0x25BD #WHITE DOWN-POINTING TRIANGLE
+0x81A5 0x25BC #BLACK DOWN-POINTING TRIANGLE
+0x81A6 0x203B #REFERENCE MARK
+0x81A7 0x3012 #POSTAL MARK
+0x81A8 0x2192 #RIGHTWARDS ARROW
+0x81A9 0x2190 #LEFTWARDS ARROW
+0x81AA 0x2191 #UPWARDS ARROW
+0x81AB 0x2193 #DOWNWARDS ARROW
+0x81AC 0x3013 #GETA MARK
+0x81B8 0x2208 #ELEMENT OF
+0x81B9 0x220B #CONTAINS AS MEMBER
+0x81BA 0x2286 #SUBSET OF OR EQUAL TO
+0x81BB 0x2287 #SUPERSET OF OR EQUAL TO
+0x81BC 0x2282 #SUBSET OF
+0x81BD 0x2283 #SUPERSET OF
+0x81BE 0x222A #UNION
+0x81BF 0x2229 #INTERSECTION
+0x81C8 0x2227 #LOGICAL AND
+0x81C9 0x2228 #LOGICAL OR
+0x81CA 0xFFE2 #FULLWIDTH NOT SIGN
+0x81CB 0x21D2 #RIGHTWARDS DOUBLE ARROW
+0x81CC 0x21D4 #LEFT RIGHT DOUBLE ARROW
+0x81CD 0x2200 #FOR ALL
+0x81CE 0x2203 #THERE EXISTS
+0x81DA 0x2220 #ANGLE
+0x81DB 0x22A5 #UP TACK
+0x81DC 0x2312 #ARC
+0x81DD 0x2202 #PARTIAL DIFFERENTIAL
+0x81DE 0x2207 #NABLA
+0x81DF 0x2261 #IDENTICAL TO
+0x81E0 0x2252 #APPROXIMATELY EQUAL TO OR THE IMAGE OF
+0x81E1 0x226A #MUCH LESS-THAN
+0x81E2 0x226B #MUCH GREATER-THAN
+0x81E3 0x221A #SQUARE ROOT
+0x81E4 0x223D #REVERSED TILDE
+0x81E5 0x221D #PROPORTIONAL TO
+0x81E6 0x2235 #BECAUSE
+0x81E7 0x222B #INTEGRAL
+0x81E8 0x222C #DOUBLE INTEGRAL
+0x81F0 0x212B #ANGSTROM SIGN
+0x81F1 0x2030 #PER MILLE SIGN
+0x81F2 0x266F #MUSIC SHARP SIGN
+0x81F3 0x266D #MUSIC FLAT SIGN
+0x81F4 0x266A #EIGHTH NOTE
+0x81F5 0x2020 #DAGGER
+0x81F6 0x2021 #DOUBLE DAGGER
+0x81F7 0x00B6 #PILCROW SIGN
+0x81FC 0x25EF #LARGE CIRCLE
+0x824F 0xFF10 #FULLWIDTH DIGIT ZERO
+0x8250 0xFF11 #FULLWIDTH DIGIT ONE
+0x8251 0xFF12 #FULLWIDTH DIGIT TWO
+0x8252 0xFF13 #FULLWIDTH DIGIT THREE
+0x8253 0xFF14 #FULLWIDTH DIGIT FOUR
+0x8254 0xFF15 #FULLWIDTH DIGIT FIVE
+0x8255 0xFF16 #FULLWIDTH DIGIT SIX
+0x8256 0xFF17 #FULLWIDTH DIGIT SEVEN
+0x8257 0xFF18 #FULLWIDTH DIGIT EIGHT
+0x8258 0xFF19 #FULLWIDTH DIGIT NINE
+0x8260 0xFF21 #FULLWIDTH LATIN CAPITAL LETTER A
+0x8261 0xFF22 #FULLWIDTH LATIN CAPITAL LETTER B
+0x8262 0xFF23 #FULLWIDTH LATIN CAPITAL LETTER C
+0x8263 0xFF24 #FULLWIDTH LATIN CAPITAL LETTER D
+0x8264 0xFF25 #FULLWIDTH LATIN CAPITAL LETTER E
+0x8265 0xFF26 #FULLWIDTH LATIN CAPITAL LETTER F
+0x8266 0xFF27 #FULLWIDTH LATIN CAPITAL LETTER G
+0x8267 0xFF28 #FULLWIDTH LATIN CAPITAL LETTER H
+0x8268 0xFF29 #FULLWIDTH LATIN CAPITAL LETTER I
+0x8269 0xFF2A #FULLWIDTH LATIN CAPITAL LETTER J
+0x826A 0xFF2B #FULLWIDTH LATIN CAPITAL LETTER K
+0x826B 0xFF2C #FULLWIDTH LATIN CAPITAL LETTER L
+0x826C 0xFF2D #FULLWIDTH LATIN CAPITAL LETTER M
+0x826D 0xFF2E #FULLWIDTH LATIN CAPITAL LETTER N
+0x826E 0xFF2F #FULLWIDTH LATIN CAPITAL LETTER O
+0x826F 0xFF30 #FULLWIDTH LATIN CAPITAL LETTER P
+0x8270 0xFF31 #FULLWIDTH LATIN CAPITAL LETTER Q
+0x8271 0xFF32 #FULLWIDTH LATIN CAPITAL LETTER R
+0x8272 0xFF33 #FULLWIDTH LATIN CAPITAL LETTER S
+0x8273 0xFF34 #FULLWIDTH LATIN CAPITAL LETTER T
+0x8274 0xFF35 #FULLWIDTH LATIN CAPITAL LETTER U
+0x8275 0xFF36 #FULLWIDTH LATIN CAPITAL LETTER V
+0x8276 0xFF37 #FULLWIDTH LATIN CAPITAL LETTER W
+0x8277 0xFF38 #FULLWIDTH LATIN CAPITAL LETTER X
+0x8278 0xFF39 #FULLWIDTH LATIN CAPITAL LETTER Y
+0x8279 0xFF3A #FULLWIDTH LATIN CAPITAL LETTER Z
+0x8281 0xFF41 #FULLWIDTH LATIN SMALL LETTER A
+0x8282 0xFF42 #FULLWIDTH LATIN SMALL LETTER B
+0x8283 0xFF43 #FULLWIDTH LATIN SMALL LETTER C
+0x8284 0xFF44 #FULLWIDTH LATIN SMALL LETTER D
+0x8285 0xFF45 #FULLWIDTH LATIN SMALL LETTER E
+0x8286 0xFF46 #FULLWIDTH LATIN SMALL LETTER F
+0x8287 0xFF47 #FULLWIDTH LATIN SMALL LETTER G
+0x8288 0xFF48 #FULLWIDTH LATIN SMALL LETTER H
+0x8289 0xFF49 #FULLWIDTH LATIN SMALL LETTER I
+0x828A 0xFF4A #FULLWIDTH LATIN SMALL LETTER J
+0x828B 0xFF4B #FULLWIDTH LATIN SMALL LETTER K
+0x828C 0xFF4C #FULLWIDTH LATIN SMALL LETTER L
+0x828D 0xFF4D #FULLWIDTH LATIN SMALL LETTER M
+0x828E 0xFF4E #FULLWIDTH LATIN SMALL LETTER N
+0x828F 0xFF4F #FULLWIDTH LATIN SMALL LETTER O
+0x8290 0xFF50 #FULLWIDTH LATIN SMALL LETTER P
+0x8291 0xFF51 #FULLWIDTH LATIN SMALL LETTER Q
+0x8292 0xFF52 #FULLWIDTH LATIN SMALL LETTER R
+0x8293 0xFF53 #FULLWIDTH LATIN SMALL LETTER S
+0x8294 0xFF54 #FULLWIDTH LATIN SMALL LETTER T
+0x8295 0xFF55 #FULLWIDTH LATIN SMALL LETTER U
+0x8296 0xFF56 #FULLWIDTH LATIN SMALL LETTER V
+0x8297 0xFF57 #FULLWIDTH LATIN SMALL LETTER W
+0x8298 0xFF58 #FULLWIDTH LATIN SMALL LETTER X
+0x8299 0xFF59 #FULLWIDTH LATIN SMALL LETTER Y
+0x829A 0xFF5A #FULLWIDTH LATIN SMALL LETTER Z
+0x829F 0x3041 #HIRAGANA LETTER SMALL A
+0x82A0 0x3042 #HIRAGANA LETTER A
+0x82A1 0x3043 #HIRAGANA LETTER SMALL I
+0x82A2 0x3044 #HIRAGANA LETTER I
+0x82A3 0x3045 #HIRAGANA LETTER SMALL U
+0x82A4 0x3046 #HIRAGANA LETTER U
+0x82A5 0x3047 #HIRAGANA LETTER SMALL E
+0x82A6 0x3048 #HIRAGANA LETTER E
+0x82A7 0x3049 #HIRAGANA LETTER SMALL O
+0x82A8 0x304A #HIRAGANA LETTER O
+0x82A9 0x304B #HIRAGANA LETTER KA
+0x82AA 0x304C #HIRAGANA LETTER GA
+0x82AB 0x304D #HIRAGANA LETTER KI
+0x82AC 0x304E #HIRAGANA LETTER GI
+0x82AD 0x304F #HIRAGANA LETTER KU
+0x82AE 0x3050 #HIRAGANA LETTER GU
+0x82AF 0x3051 #HIRAGANA LETTER KE
+0x82B0 0x3052 #HIRAGANA LETTER GE
+0x82B1 0x3053 #HIRAGANA LETTER KO
+0x82B2 0x3054 #HIRAGANA LETTER GO
+0x82B3 0x3055 #HIRAGANA LETTER SA
+0x82B4 0x3056 #HIRAGANA LETTER ZA
+0x82B5 0x3057 #HIRAGANA LETTER SI
+0x82B6 0x3058 #HIRAGANA LETTER ZI
+0x82B7 0x3059 #HIRAGANA LETTER SU
+0x82B8 0x305A #HIRAGANA LETTER ZU
+0x82B9 0x305B #HIRAGANA LETTER SE
+0x82BA 0x305C #HIRAGANA LETTER ZE
+0x82BB 0x305D #HIRAGANA LETTER SO
+0x82BC 0x305E #HIRAGANA LETTER ZO
+0x82BD 0x305F #HIRAGANA LETTER TA
+0x82BE 0x3060 #HIRAGANA LETTER DA
+0x82BF 0x3061 #HIRAGANA LETTER TI
+0x82C0 0x3062 #HIRAGANA LETTER DI
+0x82C1 0x3063 #HIRAGANA LETTER SMALL TU
+0x82C2 0x3064 #HIRAGANA LETTER TU
+0x82C3 0x3065 #HIRAGANA LETTER DU
+0x82C4 0x3066 #HIRAGANA LETTER TE
+0x82C5 0x3067 #HIRAGANA LETTER DE
+0x82C6 0x3068 #HIRAGANA LETTER TO
+0x82C7 0x3069 #HIRAGANA LETTER DO
+0x82C8 0x306A #HIRAGANA LETTER NA
+0x82C9 0x306B #HIRAGANA LETTER NI
+0x82CA 0x306C #HIRAGANA LETTER NU
+0x82CB 0x306D #HIRAGANA LETTER NE
+0x82CC 0x306E #HIRAGANA LETTER NO
+0x82CD 0x306F #HIRAGANA LETTER HA
+0x82CE 0x3070 #HIRAGANA LETTER BA
+0x82CF 0x3071 #HIRAGANA LETTER PA
+0x82D0 0x3072 #HIRAGANA LETTER HI
+0x82D1 0x3073 #HIRAGANA LETTER BI
+0x82D2 0x3074 #HIRAGANA LETTER PI
+0x82D3 0x3075 #HIRAGANA LETTER HU
+0x82D4 0x3076 #HIRAGANA LETTER BU
+0x82D5 0x3077 #HIRAGANA LETTER PU
+0x82D6 0x3078 #HIRAGANA LETTER HE
+0x82D7 0x3079 #HIRAGANA LETTER BE
+0x82D8 0x307A #HIRAGANA LETTER PE
+0x82D9 0x307B #HIRAGANA LETTER HO
+0x82DA 0x307C #HIRAGANA LETTER BO
+0x82DB 0x307D #HIRAGANA LETTER PO
+0x82DC 0x307E #HIRAGANA LETTER MA
+0x82DD 0x307F #HIRAGANA LETTER MI
+0x82DE 0x3080 #HIRAGANA LETTER MU
+0x82DF 0x3081 #HIRAGANA LETTER ME
+0x82E0 0x3082 #HIRAGANA LETTER MO
+0x82E1 0x3083 #HIRAGANA LETTER SMALL YA
+0x82E2 0x3084 #HIRAGANA LETTER YA
+0x82E3 0x3085 #HIRAGANA LETTER SMALL YU
+0x82E4 0x3086 #HIRAGANA LETTER YU
+0x82E5 0x3087 #HIRAGANA LETTER SMALL YO
+0x82E6 0x3088 #HIRAGANA LETTER YO
+0x82E7 0x3089 #HIRAGANA LETTER RA
+0x82E8 0x308A #HIRAGANA LETTER RI
+0x82E9 0x308B #HIRAGANA LETTER RU
+0x82EA 0x308C #HIRAGANA LETTER RE
+0x82EB 0x308D #HIRAGANA LETTER RO
+0x82EC 0x308E #HIRAGANA LETTER SMALL WA
+0x82ED 0x308F #HIRAGANA LETTER WA
+0x82EE 0x3090 #HIRAGANA LETTER WI
+0x82EF 0x3091 #HIRAGANA LETTER WE
+0x82F0 0x3092 #HIRAGANA LETTER WO
+0x82F1 0x3093 #HIRAGANA LETTER N
+0x8340 0x30A1 #KATAKANA LETTER SMALL A
+0x8341 0x30A2 #KATAKANA LETTER A
+0x8342 0x30A3 #KATAKANA LETTER SMALL I
+0x8343 0x30A4 #KATAKANA LETTER I
+0x8344 0x30A5 #KATAKANA LETTER SMALL U
+0x8345 0x30A6 #KATAKANA LETTER U
+0x8346 0x30A7 #KATAKANA LETTER SMALL E
+0x8347 0x30A8 #KATAKANA LETTER E
+0x8348 0x30A9 #KATAKANA LETTER SMALL O
+0x8349 0x30AA #KATAKANA LETTER O
+0x834A 0x30AB #KATAKANA LETTER KA
+0x834B 0x30AC #KATAKANA LETTER GA
+0x834C 0x30AD #KATAKANA LETTER KI
+0x834D 0x30AE #KATAKANA LETTER GI
+0x834E 0x30AF #KATAKANA LETTER KU
+0x834F 0x30B0 #KATAKANA LETTER GU
+0x8350 0x30B1 #KATAKANA LETTER KE
+0x8351 0x30B2 #KATAKANA LETTER GE
+0x8352 0x30B3 #KATAKANA LETTER KO
+0x8353 0x30B4 #KATAKANA LETTER GO
+0x8354 0x30B5 #KATAKANA LETTER SA
+0x8355 0x30B6 #KATAKANA LETTER ZA
+0x8356 0x30B7 #KATAKANA LETTER SI
+0x8357 0x30B8 #KATAKANA LETTER ZI
+0x8358 0x30B9 #KATAKANA LETTER SU
+0x8359 0x30BA #KATAKANA LETTER ZU
+0x835A 0x30BB #KATAKANA LETTER SE
+0x835B 0x30BC #KATAKANA LETTER ZE
+0x835C 0x30BD #KATAKANA LETTER SO
+0x835D 0x30BE #KATAKANA LETTER ZO
+0x835E 0x30BF #KATAKANA LETTER TA
+0x835F 0x30C0 #KATAKANA LETTER DA
+0x8360 0x30C1 #KATAKANA LETTER TI
+0x8361 0x30C2 #KATAKANA LETTER DI
+0x8362 0x30C3 #KATAKANA LETTER SMALL TU
+0x8363 0x30C4 #KATAKANA LETTER TU
+0x8364 0x30C5 #KATAKANA LETTER DU
+0x8365 0x30C6 #KATAKANA LETTER TE
+0x8366 0x30C7 #KATAKANA LETTER DE
+0x8367 0x30C8 #KATAKANA LETTER TO
+0x8368 0x30C9 #KATAKANA LETTER DO
+0x8369 0x30CA #KATAKANA LETTER NA
+0x836A 0x30CB #KATAKANA LETTER NI
+0x836B 0x30CC #KATAKANA LETTER NU
+0x836C 0x30CD #KATAKANA LETTER NE
+0x836D 0x30CE #KATAKANA LETTER NO
+0x836E 0x30CF #KATAKANA LETTER HA
+0x836F 0x30D0 #KATAKANA LETTER BA
+0x8370 0x30D1 #KATAKANA LETTER PA
+0x8371 0x30D2 #KATAKANA LETTER HI
+0x8372 0x30D3 #KATAKANA LETTER BI
+0x8373 0x30D4 #KATAKANA LETTER PI
+0x8374 0x30D5 #KATAKANA LETTER HU
+0x8375 0x30D6 #KATAKANA LETTER BU
+0x8376 0x30D7 #KATAKANA LETTER PU
+0x8377 0x30D8 #KATAKANA LETTER HE
+0x8378 0x30D9 #KATAKANA LETTER BE
+0x8379 0x30DA #KATAKANA LETTER PE
+0x837A 0x30DB #KATAKANA LETTER HO
+0x837B 0x30DC #KATAKANA LETTER BO
+0x837C 0x30DD #KATAKANA LETTER PO
+0x837D 0x30DE #KATAKANA LETTER MA
+0x837E 0x30DF #KATAKANA LETTER MI
+0x8380 0x30E0 #KATAKANA LETTER MU
+0x8381 0x30E1 #KATAKANA LETTER ME
+0x8382 0x30E2 #KATAKANA LETTER MO
+0x8383 0x30E3 #KATAKANA LETTER SMALL YA
+0x8384 0x30E4 #KATAKANA LETTER YA
+0x8385 0x30E5 #KATAKANA LETTER SMALL YU
+0x8386 0x30E6 #KATAKANA LETTER YU
+0x8387 0x30E7 #KATAKANA LETTER SMALL YO
+0x8388 0x30E8 #KATAKANA LETTER YO
+0x8389 0x30E9 #KATAKANA LETTER RA
+0x838A 0x30EA #KATAKANA LETTER RI
+0x838B 0x30EB #KATAKANA LETTER RU
+0x838C 0x30EC #KATAKANA LETTER RE
+0x838D 0x30ED #KATAKANA LETTER RO
+0x838E 0x30EE #KATAKANA LETTER SMALL WA
+0x838F 0x30EF #KATAKANA LETTER WA
+0x8390 0x30F0 #KATAKANA LETTER WI
+0x8391 0x30F1 #KATAKANA LETTER WE
+0x8392 0x30F2 #KATAKANA LETTER WO
+0x8393 0x30F3 #KATAKANA LETTER N
+0x8394 0x30F4 #KATAKANA LETTER VU
+0x8395 0x30F5 #KATAKANA LETTER SMALL KA
+0x8396 0x30F6 #KATAKANA LETTER SMALL KE
+0x839F 0x0391 #GREEK CAPITAL LETTER ALPHA
+0x83A0 0x0392 #GREEK CAPITAL LETTER BETA
+0x83A1 0x0393 #GREEK CAPITAL LETTER GAMMA
+0x83A2 0x0394 #GREEK CAPITAL LETTER DELTA
+0x83A3 0x0395 #GREEK CAPITAL LETTER EPSILON
+0x83A4 0x0396 #GREEK CAPITAL LETTER ZETA
+0x83A5 0x0397 #GREEK CAPITAL LETTER ETA
+0x83A6 0x0398 #GREEK CAPITAL LETTER THETA
+0x83A7 0x0399 #GREEK CAPITAL LETTER IOTA
+0x83A8 0x039A #GREEK CAPITAL LETTER KAPPA
+0x83A9 0x039B #GREEK CAPITAL LETTER LAMDA
+0x83AA 0x039C #GREEK CAPITAL LETTER MU
+0x83AB 0x039D #GREEK CAPITAL LETTER NU
+0x83AC 0x039E #GREEK CAPITAL LETTER XI
+0x83AD 0x039F #GREEK CAPITAL LETTER OMICRON
+0x83AE 0x03A0 #GREEK CAPITAL LETTER PI
+0x83AF 0x03A1 #GREEK CAPITAL LETTER RHO
+0x83B0 0x03A3 #GREEK CAPITAL LETTER SIGMA
+0x83B1 0x03A4 #GREEK CAPITAL LETTER TAU
+0x83B2 0x03A5 #GREEK CAPITAL LETTER UPSILON
+0x83B3 0x03A6 #GREEK CAPITAL LETTER PHI
+0x83B4 0x03A7 #GREEK CAPITAL LETTER CHI
+0x83B5 0x03A8 #GREEK CAPITAL LETTER PSI
+0x83B6 0x03A9 #GREEK CAPITAL LETTER OMEGA
+0x83BF 0x03B1 #GREEK SMALL LETTER ALPHA
+0x83C0 0x03B2 #GREEK SMALL LETTER BETA
+0x83C1 0x03B3 #GREEK SMALL LETTER GAMMA
+0x83C2 0x03B4 #GREEK SMALL LETTER DELTA
+0x83C3 0x03B5 #GREEK SMALL LETTER EPSILON
+0x83C4 0x03B6 #GREEK SMALL LETTER ZETA
+0x83C5 0x03B7 #GREEK SMALL LETTER ETA
+0x83C6 0x03B8 #GREEK SMALL LETTER THETA
+0x83C7 0x03B9 #GREEK SMALL LETTER IOTA
+0x83C8 0x03BA #GREEK SMALL LETTER KAPPA
+0x83C9 0x03BB #GREEK SMALL LETTER LAMDA
+0x83CA 0x03BC #GREEK SMALL LETTER MU
+0x83CB 0x03BD #GREEK SMALL LETTER NU
+0x83CC 0x03BE #GREEK SMALL LETTER XI
+0x83CD 0x03BF #GREEK SMALL LETTER OMICRON
+0x83CE 0x03C0 #GREEK SMALL LETTER PI
+0x83CF 0x03C1 #GREEK SMALL LETTER RHO
+0x83D0 0x03C3 #GREEK SMALL LETTER SIGMA
+0x83D1 0x03C4 #GREEK SMALL LETTER TAU
+0x83D2 0x03C5 #GREEK SMALL LETTER UPSILON
+0x83D3 0x03C6 #GREEK SMALL LETTER PHI
+0x83D4 0x03C7 #GREEK SMALL LETTER CHI
+0x83D5 0x03C8 #GREEK SMALL LETTER PSI
+0x83D6 0x03C9 #GREEK SMALL LETTER OMEGA
+0x8440 0x0410 #CYRILLIC CAPITAL LETTER A
+0x8441 0x0411 #CYRILLIC CAPITAL LETTER BE
+0x8442 0x0412 #CYRILLIC CAPITAL LETTER VE
+0x8443 0x0413 #CYRILLIC CAPITAL LETTER GHE
+0x8444 0x0414 #CYRILLIC CAPITAL LETTER DE
+0x8445 0x0415 #CYRILLIC CAPITAL LETTER IE
+0x8446 0x0401 #CYRILLIC CAPITAL LETTER IO
+0x8447 0x0416 #CYRILLIC CAPITAL LETTER ZHE
+0x8448 0x0417 #CYRILLIC CAPITAL LETTER ZE
+0x8449 0x0418 #CYRILLIC CAPITAL LETTER I
+0x844A 0x0419 #CYRILLIC CAPITAL LETTER SHORT I
+0x844B 0x041A #CYRILLIC CAPITAL LETTER KA
+0x844C 0x041B #CYRILLIC CAPITAL LETTER EL
+0x844D 0x041C #CYRILLIC CAPITAL LETTER EM
+0x844E 0x041D #CYRILLIC CAPITAL LETTER EN
+0x844F 0x041E #CYRILLIC CAPITAL LETTER O
+0x8450 0x041F #CYRILLIC CAPITAL LETTER PE
+0x8451 0x0420 #CYRILLIC CAPITAL LETTER ER
+0x8452 0x0421 #CYRILLIC CAPITAL LETTER ES
+0x8453 0x0422 #CYRILLIC CAPITAL LETTER TE
+0x8454 0x0423 #CYRILLIC CAPITAL LETTER U
+0x8455 0x0424 #CYRILLIC CAPITAL LETTER EF
+0x8456 0x0425 #CYRILLIC CAPITAL LETTER HA
+0x8457 0x0426 #CYRILLIC CAPITAL LETTER TSE
+0x8458 0x0427 #CYRILLIC CAPITAL LETTER CHE
+0x8459 0x0428 #CYRILLIC CAPITAL LETTER SHA
+0x845A 0x0429 #CYRILLIC CAPITAL LETTER SHCHA
+0x845B 0x042A #CYRILLIC CAPITAL LETTER HARD SIGN
+0x845C 0x042B #CYRILLIC CAPITAL LETTER YERU
+0x845D 0x042C #CYRILLIC CAPITAL LETTER SOFT SIGN
+0x845E 0x042D #CYRILLIC CAPITAL LETTER E
+0x845F 0x042E #CYRILLIC CAPITAL LETTER YU
+0x8460 0x042F #CYRILLIC CAPITAL LETTER YA
+0x8470 0x0430 #CYRILLIC SMALL LETTER A
+0x8471 0x0431 #CYRILLIC SMALL LETTER BE
+0x8472 0x0432 #CYRILLIC SMALL LETTER VE
+0x8473 0x0433 #CYRILLIC SMALL LETTER GHE
+0x8474 0x0434 #CYRILLIC SMALL LETTER DE
+0x8475 0x0435 #CYRILLIC SMALL LETTER IE
+0x8476 0x0451 #CYRILLIC SMALL LETTER IO
+0x8477 0x0436 #CYRILLIC SMALL LETTER ZHE
+0x8478 0x0437 #CYRILLIC SMALL LETTER ZE
+0x8479 0x0438 #CYRILLIC SMALL LETTER I
+0x847A 0x0439 #CYRILLIC SMALL LETTER SHORT I
+0x847B 0x043A #CYRILLIC SMALL LETTER KA
+0x847C 0x043B #CYRILLIC SMALL LETTER EL
+0x847D 0x043C #CYRILLIC SMALL LETTER EM
+0x847E 0x043D #CYRILLIC SMALL LETTER EN
+0x8480 0x043E #CYRILLIC SMALL LETTER O
+0x8481 0x043F #CYRILLIC SMALL LETTER PE
+0x8482 0x0440 #CYRILLIC SMALL LETTER ER
+0x8483 0x0441 #CYRILLIC SMALL LETTER ES
+0x8484 0x0442 #CYRILLIC SMALL LETTER TE
+0x8485 0x0443 #CYRILLIC SMALL LETTER U
+0x8486 0x0444 #CYRILLIC SMALL LETTER EF
+0x8487 0x0445 #CYRILLIC SMALL LETTER HA
+0x8488 0x0446 #CYRILLIC SMALL LETTER TSE
+0x8489 0x0447 #CYRILLIC SMALL LETTER CHE
+0x848A 0x0448 #CYRILLIC SMALL LETTER SHA
+0x848B 0x0449 #CYRILLIC SMALL LETTER SHCHA
+0x848C 0x044A #CYRILLIC SMALL LETTER HARD SIGN
+0x848D 0x044B #CYRILLIC SMALL LETTER YERU
+0x848E 0x044C #CYRILLIC SMALL LETTER SOFT SIGN
+0x848F 0x044D #CYRILLIC SMALL LETTER E
+0x8490 0x044E #CYRILLIC SMALL LETTER YU
+0x8491 0x044F #CYRILLIC SMALL LETTER YA
+0x849F 0x2500 #BOX DRAWINGS LIGHT HORIZONTAL
+0x84A0 0x2502 #BOX DRAWINGS LIGHT VERTICAL
+0x84A1 0x250C #BOX DRAWINGS LIGHT DOWN AND RIGHT
+0x84A2 0x2510 #BOX DRAWINGS LIGHT DOWN AND LEFT
+0x84A3 0x2518 #BOX DRAWINGS LIGHT UP AND LEFT
+0x84A4 0x2514 #BOX DRAWINGS LIGHT UP AND RIGHT
+0x84A5 0x251C #BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+0x84A6 0x252C #BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+0x84A7 0x2524 #BOX DRAWINGS LIGHT VERTICAL AND LEFT
+0x84A8 0x2534 #BOX DRAWINGS LIGHT UP AND HORIZONTAL
+0x84A9 0x253C #BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+0x84AA 0x2501 #BOX DRAWINGS HEAVY HORIZONTAL
+0x84AB 0x2503 #BOX DRAWINGS HEAVY VERTICAL
+0x84AC 0x250F #BOX DRAWINGS HEAVY DOWN AND RIGHT
+0x84AD 0x2513 #BOX DRAWINGS HEAVY DOWN AND LEFT
+0x84AE 0x251B #BOX DRAWINGS HEAVY UP AND LEFT
+0x84AF 0x2517 #BOX DRAWINGS HEAVY UP AND RIGHT
+0x84B0 0x2523 #BOX DRAWINGS HEAVY VERTICAL AND RIGHT
+0x84B1 0x2533 #BOX DRAWINGS HEAVY DOWN AND HORIZONTAL
+0x84B2 0x252B #BOX DRAWINGS HEAVY VERTICAL AND LEFT
+0x84B3 0x253B #BOX DRAWINGS HEAVY UP AND HORIZONTAL
+0x84B4 0x254B #BOX DRAWINGS HEAVY VERTICAL AND HORIZONTAL
+0x84B5 0x2520 #BOX DRAWINGS VERTICAL HEAVY AND RIGHT LIGHT
+0x84B6 0x252F #BOX DRAWINGS DOWN LIGHT AND HORIZONTAL HEAVY
+0x84B7 0x2528 #BOX DRAWINGS VERTICAL HEAVY AND LEFT LIGHT
+0x84B8 0x2537 #BOX DRAWINGS UP LIGHT AND HORIZONTAL HEAVY
+0x84B9 0x253F #BOX DRAWINGS VERTICAL LIGHT AND HORIZONTAL HEAVY
+0x84BA 0x251D #BOX DRAWINGS VERTICAL LIGHT AND RIGHT HEAVY
+0x84BB 0x2530 #BOX DRAWINGS DOWN HEAVY AND HORIZONTAL LIGHT
+0x84BC 0x2525 #BOX DRAWINGS VERTICAL LIGHT AND LEFT HEAVY
+0x84BD 0x2538 #BOX DRAWINGS UP HEAVY AND HORIZONTAL LIGHT
+0x84BE 0x2542 #BOX DRAWINGS VERTICAL HEAVY AND HORIZONTAL LIGHT
+0x8740 0x2460 #CIRCLED DIGIT ONE
+0x8741 0x2461 #CIRCLED DIGIT TWO
+0x8742 0x2462 #CIRCLED DIGIT THREE
+0x8743 0x2463 #CIRCLED DIGIT FOUR
+0x8744 0x2464 #CIRCLED DIGIT FIVE
+0x8745 0x2465 #CIRCLED DIGIT SIX
+0x8746 0x2466 #CIRCLED DIGIT SEVEN
+0x8747 0x2467 #CIRCLED DIGIT EIGHT
+0x8748 0x2468 #CIRCLED DIGIT NINE
+0x8749 0x2469 #CIRCLED NUMBER TEN
+0x874A 0x246A #CIRCLED NUMBER ELEVEN
+0x874B 0x246B #CIRCLED NUMBER TWELVE
+0x874C 0x246C #CIRCLED NUMBER THIRTEEN
+0x874D 0x246D #CIRCLED NUMBER FOURTEEN
+0x874E 0x246E #CIRCLED NUMBER FIFTEEN
+0x874F 0x246F #CIRCLED NUMBER SIXTEEN
+0x8750 0x2470 #CIRCLED NUMBER SEVENTEEN
+0x8751 0x2471 #CIRCLED NUMBER EIGHTEEN
+0x8752 0x2472 #CIRCLED NUMBER NINETEEN
+0x8753 0x2473 #CIRCLED NUMBER TWENTY
+0x8754 0x2160 #ROMAN NUMERAL ONE
+0x8755 0x2161 #ROMAN NUMERAL TWO
+0x8756 0x2162 #ROMAN NUMERAL THREE
+0x8757 0x2163 #ROMAN NUMERAL FOUR
+0x8758 0x2164 #ROMAN NUMERAL FIVE
+0x8759 0x2165 #ROMAN NUMERAL SIX
+0x875A 0x2166 #ROMAN NUMERAL SEVEN
+0x875B 0x2167 #ROMAN NUMERAL EIGHT
+0x875C 0x2168 #ROMAN NUMERAL NINE
+0x875D 0x2169 #ROMAN NUMERAL TEN
+0x875F 0x3349 #SQUARE MIRI
+0x8760 0x3314 #SQUARE KIRO
+0x8761 0x3322 #SQUARE SENTI
+0x8762 0x334D #SQUARE MEETORU
+0x8763 0x3318 #SQUARE GURAMU
+0x8764 0x3327 #SQUARE TON
+0x8765 0x3303 #SQUARE AARU
+0x8766 0x3336 #SQUARE HEKUTAARU
+0x8767 0x3351 #SQUARE RITTORU
+0x8768 0x3357 #SQUARE WATTO
+0x8769 0x330D #SQUARE KARORII
+0x876A 0x3326 #SQUARE DORU
+0x876B 0x3323 #SQUARE SENTO
+0x876C 0x332B #SQUARE PAASENTO
+0x876D 0x334A #SQUARE MIRIBAARU
+0x876E 0x333B #SQUARE PEEZI
+0x876F 0x339C #SQUARE MM
+0x8770 0x339D #SQUARE CM
+0x8771 0x339E #SQUARE KM
+0x8772 0x338E #SQUARE MG
+0x8773 0x338F #SQUARE KG
+0x8774 0x33C4 #SQUARE CC
+0x8775 0x33A1 #SQUARE M SQUARED
+0x877E 0x337B #SQUARE ERA NAME HEISEI
+0x8780 0x301D #REVERSED DOUBLE PRIME QUOTATION MARK
+0x8781 0x301F #LOW DOUBLE PRIME QUOTATION MARK
+0x8782 0x2116 #NUMERO SIGN
+0x8783 0x33CD #SQUARE KK
+0x8784 0x2121 #TELEPHONE SIGN
+0x8785 0x32A4 #CIRCLED IDEOGRAPH HIGH
+0x8786 0x32A5 #CIRCLED IDEOGRAPH CENTRE
+0x8787 0x32A6 #CIRCLED IDEOGRAPH LOW
+0x8788 0x32A7 #CIRCLED IDEOGRAPH LEFT
+0x8789 0x32A8 #CIRCLED IDEOGRAPH RIGHT
+0x878A 0x3231 #PARENTHESIZED IDEOGRAPH STOCK
+0x878B 0x3232 #PARENTHESIZED IDEOGRAPH HAVE
+0x878C 0x3239 #PARENTHESIZED IDEOGRAPH REPRESENT
+0x878D 0x337E #SQUARE ERA NAME MEIZI
+0x878E 0x337D #SQUARE ERA NAME TAISYOU
+0x878F 0x337C #SQUARE ERA NAME SYOUWA
+0x8790 0x2252 #APPROXIMATELY EQUAL TO OR THE IMAGE OF
+0x8791 0x2261 #IDENTICAL TO
+0x8792 0x222B #INTEGRAL
+0x8793 0x222E #CONTOUR INTEGRAL
+0x8794 0x2211 #N-ARY SUMMATION
+0x8795 0x221A #SQUARE ROOT
+0x8796 0x22A5 #UP TACK
+0x8797 0x2220 #ANGLE
+0x8798 0x221F #RIGHT ANGLE
+0x8799 0x22BF #RIGHT TRIANGLE
+0x879A 0x2235 #BECAUSE
+0x879B 0x2229 #INTERSECTION
+0x879C 0x222A #UNION
+0x889F 0x4E9C #CJK UNIFIED IDEOGRAPH
+0x88A0 0x5516 #CJK UNIFIED IDEOGRAPH
+0x88A1 0x5A03 #CJK UNIFIED IDEOGRAPH
+0x88A2 0x963F #CJK UNIFIED IDEOGRAPH
+0x88A3 0x54C0 #CJK UNIFIED IDEOGRAPH
+0x88A4 0x611B #CJK UNIFIED IDEOGRAPH
+0x88A5 0x6328 #CJK UNIFIED IDEOGRAPH
+0x88A6 0x59F6 #CJK UNIFIED IDEOGRAPH
+0x88A7 0x9022 #CJK UNIFIED IDEOGRAPH
+0x88A8 0x8475 #CJK UNIFIED IDEOGRAPH
+0x88A9 0x831C #CJK UNIFIED IDEOGRAPH
+0x88AA 0x7A50 #CJK UNIFIED IDEOGRAPH
+0x88AB 0x60AA #CJK UNIFIED IDEOGRAPH
+0x88AC 0x63E1 #CJK UNIFIED IDEOGRAPH
+0x88AD 0x6E25 #CJK UNIFIED IDEOGRAPH
+0x88AE 0x65ED #CJK UNIFIED IDEOGRAPH
+0x88AF 0x8466 #CJK UNIFIED IDEOGRAPH
+0x88B0 0x82A6 #CJK UNIFIED IDEOGRAPH
+0x88B1 0x9BF5 #CJK UNIFIED IDEOGRAPH
+0x88B2 0x6893 #CJK UNIFIED IDEOGRAPH
+0x88B3 0x5727 #CJK UNIFIED IDEOGRAPH
+0x88B4 0x65A1 #CJK UNIFIED IDEOGRAPH
+0x88B5 0x6271 #CJK UNIFIED IDEOGRAPH
+0x88B6 0x5B9B #CJK UNIFIED IDEOGRAPH
+0x88B7 0x59D0 #CJK UNIFIED IDEOGRAPH
+0x88B8 0x867B #CJK UNIFIED IDEOGRAPH
+0x88B9 0x98F4 #CJK UNIFIED IDEOGRAPH
+0x88BA 0x7D62 #CJK UNIFIED IDEOGRAPH
+0x88BB 0x7DBE #CJK UNIFIED IDEOGRAPH
+0x88BC 0x9B8E #CJK UNIFIED IDEOGRAPH
+0x88BD 0x6216 #CJK UNIFIED IDEOGRAPH
+0x88BE 0x7C9F #CJK UNIFIED IDEOGRAPH
+0x88BF 0x88B7 #CJK UNIFIED IDEOGRAPH
+0x88C0 0x5B89 #CJK UNIFIED IDEOGRAPH
+0x88C1 0x5EB5 #CJK UNIFIED IDEOGRAPH
+0x88C2 0x6309 #CJK UNIFIED IDEOGRAPH
+0x88C3 0x6697 #CJK UNIFIED IDEOGRAPH
+0x88C4 0x6848 #CJK UNIFIED IDEOGRAPH
+0x88C5 0x95C7 #CJK UNIFIED IDEOGRAPH
+0x88C6 0x978D #CJK UNIFIED IDEOGRAPH
+0x88C7 0x674F #CJK UNIFIED IDEOGRAPH
+0x88C8 0x4EE5 #CJK UNIFIED IDEOGRAPH
+0x88C9 0x4F0A #CJK UNIFIED IDEOGRAPH
+0x88CA 0x4F4D #CJK UNIFIED IDEOGRAPH
+0x88CB 0x4F9D #CJK UNIFIED IDEOGRAPH
+0x88CC 0x5049 #CJK UNIFIED IDEOGRAPH
+0x88CD 0x56F2 #CJK UNIFIED IDEOGRAPH
+0x88CE 0x5937 #CJK UNIFIED IDEOGRAPH
+0x88CF 0x59D4 #CJK UNIFIED IDEOGRAPH
+0x88D0 0x5A01 #CJK UNIFIED IDEOGRAPH
+0x88D1 0x5C09 #CJK UNIFIED IDEOGRAPH
+0x88D2 0x60DF #CJK UNIFIED IDEOGRAPH
+0x88D3 0x610F #CJK UNIFIED IDEOGRAPH
+0x88D4 0x6170 #CJK UNIFIED IDEOGRAPH
+0x88D5 0x6613 #CJK UNIFIED IDEOGRAPH
+0x88D6 0x6905 #CJK UNIFIED IDEOGRAPH
+0x88D7 0x70BA #CJK UNIFIED IDEOGRAPH
+0x88D8 0x754F #CJK UNIFIED IDEOGRAPH
+0x88D9 0x7570 #CJK UNIFIED IDEOGRAPH
+0x88DA 0x79FB #CJK UNIFIED IDEOGRAPH
+0x88DB 0x7DAD #CJK UNIFIED IDEOGRAPH
+0x88DC 0x7DEF #CJK UNIFIED IDEOGRAPH
+0x88DD 0x80C3 #CJK UNIFIED IDEOGRAPH
+0x88DE 0x840E #CJK UNIFIED IDEOGRAPH
+0x88DF 0x8863 #CJK UNIFIED IDEOGRAPH
+0x88E0 0x8B02 #CJK UNIFIED IDEOGRAPH
+0x88E1 0x9055 #CJK UNIFIED IDEOGRAPH
+0x88E2 0x907A #CJK UNIFIED IDEOGRAPH
+0x88E3 0x533B #CJK UNIFIED IDEOGRAPH
+0x88E4 0x4E95 #CJK UNIFIED IDEOGRAPH
+0x88E5 0x4EA5 #CJK UNIFIED IDEOGRAPH
+0x88E6 0x57DF #CJK UNIFIED IDEOGRAPH
+0x88E7 0x80B2 #CJK UNIFIED IDEOGRAPH
+0x88E8 0x90C1 #CJK UNIFIED IDEOGRAPH
+0x88E9 0x78EF #CJK UNIFIED IDEOGRAPH
+0x88EA 0x4E00 #CJK UNIFIED IDEOGRAPH
+0x88EB 0x58F1 #CJK UNIFIED IDEOGRAPH
+0x88EC 0x6EA2 #CJK UNIFIED IDEOGRAPH
+0x88ED 0x9038 #CJK UNIFIED IDEOGRAPH
+0x88EE 0x7A32 #CJK UNIFIED IDEOGRAPH
+0x88EF 0x8328 #CJK UNIFIED IDEOGRAPH
+0x88F0 0x828B #CJK UNIFIED IDEOGRAPH
+0x88F1 0x9C2F #CJK UNIFIED IDEOGRAPH
+0x88F2 0x5141 #CJK UNIFIED IDEOGRAPH
+0x88F3 0x5370 #CJK UNIFIED IDEOGRAPH
+0x88F4 0x54BD #CJK UNIFIED IDEOGRAPH
+0x88F5 0x54E1 #CJK UNIFIED IDEOGRAPH
+0x88F6 0x56E0 #CJK UNIFIED IDEOGRAPH
+0x88F7 0x59FB #CJK UNIFIED IDEOGRAPH
+0x88F8 0x5F15 #CJK UNIFIED IDEOGRAPH
+0x88F9 0x98F2 #CJK UNIFIED IDEOGRAPH
+0x88FA 0x6DEB #CJK UNIFIED IDEOGRAPH
+0x88FB 0x80E4 #CJK UNIFIED IDEOGRAPH
+0x88FC 0x852D #CJK UNIFIED IDEOGRAPH
+0x8940 0x9662 #CJK UNIFIED IDEOGRAPH
+0x8941 0x9670 #CJK UNIFIED IDEOGRAPH
+0x8942 0x96A0 #CJK UNIFIED IDEOGRAPH
+0x8943 0x97FB #CJK UNIFIED IDEOGRAPH
+0x8944 0x540B #CJK UNIFIED IDEOGRAPH
+0x8945 0x53F3 #CJK UNIFIED IDEOGRAPH
+0x8946 0x5B87 #CJK UNIFIED IDEOGRAPH
+0x8947 0x70CF #CJK UNIFIED IDEOGRAPH
+0x8948 0x7FBD #CJK UNIFIED IDEOGRAPH
+0x8949 0x8FC2 #CJK UNIFIED IDEOGRAPH
+0x894A 0x96E8 #CJK UNIFIED IDEOGRAPH
+0x894B 0x536F #CJK UNIFIED IDEOGRAPH
+0x894C 0x9D5C #CJK UNIFIED IDEOGRAPH
+0x894D 0x7ABA #CJK UNIFIED IDEOGRAPH
+0x894E 0x4E11 #CJK UNIFIED IDEOGRAPH
+0x894F 0x7893 #CJK UNIFIED IDEOGRAPH
+0x8950 0x81FC #CJK UNIFIED IDEOGRAPH
+0x8951 0x6E26 #CJK UNIFIED IDEOGRAPH
+0x8952 0x5618 #CJK UNIFIED IDEOGRAPH
+0x8953 0x5504 #CJK UNIFIED IDEOGRAPH
+0x8954 0x6B1D #CJK UNIFIED IDEOGRAPH
+0x8955 0x851A #CJK UNIFIED IDEOGRAPH
+0x8956 0x9C3B #CJK UNIFIED IDEOGRAPH
+0x8957 0x59E5 #CJK UNIFIED IDEOGRAPH
+0x8958 0x53A9 #CJK UNIFIED IDEOGRAPH
+0x8959 0x6D66 #CJK UNIFIED IDEOGRAPH
+0x895A 0x74DC #CJK UNIFIED IDEOGRAPH
+0x895B 0x958F #CJK UNIFIED IDEOGRAPH
+0x895C 0x5642 #CJK UNIFIED IDEOGRAPH
+0x895D 0x4E91 #CJK UNIFIED IDEOGRAPH
+0x895E 0x904B #CJK UNIFIED IDEOGRAPH
+0x895F 0x96F2 #CJK UNIFIED IDEOGRAPH
+0x8960 0x834F #CJK UNIFIED IDEOGRAPH
+0x8961 0x990C #CJK UNIFIED IDEOGRAPH
+0x8962 0x53E1 #CJK UNIFIED IDEOGRAPH
+0x8963 0x55B6 #CJK UNIFIED IDEOGRAPH
+0x8964 0x5B30 #CJK UNIFIED IDEOGRAPH
+0x8965 0x5F71 #CJK UNIFIED IDEOGRAPH
+0x8966 0x6620 #CJK UNIFIED IDEOGRAPH
+0x8967 0x66F3 #CJK UNIFIED IDEOGRAPH
+0x8968 0x6804 #CJK UNIFIED IDEOGRAPH
+0x8969 0x6C38 #CJK UNIFIED IDEOGRAPH
+0x896A 0x6CF3 #CJK UNIFIED IDEOGRAPH
+0x896B 0x6D29 #CJK UNIFIED IDEOGRAPH
+0x896C 0x745B #CJK UNIFIED IDEOGRAPH
+0x896D 0x76C8 #CJK UNIFIED IDEOGRAPH
+0x896E 0x7A4E #CJK UNIFIED IDEOGRAPH
+0x896F 0x9834 #CJK UNIFIED IDEOGRAPH
+0x8970 0x82F1 #CJK UNIFIED IDEOGRAPH
+0x8971 0x885B #CJK UNIFIED IDEOGRAPH
+0x8972 0x8A60 #CJK UNIFIED IDEOGRAPH
+0x8973 0x92ED #CJK UNIFIED IDEOGRAPH
+0x8974 0x6DB2 #CJK UNIFIED IDEOGRAPH
+0x8975 0x75AB #CJK UNIFIED IDEOGRAPH
+0x8976 0x76CA #CJK UNIFIED IDEOGRAPH
+0x8977 0x99C5 #CJK UNIFIED IDEOGRAPH
+0x8978 0x60A6 #CJK UNIFIED IDEOGRAPH
+0x8979 0x8B01 #CJK UNIFIED IDEOGRAPH
+0x897A 0x8D8A #CJK UNIFIED IDEOGRAPH
+0x897B 0x95B2 #CJK UNIFIED IDEOGRAPH
+0x897C 0x698E #CJK UNIFIED IDEOGRAPH
+0x897D 0x53AD #CJK UNIFIED IDEOGRAPH
+0x897E 0x5186 #CJK UNIFIED IDEOGRAPH
+0x8980 0x5712 #CJK UNIFIED IDEOGRAPH
+0x8981 0x5830 #CJK UNIFIED IDEOGRAPH
+0x8982 0x5944 #CJK UNIFIED IDEOGRAPH
+0x8983 0x5BB4 #CJK UNIFIED IDEOGRAPH
+0x8984 0x5EF6 #CJK UNIFIED IDEOGRAPH
+0x8985 0x6028 #CJK UNIFIED IDEOGRAPH
+0x8986 0x63A9 #CJK UNIFIED IDEOGRAPH
+0x8987 0x63F4 #CJK UNIFIED IDEOGRAPH
+0x8988 0x6CBF #CJK UNIFIED IDEOGRAPH
+0x8989 0x6F14 #CJK UNIFIED IDEOGRAPH
+0x898A 0x708E #CJK UNIFIED IDEOGRAPH
+0x898B 0x7114 #CJK UNIFIED IDEOGRAPH
+0x898C 0x7159 #CJK UNIFIED IDEOGRAPH
+0x898D 0x71D5 #CJK UNIFIED IDEOGRAPH
+0x898E 0x733F #CJK UNIFIED IDEOGRAPH
+0x898F 0x7E01 #CJK UNIFIED IDEOGRAPH
+0x8990 0x8276 #CJK UNIFIED IDEOGRAPH
+0x8991 0x82D1 #CJK UNIFIED IDEOGRAPH
+0x8992 0x8597 #CJK UNIFIED IDEOGRAPH
+0x8993 0x9060 #CJK UNIFIED IDEOGRAPH
+0x8994 0x925B #CJK UNIFIED IDEOGRAPH
+0x8995 0x9D1B #CJK UNIFIED IDEOGRAPH
+0x8996 0x5869 #CJK UNIFIED IDEOGRAPH
+0x8997 0x65BC #CJK UNIFIED IDEOGRAPH
+0x8998 0x6C5A #CJK UNIFIED IDEOGRAPH
+0x8999 0x7525 #CJK UNIFIED IDEOGRAPH
+0x899A 0x51F9 #CJK UNIFIED IDEOGRAPH
+0x899B 0x592E #CJK UNIFIED IDEOGRAPH
+0x899C 0x5965 #CJK UNIFIED IDEOGRAPH
+0x899D 0x5F80 #CJK UNIFIED IDEOGRAPH
+0x899E 0x5FDC #CJK UNIFIED IDEOGRAPH
+0x899F 0x62BC #CJK UNIFIED IDEOGRAPH
+0x89A0 0x65FA #CJK UNIFIED IDEOGRAPH
+0x89A1 0x6A2A #CJK UNIFIED IDEOGRAPH
+0x89A2 0x6B27 #CJK UNIFIED IDEOGRAPH
+0x89A3 0x6BB4 #CJK UNIFIED IDEOGRAPH
+0x89A4 0x738B #CJK UNIFIED IDEOGRAPH
+0x89A5 0x7FC1 #CJK UNIFIED IDEOGRAPH
+0x89A6 0x8956 #CJK UNIFIED IDEOGRAPH
+0x89A7 0x9D2C #CJK UNIFIED IDEOGRAPH
+0x89A8 0x9D0E #CJK UNIFIED IDEOGRAPH
+0x89A9 0x9EC4 #CJK UNIFIED IDEOGRAPH
+0x89AA 0x5CA1 #CJK UNIFIED IDEOGRAPH
+0x89AB 0x6C96 #CJK UNIFIED IDEOGRAPH
+0x89AC 0x837B #CJK UNIFIED IDEOGRAPH
+0x89AD 0x5104 #CJK UNIFIED IDEOGRAPH
+0x89AE 0x5C4B #CJK UNIFIED IDEOGRAPH
+0x89AF 0x61B6 #CJK UNIFIED IDEOGRAPH
+0x89B0 0x81C6 #CJK UNIFIED IDEOGRAPH
+0x89B1 0x6876 #CJK UNIFIED IDEOGRAPH
+0x89B2 0x7261 #CJK UNIFIED IDEOGRAPH
+0x89B3 0x4E59 #CJK UNIFIED IDEOGRAPH
+0x89B4 0x4FFA #CJK UNIFIED IDEOGRAPH
+0x89B5 0x5378 #CJK UNIFIED IDEOGRAPH
+0x89B6 0x6069 #CJK UNIFIED IDEOGRAPH
+0x89B7 0x6E29 #CJK UNIFIED IDEOGRAPH
+0x89B8 0x7A4F #CJK UNIFIED IDEOGRAPH
+0x89B9 0x97F3 #CJK UNIFIED IDEOGRAPH
+0x89BA 0x4E0B #CJK UNIFIED IDEOGRAPH
+0x89BB 0x5316 #CJK UNIFIED IDEOGRAPH
+0x89BC 0x4EEE #CJK UNIFIED IDEOGRAPH
+0x89BD 0x4F55 #CJK UNIFIED IDEOGRAPH
+0x89BE 0x4F3D #CJK UNIFIED IDEOGRAPH
+0x89BF 0x4FA1 #CJK UNIFIED IDEOGRAPH
+0x89C0 0x4F73 #CJK UNIFIED IDEOGRAPH
+0x89C1 0x52A0 #CJK UNIFIED IDEOGRAPH
+0x89C2 0x53EF #CJK UNIFIED IDEOGRAPH
+0x89C3 0x5609 #CJK UNIFIED IDEOGRAPH
+0x89C4 0x590F #CJK UNIFIED IDEOGRAPH
+0x89C5 0x5AC1 #CJK UNIFIED IDEOGRAPH
+0x89C6 0x5BB6 #CJK UNIFIED IDEOGRAPH
+0x89C7 0x5BE1 #CJK UNIFIED IDEOGRAPH
+0x89C8 0x79D1 #CJK UNIFIED IDEOGRAPH
+0x89C9 0x6687 #CJK UNIFIED IDEOGRAPH
+0x89CA 0x679C #CJK UNIFIED IDEOGRAPH
+0x89CB 0x67B6 #CJK UNIFIED IDEOGRAPH
+0x89CC 0x6B4C #CJK UNIFIED IDEOGRAPH
+0x89CD 0x6CB3 #CJK UNIFIED IDEOGRAPH
+0x89CE 0x706B #CJK UNIFIED IDEOGRAPH
+0x89CF 0x73C2 #CJK UNIFIED IDEOGRAPH
+0x89D0 0x798D #CJK UNIFIED IDEOGRAPH
+0x89D1 0x79BE #CJK UNIFIED IDEOGRAPH
+0x89D2 0x7A3C #CJK UNIFIED IDEOGRAPH
+0x89D3 0x7B87 #CJK UNIFIED IDEOGRAPH
+0x89D4 0x82B1 #CJK UNIFIED IDEOGRAPH
+0x89D5 0x82DB #CJK UNIFIED IDEOGRAPH
+0x89D6 0x8304 #CJK UNIFIED IDEOGRAPH
+0x89D7 0x8377 #CJK UNIFIED IDEOGRAPH
+0x89D8 0x83EF #CJK UNIFIED IDEOGRAPH
+0x89D9 0x83D3 #CJK UNIFIED IDEOGRAPH
+0x89DA 0x8766 #CJK UNIFIED IDEOGRAPH
+0x89DB 0x8AB2 #CJK UNIFIED IDEOGRAPH
+0x89DC 0x5629 #CJK UNIFIED IDEOGRAPH
+0x89DD 0x8CA8 #CJK UNIFIED IDEOGRAPH
+0x89DE 0x8FE6 #CJK UNIFIED IDEOGRAPH
+0x89DF 0x904E #CJK UNIFIED IDEOGRAPH
+0x89E0 0x971E #CJK UNIFIED IDEOGRAPH
+0x89E1 0x868A #CJK UNIFIED IDEOGRAPH
+0x89E2 0x4FC4 #CJK UNIFIED IDEOGRAPH
+0x89E3 0x5CE8 #CJK UNIFIED IDEOGRAPH
+0x89E4 0x6211 #CJK UNIFIED IDEOGRAPH
+0x89E5 0x7259 #CJK UNIFIED IDEOGRAPH
+0x89E6 0x753B #CJK UNIFIED IDEOGRAPH
+0x89E7 0x81E5 #CJK UNIFIED IDEOGRAPH
+0x89E8 0x82BD #CJK UNIFIED IDEOGRAPH
+0x89E9 0x86FE #CJK UNIFIED IDEOGRAPH
+0x89EA 0x8CC0 #CJK UNIFIED IDEOGRAPH
+0x89EB 0x96C5 #CJK UNIFIED IDEOGRAPH
+0x89EC 0x9913 #CJK UNIFIED IDEOGRAPH
+0x89ED 0x99D5 #CJK UNIFIED IDEOGRAPH
+0x89EE 0x4ECB #CJK UNIFIED IDEOGRAPH
+0x89EF 0x4F1A #CJK UNIFIED IDEOGRAPH
+0x89F0 0x89E3 #CJK UNIFIED IDEOGRAPH
+0x89F1 0x56DE #CJK UNIFIED IDEOGRAPH
+0x89F2 0x584A #CJK UNIFIED IDEOGRAPH
+0x89F3 0x58CA #CJK UNIFIED IDEOGRAPH
+0x89F4 0x5EFB #CJK UNIFIED IDEOGRAPH
+0x89F5 0x5FEB #CJK UNIFIED IDEOGRAPH
+0x89F6 0x602A #CJK UNIFIED IDEOGRAPH
+0x89F7 0x6094 #CJK UNIFIED IDEOGRAPH
+0x89F8 0x6062 #CJK UNIFIED IDEOGRAPH
+0x89F9 0x61D0 #CJK UNIFIED IDEOGRAPH
+0x89FA 0x6212 #CJK UNIFIED IDEOGRAPH
+0x89FB 0x62D0 #CJK UNIFIED IDEOGRAPH
+0x89FC 0x6539 #CJK UNIFIED IDEOGRAPH
+0x8A40 0x9B41 #CJK UNIFIED IDEOGRAPH
+0x8A41 0x6666 #CJK UNIFIED IDEOGRAPH
+0x8A42 0x68B0 #CJK UNIFIED IDEOGRAPH
+0x8A43 0x6D77 #CJK UNIFIED IDEOGRAPH
+0x8A44 0x7070 #CJK UNIFIED IDEOGRAPH
+0x8A45 0x754C #CJK UNIFIED IDEOGRAPH
+0x8A46 0x7686 #CJK UNIFIED IDEOGRAPH
+0x8A47 0x7D75 #CJK UNIFIED IDEOGRAPH
+0x8A48 0x82A5 #CJK UNIFIED IDEOGRAPH
+0x8A49 0x87F9 #CJK UNIFIED IDEOGRAPH
+0x8A4A 0x958B #CJK UNIFIED IDEOGRAPH
+0x8A4B 0x968E #CJK UNIFIED IDEOGRAPH
+0x8A4C 0x8C9D #CJK UNIFIED IDEOGRAPH
+0x8A4D 0x51F1 #CJK UNIFIED IDEOGRAPH
+0x8A4E 0x52BE #CJK UNIFIED IDEOGRAPH
+0x8A4F 0x5916 #CJK UNIFIED IDEOGRAPH
+0x8A50 0x54B3 #CJK UNIFIED IDEOGRAPH
+0x8A51 0x5BB3 #CJK UNIFIED IDEOGRAPH
+0x8A52 0x5D16 #CJK UNIFIED IDEOGRAPH
+0x8A53 0x6168 #CJK UNIFIED IDEOGRAPH
+0x8A54 0x6982 #CJK UNIFIED IDEOGRAPH
+0x8A55 0x6DAF #CJK UNIFIED IDEOGRAPH
+0x8A56 0x788D #CJK UNIFIED IDEOGRAPH
+0x8A57 0x84CB #CJK UNIFIED IDEOGRAPH
+0x8A58 0x8857 #CJK UNIFIED IDEOGRAPH
+0x8A59 0x8A72 #CJK UNIFIED IDEOGRAPH
+0x8A5A 0x93A7 #CJK UNIFIED IDEOGRAPH
+0x8A5B 0x9AB8 #CJK UNIFIED IDEOGRAPH
+0x8A5C 0x6D6C #CJK UNIFIED IDEOGRAPH
+0x8A5D 0x99A8 #CJK UNIFIED IDEOGRAPH
+0x8A5E 0x86D9 #CJK UNIFIED IDEOGRAPH
+0x8A5F 0x57A3 #CJK UNIFIED IDEOGRAPH
+0x8A60 0x67FF #CJK UNIFIED IDEOGRAPH
+0x8A61 0x86CE #CJK UNIFIED IDEOGRAPH
+0x8A62 0x920E #CJK UNIFIED IDEOGRAPH
+0x8A63 0x5283 #CJK UNIFIED IDEOGRAPH
+0x8A64 0x5687 #CJK UNIFIED IDEOGRAPH
+0x8A65 0x5404 #CJK UNIFIED IDEOGRAPH
+0x8A66 0x5ED3 #CJK UNIFIED IDEOGRAPH
+0x8A67 0x62E1 #CJK UNIFIED IDEOGRAPH
+0x8A68 0x64B9 #CJK UNIFIED IDEOGRAPH
+0x8A69 0x683C #CJK UNIFIED IDEOGRAPH
+0x8A6A 0x6838 #CJK UNIFIED IDEOGRAPH
+0x8A6B 0x6BBB #CJK UNIFIED IDEOGRAPH
+0x8A6C 0x7372 #CJK UNIFIED IDEOGRAPH
+0x8A6D 0x78BA #CJK UNIFIED IDEOGRAPH
+0x8A6E 0x7A6B #CJK UNIFIED IDEOGRAPH
+0x8A6F 0x899A #CJK UNIFIED IDEOGRAPH
+0x8A70 0x89D2 #CJK UNIFIED IDEOGRAPH
+0x8A71 0x8D6B #CJK UNIFIED IDEOGRAPH
+0x8A72 0x8F03 #CJK UNIFIED IDEOGRAPH
+0x8A73 0x90ED #CJK UNIFIED IDEOGRAPH
+0x8A74 0x95A3 #CJK UNIFIED IDEOGRAPH
+0x8A75 0x9694 #CJK UNIFIED IDEOGRAPH
+0x8A76 0x9769 #CJK UNIFIED IDEOGRAPH
+0x8A77 0x5B66 #CJK UNIFIED IDEOGRAPH
+0x8A78 0x5CB3 #CJK UNIFIED IDEOGRAPH
+0x8A79 0x697D #CJK UNIFIED IDEOGRAPH
+0x8A7A 0x984D #CJK UNIFIED IDEOGRAPH
+0x8A7B 0x984E #CJK UNIFIED IDEOGRAPH
+0x8A7C 0x639B #CJK UNIFIED IDEOGRAPH
+0x8A7D 0x7B20 #CJK UNIFIED IDEOGRAPH
+0x8A7E 0x6A2B #CJK UNIFIED IDEOGRAPH
+0x8A80 0x6A7F #CJK UNIFIED IDEOGRAPH
+0x8A81 0x68B6 #CJK UNIFIED IDEOGRAPH
+0x8A82 0x9C0D #CJK UNIFIED IDEOGRAPH
+0x8A83 0x6F5F #CJK UNIFIED IDEOGRAPH
+0x8A84 0x5272 #CJK UNIFIED IDEOGRAPH
+0x8A85 0x559D #CJK UNIFIED IDEOGRAPH
+0x8A86 0x6070 #CJK UNIFIED IDEOGRAPH
+0x8A87 0x62EC #CJK UNIFIED IDEOGRAPH
+0x8A88 0x6D3B #CJK UNIFIED IDEOGRAPH
+0x8A89 0x6E07 #CJK UNIFIED IDEOGRAPH
+0x8A8A 0x6ED1 #CJK UNIFIED IDEOGRAPH
+0x8A8B 0x845B #CJK UNIFIED IDEOGRAPH
+0x8A8C 0x8910 #CJK UNIFIED IDEOGRAPH
+0x8A8D 0x8F44 #CJK UNIFIED IDEOGRAPH
+0x8A8E 0x4E14 #CJK UNIFIED IDEOGRAPH
+0x8A8F 0x9C39 #CJK UNIFIED IDEOGRAPH
+0x8A90 0x53F6 #CJK UNIFIED IDEOGRAPH
+0x8A91 0x691B #CJK UNIFIED IDEOGRAPH
+0x8A92 0x6A3A #CJK UNIFIED IDEOGRAPH
+0x8A93 0x9784 #CJK UNIFIED IDEOGRAPH
+0x8A94 0x682A #CJK UNIFIED IDEOGRAPH
+0x8A95 0x515C #CJK UNIFIED IDEOGRAPH
+0x8A96 0x7AC3 #CJK UNIFIED IDEOGRAPH
+0x8A97 0x84B2 #CJK UNIFIED IDEOGRAPH
+0x8A98 0x91DC #CJK UNIFIED IDEOGRAPH
+0x8A99 0x938C #CJK UNIFIED IDEOGRAPH
+0x8A9A 0x565B #CJK UNIFIED IDEOGRAPH
+0x8A9B 0x9D28 #CJK UNIFIED IDEOGRAPH
+0x8A9C 0x6822 #CJK UNIFIED IDEOGRAPH
+0x8A9D 0x8305 #CJK UNIFIED IDEOGRAPH
+0x8A9E 0x8431 #CJK UNIFIED IDEOGRAPH
+0x8A9F 0x7CA5 #CJK UNIFIED IDEOGRAPH
+0x8AA0 0x5208 #CJK UNIFIED IDEOGRAPH
+0x8AA1 0x82C5 #CJK UNIFIED IDEOGRAPH
+0x8AA2 0x74E6 #CJK UNIFIED IDEOGRAPH
+0x8AA3 0x4E7E #CJK UNIFIED IDEOGRAPH
+0x8AA4 0x4F83 #CJK UNIFIED IDEOGRAPH
+0x8AA5 0x51A0 #CJK UNIFIED IDEOGRAPH
+0x8AA6 0x5BD2 #CJK UNIFIED IDEOGRAPH
+0x8AA7 0x520A #CJK UNIFIED IDEOGRAPH
+0x8AA8 0x52D8 #CJK UNIFIED IDEOGRAPH
+0x8AA9 0x52E7 #CJK UNIFIED IDEOGRAPH
+0x8AAA 0x5DFB #CJK UNIFIED IDEOGRAPH
+0x8AAB 0x559A #CJK UNIFIED IDEOGRAPH
+0x8AAC 0x582A #CJK UNIFIED IDEOGRAPH
+0x8AAD 0x59E6 #CJK UNIFIED IDEOGRAPH
+0x8AAE 0x5B8C #CJK UNIFIED IDEOGRAPH
+0x8AAF 0x5B98 #CJK UNIFIED IDEOGRAPH
+0x8AB0 0x5BDB #CJK UNIFIED IDEOGRAPH
+0x8AB1 0x5E72 #CJK UNIFIED IDEOGRAPH
+0x8AB2 0x5E79 #CJK UNIFIED IDEOGRAPH
+0x8AB3 0x60A3 #CJK UNIFIED IDEOGRAPH
+0x8AB4 0x611F #CJK UNIFIED IDEOGRAPH
+0x8AB5 0x6163 #CJK UNIFIED IDEOGRAPH
+0x8AB6 0x61BE #CJK UNIFIED IDEOGRAPH
+0x8AB7 0x63DB #CJK UNIFIED IDEOGRAPH
+0x8AB8 0x6562 #CJK UNIFIED IDEOGRAPH
+0x8AB9 0x67D1 #CJK UNIFIED IDEOGRAPH
+0x8ABA 0x6853 #CJK UNIFIED IDEOGRAPH
+0x8ABB 0x68FA #CJK UNIFIED IDEOGRAPH
+0x8ABC 0x6B3E #CJK UNIFIED IDEOGRAPH
+0x8ABD 0x6B53 #CJK UNIFIED IDEOGRAPH
+0x8ABE 0x6C57 #CJK UNIFIED IDEOGRAPH
+0x8ABF 0x6F22 #CJK UNIFIED IDEOGRAPH
+0x8AC0 0x6F97 #CJK UNIFIED IDEOGRAPH
+0x8AC1 0x6F45 #CJK UNIFIED IDEOGRAPH
+0x8AC2 0x74B0 #CJK UNIFIED IDEOGRAPH
+0x8AC3 0x7518 #CJK UNIFIED IDEOGRAPH
+0x8AC4 0x76E3 #CJK UNIFIED IDEOGRAPH
+0x8AC5 0x770B #CJK UNIFIED IDEOGRAPH
+0x8AC6 0x7AFF #CJK UNIFIED IDEOGRAPH
+0x8AC7 0x7BA1 #CJK UNIFIED IDEOGRAPH
+0x8AC8 0x7C21 #CJK UNIFIED IDEOGRAPH
+0x8AC9 0x7DE9 #CJK UNIFIED IDEOGRAPH
+0x8ACA 0x7F36 #CJK UNIFIED IDEOGRAPH
+0x8ACB 0x7FF0 #CJK UNIFIED IDEOGRAPH
+0x8ACC 0x809D #CJK UNIFIED IDEOGRAPH
+0x8ACD 0x8266 #CJK UNIFIED IDEOGRAPH
+0x8ACE 0x839E #CJK UNIFIED IDEOGRAPH
+0x8ACF 0x89B3 #CJK UNIFIED IDEOGRAPH
+0x8AD0 0x8ACC #CJK UNIFIED IDEOGRAPH
+0x8AD1 0x8CAB #CJK UNIFIED IDEOGRAPH
+0x8AD2 0x9084 #CJK UNIFIED IDEOGRAPH
+0x8AD3 0x9451 #CJK UNIFIED IDEOGRAPH
+0x8AD4 0x9593 #CJK UNIFIED IDEOGRAPH
+0x8AD5 0x9591 #CJK UNIFIED IDEOGRAPH
+0x8AD6 0x95A2 #CJK UNIFIED IDEOGRAPH
+0x8AD7 0x9665 #CJK UNIFIED IDEOGRAPH
+0x8AD8 0x97D3 #CJK UNIFIED IDEOGRAPH
+0x8AD9 0x9928 #CJK UNIFIED IDEOGRAPH
+0x8ADA 0x8218 #CJK UNIFIED IDEOGRAPH
+0x8ADB 0x4E38 #CJK UNIFIED IDEOGRAPH
+0x8ADC 0x542B #CJK UNIFIED IDEOGRAPH
+0x8ADD 0x5CB8 #CJK UNIFIED IDEOGRAPH
+0x8ADE 0x5DCC #CJK UNIFIED IDEOGRAPH
+0x8ADF 0x73A9 #CJK UNIFIED IDEOGRAPH
+0x8AE0 0x764C #CJK UNIFIED IDEOGRAPH
+0x8AE1 0x773C #CJK UNIFIED IDEOGRAPH
+0x8AE2 0x5CA9 #CJK UNIFIED IDEOGRAPH
+0x8AE3 0x7FEB #CJK UNIFIED IDEOGRAPH
+0x8AE4 0x8D0B #CJK UNIFIED IDEOGRAPH
+0x8AE5 0x96C1 #CJK UNIFIED IDEOGRAPH
+0x8AE6 0x9811 #CJK UNIFIED IDEOGRAPH
+0x8AE7 0x9854 #CJK UNIFIED IDEOGRAPH
+0x8AE8 0x9858 #CJK UNIFIED IDEOGRAPH
+0x8AE9 0x4F01 #CJK UNIFIED IDEOGRAPH
+0x8AEA 0x4F0E #CJK UNIFIED IDEOGRAPH
+0x8AEB 0x5371 #CJK UNIFIED IDEOGRAPH
+0x8AEC 0x559C #CJK UNIFIED IDEOGRAPH
+0x8AED 0x5668 #CJK UNIFIED IDEOGRAPH
+0x8AEE 0x57FA #CJK UNIFIED IDEOGRAPH
+0x8AEF 0x5947 #CJK UNIFIED IDEOGRAPH
+0x8AF0 0x5B09 #CJK UNIFIED IDEOGRAPH
+0x8AF1 0x5BC4 #CJK UNIFIED IDEOGRAPH
+0x8AF2 0x5C90 #CJK UNIFIED IDEOGRAPH
+0x8AF3 0x5E0C #CJK UNIFIED IDEOGRAPH
+0x8AF4 0x5E7E #CJK UNIFIED IDEOGRAPH
+0x8AF5 0x5FCC #CJK UNIFIED IDEOGRAPH
+0x8AF6 0x63EE #CJK UNIFIED IDEOGRAPH
+0x8AF7 0x673A #CJK UNIFIED IDEOGRAPH
+0x8AF8 0x65D7 #CJK UNIFIED IDEOGRAPH
+0x8AF9 0x65E2 #CJK UNIFIED IDEOGRAPH
+0x8AFA 0x671F #CJK UNIFIED IDEOGRAPH
+0x8AFB 0x68CB #CJK UNIFIED IDEOGRAPH
+0x8AFC 0x68C4 #CJK UNIFIED IDEOGRAPH
+0x8B40 0x6A5F #CJK UNIFIED IDEOGRAPH
+0x8B41 0x5E30 #CJK UNIFIED IDEOGRAPH
+0x8B42 0x6BC5 #CJK UNIFIED IDEOGRAPH
+0x8B43 0x6C17 #CJK UNIFIED IDEOGRAPH
+0x8B44 0x6C7D #CJK UNIFIED IDEOGRAPH
+0x8B45 0x757F #CJK UNIFIED IDEOGRAPH
+0x8B46 0x7948 #CJK UNIFIED IDEOGRAPH
+0x8B47 0x5B63 #CJK UNIFIED IDEOGRAPH
+0x8B48 0x7A00 #CJK UNIFIED IDEOGRAPH
+0x8B49 0x7D00 #CJK UNIFIED IDEOGRAPH
+0x8B4A 0x5FBD #CJK UNIFIED IDEOGRAPH
+0x8B4B 0x898F #CJK UNIFIED IDEOGRAPH
+0x8B4C 0x8A18 #CJK UNIFIED IDEOGRAPH
+0x8B4D 0x8CB4 #CJK UNIFIED IDEOGRAPH
+0x8B4E 0x8D77 #CJK UNIFIED IDEOGRAPH
+0x8B4F 0x8ECC #CJK UNIFIED IDEOGRAPH
+0x8B50 0x8F1D #CJK UNIFIED IDEOGRAPH
+0x8B51 0x98E2 #CJK UNIFIED IDEOGRAPH
+0x8B52 0x9A0E #CJK UNIFIED IDEOGRAPH
+0x8B53 0x9B3C #CJK UNIFIED IDEOGRAPH
+0x8B54 0x4E80 #CJK UNIFIED IDEOGRAPH
+0x8B55 0x507D #CJK UNIFIED IDEOGRAPH
+0x8B56 0x5100 #CJK UNIFIED IDEOGRAPH
+0x8B57 0x5993 #CJK UNIFIED IDEOGRAPH
+0x8B58 0x5B9C #CJK UNIFIED IDEOGRAPH
+0x8B59 0x622F #CJK UNIFIED IDEOGRAPH
+0x8B5A 0x6280 #CJK UNIFIED IDEOGRAPH
+0x8B5B 0x64EC #CJK UNIFIED IDEOGRAPH
+0x8B5C 0x6B3A #CJK UNIFIED IDEOGRAPH
+0x8B5D 0x72A0 #CJK UNIFIED IDEOGRAPH
+0x8B5E 0x7591 #CJK UNIFIED IDEOGRAPH
+0x8B5F 0x7947 #CJK UNIFIED IDEOGRAPH
+0x8B60 0x7FA9 #CJK UNIFIED IDEOGRAPH
+0x8B61 0x87FB #CJK UNIFIED IDEOGRAPH
+0x8B62 0x8ABC #CJK UNIFIED IDEOGRAPH
+0x8B63 0x8B70 #CJK UNIFIED IDEOGRAPH
+0x8B64 0x63AC #CJK UNIFIED IDEOGRAPH
+0x8B65 0x83CA #CJK UNIFIED IDEOGRAPH
+0x8B66 0x97A0 #CJK UNIFIED IDEOGRAPH
+0x8B67 0x5409 #CJK UNIFIED IDEOGRAPH
+0x8B68 0x5403 #CJK UNIFIED IDEOGRAPH
+0x8B69 0x55AB #CJK UNIFIED IDEOGRAPH
+0x8B6A 0x6854 #CJK UNIFIED IDEOGRAPH
+0x8B6B 0x6A58 #CJK UNIFIED IDEOGRAPH
+0x8B6C 0x8A70 #CJK UNIFIED IDEOGRAPH
+0x8B6D 0x7827 #CJK UNIFIED IDEOGRAPH
+0x8B6E 0x6775 #CJK UNIFIED IDEOGRAPH
+0x8B6F 0x9ECD #CJK UNIFIED IDEOGRAPH
+0x8B70 0x5374 #CJK UNIFIED IDEOGRAPH
+0x8B71 0x5BA2 #CJK UNIFIED IDEOGRAPH
+0x8B72 0x811A #CJK UNIFIED IDEOGRAPH
+0x8B73 0x8650 #CJK UNIFIED IDEOGRAPH
+0x8B74 0x9006 #CJK UNIFIED IDEOGRAPH
+0x8B75 0x4E18 #CJK UNIFIED IDEOGRAPH
+0x8B76 0x4E45 #CJK UNIFIED IDEOGRAPH
+0x8B77 0x4EC7 #CJK UNIFIED IDEOGRAPH
+0x8B78 0x4F11 #CJK UNIFIED IDEOGRAPH
+0x8B79 0x53CA #CJK UNIFIED IDEOGRAPH
+0x8B7A 0x5438 #CJK UNIFIED IDEOGRAPH
+0x8B7B 0x5BAE #CJK UNIFIED IDEOGRAPH
+0x8B7C 0x5F13 #CJK UNIFIED IDEOGRAPH
+0x8B7D 0x6025 #CJK UNIFIED IDEOGRAPH
+0x8B7E 0x6551 #CJK UNIFIED IDEOGRAPH
+0x8B80 0x673D #CJK UNIFIED IDEOGRAPH
+0x8B81 0x6C42 #CJK UNIFIED IDEOGRAPH
+0x8B82 0x6C72 #CJK UNIFIED IDEOGRAPH
+0x8B83 0x6CE3 #CJK UNIFIED IDEOGRAPH
+0x8B84 0x7078 #CJK UNIFIED IDEOGRAPH
+0x8B85 0x7403 #CJK UNIFIED IDEOGRAPH
+0x8B86 0x7A76 #CJK UNIFIED IDEOGRAPH
+0x8B87 0x7AAE #CJK UNIFIED IDEOGRAPH
+0x8B88 0x7B08 #CJK UNIFIED IDEOGRAPH
+0x8B89 0x7D1A #CJK UNIFIED IDEOGRAPH
+0x8B8A 0x7CFE #CJK UNIFIED IDEOGRAPH
+0x8B8B 0x7D66 #CJK UNIFIED IDEOGRAPH
+0x8B8C 0x65E7 #CJK UNIFIED IDEOGRAPH
+0x8B8D 0x725B #CJK UNIFIED IDEOGRAPH
+0x8B8E 0x53BB #CJK UNIFIED IDEOGRAPH
+0x8B8F 0x5C45 #CJK UNIFIED IDEOGRAPH
+0x8B90 0x5DE8 #CJK UNIFIED IDEOGRAPH
+0x8B91 0x62D2 #CJK UNIFIED IDEOGRAPH
+0x8B92 0x62E0 #CJK UNIFIED IDEOGRAPH
+0x8B93 0x6319 #CJK UNIFIED IDEOGRAPH
+0x8B94 0x6E20 #CJK UNIFIED IDEOGRAPH
+0x8B95 0x865A #CJK UNIFIED IDEOGRAPH
+0x8B96 0x8A31 #CJK UNIFIED IDEOGRAPH
+0x8B97 0x8DDD #CJK UNIFIED IDEOGRAPH
+0x8B98 0x92F8 #CJK UNIFIED IDEOGRAPH
+0x8B99 0x6F01 #CJK UNIFIED IDEOGRAPH
+0x8B9A 0x79A6 #CJK UNIFIED IDEOGRAPH
+0x8B9B 0x9B5A #CJK UNIFIED IDEOGRAPH
+0x8B9C 0x4EA8 #CJK UNIFIED IDEOGRAPH
+0x8B9D 0x4EAB #CJK UNIFIED IDEOGRAPH
+0x8B9E 0x4EAC #CJK UNIFIED IDEOGRAPH
+0x8B9F 0x4F9B #CJK UNIFIED IDEOGRAPH
+0x8BA0 0x4FA0 #CJK UNIFIED IDEOGRAPH
+0x8BA1 0x50D1 #CJK UNIFIED IDEOGRAPH
+0x8BA2 0x5147 #CJK UNIFIED IDEOGRAPH
+0x8BA3 0x7AF6 #CJK UNIFIED IDEOGRAPH
+0x8BA4 0x5171 #CJK UNIFIED IDEOGRAPH
+0x8BA5 0x51F6 #CJK UNIFIED IDEOGRAPH
+0x8BA6 0x5354 #CJK UNIFIED IDEOGRAPH
+0x8BA7 0x5321 #CJK UNIFIED IDEOGRAPH
+0x8BA8 0x537F #CJK UNIFIED IDEOGRAPH
+0x8BA9 0x53EB #CJK UNIFIED IDEOGRAPH
+0x8BAA 0x55AC #CJK UNIFIED IDEOGRAPH
+0x8BAB 0x5883 #CJK UNIFIED IDEOGRAPH
+0x8BAC 0x5CE1 #CJK UNIFIED IDEOGRAPH
+0x8BAD 0x5F37 #CJK UNIFIED IDEOGRAPH
+0x8BAE 0x5F4A #CJK UNIFIED IDEOGRAPH
+0x8BAF 0x602F #CJK UNIFIED IDEOGRAPH
+0x8BB0 0x6050 #CJK UNIFIED IDEOGRAPH
+0x8BB1 0x606D #CJK UNIFIED IDEOGRAPH
+0x8BB2 0x631F #CJK UNIFIED IDEOGRAPH
+0x8BB3 0x6559 #CJK UNIFIED IDEOGRAPH
+0x8BB4 0x6A4B #CJK UNIFIED IDEOGRAPH
+0x8BB5 0x6CC1 #CJK UNIFIED IDEOGRAPH
+0x8BB6 0x72C2 #CJK UNIFIED IDEOGRAPH
+0x8BB7 0x72ED #CJK UNIFIED IDEOGRAPH
+0x8BB8 0x77EF #CJK UNIFIED IDEOGRAPH
+0x8BB9 0x80F8 #CJK UNIFIED IDEOGRAPH
+0x8BBA 0x8105 #CJK UNIFIED IDEOGRAPH
+0x8BBB 0x8208 #CJK UNIFIED IDEOGRAPH
+0x8BBC 0x854E #CJK UNIFIED IDEOGRAPH
+0x8BBD 0x90F7 #CJK UNIFIED IDEOGRAPH
+0x8BBE 0x93E1 #CJK UNIFIED IDEOGRAPH
+0x8BBF 0x97FF #CJK UNIFIED IDEOGRAPH
+0x8BC0 0x9957 #CJK UNIFIED IDEOGRAPH
+0x8BC1 0x9A5A #CJK UNIFIED IDEOGRAPH
+0x8BC2 0x4EF0 #CJK UNIFIED IDEOGRAPH
+0x8BC3 0x51DD #CJK UNIFIED IDEOGRAPH
+0x8BC4 0x5C2D #CJK UNIFIED IDEOGRAPH
+0x8BC5 0x6681 #CJK UNIFIED IDEOGRAPH
+0x8BC6 0x696D #CJK UNIFIED IDEOGRAPH
+0x8BC7 0x5C40 #CJK UNIFIED IDEOGRAPH
+0x8BC8 0x66F2 #CJK UNIFIED IDEOGRAPH
+0x8BC9 0x6975 #CJK UNIFIED IDEOGRAPH
+0x8BCA 0x7389 #CJK UNIFIED IDEOGRAPH
+0x8BCB 0x6850 #CJK UNIFIED IDEOGRAPH
+0x8BCC 0x7C81 #CJK UNIFIED IDEOGRAPH
+0x8BCD 0x50C5 #CJK UNIFIED IDEOGRAPH
+0x8BCE 0x52E4 #CJK UNIFIED IDEOGRAPH
+0x8BCF 0x5747 #CJK UNIFIED IDEOGRAPH
+0x8BD0 0x5DFE #CJK UNIFIED IDEOGRAPH
+0x8BD1 0x9326 #CJK UNIFIED IDEOGRAPH
+0x8BD2 0x65A4 #CJK UNIFIED IDEOGRAPH
+0x8BD3 0x6B23 #CJK UNIFIED IDEOGRAPH
+0x8BD4 0x6B3D #CJK UNIFIED IDEOGRAPH
+0x8BD5 0x7434 #CJK UNIFIED IDEOGRAPH
+0x8BD6 0x7981 #CJK UNIFIED IDEOGRAPH
+0x8BD7 0x79BD #CJK UNIFIED IDEOGRAPH
+0x8BD8 0x7B4B #CJK UNIFIED IDEOGRAPH
+0x8BD9 0x7DCA #CJK UNIFIED IDEOGRAPH
+0x8BDA 0x82B9 #CJK UNIFIED IDEOGRAPH
+0x8BDB 0x83CC #CJK UNIFIED IDEOGRAPH
+0x8BDC 0x887F #CJK UNIFIED IDEOGRAPH
+0x8BDD 0x895F #CJK UNIFIED IDEOGRAPH
+0x8BDE 0x8B39 #CJK UNIFIED IDEOGRAPH
+0x8BDF 0x8FD1 #CJK UNIFIED IDEOGRAPH
+0x8BE0 0x91D1 #CJK UNIFIED IDEOGRAPH
+0x8BE1 0x541F #CJK UNIFIED IDEOGRAPH
+0x8BE2 0x9280 #CJK UNIFIED IDEOGRAPH
+0x8BE3 0x4E5D #CJK UNIFIED IDEOGRAPH
+0x8BE4 0x5036 #CJK UNIFIED IDEOGRAPH
+0x8BE5 0x53E5 #CJK UNIFIED IDEOGRAPH
+0x8BE6 0x533A #CJK UNIFIED IDEOGRAPH
+0x8BE7 0x72D7 #CJK UNIFIED IDEOGRAPH
+0x8BE8 0x7396 #CJK UNIFIED IDEOGRAPH
+0x8BE9 0x77E9 #CJK UNIFIED IDEOGRAPH
+0x8BEA 0x82E6 #CJK UNIFIED IDEOGRAPH
+0x8BEB 0x8EAF #CJK UNIFIED IDEOGRAPH
+0x8BEC 0x99C6 #CJK UNIFIED IDEOGRAPH
+0x8BED 0x99C8 #CJK UNIFIED IDEOGRAPH
+0x8BEE 0x99D2 #CJK UNIFIED IDEOGRAPH
+0x8BEF 0x5177 #CJK UNIFIED IDEOGRAPH
+0x8BF0 0x611A #CJK UNIFIED IDEOGRAPH
+0x8BF1 0x865E #CJK UNIFIED IDEOGRAPH
+0x8BF2 0x55B0 #CJK UNIFIED IDEOGRAPH
+0x8BF3 0x7A7A #CJK UNIFIED IDEOGRAPH
+0x8BF4 0x5076 #CJK UNIFIED IDEOGRAPH
+0x8BF5 0x5BD3 #CJK UNIFIED IDEOGRAPH
+0x8BF6 0x9047 #CJK UNIFIED IDEOGRAPH
+0x8BF7 0x9685 #CJK UNIFIED IDEOGRAPH
+0x8BF8 0x4E32 #CJK UNIFIED IDEOGRAPH
+0x8BF9 0x6ADB #CJK UNIFIED IDEOGRAPH
+0x8BFA 0x91E7 #CJK UNIFIED IDEOGRAPH
+0x8BFB 0x5C51 #CJK UNIFIED IDEOGRAPH
+0x8BFC 0x5C48 #CJK UNIFIED IDEOGRAPH
+0x8C40 0x6398 #CJK UNIFIED IDEOGRAPH
+0x8C41 0x7A9F #CJK UNIFIED IDEOGRAPH
+0x8C42 0x6C93 #CJK UNIFIED IDEOGRAPH
+0x8C43 0x9774 #CJK UNIFIED IDEOGRAPH
+0x8C44 0x8F61 #CJK UNIFIED IDEOGRAPH
+0x8C45 0x7AAA #CJK UNIFIED IDEOGRAPH
+0x8C46 0x718A #CJK UNIFIED IDEOGRAPH
+0x8C47 0x9688 #CJK UNIFIED IDEOGRAPH
+0x8C48 0x7C82 #CJK UNIFIED IDEOGRAPH
+0x8C49 0x6817 #CJK UNIFIED IDEOGRAPH
+0x8C4A 0x7E70 #CJK UNIFIED IDEOGRAPH
+0x8C4B 0x6851 #CJK UNIFIED IDEOGRAPH
+0x8C4C 0x936C #CJK UNIFIED IDEOGRAPH
+0x8C4D 0x52F2 #CJK UNIFIED IDEOGRAPH
+0x8C4E 0x541B #CJK UNIFIED IDEOGRAPH
+0x8C4F 0x85AB #CJK UNIFIED IDEOGRAPH
+0x8C50 0x8A13 #CJK UNIFIED IDEOGRAPH
+0x8C51 0x7FA4 #CJK UNIFIED IDEOGRAPH
+0x8C52 0x8ECD #CJK UNIFIED IDEOGRAPH
+0x8C53 0x90E1 #CJK UNIFIED IDEOGRAPH
+0x8C54 0x5366 #CJK UNIFIED IDEOGRAPH
+0x8C55 0x8888 #CJK UNIFIED IDEOGRAPH
+0x8C56 0x7941 #CJK UNIFIED IDEOGRAPH
+0x8C57 0x4FC2 #CJK UNIFIED IDEOGRAPH
+0x8C58 0x50BE #CJK UNIFIED IDEOGRAPH
+0x8C59 0x5211 #CJK UNIFIED IDEOGRAPH
+0x8C5A 0x5144 #CJK UNIFIED IDEOGRAPH
+0x8C5B 0x5553 #CJK UNIFIED IDEOGRAPH
+0x8C5C 0x572D #CJK UNIFIED IDEOGRAPH
+0x8C5D 0x73EA #CJK UNIFIED IDEOGRAPH
+0x8C5E 0x578B #CJK UNIFIED IDEOGRAPH
+0x8C5F 0x5951 #CJK UNIFIED IDEOGRAPH
+0x8C60 0x5F62 #CJK UNIFIED IDEOGRAPH
+0x8C61 0x5F84 #CJK UNIFIED IDEOGRAPH
+0x8C62 0x6075 #CJK UNIFIED IDEOGRAPH
+0x8C63 0x6176 #CJK UNIFIED IDEOGRAPH
+0x8C64 0x6167 #CJK UNIFIED IDEOGRAPH
+0x8C65 0x61A9 #CJK UNIFIED IDEOGRAPH
+0x8C66 0x63B2 #CJK UNIFIED IDEOGRAPH
+0x8C67 0x643A #CJK UNIFIED IDEOGRAPH
+0x8C68 0x656C #CJK UNIFIED IDEOGRAPH
+0x8C69 0x666F #CJK UNIFIED IDEOGRAPH
+0x8C6A 0x6842 #CJK UNIFIED IDEOGRAPH
+0x8C6B 0x6E13 #CJK UNIFIED IDEOGRAPH
+0x8C6C 0x7566 #CJK UNIFIED IDEOGRAPH
+0x8C6D 0x7A3D #CJK UNIFIED IDEOGRAPH
+0x8C6E 0x7CFB #CJK UNIFIED IDEOGRAPH
+0x8C6F 0x7D4C #CJK UNIFIED IDEOGRAPH
+0x8C70 0x7D99 #CJK UNIFIED IDEOGRAPH
+0x8C71 0x7E4B #CJK UNIFIED IDEOGRAPH
+0x8C72 0x7F6B #CJK UNIFIED IDEOGRAPH
+0x8C73 0x830E #CJK UNIFIED IDEOGRAPH
+0x8C74 0x834A #CJK UNIFIED IDEOGRAPH
+0x8C75 0x86CD #CJK UNIFIED IDEOGRAPH
+0x8C76 0x8A08 #CJK UNIFIED IDEOGRAPH
+0x8C77 0x8A63 #CJK UNIFIED IDEOGRAPH
+0x8C78 0x8B66 #CJK UNIFIED IDEOGRAPH
+0x8C79 0x8EFD #CJK UNIFIED IDEOGRAPH
+0x8C7A 0x981A #CJK UNIFIED IDEOGRAPH
+0x8C7B 0x9D8F #CJK UNIFIED IDEOGRAPH
+0x8C7C 0x82B8 #CJK UNIFIED IDEOGRAPH
+0x8C7D 0x8FCE #CJK UNIFIED IDEOGRAPH
+0x8C7E 0x9BE8 #CJK UNIFIED IDEOGRAPH
+0x8C80 0x5287 #CJK UNIFIED IDEOGRAPH
+0x8C81 0x621F #CJK UNIFIED IDEOGRAPH
+0x8C82 0x6483 #CJK UNIFIED IDEOGRAPH
+0x8C83 0x6FC0 #CJK UNIFIED IDEOGRAPH
+0x8C84 0x9699 #CJK UNIFIED IDEOGRAPH
+0x8C85 0x6841 #CJK UNIFIED IDEOGRAPH
+0x8C86 0x5091 #CJK UNIFIED IDEOGRAPH
+0x8C87 0x6B20 #CJK UNIFIED IDEOGRAPH
+0x8C88 0x6C7A #CJK UNIFIED IDEOGRAPH
+0x8C89 0x6F54 #CJK UNIFIED IDEOGRAPH
+0x8C8A 0x7A74 #CJK UNIFIED IDEOGRAPH
+0x8C8B 0x7D50 #CJK UNIFIED IDEOGRAPH
+0x8C8C 0x8840 #CJK UNIFIED IDEOGRAPH
+0x8C8D 0x8A23 #CJK UNIFIED IDEOGRAPH
+0x8C8E 0x6708 #CJK UNIFIED IDEOGRAPH
+0x8C8F 0x4EF6 #CJK UNIFIED IDEOGRAPH
+0x8C90 0x5039 #CJK UNIFIED IDEOGRAPH
+0x8C91 0x5026 #CJK UNIFIED IDEOGRAPH
+0x8C92 0x5065 #CJK UNIFIED IDEOGRAPH
+0x8C93 0x517C #CJK UNIFIED IDEOGRAPH
+0x8C94 0x5238 #CJK UNIFIED IDEOGRAPH
+0x8C95 0x5263 #CJK UNIFIED IDEOGRAPH
+0x8C96 0x55A7 #CJK UNIFIED IDEOGRAPH
+0x8C97 0x570F #CJK UNIFIED IDEOGRAPH
+0x8C98 0x5805 #CJK UNIFIED IDEOGRAPH
+0x8C99 0x5ACC #CJK UNIFIED IDEOGRAPH
+0x8C9A 0x5EFA #CJK UNIFIED IDEOGRAPH
+0x8C9B 0x61B2 #CJK UNIFIED IDEOGRAPH
+0x8C9C 0x61F8 #CJK UNIFIED IDEOGRAPH
+0x8C9D 0x62F3 #CJK UNIFIED IDEOGRAPH
+0x8C9E 0x6372 #CJK UNIFIED IDEOGRAPH
+0x8C9F 0x691C #CJK UNIFIED IDEOGRAPH
+0x8CA0 0x6A29 #CJK UNIFIED IDEOGRAPH
+0x8CA1 0x727D #CJK UNIFIED IDEOGRAPH
+0x8CA2 0x72AC #CJK UNIFIED IDEOGRAPH
+0x8CA3 0x732E #CJK UNIFIED IDEOGRAPH
+0x8CA4 0x7814 #CJK UNIFIED IDEOGRAPH
+0x8CA5 0x786F #CJK UNIFIED IDEOGRAPH
+0x8CA6 0x7D79 #CJK UNIFIED IDEOGRAPH
+0x8CA7 0x770C #CJK UNIFIED IDEOGRAPH
+0x8CA8 0x80A9 #CJK UNIFIED IDEOGRAPH
+0x8CA9 0x898B #CJK UNIFIED IDEOGRAPH
+0x8CAA 0x8B19 #CJK UNIFIED IDEOGRAPH
+0x8CAB 0x8CE2 #CJK UNIFIED IDEOGRAPH
+0x8CAC 0x8ED2 #CJK UNIFIED IDEOGRAPH
+0x8CAD 0x9063 #CJK UNIFIED IDEOGRAPH
+0x8CAE 0x9375 #CJK UNIFIED IDEOGRAPH
+0x8CAF 0x967A #CJK UNIFIED IDEOGRAPH
+0x8CB0 0x9855 #CJK UNIFIED IDEOGRAPH
+0x8CB1 0x9A13 #CJK UNIFIED IDEOGRAPH
+0x8CB2 0x9E78 #CJK UNIFIED IDEOGRAPH
+0x8CB3 0x5143 #CJK UNIFIED IDEOGRAPH
+0x8CB4 0x539F #CJK UNIFIED IDEOGRAPH
+0x8CB5 0x53B3 #CJK UNIFIED IDEOGRAPH
+0x8CB6 0x5E7B #CJK UNIFIED IDEOGRAPH
+0x8CB7 0x5F26 #CJK UNIFIED IDEOGRAPH
+0x8CB8 0x6E1B #CJK UNIFIED IDEOGRAPH
+0x8CB9 0x6E90 #CJK UNIFIED IDEOGRAPH
+0x8CBA 0x7384 #CJK UNIFIED IDEOGRAPH
+0x8CBB 0x73FE #CJK UNIFIED IDEOGRAPH
+0x8CBC 0x7D43 #CJK UNIFIED IDEOGRAPH
+0x8CBD 0x8237 #CJK UNIFIED IDEOGRAPH
+0x8CBE 0x8A00 #CJK UNIFIED IDEOGRAPH
+0x8CBF 0x8AFA #CJK UNIFIED IDEOGRAPH
+0x8CC0 0x9650 #CJK UNIFIED IDEOGRAPH
+0x8CC1 0x4E4E #CJK UNIFIED IDEOGRAPH
+0x8CC2 0x500B #CJK UNIFIED IDEOGRAPH
+0x8CC3 0x53E4 #CJK UNIFIED IDEOGRAPH
+0x8CC4 0x547C #CJK UNIFIED IDEOGRAPH
+0x8CC5 0x56FA #CJK UNIFIED IDEOGRAPH
+0x8CC6 0x59D1 #CJK UNIFIED IDEOGRAPH
+0x8CC7 0x5B64 #CJK UNIFIED IDEOGRAPH
+0x8CC8 0x5DF1 #CJK UNIFIED IDEOGRAPH
+0x8CC9 0x5EAB #CJK UNIFIED IDEOGRAPH
+0x8CCA 0x5F27 #CJK UNIFIED IDEOGRAPH
+0x8CCB 0x6238 #CJK UNIFIED IDEOGRAPH
+0x8CCC 0x6545 #CJK UNIFIED IDEOGRAPH
+0x8CCD 0x67AF #CJK UNIFIED IDEOGRAPH
+0x8CCE 0x6E56 #CJK UNIFIED IDEOGRAPH
+0x8CCF 0x72D0 #CJK UNIFIED IDEOGRAPH
+0x8CD0 0x7CCA #CJK UNIFIED IDEOGRAPH
+0x8CD1 0x88B4 #CJK UNIFIED IDEOGRAPH
+0x8CD2 0x80A1 #CJK UNIFIED IDEOGRAPH
+0x8CD3 0x80E1 #CJK UNIFIED IDEOGRAPH
+0x8CD4 0x83F0 #CJK UNIFIED IDEOGRAPH
+0x8CD5 0x864E #CJK UNIFIED IDEOGRAPH
+0x8CD6 0x8A87 #CJK UNIFIED IDEOGRAPH
+0x8CD7 0x8DE8 #CJK UNIFIED IDEOGRAPH
+0x8CD8 0x9237 #CJK UNIFIED IDEOGRAPH
+0x8CD9 0x96C7 #CJK UNIFIED IDEOGRAPH
+0x8CDA 0x9867 #CJK UNIFIED IDEOGRAPH
+0x8CDB 0x9F13 #CJK UNIFIED IDEOGRAPH
+0x8CDC 0x4E94 #CJK UNIFIED IDEOGRAPH
+0x8CDD 0x4E92 #CJK UNIFIED IDEOGRAPH
+0x8CDE 0x4F0D #CJK UNIFIED IDEOGRAPH
+0x8CDF 0x5348 #CJK UNIFIED IDEOGRAPH
+0x8CE0 0x5449 #CJK UNIFIED IDEOGRAPH
+0x8CE1 0x543E #CJK UNIFIED IDEOGRAPH
+0x8CE2 0x5A2F #CJK UNIFIED IDEOGRAPH
+0x8CE3 0x5F8C #CJK UNIFIED IDEOGRAPH
+0x8CE4 0x5FA1 #CJK UNIFIED IDEOGRAPH
+0x8CE5 0x609F #CJK UNIFIED IDEOGRAPH
+0x8CE6 0x68A7 #CJK UNIFIED IDEOGRAPH
+0x8CE7 0x6A8E #CJK UNIFIED IDEOGRAPH
+0x8CE8 0x745A #CJK UNIFIED IDEOGRAPH
+0x8CE9 0x7881 #CJK UNIFIED IDEOGRAPH
+0x8CEA 0x8A9E #CJK UNIFIED IDEOGRAPH
+0x8CEB 0x8AA4 #CJK UNIFIED IDEOGRAPH
+0x8CEC 0x8B77 #CJK UNIFIED IDEOGRAPH
+0x8CED 0x9190 #CJK UNIFIED IDEOGRAPH
+0x8CEE 0x4E5E #CJK UNIFIED IDEOGRAPH
+0x8CEF 0x9BC9 #CJK UNIFIED IDEOGRAPH
+0x8CF0 0x4EA4 #CJK UNIFIED IDEOGRAPH
+0x8CF1 0x4F7C #CJK UNIFIED IDEOGRAPH
+0x8CF2 0x4FAF #CJK UNIFIED IDEOGRAPH
+0x8CF3 0x5019 #CJK UNIFIED IDEOGRAPH
+0x8CF4 0x5016 #CJK UNIFIED IDEOGRAPH
+0x8CF5 0x5149 #CJK UNIFIED IDEOGRAPH
+0x8CF6 0x516C #CJK UNIFIED IDEOGRAPH
+0x8CF7 0x529F #CJK UNIFIED IDEOGRAPH
+0x8CF8 0x52B9 #CJK UNIFIED IDEOGRAPH
+0x8CF9 0x52FE #CJK UNIFIED IDEOGRAPH
+0x8CFA 0x539A #CJK UNIFIED IDEOGRAPH
+0x8CFB 0x53E3 #CJK UNIFIED IDEOGRAPH
+0x8CFC 0x5411 #CJK UNIFIED IDEOGRAPH
+0x8D40 0x540E #CJK UNIFIED IDEOGRAPH
+0x8D41 0x5589 #CJK UNIFIED IDEOGRAPH
+0x8D42 0x5751 #CJK UNIFIED IDEOGRAPH
+0x8D43 0x57A2 #CJK UNIFIED IDEOGRAPH
+0x8D44 0x597D #CJK UNIFIED IDEOGRAPH
+0x8D45 0x5B54 #CJK UNIFIED IDEOGRAPH
+0x8D46 0x5B5D #CJK UNIFIED IDEOGRAPH
+0x8D47 0x5B8F #CJK UNIFIED IDEOGRAPH
+0x8D48 0x5DE5 #CJK UNIFIED IDEOGRAPH
+0x8D49 0x5DE7 #CJK UNIFIED IDEOGRAPH
+0x8D4A 0x5DF7 #CJK UNIFIED IDEOGRAPH
+0x8D4B 0x5E78 #CJK UNIFIED IDEOGRAPH
+0x8D4C 0x5E83 #CJK UNIFIED IDEOGRAPH
+0x8D4D 0x5E9A #CJK UNIFIED IDEOGRAPH
+0x8D4E 0x5EB7 #CJK UNIFIED IDEOGRAPH
+0x8D4F 0x5F18 #CJK UNIFIED IDEOGRAPH
+0x8D50 0x6052 #CJK UNIFIED IDEOGRAPH
+0x8D51 0x614C #CJK UNIFIED IDEOGRAPH
+0x8D52 0x6297 #CJK UNIFIED IDEOGRAPH
+0x8D53 0x62D8 #CJK UNIFIED IDEOGRAPH
+0x8D54 0x63A7 #CJK UNIFIED IDEOGRAPH
+0x8D55 0x653B #CJK UNIFIED IDEOGRAPH
+0x8D56 0x6602 #CJK UNIFIED IDEOGRAPH
+0x8D57 0x6643 #CJK UNIFIED IDEOGRAPH
+0x8D58 0x66F4 #CJK UNIFIED IDEOGRAPH
+0x8D59 0x676D #CJK UNIFIED IDEOGRAPH
+0x8D5A 0x6821 #CJK UNIFIED IDEOGRAPH
+0x8D5B 0x6897 #CJK UNIFIED IDEOGRAPH
+0x8D5C 0x69CB #CJK UNIFIED IDEOGRAPH
+0x8D5D 0x6C5F #CJK UNIFIED IDEOGRAPH
+0x8D5E 0x6D2A #CJK UNIFIED IDEOGRAPH
+0x8D5F 0x6D69 #CJK UNIFIED IDEOGRAPH
+0x8D60 0x6E2F #CJK UNIFIED IDEOGRAPH
+0x8D61 0x6E9D #CJK UNIFIED IDEOGRAPH
+0x8D62 0x7532 #CJK UNIFIED IDEOGRAPH
+0x8D63 0x7687 #CJK UNIFIED IDEOGRAPH
+0x8D64 0x786C #CJK UNIFIED IDEOGRAPH
+0x8D65 0x7A3F #CJK UNIFIED IDEOGRAPH
+0x8D66 0x7CE0 #CJK UNIFIED IDEOGRAPH
+0x8D67 0x7D05 #CJK UNIFIED IDEOGRAPH
+0x8D68 0x7D18 #CJK UNIFIED IDEOGRAPH
+0x8D69 0x7D5E #CJK UNIFIED IDEOGRAPH
+0x8D6A 0x7DB1 #CJK UNIFIED IDEOGRAPH
+0x8D6B 0x8015 #CJK UNIFIED IDEOGRAPH
+0x8D6C 0x8003 #CJK UNIFIED IDEOGRAPH
+0x8D6D 0x80AF #CJK UNIFIED IDEOGRAPH
+0x8D6E 0x80B1 #CJK UNIFIED IDEOGRAPH
+0x8D6F 0x8154 #CJK UNIFIED IDEOGRAPH
+0x8D70 0x818F #CJK UNIFIED IDEOGRAPH
+0x8D71 0x822A #CJK UNIFIED IDEOGRAPH
+0x8D72 0x8352 #CJK UNIFIED IDEOGRAPH
+0x8D73 0x884C #CJK UNIFIED IDEOGRAPH
+0x8D74 0x8861 #CJK UNIFIED IDEOGRAPH
+0x8D75 0x8B1B #CJK UNIFIED IDEOGRAPH
+0x8D76 0x8CA2 #CJK UNIFIED IDEOGRAPH
+0x8D77 0x8CFC #CJK UNIFIED IDEOGRAPH
+0x8D78 0x90CA #CJK UNIFIED IDEOGRAPH
+0x8D79 0x9175 #CJK UNIFIED IDEOGRAPH
+0x8D7A 0x9271 #CJK UNIFIED IDEOGRAPH
+0x8D7B 0x783F #CJK UNIFIED IDEOGRAPH
+0x8D7C 0x92FC #CJK UNIFIED IDEOGRAPH
+0x8D7D 0x95A4 #CJK UNIFIED IDEOGRAPH
+0x8D7E 0x964D #CJK UNIFIED IDEOGRAPH
+0x8D80 0x9805 #CJK UNIFIED IDEOGRAPH
+0x8D81 0x9999 #CJK UNIFIED IDEOGRAPH
+0x8D82 0x9AD8 #CJK UNIFIED IDEOGRAPH
+0x8D83 0x9D3B #CJK UNIFIED IDEOGRAPH
+0x8D84 0x525B #CJK UNIFIED IDEOGRAPH
+0x8D85 0x52AB #CJK UNIFIED IDEOGRAPH
+0x8D86 0x53F7 #CJK UNIFIED IDEOGRAPH
+0x8D87 0x5408 #CJK UNIFIED IDEOGRAPH
+0x8D88 0x58D5 #CJK UNIFIED IDEOGRAPH
+0x8D89 0x62F7 #CJK UNIFIED IDEOGRAPH
+0x8D8A 0x6FE0 #CJK UNIFIED IDEOGRAPH
+0x8D8B 0x8C6A #CJK UNIFIED IDEOGRAPH
+0x8D8C 0x8F5F #CJK UNIFIED IDEOGRAPH
+0x8D8D 0x9EB9 #CJK UNIFIED IDEOGRAPH
+0x8D8E 0x514B #CJK UNIFIED IDEOGRAPH
+0x8D8F 0x523B #CJK UNIFIED IDEOGRAPH
+0x8D90 0x544A #CJK UNIFIED IDEOGRAPH
+0x8D91 0x56FD #CJK UNIFIED IDEOGRAPH
+0x8D92 0x7A40 #CJK UNIFIED IDEOGRAPH
+0x8D93 0x9177 #CJK UNIFIED IDEOGRAPH
+0x8D94 0x9D60 #CJK UNIFIED IDEOGRAPH
+0x8D95 0x9ED2 #CJK UNIFIED IDEOGRAPH
+0x8D96 0x7344 #CJK UNIFIED IDEOGRAPH
+0x8D97 0x6F09 #CJK UNIFIED IDEOGRAPH
+0x8D98 0x8170 #CJK UNIFIED IDEOGRAPH
+0x8D99 0x7511 #CJK UNIFIED IDEOGRAPH
+0x8D9A 0x5FFD #CJK UNIFIED IDEOGRAPH
+0x8D9B 0x60DA #CJK UNIFIED IDEOGRAPH
+0x8D9C 0x9AA8 #CJK UNIFIED IDEOGRAPH
+0x8D9D 0x72DB #CJK UNIFIED IDEOGRAPH
+0x8D9E 0x8FBC #CJK UNIFIED IDEOGRAPH
+0x8D9F 0x6B64 #CJK UNIFIED IDEOGRAPH
+0x8DA0 0x9803 #CJK UNIFIED IDEOGRAPH
+0x8DA1 0x4ECA #CJK UNIFIED IDEOGRAPH
+0x8DA2 0x56F0 #CJK UNIFIED IDEOGRAPH
+0x8DA3 0x5764 #CJK UNIFIED IDEOGRAPH
+0x8DA4 0x58BE #CJK UNIFIED IDEOGRAPH
+0x8DA5 0x5A5A #CJK UNIFIED IDEOGRAPH
+0x8DA6 0x6068 #CJK UNIFIED IDEOGRAPH
+0x8DA7 0x61C7 #CJK UNIFIED IDEOGRAPH
+0x8DA8 0x660F #CJK UNIFIED IDEOGRAPH
+0x8DA9 0x6606 #CJK UNIFIED IDEOGRAPH
+0x8DAA 0x6839 #CJK UNIFIED IDEOGRAPH
+0x8DAB 0x68B1 #CJK UNIFIED IDEOGRAPH
+0x8DAC 0x6DF7 #CJK UNIFIED IDEOGRAPH
+0x8DAD 0x75D5 #CJK UNIFIED IDEOGRAPH
+0x8DAE 0x7D3A #CJK UNIFIED IDEOGRAPH
+0x8DAF 0x826E #CJK UNIFIED IDEOGRAPH
+0x8DB0 0x9B42 #CJK UNIFIED IDEOGRAPH
+0x8DB1 0x4E9B #CJK UNIFIED IDEOGRAPH
+0x8DB2 0x4F50 #CJK UNIFIED IDEOGRAPH
+0x8DB3 0x53C9 #CJK UNIFIED IDEOGRAPH
+0x8DB4 0x5506 #CJK UNIFIED IDEOGRAPH
+0x8DB5 0x5D6F #CJK UNIFIED IDEOGRAPH
+0x8DB6 0x5DE6 #CJK UNIFIED IDEOGRAPH
+0x8DB7 0x5DEE #CJK UNIFIED IDEOGRAPH
+0x8DB8 0x67FB #CJK UNIFIED IDEOGRAPH
+0x8DB9 0x6C99 #CJK UNIFIED IDEOGRAPH
+0x8DBA 0x7473 #CJK UNIFIED IDEOGRAPH
+0x8DBB 0x7802 #CJK UNIFIED IDEOGRAPH
+0x8DBC 0x8A50 #CJK UNIFIED IDEOGRAPH
+0x8DBD 0x9396 #CJK UNIFIED IDEOGRAPH
+0x8DBE 0x88DF #CJK UNIFIED IDEOGRAPH
+0x8DBF 0x5750 #CJK UNIFIED IDEOGRAPH
+0x8DC0 0x5EA7 #CJK UNIFIED IDEOGRAPH
+0x8DC1 0x632B #CJK UNIFIED IDEOGRAPH
+0x8DC2 0x50B5 #CJK UNIFIED IDEOGRAPH
+0x8DC3 0x50AC #CJK UNIFIED IDEOGRAPH
+0x8DC4 0x518D #CJK UNIFIED IDEOGRAPH
+0x8DC5 0x6700 #CJK UNIFIED IDEOGRAPH
+0x8DC6 0x54C9 #CJK UNIFIED IDEOGRAPH
+0x8DC7 0x585E #CJK UNIFIED IDEOGRAPH
+0x8DC8 0x59BB #CJK UNIFIED IDEOGRAPH
+0x8DC9 0x5BB0 #CJK UNIFIED IDEOGRAPH
+0x8DCA 0x5F69 #CJK UNIFIED IDEOGRAPH
+0x8DCB 0x624D #CJK UNIFIED IDEOGRAPH
+0x8DCC 0x63A1 #CJK UNIFIED IDEOGRAPH
+0x8DCD 0x683D #CJK UNIFIED IDEOGRAPH
+0x8DCE 0x6B73 #CJK UNIFIED IDEOGRAPH
+0x8DCF 0x6E08 #CJK UNIFIED IDEOGRAPH
+0x8DD0 0x707D #CJK UNIFIED IDEOGRAPH
+0x8DD1 0x91C7 #CJK UNIFIED IDEOGRAPH
+0x8DD2 0x7280 #CJK UNIFIED IDEOGRAPH
+0x8DD3 0x7815 #CJK UNIFIED IDEOGRAPH
+0x8DD4 0x7826 #CJK UNIFIED IDEOGRAPH
+0x8DD5 0x796D #CJK UNIFIED IDEOGRAPH
+0x8DD6 0x658E #CJK UNIFIED IDEOGRAPH
+0x8DD7 0x7D30 #CJK UNIFIED IDEOGRAPH
+0x8DD8 0x83DC #CJK UNIFIED IDEOGRAPH
+0x8DD9 0x88C1 #CJK UNIFIED IDEOGRAPH
+0x8DDA 0x8F09 #CJK UNIFIED IDEOGRAPH
+0x8DDB 0x969B #CJK UNIFIED IDEOGRAPH
+0x8DDC 0x5264 #CJK UNIFIED IDEOGRAPH
+0x8DDD 0x5728 #CJK UNIFIED IDEOGRAPH
+0x8DDE 0x6750 #CJK UNIFIED IDEOGRAPH
+0x8DDF 0x7F6A #CJK UNIFIED IDEOGRAPH
+0x8DE0 0x8CA1 #CJK UNIFIED IDEOGRAPH
+0x8DE1 0x51B4 #CJK UNIFIED IDEOGRAPH
+0x8DE2 0x5742 #CJK UNIFIED IDEOGRAPH
+0x8DE3 0x962A #CJK UNIFIED IDEOGRAPH
+0x8DE4 0x583A #CJK UNIFIED IDEOGRAPH
+0x8DE5 0x698A #CJK UNIFIED IDEOGRAPH
+0x8DE6 0x80B4 #CJK UNIFIED IDEOGRAPH
+0x8DE7 0x54B2 #CJK UNIFIED IDEOGRAPH
+0x8DE8 0x5D0E #CJK UNIFIED IDEOGRAPH
+0x8DE9 0x57FC #CJK UNIFIED IDEOGRAPH
+0x8DEA 0x7895 #CJK UNIFIED IDEOGRAPH
+0x8DEB 0x9DFA #CJK UNIFIED IDEOGRAPH
+0x8DEC 0x4F5C #CJK UNIFIED IDEOGRAPH
+0x8DED 0x524A #CJK UNIFIED IDEOGRAPH
+0x8DEE 0x548B #CJK UNIFIED IDEOGRAPH
+0x8DEF 0x643E #CJK UNIFIED IDEOGRAPH
+0x8DF0 0x6628 #CJK UNIFIED IDEOGRAPH
+0x8DF1 0x6714 #CJK UNIFIED IDEOGRAPH
+0x8DF2 0x67F5 #CJK UNIFIED IDEOGRAPH
+0x8DF3 0x7A84 #CJK UNIFIED IDEOGRAPH
+0x8DF4 0x7B56 #CJK UNIFIED IDEOGRAPH
+0x8DF5 0x7D22 #CJK UNIFIED IDEOGRAPH
+0x8DF6 0x932F #CJK UNIFIED IDEOGRAPH
+0x8DF7 0x685C #CJK UNIFIED IDEOGRAPH
+0x8DF8 0x9BAD #CJK UNIFIED IDEOGRAPH
+0x8DF9 0x7B39 #CJK UNIFIED IDEOGRAPH
+0x8DFA 0x5319 #CJK UNIFIED IDEOGRAPH
+0x8DFB 0x518A #CJK UNIFIED IDEOGRAPH
+0x8DFC 0x5237 #CJK UNIFIED IDEOGRAPH
+0x8E40 0x5BDF #CJK UNIFIED IDEOGRAPH
+0x8E41 0x62F6 #CJK UNIFIED IDEOGRAPH
+0x8E42 0x64AE #CJK UNIFIED IDEOGRAPH
+0x8E43 0x64E6 #CJK UNIFIED IDEOGRAPH
+0x8E44 0x672D #CJK UNIFIED IDEOGRAPH
+0x8E45 0x6BBA #CJK UNIFIED IDEOGRAPH
+0x8E46 0x85A9 #CJK UNIFIED IDEOGRAPH
+0x8E47 0x96D1 #CJK UNIFIED IDEOGRAPH
+0x8E48 0x7690 #CJK UNIFIED IDEOGRAPH
+0x8E49 0x9BD6 #CJK UNIFIED IDEOGRAPH
+0x8E4A 0x634C #CJK UNIFIED IDEOGRAPH
+0x8E4B 0x9306 #CJK UNIFIED IDEOGRAPH
+0x8E4C 0x9BAB #CJK UNIFIED IDEOGRAPH
+0x8E4D 0x76BF #CJK UNIFIED IDEOGRAPH
+0x8E4E 0x6652 #CJK UNIFIED IDEOGRAPH
+0x8E4F 0x4E09 #CJK UNIFIED IDEOGRAPH
+0x8E50 0x5098 #CJK UNIFIED IDEOGRAPH
+0x8E51 0x53C2 #CJK UNIFIED IDEOGRAPH
+0x8E52 0x5C71 #CJK UNIFIED IDEOGRAPH
+0x8E53 0x60E8 #CJK UNIFIED IDEOGRAPH
+0x8E54 0x6492 #CJK UNIFIED IDEOGRAPH
+0x8E55 0x6563 #CJK UNIFIED IDEOGRAPH
+0x8E56 0x685F #CJK UNIFIED IDEOGRAPH
+0x8E57 0x71E6 #CJK UNIFIED IDEOGRAPH
+0x8E58 0x73CA #CJK UNIFIED IDEOGRAPH
+0x8E59 0x7523 #CJK UNIFIED IDEOGRAPH
+0x8E5A 0x7B97 #CJK UNIFIED IDEOGRAPH
+0x8E5B 0x7E82 #CJK UNIFIED IDEOGRAPH
+0x8E5C 0x8695 #CJK UNIFIED IDEOGRAPH
+0x8E5D 0x8B83 #CJK UNIFIED IDEOGRAPH
+0x8E5E 0x8CDB #CJK UNIFIED IDEOGRAPH
+0x8E5F 0x9178 #CJK UNIFIED IDEOGRAPH
+0x8E60 0x9910 #CJK UNIFIED IDEOGRAPH
+0x8E61 0x65AC #CJK UNIFIED IDEOGRAPH
+0x8E62 0x66AB #CJK UNIFIED IDEOGRAPH
+0x8E63 0x6B8B #CJK UNIFIED IDEOGRAPH
+0x8E64 0x4ED5 #CJK UNIFIED IDEOGRAPH
+0x8E65 0x4ED4 #CJK UNIFIED IDEOGRAPH
+0x8E66 0x4F3A #CJK UNIFIED IDEOGRAPH
+0x8E67 0x4F7F #CJK UNIFIED IDEOGRAPH
+0x8E68 0x523A #CJK UNIFIED IDEOGRAPH
+0x8E69 0x53F8 #CJK UNIFIED IDEOGRAPH
+0x8E6A 0x53F2 #CJK UNIFIED IDEOGRAPH
+0x8E6B 0x55E3 #CJK UNIFIED IDEOGRAPH
+0x8E6C 0x56DB #CJK UNIFIED IDEOGRAPH
+0x8E6D 0x58EB #CJK UNIFIED IDEOGRAPH
+0x8E6E 0x59CB #CJK UNIFIED IDEOGRAPH
+0x8E6F 0x59C9 #CJK UNIFIED IDEOGRAPH
+0x8E70 0x59FF #CJK UNIFIED IDEOGRAPH
+0x8E71 0x5B50 #CJK UNIFIED IDEOGRAPH
+0x8E72 0x5C4D #CJK UNIFIED IDEOGRAPH
+0x8E73 0x5E02 #CJK UNIFIED IDEOGRAPH
+0x8E74 0x5E2B #CJK UNIFIED IDEOGRAPH
+0x8E75 0x5FD7 #CJK UNIFIED IDEOGRAPH
+0x8E76 0x601D #CJK UNIFIED IDEOGRAPH
+0x8E77 0x6307 #CJK UNIFIED IDEOGRAPH
+0x8E78 0x652F #CJK UNIFIED IDEOGRAPH
+0x8E79 0x5B5C #CJK UNIFIED IDEOGRAPH
+0x8E7A 0x65AF #CJK UNIFIED IDEOGRAPH
+0x8E7B 0x65BD #CJK UNIFIED IDEOGRAPH
+0x8E7C 0x65E8 #CJK UNIFIED IDEOGRAPH
+0x8E7D 0x679D #CJK UNIFIED IDEOGRAPH
+0x8E7E 0x6B62 #CJK UNIFIED IDEOGRAPH
+0x8E80 0x6B7B #CJK UNIFIED IDEOGRAPH
+0x8E81 0x6C0F #CJK UNIFIED IDEOGRAPH
+0x8E82 0x7345 #CJK UNIFIED IDEOGRAPH
+0x8E83 0x7949 #CJK UNIFIED IDEOGRAPH
+0x8E84 0x79C1 #CJK UNIFIED IDEOGRAPH
+0x8E85 0x7CF8 #CJK UNIFIED IDEOGRAPH
+0x8E86 0x7D19 #CJK UNIFIED IDEOGRAPH
+0x8E87 0x7D2B #CJK UNIFIED IDEOGRAPH
+0x8E88 0x80A2 #CJK UNIFIED IDEOGRAPH
+0x8E89 0x8102 #CJK UNIFIED IDEOGRAPH
+0x8E8A 0x81F3 #CJK UNIFIED IDEOGRAPH
+0x8E8B 0x8996 #CJK UNIFIED IDEOGRAPH
+0x8E8C 0x8A5E #CJK UNIFIED IDEOGRAPH
+0x8E8D 0x8A69 #CJK UNIFIED IDEOGRAPH
+0x8E8E 0x8A66 #CJK UNIFIED IDEOGRAPH
+0x8E8F 0x8A8C #CJK UNIFIED IDEOGRAPH
+0x8E90 0x8AEE #CJK UNIFIED IDEOGRAPH
+0x8E91 0x8CC7 #CJK UNIFIED IDEOGRAPH
+0x8E92 0x8CDC #CJK UNIFIED IDEOGRAPH
+0x8E93 0x96CC #CJK UNIFIED IDEOGRAPH
+0x8E94 0x98FC #CJK UNIFIED IDEOGRAPH
+0x8E95 0x6B6F #CJK UNIFIED IDEOGRAPH
+0x8E96 0x4E8B #CJK UNIFIED IDEOGRAPH
+0x8E97 0x4F3C #CJK UNIFIED IDEOGRAPH
+0x8E98 0x4F8D #CJK UNIFIED IDEOGRAPH
+0x8E99 0x5150 #CJK UNIFIED IDEOGRAPH
+0x8E9A 0x5B57 #CJK UNIFIED IDEOGRAPH
+0x8E9B 0x5BFA #CJK UNIFIED IDEOGRAPH
+0x8E9C 0x6148 #CJK UNIFIED IDEOGRAPH
+0x8E9D 0x6301 #CJK UNIFIED IDEOGRAPH
+0x8E9E 0x6642 #CJK UNIFIED IDEOGRAPH
+0x8E9F 0x6B21 #CJK UNIFIED IDEOGRAPH
+0x8EA0 0x6ECB #CJK UNIFIED IDEOGRAPH
+0x8EA1 0x6CBB #CJK UNIFIED IDEOGRAPH
+0x8EA2 0x723E #CJK UNIFIED IDEOGRAPH
+0x8EA3 0x74BD #CJK UNIFIED IDEOGRAPH
+0x8EA4 0x75D4 #CJK UNIFIED IDEOGRAPH
+0x8EA5 0x78C1 #CJK UNIFIED IDEOGRAPH
+0x8EA6 0x793A #CJK UNIFIED IDEOGRAPH
+0x8EA7 0x800C #CJK UNIFIED IDEOGRAPH
+0x8EA8 0x8033 #CJK UNIFIED IDEOGRAPH
+0x8EA9 0x81EA #CJK UNIFIED IDEOGRAPH
+0x8EAA 0x8494 #CJK UNIFIED IDEOGRAPH
+0x8EAB 0x8F9E #CJK UNIFIED IDEOGRAPH
+0x8EAC 0x6C50 #CJK UNIFIED IDEOGRAPH
+0x8EAD 0x9E7F #CJK UNIFIED IDEOGRAPH
+0x8EAE 0x5F0F #CJK UNIFIED IDEOGRAPH
+0x8EAF 0x8B58 #CJK UNIFIED IDEOGRAPH
+0x8EB0 0x9D2B #CJK UNIFIED IDEOGRAPH
+0x8EB1 0x7AFA #CJK UNIFIED IDEOGRAPH
+0x8EB2 0x8EF8 #CJK UNIFIED IDEOGRAPH
+0x8EB3 0x5B8D #CJK UNIFIED IDEOGRAPH
+0x8EB4 0x96EB #CJK UNIFIED IDEOGRAPH
+0x8EB5 0x4E03 #CJK UNIFIED IDEOGRAPH
+0x8EB6 0x53F1 #CJK UNIFIED IDEOGRAPH
+0x8EB7 0x57F7 #CJK UNIFIED IDEOGRAPH
+0x8EB8 0x5931 #CJK UNIFIED IDEOGRAPH
+0x8EB9 0x5AC9 #CJK UNIFIED IDEOGRAPH
+0x8EBA 0x5BA4 #CJK UNIFIED IDEOGRAPH
+0x8EBB 0x6089 #CJK UNIFIED IDEOGRAPH
+0x8EBC 0x6E7F #CJK UNIFIED IDEOGRAPH
+0x8EBD 0x6F06 #CJK UNIFIED IDEOGRAPH
+0x8EBE 0x75BE #CJK UNIFIED IDEOGRAPH
+0x8EBF 0x8CEA #CJK UNIFIED IDEOGRAPH
+0x8EC0 0x5B9F #CJK UNIFIED IDEOGRAPH
+0x8EC1 0x8500 #CJK UNIFIED IDEOGRAPH
+0x8EC2 0x7BE0 #CJK UNIFIED IDEOGRAPH
+0x8EC3 0x5072 #CJK UNIFIED IDEOGRAPH
+0x8EC4 0x67F4 #CJK UNIFIED IDEOGRAPH
+0x8EC5 0x829D #CJK UNIFIED IDEOGRAPH
+0x8EC6 0x5C61 #CJK UNIFIED IDEOGRAPH
+0x8EC7 0x854A #CJK UNIFIED IDEOGRAPH
+0x8EC8 0x7E1E #CJK UNIFIED IDEOGRAPH
+0x8EC9 0x820E #CJK UNIFIED IDEOGRAPH
+0x8ECA 0x5199 #CJK UNIFIED IDEOGRAPH
+0x8ECB 0x5C04 #CJK UNIFIED IDEOGRAPH
+0x8ECC 0x6368 #CJK UNIFIED IDEOGRAPH
+0x8ECD 0x8D66 #CJK UNIFIED IDEOGRAPH
+0x8ECE 0x659C #CJK UNIFIED IDEOGRAPH
+0x8ECF 0x716E #CJK UNIFIED IDEOGRAPH
+0x8ED0 0x793E #CJK UNIFIED IDEOGRAPH
+0x8ED1 0x7D17 #CJK UNIFIED IDEOGRAPH
+0x8ED2 0x8005 #CJK UNIFIED IDEOGRAPH
+0x8ED3 0x8B1D #CJK UNIFIED IDEOGRAPH
+0x8ED4 0x8ECA #CJK UNIFIED IDEOGRAPH
+0x8ED5 0x906E #CJK UNIFIED IDEOGRAPH
+0x8ED6 0x86C7 #CJK UNIFIED IDEOGRAPH
+0x8ED7 0x90AA #CJK UNIFIED IDEOGRAPH
+0x8ED8 0x501F #CJK UNIFIED IDEOGRAPH
+0x8ED9 0x52FA #CJK UNIFIED IDEOGRAPH
+0x8EDA 0x5C3A #CJK UNIFIED IDEOGRAPH
+0x8EDB 0x6753 #CJK UNIFIED IDEOGRAPH
+0x8EDC 0x707C #CJK UNIFIED IDEOGRAPH
+0x8EDD 0x7235 #CJK UNIFIED IDEOGRAPH
+0x8EDE 0x914C #CJK UNIFIED IDEOGRAPH
+0x8EDF 0x91C8 #CJK UNIFIED IDEOGRAPH
+0x8EE0 0x932B #CJK UNIFIED IDEOGRAPH
+0x8EE1 0x82E5 #CJK UNIFIED IDEOGRAPH
+0x8EE2 0x5BC2 #CJK UNIFIED IDEOGRAPH
+0x8EE3 0x5F31 #CJK UNIFIED IDEOGRAPH
+0x8EE4 0x60F9 #CJK UNIFIED IDEOGRAPH
+0x8EE5 0x4E3B #CJK UNIFIED IDEOGRAPH
+0x8EE6 0x53D6 #CJK UNIFIED IDEOGRAPH
+0x8EE7 0x5B88 #CJK UNIFIED IDEOGRAPH
+0x8EE8 0x624B #CJK UNIFIED IDEOGRAPH
+0x8EE9 0x6731 #CJK UNIFIED IDEOGRAPH
+0x8EEA 0x6B8A #CJK UNIFIED IDEOGRAPH
+0x8EEB 0x72E9 #CJK UNIFIED IDEOGRAPH
+0x8EEC 0x73E0 #CJK UNIFIED IDEOGRAPH
+0x8EED 0x7A2E #CJK UNIFIED IDEOGRAPH
+0x8EEE 0x816B #CJK UNIFIED IDEOGRAPH
+0x8EEF 0x8DA3 #CJK UNIFIED IDEOGRAPH
+0x8EF0 0x9152 #CJK UNIFIED IDEOGRAPH
+0x8EF1 0x9996 #CJK UNIFIED IDEOGRAPH
+0x8EF2 0x5112 #CJK UNIFIED IDEOGRAPH
+0x8EF3 0x53D7 #CJK UNIFIED IDEOGRAPH
+0x8EF4 0x546A #CJK UNIFIED IDEOGRAPH
+0x8EF5 0x5BFF #CJK UNIFIED IDEOGRAPH
+0x8EF6 0x6388 #CJK UNIFIED IDEOGRAPH
+0x8EF7 0x6A39 #CJK UNIFIED IDEOGRAPH
+0x8EF8 0x7DAC #CJK UNIFIED IDEOGRAPH
+0x8EF9 0x9700 #CJK UNIFIED IDEOGRAPH
+0x8EFA 0x56DA #CJK UNIFIED IDEOGRAPH
+0x8EFB 0x53CE #CJK UNIFIED IDEOGRAPH
+0x8EFC 0x5468 #CJK UNIFIED IDEOGRAPH
+0x8F40 0x5B97 #CJK UNIFIED IDEOGRAPH
+0x8F41 0x5C31 #CJK UNIFIED IDEOGRAPH
+0x8F42 0x5DDE #CJK UNIFIED IDEOGRAPH
+0x8F43 0x4FEE #CJK UNIFIED IDEOGRAPH
+0x8F44 0x6101 #CJK UNIFIED IDEOGRAPH
+0x8F45 0x62FE #CJK UNIFIED IDEOGRAPH
+0x8F46 0x6D32 #CJK UNIFIED IDEOGRAPH
+0x8F47 0x79C0 #CJK UNIFIED IDEOGRAPH
+0x8F48 0x79CB #CJK UNIFIED IDEOGRAPH
+0x8F49 0x7D42 #CJK UNIFIED IDEOGRAPH
+0x8F4A 0x7E4D #CJK UNIFIED IDEOGRAPH
+0x8F4B 0x7FD2 #CJK UNIFIED IDEOGRAPH
+0x8F4C 0x81ED #CJK UNIFIED IDEOGRAPH
+0x8F4D 0x821F #CJK UNIFIED IDEOGRAPH
+0x8F4E 0x8490 #CJK UNIFIED IDEOGRAPH
+0x8F4F 0x8846 #CJK UNIFIED IDEOGRAPH
+0x8F50 0x8972 #CJK UNIFIED IDEOGRAPH
+0x8F51 0x8B90 #CJK UNIFIED IDEOGRAPH
+0x8F52 0x8E74 #CJK UNIFIED IDEOGRAPH
+0x8F53 0x8F2F #CJK UNIFIED IDEOGRAPH
+0x8F54 0x9031 #CJK UNIFIED IDEOGRAPH
+0x8F55 0x914B #CJK UNIFIED IDEOGRAPH
+0x8F56 0x916C #CJK UNIFIED IDEOGRAPH
+0x8F57 0x96C6 #CJK UNIFIED IDEOGRAPH
+0x8F58 0x919C #CJK UNIFIED IDEOGRAPH
+0x8F59 0x4EC0 #CJK UNIFIED IDEOGRAPH
+0x8F5A 0x4F4F #CJK UNIFIED IDEOGRAPH
+0x8F5B 0x5145 #CJK UNIFIED IDEOGRAPH
+0x8F5C 0x5341 #CJK UNIFIED IDEOGRAPH
+0x8F5D 0x5F93 #CJK UNIFIED IDEOGRAPH
+0x8F5E 0x620E #CJK UNIFIED IDEOGRAPH
+0x8F5F 0x67D4 #CJK UNIFIED IDEOGRAPH
+0x8F60 0x6C41 #CJK UNIFIED IDEOGRAPH
+0x8F61 0x6E0B #CJK UNIFIED IDEOGRAPH
+0x8F62 0x7363 #CJK UNIFIED IDEOGRAPH
+0x8F63 0x7E26 #CJK UNIFIED IDEOGRAPH
+0x8F64 0x91CD #CJK UNIFIED IDEOGRAPH
+0x8F65 0x9283 #CJK UNIFIED IDEOGRAPH
+0x8F66 0x53D4 #CJK UNIFIED IDEOGRAPH
+0x8F67 0x5919 #CJK UNIFIED IDEOGRAPH
+0x8F68 0x5BBF #CJK UNIFIED IDEOGRAPH
+0x8F69 0x6DD1 #CJK UNIFIED IDEOGRAPH
+0x8F6A 0x795D #CJK UNIFIED IDEOGRAPH
+0x8F6B 0x7E2E #CJK UNIFIED IDEOGRAPH
+0x8F6C 0x7C9B #CJK UNIFIED IDEOGRAPH
+0x8F6D 0x587E #CJK UNIFIED IDEOGRAPH
+0x8F6E 0x719F #CJK UNIFIED IDEOGRAPH
+0x8F6F 0x51FA #CJK UNIFIED IDEOGRAPH
+0x8F70 0x8853 #CJK UNIFIED IDEOGRAPH
+0x8F71 0x8FF0 #CJK UNIFIED IDEOGRAPH
+0x8F72 0x4FCA #CJK UNIFIED IDEOGRAPH
+0x8F73 0x5CFB #CJK UNIFIED IDEOGRAPH
+0x8F74 0x6625 #CJK UNIFIED IDEOGRAPH
+0x8F75 0x77AC #CJK UNIFIED IDEOGRAPH
+0x8F76 0x7AE3 #CJK UNIFIED IDEOGRAPH
+0x8F77 0x821C #CJK UNIFIED IDEOGRAPH
+0x8F78 0x99FF #CJK UNIFIED IDEOGRAPH
+0x8F79 0x51C6 #CJK UNIFIED IDEOGRAPH
+0x8F7A 0x5FAA #CJK UNIFIED IDEOGRAPH
+0x8F7B 0x65EC #CJK UNIFIED IDEOGRAPH
+0x8F7C 0x696F #CJK UNIFIED IDEOGRAPH
+0x8F7D 0x6B89 #CJK UNIFIED IDEOGRAPH
+0x8F7E 0x6DF3 #CJK UNIFIED IDEOGRAPH
+0x8F80 0x6E96 #CJK UNIFIED IDEOGRAPH
+0x8F81 0x6F64 #CJK UNIFIED IDEOGRAPH
+0x8F82 0x76FE #CJK UNIFIED IDEOGRAPH
+0x8F83 0x7D14 #CJK UNIFIED IDEOGRAPH
+0x8F84 0x5DE1 #CJK UNIFIED IDEOGRAPH
+0x8F85 0x9075 #CJK UNIFIED IDEOGRAPH
+0x8F86 0x9187 #CJK UNIFIED IDEOGRAPH
+0x8F87 0x9806 #CJK UNIFIED IDEOGRAPH
+0x8F88 0x51E6 #CJK UNIFIED IDEOGRAPH
+0x8F89 0x521D #CJK UNIFIED IDEOGRAPH
+0x8F8A 0x6240 #CJK UNIFIED IDEOGRAPH
+0x8F8B 0x6691 #CJK UNIFIED IDEOGRAPH
+0x8F8C 0x66D9 #CJK UNIFIED IDEOGRAPH
+0x8F8D 0x6E1A #CJK UNIFIED IDEOGRAPH
+0x8F8E 0x5EB6 #CJK UNIFIED IDEOGRAPH
+0x8F8F 0x7DD2 #CJK UNIFIED IDEOGRAPH
+0x8F90 0x7F72 #CJK UNIFIED IDEOGRAPH
+0x8F91 0x66F8 #CJK UNIFIED IDEOGRAPH
+0x8F92 0x85AF #CJK UNIFIED IDEOGRAPH
+0x8F93 0x85F7 #CJK UNIFIED IDEOGRAPH
+0x8F94 0x8AF8 #CJK UNIFIED IDEOGRAPH
+0x8F95 0x52A9 #CJK UNIFIED IDEOGRAPH
+0x8F96 0x53D9 #CJK UNIFIED IDEOGRAPH
+0x8F97 0x5973 #CJK UNIFIED IDEOGRAPH
+0x8F98 0x5E8F #CJK UNIFIED IDEOGRAPH
+0x8F99 0x5F90 #CJK UNIFIED IDEOGRAPH
+0x8F9A 0x6055 #CJK UNIFIED IDEOGRAPH
+0x8F9B 0x92E4 #CJK UNIFIED IDEOGRAPH
+0x8F9C 0x9664 #CJK UNIFIED IDEOGRAPH
+0x8F9D 0x50B7 #CJK UNIFIED IDEOGRAPH
+0x8F9E 0x511F #CJK UNIFIED IDEOGRAPH
+0x8F9F 0x52DD #CJK UNIFIED IDEOGRAPH
+0x8FA0 0x5320 #CJK UNIFIED IDEOGRAPH
+0x8FA1 0x5347 #CJK UNIFIED IDEOGRAPH
+0x8FA2 0x53EC #CJK UNIFIED IDEOGRAPH
+0x8FA3 0x54E8 #CJK UNIFIED IDEOGRAPH
+0x8FA4 0x5546 #CJK UNIFIED IDEOGRAPH
+0x8FA5 0x5531 #CJK UNIFIED IDEOGRAPH
+0x8FA6 0x5617 #CJK UNIFIED IDEOGRAPH
+0x8FA7 0x5968 #CJK UNIFIED IDEOGRAPH
+0x8FA8 0x59BE #CJK UNIFIED IDEOGRAPH
+0x8FA9 0x5A3C #CJK UNIFIED IDEOGRAPH
+0x8FAA 0x5BB5 #CJK UNIFIED IDEOGRAPH
+0x8FAB 0x5C06 #CJK UNIFIED IDEOGRAPH
+0x8FAC 0x5C0F #CJK UNIFIED IDEOGRAPH
+0x8FAD 0x5C11 #CJK UNIFIED IDEOGRAPH
+0x8FAE 0x5C1A #CJK UNIFIED IDEOGRAPH
+0x8FAF 0x5E84 #CJK UNIFIED IDEOGRAPH
+0x8FB0 0x5E8A #CJK UNIFIED IDEOGRAPH
+0x8FB1 0x5EE0 #CJK UNIFIED IDEOGRAPH
+0x8FB2 0x5F70 #CJK UNIFIED IDEOGRAPH
+0x8FB3 0x627F #CJK UNIFIED IDEOGRAPH
+0x8FB4 0x6284 #CJK UNIFIED IDEOGRAPH
+0x8FB5 0x62DB #CJK UNIFIED IDEOGRAPH
+0x8FB6 0x638C #CJK UNIFIED IDEOGRAPH
+0x8FB7 0x6377 #CJK UNIFIED IDEOGRAPH
+0x8FB8 0x6607 #CJK UNIFIED IDEOGRAPH
+0x8FB9 0x660C #CJK UNIFIED IDEOGRAPH
+0x8FBA 0x662D #CJK UNIFIED IDEOGRAPH
+0x8FBB 0x6676 #CJK UNIFIED IDEOGRAPH
+0x8FBC 0x677E #CJK UNIFIED IDEOGRAPH
+0x8FBD 0x68A2 #CJK UNIFIED IDEOGRAPH
+0x8FBE 0x6A1F #CJK UNIFIED IDEOGRAPH
+0x8FBF 0x6A35 #CJK UNIFIED IDEOGRAPH
+0x8FC0 0x6CBC #CJK UNIFIED IDEOGRAPH
+0x8FC1 0x6D88 #CJK UNIFIED IDEOGRAPH
+0x8FC2 0x6E09 #CJK UNIFIED IDEOGRAPH
+0x8FC3 0x6E58 #CJK UNIFIED IDEOGRAPH
+0x8FC4 0x713C #CJK UNIFIED IDEOGRAPH
+0x8FC5 0x7126 #CJK UNIFIED IDEOGRAPH
+0x8FC6 0x7167 #CJK UNIFIED IDEOGRAPH
+0x8FC7 0x75C7 #CJK UNIFIED IDEOGRAPH
+0x8FC8 0x7701 #CJK UNIFIED IDEOGRAPH
+0x8FC9 0x785D #CJK UNIFIED IDEOGRAPH
+0x8FCA 0x7901 #CJK UNIFIED IDEOGRAPH
+0x8FCB 0x7965 #CJK UNIFIED IDEOGRAPH
+0x8FCC 0x79F0 #CJK UNIFIED IDEOGRAPH
+0x8FCD 0x7AE0 #CJK UNIFIED IDEOGRAPH
+0x8FCE 0x7B11 #CJK UNIFIED IDEOGRAPH
+0x8FCF 0x7CA7 #CJK UNIFIED IDEOGRAPH
+0x8FD0 0x7D39 #CJK UNIFIED IDEOGRAPH
+0x8FD1 0x8096 #CJK UNIFIED IDEOGRAPH
+0x8FD2 0x83D6 #CJK UNIFIED IDEOGRAPH
+0x8FD3 0x848B #CJK UNIFIED IDEOGRAPH
+0x8FD4 0x8549 #CJK UNIFIED IDEOGRAPH
+0x8FD5 0x885D #CJK UNIFIED IDEOGRAPH
+0x8FD6 0x88F3 #CJK UNIFIED IDEOGRAPH
+0x8FD7 0x8A1F #CJK UNIFIED IDEOGRAPH
+0x8FD8 0x8A3C #CJK UNIFIED IDEOGRAPH
+0x8FD9 0x8A54 #CJK UNIFIED IDEOGRAPH
+0x8FDA 0x8A73 #CJK UNIFIED IDEOGRAPH
+0x8FDB 0x8C61 #CJK UNIFIED IDEOGRAPH
+0x8FDC 0x8CDE #CJK UNIFIED IDEOGRAPH
+0x8FDD 0x91A4 #CJK UNIFIED IDEOGRAPH
+0x8FDE 0x9266 #CJK UNIFIED IDEOGRAPH
+0x8FDF 0x937E #CJK UNIFIED IDEOGRAPH
+0x8FE0 0x9418 #CJK UNIFIED IDEOGRAPH
+0x8FE1 0x969C #CJK UNIFIED IDEOGRAPH
+0x8FE2 0x9798 #CJK UNIFIED IDEOGRAPH
+0x8FE3 0x4E0A #CJK UNIFIED IDEOGRAPH
+0x8FE4 0x4E08 #CJK UNIFIED IDEOGRAPH
+0x8FE5 0x4E1E #CJK UNIFIED IDEOGRAPH
+0x8FE6 0x4E57 #CJK UNIFIED IDEOGRAPH
+0x8FE7 0x5197 #CJK UNIFIED IDEOGRAPH
+0x8FE8 0x5270 #CJK UNIFIED IDEOGRAPH
+0x8FE9 0x57CE #CJK UNIFIED IDEOGRAPH
+0x8FEA 0x5834 #CJK UNIFIED IDEOGRAPH
+0x8FEB 0x58CC #CJK UNIFIED IDEOGRAPH
+0x8FEC 0x5B22 #CJK UNIFIED IDEOGRAPH
+0x8FED 0x5E38 #CJK UNIFIED IDEOGRAPH
+0x8FEE 0x60C5 #CJK UNIFIED IDEOGRAPH
+0x8FEF 0x64FE #CJK UNIFIED IDEOGRAPH
+0x8FF0 0x6761 #CJK UNIFIED IDEOGRAPH
+0x8FF1 0x6756 #CJK UNIFIED IDEOGRAPH
+0x8FF2 0x6D44 #CJK UNIFIED IDEOGRAPH
+0x8FF3 0x72B6 #CJK UNIFIED IDEOGRAPH
+0x8FF4 0x7573 #CJK UNIFIED IDEOGRAPH
+0x8FF5 0x7A63 #CJK UNIFIED IDEOGRAPH
+0x8FF6 0x84B8 #CJK UNIFIED IDEOGRAPH
+0x8FF7 0x8B72 #CJK UNIFIED IDEOGRAPH
+0x8FF8 0x91B8 #CJK UNIFIED IDEOGRAPH
+0x8FF9 0x9320 #CJK UNIFIED IDEOGRAPH
+0x8FFA 0x5631 #CJK UNIFIED IDEOGRAPH
+0x8FFB 0x57F4 #CJK UNIFIED IDEOGRAPH
+0x8FFC 0x98FE #CJK UNIFIED IDEOGRAPH
+0x9040 0x62ED #CJK UNIFIED IDEOGRAPH
+0x9041 0x690D #CJK UNIFIED IDEOGRAPH
+0x9042 0x6B96 #CJK UNIFIED IDEOGRAPH
+0x9043 0x71ED #CJK UNIFIED IDEOGRAPH
+0x9044 0x7E54 #CJK UNIFIED IDEOGRAPH
+0x9045 0x8077 #CJK UNIFIED IDEOGRAPH
+0x9046 0x8272 #CJK UNIFIED IDEOGRAPH
+0x9047 0x89E6 #CJK UNIFIED IDEOGRAPH
+0x9048 0x98DF #CJK UNIFIED IDEOGRAPH
+0x9049 0x8755 #CJK UNIFIED IDEOGRAPH
+0x904A 0x8FB1 #CJK UNIFIED IDEOGRAPH
+0x904B 0x5C3B #CJK UNIFIED IDEOGRAPH
+0x904C 0x4F38 #CJK UNIFIED IDEOGRAPH
+0x904D 0x4FE1 #CJK UNIFIED IDEOGRAPH
+0x904E 0x4FB5 #CJK UNIFIED IDEOGRAPH
+0x904F 0x5507 #CJK UNIFIED IDEOGRAPH
+0x9050 0x5A20 #CJK UNIFIED IDEOGRAPH
+0x9051 0x5BDD #CJK UNIFIED IDEOGRAPH
+0x9052 0x5BE9 #CJK UNIFIED IDEOGRAPH
+0x9053 0x5FC3 #CJK UNIFIED IDEOGRAPH
+0x9054 0x614E #CJK UNIFIED IDEOGRAPH
+0x9055 0x632F #CJK UNIFIED IDEOGRAPH
+0x9056 0x65B0 #CJK UNIFIED IDEOGRAPH
+0x9057 0x664B #CJK UNIFIED IDEOGRAPH
+0x9058 0x68EE #CJK UNIFIED IDEOGRAPH
+0x9059 0x699B #CJK UNIFIED IDEOGRAPH
+0x905A 0x6D78 #CJK UNIFIED IDEOGRAPH
+0x905B 0x6DF1 #CJK UNIFIED IDEOGRAPH
+0x905C 0x7533 #CJK UNIFIED IDEOGRAPH
+0x905D 0x75B9 #CJK UNIFIED IDEOGRAPH
+0x905E 0x771F #CJK UNIFIED IDEOGRAPH
+0x905F 0x795E #CJK UNIFIED IDEOGRAPH
+0x9060 0x79E6 #CJK UNIFIED IDEOGRAPH
+0x9061 0x7D33 #CJK UNIFIED IDEOGRAPH
+0x9062 0x81E3 #CJK UNIFIED IDEOGRAPH
+0x9063 0x82AF #CJK UNIFIED IDEOGRAPH
+0x9064 0x85AA #CJK UNIFIED IDEOGRAPH
+0x9065 0x89AA #CJK UNIFIED IDEOGRAPH
+0x9066 0x8A3A #CJK UNIFIED IDEOGRAPH
+0x9067 0x8EAB #CJK UNIFIED IDEOGRAPH
+0x9068 0x8F9B #CJK UNIFIED IDEOGRAPH
+0x9069 0x9032 #CJK UNIFIED IDEOGRAPH
+0x906A 0x91DD #CJK UNIFIED IDEOGRAPH
+0x906B 0x9707 #CJK UNIFIED IDEOGRAPH
+0x906C 0x4EBA #CJK UNIFIED IDEOGRAPH
+0x906D 0x4EC1 #CJK UNIFIED IDEOGRAPH
+0x906E 0x5203 #CJK UNIFIED IDEOGRAPH
+0x906F 0x5875 #CJK UNIFIED IDEOGRAPH
+0x9070 0x58EC #CJK UNIFIED IDEOGRAPH
+0x9071 0x5C0B #CJK UNIFIED IDEOGRAPH
+0x9072 0x751A #CJK UNIFIED IDEOGRAPH
+0x9073 0x5C3D #CJK UNIFIED IDEOGRAPH
+0x9074 0x814E #CJK UNIFIED IDEOGRAPH
+0x9075 0x8A0A #CJK UNIFIED IDEOGRAPH
+0x9076 0x8FC5 #CJK UNIFIED IDEOGRAPH
+0x9077 0x9663 #CJK UNIFIED IDEOGRAPH
+0x9078 0x976D #CJK UNIFIED IDEOGRAPH
+0x9079 0x7B25 #CJK UNIFIED IDEOGRAPH
+0x907A 0x8ACF #CJK UNIFIED IDEOGRAPH
+0x907B 0x9808 #CJK UNIFIED IDEOGRAPH
+0x907C 0x9162 #CJK UNIFIED IDEOGRAPH
+0x907D 0x56F3 #CJK UNIFIED IDEOGRAPH
+0x907E 0x53A8 #CJK UNIFIED IDEOGRAPH
+0x9080 0x9017 #CJK UNIFIED IDEOGRAPH
+0x9081 0x5439 #CJK UNIFIED IDEOGRAPH
+0x9082 0x5782 #CJK UNIFIED IDEOGRAPH
+0x9083 0x5E25 #CJK UNIFIED IDEOGRAPH
+0x9084 0x63A8 #CJK UNIFIED IDEOGRAPH
+0x9085 0x6C34 #CJK UNIFIED IDEOGRAPH
+0x9086 0x708A #CJK UNIFIED IDEOGRAPH
+0x9087 0x7761 #CJK UNIFIED IDEOGRAPH
+0x9088 0x7C8B #CJK UNIFIED IDEOGRAPH
+0x9089 0x7FE0 #CJK UNIFIED IDEOGRAPH
+0x908A 0x8870 #CJK UNIFIED IDEOGRAPH
+0x908B 0x9042 #CJK UNIFIED IDEOGRAPH
+0x908C 0x9154 #CJK UNIFIED IDEOGRAPH
+0x908D 0x9310 #CJK UNIFIED IDEOGRAPH
+0x908E 0x9318 #CJK UNIFIED IDEOGRAPH
+0x908F 0x968F #CJK UNIFIED IDEOGRAPH
+0x9090 0x745E #CJK UNIFIED IDEOGRAPH
+0x9091 0x9AC4 #CJK UNIFIED IDEOGRAPH
+0x9092 0x5D07 #CJK UNIFIED IDEOGRAPH
+0x9093 0x5D69 #CJK UNIFIED IDEOGRAPH
+0x9094 0x6570 #CJK UNIFIED IDEOGRAPH
+0x9095 0x67A2 #CJK UNIFIED IDEOGRAPH
+0x9096 0x8DA8 #CJK UNIFIED IDEOGRAPH
+0x9097 0x96DB #CJK UNIFIED IDEOGRAPH
+0x9098 0x636E #CJK UNIFIED IDEOGRAPH
+0x9099 0x6749 #CJK UNIFIED IDEOGRAPH
+0x909A 0x6919 #CJK UNIFIED IDEOGRAPH
+0x909B 0x83C5 #CJK UNIFIED IDEOGRAPH
+0x909C 0x9817 #CJK UNIFIED IDEOGRAPH
+0x909D 0x96C0 #CJK UNIFIED IDEOGRAPH
+0x909E 0x88FE #CJK UNIFIED IDEOGRAPH
+0x909F 0x6F84 #CJK UNIFIED IDEOGRAPH
+0x90A0 0x647A #CJK UNIFIED IDEOGRAPH
+0x90A1 0x5BF8 #CJK UNIFIED IDEOGRAPH
+0x90A2 0x4E16 #CJK UNIFIED IDEOGRAPH
+0x90A3 0x702C #CJK UNIFIED IDEOGRAPH
+0x90A4 0x755D #CJK UNIFIED IDEOGRAPH
+0x90A5 0x662F #CJK UNIFIED IDEOGRAPH
+0x90A6 0x51C4 #CJK UNIFIED IDEOGRAPH
+0x90A7 0x5236 #CJK UNIFIED IDEOGRAPH
+0x90A8 0x52E2 #CJK UNIFIED IDEOGRAPH
+0x90A9 0x59D3 #CJK UNIFIED IDEOGRAPH
+0x90AA 0x5F81 #CJK UNIFIED IDEOGRAPH
+0x90AB 0x6027 #CJK UNIFIED IDEOGRAPH
+0x90AC 0x6210 #CJK UNIFIED IDEOGRAPH
+0x90AD 0x653F #CJK UNIFIED IDEOGRAPH
+0x90AE 0x6574 #CJK UNIFIED IDEOGRAPH
+0x90AF 0x661F #CJK UNIFIED IDEOGRAPH
+0x90B0 0x6674 #CJK UNIFIED IDEOGRAPH
+0x90B1 0x68F2 #CJK UNIFIED IDEOGRAPH
+0x90B2 0x6816 #CJK UNIFIED IDEOGRAPH
+0x90B3 0x6B63 #CJK UNIFIED IDEOGRAPH
+0x90B4 0x6E05 #CJK UNIFIED IDEOGRAPH
+0x90B5 0x7272 #CJK UNIFIED IDEOGRAPH
+0x90B6 0x751F #CJK UNIFIED IDEOGRAPH
+0x90B7 0x76DB #CJK UNIFIED IDEOGRAPH
+0x90B8 0x7CBE #CJK UNIFIED IDEOGRAPH
+0x90B9 0x8056 #CJK UNIFIED IDEOGRAPH
+0x90BA 0x58F0 #CJK UNIFIED IDEOGRAPH
+0x90BB 0x88FD #CJK UNIFIED IDEOGRAPH
+0x90BC 0x897F #CJK UNIFIED IDEOGRAPH
+0x90BD 0x8AA0 #CJK UNIFIED IDEOGRAPH
+0x90BE 0x8A93 #CJK UNIFIED IDEOGRAPH
+0x90BF 0x8ACB #CJK UNIFIED IDEOGRAPH
+0x90C0 0x901D #CJK UNIFIED IDEOGRAPH
+0x90C1 0x9192 #CJK UNIFIED IDEOGRAPH
+0x90C2 0x9752 #CJK UNIFIED IDEOGRAPH
+0x90C3 0x9759 #CJK UNIFIED IDEOGRAPH
+0x90C4 0x6589 #CJK UNIFIED IDEOGRAPH
+0x90C5 0x7A0E #CJK UNIFIED IDEOGRAPH
+0x90C6 0x8106 #CJK UNIFIED IDEOGRAPH
+0x90C7 0x96BB #CJK UNIFIED IDEOGRAPH
+0x90C8 0x5E2D #CJK UNIFIED IDEOGRAPH
+0x90C9 0x60DC #CJK UNIFIED IDEOGRAPH
+0x90CA 0x621A #CJK UNIFIED IDEOGRAPH
+0x90CB 0x65A5 #CJK UNIFIED IDEOGRAPH
+0x90CC 0x6614 #CJK UNIFIED IDEOGRAPH
+0x90CD 0x6790 #CJK UNIFIED IDEOGRAPH
+0x90CE 0x77F3 #CJK UNIFIED IDEOGRAPH
+0x90CF 0x7A4D #CJK UNIFIED IDEOGRAPH
+0x90D0 0x7C4D #CJK UNIFIED IDEOGRAPH
+0x90D1 0x7E3E #CJK UNIFIED IDEOGRAPH
+0x90D2 0x810A #CJK UNIFIED IDEOGRAPH
+0x90D3 0x8CAC #CJK UNIFIED IDEOGRAPH
+0x90D4 0x8D64 #CJK UNIFIED IDEOGRAPH
+0x90D5 0x8DE1 #CJK UNIFIED IDEOGRAPH
+0x90D6 0x8E5F #CJK UNIFIED IDEOGRAPH
+0x90D7 0x78A9 #CJK UNIFIED IDEOGRAPH
+0x90D8 0x5207 #CJK UNIFIED IDEOGRAPH
+0x90D9 0x62D9 #CJK UNIFIED IDEOGRAPH
+0x90DA 0x63A5 #CJK UNIFIED IDEOGRAPH
+0x90DB 0x6442 #CJK UNIFIED IDEOGRAPH
+0x90DC 0x6298 #CJK UNIFIED IDEOGRAPH
+0x90DD 0x8A2D #CJK UNIFIED IDEOGRAPH
+0x90DE 0x7A83 #CJK UNIFIED IDEOGRAPH
+0x90DF 0x7BC0 #CJK UNIFIED IDEOGRAPH
+0x90E0 0x8AAC #CJK UNIFIED IDEOGRAPH
+0x90E1 0x96EA #CJK UNIFIED IDEOGRAPH
+0x90E2 0x7D76 #CJK UNIFIED IDEOGRAPH
+0x90E3 0x820C #CJK UNIFIED IDEOGRAPH
+0x90E4 0x8749 #CJK UNIFIED IDEOGRAPH
+0x90E5 0x4ED9 #CJK UNIFIED IDEOGRAPH
+0x90E6 0x5148 #CJK UNIFIED IDEOGRAPH
+0x90E7 0x5343 #CJK UNIFIED IDEOGRAPH
+0x90E8 0x5360 #CJK UNIFIED IDEOGRAPH
+0x90E9 0x5BA3 #CJK UNIFIED IDEOGRAPH
+0x90EA 0x5C02 #CJK UNIFIED IDEOGRAPH
+0x90EB 0x5C16 #CJK UNIFIED IDEOGRAPH
+0x90EC 0x5DDD #CJK UNIFIED IDEOGRAPH
+0x90ED 0x6226 #CJK UNIFIED IDEOGRAPH
+0x90EE 0x6247 #CJK UNIFIED IDEOGRAPH
+0x90EF 0x64B0 #CJK UNIFIED IDEOGRAPH
+0x90F0 0x6813 #CJK UNIFIED IDEOGRAPH
+0x90F1 0x6834 #CJK UNIFIED IDEOGRAPH
+0x90F2 0x6CC9 #CJK UNIFIED IDEOGRAPH
+0x90F3 0x6D45 #CJK UNIFIED IDEOGRAPH
+0x90F4 0x6D17 #CJK UNIFIED IDEOGRAPH
+0x90F5 0x67D3 #CJK UNIFIED IDEOGRAPH
+0x90F6 0x6F5C #CJK UNIFIED IDEOGRAPH
+0x90F7 0x714E #CJK UNIFIED IDEOGRAPH
+0x90F8 0x717D #CJK UNIFIED IDEOGRAPH
+0x90F9 0x65CB #CJK UNIFIED IDEOGRAPH
+0x90FA 0x7A7F #CJK UNIFIED IDEOGRAPH
+0x90FB 0x7BAD #CJK UNIFIED IDEOGRAPH
+0x90FC 0x7DDA #CJK UNIFIED IDEOGRAPH
+0x9140 0x7E4A #CJK UNIFIED IDEOGRAPH
+0x9141 0x7FA8 #CJK UNIFIED IDEOGRAPH
+0x9142 0x817A #CJK UNIFIED IDEOGRAPH
+0x9143 0x821B #CJK UNIFIED IDEOGRAPH
+0x9144 0x8239 #CJK UNIFIED IDEOGRAPH
+0x9145 0x85A6 #CJK UNIFIED IDEOGRAPH
+0x9146 0x8A6E #CJK UNIFIED IDEOGRAPH
+0x9147 0x8CCE #CJK UNIFIED IDEOGRAPH
+0x9148 0x8DF5 #CJK UNIFIED IDEOGRAPH
+0x9149 0x9078 #CJK UNIFIED IDEOGRAPH
+0x914A 0x9077 #CJK UNIFIED IDEOGRAPH
+0x914B 0x92AD #CJK UNIFIED IDEOGRAPH
+0x914C 0x9291 #CJK UNIFIED IDEOGRAPH
+0x914D 0x9583 #CJK UNIFIED IDEOGRAPH
+0x914E 0x9BAE #CJK UNIFIED IDEOGRAPH
+0x914F 0x524D #CJK UNIFIED IDEOGRAPH
+0x9150 0x5584 #CJK UNIFIED IDEOGRAPH
+0x9151 0x6F38 #CJK UNIFIED IDEOGRAPH
+0x9152 0x7136 #CJK UNIFIED IDEOGRAPH
+0x9153 0x5168 #CJK UNIFIED IDEOGRAPH
+0x9154 0x7985 #CJK UNIFIED IDEOGRAPH
+0x9155 0x7E55 #CJK UNIFIED IDEOGRAPH
+0x9156 0x81B3 #CJK UNIFIED IDEOGRAPH
+0x9157 0x7CCE #CJK UNIFIED IDEOGRAPH
+0x9158 0x564C #CJK UNIFIED IDEOGRAPH
+0x9159 0x5851 #CJK UNIFIED IDEOGRAPH
+0x915A 0x5CA8 #CJK UNIFIED IDEOGRAPH
+0x915B 0x63AA #CJK UNIFIED IDEOGRAPH
+0x915C 0x66FE #CJK UNIFIED IDEOGRAPH
+0x915D 0x66FD #CJK UNIFIED IDEOGRAPH
+0x915E 0x695A #CJK UNIFIED IDEOGRAPH
+0x915F 0x72D9 #CJK UNIFIED IDEOGRAPH
+0x9160 0x758F #CJK UNIFIED IDEOGRAPH
+0x9161 0x758E #CJK UNIFIED IDEOGRAPH
+0x9162 0x790E #CJK UNIFIED IDEOGRAPH
+0x9163 0x7956 #CJK UNIFIED IDEOGRAPH
+0x9164 0x79DF #CJK UNIFIED IDEOGRAPH
+0x9165 0x7C97 #CJK UNIFIED IDEOGRAPH
+0x9166 0x7D20 #CJK UNIFIED IDEOGRAPH
+0x9167 0x7D44 #CJK UNIFIED IDEOGRAPH
+0x9168 0x8607 #CJK UNIFIED IDEOGRAPH
+0x9169 0x8A34 #CJK UNIFIED IDEOGRAPH
+0x916A 0x963B #CJK UNIFIED IDEOGRAPH
+0x916B 0x9061 #CJK UNIFIED IDEOGRAPH
+0x916C 0x9F20 #CJK UNIFIED IDEOGRAPH
+0x916D 0x50E7 #CJK UNIFIED IDEOGRAPH
+0x916E 0x5275 #CJK UNIFIED IDEOGRAPH
+0x916F 0x53CC #CJK UNIFIED IDEOGRAPH
+0x9170 0x53E2 #CJK UNIFIED IDEOGRAPH
+0x9171 0x5009 #CJK UNIFIED IDEOGRAPH
+0x9172 0x55AA #CJK UNIFIED IDEOGRAPH
+0x9173 0x58EE #CJK UNIFIED IDEOGRAPH
+0x9174 0x594F #CJK UNIFIED IDEOGRAPH
+0x9175 0x723D #CJK UNIFIED IDEOGRAPH
+0x9176 0x5B8B #CJK UNIFIED IDEOGRAPH
+0x9177 0x5C64 #CJK UNIFIED IDEOGRAPH
+0x9178 0x531D #CJK UNIFIED IDEOGRAPH
+0x9179 0x60E3 #CJK UNIFIED IDEOGRAPH
+0x917A 0x60F3 #CJK UNIFIED IDEOGRAPH
+0x917B 0x635C #CJK UNIFIED IDEOGRAPH
+0x917C 0x6383 #CJK UNIFIED IDEOGRAPH
+0x917D 0x633F #CJK UNIFIED IDEOGRAPH
+0x917E 0x63BB #CJK UNIFIED IDEOGRAPH
+0x9180 0x64CD #CJK UNIFIED IDEOGRAPH
+0x9181 0x65E9 #CJK UNIFIED IDEOGRAPH
+0x9182 0x66F9 #CJK UNIFIED IDEOGRAPH
+0x9183 0x5DE3 #CJK UNIFIED IDEOGRAPH
+0x9184 0x69CD #CJK UNIFIED IDEOGRAPH
+0x9185 0x69FD #CJK UNIFIED IDEOGRAPH
+0x9186 0x6F15 #CJK UNIFIED IDEOGRAPH
+0x9187 0x71E5 #CJK UNIFIED IDEOGRAPH
+0x9188 0x4E89 #CJK UNIFIED IDEOGRAPH
+0x9189 0x75E9 #CJK UNIFIED IDEOGRAPH
+0x918A 0x76F8 #CJK UNIFIED IDEOGRAPH
+0x918B 0x7A93 #CJK UNIFIED IDEOGRAPH
+0x918C 0x7CDF #CJK UNIFIED IDEOGRAPH
+0x918D 0x7DCF #CJK UNIFIED IDEOGRAPH
+0x918E 0x7D9C #CJK UNIFIED IDEOGRAPH
+0x918F 0x8061 #CJK UNIFIED IDEOGRAPH
+0x9190 0x8349 #CJK UNIFIED IDEOGRAPH
+0x9191 0x8358 #CJK UNIFIED IDEOGRAPH
+0x9192 0x846C #CJK UNIFIED IDEOGRAPH
+0x9193 0x84BC #CJK UNIFIED IDEOGRAPH
+0x9194 0x85FB #CJK UNIFIED IDEOGRAPH
+0x9195 0x88C5 #CJK UNIFIED IDEOGRAPH
+0x9196 0x8D70 #CJK UNIFIED IDEOGRAPH
+0x9197 0x9001 #CJK UNIFIED IDEOGRAPH
+0x9198 0x906D #CJK UNIFIED IDEOGRAPH
+0x9199 0x9397 #CJK UNIFIED IDEOGRAPH
+0x919A 0x971C #CJK UNIFIED IDEOGRAPH
+0x919B 0x9A12 #CJK UNIFIED IDEOGRAPH
+0x919C 0x50CF #CJK UNIFIED IDEOGRAPH
+0x919D 0x5897 #CJK UNIFIED IDEOGRAPH
+0x919E 0x618E #CJK UNIFIED IDEOGRAPH
+0x919F 0x81D3 #CJK UNIFIED IDEOGRAPH
+0x91A0 0x8535 #CJK UNIFIED IDEOGRAPH
+0x91A1 0x8D08 #CJK UNIFIED IDEOGRAPH
+0x91A2 0x9020 #CJK UNIFIED IDEOGRAPH
+0x91A3 0x4FC3 #CJK UNIFIED IDEOGRAPH
+0x91A4 0x5074 #CJK UNIFIED IDEOGRAPH
+0x91A5 0x5247 #CJK UNIFIED IDEOGRAPH
+0x91A6 0x5373 #CJK UNIFIED IDEOGRAPH
+0x91A7 0x606F #CJK UNIFIED IDEOGRAPH
+0x91A8 0x6349 #CJK UNIFIED IDEOGRAPH
+0x91A9 0x675F #CJK UNIFIED IDEOGRAPH
+0x91AA 0x6E2C #CJK UNIFIED IDEOGRAPH
+0x91AB 0x8DB3 #CJK UNIFIED IDEOGRAPH
+0x91AC 0x901F #CJK UNIFIED IDEOGRAPH
+0x91AD 0x4FD7 #CJK UNIFIED IDEOGRAPH
+0x91AE 0x5C5E #CJK UNIFIED IDEOGRAPH
+0x91AF 0x8CCA #CJK UNIFIED IDEOGRAPH
+0x91B0 0x65CF #CJK UNIFIED IDEOGRAPH
+0x91B1 0x7D9A #CJK UNIFIED IDEOGRAPH
+0x91B2 0x5352 #CJK UNIFIED IDEOGRAPH
+0x91B3 0x8896 #CJK UNIFIED IDEOGRAPH
+0x91B4 0x5176 #CJK UNIFIED IDEOGRAPH
+0x91B5 0x63C3 #CJK UNIFIED IDEOGRAPH
+0x91B6 0x5B58 #CJK UNIFIED IDEOGRAPH
+0x91B7 0x5B6B #CJK UNIFIED IDEOGRAPH
+0x91B8 0x5C0A #CJK UNIFIED IDEOGRAPH
+0x91B9 0x640D #CJK UNIFIED IDEOGRAPH
+0x91BA 0x6751 #CJK UNIFIED IDEOGRAPH
+0x91BB 0x905C #CJK UNIFIED IDEOGRAPH
+0x91BC 0x4ED6 #CJK UNIFIED IDEOGRAPH
+0x91BD 0x591A #CJK UNIFIED IDEOGRAPH
+0x91BE 0x592A #CJK UNIFIED IDEOGRAPH
+0x91BF 0x6C70 #CJK UNIFIED IDEOGRAPH
+0x91C0 0x8A51 #CJK UNIFIED IDEOGRAPH
+0x91C1 0x553E #CJK UNIFIED IDEOGRAPH
+0x91C2 0x5815 #CJK UNIFIED IDEOGRAPH
+0x91C3 0x59A5 #CJK UNIFIED IDEOGRAPH
+0x91C4 0x60F0 #CJK UNIFIED IDEOGRAPH
+0x91C5 0x6253 #CJK UNIFIED IDEOGRAPH
+0x91C6 0x67C1 #CJK UNIFIED IDEOGRAPH
+0x91C7 0x8235 #CJK UNIFIED IDEOGRAPH
+0x91C8 0x6955 #CJK UNIFIED IDEOGRAPH
+0x91C9 0x9640 #CJK UNIFIED IDEOGRAPH
+0x91CA 0x99C4 #CJK UNIFIED IDEOGRAPH
+0x91CB 0x9A28 #CJK UNIFIED IDEOGRAPH
+0x91CC 0x4F53 #CJK UNIFIED IDEOGRAPH
+0x91CD 0x5806 #CJK UNIFIED IDEOGRAPH
+0x91CE 0x5BFE #CJK UNIFIED IDEOGRAPH
+0x91CF 0x8010 #CJK UNIFIED IDEOGRAPH
+0x91D0 0x5CB1 #CJK UNIFIED IDEOGRAPH
+0x91D1 0x5E2F #CJK UNIFIED IDEOGRAPH
+0x91D2 0x5F85 #CJK UNIFIED IDEOGRAPH
+0x91D3 0x6020 #CJK UNIFIED IDEOGRAPH
+0x91D4 0x614B #CJK UNIFIED IDEOGRAPH
+0x91D5 0x6234 #CJK UNIFIED IDEOGRAPH
+0x91D6 0x66FF #CJK UNIFIED IDEOGRAPH
+0x91D7 0x6CF0 #CJK UNIFIED IDEOGRAPH
+0x91D8 0x6EDE #CJK UNIFIED IDEOGRAPH
+0x91D9 0x80CE #CJK UNIFIED IDEOGRAPH
+0x91DA 0x817F #CJK UNIFIED IDEOGRAPH
+0x91DB 0x82D4 #CJK UNIFIED IDEOGRAPH
+0x91DC 0x888B #CJK UNIFIED IDEOGRAPH
+0x91DD 0x8CB8 #CJK UNIFIED IDEOGRAPH
+0x91DE 0x9000 #CJK UNIFIED IDEOGRAPH
+0x91DF 0x902E #CJK UNIFIED IDEOGRAPH
+0x91E0 0x968A #CJK UNIFIED IDEOGRAPH
+0x91E1 0x9EDB #CJK UNIFIED IDEOGRAPH
+0x91E2 0x9BDB #CJK UNIFIED IDEOGRAPH
+0x91E3 0x4EE3 #CJK UNIFIED IDEOGRAPH
+0x91E4 0x53F0 #CJK UNIFIED IDEOGRAPH
+0x91E5 0x5927 #CJK UNIFIED IDEOGRAPH
+0x91E6 0x7B2C #CJK UNIFIED IDEOGRAPH
+0x91E7 0x918D #CJK UNIFIED IDEOGRAPH
+0x91E8 0x984C #CJK UNIFIED IDEOGRAPH
+0x91E9 0x9DF9 #CJK UNIFIED IDEOGRAPH
+0x91EA 0x6EDD #CJK UNIFIED IDEOGRAPH
+0x91EB 0x7027 #CJK UNIFIED IDEOGRAPH
+0x91EC 0x5353 #CJK UNIFIED IDEOGRAPH
+0x91ED 0x5544 #CJK UNIFIED IDEOGRAPH
+0x91EE 0x5B85 #CJK UNIFIED IDEOGRAPH
+0x91EF 0x6258 #CJK UNIFIED IDEOGRAPH
+0x91F0 0x629E #CJK UNIFIED IDEOGRAPH
+0x91F1 0x62D3 #CJK UNIFIED IDEOGRAPH
+0x91F2 0x6CA2 #CJK UNIFIED IDEOGRAPH
+0x91F3 0x6FEF #CJK UNIFIED IDEOGRAPH
+0x91F4 0x7422 #CJK UNIFIED IDEOGRAPH
+0x91F5 0x8A17 #CJK UNIFIED IDEOGRAPH
+0x91F6 0x9438 #CJK UNIFIED IDEOGRAPH
+0x91F7 0x6FC1 #CJK UNIFIED IDEOGRAPH
+0x91F8 0x8AFE #CJK UNIFIED IDEOGRAPH
+0x91F9 0x8338 #CJK UNIFIED IDEOGRAPH
+0x91FA 0x51E7 #CJK UNIFIED IDEOGRAPH
+0x91FB 0x86F8 #CJK UNIFIED IDEOGRAPH
+0x91FC 0x53EA #CJK UNIFIED IDEOGRAPH
+0x9240 0x53E9 #CJK UNIFIED IDEOGRAPH
+0x9241 0x4F46 #CJK UNIFIED IDEOGRAPH
+0x9242 0x9054 #CJK UNIFIED IDEOGRAPH
+0x9243 0x8FB0 #CJK UNIFIED IDEOGRAPH
+0x9244 0x596A #CJK UNIFIED IDEOGRAPH
+0x9245 0x8131 #CJK UNIFIED IDEOGRAPH
+0x9246 0x5DFD #CJK UNIFIED IDEOGRAPH
+0x9247 0x7AEA #CJK UNIFIED IDEOGRAPH
+0x9248 0x8FBF #CJK UNIFIED IDEOGRAPH
+0x9249 0x68DA #CJK UNIFIED IDEOGRAPH
+0x924A 0x8C37 #CJK UNIFIED IDEOGRAPH
+0x924B 0x72F8 #CJK UNIFIED IDEOGRAPH
+0x924C 0x9C48 #CJK UNIFIED IDEOGRAPH
+0x924D 0x6A3D #CJK UNIFIED IDEOGRAPH
+0x924E 0x8AB0 #CJK UNIFIED IDEOGRAPH
+0x924F 0x4E39 #CJK UNIFIED IDEOGRAPH
+0x9250 0x5358 #CJK UNIFIED IDEOGRAPH
+0x9251 0x5606 #CJK UNIFIED IDEOGRAPH
+0x9252 0x5766 #CJK UNIFIED IDEOGRAPH
+0x9253 0x62C5 #CJK UNIFIED IDEOGRAPH
+0x9254 0x63A2 #CJK UNIFIED IDEOGRAPH
+0x9255 0x65E6 #CJK UNIFIED IDEOGRAPH
+0x9256 0x6B4E #CJK UNIFIED IDEOGRAPH
+0x9257 0x6DE1 #CJK UNIFIED IDEOGRAPH
+0x9258 0x6E5B #CJK UNIFIED IDEOGRAPH
+0x9259 0x70AD #CJK UNIFIED IDEOGRAPH
+0x925A 0x77ED #CJK UNIFIED IDEOGRAPH
+0x925B 0x7AEF #CJK UNIFIED IDEOGRAPH
+0x925C 0x7BAA #CJK UNIFIED IDEOGRAPH
+0x925D 0x7DBB #CJK UNIFIED IDEOGRAPH
+0x925E 0x803D #CJK UNIFIED IDEOGRAPH
+0x925F 0x80C6 #CJK UNIFIED IDEOGRAPH
+0x9260 0x86CB #CJK UNIFIED IDEOGRAPH
+0x9261 0x8A95 #CJK UNIFIED IDEOGRAPH
+0x9262 0x935B #CJK UNIFIED IDEOGRAPH
+0x9263 0x56E3 #CJK UNIFIED IDEOGRAPH
+0x9264 0x58C7 #CJK UNIFIED IDEOGRAPH
+0x9265 0x5F3E #CJK UNIFIED IDEOGRAPH
+0x9266 0x65AD #CJK UNIFIED IDEOGRAPH
+0x9267 0x6696 #CJK UNIFIED IDEOGRAPH
+0x9268 0x6A80 #CJK UNIFIED IDEOGRAPH
+0x9269 0x6BB5 #CJK UNIFIED IDEOGRAPH
+0x926A 0x7537 #CJK UNIFIED IDEOGRAPH
+0x926B 0x8AC7 #CJK UNIFIED IDEOGRAPH
+0x926C 0x5024 #CJK UNIFIED IDEOGRAPH
+0x926D 0x77E5 #CJK UNIFIED IDEOGRAPH
+0x926E 0x5730 #CJK UNIFIED IDEOGRAPH
+0x926F 0x5F1B #CJK UNIFIED IDEOGRAPH
+0x9270 0x6065 #CJK UNIFIED IDEOGRAPH
+0x9271 0x667A #CJK UNIFIED IDEOGRAPH
+0x9272 0x6C60 #CJK UNIFIED IDEOGRAPH
+0x9273 0x75F4 #CJK UNIFIED IDEOGRAPH
+0x9274 0x7A1A #CJK UNIFIED IDEOGRAPH
+0x9275 0x7F6E #CJK UNIFIED IDEOGRAPH
+0x9276 0x81F4 #CJK UNIFIED IDEOGRAPH
+0x9277 0x8718 #CJK UNIFIED IDEOGRAPH
+0x9278 0x9045 #CJK UNIFIED IDEOGRAPH
+0x9279 0x99B3 #CJK UNIFIED IDEOGRAPH
+0x927A 0x7BC9 #CJK UNIFIED IDEOGRAPH
+0x927B 0x755C #CJK UNIFIED IDEOGRAPH
+0x927C 0x7AF9 #CJK UNIFIED IDEOGRAPH
+0x927D 0x7B51 #CJK UNIFIED IDEOGRAPH
+0x927E 0x84C4 #CJK UNIFIED IDEOGRAPH
+0x9280 0x9010 #CJK UNIFIED IDEOGRAPH
+0x9281 0x79E9 #CJK UNIFIED IDEOGRAPH
+0x9282 0x7A92 #CJK UNIFIED IDEOGRAPH
+0x9283 0x8336 #CJK UNIFIED IDEOGRAPH
+0x9284 0x5AE1 #CJK UNIFIED IDEOGRAPH
+0x9285 0x7740 #CJK UNIFIED IDEOGRAPH
+0x9286 0x4E2D #CJK UNIFIED IDEOGRAPH
+0x9287 0x4EF2 #CJK UNIFIED IDEOGRAPH
+0x9288 0x5B99 #CJK UNIFIED IDEOGRAPH
+0x9289 0x5FE0 #CJK UNIFIED IDEOGRAPH
+0x928A 0x62BD #CJK UNIFIED IDEOGRAPH
+0x928B 0x663C #CJK UNIFIED IDEOGRAPH
+0x928C 0x67F1 #CJK UNIFIED IDEOGRAPH
+0x928D 0x6CE8 #CJK UNIFIED IDEOGRAPH
+0x928E 0x866B #CJK UNIFIED IDEOGRAPH
+0x928F 0x8877 #CJK UNIFIED IDEOGRAPH
+0x9290 0x8A3B #CJK UNIFIED IDEOGRAPH
+0x9291 0x914E #CJK UNIFIED IDEOGRAPH
+0x9292 0x92F3 #CJK UNIFIED IDEOGRAPH
+0x9293 0x99D0 #CJK UNIFIED IDEOGRAPH
+0x9294 0x6A17 #CJK UNIFIED IDEOGRAPH
+0x9295 0x7026 #CJK UNIFIED IDEOGRAPH
+0x9296 0x732A #CJK UNIFIED IDEOGRAPH
+0x9297 0x82E7 #CJK UNIFIED IDEOGRAPH
+0x9298 0x8457 #CJK UNIFIED IDEOGRAPH
+0x9299 0x8CAF #CJK UNIFIED IDEOGRAPH
+0x929A 0x4E01 #CJK UNIFIED IDEOGRAPH
+0x929B 0x5146 #CJK UNIFIED IDEOGRAPH
+0x929C 0x51CB #CJK UNIFIED IDEOGRAPH
+0x929D 0x558B #CJK UNIFIED IDEOGRAPH
+0x929E 0x5BF5 #CJK UNIFIED IDEOGRAPH
+0x929F 0x5E16 #CJK UNIFIED IDEOGRAPH
+0x92A0 0x5E33 #CJK UNIFIED IDEOGRAPH
+0x92A1 0x5E81 #CJK UNIFIED IDEOGRAPH
+0x92A2 0x5F14 #CJK UNIFIED IDEOGRAPH
+0x92A3 0x5F35 #CJK UNIFIED IDEOGRAPH
+0x92A4 0x5F6B #CJK UNIFIED IDEOGRAPH
+0x92A5 0x5FB4 #CJK UNIFIED IDEOGRAPH
+0x92A6 0x61F2 #CJK UNIFIED IDEOGRAPH
+0x92A7 0x6311 #CJK UNIFIED IDEOGRAPH
+0x92A8 0x66A2 #CJK UNIFIED IDEOGRAPH
+0x92A9 0x671D #CJK UNIFIED IDEOGRAPH
+0x92AA 0x6F6E #CJK UNIFIED IDEOGRAPH
+0x92AB 0x7252 #CJK UNIFIED IDEOGRAPH
+0x92AC 0x753A #CJK UNIFIED IDEOGRAPH
+0x92AD 0x773A #CJK UNIFIED IDEOGRAPH
+0x92AE 0x8074 #CJK UNIFIED IDEOGRAPH
+0x92AF 0x8139 #CJK UNIFIED IDEOGRAPH
+0x92B0 0x8178 #CJK UNIFIED IDEOGRAPH
+0x92B1 0x8776 #CJK UNIFIED IDEOGRAPH
+0x92B2 0x8ABF #CJK UNIFIED IDEOGRAPH
+0x92B3 0x8ADC #CJK UNIFIED IDEOGRAPH
+0x92B4 0x8D85 #CJK UNIFIED IDEOGRAPH
+0x92B5 0x8DF3 #CJK UNIFIED IDEOGRAPH
+0x92B6 0x929A #CJK UNIFIED IDEOGRAPH
+0x92B7 0x9577 #CJK UNIFIED IDEOGRAPH
+0x92B8 0x9802 #CJK UNIFIED IDEOGRAPH
+0x92B9 0x9CE5 #CJK UNIFIED IDEOGRAPH
+0x92BA 0x52C5 #CJK UNIFIED IDEOGRAPH
+0x92BB 0x6357 #CJK UNIFIED IDEOGRAPH
+0x92BC 0x76F4 #CJK UNIFIED IDEOGRAPH
+0x92BD 0x6715 #CJK UNIFIED IDEOGRAPH
+0x92BE 0x6C88 #CJK UNIFIED IDEOGRAPH
+0x92BF 0x73CD #CJK UNIFIED IDEOGRAPH
+0x92C0 0x8CC3 #CJK UNIFIED IDEOGRAPH
+0x92C1 0x93AE #CJK UNIFIED IDEOGRAPH
+0x92C2 0x9673 #CJK UNIFIED IDEOGRAPH
+0x92C3 0x6D25 #CJK UNIFIED IDEOGRAPH
+0x92C4 0x589C #CJK UNIFIED IDEOGRAPH
+0x92C5 0x690E #CJK UNIFIED IDEOGRAPH
+0x92C6 0x69CC #CJK UNIFIED IDEOGRAPH
+0x92C7 0x8FFD #CJK UNIFIED IDEOGRAPH
+0x92C8 0x939A #CJK UNIFIED IDEOGRAPH
+0x92C9 0x75DB #CJK UNIFIED IDEOGRAPH
+0x92CA 0x901A #CJK UNIFIED IDEOGRAPH
+0x92CB 0x585A #CJK UNIFIED IDEOGRAPH
+0x92CC 0x6802 #CJK UNIFIED IDEOGRAPH
+0x92CD 0x63B4 #CJK UNIFIED IDEOGRAPH
+0x92CE 0x69FB #CJK UNIFIED IDEOGRAPH
+0x92CF 0x4F43 #CJK UNIFIED IDEOGRAPH
+0x92D0 0x6F2C #CJK UNIFIED IDEOGRAPH
+0x92D1 0x67D8 #CJK UNIFIED IDEOGRAPH
+0x92D2 0x8FBB #CJK UNIFIED IDEOGRAPH
+0x92D3 0x8526 #CJK UNIFIED IDEOGRAPH
+0x92D4 0x7DB4 #CJK UNIFIED IDEOGRAPH
+0x92D5 0x9354 #CJK UNIFIED IDEOGRAPH
+0x92D6 0x693F #CJK UNIFIED IDEOGRAPH
+0x92D7 0x6F70 #CJK UNIFIED IDEOGRAPH
+0x92D8 0x576A #CJK UNIFIED IDEOGRAPH
+0x92D9 0x58F7 #CJK UNIFIED IDEOGRAPH
+0x92DA 0x5B2C #CJK UNIFIED IDEOGRAPH
+0x92DB 0x7D2C #CJK UNIFIED IDEOGRAPH
+0x92DC 0x722A #CJK UNIFIED IDEOGRAPH
+0x92DD 0x540A #CJK UNIFIED IDEOGRAPH
+0x92DE 0x91E3 #CJK UNIFIED IDEOGRAPH
+0x92DF 0x9DB4 #CJK UNIFIED IDEOGRAPH
+0x92E0 0x4EAD #CJK UNIFIED IDEOGRAPH
+0x92E1 0x4F4E #CJK UNIFIED IDEOGRAPH
+0x92E2 0x505C #CJK UNIFIED IDEOGRAPH
+0x92E3 0x5075 #CJK UNIFIED IDEOGRAPH
+0x92E4 0x5243 #CJK UNIFIED IDEOGRAPH
+0x92E5 0x8C9E #CJK UNIFIED IDEOGRAPH
+0x92E6 0x5448 #CJK UNIFIED IDEOGRAPH
+0x92E7 0x5824 #CJK UNIFIED IDEOGRAPH
+0x92E8 0x5B9A #CJK UNIFIED IDEOGRAPH
+0x92E9 0x5E1D #CJK UNIFIED IDEOGRAPH
+0x92EA 0x5E95 #CJK UNIFIED IDEOGRAPH
+0x92EB 0x5EAD #CJK UNIFIED IDEOGRAPH
+0x92EC 0x5EF7 #CJK UNIFIED IDEOGRAPH
+0x92ED 0x5F1F #CJK UNIFIED IDEOGRAPH
+0x92EE 0x608C #CJK UNIFIED IDEOGRAPH
+0x92EF 0x62B5 #CJK UNIFIED IDEOGRAPH
+0x92F0 0x633A #CJK UNIFIED IDEOGRAPH
+0x92F1 0x63D0 #CJK UNIFIED IDEOGRAPH
+0x92F2 0x68AF #CJK UNIFIED IDEOGRAPH
+0x92F3 0x6C40 #CJK UNIFIED IDEOGRAPH
+0x92F4 0x7887 #CJK UNIFIED IDEOGRAPH
+0x92F5 0x798E #CJK UNIFIED IDEOGRAPH
+0x92F6 0x7A0B #CJK UNIFIED IDEOGRAPH
+0x92F7 0x7DE0 #CJK UNIFIED IDEOGRAPH
+0x92F8 0x8247 #CJK UNIFIED IDEOGRAPH
+0x92F9 0x8A02 #CJK UNIFIED IDEOGRAPH
+0x92FA 0x8AE6 #CJK UNIFIED IDEOGRAPH
+0x92FB 0x8E44 #CJK UNIFIED IDEOGRAPH
+0x92FC 0x9013 #CJK UNIFIED IDEOGRAPH
+0x9340 0x90B8 #CJK UNIFIED IDEOGRAPH
+0x9341 0x912D #CJK UNIFIED IDEOGRAPH
+0x9342 0x91D8 #CJK UNIFIED IDEOGRAPH
+0x9343 0x9F0E #CJK UNIFIED IDEOGRAPH
+0x9344 0x6CE5 #CJK UNIFIED IDEOGRAPH
+0x9345 0x6458 #CJK UNIFIED IDEOGRAPH
+0x9346 0x64E2 #CJK UNIFIED IDEOGRAPH
+0x9347 0x6575 #CJK UNIFIED IDEOGRAPH
+0x9348 0x6EF4 #CJK UNIFIED IDEOGRAPH
+0x9349 0x7684 #CJK UNIFIED IDEOGRAPH
+0x934A 0x7B1B #CJK UNIFIED IDEOGRAPH
+0x934B 0x9069 #CJK UNIFIED IDEOGRAPH
+0x934C 0x93D1 #CJK UNIFIED IDEOGRAPH
+0x934D 0x6EBA #CJK UNIFIED IDEOGRAPH
+0x934E 0x54F2 #CJK UNIFIED IDEOGRAPH
+0x934F 0x5FB9 #CJK UNIFIED IDEOGRAPH
+0x9350 0x64A4 #CJK UNIFIED IDEOGRAPH
+0x9351 0x8F4D #CJK UNIFIED IDEOGRAPH
+0x9352 0x8FED #CJK UNIFIED IDEOGRAPH
+0x9353 0x9244 #CJK UNIFIED IDEOGRAPH
+0x9354 0x5178 #CJK UNIFIED IDEOGRAPH
+0x9355 0x586B #CJK UNIFIED IDEOGRAPH
+0x9356 0x5929 #CJK UNIFIED IDEOGRAPH
+0x9357 0x5C55 #CJK UNIFIED IDEOGRAPH
+0x9358 0x5E97 #CJK UNIFIED IDEOGRAPH
+0x9359 0x6DFB #CJK UNIFIED IDEOGRAPH
+0x935A 0x7E8F #CJK UNIFIED IDEOGRAPH
+0x935B 0x751C #CJK UNIFIED IDEOGRAPH
+0x935C 0x8CBC #CJK UNIFIED IDEOGRAPH
+0x935D 0x8EE2 #CJK UNIFIED IDEOGRAPH
+0x935E 0x985B #CJK UNIFIED IDEOGRAPH
+0x935F 0x70B9 #CJK UNIFIED IDEOGRAPH
+0x9360 0x4F1D #CJK UNIFIED IDEOGRAPH
+0x9361 0x6BBF #CJK UNIFIED IDEOGRAPH
+0x9362 0x6FB1 #CJK UNIFIED IDEOGRAPH
+0x9363 0x7530 #CJK UNIFIED IDEOGRAPH
+0x9364 0x96FB #CJK UNIFIED IDEOGRAPH
+0x9365 0x514E #CJK UNIFIED IDEOGRAPH
+0x9366 0x5410 #CJK UNIFIED IDEOGRAPH
+0x9367 0x5835 #CJK UNIFIED IDEOGRAPH
+0x9368 0x5857 #CJK UNIFIED IDEOGRAPH
+0x9369 0x59AC #CJK UNIFIED IDEOGRAPH
+0x936A 0x5C60 #CJK UNIFIED IDEOGRAPH
+0x936B 0x5F92 #CJK UNIFIED IDEOGRAPH
+0x936C 0x6597 #CJK UNIFIED IDEOGRAPH
+0x936D 0x675C #CJK UNIFIED IDEOGRAPH
+0x936E 0x6E21 #CJK UNIFIED IDEOGRAPH
+0x936F 0x767B #CJK UNIFIED IDEOGRAPH
+0x9370 0x83DF #CJK UNIFIED IDEOGRAPH
+0x9371 0x8CED #CJK UNIFIED IDEOGRAPH
+0x9372 0x9014 #CJK UNIFIED IDEOGRAPH
+0x9373 0x90FD #CJK UNIFIED IDEOGRAPH
+0x9374 0x934D #CJK UNIFIED IDEOGRAPH
+0x9375 0x7825 #CJK UNIFIED IDEOGRAPH
+0x9376 0x783A #CJK UNIFIED IDEOGRAPH
+0x9377 0x52AA #CJK UNIFIED IDEOGRAPH
+0x9378 0x5EA6 #CJK UNIFIED IDEOGRAPH
+0x9379 0x571F #CJK UNIFIED IDEOGRAPH
+0x937A 0x5974 #CJK UNIFIED IDEOGRAPH
+0x937B 0x6012 #CJK UNIFIED IDEOGRAPH
+0x937C 0x5012 #CJK UNIFIED IDEOGRAPH
+0x937D 0x515A #CJK UNIFIED IDEOGRAPH
+0x937E 0x51AC #CJK UNIFIED IDEOGRAPH
+0x9380 0x51CD #CJK UNIFIED IDEOGRAPH
+0x9381 0x5200 #CJK UNIFIED IDEOGRAPH
+0x9382 0x5510 #CJK UNIFIED IDEOGRAPH
+0x9383 0x5854 #CJK UNIFIED IDEOGRAPH
+0x9384 0x5858 #CJK UNIFIED IDEOGRAPH
+0x9385 0x5957 #CJK UNIFIED IDEOGRAPH
+0x9386 0x5B95 #CJK UNIFIED IDEOGRAPH
+0x9387 0x5CF6 #CJK UNIFIED IDEOGRAPH
+0x9388 0x5D8B #CJK UNIFIED IDEOGRAPH
+0x9389 0x60BC #CJK UNIFIED IDEOGRAPH
+0x938A 0x6295 #CJK UNIFIED IDEOGRAPH
+0x938B 0x642D #CJK UNIFIED IDEOGRAPH
+0x938C 0x6771 #CJK UNIFIED IDEOGRAPH
+0x938D 0x6843 #CJK UNIFIED IDEOGRAPH
+0x938E 0x68BC #CJK UNIFIED IDEOGRAPH
+0x938F 0x68DF #CJK UNIFIED IDEOGRAPH
+0x9390 0x76D7 #CJK UNIFIED IDEOGRAPH
+0x9391 0x6DD8 #CJK UNIFIED IDEOGRAPH
+0x9392 0x6E6F #CJK UNIFIED IDEOGRAPH
+0x9393 0x6D9B #CJK UNIFIED IDEOGRAPH
+0x9394 0x706F #CJK UNIFIED IDEOGRAPH
+0x9395 0x71C8 #CJK UNIFIED IDEOGRAPH
+0x9396 0x5F53 #CJK UNIFIED IDEOGRAPH
+0x9397 0x75D8 #CJK UNIFIED IDEOGRAPH
+0x9398 0x7977 #CJK UNIFIED IDEOGRAPH
+0x9399 0x7B49 #CJK UNIFIED IDEOGRAPH
+0x939A 0x7B54 #CJK UNIFIED IDEOGRAPH
+0x939B 0x7B52 #CJK UNIFIED IDEOGRAPH
+0x939C 0x7CD6 #CJK UNIFIED IDEOGRAPH
+0x939D 0x7D71 #CJK UNIFIED IDEOGRAPH
+0x939E 0x5230 #CJK UNIFIED IDEOGRAPH
+0x939F 0x8463 #CJK UNIFIED IDEOGRAPH
+0x93A0 0x8569 #CJK UNIFIED IDEOGRAPH
+0x93A1 0x85E4 #CJK UNIFIED IDEOGRAPH
+0x93A2 0x8A0E #CJK UNIFIED IDEOGRAPH
+0x93A3 0x8B04 #CJK UNIFIED IDEOGRAPH
+0x93A4 0x8C46 #CJK UNIFIED IDEOGRAPH
+0x93A5 0x8E0F #CJK UNIFIED IDEOGRAPH
+0x93A6 0x9003 #CJK UNIFIED IDEOGRAPH
+0x93A7 0x900F #CJK UNIFIED IDEOGRAPH
+0x93A8 0x9419 #CJK UNIFIED IDEOGRAPH
+0x93A9 0x9676 #CJK UNIFIED IDEOGRAPH
+0x93AA 0x982D #CJK UNIFIED IDEOGRAPH
+0x93AB 0x9A30 #CJK UNIFIED IDEOGRAPH
+0x93AC 0x95D8 #CJK UNIFIED IDEOGRAPH
+0x93AD 0x50CD #CJK UNIFIED IDEOGRAPH
+0x93AE 0x52D5 #CJK UNIFIED IDEOGRAPH
+0x93AF 0x540C #CJK UNIFIED IDEOGRAPH
+0x93B0 0x5802 #CJK UNIFIED IDEOGRAPH
+0x93B1 0x5C0E #CJK UNIFIED IDEOGRAPH
+0x93B2 0x61A7 #CJK UNIFIED IDEOGRAPH
+0x93B3 0x649E #CJK UNIFIED IDEOGRAPH
+0x93B4 0x6D1E #CJK UNIFIED IDEOGRAPH
+0x93B5 0x77B3 #CJK UNIFIED IDEOGRAPH
+0x93B6 0x7AE5 #CJK UNIFIED IDEOGRAPH
+0x93B7 0x80F4 #CJK UNIFIED IDEOGRAPH
+0x93B8 0x8404 #CJK UNIFIED IDEOGRAPH
+0x93B9 0x9053 #CJK UNIFIED IDEOGRAPH
+0x93BA 0x9285 #CJK UNIFIED IDEOGRAPH
+0x93BB 0x5CE0 #CJK UNIFIED IDEOGRAPH
+0x93BC 0x9D07 #CJK UNIFIED IDEOGRAPH
+0x93BD 0x533F #CJK UNIFIED IDEOGRAPH
+0x93BE 0x5F97 #CJK UNIFIED IDEOGRAPH
+0x93BF 0x5FB3 #CJK UNIFIED IDEOGRAPH
+0x93C0 0x6D9C #CJK UNIFIED IDEOGRAPH
+0x93C1 0x7279 #CJK UNIFIED IDEOGRAPH
+0x93C2 0x7763 #CJK UNIFIED IDEOGRAPH
+0x93C3 0x79BF #CJK UNIFIED IDEOGRAPH
+0x93C4 0x7BE4 #CJK UNIFIED IDEOGRAPH
+0x93C5 0x6BD2 #CJK UNIFIED IDEOGRAPH
+0x93C6 0x72EC #CJK UNIFIED IDEOGRAPH
+0x93C7 0x8AAD #CJK UNIFIED IDEOGRAPH
+0x93C8 0x6803 #CJK UNIFIED IDEOGRAPH
+0x93C9 0x6A61 #CJK UNIFIED IDEOGRAPH
+0x93CA 0x51F8 #CJK UNIFIED IDEOGRAPH
+0x93CB 0x7A81 #CJK UNIFIED IDEOGRAPH
+0x93CC 0x6934 #CJK UNIFIED IDEOGRAPH
+0x93CD 0x5C4A #CJK UNIFIED IDEOGRAPH
+0x93CE 0x9CF6 #CJK UNIFIED IDEOGRAPH
+0x93CF 0x82EB #CJK UNIFIED IDEOGRAPH
+0x93D0 0x5BC5 #CJK UNIFIED IDEOGRAPH
+0x93D1 0x9149 #CJK UNIFIED IDEOGRAPH
+0x93D2 0x701E #CJK UNIFIED IDEOGRAPH
+0x93D3 0x5678 #CJK UNIFIED IDEOGRAPH
+0x93D4 0x5C6F #CJK UNIFIED IDEOGRAPH
+0x93D5 0x60C7 #CJK UNIFIED IDEOGRAPH
+0x93D6 0x6566 #CJK UNIFIED IDEOGRAPH
+0x93D7 0x6C8C #CJK UNIFIED IDEOGRAPH
+0x93D8 0x8C5A #CJK UNIFIED IDEOGRAPH
+0x93D9 0x9041 #CJK UNIFIED IDEOGRAPH
+0x93DA 0x9813 #CJK UNIFIED IDEOGRAPH
+0x93DB 0x5451 #CJK UNIFIED IDEOGRAPH
+0x93DC 0x66C7 #CJK UNIFIED IDEOGRAPH
+0x93DD 0x920D #CJK UNIFIED IDEOGRAPH
+0x93DE 0x5948 #CJK UNIFIED IDEOGRAPH
+0x93DF 0x90A3 #CJK UNIFIED IDEOGRAPH
+0x93E0 0x5185 #CJK UNIFIED IDEOGRAPH
+0x93E1 0x4E4D #CJK UNIFIED IDEOGRAPH
+0x93E2 0x51EA #CJK UNIFIED IDEOGRAPH
+0x93E3 0x8599 #CJK UNIFIED IDEOGRAPH
+0x93E4 0x8B0E #CJK UNIFIED IDEOGRAPH
+0x93E5 0x7058 #CJK UNIFIED IDEOGRAPH
+0x93E6 0x637A #CJK UNIFIED IDEOGRAPH
+0x93E7 0x934B #CJK UNIFIED IDEOGRAPH
+0x93E8 0x6962 #CJK UNIFIED IDEOGRAPH
+0x93E9 0x99B4 #CJK UNIFIED IDEOGRAPH
+0x93EA 0x7E04 #CJK UNIFIED IDEOGRAPH
+0x93EB 0x7577 #CJK UNIFIED IDEOGRAPH
+0x93EC 0x5357 #CJK UNIFIED IDEOGRAPH
+0x93ED 0x6960 #CJK UNIFIED IDEOGRAPH
+0x93EE 0x8EDF #CJK UNIFIED IDEOGRAPH
+0x93EF 0x96E3 #CJK UNIFIED IDEOGRAPH
+0x93F0 0x6C5D #CJK UNIFIED IDEOGRAPH
+0x93F1 0x4E8C #CJK UNIFIED IDEOGRAPH
+0x93F2 0x5C3C #CJK UNIFIED IDEOGRAPH
+0x93F3 0x5F10 #CJK UNIFIED IDEOGRAPH
+0x93F4 0x8FE9 #CJK UNIFIED IDEOGRAPH
+0x93F5 0x5302 #CJK UNIFIED IDEOGRAPH
+0x93F6 0x8CD1 #CJK UNIFIED IDEOGRAPH
+0x93F7 0x8089 #CJK UNIFIED IDEOGRAPH
+0x93F8 0x8679 #CJK UNIFIED IDEOGRAPH
+0x93F9 0x5EFF #CJK UNIFIED IDEOGRAPH
+0x93FA 0x65E5 #CJK UNIFIED IDEOGRAPH
+0x93FB 0x4E73 #CJK UNIFIED IDEOGRAPH
+0x93FC 0x5165 #CJK UNIFIED IDEOGRAPH
+0x9440 0x5982 #CJK UNIFIED IDEOGRAPH
+0x9441 0x5C3F #CJK UNIFIED IDEOGRAPH
+0x9442 0x97EE #CJK UNIFIED IDEOGRAPH
+0x9443 0x4EFB #CJK UNIFIED IDEOGRAPH
+0x9444 0x598A #CJK UNIFIED IDEOGRAPH
+0x9445 0x5FCD #CJK UNIFIED IDEOGRAPH
+0x9446 0x8A8D #CJK UNIFIED IDEOGRAPH
+0x9447 0x6FE1 #CJK UNIFIED IDEOGRAPH
+0x9448 0x79B0 #CJK UNIFIED IDEOGRAPH
+0x9449 0x7962 #CJK UNIFIED IDEOGRAPH
+0x944A 0x5BE7 #CJK UNIFIED IDEOGRAPH
+0x944B 0x8471 #CJK UNIFIED IDEOGRAPH
+0x944C 0x732B #CJK UNIFIED IDEOGRAPH
+0x944D 0x71B1 #CJK UNIFIED IDEOGRAPH
+0x944E 0x5E74 #CJK UNIFIED IDEOGRAPH
+0x944F 0x5FF5 #CJK UNIFIED IDEOGRAPH
+0x9450 0x637B #CJK UNIFIED IDEOGRAPH
+0x9451 0x649A #CJK UNIFIED IDEOGRAPH
+0x9452 0x71C3 #CJK UNIFIED IDEOGRAPH
+0x9453 0x7C98 #CJK UNIFIED IDEOGRAPH
+0x9454 0x4E43 #CJK UNIFIED IDEOGRAPH
+0x9455 0x5EFC #CJK UNIFIED IDEOGRAPH
+0x9456 0x4E4B #CJK UNIFIED IDEOGRAPH
+0x9457 0x57DC #CJK UNIFIED IDEOGRAPH
+0x9458 0x56A2 #CJK UNIFIED IDEOGRAPH
+0x9459 0x60A9 #CJK UNIFIED IDEOGRAPH
+0x945A 0x6FC3 #CJK UNIFIED IDEOGRAPH
+0x945B 0x7D0D #CJK UNIFIED IDEOGRAPH
+0x945C 0x80FD #CJK UNIFIED IDEOGRAPH
+0x945D 0x8133 #CJK UNIFIED IDEOGRAPH
+0x945E 0x81BF #CJK UNIFIED IDEOGRAPH
+0x945F 0x8FB2 #CJK UNIFIED IDEOGRAPH
+0x9460 0x8997 #CJK UNIFIED IDEOGRAPH
+0x9461 0x86A4 #CJK UNIFIED IDEOGRAPH
+0x9462 0x5DF4 #CJK UNIFIED IDEOGRAPH
+0x9463 0x628A #CJK UNIFIED IDEOGRAPH
+0x9464 0x64AD #CJK UNIFIED IDEOGRAPH
+0x9465 0x8987 #CJK UNIFIED IDEOGRAPH
+0x9466 0x6777 #CJK UNIFIED IDEOGRAPH
+0x9467 0x6CE2 #CJK UNIFIED IDEOGRAPH
+0x9468 0x6D3E #CJK UNIFIED IDEOGRAPH
+0x9469 0x7436 #CJK UNIFIED IDEOGRAPH
+0x946A 0x7834 #CJK UNIFIED IDEOGRAPH
+0x946B 0x5A46 #CJK UNIFIED IDEOGRAPH
+0x946C 0x7F75 #CJK UNIFIED IDEOGRAPH
+0x946D 0x82AD #CJK UNIFIED IDEOGRAPH
+0x946E 0x99AC #CJK UNIFIED IDEOGRAPH
+0x946F 0x4FF3 #CJK UNIFIED IDEOGRAPH
+0x9470 0x5EC3 #CJK UNIFIED IDEOGRAPH
+0x9471 0x62DD #CJK UNIFIED IDEOGRAPH
+0x9472 0x6392 #CJK UNIFIED IDEOGRAPH
+0x9473 0x6557 #CJK UNIFIED IDEOGRAPH
+0x9474 0x676F #CJK UNIFIED IDEOGRAPH
+0x9475 0x76C3 #CJK UNIFIED IDEOGRAPH
+0x9476 0x724C #CJK UNIFIED IDEOGRAPH
+0x9477 0x80CC #CJK UNIFIED IDEOGRAPH
+0x9478 0x80BA #CJK UNIFIED IDEOGRAPH
+0x9479 0x8F29 #CJK UNIFIED IDEOGRAPH
+0x947A 0x914D #CJK UNIFIED IDEOGRAPH
+0x947B 0x500D #CJK UNIFIED IDEOGRAPH
+0x947C 0x57F9 #CJK UNIFIED IDEOGRAPH
+0x947D 0x5A92 #CJK UNIFIED IDEOGRAPH
+0x947E 0x6885 #CJK UNIFIED IDEOGRAPH
+0x9480 0x6973 #CJK UNIFIED IDEOGRAPH
+0x9481 0x7164 #CJK UNIFIED IDEOGRAPH
+0x9482 0x72FD #CJK UNIFIED IDEOGRAPH
+0x9483 0x8CB7 #CJK UNIFIED IDEOGRAPH
+0x9484 0x58F2 #CJK UNIFIED IDEOGRAPH
+0x9485 0x8CE0 #CJK UNIFIED IDEOGRAPH
+0x9486 0x966A #CJK UNIFIED IDEOGRAPH
+0x9487 0x9019 #CJK UNIFIED IDEOGRAPH
+0x9488 0x877F #CJK UNIFIED IDEOGRAPH
+0x9489 0x79E4 #CJK UNIFIED IDEOGRAPH
+0x948A 0x77E7 #CJK UNIFIED IDEOGRAPH
+0x948B 0x8429 #CJK UNIFIED IDEOGRAPH
+0x948C 0x4F2F #CJK UNIFIED IDEOGRAPH
+0x948D 0x5265 #CJK UNIFIED IDEOGRAPH
+0x948E 0x535A #CJK UNIFIED IDEOGRAPH
+0x948F 0x62CD #CJK UNIFIED IDEOGRAPH
+0x9490 0x67CF #CJK UNIFIED IDEOGRAPH
+0x9491 0x6CCA #CJK UNIFIED IDEOGRAPH
+0x9492 0x767D #CJK UNIFIED IDEOGRAPH
+0x9493 0x7B94 #CJK UNIFIED IDEOGRAPH
+0x9494 0x7C95 #CJK UNIFIED IDEOGRAPH
+0x9495 0x8236 #CJK UNIFIED IDEOGRAPH
+0x9496 0x8584 #CJK UNIFIED IDEOGRAPH
+0x9497 0x8FEB #CJK UNIFIED IDEOGRAPH
+0x9498 0x66DD #CJK UNIFIED IDEOGRAPH
+0x9499 0x6F20 #CJK UNIFIED IDEOGRAPH
+0x949A 0x7206 #CJK UNIFIED IDEOGRAPH
+0x949B 0x7E1B #CJK UNIFIED IDEOGRAPH
+0x949C 0x83AB #CJK UNIFIED IDEOGRAPH
+0x949D 0x99C1 #CJK UNIFIED IDEOGRAPH
+0x949E 0x9EA6 #CJK UNIFIED IDEOGRAPH
+0x949F 0x51FD #CJK UNIFIED IDEOGRAPH
+0x94A0 0x7BB1 #CJK UNIFIED IDEOGRAPH
+0x94A1 0x7872 #CJK UNIFIED IDEOGRAPH
+0x94A2 0x7BB8 #CJK UNIFIED IDEOGRAPH
+0x94A3 0x8087 #CJK UNIFIED IDEOGRAPH
+0x94A4 0x7B48 #CJK UNIFIED IDEOGRAPH
+0x94A5 0x6AE8 #CJK UNIFIED IDEOGRAPH
+0x94A6 0x5E61 #CJK UNIFIED IDEOGRAPH
+0x94A7 0x808C #CJK UNIFIED IDEOGRAPH
+0x94A8 0x7551 #CJK UNIFIED IDEOGRAPH
+0x94A9 0x7560 #CJK UNIFIED IDEOGRAPH
+0x94AA 0x516B #CJK UNIFIED IDEOGRAPH
+0x94AB 0x9262 #CJK UNIFIED IDEOGRAPH
+0x94AC 0x6E8C #CJK UNIFIED IDEOGRAPH
+0x94AD 0x767A #CJK UNIFIED IDEOGRAPH
+0x94AE 0x9197 #CJK UNIFIED IDEOGRAPH
+0x94AF 0x9AEA #CJK UNIFIED IDEOGRAPH
+0x94B0 0x4F10 #CJK UNIFIED IDEOGRAPH
+0x94B1 0x7F70 #CJK UNIFIED IDEOGRAPH
+0x94B2 0x629C #CJK UNIFIED IDEOGRAPH
+0x94B3 0x7B4F #CJK UNIFIED IDEOGRAPH
+0x94B4 0x95A5 #CJK UNIFIED IDEOGRAPH
+0x94B5 0x9CE9 #CJK UNIFIED IDEOGRAPH
+0x94B6 0x567A #CJK UNIFIED IDEOGRAPH
+0x94B7 0x5859 #CJK UNIFIED IDEOGRAPH
+0x94B8 0x86E4 #CJK UNIFIED IDEOGRAPH
+0x94B9 0x96BC #CJK UNIFIED IDEOGRAPH
+0x94BA 0x4F34 #CJK UNIFIED IDEOGRAPH
+0x94BB 0x5224 #CJK UNIFIED IDEOGRAPH
+0x94BC 0x534A #CJK UNIFIED IDEOGRAPH
+0x94BD 0x53CD #CJK UNIFIED IDEOGRAPH
+0x94BE 0x53DB #CJK UNIFIED IDEOGRAPH
+0x94BF 0x5E06 #CJK UNIFIED IDEOGRAPH
+0x94C0 0x642C #CJK UNIFIED IDEOGRAPH
+0x94C1 0x6591 #CJK UNIFIED IDEOGRAPH
+0x94C2 0x677F #CJK UNIFIED IDEOGRAPH
+0x94C3 0x6C3E #CJK UNIFIED IDEOGRAPH
+0x94C4 0x6C4E #CJK UNIFIED IDEOGRAPH
+0x94C5 0x7248 #CJK UNIFIED IDEOGRAPH
+0x94C6 0x72AF #CJK UNIFIED IDEOGRAPH
+0x94C7 0x73ED #CJK UNIFIED IDEOGRAPH
+0x94C8 0x7554 #CJK UNIFIED IDEOGRAPH
+0x94C9 0x7E41 #CJK UNIFIED IDEOGRAPH
+0x94CA 0x822C #CJK UNIFIED IDEOGRAPH
+0x94CB 0x85E9 #CJK UNIFIED IDEOGRAPH
+0x94CC 0x8CA9 #CJK UNIFIED IDEOGRAPH
+0x94CD 0x7BC4 #CJK UNIFIED IDEOGRAPH
+0x94CE 0x91C6 #CJK UNIFIED IDEOGRAPH
+0x94CF 0x7169 #CJK UNIFIED IDEOGRAPH
+0x94D0 0x9812 #CJK UNIFIED IDEOGRAPH
+0x94D1 0x98EF #CJK UNIFIED IDEOGRAPH
+0x94D2 0x633D #CJK UNIFIED IDEOGRAPH
+0x94D3 0x6669 #CJK UNIFIED IDEOGRAPH
+0x94D4 0x756A #CJK UNIFIED IDEOGRAPH
+0x94D5 0x76E4 #CJK UNIFIED IDEOGRAPH
+0x94D6 0x78D0 #CJK UNIFIED IDEOGRAPH
+0x94D7 0x8543 #CJK UNIFIED IDEOGRAPH
+0x94D8 0x86EE #CJK UNIFIED IDEOGRAPH
+0x94D9 0x532A #CJK UNIFIED IDEOGRAPH
+0x94DA 0x5351 #CJK UNIFIED IDEOGRAPH
+0x94DB 0x5426 #CJK UNIFIED IDEOGRAPH
+0x94DC 0x5983 #CJK UNIFIED IDEOGRAPH
+0x94DD 0x5E87 #CJK UNIFIED IDEOGRAPH
+0x94DE 0x5F7C #CJK UNIFIED IDEOGRAPH
+0x94DF 0x60B2 #CJK UNIFIED IDEOGRAPH
+0x94E0 0x6249 #CJK UNIFIED IDEOGRAPH
+0x94E1 0x6279 #CJK UNIFIED IDEOGRAPH
+0x94E2 0x62AB #CJK UNIFIED IDEOGRAPH
+0x94E3 0x6590 #CJK UNIFIED IDEOGRAPH
+0x94E4 0x6BD4 #CJK UNIFIED IDEOGRAPH
+0x94E5 0x6CCC #CJK UNIFIED IDEOGRAPH
+0x94E6 0x75B2 #CJK UNIFIED IDEOGRAPH
+0x94E7 0x76AE #CJK UNIFIED IDEOGRAPH
+0x94E8 0x7891 #CJK UNIFIED IDEOGRAPH
+0x94E9 0x79D8 #CJK UNIFIED IDEOGRAPH
+0x94EA 0x7DCB #CJK UNIFIED IDEOGRAPH
+0x94EB 0x7F77 #CJK UNIFIED IDEOGRAPH
+0x94EC 0x80A5 #CJK UNIFIED IDEOGRAPH
+0x94ED 0x88AB #CJK UNIFIED IDEOGRAPH
+0x94EE 0x8AB9 #CJK UNIFIED IDEOGRAPH
+0x94EF 0x8CBB #CJK UNIFIED IDEOGRAPH
+0x94F0 0x907F #CJK UNIFIED IDEOGRAPH
+0x94F1 0x975E #CJK UNIFIED IDEOGRAPH
+0x94F2 0x98DB #CJK UNIFIED IDEOGRAPH
+0x94F3 0x6A0B #CJK UNIFIED IDEOGRAPH
+0x94F4 0x7C38 #CJK UNIFIED IDEOGRAPH
+0x94F5 0x5099 #CJK UNIFIED IDEOGRAPH
+0x94F6 0x5C3E #CJK UNIFIED IDEOGRAPH
+0x94F7 0x5FAE #CJK UNIFIED IDEOGRAPH
+0x94F8 0x6787 #CJK UNIFIED IDEOGRAPH
+0x94F9 0x6BD8 #CJK UNIFIED IDEOGRAPH
+0x94FA 0x7435 #CJK UNIFIED IDEOGRAPH
+0x94FB 0x7709 #CJK UNIFIED IDEOGRAPH
+0x94FC 0x7F8E #CJK UNIFIED IDEOGRAPH
+0x9540 0x9F3B #CJK UNIFIED IDEOGRAPH
+0x9541 0x67CA #CJK UNIFIED IDEOGRAPH
+0x9542 0x7A17 #CJK UNIFIED IDEOGRAPH
+0x9543 0x5339 #CJK UNIFIED IDEOGRAPH
+0x9544 0x758B #CJK UNIFIED IDEOGRAPH
+0x9545 0x9AED #CJK UNIFIED IDEOGRAPH
+0x9546 0x5F66 #CJK UNIFIED IDEOGRAPH
+0x9547 0x819D #CJK UNIFIED IDEOGRAPH
+0x9548 0x83F1 #CJK UNIFIED IDEOGRAPH
+0x9549 0x8098 #CJK UNIFIED IDEOGRAPH
+0x954A 0x5F3C #CJK UNIFIED IDEOGRAPH
+0x954B 0x5FC5 #CJK UNIFIED IDEOGRAPH
+0x954C 0x7562 #CJK UNIFIED IDEOGRAPH
+0x954D 0x7B46 #CJK UNIFIED IDEOGRAPH
+0x954E 0x903C #CJK UNIFIED IDEOGRAPH
+0x954F 0x6867 #CJK UNIFIED IDEOGRAPH
+0x9550 0x59EB #CJK UNIFIED IDEOGRAPH
+0x9551 0x5A9B #CJK UNIFIED IDEOGRAPH
+0x9552 0x7D10 #CJK UNIFIED IDEOGRAPH
+0x9553 0x767E #CJK UNIFIED IDEOGRAPH
+0x9554 0x8B2C #CJK UNIFIED IDEOGRAPH
+0x9555 0x4FF5 #CJK UNIFIED IDEOGRAPH
+0x9556 0x5F6A #CJK UNIFIED IDEOGRAPH
+0x9557 0x6A19 #CJK UNIFIED IDEOGRAPH
+0x9558 0x6C37 #CJK UNIFIED IDEOGRAPH
+0x9559 0x6F02 #CJK UNIFIED IDEOGRAPH
+0x955A 0x74E2 #CJK UNIFIED IDEOGRAPH
+0x955B 0x7968 #CJK UNIFIED IDEOGRAPH
+0x955C 0x8868 #CJK UNIFIED IDEOGRAPH
+0x955D 0x8A55 #CJK UNIFIED IDEOGRAPH
+0x955E 0x8C79 #CJK UNIFIED IDEOGRAPH
+0x955F 0x5EDF #CJK UNIFIED IDEOGRAPH
+0x9560 0x63CF #CJK UNIFIED IDEOGRAPH
+0x9561 0x75C5 #CJK UNIFIED IDEOGRAPH
+0x9562 0x79D2 #CJK UNIFIED IDEOGRAPH
+0x9563 0x82D7 #CJK UNIFIED IDEOGRAPH
+0x9564 0x9328 #CJK UNIFIED IDEOGRAPH
+0x9565 0x92F2 #CJK UNIFIED IDEOGRAPH
+0x9566 0x849C #CJK UNIFIED IDEOGRAPH
+0x9567 0x86ED #CJK UNIFIED IDEOGRAPH
+0x9568 0x9C2D #CJK UNIFIED IDEOGRAPH
+0x9569 0x54C1 #CJK UNIFIED IDEOGRAPH
+0x956A 0x5F6C #CJK UNIFIED IDEOGRAPH
+0x956B 0x658C #CJK UNIFIED IDEOGRAPH
+0x956C 0x6D5C #CJK UNIFIED IDEOGRAPH
+0x956D 0x7015 #CJK UNIFIED IDEOGRAPH
+0x956E 0x8CA7 #CJK UNIFIED IDEOGRAPH
+0x956F 0x8CD3 #CJK UNIFIED IDEOGRAPH
+0x9570 0x983B #CJK UNIFIED IDEOGRAPH
+0x9571 0x654F #CJK UNIFIED IDEOGRAPH
+0x9572 0x74F6 #CJK UNIFIED IDEOGRAPH
+0x9573 0x4E0D #CJK UNIFIED IDEOGRAPH
+0x9574 0x4ED8 #CJK UNIFIED IDEOGRAPH
+0x9575 0x57E0 #CJK UNIFIED IDEOGRAPH
+0x9576 0x592B #CJK UNIFIED IDEOGRAPH
+0x9577 0x5A66 #CJK UNIFIED IDEOGRAPH
+0x9578 0x5BCC #CJK UNIFIED IDEOGRAPH
+0x9579 0x51A8 #CJK UNIFIED IDEOGRAPH
+0x957A 0x5E03 #CJK UNIFIED IDEOGRAPH
+0x957B 0x5E9C #CJK UNIFIED IDEOGRAPH
+0x957C 0x6016 #CJK UNIFIED IDEOGRAPH
+0x957D 0x6276 #CJK UNIFIED IDEOGRAPH
+0x957E 0x6577 #CJK UNIFIED IDEOGRAPH
+0x9580 0x65A7 #CJK UNIFIED IDEOGRAPH
+0x9581 0x666E #CJK UNIFIED IDEOGRAPH
+0x9582 0x6D6E #CJK UNIFIED IDEOGRAPH
+0x9583 0x7236 #CJK UNIFIED IDEOGRAPH
+0x9584 0x7B26 #CJK UNIFIED IDEOGRAPH
+0x9585 0x8150 #CJK UNIFIED IDEOGRAPH
+0x9586 0x819A #CJK UNIFIED IDEOGRAPH
+0x9587 0x8299 #CJK UNIFIED IDEOGRAPH
+0x9588 0x8B5C #CJK UNIFIED IDEOGRAPH
+0x9589 0x8CA0 #CJK UNIFIED IDEOGRAPH
+0x958A 0x8CE6 #CJK UNIFIED IDEOGRAPH
+0x958B 0x8D74 #CJK UNIFIED IDEOGRAPH
+0x958C 0x961C #CJK UNIFIED IDEOGRAPH
+0x958D 0x9644 #CJK UNIFIED IDEOGRAPH
+0x958E 0x4FAE #CJK UNIFIED IDEOGRAPH
+0x958F 0x64AB #CJK UNIFIED IDEOGRAPH
+0x9590 0x6B66 #CJK UNIFIED IDEOGRAPH
+0x9591 0x821E #CJK UNIFIED IDEOGRAPH
+0x9592 0x8461 #CJK UNIFIED IDEOGRAPH
+0x9593 0x856A #CJK UNIFIED IDEOGRAPH
+0x9594 0x90E8 #CJK UNIFIED IDEOGRAPH
+0x9595 0x5C01 #CJK UNIFIED IDEOGRAPH
+0x9596 0x6953 #CJK UNIFIED IDEOGRAPH
+0x9597 0x98A8 #CJK UNIFIED IDEOGRAPH
+0x9598 0x847A #CJK UNIFIED IDEOGRAPH
+0x9599 0x8557 #CJK UNIFIED IDEOGRAPH
+0x959A 0x4F0F #CJK UNIFIED IDEOGRAPH
+0x959B 0x526F #CJK UNIFIED IDEOGRAPH
+0x959C 0x5FA9 #CJK UNIFIED IDEOGRAPH
+0x959D 0x5E45 #CJK UNIFIED IDEOGRAPH
+0x959E 0x670D #CJK UNIFIED IDEOGRAPH
+0x959F 0x798F #CJK UNIFIED IDEOGRAPH
+0x95A0 0x8179 #CJK UNIFIED IDEOGRAPH
+0x95A1 0x8907 #CJK UNIFIED IDEOGRAPH
+0x95A2 0x8986 #CJK UNIFIED IDEOGRAPH
+0x95A3 0x6DF5 #CJK UNIFIED IDEOGRAPH
+0x95A4 0x5F17 #CJK UNIFIED IDEOGRAPH
+0x95A5 0x6255 #CJK UNIFIED IDEOGRAPH
+0x95A6 0x6CB8 #CJK UNIFIED IDEOGRAPH
+0x95A7 0x4ECF #CJK UNIFIED IDEOGRAPH
+0x95A8 0x7269 #CJK UNIFIED IDEOGRAPH
+0x95A9 0x9B92 #CJK UNIFIED IDEOGRAPH
+0x95AA 0x5206 #CJK UNIFIED IDEOGRAPH
+0x95AB 0x543B #CJK UNIFIED IDEOGRAPH
+0x95AC 0x5674 #CJK UNIFIED IDEOGRAPH
+0x95AD 0x58B3 #CJK UNIFIED IDEOGRAPH
+0x95AE 0x61A4 #CJK UNIFIED IDEOGRAPH
+0x95AF 0x626E #CJK UNIFIED IDEOGRAPH
+0x95B0 0x711A #CJK UNIFIED IDEOGRAPH
+0x95B1 0x596E #CJK UNIFIED IDEOGRAPH
+0x95B2 0x7C89 #CJK UNIFIED IDEOGRAPH
+0x95B3 0x7CDE #CJK UNIFIED IDEOGRAPH
+0x95B4 0x7D1B #CJK UNIFIED IDEOGRAPH
+0x95B5 0x96F0 #CJK UNIFIED IDEOGRAPH
+0x95B6 0x6587 #CJK UNIFIED IDEOGRAPH
+0x95B7 0x805E #CJK UNIFIED IDEOGRAPH
+0x95B8 0x4E19 #CJK UNIFIED IDEOGRAPH
+0x95B9 0x4F75 #CJK UNIFIED IDEOGRAPH
+0x95BA 0x5175 #CJK UNIFIED IDEOGRAPH
+0x95BB 0x5840 #CJK UNIFIED IDEOGRAPH
+0x95BC 0x5E63 #CJK UNIFIED IDEOGRAPH
+0x95BD 0x5E73 #CJK UNIFIED IDEOGRAPH
+0x95BE 0x5F0A #CJK UNIFIED IDEOGRAPH
+0x95BF 0x67C4 #CJK UNIFIED IDEOGRAPH
+0x95C0 0x4E26 #CJK UNIFIED IDEOGRAPH
+0x95C1 0x853D #CJK UNIFIED IDEOGRAPH
+0x95C2 0x9589 #CJK UNIFIED IDEOGRAPH
+0x95C3 0x965B #CJK UNIFIED IDEOGRAPH
+0x95C4 0x7C73 #CJK UNIFIED IDEOGRAPH
+0x95C5 0x9801 #CJK UNIFIED IDEOGRAPH
+0x95C6 0x50FB #CJK UNIFIED IDEOGRAPH
+0x95C7 0x58C1 #CJK UNIFIED IDEOGRAPH
+0x95C8 0x7656 #CJK UNIFIED IDEOGRAPH
+0x95C9 0x78A7 #CJK UNIFIED IDEOGRAPH
+0x95CA 0x5225 #CJK UNIFIED IDEOGRAPH
+0x95CB 0x77A5 #CJK UNIFIED IDEOGRAPH
+0x95CC 0x8511 #CJK UNIFIED IDEOGRAPH
+0x95CD 0x7B86 #CJK UNIFIED IDEOGRAPH
+0x95CE 0x504F #CJK UNIFIED IDEOGRAPH
+0x95CF 0x5909 #CJK UNIFIED IDEOGRAPH
+0x95D0 0x7247 #CJK UNIFIED IDEOGRAPH
+0x95D1 0x7BC7 #CJK UNIFIED IDEOGRAPH
+0x95D2 0x7DE8 #CJK UNIFIED IDEOGRAPH
+0x95D3 0x8FBA #CJK UNIFIED IDEOGRAPH
+0x95D4 0x8FD4 #CJK UNIFIED IDEOGRAPH
+0x95D5 0x904D #CJK UNIFIED IDEOGRAPH
+0x95D6 0x4FBF #CJK UNIFIED IDEOGRAPH
+0x95D7 0x52C9 #CJK UNIFIED IDEOGRAPH
+0x95D8 0x5A29 #CJK UNIFIED IDEOGRAPH
+0x95D9 0x5F01 #CJK UNIFIED IDEOGRAPH
+0x95DA 0x97AD #CJK UNIFIED IDEOGRAPH
+0x95DB 0x4FDD #CJK UNIFIED IDEOGRAPH
+0x95DC 0x8217 #CJK UNIFIED IDEOGRAPH
+0x95DD 0x92EA #CJK UNIFIED IDEOGRAPH
+0x95DE 0x5703 #CJK UNIFIED IDEOGRAPH
+0x95DF 0x6355 #CJK UNIFIED IDEOGRAPH
+0x95E0 0x6B69 #CJK UNIFIED IDEOGRAPH
+0x95E1 0x752B #CJK UNIFIED IDEOGRAPH
+0x95E2 0x88DC #CJK UNIFIED IDEOGRAPH
+0x95E3 0x8F14 #CJK UNIFIED IDEOGRAPH
+0x95E4 0x7A42 #CJK UNIFIED IDEOGRAPH
+0x95E5 0x52DF #CJK UNIFIED IDEOGRAPH
+0x95E6 0x5893 #CJK UNIFIED IDEOGRAPH
+0x95E7 0x6155 #CJK UNIFIED IDEOGRAPH
+0x95E8 0x620A #CJK UNIFIED IDEOGRAPH
+0x95E9 0x66AE #CJK UNIFIED IDEOGRAPH
+0x95EA 0x6BCD #CJK UNIFIED IDEOGRAPH
+0x95EB 0x7C3F #CJK UNIFIED IDEOGRAPH
+0x95EC 0x83E9 #CJK UNIFIED IDEOGRAPH
+0x95ED 0x5023 #CJK UNIFIED IDEOGRAPH
+0x95EE 0x4FF8 #CJK UNIFIED IDEOGRAPH
+0x95EF 0x5305 #CJK UNIFIED IDEOGRAPH
+0x95F0 0x5446 #CJK UNIFIED IDEOGRAPH
+0x95F1 0x5831 #CJK UNIFIED IDEOGRAPH
+0x95F2 0x5949 #CJK UNIFIED IDEOGRAPH
+0x95F3 0x5B9D #CJK UNIFIED IDEOGRAPH
+0x95F4 0x5CF0 #CJK UNIFIED IDEOGRAPH
+0x95F5 0x5CEF #CJK UNIFIED IDEOGRAPH
+0x95F6 0x5D29 #CJK UNIFIED IDEOGRAPH
+0x95F7 0x5E96 #CJK UNIFIED IDEOGRAPH
+0x95F8 0x62B1 #CJK UNIFIED IDEOGRAPH
+0x95F9 0x6367 #CJK UNIFIED IDEOGRAPH
+0x95FA 0x653E #CJK UNIFIED IDEOGRAPH
+0x95FB 0x65B9 #CJK UNIFIED IDEOGRAPH
+0x95FC 0x670B #CJK UNIFIED IDEOGRAPH
+0x9640 0x6CD5 #CJK UNIFIED IDEOGRAPH
+0x9641 0x6CE1 #CJK UNIFIED IDEOGRAPH
+0x9642 0x70F9 #CJK UNIFIED IDEOGRAPH
+0x9643 0x7832 #CJK UNIFIED IDEOGRAPH
+0x9644 0x7E2B #CJK UNIFIED IDEOGRAPH
+0x9645 0x80DE #CJK UNIFIED IDEOGRAPH
+0x9646 0x82B3 #CJK UNIFIED IDEOGRAPH
+0x9647 0x840C #CJK UNIFIED IDEOGRAPH
+0x9648 0x84EC #CJK UNIFIED IDEOGRAPH
+0x9649 0x8702 #CJK UNIFIED IDEOGRAPH
+0x964A 0x8912 #CJK UNIFIED IDEOGRAPH
+0x964B 0x8A2A #CJK UNIFIED IDEOGRAPH
+0x964C 0x8C4A #CJK UNIFIED IDEOGRAPH
+0x964D 0x90A6 #CJK UNIFIED IDEOGRAPH
+0x964E 0x92D2 #CJK UNIFIED IDEOGRAPH
+0x964F 0x98FD #CJK UNIFIED IDEOGRAPH
+0x9650 0x9CF3 #CJK UNIFIED IDEOGRAPH
+0x9651 0x9D6C #CJK UNIFIED IDEOGRAPH
+0x9652 0x4E4F #CJK UNIFIED IDEOGRAPH
+0x9653 0x4EA1 #CJK UNIFIED IDEOGRAPH
+0x9654 0x508D #CJK UNIFIED IDEOGRAPH
+0x9655 0x5256 #CJK UNIFIED IDEOGRAPH
+0x9656 0x574A #CJK UNIFIED IDEOGRAPH
+0x9657 0x59A8 #CJK UNIFIED IDEOGRAPH
+0x9658 0x5E3D #CJK UNIFIED IDEOGRAPH
+0x9659 0x5FD8 #CJK UNIFIED IDEOGRAPH
+0x965A 0x5FD9 #CJK UNIFIED IDEOGRAPH
+0x965B 0x623F #CJK UNIFIED IDEOGRAPH
+0x965C 0x66B4 #CJK UNIFIED IDEOGRAPH
+0x965D 0x671B #CJK UNIFIED IDEOGRAPH
+0x965E 0x67D0 #CJK UNIFIED IDEOGRAPH
+0x965F 0x68D2 #CJK UNIFIED IDEOGRAPH
+0x9660 0x5192 #CJK UNIFIED IDEOGRAPH
+0x9661 0x7D21 #CJK UNIFIED IDEOGRAPH
+0x9662 0x80AA #CJK UNIFIED IDEOGRAPH
+0x9663 0x81A8 #CJK UNIFIED IDEOGRAPH
+0x9664 0x8B00 #CJK UNIFIED IDEOGRAPH
+0x9665 0x8C8C #CJK UNIFIED IDEOGRAPH
+0x9666 0x8CBF #CJK UNIFIED IDEOGRAPH
+0x9667 0x927E #CJK UNIFIED IDEOGRAPH
+0x9668 0x9632 #CJK UNIFIED IDEOGRAPH
+0x9669 0x5420 #CJK UNIFIED IDEOGRAPH
+0x966A 0x982C #CJK UNIFIED IDEOGRAPH
+0x966B 0x5317 #CJK UNIFIED IDEOGRAPH
+0x966C 0x50D5 #CJK UNIFIED IDEOGRAPH
+0x966D 0x535C #CJK UNIFIED IDEOGRAPH
+0x966E 0x58A8 #CJK UNIFIED IDEOGRAPH
+0x966F 0x64B2 #CJK UNIFIED IDEOGRAPH
+0x9670 0x6734 #CJK UNIFIED IDEOGRAPH
+0x9671 0x7267 #CJK UNIFIED IDEOGRAPH
+0x9672 0x7766 #CJK UNIFIED IDEOGRAPH
+0x9673 0x7A46 #CJK UNIFIED IDEOGRAPH
+0x9674 0x91E6 #CJK UNIFIED IDEOGRAPH
+0x9675 0x52C3 #CJK UNIFIED IDEOGRAPH
+0x9676 0x6CA1 #CJK UNIFIED IDEOGRAPH
+0x9677 0x6B86 #CJK UNIFIED IDEOGRAPH
+0x9678 0x5800 #CJK UNIFIED IDEOGRAPH
+0x9679 0x5E4C #CJK UNIFIED IDEOGRAPH
+0x967A 0x5954 #CJK UNIFIED IDEOGRAPH
+0x967B 0x672C #CJK UNIFIED IDEOGRAPH
+0x967C 0x7FFB #CJK UNIFIED IDEOGRAPH
+0x967D 0x51E1 #CJK UNIFIED IDEOGRAPH
+0x967E 0x76C6 #CJK UNIFIED IDEOGRAPH
+0x9680 0x6469 #CJK UNIFIED IDEOGRAPH
+0x9681 0x78E8 #CJK UNIFIED IDEOGRAPH
+0x9682 0x9B54 #CJK UNIFIED IDEOGRAPH
+0x9683 0x9EBB #CJK UNIFIED IDEOGRAPH
+0x9684 0x57CB #CJK UNIFIED IDEOGRAPH
+0x9685 0x59B9 #CJK UNIFIED IDEOGRAPH
+0x9686 0x6627 #CJK UNIFIED IDEOGRAPH
+0x9687 0x679A #CJK UNIFIED IDEOGRAPH
+0x9688 0x6BCE #CJK UNIFIED IDEOGRAPH
+0x9689 0x54E9 #CJK UNIFIED IDEOGRAPH
+0x968A 0x69D9 #CJK UNIFIED IDEOGRAPH
+0x968B 0x5E55 #CJK UNIFIED IDEOGRAPH
+0x968C 0x819C #CJK UNIFIED IDEOGRAPH
+0x968D 0x6795 #CJK UNIFIED IDEOGRAPH
+0x968E 0x9BAA #CJK UNIFIED IDEOGRAPH
+0x968F 0x67FE #CJK UNIFIED IDEOGRAPH
+0x9690 0x9C52 #CJK UNIFIED IDEOGRAPH
+0x9691 0x685D #CJK UNIFIED IDEOGRAPH
+0x9692 0x4EA6 #CJK UNIFIED IDEOGRAPH
+0x9693 0x4FE3 #CJK UNIFIED IDEOGRAPH
+0x9694 0x53C8 #CJK UNIFIED IDEOGRAPH
+0x9695 0x62B9 #CJK UNIFIED IDEOGRAPH
+0x9696 0x672B #CJK UNIFIED IDEOGRAPH
+0x9697 0x6CAB #CJK UNIFIED IDEOGRAPH
+0x9698 0x8FC4 #CJK UNIFIED IDEOGRAPH
+0x9699 0x4FAD #CJK UNIFIED IDEOGRAPH
+0x969A 0x7E6D #CJK UNIFIED IDEOGRAPH
+0x969B 0x9EBF #CJK UNIFIED IDEOGRAPH
+0x969C 0x4E07 #CJK UNIFIED IDEOGRAPH
+0x969D 0x6162 #CJK UNIFIED IDEOGRAPH
+0x969E 0x6E80 #CJK UNIFIED IDEOGRAPH
+0x969F 0x6F2B #CJK UNIFIED IDEOGRAPH
+0x96A0 0x8513 #CJK UNIFIED IDEOGRAPH
+0x96A1 0x5473 #CJK UNIFIED IDEOGRAPH
+0x96A2 0x672A #CJK UNIFIED IDEOGRAPH
+0x96A3 0x9B45 #CJK UNIFIED IDEOGRAPH
+0x96A4 0x5DF3 #CJK UNIFIED IDEOGRAPH
+0x96A5 0x7B95 #CJK UNIFIED IDEOGRAPH
+0x96A6 0x5CAC #CJK UNIFIED IDEOGRAPH
+0x96A7 0x5BC6 #CJK UNIFIED IDEOGRAPH
+0x96A8 0x871C #CJK UNIFIED IDEOGRAPH
+0x96A9 0x6E4A #CJK UNIFIED IDEOGRAPH
+0x96AA 0x84D1 #CJK UNIFIED IDEOGRAPH
+0x96AB 0x7A14 #CJK UNIFIED IDEOGRAPH
+0x96AC 0x8108 #CJK UNIFIED IDEOGRAPH
+0x96AD 0x5999 #CJK UNIFIED IDEOGRAPH
+0x96AE 0x7C8D #CJK UNIFIED IDEOGRAPH
+0x96AF 0x6C11 #CJK UNIFIED IDEOGRAPH
+0x96B0 0x7720 #CJK UNIFIED IDEOGRAPH
+0x96B1 0x52D9 #CJK UNIFIED IDEOGRAPH
+0x96B2 0x5922 #CJK UNIFIED IDEOGRAPH
+0x96B3 0x7121 #CJK UNIFIED IDEOGRAPH
+0x96B4 0x725F #CJK UNIFIED IDEOGRAPH
+0x96B5 0x77DB #CJK UNIFIED IDEOGRAPH
+0x96B6 0x9727 #CJK UNIFIED IDEOGRAPH
+0x96B7 0x9D61 #CJK UNIFIED IDEOGRAPH
+0x96B8 0x690B #CJK UNIFIED IDEOGRAPH
+0x96B9 0x5A7F #CJK UNIFIED IDEOGRAPH
+0x96BA 0x5A18 #CJK UNIFIED IDEOGRAPH
+0x96BB 0x51A5 #CJK UNIFIED IDEOGRAPH
+0x96BC 0x540D #CJK UNIFIED IDEOGRAPH
+0x96BD 0x547D #CJK UNIFIED IDEOGRAPH
+0x96BE 0x660E #CJK UNIFIED IDEOGRAPH
+0x96BF 0x76DF #CJK UNIFIED IDEOGRAPH
+0x96C0 0x8FF7 #CJK UNIFIED IDEOGRAPH
+0x96C1 0x9298 #CJK UNIFIED IDEOGRAPH
+0x96C2 0x9CF4 #CJK UNIFIED IDEOGRAPH
+0x96C3 0x59EA #CJK UNIFIED IDEOGRAPH
+0x96C4 0x725D #CJK UNIFIED IDEOGRAPH
+0x96C5 0x6EC5 #CJK UNIFIED IDEOGRAPH
+0x96C6 0x514D #CJK UNIFIED IDEOGRAPH
+0x96C7 0x68C9 #CJK UNIFIED IDEOGRAPH
+0x96C8 0x7DBF #CJK UNIFIED IDEOGRAPH
+0x96C9 0x7DEC #CJK UNIFIED IDEOGRAPH
+0x96CA 0x9762 #CJK UNIFIED IDEOGRAPH
+0x96CB 0x9EBA #CJK UNIFIED IDEOGRAPH
+0x96CC 0x6478 #CJK UNIFIED IDEOGRAPH
+0x96CD 0x6A21 #CJK UNIFIED IDEOGRAPH
+0x96CE 0x8302 #CJK UNIFIED IDEOGRAPH
+0x96CF 0x5984 #CJK UNIFIED IDEOGRAPH
+0x96D0 0x5B5F #CJK UNIFIED IDEOGRAPH
+0x96D1 0x6BDB #CJK UNIFIED IDEOGRAPH
+0x96D2 0x731B #CJK UNIFIED IDEOGRAPH
+0x96D3 0x76F2 #CJK UNIFIED IDEOGRAPH
+0x96D4 0x7DB2 #CJK UNIFIED IDEOGRAPH
+0x96D5 0x8017 #CJK UNIFIED IDEOGRAPH
+0x96D6 0x8499 #CJK UNIFIED IDEOGRAPH
+0x96D7 0x5132 #CJK UNIFIED IDEOGRAPH
+0x96D8 0x6728 #CJK UNIFIED IDEOGRAPH
+0x96D9 0x9ED9 #CJK UNIFIED IDEOGRAPH
+0x96DA 0x76EE #CJK UNIFIED IDEOGRAPH
+0x96DB 0x6762 #CJK UNIFIED IDEOGRAPH
+0x96DC 0x52FF #CJK UNIFIED IDEOGRAPH
+0x96DD 0x9905 #CJK UNIFIED IDEOGRAPH
+0x96DE 0x5C24 #CJK UNIFIED IDEOGRAPH
+0x96DF 0x623B #CJK UNIFIED IDEOGRAPH
+0x96E0 0x7C7E #CJK UNIFIED IDEOGRAPH
+0x96E1 0x8CB0 #CJK UNIFIED IDEOGRAPH
+0x96E2 0x554F #CJK UNIFIED IDEOGRAPH
+0x96E3 0x60B6 #CJK UNIFIED IDEOGRAPH
+0x96E4 0x7D0B #CJK UNIFIED IDEOGRAPH
+0x96E5 0x9580 #CJK UNIFIED IDEOGRAPH
+0x96E6 0x5301 #CJK UNIFIED IDEOGRAPH
+0x96E7 0x4E5F #CJK UNIFIED IDEOGRAPH
+0x96E8 0x51B6 #CJK UNIFIED IDEOGRAPH
+0x96E9 0x591C #CJK UNIFIED IDEOGRAPH
+0x96EA 0x723A #CJK UNIFIED IDEOGRAPH
+0x96EB 0x8036 #CJK UNIFIED IDEOGRAPH
+0x96EC 0x91CE #CJK UNIFIED IDEOGRAPH
+0x96ED 0x5F25 #CJK UNIFIED IDEOGRAPH
+0x96EE 0x77E2 #CJK UNIFIED IDEOGRAPH
+0x96EF 0x5384 #CJK UNIFIED IDEOGRAPH
+0x96F0 0x5F79 #CJK UNIFIED IDEOGRAPH
+0x96F1 0x7D04 #CJK UNIFIED IDEOGRAPH
+0x96F2 0x85AC #CJK UNIFIED IDEOGRAPH
+0x96F3 0x8A33 #CJK UNIFIED IDEOGRAPH
+0x96F4 0x8E8D #CJK UNIFIED IDEOGRAPH
+0x96F5 0x9756 #CJK UNIFIED IDEOGRAPH
+0x96F6 0x67F3 #CJK UNIFIED IDEOGRAPH
+0x96F7 0x85AE #CJK UNIFIED IDEOGRAPH
+0x96F8 0x9453 #CJK UNIFIED IDEOGRAPH
+0x96F9 0x6109 #CJK UNIFIED IDEOGRAPH
+0x96FA 0x6108 #CJK UNIFIED IDEOGRAPH
+0x96FB 0x6CB9 #CJK UNIFIED IDEOGRAPH
+0x96FC 0x7652 #CJK UNIFIED IDEOGRAPH
+0x9740 0x8AED #CJK UNIFIED IDEOGRAPH
+0x9741 0x8F38 #CJK UNIFIED IDEOGRAPH
+0x9742 0x552F #CJK UNIFIED IDEOGRAPH
+0x9743 0x4F51 #CJK UNIFIED IDEOGRAPH
+0x9744 0x512A #CJK UNIFIED IDEOGRAPH
+0x9745 0x52C7 #CJK UNIFIED IDEOGRAPH
+0x9746 0x53CB #CJK UNIFIED IDEOGRAPH
+0x9747 0x5BA5 #CJK UNIFIED IDEOGRAPH
+0x9748 0x5E7D #CJK UNIFIED IDEOGRAPH
+0x9749 0x60A0 #CJK UNIFIED IDEOGRAPH
+0x974A 0x6182 #CJK UNIFIED IDEOGRAPH
+0x974B 0x63D6 #CJK UNIFIED IDEOGRAPH
+0x974C 0x6709 #CJK UNIFIED IDEOGRAPH
+0x974D 0x67DA #CJK UNIFIED IDEOGRAPH
+0x974E 0x6E67 #CJK UNIFIED IDEOGRAPH
+0x974F 0x6D8C #CJK UNIFIED IDEOGRAPH
+0x9750 0x7336 #CJK UNIFIED IDEOGRAPH
+0x9751 0x7337 #CJK UNIFIED IDEOGRAPH
+0x9752 0x7531 #CJK UNIFIED IDEOGRAPH
+0x9753 0x7950 #CJK UNIFIED IDEOGRAPH
+0x9754 0x88D5 #CJK UNIFIED IDEOGRAPH
+0x9755 0x8A98 #CJK UNIFIED IDEOGRAPH
+0x9756 0x904A #CJK UNIFIED IDEOGRAPH
+0x9757 0x9091 #CJK UNIFIED IDEOGRAPH
+0x9758 0x90F5 #CJK UNIFIED IDEOGRAPH
+0x9759 0x96C4 #CJK UNIFIED IDEOGRAPH
+0x975A 0x878D #CJK UNIFIED IDEOGRAPH
+0x975B 0x5915 #CJK UNIFIED IDEOGRAPH
+0x975C 0x4E88 #CJK UNIFIED IDEOGRAPH
+0x975D 0x4F59 #CJK UNIFIED IDEOGRAPH
+0x975E 0x4E0E #CJK UNIFIED IDEOGRAPH
+0x975F 0x8A89 #CJK UNIFIED IDEOGRAPH
+0x9760 0x8F3F #CJK UNIFIED IDEOGRAPH
+0x9761 0x9810 #CJK UNIFIED IDEOGRAPH
+0x9762 0x50AD #CJK UNIFIED IDEOGRAPH
+0x9763 0x5E7C #CJK UNIFIED IDEOGRAPH
+0x9764 0x5996 #CJK UNIFIED IDEOGRAPH
+0x9765 0x5BB9 #CJK UNIFIED IDEOGRAPH
+0x9766 0x5EB8 #CJK UNIFIED IDEOGRAPH
+0x9767 0x63DA #CJK UNIFIED IDEOGRAPH
+0x9768 0x63FA #CJK UNIFIED IDEOGRAPH
+0x9769 0x64C1 #CJK UNIFIED IDEOGRAPH
+0x976A 0x66DC #CJK UNIFIED IDEOGRAPH
+0x976B 0x694A #CJK UNIFIED IDEOGRAPH
+0x976C 0x69D8 #CJK UNIFIED IDEOGRAPH
+0x976D 0x6D0B #CJK UNIFIED IDEOGRAPH
+0x976E 0x6EB6 #CJK UNIFIED IDEOGRAPH
+0x976F 0x7194 #CJK UNIFIED IDEOGRAPH
+0x9770 0x7528 #CJK UNIFIED IDEOGRAPH
+0x9771 0x7AAF #CJK UNIFIED IDEOGRAPH
+0x9772 0x7F8A #CJK UNIFIED IDEOGRAPH
+0x9773 0x8000 #CJK UNIFIED IDEOGRAPH
+0x9774 0x8449 #CJK UNIFIED IDEOGRAPH
+0x9775 0x84C9 #CJK UNIFIED IDEOGRAPH
+0x9776 0x8981 #CJK UNIFIED IDEOGRAPH
+0x9777 0x8B21 #CJK UNIFIED IDEOGRAPH
+0x9778 0x8E0A #CJK UNIFIED IDEOGRAPH
+0x9779 0x9065 #CJK UNIFIED IDEOGRAPH
+0x977A 0x967D #CJK UNIFIED IDEOGRAPH
+0x977B 0x990A #CJK UNIFIED IDEOGRAPH
+0x977C 0x617E #CJK UNIFIED IDEOGRAPH
+0x977D 0x6291 #CJK UNIFIED IDEOGRAPH
+0x977E 0x6B32 #CJK UNIFIED IDEOGRAPH
+0x9780 0x6C83 #CJK UNIFIED IDEOGRAPH
+0x9781 0x6D74 #CJK UNIFIED IDEOGRAPH
+0x9782 0x7FCC #CJK UNIFIED IDEOGRAPH
+0x9783 0x7FFC #CJK UNIFIED IDEOGRAPH
+0x9784 0x6DC0 #CJK UNIFIED IDEOGRAPH
+0x9785 0x7F85 #CJK UNIFIED IDEOGRAPH
+0x9786 0x87BA #CJK UNIFIED IDEOGRAPH
+0x9787 0x88F8 #CJK UNIFIED IDEOGRAPH
+0x9788 0x6765 #CJK UNIFIED IDEOGRAPH
+0x9789 0x83B1 #CJK UNIFIED IDEOGRAPH
+0x978A 0x983C #CJK UNIFIED IDEOGRAPH
+0x978B 0x96F7 #CJK UNIFIED IDEOGRAPH
+0x978C 0x6D1B #CJK UNIFIED IDEOGRAPH
+0x978D 0x7D61 #CJK UNIFIED IDEOGRAPH
+0x978E 0x843D #CJK UNIFIED IDEOGRAPH
+0x978F 0x916A #CJK UNIFIED IDEOGRAPH
+0x9790 0x4E71 #CJK UNIFIED IDEOGRAPH
+0x9791 0x5375 #CJK UNIFIED IDEOGRAPH
+0x9792 0x5D50 #CJK UNIFIED IDEOGRAPH
+0x9793 0x6B04 #CJK UNIFIED IDEOGRAPH
+0x9794 0x6FEB #CJK UNIFIED IDEOGRAPH
+0x9795 0x85CD #CJK UNIFIED IDEOGRAPH
+0x9796 0x862D #CJK UNIFIED IDEOGRAPH
+0x9797 0x89A7 #CJK UNIFIED IDEOGRAPH
+0x9798 0x5229 #CJK UNIFIED IDEOGRAPH
+0x9799 0x540F #CJK UNIFIED IDEOGRAPH
+0x979A 0x5C65 #CJK UNIFIED IDEOGRAPH
+0x979B 0x674E #CJK UNIFIED IDEOGRAPH
+0x979C 0x68A8 #CJK UNIFIED IDEOGRAPH
+0x979D 0x7406 #CJK UNIFIED IDEOGRAPH
+0x979E 0x7483 #CJK UNIFIED IDEOGRAPH
+0x979F 0x75E2 #CJK UNIFIED IDEOGRAPH
+0x97A0 0x88CF #CJK UNIFIED IDEOGRAPH
+0x97A1 0x88E1 #CJK UNIFIED IDEOGRAPH
+0x97A2 0x91CC #CJK UNIFIED IDEOGRAPH
+0x97A3 0x96E2 #CJK UNIFIED IDEOGRAPH
+0x97A4 0x9678 #CJK UNIFIED IDEOGRAPH
+0x97A5 0x5F8B #CJK UNIFIED IDEOGRAPH
+0x97A6 0x7387 #CJK UNIFIED IDEOGRAPH
+0x97A7 0x7ACB #CJK UNIFIED IDEOGRAPH
+0x97A8 0x844E #CJK UNIFIED IDEOGRAPH
+0x97A9 0x63A0 #CJK UNIFIED IDEOGRAPH
+0x97AA 0x7565 #CJK UNIFIED IDEOGRAPH
+0x97AB 0x5289 #CJK UNIFIED IDEOGRAPH
+0x97AC 0x6D41 #CJK UNIFIED IDEOGRAPH
+0x97AD 0x6E9C #CJK UNIFIED IDEOGRAPH
+0x97AE 0x7409 #CJK UNIFIED IDEOGRAPH
+0x97AF 0x7559 #CJK UNIFIED IDEOGRAPH
+0x97B0 0x786B #CJK UNIFIED IDEOGRAPH
+0x97B1 0x7C92 #CJK UNIFIED IDEOGRAPH
+0x97B2 0x9686 #CJK UNIFIED IDEOGRAPH
+0x97B3 0x7ADC #CJK UNIFIED IDEOGRAPH
+0x97B4 0x9F8D #CJK UNIFIED IDEOGRAPH
+0x97B5 0x4FB6 #CJK UNIFIED IDEOGRAPH
+0x97B6 0x616E #CJK UNIFIED IDEOGRAPH
+0x97B7 0x65C5 #CJK UNIFIED IDEOGRAPH
+0x97B8 0x865C #CJK UNIFIED IDEOGRAPH
+0x97B9 0x4E86 #CJK UNIFIED IDEOGRAPH
+0x97BA 0x4EAE #CJK UNIFIED IDEOGRAPH
+0x97BB 0x50DA #CJK UNIFIED IDEOGRAPH
+0x97BC 0x4E21 #CJK UNIFIED IDEOGRAPH
+0x97BD 0x51CC #CJK UNIFIED IDEOGRAPH
+0x97BE 0x5BEE #CJK UNIFIED IDEOGRAPH
+0x97BF 0x6599 #CJK UNIFIED IDEOGRAPH
+0x97C0 0x6881 #CJK UNIFIED IDEOGRAPH
+0x97C1 0x6DBC #CJK UNIFIED IDEOGRAPH
+0x97C2 0x731F #CJK UNIFIED IDEOGRAPH
+0x97C3 0x7642 #CJK UNIFIED IDEOGRAPH
+0x97C4 0x77AD #CJK UNIFIED IDEOGRAPH
+0x97C5 0x7A1C #CJK UNIFIED IDEOGRAPH
+0x97C6 0x7CE7 #CJK UNIFIED IDEOGRAPH
+0x97C7 0x826F #CJK UNIFIED IDEOGRAPH
+0x97C8 0x8AD2 #CJK UNIFIED IDEOGRAPH
+0x97C9 0x907C #CJK UNIFIED IDEOGRAPH
+0x97CA 0x91CF #CJK UNIFIED IDEOGRAPH
+0x97CB 0x9675 #CJK UNIFIED IDEOGRAPH
+0x97CC 0x9818 #CJK UNIFIED IDEOGRAPH
+0x97CD 0x529B #CJK UNIFIED IDEOGRAPH
+0x97CE 0x7DD1 #CJK UNIFIED IDEOGRAPH
+0x97CF 0x502B #CJK UNIFIED IDEOGRAPH
+0x97D0 0x5398 #CJK UNIFIED IDEOGRAPH
+0x97D1 0x6797 #CJK UNIFIED IDEOGRAPH
+0x97D2 0x6DCB #CJK UNIFIED IDEOGRAPH
+0x97D3 0x71D0 #CJK UNIFIED IDEOGRAPH
+0x97D4 0x7433 #CJK UNIFIED IDEOGRAPH
+0x97D5 0x81E8 #CJK UNIFIED IDEOGRAPH
+0x97D6 0x8F2A #CJK UNIFIED IDEOGRAPH
+0x97D7 0x96A3 #CJK UNIFIED IDEOGRAPH
+0x97D8 0x9C57 #CJK UNIFIED IDEOGRAPH
+0x97D9 0x9E9F #CJK UNIFIED IDEOGRAPH
+0x97DA 0x7460 #CJK UNIFIED IDEOGRAPH
+0x97DB 0x5841 #CJK UNIFIED IDEOGRAPH
+0x97DC 0x6D99 #CJK UNIFIED IDEOGRAPH
+0x97DD 0x7D2F #CJK UNIFIED IDEOGRAPH
+0x97DE 0x985E #CJK UNIFIED IDEOGRAPH
+0x97DF 0x4EE4 #CJK UNIFIED IDEOGRAPH
+0x97E0 0x4F36 #CJK UNIFIED IDEOGRAPH
+0x97E1 0x4F8B #CJK UNIFIED IDEOGRAPH
+0x97E2 0x51B7 #CJK UNIFIED IDEOGRAPH
+0x97E3 0x52B1 #CJK UNIFIED IDEOGRAPH
+0x97E4 0x5DBA #CJK UNIFIED IDEOGRAPH
+0x97E5 0x601C #CJK UNIFIED IDEOGRAPH
+0x97E6 0x73B2 #CJK UNIFIED IDEOGRAPH
+0x97E7 0x793C #CJK UNIFIED IDEOGRAPH
+0x97E8 0x82D3 #CJK UNIFIED IDEOGRAPH
+0x97E9 0x9234 #CJK UNIFIED IDEOGRAPH
+0x97EA 0x96B7 #CJK UNIFIED IDEOGRAPH
+0x97EB 0x96F6 #CJK UNIFIED IDEOGRAPH
+0x97EC 0x970A #CJK UNIFIED IDEOGRAPH
+0x97ED 0x9E97 #CJK UNIFIED IDEOGRAPH
+0x97EE 0x9F62 #CJK UNIFIED IDEOGRAPH
+0x97EF 0x66A6 #CJK UNIFIED IDEOGRAPH
+0x97F0 0x6B74 #CJK UNIFIED IDEOGRAPH
+0x97F1 0x5217 #CJK UNIFIED IDEOGRAPH
+0x97F2 0x52A3 #CJK UNIFIED IDEOGRAPH
+0x97F3 0x70C8 #CJK UNIFIED IDEOGRAPH
+0x97F4 0x88C2 #CJK UNIFIED IDEOGRAPH
+0x97F5 0x5EC9 #CJK UNIFIED IDEOGRAPH
+0x97F6 0x604B #CJK UNIFIED IDEOGRAPH
+0x97F7 0x6190 #CJK UNIFIED IDEOGRAPH
+0x97F8 0x6F23 #CJK UNIFIED IDEOGRAPH
+0x97F9 0x7149 #CJK UNIFIED IDEOGRAPH
+0x97FA 0x7C3E #CJK UNIFIED IDEOGRAPH
+0x97FB 0x7DF4 #CJK UNIFIED IDEOGRAPH
+0x97FC 0x806F #CJK UNIFIED IDEOGRAPH
+0x9840 0x84EE #CJK UNIFIED IDEOGRAPH
+0x9841 0x9023 #CJK UNIFIED IDEOGRAPH
+0x9842 0x932C #CJK UNIFIED IDEOGRAPH
+0x9843 0x5442 #CJK UNIFIED IDEOGRAPH
+0x9844 0x9B6F #CJK UNIFIED IDEOGRAPH
+0x9845 0x6AD3 #CJK UNIFIED IDEOGRAPH
+0x9846 0x7089 #CJK UNIFIED IDEOGRAPH
+0x9847 0x8CC2 #CJK UNIFIED IDEOGRAPH
+0x9848 0x8DEF #CJK UNIFIED IDEOGRAPH
+0x9849 0x9732 #CJK UNIFIED IDEOGRAPH
+0x984A 0x52B4 #CJK UNIFIED IDEOGRAPH
+0x984B 0x5A41 #CJK UNIFIED IDEOGRAPH
+0x984C 0x5ECA #CJK UNIFIED IDEOGRAPH
+0x984D 0x5F04 #CJK UNIFIED IDEOGRAPH
+0x984E 0x6717 #CJK UNIFIED IDEOGRAPH
+0x984F 0x697C #CJK UNIFIED IDEOGRAPH
+0x9850 0x6994 #CJK UNIFIED IDEOGRAPH
+0x9851 0x6D6A #CJK UNIFIED IDEOGRAPH
+0x9852 0x6F0F #CJK UNIFIED IDEOGRAPH
+0x9853 0x7262 #CJK UNIFIED IDEOGRAPH
+0x9854 0x72FC #CJK UNIFIED IDEOGRAPH
+0x9855 0x7BED #CJK UNIFIED IDEOGRAPH
+0x9856 0x8001 #CJK UNIFIED IDEOGRAPH
+0x9857 0x807E #CJK UNIFIED IDEOGRAPH
+0x9858 0x874B #CJK UNIFIED IDEOGRAPH
+0x9859 0x90CE #CJK UNIFIED IDEOGRAPH
+0x985A 0x516D #CJK UNIFIED IDEOGRAPH
+0x985B 0x9E93 #CJK UNIFIED IDEOGRAPH
+0x985C 0x7984 #CJK UNIFIED IDEOGRAPH
+0x985D 0x808B #CJK UNIFIED IDEOGRAPH
+0x985E 0x9332 #CJK UNIFIED IDEOGRAPH
+0x985F 0x8AD6 #CJK UNIFIED IDEOGRAPH
+0x9860 0x502D #CJK UNIFIED IDEOGRAPH
+0x9861 0x548C #CJK UNIFIED IDEOGRAPH
+0x9862 0x8A71 #CJK UNIFIED IDEOGRAPH
+0x9863 0x6B6A #CJK UNIFIED IDEOGRAPH
+0x9864 0x8CC4 #CJK UNIFIED IDEOGRAPH
+0x9865 0x8107 #CJK UNIFIED IDEOGRAPH
+0x9866 0x60D1 #CJK UNIFIED IDEOGRAPH
+0x9867 0x67A0 #CJK UNIFIED IDEOGRAPH
+0x9868 0x9DF2 #CJK UNIFIED IDEOGRAPH
+0x9869 0x4E99 #CJK UNIFIED IDEOGRAPH
+0x986A 0x4E98 #CJK UNIFIED IDEOGRAPH
+0x986B 0x9C10 #CJK UNIFIED IDEOGRAPH
+0x986C 0x8A6B #CJK UNIFIED IDEOGRAPH
+0x986D 0x85C1 #CJK UNIFIED IDEOGRAPH
+0x986E 0x8568 #CJK UNIFIED IDEOGRAPH
+0x986F 0x6900 #CJK UNIFIED IDEOGRAPH
+0x9870 0x6E7E #CJK UNIFIED IDEOGRAPH
+0x9871 0x7897 #CJK UNIFIED IDEOGRAPH
+0x9872 0x8155 #CJK UNIFIED IDEOGRAPH
+0x989F 0x5F0C #CJK UNIFIED IDEOGRAPH
+0x98A0 0x4E10 #CJK UNIFIED IDEOGRAPH
+0x98A1 0x4E15 #CJK UNIFIED IDEOGRAPH
+0x98A2 0x4E2A #CJK UNIFIED IDEOGRAPH
+0x98A3 0x4E31 #CJK UNIFIED IDEOGRAPH
+0x98A4 0x4E36 #CJK UNIFIED IDEOGRAPH
+0x98A5 0x4E3C #CJK UNIFIED IDEOGRAPH
+0x98A6 0x4E3F #CJK UNIFIED IDEOGRAPH
+0x98A7 0x4E42 #CJK UNIFIED IDEOGRAPH
+0x98A8 0x4E56 #CJK UNIFIED IDEOGRAPH
+0x98A9 0x4E58 #CJK UNIFIED IDEOGRAPH
+0x98AA 0x4E82 #CJK UNIFIED IDEOGRAPH
+0x98AB 0x4E85 #CJK UNIFIED IDEOGRAPH
+0x98AC 0x8C6B #CJK UNIFIED IDEOGRAPH
+0x98AD 0x4E8A #CJK UNIFIED IDEOGRAPH
+0x98AE 0x8212 #CJK UNIFIED IDEOGRAPH
+0x98AF 0x5F0D #CJK UNIFIED IDEOGRAPH
+0x98B0 0x4E8E #CJK UNIFIED IDEOGRAPH
+0x98B1 0x4E9E #CJK UNIFIED IDEOGRAPH
+0x98B2 0x4E9F #CJK UNIFIED IDEOGRAPH
+0x98B3 0x4EA0 #CJK UNIFIED IDEOGRAPH
+0x98B4 0x4EA2 #CJK UNIFIED IDEOGRAPH
+0x98B5 0x4EB0 #CJK UNIFIED IDEOGRAPH
+0x98B6 0x4EB3 #CJK UNIFIED IDEOGRAPH
+0x98B7 0x4EB6 #CJK UNIFIED IDEOGRAPH
+0x98B8 0x4ECE #CJK UNIFIED IDEOGRAPH
+0x98B9 0x4ECD #CJK UNIFIED IDEOGRAPH
+0x98BA 0x4EC4 #CJK UNIFIED IDEOGRAPH
+0x98BB 0x4EC6 #CJK UNIFIED IDEOGRAPH
+0x98BC 0x4EC2 #CJK UNIFIED IDEOGRAPH
+0x98BD 0x4ED7 #CJK UNIFIED IDEOGRAPH
+0x98BE 0x4EDE #CJK UNIFIED IDEOGRAPH
+0x98BF 0x4EED #CJK UNIFIED IDEOGRAPH
+0x98C0 0x4EDF #CJK UNIFIED IDEOGRAPH
+0x98C1 0x4EF7 #CJK UNIFIED IDEOGRAPH
+0x98C2 0x4F09 #CJK UNIFIED IDEOGRAPH
+0x98C3 0x4F5A #CJK UNIFIED IDEOGRAPH
+0x98C4 0x4F30 #CJK UNIFIED IDEOGRAPH
+0x98C5 0x4F5B #CJK UNIFIED IDEOGRAPH
+0x98C6 0x4F5D #CJK UNIFIED IDEOGRAPH
+0x98C7 0x4F57 #CJK UNIFIED IDEOGRAPH
+0x98C8 0x4F47 #CJK UNIFIED IDEOGRAPH
+0x98C9 0x4F76 #CJK UNIFIED IDEOGRAPH
+0x98CA 0x4F88 #CJK UNIFIED IDEOGRAPH
+0x98CB 0x4F8F #CJK UNIFIED IDEOGRAPH
+0x98CC 0x4F98 #CJK UNIFIED IDEOGRAPH
+0x98CD 0x4F7B #CJK UNIFIED IDEOGRAPH
+0x98CE 0x4F69 #CJK UNIFIED IDEOGRAPH
+0x98CF 0x4F70 #CJK UNIFIED IDEOGRAPH
+0x98D0 0x4F91 #CJK UNIFIED IDEOGRAPH
+0x98D1 0x4F6F #CJK UNIFIED IDEOGRAPH
+0x98D2 0x4F86 #CJK UNIFIED IDEOGRAPH
+0x98D3 0x4F96 #CJK UNIFIED IDEOGRAPH
+0x98D4 0x5118 #CJK UNIFIED IDEOGRAPH
+0x98D5 0x4FD4 #CJK UNIFIED IDEOGRAPH
+0x98D6 0x4FDF #CJK UNIFIED IDEOGRAPH
+0x98D7 0x4FCE #CJK UNIFIED IDEOGRAPH
+0x98D8 0x4FD8 #CJK UNIFIED IDEOGRAPH
+0x98D9 0x4FDB #CJK UNIFIED IDEOGRAPH
+0x98DA 0x4FD1 #CJK UNIFIED IDEOGRAPH
+0x98DB 0x4FDA #CJK UNIFIED IDEOGRAPH
+0x98DC 0x4FD0 #CJK UNIFIED IDEOGRAPH
+0x98DD 0x4FE4 #CJK UNIFIED IDEOGRAPH
+0x98DE 0x4FE5 #CJK UNIFIED IDEOGRAPH
+0x98DF 0x501A #CJK UNIFIED IDEOGRAPH
+0x98E0 0x5028 #CJK UNIFIED IDEOGRAPH
+0x98E1 0x5014 #CJK UNIFIED IDEOGRAPH
+0x98E2 0x502A #CJK UNIFIED IDEOGRAPH
+0x98E3 0x5025 #CJK UNIFIED IDEOGRAPH
+0x98E4 0x5005 #CJK UNIFIED IDEOGRAPH
+0x98E5 0x4F1C #CJK UNIFIED IDEOGRAPH
+0x98E6 0x4FF6 #CJK UNIFIED IDEOGRAPH
+0x98E7 0x5021 #CJK UNIFIED IDEOGRAPH
+0x98E8 0x5029 #CJK UNIFIED IDEOGRAPH
+0x98E9 0x502C #CJK UNIFIED IDEOGRAPH
+0x98EA 0x4FFE #CJK UNIFIED IDEOGRAPH
+0x98EB 0x4FEF #CJK UNIFIED IDEOGRAPH
+0x98EC 0x5011 #CJK UNIFIED IDEOGRAPH
+0x98ED 0x5006 #CJK UNIFIED IDEOGRAPH
+0x98EE 0x5043 #CJK UNIFIED IDEOGRAPH
+0x98EF 0x5047 #CJK UNIFIED IDEOGRAPH
+0x98F0 0x6703 #CJK UNIFIED IDEOGRAPH
+0x98F1 0x5055 #CJK UNIFIED IDEOGRAPH
+0x98F2 0x5050 #CJK UNIFIED IDEOGRAPH
+0x98F3 0x5048 #CJK UNIFIED IDEOGRAPH
+0x98F4 0x505A #CJK UNIFIED IDEOGRAPH
+0x98F5 0x5056 #CJK UNIFIED IDEOGRAPH
+0x98F6 0x506C #CJK UNIFIED IDEOGRAPH
+0x98F7 0x5078 #CJK UNIFIED IDEOGRAPH
+0x98F8 0x5080 #CJK UNIFIED IDEOGRAPH
+0x98F9 0x509A #CJK UNIFIED IDEOGRAPH
+0x98FA 0x5085 #CJK UNIFIED IDEOGRAPH
+0x98FB 0x50B4 #CJK UNIFIED IDEOGRAPH
+0x98FC 0x50B2 #CJK UNIFIED IDEOGRAPH
+0x9940 0x50C9 #CJK UNIFIED IDEOGRAPH
+0x9941 0x50CA #CJK UNIFIED IDEOGRAPH
+0x9942 0x50B3 #CJK UNIFIED IDEOGRAPH
+0x9943 0x50C2 #CJK UNIFIED IDEOGRAPH
+0x9944 0x50D6 #CJK UNIFIED IDEOGRAPH
+0x9945 0x50DE #CJK UNIFIED IDEOGRAPH
+0x9946 0x50E5 #CJK UNIFIED IDEOGRAPH
+0x9947 0x50ED #CJK UNIFIED IDEOGRAPH
+0x9948 0x50E3 #CJK UNIFIED IDEOGRAPH
+0x9949 0x50EE #CJK UNIFIED IDEOGRAPH
+0x994A 0x50F9 #CJK UNIFIED IDEOGRAPH
+0x994B 0x50F5 #CJK UNIFIED IDEOGRAPH
+0x994C 0x5109 #CJK UNIFIED IDEOGRAPH
+0x994D 0x5101 #CJK UNIFIED IDEOGRAPH
+0x994E 0x5102 #CJK UNIFIED IDEOGRAPH
+0x994F 0x5116 #CJK UNIFIED IDEOGRAPH
+0x9950 0x5115 #CJK UNIFIED IDEOGRAPH
+0x9951 0x5114 #CJK UNIFIED IDEOGRAPH
+0x9952 0x511A #CJK UNIFIED IDEOGRAPH
+0x9953 0x5121 #CJK UNIFIED IDEOGRAPH
+0x9954 0x513A #CJK UNIFIED IDEOGRAPH
+0x9955 0x5137 #CJK UNIFIED IDEOGRAPH
+0x9956 0x513C #CJK UNIFIED IDEOGRAPH
+0x9957 0x513B #CJK UNIFIED IDEOGRAPH
+0x9958 0x513F #CJK UNIFIED IDEOGRAPH
+0x9959 0x5140 #CJK UNIFIED IDEOGRAPH
+0x995A 0x5152 #CJK UNIFIED IDEOGRAPH
+0x995B 0x514C #CJK UNIFIED IDEOGRAPH
+0x995C 0x5154 #CJK UNIFIED IDEOGRAPH
+0x995D 0x5162 #CJK UNIFIED IDEOGRAPH
+0x995E 0x7AF8 #CJK UNIFIED IDEOGRAPH
+0x995F 0x5169 #CJK UNIFIED IDEOGRAPH
+0x9960 0x516A #CJK UNIFIED IDEOGRAPH
+0x9961 0x516E #CJK UNIFIED IDEOGRAPH
+0x9962 0x5180 #CJK UNIFIED IDEOGRAPH
+0x9963 0x5182 #CJK UNIFIED IDEOGRAPH
+0x9964 0x56D8 #CJK UNIFIED IDEOGRAPH
+0x9965 0x518C #CJK UNIFIED IDEOGRAPH
+0x9966 0x5189 #CJK UNIFIED IDEOGRAPH
+0x9967 0x518F #CJK UNIFIED IDEOGRAPH
+0x9968 0x5191 #CJK UNIFIED IDEOGRAPH
+0x9969 0x5193 #CJK UNIFIED IDEOGRAPH
+0x996A 0x5195 #CJK UNIFIED IDEOGRAPH
+0x996B 0x5196 #CJK UNIFIED IDEOGRAPH
+0x996C 0x51A4 #CJK UNIFIED IDEOGRAPH
+0x996D 0x51A6 #CJK UNIFIED IDEOGRAPH
+0x996E 0x51A2 #CJK UNIFIED IDEOGRAPH
+0x996F 0x51A9 #CJK UNIFIED IDEOGRAPH
+0x9970 0x51AA #CJK UNIFIED IDEOGRAPH
+0x9971 0x51AB #CJK UNIFIED IDEOGRAPH
+0x9972 0x51B3 #CJK UNIFIED IDEOGRAPH
+0x9973 0x51B1 #CJK UNIFIED IDEOGRAPH
+0x9974 0x51B2 #CJK UNIFIED IDEOGRAPH
+0x9975 0x51B0 #CJK UNIFIED IDEOGRAPH
+0x9976 0x51B5 #CJK UNIFIED IDEOGRAPH
+0x9977 0x51BD #CJK UNIFIED IDEOGRAPH
+0x9978 0x51C5 #CJK UNIFIED IDEOGRAPH
+0x9979 0x51C9 #CJK UNIFIED IDEOGRAPH
+0x997A 0x51DB #CJK UNIFIED IDEOGRAPH
+0x997B 0x51E0 #CJK UNIFIED IDEOGRAPH
+0x997C 0x8655 #CJK UNIFIED IDEOGRAPH
+0x997D 0x51E9 #CJK UNIFIED IDEOGRAPH
+0x997E 0x51ED #CJK UNIFIED IDEOGRAPH
+0x9980 0x51F0 #CJK UNIFIED IDEOGRAPH
+0x9981 0x51F5 #CJK UNIFIED IDEOGRAPH
+0x9982 0x51FE #CJK UNIFIED IDEOGRAPH
+0x9983 0x5204 #CJK UNIFIED IDEOGRAPH
+0x9984 0x520B #CJK UNIFIED IDEOGRAPH
+0x9985 0x5214 #CJK UNIFIED IDEOGRAPH
+0x9986 0x520E #CJK UNIFIED IDEOGRAPH
+0x9987 0x5227 #CJK UNIFIED IDEOGRAPH
+0x9988 0x522A #CJK UNIFIED IDEOGRAPH
+0x9989 0x522E #CJK UNIFIED IDEOGRAPH
+0x998A 0x5233 #CJK UNIFIED IDEOGRAPH
+0x998B 0x5239 #CJK UNIFIED IDEOGRAPH
+0x998C 0x524F #CJK UNIFIED IDEOGRAPH
+0x998D 0x5244 #CJK UNIFIED IDEOGRAPH
+0x998E 0x524B #CJK UNIFIED IDEOGRAPH
+0x998F 0x524C #CJK UNIFIED IDEOGRAPH
+0x9990 0x525E #CJK UNIFIED IDEOGRAPH
+0x9991 0x5254 #CJK UNIFIED IDEOGRAPH
+0x9992 0x526A #CJK UNIFIED IDEOGRAPH
+0x9993 0x5274 #CJK UNIFIED IDEOGRAPH
+0x9994 0x5269 #CJK UNIFIED IDEOGRAPH
+0x9995 0x5273 #CJK UNIFIED IDEOGRAPH
+0x9996 0x527F #CJK UNIFIED IDEOGRAPH
+0x9997 0x527D #CJK UNIFIED IDEOGRAPH
+0x9998 0x528D #CJK UNIFIED IDEOGRAPH
+0x9999 0x5294 #CJK UNIFIED IDEOGRAPH
+0x999A 0x5292 #CJK UNIFIED IDEOGRAPH
+0x999B 0x5271 #CJK UNIFIED IDEOGRAPH
+0x999C 0x5288 #CJK UNIFIED IDEOGRAPH
+0x999D 0x5291 #CJK UNIFIED IDEOGRAPH
+0x999E 0x8FA8 #CJK UNIFIED IDEOGRAPH
+0x999F 0x8FA7 #CJK UNIFIED IDEOGRAPH
+0x99A0 0x52AC #CJK UNIFIED IDEOGRAPH
+0x99A1 0x52AD #CJK UNIFIED IDEOGRAPH
+0x99A2 0x52BC #CJK UNIFIED IDEOGRAPH
+0x99A3 0x52B5 #CJK UNIFIED IDEOGRAPH
+0x99A4 0x52C1 #CJK UNIFIED IDEOGRAPH
+0x99A5 0x52CD #CJK UNIFIED IDEOGRAPH
+0x99A6 0x52D7 #CJK UNIFIED IDEOGRAPH
+0x99A7 0x52DE #CJK UNIFIED IDEOGRAPH
+0x99A8 0x52E3 #CJK UNIFIED IDEOGRAPH
+0x99A9 0x52E6 #CJK UNIFIED IDEOGRAPH
+0x99AA 0x98ED #CJK UNIFIED IDEOGRAPH
+0x99AB 0x52E0 #CJK UNIFIED IDEOGRAPH
+0x99AC 0x52F3 #CJK UNIFIED IDEOGRAPH
+0x99AD 0x52F5 #CJK UNIFIED IDEOGRAPH
+0x99AE 0x52F8 #CJK UNIFIED IDEOGRAPH
+0x99AF 0x52F9 #CJK UNIFIED IDEOGRAPH
+0x99B0 0x5306 #CJK UNIFIED IDEOGRAPH
+0x99B1 0x5308 #CJK UNIFIED IDEOGRAPH
+0x99B2 0x7538 #CJK UNIFIED IDEOGRAPH
+0x99B3 0x530D #CJK UNIFIED IDEOGRAPH
+0x99B4 0x5310 #CJK UNIFIED IDEOGRAPH
+0x99B5 0x530F #CJK UNIFIED IDEOGRAPH
+0x99B6 0x5315 #CJK UNIFIED IDEOGRAPH
+0x99B7 0x531A #CJK UNIFIED IDEOGRAPH
+0x99B8 0x5323 #CJK UNIFIED IDEOGRAPH
+0x99B9 0x532F #CJK UNIFIED IDEOGRAPH
+0x99BA 0x5331 #CJK UNIFIED IDEOGRAPH
+0x99BB 0x5333 #CJK UNIFIED IDEOGRAPH
+0x99BC 0x5338 #CJK UNIFIED IDEOGRAPH
+0x99BD 0x5340 #CJK UNIFIED IDEOGRAPH
+0x99BE 0x5346 #CJK UNIFIED IDEOGRAPH
+0x99BF 0x5345 #CJK UNIFIED IDEOGRAPH
+0x99C0 0x4E17 #CJK UNIFIED IDEOGRAPH
+0x99C1 0x5349 #CJK UNIFIED IDEOGRAPH
+0x99C2 0x534D #CJK UNIFIED IDEOGRAPH
+0x99C3 0x51D6 #CJK UNIFIED IDEOGRAPH
+0x99C4 0x535E #CJK UNIFIED IDEOGRAPH
+0x99C5 0x5369 #CJK UNIFIED IDEOGRAPH
+0x99C6 0x536E #CJK UNIFIED IDEOGRAPH
+0x99C7 0x5918 #CJK UNIFIED IDEOGRAPH
+0x99C8 0x537B #CJK UNIFIED IDEOGRAPH
+0x99C9 0x5377 #CJK UNIFIED IDEOGRAPH
+0x99CA 0x5382 #CJK UNIFIED IDEOGRAPH
+0x99CB 0x5396 #CJK UNIFIED IDEOGRAPH
+0x99CC 0x53A0 #CJK UNIFIED IDEOGRAPH
+0x99CD 0x53A6 #CJK UNIFIED IDEOGRAPH
+0x99CE 0x53A5 #CJK UNIFIED IDEOGRAPH
+0x99CF 0x53AE #CJK UNIFIED IDEOGRAPH
+0x99D0 0x53B0 #CJK UNIFIED IDEOGRAPH
+0x99D1 0x53B6 #CJK UNIFIED IDEOGRAPH
+0x99D2 0x53C3 #CJK UNIFIED IDEOGRAPH
+0x99D3 0x7C12 #CJK UNIFIED IDEOGRAPH
+0x99D4 0x96D9 #CJK UNIFIED IDEOGRAPH
+0x99D5 0x53DF #CJK UNIFIED IDEOGRAPH
+0x99D6 0x66FC #CJK UNIFIED IDEOGRAPH
+0x99D7 0x71EE #CJK UNIFIED IDEOGRAPH
+0x99D8 0x53EE #CJK UNIFIED IDEOGRAPH
+0x99D9 0x53E8 #CJK UNIFIED IDEOGRAPH
+0x99DA 0x53ED #CJK UNIFIED IDEOGRAPH
+0x99DB 0x53FA #CJK UNIFIED IDEOGRAPH
+0x99DC 0x5401 #CJK UNIFIED IDEOGRAPH
+0x99DD 0x543D #CJK UNIFIED IDEOGRAPH
+0x99DE 0x5440 #CJK UNIFIED IDEOGRAPH
+0x99DF 0x542C #CJK UNIFIED IDEOGRAPH
+0x99E0 0x542D #CJK UNIFIED IDEOGRAPH
+0x99E1 0x543C #CJK UNIFIED IDEOGRAPH
+0x99E2 0x542E #CJK UNIFIED IDEOGRAPH
+0x99E3 0x5436 #CJK UNIFIED IDEOGRAPH
+0x99E4 0x5429 #CJK UNIFIED IDEOGRAPH
+0x99E5 0x541D #CJK UNIFIED IDEOGRAPH
+0x99E6 0x544E #CJK UNIFIED IDEOGRAPH
+0x99E7 0x548F #CJK UNIFIED IDEOGRAPH
+0x99E8 0x5475 #CJK UNIFIED IDEOGRAPH
+0x99E9 0x548E #CJK UNIFIED IDEOGRAPH
+0x99EA 0x545F #CJK UNIFIED IDEOGRAPH
+0x99EB 0x5471 #CJK UNIFIED IDEOGRAPH
+0x99EC 0x5477 #CJK UNIFIED IDEOGRAPH
+0x99ED 0x5470 #CJK UNIFIED IDEOGRAPH
+0x99EE 0x5492 #CJK UNIFIED IDEOGRAPH
+0x99EF 0x547B #CJK UNIFIED IDEOGRAPH
+0x99F0 0x5480 #CJK UNIFIED IDEOGRAPH
+0x99F1 0x5476 #CJK UNIFIED IDEOGRAPH
+0x99F2 0x5484 #CJK UNIFIED IDEOGRAPH
+0x99F3 0x5490 #CJK UNIFIED IDEOGRAPH
+0x99F4 0x5486 #CJK UNIFIED IDEOGRAPH
+0x99F5 0x54C7 #CJK UNIFIED IDEOGRAPH
+0x99F6 0x54A2 #CJK UNIFIED IDEOGRAPH
+0x99F7 0x54B8 #CJK UNIFIED IDEOGRAPH
+0x99F8 0x54A5 #CJK UNIFIED IDEOGRAPH
+0x99F9 0x54AC #CJK UNIFIED IDEOGRAPH
+0x99FA 0x54C4 #CJK UNIFIED IDEOGRAPH
+0x99FB 0x54C8 #CJK UNIFIED IDEOGRAPH
+0x99FC 0x54A8 #CJK UNIFIED IDEOGRAPH
+0x9A40 0x54AB #CJK UNIFIED IDEOGRAPH
+0x9A41 0x54C2 #CJK UNIFIED IDEOGRAPH
+0x9A42 0x54A4 #CJK UNIFIED IDEOGRAPH
+0x9A43 0x54BE #CJK UNIFIED IDEOGRAPH
+0x9A44 0x54BC #CJK UNIFIED IDEOGRAPH
+0x9A45 0x54D8 #CJK UNIFIED IDEOGRAPH
+0x9A46 0x54E5 #CJK UNIFIED IDEOGRAPH
+0x9A47 0x54E6 #CJK UNIFIED IDEOGRAPH
+0x9A48 0x550F #CJK UNIFIED IDEOGRAPH
+0x9A49 0x5514 #CJK UNIFIED IDEOGRAPH
+0x9A4A 0x54FD #CJK UNIFIED IDEOGRAPH
+0x9A4B 0x54EE #CJK UNIFIED IDEOGRAPH
+0x9A4C 0x54ED #CJK UNIFIED IDEOGRAPH
+0x9A4D 0x54FA #CJK UNIFIED IDEOGRAPH
+0x9A4E 0x54E2 #CJK UNIFIED IDEOGRAPH
+0x9A4F 0x5539 #CJK UNIFIED IDEOGRAPH
+0x9A50 0x5540 #CJK UNIFIED IDEOGRAPH
+0x9A51 0x5563 #CJK UNIFIED IDEOGRAPH
+0x9A52 0x554C #CJK UNIFIED IDEOGRAPH
+0x9A53 0x552E #CJK UNIFIED IDEOGRAPH
+0x9A54 0x555C #CJK UNIFIED IDEOGRAPH
+0x9A55 0x5545 #CJK UNIFIED IDEOGRAPH
+0x9A56 0x5556 #CJK UNIFIED IDEOGRAPH
+0x9A57 0x5557 #CJK UNIFIED IDEOGRAPH
+0x9A58 0x5538 #CJK UNIFIED IDEOGRAPH
+0x9A59 0x5533 #CJK UNIFIED IDEOGRAPH
+0x9A5A 0x555D #CJK UNIFIED IDEOGRAPH
+0x9A5B 0x5599 #CJK UNIFIED IDEOGRAPH
+0x9A5C 0x5580 #CJK UNIFIED IDEOGRAPH
+0x9A5D 0x54AF #CJK UNIFIED IDEOGRAPH
+0x9A5E 0x558A #CJK UNIFIED IDEOGRAPH
+0x9A5F 0x559F #CJK UNIFIED IDEOGRAPH
+0x9A60 0x557B #CJK UNIFIED IDEOGRAPH
+0x9A61 0x557E #CJK UNIFIED IDEOGRAPH
+0x9A62 0x5598 #CJK UNIFIED IDEOGRAPH
+0x9A63 0x559E #CJK UNIFIED IDEOGRAPH
+0x9A64 0x55AE #CJK UNIFIED IDEOGRAPH
+0x9A65 0x557C #CJK UNIFIED IDEOGRAPH
+0x9A66 0x5583 #CJK UNIFIED IDEOGRAPH
+0x9A67 0x55A9 #CJK UNIFIED IDEOGRAPH
+0x9A68 0x5587 #CJK UNIFIED IDEOGRAPH
+0x9A69 0x55A8 #CJK UNIFIED IDEOGRAPH
+0x9A6A 0x55DA #CJK UNIFIED IDEOGRAPH
+0x9A6B 0x55C5 #CJK UNIFIED IDEOGRAPH
+0x9A6C 0x55DF #CJK UNIFIED IDEOGRAPH
+0x9A6D 0x55C4 #CJK UNIFIED IDEOGRAPH
+0x9A6E 0x55DC #CJK UNIFIED IDEOGRAPH
+0x9A6F 0x55E4 #CJK UNIFIED IDEOGRAPH
+0x9A70 0x55D4 #CJK UNIFIED IDEOGRAPH
+0x9A71 0x5614 #CJK UNIFIED IDEOGRAPH
+0x9A72 0x55F7 #CJK UNIFIED IDEOGRAPH
+0x9A73 0x5616 #CJK UNIFIED IDEOGRAPH
+0x9A74 0x55FE #CJK UNIFIED IDEOGRAPH
+0x9A75 0x55FD #CJK UNIFIED IDEOGRAPH
+0x9A76 0x561B #CJK UNIFIED IDEOGRAPH
+0x9A77 0x55F9 #CJK UNIFIED IDEOGRAPH
+0x9A78 0x564E #CJK UNIFIED IDEOGRAPH
+0x9A79 0x5650 #CJK UNIFIED IDEOGRAPH
+0x9A7A 0x71DF #CJK UNIFIED IDEOGRAPH
+0x9A7B 0x5634 #CJK UNIFIED IDEOGRAPH
+0x9A7C 0x5636 #CJK UNIFIED IDEOGRAPH
+0x9A7D 0x5632 #CJK UNIFIED IDEOGRAPH
+0x9A7E 0x5638 #CJK UNIFIED IDEOGRAPH
+0x9A80 0x566B #CJK UNIFIED IDEOGRAPH
+0x9A81 0x5664 #CJK UNIFIED IDEOGRAPH
+0x9A82 0x562F #CJK UNIFIED IDEOGRAPH
+0x9A83 0x566C #CJK UNIFIED IDEOGRAPH
+0x9A84 0x566A #CJK UNIFIED IDEOGRAPH
+0x9A85 0x5686 #CJK UNIFIED IDEOGRAPH
+0x9A86 0x5680 #CJK UNIFIED IDEOGRAPH
+0x9A87 0x568A #CJK UNIFIED IDEOGRAPH
+0x9A88 0x56A0 #CJK UNIFIED IDEOGRAPH
+0x9A89 0x5694 #CJK UNIFIED IDEOGRAPH
+0x9A8A 0x568F #CJK UNIFIED IDEOGRAPH
+0x9A8B 0x56A5 #CJK UNIFIED IDEOGRAPH
+0x9A8C 0x56AE #CJK UNIFIED IDEOGRAPH
+0x9A8D 0x56B6 #CJK UNIFIED IDEOGRAPH
+0x9A8E 0x56B4 #CJK UNIFIED IDEOGRAPH
+0x9A8F 0x56C2 #CJK UNIFIED IDEOGRAPH
+0x9A90 0x56BC #CJK UNIFIED IDEOGRAPH
+0x9A91 0x56C1 #CJK UNIFIED IDEOGRAPH
+0x9A92 0x56C3 #CJK UNIFIED IDEOGRAPH
+0x9A93 0x56C0 #CJK UNIFIED IDEOGRAPH
+0x9A94 0x56C8 #CJK UNIFIED IDEOGRAPH
+0x9A95 0x56CE #CJK UNIFIED IDEOGRAPH
+0x9A96 0x56D1 #CJK UNIFIED IDEOGRAPH
+0x9A97 0x56D3 #CJK UNIFIED IDEOGRAPH
+0x9A98 0x56D7 #CJK UNIFIED IDEOGRAPH
+0x9A99 0x56EE #CJK UNIFIED IDEOGRAPH
+0x9A9A 0x56F9 #CJK UNIFIED IDEOGRAPH
+0x9A9B 0x5700 #CJK UNIFIED IDEOGRAPH
+0x9A9C 0x56FF #CJK UNIFIED IDEOGRAPH
+0x9A9D 0x5704 #CJK UNIFIED IDEOGRAPH
+0x9A9E 0x5709 #CJK UNIFIED IDEOGRAPH
+0x9A9F 0x5708 #CJK UNIFIED IDEOGRAPH
+0x9AA0 0x570B #CJK UNIFIED IDEOGRAPH
+0x9AA1 0x570D #CJK UNIFIED IDEOGRAPH
+0x9AA2 0x5713 #CJK UNIFIED IDEOGRAPH
+0x9AA3 0x5718 #CJK UNIFIED IDEOGRAPH
+0x9AA4 0x5716 #CJK UNIFIED IDEOGRAPH
+0x9AA5 0x55C7 #CJK UNIFIED IDEOGRAPH
+0x9AA6 0x571C #CJK UNIFIED IDEOGRAPH
+0x9AA7 0x5726 #CJK UNIFIED IDEOGRAPH
+0x9AA8 0x5737 #CJK UNIFIED IDEOGRAPH
+0x9AA9 0x5738 #CJK UNIFIED IDEOGRAPH
+0x9AAA 0x574E #CJK UNIFIED IDEOGRAPH
+0x9AAB 0x573B #CJK UNIFIED IDEOGRAPH
+0x9AAC 0x5740 #CJK UNIFIED IDEOGRAPH
+0x9AAD 0x574F #CJK UNIFIED IDEOGRAPH
+0x9AAE 0x5769 #CJK UNIFIED IDEOGRAPH
+0x9AAF 0x57C0 #CJK UNIFIED IDEOGRAPH
+0x9AB0 0x5788 #CJK UNIFIED IDEOGRAPH
+0x9AB1 0x5761 #CJK UNIFIED IDEOGRAPH
+0x9AB2 0x577F #CJK UNIFIED IDEOGRAPH
+0x9AB3 0x5789 #CJK UNIFIED IDEOGRAPH
+0x9AB4 0x5793 #CJK UNIFIED IDEOGRAPH
+0x9AB5 0x57A0 #CJK UNIFIED IDEOGRAPH
+0x9AB6 0x57B3 #CJK UNIFIED IDEOGRAPH
+0x9AB7 0x57A4 #CJK UNIFIED IDEOGRAPH
+0x9AB8 0x57AA #CJK UNIFIED IDEOGRAPH
+0x9AB9 0x57B0 #CJK UNIFIED IDEOGRAPH
+0x9ABA 0x57C3 #CJK UNIFIED IDEOGRAPH
+0x9ABB 0x57C6 #CJK UNIFIED IDEOGRAPH
+0x9ABC 0x57D4 #CJK UNIFIED IDEOGRAPH
+0x9ABD 0x57D2 #CJK UNIFIED IDEOGRAPH
+0x9ABE 0x57D3 #CJK UNIFIED IDEOGRAPH
+0x9ABF 0x580A #CJK UNIFIED IDEOGRAPH
+0x9AC0 0x57D6 #CJK UNIFIED IDEOGRAPH
+0x9AC1 0x57E3 #CJK UNIFIED IDEOGRAPH
+0x9AC2 0x580B #CJK UNIFIED IDEOGRAPH
+0x9AC3 0x5819 #CJK UNIFIED IDEOGRAPH
+0x9AC4 0x581D #CJK UNIFIED IDEOGRAPH
+0x9AC5 0x5872 #CJK UNIFIED IDEOGRAPH
+0x9AC6 0x5821 #CJK UNIFIED IDEOGRAPH
+0x9AC7 0x5862 #CJK UNIFIED IDEOGRAPH
+0x9AC8 0x584B #CJK UNIFIED IDEOGRAPH
+0x9AC9 0x5870 #CJK UNIFIED IDEOGRAPH
+0x9ACA 0x6BC0 #CJK UNIFIED IDEOGRAPH
+0x9ACB 0x5852 #CJK UNIFIED IDEOGRAPH
+0x9ACC 0x583D #CJK UNIFIED IDEOGRAPH
+0x9ACD 0x5879 #CJK UNIFIED IDEOGRAPH
+0x9ACE 0x5885 #CJK UNIFIED IDEOGRAPH
+0x9ACF 0x58B9 #CJK UNIFIED IDEOGRAPH
+0x9AD0 0x589F #CJK UNIFIED IDEOGRAPH
+0x9AD1 0x58AB #CJK UNIFIED IDEOGRAPH
+0x9AD2 0x58BA #CJK UNIFIED IDEOGRAPH
+0x9AD3 0x58DE #CJK UNIFIED IDEOGRAPH
+0x9AD4 0x58BB #CJK UNIFIED IDEOGRAPH
+0x9AD5 0x58B8 #CJK UNIFIED IDEOGRAPH
+0x9AD6 0x58AE #CJK UNIFIED IDEOGRAPH
+0x9AD7 0x58C5 #CJK UNIFIED IDEOGRAPH
+0x9AD8 0x58D3 #CJK UNIFIED IDEOGRAPH
+0x9AD9 0x58D1 #CJK UNIFIED IDEOGRAPH
+0x9ADA 0x58D7 #CJK UNIFIED IDEOGRAPH
+0x9ADB 0x58D9 #CJK UNIFIED IDEOGRAPH
+0x9ADC 0x58D8 #CJK UNIFIED IDEOGRAPH
+0x9ADD 0x58E5 #CJK UNIFIED IDEOGRAPH
+0x9ADE 0x58DC #CJK UNIFIED IDEOGRAPH
+0x9ADF 0x58E4 #CJK UNIFIED IDEOGRAPH
+0x9AE0 0x58DF #CJK UNIFIED IDEOGRAPH
+0x9AE1 0x58EF #CJK UNIFIED IDEOGRAPH
+0x9AE2 0x58FA #CJK UNIFIED IDEOGRAPH
+0x9AE3 0x58F9 #CJK UNIFIED IDEOGRAPH
+0x9AE4 0x58FB #CJK UNIFIED IDEOGRAPH
+0x9AE5 0x58FC #CJK UNIFIED IDEOGRAPH
+0x9AE6 0x58FD #CJK UNIFIED IDEOGRAPH
+0x9AE7 0x5902 #CJK UNIFIED IDEOGRAPH
+0x9AE8 0x590A #CJK UNIFIED IDEOGRAPH
+0x9AE9 0x5910 #CJK UNIFIED IDEOGRAPH
+0x9AEA 0x591B #CJK UNIFIED IDEOGRAPH
+0x9AEB 0x68A6 #CJK UNIFIED IDEOGRAPH
+0x9AEC 0x5925 #CJK UNIFIED IDEOGRAPH
+0x9AED 0x592C #CJK UNIFIED IDEOGRAPH
+0x9AEE 0x592D #CJK UNIFIED IDEOGRAPH
+0x9AEF 0x5932 #CJK UNIFIED IDEOGRAPH
+0x9AF0 0x5938 #CJK UNIFIED IDEOGRAPH
+0x9AF1 0x593E #CJK UNIFIED IDEOGRAPH
+0x9AF2 0x7AD2 #CJK UNIFIED IDEOGRAPH
+0x9AF3 0x5955 #CJK UNIFIED IDEOGRAPH
+0x9AF4 0x5950 #CJK UNIFIED IDEOGRAPH
+0x9AF5 0x594E #CJK UNIFIED IDEOGRAPH
+0x9AF6 0x595A #CJK UNIFIED IDEOGRAPH
+0x9AF7 0x5958 #CJK UNIFIED IDEOGRAPH
+0x9AF8 0x5962 #CJK UNIFIED IDEOGRAPH
+0x9AF9 0x5960 #CJK UNIFIED IDEOGRAPH
+0x9AFA 0x5967 #CJK UNIFIED IDEOGRAPH
+0x9AFB 0x596C #CJK UNIFIED IDEOGRAPH
+0x9AFC 0x5969 #CJK UNIFIED IDEOGRAPH
+0x9B40 0x5978 #CJK UNIFIED IDEOGRAPH
+0x9B41 0x5981 #CJK UNIFIED IDEOGRAPH
+0x9B42 0x599D #CJK UNIFIED IDEOGRAPH
+0x9B43 0x4F5E #CJK UNIFIED IDEOGRAPH
+0x9B44 0x4FAB #CJK UNIFIED IDEOGRAPH
+0x9B45 0x59A3 #CJK UNIFIED IDEOGRAPH
+0x9B46 0x59B2 #CJK UNIFIED IDEOGRAPH
+0x9B47 0x59C6 #CJK UNIFIED IDEOGRAPH
+0x9B48 0x59E8 #CJK UNIFIED IDEOGRAPH
+0x9B49 0x59DC #CJK UNIFIED IDEOGRAPH
+0x9B4A 0x598D #CJK UNIFIED IDEOGRAPH
+0x9B4B 0x59D9 #CJK UNIFIED IDEOGRAPH
+0x9B4C 0x59DA #CJK UNIFIED IDEOGRAPH
+0x9B4D 0x5A25 #CJK UNIFIED IDEOGRAPH
+0x9B4E 0x5A1F #CJK UNIFIED IDEOGRAPH
+0x9B4F 0x5A11 #CJK UNIFIED IDEOGRAPH
+0x9B50 0x5A1C #CJK UNIFIED IDEOGRAPH
+0x9B51 0x5A09 #CJK UNIFIED IDEOGRAPH
+0x9B52 0x5A1A #CJK UNIFIED IDEOGRAPH
+0x9B53 0x5A40 #CJK UNIFIED IDEOGRAPH
+0x9B54 0x5A6C #CJK UNIFIED IDEOGRAPH
+0x9B55 0x5A49 #CJK UNIFIED IDEOGRAPH
+0x9B56 0x5A35 #CJK UNIFIED IDEOGRAPH
+0x9B57 0x5A36 #CJK UNIFIED IDEOGRAPH
+0x9B58 0x5A62 #CJK UNIFIED IDEOGRAPH
+0x9B59 0x5A6A #CJK UNIFIED IDEOGRAPH
+0x9B5A 0x5A9A #CJK UNIFIED IDEOGRAPH
+0x9B5B 0x5ABC #CJK UNIFIED IDEOGRAPH
+0x9B5C 0x5ABE #CJK UNIFIED IDEOGRAPH
+0x9B5D 0x5ACB #CJK UNIFIED IDEOGRAPH
+0x9B5E 0x5AC2 #CJK UNIFIED IDEOGRAPH
+0x9B5F 0x5ABD #CJK UNIFIED IDEOGRAPH
+0x9B60 0x5AE3 #CJK UNIFIED IDEOGRAPH
+0x9B61 0x5AD7 #CJK UNIFIED IDEOGRAPH
+0x9B62 0x5AE6 #CJK UNIFIED IDEOGRAPH
+0x9B63 0x5AE9 #CJK UNIFIED IDEOGRAPH
+0x9B64 0x5AD6 #CJK UNIFIED IDEOGRAPH
+0x9B65 0x5AFA #CJK UNIFIED IDEOGRAPH
+0x9B66 0x5AFB #CJK UNIFIED IDEOGRAPH
+0x9B67 0x5B0C #CJK UNIFIED IDEOGRAPH
+0x9B68 0x5B0B #CJK UNIFIED IDEOGRAPH
+0x9B69 0x5B16 #CJK UNIFIED IDEOGRAPH
+0x9B6A 0x5B32 #CJK UNIFIED IDEOGRAPH
+0x9B6B 0x5AD0 #CJK UNIFIED IDEOGRAPH
+0x9B6C 0x5B2A #CJK UNIFIED IDEOGRAPH
+0x9B6D 0x5B36 #CJK UNIFIED IDEOGRAPH
+0x9B6E 0x5B3E #CJK UNIFIED IDEOGRAPH
+0x9B6F 0x5B43 #CJK UNIFIED IDEOGRAPH
+0x9B70 0x5B45 #CJK UNIFIED IDEOGRAPH
+0x9B71 0x5B40 #CJK UNIFIED IDEOGRAPH
+0x9B72 0x5B51 #CJK UNIFIED IDEOGRAPH
+0x9B73 0x5B55 #CJK UNIFIED IDEOGRAPH
+0x9B74 0x5B5A #CJK UNIFIED IDEOGRAPH
+0x9B75 0x5B5B #CJK UNIFIED IDEOGRAPH
+0x9B76 0x5B65 #CJK UNIFIED IDEOGRAPH
+0x9B77 0x5B69 #CJK UNIFIED IDEOGRAPH
+0x9B78 0x5B70 #CJK UNIFIED IDEOGRAPH
+0x9B79 0x5B73 #CJK UNIFIED IDEOGRAPH
+0x9B7A 0x5B75 #CJK UNIFIED IDEOGRAPH
+0x9B7B 0x5B78 #CJK UNIFIED IDEOGRAPH
+0x9B7C 0x6588 #CJK UNIFIED IDEOGRAPH
+0x9B7D 0x5B7A #CJK UNIFIED IDEOGRAPH
+0x9B7E 0x5B80 #CJK UNIFIED IDEOGRAPH
+0x9B80 0x5B83 #CJK UNIFIED IDEOGRAPH
+0x9B81 0x5BA6 #CJK UNIFIED IDEOGRAPH
+0x9B82 0x5BB8 #CJK UNIFIED IDEOGRAPH
+0x9B83 0x5BC3 #CJK UNIFIED IDEOGRAPH
+0x9B84 0x5BC7 #CJK UNIFIED IDEOGRAPH
+0x9B85 0x5BC9 #CJK UNIFIED IDEOGRAPH
+0x9B86 0x5BD4 #CJK UNIFIED IDEOGRAPH
+0x9B87 0x5BD0 #CJK UNIFIED IDEOGRAPH
+0x9B88 0x5BE4 #CJK UNIFIED IDEOGRAPH
+0x9B89 0x5BE6 #CJK UNIFIED IDEOGRAPH
+0x9B8A 0x5BE2 #CJK UNIFIED IDEOGRAPH
+0x9B8B 0x5BDE #CJK UNIFIED IDEOGRAPH
+0x9B8C 0x5BE5 #CJK UNIFIED IDEOGRAPH
+0x9B8D 0x5BEB #CJK UNIFIED IDEOGRAPH
+0x9B8E 0x5BF0 #CJK UNIFIED IDEOGRAPH
+0x9B8F 0x5BF6 #CJK UNIFIED IDEOGRAPH
+0x9B90 0x5BF3 #CJK UNIFIED IDEOGRAPH
+0x9B91 0x5C05 #CJK UNIFIED IDEOGRAPH
+0x9B92 0x5C07 #CJK UNIFIED IDEOGRAPH
+0x9B93 0x5C08 #CJK UNIFIED IDEOGRAPH
+0x9B94 0x5C0D #CJK UNIFIED IDEOGRAPH
+0x9B95 0x5C13 #CJK UNIFIED IDEOGRAPH
+0x9B96 0x5C20 #CJK UNIFIED IDEOGRAPH
+0x9B97 0x5C22 #CJK UNIFIED IDEOGRAPH
+0x9B98 0x5C28 #CJK UNIFIED IDEOGRAPH
+0x9B99 0x5C38 #CJK UNIFIED IDEOGRAPH
+0x9B9A 0x5C39 #CJK UNIFIED IDEOGRAPH
+0x9B9B 0x5C41 #CJK UNIFIED IDEOGRAPH
+0x9B9C 0x5C46 #CJK UNIFIED IDEOGRAPH
+0x9B9D 0x5C4E #CJK UNIFIED IDEOGRAPH
+0x9B9E 0x5C53 #CJK UNIFIED IDEOGRAPH
+0x9B9F 0x5C50 #CJK UNIFIED IDEOGRAPH
+0x9BA0 0x5C4F #CJK UNIFIED IDEOGRAPH
+0x9BA1 0x5B71 #CJK UNIFIED IDEOGRAPH
+0x9BA2 0x5C6C #CJK UNIFIED IDEOGRAPH
+0x9BA3 0x5C6E #CJK UNIFIED IDEOGRAPH
+0x9BA4 0x4E62 #CJK UNIFIED IDEOGRAPH
+0x9BA5 0x5C76 #CJK UNIFIED IDEOGRAPH
+0x9BA6 0x5C79 #CJK UNIFIED IDEOGRAPH
+0x9BA7 0x5C8C #CJK UNIFIED IDEOGRAPH
+0x9BA8 0x5C91 #CJK UNIFIED IDEOGRAPH
+0x9BA9 0x5C94 #CJK UNIFIED IDEOGRAPH
+0x9BAA 0x599B #CJK UNIFIED IDEOGRAPH
+0x9BAB 0x5CAB #CJK UNIFIED IDEOGRAPH
+0x9BAC 0x5CBB #CJK UNIFIED IDEOGRAPH
+0x9BAD 0x5CB6 #CJK UNIFIED IDEOGRAPH
+0x9BAE 0x5CBC #CJK UNIFIED IDEOGRAPH
+0x9BAF 0x5CB7 #CJK UNIFIED IDEOGRAPH
+0x9BB0 0x5CC5 #CJK UNIFIED IDEOGRAPH
+0x9BB1 0x5CBE #CJK UNIFIED IDEOGRAPH
+0x9BB2 0x5CC7 #CJK UNIFIED IDEOGRAPH
+0x9BB3 0x5CD9 #CJK UNIFIED IDEOGRAPH
+0x9BB4 0x5CE9 #CJK UNIFIED IDEOGRAPH
+0x9BB5 0x5CFD #CJK UNIFIED IDEOGRAPH
+0x9BB6 0x5CFA #CJK UNIFIED IDEOGRAPH
+0x9BB7 0x5CED #CJK UNIFIED IDEOGRAPH
+0x9BB8 0x5D8C #CJK UNIFIED IDEOGRAPH
+0x9BB9 0x5CEA #CJK UNIFIED IDEOGRAPH
+0x9BBA 0x5D0B #CJK UNIFIED IDEOGRAPH
+0x9BBB 0x5D15 #CJK UNIFIED IDEOGRAPH
+0x9BBC 0x5D17 #CJK UNIFIED IDEOGRAPH
+0x9BBD 0x5D5C #CJK UNIFIED IDEOGRAPH
+0x9BBE 0x5D1F #CJK UNIFIED IDEOGRAPH
+0x9BBF 0x5D1B #CJK UNIFIED IDEOGRAPH
+0x9BC0 0x5D11 #CJK UNIFIED IDEOGRAPH
+0x9BC1 0x5D14 #CJK UNIFIED IDEOGRAPH
+0x9BC2 0x5D22 #CJK UNIFIED IDEOGRAPH
+0x9BC3 0x5D1A #CJK UNIFIED IDEOGRAPH
+0x9BC4 0x5D19 #CJK UNIFIED IDEOGRAPH
+0x9BC5 0x5D18 #CJK UNIFIED IDEOGRAPH
+0x9BC6 0x5D4C #CJK UNIFIED IDEOGRAPH
+0x9BC7 0x5D52 #CJK UNIFIED IDEOGRAPH
+0x9BC8 0x5D4E #CJK UNIFIED IDEOGRAPH
+0x9BC9 0x5D4B #CJK UNIFIED IDEOGRAPH
+0x9BCA 0x5D6C #CJK UNIFIED IDEOGRAPH
+0x9BCB 0x5D73 #CJK UNIFIED IDEOGRAPH
+0x9BCC 0x5D76 #CJK UNIFIED IDEOGRAPH
+0x9BCD 0x5D87 #CJK UNIFIED IDEOGRAPH
+0x9BCE 0x5D84 #CJK UNIFIED IDEOGRAPH
+0x9BCF 0x5D82 #CJK UNIFIED IDEOGRAPH
+0x9BD0 0x5DA2 #CJK UNIFIED IDEOGRAPH
+0x9BD1 0x5D9D #CJK UNIFIED IDEOGRAPH
+0x9BD2 0x5DAC #CJK UNIFIED IDEOGRAPH
+0x9BD3 0x5DAE #CJK UNIFIED IDEOGRAPH
+0x9BD4 0x5DBD #CJK UNIFIED IDEOGRAPH
+0x9BD5 0x5D90 #CJK UNIFIED IDEOGRAPH
+0x9BD6 0x5DB7 #CJK UNIFIED IDEOGRAPH
+0x9BD7 0x5DBC #CJK UNIFIED IDEOGRAPH
+0x9BD8 0x5DC9 #CJK UNIFIED IDEOGRAPH
+0x9BD9 0x5DCD #CJK UNIFIED IDEOGRAPH
+0x9BDA 0x5DD3 #CJK UNIFIED IDEOGRAPH
+0x9BDB 0x5DD2 #CJK UNIFIED IDEOGRAPH
+0x9BDC 0x5DD6 #CJK UNIFIED IDEOGRAPH
+0x9BDD 0x5DDB #CJK UNIFIED IDEOGRAPH
+0x9BDE 0x5DEB #CJK UNIFIED IDEOGRAPH
+0x9BDF 0x5DF2 #CJK UNIFIED IDEOGRAPH
+0x9BE0 0x5DF5 #CJK UNIFIED IDEOGRAPH
+0x9BE1 0x5E0B #CJK UNIFIED IDEOGRAPH
+0x9BE2 0x5E1A #CJK UNIFIED IDEOGRAPH
+0x9BE3 0x5E19 #CJK UNIFIED IDEOGRAPH
+0x9BE4 0x5E11 #CJK UNIFIED IDEOGRAPH
+0x9BE5 0x5E1B #CJK UNIFIED IDEOGRAPH
+0x9BE6 0x5E36 #CJK UNIFIED IDEOGRAPH
+0x9BE7 0x5E37 #CJK UNIFIED IDEOGRAPH
+0x9BE8 0x5E44 #CJK UNIFIED IDEOGRAPH
+0x9BE9 0x5E43 #CJK UNIFIED IDEOGRAPH
+0x9BEA 0x5E40 #CJK UNIFIED IDEOGRAPH
+0x9BEB 0x5E4E #CJK UNIFIED IDEOGRAPH
+0x9BEC 0x5E57 #CJK UNIFIED IDEOGRAPH
+0x9BED 0x5E54 #CJK UNIFIED IDEOGRAPH
+0x9BEE 0x5E5F #CJK UNIFIED IDEOGRAPH
+0x9BEF 0x5E62 #CJK UNIFIED IDEOGRAPH
+0x9BF0 0x5E64 #CJK UNIFIED IDEOGRAPH
+0x9BF1 0x5E47 #CJK UNIFIED IDEOGRAPH
+0x9BF2 0x5E75 #CJK UNIFIED IDEOGRAPH
+0x9BF3 0x5E76 #CJK UNIFIED IDEOGRAPH
+0x9BF4 0x5E7A #CJK UNIFIED IDEOGRAPH
+0x9BF5 0x9EBC #CJK UNIFIED IDEOGRAPH
+0x9BF6 0x5E7F #CJK UNIFIED IDEOGRAPH
+0x9BF7 0x5EA0 #CJK UNIFIED IDEOGRAPH
+0x9BF8 0x5EC1 #CJK UNIFIED IDEOGRAPH
+0x9BF9 0x5EC2 #CJK UNIFIED IDEOGRAPH
+0x9BFA 0x5EC8 #CJK UNIFIED IDEOGRAPH
+0x9BFB 0x5ED0 #CJK UNIFIED IDEOGRAPH
+0x9BFC 0x5ECF #CJK UNIFIED IDEOGRAPH
+0x9C40 0x5ED6 #CJK UNIFIED IDEOGRAPH
+0x9C41 0x5EE3 #CJK UNIFIED IDEOGRAPH
+0x9C42 0x5EDD #CJK UNIFIED IDEOGRAPH
+0x9C43 0x5EDA #CJK UNIFIED IDEOGRAPH
+0x9C44 0x5EDB #CJK UNIFIED IDEOGRAPH
+0x9C45 0x5EE2 #CJK UNIFIED IDEOGRAPH
+0x9C46 0x5EE1 #CJK UNIFIED IDEOGRAPH
+0x9C47 0x5EE8 #CJK UNIFIED IDEOGRAPH
+0x9C48 0x5EE9 #CJK UNIFIED IDEOGRAPH
+0x9C49 0x5EEC #CJK UNIFIED IDEOGRAPH
+0x9C4A 0x5EF1 #CJK UNIFIED IDEOGRAPH
+0x9C4B 0x5EF3 #CJK UNIFIED IDEOGRAPH
+0x9C4C 0x5EF0 #CJK UNIFIED IDEOGRAPH
+0x9C4D 0x5EF4 #CJK UNIFIED IDEOGRAPH
+0x9C4E 0x5EF8 #CJK UNIFIED IDEOGRAPH
+0x9C4F 0x5EFE #CJK UNIFIED IDEOGRAPH
+0x9C50 0x5F03 #CJK UNIFIED IDEOGRAPH
+0x9C51 0x5F09 #CJK UNIFIED IDEOGRAPH
+0x9C52 0x5F5D #CJK UNIFIED IDEOGRAPH
+0x9C53 0x5F5C #CJK UNIFIED IDEOGRAPH
+0x9C54 0x5F0B #CJK UNIFIED IDEOGRAPH
+0x9C55 0x5F11 #CJK UNIFIED IDEOGRAPH
+0x9C56 0x5F16 #CJK UNIFIED IDEOGRAPH
+0x9C57 0x5F29 #CJK UNIFIED IDEOGRAPH
+0x9C58 0x5F2D #CJK UNIFIED IDEOGRAPH
+0x9C59 0x5F38 #CJK UNIFIED IDEOGRAPH
+0x9C5A 0x5F41 #CJK UNIFIED IDEOGRAPH
+0x9C5B 0x5F48 #CJK UNIFIED IDEOGRAPH
+0x9C5C 0x5F4C #CJK UNIFIED IDEOGRAPH
+0x9C5D 0x5F4E #CJK UNIFIED IDEOGRAPH
+0x9C5E 0x5F2F #CJK UNIFIED IDEOGRAPH
+0x9C5F 0x5F51 #CJK UNIFIED IDEOGRAPH
+0x9C60 0x5F56 #CJK UNIFIED IDEOGRAPH
+0x9C61 0x5F57 #CJK UNIFIED IDEOGRAPH
+0x9C62 0x5F59 #CJK UNIFIED IDEOGRAPH
+0x9C63 0x5F61 #CJK UNIFIED IDEOGRAPH
+0x9C64 0x5F6D #CJK UNIFIED IDEOGRAPH
+0x9C65 0x5F73 #CJK UNIFIED IDEOGRAPH
+0x9C66 0x5F77 #CJK UNIFIED IDEOGRAPH
+0x9C67 0x5F83 #CJK UNIFIED IDEOGRAPH
+0x9C68 0x5F82 #CJK UNIFIED IDEOGRAPH
+0x9C69 0x5F7F #CJK UNIFIED IDEOGRAPH
+0x9C6A 0x5F8A #CJK UNIFIED IDEOGRAPH
+0x9C6B 0x5F88 #CJK UNIFIED IDEOGRAPH
+0x9C6C 0x5F91 #CJK UNIFIED IDEOGRAPH
+0x9C6D 0x5F87 #CJK UNIFIED IDEOGRAPH
+0x9C6E 0x5F9E #CJK UNIFIED IDEOGRAPH
+0x9C6F 0x5F99 #CJK UNIFIED IDEOGRAPH
+0x9C70 0x5F98 #CJK UNIFIED IDEOGRAPH
+0x9C71 0x5FA0 #CJK UNIFIED IDEOGRAPH
+0x9C72 0x5FA8 #CJK UNIFIED IDEOGRAPH
+0x9C73 0x5FAD #CJK UNIFIED IDEOGRAPH
+0x9C74 0x5FBC #CJK UNIFIED IDEOGRAPH
+0x9C75 0x5FD6 #CJK UNIFIED IDEOGRAPH
+0x9C76 0x5FFB #CJK UNIFIED IDEOGRAPH
+0x9C77 0x5FE4 #CJK UNIFIED IDEOGRAPH
+0x9C78 0x5FF8 #CJK UNIFIED IDEOGRAPH
+0x9C79 0x5FF1 #CJK UNIFIED IDEOGRAPH
+0x9C7A 0x5FDD #CJK UNIFIED IDEOGRAPH
+0x9C7B 0x60B3 #CJK UNIFIED IDEOGRAPH
+0x9C7C 0x5FFF #CJK UNIFIED IDEOGRAPH
+0x9C7D 0x6021 #CJK UNIFIED IDEOGRAPH
+0x9C7E 0x6060 #CJK UNIFIED IDEOGRAPH
+0x9C80 0x6019 #CJK UNIFIED IDEOGRAPH
+0x9C81 0x6010 #CJK UNIFIED IDEOGRAPH
+0x9C82 0x6029 #CJK UNIFIED IDEOGRAPH
+0x9C83 0x600E #CJK UNIFIED IDEOGRAPH
+0x9C84 0x6031 #CJK UNIFIED IDEOGRAPH
+0x9C85 0x601B #CJK UNIFIED IDEOGRAPH
+0x9C86 0x6015 #CJK UNIFIED IDEOGRAPH
+0x9C87 0x602B #CJK UNIFIED IDEOGRAPH
+0x9C88 0x6026 #CJK UNIFIED IDEOGRAPH
+0x9C89 0x600F #CJK UNIFIED IDEOGRAPH
+0x9C8A 0x603A #CJK UNIFIED IDEOGRAPH
+0x9C8B 0x605A #CJK UNIFIED IDEOGRAPH
+0x9C8C 0x6041 #CJK UNIFIED IDEOGRAPH
+0x9C8D 0x606A #CJK UNIFIED IDEOGRAPH
+0x9C8E 0x6077 #CJK UNIFIED IDEOGRAPH
+0x9C8F 0x605F #CJK UNIFIED IDEOGRAPH
+0x9C90 0x604A #CJK UNIFIED IDEOGRAPH
+0x9C91 0x6046 #CJK UNIFIED IDEOGRAPH
+0x9C92 0x604D #CJK UNIFIED IDEOGRAPH
+0x9C93 0x6063 #CJK UNIFIED IDEOGRAPH
+0x9C94 0x6043 #CJK UNIFIED IDEOGRAPH
+0x9C95 0x6064 #CJK UNIFIED IDEOGRAPH
+0x9C96 0x6042 #CJK UNIFIED IDEOGRAPH
+0x9C97 0x606C #CJK UNIFIED IDEOGRAPH
+0x9C98 0x606B #CJK UNIFIED IDEOGRAPH
+0x9C99 0x6059 #CJK UNIFIED IDEOGRAPH
+0x9C9A 0x6081 #CJK UNIFIED IDEOGRAPH
+0x9C9B 0x608D #CJK UNIFIED IDEOGRAPH
+0x9C9C 0x60E7 #CJK UNIFIED IDEOGRAPH
+0x9C9D 0x6083 #CJK UNIFIED IDEOGRAPH
+0x9C9E 0x609A #CJK UNIFIED IDEOGRAPH
+0x9C9F 0x6084 #CJK UNIFIED IDEOGRAPH
+0x9CA0 0x609B #CJK UNIFIED IDEOGRAPH
+0x9CA1 0x6096 #CJK UNIFIED IDEOGRAPH
+0x9CA2 0x6097 #CJK UNIFIED IDEOGRAPH
+0x9CA3 0x6092 #CJK UNIFIED IDEOGRAPH
+0x9CA4 0x60A7 #CJK UNIFIED IDEOGRAPH
+0x9CA5 0x608B #CJK UNIFIED IDEOGRAPH
+0x9CA6 0x60E1 #CJK UNIFIED IDEOGRAPH
+0x9CA7 0x60B8 #CJK UNIFIED IDEOGRAPH
+0x9CA8 0x60E0 #CJK UNIFIED IDEOGRAPH
+0x9CA9 0x60D3 #CJK UNIFIED IDEOGRAPH
+0x9CAA 0x60B4 #CJK UNIFIED IDEOGRAPH
+0x9CAB 0x5FF0 #CJK UNIFIED IDEOGRAPH
+0x9CAC 0x60BD #CJK UNIFIED IDEOGRAPH
+0x9CAD 0x60C6 #CJK UNIFIED IDEOGRAPH
+0x9CAE 0x60B5 #CJK UNIFIED IDEOGRAPH
+0x9CAF 0x60D8 #CJK UNIFIED IDEOGRAPH
+0x9CB0 0x614D #CJK UNIFIED IDEOGRAPH
+0x9CB1 0x6115 #CJK UNIFIED IDEOGRAPH
+0x9CB2 0x6106 #CJK UNIFIED IDEOGRAPH
+0x9CB3 0x60F6 #CJK UNIFIED IDEOGRAPH
+0x9CB4 0x60F7 #CJK UNIFIED IDEOGRAPH
+0x9CB5 0x6100 #CJK UNIFIED IDEOGRAPH
+0x9CB6 0x60F4 #CJK UNIFIED IDEOGRAPH
+0x9CB7 0x60FA #CJK UNIFIED IDEOGRAPH
+0x9CB8 0x6103 #CJK UNIFIED IDEOGRAPH
+0x9CB9 0x6121 #CJK UNIFIED IDEOGRAPH
+0x9CBA 0x60FB #CJK UNIFIED IDEOGRAPH
+0x9CBB 0x60F1 #CJK UNIFIED IDEOGRAPH
+0x9CBC 0x610D #CJK UNIFIED IDEOGRAPH
+0x9CBD 0x610E #CJK UNIFIED IDEOGRAPH
+0x9CBE 0x6147 #CJK UNIFIED IDEOGRAPH
+0x9CBF 0x613E #CJK UNIFIED IDEOGRAPH
+0x9CC0 0x6128 #CJK UNIFIED IDEOGRAPH
+0x9CC1 0x6127 #CJK UNIFIED IDEOGRAPH
+0x9CC2 0x614A #CJK UNIFIED IDEOGRAPH
+0x9CC3 0x613F #CJK UNIFIED IDEOGRAPH
+0x9CC4 0x613C #CJK UNIFIED IDEOGRAPH
+0x9CC5 0x612C #CJK UNIFIED IDEOGRAPH
+0x9CC6 0x6134 #CJK UNIFIED IDEOGRAPH
+0x9CC7 0x613D #CJK UNIFIED IDEOGRAPH
+0x9CC8 0x6142 #CJK UNIFIED IDEOGRAPH
+0x9CC9 0x6144 #CJK UNIFIED IDEOGRAPH
+0x9CCA 0x6173 #CJK UNIFIED IDEOGRAPH
+0x9CCB 0x6177 #CJK UNIFIED IDEOGRAPH
+0x9CCC 0x6158 #CJK UNIFIED IDEOGRAPH
+0x9CCD 0x6159 #CJK UNIFIED IDEOGRAPH
+0x9CCE 0x615A #CJK UNIFIED IDEOGRAPH
+0x9CCF 0x616B #CJK UNIFIED IDEOGRAPH
+0x9CD0 0x6174 #CJK UNIFIED IDEOGRAPH
+0x9CD1 0x616F #CJK UNIFIED IDEOGRAPH
+0x9CD2 0x6165 #CJK UNIFIED IDEOGRAPH
+0x9CD3 0x6171 #CJK UNIFIED IDEOGRAPH
+0x9CD4 0x615F #CJK UNIFIED IDEOGRAPH
+0x9CD5 0x615D #CJK UNIFIED IDEOGRAPH
+0x9CD6 0x6153 #CJK UNIFIED IDEOGRAPH
+0x9CD7 0x6175 #CJK UNIFIED IDEOGRAPH
+0x9CD8 0x6199 #CJK UNIFIED IDEOGRAPH
+0x9CD9 0x6196 #CJK UNIFIED IDEOGRAPH
+0x9CDA 0x6187 #CJK UNIFIED IDEOGRAPH
+0x9CDB 0x61AC #CJK UNIFIED IDEOGRAPH
+0x9CDC 0x6194 #CJK UNIFIED IDEOGRAPH
+0x9CDD 0x619A #CJK UNIFIED IDEOGRAPH
+0x9CDE 0x618A #CJK UNIFIED IDEOGRAPH
+0x9CDF 0x6191 #CJK UNIFIED IDEOGRAPH
+0x9CE0 0x61AB #CJK UNIFIED IDEOGRAPH
+0x9CE1 0x61AE #CJK UNIFIED IDEOGRAPH
+0x9CE2 0x61CC #CJK UNIFIED IDEOGRAPH
+0x9CE3 0x61CA #CJK UNIFIED IDEOGRAPH
+0x9CE4 0x61C9 #CJK UNIFIED IDEOGRAPH
+0x9CE5 0x61F7 #CJK UNIFIED IDEOGRAPH
+0x9CE6 0x61C8 #CJK UNIFIED IDEOGRAPH
+0x9CE7 0x61C3 #CJK UNIFIED IDEOGRAPH
+0x9CE8 0x61C6 #CJK UNIFIED IDEOGRAPH
+0x9CE9 0x61BA #CJK UNIFIED IDEOGRAPH
+0x9CEA 0x61CB #CJK UNIFIED IDEOGRAPH
+0x9CEB 0x7F79 #CJK UNIFIED IDEOGRAPH
+0x9CEC 0x61CD #CJK UNIFIED IDEOGRAPH
+0x9CED 0x61E6 #CJK UNIFIED IDEOGRAPH
+0x9CEE 0x61E3 #CJK UNIFIED IDEOGRAPH
+0x9CEF 0x61F6 #CJK UNIFIED IDEOGRAPH
+0x9CF0 0x61FA #CJK UNIFIED IDEOGRAPH
+0x9CF1 0x61F4 #CJK UNIFIED IDEOGRAPH
+0x9CF2 0x61FF #CJK UNIFIED IDEOGRAPH
+0x9CF3 0x61FD #CJK UNIFIED IDEOGRAPH
+0x9CF4 0x61FC #CJK UNIFIED IDEOGRAPH
+0x9CF5 0x61FE #CJK UNIFIED IDEOGRAPH
+0x9CF6 0x6200 #CJK UNIFIED IDEOGRAPH
+0x9CF7 0x6208 #CJK UNIFIED IDEOGRAPH
+0x9CF8 0x6209 #CJK UNIFIED IDEOGRAPH
+0x9CF9 0x620D #CJK UNIFIED IDEOGRAPH
+0x9CFA 0x620C #CJK UNIFIED IDEOGRAPH
+0x9CFB 0x6214 #CJK UNIFIED IDEOGRAPH
+0x9CFC 0x621B #CJK UNIFIED IDEOGRAPH
+0x9D40 0x621E #CJK UNIFIED IDEOGRAPH
+0x9D41 0x6221 #CJK UNIFIED IDEOGRAPH
+0x9D42 0x622A #CJK UNIFIED IDEOGRAPH
+0x9D43 0x622E #CJK UNIFIED IDEOGRAPH
+0x9D44 0x6230 #CJK UNIFIED IDEOGRAPH
+0x9D45 0x6232 #CJK UNIFIED IDEOGRAPH
+0x9D46 0x6233 #CJK UNIFIED IDEOGRAPH
+0x9D47 0x6241 #CJK UNIFIED IDEOGRAPH
+0x9D48 0x624E #CJK UNIFIED IDEOGRAPH
+0x9D49 0x625E #CJK UNIFIED IDEOGRAPH
+0x9D4A 0x6263 #CJK UNIFIED IDEOGRAPH
+0x9D4B 0x625B #CJK UNIFIED IDEOGRAPH
+0x9D4C 0x6260 #CJK UNIFIED IDEOGRAPH
+0x9D4D 0x6268 #CJK UNIFIED IDEOGRAPH
+0x9D4E 0x627C #CJK UNIFIED IDEOGRAPH
+0x9D4F 0x6282 #CJK UNIFIED IDEOGRAPH
+0x9D50 0x6289 #CJK UNIFIED IDEOGRAPH
+0x9D51 0x627E #CJK UNIFIED IDEOGRAPH
+0x9D52 0x6292 #CJK UNIFIED IDEOGRAPH
+0x9D53 0x6293 #CJK UNIFIED IDEOGRAPH
+0x9D54 0x6296 #CJK UNIFIED IDEOGRAPH
+0x9D55 0x62D4 #CJK UNIFIED IDEOGRAPH
+0x9D56 0x6283 #CJK UNIFIED IDEOGRAPH
+0x9D57 0x6294 #CJK UNIFIED IDEOGRAPH
+0x9D58 0x62D7 #CJK UNIFIED IDEOGRAPH
+0x9D59 0x62D1 #CJK UNIFIED IDEOGRAPH
+0x9D5A 0x62BB #CJK UNIFIED IDEOGRAPH
+0x9D5B 0x62CF #CJK UNIFIED IDEOGRAPH
+0x9D5C 0x62FF #CJK UNIFIED IDEOGRAPH
+0x9D5D 0x62C6 #CJK UNIFIED IDEOGRAPH
+0x9D5E 0x64D4 #CJK UNIFIED IDEOGRAPH
+0x9D5F 0x62C8 #CJK UNIFIED IDEOGRAPH
+0x9D60 0x62DC #CJK UNIFIED IDEOGRAPH
+0x9D61 0x62CC #CJK UNIFIED IDEOGRAPH
+0x9D62 0x62CA #CJK UNIFIED IDEOGRAPH
+0x9D63 0x62C2 #CJK UNIFIED IDEOGRAPH
+0x9D64 0x62C7 #CJK UNIFIED IDEOGRAPH
+0x9D65 0x629B #CJK UNIFIED IDEOGRAPH
+0x9D66 0x62C9 #CJK UNIFIED IDEOGRAPH
+0x9D67 0x630C #CJK UNIFIED IDEOGRAPH
+0x9D68 0x62EE #CJK UNIFIED IDEOGRAPH
+0x9D69 0x62F1 #CJK UNIFIED IDEOGRAPH
+0x9D6A 0x6327 #CJK UNIFIED IDEOGRAPH
+0x9D6B 0x6302 #CJK UNIFIED IDEOGRAPH
+0x9D6C 0x6308 #CJK UNIFIED IDEOGRAPH
+0x9D6D 0x62EF #CJK UNIFIED IDEOGRAPH
+0x9D6E 0x62F5 #CJK UNIFIED IDEOGRAPH
+0x9D6F 0x6350 #CJK UNIFIED IDEOGRAPH
+0x9D70 0x633E #CJK UNIFIED IDEOGRAPH
+0x9D71 0x634D #CJK UNIFIED IDEOGRAPH
+0x9D72 0x641C #CJK UNIFIED IDEOGRAPH
+0x9D73 0x634F #CJK UNIFIED IDEOGRAPH
+0x9D74 0x6396 #CJK UNIFIED IDEOGRAPH
+0x9D75 0x638E #CJK UNIFIED IDEOGRAPH
+0x9D76 0x6380 #CJK UNIFIED IDEOGRAPH
+0x9D77 0x63AB #CJK UNIFIED IDEOGRAPH
+0x9D78 0x6376 #CJK UNIFIED IDEOGRAPH
+0x9D79 0x63A3 #CJK UNIFIED IDEOGRAPH
+0x9D7A 0x638F #CJK UNIFIED IDEOGRAPH
+0x9D7B 0x6389 #CJK UNIFIED IDEOGRAPH
+0x9D7C 0x639F #CJK UNIFIED IDEOGRAPH
+0x9D7D 0x63B5 #CJK UNIFIED IDEOGRAPH
+0x9D7E 0x636B #CJK UNIFIED IDEOGRAPH
+0x9D80 0x6369 #CJK UNIFIED IDEOGRAPH
+0x9D81 0x63BE #CJK UNIFIED IDEOGRAPH
+0x9D82 0x63E9 #CJK UNIFIED IDEOGRAPH
+0x9D83 0x63C0 #CJK UNIFIED IDEOGRAPH
+0x9D84 0x63C6 #CJK UNIFIED IDEOGRAPH
+0x9D85 0x63E3 #CJK UNIFIED IDEOGRAPH
+0x9D86 0x63C9 #CJK UNIFIED IDEOGRAPH
+0x9D87 0x63D2 #CJK UNIFIED IDEOGRAPH
+0x9D88 0x63F6 #CJK UNIFIED IDEOGRAPH
+0x9D89 0x63C4 #CJK UNIFIED IDEOGRAPH
+0x9D8A 0x6416 #CJK UNIFIED IDEOGRAPH
+0x9D8B 0x6434 #CJK UNIFIED IDEOGRAPH
+0x9D8C 0x6406 #CJK UNIFIED IDEOGRAPH
+0x9D8D 0x6413 #CJK UNIFIED IDEOGRAPH
+0x9D8E 0x6426 #CJK UNIFIED IDEOGRAPH
+0x9D8F 0x6436 #CJK UNIFIED IDEOGRAPH
+0x9D90 0x651D #CJK UNIFIED IDEOGRAPH
+0x9D91 0x6417 #CJK UNIFIED IDEOGRAPH
+0x9D92 0x6428 #CJK UNIFIED IDEOGRAPH
+0x9D93 0x640F #CJK UNIFIED IDEOGRAPH
+0x9D94 0x6467 #CJK UNIFIED IDEOGRAPH
+0x9D95 0x646F #CJK UNIFIED IDEOGRAPH
+0x9D96 0x6476 #CJK UNIFIED IDEOGRAPH
+0x9D97 0x644E #CJK UNIFIED IDEOGRAPH
+0x9D98 0x652A #CJK UNIFIED IDEOGRAPH
+0x9D99 0x6495 #CJK UNIFIED IDEOGRAPH
+0x9D9A 0x6493 #CJK UNIFIED IDEOGRAPH
+0x9D9B 0x64A5 #CJK UNIFIED IDEOGRAPH
+0x9D9C 0x64A9 #CJK UNIFIED IDEOGRAPH
+0x9D9D 0x6488 #CJK UNIFIED IDEOGRAPH
+0x9D9E 0x64BC #CJK UNIFIED IDEOGRAPH
+0x9D9F 0x64DA #CJK UNIFIED IDEOGRAPH
+0x9DA0 0x64D2 #CJK UNIFIED IDEOGRAPH
+0x9DA1 0x64C5 #CJK UNIFIED IDEOGRAPH
+0x9DA2 0x64C7 #CJK UNIFIED IDEOGRAPH
+0x9DA3 0x64BB #CJK UNIFIED IDEOGRAPH
+0x9DA4 0x64D8 #CJK UNIFIED IDEOGRAPH
+0x9DA5 0x64C2 #CJK UNIFIED IDEOGRAPH
+0x9DA6 0x64F1 #CJK UNIFIED IDEOGRAPH
+0x9DA7 0x64E7 #CJK UNIFIED IDEOGRAPH
+0x9DA8 0x8209 #CJK UNIFIED IDEOGRAPH
+0x9DA9 0x64E0 #CJK UNIFIED IDEOGRAPH
+0x9DAA 0x64E1 #CJK UNIFIED IDEOGRAPH
+0x9DAB 0x62AC #CJK UNIFIED IDEOGRAPH
+0x9DAC 0x64E3 #CJK UNIFIED IDEOGRAPH
+0x9DAD 0x64EF #CJK UNIFIED IDEOGRAPH
+0x9DAE 0x652C #CJK UNIFIED IDEOGRAPH
+0x9DAF 0x64F6 #CJK UNIFIED IDEOGRAPH
+0x9DB0 0x64F4 #CJK UNIFIED IDEOGRAPH
+0x9DB1 0x64F2 #CJK UNIFIED IDEOGRAPH
+0x9DB2 0x64FA #CJK UNIFIED IDEOGRAPH
+0x9DB3 0x6500 #CJK UNIFIED IDEOGRAPH
+0x9DB4 0x64FD #CJK UNIFIED IDEOGRAPH
+0x9DB5 0x6518 #CJK UNIFIED IDEOGRAPH
+0x9DB6 0x651C #CJK UNIFIED IDEOGRAPH
+0x9DB7 0x6505 #CJK UNIFIED IDEOGRAPH
+0x9DB8 0x6524 #CJK UNIFIED IDEOGRAPH
+0x9DB9 0x6523 #CJK UNIFIED IDEOGRAPH
+0x9DBA 0x652B #CJK UNIFIED IDEOGRAPH
+0x9DBB 0x6534 #CJK UNIFIED IDEOGRAPH
+0x9DBC 0x6535 #CJK UNIFIED IDEOGRAPH
+0x9DBD 0x6537 #CJK UNIFIED IDEOGRAPH
+0x9DBE 0x6536 #CJK UNIFIED IDEOGRAPH
+0x9DBF 0x6538 #CJK UNIFIED IDEOGRAPH
+0x9DC0 0x754B #CJK UNIFIED IDEOGRAPH
+0x9DC1 0x6548 #CJK UNIFIED IDEOGRAPH
+0x9DC2 0x6556 #CJK UNIFIED IDEOGRAPH
+0x9DC3 0x6555 #CJK UNIFIED IDEOGRAPH
+0x9DC4 0x654D #CJK UNIFIED IDEOGRAPH
+0x9DC5 0x6558 #CJK UNIFIED IDEOGRAPH
+0x9DC6 0x655E #CJK UNIFIED IDEOGRAPH
+0x9DC7 0x655D #CJK UNIFIED IDEOGRAPH
+0x9DC8 0x6572 #CJK UNIFIED IDEOGRAPH
+0x9DC9 0x6578 #CJK UNIFIED IDEOGRAPH
+0x9DCA 0x6582 #CJK UNIFIED IDEOGRAPH
+0x9DCB 0x6583 #CJK UNIFIED IDEOGRAPH
+0x9DCC 0x8B8A #CJK UNIFIED IDEOGRAPH
+0x9DCD 0x659B #CJK UNIFIED IDEOGRAPH
+0x9DCE 0x659F #CJK UNIFIED IDEOGRAPH
+0x9DCF 0x65AB #CJK UNIFIED IDEOGRAPH
+0x9DD0 0x65B7 #CJK UNIFIED IDEOGRAPH
+0x9DD1 0x65C3 #CJK UNIFIED IDEOGRAPH
+0x9DD2 0x65C6 #CJK UNIFIED IDEOGRAPH
+0x9DD3 0x65C1 #CJK UNIFIED IDEOGRAPH
+0x9DD4 0x65C4 #CJK UNIFIED IDEOGRAPH
+0x9DD5 0x65CC #CJK UNIFIED IDEOGRAPH
+0x9DD6 0x65D2 #CJK UNIFIED IDEOGRAPH
+0x9DD7 0x65DB #CJK UNIFIED IDEOGRAPH
+0x9DD8 0x65D9 #CJK UNIFIED IDEOGRAPH
+0x9DD9 0x65E0 #CJK UNIFIED IDEOGRAPH
+0x9DDA 0x65E1 #CJK UNIFIED IDEOGRAPH
+0x9DDB 0x65F1 #CJK UNIFIED IDEOGRAPH
+0x9DDC 0x6772 #CJK UNIFIED IDEOGRAPH
+0x9DDD 0x660A #CJK UNIFIED IDEOGRAPH
+0x9DDE 0x6603 #CJK UNIFIED IDEOGRAPH
+0x9DDF 0x65FB #CJK UNIFIED IDEOGRAPH
+0x9DE0 0x6773 #CJK UNIFIED IDEOGRAPH
+0x9DE1 0x6635 #CJK UNIFIED IDEOGRAPH
+0x9DE2 0x6636 #CJK UNIFIED IDEOGRAPH
+0x9DE3 0x6634 #CJK UNIFIED IDEOGRAPH
+0x9DE4 0x661C #CJK UNIFIED IDEOGRAPH
+0x9DE5 0x664F #CJK UNIFIED IDEOGRAPH
+0x9DE6 0x6644 #CJK UNIFIED IDEOGRAPH
+0x9DE7 0x6649 #CJK UNIFIED IDEOGRAPH
+0x9DE8 0x6641 #CJK UNIFIED IDEOGRAPH
+0x9DE9 0x665E #CJK UNIFIED IDEOGRAPH
+0x9DEA 0x665D #CJK UNIFIED IDEOGRAPH
+0x9DEB 0x6664 #CJK UNIFIED IDEOGRAPH
+0x9DEC 0x6667 #CJK UNIFIED IDEOGRAPH
+0x9DED 0x6668 #CJK UNIFIED IDEOGRAPH
+0x9DEE 0x665F #CJK UNIFIED IDEOGRAPH
+0x9DEF 0x6662 #CJK UNIFIED IDEOGRAPH
+0x9DF0 0x6670 #CJK UNIFIED IDEOGRAPH
+0x9DF1 0x6683 #CJK UNIFIED IDEOGRAPH
+0x9DF2 0x6688 #CJK UNIFIED IDEOGRAPH
+0x9DF3 0x668E #CJK UNIFIED IDEOGRAPH
+0x9DF4 0x6689 #CJK UNIFIED IDEOGRAPH
+0x9DF5 0x6684 #CJK UNIFIED IDEOGRAPH
+0x9DF6 0x6698 #CJK UNIFIED IDEOGRAPH
+0x9DF7 0x669D #CJK UNIFIED IDEOGRAPH
+0x9DF8 0x66C1 #CJK UNIFIED IDEOGRAPH
+0x9DF9 0x66B9 #CJK UNIFIED IDEOGRAPH
+0x9DFA 0x66C9 #CJK UNIFIED IDEOGRAPH
+0x9DFB 0x66BE #CJK UNIFIED IDEOGRAPH
+0x9DFC 0x66BC #CJK UNIFIED IDEOGRAPH
+0x9E40 0x66C4 #CJK UNIFIED IDEOGRAPH
+0x9E41 0x66B8 #CJK UNIFIED IDEOGRAPH
+0x9E42 0x66D6 #CJK UNIFIED IDEOGRAPH
+0x9E43 0x66DA #CJK UNIFIED IDEOGRAPH
+0x9E44 0x66E0 #CJK UNIFIED IDEOGRAPH
+0x9E45 0x663F #CJK UNIFIED IDEOGRAPH
+0x9E46 0x66E6 #CJK UNIFIED IDEOGRAPH
+0x9E47 0x66E9 #CJK UNIFIED IDEOGRAPH
+0x9E48 0x66F0 #CJK UNIFIED IDEOGRAPH
+0x9E49 0x66F5 #CJK UNIFIED IDEOGRAPH
+0x9E4A 0x66F7 #CJK UNIFIED IDEOGRAPH
+0x9E4B 0x670F #CJK UNIFIED IDEOGRAPH
+0x9E4C 0x6716 #CJK UNIFIED IDEOGRAPH
+0x9E4D 0x671E #CJK UNIFIED IDEOGRAPH
+0x9E4E 0x6726 #CJK UNIFIED IDEOGRAPH
+0x9E4F 0x6727 #CJK UNIFIED IDEOGRAPH
+0x9E50 0x9738 #CJK UNIFIED IDEOGRAPH
+0x9E51 0x672E #CJK UNIFIED IDEOGRAPH
+0x9E52 0x673F #CJK UNIFIED IDEOGRAPH
+0x9E53 0x6736 #CJK UNIFIED IDEOGRAPH
+0x9E54 0x6741 #CJK UNIFIED IDEOGRAPH
+0x9E55 0x6738 #CJK UNIFIED IDEOGRAPH
+0x9E56 0x6737 #CJK UNIFIED IDEOGRAPH
+0x9E57 0x6746 #CJK UNIFIED IDEOGRAPH
+0x9E58 0x675E #CJK UNIFIED IDEOGRAPH
+0x9E59 0x6760 #CJK UNIFIED IDEOGRAPH
+0x9E5A 0x6759 #CJK UNIFIED IDEOGRAPH
+0x9E5B 0x6763 #CJK UNIFIED IDEOGRAPH
+0x9E5C 0x6764 #CJK UNIFIED IDEOGRAPH
+0x9E5D 0x6789 #CJK UNIFIED IDEOGRAPH
+0x9E5E 0x6770 #CJK UNIFIED IDEOGRAPH
+0x9E5F 0x67A9 #CJK UNIFIED IDEOGRAPH
+0x9E60 0x677C #CJK UNIFIED IDEOGRAPH
+0x9E61 0x676A #CJK UNIFIED IDEOGRAPH
+0x9E62 0x678C #CJK UNIFIED IDEOGRAPH
+0x9E63 0x678B #CJK UNIFIED IDEOGRAPH
+0x9E64 0x67A6 #CJK UNIFIED IDEOGRAPH
+0x9E65 0x67A1 #CJK UNIFIED IDEOGRAPH
+0x9E66 0x6785 #CJK UNIFIED IDEOGRAPH
+0x9E67 0x67B7 #CJK UNIFIED IDEOGRAPH
+0x9E68 0x67EF #CJK UNIFIED IDEOGRAPH
+0x9E69 0x67B4 #CJK UNIFIED IDEOGRAPH
+0x9E6A 0x67EC #CJK UNIFIED IDEOGRAPH
+0x9E6B 0x67B3 #CJK UNIFIED IDEOGRAPH
+0x9E6C 0x67E9 #CJK UNIFIED IDEOGRAPH
+0x9E6D 0x67B8 #CJK UNIFIED IDEOGRAPH
+0x9E6E 0x67E4 #CJK UNIFIED IDEOGRAPH
+0x9E6F 0x67DE #CJK UNIFIED IDEOGRAPH
+0x9E70 0x67DD #CJK UNIFIED IDEOGRAPH
+0x9E71 0x67E2 #CJK UNIFIED IDEOGRAPH
+0x9E72 0x67EE #CJK UNIFIED IDEOGRAPH
+0x9E73 0x67B9 #CJK UNIFIED IDEOGRAPH
+0x9E74 0x67CE #CJK UNIFIED IDEOGRAPH
+0x9E75 0x67C6 #CJK UNIFIED IDEOGRAPH
+0x9E76 0x67E7 #CJK UNIFIED IDEOGRAPH
+0x9E77 0x6A9C #CJK UNIFIED IDEOGRAPH
+0x9E78 0x681E #CJK UNIFIED IDEOGRAPH
+0x9E79 0x6846 #CJK UNIFIED IDEOGRAPH
+0x9E7A 0x6829 #CJK UNIFIED IDEOGRAPH
+0x9E7B 0x6840 #CJK UNIFIED IDEOGRAPH
+0x9E7C 0x684D #CJK UNIFIED IDEOGRAPH
+0x9E7D 0x6832 #CJK UNIFIED IDEOGRAPH
+0x9E7E 0x684E #CJK UNIFIED IDEOGRAPH
+0x9E80 0x68B3 #CJK UNIFIED IDEOGRAPH
+0x9E81 0x682B #CJK UNIFIED IDEOGRAPH
+0x9E82 0x6859 #CJK UNIFIED IDEOGRAPH
+0x9E83 0x6863 #CJK UNIFIED IDEOGRAPH
+0x9E84 0x6877 #CJK UNIFIED IDEOGRAPH
+0x9E85 0x687F #CJK UNIFIED IDEOGRAPH
+0x9E86 0x689F #CJK UNIFIED IDEOGRAPH
+0x9E87 0x688F #CJK UNIFIED IDEOGRAPH
+0x9E88 0x68AD #CJK UNIFIED IDEOGRAPH
+0x9E89 0x6894 #CJK UNIFIED IDEOGRAPH
+0x9E8A 0x689D #CJK UNIFIED IDEOGRAPH
+0x9E8B 0x689B #CJK UNIFIED IDEOGRAPH
+0x9E8C 0x6883 #CJK UNIFIED IDEOGRAPH
+0x9E8D 0x6AAE #CJK UNIFIED IDEOGRAPH
+0x9E8E 0x68B9 #CJK UNIFIED IDEOGRAPH
+0x9E8F 0x6874 #CJK UNIFIED IDEOGRAPH
+0x9E90 0x68B5 #CJK UNIFIED IDEOGRAPH
+0x9E91 0x68A0 #CJK UNIFIED IDEOGRAPH
+0x9E92 0x68BA #CJK UNIFIED IDEOGRAPH
+0x9E93 0x690F #CJK UNIFIED IDEOGRAPH
+0x9E94 0x688D #CJK UNIFIED IDEOGRAPH
+0x9E95 0x687E #CJK UNIFIED IDEOGRAPH
+0x9E96 0x6901 #CJK UNIFIED IDEOGRAPH
+0x9E97 0x68CA #CJK UNIFIED IDEOGRAPH
+0x9E98 0x6908 #CJK UNIFIED IDEOGRAPH
+0x9E99 0x68D8 #CJK UNIFIED IDEOGRAPH
+0x9E9A 0x6922 #CJK UNIFIED IDEOGRAPH
+0x9E9B 0x6926 #CJK UNIFIED IDEOGRAPH
+0x9E9C 0x68E1 #CJK UNIFIED IDEOGRAPH
+0x9E9D 0x690C #CJK UNIFIED IDEOGRAPH
+0x9E9E 0x68CD #CJK UNIFIED IDEOGRAPH
+0x9E9F 0x68D4 #CJK UNIFIED IDEOGRAPH
+0x9EA0 0x68E7 #CJK UNIFIED IDEOGRAPH
+0x9EA1 0x68D5 #CJK UNIFIED IDEOGRAPH
+0x9EA2 0x6936 #CJK UNIFIED IDEOGRAPH
+0x9EA3 0x6912 #CJK UNIFIED IDEOGRAPH
+0x9EA4 0x6904 #CJK UNIFIED IDEOGRAPH
+0x9EA5 0x68D7 #CJK UNIFIED IDEOGRAPH
+0x9EA6 0x68E3 #CJK UNIFIED IDEOGRAPH
+0x9EA7 0x6925 #CJK UNIFIED IDEOGRAPH
+0x9EA8 0x68F9 #CJK UNIFIED IDEOGRAPH
+0x9EA9 0x68E0 #CJK UNIFIED IDEOGRAPH
+0x9EAA 0x68EF #CJK UNIFIED IDEOGRAPH
+0x9EAB 0x6928 #CJK UNIFIED IDEOGRAPH
+0x9EAC 0x692A #CJK UNIFIED IDEOGRAPH
+0x9EAD 0x691A #CJK UNIFIED IDEOGRAPH
+0x9EAE 0x6923 #CJK UNIFIED IDEOGRAPH
+0x9EAF 0x6921 #CJK UNIFIED IDEOGRAPH
+0x9EB0 0x68C6 #CJK UNIFIED IDEOGRAPH
+0x9EB1 0x6979 #CJK UNIFIED IDEOGRAPH
+0x9EB2 0x6977 #CJK UNIFIED IDEOGRAPH
+0x9EB3 0x695C #CJK UNIFIED IDEOGRAPH
+0x9EB4 0x6978 #CJK UNIFIED IDEOGRAPH
+0x9EB5 0x696B #CJK UNIFIED IDEOGRAPH
+0x9EB6 0x6954 #CJK UNIFIED IDEOGRAPH
+0x9EB7 0x697E #CJK UNIFIED IDEOGRAPH
+0x9EB8 0x696E #CJK UNIFIED IDEOGRAPH
+0x9EB9 0x6939 #CJK UNIFIED IDEOGRAPH
+0x9EBA 0x6974 #CJK UNIFIED IDEOGRAPH
+0x9EBB 0x693D #CJK UNIFIED IDEOGRAPH
+0x9EBC 0x6959 #CJK UNIFIED IDEOGRAPH
+0x9EBD 0x6930 #CJK UNIFIED IDEOGRAPH
+0x9EBE 0x6961 #CJK UNIFIED IDEOGRAPH
+0x9EBF 0x695E #CJK UNIFIED IDEOGRAPH
+0x9EC0 0x695D #CJK UNIFIED IDEOGRAPH
+0x9EC1 0x6981 #CJK UNIFIED IDEOGRAPH
+0x9EC2 0x696A #CJK UNIFIED IDEOGRAPH
+0x9EC3 0x69B2 #CJK UNIFIED IDEOGRAPH
+0x9EC4 0x69AE #CJK UNIFIED IDEOGRAPH
+0x9EC5 0x69D0 #CJK UNIFIED IDEOGRAPH
+0x9EC6 0x69BF #CJK UNIFIED IDEOGRAPH
+0x9EC7 0x69C1 #CJK UNIFIED IDEOGRAPH
+0x9EC8 0x69D3 #CJK UNIFIED IDEOGRAPH
+0x9EC9 0x69BE #CJK UNIFIED IDEOGRAPH
+0x9ECA 0x69CE #CJK UNIFIED IDEOGRAPH
+0x9ECB 0x5BE8 #CJK UNIFIED IDEOGRAPH
+0x9ECC 0x69CA #CJK UNIFIED IDEOGRAPH
+0x9ECD 0x69DD #CJK UNIFIED IDEOGRAPH
+0x9ECE 0x69BB #CJK UNIFIED IDEOGRAPH
+0x9ECF 0x69C3 #CJK UNIFIED IDEOGRAPH
+0x9ED0 0x69A7 #CJK UNIFIED IDEOGRAPH
+0x9ED1 0x6A2E #CJK UNIFIED IDEOGRAPH
+0x9ED2 0x6991 #CJK UNIFIED IDEOGRAPH
+0x9ED3 0x69A0 #CJK UNIFIED IDEOGRAPH
+0x9ED4 0x699C #CJK UNIFIED IDEOGRAPH
+0x9ED5 0x6995 #CJK UNIFIED IDEOGRAPH
+0x9ED6 0x69B4 #CJK UNIFIED IDEOGRAPH
+0x9ED7 0x69DE #CJK UNIFIED IDEOGRAPH
+0x9ED8 0x69E8 #CJK UNIFIED IDEOGRAPH
+0x9ED9 0x6A02 #CJK UNIFIED IDEOGRAPH
+0x9EDA 0x6A1B #CJK UNIFIED IDEOGRAPH
+0x9EDB 0x69FF #CJK UNIFIED IDEOGRAPH
+0x9EDC 0x6B0A #CJK UNIFIED IDEOGRAPH
+0x9EDD 0x69F9 #CJK UNIFIED IDEOGRAPH
+0x9EDE 0x69F2 #CJK UNIFIED IDEOGRAPH
+0x9EDF 0x69E7 #CJK UNIFIED IDEOGRAPH
+0x9EE0 0x6A05 #CJK UNIFIED IDEOGRAPH
+0x9EE1 0x69B1 #CJK UNIFIED IDEOGRAPH
+0x9EE2 0x6A1E #CJK UNIFIED IDEOGRAPH
+0x9EE3 0x69ED #CJK UNIFIED IDEOGRAPH
+0x9EE4 0x6A14 #CJK UNIFIED IDEOGRAPH
+0x9EE5 0x69EB #CJK UNIFIED IDEOGRAPH
+0x9EE6 0x6A0A #CJK UNIFIED IDEOGRAPH
+0x9EE7 0x6A12 #CJK UNIFIED IDEOGRAPH
+0x9EE8 0x6AC1 #CJK UNIFIED IDEOGRAPH
+0x9EE9 0x6A23 #CJK UNIFIED IDEOGRAPH
+0x9EEA 0x6A13 #CJK UNIFIED IDEOGRAPH
+0x9EEB 0x6A44 #CJK UNIFIED IDEOGRAPH
+0x9EEC 0x6A0C #CJK UNIFIED IDEOGRAPH
+0x9EED 0x6A72 #CJK UNIFIED IDEOGRAPH
+0x9EEE 0x6A36 #CJK UNIFIED IDEOGRAPH
+0x9EEF 0x6A78 #CJK UNIFIED IDEOGRAPH
+0x9EF0 0x6A47 #CJK UNIFIED IDEOGRAPH
+0x9EF1 0x6A62 #CJK UNIFIED IDEOGRAPH
+0x9EF2 0x6A59 #CJK UNIFIED IDEOGRAPH
+0x9EF3 0x6A66 #CJK UNIFIED IDEOGRAPH
+0x9EF4 0x6A48 #CJK UNIFIED IDEOGRAPH
+0x9EF5 0x6A38 #CJK UNIFIED IDEOGRAPH
+0x9EF6 0x6A22 #CJK UNIFIED IDEOGRAPH
+0x9EF7 0x6A90 #CJK UNIFIED IDEOGRAPH
+0x9EF8 0x6A8D #CJK UNIFIED IDEOGRAPH
+0x9EF9 0x6AA0 #CJK UNIFIED IDEOGRAPH
+0x9EFA 0x6A84 #CJK UNIFIED IDEOGRAPH
+0x9EFB 0x6AA2 #CJK UNIFIED IDEOGRAPH
+0x9EFC 0x6AA3 #CJK UNIFIED IDEOGRAPH
+0x9F40 0x6A97 #CJK UNIFIED IDEOGRAPH
+0x9F41 0x8617 #CJK UNIFIED IDEOGRAPH
+0x9F42 0x6ABB #CJK UNIFIED IDEOGRAPH
+0x9F43 0x6AC3 #CJK UNIFIED IDEOGRAPH
+0x9F44 0x6AC2 #CJK UNIFIED IDEOGRAPH
+0x9F45 0x6AB8 #CJK UNIFIED IDEOGRAPH
+0x9F46 0x6AB3 #CJK UNIFIED IDEOGRAPH
+0x9F47 0x6AAC #CJK UNIFIED IDEOGRAPH
+0x9F48 0x6ADE #CJK UNIFIED IDEOGRAPH
+0x9F49 0x6AD1 #CJK UNIFIED IDEOGRAPH
+0x9F4A 0x6ADF #CJK UNIFIED IDEOGRAPH
+0x9F4B 0x6AAA #CJK UNIFIED IDEOGRAPH
+0x9F4C 0x6ADA #CJK UNIFIED IDEOGRAPH
+0x9F4D 0x6AEA #CJK UNIFIED IDEOGRAPH
+0x9F4E 0x6AFB #CJK UNIFIED IDEOGRAPH
+0x9F4F 0x6B05 #CJK UNIFIED IDEOGRAPH
+0x9F50 0x8616 #CJK UNIFIED IDEOGRAPH
+0x9F51 0x6AFA #CJK UNIFIED IDEOGRAPH
+0x9F52 0x6B12 #CJK UNIFIED IDEOGRAPH
+0x9F53 0x6B16 #CJK UNIFIED IDEOGRAPH
+0x9F54 0x9B31 #CJK UNIFIED IDEOGRAPH
+0x9F55 0x6B1F #CJK UNIFIED IDEOGRAPH
+0x9F56 0x6B38 #CJK UNIFIED IDEOGRAPH
+0x9F57 0x6B37 #CJK UNIFIED IDEOGRAPH
+0x9F58 0x76DC #CJK UNIFIED IDEOGRAPH
+0x9F59 0x6B39 #CJK UNIFIED IDEOGRAPH
+0x9F5A 0x98EE #CJK UNIFIED IDEOGRAPH
+0x9F5B 0x6B47 #CJK UNIFIED IDEOGRAPH
+0x9F5C 0x6B43 #CJK UNIFIED IDEOGRAPH
+0x9F5D 0x6B49 #CJK UNIFIED IDEOGRAPH
+0x9F5E 0x6B50 #CJK UNIFIED IDEOGRAPH
+0x9F5F 0x6B59 #CJK UNIFIED IDEOGRAPH
+0x9F60 0x6B54 #CJK UNIFIED IDEOGRAPH
+0x9F61 0x6B5B #CJK UNIFIED IDEOGRAPH
+0x9F62 0x6B5F #CJK UNIFIED IDEOGRAPH
+0x9F63 0x6B61 #CJK UNIFIED IDEOGRAPH
+0x9F64 0x6B78 #CJK UNIFIED IDEOGRAPH
+0x9F65 0x6B79 #CJK UNIFIED IDEOGRAPH
+0x9F66 0x6B7F #CJK UNIFIED IDEOGRAPH
+0x9F67 0x6B80 #CJK UNIFIED IDEOGRAPH
+0x9F68 0x6B84 #CJK UNIFIED IDEOGRAPH
+0x9F69 0x6B83 #CJK UNIFIED IDEOGRAPH
+0x9F6A 0x6B8D #CJK UNIFIED IDEOGRAPH
+0x9F6B 0x6B98 #CJK UNIFIED IDEOGRAPH
+0x9F6C 0x6B95 #CJK UNIFIED IDEOGRAPH
+0x9F6D 0x6B9E #CJK UNIFIED IDEOGRAPH
+0x9F6E 0x6BA4 #CJK UNIFIED IDEOGRAPH
+0x9F6F 0x6BAA #CJK UNIFIED IDEOGRAPH
+0x9F70 0x6BAB #CJK UNIFIED IDEOGRAPH
+0x9F71 0x6BAF #CJK UNIFIED IDEOGRAPH
+0x9F72 0x6BB2 #CJK UNIFIED IDEOGRAPH
+0x9F73 0x6BB1 #CJK UNIFIED IDEOGRAPH
+0x9F74 0x6BB3 #CJK UNIFIED IDEOGRAPH
+0x9F75 0x6BB7 #CJK UNIFIED IDEOGRAPH
+0x9F76 0x6BBC #CJK UNIFIED IDEOGRAPH
+0x9F77 0x6BC6 #CJK UNIFIED IDEOGRAPH
+0x9F78 0x6BCB #CJK UNIFIED IDEOGRAPH
+0x9F79 0x6BD3 #CJK UNIFIED IDEOGRAPH
+0x9F7A 0x6BDF #CJK UNIFIED IDEOGRAPH
+0x9F7B 0x6BEC #CJK UNIFIED IDEOGRAPH
+0x9F7C 0x6BEB #CJK UNIFIED IDEOGRAPH
+0x9F7D 0x6BF3 #CJK UNIFIED IDEOGRAPH
+0x9F7E 0x6BEF #CJK UNIFIED IDEOGRAPH
+0x9F80 0x9EBE #CJK UNIFIED IDEOGRAPH
+0x9F81 0x6C08 #CJK UNIFIED IDEOGRAPH
+0x9F82 0x6C13 #CJK UNIFIED IDEOGRAPH
+0x9F83 0x6C14 #CJK UNIFIED IDEOGRAPH
+0x9F84 0x6C1B #CJK UNIFIED IDEOGRAPH
+0x9F85 0x6C24 #CJK UNIFIED IDEOGRAPH
+0x9F86 0x6C23 #CJK UNIFIED IDEOGRAPH
+0x9F87 0x6C5E #CJK UNIFIED IDEOGRAPH
+0x9F88 0x6C55 #CJK UNIFIED IDEOGRAPH
+0x9F89 0x6C62 #CJK UNIFIED IDEOGRAPH
+0x9F8A 0x6C6A #CJK UNIFIED IDEOGRAPH
+0x9F8B 0x6C82 #CJK UNIFIED IDEOGRAPH
+0x9F8C 0x6C8D #CJK UNIFIED IDEOGRAPH
+0x9F8D 0x6C9A #CJK UNIFIED IDEOGRAPH
+0x9F8E 0x6C81 #CJK UNIFIED IDEOGRAPH
+0x9F8F 0x6C9B #CJK UNIFIED IDEOGRAPH
+0x9F90 0x6C7E #CJK UNIFIED IDEOGRAPH
+0x9F91 0x6C68 #CJK UNIFIED IDEOGRAPH
+0x9F92 0x6C73 #CJK UNIFIED IDEOGRAPH
+0x9F93 0x6C92 #CJK UNIFIED IDEOGRAPH
+0x9F94 0x6C90 #CJK UNIFIED IDEOGRAPH
+0x9F95 0x6CC4 #CJK UNIFIED IDEOGRAPH
+0x9F96 0x6CF1 #CJK UNIFIED IDEOGRAPH
+0x9F97 0x6CD3 #CJK UNIFIED IDEOGRAPH
+0x9F98 0x6CBD #CJK UNIFIED IDEOGRAPH
+0x9F99 0x6CD7 #CJK UNIFIED IDEOGRAPH
+0x9F9A 0x6CC5 #CJK UNIFIED IDEOGRAPH
+0x9F9B 0x6CDD #CJK UNIFIED IDEOGRAPH
+0x9F9C 0x6CAE #CJK UNIFIED IDEOGRAPH
+0x9F9D 0x6CB1 #CJK UNIFIED IDEOGRAPH
+0x9F9E 0x6CBE #CJK UNIFIED IDEOGRAPH
+0x9F9F 0x6CBA #CJK UNIFIED IDEOGRAPH
+0x9FA0 0x6CDB #CJK UNIFIED IDEOGRAPH
+0x9FA1 0x6CEF #CJK UNIFIED IDEOGRAPH
+0x9FA2 0x6CD9 #CJK UNIFIED IDEOGRAPH
+0x9FA3 0x6CEA #CJK UNIFIED IDEOGRAPH
+0x9FA4 0x6D1F #CJK UNIFIED IDEOGRAPH
+0x9FA5 0x884D #CJK UNIFIED IDEOGRAPH
+0x9FA6 0x6D36 #CJK UNIFIED IDEOGRAPH
+0x9FA7 0x6D2B #CJK UNIFIED IDEOGRAPH
+0x9FA8 0x6D3D #CJK UNIFIED IDEOGRAPH
+0x9FA9 0x6D38 #CJK UNIFIED IDEOGRAPH
+0x9FAA 0x6D19 #CJK UNIFIED IDEOGRAPH
+0x9FAB 0x6D35 #CJK UNIFIED IDEOGRAPH
+0x9FAC 0x6D33 #CJK UNIFIED IDEOGRAPH
+0x9FAD 0x6D12 #CJK UNIFIED IDEOGRAPH
+0x9FAE 0x6D0C #CJK UNIFIED IDEOGRAPH
+0x9FAF 0x6D63 #CJK UNIFIED IDEOGRAPH
+0x9FB0 0x6D93 #CJK UNIFIED IDEOGRAPH
+0x9FB1 0x6D64 #CJK UNIFIED IDEOGRAPH
+0x9FB2 0x6D5A #CJK UNIFIED IDEOGRAPH
+0x9FB3 0x6D79 #CJK UNIFIED IDEOGRAPH
+0x9FB4 0x6D59 #CJK UNIFIED IDEOGRAPH
+0x9FB5 0x6D8E #CJK UNIFIED IDEOGRAPH
+0x9FB6 0x6D95 #CJK UNIFIED IDEOGRAPH
+0x9FB7 0x6FE4 #CJK UNIFIED IDEOGRAPH
+0x9FB8 0x6D85 #CJK UNIFIED IDEOGRAPH
+0x9FB9 0x6DF9 #CJK UNIFIED IDEOGRAPH
+0x9FBA 0x6E15 #CJK UNIFIED IDEOGRAPH
+0x9FBB 0x6E0A #CJK UNIFIED IDEOGRAPH
+0x9FBC 0x6DB5 #CJK UNIFIED IDEOGRAPH
+0x9FBD 0x6DC7 #CJK UNIFIED IDEOGRAPH
+0x9FBE 0x6DE6 #CJK UNIFIED IDEOGRAPH
+0x9FBF 0x6DB8 #CJK UNIFIED IDEOGRAPH
+0x9FC0 0x6DC6 #CJK UNIFIED IDEOGRAPH
+0x9FC1 0x6DEC #CJK UNIFIED IDEOGRAPH
+0x9FC2 0x6DDE #CJK UNIFIED IDEOGRAPH
+0x9FC3 0x6DCC #CJK UNIFIED IDEOGRAPH
+0x9FC4 0x6DE8 #CJK UNIFIED IDEOGRAPH
+0x9FC5 0x6DD2 #CJK UNIFIED IDEOGRAPH
+0x9FC6 0x6DC5 #CJK UNIFIED IDEOGRAPH
+0x9FC7 0x6DFA #CJK UNIFIED IDEOGRAPH
+0x9FC8 0x6DD9 #CJK UNIFIED IDEOGRAPH
+0x9FC9 0x6DE4 #CJK UNIFIED IDEOGRAPH
+0x9FCA 0x6DD5 #CJK UNIFIED IDEOGRAPH
+0x9FCB 0x6DEA #CJK UNIFIED IDEOGRAPH
+0x9FCC 0x6DEE #CJK UNIFIED IDEOGRAPH
+0x9FCD 0x6E2D #CJK UNIFIED IDEOGRAPH
+0x9FCE 0x6E6E #CJK UNIFIED IDEOGRAPH
+0x9FCF 0x6E2E #CJK UNIFIED IDEOGRAPH
+0x9FD0 0x6E19 #CJK UNIFIED IDEOGRAPH
+0x9FD1 0x6E72 #CJK UNIFIED IDEOGRAPH
+0x9FD2 0x6E5F #CJK UNIFIED IDEOGRAPH
+0x9FD3 0x6E3E #CJK UNIFIED IDEOGRAPH
+0x9FD4 0x6E23 #CJK UNIFIED IDEOGRAPH
+0x9FD5 0x6E6B #CJK UNIFIED IDEOGRAPH
+0x9FD6 0x6E2B #CJK UNIFIED IDEOGRAPH
+0x9FD7 0x6E76 #CJK UNIFIED IDEOGRAPH
+0x9FD8 0x6E4D #CJK UNIFIED IDEOGRAPH
+0x9FD9 0x6E1F #CJK UNIFIED IDEOGRAPH
+0x9FDA 0x6E43 #CJK UNIFIED IDEOGRAPH
+0x9FDB 0x6E3A #CJK UNIFIED IDEOGRAPH
+0x9FDC 0x6E4E #CJK UNIFIED IDEOGRAPH
+0x9FDD 0x6E24 #CJK UNIFIED IDEOGRAPH
+0x9FDE 0x6EFF #CJK UNIFIED IDEOGRAPH
+0x9FDF 0x6E1D #CJK UNIFIED IDEOGRAPH
+0x9FE0 0x6E38 #CJK UNIFIED IDEOGRAPH
+0x9FE1 0x6E82 #CJK UNIFIED IDEOGRAPH
+0x9FE2 0x6EAA #CJK UNIFIED IDEOGRAPH
+0x9FE3 0x6E98 #CJK UNIFIED IDEOGRAPH
+0x9FE4 0x6EC9 #CJK UNIFIED IDEOGRAPH
+0x9FE5 0x6EB7 #CJK UNIFIED IDEOGRAPH
+0x9FE6 0x6ED3 #CJK UNIFIED IDEOGRAPH
+0x9FE7 0x6EBD #CJK UNIFIED IDEOGRAPH
+0x9FE8 0x6EAF #CJK UNIFIED IDEOGRAPH
+0x9FE9 0x6EC4 #CJK UNIFIED IDEOGRAPH
+0x9FEA 0x6EB2 #CJK UNIFIED IDEOGRAPH
+0x9FEB 0x6ED4 #CJK UNIFIED IDEOGRAPH
+0x9FEC 0x6ED5 #CJK UNIFIED IDEOGRAPH
+0x9FED 0x6E8F #CJK UNIFIED IDEOGRAPH
+0x9FEE 0x6EA5 #CJK UNIFIED IDEOGRAPH
+0x9FEF 0x6EC2 #CJK UNIFIED IDEOGRAPH
+0x9FF0 0x6E9F #CJK UNIFIED IDEOGRAPH
+0x9FF1 0x6F41 #CJK UNIFIED IDEOGRAPH
+0x9FF2 0x6F11 #CJK UNIFIED IDEOGRAPH
+0x9FF3 0x704C #CJK UNIFIED IDEOGRAPH
+0x9FF4 0x6EEC #CJK UNIFIED IDEOGRAPH
+0x9FF5 0x6EF8 #CJK UNIFIED IDEOGRAPH
+0x9FF6 0x6EFE #CJK UNIFIED IDEOGRAPH
+0x9FF7 0x6F3F #CJK UNIFIED IDEOGRAPH
+0x9FF8 0x6EF2 #CJK UNIFIED IDEOGRAPH
+0x9FF9 0x6F31 #CJK UNIFIED IDEOGRAPH
+0x9FFA 0x6EEF #CJK UNIFIED IDEOGRAPH
+0x9FFB 0x6F32 #CJK UNIFIED IDEOGRAPH
+0x9FFC 0x6ECC #CJK UNIFIED IDEOGRAPH
+0xE040 0x6F3E #CJK UNIFIED IDEOGRAPH
+0xE041 0x6F13 #CJK UNIFIED IDEOGRAPH
+0xE042 0x6EF7 #CJK UNIFIED IDEOGRAPH
+0xE043 0x6F86 #CJK UNIFIED IDEOGRAPH
+0xE044 0x6F7A #CJK UNIFIED IDEOGRAPH
+0xE045 0x6F78 #CJK UNIFIED IDEOGRAPH
+0xE046 0x6F81 #CJK UNIFIED IDEOGRAPH
+0xE047 0x6F80 #CJK UNIFIED IDEOGRAPH
+0xE048 0x6F6F #CJK UNIFIED IDEOGRAPH
+0xE049 0x6F5B #CJK UNIFIED IDEOGRAPH
+0xE04A 0x6FF3 #CJK UNIFIED IDEOGRAPH
+0xE04B 0x6F6D #CJK UNIFIED IDEOGRAPH
+0xE04C 0x6F82 #CJK UNIFIED IDEOGRAPH
+0xE04D 0x6F7C #CJK UNIFIED IDEOGRAPH
+0xE04E 0x6F58 #CJK UNIFIED IDEOGRAPH
+0xE04F 0x6F8E #CJK UNIFIED IDEOGRAPH
+0xE050 0x6F91 #CJK UNIFIED IDEOGRAPH
+0xE051 0x6FC2 #CJK UNIFIED IDEOGRAPH
+0xE052 0x6F66 #CJK UNIFIED IDEOGRAPH
+0xE053 0x6FB3 #CJK UNIFIED IDEOGRAPH
+0xE054 0x6FA3 #CJK UNIFIED IDEOGRAPH
+0xE055 0x6FA1 #CJK UNIFIED IDEOGRAPH
+0xE056 0x6FA4 #CJK UNIFIED IDEOGRAPH
+0xE057 0x6FB9 #CJK UNIFIED IDEOGRAPH
+0xE058 0x6FC6 #CJK UNIFIED IDEOGRAPH
+0xE059 0x6FAA #CJK UNIFIED IDEOGRAPH
+0xE05A 0x6FDF #CJK UNIFIED IDEOGRAPH
+0xE05B 0x6FD5 #CJK UNIFIED IDEOGRAPH
+0xE05C 0x6FEC #CJK UNIFIED IDEOGRAPH
+0xE05D 0x6FD4 #CJK UNIFIED IDEOGRAPH
+0xE05E 0x6FD8 #CJK UNIFIED IDEOGRAPH
+0xE05F 0x6FF1 #CJK UNIFIED IDEOGRAPH
+0xE060 0x6FEE #CJK UNIFIED IDEOGRAPH
+0xE061 0x6FDB #CJK UNIFIED IDEOGRAPH
+0xE062 0x7009 #CJK UNIFIED IDEOGRAPH
+0xE063 0x700B #CJK UNIFIED IDEOGRAPH
+0xE064 0x6FFA #CJK UNIFIED IDEOGRAPH
+0xE065 0x7011 #CJK UNIFIED IDEOGRAPH
+0xE066 0x7001 #CJK UNIFIED IDEOGRAPH
+0xE067 0x700F #CJK UNIFIED IDEOGRAPH
+0xE068 0x6FFE #CJK UNIFIED IDEOGRAPH
+0xE069 0x701B #CJK UNIFIED IDEOGRAPH
+0xE06A 0x701A #CJK UNIFIED IDEOGRAPH
+0xE06B 0x6F74 #CJK UNIFIED IDEOGRAPH
+0xE06C 0x701D #CJK UNIFIED IDEOGRAPH
+0xE06D 0x7018 #CJK UNIFIED IDEOGRAPH
+0xE06E 0x701F #CJK UNIFIED IDEOGRAPH
+0xE06F 0x7030 #CJK UNIFIED IDEOGRAPH
+0xE070 0x703E #CJK UNIFIED IDEOGRAPH
+0xE071 0x7032 #CJK UNIFIED IDEOGRAPH
+0xE072 0x7051 #CJK UNIFIED IDEOGRAPH
+0xE073 0x7063 #CJK UNIFIED IDEOGRAPH
+0xE074 0x7099 #CJK UNIFIED IDEOGRAPH
+0xE075 0x7092 #CJK UNIFIED IDEOGRAPH
+0xE076 0x70AF #CJK UNIFIED IDEOGRAPH
+0xE077 0x70F1 #CJK UNIFIED IDEOGRAPH
+0xE078 0x70AC #CJK UNIFIED IDEOGRAPH
+0xE079 0x70B8 #CJK UNIFIED IDEOGRAPH
+0xE07A 0x70B3 #CJK UNIFIED IDEOGRAPH
+0xE07B 0x70AE #CJK UNIFIED IDEOGRAPH
+0xE07C 0x70DF #CJK UNIFIED IDEOGRAPH
+0xE07D 0x70CB #CJK UNIFIED IDEOGRAPH
+0xE07E 0x70DD #CJK UNIFIED IDEOGRAPH
+0xE080 0x70D9 #CJK UNIFIED IDEOGRAPH
+0xE081 0x7109 #CJK UNIFIED IDEOGRAPH
+0xE082 0x70FD #CJK UNIFIED IDEOGRAPH
+0xE083 0x711C #CJK UNIFIED IDEOGRAPH
+0xE084 0x7119 #CJK UNIFIED IDEOGRAPH
+0xE085 0x7165 #CJK UNIFIED IDEOGRAPH
+0xE086 0x7155 #CJK UNIFIED IDEOGRAPH
+0xE087 0x7188 #CJK UNIFIED IDEOGRAPH
+0xE088 0x7166 #CJK UNIFIED IDEOGRAPH
+0xE089 0x7162 #CJK UNIFIED IDEOGRAPH
+0xE08A 0x714C #CJK UNIFIED IDEOGRAPH
+0xE08B 0x7156 #CJK UNIFIED IDEOGRAPH
+0xE08C 0x716C #CJK UNIFIED IDEOGRAPH
+0xE08D 0x718F #CJK UNIFIED IDEOGRAPH
+0xE08E 0x71FB #CJK UNIFIED IDEOGRAPH
+0xE08F 0x7184 #CJK UNIFIED IDEOGRAPH
+0xE090 0x7195 #CJK UNIFIED IDEOGRAPH
+0xE091 0x71A8 #CJK UNIFIED IDEOGRAPH
+0xE092 0x71AC #CJK UNIFIED IDEOGRAPH
+0xE093 0x71D7 #CJK UNIFIED IDEOGRAPH
+0xE094 0x71B9 #CJK UNIFIED IDEOGRAPH
+0xE095 0x71BE #CJK UNIFIED IDEOGRAPH
+0xE096 0x71D2 #CJK UNIFIED IDEOGRAPH
+0xE097 0x71C9 #CJK UNIFIED IDEOGRAPH
+0xE098 0x71D4 #CJK UNIFIED IDEOGRAPH
+0xE099 0x71CE #CJK UNIFIED IDEOGRAPH
+0xE09A 0x71E0 #CJK UNIFIED IDEOGRAPH
+0xE09B 0x71EC #CJK UNIFIED IDEOGRAPH
+0xE09C 0x71E7 #CJK UNIFIED IDEOGRAPH
+0xE09D 0x71F5 #CJK UNIFIED IDEOGRAPH
+0xE09E 0x71FC #CJK UNIFIED IDEOGRAPH
+0xE09F 0x71F9 #CJK UNIFIED IDEOGRAPH
+0xE0A0 0x71FF #CJK UNIFIED IDEOGRAPH
+0xE0A1 0x720D #CJK UNIFIED IDEOGRAPH
+0xE0A2 0x7210 #CJK UNIFIED IDEOGRAPH
+0xE0A3 0x721B #CJK UNIFIED IDEOGRAPH
+0xE0A4 0x7228 #CJK UNIFIED IDEOGRAPH
+0xE0A5 0x722D #CJK UNIFIED IDEOGRAPH
+0xE0A6 0x722C #CJK UNIFIED IDEOGRAPH
+0xE0A7 0x7230 #CJK UNIFIED IDEOGRAPH
+0xE0A8 0x7232 #CJK UNIFIED IDEOGRAPH
+0xE0A9 0x723B #CJK UNIFIED IDEOGRAPH
+0xE0AA 0x723C #CJK UNIFIED IDEOGRAPH
+0xE0AB 0x723F #CJK UNIFIED IDEOGRAPH
+0xE0AC 0x7240 #CJK UNIFIED IDEOGRAPH
+0xE0AD 0x7246 #CJK UNIFIED IDEOGRAPH
+0xE0AE 0x724B #CJK UNIFIED IDEOGRAPH
+0xE0AF 0x7258 #CJK UNIFIED IDEOGRAPH
+0xE0B0 0x7274 #CJK UNIFIED IDEOGRAPH
+0xE0B1 0x727E #CJK UNIFIED IDEOGRAPH
+0xE0B2 0x7282 #CJK UNIFIED IDEOGRAPH
+0xE0B3 0x7281 #CJK UNIFIED IDEOGRAPH
+0xE0B4 0x7287 #CJK UNIFIED IDEOGRAPH
+0xE0B5 0x7292 #CJK UNIFIED IDEOGRAPH
+0xE0B6 0x7296 #CJK UNIFIED IDEOGRAPH
+0xE0B7 0x72A2 #CJK UNIFIED IDEOGRAPH
+0xE0B8 0x72A7 #CJK UNIFIED IDEOGRAPH
+0xE0B9 0x72B9 #CJK UNIFIED IDEOGRAPH
+0xE0BA 0x72B2 #CJK UNIFIED IDEOGRAPH
+0xE0BB 0x72C3 #CJK UNIFIED IDEOGRAPH
+0xE0BC 0x72C6 #CJK UNIFIED IDEOGRAPH
+0xE0BD 0x72C4 #CJK UNIFIED IDEOGRAPH
+0xE0BE 0x72CE #CJK UNIFIED IDEOGRAPH
+0xE0BF 0x72D2 #CJK UNIFIED IDEOGRAPH
+0xE0C0 0x72E2 #CJK UNIFIED IDEOGRAPH
+0xE0C1 0x72E0 #CJK UNIFIED IDEOGRAPH
+0xE0C2 0x72E1 #CJK UNIFIED IDEOGRAPH
+0xE0C3 0x72F9 #CJK UNIFIED IDEOGRAPH
+0xE0C4 0x72F7 #CJK UNIFIED IDEOGRAPH
+0xE0C5 0x500F #CJK UNIFIED IDEOGRAPH
+0xE0C6 0x7317 #CJK UNIFIED IDEOGRAPH
+0xE0C7 0x730A #CJK UNIFIED IDEOGRAPH
+0xE0C8 0x731C #CJK UNIFIED IDEOGRAPH
+0xE0C9 0x7316 #CJK UNIFIED IDEOGRAPH
+0xE0CA 0x731D #CJK UNIFIED IDEOGRAPH
+0xE0CB 0x7334 #CJK UNIFIED IDEOGRAPH
+0xE0CC 0x732F #CJK UNIFIED IDEOGRAPH
+0xE0CD 0x7329 #CJK UNIFIED IDEOGRAPH
+0xE0CE 0x7325 #CJK UNIFIED IDEOGRAPH
+0xE0CF 0x733E #CJK UNIFIED IDEOGRAPH
+0xE0D0 0x734E #CJK UNIFIED IDEOGRAPH
+0xE0D1 0x734F #CJK UNIFIED IDEOGRAPH
+0xE0D2 0x9ED8 #CJK UNIFIED IDEOGRAPH
+0xE0D3 0x7357 #CJK UNIFIED IDEOGRAPH
+0xE0D4 0x736A #CJK UNIFIED IDEOGRAPH
+0xE0D5 0x7368 #CJK UNIFIED IDEOGRAPH
+0xE0D6 0x7370 #CJK UNIFIED IDEOGRAPH
+0xE0D7 0x7378 #CJK UNIFIED IDEOGRAPH
+0xE0D8 0x7375 #CJK UNIFIED IDEOGRAPH
+0xE0D9 0x737B #CJK UNIFIED IDEOGRAPH
+0xE0DA 0x737A #CJK UNIFIED IDEOGRAPH
+0xE0DB 0x73C8 #CJK UNIFIED IDEOGRAPH
+0xE0DC 0x73B3 #CJK UNIFIED IDEOGRAPH
+0xE0DD 0x73CE #CJK UNIFIED IDEOGRAPH
+0xE0DE 0x73BB #CJK UNIFIED IDEOGRAPH
+0xE0DF 0x73C0 #CJK UNIFIED IDEOGRAPH
+0xE0E0 0x73E5 #CJK UNIFIED IDEOGRAPH
+0xE0E1 0x73EE #CJK UNIFIED IDEOGRAPH
+0xE0E2 0x73DE #CJK UNIFIED IDEOGRAPH
+0xE0E3 0x74A2 #CJK UNIFIED IDEOGRAPH
+0xE0E4 0x7405 #CJK UNIFIED IDEOGRAPH
+0xE0E5 0x746F #CJK UNIFIED IDEOGRAPH
+0xE0E6 0x7425 #CJK UNIFIED IDEOGRAPH
+0xE0E7 0x73F8 #CJK UNIFIED IDEOGRAPH
+0xE0E8 0x7432 #CJK UNIFIED IDEOGRAPH
+0xE0E9 0x743A #CJK UNIFIED IDEOGRAPH
+0xE0EA 0x7455 #CJK UNIFIED IDEOGRAPH
+0xE0EB 0x743F #CJK UNIFIED IDEOGRAPH
+0xE0EC 0x745F #CJK UNIFIED IDEOGRAPH
+0xE0ED 0x7459 #CJK UNIFIED IDEOGRAPH
+0xE0EE 0x7441 #CJK UNIFIED IDEOGRAPH
+0xE0EF 0x745C #CJK UNIFIED IDEOGRAPH
+0xE0F0 0x7469 #CJK UNIFIED IDEOGRAPH
+0xE0F1 0x7470 #CJK UNIFIED IDEOGRAPH
+0xE0F2 0x7463 #CJK UNIFIED IDEOGRAPH
+0xE0F3 0x746A #CJK UNIFIED IDEOGRAPH
+0xE0F4 0x7476 #CJK UNIFIED IDEOGRAPH
+0xE0F5 0x747E #CJK UNIFIED IDEOGRAPH
+0xE0F6 0x748B #CJK UNIFIED IDEOGRAPH
+0xE0F7 0x749E #CJK UNIFIED IDEOGRAPH
+0xE0F8 0x74A7 #CJK UNIFIED IDEOGRAPH
+0xE0F9 0x74CA #CJK UNIFIED IDEOGRAPH
+0xE0FA 0x74CF #CJK UNIFIED IDEOGRAPH
+0xE0FB 0x74D4 #CJK UNIFIED IDEOGRAPH
+0xE0FC 0x73F1 #CJK UNIFIED IDEOGRAPH
+0xE140 0x74E0 #CJK UNIFIED IDEOGRAPH
+0xE141 0x74E3 #CJK UNIFIED IDEOGRAPH
+0xE142 0x74E7 #CJK UNIFIED IDEOGRAPH
+0xE143 0x74E9 #CJK UNIFIED IDEOGRAPH
+0xE144 0x74EE #CJK UNIFIED IDEOGRAPH
+0xE145 0x74F2 #CJK UNIFIED IDEOGRAPH
+0xE146 0x74F0 #CJK UNIFIED IDEOGRAPH
+0xE147 0x74F1 #CJK UNIFIED IDEOGRAPH
+0xE148 0x74F8 #CJK UNIFIED IDEOGRAPH
+0xE149 0x74F7 #CJK UNIFIED IDEOGRAPH
+0xE14A 0x7504 #CJK UNIFIED IDEOGRAPH
+0xE14B 0x7503 #CJK UNIFIED IDEOGRAPH
+0xE14C 0x7505 #CJK UNIFIED IDEOGRAPH
+0xE14D 0x750C #CJK UNIFIED IDEOGRAPH
+0xE14E 0x750E #CJK UNIFIED IDEOGRAPH
+0xE14F 0x750D #CJK UNIFIED IDEOGRAPH
+0xE150 0x7515 #CJK UNIFIED IDEOGRAPH
+0xE151 0x7513 #CJK UNIFIED IDEOGRAPH
+0xE152 0x751E #CJK UNIFIED IDEOGRAPH
+0xE153 0x7526 #CJK UNIFIED IDEOGRAPH
+0xE154 0x752C #CJK UNIFIED IDEOGRAPH
+0xE155 0x753C #CJK UNIFIED IDEOGRAPH
+0xE156 0x7544 #CJK UNIFIED IDEOGRAPH
+0xE157 0x754D #CJK UNIFIED IDEOGRAPH
+0xE158 0x754A #CJK UNIFIED IDEOGRAPH
+0xE159 0x7549 #CJK UNIFIED IDEOGRAPH
+0xE15A 0x755B #CJK UNIFIED IDEOGRAPH
+0xE15B 0x7546 #CJK UNIFIED IDEOGRAPH
+0xE15C 0x755A #CJK UNIFIED IDEOGRAPH
+0xE15D 0x7569 #CJK UNIFIED IDEOGRAPH
+0xE15E 0x7564 #CJK UNIFIED IDEOGRAPH
+0xE15F 0x7567 #CJK UNIFIED IDEOGRAPH
+0xE160 0x756B #CJK UNIFIED IDEOGRAPH
+0xE161 0x756D #CJK UNIFIED IDEOGRAPH
+0xE162 0x7578 #CJK UNIFIED IDEOGRAPH
+0xE163 0x7576 #CJK UNIFIED IDEOGRAPH
+0xE164 0x7586 #CJK UNIFIED IDEOGRAPH
+0xE165 0x7587 #CJK UNIFIED IDEOGRAPH
+0xE166 0x7574 #CJK UNIFIED IDEOGRAPH
+0xE167 0x758A #CJK UNIFIED IDEOGRAPH
+0xE168 0x7589 #CJK UNIFIED IDEOGRAPH
+0xE169 0x7582 #CJK UNIFIED IDEOGRAPH
+0xE16A 0x7594 #CJK UNIFIED IDEOGRAPH
+0xE16B 0x759A #CJK UNIFIED IDEOGRAPH
+0xE16C 0x759D #CJK UNIFIED IDEOGRAPH
+0xE16D 0x75A5 #CJK UNIFIED IDEOGRAPH
+0xE16E 0x75A3 #CJK UNIFIED IDEOGRAPH
+0xE16F 0x75C2 #CJK UNIFIED IDEOGRAPH
+0xE170 0x75B3 #CJK UNIFIED IDEOGRAPH
+0xE171 0x75C3 #CJK UNIFIED IDEOGRAPH
+0xE172 0x75B5 #CJK UNIFIED IDEOGRAPH
+0xE173 0x75BD #CJK UNIFIED IDEOGRAPH
+0xE174 0x75B8 #CJK UNIFIED IDEOGRAPH
+0xE175 0x75BC #CJK UNIFIED IDEOGRAPH
+0xE176 0x75B1 #CJK UNIFIED IDEOGRAPH
+0xE177 0x75CD #CJK UNIFIED IDEOGRAPH
+0xE178 0x75CA #CJK UNIFIED IDEOGRAPH
+0xE179 0x75D2 #CJK UNIFIED IDEOGRAPH
+0xE17A 0x75D9 #CJK UNIFIED IDEOGRAPH
+0xE17B 0x75E3 #CJK UNIFIED IDEOGRAPH
+0xE17C 0x75DE #CJK UNIFIED IDEOGRAPH
+0xE17D 0x75FE #CJK UNIFIED IDEOGRAPH
+0xE17E 0x75FF #CJK UNIFIED IDEOGRAPH
+0xE180 0x75FC #CJK UNIFIED IDEOGRAPH
+0xE181 0x7601 #CJK UNIFIED IDEOGRAPH
+0xE182 0x75F0 #CJK UNIFIED IDEOGRAPH
+0xE183 0x75FA #CJK UNIFIED IDEOGRAPH
+0xE184 0x75F2 #CJK UNIFIED IDEOGRAPH
+0xE185 0x75F3 #CJK UNIFIED IDEOGRAPH
+0xE186 0x760B #CJK UNIFIED IDEOGRAPH
+0xE187 0x760D #CJK UNIFIED IDEOGRAPH
+0xE188 0x7609 #CJK UNIFIED IDEOGRAPH
+0xE189 0x761F #CJK UNIFIED IDEOGRAPH
+0xE18A 0x7627 #CJK UNIFIED IDEOGRAPH
+0xE18B 0x7620 #CJK UNIFIED IDEOGRAPH
+0xE18C 0x7621 #CJK UNIFIED IDEOGRAPH
+0xE18D 0x7622 #CJK UNIFIED IDEOGRAPH
+0xE18E 0x7624 #CJK UNIFIED IDEOGRAPH
+0xE18F 0x7634 #CJK UNIFIED IDEOGRAPH
+0xE190 0x7630 #CJK UNIFIED IDEOGRAPH
+0xE191 0x763B #CJK UNIFIED IDEOGRAPH
+0xE192 0x7647 #CJK UNIFIED IDEOGRAPH
+0xE193 0x7648 #CJK UNIFIED IDEOGRAPH
+0xE194 0x7646 #CJK UNIFIED IDEOGRAPH
+0xE195 0x765C #CJK UNIFIED IDEOGRAPH
+0xE196 0x7658 #CJK UNIFIED IDEOGRAPH
+0xE197 0x7661 #CJK UNIFIED IDEOGRAPH
+0xE198 0x7662 #CJK UNIFIED IDEOGRAPH
+0xE199 0x7668 #CJK UNIFIED IDEOGRAPH
+0xE19A 0x7669 #CJK UNIFIED IDEOGRAPH
+0xE19B 0x766A #CJK UNIFIED IDEOGRAPH
+0xE19C 0x7667 #CJK UNIFIED IDEOGRAPH
+0xE19D 0x766C #CJK UNIFIED IDEOGRAPH
+0xE19E 0x7670 #CJK UNIFIED IDEOGRAPH
+0xE19F 0x7672 #CJK UNIFIED IDEOGRAPH
+0xE1A0 0x7676 #CJK UNIFIED IDEOGRAPH
+0xE1A1 0x7678 #CJK UNIFIED IDEOGRAPH
+0xE1A2 0x767C #CJK UNIFIED IDEOGRAPH
+0xE1A3 0x7680 #CJK UNIFIED IDEOGRAPH
+0xE1A4 0x7683 #CJK UNIFIED IDEOGRAPH
+0xE1A5 0x7688 #CJK UNIFIED IDEOGRAPH
+0xE1A6 0x768B #CJK UNIFIED IDEOGRAPH
+0xE1A7 0x768E #CJK UNIFIED IDEOGRAPH
+0xE1A8 0x7696 #CJK UNIFIED IDEOGRAPH
+0xE1A9 0x7693 #CJK UNIFIED IDEOGRAPH
+0xE1AA 0x7699 #CJK UNIFIED IDEOGRAPH
+0xE1AB 0x769A #CJK UNIFIED IDEOGRAPH
+0xE1AC 0x76B0 #CJK UNIFIED IDEOGRAPH
+0xE1AD 0x76B4 #CJK UNIFIED IDEOGRAPH
+0xE1AE 0x76B8 #CJK UNIFIED IDEOGRAPH
+0xE1AF 0x76B9 #CJK UNIFIED IDEOGRAPH
+0xE1B0 0x76BA #CJK UNIFIED IDEOGRAPH
+0xE1B1 0x76C2 #CJK UNIFIED IDEOGRAPH
+0xE1B2 0x76CD #CJK UNIFIED IDEOGRAPH
+0xE1B3 0x76D6 #CJK UNIFIED IDEOGRAPH
+0xE1B4 0x76D2 #CJK UNIFIED IDEOGRAPH
+0xE1B5 0x76DE #CJK UNIFIED IDEOGRAPH
+0xE1B6 0x76E1 #CJK UNIFIED IDEOGRAPH
+0xE1B7 0x76E5 #CJK UNIFIED IDEOGRAPH
+0xE1B8 0x76E7 #CJK UNIFIED IDEOGRAPH
+0xE1B9 0x76EA #CJK UNIFIED IDEOGRAPH
+0xE1BA 0x862F #CJK UNIFIED IDEOGRAPH
+0xE1BB 0x76FB #CJK UNIFIED IDEOGRAPH
+0xE1BC 0x7708 #CJK UNIFIED IDEOGRAPH
+0xE1BD 0x7707 #CJK UNIFIED IDEOGRAPH
+0xE1BE 0x7704 #CJK UNIFIED IDEOGRAPH
+0xE1BF 0x7729 #CJK UNIFIED IDEOGRAPH
+0xE1C0 0x7724 #CJK UNIFIED IDEOGRAPH
+0xE1C1 0x771E #CJK UNIFIED IDEOGRAPH
+0xE1C2 0x7725 #CJK UNIFIED IDEOGRAPH
+0xE1C3 0x7726 #CJK UNIFIED IDEOGRAPH
+0xE1C4 0x771B #CJK UNIFIED IDEOGRAPH
+0xE1C5 0x7737 #CJK UNIFIED IDEOGRAPH
+0xE1C6 0x7738 #CJK UNIFIED IDEOGRAPH
+0xE1C7 0x7747 #CJK UNIFIED IDEOGRAPH
+0xE1C8 0x775A #CJK UNIFIED IDEOGRAPH
+0xE1C9 0x7768 #CJK UNIFIED IDEOGRAPH
+0xE1CA 0x776B #CJK UNIFIED IDEOGRAPH
+0xE1CB 0x775B #CJK UNIFIED IDEOGRAPH
+0xE1CC 0x7765 #CJK UNIFIED IDEOGRAPH
+0xE1CD 0x777F #CJK UNIFIED IDEOGRAPH
+0xE1CE 0x777E #CJK UNIFIED IDEOGRAPH
+0xE1CF 0x7779 #CJK UNIFIED IDEOGRAPH
+0xE1D0 0x778E #CJK UNIFIED IDEOGRAPH
+0xE1D1 0x778B #CJK UNIFIED IDEOGRAPH
+0xE1D2 0x7791 #CJK UNIFIED IDEOGRAPH
+0xE1D3 0x77A0 #CJK UNIFIED IDEOGRAPH
+0xE1D4 0x779E #CJK UNIFIED IDEOGRAPH
+0xE1D5 0x77B0 #CJK UNIFIED IDEOGRAPH
+0xE1D6 0x77B6 #CJK UNIFIED IDEOGRAPH
+0xE1D7 0x77B9 #CJK UNIFIED IDEOGRAPH
+0xE1D8 0x77BF #CJK UNIFIED IDEOGRAPH
+0xE1D9 0x77BC #CJK UNIFIED IDEOGRAPH
+0xE1DA 0x77BD #CJK UNIFIED IDEOGRAPH
+0xE1DB 0x77BB #CJK UNIFIED IDEOGRAPH
+0xE1DC 0x77C7 #CJK UNIFIED IDEOGRAPH
+0xE1DD 0x77CD #CJK UNIFIED IDEOGRAPH
+0xE1DE 0x77D7 #CJK UNIFIED IDEOGRAPH
+0xE1DF 0x77DA #CJK UNIFIED IDEOGRAPH
+0xE1E0 0x77DC #CJK UNIFIED IDEOGRAPH
+0xE1E1 0x77E3 #CJK UNIFIED IDEOGRAPH
+0xE1E2 0x77EE #CJK UNIFIED IDEOGRAPH
+0xE1E3 0x77FC #CJK UNIFIED IDEOGRAPH
+0xE1E4 0x780C #CJK UNIFIED IDEOGRAPH
+0xE1E5 0x7812 #CJK UNIFIED IDEOGRAPH
+0xE1E6 0x7926 #CJK UNIFIED IDEOGRAPH
+0xE1E7 0x7820 #CJK UNIFIED IDEOGRAPH
+0xE1E8 0x792A #CJK UNIFIED IDEOGRAPH
+0xE1E9 0x7845 #CJK UNIFIED IDEOGRAPH
+0xE1EA 0x788E #CJK UNIFIED IDEOGRAPH
+0xE1EB 0x7874 #CJK UNIFIED IDEOGRAPH
+0xE1EC 0x7886 #CJK UNIFIED IDEOGRAPH
+0xE1ED 0x787C #CJK UNIFIED IDEOGRAPH
+0xE1EE 0x789A #CJK UNIFIED IDEOGRAPH
+0xE1EF 0x788C #CJK UNIFIED IDEOGRAPH
+0xE1F0 0x78A3 #CJK UNIFIED IDEOGRAPH
+0xE1F1 0x78B5 #CJK UNIFIED IDEOGRAPH
+0xE1F2 0x78AA #CJK UNIFIED IDEOGRAPH
+0xE1F3 0x78AF #CJK UNIFIED IDEOGRAPH
+0xE1F4 0x78D1 #CJK UNIFIED IDEOGRAPH
+0xE1F5 0x78C6 #CJK UNIFIED IDEOGRAPH
+0xE1F6 0x78CB #CJK UNIFIED IDEOGRAPH
+0xE1F7 0x78D4 #CJK UNIFIED IDEOGRAPH
+0xE1F8 0x78BE #CJK UNIFIED IDEOGRAPH
+0xE1F9 0x78BC #CJK UNIFIED IDEOGRAPH
+0xE1FA 0x78C5 #CJK UNIFIED IDEOGRAPH
+0xE1FB 0x78CA #CJK UNIFIED IDEOGRAPH
+0xE1FC 0x78EC #CJK UNIFIED IDEOGRAPH
+0xE240 0x78E7 #CJK UNIFIED IDEOGRAPH
+0xE241 0x78DA #CJK UNIFIED IDEOGRAPH
+0xE242 0x78FD #CJK UNIFIED IDEOGRAPH
+0xE243 0x78F4 #CJK UNIFIED IDEOGRAPH
+0xE244 0x7907 #CJK UNIFIED IDEOGRAPH
+0xE245 0x7912 #CJK UNIFIED IDEOGRAPH
+0xE246 0x7911 #CJK UNIFIED IDEOGRAPH
+0xE247 0x7919 #CJK UNIFIED IDEOGRAPH
+0xE248 0x792C #CJK UNIFIED IDEOGRAPH
+0xE249 0x792B #CJK UNIFIED IDEOGRAPH
+0xE24A 0x7940 #CJK UNIFIED IDEOGRAPH
+0xE24B 0x7960 #CJK UNIFIED IDEOGRAPH
+0xE24C 0x7957 #CJK UNIFIED IDEOGRAPH
+0xE24D 0x795F #CJK UNIFIED IDEOGRAPH
+0xE24E 0x795A #CJK UNIFIED IDEOGRAPH
+0xE24F 0x7955 #CJK UNIFIED IDEOGRAPH
+0xE250 0x7953 #CJK UNIFIED IDEOGRAPH
+0xE251 0x797A #CJK UNIFIED IDEOGRAPH
+0xE252 0x797F #CJK UNIFIED IDEOGRAPH
+0xE253 0x798A #CJK UNIFIED IDEOGRAPH
+0xE254 0x799D #CJK UNIFIED IDEOGRAPH
+0xE255 0x79A7 #CJK UNIFIED IDEOGRAPH
+0xE256 0x9F4B #CJK UNIFIED IDEOGRAPH
+0xE257 0x79AA #CJK UNIFIED IDEOGRAPH
+0xE258 0x79AE #CJK UNIFIED IDEOGRAPH
+0xE259 0x79B3 #CJK UNIFIED IDEOGRAPH
+0xE25A 0x79B9 #CJK UNIFIED IDEOGRAPH
+0xE25B 0x79BA #CJK UNIFIED IDEOGRAPH
+0xE25C 0x79C9 #CJK UNIFIED IDEOGRAPH
+0xE25D 0x79D5 #CJK UNIFIED IDEOGRAPH
+0xE25E 0x79E7 #CJK UNIFIED IDEOGRAPH
+0xE25F 0x79EC #CJK UNIFIED IDEOGRAPH
+0xE260 0x79E1 #CJK UNIFIED IDEOGRAPH
+0xE261 0x79E3 #CJK UNIFIED IDEOGRAPH
+0xE262 0x7A08 #CJK UNIFIED IDEOGRAPH
+0xE263 0x7A0D #CJK UNIFIED IDEOGRAPH
+0xE264 0x7A18 #CJK UNIFIED IDEOGRAPH
+0xE265 0x7A19 #CJK UNIFIED IDEOGRAPH
+0xE266 0x7A20 #CJK UNIFIED IDEOGRAPH
+0xE267 0x7A1F #CJK UNIFIED IDEOGRAPH
+0xE268 0x7980 #CJK UNIFIED IDEOGRAPH
+0xE269 0x7A31 #CJK UNIFIED IDEOGRAPH
+0xE26A 0x7A3B #CJK UNIFIED IDEOGRAPH
+0xE26B 0x7A3E #CJK UNIFIED IDEOGRAPH
+0xE26C 0x7A37 #CJK UNIFIED IDEOGRAPH
+0xE26D 0x7A43 #CJK UNIFIED IDEOGRAPH
+0xE26E 0x7A57 #CJK UNIFIED IDEOGRAPH
+0xE26F 0x7A49 #CJK UNIFIED IDEOGRAPH
+0xE270 0x7A61 #CJK UNIFIED IDEOGRAPH
+0xE271 0x7A62 #CJK UNIFIED IDEOGRAPH
+0xE272 0x7A69 #CJK UNIFIED IDEOGRAPH
+0xE273 0x9F9D #CJK UNIFIED IDEOGRAPH
+0xE274 0x7A70 #CJK UNIFIED IDEOGRAPH
+0xE275 0x7A79 #CJK UNIFIED IDEOGRAPH
+0xE276 0x7A7D #CJK UNIFIED IDEOGRAPH
+0xE277 0x7A88 #CJK UNIFIED IDEOGRAPH
+0xE278 0x7A97 #CJK UNIFIED IDEOGRAPH
+0xE279 0x7A95 #CJK UNIFIED IDEOGRAPH
+0xE27A 0x7A98 #CJK UNIFIED IDEOGRAPH
+0xE27B 0x7A96 #CJK UNIFIED IDEOGRAPH
+0xE27C 0x7AA9 #CJK UNIFIED IDEOGRAPH
+0xE27D 0x7AC8 #CJK UNIFIED IDEOGRAPH
+0xE27E 0x7AB0 #CJK UNIFIED IDEOGRAPH
+0xE280 0x7AB6 #CJK UNIFIED IDEOGRAPH
+0xE281 0x7AC5 #CJK UNIFIED IDEOGRAPH
+0xE282 0x7AC4 #CJK UNIFIED IDEOGRAPH
+0xE283 0x7ABF #CJK UNIFIED IDEOGRAPH
+0xE284 0x9083 #CJK UNIFIED IDEOGRAPH
+0xE285 0x7AC7 #CJK UNIFIED IDEOGRAPH
+0xE286 0x7ACA #CJK UNIFIED IDEOGRAPH
+0xE287 0x7ACD #CJK UNIFIED IDEOGRAPH
+0xE288 0x7ACF #CJK UNIFIED IDEOGRAPH
+0xE289 0x7AD5 #CJK UNIFIED IDEOGRAPH
+0xE28A 0x7AD3 #CJK UNIFIED IDEOGRAPH
+0xE28B 0x7AD9 #CJK UNIFIED IDEOGRAPH
+0xE28C 0x7ADA #CJK UNIFIED IDEOGRAPH
+0xE28D 0x7ADD #CJK UNIFIED IDEOGRAPH
+0xE28E 0x7AE1 #CJK UNIFIED IDEOGRAPH
+0xE28F 0x7AE2 #CJK UNIFIED IDEOGRAPH
+0xE290 0x7AE6 #CJK UNIFIED IDEOGRAPH
+0xE291 0x7AED #CJK UNIFIED IDEOGRAPH
+0xE292 0x7AF0 #CJK UNIFIED IDEOGRAPH
+0xE293 0x7B02 #CJK UNIFIED IDEOGRAPH
+0xE294 0x7B0F #CJK UNIFIED IDEOGRAPH
+0xE295 0x7B0A #CJK UNIFIED IDEOGRAPH
+0xE296 0x7B06 #CJK UNIFIED IDEOGRAPH
+0xE297 0x7B33 #CJK UNIFIED IDEOGRAPH
+0xE298 0x7B18 #CJK UNIFIED IDEOGRAPH
+0xE299 0x7B19 #CJK UNIFIED IDEOGRAPH
+0xE29A 0x7B1E #CJK UNIFIED IDEOGRAPH
+0xE29B 0x7B35 #CJK UNIFIED IDEOGRAPH
+0xE29C 0x7B28 #CJK UNIFIED IDEOGRAPH
+0xE29D 0x7B36 #CJK UNIFIED IDEOGRAPH
+0xE29E 0x7B50 #CJK UNIFIED IDEOGRAPH
+0xE29F 0x7B7A #CJK UNIFIED IDEOGRAPH
+0xE2A0 0x7B04 #CJK UNIFIED IDEOGRAPH
+0xE2A1 0x7B4D #CJK UNIFIED IDEOGRAPH
+0xE2A2 0x7B0B #CJK UNIFIED IDEOGRAPH
+0xE2A3 0x7B4C #CJK UNIFIED IDEOGRAPH
+0xE2A4 0x7B45 #CJK UNIFIED IDEOGRAPH
+0xE2A5 0x7B75 #CJK UNIFIED IDEOGRAPH
+0xE2A6 0x7B65 #CJK UNIFIED IDEOGRAPH
+0xE2A7 0x7B74 #CJK UNIFIED IDEOGRAPH
+0xE2A8 0x7B67 #CJK UNIFIED IDEOGRAPH
+0xE2A9 0x7B70 #CJK UNIFIED IDEOGRAPH
+0xE2AA 0x7B71 #CJK UNIFIED IDEOGRAPH
+0xE2AB 0x7B6C #CJK UNIFIED IDEOGRAPH
+0xE2AC 0x7B6E #CJK UNIFIED IDEOGRAPH
+0xE2AD 0x7B9D #CJK UNIFIED IDEOGRAPH
+0xE2AE 0x7B98 #CJK UNIFIED IDEOGRAPH
+0xE2AF 0x7B9F #CJK UNIFIED IDEOGRAPH
+0xE2B0 0x7B8D #CJK UNIFIED IDEOGRAPH
+0xE2B1 0x7B9C #CJK UNIFIED IDEOGRAPH
+0xE2B2 0x7B9A #CJK UNIFIED IDEOGRAPH
+0xE2B3 0x7B8B #CJK UNIFIED IDEOGRAPH
+0xE2B4 0x7B92 #CJK UNIFIED IDEOGRAPH
+0xE2B5 0x7B8F #CJK UNIFIED IDEOGRAPH
+0xE2B6 0x7B5D #CJK UNIFIED IDEOGRAPH
+0xE2B7 0x7B99 #CJK UNIFIED IDEOGRAPH
+0xE2B8 0x7BCB #CJK UNIFIED IDEOGRAPH
+0xE2B9 0x7BC1 #CJK UNIFIED IDEOGRAPH
+0xE2BA 0x7BCC #CJK UNIFIED IDEOGRAPH
+0xE2BB 0x7BCF #CJK UNIFIED IDEOGRAPH
+0xE2BC 0x7BB4 #CJK UNIFIED IDEOGRAPH
+0xE2BD 0x7BC6 #CJK UNIFIED IDEOGRAPH
+0xE2BE 0x7BDD #CJK UNIFIED IDEOGRAPH
+0xE2BF 0x7BE9 #CJK UNIFIED IDEOGRAPH
+0xE2C0 0x7C11 #CJK UNIFIED IDEOGRAPH
+0xE2C1 0x7C14 #CJK UNIFIED IDEOGRAPH
+0xE2C2 0x7BE6 #CJK UNIFIED IDEOGRAPH
+0xE2C3 0x7BE5 #CJK UNIFIED IDEOGRAPH
+0xE2C4 0x7C60 #CJK UNIFIED IDEOGRAPH
+0xE2C5 0x7C00 #CJK UNIFIED IDEOGRAPH
+0xE2C6 0x7C07 #CJK UNIFIED IDEOGRAPH
+0xE2C7 0x7C13 #CJK UNIFIED IDEOGRAPH
+0xE2C8 0x7BF3 #CJK UNIFIED IDEOGRAPH
+0xE2C9 0x7BF7 #CJK UNIFIED IDEOGRAPH
+0xE2CA 0x7C17 #CJK UNIFIED IDEOGRAPH
+0xE2CB 0x7C0D #CJK UNIFIED IDEOGRAPH
+0xE2CC 0x7BF6 #CJK UNIFIED IDEOGRAPH
+0xE2CD 0x7C23 #CJK UNIFIED IDEOGRAPH
+0xE2CE 0x7C27 #CJK UNIFIED IDEOGRAPH
+0xE2CF 0x7C2A #CJK UNIFIED IDEOGRAPH
+0xE2D0 0x7C1F #CJK UNIFIED IDEOGRAPH
+0xE2D1 0x7C37 #CJK UNIFIED IDEOGRAPH
+0xE2D2 0x7C2B #CJK UNIFIED IDEOGRAPH
+0xE2D3 0x7C3D #CJK UNIFIED IDEOGRAPH
+0xE2D4 0x7C4C #CJK UNIFIED IDEOGRAPH
+0xE2D5 0x7C43 #CJK UNIFIED IDEOGRAPH
+0xE2D6 0x7C54 #CJK UNIFIED IDEOGRAPH
+0xE2D7 0x7C4F #CJK UNIFIED IDEOGRAPH
+0xE2D8 0x7C40 #CJK UNIFIED IDEOGRAPH
+0xE2D9 0x7C50 #CJK UNIFIED IDEOGRAPH
+0xE2DA 0x7C58 #CJK UNIFIED IDEOGRAPH
+0xE2DB 0x7C5F #CJK UNIFIED IDEOGRAPH
+0xE2DC 0x7C64 #CJK UNIFIED IDEOGRAPH
+0xE2DD 0x7C56 #CJK UNIFIED IDEOGRAPH
+0xE2DE 0x7C65 #CJK UNIFIED IDEOGRAPH
+0xE2DF 0x7C6C #CJK UNIFIED IDEOGRAPH
+0xE2E0 0x7C75 #CJK UNIFIED IDEOGRAPH
+0xE2E1 0x7C83 #CJK UNIFIED IDEOGRAPH
+0xE2E2 0x7C90 #CJK UNIFIED IDEOGRAPH
+0xE2E3 0x7CA4 #CJK UNIFIED IDEOGRAPH
+0xE2E4 0x7CAD #CJK UNIFIED IDEOGRAPH
+0xE2E5 0x7CA2 #CJK UNIFIED IDEOGRAPH
+0xE2E6 0x7CAB #CJK UNIFIED IDEOGRAPH
+0xE2E7 0x7CA1 #CJK UNIFIED IDEOGRAPH
+0xE2E8 0x7CA8 #CJK UNIFIED IDEOGRAPH
+0xE2E9 0x7CB3 #CJK UNIFIED IDEOGRAPH
+0xE2EA 0x7CB2 #CJK UNIFIED IDEOGRAPH
+0xE2EB 0x7CB1 #CJK UNIFIED IDEOGRAPH
+0xE2EC 0x7CAE #CJK UNIFIED IDEOGRAPH
+0xE2ED 0x7CB9 #CJK UNIFIED IDEOGRAPH
+0xE2EE 0x7CBD #CJK UNIFIED IDEOGRAPH
+0xE2EF 0x7CC0 #CJK UNIFIED IDEOGRAPH
+0xE2F0 0x7CC5 #CJK UNIFIED IDEOGRAPH
+0xE2F1 0x7CC2 #CJK UNIFIED IDEOGRAPH
+0xE2F2 0x7CD8 #CJK UNIFIED IDEOGRAPH
+0xE2F3 0x7CD2 #CJK UNIFIED IDEOGRAPH
+0xE2F4 0x7CDC #CJK UNIFIED IDEOGRAPH
+0xE2F5 0x7CE2 #CJK UNIFIED IDEOGRAPH
+0xE2F6 0x9B3B #CJK UNIFIED IDEOGRAPH
+0xE2F7 0x7CEF #CJK UNIFIED IDEOGRAPH
+0xE2F8 0x7CF2 #CJK UNIFIED IDEOGRAPH
+0xE2F9 0x7CF4 #CJK UNIFIED IDEOGRAPH
+0xE2FA 0x7CF6 #CJK UNIFIED IDEOGRAPH
+0xE2FB 0x7CFA #CJK UNIFIED IDEOGRAPH
+0xE2FC 0x7D06 #CJK UNIFIED IDEOGRAPH
+0xE340 0x7D02 #CJK UNIFIED IDEOGRAPH
+0xE341 0x7D1C #CJK UNIFIED IDEOGRAPH
+0xE342 0x7D15 #CJK UNIFIED IDEOGRAPH
+0xE343 0x7D0A #CJK UNIFIED IDEOGRAPH
+0xE344 0x7D45 #CJK UNIFIED IDEOGRAPH
+0xE345 0x7D4B #CJK UNIFIED IDEOGRAPH
+0xE346 0x7D2E #CJK UNIFIED IDEOGRAPH
+0xE347 0x7D32 #CJK UNIFIED IDEOGRAPH
+0xE348 0x7D3F #CJK UNIFIED IDEOGRAPH
+0xE349 0x7D35 #CJK UNIFIED IDEOGRAPH
+0xE34A 0x7D46 #CJK UNIFIED IDEOGRAPH
+0xE34B 0x7D73 #CJK UNIFIED IDEOGRAPH
+0xE34C 0x7D56 #CJK UNIFIED IDEOGRAPH
+0xE34D 0x7D4E #CJK UNIFIED IDEOGRAPH
+0xE34E 0x7D72 #CJK UNIFIED IDEOGRAPH
+0xE34F 0x7D68 #CJK UNIFIED IDEOGRAPH
+0xE350 0x7D6E #CJK UNIFIED IDEOGRAPH
+0xE351 0x7D4F #CJK UNIFIED IDEOGRAPH
+0xE352 0x7D63 #CJK UNIFIED IDEOGRAPH
+0xE353 0x7D93 #CJK UNIFIED IDEOGRAPH
+0xE354 0x7D89 #CJK UNIFIED IDEOGRAPH
+0xE355 0x7D5B #CJK UNIFIED IDEOGRAPH
+0xE356 0x7D8F #CJK UNIFIED IDEOGRAPH
+0xE357 0x7D7D #CJK UNIFIED IDEOGRAPH
+0xE358 0x7D9B #CJK UNIFIED IDEOGRAPH
+0xE359 0x7DBA #CJK UNIFIED IDEOGRAPH
+0xE35A 0x7DAE #CJK UNIFIED IDEOGRAPH
+0xE35B 0x7DA3 #CJK UNIFIED IDEOGRAPH
+0xE35C 0x7DB5 #CJK UNIFIED IDEOGRAPH
+0xE35D 0x7DC7 #CJK UNIFIED IDEOGRAPH
+0xE35E 0x7DBD #CJK UNIFIED IDEOGRAPH
+0xE35F 0x7DAB #CJK UNIFIED IDEOGRAPH
+0xE360 0x7E3D #CJK UNIFIED IDEOGRAPH
+0xE361 0x7DA2 #CJK UNIFIED IDEOGRAPH
+0xE362 0x7DAF #CJK UNIFIED IDEOGRAPH
+0xE363 0x7DDC #CJK UNIFIED IDEOGRAPH
+0xE364 0x7DB8 #CJK UNIFIED IDEOGRAPH
+0xE365 0x7D9F #CJK UNIFIED IDEOGRAPH
+0xE366 0x7DB0 #CJK UNIFIED IDEOGRAPH
+0xE367 0x7DD8 #CJK UNIFIED IDEOGRAPH
+0xE368 0x7DDD #CJK UNIFIED IDEOGRAPH
+0xE369 0x7DE4 #CJK UNIFIED IDEOGRAPH
+0xE36A 0x7DDE #CJK UNIFIED IDEOGRAPH
+0xE36B 0x7DFB #CJK UNIFIED IDEOGRAPH
+0xE36C 0x7DF2 #CJK UNIFIED IDEOGRAPH
+0xE36D 0x7DE1 #CJK UNIFIED IDEOGRAPH
+0xE36E 0x7E05 #CJK UNIFIED IDEOGRAPH
+0xE36F 0x7E0A #CJK UNIFIED IDEOGRAPH
+0xE370 0x7E23 #CJK UNIFIED IDEOGRAPH
+0xE371 0x7E21 #CJK UNIFIED IDEOGRAPH
+0xE372 0x7E12 #CJK UNIFIED IDEOGRAPH
+0xE373 0x7E31 #CJK UNIFIED IDEOGRAPH
+0xE374 0x7E1F #CJK UNIFIED IDEOGRAPH
+0xE375 0x7E09 #CJK UNIFIED IDEOGRAPH
+0xE376 0x7E0B #CJK UNIFIED IDEOGRAPH
+0xE377 0x7E22 #CJK UNIFIED IDEOGRAPH
+0xE378 0x7E46 #CJK UNIFIED IDEOGRAPH
+0xE379 0x7E66 #CJK UNIFIED IDEOGRAPH
+0xE37A 0x7E3B #CJK UNIFIED IDEOGRAPH
+0xE37B 0x7E35 #CJK UNIFIED IDEOGRAPH
+0xE37C 0x7E39 #CJK UNIFIED IDEOGRAPH
+0xE37D 0x7E43 #CJK UNIFIED IDEOGRAPH
+0xE37E 0x7E37 #CJK UNIFIED IDEOGRAPH
+0xE380 0x7E32 #CJK UNIFIED IDEOGRAPH
+0xE381 0x7E3A #CJK UNIFIED IDEOGRAPH
+0xE382 0x7E67 #CJK UNIFIED IDEOGRAPH
+0xE383 0x7E5D #CJK UNIFIED IDEOGRAPH
+0xE384 0x7E56 #CJK UNIFIED IDEOGRAPH
+0xE385 0x7E5E #CJK UNIFIED IDEOGRAPH
+0xE386 0x7E59 #CJK UNIFIED IDEOGRAPH
+0xE387 0x7E5A #CJK UNIFIED IDEOGRAPH
+0xE388 0x7E79 #CJK UNIFIED IDEOGRAPH
+0xE389 0x7E6A #CJK UNIFIED IDEOGRAPH
+0xE38A 0x7E69 #CJK UNIFIED IDEOGRAPH
+0xE38B 0x7E7C #CJK UNIFIED IDEOGRAPH
+0xE38C 0x7E7B #CJK UNIFIED IDEOGRAPH
+0xE38D 0x7E83 #CJK UNIFIED IDEOGRAPH
+0xE38E 0x7DD5 #CJK UNIFIED IDEOGRAPH
+0xE38F 0x7E7D #CJK UNIFIED IDEOGRAPH
+0xE390 0x8FAE #CJK UNIFIED IDEOGRAPH
+0xE391 0x7E7F #CJK UNIFIED IDEOGRAPH
+0xE392 0x7E88 #CJK UNIFIED IDEOGRAPH
+0xE393 0x7E89 #CJK UNIFIED IDEOGRAPH
+0xE394 0x7E8C #CJK UNIFIED IDEOGRAPH
+0xE395 0x7E92 #CJK UNIFIED IDEOGRAPH
+0xE396 0x7E90 #CJK UNIFIED IDEOGRAPH
+0xE397 0x7E93 #CJK UNIFIED IDEOGRAPH
+0xE398 0x7E94 #CJK UNIFIED IDEOGRAPH
+0xE399 0x7E96 #CJK UNIFIED IDEOGRAPH
+0xE39A 0x7E8E #CJK UNIFIED IDEOGRAPH
+0xE39B 0x7E9B #CJK UNIFIED IDEOGRAPH
+0xE39C 0x7E9C #CJK UNIFIED IDEOGRAPH
+0xE39D 0x7F38 #CJK UNIFIED IDEOGRAPH
+0xE39E 0x7F3A #CJK UNIFIED IDEOGRAPH
+0xE39F 0x7F45 #CJK UNIFIED IDEOGRAPH
+0xE3A0 0x7F4C #CJK UNIFIED IDEOGRAPH
+0xE3A1 0x7F4D #CJK UNIFIED IDEOGRAPH
+0xE3A2 0x7F4E #CJK UNIFIED IDEOGRAPH
+0xE3A3 0x7F50 #CJK UNIFIED IDEOGRAPH
+0xE3A4 0x7F51 #CJK UNIFIED IDEOGRAPH
+0xE3A5 0x7F55 #CJK UNIFIED IDEOGRAPH
+0xE3A6 0x7F54 #CJK UNIFIED IDEOGRAPH
+0xE3A7 0x7F58 #CJK UNIFIED IDEOGRAPH
+0xE3A8 0x7F5F #CJK UNIFIED IDEOGRAPH
+0xE3A9 0x7F60 #CJK UNIFIED IDEOGRAPH
+0xE3AA 0x7F68 #CJK UNIFIED IDEOGRAPH
+0xE3AB 0x7F69 #CJK UNIFIED IDEOGRAPH
+0xE3AC 0x7F67 #CJK UNIFIED IDEOGRAPH
+0xE3AD 0x7F78 #CJK UNIFIED IDEOGRAPH
+0xE3AE 0x7F82 #CJK UNIFIED IDEOGRAPH
+0xE3AF 0x7F86 #CJK UNIFIED IDEOGRAPH
+0xE3B0 0x7F83 #CJK UNIFIED IDEOGRAPH
+0xE3B1 0x7F88 #CJK UNIFIED IDEOGRAPH
+0xE3B2 0x7F87 #CJK UNIFIED IDEOGRAPH
+0xE3B3 0x7F8C #CJK UNIFIED IDEOGRAPH
+0xE3B4 0x7F94 #CJK UNIFIED IDEOGRAPH
+0xE3B5 0x7F9E #CJK UNIFIED IDEOGRAPH
+0xE3B6 0x7F9D #CJK UNIFIED IDEOGRAPH
+0xE3B7 0x7F9A #CJK UNIFIED IDEOGRAPH
+0xE3B8 0x7FA3 #CJK UNIFIED IDEOGRAPH
+0xE3B9 0x7FAF #CJK UNIFIED IDEOGRAPH
+0xE3BA 0x7FB2 #CJK UNIFIED IDEOGRAPH
+0xE3BB 0x7FB9 #CJK UNIFIED IDEOGRAPH
+0xE3BC 0x7FAE #CJK UNIFIED IDEOGRAPH
+0xE3BD 0x7FB6 #CJK UNIFIED IDEOGRAPH
+0xE3BE 0x7FB8 #CJK UNIFIED IDEOGRAPH
+0xE3BF 0x8B71 #CJK UNIFIED IDEOGRAPH
+0xE3C0 0x7FC5 #CJK UNIFIED IDEOGRAPH
+0xE3C1 0x7FC6 #CJK UNIFIED IDEOGRAPH
+0xE3C2 0x7FCA #CJK UNIFIED IDEOGRAPH
+0xE3C3 0x7FD5 #CJK UNIFIED IDEOGRAPH
+0xE3C4 0x7FD4 #CJK UNIFIED IDEOGRAPH
+0xE3C5 0x7FE1 #CJK UNIFIED IDEOGRAPH
+0xE3C6 0x7FE6 #CJK UNIFIED IDEOGRAPH
+0xE3C7 0x7FE9 #CJK UNIFIED IDEOGRAPH
+0xE3C8 0x7FF3 #CJK UNIFIED IDEOGRAPH
+0xE3C9 0x7FF9 #CJK UNIFIED IDEOGRAPH
+0xE3CA 0x98DC #CJK UNIFIED IDEOGRAPH
+0xE3CB 0x8006 #CJK UNIFIED IDEOGRAPH
+0xE3CC 0x8004 #CJK UNIFIED IDEOGRAPH
+0xE3CD 0x800B #CJK UNIFIED IDEOGRAPH
+0xE3CE 0x8012 #CJK UNIFIED IDEOGRAPH
+0xE3CF 0x8018 #CJK UNIFIED IDEOGRAPH
+0xE3D0 0x8019 #CJK UNIFIED IDEOGRAPH
+0xE3D1 0x801C #CJK UNIFIED IDEOGRAPH
+0xE3D2 0x8021 #CJK UNIFIED IDEOGRAPH
+0xE3D3 0x8028 #CJK UNIFIED IDEOGRAPH
+0xE3D4 0x803F #CJK UNIFIED IDEOGRAPH
+0xE3D5 0x803B #CJK UNIFIED IDEOGRAPH
+0xE3D6 0x804A #CJK UNIFIED IDEOGRAPH
+0xE3D7 0x8046 #CJK UNIFIED IDEOGRAPH
+0xE3D8 0x8052 #CJK UNIFIED IDEOGRAPH
+0xE3D9 0x8058 #CJK UNIFIED IDEOGRAPH
+0xE3DA 0x805A #CJK UNIFIED IDEOGRAPH
+0xE3DB 0x805F #CJK UNIFIED IDEOGRAPH
+0xE3DC 0x8062 #CJK UNIFIED IDEOGRAPH
+0xE3DD 0x8068 #CJK UNIFIED IDEOGRAPH
+0xE3DE 0x8073 #CJK UNIFIED IDEOGRAPH
+0xE3DF 0x8072 #CJK UNIFIED IDEOGRAPH
+0xE3E0 0x8070 #CJK UNIFIED IDEOGRAPH
+0xE3E1 0x8076 #CJK UNIFIED IDEOGRAPH
+0xE3E2 0x8079 #CJK UNIFIED IDEOGRAPH
+0xE3E3 0x807D #CJK UNIFIED IDEOGRAPH
+0xE3E4 0x807F #CJK UNIFIED IDEOGRAPH
+0xE3E5 0x8084 #CJK UNIFIED IDEOGRAPH
+0xE3E6 0x8086 #CJK UNIFIED IDEOGRAPH
+0xE3E7 0x8085 #CJK UNIFIED IDEOGRAPH
+0xE3E8 0x809B #CJK UNIFIED IDEOGRAPH
+0xE3E9 0x8093 #CJK UNIFIED IDEOGRAPH
+0xE3EA 0x809A #CJK UNIFIED IDEOGRAPH
+0xE3EB 0x80AD #CJK UNIFIED IDEOGRAPH
+0xE3EC 0x5190 #CJK UNIFIED IDEOGRAPH
+0xE3ED 0x80AC #CJK UNIFIED IDEOGRAPH
+0xE3EE 0x80DB #CJK UNIFIED IDEOGRAPH
+0xE3EF 0x80E5 #CJK UNIFIED IDEOGRAPH
+0xE3F0 0x80D9 #CJK UNIFIED IDEOGRAPH
+0xE3F1 0x80DD #CJK UNIFIED IDEOGRAPH
+0xE3F2 0x80C4 #CJK UNIFIED IDEOGRAPH
+0xE3F3 0x80DA #CJK UNIFIED IDEOGRAPH
+0xE3F4 0x80D6 #CJK UNIFIED IDEOGRAPH
+0xE3F5 0x8109 #CJK UNIFIED IDEOGRAPH
+0xE3F6 0x80EF #CJK UNIFIED IDEOGRAPH
+0xE3F7 0x80F1 #CJK UNIFIED IDEOGRAPH
+0xE3F8 0x811B #CJK UNIFIED IDEOGRAPH
+0xE3F9 0x8129 #CJK UNIFIED IDEOGRAPH
+0xE3FA 0x8123 #CJK UNIFIED IDEOGRAPH
+0xE3FB 0x812F #CJK UNIFIED IDEOGRAPH
+0xE3FC 0x814B #CJK UNIFIED IDEOGRAPH
+0xE440 0x968B #CJK UNIFIED IDEOGRAPH
+0xE441 0x8146 #CJK UNIFIED IDEOGRAPH
+0xE442 0x813E #CJK UNIFIED IDEOGRAPH
+0xE443 0x8153 #CJK UNIFIED IDEOGRAPH
+0xE444 0x8151 #CJK UNIFIED IDEOGRAPH
+0xE445 0x80FC #CJK UNIFIED IDEOGRAPH
+0xE446 0x8171 #CJK UNIFIED IDEOGRAPH
+0xE447 0x816E #CJK UNIFIED IDEOGRAPH
+0xE448 0x8165 #CJK UNIFIED IDEOGRAPH
+0xE449 0x8166 #CJK UNIFIED IDEOGRAPH
+0xE44A 0x8174 #CJK UNIFIED IDEOGRAPH
+0xE44B 0x8183 #CJK UNIFIED IDEOGRAPH
+0xE44C 0x8188 #CJK UNIFIED IDEOGRAPH
+0xE44D 0x818A #CJK UNIFIED IDEOGRAPH
+0xE44E 0x8180 #CJK UNIFIED IDEOGRAPH
+0xE44F 0x8182 #CJK UNIFIED IDEOGRAPH
+0xE450 0x81A0 #CJK UNIFIED IDEOGRAPH
+0xE451 0x8195 #CJK UNIFIED IDEOGRAPH
+0xE452 0x81A4 #CJK UNIFIED IDEOGRAPH
+0xE453 0x81A3 #CJK UNIFIED IDEOGRAPH
+0xE454 0x815F #CJK UNIFIED IDEOGRAPH
+0xE455 0x8193 #CJK UNIFIED IDEOGRAPH
+0xE456 0x81A9 #CJK UNIFIED IDEOGRAPH
+0xE457 0x81B0 #CJK UNIFIED IDEOGRAPH
+0xE458 0x81B5 #CJK UNIFIED IDEOGRAPH
+0xE459 0x81BE #CJK UNIFIED IDEOGRAPH
+0xE45A 0x81B8 #CJK UNIFIED IDEOGRAPH
+0xE45B 0x81BD #CJK UNIFIED IDEOGRAPH
+0xE45C 0x81C0 #CJK UNIFIED IDEOGRAPH
+0xE45D 0x81C2 #CJK UNIFIED IDEOGRAPH
+0xE45E 0x81BA #CJK UNIFIED IDEOGRAPH
+0xE45F 0x81C9 #CJK UNIFIED IDEOGRAPH
+0xE460 0x81CD #CJK UNIFIED IDEOGRAPH
+0xE461 0x81D1 #CJK UNIFIED IDEOGRAPH
+0xE462 0x81D9 #CJK UNIFIED IDEOGRAPH
+0xE463 0x81D8 #CJK UNIFIED IDEOGRAPH
+0xE464 0x81C8 #CJK UNIFIED IDEOGRAPH
+0xE465 0x81DA #CJK UNIFIED IDEOGRAPH
+0xE466 0x81DF #CJK UNIFIED IDEOGRAPH
+0xE467 0x81E0 #CJK UNIFIED IDEOGRAPH
+0xE468 0x81E7 #CJK UNIFIED IDEOGRAPH
+0xE469 0x81FA #CJK UNIFIED IDEOGRAPH
+0xE46A 0x81FB #CJK UNIFIED IDEOGRAPH
+0xE46B 0x81FE #CJK UNIFIED IDEOGRAPH
+0xE46C 0x8201 #CJK UNIFIED IDEOGRAPH
+0xE46D 0x8202 #CJK UNIFIED IDEOGRAPH
+0xE46E 0x8205 #CJK UNIFIED IDEOGRAPH
+0xE46F 0x8207 #CJK UNIFIED IDEOGRAPH
+0xE470 0x820A #CJK UNIFIED IDEOGRAPH
+0xE471 0x820D #CJK UNIFIED IDEOGRAPH
+0xE472 0x8210 #CJK UNIFIED IDEOGRAPH
+0xE473 0x8216 #CJK UNIFIED IDEOGRAPH
+0xE474 0x8229 #CJK UNIFIED IDEOGRAPH
+0xE475 0x822B #CJK UNIFIED IDEOGRAPH
+0xE476 0x8238 #CJK UNIFIED IDEOGRAPH
+0xE477 0x8233 #CJK UNIFIED IDEOGRAPH
+0xE478 0x8240 #CJK UNIFIED IDEOGRAPH
+0xE479 0x8259 #CJK UNIFIED IDEOGRAPH
+0xE47A 0x8258 #CJK UNIFIED IDEOGRAPH
+0xE47B 0x825D #CJK UNIFIED IDEOGRAPH
+0xE47C 0x825A #CJK UNIFIED IDEOGRAPH
+0xE47D 0x825F #CJK UNIFIED IDEOGRAPH
+0xE47E 0x8264 #CJK UNIFIED IDEOGRAPH
+0xE480 0x8262 #CJK UNIFIED IDEOGRAPH
+0xE481 0x8268 #CJK UNIFIED IDEOGRAPH
+0xE482 0x826A #CJK UNIFIED IDEOGRAPH
+0xE483 0x826B #CJK UNIFIED IDEOGRAPH
+0xE484 0x822E #CJK UNIFIED IDEOGRAPH
+0xE485 0x8271 #CJK UNIFIED IDEOGRAPH
+0xE486 0x8277 #CJK UNIFIED IDEOGRAPH
+0xE487 0x8278 #CJK UNIFIED IDEOGRAPH
+0xE488 0x827E #CJK UNIFIED IDEOGRAPH
+0xE489 0x828D #CJK UNIFIED IDEOGRAPH
+0xE48A 0x8292 #CJK UNIFIED IDEOGRAPH
+0xE48B 0x82AB #CJK UNIFIED IDEOGRAPH
+0xE48C 0x829F #CJK UNIFIED IDEOGRAPH
+0xE48D 0x82BB #CJK UNIFIED IDEOGRAPH
+0xE48E 0x82AC #CJK UNIFIED IDEOGRAPH
+0xE48F 0x82E1 #CJK UNIFIED IDEOGRAPH
+0xE490 0x82E3 #CJK UNIFIED IDEOGRAPH
+0xE491 0x82DF #CJK UNIFIED IDEOGRAPH
+0xE492 0x82D2 #CJK UNIFIED IDEOGRAPH
+0xE493 0x82F4 #CJK UNIFIED IDEOGRAPH
+0xE494 0x82F3 #CJK UNIFIED IDEOGRAPH
+0xE495 0x82FA #CJK UNIFIED IDEOGRAPH
+0xE496 0x8393 #CJK UNIFIED IDEOGRAPH
+0xE497 0x8303 #CJK UNIFIED IDEOGRAPH
+0xE498 0x82FB #CJK UNIFIED IDEOGRAPH
+0xE499 0x82F9 #CJK UNIFIED IDEOGRAPH
+0xE49A 0x82DE #CJK UNIFIED IDEOGRAPH
+0xE49B 0x8306 #CJK UNIFIED IDEOGRAPH
+0xE49C 0x82DC #CJK UNIFIED IDEOGRAPH
+0xE49D 0x8309 #CJK UNIFIED IDEOGRAPH
+0xE49E 0x82D9 #CJK UNIFIED IDEOGRAPH
+0xE49F 0x8335 #CJK UNIFIED IDEOGRAPH
+0xE4A0 0x8334 #CJK UNIFIED IDEOGRAPH
+0xE4A1 0x8316 #CJK UNIFIED IDEOGRAPH
+0xE4A2 0x8332 #CJK UNIFIED IDEOGRAPH
+0xE4A3 0x8331 #CJK UNIFIED IDEOGRAPH
+0xE4A4 0x8340 #CJK UNIFIED IDEOGRAPH
+0xE4A5 0x8339 #CJK UNIFIED IDEOGRAPH
+0xE4A6 0x8350 #CJK UNIFIED IDEOGRAPH
+0xE4A7 0x8345 #CJK UNIFIED IDEOGRAPH
+0xE4A8 0x832F #CJK UNIFIED IDEOGRAPH
+0xE4A9 0x832B #CJK UNIFIED IDEOGRAPH
+0xE4AA 0x8317 #CJK UNIFIED IDEOGRAPH
+0xE4AB 0x8318 #CJK UNIFIED IDEOGRAPH
+0xE4AC 0x8385 #CJK UNIFIED IDEOGRAPH
+0xE4AD 0x839A #CJK UNIFIED IDEOGRAPH
+0xE4AE 0x83AA #CJK UNIFIED IDEOGRAPH
+0xE4AF 0x839F #CJK UNIFIED IDEOGRAPH
+0xE4B0 0x83A2 #CJK UNIFIED IDEOGRAPH
+0xE4B1 0x8396 #CJK UNIFIED IDEOGRAPH
+0xE4B2 0x8323 #CJK UNIFIED IDEOGRAPH
+0xE4B3 0x838E #CJK UNIFIED IDEOGRAPH
+0xE4B4 0x8387 #CJK UNIFIED IDEOGRAPH
+0xE4B5 0x838A #CJK UNIFIED IDEOGRAPH
+0xE4B6 0x837C #CJK UNIFIED IDEOGRAPH
+0xE4B7 0x83B5 #CJK UNIFIED IDEOGRAPH
+0xE4B8 0x8373 #CJK UNIFIED IDEOGRAPH
+0xE4B9 0x8375 #CJK UNIFIED IDEOGRAPH
+0xE4BA 0x83A0 #CJK UNIFIED IDEOGRAPH
+0xE4BB 0x8389 #CJK UNIFIED IDEOGRAPH
+0xE4BC 0x83A8 #CJK UNIFIED IDEOGRAPH
+0xE4BD 0x83F4 #CJK UNIFIED IDEOGRAPH
+0xE4BE 0x8413 #CJK UNIFIED IDEOGRAPH
+0xE4BF 0x83EB #CJK UNIFIED IDEOGRAPH
+0xE4C0 0x83CE #CJK UNIFIED IDEOGRAPH
+0xE4C1 0x83FD #CJK UNIFIED IDEOGRAPH
+0xE4C2 0x8403 #CJK UNIFIED IDEOGRAPH
+0xE4C3 0x83D8 #CJK UNIFIED IDEOGRAPH
+0xE4C4 0x840B #CJK UNIFIED IDEOGRAPH
+0xE4C5 0x83C1 #CJK UNIFIED IDEOGRAPH
+0xE4C6 0x83F7 #CJK UNIFIED IDEOGRAPH
+0xE4C7 0x8407 #CJK UNIFIED IDEOGRAPH
+0xE4C8 0x83E0 #CJK UNIFIED IDEOGRAPH
+0xE4C9 0x83F2 #CJK UNIFIED IDEOGRAPH
+0xE4CA 0x840D #CJK UNIFIED IDEOGRAPH
+0xE4CB 0x8422 #CJK UNIFIED IDEOGRAPH
+0xE4CC 0x8420 #CJK UNIFIED IDEOGRAPH
+0xE4CD 0x83BD #CJK UNIFIED IDEOGRAPH
+0xE4CE 0x8438 #CJK UNIFIED IDEOGRAPH
+0xE4CF 0x8506 #CJK UNIFIED IDEOGRAPH
+0xE4D0 0x83FB #CJK UNIFIED IDEOGRAPH
+0xE4D1 0x846D #CJK UNIFIED IDEOGRAPH
+0xE4D2 0x842A #CJK UNIFIED IDEOGRAPH
+0xE4D3 0x843C #CJK UNIFIED IDEOGRAPH
+0xE4D4 0x855A #CJK UNIFIED IDEOGRAPH
+0xE4D5 0x8484 #CJK UNIFIED IDEOGRAPH
+0xE4D6 0x8477 #CJK UNIFIED IDEOGRAPH
+0xE4D7 0x846B #CJK UNIFIED IDEOGRAPH
+0xE4D8 0x84AD #CJK UNIFIED IDEOGRAPH
+0xE4D9 0x846E #CJK UNIFIED IDEOGRAPH
+0xE4DA 0x8482 #CJK UNIFIED IDEOGRAPH
+0xE4DB 0x8469 #CJK UNIFIED IDEOGRAPH
+0xE4DC 0x8446 #CJK UNIFIED IDEOGRAPH
+0xE4DD 0x842C #CJK UNIFIED IDEOGRAPH
+0xE4DE 0x846F #CJK UNIFIED IDEOGRAPH
+0xE4DF 0x8479 #CJK UNIFIED IDEOGRAPH
+0xE4E0 0x8435 #CJK UNIFIED IDEOGRAPH
+0xE4E1 0x84CA #CJK UNIFIED IDEOGRAPH
+0xE4E2 0x8462 #CJK UNIFIED IDEOGRAPH
+0xE4E3 0x84B9 #CJK UNIFIED IDEOGRAPH
+0xE4E4 0x84BF #CJK UNIFIED IDEOGRAPH
+0xE4E5 0x849F #CJK UNIFIED IDEOGRAPH
+0xE4E6 0x84D9 #CJK UNIFIED IDEOGRAPH
+0xE4E7 0x84CD #CJK UNIFIED IDEOGRAPH
+0xE4E8 0x84BB #CJK UNIFIED IDEOGRAPH
+0xE4E9 0x84DA #CJK UNIFIED IDEOGRAPH
+0xE4EA 0x84D0 #CJK UNIFIED IDEOGRAPH
+0xE4EB 0x84C1 #CJK UNIFIED IDEOGRAPH
+0xE4EC 0x84C6 #CJK UNIFIED IDEOGRAPH
+0xE4ED 0x84D6 #CJK UNIFIED IDEOGRAPH
+0xE4EE 0x84A1 #CJK UNIFIED IDEOGRAPH
+0xE4EF 0x8521 #CJK UNIFIED IDEOGRAPH
+0xE4F0 0x84FF #CJK UNIFIED IDEOGRAPH
+0xE4F1 0x84F4 #CJK UNIFIED IDEOGRAPH
+0xE4F2 0x8517 #CJK UNIFIED IDEOGRAPH
+0xE4F3 0x8518 #CJK UNIFIED IDEOGRAPH
+0xE4F4 0x852C #CJK UNIFIED IDEOGRAPH
+0xE4F5 0x851F #CJK UNIFIED IDEOGRAPH
+0xE4F6 0x8515 #CJK UNIFIED IDEOGRAPH
+0xE4F7 0x8514 #CJK UNIFIED IDEOGRAPH
+0xE4F8 0x84FC #CJK UNIFIED IDEOGRAPH
+0xE4F9 0x8540 #CJK UNIFIED IDEOGRAPH
+0xE4FA 0x8563 #CJK UNIFIED IDEOGRAPH
+0xE4FB 0x8558 #CJK UNIFIED IDEOGRAPH
+0xE4FC 0x8548 #CJK UNIFIED IDEOGRAPH
+0xE540 0x8541 #CJK UNIFIED IDEOGRAPH
+0xE541 0x8602 #CJK UNIFIED IDEOGRAPH
+0xE542 0x854B #CJK UNIFIED IDEOGRAPH
+0xE543 0x8555 #CJK UNIFIED IDEOGRAPH
+0xE544 0x8580 #CJK UNIFIED IDEOGRAPH
+0xE545 0x85A4 #CJK UNIFIED IDEOGRAPH
+0xE546 0x8588 #CJK UNIFIED IDEOGRAPH
+0xE547 0x8591 #CJK UNIFIED IDEOGRAPH
+0xE548 0x858A #CJK UNIFIED IDEOGRAPH
+0xE549 0x85A8 #CJK UNIFIED IDEOGRAPH
+0xE54A 0x856D #CJK UNIFIED IDEOGRAPH
+0xE54B 0x8594 #CJK UNIFIED IDEOGRAPH
+0xE54C 0x859B #CJK UNIFIED IDEOGRAPH
+0xE54D 0x85EA #CJK UNIFIED IDEOGRAPH
+0xE54E 0x8587 #CJK UNIFIED IDEOGRAPH
+0xE54F 0x859C #CJK UNIFIED IDEOGRAPH
+0xE550 0x8577 #CJK UNIFIED IDEOGRAPH
+0xE551 0x857E #CJK UNIFIED IDEOGRAPH
+0xE552 0x8590 #CJK UNIFIED IDEOGRAPH
+0xE553 0x85C9 #CJK UNIFIED IDEOGRAPH
+0xE554 0x85BA #CJK UNIFIED IDEOGRAPH
+0xE555 0x85CF #CJK UNIFIED IDEOGRAPH
+0xE556 0x85B9 #CJK UNIFIED IDEOGRAPH
+0xE557 0x85D0 #CJK UNIFIED IDEOGRAPH
+0xE558 0x85D5 #CJK UNIFIED IDEOGRAPH
+0xE559 0x85DD #CJK UNIFIED IDEOGRAPH
+0xE55A 0x85E5 #CJK UNIFIED IDEOGRAPH
+0xE55B 0x85DC #CJK UNIFIED IDEOGRAPH
+0xE55C 0x85F9 #CJK UNIFIED IDEOGRAPH
+0xE55D 0x860A #CJK UNIFIED IDEOGRAPH
+0xE55E 0x8613 #CJK UNIFIED IDEOGRAPH
+0xE55F 0x860B #CJK UNIFIED IDEOGRAPH
+0xE560 0x85FE #CJK UNIFIED IDEOGRAPH
+0xE561 0x85FA #CJK UNIFIED IDEOGRAPH
+0xE562 0x8606 #CJK UNIFIED IDEOGRAPH
+0xE563 0x8622 #CJK UNIFIED IDEOGRAPH
+0xE564 0x861A #CJK UNIFIED IDEOGRAPH
+0xE565 0x8630 #CJK UNIFIED IDEOGRAPH
+0xE566 0x863F #CJK UNIFIED IDEOGRAPH
+0xE567 0x864D #CJK UNIFIED IDEOGRAPH
+0xE568 0x4E55 #CJK UNIFIED IDEOGRAPH
+0xE569 0x8654 #CJK UNIFIED IDEOGRAPH
+0xE56A 0x865F #CJK UNIFIED IDEOGRAPH
+0xE56B 0x8667 #CJK UNIFIED IDEOGRAPH
+0xE56C 0x8671 #CJK UNIFIED IDEOGRAPH
+0xE56D 0x8693 #CJK UNIFIED IDEOGRAPH
+0xE56E 0x86A3 #CJK UNIFIED IDEOGRAPH
+0xE56F 0x86A9 #CJK UNIFIED IDEOGRAPH
+0xE570 0x86AA #CJK UNIFIED IDEOGRAPH
+0xE571 0x868B #CJK UNIFIED IDEOGRAPH
+0xE572 0x868C #CJK UNIFIED IDEOGRAPH
+0xE573 0x86B6 #CJK UNIFIED IDEOGRAPH
+0xE574 0x86AF #CJK UNIFIED IDEOGRAPH
+0xE575 0x86C4 #CJK UNIFIED IDEOGRAPH
+0xE576 0x86C6 #CJK UNIFIED IDEOGRAPH
+0xE577 0x86B0 #CJK UNIFIED IDEOGRAPH
+0xE578 0x86C9 #CJK UNIFIED IDEOGRAPH
+0xE579 0x8823 #CJK UNIFIED IDEOGRAPH
+0xE57A 0x86AB #CJK UNIFIED IDEOGRAPH
+0xE57B 0x86D4 #CJK UNIFIED IDEOGRAPH
+0xE57C 0x86DE #CJK UNIFIED IDEOGRAPH
+0xE57D 0x86E9 #CJK UNIFIED IDEOGRAPH
+0xE57E 0x86EC #CJK UNIFIED IDEOGRAPH
+0xE580 0x86DF #CJK UNIFIED IDEOGRAPH
+0xE581 0x86DB #CJK UNIFIED IDEOGRAPH
+0xE582 0x86EF #CJK UNIFIED IDEOGRAPH
+0xE583 0x8712 #CJK UNIFIED IDEOGRAPH
+0xE584 0x8706 #CJK UNIFIED IDEOGRAPH
+0xE585 0x8708 #CJK UNIFIED IDEOGRAPH
+0xE586 0x8700 #CJK UNIFIED IDEOGRAPH
+0xE587 0x8703 #CJK UNIFIED IDEOGRAPH
+0xE588 0x86FB #CJK UNIFIED IDEOGRAPH
+0xE589 0x8711 #CJK UNIFIED IDEOGRAPH
+0xE58A 0x8709 #CJK UNIFIED IDEOGRAPH
+0xE58B 0x870D #CJK UNIFIED IDEOGRAPH
+0xE58C 0x86F9 #CJK UNIFIED IDEOGRAPH
+0xE58D 0x870A #CJK UNIFIED IDEOGRAPH
+0xE58E 0x8734 #CJK UNIFIED IDEOGRAPH
+0xE58F 0x873F #CJK UNIFIED IDEOGRAPH
+0xE590 0x8737 #CJK UNIFIED IDEOGRAPH
+0xE591 0x873B #CJK UNIFIED IDEOGRAPH
+0xE592 0x8725 #CJK UNIFIED IDEOGRAPH
+0xE593 0x8729 #CJK UNIFIED IDEOGRAPH
+0xE594 0x871A #CJK UNIFIED IDEOGRAPH
+0xE595 0x8760 #CJK UNIFIED IDEOGRAPH
+0xE596 0x875F #CJK UNIFIED IDEOGRAPH
+0xE597 0x8778 #CJK UNIFIED IDEOGRAPH
+0xE598 0x874C #CJK UNIFIED IDEOGRAPH
+0xE599 0x874E #CJK UNIFIED IDEOGRAPH
+0xE59A 0x8774 #CJK UNIFIED IDEOGRAPH
+0xE59B 0x8757 #CJK UNIFIED IDEOGRAPH
+0xE59C 0x8768 #CJK UNIFIED IDEOGRAPH
+0xE59D 0x876E #CJK UNIFIED IDEOGRAPH
+0xE59E 0x8759 #CJK UNIFIED IDEOGRAPH
+0xE59F 0x8753 #CJK UNIFIED IDEOGRAPH
+0xE5A0 0x8763 #CJK UNIFIED IDEOGRAPH
+0xE5A1 0x876A #CJK UNIFIED IDEOGRAPH
+0xE5A2 0x8805 #CJK UNIFIED IDEOGRAPH
+0xE5A3 0x87A2 #CJK UNIFIED IDEOGRAPH
+0xE5A4 0x879F #CJK UNIFIED IDEOGRAPH
+0xE5A5 0x8782 #CJK UNIFIED IDEOGRAPH
+0xE5A6 0x87AF #CJK UNIFIED IDEOGRAPH
+0xE5A7 0x87CB #CJK UNIFIED IDEOGRAPH
+0xE5A8 0x87BD #CJK UNIFIED IDEOGRAPH
+0xE5A9 0x87C0 #CJK UNIFIED IDEOGRAPH
+0xE5AA 0x87D0 #CJK UNIFIED IDEOGRAPH
+0xE5AB 0x96D6 #CJK UNIFIED IDEOGRAPH
+0xE5AC 0x87AB #CJK UNIFIED IDEOGRAPH
+0xE5AD 0x87C4 #CJK UNIFIED IDEOGRAPH
+0xE5AE 0x87B3 #CJK UNIFIED IDEOGRAPH
+0xE5AF 0x87C7 #CJK UNIFIED IDEOGRAPH
+0xE5B0 0x87C6 #CJK UNIFIED IDEOGRAPH
+0xE5B1 0x87BB #CJK UNIFIED IDEOGRAPH
+0xE5B2 0x87EF #CJK UNIFIED IDEOGRAPH
+0xE5B3 0x87F2 #CJK UNIFIED IDEOGRAPH
+0xE5B4 0x87E0 #CJK UNIFIED IDEOGRAPH
+0xE5B5 0x880F #CJK UNIFIED IDEOGRAPH
+0xE5B6 0x880D #CJK UNIFIED IDEOGRAPH
+0xE5B7 0x87FE #CJK UNIFIED IDEOGRAPH
+0xE5B8 0x87F6 #CJK UNIFIED IDEOGRAPH
+0xE5B9 0x87F7 #CJK UNIFIED IDEOGRAPH
+0xE5BA 0x880E #CJK UNIFIED IDEOGRAPH
+0xE5BB 0x87D2 #CJK UNIFIED IDEOGRAPH
+0xE5BC 0x8811 #CJK UNIFIED IDEOGRAPH
+0xE5BD 0x8816 #CJK UNIFIED IDEOGRAPH
+0xE5BE 0x8815 #CJK UNIFIED IDEOGRAPH
+0xE5BF 0x8822 #CJK UNIFIED IDEOGRAPH
+0xE5C0 0x8821 #CJK UNIFIED IDEOGRAPH
+0xE5C1 0x8831 #CJK UNIFIED IDEOGRAPH
+0xE5C2 0x8836 #CJK UNIFIED IDEOGRAPH
+0xE5C3 0x8839 #CJK UNIFIED IDEOGRAPH
+0xE5C4 0x8827 #CJK UNIFIED IDEOGRAPH
+0xE5C5 0x883B #CJK UNIFIED IDEOGRAPH
+0xE5C6 0x8844 #CJK UNIFIED IDEOGRAPH
+0xE5C7 0x8842 #CJK UNIFIED IDEOGRAPH
+0xE5C8 0x8852 #CJK UNIFIED IDEOGRAPH
+0xE5C9 0x8859 #CJK UNIFIED IDEOGRAPH
+0xE5CA 0x885E #CJK UNIFIED IDEOGRAPH
+0xE5CB 0x8862 #CJK UNIFIED IDEOGRAPH
+0xE5CC 0x886B #CJK UNIFIED IDEOGRAPH
+0xE5CD 0x8881 #CJK UNIFIED IDEOGRAPH
+0xE5CE 0x887E #CJK UNIFIED IDEOGRAPH
+0xE5CF 0x889E #CJK UNIFIED IDEOGRAPH
+0xE5D0 0x8875 #CJK UNIFIED IDEOGRAPH
+0xE5D1 0x887D #CJK UNIFIED IDEOGRAPH
+0xE5D2 0x88B5 #CJK UNIFIED IDEOGRAPH
+0xE5D3 0x8872 #CJK UNIFIED IDEOGRAPH
+0xE5D4 0x8882 #CJK UNIFIED IDEOGRAPH
+0xE5D5 0x8897 #CJK UNIFIED IDEOGRAPH
+0xE5D6 0x8892 #CJK UNIFIED IDEOGRAPH
+0xE5D7 0x88AE #CJK UNIFIED IDEOGRAPH
+0xE5D8 0x8899 #CJK UNIFIED IDEOGRAPH
+0xE5D9 0x88A2 #CJK UNIFIED IDEOGRAPH
+0xE5DA 0x888D #CJK UNIFIED IDEOGRAPH
+0xE5DB 0x88A4 #CJK UNIFIED IDEOGRAPH
+0xE5DC 0x88B0 #CJK UNIFIED IDEOGRAPH
+0xE5DD 0x88BF #CJK UNIFIED IDEOGRAPH
+0xE5DE 0x88B1 #CJK UNIFIED IDEOGRAPH
+0xE5DF 0x88C3 #CJK UNIFIED IDEOGRAPH
+0xE5E0 0x88C4 #CJK UNIFIED IDEOGRAPH
+0xE5E1 0x88D4 #CJK UNIFIED IDEOGRAPH
+0xE5E2 0x88D8 #CJK UNIFIED IDEOGRAPH
+0xE5E3 0x88D9 #CJK UNIFIED IDEOGRAPH
+0xE5E4 0x88DD #CJK UNIFIED IDEOGRAPH
+0xE5E5 0x88F9 #CJK UNIFIED IDEOGRAPH
+0xE5E6 0x8902 #CJK UNIFIED IDEOGRAPH
+0xE5E7 0x88FC #CJK UNIFIED IDEOGRAPH
+0xE5E8 0x88F4 #CJK UNIFIED IDEOGRAPH
+0xE5E9 0x88E8 #CJK UNIFIED IDEOGRAPH
+0xE5EA 0x88F2 #CJK UNIFIED IDEOGRAPH
+0xE5EB 0x8904 #CJK UNIFIED IDEOGRAPH
+0xE5EC 0x890C #CJK UNIFIED IDEOGRAPH
+0xE5ED 0x890A #CJK UNIFIED IDEOGRAPH
+0xE5EE 0x8913 #CJK UNIFIED IDEOGRAPH
+0xE5EF 0x8943 #CJK UNIFIED IDEOGRAPH
+0xE5F0 0x891E #CJK UNIFIED IDEOGRAPH
+0xE5F1 0x8925 #CJK UNIFIED IDEOGRAPH
+0xE5F2 0x892A #CJK UNIFIED IDEOGRAPH
+0xE5F3 0x892B #CJK UNIFIED IDEOGRAPH
+0xE5F4 0x8941 #CJK UNIFIED IDEOGRAPH
+0xE5F5 0x8944 #CJK UNIFIED IDEOGRAPH
+0xE5F6 0x893B #CJK UNIFIED IDEOGRAPH
+0xE5F7 0x8936 #CJK UNIFIED IDEOGRAPH
+0xE5F8 0x8938 #CJK UNIFIED IDEOGRAPH
+0xE5F9 0x894C #CJK UNIFIED IDEOGRAPH
+0xE5FA 0x891D #CJK UNIFIED IDEOGRAPH
+0xE5FB 0x8960 #CJK UNIFIED IDEOGRAPH
+0xE5FC 0x895E #CJK UNIFIED IDEOGRAPH
+0xE640 0x8966 #CJK UNIFIED IDEOGRAPH
+0xE641 0x8964 #CJK UNIFIED IDEOGRAPH
+0xE642 0x896D #CJK UNIFIED IDEOGRAPH
+0xE643 0x896A #CJK UNIFIED IDEOGRAPH
+0xE644 0x896F #CJK UNIFIED IDEOGRAPH
+0xE645 0x8974 #CJK UNIFIED IDEOGRAPH
+0xE646 0x8977 #CJK UNIFIED IDEOGRAPH
+0xE647 0x897E #CJK UNIFIED IDEOGRAPH
+0xE648 0x8983 #CJK UNIFIED IDEOGRAPH
+0xE649 0x8988 #CJK UNIFIED IDEOGRAPH
+0xE64A 0x898A #CJK UNIFIED IDEOGRAPH
+0xE64B 0x8993 #CJK UNIFIED IDEOGRAPH
+0xE64C 0x8998 #CJK UNIFIED IDEOGRAPH
+0xE64D 0x89A1 #CJK UNIFIED IDEOGRAPH
+0xE64E 0x89A9 #CJK UNIFIED IDEOGRAPH
+0xE64F 0x89A6 #CJK UNIFIED IDEOGRAPH
+0xE650 0x89AC #CJK UNIFIED IDEOGRAPH
+0xE651 0x89AF #CJK UNIFIED IDEOGRAPH
+0xE652 0x89B2 #CJK UNIFIED IDEOGRAPH
+0xE653 0x89BA #CJK UNIFIED IDEOGRAPH
+0xE654 0x89BD #CJK UNIFIED IDEOGRAPH
+0xE655 0x89BF #CJK UNIFIED IDEOGRAPH
+0xE656 0x89C0 #CJK UNIFIED IDEOGRAPH
+0xE657 0x89DA #CJK UNIFIED IDEOGRAPH
+0xE658 0x89DC #CJK UNIFIED IDEOGRAPH
+0xE659 0x89DD #CJK UNIFIED IDEOGRAPH
+0xE65A 0x89E7 #CJK UNIFIED IDEOGRAPH
+0xE65B 0x89F4 #CJK UNIFIED IDEOGRAPH
+0xE65C 0x89F8 #CJK UNIFIED IDEOGRAPH
+0xE65D 0x8A03 #CJK UNIFIED IDEOGRAPH
+0xE65E 0x8A16 #CJK UNIFIED IDEOGRAPH
+0xE65F 0x8A10 #CJK UNIFIED IDEOGRAPH
+0xE660 0x8A0C #CJK UNIFIED IDEOGRAPH
+0xE661 0x8A1B #CJK UNIFIED IDEOGRAPH
+0xE662 0x8A1D #CJK UNIFIED IDEOGRAPH
+0xE663 0x8A25 #CJK UNIFIED IDEOGRAPH
+0xE664 0x8A36 #CJK UNIFIED IDEOGRAPH
+0xE665 0x8A41 #CJK UNIFIED IDEOGRAPH
+0xE666 0x8A5B #CJK UNIFIED IDEOGRAPH
+0xE667 0x8A52 #CJK UNIFIED IDEOGRAPH
+0xE668 0x8A46 #CJK UNIFIED IDEOGRAPH
+0xE669 0x8A48 #CJK UNIFIED IDEOGRAPH
+0xE66A 0x8A7C #CJK UNIFIED IDEOGRAPH
+0xE66B 0x8A6D #CJK UNIFIED IDEOGRAPH
+0xE66C 0x8A6C #CJK UNIFIED IDEOGRAPH
+0xE66D 0x8A62 #CJK UNIFIED IDEOGRAPH
+0xE66E 0x8A85 #CJK UNIFIED IDEOGRAPH
+0xE66F 0x8A82 #CJK UNIFIED IDEOGRAPH
+0xE670 0x8A84 #CJK UNIFIED IDEOGRAPH
+0xE671 0x8AA8 #CJK UNIFIED IDEOGRAPH
+0xE672 0x8AA1 #CJK UNIFIED IDEOGRAPH
+0xE673 0x8A91 #CJK UNIFIED IDEOGRAPH
+0xE674 0x8AA5 #CJK UNIFIED IDEOGRAPH
+0xE675 0x8AA6 #CJK UNIFIED IDEOGRAPH
+0xE676 0x8A9A #CJK UNIFIED IDEOGRAPH
+0xE677 0x8AA3 #CJK UNIFIED IDEOGRAPH
+0xE678 0x8AC4 #CJK UNIFIED IDEOGRAPH
+0xE679 0x8ACD #CJK UNIFIED IDEOGRAPH
+0xE67A 0x8AC2 #CJK UNIFIED IDEOGRAPH
+0xE67B 0x8ADA #CJK UNIFIED IDEOGRAPH
+0xE67C 0x8AEB #CJK UNIFIED IDEOGRAPH
+0xE67D 0x8AF3 #CJK UNIFIED IDEOGRAPH
+0xE67E 0x8AE7 #CJK UNIFIED IDEOGRAPH
+0xE680 0x8AE4 #CJK UNIFIED IDEOGRAPH
+0xE681 0x8AF1 #CJK UNIFIED IDEOGRAPH
+0xE682 0x8B14 #CJK UNIFIED IDEOGRAPH
+0xE683 0x8AE0 #CJK UNIFIED IDEOGRAPH
+0xE684 0x8AE2 #CJK UNIFIED IDEOGRAPH
+0xE685 0x8AF7 #CJK UNIFIED IDEOGRAPH
+0xE686 0x8ADE #CJK UNIFIED IDEOGRAPH
+0xE687 0x8ADB #CJK UNIFIED IDEOGRAPH
+0xE688 0x8B0C #CJK UNIFIED IDEOGRAPH
+0xE689 0x8B07 #CJK UNIFIED IDEOGRAPH
+0xE68A 0x8B1A #CJK UNIFIED IDEOGRAPH
+0xE68B 0x8AE1 #CJK UNIFIED IDEOGRAPH
+0xE68C 0x8B16 #CJK UNIFIED IDEOGRAPH
+0xE68D 0x8B10 #CJK UNIFIED IDEOGRAPH
+0xE68E 0x8B17 #CJK UNIFIED IDEOGRAPH
+0xE68F 0x8B20 #CJK UNIFIED IDEOGRAPH
+0xE690 0x8B33 #CJK UNIFIED IDEOGRAPH
+0xE691 0x97AB #CJK UNIFIED IDEOGRAPH
+0xE692 0x8B26 #CJK UNIFIED IDEOGRAPH
+0xE693 0x8B2B #CJK UNIFIED IDEOGRAPH
+0xE694 0x8B3E #CJK UNIFIED IDEOGRAPH
+0xE695 0x8B28 #CJK UNIFIED IDEOGRAPH
+0xE696 0x8B41 #CJK UNIFIED IDEOGRAPH
+0xE697 0x8B4C #CJK UNIFIED IDEOGRAPH
+0xE698 0x8B4F #CJK UNIFIED IDEOGRAPH
+0xE699 0x8B4E #CJK UNIFIED IDEOGRAPH
+0xE69A 0x8B49 #CJK UNIFIED IDEOGRAPH
+0xE69B 0x8B56 #CJK UNIFIED IDEOGRAPH
+0xE69C 0x8B5B #CJK UNIFIED IDEOGRAPH
+0xE69D 0x8B5A #CJK UNIFIED IDEOGRAPH
+0xE69E 0x8B6B #CJK UNIFIED IDEOGRAPH
+0xE69F 0x8B5F #CJK UNIFIED IDEOGRAPH
+0xE6A0 0x8B6C #CJK UNIFIED IDEOGRAPH
+0xE6A1 0x8B6F #CJK UNIFIED IDEOGRAPH
+0xE6A2 0x8B74 #CJK UNIFIED IDEOGRAPH
+0xE6A3 0x8B7D #CJK UNIFIED IDEOGRAPH
+0xE6A4 0x8B80 #CJK UNIFIED IDEOGRAPH
+0xE6A5 0x8B8C #CJK UNIFIED IDEOGRAPH
+0xE6A6 0x8B8E #CJK UNIFIED IDEOGRAPH
+0xE6A7 0x8B92 #CJK UNIFIED IDEOGRAPH
+0xE6A8 0x8B93 #CJK UNIFIED IDEOGRAPH
+0xE6A9 0x8B96 #CJK UNIFIED IDEOGRAPH
+0xE6AA 0x8B99 #CJK UNIFIED IDEOGRAPH
+0xE6AB 0x8B9A #CJK UNIFIED IDEOGRAPH
+0xE6AC 0x8C3A #CJK UNIFIED IDEOGRAPH
+0xE6AD 0x8C41 #CJK UNIFIED IDEOGRAPH
+0xE6AE 0x8C3F #CJK UNIFIED IDEOGRAPH
+0xE6AF 0x8C48 #CJK UNIFIED IDEOGRAPH
+0xE6B0 0x8C4C #CJK UNIFIED IDEOGRAPH
+0xE6B1 0x8C4E #CJK UNIFIED IDEOGRAPH
+0xE6B2 0x8C50 #CJK UNIFIED IDEOGRAPH
+0xE6B3 0x8C55 #CJK UNIFIED IDEOGRAPH
+0xE6B4 0x8C62 #CJK UNIFIED IDEOGRAPH
+0xE6B5 0x8C6C #CJK UNIFIED IDEOGRAPH
+0xE6B6 0x8C78 #CJK UNIFIED IDEOGRAPH
+0xE6B7 0x8C7A #CJK UNIFIED IDEOGRAPH
+0xE6B8 0x8C82 #CJK UNIFIED IDEOGRAPH
+0xE6B9 0x8C89 #CJK UNIFIED IDEOGRAPH
+0xE6BA 0x8C85 #CJK UNIFIED IDEOGRAPH
+0xE6BB 0x8C8A #CJK UNIFIED IDEOGRAPH
+0xE6BC 0x8C8D #CJK UNIFIED IDEOGRAPH
+0xE6BD 0x8C8E #CJK UNIFIED IDEOGRAPH
+0xE6BE 0x8C94 #CJK UNIFIED IDEOGRAPH
+0xE6BF 0x8C7C #CJK UNIFIED IDEOGRAPH
+0xE6C0 0x8C98 #CJK UNIFIED IDEOGRAPH
+0xE6C1 0x621D #CJK UNIFIED IDEOGRAPH
+0xE6C2 0x8CAD #CJK UNIFIED IDEOGRAPH
+0xE6C3 0x8CAA #CJK UNIFIED IDEOGRAPH
+0xE6C4 0x8CBD #CJK UNIFIED IDEOGRAPH
+0xE6C5 0x8CB2 #CJK UNIFIED IDEOGRAPH
+0xE6C6 0x8CB3 #CJK UNIFIED IDEOGRAPH
+0xE6C7 0x8CAE #CJK UNIFIED IDEOGRAPH
+0xE6C8 0x8CB6 #CJK UNIFIED IDEOGRAPH
+0xE6C9 0x8CC8 #CJK UNIFIED IDEOGRAPH
+0xE6CA 0x8CC1 #CJK UNIFIED IDEOGRAPH
+0xE6CB 0x8CE4 #CJK UNIFIED IDEOGRAPH
+0xE6CC 0x8CE3 #CJK UNIFIED IDEOGRAPH
+0xE6CD 0x8CDA #CJK UNIFIED IDEOGRAPH
+0xE6CE 0x8CFD #CJK UNIFIED IDEOGRAPH
+0xE6CF 0x8CFA #CJK UNIFIED IDEOGRAPH
+0xE6D0 0x8CFB #CJK UNIFIED IDEOGRAPH
+0xE6D1 0x8D04 #CJK UNIFIED IDEOGRAPH
+0xE6D2 0x8D05 #CJK UNIFIED IDEOGRAPH
+0xE6D3 0x8D0A #CJK UNIFIED IDEOGRAPH
+0xE6D4 0x8D07 #CJK UNIFIED IDEOGRAPH
+0xE6D5 0x8D0F #CJK UNIFIED IDEOGRAPH
+0xE6D6 0x8D0D #CJK UNIFIED IDEOGRAPH
+0xE6D7 0x8D10 #CJK UNIFIED IDEOGRAPH
+0xE6D8 0x9F4E #CJK UNIFIED IDEOGRAPH
+0xE6D9 0x8D13 #CJK UNIFIED IDEOGRAPH
+0xE6DA 0x8CCD #CJK UNIFIED IDEOGRAPH
+0xE6DB 0x8D14 #CJK UNIFIED IDEOGRAPH
+0xE6DC 0x8D16 #CJK UNIFIED IDEOGRAPH
+0xE6DD 0x8D67 #CJK UNIFIED IDEOGRAPH
+0xE6DE 0x8D6D #CJK UNIFIED IDEOGRAPH
+0xE6DF 0x8D71 #CJK UNIFIED IDEOGRAPH
+0xE6E0 0x8D73 #CJK UNIFIED IDEOGRAPH
+0xE6E1 0x8D81 #CJK UNIFIED IDEOGRAPH
+0xE6E2 0x8D99 #CJK UNIFIED IDEOGRAPH
+0xE6E3 0x8DC2 #CJK UNIFIED IDEOGRAPH
+0xE6E4 0x8DBE #CJK UNIFIED IDEOGRAPH
+0xE6E5 0x8DBA #CJK UNIFIED IDEOGRAPH
+0xE6E6 0x8DCF #CJK UNIFIED IDEOGRAPH
+0xE6E7 0x8DDA #CJK UNIFIED IDEOGRAPH
+0xE6E8 0x8DD6 #CJK UNIFIED IDEOGRAPH
+0xE6E9 0x8DCC #CJK UNIFIED IDEOGRAPH
+0xE6EA 0x8DDB #CJK UNIFIED IDEOGRAPH
+0xE6EB 0x8DCB #CJK UNIFIED IDEOGRAPH
+0xE6EC 0x8DEA #CJK UNIFIED IDEOGRAPH
+0xE6ED 0x8DEB #CJK UNIFIED IDEOGRAPH
+0xE6EE 0x8DDF #CJK UNIFIED IDEOGRAPH
+0xE6EF 0x8DE3 #CJK UNIFIED IDEOGRAPH
+0xE6F0 0x8DFC #CJK UNIFIED IDEOGRAPH
+0xE6F1 0x8E08 #CJK UNIFIED IDEOGRAPH
+0xE6F2 0x8E09 #CJK UNIFIED IDEOGRAPH
+0xE6F3 0x8DFF #CJK UNIFIED IDEOGRAPH
+0xE6F4 0x8E1D #CJK UNIFIED IDEOGRAPH
+0xE6F5 0x8E1E #CJK UNIFIED IDEOGRAPH
+0xE6F6 0x8E10 #CJK UNIFIED IDEOGRAPH
+0xE6F7 0x8E1F #CJK UNIFIED IDEOGRAPH
+0xE6F8 0x8E42 #CJK UNIFIED IDEOGRAPH
+0xE6F9 0x8E35 #CJK UNIFIED IDEOGRAPH
+0xE6FA 0x8E30 #CJK UNIFIED IDEOGRAPH
+0xE6FB 0x8E34 #CJK UNIFIED IDEOGRAPH
+0xE6FC 0x8E4A #CJK UNIFIED IDEOGRAPH
+0xE740 0x8E47 #CJK UNIFIED IDEOGRAPH
+0xE741 0x8E49 #CJK UNIFIED IDEOGRAPH
+0xE742 0x8E4C #CJK UNIFIED IDEOGRAPH
+0xE743 0x8E50 #CJK UNIFIED IDEOGRAPH
+0xE744 0x8E48 #CJK UNIFIED IDEOGRAPH
+0xE745 0x8E59 #CJK UNIFIED IDEOGRAPH
+0xE746 0x8E64 #CJK UNIFIED IDEOGRAPH
+0xE747 0x8E60 #CJK UNIFIED IDEOGRAPH
+0xE748 0x8E2A #CJK UNIFIED IDEOGRAPH
+0xE749 0x8E63 #CJK UNIFIED IDEOGRAPH
+0xE74A 0x8E55 #CJK UNIFIED IDEOGRAPH
+0xE74B 0x8E76 #CJK UNIFIED IDEOGRAPH
+0xE74C 0x8E72 #CJK UNIFIED IDEOGRAPH
+0xE74D 0x8E7C #CJK UNIFIED IDEOGRAPH
+0xE74E 0x8E81 #CJK UNIFIED IDEOGRAPH
+0xE74F 0x8E87 #CJK UNIFIED IDEOGRAPH
+0xE750 0x8E85 #CJK UNIFIED IDEOGRAPH
+0xE751 0x8E84 #CJK UNIFIED IDEOGRAPH
+0xE752 0x8E8B #CJK UNIFIED IDEOGRAPH
+0xE753 0x8E8A #CJK UNIFIED IDEOGRAPH
+0xE754 0x8E93 #CJK UNIFIED IDEOGRAPH
+0xE755 0x8E91 #CJK UNIFIED IDEOGRAPH
+0xE756 0x8E94 #CJK UNIFIED IDEOGRAPH
+0xE757 0x8E99 #CJK UNIFIED IDEOGRAPH
+0xE758 0x8EAA #CJK UNIFIED IDEOGRAPH
+0xE759 0x8EA1 #CJK UNIFIED IDEOGRAPH
+0xE75A 0x8EAC #CJK UNIFIED IDEOGRAPH
+0xE75B 0x8EB0 #CJK UNIFIED IDEOGRAPH
+0xE75C 0x8EC6 #CJK UNIFIED IDEOGRAPH
+0xE75D 0x8EB1 #CJK UNIFIED IDEOGRAPH
+0xE75E 0x8EBE #CJK UNIFIED IDEOGRAPH
+0xE75F 0x8EC5 #CJK UNIFIED IDEOGRAPH
+0xE760 0x8EC8 #CJK UNIFIED IDEOGRAPH
+0xE761 0x8ECB #CJK UNIFIED IDEOGRAPH
+0xE762 0x8EDB #CJK UNIFIED IDEOGRAPH
+0xE763 0x8EE3 #CJK UNIFIED IDEOGRAPH
+0xE764 0x8EFC #CJK UNIFIED IDEOGRAPH
+0xE765 0x8EFB #CJK UNIFIED IDEOGRAPH
+0xE766 0x8EEB #CJK UNIFIED IDEOGRAPH
+0xE767 0x8EFE #CJK UNIFIED IDEOGRAPH
+0xE768 0x8F0A #CJK UNIFIED IDEOGRAPH
+0xE769 0x8F05 #CJK UNIFIED IDEOGRAPH
+0xE76A 0x8F15 #CJK UNIFIED IDEOGRAPH
+0xE76B 0x8F12 #CJK UNIFIED IDEOGRAPH
+0xE76C 0x8F19 #CJK UNIFIED IDEOGRAPH
+0xE76D 0x8F13 #CJK UNIFIED IDEOGRAPH
+0xE76E 0x8F1C #CJK UNIFIED IDEOGRAPH
+0xE76F 0x8F1F #CJK UNIFIED IDEOGRAPH
+0xE770 0x8F1B #CJK UNIFIED IDEOGRAPH
+0xE771 0x8F0C #CJK UNIFIED IDEOGRAPH
+0xE772 0x8F26 #CJK UNIFIED IDEOGRAPH
+0xE773 0x8F33 #CJK UNIFIED IDEOGRAPH
+0xE774 0x8F3B #CJK UNIFIED IDEOGRAPH
+0xE775 0x8F39 #CJK UNIFIED IDEOGRAPH
+0xE776 0x8F45 #CJK UNIFIED IDEOGRAPH
+0xE777 0x8F42 #CJK UNIFIED IDEOGRAPH
+0xE778 0x8F3E #CJK UNIFIED IDEOGRAPH
+0xE779 0x8F4C #CJK UNIFIED IDEOGRAPH
+0xE77A 0x8F49 #CJK UNIFIED IDEOGRAPH
+0xE77B 0x8F46 #CJK UNIFIED IDEOGRAPH
+0xE77C 0x8F4E #CJK UNIFIED IDEOGRAPH
+0xE77D 0x8F57 #CJK UNIFIED IDEOGRAPH
+0xE77E 0x8F5C #CJK UNIFIED IDEOGRAPH
+0xE780 0x8F62 #CJK UNIFIED IDEOGRAPH
+0xE781 0x8F63 #CJK UNIFIED IDEOGRAPH
+0xE782 0x8F64 #CJK UNIFIED IDEOGRAPH
+0xE783 0x8F9C #CJK UNIFIED IDEOGRAPH
+0xE784 0x8F9F #CJK UNIFIED IDEOGRAPH
+0xE785 0x8FA3 #CJK UNIFIED IDEOGRAPH
+0xE786 0x8FAD #CJK UNIFIED IDEOGRAPH
+0xE787 0x8FAF #CJK UNIFIED IDEOGRAPH
+0xE788 0x8FB7 #CJK UNIFIED IDEOGRAPH
+0xE789 0x8FDA #CJK UNIFIED IDEOGRAPH
+0xE78A 0x8FE5 #CJK UNIFIED IDEOGRAPH
+0xE78B 0x8FE2 #CJK UNIFIED IDEOGRAPH
+0xE78C 0x8FEA #CJK UNIFIED IDEOGRAPH
+0xE78D 0x8FEF #CJK UNIFIED IDEOGRAPH
+0xE78E 0x9087 #CJK UNIFIED IDEOGRAPH
+0xE78F 0x8FF4 #CJK UNIFIED IDEOGRAPH
+0xE790 0x9005 #CJK UNIFIED IDEOGRAPH
+0xE791 0x8FF9 #CJK UNIFIED IDEOGRAPH
+0xE792 0x8FFA #CJK UNIFIED IDEOGRAPH
+0xE793 0x9011 #CJK UNIFIED IDEOGRAPH
+0xE794 0x9015 #CJK UNIFIED IDEOGRAPH
+0xE795 0x9021 #CJK UNIFIED IDEOGRAPH
+0xE796 0x900D #CJK UNIFIED IDEOGRAPH
+0xE797 0x901E #CJK UNIFIED IDEOGRAPH
+0xE798 0x9016 #CJK UNIFIED IDEOGRAPH
+0xE799 0x900B #CJK UNIFIED IDEOGRAPH
+0xE79A 0x9027 #CJK UNIFIED IDEOGRAPH
+0xE79B 0x9036 #CJK UNIFIED IDEOGRAPH
+0xE79C 0x9035 #CJK UNIFIED IDEOGRAPH
+0xE79D 0x9039 #CJK UNIFIED IDEOGRAPH
+0xE79E 0x8FF8 #CJK UNIFIED IDEOGRAPH
+0xE79F 0x904F #CJK UNIFIED IDEOGRAPH
+0xE7A0 0x9050 #CJK UNIFIED IDEOGRAPH
+0xE7A1 0x9051 #CJK UNIFIED IDEOGRAPH
+0xE7A2 0x9052 #CJK UNIFIED IDEOGRAPH
+0xE7A3 0x900E #CJK UNIFIED IDEOGRAPH
+0xE7A4 0x9049 #CJK UNIFIED IDEOGRAPH
+0xE7A5 0x903E #CJK UNIFIED IDEOGRAPH
+0xE7A6 0x9056 #CJK UNIFIED IDEOGRAPH
+0xE7A7 0x9058 #CJK UNIFIED IDEOGRAPH
+0xE7A8 0x905E #CJK UNIFIED IDEOGRAPH
+0xE7A9 0x9068 #CJK UNIFIED IDEOGRAPH
+0xE7AA 0x906F #CJK UNIFIED IDEOGRAPH
+0xE7AB 0x9076 #CJK UNIFIED IDEOGRAPH
+0xE7AC 0x96A8 #CJK UNIFIED IDEOGRAPH
+0xE7AD 0x9072 #CJK UNIFIED IDEOGRAPH
+0xE7AE 0x9082 #CJK UNIFIED IDEOGRAPH
+0xE7AF 0x907D #CJK UNIFIED IDEOGRAPH
+0xE7B0 0x9081 #CJK UNIFIED IDEOGRAPH
+0xE7B1 0x9080 #CJK UNIFIED IDEOGRAPH
+0xE7B2 0x908A #CJK UNIFIED IDEOGRAPH
+0xE7B3 0x9089 #CJK UNIFIED IDEOGRAPH
+0xE7B4 0x908F #CJK UNIFIED IDEOGRAPH
+0xE7B5 0x90A8 #CJK UNIFIED IDEOGRAPH
+0xE7B6 0x90AF #CJK UNIFIED IDEOGRAPH
+0xE7B7 0x90B1 #CJK UNIFIED IDEOGRAPH
+0xE7B8 0x90B5 #CJK UNIFIED IDEOGRAPH
+0xE7B9 0x90E2 #CJK UNIFIED IDEOGRAPH
+0xE7BA 0x90E4 #CJK UNIFIED IDEOGRAPH
+0xE7BB 0x6248 #CJK UNIFIED IDEOGRAPH
+0xE7BC 0x90DB #CJK UNIFIED IDEOGRAPH
+0xE7BD 0x9102 #CJK UNIFIED IDEOGRAPH
+0xE7BE 0x9112 #CJK UNIFIED IDEOGRAPH
+0xE7BF 0x9119 #CJK UNIFIED IDEOGRAPH
+0xE7C0 0x9132 #CJK UNIFIED IDEOGRAPH
+0xE7C1 0x9130 #CJK UNIFIED IDEOGRAPH
+0xE7C2 0x914A #CJK UNIFIED IDEOGRAPH
+0xE7C3 0x9156 #CJK UNIFIED IDEOGRAPH
+0xE7C4 0x9158 #CJK UNIFIED IDEOGRAPH
+0xE7C5 0x9163 #CJK UNIFIED IDEOGRAPH
+0xE7C6 0x9165 #CJK UNIFIED IDEOGRAPH
+0xE7C7 0x9169 #CJK UNIFIED IDEOGRAPH
+0xE7C8 0x9173 #CJK UNIFIED IDEOGRAPH
+0xE7C9 0x9172 #CJK UNIFIED IDEOGRAPH
+0xE7CA 0x918B #CJK UNIFIED IDEOGRAPH
+0xE7CB 0x9189 #CJK UNIFIED IDEOGRAPH
+0xE7CC 0x9182 #CJK UNIFIED IDEOGRAPH
+0xE7CD 0x91A2 #CJK UNIFIED IDEOGRAPH
+0xE7CE 0x91AB #CJK UNIFIED IDEOGRAPH
+0xE7CF 0x91AF #CJK UNIFIED IDEOGRAPH
+0xE7D0 0x91AA #CJK UNIFIED IDEOGRAPH
+0xE7D1 0x91B5 #CJK UNIFIED IDEOGRAPH
+0xE7D2 0x91B4 #CJK UNIFIED IDEOGRAPH
+0xE7D3 0x91BA #CJK UNIFIED IDEOGRAPH
+0xE7D4 0x91C0 #CJK UNIFIED IDEOGRAPH
+0xE7D5 0x91C1 #CJK UNIFIED IDEOGRAPH
+0xE7D6 0x91C9 #CJK UNIFIED IDEOGRAPH
+0xE7D7 0x91CB #CJK UNIFIED IDEOGRAPH
+0xE7D8 0x91D0 #CJK UNIFIED IDEOGRAPH
+0xE7D9 0x91D6 #CJK UNIFIED IDEOGRAPH
+0xE7DA 0x91DF #CJK UNIFIED IDEOGRAPH
+0xE7DB 0x91E1 #CJK UNIFIED IDEOGRAPH
+0xE7DC 0x91DB #CJK UNIFIED IDEOGRAPH
+0xE7DD 0x91FC #CJK UNIFIED IDEOGRAPH
+0xE7DE 0x91F5 #CJK UNIFIED IDEOGRAPH
+0xE7DF 0x91F6 #CJK UNIFIED IDEOGRAPH
+0xE7E0 0x921E #CJK UNIFIED IDEOGRAPH
+0xE7E1 0x91FF #CJK UNIFIED IDEOGRAPH
+0xE7E2 0x9214 #CJK UNIFIED IDEOGRAPH
+0xE7E3 0x922C #CJK UNIFIED IDEOGRAPH
+0xE7E4 0x9215 #CJK UNIFIED IDEOGRAPH
+0xE7E5 0x9211 #CJK UNIFIED IDEOGRAPH
+0xE7E6 0x925E #CJK UNIFIED IDEOGRAPH
+0xE7E7 0x9257 #CJK UNIFIED IDEOGRAPH
+0xE7E8 0x9245 #CJK UNIFIED IDEOGRAPH
+0xE7E9 0x9249 #CJK UNIFIED IDEOGRAPH
+0xE7EA 0x9264 #CJK UNIFIED IDEOGRAPH
+0xE7EB 0x9248 #CJK UNIFIED IDEOGRAPH
+0xE7EC 0x9295 #CJK UNIFIED IDEOGRAPH
+0xE7ED 0x923F #CJK UNIFIED IDEOGRAPH
+0xE7EE 0x924B #CJK UNIFIED IDEOGRAPH
+0xE7EF 0x9250 #CJK UNIFIED IDEOGRAPH
+0xE7F0 0x929C #CJK UNIFIED IDEOGRAPH
+0xE7F1 0x9296 #CJK UNIFIED IDEOGRAPH
+0xE7F2 0x9293 #CJK UNIFIED IDEOGRAPH
+0xE7F3 0x929B #CJK UNIFIED IDEOGRAPH
+0xE7F4 0x925A #CJK UNIFIED IDEOGRAPH
+0xE7F5 0x92CF #CJK UNIFIED IDEOGRAPH
+0xE7F6 0x92B9 #CJK UNIFIED IDEOGRAPH
+0xE7F7 0x92B7 #CJK UNIFIED IDEOGRAPH
+0xE7F8 0x92E9 #CJK UNIFIED IDEOGRAPH
+0xE7F9 0x930F #CJK UNIFIED IDEOGRAPH
+0xE7FA 0x92FA #CJK UNIFIED IDEOGRAPH
+0xE7FB 0x9344 #CJK UNIFIED IDEOGRAPH
+0xE7FC 0x932E #CJK UNIFIED IDEOGRAPH
+0xE840 0x9319 #CJK UNIFIED IDEOGRAPH
+0xE841 0x9322 #CJK UNIFIED IDEOGRAPH
+0xE842 0x931A #CJK UNIFIED IDEOGRAPH
+0xE843 0x9323 #CJK UNIFIED IDEOGRAPH
+0xE844 0x933A #CJK UNIFIED IDEOGRAPH
+0xE845 0x9335 #CJK UNIFIED IDEOGRAPH
+0xE846 0x933B #CJK UNIFIED IDEOGRAPH
+0xE847 0x935C #CJK UNIFIED IDEOGRAPH
+0xE848 0x9360 #CJK UNIFIED IDEOGRAPH
+0xE849 0x937C #CJK UNIFIED IDEOGRAPH
+0xE84A 0x936E #CJK UNIFIED IDEOGRAPH
+0xE84B 0x9356 #CJK UNIFIED IDEOGRAPH
+0xE84C 0x93B0 #CJK UNIFIED IDEOGRAPH
+0xE84D 0x93AC #CJK UNIFIED IDEOGRAPH
+0xE84E 0x93AD #CJK UNIFIED IDEOGRAPH
+0xE84F 0x9394 #CJK UNIFIED IDEOGRAPH
+0xE850 0x93B9 #CJK UNIFIED IDEOGRAPH
+0xE851 0x93D6 #CJK UNIFIED IDEOGRAPH
+0xE852 0x93D7 #CJK UNIFIED IDEOGRAPH
+0xE853 0x93E8 #CJK UNIFIED IDEOGRAPH
+0xE854 0x93E5 #CJK UNIFIED IDEOGRAPH
+0xE855 0x93D8 #CJK UNIFIED IDEOGRAPH
+0xE856 0x93C3 #CJK UNIFIED IDEOGRAPH
+0xE857 0x93DD #CJK UNIFIED IDEOGRAPH
+0xE858 0x93D0 #CJK UNIFIED IDEOGRAPH
+0xE859 0x93C8 #CJK UNIFIED IDEOGRAPH
+0xE85A 0x93E4 #CJK UNIFIED IDEOGRAPH
+0xE85B 0x941A #CJK UNIFIED IDEOGRAPH
+0xE85C 0x9414 #CJK UNIFIED IDEOGRAPH
+0xE85D 0x9413 #CJK UNIFIED IDEOGRAPH
+0xE85E 0x9403 #CJK UNIFIED IDEOGRAPH
+0xE85F 0x9407 #CJK UNIFIED IDEOGRAPH
+0xE860 0x9410 #CJK UNIFIED IDEOGRAPH
+0xE861 0x9436 #CJK UNIFIED IDEOGRAPH
+0xE862 0x942B #CJK UNIFIED IDEOGRAPH
+0xE863 0x9435 #CJK UNIFIED IDEOGRAPH
+0xE864 0x9421 #CJK UNIFIED IDEOGRAPH
+0xE865 0x943A #CJK UNIFIED IDEOGRAPH
+0xE866 0x9441 #CJK UNIFIED IDEOGRAPH
+0xE867 0x9452 #CJK UNIFIED IDEOGRAPH
+0xE868 0x9444 #CJK UNIFIED IDEOGRAPH
+0xE869 0x945B #CJK UNIFIED IDEOGRAPH
+0xE86A 0x9460 #CJK UNIFIED IDEOGRAPH
+0xE86B 0x9462 #CJK UNIFIED IDEOGRAPH
+0xE86C 0x945E #CJK UNIFIED IDEOGRAPH
+0xE86D 0x946A #CJK UNIFIED IDEOGRAPH
+0xE86E 0x9229 #CJK UNIFIED IDEOGRAPH
+0xE86F 0x9470 #CJK UNIFIED IDEOGRAPH
+0xE870 0x9475 #CJK UNIFIED IDEOGRAPH
+0xE871 0x9477 #CJK UNIFIED IDEOGRAPH
+0xE872 0x947D #CJK UNIFIED IDEOGRAPH
+0xE873 0x945A #CJK UNIFIED IDEOGRAPH
+0xE874 0x947C #CJK UNIFIED IDEOGRAPH
+0xE875 0x947E #CJK UNIFIED IDEOGRAPH
+0xE876 0x9481 #CJK UNIFIED IDEOGRAPH
+0xE877 0x947F #CJK UNIFIED IDEOGRAPH
+0xE878 0x9582 #CJK UNIFIED IDEOGRAPH
+0xE879 0x9587 #CJK UNIFIED IDEOGRAPH
+0xE87A 0x958A #CJK UNIFIED IDEOGRAPH
+0xE87B 0x9594 #CJK UNIFIED IDEOGRAPH
+0xE87C 0x9596 #CJK UNIFIED IDEOGRAPH
+0xE87D 0x9598 #CJK UNIFIED IDEOGRAPH
+0xE87E 0x9599 #CJK UNIFIED IDEOGRAPH
+0xE880 0x95A0 #CJK UNIFIED IDEOGRAPH
+0xE881 0x95A8 #CJK UNIFIED IDEOGRAPH
+0xE882 0x95A7 #CJK UNIFIED IDEOGRAPH
+0xE883 0x95AD #CJK UNIFIED IDEOGRAPH
+0xE884 0x95BC #CJK UNIFIED IDEOGRAPH
+0xE885 0x95BB #CJK UNIFIED IDEOGRAPH
+0xE886 0x95B9 #CJK UNIFIED IDEOGRAPH
+0xE887 0x95BE #CJK UNIFIED IDEOGRAPH
+0xE888 0x95CA #CJK UNIFIED IDEOGRAPH
+0xE889 0x6FF6 #CJK UNIFIED IDEOGRAPH
+0xE88A 0x95C3 #CJK UNIFIED IDEOGRAPH
+0xE88B 0x95CD #CJK UNIFIED IDEOGRAPH
+0xE88C 0x95CC #CJK UNIFIED IDEOGRAPH
+0xE88D 0x95D5 #CJK UNIFIED IDEOGRAPH
+0xE88E 0x95D4 #CJK UNIFIED IDEOGRAPH
+0xE88F 0x95D6 #CJK UNIFIED IDEOGRAPH
+0xE890 0x95DC #CJK UNIFIED IDEOGRAPH
+0xE891 0x95E1 #CJK UNIFIED IDEOGRAPH
+0xE892 0x95E5 #CJK UNIFIED IDEOGRAPH
+0xE893 0x95E2 #CJK UNIFIED IDEOGRAPH
+0xE894 0x9621 #CJK UNIFIED IDEOGRAPH
+0xE895 0x9628 #CJK UNIFIED IDEOGRAPH
+0xE896 0x962E #CJK UNIFIED IDEOGRAPH
+0xE897 0x962F #CJK UNIFIED IDEOGRAPH
+0xE898 0x9642 #CJK UNIFIED IDEOGRAPH
+0xE899 0x964C #CJK UNIFIED IDEOGRAPH
+0xE89A 0x964F #CJK UNIFIED IDEOGRAPH
+0xE89B 0x964B #CJK UNIFIED IDEOGRAPH
+0xE89C 0x9677 #CJK UNIFIED IDEOGRAPH
+0xE89D 0x965C #CJK UNIFIED IDEOGRAPH
+0xE89E 0x965E #CJK UNIFIED IDEOGRAPH
+0xE89F 0x965D #CJK UNIFIED IDEOGRAPH
+0xE8A0 0x965F #CJK UNIFIED IDEOGRAPH
+0xE8A1 0x9666 #CJK UNIFIED IDEOGRAPH
+0xE8A2 0x9672 #CJK UNIFIED IDEOGRAPH
+0xE8A3 0x966C #CJK UNIFIED IDEOGRAPH
+0xE8A4 0x968D #CJK UNIFIED IDEOGRAPH
+0xE8A5 0x9698 #CJK UNIFIED IDEOGRAPH
+0xE8A6 0x9695 #CJK UNIFIED IDEOGRAPH
+0xE8A7 0x9697 #CJK UNIFIED IDEOGRAPH
+0xE8A8 0x96AA #CJK UNIFIED IDEOGRAPH
+0xE8A9 0x96A7 #CJK UNIFIED IDEOGRAPH
+0xE8AA 0x96B1 #CJK UNIFIED IDEOGRAPH
+0xE8AB 0x96B2 #CJK UNIFIED IDEOGRAPH
+0xE8AC 0x96B0 #CJK UNIFIED IDEOGRAPH
+0xE8AD 0x96B4 #CJK UNIFIED IDEOGRAPH
+0xE8AE 0x96B6 #CJK UNIFIED IDEOGRAPH
+0xE8AF 0x96B8 #CJK UNIFIED IDEOGRAPH
+0xE8B0 0x96B9 #CJK UNIFIED IDEOGRAPH
+0xE8B1 0x96CE #CJK UNIFIED IDEOGRAPH
+0xE8B2 0x96CB #CJK UNIFIED IDEOGRAPH
+0xE8B3 0x96C9 #CJK UNIFIED IDEOGRAPH
+0xE8B4 0x96CD #CJK UNIFIED IDEOGRAPH
+0xE8B5 0x894D #CJK UNIFIED IDEOGRAPH
+0xE8B6 0x96DC #CJK UNIFIED IDEOGRAPH
+0xE8B7 0x970D #CJK UNIFIED IDEOGRAPH
+0xE8B8 0x96D5 #CJK UNIFIED IDEOGRAPH
+0xE8B9 0x96F9 #CJK UNIFIED IDEOGRAPH
+0xE8BA 0x9704 #CJK UNIFIED IDEOGRAPH
+0xE8BB 0x9706 #CJK UNIFIED IDEOGRAPH
+0xE8BC 0x9708 #CJK UNIFIED IDEOGRAPH
+0xE8BD 0x9713 #CJK UNIFIED IDEOGRAPH
+0xE8BE 0x970E #CJK UNIFIED IDEOGRAPH
+0xE8BF 0x9711 #CJK UNIFIED IDEOGRAPH
+0xE8C0 0x970F #CJK UNIFIED IDEOGRAPH
+0xE8C1 0x9716 #CJK UNIFIED IDEOGRAPH
+0xE8C2 0x9719 #CJK UNIFIED IDEOGRAPH
+0xE8C3 0x9724 #CJK UNIFIED IDEOGRAPH
+0xE8C4 0x972A #CJK UNIFIED IDEOGRAPH
+0xE8C5 0x9730 #CJK UNIFIED IDEOGRAPH
+0xE8C6 0x9739 #CJK UNIFIED IDEOGRAPH
+0xE8C7 0x973D #CJK UNIFIED IDEOGRAPH
+0xE8C8 0x973E #CJK UNIFIED IDEOGRAPH
+0xE8C9 0x9744 #CJK UNIFIED IDEOGRAPH
+0xE8CA 0x9746 #CJK UNIFIED IDEOGRAPH
+0xE8CB 0x9748 #CJK UNIFIED IDEOGRAPH
+0xE8CC 0x9742 #CJK UNIFIED IDEOGRAPH
+0xE8CD 0x9749 #CJK UNIFIED IDEOGRAPH
+0xE8CE 0x975C #CJK UNIFIED IDEOGRAPH
+0xE8CF 0x9760 #CJK UNIFIED IDEOGRAPH
+0xE8D0 0x9764 #CJK UNIFIED IDEOGRAPH
+0xE8D1 0x9766 #CJK UNIFIED IDEOGRAPH
+0xE8D2 0x9768 #CJK UNIFIED IDEOGRAPH
+0xE8D3 0x52D2 #CJK UNIFIED IDEOGRAPH
+0xE8D4 0x976B #CJK UNIFIED IDEOGRAPH
+0xE8D5 0x9771 #CJK UNIFIED IDEOGRAPH
+0xE8D6 0x9779 #CJK UNIFIED IDEOGRAPH
+0xE8D7 0x9785 #CJK UNIFIED IDEOGRAPH
+0xE8D8 0x977C #CJK UNIFIED IDEOGRAPH
+0xE8D9 0x9781 #CJK UNIFIED IDEOGRAPH
+0xE8DA 0x977A #CJK UNIFIED IDEOGRAPH
+0xE8DB 0x9786 #CJK UNIFIED IDEOGRAPH
+0xE8DC 0x978B #CJK UNIFIED IDEOGRAPH
+0xE8DD 0x978F #CJK UNIFIED IDEOGRAPH
+0xE8DE 0x9790 #CJK UNIFIED IDEOGRAPH
+0xE8DF 0x979C #CJK UNIFIED IDEOGRAPH
+0xE8E0 0x97A8 #CJK UNIFIED IDEOGRAPH
+0xE8E1 0x97A6 #CJK UNIFIED IDEOGRAPH
+0xE8E2 0x97A3 #CJK UNIFIED IDEOGRAPH
+0xE8E3 0x97B3 #CJK UNIFIED IDEOGRAPH
+0xE8E4 0x97B4 #CJK UNIFIED IDEOGRAPH
+0xE8E5 0x97C3 #CJK UNIFIED IDEOGRAPH
+0xE8E6 0x97C6 #CJK UNIFIED IDEOGRAPH
+0xE8E7 0x97C8 #CJK UNIFIED IDEOGRAPH
+0xE8E8 0x97CB #CJK UNIFIED IDEOGRAPH
+0xE8E9 0x97DC #CJK UNIFIED IDEOGRAPH
+0xE8EA 0x97ED #CJK UNIFIED IDEOGRAPH
+0xE8EB 0x9F4F #CJK UNIFIED IDEOGRAPH
+0xE8EC 0x97F2 #CJK UNIFIED IDEOGRAPH
+0xE8ED 0x7ADF #CJK UNIFIED IDEOGRAPH
+0xE8EE 0x97F6 #CJK UNIFIED IDEOGRAPH
+0xE8EF 0x97F5 #CJK UNIFIED IDEOGRAPH
+0xE8F0 0x980F #CJK UNIFIED IDEOGRAPH
+0xE8F1 0x980C #CJK UNIFIED IDEOGRAPH
+0xE8F2 0x9838 #CJK UNIFIED IDEOGRAPH
+0xE8F3 0x9824 #CJK UNIFIED IDEOGRAPH
+0xE8F4 0x9821 #CJK UNIFIED IDEOGRAPH
+0xE8F5 0x9837 #CJK UNIFIED IDEOGRAPH
+0xE8F6 0x983D #CJK UNIFIED IDEOGRAPH
+0xE8F7 0x9846 #CJK UNIFIED IDEOGRAPH
+0xE8F8 0x984F #CJK UNIFIED IDEOGRAPH
+0xE8F9 0x984B #CJK UNIFIED IDEOGRAPH
+0xE8FA 0x986B #CJK UNIFIED IDEOGRAPH
+0xE8FB 0x986F #CJK UNIFIED IDEOGRAPH
+0xE8FC 0x9870 #CJK UNIFIED IDEOGRAPH
+0xE940 0x9871 #CJK UNIFIED IDEOGRAPH
+0xE941 0x9874 #CJK UNIFIED IDEOGRAPH
+0xE942 0x9873 #CJK UNIFIED IDEOGRAPH
+0xE943 0x98AA #CJK UNIFIED IDEOGRAPH
+0xE944 0x98AF #CJK UNIFIED IDEOGRAPH
+0xE945 0x98B1 #CJK UNIFIED IDEOGRAPH
+0xE946 0x98B6 #CJK UNIFIED IDEOGRAPH
+0xE947 0x98C4 #CJK UNIFIED IDEOGRAPH
+0xE948 0x98C3 #CJK UNIFIED IDEOGRAPH
+0xE949 0x98C6 #CJK UNIFIED IDEOGRAPH
+0xE94A 0x98E9 #CJK UNIFIED IDEOGRAPH
+0xE94B 0x98EB #CJK UNIFIED IDEOGRAPH
+0xE94C 0x9903 #CJK UNIFIED IDEOGRAPH
+0xE94D 0x9909 #CJK UNIFIED IDEOGRAPH
+0xE94E 0x9912 #CJK UNIFIED IDEOGRAPH
+0xE94F 0x9914 #CJK UNIFIED IDEOGRAPH
+0xE950 0x9918 #CJK UNIFIED IDEOGRAPH
+0xE951 0x9921 #CJK UNIFIED IDEOGRAPH
+0xE952 0x991D #CJK UNIFIED IDEOGRAPH
+0xE953 0x991E #CJK UNIFIED IDEOGRAPH
+0xE954 0x9924 #CJK UNIFIED IDEOGRAPH
+0xE955 0x9920 #CJK UNIFIED IDEOGRAPH
+0xE956 0x992C #CJK UNIFIED IDEOGRAPH
+0xE957 0x992E #CJK UNIFIED IDEOGRAPH
+0xE958 0x993D #CJK UNIFIED IDEOGRAPH
+0xE959 0x993E #CJK UNIFIED IDEOGRAPH
+0xE95A 0x9942 #CJK UNIFIED IDEOGRAPH
+0xE95B 0x9949 #CJK UNIFIED IDEOGRAPH
+0xE95C 0x9945 #CJK UNIFIED IDEOGRAPH
+0xE95D 0x9950 #CJK UNIFIED IDEOGRAPH
+0xE95E 0x994B #CJK UNIFIED IDEOGRAPH
+0xE95F 0x9951 #CJK UNIFIED IDEOGRAPH
+0xE960 0x9952 #CJK UNIFIED IDEOGRAPH
+0xE961 0x994C #CJK UNIFIED IDEOGRAPH
+0xE962 0x9955 #CJK UNIFIED IDEOGRAPH
+0xE963 0x9997 #CJK UNIFIED IDEOGRAPH
+0xE964 0x9998 #CJK UNIFIED IDEOGRAPH
+0xE965 0x99A5 #CJK UNIFIED IDEOGRAPH
+0xE966 0x99AD #CJK UNIFIED IDEOGRAPH
+0xE967 0x99AE #CJK UNIFIED IDEOGRAPH
+0xE968 0x99BC #CJK UNIFIED IDEOGRAPH
+0xE969 0x99DF #CJK UNIFIED IDEOGRAPH
+0xE96A 0x99DB #CJK UNIFIED IDEOGRAPH
+0xE96B 0x99DD #CJK UNIFIED IDEOGRAPH
+0xE96C 0x99D8 #CJK UNIFIED IDEOGRAPH
+0xE96D 0x99D1 #CJK UNIFIED IDEOGRAPH
+0xE96E 0x99ED #CJK UNIFIED IDEOGRAPH
+0xE96F 0x99EE #CJK UNIFIED IDEOGRAPH
+0xE970 0x99F1 #CJK UNIFIED IDEOGRAPH
+0xE971 0x99F2 #CJK UNIFIED IDEOGRAPH
+0xE972 0x99FB #CJK UNIFIED IDEOGRAPH
+0xE973 0x99F8 #CJK UNIFIED IDEOGRAPH
+0xE974 0x9A01 #CJK UNIFIED IDEOGRAPH
+0xE975 0x9A0F #CJK UNIFIED IDEOGRAPH
+0xE976 0x9A05 #CJK UNIFIED IDEOGRAPH
+0xE977 0x99E2 #CJK UNIFIED IDEOGRAPH
+0xE978 0x9A19 #CJK UNIFIED IDEOGRAPH
+0xE979 0x9A2B #CJK UNIFIED IDEOGRAPH
+0xE97A 0x9A37 #CJK UNIFIED IDEOGRAPH
+0xE97B 0x9A45 #CJK UNIFIED IDEOGRAPH
+0xE97C 0x9A42 #CJK UNIFIED IDEOGRAPH
+0xE97D 0x9A40 #CJK UNIFIED IDEOGRAPH
+0xE97E 0x9A43 #CJK UNIFIED IDEOGRAPH
+0xE980 0x9A3E #CJK UNIFIED IDEOGRAPH
+0xE981 0x9A55 #CJK UNIFIED IDEOGRAPH
+0xE982 0x9A4D #CJK UNIFIED IDEOGRAPH
+0xE983 0x9A5B #CJK UNIFIED IDEOGRAPH
+0xE984 0x9A57 #CJK UNIFIED IDEOGRAPH
+0xE985 0x9A5F #CJK UNIFIED IDEOGRAPH
+0xE986 0x9A62 #CJK UNIFIED IDEOGRAPH
+0xE987 0x9A65 #CJK UNIFIED IDEOGRAPH
+0xE988 0x9A64 #CJK UNIFIED IDEOGRAPH
+0xE989 0x9A69 #CJK UNIFIED IDEOGRAPH
+0xE98A 0x9A6B #CJK UNIFIED IDEOGRAPH
+0xE98B 0x9A6A #CJK UNIFIED IDEOGRAPH
+0xE98C 0x9AAD #CJK UNIFIED IDEOGRAPH
+0xE98D 0x9AB0 #CJK UNIFIED IDEOGRAPH
+0xE98E 0x9ABC #CJK UNIFIED IDEOGRAPH
+0xE98F 0x9AC0 #CJK UNIFIED IDEOGRAPH
+0xE990 0x9ACF #CJK UNIFIED IDEOGRAPH
+0xE991 0x9AD1 #CJK UNIFIED IDEOGRAPH
+0xE992 0x9AD3 #CJK UNIFIED IDEOGRAPH
+0xE993 0x9AD4 #CJK UNIFIED IDEOGRAPH
+0xE994 0x9ADE #CJK UNIFIED IDEOGRAPH
+0xE995 0x9ADF #CJK UNIFIED IDEOGRAPH
+0xE996 0x9AE2 #CJK UNIFIED IDEOGRAPH
+0xE997 0x9AE3 #CJK UNIFIED IDEOGRAPH
+0xE998 0x9AE6 #CJK UNIFIED IDEOGRAPH
+0xE999 0x9AEF #CJK UNIFIED IDEOGRAPH
+0xE99A 0x9AEB #CJK UNIFIED IDEOGRAPH
+0xE99B 0x9AEE #CJK UNIFIED IDEOGRAPH
+0xE99C 0x9AF4 #CJK UNIFIED IDEOGRAPH
+0xE99D 0x9AF1 #CJK UNIFIED IDEOGRAPH
+0xE99E 0x9AF7 #CJK UNIFIED IDEOGRAPH
+0xE99F 0x9AFB #CJK UNIFIED IDEOGRAPH
+0xE9A0 0x9B06 #CJK UNIFIED IDEOGRAPH
+0xE9A1 0x9B18 #CJK UNIFIED IDEOGRAPH
+0xE9A2 0x9B1A #CJK UNIFIED IDEOGRAPH
+0xE9A3 0x9B1F #CJK UNIFIED IDEOGRAPH
+0xE9A4 0x9B22 #CJK UNIFIED IDEOGRAPH
+0xE9A5 0x9B23 #CJK UNIFIED IDEOGRAPH
+0xE9A6 0x9B25 #CJK UNIFIED IDEOGRAPH
+0xE9A7 0x9B27 #CJK UNIFIED IDEOGRAPH
+0xE9A8 0x9B28 #CJK UNIFIED IDEOGRAPH
+0xE9A9 0x9B29 #CJK UNIFIED IDEOGRAPH
+0xE9AA 0x9B2A #CJK UNIFIED IDEOGRAPH
+0xE9AB 0x9B2E #CJK UNIFIED IDEOGRAPH
+0xE9AC 0x9B2F #CJK UNIFIED IDEOGRAPH
+0xE9AD 0x9B32 #CJK UNIFIED IDEOGRAPH
+0xE9AE 0x9B44 #CJK UNIFIED IDEOGRAPH
+0xE9AF 0x9B43 #CJK UNIFIED IDEOGRAPH
+0xE9B0 0x9B4F #CJK UNIFIED IDEOGRAPH
+0xE9B1 0x9B4D #CJK UNIFIED IDEOGRAPH
+0xE9B2 0x9B4E #CJK UNIFIED IDEOGRAPH
+0xE9B3 0x9B51 #CJK UNIFIED IDEOGRAPH
+0xE9B4 0x9B58 #CJK UNIFIED IDEOGRAPH
+0xE9B5 0x9B74 #CJK UNIFIED IDEOGRAPH
+0xE9B6 0x9B93 #CJK UNIFIED IDEOGRAPH
+0xE9B7 0x9B83 #CJK UNIFIED IDEOGRAPH
+0xE9B8 0x9B91 #CJK UNIFIED IDEOGRAPH
+0xE9B9 0x9B96 #CJK UNIFIED IDEOGRAPH
+0xE9BA 0x9B97 #CJK UNIFIED IDEOGRAPH
+0xE9BB 0x9B9F #CJK UNIFIED IDEOGRAPH
+0xE9BC 0x9BA0 #CJK UNIFIED IDEOGRAPH
+0xE9BD 0x9BA8 #CJK UNIFIED IDEOGRAPH
+0xE9BE 0x9BB4 #CJK UNIFIED IDEOGRAPH
+0xE9BF 0x9BC0 #CJK UNIFIED IDEOGRAPH
+0xE9C0 0x9BCA #CJK UNIFIED IDEOGRAPH
+0xE9C1 0x9BB9 #CJK UNIFIED IDEOGRAPH
+0xE9C2 0x9BC6 #CJK UNIFIED IDEOGRAPH
+0xE9C3 0x9BCF #CJK UNIFIED IDEOGRAPH
+0xE9C4 0x9BD1 #CJK UNIFIED IDEOGRAPH
+0xE9C5 0x9BD2 #CJK UNIFIED IDEOGRAPH
+0xE9C6 0x9BE3 #CJK UNIFIED IDEOGRAPH
+0xE9C7 0x9BE2 #CJK UNIFIED IDEOGRAPH
+0xE9C8 0x9BE4 #CJK UNIFIED IDEOGRAPH
+0xE9C9 0x9BD4 #CJK UNIFIED IDEOGRAPH
+0xE9CA 0x9BE1 #CJK UNIFIED IDEOGRAPH
+0xE9CB 0x9C3A #CJK UNIFIED IDEOGRAPH
+0xE9CC 0x9BF2 #CJK UNIFIED IDEOGRAPH
+0xE9CD 0x9BF1 #CJK UNIFIED IDEOGRAPH
+0xE9CE 0x9BF0 #CJK UNIFIED IDEOGRAPH
+0xE9CF 0x9C15 #CJK UNIFIED IDEOGRAPH
+0xE9D0 0x9C14 #CJK UNIFIED IDEOGRAPH
+0xE9D1 0x9C09 #CJK UNIFIED IDEOGRAPH
+0xE9D2 0x9C13 #CJK UNIFIED IDEOGRAPH
+0xE9D3 0x9C0C #CJK UNIFIED IDEOGRAPH
+0xE9D4 0x9C06 #CJK UNIFIED IDEOGRAPH
+0xE9D5 0x9C08 #CJK UNIFIED IDEOGRAPH
+0xE9D6 0x9C12 #CJK UNIFIED IDEOGRAPH
+0xE9D7 0x9C0A #CJK UNIFIED IDEOGRAPH
+0xE9D8 0x9C04 #CJK UNIFIED IDEOGRAPH
+0xE9D9 0x9C2E #CJK UNIFIED IDEOGRAPH
+0xE9DA 0x9C1B #CJK UNIFIED IDEOGRAPH
+0xE9DB 0x9C25 #CJK UNIFIED IDEOGRAPH
+0xE9DC 0x9C24 #CJK UNIFIED IDEOGRAPH
+0xE9DD 0x9C21 #CJK UNIFIED IDEOGRAPH
+0xE9DE 0x9C30 #CJK UNIFIED IDEOGRAPH
+0xE9DF 0x9C47 #CJK UNIFIED IDEOGRAPH
+0xE9E0 0x9C32 #CJK UNIFIED IDEOGRAPH
+0xE9E1 0x9C46 #CJK UNIFIED IDEOGRAPH
+0xE9E2 0x9C3E #CJK UNIFIED IDEOGRAPH
+0xE9E3 0x9C5A #CJK UNIFIED IDEOGRAPH
+0xE9E4 0x9C60 #CJK UNIFIED IDEOGRAPH
+0xE9E5 0x9C67 #CJK UNIFIED IDEOGRAPH
+0xE9E6 0x9C76 #CJK UNIFIED IDEOGRAPH
+0xE9E7 0x9C78 #CJK UNIFIED IDEOGRAPH
+0xE9E8 0x9CE7 #CJK UNIFIED IDEOGRAPH
+0xE9E9 0x9CEC #CJK UNIFIED IDEOGRAPH
+0xE9EA 0x9CF0 #CJK UNIFIED IDEOGRAPH
+0xE9EB 0x9D09 #CJK UNIFIED IDEOGRAPH
+0xE9EC 0x9D08 #CJK UNIFIED IDEOGRAPH
+0xE9ED 0x9CEB #CJK UNIFIED IDEOGRAPH
+0xE9EE 0x9D03 #CJK UNIFIED IDEOGRAPH
+0xE9EF 0x9D06 #CJK UNIFIED IDEOGRAPH
+0xE9F0 0x9D2A #CJK UNIFIED IDEOGRAPH
+0xE9F1 0x9D26 #CJK UNIFIED IDEOGRAPH
+0xE9F2 0x9DAF #CJK UNIFIED IDEOGRAPH
+0xE9F3 0x9D23 #CJK UNIFIED IDEOGRAPH
+0xE9F4 0x9D1F #CJK UNIFIED IDEOGRAPH
+0xE9F5 0x9D44 #CJK UNIFIED IDEOGRAPH
+0xE9F6 0x9D15 #CJK UNIFIED IDEOGRAPH
+0xE9F7 0x9D12 #CJK UNIFIED IDEOGRAPH
+0xE9F8 0x9D41 #CJK UNIFIED IDEOGRAPH
+0xE9F9 0x9D3F #CJK UNIFIED IDEOGRAPH
+0xE9FA 0x9D3E #CJK UNIFIED IDEOGRAPH
+0xE9FB 0x9D46 #CJK UNIFIED IDEOGRAPH
+0xE9FC 0x9D48 #CJK UNIFIED IDEOGRAPH
+0xEA40 0x9D5D #CJK UNIFIED IDEOGRAPH
+0xEA41 0x9D5E #CJK UNIFIED IDEOGRAPH
+0xEA42 0x9D64 #CJK UNIFIED IDEOGRAPH
+0xEA43 0x9D51 #CJK UNIFIED IDEOGRAPH
+0xEA44 0x9D50 #CJK UNIFIED IDEOGRAPH
+0xEA45 0x9D59 #CJK UNIFIED IDEOGRAPH
+0xEA46 0x9D72 #CJK UNIFIED IDEOGRAPH
+0xEA47 0x9D89 #CJK UNIFIED IDEOGRAPH
+0xEA48 0x9D87 #CJK UNIFIED IDEOGRAPH
+0xEA49 0x9DAB #CJK UNIFIED IDEOGRAPH
+0xEA4A 0x9D6F #CJK UNIFIED IDEOGRAPH
+0xEA4B 0x9D7A #CJK UNIFIED IDEOGRAPH
+0xEA4C 0x9D9A #CJK UNIFIED IDEOGRAPH
+0xEA4D 0x9DA4 #CJK UNIFIED IDEOGRAPH
+0xEA4E 0x9DA9 #CJK UNIFIED IDEOGRAPH
+0xEA4F 0x9DB2 #CJK UNIFIED IDEOGRAPH
+0xEA50 0x9DC4 #CJK UNIFIED IDEOGRAPH
+0xEA51 0x9DC1 #CJK UNIFIED IDEOGRAPH
+0xEA52 0x9DBB #CJK UNIFIED IDEOGRAPH
+0xEA53 0x9DB8 #CJK UNIFIED IDEOGRAPH
+0xEA54 0x9DBA #CJK UNIFIED IDEOGRAPH
+0xEA55 0x9DC6 #CJK UNIFIED IDEOGRAPH
+0xEA56 0x9DCF #CJK UNIFIED IDEOGRAPH
+0xEA57 0x9DC2 #CJK UNIFIED IDEOGRAPH
+0xEA58 0x9DD9 #CJK UNIFIED IDEOGRAPH
+0xEA59 0x9DD3 #CJK UNIFIED IDEOGRAPH
+0xEA5A 0x9DF8 #CJK UNIFIED IDEOGRAPH
+0xEA5B 0x9DE6 #CJK UNIFIED IDEOGRAPH
+0xEA5C 0x9DED #CJK UNIFIED IDEOGRAPH
+0xEA5D 0x9DEF #CJK UNIFIED IDEOGRAPH
+0xEA5E 0x9DFD #CJK UNIFIED IDEOGRAPH
+0xEA5F 0x9E1A #CJK UNIFIED IDEOGRAPH
+0xEA60 0x9E1B #CJK UNIFIED IDEOGRAPH
+0xEA61 0x9E1E #CJK UNIFIED IDEOGRAPH
+0xEA62 0x9E75 #CJK UNIFIED IDEOGRAPH
+0xEA63 0x9E79 #CJK UNIFIED IDEOGRAPH
+0xEA64 0x9E7D #CJK UNIFIED IDEOGRAPH
+0xEA65 0x9E81 #CJK UNIFIED IDEOGRAPH
+0xEA66 0x9E88 #CJK UNIFIED IDEOGRAPH
+0xEA67 0x9E8B #CJK UNIFIED IDEOGRAPH
+0xEA68 0x9E8C #CJK UNIFIED IDEOGRAPH
+0xEA69 0x9E92 #CJK UNIFIED IDEOGRAPH
+0xEA6A 0x9E95 #CJK UNIFIED IDEOGRAPH
+0xEA6B 0x9E91 #CJK UNIFIED IDEOGRAPH
+0xEA6C 0x9E9D #CJK UNIFIED IDEOGRAPH
+0xEA6D 0x9EA5 #CJK UNIFIED IDEOGRAPH
+0xEA6E 0x9EA9 #CJK UNIFIED IDEOGRAPH
+0xEA6F 0x9EB8 #CJK UNIFIED IDEOGRAPH
+0xEA70 0x9EAA #CJK UNIFIED IDEOGRAPH
+0xEA71 0x9EAD #CJK UNIFIED IDEOGRAPH
+0xEA72 0x9761 #CJK UNIFIED IDEOGRAPH
+0xEA73 0x9ECC #CJK UNIFIED IDEOGRAPH
+0xEA74 0x9ECE #CJK UNIFIED IDEOGRAPH
+0xEA75 0x9ECF #CJK UNIFIED IDEOGRAPH
+0xEA76 0x9ED0 #CJK UNIFIED IDEOGRAPH
+0xEA77 0x9ED4 #CJK UNIFIED IDEOGRAPH
+0xEA78 0x9EDC #CJK UNIFIED IDEOGRAPH
+0xEA79 0x9EDE #CJK UNIFIED IDEOGRAPH
+0xEA7A 0x9EDD #CJK UNIFIED IDEOGRAPH
+0xEA7B 0x9EE0 #CJK UNIFIED IDEOGRAPH
+0xEA7C 0x9EE5 #CJK UNIFIED IDEOGRAPH
+0xEA7D 0x9EE8 #CJK UNIFIED IDEOGRAPH
+0xEA7E 0x9EEF #CJK UNIFIED IDEOGRAPH
+0xEA80 0x9EF4 #CJK UNIFIED IDEOGRAPH
+0xEA81 0x9EF6 #CJK UNIFIED IDEOGRAPH
+0xEA82 0x9EF7 #CJK UNIFIED IDEOGRAPH
+0xEA83 0x9EF9 #CJK UNIFIED IDEOGRAPH
+0xEA84 0x9EFB #CJK UNIFIED IDEOGRAPH
+0xEA85 0x9EFC #CJK UNIFIED IDEOGRAPH
+0xEA86 0x9EFD #CJK UNIFIED IDEOGRAPH
+0xEA87 0x9F07 #CJK UNIFIED IDEOGRAPH
+0xEA88 0x9F08 #CJK UNIFIED IDEOGRAPH
+0xEA89 0x76B7 #CJK UNIFIED IDEOGRAPH
+0xEA8A 0x9F15 #CJK UNIFIED IDEOGRAPH
+0xEA8B 0x9F21 #CJK UNIFIED IDEOGRAPH
+0xEA8C 0x9F2C #CJK UNIFIED IDEOGRAPH
+0xEA8D 0x9F3E #CJK UNIFIED IDEOGRAPH
+0xEA8E 0x9F4A #CJK UNIFIED IDEOGRAPH
+0xEA8F 0x9F52 #CJK UNIFIED IDEOGRAPH
+0xEA90 0x9F54 #CJK UNIFIED IDEOGRAPH
+0xEA91 0x9F63 #CJK UNIFIED IDEOGRAPH
+0xEA92 0x9F5F #CJK UNIFIED IDEOGRAPH
+0xEA93 0x9F60 #CJK UNIFIED IDEOGRAPH
+0xEA94 0x9F61 #CJK UNIFIED IDEOGRAPH
+0xEA95 0x9F66 #CJK UNIFIED IDEOGRAPH
+0xEA96 0x9F67 #CJK UNIFIED IDEOGRAPH
+0xEA97 0x9F6C #CJK UNIFIED IDEOGRAPH
+0xEA98 0x9F6A #CJK UNIFIED IDEOGRAPH
+0xEA99 0x9F77 #CJK UNIFIED IDEOGRAPH
+0xEA9A 0x9F72 #CJK UNIFIED IDEOGRAPH
+0xEA9B 0x9F76 #CJK UNIFIED IDEOGRAPH
+0xEA9C 0x9F95 #CJK UNIFIED IDEOGRAPH
+0xEA9D 0x9F9C #CJK UNIFIED IDEOGRAPH
+0xEA9E 0x9FA0 #CJK UNIFIED IDEOGRAPH
+0xEA9F 0x582F #CJK UNIFIED IDEOGRAPH
+0xEAA0 0x69C7 #CJK UNIFIED IDEOGRAPH
+0xEAA1 0x9059 #CJK UNIFIED IDEOGRAPH
+0xEAA2 0x7464 #CJK UNIFIED IDEOGRAPH
+0xEAA3 0x51DC #CJK UNIFIED IDEOGRAPH
+0xEAA4 0x7199 #CJK UNIFIED IDEOGRAPH
+0xED40 0x7E8A #CJK UNIFIED IDEOGRAPH
+0xED41 0x891C #CJK UNIFIED IDEOGRAPH
+0xED42 0x9348 #CJK UNIFIED IDEOGRAPH
+0xED43 0x9288 #CJK UNIFIED IDEOGRAPH
+0xED44 0x84DC #CJK UNIFIED IDEOGRAPH
+0xED45 0x4FC9 #CJK UNIFIED IDEOGRAPH
+0xED46 0x70BB #CJK UNIFIED IDEOGRAPH
+0xED47 0x6631 #CJK UNIFIED IDEOGRAPH
+0xED48 0x68C8 #CJK UNIFIED IDEOGRAPH
+0xED49 0x92F9 #CJK UNIFIED IDEOGRAPH
+0xED4A 0x66FB #CJK UNIFIED IDEOGRAPH
+0xED4B 0x5F45 #CJK UNIFIED IDEOGRAPH
+0xED4C 0x4E28 #CJK UNIFIED IDEOGRAPH
+0xED4D 0x4EE1 #CJK UNIFIED IDEOGRAPH
+0xED4E 0x4EFC #CJK UNIFIED IDEOGRAPH
+0xED4F 0x4F00 #CJK UNIFIED IDEOGRAPH
+0xED50 0x4F03 #CJK UNIFIED IDEOGRAPH
+0xED51 0x4F39 #CJK UNIFIED IDEOGRAPH
+0xED52 0x4F56 #CJK UNIFIED IDEOGRAPH
+0xED53 0x4F92 #CJK UNIFIED IDEOGRAPH
+0xED54 0x4F8A #CJK UNIFIED IDEOGRAPH
+0xED55 0x4F9A #CJK UNIFIED IDEOGRAPH
+0xED56 0x4F94 #CJK UNIFIED IDEOGRAPH
+0xED57 0x4FCD #CJK UNIFIED IDEOGRAPH
+0xED58 0x5040 #CJK UNIFIED IDEOGRAPH
+0xED59 0x5022 #CJK UNIFIED IDEOGRAPH
+0xED5A 0x4FFF #CJK UNIFIED IDEOGRAPH
+0xED5B 0x501E #CJK UNIFIED IDEOGRAPH
+0xED5C 0x5046 #CJK UNIFIED IDEOGRAPH
+0xED5D 0x5070 #CJK UNIFIED IDEOGRAPH
+0xED5E 0x5042 #CJK UNIFIED IDEOGRAPH
+0xED5F 0x5094 #CJK UNIFIED IDEOGRAPH
+0xED60 0x50F4 #CJK UNIFIED IDEOGRAPH
+0xED61 0x50D8 #CJK UNIFIED IDEOGRAPH
+0xED62 0x514A #CJK UNIFIED IDEOGRAPH
+0xED63 0x5164 #CJK UNIFIED IDEOGRAPH
+0xED64 0x519D #CJK UNIFIED IDEOGRAPH
+0xED65 0x51BE #CJK UNIFIED IDEOGRAPH
+0xED66 0x51EC #CJK UNIFIED IDEOGRAPH
+0xED67 0x5215 #CJK UNIFIED IDEOGRAPH
+0xED68 0x529C #CJK UNIFIED IDEOGRAPH
+0xED69 0x52A6 #CJK UNIFIED IDEOGRAPH
+0xED6A 0x52C0 #CJK UNIFIED IDEOGRAPH
+0xED6B 0x52DB #CJK UNIFIED IDEOGRAPH
+0xED6C 0x5300 #CJK UNIFIED IDEOGRAPH
+0xED6D 0x5307 #CJK UNIFIED IDEOGRAPH
+0xED6E 0x5324 #CJK UNIFIED IDEOGRAPH
+0xED6F 0x5372 #CJK UNIFIED IDEOGRAPH
+0xED70 0x5393 #CJK UNIFIED IDEOGRAPH
+0xED71 0x53B2 #CJK UNIFIED IDEOGRAPH
+0xED72 0x53DD #CJK UNIFIED IDEOGRAPH
+0xED73 0xFA0E #CJK COMPATIBILITY IDEOGRAPH
+0xED74 0x549C #CJK UNIFIED IDEOGRAPH
+0xED75 0x548A #CJK UNIFIED IDEOGRAPH
+0xED76 0x54A9 #CJK UNIFIED IDEOGRAPH
+0xED77 0x54FF #CJK UNIFIED IDEOGRAPH
+0xED78 0x5586 #CJK UNIFIED IDEOGRAPH
+0xED79 0x5759 #CJK UNIFIED IDEOGRAPH
+0xED7A 0x5765 #CJK UNIFIED IDEOGRAPH
+0xED7B 0x57AC #CJK UNIFIED IDEOGRAPH
+0xED7C 0x57C8 #CJK UNIFIED IDEOGRAPH
+0xED7D 0x57C7 #CJK UNIFIED IDEOGRAPH
+0xED7E 0xFA0F #CJK COMPATIBILITY IDEOGRAPH
+0xED80 0xFA10 #CJK COMPATIBILITY IDEOGRAPH
+0xED81 0x589E #CJK UNIFIED IDEOGRAPH
+0xED82 0x58B2 #CJK UNIFIED IDEOGRAPH
+0xED83 0x590B #CJK UNIFIED IDEOGRAPH
+0xED84 0x5953 #CJK UNIFIED IDEOGRAPH
+0xED85 0x595B #CJK UNIFIED IDEOGRAPH
+0xED86 0x595D #CJK UNIFIED IDEOGRAPH
+0xED87 0x5963 #CJK UNIFIED IDEOGRAPH
+0xED88 0x59A4 #CJK UNIFIED IDEOGRAPH
+0xED89 0x59BA #CJK UNIFIED IDEOGRAPH
+0xED8A 0x5B56 #CJK UNIFIED IDEOGRAPH
+0xED8B 0x5BC0 #CJK UNIFIED IDEOGRAPH
+0xED8C 0x752F #CJK UNIFIED IDEOGRAPH
+0xED8D 0x5BD8 #CJK UNIFIED IDEOGRAPH
+0xED8E 0x5BEC #CJK UNIFIED IDEOGRAPH
+0xED8F 0x5C1E #CJK UNIFIED IDEOGRAPH
+0xED90 0x5CA6 #CJK UNIFIED IDEOGRAPH
+0xED91 0x5CBA #CJK UNIFIED IDEOGRAPH
+0xED92 0x5CF5 #CJK UNIFIED IDEOGRAPH
+0xED93 0x5D27 #CJK UNIFIED IDEOGRAPH
+0xED94 0x5D53 #CJK UNIFIED IDEOGRAPH
+0xED95 0xFA11 #CJK COMPATIBILITY IDEOGRAPH
+0xED96 0x5D42 #CJK UNIFIED IDEOGRAPH
+0xED97 0x5D6D #CJK UNIFIED IDEOGRAPH
+0xED98 0x5DB8 #CJK UNIFIED IDEOGRAPH
+0xED99 0x5DB9 #CJK UNIFIED IDEOGRAPH
+0xED9A 0x5DD0 #CJK UNIFIED IDEOGRAPH
+0xED9B 0x5F21 #CJK UNIFIED IDEOGRAPH
+0xED9C 0x5F34 #CJK UNIFIED IDEOGRAPH
+0xED9D 0x5F67 #CJK UNIFIED IDEOGRAPH
+0xED9E 0x5FB7 #CJK UNIFIED IDEOGRAPH
+0xED9F 0x5FDE #CJK UNIFIED IDEOGRAPH
+0xEDA0 0x605D #CJK UNIFIED IDEOGRAPH
+0xEDA1 0x6085 #CJK UNIFIED IDEOGRAPH
+0xEDA2 0x608A #CJK UNIFIED IDEOGRAPH
+0xEDA3 0x60DE #CJK UNIFIED IDEOGRAPH
+0xEDA4 0x60D5 #CJK UNIFIED IDEOGRAPH
+0xEDA5 0x6120 #CJK UNIFIED IDEOGRAPH
+0xEDA6 0x60F2 #CJK UNIFIED IDEOGRAPH
+0xEDA7 0x6111 #CJK UNIFIED IDEOGRAPH
+0xEDA8 0x6137 #CJK UNIFIED IDEOGRAPH
+0xEDA9 0x6130 #CJK UNIFIED IDEOGRAPH
+0xEDAA 0x6198 #CJK UNIFIED IDEOGRAPH
+0xEDAB 0x6213 #CJK UNIFIED IDEOGRAPH
+0xEDAC 0x62A6 #CJK UNIFIED IDEOGRAPH
+0xEDAD 0x63F5 #CJK UNIFIED IDEOGRAPH
+0xEDAE 0x6460 #CJK UNIFIED IDEOGRAPH
+0xEDAF 0x649D #CJK UNIFIED IDEOGRAPH
+0xEDB0 0x64CE #CJK UNIFIED IDEOGRAPH
+0xEDB1 0x654E #CJK UNIFIED IDEOGRAPH
+0xEDB2 0x6600 #CJK UNIFIED IDEOGRAPH
+0xEDB3 0x6615 #CJK UNIFIED IDEOGRAPH
+0xEDB4 0x663B #CJK UNIFIED IDEOGRAPH
+0xEDB5 0x6609 #CJK UNIFIED IDEOGRAPH
+0xEDB6 0x662E #CJK UNIFIED IDEOGRAPH
+0xEDB7 0x661E #CJK UNIFIED IDEOGRAPH
+0xEDB8 0x6624 #CJK UNIFIED IDEOGRAPH
+0xEDB9 0x6665 #CJK UNIFIED IDEOGRAPH
+0xEDBA 0x6657 #CJK UNIFIED IDEOGRAPH
+0xEDBB 0x6659 #CJK UNIFIED IDEOGRAPH
+0xEDBC 0xFA12 #CJK COMPATIBILITY IDEOGRAPH
+0xEDBD 0x6673 #CJK UNIFIED IDEOGRAPH
+0xEDBE 0x6699 #CJK UNIFIED IDEOGRAPH
+0xEDBF 0x66A0 #CJK UNIFIED IDEOGRAPH
+0xEDC0 0x66B2 #CJK UNIFIED IDEOGRAPH
+0xEDC1 0x66BF #CJK UNIFIED IDEOGRAPH
+0xEDC2 0x66FA #CJK UNIFIED IDEOGRAPH
+0xEDC3 0x670E #CJK UNIFIED IDEOGRAPH
+0xEDC4 0xF929 #CJK COMPATIBILITY IDEOGRAPH
+0xEDC5 0x6766 #CJK UNIFIED IDEOGRAPH
+0xEDC6 0x67BB #CJK UNIFIED IDEOGRAPH
+0xEDC7 0x6852 #CJK UNIFIED IDEOGRAPH
+0xEDC8 0x67C0 #CJK UNIFIED IDEOGRAPH
+0xEDC9 0x6801 #CJK UNIFIED IDEOGRAPH
+0xEDCA 0x6844 #CJK UNIFIED IDEOGRAPH
+0xEDCB 0x68CF #CJK UNIFIED IDEOGRAPH
+0xEDCC 0xFA13 #CJK COMPATIBILITY IDEOGRAPH
+0xEDCD 0x6968 #CJK UNIFIED IDEOGRAPH
+0xEDCE 0xFA14 #CJK COMPATIBILITY IDEOGRAPH
+0xEDCF 0x6998 #CJK UNIFIED IDEOGRAPH
+0xEDD0 0x69E2 #CJK UNIFIED IDEOGRAPH
+0xEDD1 0x6A30 #CJK UNIFIED IDEOGRAPH
+0xEDD2 0x6A6B #CJK UNIFIED IDEOGRAPH
+0xEDD3 0x6A46 #CJK UNIFIED IDEOGRAPH
+0xEDD4 0x6A73 #CJK UNIFIED IDEOGRAPH
+0xEDD5 0x6A7E #CJK UNIFIED IDEOGRAPH
+0xEDD6 0x6AE2 #CJK UNIFIED IDEOGRAPH
+0xEDD7 0x6AE4 #CJK UNIFIED IDEOGRAPH
+0xEDD8 0x6BD6 #CJK UNIFIED IDEOGRAPH
+0xEDD9 0x6C3F #CJK UNIFIED IDEOGRAPH
+0xEDDA 0x6C5C #CJK UNIFIED IDEOGRAPH
+0xEDDB 0x6C86 #CJK UNIFIED IDEOGRAPH
+0xEDDC 0x6C6F #CJK UNIFIED IDEOGRAPH
+0xEDDD 0x6CDA #CJK UNIFIED IDEOGRAPH
+0xEDDE 0x6D04 #CJK UNIFIED IDEOGRAPH
+0xEDDF 0x6D87 #CJK UNIFIED IDEOGRAPH
+0xEDE0 0x6D6F #CJK UNIFIED IDEOGRAPH
+0xEDE1 0x6D96 #CJK UNIFIED IDEOGRAPH
+0xEDE2 0x6DAC #CJK UNIFIED IDEOGRAPH
+0xEDE3 0x6DCF #CJK UNIFIED IDEOGRAPH
+0xEDE4 0x6DF8 #CJK UNIFIED IDEOGRAPH
+0xEDE5 0x6DF2 #CJK UNIFIED IDEOGRAPH
+0xEDE6 0x6DFC #CJK UNIFIED IDEOGRAPH
+0xEDE7 0x6E39 #CJK UNIFIED IDEOGRAPH
+0xEDE8 0x6E5C #CJK UNIFIED IDEOGRAPH
+0xEDE9 0x6E27 #CJK UNIFIED IDEOGRAPH
+0xEDEA 0x6E3C #CJK UNIFIED IDEOGRAPH
+0xEDEB 0x6EBF #CJK UNIFIED IDEOGRAPH
+0xEDEC 0x6F88 #CJK UNIFIED IDEOGRAPH
+0xEDED 0x6FB5 #CJK UNIFIED IDEOGRAPH
+0xEDEE 0x6FF5 #CJK UNIFIED IDEOGRAPH
+0xEDEF 0x7005 #CJK UNIFIED IDEOGRAPH
+0xEDF0 0x7007 #CJK UNIFIED IDEOGRAPH
+0xEDF1 0x7028 #CJK UNIFIED IDEOGRAPH
+0xEDF2 0x7085 #CJK UNIFIED IDEOGRAPH
+0xEDF3 0x70AB #CJK UNIFIED IDEOGRAPH
+0xEDF4 0x710F #CJK UNIFIED IDEOGRAPH
+0xEDF5 0x7104 #CJK UNIFIED IDEOGRAPH
+0xEDF6 0x715C #CJK UNIFIED IDEOGRAPH
+0xEDF7 0x7146 #CJK UNIFIED IDEOGRAPH
+0xEDF8 0x7147 #CJK UNIFIED IDEOGRAPH
+0xEDF9 0xFA15 #CJK COMPATIBILITY IDEOGRAPH
+0xEDFA 0x71C1 #CJK UNIFIED IDEOGRAPH
+0xEDFB 0x71FE #CJK UNIFIED IDEOGRAPH
+0xEDFC 0x72B1 #CJK UNIFIED IDEOGRAPH
+0xEE40 0x72BE #CJK UNIFIED IDEOGRAPH
+0xEE41 0x7324 #CJK UNIFIED IDEOGRAPH
+0xEE42 0xFA16 #CJK COMPATIBILITY IDEOGRAPH
+0xEE43 0x7377 #CJK UNIFIED IDEOGRAPH
+0xEE44 0x73BD #CJK UNIFIED IDEOGRAPH
+0xEE45 0x73C9 #CJK UNIFIED IDEOGRAPH
+0xEE46 0x73D6 #CJK UNIFIED IDEOGRAPH
+0xEE47 0x73E3 #CJK UNIFIED IDEOGRAPH
+0xEE48 0x73D2 #CJK UNIFIED IDEOGRAPH
+0xEE49 0x7407 #CJK UNIFIED IDEOGRAPH
+0xEE4A 0x73F5 #CJK UNIFIED IDEOGRAPH
+0xEE4B 0x7426 #CJK UNIFIED IDEOGRAPH
+0xEE4C 0x742A #CJK UNIFIED IDEOGRAPH
+0xEE4D 0x7429 #CJK UNIFIED IDEOGRAPH
+0xEE4E 0x742E #CJK UNIFIED IDEOGRAPH
+0xEE4F 0x7462 #CJK UNIFIED IDEOGRAPH
+0xEE50 0x7489 #CJK UNIFIED IDEOGRAPH
+0xEE51 0x749F #CJK UNIFIED IDEOGRAPH
+0xEE52 0x7501 #CJK UNIFIED IDEOGRAPH
+0xEE53 0x756F #CJK UNIFIED IDEOGRAPH
+0xEE54 0x7682 #CJK UNIFIED IDEOGRAPH
+0xEE55 0x769C #CJK UNIFIED IDEOGRAPH
+0xEE56 0x769E #CJK UNIFIED IDEOGRAPH
+0xEE57 0x769B #CJK UNIFIED IDEOGRAPH
+0xEE58 0x76A6 #CJK UNIFIED IDEOGRAPH
+0xEE59 0xFA17 #CJK COMPATIBILITY IDEOGRAPH
+0xEE5A 0x7746 #CJK UNIFIED IDEOGRAPH
+0xEE5B 0x52AF #CJK UNIFIED IDEOGRAPH
+0xEE5C 0x7821 #CJK UNIFIED IDEOGRAPH
+0xEE5D 0x784E #CJK UNIFIED IDEOGRAPH
+0xEE5E 0x7864 #CJK UNIFIED IDEOGRAPH
+0xEE5F 0x787A #CJK UNIFIED IDEOGRAPH
+0xEE60 0x7930 #CJK UNIFIED IDEOGRAPH
+0xEE61 0xFA18 #CJK COMPATIBILITY IDEOGRAPH
+0xEE62 0xFA19 #CJK COMPATIBILITY IDEOGRAPH
+0xEE63 0xFA1A #CJK COMPATIBILITY IDEOGRAPH
+0xEE64 0x7994 #CJK UNIFIED IDEOGRAPH
+0xEE65 0xFA1B #CJK COMPATIBILITY IDEOGRAPH
+0xEE66 0x799B #CJK UNIFIED IDEOGRAPH
+0xEE67 0x7AD1 #CJK UNIFIED IDEOGRAPH
+0xEE68 0x7AE7 #CJK UNIFIED IDEOGRAPH
+0xEE69 0xFA1C #CJK COMPATIBILITY IDEOGRAPH
+0xEE6A 0x7AEB #CJK UNIFIED IDEOGRAPH
+0xEE6B 0x7B9E #CJK UNIFIED IDEOGRAPH
+0xEE6C 0xFA1D #CJK COMPATIBILITY IDEOGRAPH
+0xEE6D 0x7D48 #CJK UNIFIED IDEOGRAPH
+0xEE6E 0x7D5C #CJK UNIFIED IDEOGRAPH
+0xEE6F 0x7DB7 #CJK UNIFIED IDEOGRAPH
+0xEE70 0x7DA0 #CJK UNIFIED IDEOGRAPH
+0xEE71 0x7DD6 #CJK UNIFIED IDEOGRAPH
+0xEE72 0x7E52 #CJK UNIFIED IDEOGRAPH
+0xEE73 0x7F47 #CJK UNIFIED IDEOGRAPH
+0xEE74 0x7FA1 #CJK UNIFIED IDEOGRAPH
+0xEE75 0xFA1E #CJK COMPATIBILITY IDEOGRAPH
+0xEE76 0x8301 #CJK UNIFIED IDEOGRAPH
+0xEE77 0x8362 #CJK UNIFIED IDEOGRAPH
+0xEE78 0x837F #CJK UNIFIED IDEOGRAPH
+0xEE79 0x83C7 #CJK UNIFIED IDEOGRAPH
+0xEE7A 0x83F6 #CJK UNIFIED IDEOGRAPH
+0xEE7B 0x8448 #CJK UNIFIED IDEOGRAPH
+0xEE7C 0x84B4 #CJK UNIFIED IDEOGRAPH
+0xEE7D 0x8553 #CJK UNIFIED IDEOGRAPH
+0xEE7E 0x8559 #CJK UNIFIED IDEOGRAPH
+0xEE80 0x856B #CJK UNIFIED IDEOGRAPH
+0xEE81 0xFA1F #CJK COMPATIBILITY IDEOGRAPH
+0xEE82 0x85B0 #CJK UNIFIED IDEOGRAPH
+0xEE83 0xFA20 #CJK COMPATIBILITY IDEOGRAPH
+0xEE84 0xFA21 #CJK COMPATIBILITY IDEOGRAPH
+0xEE85 0x8807 #CJK UNIFIED IDEOGRAPH
+0xEE86 0x88F5 #CJK UNIFIED IDEOGRAPH
+0xEE87 0x8A12 #CJK UNIFIED IDEOGRAPH
+0xEE88 0x8A37 #CJK UNIFIED IDEOGRAPH
+0xEE89 0x8A79 #CJK UNIFIED IDEOGRAPH
+0xEE8A 0x8AA7 #CJK UNIFIED IDEOGRAPH
+0xEE8B 0x8ABE #CJK UNIFIED IDEOGRAPH
+0xEE8C 0x8ADF #CJK UNIFIED IDEOGRAPH
+0xEE8D 0xFA22 #CJK COMPATIBILITY IDEOGRAPH
+0xEE8E 0x8AF6 #CJK UNIFIED IDEOGRAPH
+0xEE8F 0x8B53 #CJK UNIFIED IDEOGRAPH
+0xEE90 0x8B7F #CJK UNIFIED IDEOGRAPH
+0xEE91 0x8CF0 #CJK UNIFIED IDEOGRAPH
+0xEE92 0x8CF4 #CJK UNIFIED IDEOGRAPH
+0xEE93 0x8D12 #CJK UNIFIED IDEOGRAPH
+0xEE94 0x8D76 #CJK UNIFIED IDEOGRAPH
+0xEE95 0xFA23 #CJK COMPATIBILITY IDEOGRAPH
+0xEE96 0x8ECF #CJK UNIFIED IDEOGRAPH
+0xEE97 0xFA24 #CJK COMPATIBILITY IDEOGRAPH
+0xEE98 0xFA25 #CJK COMPATIBILITY IDEOGRAPH
+0xEE99 0x9067 #CJK UNIFIED IDEOGRAPH
+0xEE9A 0x90DE #CJK UNIFIED IDEOGRAPH
+0xEE9B 0xFA26 #CJK COMPATIBILITY IDEOGRAPH
+0xEE9C 0x9115 #CJK UNIFIED IDEOGRAPH
+0xEE9D 0x9127 #CJK UNIFIED IDEOGRAPH
+0xEE9E 0x91DA #CJK UNIFIED IDEOGRAPH
+0xEE9F 0x91D7 #CJK UNIFIED IDEOGRAPH
+0xEEA0 0x91DE #CJK UNIFIED IDEOGRAPH
+0xEEA1 0x91ED #CJK UNIFIED IDEOGRAPH
+0xEEA2 0x91EE #CJK UNIFIED IDEOGRAPH
+0xEEA3 0x91E4 #CJK UNIFIED IDEOGRAPH
+0xEEA4 0x91E5 #CJK UNIFIED IDEOGRAPH
+0xEEA5 0x9206 #CJK UNIFIED IDEOGRAPH
+0xEEA6 0x9210 #CJK UNIFIED IDEOGRAPH
+0xEEA7 0x920A #CJK UNIFIED IDEOGRAPH
+0xEEA8 0x923A #CJK UNIFIED IDEOGRAPH
+0xEEA9 0x9240 #CJK UNIFIED IDEOGRAPH
+0xEEAA 0x923C #CJK UNIFIED IDEOGRAPH
+0xEEAB 0x924E #CJK UNIFIED IDEOGRAPH
+0xEEAC 0x9259 #CJK UNIFIED IDEOGRAPH
+0xEEAD 0x9251 #CJK UNIFIED IDEOGRAPH
+0xEEAE 0x9239 #CJK UNIFIED IDEOGRAPH
+0xEEAF 0x9267 #CJK UNIFIED IDEOGRAPH
+0xEEB0 0x92A7 #CJK UNIFIED IDEOGRAPH
+0xEEB1 0x9277 #CJK UNIFIED IDEOGRAPH
+0xEEB2 0x9278 #CJK UNIFIED IDEOGRAPH
+0xEEB3 0x92E7 #CJK UNIFIED IDEOGRAPH
+0xEEB4 0x92D7 #CJK UNIFIED IDEOGRAPH
+0xEEB5 0x92D9 #CJK UNIFIED IDEOGRAPH
+0xEEB6 0x92D0 #CJK UNIFIED IDEOGRAPH
+0xEEB7 0xFA27 #CJK COMPATIBILITY IDEOGRAPH
+0xEEB8 0x92D5 #CJK UNIFIED IDEOGRAPH
+0xEEB9 0x92E0 #CJK UNIFIED IDEOGRAPH
+0xEEBA 0x92D3 #CJK UNIFIED IDEOGRAPH
+0xEEBB 0x9325 #CJK UNIFIED IDEOGRAPH
+0xEEBC 0x9321 #CJK UNIFIED IDEOGRAPH
+0xEEBD 0x92FB #CJK UNIFIED IDEOGRAPH
+0xEEBE 0xFA28 #CJK COMPATIBILITY IDEOGRAPH
+0xEEBF 0x931E #CJK UNIFIED IDEOGRAPH
+0xEEC0 0x92FF #CJK UNIFIED IDEOGRAPH
+0xEEC1 0x931D #CJK UNIFIED IDEOGRAPH
+0xEEC2 0x9302 #CJK UNIFIED IDEOGRAPH
+0xEEC3 0x9370 #CJK UNIFIED IDEOGRAPH
+0xEEC4 0x9357 #CJK UNIFIED IDEOGRAPH
+0xEEC5 0x93A4 #CJK UNIFIED IDEOGRAPH
+0xEEC6 0x93C6 #CJK UNIFIED IDEOGRAPH
+0xEEC7 0x93DE #CJK UNIFIED IDEOGRAPH
+0xEEC8 0x93F8 #CJK UNIFIED IDEOGRAPH
+0xEEC9 0x9431 #CJK UNIFIED IDEOGRAPH
+0xEECA 0x9445 #CJK UNIFIED IDEOGRAPH
+0xEECB 0x9448 #CJK UNIFIED IDEOGRAPH
+0xEECC 0x9592 #CJK UNIFIED IDEOGRAPH
+0xEECD 0xF9DC #CJK COMPATIBILITY IDEOGRAPH
+0xEECE 0xFA29 #CJK COMPATIBILITY IDEOGRAPH
+0xEECF 0x969D #CJK UNIFIED IDEOGRAPH
+0xEED0 0x96AF #CJK UNIFIED IDEOGRAPH
+0xEED1 0x9733 #CJK UNIFIED IDEOGRAPH
+0xEED2 0x973B #CJK UNIFIED IDEOGRAPH
+0xEED3 0x9743 #CJK UNIFIED IDEOGRAPH
+0xEED4 0x974D #CJK UNIFIED IDEOGRAPH
+0xEED5 0x974F #CJK UNIFIED IDEOGRAPH
+0xEED6 0x9751 #CJK UNIFIED IDEOGRAPH
+0xEED7 0x9755 #CJK UNIFIED IDEOGRAPH
+0xEED8 0x9857 #CJK UNIFIED IDEOGRAPH
+0xEED9 0x9865 #CJK UNIFIED IDEOGRAPH
+0xEEDA 0xFA2A #CJK COMPATIBILITY IDEOGRAPH
+0xEEDB 0xFA2B #CJK COMPATIBILITY IDEOGRAPH
+0xEEDC 0x9927 #CJK UNIFIED IDEOGRAPH
+0xEEDD 0xFA2C #CJK COMPATIBILITY IDEOGRAPH
+0xEEDE 0x999E #CJK UNIFIED IDEOGRAPH
+0xEEDF 0x9A4E #CJK UNIFIED IDEOGRAPH
+0xEEE0 0x9AD9 #CJK UNIFIED IDEOGRAPH
+0xEEE1 0x9ADC #CJK UNIFIED IDEOGRAPH
+0xEEE2 0x9B75 #CJK UNIFIED IDEOGRAPH
+0xEEE3 0x9B72 #CJK UNIFIED IDEOGRAPH
+0xEEE4 0x9B8F #CJK UNIFIED IDEOGRAPH
+0xEEE5 0x9BB1 #CJK UNIFIED IDEOGRAPH
+0xEEE6 0x9BBB #CJK UNIFIED IDEOGRAPH
+0xEEE7 0x9C00 #CJK UNIFIED IDEOGRAPH
+0xEEE8 0x9D70 #CJK UNIFIED IDEOGRAPH
+0xEEE9 0x9D6B #CJK UNIFIED IDEOGRAPH
+0xEEEA 0xFA2D #CJK COMPATIBILITY IDEOGRAPH
+0xEEEB 0x9E19 #CJK UNIFIED IDEOGRAPH
+0xEEEC 0x9ED1 #CJK UNIFIED IDEOGRAPH
+0xEEEF 0x2170 #SMALL ROMAN NUMERAL ONE
+0xEEF0 0x2171 #SMALL ROMAN NUMERAL TWO
+0xEEF1 0x2172 #SMALL ROMAN NUMERAL THREE
+0xEEF2 0x2173 #SMALL ROMAN NUMERAL FOUR
+0xEEF3 0x2174 #SMALL ROMAN NUMERAL FIVE
+0xEEF4 0x2175 #SMALL ROMAN NUMERAL SIX
+0xEEF5 0x2176 #SMALL ROMAN NUMERAL SEVEN
+0xEEF6 0x2177 #SMALL ROMAN NUMERAL EIGHT
+0xEEF7 0x2178 #SMALL ROMAN NUMERAL NINE
+0xEEF8 0x2179 #SMALL ROMAN NUMERAL TEN
+0xEEF9 0xFFE2 #FULLWIDTH NOT SIGN
+0xEEFA 0xFFE4 #FULLWIDTH BROKEN BAR
+0xEEFB 0xFF07 #FULLWIDTH APOSTROPHE
+0xEEFC 0xFF02 #FULLWIDTH QUOTATION MARK
+0xFA40 0x2170 #SMALL ROMAN NUMERAL ONE
+0xFA41 0x2171 #SMALL ROMAN NUMERAL TWO
+0xFA42 0x2172 #SMALL ROMAN NUMERAL THREE
+0xFA43 0x2173 #SMALL ROMAN NUMERAL FOUR
+0xFA44 0x2174 #SMALL ROMAN NUMERAL FIVE
+0xFA45 0x2175 #SMALL ROMAN NUMERAL SIX
+0xFA46 0x2176 #SMALL ROMAN NUMERAL SEVEN
+0xFA47 0x2177 #SMALL ROMAN NUMERAL EIGHT
+0xFA48 0x2178 #SMALL ROMAN NUMERAL NINE
+0xFA49 0x2179 #SMALL ROMAN NUMERAL TEN
+0xFA4A 0x2160 #ROMAN NUMERAL ONE
+0xFA4B 0x2161 #ROMAN NUMERAL TWO
+0xFA4C 0x2162 #ROMAN NUMERAL THREE
+0xFA4D 0x2163 #ROMAN NUMERAL FOUR
+0xFA4E 0x2164 #ROMAN NUMERAL FIVE
+0xFA4F 0x2165 #ROMAN NUMERAL SIX
+0xFA50 0x2166 #ROMAN NUMERAL SEVEN
+0xFA51 0x2167 #ROMAN NUMERAL EIGHT
+0xFA52 0x2168 #ROMAN NUMERAL NINE
+0xFA53 0x2169 #ROMAN NUMERAL TEN
+0xFA54 0xFFE2 #FULLWIDTH NOT SIGN
+0xFA55 0xFFE4 #FULLWIDTH BROKEN BAR
+0xFA56 0xFF07 #FULLWIDTH APOSTROPHE
+0xFA57 0xFF02 #FULLWIDTH QUOTATION MARK
+0xFA58 0x3231 #PARENTHESIZED IDEOGRAPH STOCK
+0xFA59 0x2116 #NUMERO SIGN
+0xFA5A 0x2121 #TELEPHONE SIGN
+0xFA5B 0x2235 #BECAUSE
+0xFA5C 0x7E8A #CJK UNIFIED IDEOGRAPH
+0xFA5D 0x891C #CJK UNIFIED IDEOGRAPH
+0xFA5E 0x9348 #CJK UNIFIED IDEOGRAPH
+0xFA5F 0x9288 #CJK UNIFIED IDEOGRAPH
+0xFA60 0x84DC #CJK UNIFIED IDEOGRAPH
+0xFA61 0x4FC9 #CJK UNIFIED IDEOGRAPH
+0xFA62 0x70BB #CJK UNIFIED IDEOGRAPH
+0xFA63 0x6631 #CJK UNIFIED IDEOGRAPH
+0xFA64 0x68C8 #CJK UNIFIED IDEOGRAPH
+0xFA65 0x92F9 #CJK UNIFIED IDEOGRAPH
+0xFA66 0x66FB #CJK UNIFIED IDEOGRAPH
+0xFA67 0x5F45 #CJK UNIFIED IDEOGRAPH
+0xFA68 0x4E28 #CJK UNIFIED IDEOGRAPH
+0xFA69 0x4EE1 #CJK UNIFIED IDEOGRAPH
+0xFA6A 0x4EFC #CJK UNIFIED IDEOGRAPH
+0xFA6B 0x4F00 #CJK UNIFIED IDEOGRAPH
+0xFA6C 0x4F03 #CJK UNIFIED IDEOGRAPH
+0xFA6D 0x4F39 #CJK UNIFIED IDEOGRAPH
+0xFA6E 0x4F56 #CJK UNIFIED IDEOGRAPH
+0xFA6F 0x4F92 #CJK UNIFIED IDEOGRAPH
+0xFA70 0x4F8A #CJK UNIFIED IDEOGRAPH
+0xFA71 0x4F9A #CJK UNIFIED IDEOGRAPH
+0xFA72 0x4F94 #CJK UNIFIED IDEOGRAPH
+0xFA73 0x4FCD #CJK UNIFIED IDEOGRAPH
+0xFA74 0x5040 #CJK UNIFIED IDEOGRAPH
+0xFA75 0x5022 #CJK UNIFIED IDEOGRAPH
+0xFA76 0x4FFF #CJK UNIFIED IDEOGRAPH
+0xFA77 0x501E #CJK UNIFIED IDEOGRAPH
+0xFA78 0x5046 #CJK UNIFIED IDEOGRAPH
+0xFA79 0x5070 #CJK UNIFIED IDEOGRAPH
+0xFA7A 0x5042 #CJK UNIFIED IDEOGRAPH
+0xFA7B 0x5094 #CJK UNIFIED IDEOGRAPH
+0xFA7C 0x50F4 #CJK UNIFIED IDEOGRAPH
+0xFA7D 0x50D8 #CJK UNIFIED IDEOGRAPH
+0xFA7E 0x514A #CJK UNIFIED IDEOGRAPH
+0xFA80 0x5164 #CJK UNIFIED IDEOGRAPH
+0xFA81 0x519D #CJK UNIFIED IDEOGRAPH
+0xFA82 0x51BE #CJK UNIFIED IDEOGRAPH
+0xFA83 0x51EC #CJK UNIFIED IDEOGRAPH
+0xFA84 0x5215 #CJK UNIFIED IDEOGRAPH
+0xFA85 0x529C #CJK UNIFIED IDEOGRAPH
+0xFA86 0x52A6 #CJK UNIFIED IDEOGRAPH
+0xFA87 0x52C0 #CJK UNIFIED IDEOGRAPH
+0xFA88 0x52DB #CJK UNIFIED IDEOGRAPH
+0xFA89 0x5300 #CJK UNIFIED IDEOGRAPH
+0xFA8A 0x5307 #CJK UNIFIED IDEOGRAPH
+0xFA8B 0x5324 #CJK UNIFIED IDEOGRAPH
+0xFA8C 0x5372 #CJK UNIFIED IDEOGRAPH
+0xFA8D 0x5393 #CJK UNIFIED IDEOGRAPH
+0xFA8E 0x53B2 #CJK UNIFIED IDEOGRAPH
+0xFA8F 0x53DD #CJK UNIFIED IDEOGRAPH
+0xFA90 0xFA0E #CJK COMPATIBILITY IDEOGRAPH
+0xFA91 0x549C #CJK UNIFIED IDEOGRAPH
+0xFA92 0x548A #CJK UNIFIED IDEOGRAPH
+0xFA93 0x54A9 #CJK UNIFIED IDEOGRAPH
+0xFA94 0x54FF #CJK UNIFIED IDEOGRAPH
+0xFA95 0x5586 #CJK UNIFIED IDEOGRAPH
+0xFA96 0x5759 #CJK UNIFIED IDEOGRAPH
+0xFA97 0x5765 #CJK UNIFIED IDEOGRAPH
+0xFA98 0x57AC #CJK UNIFIED IDEOGRAPH
+0xFA99 0x57C8 #CJK UNIFIED IDEOGRAPH
+0xFA9A 0x57C7 #CJK UNIFIED IDEOGRAPH
+0xFA9B 0xFA0F #CJK COMPATIBILITY IDEOGRAPH
+0xFA9C 0xFA10 #CJK COMPATIBILITY IDEOGRAPH
+0xFA9D 0x589E #CJK UNIFIED IDEOGRAPH
+0xFA9E 0x58B2 #CJK UNIFIED IDEOGRAPH
+0xFA9F 0x590B #CJK UNIFIED IDEOGRAPH
+0xFAA0 0x5953 #CJK UNIFIED IDEOGRAPH
+0xFAA1 0x595B #CJK UNIFIED IDEOGRAPH
+0xFAA2 0x595D #CJK UNIFIED IDEOGRAPH
+0xFAA3 0x5963 #CJK UNIFIED IDEOGRAPH
+0xFAA4 0x59A4 #CJK UNIFIED IDEOGRAPH
+0xFAA5 0x59BA #CJK UNIFIED IDEOGRAPH
+0xFAA6 0x5B56 #CJK UNIFIED IDEOGRAPH
+0xFAA7 0x5BC0 #CJK UNIFIED IDEOGRAPH
+0xFAA8 0x752F #CJK UNIFIED IDEOGRAPH
+0xFAA9 0x5BD8 #CJK UNIFIED IDEOGRAPH
+0xFAAA 0x5BEC #CJK UNIFIED IDEOGRAPH
+0xFAAB 0x5C1E #CJK UNIFIED IDEOGRAPH
+0xFAAC 0x5CA6 #CJK UNIFIED IDEOGRAPH
+0xFAAD 0x5CBA #CJK UNIFIED IDEOGRAPH
+0xFAAE 0x5CF5 #CJK UNIFIED IDEOGRAPH
+0xFAAF 0x5D27 #CJK UNIFIED IDEOGRAPH
+0xFAB0 0x5D53 #CJK UNIFIED IDEOGRAPH
+0xFAB1 0xFA11 #CJK COMPATIBILITY IDEOGRAPH
+0xFAB2 0x5D42 #CJK UNIFIED IDEOGRAPH
+0xFAB3 0x5D6D #CJK UNIFIED IDEOGRAPH
+0xFAB4 0x5DB8 #CJK UNIFIED IDEOGRAPH
+0xFAB5 0x5DB9 #CJK UNIFIED IDEOGRAPH
+0xFAB6 0x5DD0 #CJK UNIFIED IDEOGRAPH
+0xFAB7 0x5F21 #CJK UNIFIED IDEOGRAPH
+0xFAB8 0x5F34 #CJK UNIFIED IDEOGRAPH
+0xFAB9 0x5F67 #CJK UNIFIED IDEOGRAPH
+0xFABA 0x5FB7 #CJK UNIFIED IDEOGRAPH
+0xFABB 0x5FDE #CJK UNIFIED IDEOGRAPH
+0xFABC 0x605D #CJK UNIFIED IDEOGRAPH
+0xFABD 0x6085 #CJK UNIFIED IDEOGRAPH
+0xFABE 0x608A #CJK UNIFIED IDEOGRAPH
+0xFABF 0x60DE #CJK UNIFIED IDEOGRAPH
+0xFAC0 0x60D5 #CJK UNIFIED IDEOGRAPH
+0xFAC1 0x6120 #CJK UNIFIED IDEOGRAPH
+0xFAC2 0x60F2 #CJK UNIFIED IDEOGRAPH
+0xFAC3 0x6111 #CJK UNIFIED IDEOGRAPH
+0xFAC4 0x6137 #CJK UNIFIED IDEOGRAPH
+0xFAC5 0x6130 #CJK UNIFIED IDEOGRAPH
+0xFAC6 0x6198 #CJK UNIFIED IDEOGRAPH
+0xFAC7 0x6213 #CJK UNIFIED IDEOGRAPH
+0xFAC8 0x62A6 #CJK UNIFIED IDEOGRAPH
+0xFAC9 0x63F5 #CJK UNIFIED IDEOGRAPH
+0xFACA 0x6460 #CJK UNIFIED IDEOGRAPH
+0xFACB 0x649D #CJK UNIFIED IDEOGRAPH
+0xFACC 0x64CE #CJK UNIFIED IDEOGRAPH
+0xFACD 0x654E #CJK UNIFIED IDEOGRAPH
+0xFACE 0x6600 #CJK UNIFIED IDEOGRAPH
+0xFACF 0x6615 #CJK UNIFIED IDEOGRAPH
+0xFAD0 0x663B #CJK UNIFIED IDEOGRAPH
+0xFAD1 0x6609 #CJK UNIFIED IDEOGRAPH
+0xFAD2 0x662E #CJK UNIFIED IDEOGRAPH
+0xFAD3 0x661E #CJK UNIFIED IDEOGRAPH
+0xFAD4 0x6624 #CJK UNIFIED IDEOGRAPH
+0xFAD5 0x6665 #CJK UNIFIED IDEOGRAPH
+0xFAD6 0x6657 #CJK UNIFIED IDEOGRAPH
+0xFAD7 0x6659 #CJK UNIFIED IDEOGRAPH
+0xFAD8 0xFA12 #CJK COMPATIBILITY IDEOGRAPH
+0xFAD9 0x6673 #CJK UNIFIED IDEOGRAPH
+0xFADA 0x6699 #CJK UNIFIED IDEOGRAPH
+0xFADB 0x66A0 #CJK UNIFIED IDEOGRAPH
+0xFADC 0x66B2 #CJK UNIFIED IDEOGRAPH
+0xFADD 0x66BF #CJK UNIFIED IDEOGRAPH
+0xFADE 0x66FA #CJK UNIFIED IDEOGRAPH
+0xFADF 0x670E #CJK UNIFIED IDEOGRAPH
+0xFAE0 0xF929 #CJK COMPATIBILITY IDEOGRAPH
+0xFAE1 0x6766 #CJK UNIFIED IDEOGRAPH
+0xFAE2 0x67BB #CJK UNIFIED IDEOGRAPH
+0xFAE3 0x6852 #CJK UNIFIED IDEOGRAPH
+0xFAE4 0x67C0 #CJK UNIFIED IDEOGRAPH
+0xFAE5 0x6801 #CJK UNIFIED IDEOGRAPH
+0xFAE6 0x6844 #CJK UNIFIED IDEOGRAPH
+0xFAE7 0x68CF #CJK UNIFIED IDEOGRAPH
+0xFAE8 0xFA13 #CJK COMPATIBILITY IDEOGRAPH
+0xFAE9 0x6968 #CJK UNIFIED IDEOGRAPH
+0xFAEA 0xFA14 #CJK COMPATIBILITY IDEOGRAPH
+0xFAEB 0x6998 #CJK UNIFIED IDEOGRAPH
+0xFAEC 0x69E2 #CJK UNIFIED IDEOGRAPH
+0xFAED 0x6A30 #CJK UNIFIED IDEOGRAPH
+0xFAEE 0x6A6B #CJK UNIFIED IDEOGRAPH
+0xFAEF 0x6A46 #CJK UNIFIED IDEOGRAPH
+0xFAF0 0x6A73 #CJK UNIFIED IDEOGRAPH
+0xFAF1 0x6A7E #CJK UNIFIED IDEOGRAPH
+0xFAF2 0x6AE2 #CJK UNIFIED IDEOGRAPH
+0xFAF3 0x6AE4 #CJK UNIFIED IDEOGRAPH
+0xFAF4 0x6BD6 #CJK UNIFIED IDEOGRAPH
+0xFAF5 0x6C3F #CJK UNIFIED IDEOGRAPH
+0xFAF6 0x6C5C #CJK UNIFIED IDEOGRAPH
+0xFAF7 0x6C86 #CJK UNIFIED IDEOGRAPH
+0xFAF8 0x6C6F #CJK UNIFIED IDEOGRAPH
+0xFAF9 0x6CDA #CJK UNIFIED IDEOGRAPH
+0xFAFA 0x6D04 #CJK UNIFIED IDEOGRAPH
+0xFAFB 0x6D87 #CJK UNIFIED IDEOGRAPH
+0xFAFC 0x6D6F #CJK UNIFIED IDEOGRAPH
+0xFB40 0x6D96 #CJK UNIFIED IDEOGRAPH
+0xFB41 0x6DAC #CJK UNIFIED IDEOGRAPH
+0xFB42 0x6DCF #CJK UNIFIED IDEOGRAPH
+0xFB43 0x6DF8 #CJK UNIFIED IDEOGRAPH
+0xFB44 0x6DF2 #CJK UNIFIED IDEOGRAPH
+0xFB45 0x6DFC #CJK UNIFIED IDEOGRAPH
+0xFB46 0x6E39 #CJK UNIFIED IDEOGRAPH
+0xFB47 0x6E5C #CJK UNIFIED IDEOGRAPH
+0xFB48 0x6E27 #CJK UNIFIED IDEOGRAPH
+0xFB49 0x6E3C #CJK UNIFIED IDEOGRAPH
+0xFB4A 0x6EBF #CJK UNIFIED IDEOGRAPH
+0xFB4B 0x6F88 #CJK UNIFIED IDEOGRAPH
+0xFB4C 0x6FB5 #CJK UNIFIED IDEOGRAPH
+0xFB4D 0x6FF5 #CJK UNIFIED IDEOGRAPH
+0xFB4E 0x7005 #CJK UNIFIED IDEOGRAPH
+0xFB4F 0x7007 #CJK UNIFIED IDEOGRAPH
+0xFB50 0x7028 #CJK UNIFIED IDEOGRAPH
+0xFB51 0x7085 #CJK UNIFIED IDEOGRAPH
+0xFB52 0x70AB #CJK UNIFIED IDEOGRAPH
+0xFB53 0x710F #CJK UNIFIED IDEOGRAPH
+0xFB54 0x7104 #CJK UNIFIED IDEOGRAPH
+0xFB55 0x715C #CJK UNIFIED IDEOGRAPH
+0xFB56 0x7146 #CJK UNIFIED IDEOGRAPH
+0xFB57 0x7147 #CJK UNIFIED IDEOGRAPH
+0xFB58 0xFA15 #CJK COMPATIBILITY IDEOGRAPH
+0xFB59 0x71C1 #CJK UNIFIED IDEOGRAPH
+0xFB5A 0x71FE #CJK UNIFIED IDEOGRAPH
+0xFB5B 0x72B1 #CJK UNIFIED IDEOGRAPH
+0xFB5C 0x72BE #CJK UNIFIED IDEOGRAPH
+0xFB5D 0x7324 #CJK UNIFIED IDEOGRAPH
+0xFB5E 0xFA16 #CJK COMPATIBILITY IDEOGRAPH
+0xFB5F 0x7377 #CJK UNIFIED IDEOGRAPH
+0xFB60 0x73BD #CJK UNIFIED IDEOGRAPH
+0xFB61 0x73C9 #CJK UNIFIED IDEOGRAPH
+0xFB62 0x73D6 #CJK UNIFIED IDEOGRAPH
+0xFB63 0x73E3 #CJK UNIFIED IDEOGRAPH
+0xFB64 0x73D2 #CJK UNIFIED IDEOGRAPH
+0xFB65 0x7407 #CJK UNIFIED IDEOGRAPH
+0xFB66 0x73F5 #CJK UNIFIED IDEOGRAPH
+0xFB67 0x7426 #CJK UNIFIED IDEOGRAPH
+0xFB68 0x742A #CJK UNIFIED IDEOGRAPH
+0xFB69 0x7429 #CJK UNIFIED IDEOGRAPH
+0xFB6A 0x742E #CJK UNIFIED IDEOGRAPH
+0xFB6B 0x7462 #CJK UNIFIED IDEOGRAPH
+0xFB6C 0x7489 #CJK UNIFIED IDEOGRAPH
+0xFB6D 0x749F #CJK UNIFIED IDEOGRAPH
+0xFB6E 0x7501 #CJK UNIFIED IDEOGRAPH
+0xFB6F 0x756F #CJK UNIFIED IDEOGRAPH
+0xFB70 0x7682 #CJK UNIFIED IDEOGRAPH
+0xFB71 0x769C #CJK UNIFIED IDEOGRAPH
+0xFB72 0x769E #CJK UNIFIED IDEOGRAPH
+0xFB73 0x769B #CJK UNIFIED IDEOGRAPH
+0xFB74 0x76A6 #CJK UNIFIED IDEOGRAPH
+0xFB75 0xFA17 #CJK COMPATIBILITY IDEOGRAPH
+0xFB76 0x7746 #CJK UNIFIED IDEOGRAPH
+0xFB77 0x52AF #CJK UNIFIED IDEOGRAPH
+0xFB78 0x7821 #CJK UNIFIED IDEOGRAPH
+0xFB79 0x784E #CJK UNIFIED IDEOGRAPH
+0xFB7A 0x7864 #CJK UNIFIED IDEOGRAPH
+0xFB7B 0x787A #CJK UNIFIED IDEOGRAPH
+0xFB7C 0x7930 #CJK UNIFIED IDEOGRAPH
+0xFB7D 0xFA18 #CJK COMPATIBILITY IDEOGRAPH
+0xFB7E 0xFA19 #CJK COMPATIBILITY IDEOGRAPH
+0xFB80 0xFA1A #CJK COMPATIBILITY IDEOGRAPH
+0xFB81 0x7994 #CJK UNIFIED IDEOGRAPH
+0xFB82 0xFA1B #CJK COMPATIBILITY IDEOGRAPH
+0xFB83 0x799B #CJK UNIFIED IDEOGRAPH
+0xFB84 0x7AD1 #CJK UNIFIED IDEOGRAPH
+0xFB85 0x7AE7 #CJK UNIFIED IDEOGRAPH
+0xFB86 0xFA1C #CJK COMPATIBILITY IDEOGRAPH
+0xFB87 0x7AEB #CJK UNIFIED IDEOGRAPH
+0xFB88 0x7B9E #CJK UNIFIED IDEOGRAPH
+0xFB89 0xFA1D #CJK COMPATIBILITY IDEOGRAPH
+0xFB8A 0x7D48 #CJK UNIFIED IDEOGRAPH
+0xFB8B 0x7D5C #CJK UNIFIED IDEOGRAPH
+0xFB8C 0x7DB7 #CJK UNIFIED IDEOGRAPH
+0xFB8D 0x7DA0 #CJK UNIFIED IDEOGRAPH
+0xFB8E 0x7DD6 #CJK UNIFIED IDEOGRAPH
+0xFB8F 0x7E52 #CJK UNIFIED IDEOGRAPH
+0xFB90 0x7F47 #CJK UNIFIED IDEOGRAPH
+0xFB91 0x7FA1 #CJK UNIFIED IDEOGRAPH
+0xFB92 0xFA1E #CJK COMPATIBILITY IDEOGRAPH
+0xFB93 0x8301 #CJK UNIFIED IDEOGRAPH
+0xFB94 0x8362 #CJK UNIFIED IDEOGRAPH
+0xFB95 0x837F #CJK UNIFIED IDEOGRAPH
+0xFB96 0x83C7 #CJK UNIFIED IDEOGRAPH
+0xFB97 0x83F6 #CJK UNIFIED IDEOGRAPH
+0xFB98 0x8448 #CJK UNIFIED IDEOGRAPH
+0xFB99 0x84B4 #CJK UNIFIED IDEOGRAPH
+0xFB9A 0x8553 #CJK UNIFIED IDEOGRAPH
+0xFB9B 0x8559 #CJK UNIFIED IDEOGRAPH
+0xFB9C 0x856B #CJK UNIFIED IDEOGRAPH
+0xFB9D 0xFA1F #CJK COMPATIBILITY IDEOGRAPH
+0xFB9E 0x85B0 #CJK UNIFIED IDEOGRAPH
+0xFB9F 0xFA20 #CJK COMPATIBILITY IDEOGRAPH
+0xFBA0 0xFA21 #CJK COMPATIBILITY IDEOGRAPH
+0xFBA1 0x8807 #CJK UNIFIED IDEOGRAPH
+0xFBA2 0x88F5 #CJK UNIFIED IDEOGRAPH
+0xFBA3 0x8A12 #CJK UNIFIED IDEOGRAPH
+0xFBA4 0x8A37 #CJK UNIFIED IDEOGRAPH
+0xFBA5 0x8A79 #CJK UNIFIED IDEOGRAPH
+0xFBA6 0x8AA7 #CJK UNIFIED IDEOGRAPH
+0xFBA7 0x8ABE #CJK UNIFIED IDEOGRAPH
+0xFBA8 0x8ADF #CJK UNIFIED IDEOGRAPH
+0xFBA9 0xFA22 #CJK COMPATIBILITY IDEOGRAPH
+0xFBAA 0x8AF6 #CJK UNIFIED IDEOGRAPH
+0xFBAB 0x8B53 #CJK UNIFIED IDEOGRAPH
+0xFBAC 0x8B7F #CJK UNIFIED IDEOGRAPH
+0xFBAD 0x8CF0 #CJK UNIFIED IDEOGRAPH
+0xFBAE 0x8CF4 #CJK UNIFIED IDEOGRAPH
+0xFBAF 0x8D12 #CJK UNIFIED IDEOGRAPH
+0xFBB0 0x8D76 #CJK UNIFIED IDEOGRAPH
+0xFBB1 0xFA23 #CJK COMPATIBILITY IDEOGRAPH
+0xFBB2 0x8ECF #CJK UNIFIED IDEOGRAPH
+0xFBB3 0xFA24 #CJK COMPATIBILITY IDEOGRAPH
+0xFBB4 0xFA25 #CJK COMPATIBILITY IDEOGRAPH
+0xFBB5 0x9067 #CJK UNIFIED IDEOGRAPH
+0xFBB6 0x90DE #CJK UNIFIED IDEOGRAPH
+0xFBB7 0xFA26 #CJK COMPATIBILITY IDEOGRAPH
+0xFBB8 0x9115 #CJK UNIFIED IDEOGRAPH
+0xFBB9 0x9127 #CJK UNIFIED IDEOGRAPH
+0xFBBA 0x91DA #CJK UNIFIED IDEOGRAPH
+0xFBBB 0x91D7 #CJK UNIFIED IDEOGRAPH
+0xFBBC 0x91DE #CJK UNIFIED IDEOGRAPH
+0xFBBD 0x91ED #CJK UNIFIED IDEOGRAPH
+0xFBBE 0x91EE #CJK UNIFIED IDEOGRAPH
+0xFBBF 0x91E4 #CJK UNIFIED IDEOGRAPH
+0xFBC0 0x91E5 #CJK UNIFIED IDEOGRAPH
+0xFBC1 0x9206 #CJK UNIFIED IDEOGRAPH
+0xFBC2 0x9210 #CJK UNIFIED IDEOGRAPH
+0xFBC3 0x920A #CJK UNIFIED IDEOGRAPH
+0xFBC4 0x923A #CJK UNIFIED IDEOGRAPH
+0xFBC5 0x9240 #CJK UNIFIED IDEOGRAPH
+0xFBC6 0x923C #CJK UNIFIED IDEOGRAPH
+0xFBC7 0x924E #CJK UNIFIED IDEOGRAPH
+0xFBC8 0x9259 #CJK UNIFIED IDEOGRAPH
+0xFBC9 0x9251 #CJK UNIFIED IDEOGRAPH
+0xFBCA 0x9239 #CJK UNIFIED IDEOGRAPH
+0xFBCB 0x9267 #CJK UNIFIED IDEOGRAPH
+0xFBCC 0x92A7 #CJK UNIFIED IDEOGRAPH
+0xFBCD 0x9277 #CJK UNIFIED IDEOGRAPH
+0xFBCE 0x9278 #CJK UNIFIED IDEOGRAPH
+0xFBCF 0x92E7 #CJK UNIFIED IDEOGRAPH
+0xFBD0 0x92D7 #CJK UNIFIED IDEOGRAPH
+0xFBD1 0x92D9 #CJK UNIFIED IDEOGRAPH
+0xFBD2 0x92D0 #CJK UNIFIED IDEOGRAPH
+0xFBD3 0xFA27 #CJK COMPATIBILITY IDEOGRAPH
+0xFBD4 0x92D5 #CJK UNIFIED IDEOGRAPH
+0xFBD5 0x92E0 #CJK UNIFIED IDEOGRAPH
+0xFBD6 0x92D3 #CJK UNIFIED IDEOGRAPH
+0xFBD7 0x9325 #CJK UNIFIED IDEOGRAPH
+0xFBD8 0x9321 #CJK UNIFIED IDEOGRAPH
+0xFBD9 0x92FB #CJK UNIFIED IDEOGRAPH
+0xFBDA 0xFA28 #CJK COMPATIBILITY IDEOGRAPH
+0xFBDB 0x931E #CJK UNIFIED IDEOGRAPH
+0xFBDC 0x92FF #CJK UNIFIED IDEOGRAPH
+0xFBDD 0x931D #CJK UNIFIED IDEOGRAPH
+0xFBDE 0x9302 #CJK UNIFIED IDEOGRAPH
+0xFBDF 0x9370 #CJK UNIFIED IDEOGRAPH
+0xFBE0 0x9357 #CJK UNIFIED IDEOGRAPH
+0xFBE1 0x93A4 #CJK UNIFIED IDEOGRAPH
+0xFBE2 0x93C6 #CJK UNIFIED IDEOGRAPH
+0xFBE3 0x93DE #CJK UNIFIED IDEOGRAPH
+0xFBE4 0x93F8 #CJK UNIFIED IDEOGRAPH
+0xFBE5 0x9431 #CJK UNIFIED IDEOGRAPH
+0xFBE6 0x9445 #CJK UNIFIED IDEOGRAPH
+0xFBE7 0x9448 #CJK UNIFIED IDEOGRAPH
+0xFBE8 0x9592 #CJK UNIFIED IDEOGRAPH
+0xFBE9 0xF9DC #CJK COMPATIBILITY IDEOGRAPH
+0xFBEA 0xFA29 #CJK COMPATIBILITY IDEOGRAPH
+0xFBEB 0x969D #CJK UNIFIED IDEOGRAPH
+0xFBEC 0x96AF #CJK UNIFIED IDEOGRAPH
+0xFBED 0x9733 #CJK UNIFIED IDEOGRAPH
+0xFBEE 0x973B #CJK UNIFIED IDEOGRAPH
+0xFBEF 0x9743 #CJK UNIFIED IDEOGRAPH
+0xFBF0 0x974D #CJK UNIFIED IDEOGRAPH
+0xFBF1 0x974F #CJK UNIFIED IDEOGRAPH
+0xFBF2 0x9751 #CJK UNIFIED IDEOGRAPH
+0xFBF3 0x9755 #CJK UNIFIED IDEOGRAPH
+0xFBF4 0x9857 #CJK UNIFIED IDEOGRAPH
+0xFBF5 0x9865 #CJK UNIFIED IDEOGRAPH
+0xFBF6 0xFA2A #CJK COMPATIBILITY IDEOGRAPH
+0xFBF7 0xFA2B #CJK COMPATIBILITY IDEOGRAPH
+0xFBF8 0x9927 #CJK UNIFIED IDEOGRAPH
+0xFBF9 0xFA2C #CJK COMPATIBILITY IDEOGRAPH
+0xFBFA 0x999E #CJK UNIFIED IDEOGRAPH
+0xFBFB 0x9A4E #CJK UNIFIED IDEOGRAPH
+0xFBFC 0x9AD9 #CJK UNIFIED IDEOGRAPH
+0xFC40 0x9ADC #CJK UNIFIED IDEOGRAPH
+0xFC41 0x9B75 #CJK UNIFIED IDEOGRAPH
+0xFC42 0x9B72 #CJK UNIFIED IDEOGRAPH
+0xFC43 0x9B8F #CJK UNIFIED IDEOGRAPH
+0xFC44 0x9BB1 #CJK UNIFIED IDEOGRAPH
+0xFC45 0x9BBB #CJK UNIFIED IDEOGRAPH
+0xFC46 0x9C00 #CJK UNIFIED IDEOGRAPH
+0xFC47 0x9D70 #CJK UNIFIED IDEOGRAPH
+0xFC48 0x9D6B #CJK UNIFIED IDEOGRAPH
+0xFC49 0xFA2D #CJK COMPATIBILITY IDEOGRAPH
+0xFC4A 0x9E19 #CJK UNIFIED IDEOGRAPH
+0xFC4B 0x9ED1 #CJK UNIFIED IDEOGRAPH
diff --git a/rtl/unix/aliasctp.inc b/rtl/unix/aliasctp.inc
new file mode 100644
index 0000000000..9d20803122
--- /dev/null
+++ b/rtl/unix/aliasctp.inc
@@ -0,0 +1,69 @@
+{
+ $Id: aliasctp.inc,v 1.5 2005/03/16 22:26:12 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Marco van de Voort
+ Member of the Free Pascal development team
+
+ Aliases for basic types for C interfacing, for reloading them
+ in other units from unit unixtype in a typesafe way.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Type
+ cInt8 = UnixType.cInt8;
+ cUInt8 = UnixType.cUInt8;
+ cUInt16 = UnixType.cUInt16;
+ cInt16 = UnixType.cInt16;
+ cInt32 = UnixType.cInt32;
+ cUInt32 = UnixType.cUInt32;
+ cInt64 = UnixType.cInt64;
+ cUInt64 = UnixType.cUInt64;
+ cuchar = UnixType.cuchar;
+ cchar = UnixType.cchar;
+ cInt = UnixType.cInt;
+ cUInt = UnixType.cUInt;
+ cLong = UnixType.cLong;
+ cuLong = UnixType.cuLong;
+ cshort = UnixType.cshort;
+ cushort = UnixType.cushort;
+ cunsigned = UnixType.cunsigned;
+ pcuchar = UnixType.pcuchar;
+ pcchar = UnixType.pcchar;
+ pcInt = UnixType.pcInt;
+ pcUInt = UnixType.pcUInt;
+ pcLong = UnixType.pcLong;
+ pculong = UnixType.pculong;
+ pcshort = UnixType.pcshort;
+ pcushort= UnixType.pcushort;
+ pcunsigned = UnixType.pcunsigned;
+
+ { Floating point }
+ cFloat = UnixType.cFloat;
+ cDouble = UnixType.cDouble;
+ clDouble = UnixType.clDouble;
+ pcFloat = UnixType.pcFloat;
+ pcDouble = UnixType.pcDouble;
+ pclDouble = UnixType.pclDouble;
+{
+ $Log: aliasctp.inc,v $
+ Revision 1.5 2005/03/16 22:26:12 florian
+ + ansi<->wide implemented using iconv
+
+ Revision 1.4 2005/03/13 10:05:13 florian
+ + floating point c types added
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/05 23:02:37 florian
+ + added some missing c types
+
+}
+
diff --git a/rtl/unix/aliasptp.inc b/rtl/unix/aliasptp.inc
new file mode 100644
index 0000000000..e4d63d58d3
--- /dev/null
+++ b/rtl/unix/aliasptp.inc
@@ -0,0 +1,88 @@
+{
+ $Id: aliasptp.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Marco van de Voort
+ Member of the Free Pascal development team
+
+ Aliases for Unix base types and constants, to import them into
+ multiple units in a typesafe way.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$i aliasctp.inc}
+
+type
+ dev_t = UnixType.dev_t;
+ TDev = UnixType.TDev;
+ pDev = UnixType.pDev;
+ gid_t = UnixType.gid_t;
+ TGid = UnixType.TGid;
+ pGid = UnixType.pGid;
+ ino_t = UnixType.ino_t;
+ TIno = UnixType.TIno;
+ pIno = UnixType.pIno;
+ mode_t = UnixType.mode_t;
+ TMode = UnixType.TMode;
+ pMode = UnixType.pMode;
+ nlink_t = UnixType.nlink_t;
+ TnLink = UnixType.TnLink;
+ pnLink = UnixType.pnLink;
+ off_t = UnixType.off_t;
+ TOff = UnixType.TOff;
+ pOff = UnixType.pOff;
+ pid_t = UnixType.pid_t;
+ TPid = UnixType.TPid;
+ pPid = UnixType.pPid;
+ size_t = UnixType.size_t;
+ TSize = UnixType.TSize;
+ pSize = UnixType.pSize;
+ ssize_t = UnixType.ssize_t;
+ TsSize = UnixType.TsSize;
+ psSize = UnixType.psSize;
+ uid_t = UnixType.uid_t;
+ TUid = UnixType.TUid;
+ pUid = UnixType.pUid;
+ clock_t = UnixType.clock_t;
+ TClock = UnixType.TClock;
+ pClock = UnixType.pClock;
+ time_t = UnixType.time_t;
+ TTime = UnixType.TTime;
+ pTime = UnixType.pTime;
+ ptime_t = UnixType.ptime_t;
+
+ socklen_t= UnixType.socklen_t;
+ TSocklen = UnixType.TSocklen;
+ pSocklen = UnixType.pSocklen;
+
+ timeval = UnixType.timeval;
+ ptimeval = UnixType.ptimeval;
+ TTimeVal = UnixType.TTimeVal;
+ timespec = UnixType.timespec;
+ ptimespec= UnixType.ptimespec;
+ Ttimespec= UnixType.Ttimespec;
+ pthread_mutex_t = UnixType.pthread_mutex_t;
+ pthread_cond_t = UnixType.pthread_cond_t;
+ pthread_t = UnixType.pthread_t;
+ tstatfs = UnixType.TStatFs;
+
+CONST
+ ARG_MAX = UnixType.ARG_MAX;
+ NAME_MAX = UnixType.NAME_MAX;
+ PATH_MAX = UnixType.PATH_MAX;
+ SYS_NMLN = UnixType.SYS_NMLN;
+ SIG_MAXSIG = UnixType.SIG_MAXSIG;
+// wordsinsigset = UnixType.wordsinsigset;
+
+{
+ $Log: aliasptp.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/baseunix.pp b/rtl/unix/baseunix.pp
new file mode 100644
index 0000000000..a99a7ba354
--- /dev/null
+++ b/rtl/unix/baseunix.pp
@@ -0,0 +1,108 @@
+{
+ $Id: baseunix.pp,v 1.4 2005/03/03 20:58:38 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Carl Eric Codere development team
+
+ Base Unix unit modelled after POSIX 2001.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit BaseUnix;
+
+Interface
+
+Uses UnixType;
+
+{$i osdefs.inc} { Compile time defines }
+
+{$i aliasptp.inc}
+
+{$packrecords C}
+
+{$ifndef FPC_USE_LIBC}
+ {$define FPC_USE_SYSCALL}
+{$endif}
+
+{$i errno.inc} { Error numbers }
+{$i ostypes.inc}
+
+{$ifdef FPC_USE_LIBC}
+ const clib = 'c';
+ {$i oscdeclh.inc}
+{$ELSE}
+ {$i bunxh.inc} { Functions}
+{$ENDIF}
+
+{$ifndef ver1_0}
+ function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+ procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+ property errno : cint read fpgeterrno write fpseterrno;
+{$else}
+ function fpgeterrno:longint;
+ procedure fpseterrno(err:longint);
+{$endif}
+
+{$i bunxovlh.inc}
+
+
+implementation
+
+{$ifdef hassysctl}
+Uses Sysctl;
+{$endif}
+
+{$ifdef ver1_0}
+// workaround for 1.0.10 bugs.
+
+function intgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+procedure intseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+
+function fpgeterrno:longint;
+begin
+ fpgeterrno:=intgeterrno;
+end;
+
+procedure fpseterrno(err:longint);
+begin
+ intseterrno(err);
+end;
+
+{$endif}
+
+{$i genfuncs.inc} // generic calls. (like getenv)
+{$I gensigset.inc} // general sigset funcs implementation.
+{$I genfdset.inc} // general fdset funcs.
+
+{$ifndef FPC_USE_LIBC}
+ {$i syscallh.inc} // do_syscall declarations themselves
+ {$i sysnr.inc} // syscall numbers.
+ {$i bsyscall.inc} // cpu specific syscalls
+ {$i bunxsysc.inc} // syscalls in system unit.
+ {$i settimeo.inc}
+{$endif}
+
+{$i osmacro.inc} { macro implenenations }
+{$i bunxovl.inc} { redefs and overloads implementation }
+
+end.
+{
+ $Log: baseunix.pp,v $
+ Revision 1.4 2005/03/03 20:58:38 florian
+ + routines in baseunix can be overriden by processor specifics in bsyscall.inc
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.1 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/unix/bunxh.inc b/rtl/unix/bunxh.inc
new file mode 100644
index 0000000000..ade37ecf43
--- /dev/null
+++ b/rtl/unix/bunxh.inc
@@ -0,0 +1,113 @@
+{
+ $Id: bunxh.inc,v 1.16 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ The interface part of the baseunix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Type TGrpArr = Array [0..0] of TGid; { C style array workarounds}
+ pGrpArr = ^TGrpArr;
+ TFilDes = Array [0..1] of cInt;
+ pFilDes = ^TFilDes;
+
+// if you are looking for macro definitions or non C template overloaded versions, they are moved to bunxovlh.inc
+
+ Function FpSigProcMask(how : cInt; nset : pSigSet; oset : pSigSet): cInt; external name 'FPC_SYSC_SIGPROCMASK';
+ Function FpSigProcMask(how : cInt; Const nset : TSigSet; var oset : TSigSet): cInt; external name 'FPC_SYSC_SIGPROCMASK';
+ Function FpSigPending (var nset : TSigSet): cInt;
+ Function FpSigSuspend (Const sigmask : TSigSet): cInt;
+
+ Function FpUmask (cmask : TMode): TMode;
+ Function FpLink (existing : pChar; newone : pChar): cInt;
+ Function FpMkfifo (path : pChar; Mode : TMode): cInt;
+ Function FpChmod (path : pChar; Mode : TMode): cInt;
+ Function FpChown (path : pChar; owner : TUid; group : TGid): cInt;
+ Function FpUtime (path : pChar; times : putimbuf): cInt;
+ Function FpPipe (var fildes : tfildes):cInt;
+ Function FpDup (fildes : cInt): cInt; external name 'FPC_SYSC_DUP';
+ Function FpDup2 (fildes, fildes2 : cInt): cInt; external name 'FPC_SYSC_DUP2';
+ Function FpTimes (var buffer : tms): TClock;
+
+ Function FpAlarm (seconds : cuint): cuint;
+ Function FpPause : cInt;
+ Function FpSleep (seconds : cuint): cuint;
+
+ Function FpGetpid : TPid; external name 'FPC_SYSC_GETPID';
+ Function FpGetppid : TPid;
+ Function FpGetuid : TUid;
+ Function FpGeteuid : TUid;
+ Function FpGetgid : TGid;
+ Function FpGetegid : TGid;
+ Function FpSetuid (uid : TUid): cInt;
+ Function FpSetgid (gid : TGid): cInt;
+ Function FpGetgroups (gidsetsize : cInt; var grouplist : tgrparr): cInt;
+ Function FpGetpgrp : TPid;
+ Function FpSetsid : TPid;
+ Function FpFcntl (fildes : cInt; cmd : cInt): cInt;
+ Function FpFcntl (fildes : cInt; cmd : cInt; arg : cInt): cInt;
+ Function FpFcntl (fildes : cInt; cmd : cInt; var arg : flock): cInt;
+
+ Function FpGetcwd (path:pChar; siz:TSize):pChar; external name 'FPC_SYSC_GETCWD';
+ Function FpFork : TPid; external name 'FPC_SYSC_FORK';
+ Function FpExecve (path : pChar; argv : ppChar; envp: ppChar): cInt;
+ Function FpExecv (path : pChar; argv : ppChar): cInt;
+ Function FpWaitpid (pid : TPid; stat_loc : pcInt; options: cInt): TPid; external name 'FPC_SYSC_WAITPID';
+ Function FpWait (var stat_loc : cInt): TPid;
+ Procedure FpExit (Status : cInt); external name 'FPC_SYSC_EXIT';
+ Function FpKill (pid : TPid; sig: cInt): cInt;
+ Function FpUname (var name: utsname): cInt;
+ Function FpOpendir (dirname : pChar): pDir; external name 'FPC_SYSC_OPENDIR';
+ Function FpReaddir (var dirp : Dir) : pDirent; external name 'FPC_SYSC_READDIR';
+ Function FpClosedir (var dirp : Dir): cInt; external name 'FPC_SYSC_CLOSEDIR';
+ Function FpChdir (path : pChar): cInt; external name 'FPC_SYSC_CHDIR';
+ Function FpOpen (path : pChar; flags : cInt; Mode: TMode):cInt; external name 'FPC_SYSC_OPEN';
+ Function FpMkdir (path : pChar; Mode: TMode):cInt; external name 'FPC_SYSC_MKDIR';
+ Function FpUnlink (path : pChar): cInt; external name 'FPC_SYSC_UNLINK';
+ Function FpRmdir (path : pChar): cInt; external name 'FPC_SYSC_RMDIR';
+ Function FpRename (old : pChar; newpath: pChar): cInt; external name 'FPC_SYSC_RENAME';
+ Function FpFStat (fd : cInt; var sb : stat): cInt; external name 'FPC_SYSC_FSTAT';
+ Function FpStat (path: pChar; var buf : stat): cInt; external name 'FPC_SYSC_STAT';
+ Function FpAccess (pathname : pChar; aMode : cInt): cInt; external name 'FPC_SYSC_ACCESS';
+ Function FpClose (fd : cInt): cInt; external name 'FPC_SYSC_CLOSE';
+
+ Function FpRead (fd : cInt; buf: pChar; nbytes : TSize): TSsize; external name 'FPC_SYSC_READ';
+ Function FpWrite (fd : cInt; buf:pChar; nbytes : TSize): TSsize; external name 'FPC_SYSC_WRITE';
+ Function FpLseek (fd : cInt; offset : TOff; whence : cInt): TOff; external name 'FPC_SYSC_LSEEK';
+ Function FpTime (var tloc : TTime): TTime; external name 'FPC_SYSC_TIME';
+ Function FpFtruncate (fd : cInt; flength : TOff): cInt; external name 'FPC_SYSC_FTRUNCATE';
+ Function FPSigaction (sig: cInt; act : pSigActionRec; oact : pSigActionRec): cint; external name 'FPC_SYSC_SIGACTION';
+ Function FPSelect (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint;
+ Function FpIOCtl (Handle:cint;Ndx: culong;Data: Pointer):cint; external name 'FPC_SYSC_IOCTL';
+ Function FpNanoSleep (req : ptimespec;rem : ptimespec):cint; external name 'FPC_SYSC_NANOSLEEP';
+ Function fpLstat(path:pchar;Info:pstat):cint;
+ Function fpLstat(Filename: ansistring;Info:pstat):cint;
+ Function fpSymlink(oldname,newname:pchar):cint;
+ Function fpReadLink(name,linkname:pchar;maxlen:size_t):cint; external name 'FPC_SYSC_READLINK';
+
+ function fpNice(N:cint):cint;
+ Function fpGetPriority(Which,Who:cint):cint;
+ Function fpSetPriority(Which,Who,What:cint):cint;
+ Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; external name 'FPC_SYSC_MMAP';
+ Function Fpmunmap(start:pointer;len:size_t):cint; external name 'FPC_SYSC_MUNMAP';
+
+ Function FpGetEnv (name : pChar): pChar;
+ function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+
+{
+ $Log: bunxh.inc,v $
+ Revision 1.16 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.15 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/unix/bunxovl.inc b/rtl/unix/bunxovl.inc
new file mode 100644
index 0000000000..fc51e2e1b0
--- /dev/null
+++ b/rtl/unix/bunxovl.inc
@@ -0,0 +1,383 @@
+{
+ $Id: bunxovl.inc,v 1.18 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ Some generic overloads for stringfunctions in the baseunix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$if defined(CPUARM) or defined(CPUX86_64) or defined(CPUSPARC)}
+ {$define RTSIGACTION}
+{$endif}
+
+{$I textrec.inc}
+{$I filerec.inc}
+
+Function FpLink (existing : AnsiString; newone : AnsiString): cInt;
+Begin
+ FpLink:=FpLink(pchar(existing),pchar(newone));
+End;
+
+Function FpMkfifo (path : AnsiString; Mode : TMode): cInt;
+Begin
+ FpMkfifo:=FpMkfifo(pchar(path),mode);
+End;
+
+Function FpChmod (path : AnsiString; Mode : TMode): cInt;
+Begin
+ FpChmod:=FpChmod(pchar(path),mode);
+End;
+
+Function FpChown (path : AnsiString; owner : TUid; group : TGid): cInt;
+Begin
+ FpChown:=FpChown(pchar(path),owner,group);
+End;
+
+Function FpUtime (path : AnsiString; times : putimbuf): cInt;
+Begin
+ FpUtime:=FpUtime(pchar(path),times);
+End;
+
+{
+Function FpGetcwd (path:AnsiString; siz:TSize):AnsiString;
+Begin
+ FpGetcwd:=ansistring(pchar(FpGetcwd(pchar(path),siz)));
+End;
+}
+Function FpGetcwd :AnsiString;
+
+Var
+ Buf : Array[0..PATH_MAX+1] of char;
+Begin
+ Buf[PATH_MAX+1]:=#0;
+ If FpGetcwd(@Buf[0],PATH_MAX)=Nil then
+ FpGetcwd:=''
+ else
+ FpGetcwd:=Buf;
+End;
+
+Function FpExecve (path : AnsiString; argv : ppchar; envp: ppchar): cInt;
+Begin
+ FpExecve:=FpExecve (pchar(path),argv,envp);
+End;
+
+Function FpExecv (path : AnsiString; argv : ppchar): cInt;
+Begin
+ FpExecv:=FpExecve (pchar(path),argv,envp);
+End;
+
+
+Function FpChdir (path : AnsiString): cInt;
+Begin
+ FpChDir:=FpChdir(pchar(Path));
+End;
+
+Function FpOpen (path : AnsiString; flags : cInt; Mode: TMode):cInt;
+Begin
+ FpOpen:=FpOpen(pchar(Path),flags,mode);
+End;
+
+
+Function FpMkdir (path : AnsiString; Mode: TMode):cInt;
+Begin
+ FpMkdir:=FpMkdir(pchar(Path),mode);
+End;
+
+Function FpUnlink (path : AnsiString): cInt;
+Begin
+ FpUnlink:=FpUnlink(pchar(path));
+End;
+
+Function FpRmdir (path : AnsiString): cInt;
+Begin
+ FpRmdir:=FpRmdir(pchar(path));
+End;
+
+Function FpRename (old : AnsiString;newpath: AnsiString): cInt;
+Begin
+ FpRename:=FpRename(pchar(old),pchar(newpath));
+End;
+
+Function FpStat (path: AnsiString; var buf : stat): cInt;
+begin
+ FpStat:=FpStat(pchar(path),buf);
+End;
+
+Function FpAccess (pathname : AnsiString; aMode : cInt): cInt;
+Begin
+ FpAccess:=FpAccess(pchar(pathname),amode);
+End;
+
+Function FPFStat(var F:Text;Var Info:stat):Boolean;
+{
+ Get all information on a text file, and return it in info.
+}
+begin
+ FPFStat:=FPFstat(TextRec(F).Handle,INfo)=0;
+end;
+
+Function FPFStat(var F:File;Var Info:stat):Boolean;
+{
+ Get all information on a untyped file, and return it in info.
+}
+begin
+ FPFStat:=FPFstat(FileRec(F).Handle,Info)=0;
+end;
+
+Function FpSignal(signum:longint;Handler:signalhandler):signalhandler;
+// should be moved out of generic files. Too specific.
+
+var sa,osa : sigactionrec;
+
+begin
+ sa.sa_handler:=SigActionHandler(handler);
+ FillChar(sa.sa_mask,sizeof(sigset),#0);
+ sa.sa_flags := 0;
+{ if (sigintr and signum) =0 then
+ {restart behaviour needs libc}
+ sa.sa_flags :=sa.sa_flags or SA_RESTART;
+}
+{$ifdef RTSIGACTION}
+ sa.sa_flags:=SA_SIGINFO
+{$ifdef cpux86_64}
+ or $4000000
+{$endif cpux86_64}
+ ;
+{$endif RTSIGACTION}
+ FPSigaction(signum,@sa,@osa);
+ if fpgetErrNo<>0 then
+ fpsignal:=NIL
+ else
+ fpsignal:=signalhandler(osa.sa_handler);
+end;
+
+{$ifdef FPC_USE_LIBC} // can't remember why this is the case. Might be legacy.
+function xFpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external clib name 'read';
+{$else}
+function xFpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_READ';
+{$endif}
+
+Function FpRead (fd : cInt;var buf; nbytes : TSize): TSsize;
+
+begin
+ FPRead:=xFpRead(fd,pchar(@buf),nbytes);
+end;
+
+Function FpWrite (fd : cInt;const buf; nbytes : TSize): TSsize;
+begin
+ FpWrite:=FpWrite(fd,pchar(@buf),nbytes);
+end;
+
+Function FpOpen (path : pChar; flags : cInt):cInt;
+
+begin
+ FpOpen:=FpOpen(path,flags,438);
+end;
+
+Function FpOpen (path : AnsiString; flags : cInt):cInt;
+
+begin
+ FpOpen:=FpOpen(pchar(path),flags,438);
+end;
+
+Function FpOpen (path : String; flags : cInt):cInt;
+
+begin
+ path:=path+#0;
+ FpOpen:=FpOpen(@path[1],flags,438);
+end;
+
+Function FpOpen (path : String; flags : cInt; Mode: TMode):cInt;
+
+begin
+ path:=path+#0;
+ FpOpen:=FpOpen(@path[1],flags,Mode);
+end;
+
+Function FpOpendir (dirname : AnsiString): pDir;
+Begin
+ FpOpenDir:=FpOpenDir(pchar(dirname));
+End;
+
+
+Function FpOpendir (dirname : shortString): pDir;
+Begin
+ dirname:=dirname+#0;
+ FpOpenDir:=FpOpenDir(pchar(@dirname[1]));
+End;
+
+
+Function FpStat (path: String; var buf : stat): cInt;
+
+begin
+ path:=path+#0;
+ FpStat:=FpStat(pchar(@path[1]),buf);
+end;
+
+Function fpDup(var oldfile,newfile:text):cint;
+{
+ Copies the filedescriptor oldfile to newfile, after flushing the buffer of
+ oldfile.
+ After which the two textfiles are, in effect, the same, except
+ that they don't share the same buffer, and don't share the same
+ close_on_exit flag.
+}
+begin
+ flush(oldfile);{ We cannot share buffers, so we flush them. }
+ textrec(newfile):=textrec(oldfile);
+ textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
+ textrec(newfile).handle:=fpDup(textrec(oldfile).handle);
+ fpdup:=textrec(newfile).handle;
+end;
+
+Function fpDup(var oldfile,newfile:file):cint;
+{
+ Copies the filedescriptor oldfile to newfile
+}
+begin
+ filerec(newfile):=filerec(oldfile);
+ filerec(newfile).handle:=fpDup(filerec(oldfile).handle);
+ fpdup:= filerec(newfile).handle;
+end;
+
+
+Function FpDup2(var oldfile,newfile:text):cint;
+{
+ Copies the filedescriptor oldfile to newfile, after flushing the buffer of
+ oldfile. It closes newfile if it was still open.
+ After which the two textfiles are, in effect, the same, except
+ that they don't share the same buffer, and don't share the same
+ close_on_exit flag.
+}
+var
+ tmphandle : word;
+begin
+ case TextRec(oldfile).mode of
+ fmOutput, fmInOut, fmAppend :
+ flush(oldfile);{ We cannot share buffers, so we flush them. }
+ end;
+ case TextRec(newfile).mode of
+ fmOutput, fmInOut, fmAppend :
+ flush(newfile);
+ end;
+ tmphandle:=textrec(newfile).handle;
+ textrec(newfile):=textrec(oldfile);
+ textrec(newfile).handle:=tmphandle;
+ textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
+ fpDup2:=fpDup2(textrec(oldfile).handle,textrec(newfile).handle);
+end;
+
+Function FpDup2(var oldfile,newfile:file):cint;
+{
+ Copies the filedescriptor oldfile to newfile
+}
+begin
+ filerec(newfile):=filerec(oldfile);
+ fpDup2:=fpDup2(filerec(oldfile).handle,filerec(newfile).handle);
+end;
+
+function fptime :time_t;
+var t:time_t;
+begin
+ fptime:=fptime(t);
+end;
+
+Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdset;TimeOut:cint):cint;
+{
+ Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+ have changed.
+ This function allows specification of a timeout as a longint.
+}
+var
+ p : PTimeVal;
+ tv : TimeVal;
+begin
+ if TimeOut=-1 then
+ p:=nil
+ else
+ begin
+ tv.tv_Sec:=Timeout div 1000;
+ tv.tv_Usec:=(Timeout mod 1000)*1000;
+ p:=@tv;
+ end;
+ fpSelect:=fpSelect(N,Readfds,WriteFds,ExceptFds,p);
+end;
+
+Function fpSelect(var T:Text;TimeOut :PTimeval):cint;
+Var
+ F:TfdSet;
+begin
+ if textrec(t).mode=fmclosed then
+ begin
+ fpSetErrNo(ESysEBADF);
+ exit(-1);
+ end;
+ FpFD_ZERO(f);
+ fpFD_SET(textrec(T).handle,f);
+ if textrec(T).mode=fminput then
+ fpselect:=fpselect(textrec(T).handle+1,@f,nil,nil,TimeOut)
+ else
+ fpSelect:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut);
+end;
+
+Function fpSelect(var T:Text;TimeOut :time_t):cint;
+var
+ p : PTimeVal;
+ tv : TimeVal;
+begin
+ if TimeOut=-1 then
+ p:=nil
+ else
+ begin
+ tv.tv_Sec:=Timeout div 1000;
+ tv.tv_Usec:=(Timeout mod 1000)*1000;
+ p:=@tv;
+ end;
+ fpSelect:=fpSelect(T,p);
+end;
+
+function FpWaitPid (pid : TPid; Var Status : cInt; Options : cint) : TPid;
+
+begin
+ fpWaitPID:=fpWaitPID(Pid,@Status,Options);
+end;
+
+Function fpReadLink(Name:ansistring):ansistring;
+{
+ Read a link (where it points to)
+}
+var
+ LinkName : ansistring;
+ i : cint;
+begin
+ SetLength(linkname,PATH_MAX);
+ i:=fpReadLink(pchar(name),pchar(linkname),PATH_MAX);
+ if i>0 then
+ begin
+ SetLength(linkname,i);
+ fpReadLink:=LinkName;
+ end
+ else
+ fpReadLink:='';
+end;
+
+
+{
+ $Log: bunxovl.inc,v $
+ Revision 1.18 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.17 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/unix/bunxovlh.inc b/rtl/unix/bunxovlh.inc
new file mode 100644
index 0000000000..c6a4919ee2
--- /dev/null
+++ b/rtl/unix/bunxovlh.inc
@@ -0,0 +1,104 @@
+{
+ $Id: bunxovlh.inc,v 1.8 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ Functions that are not part of the libc<->syscall decision.
+ - string and file type overloads
+ - functions that are macro's in C.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function FpLink (existing : AnsiString; newone : AnsiString): cInt;
+Function FpMkfifo (path : AnsiString; Mode : TMode): cInt;
+Function FpChmod (path : AnsiString; Mode : TMode): cInt;
+Function FpChown (path : AnsiString; owner : TUid; group : TGid): cInt;
+Function FpUtime (path : AnsiString; times : putimbuf): cInt;
+Function FpGetcwd : AnsiString;
+Function FpExecve (path : AnsiString; argv : ppchar; envp: ppchar): cInt;
+Function FpExecv (path : AnsiString; argv : ppchar): cInt;
+Function FpOpendir (dirname : AnsiString): pDir;
+Function FpOpendir (dirname : shortString): pDir;
+Function FpOpen (path : pChar; flags : cInt):cInt;
+Function FpOpen (path : AnsiString; flags : cInt):cInt;
+Function FpOpen (path : AnsiString; flags : cInt; Mode: TMode):cInt;
+Function FpOpen (path : String; flags : cInt):cInt;
+Function FpOpen (path : String; flags : cInt; Mode: TMode):cInt;
+Function FpChdir (path : AnsiString): cInt;
+Function FpMkdir (path : AnsiString; Mode: TMode):cInt;
+Function FpUnlink (path : AnsiString): cInt;
+Function FpRmdir (path : AnsiString): cInt;
+Function FpRename (old : AnsiString;newpath: AnsiString): cInt;
+Function FpStat (path: AnsiString; var buf : stat): cInt;
+Function FpStat (path: String; var buf : stat): cInt;
+Function FpAccess (pathname : AnsiString; aMode : cInt): cInt;
+function FpWaitPid (pid : TPid; Var Status : cInt; Options : cint) : TPid;
+
+Function FPFStat (var F:Text;Var Info:stat):Boolean;
+Function FPFStat (var F:File;Var Info:stat):Boolean;
+
+// added. Is a depreciated POSIX function that can be considered alias to sigaction
+
+Function FpSignal (signum:longint;Handler:signalhandler):signalhandler;
+Function FpRead (fd : cInt; var buf; nbytes : TSize): TSsize;
+Function FpWrite (fd : cInt; const buf; nbytes : TSize): TSsize;
+Function FpDup (var oldfile,newfile:text):cint;
+Function FpDup (var oldfile,newfile:file):cint;
+Function FpDup2 (var oldfile,newfile:text):cint;
+Function FpDup2 (var oldfile,newfile:file):cint;
+function fptime :time_t;
+
+
+Function fpSelect (N:cint;readfds,writefds,exceptfds:pfdset;TimeOut:cint):cint;
+Function fpSelect (var T:Text;TimeOut :PTimeval):cint;
+Function fpSelect (var T:Text;TimeOut :time_t):cint;
+Function FpGetEnv (name : String): pChar;
+
+// macro's
+
+Function fpFD_SET (fdno:cint;var nset : TFDSet): cint;
+Function fpFD_CLR (fdno:cint;var nset : TFDSet): cint;
+Function fpFD_ZERO (var nset : TFDSet):cint;
+Function fpFD_ISSET (fdno:cint;const nset : TFDSet): cint;
+Function fpfdfillset(var nset : TFDSet):cint;
+
+Function FpsigEmptySet(var nset : TSigSet): cint;
+Function FpSigFillSet (var nset : TSigSet): cInt;
+Function FpSigAddSet (var nset : TSigSet; signo : cInt): cInt;
+Function FpSigDelSet (var nset : TSigSet; signo : cInt): cInt;
+Function FpSigIsMember(Const nset : TSigSet; signo : cInt): cInt;
+Function fpS_ISDIR (m : TMode): Boolean;
+Function fpS_ISCHR (m : TMode): Boolean;
+Function fpS_ISBLK (m : TMode): Boolean;
+Function fpS_ISREG (m : TMode): Boolean;
+Function fpS_ISFIFO (m : TMode): Boolean;
+
+// The following two are very common, but not POSIX.
+Function fpS_ISLNK (m:TMode) : Boolean;
+Function fpS_ISSOCK (m:TMode) : Boolean;
+
+Function wifexited (Status : cInt): boolean;
+Function wexitStatus (Status : cInt): cInt;
+Function wstopsig (Status : cInt): cInt;
+Function wifsignaled (Status : cInt): boolean;
+Function wtermsig (Status : cInt): cInt;
+
+Function fpReadLink(Name:ansistring):ansistring;
+{
+ $Log: bunxovlh.inc,v $
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.7 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
+
+
diff --git a/rtl/unix/classes.pp b/rtl/unix/classes.pp
new file mode 100644
index 0000000000..f3c2f44ea0
--- /dev/null
+++ b/rtl/unix/classes.pp
@@ -0,0 +1,69 @@
+{
+ $Id: classes.pp,v 1.3 2005/03/07 17:57:25 peter Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ sysutils,
+ types,
+ typinfo,
+ rtlconsts;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+ BaseUnix,unix
+ ;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+ CommonInit;
+finalization
+ CommonCleanup;
+
+{$ifndef VER1_0}
+ if ThreadsInited then
+ DoneThreads;
+{$endif}
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.3 2005/03/07 17:57:25 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.8 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
diff --git a/rtl/unix/crt.pp b/rtl/unix/crt.pp
new file mode 100644
index 0000000000..5e885e4b77
--- /dev/null
+++ b/rtl/unix/crt.pp
@@ -0,0 +1,1638 @@
+{
+ $Id: crt.pp,v 1.24 2005/03/16 18:17:23 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman,
+ members of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Crt;
+
+Interface
+
+{$i crth.inc}
+
+Const
+ { Controlling consts }
+ Flushing = false; {if true then don't buffer output}
+ ConsoleMaxX = 1024;
+ ConsoleMaxY = 1024;
+ ScreenHeight : longint = 25;
+ ScreenWidth : longint = 80;
+
+Type
+ TCharAttr=packed record
+ ch : char;
+ attr : byte;
+ end;
+ TConsoleBuf=Array[0..ConsoleMaxX*ConsoleMaxY-1] of TCharAttr;
+ PConsoleBuf=^TConsoleBuf;
+
+var
+ ConsoleBuf : PConsoleBuf;
+
+Implementation
+
+uses BaseUnix ,unix, termio;
+
+{
+ The definitions of TextRec and FileRec are in separate files.
+}
+{$i textrec.inc}
+
+Const
+ OldTextAttr : byte = $07;
+Var
+ CurrX,CurrY : Byte;
+ OutputRedir, InputRedir : boolean; { is the output/input being redirected (not a TTY) }
+ WinMinX,
+ WinMinY,
+ WinMaxX,
+ WinMaxY : Longint;
+
+
+{*****************************************************************************
+ Some Handy Functions Not in the System.PP
+*****************************************************************************}
+
+Function Str(l:longint):string;
+{
+ Return a String of the longint
+}
+var
+ hstr : string[32];
+begin
+ System.Str(l,hstr);
+ Str:=hstr;
+end;
+
+
+
+Function Max(l1,l2:longint):longint;
+{
+ Return the maximum of l1 and l2
+}
+begin
+ if l1>l2 then
+ Max:=l1
+ else
+ Max:=l2;
+end;
+
+
+
+Function Min(l1,l2:longint):longint;
+{
+ Return the minimum of l1 and l2
+}
+begin
+ if l1<l2 then
+ Min:=l1
+ else
+ Min:=l2;
+end;
+
+
+{*****************************************************************************
+ Optimal AnsiString Conversion Routines
+*****************************************************************************}
+
+Function XY2Ansi(x,y,ox,oy:longint):String;
+{
+ Returns a string with the escape sequences to go to X,Y on the screen
+}
+Begin
+ if y=oy then
+ begin
+ if x=ox then
+ begin
+ // this workaround should improve behaviour on some terminals.
+ // debian bug 216057 but I also observed this with video on FreeBSD
+ if x=screenwidth then
+ XY2Ansi:=#27'['+Str(y)+';'+Str(x)+'H'
+ else
+ // end workaround
+ XY2Ansi:='';
+ exit;
+ end;
+ {$ifdef Linux} // linux CRT shortcut
+ if x=1 then
+ begin
+ XY2Ansi:=#13;
+ exit;
+ end;
+ {$endif}
+ if x>ox then
+ begin
+ XY2Ansi:=#27'['+Str(x-ox)+'C';
+ exit;
+ end
+ else
+ begin
+ XY2Ansi:=#27'['+Str(ox-x)+'D';
+ exit;
+ end;
+ end;
+ if x=ox then
+ begin
+ if y>oy then
+ begin
+ XY2Ansi:=#27'['+Str(y-oy)+'B';
+ exit;
+ end
+ else
+ begin
+ XY2Ansi:=#27'['+Str(oy-y)+'A';
+ exit;
+ end;
+ end;
+ {$ifdef Linux} // this shortcut isn't for everybody
+ if (x=1) and (oy+1=y) then
+ XY2Ansi:=#13#10
+ else
+ {$endif}
+ XY2Ansi:=#27'['+Str(y)+';'+Str(x)+'H';
+End;
+
+
+
+const
+ AnsiTbl : string[8]='04261537';
+Function Attr2Ansi(Attr,OAttr:longint):string;
+{
+ Convert Attr to an Ansi String, the Optimal code is calculate
+ with use of the old OAttr
+}
+var
+ hstr : string[16];
+ OFg,OBg,Fg,Bg : longint;
+
+ procedure AddSep(ch:char);
+ begin
+ if length(hstr)>0 then
+ hstr:=hstr+';';
+ hstr:=hstr+ch;
+ end;
+
+begin
+ if Attr=OAttr then
+ begin
+ Attr2Ansi:='';
+ exit;
+ end;
+ Hstr:='';
+ Fg:=Attr and $f;
+ Bg:=Attr shr 4;
+ OFg:=OAttr and $f;
+ OBg:=OAttr shr 4;
+ if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then
+ begin
+ hstr:='0';
+ OFg:=7;
+ OBg:=0;
+ end;
+ if (Fg>7) and (OFg<8) then
+ begin
+ AddSep('1');
+ OFg:=OFg or 8;
+ end;
+ if (Bg and 8)<>(OBg and 8) then
+ begin
+ AddSep('5');
+ OBg:=OBg or 8;
+ end;
+ if (Fg<>OFg) then
+ begin
+ AddSep('3');
+ hstr:=hstr+AnsiTbl[(Fg and 7)+1];
+ end;
+ if (Bg<>OBg) then
+ begin
+ AddSep('4');
+ hstr:=hstr+AnsiTbl[(Bg and 7)+1];
+ end;
+ if hstr='0' then
+ hstr:='';
+ Attr2Ansi:=#27'['+hstr+'m';
+end;
+
+
+
+Function Ansi2Attr(Const HStr:String;oattr:longint):longint;
+{
+ Convert an Escape sequence to an attribute value, uses Oattr as the last
+ color written
+}
+var
+ i,j : longint;
+begin
+ i:=2;
+ if (Length(HStr)<3) or (Hstr[1]<>#27) or (Hstr[2]<>'[') then
+ i:=255;
+ while (i<length(Hstr)) do
+ begin
+ inc(i);
+ case Hstr[i] of
+ '0' : OAttr:=7;
+ '1' : OAttr:=OAttr or $8;
+ '5' : OAttr:=OAttr or $80;
+ '3' : begin
+ inc(i);
+ j:=pos(Hstr[i],AnsiTbl);
+ if j>0 then
+ OAttr:=(OAttr and $f8) or (j-1);
+ end;
+ '4' : begin
+ inc(i);
+ j:=pos(Hstr[i],AnsiTbl);
+ if j>0 then
+ OAttr:=(OAttr and $8f) or ((j-1) shl 4);
+ end;
+ 'm' : i:=length(HStr);
+ end;
+ end;
+ Ansi2Attr:=OAttr;
+end;
+
+
+
+{*****************************************************************************
+ Buffered StdIn/StdOut IO
+*****************************************************************************}
+
+const
+ ttyIn=0; {Handles for stdin/stdout}
+ ttyOut=1;
+ ttyFlush:boolean=true;
+{Buffered Input/Output}
+ InSize=256;
+ OutSize=1024;
+var
+ InBuf : array[0..InSize-1] of char;
+ InCnt,
+ InHead,
+ InTail : longint;
+ OutBuf : array[0..OutSize-1] of char;
+ OutCnt : longint;
+
+
+{Flush Output Buffer}
+procedure ttyFlushOutput;
+begin
+ if OutCnt>0 then
+ begin
+ fpWrite(ttyOut,OutBuf,OutCnt);
+ OutCnt:=0;
+ end;
+end;
+
+
+
+Function ttySetFlush(b:boolean):boolean;
+begin
+ ttySetFlush:=ttyFlush;
+ ttyFlush:=b;
+ if ttyFlush then
+ ttyFlushOutput;
+end;
+
+
+{Send Char to Remote}
+Procedure ttySendChar(c:char);
+Begin
+ if OutCnt<OutSize then
+ begin
+ OutBuf[OutCnt]:=c;
+ inc(OutCnt);
+ end;
+{Full ?}
+ if (OutCnt>=OutSize) then
+ ttyFlushOutput;
+End;
+
+
+
+{Send String to Remote}
+procedure ttySendStr(const hstr:string);
+var
+ i : longint;
+begin
+ for i:=1to length(hstr) do
+ ttySendChar(hstr[i]);
+ if ttyFlush then
+ ttyFlushOutput;
+end;
+
+
+
+{Get Char from Remote}
+function ttyRecvChar:char;
+var
+ Readed,i : longint;
+begin
+{Buffer Empty? Yes, Input from StdIn}
+ if (InHead=InTail) then
+ begin
+ {Calc Amount of Chars to Read}
+ i:=InSize-InHead;
+ if InTail>InHead then
+ i:=InTail-InHead;
+ {Read}
+ Readed:=fpread(TTYIn,InBuf[InHead],i);
+ {Increase Counters}
+ inc(InCnt,Readed);
+ inc(InHead,Readed);
+ {Wrap if End has Reached}
+ if InHead>=InSize then
+ InHead:=0;
+ end;
+{Check Buffer}
+ if (InCnt=0) then
+ ttyRecvChar:=#0
+ else
+ begin
+ ttyRecvChar:=InBuf[InTail];
+ dec(InCnt);
+ inc(InTail);
+ if InTail>=InSize then
+ InTail:=0;
+ end;
+end;
+
+
+{*****************************************************************************
+ Screen Routines not Window Depended
+*****************************************************************************}
+
+procedure ttyGotoXY(x,y:longint);
+{
+ Goto XY on the Screen, if a value is 0 the goto the current
+ postion of that value and always recalc the ansicode for it
+}
+begin
+ if x=0 then
+ begin
+ x:=CurrX;
+ CurrX:=$ff;
+ end;
+ if y=0 then
+ begin
+ y:=CurrY;
+ CurrY:=$ff;
+ end;
+ if OutputRedir then
+ begin
+ if longint(y)-longint(CurrY)=1 then
+ ttySendStr(#10);
+ end
+ else
+ ttySendStr(XY2Ansi(x,y,CurrX,CurrY));
+ CurrX:=x;
+ CurrY:=y;
+end;
+
+
+
+procedure ttyColor(a:longint);
+{
+ Set Attribute to A, only output if not the last attribute is set
+}
+begin
+ if a<>OldTextAttr then
+ begin
+ if not OutputRedir then
+ ttySendStr(Attr2Ansi(a,OldTextAttr));
+ TextAttr:=a;
+ OldTextAttr:=a;
+ end;
+end;
+
+
+
+procedure ttyWrite(const s:string);
+{
+ Write a string to the output, memory copy and Current X&Y are also updated
+}
+var
+ idx,i : longint;
+begin
+ ttySendStr(s);
+{Update MemCopy}
+ idx:=(CurrY-1)*ScreenWidth-1;
+ for i:=1to length(s) do
+ if s[i]=#8 then
+ begin
+ if CurrX>1 then
+ dec(CurrX);
+ end
+ else
+ begin
+ ConsoleBuf^[idx+CurrX].ch:=s[i];
+ ConsoleBuf^[idx+CurrX].attr:=TextAttr;
+ inc(CurrX);
+ if CurrX>ScreenWidth then
+ CurrX:=ScreenWidth;
+ end;
+end;
+
+
+
+Function FullWin:boolean;
+{
+ Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+ FullWin:=(WinMinX=1) and (WinMinY=1) and
+ (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
+end;
+
+
+procedure LineWrite(const temp:String);
+{
+ Write a Line to the screen, doesn't write on 80,25 under Dos
+ the Current CurrX is set to WinMax. NO MEMORY UPDATE!
+}
+begin
+ CurrX:=WinMaxX+1;
+ ttySendStr(Temp);
+end;
+
+
+
+Procedure DoEmptyLine(y,xl,xh:Longint);
+{
+ Write an empty line at row Y from column Xl to Xh. Memory is also updated.
+}
+Var
+ len : Longint;
+ blank_with_attribute : TCharAttr;
+Begin
+ ttyGotoXY(xl,y);
+ len:=xh-xl+1;
+ LineWrite(Space(len));
+ blank_with_attribute.ch:=' ';
+ blank_with_attribute.attr:=TextAttr;
+ FillWord(ConsoleBuf^[(y-1)*ScreenWidth+xl-1],len,word(blank_with_attribute));
+End;
+
+
+procedure DoScrollLine(y1,y2,xl,xh:longint);
+{
+ Move Line y1 to y2, use only columns Xl-Xh, Memory is updated also
+}
+var
+ Temp : string;
+ idx,
+ OldAttr,
+ x,attr : longint;
+begin
+ ttyGotoXY(xl,y2);
+{ precalc ConsoleBuf[] y-offset }
+ idx:=(y1-1)*ScreenWidth-1;
+{ update screen }
+ OldAttr:=$ff;
+ Temp:='';
+ For x:=xl To xh Do
+ Begin
+ attr:=ConsoleBuf^[idx+x].attr;
+ if (attr<>OldAttr) and (not OutputRedir) then
+ begin
+ temp:=temp+Attr2Ansi(Attr,OldAttr);
+ OldAttr:=Attr;
+ end;
+ Temp:=Temp+ConsoleBuf^[idx+x].ch;
+ if (x=xh) or (length(Temp)>240) then
+ begin
+ LineWrite(Temp);
+ Temp:='';
+ end;
+ End;
+{Update memory copy}
+ Move(ConsoleBuf^[(y1-1)*ScreenWidth+xl-1],ConsoleBuf^[(y2-1)*ScreenWidth+xl-1],(xh-xl+1)*2);
+end;
+
+
+
+Procedure TextColor(Color: Byte);
+{
+ Switch foregroundcolor
+}
+ var AddBlink : byte;
+Begin
+ If (Color>15) Then
+ AddBlink:=Blink
+ else
+ AddBlink:=0;
+ ttyColor((Color and $f) or (TextAttr and $70) or AddBlink);
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+ Switch backgroundcolor
+}
+Begin
+ TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink));
+ ttyColor(TextAttr);
+End;
+
+
+
+Procedure HighVideo;
+{
+ Set highlighted output.
+}
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+ Set normal output
+}
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+ Set normal back and foregroundcolors.
+}
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+ Go to coordinates X,Y in the current window.
+}
+Begin
+ If (X>0) and (X<=WinMaxX- WinMinX+1) and
+ (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+ Begin
+ Inc(X,WinMinX-1);
+ Inc(Y,WinMinY-1);
+ ttyGotoXY(x,y);
+ End;
+End;
+
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+ Set screen window to the specified coordinates.
+}
+Begin
+ if (X1>X2) or (X2>ScreenWidth) or
+ (Y1>Y2) or (Y2>ScreenHeight) then
+ exit;
+ WinMinX:=X1;
+ WinMaxX:=X2;
+ WinMinY:=Y1;
+ WinMaxY:=Y2;
+ WindMin:=((Y1-1) Shl 8)+(X1-1);
+ WindMax:=((Y2-1) Shl 8)+(X2-1);
+ GoToXY(1,1);
+End;
+
+
+
+Procedure ClrScr;
+{
+ Clear the current window, and set the cursor on 1,1
+}
+Var
+ CY,i : Longint;
+ oldflush : boolean;
+ blank_with_attribute : TCharAttr;
+
+Begin
+ { See if color has changed }
+ if OldTextAttr<>TextAttr then
+ begin
+ i:=TextAttr;
+ TextAttr:=OldTextAttr;
+ ttyColor(i);
+ end;
+ oldflush:=ttySetFlush(Flushing);
+ if FullWin then
+ begin
+ if not OutputRedir then
+ ttySendStr(#27'[H'#27'[2J');
+ CurrX:=1;
+ CurrY:=1;
+ blank_with_attribute.ch := ' ';
+ blank_with_attribute.attr := TextAttr;
+ FillWord(ConsoleBuf^,ScreenWidth*ScreenHeight,word(blank_with_attribute));
+ end
+ else
+ begin
+ For Cy:=WinMinY To WinMaxY Do
+ DoEmptyLine(Cy,WinMinX,WinMaxX);
+ GoToXY(1,1);
+ end;
+ ttySetFlush(oldflush);
+End;
+
+
+
+Procedure ClrEol;
+{
+ Clear from current position to end of line.
+}
+var
+ len,i : longint;
+ IsLastLine : boolean;
+Begin
+ { See if color has changed }
+ if OldTextAttr<>TextAttr then
+ begin
+ i:=TextAttr;
+ TextAttr:=OldTextAttr;
+ ttyColor(i);
+ end;
+ if FullWin or (WinMaxX = ScreenWidth) then
+ begin
+ if not OutputRedir then
+ ttySendStr(#27'[K');
+ end
+ else
+ begin
+ { Tweak winmaxx and winmaxy so no scrolling happends }
+ len:=WinMaxX-CurrX+1;
+ IsLastLine:=false;
+ if CurrY=WinMaxY then
+ begin
+ inc(WinMaxX,3);
+ inc(WinMaxY,2);
+ IsLastLine:=true;
+ end;
+ ttySendStr(Space(len));
+ if IsLastLine then
+ begin
+ dec(WinMaxX,3);
+ dec(WinMaxY,2);
+ end;
+ ttyGotoXY(0,0);
+ end;
+End;
+
+
+
+Function WhereX: Byte;
+{
+ Return current X-position of cursor.
+}
+Begin
+ WhereX:=CurrX-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+ Return current Y-position of cursor.
+}
+Begin
+ WhereY:=CurrY-WinMinY+1;
+End;
+
+
+
+Procedure ScrollScrnRegionUp(xl,yl,xh,yh, count: longint);
+{
+ Scroll the indicated region count lines up. The empty lines are filled
+ with blanks in the current color. The screen position is restored
+ afterwards.
+}
+Var
+ y,oldx,oldy : byte;
+ oldflush : boolean;
+Begin
+ oldflush:=ttySetFlush(Flushing);
+ oldx:=CurrX;
+ oldy:=CurrY;
+{Scroll}
+ For y:=yl to yh-count do
+ DoScrollLine(y+count,y,xl,xh);
+{Restore TextAttr}
+ ttySendStr(Attr2Ansi(TextAttr,$ff));
+{Fill the rest with empty lines}
+ for y:=yh-count+1 to yh do
+ DoEmptyLine(y,xl,xh);
+{Restore current position}
+ ttyGotoXY(OldX,OldY);
+ ttySetFlush(oldflush);
+End;
+
+
+
+Procedure ScrollScrnRegionDown(xl,yl,xh,yh, count: longint);
+{
+ Scroll the indicated region count lines down. The empty lines are filled
+ with blanks in the current color. The screen position is restored
+ afterwards.
+}
+Var
+ y,oldx,oldy : byte;
+ oldflush : boolean;
+Begin
+ oldflush:=ttySetFlush(Flushing);
+ oldx:=CurrX;
+ oldy:=CurrY;
+{Scroll}
+ for y:=yh downto yl+count do
+ DoScrollLine(y-count,y,xl,xh);
+{Restore TextAttr}
+ ttySendStr(Attr2Ansi(TextAttr,$ff));
+{Fill the rest with empty lines}
+ for y:=yl to yl+count-1 do
+ DoEmptyLine(y,xl,xh);
+{Restore current position}
+ ttyGotoXY(OldX,OldY);
+ ttySetFlush(oldflush);
+End;
+
+
+
+{*************************************************************************
+ KeyBoard
+*************************************************************************}
+
+Const
+ KeyBufferSize = 20;
+var
+ KeyBuffer : Array[0..KeyBufferSize-1] of Char;
+ KeyPut,
+ KeySend : longint;
+
+Procedure PushKey(Ch:char);
+Var
+ Tmp : Longint;
+Begin
+ Tmp:=KeyPut;
+ Inc(KeyPut);
+ If KeyPut>=KeyBufferSize Then
+ KeyPut:=0;
+ If KeyPut<>KeySend Then
+ KeyBuffer[Tmp]:=Ch
+ Else
+ KeyPut:=Tmp;
+End;
+
+
+
+Function PopKey:char;
+Begin
+ If KeyPut<>KeySend Then
+ Begin
+ PopKey:=KeyBuffer[KeySend];
+ Inc(KeySend);
+ If KeySend>=KeyBufferSize Then
+ KeySend:=0;
+ End
+ Else
+ PopKey:=#0;
+End;
+
+
+
+Procedure PushExt(b:byte);
+begin
+ PushKey(#0);
+ PushKey(chr(b));
+end;
+
+
+
+const
+ AltKeyStr : string[38]='qwertyuiopasdfghjklzxcvbnm1234567890-=';
+ AltCodeStr : string[38]=#016#017#018#019#020#021#022#023#024#025#030#031#032#033#034#035#036#037#038+
+ #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131;
+Function FAltKey(ch:char):byte;
+var
+ Idx : longint;
+Begin
+ Idx:=Pos(ch,AltKeyStr);
+ if Idx>0 then
+ FAltKey:=byte(AltCodeStr[Idx])
+ else
+ FAltKey:=0;
+End;
+
+{ This one doesn't care about keypresses already processed by readkey }
+{ and waiting in the KeyBuffer, only about waiting keypresses at the }
+{ TTYLevel (including ones that are waiting in the TTYRecvChar buffer) }
+function sysKeyPressed: boolean;
+var
+ fdsin : tfdSet;
+begin
+ if (InCnt>0) then
+ sysKeyPressed:=true
+ else
+ begin
+ fpFD_ZERO(fdsin);
+ fpFD_SET(TTYin,fdsin);
+ sysKeypressed:=(fpSelect(TTYIn+1,@fdsin,nil,nil,0)>0);
+ end;
+end;
+
+Function KeyPressed:Boolean;
+Begin
+ Keypressed := (KeySend<>KeyPut) or sysKeyPressed;
+End;
+
+Function ReadKey:char;
+Var
+ ch : char;
+ OldState,
+ State : longint;
+ FDS : TFDSet;
+Begin
+{Check Buffer first}
+ if KeySend<>KeyPut then
+ begin
+ ReadKey:=PopKey;
+ exit;
+ end;
+{Wait for Key}
+{ Only if none are waiting! (JM) }
+ if not sysKeyPressed then
+ begin
+ FpFD_ZERO (FDS);
+ fpFD_SET (0,FDS);
+ fpSelect (1,@FDS,nil,nil,nil);
+ end;
+
+ ch:=ttyRecvChar;
+{Esc Found ?}
+ CASE ch OF
+ #27: begin
+ State:=1;
+ Delay(10);
+ { This has to be sysKeyPressed and not "keyPressed", since after }
+ { one iteration keyPressed will always be true because of the }
+ { pushKey commands (JM) }
+ while (State<>0) and (sysKeyPressed) do
+ begin
+ ch:=ttyRecvChar;
+ OldState:=State;
+ State:=0;
+ case OldState of
+ 1 : begin {Esc}
+ case ch of
+ 'a'..'z',
+ '0'..'9',
+ '-','=' : PushExt(FAltKey(ch));
+ #10 : PushKey(#10);
+ '[' : State:=2;
+{$IFDEF Unix}
+ 'O': State:=7;
+{$ENDIF}
+ else
+ begin
+ PushKey(ch);
+ PushKey(#27);
+ end;
+ end;
+ end;
+ 2 : begin {Esc[}
+ case ch of
+ '[' : State:=3;
+ 'A' : PushExt(72);
+ 'B' : PushExt(80);
+ 'C' : PushExt(77);
+ 'D' : PushExt(75);
+ {$IFDEF FREEBSD}
+ {'E' - Center key, not handled in DOS TP7}
+ 'F' : PushExt(79); {End}
+ 'G': PushExt(81); {PageDown}
+ {$ELSE}
+ 'G' : PushKey('5'); {Center key, Linux}
+ {$ENDIF}
+ 'H' : PushExt(71);
+ {$IFDEF FREEBSD}
+ 'I' : PushExt(73); {PageUp}
+ {$ENDIF}
+ 'K' : PushExt(79);
+ {$IFDEF FREEBSD}
+ 'L' : PushExt(82); {Insert - Deekoo}
+ 'M' : PushExt(59); {F1-F10 - Deekoo}
+ 'N' : PushExt(60); {F2}
+ 'O' : PushExt(61); {F3}
+ 'P' : PushExt(62); {F4}
+ 'Q' : PushExt(63); {F5}
+ 'R' : PushExt(64); {F6}
+ 'S' : PushExt(65); {F7}
+ 'T' : PushExt(66); {F8}
+ 'U' : PushExt(67); {F9}
+ 'V' : PushExt(68); {F10}
+ {Not sure if TP/BP handles F11 and F12 like this normally;
+ In pcemu, a TP7 executable handles 'em this way, though.}
+ 'W' : PushExt(133); {F11}
+ 'X' : PushExt(134); {F12}
+ 'Y' : PushExt(84); {Shift-F1}
+ 'Z' : PushExt(85); {Shift-F2}
+ 'a' : PushExt(86); {Shift-F3}
+ 'b' : PushExt(87); {Shift-F4}
+ 'c' : PushExt(88); {Shift-F5}
+ 'd' : PushExt(89); {Shift-F6}
+ 'e' : PushExt(90); {Shift-F7}
+ 'f' : PushExt(91); {Shift-F8}
+ 'g' : PushExt(92); {Shift-F9}
+ 'h' : PushExt(93); {Shift-F10}
+ 'i' : PushExt(135); {Shift-F11}
+ 'j' : PushExt(136); {Shift-F12}
+ 'k' : PushExt(94); {Ctrl-F1}
+ 'l' : PushExt(95);
+ 'm' : PushExt(96);
+ 'n' : PushExt(97);
+ 'o' : PushExt(98);
+ 'p' : PushExt(99);
+ 'q' : PushExt(100);
+ 'r' : PushExt(101);
+ 's' : PushExt(102);
+ 't' : PushExt(103); {Ctrl-F10}
+ 'u' : PushExt(137); {Ctrl-F11}
+ 'v' : PushExt(138); {Ctrl-F12}
+ {$ENDIF}
+ '1' : State:=4;
+ '2' : State:=5;
+ '3' : State:=6;
+ '4' : PushExt(79);
+ '5' : PushExt(73);
+ '6' : PushExt(81);
+ else
+ begin
+ PushKey(ch);
+ PushKey('[');
+ PushKey(#27);
+ end;
+ end;
+ if ch in ['4'..'6'] then
+ State:=255;
+ end;
+ 3 : begin {Esc[[}
+ case ch of
+ 'A' : PushExt(59);
+ 'B' : PushExt(60);
+ 'C' : PushExt(61);
+ 'D' : PushExt(62);
+ 'E' : PushExt(63);
+ end;
+ end;
+ 4 : begin {Esc[1}
+ case ch of
+ '~' : PushExt(71);
+ '7' : PushExt(64);
+ '8' : PushExt(65);
+ '9' : PushExt(66);
+ end;
+ if (Ch<>'~') then
+ State:=255;
+ end;
+ 5 : begin {Esc[2}
+ case ch of
+ '~' : PushExt(82);
+ '0' : pushExt(67);
+ '1' : PushExt(68);
+ '3' : PushExt(133); {F11}
+ {Esc[23~ is also shift-F1,shift-F11}
+ '4' : PushExt(134); {F12}
+ {Esc[24~ is also shift-F2,shift-F12}
+ '5' : PushExt(86); {Shift-F3}
+ '6' : PushExt(87); {Shift-F4}
+ '8' : PushExt(88); {Shift-F5}
+ '9' : PushExt(89); {Shift-F6}
+ end;
+ if (Ch<>'~') then
+ State:=255;
+ end;
+ 6 : begin {Esc[3}
+ case ch of
+ '~' : PushExt(83); {Del}
+ '1' : PushExt(90); {Shift-F7}
+ '2' : PushExt(91); {Shift-F8}
+ '3' : PushExt(92); {Shift-F9}
+ '4' : PushExt(93); {Shift-F10}
+ end;
+ if (Ch<>'~') then
+ State:=255;
+ end;
+{$ifdef Unix}
+ 7 : begin {Esc[O}
+ case ch of
+ 'A' : PushExt(72);
+ 'B' : PushExt(80);
+ 'C' : PushExt(77);
+ 'D' : PushExt(75);
+ end;
+ end;
+{$endif}
+ 255 : ;
+ end;
+ if State<>0 then
+ Delay(10);
+ end;
+ if State=1 then
+ PushKey(ch);
+ end;
+ #127: PushKey(#8);
+ else PushKey(ch);
+ End;
+ ReadKey:=PopKey;
+End;
+
+
+Procedure Delay(MS: Word);
+{
+ Wait for DTime milliseconds.
+}
+Begin
+ fpSelect(0,nil,nil,nil,MS);
+End;
+
+
+{****************************************************************************
+ Write(ln)/Read(ln) support
+****************************************************************************}
+
+procedure DoLn;
+begin
+ if CurrY=WinMaxY then
+ begin
+ if FullWin then
+ begin
+ ttySendStr(#10#13);
+ CurrX:=WinMinX;
+ CurrY:=WinMaxY;
+ end
+ else
+ begin
+ ScrollScrnRegionUp(WinMinX,WinMinY,WinMaxX,WinMaxY,1);
+ ttyGotoXY(WinMinX,WinMaxY);
+ end;
+ end
+ else
+ ttyGotoXY(WinMinX,CurrY+1);
+end;
+
+
+var
+ Lastansi : boolean;
+ AnsiCode : string;
+Procedure DoWrite(const s:String);
+{
+ Write string to screen, parse most common AnsiCodes
+}
+var
+ found,
+ OldFlush : boolean;
+ x,y,
+ i,j,
+ SendBytes : longint;
+
+ function AnsiPara(var hstr:string):byte;
+ var
+ k,j : longint;
+ code : word;
+ begin
+ j:=pos(';',hstr);
+ if j=0 then
+ j:=length(hstr);
+ val(copy(hstr,3,j-3),k,code);
+ Delete(hstr,3,j-2);
+ if k=0 then
+ k:=1;
+ AnsiPara:=k;
+ end;
+
+ procedure SendText;
+ var
+ LeftX : longint;
+ begin
+ while (SendBytes>0) do
+ begin
+ LeftX:=WinMaxX-CurrX+1;
+ if (SendBytes>LeftX) then
+ begin
+ ttyWrite(Copy(s,i-SendBytes,LeftX));
+ dec(SendBytes,LeftX);
+ DoLn;
+ end
+ else
+ begin
+ ttyWrite(Copy(s,i-SendBytes,SendBytes));
+ SendBytes:=0;
+ end;
+ end;
+ end;
+
+begin
+ oldflush:=ttySetFlush(Flushing);
+{ Support textattr:= changing }
+ if OldTextAttr<>TextAttr then
+ begin
+ i:=TextAttr;
+ TextAttr:=OldTextAttr;
+ ttyColor(i);
+ end;
+{ write the stuff }
+ SendBytes:=0;
+ i:=1;
+ while (i<=length(s)) do
+ begin
+ if (s[i]=#27) or (LastAnsi) then
+ begin
+ SendText;
+ LastAnsi:=false;
+ j:=i;
+ found:=false;
+ while (j<=length(s)) and (not found) do
+ begin
+ found:=not (s[j] in [#27,'[','0'..'9',';','?']);
+ inc(j);
+ end;
+ Ansicode:=AnsiCode+Copy(s,i,j-i);
+ if found then
+ begin
+ case AnsiCode[length(AnsiCode)] of
+ 'm' : ttyColor(Ansi2Attr(AnsiCode,TextAttr));
+ 'H' : begin {No other way :( Coz First Para=Y}
+ y:=AnsiPara(AnsiCode);
+ x:=AnsiPara(AnsiCode);
+ GotoXY(x,y);
+ end;
+ 'J' : if AnsiPara(AnsiCode)=2 then
+ ClrScr;
+ 'K' : ClrEol;
+ 'A' : GotoXY(CurrX,Max(CurrY-AnsiPara(AnsiCode),WinMinY));
+ 'B' : GotoXY(CurrX,Min(CurrY+AnsiPara(AnsiCode),WinMaxY));
+ 'C' : GotoXY(Min(CurrX+AnsiPara(AnsiCode),WinMaxX),CurrY);
+ 'D' : GotoXY(Max(CurrX-AnsiPara(AnsiCode),WinMinX),CurrY);
+ 'h' : ; {Stupid Thedraw [?7h Code}
+ else
+ found:=false;
+ end;
+ end
+ else
+ begin
+ LastAnsi:=true;
+ found:=true;
+ end;
+ {Clear AnsiCode?}
+ if not LastAnsi then
+ AnsiCode:='';
+ {Increase Idx or SendBytes}
+ if found then
+ i:=j-1
+ else
+ inc(SendBytes);
+ end
+ else
+ begin
+ LastAnsi:=false;
+ case s[i] of
+ #13 : begin {CR}
+ SendText;
+ ttyGotoXY(WinMinX,CurrY);
+ end;
+ #10 : begin {NL}
+ SendText;
+ DoLn;
+ end;
+ #9 : begin {Tab}
+ SendText;
+ ttyWrite(Space(9-((CurrX-1) and $08)));
+ end;
+ #8 : begin {BackSpace}
+ SendText;
+ ttyWrite(#8);
+ end;
+ else
+ inc(SendBytes);
+ end;
+ end;
+ inc(i);
+ end;
+ if SendBytes>0 then
+ SendText;
+ ttySetFlush(oldFLush);
+end;
+
+
+Function CrtWrite(Var F: TextRec): Integer;
+{
+ Top level write function for CRT
+}
+Var
+ Temp : String;
+ idx,i : Longint;
+ oldflush : boolean;
+Begin
+ oldflush:=ttySetFlush(Flushing);
+ idx:=0;
+ while (F.BufPos>0) do
+ begin
+ i:=F.BufPos;
+ if i>255 then
+ i:=255;
+ Move(F.BufPTR^[idx],Temp[1],i);
+ SetLength(Temp,i);
+ DoWrite(Temp);
+ dec(F.BufPos,i);
+ inc(idx,i);
+ end;
+
+ ttySetFlush(oldFLush);
+ CrtWrite:=0;
+End;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+{
+ Read from CRT associated file.
+}
+var
+ c : char;
+ i : longint;
+Begin
+ if isATTY(F.Handle)<>-1 then
+ begin
+ F.BufPos := 0;
+ i := 0;
+ repeat
+ c := readkey;
+ case c of
+ { ignore special keys }
+ #0:
+ c:= readkey;
+ { Backspace }
+ #8:
+ if i > 0 then
+ begin
+ if not(OutputRedir or InputRedir) then
+ write(#8#32#8);
+ dec(i);
+ end;
+ { Unhandled extended key }
+ #27:;
+ { CR }
+ #13:
+ begin
+ F.BufPtr^[i] := #10;
+ if not(OutputRedir or InputRedir) then
+ write(#10);
+ inc(i);
+ end;
+ else
+ begin
+ if not(OutputRedir or InputRedir) then
+ write(c);
+ F.BufPtr^[i] := c;
+ inc(i);
+ end;
+ end;
+ until (c in [#10,#13]) or (i >= F.BufSize);
+ F.BufEnd := i;
+ CrtRead := 0;
+ exit;
+ end;
+ F.BufEnd:=fpRead(F.Handle, F.BufPtr^, F.BufSize);
+{ fix #13 only's -> #10 to overcome terminal setting }
+ for i:=1to F.BufEnd do
+ begin
+ if (F.BufPtr^[i-1]=#13) and (F.BufPtr^[i]<>#10) then
+ F.BufPtr^[i-1]:=#10;
+ end;
+ F.BufPos:=F.BufEnd;
+ if not(OutputRedir or InputRedir) then
+ CrtWrite(F)
+ else F.BufPos := 0;
+ CrtRead:=0;
+End;
+
+
+Function CrtReturn(Var F:TextRec):Integer;
+Begin
+ CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+{
+ Close CRT associated file.
+}
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+{
+ Open CRT associated file.
+}
+Begin
+ If F.Mode=fmOutput Then
+ begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end
+ Else
+ begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+{
+ Assign a file to the console. All output on file goes to console instead.
+}
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+
+{******************************************************************************
+ High Level Functions
+******************************************************************************}
+
+Procedure DelLine;
+{
+ Delete current line. Scroll subsequent lines up
+}
+Begin
+ ScrollScrnRegionUp(WinMinX, CurrY, WinMaxX, WinMaxY, 1);
+End;
+
+
+
+Procedure InsLine;
+{
+ Insert line at current cursor position. Scroll subsequent lines down.
+}
+Begin
+ ScrollScrnRegionDown(WinMinX, CurrY, WinMaxX, WinMaxY, 1);
+End;
+
+
+const
+ KIOCSOUND = $4B2F; // start sound generation (0 for off)
+
+Procedure Sound(Hz: Word);
+begin
+ if not OutputRedir then
+ fpIoctl(TextRec(Output).Handle, KIOCSOUND, Pointer(1193180 div Hz));
+end;
+
+
+
+Procedure NoSound;
+begin
+ if not OutputRedir then
+ fpIoctl(TextRec(Output).Handle, KIOCSOUND, nil);
+end;
+
+
+
+Procedure TextMode(Mode: Integer);
+{
+ Only Clears Screen under linux}
+begin
+ ClrScr;
+end;
+
+
+{******************************************************************************
+ Extra
+******************************************************************************}
+
+procedure CursorBig;
+begin
+ ttySendStr(#27'[?17;0;64c');
+end;
+
+
+procedure CursorOn;
+begin
+ ttySendStr(#27'[?2c');
+end;
+
+
+procedure CursorOff;
+begin
+ ttySendStr(#27'[?1c');
+end;
+
+
+{******************************************************************************
+ Initialization
+******************************************************************************}
+
+var
+ OldIO : termio.TermIos;
+ inputRaw, outputRaw: boolean;
+
+procedure saveRawSettings(const tio: termio.termios);
+Begin
+ with tio do
+ begin
+ inputRaw :=
+ ((c_iflag and (IGNBRK or BRKINT or PARMRK or ISTRIP or
+ INLCR or IGNCR or ICRNL or IXON)) = 0) and
+ ((c_lflag and (ECHO or ECHONL or ICANON or ISIG or IEXTEN)) = 0);
+ outPutRaw :=
+ ((c_oflag and OPOST) = 0) and
+ ((c_cflag and (CSIZE or PARENB)) = 0) and
+ ((c_cflag and CS8) <> 0);
+ end;
+end;
+
+procedure restoreRawSettings(tio: termio.termios);
+begin
+ with tio do
+ begin
+ if inputRaw then
+ begin
+ c_iflag := c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
+ INLCR or IGNCR or ICRNL or IXON));
+ c_lflag := c_lflag and
+ (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
+ end;
+ if outPutRaw then
+ begin
+ c_oflag := c_oflag and not(OPOST);
+ c_cflag := c_cflag and not(CSIZE or PARENB) or CS8;
+ end;
+ end;
+end;
+
+
+Procedure SetRawMode(b:boolean);
+Var
+ Tio : Termios;
+Begin
+ if b then
+ begin
+ TCGetAttr(1,Tio);
+ SaveRawSettings(Tio);
+ OldIO:=Tio;
+ CFMakeRaw(Tio);
+ end
+ else
+ begin
+ RestoreRawSettings(OldIO);
+ Tio:=OldIO;
+ end;
+ TCSetAttr(1,TCSANOW,Tio);
+End;
+
+
+
+procedure GetXY(var x,y:byte);
+var
+ fds : tfdSet;
+ i,j,
+ readed : longint;
+ buf : array[0..255] of char;
+ s : string[16];
+begin
+ x:=0;
+ y:=0;
+ s:=#27'[6n';
+ fpWrite(0,s[1],length(s));
+ fpFD_ZERO(fds);
+ fpFD_SET(1,fds);
+ if (fpSelect(2,@fds,nil,nil,1000)>0) then
+ begin
+ readed:=fpRead(1,buf,sizeof(buf));
+ i:=0;
+ while (i+5<readed) and (buf[i]<>#27) and (buf[i+1]<>'[') do
+ inc(i);
+ if i+5<readed then
+ begin
+ s:=space(16);
+ move(buf[i+2],s[1],16);
+ i:=Pos(';',s);
+ if i>0 then
+ begin
+ Val(Copy(s,1,i-1),y);
+ j:=Pos('R',s);
+ if j=0 then
+ j:=length(s);
+ Val(Copy(s,i+1,j-(i+1)),x);
+ end;
+ end;
+ end;
+end;
+
+
+Procedure GetConsoleBuf;
+var
+ WinInfo : TWinSize;
+begin
+ if Assigned(ConsoleBuf) then
+ FreeMem(ConsoleBuf,ScreenHeight*ScreenWidth*2);
+ ScreenWidth:=0;
+ ScreenHeight:=0;
+ if (not OutputRedir) and (fpIOCtl(TextRec(Output).Handle,TIOCGWINSZ,@Wininfo)>=0) then
+ begin
+ ScreenWidth:=Wininfo.ws_col;
+ ScreenHeight:=Wininfo.ws_row;
+ end;
+ // Set some arbitrary defaults which make some sense...
+ If (ScreenWidth=0) then
+ ScreenWidth:=80;
+ If (ScreenHeight=0) then
+ ScreenHeight:=25;
+ GetMem(ConsoleBuf,ScreenHeight*ScreenWidth*2);
+ FillChar(ConsoleBuf^,ScreenHeight*ScreenWidth*2,0);
+end;
+
+
+Initialization
+{ Redirect the standard output }
+ assigncrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:=StdOutputHandle;
+ assigncrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:=StdInputHandle;
+{ Are we redirected to a file ? }
+ OutputRedir:= IsAtty(TextRec(Output).Handle)=-1;
+{ does the input come from another console or from a file? }
+ InputRedir :=
+ (IsAtty(TextRec(Input).Handle)=-1) or
+ (not OutputRedir and
+ (TTYName(TextRec(Input).Handle) <> TTYName(TextRec(Output).Handle)));
+{ Get Size of terminal and set WindMax to the window }
+ GetConsoleBuf;
+ WinMinX:=1;
+ WinMinY:=1;
+ WinMaxX:=ScreenWidth;
+ WinMaxY:=ScreenHeight;
+ WindMax:=((ScreenHeight-1) Shl 8)+(ScreenWidth-1);
+{Get Current X&Y or Reset to Home}
+ if OutputRedir then
+ begin
+ CurrX:=1;
+ CurrY:=1;
+ end
+ else
+ begin
+ { Set default Terminal Settings }
+ SetRawMode(True);
+ { Get current X,Y if not set already }
+ GetXY(CurrX,CurrY);
+ if (CurrX=0) then
+ begin
+ CurrX:=1;
+ CurrY:=1;
+ ttySendStr(#27'[H');
+ end;
+ {Reset Attribute (TextAttr=7 at startup)}
+ ttySendStr(#27'[m');
+ end;
+
+Finalization
+ ttyFlushOutput;
+ if not OutputRedir then
+ SetRawMode(False);
+{ remove console buf }
+ if Assigned(ConsoleBuf) then
+ FreeMem(ConsoleBuf,ScreenHeight*ScreenWidth*2);
+
+End.
+{
+ $Log: crt.pp,v $
+ Revision 1.24 2005/03/16 18:17:23 jonas
+ * fix from mischi to fix extra spaces under some terminals
+
+ Revision 1.23 2005/03/15 09:20:11 jonas
+ * endianess fixes from mischi
+
+ Revision 1.22 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp
new file mode 100644
index 0000000000..39230c0ba2
--- /dev/null
+++ b/rtl/unix/cthreads.pp
@@ -0,0 +1,697 @@
+{
+ $Id: cthreads.pp,v 1.28 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$ifdef linux}
+{$define dynpthreads} // Useless on BSD, since they are in libc
+{$endif}
+
+unit cthreads;
+interface
+{$S-}
+
+{$ifndef dynpthreads} // If you have problems compiling this on FreeBSD 5.x
+ {$linklib c} // try adding -Xf
+ {$ifndef Darwin}
+ {$linklib pthread}
+ {$endif darwin}
+{$endif}
+
+Procedure SetCThreadManager;
+
+implementation
+
+Uses
+ BaseUnix,
+ unix,
+ unixtype,
+ sysutils
+{$ifdef dynpthreads}
+ ,dl
+{$endif}
+ ;
+
+{*****************************************************************************
+ Generic overloaded
+*****************************************************************************}
+
+{ Include OS specific parts. }
+{$i pthread.inc}
+
+Type PINTRTLEvent = ^TINTRTLEvent;
+ TINTRTLEvent = record
+ condvar: pthread_cond_t;
+ mutex: pthread_mutex_t;
+ end;
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+ const
+ threadvarblocksize : dword = 0;
+
+
+ var
+ TLSKey : pthread_key_t;
+
+ procedure CInitThreadvar(var offset : dword;size : dword);
+ begin
+ {$ifdef cpusparc}
+ threadvarblocksize:=align(threadvarblocksize,16);
+ {$endif cpusparc}
+
+ {$ifdef cpupowerpc}
+ threadvarblocksize:=align(threadvarblocksize,8);
+ {$endif cpupowerc}
+
+ {$ifdef cpui386}
+ threadvarblocksize:=align(threadvarblocksize,8);
+ {$endif cpui386}
+
+ {$ifdef cpuarm}
+ threadvarblocksize:=align(threadvarblocksize,4);
+ {$endif cpuarm}
+
+ {$ifdef cpum68k}
+ threadvarblocksize:=align(threadvarblocksize,2);
+ {$endif cpum68k}
+
+ {$ifdef cpux86_64}
+ threadvarblocksize:=align(threadvarblocksize,16);
+ {$endif cpux86_64}
+
+ offset:=threadvarblocksize;
+
+ inc(threadvarblocksize,size);
+ end;
+
+ function CRelocateThreadvar(offset : dword) : pointer;
+ begin
+ CRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
+ end;
+
+
+ procedure CAllocateThreadVars;
+ var
+ dataindex : pointer;
+ begin
+ { we've to allocate the memory from system }
+ { because the FPC heap management uses }
+ { exceptions which use threadvars but }
+ { these aren't allocated yet ... }
+ { allocate room on the heap for the thread vars }
+ DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+ FillChar(DataIndex^,threadvarblocksize,0);
+ pthread_setspecific(tlskey,dataindex);
+ end;
+
+
+ procedure CReleaseThreadVars;
+ begin
+ {$ifdef ver1_0}
+ Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize);
+ {$else}
+ Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
+ {$endif}
+ end;
+
+{ Include OS independent Threadvar initialization }
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+ Thread starting
+*****************************************************************************}
+
+ type
+ pthreadinfo = ^tthreadinfo;
+ tthreadinfo = record
+ f : tthreadfunc;
+ p : pointer;
+ stklen : cardinal;
+ end;
+
+ procedure DoneThread;
+ begin
+ { Release Threadvars }
+{$ifdef HASTHREADVAR}
+ CReleaseThreadVars;
+{$endif HASTHREADVAR}
+ end;
+
+
+ function ThreadMain(param : pointer) : pointer;cdecl;
+ var
+ ti : tthreadinfo;
+{$ifdef DEBUG_MT}
+ // in here, don't use write/writeln before having called
+ // InitThread! I wonder if anyone ever debugged these routines,
+ // because they will have crashed if DEBUG_MT was enabled!
+ // this took me the good part of an hour to figure out
+ // why it was crashing all the time!
+ // this is kind of a workaround, we simply write(2) to fd 0
+ s: string[100]; // not an ansistring
+{$endif DEBUG_MT}
+ begin
+{$ifdef DEBUG_MT}
+ s := 'New thread started, initing threadvars'#10;
+ fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+{$ifdef HASTHREADVAR}
+ { Allocate local thread vars, this must be the first thing,
+ because the exception management and io depends on threadvars }
+ CAllocateThreadVars;
+{$endif HASTHREADVAR}
+ { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+ s := 'New thread started, initialising ...'#10;
+ fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+ ti:=pthreadinfo(param)^;
+ dispose(pthreadinfo(param));
+ { Initialize thread }
+ InitThread(ti.stklen);
+ { Start thread function }
+{$ifdef DEBUG_MT}
+ writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+ ThreadMain:=pointer(ti.f(ti.p));
+ DoneThread;
+ pthread_detach(pthread_t(pthread_self()));
+ end;
+
+
+ function CBeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;
+ creationFlags : dword; var ThreadId : THandle) : DWord;
+ var
+ ti : pthreadinfo;
+ thread_attr : pthread_attr_t;
+ begin
+{$ifdef DEBUG_MT}
+ writeln('Creating new thread');
+{$endif DEBUG_MT}
+ { Initialize multithreading if not done }
+ if not IsMultiThread then
+ begin
+{$ifdef HASTHREADVAR}
+ { We're still running in single thread mode, setup the TLS }
+ pthread_key_create(@TLSKey,nil);
+ InitThreadVars(@CRelocateThreadvar);
+{$endif HASTHREADVAR}
+ IsMultiThread:=true;
+ end;
+ { the only way to pass data to the newly created thread
+ in a MT safe way, is to use the heap }
+ new(ti);
+ ti^.f:=ThreadFunction;
+ ti^.p:=p;
+ ti^.stklen:=stacksize;
+ { call pthread_create }
+{$ifdef DEBUG_MT}
+ writeln('Starting new thread');
+{$endif DEBUG_MT}
+ pthread_attr_init(@thread_attr);
+ pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
+
+ // will fail under linux -- apparently unimplemented
+ pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
+
+ // don't create detached, we need to be able to join (waitfor) on
+ // the newly created thread!
+ //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
+ if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
+ threadid := 0;
+ end;
+ CBeginThread:=threadid;
+{$ifdef DEBUG_MT}
+ writeln('BeginThread returning ',CBeginThread);
+{$endif DEBUG_MT}
+ end;
+
+
+ procedure CEndThread(ExitCode : DWord);
+ begin
+ DoneThread;
+ pthread_detach(pthread_t(pthread_self()));
+ pthread_exit(pointer(ptrint(ExitCode)));
+ end;
+
+
+
+ function CSuspendThread (threadHandle : TThreadID) : dword;
+ begin
+ {$Warning SuspendThread needs to be implemented}
+ end;
+
+
+ function CResumeThread (threadHandle : TThreadID) : dword;
+ begin
+ {$Warning ResumeThread needs to be implemented}
+ end;
+
+
+ procedure CThreadSwitch; {give time to other threads}
+ begin
+ {extern int pthread_yield (void) __THROW;}
+ {$Warning ThreadSwitch needs to be implemented}
+ end;
+
+
+ function CKillThread (threadHandle : TThreadID) : dword;
+ begin
+ pthread_detach(pthread_t(threadHandle));
+ CKillThread := pthread_cancel(pthread_t(threadHandle));
+ end;
+
+
+ function CWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout}
+ var
+ LResultP: Pointer;
+ LResult: DWord;
+ begin
+ LResult := 0;
+ LResultP := @LResult;
+ pthread_join(pthread_t(threadHandle), @LResultP);
+ CWaitForThreadTerminate := LResult;
+ end;
+
+{$warning threadhandle can be larger than a dword}
+ function CThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal}
+ begin
+ {$Warning ThreadSetPriority needs to be implemented}
+ end;
+
+
+{$warning threadhandle can be larger than a dword}
+ function CThreadGetPriority (threadHandle : TThreadID): Integer;
+ begin
+ {$Warning ThreadGetPriority needs to be implemented}
+ end;
+
+
+ function CGetCurrentThreadId : TThreadID;
+ begin
+ CGetCurrentThreadId:=dword(pthread_self());
+ end;
+
+
+{*****************************************************************************
+ Delphi/Win32 compatibility
+*****************************************************************************}
+
+ procedure CInitCriticalSection(var CS);
+
+ var
+ MAttr : pthread_mutexattr_t;
+ res: longint;
+ begin
+ res:=pthread_mutexattr_init(@MAttr);
+ if res=0 then
+ begin
+ res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+ if res=0 then
+ res := pthread_mutex_init(@CS,@MAttr)
+ else
+ { No recursive mutex support :/ }
+ res := pthread_mutex_init(@CS,NIL);
+ end
+ else
+ res:= pthread_mutex_init(@CS,NIL);
+ pthread_mutexattr_destroy(@MAttr);
+ if res <> 0 then
+ runerror(6);
+ end;
+
+ procedure CEnterCriticalSection(var CS);
+ begin
+ if pthread_mutex_lock(@CS) <> 0 then
+ runerror(6);
+ end;
+
+ procedure CLeaveCriticalSection(var CS);
+ begin
+ if pthread_mutex_unlock(@CS) <> 0 then
+ runerror(6)
+ end;
+
+ procedure CDoneCriticalSection(var CS);
+ begin
+ if pthread_mutex_destroy(@CS) <> 0 then
+ runerror(6);
+ end;
+
+
+{*****************************************************************************
+ Heap Mutex Protection
+*****************************************************************************}
+
+ var
+ HeapMutex : pthread_mutex_t;
+
+ procedure PThreadHeapMutexInit;
+ begin
+ pthread_mutex_init(@heapmutex,nil);
+ end;
+
+ procedure PThreadHeapMutexDone;
+ begin
+ pthread_mutex_destroy(@heapmutex);
+ end;
+
+ procedure PThreadHeapMutexLock;
+ begin
+ pthread_mutex_lock(@heapmutex);
+ end;
+
+ procedure PThreadHeapMutexUnlock;
+ begin
+ pthread_mutex_unlock(@heapmutex);
+ end;
+
+ const
+ PThreadMemoryMutexManager : TMemoryMutexManager = (
+ MutexInit : @PThreadHeapMutexInit;
+ MutexDone : @PThreadHeapMutexDone;
+ MutexLock : @PThreadHeapMutexLock;
+ MutexUnlock : @PThreadHeapMutexUnlock;
+ );
+
+ procedure InitHeapMutexes;
+ begin
+ SetMemoryMutexManager(PThreadMemoryMutexManager);
+ end;
+
+
+type
+ TPthreadMutex = pthread_mutex_t;
+ Tbasiceventstate=record
+ FSem: Pointer;
+ FManualReset: Boolean;
+ FEventSection: TPthreadMutex;
+ end;
+ plocaleventstate = ^tbasiceventstate;
+// peventstate=pointer;
+
+Const
+ wrSignaled = 0;
+ wrTimeout = 1;
+ wrAbandoned= 2;
+ wrError = 3;
+
+function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+var
+ MAttr : pthread_mutexattr_t;
+ res : cint;
+
+
+begin
+ new(plocaleventstate(result));
+ plocaleventstate(result)^.FManualReset:=AManualReset;
+ plocaleventstate(result)^.FSem:=New(PSemaphore); //sem_t.
+// plocaleventstate(result)^.feventsection:=nil;
+ res:=pthread_mutexattr_init(@MAttr);
+ if res=0 then
+ begin
+ res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+ if Res=0 then
+ Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr)
+ else
+ res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+ end
+ else
+ res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+ pthread_mutexattr_destroy(@MAttr);
+ if res <> 0 then
+ runerror(6);
+ if sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState)) <> 0 then
+ runerror(6);
+end;
+
+procedure Intbasiceventdestroy(state:peventstate);
+
+begin
+ sem_destroy(psem_t( plocaleventstate(state)^.FSem));
+end;
+
+procedure IntbasiceventResetEvent(state:peventstate);
+
+begin
+ While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
+ ;
+end;
+
+procedure IntbasiceventSetEvent(state:peventstate);
+
+Var
+ Value : Longint;
+
+begin
+ pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+ Try
+ sem_getvalue(plocaleventstate(state)^.FSem,@value);
+ if Value=0 then
+ sem_post(psem_t( plocaleventstate(state)^.FSem));
+ finally
+ pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+ end;
+end;
+
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+ If TimeOut<>Cardinal($FFFFFFFF) then
+ result:=wrError
+ else
+ begin
+ sem_wait(psem_t(plocaleventstate(state)^.FSem));
+ result:=wrSignaled;
+ if plocaleventstate(state)^.FManualReset then
+ begin
+ pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+ Try
+ intbasiceventresetevent(State);
+ sem_post(psem_t( plocaleventstate(state)^.FSem));
+ Finally
+ pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+ end;
+ end;
+ end;
+end;
+
+function intRTLEventCreate: PRTLEvent;
+
+var p:pintrtlevent;
+
+begin
+ new(p);
+ pthread_cond_init(@p^.condvar, nil);
+ pthread_mutex_init(@p^.mutex, nil);
+ result:=PRTLEVENT(p);
+end;
+
+procedure intRTLEventDestroy(AEvent: PRTLEvent);
+
+var p:pintrtlevent;
+
+begin
+ p:=pintrtlevent(aevent);
+ pthread_cond_destroy(@p^.condvar);
+ pthread_mutex_destroy(@p^.mutex);
+ dispose(p);
+end;
+
+procedure intRTLEventSetEvent(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+ p:=pintrtlevent(aevent);
+ pthread_mutex_lock(@p^.mutex);
+ pthread_cond_signal(@p^.condvar);
+ pthread_mutex_unlock(@p^.mutex);
+end;
+
+
+procedure intRTLEventResetEvent(AEvent: PRTLEvent);
+ begin
+ { events before startwait are ignored unix }
+ end;
+
+
+procedure intRTLEventStartWait(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+ p:=pintrtlevent(aevent);
+ pthread_mutex_lock(@p^.mutex);
+end;
+
+procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+var p:pintrtlevent;
+
+begin
+ p:=pintrtlevent(aevent);
+ pthread_cond_wait(@p^.condvar, @p^.mutex);
+ pthread_mutex_unlock(@p^.mutex);
+end;
+
+
+procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
+ var
+ p : pintrtlevent;
+ errres : cint;
+ timespec : ttimespec;
+ begin
+ p:=pintrtlevent(aevent);
+ timespec.tv_sec:=timeout div 1000;
+ timespec.tv_nsec:=(timeout mod 1000)*1000000;
+ errres:=pthread_cond_timedwait(@p^.condvar, @p^.mutex, @timespec);
+ if (errres=0) or (errres=ESysETIMEDOUT) then
+ pthread_mutex_unlock(@p^.mutex);
+ end;
+
+
+type
+ threadmethod = procedure of object;
+
+
+Function CInitThreads : Boolean;
+
+begin
+{$ifdef DEBUG_MT}
+ Writeln('Entering InitThreads.');
+{$endif}
+{$ifndef dynpthreads}
+ Result:=True;
+{$else}
+ Result:=LoadPthreads;
+{$endif}
+ ThreadID := SizeUInt (pthread_self);
+{$ifdef DEBUG_MT}
+ Writeln('InitThreads : ',Result);
+{$endif DEBUG_MT}
+end;
+
+Function CDoneThreads : Boolean;
+
+begin
+{$ifndef dynpthreads}
+ Result:=True;
+{$else}
+ Result:=UnloadPthreads;
+{$endif}
+end;
+
+
+Var
+ CThreadManager : TThreadManager;
+
+Procedure SetCThreadManager;
+
+begin
+ With CThreadManager do
+ begin
+ InitManager :=@CInitThreads;
+ DoneManager :=@CDoneThreads;
+ BeginThread :=@CBeginThread;
+ EndThread :=@CEndThread;
+ SuspendThread :=@CSuspendThread;
+ ResumeThread :=@CResumeThread;
+ KillThread :=@CKillThread;
+ ThreadSwitch :=@CThreadSwitch;
+ WaitForThreadTerminate :=@CWaitForThreadTerminate;
+ ThreadSetPriority :=@CThreadSetPriority;
+ ThreadGetPriority :=@CThreadGetPriority;
+ GetCurrentThreadId :=@CGetCurrentThreadId;
+ InitCriticalSection :=@CInitCriticalSection;
+ DoneCriticalSection :=@CDoneCriticalSection;
+ EnterCriticalSection :=@CEnterCriticalSection;
+ LeaveCriticalSection :=@CLeaveCriticalSection;
+{$ifdef hasthreadvar}
+ InitThreadVar :=@CInitThreadVar;
+ RelocateThreadVar :=@CRelocateThreadVar;
+ AllocateThreadVars :=@CAllocateThreadVars;
+ ReleaseThreadVars :=@CReleaseThreadVars;
+{$endif}
+ BasicEventCreate :=@intBasicEventCreate;
+ BasicEventDestroy :=@intBasicEventDestroy;
+ BasicEventResetEvent :=@intBasicEventResetEvent;
+ BasicEventSetEvent :=@intBasicEventSetEvent;
+ BasiceventWaitFor :=@intBasiceventWaitFor;
+ rtlEventCreate :=@intrtlEventCreate;
+ rtlEventDestroy :=@intrtlEventDestroy;
+ rtlEventSetEvent :=@intrtlEventSetEvent;
+ rtlEventResetEvent :=@intrtlEventResetEvent;
+ rtlEventStartWait :=@intrtlEventStartWait;
+ rtleventWaitForTimeout :=@intrtleventWaitForTimeout;
+ rtleventWaitFor :=@intrtleventWaitFor;
+ end;
+ SetThreadManager(CThreadManager);
+ InitHeapMutexes;
+end;
+
+
+initialization
+ if ThreadingAlreadyUsed then
+ begin
+ writeln('Threading has been used before cthreads was initialized.');
+ writeln('Make cthreads one of the first units in your uses clause.');
+ runerror(211);
+ end;
+ SetCThreadManager;
+finalization
+end.
+{
+ $Log: cthreads.pp,v $
+ Revision 1.28 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.27 2005/04/09 18:45:43 florian
+ * fixed some unix stuff
+
+ Revision 1.26 2005/04/09 17:26:08 florian
+ + classes.mainthreadid is set now
+ + rtleventresetevent
+ + rtleventwairfor with timeout
+ + checksynchronize with timeout
+ * race condition in synchronize fixed
+
+ Revision 1.25 2005/04/03 19:29:28 florian
+ * proper error message if the cthreads unit is included too late
+ uses clause
+
+ Revision 1.24 2005/02/25 22:10:27 florian
+ * final fix for linux (hopefully)
+
+ Revision 1.23 2005/02/25 22:02:48 florian
+ * another "transfer to linux"-commit
+
+ Revision 1.22 2005/02/25 21:52:07 florian
+ * "transfer to linux"-commit
+
+ Revision 1.21 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.20 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/unix/ctypes.inc b/rtl/unix/ctypes.inc
new file mode 100644
index 0000000000..0a124add81
--- /dev/null
+++ b/rtl/unix/ctypes.inc
@@ -0,0 +1,96 @@
+{
+ $Id: ctypes.inc,v 1.4 2005/03/13 19:17:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Basic types for C interfacing. Check the 64-bit defines.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{ POSIX TYPE DEFINITIONS }
+{***********************************************************************}
+
+Type
+ { the following type definitions are compiler dependant }
+ { and system dependant }
+
+ cInt8 = shortint;
+ cUInt8 = byte;
+ cUInt16= word;
+ cInt16 = smallint;
+ cInt32 = longint;
+ cUInt32= cardinal;
+ cInt64 = int64;
+{$ifndef VER1_0}
+ cUInt64= qword;
+{$else}
+ cUInt64= int64;
+{$endif}
+
+ cuchar = byte;
+ cchar = shortint;
+ cInt = longint; { minimum range is : 32-bit }
+ cUInt = Cardinal; { minimum range is : 32-bit }
+{$ifdef cpu64}
+ cLong = int64;
+ cuLong = qword;
+{$else}
+ cLong = longint;
+ cuLong = Cardinal;
+{$endif}
+ clonglong = int64;
+{$ifndef VER1_0}
+ culonglong = qword;
+{$else VER1_0}
+ culonglong = int64;
+{$endif VER1_0}
+ cshort = smallint;
+ cushort = word;
+
+ pcInt = ^cInt;
+ pcUInt = ^cUInt;
+ pcLong = ^cLong;
+ pculong = ^cuLong;
+ pcshort = ^cshort;
+ pcushort = ^cushort;
+ pcchar = ^cchar;
+ pcuchar = ^cuchar;
+
+ cunsigned = cuint;
+ pcunsigned = ^cunsigned;
+
+ { Floating point }
+ cFloat = Single;
+ cDouble = Double;
+ clDouble = Extended;
+ pcFloat = ^cFloat;
+ pcDouble = ^cDouble;
+ pclDouble = ^clDouble;
+
+{
+ $Log: ctypes.inc,v $
+ Revision 1.4 2005/03/13 19:17:14 florian
+ * indention fixed
+
+ Revision 1.3 2005/03/13 10:05:13 florian
+ + floating point c types added
+
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.1 2005/02/13 22:14:36 peter
+ * new files
+
+ Revision 1.6 2005/02/05 23:02:37 florian
+ + added some missing c types
+
+}
+
diff --git a/rtl/unix/cwstring.pp b/rtl/unix/cwstring.pp
new file mode 100644
index 0000000000..564fcd4120
--- /dev/null
+++ b/rtl/unix/cwstring.pp
@@ -0,0 +1,269 @@
+{
+ $Id: cwstring.pp,v 1.5 2005/03/17 19:11:04 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2005 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ libc based wide string support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+ **********************************************************************}
+
+{$mode objfpc}
+
+unit cwstring;
+
+interface
+
+{$ifdef HASWIDESTRING}
+procedure SetCWidestringManager;
+{$endif HASWIDESTRING}
+
+implementation
+
+{$ifdef HASWIDESTRING}
+{$linklib c}
+
+Uses
+ BaseUnix,
+ ctypes,
+ unix,
+ unixtype,
+ sysutils,
+ initc;
+
+
+{ Case-mapping "arrays" }
+var
+ AnsiUpperChars: AnsiString; // 1..255
+ AnsiLowerChars: AnsiString; // 1..255
+ WideUpperChars: WideString; // 1..65535
+ WideLowerChars: WideString; // 1..65535
+
+
+{ the following declarations are from the libc unit for linux so they
+ might be very linux centric
+ maybe this needs to be splitted in an os depend way later }
+function towlower(__wc:wint_t):wint_t;cdecl;external;
+function towupper(__wc:wint_t):wint_t;cdecl;external;
+function wcscoll(__s1:pwchar_t; __s2:pwchar_t):longint;cdecl;external;
+
+const
+ __LC_CTYPE = 0;
+ _NL_CTYPE_CLASS = (__LC_CTYPE shl 16);
+ _NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14;
+ CODESET = _NL_CTYPE_CODESET_NAME;
+
+{ unicode encoding name }
+{$ifdef FPC_LITTLE_ENDIAN}
+ unicode_encoding = 'UNICODELITTLE';
+{$else FPC_LITTLE_ENDIAN}
+ unicode_encoding = 'UNICODEBIG';
+{$endif FPC_LITTLE_ENDIAN}
+
+type
+ piconv_t = ^iconv_t;
+ iconv_t = pointer;
+ nl_item = longint;
+
+function nl_langinfo(__item:nl_item):pchar;cdecl;external;
+function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external;
+function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external;
+function iconv_close(__cd:iconv_t):longint;cdecl;external;
+
+var
+ iconv_ansi2wide,
+ iconv_wide2ansi : iconv_t;
+
+procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
+ var
+ outlength,
+ outoffset,
+ srclen,
+ outleft : size_t;
+ srcpos : pwidechar;
+ destpos: pchar;
+ mynil : pchar;
+ my0 : size_t;
+ begin
+ mynil:=nil;
+ my0:=0;
+ { rought estimation }
+ setlength(dest,len*3);
+ outlength:=len*3;
+ srclen:=len*2;
+ srcpos:=source;
+ destpos:=pchar(dest);
+ outleft:=outlength;
+ while iconv(iconv_wide2ansi,@srcpos,@srclen,@destpos,@outleft)=size_t(-1) do
+ begin
+ case fpgetCerrno of
+ ESysEILSEQ:
+ begin
+ { skip and set to '?' }
+ inc(srcpos);
+ dec(srclen,2);
+ destpos^:='?';
+ inc(destpos);
+ dec(outleft);
+ { reset }
+ iconv(iconv_wide2ansi,@mynil,@my0,@mynil,@my0);
+ end;
+ ESysE2BIG:
+ begin
+ outoffset:=destpos-pchar(dest);
+ { extend }
+ setlength(dest,outlength+len*3);
+ inc(outleft,len*3);
+ inc(outlength,len*3);
+ { string could have been moved }
+ destpos:=pchar(dest)+outoffset;
+ end;
+ else
+ raise EConvertError.Create('iconv error');
+ end;
+ end;
+ // truncate string
+ setlength(dest,length(dest)-outleft);
+ end;
+
+
+procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
+ var
+ outlength,
+ outoffset,
+ outleft : size_t;
+ srcpos,
+ destpos: pchar;
+ mynil : pchar;
+ my0 : size_t;
+ begin
+ mynil:=nil;
+ my0:=0;
+ // extra space
+ outlength:=len+1;
+ setlength(dest,outlength);
+ outlength:=len+1;
+ srcpos:=source;
+ destpos:=pchar(dest);
+ outleft:=outlength*2;
+ while iconv(iconv_ansi2wide,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
+ begin
+ case fpgetCerrno of
+ ESysE2BIG:
+ begin
+ outoffset:=destpos-pchar(dest);
+ { extend }
+ setlength(dest,outlength+len);
+ inc(outleft,len*2);
+ inc(outlength,len);
+ { string could have been moved }
+ destpos:=pchar(dest)+outoffset;
+ end;
+ else
+ raise EConvertError.Create('iconv error');
+ end;
+ end;
+ // truncate string
+ setlength(dest,length(dest)-outleft div 2);
+ end;
+
+
+function LowerWideString(const s : WideString) : WideString;
+ var
+ i : SizeInt;
+ begin
+ SetLength(result,length(s));
+ for i:=1 to length(s) do
+ result[i]:=WideChar(towlower(wint_t(s[i])));
+ end;
+
+
+function UpperWideString(const s : WideString) : WideString;
+ var
+ i : SizeInt;
+ begin
+ SetLength(result,length(s));
+ for i:=1 to length(s) do
+ result[i]:=WideChar(towupper(wint_t(s[i])));
+ end;
+
+
+function CompareWideString(const s1, s2 : WideString) : PtrInt;
+ begin
+ end;
+
+
+function CompareTextWideString(const s1, s2 : WideString): PtrInt;
+ begin
+ end;
+
+Var
+ CWideStringManager : TWideStringManager;
+
+Procedure SetCWideStringManager;
+
+begin
+ With CWideStringManager do
+ begin
+ Wide2AnsiMoveProc:=@Wide2AnsiMove;
+ Ansi2WideMoveProc:=@Ansi2WideMove;
+
+ UpperWideStringProc:=@UpperWideString;
+ LowerWideStringProc:=@LowerWideString;
+ {
+ CompareWideStringProc
+ CompareTextWideStringProc
+ CharLengthPCharProc
+
+ UpperAnsiStringProc
+ LowerAnsiStringProc
+ CompareStrAnsiStringProc
+ CompareTextAnsiStringProc
+ StrCompAnsiStringProc
+ StrICompAnsiStringProc
+ StrLCompAnsiStringProc
+ StrLICompAnsiStringProc
+ StrLowerAnsiStringProc
+ StrUpperAnsiStringProc
+ }
+ end;
+ SetWideStringManager(CWideStringManager);
+end;
+
+
+initialization
+ SetCWideStringManager;
+ { init conversion tables }
+ iconv_wide2ansi:=iconv_open(nl_langinfo(CODESET),unicode_encoding);
+ iconv_ansi2wide:=iconv_open(unicode_encoding,nl_langinfo(CODESET));
+finalization
+ iconv_close(iconv_ansi2wide);
+end.
+
+{$else HASWIDESTRING}
+end.
+{$endif HASWIDESTRING}
+
+{
+ $Log: cwstring.pp,v $
+ Revision 1.5 2005/03/17 19:11:04 florian
+ * first working version
+
+ Revision 1.4 2005/03/16 22:26:12 florian
+ + ansi<->wide implemented using iconv
+
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/03 18:40:57 florian
+ + infrastructure for WideCompareText implemented
+
+ Revision 1.1 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+}
diff --git a/rtl/unix/dl.pp b/rtl/unix/dl.pp
new file mode 100644
index 0000000000..f7544ba1cd
--- /dev/null
+++ b/rtl/unix/dl.pp
@@ -0,0 +1,26 @@
+Unit dl;
+
+Interface
+
+Const
+ {$ifdef BSD} // dlopen is in libc on FreeBSD.
+ LibDL = 'c';
+ {$else}
+ LibDL = 'dl';
+{$endif}
+
+ RTLD_LAZY = $001;
+ RTLD_NOW = $002;
+ RTLD_BINDING_MASK = $003;
+ RTLD_GLOBAL = $100;
+ {$ifdef BSD}
+ RTLD_MODEMASK = RTLD_BINDING_MASK;
+ {$endif}
+
+Function dlopen(Name : PChar; Flags : longint) : Pointer; cdecl; external libdl;
+FUnction dlsym(Lib : Pointer; Name : Pchar) : Pointer; cdecl; external Libdl;
+Function dlclose(Lib : Pointer) : Longint; cdecl; external libdl;
+
+implementation
+
+end.
diff --git a/rtl/unix/dos.pp b/rtl/unix/dos.pp
new file mode 100644
index 0000000000..9fda14d8fb
--- /dev/null
+++ b/rtl/unix/dos.pp
@@ -0,0 +1,904 @@
+{
+ $Id: dos.pp,v 1.46 2005/03/15 16:53:52 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman,
+ members of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit Dos;
+Interface
+
+Const
+ FileNameLen = 255;
+
+Type
+ SearchRec =
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+ packed
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+ Record
+ {Fill : array[1..21] of byte; Fill replaced with below}
+ SearchNum : LongInt; {to track which search this is}
+ SearchPos : LongInt; {directory position}
+ DirPtr : Pointer; {directory pointer for reading directory}
+ SearchType : Byte; {0=normal, 1=open will close, 2=only 1 file}
+ SearchAttr : Byte; {attribute we are searching for}
+ Fill : Array[1..07] of Byte; {future use}
+ {End of fill}
+ Attr : Byte; {attribute of found file}
+ Time : LongInt; {last modify date of found file}
+ Size : LongInt; {file size of found file}
+ Reserved : Word; {future use}
+ Name : String[FileNameLen]; {name of found file}
+ SearchSpec : String[FileNameLen]; {search pattern}
+ NamePos : Word; {end of path, start of name position}
+ End;
+
+{$DEFINE HAS_FILENAMELEN}
+{$i dosh.inc}
+
+{Extra Utils}
+function weekday(y,m,d : longint) : longint;
+Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
+Function DTToUnixDate(DT: DateTime): LongInt;
+
+{Disk}
+Procedure AddDisk(const path:string);
+
+Implementation
+
+Uses
+ Strings,Unix,BaseUnix,{$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF};
+
+{$DEFINE HAS_GETMSCOUNT}
+
+{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
+{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
+
+{$I dos.inc}
+
+
+{******************************************************************************
+ --- Link C Lib if set ---
+******************************************************************************}
+
+type
+ RtlInfoType = Record
+ FMode,
+ FInode,
+ FUid,
+ FGid,
+ FSize,
+ FMTime : LongInt;
+ End;
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+
+Const
+{Date Calculation}
+ C1970 = 2440588;
+ D0 = 1461;
+ D1 = 146097;
+ D2 = 1721119;
+type
+ GTRec = packed Record
+ Year,
+ Month,
+ MDay,
+ WDay,
+ Hour,
+ Minute,
+ Second : Word;
+ End;
+
+Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
+Var
+ Century,XYear: LongInt;
+Begin
+ If Month<=2 Then
+ Begin
+ Dec(Year);
+ Inc(Month,12);
+ End;
+ Dec(Month,3);
+ Century:=(longint(Year Div 100)*D1) shr 2;
+ XYear:=(longint(Year Mod 100)*D0) shr 2;
+ GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
+End;
+
+
+Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
+{
+ Transforms local time (year,month,day,hour,minutes,second) to Epoch time
+ (seconds since 00:00, january 1 1970, corrected for local time zone)
+}
+Begin
+ LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
+ (LongInt(Hour)*3600)+(Longint(Minute)*60)+Second-TZSeconds;
+End;
+
+Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
+Var
+ YYear,XYear,Temp,TempMonth : LongInt;
+Begin
+ Temp:=((JulianDN-D2) shl 2)-1;
+ JulianDN:=Temp Div D1;
+ XYear:=(Temp Mod D1) or 3;
+ YYear:=(XYear Div D0);
+ Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
+ Day:=((Temp Mod 153)+5) Div 5;
+ TempMonth:=Temp Div 153;
+ If TempMonth>=10 Then
+ Begin
+ inc(YYear);
+ dec(TempMonth,12);
+ End;
+ inc(TempMonth,3);
+ Month := TempMonth;
+ Year:=YYear+(JulianDN*100);
+end;
+
+Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
+{
+ Transforms Epoch time into local time (hour, minute,seconds)
+}
+Var
+ DateNum: LongInt;
+Begin
+ inc(Epoch,TZSeconds);
+ Datenum:=(Epoch Div 86400) + c1970;
+ JulianToGregorian(DateNum,Year,Month,day);
+ Epoch:=Abs(Epoch Mod 86400);
+ Hour:=Epoch Div 3600;
+ Epoch:=Epoch Mod 3600;
+ Minute:=Epoch Div 60;
+ Second:=Epoch Mod 60;
+End;
+
+
+
+Function DosVersion:Word;
+Var
+ Buffer : Array[0..255] of Char;
+ Tmp2,
+ TmpStr : String[40];
+ TmpPos,
+ SubRel,
+ Rel : LongInt;
+ info : utsname;
+Begin
+ FPUName(info);
+ Move(info.release,buffer[0],40);
+ TmpStr:=StrPas(Buffer);
+ SubRel:=0;
+ TmpPos:=Pos('.',TmpStr);
+ if TmpPos>0 then
+ begin
+ Tmp2:=Copy(TmpStr,TmpPos+1,40);
+ Delete(TmpStr,TmpPos,40);
+ end;
+ TmpPos:=Pos('.',Tmp2);
+ if TmpPos>0 then
+ Delete(Tmp2,TmpPos,40);
+ Val(TmpStr,Rel);
+ Val(Tmp2,SubRel);
+ DosVersion:=Rel+(SubRel shl 8);
+End;
+
+function WeekDay (y,m,d:longint):longint;
+{
+ Calculates th day of the week. returns -1 on error
+}
+var
+ u,v : longint;
+begin
+ if (m<1) or (m>12) or (y<1600) or (y>4000) or
+ (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
+ ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
+ WeekDay:=-1
+ else
+ begin
+ u:=m;
+ v:=y;
+ if m<3 then
+ begin
+ inc(u,12);
+ dec(v);
+ end;
+ WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
+ end;
+end;
+
+
+Procedure GetDate(Var Year, Month, MDay, WDay: Word);
+var
+ tz:timeval;
+ hour,min,sec : word;
+begin
+ fpgettimeofday(@tz,nil);
+ EpochToLocal(tz.tv_sec,year,month,mday,hour,min,sec);
+ Wday:=weekday(Year,Month,MDay);
+end;
+
+
+procedure SetTime(Hour,Minute,Second,sec100:word);
+var
+ dow,Year, Month, Day : Word;
+
+ tv : timeval;
+begin
+ GetDate (Year, Month, Day,dow);
+ tv.tv_sec:= LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) ;
+ fpSettimeofday(@tv,nil);
+end;
+
+procedure SetDate(Year,Month,Day:Word);
+var
+ Hour, Min, Sec, Sec100 : Word;
+ tv : timeval;
+begin
+ GetTime ( Hour, Min, Sec, Sec100 );
+ tv.tv_sec:= LocalToEpoch ( Year, Month, Day, Hour, Min, Sec ) ;
+ fpSettimeofday(@tv,nil);
+end;
+
+
+Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
+var
+ tv : timeval;
+begin
+ tv.tv_sec:= LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) ;
+ SetDatetime:=fpSettimeofday(@tv,nil)=0;
+end;
+
+
+Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
+var
+ tz:timeval;
+ year,month,day : word;
+begin
+ fpgettimeofday(@tz,nil);
+ EpochToLocal(tz.tv_sec,year,month,day,hour,minute,second);
+ sec100:=tz.tv_usec div 10000;
+end;
+
+
+Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
+Begin
+ EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
+End;
+
+
+Function DTToUnixDate(DT: DateTime): LongInt;
+Begin
+ DTToUnixDate:=LocalToEpoch(dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
+End;
+
+
+function GetMsCount: int64;
+var
+ tv : TimeVal;
+{ tz : TimeZone;}
+begin
+ FPGetTimeOfDay (@tv, nil {,tz});
+ GetMsCount := tv.tv_Sec * 1000 + tv.tv_uSec div 1000;
+end;
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+var
+ pid : longint; // pid_t?
+ cmdline2 : ppchar;
+ commandline : ansistring;
+ realpath : ansistring;
+
+// The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
+Begin
+ LastDosExitCode:=0;
+ if Path='' then
+ begin
+ doserror:=2;
+ exit;
+ end;
+ pid:=fpFork;
+ if pid=0 then
+ begin
+ cmdline2:=nil;
+ realpath:=path;
+ if Comline<>'' Then
+ begin
+ CommandLine:=ComLine; // conversion must live till after fpexec!
+ cmdline2:=StringtoPPChar(CommandLine,1);
+ cmdline2^:=pchar(realPath);
+ end
+ else
+ begin
+ getmem(cmdline2,2*sizeof(pchar));
+ cmdline2^:=pchar(realPath);
+ cmdline2[1]:=nil;
+ end;
+ {The child does the actual exec, and then exits}
+ fpExecv(pchar(realPath),cmdline2);
+ {If the execve fails, we return an exitvalue of 127, to let it be known}
+ fpExit(127);
+ end
+ else
+ if pid=-1 then {Fork failed}
+ begin
+ DosError:=8;
+ exit
+ end;
+ {We're in the parent, let's wait.}
+ LastDosExitCode:=WaitProcess(pid); // WaitPid and result-convert
+ if (LastDosExitCode>=0) and (LastDosExitCode<>127) then
+ DosError:=0
+ else
+ DosError:=8; // perhaps one time give an better error
+End;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.',
+ '/fd0/.',
+ '/fd1/.',
+ '/.'
+ );
+const
+ Drives : byte = 4;
+var
+ DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+
+Function DiskFree(Drive: Byte): int64;
+var
+ fs : tstatfs;
+Begin
+ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (StatFS(fixdrivestr[drive],fs)<>-1)) or
+ ((not (drivestr[Drive]=nil)) and (StatFS(drivestr[drive],fs)<>-1)) then
+ Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+ else
+ Diskfree:=-1;
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+var
+ fs : tstatfs;
+Begin
+ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (StatFS(fixdrivestr[drive],fs)<>-1)) or
+ ((not (drivestr[Drive]=nil)) and (StatFS(drivestr[drive],fs)<>-1)) then
+ DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+ else
+ DiskSize:=-1;
+End;
+
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+
+Function FNMatch(const Pattern,Name:string):Boolean;
+Var
+ LenPat,LenName : longint;
+
+ Function DoFNMatch(i,j:longint):Boolean;
+ Var
+ Found : boolean;
+ Begin
+ Found:=true;
+ While Found and (i<=LenPat) Do
+ Begin
+ Case Pattern[i] of
+ '?' : Found:=(j<=LenName);
+ '*' : Begin
+ {find the next character in pattern, different of ? and *}
+ while Found do
+ begin
+ inc(i);
+ if i>LenPat then Break;
+ case Pattern[i] of
+ '*' : ;
+ '?' : begin
+ if j>LenName then begin DoFNMatch:=false; Exit; end;
+ inc(j);
+ end;
+ else
+ Found:=false;
+ end;
+ end;
+ Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
+ {Now, find in name the character which i points to, if the * or ?
+ wasn't the last character in the pattern, else, use up all the
+ chars in name}
+ Found:=false;
+ if (i<=LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j<=LenName) and (name[j]<>pattern[i]) do
+ inc (j);
+ if (j<LenName) then
+ begin
+ if DoFnMatch(i+1,j+1) then
+ begin
+ i:=LenPat;
+ j:=LenName;{we can stop}
+ Found:=true;
+ Break;
+ end else
+ inc(j);{We didn't find one, need to look further}
+ end else
+ if j=LenName then
+ begin
+ Found:=true;
+ Break;
+ end;
+ { This 'until' condition must be j>LenName, not j>=LenName.
+ That's because when we 'need to look further' and
+ j = LenName then loop must not terminate. }
+ until (j>LenName);
+ end else
+ begin
+ j:=LenName;{we can stop}
+ Found:=true;
+ end;
+ end;
+ else {not a wildcard character in pattern}
+ Found:=(j<=LenName) and (pattern[i]=name[j]);
+ end;
+ inc(i);
+ inc(j);
+ end;
+ DoFnMatch:=Found and (j>LenName);
+ end;
+
+Begin {start FNMatch}
+ LenPat:=Length(Pattern);
+ LenName:=Length(Name);
+ FNMatch:=DoFNMatch(1,1);
+End;
+
+
+Const
+ RtlFindSize = 15;
+Type
+ RtlFindRecType = Record
+ DirPtr : Pointer;
+ SearchNum,
+ LastUsed : LongInt;
+ End;
+Var
+ RtlFindRecs : Array[1..RtlFindSize] of RtlFindRecType;
+ CurrSearchNum : LongInt;
+
+
+Procedure FindClose(Var f: SearchRec);
+{
+ Closes dirptr if it is open
+}
+Var
+ i : longint;
+Begin
+ if f.SearchType=0 then
+ begin
+ i:=1;
+ repeat
+ if (RtlFindRecs[i].SearchNum=f.SearchNum) then
+ break;
+ inc(i);
+ until (i>RtlFindSize);
+ If i<=RtlFindSize Then
+ Begin
+ RtlFindRecs[i].SearchNum:=0;
+ if f.dirptr<>nil then
+ fpclosedir(pdir(f.dirptr)^);
+ End;
+ end;
+ f.dirptr:=nil;
+End;
+
+
+Function FindGetFileInfo(const s:string;var f:SearchRec):boolean;
+var
+ DT : DateTime;
+ Info : RtlInfoType;
+ st : baseunix.stat;
+begin
+ FindGetFileInfo:=false;
+ if not fpstat(s,st)>=0 then
+ exit;
+ info.FSize:=st.st_Size;
+ info.FMTime:=st.st_mtime;
+ if (st.st_mode and STAT_IFMT)=STAT_IFDIR then
+ info.fmode:=$10
+ else
+ info.fmode:=$0;
+ if (st.st_mode and STAT_IWUSR)=0 then
+ info.fmode:=info.fmode or 1;
+ if s[f.NamePos+1]='.' then
+ info.fmode:=info.fmode or $2;
+
+ If ((Info.FMode and Not(f.searchattr))=0) Then
+ Begin
+ f.Name:=Copy(s,f.NamePos+1,255);
+ f.Attr:=Info.FMode;
+ f.Size:=Info.FSize;
+ UnixDateToDT(Info.FMTime, DT);
+ PackTime(DT,f.Time);
+ FindGetFileInfo:=true;
+ End;
+end;
+
+
+Function FindLastUsed: Longint;
+{
+ Find unused or least recently used dirpointer slot in findrecs array
+}
+Var
+ BestMatch,i : Longint;
+ Found : Boolean;
+Begin
+ BestMatch:=1;
+ i:=1;
+ Found:=False;
+ While (i <= RtlFindSize) And (Not Found) Do
+ Begin
+ If (RtlFindRecs[i].SearchNum = 0) Then
+ Begin
+ BestMatch := i;
+ Found := True;
+ End
+ Else
+ Begin
+ If RtlFindRecs[i].LastUsed > RtlFindRecs[BestMatch].LastUsed Then
+ BestMatch := i;
+ End;
+ Inc(i);
+ End;
+ FindLastUsed := BestMatch;
+End;
+
+
+
+Procedure FindNext(Var f: SearchRec);
+{
+ re-opens dir if not already in array and calls FindWorkProc
+}
+Var
+
+ DirName : Array[0..256] of Char;
+ i,
+ ArrayPos : Longint;
+ FName,
+ SName : string;
+ Found,
+ Finished : boolean;
+ p : pdirent;
+Begin
+ If f.SearchType=0 Then
+ Begin
+ ArrayPos:=0;
+ For i:=1 to RtlFindSize Do
+ Begin
+ If RtlFindRecs[i].SearchNum = f.SearchNum Then
+ ArrayPos:=i;
+ Inc(RtlFindRecs[i].LastUsed);
+ End;
+ If ArrayPos=0 Then
+ Begin
+ If f.NamePos = 0 Then
+ Begin
+ DirName[0] := '.';
+ DirName[1] := '/';
+ DirName[2] := #0;
+ End
+ Else
+ Begin
+ Move(f.SearchSpec[1], DirName[0], f.NamePos);
+ DirName[f.NamePos] := #0;
+ End;
+ f.DirPtr := fpopendir(@(DirName));
+ If f.DirPtr <> nil Then
+ begin
+ ArrayPos:=FindLastUsed;
+ If RtlFindRecs[ArrayPos].SearchNum > 0 Then
+ FpCloseDir((pdir(rtlfindrecs[arraypos].dirptr)^));
+ RtlFindRecs[ArrayPos].SearchNum := f.SearchNum;
+ RtlFindRecs[ArrayPos].DirPtr := f.DirPtr;
+ if f.searchpos>0 then
+ seekdir(pdir(f.dirptr), f.searchpos);
+ end;
+ End;
+ if ArrayPos>0 then
+ RtlFindRecs[ArrayPos].LastUsed:=0;
+ end;
+{Main loop}
+ SName:=Copy(f.SearchSpec,f.NamePos+1,255);
+ Found:=False;
+ Finished:=(f.dirptr=nil);
+ While Not Finished Do
+ Begin
+ p:=fpreaddir(pdir(f.dirptr)^);
+ if p=nil then
+ FName:=''
+ else
+ FName:=Strpas(@p^.d_name);
+ If FName='' Then
+ Finished:=True
+ Else
+ Begin
+ If FNMatch(SName,FName) Then
+ Begin
+ Found:=FindGetFileInfo(Copy(f.SearchSpec,1,f.NamePos)+FName,f);
+ if Found then
+ Finished:=true;
+ End;
+ End;
+ End;
+{Shutdown}
+ If Found Then
+ Begin
+ f.searchpos:=telldir(pdir(f.dirptr));
+ DosError:=0;
+ End
+ Else
+ Begin
+ FindClose(f);
+ DosError:=18;
+ End;
+End;
+
+
+Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
+{
+ opens dir and calls FindWorkProc
+}
+Begin
+ fillchar(f,sizeof(f),0);
+ if Path='' then
+ begin
+ DosError:=3;
+ exit;
+ end;
+{Create Info}
+ f.SearchSpec := Path;
+ {We always also search for readonly and archive, regardless of Attr:}
+ f.SearchAttr := Attr or archive or readonly;
+ f.SearchPos := 0;
+ f.NamePos := Length(f.SearchSpec);
+ while (f.NamePos>0) and (f.SearchSpec[f.NamePos]<>'/') do
+ dec(f.NamePos);
+{Wildcards?}
+ if (Pos('?',Path)=0) and (Pos('*',Path)=0) then
+ begin
+ if FindGetFileInfo(Path,f) then
+ DosError:=0
+ else
+ begin
+ { According to tdos2 test it should return 18
+ if ErrNo=Sys_ENOENT then
+ DosError:=3
+ else }
+ DosError:=18;
+ end;
+ f.DirPtr:=nil;
+ f.SearchType:=1;
+ f.searchnum:=-1;
+ end
+ else
+{Find Entry}
+ begin
+ Inc(CurrSearchNum);
+ f.SearchNum:=CurrSearchNum;
+ f.SearchType:=0;
+ FindNext(f);
+ end;
+End;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+Function FSearch(path : pathstr;dirlist : string) : pathstr;
+Var
+ info : BaseUnix.stat;
+Begin
+ if (length(Path)>0) and (path[1]='/') and (fpStat(path,info)>=0) and (not fpS_ISDIR(Info.st_Mode)) then
+ FSearch:=path
+ else
+ FSearch:=Unix.FSearch(path,dirlist);
+End;
+
+Procedure GetFAttr(var f; var attr : word);
+Var
+ info : baseunix.stat;
+ LinAttr : longint;
+Begin
+ DosError:=0;
+ if FPStat(@textrec(f).name,info)<0 then
+ begin
+ Attr:=0;
+ DosError:=3;
+ exit;
+ end
+ else
+ LinAttr:=Info.st_Mode;
+ if fpS_ISDIR(LinAttr) then
+ Attr:=$10
+ else
+ Attr:=$0;
+ if fpAccess(@textrec(f).name,W_OK)<0 then
+ Attr:=Attr or $1;
+ if filerec(f).name[0]='.' then
+ Attr:=Attr or $2;
+end;
+
+Procedure getftime (var f; var time : longint);
+Var
+ Info: baseunix.stat;
+ DT: DateTime;
+Begin
+ doserror:=0;
+ if fpfstat(filerec(f).handle,info)<0 then
+ begin
+ Time:=0;
+ doserror:=6;
+ exit
+ end
+ else
+ UnixDateToDT(Info.st_mTime,DT);
+ PackTime(DT,Time);
+End;
+
+Procedure setftime(var f; time : longint);
+
+Var
+ utim: utimbuf;
+ DT: DateTime;
+
+Begin
+ doserror:=0;
+ with utim do
+ begin
+ actime:=fptime;
+ UnPackTime(Time,DT);
+ modtime:=DTToUnixDate(DT);
+ end;
+ if fputime(@filerec(f).name,@utim)<0 then
+ begin
+ Time:=0;
+ doserror:=3;
+ end;
+End;
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+Function EnvCount: Longint;
+var
+ envcnt : longint;
+ p : ppchar;
+Begin
+ envcnt:=0;
+ p:=envp; {defined in syslinux}
+ while (p^<>nil) do
+ begin
+ inc(envcnt);
+ inc(p);
+ end;
+ EnvCount := envcnt
+End;
+
+
+Function EnvStr (Index: longint): String;
+Var
+ i : longint;
+ p : ppchar;
+Begin
+ if Index <= 0 then
+ envstr:=''
+ else
+ begin
+ p:=envp; {defined in syslinux}
+ i:=1;
+ while (i<Index) and (p^<>nil) do
+ begin
+ inc(i);
+ inc(p);
+ end;
+ if p=nil then
+ envstr:=''
+ else
+ envstr:=strpas(p^)
+ end;
+end;
+
+
+Function GetEnv(EnvVar: String): String;
+var
+ p : pchar;
+Begin
+ p:=BaseUnix.fpGetEnv(EnvVar);
+ if p=nil then
+ GetEnv:=''
+ else
+ GetEnv:=StrPas(p);
+End;
+
+
+Procedure setfattr (var f;attr : word);
+Begin
+ {! No Unix equivalent !}
+ { Fail for setting VolumeId }
+ if (attr and VolumeID)<>0 then
+ doserror:=5;
+End;
+
+
+
+{******************************************************************************
+ --- Initialization ---
+******************************************************************************}
+
+End.
+
+{
+ $Log: dos.pp,v $
+ Revision 1.46 2005/03/15 16:53:52 peter
+ * return doserror=2 if path is empty in exec()
+
+ Revision 1.45 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.44 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/unix/dynlibs.inc b/rtl/unix/dynlibs.inc
new file mode 100644
index 0000000000..83072a0d7f
--- /dev/null
+++ b/rtl/unix/dynlibs.inc
@@ -0,0 +1,62 @@
+{
+ $Id: dynlibs.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Implement OS-dependent part of dynamic library loading.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef readinterface}
+
+{ ---------------------------------------------------------------------
+ Interface declarations
+ ---------------------------------------------------------------------}
+
+Type
+ TLibHandle = Pointer;
+
+Const
+ NilHandle = Nil;
+
+{$else}
+
+{ ---------------------------------------------------------------------
+ Implementation section
+ ---------------------------------------------------------------------}
+
+uses dl;
+
+Function LoadLibrary(Name : AnsiString) : TLibHandle;
+
+begin
+ Result:=dlopen(Pchar(Name),RTLD_LAZY);
+end;
+
+Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
+
+begin
+ Result:=dlsym(lib,pchar(ProcName));
+end;
+
+Function UnloadLibrary(Lib : TLibHandle) : Boolean;
+
+begin
+ Result:=dlClose(Lib)=0;
+end;
+
+{$endif}
+
+{
+ $Log: dynlibs.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/errors.pp b/rtl/unix/errors.pp
new file mode 100644
index 0000000000..0f23d48ac0
--- /dev/null
+++ b/rtl/unix/errors.pp
@@ -0,0 +1,187 @@
+{
+ $Id: errors.pp,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+Unit errors;
+
+Interface
+
+uses strings;
+
+const
+ sys_errn=125;
+ sys_errlist:array[0..sys_errn-1] of pchar = (
+ 'Success', { 0 }
+ 'Operation not permitted', { EPERM }
+ 'No such file or directory', { ENOENT }
+ 'No such process', { ESRCH }
+ 'Interrupted system call', { EINTR }
+ 'I/O error', { EIO }
+ 'No such device or address', { ENXIO }
+ 'Arg list too long', { E2BIG }
+ 'Exec format error', { ENOEXEC }
+ 'Bad file number', { EBADF }
+ 'No child processes', { ECHILD }
+ 'Try again', { EAGAIN }
+ 'Out of memory', { ENOMEM }
+ 'Permission denied', { EACCES }
+ 'Bad address', { EFAULT }
+ 'Block device required', { ENOTBLK }
+ 'Device or resource busy', { EBUSY }
+ 'File exists', { EEXIST }
+ 'Cross-device link', { EXDEV }
+ 'No such device', { ENODEV }
+ 'Not a directory', { ENOTDIR }
+ 'Is a directory', { EISDIR }
+ 'Invalid argument', { EINVAL }
+ 'File table overflow', { ENFILE }
+ 'Too many open files', { EMFILE }
+ 'Not a typewriter', { ENOTTY }
+ 'Text (code segment) file busy', { ETXTBSY Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+ 'File too large', { EFBIG }
+ 'No space left on device', { ENOSPC }
+ 'Illegal seek', { ESPIPE }
+ 'Read-only file system', { EROFS }
+ 'Too many links', { EMLINK }
+ 'Broken pipe', { EPIPE }
+ 'Math argument out of domain of func', { EDOM }
+ 'Math result not representable', { ERANGE }
+ 'Resource deadlock would occur', { EDEADLK }
+ 'File name too long', { ENAMETOOLONG }
+ 'No record locks available', { ENOLCK }
+ 'Function not implemented', { ENOSYS }
+ 'Directory not empty', { ENOTEMPTY }
+ 'Too many symbolic links encountered', { ELOOP }
+ 'Operation would block', { EWOULDBLOCK }
+ 'No message of desired type', { ENOMSG }
+ 'Identifier removed', { EIDRM }
+ 'Channel number out of range', { ECHRNG }
+ 'Level 2 not synchronized', { EL2NSYNC }
+ 'Level 3 halted', { EL3HLT }
+ 'Level 3 reset', { EL3RST }
+ 'Link number out of range', { ELNRNG }
+ 'Protocol driver not attached', { EUNATCH }
+ 'No CSI structure available', { ENOCSI }
+ 'Level 2 halted', { EL2HLT }
+ 'Invalid exchange', { EBADE }
+ 'Invalid request descriptor', { EBADR }
+ 'Exchange full', { EXFULL }
+ 'No anode', { ENOANO }
+ 'Invalid request code', { EBADRQC }
+ 'Invalid slot', { EBADSLT }
+ 'File locking deadlock error', { EDEADLOCK }
+ 'Bad font file format', { EBFONT }
+ 'Device not a stream', { ENOSTR }
+ 'No data available', { ENODATA }
+ 'Timer expired', { ETIME }
+ 'Out of streams resources', { ENOSR }
+ 'Machine is not on the network', { ENONET }
+ 'Package not installed', { ENOPKG }
+ 'Object is remote', { EREMOTE }
+ 'Link has been severed', { ENOLINK }
+ 'Advertise error', { EADV }
+ 'Srmount error', { ESRMNT }
+ 'Communication error on send', { ECOMM }
+ 'Protocol error', { EPROTO }
+ 'Multihop attempted', { EMULTIHOP }
+ 'RFS specific error', { EDOTDOT }
+ 'Not a data message', { EBADMSG }
+ 'Value too large for defined data type', { EOVERFLOW }
+ 'Name not unique on network', { ENOTUNIQ }
+ 'File descriptor in bad state', { EBADFD }
+ 'Remote address changed', { EREMCHG }
+ 'Can not access a needed shared library', { ELIBACC }
+ 'Accessing a corrupted shared library', { ELIBBAD }
+ '.lib section in a.out corrupted', { ELIBSCN }
+ 'Attempting to link in too many shared libraries', { ELIBMAX }
+ 'Cannot exec a shared library directly', { ELIBEXEC }
+ 'Illegal byte sequence', { EILSEQ }
+ 'Interrupted system call should be restarted', { ERESTART }
+ 'Streams pipe error', { ESTRPIPE }
+ 'Too many users', { EUSERS }
+ 'Socket operation on non-socket', { ENOTSOCK }
+ 'Destination address required', { EDESTADDRREQ }
+ 'Message too long', { EMSGSIZE }
+ 'Protocol wrong type for socket', { EPROTOTYPE }
+ 'Protocol not available', { ENOPROTOOPT }
+ 'Protocol not supported', { EPROTONOSUPPORT }
+ 'Socket type not supported', { ESOCKTNOSUPPORT }
+ 'Operation not supported on transport endpoint', { EOPNOTSUPP }
+ 'Protocol family not supported', { EPFNOSUPPORT }
+ 'Address family not supported by protocol', { EAFNOSUPPORT }
+ 'Address already in use', { EADDRINUSE }
+ 'Cannot assign requested address', { EADDRNOTAVAIL }
+ 'Network is down', { ENETDOWN }
+ 'Network is unreachable', { ENETUNREACH }
+ 'Network dropped connection because of reset', { ENETRESET }
+ 'Software caused connection abort', { ECONNABORTED }
+ 'Connection reset by peer', { ECONNRESET }
+ 'No buffer space available', { ENOBUFS }
+ 'Transport endpoint is already connected', { EISCONN }
+ 'Transport endpoint is not connected', { ENOTCONN }
+ 'Cannot send after transport endpoint shutdown', { ESHUTDOWN }
+ 'Too many references: cannot splice', { ETOOMANYREFS }
+ 'Connection timed out', { ETIMEDOUT }
+ 'Connection refused', { ECONNREFUSED }
+ 'Host is down', { EHOSTDOWN }
+ 'No route to host', { EHOSTUNREACH }
+ 'Operation already in progress', { EALREADY }
+ 'Operation now in progress', { EINPROGRESS }
+ 'Stale NFS file handle', { ESTALE }
+ 'Structure needs cleaning', { EUCLEAN }
+ 'Not a XENIX named type file', { ENOTNAM }
+ 'No XENIX semaphores available', { ENAVAIL }
+ 'Is a named type file', { EISNAM }
+ 'Remote I/O error', { EREMOTEIO }
+ 'Quota exceeded', { EDQUOT }
+ 'No medium found', { ENOMEDIUM }
+ 'Wrong medium type'); { EMEDIUMTYPE }
+
+Function StrError(err:longint):string;
+Procedure PError(const s:string; Errno : longint);
+
+Implementation
+
+Function StrError(err:longint):string;
+var s : string[12];
+begin
+ if (err<0) or (err>=sys_errn) then
+ begin
+ str(err,s);
+ StrError:='Unknown Error ('+s+')';
+ end
+ else
+ StrError:=StrPas(Sys_ErrList[err]);
+end;
+
+
+procedure PError(const s:string; Errno : longint);
+begin
+ WriteLn(stderr,s,': ',StrError(ErrNo));
+end;
+
+end.
+
+{
+ $Log: errors.pp,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/genfdset.inc b/rtl/unix/genfdset.inc
new file mode 100644
index 0000000000..6b790a17a0
--- /dev/null
+++ b/rtl/unix/genfdset.inc
@@ -0,0 +1,70 @@
+{
+ $Id: genfdset.inc,v 1.6 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2002 by Marco van de Voort
+ members of the Free Pascal development team.
+
+ Generic POSIX signal functions draft. Based on a few constants.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+function fpFD_SET(fdno:cint;var nset : TFDSet): cint;
+
+Begin
+ if (fdno<0) or (fdno > FD_MAXFDSET) Then
+ exit(-1);
+ nset[fdno shr ln2bitsinword]:=nset[(fdno) shr ln2bitsinword] OR (1 shl ((fdno) and ln2bitmask));
+ fpFD_SET:=0;
+End;
+
+function fpFD_CLR(fdno:cint;var nset : TFDSet): cint;
+
+Begin
+ if (fdno<0) or (fdno > FD_MAXFDSET) Then
+ exit(-1);
+ nset[(fdno) shr ln2bitsinword]:=nset[(fdno) shr ln2bitsinword] AND Cardinal(NOT (1 shl ((fdno) and ln2bitmask)));
+ fpFD_CLR:=0;
+End;
+
+function fpFD_ZERO(var nset : TFDSet):cint;
+
+var i :longint;
+
+Begin
+ for i:=0 to wordsinfdset-1 DO nset[i]:=0;
+ fpFD_ZERO:=0;
+End;
+
+function fpfdfillset(var nset : TFDSet):cint;
+
+var i :longint;
+
+Begin
+ for i:=0 to wordsinfdset-1 DO nset[i]:=Cardinal(NOT 0);
+ fpfdfillset:=0;
+End;
+
+function fpFD_ISSET(fdno:cint;const nset : TFDSet): cint;
+
+Begin
+ if (fdno<0) or (fdno > FD_MAXFDSET) Then
+ exit(-1);
+ if ((nset[(fdno) shr ln2bitsinword]) and (1 shl ((fdno) and ln2bitmask)))>0 Then
+ fpFD_ISSET:=1
+ else
+ fpFD_ISSET:=0;
+End;
+
+{
+ $Log: genfdset.inc,v $
+ Revision 1.6 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/genfuncs.inc b/rtl/unix/genfuncs.inc
new file mode 100644
index 0000000000..d737b6ca3f
--- /dev/null
+++ b/rtl/unix/genfuncs.inc
@@ -0,0 +1,124 @@
+{
+ $Id: genfuncs.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort.
+
+ A few general purpose routines. General purpose enough for *BSD
+ and Linux at least.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
+{
+ Create an argv which executes a command in a shell using /bin/sh -c
+}
+const Shell = '/bin/sh'#0'-c'#0;
+var
+ pp,p : ppchar;
+// temp : string; !! Never pass a local var back!!
+begin
+ getmem(pp,4*4);
+ p:=pp;
+ p^:=@Shell[1];
+ inc(p);
+ p^:=@Shell[9];
+ inc(p);
+ getmem(p^,len+1);
+ move(cmd^,p^^,len);
+ pchar(p^)[len]:=#0;
+ inc(p);
+ p^:=Nil;
+ InternalCreateShellArgV:=pp;
+end;
+
+function CreateShellArgV(const prog:string):ppchar;
+begin
+ CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
+end;
+
+function CreateShellArgV(const prog:Ansistring):ppchar;
+{
+ Create an argv which executes a command in a shell using /bin/sh -c
+ using a AnsiString;
+}
+begin
+ CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
+end;
+
+
+procedure FreeShellArgV(p:ppchar);
+begin
+ if (p<>nil) then begin
+ freemem(p[2]);
+ freemem(p);
+ end;
+end;
+
+{$ifndef FPC_USE_LIBC}
+Function fpgetenv(name:pchar):pchar;
+
+var
+ p : ppchar;
+ found : boolean;
+ np,cp : pchar;
+ len,i : longint;
+Begin
+ if (name=nil) or (envp=NIL) Then
+ exit(NIL);
+ np:=name;
+ while (np^<>#0) and (np^<>'=') DO
+ inc(np);
+ len:=np-name;
+ p:=envp;
+ while (p^<>NIL) DO
+ Begin
+ cp:=p^;
+ np:=name;
+ i:=len;
+ while (i<>0) and (cp^<>#0) DO
+ Begin
+ if cp^<>np^ Then
+ Begin
+ inc(cp); inc(np);
+ break;
+ End;
+ inc(cp); inc(np);
+ dec(i)
+ End;
+ if (i=0) and (cp^='=') Then
+ exit(cp+1);
+ inc(p);
+ end;
+ fpgetenv:=nil;
+End;
+{$ENDIF}
+
+Function fpgetenv(name:string):Pchar; [public, alias : 'FPC_SYSC_FPGETENV'];
+{
+ Searches the environment for a string with name p and
+ returns a pchar to it's value.
+ A pchar is used to accomodate for strings of length > 255
+}
+
+Begin
+{$ifndef FPC_USE_LIBC}
+ name:=name+'='; {Else HOST will also find HOSTNAME, etc}
+{$else}
+ name:=name+#0;
+{$endif}
+ fpgetenv:=fpgetenv(@name[1]);
+end;
+
+{
+ $Log: genfuncs.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/gensigset.inc b/rtl/unix/gensigset.inc
new file mode 100644
index 0000000000..3453077ac7
--- /dev/null
+++ b/rtl/unix/gensigset.inc
@@ -0,0 +1,79 @@
+{
+ $Id: gensigset.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2002 by Marco van de Voort
+ members of the Free Pascal development team.
+
+ Generic POSIX signal functions draft. Based on a few constants.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+function fpsigaddset(var nset : tsigset;signo:cint): cint;
+
+Begin
+ if (signo<=0) or (signo > SIG_MAXSIG) Then
+ Begin
+ fpseterrno(ESysEINVAL);
+ exit(-1);
+ End;
+ nset[(signo-1) shr ln2bitsinword]:=nset[(signo-1) shr ln2bitsinword] OR (1 shl ((signo-1) and ln2bitmask));
+ fpsigaddset:=0;
+End;
+
+function fpsigdelset(var nset : tsigset;signo:cint): cint;
+
+Begin
+ if (signo<=0) or (signo > SIG_MAXSIG) Then
+ Begin
+ fpseterrno(ESysEINVAL);
+ exit(-1);
+ End;
+ nset[(signo-1) shr ln2bitsinword]:=nset[(signo-1) shr ln2bitsinword] AND NOT (1 shl ((signo-1) and ln2bitmask));
+ fpsigdelset:=0;
+End;
+
+function fpsigemptyset(var nset : tsigset):cint;
+
+var i :longint;
+
+Begin
+ for i:=0 to wordsinsigset-1 DO nset[i]:=0;
+ fpsigemptyset:=0;
+End;
+
+function fpsigfillset(var nset : tsigset):cint;
+
+var i :longint;
+
+Begin
+ for i:=0 to wordsinsigset DO nset[i]:=NOT 0;
+ fpsigfillset:=0;
+End;
+
+function fpsigismember(const nset : tsigset;signo:cint): cint;
+
+Begin
+ if (signo<=0) or (signo > SIG_MAXSIG) Then
+ Begin
+ fpseterrno(ESysEINVAL);
+ exit(-1);
+ End;
+ if ((nset[(signo-1) shr ln2bitsinword]) and (1 shl ((signo-1) and ln2bitmask)))>0 Then
+ fpsigismember:=1
+ else
+ fpsigismember:=0;
+End;
+
+{
+ $Log: gensigset.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/ggigraph.pp b/rtl/unix/ggigraph.pp
new file mode 100644
index 0000000000..0dd2435639
--- /dev/null
+++ b/rtl/unix/ggigraph.pp
@@ -0,0 +1,543 @@
+{
+ $Id: ggigraph.pp,v 1.8 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+
+ This file implements the linux GGI support for the graph unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit GGIGraph;
+interface
+
+{ objfpc is needed for array of const support }
+{$mode objfpc}
+
+{$i graphh.inc}
+
+Const
+ { Supported modes }
+ {(sg) GTEXT deactivated because we need mode #0 as default mode}
+ {GTEXT = 0; Compatible with VGAlib v1.2 }
+ G320x200x16 = 1;
+ G640x200x16 = 2;
+ G640x350x16 = 3;
+ G640x480x16 = 4;
+ G320x200x256 = 5;
+ G320x240x256 = 6;
+ G320x400x256 = 7;
+ G360x480x256 = 8;
+ G640x480x2 = 9;
+
+ G640x480x256 = 10;
+ G800x600x256 = 11;
+ G1024x768x256 = 12;
+
+ G1280x1024x256 = 13; { Additional modes. }
+
+ G320x200x32K = 14;
+ G320x200x64K = 15;
+ G320x200x16M = 16;
+ G640x480x32K = 17;
+ G640x480x64K = 18;
+ G640x480x16M = 19;
+ G800x600x32K = 20;
+ G800x600x64K = 21;
+ G800x600x16M = 22;
+ G1024x768x32K = 23;
+ G1024x768x64K = 24;
+ G1024x768x16M = 25;
+ G1280x1024x32K = 26;
+ G1280x1024x64K = 27;
+ G1280x1024x16M = 28;
+
+ G800x600x16 = 29;
+ G1024x768x16 = 30;
+ G1280x1024x16 = 31;
+
+ G720x348x2 = 32; { Hercules emulation mode }
+
+ G320x200x16M32 = 33; { 32-bit per pixel modes. }
+ G640x480x16M32 = 34;
+ G800x600x16M32 = 35;
+ G1024x768x16M32 = 36;
+ G1280x1024x16M32 = 37;
+
+ { additional resolutions }
+ G1152x864x16 = 38;
+ G1152x864x256 = 39;
+ G1152x864x32K = 40;
+ G1152x864x64K = 41;
+ G1152x864x16M = 42;
+ G1152x864x16M32 = 43;
+
+ G1600x1200x16 = 44;
+ G1600x1200x256 = 45;
+ G1600x1200x32K = 46;
+ G1600x1200x64K = 47;
+ G1600x1200x16M = 48;
+ G1600x1200x16M32 = 49;
+
+
+implementation
+
+uses
+ termio;
+
+var
+ OldIO : TermIos;
+Procedure SetRawMode(b:boolean);
+Var
+ Tio : Termios;
+Begin
+ if b then
+ begin
+ TCGetAttr(1,Tio);
+ OldIO:=Tio;
+ CFMakeRaw(Tio);
+ end
+ else
+ Tio:=OldIO;
+ TCSetAttr(1,TCSANOW,Tio);
+End;
+
+const
+ InternalDriverName = 'LinuxGGI';
+
+{$i graph.inc}
+
+{ ---------------------------------------------------------------------
+ GGI bindings [(c) 1999 Sebastian Guenther]
+ ---------------------------------------------------------------------}
+{$LINKLIB c}
+{$PACKRECORDS C}
+
+const
+ GLASTMODE = 49;
+ ModeNames: array[0..GLastMode] of PChar =
+ ('[]', {Let GGI choose a default mode}
+ 'S320x200[GT_4BIT]',
+ 'S640x200[GT_4BIT]',
+ 'S640x350[GT_4BIT]',
+ 'S640x480[GT_4BIT]',
+ 'S320x200[GT_8BIT]',
+ 'S320x240[GT_8BIT]',
+ 'S320x400[GT_8BIT]',
+ 'S360x480[GT_8BIT]',
+ 'S640x480x[GT_1BIT]',
+ 'S640x480[GT_8BIT]',
+ 'S800x600[GT_8BIT]',
+ 'S1024x768[GT_8BIT]',
+ 'S1280x1024[GT_8BIT]',
+ 'S320x200[GT_15BIT]',
+ 'S320x200[GT_16BIT]',
+ 'S320x200[GT_24BIT]',
+ 'S640x480[GT_15BIT]',
+ 'S640x480[GT_16BIT]',
+ 'S640x480[GT_24BIT]',
+ 'S800x600[GT_15BIT]',
+ 'S800x600[GT_16BIT]',
+ 'S800x600[GT_24BIT]',
+ 'S1024x768[GT_15BIT]',
+ 'S1024x768[GT_16BIT]',
+ 'S1024x768[GT_24BIT]',
+ 'S1280x1024[GT_15BIT]',
+ 'S1280x1024[GT_16BIT]',
+ 'S1280x1024[GT_24BIT]',
+ 'S800x600[GT_4BIT]',
+ 'S1024x768[GT_4BIT]',
+ 'S1280x1024[GT_4BIT]',
+ 'S720x348x[GT_1BIT]',
+ 'S320x200[GT_32BIT]',
+ 'S640x480[GT_32BIT]',
+ 'S800x600[GT_32BIT]',
+ 'S1024x768[GT_32BIT]',
+ 'S1280x1024[GT_32BIT]',
+ 'S1152x864[GT_4BIT]',
+ 'S1152x864[gt_8BIT]',
+ 'S1152x864[GT_15BIT]',
+ 'S1152x864[GT_16BIT]',
+ 'S1152x864[GT_24BIT]',
+ 'S1152x864[GT_32BIT]',
+ 'S1600x1200[GT_4BIT]',
+ 'S1600x1200[gt_8BIT]',
+ 'S1600x1200[GT_15BIT]',
+ 'S1600x1200[GT_16BIT]',
+ 'S1600x1200[GT_24BIT]',
+ 'S1600x1200[GT_32BIT]');
+
+type
+ TGGIVisual = Pointer;
+ TGGIResource = Pointer;
+ TGGICoord = record
+ x, y: SmallInt;
+ end;
+ TGGIPixel = LongWord;
+ PGGIColor = ^TGGIColor;
+ TGGIColor = record
+ r, g, b, a: Word;
+ end;
+ PGGIClut = ^TGGIClut;
+ TGGIClut = record
+ size: SmallInt;
+ data: PGGIColor;
+ end;
+ TGGIGraphType = LongWord;
+ TGGIAttr = LongWord;
+ TGGIMode = record // requested by user and changed by driver
+ Frames: LongInt; // frames needed
+ Visible: TGGICoord; // vis. pixels, may change slightly
+ Virt: TGGICoord; // virtual pixels, may change
+ Size: TGGICoord; // size of visible in mm
+ GraphType: TGGIGraphType; // which mode ?
+ dpp: TGGICoord; // dots per pixel
+ end;
+
+const
+ libggi = 'ggi';
+function ggiInit: Longint; cdecl; external libggi;
+procedure ggiExit; cdecl; external libggi;
+function ggiOpen(display: PChar; args: Array of const): TGGIVisual; cdecl; external libggi;
+function ggiClose(vis: TGGIVisual): Longint; cdecl; external libggi;
+function ggiParseMode(s: PChar; var m: TGGIMode): Longint; cdecl; external libggi;
+function ggiSetMode(visual: TGGIVisual; var tm: TGGIMode): Longint; cdecl; external libggi;
+function ggiGetMode(visual: TGGIVisual; var tm: TGGIMode): Longint; cdecl; external libggi;
+function ggiCheckMode(visual: TGGIVisual; var tm: TGGIMode): Longint; cdecl; external libggi;
+
+function ggiMapColor(vis: TGGIVisual; Color: TGGIColor): TGGIPixel; cdecl; external libggi;
+
+function ggiPutPixel(vis: TGGIVisual; x, y: Longint; pixel: TGGIPixel): Longint; cdecl; external libggi;
+function ggiGetPixel(vis: TGGIVisual; x, y: Longint; var pixel: TGGIPixel): Longint; cdecl; external libggi;
+function ggiDrawBox(vis: TGGIVisual; x, y, w, h: Longint): Longint; cdecl; external libggi;
+function ggiPutBox(vis: TGGIVisual; x, y, w, h: Longint; var buffer): Longint; cdecl; external libggi;
+function ggiGetBox(vis: TGGIVisual; x, y, w, h: Longint; var buffer): Longint; cdecl; external libggi;
+
+function ggiGetPalette(vis: TGGIVisual; s, len: Longint; var cmap: TGGIColor): Longint; cdecl; external libggi;
+function ggiSetPalette(vis: TGGIVisual; s, len: Longint; var cmap: TGGIColor): Longint; cdecl; external libggi;
+
+
+var
+ Visual: TGGIVisual;
+ CurrentMode, OldMode: TGGIMode;
+
+
+procedure ggi_savevideostate;
+begin
+ ggiGetMode(Visual, OldMode);
+end;
+
+procedure ggi_restorevideostate;
+begin
+ ggiSetMode(Visual, OldMode);
+end;
+
+const
+ BgiColors: array[0..15] of TGGIColor = (
+ (r: $0000; g: $0000; b: $0000; a: 0),
+ (r: $0000; g: $0000; b: $8000; a: 0),
+ (r: $0000; g: $8000; b: $0000; a: 0),
+ (r: $0000; g: $8000; b: $8000; a: 0),
+ (r: $8000; g: $0000; b: $0000; a: 0),
+ (r: $8000; g: $0000; b: $8000; a: 0),
+ (r: $8000; g: $8000; b: $0000; a: 0),
+ (r: $C000; g: $C000; b: $C000; a: 0),
+ (r: $8000; g: $8000; b: $8000; a: 0),
+ (r: $0000; g: $0000; b: $FFFF; a: 0),
+ (r: $0000; g: $FFFF; b: $0000; a: 0),
+ (r: $0000; g: $FFFF; b: $FFFF; a: 0),
+ (r: $FFFF; g: $0000; b: $0000; a: 0),
+ (r: $FFFF; g: $0000; b: $FFFF; a: 0),
+ (r: $FFFF; g: $FFFF; b: $0000; a: 0),
+ (r: $FFFF; g: $FFFF; b: $FFFF; a: 0));
+
+procedure ggi_initmodeproc;
+begin
+ ggiParseMode(ModeNames[IntCurrentMode], CurrentMode);
+ ggiSetMode(Visual, CurrentMode);
+end;
+
+function ClipCoords(var x, y: SmallInt): Boolean;
+{ Adapt to viewport, return TRUE if still in viewport,
+ false if outside viewport}
+begin
+ x := x + StartXViewPort;
+ x := y + StartYViewPort;
+ ClipCoords := not ClipPixels;
+ if ClipCoords then begin
+ ClipCoords := (y < StartXViewPort) or (x > (StartXViewPort + ViewWidth));
+ ClipCoords := ClipCoords or
+ ((y < StartYViewPort) or (y > (StartYViewPort + ViewHeight)));
+ ClipCoords := not ClipCoords;
+ end;
+end;
+
+
+procedure ggi_directpixelproc(X, Y: smallint);
+var
+ Color, CurCol: TGGIPixel;
+begin
+ CurCol := ggiMapColor(Visual, BgiColors[CurrentColor]);
+ case CurrentWriteMode of
+ XORPut: begin
+ { getpixel wants local/relative coordinates }
+ ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
+ Color := CurCol xor Color;
+ end;
+ OrPut: begin
+ { getpixel wants local/relative coordinates }
+ ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
+ Color := CurCol or Color;
+ end;
+ AndPut: begin
+ { getpixel wants local/relative coordinates }
+ ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
+ Color := CurCol and Color;
+ end;
+ NotPut:
+ Color := not Color;
+ else
+ Color := CurCol;
+ end;
+ ggiPutPixel(Visual, x, y, Color);
+end;
+
+procedure ggi_putpixelproc(X,Y: smallint; Color: Word);
+begin
+ If Not ClipCoords(X,Y) Then exit;
+ ggiputpixel(Visual,x, y, Color);
+end;
+
+function ggi_getpixelproc (X,Y: smallint): word;
+
+Var i : TGGIPixel;
+
+begin
+ ClipCoords(X,Y);
+ ggigetpixel(Visual,x, y,I);
+ ggi_getpixelproc:=i;
+end;
+
+procedure ggi_clrviewproc;
+begin
+ ggidrawbox(Visual,StartXViewPort,StartYViewPort,ViewWidth,ViewHeight);
+ { reset coordinates }
+ CurrentX := 0;
+ CurrentY := 0;
+end;
+
+{ Bitmap utilities }
+type
+ PBitmap = ^TBitmap;
+ TBitmap = record
+ Width, Height: longint;
+ reserved : longint;
+ Data: record end;
+ end;
+
+procedure ggi_putimageproc (X,Y: smallint; var Bitmap; BitBlt: Word);
+begin
+ With TBitMap(BitMap) do
+ ggiputbox(Visual,x, y, width, height, Data);
+end;
+
+procedure ggi_getimageproc (X1,Y1,X2,Y2: smallint; Var Bitmap);
+begin
+ with TBitmap(Bitmap) do
+ begin
+ Width := x2 - x1 + 1;
+ Height := y2 - y1 + 1;
+ ggigetbox(Visual,x1,y1, x2 - x1 + 1, y2 - y1 + 1, Data);
+ end;
+end;
+
+function ggi_imagesizeproc (X1,Y1,X2,Y2: smallint): longint;
+begin
+ // 32 bits per pixel -- change ASAP !!
+ ggi_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * SizeOF(longint);
+end;
+
+procedure ggi_hlineproc (x, x2,y : smallint);
+begin
+end;
+
+procedure ggi_vlineproc (x,y,y2: smallint);
+begin
+end;
+
+procedure ggi_patternlineproc (x1,x2,y: smallint);
+begin
+end;
+
+procedure ggi_ellipseproc (X,Y: smallint;XRadius: word;
+ YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
+begin
+end;
+
+procedure ggi_lineproc (X1, Y1, X2, Y2 : smallint);
+begin
+end;
+
+procedure ggi_getscanlineproc (X1, X2, Y : smallint; var data);
+begin
+end;
+
+procedure ggi_setactivepageproc (page: word);
+begin
+end;
+
+procedure ggi_setvisualpageproc (page: word);
+begin
+end;
+
+
+procedure ggi_savestateproc;
+begin
+end;
+
+procedure ggi_restorestateproc;
+begin
+end;
+
+procedure ggi_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: smallint);
+
+Var Col : TGGIcolor;
+
+begin
+ col.r:=redvalue;
+ col.g:=greenvalue;
+ col.b:=bluevalue;
+ ggisetpalette(Visual,ColorNum,1,col);
+end;
+
+procedure ggi_getrgbpaletteproc (ColorNum: smallint;
+ var RedValue, GreenValue, BlueValue: smallint);
+
+Var Col : TGGIColor;
+
+begin
+ ggigetpalette(Visual,ColorNum,1,col);
+ RedValue:=Col.R;
+ GreenValue:=Col.G;
+ BlueValue:=Col.B;
+end;
+
+{************************************************************************}
+{* General routines *}
+{************************************************************************}
+
+procedure CloseGraph;
+begin
+ if not IsGraphMode then
+ begin
+ _graphresult := grnoinitgraph;
+ exit
+ end;
+ RestoreVideoState;
+ isgraphmode := false;
+end;
+
+function QueryAdapterInfo:PModeInfo;
+{ This routine returns the head pointer to the list }
+{ of supported graphics modes. }
+{ Returns nil if no graphics mode supported. }
+{ This list is READ ONLY! }
+
+var
+ ModeInfo: TGGIMode;
+
+ procedure AddGGIMode(i: smallint); // i is the mode number
+ var
+ mode: TModeInfo;
+ begin
+ InitMode(Mode);
+ with Mode do begin
+ ModeNumber := i;
+ ModeName := ModeNames[i];
+ // Pretend we're VGA always.
+ DriverNumber := VGA;
+ MaxX := ModeInfo.Visible.X-1;
+ MaxY := ModeInfo.Visible.Y-1;
+ MaxColor := 1 shl (ModeInfo.graphtype and $ff);
+ //MaxColor := 255;
+ PaletteSize := MaxColor;
+ HardwarePages := 0;
+ // necessary hooks ...
+ DirectPutPixel := @ggi_DirectPixelProc;
+ GetPixel := @ggi_GetPixelProc;
+ PutPixel := @ggi_PutPixelProc;
+ SetRGBPalette := @ggi_SetRGBPaletteProc;
+ GetRGBPalette := @ggi_GetRGBPaletteProc;
+ ClearViewPort := @ggi_ClrViewProc;
+ PutImage := @ggi_PutImageProc;
+ GetImage := @ggi_GetImageProc;
+ ImageSize := @ggi_ImageSizeProc;
+ { Add later maybe ?
+ SetVisualPage := SetVisualPageProc;
+ SetActivePage := SetActivePageProc;
+ GetScanLine := @ggi_GetScanLineProc;
+ Line := @ggi_LineProc;
+ InternalEllipse:= @ggi_EllipseProc;
+ PatternLine := @ggi_PatternLineProc;
+ HLine := @ggi_HLineProc;
+ VLine := @ggi_VLineProc;
+ }
+ InitMode := @ggi_InitModeProc;
+ end;
+ AddMode(Mode);
+ end;
+
+var
+ i: longint;
+ OldMode: TGGIMode;
+begin
+ QueryAdapterInfo := ModeList;
+ { If the mode listing already exists... }
+ { simply return it, without changing }
+ { anything... }
+ if Assigned(ModeList) then
+ exit;
+ SaveVideoState:=@ggi_savevideostate;
+ RestoreVideoState:=@ggi_restorevideostate;
+
+ If ggiInit <> 0 then begin
+ _graphresult := grNoInitGraph;
+ exit;
+ end;
+
+ Visual := ggiOpen(nil, []); // Use default visual
+
+ ggiGetMode(Visual, OldMode);
+ ggiParseMode('', ModeInfo);
+ ggiSetMode(Visual, ModeInfo);
+ ggiGetMode(Visual, ModeInfo);
+ ggiSetMode(Visual, OldMode);
+ AddGGIMode(0);
+
+ for i := 1 to GLastMode do begin
+ // WriteLn('Testing mode: ', ModeNames[i]);
+ ggiParseMode(ModeNames[i], ModeInfo);
+ If ggiCheckMode(visual, ModeInfo) = 0 then begin
+ Writeln('OK for mode ',i,' : ', ModeNames[i]);
+ AddGGIMode(i);
+ end;
+ end;
+end;
+
+initialization
+ InitializeGraph;
+ SetRawMode(True);
+finalization
+ SetRawMode(False);
+end.
+{
+ $Log: ggigraph.pp,v $
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/graph.pp b/rtl/unix/graph.pp
new file mode 100644
index 0000000000..4c67ad2279
--- /dev/null
+++ b/rtl/unix/graph.pp
@@ -0,0 +1,610 @@
+{
+ $Id: graph.pp,v 1.11 2005/04/04 16:13:09 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+
+ This file implements the linux GGI support for the graph unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Graph;
+interface
+
+{$i graphh.inc}
+
+Const
+ { Supported modes }
+ {(sg) GTEXT deactivated because we need mode #0 as default mode}
+ {GTEXT = 0; Compatible with VGAlib v1.2 }
+ G320x200x16 = 1;
+ G640x200x16 = 2;
+ G640x350x16 = 3;
+ G640x480x16 = 4;
+ G320x200x256 = 5;
+ G320x240x256 = 6;
+ G320x400x256 = 7;
+ G360x480x256 = 8;
+ G640x480x2 = 9;
+
+ G640x480x256 = 10;
+ G800x600x256 = 11;
+ G1024x768x256 = 12;
+
+ G1280x1024x256 = 13; { Additional modes. }
+
+ G320x200x32K = 14;
+ G320x200x64K = 15;
+ G320x200x16M = 16;
+ G640x480x32K = 17;
+ G640x480x64K = 18;
+ G640x480x16M = 19;
+ G800x600x32K = 20;
+ G800x600x64K = 21;
+ G800x600x16M = 22;
+ G1024x768x32K = 23;
+ G1024x768x64K = 24;
+ G1024x768x16M = 25;
+ G1280x1024x32K = 26;
+ G1280x1024x64K = 27;
+ G1280x1024x16M = 28;
+
+ G800x600x16 = 29;
+ G1024x768x16 = 30;
+ G1280x1024x16 = 31;
+
+ G720x348x2 = 32; { Hercules emulation mode }
+
+ G320x200x16M32 = 33; { 32-bit per pixel modes. }
+ G640x480x16M32 = 34;
+ G800x600x16M32 = 35;
+ G1024x768x16M32 = 36;
+ G1280x1024x16M32 = 37;
+
+ { additional resolutions }
+ G1152x864x16 = 38;
+ G1152x864x256 = 39;
+ G1152x864x32K = 40;
+ G1152x864x64K = 41;
+ G1152x864x16M = 42;
+ G1152x864x16M32 = 43;
+
+ G1600x1200x16 = 44;
+ G1600x1200x256 = 45;
+ G1600x1200x32K = 46;
+ G1600x1200x64K = 47;
+ G1600x1200x16M = 48;
+ G1600x1200x16M32 = 49;
+
+
+implementation
+
+uses
+ termio,x86;
+
+const
+ InternalDriverName = 'LinuxVGA';
+
+{$i graph.inc}
+
+ type
+ PByte = ^Byte;
+ PLongInt = ^LongInt;
+
+ PByteArray = ^TByteArray;
+ TByteArray = array [0..MAXINT - 1] of Byte;
+
+
+
+{ ---------------------------------------------------------------------
+ SVGA bindings.
+
+ ---------------------------------------------------------------------}
+
+{ Link with VGA, gl and c libraries }
+{$linklib vga}
+{$linklib c}
+
+Const
+ { Text }
+
+ WRITEMODE_OVERWRITE = 0;
+ WRITEMODE_MASKED = 1;
+ FONT_EXPANDED = 0;
+ FONT_COMPRESSED = 2;
+
+ { Types }
+ type
+ pvga_modeinfo = ^vga_modeinfo;
+ vga_modeinfo = record
+ width,
+ height,
+ bytesperpixel,
+ colors,
+ linewidth, { scanline width in bytes }
+ maxlogicalwidth, { maximum logical scanline width }
+ startaddressrange, { changeable bits set }
+ maxpixels, { video memory / bytesperpixel }
+ haveblit, { mask of blit functions available }
+ flags: Longint; { other flags }
+ { Extended fields: }
+ chiptype, { Chiptype detected }
+ memory, { videomemory in KB }
+ linewidth_unit: Longint; { Use only a multiple of this as parameter for set_displaystart }
+ linear_aperture: PChar; { points to mmap secondary mem aperture of card }
+ aperture_size: Longint; { size of aperture in KB if size>=videomemory.}
+
+ set_aperture_page: procedure (page: Longint);
+ { if aperture_size<videomemory select a memory page }
+ extensions: Pointer; { points to copy of eeprom for mach32 }
+ { depends from actual driver/chiptype.. etc. }
+ end;
+
+ PGraphicsContext = ^TGraphicsContext;
+ TGraphicsContext = record
+ ModeType: Byte;
+ ModeFlags: Byte;
+ Dummy: Byte;
+ FlipPage: Byte;
+ Width: LongInt;
+ Height: LongInt;
+ BytesPerPixel: LongInt;
+ Colors: LongInt;
+ BitsPerPixel: LongInt;
+ ByteWidth: LongInt;
+ VBuf: pointer;
+ Clip: LongInt;
+ ClipX1: LongInt;
+ ClipY1: LongInt;
+ ClipX2: LongInt;
+ ClipY2: LongInt;
+ ff: pointer;
+ end;
+
+Const
+ GLASTMODE = 49;
+ ModeNames : Array[0..GLastMode] of string [18] =
+ ('Text',
+ 'G320x200x16',
+ 'G640x200x16',
+ 'G640x350x16',
+ 'G640x480x16',
+ 'G320x200x256',
+ 'G320x240x256',
+ 'G320x400x256',
+ 'G360x480x256',
+ 'G640x480x2',
+ 'G640x480x256',
+ 'G800x600x256',
+ 'G1024x768x256',
+ 'G1280x1024x256',
+ 'G320x200x32K',
+ 'G320x200x64K',
+ 'G320x200x16M',
+ 'G640x480x32K',
+ 'G640x480x64K',
+ 'G640x480x16M',
+ 'G800x600x32K',
+ 'G800x600x64K',
+ 'G800x600x16M',
+ 'G1024x768x32K',
+ 'G1024x768x64K',
+ 'G1024x768x16M',
+ 'G1280x1024x32K',
+ 'G1280x1024x64K',
+ 'G1280x1024x16M',
+ 'G800x600x16',
+ '1024x768x16',
+ '1280x1024x16',
+ 'G720x348x2',
+ 'G320x200x16M32',
+ 'G640x480x16M32',
+ 'G800x600x16M32',
+ 'G1024x768x16M32',
+ 'G1280x1024x16M32',
+ 'G1152x864x16',
+ 'G1152x864x256',
+ 'G1152x864x32K',
+ 'G1152x864x64K',
+ 'G1152x864x16M',
+ 'G1152x864x16M32',
+ 'G1600x1200x16',
+ 'G1600x1200x256',
+ 'G1600x1200x32K',
+ 'G1600x1200x64K',
+ 'G1600x1200x16M',
+ 'G1600x1200x16M32');
+{var
+ PhysicalScreen: PGraphicsContext; }
+
+ { vga functions }
+ Function vga_init: Longint; Cdecl; External;
+ Function vga_hasmode(mode: Longint): Boolean; Cdecl; External;
+ Function vga_getmodeinfo(mode: Longint): pvga_modeinfo; Cdecl; External;
+ Function vga_setmode(mode: Longint): Longint; Cdecl; External;
+ Function vga_getcolors: Longint; cdecl;external;
+ Function vga_setpalette(index: Longint; red: Longint; green: Longint; blue: Longint) : longint; cdecl;external;
+ Function vga_getpalette(index: Longint; var red: Longint; var green: Longint; var blue: Longint): Longint; cdecl;external;
+ Function vga_setegacolor(Color: Longint) : longint; cdecl;external;
+ Function vga_setcolor(color: Longint): Longint; cdecl;external;
+ Function vga_drawpixel(x, y: Longint): Longint; cdecl;external;
+ Function vga_getpixel(x, y: Longint): Longint; cdecl;external;
+ Function vga_drawline(x1, y1, x2, y2: Longint): Longint; cdecl;external;
+ function vga_screenoff: Longint; Cdecl; External;
+ function vga_screenon: Longint; Cdecl; External;
+ function vga_getgraphmem: PByteArray; cdecl; external;
+
+
+
+var
+ OldIO : TermIos;
+Procedure SetRawMode(b:boolean);
+Var
+ Tio : Termios;
+Begin
+ if b then
+ begin
+ TCGetAttr(1,Tio);
+ OldIO:=Tio;
+ CFMakeRaw(Tio);
+ end
+ else
+ Tio:=OldIO;
+ TCSetAttr(1,TCSANOW,Tio);
+End;
+
+
+{ ---------------------------------------------------------------------
+ Required procedures
+ ---------------------------------------------------------------------}
+
+{$INCLUDE graph16.inc} // Include graphic functions for 16 colours modes
+
+var
+ LastColor: smallint; {Cache the last set color to improve speed}
+
+procedure SetEGAColor(color: smallint);
+begin
+ if color <> LastColor then begin
+ LastColor := color;
+ if maxcolor = 16 then
+ vga_setegacolor(color)
+ else vga_setcolor(color);
+ end;
+end;
+
+
+procedure libvga_savevideostate;
+begin
+end;
+
+procedure libvga_restorevideostate;
+begin
+ vga_setmode(0);
+end;
+
+{
+const
+ BgiColors: array[0..15] of LongInt
+ = ($000000, $000020, $002000, $002020,
+ $200000, $200020, $202000, $303030,
+ $202020, $00003F, $003F00, $003F3F,
+ $3F0000, $3F003F, $3F3F00, $3F3F3F);
+}
+
+procedure InitColors(nrColors: longint);
+
+var
+ i: smallint;
+begin
+ for i:=0 to nrColors do
+ vga_setpalette(I,DefaultColors[i].red shr 2,
+ DefaultColors[i].green shr 2,DefaultColors[i].blue shr 2)
+end;
+
+procedure libvga_initmodeproc;
+
+Var Nrcolors : Longint;
+
+begin
+ vga_setmode(IntCurrentMode);
+ vga_screenon;
+ VidMem := vga_getgraphmem;
+ nrColors:=vga_getcolors;
+ if (nrColors=16) or (nrcolors=256) then
+ InitColors(nrColors);
+ SetRawMode(True);
+end;
+
+Function ClipCoords (Var X,Y : smallint) : Boolean;
+{ Adapt to viewport, return TRUE if still in viewport,
+ false if outside viewport}
+
+begin
+ X:= X + StartXViewPort;
+ Y:= Y + StartYViewPort;
+ ClipCoords:=Not ClipPixels;
+ if ClipPixels then
+ Begin
+ ClipCoords:=(X < StartXViewPort) or (X > (StartXViewPort + ViewWidth));
+ ClipCoords:=ClipCoords or
+ ((Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)));
+ ClipCoords:=Not ClipCoords;
+ end;
+end;
+
+
+procedure libvga_directpixelproc(X,Y: smallint);
+
+Var Color : Word;
+
+begin
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor Xor Color;
+ end;
+ OrPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor Or Color;
+ end;
+ AndPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+ Color := CurrentColor And Color;
+ end;
+ NotPut:
+ begin
+ Color := Not Color;
+ end
+ else
+ Color:=CurrentColor;
+ end;
+ SetEGAColor(Color);
+ vga_drawpixel(x, y);
+end;
+
+procedure libvga_putpixelproc(X,Y: smallint; Color: Word);
+begin
+ If Not ClipCoords(X,Y) Then exit;
+ SetEGAColor(Color);
+ vga_drawpixel(x, y);
+end;
+
+function libvga_getpixelproc (X,Y: smallint): word;
+begin
+ ClipCoords(X,Y);
+ libvga_getpixelproc:=vga_getpixel(x, y);
+end;
+
+procedure libvga_clrviewproc;
+
+Var I,Xmax : longint;
+
+begin
+ SetEGAColor(CurrentBkColor);
+ Xmax:=StartXViewPort+ViewWidth-1;
+ For i:=StartYViewPort to StartYViewPort+ViewHeight-1 do
+ vga_drawline(StartXViewPort,I,Xmax,I);
+ { reset coordinates }
+ CurrentX := 0;
+ CurrentY := 0;
+end;
+
+{ Bitmap utilities }
+{type
+ PBitmap = ^TBitmap;
+ TBitmap = record
+ Width, Height: smallint;
+ Data: record end;
+ end;
+}
+
+procedure libvga_putimageproc (X,Y: smallint; var Bitmap; BitBlt: Word);
+begin
+{
+ With TBitMap(BitMap) do
+ gl_putbox(x, y, width, height, @Data);
+}
+end;
+
+procedure libvga_getimageproc (X1,Y1,X2,Y2: smallint; Var Bitmap);
+begin
+{ with TBitmap(Bitmap) do
+ begin
+ Width := x2 - x1 + 1;
+ Height := y2 - y1 + 1;
+ gl_getbox(x1,y1, x2 - x1 + 1, y2 - y1 + 1, @Data);
+ end;
+}
+end;
+
+{
+function libvga_imagesizeproc (X1,Y1,X2,Y2: smallint): longint;
+begin
+ libvga_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * PhysicalScreen^.BytesPerPixel;
+
+end;
+}
+procedure libvga_hlineproc (x, x2,y : smallint);
+begin
+end;
+
+procedure libvga_vlineproc (x,y,y2: smallint);
+begin
+end;
+
+procedure libvga_patternlineproc (x1,x2,y: smallint);
+begin
+end;
+
+procedure libvga_ellipseproc (X,Y: smallint;XRadius: word;
+ YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
+begin
+end;
+
+procedure libvga_lineproc (X1, Y1, X2, Y2 : smallint);
+begin
+end;
+
+procedure libvga_getscanlineproc (X1,X2,Y : smallint; var data);
+begin
+end;
+
+procedure libvga_setactivepageproc (page: word);
+begin
+end;
+
+procedure libvga_setvisualpageproc (page: word);
+begin
+end;
+
+
+procedure libvga_savestateproc;
+begin
+end;
+
+procedure libvga_restorestateproc;
+begin
+end;
+
+procedure libvga_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: smallint);
+begin
+ vga_setpalette(ColorNum,RedValue shr 2,GreenValue shr 2,BlueValue shr 2);
+end;
+
+procedure libvga_getrgbpaletteproc (ColorNum: smallint;
+ var RedValue, GreenValue, BlueValue: smallint);
+
+Var R,G,B : longint;
+
+begin
+ vga_getpalette(ColorNum,R,G,B);
+ RedValue:=R * 255 div 63;
+ GreenValue:=G * 255 div 63;
+ BlueValue:=B * 255 div 63;
+end;
+
+{************************************************************************}
+{* General routines *}
+{************************************************************************}
+
+ procedure CloseGraph;
+ Begin
+ If not isgraphmode then
+ begin
+ _graphresult := grnoinitgraph;
+ exit
+ end;
+ SetRawMode(False);
+ RestoreVideoState;
+ isgraphmode := false;
+ end;
+
+ function QueryAdapterInfo:PModeInfo;
+ { This routine returns the head pointer to the list }
+ { of supported graphics modes. }
+ { Returns nil if no graphics mode supported. }
+ { This list is READ ONLY! }
+ var
+ mode: TModeInfo;
+ modeinfo : vga_modeinfo;
+ i : longint;
+
+ begin
+ QueryAdapterInfo := ModeList;
+ { If the mode listing already exists... }
+ { simply return it, without changing }
+ { anything... }
+ if assigned(ModeList) then
+ exit;
+ SaveVideoState:=@libvga_savevideostate;
+ RestoreVideoState:=@libvga_restorevideostate;
+ vga_init;
+ For I:=0 to GLastMode do
+ begin
+ If vga_hasmode(I) then
+ begin
+ ModeInfo:=vga_getmodeinfo(i)^;
+ InitMode(Mode);
+ With Mode do
+ begin
+ ModeNumber:=I;
+ ModeName:=ModeNames[i];
+ // Pretend we are VGA always.
+ DriverNumber := VGA;
+ // MaxX is number of pixels in X direction - 1
+ MaxX:=ModeInfo.Width-1;
+ // same for MaxY
+ MaxY:=ModeInfo.Height-1;
+ MaxColor := ModeInfo.colors;
+ PaletteSize := MaxColor;
+ HardwarePages := 0;
+ // necessary hooks ...
+ if (MaxColor = 16) and
+ (LongInt(ModeInfo.Width) * LongInt(ModeInfo.Height) < 65536*4*2) then
+ begin
+ // Use optimized graphics routines for 4 bit EGA/VGA modes
+ ScrWidth := ModeInfo.Width div 8;
+ DirectPutPixel := @DirectPutPixel16;
+ PutPixel := @PutPixel16;
+ GetPixel := @GetPixel16;
+ HLine := @HLine16;
+ VLine := @VLine16;
+ GetScanLine := @GetScanLine16;
+ end
+ else
+ begin
+ DirectPutPixel := @libvga_DirectPixelProc;
+ GetPixel := @libvga_GetPixelProc;
+ PutPixel := @libvga_PutPixelProc;
+ { May be implemented later:
+ HLine := @libvga_HLineProc;
+ VLine := @libvga_VLineProc;
+ GetScanLine := @libvga_GetScanLineProc;}
+ ClearViewPort := @libvga_ClrViewProc;
+ end;
+ SetRGBPalette := @libvga_SetRGBPaletteProc;
+ GetRGBPalette := @libvga_GetRGBPaletteProc;
+ { These are not really implemented yet:
+ PutImage := @libvga_PutImageProc;
+ GetImage := @libvga_GetImageProc;}
+{ If you use the default getimage/putimage, you also need the default
+ imagesize! (JM)
+ ImageSize := @libvga_ImageSizeProc; }
+ { Add later maybe ?
+ SetVisualPage := SetVisualPageProc;
+ SetActivePage := SetActivePageProc;
+ Line := @libvga_LineProc;
+ InternalEllipse:= @libvga_EllipseProc;
+ PatternLine := @libvga_PatternLineProc;
+ }
+ InitMode := @libvga_InitModeProc;
+ end;
+ AddMode(Mode);
+ end;
+ end;
+ end;
+
+initialization
+ InitializeGraph;
+end.
+{
+ $Log: graph.pp,v $
+ Revision 1.11 2005/04/04 16:13:09 peter
+ * use smallint
+
+ Revision 1.10 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/graph16.inc b/rtl/unix/graph16.inc
new file mode 100644
index 0000000000..2f33d2f314
--- /dev/null
+++ b/rtl/unix/graph16.inc
@@ -0,0 +1,434 @@
+ {************************************************************************}
+ {* 4-bit planar VGA mode routines *}
+ {************************************************************************}
+
+
+const
+
+ VideoOfs = 0;
+
+
+var
+
+ VidMem: PByteArray;
+ ScrWidth: SmallInt;
+
+
+procedure bytemove(var source, dest; count: SmallInt);
+var
+ s, d: PByte;
+begin
+ s := PByte(@source);
+ d := PByte(@dest);
+ while count > 0 do begin
+ d^ := s^;
+ Inc(d);
+ Inc(s);
+ Dec(count);
+ end;
+end;
+
+
+
+procedure PutPixel16(X,Y : SmallInt; Pixel: Word);
+var
+ offset: word;
+ dummy: byte;
+begin
+ Inc(x, StartXViewPort);
+ Inc(y, StartYViewPort);
+ { convert to absolute coordinates and then verify clipping...}
+ if ClipPixels then
+ begin
+ if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+ exit;
+ if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+ exit;
+ end;
+ offset := y * 80 + (x shr 3) + VideoOfs;
+ WritePortW($3ce, $0f01); { Index 01 : Enable ops on all 4 planes }
+ WritePortW($3ce, (Pixel and $ff) shl 8); { Index 00 : Enable correct plane and write color }
+
+ WritePortW($3ce, 8 or ($8000 shr (x and $7)));{ Select correct bits to modify }
+ dummy := VidMem^[offset]; { Read data byte into VGA latch register }
+ VidMem^[offset] := dummy; { Write the data into video memory }
+end;
+
+
+function GetPixel16(X,Y: SmallInt):word;
+var
+ dummy, offset: Word;
+ shift: byte;
+begin
+ Inc(x, StartXViewPort);
+ Inc(y, StartYViewPort);
+ offset := Y * 80 + (x shr 3) + VideoOfs;
+ WritePortW($3ce, 4);
+ shift := 7 - (X and 7);
+ dummy := (VidMem^[offset] shr shift) and 1;
+ WritePortB($3cf, 1);
+ dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 1);
+ WritePortB($3cf, 2);
+ dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 2);
+ WritePortB($3cf, 3);
+ dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 3);
+ GetPixel16 := dummy;
+end;
+
+
+procedure GetScanLine16(x1, x2, y: SmallInt; var data);
+var
+ dummylong: longint;
+ Offset, count, count2, amount, index: word;
+ plane: byte;
+begin
+ inc(x1,StartXViewPort);
+ inc(x2,StartXViewPort);
+{$ifdef logging}
+ LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
+{$Endif logging}
+ offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
+{$ifdef logging}
+ LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
+{$Endif logging}
+ { first get enough pixels so offset is 32bit aligned }
+ amount := 0;
+ index := 0;
+ If ((x1 and 31) <> 0) Or
+ ((x2-x1+1) < 32) Then
+ Begin
+ If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
+ amount := 32-(x1 and 31)
+ Else amount := x2-x1+1;
+{$ifdef logging}
+ LogLn('amount to align to 32bits or to get all: ' + strf(amount));
+{$Endif logging}
+ For count := 0 to amount-1 do
+ WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
+ index := amount;
+ Inc(Offset,(amount+7) shr 3);
+{$ifdef logging}
+ LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
+ LogLn('index now: '+strf(index));
+{$Endif logging}
+ End;
+ amount := x2-x1+1 - amount;
+{$ifdef logging}
+ LogLn('amount left: ' + strf(amount));
+{$Endif logging}
+ If amount = 0 Then Exit;
+ WritePortB($3ce, 4);
+ { first get everything from plane 3 (4th plane) }
+ WritePortB($3cf, 3);
+ Count := 0;
+ For Count := 1 to (amount shr 5) Do
+ Begin
+ dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
+ dummylong :=
+ ((dummylong and $ff) shl 24) or
+ ((dummylong and $ff00) shl 8) or
+ ((dummylong and $ff0000) shr 8) or
+ ((dummylong and $ff000000) shr 24);
+ For Count2 := 31 downto 0 Do
+ Begin
+ WordArray(Data)[index+Count2] := DummyLong and 1;
+ DummyLong := DummyLong shr 1;
+ End;
+ Inc(Index, 32);
+ End;
+{ Now get the data from the 3 other planes }
+ plane := 3;
+ Repeat
+ Dec(Index,Count*32);
+ Dec(plane);
+ WritePortB($3cf, plane);
+ Count := 0;
+ For Count := 1 to (amount shr 5) Do
+ Begin
+ dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
+ dummylong :=
+ ((dummylong and $ff) shl 24) or
+ ((dummylong and $ff00) shl 8) or
+ ((dummylong and $ff0000) shr 8) or
+ ((dummylong and $ff000000) shr 24);
+ For Count2 := 31 downto 0 Do
+ Begin
+ WordArray(Data)[index+Count2] :=
+ (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
+ DummyLong := DummyLong shr 1;
+ End;
+ Inc(Index, 32);
+ End;
+ Until plane = 0;
+ amount := amount and 31;
+ Dec(index);
+{$ifdef Logging}
+ LogLn('Last array index written to: '+strf(index));
+ LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
+{$Endif logging}
+ For Count := 1 to amount Do
+ WordArray(Data)[index+Count] := getpixel16(index+Count,y);
+{$ifdef logging}
+ LogLn('First 32 bytes gotten with getscanline16: ');
+ If x2-x1+1 >= 32 Then
+ Count2 := 32
+ Else Count2 := x2-x1+1;
+ For Count := 0 to Count2-1 Do
+ Log(strf(WordArray(Data)[Count])+' ');
+ LogLn('');
+ If x2-x1+1 >= 32 Then
+ Begin
+ LogLn('Last 32 bytes gotten with getscanline16: ');
+ For Count := 31 downto 0 Do
+ Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+ End;
+ LogLn('');
+ GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
+ LogLn('First 32 bytes gotten with getscanlinedef: ');
+ If x2-x1+1 >= 32 Then
+ Count2 := 32
+ Else Count2 := x2-x1+1;
+ For Count := 0 to Count2-1 Do
+ Log(strf(WordArray(Data)[Count])+' ');
+ LogLn('');
+ If x2-x1+1 >= 32 Then
+ Begin
+ LogLn('Last 32 bytes gotten with getscanlinedef: ');
+ For Count := 31 downto 0 Do
+ Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+ End;
+ LogLn('');
+ LogLn('GetScanLine16 end');
+{$Endif logging}
+end;
+
+
+procedure DirectPutPixel16(X,Y : SmallInt);
+{ x,y -> must be in global coordinates. No clipping. }
+var
+ color: word;
+ offset: word;
+ dummy: byte;
+begin
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
+ Color := CurrentColor xor Color;
+ end;
+ OrPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
+ Color := CurrentColor or Color;
+ end;
+ AndPut:
+ begin
+ { getpixel wants local/relative coordinates }
+ Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
+ Color := CurrentColor and Color;
+ end;
+ NotPut:
+ Color := Not Color;
+ else
+ Color := CurrentColor;
+ end;
+ offset := Y * 80 + (X shr 3) + VideoOfs;
+ WritePortW($3ce, $f01);
+ WritePortW($3ce, Color shl 8);
+ WritePortW($3ce, 8 or $8000 shr (X and 7));
+ dummy := VidMem^[offset];
+ VidMem^[offset] := dummy;
+end;
+
+
+procedure HLine16(x, x2, y: SmallInt);
+var
+ xtmp: SmallInt;
+ ScrOfs, HLength: Word;
+ LMask, RMask: Byte;
+begin
+ { must we swap the values? }
+ if x > x2 then
+ begin
+ xtmp := x2;
+ x2 := x;
+ x:= xtmp;
+ end;
+ { First convert to global coordinates }
+ Inc(x, StartXViewPort);
+ Inc(x2, StartXViewPort);
+ Inc(y, StartYViewPort);
+ if ClipPixels and LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+
+ ScrOfs := y * ScrWidth + x div 8;
+ HLength := x2 div 8 - x div 8;
+ LMask := $ff shr (x and 7);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ RMask:=$ff shl (7 - (x2 and 7));
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ if HLength=0 then
+ LMask:=LMask and RMask;
+ WritePortB($3ce, 0);
+ if CurrentWriteMode <> NotPut Then
+ WritePortB($3cf, CurrentColor)
+ else
+ WritePortB($3cf, not CurrentColor);
+ WritePortW($3ce, $0f01);
+ WritePortB($3ce, 3);
+ case CurrentWriteMode of
+ XORPut:
+ WritePortB($3cf, 3 shl 3);
+ ANDPut:
+ WritePortB($3cf, 1 shl 3);
+ ORPut:
+ WritePortB($3cf, 2 shl 3);
+ NormalPut, NotPut:
+ WritePortB($3cf, 0)
+ else
+ WritePortB($3cf, 0)
+ end;
+
+ WritePortB($3ce, 8);
+ WritePortB($3cf, LMask);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ if HLength>0 then
+ begin
+ Dec(HLength);
+ Inc(ScrOfs);
+ if HLength>0 then
+ begin
+ WritePortW($3ce, $ff08);
+ bytemove(VidMem^[ScrOfs], VidMem^[ScrOfs], HLength);
+ Inc(ScrOfs, HLength);
+ end else
+ WritePortB($3ce, 8);
+ WritePortB($3cf, RMask);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ end;
+end;
+
+
+
+procedure VLine16(x,y,y2: SmallInt);
+var
+ ytmp: SmallInt;
+ ScrOfs,i: longint;
+ BitMask: byte;
+
+begin
+ { must we swap the values? }
+ if y > y2 then
+ begin
+ ytmp := y2;
+ y2 := y;
+ y:= ytmp;
+ end;
+ { First convert to global coordinates }
+ Inc(x, StartXViewPort);
+ Inc(y, StartYViewPort);
+ Inc(y2, StartYViewPort);
+ if ClipPixels and LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ ScrOfs:=y*ScrWidth+x div 8;
+ BitMask:=$80 shr (x and 7);
+ WritePortB($3ce, 0);
+ if CurrentWriteMode <> NotPut then
+ WritePortB($3cf, CurrentColor)
+ else
+ WritePortB($3cf, not CurrentColor);
+ WritePortW($3ce, $0f01);
+ WritePortB($3ce, 8);
+ WritePortB($3cf, BitMask);
+ WritePortB($3ce, 3);
+ case CurrentWriteMode of
+ XORPut:
+ WritePortB($3cf, 3 shl 3);
+ ANDPut:
+ WritePortB($3cf, 1 shl 3);
+ ORPut:
+ WritePortB($3cf, 2 shl 3);
+ NormalPut, NotPut:
+ WritePortB($3cf, 0)
+ else
+ WritePortB($3cf, 0)
+ end;
+ for i:=y to y2 do
+ begin
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+ VidMem^[ScrOfs]:=VidMem^[ScrOfs]+1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+ Inc(ScrOfs, ScrWidth);
+ end;
+end;
+
+{
+ $Log: graph16.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/initc.pp b/rtl/unix/initc.pp
new file mode 100644
index 0000000000..2632cf35d9
--- /dev/null
+++ b/rtl/unix/initc.pp
@@ -0,0 +1,93 @@
+{
+ $Id: initc.pp,v 1.12 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman,
+ members of the Free Pascal development team
+
+ This file links to libc, and handles the libc errno abstraction.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit initc;
+interface
+{$linklib c}
+
+type libcint = longint;
+ plibcint = ^libcint;
+
+function fpgetCerrno:libcint;
+procedure fpsetCerrno(err:libcint);
+
+{$ifdef HASGLOBALPROPERTY}
+property cerrno:libcint read fpgetCerrno write fpsetcerrno;
+{$endif HASGLOBALPROPERTY}
+
+const clib = 'c';
+
+implementation
+// hasn't been divided up in .inc's, because I first want to see hoe
+// this idea works out.
+
+{$ifdef OpenBSD}
+{$define UseOldErrnoDirectLink}
+{$endif}
+
+{$ifdef UseOldErrnoDirectLink}
+Var
+ interrno : libcint;external name {$ifdef OpenBSD} '_errno' {$else} 'h_errno'{$endif};
+
+function fpgetCerrno:libcint;
+
+begin
+ fpgetCerrno:=interrno;
+end;
+
+procedure fpsetCerrno(err:libcint);
+begin
+ interrno:=err;
+end;
+{$else}
+
+
+{$ifdef Linux}
+function geterrnolocation: Plibcint; cdecl;external clib name '__errno_location';
+{$else}
+{$ifdef FreeBSD} // tested on x86
+function geterrnolocation: Plibcint; cdecl;external clib name '__error';
+{$else}
+{$ifdef NetBSD} // from a sparc dump.
+function geterrnolocation: Plibcint; cdecl;external clib name '__errno';
+{$else}
+{$ifdef Darwin}
+function geterrnolocation: Plibcint; cdecl;external clib name '__error';
+{$endif}
+{$endif}
+{$endif}
+{$endif}
+
+function fpgetCerrno:libcint;
+
+begin
+ fpgetCerrno:=geterrnolocation^;
+end;
+
+procedure fpsetCerrno(err:libcint);
+begin
+ geterrnolocation^:=err;
+end;
+
+{$endif}
+
+end.
+{
+ $Log: initc.pp,v $
+ Revision 1.12 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/ipc.pp b/rtl/unix/ipc.pp
new file mode 100644
index 0000000000..e60b491d5a
--- /dev/null
+++ b/rtl/unix/ipc.pp
@@ -0,0 +1,423 @@
+{
+ $Id: ipc.pp,v 1.10 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team
+
+ This file implements IPC calls calls for Linu/FreeBSD
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Unit ipc;
+
+interface
+
+Uses BaseUnix;
+
+{ ----------------------------------------------------------------------
+ General IPC stuff
+ ----------------------------------------------------------------------}
+
+//Var
+// IPCError : longint;
+
+Type
+
+ {$IFDEF FreeBSD}
+ TKey = clong;
+ {$ELSE}
+ TKey = longint;
+ {$ENDIF}
+ key_t = TKey;
+
+
+Const
+ { IPC flags for get calls }
+
+{$ifdef FreeBSD} // BSD_VISIBLE
+ IPC_R = 4 shl 6;
+ IPC_W = 2 shl 6;
+ IPC_M = 2 shl 12;
+{$endif}
+
+ IPC_CREAT = 1 shl 9; { create if key is nonexistent }
+ IPC_EXCL = 2 shl 9; { fail if key exists }
+ IPC_NOWAIT = 4 shl 9; { return error on wait }
+
+ {$IFDEF FreeBSD}
+ IPC_PRIVATE : TKey = 0;
+ {$ENDIF}
+
+ { Actions for ctl calls }
+
+ IPC_RMID = 0; { remove resource }
+ IPC_SET = 1; { set ipc_perm options }
+ IPC_STAT = 2; { get ipc_perm options }
+ IPC_INFO = 3; { see ipcs }
+
+type
+ PIPC_Perm = ^TIPC_Perm;
+ {$ifdef FreeBSD}
+ TIPC_Perm = record
+ cuid : cushort; { creator user id }
+ cgid : cushort; { creator group id }
+ uid : cushort; { user id }
+ gid : cushort; { group id }
+ mode : cushort; { r/w permission }
+ seq : cushort; { sequence # (to generate unique msg/sem/shm id) }
+ key : key_t; { user specified msg/sem/shm key }
+ End;
+ {$else} // linux
+ TIPC_Perm = record
+ key : TKey;
+ uid,
+ gid,
+ cuid,
+ cgid,
+ mode,
+ seq : Word;
+ End;
+ {$endif}
+
+{ Function to generate a IPC key. }
+Function ftok (Path : pchar; ID : cint) : TKey;
+
+{ ----------------------------------------------------------------------
+ Sys V Shared memory stuff
+ ----------------------------------------------------------------------}
+
+Type
+ PShmid_DS = ^TShmid_ds;
+{$ifdef linux}
+ TShmid_ds = record
+ shm_perm : TIPC_Perm;
+ shm_segsz : longint;
+ shm_atime : longint;
+ shm_dtime : longint;
+ shm_ctime : longint;
+ shm_cpid : word;
+ shm_lpid : word;
+ shm_nattch : integer;
+ shm_npages : word;
+ shm_pages : Pointer;
+ attaches : pointer;
+ end;
+{$else} // FreeBSD checked
+ TShmid_ds = record
+ shm_perm : TIPC_Perm;
+ shm_segsz : cint;
+ shm_lpid : pid_t;
+ shm_cpid : pid_t;
+ shm_nattch : cshort;
+ shm_atime : time_t;
+ shm_dtime : time_t;
+ shm_ctime : time_t;
+ shm_internal : pointer;
+ end;
+{$endif}
+
+ const
+{$ifdef linux}
+ SHM_R = 4 shl 6;
+ SHM_W = 2 shl 6;
+{$else}
+ SHM_R = IPC_R;
+ SHM_W = IPC_W;
+{$endif}
+
+ SHM_RDONLY = 1 shl 12;
+ SHM_RND = 2 shl 12;
+{$ifdef Linux}
+ SHM_REMAP = 4 shl 12;
+{$endif}
+
+ SHM_LOCK = 11;
+ SHM_UNLOCK = 12;
+
+{$ifdef FreeBSD} // ipcs shmctl commands
+ SHM_STAT = 13;
+ SHM_INFO = 14;
+{$endif}
+
+type // the shm*info kind is "kernel" only.
+ PSHMinfo = ^TSHMinfo;
+ TSHMinfo = record // comment under FreeBSD: do we really need
+ // this?
+ shmmax : cint;
+ shmmin : cint;
+ shmmni : cint;
+ shmseg : cint;
+ shmall : cint;
+ end;
+
+{$ifdef FreeBSD}
+ PSHM_info = ^TSHM_info;
+ TSHM_info = record
+ used_ids : cint;
+ shm_tot,
+ shm_rss,
+ shm_swp,
+ swap_attempts,
+ swap_successes : culong;
+ end;
+{$endif}
+
+Function shmget(key: Tkey; size:cint; flag:cint):cint;
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+Function shmdt (shmaddr:pointer):cint;
+Function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+
+{ ----------------------------------------------------------------------
+ Message queue stuff
+ ----------------------------------------------------------------------}
+
+const
+ MSG_NOERROR = 1 shl 12;
+
+{$ifdef Linux}
+ MSG_EXCEPT = 2 shl 12;
+
+ MSGMNI = 128;
+ MSGMAX = 4056;
+ MSGMNB = 16384;
+{$endif}
+
+type
+ msglen_t = culong;
+ msgqnum_t= culong;
+
+ PMSG = ^TMSG;
+ TMSG = record
+{$ifndef FreeBSD} // opague in FreeBSD
+ msg_next : PMSG;
+ msg_type : Longint;
+ msg_spot : PChar;
+ msg_stime : Longint;
+ msg_ts : Integer;
+{$endif}
+ end;
+
+type
+
+{$ifdef Linux}
+ PMSQid_ds = ^TMSQid_ds;
+ TMSQid_ds = record
+ msg_perm : TIPC_perm;
+ msg_first : PMsg;
+ msg_last : PMsg;
+ msg_stime : Longint;
+ msg_rtime : Longint;
+ msg_ctime : Longint;
+ wwait : Pointer;
+ rwait : pointer;
+ msg_cbytes : word;
+ msg_qnum : word;
+ msg_qbytes : word;
+ msg_lspid : word;
+ msg_lrpid : word;
+ end;
+{$else}
+ PMSQid_ds = ^TMSQid_ds;
+ TMSQid_ds = record
+ msg_perm : TIPC_perm;
+ msg_first : PMsg;
+ msg_last : PMsg;
+ msg_cbytes : msglen_t;
+ msg_qnum : msgqnum_t;
+ msg_qbytes : msglen_t;
+ msg_lspid : pid_t;
+ msg_lrpid : pid_t;
+ msg_stime : time_t;
+ msg_pad1 : clong;
+ msg_rtime : time_t;
+ msg_pad2 : clong;
+ msg_ctime : time_t;
+ msg_pad3 : clong;
+ msg_pad4 : array [0..3] of clong;
+ end;
+{$endif}
+
+ PMSGbuf = ^TMSGbuf;
+ TMSGbuf = record // called mymsg on freebsd and SVID manual
+ mtype : longint;
+ mtext : array[0..0] of char;
+ end;
+
+{$ifdef linux}
+ PMSGinfo = ^TMSGinfo;
+ TMSGinfo = record
+ msgpool : Longint;
+ msgmap : Longint;
+ msgmax : Longint;
+ msgmnb : Longint;
+ msgmni : Longint;
+ msgssz : Longint;
+ msgtql : Longint;
+ msgseg : Word;
+ end;
+{$else}
+ PMSGinfo = ^TMSGinfo;
+ TMSGinfo = record
+ msgmax,
+ msgmni,
+ msgmnb,
+ msgtql,
+ msgssz,
+ msgseg : cint;
+ end;
+{$endif}
+
+Function msgget(key: TKey; msgflg:cint):cint;
+Function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint): cint;
+Function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+
+{ ----------------------------------------------------------------------
+ Semaphores stuff
+ ----------------------------------------------------------------------}
+
+const
+{$ifdef Linux} // renamed to many name clashes
+ SEM_UNDO = $1000;
+ SEM_GETPID = 11;
+ SEM_GETVAL = 12;
+ SEM_GETALL = 13;
+ SEM_GETNCNT = 14;
+ SEM_GETZCNT = 15;
+ SEM_SETVAL = 16;
+ SEM_SETALL = 17;
+
+ SEM_SEMMNI = 128;
+ SEM_SEMMSL = 32;
+ SEM_SEMMNS = (SEM_SEMMNI * SEM_SEMMSL);
+ SEM_SEMOPM = 32;
+ SEM_SEMVMX = 32767;
+{$else}
+ SEM_UNDO = 1 shl 12;
+ MAX_SOPS = 5;
+
+ SEM_GETNCNT = 3; { Return the value of sempid {READ} }
+ SEM_GETPID = 4; { Return the value of semval {READ} }
+ SEM_GETVAL = 5; { Return semvals into arg.array {READ} }
+ SEM_GETALL = 6; { Return the value of semzcnt {READ} }
+ SEM_GETZCNT = 7; { Set the value of semval to arg.val {ALTER} }
+ SEM_SETVAL = 8; { Set semvals from arg.array {ALTER} }
+ SEM_SETALL = 9;
+
+ { Permissions }
+
+ SEM_A = 2 shl 6; { alter permission }
+ SEM_R = 4 shl 6; { read permission }
+{$endif}
+
+type
+{$ifdef Linux}
+ PSEMid_ds = ^TSEMid_ds;
+ TSEMid_ds = record
+ sem_perm : tipc_perm;
+ sem_otime : longint;
+ sem_ctime : longint;
+ sem_base : pointer;
+ sem_pending : pointer;
+ sem_pending_last : pointer;
+ undo : pointer;
+ sem_nsems : word;
+ end;
+{$else}
+
+ sem=record end; // opague
+
+ PSEMid_ds = ^TSEMid_ds;
+ TSEMid_ds = record
+ sem_perm : tipc_perm;
+ sem_base : ^sem;
+ sem_nsems : cushort;
+ sem_otime : time_t;
+ sem_pad1 : cint;
+ sem_ctime : time_t;
+ sem_pad2 : cint;
+ sem_pad3 : array[0..3] of cint;
+ end;
+{$endif}
+
+ PSEMbuf = ^TSEMbuf;
+ TSEMbuf = record
+ sem_num : cushort;
+ sem_op : cshort;
+ sem_flg : cshort;
+ end;
+
+
+ PSEMinfo = ^TSEMinfo;
+ TSEMinfo = record
+ semmap : cint;
+ semmni : cint;
+ semmns : cint;
+ semmnu : cint;
+ semmsl : cint;
+ semopm : cint;
+ semume : cint;
+ semusz : cint;
+ semvmx : cint;
+ semaem : cint;
+ end;
+
+{ internal mode bits}
+
+{$ifdef FreeBSD}
+Const
+ SEM_ALLOC = 1 shl 9;
+ SEM_DEST = 2 shl 9;
+{$endif}
+
+Type
+ PSEMun = ^TSEMun;
+ TSEMun = record
+ case cint of
+ 0 : ( val : cint );
+ 1 : ( buf : PSEMid_ds );
+ 2 : ( arr : PWord ); // ^ushort
+{$ifdef linux}
+ 3 : ( padbuf : PSeminfo );
+ 4 : ( padpad : pointer );
+{$endif}
+ end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+Function semop(semid:cint; sops: psembuf; nsops: cuint): cint;
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): longint;
+
+implementation
+
+uses Syscall;
+
+{$ifdef FPC_USE_LIBC}
+ {$i ipccdecl.inc}
+{$else}
+ {$ifdef Linux}
+ {$ifdef cpux86_64}
+ {$i ipcsys.inc}
+ {$else}
+ {$i ipccall.inc}
+ {$endif}
+ {$endif}
+ {$ifdef BSD}
+ {$i ipcbsd.inc}
+ {$endif}
+{$endif}
+
+
+end.
+
+{
+ $Log: ipc.pp,v $
+ Revision 1.10 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/ipccdecl.inc b/rtl/unix/ipccdecl.inc
new file mode 100644
index 0000000000..1bc83a4000
--- /dev/null
+++ b/rtl/unix/ipccdecl.inc
@@ -0,0 +1,103 @@
+{
+ $Id: ipccdecl.inc,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Marco van de Voort
+ member of the Free Pascal development team
+
+ CDecl calls for ipc unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+function cshmget(key:key_t;size:cint;shmflg:cint):cint; cdecl; external;
+Function cshmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer; cdecl;external;
+Function cshmdt (shmaddr:pointer):cint; cdecl; external;
+Function cshmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint; cdecl; external;
+Function csemget(key:Tkey; nsems:cint; semflg:cint): cint; cdecl; external;
+Function csemop(semid:cint; sops: psembuf; nsops: cuint): cint; cdecl; external;
+Function csemctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint; cdecl; external;
+Function cmsgget(key: TKey; msgflg:cint):cint; cdecl; external;
+Function cmsgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint): cint; cdecl; external;
+Function cmsgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint; cdecl; external;
+Function cmsgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint; cdecl; external;
+
+function cftok(path:Pchar; id:cint):key_t; cdecl; external;
+
+function ftok(path:Pchar; id:cint):key_t;
+
+var st:stat;
+
+begin
+ ftok:=cftok(path,id);
+end;
+
+function shmget(key:key_t;size:cint;flag:cint):cint;
+begin
+ shmget:=cshmget(key, size, flag);
+end;
+
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+begin
+ shmat:=cshmat(shmid, shmaddr, shmflg);
+end;
+
+Function shmdt (shmaddr:pointer):cint;
+
+begin
+ shmdt:=cshmdt(shmaddr);
+end;
+
+Function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+
+begin
+ shmctl:= cshmctl(shmid, cmd, buf);
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+ semget:=csemget(key, nsems, semflg);
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops: cuint): cint;
+begin
+ semop:=csemop(semid, sops, nsops);
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): longint;
+begin
+ semctl:=csemctl(semid, semnum, cmd, arg);
+end;
+
+Function msgget(key: TKey; msgflg:cint):cint;
+begin
+ msgget:=cmsgget(key, msgflg);
+end;
+
+Function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint): cint;
+begin
+ msgsnd:=cmsgsnd(msqid, msgp, msgsz, msgflg);
+end;
+
+Function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+begin
+ msgrcv:=cmsgrcv(msqid, msgp, msgsz, msgtyp, msgflg);
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+ msgctl:=cmsgctl( msqid, cmd, buf);
+end;
+
+{
+ $Log: ipccdecl.inc,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/keyboard.pp b/rtl/unix/keyboard.pp
new file mode 100644
index 0000000000..ddd980d2cc
--- /dev/null
+++ b/rtl/unix/keyboard.pp
@@ -0,0 +1,1542 @@
+{
+ $Id: keyboard.pp,v 1.22 2005/03/25 23:01:50 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Keyboard unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Keyboard;
+interface
+
+{$i keybrdh.inc}
+
+Const
+ AltPrefix : byte = 0;
+ ShiftPrefix : byte = 0;
+ CtrlPrefix : byte = 0;
+
+Function RawReadKey:char;
+Function RawReadString : String;
+Function KeyPressed : Boolean;
+{$ifndef NotUseTree}
+Procedure AddSequence(Const St : String; AChar,AScan :byte);
+Function FindSequence(Const St : String;var AChar, Ascan : byte) : boolean;
+{$endif NotUseTree}
+procedure RestoreStartMode;
+
+
+implementation
+
+uses
+ Mouse,
+{$ifndef NotUseTree}
+ Strings,
+ TermInfo,
+{$endif NotUseTree}
+ termio,baseUnix;
+
+{$i keyboard.inc}
+
+var
+ OldIO,StartTio : TermIos;
+{$ifdef logging}
+ f : text;
+{$endif logging}
+{$i keyscan.inc}
+
+{$ifdef Unused}
+type
+ TKeyState = Record
+ Normal, Shift, Ctrl, Alt : word;
+ end;
+
+Const
+ KeyStates : Array[0..255] of TKeyState
+ (
+
+ );
+
+{$endif Unused}
+
+Procedure SetRawMode(b:boolean);
+Var
+ Tio : Termios;
+Begin
+ TCGetAttr(1,Tio);
+ if b then
+ begin
+ OldIO:=Tio;
+ CFMakeRaw(Tio);
+ end
+ else
+ Tio := OldIO;
+ TCSetAttr(1,TCSANOW,Tio);
+End;
+
+type
+ chgentry=packed record
+ tab,
+ idx,
+ oldtab,
+ oldidx : byte;
+ oldval,
+ newval : word;
+ end;
+ kbentry=packed record
+ kb_table,
+ kb_index : byte;
+ kb_value : word;
+ end;
+
+const
+ kbdchanges=10;
+ kbdchange:array[1..kbdchanges] of chgentry=(
+ (tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
+ (tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
+ (tab:8; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0),
+ (tab:8; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0),
+ (tab:8; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0),
+ (tab:8; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0),
+ (tab:8; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0),
+ (tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
+ (tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
+ (tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0)
+ );
+ KDGKBENT=$4B46;
+ KDSKBENT=$4B47;
+ KDGKBMETA=$4B62;
+ KDSKBMETA=$4B63;
+ K_ESCPREFIX=$4;
+ K_METABIT=$3;
+
+const
+ oldmeta : longint = 0;
+ meta : longint = 0;
+
+procedure PatchKeyboard;
+var
+ e : ^chgentry;
+ entry : kbentry;
+ i : longint;
+begin
+ fpIoctl(stdinputhandle,KDGKBMETA,@oldmeta);
+ meta:=K_ESCPREFIX;
+ fpIoctl(stdinputhandle,KDSKBMETA,@meta);
+ for i:=1 to kbdchanges do
+ begin
+ e:=@kbdchange[i];
+ entry.kb_table:=e^.tab;
+ entry.kb_index:=e^.idx;
+ fpIoctl(stdinputhandle,KDGKBENT,@entry);
+ e^.oldval:=entry.kb_value;
+ entry.kb_table:=e^.oldtab;
+ entry.kb_index:=e^.oldidx;
+ fpioctl(stdinputhandle,KDGKBENT,@entry);
+ e^.newval:=entry.kb_value;
+ end;
+ for i:=1 to kbdchanges do
+ begin
+ e:=@kbdchange[i];
+ entry.kb_table:=e^.tab;
+ entry.kb_index:=e^.idx;
+ entry.kb_value:=e^.newval;
+ fpioctl(stdinputhandle,KDSKBENT,@entry);
+ end;
+end;
+
+
+procedure UnpatchKeyboard;
+var
+ e : ^chgentry;
+ entry : kbentry;
+ i : longint;
+begin
+ if oldmeta in [K_ESCPREFIX,K_METABIT] then
+ fpioctl(stdinputhandle,KDSKBMETA,@oldmeta);
+ for i:=1 to kbdchanges do
+ begin
+ e:=@kbdchange[i];
+ entry.kb_table:=e^.tab;
+ entry.kb_index:=e^.idx;
+ entry.kb_value:=e^.oldval;
+ fpioctl(stdinputhandle,KDSKBENT,@entry);
+ end;
+end;
+
+
+
+{ Buffered Input routines }
+const
+ InSize=256;
+var
+ InBuf : array [0..InSize-1] of char;
+ InCnt,
+ InHead,
+ InTail : longint;
+
+function ttyRecvChar:char;
+var
+ Readed,i : longint;
+begin
+{Buffer Empty? Yes, Input from StdIn}
+ if (InHead=InTail) then
+ begin
+ {Calc Amount of Chars to Read}
+ i:=InSize-InHead;
+ if InTail>InHead then
+ i:=InTail-InHead;
+ {Read}
+ Readed:=fpRead(StdInputHandle,InBuf[InHead],i);
+ {Increase Counters}
+ inc(InCnt,Readed);
+ inc(InHead,Readed);
+ {Wrap if End has Reached}
+ if InHead>=InSize then
+ InHead:=0;
+ end;
+{Check Buffer}
+ if (InCnt=0) then
+ ttyRecvChar:=#0
+ else
+ begin
+ ttyRecvChar:=InBuf[InTail];
+ dec(InCnt);
+ inc(InTail);
+ if InTail>=InSize then
+ InTail:=0;
+ end;
+end;
+
+
+Const
+ KeyBufferSize = 20;
+var
+ KeyBuffer : Array[0..KeyBufferSize-1] of Char;
+ KeyPut,
+ KeySend : longint;
+
+Procedure PushKey(Ch:char);
+Var
+ Tmp : Longint;
+Begin
+ Tmp:=KeyPut;
+ Inc(KeyPut);
+ If KeyPut>=KeyBufferSize Then
+ KeyPut:=0;
+ If KeyPut<>KeySend Then
+ KeyBuffer[Tmp]:=Ch
+ Else
+ KeyPut:=Tmp;
+End;
+
+
+Function PopKey:char;
+Begin
+ If KeyPut<>KeySend Then
+ Begin
+ PopKey:=KeyBuffer[KeySend];
+ Inc(KeySend);
+ If KeySend>=KeyBufferSize Then
+ KeySend:=0;
+ End
+ Else
+ PopKey:=#0;
+End;
+
+
+Procedure PushExt(b:byte);
+begin
+ PushKey(#0);
+ PushKey(chr(b));
+end;
+
+
+const
+ AltKeyStr : string[38]='qwertyuiopasdfghjklzxcvbnm1234567890-=';
+ AltCodeStr : string[38]=#016#017#018#019#020#021#022#023#024#025#030#031#032#033#034#035#036#037#038+
+ #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131;
+Function FAltKey(ch:char):byte;
+var
+ Idx : longint;
+Begin
+ Idx:=Pos(ch,AltKeyStr);
+ if Idx>0 then
+ FAltKey:=byte(AltCodeStr[Idx])
+ else
+ FAltKey:=0;
+End;
+
+
+{ This one doesn't care about keypresses already processed by readkey }
+{ and waiting in the KeyBuffer, only about waiting keypresses at the }
+{ TTYLevel (including ones that are waiting in the TTYRecvChar buffer) }
+function sysKeyPressed: boolean;
+var
+ fdsin : tfdSet;
+begin
+ if (InCnt>0) then
+ sysKeyPressed:=true
+ else
+ begin
+ fpFD_ZERO(fdsin);
+ fpFD_SET(StdInputHandle,fdsin);
+ sysKeypressed:=(fpSelect(StdInputHandle+1,@fdsin,nil,nil,0)>0);
+ end;
+end;
+
+Function KeyPressed:Boolean;
+Begin
+ Keypressed := (KeySend<>KeyPut) or sysKeyPressed;
+End;
+
+
+Function IsConsole : Boolean;
+var
+ ThisTTY: String[30];
+begin
+ IsConsole:=false;
+ { check for tty }
+ if (IsATTY(stdinputhandle)<>-1) then
+ begin
+ { running on a tty, find out whether locally or remotely }
+ ThisTTY:=TTYName(stdinputhandle);
+ if (Copy(ThisTTY, 1, 8) = '/dev/tty') and
+ (ThisTTY[9] >= '0') and (ThisTTY[9] <= '9') then
+ IsConsole:=true;
+ end;
+end;
+
+Const
+ LastMouseEvent : TMouseEvent =
+ (
+ Buttons : 0;
+ X : 0;
+ Y : 0;
+ Action : 0;
+ );
+
+{$ifndef NotUseTree}
+
+ procedure GenMouseEvent;
+ var MouseEvent: TMouseEvent;
+ ch : char;
+ fdsin : tfdSet;
+ begin
+ fpFD_ZERO(fdsin);
+ fpFD_SET(StdInputHandle,fdsin);
+ Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ ch:=ttyRecvChar;
+ { Other bits are used for Shift, Meta and Ctrl modifiers PM }
+ case (ord(ch)-ord(' ')) and 3 of
+ 0 : {left button press}
+ MouseEvent.buttons:=1;
+ 1 : {middle button pressed }
+ MouseEvent.buttons:=2;
+ 2 : { right button pressed }
+ MouseEvent.buttons:=4;
+ 3 : { no button pressed };
+ end;
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ ch:=ttyRecvChar;
+ MouseEvent.x:=Ord(ch)-ord(' ')-1;
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ ch:=ttyRecvChar;
+ MouseEvent.y:=Ord(ch)-ord(' ')-1;
+ if (MouseEvent.buttons<>0) then
+ MouseEvent.action:=MouseActionDown
+ else
+ begin
+ if (LastMouseEvent.Buttons<>0) and
+ ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
+ begin
+ MouseEvent.Action:=MouseActionMove;
+ MouseEvent.Buttons:=LastMouseEvent.Buttons;
+{$ifdef DebugMouse}
+ Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')');
+{$endif DebugMouse}
+ PutMouseEvent(MouseEvent);
+ MouseEvent.Buttons:=0;
+ end;
+ MouseEvent.Action:=MouseActionUp;
+ end;
+ PutMouseEvent(MouseEvent);
+{$ifdef DebugMouse}
+ if MouseEvent.Action=MouseActionDown then
+ Write(system.stderr,'Button down : ')
+ else
+ Write(system.stderr,'Button up : ');
+ Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')');
+{$endif DebugMouse}
+ LastMouseEvent:=MouseEvent;
+ end;
+
+type
+ TProcedure = procedure;
+
+ PTreeElement = ^TTreeElement;
+ TTreeElement = record
+ Next,Parent,Child : PTreeElement;
+ CanBeTerminal : boolean;
+ char : byte;
+ ScanValue : byte;
+ CharValue : byte;
+ SpecialHandler : TProcedure;
+ end;
+
+var
+ RootTree : Array[0..255] of PTreeElement;
+
+procedure FreeElement (PT:PTreeElement);
+var next : PTreeElement;
+begin
+ while PT <> nil do
+ begin
+ FreeElement(PT^.Child);
+ next := PT^.Next;
+ dispose(PT);
+ PT := next;
+ end;
+end;
+
+procedure FreeTree;
+var i : integer;
+begin
+ for i := low(RootTree) to high(RootTree) do
+ begin
+ FreeElement(RootTree[i]);
+ RootTree[i] := nil;
+ end;
+end;
+
+function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement;
+var PT : PTreeElement;
+begin
+ New(PT);
+ FillChar(PT^,SizeOf(TTreeElement),#0);
+ PT^.char:=ch;
+ PT^.Parent:=Pa;
+ if Assigned(Pa) and (Pa^.Child=nil) then
+ Pa^.Child:=PT;
+ NewPTree:=PT;
+end;
+
+function DoAddSequence(Const St : String; AChar,AScan :byte) : PTreeElement;
+var
+ CurPTree,NPT : PTreeElement;
+ c : byte;
+ i : longint;
+begin
+ if St='' then
+ begin
+ DoAddSequence:=nil;
+ exit;
+ end;
+ CurPTree:=RootTree[ord(st[1])];
+ if CurPTree=nil then
+ begin
+ CurPTree:=NewPTree(ord(st[1]),nil);
+ RootTree[ord(st[1])]:=CurPTree;
+ end;
+ for i:=2 to Length(St) do
+ begin
+ NPT:=CurPTree^.Child;
+ c:=ord(St[i]);
+ if NPT=nil then
+ NPT:=NewPTree(c,CurPTree);
+ CurPTree:=nil;
+ while assigned(NPT) and (NPT^.char<c) do
+ begin
+ CurPTree:=NPT;
+ NPT:=NPT^.Next;
+ end;
+
+ if assigned(NPT) and (NPT^.char=c) then
+ CurPTree:=NPT
+ else
+ begin
+ if CurPTree=nil then
+ begin
+ NPT^.Parent^.child:=NewPTree(c,NPT^.Parent);
+ CurPTree:=NPT^.Parent^.Child;
+ CurPTree^.Next:=NPT;
+ end
+ else
+ begin
+ CurPTree^.Next:=NewPTree(c,CurPTree^.Parent);
+ CurPTree:=CurPTree^.Next;
+ CurPTree^.Next:=NPT;
+ end;
+ end;
+ end;
+ if CurPTree^.CanBeTerminal then
+ begin
+ { here we have a conflict !! }
+ { maybe we should claim }
+ with CurPTree^ do
+ begin
+{$ifdef DEBUG}
+ if (ScanValue<>AScan) or (CharValue<>AChar) then
+ Writeln(system.stderr,'key "',st,'" changed value');
+ if (ScanValue<>AScan) then
+ Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan);
+ if (CharValue<>AChar) then
+ Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar));
+{$endif DEBUG}
+ ScanValue:=AScan;
+ CharValue:=AChar;
+ end;
+ end
+ else with CurPTree^ do
+ begin
+ CanBeTerminal:=True;
+ ScanValue:=AScan;
+ CharValue:=AChar;
+ end;
+ DoAddSequence:=CurPTree;
+end;
+
+
+procedure AddSequence(Const St : String; AChar,AScan :byte);
+begin
+ DoAddSequence(St,AChar,AScan);
+end;
+
+{ Returns the Child that as c as char if it exists }
+Function FindChild(c : byte;Root : PTreeElement) : PTreeElement;
+var
+ NPT : PTreeElement;
+begin
+ if not assigned(Root) then
+ begin
+ FindChild:=nil;
+ exit;
+ end;
+ NPT:=Root^.Child;
+ while assigned(NPT) and (NPT^.char<c) do
+ NPT:=NPT^.Next;
+ if assigned(NPT) and (NPT^.char=c) then
+ FindChild:=NPT
+ else
+ FindChild:=nil;
+end;
+
+Function AddSpecialSequence(Const St : string;Proc : TProcedure) : PTreeElement;
+var
+ NPT : PTreeElement;
+begin
+ NPT:=DoAddSequence(St,0,0);
+ NPT^.SpecialHandler:=Proc;
+ AddSpecialSequence:=NPT;
+end;
+
+function FindSequence(Const St : String;var AChar,AScan :byte) : boolean;
+var
+ NPT : PTreeElement;
+ I : longint;
+begin
+ FindSequence:=false;
+ AChar:=0;
+ AScan:=0;
+ if St='' then
+ exit;
+ NPT:=RootTree[ord(St[1])];
+ if not assigned(NPT) then
+ exit;
+ for i:=2 to Length(St) do
+ begin
+ NPT:=FindChild(ord(St[i]),NPT);
+ if not assigned(NPT) then
+ exit;
+ end;
+ if not NPT^.CanBeTerminal then
+ exit
+ else
+ begin
+ FindSequence:=true;
+ AScan:=NPT^.ScanValue;
+ AChar:=NPT^.CharValue;
+ end;
+end;
+
+Procedure LoadDefaultSequences;
+begin
+ AddSpecialSequence(#27'[M',@GenMouseEvent);
+ { linux default values, the next setting is
+ compatible with xterms from XFree 4.x }
+ DoAddSequence(#127,8,0);
+ { all Esc letter }
+ DoAddSequence(#27'A',0,kbAltA);
+ DoAddSequence(#27'a',0,kbAltA);
+ DoAddSequence(#27'B',0,kbAltB);
+ DoAddSequence(#27'b',0,kbAltB);
+ DoAddSequence(#27'C',0,kbAltC);
+ DoAddSequence(#27'c',0,kbAltC);
+ DoAddSequence(#27'D',0,kbAltD);
+ DoAddSequence(#27'd',0,kbAltD);
+ DoAddSequence(#27'E',0,kbAltE);
+ DoAddSequence(#27'e',0,kbAltE);
+ DoAddSequence(#27'F',0,kbAltF);
+ DoAddSequence(#27'f',0,kbAltF);
+ DoAddSequence(#27'G',0,kbAltG);
+ DoAddSequence(#27'g',0,kbAltG);
+ DoAddSequence(#27'H',0,kbAltH);
+ DoAddSequence(#27'h',0,kbAltH);
+ DoAddSequence(#27'I',0,kbAltI);
+ DoAddSequence(#27'i',0,kbAltI);
+ DoAddSequence(#27'J',0,kbAltJ);
+ DoAddSequence(#27'j',0,kbAltJ);
+ DoAddSequence(#27'K',0,kbAltK);
+ DoAddSequence(#27'k',0,kbAltK);
+ DoAddSequence(#27'L',0,kbAltL);
+ DoAddSequence(#27'l',0,kbAltL);
+ DoAddSequence(#27'M',0,kbAltM);
+ DoAddSequence(#27'm',0,kbAltM);
+ DoAddSequence(#27'N',0,kbAltN);
+ DoAddSequence(#27'n',0,kbAltN);
+ DoAddSequence(#27'O',0,kbAltO);
+ DoAddSequence(#27'o',0,kbAltO);
+ DoAddSequence(#27'P',0,kbAltP);
+ DoAddSequence(#27'p',0,kbAltP);
+ DoAddSequence(#27'Q',0,kbAltQ);
+ DoAddSequence(#27'q',0,kbAltQ);
+ DoAddSequence(#27'R',0,kbAltR);
+ DoAddSequence(#27'r',0,kbAltR);
+ DoAddSequence(#27'S',0,kbAltS);
+ DoAddSequence(#27's',0,kbAltS);
+ DoAddSequence(#27'T',0,kbAltT);
+ DoAddSequence(#27't',0,kbAltT);
+ DoAddSequence(#27'U',0,kbAltU);
+ DoAddSequence(#27'u',0,kbAltU);
+ DoAddSequence(#27'V',0,kbAltV);
+ DoAddSequence(#27'v',0,kbAltV);
+ DoAddSequence(#27'W',0,kbAltW);
+ DoAddSequence(#27'w',0,kbAltW);
+ DoAddSequence(#27'X',0,kbAltX);
+ DoAddSequence(#27'x',0,kbAltX);
+ DoAddSequence(#27'Y',0,kbAltY);
+ DoAddSequence(#27'y',0,kbAltY);
+ DoAddSequence(#27'Z',0,kbAltZ);
+ DoAddSequence(#27'z',0,kbAltZ);
+ DoAddSequence(#27'-',0,kbAltMinus);
+ DoAddSequence(#27'=',0,kbAltEqual);
+ DoAddSequence(#27'0',0,kbAlt0);
+ DoAddSequence(#27'1',0,kbAlt1);
+ DoAddSequence(#27'2',0,kbAlt2);
+ DoAddSequence(#27'3',0,kbAlt3);
+ DoAddSequence(#27'4',0,kbAlt4);
+ DoAddSequence(#27'5',0,kbAlt5);
+ DoAddSequence(#27'6',0,kbAlt6);
+ DoAddSequence(#27'7',0,kbAlt7);
+ DoAddSequence(#27'8',0,kbAlt8);
+ DoAddSequence(#27'9',0,kbAlt9);
+ { vt100 default values }
+ DoAddSequence(#27'[[A',0,kbF1);
+ DoAddSequence(#27'[[B',0,kbF2);
+ DoAddSequence(#27'[[C',0,kbF3);
+ DoAddSequence(#27'[[D',0,kbF4);
+ DoAddSequence(#27'[[E',0,kbF5);
+ DoAddSequence(#27'[17~',0,kbF6);
+ DoAddSequence(#27'[18~',0,kbF7);
+ DoAddSequence(#27'[19~',0,kbF8);
+ DoAddSequence(#27'[20~',0,kbF9);
+ DoAddSequence(#27'[21~',0,kbF10);
+ DoAddSequence(#27'[23~',0,kbF11);
+ DoAddSequence(#27'[24~',0,kbF12);
+ DoAddSequence(#27'[25~',0,kbShiftF3);
+ DoAddSequence(#27'[26~',0,kbShiftF4);
+ DoAddSequence(#27'[28~',0,kbShiftF5);
+ DoAddSequence(#27'[29~',0,kbShiftF6);
+ DoAddSequence(#27'[31~',0,kbShiftF7);
+ DoAddSequence(#27'[32~',0,kbShiftF8);
+ DoAddSequence(#27'[33~',0,kbShiftF9);
+ DoAddSequence(#27'[34~',0,kbShiftF10);
+ DoAddSequence(#27#27'[[A',0,kbAltF1);
+ DoAddSequence(#27#27'[[B',0,kbAltF2);
+ DoAddSequence(#27#27'[[C',0,kbAltF3);
+ DoAddSequence(#27#27'[[D',0,kbAltF4);
+ DoAddSequence(#27#27'[[E',0,kbAltF5);
+ DoAddSequence(#27#27'[17~',0,kbAltF6);
+ DoAddSequence(#27#27'[18~',0,kbAltF7);
+ DoAddSequence(#27#27'[19~',0,kbAltF8);
+ DoAddSequence(#27#27'[20~',0,kbAltF9);
+ DoAddSequence(#27#27'[21~',0,kbAltF10);
+ DoAddSequence(#27#27'[23~',0,kbAltF11);
+ DoAddSequence(#27#27'[24~',0,kbAltF12);
+ DoAddSequence(#27'[A',0,kbUp);
+ DoAddSequence(#27'[B',0,kbDown);
+ DoAddSequence(#27'[C',0,kbRight);
+ DoAddSequence(#27'[D',0,kbLeft);
+ DoAddSequence(#27'[F',0,kbEnd);
+ DoAddSequence(#27'[H',0,kbHome);
+ DoAddSequence(#27'[Z',0,kbShiftTab);
+ DoAddSequence(#27'[5~',0,kbPgUp);
+ DoAddSequence(#27'[6~',0,kbPgDn);
+ DoAddSequence(#27'[4~',0,kbEnd);
+ DoAddSequence(#27'[1~',0,kbHome);
+ DoAddSequence(#27'[2~',0,kbIns);
+ DoAddSequence(#27'[3~',0,kbDel);
+ DoAddSequence(#27#27'[A',0,kbAltUp);
+ DoAddSequence(#27#27'[B',0,kbAltDown);
+ DoAddSequence(#27#27'[D',0,kbAltLeft);
+ DoAddSequence(#27#27'[C',0,kbAltRight);
+ DoAddSequence(#27#27'[5~',0,kbAltPgUp);
+ DoAddSequence(#27#27'[6~',0,kbAltPgDn);
+ DoAddSequence(#27#27'[4~',0,kbAltEnd);
+ DoAddSequence(#27#27'[1~',0,kbAltHome);
+ DoAddSequence(#27#27'[2~',0,kbAltIns);
+ DoAddSequence(#27#27'[3~',0,kbAltDel);
+ DoAddSequence(#27'OP',0,kbF1);
+ DoAddSequence(#27'OQ',0,kbF2);
+ DoAddSequence(#27'OR',0,kbF3);
+ DoAddSequence(#27'OS',0,kbF4);
+ DoAddSequence(#27'Ot',0,kbF5);
+ DoAddSequence(#27'Ou',0,kbF6);
+ DoAddSequence(#27'Ov',0,kbF7);
+ DoAddSequence(#27'Ol',0,kbF8);
+ DoAddSequence(#27'Ow',0,kbF9);
+ DoAddSequence(#27'Ox',0,kbF10);
+ DoAddSequence(#27'Oy',0,kbF11);
+ DoAddSequence(#27'Oz',0,kbF12);
+ DoAddSequence(#27#27'OP',0,kbAltF1);
+ DoAddSequence(#27#27'OQ',0,kbAltF2);
+ DoAddSequence(#27#27'OR',0,kbAltF3);
+ DoAddSequence(#27#27'OS',0,kbAltF4);
+ DoAddSequence(#27#27'Ot',0,kbAltF5);
+ DoAddSequence(#27#27'Ou',0,kbAltF6);
+ DoAddSequence(#27#27'Ov',0,kbAltF7);
+ DoAddSequence(#27#27'Ol',0,kbAltF8);
+ DoAddSequence(#27#27'Ow',0,kbAltF9);
+ DoAddSequence(#27#27'Ox',0,kbAltF10);
+ DoAddSequence(#27#27'Oy',0,kbAltF11);
+ DoAddSequence(#27#27'Oz',0,kbAltF12);
+ DoAddSequence(#27'OA',0,kbUp);
+ DoAddSequence(#27'OB',0,kbDown);
+ DoAddSequence(#27'OC',0,kbRight);
+ DoAddSequence(#27'OD',0,kbLeft);
+ DoAddSequence(#27#27'OA',0,kbAltUp);
+ DoAddSequence(#27#27'OB',0,kbAltDown);
+ DoAddSequence(#27#27'OC',0,kbAltRight);
+ DoAddSequence(#27#27'OD',0,kbAltLeft);
+ { xterm default values }
+ { xterm alternate default values }
+ { ignored sequences }
+ DoAddSequence(#27'[?1;0c',0,0);
+ DoAddSequence(#27'[?1l',0,0);
+ DoAddSequence(#27'[?1h',0,0);
+ DoAddSequence(#27'[?1;2c',0,0);
+ DoAddSequence(#27'[?7l',0,0);
+ DoAddSequence(#27'[?7h',0,0);
+end;
+
+function EnterEscapeSeqNdx(Ndx: Word;Char,Scan : byte) : PTreeElement;
+var
+ P,pdelay: PChar;
+ St : string;
+begin
+ EnterEscapeSeqNdx:=nil;
+ P:=cur_term_Strings^[Ndx];
+ if assigned(p) then
+ begin { Do not record the delays }
+ pdelay:=strpos(p,'$<');
+ if assigned(pdelay) then
+ pdelay^:=#0;
+ St:=StrPas(p);
+ EnterEscapeSeqNdx:=DoAddSequence(St,Char,Scan);
+ if assigned(pdelay) then
+ pdelay^:='$';
+ end;
+end;
+
+
+Procedure LoadTermInfoSequences;
+var
+ err : longint;
+begin
+ if not assigned(cur_term) then
+ setupterm(nil, stdoutputhandle, err);
+ if not assigned(cur_term_Strings) then
+ exit;
+ EnterEscapeSeqNdx(key_f1,0,kbF1);
+ EnterEscapeSeqNdx(key_f2,0,kbF2);
+ EnterEscapeSeqNdx(key_f3,0,kbF3);
+ EnterEscapeSeqNdx(key_f4,0,kbF4);
+ EnterEscapeSeqNdx(key_f5,0,kbF5);
+ EnterEscapeSeqNdx(key_f6,0,kbF6);
+ EnterEscapeSeqNdx(key_f7,0,kbF7);
+ EnterEscapeSeqNdx(key_f8,0,kbF8);
+ EnterEscapeSeqNdx(key_f9,0,kbF9);
+ EnterEscapeSeqNdx(key_f10,0,kbF10);
+ EnterEscapeSeqNdx(key_f11,0,kbF11);
+ EnterEscapeSeqNdx(key_f12,0,kbF12);
+ EnterEscapeSeqNdx(key_up,0,kbUp);
+ EnterEscapeSeqNdx(key_down,0,kbDown);
+ EnterEscapeSeqNdx(key_left,0,kbLeft);
+ EnterEscapeSeqNdx(key_right,0,kbRight);
+ EnterEscapeSeqNdx(key_ppage,0,kbPgUp);
+ EnterEscapeSeqNdx(key_npage,0,kbPgDn);
+ EnterEscapeSeqNdx(key_end,0,kbEnd);
+ EnterEscapeSeqNdx(key_home,0,kbHome);
+ EnterEscapeSeqNdx(key_ic,0,kbIns);
+ EnterEscapeSeqNdx(key_dc,0,kbDel);
+ EnterEscapeSeqNdx(key_stab,0,kbShiftTab);
+ { EnterEscapeSeqNdx(key_,0,kb);
+ EnterEscapeSeqNdx(key_,0,kb); }
+end;
+
+{$endif not NotUseTree}
+
+Function RawReadKey:char;
+Var
+ fdsin : tfdSet;
+Begin
+{Check Buffer first}
+ if KeySend<>KeyPut then
+ begin
+ RawReadKey:=PopKey;
+ exit;
+ end;
+{Wait for Key}
+ if not sysKeyPressed then
+ begin
+ fpFD_ZERO (fdsin);
+ fpFD_SET (StdInputHandle,fdsin);
+ fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
+ end;
+ RawReadKey:=ttyRecvChar;
+end;
+
+
+Function RawReadString : String;
+Var
+ ch : char;
+ fdsin : tfdSet;
+ St : String;
+Begin
+ St:=RawReadKey;
+ fpFD_ZERO (fdsin);
+ fpFD_SET (StdInputHandle,fdsin);
+ Repeat
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ if SysKeyPressed then
+ ch:=ttyRecvChar
+ else
+ ch:=#0;
+ if ch<>#0 then
+ St:=St+ch;
+ Until ch=#0;
+ RawReadString:=St;
+end;
+
+
+Function ReadKey(var IsAlt : boolean):char;
+Var
+ ch : char;
+{$ifdef NotUseTree}
+ OldState : longint;
+ State : longint;
+{$endif NotUseTree}
+ is_delay : boolean;
+ fdsin : tfdSet;
+ store : array [0..8] of char;
+ arrayind : byte;
+{$ifndef NotUseTree}
+ NPT,NNPT : PTreeElement;
+{$else NotUseTree}
+ procedure GenMouseEvent;
+ var MouseEvent: TMouseEvent;
+ begin
+ Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+ case ch of
+ #32 : {left button pressed }
+ MouseEvent.buttons:=1;
+ #33 : {middle button pressed }
+ MouseEvent.buttons:=2;
+ #34 : { right button pressed }
+ MouseEvent.buttons:=4;
+ #35 : { no button pressed };
+ end;
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ ch:=ttyRecvChar;
+ MouseEvent.x:=Ord(ch)-ord(' ')-1;
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ ch:=ttyRecvChar;
+ MouseEvent.y:=Ord(ch)-ord(' ')-1;
+ if (MouseEvent.buttons<>0) then
+ MouseEvent.action:=MouseActionDown
+ else
+ begin
+ if (LastMouseEvent.Buttons<>0) and
+ ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
+ begin
+ MouseEvent.Action:=MouseActionMove;
+ MouseEvent.Buttons:=LastMouseEvent.Buttons;
+ PutMouseEvent(MouseEvent);
+ MouseEvent.Buttons:=0;
+ end;
+ MouseEvent.Action:=MouseActionUp;
+ end;
+ PutMouseEvent(MouseEvent);
+ LastMouseEvent:=MouseEvent;
+ end;
+{$endif NotUseTree}
+
+ procedure RestoreArray;
+ var
+ i : byte;
+ begin
+ for i:=0 to arrayind-1 do
+ PushKey(store[i]);
+ end;
+
+Begin
+ IsAlt:=false;
+{Check Buffer first}
+ if KeySend<>KeyPut then
+ begin
+ ReadKey:=PopKey;
+ exit;
+ end;
+{Wait for Key}
+ if not sysKeyPressed then
+ begin
+ fpFD_ZERO (fdsin);
+ fpFD_SET (StdInputHandle,fdsin);
+ fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
+ end;
+ ch:=ttyRecvChar;
+{$ifndef NotUseTree}
+ NPT:=RootTree[ord(ch)];
+ if not assigned(NPT) then
+ PushKey(ch)
+ else
+ begin
+ fpFD_ZERO(fdsin);
+ fpFD_SET(StdInputHandle,fdsin);
+ store[0]:=ch;
+ arrayind:=1;
+ while assigned(NPT) and syskeypressed do
+ begin
+ if (InCnt=0) then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ ch:=ttyRecvChar;
+ NNPT:=FindChild(ord(ch),NPT);
+ if assigned(NNPT) then
+ Begin
+ NPT:=NNPT;
+ if NPT^.CanBeTerminal and
+ assigned(NPT^.SpecialHandler) then
+ break;
+ End;
+ if ch<>#0 then
+ begin
+ store[arrayind]:=ch;
+ inc(arrayind);
+ end;
+ if not assigned(NNPT) then
+ begin
+ if ch<>#0 then
+ begin
+ { Put that unused char back into InBuf }
+ If InTail=0 then
+ InTail:=InSize-1
+ else
+ Dec(InTail);
+ InBuf[InTail]:=ch;
+ inc(InCnt);
+ end;
+ break;
+ end;
+ end;
+ if assigned(NPT) and NPT^.CanBeTerminal then
+ begin
+ if assigned(NPT^.SpecialHandler) then
+ begin
+ NPT^.SpecialHandler;
+ PushExt(0);
+ end
+ else if NPT^.CharValue<>0 then
+ PushKey(chr(NPT^.CharValue))
+ else if NPT^.ScanValue<>0 then
+ PushExt(NPT^.ScanValue);
+ end
+ else
+ RestoreArray;
+{$else NotUseTree}
+{Esc Found ?}
+ If (ch=#27) then
+ begin
+ fpFD_ZERO(fdsin);
+ fpFD_SET(StdInputHandle,fdsin);
+ State:=1;
+ store[0]:=#27;
+ arrayind:=1;
+{$ifdef logging}
+ write(f,'Esc');
+{$endif logging}
+ if InCnt=0 then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ while (State<>0) and (sysKeyPressed) do
+ begin
+ ch:=ttyRecvChar;
+ store[arrayind]:=ch;
+ inc(arrayind);
+{$ifdef logging}
+ if ord(ch)>31 then
+ write(f,ch)
+ else
+ write(f,'#',ord(ch):2);
+{$endif logging}
+ OldState:=State;
+ State:=0;
+ case OldState of
+ 1 : begin {Esc}
+ case ch of
+ 'a'..'z',
+ '0'..'9',
+ '-','=' : PushExt(FAltKey(ch));
+ 'A'..'N',
+ 'P'..'Z' : PushExt(FAltKey(chr(ord(ch)+ord('a')-ord('A'))));
+ #10 : PushKey(#10);
+ #13 : PushKey(#10);
+ #27 : begin
+ IsAlt:=True;
+ State:=1;
+ end;
+ #127 : PushExt(kbAltDel);
+ '[' : State:=2;
+ 'O' : State:=6;
+ else
+ RestoreArray;
+ end;
+ end;
+ 2 : begin {Esc[}
+ case ch of
+ '[' : State:=3;
+ 'A' : PushExt(kbUp);
+ 'B' : PushExt(kbDown);
+ 'C' : PushExt(kbRight);
+ 'D' : PushExt(kbLeft);
+ 'F' : PushExt(kbEnd);
+ 'G' : PushKey('5');
+ 'H' : PushExt(kbHome);
+ 'K' : PushExt(kbEnd);
+ 'M' : State:=13;
+ '1' : State:=4;
+ '2' : State:=5;
+ '3' : State:=12;{PushExt(kbDel)}
+ '4' : PushExt(kbEnd);
+ '5' : PushExt(73);
+ '6' : PushExt(kbPgDn);
+ '?' : State:=7;
+ else
+ RestoreArray;
+ end;
+ if ch in ['4'..'6'] then
+ State:=255;
+ end;
+ 3 : begin {Esc[[}
+ case ch of
+ 'A' : PushExt(kbF1);
+ 'B' : PushExt(kbF2);
+ 'C' : PushExt(kbF3);
+ 'D' : PushExt(kbF4);
+ 'E' : PushExt(kbF5);
+ else
+ RestoreArray;
+ end;
+ end;
+ 4 : begin {Esc[1}
+ case ch of
+ '~' : PushExt(kbHome);
+ '7' : PushExt(kbF6);
+ '8' : PushExt(kbF7);
+ '9' : PushExt(kbF8);
+ else
+ RestoreArray;
+ end;
+ if (Ch<>'~') then
+ State:=255;
+ end;
+ 5 : begin {Esc[2}
+ case ch of
+ '~' : PushExt(kbIns);
+ '0' : pushExt(kbF9);
+ '1' : PushExt(kbF10);
+ '3' : PushExt($85){F11, but ShiftF1 also !!};
+ '4' : PushExt($86){F12, but Shift F2 also !!};
+ '5' : PushExt($56){ShiftF3};
+ '6' : PushExt($57){ShiftF4};
+ '8' : PushExt($58){ShiftF5};
+ '9' : PushExt($59){ShiftF6};
+ else
+ RestoreArray;
+ end;
+ if (Ch<>'~') then
+ State:=255;
+ end;
+ 12 : begin {Esc[3}
+ case ch of
+ '~' : PushExt(kbDel);
+ '1' : PushExt($5A){ShiftF7};
+ '2' : PushExt($5B){ShiftF8};
+ '3' : PushExt($5C){ShiftF9};
+ '4' : PushExt($5D){ShiftF10};
+ else
+ RestoreArray;
+ end;
+ if (Ch<>'~') then
+ State:=255;
+ end;
+ 6 : begin {EscO Function keys in vt100 mode PM }
+ case ch of
+ 'P' : {F1}PushExt(kbF1);
+ 'Q' : {F2}PushExt(kbF2);
+ 'R' : {F3}PushExt(kbF3);
+ 'S' : {F4}PushExt(kbF4);
+ 't' : {F5}PushExt(kbF5);
+ 'u' : {F6}PushExt(kbF6);
+ 'v' : {F7}PushExt(kbF7);
+ 'l' : {F8}PushExt(kbF8);
+ 'w' : {F9}PushExt(kbF9);
+ 'x' : {F10}PushExt(kbF10);
+ 'D' : {keyLeft}PushExt($4B);
+ 'C' : {keyRight}PushExt($4D);
+ 'A' : {keyUp}PushExt($48);
+ 'B' : {keyDown}PushExt($50);
+ else
+ RestoreArray;
+ end;
+ end;
+ 7 : begin {Esc[? keys in vt100 mode PM }
+ case ch of
+ '0' : State:=11;
+ '1' : State:=8;
+ '7' : State:=9;
+ else
+ RestoreArray;
+ end;
+ end;
+ 8 : begin {Esc[?1 keys in vt100 mode PM }
+ case ch of
+ 'l' : {local mode};
+ 'h' : {transmit mode};
+ ';' : { 'Esc[1;0c seems to be sent by M$ telnet app
+ for no hangup purposes }
+ state:=10;
+ else
+ RestoreArray;
+ end;
+ end;
+ 9 : begin {Esc[?7 keys in vt100 mode PM }
+ case ch of
+ 'l' : {exit_am_mode};
+ 'h' : {enter_am_mode};
+ else
+ RestoreArray;
+ end;
+ end;
+ 10 : begin {Esc[?1; keys in vt100 mode PM }
+ case ch of
+ '0' : state:=11;
+ else
+ RestoreArray;
+ end;
+ end;
+ 11 : begin {Esc[?1;0 keys in vt100 mode PM }
+ case ch of
+ 'c' : ;
+ else
+ RestoreArray;
+ end;
+ end;
+ 13 : begin {Esc[M mouse prefix for xterm }
+ GenMouseEvent;
+ end;
+ 255 : { just forget this trailing char };
+ end;
+ if (State<>0) and (InCnt=0) then
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ end;
+ if State=1 then
+ PushKey(ch);
+{$endif NotUseTree}
+ if ch='$' then
+ begin { '$<XX>' means a delay of XX millisecs }
+ is_delay :=false;
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ if (sysKeyPressed) then
+ begin
+ ch:=ttyRecvChar;
+ is_delay:=(ch='<');
+ if not is_delay then
+ begin
+ PushKey('$');
+ PushKey(ch);
+ end
+ else
+ begin
+{$ifdef logging}
+ write(f,'$<');
+{$endif logging}
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ while (sysKeyPressed) and (ch<>'>') do
+ begin
+ { Should we really repect this delay ?? }
+ ch:=ttyRecvChar;
+{$ifdef logging}
+ write(f,ch);
+{$endif logging}
+ fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
+ end;
+ end;
+ end
+ else
+ PushKey('$');
+ end;
+ end
+{$ifdef logging}
+ writeln(f);
+{$endif logging}
+{$ifndef NotUseTree}
+ ;
+ ReadKey:=PopKey;
+{$else NotUseTree}
+ else
+ Begin
+ case ch of
+ #127 : PushKey(#8);
+ else
+ PushKey(ch);
+ end;
+ End;
+ ReadKey:=PopKey;
+{$endif NotUseTree}
+End;
+
+
+function ShiftState:byte;
+var
+{$ifndef BSD}
+ arg,
+{$endif BSD}
+ shift : longint;
+begin
+ shift:=0;
+ {$Ifndef BSD}
+ arg:=6;
+ if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
+ begin
+ if (arg and 8)<>0 then
+ shift:=kbAlt;
+ if (arg and 4)<>0 then
+ inc(shift,kbCtrl);
+ { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
+ if (arg and 2)<>0 then
+ shift:=shift or (kbAlt or kbCtrl);
+ if (arg and 1)<>0 then
+ inc(shift,kbShift);
+ end;
+ {$endif}
+ ShiftState:=shift;
+end;
+
+
+{ Exported functions }
+
+procedure SysInitKeyboard;
+begin
+ SetRawMode(true);
+ patchkeyboard;
+{$ifdef logging}
+ assign(f,'keyboard.log');
+ rewrite(f);
+{$endif logging}
+ if not IsConsole then
+ begin
+ { default for Shift prefix is ^ A}
+ if ShiftPrefix = 0 then
+ ShiftPrefix:=1;
+ {default for Alt prefix is ^Z }
+ if AltPrefix=0 then
+ AltPrefix:=26;
+ { default for Ctrl Prefix is ^W }
+ if CtrlPrefix=0 then
+ CtrlPrefix:=23;
+ end;
+{$ifndef NotUseTree}
+ LoadDefaultSequences;
+ LoadTerminfoSequences;
+{$endif not NotUseTree}
+end;
+
+
+procedure SysDoneKeyboard;
+begin
+ unpatchkeyboard;
+ SetRawMode(false);
+
+{$ifndef NotUseTree}
+ FreeTree;
+{$endif not NotUseTree}
+
+{$ifdef logging}
+ close(f);
+{$endif logging}
+end;
+
+
+function SysGetKeyEvent: TKeyEvent;
+
+ function EvalScan(b:byte):byte;
+ const
+ DScan:array[0..31] of byte = (
+ $39, $02, $28, $04, $05, $06, $08, $28,
+ $0A, $0B, $09, $0D, $33, $0C, $34, $35,
+ $0B, $02, $03, $04, $05, $06, $07, $08,
+ $09, $0A, $27, $27, $33, $0D, $34, $35);
+ LScan:array[0..31] of byte = (
+ $29, $1E, $30, $2E, $20, $12, $21, $22,
+ $23, $17, $24, $25, $26, $32, $31, $18,
+ $19, $10, $13, $1F, $14, $16, $2F, $11,
+ $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
+ begin
+ if (b and $E0)=$20 { digits / leters } then
+ EvalScan:=DScan[b and $1F]
+ else
+ case b of
+ $08:EvalScan:=$0E; { backspace }
+ $09:EvalScan:=$0F; { TAB }
+ $0D:EvalScan:=$1C; { CR }
+ $1B:EvalScan:=$01; { esc }
+ $40:EvalScan:=$03; { @ }
+ $5E:EvalScan:=$07; { ^ }
+ $60:EvalScan:=$29; { ` }
+ else
+ EvalScan:=LScan[b and $1F];
+ end;
+ end;
+
+ function EvalScanZ(b:byte):byte;
+ begin
+ EvalScanZ:=b;
+ if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
+ EvalScanZ:=b+$2D;
+ end;
+const
+ {kbHome, kbUp, kbPgUp,Missing, kbLeft,
+ kbCenter, kbRight, kbAltGrayPlus, kbend,
+ kbDown, kbPgDn, kbIns, kbDel }
+ CtrlArrow : array [kbHome..kbDel] of byte =
+ {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
+ (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
+ kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
+ kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
+ AltArrow : array [kbHome..kbDel] of byte =
+ (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
+ kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
+ kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
+var
+ MyScan,
+ SState : byte;
+ MyChar : char;
+ EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
+begin {main}
+ MyChar:=Readkey(IsAlt);
+ MyScan:=ord(MyChar);
+ SState:=ShiftState;
+ CtrlPrefixUsed:=false;
+ AltPrefixUsed:=false;
+ ShiftPrefixUsed:=false;
+ EscUsed:=false;
+ if IsAlt then
+ SState:=SState or kbAlt;
+ repeat
+ again:=false;
+ if Mychar=#0 then
+ begin
+ MyScan:=ord(ReadKey(IsAlt));
+ { Handle Ctrl-<x>, but not AltGr-<x> }
+ if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
+ begin
+ case MyScan of
+ kbHome..kbDel : { cArrow }
+ MyScan:=CtrlArrow[MyScan];
+ kbF1..KbF10 : { cF1-cF10 }
+ MyScan:=MyScan+kbCtrlF1-kbF1;
+ kbF11..KbF12 : { cF11-cF12 }
+ MyScan:=MyScan+kbCtrlF11-kbF11;
+ end;
+ end
+ { Handle Alt-<x>, but not AltGr }
+ else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
+ begin
+ case MyScan of
+ kbHome..kbDel : { AltArrow }
+ MyScan:=AltArrow[MyScan];
+ kbF1..KbF10 : { aF1-aF10 }
+ MyScan:=MyScan+kbAltF1-kbF1;
+ kbF11..KbF12 : { aF11-aF12 }
+ MyScan:=MyScan+kbAltF11-kbF11;
+ end;
+ end
+ else if (SState and kbShift)<>0 then
+ begin
+ case MyScan of
+ kbIns: MyScan:=kbShiftIns;
+ kbDel: MyScan:=kbShiftDel;
+ kbF1..KbF10 : { sF1-sF10 }
+ MyScan:=MyScan+kbShiftF1-kbF1;
+ kbF11..KbF12 : { sF11-sF12 }
+ MyScan:=MyScan+kbShiftF11-kbF11;
+ end;
+ end;
+ if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
+ SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
+ else
+ SysGetKeyEvent:=0;
+ exit;
+ end
+ else if MyChar=#27 then
+ begin
+ if EscUsed then
+ SState:=SState and not kbAlt
+ else
+ begin
+ SState:=SState or kbAlt;
+ Again:=true;
+ EscUsed:=true;
+ end;
+ end
+ else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
+ begin { ^Z - replace Alt for Linux OS }
+ if AltPrefixUsed then
+ begin
+ SState:=SState and not kbAlt;
+ end
+ else
+ begin
+ AltPrefixUsed:=true;
+ SState:=SState or kbAlt;
+ Again:=true;
+ end;
+ end
+ else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
+ begin
+ if CtrlPrefixUsed then
+ SState:=SState and not kbCtrl
+ else
+ begin
+ CtrlPrefixUsed:=true;
+ SState:=SState or kbCtrl;
+ Again:=true;
+ end;
+ end
+ else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
+ begin
+ if ShiftPrefixUsed then
+ SState:=SState and not kbShift
+ else
+ begin
+ ShiftPrefixUsed:=true;
+ SState:=SState or kbShift;
+ Again:=true;
+ end;
+ end;
+ if not again then
+ begin
+ MyScan:=EvalScan(ord(MyChar));
+ if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
+ begin
+ if MyScan in [$02..$0D] then
+ inc(MyScan,$76);
+ MyChar:=chr(0);
+ end
+ else if (SState and kbShift)<>0 then
+ if MyChar=#9 then
+ begin
+ MyChar:=#0;
+ MyScan:=kbShiftTab;
+ end;
+ end
+ else
+ begin
+ MyChar:=Readkey(IsAlt);
+ MyScan:=ord(MyChar);
+ if IsAlt then
+ SState:=SState or kbAlt;
+ end;
+ until not Again;
+ if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
+ SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
+ else
+ SysGetKeyEvent:=0;
+end;
+
+
+function SysPollKeyEvent: TKeyEvent;
+var
+ KeyEvent : TKeyEvent;
+begin
+ if keypressed then
+ begin
+ KeyEvent:=SysGetKeyEvent;
+ PutKeyEvent(KeyEvent);
+ SysPollKeyEvent:=KeyEvent
+ end
+ else
+ SysPollKeyEvent:=0;
+end;
+
+
+function SysGetShiftState : Byte;
+begin
+ SysGetShiftState:=ShiftState;
+end;
+
+
+procedure RestoreStartMode;
+begin
+ TCSetAttr(1,TCSANOW,StartTio);
+end;
+
+
+Const
+ SysKeyboardDriver : TKeyboardDriver = (
+ InitDriver : @SysInitKeyBoard;
+ DoneDriver : @SysDoneKeyBoard;
+ GetKeyevent : @SysGetKeyEvent;
+ PollKeyEvent : @SysPollKeyEvent;
+ GetShiftState : @SysGetShiftState;
+ TranslateKeyEvent : Nil;
+ TranslateKeyEventUnicode : Nil;
+ );
+
+begin
+ SetKeyBoardDriver(SysKeyBoardDriver);
+ TCGetAttr(1,StartTio);
+end.
+{
+ $Log: keyboard.pp,v $
+ Revision 1.22 2005/03/25 23:01:50 jonas
+ * removed unused variable
+
+ Revision 1.21 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/linux.pp b/rtl/unix/linux.pp
new file mode 100644
index 0000000000..509c3d55cb
--- /dev/null
+++ b/rtl/unix/linux.pp
@@ -0,0 +1,32 @@
+{
+ $Id: linux.pp,v 1.33 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ BSD parts (c) 2000 by Marco van de Voort
+ members of the Free Pascal development team.
+
+ This unit contains only fully linux specific code and calls under 1.1.x
+ When compiled with the 1.0.x series it contains a somewhat 1.0.x
+ compatible linux code to allow bootstrap.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$ifdef VER1_0}
+{$i linuxold.inc}
+{$else}
+{$i linuxnew.inc}
+{$endif}
+
+{
+ $Log: linux.pp,v $
+ Revision 1.33 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/linuxnew.inc b/rtl/unix/linuxnew.inc
new file mode 100644
index 0000000000..30b650a5bf
--- /dev/null
+++ b/rtl/unix/linuxnew.inc
@@ -0,0 +1,153 @@
+{
+ $Id: linuxnew.inc,v 1.6 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ BSD parts (c) 2000 by Marco van de Voort
+ members of the Free Pascal development team.
+
+ New linux unit. Linux only calls only. Will be renamed to linux.pp
+ when 1.0.x support is killed off.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+unit Linux;
+
+interface
+
+Type
+ TSysinfo = packed record
+ uptime : longint;
+ loads : array[1..3] of longint;
+ totalram,
+ freeram,
+ sharedram,
+ bufferram,
+ totalswap,
+ freeswap : longint;
+ procs : integer;
+ s : string[18];
+ end;
+ PSysInfo = ^TSysInfo;
+
+Function Sysinfo(var Info:TSysinfo):Boolean; {$ifdef FPC_USE_LIBC} cdecl; external name 'sysinfo'; {$endif}
+
+Const
+ CSIGNAL = $000000ff; // signal mask to be sent at exit
+ CLONE_VM = $00000100; // set if VM shared between processes
+ CLONE_FS = $00000200; // set if fs info shared between processes
+ CLONE_FILES = $00000400; // set if open files shared between processes
+ CLONE_SIGHAND = $00000800; // set if signal handlers shared
+ CLONE_PID = $00001000; // set if pid shared
+
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+
+function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; {$ifdef FPC_USE_LIBC} cdecl; external name 'clone'; {$endif}
+
+implementation
+
+{$ifndef FPC_USE_LIBC}
+Uses Syscall;
+
+Function Sysinfo(var Info:TSysinfo):Boolean;
+{
+ Get system info
+}
+Begin
+ Sysinfo:=do_SysCall(SysCall_nr_Sysinfo,TSysParam(@info))=0;
+End;
+
+function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+
+begin
+ if (pointer(func)=nil) or (sp=nil) then
+ exit(-1); // give an error result
+{$ifdef cpui386}
+{$ASMMODE ATT}
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ movl flags,%ebx
+ movl SysCall_nr_clone,%eax
+ int $0x80
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+{$endif cpui386}
+{$ifdef cpum68k}
+ { No yet translated, my m68k assembler is too weak for such things PM }
+(*
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ movl flags,%ebx
+ movl SysCall_nr_clone,%eax
+ int $0x80
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+ *)
+{$endif cpum68k}
+end;
+{$endif}
+
+end.
+
+{
+ $Log: linuxnew.inc,v $
+ Revision 1.6 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/linuxold.inc b/rtl/unix/linuxold.inc
new file mode 100644
index 0000000000..ea3f44b9ba
--- /dev/null
+++ b/rtl/unix/linuxold.inc
@@ -0,0 +1,5920 @@
+{
+ $Id: linuxold.inc,v 1.19 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ BSD parts (c) 2000 by Marco van de Voort
+ members of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$ifdef VER1_0}
+unit linux;
+{$else}
+unit oldlinux;
+{$endif}
+
+Interface
+
+Const
+ { Things for LSEEK call }
+ Seek_set = 0;
+ Seek_Cur = 1;
+ Seek_End = 2;
+ { Things for OPEN call - after linux/fcntl.h }
+ Open_Accmode = 3;
+ Open_RdOnly = 0;
+ Open_WrOnly = 1;
+ Open_RdWr = 2;
+ Open_Creat = 1 shl 6;
+ Open_Excl = 2 shl 6;
+ Open_NoCtty = 4 shl 6;
+ Open_Trunc = 1 shl 9;
+ Open_Append = 2 shl 9;
+ Open_NonBlock = 4 shl 9;
+ Open_NDelay = Open_NonBlock;
+ Open_Sync = 1 shl 12;
+ Open_Direct = 4 shl 12;
+ Open_LargeFile = 1 shl 15;
+ Open_Directory = 2 shl 15;
+ Open_NoFollow = 4 shl 15;
+ { The waitpid uses the following options:}
+ Wait_NoHang = 1;
+ Wait_UnTraced = 2;
+ Wait_Any = -1;
+ Wait_MyPGRP = 0;
+ Wait_Clone = $80000000;
+ { Constants to check stat.mode }
+ STAT_IFMT = $f000; {00170000}
+ STAT_IFSOCK = $c000; {0140000}
+ STAT_IFLNK = $a000; {0120000}
+ STAT_IFREG = $8000; {0100000}
+ STAT_IFBLK = $6000; {0060000}
+ STAT_IFDIR = $4000; {0040000}
+ STAT_IFCHR = $2000; {0020000}
+ STAT_IFIFO = $1000; {0010000}
+ STAT_ISUID = $0800; {0004000}
+ STAT_ISGID = $0400; {0002000}
+ STAT_ISVTX = $0200; {0001000}
+ { Constants to check permissions }
+ STAT_IRWXO = $7;
+ STAT_IROTH = $4;
+ STAT_IWOTH = $2;
+ STAT_IXOTH = $1;
+
+ STAT_IRWXG = STAT_IRWXO shl 3;
+ STAT_IRGRP = STAT_IROTH shl 3;
+ STAT_IWGRP = STAT_IWOTH shl 3;
+ STAT_IXGRP = STAT_IXOTH shl 3;
+
+ STAT_IRWXU = STAT_IRWXO shl 6;
+ STAT_IRUSR = STAT_IROTH shl 6;
+ STAT_IWUSR = STAT_IWOTH shl 6;
+ STAT_IXUSR = STAT_IXOTH shl 6;
+
+ { Constants to test the type of filesystem }
+ fs_old_ext2 = $ef51;
+ fs_ext2 = $ef53;
+ fs_ext = $137d;
+ fs_iso = $9660;
+ fs_minix = $137f;
+ fs_minix_30 = $138f;
+ fs_minux_V2 = $2468;
+ fs_msdos = $4d44;
+ fs_nfs = $6969;
+ fs_proc = $9fa0;
+ fs_xia = $012FD16D;
+
+ { Constansts for MMAP }
+ MAP_PRIVATE =2;
+ MAP_ANONYMOUS =$20;
+
+ {Constansts Termios/Ioctl (used in Do_IsDevice) }
+ IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+type
+
+{
+ Linux system calls take arguments as follows :
+
+ cpui386/m68k:
+
+ %eax/%d0 : System call number
+ %ebx/%d1 : first argument
+ %ecx/%d2 : second argument
+ %edx/%d3 : third argumens
+ %esi/%d3 : fourth argument
+ %edi/%d4 : fifth argument
+
+ That is why we define a special type, with only these arguments
+ To make it processor independent, we don't give any system dependent
+ names, but the rather abstract reg1,reg2 etc;
+}
+ SysCallRegs=record
+ reg1,reg2,reg3,reg4,reg5,reg6 : longint;
+ end;
+ PSysCallRegs=^SysCallRegs;
+ TSysCallRegs=SysCallRegs;
+
+{ The following are records for system calls }
+ dirent = packed record
+ ino,
+ off : longint;
+ reclen : word;
+ name : array [0..255] of char;
+ end;
+ pdirent =^dirent;
+ TDirEnt = dirent;
+
+ TDir = packed record
+ fd : integer;
+ loc : longint;
+ size : integer;
+ buf : pdirent;
+ {The following are used in libc, but NOT in the linux kernel sources ??}
+ nextoff: longint;
+ dd_max : integer; {size of buf. Irrelevant, as buf is of type dirent}
+ lock : pointer;
+ end;
+ PDir =^TDir;
+
+ dev_t = word;
+
+ Stat = packed record
+ dev : dev_t;
+ pad1 : word;
+ ino : longint;
+ mode,
+ nlink,
+ uid,
+ gid : word;
+ rdev : dev_t;
+ pad2 : word;
+ size,
+ blksze,
+ blocks,
+ atime,
+ unused1,
+ mtime,
+ unused2,
+ ctime,
+ unused3,
+ unused4,
+ unused5 : longint;
+ end;
+ PStat=^Stat;
+ TStat=Stat;
+
+ Statfs = packed record
+ fstype, { File system type }
+ bsize, { Optimal block trensfer size }
+ blocks, { Data blocks in system }
+ bfree, { free blocks in system }
+ bavail, { Available free blocks to non-root users }
+ files, { File nodes in system }
+ ffree, { Free file nodes in system }
+ fsid, { File system ID }
+ namelen : longint; { Maximum name length in system }
+ spare : array [0..6] of longint; { For later use }
+ end;
+ PStatFS=^StatFS;
+ TStatFS=StatFS;
+
+ fdSet=array[0..7] of longint;{=256 bits}
+ pfdset=^fdset;
+ TFDSet=fdset;
+
+ timeval = packed record
+ sec,usec:longint
+ end;
+ ptimeval=^timeval;
+ TTimeVal=timeval;
+
+ timespec = packed record
+ tv_sec,tv_nsec:longint;
+ end;
+
+ timezone = packed record
+ minuteswest,dsttime:longint;
+ end;
+ ptimezone =^timezone;
+ TTimeZone = timezone;
+
+ utsname = packed record
+ sysname,
+ nodename,
+ release,
+ version,
+ machine,
+ domainname : Array[0..64] of char;
+ end;
+ PUTSName=^UTSName;
+ TUTSName=UTSName;
+
+{ Get System call numbers and error-numbers}
+
+const
+ syscall_nr_setup = 0;
+ syscall_nr_exit = 1;
+ syscall_nr_fork = 2;
+ syscall_nr_read = 3;
+ syscall_nr_write = 4;
+ syscall_nr_open = 5;
+ syscall_nr_close = 6;
+ syscall_nr_waitpid = 7;
+ syscall_nr_creat = 8;
+ syscall_nr_link = 9;
+ syscall_nr_unlink = 10;
+ syscall_nr_execve = 11;
+ syscall_nr_chdir = 12;
+ syscall_nr_time = 13;
+ syscall_nr_mknod = 14;
+ syscall_nr_chmod = 15;
+ syscall_nr_chown = 16;
+ syscall_nr_break = 17;
+ syscall_nr_oldstat = 18;
+ syscall_nr_lseek = 19;
+ syscall_nr_getpid = 20;
+ syscall_nr_mount = 21;
+ syscall_nr_umount = 22;
+ syscall_nr_setuid = 23;
+ syscall_nr_getuid = 24;
+ syscall_nr_stime = 25;
+ syscall_nr_ptrace = 26;
+ syscall_nr_alarm = 27;
+ syscall_nr_oldfstat = 28;
+ syscall_nr_pause = 29;
+ syscall_nr_utime = 30;
+ syscall_nr_stty = 31;
+ syscall_nr_gtty = 32;
+ syscall_nr_access = 33;
+ syscall_nr_nice = 34;
+ syscall_nr_ftime = 35;
+ syscall_nr_sync = 36;
+ syscall_nr_kill = 37;
+ syscall_nr_rename = 38;
+ syscall_nr_mkdir = 39;
+ syscall_nr_rmdir = 40;
+ syscall_nr_dup = 41;
+ syscall_nr_pipe = 42;
+ syscall_nr_times = 43;
+ syscall_nr_prof = 44;
+ syscall_nr_brk = 45;
+ syscall_nr_setgid = 46;
+ syscall_nr_getgid = 47;
+ syscall_nr_signal = 48;
+ syscall_nr_geteuid = 49;
+ syscall_nr_getegid = 50;
+ syscall_nr_acct = 51;
+ syscall_nr_phys = 52;
+ syscall_nr_lock = 53;
+ syscall_nr_ioctl = 54;
+ syscall_nr_fcntl = 55;
+ syscall_nr_mpx = 56;
+ syscall_nr_setpgid = 57;
+ syscall_nr_ulimit = 58;
+ syscall_nr_oldolduname = 59;
+ syscall_nr_umask = 60;
+ syscall_nr_chroot = 61;
+ syscall_nr_ustat = 62;
+ syscall_nr_dup2 = 63;
+ syscall_nr_getppid = 64;
+ syscall_nr_getpgrp = 65;
+ syscall_nr_setsid = 66;
+ syscall_nr_sigaction = 67;
+ syscall_nr_sgetmask = 68;
+ syscall_nr_ssetmask = 69;
+ syscall_nr_setreuid = 70;
+ syscall_nr_setregid = 71;
+ syscall_nr_sigsuspend = 72;
+ syscall_nr_sigpending = 73;
+ syscall_nr_sethostname = 74;
+ syscall_nr_setrlimit = 75;
+ syscall_nr_getrlimit = 76;
+ syscall_nr_getrusage = 77;
+ syscall_nr_gettimeofday = 78;
+ syscall_nr_settimeofday = 79;
+ syscall_nr_getgroups = 80;
+ syscall_nr_setgroups = 81;
+ syscall_nr_select = 82;
+ syscall_nr_symlink = 83;
+ syscall_nr_oldlstat = 84;
+ syscall_nr_readlink = 85;
+ syscall_nr_uselib = 86;
+ syscall_nr_swapon = 87;
+ syscall_nr_reboot = 88;
+ syscall_nr_readdir = 89;
+ syscall_nr_mmap = 90;
+ syscall_nr_munmap = 91;
+ syscall_nr_truncate = 92;
+ syscall_nr_ftruncate = 93;
+ syscall_nr_fchmod = 94;
+ syscall_nr_fchown = 95;
+ syscall_nr_getpriority = 96;
+ syscall_nr_setpriority = 97;
+ syscall_nr_profil = 98;
+ syscall_nr_statfs = 99;
+ syscall_nr_fstatfs = 100;
+ syscall_nr_ioperm = 101;
+ syscall_nr_socketcall = 102;
+ syscall_nr_syslog = 103;
+ syscall_nr_setitimer = 104;
+ syscall_nr_getitimer = 105;
+ syscall_nr_stat = 106;
+ syscall_nr_lstat = 107;
+ syscall_nr_fstat = 108;
+ syscall_nr_olduname = 109;
+ syscall_nr_iopl = 110;
+ syscall_nr_vhangup = 111;
+ syscall_nr_idle = 112;
+ syscall_nr_vm86old = 113;
+ syscall_nr_wait4 = 114;
+ syscall_nr_swapoff = 115;
+ syscall_nr_sysinfo = 116;
+ syscall_nr_ipc = 117;
+ syscall_nr_fsync = 118;
+ syscall_nr_sigreturn = 119;
+ syscall_nr_clone = 120;
+ syscall_nr_setdomainname = 121;
+ syscall_nr_uname = 122;
+ syscall_nr_modify_ldt = 123;
+ syscall_nr_adjtimex = 124;
+ syscall_nr_mprotect = 125;
+ syscall_nr_sigprocmask = 126;
+ syscall_nr_create_module = 127;
+ syscall_nr_init_module = 128;
+ syscall_nr_delete_module = 129;
+ syscall_nr_get_kernel_syms = 130;
+ syscall_nr_quotactl = 131;
+ syscall_nr_getpgid = 132;
+ syscall_nr_fchdir = 133;
+ syscall_nr_bdflush = 134;
+ syscall_nr_sysfs = 135;
+ syscall_nr_personality = 136;
+ syscall_nr_afs_syscall = 137;
+ syscall_nr_setfsuid = 138;
+ syscall_nr_setfsgid = 139;
+ syscall_nr__llseek = 140;
+ syscall_nr_getdents = 141;
+ syscall_nr__newselect = 142;
+ syscall_nr_flock = 143;
+ syscall_nr_msync = 144;
+ syscall_nr_readv = 145;
+ syscall_nr_writev = 146;
+ syscall_nr_getsid = 147;
+ syscall_nr_fdatasync = 148;
+ syscall_nr__sysctl = 149;
+ syscall_nr_mlock = 150;
+ syscall_nr_munlock = 151;
+ syscall_nr_mlockall = 152;
+ syscall_nr_munlockall = 153;
+ syscall_nr_sched_setparam = 154;
+ syscall_nr_sched_getparam = 155;
+ syscall_nr_sched_setscheduler = 156;
+ syscall_nr_sched_getscheduler = 157;
+ syscall_nr_sched_yield = 158;
+ syscall_nr_sched_get_priority_max = 159;
+ syscall_nr_sched_get_priority_min = 160;
+ syscall_nr_sched_rr_get_interval = 161;
+ syscall_nr_nanosleep = 162;
+ syscall_nr_mremap = 163;
+ syscall_nr_setresuid = 164;
+ syscall_nr_getresuid = 165;
+ syscall_nr_vm86 = 166;
+ syscall_nr_query_module = 167;
+ syscall_nr_poll = 168;
+ syscall_nr_sigaltstack = 186;
+
+{$IFDEF SYSCALL_DEBUG}
+const
+ Sys_nr_txt : array[0..168] of string[15]=(
+ 'Setup', { 0 }
+ 'Exit', { 1 }
+ 'Fork', { 2 }
+ 'Read', { 3 }
+ 'Write', { 4 }
+ 'Open', { 5 }
+ 'Close', { 6 }
+ 'WaitPid', { 7 }
+ 'Create', { 8 }
+ 'Link', { 9 }
+ 'UnLink', { 10 }
+ 'ExecVe', { 11 }
+ 'ChDir', { 12 }
+ 'Time', { 13 }
+ 'MkNod', { 14 }
+ 'ChMod', { 15 }
+ 'ChOwn', { 16 }
+ 'Break', { 17 }
+ 'OldState', { 18 }
+ 'LSeek', { 19 }
+ 'GetPid', { 20 }
+ 'Mount', { 21 }
+ 'UMount', { 22 }
+ 'SetUid', { 23 }
+ 'GetUid', { 24 }
+ 'STime', { 25 }
+ 'PTrace', { 26 }
+ 'Alarm', { 27 }
+ 'OldFStat', { 28 }
+ 'Pause', { 29 }
+ 'UTime', { 30 }
+ 'STTY', { 31 }
+ 'GTTY', { 32 }
+ 'Access', { 33 }
+ 'Nice', { 34 }
+ 'FTime', { 35 }
+ 'Sync', { 36 }
+ 'Kill', { 37 }
+ 'Rename', { 38 }
+ 'MkDir', { 39 }
+ 'RmDir', { 40 }
+ 'Dup', { 41 }
+ 'Pipe', { 42 }
+ 'Times', { 43 }
+ 'Prof', { 44 }
+ 'Break', { 45 }
+ 'SetGid', { 46 }
+ 'GetGid', { 47 }
+ 'Signal', { 48 }
+ 'GetEUid', { 49 }
+ 'GetEGid', { 50 }
+ 'Acct', { 51 }
+ 'Phys', { 52 }
+ 'Lock', { 53 }
+ 'IOCtl', { 54 }
+ 'FCNtl', { 55 }
+ 'Mpx', { 56 }
+ 'SetPGid', { 57 }
+ 'ULimit', { 58 }
+ 'OldOldUName', { 59 }
+ 'UMask', { 60 }
+ 'ChRoot', { 61 }
+ 'UStat', { 62 }
+ 'Dup2', { 63 }
+ 'GetPPid', { 64 }
+ 'GetPGrp', { 65 }
+ 'SetSid', { 66 }
+ 'SigAction', { 67 }
+ 'SGetMask', { 68 }
+ 'SSetMask', { 69 }
+ 'SetReUid', { 70 }
+ 'SetReGid', { 71 }
+ 'SigSuspend', { 72 }
+ 'SigPending', { 73 }
+ 'SetHostName', { 74 }
+ 'SetRLimit', { 75 }
+ 'GetRLimit', { 76 }
+ 'GetRUsage', { 77 }
+ 'GetTimeOfDay', { 78 }
+ 'SetTimeOfDay', { 79 }
+ 'GetGroups', { 80 }
+ 'SetGroups', { 81 }
+ 'Select', { 82 }
+ 'SymLink', { 83 }
+ 'OldLStat', { 84 }
+ 'ReadLink', { 85 }
+ 'UseLib', { 86 }
+ 'SwapOn', { 87 }
+ 'Reboot', { 88 }
+ 'ReadDir', { 89 }
+ 'MMap', { 90 }
+ 'MunMap', { 91 }
+ 'Truncate', { 92 }
+ 'FTruncate', { 93 }
+ 'FChMod', { 94 }
+ 'FChOwn', { 95 }
+ 'GetPriority', { 96 }
+ 'SetPriority', { 97 }
+ 'Profile', { 98 }
+ 'StatFs', { 99 }
+ 'FStatFs', { 100 }
+ 'IOPerm', { 101 }
+ 'SocketCall', { 102 }
+ 'SysLog', { 103 }
+ 'SetITimer', { 104 }
+ 'GetITimer', { 105 }
+ 'Stat', { 106 }
+ 'LStat', { 107 }
+ 'FStat', { 108 }
+ 'OldUName', { 109 }
+ 'IOPl', { 110 }
+ 'VHangup', { 111 }
+ 'Idle', { 112 }
+ 'VM86', { 113 }
+ 'Wait4', { 114 }
+ 'SwapOff', { 115 }
+ 'SysInfo', { 116 }
+ 'IPC', { 117 }
+ 'FSync', { 118 }
+ 'SigReturn', { 119 }
+ 'Clone', { 120 }
+ 'SetDomainName', { 121 }
+ 'UName', { 122 }
+ 'Modify_Ldt', { 123 }
+ 'AdjTimeX', { 124 }
+ 'MProtect', { 125 }
+ 'SigProcMask', { 126 }
+ 'Create_Module', { 127 }
+ 'Init_Module', { 128 }
+ 'Delete_Module', { 129 }
+ 'Get_Kernel_Syms', { 130 }
+ 'QuotaCtl', { 131 }
+ 'GetPGid', { 132 }
+ 'FChDir', { 133 }
+ 'BDFlush', { 134 }
+ 'SysFs', { 135 }
+ 'Personality', { 136 }
+ 'AFS_SysCall', { 137 }
+ 'SetFsUid', { 138 }
+ 'SetFsGid', { 139 }
+ '__LLSeek', { 140 }
+ 'GetDents', { 141 }
+ '__NewSelect', { 142 }
+ 'FLock', { 143 }
+ 'MSync', { 144 }
+ 'ReadV', { 145 }
+ 'WriteV', { 146 }
+ 'GetSid', { 147 }
+ 'FDataSync', { 148 }
+ '__SysCtl', { 149 }
+ 'MLock', { 150 }
+ 'MUnLock', { 151 }
+ 'MLockAll', { 152 }
+ 'MUnLockAll', { 153 }
+ 'MSchdSetParam', { 154 }
+ 'MSchdGetParam', { 155 }
+ 'MSchdSetSchd', { 156 }
+ 'MSchdGetSchd', { 157 }
+ 'MSchdYield', { 158 }
+ 'MSchdGetPriMax', { 159 }
+ 'MSchdGetPriMin', { 160 }
+ 'MSchdRRGetInt', { 161 }
+ 'NanoSleep', { 162 }
+ 'MRemap', { 163 }
+ 'SetReSuid', { 164 }
+ 'GetReSuid', { 165 }
+ 'vm86', { 166 }
+ 'QueryModule', { 167 }
+ 'Poll'); { 168 }
+{$ENDIF}
+
+Const
+
+Sys_EPERM = 1; { Operation not permitted }
+Sys_ENOENT = 2; { No such file or directory }
+Sys_ESRCH = 3; { No such process }
+Sys_EINTR = 4; { Interrupted system call }
+Sys_EIO = 5; { I/O error }
+Sys_ENXIO = 6; { No such device or address }
+Sys_E2BIG = 7; { Arg list too long }
+Sys_ENOEXEC = 8; { Exec format error }
+Sys_EBADF = 9; { Bad file number }
+Sys_ECHILD = 10; { No child processes }
+Sys_EAGAIN = 11; { Try again }
+Sys_ENOMEM = 12; { Out of memory }
+Sys_EACCES = 13; { Permission denied }
+Sys_EFAULT = 14; { Bad address }
+Sys_ENOTBLK = 15; { Block device required, NOT POSIX! }
+Sys_EBUSY = 16; { Device or resource busy }
+Sys_EEXIST = 17; { File exists }
+Sys_EXDEV = 18; { Cross-device link }
+Sys_ENODEV = 19; { No such device }
+Sys_ENOTDIR = 20; { Not a directory }
+Sys_EISDIR = 21; { Is a directory }
+Sys_EINVAL = 22; { Invalid argument }
+Sys_ENFILE = 23; { File table overflow }
+Sys_EMFILE = 24; { Too many open files }
+Sys_ENOTTY = 25; { Not a typewriter }
+Sys_ETXTBSY = 26; { Text file busy. The new process was
+ a pure procedure (shared text) file which was
+ open for writing by another process, or file
+ which was open for writing by another process,
+ or while the pure procedure file was being
+ executed an open(2) call requested write access
+ requested write access.}
+Sys_EFBIG = 27; { File too large }
+Sys_ENOSPC = 28; { No space left on device }
+Sys_ESPIPE = 29; { Illegal seek }
+Sys_EROFS = 30; { Read-only file system }
+Sys_EMLINK = 31; { Too many links }
+Sys_EPIPE = 32; { Broken pipe }
+Sys_EDOM = 33; { Math argument out of domain of func }
+Sys_ERANGE = 34; { Math result not representable }
+Sys_EDEADLK = 35; { Resource deadlock would occur }
+Sys_ENAMETOOLONG= 36; { File name too long }
+Sys_ENOLCK = 37; { No record locks available }
+Sys_ENOSYS = 38; { Function not implemented }
+Sys_ENOTEMPTY= 39; { Directory not empty }
+Sys_ELOOP = 40; { Too many symbolic links encountered }
+Sys_EWOULDBLOCK = Sys_EAGAIN; { Operation would block }
+Sys_ENOMSG = 42; { No message of desired type }
+Sys_EIDRM = 43; { Identifier removed }
+Sys_ECHRNG = 44; { Channel number out of range }
+Sys_EL2NSYNC= 45; { Level 2 not synchronized }
+Sys_EL3HLT = 46; { Level 3 halted }
+Sys_EL3RST = 47; { Level 3 reset }
+Sys_ELNRNG = 48; { Link number out of range }
+Sys_EUNATCH = 49; { Protocol driver not attached }
+Sys_ENOCSI = 50; { No CSI structure available }
+Sys_EL2HLT = 51; { Level 2 halted }
+Sys_EBADE = 52; { Invalid exchange }
+Sys_EBADR = 53; { Invalid request descriptor }
+Sys_EXFULL = 54; { Exchange full }
+Sys_ENOANO = 55; { No anode }
+Sys_EBADRQC = 56; { Invalid request code }
+Sys_EBADSLT = 57; { Invalid slot }
+Sys_EDEADLOCK= 58; { File locking deadlock error }
+Sys_EBFONT = 59; { Bad font file format }
+Sys_ENOSTR = 60; { Device not a stream }
+Sys_ENODATA = 61; { No data available }
+Sys_ETIME = 62; { Timer expired }
+Sys_ENOSR = 63; { Out of streams resources }
+Sys_ENONET = 64; { Machine is not on the network }
+Sys_ENOPKG = 65; { Package not installed }
+Sys_EREMOTE = 66; { Object is remote }
+Sys_ENOLINK = 67; { Link has been severed }
+Sys_EADV = 68; { Advertise error }
+Sys_ESRMNT = 69; { Srmount error }
+Sys_ECOMM = 70; { Communication error on send }
+Sys_EPROTO = 71; { Protocol error }
+Sys_EMULTIHOP= 72; { Multihop attempted }
+Sys_EDOTDOT = 73; { RFS specific error }
+Sys_EBADMSG = 74; { Not a data message }
+Sys_EOVERFLOW= 75; { Value too large for defined data type }
+Sys_ENOTUNIQ= 76; { Name not unique on network }
+Sys_EBADFD = 77; { File descriptor in bad state }
+Sys_EREMCHG = 78; { Remote address changed }
+Sys_ELIBACC = 79; { Can not access a needed shared library }
+Sys_ELIBBAD = 80; { Accessing a corrupted shared library }
+Sys_ELIBSCN = 81; { .lib section in a.out corrupted }
+Sys_ELIBMAX = 82; { Attempting to link in too many shared libraries }
+Sys_ELIBEXEC= 83; { Cannot exec a shared library directly }
+Sys_EILSEQ = 84; { Illegal byte sequence }
+Sys_ERESTART= 85; { Interrupted system call should be restarted }
+Sys_ESTRPIPE= 86; { Streams pipe error }
+Sys_EUSERS = 87; { Too many users }
+Sys_ENOTSOCK= 88; { Socket operation on non-socket }
+Sys_EDESTADDRREQ= 89; { Destination address required }
+Sys_EMSGSIZE= 90; { Message too long }
+Sys_EPROTOTYPE= 91; { Protocol wrong type for socket }
+Sys_ENOPROTOOPT= 92; { Protocol not available }
+Sys_EPROTONOSUPPORT= 93; { Protocol not supported }
+Sys_ESOCKTNOSUPPORT= 94; { Socket type not supported }
+Sys_EOPNOTSUPP= 95; { Operation not supported on transport endpoint }
+Sys_EPFNOSUPPORT= 96; { Protocol family not supported }
+Sys_EAFNOSUPPORT= 97; { Address family not supported by protocol }
+Sys_EADDRINUSE= 98; { Address already in use }
+Sys_EADDRNOTAVAIL= 99; { Cannot assign requested address }
+Sys_ENETDOWN= 100; { Network is down }
+Sys_ENETUNREACH= 101; { Network is unreachable }
+Sys_ENETRESET= 102; { Network dropped connection because of reset }
+Sys_ECONNABORTED= 103; { Software caused connection abort }
+Sys_ECONNRESET= 104; { Connection reset by peer }
+Sys_ENOBUFS = 105; { No buffer space available }
+Sys_EISCONN = 106; { Transport endpoint is already connected }
+Sys_ENOTCONN= 107; { Transport endpoint is not connected }
+Sys_ESHUTDOWN= 108; { Cannot send after transport endpoint shutdown }
+Sys_ETOOMANYREFS= 109; { Too many references: cannot splice }
+Sys_ETIMEDOUT= 110; { Connection timed out }
+Sys_ECONNREFUSED= 111; { Connection refused }
+Sys_EHOSTDOWN= 112; { Host is down }
+Sys_EHOSTUNREACH= 113; { No route to host }
+Sys_EALREADY= 114; { Operation already in progress }
+Sys_EINPROGRESS= 115; { Operation now in progress }
+Sys_ESTALE = 116; { Stale NFS file handle }
+Sys_EUCLEAN = 117; { Structure needs cleaning }
+Sys_ENOTNAM = 118; { Not a XENIX named type file }
+Sys_ENAVAIL = 119; { No XENIX semaphores available }
+Sys_EISNAM = 120; { Is a named type file }
+Sys_EREMOTEIO= 121; { Remote I/O error }
+Sys_EDQUOT = 122; { Quota exceeded }
+
+
+{ This value was suggested by Daniel
+ based on infos from www.linuxassembly.org }
+
+Sys_ERROR_MAX = $fff;
+
+{$packrecords C}
+
+{********************
+ Signal
+********************}
+type
+ SigSet = Longint;
+ PSigSet = ^SigSet;
+
+Const
+ { For sending a signal }
+ SA_NOCLDSTOP = 1;
+ SA_SHIRQ = $04000000;
+ SA_STACK = $08000000;
+ SA_RESTART = $10000000;
+ SA_INTERRUPT = $20000000;
+ SA_NOMASK = $40000000;
+ SA_ONESHOT = $80000000;
+ SA_ONSTACK = SA_STACK;
+
+ SIG_BLOCK = 0;
+ SIG_UNBLOCK = 1;
+ SIG_SETMASK = 2;
+
+ SIG_DFL = 0 ;
+ SIG_IGN = 1 ;
+ SIG_ERR = -1 ;
+
+ SIGHUP = 1;
+ SIGINT = 2;
+ SIGQUIT = 3;
+ SIGILL = 4;
+ SIGTRAP = 5;
+ SIGABRT = 6;
+ SIGIOT = 6;
+ SIGBUS = 7;
+ SIGFPE = 8;
+ SIGKILL = 9;
+ SIGUSR1 = 10;
+ SIGSEGV = 11;
+ SIGUSR2 = 12;
+ SIGPIPE = 13;
+ SIGALRM = 14;
+ SIGTerm = 15;
+ SIGSTKFLT = 16;
+ SIGCHLD = 17;
+ SIGCONT = 18;
+ SIGSTOP = 19;
+ SIGTSTP = 20;
+ SIGTTIN = 21;
+ SIGTTOU = 22;
+ SIGURG = 23;
+ SIGXCPU = 24;
+ SIGXFSZ = 25;
+ SIGVTALRM = 26;
+ SIGPROF = 27;
+ SIGWINCH = 28;
+ SIGIO = 29;
+ SIGPOLL = SIGIO;
+ SIGPWR = 30;
+ SIGUNUSED = 31;
+
+
+const
+ SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
+
+type
+ Size_T = cardinal;
+
+ tfpreg = record
+ significand: array[0..3] of word;
+ exponent: word;
+ end;
+
+ pfpstate = ^tfpstate;
+ tfpstate = record
+ cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
+ st: array[0..7] of tfpreg;
+ status: cardinal;
+ end;
+
+ PSigContextRec = ^SigContextRec;
+ SigContextRec = record
+ gs, __gsh: word;
+ fs, __fsh: word;
+ es, __esh: word;
+ ds, __dsh: word;
+ edi: cardinal;
+ esi: cardinal;
+ ebp: cardinal;
+ esp: cardinal;
+ ebx: cardinal;
+ edx: cardinal;
+ ecx: cardinal;
+ eax: cardinal;
+ trapno: cardinal;
+ err: cardinal;
+ eip: cardinal;
+ cs, __csh: word;
+ eflags: cardinal;
+ esp_at_signal: cardinal;
+ ss, __ssh: word;
+ fpstate: pfpstate;
+ oldmask: cardinal;
+ cr2: cardinal;
+ end;
+
+(*
+ PSigInfoRec = ^SigInfoRec;
+ SigInfoRec = record
+ si_signo: longint;
+ si_errno: longint;
+ si_code: longint;
+
+ case longint of
+ 0:
+ (pad: array[SI_PAD_SIZE] of longint);
+ 1: { kill }
+ ( kill: record
+ pid: longint; { sender's pid }
+ uid : longint; { sender's uid }
+ end );
+ 2: { POSIX.1b timers }
+ ( timer : record
+ timer1 : cardinal;
+ timer2 : cardinal;
+ end );
+ 3: { POSIX.1b signals }
+ ( rt : record
+ pid : longint; { sender's pid }
+ uid : longint; { sender's uid }
+ sigval : longint;
+ end );
+ 4: { SIGCHLD }
+ ( sigchld : record
+ pid : longint; { which child }
+ uid : longint; { sender's uid }
+ status : longint; { exit code }
+ utime : timeval;
+ stime : timeval;
+ end );
+ 5: { SIGILL, SIGFPE, SIGSEGV, SIGBUS }
+ ( sigfault : record
+ addr : pointer;{ faulting insn/memory ref. }
+ end );
+ 6:
+ ( sigpoll : record
+ band : longint; { POLL_IN, POLL_OUT, POLL_MSG }
+ fd : longint;
+ end );
+ end;
+*)
+
+ SignalHandler = Procedure(Sig : Longint);cdecl;
+ PSignalHandler = ^SignalHandler;
+ SignalRestorer = Procedure;cdecl;
+ PSignalRestorer = ^SignalRestorer;
+ TSigAction = procedure(Sig: Longint; SigContext: SigContextRec);cdecl;
+
+ SigActionRec = packed record
+ Handler : record
+ case byte of
+ 0: (Sh: SignalHandler);
+ 1: (Sa: TSigAction);
+ end;
+ Sa_Mask : SigSet;
+ Sa_Flags : Longint;
+ Sa_restorer : SignalRestorer; { Obsolete - Don't use }
+ end;
+ PSigActionRec = ^SigActionRec;
+
+const
+ SS_ONSTACK = 1;
+ SS_DISABLE = 2;
+ MINSIGSTKSZ = 2048;
+ SIGSTKSZ = 8192;
+
+type
+ SigAltStack = record
+ ss_sp : pointer;
+ ss_flags : longint;
+ ss_size : size_t;
+ end;
+
+ stack_t = sigaltstack;
+
+ PSigAltStack = ^SigAltStack;
+
+ pstack_t = ^stack_t;
+
+var
+ ErrNo,
+ LinuxError : Longint;
+
+
+{********************
+ Process
+********************}
+const
+ {Checked for BSD using Linuxthreads port}
+ { cloning flags }
+ CSIGNAL = $000000ff; // signal mask to be sent at exit
+ CLONE_VM = $00000100; // set if VM shared between processes
+ CLONE_FS = $00000200; // set if fs info shared between processes
+ CLONE_FILES = $00000400; // set if open files shared between processes
+ CLONE_SIGHAND = $00000800; // set if signal handlers shared
+ CLONE_PID = $00001000; // set if pid shared
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+
+const
+ { For getting/setting priority }
+ Prio_Process = 0;
+ Prio_PGrp = 1;
+ Prio_User = 2;
+
+{$ifdef Solaris}
+ WNOHANG = $100;
+ WUNTRACED = $4;
+{$ELSE}
+ WNOHANG = $1;
+ WUNTRACED = $2;
+ __WCLONE = $80000000;
+{$ENDIF}
+
+{********************
+ File
+********************}
+
+Const
+ P_IN = 1;
+ P_OUT = 2;
+
+Const
+ LOCK_SH = 1;
+ LOCK_EX = 2;
+ LOCK_UN = 8;
+ LOCK_NB = 4;
+
+
+Type
+ Tpipe = array[1..2] of longint;
+
+ pglob = ^tglob;
+ tglob = record
+ name : pchar;
+ next : pglob;
+ end;
+
+ ComStr = String[255];
+ PathStr = String[255];
+ DirStr = String[255];
+ NameStr = String[255];
+ ExtStr = String[255];
+
+const
+
+ { For testing access rights }
+ R_OK = 4;
+ W_OK = 2;
+ X_OK = 1;
+ F_OK = 0;
+
+{$ifndef newreaddir}
+ { For File control mechanism }
+ F_GetFd = 1;
+ F_SetFd = 2;
+ F_GetFl = 3;
+ F_SetFl = 4;
+
+{$ifdef Solaris}
+ F_DupFd = 0;
+ F_Dup2Fd = 9;
+ F_GetOwn = 23;
+ F_SetOwn = 24;
+ F_GetLk = 14;
+ F_SetLk = 6;
+ F_SetLkW = 7;
+ F_FreeSp = 11;
+{$else}
+ F_GetLk = 5;
+ F_SetLk = 6;
+ F_SetLkW = 7;
+ F_SetOwn = 8;
+ F_GetOwn = 9;
+{$endif}
+{$endif}
+
+{********************
+ IOCtl(TermIOS)
+********************}
+
+{Is too freebsd/Linux specific}
+
+{********************
+ IOCtl(TermIOS)
+********************}
+
+Const
+ { Amount of Control Chars }
+ NCCS = 32;
+ NCC = 8;
+
+{$Ifndef BSD}
+ { For Terminal handling }
+ TCGETS = $5401;
+ TCSETS = $5402;
+ TCSETSW = $5403;
+ TCSETSF = $5404;
+ TCGETA = $5405;
+ TCSETA = $5406;
+ TCSETAW = $5407;
+ TCSETAF = $5408;
+ TCSBRK = $5409;
+ TCXONC = $540A;
+ TCFLSH = $540B;
+ TIOCEXCL = $540C;
+ TIOCNXCL = $540D;
+ TIOCSCTTY = $540E;
+ TIOCGPGRP = $540F;
+ TIOCSPGRP = $5410;
+ TIOCOUTQ = $5411;
+ TIOCSTI = $5412;
+ TIOCGWINSZ = $5413;
+ TIOCSWINSZ = $5414;
+ TIOCMGET = $5415;
+ TIOCMBIS = $5416;
+ TIOCMBIC = $5417;
+ TIOCMSET = $5418;
+ TIOCGSOFTCAR = $5419;
+ TIOCSSOFTCAR = $541A;
+ FIONREAD = $541B;
+ TIOCINQ = FIONREAD;
+ TIOCLINUX = $541C;
+ TIOCCONS = $541D;
+ TIOCGSERIAL = $541E;
+ TIOCSSERIAL = $541F;
+ TIOCPKT = $5420;
+ FIONBIO = $5421;
+ TIOCNOTTY = $5422;
+ TIOCSETD = $5423;
+ TIOCGETD = $5424;
+ TCSBRKP = $5425;
+ TIOCTTYGSTRUCT = $5426;
+ FIONCLEX = $5450;
+ FIOCLEX = $5451;
+ FIOASYNC = $5452;
+ TIOCSERCONFIG = $5453;
+ TIOCSERGWILD = $5454;
+ TIOCSERSWILD = $5455;
+ TIOCGLCKTRMIOS = $5456;
+ TIOCSLCKTRMIOS = $5457;
+ TIOCSERGSTRUCT = $5458;
+ TIOCSERGETLSR = $5459;
+ TIOCSERGETMULTI = $545A;
+ TIOCSERSETMULTI = $545B;
+
+ TIOCMIWAIT = $545C;
+ TIOCGICOUNT = $545D;
+ TIOCPKT_DATA = 0;
+ TIOCPKT_FLUSHREAD = 1;
+ TIOCPKT_FLUSHWRITE = 2;
+ TIOCPKT_STOP = 4;
+ TIOCPKT_START = 8;
+ TIOCPKT_NOSTOP = 16;
+ TIOCPKT_DOSTOP = 32;
+{$else}
+
+{$endif}
+Type
+ winsize = packed record
+ ws_row,
+ ws_col,
+ ws_xpixel,
+ ws_ypixel : word;
+ end;
+ TWinSize=winsize;
+
+ Termio = packed record
+ c_iflag, { input mode flags }
+ c_oflag, { output mode flags }
+ c_cflag, { control mode flags }
+ c_lflag : Word; { local mode flags }
+ c_line : Word; { line discipline - careful, only High byte in use}
+ c_cc : array [0..NCC-1] of char;{ control characters }
+ end;
+ TTermio=Termio;
+
+{$PACKRECORDS C}
+ Termios = record
+ c_iflag,
+ c_oflag,
+ c_cflag,
+ c_lflag : Cardinal;
+ c_line : char;
+ c_cc : array[0..NCCS-1] of byte;
+ c_ispeed,
+ c_ospeed : longint;
+ end;
+ TTermios=Termios;
+{$PACKRECORDS Default}
+
+
+{const
+ InitCC:array[0..NCCS-1] of byte=(3,34,177,25,4,0,1,0,21,23,32,0,22,17,27,26,0,0,0);}
+
+const
+{c_cc characters}
+ VINTR = 0;
+ VQUIT = 1;
+ VERASE = 2;
+ VKILL = 3;
+ VEOF = 4;
+ VTIME = 5;
+ VMIN = 6;
+ VSWTC = 7;
+ VSTART = 8;
+ VSTOP = 9;
+ VSUSP = 10;
+ VEOL = 11;
+ VREPRINT = 12;
+ VDISCARD = 13;
+ VWERASE = 14;
+ VLNEXT = 15;
+ VEOL2 = 16;
+
+{c_iflag bits}
+ IGNBRK = $0000001;
+ BRKINT = $0000002;
+ IGNPAR = $0000004;
+ PARMRK = $0000008;
+ INPCK = $0000010;
+ ISTRIP = $0000020;
+ INLCR = $0000040;
+ IGNCR = $0000080;
+ ICRNL = $0000100;
+ IUCLC = $0000200;
+ IXON = $0000400;
+ IXANY = $0000800;
+ IXOFF = $0001000;
+ IMAXBEL = $0002000;
+
+{c_oflag bits}
+ OPOST = $0000001;
+ OLCUC = $0000002;
+ ONLCR = $0000004;
+ OCRNL = $0000008;
+ ONOCR = $0000010;
+ ONLRET = $0000020;
+ OFILL = $0000040;
+ OFDEL = $0000080;
+ NLDLY = $0000100;
+ NL0 = $0000000;
+ NL1 = $0000100;
+ CRDLY = $0000600;
+ CR0 = $0000000;
+ CR1 = $0000200;
+ CR2 = $0000400;
+ CR3 = $0000600;
+ TABDLY = $0001800;
+ TAB0 = $0000000;
+ TAB1 = $0000800;
+ TAB2 = $0001000;
+ TAB3 = $0001800;
+ XTABS = $0001800;
+ BSDLY = $0002000;
+ BS0 = $0000000;
+ BS1 = $0002000;
+ VTDLY = $0004000;
+ VT0 = $0000000;
+ VT1 = $0004000;
+ FFDLY = $0008000;
+ FF0 = $0000000;
+ FF1 = $0008000;
+
+{c_cflag bits}
+ CBAUD = $000100F;
+ B0 = $0000000;
+ B50 = $0000001;
+ B75 = $0000002;
+ B110 = $0000003;
+ B134 = $0000004;
+ B150 = $0000005;
+ B200 = $0000006;
+ B300 = $0000007;
+ B600 = $0000008;
+ B1200 = $0000009;
+ B1800 = $000000A;
+ B2400 = $000000B;
+ B4800 = $000000C;
+ B9600 = $000000D;
+ B19200 = $000000E;
+ B38400 = $000000F;
+ EXTA = B19200;
+ EXTB = B38400;
+ CSIZE = $0000030;
+ CS5 = $0000000;
+ CS6 = $0000010;
+ CS7 = $0000020;
+ CS8 = $0000030;
+ CSTOPB = $0000040;
+ CREAD = $0000080;
+ PARENB = $0000100;
+ PARODD = $0000200;
+ HUPCL = $0000400;
+ CLOCAL = $0000800;
+ CBAUDEX = $0001000;
+ B57600 = $0001001;
+ B115200 = $0001002;
+ B230400 = $0001003;
+ B460800 = $0001004;
+ CIBAUD = $100F0000;
+ CMSPAR = $40000000;
+ CRTSCTS = $80000000;
+
+{c_lflag bits}
+ ISIG = $0000001;
+ ICANON = $0000002;
+ XCASE = $0000004;
+ ECHO = $0000008;
+ ECHOE = $0000010;
+ ECHOK = $0000020;
+ ECHONL = $0000040;
+ NOFLSH = $0000080;
+ TOSTOP = $0000100;
+ ECHOCTL = $0000200;
+ ECHOPRT = $0000400;
+ ECHOKE = $0000800;
+ FLUSHO = $0001000;
+ PENDIN = $0004000;
+ IEXTEN = $0008000;
+
+{c_line bits}
+ TIOCM_LE = $001;
+ TIOCM_DTR = $002;
+ TIOCM_RTS = $004;
+ TIOCM_ST = $008;
+ TIOCM_SR = $010;
+ TIOCM_CTS = $020;
+ TIOCM_CAR = $040;
+ TIOCM_RNG = $080;
+ TIOCM_DSR = $100;
+ TIOCM_CD = TIOCM_CAR;
+ TIOCM_RI = TIOCM_RNG;
+ TIOCM_OUT1 = $2000;
+ TIOCM_OUT2 = $4000;
+
+{TCSetAttr}
+ TCSANOW = 0;
+ TCSADRAIN = 1;
+ TCSAFLUSH = 2;
+
+{TCFlow}
+ TCOOFF = 0;
+ TCOON = 1;
+ TCIOFF = 2;
+ TCION = 3;
+
+{TCFlush}
+ TCIFLUSH = 0;
+ TCOFLUSH = 1;
+ TCIOFLUSH = 2;
+
+
+
+{********************
+ Info
+********************}
+
+Type
+
+ UTimBuf = packed record{in BSD array[0..1] of timeval, but this is
+ backwards compatible with linux version}
+ actime,
+ modtime
+ : longint;
+ end;
+ UTimeBuf=UTimBuf;
+ TUTimeBuf=UTimeBuf;
+ PUTimeBuf=^UTimeBuf;
+
+ TSysinfo = packed record
+ uptime : longint;
+ loads : array[1..3] of longint;
+ totalram,
+ freeram,
+ sharedram,
+ bufferram,
+ totalswap,
+ freeswap : longint;
+ procs : integer;
+ s : string[18];
+ end;
+ PSysInfo = ^TSysInfo;
+
+{******************************************************************************
+ Procedure/Functions
+******************************************************************************}
+
+Function SysCall(callnr:longint;var regs:SysCallregs):longint;
+
+{**************************
+ Time/Date Handling
+***************************}
+
+var
+ tzdaylight : boolean;
+ tzseconds : longint;
+ tzname : array[boolean] of pchar;
+
+{ timezone support }
+procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
+procedure GetLocalTimezone(timer:longint);
+procedure ReadTimezoneFile(fn:string);
+function GetTimezoneFile:string;
+
+Procedure GetTimeOfDay(var tv:timeval);
+Function GetTimeOfDay:longint;
+Function GetEpochTime: longint;
+Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
+Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
+procedure GetTime(var hour,min,sec,msec,usec:word);
+procedure GetTime(var hour,min,sec,sec100:word);
+procedure GetTime(var hour,min,sec:word);
+Procedure GetDate(Var Year,Month,Day:Word);
+Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
+function SetTime(Hour,Min,Sec:word) : Boolean;
+function SetDate(Year,Month,Day:Word) : Boolean;
+function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
+
+{**************************
+ Process Handling
+***************************}
+
+function CreateShellArgV(const prog:string):ppchar;
+function CreateShellArgV(const prog:Ansistring):ppchar;
+Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
+Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
+Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
+Procedure Execv(const path:pathstr;args:ppchar);
+Procedure Execv(const path: AnsiString;args:ppchar);
+Procedure Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar);
+Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
+Procedure Execl(const Todo: String);
+Procedure Execl(const Todo: Ansistring);
+Procedure Execle(Todo: String;Ep:ppchar);
+Procedure Execle(Todo: AnsiString;Ep:ppchar);
+Procedure Execlp(Todo: string;Ep:ppchar);
+Procedure Execlp(Todo: Ansistring;Ep:ppchar);
+Function Shell(const Command:String):Longint;
+Function Shell(const Command:AnsiString):Longint;
+Function Fork:longint;
+{Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
+function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+Procedure ExitProcess(val:longint);
+Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint; {=>PID (Status Valid), 0 (No Status), -1: Error, special case errno=EINTR }
+Function WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+Procedure Nice(N:integer);
+Function GetPriority(Which,Who:Integer):integer;
+Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
+function WEXITSTATUS(Status: Integer): Integer;
+function WTERMSIG(Status: Integer): Integer;
+function WSTOPSIG(Status: Integer): Integer;
+Function WIFEXITED(Status: Integer): Boolean;
+Function WIFSTOPPED(Status: Integer): Boolean;
+Function WIFSIGNALED(Status: Integer): Boolean;
+Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
+Function W_STOPCODE(Signal: Integer): Integer;
+
+Function GetPid:LongInt;
+Function GetPPid:LongInt;
+Function GetUid:Longint;
+Function GetEUid:Longint;
+Function GetGid:Longint;
+Function GetEGid:Longint;
+
+{**************************
+ File Handling
+***************************}
+
+Function fdOpen(pathname:string;flags:longint):longint;
+Function fdOpen(pathname:string;flags,mode:longint):longint;
+Function fdOpen(pathname:pchar;flags:longint):longint;
+Function fdOpen(pathname:pchar;flags,mode:longint):longint;
+Function fdClose(fd:longint):boolean;
+Function fdRead(fd:longint;var buf;size:longint):longint;
+Function fdWrite(fd:longint;const buf;size:longint):longint;
+Function fdTruncate(fd,size:longint):boolean;
+Function fdSeek (fd,pos,seektype :longint): longint;
+Function fdFlush (fd : Longint) : Boolean;
+Function Link(OldPath,NewPath:pathstr):boolean;
+Function SymLink(OldPath,NewPath:pathstr):boolean;
+Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
+Function ReadLink(name:pathstr):pathstr;
+Function UnLink(Path:pathstr):boolean;
+Function UnLink(Path:pchar):Boolean;
+Function FReName (OldName,NewName : Pchar) : Boolean;
+Function FReName (OldName,NewName : String) : Boolean;
+Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
+Function Chmod(path:pathstr;Newmode:longint):boolean;
+Function Utime(const path:pathstr;utim:utimebuf):boolean;
+Function Access(Path:Pathstr ;mode:integer):boolean;
+Function Umask(Mask:Integer):integer;
+Function Flock (fd,mode : longint) : boolean;
+Function Flock (var T : text;mode : longint) : boolean;
+Function Flock (var F : File;mode : longint) : boolean;
+Function FStat(Path:Pathstr;Var Info:stat):Boolean;
+Function FStat(Fd:longint;Var Info:stat):Boolean;
+Function FStat(var F:Text;Var Info:stat):Boolean;
+Function FStat(var F:File;Var Info:stat):Boolean;
+Function Lstat(Filename: PathStr;var Info:stat):Boolean;
+Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
+Function FSStat(Fd: Longint;Var Info:statfs):Boolean;
+Function Fcntl(Fd:longint;Cmd:longint):longint;
+Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
+Function Fcntl(var Fd:Text;Cmd:longint):longint;
+Procedure Fcntl(var Fd:Text;Cmd:longint;Arg:Longint);
+Function Dup(oldfile:longint;var newfile:longint):Boolean;
+Function Dup(var oldfile,newfile:text):Boolean;
+Function Dup(var oldfile,newfile:file):Boolean;
+Function Dup2(oldfile,newfile:longint):Boolean;
+Function Dup2(var oldfile,newfile:text):Boolean;
+Function Dup2(var oldfile,newfile:file):Boolean;
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
+Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
+Function SelectText(var T:Text;TimeOut :Longint):Longint;
+
+{**************************
+ Directory Handling
+***************************}
+
+{$ifndef newreaddir} {only for FreeBSD, temporary solution}
+
+Function OpenDir(f:pchar):pdir;
+Function OpenDir(f: String):pdir;
+function CloseDir(p:pdir):integer;
+Function ReadDir(p:pdir):pdirent;
+procedure SeekDir(p:pdir;off:longint);
+function TellDir(p:pdir):longint;
+{$else}
+Function OpenDir(name:pchar):pdir;
+Function OpenDir(f: String):pdir;
+function CloseDir(dirp:pdir):integer;
+Function ReadDir(p:pdir):pdirent;
+procedure SeekDir(dirp:pdir;loc:longint);
+function TellDir(dirp:pdir):longint;
+
+{$endif}
+
+{**************************
+ Pipe/Fifo/Stream
+***************************}
+
+Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
+Function AssignPipe(var pipe_in,pipe_out:text):boolean;
+Function AssignPipe(var pipe_in,pipe_out:file):boolean;
+Function PClose(Var F:text) : longint;
+Function PClose(Var F:file) : longint;
+Procedure POpen(var F:text;const Prog:String;rw:char);
+Procedure POpen(var F:file;const Prog:String;rw:char);
+
+Function mkFifo(pathname:string;mode:longint):boolean;
+
+function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
+function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
+
+{**************************
+ General information
+***************************}
+
+Function GetEnv(P:string):Pchar;
+
+Function GetDomainName:String;
+Function GetHostName:String;
+Function Sysinfo(var Info:TSysinfo):Boolean;
+Function Uname(var unamerec:utsname):Boolean;
+{**************************
+ Signal
+***************************}
+
+Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
+Procedure SigProcMask (How:longint;SSet,OldSSet:PSigSet);
+Function SigPending:SigSet;
+Procedure SigSuspend(Mask:Sigset);
+Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
+Function Kill(Pid:longint;Sig:longint):integer;
+Procedure SigRaise(Sig:integer);
+ Function Alarm(Sec : Longint) : longint;
+
+Procedure Pause;
+Function NanoSleep(const req : timespec;var rem : timespec) : longint;
+
+{**************************
+ IOCtl/Termios Functions
+***************************}
+
+Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
+Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
+Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+Procedure CFMakeRaw(var tios:TermIOS);
+Function TCSendBreak(fd,duration:longint):boolean;
+Function TCSetPGrp(fd,id:longint):boolean;
+Function TCGetPGrp(fd:longint;var id:longint):boolean;
+Function TCFlush(fd,qsel:longint):boolean;
+Function TCDrain(fd:longint):boolean;
+Function TCFlow(fd,act:longint):boolean;
+Function IsATTY(Handle:Longint):Boolean;
+Function IsATTY(var f:text):Boolean;
+function TTYname(Handle:Longint):string;
+function TTYname(var F:Text):string;
+
+{**************************
+ Memory functions
+***************************}
+
+const
+ PROT_READ = $1; { page can be read }
+ PROT_WRITE = $2; { page can be written }
+ PROT_EXEC = $4; { page can be executed }
+ PROT_NONE = $0; { page can not be accessed }
+
+ MAP_SHARED = $1; { Share changes }
+// MAP_PRIVATE = $2; { Changes are private }
+ MAP_TYPE = $f; { Mask for type of mapping }
+ MAP_FIXED = $10; { Interpret addr exactly }
+// MAP_ANONYMOUS = $20; { don't use a file }
+
+ MAP_GROWSDOWN = $100; { stack-like segment }
+ MAP_DENYWRITE = $800; { ETXTBSY }
+ MAP_EXECUTABLE = $1000; { mark it as an executable }
+ MAP_LOCKED = $2000; { pages are locked }
+ MAP_NORESERVE = $4000; { don't check for reservations }
+
+type
+ tmmapargs=record
+ address : longint;
+ size : longint;
+ prot : longint;
+ flags : longint;
+ fd : longint;
+ offset : longint;
+ end;
+
+function MMap(const m:tmmapargs):longint;
+function MUnMap (P : Pointer; Size : Longint) : Boolean;
+
+{**************************
+ Port IO functions
+***************************}
+
+Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
+Function IoPL(Level : longint) : Boolean;
+{$ifdef cpui386}
+Procedure WritePort (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePort (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePort (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePortB (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePortW (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePortL (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePortL (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure WritePortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure ReadPort (Port : Longint; Var Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure ReadPort (Port : Longint; Var Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure ReadPort (Port : Longint; Var Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
+function ReadPortB (Port : Longint): Byte;{$ifndef VER1_0}oldfpccall;{$endif}
+function ReadPortW (Port : Longint): Word;{$ifndef VER1_0}oldfpccall;{$endif}
+function ReadPortL (Port : Longint): LongInt;{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{$endif}
+
+{**************************
+ Utility functions
+***************************}
+
+Function Octal(l:longint):longint;
+Function FExpand(Const Path: PathStr):PathStr;
+Function FSearch(const path:pathstr;dirlist:string):pathstr;
+Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+Function Dirname(Const path:pathstr):pathstr;
+Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+Function FNMatch(const Pattern,Name:string):Boolean;
+Function Glob(Const path:pathstr):pglob;
+Procedure Globfree(var p:pglob);
+Function StringToPPChar(Var S:String):ppchar;
+Function StringToPPChar(Var S:AnsiString):ppchar;
+Function StringToPPChar(S : Pchar):ppchar;
+Function GetFS(var T:Text):longint;
+Function GetFS(Var F:File):longint;
+{Filedescriptorsets}
+Procedure FD_Zero(var fds:fdSet);
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+Procedure FD_Set(fd:longint;var fds:fdSet);
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+{Stat.Mode Types}
+Function S_ISLNK(m:word):boolean;
+Function S_ISREG(m:word):boolean;
+Function S_ISDIR(m:word):boolean;
+
+Function S_ISCHR(m:word):boolean;
+Function S_ISBLK(m:word):boolean;
+Function S_ISFIFO(m:word):boolean;
+Function S_ISSOCK(m:word):boolean;
+
+
+{******************************************************************************
+ Implementation
+******************************************************************************}
+
+Implementation
+
+Uses Strings;
+
+{ Get the definitions of textrec and filerec }
+{$i textrec.inc}
+{$i filerec.inc}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+ {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{*****************************************************************************
+ --- Main:The System Call Self ---
+*****************************************************************************}
+
+{$ifdef FPC_PROFILE}
+ {$define PROFILE_WAS_ACTIVE}
+ {$profile off}
+{$else}
+ {$undef PROFILE_WAS_ACTIVE}
+{$endif}
+
+
+Procedure Do_SysCall( callnr:longint;var regs : SysCallregs );{$ifndef ver1_0}oldfpccall;{$endif}assembler;
+{
+ This function puts the registers in place, does the call, and then
+ copies back the registers as they are after the SysCall.
+}
+{$ifdef cpui386}
+{$ASMMODE ATT}
+asm
+{ load the registers... }
+ movl 12(%ebp),%eax
+ movl 4(%eax),%ebx
+ movl 8(%eax),%ecx
+ movl 12(%eax),%edx
+ movl 16(%eax),%esi
+ movl 20(%eax),%edi
+{ set the call number }
+ movl 8(%ebp),%eax
+{ Go ! }
+ int $0x80
+{ Put back the registers... }
+ pushl %eax
+ movl 12(%ebp),%eax
+ movl %edi,20(%eax)
+ movl %esi,16(%eax)
+ movl %edx,12(%eax)
+ movl %ecx,8(%eax)
+ movl %ebx,4(%eax)
+ popl %ebx
+ movl %ebx,(%eax)
+end;
+{$ASMMODE DEFAULT}
+{$else}
+{$ifdef cpum68k}
+asm
+{ load the registers... }
+ move.l 12(a6),a0
+ move.l 4(a0),d1
+ move.l 8(a0),d2
+ move.l 12(a0),d3
+ move.l 16(a0),d4
+ move.l 20(a0),d5
+{ set the call number }
+ move.l 8(a6),d0
+{ Go ! }
+ trap #0
+{ Put back the registers... }
+ move.l d0,-(sp)
+ move.l 12(a6),a0
+ move.l d5,20(a0)
+ move.l d4,16(a0)
+ move.l d3,12(a0)
+ move.l d2,8(a0)
+ move.l d1,4(a0)
+ move.l (sp)+,d1
+ move.l d1,(a0)
+end;
+{$else}
+{$error Cannot decide which processor you have ! define cpui386 or m68k }
+{$endif}
+{$endif}
+
+{$IFDEF SYSCALL_DEBUG}
+Const
+ DoSysCallDebug : Boolean = False;
+
+var
+ LastCnt,
+ LastEax,
+ LastCall : longint;
+ DebugTxt : string[20];
+{$ENDIF}
+Function SysCall( callnr:longint;var regs : SysCallregs ):longint;
+{
+ This function serves as an interface to do_SysCall.
+ If the SysCall returned a negative number, it returns -1, and puts the
+ SysCall result in errno. Otherwise, it returns the SysCall return value
+}
+begin
+ do_SysCall(callnr,regs);
+ if (regs.reg1<0) and (regs.reg1>=-Sys_ERROR_MAX) then
+ begin
+{$IFDEF SYSCALL_DEBUG}
+ If DoSysCallDebug then
+ debugtxt:=' syscall error: ';
+{$endif}
+ ErrNo:=-regs.reg1;
+ SysCall:=-1;
+ end
+ else
+ begin
+{$IFDEF SYSCALL_DEBUG}
+ if DoSysCallDebug then
+ debugtxt:=' syscall returned: ';
+{$endif}
+ SysCall:=regs.reg1;
+ errno:=0
+ end;
+{$IFDEF SYSCALL_DEBUG}
+ if DoSysCallDebug then
+ begin
+ inc(lastcnt);
+ if (callnr<>lastcall) or (regs.reg1<>lasteax) then
+ begin
+ if lastcnt>1 then
+ writeln(sys_nr_txt[lastcall],debugtxt,lasteax,' (',lastcnt,'x)');
+ lastcall:=callnr;
+ lasteax:=regs.reg1;
+ lastcnt:=0;
+ writeln(sys_nr_txt[lastcall],debugtxt,lasteax);
+ end;
+ end;
+{$endif}
+end;
+
+{$ifdef PROFILE_WAS_ACTIVE}
+ {$profile on}
+ {$undef PROFILE_WAS_ACTIVE}
+{$endif}
+
+
+Function Sys_Time:longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=0;
+ Sys_Time:=SysCall(SysCall_nr_time,regs);
+end;
+
+
+{*****************************************************************************
+ --- File:File handling related calls ---
+*****************************************************************************}
+
+
+Function Sys_Open(f:pchar;flags:longint;mode:integer):longint;
+var
+ regs : SysCallregs;
+Begin
+ regs.reg2:=longint(f);
+ regs.reg3:=flags;
+ regs.reg4:=mode;
+ Sys_Open:=SysCall(SysCall_nr_open,regs);
+End;
+
+
+
+Function Sys_Close(f:longint):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=f;
+ Sys_Close:=SysCall(SysCall_nr_close,regs);
+end;
+
+
+
+Function Sys_Lseek(F:longint;Off:longint;Whence:longint):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=f;
+ regs.reg3:=off;
+ regs.reg4:=Whence;
+ Sys_lseek:=SysCall(SysCall_nr_lseek,regs);
+end;
+
+
+
+Function Sys_Read(f:longint;buffer:pchar;count:longint):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=f;
+ regs.reg3:=longint(buffer);
+ regs.reg4:=count;
+ Sys_Read:=SysCall(SysCall_nr_read,regs);
+end;
+
+
+
+Function Sys_Write(f:longint;buffer:pchar;count:longint):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=f;
+ regs.reg3:=longint(buffer);
+ regs.reg4:=count;
+ Sys_Write:=SysCall(SysCall_nr_write,regs);
+end;
+
+
+
+Function Sys_Unlink(Filename:pchar):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(filename);
+ Sys_Unlink:=SysCall(SysCall_nr_unlink,regs);
+end;
+
+
+Function Sys_fstat(fd : longint;var Info:stat):Longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=fd;
+ regs.reg3:=longint(@Info);
+ Sys_fStat:=SysCall(SysCall_nr_fstat,regs);
+end;
+
+
+Function Sys_Rename(Oldname,Newname:pchar):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(oldname);
+ regs.reg3:=longint(newname);
+ Sys_Rename:=SysCall(SysCall_nr_rename,regs);
+end;
+
+
+
+Function Sys_Stat(Filename:pchar;var Buffer: stat):longint;
+{
+ We need this for getcwd
+}
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(filename);
+ regs.reg3:=longint(@buffer);
+ Sys_Stat:=SysCall(SysCall_nr_stat,regs);
+end;
+
+
+Function Sys_Symlink(oldname,newname:pchar):longint;
+{
+ We need this for erase
+}
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(oldname);
+ regs.reg3:=longint(newname);
+ Sys_symlink:=SysCall(SysCall_nr_symlink,regs);
+end;
+
+
+Function Sys_ReadLink(name,linkname:pchar;maxlen:longint):longint;
+var
+ regs : SysCallRegs;
+begin
+ regs.reg2:=longint(name);
+ regs.reg3:=longint(linkname);
+ regs.reg4:=maxlen;
+ Sys_ReadLink:=SysCall(Syscall_nr_readlink,regs);
+end;
+
+
+{*****************************************************************************
+ --- Directory:Directory related calls ---
+*****************************************************************************}
+
+
+Function Sys_Chdir(Filename:pchar):longint;
+var
+ regs : SysCallregs;
+
+begin
+ regs.reg2:=longint(filename);
+ Sys_ChDir:=SysCall(SysCall_nr_chdir,regs);
+end;
+
+
+
+Function Sys_Mkdir(Filename:pchar;mode:longint):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(filename);
+ regs.reg3:=mode;
+ Sys_MkDir:=SysCall(SysCall_nr_mkdir,regs);
+end;
+
+
+
+Function Sys_Rmdir(Filename:pchar):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(filename);
+ Sys_Rmdir:=SysCall(SysCall_nr_rmdir,regs);
+end;
+
+
+
+{ we need this for getcwd }
+Function OpenDir(f:pchar):pdir;
+var
+ fd:integer;
+ st:stat;
+ ptr:pdir;
+begin
+ opendir:=nil;
+ if sys_stat(f,st)<0 then
+ exit;
+{ Is it a dir ? }
+ if not((st.mode and $f000)=$4000)then
+ begin
+ errno:=sys_enotdir;
+ exit
+ end;
+{ Open it}
+ fd:=sys_open(f,OPEN_RDONLY,438);
+ if fd<0 then
+ exit;
+ new(ptr);
+ if ptr=nil then
+ exit;
+ new(ptr^.buf);
+ if ptr^.buf=nil then
+ exit;
+ ptr^.fd:=fd;
+ ptr^.loc:=0;
+ ptr^.size:=0;
+ ptr^.dd_max:=sizeof(ptr^.buf^);
+ opendir:=ptr;
+end;
+
+
+
+function CloseDir(p:pdir):integer;
+begin
+ closedir:=sys_close(p^.fd);
+ dispose(p^.buf);
+ dispose(p);
+end;
+
+
+
+Function Sys_ReadDir(p:pdir):pdirent;
+var
+ regs :SysCallregs;
+ dummy:longint;
+begin
+ regs.reg3:=longint(p^.buf);
+ regs.reg2:=p^.fd;
+ regs.reg4:=1;
+ dummy:=SysCall(SysCall_nr_readdir,regs);
+{ the readdir system call returns the number of bytes written }
+ if dummy=0 then
+ sys_readdir:=nil
+ else
+ sys_readdir:=p^.buf
+end;
+
+
+{*****************************************************************************
+ --- Process:Process & program handling - related calls ---
+*****************************************************************************}
+
+Function Sys_GetPid:LongInt;
+var
+ regs : SysCallregs;
+begin
+ Sys_GetPid:=SysCall(SysCall_nr_getpid,regs);
+end;
+
+
+Procedure Sys_Exit(ExitCode:Integer);
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=exitcode;
+ SysCall(SysCall_nr_exit,regs)
+end;
+
+Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
+{
+ Change action of process upon receipt of a signal.
+ Signum specifies the signal (all except SigKill and SigStop).
+ If Act is non-nil, it is used to specify the new action.
+ If OldAct is non-nil the previous action is saved there.
+}
+Var
+ sr : Syscallregs;
+begin
+ sr.reg2:=Signum;
+ sr.reg3:=Longint(act);
+ sr.reg4:=Longint(oldact);
+ SysCall(Syscall_nr_sigaction,sr);
+end;
+
+function Sys_FTruncate(Handle,Pos:longint):longint; //moved from sysunix.inc Do_Truncate
+var
+ sr : syscallregs;
+begin
+ sr.reg2:=Handle;
+ sr.reg3:=Pos;
+ Sys_FTruncate:=syscall(syscall_nr_ftruncate,sr);
+end;
+
+Function Sys_mmap(adr,len,prot,flags,fdes,off:longint):longint; // moved from sysunix.inc, used in sbrk
+type
+ tmmapargs=packed record
+ address : longint;
+ size : longint;
+ prot : longint;
+ flags : longint;
+ fd : longint;
+ offset : longint;
+ end;
+var
+ t : syscallregs;
+ mmapargs : tmmapargs;
+begin
+ mmapargs.address:=adr;
+ mmapargs.size:=len;
+ mmapargs.prot:=prot;
+ mmapargs.flags:=flags;
+ mmapargs.fd:=fdes;
+ mmapargs.offset:=off;
+ t.reg2:=longint(@mmapargs);
+ do_syscall(syscall_nr_mmap,t);
+ Sys_mmap:=t.reg1;
+ if t.reg1=-1 then
+ errno:=-1;
+end;
+
+{
+ Interface to Unix ioctl call.
+ Performs various operations on the filedescriptor Handle.
+ Ndx describes the operation to perform.
+ Data points to data needed for the Ndx function. The structure of this
+ data is function-dependent.
+}
+Function Sys_IOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; // This was missing here, instead hardcode in Do_IsDevice
+var
+ sr: SysCallRegs;
+begin
+ sr.reg2:=Handle;
+ sr.reg3:=Ndx;
+ sr.reg4:=Longint(Data);
+ Sys_IOCtl:=SysCall(Syscall_nr_ioctl,sr);
+end;
+
+
+Function Sys_SigAltStack(ss, oss :psigaltstack):longint;
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(ss);
+ regs.reg3:=longint(oss);
+ sys_sigaltstack:=SysCall(syscall_nr_sigaltstack,regs);
+end;
+
+Function Fork:longint;
+{
+ This function issues the 'fork' System call. the program is duplicated in memory
+ and Execution continues in parent and child process.
+ In the parent process, fork returns the PID of the child. In the child process,
+ zero is returned.
+ A negative value indicates that an error has occurred, the error is returned in
+ LinuxError.
+}
+var
+ regs:SysCallregs;
+begin
+ Fork:=SysCall(SysCall_nr_fork,regs);
+ LinuxError:=Errno;
+End;
+
+
+function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+begin
+ if (pointer(func)=nil) or (sp=nil) then
+ begin
+ LinuxError:=Sys_EInval;
+ exit(-1); // give an error result
+ end;
+{$ifdef cpui386}
+{$ASMMODE ATT}
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ movl flags,%ebx
+ movl SysCall_nr_clone,%eax
+ int $0x80
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+{$endif cpui386}
+{$ifdef cpum68k}
+ { No yet translated, my m68k assembler is too weak for such things PM }
+(*
+ asm
+ { Insert the argument onto the new stack. }
+ movl sp,%ecx
+ subl $8,%ecx
+ movl args,%eax
+ movl %eax,4(%ecx)
+
+ { Save the function pointer as the zeroth argument.
+ It will be popped off in the child in the ebx frobbing below. }
+ movl func,%eax
+ movl %eax,0(%ecx)
+
+ { Do the system call }
+ pushl %ebx
+ movl flags,%ebx
+ movl SysCall_nr_clone,%eax
+ int $0x80
+ popl %ebx
+ test %eax,%eax
+ jnz .Lclone_end
+
+ { We're in the new thread }
+ subl %ebp,%ebp { terminate the stack frame }
+ call *%ebx
+ { exit process }
+ movl %eax,%ebx
+ movl $1,%eax
+ int $0x80
+
+.Lclone_end:
+ movl %eax,__RESULT
+ end;
+ *)
+{$endif cpum68k}
+end;
+
+
+Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ environment specified in ep is passed on.
+}
+var
+ regs:SysCallregs;
+begin
+ path:=path+#0;
+ regs.reg2:=longint(@path[1]);
+ regs.reg3:=longint(args);
+ regs.reg4:=longint(ep);
+ SysCall(SysCall_nr_Execve,regs);
+{ This only gets set when the call fails, otherwise we don't get here ! }
+ Linuxerror:=errno;
+end;
+
+
+Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ environment specified in ep is passed on.
+}
+var
+ regs:SysCallregs;
+begin
+ regs.reg2:=longint(path);
+ regs.reg3:=longint(args);
+ regs.reg4:=longint(ep);
+ SysCall(SysCall_nr_Execve,regs);
+{ This only gets set when the call fails, otherwise we don't get here ! }
+ Linuxerror:=errno;
+end;
+
+Procedure ExitProcess(val:longint);
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=val;
+ SysCall(SysCall_nr_exit,regs);
+end;
+
+
+Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;
+{
+ Waits until a child with PID Pid exits, or returns if it is exited already.
+ Any resources used by the child are freed.
+ The exit status is reported in the adress referred to by Status. It should
+ be a longint.
+}
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=pid;
+ regs.reg3:=longint(status);
+ regs.reg4:=options;
+ WaitPid:=SysCall(SysCall_nr_waitpid,regs);
+ LinuxError:=errno;
+end;
+
+
+Procedure GetTimeOfDay(var tv:timeval);
+{
+ Get the number of seconds since 00:00, January 1 1970, GMT
+ the time NOT corrected any way
+}
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(@tv);
+ regs.reg3:=0;
+ SysCall(SysCall_nr_gettimeofday,regs);
+ LinuxError:=Errno;
+end;
+
+Function GetPriority(Which,Who:Integer):integer;
+{
+ Get Priority of process, process group, or user.
+ Which : selects what kind of priority is used.
+ can be one of the following predefined Constants :
+ Prio_User.
+ Prio_PGrp.
+ Prio_Process.
+ Who : depending on which, this is , respectively :
+ Uid
+ Pid
+ Process Group id
+ Errors are reported in linuxerror _only_. (priority can be negative)
+}
+var
+ sr : Syscallregs;
+begin
+ errno:=0;
+ if (which<prio_process) or (which>prio_user) then
+ begin
+ { We can save an interrupt here }
+ getpriority:=0;
+ linuxerror:=Sys_einval;
+ end
+ else
+ begin
+ sr.reg2:=which;
+ sr.reg3:=who;
+ getpriority:=SysCall(Syscall_nr_getpriority,sr);
+ linuxerror:=errno;
+ end;
+end;
+
+
+
+Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
+{
+ Set Priority of process, process group, or user.
+ Which : selects what kind of priority is used.
+ can be one of the following predefined Constants :
+ Prio_User.
+ Prio_PGrp.
+ Prio_Process.
+ Who : depending on value of which, this is, respectively :
+ Uid
+ Pid
+ Process Group id
+ what : A number between -20 and 20. -20 is most favorable, 20 least.
+ 0 is the default.
+}
+var
+ sr : Syscallregs;
+begin
+ errno:=0;
+ if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
+ linuxerror:=Sys_einval { We can save an interrupt here }
+ else
+ begin
+ sr.reg2:=which;
+ sr.reg3:=who;
+ sr.reg4:=what;
+ SysCall(Syscall_nr_setpriority,sr);
+ linuxerror:=errno;
+ end;
+end;
+
+
+Procedure Nice(N:integer);
+{
+ Set process priority. A positive N means a lower priority.
+ A negative N decreases priority.
+}
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=n;
+ SysCall(Syscall_nr_nice,sr);
+ linuxerror:=errno;
+end;
+
+
+
+Function GetPid:LongInt;
+{
+ Get Process ID.
+}
+var
+ regs : SysCallregs;
+begin
+ GetPid:=SysCall(SysCall_nr_getpid,regs);
+ linuxerror:=errno;
+end;
+
+
+
+Function GetPPid:LongInt;
+{
+ Get Process ID of parent process.
+}
+var
+ regs : SysCallregs;
+begin
+ GetPpid:=SysCall(SysCall_nr_getppid,regs);
+ linuxerror:=errno;
+end;
+
+
+
+Function GetUid:Longint;
+{
+ Get User ID.
+}
+var
+ regs : SysCallregs;
+begin
+ GetUid:=SysCall(SysCall_nr_getuid,regs);
+ Linuxerror:=errno;
+end;
+
+
+
+Function GetEUid:Longint;
+{
+ Get _effective_ User ID.
+}
+var
+ regs : SysCallregs;
+begin
+ GetEuid:=SysCall(SysCall_nr_geteuid,regs);
+ Linuxerror:=errno;
+end;
+
+
+
+Function GetGid:Longint;
+{
+ Get Group ID.
+}
+var
+ regs : SysCallregs;
+begin
+ Getgid:=SysCall(SysCall_nr_getgid,regs);
+ Linuxerror:=errno;
+end;
+
+
+
+Function GetEGid:Longint;
+{
+ Get _effective_ Group ID.
+}
+var
+ regs : SysCallregs;
+begin
+ GetEgid:=SysCall(SysCall_nr_getegid,regs);
+ Linuxerror:=errno;
+end;
+
+
+Function GetTimeOfDay: longint;
+{
+ Get the number of seconds since 00:00, January 1 1970, GMT
+ the time NOT corrected any way
+}
+var
+ regs : SysCallregs;
+ tv : timeval;
+begin
+ regs.reg2:=longint(@tv);
+ regs.reg3:=0;
+ SysCall(SysCall_nr_gettimeofday,regs);
+ LinuxError:=Errno;
+ GetTimeOfDay:=tv.sec;
+end;
+
+
+Function fdTruncate(fd,size:longint):boolean;
+var
+ Regs : SysCallRegs;
+begin
+ Regs.reg2:=fd;
+ Regs.reg3:=size;
+ fdTruncate:=(SysCall(Syscall_nr_ftruncate,regs)=0);
+ LinuxError:=Errno;
+end;
+
+
+
+Function fdFlush (fd : Longint) : Boolean;
+var
+ SR: SysCallRegs;
+begin
+ SR.reg2 := fd;
+ fdFlush := (SysCall(syscall_nr_fsync, SR)=0);
+ LinuxError:=Errno;
+end;
+
+
+
+Function Fcntl(Fd:longint;Cmd:longint): longint;
+{
+ Read or manipulate a file.(See also fcntl (2) )
+ Possible values for Cmd are :
+ F_GetFd,F_GetFl,F_GetOwn
+ Errors are reported in Linuxerror;
+ If Cmd is different from the allowed values, linuxerror=Sys_eninval.
+}
+var
+ sr : Syscallregs;
+begin
+ if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
+ begin
+ sr.reg2:=Fd;
+ sr.reg3:=cmd;
+ Linuxerror:=SysCall(Syscall_nr_fcntl,sr);
+ if linuxerror=-1 then
+ begin
+ linuxerror:=errno;
+ fcntl:=0;
+ end
+ else
+ begin
+ fcntl:=linuxerror;
+ linuxerror:=0;
+ end;
+ end
+ else
+ begin
+ linuxerror:=Sys_einval;
+ Fcntl:=0;
+ end;
+end;
+
+
+
+Procedure Fcntl(Fd:longint;Cmd:LongInt;Arg:Longint);
+{
+ Read or manipulate a file. (See also fcntl (2) )
+ Possible values for Cmd are :
+ F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
+ Errors are reported in Linuxerror;
+ If Cmd is different from the allowed values, linuxerror=Sys_eninval.
+ F_DupFD is not allowed, due to the structure of Files in Pascal.
+}
+var
+ sr : Syscallregs;
+begin
+ if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
+ begin
+ sr.reg2:=Fd;
+ sr.reg3:=cmd;
+ sr.reg4:=arg;
+ SysCall(Syscall_nr_fcntl,sr);
+ linuxerror:=errno;
+ end
+ else
+ linuxerror:=Sys_einval;
+end;
+
+
+Function Chmod(path:pathstr;Newmode:longint):Boolean;
+{
+ Changes the permissions of a file.
+}
+var
+ sr : Syscallregs;
+begin
+ path:=path+#0;
+ sr.reg2:=longint(@(path[1]));
+ sr.reg3:=newmode;
+ Chmod:=(SysCall(Syscall_nr_chmod,sr)=0);
+ linuxerror:=errno;
+end;
+
+
+
+Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
+{
+ Change the owner and group of a file.
+ A user can only change the group to a group of which he is a member.
+ The super-user can change uid and gid of any file.
+}
+var
+ sr : Syscallregs;
+begin
+ path:=path+#0;
+ sr.reg2:=longint(@(path[1]));
+ sr.reg3:=newuid;
+ sr.reg4:=newgid;
+ ChOwn:=(Syscall(Syscall_nr_chown,sr)=0);
+ linuxerror:=errno;
+end;
+
+
+
+Function Utime(const path:pathstr;utim:utimebuf):boolean;
+var
+ sr : Syscallregs;
+ buf : pathstr;
+begin
+ buf:=path+#0;
+ sr.reg2:=longint(@(buf[1]));
+ sr.reg3:=longint(@utim);
+ Utime:=SysCall(Syscall_nr_utime,sr)=0;
+ linuxerror:=errno;
+end;
+
+
+
+Function Flock (fd,mode : longint) : boolean;
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=fd;
+ sr.reg3:=mode;
+ flock:=Syscall(Syscall_nr_flock,sr)=0;
+ LinuxError:=errno;
+end;
+
+
+
+Function Fstat(Fd:Longint;var Info:stat):Boolean;
+{
+ Get all information on a file descriptor, and return it in info.
+}
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=Fd;
+ regs.reg3:=longint(@Info);
+ FStat:=(SysCall(SysCall_nr_fstat,regs)=0);
+ LinuxError:=Errno;
+end;
+
+
+Function Lstat(Filename: PathStr;var Info:stat):Boolean;
+{
+ Get all information on a link (the link itself), and return it in info.
+}
+var
+ regs : SysCallregs;
+begin
+ FileName:=FileName+#0;
+ regs.reg2:=longint(@filename[1]);
+ regs.reg3:=longint(@Info);
+ LStat:=(SysCall(SysCall_nr_lstat,regs)=0);
+ LinuxError:=Errno;
+end;
+
+
+
+Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Path is the name of a file/directory on the fileSystem you wish to
+ investigate.
+}
+var
+ regs : SysCallregs;
+begin
+ path:=path+#0;
+ regs.reg2:=longint(@path[1]);
+ regs.reg3:=longint(@Info);
+ FSStat:=(SysCall(SysCall_nr_statfs,regs)=0);
+ LinuxError:=errno;
+end;
+
+
+
+Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
+{
+ Get all information on a fileSystem, and return it in Info.
+ Fd is the file descriptor of a file/directory on the fileSystem
+ you wish to investigate.
+}
+var
+ regs : SysCallregs;
+begin
+ regs.reg2:=Fd;
+ regs.reg3:=longint(@Info);
+ FSStat:=(SysCall(SysCall_nr_fstatfs,regs)=0);
+ LinuxError:=errno;
+end;
+
+
+
+Function Link(OldPath,NewPath:pathstr):boolean;
+{
+ Proceduces a hard link from new to old.
+ In effect, new will be the same file as old.
+}
+var
+ regs : SysCallregs;
+begin
+ oldpath:=oldpath+#0;
+ newpath:=newpath+#0;
+ regs.reg2:=longint(@oldpath[1]);
+ regs.reg3:=longint(@newpath[1]);
+ Link:=SysCall(SysCall_nr_link,regs)=0;
+ linuxerror:=errno;
+end;
+
+
+
+
+Function Umask(Mask:Integer):integer;
+{
+ Sets file creation mask to (Mask and 0777 (octal) ), and returns the
+ previous value.
+}
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=mask;
+ Umask:=SysCall(Syscall_nr_umask,sr);
+ linuxerror:=0;
+end;
+
+
+
+Function Access(Path:Pathstr ;mode:integer):boolean;
+{
+ Test users access rights on the specified file.
+ Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+ R,W,X stand for read,write and Execute access, simultaneously.
+ F_OK checks whether the test would be allowed on the file.
+ i.e. It checks the search permissions in all directory components
+ of the path.
+ The test is done with the real user-ID, instead of the effective.
+ If access is denied, or an error occurred, false is returned.
+ If access is granted, true is returned.
+ Errors other than no access,are reported in linuxerror.
+}
+var
+ sr : Syscallregs;
+begin
+ path:=path+#0;
+ sr.reg2:=longint(@(path[1]));
+ sr.reg3:=mode;
+ access:=(SysCall(Syscall_nr_access,sr)=0);
+ linuxerror:=errno;
+end;
+
+
+Function Dup(oldfile:longint;var newfile:longint):Boolean;
+{
+ Copies the filedescriptor oldfile to newfile
+}
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=oldfile;
+ newfile:=Syscall(Syscall_nr_dup,sr);
+ linuxerror:=errno;
+ Dup:=(LinuxError=0);
+end;
+
+
+Function Dup2(oldfile,newfile:longint):Boolean;
+{
+ Copies the filedescriptor oldfile to newfile
+}
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=oldfile;
+ sr.reg3:=newfile;
+ SysCall(Syscall_nr_dup2,sr);
+ linuxerror:=errno;
+ Dup2:=(LinuxError=0);
+end;
+
+
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
+{
+ Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+ have changed.
+}
+Var
+ SelectArray : Array[1..5] of longint;
+ Sr : Syscallregs;
+begin
+ SelectArray[1]:=n;
+ SelectArray[2]:=longint(Readfds);
+ Selectarray[3]:=longint(Writefds);
+ selectarray[4]:=longint(exceptfds);
+ Selectarray[5]:=longint(TimeOut);
+ sr.reg2:=longint(@selectarray);
+ Select:=SysCall(Syscall_nr_select,sr);
+ LinuxError:=Errno;
+end;
+
+
+
+Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ pip : tpipe;
+ regs : SysCallregs;
+begin
+ regs.reg2:=longint(@pip);
+ SysCall(SysCall_nr_pipe,regs);
+ pipe_in:=pip[1];
+ pipe_out:=pip[2];
+ linuxerror:=errno;
+ AssignPipe:=(LinuxError=0);
+end;
+
+
+
+
+Function PClose(Var F:text) :longint;
+var
+ sr : syscallregs;
+ pl : ^longint;
+ res : longint;
+begin
+ sr.reg2:=Textrec(F).Handle;
+ SysCall (syscall_nr_close,sr);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(textrec(f).userdata[2]);
+ waitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+
+Function PClose(Var F:file) : longint;
+var
+ sr : syscallregs;
+ pl : ^longint;
+ res : longint;
+begin
+ sr.reg2:=FileRec(F).Handle;
+ SysCall (Syscall_nr_close,sr);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+ pl:=@(filerec(f).userdata[2]);
+ waitpid(pl^,@res,0);
+ pclose:=res shr 8;
+end;
+
+
+Function Sysinfo(var Info:TSysinfo):Boolean;
+{
+ Get system info
+}
+var
+ regs : SysCallregs;
+Begin
+ regs.reg2:=longint(@info);
+ Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
+End;
+
+Function mkFifo(pathname:string;mode:longint):boolean;
+var
+ regs : SysCallRegs;
+begin
+ pathname:=pathname+#0;
+ regs.reg2:=longint(@pathname[1]);
+ regs.reg3:=mode or STAT_IFIFO;
+ regs.reg4:=0;
+ mkFifo:=(SysCall(syscall_nr_mknod,regs)=0);
+end;
+
+
+
+
+Function Uname(var unamerec:utsname):Boolean;
+{
+ Get machine's names
+}
+var
+ regs : SysCallregs;
+Begin
+ regs.reg2:=longint(@unamerec);
+ Uname:=SysCall(SysCall_nr_uname,regs)=0;
+ LinuxError:=Errno;
+End;
+
+
+Function Kill(Pid:longint;Sig:longint):integer;
+{
+ Send signal 'sig' to a process, or a group of processes.
+ If Pid > 0 then the signal is sent to pid
+ pid=-1 to all processes except process 1
+ pid < -1 to process group -pid
+ Return value is zero, except for case three, where the return value
+ is the number of processes to which the signal was sent.
+}
+var
+ regs : Syscallregs;
+begin
+ regs.reg2:=Pid;
+ regs.reg3:=Sig;
+ kill:=SysCall(Syscall_nr_kill,regs);
+ if kill<0 then
+ Kill:=0;
+ linuxerror:=errno;
+end;
+
+
+Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet);
+{
+ Change the list of currently blocked signals.
+ How determines which signals will be blocked :
+ SigBlock : Add SSet to the current list of blocked signals
+ SigUnBlock : Remove the signals in SSet from the list of blocked signals.
+ SigSetMask : Set the list of blocked signals to SSet
+ if OldSSet is non-null, the old set will be saved there.
+}
+Var
+ sr : SyscallRegs;
+begin
+ sr.reg2:=how;
+ sr.reg3:=longint(SSet);
+ sr.reg4:=longint(OldSSet);
+ SysCall(Syscall_nr_sigprocmask,sr);
+ linuxerror:=errno;
+end;
+
+
+
+Function SigPending:SigSet;
+{
+ Allows examination of pending signals. The signal mask of pending
+ signals is set in SSet
+}
+Var
+ sr : SyscallRegs;
+ dummy : Sigset;
+begin
+ sr.reg2:=longint(@dummy);
+ SysCall(Syscall_nr_sigpending,sr);
+ linuxerror:=errno;
+ Sigpending:=dummy;
+end;
+
+
+
+Procedure SigSuspend(Mask:Sigset);
+{
+ Set the signal mask with Mask, and suspend the program until a signal
+ is received.
+}
+Var
+ sr : SyscallRegs;
+begin
+ sr.reg2:=mask;
+ SysCall(Syscall_nr_sigsuspend,sr);
+ linuxerror:=errno;
+end;
+
+
+
+Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
+{
+ Install a new handler for signal Signum.
+ The old signal handler is returned.
+ This call does, in fact, the same as SigAction.
+}
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=signum;
+ sr.reg3:=longint(handler);
+ Linuxerror:=SysCall(Syscall_nr_signal,sr);
+ If linuxerror=Sig_Err then
+ begin
+ Signal:=nil;
+ Linuxerror:=errno;
+ end
+ else
+ begin
+ Signal:=signalhandler(Linuxerror);
+ linuxerror:=0;
+ end;
+end;
+
+Function Alarm(Sec : Longint) : longint;
+
+Var Sr : Syscallregs;
+
+begin
+ sr.reg2:=Sec;
+ Alarm:=Syscall(syscall_nr_alarm,sr);
+end;
+
+Procedure Pause;
+
+Var Sr : Syscallregs;
+
+begin
+ syscall(syscall_nr_pause,sr);
+end;
+
+Function NanoSleep(const req : timespec;var rem : timespec) : longint;
+
+var Sr : Syscallregs;
+
+begin
+ sr.reg2:=longint(@req);
+ sr.reg3:=longint(@rem);
+ NanoSleep:=Syscall(syscall_nr_nanosleep,sr);
+ LinuxError:=Errno;
+end;
+
+Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
+{
+ Interface to Unix ioctl call.
+ Performs various operations on the filedescriptor Handle.
+ Ndx describes the operation to perform.
+ Data points to data needed for the Ndx function. The structure of this
+ data is function-dependent.
+}
+var
+ sr: SysCallRegs;
+begin
+ sr.reg2:=Handle;
+ sr.reg3:=Ndx;
+ sr.reg4:=Longint(Data);
+ IOCtl:=(SysCall(Syscall_nr_ioctl,sr)=0);
+ LinuxError:=Errno;
+end;
+
+
+function MMap(const m:tmmapargs):longint;
+Var
+ Sr : Syscallregs;
+begin
+ Sr.reg2:=longint(@m);
+ MMap:=syscall(syscall_nr_mmap,sr);
+ LinuxError:=Errno;
+end;
+
+function MUnMap (P : Pointer; Size : Longint) : Boolean;
+Var
+ Sr : Syscallregs;
+begin
+ Sr.reg2:=longint(P);
+ sr.reg3:=Size;
+ MUnMap:=syscall(syscall_nr_munmap,sr)=0;
+ LinuxError:=Errno;
+end;
+
+{--------------------------------
+ Port IO functions
+--------------------------------}
+
+Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
+{
+ Set permissions on NUM ports starting with port FROM to VALUE
+ this works ONLY as root.
+}
+
+Var
+ Sr : Syscallregs;
+begin
+ Sr.Reg2:=From;
+ Sr.Reg3:=Num;
+ Sr.Reg4:=Value;
+ IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
+ LinuxError:=Errno;
+end;
+
+Function IoPL(Level : longint) : Boolean;
+
+Var
+ Sr : Syscallregs;
+begin
+ Sr.Reg2:=Level;
+ IOPL:=Syscall(Syscall_nr_iopl,sr)=0;
+ LinuxError:=Errno;
+end;
+
+{******************************************************************************
+ Process related calls
+******************************************************************************}
+
+{ Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
+Function WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+var r,s : LongInt;
+begin
+ repeat
+ s:=$7F00;
+ r:=WaitPid(Pid,@s,0);
+ until (r<>-1) or (LinuxError<>Sys_EINTR);
+ if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
+ WaitProcess:=-1 // return -1 to indicate an error
+ else
+ begin
+{$ifdef solaris}
+ if (s and $FF)=0 then // Only this is a valid returncode
+{$else solaris}
+ { the following is at least correct for Linux and Darwin (JM) }
+ if (s and $7F)=0 then
+{$endif solaris}
+ WaitProcess:=s shr 8
+ else if (s>0) then // Until now there is not use of the highest bit , but check this for the future
+ WaitProcess:=-s // normal case
+ else
+ WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
+ end;
+end;
+
+function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
+{
+ Create an argv which executes a command in a shell using /bin/sh -c
+}
+const Shell = '/bin/sh'#0'-c'#0;
+var
+ pp,p : ppchar;
+// temp : string; !! Never pass a local var back!!
+begin
+ getmem(pp,4*4);
+ p:=pp;
+ p^:=@Shell[1];
+ inc(p);
+ p^:=@Shell[9];
+ inc(p);
+ getmem(p^,len+1);
+ move(cmd^,p^^,len);
+ pchar(p^)[len]:=#0;
+ inc(p);
+ p^:=Nil;
+ InternalCreateShellArgV:=pp;
+end;
+
+function CreateShellArgV(const prog:string):ppchar;
+begin
+ CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
+end;
+
+function CreateShellArgV(const prog:Ansistring):ppchar;
+{
+ Create an argv which executes a command in a shell using /bin/sh -c
+ using a AnsiString;
+}
+begin
+ CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
+end;
+
+procedure FreeShellArgV(p:ppchar);
+begin
+ if (p<>nil) then begin
+ freemem(p[2]);
+ freemem(p);
+ end;
+end;
+
+Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
+{
+ overloaded ansistring version.
+}
+begin
+ ExecVE(PChar(Path),args,ep);
+end;
+
+Procedure Execv(const path: AnsiString;args:ppchar);
+{
+ Overloaded ansistring version.
+}
+begin
+ ExecVe(Path,Args,envp)
+end;
+
+Procedure Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar);
+{
+ Overloaded ansistring version
+}
+var
+ thepath : Ansistring;
+begin
+ if path[1]<>'/' then
+ begin
+ Thepath:=strpas(getenv('PATH'));
+ if thepath='' then
+ thepath:='.';
+ Path:=FSearch(path,thepath)
+ end
+ else
+ Path:='';
+ if Path='' then
+ linuxerror:=Sys_enoent
+ else
+ Execve(Path,args,ep);{On error linuxerror will get set there}
+end;
+
+Procedure Execv(const path:pathstr;args:ppchar);
+{
+ Replaces the current program by the program specified in path,
+ arguments in args are passed to Execve.
+ the current environment is passed on.
+}
+begin
+ Execve(path,args,envp); {On error linuxerror will get set there}
+end;
+
+Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
+{
+ This does the same as Execve, only it searches the PATH environment
+ for the place of the Executable, except when Path starts with a slash.
+ if the PATH environment variable is unavailable, the path is set to '.'
+}
+var
+ thepath : string;
+begin
+ if path[1]<>'/' then
+ begin
+ Thepath:=strpas(getenv('PATH'));
+ if thepath='' then
+ thepath:='.';
+ Path:=FSearch(path,thepath)
+ end
+ else
+ Path:='';
+ if Path='' then
+ linuxerror:=Sys_enoent
+ else
+ Execve(Path,args,ep);{On error linuxerror will get set there}
+end;
+
+Procedure Execle(Todo:string;Ep:ppchar);
+{
+ This procedure takes the string 'Todo', parses it for command and
+ command options, and Executes the command with the given options.
+ The string 'Todo' shoud be of the form 'command options', options
+ separated by commas.
+ the PATH environment is not searched for 'command'.
+ The specified environment(in 'ep') is passed on to command
+}
+var
+ p : ppchar;
+begin
+ p:=StringToPPChar(ToDo);
+ if (p=nil) or (p^=nil) then
+ exit;
+ ExecVE(p^,p,EP);
+end;
+
+Procedure Execle(Todo:AnsiString;Ep:ppchar);
+{
+ This procedure takes the string 'Todo', parses it for command and
+ command options, and Executes the command with the given options.
+ The string 'Todo' shoud be of the form 'command options', options
+ separated by commas.
+ the PATH environment is not searched for 'command'.
+ The specified environment(in 'ep') is passed on to command
+}
+var
+ p : ppchar;
+begin
+ p:=StringToPPChar(ToDo);
+ if (p=nil) or (p^=nil) then
+ exit;
+ ExecVE(p^,p,EP);
+end;
+
+Procedure Execl(const Todo:string);
+{
+ This procedure takes the string 'Todo', parses it for command and
+ command options, and Executes the command with the given options.
+ The string 'Todo' shoud be of the form 'command options', options
+ separated by commas.
+ the PATH environment is not searched for 'command'.
+ The current environment is passed on to command
+}
+begin
+ ExecLE(ToDo,EnvP);
+end;
+
+Procedure Execl(const Todo:Ansistring);
+
+{
+ Overloaded AnsiString Version of ExecL.
+}
+
+begin
+ ExecLE(ToDo,EnvP);
+end;
+
+
+Procedure Execlp(Todo:string;Ep:ppchar);
+{
+ This procedure takes the string 'Todo', parses it for command and
+ command options, and Executes the command with the given options.
+ The string 'Todo' shoud be of the form 'command options', options
+ separated by commas.
+ the PATH environment is searched for 'command'.
+ The specified environment (in 'ep') is passed on to command
+}
+var
+ p : ppchar;
+begin
+ p:=StringToPPchar(todo);
+ if (p=nil) or (p^=nil) then
+ exit;
+ ExecVP(StrPas(p^),p,EP);
+end;
+
+Procedure Execlp(Todo: Ansistring;Ep:ppchar);
+{
+ Overloaded ansistring version.
+}
+var
+ p : ppchar;
+begin
+ p:=StringToPPchar(todo);
+ if (p=nil) or (p^=nil) then
+ exit;
+ ExecVP(StrPas(p^),p,EP);
+end;
+
+Function Shell(const Command:String):Longint;
+{
+ Executes the shell, and passes it the string Command. (Through /bin/sh -c)
+ The current environment is passed to the shell.
+ It waits for the shell to exit, and returns its exit status.
+ If the Exec call failed exit status 127 is reported.
+}
+{ Changed the structure:
+- the previous version returns an undefinied value if fork fails
+- it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
+- it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
+- ShellArgs are now released
+- The Old CreateShellArg gives back pointers to a local var
+}
+var
+ p : ppchar;
+ pid,r,s : longint;
+begin
+ p:=CreateShellArgv(command);
+ pid:=fork;
+ if pid=0 then // We are in the Child
+ begin
+ {This is the child.}
+ Execve(p^,p,envp);
+ ExitProcess(127); // was Exit(127)
+ end
+ else if (pid<>-1) then // Successfull started
+ begin
+ repeat
+ s:=$7F00;
+ r:=WaitPid(Pid,@s,0);
+ until (r<>-1) or (LinuxError<>Sys_EINTR);
+ if (r=-1) or (r=0) then
+ Shell:=-1
+ else
+ Shell:=s;
+ end
+ else // no success
+ Shell:=-1; // indicate an error
+ FreeShellArgV(p);
+end;
+
+Function Shell(const Command:AnsiString):Longint;
+{
+ AnsiString version of Shell
+}
+var
+ p : ppchar;
+ pid : longint;
+begin { Changes as above }
+ p:=CreateShellArgv(command);
+ pid:=fork;
+ if pid=0 then // We are in the Child
+ begin
+ Execve(p^,p,envp);
+ ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
+ end
+ else if (pid<>-1) then // Successfull started
+ Shell:=WaitProcess(pid) {Linuxerror is set there}
+ else // no success
+ Shell:=-1;
+ FreeShellArgV(p);
+end;
+
+function WEXITSTATUS(Status: Integer): Integer;
+begin
+ WEXITSTATUS:=(Status and $FF00) shr 8;
+end;
+
+function WTERMSIG(Status: Integer): Integer;
+begin
+ WTERMSIG:=(Status and $7F);
+end;
+
+function WSTOPSIG(Status: Integer): Integer;
+begin
+ WSTOPSIG:=WEXITSTATUS(Status);
+end;
+
+Function WIFEXITED(Status: Integer): Boolean;
+begin
+ WIFEXITED:=(WTERMSIG(Status)=0);
+end;
+
+Function WIFSTOPPED(Status: Integer): Boolean;
+begin
+ WIFSTOPPED:=((Status and $FF)=$7F);
+end;
+
+Function WIFSIGNALED(Status: Integer): Boolean;
+begin
+ WIFSIGNALED:=(not WIFSTOPPED(Status)) and
+ (not WIFEXITED(Status));
+end;
+
+Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
+begin
+ W_EXITCODE:=(ReturnCode shl 8) or Signal;
+end;
+
+Function W_STOPCODE(Signal: Integer): Integer;
+
+begin
+ W_STOPCODE:=(Signal shl 8) or $7F;
+end;
+
+
+{******************************************************************************
+ Date and Time related calls
+******************************************************************************}
+
+Const
+{Date Translation}
+ C1970=2440588;
+ D0 = 1461;
+ D1 = 146097;
+ D2 =1721119;
+
+Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
+Var
+ Century,XYear: LongInt;
+Begin
+ If Month<=2 Then
+ Begin
+ Dec(Year);
+ Inc(Month,12);
+ End;
+ Dec(Month,3);
+ Century:=(longint(Year Div 100)*D1) shr 2;
+ XYear:=(longint(Year Mod 100)*D0) shr 2;
+ GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
+End;
+
+
+
+Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
+Var
+ YYear,XYear,Temp,TempMonth : LongInt;
+Begin
+ Temp:=((JulianDN-D2) shl 2)-1;
+ JulianDN:=Temp Div D1;
+ XYear:=(Temp Mod D1) or 3;
+ YYear:=(XYear Div D0);
+ Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
+ Day:=((Temp Mod 153)+5) Div 5;
+ TempMonth:=Temp Div 153;
+ If TempMonth>=10 Then
+ Begin
+ inc(YYear);
+ dec(TempMonth,12);
+ End;
+ inc(TempMonth,3);
+ Month := TempMonth;
+ Year:=YYear+(JulianDN*100);
+end;
+
+Function GetEpochTime: longint;
+{
+ Get the number of seconds since 00:00, January 1 1970, GMT
+ the time NOT corrected any way
+}
+begin
+ GetEpochTime:=GetTimeOfDay;
+end;
+
+
+Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
+{
+ Transforms Epoch time into local time (hour, minute,seconds)
+}
+Var
+ DateNum: LongInt;
+Begin
+ inc(Epoch,TZSeconds);
+ Datenum:=(Epoch Div 86400) + c1970;
+ JulianToGregorian(DateNum,Year,Month,day);
+ Epoch:=Abs(Epoch Mod 86400);
+ Hour:=Epoch Div 3600;
+ Epoch:=Epoch Mod 3600;
+ Minute:=Epoch Div 60;
+ Second:=Epoch Mod 60;
+End;
+
+
+Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
+{
+ Transforms local time (year,month,day,hour,minutes,second) to Epoch time
+ (seconds since 00:00, january 1 1970, corrected for local time zone)
+}
+Begin
+ LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
+ (LongInt(Hour)*3600)+(Minute*60)+Second-TZSeconds;
+End;
+
+
+procedure GetTime(var hour,min,sec,msec,usec:word);
+{
+ Gets the current time, adjusted to local time
+}
+var
+ year,day,month:Word;
+ t : timeval;
+begin
+ gettimeofday(t);
+ EpochToLocal(t.sec,year,month,day,hour,min,sec);
+ msec:=t.usec div 1000;
+ usec:=t.usec mod 1000;
+end;
+
+
+procedure GetTime(var hour,min,sec,sec100:word);
+{
+ Gets the current time, adjusted to local time
+}
+var
+ usec : word;
+begin
+ gettime(hour,min,sec,sec100,usec);
+ sec100:=sec100 div 10;
+end;
+
+
+Procedure GetTime(Var Hour,Min,Sec:Word);
+{
+ Gets the current time, adjusted to local time
+}
+var
+ msec,usec : Word;
+Begin
+ gettime(hour,min,sec,msec,usec);
+End;
+
+
+Procedure GetDate(Var Year,Month,Day:Word);
+{
+ Gets the current date, adjusted to local time
+}
+var
+ hour,minute,second : word;
+Begin
+ EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
+End;
+
+
+Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
+{
+ Gets the current date, adjusted to local time
+}
+Begin
+ EpochToLocal(GetTimeOfDay,year,month,day,hour,minute,second);
+End;
+
+{$ifndef BSD} {Fix for 1.0.x starting compiler only}
+{$ifdef linux}
+Function stime (t : longint) : Boolean;
+var
+ sr : Syscallregs;
+begin
+ sr.reg2:=longint(@t);
+ SysCall(Syscall_nr_stime,sr);
+ linuxerror:=errno;
+ stime:=linuxerror=0;
+end;
+{$endif}
+{$endif}
+
+{$ifdef BSD}
+Function stime (t : longint) : Boolean;
+begin
+ stime:=false;
+end;
+{$endif}
+
+Function SetTime(Hour,Min,Sec:word) : boolean;
+var
+ Year, Month, Day : Word;
+begin
+ GetDate (Year, Month, Day);
+ SetTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Min, Sec ) );
+end;
+
+Function SetDate(Year,Month,Day:Word) : boolean;
+var
+ Hour, Minute, Second, Sec100 : Word;
+begin
+ GetTime ( Hour, Minute, Second, Sec100 );
+ SetDate:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
+end;
+
+Function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
+
+begin
+ SetDateTime:=stime ( LocalToEpoch ( Year, Month, Day, Hour, Minute, Second ) );
+end;
+
+{ Include timezone handling routines which use /usr/share/timezone info }
+
+type
+ plongint=^longint;
+ pbyte=^byte;
+
+ ttzhead=packed record
+ tzh_reserved : array[0..19] of byte;
+ tzh_ttisgmtcnt,
+ tzh_ttisstdcnt,
+ tzh_leapcnt,
+ tzh_timecnt,
+ tzh_typecnt,
+ tzh_charcnt : longint;
+ end;
+
+ pttinfo=^tttinfo;
+ tttinfo=packed record
+ offset : longint;
+ isdst : boolean;
+ idx : byte;
+ isstd : byte;
+ isgmt : byte;
+ end;
+
+ pleap=^tleap;
+ tleap=record
+ transition : longint;
+ change : longint;
+ end;
+
+var
+ num_transitions,
+ num_leaps,
+ num_types : longint;
+
+ transitions : plongint;
+ type_idxs : pbyte;
+ types : pttinfo;
+ zone_names : pchar;
+ leaps : pleap;
+
+function find_transition(timer:longint):pttinfo;
+var
+ i : longint;
+begin
+ if (num_transitions=0) or (timer<transitions[0]) then
+ begin
+ i:=0;
+ while (i<num_types) and (types[i].isdst) do
+ inc(i);
+ if (i=num_types) then
+ i:=0;
+ end
+ else
+ begin
+ for i:=1 to num_transitions do
+ if (timer<transitions[i]) then
+ break;
+ i:=type_idxs[i-1];
+ end;
+ find_transition:=@types[i];
+end;
+
+
+procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
+var
+ info : pttinfo;
+ i : longint;
+begin
+{ reset }
+ TZDaylight:=false;
+ TZSeconds:=0;
+ TZName[false]:=nil;
+ TZName[true]:=nil;
+ leap_correct:=0;
+ leap_hit:=0;
+{ get info }
+ info:=find_transition(timer);
+ if not assigned(info) then
+ exit;
+ TZDaylight:=info^.isdst;
+ TZSeconds:=info^.offset;
+ i:=0;
+ while (i<num_types) do
+ begin
+ tzname[types[i].isdst]:=@zone_names[types[i].idx];
+ inc(i);
+ end;
+ tzname[info^.isdst]:=@zone_names[info^.idx];
+ i:=num_leaps;
+ repeat
+ if i=0 then
+ exit;
+ dec(i);
+ until (timer>leaps[i].transition);
+ leap_correct:=leaps[i].change;
+ if (timer=leaps[i].transition) and
+ (((i=0) and (leaps[i].change>0)) or
+ (leaps[i].change>leaps[i-1].change)) then
+ begin
+ leap_hit:=1;
+ while (i>0) and
+ (leaps[i].transition=leaps[i-1].transition+1) and
+ (leaps[i].change=leaps[i-1].change+1) do
+ begin
+ inc(leap_hit);
+ dec(i);
+ end;
+ end;
+end;
+
+
+procedure GetLocalTimezone(timer:longint);
+var
+ lc,lh : longint;
+begin
+ GetLocalTimezone(timer,lc,lh);
+end;
+
+
+procedure ReadTimezoneFile(fn:string);
+
+ procedure decode(var l:longint);
+ var
+ k : longint;
+ p : pbyte;
+ begin
+ p:=pbyte(@l);
+ if (p[0] and (1 shl 7))<>0 then
+ k:=not 0
+ else
+ k:=0;
+ k:=(k shl 8) or p[0];
+ k:=(k shl 8) or p[1];
+ k:=(k shl 8) or p[2];
+ k:=(k shl 8) or p[3];
+ l:=k;
+ end;
+
+var
+ f : longint;
+ tzdir : string;
+ tzhead : ttzhead;
+ i : longint;
+ chars : longint;
+ buf : pbyte;
+begin
+ if fn='' then
+ fn:='localtime';
+ if fn[1]<>'/' then
+ begin
+ tzdir:=getenv('TZDIR');
+ if tzdir='' then
+ tzdir:='/usr/share/zoneinfo';
+ if tzdir[length(tzdir)]<>'/' then
+ tzdir:=tzdir+'/';
+ fn:=tzdir+fn;
+ end;
+ f:=fdopen(fn,Open_RdOnly);
+ if f<0 then
+ exit;
+ i:=fdread(f,tzhead,sizeof(tzhead));
+ if i<>sizeof(tzhead) then
+ exit;
+ decode(tzhead.tzh_timecnt);
+ decode(tzhead.tzh_typecnt);
+ decode(tzhead.tzh_charcnt);
+ decode(tzhead.tzh_leapcnt);
+ decode(tzhead.tzh_ttisstdcnt);
+ decode(tzhead.tzh_ttisgmtcnt);
+
+ num_transitions:=tzhead.tzh_timecnt;
+ num_types:=tzhead.tzh_typecnt;
+ chars:=tzhead.tzh_charcnt;
+
+ reallocmem(transitions,num_transitions*sizeof(longint));
+ reallocmem(type_idxs,num_transitions);
+ reallocmem(types,num_types*sizeof(tttinfo));
+ reallocmem(zone_names,chars);
+ reallocmem(leaps,num_leaps*sizeof(tleap));
+
+ fdread(f,transitions^,num_transitions*4);
+ fdread(f,type_idxs^,num_transitions);
+
+ for i:=0 to num_transitions-1 do
+ decode(transitions[i]);
+
+ for i:=0 to num_types-1 do
+ begin
+ fdread(f,types[i].offset,4);
+ fdread(f,types[i].isdst,1);
+ fdread(f,types[i].idx,1);
+ decode(types[i].offset);
+ types[i].isstd:=0;
+ types[i].isgmt:=0;
+ end;
+
+ fdread(f,zone_names^,chars);
+
+ for i:=0 to num_leaps-1 do
+ begin
+ fdread(f,leaps[i].transition,4);
+ fdread(f,leaps[i].change,4);
+ decode(leaps[i].transition);
+ decode(leaps[i].change);
+ end;
+
+ getmem(buf,tzhead.tzh_ttisstdcnt);
+ fdread(f,buf^,tzhead.tzh_ttisstdcnt);
+ for i:=0 to tzhead.tzh_ttisstdcnt-1 do
+ types[i].isstd:=byte(buf[i]<>0);
+ freemem(buf);
+
+ getmem(buf,tzhead.tzh_ttisgmtcnt);
+ fdread(f,buf^,tzhead.tzh_ttisgmtcnt);
+ for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
+ types[i].isgmt:=byte(buf[i]<>0);
+ freemem(buf);
+ fdclose(f);
+end;
+
+Const
+ // Debian system; contains location of timezone file.
+ TimeZoneLocationFile = '/etc/timezone';
+ // SuSE has link in /usr/lib/zoneinfo/localtime to /etc/localtime
+ // RedHat uses /etc/localtime
+ TimeZoneFile = '/usr/lib/zoneinfo/localtime';
+ AltTimeZoneFile = '/etc/localtime';
+
+function GetTimezoneFile:string;
+var
+ f,len : longint;
+ s : string;
+ info : stat;
+
+begin
+ GetTimezoneFile:='';
+ f:=fdopen(TimeZoneLocationFile,Open_RdOnly);
+ if f>0 then
+ begin
+ len:=fdread(f,s[1],high(s));
+ s[0]:=chr(len);
+ len:=pos(#10,s);
+ if len<>0 then
+ s[0]:=chr(len-1);
+ fdclose(f);
+ GetTimezoneFile:=s;
+ end
+ // Try SuSE
+ else if fstat(TimeZoneFile,info) then
+ GetTimeZoneFile:=TimeZoneFile
+ // Try RedHat
+ else If fstat(AltTimeZoneFile,Info) then
+ GetTimeZoneFile:=AltTimeZoneFile;
+end;
+
+
+procedure InitLocalTime;
+begin
+ ReadTimezoneFile(GetTimezoneFile);
+ GetLocalTimezone(GetTimeOfDay);
+end;
+
+
+procedure DoneLocalTime;
+begin
+ if assigned(transitions) then
+ freemem(transitions);
+ if assigned(type_idxs) then
+ freemem(type_idxs);
+ if assigned(types) then
+ freemem(types);
+ if assigned(zone_names) then
+ freemem(zone_names);
+ if assigned(leaps) then
+ freemem(leaps);
+ num_transitions:=0;
+ num_leaps:=0;
+ num_types:=0;
+end;
+
+
+
+
+{******************************************************************************
+ FileSystem calls
+******************************************************************************}
+
+Function fdOpen(pathname:string;flags:longint):longint;
+begin
+ pathname:=pathname+#0;
+ fdOpen:=Sys_Open(@pathname[1],flags,438);
+ LinuxError:=Errno;
+end;
+
+
+Function fdOpen(pathname:string;flags,mode:longint):longint;
+begin
+ pathname:=pathname+#0;
+ fdOpen:=Sys_Open(@pathname[1],flags,mode);
+ LinuxError:=Errno;
+end;
+
+
+
+Function fdOpen(pathname:pchar;flags:longint):longint;
+begin
+ fdOpen:=Sys_Open(pathname,flags,0);
+ LinuxError:=Errno;
+end;
+
+
+
+Function fdOpen(pathname:pchar;flags,mode:longint):longint;
+begin
+ fdOpen:=Sys_Open(pathname,flags,mode);
+ LinuxError:=Errno;
+end;
+
+
+
+Function fdClose(fd:longint):boolean;
+begin
+ fdClose:=(Sys_Close(fd)=0);
+ LinuxError:=Errno;
+end;
+
+
+
+Function fdRead(fd:longint;var buf;size:longint):longint;
+begin
+ fdRead:=Sys_Read(fd,pchar(@buf),size);
+ LinuxError:=Errno;
+end;
+
+
+
+Function fdWrite(fd:longint;const buf;size:longint):longint;
+begin
+ fdWrite:=Sys_Write(fd,pchar(@buf),size);
+ LinuxError:=Errno;
+end;
+
+
+
+
+Function fdSeek (fd,pos,seektype :longint): longint;
+{
+ Do a Seek on a file descriptor fd to position pos, starting from seektype
+
+}
+begin
+ fdseek:=Sys_LSeek (fd,pos,seektype);
+ LinuxError:=Errno;
+end;
+
+{$ifdef BSD}
+Function Fcntl(Fd:longint;Cmd:longint):longint;
+{
+ Read or manipulate a file.(See also fcntl (2) )
+ Possible values for Cmd are :
+ F_GetFd,F_GetFl,F_GetOwn
+ Errors are reported in Linuxerror;
+ If Cmd is different from the allowed values, linuxerror=Sys_eninval.
+}
+
+begin
+ if (cmd in [F_GetFd,F_GetFl,F_GetOwn]) then
+ begin
+ Linuxerror:=sys_fcntl(fd,cmd,0);
+ if linuxerror=-1 then
+ begin
+ linuxerror:=errno;
+ fcntl:=0;
+ end
+ else
+ begin
+ fcntl:=linuxerror;
+ linuxerror:=0;
+ end;
+ end
+ else
+ begin
+ linuxerror:=Sys_einval;
+ Fcntl:=0;
+ end;
+end;
+
+
+Procedure Fcntl(Fd:longint;Cmd:longint;Arg:Longint);
+{
+ Read or manipulate a file. (See also fcntl (2) )
+ Possible values for Cmd are :
+ F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
+ Errors are reported in Linuxerror;
+ If Cmd is different from the allowed values, linuxerror=Sys_eninval.
+ F_DupFD is not allowed, due to the structure of Files in Pascal.
+}
+begin
+ if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn]) then
+ begin
+ sys_fcntl(fd,cmd,arg);
+ LinuxError:=ErrNo;
+ end
+ else
+ linuxerror:=Sys_einval;
+end;
+{$endif}
+
+
+Function Fcntl(var Fd:Text;Cmd:longint):longint;
+begin
+ Fcntl := Fcntl(textrec(Fd).handle, Cmd);
+end;
+
+Procedure Fcntl(var Fd:Text;Cmd,Arg:Longint);
+
+begin
+ Fcntl(textrec(Fd).handle, Cmd, Arg);
+end;
+
+
+Function Flock (var T : text;mode : longint) : boolean;
+begin
+ Flock:=Flock(TextRec(T).Handle,mode);
+end;
+
+
+
+Function Flock (var F : File;mode : longint) : boolean;
+begin
+ Flock:=Flock(FileRec(F).Handle,mode);
+end;
+
+
+
+Function FStat(Path:Pathstr;Var Info:stat):Boolean;
+{
+ Get all information on a file, and return it in Info.
+}
+begin
+ path:=path+#0;
+ FStat:=(Sys_stat(@(path[1]),Info)=0);
+ LinuxError:=errno;
+end;
+
+
+
+
+Function FStat(var F:Text;Var Info:stat):Boolean;
+{
+ Get all information on a text file, and return it in info.
+}
+begin
+ FStat:=Fstat(TextRec(F).Handle,INfo);
+end;
+
+
+
+Function FStat(var F:File;Var Info:stat):Boolean;
+{
+ Get all information on a untyped file, and return it in info.
+}
+begin
+ FStat:=Fstat(FileRec(F).Handle,Info);
+end;
+
+Function SymLink(OldPath,newPath:pathstr):boolean;
+{
+ Proceduces a soft link from new to old.
+}
+begin
+ oldpath:=oldpath+#0;
+ newpath:=newpath+#0;
+ Symlink:=Sys_symlink(pchar(@(oldpath[1])),pchar(@(newpath[1])))=0;
+ linuxerror:=errno;
+end;
+
+
+Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
+{
+ Read a link (where it points to)
+}
+begin
+ Readlink:=Sys_readlink(Name,LinkName,maxlen);
+ linuxerror:=errno;
+end;
+
+
+Function ReadLink(Name:pathstr):pathstr;
+{
+ Read a link (where it points to)
+}
+var
+ LinkName : pathstr;
+ i : longint;
+begin
+ Name:=Name+#0;
+ i:=ReadLink(@Name[1],@LinkName[1],high(linkname));
+ if i>0 then
+ begin
+ linkname[0]:=chr(i);
+ ReadLink:=LinkName;
+ end
+ else
+ ReadLink:='';
+end;
+
+
+Function UnLink(Path:pathstr):boolean;
+{
+ Removes the file in 'Path' (that is, it decreases the link count with one.
+ if the link count is zero, the file is removed from the disk.
+}
+begin
+ path:=path+#0;
+ Unlink:=Sys_unlink(pchar(@(path[1])))=0;
+ linuxerror:=errno;
+end;
+
+
+Function UnLink(Path:pchar):Boolean;
+{
+ Removes the file in 'Path' (that is, it decreases the link count with one.
+ if the link count is zero, the file is removed from the disk.
+}
+begin
+ Unlink:=(Sys_unlink(path)=0);
+ linuxerror:=errno;
+end;
+
+
+Function FRename (OldName,NewName : Pchar) : Boolean;
+begin
+ FRename:=Sys_rename(OldName,NewName)=0;
+ LinuxError:=Errno;
+end;
+
+
+Function FRename (OldName,NewName : String) : Boolean;
+begin
+ OldName:=OldName+#0;
+ NewName:=NewName+#0;
+ FRename:=FRename (@OldName[1],@NewName[1]);
+end;
+
+Function Dup(var oldfile,newfile:text):Boolean;
+{
+ Copies the filedescriptor oldfile to newfile, after flushing the buffer of
+ oldfile.
+ After which the two textfiles are, in effect, the same, except
+ that they don't share the same buffer, and don't share the same
+ close_on_exit flag.
+}
+begin
+ flush(oldfile);{ We cannot share buffers, so we flush them. }
+ textrec(newfile):=textrec(oldfile);
+ textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
+ Dup:=Dup(textrec(oldfile).handle,textrec(newfile).handle);
+end;
+
+
+Function Dup(var oldfile,newfile:file):Boolean;
+{
+ Copies the filedescriptor oldfile to newfile
+}
+begin
+ filerec(newfile):=filerec(oldfile);
+ Dup:=Dup(filerec(oldfile).handle,filerec(newfile).handle);
+end;
+
+
+
+Function Dup2(var oldfile,newfile:text):Boolean;
+{
+ Copies the filedescriptor oldfile to newfile, after flushing the buffer of
+ oldfile. It closes newfile if it was still open.
+ After which the two textfiles are, in effect, the same, except
+ that they don't share the same buffer, and don't share the same
+ close_on_exit flag.
+}
+var
+ tmphandle : word;
+begin
+ case TextRec(oldfile).mode of
+ fmOutput, fmInOut, fmAppend :
+ flush(oldfile);{ We cannot share buffers, so we flush them. }
+ end;
+ case TextRec(newfile).mode of
+ fmOutput, fmInOut, fmAppend :
+ flush(newfile);
+ end;
+ tmphandle:=textrec(newfile).handle;
+ textrec(newfile):=textrec(oldfile);
+ textrec(newfile).handle:=tmphandle;
+ textrec(newfile).bufptr:=@(textrec(newfile).buffer);{ No shared buffer. }
+ Dup2:=Dup2(textrec(oldfile).handle,textrec(newfile).handle);
+end;
+
+
+Function Dup2(var oldfile,newfile:file):Boolean;
+{
+ Copies the filedescriptor oldfile to newfile
+}
+begin
+ filerec(newfile):=filerec(oldfile);
+ Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
+end;
+
+
+
+Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
+{
+ Select checks whether the file descriptor sets in readfs/writefs/exceptfs
+ have changed.
+ This function allows specification of a timeout as a longint.
+}
+var
+ p : PTimeVal;
+ tv : TimeVal;
+begin
+ if TimeOut=-1 then
+ p:=nil
+ else
+ begin
+ tv.Sec:=Timeout div 1000;
+ tv.Usec:=(Timeout mod 1000)*1000;
+ p:=@tv;
+ end;
+ Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
+end;
+
+
+
+Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
+Var
+ F:FDSet;
+begin
+ if textrec(t).mode=fmclosed then
+ begin
+ LinuxError:=Sys_EBADF;
+ exit(-1);
+ end;
+ FD_Zero(f);
+ FD_Set(textrec(T).handle,f);
+ if textrec(T).mode=fminput then
+ SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
+ else
+ SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
+end;
+
+
+Function SelectText(var T:Text;TimeOut :Longint):Longint;
+var
+ p : PTimeVal;
+ tv : TimeVal;
+begin
+ if TimeOut=-1 then
+ p:=nil
+ else
+ begin
+ tv.Sec:=Timeout div 1000;
+ tv.Usec:=(Timeout mod 1000)*1000;
+ p:=@tv;
+ end;
+ SelectText:=SelectText(T,p);
+end;
+
+
+{******************************************************************************
+ Directory
+******************************************************************************}
+
+Function OpenDir(F:String):PDir;
+begin
+ F:=F+#0;
+ OpenDir:=OpenDir(@F[1]);
+ LinuxError:=ErrNo;
+end;
+
+{$ifndef newreaddir}
+procedure SeekDir(p:pdir;off:longint);
+begin
+ if p=nil then
+ begin
+ errno:=Sys_EBADF;
+ exit;
+ end;
+ {$ifndef bsd}
+ p^.nextoff:=Sys_lseek(p^.fd,off,seek_set);
+ {$endif}
+ p^.size:=0;
+ p^.loc:=0;
+end;
+
+function TellDir(p:pdir):longint;
+begin
+ if p=nil then
+ begin
+ errno:=Sys_EBADF;
+ telldir:=-1;
+ exit;
+ end;
+ telldir:=Sys_lseek(p^.fd,0,seek_cur)
+ { We could try to use the nextoff field here, but on my 1.2.13
+ kernel, this gives nothing... This may have to do with
+ the readdir implementation of libc... I also didn't find any trace of
+ the field in the kernel code itself, So I suspect it is an artifact of libc.
+ Michael. }
+end;
+{$endif}
+
+Function ReadDir(P:pdir):pdirent;
+begin
+ ReadDir:=Sys_ReadDir(p);
+ LinuxError:=Errno;
+end;
+
+
+{******************************************************************************
+ Pipes/Fifo
+******************************************************************************}
+
+Procedure OpenPipe(var F:Text);
+begin
+ case textrec(f).mode of
+ fmoutput :
+ if textrec(f).userdata[1]<>P_OUT then
+ textrec(f).mode:=fmclosed;
+ fminput :
+ if textrec(f).userdata[1]<>P_IN then
+ textrec(f).mode:=fmclosed;
+ else
+ textrec(f).mode:=fmclosed;
+ end;
+end;
+
+
+Procedure IOPipe(var F:text);
+begin
+ case textrec(f).mode of
+ fmoutput :
+ begin
+ { first check if we need something to write, else we may
+ get a SigPipe when Close() is called (PFV) }
+ if textrec(f).bufpos>0 then
+ Sys_write(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
+ end;
+ fminput :
+ textrec(f).bufend:=Sys_read(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
+ end;
+ textrec(f).bufpos:=0;
+end;
+
+
+Procedure FlushPipe(var F:Text);
+begin
+ if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
+ IOPipe(f);
+ textrec(f).bufpos:=0;
+end;
+
+
+Procedure ClosePipe(var F:text);
+begin
+ textrec(f).mode:=fmclosed;
+ Sys_close(textrec(f).handle);
+end;
+
+
+Function AssignPipe(var pipe_in,pipe_out:text):boolean;
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ f_in,f_out : longint;
+begin
+ if not AssignPipe(f_in,f_out) then
+ begin
+ AssignPipe:=false;
+ exit;
+ end;
+{ Set up input }
+ Assign(Pipe_in,'');
+ Textrec(Pipe_in).Handle:=f_in;
+ Textrec(Pipe_in).Mode:=fmInput;
+ Textrec(Pipe_in).userdata[1]:=P_IN;
+ TextRec(Pipe_in).OpenFunc:=@OpenPipe;
+ TextRec(Pipe_in).InOutFunc:=@IOPipe;
+ TextRec(Pipe_in).FlushFunc:=@FlushPipe;
+ TextRec(Pipe_in).CloseFunc:=@ClosePipe;
+{ Set up output }
+ Assign(Pipe_out,'');
+ Textrec(Pipe_out).Handle:=f_out;
+ Textrec(Pipe_out).Mode:=fmOutput;
+ Textrec(Pipe_out).userdata[1]:=P_OUT;
+ TextRec(Pipe_out).OpenFunc:=@OpenPipe;
+ TextRec(Pipe_out).InOutFunc:=@IOPipe;
+ TextRec(Pipe_out).FlushFunc:=@FlushPipe;
+ TextRec(Pipe_out).CloseFunc:=@ClosePipe;
+ AssignPipe:=true;
+end;
+
+
+Function AssignPipe(var pipe_in,pipe_out:file):boolean;
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful, linuxerror is set.
+}
+var
+ f_in,f_out : longint;
+begin
+ if not AssignPipe(f_in,f_out) then
+ begin
+ AssignPipe:=false;
+ exit;
+ end;
+{ Set up input }
+ Assign(Pipe_in,'');
+ Filerec(Pipe_in).Handle:=f_in;
+ Filerec(Pipe_in).Mode:=fmInput;
+ Filerec(Pipe_in).recsize:=1;
+ Filerec(Pipe_in).userdata[1]:=P_IN;
+{ Set up output }
+ Assign(Pipe_out,'');
+ Filerec(Pipe_out).Handle:=f_out;
+ Filerec(Pipe_out).Mode:=fmoutput;
+ Filerec(Pipe_out).recsize:=1;
+ Filerec(Pipe_out).userdata[1]:=P_OUT;
+ AssignPipe:=true;
+end;
+
+Procedure PCloseText(Var F:text);
+{
+ May not use @PClose due overloading
+}
+begin
+ PClose(f);
+end;
+
+
+
+Procedure POpen(var F:text;const Prog:String;rw:char);
+{
+ Starts the program in 'Prog' and makes it's input or out put the
+ other end of a pipe. If rw is 'w' or 'W', then whatever is written to
+ F, will be read from stdin by the program in 'Prog'. The inverse is true
+ for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
+ read from 'f'.
+}
+var
+ pipi,
+ pipo : text;
+ pid : longint;
+ pl : ^longint;
+ pp : ppchar;
+begin
+ LinuxError:=0;
+ rw:=upcase(rw);
+ if not (rw in ['R','W']) then
+ begin
+ LinuxError:=Sys_enoent;
+ exit;
+ end;
+ AssignPipe(pipi,pipo);
+ if Linuxerror<>0 then
+ exit;
+ pid:=fork;
+ if linuxerror<>0 then
+ begin
+ close(pipi);
+ close(pipo);
+ exit;
+ end;
+ if pid=0 then
+ begin
+ {$ifdef BSD} // FreeBSD checked only
+ { We're in the child }
+ close(pipi);
+ if textrec(pipo).handle<>textrec(output).handle Then
+ begin
+ dup2(textrec(pipo).handle,textrec(output).handle);
+ if rw='W' Then
+ dup2(textrec(output).handle,textrec(input).handle);
+ end
+ else
+ if (rw='W') and (textrec(pipi).handle<>textrec(input).handle) then
+ dup2(textrec(output).handle,textrec(input).handle);
+ close(pipo);
+ if linuxerror<>0 then
+ halt(127);
+ pp:=createshellargv(prog);
+ Execve(pp^,pp,envp);
+ halt(127);
+ end
+ {$else}
+ { We're in the child }
+ if rw='W' then
+ begin
+ close(pipo);
+ dup2(pipi,input);
+ close(pipi);
+ if linuxerror<>0 then
+ halt(127);
+ end
+ else
+ begin
+ close(pipi);
+ dup2(pipo,output);
+ close(pipo);
+ if linuxerror<>0 then
+ halt(127);
+ end;
+ pp:=createshellargv(prog);
+ Execve(pp^,pp,envp);
+ halt(127);
+ end
+ {$endif}
+ else
+ begin
+ { We're in the parent }
+ if rw='W' then
+ begin
+ close(pipi);
+ f:=pipo;
+ textrec(f).bufptr:=@textrec(f).buffer;
+ end
+ else
+ begin
+ close(pipo);
+ f:=pipi;
+ textrec(f).bufptr:=@textrec(f).buffer;
+ end;
+ {Save the process ID - needed when closing }
+ pl:=@(textrec(f).userdata[2]);
+ pl^:=pid;
+ textrec(f).closefunc:=@PCloseText;
+ end;
+end;
+
+
+Procedure POpen(var F:file;const Prog:String;rw:char);
+{
+ Starts the program in 'Prog' and makes it's input or out put the
+ other end of a pipe. If rw is 'w' or 'W', then whatever is written to
+ F, will be read from stdin by the program in 'Prog'. The inverse is true
+ for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
+ read from 'f'.
+}
+var
+ pipi,
+ pipo : file;
+ pid : longint;
+ pl : ^longint;
+ p,pp : ppchar;
+ temp : string[255];
+begin
+ LinuxError:=0;
+ rw:=upcase(rw);
+ if not (rw in ['R','W']) then
+ begin
+ LinuxError:=Sys_enoent;
+ exit;
+ end;
+ AssignPipe(pipi,pipo);
+ if Linuxerror<>0 then
+ exit;
+ pid:=fork;
+ if linuxerror<>0 then
+ begin
+ close(pipi);
+ close(pipo);
+ exit;
+ end;
+ if pid=0 then
+ begin
+ { We're in the child }
+ if rw='W' then
+ begin
+ close(pipo);
+ dup2(filerec(pipi).handle,stdinputhandle);
+ close(pipi);
+ if linuxerror<>0 then
+ halt(127);
+ end
+ else
+ begin
+ close(pipi);
+ dup2(filerec(pipo).handle,stdoutputhandle);
+ close(pipo);
+ if linuxerror<>0 then
+ halt(127);
+ end;
+ getmem(pp,sizeof(pchar)*4);
+ temp:='/bin/sh'#0'-c'#0+prog+#0;
+ p:=pp;
+ p^:=@temp[1];
+ inc(p);
+ p^:=@temp[9];
+ inc(p);
+ p^:=@temp[12];
+ inc(p);
+ p^:=Nil;
+ Execve('/bin/sh',pp,envp);
+ halt(127);
+ end
+ else
+ begin
+ { We're in the parent }
+ if rw='W' then
+ begin
+ close(pipi);
+ f:=pipo;
+ end
+ else
+ begin
+ close(pipo);
+ f:=pipi;
+ end;
+ {Save the process ID - needed when closing }
+ pl:=@(filerec(f).userdata[2]);
+ pl^:=pid;
+ end;
+end;
+
+
+Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : longint;
+{
+ Starts the program in 'Prog' and makes its input and output the
+ other end of two pipes, which are the stdin and stdout of a program
+ specified in 'Prog'.
+ streamout can be used to write to the program, streamin can be used to read
+ the output of the program. See the following diagram :
+ Parent Child
+ STreamout --> Input
+ Streamin <-- Output
+ Return value is the process ID of the process being spawned, or -1 in case of failure.
+}
+var
+ pipi,
+ pipo : text;
+ pid : longint;
+ pl : ^Longint;
+begin
+ LinuxError:=0;
+ AssignStream:=-1;
+ AssignPipe(streamin,pipo);
+ if Linuxerror<>0 then
+ exit;
+ AssignPipe(pipi,streamout);
+ if Linuxerror<>0 then
+ exit;
+ pid:=fork;
+ if linuxerror<>0 then
+ begin
+ close(pipi);
+ close(pipo);
+ close (streamin);
+ close (streamout);
+ exit;
+ end;
+ if pid=0 then
+ begin
+ { We're in the child }
+ { Close what we don't need }
+ close(streamout);
+ close(streamin);
+ dup2(pipi,input);
+ if linuxerror<>0 then
+ halt(127);
+ close(pipi);
+ dup2(pipo,output);
+ if linuxerror<>0 then
+ halt (127);
+ close(pipo);
+ Execl(Prog);
+ halt(127);
+ end
+ else
+ begin
+ { we're in the parent}
+ close(pipo);
+ close(pipi);
+ {Save the process ID - needed when closing }
+ pl:=@(textrec(StreamIn).userdata[2]);
+ pl^:=pid;
+ textrec(StreamIn).closefunc:=@PCloseText;
+ {Save the process ID - needed when closing }
+ pl:=@(textrec(StreamOut).userdata[2]);
+ pl^:=pid;
+ textrec(StreamOut).closefunc:=@PCloseText;
+ AssignStream:=Pid;
+ end;
+end;
+
+
+function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
+{
+ Starts the program in 'prog' and makes its input, output and error output the
+ other end of three pipes, which are the stdin, stdout and stderr of a program
+ specified in 'prog'.
+ StreamOut can be used to write to the program, StreamIn can be used to read
+ the output of the program, StreamErr reads the error output of the program.
+ See the following diagram :
+ Parent Child
+ StreamOut --> StdIn (input)
+ StreamIn <-- StdOut (output)
+ StreamErr <-- StdErr (error output)
+}
+var
+ PipeIn, PipeOut, PipeErr: text;
+ pid: LongInt;
+ pl: ^LongInt;
+begin
+ LinuxError := 0;
+ AssignStream := -1;
+
+ // Assign pipes
+ AssignPipe(StreamIn, PipeOut);
+ if LinuxError <> 0 then exit;
+
+ AssignPipe(StreamErr, PipeErr);
+ if LinuxError <> 0 then begin
+ Close(StreamIn);
+ Close(PipeOut);
+ exit;
+ end;
+
+ AssignPipe(PipeIn, StreamOut);
+ if LinuxError <> 0 then begin
+ Close(StreamIn);
+ Close(PipeOut);
+ Close(StreamErr);
+ Close(PipeErr);
+ exit;
+ end;
+
+ // Fork
+
+ pid := Fork;
+ if LinuxError <> 0 then begin
+ Close(StreamIn);
+ Close(PipeOut);
+ Close(StreamErr);
+ Close(PipeErr);
+ Close(PipeIn);
+ Close(StreamOut);
+ exit;
+ end;
+
+ if pid = 0 then begin
+ // *** We are in the child ***
+ // Close what we don not need
+ Close(StreamOut);
+ Close(StreamIn);
+ Close(StreamErr);
+ // Connect pipes
+ dup2(PipeIn, Input);
+ if LinuxError <> 0 then Halt(127);
+ Close(PipeIn);
+ dup2(PipeOut, Output);
+ if LinuxError <> 0 then Halt(127);
+ Close(PipeOut);
+ dup2(PipeErr, StdErr);
+ if LinuxError <> 0 then Halt(127);
+ Close(PipeErr);
+ // Execute program
+ Execl(Prog);
+ Halt(127);
+ end else begin
+ // *** We are in the parent ***
+ Close(PipeErr);
+ Close(PipeOut);
+ Close(PipeIn);
+ // Save the process ID - needed when closing
+ pl := @(TextRec(StreamIn).userdata[2]);
+ pl^ := pid;
+ TextRec(StreamIn).closefunc := @PCloseText;
+ // Save the process ID - needed when closing
+ pl := @(TextRec(StreamOut).userdata[2]);
+ pl^ := pid;
+ TextRec(StreamOut).closefunc := @PCloseText;
+ // Save the process ID - needed when closing
+ pl := @(TextRec(StreamErr).userdata[2]);
+ pl^ := pid;
+ TextRec(StreamErr).closefunc := @PCloseText;
+ AssignStream := pid;
+ end;
+end;
+
+
+{******************************************************************************
+ General information calls
+******************************************************************************}
+
+
+Function GetEnv(P:string):Pchar;
+{
+ Searches the environment for a string with name p and
+ returns a pchar to it's value.
+ A pchar is used to accomodate for strings of length > 255
+}
+var
+ ep : ppchar;
+ found : boolean;
+Begin
+ p:=p+'='; {Else HOST will also find HOSTNAME, etc}
+ ep:=envp;
+ found:=false;
+ if ep<>nil then
+ begin
+ while (not found) and (ep^<>nil) do
+ begin
+ if strlcomp(@p[1],(ep^),length(p))=0 then
+ found:=true
+ else
+ inc(ep);
+ end;
+ end;
+ if found then
+ getenv:=ep^+length(p)
+ else
+ getenv:=nil;
+end;
+
+
+{$ifndef bsd}
+Function GetDomainName:String;
+{
+ Get machines domain name. Returns empty string if not set.
+}
+Var
+ Sysn : utsname;
+begin
+ Uname(Sysn);
+ linuxerror:=errno;
+ If linuxerror<>0 then
+ getdomainname:=''
+ else
+ getdomainname:=strpas(@Sysn.domainname[0]);
+end;
+
+
+
+Function GetHostName:String;
+{
+ Get machines name. Returns empty string if not set.
+}
+Var
+ Sysn : utsname;
+begin
+ uname(Sysn);
+ linuxerror:=errno;
+ If linuxerror<>0 then
+ gethostname:=''
+ else
+ gethostname:=strpas(@Sysn.nodename[0]);
+end;
+{$endif}
+
+{******************************************************************************
+ Signal handling calls
+******************************************************************************}
+
+procedure SigRaise(sig:integer);
+begin
+ Kill(GetPid,Sig);
+end;
+
+
+{******************************************************************************
+ IOCtl and Termios calls
+******************************************************************************}
+
+
+Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
+begin
+ {$ifndef BSD}
+ TCGetAttr:=IOCtl(fd,TCGETS,@tios);
+ {$else}
+ TCGETAttr:=IoCtl(Fd,TIOCGETA,@tios);
+ {$endif}
+end;
+
+
+
+Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
+var
+ nr:longint;
+begin
+ {$ifndef BSD}
+ case OptAct of
+ TCSANOW : nr:=TCSETS;
+ TCSADRAIN : nr:=TCSETSW;
+ TCSAFLUSH : nr:=TCSETSF;
+ {$else}
+ case OptAct of
+ TCSANOW : nr:=TIOCSETA;
+ TCSADRAIN : nr:=TIOCSETAW;
+ TCSAFLUSH : nr:=TIOCSETAF;
+ {$endif}
+ else
+ begin
+ ErrNo:=Sys_EINVAL;
+ TCSetAttr:=false;
+ exit;
+ end;
+ end;
+ TCSetAttr:=IOCtl(fd,nr,@Tios);
+end;
+
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ {$ifndef BSD}
+ tios.c_cflag:=Cardinal(tios.c_cflag and cardinal(not CBAUD)) or speed;
+ {$else}
+ tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+ {$endif}
+end;
+
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+ {$ifndef BSD}
+ CFSetISpeed(tios,speed);
+ {$else}
+ tios.c_ospeed:=speed;
+ {$endif}
+end;
+
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+ {$ifndef BSD}
+ with tios do
+ begin
+ c_iflag:=c_iflag and cardinal(not (IGNBRK or BRKINT or PARMRK or ISTRIP or
+ INLCR or IGNCR or ICRNL or IXON));
+ c_oflag:=c_oflag and cardinal(not OPOST);
+ c_lflag:=c_lflag and cardinal(not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
+ c_cflag:=(c_cflag and cardinal(not (CSIZE or PARENB))) or CS8;
+ end;
+ {$else}
+ with tios do
+ begin
+ c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
+ PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+ IGNPAR));
+ c_iflag:=c_iflag OR IGNBRK;
+ c_oflag:=c_oflag and (not OPOST);
+ c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+ ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
+ c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+ {$endif}
+end;
+
+
+Function TCSendBreak(fd,duration:longint):boolean;
+begin
+ {$ifndef BSD}
+ TCSendBreak:=IOCtl(fd,TCSBRK,pointer(duration));
+ {$else}
+ TCSendBreak:=IOCtl(fd,TIOCSBRK,0);
+ {$endif}
+end;
+
+
+
+Function TCSetPGrp(fd,id:longint):boolean;
+begin
+ TCSetPGrp:=IOCtl(fd,TIOCSPGRP,pointer(id));
+end;
+
+
+
+Function TCGetPGrp(fd:longint;var id:longint):boolean;
+begin
+ TCGetPGrp:=IOCtl(fd,TIOCGPGRP,@id);
+end;
+
+
+Function TCDrain(fd:longint):boolean;
+begin
+ {$ifndef BSD}
+ TCDrain:=IOCtl(fd,TCSBRK,pointer(1));
+ {$else}
+ TCDrain:=IOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
+ {$endif}
+end;
+
+
+
+Function TCFlow(fd,act:longint):boolean;
+begin
+ {$ifndef BSD}
+ TCFlow:=IOCtl(fd,TCXONC,pointer(act));
+ {$else}
+ case act OF
+ TCOOFF : TCFlow:=Ioctl(fd,TIOCSTOP,0);
+ TCOOn : TCFlow:=IOctl(Fd,TIOCStart,0);
+ TCIOFF : {N/I}
+ end;
+ {$endif}
+end;
+
+
+
+Function TCFlush(fd,qsel:longint):boolean;
+
+begin
+ {$ifndef BSD}
+ TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
+ {$else}
+ TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
+ {$endif}
+end;
+
+Function IsATTY(Handle:Longint):Boolean;
+{
+ Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+var
+ t : Termios;
+begin
+ IsAtty:=TCGetAttr(Handle,t);
+end;
+
+
+
+Function IsATTY(var f: text):Boolean;
+{
+ Idem as previous, only now for text variables.
+}
+begin
+ IsATTY:=IsaTTY(textrec(f).handle);
+end;
+
+
+
+function TTYName(Handle:Longint):string;
+{
+ Return the name of the current tty described by handle f.
+ returns empty string in case of an error.
+}
+{$ifdef BSD}
+var
+ mydev,
+ myino : cardinal;
+{$else not BSD}
+var
+ mydev,
+ myino : longint;
+{$endif not BSD}
+ st : stat;
+
+ function mysearch(n:string): boolean;
+ {searches recursively for the device in the directory given by n,
+ returns true if found and sets the name of the device in ttyname}
+ var dirstream : pdir;
+ d : pdirent;
+ name : string;
+ st : stat;
+ begin
+ dirstream:=opendir(n);
+ if (linuxerror<>0) then
+ exit;
+ d:=Readdir(dirstream);
+ while (d<>nil) do
+ begin
+ name:=n+'/'+strpas(@(d^.name));
+ fstat(name,st);
+ if linuxerror=0 then
+ begin
+ if ((st.mode and $E000)=$4000) and { if it is a directory }
+ (strpas(@(d^.name))<>'.') and { but not ., .. and fd subdirs }
+ (strpas(@(d^.name))<>'..') and
+ (strpas(@(d^.name))<>'') and
+ (strpas(@(d^.name))<>'fd') then
+ begin {we found a directory, search inside it}
+ if mysearch(name) then
+ begin {the device is here}
+ closedir(dirstream); {then don't continue searching}
+ mysearch:=true;
+ exit;
+ end;
+ end
+ else if (d^.ino=myino) and (st.dev=mydev) then
+ begin
+ closedir(dirstream);
+ ttyname:=name;
+ mysearch:=true;
+ exit;
+ end;
+ end;
+ d:=Readdir(dirstream);
+ end;
+ closedir(dirstream);
+ mysearch:=false;
+ end;
+
+begin
+ TTYName:='';
+ fstat(handle,st);
+ if (errno<>0) and isatty (handle) then
+ exit;
+ mydev:=st.dev;
+ myino:=st.ino;
+ mysearch('/dev');
+end;
+
+function TTYName(var F:Text):string;
+{
+ Idem as previous, only now for text variables;
+}
+begin
+ TTYName:=TTYName(textrec(f).handle);
+end;
+
+
+
+{******************************************************************************
+ Utility calls
+******************************************************************************}
+
+Function Octal(l:longint):longint;
+{
+ Convert an octal specified number to decimal;
+}
+var
+ octnr,
+ oct : longint;
+begin
+ octnr:=0;
+ oct:=0;
+ while (l>0) do
+ begin
+ oct:=oct or ((l mod 10) shl octnr);
+ l:=l div 10;
+ inc(octnr,3);
+ end;
+ Octal:=oct;
+end;
+
+Function StringToPPChar(S: PChar):ppchar;
+var
+ nr : longint;
+ Buf : ^char;
+ p : ppchar;
+
+begin
+ buf:=s;
+ nr:=0;
+ while(buf^<>#0) do
+ begin
+ while (buf^ in [' ',#9,#10]) do
+ inc(buf);
+ inc(nr);
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+ getmem(p,(nr+1)*4);
+ StringToPPChar:=p;
+ if p=nil then
+ begin
+ LinuxError:=sys_enomem;
+ exit;
+ end;
+ buf:=s;
+ while (buf^<>#0) do
+ begin
+ while (buf^ in [' ',#9,#10]) do
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+end;
+
+Function StringToPPChar(Var S:String):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+ Note that the string S is destroyed by this call.
+}
+
+begin
+ S:=S+#0;
+ StringToPPChar:=StringToPPChar(@S[1]);
+end;
+
+Function StringToPPChar(Var S:AnsiString):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+}
+
+begin
+ StringToPPChar:=StringToPPChar(PChar(S));
+end;
+
+
+{
+function FExpand (const Path: PathStr): PathStr;
+- declared in fexpand.inc
+}
+
+{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
+{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
+
+const
+ LFNSupport = true;
+ FileNameCaseSensitive = true;
+
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_GETENVPCHAR}
+{$UNDEF FPC_FEXPAND_TILDE}
+
+
+
+Function FSearch(const path:pathstr;dirlist:string):pathstr;
+{
+ Searches for a file 'path' in the list of direcories in 'dirlist'.
+ returns an empty string if not found. Wildcards are NOT allowed.
+ If dirlist is empty, it is set to '.'
+}
+Var
+ NewDir : PathStr;
+ p1 : Longint;
+ Info : Stat;
+Begin
+{Replace ':' with ';'}
+ for p1:=1to length(dirlist) do
+ if dirlist[p1]=':' then
+ dirlist[p1]:=';';
+{Check for WildCards}
+ If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
+ FSearch:='' {No wildcards allowed in these things.}
+ Else
+ Begin
+ Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
+ Repeat
+ p1:=Pos(';',DirList);
+ If p1=0 Then
+ p1:=255;
+ NewDir:=Copy(DirList,1,P1 - 1);
+ if NewDir[Length(NewDir)]<>'/' then
+ NewDir:=NewDir+'/';
+ NewDir:=NewDir+Path;
+ Delete(DirList,1,p1);
+ if FStat(NewDir,Info) then
+ Begin
+ If Pos('./',NewDir)=1 Then
+ Delete(NewDir,1,2);
+ {DOS strips off an initial .\}
+ End
+ Else
+ NewDir:='';
+ Until (DirList='') or (Length(NewDir) > 0);
+ FSearch:=NewDir;
+ End;
+End;
+
+
+
+Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+Var
+ DotPos,SlashPos,i : longint;
+Begin
+ SlashPos:=0;
+ DotPos:=256;
+ i:=Length(Path);
+ While (i>0) and (SlashPos=0) Do
+ Begin
+ If (DotPos=256) and (Path[i]='.') Then
+ begin
+ DotPos:=i;
+ end;
+ If (Path[i]='/') Then
+ SlashPos:=i;
+ Dec(i);
+ End;
+ Ext:=Copy(Path,DotPos,255);
+ Dir:=Copy(Path,1,SlashPos);
+ Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
+End;
+
+
+
+Function Dirname(Const path:pathstr):pathstr;
+{
+ This function returns the directory part of a complete path.
+ Unless the directory is root '/', The last character is not
+ a slash.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if length(Dir)>1 then
+ Delete(Dir,length(Dir),1);
+ DirName:=Dir;
+end;
+
+
+
+Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+{
+ This function returns the filename part of a complete path. If suf is
+ supplied, it is cut off the filename.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if Suf<>Ext then
+ Name:=Name+Ext;
+ BaseName:=Name;
+end;
+
+
+
+Function FNMatch(const Pattern,Name:string):Boolean;
+Var
+ LenPat,LenName : longint;
+
+ Function DoFNMatch(i,j:longint):Boolean;
+ Var
+ Found : boolean;
+ Begin
+ Found:=true;
+ While Found and (i<=LenPat) Do
+ Begin
+ Case Pattern[i] of
+ '?' : Found:=(j<=LenName);
+ '*' : Begin
+ {find the next character in pattern, different of ? and *}
+ while Found and (i<LenPat) do
+ begin
+ inc(i);
+ case Pattern[i] of
+ '*' : ;
+ '?' : begin
+ inc(j);
+ Found:=(j<=LenName);
+ end;
+ else
+ Found:=false;
+ end;
+ end;
+ {Now, find in name the character which i points to, if the * or ?
+ wasn't the last character in the pattern, else, use up all the
+ chars in name}
+ Found:=true;
+ if (i<=LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j<=LenName) and (name[j]<>pattern[i]) do
+ inc (j);
+ if (j<LenName) then
+ begin
+ if DoFnMatch(i+1,j+1) then
+ begin
+ i:=LenPat;
+ j:=LenName;{we can stop}
+ Found:=true;
+ end
+ else
+ inc(j);{We didn't find one, need to look further}
+ end;
+ until (j>=LenName);
+ end
+ else
+ j:=LenName;{we can stop}
+ end;
+ else {not a wildcard character in pattern}
+ Found:=(j<=LenName) and (pattern[i]=name[j]);
+ end;
+ inc(i);
+ inc(j);
+ end;
+ DoFnMatch:=Found and (j>LenName);
+ end;
+
+Begin {start FNMatch}
+ LenPat:=Length(Pattern);
+ LenName:=Length(Name);
+ FNMatch:=DoFNMatch(1,1);
+End;
+
+
+
+Procedure Globfree(var p : pglob);
+{
+ Release memory occupied by pglob structure, and names in it.
+ sets p to nil.
+}
+var
+ temp : pglob;
+begin
+ while assigned(p) do
+ begin
+ temp:=p^.next;
+ if assigned(p^.name) then
+ freemem(p^.name);
+ dispose(p);
+ p:=temp;
+ end;
+end;
+
+
+
+Function Glob(Const path:pathstr):pglob;
+{
+ Fills a tglob structure with entries matching path,
+ and returns a pointer to it. Returns nil on error,
+ linuxerror is set accordingly.
+}
+var
+ temp,
+ temp2 : string[255];
+ thedir : pdir;
+ buffer : pdirent;
+ root,
+ current : pglob;
+begin
+{ Get directory }
+ temp:=dirname(path);
+ if temp='' then
+ temp:='.';
+ temp:=temp+#0;
+ thedir:=opendir(@temp[1]);
+ if thedir=nil then
+ begin
+ glob:=nil;
+ linuxerror:=errno;
+ exit;
+ end;
+ temp:=basename(path,''); { get the pattern }
+ if thedir^.fd<0 then
+ begin
+ linuxerror:=errno;
+ glob:=nil;
+ exit;
+ end;
+{get the entries}
+ root:=nil;
+ current:=nil;
+ repeat
+ buffer:=Sys_readdir(thedir);
+ if buffer=nil then
+ break;
+ temp2:=strpas(@(buffer^.name[0]));
+ if fnmatch(temp,temp2) then
+ begin
+ if root=nil then
+ begin
+ new(root);
+ current:=root;
+ end
+ else
+ begin
+ new(current^.next);
+ current:=current^.next;
+ end;
+ if current=nil then
+ begin
+ linuxerror:=Sys_ENOMEM;
+ globfree(root);
+ break;
+ end;
+ current^.next:=nil;
+ getmem(current^.name,length(temp2)+1);
+ if current^.name=nil then
+ begin
+ linuxerror:=Sys_ENOMEM;
+ globfree(root);
+ break;
+ end;
+ move(buffer^.name[0],current^.name^,length(temp2)+1);
+ end;
+ until false;
+ closedir(thedir);
+ glob:=root;
+end;
+
+
+{--------------------------------
+ FiledescriptorSets
+--------------------------------}
+
+Procedure FD_Zero(var fds:fdSet);
+{
+ Clear the set of filedescriptors
+}
+begin
+ FillChar(fds,sizeof(fdSet),0);
+end;
+
+
+
+Procedure FD_Clr(fd:longint;var fds:fdSet);
+{
+ Remove fd from the set of filedescriptors
+}
+begin
+ fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
+end;
+
+
+
+Procedure FD_Set(fd:longint;var fds:fdSet);
+{
+ Add fd to the set of filedescriptors
+}
+begin
+ fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
+end;
+
+
+
+Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
+{
+ Test if fd is part of the set of filedescriptors
+}
+begin
+ FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
+end;
+
+
+
+Function GetFS (var T:Text):longint;
+{
+ Get File Descriptor of a text file.
+}
+begin
+ if textrec(t).mode=fmclosed then
+ exit(-1)
+ else
+ GETFS:=textrec(t).Handle
+end;
+
+
+
+Function GetFS(Var F:File):longint;
+{
+ Get File Descriptor of an unTyped file.
+}
+begin
+ { Handle and mode are on the same place in textrec and filerec. }
+ if filerec(f).mode=fmclosed then
+ exit(-1)
+ else
+ GETFS:=filerec(f).Handle
+end;
+
+
+{--------------------------------
+ Stat.Mode Macro's
+--------------------------------}
+
+Function S_ISLNK(m:word):boolean;
+{
+ Check mode field of inode for link.
+}
+begin
+ S_ISLNK:=(m and STAT_IFMT)=STAT_IFLNK;
+end;
+
+
+
+Function S_ISREG(m:word):boolean;
+{
+ Check mode field of inode for regular file.
+}
+begin
+ S_ISREG:=(m and STAT_IFMT)=STAT_IFREG;
+end;
+
+
+
+Function S_ISDIR(m:word):boolean;
+
+{
+ Check mode field of inode for directory.
+}
+begin
+ S_ISDIR:=(m and STAT_IFMT)=STAT_IFDIR;
+end;
+
+
+
+Function S_ISCHR(m:word):boolean;
+{
+ Check mode field of inode for character device.
+}
+begin
+ S_ISCHR:=(m and STAT_IFMT)=STAT_IFCHR;
+end;
+
+
+
+Function S_ISBLK(m:word):boolean;
+{
+ Check mode field of inode for block device.
+}
+begin
+ S_ISBLK:=(m and STAT_IFMT)=STAT_IFBLK;
+end;
+
+
+
+Function S_ISFIFO(m:word):boolean;
+{
+ Check mode field of inode for named pipe (FIFO).
+}
+begin
+ S_ISFIFO:=(m and STAT_IFMT)=STAT_IFIFO;
+end;
+
+
+
+Function S_ISSOCK(m:word):boolean;
+{
+ Check mode field of inode for socket.
+}
+begin
+ S_ISSOCK:=(m and STAT_IFMT)=STAT_IFSOCK;
+end;
+
+
+Procedure WritePort (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Value' to port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ movb value,%al
+ outb %al,%dx
+ end ['EAX','EDX'];
+end;
+
+Procedure WritePort (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movw value,%ax
+ outw %ax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure WritePort (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movl value,%eax
+ outl %eax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+Procedure WritePortB (Port : Longint; Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Value' to port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ movb value,%al
+ outb %al,%dx
+ end ['EAX','EDX'];
+end;
+
+Procedure WritePortW (Port : Longint; Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movw value,%ax
+ outw %ax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure WritePortL (Port : Longint; Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movl value,%eax
+ outl %eax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure WritePortl (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Count' longints from 'Buf' to Port
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%esi
+ movl port,%edx
+ cld
+ rep
+ outsl
+ end ['ECX','ESI','EDX'];
+end;
+
+
+
+Procedure WritePortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Count' words from 'Buf' to Port
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%esi
+ movl port,%edx
+ cld
+ rep
+ outsw
+ end ['ECX','ESI','EDX'];
+end;
+
+
+
+Procedure WritePortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Writes 'Count' bytes from 'Buf' to Port
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%esi
+ movl port,%edx
+ cld
+ rep
+ outsb
+ end ['ECX','ESI','EDX'];
+end;
+
+
+
+Procedure ReadPort (Port : Longint; Var Value : Byte);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Reads 'Value' from port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ inb %dx,%al
+ movl value,%edx
+ movb %al,(%edx)
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure ReadPort (Port : Longint; Var Value : Word);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Reads 'Value' from port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ inw %dx,%ax
+ movl value,%edx
+ movw %ax,(%edx)
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure ReadPort (Port : Longint; Var Value : Longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Reads 'Value' from port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ inl %dx,%eax
+ movl value,%edx
+ movl %eax,(%edx)
+ end ['EAX','EDX'];
+end;
+
+
+
+function ReadPortB (Port : Longint): Byte;{$ifndef VER1_0}oldfpccall;{$endif} assembler;
+{
+ Reads a byte from port 'Port'
+}
+
+asm
+ xorl %eax,%eax
+ movl port,%edx
+ inb %dx,%al
+end ['EAX','EDX'];
+
+
+
+function ReadPortW (Port : Longint): Word;{$ifndef VER1_0}oldfpccall;{$endif} assembler;
+{
+ Reads a word from port 'Port'
+}
+asm
+ xorl %eax,%eax
+ movl port,%edx
+ inw %dx,%ax
+end ['EAX','EDX'];
+
+
+
+function ReadPortL (Port : Longint): LongInt;{$ifndef VER1_0}oldfpccall;{$endif} assembler;
+{
+ Reads a LongInt from port 'Port'
+}
+asm
+ movl port,%edx
+ inl %dx,%eax
+end ['EAX','EDX'];
+
+
+
+Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Reads 'Count' longints from port 'Port' to 'Buf'.
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%edi
+ movl port,%edx
+ cld
+ rep
+ insl
+ end ['ECX','EDI','EDX'];
+end;
+
+
+
+Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Reads 'Count' words from port 'Port' to 'Buf'.
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%edi
+ movl port,%edx
+ cld
+ rep
+ insw
+ end ['ECX','EDI','EDX'];
+end;
+
+
+
+Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);{$ifndef VER1_0}oldfpccall;{$endif}
+{
+ Reads 'Count' bytes from port 'Port' to 'Buf'.
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%edi
+ movl port,%edx
+ cld
+ rep
+ insb
+ end ['ECX','EDI','EDX'];
+end;
+
+{--------------------------------
+ Memory functions
+--------------------------------}
+
+Initialization
+ InitLocalTime;
+
+finalization
+ DoneLocalTime;
+
+End.
+
+{
+ $Log: linuxold.inc,v $
+ Revision 1.19 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/mouse.pp b/rtl/unix/mouse.pp
new file mode 100644
index 0000000000..fa6b4f5869
--- /dev/null
+++ b/rtl/unix/mouse.pp
@@ -0,0 +1,435 @@
+{
+ $Id: mouse.pp,v 1.15 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Mouse unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Mouse;
+interface
+
+{$ifdef NOMOUSE}
+{$DEFINE NOGPM}
+{$ENDIF}
+
+{$i mouseh.inc}
+
+implementation
+
+uses
+ BaseUnix,Video
+{$ifndef NOGPM}
+ ,gpm
+{$endif ndef NOGPM}
+ ;
+
+{$i mouse.inc}
+
+{$ifndef NOMOUSE}
+
+const
+ WaitMouseMove : boolean = false;
+ PrintMouseCur : boolean = false;
+ mousecurofs : longint = -1;
+
+var
+ mousecurcell : TVideoCell;
+ SysLastMouseEvent : TMouseEvent;
+
+const
+ gpm_fs : longint = -1;
+
+{$ifndef NOGPM}
+procedure GPMEvent2MouseEvent(const e:TGPMEvent;var mouseevent:tmouseevent);
+var
+ PrevButtons : byte;
+
+begin
+ PrevButtons:=SysLastMouseEvent.Buttons;
+ if e.x>0 then
+ mouseevent.x:=e.x-1
+ else
+ MouseEvent.x:=0;
+ if e.y>0 then
+ MouseEvent.y:=e.y-1
+ else
+ MouseEvent.y:=0;
+ MouseEvent.buttons:=0;
+ if e.buttons and Gpm_b_left<>0 then
+ inc(MouseEvent.buttons,1);
+ if e.buttons and Gpm_b_right<>0 then
+ inc(MouseEvent.buttons,2);
+ if e.buttons and Gpm_b_middle<>0 then
+ inc(MouseEvent.buttons,4);
+ case (e.EventType and $f) of
+ GPM_MOVE,
+ GPM_DRAG :
+ begin
+ MouseEvent.Action:=MouseActionMove;
+ WaitMouseMove:=false;
+ end;
+ GPM_DOWN :
+ begin
+ MouseEvent.Action:=MouseActionDown;
+ WaitMouseMove:=false;
+ end;
+ GPM_UP :
+ begin
+ { gpm apparently sends the button that is left up
+ while mouse unit expects the button state after
+ the button was released PM }
+ if MouseEvent.Buttons<>0 then
+ begin
+ MouseEvent.Buttons:=MouseEvent.Buttons xor PrevButtons;
+ MouseEvent.Action:=MouseActionUp;
+ end
+ { this does probably never happen...
+ but its just a security PM }
+ else
+ MouseEvent.Action:=MouseActionMove;
+ WaitMouseMove:=false;
+ end;
+ else
+ MouseEvent.Action:=0;
+ end;
+end;
+{$ENDIF}
+
+procedure PlaceMouseCur(ofs:longint);
+var
+ upd : boolean;
+begin
+ if (VideoBuf=nil) or (MouseCurOfs=Ofs) then
+ exit;
+ upd:=false;
+
+ if (MouseCurOfs<>-1) and (VideoBuf^[MouseCurOfs]=MouseCurCell) then
+ begin
+ VideoBuf^[MouseCurOfs]:=MouseCurCell xor $7f00;
+ upd:=true;
+ end;
+ MouseCurOfs:=ofs;
+ if (MouseCurOfs<>-1) then
+ begin
+ MouseCurCell:=VideoBuf^[MouseCurOfs] xor $7f00;
+ VideoBuf^[MouseCurOfs]:=MouseCurCell;
+ upd:=true;
+ end;
+ if upd then
+ Updatescreen(false);
+end;
+
+procedure SysInitMouse;
+{$ifndef NOGPM}
+var
+ connect : TGPMConnect;
+ E : TGPMEvent;
+{$endif ndef NOGPM}
+begin
+{$ifndef NOGPM}
+ if gpm_fs=-1 then
+ begin
+ { open gpm }
+ connect.EventMask:=GPM_MOVE or GPM_DRAG or GPM_DOWN or GPM_UP;
+ connect.DefaultMask:=0;
+ connect.MinMod:=0;
+ connect.MaxMod:=0;
+ gpm_fs:=Gpm_Open(connect,0);
+ if (gpm_fs=-2) and (fpgetenv('TERM')<>'xterm') then
+ begin
+ gpm_fs:=-1;
+ Gpm_Close;
+ end;
+ { initialize SysLastMouseEvent }
+ if gpm_fs<>-1 then
+ begin
+ Gpm_GetSnapshot(e);
+ GPMEvent2MouseEvent(e,SysLastMouseEvent);
+ end;
+ end;
+ { show mousepointer }
+ if gpm_fs<>-1 then
+ ShowMouse;
+{$else ifdef NOGPM}
+ if (fpgetenv('TERM')='xterm') then
+ begin
+ gpm_fs:=-2;
+ Write(#27'[?1001s'); { save old hilit tracking }
+ Write(#27'[?1000h'); { enable mouse tracking }
+ end;
+{$endif NOGPM}
+end;
+
+
+procedure SysDoneMouse;
+begin
+ If gpm_fs<>-1 then
+ begin
+ HideMouse;
+{$ifndef NOGPM}
+ Gpm_Close;
+{$else ifdef NOGPM}
+ Write(#27'[?1000l'); { disable mouse tracking }
+ Write(#27'[?1001r'); { Restore old hilit tracking }
+{$endif ifdef NOGPM}
+ gpm_fs:=-1;
+ end;
+end;
+
+
+function SysDetectMouse:byte;
+{$ifndef NOGPM}
+var
+ connect : TGPMConnect;
+{$endif ndef NOGPM}
+begin
+{$ifndef NOGPM}
+ if gpm_fs=-1 then
+ begin
+ connect.EventMask:=GPM_MOVE or GPM_DRAG or GPM_DOWN or GPM_UP;
+ connect.DefaultMask:=0;
+ connect.MinMod:=0;
+ connect.MaxMod:=0;
+ gpm_fs:=Gpm_Open(connect,0);
+ if (gpm_fs=-2) and (fpgetenv('TERM')<>'xterm') then
+ begin
+ Gpm_Close;
+ gpm_fs:=-1;
+ end;
+ end;
+{ always a mouse deamon present }
+ if gpm_fs<>-1 then
+ SysDetectMouse:=Gpm_GetSnapshot(nil)
+ else
+ SysDetectMouse:=0;
+{$else ifdef NOGPM}
+ if (fpgetenv('TERM')='xterm') then
+ SysDetectMouse:=2;
+{$endif NOGPM}
+end;
+
+
+procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
+{$ifndef NOGPM}
+var
+ e : TGPMEvent;
+{$endif ndef NOGPM}
+begin
+ fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+ if gpm_fs<0 then
+ exit;
+{$ifndef NOGPM}
+ Gpm_GetEvent(e);
+ GPMEvent2MouseEvent(e,MouseEvent);
+ SysLastMouseEvent:=MouseEvent;
+{ update mouse cursor }
+ if PrintMouseCur then
+ PlaceMouseCur(MouseEvent.y*ScreenWidth+MouseEvent.x);
+{$endif ndef NOGPM}
+end;
+
+
+
+function SysPollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+{$ifndef NOGPM}
+var
+ e : TGPMEvent;
+ fds : tFDSet;
+{$endif ndef NOGPM}
+begin
+ fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
+{$ifndef NOGPM}
+ if gpm_fs<0 then
+ exit(false);
+ if gpm_fs>0 then
+ begin
+ fpFD_ZERO(fds);
+ fpFD_SET(gpm_fs,fds);
+ end;
+ if (fpSelect(gpm_fs+1,@fds,nil,nil,1)>0) then
+ begin
+ FillChar(e,SizeOf(e),#0);
+ { Gpm_snapshot does not work here PM }
+ Gpm_GetEvent(e);
+ GPMEvent2MouseEvent(e,MouseEvent);
+ SysLastMouseEvent:=MouseEvent;
+ if (MouseEvent.Action<>0) then
+ begin
+ { As we now use Gpm_GetEvent, we need to put in
+ in the MouseEvent queue PM }
+ PutMouseEvent(MouseEvent);
+ SysPollMouseEvent:=true;
+ { update mouse cursor is also required here
+ as next call will read MouseEvent from queue }
+ if PrintMouseCur then
+ PlaceMouseCur(MouseEvent.y*ScreenWidth+MouseEvent.x);
+ end
+ else
+ SysPollMouseEvent:=false;
+ end
+ else
+{$endif NOGPM}
+ SysPollMouseEvent:=false;
+end;
+
+function SysGetMouseX:word;
+{$ifndef NOGPM}
+var
+ me : TMouseEvent;
+{$endif ndef NOGPM}
+begin
+ if gpm_fs<0 then
+ exit(0);
+{$ifndef NOGPM}
+ if PollMouseEvent(ME) then
+ begin
+ { Remove mouse event, we are only interrested in
+ the X,Y so all other events can be thrown away }
+ GetMouseEvent(ME);
+ SysGetMouseX:=ME.X
+ end
+ else
+ begin
+ SysGetMouseX:=SysLastMouseEvent.x;
+ end;
+{$endif ndef NOGPM}
+end;
+
+
+function SysGetMouseY:word;
+{$ifndef NOGPM}
+var
+ me : TMouseEvent;
+{$endif ndef NOGPM}
+begin
+ if gpm_fs<0 then
+ exit(0);
+{$ifndef NOGPM}
+ if PollMouseEvent(ME) then
+ begin
+ { Remove mouse event, we are only interrested in
+ the X,Y so all other events can be thrown away }
+ GetMouseEvent(ME);
+ SysGetMouseY:=ME.Y
+ end
+ else
+ begin
+ SysGetMouseY:=SysLastMouseEvent.y;
+ end;
+{$endif ndef NOGPM}
+end;
+
+
+procedure SysShowMouse;
+var
+ x,y : word;
+begin
+ PrintMouseCur:=true;
+ { Wait with showing the cursor until the mouse has moved. Else the
+ cursor updates will be to quickly }
+ if WaitMouseMove then
+ exit;
+ if (MouseCurOfs>=0) or (gpm_fs=-1) then
+ PlaceMouseCur(MouseCurOfs)
+ else
+ begin
+ x:=SysGetMouseX;
+ y:=SysGetMouseY;
+ if (x<=ScreenWidth) and (y<=ScreenHeight) then
+ PlaceMouseCur(Y*ScreenWidth+X)
+ else
+ PlaceMouseCur(MouseCurOfs);
+ end;
+end;
+
+
+procedure SysHideMouse;
+begin
+ if (MouseCurOfs>=0) then
+ PlaceMouseCur(-1);
+ WaitMouseMove:=true;
+ PrintMouseCur:=false;
+end;
+
+
+function SysGetMouseButtons:word;
+{$ifndef NOGPM}
+var
+ me : TMouseEvent;
+{$endif ndef NOGPM}
+begin
+ if gpm_fs<0 then
+ exit(0);
+{$ifndef NOGPM}
+ if PollMouseEvent(ME) then
+ begin
+ { Remove mouse event, we are only interrested in
+ the buttons so all other events can be thrown away }
+ GetMouseEvent(ME);
+ SysGetMouseButtons:=ME.Buttons;
+ end
+ else
+ begin
+ SysGetMouseButtons:=SysLastMouseEvent.buttons;
+ end;
+{$endif ndef NOGPM}
+end;
+
+
+Const
+ SysMouseDriver : TMouseDriver = (
+ UseDefaultQueue : true;
+ InitDriver : @SysInitMouse;
+ DoneDriver : @SysDoneMouse;
+ DetectMouse : @SysDetectMouse;
+ ShowMouse : @SysShowMouse;
+ HideMouse : @SysHideMouse;
+ GetMouseX : @SysGetMouseX;
+ GetMouseY : @SysGetMouseY;
+ GetMouseButtons : @SysGetMouseButtons;
+ SetMouseXY : Nil;
+ GetMouseEvent : @SysGetMouseEvent;
+ PollMouseEvent : @SysPollMouseEvent;
+ PutMouseEvent : Nil;
+ );
+
+{$else ifndef NOMOUSE}
+
+Const
+ SysMouseDriver : TMouseDriver = (
+ UseDefaultQueue : true;
+ InitDriver : Nil;
+ DoneDriver : Nil;
+ DetectMouse : Nil;
+ ShowMouse : Nil;
+ HideMouse : Nil;
+ GetMouseX : Nil;
+ GetMouseY : Nil;
+ GetMouseButtons : Nil;
+ SetMouseXY : Nil;
+ GetMouseEvent : Nil;
+ PollMouseEvent : Nil;
+ PutMouseEvent : Nil;
+ );
+
+{$endif}
+
+Begin
+ SetMouseDriver(SysMouseDriver);
+end.
+
+{
+ $Log: mouse.pp,v $
+ Revision 1.15 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/oldlinux.pp b/rtl/unix/oldlinux.pp
new file mode 100644
index 0000000000..2d53fe77f4
--- /dev/null
+++ b/rtl/unix/oldlinux.pp
@@ -0,0 +1 @@
+{$i linuxold.inc}
diff --git a/rtl/unix/oscdeclh.inc b/rtl/unix/oscdeclh.inc
new file mode 100644
index 0000000000..4a2326ac73
--- /dev/null
+++ b/rtl/unix/oscdeclh.inc
@@ -0,0 +1,102 @@
+{
+ $Id: oscdeclh.inc,v 1.14 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file should become an alternative to the syscalls in due time,
+ to import the base calls from libc.
+ Be very careful though. Kernel types and libc types are often not the
+ same on Linux.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+{ var
+ Errno : cint; external clib name 'errno';}
+
+Type TGrpArr = Array [0..0] of TGid; { C style array workarounds}
+ pGrpArr = ^TGrpArr;
+ TFilDes = Array [0..1] of cInt;
+ pFilDes = ^TFilDes;
+
+ function FpAccess (pathname : pchar; amode : cint): cint; cdecl; external clib name 'access';
+ function FpChdir (path : pchar): cint; cdecl; external clib name 'chdir';
+ function FpClose (fd : cint): cint; cdecl; external clib name 'close';
+ Function FpClosedir (var dirp : Dir): cInt; cdecl; external clib name 'closedir';
+ function FpClosedir (dirp : pdir): cint; cdecl; external clib name 'closedir';
+ function FpDup (oldd:cint):cint; cdecl; external clib name 'dup';
+ function FpDup2 (oldd:cint;newd:cint):cint; cdecl; external clib name 'dup2';
+ function FpExecve (path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external clib name 'execve';
+ function FpFork : TPid; cdecl; external clib name 'fork';
+ function FpFstat (fd : cint; var sb : stat): cint; cdecl; external clib name 'fstat';
+ function FpFtruncate(fd : cint; flength : TOff): cint; cdecl; external clib name 'ftruncate';
+ function FpLseek (fd : cint; offset : TOff; whence : cint): TOff; cdecl; external clib name 'lseek';
+ function FpMkdir (path : pchar; mode: TMode):cint; cdecl; external clib name 'mkdir';
+ function FpOpen (path: pchar; flags : cint; mode: TMode):cint; cdecl; external clib name 'open';
+ function FpOpendir (dirname : pchar): pdir; cdecl; external clib name 'opendir';
+ function FpRead (fd: cint; buf: pchar; nbytes : TSize): TSSize; cdecl; external clib name 'read';
+ function FpReaddir (dirp : pdir) : pdirent;cdecl; external clib name 'readdir';
+ Function FpReaddir (var dirp : Dir) : pDirent;cdecl; external clib name 'readdir';
+ function FpRename (old : pchar; newpath: pchar): cint; cdecl;external clib name 'rename';
+ function FpRmdir (path : pchar): cint; cdecl; external clib name 'rmdir';
+ function FpSigaction (sig: cint;var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external clib name 'sigaction';
+ Function FPSigaction (sig: cInt; act :pSigActionRec;oact:pSigActionRec):cint;cdecl; external clib name 'sigaction';
+ Function FpChmod (path : pChar; Mode : TMode): cInt; cdecl; external clib name 'chmod';
+ Function FPUtime(path:pchar;times:putimbuf):cint; cdecl; external clib name 'utime';
+ Function FpGetcwd (path:pChar; siz:TSize):pChar; cdecl; external clib name 'getcwd';
+ function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint;cdecl; external clib name 'sigprocmask';
+ function FPSigProcMask(how:cint;const nset : sigset;var oset : sigset):cint;cdecl; external clib name 'sigprocmask';
+ function FpStat (path: pchar; var buf : stat): cint; cdecl; external clib name 'stat';
+ function FpTime (tloc:ptime_t): time_t; cdecl; external clib name 'time';
+ Function FpTime (var tloc : TTime): TTime; cdecl; external clib name 'time';
+ function FpUname (var name: utsname): cint; cdecl; external clib name 'uname';
+ function FpUnlink (path: pchar): cint; cdecl; external clib name 'unlink';
+ function FpWaitpid (pid : TPid; stat_loc : pcint; options: cint): TPid; cdecl; external clib name 'waitpid';
+ function FpWrite (fd: cint;buf:pchar; nbytes : TSize): TSSize; cdecl; external clib name 'write';
+ procedure FpExit (status : cint); cdecl; external clib name '_exit';
+ function fpmmap (addr:pointer;len:size_t;prot:cint;flags:cint;fd:cint;ofs:off_t):pointer; cdecl; external clib name 'mmap';
+ function fpmunmap (addr:pointer;len:size_t):cint; cdecl; external clib name 'munmap';
+ function FpIOCtl (Handle:cint;Ndx: culong;Data: Pointer):cint; cdecl; external clib name 'ioctl';
+ Function FPSelect (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external clib name 'select';
+ function fpgetenv (name : pchar):pchar; cdecl; external clib name 'getenv';
+ Function FpKill (pid : TPid; sig: cInt): cInt; cdecl; external clib name 'kill';
+ Function FpGetpid : TPid; cdecl;external clib name 'getpid';
+ Function FpGetppid : TPid;cdecl;external clib name 'getppid';
+ Function FpGetuid : TUid;cdecl;external clib name 'getuid';
+ Function FpGeteuid : TUid;cdecl;external clib name 'geteuid';
+ Function FpGetgid : TGid;cdecl;external clib name 'getgid';
+ Function FpGetegid : TGid;cdecl;external clib name 'getegid';
+ Function FpSetuid (uid : TUid): cInt;cdecl;external clib name 'setuid';
+ Function FpSetgid (gid : TGid): cInt;cdecl;external clib name 'setgid';
+ Function FpGetgroups (gidsetsize : cInt; var grouplist : tgrparr):cint; cdecl;external clib name 'getgroups';
+ Function FpGetpgrp : TPid; cdecl;external clib name 'getpgrp';
+ Function FpSetsid : TPid; cdecl;external clib name 'setsid';
+ Function FpPipe (var fildes : tfildes):cInt; cdecl;external clib name 'pipe';
+ Function FpFcntl (fildes : cInt; cmd : cInt): cInt; cdecl; external clib name 'fcntl';
+ Function FpFcntl (fildes : cInt; cmd : cInt; arg :cInt): cInt; cdecl; external clib name 'fcntl';
+ Function FpFcntl (fildes : cInt; cmd : cInt; var arg : flock): cInt; cdecl external clib name 'fcntl';
+ Function FPnanosleep (const rqtp: ptimespec; rmtp: ptimespec): cint; cdecl; external clib name 'nanosleep';
+ Function fpLstat (path:pchar;Info:pstat):cint; cdecl; external clib name 'lstat';
+ function fpNice (N:cint):cint; cdecl; external clib name 'nice';
+ Function fpGetPriority (Which,Who:cint):cint; cdecl; external clib name 'getpriority';
+ Function fpSetPriority (Which,Who,What:cint):cint; cdecl; external clib name 'setpriority';
+ Function fpSymlink (oldname,newname:pchar):cint; cdecl; external clib name 'symlink';
+ Function fpReadLink (name,linkname:pchar;maxlen:size_t):cint; cdecl; external clib name 'readlink';
+ Function FpUmask (cmask : TMode): TMode; cdecl; external clib name 'umask';
+ function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
+
+{
+ $Log: oscdeclh.inc,v $
+ Revision 1.14 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.13 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
diff --git a/rtl/unix/ports.pp b/rtl/unix/ports.pp
new file mode 100644
index 0000000000..0bbbc9d1e8
--- /dev/null
+++ b/rtl/unix/ports.pp
@@ -0,0 +1,109 @@
+{
+ $Id: ports.pp,v 1.6 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Unit ports;
+
+{$mode objfpc}
+
+{ Implements the
+ port[] portw[] and portl[]
+ constructs using Delphi classes }
+
+Interface
+
+type
+ tport = class
+ protected
+ procedure writeport(p : longint;data : byte);
+ function readport(p : longint) : byte;
+ public
+ property pp[w : longint] : byte read readport write writeport;default;
+ end;
+
+ tportw = class
+ protected
+ procedure writeport(p : longint;data : word);
+ function readport(p : longint) : word;
+ public
+ property pp[w : longint] : word read readport write writeport;default;
+ end;
+
+ tportl = class
+ Protected
+ procedure writeport(p : longint;data : longint);
+ function readport(p : longint) : longint;
+ Public
+ property pp[w : Longint] : longint read readport write writeport;default;
+ end;
+
+
+ { Non-Instantiaded vars. As yet, they don't have to be instantiated,
+ because there is no need for 'self' etc. }
+
+var
+ port,
+ portb : tport;
+ portw : tportw;
+ portl : tportl;
+
+
+implementation
+
+uses x86;
+
+{ to give easy port access like tp with port[] }
+
+procedure tport.writeport(p : Longint;data : byte);
+
+begin
+ x86.writeport (p,data)
+end;
+
+function tport.readport(p : Longint) : byte;
+
+begin
+ readport := x86.readportb (p);
+end;
+
+procedure tportw.writeport(p : longint;data : word);
+
+begin
+ x86.writeport (p,data)
+end;
+
+function tportw.readport(p : longint) : word;
+
+begin
+ readport := x86.readportw(p);
+end;
+
+procedure tportl.writeport(p : longint;data : longint);
+
+begin
+ x86.writeport (p,data)
+end;
+
+function tportl.readport(p : longint) : longint;
+
+begin
+ readPort := x86.readportl(p);
+end;
+
+end.
+ $Log: ports.pp,v $
+ Revision 1.6 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/printer.pp b/rtl/unix/printer.pp
new file mode 100644
index 0000000000..5004223dc4
--- /dev/null
+++ b/rtl/unix/printer.pp
@@ -0,0 +1,248 @@
+{
+ $Id: printer.pp,v 1.8 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ Change Log
+ ----------
+
+ Started by Michael Van Canneyt, 1996
+ (michael@tfdec1.fys.kuleuven.ac.be)
+
+ Current version is 0.9
+
+ Date Version Who Comments
+ 1999-2000 by 0.8 Michael Initial implementation
+ 11/97 0.9 Peter Vreman <pfv@worldonline.nl>
+ Unit now depends on the
+ linux unit only.
+ Cleaned up code.
+
+ ---------------------------------------------------------------------}
+
+Unit printer;
+
+Interface
+
+{.$DEFINE PRINTERDEBUG}
+
+{$I printerh.inc}
+
+Procedure AssignLst ( Var F : text; ToFile : string);
+{
+ Assigns to F a printing device. ToFile is a string with the following form:
+ '|filename options' : This sets up a pipe with the program filename,
+ with the given options
+ 'filename' : Prints to file filename. Filename can contain the string 'PID'
+ (No Quotes), which will be replaced by the PID of your program.
+ When closing lst, the file will be sent to lpr and deleted.
+ (lpr should be in PATH)
+
+ 'filename|' Idem as previous, only the file is NOT sent to lpr, nor is it
+ deleted.
+ (useful for opening /dev/printer or for later printing)
+
+ Lst is set up using '/tmp/PID.lst'. You can change this behaviour at
+ compile time, setting the DefFile constant.
+}
+
+Implementation
+Uses Unix,BaseUnix,Strings;
+
+{$I printer.inc}
+
+{
+ include definition of textrec
+}
+{$i textrec.inc}
+
+
+Const
+ P_TOF = 1; { Print to file }
+ P_TOFNP = 2; { Print to File, don't spool }
+ P_TOP = 3; { Print to Pipe }
+
+Var
+ Lpr : String[255]; { Contains path to lpr binary, including null char }
+
+Procedure PrintAndDelete (f:string);
+var
+ i,j : longint;
+ p,pp : ppchar;
+begin
+ f:=f+#0;
+ if lpr='' then
+ exit;
+ i:=fpFork;
+ if i<0 then
+ exit; { No printing was done. We leave the file where it is.}
+ if i=0 then
+ begin
+ { We're in the child }
+ getmem(p,12);
+ if p=nil then
+ halt(127);
+ pp:=p;
+ pp^:=@lpr[1];
+ inc(pp);
+ pp^:=@f[1];
+ inc(pp);
+ pp^:=nil;
+ fpExecve(lpr,p,envp);
+ { In trouble here ! }
+ halt(128)
+ end
+ else
+ begin
+ { We're in the parent. }
+ fpwaitpid (i,@j,0);
+ if j<>0 then
+ exit;
+ { Erase the file }
+ fpUnlink(f);
+ end;
+end;
+
+
+
+Procedure OpenLstPipe ( Var F : Text);
+begin
+ POpen (f,StrPas(textrec(f).name),'W');
+end;
+
+
+
+Procedure OpenLstFile ( Var F : Text);
+var
+ i : longint;
+begin
+{$IFDEF PRINTERDEBUG}
+ writeln ('Printer : In OpenLstFile');
+{$ENDIF}
+ If textrec(f).mode <> fmoutput then
+ exit;
+ textrec(f).userdata[15]:=0; { set Zero length flag }
+ i:=fpOpen(StrPas(textrec(f).name),(Open_WrOnly or Open_Creat), 438);
+ if i<0 then
+ textrec(f).mode:=fmclosed
+ else
+ textrec(f).handle:=i;
+end;
+
+
+
+Procedure CloseLstFile ( Var F : Text);
+begin
+{$IFDEF PRINTERDEBUG}
+ writeln ('Printer : In CloseLstFile');
+{$ENDIF}
+ fpclose (textrec(f).handle);
+{ In case length is zero, don't print : lpr would give an error }
+ if (textrec(f).userdata[15]=0) and (textrec(f).userdata[16]=P_TOF) then
+ begin
+ fpUnlink(StrPas(textrec(f).name));
+ exit
+ end;
+{ Non empty : needs printing ? }
+ if (textrec(f).userdata[16]=P_TOF) then
+ PrintAndDelete (strpas(textrec(f).name));
+ textrec(f).mode:=fmclosed
+end;
+
+
+
+Procedure InOutLstFile ( Var F : text);
+begin
+{$IFDEF PRINTERDEBUG}
+ writeln ('Printer : In InOutLstFile');
+{$ENDIF}
+ If textrec(f).mode<>fmoutput then
+ exit;
+ if textrec(f).bufpos<>0 then
+ textrec(f).userdata[15]:=1; { Set it is not empty. Important when closing !!}
+ fpwrite(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
+ textrec(f).bufpos:=0;
+end;
+
+
+
+function SubstPidInName (const S: string): string;
+var
+ i : longint;
+ temp : string[8];
+begin
+ i:=pos('PID',s);
+ if i=0 then
+ SubstPidInName := S
+ else
+ begin
+ Str (fpGetPid, Temp);
+ SubstPidInName := Copy (S, 1, Pred (I)) + Temp +
+ Copy (S, I + 3, Length (S) - I - 2);
+{$IFDEF PRINTERDEBUG}
+ writeln ('Print : Filename became : ', Result);
+{$ENDIF}
+ end;
+end;
+
+
+
+Procedure AssignLst ( Var F : text; ToFile : string);
+begin
+{$IFDEF PRINTERDEBUG}
+ writeln ('Printer : In AssignLst');
+{$ENDIF}
+ If ToFile='' then
+ exit;
+ textrec(f).bufptr:=@textrec(f).buffer;
+ textrec(f).bufsize:=128;
+ ToFile := SubstPidInName (ToFile);
+ if ToFile[1]='|' then
+ begin
+ Assign(f,Copy(ToFile,2,255));
+ textrec(f).userdata[16]:=P_TOP;
+ textrec(f).OpenFunc:=@OpenLstPipe;
+ end
+ else
+ begin
+ if Tofile[Length(ToFile)]='|' then
+ begin
+ Assign(f,Copy(ToFile,1,length(Tofile)-1));
+ textrec(f).userdata[16]:=P_TOFNP;
+ end
+ else
+ begin
+ Assign(f,ToFile);
+ textrec(f).userdata[16]:=P_TOF;
+ end;
+ textrec(f).OpenFunc:=@OpenLstFile;
+ textrec(f).CloseFunc:=@CloseLstFile;
+ textrec(f).InoutFunc:=@InoutLstFile;
+ textrec(f).FlushFunc:=@InoutLstFile;
+ end;
+end;
+
+
+begin
+ InitPrinter (SubstPidInName ('/tmp/PID.lst'));
+ SetPrinterExit;
+ Lpr := '/usr/bin/lpr';
+end.
+
+
+{
+ $Log: printer.pp,v $
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/serial.pp b/rtl/unix/serial.pp
new file mode 100644
index 0000000000..6932be4943
--- /dev/null
+++ b/rtl/unix/serial.pp
@@ -0,0 +1,221 @@
+{ Unit for handling the serial interfaces for Linux and similar Unices.
+ (c) 2000 Sebastian Guenther, sg@freepascal.org
+}
+
+unit Serial;
+
+{$MODE objfpc}
+{$H+}
+{$PACKRECORDS C}
+
+interface
+
+uses BaseUnix,termio,unix;
+
+type
+
+ TSerialHandle = LongInt;
+
+ TParityType = (NoneParity, OddParity, EvenParity);
+
+ TSerialFlags = set of (RtsCtsFlowControl);
+
+ TSerialState = record
+ LineState: LongWord;
+ tios: termios;
+ end;
+
+
+{ Open the serial device with the given device name, for example:
+ /dev/ttyS0, /dev/ttyS1... for normal serial ports
+ /dev/ttyI0, /dev/ttyI1... for ISDN emulated serial ports
+ other device names are possible; refer to your OS documentation.
+ Returns "0" if device could not be found }
+function SerOpen(const DeviceName: String): TSerialHandle;
+
+{ Closes a serial device previously opened with SerOpen. }
+procedure SerClose(Handle: TSerialHandle);
+
+{ Flushes the data queues of the given serial device. }
+procedure SerFlush(Handle: TSerialHandle);
+
+{ Reads a maximum of "Count" bytes of data into the specified buffer.
+ Result: Number of bytes read. }
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+{ Tries to write "Count" bytes from "Buffer".
+ Result: Number of bytes written. }
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+ ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+ Flags: TSerialFlags);
+
+{ Saves and restores the state of the serial device. }
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+
+{ Getting and setting the line states directly. }
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+function SerGetRI(Handle: TSerialHandle): Boolean;
+
+
+{ ************************************************************************** }
+
+implementation
+
+
+function SerOpen(const DeviceName: String): TSerialHandle;
+begin
+ Result := fpopen(DeviceName, O_RDWR or O_NOCTTY);
+end;
+
+procedure SerClose(Handle: TSerialHandle);
+begin
+ fpClose(Handle);
+end;
+
+procedure SerFlush(Handle: TSerialHandle);
+begin
+ fsync(Handle);
+end;
+
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+ Result := fpRead(Handle, Buffer, Count);
+end;
+
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+ Result := fpWrite(Handle, Buffer, Count);
+end;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+ ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+ Flags: TSerialFlags);
+var
+ tios: termios;
+begin
+ FillChar(tios, SizeOf(tios), #0);
+
+ case BitsPerSec of
+ 50: tios.c_cflag := B50;
+ 75: tios.c_cflag := B75;
+ 110: tios.c_cflag := B110;
+ 134: tios.c_cflag := B134;
+ 150: tios.c_cflag := B150;
+ 200: tios.c_cflag := B200;
+ 300: tios.c_cflag := B300;
+ 600: tios.c_cflag := B600;
+ 1200: tios.c_cflag := B1200;
+ 1800: tios.c_cflag := B1800;
+ 2400: tios.c_cflag := B2400;
+ 4800: tios.c_cflag := B4800;
+ 19200: tios.c_cflag := B19200;
+ 38400: tios.c_cflag := B38400;
+ 57600: tios.c_cflag := B57600;
+ 115200: tios.c_cflag := B115200;
+ 230400: tios.c_cflag := B230400;
+{$ifndef BSD}
+ 460800: tios.c_cflag := B460800;
+{$endif}
+ else tios.c_cflag := B9600;
+ end;
+ tios.c_ispeed := tios.c_cflag;
+ tios.c_ospeed := tios.c_ispeed;
+
+ tios.c_cflag := tios.c_cflag or CREAD or CLOCAL;
+
+ case ByteSize of
+ 5: tios.c_cflag := tios.c_cflag or CS5;
+ 6: tios.c_cflag := tios.c_cflag or CS6;
+ 7: tios.c_cflag := tios.c_cflag or CS7;
+ else tios.c_cflag := tios.c_cflag or CS8;
+ end;
+
+ case Parity of
+ OddParity: tios.c_cflag := tios.c_cflag or PARENB or PARODD;
+ EvenParity: tios.c_cflag := tios.c_cflag or PARENB;
+ end;
+
+ if StopBits = 2 then
+ tios.c_cflag := tios.c_cflag or CSTOPB;
+
+ if RtsCtsFlowControl in Flags then
+ tios.c_cflag := tios.c_cflag or CRTSCTS;
+
+ tcflush(Handle, TCIOFLUSH);
+ tcsetattr(Handle, TCSANOW, tios)
+end;
+
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+begin
+ fpioctl(Handle, TIOCMGET, @Result.LineState);
+// fpioctl(Handle, TCGETS, @Result.tios);
+ TcGetAttr(handle,result.tios);
+
+end;
+
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+begin
+// fpioctl(Handle, TCSETS, @State.tios);
+ TCSetAttr(handle,TCSANOW,State.tios);
+ fpioctl(Handle, TIOCMSET, @State.LineState);
+end;
+
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+const
+ DTR: Cardinal = TIOCM_DTR;
+begin
+ if State then
+ fpioctl(Handle, TIOCMBIS, @DTR)
+ else
+ fpioctl(Handle, TIOCMBIC, @DTR);
+end;
+
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+const
+ RTS: Cardinal = TIOCM_RTS;
+begin
+ if State then
+ fpioctl(Handle, TIOCMBIS, @RTS)
+ else
+ fpioctl(Handle, TIOCMBIC, @RTS);
+end;
+
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ fpioctl(Handle, TIOCMGET, @Flags);
+ Result := (Flags and TIOCM_CTS) <> 0;
+end;
+
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ fpioctl(Handle, TIOCMGET, @Flags);
+ Result := (Flags and TIOCM_DSR) <> 0;
+end;
+
+function SerGetRI(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ fpioctl(Handle, TIOCMGET, @Flags);
+ Result := (Flags and TIOCM_RI) <> 0;
+end;
+
+
+end.
+
+{
+ $Log: serial.pp,v $
+ Revision 1.11 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/settimeo.inc b/rtl/unix/settimeo.inc
new file mode 100644
index 0000000000..5e99cb0d4c
--- /dev/null
+++ b/rtl/unix/settimeo.inc
@@ -0,0 +1,46 @@
+{
+ $Id: settimeo.inc,v 1.8 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2004 by Michael Van Canneyt,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$ifdef usestime}
+
+function stime (t:ptime_t):cint;
+begin
+ stime:=do_SysCall(Syscall_nr_stime,TSysParam(t));
+end;
+
+function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+begin
+ fpsettimeofday:=stime(@tp^.tv_sec);
+end;
+
+{$else}
+
+function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+begin
+ fpsettimeofday:=do_SysCall(Syscall_nr_settimeofday,TSysParam(@tp),TSysParam(tzp));
+end;
+
+{$endif}
+
+{
+ $Log: settimeo.inc,v $
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.7 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+}
+
diff --git a/rtl/unix/sockets.pp b/rtl/unix/sockets.pp
new file mode 100644
index 0000000000..a6f1c4ec48
--- /dev/null
+++ b/rtl/unix/sockets.pp
@@ -0,0 +1,76 @@
+{
+ $Id: sockets.pp,v 1.11 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Sockets;
+Interface
+
+{$ifdef Unix}
+Uses UnixType;
+{$endif}
+
+{$ifdef FreeBSD}
+{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr
+{$endif}
+
+{$i unxsockh.inc}
+{$i socketsh.inc}
+
+type
+ TUnixSockAddr = packed Record
+ {$ifdef SOCK_HAS_SINLEN}
+ sa_len : cuchar;
+ {$endif}
+ family : sa_family_t;
+ path:array[0..107] of char; //104 total for freebsd.
+ end;
+
+
+{ unix socket specific functions }
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+Function Bind(Sock:longint;const addr:string):boolean;
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+
+//function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint; maybelibc
+//function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint; maybelibc
+//function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint; maybelibc
+
+Implementation
+
+Uses BaseUnix,{$ifndef FPC_USE_LIBC}SysCall{$else}initc{$endif};
+
+{ Include filerec and textrec structures }
+{$i filerec.inc}
+{$i textrec.inc}
+{******************************************************************************
+ Kernel Socket Callings
+******************************************************************************}
+
+{$ifndef FPC_USE_LIBC}
+{$i unixsock.inc}
+{$else}
+{$i stdsock.inc}
+{$endif}
+{$i sockovl.inc}
+{$i sockets.inc}
+
+end.
+
+{
+ $Log: sockets.pp,v $
+ Revision 1.11 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/syscall.pp b/rtl/unix/syscall.pp
new file mode 100644
index 0000000000..fe001aac4b
--- /dev/null
+++ b/rtl/unix/syscall.pp
@@ -0,0 +1,11 @@
+unit syscall;
+
+interface
+{$define FPC_USE_SYSCALL}
+
+{$i sysnr.inc}
+{$i syscallh.inc}
+
+implementation
+
+end.
diff --git a/rtl/unix/sysdir.inc b/rtl/unix/sysdir.inc
new file mode 100644
index 0000000000..45eb8219af
--- /dev/null
+++ b/rtl/unix/sysdir.inc
@@ -0,0 +1,169 @@
+{
+ $Id: sysdir.inc,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Main OS dependant body of the system unit, loosely modelled
+ after POSIX. *BSD version (Linux version is near identical)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+Procedure MkDir(Const s: String);[IOCheck];
+const
+ { read/write search permission for everyone }
+ MODE_MKDIR = S_IWUSR OR S_IRUSR OR
+ S_IWGRP OR S_IRGRP OR
+ S_IWOTH OR S_IROTH OR
+ S_IXUSR OR S_IXGRP OR S_IXOTH;
+Var
+ Buffer: Array[0..255] of Char;
+Begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ Move(s[1], Buffer, Length(s));
+ Buffer[Length(s)] := #0;
+ If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+End;
+
+
+Procedure RmDir(Const s: String);[IOCheck];
+Var
+ Buffer: Array[0..255] of Char;
+Begin
+ if (s = '.') then
+ InOutRes := 16;
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ Move(s[1], Buffer, Length(s));
+ Buffer[Length(s)] := #0;
+ If Fprmdir(@buffer)<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+End;
+
+
+Procedure ChDir(Const s: String);[IOCheck];
+Var
+ Buffer: Array[0..255] of Char;
+Begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ Move(s[1], Buffer, Length(s));
+ Buffer[Length(s)] := #0;
+ If Fpchdir(@buffer)<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+ { file not exists is path not found under tp7 }
+ if InOutRes=2 then
+ InOutRes:=3;
+End;
+
+{ // $define usegetcwd}
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+{$ifdef usegetcwd}
+ buf : array[0..254] of char;
+{$else}
+ cwdinfo : stat;
+ rootinfo : stat;
+ thedir,dummy : string[255];
+ dirstream : pdir;
+ d : pdirent;
+ name : string[255];
+ thisdir : stat;
+ tmp : string[255];
+{$endif}
+
+begin
+ dir:='';
+{$ifdef usegetcwd}
+ if Fpgetcwd(@buf,sizeof(buf))<>nil then
+ dir:=strpas(buf);
+{$else}
+ thedir:='';
+ dummy:='';
+
+ { get root directory information }
+ tmp := '/'+#0;
+ if Fpstat(@tmp[1],rootinfo)<0 then
+ Exit;
+ repeat
+ tmp := dummy+'.'+#0;
+ { get current directory information }
+ if Fpstat(@tmp[1],cwdinfo)<0 then
+ Exit;
+ tmp:=dummy+'..'+#0;
+ { open directory stream }
+ { try to find the current inode number of the cwd }
+ dirstream:=Fpopendir(@tmp[1]);
+ if dirstream=nil then
+ exit;
+ repeat
+ name:='';
+ d:=Fpreaddir(dirstream);
+ { no more entries to read ... }
+ if not assigned(d) then
+ break;
+ tmp:=dummy+'../'+strpas(d^.d_name) + #0;
+ if (Fpstat(@tmp[1],thisdir)=0) then
+ begin
+ { found the entry for this directory name }
+ if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
+ begin
+ { are the filenames of type '.' or '..' ? }
+ { then do not set the name. }
+ if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
+ ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
+ name:='/'+strpas(d^.d_name);
+ end;
+ end;
+ until (name<>'');
+ if Fpclosedir(dirstream)<0 then
+ Exit;
+ thedir:=name+thedir;
+ dummy:=dummy+'../';
+ if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
+ begin
+ if thedir='' then
+ dir:='/'
+ else
+ dir:=thedir;
+ exit;
+ end;
+ until false;
+ {$endif}
+end;
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.2 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+ Revision 1.1 2005/02/07 22:04:55 peter
+ * moved to unix
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/unix/sysfile.inc b/rtl/unix/sysfile.inc
new file mode 100644
index 0000000000..6fb2472015
--- /dev/null
+++ b/rtl/unix/sysfile.inc
@@ -0,0 +1,237 @@
+{
+ $Id: sysfile.inc,v 1.1 2005/02/07 22:04:55 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Main OS dependant body of the system unit, loosely modelled
+ after POSIX. *BSD version (Linux version is near identical)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure Do_Close(Handle:thandle);
+Begin
+ Fpclose(cint(Handle));
+End;
+
+Procedure Do_Erase(p:pchar);
+var
+ fileinfo : stat;
+Begin
+ { verify if the filename is actually a directory }
+ { if so return error and do nothing, as defined }
+ { by POSIX }
+ if Fpstat(p,fileinfo)<0 then
+ begin
+ Errno2Inoutres;
+ exit;
+ end;
+ if FpS_ISDIR(fileinfo.st_mode) then
+ begin
+ InOutRes := 2;
+ exit;
+ end;
+ if Fpunlink(p)<0 then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+End;
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;fpos:longint);
+begin
+ { should be simulated in cases where it is not }
+ { available. }
+ If Fpftruncate(handle,fpos)<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+end;
+
+
+
+Procedure Do_Rename(p1,p2:pchar);
+Begin
+ If Fprename(p1,p2)<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+End;
+
+
+Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
+
+var j : cint;
+Begin
+ repeat
+ Do_Write:=Fpwrite(Handle,addr,len);
+ j:=geterrno;
+ until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
+ If Do_Write<0 Then
+ Begin
+ Errno2InOutRes;
+ Do_Write:=0;
+ End
+ else
+ InOutRes:=0;
+End;
+
+
+Function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
+
+var j:cint;
+
+Begin
+ repeat
+ Do_Read:=Fpread(Handle,addr,len);
+ j:=geterrno;
+ until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
+ If Do_Read<0 Then
+ Begin
+ Errno2InOutRes;
+ Do_Read:=0;
+ End
+ else
+ InOutRes:=0;
+End;
+
+function Do_FilePos(Handle: thandle):longint;
+Begin
+ do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
+ If Do_FilePos<0 Then
+ Errno2InOutRes
+ else
+ InOutRes:=0;
+End;
+
+Procedure Do_Seek(Handle:thandle;Pos:Longint);
+Begin
+ If Fplseek(Handle, pos, SEEK_SET)<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+End;
+
+Function Do_SeekEnd(Handle:thandle): Longint;
+begin
+ Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
+ If Do_SeekEnd<0 Then
+ Errno2Inoutres
+ Else
+ InOutRes:=0;
+end;
+
+Function Do_FileSize(Handle:thandle): Longint;
+var
+ Info : Stat;
+ Ret : Longint;
+Begin
+ Ret:=Fpfstat(handle,info);
+ If Ret=0 Then
+ Do_FileSize:=Info.st_size
+ else
+ Do_FileSize:=0;
+ If Ret<0 Then
+ Errno2InOutRes
+ Else
+ InOutRes:=0;
+End;
+
+Procedure Do_Open(var f;p:pchar;flags:longint);
+{
+ FileRec and textrec have both Handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+const
+ { read/write permission for everyone }
+ MODE_OPEN = S_IWUSR OR S_IRUSR OR
+ S_IWGRP OR S_IRGRP OR
+ S_IWOTH OR S_IROTH;
+var
+ oflags : cint;
+Begin
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case FileRec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file Handle }
+ FileRec(f).Handle:=UnusedHandle;
+{ We do the conversion of filemodes here, concentrated on 1 place }
+ case (flags and 3) of
+ 0 : begin
+ oflags :=O_RDONLY;
+ FileRec(f).mode:=fminput;
+ end;
+ 1 : begin
+ oflags :=O_WRONLY;
+ FileRec(f).mode:=fmoutput;
+ end;
+ 2 : begin
+ oflags :=O_RDWR;
+ FileRec(f).mode:=fminout;
+ end;
+ end;
+ if (flags and $1000)=$1000 then
+ oflags:=oflags or (O_CREAT or O_TRUNC)
+ else
+ if (flags and $100)=$100 then
+ oflags:=oflags or (O_APPEND);
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+{ real open call }
+ FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+ if (FileRec(f).Handle<0) and
+ (getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
+ begin
+ Oflags:=Oflags and not(O_RDWR);
+ FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+ end;
+ If Filerec(f).Handle<0 Then
+ Errno2Inoutres
+ else
+ InOutRes:=0;
+End;
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.1 2005/02/07 22:04:55 peter
+ * moved to unix
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/unix/sysheap.inc b/rtl/unix/sysheap.inc
new file mode 100644
index 0000000000..daa5adbdbb
--- /dev/null
+++ b/rtl/unix/sysheap.inc
@@ -0,0 +1,50 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/07 22:04:55 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function SysOSAlloc(size: ptrint): pointer;
+begin
+ result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+ if result=pointer(-1) then
+ result:=nil
+ else
+ seterrno(0);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+ fpmunmap(p, size);
+end;
+
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/07 22:04:55 peter
+ * moved to unix
+
+ Revision 1.1 2005/02/06 16:57:18 peter
+ * threads for go32v2,os,emx,netware
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/unix/systhrd.inc b/rtl/unix/systhrd.inc
new file mode 100644
index 0000000000..1efcc2c7fb
--- /dev/null
+++ b/rtl/unix/systhrd.inc
@@ -0,0 +1,36 @@
+{
+ $Id: systhrd.inc,v 1.1 2005/02/06 12:16:52 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Procedure InitSystemThreads;
+begin
+ { This should be changed to a real value during
+ thread driver initialization if appropriate. }
+ ThreadID := 1;
+ SetNoThreadManager;
+end;
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.1 2005/02/06 12:16:52 peter
+ * bsd thread updates
+
+ Revision 1.1 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
+
diff --git a/rtl/unix/sysunixh.inc b/rtl/unix/sysunixh.inc
new file mode 100644
index 0000000000..9550410fc4
--- /dev/null
+++ b/rtl/unix/sysunixh.inc
@@ -0,0 +1,72 @@
+{
+ $Id: sysunixh.inc,v 1.26 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal Run time library.
+ Copyright (c) 2001 by the Free Pascal development team
+
+ This file contains the OS independent declarations of the system unit
+ for unix styled systems
+
+ See the File COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define newsignal}
+
+{$I systemh.inc}
+
+{$ifdef cpum68k}
+{ used for single computations }
+const
+ BIAS4 = $7f-1;
+{$endif cpum68k}
+
+const
+ LineEnding = #10;
+ LFNSupport = true;
+ DirectorySeparator = '/';
+ DriveSeparator = ':';
+ PathSeparator = ':';
+{ FileNameCaseSensitive is defined below! }
+ maxExitCode = 255;
+
+const
+ UnusedHandle = -1;
+ StdInputHandle = 0;
+ StdOutputHandle = 1;
+ StdErrorHandle = 2;
+
+ FileNameCaseSensitive : boolean = true;
+ CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+
+{$ifndef Solaris}
+{$ifndef Darwin}
+var argc:longint;external name 'operatingsystem_parameter_argc';
+ argv:PPchar;external name 'operatingsystem_parameter_argv';
+ envp:PPchar;external name 'operatingsystem_parameter_envp';
+{$endif}
+{$endif}
+
+{
+ $Log: sysunixh.inc,v $
+ Revision 1.26 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.25 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.24 2005/02/14 16:32:41 peter
+ * solaris updates
+
+ Revision 1.23 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+}
diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp
new file mode 100644
index 0000000000..55ee964432
--- /dev/null
+++ b/rtl/unix/sysutils.pp
@@ -0,0 +1,1249 @@
+{
+ $Id: sysutils.pp,v 1.59 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+{$DEFINE HAS_SLEEP}
+{$DEFINE HAS_OSERROR}
+{$DEFINE HAS_OSCONFIG}
+{$DEFINE HAS_TEMPDIR}
+{$DEFINE HASUNIX}
+
+uses
+ Unix,errors,sysconst,Unixtype;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+Procedure AddDisk(const path:string);
+
+
+implementation
+
+Uses
+ {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix;
+
+{$Define OS_FILEISREADONLY} // Specific implementation for Unix.
+
+Function getenv(name:shortstring):Pchar; external name 'FPC_SYSC_FPGETENV';
+
+Type
+ ComStr = String[255];
+ PathStr = String[255];
+ DirStr = String[255];
+ NameStr = String[255];
+ ExtStr = String[255];
+
+
+{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
+{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
+
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_GETENVPCHAR}
+{$UNDEF FPC_FEXPAND_TILDE}
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+Const
+{Date Translation}
+ C1970=2440588;
+ D0 = 1461;
+ D1 = 146097;
+ D2 =1721119;
+
+
+Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
+Var
+ YYear,XYear,Temp,TempMonth : LongInt;
+Begin
+ Temp:=((JulianDN-D2) shl 2)-1;
+ JulianDN:=Temp Div D1;
+ XYear:=(Temp Mod D1) or 3;
+ YYear:=(XYear Div D0);
+ Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
+ Day:=((Temp Mod 153)+5) Div 5;
+ TempMonth:=Temp Div 153;
+ If TempMonth>=10 Then
+ Begin
+ inc(YYear);
+ dec(TempMonth,12);
+ End;
+ inc(TempMonth,3);
+ Month := TempMonth;
+ Year:=YYear+(JulianDN*100);
+end;
+
+
+
+Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
+{
+ Transforms Epoch time into local time (hour, minute,seconds)
+}
+Var
+ DateNum: LongInt;
+Begin
+ inc(Epoch,TZSeconds);
+ Datenum:=(Epoch Div 86400) + c1970;
+ JulianToGregorian(DateNum,Year,Month,day);
+ Epoch:=Abs(Epoch Mod 86400);
+ Hour:=Epoch Div 3600;
+ Epoch:=Epoch Mod 3600;
+ Minute:=Epoch Div 60;
+ Second:=Epoch Mod 60;
+End;
+
+
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+
+
+Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+Var
+ DotPos,SlashPos,i : longint;
+Begin
+ SlashPos:=0;
+ DotPos:=256;
+ i:=Length(Path);
+ While (i>0) and (SlashPos=0) Do
+ Begin
+ If (DotPos=256) and (Path[i]='.') Then
+ begin
+ DotPos:=i;
+ end;
+ If (Path[i]='/') Then
+ SlashPos:=i;
+ Dec(i);
+ End;
+ Ext:=Copy(Path,DotPos,255);
+ Dir:=Copy(Path,1,SlashPos);
+ Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
+End;
+
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+
+Var LinuxFlags : longint;
+
+BEGIN
+ LinuxFlags:=0;
+ Case (Mode and 3) of
+ 0 : LinuxFlags:=LinuxFlags or O_RdOnly;
+ 1 : LinuxFlags:=LinuxFlags or O_WrOnly;
+ 2 : LinuxFlags:=LinuxFlags or O_RdWr;
+ end;
+ FileOpen:=fpOpen (FileName,LinuxFlags);
+ //!! We need to set locking based on Mode !!
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+
+begin
+ FileCreate:=fpOpen(FileName,O_RdWr or O_Creat or O_Trunc);
+end;
+
+
+Function FileCreate (Const FileName : String;Mode : Longint) : Longint;
+
+Var LinuxFlags : longint;
+
+BEGIN
+ LinuxFlags:=0;
+ Case (Mode and 3) of
+ 0 : LinuxFlags:=LinuxFlags or O_RdOnly;
+ 1 : LinuxFlags:=LinuxFlags or O_WrOnly;
+ 2 : LinuxFlags:=LinuxFlags or O_RdWr;
+ end;
+ FileCreate:=fpOpen(FileName,LinuxFlags or O_Creat or O_Trunc);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+
+begin
+ FileRead:=fpRead (Handle,Buffer,Count);
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+
+begin
+ FileWrite:=fpWrite (Handle,Buffer,Count);
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+
+begin
+ FileSeek:=fplSeek (Handle,FOffset,Origin);
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+
+begin
+ {$warning need to add 64bit call }
+ FileSeek:=fplSeek (Handle,FOffset,Origin);
+end;
+
+
+Procedure FileClose (Handle : Longint);
+
+begin
+ fpclose(Handle);
+end;
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+
+begin
+ FileTruncate:=fpftruncate(Handle,Size)>=0;
+end;
+
+Function UnixToWinAge(UnixAge : time_t): Longint;
+
+Var
+ Y,M,D,hh,mm,ss : word;
+
+begin
+ EpochToLocal(UnixAge,y,m,d,hh,mm,ss);
+ Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+
+Var Info : Stat;
+
+begin
+ If fpstat (FileName,Info)<0 then
+ exit(-1)
+ else
+ Result:=UnixToWinAge(info.st_mtime);
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+
+Var Info : Stat;
+
+begin
+ FileExists:=fpstat(filename,Info)>=0;
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+
+Var Info : Stat;
+
+begin
+ DirectoryExists:=(fpstat(Directory,Info)>=0) and fpS_ISDIR(Info.st_mode);
+end;
+
+
+Function LinuxToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
+
+begin
+ Result:=faArchive;
+ If fpS_ISDIR(Info.st_mode) then
+ Result:=Result or faDirectory;
+ If (FN[0]='.') and (not (FN[1] in [#0,'.'])) then
+ Result:=Result or faHidden;
+ If (Info.st_Mode and S_IWUSR)=0 Then
+ Result:=Result or faReadOnly;
+ If fpS_ISSOCK(Info.st_mode) or fpS_ISBLK(Info.st_mode) or fpS_ISCHR(Info.st_mode) or fpS_ISFIFO(Info.st_mode) Then
+ Result:=Result or faSysFile;
+end;
+
+type
+
+ pglob = ^tglob;
+ tglob = record
+ name : pchar;
+ next : pglob;
+ end;
+
+Function Dirname(Const path:pathstr):pathstr;
+{
+ This function returns the directory part of a complete path.
+ Unless the directory is root '/', The last character is not
+ a slash.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if length(Dir)>1 then
+ Delete(Dir,length(Dir),1);
+ DirName:=Dir;
+end;
+
+
+Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+{
+ This function returns the filename part of a complete path. If suf is
+ supplied, it is cut off the filename.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if Suf<>Ext then
+ Name:=Name+Ext;
+ BaseName:=Name;
+end;
+
+
+Function FNMatch(const Pattern,Name:shortstring):Boolean;
+Var
+ LenPat,LenName : longint;
+
+ Function DoFNMatch(i,j:longint):Boolean;
+ Var
+ Found : boolean;
+ Begin
+ Found:=true;
+ While Found and (i<=LenPat) Do
+ Begin
+ Case Pattern[i] of
+ '?' : Found:=(j<=LenName);
+ '*' : Begin
+ {find the next character in pattern, different of ? and *}
+ while Found do
+ begin
+ inc(i);
+ if i>LenPat then Break;
+ case Pattern[i] of
+ '*' : ;
+ '?' : begin
+ if j>LenName then begin DoFNMatch:=false; Exit; end;
+ inc(j);
+ end;
+ else
+ Found:=false;
+ end;
+ end;
+ Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
+ {Now, find in name the character which i points to, if the * or ?
+ wasn't the last character in the pattern, else, use up all the
+ chars in name}
+ Found:=false;
+ if (i<=LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j<=LenName) and (name[j]<>pattern[i]) do
+ inc (j);
+ if (j<LenName) then
+ begin
+ if DoFnMatch(i+1,j+1) then
+ begin
+ i:=LenPat;
+ j:=LenName;{we can stop}
+ Found:=true;
+ Break;
+ end else
+ inc(j);{We didn't find one, need to look further}
+ end else
+ if j=LenName then
+ begin
+ Found:=true;
+ Break;
+ end;
+ { This 'until' condition must be j>LenName, not j>=LenName.
+ That's because when we 'need to look further' and
+ j = LenName then loop must not terminate. }
+ until (j>LenName);
+ end else
+ begin
+ j:=LenName;{we can stop}
+ Found:=true;
+ end;
+ end;
+ else {not a wildcard character in pattern}
+ Found:=(j<=LenName) and (pattern[i]=name[j]);
+ end;
+ inc(i);
+ inc(j);
+ end;
+ DoFnMatch:=Found and (j>LenName);
+ end;
+
+Begin {start FNMatch}
+ LenPat:=Length(Pattern);
+ LenName:=Length(Name);
+ FNMatch:=DoFNMatch(1,1);
+End;
+
+
+Procedure Globfree(var p : pglob);
+{
+ Release memory occupied by pglob structure, and names in it.
+ sets p to nil.
+}
+var
+ temp : pglob;
+begin
+ while assigned(p) do
+ begin
+ temp:=p^.next;
+ if assigned(p^.name) then
+ freemem(p^.name);
+ dispose(p);
+ p:=temp;
+ end;
+end;
+
+
+Function Glob(Const path:pathstr):pglob;
+{
+ Fills a tglob structure with entries matching path,
+ and returns a pointer to it. Returns nil on error,
+ linuxerror is set accordingly.
+}
+var
+ temp,
+ temp2 : string[255];
+ thedir : pdir;
+ buffer : pdirent;
+ root,
+ current : pglob;
+begin
+{ Get directory }
+ temp:=dirname(path);
+ if temp='' then
+ temp:='.';
+ temp:=temp+#0;
+ thedir:=fpopendir(@temp[1]);
+ if thedir=nil then
+ exit(nil);
+ temp:=basename(path,''); { get the pattern }
+ if thedir^.dd_fd<0 then
+ exit(nil);
+{get the entries}
+ root:=nil;
+ current:=nil;
+ repeat
+ buffer:=fpreaddir(thedir^);
+ if buffer=nil then
+ break;
+ temp2:=strpas(@(buffer^.d_name[0]));
+ if fnmatch(temp,temp2) then
+ begin
+ if root=nil then
+ begin
+ new(root);
+ current:=root;
+ end
+ else
+ begin
+ new(current^.next);
+ current:=current^.next;
+ end;
+ if current=nil then
+ begin
+ fpseterrno(ESysENOMEM);
+ globfree(root);
+ break;
+ end;
+ current^.next:=nil;
+ getmem(current^.name,length(temp2)+1);
+ if current^.name=nil then
+ begin
+ fpseterrno(ESysENOMEM);
+ globfree(root);
+ break;
+ end;
+ move(buffer^.d_name[0],current^.name^,length(temp2)+1);
+ end;
+ until false;
+ fpclosedir(thedir^);
+ glob:=root;
+end;
+
+
+{
+ GlobToSearch takes a glob entry, stats the file.
+ The glob entry is removed.
+ If FileAttributes match, the entry is reused
+}
+
+Type
+ TGlobSearchRec = Record
+ Path : shortString;
+ GlobHandle : PGlob;
+ end;
+ PGlobSearchRec = ^TGlobSearchRec;
+
+Function GlobToTSearchRec (Var Info : TSearchRec) : Boolean;
+
+Var SInfo : Stat;
+ p : Pglob;
+ GlobSearchRec : PGlobSearchrec;
+
+begin
+ GlobSearchRec:=Info.FindHandle;
+ P:=GlobSearchRec^.GlobHandle;
+ Result:=P<>Nil;
+ If Result then
+ begin
+ GlobSearchRec^.GlobHandle:=P^.Next;
+ Result:=Fpstat(GlobSearchRec^.Path+StrPas(p^.name),SInfo)>=0;
+ If Result then
+ begin
+ Info.Attr:=LinuxToWinAttr(p^.name,SInfo);
+ Result:=(Info.ExcludeAttr and Info.Attr)=0;
+ If Result Then
+ With Info do
+ begin
+ Attr:=Info.Attr;
+ If P^.Name<>Nil then
+ Name:=strpas(p^.name);
+ Time:=UnixToWinAge(Sinfo.st_mtime);
+ Size:=Sinfo.st_Size;
+ Mode:=Sinfo.st_mode;
+ end;
+ end;
+ P^.Next:=Nil;
+ GlobFree(P);
+ end;
+end;
+
+Function DoFind(Var Rslt : TSearchRec) : Longint;
+
+Var
+ GlobSearchRec : PGlobSearchRec;
+
+begin
+ Result:=-1;
+ GlobSearchRec:=Rslt.FindHandle;
+ If (GlobSearchRec^.GlobHandle<>Nil) then
+ While (GlobSearchRec^.GlobHandle<>Nil) and not (Result=0) do
+ If GlobToTSearchRec(Rslt) Then Result:=0;
+end;
+
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+
+Var
+ GlobSearchRec : PGlobSearchRec;
+
+begin
+ New(GlobSearchRec);
+ GlobSearchRec^.Path:=ExpandFileName(ExtractFilePath(Path));
+ GlobSearchRec^.GlobHandle:=Glob(Path);
+ Rslt.ExcludeAttr:=Not Attr and (faHidden or faSysFile or faVolumeID or faDirectory); //!! Not correct !!
+ Rslt.FindHandle:=GlobSearchRec;
+ Result:=DoFind (Rslt);
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+
+begin
+ Result:=DoFind (Rslt);
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+
+Var
+ GlobSearchRec : PGlobSearchRec;
+
+begin
+ GlobSearchRec:=F.FindHandle;
+ GlobFree (GlobSearchRec^.GlobHandle);
+ Dispose(GlobSearchRec);
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+
+Var Info : Stat;
+
+begin
+ If (fpFStat(Handle,Info))<0 then
+ Result:=-1
+ else
+ Result:=Info.st_Mtime;
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+
+begin
+ // Impossible under Linux from FileHandle !!
+ FileSetDate:=-1;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+
+Var Info : Stat;
+
+begin
+ If FpStat (FileName,Info)<0 then
+ Result:=-1
+ Else
+ Result:=LinuxToWinAttr(Pchar(FileName),Info);
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+
+begin
+ Result:=-1;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+
+begin
+ Result:=fpUnLink (FileName)>=0;
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+
+begin
+ RenameFile:=BaseUnix.FpRename(OldNAme,NewName)>=0;
+end;
+
+Function FileIsReadOnly(const FileName: String): Boolean;
+
+begin
+ Result := fpAccess(PChar(FileName),W_OK)<>0;
+end;
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+{
+ The Diskfree and Disksize functions need a file on the specified drive, since this
+ is required for the statfs system call.
+ These filenames are set in drivestr[0..26], and have been preset to :
+ 0 - '.' (default drive - hence current dir is ok.)
+ 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system )
+ 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system )
+ 3 - '/' (C: equivalent of dos is the root partition)
+ 4..26 (can be set by you're own applications)
+ ! Use AddDisk() to Add new drives !
+ They both return -1 when a failure occurs.
+}
+Const
+ FixDriveStr : array[0..3] of pchar=(
+ '.',
+ '/fd0/.',
+ '/fd1/.',
+ '/.'
+ );
+var
+ Drives : byte;
+ DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+ if not (DriveStr[Drives]=nil) then
+ FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+ GetMem(DriveStr[Drives],length(Path)+1);
+ StrPCopy(DriveStr[Drives],path);
+ inc(Drives);
+ if Drives>26 then
+ Drives:=4;
+end;
+
+
+Function DiskFree(Drive: Byte): int64;
+var
+ fs : tstatfs;
+Begin
+ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
+ ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
+ Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+ else
+ Diskfree:=-1;
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+var
+ fs : tstatfs;
+Begin
+ if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
+ ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
+ DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+ else
+ DiskSize:=-1;
+End;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+
+Function GetEpochTime: cint;
+{
+ Get the number of seconds since 00:00, January 1 1970, GMT
+ the time NOT corrected any way
+}
+begin
+ GetEpochTime:=fptime;
+end;
+
+procedure GetTime(var hour,min,sec,msec,usec:word);
+{
+ Gets the current time, adjusted to local time
+}
+var
+ year,day,month:Word;
+ tz:timeval;
+begin
+ fpgettimeofday(@tz,nil);
+ EpochToLocal(tz.tv_sec,year,month,day,hour,min,sec);
+ msec:=tz.tv_usec div 1000;
+ usec:=tz.tv_usec mod 1000;
+end;
+
+procedure GetTime(var hour,min,sec,sec100:word);
+{
+ Gets the current time, adjusted to local time
+}
+var
+ usec : word;
+begin
+ gettime(hour,min,sec,sec100,usec);
+ sec100:=sec100 div 10;
+end;
+
+Procedure GetTime(Var Hour,Min,Sec:Word);
+{
+ Gets the current time, adjusted to local time
+}
+var
+ msec,usec : Word;
+Begin
+ gettime(hour,min,sec,msec,usec);
+End;
+
+Procedure GetDate(Var Year,Month,Day:Word);
+{
+ Gets the current date, adjusted to local time
+}
+var
+ hour,minute,second : word;
+Begin
+ EpochToLocal(fptime,year,month,day,hour,minute,second);
+End;
+
+Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
+{
+ Gets the current date, adjusted to local time
+}
+Begin
+ EpochToLocal(fptime,year,month,day,hour,minute,second);
+End;
+
+
+
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+
+var
+ usecs : Word;
+begin
+ GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond, usecs);
+ GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
+// SystemTime.MilliSecond := 0;
+end ;
+
+
+Procedure InitAnsi;
+Var
+ i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,LowerCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=StrError(ErrorCode);
+end;
+
+{****************************************************************************
+ OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=StrPas(BaseUnix.FPGetenv(PChar(EnvVar)));
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ Result:=FPCCountEnvVar(EnvP);
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ Result:=FPCGetEnvStrFromP(Envp,Index);
+end;
+
+
+{$define FPC_USE_FPEXEC} // leave the old code under IFDEF for a while.
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+var
+ pid : longint;
+ e : EOSError;
+ CommandLine: AnsiString;
+ cmdline2 : ppchar;
+
+Begin
+ { always surround the name of the application by quotes
+ so that long filenames will always be accepted. But don't
+ do it if there are already double quotes!
+ }
+ {$ifdef FPC_USE_FPEXEC} // Only place we still parse
+ cmdline2:=nil;
+ if Comline<>'' Then
+ begin
+ CommandLine:=ComLine;
+ cmdline2:=StringtoPPChar(CommandLine,1);
+ cmdline2^:=pchar(Path);
+ end
+ else
+ begin
+ getmem(cmdline2,2*sizeof(pchar));
+ cmdline2^:=pchar(Path);
+ cmdline2[1]:=nil;
+ end;
+ {$else}
+ if Pos ('"', Path) = 0 then
+ CommandLine := '"' + Path + '"'
+ else
+ CommandLine := Path;
+ if ComLine <> '' then
+ CommandLine := Commandline + ' ' + ComLine;
+ {$endif}
+ pid:=fpFork;
+ if pid=0 then
+ begin
+ {The child does the actual exec, and then exits}
+ {$ifdef FPC_USE_FPEXEC}
+ fpexecv(pchar(Path),Cmdline2);
+ {$else}
+ Execl(CommandLine);
+ {$endif}
+ { If the execve fails, we return an exitvalue of 127, to let it be known}
+ fpExit(127);
+ end
+ else
+ if pid=-1 then {Fork failed}
+ begin
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
+ e.ErrorCode:=-1;
+ raise e;
+ end;
+
+ { We're in the parent, let's wait. }
+ result:=WaitProcess(pid); // WaitPid and result-convert
+
+ if (result<0) or (result=127) then
+ begin
+ E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
+ E.ErrorCode:=result;
+ Raise E;
+ end;
+End;
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
+
+var
+ pid : longint;
+ e : EOSError;
+
+Begin
+ { always surround the name of the application by quotes
+ so that long filenames will always be accepted. But don't
+ do it if there are already double quotes!
+ }
+ pid:=fpFork;
+ if pid=0 then
+ begin
+ {The child does the actual exec, and then exits}
+ fpexecl(Path,Comline);
+ { If the execve fails, we return an exitvalue of 127, to let it be known}
+ fpExit(127);
+ end
+ else
+ if pid=-1 then {Fork failed}
+ begin
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
+ e.ErrorCode:=-1;
+ raise e;
+ end;
+
+ { We're in the parent, let's wait. }
+ result:=WaitProcess(pid); // WaitPid and result-convert
+
+ if (result<0) or (result=127) then
+ begin
+ E:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
+ E.ErrorCode:=result;
+ raise E;
+ end;
+End;
+
+
+procedure Sleep(milliseconds: Cardinal);
+
+Var
+ fd : Integer;
+ fds : TfdSet;
+ timeout : TimeVal;
+
+begin
+ fd:=FileOpen('/dev/null',fmOpenRead);
+ If Not(Fd<0) then
+ try
+ fpfd_zero(fds);
+ fpfd_set(0,fds);
+ timeout.tv_sec:=Milliseconds div 1000;
+ timeout.tv_usec:=(Milliseconds mod 1000) * 1000;
+ fpSelect(1,Nil,Nil,@fds,@timeout);
+ finally
+ FileClose(fd);
+ end;
+end;
+
+Function GetLastOSError : Integer;
+
+begin
+ Result:=fpgetErrNo;
+end;
+
+{ ---------------------------------------------------------------------
+ Application config files
+ ---------------------------------------------------------------------}
+
+
+Function GetHomeDir : String;
+
+begin
+ Result:=GetEnvironmentVariable('HOME');
+ If (Result<>'') then
+ Result:=IncludeTrailingPathDelimiter(Result);
+end;
+
+Function GetAppConfigDir(Global : Boolean) : String;
+
+begin
+ If Global then
+ Result:=SysConfigDir
+ else
+ Result:=GetHomeDir+ApplicationName;
+end;
+
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+ if Global then
+ begin
+ Result:=IncludeTrailingPathDelimiter(SysConfigDir);
+ if SubDir then
+ Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
+ Result:=Result+ApplicationName+ConfigExtension;
+ end
+ else
+ begin
+ if SubDir then
+ begin
+ Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
+ Result:=Result+ApplicationName+ConfigExtension;
+ end
+ else
+ begin
+ Result:=GetHomeDir;
+ Result:=Result+'.'+ApplicationName;
+ end;
+ end;
+end;
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+
+Function GetTempDir(Global : Boolean) : String;
+
+begin
+ If Assigned(OnGetTempDir) then
+ Result:=OnGetTempDir(Global)
+ else
+ begin
+ Result:=GetEnvironmentVariable('TEMP');
+ If (Result='') Then
+ Result:=GetEnvironmentVariable('TMP');
+ if (Result='') then
+ Result:='/tmp/' // fallback.
+ end;
+ if (Result<>'') then
+ Result:=IncludeTrailingPathDelimiter(Result);
+end;
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+ SysConfigDir:='/etc'; { Initialize system config dir }
+Finalization
+ DoneExceptions;
+end.
+{
+
+ $Log: sysutils.pp,v $
+ Revision 1.59 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.58 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.57 2005/02/14 17:13:31 peter
+ * truncate log
+
+ * getenv had ansistring as param due to {$H+} now shortstring.
+
+ Revision 1.52 2004/11/02 13:59:42 marco
+ * timezone stuff back to unix
+
+ Revision 1.51 2004/11/01 07:10:56 peter
+ * 1.0.x bootstrap fix
+
+ Revision 1.50 2004/10/31 22:25:31 olle
+ * Fix for FPC_USE_LIBC
+
+ Revision 1.49 2004/10/30 20:55:54 marco
+ * unix interface cleanup
+
+ Revision 1.48 2004/10/12 15:22:23 michael
+ + Fixed sleep: file needs to be closed again
+
+ Revision 1.47 2004/10/10 10:28:34 michael
+ + Implementation of GetTempDir and GetTempFileName
+
+ Revision 1.46 2004/08/30 11:20:39 michael
+ + Give path, not comline in ExecuteProcess
+
+ Revision 1.45 2004/08/30 11:13:20 michael
+ + Fixed ExecuteProcess. Now returns the exit code or raises an exception on failure
+
+ Revision 1.44 2004/08/05 07:32:51 michael
+ Added getappconfig calls
+
+ Revision 1.43 2004/07/03 21:50:31 daniel
+ * Modified bootstrap code so separate prt0.as/prt0_10.as files are no
+ longer necessary
+
+ Revision 1.42 2004/06/15 07:36:03 michael
+ + Fixed Globtosearchrec to use unixtowinage
+
+ Revision 1.41 2004/05/22 14:25:03 michael
+ + Fixed FindFirst/FindNext so it treats the attributes correctly
+
+ Revision 1.40 2004/04/28 20:48:20 peter
+ * ordinal-pointer conversions fixed
+
+ Revision 1.39 2004/04/26 14:50:19 peter
+ * FileIsReadOnly fixed
+
+ Revision 1.38 2004/04/20 18:24:32 marco
+ * small fix for NIL arg ptr in first executeprocess
+
+ Revision 1.37 2004/03/04 22:15:16 marco
+ * UnixType changes. Please report problems to me.
+
+ Revision 1.36 2004/02/13 10:50:23 marco
+ * Hopefully last large changes to fpexec and friends.
+ - naming conventions changes from Michael.
+ - shell functions get alternative under ifdef.
+ - arraystring function moves to unixutil
+ - unixutil now regards quotes in stringtoppchar.
+ - sysutils/unix get executeprocess(ansi,array of ansi), and
+ both executeprocess functions are fixed
+ - Sysutils/win32 get executeprocess(ansi,array of ansi)
+
+ Revision 1.35 2004/02/12 15:31:06 marco
+ * First version of fpexec change. Still under ifdef or silently overloaded
+
+ Revision 1.34 2004/02/09 17:11:17 marco
+ * fixed for 1.0 errno->fpgeterrno
+
+ Revision 1.33 2004/02/08 14:50:51 michael
+ + Added fileIsReadOnly
+
+ Revision 1.32 2004/02/08 11:01:17 michael
+ + Implemented getlastoserror
+
+ Revision 1.31 2004/01/20 23:13:53 hajny
+ * ExecuteProcess fixes, ProcessID and ThreadID added
+
+ Revision 1.30 2004/01/10 17:34:36 michael
+ + Implemented sleep() on Unix.
+
+ Revision 1.29 2004/01/05 22:42:35 florian
+ * compilation error fixed
+
+ Revision 1.28 2004/01/05 22:37:15 florian
+ * changed sysutils.exec to ExecuteProcess
+
+ Revision 1.27 2004/01/03 09:09:11 marco
+ * Unix exec(ansistring)
+
+ Revision 1.26 2003/11/26 20:35:14 michael
+ + Some fixes to have everything compile again
+
+ Revision 1.25 2003/11/17 10:05:51 marco
+ * threads for FreeBSD. Not working tho
+
+ Revision 1.24 2003/10/25 23:43:59 hajny
+ * THandle in sysutils common using System.THandle
+
+ Revision 1.23 2003/10/07 08:28:49 marco
+ * fix from Vincent to casetables
+
+ Revision 1.22 2003/09/27 12:51:33 peter
+ * fpISxxx macros renamed to C compliant fpS_ISxxx
+
+ Revision 1.21 2003/09/17 19:07:44 marco
+ * more fixes for Unix<->unixutil
+
+ Revision 1.20 2003/09/17 12:41:31 marco
+ * Uses more baseunix, less unix now
+
+ Revision 1.19 2003/09/14 20:15:01 marco
+ * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
+
+ Revision 1.18 2003/04/01 15:57:41 peter
+ * made THandle platform dependent and unique type
+
+ Revision 1.17 2003/03/30 10:38:00 armin
+ * corrected typo in DirectoryExists
+
+ Revision 1.16 2003/03/29 18:21:42 hajny
+ * DirectoryExists declaration changed to that one from fixes branch
+
+ Revision 1.15 2003/03/28 19:06:59 peter
+ * directoryexists added
+
+ Revision 1.14 2003/01/03 20:41:04 peter
+ * FileCreate(string,mode) overload added
+
+ Revision 1.13 2002/09/07 16:01:28 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.12 2002/01/25 16:23:03 peter
+ * merged filesearch() fix
+
+}
diff --git a/rtl/unix/terminfo.pp b/rtl/unix/terminfo.pp
new file mode 100644
index 0000000000..5796c77a15
--- /dev/null
+++ b/rtl/unix/terminfo.pp
@@ -0,0 +1,751 @@
+{
+ $Id: terminfo.pp,v 1.8 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ TermInfo interface unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit TermInfo;
+
+interface
+
+{$linklib ncurses}
+{$linklib c}
+{$packrecords c}
+
+const curseslib = 'ncurses';
+
+const
+ { boolean values }
+ auto_left_margin = 0;
+ auto_right_margin = 1;
+ no_esc_ctlc = 2;
+ ceol_standout_glitch = 3;
+ eat_newline_glitch = 4;
+ erase_overstrike = 5;
+ generic_type = 6;
+ hard_copy = 7;
+ has_meta_key = 8;
+ has_status_line = 9;
+ insert_null_glitch = 10;
+ memory_above = 11;
+ memory_below = 12;
+ move_insert_mode = 13;
+ move_standout_mode = 14;
+ over_strike = 15;
+ status_line_esc_ok = 16;
+ dest_tabs_magic_smso = 17;
+ tilde_glitch = 18;
+ transparent_underline = 19;
+ xon_xoff = 20;
+ needs_xon_xoff = 21;
+ prtr_silent = 22;
+ hard_cursor = 23;
+ non_rev_rmcup = 24;
+ no_pad_char = 25;
+ non_dest_scroll_region = 26;
+ can_change = 27;
+ back_color_erase = 28;
+ hue_lightness_saturation = 29;
+ col_addr_glitch = 30;
+ cr_cancels_micro_mode = 31;
+ has_print_wheel = 32;
+ row_addr_glitch = 33;
+ semi_auto_right_margin = 34;
+ cpi_changes_res = 35;
+ lpi_changes_res = 36;
+
+ { numbers ... }
+ columns = 0;
+ init_tabs = 1;
+ lines = 2;
+ lines_of_memory = 3;
+ magic_cookie_glitch = 4;
+ padding_baud_rate = 5;
+ virtual_terminal = 6;
+ width_status_line = 7;
+ num_labels = 8;
+ label_height = 9;
+ label_width = 10;
+ max_attributes = 11;
+ maximum_windows = 12;
+ max_colors = 13;
+ max_pairs = 14;
+ no_color_video = 15;
+ buffer_capacity = 16;
+ dot_vert_spacing = 17;
+ dot_horz_spacing = 18;
+ max_micro_address = 19;
+ max_micro_jump = 20;
+ micro_char_size = 21;
+ micro_line_size = 22;
+ number_of_pins = 23;
+ output_res_char = 24;
+ output_res_line = 25;
+ output_res_horz_inch = 26;
+ output_res_vert_inch = 27;
+ print_rate = 28;
+ wide_char_size = 29;
+ buttons = 30;
+ bit_image_entwining = 31;
+ bit_image_type = 32;
+
+ { strings }
+ back_tab = 0;
+ bell = 1;
+ carriage_return = 2;
+ change_scroll_region = 3;
+ clear_all_tabs = 4;
+ clear_screen = 5;
+ clr_eol = 6;
+ clr_eos = 7;
+ column_address = 8;
+ command_character = 9;
+ cursor_address = 10;
+ cursor_down = 11;
+ cursor_home = 12;
+ cursor_invisible = 13;
+ cursor_left = 14;
+ cursor_mem_address = 15;
+ cursor_normal = 16;
+ cursor_right = 17;
+ cursor_to_ll = 18;
+ cursor_up = 19;
+ cursor_visible = 20;
+ delete_character = 21;
+ delete_line = 22;
+ dis_status_line = 23;
+ down_half_line = 24;
+ enter_alt_charset_mode = 25;
+ enter_blink_mode = 26;
+ enter_bold_mode = 27;
+ enter_ca_mode = 28;
+ enter_delete_mode = 29;
+ enter_dim_mode = 30;
+ enter_insert_mode = 31;
+ enter_secure_mode = 32;
+ enter_protected_mode = 33;
+ enter_reverse_mode = 34;
+ enter_standout_mode = 35;
+ enter_underline_mode = 36;
+ erase_chars = 37;
+ exit_alt_charset_mode = 38;
+ exit_attribute_mode = 39;
+ exit_ca_mode = 40;
+ exit_delete_mode = 41;
+ exit_insert_mode = 42;
+ exit_standout_mode = 43;
+ exit_underline_mode = 44;
+ flash_screen = 45;
+ form_feed = 46;
+ from_status_line = 47;
+ init_1string = 48;
+ init_2string = 49;
+ init_3string = 50;
+ init_file = 51;
+ insert_character = 52;
+ insert_line = 53;
+ insert_padding = 54;
+ key_backspace = 55;
+ key_catab = 56;
+ key_clear = 57;
+ key_ctab = 58;
+ key_dc = 59;
+ key_dl = 60;
+ key_down = 61;
+ key_eic = 62;
+ key_eol = 63;
+ key_eos = 64;
+ key_f0 = 65;
+ key_f1 = 66;
+ key_f10 = 67;
+ key_f2 = 68;
+ key_f3 = 69;
+ key_f4 = 70;
+ key_f5 = 71;
+ key_f6 = 72;
+ key_f7 = 73;
+ key_f8 = 74;
+ key_f9 = 75;
+ key_home = 76;
+ key_ic = 77;
+ key_il = 78;
+ key_left = 79;
+ key_ll = 80;
+ key_npage = 81;
+ key_ppage = 82;
+ key_right = 83;
+ key_sf = 84;
+ key_sr = 85;
+ key_stab = 86;
+ key_up = 87;
+ keypad_local = 88;
+ keypad_xmit = 89;
+ lab_f0 = 90;
+ lab_f1 = 91;
+ lab_f10 = 92;
+ lab_f2 = 93;
+ lab_f3 = 94;
+ lab_f4 = 95;
+ lab_f5 = 96;
+ lab_f6 = 97;
+ lab_f7 = 98;
+ lab_f8 = 99;
+ lab_f9 = 100;
+ meta_off = 101;
+ meta_on = 102;
+ newline = 103;
+ pad_char = 104;
+ parm_dch = 105;
+ parm_delete_line = 106;
+ parm_down_cursor = 107;
+ parm_ich = 108;
+ parm_index = 109;
+ parm_insert_line = 110;
+ parm_left_cursor = 111;
+ parm_right_cursor = 112;
+ parm_rindex = 113;
+ parm_up_cursor = 114;
+ pkey_key = 115;
+ pkey_local = 116;
+ pkey_xmit = 117;
+ print_screen = 118;
+ prtr_off = 119;
+ prtr_on = 120;
+ repeat_char = 121;
+ reset_1string = 122;
+ reset_2string = 123;
+ reset_3string = 124;
+ reset_file = 125;
+ restore_cursor = 126;
+ row_address = 127;
+ save_cursor = 128;
+ scroll_forward = 129;
+ scroll_reverse = 130;
+ set_attributes = 131;
+ set_tab = 132;
+ set_window = 133;
+ tab = 134;
+ to_status_line = 135;
+ underline_char = 136;
+ up_half_line = 137;
+ init_prog = 138;
+ key_a1 = 139;
+ key_a3 = 140;
+ key_b2 = 141;
+ key_c1 = 142;
+ key_c3 = 143;
+ prtr_non = 144;
+ char_padding = 145;
+ acs_chars = 146;
+ plab_norm = 147;
+ key_btab = 148;
+ enter_xon_mode = 149;
+ exit_xon_mode = 150;
+ enter_am_mode = 151;
+ exit_am_mode = 152;
+ xon_character = 153;
+ xoff_character = 154;
+ ena_acs = 155;
+ label_on = 156;
+ label_off = 157;
+ key_beg = 158;
+ key_cancel = 159;
+ key_close = 160;
+ key_command = 161;
+ key_copy = 162;
+ key_create = 163;
+ key_end = 164;
+ key_enter = 165;
+ key_exit = 166;
+ key_find = 167;
+ key_help = 168;
+ key_mark = 169;
+ key_message = 170;
+ key_move = 171;
+ key_next = 172;
+ key_open = 173;
+ key_options = 174;
+ key_previous = 175;
+ key_print = 176;
+ key_redo = 177;
+ key_reference = 178;
+ key_refresh = 179;
+ key_replace = 180;
+ key_restart = 181;
+ key_resume = 182;
+ key_save = 183;
+ key_suspend = 184;
+ key_undo = 185;
+ key_sbeg = 186;
+ key_scancel = 187;
+ key_scommand = 188;
+ key_scopy = 189;
+ key_screate = 190;
+ key_sdc = 191;
+ key_sdl = 192;
+ key_select = 193;
+ key_send = 194;
+ key_seol = 195;
+ key_sexit = 196;
+ key_sfind = 197;
+ key_shelp = 198;
+ key_shome = 199;
+ key_sic = 200;
+ key_sleft = 201;
+ key_smessage = 202;
+ key_smove = 203;
+ key_snext = 204;
+ key_soptions = 205;
+ key_sprevious = 206;
+ key_sprint = 207;
+ key_sredo = 208;
+ key_sreplace = 209;
+ key_sright = 210;
+ key_srsume = 211;
+ key_ssave = 212;
+ key_ssuspend = 213;
+ key_sundo = 214;
+ req_for_input = 215;
+ key_f11 = 216;
+ key_f12 = 217;
+ key_f13 = 218;
+ key_f14 = 219;
+ key_f15 = 220;
+ key_f16 = 221;
+ key_f17 = 222;
+ key_f18 = 223;
+ key_f19 = 224;
+ key_f20 = 225;
+ key_f21 = 226;
+ key_f22 = 227;
+ key_f23 = 228;
+ key_f24 = 229;
+ key_f25 = 230;
+ key_f26 = 231;
+ key_f27 = 232;
+ key_f28 = 233;
+ key_f29 = 234;
+ key_f30 = 235;
+ key_f31 = 236;
+ key_f32 = 237;
+ key_f33 = 238;
+ key_f34 = 239;
+ key_f35 = 240;
+ key_f36 = 241;
+ key_f37 = 242;
+ key_f38 = 243;
+ key_f39 = 244;
+ key_f40 = 245;
+ key_f41 = 246;
+ key_f42 = 247;
+ key_f43 = 248;
+ key_f44 = 249;
+ key_f45 = 250;
+ key_f46 = 251;
+ key_f47 = 252;
+ key_f48 = 253;
+ key_f49 = 254;
+ key_f50 = 255;
+ key_f51 = 256;
+ key_f52 = 257;
+ key_f53 = 258;
+ key_f54 = 259;
+ key_f55 = 260;
+ key_f56 = 261;
+ key_f57 = 262;
+ key_f58 = 263;
+ key_f59 = 264;
+ key_f60 = 265;
+ key_f61 = 266;
+ key_f62 = 267;
+ key_f63 = 268;
+ clr_bol = 269;
+ clear_margins = 270;
+ set_left_margin = 271;
+ set_right_margin = 272;
+ label_format = 273;
+ set_clock = 274;
+ display_clock = 275;
+ remove_clock = 276;
+ create_window = 277;
+ goto_window = 278;
+ hangup = 279;
+ dial_phone = 280;
+ quick_dial = 281;
+ tone = 282;
+ pulse = 283;
+ flash_hook = 284;
+ fixed_pause = 285;
+ wait_tone = 286;
+ user0 = 287;
+ user1 = 288;
+ user2 = 289;
+ user3 = 290;
+ user4 = 291;
+ user5 = 292;
+ user6 = 293;
+ user7 = 294;
+ user8 = 295;
+ user9 = 296;
+ orig_pair = 297;
+ orig_colors = 298;
+ initialize_color = 299;
+ initialize_pair = 300;
+ set_color_pair = 301;
+ set_foreground = 302;
+ set_background = 303;
+ change_char_pitch = 304;
+ change_line_pitch = 305;
+ change_res_horz = 306;
+ change_res_vert = 307;
+ define_char = 308;
+ enter_doublewide_mode = 309;
+ enter_draft_quality = 310;
+ enter_italics_mode = 311;
+ enter_leftward_mode = 312;
+ enter_micro_mode = 313;
+ enter_near_letter_quality = 314;
+ enter_normal_quality = 315;
+ enter_shadow_mode = 316;
+ enter_subscript_mode = 317;
+ enter_superscript_mode = 318;
+ enter_upward_mode = 319;
+ exit_doublewide_mode = 320;
+ exit_italics_mode = 321;
+ exit_leftward_mode = 322;
+ exit_micro_mode = 323;
+ exit_shadow_mode = 324;
+ exit_subscript_mode = 325;
+ exit_superscript_mode = 326;
+ exit_upward_mode = 327;
+ micro_column_address = 328;
+ micro_down = 329;
+ micro_left = 330;
+ micro_right = 331;
+ micro_row_address = 332;
+ micro_up = 333;
+ order_of_pins = 334;
+ parm_down_micro = 335;
+ parm_left_micro = 336;
+ parm_right_micro = 337;
+ parm_up_micro = 338;
+ select_char_set = 339;
+ set_bottom_margin = 340;
+ set_bottom_margin_parm = 341;
+ set_left_margin_parm = 342;
+ set_right_margin_parm = 343;
+ set_top_margin = 344;
+ set_top_margin_parm = 345;
+ start_bit_image = 346;
+ start_char_set_def = 347;
+ stop_bit_image = 348;
+ stop_char_set_def = 349;
+ subscript_characters = 350;
+ superscript_characters = 351;
+ these_cause_cr = 352;
+ zero_motion = 353;
+ char_set_names = 354;
+ key_mouse = 355;
+ mouse_info = 356;
+ req_mouse_pos = 357;
+ get_mouse = 358;
+ set_a_foreground = 359;
+ set_a_background = 360;
+ pkey_plab = 361;
+ device_type = 362;
+ code_set_init = 363;
+ set0_des_seq = 364;
+ set1_des_seq = 365;
+ set2_des_seq = 366;
+ set3_des_seq = 367;
+ set_lr_margin = 368;
+ set_tb_margin = 369;
+ bit_image_repeat = 370;
+ bit_image_newline = 371;
+ bit_image_carriage_return = 372;
+ color_names = 373;
+ define_bit_image_region = 374;
+ end_bit_image_region = 375;
+ set_color_band = 376;
+ set_page_length = 377;
+ display_pc_char = 378;
+ enter_pc_charset_mode = 379;
+ exit_pc_charset_mode = 380;
+ enter_scancode_mode = 381;
+ exit_scancode_mode = 382;
+ pc_term_options = 383;
+ scancode_escape = 384;
+ alt_scancode_esc = 385;
+ enter_horizontal_hl_mode = 386;
+ enter_left_hl_mode = 387;
+ enter_low_hl_mode = 388;
+ enter_right_hl_mode = 389;
+ enter_top_hl_mode = 390;
+ enter_vertical_hl_mode = 391;
+
+ { older synonyms for some booleans }
+ beehive_glitch = no_esc_ctlc;
+ teleray_glitch = dest_tabs_magic_smso;
+ micro_col_size = micro_char_size;
+ { internal }
+ termcap_init2 = 392;
+ termcap_reset = 393;
+ magic_cookie_glitch_ul = 33;
+ backspaces_with_bs = 37;
+ crt_no_scrolling = 38;
+ no_correctly_working_cr = 39;
+ carriage_return_delay = 34;
+ new_line_delay = 35;
+ linefeed_if_not_lf = 394;
+ backspace_if_not_bs = 395;
+ gnu_has_meta_key = 40;
+ linefeed_is_newline = 41;
+ backspace_delay = 36;
+ horizontal_tab_delay = 37;
+ number_of_function_keys = 38;
+ other_non_function_keys = 396;
+ arrow_key_map = 397;
+ has_hardware_tabs = 42;
+ return_does_clr_eol = 43;
+ acs_ulcorner = 398;
+ acs_llcorner = 399;
+ acs_urcorner = 400;
+ acs_lrcorner = 401;
+ acs_ltee = 402;
+ acs_rtee = 403;
+ acs_btee = 404;
+ acs_ttee = 405;
+ acs_hline = 406;
+ acs_vline = 407;
+ acs_plus = 408;
+ memory_lock = 409;
+ memory_unlock = 410;
+ box_chars_1 = 411;
+
+
+const
+ NCCS = 32;
+ BoolCount = 44;
+ NumCount = 39;
+ StrCount = 412;
+
+type
+ TCFlag_t = Longint;
+ Speed_t = Longint;
+ TermIOS = record
+ c_iflag, c_oflag, c_cflag, c_lflag: TCFlag_t;
+ c_line: Byte;
+ c_cc: array [0..NCCS-1] of Char;
+ c_ispeed, c_ospeed: Speed_t;
+ Pad: word;
+ end;
+
+ TT_BoolArray = array [0..BoolCount - 1] of Boolean;
+ TT_WordArray = array [0..NumCount - 1] of Word;
+ TT_PCharArray = array [0..StrCount - 1] of PChar;
+
+ TermType4 = record
+ Term_Names: PChar;
+ Str_Table: PChar;
+ Booleans: TT_BoolArray;
+ Numbers: TT_WordArray;
+ Strings: TT_PCharArray;
+ end;
+
+ Terminal_ptr4 = ^Terminal4;
+ Terminal4 = record
+ TType: TermType4;
+ FileDes: Word;
+ Ottyb, Nttyb: Termios;
+ Pad: longint;
+ end;
+
+ TermType5 = record
+ Term_Names: PChar;
+ Str_Table: PChar;
+ Booleans: ^TT_BoolArray;
+ Numbers: ^TT_WordArray;
+ Strings: ^TT_PCharArray;
+ end;
+
+ Terminal_ptr5 = ^Terminal5;
+ Terminal5 = record
+ TType: TermType5;
+ FileDes: Word;
+ Ottyb, Nttyb: Termios;
+ Pad: longint;
+ end;
+
+ TerminalCommon_ptr1 = ^TerminalCommon1;
+ TerminalCommon1 = record
+ Term_Names: PChar;
+ Str_Table: PChar;
+ end;
+
+ TerminalCommon_ptr2 = ^TerminalCommon2;
+ TerminalCommon2 = record
+ FileDes: Word;
+ Ottyb, Nttyb: Termios;
+ Pad: longint;
+ end;
+
+ WriterFunc = function (P: PChar): Longint;
+
+var
+{$ifndef darwin}
+ cur_term : TerminalCommon_ptr1; cvar; external;
+{$else darwin}
+ cur_term : TerminalCommon_ptr1; external curseslib name 'cur_term';
+{$endif darwin}
+ cur_term_booleans: ^TT_BoolArray;
+ cur_term_numbers: ^TT_WordArray;
+ cur_term_strings: ^TT_PCharArray;
+ cur_term_common: TerminalCommon_ptr2;
+
+const
+ cur_term_valid : boolean = false;
+
+{ Note: the following two procedures expect a pointer to a full terminfo }
+{ structure, not just to the common parts. However, since this structure }
+{ differs for different versions of ncurses,it's impossible to give a }
+{ general declaration here which is correct (JM) }
+function set_curterm(term: TerminalCommon_ptr1): TerminalCommon_ptr1;cdecl; external curseslib name 'set_curterm';
+function del_curterm(term: TerminalCommon_ptr1): Longint;
+
+{ sets whether to use environment variables for LINES and COLUMNS }
+procedure use_env(B: Longint); cdecl; external curseslib name 'use_env';
+
+function putp(Ndx: Longint): Longint;
+
+{ this function must be called before any terminal properties are accessed }
+function setupterm(Term: PChar; fd: Longint; var ErrCode: Longint): Longint;
+
+{ reinitialize lib }
+function restartterm(Term: PChar; fd: Longint; var ErrCode: Longint): Longint; cdecl; external curseslib name 'restartterm';
+
+{function tgetent(P1, P2: PChar): Longint;
+function tgetflag(P: PChar): Longint;
+function tgetnum(P: PChar): Longint;
+function tgoto(P: PChar; L1, L2: Longint): PChar;
+function tgetstr(P: PChar; var R: PChar): PChar;
+function tigetflag(P: PChar): Longint;
+function tigetnum(P: PChar): Longint;
+function tigetstr(P: PChar): PChar;
+function tparm(P: PChar, ...): PChar;
+function tparam(const char *, char *, int, ...): PChar;}
+function tputs(Ndx: Word; L1: Longint; F: WriterFunc): Longint;
+
+implementation
+
+uses
+ baseUnix;
+
+function putp(Ndx: Longint): Longint;
+var
+ P: PChar;
+begin
+ if not assigned(cur_term) then
+ RunError(219);
+ P := cur_term_strings^[Ndx];
+ putp := fpWrite(cur_term_common^.filedes, P^, StrLen(P));
+end;
+
+function tputs(Ndx: Word; L1: Longint; F: WriterFunc): Longint;
+var
+ P: PChar;
+begin
+ if not assigned(cur_term) then
+ RunError(219);
+ { L1 := L1; why was this here ?? PM }
+ P := cur_term_strings^[Ndx];
+ tputs := F(P);
+end;
+
+//function set_curterm(term: TerminalCommon_ptr1): TerminalCommon_ptr1; cdecl; external curseslib;
+
+// function restartterm(Term: PChar; fd: Longint; var ErrCode: Longint): Longint; cdecl; external curseslib;
+
+function setuptermC(Term: PChar; fd: Longint; var ErrCode: Longint): Longint; cdecl; external curseslib name 'setupterm';
+
+function setupterm(Term: PChar; fd: Longint; var ErrCode: Longint): Longint;
+var
+ versioncheck: longint;
+begin
+ setupterm := setuptermC(term,fd,errcode);
+ if not assigned(cur_term) then
+ exit;
+ cur_term_valid := true;
+ versioncheck := 0;
+ repeat
+ if (Terminal_ptr4(cur_term)^.ttype.Booleans[versioncheck] in [false,true]) then
+ inc(versioncheck)
+ else versioncheck := -1;
+ until (versioncheck = BoolCount) or
+ (versioncheck = -1);
+ if versioncheck = BoolCount then
+ { version 4.x }
+ begin
+ cur_term_booleans := @Terminal_ptr4(cur_term)^.ttype.Booleans;
+ cur_term_numbers := @Terminal_ptr4(cur_term)^.ttype.Numbers;
+ cur_term_strings := @Terminal_ptr4(cur_term)^.ttype.Strings;
+ cur_term_common := pointer(@Terminal_ptr4(cur_term)^.FileDes);
+ end
+ else
+ { assume 5.x or higher }
+ begin
+ cur_term_booleans := Terminal_ptr5(cur_term)^.ttype.Booleans;
+ cur_term_numbers := Terminal_ptr5(cur_term)^.ttype.Numbers;
+ cur_term_strings := Terminal_ptr5(cur_term)^.ttype.Strings;
+ cur_term_common := pointer(@Terminal_ptr5(cur_term)^.FileDes);
+ end;
+end;
+
+function del_curtermC(term: TerminalCommon_ptr1): Longint; cdecl; external curseslib name 'del_curterm';
+
+function del_curterm(term: TerminalCommon_ptr1): Longint;
+var
+ reset_cur_term : boolean;
+begin
+ if term=cur_term then
+ begin
+ cur_term_booleans := nil;
+ cur_term_numbers := nil;
+ cur_term_strings := nil;
+ cur_term_common := nil;
+ reset_cur_term := true;
+ end
+ else
+ reset_cur_term := false;
+ del_curterm := del_curtermC(term);
+ if reset_cur_term then
+ cur_term_valid := false;
+end;
+
+{function tgetent(P1, P2: PChar): Longint; cdecl; external;
+function tgetflag(P: PChar): Longint; cdecl; external;
+function tgetnum(P: PChar): Longint; cdecl; external;
+function tgoto(P: PChar; L1, L2: Longint): PChar; cdecl; external;
+function tgetstr(P: PChar; var R: PChar): PChar; cdecl; external;
+function tigetflag(P: PChar): Longint; cdecl; external;
+function tigetnum(P: PChar): Longint; cdecl; external;
+function tigetstr(P: PChar): PChar; cdecl; external;
+function tparm(P: PChar; ...): PChar; cdecl; external;
+function tparam(const char *, char *, int, ...): PChar; cdecl; external;}
+
+end.
+{
+ $Log: terminfo.pp,v $
+ Revision 1.8 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/termiosh.inc b/rtl/unix/termiosh.inc
new file mode 100644
index 0000000000..fde35b3070
--- /dev/null
+++ b/rtl/unix/termiosh.inc
@@ -0,0 +1,38 @@
+{
+ $Id: termiosh.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Termios basic prototypes
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+Function TCGetAttr (fd:cint;var tios:TermIOS):cint;
+Function TCSetAttr (fd:cint;OptAct:cint;const tios:TermIOS):cint;
+Procedure CFSetISpeed (var tios:TermIOS;speed:Cardinal);
+Procedure CFSetOSpeed (var tios:TermIOS;speed:Cardinal);
+Procedure CFMakeRaw (var tios:TermIOS);
+Function TCSendBreak (fd,duration:cint):cint;
+Function TCSetPGrp (fd,id:cint) :cint;
+Function TCGetPGrp (fd:cint;var id:cint):cint;
+Function TCFlush (fd,qsel:cint):cint;
+Function TCDrain (fd:cint) :cint;
+Function TCFlow (fd,act:cint) :cint;
+Function IsATTY (Handle:cint) :cint;
+Function IsATTY (var f:text) :cint;
+function TTYname (Handle:cint):string;
+function TTYname (var F:Text) :string;
+
+{
+ $Log: termiosh.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/timezone.inc b/rtl/unix/timezone.inc
new file mode 100644
index 0000000000..d10c5130b7
--- /dev/null
+++ b/rtl/unix/timezone.inc
@@ -0,0 +1,301 @@
+{
+ $Id: timezone.inc,v 1.9 2005/02/14 17:13:31 peter Exp $
+
+ Support for timezone info in /usr/share/timezone
+}
+
+type
+
+ ttzhead=packed record
+ tzh_reserved : array[0..19] of byte;
+ tzh_ttisgmtcnt,
+ tzh_ttisstdcnt,
+ tzh_leapcnt,
+ tzh_timecnt,
+ tzh_typecnt,
+ tzh_charcnt : longint;
+ end;
+
+ pttinfo=^tttinfo;
+ tttinfo=packed record
+ offset : longint;
+ isdst : boolean;
+ idx : byte;
+ isstd : byte;
+ isgmt : byte;
+ end;
+
+ pleap=^tleap;
+ tleap=record
+ transition : longint;
+ change : longint;
+ end;
+
+var
+ num_transitions,
+ num_leaps,
+ num_types : longint;
+
+ transitions : plongint;
+ type_idxs : pbyte;
+ types : pttinfo;
+ zone_names : pchar;
+ leaps : pleap;
+
+function find_transition(timer:longint):pttinfo;
+var
+ i : longint;
+begin
+ if (num_transitions=0) or (timer<transitions[0]) then
+ begin
+ i:=0;
+ while (i<num_types) and (types[i].isdst) do
+ inc(i);
+ if (i=num_types) then
+ i:=0;
+ end
+ else
+ begin
+ for i:=1 to num_transitions do
+ if (timer<transitions[i]) then
+ break;
+ i:=type_idxs[i-1];
+ end;
+ find_transition:=@types[i];
+end;
+
+
+procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
+var
+ info : pttinfo;
+ i : longint;
+begin
+{ reset }
+ TZDaylight:=false;
+ TZSeconds:=0;
+ TZName[false]:=nil;
+ TZName[true]:=nil;
+ leap_correct:=0;
+ leap_hit:=0;
+{ get info }
+ info:=find_transition(timer);
+ if not assigned(info) then
+ exit;
+ TZDaylight:=info^.isdst;
+ TZSeconds:=info^.offset;
+ i:=0;
+ while (i<num_types) do
+ begin
+ tzname[types[i].isdst]:=@zone_names[types[i].idx];
+ inc(i);
+ end;
+ tzname[info^.isdst]:=@zone_names[info^.idx];
+ i:=num_leaps;
+ repeat
+ if i=0 then
+ exit;
+ dec(i);
+ until (timer>leaps[i].transition);
+ leap_correct:=leaps[i].change;
+ if (timer=leaps[i].transition) and
+ (((i=0) and (leaps[i].change>0)) or
+ (leaps[i].change>leaps[i-1].change)) then
+ begin
+ leap_hit:=1;
+ while (i>0) and
+ (leaps[i].transition=leaps[i-1].transition+1) and
+ (leaps[i].change=leaps[i-1].change+1) do
+ begin
+ inc(leap_hit);
+ dec(i);
+ end;
+ end;
+end;
+
+
+procedure GetLocalTimezone(timer:longint);
+var
+ lc,lh : longint;
+begin
+ GetLocalTimezone(timer,lc,lh);
+end;
+
+
+procedure ReadTimezoneFile(fn:shortstring);
+
+ procedure decode(var l:longint);
+ var
+ k : longint;
+ p : pbyte;
+ begin
+ p:=pbyte(@l);
+ if (p[0] and (1 shl 7))<>0 then
+ k:=not 0
+ else
+ k:=0;
+ k:=(k shl 8) or p[0];
+ k:=(k shl 8) or p[1];
+ k:=(k shl 8) or p[2];
+ k:=(k shl 8) or p[3];
+ l:=k;
+ end;
+
+var
+ f : longint;
+ tzdir : shortstring;
+ tzhead : ttzhead;
+ i : longint;
+ chars : longint;
+ buf : pbyte;
+begin
+ if fn='' then
+ fn:='localtime';
+ if fn[1]<>'/' then
+ begin
+ tzdir:=fpgetenv('TZDIR');
+ if tzdir='' then
+ tzdir:='/usr/share/zoneinfo';
+ if tzdir[length(tzdir)]<>'/' then
+ tzdir:=tzdir+'/';
+ fn:=tzdir+fn;
+ end;
+ f:=fpopen(fn,Open_RdOnly);
+ if f<0 then
+ exit;
+ i:=fpread(f,tzhead,sizeof(tzhead));
+ if i<>sizeof(tzhead) then
+ exit;
+ decode(tzhead.tzh_timecnt);
+ decode(tzhead.tzh_typecnt);
+ decode(tzhead.tzh_charcnt);
+ decode(tzhead.tzh_leapcnt);
+ decode(tzhead.tzh_ttisstdcnt);
+ decode(tzhead.tzh_ttisgmtcnt);
+
+ num_transitions:=tzhead.tzh_timecnt;
+ num_types:=tzhead.tzh_typecnt;
+ chars:=tzhead.tzh_charcnt;
+
+ reallocmem(transitions,num_transitions*sizeof(longint));
+ reallocmem(type_idxs,num_transitions);
+ reallocmem(types,num_types*sizeof(tttinfo));
+ reallocmem(zone_names,chars);
+ reallocmem(leaps,num_leaps*sizeof(tleap));
+
+ fpread(f,transitions^,num_transitions*4);
+ fpread(f,type_idxs^,num_transitions);
+
+ for i:=0 to num_transitions-1 do
+ decode(transitions[i]);
+
+ for i:=0 to num_types-1 do
+ begin
+ fpread(f,types[i].offset,4);
+ fpread(f,types[i].isdst,1);
+ fpread(f,types[i].idx,1);
+ decode(types[i].offset);
+ types[i].isstd:=0;
+ types[i].isgmt:=0;
+ end;
+
+ fpread(f,zone_names^,chars);
+
+ for i:=0 to num_leaps-1 do
+ begin
+ fpread(f,leaps[i].transition,4);
+ fpread(f,leaps[i].change,4);
+ decode(leaps[i].transition);
+ decode(leaps[i].change);
+ end;
+
+ getmem(buf,tzhead.tzh_ttisstdcnt);
+ fpread(f,buf^,tzhead.tzh_ttisstdcnt);
+ for i:=0 to tzhead.tzh_ttisstdcnt-1 do
+ types[i].isstd:=byte(buf[i]<>0);
+ freemem(buf);
+
+ getmem(buf,tzhead.tzh_ttisgmtcnt);
+ fpread(f,buf^,tzhead.tzh_ttisgmtcnt);
+ for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
+ types[i].isgmt:=byte(buf[i]<>0);
+ freemem(buf);
+ fpclose(f);
+end;
+
+Const
+ // Debian system; contains location of timezone file.
+ TimeZoneLocationFile = '/etc/timezone';
+ // SuSE has link in /usr/lib/zoneinfo/localtime to /etc/localtime
+ // RedHat uses /etc/localtime
+
+ TimeZoneFile = '/etc/localtime'; // POSIX
+ AltTimeZoneFile = '/usr/lib/zoneinfo/localtime'; // Other
+{$ifdef BSD}
+ BSDTimeZonefile = '/usr/share/zoneinfo'; // BSD usually is POSIX
+ // compliant though
+{$ENDIF}
+
+
+function GetTimezoneFile:shortstring;
+var
+ f,len : longint;
+ s : shortstring;
+ info : stat;
+
+begin
+ GetTimezoneFile:='';
+ f:=fpopen(TimeZoneLocationFile,Open_RdOnly);
+ if f>0 then
+ begin
+ len:=fpread(f,s[1],high(s));
+ s[0]:=chr(len);
+ len:=pos(#10,s);
+ if len<>0 then
+ s[0]:=chr(len-1);
+ fpclose(f);
+ GetTimezoneFile:=s;
+ end
+ // Try SuSE
+ else if fpstat(TimeZoneFile,{$ifdef oldlinuxstat}baseunix.stat(info){$else}info{$endif})>=0 then
+ GetTimeZoneFile:=TimeZoneFile
+ // Try RedHat
+ else If fpstat(AltTimeZoneFile,{$ifdef oldlinuxstat}baseunix.stat(info){$else}info{$endif})>=0 then
+ GetTimeZoneFile:=AltTimeZoneFile
+{$ifdef BSD}
+// else
+// If fpstat(BSDTimeZoneFile,{$ifdef oldlinuxstat}baseunix.stat(info){$else}info{$endif})>=0 then
+// GetTimeZoneFile:=BSDTimeZoneFile
+{$ENDIF}
+end;
+
+
+procedure InitLocalTime;
+begin
+ ReadTimezoneFile(GetTimezoneFile);
+ GetLocalTimezone(fptime);
+end;
+
+
+procedure DoneLocalTime;
+begin
+ if assigned(transitions) then
+ freemem(transitions);
+ if assigned(type_idxs) then
+ freemem(type_idxs);
+ if assigned(types) then
+ freemem(types);
+ if assigned(zone_names) then
+ freemem(zone_names);
+ if assigned(leaps) then
+ freemem(leaps);
+ num_transitions:=0;
+ num_leaps:=0;
+ num_types:=0;
+end;
+
+{
+ $Log: timezone.inc,v $
+ Revision 1.9 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/ttyname.inc b/rtl/unix/ttyname.inc
new file mode 100644
index 0000000000..2eeb42c5cd
--- /dev/null
+++ b/rtl/unix/ttyname.inc
@@ -0,0 +1,96 @@
+{
+ $Id: ttyname.inc,v 1.4 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Peter Vreman
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ A generic implementation of ttyname functionality.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function TTYName(Handle:cint):string;
+{
+ Return the name of the current tty described by handle f.
+ returns empty string in case of an error.
+}
+var
+ mydev : dev_t;
+ myino : ino_t;
+ st : stat;
+
+ function mysearch(n:string): boolean;
+ {searches recursively for the device in the directory given by n,
+ returns true if found and sets the name of the device in ttyname}
+ var dirstream : pdir;
+ d : pdirent;
+ name : string;
+ st : stat;
+ begin
+ dirstream:=fpopendir(n);
+ if (dirstream=nil) then
+ exit(false);
+ d:=fpReaddir(dirstream^);
+ while (d<>nil) do
+ begin
+ name:=n+'/'+strpas(@(d^.d_name));
+ // fpstat(name,st);
+ if fpstat(name,st)=0 then
+ begin
+ if (fpS_ISDIR(st.st_mode)) and { if it is a directory }
+ (strpas(@(d^.d_name))<>'.') and { but not ., .. and fd subdirs }
+ (strpas(@(d^.d_name))<>'..') and
+ (strpas(@(d^.d_name))<>'') and
+ (strpas(@(d^.d_name))<>'fd') then
+ begin {we found a directory, search inside it}
+ if mysearch(name) then
+ begin {the device is here}
+ fpclosedir(dirstream^); {then don't continue searching}
+ mysearch:=true;
+ exit;
+ end;
+ end
+ else if (ino_t(d^.d_fileno)=myino) and (st.st_dev=mydev) then
+ begin
+ fpclosedir(dirstream^);
+ ttyname:=name;
+ mysearch:=true;
+ exit;
+ end;
+ end;
+ d:=fpReaddir(dirstream^);
+ end;
+ fpclosedir(dirstream^);
+ mysearch:=false;
+ end;
+
+begin
+ TTYName:='';
+ if (fpfstat(handle,st)=-1) and (isatty (handle)<>-1) then
+ exit;
+ mydev:=st.st_dev;
+ myino:=st.st_ino;
+ mysearch('/dev');
+end;
+
+
+function TTYName(var F:Text):string;
+{
+ Idem as previous, only now for text variables;
+}
+begin
+ TTYName:=TTYName(textrec(f).handle);
+end;
+
+{
+ $Log: ttyname.inc,v $
+ Revision 1.4 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/unix.pp b/rtl/unix/unix.pp
new file mode 100644
index 0000000000..361d092507
--- /dev/null
+++ b/rtl/unix/unix.pp
@@ -0,0 +1,1248 @@
+{
+ $Id: unix.pp,v 1.85 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Michael Van Canneyt,
+ BSD parts (c) 2000 by Marco van de Voort
+ members of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+Unit Unix;
+Interface
+
+Uses BaseUnix,UnixType;
+
+{$i aliasptp.inc}
+
+{ Get Types and Constants only exported in this unit }
+{$i unxconst.inc}
+
+// We init to zero to be able to put timezone stuff under IFDEF, and still
+// keep the code working.
+
+var
+ Tzseconds : Longint {$ifndef ver1_0} = 0 {$endif};
+
+
+{********************
+ File
+********************}
+
+Const
+ P_IN = 1; // pipes (?)
+ P_OUT = 2;
+
+Const
+ LOCK_SH = 1; // flock constants ?
+ LOCK_EX = 2;
+ LOCK_UN = 8;
+ LOCK_NB = 4;
+
+Type
+ Tpipe = baseunix.tfildes; // compability.
+
+{******************************************************************************
+ Procedure/Functions
+******************************************************************************}
+
+{**************************
+ Time/Date Handling
+***************************}
+
+var
+ tzdaylight : boolean;
+ tzname : array[boolean] of pchar;
+
+{$IFNDEF DONT_READ_TIMEZONE} // allows to disable linking in and trying for platforms
+ // it doesn't (yet) work for.
+
+{ timezone support }
+procedure GetLocalTimezone(timer:cint;var leap_correct,leap_hit:cint);
+procedure GetLocalTimezone(timer:cint);
+procedure ReadTimezoneFile(fn:string);
+function GetTimezoneFile:string;
+{$ENDIF}
+
+{**************************
+ Process Handling
+***************************}
+
+//
+// These are much better, in nearly all ways.
+//
+
+function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint;
+function FpExecL(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
+function FpExecLP(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
+function FpExecV(Const PathName:AnsiString;args:ppchar):cint;
+function FpExecVP(Const PathName:AnsiString;args:ppchar):cint;
+function FpExecVPE(Const PathName:AnsiString;args,env:ppchar):cint;
+
+Function Shell (const Command:String):cint;
+Function Shell (const Command:AnsiString):cint;
+Function fpSystem(const Command:AnsiString):cint;
+
+Function WaitProcess (Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+
+Function WIFSTOPPED (Status: Integer): Boolean;
+Function W_EXITCODE (ReturnCode, Signal: Integer): Integer;
+Function W_STOPCODE (Signal: Integer): Integer;
+
+{**************************
+ File Handling
+***************************}
+
+{$ifndef FPC_USE_LIBC} // defined using cdecl for libc.
+Function fsync (fd : cint) : cint;
+Function fpFlock (fd,mode : cint) : cint ;
+Function fStatFS (Fd: cint;Var Info:tstatfs):cint;
+Function StatFS (Path:pchar;Var Info:tstatfs):cint;
+{$endif}
+
+Function fpFlock (var T : text;mode : cint) : cint;
+Function fpFlock (var F : File;mode : cint) : cint;
+
+
+Function SelectText (var T:Text;TimeOut :PTimeVal):cint;
+Function SelectText (var T:Text;TimeOut :cint):cint;
+
+{**************************
+ Directory Handling
+***************************}
+
+procedure SeekDir(p:pdir;loc:clong);
+function TellDir(p:pdir):clong;
+
+{**************************
+ Pipe/Fifo/Stream
+***************************}
+
+Function AssignPipe (var pipe_in,pipe_out:cint):cint;
+Function AssignPipe (var pipe_in,pipe_out:text):cint;
+Function AssignPipe (var pipe_in,pipe_out:file):cint;
+//Function PClose (Var F:text) : cint;
+//Function PClose (Var F:file) : cint;
+Function POpen (var F:text;const Prog:String;rw:char):cint;
+Function POpen (var F:file;const Prog:String;rw:char):cint;
+Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint;
+Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint;
+
+Function GetDomainName:String;
+Function GetHostName:String;
+
+
+{**************************
+ Memory functions
+***************************}
+
+const
+ PROT_READ = $1; { page can be read }
+ PROT_WRITE = $2; { page can be written }
+ PROT_EXEC = $4; { page can be executed }
+ PROT_NONE = $0; { page can not be accessed }
+
+ MAP_SHARED = $1; { Share changes }
+// MAP_PRIVATE = $2; { Changes are private }
+ MAP_TYPE = $f; { Mask for type of mapping }
+ MAP_FIXED = $10; { Interpret addr exactly }
+// MAP_ANONYMOUS = $20; { don't use a file }
+
+{$ifdef Linux}
+ MAP_GROWSDOWN = $100; { stack-like segment }
+ MAP_DENYWRITE = $800; { ETXTBSY }
+ MAP_EXECUTABLE = $1000; { mark it as an executable }
+ MAP_LOCKED = $2000; { pages are locked }
+ MAP_NORESERVE = $4000; { don't check for reservations }
+{$else}
+ {$ifdef FreeBSD}
+ // FreeBSD defines MAP_COPY=MAP_PRIVATE=$2;
+ MAP_FILE = $0000; { map from file (default) }
+ MAP_ANON = $1000; { allocated from memory, swap space }
+
+ MAP_RENAME = $0020; { Sun: rename private pages to file }
+ MAP_NORESERVE = $0040; { Sun: don't reserve needed swap area }
+ MAP_INHERIT = $0080; { region is retained after exec }
+ MAP_NOEXTEND = $0100; { for MAP_FILE, don't change file size }
+ MAP_HASSEMAPHORE = $0200; { region may contain semaphores }
+ MAP_STACK = $0400; { region grows down, like a stack }
+ MAP_NOSYNC = $0800; { page to but do not sync underlying file}
+ MAP_NOCORE = $20000;{ dont include these pages in a coredump}
+ {$endif}
+{$endif}
+{**************************
+ Utility functions
+***************************}
+
+Type
+ TFSearchOption = (NoCurrentDirectory,
+ CurrentDirectoryFirst,
+ CurrentDirectoryLast);
+
+Function FSearch (const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString;
+Function FSearch (const path:AnsiString;dirlist:AnsiString):AnsiString;
+
+procedure SigRaise (sig:integer);
+
+{$ifdef FPC_USE_LIBC}
+ const clib = 'c';
+ {$i unxdeclh.inc}
+{$else}
+ {$i unxsysch.inc} // calls used in system and not reexported from baseunix
+{$endif}
+
+{******************************************************************************
+ Implementation
+******************************************************************************}
+
+{$i unxovlh.inc}
+
+Implementation
+
+Uses Strings{$ifndef FPC_USE_LIBC},Syscall{$endif};
+
+{$i unxovl.inc}
+
+{$ifndef FPC_USE_LIBC}
+ {$i syscallh.inc}
+ {$i unxsysc.inc}
+{$endif}
+
+{ Get the definitions of textrec and filerec }
+{$i textrec.inc}
+{$i filerec.inc}
+
+{$i unxfunc.inc} { Platform specific implementations }
+
+Function getenv(name:string):Pchar; external name 'FPC_SYSC_FPGETENV';
+
+{******************************************************************************
+ Process related calls
+******************************************************************************}
+
+{ Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
+Function WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+var
+ r,s : cint;
+begin
+ s:=$7F00;
+
+ repeat
+ r:=fpWaitPid(Pid,@s,0);
+ if (r=-1) and (fpgeterrno=ESysEIntr) Then
+ r:=0;
+ until (r<>0);
+ if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
+ WaitProcess:=-1 // return -1 to indicate an error. fpwaitpid updated it.
+ else
+ begin
+ if wifexited(s) then
+ WaitProcess:=wexitstatus(s)
+ else if (s>0) then // Until now there is not use of the highest bit , but check this for the future
+ WaitProcess:=-s // normal case
+ else
+ WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
+ end;
+end;
+
+function intFpExecVEMaybeP (Const PathName:AnsiString;Args,MyEnv:ppchar;SearchPath:Boolean):cint;
+// does an ExecVE, but still has to handle P
+// execv variants call this directly, execl variants indirectly via
+// intfpexecl
+
+Var
+ NewCmd : ansistring;
+ ThePath : AnsiString;
+
+Begin
+ If SearchPath and (pos('/',pathname)=0) Then
+ Begin
+ // The above could be better. (check if not escaped/quoted '/'s) ?
+ // (Jilles says this is ok)
+ // Stevens says only search if newcmd contains no '/'
+ // fsearch is not ansistring clean yet.
+ ThePath:=fpgetenv('PATH');
+ if thepath='' then
+ thepath:='.'; // FreeBSD uses _PATH_DEFPATH = /usr/bin:/bin
+ // but a quick check showed that _PATH_DEFPATH
+ // varied from OS to OS
+
+ newcmd:=FSearch(pathname,thepath,NoCurrentDirectory);
+ // FreeBSD libc keeps on trying till a file is successfully run.
+ // Stevens says "try each path prefix"
+
+ // execp puts newcmd here.
+ args^:=pchar(newcmd);
+ End else
+ newcmd:=pathname;
+ // repeat
+// if searchpath then args^:=pchar(commandtorun)
+
+ IntFpExecVEMaybeP:=fpExecVE(newcmd,Args,MyEnv);
+{
+// Code that if exec fails due to permissions, tries to run it with sh
+// Should we deallocate p on fail? -> no fpexit is run no matter what
+//
+}
+// if intfpexecvemaybep=-1 then zoekvolgende file.
+// until (Goexit) or SearchExit;
+
+
+{
+ If IntFpExec=-1 Then
+ Begin
+ Error:=fpGetErrno
+ Case Error of
+ ESysE2Big : Exit(-1);
+ ESysELoop,
+ : Exit(-1);
+
+}
+end;
+
+function intFpExecl (Const PathName:AnsiString;const s:array of ansistring;MyEnv:ppchar;SearchPath:Boolean):cint;
+{ Handles the array of ansistring -> ppchar conversion.
+ Base for the the "l" variants.
+}
+var p:ppchar;
+
+begin
+ If PathName='' Then
+ Begin
+ fpsetErrno(ESysEnoEnt);
+ Exit(-1); // Errno?
+ End;
+ p:=ArrayStringToPPchar(s,1);
+ if p=NIL Then
+ Begin
+ GetMem(p,2*sizeof(pchar));
+ if p=nil then
+ begin
+ {$ifdef xunix}
+ fpseterrno(ESysEnoMem);
+ {$endif}
+ fpseterrno(ESysEnoEnt);
+ exit(-1);
+ end;
+ p[1]:=nil;
+ End;
+ p^:=pchar(PathName);
+ IntFPExecL:=intFpExecVEMaybeP(PathName,p,MyEnv,SearchPath);
+ // If we come here, no attempts were executed successfully.
+ Freemem(p);
+end;
+
+function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint;
+
+Begin
+ FpExecLE:=intFPExecl(PathName,s,MyEnv,false);
+End;
+
+function FpExecL(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
+
+Begin
+ FpExecL:=intFPExecl(PathName,S,EnvP,false);
+End;
+
+function FpExecLP(Const PathName:AnsiString;const S:Array Of AnsiString):cint;
+
+Begin
+ FpExecLP:=intFPExecl(PathName,S,EnvP,True);
+End;
+
+function FpExecV(Const PathName:AnsiString;args:ppchar):cint;
+
+Begin
+ fpexecV:=intFpExecVEMaybeP (PathName,args,envp,false);
+End;
+
+function FpExecVP(Const PathName:AnsiString;args:ppchar):cint;
+
+Begin
+ fpexecVP:=intFpExecVEMaybeP (PathName,args,envp,true);
+End;
+
+function FpExecVPE(Const PathName:AnsiString;args,env:ppchar):cint;
+
+Begin
+ fpexecVPE:=intFpExecVEMaybeP (PathName,args,env,true);
+End;
+
+// exect and execvP (ExecCapitalP) are not implement
+// Non POSIX anyway.
+// Exect turns on tracing for the process
+// execvP has the searchpath as array of ansistring ( const char *search_path)
+
+{$define FPC_USE_FPEXEC}
+Function Shell(const Command:String):cint;
+{
+ Executes the shell, and passes it the string Command. (Through /bin/sh -c)
+ The current environment is passed to the shell.
+ It waits for the shell to exit, and returns its exit status.
+ If the Exec call failed exit status 127 is reported.
+}
+{ Changed the structure:
+- the previous version returns an undefinied value if fork fails
+- it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
+- it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
+- ShellArgs are now released
+- The Old CreateShellArg gives back pointers to a local var
+}
+var
+{$ifndef FPC_USE_FPEXEC}
+ p : ppchar;
+{$endif}
+ pid : cint;
+begin
+ {$ifndef FPC_USE_FPEXEC}
+ p:=CreateShellArgv(command);
+{$endif}
+ pid:=fpfork;
+ if pid=0 then // We are in the Child
+ begin
+ {This is the child.}
+ {$ifndef FPC_USE_FPEXEC}
+ fpExecve(p^,p,envp);
+ {$else}
+ fpexecl('/bin/sh',['-c',Command]);
+ {$endif}
+ fpExit(127); // was Exit(127)
+ end
+ else if (pid<>-1) then // Successfull started
+ Shell:=WaitProcess(pid)
+ else // no success
+ Shell:=-1; // indicate an error
+ {$ifndef FPC_USE_FPEXEC}
+ FreeShellArgV(p);
+ {$endif}
+end;
+
+Function Shell(const Command:AnsiString):cint;
+{
+ AnsiString version of Shell
+}
+var
+{$ifndef FPC_USE_FPEXEC}
+ p : ppchar;
+{$endif}
+ pid : cint;
+begin { Changes as above }
+{$ifndef FPC_USE_FPEXEC}
+ p:=CreateShellArgv(command);
+{$endif}
+ pid:=fpfork;
+ if pid=0 then // We are in the Child
+ begin
+ {$ifdef FPC_USE_FPEXEC}
+ fpexecl('/bin/sh',['-c',Command]);
+ {$else}
+ fpExecve(p^,p,envp);
+ {$endif}
+ fpExit(127); // was exit(127)!! We must exit the Process, not the function
+ end
+ else if (pid<>-1) then // Successfull started
+ Shell:=WaitProcess(pid)
+ else // no success
+ Shell:=-1;
+ {$ifndef FPC_USE_FPEXEC}
+ FreeShellArgV(p);
+ {$ENDIF}
+end;
+
+
+{$ifdef FPC_USE_LIBC}
+function xfpsystem(p:pchar):cint; cdecl; external clib name 'system';
+
+Function fpSystem(const Command:AnsiString):cint;
+begin
+ fpsystem:=xfpsystem(pchar(command));
+end;
+{$else}
+Function fpSystem(const Command:AnsiString):cint;
+{
+ AnsiString version of Shell
+}
+var
+ pid,savedpid : cint;
+ pstat : cint;
+ ign,intact,
+ quitact : SigactionRec;
+ newsigblock,
+ oldsigblock : tsigset;
+
+begin { Changes as above }
+ if command='' then exit(1);
+ ign.sa_handler:=SigActionHandler(SIG_IGN);
+ fpsigemptyset(ign.sa_mask);
+ ign.sa_flags:=0;
+ fpsigaction(SIGINT, @ign, @intact);
+ fpsigaction(SIGQUIT, @ign, @quitact);
+ fpsigemptyset(newsigblock);
+ fpsigaddset(newsigblock,SIGCHLD);
+ fpsigprocmask(SIG_BLOCK,{$ifdef ver1_0}@{$endif}newsigblock,{$ifdef ver1_0}@{$endif}oldsigblock);
+ pid:=fpfork;
+ if pid=0 then // We are in the Child
+ begin
+ fpsigaction(SIGINT,@intact,NIL);
+ fpsigaction(SIGQUIT,@quitact,NIL);
+ fpsigprocmask(SIG_SETMASK,@oldsigblock,NIL);
+ fpexecl('/bin/sh',['-c',Command]);
+ fpExit(127); // was exit(127)!! We must exit the Process, not the function
+ end
+ else if (pid<>-1) then // Successfull started
+ begin
+ savedpid:=pid;
+ repeat
+ pid:=fpwaitpid(savedpid,@pstat,0);
+ until (pid<>-1) and (fpgeterrno()<>ESysEintr);
+ if pid=-1 Then
+ fpsystem:=-1
+ else
+ fpsystem:=pstat;
+ end
+ else // no success
+ fpsystem:=-1;
+ fpsigaction(SIGINT,@intact,NIL);
+ fpsigaction(SIGQUIT,@quitact,NIL);
+ fpsigprocmask(SIG_SETMASK,@oldsigblock,NIL);
+end;
+{$endif}
+
+Function WIFSTOPPED(Status: Integer): Boolean;
+begin
+ WIFSTOPPED:=((Status and $FF)=$7F);
+end;
+
+Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
+begin
+ W_EXITCODE:=(ReturnCode shl 8) or Signal;
+end;
+
+Function W_STOPCODE(Signal: Integer): Integer;
+
+begin
+ W_STOPCODE:=(Signal shl 8) or $7F;
+end;
+
+
+{$IFNDEF DONT_READ_TIMEZONE}
+{ Include timezone handling routines which use /usr/share/timezone info }
+{$i timezone.inc}
+{$endif}
+{******************************************************************************
+ FileSystem calls
+******************************************************************************}
+
+Function fpFlock (var T : text;mode : cint) : cint;
+begin
+ fpFlock:=fpFlock(TextRec(T).Handle,mode);
+end;
+
+
+Function fpFlock (var F : File;mode : cint) :cint;
+begin
+ fpFlock:=fpFlock(FileRec(F).Handle,mode);
+end;
+
+Function SelectText(var T:Text;TimeOut :PTimeval):cint;
+Var
+ F:TfdSet;
+begin
+ if textrec(t).mode=fmclosed then
+ begin
+ fpseterrno(ESysEBADF);
+ exit(-1);
+ end;
+ FpFD_ZERO(f);
+ fpFD_SET(textrec(T).handle,f);
+ if textrec(T).mode=fminput then
+ SelectText:=fpselect(textrec(T).handle+1,@f,nil,nil,TimeOut)
+ else
+ SelectText:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut);
+end;
+
+Function SelectText(var T:Text;TimeOut :cint):cint;
+var
+ p : PTimeVal;
+ tv : TimeVal;
+begin
+ if TimeOut=-1 then
+ p:=nil
+ else
+ begin
+ tv.tv_Sec:=Timeout div 1000;
+ tv.tv_Usec:=(Timeout mod 1000)*1000;
+ p:=@tv;
+ end;
+ SelectText:=SelectText(T,p);
+end;
+
+{******************************************************************************
+ Directory
+******************************************************************************}
+
+procedure SeekDir(p:pdir;loc:clong);
+begin
+ if p=nil then
+ begin
+ fpseterrno(ESysEBADF);
+ exit;
+ end;
+ {$ifndef bsd}
+ p^.dd_nextoff:=fplseek(p^.dd_fd,loc,seek_set);
+ {$endif}
+ p^.dd_size:=0;
+ p^.dd_loc:=0;
+end;
+
+function TellDir(p:pdir):clong;
+begin
+ if p=nil then
+ begin
+ fpseterrno(ESysEBADF);
+ telldir:=-1;
+ exit;
+ end;
+ telldir:=fplseek(p^.dd_fd,0,seek_cur)
+ { We could try to use the nextoff field here, but on my 1.2.13
+ kernel, this gives nothing... This may have to do with
+ the readdir implementation of libc... I also didn't find any trace of
+ the field in the kernel code itself, So I suspect it is an artifact of libc.
+ Michael. }
+end;
+
+{******************************************************************************
+ Pipes/Fifo
+******************************************************************************}
+
+Procedure OpenPipe(var F:Text);
+begin
+ case textrec(f).mode of
+ fmoutput :
+ if textrec(f).userdata[1]<>P_OUT then
+ textrec(f).mode:=fmclosed;
+ fminput :
+ if textrec(f).userdata[1]<>P_IN then
+ textrec(f).mode:=fmclosed;
+ else
+ textrec(f).mode:=fmclosed;
+ end;
+end;
+
+Function IOPipe(var F:text):cint;
+begin
+ IOPipe:=0;
+ case textrec(f).mode of
+ fmoutput :
+ begin
+ { first check if we need something to write, else we may
+ get a SigPipe when Close() is called (PFV) }
+ if textrec(f).bufpos>0 then
+ IOPipe:=fpwrite(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos);
+ end;
+ fminput : Begin
+ textrec(f).bufend:=fpread(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize);
+ IOPipe:=textrec(f).bufend;
+ End;
+ end;
+ textrec(f).bufpos:=0;
+end;
+
+Function FlushPipe(var F:Text):cint;
+begin
+ FlushPipe:=0;
+ if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
+ FlushPipe:=IOPipe(f);
+ textrec(f).bufpos:=0;
+end;
+
+Function ClosePipe(var F:text):cint;
+begin
+ textrec(f).mode:=fmclosed;
+ ClosePipe:=fpclose(textrec(f).handle);
+end;
+
+
+Function AssignPipe(var pipe_in,pipe_out:text):cint;
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+}
+var
+ f_in,f_out : cint;
+begin
+ if AssignPipe(f_in,f_out)=-1 then
+ exit(-1);
+{ Set up input }
+ Assign(Pipe_in,'');
+ Textrec(Pipe_in).Handle:=f_in;
+ Textrec(Pipe_in).Mode:=fmInput;
+ Textrec(Pipe_in).userdata[1]:=P_IN;
+ TextRec(Pipe_in).OpenFunc:=@OpenPipe;
+ TextRec(Pipe_in).InOutFunc:=@IOPipe;
+ TextRec(Pipe_in).FlushFunc:=@FlushPipe;
+ TextRec(Pipe_in).CloseFunc:=@ClosePipe;
+{ Set up output }
+ Assign(Pipe_out,'');
+ Textrec(Pipe_out).Handle:=f_out;
+ Textrec(Pipe_out).Mode:=fmOutput;
+ Textrec(Pipe_out).userdata[1]:=P_OUT;
+ TextRec(Pipe_out).OpenFunc:=@OpenPipe;
+ TextRec(Pipe_out).InOutFunc:=@IOPipe;
+ TextRec(Pipe_out).FlushFunc:=@FlushPipe;
+ TextRec(Pipe_out).CloseFunc:=@ClosePipe;
+ AssignPipe:=0;
+end;
+
+Function AssignPipe(var pipe_in,pipe_out:file):cint;
+{
+ Sets up a pair of file variables, which act as a pipe. The first one can
+ be read from, the second one can be written to.
+ If the operation was unsuccesful,
+}
+var
+ f_in,f_out : cint;
+begin
+ if AssignPipe(f_in,f_out)=-1 then
+ exit(-1);
+{ Set up input }
+ Assign(Pipe_in,'');
+ Filerec(Pipe_in).Handle:=f_in;
+ Filerec(Pipe_in).Mode:=fmInput;
+ Filerec(Pipe_in).recsize:=1;
+ Filerec(Pipe_in).userdata[1]:=P_IN;
+{ Set up output }
+ Assign(Pipe_out,'');
+ Filerec(Pipe_out).Handle:=f_out;
+ Filerec(Pipe_out).Mode:=fmoutput;
+ Filerec(Pipe_out).recsize:=1;
+ Filerec(Pipe_out).userdata[1]:=P_OUT;
+ AssignPipe:=0;
+end;
+
+
+Function PCloseText(Var F:text):cint;
+{
+ May not use @PClose due overloading
+}
+begin
+ PCloseText:=PClose(f);
+end;
+
+
+function POpen(var F:text;const Prog:String;rw:char):cint;
+{
+ Starts the program in 'Prog' and makes it's input or out put the
+ other end of a pipe. If rw is 'w' or 'W', then whatever is written to
+ F, will be read from stdin by the program in 'Prog'. The inverse is true
+ for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
+ read from 'f'.
+}
+var
+ pipi,
+ pipo : text;
+ pid : pid_t;
+ pl : ^cint;
+{$ifndef FPC_USE_FPEXEC}
+ pp : ppchar;
+{$endif not FPC_USE_FPEXEC}
+ ret : cint;
+begin
+ rw:=upcase(rw);
+ if not (rw in ['R','W']) then
+ begin
+ FpSetErrno(ESysEnoent);
+ exit(-1);
+ end;
+ if AssignPipe(pipi,pipo)=-1 Then
+ Exit(-1);
+ pid:=fpfork; // vfork in FreeBSD.
+ if pid=-1 then
+ begin
+ close(pipi);
+ close(pipo);
+ exit(-1);
+ end;
+ if pid=0 then
+ begin
+ { We're in the child }
+ if rw='W' then
+ begin
+ close(pipo);
+ ret:=fpdup2(pipi,input);
+ close(pipi);
+ if ret=-1 then
+ halt(127);
+ end
+ else
+ begin
+ close(pipi);
+ ret:=fpdup2(pipo,output);
+ close(pipo);
+ if ret=-1 then
+ halt(127);
+ end;
+ {$ifdef FPC_USE_FPEXEC}
+ fpexecl('/bin/sh',['-c',Prog]);
+ {$else}
+ pp:=createshellargv(prog);
+ fpExecve(pp^,pp,envp);
+ {$endif}
+ halt(127);
+ end
+ else
+ begin
+ { We're in the parent }
+ if rw='W' then
+ begin
+ close(pipi);
+ f:=pipo;
+ textrec(f).bufptr:=@textrec(f).buffer;
+ end
+ else
+ begin
+ close(pipo);
+ f:=pipi;
+ textrec(f).bufptr:=@textrec(f).buffer;
+ end;
+ {Save the process ID - needed when closing }
+ pl:=@(textrec(f).userdata[2]);
+ pl^:=pid;
+ textrec(f).closefunc:=@PCloseText;
+ end;
+ ret:=0;
+end;
+
+Function POpen(var F:file;const Prog:String;rw:char):cint;
+{
+ Starts the program in 'Prog' and makes it's input or out put the
+ other end of a pipe. If rw is 'w' or 'W', then whatever is written to
+ F, will be read from stdin by the program in 'Prog'. The inverse is true
+ for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be
+ read from 'f'.
+}
+var
+ pipi,
+ pipo : file;
+ pid : cint;
+ pl : ^cint;
+{$ifndef FPC_USE_FPEXEC}
+ p,pp : ppchar;
+ temp : string[255];
+{$endif not FPC_USE_FPEXEC}
+ ret : cint;
+begin
+ rw:=upcase(rw);
+ if not (rw in ['R','W']) then
+ begin
+ FpSetErrno(ESysEnoent);
+ exit(-1);
+ end;
+ ret:=AssignPipe(pipi,pipo);
+ if ret=-1 then
+ exit(-1);
+ pid:=fpfork;
+ if pid=-1 then
+ begin
+ close(pipi);
+ close(pipo);
+ exit(-1);
+ end;
+ if pid=0 then
+ begin
+ { We're in the child }
+ if rw='W' then
+ begin
+ close(pipo);
+ ret:=fpdup2(filerec(pipi).handle,stdinputhandle);
+ close(pipi);
+ if ret=-1 then
+ halt(127);
+ end
+ else
+ begin
+ close(pipi);
+ ret:=fpdup2(filerec(pipo).handle,stdoutputhandle);
+ close(pipo);
+ if ret=1 then
+ halt(127);
+ end;
+ {$ifdef FPC_USE_FPEXEC}
+ fpexecl('/bin/sh',['-c',Prog]);
+ {$else}
+ getmem(pp,sizeof(pchar)*4);
+ temp:='/bin/sh'#0'-c'#0+prog+#0;
+ p:=pp;
+ p^:=@temp[1];
+ inc(p);
+ p^:=@temp[9];
+ inc(p);
+ p^:=@temp[12];
+ inc(p);
+ p^:=Nil;
+ fpExecve(ansistring('/bin/sh'),pp,envp);
+ {$endif}
+ halt(127);
+ end
+ else
+ begin
+ { We're in the parent }
+ if rw='W' then
+ begin
+ close(pipi);
+ f:=pipo;
+ end
+ else
+ begin
+ close(pipo);
+ f:=pipi;
+ end;
+ {Save the process ID - needed when closing }
+ pl:=@(filerec(f).userdata[2]);
+ pl^:=pid;
+ end;
+ POpen:=0;
+end;
+
+Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint;
+{
+ Starts the program in 'Prog' and makes its input and output the
+ other end of two pipes, which are the stdin and stdout of a program
+ specified in 'Prog'.
+ streamout can be used to write to the program, streamin can be used to read
+ the output of the program. See the following diagram :
+ Parent Child
+ STreamout --> Input
+ Streamin <-- Output
+ Return value is the process ID of the process being spawned, or -1 in case of failure.
+}
+var
+ pipi,
+ pipo : text;
+ pid : cint;
+ pl : ^cint;
+begin
+ AssignStream:=-1;
+ if AssignPipe(streamin,pipo)=-1 Then
+ exit(-1);
+ if AssignPipe(pipi,streamout)=-1 Then // shouldn't this close streamin and pipo?
+ exit(-1);
+ pid:=fpfork;
+ if pid=-1 then
+ begin
+ close(pipi);
+ close(pipo);
+ close (streamin);
+ close (streamout);
+ exit;
+ end;
+ if pid=0 then
+ begin
+ { We're in the child }
+ { Close what we don't need }
+ close(streamout);
+ close(streamin);
+ if fpdup2(pipi,input)=-1 Then
+ halt(127);
+ close(pipi);
+ If fpdup2(pipo,output)=-1 Then
+ halt (127);
+ close(pipo);
+ fpExecl(Prog,args);
+ halt(127);
+ end
+ else
+ begin
+ { we're in the parent}
+ close(pipo);
+ close(pipi);
+ {Save the process ID - needed when closing }
+ pl:=@(textrec(StreamIn).userdata[2]);
+ pl^:=pid;
+ textrec(StreamIn).closefunc:=@PCloseText;
+ {Save the process ID - needed when closing }
+ pl:=@(textrec(StreamOut).userdata[2]);
+ pl^:=pid;
+ textrec(StreamOut).closefunc:=@PCloseText;
+ AssignStream:=Pid;
+ end;
+end;
+
+Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint;
+
+{
+ Starts the program in 'prog' and makes its input, output and error output the
+ other end of three pipes, which are the stdin, stdout and stderr of a program
+ specified in 'prog'.
+ StreamOut can be used to write to the program, StreamIn can be used to read
+ the output of the program, StreamErr reads the error output of the program.
+ See the following diagram :
+ Parent Child
+ StreamOut --> StdIn (input)
+ StreamIn <-- StdOut (output)
+ StreamErr <-- StdErr (error output)
+}
+var
+ PipeIn, PipeOut, PipeErr: text;
+ pid: cint;
+ pl: ^cint;
+begin
+ AssignStream := -1;
+
+ // Assign pipes
+ if AssignPipe(StreamIn, PipeOut)=-1 Then
+ Exit(-1);
+
+ If AssignPipe(StreamErr, PipeErr)=-1 Then
+ begin
+ Close(StreamIn);
+ Close(PipeOut);
+ exit(-1);
+ end;
+
+ if AssignPipe(PipeIn, StreamOut)=-1 Then
+ begin
+ Close(StreamIn);
+ Close(PipeOut);
+ Close(StreamErr);
+ Close(PipeErr);
+ exit(-1);
+ end;
+
+ // Fork
+
+ pid := fpFork;
+ if pid=-1 then begin
+ Close(StreamIn);
+ Close(PipeOut);
+ Close(StreamErr);
+ Close(PipeErr);
+ Close(PipeIn);
+ Close(StreamOut);
+ exit(-1);
+ end;
+
+ if pid = 0 then begin
+ // *** We are in the child ***
+ // Close what we don not need
+ Close(StreamOut);
+ Close(StreamIn);
+ Close(StreamErr);
+ // Connect pipes
+ if fpdup2(PipeIn, Input)=-1 Then
+ Halt(127);
+ Close(PipeIn);
+ if fpdup2(PipeOut, Output)=-1 Then
+ Halt(127);
+ Close(PipeOut);
+ if fpdup2(PipeErr, StdErr)=-1 Then
+ Halt(127);
+ Close(PipeErr);
+ // Execute program
+ fpExecl(Prog,args);
+ Halt(127);
+ end else begin
+ // *** We are in the parent ***
+ Close(PipeErr);
+ Close(PipeOut);
+ Close(PipeIn);
+ // Save the process ID - needed when closing
+ pl := @(TextRec(StreamIn).userdata[2]);
+ pl^ := pid;
+ TextRec(StreamIn).closefunc := @PCloseText;
+ // Save the process ID - needed when closing
+ pl := @(TextRec(StreamOut).userdata[2]);
+ pl^ := pid;
+ TextRec(StreamOut).closefunc := @PCloseText;
+ // Save the process ID - needed when closing
+ pl := @(TextRec(StreamErr).userdata[2]);
+ pl^ := pid;
+ TextRec(StreamErr).closefunc := @PCloseText;
+ AssignStream := pid;
+ end;
+end;
+
+{******************************************************************************
+ General information calls
+******************************************************************************}
+
+{$ifdef Linux}
+Function GetDomainName:String; { linux only!}
+// domainname is a glibc extension.
+
+{
+ Get machines domain name. Returns empty string if not set.
+}
+Var
+ Sysn : utsname;
+begin
+ If fpUname(sysn)<>0 then
+ getdomainname:=''
+ else
+ getdomainname:=strpas(@Sysn.domain[0]);
+end;
+{$endif}
+
+{$ifdef BSD}
+
+function intGetDomainName(Name:PChar; NameLen:Cint):cint;
+{$ifndef FPC_USE_LIBC}
+ external name 'FPC_SYSC_GETDOMAINNAME';
+{$else FPC_USE_LIBC}
+ cdecl; external clib name 'getdomainname';
+{$endif FPC_USE_LIBC}
+
+Function GetDomainName:String; { linux only!}
+// domainname is a glibc extension.
+
+{
+ Get machines domain name. Returns empty string if not set.
+}
+
+begin
+ if intGetDomainName(@getdomainname[1],255)=-1 then
+ getdomainname:=''
+ else
+ getdomainname[0]:=chr(strlen(@getdomainname[1]));
+end;
+{$endif}
+
+
+Function GetHostName:String;
+{
+ Get machines name. Returns empty string if not set.
+}
+Var
+ Sysn : utsname;
+begin
+ If fpuname(sysn)=-1 then
+ gethostname:=''
+ else
+ gethostname:=strpas(@Sysn.nodename[0]);
+end;
+
+{******************************************************************************
+ Signal handling calls
+******************************************************************************}
+
+procedure SigRaise(sig:integer);
+begin
+ fpKill(fpGetPid,Sig);
+end;
+
+
+{******************************************************************************
+ Utility calls
+******************************************************************************}
+
+Function FSearch(const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString;
+{
+ Searches for a file 'path' in the list of direcories in 'dirlist'.
+ returns an empty string if not found. Wildcards are NOT allowed.
+ If dirlist is empty, it is set to '.'
+
+This function tries to make FSearch use ansistrings, and decrease
+stringhandling overhead at the same time.
+
+}
+Var
+ mydir,NewDir : ansistring;
+ p1 : cint;
+ Info : Stat;
+ i,j : cint;
+ p : pchar;
+Begin
+
+ if CurrentDirStrategy=CurrentDirectoryFirst Then
+ Dirlist:='.:'+dirlist; {Make sure current dir is first to be searched.}
+ if CurrentDirStrategy=CurrentDirectoryLast Then
+ Dirlist:=dirlist+':.'; {Make sure current dir is last to be searched.}
+
+{Replace ':' and ';' with #0}
+
+ for p1:=1 to length(dirlist) do
+ if (dirlist[p1]=':') or (dirlist[p1]=';') then
+ dirlist[p1]:=#0;
+
+{Check for WildCards}
+ If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
+ FSearch:='' {No wildcards allowed in these things.}
+ Else
+ Begin
+ p:=pchar(dirlist);
+ i:=length(dirlist);
+ j:=1;
+ Repeat
+ mydir:=ansistring(p);
+ if (length(mydir)>0) and (mydir[length(mydir)]<>'/') then
+ mydir:=mydir+'/';
+ NewDir:=mydir+Path;
+ if (FpStat(NewDir,Info)>=0) and
+ (not fpS_ISDIR(Info.st_Mode)) then
+ Begin
+ If Pos('./',NewDir)=1 Then
+ Delete(NewDir,1,2);
+ {DOS strips off an initial .\}
+ End
+ Else
+ NewDir:='';
+ while (j<=i) and (p^<>#0) do begin inc(j); inc(p); end;
+ if p^=#0 then inc(p);
+ Until (j>=i) or (Length(NewDir) > 0);
+ FSearch:=NewDir;
+ End;
+End;
+
+Function FSearch(const path:AnsiString;dirlist:Ansistring):AnsiString;
+
+Begin
+ FSearch:=FSearch(path,dirlist,CurrentDirectoryFirst);
+End;
+
+{--------------------------------
+ Stat.Mode Macro's
+--------------------------------}
+
+Initialization
+{$IFNDEF DONT_READ_TIMEZONE}
+ InitLocalTime;
+{$endif}
+finalization
+{$IFNDEF DONT_READ_TIMEZONE}
+ DoneLocalTime;
+{$endif}
+End.
+
+{
+ $Log: unix.pp,v $
+ Revision 1.85 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.84 2005/02/14 17:13:31 peter
+ * truncate log
+
+ Revision 1.83 2005/02/13 21:47:56 peter
+ * include file cleanup part 2
+
+ Revision 1.82 2005/02/13 20:01:38 peter
+ * include file cleanup
+
+ Revision 1.81 2005/02/06 11:20:52 peter
+ * threading in system unit
+ * removed systhrds unit
+
+ Revision 1.80 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+ Revision 1.79 2005/01/22 20:56:11 michael
+ + Patch for intFpExecVEMaybeP to use the right path (From Colin Western)
+
+}
diff --git a/rtl/unix/unixtype.pp b/rtl/unix/unixtype.pp
new file mode 100644
index 0000000000..1c843835dd
--- /dev/null
+++ b/rtl/unix/unixtype.pp
@@ -0,0 +1,33 @@
+{
+ $Id: unixtype.pp,v 1.2 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ (c) 2004 by Marco van de Voort
+ member of the Free Pascal development team.
+
+ THIS UNIT IS NOT FOR USE BY ENDUSERS. IT IS USED TO AVOID CERTAIN
+ CIRCULAR REFERENCE PROBLEMS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+unit unixtype;
+
+Interface
+
+{$i ptypes.inc}
+
+Implementation
+
+End.
+
+{
+ $Log: unixtype.pp,v $
+ Revision 1.2 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/unixutil.pp b/rtl/unix/unixutil.pp
new file mode 100644
index 0000000000..c33cfff43b
--- /dev/null
+++ b/rtl/unix/unixutil.pp
@@ -0,0 +1,417 @@
+{
+ $Id: unixutil.pp,v 1.8 2005/03/25 22:53:39 jonas Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ <What does this file>
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit unixutil;
+
+interface
+
+var
+ Tzseconds : Longint;
+
+Type
+ ComStr = String[255];
+ PathStr = String[255];
+ DirStr = String[255];
+ NameStr = String[255];
+ ExtStr = String[255];
+
+Function Dirname(Const path:pathstr):pathstr;
+Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
+Function StringToPPChar(Var S:String;ReserveEntries:integer):ppchar;
+Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
+function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
+Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+Function FNMatch(const Pattern,Name:string):Boolean;
+Function GetFS (var T:Text):longint;
+Function GetFS(Var F:File):longint;
+Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
+Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
+Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
+Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
+
+implementation
+
+{$I textrec.inc}
+{$i filerec.inc}
+
+function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
+// Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?)
+// Note: for internal use by skilled programmers only
+// if "s" goes out of scope in the parent procedure, the pointer is dangling.
+
+var p : ppchar;
+ i : LongInt;
+begin
+ if High(s)<Low(s) Then Exit(NIL);
+ Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2)); // one more for NIL, one more
+ // for cmd
+ if p=nil then
+ begin
+ {$ifdef xunix}
+ fpseterrno(ESysEnomem);
+ {$endif}
+ exit(NIL);
+ end;
+ for i:=low(s) to high(s) do
+ p[i+Reserveentries]:=pchar(s[i]);
+ p[high(s)+1+Reserveentries]:=nil;
+ ArrayStringToPPchar:=p;
+end;
+
+
+Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
+Var
+ DotPos,SlashPos,i : longint;
+Begin
+ SlashPos:=0;
+ DotPos:=256;
+ i:=Length(Path);
+ While (i>0) and (SlashPos=0) Do
+ Begin
+ If (DotPos=256) and (Path[i]='.') Then
+ begin
+ DotPos:=i;
+ end;
+ If (Path[i]='/') Then
+ SlashPos:=i;
+ Dec(i);
+ End;
+ Ext:=Copy(Path,DotPos,255);
+ Dir:=Copy(Path,1,SlashPos);
+ Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
+End;
+
+
+Function Dirname(Const path:pathstr):pathstr;
+{
+ This function returns the directory part of a complete path.
+ Unless the directory is root '/', The last character is not
+ a slash.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if length(Dir)>1 then
+ Delete(Dir,length(Dir),1);
+ DirName:=Dir;
+end;
+
+Function StringToPPChar(Var S:String;ReserveEntries:integer):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+ Note that the string S is destroyed by this call.
+}
+
+begin
+ S:=S+#0;
+ StringToPPChar:=StringToPPChar(pchar(@S[1]),ReserveEntries);
+end;
+
+Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
+{
+ Create a PPChar to structure of pchars which are the arguments specified
+ in the string S. Especially usefull for creating an ArgV for Exec-calls
+}
+
+begin
+ StringToPPChar:=StringToPPChar(PChar(S),ReserveEntries);
+end;
+
+Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
+
+var
+ i,nr : longint;
+ Buf : ^char;
+ p : ppchar;
+
+begin
+ buf:=s;
+ nr:=1;
+ while (buf^<>#0) do // count nr of args
+ begin
+ while (buf^ in [' ',#9,#10]) do // Kill separators.
+ inc(buf);
+ inc(nr);
+ if buf^='"' Then // quotes argument?
+ begin
+ inc(buf);
+ while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+ inc(buf);
+ if buf^='"' then // skip closing quote.
+ inc(buf);
+ end
+ else
+ begin // else std
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+ end;
+ getmem(p,(ReserveEntries+nr)*sizeof(pchar));
+ StringToPPChar:=p;
+ if p=nil then
+ begin
+ {$ifdef xunix}
+ fpseterrno(ESysEnomem);
+ {$endif}
+ exit;
+ end;
+ for i:=1 to ReserveEntries do inc(p); // skip empty slots
+ buf:=s;
+ while (buf^<>#0) do
+ begin
+ while (buf^ in [' ',#9,#10]) do // Kill separators.
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ if buf^='"' Then // quotes argument?
+ begin
+ inc(buf);
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+ inc(buf);
+ if buf^='"' then // skip closing quote.
+ begin
+ buf^:=#0;
+ inc(buf);
+ end;
+ end
+ else
+ begin
+ p^:=buf;
+ inc(p);
+ p^:=nil;
+ while not (buf^ in [' ',#0,#9,#10]) do
+ inc(buf);
+ end;
+ end;
+end;
+
+
+Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
+{
+ This function returns the filename part of a complete path. If suf is
+ supplied, it is cut off the filename.
+}
+var
+ Dir : PathStr;
+ Name : NameStr;
+ Ext : ExtStr;
+begin
+ FSplit(Path,Dir,Name,Ext);
+ if Suf<>Ext then
+ Name:=Name+Ext;
+ BaseName:=Name;
+end;
+
+
+Function FNMatch(const Pattern,Name:string):Boolean;
+Var
+ LenPat,LenName : longint;
+
+ Function DoFNMatch(i,j:longint):Boolean;
+ Var
+ Found : boolean;
+ Begin
+ Found:=true;
+ While Found and (i<=LenPat) Do
+ Begin
+ Case Pattern[i] of
+ '?' : Found:=(j<=LenName);
+ '*' : Begin
+ {find the next character in pattern, different of ? and *}
+ while Found do
+ begin
+ inc(i);
+ if i>LenPat then Break;
+ case Pattern[i] of
+ '*' : ;
+ '?' : begin
+ if j>LenName then begin DoFNMatch:=false; Exit; end;
+ inc(j);
+ end;
+ else
+ Found:=false;
+ end;
+ end;
+ Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
+ {Now, find in name the character which i points to, if the * or ?
+ wasn't the last character in the pattern, else, use up all the
+ chars in name}
+ Found:=false;
+ if (i<=LenPat) then
+ begin
+ repeat
+ {find a letter (not only first !) which maches pattern[i]}
+ while (j<=LenName) and (name[j]<>pattern[i]) do
+ inc (j);
+ if (j<LenName) then
+ begin
+ if DoFnMatch(i+1,j+1) then
+ begin
+ i:=LenPat;
+ j:=LenName;{we can stop}
+ Found:=true;
+ Break;
+ end else
+ inc(j);{We didn't find one, need to look further}
+ end else
+ if j=LenName then
+ begin
+ Found:=true;
+ Break;
+ end;
+ { This 'until' condition must be j>LenName, not j>=LenName.
+ That's because when we 'need to look further' and
+ j = LenName then loop must not terminate. }
+ until (j>LenName);
+ end else
+ begin
+ j:=LenName;{we can stop}
+ Found:=true;
+ end;
+ end;
+ else {not a wildcard character in pattern}
+ Found:=(j<=LenName) and (pattern[i]=name[j]);
+ end;
+ inc(i);
+ inc(j);
+ end;
+ DoFnMatch:=Found and (j>LenName);
+ end;
+
+Begin {start FNMatch}
+ LenPat:=Length(Pattern);
+ LenName:=Length(Name);
+ FNMatch:=DoFNMatch(1,1);
+End;
+
+
+
+Function GetFS (var T:Text):longint;
+{
+ Get File Descriptor of a text file.
+}
+begin
+ if textrec(t).mode=fmclosed then
+ exit(-1)
+ else
+ GETFS:=textrec(t).Handle
+end;
+
+
+Function GetFS(Var F:File):longint;
+{
+ Get File Descriptor of an unTyped file.
+}
+begin
+ { Handle and mode are on the same place in textrec and filerec. }
+ if filerec(f).mode=fmclosed then
+ exit(-1)
+ else
+ GETFS:=filerec(f).Handle
+end;
+
+Const
+{Date Translation}
+ C1970=2440588;
+ D0 = 1461;
+ D1 = 146097;
+ D2 =1721119;
+
+
+Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
+Var
+ YYear,XYear,Temp,TempMonth : LongInt;
+Begin
+ Temp:=((JulianDN-D2) shl 2)-1;
+ JulianDN:=Temp Div D1;
+ XYear:=(Temp Mod D1) or 3;
+ YYear:=(XYear Div D0);
+ Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
+ Day:=((Temp Mod 153)+5) Div 5;
+ TempMonth:=Temp Div 153;
+ If TempMonth>=10 Then
+ Begin
+ inc(YYear);
+ dec(TempMonth,12);
+ End;
+ inc(TempMonth,3);
+ Month := TempMonth;
+ Year:=YYear+(JulianDN*100);
+end;
+
+Procedure EpochToLocal(epoch:longint;var year,month,day,hour,minute,second:Word);
+{
+ Transforms Epoch time into local time (hour, minute,seconds)
+}
+Var
+ DateNum: LongInt;
+Begin
+ inc(Epoch,TZSeconds);
+ Datenum:=(Epoch Div 86400) + c1970;
+ JulianToGregorian(DateNum,Year,Month,day);
+ Epoch:=Abs(Epoch Mod 86400);
+ Hour:=Epoch Div 3600;
+ Epoch:=Epoch Mod 3600;
+ Minute:=Epoch Div 60;
+ Second:=Epoch Mod 60;
+End;
+
+Function LocalToEpoch(year,month,day,hour,minute,second:Word):Longint;
+{
+ Transforms local time (year,month,day,hour,minutes,second) to Epoch time
+ (seconds since 00:00, january 1 1970, corrected for local time zone)
+}
+Begin
+ LocalToEpoch:=((GregorianToJulian(Year,Month,Day)-c1970)*86400)+
+ (LongInt(Hour)*3600)+(Longint(Minute)*60)+Second-TZSeconds;
+End;
+
+
+Function GregorianToJulian(Year,Month,Day:Longint):LongInt;
+Var
+ Century,XYear: LongInt;
+Begin
+ If Month<=2 Then
+ Begin
+ Dec(Year);
+ Inc(Month,12);
+ End;
+ Dec(Month,3);
+ Century:=(longint(Year Div 100)*D1) shr 2;
+ XYear:=(longint(Year Mod 100)*D0) shr 2;
+ GregorianToJulian:=((((Month*153)+2) div 5)+Day)+D2+XYear+Century;
+End;
+
+
+end.
+{
+ $Log: unixutil.pp,v $
+ Revision 1.8 2005/03/25 22:53:39 jonas
+ * fixed several warnings and notes about unused variables (mainly) or
+ uninitialised use of variables/function results (a few)
+
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/unxdeclh.inc b/rtl/unix/unxdeclh.inc
new file mode 100644
index 0000000000..c9bbb647ae
--- /dev/null
+++ b/rtl/unix/unxdeclh.inc
@@ -0,0 +1,30 @@
+{
+ $Id: unxdeclh.inc,v 1.7 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ cdecl; definitions needed for unix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+type filedesarray=array[0..1] of cint;
+
+Function fStatFS(Fd:Longint;Var Info:tstatfs):cint; cdecl; external clib name 'fstatfs';
+Function fpFlock (fd,mode : longint) : cint; cdecl; external clib name 'flock';
+Function fsync (fd : cint) : cint; cdecl; external clib name 'fsync';
+Function StatFS (Path:pchar;Var Info:tstatfs):cint; cdecl; external clib name 'statfs';
+function pipe (var fildes: filedesarray):cint; cdecl; external clib name 'pipe';
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'gettimeofday';
+{
+ $Log: unxdeclh.inc,v $
+ Revision 1.7 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/unxovl.inc b/rtl/unix/unxovl.inc
new file mode 100644
index 0000000000..fde6adab3d
--- /dev/null
+++ b/rtl/unix/unxovl.inc
@@ -0,0 +1,35 @@
+{
+ $Id: unxovl.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Marco van de Voort
+
+ Some generic overloads for stringfunctions in the unix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Function StatFS(Path:ansistring;Var Info:Tstatfs):cint;
+
+{
+ Get all information on a fileSystem, and return it in Info.
+ Path is the name of a file/directory on the fileSystem you wish to
+ investigate.
+}
+
+begin
+ statfs:=statfs(pchar(path),info);
+end;
+
+{
+ $Log: unxovl.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
+
diff --git a/rtl/unix/unxovlh.inc b/rtl/unix/unxovlh.inc
new file mode 100644
index 0000000000..1f6c0e6b6e
--- /dev/null
+++ b/rtl/unix/unxovlh.inc
@@ -0,0 +1,27 @@
+{
+ $Id: unxovlh.inc,v 1.5 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ cdecl; definitions needed for unix unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+Function PClose(Var F:file) : cint;
+Function PClose (Var F:text) : cint;
+Function StatFS(Path:ansistring;Var Info:Tstatfs):cint;
+//Function fpReadLink(Name:ansistring):ansistring;
+
+{
+ $Log: unxovlh.inc,v $
+ Revision 1.5 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
diff --git a/rtl/unix/varutils.pp b/rtl/unix/varutils.pp
new file mode 100644
index 0000000000..9dcb838944
--- /dev/null
+++ b/rtl/unix/varutils.pp
@@ -0,0 +1,47 @@
+{
+ $Id: varutils.pp,v 1.3 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.3 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
+
diff --git a/rtl/unix/video.pp b/rtl/unix/video.pp
new file mode 100644
index 0000000000..bf039f2759
--- /dev/null
+++ b/rtl/unix/video.pp
@@ -0,0 +1,909 @@
+{
+ $Id: video.pp,v 1.28 2005/02/14 17:13:31 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Video unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+
+interface
+
+{$i videoh.inc}
+
+implementation
+
+uses
+ BaseUnix, Strings, TermInfo, termio;
+
+{$i video.inc}
+
+
+Type TConsoleType = (ttyNetwork,ttyLinux,ttyFreeBSD,ttyNetBSD);
+
+var
+ LastCursorType : byte;
+ TtyFd: Longint;
+ Console: TConsoleType;
+{$ifdef logging}
+ f: file;
+
+const
+ logstart: string = '';
+ nl: char = #10;
+ logend: string = #10#10;
+{$endif logging}
+
+{$ifdef cpui386}
+{$ASMMODE ATT}
+{$endif cpui386}
+
+const
+
+ can_delete_term : boolean = false;
+ ACSIn : string = '';
+ ACSOut : string = '';
+ InACS : boolean =false;
+
+function IsACS(var ch,ACSchar : char): boolean;
+begin
+ IsACS:=false;
+ case ch of
+ #24, #30: {}
+ ch:='^';
+ #25, #31: {}
+ ch:='v';
+ #26, #16: {Never introduce a ctrl-Z ... }
+ ch:='>';
+ {#27,needed in Escape sequences} #17: {}
+ ch:='<';
+ #176, #177, #178: {°±²}
+ begin
+ IsACS:=true;
+ ACSChar:='a';
+ end;
+ #180, #181, #182, #185: {´µ¶¹}
+ begin
+ IsACS:=true;
+ ACSChar:='u';
+ end;
+ #183, #184, #187, #191: {·¸»¿}
+ begin
+ IsACS:=true;
+ ACSChar:='k';
+ end;
+ #188, #189, #190, #217: {¼½¾Ù}
+ begin
+ IsACS:=true;
+ ACSChar:='j';
+ end;
+ #192, #200, #211, #212: {ÀÈÓÔ}
+ begin
+ IsACS:=true;
+ ACSChar:='m';
+ end;
+ #193, #202, #207, #208: {ÁÊÏÐ}
+ begin
+ IsACS:=true;
+ ACSChar:='v';
+ end;
+ #194, #203, #209, #210: {ÂËÑÒ}
+ begin
+ IsACS:=true;
+ ACSChar:='w';
+ end;
+ #195, #198, #199, #204: {ÃÆÇÌ}
+ begin
+ IsACS:=true;
+ ACSChar:='t';
+ end;
+ #196, #205: {ÄÍ}
+ begin
+ IsACS:=true;
+ ACSChar:='q';
+ end;
+ #179, #186: {³º}
+ begin
+ IsACS:=true;
+ ACSChar:='x';
+ end;
+ #197, #206, #215, #216: {ÅÎר}
+ begin
+ IsACS:=true;
+ ACSChar:='n';
+ end;
+ #201, #213, #214, #218: {ÉÕÖÚ}
+ begin
+ IsACS:=true;
+ ACSChar:='l';
+ end;
+ #254: { þ }
+ begin
+ ch:='*';
+ end;
+ { Shadows for Buttons }
+ #220: { Ü }
+ begin
+ IsACS:=true;
+ ACSChar:='a';
+ end;
+ #223: { ß }
+ begin
+ IsACS:=true;
+ ACSChar:='a';
+ end;
+ end;
+end;
+
+
+function SendEscapeSeqNdx(Ndx: Word) : boolean;
+var
+ P,pdelay: PChar;
+begin
+ SendEscapeSeqNdx:=false;
+ if not assigned(cur_term_Strings) then
+ exit{RunError(219)};
+ P:=cur_term_Strings^[Ndx];
+ if assigned(p) then
+ begin { Do not transmit the delays }
+ pdelay:=strpos(p,'$<');
+ if assigned(pdelay) then
+ pdelay^:=#0;
+ fpWrite(stdoutputhandle, P^, StrLen(P));
+ SendEscapeSeqNdx:=true;
+ if assigned(pdelay) then
+ pdelay^:='$';
+ end;
+end;
+
+
+procedure SendEscapeSeq(const S: String);
+begin
+ fpWrite(stdoutputhandle, S[1], Length(S));
+end;
+
+
+Function IntStr(l:longint):string;
+var
+ s : string;
+begin
+ Str(l,s);
+ IntStr:=s;
+end;
+
+
+Function XY2Ansi(x,y,ox,oy:longint):String;
+{
+ Returns a string with the escape sequences to go to X,Y on the screen.
+
+ Note that x, y, ox, oy are 1-based (i.e. top-left corner of the screen
+ is (1, 1)), while SetCursorPos parameters and CursorX and CursorY
+ are 0-based (top-left corner of the screen is (0, 0)).
+}
+Begin
+ if y=oy then
+ begin
+ if x=ox then
+ begin
+ XY2Ansi:='';
+ exit;
+ end;
+ if x=1 then
+ begin
+ XY2Ansi:=#13;
+ exit;
+ end;
+ if x>ox then
+ begin
+ XY2Ansi:=#27'['+IntStr(x-ox)+'C';
+ exit;
+ end
+ else
+ begin
+ XY2Ansi:=#27'['+IntStr(ox-x)+'D';
+ exit;
+ end;
+ end;
+ if x=ox then
+ begin
+ if y>oy then
+ begin
+ XY2Ansi:=#27'['+IntStr(y-oy)+'B';
+ exit;
+ end
+ else
+ begin
+ XY2Ansi:=#27'['+IntStr(oy-y)+'A';
+ exit;
+ end;
+ end;
+ if ((x=1) and (oy+1=y)) and (console<>ttyfreebsd) then
+ XY2Ansi:=#13#10
+ else
+ XY2Ansi:=#27'['+IntStr(y)+';'+IntStr(x)+'H';
+End;
+
+
+
+const
+ AnsiTbl : string[8]='04261537';
+Function Attr2Ansi(Attr,OAttr:longint):string;
+{
+ Convert Attr to an Ansi String, the Optimal code is calculate
+ with use of the old OAttr
+}
+var
+ hstr : string[16];
+ OFg,OBg,Fg,Bg : longint;
+
+ procedure AddSep(ch:char);
+ begin
+ if length(hstr)>0 then
+ hstr:=hstr+';';
+ hstr:=hstr+ch;
+ end;
+
+begin
+ if Attr=OAttr then
+ begin
+ Attr2Ansi:='';
+ exit;
+ end;
+ Hstr:='';
+ Fg:=Attr and $f;
+ Bg:=Attr shr 4;
+ OFg:=OAttr and $f;
+ OBg:=OAttr shr 4;
+ if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then
+ begin
+ hstr:='0';
+ OFg:=7;
+ OBg:=0;
+ end;
+ if (Fg>7) and (OFg<8) then
+ begin
+ AddSep('1');
+ OFg:=OFg or 8;
+ end;
+ if (Bg and 8)<>(OBg and 8) then
+ begin
+ AddSep('5');
+ OBg:=OBg or 8;
+ end;
+ if (Fg<>OFg) then
+ begin
+ AddSep('3');
+ hstr:=hstr+AnsiTbl[(Fg and 7)+1];
+ end;
+ if (Bg<>OBg) then
+ begin
+ AddSep('4');
+ hstr:=hstr+AnsiTbl[(Bg and 7)+1];
+ end;
+ if hstr='0' then
+ hstr:='';
+ Attr2Ansi:=#27'['+hstr+'m';
+end;
+
+procedure UpdateTTY(Force:boolean);
+type
+ tchattr=packed record
+{$ifdef ENDIAN_LITTLE}
+ ch : char;
+ attr : byte;
+{$else}
+ attr : byte;
+ ch : char;
+{$endif}
+ end;
+var
+ outbuf : array[0..1023+255] of char;
+ chattr : tchattr;
+ skipped : boolean;
+ outptr,
+ spaces,
+ eol,
+ x,y,
+ LastX,LastY,
+ SpaceAttr,
+ LastAttr : longint;
+ p,pold : pvideocell;
+ LastLineWidth : Longint;
+
+procedure TransformUsingACS(var st : string);
+var
+ res : string;
+ i : longint;
+ ch,ACSch : char;
+begin
+ res:='';
+ for i:=1 to length(st) do
+ begin
+ ch:=st[i];
+ if IsACS(ch,ACSch) then
+ begin
+ if not InACS then
+ begin
+ res:=res+ACSIn;
+ InACS:=true;
+ end;
+ res:=res+ACSch;
+ end
+ else
+ begin
+ if InACS then
+ begin
+ res:=res+ACSOut+Attr2Ansi(LastAttr,0);
+ InACS:=false;
+ end;
+ res:=res+ch;
+ end;
+ end;
+ st:=res;
+end;
+
+
+
+ procedure outdata(hstr:string);
+ begin
+ If Length(HStr)>0 Then
+ Begin
+ while (eol>0) do
+ begin
+ hstr:=#13#10+hstr;
+ dec(eol);
+ end;
+ if NoExtendedFrame and (ACSIn<>'') and (ACSOut<>'') then
+ TransformUsingACS(Hstr);
+ move(hstr[1],outbuf[outptr],length(hstr));
+ inc(outptr,length(hstr));
+ if outptr>=1024 then
+ begin
+{$ifdef logging}
+ blockwrite(f,logstart[1],length(logstart));
+ blockwrite(f,nl,1);
+ blockwrite(f,outptr,sizeof(outptr));
+ blockwrite(f,nl,1);
+ blockwrite(f,outbuf,outptr);
+ blockwrite(f,nl,1);
+{$endif logging}
+ fpWrite(stdoutputhandle,outbuf,outptr);
+ outptr:=0;
+ end;
+ end;
+ end;
+
+ procedure OutClr(c:byte);
+ begin
+ if c=LastAttr then
+ exit;
+ OutData(Attr2Ansi(c,LastAttr));
+ LastAttr:=c;
+ end;
+
+ procedure OutSpaces;
+ begin
+ if (Spaces=0) then
+ exit;
+ OutClr(SpaceAttr);
+ OutData(Space(Spaces));
+ LastX:=x;
+ LastY:=y;
+ Spaces:=0;
+ end;
+
+function GetTermString(ndx:word):String;
+var
+ P,pdelay: PChar;
+begin
+ GetTermString:='';
+ if not assigned(cur_term_Strings) then
+ exit{RunError(219)};
+ P:=cur_term_Strings^[Ndx];
+ if assigned(p) then
+ begin { Do not transmit the delays }
+ pdelay:=strpos(p,'$<');
+ if assigned(pdelay) then
+ pdelay^:=#0;
+ GetTermString:=StrPas(p);
+ if assigned(pdelay) then
+ pdelay^:='$';
+ end;
+end;
+
+begin
+ OutPtr:=0;
+ Eol:=0;
+ skipped:=true;
+ p:=PVideoCell(VideoBuf);
+ pold:=PVideoCell(OldVideoBuf);
+{ init Attr, X,Y and set autowrap off }
+ SendEscapeSeq(#27'[m'#27'[?7l'{#27'[H'} );
+// 1.0.x: SendEscapeSeq(#27'[m'{#27'[H'});
+ LastAttr:=7;
+ LastX:=-1;
+ LastY:=-1;
+ for y:=1 to ScreenHeight do
+ begin
+ SpaceAttr:=0;
+ Spaces:=0;
+ LastLineWidth:=ScreenWidth;
+ If (y=ScreenHeight) And (Console=ttyFreeBSD) {And :am: is on} Then
+ LastLineWidth:=ScreenWidth-2;
+ for x:=1 to LastLineWidth do
+ begin
+ if (not force) and (p^=pold^) then
+ begin
+ if (Spaces>0) then
+ OutSpaces;
+ skipped:=true;
+ end
+ else
+ begin
+ if skipped then
+ begin
+ OutData(XY2Ansi(x,y,LastX,LastY));
+ LastX:=x;
+ LastY:=y;
+ skipped:=false;
+ end;
+ chattr:=tchattr(p^);
+ if chattr.ch in [#0,#255] then
+ chattr.ch:=' ';
+ if chattr.ch=' ' then
+ begin
+ if Spaces=0 then
+ SpaceAttr:=chattr.Attr;
+ if (chattr.attr and $f0)=(spaceattr and $f0) then
+ chattr.Attr:=SpaceAttr
+ else
+ begin
+ OutSpaces;
+ SpaceAttr:=chattr.Attr;
+ end;
+ inc(Spaces);
+ end
+ else
+ begin
+ if (Spaces>0) then
+ OutSpaces;
+ if ord(chattr.ch)<32 then
+ begin
+ Chattr.Attr:= $ff xor Chattr.Attr;
+ ChAttr.ch:= chr(ord(chattr.ch)+ord('A')-1);
+ end;
+ if LastAttr<>chattr.Attr then
+ OutClr(chattr.Attr);
+ OutData(chattr.ch);
+ LastX:=x+1;
+ LastY:=y;
+ end;
+ p^:=tvideocell(chattr);
+ end;
+ inc(p);
+ inc(pold);
+ end;
+ if (Spaces>0) then
+ OutSpaces;
+ if force then
+ inc(eol)
+ else
+ skipped:=true;
+ end;
+ eol:=0;
+ {if am in capabilities? Then}
+ If (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then
+ Begin
+ OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY));
+ OutData(#8);
+ {Output last char}
+ chattr:=tchattr(p[1]);
+ if LastAttr<>chattr.Attr then
+ OutClr(chattr.Attr);
+ OutData(chattr.ch);
+ inc(LastX);
+// OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
+// OutData(GetTermString(Insert_character));
+ OutData(#8+#27+'[1@');
+
+ chattr:=tchattr(p^);
+ if LastAttr<>chattr.Attr then
+ OutClr(chattr.Attr);
+ OutData(chattr.ch);
+ inc(LastX);
+ end;
+ OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY));
+{$ifdef logging}
+ blockwrite(f,logstart[1],length(logstart));
+ blockwrite(f,nl,1);
+ blockwrite(f,outptr,sizeof(outptr));
+ blockwrite(f,nl,1);
+ blockwrite(f,outbuf,outptr);
+ blockwrite(f,nl,1);
+{$endif logging}
+ fpWrite(stdoutputhandle,outbuf,outptr);
+ if InACS then
+ SendEscapeSeqNdx(exit_alt_charset_mode);
+ {turn autowrap on}
+// SendEscapeSeq(#27'[?7h');
+end;
+
+var
+ preInitVideoTio, postInitVideoTio: termio.termios;
+ inputRaw, outputRaw: boolean;
+
+procedure saveRawSettings(const tio: termio.termios);
+Begin
+ with tio do
+ begin
+ inputRaw :=
+ ((c_iflag and (IGNBRK or BRKINT or PARMRK or ISTRIP or
+ INLCR or IGNCR or ICRNL or IXON)) = 0) and
+ ((c_lflag and (ECHO or ECHONL or ICANON or ISIG or IEXTEN)) = 0);
+ outPutRaw :=
+ ((c_oflag and OPOST) = 0) and
+ ((c_cflag and (CSIZE or PARENB)) = 0) and
+ ((c_cflag and CS8) <> 0);
+ end;
+end;
+
+procedure restoreRawSettings(tio: termio.termios);
+begin
+ with tio do
+ begin
+ if inputRaw then
+ begin
+ c_iflag := c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
+ INLCR or IGNCR or ICRNL or IXON));
+ c_lflag := c_lflag and
+ (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
+ c_cc[VMIN]:=1;
+ c_cc[VTIME]:=0;
+ end;
+ if outPutRaw then
+ begin
+ c_oflag := c_oflag and not(OPOST);
+ c_cflag := c_cflag and not(CSIZE or PARENB) or CS8;
+ end;
+ end;
+ TCSetAttr(1,TCSANOW,tio);
+end;
+
+
+procedure prepareInitVideo;
+begin
+ TCGetAttr(1,preInitVideoTio);
+ saveRawSettings(preInitVideoTio);
+end;
+
+procedure videoInitDone;
+begin
+ TCGetAttr(1,postInitVideoTio);
+ restoreRawSettings(postInitVideoTio);
+end;
+
+procedure prepareDoneVideo;
+var
+ tio: termio.termios;
+begin
+ TCGetAttr(1,tio);
+ saveRawSettings(tio);
+ TCSetAttr(1,TCSANOW,postInitVideoTio);
+end;
+
+procedure doneVideoDone;
+begin
+ restoreRawSettings(preInitVideoTio);
+end;
+
+procedure SysInitVideo;
+const
+ fontstr : string[3]=#27'(K';
+var
+ ThisTTY: String[30];
+ FName: String;
+ WS: packed record
+ ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
+ end;
+ Err: Longint;
+ prev_term : TerminalCommon_ptr1;
+begin
+{$ifndef CPUI386}
+ LowAscii:=false;
+{$endif CPUI386}
+ { check for tty }
+ ThisTTY:=TTYName(stdinputhandle);
+ if (IsATTY(stdinputhandle)<>-1) then
+ begin
+ { save current terminal characteristics and remove rawness }
+ prepareInitVideo;
+ { write code to set a correct font }
+ fpWrite(stdoutputhandle,fontstr[1],length(fontstr));
+ { running on a tty, find out whether locally or remotely }
+ TTyfd:=-1;
+ Console:=TTyNetwork; {Default: Network or other vtxxx tty}
+ if (Copy(ThisTTY, 1, 8) = '/dev/tty') and
+ not (ThisTTY[9] IN ['p'..'u','P']) then // FreeBSD has these
+ begin
+ { running on the console }
+ Case ThisTTY[9] of
+ '0'..'9' : begin { running Linux on native console or native-emulation }
+ FName:='/dev/vcsa' + ThisTTY[9];
+ { open console, $1b6=rw-rw-rw- }
+ TTYFd:=fpOpen(FName, $1b6, O_RdWr);
+ IF TTYFd <>-1 Then
+ Console:=ttyLinux;
+ end;
+ 'v' : { check for (Free?)BSD native}
+ If (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
+ Console:=ttyFreeBSD; {TTYFd ?}
+ end;
+ end;
+ If (Copy(fpGetEnv('TERM'),1,4)='cons') Then // cons<lines>
+ Console:=ttyFreeBSD;
+ If Console<>ttylinux Then
+ begin
+ { running on a remote terminal, no error with /dev/vcsa }
+ LowAscii:=false;
+ //TTYFd:=stdoutputhandle;
+ end;
+ fpioctl(stdinputhandle, TIOCGWINSZ, @WS);
+ if WS.ws_Col=0 then
+ WS.ws_Col:=80;
+ if WS.ws_Row=0 then
+ WS.ws_Row:=25;
+ ScreenWidth:=WS.ws_Col;
+ { TDrawBuffer only has FVMaxWidth elements
+ larger values lead to crashes }
+ if ScreenWidth> FVMaxWidth then
+ ScreenWidth:=FVMaxWidth;
+ ScreenHeight:=WS.ws_Row;
+ CursorX:=0;
+ CursorY:=0;
+ LastCursorType:=$ff;
+ ScreenColor:=True;
+ { Start with a clear screen }
+ if Console<>ttylinux then
+ begin
+ prev_term:=cur_term;
+ setupterm(nil, stdoutputhandle, err);
+ can_delete_term:=assigned(prev_term) and (prev_term<>cur_term);
+ SendEscapeSeqNdx(cursor_home);
+ SendEscapeSeqNdx(cursor_normal);
+ SendEscapeSeqNdx(cursor_visible);
+ SendEscapeSeqNdx(enter_ca_mode);
+ SetCursorType(crUnderLine);
+ If Console=ttyFreeBSD Then
+ SendEscapeSeqNdx(exit_am_mode);
+ end
+ else if not assigned(cur_term) then
+ begin
+ setupterm(nil, stdoutputhandle, err);
+ can_delete_term:=false;
+ end;
+ if assigned(cur_term_Strings) then
+ begin
+ ACSIn:=StrPas(cur_term_Strings^[enter_alt_charset_mode]);
+ ACSOut:=StrPas(cur_term_Strings^[exit_alt_charset_mode]);
+ if (ACSIn<>'') and (ACSOut<>'') then
+ SendEscapeSeqNdx(ena_acs);
+ if pos('$<',ACSIn)>0 then
+ ACSIn:=Copy(ACSIn,1,Pos('$<',ACSIn)-1);
+ if pos('$<',ACSOut)>0 then
+ ACSOut:=Copy(ACSOut,1,Pos('$<',ACSOut)-1);
+ If fpGetEnv('TERM')='xterm' then
+ NoExtendedFrame := true; {use of acs for xterm is ok}
+ end
+ else
+ begin
+ ACSIn:='';
+ ACSOut:='';
+ end;
+{$ifdef logging}
+ assign(f,'video.log');
+ rewrite(f,1);
+{$endif logging}
+ { save new terminal characteristics and possible restore rawness }
+ videoInitDone;
+ end
+ else
+ ErrorCode:=errVioInit; { not a TTY }
+end;
+
+procedure SysDoneVideo;
+begin
+ prepareDoneVideo;
+ if Console=ttylinux then
+ SetCursorPos(0,0)
+ else
+ begin
+ SendEscapeSeqNdx(exit_ca_mode);
+ SendEscapeSeqNdx(cursor_home);
+ SendEscapeSeqNdx(cursor_normal);
+ SendEscapeSeqNdx(cursor_visible);
+ SetCursorType(crUnderLine);
+ SendEscapeSeq(#27'[H');
+ end;
+ ACSIn:='';
+ ACSOut:='';
+ doneVideoDone;
+ { FreeBSD gives an error here.
+ According to Pierre this could be more a NCurses version thing that
+ a FreeBSD one. FreeBSD 4.4 has ncurses 5.
+ MvdV102003: Since I ran 1.1 with newer FreeBSD without problem, I let it be for now}
+ if can_delete_term then
+ begin
+ del_curterm(cur_term);
+ can_delete_term:=false;
+ end;
+{$ifdef logging}
+ close(f);
+{$endif logging}
+end;
+
+
+procedure SysClearScreen;
+begin
+ if Console=ttylinux then
+ UpdateScreen(true)
+ else
+ begin
+ SendEscapeSeq(#27'[0m');
+ SendEscapeSeqNdx(clear_screen);
+ end;
+end;
+
+
+procedure SysUpdateScreen(Force: Boolean);
+var
+ DoUpdate : boolean;
+ i : longint;
+ p1,p2 : plongint;
+begin
+ if not force then
+ begin
+{$ifdef cpui386}
+ asm
+ pushl %esi
+ pushl %edi
+ movl VideoBuf,%esi
+ movl OldVideoBuf,%edi
+ movl VideoBufSize,%ecx
+ shrl $2,%ecx
+ repe
+ cmpsl
+ setne DoUpdate
+ popl %edi
+ popl %esi
+ end;
+{$else not cpui386}
+ p1:=plongint(VideoBuf);
+ p2:=plongint(OldVideoBuf);
+ for i:=0 to VideoBufSize div 2 do
+ if (p1^<>p2^) then
+ begin
+ DoUpdate:=true;
+ break;
+ end
+ else
+ begin
+ { Inc does add sizeof(longint) to both pointer values }
+ inc(p1);
+ inc(p2);
+ end;
+{$endif not cpui386}
+ end
+ else
+ DoUpdate:=true;
+ if not DoUpdate then
+ exit;
+ if Console=ttylinux then
+ begin
+ fplSeek(TTYFd, 4, Seek_Set);
+ fpWrite(TTYFd, VideoBuf^,VideoBufSize);
+ end
+ else
+ begin
+ UpdateTTY(force);
+ end;
+ Move(VideoBuf^, OldVideoBuf^, VideoBufSize);
+end;
+
+
+function SysGetCapabilities: Word;
+begin
+{ about cpColor... we should check the terminfo database... }
+ SysGetCapabilities:=cpUnderLine + cpBlink + cpColor;
+end;
+
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+var
+ Pos : array [1..2] of Byte;
+begin
+ if (CursorX=NewCursorX) and (CursorY=NewCursorY) then
+ exit;
+ if Console=ttylinux then
+ begin
+ fplSeek(TTYFd, 2, Seek_Set);
+ Pos[1]:=NewCursorX;
+ Pos[2]:=NewCursorY;
+ fpWrite(TTYFd, Pos, 2);
+ end
+ else
+ begin
+ { newcursorx,y and CursorX,Y are 0 based ! }
+ SendEscapeSeq(XY2Ansi(NewCursorX+1,NewCursorY+1,CursorX+1,CursorY+1));
+ end;
+ CursorX:=NewCursorX;
+ CursorY:=NewCursorY;
+end;
+
+
+function SysGetCursorType: Word;
+begin
+ SysGetCursorType:=LastCursorType;
+end;
+
+
+procedure SysSetCursorType(NewType: Word);
+begin
+ If LastCursorType=NewType then
+ exit;
+ LastCursorType:=NewType;
+ case NewType of
+ crBlock :
+ Begin
+ If not SendEscapeSeqNdx(cursor_visible) then
+ If Console<>ttyFreeBSD Then // should be done only for linux?
+ SendEscapeSeq(#27'[?17;0;64c');
+ End;
+ crHidden :
+ Begin
+ If not SendEscapeSeqNdx(cursor_invisible) then
+ If Console<>ttyFreeBSD Then
+ SendEscapeSeq(#27'[?1c');
+ End;
+ else
+ begin
+ If not SendEscapeSeqNdx(cursor_normal) then
+ If Console<>ttyFreeBSD Then
+ SendEscapeSeq(#27'[?2c');
+ end;
+ end;
+end;
+
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : @SysClearScreen;
+ SetVideoMode : Nil;
+ GetVideoModeCount : Nil;
+ GetVideoModeData : Nil;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities;
+ );
+
+initialization
+ SetVideoDriver(SysVideoDriver);
+end.
+{
+ $Log: video.pp,v $
+ Revision 1.28 2005/02/14 17:13:31 peter
+ * truncate log
+
+}
+
diff --git a/rtl/unix/x86.pp b/rtl/unix/x86.pp
new file mode 100644
index 0000000000..30a9c78a61
--- /dev/null
+++ b/rtl/unix/x86.pp
@@ -0,0 +1,399 @@
+{
+ $Id: x86.pp,v 1.7 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1997-2004 by the Free Pascal development team
+
+ Some x86 specific stuff. Has to be fixed still for *BSD
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY;without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit x86;
+
+interface
+
+Uses BaseUnix;
+
+function ReadPortB (Port : Longint): Byte;
+function ReadPortW (Port : Longint): Word;
+function ReadPortL (Port : Longint): Longint;
+Procedure ReadPort (Port : Longint; Var Value : Byte);
+Procedure ReadPort (Port : Longint; Var Value : Longint);
+Procedure ReadPort (Port : Longint; Var Value : Word);
+Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
+Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
+Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
+Procedure WritePort (Port : Longint; Value : Byte);
+Procedure WritePort (Port : Longint; Value : Longint);
+Procedure WritePort (Port : Longint; Value : Word);
+Procedure WritePortB (Port : Longint; Value : Byte);
+Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
+Procedure WritePortL (Port : Longint; Value : Longint);
+Procedure WritePortW (Port : Longint; Value : Word);
+Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
+Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
+
+Function fpIOperm (From,Num : Cardinal; Value : cint) : cint;
+Function fpIoPL(Level : cint) : cint;
+
+implementation
+{$ASMMODE ATT}
+
+Uses Syscall;
+
+Procedure WritePort (Port : Longint; Value : Byte);
+{
+ Writes 'Value' to port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ movb value,%al
+ outb %al,%dx
+ end ['EAX','EDX'];
+end;
+
+Procedure WritePort (Port : Longint; Value : Word);
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movw value,%ax
+ outw %ax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure WritePort (Port : Longint; Value : Longint);
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movl value,%eax
+ outl %eax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+Procedure WritePortB (Port : Longint; Value : Byte);
+{
+ Writes 'Value' to port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ movb value,%al
+ outb %al,%dx
+ end ['EAX','EDX'];
+end;
+
+Procedure WritePortW (Port : Longint; Value : Word);
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movw value,%ax
+ outw %ax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure WritePortL (Port : Longint; Value : Longint);
+{
+ Writes 'Value' to port 'Port'
+}
+
+begin
+ asm
+ movl port,%edx
+ movl value,%eax
+ outl %eax,%dx
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure WritePortl (Port : Longint; Var Buf; Count: longint);
+{
+ Writes 'Count' longints from 'Buf' to Port
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%esi
+ movl port,%edx
+ cld
+ rep
+ outsl
+ end ['ECX','ESI','EDX'];
+end;
+
+
+
+Procedure WritePortW (Port : Longint; Var Buf; Count: longint);
+{
+ Writes 'Count' words from 'Buf' to Port
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%esi
+ movl port,%edx
+ cld
+ rep
+ outsw
+ end ['ECX','ESI','EDX'];
+end;
+
+
+
+Procedure WritePortB (Port : Longint; Var Buf; Count: longint);
+{
+ Writes 'Count' bytes from 'Buf' to Port
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%esi
+ movl port,%edx
+ cld
+ rep
+ outsb
+ end ['ECX','ESI','EDX'];
+end;
+
+
+
+Procedure ReadPort (Port : Longint; Var Value : Byte);
+{
+ Reads 'Value' from port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ inb %dx,%al
+ movl value,%edx
+ movb %al,(%edx)
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure ReadPort (Port : Longint; Var Value : Word);
+{
+ Reads 'Value' from port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ inw %dx,%ax
+ movl value,%edx
+ movw %ax,(%edx)
+ end ['EAX','EDX'];
+end;
+
+
+
+Procedure ReadPort (Port : Longint; Var Value : Longint);
+{
+ Reads 'Value' from port 'Port'
+}
+begin
+ asm
+ movl port,%edx
+ inl %dx,%eax
+ movl value,%edx
+ movl %eax,(%edx)
+ end ['EAX','EDX'];
+end;
+
+
+
+function ReadPortB (Port : Longint): Byte; assembler;
+{
+ Reads a byte from port 'Port'
+}
+
+asm
+ movl port,%edx
+ xorl %eax,%eax
+ inb %dx,%al
+end ['EAX','EDX'];
+
+function ReadPortW (Port : Longint): Word; assembler;
+{
+ Reads a word from port 'Port'
+}
+asm
+ movl port,%edx
+ xorl %eax,%eax
+ inw %dx,%ax
+end ['EAX','EDX'];
+
+function ReadPortL (Port : Longint): LongInt; assembler;
+{
+ Reads a LongInt from port 'Port'
+}
+asm
+ movl port,%edx
+ inl %dx,%eax
+end ['EAX','EDX'];
+
+Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
+{
+ Reads 'Count' longints from port 'Port' to 'Buf'.
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%edi
+ movl port,%edx
+ cld
+ rep
+ insl
+ end ['ECX','EDI','EDX'];
+end;
+
+
+
+Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
+{
+ Reads 'Count' words from port 'Port' to 'Buf'.
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%edi
+ movl port,%edx
+ cld
+ rep
+ insw
+ end ['ECX','EDI','EDX'];
+end;
+
+Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
+{
+ Reads 'Count' bytes from port 'Port' to 'Buf'.
+}
+begin
+ asm
+ movl count,%ecx
+ movl buf,%edi
+ movl port,%edx
+ cld
+ rep
+ insb
+ end ['ECX','EDI','EDX'];
+end;
+
+{$ifdef linux}
+Function fpIOperm (From,Num : Cardinal; Value : cint) : cint;
+{
+ Set permissions on NUM ports starting with port FROM to VALUE
+ this works ONLY as root.
+}
+
+begin
+ fpIOPerm:=do_Syscall(Syscall_nr_ioperm,TSysParam(From),TSysParam(Num),TSysParam(Value));
+end;
+{$else}
+
+
+{$packrecords C}
+
+TYPE uint=CARDINAL;
+
+CONST
+ I386_GET_LDT =0;
+ I386_SET_LDT =1;
+ { I386_IOPL }
+ I386_GET_IOPERM =3;
+ I386_SET_IOPERM =4;
+ { xxxxx }
+ I386_VM86 =6;
+
+
+type
+
+{ i386_ldt_args = record
+ int start : longint;
+ union descriptor *descs;
+ int num;
+ end;
+}
+
+ i386_ioperm_args = record
+ start : cuint;
+ length : cuint;
+ enable : cint;
+ end;
+
+
+ i386_vm86_args = record
+ sub_op : cint; { sub-operation to perform }
+ sub_args : pchar; { args }
+ end;
+
+ sysarch_args = record
+ op : longint;
+ parms : pchar;
+ end;
+
+Function fpIOPerm(From,Num:CARDINAL;Value:cint):cint;
+
+var sg : i386_ioperm_args;
+ sa : sysarch_args;
+
+begin
+ sg.start:=From;
+ sg.length:=Num;
+ sg.enable:=value;
+ sa.op:=i386_SET_IOPERM;
+ sa.parms:=@sg;
+ fpIOPerm:=do_syscall(syscall_nr_sysarch,TSysParam(@sa));
+end;
+{$endif}
+
+Function fpIoPL(Level : cint) : cint;
+
+begin
+ {$ifdef Linux}
+ fpIOPL:=do_Syscall(Syscall_nr_iopl,TSysParam(Level));
+ {$endif}
+end;
+
+
+end.
+
+{
+ $Log: x86.pp,v $
+ Revision 1.7 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.6 2005/02/05 20:07:19 michael
+ + Fix for compilation with version 1.0.10
+
+ Revision 1.5 2005/02/05 10:44:01 marco
+ * FreeBSD ioperm fixes backported from 1.0
+
+ Revision 1.4 2005/02/05 08:42:24 marco
+ * regvars problem fixed
+
+}
diff --git a/rtl/watcom/Makefile b/rtl/watcom/Makefile
new file mode 100644
index 0000000000..95e9bc2d8b
--- /dev/null
+++ b/rtl/watcom/Makefile
@@ -0,0 +1,2010 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=watcom
+override CPU_TARGET_DEFAULT=i386
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+UNITPREFIX=rtl
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+ifdef EXCEPTIONS_IN_SYSTEM
+override FPCOPT+=-dEXCEPTIONS_IN_SYSTEM
+endif
+override FPCOPT+=-dNO_EXCEPTIONS_IN_SYSTEM
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=system objpas macpas strings watcom dos crt objects cpu charset types getopts heaptrc lineinfo ctypes
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=prt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo classes variants sysconst
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+prt0$(OEXT) : prt0.asm
+ wasm prt0.asm -bt=dos -5s -fp5 -ms -zq
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ system$(PPUEXT)
+watcom$(PPUEXT) : watcom.pp system$(PPUEXT)
+dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
+ $(COMPILER) -Sg dpmiexcp.pp
+initc$(PPUEXT) : initc.pp system$(PPUEXT)
+profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) watcom$(PPUEXT)
+dxeload$(PPUEXT) : dxeload.pp system$(PPUEXT)
+emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
+ dpmiexcp$(PPUEXT)
+ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
+ watcom$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc watcom$(PPUEXT) system$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+graph$(PPUEXT) : graph.pp watcom$(PPUEXT) ports$(PPUEXT) system$(PPUEXT) \
+ $(GRAPHINCDEPS) vesa.inc vesah.inc dpmi.inc
+ $(COMPILER) -I$(GRAPHDIR) graph.pp
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) watcom$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
diff --git a/rtl/watcom/Makefile.fpc b/rtl/watcom/Makefile.fpc
new file mode 100644
index 0000000000..dfbb33edff
--- /dev/null
+++ b/rtl/watcom/Makefile.fpc
@@ -0,0 +1,207 @@
+#
+# Makefile.fpc for Watcom RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0
+#exceptn fpu
+units=system objpas macpas strings watcom dos crt objects \
+ cpu charset types getopts heaptrc lineinfo ctypes
+# math typinfo mmx ucomplex \
+# varutils variants sysutils
+
+# dpmiexcp initc ports profile dxeload emu387 \
+# printer graph classes \
+# msmouse video mouse keyboard vesamode
+
+rsts=math varutils typinfo classes variants sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=watcom
+cpu=i386
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=../inc
+PROCINC=../$(CPU_TARGET)
+
+UNITPREFIX=rtl
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Insert exception handler in system unit
+ifdef EXCEPTIONS_IN_SYSTEM
+override FPCOPT+=-dEXCEPTIONS_IN_SYSTEM
+endif
+
+# Insert exception handler in system unit
+# ifdef NO_EXCEPTIONS_IN_SYSTEM !!!!!!!!!!!!!!!!!!!!1
+override FPCOPT+=-dNO_EXCEPTIONS_IN_SYSTEM
+# endif !!!!!!!!!!!!!!!!!!!!
+
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : prt0.asm
+ wasm prt0.asm -bt=dos -5s -fp5 -ms -zq
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+system$(PPUEXT) : system.pp $(SYSDEPS)
+ $(COMPILER) -Us -Sg system.pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+ system$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+watcom$(PPUEXT) : watcom.pp system$(PPUEXT)
+
+dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
+ $(COMPILER) -Sg dpmiexcp.pp
+
+initc$(PPUEXT) : initc.pp system$(PPUEXT)
+
+profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) watcom$(PPUEXT)
+
+dxeload$(PPUEXT) : dxeload.pp system$(PPUEXT)
+
+emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
+ dpmiexcp$(PPUEXT)
+
+ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
+ watcom$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc watcom$(PPUEXT) system$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
+
+#
+# Graph
+#
+
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+
+graph$(PPUEXT) : graph.pp watcom$(PPUEXT) ports$(PPUEXT) system$(PPUEXT) \
+ $(GRAPHINCDEPS) vesa.inc vesah.inc dpmi.inc
+ $(COMPILER) -I$(GRAPHDIR) graph.pp
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) watcom$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp
+ $(COMPILER) -I$(OBJPASDIR) varutils.pp
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
diff --git a/rtl/watcom/classes.pp b/rtl/watcom/classes.pp
new file mode 100644
index 0000000000..aa216262f1
--- /dev/null
+++ b/rtl/watcom/classes.pp
@@ -0,0 +1,53 @@
+{
+ $Id: classes.pp,v 1.4 2005/04/17 17:33:40 hajny Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for Watcom
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ typinfo,
+ rtlconsts,
+ sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.4 2005/04/17 17:33:40 hajny
+ * more rtlconst/s fixes
+
+ Revision 1.3 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/watcom/crt.pp b/rtl/watcom/crt.pp
new file mode 100644
index 0000000000..52af23d393
--- /dev/null
+++ b/rtl/watcom/crt.pp
@@ -0,0 +1,762 @@
+{
+ $Id: crt.pp,v 1.5 2005/02/14 17:13:32 peter Exp $
+
+}
+
+unit crt;
+
+interface
+
+{$i crth.inc}
+
+implementation
+
+uses
+ watcom;
+
+
+{$ASMMODE ATT}
+
+var
+ DelayCnt,
+ ScreenWidth,
+ ScreenHeight : longint;
+ VidSeg : Word;
+
+{
+ definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
+
+
+{****************************************************************************
+ Low level Routines
+****************************************************************************}
+
+procedure setscreenmode(mode : byte);
+var
+ regs : trealregs;
+begin
+ regs.realeax:=mode;
+ realintr($10,regs);
+end;
+
+
+function GetScreenHeight : longint;
+begin
+ getscreenheight:=mem[$40:$84]+1;
+ If mem[$40:$84]=0 then
+ getscreenheight := 25;
+end;
+
+
+function GetScreenWidth : longint;
+begin
+ getscreenwidth:=memw[$40:$4a];
+end;
+
+
+procedure SetScreenCursor(x,y : longint);
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0200;
+ regs.realebx:=0;
+ regs.realedx:=(y-1) shl 8+(x-1);
+ realintr($10,regs);
+end;
+
+
+procedure GetScreenCursor(var x,y : longint);
+begin
+ x:=mem[$40:$50]+1;
+ y:=mem[$40:$51]+1;
+end;
+
+
+{****************************************************************************
+ Helper Routines
+****************************************************************************}
+
+Function WinMinX: Byte;
+{
+ Current Minimum X coordinate
+}
+Begin
+ WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Byte;
+{
+ Current Minimum Y Coordinate
+}
+Begin
+ WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Byte;
+{
+ Current Maximum X coordinate
+}
+Begin
+ WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Byte;
+{
+ Current Maximum Y coordinate;
+}
+Begin
+ WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+
+Function FullWin:boolean;
+{
+ Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+ FullWin:=(WinMinX=1) and (WinMinY=1) and
+ (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
+end;
+
+
+{****************************************************************************
+ Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+
+var
+ regs : trealregs;
+
+begin
+ lastmode:=mode;
+ mode:=mode and $ff;
+ setscreenmode(mode);
+
+ { set 8x8 font }
+ if (lastmode and $100)<>0 then
+ begin
+ regs.realeax:=$1112;
+ regs.realebx:=$0;
+ realintr($10,regs);
+ end;
+
+ screenwidth:=getscreenwidth;
+ screenheight:=getscreenheight;
+ windmin:=0;
+ windmax:=(screenwidth-1) or ((screenheight-1) shl 8);
+end;
+
+
+Procedure TextColor(Color: Byte);
+{
+ Switch foregroundcolor
+}
+Begin
+ TextAttr:=(Color and $f) or (TextAttr and $70);
+ If (Color>15) Then TextAttr:=TextAttr Or Blink;
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+ Switch backgroundcolor
+}
+Begin
+ TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+End;
+
+
+
+Procedure HighVideo;
+{
+ Set highlighted output.
+}
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+ Set normal output
+}
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+ Set normal back and foregroundcolors.
+}
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+ Go to coordinates X,Y in the current window.
+}
+Begin
+ If (X>0) and (X<=WinMaxX- WinMinX+1) and
+ (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+ Begin
+ Inc(X,WinMinX-1);
+ Inc(Y,WinMinY-1);
+ SetScreenCursor(x,y);
+ End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+ Set screen window to the specified coordinates.
+}
+Begin
+ if (X1>X2) or (X2>ScreenWidth) or
+ (Y1>Y2) or (Y2>ScreenHeight) then
+ exit;
+ WindMin:=((Y1-1) Shl 8)+(X1-1);
+ WindMax:=((Y2-1) Shl 8)+(X2-1);
+ GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+ Clear the current window, and set the cursor on 1,1
+}
+var
+ fil : word;
+ y : longint;
+begin
+ fil:=32 or (textattr shl 8);
+ if FullWin then
+ DosmemFillWord(VidSeg,0,ScreenHeight*ScreenWidth,fil)
+ else
+ begin
+ for y:=WinMinY to WinMaxY do
+ DosmemFillWord(VidSeg,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil);
+ end;
+ Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+ Clear from current position to end of line.
+}
+var
+ x,y : longint;
+ fil : word;
+Begin
+ GetScreenCursor(x,y);
+ fil:=32 or (textattr shl 8);
+ if x<=WinMaxX then
+ DosmemFillword(VidSeg,((y-1)*ScreenWidth+(x-1))*2,WinMaxX-x+1,fil);
+End;
+
+
+
+Function WhereX: Byte;
+{
+ Return current X-position of cursor.
+}
+var
+ x,y : longint;
+Begin
+ GetScreenCursor(x,y);
+ WhereX:=x-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+ Return current Y-position of cursor.
+}
+var
+ x,y : longint;
+Begin
+ GetScreenCursor(x,y);
+ WhereY:=y-WinMinY+1;
+End;
+
+
+{*************************************************************************
+ KeyBoard
+*************************************************************************}
+
+var
+ is_last : boolean;
+ last : char;
+
+function readkey : char;
+var
+ char2 : char;
+ char1 : char;
+ regs : trealregs;
+begin
+ if is_last then
+ begin
+ is_last:=false;
+ readkey:=last;
+ end
+ else
+ begin
+ regs.ah:=$10;
+ realintr($16,regs);
+ if (regs.al=$e0) and (regs.ah<>0) then
+ regs.al:=0;
+ char1:=chr(regs.al);
+ char2:=chr(regs.ah);
+ if char1=#0 then
+ begin
+ is_last:=true;
+ last:=char2;
+ end;
+ readkey:=char1;
+ end;
+end;
+
+
+function keypressed : boolean;
+var
+ regs : trealregs;
+begin
+ if is_last then
+ begin
+ keypressed:=true;
+ exit;
+ end
+ else
+ begin
+ regs.ah:=$11;
+ realintr($16,regs);
+ keypressed:=((regs.realflags and zeroflag) = 0);
+ end;
+end;
+
+
+{*************************************************************************
+ Delay
+*************************************************************************}
+
+procedure Delayloop;assembler;
+asm
+.LDelayLoop1:
+ subl $1,%eax
+ jc .LDelayLoop2
+ cmpl %fs:(%edi),%ebx
+ je .LDelayLoop1
+.LDelayLoop2:
+end;
+
+
+procedure initdelay;assembler;
+asm
+ pushl %ebx
+ pushl %edi
+ { for some reason, using int $31/ax=$901 doesn't work here }
+ { and interrupts are always disabled at this point when }
+ { running a program inside gdb(pas). Web bug 1345 (JM) }
+ sti
+ movl $0x46c,%edi
+ movl $-28,%edx
+ movl %fs:(%edi),%ebx
+.LInitDel1:
+ cmpl %fs:(%edi),%ebx
+ je .LInitDel1
+ movl %fs:(%edi),%ebx
+ movl %edx,%eax
+ call DelayLoop
+
+ notl %eax
+ xorl %edx,%edx
+ movl $55,%ecx
+ divl %ecx
+ movl %eax,DelayCnt
+ popl %edi
+ popl %ebx
+end;
+
+
+procedure Delay(MS: Word);assembler;
+asm
+ pushl %ebx
+ pushl %edi
+ movzwl MS,%ecx
+ jecxz .LDelay2
+ movl $0x400,%edi
+ movl DelayCnt,%edx
+ movl %fs:(%edi),%ebx
+.LDelay1:
+ movl %edx,%eax
+ call DelayLoop
+ loop .LDelay1
+.LDelay2:
+ popl %edi
+ popl %ebx
+end;
+
+
+procedure sound(hz : word);
+begin
+ if hz=0 then
+ begin
+ nosound;
+ exit;
+ end;
+ asm
+ movzwl hz,%ecx
+ movl $1193046,%eax
+ cltd
+ divl %ecx
+ movl %eax,%ecx
+ inb $0x61,%al
+ testb $0x3,%al
+ jnz .Lsound_next
+ orb $0x3,%al
+ outb %al,$0x61
+ movb $0xb6,%al
+ outb %al,$0x43
+ .Lsound_next:
+ movb %cl,%al
+ outb %al,$0x42
+ movb %ch,%al
+ outb %al,$0x42
+ end ['EAX','ECX','EDX'];
+end;
+
+
+procedure nosound;
+begin
+ asm
+ inb $0x61,%al
+ andb $0xfc,%al
+ outb %al,$0x61
+ end ['EAX'];
+end;
+
+
+
+{****************************************************************************
+ HighLevel Crt Functions
+****************************************************************************}
+
+procedure removeline(y : longint);
+var
+ fil : word;
+begin
+ fil:=32 or (textattr shl 8);
+ y:=WinMinY+y-1;
+ While (y<WinMaxY) do
+ begin
+ dosmemmove(VidSeg,(y*ScreenWidth+(WinMinX-1))*2,
+ VidSeg,((y-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+ inc(y);
+ end;
+ dosmemfillword(VidSeg,((WinMaxY-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+procedure delline;
+begin
+ removeline(wherey);
+end;
+
+
+procedure insline;
+var
+ my,y : longint;
+ fil : word;
+begin
+ fil:=32 or (textattr shl 8);
+ y:=WhereY;
+ my:=WinMaxY-WinMinY;
+ while (my>=y) do
+ begin
+ dosmemmove(VidSeg,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2,
+ VidSeg,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+ dec(my);
+ end;
+ dosmemfillword(VidSeg,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0100;
+ regs.realecx:=$90A;
+ If VidSeg=$b800 then
+ regs.realecx:=$90A
+ else
+ regs.realecx:=$b0d;
+ realintr($10,regs);
+end;
+
+
+procedure cursoroff;
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0100;
+ regs.realecx:=$ffff;
+ realintr($10,regs);
+end;
+
+
+procedure cursorbig;
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$0100;
+ regs.realecx:=$10A;
+ realintr($10,regs);
+end;
+
+
+{*****************************************************************************
+ Read and Write routines
+*****************************************************************************}
+
+var
+ CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var
+ regs : trealregs;
+begin
+ case c of
+ #10 : inc(CurrY);
+ #13 : CurrX:=WinMinX;
+ #8 : begin
+ if CurrX>WinMinX then
+ dec(CurrX);
+ end;
+ #7 : begin { beep }
+ regs.dl:=7;
+ regs.ah:=2;
+ realintr($21,regs);
+ end;
+ else
+ begin
+ memw[VidSeg:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c);
+ inc(CurrX);
+ end;
+ end;
+ if CurrX>WinMaxX then
+ begin
+ CurrX:=WinMinX;
+ inc(CurrY);
+ end;
+ while CurrY>WinMaxY do
+ begin
+ removeline(1);
+ dec(CurrY);
+ end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+ i : longint;
+begin
+ GetScreenCursor(CurrX,CurrY);
+ for i:=0 to f.bufpos-1 do
+ WriteChar(f.buffer[i]);
+ SetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+ procedure BackSpace;
+ begin
+ if (f.bufpos>0) and (f.bufpos=f.bufend) then
+ begin
+ WriteChar(#8);
+ WriteChar(' ');
+ WriteChar(#8);
+ dec(f.bufpos);
+ dec(f.bufend);
+ end;
+ end;
+
+var
+ ch : Char;
+Begin
+ GetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ f.bufend:=0;
+ repeat
+ if f.bufpos>f.bufend then
+ f.bufend:=f.bufpos;
+ SetScreenCursor(CurrX,CurrY);
+ ch:=readkey;
+ case ch of
+ #0 : case readkey of
+ #71 : while f.bufpos>0 do
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #75 : if f.bufpos>0 then
+ begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #77 : if f.bufpos<f.bufend then
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #79 : while f.bufpos<f.bufend do
+ begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ end;
+ ^S,
+ #8 : BackSpace;
+ ^Y,
+ #27 : begin
+ f.bufpos:=f.bufend;
+ while f.bufend>0 do
+ BackSpace;
+ end;
+ #13 : begin
+ WriteChar(#13);
+ WriteChar(#10);
+ f.bufptr^[f.bufend]:=#13;
+ f.bufptr^[f.bufend+1]:=#10;
+ inc(f.bufend,2);
+ break;
+ end;
+ #26 : if CheckEOF then
+ begin
+ f.bufptr^[f.bufend]:=#26;
+ inc(f.bufend);
+ break;
+ end;
+ else
+ begin
+ if f.bufpos<f.bufsize-2 then
+ begin
+ f.buffer[f.bufpos]:=ch;
+ inc(f.bufpos);
+ WriteChar(ch);
+ end;
+ end;
+ end;
+ until false;
+ f.bufpos:=0;
+ SetScreenCursor(CurrX,CurrY);
+ CrtRead:=0;
+End;
+
+
+Function CrtReturn(Var F: TextRec): Integer;
+Begin
+ CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+ If F.Mode=fmOutput Then
+ begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end
+ Else
+ begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+{ use the C version to avoid using dpmiexcp unit
+ which makes sysutils and exceptions working incorrectly PM }
+
+//function __djgpp_set_ctrl_c(enable : longint) : boolean;cdecl;external;
+
+var
+ x,y : longint;
+begin
+{ Load startup values }
+ ScreenWidth:=GetScreenWidth;
+ ScreenHeight:=GetScreenHeight;
+ WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
+{ Load TextAttr }
+ GetScreenCursor(x,y);
+ lastmode := mem[$40:$49];
+ if screenheight>25 then
+ lastmode:=lastmode or $100;
+ If not(lastmode=Mono) then
+ VidSeg := $b800
+ else
+ VidSeg := $b000;
+ TextAttr:=mem[VidSeg:((y-1)*ScreenWidth+(x-1))*2+1];
+{ Redirect the standard output }
+ assigncrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:=StdOutputHandle;
+ assigncrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:=StdInputHandle;
+{ Calculates delay calibration }
+ initdelay;
+{ Enable ctrl-c input (JM) }
+// __djgpp_set_ctrl_c(0);
+end.
+
+{
+ $Log: crt.pp,v $
+ Revision 1.5 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/watcom/dos.pp b/rtl/watcom/dos.pp
new file mode 100644
index 0000000000..026afedaac
--- /dev/null
+++ b/rtl/watcom/dos.pp
@@ -0,0 +1,848 @@
+{
+ $Id: dos.pp,v 1.10 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Dos unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+interface
+
+Uses
+ Watcom;
+
+
+Type
+ searchrec = packed record
+ fill : array[1..21] of byte;
+ attr : byte;
+ time : longint;
+ { reserved : word; not in DJGPP V2 }
+ size : longint;
+ name : string[255]; { LFN Name, DJGPP uses only [12] but more can't hurt (PFV) }
+ end;
+
+{$DEFINE HAS_REGISTERS}
+ Registers = Watcom.Registers;
+
+{$i dosh.inc}
+
+implementation
+
+uses
+ strings;
+
+{$DEFINE HAS_GETMSCOUNT}
+{$DEFINE HAS_INTR}
+{$DEFINE HAS_GETCBREAK}
+{$DEFINE HAS_SETCBREAK}
+{$DEFINE HAS_GETVERIFY}
+{$DEFINE HAS_SETVERIFY}
+{$DEFINE HAS_GETSHORTNAME}
+{$DEFINE HAS_GETLONGNAME}
+{$DEFINE HAS_GETMSCOUNT}
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+{$I dos.inc}
+
+
+{******************************************************************************
+ --- Dos Interrupt ---
+******************************************************************************}
+
+var
+ dosregs : registers;
+
+procedure LoadDosError;
+var
+ r : registers;
+ SimpleDosError : word;
+begin
+ if (dosregs.flags and fcarry) <> 0 then
+ begin
+ { I got a extended error = 0
+ while CarryFlag was set from Exec function }
+ SimpleDosError:=dosregs.ax;
+ r.eax:=$5900;
+ r.ebx:=$0;
+ realintr($21,r);
+ { conversion from word to integer !!
+ gave a Bound check error if ax is $FFFF !! PM }
+ doserror:=integer(r.ax);
+ case doserror of
+ 0 : DosError:=integer(SimpleDosError);
+ 19 : DosError:=150;
+ 21 : DosError:=152;
+ end;
+ end
+ else
+ doserror:=0;
+end;
+
+
+procedure intr(intno : byte;var regs : registers);
+begin
+ realintr(intno,regs);
+end;
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+function dosversion : word;
+begin
+ dosregs.ax:=$3000;
+ msdos(dosregs);
+ dosversion:=dosregs.ax;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+begin
+ dosregs.ax:=$2a00;
+ msdos(dosregs);
+ wday:=dosregs.al;
+ year:=dosregs.cx;
+ month:=dosregs.dh;
+ mday:=dosregs.dl;
+end;
+
+
+procedure setdate(year,month,day : word);
+begin
+ dosregs.cx:=year;
+ dosregs.dh:=month;
+ dosregs.dl:=day;
+ dosregs.ah:=$2b;
+ msdos(dosregs);
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+begin
+ dosregs.ah:=$2c;
+ msdos(dosregs);
+ hour:=dosregs.ch;
+ minute:=dosregs.cl;
+ second:=dosregs.dh;
+ sec100:=dosregs.dl;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+begin
+ dosregs.ch:=hour;
+ dosregs.cl:=minute;
+ dosregs.dh:=second;
+ dosregs.dl:=sec100;
+ dosregs.ah:=$2d;
+ msdos(dosregs);
+end;
+
+function GetMsCount: int64;
+begin
+ GetMsCount := MemL [$40:$6c] * 55;
+end;
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+procedure exec(const path : pathstr;const comline : comstr);
+type
+ realptr = packed record
+ ofs,seg : word;
+ end;
+ texecblock = packed record
+ envseg : word;
+ comtail : realptr;
+ firstFCB : realptr;
+ secondFCB : realptr;
+ iniStack : realptr;
+ iniCSIP : realptr;
+ end;
+var
+ current_dos_buffer_pos,
+ arg_ofs,
+ i,la_env,
+ la_p,la_c,la_e,
+ fcb1_la,fcb2_la : longint;
+ execblock : texecblock;
+ c,p : string;
+
+ function paste_to_dos(src : string) : boolean;
+ var
+ c : array[0..255] of char;
+ begin
+ paste_to_dos:=false;
+ if current_dos_buffer_pos+length(src)+1>tb+tb_size then
+ RunError(217);
+ move(src[1],c[0],length(src));
+ c[length(src)]:=#0;
+ seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
+ current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
+ paste_to_dos:=true;
+ end;
+
+begin
+{ create command line }
+ move(comline[0],c[1],length(comline)+1);
+ c[length(comline)+2]:=#13;
+ c[0]:=char(length(comline)+2);
+{ create path }
+ p:=path;
+ for i:=1 to length(p) do
+ if p[i]='/' then
+ p[i]:='\';
+ if LFNSupport then
+ GetShortName(p);
+{ create buffer }
+ la_env:=tb;
+ while (la_env and 15)<>0 do
+ inc(la_env);
+ current_dos_buffer_pos:=la_env;
+{ copy environment }
+ for i:=1 to envcount do
+ paste_to_dos(envstr(i));
+ paste_to_dos(''); { adds a double zero at the end }
+{ allow slash as backslash }
+ la_p:=current_dos_buffer_pos;
+ paste_to_dos(p);
+ la_c:=current_dos_buffer_pos;
+ paste_to_dos(c);
+ la_e:=current_dos_buffer_pos;
+ fcb1_la:=la_e;
+ la_e:=la_e+16;
+ fcb2_la:=la_e;
+ la_e:=la_e+16;
+{ allocate FCB see dosexec code }
+ arg_ofs:=1;
+ while (c[arg_ofs] in [' ',#9]) do
+ inc(arg_ofs);
+ dosregs.ax:=$2901;
+ dosregs.ds:=(la_c+arg_ofs) shr 4;
+ dosregs.esi:=(la_c+arg_ofs) and 15;
+ dosregs.es:=fcb1_la shr 4;
+ dosregs.edi:=fcb1_la and 15;
+ msdos(dosregs);
+{ allocate second FCB see dosexec code }
+ repeat
+ inc(arg_ofs);
+ until (c[arg_ofs] in [' ',#9,#13]);
+ if c[arg_ofs]<>#13 then
+ begin
+ repeat
+ inc(arg_ofs);
+ until not (c[arg_ofs] in [' ',#9]);
+ end;
+ dosregs.ax:=$2901;
+ dosregs.ds:=(la_c+arg_ofs) shr 4;
+ dosregs.si:=(la_c+arg_ofs) and 15;
+ dosregs.es:=fcb2_la shr 4;
+ dosregs.di:=fcb2_la and 15;
+ msdos(dosregs);
+ with execblock do
+ begin
+ envseg:=la_env shr 4;
+ comtail.seg:=la_c shr 4;
+ comtail.ofs:=la_c and 15;
+ firstFCB.seg:=fcb1_la shr 4;
+ firstFCB.ofs:=fcb1_la and 15;
+ secondFCB.seg:=fcb2_la shr 4;
+ secondFCB.ofs:=fcb2_la and 15;
+ end;
+ seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
+ dosregs.edx:=la_p and 15;
+ dosregs.ds:=la_p shr 4;
+ dosregs.ebx:=la_e and 15;
+ dosregs.es:=la_e shr 4;
+ dosregs.ax:=$4b00;
+ msdos(dosregs);
+ LoadDosError;
+ if DosError=0 then
+ begin
+ dosregs.ax:=$4d00;
+ msdos(dosregs);
+ LastDosExitCode:=DosRegs.al
+ end
+ else
+ LastDosExitCode:=0;
+end;
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+ dosregs.ax:=$3300;
+ msdos(dosregs);
+ breakvalue:=dosregs.dl<>0;
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+ dosregs.ax:=$3301;
+ dosregs.dl:=ord(breakvalue);
+ msdos(dosregs);
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+ dosregs.ah:=$54;
+ msdos(dosregs);
+ verify:=dosregs.al<>0;
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+ dosregs.ah:=$2e;
+ dosregs.al:=ord(verify);
+ msdos(dosregs);
+end;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+
+TYPE ExtendedFat32FreeSpaceRec=packed Record
+ RetSize : WORD; { (ret) size of returned structure}
+ Strucversion : WORD; {(call) structure version (0000h)
+ (ret) actual structure version (0000h)}
+ SecPerClus, {number of sectors per cluster}
+ BytePerSec, {number of bytes per sector}
+ AvailClusters, {number of available clusters}
+ TotalClusters, {total number of clusters on the drive}
+ AvailPhysSect, {physical sectors available on the drive}
+ TotalPhysSect, {total physical sectors on the drive}
+ AvailAllocUnits, {Available allocation units}
+ TotalAllocUnits : DWORD; {Total allocation units}
+ Dummy,Dummy2 : DWORD; {8 bytes reserved}
+ END;
+
+function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
+VAR
+ S : String;
+ Rec : ExtendedFat32FreeSpaceRec;
+BEGIN
+ if (swap(dosversion)>=$070A) AND LFNSupport then
+ begin
+ S:='C:\'#0;
+ if Drive=0 then
+ begin
+ GetDir(Drive,S);
+ Setlength(S,4);
+ S[4]:=#0;
+ end
+ else
+ S[1]:=chr(Drive+64);
+ Rec.Strucversion:=0;
+ dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
+ dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
+ dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
+ dosregs.ds:=tb_segment;
+ dosregs.di:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
+ dosregs.ax:=$7303;
+ msdos(dosregs);
+ if (dosregs.flags and fcarry) = 0 then {No error clausule in int except cf}
+ begin
+ copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
+ if Free then
+ Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
+ else
+ Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
+ end
+ else
+ Do_DiskData:=-1;
+ end
+ else
+ begin
+ dosregs.dl:=drive;
+ dosregs.ah:=$36;
+ msdos(dosregs);
+ if dosregs.ax<>$FFFF then
+ begin
+ if Free then
+ Do_DiskData:=int64(dosregs.ax)*dosregs.bx*dosregs.cx
+ else
+ Do_DiskData:=int64(dosregs.ax)*dosregs.cx*dosregs.dx;
+ end
+ else
+ do_diskdata:=-1;
+ end;
+end;
+
+function diskfree(drive : byte) : int64;
+begin
+ diskfree:=Do_DiskData(drive,TRUE);
+end;
+
+
+function disksize(drive : byte) : int64;
+begin
+ disksize:=Do_DiskData(drive,false);
+end;
+
+
+{******************************************************************************
+ --- LFNFindfirst LFNFindNext ---
+******************************************************************************}
+
+type
+ LFNSearchRec=packed record
+ attr,
+ crtime,
+ crtimehi,
+ actime,
+ actimehi,
+ lmtime,
+ lmtimehi,
+ sizehi,
+ size : longint;
+ reserved : array[0..7] of byte;
+ name : array[0..259] of byte;
+ shortname : array[0..13] of byte;
+ end;
+
+procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec;from_findfirst : boolean);
+var
+ Len : longint;
+begin
+ With w do
+ begin
+ FillChar(d,sizeof(SearchRec),0);
+ if DosError=0 then
+ len:=StrLen(@Name)
+ else
+ len:=0;
+ d.Name[0]:=chr(len);
+ Move(Name[0],d.Name[1],Len);
+ d.Time:=lmTime;
+ d.Size:=Size;
+ d.Attr:=Attr and $FF;
+ if (DosError<>0) and from_findfirst then
+ hdl:=-1;
+ Move(hdl,d.Fill,4);
+ end;
+end;
+
+
+procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
+var
+ i : longint;
+ w : LFNSearchRec;
+begin
+ { allow slash as backslash }
+ for i:=0 to strlen(path) do
+ if path[i]='/' then path[i]:='\';
+ dosregs.si:=1; { use ms-dos time }
+ { don't include the label if not asked for it, needed for network drives }
+ if attr=$8 then
+ dosregs.ecx:=8
+ else
+ dosregs.ecx:=attr and (not 8);
+ dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
+ dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
+ dosregs.ds:=tb_segment;
+ dosregs.edi:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.ax:=$714e;
+ msdos(dosregs);
+ LoadDosError;
+ copyfromdos(w,sizeof(LFNSearchRec));
+ LFNSearchRec2Dos(w,dosregs.ax,s,true);
+end;
+
+
+procedure LFNFindNext(var s:searchrec);
+var
+ hdl : longint;
+ w : LFNSearchRec;
+begin
+ Move(s.Fill,hdl,4);
+ dosregs.si:=1; { use ms-dos time }
+ dosregs.edi:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.ebx:=hdl;
+ dosregs.ax:=$714f;
+ msdos(dosregs);
+ LoadDosError;
+ copyfromdos(w,sizeof(LFNSearchRec));
+ LFNSearchRec2Dos(w,hdl,s,false);
+end;
+
+
+procedure LFNFindClose(var s:searchrec);
+var
+ hdl : longint;
+begin
+ Move(s.Fill,hdl,4);
+ { Do not call MsDos if FindFirst returned with an error }
+ if hdl=-1 then
+ begin
+ DosError:=0;
+ exit;
+ end;
+ dosregs.ebx:=hdl;
+ dosregs.ax:=$71a1;
+ msdos(dosregs);
+ LoadDosError;
+end;
+
+
+{******************************************************************************
+ --- DosFindfirst DosFindNext ---
+******************************************************************************}
+
+procedure dossearchrec2searchrec(var f : searchrec);
+var
+ len : longint;
+begin
+ { Check is necessary!! OS/2's VDM doesn't clear the name with #0 if the }
+ { file doesn't exist! (JM) }
+ if dosError = 0 then
+ len:=StrLen(@f.Name)
+ else len := 0;
+ Move(f.Name[0],f.Name[1],Len);
+ f.Name[0]:=chr(len);
+end;
+
+
+procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
+var
+ i : longint;
+begin
+ { allow slash as backslash }
+ for i:=0 to strlen(path) do
+ if path[i]='/' then path[i]:='\';
+ copytodos(f,sizeof(searchrec));
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ dosregs.ah:=$1a;
+ msdos(dosregs);
+ dosregs.ecx:=attr;
+ dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
+ dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
+ dosregs.ds:=tb_segment;
+ dosregs.ah:=$4e;
+ msdos(dosregs);
+ copyfromdos(f,sizeof(searchrec));
+ LoadDosError;
+ dossearchrec2searchrec(f);
+end;
+
+
+procedure Dosfindnext(var f : searchrec);
+begin
+ copytodos(f,sizeof(searchrec));
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ dosregs.ah:=$1a;
+ msdos(dosregs);
+ dosregs.ah:=$4f;
+ msdos(dosregs);
+ copyfromdos(f,sizeof(searchrec));
+ LoadDosError;
+ dossearchrec2searchrec(f);
+end;
+
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+ path0 : array[0..256] of char;
+begin
+ doserror:=0;
+ strpcopy(path0,path);
+ if LFNSupport then
+ LFNFindFirst(path0,attr,f)
+ else
+ Dosfindfirst(path0,attr,f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+ doserror:=0;
+ if LFNSupport then
+ LFNFindnext(f)
+ else
+ Dosfindnext(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+ DosError:=0;
+ if LFNSupport then
+ LFNFindClose(f);
+end;
+
+
+//type swap_proc = procedure;
+
+//var
+// _swap_in : swap_proc;external name '_swap_in';
+// _swap_out : swap_proc;external name '_swap_out';
+// _exception_exit : pointer;external name '_exception_exit';
+// _v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
+
+(*
+procedure swapvectors;
+begin
+ if _exception_exit<>nil then
+ if _v2prt0_exceptions_on then
+ _swap_out()
+ else
+ _swap_in();
+end;
+*)
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+ i,p1 : longint;
+ s : searchrec;
+ newdir : pathstr;
+begin
+{ check if the file specified exists }
+ findfirst(path,anyfile,s);
+ if doserror=0 then
+ begin
+ findclose(s);
+ fsearch:=path;
+ exit;
+ end;
+{ No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow slash as backslash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='/' then dirlist[i]:='\';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+ newdir:=newdir+'\';
+ findfirst(newdir+path,anyfile,s);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
+ end;
+ findclose(s);
+end;
+
+
+{ change to short filename if successful DOS call PM }
+function GetShortName(var p : String) : boolean;
+var
+ c : array[0..255] of char;
+begin
+ move(p[1],c[0],length(p));
+ c[length(p)]:=#0;
+ copytodos(c,length(p)+1);
+ dosregs.ax:=$7160;
+ dosregs.cx:=1;
+ dosregs.ds:=tb_segment;
+ dosregs.si:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.di:=tb_offset;
+ msdos(dosregs);
+ LoadDosError;
+ if DosError=0 then
+ begin
+ copyfromdos(c,255);
+ move(c[0],p[1],strlen(c));
+ p[0]:=char(strlen(c));
+ GetShortName:=true;
+ end
+ else
+ GetShortName:=false;
+end;
+
+
+{ change to long filename if successful DOS call PM }
+function GetLongName(var p : String) : boolean;
+var
+ c : array[0..255] of char;
+begin
+ move(p[1],c[0],length(p));
+ c[length(p)]:=#0;
+ copytodos(c,length(p)+1);
+ dosregs.ax:=$7160;
+ dosregs.cx:=2;
+ dosregs.ds:=tb_segment;
+ dosregs.si:=tb_offset;
+ dosregs.es:=tb_segment;
+ dosregs.di:=tb_offset;
+ msdos(dosregs);
+ LoadDosError;
+ if DosError=0 then
+ begin
+ copyfromdos(c,255);
+ move(c[0],p[1],strlen(c));
+ p[0]:=char(strlen(c));
+ GetLongName:=true;
+ end
+ else
+ GetLongName:=false;
+end;
+
+
+{******************************************************************************
+ --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+begin
+ dosregs.bx:=textrec(f).handle;
+ dosregs.ax:=$5700;
+ msdos(dosregs);
+ loaddoserror;
+ time:=(dosregs.dx shl 16)+dosregs.cx;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+ dosregs.bx:=textrec(f).handle;
+ dosregs.cx:=time and $ffff;
+ dosregs.dx:=time shr 16;
+ dosregs.ax:=$5701;
+ msdos(dosregs);
+ loaddoserror;
+end;
+
+
+procedure getfattr(var f;var attr : word);
+begin
+ copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ if LFNSupport then
+ begin
+ dosregs.ax:=$7143;
+ dosregs.bx:=0;
+ end
+ else
+ dosregs.ax:=$4300;
+ msdos(dosregs);
+ LoadDosError;
+ Attr:=dosregs.cx;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+ copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+ dosregs.edx:=tb_offset;
+ dosregs.ds:=tb_segment;
+ if LFNSupport then
+ begin
+ dosregs.ax:=$7143;
+ dosregs.bx:=1;
+ end
+ else
+ dosregs.ax:=$4301;
+ dosregs.cx:=attr;
+ msdos(dosregs);
+ LoadDosError;
+end;
+
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+function envcount : longint;
+var
+ hp : ppchar;
+begin
+ hp:=envp;
+ envcount:=0;
+ while assigned(hp^) do
+ begin
+ inc(envcount);
+ inc(hp);
+ end;
+end;
+
+
+function EnvStr (Index: longint): string;
+begin
+ if (index<=0) or (index>envcount) then
+ begin
+ envstr:='';
+ exit;
+ end;
+ envstr:=strpas(ppchar(pointer(envp)+4*(index-1))^);
+end;
+
+
+Function GetEnv(envvar: string): string;
+var
+ hp : ppchar;
+ hs : string;
+ eqpos : longint;
+begin
+ envvar:=upcase(envvar);
+ hp:=envp;
+ getenv:='';
+ while assigned(hp^) do
+ begin
+ hs:=strpas(hp^);
+ eqpos:=pos('=',hs);
+ if upcase(copy(hs,1,eqpos-1))=envvar then
+ begin
+ getenv:=copy(hs,eqpos+1,255);
+ exit;
+ end;
+ inc(hp);
+ end;
+end;
+
+
+end.
+
+{
+ $Log: dos.pp,v $
+ Revision 1.10 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/watcom/prt0.asm b/rtl/watcom/prt0.asm
new file mode 100644
index 0000000000..d0f69d54c1
--- /dev/null
+++ b/rtl/watcom/prt0.asm
@@ -0,0 +1,71 @@
+.387
+.386p
+
+ name prt0
+ assume nothing
+ extrn PASCALMAIN : near
+ extrn HEAPSIZE : dword
+ public start
+ public ___exit
+ public ___sbrk
+ public HEAP
+ public PSP_SELECTOR
+ public ENV_SELECTOR
+ public ENV_SIZE
+
+.STACK 1000h
+.CODE
+
+start proc near
+ jmp short main
+ db "WATCOM"
+ main:
+ mov ax,es ; psp selector in es
+ mov PSP_SELECTOR,ax
+ mov gs,ax
+ mov bx,[gs:2Ch] ; environment sel. at psp_sel:2C
+ mov ENV_SELECTOR,bx
+ lsl ecx,bx ; get selector limit
+ mov ENV_SIZE,ecx
+ push ds
+ pop es
+ push ds
+ pop fs
+ mov eax,HEAPSIZE
+ push eax
+ call ___sbrk ; allocate heap
+ mov HEAP,eax
+ pop eax
+ call PASCALMAIN
+start endp
+
+___exit proc near
+ pop eax
+ mov ah,4Ch
+ int 21h
+___exit endp
+
+___sbrk proc near
+ mov ebx,dword ptr [esp+4]
+ mov ecx,ebx
+ shr ebx,16
+ mov ax,501h
+ int 31h
+ jnc sbrk_ok
+ xor eax,eax
+ ret
+ sbrk_ok:
+ shl ebx,16
+ mov bx,cx
+ mov eax,ebx
+ ret
+___sbrk endp
+
+.DATA
+ HEAP dd 0
+ PSP_SELECTOR dw 0
+ ENV_SELECTOR dw 0
+ ENV_SIZE dd 0
+
+
+end start
diff --git a/rtl/watcom/system.pp b/rtl/watcom/system.pp
new file mode 100644
index 0000000000..783738a4a4
--- /dev/null
+++ b/rtl/watcom/system.pp
@@ -0,0 +1,1556 @@
+{
+ $Id: system.pp,v 1.22 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Watcom
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit system;
+
+INTERFACE
+
+{$ifndef NO_EXCEPTIONS_IN_SYSTEM}
+{$define EXCEPTIONS_IN_SYSTEM}
+{$endif NO_EXCEPTIONS_IN_SYSTEM}
+
+{ include system-independent routine headers }
+
+{$include systemh.inc}
+
+{ include heap support headers }
+
+
+{$include heaph.inc}
+
+{Platform specific information}
+type
+ THandle = Longint;
+ TThreadID = THandle;
+
+const
+ LineEnding = #13#10;
+{ LFNSupport is a variable here, defined below!!! }
+ DirectorySeparator = '\';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 255;
+
+const
+{ Default filehandles }
+ UnusedHandle = -1;
+ StdInputHandle = 0;
+ StdOutputHandle = 1;
+ StdErrorHandle = 2;
+
+ FileNameCaseSensitive : boolean = false;
+ CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+{ Default memory segments (Tp7 compatibility) }
+ seg0040 = $0040;
+ segA000 = $A000;
+ segB000 = $B000;
+ segB800 = $B800;
+
+var
+{ Mem[] support }
+ mem : array[0..$7fffffff] of byte absolute $0:$0;
+ memw : array[0..$7fffffff div sizeof(word)] of word absolute $0:$0;
+ meml : array[0..$7fffffff div sizeof(longint)] of longint absolute $0:$0;
+{ C-compatible arguments and environment }
+ argc : longint;
+ argv : ppchar;
+ envp : ppchar;
+ dos_argv0 : pchar;
+
+{$ifndef RTLLITE}
+{ System info }
+ LFNSupport : boolean;
+{$ELSE RTLLITE}
+Const
+ LFNSupport = false;
+{$endif RTLLITE}
+
+{
+ necessary for objects.pas, should be removed (at least from the interface
+ to the implementation)
+}
+ type
+ trealregs=record
+ realedi,realesi,realebp,realres,
+ realebx,realedx,realecx,realeax : longint;
+ realflags,
+ reales,realds,realfs,realgs,
+ realip,realcs,realsp,realss : word;
+ end;
+ function do_write(h:longint;addr:pointer;len : longint) : longint;
+ function do_read(h:longint;addr:pointer;len : longint) : longint;
+ procedure syscopyfromdos(addr : sizeuint; len : longint);
+ procedure syscopytodos(addr : sizeuint; len : longint);
+ procedure sysrealintr(intnr : word;var regs : trealregs);
+
+ var tb:longint;
+ tb_segment:word;
+
+ const tb_offset=0;
+ tb_size=8192;
+
+IMPLEMENTATION
+
+{ include system independent routines }
+
+{$include system.inc}
+
+
+const
+ carryflag = 1;
+
+type
+ tseginfo=packed record
+ offset : pointer;
+ segment : word;
+ end;
+
+var
+ old_int00 : tseginfo;cvar;
+ old_int75 : tseginfo;cvar;
+
+{$asmmode ATT}
+
+{*****************************************************************************
+ Watcom Helpers
+*****************************************************************************}
+
+function far_strlen(selector : word;linear_address : sizeuint) : longint;assembler;
+asm
+ movl linear_address,%edx
+ movl %edx,%ecx
+ movw selector,%gs
+.Larg19:
+ movb %gs:(%edx),%al
+ testb %al,%al
+ je .Larg20
+ incl %edx
+ jmp .Larg19
+.Larg20:
+ movl %edx,%eax
+ subl %ecx,%eax
+end;
+
+
+function get_ds : word;assembler;
+asm
+ movw %ds,%ax
+end;
+
+
+function get_cs : word;assembler;
+asm
+ movw %cs,%ax
+end;
+
+function dos_selector : word; assembler;
+asm
+ movw %ds,%ax { no separate selector needed }
+end;
+
+procedure alloc_tb; assembler;
+{ allocate 8kB real mode transfer buffer }
+asm
+ pushl %ebx
+ movw $0x100,%ax
+ movw $512,%bx
+ int $0x31
+ movw %ax,tb_segment
+ shll $16,%eax
+ shrl $12,%eax
+ movl %eax,tb
+ popl %ebx
+end;
+
+procedure sysseg_move(sseg : word;source : sizeuint;dseg : word;dest : sizeuint;count : longint);
+begin
+ if count=0 then
+ exit;
+ if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
+ asm
+ pushl %esi
+ pushl %edi
+ pushw %es
+ pushw %ds
+ cld
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ movl %ecx,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+ movl %eax,%ecx
+ andl $3,%ecx
+ rep
+ movsb
+ popw %ds
+ popw %es
+ popl %edi
+ popl %esi
+ end
+ else if (source<dest) then
+ { copy backward for overlapping }
+ asm
+ pushl %esi
+ pushl %edi
+ pushw %es
+ pushw %ds
+ std
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ addl %ecx,%esi
+ addl %ecx,%edi
+ movl %ecx,%eax
+ andl $3,%ecx
+ orl %ecx,%ecx
+ jz .LSEG_MOVE1
+
+ { calculate esi and edi}
+ decl %esi
+ decl %edi
+ rep
+ movsb
+ incl %esi
+ incl %edi
+ .LSEG_MOVE1:
+ subl $4,%esi
+ subl $4,%edi
+ movl %eax,%ecx
+ shrl $2,%ecx
+ rep
+ movsl
+ cld
+ popw %ds
+ popw %es
+ popl %edi
+ popl %esi
+ end;
+end;
+
+var psp_selector:word; external name 'PSP_SELECTOR';
+
+procedure setup_arguments;
+type
+ arrayword = array [0..255] of word;
+var
+ proxy_s : string[50];
+ proxy_argc,proxy_seg,proxy_ofs,lin : longint;
+ rm_argv : ^arrayword;
+ argv0len : longint;
+ useproxy : boolean;
+ hp : ppchar;
+ doscmd : string[129]; { Dos commandline copied from PSP, max is 128 chars +1 for terminating zero }
+ arglen,
+ count : longint;
+ argstart,
+ pc,arg : pchar;
+ quote : char;
+ argvlen : longint;
+
+ function atohex(s : pchar) : longint;
+ var
+ rv : longint;
+ v : byte;
+ begin
+ rv:=0;
+ while (s^<>#0) do
+ begin
+ v:=byte(s^)-byte('0');
+ if (v > 9) then
+ dec(v,7);
+ v:=v and 15; { in case it's lower case }
+ rv:=(rv shl 4) or v;
+ inc(longint(s));
+ end;
+ atohex:=rv;
+ end;
+
+ procedure allocarg(idx,len:longint);
+ var oldargvlen:longint;
+ begin
+ if idx>=argvlen then
+ begin
+ oldargvlen:=argvlen;
+ argvlen:=(idx+8) and (not 7);
+ sysreallocmem(argv,argvlen*sizeof(pointer));
+ fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
+ argv[idx]:=nil;
+ end;
+ { use realloc to reuse already existing memory }
+ if len<>0 then
+ sysreallocmem(argv[idx],len+1);
+ end;
+
+begin
+ count:=0;
+ argc:=1;
+ argv:=nil;
+ argvlen:=0;
+ { load commandline from psp }
+ sysseg_move(psp_selector, 128, get_ds, longint(@doscmd), 128);
+ doscmd[length(doscmd)+1]:=#0;
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'Dos command line is #',doscmd,'# size = ',length(doscmd));
+{$EndIf }
+ { create argv[0] }
+ argv0len:=strlen(dos_argv0);
+ allocarg(count,argv0len);
+ move(dos_argv0^,argv[count]^,argv0len);
+ inc(count);
+ { setup cmdline variable }
+ cmdline:=Getmem(argv0len+length(doscmd)+2);
+ move(dos_argv0^,cmdline^,argv0len);
+ cmdline[argv0len]:=' ';
+ inc(argv0len);
+ move(doscmd[1],cmdline[argv0len],length(doscmd));
+ cmdline[argv0len+length(doscmd)+1]:=#0;
+ { parse dos commandline }
+ pc:=@doscmd[1];
+ while pc^<>#0 do
+ begin
+ { skip leading spaces }
+ while pc^ in [#1..#32] do
+ inc(pc);
+ if pc^=#0 then
+ break;
+ { calc argument length }
+ quote:=' ';
+ argstart:=pc;
+ arglen:=0;
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ inc(arglen)
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ else
+ inc(arglen);
+ end;
+ inc(pc);
+ end;
+ { copy argument }
+ allocarg(count,arglen);
+ quote:=' ';
+ pc:=argstart;
+ arg:=argv[count];
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ inc(pc);
+ end;
+ arg^:=#0;
+ {$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
+ {$EndIf SYSTEM_DEBUG_STARTUP}
+ inc(count);
+ end;
+ argc:=count;
+ { check for !proxy for long commandlines passed using environment }
+ hp:=envp;
+ useproxy:=false;
+ while assigned(hp^) do
+ begin
+ if (hp^[0]=' ') then
+ begin
+ proxy_s:=strpas(hp^);
+ if Copy(proxy_s,1,7)=' !proxy' then
+ begin
+ proxy_s[13]:=#0;
+ proxy_s[18]:=#0;
+ proxy_s[23]:=#0;
+ argv[2]:=@proxy_s[9];
+ argv[3]:=@proxy_s[14];
+ argv[4]:=@proxy_s[19];
+ useproxy:=true;
+ break;
+ end;
+ end;
+ inc(hp);
+ end;
+ { check for !proxy for long commandlines passed using commandline }
+ if (not useproxy) and
+ (argc > 1) and (far_strlen(get_ds,longint(argv[1])) = 6) then
+ begin
+ move(argv[1]^,proxy_s[1],6);
+ proxy_s[0] := #6;
+ if (proxy_s = '!proxy') then
+ useproxy:=true;
+ end;
+ { use proxy when found }
+ if useproxy then
+ begin
+ proxy_argc:=atohex(argv[2]);
+ proxy_seg:=atohex(argv[3]);
+ proxy_ofs:=atohex(argv[4]);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'proxy command line found');
+ writeln(stderr,'argc: ',proxy_argc,' seg: ',proxy_seg,' ofs: ',proxy_ofs);
+{$EndIf SYSTEM_DEBUG_STARTUP}
+ rm_argv:=SysGetmem(proxy_argc*sizeof(word));
+ sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
+ for count:=0 to proxy_argc - 1 do
+ begin
+ lin:=proxy_seg*16+rm_argv^[count];
+ arglen:=far_strlen(dos_selector,lin);
+ allocarg(count,arglen);
+ sysseg_move(dos_selector,lin,get_ds,longint(argv[count]),arglen+1);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'arg ',count,' #',rm_argv^[count],'#',arglen,'#',argv[count],'#');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+ end;
+ SysFreemem(rm_argv);
+ argc:=proxy_argc;
+ end;
+ { create an nil entry }
+ allocarg(argc,0);
+ { free unused memory }
+ sysreallocmem(argv,(argc+1)*sizeof(pointer));
+end;
+
+function strcopy(dest,source : pchar) : pchar;assembler;
+var
+ saveeax,saveesi,saveedi : longint;
+asm
+ movl %edi,saveedi
+ movl %esi,saveesi
+{$ifdef REGCALL}
+ movl %eax,saveeax
+ movl %edx,%edi
+{$else}
+ movl source,%edi
+{$endif}
+ testl %edi,%edi
+ jz .LStrCopyDone
+ leal 3(%edi),%ecx
+ andl $-4,%ecx
+ movl %edi,%esi
+ subl %edi,%ecx
+{$ifdef REGCALL}
+ movl %eax,%edi
+{$else}
+ movl dest,%edi
+{$endif}
+ jz .LStrCopyAligned
+.LStrCopyAlignLoop:
+ movb (%esi),%al
+ incl %edi
+ incl %esi
+ testb %al,%al
+ movb %al,-1(%edi)
+ jz .LStrCopyDone
+ decl %ecx
+ jnz .LStrCopyAlignLoop
+ .balign 16
+.LStrCopyAligned:
+ movl (%esi),%eax
+ movl %eax,%edx
+ leal 0x0fefefeff(%eax),%ecx
+ notl %edx
+ addl $4,%esi
+ andl %edx,%ecx
+ andl $0x080808080,%ecx
+ jnz .LStrCopyEndFound
+ movl %eax,(%edi)
+ addl $4,%edi
+ jmp .LStrCopyAligned
+.LStrCopyEndFound:
+ testl $0x0ff,%eax
+ jz .LStrCopyByte
+ testl $0x0ff00,%eax
+ jz .LStrCopyWord
+ testl $0x0ff0000,%eax
+ jz .LStrCopy3Bytes
+ movl %eax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopy3Bytes:
+ xorb %dl,%dl
+ movw %ax,(%edi)
+ movb %dl,2(%edi)
+ jmp .LStrCopyDone
+.LStrCopyWord:
+ movw %ax,(%edi)
+ jmp .LStrCopyDone
+.LStrCopyByte:
+ movb %al,(%edi)
+.LStrCopyDone:
+{$ifdef REGCALL}
+ movl saveeax,%eax
+{$else}
+ movl dest,%eax
+{$endif}
+ movl saveedi,%edi
+ movl saveesi,%esi
+end;
+
+
+var
+ env_selector:word; external name 'ENV_SELECTOR';
+ env_size:longint; external name 'ENV_SIZE';
+
+procedure setup_environment;
+var env_count : longint;
+ dos_env,cp : pchar;
+begin
+ env_count:=0;
+ dos_env:=getmem(env_size);
+ sysseg_move(env_selector,$0, get_ds, longint(dos_env), env_size);
+ cp:=dos_env;
+ while cp ^ <> #0 do
+ begin
+ inc(env_count);
+ while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
+ inc(longint(cp)); { skip to next character }
+ end;
+ envp := sysgetmem((env_count+1) * sizeof(pchar));
+ if (envp = nil) then exit;
+ cp:=dos_env;
+ env_count:=0;
+ while cp^ <> #0 do
+ begin
+ envp[env_count] := sysgetmem(strlen(cp)+1);
+ strcopy(envp[env_count], cp);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+ inc(env_count);
+ while (cp^ <> #0) do
+ inc(longint(cp)); { skip to NUL }
+ inc(longint(cp)); { skip to next character }
+ end;
+ envp[env_count]:=nil;
+ longint(cp):=longint(cp)+3;
+ dos_argv0 := sysgetmem(strlen(cp)+1);
+ if (dos_argv0 = nil) then halt;
+ strcopy(dos_argv0, cp);
+end;
+
+
+procedure syscopytodos(addr : sizeuint; len : longint);
+begin
+ if len > tb_size then
+ HandleError(217);
+ sysseg_move(get_ds,addr,dos_selector,tb,len);
+end;
+
+
+procedure syscopyfromdos(addr : sizeuint; len : longint);
+begin
+ if len > tb_size then
+ HandleError(217);
+ sysseg_move(dos_selector,tb,get_ds,addr,len);
+end;
+
+
+procedure sysrealintr(intnr : word;var regs : trealregs);
+begin
+ regs.realsp:=0;
+ regs.realss:=0;
+ asm
+ pushl %edi
+ pushl %ebx
+ pushw %fs
+ movw intnr,%bx
+ xorl %ecx,%ecx
+ movl regs,%edi
+ movw $0x300,%ax
+ int $0x31
+ popw %fs
+ popl %ebx
+ popl %edi
+ end;
+end;
+
+
+procedure set_pm_interrupt(vector : byte;const intaddr : tseginfo);
+begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x205,%eax
+ movb vector,%bl
+ int $0x31
+ popl %ebx
+ end;
+end;
+
+
+procedure get_pm_interrupt(vector : byte;var intaddr : tseginfo);
+begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x204,%eax
+ int $0x31
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+end;
+
+
+procedure getinoutres(def : word);
+var
+ regs : trealregs;
+begin
+ regs.realeax:=$5900;
+ regs.realebx:=$0;
+ sysrealintr($21,regs);
+ InOutRes:=lo(regs.realeax);
+ case InOutRes of
+ 19 : InOutRes:=150;
+ 21 : InOutRes:=152;
+ 32 : InOutRes:=5;
+ end;
+ if InOutRes=0 then
+ InOutRes:=Def;
+end;
+
+
+ { Keep Track of open files }
+ const
+ max_files = 50;
+ var
+ openfiles : array [0..max_files-1] of boolean;
+{$ifdef SYSTEMDEBUG}
+ opennames : array [0..max_files-1] of pchar;
+ const
+ free_closed_names : boolean = true;
+{$endif SYSTEMDEBUG}
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+procedure ___exit(exitcode:longint);cdecl;external name '___exit';
+
+procedure do_close(handle : longint);forward;
+
+Procedure system_exit;
+var
+ h : byte;
+begin
+ for h:=0 to max_files-1 do
+ if openfiles[h] then
+ begin
+{$ifdef SYSTEMDEBUG}
+ writeln(stderr,'file ',opennames[h],' not closed at exit');
+{$endif SYSTEMDEBUG}
+ if h>=5 then
+ do_close(h);
+ end;
+ { halt is not allways called !! }
+ { not on normal exit !! PM }
+ set_pm_interrupt($00,old_int00);
+{$ifndef EXCEPTIONS_IN_SYSTEM}
+ set_pm_interrupt($75,old_int75);
+{$endif EXCEPTIONS_IN_SYSTEM}
+ ___exit(exitcode);
+end;
+
+
+procedure new_int00;
+begin
+ HandleError(200);
+end;
+
+
+{$ifndef EXCEPTIONS_IN_SYSTEM}
+procedure new_int75;
+begin
+ asm
+ xorl %eax,%eax
+ outb %al,$0x0f0
+ movb $0x20,%al
+ outb %al,$0x0a0
+ outb %al,$0x020
+ end;
+ HandleError(200);
+end;
+{$endif EXCEPTIONS_IN_SYSTEM}
+
+
+var
+ __stkbottom : pointer;//###########external name '__stkbottom';
+
+
+
+{*****************************************************************************
+ ParamStr/Randomize
+*****************************************************************************}
+
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+end;
+
+
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l+1<=argc) then
+ paramstr:=strpas(argv[l])
+ else
+ paramstr:='';
+end;
+
+
+procedure randomize;
+var
+ hl : longint;
+ regs : trealregs;
+begin
+ regs.realeax:=$2c00;
+ sysrealintr($21,regs);
+ hl:=lo(regs.realedx);
+ randseed:=hl*$10000+ lo(regs.realecx);
+end;
+
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+function ___sbrk(size:longint):pointer;cdecl; external name '___sbrk';
+
+function SysOSAlloc(size: ptrint): pointer;assembler;
+asm
+{$ifdef SYSTEMDEBUG}
+ cmpb $1,accept_sbrk
+ je .Lsbrk
+ movl $0,%eax
+ jmp .Lsbrk_fail
+ .Lsbrk:
+{$endif}
+ movl size,%eax
+ pushl %eax
+ call ___sbrk
+ addl $4,%esp
+{$ifdef SYSTEMDEBUG}
+ .Lsbrk_fail:
+{$endif}
+end;
+
+{ define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+end;
+
+{ include standard heap management }
+{$include heap.inc}
+
+
+{****************************************************************************
+ Low level File Routines
+ ****************************************************************************}
+
+procedure AllowSlash(p:pchar);
+var
+ i : longint;
+begin
+{ allow slash as backslash }
+ for i:=0 to strlen(p) do
+ if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close(handle : longint);
+var
+ regs : trealregs;
+begin
+ if Handle<=4 then
+ exit;
+ regs.realebx:=handle;
+ if handle<max_files then
+ begin
+ openfiles[handle]:=false;
+{$ifdef SYSTEMDEBUG}
+ if assigned(opennames[handle]) and free_closed_names then
+ begin
+ sysfreememsize(opennames[handle],strlen(opennames[handle])+1);
+ opennames[handle]:=nil;
+ end;
+{$endif SYSTEMDEBUG}
+ end;
+ regs.realeax:=$3e00;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+procedure do_erase(p : pchar);
+var
+ regs : trealregs;
+begin
+ AllowSlash(p);
+ syscopytodos(longint(p),strlen(p)+1);
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7141
+ else
+ regs.realeax:=$4100;
+ regs.realesi:=0;
+ regs.realecx:=0;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+procedure do_rename(p1,p2 : pchar);
+var
+ regs : trealregs;
+begin
+ AllowSlash(p1);
+ AllowSlash(p2);
+ if strlen(p1)+strlen(p2)+3>tb_size then
+ HandleError(217);
+ sysseg_move(get_ds,sizeuint(p2),dos_selector,tb,strlen(p2)+1);
+ sysseg_move(get_ds,sizeuint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1);
+ regs.realedi:=tb_offset;
+ regs.realedx:=tb_offset + strlen(p2)+2;
+ regs.realds:=tb_segment;
+ regs.reales:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7156
+ else
+ regs.realeax:=$5600;
+ regs.realecx:=$ff; { attribute problem here ! }
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+function do_write(h:longint;addr:pointer;len : longint) : longint;
+var
+ regs : trealregs;
+ size,
+ writesize : longint;
+begin
+ writesize:=0;
+ while len > 0 do
+ begin
+ if len>tb_size then
+ size:=tb_size
+ else
+ size:=len;
+ syscopytodos(ptrint(addr)+writesize,size);
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=h;
+ regs.realeax:=$4000;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ GetInOutRes(lo(regs.realeax));
+ exit(writesize);
+ end;
+ inc(writesize,lo(regs.realeax));
+ dec(len,lo(regs.realeax));
+ { stop when not the specified size is written }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ Do_Write:=WriteSize;
+end;
+
+function do_read(h:longint;addr:pointer;len : longint) : longint;
+var
+ regs : trealregs;
+ size,
+ readsize : longint;
+begin
+ readsize:=0;
+ while len > 0 do
+ begin
+ if len>tb_size then
+ size:=tb_size
+ else
+ size:=len;
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=h;
+ regs.realeax:=$3f00;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ GetInOutRes(lo(regs.realeax));
+ do_read:=0;
+ exit;
+ end;
+ syscopyfromdos(ptrint(addr)+readsize,lo(regs.realeax));
+ inc(readsize,lo(regs.realeax));
+ dec(len,lo(regs.realeax));
+ { stop when not the specified size is read }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ do_read:=readsize;
+end;
+
+
+function do_filepos(handle : longint) : longint;
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realecx:=0;
+ regs.realedx:=0;
+ regs.realeax:=$4201;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ Begin
+ GetInOutRes(lo(regs.realeax));
+ do_filepos:=0;
+ end
+ else
+ do_filepos:=lo(regs.realedx) shl 16+lo(regs.realeax);
+end;
+
+
+procedure do_seek(handle,pos : longint);
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realecx:=pos shr 16;
+ regs.realedx:=pos and $ffff;
+ regs.realeax:=$4200;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+
+function do_seekend(handle:longint):longint;
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realecx:=0;
+ regs.realedx:=0;
+ regs.realeax:=$4202;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ Begin
+ GetInOutRes(lo(regs.realeax));
+ do_seekend:=0;
+ end
+ else
+ do_seekend:=lo(regs.realedx) shl 16+lo(regs.realeax);
+end;
+
+
+function do_filesize(handle : longint) : longint;
+var
+ aktfilepos : longint;
+begin
+ aktfilepos:=do_filepos(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,aktfilepos);
+end;
+
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+var
+ regs : trealregs;
+begin
+ do_seek(handle,pos);
+ regs.realecx:=0;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=handle;
+ regs.realeax:=$4000;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+const
+ FileHandleCount : longint = 20;
+
+function Increase_file_handle_count : boolean;
+var
+ regs : trealregs;
+begin
+ Inc(FileHandleCount,10);
+ regs.realebx:=FileHandleCount;
+ regs.realeax:=$6700;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ Increase_file_handle_count:=false;
+ Dec (FileHandleCount, 10);
+ end
+ else
+ Increase_file_handle_count:=true;
+end;
+
+
+function dos_version : word;
+var
+ regs : trealregs;
+begin
+ regs.realeax := $3000;
+ sysrealintr($21,regs);
+ dos_version := regs.realeax
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+ regs : trealregs;
+ action : longint;
+ Avoid6c00 : boolean;
+begin
+ AllowSlash(p);
+{ check if Extended Open/Create API is safe to use }
+ Avoid6c00 := lo(dos_version) < 7;
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed : ;
+ else
+ begin
+ inoutres:=102; {not assigned}
+ exit;
+ end;
+ end;
+ end;
+{ reset file handle }
+ filerec(f).handle:=UnusedHandle;
+ action:=$1;
+{ convert filemode to filerec modes }
+ case (flags and 3) of
+ 0 : filerec(f).mode:=fminput;
+ 1 : filerec(f).mode:=fmoutput;
+ 2 : filerec(f).mode:=fminout;
+ end;
+ if (flags and $1000)<>0 then
+ action:=$12; {create file function}
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+{ real dos call }
+ syscopytodos(longint(p),strlen(p)+1);
+{$ifndef RTLLITE}
+ if LFNSupport then
+ regs.realeax := $716c { Use LFN Open/Create API }
+ else
+ regs.realeax:=$6c00;
+{$endif RTLLITE}
+ if Avoid6c00 then
+ regs.realeax := $3d00 + (flags and $ff) { For now, map to Open API }
+ else
+ regs.realeax := $6c00; { Use Extended Open/Create API }
+ if byte(regs.realeax shr 8) = $3d then
+ begin { Using the older Open or Create API's }
+ if (action and $00f0) <> 0 then
+ regs.realeax := $3c00; { Map to Create/Replace API }
+ regs.realds := tb_segment;
+ regs.realedx := tb_offset;
+ end
+ else
+ begin { Using LFN or Extended Open/Create API }
+ regs.realedx := action; { action if file does/doesn't exist }
+ regs.realds := tb_segment;
+ regs.realesi := tb_offset;
+ regs.realebx := $2000 + (flags and $ff); { file open mode }
+ end;
+ regs.realecx := $20; { file attributes }
+ sysrealintr($21,regs);
+{$ifndef RTLLITE}
+ if (regs.realflags and carryflag) <> 0 then
+ if lo(regs.realeax)=4 then
+ if Increase_file_handle_count then
+ begin
+ { Try again }
+ if LFNSupport then
+ regs.realeax := $716c {Use LFN Open/Create API}
+ else
+ if Avoid6c00 then
+ regs.realeax := $3d00+(flags and $ff) {For now, map to Open API}
+ else
+ regs.realeax := $6c00; {Use Extended Open/Create API}
+ if byte(regs.realeax shr 8) = $3d then
+ begin { Using the older Open or Create API's }
+ if (action and $00f0) <> 0 then
+ regs.realeax := $3c00; {Map to Create/Replace API}
+ regs.realds := tb_segment;
+ regs.realedx := tb_offset;
+ end
+ else
+ begin { Using LFN or Extended Open/Create API }
+ regs.realedx := action; {action if file does/doesn't exist}
+ regs.realds := tb_segment;
+ regs.realesi := tb_offset;
+ regs.realebx := $2000+(flags and $ff); {file open mode}
+ end;
+ regs.realecx := $20; {file attributes}
+ sysrealintr($21,regs);
+ end;
+{$endif RTLLITE}
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ GetInOutRes(lo(regs.realeax));
+ exit;
+ end
+ else
+ begin
+ filerec(f).handle:=lo(regs.realeax);
+{$ifndef RTLLITE}
+ { for systems that have more then 20 by default ! }
+ if lo(regs.realeax)>FileHandleCount then
+ FileHandleCount:=lo(regs.realeax);
+{$endif RTLLITE}
+ end;
+ if lo(regs.realeax)<max_files then
+ begin
+{$ifdef SYSTEMDEBUG}
+ if openfiles[lo(regs.realeax)] and
+ assigned(opennames[lo(regs.realeax)]) then
+ begin
+ Writeln(stderr,'file ',opennames[lo(regs.realeax)],'(',lo(regs.realeax),') not closed but handle reused!');
+ sysfreememsize(opennames[lo(regs.realeax)],strlen(opennames[lo(regs.realeax)])+1);
+ end;
+{$endif SYSTEMDEBUG}
+ openfiles[lo(regs.realeax)]:=true;
+{$ifdef SYSTEMDEBUG}
+ opennames[lo(regs.realeax)] := sysgetmem(strlen(p)+1);
+ move(p^,opennames[lo(regs.realeax)]^,strlen(p)+1);
+{$endif SYSTEMDEBUG}
+ end;
+{ append mode }
+ if ((flags and $100) <> 0) and
+ (FileRec (F).Handle <> UnusedHandle) then
+ begin
+ do_seekend(filerec(f).handle);
+ filerec(f).mode:=fmoutput; {fool fmappend}
+ end;
+end;
+
+function do_isdevice(handle:THandle):boolean;
+var
+ regs : trealregs;
+begin
+ regs.realebx:=handle;
+ regs.realeax:=$4400;
+ sysrealintr($21,regs);
+ do_isdevice:=(regs.realedx and $80)<>0;
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+{*****************************************************************************
+ UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+ Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+ Text File Handling
+*****************************************************************************}
+
+{$i text.inc}
+
+
+{*****************************************************************************
+ Generic Handling
+*****************************************************************************}
+
+{$ifdef TEST_GENERIC}
+{$i generic.inc}
+{$endif TEST_GENERIC}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+procedure DosDir(func:byte;const s:string);
+var
+ buffer : array[0..255] of char;
+ regs : trealregs;
+begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ AllowSlash(pchar(@buffer));
+ { True DOS does not like backslashes at end
+ Win95 DOS accepts this !!
+ but "\" and "c:\" should still be kept and accepted hopefully PM }
+ if (length(s)>0) and (buffer[length(s)-1]='\') and
+ Not ((length(s)=1) or ((length(s)=3) and (s[2]=':'))) then
+ buffer[length(s)-1]:=#0;
+ syscopytodos(longint(@buffer),length(s)+1);
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7100+func
+ else
+ regs.realeax:=func shl 8;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ GetInOutRes(lo(regs.realeax));
+end;
+
+
+procedure mkdir(const s : string);[IOCheck];
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ DosDir($39,s);
+end;
+
+
+procedure rmdir(const s : string);[IOCheck];
+begin
+ if (s = '.' ) then
+ InOutRes := 16;
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ DosDir($3a,s);
+end;
+
+
+procedure chdir(const s : string);[IOCheck];
+var
+ regs : trealregs;
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+{ First handle Drive changes }
+ if (length(s)>=2) and (s[2]=':') then
+ begin
+ regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
+ regs.realeax:=$0e00;
+ sysrealintr($21,regs);
+ regs.realeax:=$1900;
+ sysrealintr($21,regs);
+ if byte(regs.realeax)<>byte(regs.realedx) then
+ begin
+ Inoutres:=15;
+ exit;
+ end;
+ { DosDir($3b,'c:') give Path not found error on
+ pure DOS PM }
+ if length(s)=2 then
+ exit;
+ end;
+{ do the normal dos chdir }
+ DosDir($3b,s);
+end;
+
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+ temp : array[0..255] of char;
+ i : longint;
+ regs : trealregs;
+begin
+ regs.realedx:=drivenr;
+ regs.realesi:=tb_offset;
+ regs.realds:=tb_segment;
+ if LFNSupport then
+ regs.realeax:=$7147
+ else
+ regs.realeax:=$4700;
+ sysrealintr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ Begin
+ GetInOutRes(lo(regs.realeax));
+ Dir := char (DriveNr + 64) + ':\';
+ exit;
+ end
+ else
+ syscopyfromdos(longint(@temp),251);
+{ conversion to Pascal string including slash conversion }
+ i:=0;
+ while (temp[i]<>#0) do
+ begin
+ if temp[i]='/' then
+ temp[i]:='\';
+ dir[i+4]:=temp[i];
+ inc(i);
+ end;
+ dir[2]:=':';
+ dir[3]:='\';
+ dir[0]:=char(i+3);
+{ upcase the string }
+ if not FileNameCaseSensitive then
+ dir:=upcase(dir);
+ if drivenr<>0 then { Drive was supplied. We know it }
+ dir[1]:=char(65+drivenr-1)
+ else
+ begin
+ { We need to get the current drive from DOS function 19H }
+ { because the drive was the default, which can be unknown }
+ regs.realeax:=$1900;
+ sysrealintr($21,regs);
+ i:= (regs.realeax and $ff) + ord('A');
+ dir[1]:=chr(i);
+ end;
+end;
+
+{*****************************************************************************
+ SystemUnit Initialization
+*****************************************************************************}
+
+function CheckLFN:boolean;
+var
+ regs : TRealRegs;
+ RootName : pchar;
+begin
+{ Check LFN API on drive c:\ }
+ RootName:='C:\';
+ syscopytodos(longint(RootName),strlen(RootName)+1);
+{ Call 'Get Volume Information' ($71A0) }
+ regs.realeax:=$71a0;
+ regs.reales:=tb_segment;
+ regs.realedi:=tb_offset;
+ regs.realecx:=32;
+ regs.realds:=tb_segment;
+ regs.realedx:=tb_offset;
+ regs.realflags:=carryflag;
+ sysrealintr($21,regs);
+{ If carryflag=0 and LFN API bit in ebx is set then use Long file names }
+ CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
+end;
+
+{$ifdef EXCEPTIONS_IN_SYSTEM}
+{$define IN_SYSTEM}
+{$i dpmiexcp.pp}
+{$endif EXCEPTIONS_IN_SYSTEM}
+
+procedure SysInitStdIO;
+begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := 1;
+end;
+
+
+var
+ temp_int : tseginfo;
+Begin
+ alloc_tb;
+ StackLength := InitialStkLen;
+ StackBottom := __stkbottom;
+ { To be set if this is a GUI or console application }
+ IsConsole := TRUE;
+ { To be set if this is a library and not a program }
+ IsLibrary := FALSE;
+{ save old int 0 and 75 }
+ get_pm_interrupt($00,old_int00);
+ get_pm_interrupt($75,old_int75);
+ temp_int.segment:=get_cs;
+ temp_int.offset:=@new_int00;
+ set_pm_interrupt($00,temp_int);
+{$ifndef EXCEPTIONS_IN_SYSTEM}
+ temp_int.offset:=@new_int75;
+ set_pm_interrupt($75,temp_int);
+{$endif EXCEPTIONS_IN_SYSTEM}
+{ Setup heap }
+ InitHeap;
+ SysInitExceptions;
+{ Setup stdin, stdout and stderr }
+ SysInitStdIO;
+{ Setup environment and arguments }
+ Setup_Environment;
+ Setup_Arguments;
+{ Use LFNSupport LFN }
+ LFNSupport:=CheckLFN;
+ if LFNSupport then
+ FileNameCaseSensitive:=true;
+{ Reset IO Error }
+ InOutRes:=0;
+ ThreadID := 1;
+{$ifdef EXCEPTIONS_IN_SYSTEM}
+ InitDPMIExcp;
+ InstallDefaultHandlers;
+{$endif EXCEPTIONS_IN_SYSTEM}
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+{$endif HASWIDESTRING}
+End.
+
+{
+ $Log: system.pp,v $
+ Revision 1.22 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.21 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.20 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.19 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/watcom/sysutils.pp b/rtl/watcom/sysutils.pp
new file mode 100644
index 0000000000..02c005a553
--- /dev/null
+++ b/rtl/watcom/sysutils.pp
@@ -0,0 +1,888 @@
+{
+ $Id: sysutils.pp,v 1.8 2005/02/26 14:38:14 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for Watcom
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+ watcom,dos;
+
+{$DEFINE HAS_SLEEP}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+{ some internal constants }
+
+const
+ ofRead = $0000; { Open for reading }
+ ofWrite = $0001; { Open for writing }
+ ofReadWrite = $0002; { Open for reading/writing }
+ faFail = $0000; { Fail if file does not exist }
+ faCreate = $0010; { Create if file does not exist }
+ faOpen = $0001; { Open if file exists }
+ faOpenReplace = $0002; { Clear if file exists }
+
+Type
+ PSearchrec = ^Searchrec;
+
+{ converts S to a pchar and copies it to the transfer-buffer. }
+
+procedure StringToTB(const S: string);
+var
+ P: pchar;
+ Len: integer;
+begin
+ Len := Length(S) + 1;
+ P := StrPCopy(StrAlloc(Len), S);
+ SysCopyToDos(longint(P), Len);
+ StrDispose(P);
+end ;
+
+
+{ Native OpenFile function.
+ if return value <> 0 call failed. }
+function OpenFile(const FileName: string; var Handle: longint; Mode, Action: word): longint;
+var
+ Regs: registers;
+begin
+ result := 0;
+ Handle := 0;
+ StringToTB(FileName);
+ if LFNSupport then
+ Regs.Eax := $716c { Use LFN Open/Create API }
+ else { Check if Extended Open/Create API is safe to use }
+ if lo(dosversion) < 7 then
+ Regs.Eax := $3d00 + (Mode and $ff) { For now, map to Open API }
+ else
+ Regs.Eax := $6c00; { Use Extended Open/Create API }
+ if Regs.Ah = $3d then
+ begin
+ if (Action and $00f0) <> 0 then
+ Regs.Eax := $3c00; { Map to Create/Replace API }
+ Regs.Ds := tb_segment;
+ Regs.Edx := tb_offset;
+ end
+ else { LFN or Extended Open/Create API }
+ begin
+ Regs.Edx := Action; { Action if file exists/not exists }
+ Regs.Ds := tb_segment;
+ Regs.Esi := tb_offset;
+ Regs.Ebx := $2000 + (Mode and $ff); { file open mode }
+ end;
+ Regs.Ecx := $20; { Attributes }
+ RealIntr($21, Regs);
+ if (Regs.Flags and CarryFlag) <> 0 then
+ result := Regs.Ax
+ else
+ Handle := Regs.Ax;
+end;
+
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+var
+ e: integer;
+Begin
+ e := OpenFile(FileName, result, Mode, faOpen);
+ if e <> 0 then
+ result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+var
+ e: integer;
+begin
+ e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace);
+ if e <> 0 then
+ result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String; Mode:longint) : Longint;
+begin
+ FileCreate:=FileCreate(FileName);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+var
+ regs : registers;
+ size,
+ readsize : longint;
+begin
+ readsize:=0;
+ while Count > 0 do
+ begin
+ if Count>tb_size then
+ size:=tb_size
+ else
+ size:=Count;
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=Handle;
+ regs.realeax:=$3f00;
+ RealIntr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ Result:=-1;
+ exit;
+ end;
+ syscopyfromdos(Longint(@Buffer)+readsize,lo(regs.realeax));
+ inc(readsize,lo(regs.realeax));
+ dec(Count,lo(regs.realeax));
+ { stop when not the specified size is read }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ Result:=readsize;
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+var
+ regs : registers;
+ size,
+ writesize : longint;
+begin
+ writesize:=0;
+ while Count > 0 do
+ begin
+ if Count>tb_size then
+ size:=tb_size
+ else
+ size:=Count;
+ syscopytodos(Longint(@Buffer)+writesize,size);
+ regs.realecx:=size;
+ regs.realedx:=tb_offset;
+ regs.realds:=tb_segment;
+ regs.realebx:=Handle;
+ regs.realeax:=$4000;
+ RealIntr($21,regs);
+ if (regs.realflags and carryflag) <> 0 then
+ begin
+ Result:=-1;
+ exit;
+ end;
+ inc(writesize,lo(regs.realeax));
+ dec(Count,lo(regs.realeax));
+ { stop when not the specified size is written }
+ if lo(regs.realeax)<size then
+ break;
+ end;
+ Result:=WriteSize;
+end;
+
+
+Function FileSeek (Handle, FOffset, Origin : Longint) : Longint;
+var
+ Regs: registers;
+begin
+ Regs.Eax := $4200;
+ Regs.Al := Origin;
+ Regs.Edx := Lo(FOffset);
+ Regs.Ecx := Hi(FOffset);
+ Regs.Ebx := Handle;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -1
+ else begin
+ LongRec(result).Lo := Regs.Ax;
+ LongRec(result).Hi := Regs.Dx;
+ end ;
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+begin
+ {$warning need to add 64bit call }
+ FileSeek:=FileSeek(Handle,Longint(FOffset),Longint(Origin));
+end;
+
+
+Procedure FileClose (Handle : Longint);
+var
+ Regs: registers;
+begin
+ if Handle<=4 then
+ exit;
+ Regs.Eax := $3e00;
+ Regs.Ebx := Handle;
+ RealIntr($21, Regs);
+end;
+
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+var
+ regs : trealregs;
+begin
+ FileSeek(Handle,Size,0);
+ Regs.realecx := 0;
+ Regs.realedx := tb_offset;
+ Regs.ds := tb_segment;
+ Regs.ebx := Handle;
+ Regs.eax:=$4000;
+ RealIntr($21, Regs);
+ FileTruncate:=(regs.realflags and carryflag)=0;
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+var Handle: longint;
+begin
+ Handle := FileOpen(FileName, 0);
+ if Handle <> -1 then
+ begin
+ result := FileGetDate(Handle);
+ FileClose(Handle);
+ end
+ else
+ result := -1;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+Var
+ Sr : Searchrec;
+begin
+ DOS.FindFirst(FileName,$3f,sr);
+ if DosError = 0 then
+ begin
+ { No volumeid,directory }
+ Result:=(sr.attr and $18)=0;
+ Dos.FindClose(sr);
+ end
+ else
+ Result:=false;
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+Var
+ Sr : Searchrec;
+begin
+ DOS.FindFirst(Directory,$3f,sr);
+ if DosError = 0 then
+ begin
+ Result:=(sr.attr and $10)=$10;
+ Dos.FindClose(sr);
+ end
+ else
+ Result:=false;
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+
+Var Sr : PSearchrec;
+
+begin
+ //!! Sr := New(PSearchRec);
+ getmem(sr,sizeof(searchrec));
+ Rslt.FindHandle := longint(Sr);
+ DOS.FindFirst(Path, Attr, Sr^);
+ result := -DosError;
+ if result = 0 then
+ begin
+ Rslt.Time := Sr^.Time;
+ Rslt.Size := Sr^.Size;
+ Rslt.Attr := Sr^.Attr;
+ Rslt.ExcludeAttr := 0;
+ Rslt.Name := Sr^.Name;
+ end ;
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+var
+ Sr: PSearchRec;
+begin
+ Sr := PSearchRec(Rslt.FindHandle);
+ if Sr <> nil then
+ begin
+ DOS.FindNext(Sr^);
+ result := -DosError;
+ if result = 0 then
+ begin
+ Rslt.Time := Sr^.Time;
+ Rslt.Size := Sr^.Size;
+ Rslt.Attr := Sr^.Attr;
+ Rslt.ExcludeAttr := 0;
+ Rslt.Name := Sr^.Name;
+ end;
+ end;
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+var
+ Sr: PSearchRec;
+begin
+ Sr := PSearchRec(F.FindHandle);
+ if Sr <> nil then
+ begin
+ //!! Dispose(Sr);
+ // This call is non dummy if LFNSupport is true PM
+ DOS.FindClose(SR^);
+ freemem(sr,sizeof(searchrec));
+ end;
+ F.FindHandle := 0;
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+var
+ Regs: registers;
+begin
+ //!! for win95 an alternative function is available.
+ Regs.Ebx := Handle;
+ Regs.Eax := $5700;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -1
+ else
+ begin
+ LongRec(result).Lo := Regs.cx;
+ LongRec(result).Hi := Regs.dx;
+ end ;
+end;
+
+
+Function FileSetDate (Handle, Age : Longint) : Longint;
+var
+ Regs: registers;
+begin
+ Regs.Ebx := Handle;
+ Regs.Eax := $5701;
+ Regs.Ecx := Lo(Age);
+ Regs.Edx := Hi(Age);
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -Regs.Ax
+ else
+ result := 0;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+var
+ Regs: registers;
+begin
+ StringToTB(FileName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ if LFNSupport then
+ begin
+ Regs.Ax := $7143;
+ Regs.Bx := 0;
+ end
+ else
+ Regs.Ax := $4300;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -1
+ else
+ result := Regs.Cx;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+ Regs: registers;
+begin
+ StringToTB(FileName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ if LFNSupport then
+ begin
+ Regs.Ax := $7143;
+ Regs.Bx := 1;
+ end
+ else
+ Regs.Ax := $4301;
+ Regs.Cx := Attr;
+ RealIntr($21, Regs);
+ if Regs.Flags and CarryFlag <> 0 then
+ result := -Regs.Ax
+ else
+ result := 0;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+var
+ Regs: registers;
+begin
+ StringToTB(FileName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ if LFNSupport then
+ Regs.Eax := $7141
+ else
+ Regs.Eax := $4100;
+ Regs.Esi := 0;
+ Regs.Ecx := 0;
+ RealIntr($21, Regs);
+ result := (Regs.Flags and CarryFlag = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+var
+ Regs: registers;
+begin
+ StringToTB(OldName + #0 + NewName);
+ Regs.Edx := tb_offset;
+ Regs.Ds := tb_segment;
+ Regs.Edi := tb_offset + Length(OldName) + 1;
+ Regs.Es := tb_segment;
+ if LFNSupport then
+ Regs.Eax := $7156
+ else
+ Regs.Eax := $5600;
+ Regs.Ecx := $ff;
+ RealIntr($21, Regs);
+ result := (Regs.Flags and CarryFlag = 0);
+end;
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+TYPE ExtendedFat32FreeSpaceRec=packed Record
+ RetSize : WORD; { (ret) size of returned structure}
+ Strucversion : WORD; {(call) structure version (0000h)
+ (ret) actual structure version (0000h)}
+ SecPerClus, {number of sectors per cluster}
+ BytePerSec, {number of bytes per sector}
+ AvailClusters, {number of available clusters}
+ TotalClusters, {total number of clusters on the drive}
+ AvailPhysSect, {physical sectors available on the drive}
+ TotalPhysSect, {total physical sectors on the drive}
+ AvailAllocUnits, {Available allocation units}
+ TotalAllocUnits : DWORD; {Total allocation units}
+ Dummy,Dummy2 : DWORD; {8 bytes reserved}
+ END;
+
+function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
+VAR S : String;
+ Rec : ExtendedFat32FreeSpaceRec;
+ regs : registers;
+BEGIN
+ if (swap(dosversion)>=$070A) AND LFNSupport then
+ begin
+ DosError:=0;
+ S:='C:\'#0;
+ if Drive=0 then
+ begin
+ GetDir(Drive,S);
+ Setlength(S,4);
+ S[4]:=#0;
+ end
+ else
+ S[1]:=chr(Drive+64);
+ Rec.Strucversion:=0;
+ dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
+ dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
+ regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
+ regs.ds:=tb_segment;
+ regs.di:=tb_offset;
+ regs.es:=tb_segment;
+ regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
+ regs.ax:=$7303;
+ msdos(regs);
+ if regs.ax<>$ffff then
+ begin
+ copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
+ if Free then
+ Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
+ else
+ Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
+ end
+ else
+ Do_DiskData:=-1;
+ end
+ else
+ begin
+ DosError:=0;
+ regs.dl:=drive;
+ regs.ah:=$36;
+ msdos(regs);
+ if regs.ax<>$FFFF then
+ begin
+ if Free then
+ Do_DiskData:=int64(regs.ax)*regs.bx*regs.cx
+ else
+ Do_DiskData:=int64(regs.ax)*regs.cx*regs.dx;
+ end
+ else
+ do_diskdata:=-1;
+ end;
+end;
+
+
+function diskfree(drive : byte) : int64;
+begin
+ diskfree:=Do_DiskData(drive,TRUE);
+end;
+
+
+function disksize(drive : byte) : int64;
+begin
+ disksize:=Do_DiskData(drive,false);
+end;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir(0, result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+ Time Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var
+ Regs: Registers;
+begin
+ Regs.ah := $2C;
+ RealIntr($21, Regs);
+ SystemTime.Hour := Regs.Ch;
+ SystemTime.Minute := Regs.Cl;
+ SystemTime.Second := Regs.Dh;
+ SystemTime.MilliSecond := Regs.Dl*10;
+ Regs.ah := $2A;
+ RealIntr($21, Regs);
+ SystemTime.Year := Regs.Cx;
+ SystemTime.Month := Regs.Dh;
+ SystemTime.Day := Regs.Dl;
+end ;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+{ Codepage constants }
+const
+ CP_US = 437;
+ CP_MultiLingual = 850;
+ CP_SlavicLatin2 = 852;
+ CP_Turkish = 857;
+ CP_Portugal = 860;
+ CP_IceLand = 861;
+ CP_Canada = 863;
+ CP_NorwayDenmark = 865;
+
+{ CountryInfo }
+type
+ TCountryInfo = packed record
+ InfoId: byte;
+ case integer of
+ 1: ( Size: word;
+ CountryId: word;
+ CodePage: word;
+ CountryInfo: array[0..33] of byte );
+ 2: ( UpperCaseTable: longint );
+ 4: ( FilenameUpperCaseTable: longint );
+ 5: ( FilecharacterTable: longint );
+ 6: ( CollatingTable: longint );
+ 7: ( DBCSLeadByteTable: longint );
+ end ;
+
+
+procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo);
+
+Var Regs: Registers;
+
+begin
+ Regs.AH := $65;
+ Regs.AL := InfoId;
+ Regs.BX := CodePage;
+ Regs.DX := CountryId;
+ Regs.ES := tb div 16;
+ Regs.DI := tb and 15;
+ Regs.CX := SizeOf(TCountryInfo);
+ RealIntr($21, Regs);
+ DosMemGet(tb div 16,
+ tb and 15,
+ CountryInfo, Regs.CX );
+end;
+
+
+procedure InitAnsi;
+var
+ CountryInfo: TCountryInfo; i: integer;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 127 do
+ UpperCaseTable[i] := chr(i);
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 255 do
+ LowerCaseTable[i] := chr(i);
+
+ { Get country and codepage info }
+ GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo);
+ if CountryInfo.CodePage = 850 then
+ begin
+ { Special, known case }
+ Move(CP850UCT, UpperCaseTable[128], 128);
+ Move(CP850LCT, LowerCaseTable[128], 128);
+ end
+ else
+ begin
+ { this needs to be checked !!
+ this is correct only if UpperCaseTable is
+ and Offset:Segment word record (PM) }
+ { get the uppercase table from dosmemory }
+ GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo);
+ DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128);
+ for i := 128 to 255 do
+ begin
+ if UpperCaseTable[i] <> chr(i) then
+ LowerCaseTable[ord(UpperCaseTable[i])] := chr(i);
+ end;
+ end;
+end;
+
+
+Procedure InitInternational;
+begin
+ InitInternationalGeneric;
+ InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+ Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+{****************************************************************************
+ Os utils
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+ Result:=FPCGetEnvVarFromP(envp,EnvVar);
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+ Result:=FPCCountEnvVar(EnvP);
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+ Result:=FPCGetEnvStrFromP(Envp,Index);
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+
+var
+ e : EOSError;
+ CommandLine: AnsiString;
+
+begin
+ dos.exec(path,comline);
+
+ if (Dos.DosError <> 0) then
+ begin
+ if ComLine <> '' then
+ CommandLine := Path + ' ' + ComLine
+ else
+ CommandLine := Path;
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+ e.ErrorCode:=Dos.DosError;
+ raise e;
+ end;
+ Result := DosExitCode;
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+ const ComLine: array of AnsiString): integer;
+
+var
+ CommandLine: AnsiString;
+ I: integer;
+
+begin
+ Commandline := '';
+ for I := 0 to High (ComLine) do
+ if Pos (' ', ComLine [I]) <> 0 then
+ CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+ else
+ CommandLine := CommandLine + ' ' + Comline [I];
+ ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+
+{*************************************************************************
+ Sleep (copied from crt.Delay)
+*************************************************************************}
+
+var
+ DelayCnt : Longint;
+
+
+procedure Delayloop;assembler;
+asm
+.LDelayLoop1:
+ subl $1,%eax
+ jc .LDelayLoop2
+ cmpl %fs:(%edi),%ebx
+ je .LDelayLoop1
+.LDelayLoop2:
+end;
+
+
+procedure initdelay;assembler;
+asm
+ pushl %ebx
+ pushl %edi
+ { for some reason, using int $31/ax=$901 doesn't work here }
+ { and interrupts are always disabled at this point when }
+ { running a program inside gdb(pas). Web bug 1345 (JM) }
+ sti
+ movl $0x46c,%edi
+ movl $-28,%edx
+ movl %fs:(%edi),%ebx
+.LInitDel1:
+ cmpl %fs:(%edi),%ebx
+ je .LInitDel1
+ movl %fs:(%edi),%ebx
+ movl %edx,%eax
+ call DelayLoop
+
+ notl %eax
+ xorl %edx,%edx
+ movl $55,%ecx
+ divl %ecx
+ movl %eax,DelayCnt
+ popl %edi
+ popl %ebx
+end;
+
+
+procedure Sleep(MilliSeconds: Cardinal);assembler;
+asm
+ pushl %ebx
+ pushl %edi
+ movl MilliSeconds,%ecx
+ jecxz .LDelay2
+ movl $0x400,%edi
+ movl DelayCnt,%edx
+ movl %fs:(%edi),%ebx
+.LDelay1:
+ movl %edx,%eax
+ call DelayLoop
+ loop .LDelay1
+.LDelay2:
+ popl %edi
+ popl %ebx
+end;
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Initialization
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+ InitDelay;
+Finalization
+ DoneExceptions;
+end.
+
+{
+ $Log: sysutils.pp,v $
+ Revision 1.8 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.7 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/watcom/varutils.pp b/rtl/watcom/varutils.pp
new file mode 100644
index 0000000000..512ebd69a7
--- /dev/null
+++ b/rtl/watcom/varutils.pp
@@ -0,0 +1,46 @@
+{
+ $Id: varutils.pp,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.2 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/watcom/watcom.pp b/rtl/watcom/watcom.pp
new file mode 100644
index 0000000000..a8bf979c25
--- /dev/null
+++ b/rtl/watcom/watcom.pp
@@ -0,0 +1,1162 @@
+{
+ $Id: watcom.pp,v 1.5 2005/02/14 17:13:32 peter Exp $
+
+}
+// this is generally go32 unit from go32v2 target.
+// maybe these units should be merged into one ( uses dpmi ? )
+
+// not yet finished
+
+unit watcom;
+
+{$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! }
+
+interface
+
+ const
+ { contants for the run modes returned by get_run_mode }
+ rm_unknown = 0;
+ rm_raw = 1; { raw (without HIMEM) }
+ rm_xms = 2; { XMS (for example with HIMEM, without EMM386) }
+ rm_vcpi = 3; { VCPI (for example HIMEM and EMM386) }
+ rm_dpmi = 4; { DPMI (for example DOS box or 386Max) }
+
+ { flags }
+ carryflag = $001;
+ parityflag = $004;
+ auxcarryflag = $010;
+ zeroflag = $040;
+ signflag = $080;
+ trapflag = $100;
+ interruptflag = $200;
+ directionflag = $400;
+ overflowflag = $800;
+
+ type
+ tmeminfo = record
+ available_memory,
+ available_pages,
+ available_lockable_pages,
+ linear_space,
+ unlocked_pages,
+ available_physical_pages,
+ total_physical_pages,
+ free_linear_space,
+ max_pages_in_paging_file,
+ reserved0,
+ reserved1,
+ reserved2 : longint;
+ end;
+
+ tseginfo = record
+ offset : pointer;
+ segment : word;
+ end;
+
+ trealregs = record
+ case integer of
+ 1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint;
+ Flags, ES, DS, FS, GS, IP, CS, SP, SS: word);
+ 2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word;
+ BX, BX2, DX, DX2, CX, CX2, AX, AX2: word);
+ 3: { 8-bit } (stuff: array[1..4] of longint;
+ BL, BH, BL2, BH2, DL, DH, DL2, DH2,
+ CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte);
+ 4: { Compat } (RealEDI, RealESI, RealEBP, RealRES,
+ RealEBX, RealEDX, RealECX, RealEAX: longint;
+ RealFlags,
+ RealES, RealDS, RealFS, RealGS,
+ RealIP, RealCS, RealSP, RealSS: word);
+ end;
+
+ registers = trealregs;
+
+ { this works only with real DPMI }
+ function allocate_ldt_descriptors(count : word) : word;
+ function free_ldt_descriptor(d : word) : boolean;
+ function segment_to_descriptor(seg : word) : word;
+ function get_next_selector_increment_value : word;
+ function get_segment_base_address(d : word) : longint;
+ function set_segment_base_address(d : word;s : longint) : boolean;
+ function set_segment_limit(d : word;s : longint) : boolean;
+ function set_descriptor_access_right(d : word;w : word) : longint;
+ function create_code_segment_alias_descriptor(seg : word) : word;
+ function get_linear_addr(phys_addr : longint;size : longint) : longint;
+ function get_segment_limit(d : word) : longint;
+ function get_descriptor_access_right(d : word) : longint;
+ function get_page_size:longint;
+ function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+ function realintr(intnr : word;var regs : trealregs) : boolean;
+
+ { is needed for functions which need a real mode buffer }
+ function global_dos_alloc(bytes : longint) : longint;
+ function global_dos_free(selector : word) : boolean;
+
+ var
+ { selector for the DOS memory (only usable if in DPMI mode) }
+ dosmemselector : word;
+ { result of dpmi call }
+ int31error : word;
+
+ { this procedure copies data where the source and destination }
+ { are specified by 48 bit pointers }
+ { Note: the procedure checks only for overlapping if }
+ { source selector=destination selector }
+ procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+ { fills a memory area specified by a 48 bit pointer with c }
+ procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char);
+ procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word);
+
+ {************************************}
+ { this works with all PM interfaces: }
+ {************************************}
+
+ function get_meminfo(var meminfo : tmeminfo) : boolean;
+ function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+ function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+ function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+ function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+ function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+ function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+ function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+ function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+ function free_rm_callback(var intaddr : tseginfo) : boolean;
+ function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+ function get_cs : word;
+ function get_ds : word;
+ function get_ss : word;
+
+ { locking functions }
+ function allocate_memory_block(size:longint):longint;
+ function free_memory_block(blockhandle : longint) : boolean;
+ function request_linear_region(linearaddr, size : longint;
+ var blockhandle : longint) : boolean;
+ function lock_linear_region(linearaddr, size : longint) : boolean;
+ function lock_data(var data;size : longint) : boolean;
+ function lock_code(functionaddr : pointer;size : longint) : boolean;
+ function unlock_linear_region(linearaddr, size : longint) : boolean;
+ function unlock_data(var data;size : longint) : boolean;
+ function unlock_code(functionaddr : pointer;size : longint) : boolean;
+
+ { disables and enables interrupts }
+ procedure disable;
+ procedure enable;
+
+ function inportb(port : word) : byte;
+ function inportw(port : word) : word;
+ function inportl(port : word) : longint;
+
+ procedure outportb(port : word;data : byte);
+ procedure outportw(port : word;data : word);
+ procedure outportl(port : word;data : longint);
+ function get_run_mode : word;
+
+ procedure copytodos(var addr; len : longint);
+ procedure copyfromdos(var addr; len : longint);
+
+ procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
+ procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
+ procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint);
+ procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char);
+ procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
+
+
+
+ const
+ { this procedures are assigned to the procedure which are needed }
+ { for the current mode to access DOS memory }
+ { It's strongly recommended to use this procedures! }
+ dosmemput : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemput;
+ dosmemget : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemget;
+ dosmemmove : procedure(sseg,sofs,dseg,dofs : word;count : longint)=@dpmi_dosmemmove;
+ dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=@dpmi_dosmemfillchar;
+ dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=@dpmi_dosmemfillword;
+
+ implementation
+
+{$asmmode ATT}
+
+
+ { the following procedures copy from and to DOS memory using DPMI }
+ procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
+
+ begin
+ seg_move(get_ds,longint(@data),dosmemselector,seg*16+ofs,count);
+ end;
+
+ procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
+
+ begin
+ seg_move(dosmemselector,seg*16+ofs,get_ds,longint(@data),count);
+ end;
+
+ procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint);
+
+ begin
+ seg_move(dosmemselector,sseg*16+sofs,dosmemselector,dseg*16+dofs,count);
+ end;
+
+ procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char);
+
+ begin
+ seg_fillchar(dosmemselector,seg*16+ofs,count,c);
+ end;
+
+ procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
+
+ begin
+ seg_fillword(dosmemselector,seg*16+ofs,count,w);
+ end;
+
+
+ procedure test_int31(flag : longint);
+ begin
+ asm
+ pushl %ebx
+ movw $0,INT31ERROR
+ movl flag,%ebx
+ testb $1,%bl
+ jz .Lti31_1
+ movw %ax,INT31ERROR
+ xorl %eax,%eax
+ jmp .Lti31_2
+ .Lti31_1:
+ movl $1,%eax
+ .Lti31_2:
+ popl %ebx
+ end;
+ end;
+
+ function global_dos_alloc(bytes : longint) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movl bytes,%ebx
+ addl $0xf,%ebx // round up
+ shrl $0x4,%ebx // convert to Paragraphs
+ movl $0x100,%eax // function 0x100
+ int $0x31
+ jnc .LDos_OK
+ movw %ax,INT31ERROR
+ xorl %eax,%eax
+ jmp .LDos_end
+ .LDos_OK:
+ shll $0x10,%eax // return Segment in hi(Result)
+ movw %dx,%ax // return Selector in lo(Result)
+ .LDos_end:
+ movl %eax,__result
+ popl %ebx
+ end;
+ end;
+
+ function global_dos_free(selector : word) : boolean;
+
+ begin
+ asm
+ movw Selector,%dx
+ movl $0x101,%eax
+ int $0x31
+ setnc %al
+ movb %al,__RESULT
+ end;
+ end;
+
+ function realintr(intnr : word;var regs : trealregs) : boolean;
+
+ begin
+ regs.realsp:=0;
+ regs.realss:=0;
+ asm
+ pushl %ebx
+ pushl %edi
+ { save all used registers to avoid crash under NTVDM }
+ { when spawning a 32-bit DPMI application }
+ pushw %fs
+ movw intnr,%bx
+ xorl %ecx,%ecx
+ movl regs,%edi
+ { es is always equal ds }
+ movl $0x300,%eax
+ int $0x31
+ popw %fs
+ setnc %al
+ movb %al,__RESULT
+ popl %edi
+ popl %ebx
+ end;
+ end;
+
+ procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char);
+
+ begin
+ asm
+ pushl %edi
+ movl ofs,%edi
+ movl count,%ecx
+ movb c,%dl
+ { load es with selector }
+ pushw %es
+ movw seg,%ax
+ movw %ax,%es
+ { fill eax with duplicated c }
+ { so we can use stosl }
+ movb %dl,%dh
+ movw %dx,%ax
+ shll $16,%eax
+ movw %dx,%ax
+ movl %ecx,%edx
+ shrl $2,%ecx
+ cld
+ rep
+ stosl
+ movl %edx,%ecx
+ andl $3,%ecx
+ rep
+ stosb
+ popw %es
+ popl %edi
+ end;
+ end;
+
+ procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word);
+
+ begin
+ asm
+ pushl %edi
+ movl ofs,%edi
+ movl count,%ecx
+ movw w,%dx
+ { load segment }
+ pushw %es
+ movw seg,%ax
+ movw %ax,%es
+ { fill eax }
+ movw %dx,%ax
+ shll $16,%eax
+ movw %dx,%ax
+ movl %ecx,%edx
+ shrl $1,%ecx
+ cld
+ rep
+ stosl
+ movl %edx,%ecx
+ andl $1,%ecx
+ rep
+ stosw
+ popw %es
+ popl %edi
+ end;
+ end;
+
+ procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+ begin
+ if count=0 then
+ exit;
+ if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
+ asm
+ pushl %edi
+ pushl %esi
+ pushw %es
+ pushw %ds
+ cld
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ movl %ecx,%eax
+ shrl $2,%ecx
+ rep
+ movsl
+ movl %eax,%ecx
+ andl $3,%ecx
+ rep
+ movsb
+ popw %ds
+ popw %es
+ popl %esi
+ popl %edi
+ end
+ else if (source<dest) then
+ { copy backward for overlapping }
+ asm
+ pushl %edi
+ pushl %esi
+ pushw %es
+ pushw %ds
+ std
+ movl count,%ecx
+ movl source,%esi
+ movl dest,%edi
+ movw dseg,%ax
+ movw %ax,%es
+ movw sseg,%ax
+ movw %ax,%ds
+ addl %ecx,%esi
+ addl %ecx,%edi
+ movl %ecx,%eax
+ andl $3,%ecx
+ orl %ecx,%ecx
+ jz .LSEG_MOVE1
+
+ { calculate esi and edi}
+ decl %esi
+ decl %edi
+ rep
+ movsb
+ incl %esi
+ incl %edi
+ .LSEG_MOVE1:
+ subl $4,%esi
+ subl $4,%edi
+ movl %eax,%ecx
+ shrl $2,%ecx
+ rep
+ movsl
+ cld
+ popw %ds
+ popw %es
+ popl %esi
+ popl %edi
+ end;
+ end;
+
+ procedure outportb(port : word;data : byte);
+
+ begin
+ asm
+ movw port,%dx
+ movb data,%al
+ outb %al,%dx
+ end ['EAX','EDX'];
+ end;
+
+ procedure outportw(port : word;data : word);
+
+ begin
+ asm
+ movw port,%dx
+ movw data,%ax
+ outw %ax,%dx
+ end ['EAX','EDX'];
+ end;
+
+ procedure outportl(port : word;data : longint);
+
+ begin
+ asm
+ movw port,%dx
+ movl data,%eax
+ outl %eax,%dx
+ end ['EAX','EDX'];
+ end;
+
+ function inportb(port : word) : byte;
+
+ begin
+ asm
+ movw port,%dx
+ inb %dx,%al
+ movb %al,__RESULT
+ end ['EAX','EDX'];
+ end;
+
+ function inportw(port : word) : word;
+
+ begin
+ asm
+ movw port,%dx
+ inw %dx,%ax
+ movw %ax,__RESULT
+ end ['EAX','EDX'];
+ end;
+
+ function inportl(port : word) : longint;
+
+ begin
+ asm
+ movw port,%dx
+ inl %dx,%eax
+ movl %eax,__RESULT
+ end ['EAX','EDX'];
+ end;
+
+
+
+ function get_cs : word;assembler;
+ asm
+ movw %cs,%ax
+ end;
+
+
+ function get_ss : word;assembler;
+ asm
+ movw %ss,%ax
+ end;
+
+
+ function get_ds : word;assembler;
+ asm
+ movw %ds,%ax
+ end;
+
+
+ function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x205,%eax
+ movb vector,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movw (%eax),%dx
+ movw 4(%eax),%cx
+ movl $0x201,%eax
+ movb vector,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x212,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl intaddr,%eax
+ movl (%eax),%edx
+ movw 4(%eax),%cx
+ movl $0x203,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl $0x210,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movl $0x202,%eax
+ movb e,%bl
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x204,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movb vector,%bl
+ movl $0x200,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl intaddr,%eax
+ movzwl %dx,%edx
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %ebx
+ end;
+ end;
+
+ function free_rm_callback(var intaddr : tseginfo) : boolean;
+ begin
+ asm
+ movl intaddr,%eax
+ movw (%eax),%dx
+ movw 4(%eax),%cx
+ movl $0x304,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ end;
+ end;
+
+ { here we must use ___v2prt0_ds_alias instead of from v2prt0.s
+ because the exception processor sets the ds limit to $fff
+ at hardware exceptions }
+
+//!!!! var
+//!!!! ___v2prt0_ds_alias : word; external name '___v2prt0_ds_alias';
+ var ___v2prt0_ds_alias : word;
+
+ function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl pm_func,%esi
+ movl reg,%edi
+ pushw %es
+ movw ___v2prt0_ds_alias,%ax
+ movw %ax,%es
+ pushw %ds
+ movw %cs,%ax
+ movw %ax,%ds
+ movl $0x303,%eax
+ int $0x31
+ popw %ds
+ popw %es
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl rmcb,%eax
+ movzwl %dx,%edx
+ movl %edx,(%eax)
+ movw %cx,4(%eax)
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function allocate_ldt_descriptors(count : word) : word;
+
+ begin
+ asm
+ movw count,%cx
+ xorl %eax,%eax
+ int $0x31
+ movw %ax,__RESULT
+ end;
+ end;
+
+ function free_ldt_descriptor(d : word) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movl $1,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function segment_to_descriptor(seg : word) : word;
+
+ begin
+ asm
+ pushl %ebx
+ movw seg,%bx
+ movl $2,%eax
+ int $0x31
+ movw %ax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_next_selector_increment_value : word;
+
+ begin
+ asm
+ movl $3,%eax
+ int $0x31
+ movw %ax,__RESULT
+ end;
+ end;
+
+ function get_segment_base_address(d : word) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movl $6,%eax
+ int $0x31
+ xorl %eax,%eax
+ movw %dx,%ax
+ shll $16,%ecx
+ orl %ecx,%eax
+ movl %eax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_page_size:longint;
+ begin
+ asm
+ pushl %ebx
+ movl $0x604,%eax
+ int $0x31
+ shll $16,%ebx
+ movw %cx,%bx
+ movl %ebx,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function request_linear_region(linearaddr, size : longint;
+ var blockhandle : longint) : boolean;
+ var
+ pageofs : longint;
+
+ begin
+ pageofs:=linearaddr and $3ff;
+ linearaddr:=linearaddr-pageofs;
+ size:=size+pageofs;
+ asm
+ pushl %esi
+ pushl %ebx
+ movl $0x504,%eax
+ movl linearaddr,%ebx
+ movl size,%ecx
+ movl $1,%edx
+ xorl %esi,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ movl blockhandle,%eax
+ movl %esi,(%eax)
+ movl %ebx,pageofs
+ popl %ebx
+ popl %esi
+ end;
+ if pageofs<>linearaddr then
+ request_linear_region:=false;
+ end;
+
+ function allocate_memory_block(size:longint):longint;
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ pushl %ebx
+ movl $0x501,%eax
+ movl size,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ andl $65535,%ecx
+ int $0x31
+ jnc .Lallocate_mem_block_err
+ xorl %ebx,%ebx
+ xorl %ecx,%ecx
+ .Lallocate_mem_block_err:
+ shll $16,%ebx
+ movw %cx,%bx
+ shll $16,%esi
+ movw %di,%si
+ movl %ebx,__RESULT
+ popl %ebx
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function free_memory_block(blockhandle : longint) : boolean;
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl blockhandle,%esi
+ movl %esi,%edi
+ shll $16,%esi
+ movl $0x502,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function lock_linear_region(linearaddr, size : longint) : boolean;
+
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ pushl %ebx
+ movl $0x600,%eax
+ movl linearaddr,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function lock_data(var data;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(@data)+get_segment_base_address(get_ds);
+ lock_data:=lock_linear_region(linearaddr,size);
+ end;
+
+ function lock_code(functionaddr : pointer;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+ lock_code:=lock_linear_region(linearaddr,size);
+ end;
+
+ function unlock_linear_region(linearaddr,size : longint) : boolean;
+
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ pushl %ebx
+ movl $0x601,%eax
+ movl linearaddr,%ecx
+ movl %ecx,%ebx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ function unlock_data(var data;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(@data)+get_segment_base_address(get_ds);
+ unlock_data:=unlock_linear_region(linearaddr,size);
+ end;
+
+ function unlock_code(functionaddr : pointer;size : longint) : boolean;
+
+ var
+ linearaddr : longint;
+ begin
+ if get_run_mode<>rm_dpmi then
+ exit;
+ linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+ unlock_code:=unlock_linear_region(linearaddr,size);
+ end;
+
+ function set_segment_base_address(d : word;s : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ leal s,%eax
+ movw (%eax),%dx
+ movw 2(%eax),%cx
+ movl $7,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_descriptor_access_right(d : word;w : word) : longint;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ movw w,%cx
+ movl $9,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movw %ax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function set_segment_limit(d : word;s : longint) : boolean;
+
+ begin
+ asm
+ pushl %ebx
+ movw d,%bx
+ leal s,%eax
+ movw (%eax),%dx
+ movw 2(%eax),%cx
+ movl $8,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movb %al,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_descriptor_access_right(d : word) : longint;
+
+ begin
+ asm
+ movzwl d,%eax
+ lar %eax,%eax
+ jz .L_ok
+ xorl %eax,%eax
+ .L_ok:
+ movl %eax,__RESULT
+ end;
+ end;
+ function get_segment_limit(d : word) : longint;
+
+ begin
+ asm
+ movzwl d,%eax
+ lsl %eax,%eax
+ jz .L_ok2
+ xorl %eax,%eax
+ .L_ok2:
+ movl %eax,__RESULT
+ end;
+ end;
+
+ function create_code_segment_alias_descriptor(seg : word) : word;
+
+ begin
+ asm
+ pushl %ebx
+ movw seg,%bx
+ movl $0xa,%eax
+ int $0x31
+ pushf
+ call test_int31
+ movw %ax,__RESULT
+ popl %ebx
+ end;
+ end;
+
+ function get_meminfo(var meminfo : tmeminfo) : boolean;
+
+ begin
+ asm
+ pushl %edi
+ movl meminfo,%edi
+ movl $0x500,%eax
+ int $0x31
+ pushf
+ movb %al,__RESULT
+ call test_int31
+ popl %edi
+ end;
+ end;
+
+ function get_linear_addr(phys_addr : longint;size : longint) : longint;
+
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ pushl %ebx
+ movl phys_addr,%ebx
+ movl %ebx,%ecx
+ shrl $16,%ebx
+ movl size,%esi
+ movl %esi,%edi
+ shrl $16,%esi
+ movl $0x800,%eax
+ int $0x31
+ pushf
+ call test_int31
+ shll $16,%ebx
+ movw %cx,%bx
+ movl %ebx,__RESULT
+ popl %ebx
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+ procedure disable;assembler;
+
+ asm
+ cli
+ end;
+
+ procedure enable;assembler;
+
+ asm
+ sti
+ end;
+
+
+// var
+// _run_mode : word;external name '_run_mode';
+
+ function get_run_mode : word;
+
+ begin
+// get_run_mode:=_run_mode; !!!!!!!!!!
+ get_run_mode:=rm_unknown;
+ end;
+
+ function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ pushl %ebx
+ movl device,%edx
+ movl handle,%esi
+ movl offset,%ebx
+ movl pagecount,%ecx
+ movl $0x0508,%eax
+ int $0x31
+ pushf
+ setnc %al
+ movb %al,__RESULT
+ call test_int31
+ popl %ebx
+ popl %edi
+ popl %esi
+ end;
+ end;
+
+{*****************************************************************************
+ Transfer Buffer
+*****************************************************************************}
+
+ procedure copytodos(var addr; len : longint);
+ begin
+ if len>tb_size then
+ runerror(217);
+ seg_move(get_ds,longint(@addr),dosmemselector,tb,len);
+ end;
+
+
+ procedure copyfromdos(var addr; len : longint);
+ begin
+ if len>tb_size then
+ runerror(217);
+ seg_move(dosmemselector,tb,get_ds,longint(@addr),len);
+ end;
+
+
+begin
+ int31error:=0;
+ dosmemselector:=get_ds;
+end.
+
+{
+ $Log: watcom.pp,v $
+ Revision 1.5 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/Makefile b/rtl/win32/Makefile
new file mode 100644
index 0000000000..fda725b07a
--- /dev/null
+++ b/rtl/win32/Makefile
@@ -0,0 +1,2036 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/05/05]
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd arm-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override OS_TARGET_DEFAULT=win32
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=rtl
+PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+WININC=wininc
+UNITPREFIX=rtl
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+PRT0=wprt0
+else
+SYSTEMUNIT=syswin32
+PRT0=wprt0_10
+endif
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+include $(WININC)/makefile.inc
+WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconsts sysconst sysutils math types strutils convutils dateutils varutils variants typinfo classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard winsysut
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
+endif
+override INSTALL_FPCPACKAGE=y
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-openbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+override COMPILER_SOURCEDIR+=$(INC) $(PROCINC)
+endif
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+STATICLIBPREFIX=libp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.asm
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+else
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1
+else
+FPCCPUOPT:=
+endif
+endif
+override FPCOPT+=-Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-OG2p3
+endif
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+ifeq ($(FPC_VERSION),1.0.6)
+override FPCOPTDEF+=HASUNIX
+endif
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_loaders
+ifneq ($(TARGET_LOADERS),)
+override ALLTARGET+=fpc_loaders
+override CLEANTARGET+=fpc_loaders_clean
+override INSTALLTARGET+=fpc_loaders_install
+override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))
+endif
+%$(OEXT): %$(LOADEREXT)
+ifdef COMPILER_UNITTARGETDIR
+ $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<
+else
+ $(AS) -o $*$(OEXT) $<
+endif
+fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)
+fpc_loaders_clean:
+ifdef COMPILER_UNITTARGETDIR
+ -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES))
+else
+ -$(DEL) $(LOADEROFILES)
+endif
+fpc_loaders_install:
+ $(MKDIR) $(INSTALL_UNITDIR)
+ifdef COMPILER_UNITTARGETDIR
+ $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR)
+else
+ $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+ @$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+ $(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+ $(MAKE) all DEBUG=1
+fpc_release:
+ $(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+ $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+ $(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(PPUEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pp
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.pas
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.lpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%$(EXEEXT): %.dpr
+ $(COMPILER) $<
+ $(EXECPPAS)
+%.res: %.rc
+ windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+ $(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+ -$(UPXPROG) $(INSTALLEXEFILES)
+endif
+ $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+ $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+ $(MKDIR) $(INSTALL_UNITDIR)
+ $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+ $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+ $(MKDIR) $(INSTALL_LIBDIR)
+ $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+ ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+ $(MKDIR) $(INSTALL_DATADIR)
+ $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+ $(MKDIR) $(INSTALL_SOURCEDIR)
+ $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+ $(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+ $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+ -$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+ -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+ -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+ -$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+ -$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+ -$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+ -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ -$(DELTREE) units
+ -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+ -$(DEL) *.o *.ppu *.a
+endif
+ -$(DELTREE) *$(SMARTEXT)
+ -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+ -$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+ -$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+ -$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+ @$(ECHO)
+ @$(ECHO) == Package info ==
+ @$(ECHO) Package Name..... $(PACKAGE_NAME)
+ @$(ECHO) Package Version.. $(PACKAGE_VERSION)
+ @$(ECHO)
+ @$(ECHO) == Configuration info ==
+ @$(ECHO)
+ @$(ECHO) FPC.......... $(FPC)
+ @$(ECHO) FPC Version.. $(FPC_VERSION)
+ @$(ECHO) Source CPU... $(CPU_SOURCE)
+ @$(ECHO) Target CPU... $(CPU_TARGET)
+ @$(ECHO) Source OS.... $(OS_SOURCE)
+ @$(ECHO) Target OS.... $(OS_TARGET)
+ @$(ECHO) Full Source.. $(FULL_SOURCE)
+ @$(ECHO) Full Target.. $(FULL_TARGET)
+ @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
+ @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
+ @$(ECHO)
+ @$(ECHO) == Directory info ==
+ @$(ECHO)
+ @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
+ @$(ECHO)
+ @$(ECHO) Basedir......... $(BASEDIR)
+ @$(ECHO) FPCDir.......... $(FPCDIR)
+ @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
+ @$(ECHO) UnitsDir........ $(UNITSDIR)
+ @$(ECHO) PackagesDir..... $(PACKAGESDIR)
+ @$(ECHO)
+ @$(ECHO) GCC library..... $(GCCLIBDIR)
+ @$(ECHO) Other library... $(OTHERLIBDIR)
+ @$(ECHO)
+ @$(ECHO) == Tools info ==
+ @$(ECHO)
+ @$(ECHO) As........ $(AS)
+ @$(ECHO) Ld........ $(LD)
+ @$(ECHO) Ar........ $(AR)
+ @$(ECHO) Rc........ $(RC)
+ @$(ECHO)
+ @$(ECHO) Mv........ $(MVPROG)
+ @$(ECHO) Cp........ $(CPPROG)
+ @$(ECHO) Rm........ $(RMPROG)
+ @$(ECHO) GInstall.. $(GINSTALL)
+ @$(ECHO) Echo...... $(ECHO)
+ @$(ECHO) Shell..... $(SHELL)
+ @$(ECHO) Date...... $(DATE)
+ @$(ECHO) FPCMake... $(FPCMAKE)
+ @$(ECHO) PPUMove... $(PPUMOVE)
+ @$(ECHO) Upx....... $(UPXPROG)
+ @$(ECHO) Zip....... $(ZIPPROG)
+ @$(ECHO)
+ @$(ECHO) == Object info ==
+ @$(ECHO)
+ @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
+ @$(ECHO) Target Units.......... $(TARGET_UNITS)
+ @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
+ @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
+ @$(ECHO) Target Dirs........... $(TARGET_DIRS)
+ @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
+ @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+ @$(ECHO)
+ @$(ECHO) Clean Units......... $(CLEAN_UNITS)
+ @$(ECHO) Clean Files......... $(CLEAN_FILES)
+ @$(ECHO)
+ @$(ECHO) Install Units....... $(INSTALL_UNITS)
+ @$(ECHO) Install Files....... $(INSTALL_FILES)
+ @$(ECHO)
+ @$(ECHO) == Install info ==
+ @$(ECHO)
+ @$(ECHO) DateStr.............. $(DATESTR)
+ @$(ECHO) ZipName.............. $(ZIPNAME)
+ @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
+ @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+ @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
+ @$(ECHO) FullZipName.......... $(FULLZIPNAME)
+ @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
+ @$(ECHO)
+ @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
+ @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
+ @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
+ @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
+ @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
+ @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
+ @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
+ @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
+ @$(ECHO)
+ @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
+ @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
+ @$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+ fpc_makefile_dirs
+fpc_makefile:
+ $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+ $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared:
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall:
+zipinstall:
+zipsourceinstall:
+zipexampleinstall:
+zipdistinstall:
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+wprt0$(OEXT) : $(PRT0).as
+ $(AS) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(PRT0).as
+gprt0$(OEXT) : gprt0.as
+wdllprt0$(OEXT) : wdllprt0.as
+wcygprt0$(OEXT) : wcygprt0.as
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(WININC) windows.pp
+messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(WININC) messages.pp
+opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(INC)/sockets.inc $(INC)/socketsh.inc
+initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
+wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
+winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS)
+ $(COMPILER) -I$(GRAPHDIR) graph.pp
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT)
+ $(COMPILER) winsysut.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) varutils.pp
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT)
diff --git a/rtl/win32/Makefile.fpc b/rtl/win32/Makefile.fpc
new file mode 100644
index 0000000000..742027f8e5
--- /dev/null
+++ b/rtl/win32/Makefile.fpc
@@ -0,0 +1,246 @@
+#
+# Makefile.fpc for Free Pascal Win32 RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=wprt0 wdllprt0 gprt0 wcygprt0
+units=$(SYSTEMUNIT) ctypes objpas macpas strings \
+ lineinfo heaptrc matrix \
+ windows winsock initc cmem dynlibs signals \
+ dos crt objects graph messages \
+ rtlconsts sysconst sysutils math types \
+ strutils convutils dateutils varutils variants typinfo classes \
+ cpu mmx charset ucomplex getopts \
+ wincrt winmouse winevent sockets printer \
+ video mouse keyboard \
+ winsysut
+
+rsts=math varutils typinfo variants classes dateutils sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=win32
+
+[compiler]
+includedir=$(INC) $(PROCINC)
+sourcedir=$(INC) $(PROCINC)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+WININC=wininc
+
+UNITPREFIX=rtl
+
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+PRT0=wprt0
+else
+SYSTEMUNIT=syswin32
+PRT0=wprt0_10
+endif
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+# Files used by windows.pp
+include $(WININC)/makefile.inc
+
+WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
+
+
+[rules]
+SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
+
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Loaders
+#
+
+wprt0$(OEXT) : $(PRT0).as
+ $(AS) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(PRT0).as
+
+gprt0$(OEXT) : gprt0.as
+
+wdllprt0$(OEXT) : wdllprt0.as
+
+wcygprt0$(OEXT) : wcygprt0.as
+
+#
+# System Units (System, Objpas, Strings)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS)
+ $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
+ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
+ $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# System Dependent Units
+#
+
+windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(WININC) windows.pp
+
+messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -I$(WININC) messages.pp
+
+opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(INC)/sockets.inc $(INC)/socketsh.inc
+
+initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
+
+wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
+
+winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
+
+objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Graph
+#
+
+include $(GRAPHDIR)/makefile.inc
+GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
+
+graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+ $(GRAPHINCDEPS)
+ $(COMPILER) -I$(GRAPHDIR) graph.pp
+
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+ objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+ sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT)
+ $(COMPILER) winsysut.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+ $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/math.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+ $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
+ $(COMPILER) -Fi$(OBJPASDIR) varutils.pp
+
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
+ $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/types.pp
+
+rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp
+ $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
+ $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/macpas.pp $(REDIR)
+
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) -Sg $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT)
diff --git a/rtl/win32/classes.pp b/rtl/win32/classes.pp
new file mode 100644
index 0000000000..01032f83de
--- /dev/null
+++ b/rtl/win32/classes.pp
@@ -0,0 +1,64 @@
+{
+ $Id: classes.pp,v 1.10 2005/04/09 07:23:07 florian Exp $
+ This file is part of the Free Component Library (FCL)
+ Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+ Classes unit for win32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+ rtlconsts,
+ sysutils,
+ types,
+ typinfo,
+ windows;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+ sysconst;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+initialization
+ CommonInit;
+
+finalization
+ CommonCleanup;
+end.
+{
+ $Log: classes.pp,v $
+ Revision 1.10 2005/04/09 07:23:07 florian
+ * applied Jesus Reyes win32 crash fixed
+
+ Revision 1.9 2005/03/07 17:57:26 peter
+ * renamed rtlconst to rtlconsts
+
+ Revision 1.8 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.7 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/win32/crt.pp b/rtl/win32/crt.pp
new file mode 100644
index 0000000000..e2c908abca
--- /dev/null
+++ b/rtl/win32/crt.pp
@@ -0,0 +1,841 @@
+{
+ $Id: crt.pp,v 1.24 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Borland Pascal 7 Compatible CRT Unit - win32 implentation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit crt;
+
+interface
+
+{$i crth.inc}
+
+procedure Window32(X1,Y1,X2,Y2: DWord);
+procedure GotoXY32(X,Y: DWord);
+function WhereX32: DWord;
+function WhereY32: DWord;
+
+implementation
+
+uses
+ windows;
+
+var
+ SaveCursorSize: Longint;
+
+
+{
+ definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
+
+{****************************************************************************
+ Low level Routines
+****************************************************************************}
+
+procedure TurnMouseOff;
+var Mode: DWORD;
+begin
+ if GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), @Mode) then begin { Turn the mouse-cursor off }
+ Mode := Mode AND cardinal(NOT enable_processed_input)
+ AND cardinal(NOT enable_mouse_input);
+
+ SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), Mode);
+ end; { if }
+end; { proc. TurnMouseOff }
+
+function GetScreenHeight : DWord;
+var
+ ConsoleInfo: TConsoleScreenBufferinfo;
+begin
+ if (not GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo)) then begin
+{$ifdef SYSTEMDEBUG}
+ Writeln(stderr,'GetScreenHeight failed GetLastError returns ',GetLastError);
+ Halt(1);
+{$endif SYSTEMDEBUG}
+ // ts: this is really silly assumption; imho better: issue a halt
+ GetScreenHeight:=25;
+ end else
+ GetScreenHeight := ConsoleInfo.dwSize.Y;
+end; { func. GetScreenHeight }
+
+function GetScreenWidth : DWord;
+var
+ ConsoleInfo: TConsoleScreenBufferInfo;
+begin
+ if (not GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo)) then begin
+{$ifdef SYSTEMDEBUG}
+ Writeln(stderr,'GetScreenWidth failed GetLastError returns ',GetLastError);
+ Halt(1);
+{$endif SYSTEMDEBUG}
+ // ts: this is really silly assumption; imho better: issue a halt
+ GetScreenWidth:=80;
+ end else
+ GetScreenWidth := ConsoleInfo.dwSize.X;
+end; { func. GetScreenWidth }
+
+
+procedure GetScreenCursor(var x : DWord; var y : DWord);
+var
+ ConsoleInfo : TConsoleScreenBufferInfo;
+begin
+ FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
+ GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
+ X := ConsoleInfo.dwCursorPosition.X + 1;
+ Y := ConsoleInfo.dwCursorPosition.Y + 1;
+end;
+
+procedure SetScreenCursor(x,y : DWord);
+var
+ CurInfo: TCoord;
+begin
+ FillChar(Curinfo, SizeOf(Curinfo), 0);
+ CurInfo.X := X - 1;
+ CurInfo.Y := Y - 1;
+ SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), CurInfo);
+end;
+
+{****************************************************************************
+ Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+begin
+ {!!! Not done yet !!! }
+end;
+
+Procedure TextColor(Color: Byte);
+{ Switch foregroundcolor }
+Begin
+ TextAttr:=(Color and $8f) or (TextAttr and $70);
+End;
+
+Procedure TextBackground(Color: Byte);
+{ Switch backgroundcolor }
+Begin
+ TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+End;
+
+Procedure HighVideo;
+{ Set highlighted output. }
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+Procedure LowVideo;
+{ Set normal output }
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+Procedure NormVideo;
+{ Set normal back and foregroundcolors. }
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+Procedure GotoXY(X: Byte; Y: Byte);
+
+begin
+ GotoXY32(X,Y);
+end;
+
+Procedure GotoXY32(X: DWord; Y: DWord);
+
+{ Go to coordinates X,Y in the current window. }
+Begin
+ If (X > 0) and (X <= (WindMaxX - WindMinX + 1)) and
+ (Y > 0) and (Y <= (WindMaxY - WindMinY + 1)) Then Begin
+ Inc(X, WindMinX - 1);
+ Inc(Y, WindMinY - 1);
+ SetScreenCursor(x,y);
+ End;
+End;
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+
+begin
+ Window32(X1,Y1,X2,Y2);
+end;
+
+Procedure Window32(X1, Y1, X2, Y2: DWord);
+{
+ Set screen window to the specified coordinates.
+}
+Begin
+ if (X1 > X2) or (X2 > GetScreenWidth) or
+ (Y1 > Y2) or (Y2 > GetScreenHeight) then
+ exit;
+ WindMinY := Y1;
+ WindMaxY := Y2;
+ WindMinX := X1;
+ WindMaxX := X2;
+ WindMin:=((Y1-1) Shl 8)+(X1-1);
+ WindMax:=((Y2-1) Shl 8)+(X2-1);
+ GotoXY(1, 1);
+End;
+
+procedure ClrScr;
+var
+ DestCoor: TCoord;
+ numChars, x : DWord;
+begin
+ DestCoor.X := WindMinX - 1;
+ DestCoor.Y := WindMinY - 1;
+ numChars := (WindMaxX - WindMinX + 1);
+
+ repeat
+ FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), TextAttr,
+ numChars, DestCoor, x);
+ FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), #32,
+ numChars, DestCoor, x);
+ inc(DestCoor.Y);
+ until DWord(DestCoor.Y)=WindMaxY;
+
+ GotoXY(1, 1);
+end; { proc. ClrScr }
+
+
+procedure ClrEol;
+{
+ Clear from current position to end of line.
+}
+var
+ Temp: DWord;
+ CharInfo: Char;
+ Coord: TCoord;
+ X,Y: DWord;
+begin
+ GetScreenCursor(x, y);
+
+ CharInfo := #32;
+ Coord.X := X - 1;
+ Coord.Y := Y - 1;
+
+ FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), CharInfo, WindMaxX - X + 1,
+ Coord, @Temp);
+ FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), TextAttr, WindMaxX - X + 1,
+ Coord, @Temp);
+end;
+
+Function WhereX: Byte;
+
+
+begin
+ WhereX:=WhereX32 mod 256;
+end;
+
+Function WhereX32: DWord;
+{
+ Return current X-position of cursor.
+}
+var
+ x,y : DWord;
+Begin
+ GetScreenCursor(x, y);
+ WhereX32:= x - WindMinX +1;
+End;
+
+Function WhereY: Byte;
+
+begin
+ WhereY:=WhereY32 mod 256;
+end;
+
+Function WhereY32: DWord;
+{
+ Return current Y-position of cursor.
+}
+var
+ x, y : DWord;
+Begin
+ GetScreenCursor(x, y);
+ WhereY32:= y - WindMinY + 1;
+End;
+
+
+{*************************************************************************
+ KeyBoard
+*************************************************************************}
+
+var
+ ScanCode : char;
+ SpecialKey : boolean;
+ DoingNumChars: Boolean;
+ DoingNumCode: Byte;
+
+Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte; keycode:longint): byte;
+ { Several remappings of scancodes are necessary to comply with what
+ we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
+ are excluded }
+var
+ AltKey, CtrlKey, ShiftKey: boolean;
+const
+ {
+ Keypad key scancodes:
+
+ Ctrl Norm
+
+ $77 $47 - Home
+ $8D $48 - Up arrow
+ $84 $49 - PgUp
+ $8E $4A - -
+ $73 $4B - Left Arrow
+ $8F $4C - 5
+ $74 $4D - Right arrow
+ $4E $4E - +
+ $75 $4F - End
+ $91 $50 - Down arrow
+ $76 $51 - PgDn
+ $92 $52 - Ins
+ $93 $53 - Del
+ }
+ CtrlKeypadKeys: array[$47..$53] of byte =
+ ($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);
+
+begin
+ AltKey := ((CtrlKeyState AND
+ (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
+ CtrlKey := ((CtrlKeyState AND
+ (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
+ ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);
+
+ if AltKey then
+ begin
+ case ScanCode of
+ // Digits, -, =
+ $02..$0D: inc(ScanCode, $76);
+ // Function keys
+ $3B..$44: inc(Scancode, $2D);
+ $57..$58: inc(Scancode, $34);
+ // Extended cursor block keys
+ $47..$49, $4B, $4D, $4F..$53:
+ inc(Scancode, $50);
+ // Other keys
+ $1C: Scancode := $A6; // Enter
+ $35: Scancode := $A4; // / (keypad and normal!)
+ end
+ end
+ else if CtrlKey then
+ case Scancode of
+ // Tab key
+ $0F: Scancode := $94;
+ // Function keys
+ $3B..$44: inc(Scancode, $23);
+ $57..$58: inc(Scancode, $32);
+ // Keypad keys
+ $35: Scancode := $95; // \
+ $37: Scancode := $96; // *
+ $47..$53: Scancode := CtrlKeypadKeys[Scancode];
+ end
+ else if ShiftKey then
+ case Scancode of
+ // Function keys
+ $3B..$44: inc(Scancode, $19);
+ $57..$58: inc(Scancode, $30);
+ end
+ else
+ case Scancode of
+ // Function keys
+ $57..$58: inc(Scancode, $2E); // F11 and F12
+ end;
+ RemapScanCode := ScanCode;
+end;
+
+
+function KeyPressed : boolean;
+var
+ nevents,nread : dword;
+ buf : TINPUTRECORD;
+ AltKey: Boolean;
+ c : longint;
+begin
+ KeyPressed := FALSE;
+ if ScanCode <> #0 then
+ KeyPressed := TRUE
+ else
+ begin
+ GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
+ while nevents>0 do
+ begin
+ ReadConsoleInputA(TextRec(input).Handle,buf,1,nread);
+ if buf.EventType = KEY_EVENT then
+ if buf.Event.KeyEvent.bKeyDown then
+ begin
+ { Alt key is VK_MENU }
+ { Capslock key is VK_CAPITAL }
+
+ AltKey := ((Buf.Event.KeyEvent.dwControlKeyState AND
+ (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
+ if not(Buf.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT, VK_MENU, VK_CONTROL,
+ VK_CAPITAL, VK_NUMLOCK,
+ VK_SCROLL]) then
+ begin
+ keypressed:=true;
+
+ if (ord(buf.Event.KeyEvent.AsciiChar) = 0) or
+ (buf.Event.KeyEvent.dwControlKeyState and (LEFT_ALT_PRESSED or ENHANCED_KEY) > 0) then
+ begin
+ SpecialKey := TRUE;
+ ScanCode := Chr(RemapScanCode(Buf.Event.KeyEvent.wVirtualScanCode, Buf.Event.KeyEvent.dwControlKeyState,
+ Buf.Event.KeyEvent.wVirtualKeyCode));
+ end
+ else
+ begin
+ { Map shift-tab }
+ if (buf.Event.KeyEvent.AsciiChar=#9) and
+ (buf.Event.KeyEvent.dwControlKeyState and SHIFT_PRESSED > 0) then
+ begin
+ SpecialKey := TRUE;
+ ScanCode := #15;
+ end
+ else
+ begin
+ SpecialKey := FALSE;
+ ScanCode := Chr(Ord(buf.Event.KeyEvent.AsciiChar));
+ end;
+ end;
+
+ if AltKey then
+ begin
+ case Buf.Event.KeyEvent.wVirtualScanCode of
+ 71 : c:=7;
+ 72 : c:=8;
+ 73 : c:=9;
+ 75 : c:=4;
+ 76 : c:=5;
+ 77 : c:=6;
+ 79 : c:=1;
+ 80 : c:=2;
+ 81 : c:=3;
+ 82 : c:=0;
+ else
+ break;
+ end;
+ DoingNumChars := true;
+ DoingNumCode := Byte((DoingNumCode * 10) + c);
+ Keypressed := false;
+ Specialkey := false;
+ ScanCode := #0;
+ end
+ else
+ break;
+ end;
+ end
+ else
+ begin
+ if (Buf.Event.KeyEvent.wVirtualKeyCode in [VK_MENU]) then
+ if DoingNumChars then
+ if DoingNumCode > 0 then
+ begin
+ ScanCode := Chr(DoingNumCode);
+ Keypressed := true;
+
+ DoingNumChars := false;
+ DoingNumCode := 0;
+ break
+ end; { if }
+ end;
+ { if we got a key then we can exit }
+ if keypressed then
+ exit;
+ GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
+ end;
+ end;
+end;
+
+
+function ReadKey: char;
+begin
+ while (not KeyPressed) do
+ Sleep(1);
+ if SpecialKey then begin
+ ReadKey := #0;
+ SpecialKey := FALSE;
+ end else begin
+ ReadKey := ScanCode;
+ ScanCode := #0;
+ end;
+end;
+
+
+{*************************************************************************
+ Delay
+*************************************************************************}
+
+procedure Delay(MS: Word);
+begin
+ Sleep(ms);
+end; { proc. Delay }
+
+
+procedure sound(hz : word);
+begin
+ MessageBeep(0); { lame ;-) }
+end;
+
+
+procedure nosound;
+begin
+end;
+
+
+{****************************************************************************
+ HighLevel Crt Functions
+****************************************************************************}
+procedure removeline(y : DWord);
+var
+ ClipRect: TSmallRect;
+ SrcRect: TSmallRect;
+ DestCoor: TCoord;
+ CharInfo: TCharInfo;
+begin
+ CharInfo.UnicodeChar := #32;
+ CharInfo.Attributes := TextAttr;
+
+ Y := (WindMinY - 1) + (Y - 1) + 1;
+
+ SrcRect.Top := Y;
+ SrcRect.Left := WindMinX - 1;
+ SrcRect.Right := WindMaxX - 1;
+ SrcRect.Bottom := WindMaxY - 1;
+
+ DestCoor.X := WindMinX - 1;
+ DestCoor.Y := Y - 1;
+
+ ClipRect := SrcRect;
+ cliprect.top := destcoor.y;
+
+ ScrollConsoleScreenBuffer(GetStdHandle(STD_OUTPUT_HANDLE), SrcRect, ClipRect,
+ DestCoor, CharInfo);
+end; { proc. RemoveLine }
+
+
+procedure delline;
+begin
+ removeline(wherey);
+end; { proc. DelLine }
+
+
+procedure insline;
+var
+ ClipRect: TSmallRect;
+ SrcRect: TSmallRect;
+ DestCoor: TCoord;
+ CharInfo: TCharInfo;
+ X,Y: DWord;
+begin
+ GetScreenCursor(X, Y);
+
+ CharInfo.UnicodeChar := #32;
+ CharInfo.Attributes := TextAttr;
+
+ SrcRect.Top := Y - 1;
+ SrcRect.Left := WindMinX - 1;
+ SrcRect.Right := WindMaxX - 1;
+ SrcRect.Bottom := WindMaxY - 1 + 1;
+
+ DestCoor.X := WindMinX - 1;
+ DestCoor.Y := Y;
+ ClipRect := SrcRect;
+ ClipRect.Bottom := WindMaxY - 1;
+
+ ScrollConsoleScreenBuffer(GetStdHandle(STD_OUTPUT_HANDLE), SrcRect, ClipRect,
+ DestCoor, CharInfo);
+end; { proc. InsLine }
+
+
+{****************************************************************************
+ Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+var CursorInfo: TConsoleCursorInfo;
+begin
+ GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+ CursorInfo.dwSize := SaveCursorSize;
+ CursorInfo.bVisible := true;
+ SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+end;
+
+
+procedure cursoroff;
+var CursorInfo: TConsoleCursorInfo;
+begin
+ GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+ CursorInfo.bVisible := false;
+ SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+end;
+
+
+procedure cursorbig;
+var CursorInfo: TConsoleCursorInfo;
+begin
+ GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+ CursorInfo.dwSize := 93;
+ CursorInfo.bVisible := true;
+ SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+end;
+
+
+{*****************************************************************************
+ Read and Write routines
+*****************************************************************************}
+
+var
+ CurrX, CurrY : DWord;
+
+procedure WriteChar(c : char);
+var
+ WritePos: Coord; { Upper-left cell to write from }
+ numWritten : DWord;
+ WinAttr : word;
+begin
+ Case C of
+ #10 : begin
+ Inc(CurrY);
+ end;
+ #13 : begin
+ CurrX := WindMinX;
+ end; { if }
+ #08 : begin
+ if CurrX > WindMinX then Dec(CurrX);
+ end; { ^H }
+ #07 : begin
+ //MessagBeep(0);
+ end; { ^G }
+ else begin
+ WritePos.X := currX - 1;
+ WritePos.Y := currY - 1;
+
+ WriteConsoleOutputCharacter(GetStdhandle(STD_OUTPUT_HANDLE),
+ @c, 1, writePos, numWritten);
+
+ WinAttr:=TextAttr;
+ WriteConsoleOutputAttribute(GetStdhandle(STD_OUTPUT_HANDLE),
+ @WinAttr, 1, writePos, numWritten);
+
+ Inc(CurrX);
+ end; { else }
+ end; { case }
+ if CurrX > WindMaxX then begin
+ CurrX := WindMinX;
+ Inc(CurrY);
+ end; { if }
+ While CurrY > WindMaxY do begin
+ RemoveLine(1);
+ Dec(CurrY);
+ end; { while }
+end;
+
+Function CrtWrite(var f : textrec) : integer;
+var
+ i : longint;
+begin
+ GetScreenCursor(CurrX, CurrY);
+
+ for i:=0 to f.bufpos-1 do
+ WriteChar(f.buffer[i]);
+ SetScreenCursor(CurrX, CurrY);
+
+ f.bufpos:=0;
+ CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+ procedure BackSpace;
+ begin
+ if (f.bufpos>0) and (f.bufpos=f.bufend) then begin
+ WriteChar(#8);
+ WriteChar(' ');
+ WriteChar(#8);
+ dec(f.bufpos);
+ dec(f.bufend);
+ end;
+ end;
+
+var
+ ch : Char;
+Begin
+ GetScreenCursor(CurrX,CurrY);
+ f.bufpos:=0;
+ f.bufend:=0;
+ repeat
+ if f.bufpos>f.bufend then
+ f.bufend:=f.bufpos;
+ SetScreenCursor(CurrX,CurrY);
+ ch:=readkey;
+ case ch of
+ #0 : case readkey of
+ #71 : while f.bufpos>0 do begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #75 : if f.bufpos>0 then begin
+ dec(f.bufpos);
+ WriteChar(#8);
+ end;
+ #77 : if f.bufpos<f.bufend then begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #79 : while f.bufpos<f.bufend do begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ #28: begin // numpad enter
+ WriteChar(#13);
+ WriteChar(#10);
+ f.bufptr^[f.bufend]:=#13;
+ f.bufptr^[f.bufend+1]:=#10;
+ inc(f.bufend,2);
+ break;
+ end;
+ #53: begin
+ ch:='/';
+ if f.bufpos<f.bufsize-2 then begin
+ f.buffer[f.bufpos]:=ch;
+ inc(f.bufpos);
+ WriteChar(ch);
+ end;
+ end;
+ end;
+ ^S,
+ #8 : BackSpace;
+ ^Y,
+ #27 : begin
+ while f.bufpos<f.bufend do begin
+ WriteChar(f.bufptr^[f.bufpos]);
+ inc(f.bufpos);
+ end;
+ while f.bufend>0 do
+ BackSpace;
+ end;
+ #13 : begin
+ WriteChar(#13);
+ WriteChar(#10);
+ f.bufptr^[f.bufend]:=#13;
+ f.bufptr^[f.bufend+1]:=#10;
+ inc(f.bufend,2);
+ break;
+ end;
+ #26 : if CheckEOF then begin
+ f.bufptr^[f.bufend]:=#26;
+ inc(f.bufend);
+ break;
+ end;
+ else begin
+ if f.bufpos<f.bufsize-2 then begin
+ f.buffer[f.bufpos]:=ch;
+ inc(f.bufpos);
+ WriteChar(ch);
+ end;
+ end;
+ end;
+ until false;
+ f.bufpos:=0;
+ SetScreenCursor(CurrX, CurrY);
+ CrtRead:=0;
+End;
+
+
+Function CrtReturn(Var F:TextRec):Integer;
+Begin
+ CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+ If F.Mode=fmOutput Then begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end Else begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+var
+ CursorInfo : TConsoleCursorInfo;
+ ConsoleInfo : TConsoleScreenBufferinfo;
+
+// ts
+begin
+ { Initialize the output handles }
+ LastMode := 3;
+
+ SetActiveWindow(0);
+
+ {--------------------- Get the cursor size and such -----------------------}
+ FillChar(CursorInfo, SizeOf(CursorInfo), 00);
+ GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
+ SaveCursorSize := CursorInfo.dwSize;
+
+ {------------------ Get the current cursor position and attr --------------}
+ FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
+ GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
+
+ TextAttr := ConsoleInfo.wAttributes;
+
+ { Not required, the dos crt does also not touch the mouse }
+ {TurnMouseOff;}
+
+ WindMinX := (ConsoleInfo.srWindow.Left) + 1;
+ WindMinY := (ConsoleInfo.srWindow.Top) + 1;
+ WindMaxX := (ConsoleInfo.srWindow.Right) + 1;
+ WindMaxY := (ConsoleInfo.srWindow.Bottom) + 1;
+
+ DoingNumChars := false;
+ DoingNumCode := 0;
+
+ { Redirect the standard output }
+ AssignCrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:= GetStdHandle(STD_OUTPUT_HANDLE);
+
+ AssignCrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:= GetStdHandle(STD_INPUT_HANDLE);
+end. { unit Crt }
+
+{
+ $Log: crt.pp,v $
+ Revision 1.24 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.23 2005/01/03 18:16:12 peter
+ fix clrscr with windowsize<>screensize
+ fix cursorbig
+
+}
diff --git a/rtl/win32/dos.pp b/rtl/win32/dos.pp
new file mode 100644
index 0000000000..f8e95bae2c
--- /dev/null
+++ b/rtl/win32/dos.pp
@@ -0,0 +1,820 @@
+{
+ $Id: dos.pp,v 1.30 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by the Free Pascal development team.
+
+ Dos unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+interface
+
+Const
+ Max_Path = 260;
+
+Type
+ TWin32Handle = longint;
+
+ PWin32FileTime = ^TWin32FileTime;
+ TWin32FileTime = record
+ dwLowDateTime,
+ dwHighDateTime : DWORD;
+ end;
+
+ PWin32FindData = ^TWin32FindData;
+ TWin32FindData = record
+ dwFileAttributes: Cardinal;
+ ftCreationTime: TWin32FileTime;
+ ftLastAccessTime: TWin32FileTime;
+ ftLastWriteTime: TWin32FileTime;
+ nFileSizeHigh: Cardinal;
+ nFileSizeLow: Cardinal;
+ dwReserved0: Cardinal;
+ dwReserved1: Cardinal;
+ cFileName: array[0..MAX_PATH - 1] of Char;
+ cAlternateFileName: array[0..13] of Char;
+ // The structure should be 320 bytes long...
+ pad : system.integer;
+ end;
+
+ Searchrec = Packed Record
+ FindHandle : TWin32Handle;
+ W32FindData : TWin32FindData;
+ ExcludeAttr : longint;
+ time : longint;
+ size : longint;
+ attr : longint;
+ name : string;
+ end;
+
+{$i dosh.inc}
+
+Const
+ { allow EXEC to inherited handles from calling process,
+ needed for FPREDIR in ide/text
+ now set to true by default because
+ other OS also pass open handles to childs
+ finally reset to false after Florian's response PM }
+ ExecInheritsHandles : Longbool = false;
+
+
+implementation
+
+uses
+ strings;
+
+{$DEFINE HAS_GETMSCOUNT}
+{$DEFINE HAS_GETSHORTNAME}
+{$DEFINE HAS_GETLONGNAME}
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+{$I dos.inc}
+
+const
+ INVALID_HANDLE_VALUE = longint($ffffffff);
+
+ VER_PLATFORM_WIN32s = 0;
+ VER_PLATFORM_WIN32_WINDOWS = 1;
+ VER_PLATFORM_WIN32_NT = 2;
+
+type
+ OSVERSIONINFO = record
+ dwOSVersionInfoSize : DWORD;
+ dwMajorVersion : DWORD;
+ dwMinorVersion : DWORD;
+ dwBuildNumber : DWORD;
+ dwPlatformId : DWORD;
+ szCSDVersion : array[0..127] of char;
+ end;
+
+var
+ versioninfo : OSVERSIONINFO;
+ kernel32dll : TWin32Handle;
+
+{******************************************************************************
+ --- Conversion ---
+******************************************************************************}
+
+ function GetLastError : DWORD;
+ stdcall; external 'kernel32' name 'GetLastError';
+ function FileTimeToDosDateTime(const ft :TWin32FileTime;var data,time : word) : longbool;
+ stdcall; external 'kernel32' name 'FileTimeToDosDateTime';
+ function DosDateTimeToFileTime(date,time : word;var ft :TWin32FileTime) : longbool;
+ stdcall; external 'kernel32' name 'DosDateTimeToFileTime';
+ function FileTimeToLocalFileTime(const ft : TWin32FileTime;var lft : TWin32FileTime) : longbool;
+ stdcall; external 'kernel32' name 'FileTimeToLocalFileTime';
+ function LocalFileTimeToFileTime(const lft : TWin32FileTime;var ft : TWin32FileTime) : longbool;
+ stdcall; external 'kernel32' name 'LocalFileTimeToFileTime';
+ function GetTickCount : longint;
+ stdcall;external 'kernel32' name 'GetTickCount';
+
+function GetMsCount: int64;
+begin
+ GetMsCount := cardinal (GetTickCount);
+end;
+
+type
+ Longrec=packed record
+ lo,hi : word;
+ end;
+
+function Last2DosError(d:dword):integer;
+begin
+ case d of
+ 87 : { Parameter invalid -> Data invalid }
+ Last2DosError:=13;
+ else
+ Last2DosError:=d;
+ end;
+end;
+
+
+Function DosToWinAttr (Const Attr : Longint) : longint;
+begin
+ DosToWinAttr:=Attr;
+end;
+
+
+Function WinToDosAttr (Const Attr : Longint) : longint;
+begin
+ WinToDosAttr:=Attr;
+end;
+
+
+Function DosToWinTime (DTime:longint;Var Wtime : TWin32FileTime):longbool;
+var
+ lft : TWin32FileTime;
+begin
+ DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
+ LocalFileTimeToFileTime(lft,Wtime);
+end;
+
+
+Function WinToDosTime (Const Wtime : TWin32FileTime;var DTime:longint):longbool;
+var
+ lft : TWin32FileTime;
+begin
+ WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
+ FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
+end;
+
+
+{******************************************************************************
+ --- Info / Date / Time ---
+******************************************************************************}
+
+type
+ TSystemTime = record
+ wYear,
+ wMonth,
+ wDayOfWeek,
+ wDay,
+ wHour,
+ wMinute,
+ wSecond,
+ wMilliseconds: Word;
+ end;
+
+ function GetVersion : longint;
+ stdcall; external 'kernel32' name 'GetVersion';
+ procedure GetLocalTime(var t : TSystemTime);
+ stdcall; external 'kernel32' name 'GetLocalTime';
+ function SetLocalTime(const t : TSystemTime) : longbool;
+ stdcall; external 'kernel32' name 'SetLocalTime';
+
+function dosversion : word;
+begin
+ dosversion:=GetVersion and $ffff;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+var
+ t : TSystemTime;
+begin
+ GetLocalTime(t);
+ year:=t.wYear;
+ month:=t.wMonth;
+ mday:=t.wDay;
+ wday:=t.wDayOfWeek;
+end;
+
+
+procedure setdate(year,month,day : word);
+var
+ t : TSystemTime;
+begin
+ { we need the time set privilege }
+ { so this function crash currently }
+ {!!!!!}
+ GetLocalTime(t);
+ t.wYear:=year;
+ t.wMonth:=month;
+ t.wDay:=day;
+ { only a quite good solution, we can loose some ms }
+ SetLocalTime(t);
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+var
+ t : TSystemTime;
+begin
+ GetLocalTime(t);
+ hour:=t.wHour;
+ minute:=t.wMinute;
+ second:=t.wSecond;
+ sec100:=t.wMilliSeconds div 10;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+var
+ t : TSystemTime;
+begin
+ { we need the time set privilege }
+ { so this function crash currently }
+ {!!!!!}
+ GetLocalTime(t);
+ t.wHour:=hour;
+ t.wMinute:=minute;
+ t.wSecond:=second;
+ t.wMilliSeconds:=sec100*10;
+ SetLocalTime(t);
+end;
+
+
+{******************************************************************************
+ --- Exec ---
+******************************************************************************}
+
+type
+ PProcessInformation = ^TProcessInformation;
+ TProcessInformation = record
+ hProcess: TWin32Handle;
+ hThread: TWin32Handle;
+ dwProcessId: DWORD;
+ dwThreadId: DWORD;
+ end;
+
+ function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
+ lpProcessAttributes, lpThreadAttributes: Pointer;
+ bInheritHandles: Longbool; dwCreationFlags: DWORD; lpEnvironment: Pointer;
+ lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
+ var lpProcessInformation: TProcessInformation): longbool;
+ stdcall; external 'kernel32' name 'CreateProcessA';
+ function getExitCodeProcess(h:TWin32Handle;var code:longint):longbool;
+ stdcall; external 'kernel32' name 'GetExitCodeProcess';
+ function WaitForSingleObject(hHandle: TWin32Handle; dwMilliseconds: DWORD): DWORD;
+ stdcall; external 'kernel32' name 'WaitForSingleObject';
+ function CloseHandle(h : TWin32Handle) : longint;
+ stdcall; external 'kernel32' name 'CloseHandle';
+
+procedure exec(const path : pathstr;const comline : comstr);
+var
+ SI: TStartupInfo;
+ PI: TProcessInformation;
+ Proc : TWin32Handle;
+ l : Longint;
+ CommandLine : array[0..511] of char;
+ AppParam : array[0..255] of char;
+ pathlocal : string;
+begin
+ DosError := 0;
+ FillChar(SI, SizeOf(SI), 0);
+ SI.cb:=SizeOf(SI);
+ SI.wShowWindow:=1;
+ { always surroound the name of the application by quotes
+ so that long filenames will always be accepted. But don't
+ do it if there are already double quotes, since Win32 does not
+ like double quotes which are duplicated!
+ }
+ if pos('"',path) = 0 then
+ pathlocal:='"'+path+'"'
+ else
+ pathlocal := path;
+ Move(Pathlocal[1],CommandLine,length(Pathlocal));
+
+ AppParam[0]:=' ';
+ AppParam[1]:=' ';
+ Move(ComLine[1],AppParam[2],length(Comline));
+ AppParam[Length(ComLine)+2]:=#0;
+ { concatenate both pathnames }
+ Move(Appparam[0],CommandLine[length(Pathlocal)],strlen(Appparam)+1);
+ if not CreateProcess(nil, PChar(@CommandLine),
+ Nil, Nil, ExecInheritsHandles,$20, Nil, Nil, SI, PI) then
+ begin
+ DosError:=Last2DosError(GetLastError);
+ exit;
+ end;
+ Proc:=PI.hProcess;
+ CloseHandle(PI.hThread);
+ if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
+ GetExitCodeProcess(Proc,l)
+ else
+ l:=-1;
+ CloseHandle(Proc);
+ LastDosExitCode:=l;
+end;
+
+
+{******************************************************************************
+ --- Disk ---
+******************************************************************************}
+
+ function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
+ freeclusters,totalclusters:longint):longbool;
+ stdcall; external 'kernel32' name 'GetDiskFreeSpaceA';
+type
+ TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,
+ total,free):longbool;stdcall;
+
+var
+ GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
+
+function diskfree(drive : byte) : int64;
+var
+ disk : array[1..4] of char;
+ secs,bytes,
+ free,total : longint;
+ qwtotal,qwfree,qwcaller : int64;
+
+
+begin
+ if drive=0 then
+ begin
+ disk[1]:='\';
+ disk[2]:=#0;
+ end
+ else
+ begin
+ disk[1]:=chr(drive+64);
+ disk[2]:=':';
+ disk[3]:='\';
+ disk[4]:=#0;
+ end;
+ if assigned(GetDiskFreeSpaceEx) then
+ begin
+ if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
+ diskfree:=qwfree
+ else
+ diskfree:=-1;
+ end
+ else
+ begin
+ if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+ diskfree:=int64(free)*secs*bytes
+ else
+ diskfree:=-1;
+ end;
+end;
+
+
+function disksize(drive : byte) : int64;
+var
+ disk : array[1..4] of char;
+ secs,bytes,
+ free,total : longint;
+ qwtotal,qwfree,qwcaller : int64;
+
+begin
+ if drive=0 then
+ begin
+ disk[1]:='\';
+ disk[2]:=#0;
+ end
+ else
+ begin
+ disk[1]:=chr(drive+64);
+ disk[2]:=':';
+ disk[3]:='\';
+ disk[4]:=#0;
+ end;
+ if assigned(GetDiskFreeSpaceEx) then
+ begin
+ if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
+ disksize:=qwtotal
+ else
+ disksize:=-1;
+ end
+ else
+ begin
+ if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+ disksize:=int64(total)*secs*bytes
+ else
+ disksize:=-1;
+ end;
+end;
+
+
+{******************************************************************************
+ --- Findfirst FindNext ---
+******************************************************************************}
+
+{ Needed kernel calls }
+
+ function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): TWin32Handle;
+ stdcall; external 'kernel32' name 'FindFirstFileA';
+ function FindNextFile (hFindFile: TWin32Handle; var lpFindFileData: TWIN32FindData): LongBool;
+ stdcall; external 'kernel32' name 'FindNextFileA';
+ function FindCloseFile (hFindFile: TWin32Handle): LongBool;
+ stdcall; external 'kernel32' name 'FindClose';
+
+Procedure StringToPchar (Var S : String);
+Var L : Longint;
+begin
+ L:=ord(S[0]);
+ Move (S[1],S[0],L);
+ S[L]:=#0;
+end;
+
+Procedure PCharToString (Var S : String);
+Var L : Longint;
+begin
+ L:=strlen(pchar(@S[0]));
+ Move (S[0],S[1],L);
+ S[0]:=char(l);
+end;
+
+
+procedure FindMatch(var f:searchrec);
+begin
+ { Find file with correct attribute }
+ While (F.W32FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
+ begin
+ if not FindNextFile (F.FindHandle,F.W32FindData) then
+ begin
+ DosError:=Last2DosError(GetLastError);
+ if DosError=2 then
+ DosError:=18;
+ exit;
+ end;
+ end;
+
+ { Convert some attributes back }
+ f.size:=F.W32FindData.NFileSizeLow;
+ f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
+ WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
+ f.Name:=StrPas(@F.W32FindData.cFileName);
+end;
+
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+begin
+ fillchar(f,sizeof(f),0);
+ { no error }
+ doserror:=0;
+ F.Name:=Path;
+ F.Attr:=attr;
+ F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume}
+ StringToPchar(f.name);
+
+ { FindFirstFile is a Win32 Call }
+ F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr);
+ F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData);
+
+ If longint(F.FindHandle)=Invalid_Handle_value then
+ begin
+ DosError:=Last2DosError(GetLastError);
+ if DosError=2 then
+ DosError:=18;
+ exit;
+ end;
+ { Find file with correct attribute }
+ FindMatch(f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+{ no error }
+ doserror:=0;
+ if not FindNextFile (F.FindHandle,F.W32FindData) then
+ begin
+ DosError:=Last2DosError(GetLastError);
+ if DosError=2 then
+ DosError:=18;
+ exit;
+ end;
+{ Find file with correct attribute }
+ FindMatch(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+ If longint(F.FindHandle)<>Invalid_Handle_value then
+ FindCloseFile(F.FindHandle);
+end;
+
+
+{******************************************************************************
+ --- File ---
+******************************************************************************}
+
+ function GeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool;
+ stdcall; external 'kernel32' name 'GetFileTime';
+ function SeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool;
+ stdcall; external 'kernel32' name 'SetFileTime';
+ function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : longbool;
+ stdcall; external 'kernel32' name 'SetFileAttributesA';
+ function GetFileAttributes(lpFileName : pchar) : longint;
+ stdcall; external 'kernel32' name 'GetFileAttributesA';
+
+
+{ <immobilizer> }
+
+function GetFullPathName(lpFileName: PChar; nBufferLength: Longint; lpBuffer: PChar; var lpFilePart : PChar):DWORD;
+ stdcall; external 'kernel32' name 'GetFullPathNameA';
+
+function GetShortPathName(lpszLongPath:pchar; lpszShortPath:pchar; cchBuffer:DWORD):DWORD;
+ stdcall; external 'kernel32' name 'GetShortPathNameA';
+
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+ i,p1 : longint;
+ s : searchrec;
+ newdir : pathstr;
+begin
+ { check if the file specified exists }
+ findfirst(path,anyfile and not(directory),s);
+ if doserror=0 then
+ begin
+ findclose(s);
+ fsearch:=path;
+ exit;
+ end;
+ { No wildcards allowed in these things }
+ if (pos('?',path)<>0) or (pos('*',path)<>0) then
+ fsearch:=''
+ else
+ begin
+ { allow slash as backslash }
+ for i:=1 to length(dirlist) do
+ if dirlist[i]='/' then dirlist[i]:='\';
+ repeat
+ p1:=pos(';',dirlist);
+ if p1<>0 then
+ begin
+ newdir:=copy(dirlist,1,p1-1);
+ delete(dirlist,1,p1);
+ end
+ else
+ begin
+ newdir:=dirlist;
+ dirlist:='';
+ end;
+ if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+ newdir:=newdir+'\';
+ findfirst(newdir+path,anyfile and not(directory),s);
+ if doserror=0 then
+ newdir:=newdir+path
+ else
+ newdir:='';
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
+ end;
+ findclose(s);
+end;
+
+{ </immobilizer> }
+
+procedure getftime(var f;var time : longint);
+var
+ ft : TWin32FileTime;
+begin
+ doserror:=0;
+ if GeTWin32FileTime(filerec(f).Handle,nil,nil,@ft) and
+ WinToDosTime(ft,time) then
+ exit
+ else
+ begin
+ DosError:=Last2DosError(GetLastError);
+ time:=0;
+ end;
+end;
+
+
+procedure setftime(var f;time : longint);
+var
+ ft : TWin32FileTime;
+begin
+ doserror:=0;
+ if DosToWinTime(time,ft) and
+ SeTWin32FileTime(filerec(f).Handle,nil,nil,@ft) then
+ exit
+ else
+ DosError:=Last2DosError(GetLastError);
+end;
+
+
+procedure getfattr(var f;var attr : word);
+var
+ l : longint;
+begin
+ doserror:=0;
+ l:=GetFileAttributes(filerec(f).name);
+ if l=longint($ffffffff) then
+ begin
+ doserror:=getlasterror;
+ attr:=0;
+ end
+ else
+ attr:=l and $ffff;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+ { Fail for setting VolumeId }
+ if (attr and VolumeID)<>0 then
+ doserror:=5
+ else
+ if SetFileAttributes(filerec(f).name,attr) then
+ doserror:=0
+ else
+ doserror:=getlasterror;
+end;
+
+{ change to short filename if successful win32 call PM }
+function GetShortName(var p : String) : boolean;
+var
+ buffer : array[0..255] of char;
+ ret : longint;
+begin
+ {we can't mess with p, because we have to return it if call is
+ unsuccesfully.}
+
+ if Length(p)>0 then {copy p to array of char}
+ move(p[1],buffer[0],length(p));
+ buffer[length(p)]:=chr(0);
+
+ {Should return value load loaddoserror?}
+
+ ret:=GetShortPathName(@buffer,@buffer,255);
+ if ret=0 then
+ p:=strpas(buffer);
+ GetShortName:=ret<>0;
+end;
+
+{ change to long filename if successful DOS call PM }
+function GetLongName(var p : String) : boolean;
+
+var
+ lfn,sfn : array[0..255] of char;
+ filename : pchar;
+ ret : longint;
+begin
+ {contrary to shortname, SDK does not mention input buffer can be equal
+ to output.}
+
+ if Length(p)>0 then {copy p to array of char}
+ move(p[1],sfn[0],length(p));
+ sfn[length(p)]:=chr(0);
+ fillchar(lfn,sizeof(lfn),#0);
+ filename:=nil;
+
+ {Should return value load loaddoserror?}
+
+ ret:=GetFullPathName(@sfn,255,@lfn,filename);
+ if ret=0 then
+ p:=strpas(lfn); {lfn here returns full path, filename only fn}
+ GetLongName:=ret<>0;
+end;
+
+{******************************************************************************
+ --- Environment ---
+******************************************************************************}
+
+{
+ The environment is a block of zero terminated strings
+ terminated by a #0
+}
+
+ function GetEnvironmentStrings : pchar;
+ stdcall; external 'kernel32' name 'GetEnvironmentStringsA';
+ function FreeEnvironmentStrings(p : pchar) : longbool;
+ stdcall; external 'kernel32' name 'FreeEnvironmentStringsA';
+
+function envcount : longint;
+var
+ hp,p : pchar;
+ count : longint;
+begin
+ p:=GetEnvironmentStrings;
+ hp:=p;
+ count:=0;
+ while hp^<>#0 do
+ begin
+ { next string entry}
+ hp:=hp+strlen(hp)+1;
+ inc(count);
+ end;
+ FreeEnvironmentStrings(p);
+ envcount:=count;
+end;
+
+
+Function EnvStr (Index: longint): string;
+var
+ hp,p : pchar;
+ count,i : longint;
+begin
+ { envcount takes some time in win32 }
+ count:=envcount;
+
+ { range checking }
+ if (index<=0) or (index>count) then
+ begin
+ envstr:='';
+ exit;
+ end;
+ p:=GetEnvironmentStrings;
+ hp:=p;
+
+ { retrive the string with the given index }
+ for i:=2 to index do
+ hp:=hp+strlen(hp)+1;
+
+ envstr:=strpas(hp);
+ FreeEnvironmentStrings(p);
+end;
+
+
+Function GetEnv(envvar: string): string;
+var
+ s : string;
+ i : longint;
+ hp,p : pchar;
+begin
+ getenv:='';
+ p:=GetEnvironmentStrings;
+ hp:=p;
+ while hp^<>#0 do
+ begin
+ s:=strpas(hp);
+ i:=pos('=',s);
+ if upcase(copy(s,1,i-1))=upcase(envvar) then
+ begin
+ getenv:=copy(s,i+1,length(s)-i);
+ break;
+ end;
+ { next string entry}
+ hp:=hp+strlen(hp)+1;
+ end;
+ FreeEnvironmentStrings(p);
+end;
+
+
+function FreeLibrary(hLibModule : TWin32Handle) : longbool;
+ stdcall; external 'kernel32' name 'FreeLibrary';
+function GetVersionEx(var VersionInformation:OSVERSIONINFO) : longbool;
+ stdcall; external 'kernel32' name 'GetVersionExA';
+function LoadLibrary(lpLibFileName : pchar):TWin32Handle;
+ stdcall; external 'kernel32' name 'LoadLibraryA';
+function GetProcAddress(hModule : TWin32Handle;lpProcName : pchar) : pointer;
+ stdcall; external 'kernel32' name 'GetProcAddress';
+
+var
+ oldexitproc : pointer;
+
+procedure dosexitproc;
+
+ begin
+ exitproc:=oldexitproc;
+ if kernel32dll<>0 then
+ FreeLibrary(kernel32dll);
+ end;
+
+begin
+ oldexitproc:=exitproc;
+ exitproc:=@dosexitproc;
+ versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
+ GetVersionEx(versioninfo);
+ kernel32dll:=0;
+ GetDiskFreeSpaceEx:=nil;
+ if ((versioninfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
+ (versioninfo.dwBuildNUmber>=1000)) or
+ (versioninfo.dwPlatformId=VER_PLATFORM_WIN32_NT) then
+ begin
+ kernel32dll:=LoadLibrary('kernel32');
+ if kernel32dll<>0 then
+ GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
+ end;
+end.
+{
+ $Log: dos.pp,v $
+ Revision 1.30 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/dynlibs.inc b/rtl/win32/dynlibs.inc
new file mode 100644
index 0000000000..70ee50b658
--- /dev/null
+++ b/rtl/win32/dynlibs.inc
@@ -0,0 +1,63 @@
+{
+ $Id: dynlibs.inc,v 1.4 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Implements OS dependent part for loading of dynamic libraries.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$ifdef readinterface}
+
+{ ---------------------------------------------------------------------
+ Interface declarations
+ ---------------------------------------------------------------------}
+
+Type
+ TLibHandle = Longint;
+
+Const
+ NilHandle = 0;
+
+{$else}
+
+{ ---------------------------------------------------------------------
+ Implementation section
+ ---------------------------------------------------------------------}
+
+Uses windows;
+
+Function LoadLibrary(Name : AnsiString) : TlibHandle;
+
+begin
+ Result:=Windows.LoadLibrary(PChar(Name));
+end;
+
+Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
+
+begin
+ Result:=Windows.GetProcAddress(Lib,PChar(ProcName));
+end;
+
+Function UnloadLibrary(Lib : TLibHandle) : Boolean;
+
+begin
+ Result:=Windows.FreeLibrary(Lib);
+end;
+
+{$endif}
+
+{
+ $Log: dynlibs.inc,v $
+ Revision 1.4 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/gprt0.as b/rtl/win32/gprt0.as
new file mode 100644
index 0000000000..16195f4e38
--- /dev/null
+++ b/rtl/win32/gprt0.as
@@ -0,0 +1,67 @@
+// Startup code for WIN32 port of Free Pascal
+// with profiling enabled.
+ .text
+ .globl _mainCRTStartup
+_mainCRTStartup:
+ movb $1,U_SYSTEM_ISCONSOLE
+ call _FPC_EXE_Entry
+ .globl _WinMainCRTStartup
+_WinMainCRTStartup:
+ movb $0,U_SYSTEM_ISCONSOLE
+ call _FPC_EXE_Entry
+
+ .globl asm_exit
+asm_exit:
+ pushl %eax
+ call __mcleanup
+ popl %eax
+ pushl %eax
+ call exitprocess
+
+.text
+.globl exitprocess
+exitprocess:
+ jmp *.L10
+ .balign 4,144
+
+.text
+ .balign 4,144
+
+.section .idata$2
+ .rva .L7
+ .long 0,0
+ .rva .L6
+ .rva .L8
+
+.section .idata$4
+.L7:
+ .rva .L9
+ .long 0
+
+.section .idata$5
+.L8:
+
+
+.section .idata$5
+.L10:
+ .rva .L9
+ .long 0
+
+.section .idata$6
+.L9:
+ .short 0
+ .ascii "ExitProcess\000"
+ .balign 2,0
+
+.section .idata$7
+.L6:
+ .ascii "kernel32.dll\000"
+
+
+//
+// $Log: gprt0.as,v $
+// Revision 1.1 2002/11/30 18:17:35 carl
+// + profiling support
+//
+//
+//
diff --git a/rtl/win32/graph.pp b/rtl/win32/graph.pp
new file mode 100644
index 0000000000..86bfbfff58
--- /dev/null
+++ b/rtl/win32/graph.pp
@@ -0,0 +1,2238 @@
+{
+ $Id: graph.pp,v 1.15 2005/04/04 16:13:09 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+
+ This file implements the win32 gui support for the graph unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Graph;
+interface
+
+uses
+ windows;
+
+{$i graphh.inc}
+
+ var
+ { this procedure allows to hook keyboard messages }
+ charmessagehandler : WndProc;
+ { this procedure allows to hook mouse messages }
+ mousemessagehandler : WndProc;
+ { this procedure allows to wm_command messages }
+ commandmessagehandler : WndProc;
+ NotifyMessageHandler : WndProc;
+
+ OnGraphWindowCreation : procedure;
+
+ GraphWindow,ParentWindow : HWnd;
+ // this allows direct drawing to the window
+ bitmapdc : hdc;
+ windc : hdc;
+
+ const
+ { predefined window style }
+ { we shouldn't set CS_DBLCLKS here }
+ { because most dos applications }
+ { handle double clicks on it's own }
+ graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw;
+
+ windowtitle : pchar = 'Graph window application';
+ menu : hmenu = 0;
+ icon : hicon = 0;
+ drawtoscreen : boolean = true;
+ drawtobitmap : boolean = true;
+ // the graph window can be a child window, this allows to add toolbars
+ // to the main window
+ UseChildWindow : boolean = false;
+ // this allows to specify an offset for the child child window
+ ChildOffset : rect = (left:0;top:0;right:0;bottom:0);
+
+CONST
+
+ m640x200x16 = VGALo;
+ m640x400x16 = VGAMed;
+ m640x480x16 = VGAHi;
+
+ { VESA Specific video modes. }
+ m320x200x32k = $10D;
+ m320x200x64k = $10E;
+
+ m640x400x256 = $100;
+
+ m640x480x256 = $101;
+ m640x480x32k = $110;
+ m640x480x64k = $111;
+
+ m800x600x16 = $102;
+ m800x600x256 = $103;
+ m800x600x32k = $113;
+ m800x600x64k = $114;
+
+ m1024x768x16 = $104;
+ m1024x768x256 = $105;
+ m1024x768x32k = $116;
+ m1024x768x64k = $117;
+
+ m1280x1024x16 = $106;
+ m1280x1024x256 = $107;
+ m1280x1024x32k = $119;
+ m1280x1024x64k = $11A;
+
+ { some extra modes which applies only to GUI }
+ mLargestWindow16 = $f0;
+ mLargestWindow256 = $f1;
+ mLargestWindow32k = $f2;
+ mLargestWindow64k = $f3;
+ mLargestWindow16M = $f4;
+ mMaximizedWindow16 = $f5;
+ mMaximizedWindow256 = $f6;
+ mMaximizedWindow32k = $f7;
+ mMaximizedWindow64k = $f8;
+ mMaximizedWindow16M = $f9;
+
+
+implementation
+
+uses
+ strings;
+
+{
+ Remarks:
+ Colors in 16 color mode:
+ ------------------------
+ - the behavior of xor/or/and put isn't 100%:
+ it is done using the RGB color getting from windows
+ instead of the palette index!
+ - palette operations aren't supported
+ To solve these drawbacks, setpalette must be implemented
+ by exchanging the colors in the DCs, further GetPaletteEntry
+ must be used when doing xor/or/and operations
+}
+
+
+const
+ InternalDriverName = 'WIN32GUI';
+
+{$i graph.inc}
+
+
+{ used to create a file containing all calls to WM_PAINT
+ WARNING this probably creates HUGE files PM }
+{ $define DEBUG_WM_PAINT}
+var
+ savedscreen : hbitmap;
+ graphrunning : boolean;
+ graphdrawing : tcriticalsection;
+ pens : array[0..15] of HPEN;
+{$ifdef DEBUG_WM_PAINT}
+ graphdebug : text;
+
+const
+ wm_paint_count : longint = 0;
+var
+{$endif DEBUG_WM_PAINT}
+ oldbitmap : hgdiobj;
+ pal : ^rgbrec;
+// SavePtr : pointer; { we don't use that pointer }
+ MessageThreadHandle : Handle;
+ MessageThreadID : DWord;
+
+function GetPaletteEntry(r,g,b : word) : word;
+
+ var
+ dist,i,index,currentdist : longint;
+
+ begin
+ dist:=$7fffffff;
+ index:=0;
+ for i:=0 to maxcolors do
+ begin
+ currentdist:=abs(r-pal[i].red)+abs(g-pal[i].green)+
+ abs(b-pal[i].blue);
+ if currentdist<dist then
+ begin
+ index:=i;
+ dist:=currentdist;
+ if dist=0 then
+ break;
+ end;
+ end;
+ GetPaletteEntry:=index;
+ end;
+
+procedure PutPixel16Win32GUI(x,y : smallint;pixel : word);
+
+ var
+ c : colorref;
+
+ begin
+ x:=x+startxviewport;
+ y:=y+startyviewport;
+ { convert to absolute coordinates and then verify clipping...}
+ if clippixels then
+ begin
+ if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
+ (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
+ exit;
+ end;
+ if graphrunning then
+ begin
+ c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue);
+ EnterCriticalSection(graphdrawing);
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ LeaveCriticalSection(graphdrawing);
+ end;
+ end;
+
+function GetPixel16Win32GUI(x,y : smallint) : word;
+
+ var
+ c : COLORREF;
+
+ begin
+ x:=x+startxviewport;
+ y:=y+startyviewport;
+ { convert to absolute coordinates and then verify clipping...}
+ if clippixels then
+ begin
+ if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
+ (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
+ exit;
+ end;
+ if graphrunning then
+ begin
+ EnterCriticalSection(graphdrawing);
+ c:=Windows.GetPixel(bitmapdc,x,y);
+ LeaveCriticalSection(graphdrawing);
+ GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c));
+ end
+ else
+ begin
+ _graphresult:=grerror;
+ exit;
+ end;
+ end;
+
+procedure DirectPutPixel16Win32GUI(x,y : smallint);
+
+ var
+ col : longint;
+ c,c2 : COLORREF;
+
+ begin
+ if graphrunning then
+ begin
+ EnterCriticalSection(graphdrawing);
+ col:=CurrentColor;
+ case currentwritemode of
+ XorPut:
+ Begin
+ c2:=Windows.GetPixel(windc,x,y);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ End;
+ AndPut:
+ Begin
+ c2:=Windows.GetPixel(windc,x,y);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ End;
+ OrPut:
+ Begin
+ c2:=Windows.GetPixel(windc,x,y);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ End
+ else
+ Begin
+ If CurrentWriteMode<>NotPut Then
+ col:=CurrentColor
+ Else col := Not(CurrentColor);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ End
+ end;
+ LeaveCriticalSection(graphdrawing);
+ end;
+ end;
+
+var
+ bitmapfontverticalcache : array[0..255] of HBITMAP;
+ bitmapfonthorizoncache : array[0..255] of HBITMAP;
+
+procedure OutTextXYWin32GUI(x,y : smallint;const TextString : string);
+
+ type
+ Tpoint = record
+ X,Y: smallint;
+ end;
+ var
+ i,j,k,c : longint;
+ xpos,ypos : longint;
+ counter : longint;
+ cnt1,cnt2 : smallint;
+ cnt3,cnt4 : smallint;
+ charsize : word;
+ WriteMode : word;
+ curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
+ oldvalues : linesettingstype;
+ fontbitmap : TBitmapChar;
+ chr : char;
+ curx2i,cury2i,
+ xpos2i,ypos2i : longint;
+ charbitmap,oldcharbitmap : HBITMAP;
+ chardc : HDC;
+ color : longint;
+ brushwin,oldbrushwin,brushbitmap,oldbrushbitmap : HBRUSH;
+ bitmaprgn,winrgn : HRGN;
+
+ begin
+ { save current write mode }
+ WriteMode := CurrentWriteMode;
+ CurrentWriteMode := NormalPut;
+ GetTextPosition(xpos,ypos,textstring);
+ X:=X-XPos; Y:=Y+YPos;
+ XPos:=X; YPos:=Y;
+ CharSize := CurrentTextInfo.Charsize;
+ if Currenttextinfo.font=DefaultFont then
+ begin
+ if CurrentTextInfo.direction=HorizDir then
+ { Horizontal direction }
+ begin
+ if (x>viewwidth) or (y>viewheight) or
+ (x<0) or (y<0) then
+ begin
+ CurrentWriteMode:=WriteMode;
+ exit;
+ end;
+ EnterCriticalSection(graphdrawing);
+ c:=length(textstring);
+ chardc:=CreateCompatibleDC(windc);
+ if currentcolor<>white then
+ begin
+ color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
+ pal[currentcolor].blue);
+
+ if drawtoscreen then
+ begin
+ brushwin:=CreateSolidBrush(color);
+ oldbrushwin:=SelectObject(windc,brushwin);
+ end;
+
+ if drawtobitmap then
+ begin
+ brushbitmap:=CreateSolidBrush(color);
+ oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
+ end;
+ end;
+ inc(x,startxviewport);
+ inc(y,startyviewport);
+
+ { let windows do the clipping }
+ if drawtobitmap then
+ begin
+ bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
+ startxviewport+viewwidth+1,startyviewport+viewheight+1);
+ SelectClipRgn(bitmapdc,bitmaprgn);
+ end;
+
+ if drawtoscreen then
+ begin
+ winrgn:=CreateRectRgn(startxviewport,startyviewport,
+ startxviewport+viewwidth+1,startyviewport+viewheight+1);
+ SelectClipRgn(windc,winrgn);
+ end;
+
+ for i:=0 to c-1 do
+ begin
+ xpos:=x+(i*8)*Charsize;
+ if bitmapfonthorizoncache[byte(textstring[i+1])]=0 then
+ begin
+ charbitmap:=CreateCompatibleBitmap(windc,8,8);
+ if charbitmap=0 then
+ writeln('Bitmap konnte nicht erzeugt werden!');
+ oldcharbitmap:=SelectObject(chardc,charbitmap);
+ Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
+
+ for j:=0 to 7 do
+ for k:=0 to 7 do
+ if Fontbitmap[j,k]<>0 then
+ SetPixelV(chardc,k,j,$ffffff)
+ else
+ SetPixelV(chardc,k,j,0);
+ bitmapfonthorizoncache[byte(textstring[i+1])]:=charbitmap;
+ SelectObject(chardc,oldcharbitmap);
+ end;
+ oldcharbitmap:=SelectObject(chardc,bitmapfonthorizoncache[byte(textstring[i+1])]);
+ if CharSize=1 then
+ begin
+ if currentcolor=white then
+ begin
+ if drawtoscreen then
+ BitBlt(windc,xpos,y,8,8,chardc,0,0,SRCPAINT);
+ if drawtobitmap then
+ BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,SRCPAINT);
+ end
+ else
+ begin
+ { could we do this with one pattern operation ?? }
+ { we would need something like DSnaSPao }
+ if drawtoscreen then
+ begin
+ // ROP $00220326=DSna
+ BitBlt(windc,xpos,y,8,8,chardc,0,0,$00220326);
+ // ROP $00EA02E9 = DPSao
+ BitBlt(windc,xpos,y,8,8,chardc,0,0,$00EA02E9);
+ end;
+
+ if drawtobitmap then
+ begin
+ BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00220326);
+ BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00EA02E9);
+ end;
+ end;
+ end
+ else
+ begin
+ if currentcolor=white then
+ begin
+ if drawtoscreen then
+ StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
+ if drawtobitmap then
+ StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
+ end
+ else
+ begin
+ { could we do this with one pattern operation ?? }
+ { we would need something like DSnaSPao }
+ if drawtoscreen then
+ begin
+ // ROP $00220326=DSna
+ StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
+ // ROP $00EA02E9 = DPSao
+ StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
+ end;
+ if drawtobitmap then
+ begin
+ StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
+ StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
+ end;
+ end;
+ end;
+ SelectObject(chardc,oldcharbitmap);
+ end;
+ if currentcolor<>white then
+ begin
+ if drawtoscreen then
+ begin
+ SelectObject(windc,oldbrushwin);
+ DeleteObject(brushwin);
+ end;
+
+ if drawtobitmap then
+ begin
+ SelectObject(bitmapdc,oldbrushbitmap);
+ DeleteObject(brushbitmap);
+ end;
+ end;
+ { release clip regions }
+ if drawtobitmap then
+ begin
+ SelectClipRgn(bitmapdc,0);
+ DeleteObject(bitmaprgn);
+ end;
+ if drawtoscreen then
+ begin
+ SelectClipRgn(windc,0);
+ DeleteObject(winrgn);
+ end;
+ DeleteDC(chardc);
+ LeaveCriticalSection(graphdrawing);
+ end
+ else
+ { Vertical direction }
+ begin
+ if (x>viewwidth) or (y>viewheight) or
+ (x<0) or (y<0) then
+ begin
+ CurrentWriteMode:=WriteMode;
+ exit;
+ end;
+ EnterCriticalSection(graphdrawing);
+ c:=length(textstring);
+ chardc:=CreateCompatibleDC(windc);
+ if currentcolor<>white then
+ begin
+ color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
+ pal[currentcolor].blue);
+
+ if drawtoscreen then
+ begin
+ brushwin:=CreateSolidBrush(color);
+ oldbrushwin:=SelectObject(windc,brushwin);
+ end;
+
+ if drawtobitmap then
+ begin
+ brushbitmap:=CreateSolidBrush(color);
+ oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
+ end;
+ end;
+ inc(x,startxviewport);
+ inc(y,startyviewport);
+ { let windows do the clipping }
+ if drawtoscreen then
+ begin
+ winrgn:=CreateRectRgn(startxviewport,startyviewport,
+ startxviewport+viewwidth+1,startyviewport+viewheight+1);
+ SelectClipRgn(windc,winrgn);
+ end;
+
+ if drawtobitmap then
+ begin
+ bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
+ startxviewport+viewwidth+1,startyviewport+viewheight+1);
+ SelectClipRgn(bitmapdc,bitmaprgn);
+ end;
+ for i:=0 to c-1 do
+ begin
+ ypos:=y+1-((i+1)*8)*CharSize;
+ if bitmapfontverticalcache[byte(textstring[i+1])]=0 then
+ begin
+ charbitmap:=CreateCompatibleBitmap(windc,8,8);
+ if charbitmap=0 then
+ writeln('Bitmap konnte nicht erzeugt werden!');
+ oldcharbitmap:=SelectObject(chardc,charbitmap);
+ Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
+
+ for j:=0 to 7 do
+ for k:=0 to 7 do
+ if Fontbitmap[j,k]<>0 then
+ SetPixelV(chardc,j,7-k,$ffffff)
+ else
+ SetPixelV(chardc,j,7-k,0);
+ bitmapfontverticalcache[byte(textstring[i+1])]:=charbitmap;
+ SelectObject(chardc,oldcharbitmap);
+ end;
+ oldcharbitmap:=SelectObject(chardc,bitmapfontverticalcache[byte(textstring[i+1])]);
+ if CharSize=1 then
+ begin
+ if currentcolor=white then
+ begin
+ if drawtoscreen then
+ BitBlt(windc,x,ypos,8,8,chardc,0,0,SRCPAINT);
+ if drawtobitmap then
+ BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,SRCPAINT);
+ end
+ else
+ begin
+ { could we do this with one pattern operation ?? }
+ { we would need something like DSnaSPao }
+ if drawtoscreen then
+ begin
+ // ROP $00220326=DSna
+ BitBlt(windc,x,ypos,8,8,chardc,0,0,$00220326);
+ // ROP $00EA02E9 = DPSao
+ BitBlt(windc,x,ypos,8,8,chardc,0,0,$00EA02E9);
+ end;
+ if drawtobitmap then
+ begin
+ BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00220326);
+ BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00EA02E9);
+ end;
+ end;
+ end
+ else
+ begin
+ if currentcolor=white then
+ begin
+ if drawtoscreen then
+ StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
+ if drawtobitmap then
+ StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
+ end
+ else
+ begin
+ { could we do this with one pattern operation ?? }
+ { we would need something like DSnaSPao }
+ if drawtoscreen then
+ begin
+ // ROP $00220326=DSna
+ StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
+ // ROP $00EA02E9 = DPSao
+ StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
+ end;
+ if drawtobitmap then
+ begin
+ StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
+ StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
+ end;
+ end;
+ end;
+ SelectObject(chardc,oldcharbitmap);
+ end;
+ if currentcolor<>white then
+ begin
+ if drawtoscreen then
+ begin
+ SelectObject(windc,oldbrushwin);
+ DeleteObject(brushwin);
+ end;
+
+ if drawtobitmap then
+ begin
+ SelectObject(bitmapdc,oldbrushbitmap);
+ DeleteObject(brushbitmap);
+ end;
+ end;
+ { release clip regions }
+ if drawtoscreen then
+ begin
+ SelectClipRgn(windc,0);
+ DeleteObject(winrgn);
+ end;
+ if drawtobitmap then
+ begin
+ SelectClipRgn(bitmapdc,0);
+ DeleteObject(bitmaprgn);
+ end;
+ DeleteDC(chardc);
+ LeaveCriticalSection(graphdrawing);
+ end;
+ end else
+ { This is a stroked font which is already loaded into memory }
+ begin
+ getlinesettings(oldvalues);
+ { reset line style to defaults }
+ setlinestyle(solidln,oldvalues.pattern,normwidth);
+ if Currenttextinfo.direction=vertdir then
+ xpos:=xpos + Textheight(textstring);
+ CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
+ CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
+{ x:=xpos; y:=ypos;}
+
+ for i:=1 to length(textstring) do
+ begin
+ c:=byte(textstring[i]);
+{ Stroke_Count[c] := }
+ unpack( fonts[CurrentTextInfo.font].instr,
+ fonts[CurrentTextInfo.font].Offsets[c], Strokes );
+ counter:=0;
+ while true do
+ begin
+ if CurrentTextInfo.direction=VertDir then
+ begin
+ xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
+ ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
+ end
+ else
+ begin
+ xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
+ ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
+ end;
+ case opcodes(Strokes[counter].opcode) of
+ _END_OF_CHAR: break;
+ _DO_SCAN: begin
+ { Currently unsupported };
+ end;
+ _MOVE : Begin
+ CurX2 := XPos2;
+ CurY2 := YPos2;
+ end;
+ _DRAW: Begin
+ curx2i:=trunc(CurX2);
+ cury2i:=trunc(CurY2);
+ xpos2i:=trunc(xpos2);
+ ypos2i:=trunc(ypos2);
+ { this optimization doesn't matter that much
+ if (curx2i=xpos2i) then
+ begin
+ if (cury2i=ypos2i) then
+ putpixel(curx2i,cury2i,currentcolor)
+ else if (cury2i+1=ypos2i) or
+ (cury2i=ypos2i+1) then
+ begin
+ putpixel(curx2i,cury2i,currentcolor);
+ putpixel(curx2i,ypos2i,currentcolor);
+ end
+ else
+ Line(curx2i,cury2i,xpos2i,ypos2i);
+ end
+ else if (cury2i=ypos2i) then
+ begin
+ if (curx2i+1=xpos2i) or
+ (curx2i=xpos2i+1) then
+ begin
+ putpixel(curx2i,cury2i,currentcolor);
+ putpixel(xpos2i,cury2i,currentcolor);
+ end
+ else
+ Line(curx2i,cury2i,xpos2i,ypos2i);
+ end
+ else
+ }
+ Line(curx2i,cury2i,xpos2i,ypos2i);
+ CurX2:=xpos2;
+ CurY2:=ypos2;
+ end;
+ else
+ Begin
+ end;
+ end;
+ Inc(counter);
+ end; { end while }
+ if Currenttextinfo.direction=VertDir then
+ y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
+ else
+ x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
+ end;
+ setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
+ end;
+ { restore write mode }
+ CurrentWriteMode := WriteMode;
+ end;
+
+procedure HLine16Win32GUI(x,x2,y: smallint);
+
+ var
+ c,c2 : COLORREF;
+ col,i : longint;
+ oldpen,pen : HPEN;
+
+ Begin
+ if graphrunning then
+ begin
+ { must we swap the values? }
+ if x>x2 then
+ Begin
+ x:=x xor x2;
+ x2:=x xor x2;
+ x:=x xor x2;
+ end;
+ if ClipPixels then
+ begin
+ if (x>ViewWidth) or (y<0) or (y>ViewHeight) or (x2<0) then
+ exit;
+ if x<0 then
+ x:=0;
+ if x2>ViewWidth then
+ x2:=ViewWidth;
+ end;
+ X:=X+StartXViewPort;
+ X2:=X2+StartXViewPort;
+ Y:=Y+StartYViewPort;
+ Case CurrentWriteMode of
+ AndPut:
+ Begin
+ EnterCriticalSection(graphdrawing);
+ col:=CurrentColor;
+ for i:=x to x2 do
+ begin
+ c2:=Windows.GetPixel(windc,i,y);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
+ if drawtobitmap then
+ SetPixelV(bitmapdc,i,y,c);
+
+ if drawtoscreen then
+ SetPixelV(windc,i,y,c);
+ end;
+ LeaveCriticalSection(graphdrawing);
+ End;
+ XorPut:
+ Begin
+ EnterCriticalSection(graphdrawing);
+ col:=CurrentColor;
+ for i:=x to x2 do
+ begin
+ c2:=Windows.GetPixel(windc,i,y);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
+
+ if drawtobitmap then
+ SetPixelV(bitmapdc,i,y,c);
+
+ if drawtoscreen then
+ SetPixelV(windc,i,y,c);
+ end;
+ LeaveCriticalSection(graphdrawing);
+ End;
+ OrPut:
+ Begin
+ EnterCriticalSection(graphdrawing);
+ col:=CurrentColor;
+ for i:=x to x2 do
+ begin
+ c2:=Windows.GetPixel(windc,i,y);
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
+
+ if drawtobitmap then
+ SetPixelV(bitmapdc,i,y,c);
+
+ if drawtoscreen then
+ SetPixelV(windc,i,y,c);
+ end;
+ LeaveCriticalSection(graphdrawing);
+ End
+ Else
+ Begin
+ If CurrentWriteMode<>NotPut Then
+ col:=CurrentColor
+ Else col:=Not(CurrentColor);
+ EnterCriticalSection(graphdrawing);
+ if x2-x<=2 then
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ for x := x to x2 do
+ begin
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ end;
+ end
+ else
+ begin
+ if (col>=0) and (col<=high(pens)) then
+ begin
+ if pens[col]=0 then
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ pens[col]:=CreatePen(PS_SOLID,1,c);
+ end;
+ pen:=pens[col];
+ end
+ else
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ pen:=CreatePen(PS_SOLID,1,c);
+ end;
+
+ if drawtobitmap then
+ begin
+ oldpen:=SelectObject(bitmapdc,pen);
+ Windows.MoveToEx(bitmapdc,x,y,nil);
+ Windows.LineTo(bitmapdc,x2+1,y);
+ SelectObject(bitmapdc,oldpen);
+ end;
+
+ if drawtoscreen then
+ begin
+ oldpen:=SelectObject(windc,pen);
+ Windows.MoveToEx(windc,x,y,nil);
+ Windows.LineTo(windc,x2+1,y);
+ SelectObject(windc,oldpen);
+ end;
+
+ if (col<0) or (col>high(pens)) then
+ DeleteObject(pen);
+ end;
+ LeaveCriticalSection(graphdrawing);
+ End;
+ End;
+ end;
+ end;
+
+procedure VLine16Win32GUI(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
+
+ var
+ ytmp: smallint;
+ col,c : longint;
+ oldpen,pen : HPEN;
+
+Begin
+ { must we swap the values? }
+ if y >= y2 then
+ Begin
+ ytmp := y2;
+ y2 := y;
+ y:= ytmp;
+ end;
+ if ClipPixels then
+ begin
+ if (x>ViewWidth) or (x<0) or (y>ViewHeight) or (y2<0) then
+ exit;
+ if y<0 then
+ y:=0;
+ if y2>ViewHeight then
+ y2:=ViewHeight;
+ end;
+ { First convert to global coordinates }
+ X := X + StartXViewPort;
+ Y2 := Y2 + StartYViewPort;
+ Y := Y + StartYViewPort;
+ if currentwritemode=normalput then
+ begin
+ col:=CurrentColor;
+ EnterCriticalSection(graphdrawing);
+ if y2-y<=2 then
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ for y := y to y2 do
+ begin
+ if drawtobitmap then
+ SetPixelV(bitmapdc,x,y,c);
+ if drawtoscreen then
+ SetPixelV(windc,x,y,c);
+ end;
+ end
+ else
+ begin
+ if (col>=0) and (col<=high(pens)) then
+ begin
+ if pens[col]=0 then
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ pens[col]:=CreatePen(PS_SOLID,1,c);
+ end;
+ pen:=pens[col];
+ end
+ else
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ pen:=CreatePen(PS_SOLID,1,c);
+ end;
+
+ if drawtobitmap then
+ begin
+ oldpen:=SelectObject(bitmapdc,pen);
+ Windows.MoveToEx(bitmapdc,x,y,nil);
+ Windows.LineTo(bitmapdc,x,y2+1);
+ SelectObject(bitmapdc,oldpen);
+ end;
+
+ if drawtoscreen then
+ begin
+ oldpen:=SelectObject(windc,pen);
+ Windows.MoveToEx(windc,x,y,nil);
+ Windows.LineTo(windc,x,y2+1);
+ SelectObject(windc,oldpen);
+ end;
+ if (col<0) or (col>high(pens)) then
+ DeleteObject(pen);
+ end;
+ LeaveCriticalSection(graphdrawing);
+ end
+ else
+ for y := y to y2 do Directputpixel(x,y)
+End;
+
+procedure Circle16Win32GUI(X, Y: smallint; Radius:Word);
+
+ var
+ bitmaprgn,winrgn : HRGN;
+ col,c : longint;
+ oldpen,pen : HPEN;
+ OriginalArcInfo: ArcCoordsType;
+ OldWriteMode: word;
+
+ begin
+ if (Radius = 0) then
+ Exit;
+
+ if (Radius = 1) then
+ begin
+ { only normal put mode is supported by a call to PutPixel }
+ PutPixel(X, Y, CurrentColor);
+ Exit;
+ end;
+
+ if (Radius = 2) then
+ begin
+ { only normal put mode is supported by a call to PutPixel }
+ PutPixel(X-1, Y, CurrentColor);
+ PutPixel(X+1, Y, CurrentColor);
+ PutPixel(X, Y-1, CurrentColor);
+ PutPixel(X, Y+1, CurrentColor);
+ Exit;
+ end;
+
+ if LineInfo.Thickness = Normwidth then
+ begin
+ EnterCriticalSection(graphdrawing);
+ { let windows do the clipping }
+ if drawtobitmap then
+ begin
+ bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
+ startxviewport+viewwidth+1,startyviewport+viewheight+1);
+ SelectClipRgn(bitmapdc,bitmaprgn);
+ end;
+
+ if drawtoscreen then
+ begin
+ winrgn:=CreateRectRgn(startxviewport,startyviewport,
+ startxviewport+viewwidth+1,startyviewport+viewheight+1);
+ SelectClipRgn(windc,winrgn);
+ end;
+
+ inc(x,StartXViewPort);
+ inc(y,StartYViewPort);
+ col:=CurrentColor;
+
+ if (col>=0) and (col<=high(pens)) then
+ begin
+ if pens[col]=0 then
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ pens[col]:=CreatePen(PS_SOLID,1,c);
+ end;
+ pen:=pens[col];
+ end
+ else
+ begin
+ c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
+ pen:=CreatePen(PS_SOLID,1,c);
+ end;
+
+ if drawtobitmap then
+ begin
+ oldpen:=SelectObject(bitmapdc,pen);
+ windows.arc(bitmapdc,x-radius,y-radius,x+radius,y+radius,
+ x,y-radius,x,y-radius);
+ SelectObject(bitmapdc,oldpen);
+ end;
+
+ if drawtoscreen then
+ begin
+ oldpen:=SelectObject(windc,pen);
+ windows.arc(windc,x-radius,y-radius,x+radius,y+radius,
+ x,y-radius,x,y-radius);
+ SelectObject(windc,oldpen);
+ end;
+
+ if (col<0) or (col>high(pens)) then
+ DeleteObject(pen);
+ { release clip regions }
+ if drawtoscreen then
+ begin
+ SelectClipRgn(windc,0);
+ DeleteObject(winrgn);
+ end;
+ if drawtobitmap then
+ begin
+ SelectClipRgn(bitmapdc,0);
+ DeleteObject(bitmaprgn);
+ end;
+ LeaveCriticalSection(graphdrawing);
+ end
+ else
+ begin
+ { save state of arc information }
+ { because it is not needed for }
+ { a circle call. }
+ move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
+ InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
+ { restore arc information }
+ move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
+ end;
+ end;
+
+{
+Procedure PutImageWin32GUI(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
+type
+ pt = array[0..$fffffff] of word;
+ ptw = array[0..2] of longint;
+var
+ k: longint;
+ oldCurrentColor: word;
+ oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
+Begin
+{$ifdef logging}
+ LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
+ ' and height '+strf(ptw(Bitmap)[1]));
+ deltaY := 0;
+{$endif logging}
+ inc(x,startXViewPort);
+ inc(y,startYViewPort);
+ x1 := ptw(Bitmap)[0]+x; { get width and adjust end coordinate accordingly }
+ y1 := ptw(Bitmap)[1]+y; { get height and adjust end coordinate accordingly }
+
+ deltaX := 0;
+ deltaX1 := 0;
+ k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
+ { check which part of the image is in the viewport }
+ if clipPixels then
+ begin
+ if y < startYViewPort then
+ begin
+ deltaY := startYViewPort - y;
+ inc(k,(x1-x+1)*deltaY);
+ y := startYViewPort;
+ end;
+ if y1 > startYViewPort+viewHeight then
+ y1 := startYViewPort+viewHeight;
+ if x < startXViewPort then
+ begin
+ deltaX := startXViewPort-x;
+ x := startXViewPort;
+ end;
+ if x1 > startXViewPort + viewWidth then
+ begin
+ deltaX1 := x1 - (startXViewPort + viewWidth);
+ x1 := startXViewPort + viewWidth;
+ end;
+ end;
+{$ifdef logging}
+ LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
+{$endif logging}
+ case bitBlt of
+ end;
+ oldCurrentColor := currentColor;
+ oldCurrentWriteMode := currentWriteMode;
+ currentWriteMode := bitBlt;
+ for j:=Y to Y1 do
+ Begin
+ inc(k,deltaX);
+ for i:=X to X1 do
+ begin
+ currentColor := pt(bitmap)[k];
+ directPutPixel(i,j);
+ inc(k);
+ end;
+ inc(k,deltaX1);
+ end;
+ currentWriteMode := oldCurrentWriteMode;
+ currentColor := oldCurrentColor;
+end;
+}
+procedure SetRGBPaletteWin32GUI(colorNum,redValue,greenvalue,
+ bluevalue : smallint);
+
+ begin
+ if directcolor or (colornum<0) or (colornum>=maxcolor) then
+ begin
+ _graphresult:=grerror;
+ exit;
+ end;
+ pal[colorNum].red:=redValue;
+ pal[colorNum].green:=greenValue;
+ pal[colorNum].blue:=blueValue;
+ if (colorNum>=0) and (colorNum<=high(pens)) and (pens[colorNum]<>0) then
+ begin
+ DeleteObject(pens[colorNum]);
+ pens[colorNum]:=0;
+ end;
+ end;
+
+procedure GetRGBPaletteWin32GUI(colorNum : smallint;
+ var redValue,greenvalue,bluevalue : smallint);
+
+ begin
+ if directcolor or (colornum<0) or (colornum>=maxcolor) then
+ begin
+ _graphresult:=grerror;
+ exit;
+ end;
+ redValue:=pal[colorNum].red;
+ greenValue:=pal[colorNum].green;
+ blueValue:=pal[colorNum].blue;
+ end;
+
+procedure savestate;
+
+ begin
+ end;
+
+
+procedure restorestate;
+
+ begin
+ end;
+
+function WindowProcGraph(Window: HWnd; AMessage:UInt; WParam : WParam;
+ LParam: LParam): Longint; stdcall;
+
+ var
+ dc : hdc;
+ ps : paintstruct;
+ r : rect;
+ oldbrush : hbrush;
+ oldpen : hpen;
+ i : longint;
+
+begin
+ WindowProcGraph := 0;
+
+ case AMessage of
+ wm_lbuttondown,
+ wm_rbuttondown,
+ wm_mbuttondown,
+ wm_lbuttonup,
+ wm_rbuttonup,
+ wm_mbuttonup,
+ wm_lbuttondblclk,
+ wm_rbuttondblclk,
+ wm_mbuttondblclk:
+ {
+ This leads to problem, i.e. the menu etc doesn't work any longer
+ wm_nclbuttondown,
+ wm_ncrbuttondown,
+ wm_ncmbuttondown,
+ wm_nclbuttonup,
+ wm_ncrbuttonup,
+ wm_ncmbuttonup,
+ wm_nclbuttondblclk,
+ wm_ncrbuttondblclk,
+ wm_ncmbuttondblclk:
+ }
+ begin
+ if assigned(mousemessagehandler) then
+ WindowProcGraph:=mousemessagehandler(window,amessage,wparam,lparam);
+ end;
+ wm_notify:
+ begin
+ if assigned(notifymessagehandler) then
+ WindowProcGraph:=notifymessagehandler(window,amessage,wparam,lparam);
+ end;
+ wm_command:
+ if assigned(commandmessagehandler) then
+ WindowProcGraph:=commandmessagehandler(window,amessage,wparam,lparam);
+ wm_keydown,
+ wm_keyup,
+ wm_char:
+ begin
+ if assigned(charmessagehandler) then
+ WindowProcGraph:=charmessagehandler(window,amessage,wparam,lparam);
+ end;
+ wm_paint:
+ begin
+{$ifdef DEBUG_WM_PAINT}
+ inc(wm_paint_count);
+{$endif DEBUG_WM_PAINT}
+{$ifdef DEBUGCHILDS}
+ writeln('Start child painting');
+{$endif DEBUGCHILDS}
+ if not GetUpdateRect(Window,@r,false) then
+ exit;
+ EnterCriticalSection(graphdrawing);
+ graphrunning:=true;
+ dc:=BeginPaint(Window,@ps);
+{$ifdef DEBUG_WM_PAINT}
+ Writeln(graphdebug,'WM_PAINT in ((',r.left,',',r.top,
+ '),(',r.right,',',r.bottom,'))');
+{$endif def DEBUG_WM_PAINT}
+ if graphrunning then
+ {BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY);}
+ BitBlt(dc,r.left,r.top,r.right-r.left+1,r.bottom-r.top+1,bitmapdc,r.left,r.top,SRCCOPY);
+ EndPaint(Window,ps);
+ LeaveCriticalSection(graphdrawing);
+ Exit;
+ end;
+ wm_create:
+ begin
+{$ifdef DEBUG_WM_PAINT}
+ assign(graphdebug,'wingraph.log');
+ rewrite(graphdebug);
+{$endif DEBUG_WM_PAINT}
+{$ifdef DEBUGCHILDS}
+ writeln('Creating window (HWND: ',window,')... ');
+{$endif DEBUGCHILDS}
+ GraphWindow:=window;
+ EnterCriticalSection(graphdrawing);
+ dc:=GetDC(window);
+{$ifdef DEBUGCHILDS}
+ writeln('Window DC: ',dc);
+{$endif DEBUGCHILDS}
+ bitmapdc:=CreateCompatibleDC(dc);
+ savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1);
+ ReleaseDC(window,dc);
+ oldbitmap:=SelectObject(bitmapdc,savedscreen);
+ windc:=GetDC(window);
+ // clear everything
+ oldpen:=SelectObject(bitmapdc,GetStockObject(BLACK_PEN));
+ oldbrush:=SelectObject(bitmapdc,GetStockObject(BLACK_BRUSH));
+ Windows.Rectangle(bitmapdc,0,0,maxx,maxy);
+ SelectObject(bitmapdc,oldpen);
+ SelectObject(bitmapdc,oldbrush);
+ // ... the window too
+ oldpen:=SelectObject(windc,GetStockObject(BLACK_PEN));
+ oldbrush:=SelectObject(windc,GetStockObject(BLACK_BRUSH));
+ Windows.Rectangle(windc,0,0,maxx,maxy);
+ SelectObject(windc,oldpen);
+ SelectObject(windc,oldbrush);
+ // clear font cache
+ fillchar(bitmapfonthorizoncache,sizeof(bitmapfonthorizoncache),0);
+ fillchar(bitmapfontverticalcache,sizeof(bitmapfontverticalcache),0);
+
+ // clear predefined pens
+ fillchar(pens,sizeof(pens),0);
+ if assigned(OnGraphWindowCreation) then
+ OnGraphWindowCreation;
+ LeaveCriticalSection(graphdrawing);
+{$ifdef DEBUGCHILDS}
+ writeln('done');
+ GetClientRect(window,@r);
+ writeln('Window size: ',r.right,',',r.bottom);
+{$endif DEBUGCHILDS}
+ end;
+ wm_Destroy:
+ begin
+ EnterCriticalSection(graphdrawing);
+ graphrunning:=false;
+ ReleaseDC(GraphWindow,windc);
+ SelectObject(bitmapdc,oldbitmap);
+ DeleteObject(savedscreen);
+ DeleteDC(bitmapdc);
+ // release font cache
+ for i:=0 to 255 do
+ if bitmapfonthorizoncache[i]<>0 then
+ DeleteObject(bitmapfonthorizoncache[i]);
+ for i:=0 to 255 do
+ if bitmapfontverticalcache[i]<>0 then
+ DeleteObject(bitmapfontverticalcache[i]);
+
+ for i:=0 to high(pens) do
+ if pens[i]<>0 then
+ DeleteObject(pens[i]);
+
+ LeaveCriticalSection(graphdrawing);
+{$ifdef DEBUG_WM_PAINT}
+ close(graphdebug);
+{$endif DEBUG_WM_PAINT}
+ PostQuitMessage(0);
+ Exit;
+ end
+ else
+ WindowProcGraph := DefWindowProc(Window, AMessage, WParam, LParam);
+ end;
+end;
+
+function WindowProcParent(Window: HWnd; AMessage:UInt; WParam : WParam;
+ LParam: LParam): Longint; stdcall;
+
+begin
+ WindowProcParent := 0;
+ case AMessage of
+ wm_keydown,
+ wm_keyup,
+ wm_char:
+ begin
+ if assigned(charmessagehandler) then
+ WindowProcParent:=charmessagehandler(window,amessage,wparam,lparam);
+ end;
+ wm_notify:
+ begin
+ if assigned(notifymessagehandler) then
+ WindowProcParent:=notifymessagehandler(window,amessage,wparam,lparam);
+ end;
+ wm_command:
+ if assigned(commandmessagehandler) then
+ WindowProcParent:=commandmessagehandler(window,amessage,wparam,lparam);
+ else
+ WindowProcParent := DefWindowProc(Window, AMessage, WParam, LParam);
+ end;
+end;
+
+function WinRegister: Boolean;
+var
+ WindowClass: WndClass;
+begin
+ WindowClass.Style := graphwindowstyle;
+ WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
+ WindowClass.cbClsExtra := 0;
+ WindowClass.cbWndExtra := 0;
+ WindowClass.hInstance := system.MainInstance;
+ if icon<>0 then
+ WindowClass.hIcon := icon
+ else
+ WindowClass.hIcon := LoadIcon(0, idi_Application);
+ WindowClass.hCursor := LoadCursor(0, idc_Arrow);
+ WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
+ if menu<>0 then
+ WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
+ else
+ WindowClass.lpszMenuName := nil;
+ WindowClass.lpszClassName := 'FPCGraphWindow';
+
+ winregister:=RegisterClass(WindowClass) <> 0;
+end;
+
+function WinRegisterWithChild: Boolean;
+var
+ WindowClass: WndClass;
+begin
+ WindowClass.Style := graphwindowstyle;
+ WindowClass.lpfnWndProc := WndProc(@WindowProcParent);
+ WindowClass.cbClsExtra := 0;
+ WindowClass.cbWndExtra := 0;
+ WindowClass.hInstance := system.MainInstance;
+ if icon<>0 then
+ WindowClass.hIcon := icon
+ else
+ WindowClass.hIcon := LoadIcon(0, idi_Application);
+ WindowClass.hCursor := LoadCursor(0, idc_Arrow);
+ WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
+ if menu<>0 then
+ WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
+ else
+ WindowClass.lpszMenuName := nil;
+ WindowClass.lpszClassName := 'FPCGraphWindowMain';
+
+ WinRegisterWithChild:=RegisterClass(WindowClass) <> 0;
+{$ifdef DEBUGCHILDS}
+ writeln('Main window successfully registered: WinRegisterWithChild is ',WinRegisterWithChild);
+{$endif DEBUGCHILDS}
+ if WinRegisterWithChild then
+ begin
+ WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
+ WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
+ WindowClass.cbClsExtra := 0;
+ WindowClass.cbWndExtra := 0;
+ WindowClass.hInstance := system.MainInstance;
+ WindowClass.hIcon := 0;
+ WindowClass.hCursor := LoadCursor(0, idc_Arrow);
+ WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
+ WindowClass.lpszMenuName := nil;
+ WindowClass.lpszClassName := 'FPCGraphWindowChild';
+ WinRegisterWithChild:=RegisterClass(WindowClass)<>0;
+{$ifdef DEBUGCHILDS}
+ writeln('Child window registered: WinRegisterWithChild is ',WinRegisterWithChild);
+{$endif DEBUGCHILDS}
+ end;
+end;
+
+var
+ // here we can force the creation of a maximized window }
+ extrastyle : cardinal;
+
+ { Create the Window Class }
+function WinCreate : HWnd;
+var
+ hWindow: HWnd;
+begin
+ WinCreate:=0;
+ if UseChildWindow then
+ begin
+ ParentWindow:=CreateWindow('FPCGraphWindowMain', windowtitle,
+ WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or extrastyle, longint(CW_USEDEFAULT), 0,
+ maxx+ChildOffset.Left+ChildOffset.Right+1+
+ 2*GetSystemMetrics(SM_CXFRAME),
+ maxy+ChildOffset.Top+ChildOffset.Bottom+1+
+ 2*GetSystemMetrics(SM_CYFRAME)+
+ GetSystemMetrics(SM_CYCAPTION),
+ 0, 0, system.MainInstance, nil);
+ if ParentWindow<>0 then
+ begin
+ ShowWindow(ParentWindow, SW_SHOW);
+ UpdateWindow(ParentWindow);
+ end
+ else
+ exit;
+ hWindow:=CreateWindow('FPCGraphWindowChild',nil,
+ WS_CHILD, ChildOffset.Left,ChildOffset.Top,
+ maxx+1,maxy+1,
+ ParentWindow, 0, system.MainInstance, nil);
+ if hwindow<>0 then
+ begin
+ ShowWindow(hwindow, SW_SHOW);
+ UpdateWindow(hwindow);
+ end
+ else
+ exit;
+ WinCreate:=hWindow;
+ end
+ else
+ begin
+ hWindow:=CreateWindow('FPCGraphWindow', windowtitle,
+ ws_OverlappedWindow or extrastyle, longint(CW_USEDEFAULT), 0,
+ maxx+1+2*GetSystemMetrics(SM_CXFRAME),
+ maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
+ GetSystemMetrics(SM_CYCAPTION),
+ 0, 0, system.MainInstance, nil);
+ if hWindow <> 0 then
+ begin
+ ShowWindow(hWindow, SW_SHOW);
+ UpdateWindow(hWindow);
+ WinCreate:=hWindow;
+ end;
+ end;
+end;
+
+const
+ winregistered : boolean = false;
+
+function MessageHandleThread(p : pointer) : DWord;StdCall;
+
+ var
+ AMessage: Msg;
+
+ begin
+ if not(winregistered) then
+ begin
+ if UseChildWindow then
+ begin
+ if not(WinRegisterWithChild) then
+ begin
+ MessageBox(0, 'Window registration failed', nil, mb_Ok);
+ ExitThread(1);
+ end;
+ end
+ else
+ begin
+ if not(WinRegister) then
+ begin
+ MessageBox(0, 'Window registration failed', nil, mb_Ok);
+ ExitThread(1);
+ end;
+ end;
+ winregistered:=true;
+ end;
+ GraphWindow:=WinCreate;
+ if longint(GraphWindow) = 0 then begin
+ MessageBox(0, 'Window creation failed', nil, mb_Ok);
+ ExitThread(1);
+ end;
+ while longint(GetMessage(@AMessage, 0, 0, 0))=longint(true) do
+ begin
+ TranslateMessage(AMessage);
+ DispatchMessage(AMessage);
+ end;
+ MessageHandleThread:=0;
+ end;
+
+procedure InitWin32GUI16colors;
+
+ var
+ threadexitcode : longint;
+ begin
+ getmem(pal,sizeof(RGBrec)*maxcolor);
+ move(DefaultColors,pal^,sizeof(RGBrec)*maxcolor);
+ if (IntCurrentMode=mMaximizedWindow16) or
+ (IntCurrentMode=mMaximizedWindow256) or
+ (IntCurrentMode=mMaximizedWindow32k) or
+ (IntCurrentMode=mMaximizedWindow64k) or
+ (IntCurrentMode=mMaximizedWindow16M) then
+ extrastyle:=ws_maximize
+ else
+ extrastyle:=0;
+ { start graph subsystem }
+ InitializeCriticalSection(graphdrawing);
+ graphrunning:=false;
+ MessageThreadHandle:=CreateThread(nil,0,@MessageHandleThread,
+ nil,0,MessageThreadID);
+ repeat
+ GetExitCodeThread(MessageThreadHandle,@threadexitcode);
+ until graphrunning or (threadexitcode<>STILL_ACTIVE);
+ if threadexitcode<>STILL_ACTIVE then
+ _graphresult := grerror;
+ end;
+
+procedure CloseGraph;
+
+ begin
+ If not isgraphmode then
+ begin
+ _graphresult := grnoinitgraph;
+ exit
+ end;
+ if UseChildWindow then
+ begin
+ { if the child window isn't destroyed }
+ { the main window can't be closed }
+ { I don't know any other way (FK) }
+ PostMessage(GraphWindow,wm_destroy,0,0);
+ PostMessage(ParentWindow,wm_destroy,0,0)
+ end
+ else
+ PostMessage(GraphWindow,wm_destroy,0,0);
+
+ PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
+ WaitForSingleObject(MessageThreadHandle,Infinite);
+ CloseHandle(MessageThreadHandle);
+ DeleteCriticalSection(graphdrawing);
+ freemem(pal,sizeof(RGBrec)*maxcolor);
+
+ MessageThreadID := 0;
+ MessageThreadHandle := 0;
+ isgraphmode := false;
+ end;
+
+procedure LineWin32GUI(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
+
+ var X, Y : smallint;
+ deltax, deltay : smallint;
+ d, dinc1, dinc2: smallint;
+ xinc1 : smallint;
+ xinc2 : smallint;
+ yinc1 : smallint;
+ yinc2 : smallint;
+ i : smallint;
+ Flag : Boolean; { determines pixel direction in thick lines }
+ NumPixels : smallint;
+ PixelCount : smallint;
+ OldCurrentColor: Word;
+ swtmp : smallint;
+ TmpNumPixels : smallint;
+ col : longint;
+ pen,oldpen : hpen;
+
+ begin
+ if graphrunning then
+ begin
+ {******************************************}
+ { SOLID LINES }
+ {******************************************}
+ if lineinfo.LineStyle = SolidLn then
+ Begin
+ { Convert to global coordinates. }
+ x1 := x1 + StartXViewPort;
+ x2 := x2 + StartXViewPort;
+ y1 := y1 + StartYViewPort;
+ y2 := y2 + StartYViewPort;
+ { if fully clipped then exit... }
+ if ClipPixels then
+ begin
+ if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ If LineInfo.Thickness=NormWidth then
+ Begin
+ EnterCriticalSection(graphdrawing);
+ {
+ if currentwritemode<>normalput then
+ begin
+ case currentwritemode of
+ XORPut:
+ begin
+ SetROP2(windc,R2_XORPEN);
+ SetROP2(bitmapdc,R2_XORPEN);
+ end;
+ AndPut:
+ begin
+ SetROP2(windc,R2_MASKPEN);
+ SetROP2(bitmapdc,R2_MASKPEN);
+ end;
+ OrPut:
+ begin
+ SetROP2(windc,R2_MERGEPEN);
+ SetROP2(bitmapdc,R2_MERGEPEN);
+ end;
+ end;
+ end;
+ }
+ col:=RGB(pal[CurrentColor].red,pal[CurrentColor].green,pal[CurrentColor].blue);
+ pen:=CreatePen(PS_SOLID,1,col);
+ if pen=0 then
+ writeln('Pen konnte nicht erzeugt werden!');
+
+ oldpen:=SelectObject(windc,pen);
+ MoveToEx(windc,x1,y1,nil);
+ Windows.LineTo(windc,x2,y2);
+ SetPixel(windc,x2,y2,col);
+ SelectObject(windc,oldpen);
+
+ oldpen:=SelectObject(bitmapdc,pen);
+ MoveToEx(bitmapdc,x1,y1,nil);
+ Windows.LineTo(bitmapdc,x2,y2);
+ SetPixel(bitmapdc,x2,y2,col);
+ SelectObject(bitmapdc,oldpen);
+
+ DeleteObject(pen);
+ {
+ if currentwritemode<>normalput then
+ begin
+ SetROP2(windc,R2_COPYPEN);
+ SetROP2(bitmapdc,R2_COPYPEN);
+ end;
+ }
+ LeaveCriticalSection(graphdrawing);
+ end
+ else
+ { Thick width lines }
+ begin
+ { Draw the pixels }
+ for i := 1 to numpixels do
+ begin
+ { all depending on the slope, we can determine }
+ { in what direction the extra width pixels will be put }
+ If Flag then
+ Begin
+ DirectPutPixelClip(x-1,y);
+ DirectPutPixelClip(x,y);
+ DirectPutPixelClip(x+1,y);
+ end
+ else
+ Begin
+ DirectPutPixelClip(x, y-1);
+ DirectPutPixelClip(x, y);
+ DirectPutPixelClip(x, y+1);
+ end;
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ end;
+ end;
+ end;
+ end
+ else
+ {******************************************}
+ { begin patterned lines }
+ {******************************************}
+ Begin
+ { Convert to global coordinates. }
+ x1 := x1 + StartXViewPort;
+ x2 := x2 + StartXViewPort;
+ y1 := y1 + StartYViewPort;
+ y2 := y2 + StartYViewPort;
+ { if fully clipped then exit... }
+ if ClipPixels then
+ begin
+ if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+
+ OldCurrentColor := CurrentColor;
+ PixelCount:=0;
+ if y1 = y2 then
+ Begin
+ { Check if we must swap }
+ if x1 >= x2 then
+ Begin
+ swtmp := x1;
+ x1 := x2;
+ x2 := swtmp;
+ end;
+ if LineInfo.Thickness = NormWidth then
+ Begin
+ for PixelCount:=x1 to x2 do
+ { optimization: PixelCount mod 16 }
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixel(PixelCount,y2);
+ end;
+ end
+ else
+ Begin
+ for i:=-1 to 1 do
+ Begin
+ for PixelCount:=x1 to x2 do
+ { Optimization from Thomas - mod 16 = and 15 }
+ {this optimization has been performed by the compiler
+ for while as well (JM)}
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixelClip(PixelCount,y2+i);
+ end;
+ end;
+ end;
+ end
+ else
+ if x1 = x2 then
+ Begin
+ { Check if we must swap }
+ if y1 >= y2 then
+ Begin
+ swtmp := y1;
+ y1 := y2;
+ y2 := swtmp;
+ end;
+ if LineInfo.Thickness = NormWidth then
+ Begin
+ for PixelCount:=y1 to y2 do
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixel(x1,PixelCount);
+ end;
+ end
+ else
+ Begin
+ for i:=-1 to 1 do
+ Begin
+ for PixelCount:=y1 to y2 do
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[PixelCount and 15] = TRUE then
+ begin
+ DirectPutPixelClip(x1+i,PixelCount);
+ end;
+ end;
+ end;
+ end
+ else
+ Begin
+ oldCurrentColor := CurrentColor;
+ { Calculate deltax and deltay for initialisation }
+ deltax := abs(x2 - x1);
+ deltay := abs(y2 - y1);
+
+ { Initialize all vars based on which is the independent variable }
+ if deltax >= deltay then
+ begin
+
+ Flag := FALSE;
+ { x is independent variable }
+ numpixels := deltax + 1;
+ d := (2 * deltay) - deltax;
+ dinc1 := deltay Shl 1;
+ dinc2 := (deltay - deltax) shl 1;
+ xinc1 := 1;
+ xinc2 := 1;
+ yinc1 := 0;
+ yinc2 := 1;
+ end
+ else
+ begin
+
+ Flag := TRUE;
+ { y is independent variable }
+ numpixels := deltay + 1;
+ d := (2 * deltax) - deltay;
+ dinc1 := deltax Shl 1;
+ dinc2 := (deltax - deltay) shl 1;
+ xinc1 := 0;
+ xinc2 := 1;
+ yinc1 := 1;
+ yinc2 := 1;
+ end;
+
+ { Make sure x and y move in the right directions }
+ if x1 > x2 then
+ begin
+ xinc1 := - xinc1;
+ xinc2 := - xinc2;
+ end;
+ if y1 > y2 then
+ begin
+ yinc1 := - yinc1;
+ yinc2 := - yinc2;
+ end;
+
+ { Start drawing at <x1, y1> }
+ x := x1;
+ y := y1;
+
+ If LineInfo.Thickness=ThickWidth then
+
+ Begin
+ TmpNumPixels := NumPixels-1;
+ { Draw the pixels }
+ for i := 0 to TmpNumPixels do
+ begin
+ { all depending on the slope, we can determine }
+ { in what direction the extra width pixels will be put }
+ If Flag then
+ Begin
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[i and 15] = TRUE then
+ begin
+ DirectPutPixelClip(x-1,y);
+ DirectPutPixelClip(x,y);
+ DirectPutPixelClip(x+1,y);
+ end;
+ end
+ else
+ Begin
+ { compare if we should plot a pixel here , compare }
+ { with predefined line patterns... }
+ if LinePatterns[i and 15] = TRUE then
+ begin
+ DirectPutPixelClip(x,y-1);
+ DirectPutPixelClip(x,y);
+ DirectPutPixelClip(x,y+1);
+ end;
+ end;
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ end;
+ end
+ else
+ Begin
+ { instead of putting in loop , substract by one now }
+ TmpNumPixels := NumPixels-1;
+ { NormWidth }
+ for i := 0 to TmpNumPixels do
+ begin
+ if LinePatterns[i and 15] = TRUE then
+ begin
+ DirectPutPixel(x,y);
+ end;
+ if d < 0 then
+ begin
+ d := d + dinc1;
+ x := x + xinc1;
+ y := y + yinc1;
+ end
+ else
+ begin
+ d := d + dinc2;
+ x := x + xinc2;
+ y := y + yinc2;
+ end;
+ end;
+ end
+ end;
+ {******************************************}
+ { end patterned lines }
+ {******************************************}
+ { restore color }
+ CurrentColor:=OldCurrentColor;
+ end;
+ end;
+ end; { Line }
+
+{ multipage support could be done by using more than one background bitmap }
+procedure SetVisualWin32GUI(page: word);
+
+ begin
+ end;
+
+procedure SetActiveWin32GUI(page: word);
+ begin
+ end;
+
+function queryadapterinfo : pmodeinfo;
+
+ var
+ mode: TModeInfo;
+ ScreenWidth,ScreenHeight : longint;
+ ScreenWidthMaximized,ScreenHeightMaximized : longint;
+
+ procedure SetupWin32GUIDefault;
+
+ begin
+ mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
+ mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
+ mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
+ mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
+ mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
+ mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
+ mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
+ mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
+ mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
+ mode.OuttextXY:={$ifdef fpc}@{$endif}OuttextXYWin32GUI;
+ mode.VLine := {$ifdef fpc}@{$endif}VLine16Win32GUI;
+ // mode.circle := {$ifdef fpc}@{$endif}Circle16Win32GUI;
+ // doesn't work yet
+ // mode.Line:={$ifdef fpc}@{$endif}LineWin32GUI;
+ end;
+
+ begin
+ SaveVideoState:={$ifdef fpc}@{$endif}savestate;
+ RestoreVideoState:={$ifdef fpc}@{$endif}restorestate;
+ { we must take care of the border and caption }
+ ScreenWidth:=GetSystemMetrics(SM_CXSCREEN)-
+ 2*GetSystemMetrics(SM_CXFRAME);
+ ScreenHeight:=GetSystemMetrics(SM_CYSCREEN)-
+ 2*GetSystemMetrics(SM_CYFRAME)-
+ GetSystemMetrics(SM_CYCAPTION);
+ { for maximozed windows it's again different }
+ { here we've only a caption }
+ ScreenWidthMaximized:=GetSystemMetrics(SM_CXFULLSCREEN);
+ { neither GetSystemMetrics(SM_CYFULLSCREEN nor }
+ { SystemParametersInfo(SPI_GETWORKAREA) }
+ { takes a hidden try into account :( FK }
+ ScreenHeightMaximized:=GetSystemMetrics(SM_CYFULLSCREEN);
+
+ QueryAdapterInfo := ModeList;
+ { If the mode listing already exists... }
+ { simply return it, without changing }
+ { anything... }
+ if assigned(ModeList) then
+ exit;
+ { the first one becomes the standard mode }
+ if (ScreenWidth>=640) and (ScreenHeight>=480) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VGA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=VGAHi;
+ mode.ModeName:='640 x 480 x 16 Win32GUI';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 639;
+ mode.MaxY := 479;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if (ScreenWidth>=640) and (ScreenHeight>=200) then
+ begin
+ InitMode(mode);
+ { now add all standard VGA modes... }
+ mode.DriverNumber:= VGA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=VGALo;
+ mode.ModeName:='640 x 200 x 16 Win32GUI';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 639;
+ mode.MaxY := 199;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if (ScreenWidth>=640) and (ScreenHeight>=350) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VGA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=VGAMed;
+ mode.ModeName:='640 x 350 x 16 Win32GUI';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 639;
+ mode.MaxY := 349;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if (ScreenWidth>=640) and (ScreenHeight>=400) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m640x400x256;
+ mode.ModeName:='640 x 400 x 256 Win32GUI';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 639;
+ mode.MaxY := 399;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ if (ScreenWidth>=640) and (ScreenHeight>=480) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m640x480x256;
+ mode.ModeName:='640 x 480 x 256 Win32GUI';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 639;
+ mode.MaxY := 479;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ { add 800x600 only if screen is large enough }
+ If (ScreenWidth>=800) and (ScreenHeight>=600) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m800x600x16;
+ mode.ModeName:='800 x 600 x 16 Win32GUI';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 799;
+ mode.MaxY := 599;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m800x600x256;
+ mode.ModeName:='800 x 600 x 256 Win32GUI';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 799;
+ mode.MaxY := 599;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ { add 1024x768 only if screen is large enough }
+ If (ScreenWidth>=1024) and (ScreenHeight>=768) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m1024x768x16;
+ mode.ModeName:='1024 x 768 x 16 Win32GUI';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 1023;
+ mode.MaxY := 767;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m1024x768x256;
+ mode.ModeName:='1024 x 768 x 256 Win32GUI';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 1023;
+ mode.MaxY := 768;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ { add 1280x1024 only if screen is large enough }
+ If (ScreenWidth>=1280) and (ScreenHeight>=1024) then
+ begin
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m1280x1024x16;
+ mode.ModeName:='1280 x 1024 x 16 Win32GUI';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 1279;
+ mode.MaxY := 1023;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=m1280x1024x256;
+ mode.ModeName:='1280 x 1024 x 256 Win32GUI';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := 1279;
+ mode.MaxY := 1023;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+ { at least we add a mode with the largest possible window }
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=mLargestWindow16;
+ mode.ModeName:='Largest Window x 16';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := ScreenWidth-1;
+ mode.MaxY := ScreenHeight-1;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=mLargestWindow256;
+ mode.ModeName:='Largest Window x 256';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := ScreenWidth-1;
+ mode.MaxY := ScreenHeight-1;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ { .. and a maximized window }
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=mMaximizedWindow16;
+ mode.ModeName:='Maximized Window x 16';
+ mode.MaxColor := 16;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := ScreenWidthMaximized-1;
+ mode.MaxY := ScreenHeightMaximized-1;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ InitMode(mode);
+ mode.DriverNumber:= VESA;
+ mode.HardwarePages:= 0;
+ mode.ModeNumber:=mMaximizedWindow256;
+ mode.ModeName:='Maximized Window x 256';
+ mode.MaxColor := 256;
+ mode.PaletteSize := mode.MaxColor;
+ mode.DirectColor := FALSE;
+ mode.MaxX := ScreenWidthMaximized-1;
+ mode.MaxY := ScreenHeightMaximized-1;
+ SetupWin32GUIDefault;
+ mode.XAspect := 10000;
+ mode.YAspect := 10000;
+ AddMode(mode);
+ end;
+
+begin
+ InitializeGraph;
+ charmessagehandler:=nil;
+ mousemessagehandler:=nil;
+ commandmessagehandler:=nil;
+ notifymessagehandler:=nil;
+ OnGraphWindowCreation:=nil;
+end.
+{
+ $Log: graph.pp,v $
+ Revision 1.15 2005/04/04 16:13:09 peter
+ * use smallint
+
+ Revision 1.14 2005/03/31 12:47:20 marco
+ * fix from Thomas Schatzl for 3208
+
+ Revision 1.13 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/initc.pp b/rtl/win32/initc.pp
new file mode 100644
index 0000000000..1faaef0ef9
--- /dev/null
+++ b/rtl/win32/initc.pp
@@ -0,0 +1,40 @@
+{
+ $Id: initc.pp,v 1.16 2005/02/14 17:13:32 peter Exp $
+}
+unit initc;
+
+interface
+
+type
+ libcint = longint;
+ plibcint = ^libcint;
+
+function fpgetCerrno:libcint;
+procedure fpsetCerrno(err:libcint);
+
+{$ifndef ver1_0}
+property cerrno:libcint read fpgetCerrno write fpsetcerrno;
+{$endif}
+
+
+implementation
+
+function geterrnolocation: Plibcint; cdecl;external 'cygwin1.dll' name '__errno';
+
+function fpgetCerrno:libcint;
+begin
+ fpgetCerrno:=geterrnolocation^;
+end;
+
+procedure fpsetCerrno(err:libcint);
+begin
+ geterrnolocation^:=err;
+end;
+
+end.
+{
+ $Log: initc.pp,v $
+ Revision 1.16 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/keyboard.pp b/rtl/win32/keyboard.pp
new file mode 100644
index 0000000000..21f4efc116
--- /dev/null
+++ b/rtl/win32/keyboard.pp
@@ -0,0 +1,885 @@
+{
+ $Id: keyboard.pp,v 1.13 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Keyboard unit for Win32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Keyboard;
+interface
+{$ifdef DEBUG}
+uses
+ windows;
+
+var
+ last_ir : Input_Record;
+{$endif DEBUG}
+
+{$i keybrdh.inc}
+
+implementation
+
+{ WARNING: Keyboard-Drivers (i.e. german) will only work under WinNT.
+ 95 and 98 do not support keyboard-drivers other than us for win32
+ console-apps. So we always get the keys in us-keyboard layout
+ from Win9x.
+}
+
+uses
+{$ifndef DEBUG}
+ Windows,
+{$endif DEBUG}
+ Dos,
+ WinEvent;
+
+{$i keyboard.inc}
+
+const MaxQueueSize = 120;
+ FrenchKeyboard = $040C040C;
+
+var
+ keyboardeventqueue : array[0..maxqueuesize] of TKeyEventRecord;
+ nextkeyevent,nextfreekeyevent : longint;
+ newKeyEvent : THandle; {sinaled if key is available}
+ lockVar : TCriticalSection; {for queue access}
+ lastShiftState : byte; {set by handler for PollShiftStateEvent}
+ altNumActive : boolean; {for alt+0..9}
+ altNumBuffer : string [3];
+ { used for keyboard specific stuff }
+ KeyBoardLayout : HKL;
+ Inited : Boolean;
+ HasAltGr : Boolean{$ifndef ver1_0} = false {$endif};
+
+
+
+procedure incqueueindex(var l : longint);
+
+ begin
+ inc(l);
+ { wrap around? }
+ if l>maxqueuesize then
+ l:=0;
+ end;
+
+function keyEventsInQueue : boolean;
+begin
+ keyEventsInQueue := (nextkeyevent <> nextfreekeyevent);
+end;
+
+function rightistruealt(dw:cardinal):boolean; // inline ?
+// used to wrap checks for right alt/altgr.
+begin
+ rightistruealt:=true;
+ if hasaltgr then
+ rightistruealt:=(dw and RIGHT_ALT_PRESSED)=0;
+end;
+
+
+{ gets or peeks the next key from the queue, does not wait for new keys }
+function getKeyEventFromQueue (VAR t : TKeyEventRecord; Peek : boolean) : boolean;
+begin
+ if not Inited then
+ begin
+ getKeyEventFromQueue := false;
+ exit;
+ end;
+ EnterCriticalSection (lockVar);
+ if keyEventsInQueue then
+ begin
+ t := keyboardeventqueue[nextkeyevent];
+ if not peek then incqueueindex (nextkeyevent);
+ getKeyEventFromQueue := true;
+ if not keyEventsInQueue then ResetEvent (newKeyEvent);
+ end else
+ begin
+ getKeyEventFromQueue := false;
+ ResetEvent (newKeyEvent);
+ end;
+ LeaveCriticalSection (lockVar);
+end;
+
+
+{ gets the next key from the queue, does wait for new keys }
+function getKeyEventFromQueueWait (VAR t : TKeyEventRecord) : boolean;
+begin
+ if not Inited then
+ begin
+ getKeyEventFromQueueWait := false;
+ exit;
+ end;
+ WaitForSingleObject (newKeyEvent, dword(INFINITE));
+ getKeyEventFromQueueWait := getKeyEventFromQueue (t, false);
+end;
+
+{ translate win32 shift-state to keyboard shift state }
+function transShiftState (ControlKeyState : dword) : byte;
+var b : byte;
+begin
+ b := 0;
+ if ControlKeyState and SHIFT_PRESSED <> 0 then { win32 makes no difference between left and right shift }
+ b := b or kbShift;
+ if (ControlKeyState and LEFT_CTRL_PRESSED <> 0) or
+ (ControlKeyState and RIGHT_CTRL_PRESSED <> 0) then
+ b := b or kbCtrl;
+ if (ControlKeyState and LEFT_ALT_PRESSED <> 0) or
+ (ControlKeyState and RIGHT_ALT_PRESSED <> 0) then
+ b := b or kbAlt;
+ transShiftState := b;
+end;
+
+{ The event-Handler thread from the unit event will call us if a key-event
+ is available }
+
+procedure HandleKeyboard(var ir:INPUT_RECORD);
+var
+ i : longint;
+ c : word;
+ altc : char;
+ addThis: boolean;
+begin
+ with ir.Event.KeyEvent do
+ begin
+ { key up events are ignored (except alt) }
+ if bKeyDown then
+ begin
+ EnterCriticalSection (lockVar);
+ for i:=1 to wRepeatCount do
+ begin
+ addThis := true;
+ if (dwControlKeyState and LEFT_ALT_PRESSED <> 0) or
+ (dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then {alt pressed}
+ if ((wVirtualKeyCode >= $60) and (wVirtualKeyCode <= $69)) or
+ ((dwControlKeyState and ENHANCED_KEY = 0) and
+ (wVirtualKeyCode in [$C{VK_CLEAR generated by keypad 5},
+ $21 {VK_PRIOR (PgUp) 9},
+ $22 {VK_NEXT (PgDown) 3},
+ $23 {VK_END 1},
+ $24 {VK_HOME 7},
+ $25 {VK_LEFT 4},
+ $26 {VK_UP 8},
+ $27 {VK_RIGHT 6},
+ $28 {VK_DOWN 2},
+ $2D {VK_INSERT 0}])) then {0..9 on NumBlock}
+ begin
+ if length (altNumBuffer) = 3 then
+ delete (altNumBuffer,1,1);
+ case wVirtualKeyCode of
+ $60..$69 : altc:=char (wVirtualKeyCode-48);
+ $c : altc:='5';
+ $21 : altc:='9';
+ $22 : altc:='3';
+ $23 : altc:='1';
+ $24 : altc:='7';
+ $25 : altc:='4';
+ $26 : altc:='8';
+ $27 : altc:='6';
+ $28 : altc:='2';
+ $2D : altc:='0';
+ end;
+ altNumBuffer := altNumBuffer + altc;
+ altNumActive := true;
+ addThis := false;
+ end else
+ begin
+ altNumActive := false;
+ altNumBuffer := '';
+ end;
+ if addThis then
+ begin
+ keyboardeventqueue[nextfreekeyevent]:=
+ ir.Event.KeyEvent;
+ incqueueindex(nextfreekeyevent);
+ end;
+ end;
+
+ lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
+ SetEvent (newKeyEvent); {event that a new key is available}
+ LeaveCriticalSection (lockVar);
+ end
+ else
+ begin
+ lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
+ {for alt-number we have to look for alt-key release}
+ if altNumActive then
+ begin
+ if (wVirtualKeyCode = $12) then {alt-released}
+ begin
+ if altNumBuffer <> '' then {numbers with alt pressed?}
+ begin
+ Val (altNumBuffer, c, i);
+ if (i = 0) and (c <= 255) then {valid number?}
+ begin {add to queue}
+ fillchar (ir, sizeof (ir), 0);
+ bKeyDown := true;
+ AsciiChar := char (c);
+ {and add to queue}
+ EnterCriticalSection (lockVar);
+ keyboardeventqueue[nextfreekeyevent]:=ir.Event.KeyEvent;
+ incqueueindex(nextfreekeyevent);
+ SetEvent (newKeyEvent); {event that a new key is available}
+ LeaveCriticalSection (lockVar);
+ end;
+ end;
+ altNumActive := false; {clear alt-buffer}
+ altNumBuffer := '';
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure CheckAltGr;
+
+var ahkl : HKL;
+ i : integer;
+
+ begin
+ HasAltGr:=false;
+
+ ahkl:=GetKeyboardLayout(0);
+ i:=$20;
+ while i<$100 do
+ begin
+ // <MSDN>
+ // For keyboard layouts that use the right-hand ALT key as ashift key
+ // (for example, the French keyboard layout), the shift state is
+ // represented by the value 6, because the right-hand ALT key is
+ // converted internally into CTRL+ALT.
+ // </MSDN>
+ if (HIBYTE(VkKeyScanEx(chr(i),ahkl))=6) then
+ begin
+ HasAltGr:=true;
+ break;
+ end;
+ inc(i);
+ end;
+end;
+
+
+
+
+procedure SysInitKeyboard;
+begin
+ KeyBoardLayout:=GetKeyboardLayout(0);
+ lastShiftState := 0;
+ FlushConsoleInputBuffer(StdInputHandle);
+ newKeyEvent := CreateEvent (nil, // address of security attributes
+ true, // flag for manual-reset event
+ false, // flag for initial state
+ nil); // address of event-object name
+ if newKeyEvent = INVALID_HANDLE_VALUE then
+ begin
+ // what to do here ????
+ RunError (217);
+ end;
+ InitializeCriticalSection (lockVar);
+ altNumActive := false;
+ altNumBuffer := '';
+
+ nextkeyevent:=0;
+ nextfreekeyevent:=0;
+ checkaltgr;
+ SetKeyboardEventHandler (@HandleKeyboard);
+ Inited:=true;
+end;
+
+procedure SysDoneKeyboard;
+begin
+ SetKeyboardEventHandler(nil); {hangs???}
+ DeleteCriticalSection (lockVar);
+ FlushConsoleInputBuffer(StdInputHandle);
+ closeHandle (newKeyEvent);
+ Inited:=false;
+end;
+
+{$define USEKEYCODES}
+
+{Translatetable Win32 -> Dos for Special Keys = Function Key, Cursor Keys
+ and Keys other than numbers on numblock (to make fv happy) }
+{combinations under dos: Shift+Ctrl: same as Ctrl
+ Shift+Alt : same as alt
+ Ctrl+Alt : nothing (here we get it like alt)}
+{$ifdef USEKEYCODES}
+ { use positive values for ScanCode we want to set
+ 0 for key where we should leave the scancode
+ -1 for OEM specifc keys
+ -2 for unassigned
+ -3 for Kanji systems ???
+ }
+const
+ Unassigned = -2;
+ Kanji = -3;
+ OEM_specific = -1;
+ KeyToQwertyScan : array [0..255] of integer =
+ (
+ { 00 } 0,
+ { 01 VK_LBUTTON } 0,
+ { 02 VK_RBUTTON } 0,
+ { 03 VK_CANCEL } 0,
+ { 04 VK_MBUTTON } 0,
+ { 05 unassigned } -2,
+ { 06 unassigned } -2,
+ { 07 unassigned } -2,
+ { 08 VK_BACK } $E,
+ { 09 VK_TAB } $F,
+ { 0A unassigned } -2,
+ { 0B unassigned } -2,
+ { 0C VK_CLEAR ?? } 0,
+ { 0D VK_RETURN } 0,
+ { 0E unassigned } -2,
+ { 0F unassigned } -2,
+ { 10 VK_SHIFT } 0,
+ { 11 VK_CONTROL } 0,
+ { 12 VK_MENU (Alt key) } 0,
+ { 13 VK_PAUSE } 0,
+ { 14 VK_CAPITAL (Caps Lock) } 0,
+ { 15 Reserved for Kanji systems} -3,
+ { 16 Reserved for Kanji systems} -3,
+ { 17 Reserved for Kanji systems} -3,
+ { 18 Reserved for Kanji systems} -3,
+ { 19 Reserved for Kanji systems} -3,
+ { 1A unassigned } -2,
+ { 1B VK_ESCAPE } $1,
+ { 1C Reserved for Kanji systems} -3,
+ { 1D Reserved for Kanji systems} -3,
+ { 1E Reserved for Kanji systems} -3,
+ { 1F Reserved for Kanji systems} -3,
+ { 20 VK_SPACE} 0,
+ { 21 VK_PRIOR (PgUp) } 0,
+ { 22 VK_NEXT (PgDown) } 0,
+ { 23 VK_END } 0,
+ { 24 VK_HOME } 0,
+ { 25 VK_LEFT } 0,
+ { 26 VK_UP } 0,
+ { 27 VK_RIGHT } 0,
+ { 28 VK_DOWN } 0,
+ { 29 VK_SELECT ??? } 0,
+ { 2A OEM specific !! } -1,
+ { 2B VK_EXECUTE } 0,
+ { 2C VK_SNAPSHOT } 0,
+ { 2D VK_INSERT } 0,
+ { 2E VK_DELETE } 0,
+ { 2F VK_HELP } 0,
+ { 30 VK_0 '0' } 11,
+ { 31 VK_1 '1' } 2,
+ { 32 VK_2 '2' } 3,
+ { 33 VK_3 '3' } 4,
+ { 34 VK_4 '4' } 5,
+ { 35 VK_5 '5' } 6,
+ { 36 VK_6 '6' } 7,
+ { 37 VK_7 '7' } 8,
+ { 38 VK_8 '8' } 9,
+ { 39 VK_9 '9' } 10,
+ { 3A unassigned } -2,
+ { 3B unassigned } -2,
+ { 3C unassigned } -2,
+ { 3D unassigned } -2,
+ { 3E unassigned } -2,
+ { 3F unassigned } -2,
+ { 40 unassigned } -2,
+ { 41 VK_A 'A' } $1E,
+ { 42 VK_B 'B' } $30,
+ { 43 VK_C 'C' } $2E,
+ { 44 VK_D 'D' } $20,
+ { 45 VK_E 'E' } $12,
+ { 46 VK_F 'F' } $21,
+ { 47 VK_G 'G' } $22,
+ { 48 VK_H 'H' } $23,
+ { 49 VK_I 'I' } $17,
+ { 4A VK_J 'J' } $24,
+ { 4B VK_K 'K' } $25,
+ { 4C VK_L 'L' } $26,
+ { 4D VK_M 'M' } $32,
+ { 4E VK_N 'N' } $31,
+ { 4F VK_O 'O' } $18,
+ { 50 VK_P 'P' } $19,
+ { 51 VK_Q 'Q' } $10,
+ { 52 VK_R 'R' } $13,
+ { 53 VK_S 'S' } $1F,
+ { 54 VK_T 'T' } $14,
+ { 55 VK_U 'U' } $16,
+ { 56 VK_V 'V' } $2F,
+ { 57 VK_W 'W' } $11,
+ { 58 VK_X 'X' } $2D,
+ { 59 VK_Y 'Y' } $15,
+ { 5A VK_Z 'Z' } $2C,
+ { 5B unassigned } -2,
+ { 5C unassigned } -2,
+ { 5D unassigned } -2,
+ { 5E unassigned } -2,
+ { 5F unassigned } -2,
+ { 60 VK_NUMPAD0 NumKeyPad '0' } 11,
+ { 61 VK_NUMPAD1 NumKeyPad '1' } 2,
+ { 62 VK_NUMPAD2 NumKeyPad '2' } 3,
+ { 63 VK_NUMPAD3 NumKeyPad '3' } 4,
+ { 64 VK_NUMPAD4 NumKeyPad '4' } 5,
+ { 65 VK_NUMPAD5 NumKeyPad '5' } 6,
+ { 66 VK_NUMPAD6 NumKeyPad '6' } 7,
+ { 67 VK_NUMPAD7 NumKeyPad '7' } 8,
+ { 68 VK_NUMPAD8 NumKeyPad '8' } 9,
+ { 69 VK_NUMPAD9 NumKeyPad '9' } 10,
+ { 6A VK_MULTIPLY } 0,
+ { 6B VK_ADD } 0,
+ { 6C VK_SEPARATOR } 0,
+ { 6D VK_SUBSTRACT } 0,
+ { 6E VK_DECIMAL } 0,
+ { 6F VK_DIVIDE } 0,
+ { 70 VK_F1 'F1' } $3B,
+ { 71 VK_F2 'F2' } $3C,
+ { 72 VK_F3 'F3' } $3D,
+ { 73 VK_F4 'F4' } $3E,
+ { 74 VK_F5 'F5' } $3F,
+ { 75 VK_F6 'F6' } $40,
+ { 76 VK_F7 'F7' } $41,
+ { 77 VK_F8 'F8' } $42,
+ { 78 VK_F9 'F9' } $43,
+ { 79 VK_F10 'F10' } $44,
+ { 7A VK_F11 'F11' } $57,
+ { 7B VK_F12 'F12' } $58,
+ { 7C VK_F13 } 0,
+ { 7D VK_F14 } 0,
+ { 7E VK_F15 } 0,
+ { 7F VK_F16 } 0,
+ { 80 VK_F17 } 0,
+ { 81 VK_F18 } 0,
+ { 82 VK_F19 } 0,
+ { 83 VK_F20 } 0,
+ { 84 VK_F21 } 0,
+ { 85 VK_F22 } 0,
+ { 86 VK_F23 } 0,
+ { 87 VK_F24 } 0,
+ { 88 unassigned } -2,
+ { 89 VK_NUMLOCK } 0,
+ { 8A VK_SCROLL } 0,
+ { 8B unassigned } -2,
+ { 8C unassigned } -2,
+ { 8D unassigned } -2,
+ { 8E unassigned } -2,
+ { 8F unassigned } -2,
+ { 90 unassigned } -2,
+ { 91 unassigned } -2,
+ { 92 unassigned } -2,
+ { 93 unassigned } -2,
+ { 94 unassigned } -2,
+ { 95 unassigned } -2,
+ { 96 unassigned } -2,
+ { 97 unassigned } -2,
+ { 98 unassigned } -2,
+ { 99 unassigned } -2,
+ { 9A unassigned } -2,
+ { 9B unassigned } -2,
+ { 9C unassigned } -2,
+ { 9D unassigned } -2,
+ { 9E unassigned } -2,
+ { 9F unassigned } -2,
+ { A0 unassigned } -2,
+ { A1 unassigned } -2,
+ { A2 unassigned } -2,
+ { A3 unassigned } -2,
+ { A4 unassigned } -2,
+ { A5 unassigned } -2,
+ { A6 unassigned } -2,
+ { A7 unassigned } -2,
+ { A8 unassigned } -2,
+ { A9 unassigned } -2,
+ { AA unassigned } -2,
+ { AB unassigned } -2,
+ { AC unassigned } -2,
+ { AD unassigned } -2,
+ { AE unassigned } -2,
+ { AF unassigned } -2,
+ { B0 unassigned } -2,
+ { B1 unassigned } -2,
+ { B2 unassigned } -2,
+ { B3 unassigned } -2,
+ { B4 unassigned } -2,
+ { B5 unassigned } -2,
+ { B6 unassigned } -2,
+ { B7 unassigned } -2,
+ { B8 unassigned } -2,
+ { B9 unassigned } -2,
+ { BA OEM specific } 0,
+ { BB OEM specific } 0,
+ { BC OEM specific } 0,
+ { BD OEM specific } 0,
+ { BE OEM specific } 0,
+ { BF OEM specific } 0,
+ { C0 OEM specific } 0,
+ { C1 unassigned } -2,
+ { C2 unassigned } -2,
+ { C3 unassigned } -2,
+ { C4 unassigned } -2,
+ { C5 unassigned } -2,
+ { C6 unassigned } -2,
+ { C7 unassigned } -2,
+ { C8 unassigned } -2,
+ { C9 unassigned } -2,
+ { CA unassigned } -2,
+ { CB unassigned } -2,
+ { CC unassigned } -2,
+ { CD unassigned } -2,
+ { CE unassigned } -2,
+ { CF unassigned } -2,
+ { D0 unassigned } -2,
+ { D1 unassigned } -2,
+ { D2 unassigned } -2,
+ { D3 unassigned } -2,
+ { D4 unassigned } -2,
+ { D5 unassigned } -2,
+ { D6 unassigned } -2,
+ { D7 unassigned } -2,
+ { D8 unassigned } -2,
+ { D9 unassigned } -2,
+ { DA unassigned } -2,
+ { DB OEM specific } 0,
+ { DC OEM specific } 0,
+ { DD OEM specific } 0,
+ { DE OEM specific } 0,
+ { DF OEM specific } 0,
+ { E0 OEM specific } 0,
+ { E1 OEM specific } 0,
+ { E2 OEM specific } 0,
+ { E3 OEM specific } 0,
+ { E4 OEM specific } 0,
+ { E5 unassigned } -2,
+ { E6 OEM specific } 0,
+ { E7 unassigned } -2,
+ { E8 unassigned } -2,
+ { E9 OEM specific } 0,
+ { EA OEM specific } 0,
+ { EB OEM specific } 0,
+ { EC OEM specific } 0,
+ { ED OEM specific } 0,
+ { EE OEM specific } 0,
+ { EF OEM specific } 0,
+ { F0 OEM specific } 0,
+ { F1 OEM specific } 0,
+ { F2 OEM specific } 0,
+ { F3 OEM specific } 0,
+ { F4 OEM specific } 0,
+ { F5 OEM specific } 0,
+ { F6 unassigned } -2,
+ { F7 unassigned } -2,
+ { F8 unassigned } -2,
+ { F9 unassigned } -2,
+ { FA unassigned } -2,
+ { FB unassigned } -2,
+ { FC unassigned } -2,
+ { FD unassigned } -2,
+ { FE unassigned } -2,
+ { FF unassigned } -2
+ );
+{$endif USEKEYCODES}
+type TTEntryT = packed record
+ n,s,c,a : byte; {normal,shift, ctrl, alt, normal only for f11,f12}
+ end;
+
+CONST
+ DosTT : ARRAY [$3B..$58] OF TTEntryT =
+ ((n : $3B; s : $54; c : $5E; a: $68), {3B F1}
+ (n : $3C; s : $55; c : $5F; a: $69), {3C F2}
+ (n : $3D; s : $56; c : $60; a: $6A), {3D F3}
+ (n : $3E; s : $57; c : $61; a: $6B), {3E F4}
+ (n : $3F; s : $58; c : $62; a: $6C), {3F F5}
+ (n : $40; s : $59; c : $63; a: $6D), {40 F6}
+ (n : $41; s : $5A; c : $64; a: $6E), {41 F7}
+ (n : $42; s : $5B; c : $65; a: $6F), {42 F8}
+ (n : $43; s : $5C; c : $66; a: $70), {43 F9}
+ (n : $44; s : $5D; c : $67; a: $71), {44 F10}
+ (n : $45; s : $00; c : $00; a: $00), {45 ???}
+ (n : $46; s : $00; c : $00; a: $00), {46 ???}
+ (n : $47; s : $47; c : $77; a: $97), {47 Home}
+ (n : $48; s : $00; c : $8D; a: $98), {48 Up}
+ (n : $49; s : $49; c : $84; a: $99), {49 PgUp}
+ (n : $4A; s : $00; c : $8E; a: $4A), {4A -}
+ (n : $4B; s : $4B; c : $73; a: $9B), {4B Left}
+ (n : $4C; s : $00; c : $00; a: $00), {4C ???}
+ (n : $4D; s : $4D; c : $74; a: $9D), {4D Right}
+ (n : $4E; s : $00; c : $90; a: $4E), {4E +}
+ (n : $4F; s : $4F; c : $75; a: $9F), {4F End}
+ (n : $50; s : $50; c : $91; a: $A0), {50 Down}
+ (n : $51; s : $51; c : $76; a: $A1), {51 PgDown}
+ (n : $52; s : $52; c : $92; a: $A2), {52 Insert}
+ (n : $53; s : $53; c : $93; a: $A3), {53 Del}
+ (n : $54; s : $00; c : $00; a: $00), {54 ???}
+ (n : $55; s : $00; c : $00; a: $00), {55 ???}
+ (n : $56; s : $00; c : $00; a: $00), {56 ???}
+ (n : $85; s : $87; c : $89; a: $8B), {57 F11}
+ (n : $86; s : $88; c : $8A; a: $8C)); {58 F12}
+
+ DosTT09 : ARRAY [$02..$0F] OF TTEntryT =
+ ((n : $00; s : $00; c : $00; a: $78), {02 1 }
+ (n : $00; s : $00; c : $00; a: $79), {03 2 }
+ (n : $00; s : $00; c : $00; a: $7A), {04 3 }
+ (n : $00; s : $00; c : $00; a: $7B), {05 4 }
+ (n : $00; s : $00; c : $00; a: $7C), {06 5 }
+ (n : $00; s : $00; c : $00; a: $7D), {07 6 }
+ (n : $00; s : $00; c : $00; a: $7E), {08 7 }
+ (n : $00; s : $00; c : $00; a: $7F), {09 8 }
+ (n : $00; s : $00; c : $00; a: $80), {0A 9 }
+ (n : $00; s : $00; c : $00; a: $81), {0B 0 }
+ (n : $00; s : $00; c : $00; a: $82), {0C ß }
+ (n : $00; s : $00; c : $00; a: $00), {0D}
+ (n : $00; s : $09; c : $00; a: $00), {0E Backspace}
+ (n : $00; s : $0F; c : $94; a: $00)); {0F Tab }
+
+
+function TranslateKey (t : TKeyEventRecord) : TKeyEvent;
+var key : TKeyEvent;
+ ss : byte;
+{$ifdef USEKEYCODES}
+ ScanCode : byte;
+{$endif USEKEYCODES}
+ b : byte;
+begin
+ Key := 0;
+ if t.bKeyDown then
+ begin
+ { ascii-char is <> 0 if not a specal key }
+ { we return it here otherwise we have to translate more later }
+ if t.AsciiChar <> #0 then
+ begin
+ if (t.dwControlKeyState and ENHANCED_KEY <> 0) and
+ (t.wVirtualKeyCode = $DF) then
+ begin
+ t.dwControlKeyState:=t.dwControlKeyState and not ENHANCED_KEY;
+ t.wVirtualKeyCode:=VK_DIVIDE;
+ t.AsciiChar:='/';
+ end;
+ {drivers needs scancode, we return it here as under dos and linux
+ with $03000000 = the lowest two bytes is the physical representation}
+{$ifdef USEKEYCODES}
+ Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
+ If ScanCode>0 then
+ t.wVirtualScanCode:=ScanCode;
+ Key := byte (t.AsciiChar) + (t.wVirtualScanCode shl 8) + $03000000;
+ ss := transShiftState (t.dwControlKeyState);
+ key := key or (ss shl 16);
+ if (ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState) then
+ key := key and $FFFFFF00;
+{$else not USEKEYCODES}
+ Key := byte (t.AsciiChar) + ((t.wVirtualScanCode AND $00FF) shl 8) + $03000000;
+{$endif not USEKEYCODES}
+ end else
+ begin
+{$ifdef USEKEYCODES}
+ Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
+ If ScanCode>0 then
+ t.wVirtualScanCode:=ScanCode;
+{$endif not USEKEYCODES}
+ translateKey := 0;
+ { ignore shift,ctrl,alt,numlock,capslock alone }
+ case t.wVirtualKeyCode of
+ $0010, {shift}
+ $0011, {ctrl}
+ $0012, {alt}
+ $0014, {capslock}
+ $0090, {numlock}
+ $0091, {scrollock}
+ { This should be handled !! }
+ { these last two are OEM specific
+ this is not good !!! }
+ $00DC, {^ : next key i.e. a is modified }
+ { Strange on my keyboard this corresponds to double point over i or u PM }
+ $00DD: exit; {´ and ` : next key i.e. e is modified }
+ end;
+
+ key := $03000000 + (t.wVirtualScanCode shl 8); { make lower 8 bit=0 like under dos }
+ end;
+ { Handling of ~ key as AltGr 2 }
+ { This is also French keyboard specific !! }
+ { but without this I can not get a ~ !! PM }
+ { MvdV: not rightruealtised, since it already has frenchkbd guard}
+ if (t.wVirtualKeyCode=$32) and
+ (KeyBoardLayout = FrenchKeyboard) and
+ (t.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
+ key:=(key and $ffffff00) or ord('~');
+ { ok, now add Shift-State }
+ ss := transShiftState (t.dwControlKeyState);
+ key := key or (ss shl 16);
+
+ { Reset Ascii-Char if Alt+Key, fv needs that, may be we
+ need it for other special keys too
+ 18 Sept 1999 AD: not for right Alt i.e. for AltGr+ß = \ on german keyboard }
+ if ((ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState)) or
+ (*
+ { yes, we need it for cursor keys, 25=left, 26=up, 27=right,28=down}
+ {aggg, this will not work because esc is also virtualKeyCode 27!!}
+ {if (t.wVirtualKeyCode >= 25) and (t.wVirtualKeyCode <= 28) then}
+ no VK_ESCAPE is $1B !!
+ there was a mistake :
+ VK_LEFT is $25 not 25 !! *)
+ { not $2E VK_DELETE because its only the Keypad point !! PM }
+ (t.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
+ { if t.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
+ key := key and $FFFFFF00;
+
+ {and translate to dos-scancodes to make fv happy, we will convert this
+ back in translateKeyEvent}
+
+ if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
+ if (t.wVirtualScanCode >= low (DosTT)) and
+ (t.wVirtualScanCode <= high (dosTT)) then
+ begin
+ b := 0;
+ if (ss and kbAlt) <> 0 then
+ b := DosTT[t.wVirtualScanCode].a
+ else
+ if (ss and kbCtrl) <> 0 then
+ b := DosTT[t.wVirtualScanCode].c
+ else
+ if (ss and kbShift) <> 0 then
+ b := DosTT[t.wVirtualScanCode].s
+ else
+ b := DosTT[t.wVirtualScanCode].n;
+ if b <> 0 then
+ key := (key and $FFFF00FF) or (longint (b) shl 8);
+ end;
+
+ {Alt-0 to Alt-9}
+ if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
+ if (t.wVirtualScanCode >= low (DosTT09)) and
+ (t.wVirtualScanCode <= high (dosTT09)) then
+ begin
+ b := 0;
+ if (ss and kbAlt) <> 0 then
+ b := DosTT09[t.wVirtualScanCode].a
+ else
+ if (ss and kbCtrl) <> 0 then
+ b := DosTT09[t.wVirtualScanCode].c
+ else
+ if (ss and kbShift) <> 0 then
+ b := DosTT09[t.wVirtualScanCode].s
+ else
+ b := DosTT09[t.wVirtualScanCode].n;
+ if b <> 0 then
+ key := (key and $FFFF0000) or (longint (b) shl 8);
+ end;
+
+ TranslateKey := key;
+ end;
+ translateKey := Key;
+end;
+
+function SysGetKeyEvent: TKeyEvent;
+var t : TKeyEventRecord;
+ key : TKeyEvent;
+begin
+ key := 0;
+ repeat
+ if getKeyEventFromQueueWait (t) then
+ key := translateKey (t);
+ until key <> 0;
+{$ifdef DEBUG}
+ last_ir.Event.KeyEvent:=t;
+{$endif DEBUG}
+ SysGetKeyEvent := key;
+end;
+
+function SysPollKeyEvent: TKeyEvent;
+var t : TKeyEventRecord;
+ k : TKeyEvent;
+begin
+ SysPollKeyEvent := 0;
+ if getKeyEventFromQueue (t, true) then
+ begin
+ { we get an enty for shift, ctrl, alt... }
+ k := translateKey (t);
+ while (k = 0) do
+ begin
+ getKeyEventFromQueue (t, false); {remove it}
+ if not getKeyEventFromQueue (t, true) then exit;
+ k := translateKey (t)
+ end;
+ SysPollKeyEvent := k;
+ end;
+end;
+
+
+function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+begin
+ if KeyEvent and $03000000 = $03000000 then
+ begin
+ if KeyEvent and $000000FF <> 0 then
+ begin
+ SysTranslateKeyEvent := KeyEvent and $00FFFFFF;
+ exit;
+ end;
+ {translate function-keys and other specials, ascii-codes are already ok}
+ case (KeyEvent AND $0000FF00) shr 8 of
+ {F1..F10}
+ $3B..$44 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
+ {F11,F12}
+ $85..$86 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
+ {Shift F1..F10}
+ $54..$5D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
+ {Shift F11,F12}
+ $87..$88 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
+ {Alt F1..F10}
+ $68..$71 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
+ {Alt F11,F12}
+ $8B..$8C : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
+ {Ctrl F1..F10}
+ $5E..$67 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
+ {Ctrl F11,F12}
+ $89..$8A : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;
+
+ {normal,ctrl,alt}
+ $47,$77,$97 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
+ $48,$8D,$98 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
+ $49,$84,$99 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
+ $4b,$73,$9B : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
+ $4d,$74,$9D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
+ $4f,$75,$9F : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
+ $50,$91,$A0 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
+ $51,$76,$A1 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
+ $52,$92,$A2 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
+ $53,$93,$A3 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
+ else
+ SysTranslateKeyEvent := KeyEvent;
+ end;
+ end else
+ SysTranslateKeyEvent := KeyEvent;
+end;
+
+
+function SysGetShiftState: Byte;
+
+begin
+ {may be better to save the last state and return that if no key is in buffer???}
+ SysGetShiftState:= lastShiftState;
+end;
+
+Const
+ SysKeyboardDriver : TKeyboardDriver = (
+ InitDriver : @SysInitKeyBoard;
+ DoneDriver : @SysDoneKeyBoard;
+ GetKeyevent : @SysGetKeyEvent;
+ PollKeyEvent : @SysPollKeyEvent;
+ GetShiftState : @SysGetShiftState;
+ TranslateKeyEvent : @SysTranslateKeyEvent;
+ TranslateKeyEventUnicode : Nil;
+ );
+
+
+begin
+ SetKeyBoardDriver(SysKeyBoardDriver);
+end.
+{
+ $Log: keyboard.pp,v $
+ Revision 1.13 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.12 2005/01/07 18:59:22 florian
+ * AltGr fixed
+
+}
diff --git a/rtl/win32/messages.pp b/rtl/win32/messages.pp
new file mode 100644
index 0000000000..db44c2dc29
--- /dev/null
+++ b/rtl/win32/messages.pp
@@ -0,0 +1,15 @@
+unit messages;
+
+
+interface
+
+ uses
+ windows;
+
+{$DEFINE read_interface}
+{$DEFINE MESSAGESUNIT}
+{$I messages.inc}
+
+implementation
+
+end.
diff --git a/rtl/win32/mouse.pp b/rtl/win32/mouse.pp
new file mode 100644
index 0000000000..33fce9a1cc
--- /dev/null
+++ b/rtl/win32/mouse.pp
@@ -0,0 +1,255 @@
+{
+ $Id: mouse.pp,v 1.11 2005/03/31 14:43:03 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Mouse unit for linux
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Mouse;
+interface
+
+{$i mouseh.inc}
+
+implementation
+
+uses
+ windows,dos,Winevent;
+
+{$i mouse.inc}
+
+var
+ ChangeMouseEvents : TCriticalSection;
+ LastHandlerMouseEvent : TMouseEvent;
+
+procedure MouseEventHandler(var ir:INPUT_RECORD);
+
+ var
+ e : TMouseEvent;
+
+ begin
+ EnterCriticalSection(ChangeMouseEvents);
+ e.x:=ir.Event.MouseEvent.dwMousePosition.x;
+ e.y:=ir.Event.MouseEvent.dwMousePosition.y;
+ e.buttons:=0;
+ e.action:=0;
+ if (ir.Event.MouseEvent.dwButtonState and FROM_LEFT_1ST_BUTTON_PRESSED<>0) then
+ e.buttons:=e.buttons or MouseLeftButton;
+ if (ir.Event.MouseEvent.dwButtonState and FROM_LEFT_2ND_BUTTON_PRESSED<>0) then
+ e.buttons:=e.buttons or MouseMiddleButton;
+ if (ir.Event.MouseEvent.dwButtonState and RIGHTMOST_BUTTON_PRESSED<>0) then
+ e.buttons:=e.buttons or MouseRightButton;
+
+ if (Lasthandlermouseevent.x<>e.x) or (LasthandlerMouseEvent.y<>e.y) then
+ e.Action:=MouseActionMove;
+ if (LastHandlerMouseEvent.Buttons<>e.Buttons) then
+ begin
+ if (LasthandlerMouseEvent.Buttons and e.buttons<>LasthandlerMouseEvent.Buttons) then
+ e.Action:=MouseActionUp
+ else
+ e.Action:=MouseActionDown;
+ end;
+
+
+//
+// The mouse event compression here was flawed and could lead
+// to "zero" mouse actions if the new (x,y) was the same as the
+// previous one. (bug 2312)
+//
+
+ { can we compress the events? }
+ if (PendingMouseEvents>0) and
+ (e.buttons=PendingMouseTail^.buttons) and
+ (e.action=PendingMouseTail^.action) then
+ begin
+ PendingMouseTail^.x:=e.x;
+ PendingMouseTail^.y:=e.y;
+ end
+ else
+ begin
+
+ if e.action<>0 then
+ begin
+ LastHandlermouseEvent:=e;
+ PutMouseEvent(e);
+ end;
+ // this should be done in PutMouseEvent, now it is PM
+ // inc(PendingMouseEvents);
+ end;
+ LastMouseEvent:=e;
+ LeaveCriticalSection(ChangeMouseEvents);
+ end;
+
+procedure SysInitMouse;
+
+var
+ mode : dword;
+
+begin
+ // enable mouse events
+ GetConsoleMode(StdInputHandle,@mode);
+ mode:=mode or ENABLE_MOUSE_INPUT;
+ SetConsoleMode(StdInputHandle,mode);
+
+ PendingMouseHead:=@PendingMouseEvent;
+ PendingMouseTail:=@PendingMouseEvent;
+ PendingMouseEvents:=0;
+ FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
+ InitializeCriticalSection(ChangeMouseEvents);
+ SetMouseEventHandler(@MouseEventHandler);
+ ShowMouse;
+end;
+
+
+procedure SysDoneMouse;
+var
+ mode : dword;
+begin
+ HideMouse;
+ // disable mouse events
+ GetConsoleMode(StdInputHandle,@mode);
+ mode:=mode and (not ENABLE_MOUSE_INPUT);
+ SetConsoleMode(StdInputHandle,mode);
+
+ SetMouseEventHandler(nil);
+ DeleteCriticalSection(ChangeMouseEvents);
+end;
+
+
+function SysDetectMouse:byte;
+var
+ num : dword;
+begin
+ GetNumberOfConsoleMouseButtons(@num);
+ SysDetectMouse:=num;
+end;
+
+
+procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
+
+var
+ b : byte;
+
+begin
+ repeat
+ EnterCriticalSection(ChangeMouseEvents);
+ b:=PendingMouseEvents;
+ LeaveCriticalSection(ChangeMouseEvents);
+ if b>0 then
+ break
+ else
+ sleep(50);
+ until false;
+ EnterCriticalSection(ChangeMouseEvents);
+ MouseEvent:=PendingMouseHead^;
+ inc(PendingMouseHead);
+ if longint(PendingMouseHead)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+ PendingMouseHead:=@PendingMouseEvent;
+ dec(PendingMouseEvents);
+ if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
+ MouseEvent.Action:=MouseActionMove;
+ if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
+ begin
+ if (LastMouseEvent.Buttons and MouseEvent.buttons<>LastMouseEvent.Buttons) then
+ MouseEvent.Action:=MouseActionUp
+ else
+ MouseEvent.Action:=MouseActionDown;
+ end;
+ if MouseEvent.action=0 then MousEevent.action:=MouseActionMove; // can sometimes happen due to compression of events.
+ LastMouseEvent:=MouseEvent;
+ LeaveCriticalSection(ChangeMouseEvents);
+end;
+
+
+function SysPollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+begin
+ EnterCriticalSection(ChangeMouseEvents);
+ if PendingMouseEvents>0 then
+ begin
+ MouseEvent:=PendingMouseHead^;
+ SysPollMouseEvent:=true;
+ end
+ else
+ SysPollMouseEvent:=false;
+ LeaveCriticalSection(ChangeMouseEvents);
+end;
+
+
+procedure SysPutMouseEvent(const MouseEvent: TMouseEvent);
+begin
+ if PendingMouseEvents<MouseEventBufSize then
+ begin
+ PendingMouseTail^:=MouseEvent;
+ inc(PendingMouseTail);
+ if longint(PendingMouseTail)=longint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+ PendingMouseTail:=@PendingMouseEvent;
+ { why isn't this done here ?
+ so the win32 version do this by hand:}
+ inc(PendingMouseEvents);
+ end;
+end;
+
+
+function SysGetMouseX:word;
+begin
+ EnterCriticalSection(ChangeMouseEvents);
+ SysGetMouseX:=LastMouseEvent.x;
+ LeaveCriticalSection(ChangeMouseEvents);
+end;
+
+
+function SysGetMouseY:word;
+begin
+ EnterCriticalSection(ChangeMouseEvents);
+ SysGetMouseY:=LastMouseEvent.y;
+ LeaveCriticalSection(ChangeMouseEvents);
+end;
+
+
+function SysGetMouseButtons:word;
+begin
+ EnterCriticalSection(ChangeMouseEvents);
+ SysGetMouseButtons:=LastMouseEvent.Buttons;
+ LeaveCriticalSection(ChangeMouseEvents);
+end;
+
+Const
+ SysMouseDriver : TMouseDriver = (
+ UseDefaultQueue : False;
+ InitDriver : @SysInitMouse;
+ DoneDriver : @SysDoneMouse;
+ DetectMouse : @SysDetectMouse;
+ ShowMouse : Nil;
+ HideMouse : Nil;
+ GetMouseX : @SysGetMouseX;
+ GetMouseY : @SysGetMouseY;
+ GetMouseButtons : @SysGetMouseButtons;
+ SetMouseXY : Nil;
+ GetMouseEvent : @SysGetMouseEvent;
+ PollMouseEvent : @SysPollMouseEvent;
+ PutMouseEvent : @SysPutMouseEvent;
+ );
+
+Begin
+ SetMouseDriver(SysMouseDriver);
+end.
+{
+ $Log: mouse.pp,v $
+ Revision 1.11 2005/03/31 14:43:03 marco
+ * fix to lastmouseevent update
+
+ Revision 1.10 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.9 2005/01/12 10:25:48 armin
+ * Patch for bug 3548 from Peter
+
+}
diff --git a/rtl/win32/objinc.inc b/rtl/win32/objinc.inc
new file mode 100644
index 0000000000..4075c27285
--- /dev/null
+++ b/rtl/win32/objinc.inc
@@ -0,0 +1,191 @@
+{
+ $Id: objinc.inc,v 1.8 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Includefile for objects.pp implementing OS-dependent file routines
+ for WIN32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+
+CONST
+ { REQUIRED TO PUT MANUALLY here, because of name conflicts in win32.inc }
+ { flags for CreateFile }
+ GENERIC_READ=longint($80000000);
+ GENERIC_WRITE=$40000000;
+ CREATE_NEW = 1;
+ CREATE_ALWAYS = 2;
+ OPEN_EXISTING = 3;
+ OPEN_ALWAYS = 4;
+ TRUNCATE_EXISTING = 5;
+
+ FILE_ATTRIBUTE_ARCHIVE = 32;
+ FILE_ATTRIBUTE_COMPRESSED = 2048;
+ FILE_ATTRIBUTE_NORMAL = 128;
+ FILE_ATTRIBUTE_DIRECTORY = 16;
+ FILE_ATTRIBUTE_HIDDEN = 2;
+ FILE_ATTRIBUTE_READONLY = 1;
+ FILE_ATTRIBUTE_SYSTEM = 4;
+ FILE_ATTRIBUTE_TEMPORARY = 256;
+
+ { flags for SetFilePos }
+ FILE_BEGIN = 0;
+ FILE_CURRENT = 1;
+ FILE_END = 2;
+
+ { misc. functions }
+ function GetLastError : DWORD;
+ stdcall;external 'kernel32' name 'GetLastError';
+
+ function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
+ overlap:pointer):longint;
+ stdcall;external 'kernel32' name 'WriteFile';
+ function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
+ overlap:pointer):longint;
+ stdcall;external 'kernel32' name 'ReadFile';
+ function CloseHandle(h : longint) : longint;
+ stdcall;external 'kernel32' name 'CloseHandle';
+ function DeleteFile(p : pchar) : longint;
+ stdcall;external 'kernel32' name 'DeleteFileA';
+ function MoveFile(old,_new : pchar) : longint;
+ stdcall;external 'kernel32' name 'MoveFileA';
+ function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
+ stdcall;external 'kernel32' name 'SetFilePointer';
+ function GetFileSize(h:longint;p:pointer) : longint;
+ stdcall;external 'kernel32' name 'GetFileSize';
+ function CreateFile(name : pointer;access,sharing : longint;
+ security : pointer;how,attr,template : longint) : longint;
+ stdcall;external 'kernel32' name 'CreateFileA';
+ function SetEndOfFile(h : longint) : boolean;
+ stdcall;external 'kernel32' name 'SetEndOfFile';
+ function GetFileType(Handle:DWORD):DWord;
+ stdcall;external 'kernel32' name 'GetFileType';
+
+
+{---------------------------------------------------------------------------}
+{ FileClose -> Platforms WIN32 - Not checked }
+{---------------------------------------------------------------------------}
+FUNCTION FileClose(Handle: THandle): word;
+begin
+ closehandle(handle);
+ FileClose := 0;
+end;
+
+{---------------------------------------------------------------------------}
+{ FileOpen -> Platforms WIN32 - Tested MVC }
+{ Returns 0 on failure }
+{---------------------------------------------------------------------------}
+
+FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+var
+ oflags,cd: longint;
+ AHandle : longint;
+begin
+ { On opening reset error code }
+ DosStreamError := 0;
+ if Mode=stCreate then
+ Begin
+ cd:=CREATE_ALWAYS;
+ oflags:=GENERIC_WRITE or GENERIC_READ;
+ End
+ else
+ Begin
+ cd:=OPEN_EXISTING;
+ { convert filemode to filerec modes }
+ case (Mode and 3) of
+ 0 : oflags:=GENERIC_READ;
+ 1 : oflags:=GENERIC_WRITE;
+ 2 : oflags:=GENERIC_WRITE or GENERIC_READ;
+ end;
+ end;
+ AHandle:=CreateFile(pointer(@FileName),oflags,0,nil,cd,FILE_ATTRIBUTE_NORMAL,0);
+ if AHandle = -1 then
+ begin
+ FileOpen:=0;
+ DosStreamError:=word(GetLastError);
+ end
+ else
+ FileOpen := AHandle;
+end;
+
+
+{***************************************************************************}
+{ DosSetFilePtr -> Platforms WIN32 - Tested MVC }
+{***************************************************************************}
+FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
+Var Actual: LongInt): Word;
+BEGIN
+ { WARNING WIN32 CURRECTLY HAS THE SAME SEEK MODE AS MSDOS }
+ { if this changes don't forget to change and check the flags }
+ { accordingly. }
+ Actual:=SetFilePointer(handle,pos,nil,MoveType);
+ If Actual=-1 then
+ DosStreamError:=word(GetLastError);
+ SetFilePos := DosStreamError; { Return any error }
+END;
+
+
+{---------------------------------------------------------------------------}
+{ FileRead -> Platforms WIN32 - Tested MVC }
+{---------------------------------------------------------------------------}
+FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
+Var Actual: Sw_Word): Word;
+
+Var res : longint;
+
+BEGIN
+ res:=0;
+ if readfile(handle,pointer(@buf),count,res,nil)=0 then
+ DosStreamError:=word(GetLastError);
+ Actual:=res;
+ FileRead:=DosStreamError;
+end;
+
+
+{---------------------------------------------------------------------------}
+{ FileWrite -> Platforms WIN32 - Not Checked }
+{---------------------------------------------------------------------------}
+FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
+BEGIN
+ if writefile(handle,pointer(@buf),count,longint(Actual),nil)=0 then
+ Begin
+ DosStreamError:=word(GetLasterror);
+ end;
+ FileWrite:=DosStreamError;
+end;
+
+
+{---------------------------------------------------------------------------}
+{ SetFileSize -> Platforms DOS - Not Checked }
+{---------------------------------------------------------------------------}
+FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
+VAR Actual : Sw_word;
+ Buf: LongInt;
+BEGIN
+ SetFilePos(Handle,FileSize,0,longint(Actual));
+ If (Actual = FileSize) Then
+ Begin
+ Actual := FileWrite(Handle, Buf, 0,Actual); { Truncate the file }
+ If (Actual <> longword(-1)) Then
+ SetFileSize := 0
+ Else
+ SetFileSize := 103; { File truncate error }
+ End
+ Else
+ SetFileSize := 103; { File truncate error }
+END;
+
+{
+ $Log: objinc.inc,v $
+ Revision 1.8 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/printer.pp b/rtl/win32/printer.pp
new file mode 100644
index 0000000000..5a3dca7b8f
--- /dev/null
+++ b/rtl/win32/printer.pp
@@ -0,0 +1,35 @@
+{
+ $Id: printer.pp,v 1.5 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Printer unit for BP7 compatible RTL
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit printer;
+interface
+
+{$I printerh.inc}
+
+implementation
+
+{$I printer.inc}
+
+begin
+ InitPrinter ('PRN');
+ SetPrinterExit;
+end.
+{
+ $Log: printer.pp,v $
+ Revision 1.5 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/signals.pp b/rtl/win32/signals.pp
new file mode 100644
index 0000000000..b3b441d6e1
--- /dev/null
+++ b/rtl/win32/signals.pp
@@ -0,0 +1,466 @@
+unit signals;
+
+interface
+
+{$PACKRECORDS C}
+
+ { Signals }
+ const
+ SIGABRT = 288;
+ SIGFPE = 289;
+ SIGILL = 290;
+ SIGSEGV = 291;
+ SIGTERM = 292;
+ SIGALRM = 293;
+ SIGHUP = 294;
+ SIGINT = 295;
+ SIGKILL = 296;
+ SIGPIPE = 297;
+ SIGQUIT = 298;
+ SIGUSR1 = 299;
+ SIGUSR2 = 300;
+ SIGNOFP = 301;
+ SIGTRAP = 302;
+ SIGTIMR = 303; { Internal for setitimer (SIGALRM, SIGPROF) }
+ SIGPROF = 304;
+ SIGMAX = 320;
+
+ SIG_BLOCK = 1;
+ SIG_SETMASK = 2;
+ SIG_UNBLOCK = 3;
+
+ function SIG_DFL( x: longint) : longint; cdecl;
+
+ function SIG_ERR( x: longint) : longint; cdecl;
+
+ function SIG_IGN( x: longint) : longint; cdecl;
+
+ type
+
+ SignalHandler = function (v : longint) : longint;cdecl;
+
+ PSignalHandler = ^SignalHandler; { to be compatible with linux.pp }
+
+ function signal(sig : longint;func : SignalHandler) : SignalHandler;
+
+ const
+
+ EXCEPTION_MAXIMUM_PARAMETERS = 15;
+
+ type
+
+ FLOATING_SAVE_AREA = record
+ ControlWord : DWORD;
+ StatusWord : DWORD;
+ TagWord : DWORD;
+ ErrorOffset : DWORD;
+ ErrorSelector : DWORD;
+ DataOffset : DWORD;
+ DataSelector : DWORD;
+ RegisterArea : array[0..79] of BYTE;
+ Cr0NpxState : DWORD;
+ end;
+ _FLOATING_SAVE_AREA = FLOATING_SAVE_AREA;
+ TFLOATINGSAVEAREA = FLOATING_SAVE_AREA;
+ PFLOATINGSAVEAREA = ^FLOATING_SAVE_AREA;
+
+ CONTEXT = record
+ ContextFlags : DWORD;
+ Dr0 : DWORD;
+ Dr1 : DWORD;
+ Dr2 : DWORD;
+ Dr3 : DWORD;
+ Dr6 : DWORD;
+ Dr7 : DWORD;
+ FloatSave : FLOATING_SAVE_AREA;
+ SegGs : DWORD;
+ SegFs : DWORD;
+ SegEs : DWORD;
+ SegDs : DWORD;
+ Edi : DWORD;
+ Esi : DWORD;
+ Ebx : DWORD;
+ Edx : DWORD;
+ Ecx : DWORD;
+ Eax : DWORD;
+ Ebp : DWORD;
+ Eip : DWORD;
+ SegCs : DWORD;
+ EFlags : DWORD;
+ Esp : DWORD;
+ SegSs : DWORD;
+ end;
+ LPCONTEXT = ^CONTEXT;
+ _CONTEXT = CONTEXT;
+ TCONTEXT = CONTEXT;
+ PCONTEXT = ^CONTEXT;
+
+
+ type
+ pexception_record = ^exception_record;
+ EXCEPTION_RECORD = record
+ ExceptionCode : cardinal;
+ ExceptionFlags : longint;
+ ExceptionRecord : pexception_record;
+ ExceptionAddress : pointer;
+ NumberParameters : longint;
+ ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of pointer;
+ end;
+
+ PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
+ EXCEPTION_POINTERS = record
+ ExceptionRecord : PEXCEPTION_RECORD ;
+ ContextRecord : PCONTEXT ;
+ end;
+
+
+implementation
+
+
+const
+ EXCEPTION_ACCESS_VIOLATION = $c0000005;
+ EXCEPTION_BREAKPOINT = $80000003;
+ EXCEPTION_DATATYPE_MISALIGNMENT = $80000002;
+ EXCEPTION_SINGLE_STEP = $80000004;
+ EXCEPTION_ARRAY_BOUNDS_EXCEEDED = $c000008c;
+ EXCEPTION_FLT_DENORMAL_OPERAND = $c000008d;
+ EXCEPTION_FLT_DIVIDE_BY_ZERO = $c000008e;
+ EXCEPTION_FLT_INEXACT_RESULT = $c000008f;
+ EXCEPTION_FLT_INVALID_OPERATION = $c0000090;
+ EXCEPTION_FLT_OVERFLOW = $c0000091;
+ EXCEPTION_FLT_STACK_CHECK = $c0000092;
+ EXCEPTION_FLT_UNDERFLOW = $c0000093;
+ EXCEPTION_INT_DIVIDE_BY_ZERO = $c0000094;
+ EXCEPTION_INT_OVERFLOW = $c0000095;
+ EXCEPTION_INVALID_HANDLE = $c0000008;
+ EXCEPTION_PRIV_INSTRUCTION = $c0000096;
+ EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025;
+ EXCEPTION_NONCONTINUABLE = $1;
+ EXCEPTION_STACK_OVERFLOW = $c00000fd;
+ EXCEPTION_INVALID_DISPOSITION = $c0000026;
+ EXCEPTION_ILLEGAL_INSTRUCTION = $C000001D;
+ EXCEPTION_IN_PAGE_ERROR = $C0000006;
+
+ EXCEPTION_EXECUTE_HANDLER = 1;
+ EXCEPTION_CONTINUE_EXECUTION = -(1);
+ EXCEPTION_CONTINUE_SEARCH = 0;
+
+ type
+ { type of functions that should be used for exception handling }
+ LPTOP_LEVEL_EXCEPTION_FILTER = function(excep :PEXCEPTION_POINTERS) : longint;stdcall;
+
+ function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : LPTOP_LEVEL_EXCEPTION_FILTER)
+ : LPTOP_LEVEL_EXCEPTION_FILTER;
+ stdcall; external 'kernel32' name 'SetUnhandledExceptionFilter';
+
+var
+ signal_list : Array[SIGABRT..SIGMAX] of SignalHandler;
+var
+ { value of the stack segment
+ to check if the call stack can be written on exceptions }
+ _SS : cardinal;
+
+const
+ fpucw : word = $1332;
+ Exception_handler_installed : boolean = false;
+ MAX_Level = 16;
+ except_level : byte = 0;
+var
+ except_eip : array[0..Max_level-1] of longint;
+ except_signal : array[0..Max_level-1] of longint;
+ reset_fpu : array[0..max_level-1] of boolean;
+
+ procedure JumpToHandleSignal;
+ var
+ res, eip, _ebp, sigtype : longint;
+ begin
+ asm
+ movl (%ebp),%eax
+ movl %eax,_ebp
+ end;
+ Writeln('In start of JumpToHandleSignal');
+ if except_level>0 then
+ dec(except_level)
+ else
+ RunError(216);
+ eip:=except_eip[except_level];
+
+ sigtype:=except_signal[except_level];
+ if reset_fpu[except_level] then
+ asm
+ fninit
+ fldcw fpucw
+ end;
+ if assigned(System_exception_frame) then
+ { get the handler in front again }
+ asm
+ movl System_exception_frame,%eax
+ movl %eax,%fs:(0)
+ end;
+ if (sigtype>=SIGABRT) and (sigtype<=SIGMAX) and
+ (signal_list[sigtype]<>@SIG_DFL) then
+ begin
+ res:=signal_list[sigtype](sigtype);
+ end
+ else
+ res:=0;
+
+ if res=0 then
+ Begin
+ Writeln('In JumpToHandleSignal');
+ RunError(sigtype);
+ end
+ else
+ { jump back to old code }
+ asm
+ movl eip,%eax
+ push %eax
+ movl _ebp,%eax
+ push %eax
+ leave
+ ret
+ end;
+ end;
+
+
+
+ function Signals_exception_handler
+ (excep_exceptionrecord :PEXCEPTION_RECORD;
+ excep_frame : PEXCEPTION_FRAME;
+ excep_contextrecord : PCONTEXT;
+ dispatch : pointer) : longint;stdcall;
+ var frame,res : longint;
+ function CallSignal(sigtype,frame : longint;must_reset_fpu : boolean) : longint;
+ begin
+ writeln(stderr,'CallSignal called');
+ {if frame=0 then
+ begin
+ CallSignal:=1;
+ writeln(stderr,'CallSignal frame is zero');
+ end
+ else }
+ begin
+ if except_level >= Max_level then
+ exit;
+ except_eip[except_level]:=excep_ContextRecord^.Eip;
+ except_signal[except_level]:=sigtype;
+ reset_fpu[except_level]:=must_reset_fpu;
+ inc(except_level);
+ {dec(excep^.ContextRecord^.Esp,4);
+ plongint (excep^.ContextRecord^.Esp)^ := longint(excep^.ContextRecord^.Eip);}
+ excep_ContextRecord^.Eip:=longint(@JumpToHandleSignal);
+ excep_ExceptionRecord^.ExceptionCode:=0;
+ CallSignal:=0;
+ writeln(stderr,'Exception_Continue_Execution set');
+ end;
+ end;
+
+ begin
+ if excep_ContextRecord^.SegSs=_SS then
+ frame:=excep_ContextRecord^.Ebp
+ else
+ frame:=0;
+ { default : unhandled !}
+ res:=1;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then
+ writeln(stderr,'Signals exception ',
+ hexstr(excep_ExceptionRecord^.ExceptionCode,8));
+{$endif SYSTEMEXCEPTIONDEBUG}
+ case excep_ExceptionRecord^.ExceptionCode of
+ EXCEPTION_ACCESS_VIOLATION :
+ res:=CallSignal(SIGSEGV,frame,false);
+ { EXCEPTION_BREAKPOINT = $80000003;
+ EXCEPTION_DATATYPE_MISALIGNMENT = $80000002;
+ EXCEPTION_SINGLE_STEP = $80000004; }
+ EXCEPTION_ARRAY_BOUNDS_EXCEEDED :
+ res:=CallSignal(SIGSEGV,frame,false);
+ EXCEPTION_FLT_DENORMAL_OPERAND :
+ begin
+ res:=CallSignal(SIGFPE,frame,true);
+ end;
+ EXCEPTION_FLT_DIVIDE_BY_ZERO :
+ begin
+ res:=CallSignal(SIGFPE,frame,true);
+ {excep^.ContextRecord^.FloatSave.StatusWord:=excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
+ end;
+ {EXCEPTION_FLT_INEXACT_RESULT = $c000008f; }
+ EXCEPTION_FLT_INVALID_OPERATION :
+ begin
+ res:=CallSignal(SIGFPE,frame,true);
+ end;
+ EXCEPTION_FLT_OVERFLOW :
+ begin
+ res:=CallSignal(SIGFPE,frame,true);
+ end;
+ EXCEPTION_FLT_STACK_CHECK :
+ begin
+ res:=CallSignal(SIGFPE,frame,true);
+ end;
+ EXCEPTION_FLT_UNDERFLOW :
+ begin
+ res:=CallSignal(SIGFPE,frame,true); { should be accepted as zero !! }
+ end;
+ EXCEPTION_INT_DIVIDE_BY_ZERO :
+ res:=CallSignal(SIGFPE,frame,false);
+ EXCEPTION_INT_OVERFLOW :
+ res:=CallSignal(SIGFPE,frame,false);
+ {EXCEPTION_INVALID_HANDLE = $c0000008;
+ EXCEPTION_PRIV_INSTRUCTION = $c0000096;
+ EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025;
+ EXCEPTION_NONCONTINUABLE = $1;}
+ EXCEPTION_STACK_OVERFLOW :
+ res:=CallSignal(SIGSEGV,frame,false);
+ {EXCEPTION_INVALID_DISPOSITION = $c0000026;}
+ EXCEPTION_ILLEGAL_INSTRUCTION,
+ EXCEPTION_PRIV_INSTRUCTION,
+ EXCEPTION_IN_PAGE_ERROR,
+ EXCEPTION_SINGLE_STEP : res:=CallSignal(SIGSEGV,frame,false);
+ { Ignore EXCEPTION_INVALID_HANDLE exceptions }
+ EXCEPTION_INVALID_HANDLE : res:=0;
+ end;
+ Signals_exception_handler:=res;
+ end;
+
+
+ function API_signals_exception_handler(exceptptrs : PEXCEPTION_POINTERS) : longint; stdcall;
+ begin
+ API_signals_exception_handler:=Signals_exception_handler(
+ @exceptptrs^.ExceptionRecord,
+ nil,
+ @exceptptrs^.ContextRecord,
+ nil);
+ end;
+
+
+const
+ PreviousHandler : LPTOP_LEVEL_EXCEPTION_FILTER = nil;
+ Prev_Handler : pointer = nil;
+ Prev_fpc_handler : pointer = nil;
+
+ procedure install_exception_handler;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ var
+ oldexceptaddr,newexceptaddr : longint;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ begin
+ if Exception_handler_installed then
+ exit;
+ if assigned(System_exception_frame) then
+ begin
+ prev_fpc_handler:=System_exception_frame^.handler;
+ System_exception_frame^.handler:=@Signals_exception_handler;
+ { get the handler in front again }
+ asm
+ movl %fs:(0),%eax
+ movl %eax,prev_handler
+ movl System_exception_frame,%eax
+ movl %eax,%fs:(0)
+ end;
+ Exception_handler_installed:=true;
+ exit;
+ end;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ asm
+ movl $0,%eax
+ movl %fs:(%eax),%eax
+ movl %eax,oldexceptaddr
+ end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ PreviousHandler:=SetUnhandledExceptionFilter(@API_signals_exception_handler);
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ asm
+ movl $0,%eax
+ movl %fs:(%eax),%eax
+ movl %eax,newexceptaddr
+ end;
+ if IsConsole then
+ begin
+ writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8),
+ ' new exception ',hexstr(newexceptaddr,8));
+ writeln('SetUnhandledExceptionFilter returned ',hexstr(longint(PreviousHandler),8));
+ end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ Exception_handler_installed := true;
+ end;
+
+ procedure remove_exception_handler;
+ begin
+ if not Exception_handler_installed then
+ exit;
+ if assigned(System_exception_frame) then
+ begin
+ if assigned(prev_fpc_handler) then
+ System_exception_frame^.handler:=prev_fpc_handler;
+ prev_fpc_handler:=nil;
+ { restore old handler order again }
+ if assigned(prev_handler) then
+ asm
+ movl prev_handler,%eax
+ movl %eax,%fs:(0)
+ end;
+ prev_handler:=nil;
+ Exception_handler_installed:=false;
+ exit;
+ end;
+ SetUnhandledExceptionFilter(PreviousHandler);
+ PreviousHandler:=nil;
+ Exception_handler_installed:=false;
+ end;
+
+
+function SIG_ERR(x:longint):longint; cdecl;
+begin
+ SIG_ERR:=-1;
+end;
+
+
+function SIG_IGN(x:longint):longint; cdecl;
+begin
+ SIG_IGN:=-1;
+end;
+
+
+function SIG_DFL(x:longint):longint; cdecl;
+begin
+ SIG_DFL:=0;
+end;
+
+function signal(sig : longint;func : SignalHandler) : SignalHandler;
+var
+ temp : SignalHandler;
+begin
+ if ((sig < SIGABRT) or (sig > SIGMAX) or (sig = SIGKILL)) then
+ begin
+ signal:=@SIG_ERR;
+ runerror(201);
+ end;
+ if not Exception_handler_installed then
+ install_exception_handler;
+ temp := signal_list[sig];
+ signal_list[sig] := func;
+ signal:=temp;
+end;
+
+
+var
+ i : longint;
+initialization
+
+ asm
+ xorl %eax,%eax
+ movw %ss,%ax
+ movl %eax,_SS
+ end;
+
+ for i:=SIGABRT to SIGMAX do
+ signal_list[i]:=@SIG_DFL;
+
+ {install_exception_handler;
+ delay this to first use
+ as other units also might install their handlers PM }
+
+finalization
+
+ remove_exception_handler;
+end.
diff --git a/rtl/win32/sockets.pp b/rtl/win32/sockets.pp
new file mode 100644
index 0000000000..96f2024993
--- /dev/null
+++ b/rtl/win32/sockets.pp
@@ -0,0 +1,395 @@
+{
+ $Id: sockets.pp,v 1.14 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+unit Sockets;
+
+Interface
+
+{$macro on}
+{$define maybelibc:=}
+
+ Uses
+ windows,winsock;
+
+Type
+ cushort=word;
+ cuint16=word;
+ cuint32=cardinal;
+ size_t =cuint32;
+ ssize_t=cuint16;
+ cint =longint;
+ pcint =^cint;
+ tsocklen=cint;
+ psocklen=^tsocklen;
+
+
+ Const
+ AF_MAX = WinSock.AF_MAX;
+ PF_MAX = AF_MAX;
+
+{$i socketsh.inc}
+
+Implementation
+
+{ Include filerec and textrec structures }
+{$i filerec.inc}
+{$i textrec.inc}
+
+{******************************************************************************
+ Basic Socket Functions
+******************************************************************************}
+
+
+
+//function fprecvmsg (s:cint; msg: pmsghdr; flags:cint):ssize_t;
+//function fpsendmsg (s:cint; hdr: pmsghdr; flags:cint):ssize;
+
+//function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+
+
+function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+ fpSocket:=WinSock.Socket(Domain,xtype,ProtoCol);
+ if fpSocket<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+ fpSend:=WinSock.Send(S,msg,len,flags);
+ if fpSend<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+ // Dubious construct, this should be checked. (IPV6 fails ?)
+ fpSendTo:=WinSock.SendTo(S,msg,Len,Flags,Winsock.TSockAddr(tox^),toLen);
+ if fpSendTo<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fprecv (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t;
+begin
+ fpRecv:=WinSock.Recv(S,Buf,Len,Flags);
+ if fpRecv<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+
+begin
+fpRecvFrom:=WinSock.RecvFrom(S,Buf,Len,Flags,Winsock.TSockAddr(from^),FromLen^);
+ if fpRecvFrom<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
+
+begin
+ fpConnect:=WinSock.Connect(S,WinSock.TSockAddr(name^),nameLen);
+ if fpConnect<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpshutdown (s:cint; how:cint):cint;
+begin
+ fpShutDown:=WinSock.ShutDown(S,How);
+ if fpShutDown<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+ socket:=fpsocket(Domain,sockettype,protocol);
+end;
+
+Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
+
+begin
+ send:=fpsend(sock,@buf,buflen,flags);
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+
+begin
+ sendto:=fpsendto(sock,@buf,buflen,flags,@addr,addrlen);
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+ Recv:=fpRecv(Sock,@Buf,BufLen,Flags);
+end;
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; var AddrLen : longint) : longint;
+begin
+ RecvFrom:=fpRecvFrom(Sock,@Buf,BufLen,Flags,@Addr,@AddrLen);
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+
+begin
+ fpbind:=WinSock.Bind(S,WinSock.PSockAddr(Addrx),AddrLen);
+ if fpbind<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fplisten (s:cint; backlog : cint):cint;
+
+begin
+ fplisten:=WinSock.Listen(S,backlog);
+ if fplisten<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+ fpAccept:=WinSock.Accept(S,WinSock.PSockAddr(Addrx),plongint(@AddrLen));
+ if fpAccept<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
+
+begin
+ fpGetSockName:=WinSock.GetSockName(S,WinSock.TSockAddr(name^),nameLen^);
+ if fpGetSockName<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
+begin
+ fpGetPeerName:=WinSock.GetPeerName(S,WinSock.TSockAddr(name^),NameLen^);
+ if fpGetPeerName<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+ fpGetSockOpt:=WinSock.GetSockOpt(S,Level,OptName,OptVal,OptLen^);
+ if fpGetSockOpt<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
+
+begin
+ fpSetSockOpt:=WinSock.SetSockOpt(S,Level,OptName,OptVal,OptLen);
+ if fpSetSockOpt<0 then
+ SocketError:=WSAGetLastError
+ else
+ SocketError:=0;
+end;
+
+function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+end;
+
+Function CloseSocket(Sock:Longint):Longint;
+var i : longint;
+begin
+ i := Winsock.CloseSocket (Sock);
+ if i <> 0 then
+ begin
+ SocketError:=WSAGetLastError;
+ CloseSocket := i;
+ end else
+ begin
+ CloseSocket := 0;
+ SocketError := 0;
+ end;
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+
+begin
+ bind:=fpBind(Sock,@Addr,AddrLen)=0;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+
+begin
+ Listen:=fplisten(Sock,MaxConnect)=0;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+
+begin
+ Accept:=FPAccept(sock,@addr,@addrlen);
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+
+begin
+ shutdown:=fpshutdown(sock,how);
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):Boolean;
+
+begin
+ connect:=fpconnect(sock,@addr,addrlen)=0;
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetSocketName:=fpGetSockName(sock,@addr,@addrlen);
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+ GetPeerName:=fpGetPeerName(Sock,@addr,@addrlen);
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+ GetSocketOptions:=fpGetSockOpt(sock,level,optname,@optval,@optlen);
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+
+begin
+ SetSocketOptions:=fpsetsockopt(sock,level,optname,@optval,optlen);
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+ // SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);a
+end;
+
+
+{$ifdef unix}
+{ mimic the linux fpWrite/fpRead calls for the file/text socket wrapper }
+function fpWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fpWrite := dword(WinSock.send(handle, bufptr, size, 0));
+ if fpWrite = dword(SOCKET_ERROR) then
+ begin
+ SocketError := WSAGetLastError;
+ fpWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fpRead(handle : longint;var bufptr;size : dword) : dword;
+ var
+ d : dword;
+
+ begin
+ if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+ begin
+ SocketError:=WSAGetLastError;
+ fpRead:=0;
+ exit;
+ end;
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fpRead := dword(WinSock.recv(handle, bufptr, size, 0));
+ if fpRead = dword(SOCKET_ERROR) then
+ begin
+ SocketError:= WSAGetLastError;
+ fpRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+ end;
+{$else}
+{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
+function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+ fdWrite := dword(WinSock.send(handle, bufptr, size, 0));
+ if fdWrite = dword(SOCKET_ERROR) then
+ begin
+ SocketError := WSAGetLastError;
+ fdWrite := 0;
+ end
+ else
+ SocketError := 0;
+end;
+
+function fdRead(handle : longint;var bufptr;size : dword) : dword;
+ var
+ d : dword;
+
+ begin
+ if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+ begin
+ SocketError:=WSAGetLastError;
+ fdRead:=0;
+ exit;
+ end;
+ if d>0 then
+ begin
+ if size>d then
+ size:=d;
+ fdRead := dword(WinSock.recv(handle, bufptr, size, 0));
+ if fdRead = dword(SOCKET_ERROR) then
+ begin
+ SocketError:= WSAGetLastError;
+ fdRead := 0;
+ end else
+ SocketError:=0;
+ end
+ else
+ SocketError:=0;
+ end;
+{$endif}
+
+{$i sockets.inc}
+
+{ winsocket stack needs an init. and cleanup code }
+var
+ wsadata : twsadata;
+
+initialization
+ WSAStartUp($2,wsadata);
+finalization
+ WSACleanUp;
+end.
+{
+ $Log: sockets.pp,v $
+ Revision 1.14 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/sysdir.inc b/rtl/win32/sysdir.inc
new file mode 100644
index 0000000000..7a221ec15b
--- /dev/null
+++ b/rtl/win32/sysdir.inc
@@ -0,0 +1,107 @@
+{
+ $Id: sysdir.inc,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{*****************************************************************************
+ Directory Handling
+*****************************************************************************}
+
+type
+ TDirFnType=function(name:pointer):longbool;stdcall;
+
+procedure dirfn(afunc : TDirFnType;const s:string);
+var
+ buffer : array[0..255] of char;
+begin
+ move(s[1],buffer,length(s));
+ buffer[length(s)]:=#0;
+ AllowSlash(pchar(@buffer));
+ if not aFunc(@buffer) then
+ begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+end;
+
+function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+begin
+ CreateDirectoryTrunc:=CreateDirectory(name,nil);
+end;
+
+procedure mkdir(const s:string);[IOCHECK];
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ dirfn(TDirFnType(@CreateDirectoryTrunc),s);
+end;
+
+procedure rmdir(const s:string);[IOCHECK];
+begin
+ if (s ='.') then
+ InOutRes := 16;
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ dirfn(TDirFnType(@RemoveDirectory),s);
+end;
+
+procedure chdir(const s:string);[IOCHECK];
+begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ dirfn(TDirFnType(@SetCurrentDirectory),s);
+ if Inoutres=2 then
+ Inoutres:=3;
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+const
+ Drive:array[0..3]of char=(#0,':',#0,#0);
+var
+ defaultdrive:boolean;
+ DirBuf,SaveBuf:array[0..259] of Char;
+begin
+ defaultdrive:=drivenr=0;
+ if not defaultdrive then
+ begin
+ byte(Drive[0]):=Drivenr+64;
+ GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
+ if not SetCurrentDirectory(@Drive) then
+ begin
+ errno := word (GetLastError);
+ Errno2InoutRes;
+ Dir := char (DriveNr + 64) + ':\';
+ SetCurrentDirectory(@SaveBuf);
+ Exit;
+ end;
+ end;
+ GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
+ if not defaultdrive then
+ SetCurrentDirectory(@SaveBuf);
+ dir:=strpas(DirBuf);
+ if not FileNameCaseSensitive then
+ dir:=upcase(dir);
+end;
+
+{
+ $Log: sysdir.inc,v $
+ Revision 1.2 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/win32/sysfile.inc b/rtl/win32/sysfile.inc
new file mode 100644
index 0000000000..5c5517ba92
--- /dev/null
+++ b/rtl/win32/sysfile.inc
@@ -0,0 +1,272 @@
+{
+ $Id: sysfile.inc,v 1.1 2005/02/06 13:06:20 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ Low leve file functions
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Low Level File Routines
+*****************************************************************************}
+
+procedure AllowSlash(p:pchar);
+var
+ i : longint;
+begin
+{ allow slash as backslash }
+ for i:=0 to strlen(p) do
+ if p[i]='/' then p[i]:='\';
+end;
+
+function do_isdevice(handle:thandle):boolean;
+begin
+ do_isdevice:=(getfiletype(handle)=2);
+end;
+
+
+procedure do_close(h : thandle);
+begin
+ if do_isdevice(h) then
+ exit;
+ CloseHandle(h);
+end;
+
+
+procedure do_erase(p : pchar);
+begin
+ AllowSlash(p);
+ if DeleteFile(p)=0 then
+ Begin
+ errno:=GetLastError;
+ if errno=5 then
+ begin
+ if (GetFileAttributes(p)=FILE_ATTRIBUTE_DIRECTORY) then
+ errno:=2;
+ end;
+ Errno2InoutRes;
+ end;
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+begin
+ AllowSlash(p1);
+ AllowSlash(p2);
+ if MoveFile(p1,p2)=0 then
+ Begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+end;
+
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+var
+ size:longint;
+begin
+ if writefile(h,addr,len,size,nil)=0 then
+ Begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+ do_write:=size;
+end;
+
+
+function do_read(h:thandle;addr:pointer;len : longint) : longint;
+var
+ _result:longint;
+begin
+ if readfile(h,addr,len,_result,nil)=0 then
+ Begin
+ errno:=GetLastError;
+ if errno=ERROR_BROKEN_PIPE then
+ errno:=0
+ else
+ Errno2InoutRes;
+ end;
+ do_read:=_result;
+end;
+
+
+function do_filepos(handle : thandle) : longint;
+var
+ l:longint;
+begin
+ l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
+ if l=-1 then
+ begin
+ l:=0;
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+ do_filepos:=l;
+end;
+
+
+procedure do_seek(handle:thandle;pos : longint);
+begin
+ if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
+ Begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+end;
+
+
+function do_seekend(handle:thandle):longint;
+begin
+ do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
+ if do_seekend=-1 then
+ begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+end;
+
+
+function do_filesize(handle : thandle) : longint;
+var
+ aktfilepos : longint;
+begin
+ aktfilepos:=do_filepos(handle);
+ do_filesize:=do_seekend(handle);
+ do_seek(handle,aktfilepos);
+end;
+
+
+procedure do_truncate (handle:thandle;pos:longint);
+begin
+ do_seek(handle,pos);
+ if not(SetEndOfFile(handle)) then
+ begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+ filerec and textrec have both handle and mode as the first items so
+ they could use the same routine for opening/creating.
+ when (flags and $100) the file will be append
+ when (flags and $1000) the file will be truncate/rewritten
+ when (flags and $10000) there is no check for close (needed for textfiles)
+}
+Const
+ file_Share_Read = $00000001;
+ file_Share_Write = $00000002;
+Var
+ shflags,
+ oflags,cd : longint;
+ security : TSecurityAttributes;
+begin
+ AllowSlash(p);
+{ close first if opened }
+ if ((flags and $10000)=0) then
+ begin
+ case filerec(f).mode of
+ fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+ fmclosed : ;
+ else
+ begin
+ {not assigned}
+ inoutres:=102;
+ exit;
+ end;
+ end;
+ end;
+{ reset file handle }
+ filerec(f).handle:=UnusedHandle;
+{ convert filesharing }
+ shflags:=0;
+ if ((filemode and fmshareExclusive) = fmshareExclusive) then
+ { no sharing }
+ else
+ if (filemode = fmShareCompat) or ((filemode and fmshareDenyWrite) = fmshareDenyWrite) then
+ shflags := file_Share_Read
+ else
+ if ((filemode and fmshareDenyRead) = fmshareDenyRead) then
+ shflags := file_Share_Write
+ else
+ if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
+ shflags := file_Share_Read + file_Share_Write;
+{ convert filemode to filerec modes }
+ case (flags and 3) of
+ 0 : begin
+ filerec(f).mode:=fminput;
+ oflags:=longint(GENERIC_READ);
+ end;
+ 1 : begin
+ filerec(f).mode:=fmoutput;
+ oflags:=longint(GENERIC_WRITE);
+ end;
+ 2 : begin
+ filerec(f).mode:=fminout;
+ oflags:=longint(GENERIC_WRITE or GENERIC_READ);
+ end;
+ end;
+{ create it ? }
+ if (flags and $1000)<>0 then
+ cd:=CREATE_ALWAYS
+{ or Append/Open ? }
+ else
+ cd:=OPEN_EXISTING;
+{ empty name is special }
+ if p[0]=#0 then
+ begin
+ case FileRec(f).mode of
+ fminput :
+ FileRec(f).Handle:=StdInputHandle;
+ fminout, { this is set by rewrite }
+ fmoutput :
+ FileRec(f).Handle:=StdOutputHandle;
+ fmappend :
+ begin
+ FileRec(f).Handle:=StdOutputHandle;
+ FileRec(f).mode:=fmoutput; {fool fmappend}
+ end;
+ end;
+ exit;
+ end;
+ security.nLength := Sizeof(TSecurityAttributes);
+ security.bInheritHandle:=true;
+ security.lpSecurityDescriptor:=nil;
+ filerec(f).handle:=CreateFile(p,oflags,shflags,@security,cd,FILE_ATTRIBUTE_NORMAL,0);
+{ append mode }
+ if ((flags and $100)<>0) and
+ (filerec(f).handle<>0) and
+ (filerec(f).handle<>UnusedHandle) then
+ begin
+ do_seekend(filerec(f).handle);
+ filerec(f).mode:=fmoutput; {fool fmappend}
+ end;
+{ get errors }
+ { handle -1 is returned sometimes !! (PM) }
+ if (filerec(f).handle=0) or (filerec(f).handle=UnusedHandle) then
+ begin
+ errno:=GetLastError;
+ Errno2InoutRes;
+ end;
+end;
+
+
+{
+ $Log: sysfile.inc,v $
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/win32/sysheap.inc b/rtl/win32/sysheap.inc
new file mode 100644
index 0000000000..91574fa00a
--- /dev/null
+++ b/rtl/win32/sysheap.inc
@@ -0,0 +1,63 @@
+{
+ $Id: sysheap.inc,v 1.1 2005/02/06 13:06:20 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ OS Memory allocation / deallocation
+ ****************************************************************************}
+
+ { memory functions }
+ function GetProcessHeap : DWord;
+ stdcall;external 'kernel32' name 'GetProcessHeap';
+ function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
+ stdcall;external 'kernel32' name 'HeapAlloc';
+ function HeapFree(hHeap : dword; dwFlags : dword; lpMem: pointer) : boolean;
+ stdcall;external 'kernel32' name 'HeapFree';
+{$IFDEF SYSTEMDEBUG}
+ function WinAPIHeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
+ stdcall;external 'kernel32' name 'HeapSize';
+{$ENDIF}
+
+
+function SysOSAlloc(size: ptrint): pointer;
+var
+ l : longword;
+begin
+ l := HeapAlloc(GetProcessHeap, 0, size);
+{$ifdef DUMPGROW}
+ Writeln('new heap part at $',hexstr(l,8), ' size = ',WinAPIHeapSize(GetProcessHeap()));
+{$endif}
+ SysOSAlloc := pointer(l);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+ HeapFree(GetProcessHeap, 0, p);
+end;
+
+
+{
+ $Log: sysheap.inc,v $
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/win32/sysos.inc b/rtl/win32/sysos.inc
new file mode 100644
index 0000000000..f1ff3fba0f
--- /dev/null
+++ b/rtl/win32/sysos.inc
@@ -0,0 +1,292 @@
+{
+ $Id: sysos.inc,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+const
+ { constants for GetStdHandle }
+ STD_INPUT_HANDLE = longint($fffffff6);
+ STD_OUTPUT_HANDLE = longint($fffffff5);
+ STD_ERROR_HANDLE = longint($fffffff4);
+ INVALID_HANDLE_VALUE = longint($ffffffff);
+
+ IGNORE = 0; { Ignore signal }
+ INFINITE = longint($FFFFFFFF); { Infinite timeout }
+
+ { flags for CreateFile }
+ GENERIC_READ=$80000000;
+ GENERIC_WRITE=$40000000;
+ CREATE_NEW = 1;
+ CREATE_ALWAYS = 2;
+ OPEN_EXISTING = 3;
+ OPEN_ALWAYS = 4;
+ TRUNCATE_EXISTING = 5;
+
+ FILE_ATTRIBUTE_ARCHIVE = 32;
+ FILE_ATTRIBUTE_COMPRESSED = 2048;
+ FILE_ATTRIBUTE_NORMAL = 128;
+ FILE_ATTRIBUTE_DIRECTORY = 16;
+ FILE_ATTRIBUTE_HIDDEN = 2;
+ FILE_ATTRIBUTE_READONLY = 1;
+ FILE_ATTRIBUTE_SYSTEM = 4;
+ FILE_ATTRIBUTE_TEMPORARY = 256;
+
+ { Share mode open }
+ fmShareCompat = $00000000;
+ fmShareExclusive = $10;
+ fmShareDenyWrite = $20;
+ fmShareDenyRead = $30;
+ fmShareDenyNone = $40;
+
+ { flags for SetFilePos }
+ FILE_BEGIN = 0;
+ FILE_CURRENT = 1;
+ FILE_END = 2;
+
+ { GetFileType }
+ FILE_TYPE_UNKNOWN = 0;
+ FILE_TYPE_DISK = 1;
+ FILE_TYPE_CHAR = 2;
+ FILE_TYPE_PIPE = 3;
+
+ VER_PLATFORM_WIN32s = 0;
+ VER_PLATFORM_WIN32_WINDOWS = 1;
+ VER_PLATFORM_WIN32_NT = 2;
+
+ { These constants are used for conversion of error codes }
+ { from win32 i/o errors to tp i/o errors }
+ { errors 1 to 18 are the same as in Turbo Pascal }
+ { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING! }
+
+{ The media is write protected. }
+ ERROR_WRITE_PROTECT = 19;
+{ The system cannot find the device specified. }
+ ERROR_BAD_UNIT = 20;
+{ The device is not ready. }
+ ERROR_NOT_READY = 21;
+{ The device does not recognize the command. }
+ ERROR_BAD_COMMAND = 22;
+{ Data error (cyclic redundancy check) }
+ ERROR_CRC = 23;
+{ The program issued a command but the }
+{ command length is incorrect. }
+ ERROR_BAD_LENGTH = 24;
+{ The drive cannot locate a specific }
+{ area or track on the disk. }
+ ERROR_SEEK = 25;
+{ The specified disk or diskette cannot be accessed. }
+ ERROR_NOT_DOS_DISK = 26;
+{ The drive cannot find the sector requested. }
+ ERROR_SECTOR_NOT_FOUND = 27;
+{ The printer is out of paper. }
+ ERROR_OUT_OF_PAPER = 28;
+{ The system cannot write to the specified device. }
+ ERROR_WRITE_FAULT = 29;
+{ The system cannot read from the specified device. }
+ ERROR_READ_FAULT = 30;
+{ A device attached to the system is not functioning.}
+ ERROR_GEN_FAILURE = 31;
+{ The process cannot access the file because }
+{ it is being used by another process. }
+ ERROR_SHARING_VIOLATION = 32;
+{ A pipe has been closed on the other end }
+{ Removing that error allows eof to works as on other OSes }
+ ERROR_BROKEN_PIPE = 109;
+ ERROR_DIR_NOT_EMPTY = 145;
+ ERROR_ALREADY_EXISTS = 183;
+
+type
+ {UINT = longint;
+ BOOL = longint; obsolete }
+ UINT = cardinal;
+ BOOL = longbool;
+// WCHAR = word;
+{$ifdef UNICODE}
+ LPTCH = ^word;
+ LPTSTR = ^word;
+ LPCTSTR = ^word;
+{$else UNICODE}
+ LPTCH = ^char;
+ LPTSTR = ^char;
+ LPCTSTR = ^char;
+{$endif UNICODE}
+ LPWSTR = ^wchar;
+ PVOID = pointer;
+ LPVOID = pointer;
+ LPCVOID = pointer;
+ LPDWORD = ^DWORD;
+ HLocal = THandle;
+ PStr = pchar;
+ LPStr = pchar;
+ PLPSTR = ^LPSTR;
+ PLPWSTR = ^LPWSTR;
+
+ PSecurityAttributes = ^TSecurityAttributes;
+ TSecurityAttributes = packed record
+ nLength : DWORD;
+ lpSecurityDescriptor : Pointer;
+ bInheritHandle : BOOL;
+ end;
+
+ PProcessInformation = ^TProcessInformation;
+ TProcessInformation = record
+ hProcess: THandle;
+ hThread: THandle;
+ dwProcessId: DWORD;
+ dwThreadId: DWORD;
+ end;
+
+ PFileTime = ^TFileTime;
+ TFileTime = record
+ dwLowDateTime,
+ dwHighDateTime : DWORD;
+ end;
+
+ LPSystemTime= ^PSystemTime;
+ PSystemTime = ^TSystemTime;
+ TSystemTime = record
+ wYear,
+ wMonth,
+ wDayOfWeek,
+ wDay,
+ wHour,
+ wMinute,
+ wSecond,
+ wMilliseconds: Word;
+ end;
+
+{$IFDEF SUPPORT_THREADVAR}
+threadvar
+{$ELSE SUPPORT_THREADVAR}
+var
+{$ENDIF SUPPORT_THREADVAR}
+ errno : longint;
+
+{$ASMMODE ATT}
+
+
+ { misc. functions }
+ function GetLastError : DWORD;
+ stdcall;external 'kernel32' name 'GetLastError';
+
+ { time and date functions }
+ function GetTickCount : longint;
+ stdcall;external 'kernel32' name 'GetTickCount';
+
+ { process functions }
+ procedure ExitProcess(uExitCode : UINT);
+ stdcall;external 'kernel32' name 'ExitProcess';
+
+ { Startup }
+ procedure GetStartupInfo(p : pointer);
+ stdcall;external 'kernel32' name 'GetStartupInfoA';
+ function GetStdHandle(nStdHandle:DWORD):THANDLE;
+ stdcall;external 'kernel32' name 'GetStdHandle';
+
+ { command line/enviroment functions }
+ function GetCommandLine : pchar;
+ stdcall;external 'kernel32' name 'GetCommandLineA';
+
+ function GetCurrentProcessId:DWORD;
+ stdcall; external 'kernel32' name 'GetCurrentProcessId';
+
+ function Win32GetCurrentThreadId:DWORD;
+ stdcall; external 'kernel32' name 'GetCurrentThreadId';
+
+ { module functions }
+ function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
+ stdcall;external 'kernel32' name 'GetModuleFileNameA';
+ function GetModuleHandle(p : pointer) : longint;
+ stdcall;external 'kernel32' name 'GetModuleHandleA';
+ function GetCommandFile:pchar;forward;
+
+ { file functions }
+ function WriteFile(fh:thandle;buf:pointer;len:longint;var loaded:longint;
+ overlap:pointer):longint;
+ stdcall;external 'kernel32' name 'WriteFile';
+ function ReadFile(fh:thandle;buf:pointer;len:longint;var loaded:longint;
+ overlap:pointer):longint;
+ stdcall;external 'kernel32' name 'ReadFile';
+ function CloseHandle(h : thandle) : longint;
+ stdcall;external 'kernel32' name 'CloseHandle';
+ function DeleteFile(p : pchar) : longint;
+ stdcall;external 'kernel32' name 'DeleteFileA';
+ function MoveFile(old,_new : pchar) : longint;
+ stdcall;external 'kernel32' name 'MoveFileA';
+ function SetFilePointer(l1,l2 : thandle;l3 : pointer;l4 : longint) : longint;
+ stdcall;external 'kernel32' name 'SetFilePointer';
+ function GetFileSize(h:thandle;p:pointer) : longint;
+ stdcall;external 'kernel32' name 'GetFileSize';
+ function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD;
+ lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
+ dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
+ stdcall;external 'kernel32' name 'CreateFileA';
+ function SetEndOfFile(h : thandle) : longbool;
+ stdcall;external 'kernel32' name 'SetEndOfFile';
+ function GetFileType(Handle:thandle):DWord;
+ stdcall;external 'kernel32' name 'GetFileType';
+ function GetFileAttributes(p : pchar) : dword;
+ stdcall;external 'kernel32' name 'GetFileAttributesA';
+
+ { Directory }
+ function CreateDirectory(name : pointer;sec : pointer) : longbool;
+ stdcall;external 'kernel32' name 'CreateDirectoryA';
+ function RemoveDirectory(name:pointer):longbool;
+ stdcall;external 'kernel32' name 'RemoveDirectoryA';
+ function SetCurrentDirectory(name : pointer) : longbool;
+ stdcall;external 'kernel32' name 'SetCurrentDirectoryA';
+ function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
+ stdcall;external 'kernel32' name 'GetCurrentDirectoryA';
+
+
+
+ Procedure Errno2InOutRes;
+ Begin
+ { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }
+ case Errno of
+ ERROR_WRITE_PROTECT..ERROR_GEN_FAILURE :
+ begin
+ { This is the offset to the Win32 to add to directly map }
+ { to the DOS/TP compatible error codes when in this range }
+ InOutRes := word(errno)+131;
+ end;
+ ERROR_DIR_NOT_EMPTY,
+ ERROR_ALREADY_EXISTS,
+ ERROR_SHARING_VIOLATION :
+ begin
+ InOutRes :=5;
+ end;
+ else
+ begin
+ { other error codes can directly be mapped }
+ InOutRes := Word(errno);
+ end;
+ end;
+ errno:=0;
+ end;
+
+
+{
+ $Log: sysos.inc,v $
+ Revision 1.2 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/win32/sysosh.inc b/rtl/win32/sysosh.inc
new file mode 100644
index 0000000000..e7cb09fbfe
--- /dev/null
+++ b/rtl/win32/sysosh.inc
@@ -0,0 +1,54 @@
+{
+ $Id: sysosh.inc,v 1.3 2005/04/13 20:10:50 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2001 by Free Pascal development team
+
+ This file implements all the base types and limits required
+ for a minimal POSIX compliant subset required to port the compiler
+ to a new OS.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+ THandle = QWord;
+{$else CPU64}
+ THandle = DWord;
+{$endif CPU64}
+ TThreadID = THandle;
+
+ { the fields of this record are os dependent }
+ { and they shouldn't be used in a program }
+ { only the type TCriticalSection is important }
+ PRTLCriticalSection = ^TRTLCriticalSection;
+ TRTLCriticalSection = packed record
+ DebugInfo : pointer;
+ LockCount : longint;
+ RecursionCount : longint;
+ OwningThread : DWord;
+ LockSemaphore : DWord;
+ Reserved : DWord;
+ end;
+
+{
+ $Log: sysosh.inc,v $
+ Revision 1.3 2005/04/13 20:10:50 florian
+ + TThreadID
+
+ Revision 1.2 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp
new file mode 100644
index 0000000000..60eb762a6e
--- /dev/null
+++ b/rtl/win32/system.pp
@@ -0,0 +1,1138 @@
+{
+ $Id: system.pp,v 1.73 2005/04/03 21:10:59 hajny Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+ member of the Free Pascal development team.
+
+ FPC Pascal system unit for the Win32 API.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$ifndef VER1_0}
+{ $define MT}
+{$endif VER1_0}
+unit {$ifdef VER1_0}SysWin32{$else}System{$endif};
+interface
+
+{$ifdef SYSTEMDEBUG}
+ {$define SYSTEMEXCEPTIONDEBUG}
+{$endif SYSTEMDEBUG}
+
+{$ifdef cpui386}
+ {$define Set_i386_Exception_handler}
+{$endif cpui386}
+
+{ include system-independent routine headers }
+{$I systemh.inc}
+
+const
+ LineEnding = #13#10;
+ LFNSupport = true;
+ DirectorySeparator = '\';
+ DriveSeparator = ':';
+ PathSeparator = ';';
+{ FileNameCaseSensitive is defined separately below!!! }
+ maxExitCode = 65535;
+
+type
+ PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
+ TEXCEPTION_FRAME = record
+ next : PEXCEPTION_FRAME;
+ handler : pointer;
+ end;
+
+const
+{ Default filehandles }
+ UnusedHandle : THandle = -1;
+ StdInputHandle : THandle = 0;
+ StdOutputHandle : THandle = 0;
+ StdErrorHandle : THandle = 0;
+
+ FileNameCaseSensitive : boolean = true;
+ CtrlZMarksEOF: boolean = true; (* #26 not considered as end of file *)
+
+ sLineBreak = LineEnding;
+ DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+ { Thread count for DLL }
+ Thread_count : longint = 0;
+ System_exception_frame : PEXCEPTION_FRAME =nil;
+
+type
+ TStartupInfo=packed record
+ cb : longint;
+ lpReserved : Pointer;
+ lpDesktop : Pointer;
+ lpTitle : Pointer;
+ dwX : longint;
+ dwY : longint;
+ dwXSize : longint;
+ dwYSize : longint;
+ dwXCountChars : longint;
+ dwYCountChars : longint;
+ dwFillAttribute : longint;
+ dwFlags : longint;
+ wShowWindow : Word;
+ cbReserved2 : Word;
+ lpReserved2 : Pointer;
+ hStdInput : longint;
+ hStdOutput : longint;
+ hStdError : longint;
+ end;
+
+var
+{ C compatible arguments }
+ argc : longint;
+ argv : ppchar;
+{ Win32 Info }
+ startupinfo : tstartupinfo;
+ hprevinst,
+ HInstance,
+ MainInstance,
+ cmdshow : longint;
+ DLLreason,DLLparam:longint;
+ Win32StackTop : Dword;
+
+type
+ TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
+ TDLL_Entry_Hook = procedure (dllparam : longint);
+
+const
+ Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
+ Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
+ Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
+ Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
+
+type
+ HMODULE = THandle;
+
+implementation
+
+{ include system independent routines }
+{$I system.inc}
+
+{*****************************************************************************
+ Parameter Handling
+*****************************************************************************}
+
+var
+ ModuleName : array[0..255] of char;
+
+function GetCommandFile:pchar;
+begin
+ GetModuleFileName(0,@ModuleName,255);
+ GetCommandFile:=@ModuleName;
+end;
+
+
+procedure setup_arguments;
+var
+ arglen,
+ count : longint;
+ argstart,
+ pc,arg : pchar;
+ quote : char;
+ argvlen : longint;
+
+ procedure allocarg(idx,len:longint);
+ var
+ oldargvlen : longint;
+ begin
+ if idx>=argvlen then
+ begin
+ oldargvlen:=argvlen;
+ argvlen:=(idx+8) and (not 7);
+ sysreallocmem(argv,argvlen*sizeof(pointer));
+ fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
+ end;
+ { use realloc to reuse already existing memory }
+ { always allocate, even if length is zero, since }
+ { the arg. is still present! }
+ sysreallocmem(argv[idx],len+1);
+ end;
+
+begin
+ { create commandline, it starts with the executed filename which is argv[0] }
+ { Win32 passes the command NOT via the args, but via getmodulefilename}
+ count:=0;
+ argv:=nil;
+ argvlen:=0;
+ pc:=getcommandfile;
+ Arglen:=0;
+ repeat
+ Inc(Arglen);
+ until (pc[Arglen]=#0);
+ allocarg(count,arglen);
+ move(pc^,argv[count]^,arglen);
+ { Setup cmdline variable }
+ cmdline:=GetCommandLine;
+ { process arguments }
+ pc:=cmdline;
+{$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'Win32 GetCommandLine is #',pc,'#');
+{$EndIf }
+ while pc^<>#0 do
+ begin
+ { skip leading spaces }
+ while pc^ in [#1..#32] do
+ inc(pc);
+ if pc^=#0 then
+ break;
+ { calc argument length }
+ quote:=' ';
+ argstart:=pc;
+ arglen:=0;
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ inc(arglen)
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ inc(arglen);
+ end;
+ else
+ inc(arglen);
+ end;
+ inc(pc);
+ end;
+ { copy argument }
+ { Don't copy the first one, it is already there.}
+ If Count<>0 then
+ begin
+ allocarg(count,arglen);
+ quote:=' ';
+ pc:=argstart;
+ arg:=argv[count];
+ while (pc^<>#0) do
+ begin
+ case pc^ of
+ #1..#32 :
+ begin
+ if quote<>' ' then
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end
+ else
+ break;
+ end;
+ '"' :
+ begin
+ if quote<>'''' then
+ begin
+ if pchar(pc+1)^<>'"' then
+ begin
+ if quote='"' then
+ quote:=' '
+ else
+ quote:='"';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ '''' :
+ begin
+ if quote<>'"' then
+ begin
+ if pchar(pc+1)^<>'''' then
+ begin
+ if quote='''' then
+ quote:=' '
+ else
+ quote:='''';
+ end
+ else
+ inc(pc);
+ end
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ else
+ begin
+ arg^:=pc^;
+ inc(arg);
+ end;
+ end;
+ inc(pc);
+ end;
+ arg^:=#0;
+ end;
+ {$IfDef SYSTEM_DEBUG_STARTUP}
+ Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
+ {$EndIf SYSTEM_DEBUG_STARTUP}
+ inc(count);
+ end;
+ { get argc and create an nil entry }
+ argc:=count;
+ allocarg(argc,0);
+ { free unused memory }
+ sysreallocmem(argv,(argc+1)*sizeof(pointer));
+end;
+
+
+function paramcount : longint;
+begin
+ paramcount := argc - 1;
+end;
+
+function paramstr(l : longint) : string;
+begin
+ if (l>=0) and (l<argc) then
+ paramstr:=strpas(argv[l])
+ else
+ paramstr:='';
+end;
+
+
+procedure randomize;
+begin
+ randseed:=GetTickCount;
+end;
+
+
+{*****************************************************************************
+ System Dependent Exit code
+*****************************************************************************}
+
+procedure install_exception_handlers;forward;
+procedure remove_exception_handlers;forward;
+procedure PascalMain;stdcall;external name 'PASCALMAIN';
+procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
+Procedure ExitDLL(Exitcode : longint); forward;
+procedure asm_exit(Exitcode : longint);external name 'asm_exit';
+
+Procedure system_exit;
+begin
+ { don't call ExitProcess inside
+ the DLL exit code !!
+ This crashes Win95 at least PM }
+ if IsLibrary then
+ ExitDLL(ExitCode);
+ if not IsConsole then
+ begin
+ Close(stderr);
+ Close(stdout);
+ { what about Input and Output ?? PM }
+ end;
+ remove_exception_handlers;
+
+ { call exitprocess, with cleanup as required }
+ asm_exit(exitcode);
+end;
+
+var
+ { value of the stack segment
+ to check if the call stack can be written on exceptions }
+ _SS : Cardinal;
+
+procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
+ begin
+ IsLibrary:=false;
+ { install the handlers for exe only ?
+ or should we install them for DLL also ? (PM) }
+ install_exception_handlers;
+ { This strange construction is needed to solve the _SS problem
+ with a smartlinked syswin32 (PFV) }
+ asm
+ { allocate space for an exception frame }
+ pushl $0
+ pushl %fs:(0)
+ { movl %esp,%fs:(0)
+ but don't insert it as it doesn't
+ point to anything yet
+ this will be used in signals unit }
+ movl %esp,%eax
+ movl %eax,System_exception_frame
+ pushl %ebp
+ xorl %ebp,%ebp
+ movl %esp,%eax
+ movl %eax,Win32StackTop
+ movw %ss,%bp
+ movl %ebp,_SS
+ call SysResetFPU
+ xorl %ebp,%ebp
+ call PASCALMAIN
+ popl %ebp
+ end;
+ { if we pass here there was no error ! }
+ system_exit;
+ end;
+
+Const
+ { DllEntryPoint }
+ DLL_PROCESS_ATTACH = 1;
+ DLL_THREAD_ATTACH = 2;
+ DLL_PROCESS_DETACH = 0;
+ DLL_THREAD_DETACH = 3;
+Var
+ DLLBuf : Jmp_buf;
+Const
+ DLLExitOK : boolean = true;
+
+function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
+var
+ res : longbool;
+
+ begin
+ IsLibrary:=true;
+ Dll_entry:=false;
+ case DLLreason of
+ DLL_PROCESS_ATTACH :
+ begin
+ If SetJmp(DLLBuf) = 0 then
+ begin
+ if assigned(Dll_Process_Attach_Hook) then
+ begin
+ res:=Dll_Process_Attach_Hook(DllParam);
+ if not res then
+ exit(false);
+ end;
+ PASCALMAIN;
+ Dll_entry:=true;
+ end
+ else
+ Dll_entry:=DLLExitOK;
+ end;
+ DLL_THREAD_ATTACH :
+ begin
+ inc(Thread_count);
+{$warning Allocate Threadvars !}
+ if assigned(Dll_Thread_Attach_Hook) then
+ Dll_Thread_Attach_Hook(DllParam);
+ Dll_entry:=true; { return value is ignored }
+ end;
+ DLL_THREAD_DETACH :
+ begin
+ dec(Thread_count);
+ if assigned(Dll_Thread_Detach_Hook) then
+ Dll_Thread_Detach_Hook(DllParam);
+{$warning Release Threadvars !}
+ Dll_entry:=true; { return value is ignored }
+ end;
+ DLL_PROCESS_DETACH :
+ begin
+ Dll_entry:=true; { return value is ignored }
+ If SetJmp(DLLBuf) = 0 then
+ begin
+ FPC_DO_EXIT;
+ end;
+ if assigned(Dll_Process_Detach_Hook) then
+ Dll_Process_Detach_Hook(DllParam);
+ end;
+ end;
+ end;
+
+Procedure ExitDLL(Exitcode : longint);
+begin
+ DLLExitOK:=ExitCode=0;
+ LongJmp(DLLBuf,1);
+end;
+
+function GetCurrentProcess : dword;
+ stdcall;external 'kernel32' name 'GetCurrentProcess';
+
+function ReadProcessMemory(process : dword;address : pointer;dest : pointer;size : dword;bytesread : pdword) : longbool;
+ stdcall;external 'kernel32' name 'ReadProcessMemory';
+
+function is_prefetch(p : pointer) : boolean;
+ var
+ a : array[0..15] of byte;
+ doagain : boolean;
+ instrlo,instrhi,opcode : byte;
+ i : longint;
+ begin
+ result:=false;
+ { read memory savely without causing another exeception }
+ if not(ReadProcessMemory(GetCurrentProcess,p,@a,sizeof(a),nil)) then
+ exit;
+ i:=0;
+ doagain:=true;
+ while doagain and (i<15) do
+ begin
+ opcode:=a[i];
+ instrlo:=opcode and $f;
+ instrhi:=opcode and $f0;
+ case instrhi of
+ { prefix? }
+ $20,$30:
+ doagain:=(instrlo and 7)=6;
+ $60:
+ doagain:=(instrlo and $c)=4;
+ $f0:
+ doagain:=instrlo in [0,2,3];
+ $0:
+ begin
+ result:=(instrlo=$f) and (a[i+1] in [$d,$18]);
+ exit;
+ end;
+ else
+ doagain:=false;
+ end;
+ inc(i);
+ end;
+ end;
+
+
+//
+// Hardware exception handling
+//
+
+{$ifdef Set_i386_Exception_handler}
+
+{
+ Error code definitions for the Win32 API functions
+
+
+ Values are 32 bit values layed out as follows:
+ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
+ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+ +---+-+-+-----------------------+-------------------------------+
+ |Sev|C|R| Facility | Code |
+ +---+-+-+-----------------------+-------------------------------+
+
+ where
+ Sev - is the severity code
+ 00 - Success
+ 01 - Informational
+ 10 - Warning
+ 11 - Error
+
+ C - is the Customer code flag
+ R - is a reserved bit
+ Facility - is the facility code
+ Code - is the facility's status code
+}
+
+const
+ SEVERITY_SUCCESS = $00000000;
+ SEVERITY_INFORMATIONAL = $40000000;
+ SEVERITY_WARNING = $80000000;
+ SEVERITY_ERROR = $C0000000;
+
+const
+ STATUS_SEGMENT_NOTIFICATION = $40000005;
+ DBG_TERMINATE_THREAD = $40010003;
+ DBG_TERMINATE_PROCESS = $40010004;
+ DBG_CONTROL_C = $40010005;
+ DBG_CONTROL_BREAK = $40010008;
+
+ STATUS_GUARD_PAGE_VIOLATION = $80000001;
+ STATUS_DATATYPE_MISALIGNMENT = $80000002;
+ STATUS_BREAKPOINT = $80000003;
+ STATUS_SINGLE_STEP = $80000004;
+ DBG_EXCEPTION_NOT_HANDLED = $80010001;
+
+ STATUS_ACCESS_VIOLATION = $C0000005;
+ STATUS_IN_PAGE_ERROR = $C0000006;
+ STATUS_INVALID_HANDLE = $C0000008;
+ STATUS_NO_MEMORY = $C0000017;
+ STATUS_ILLEGAL_INSTRUCTION = $C000001D;
+ STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
+ STATUS_INVALID_DISPOSITION = $C0000026;
+ STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C;
+ STATUS_FLOAT_DENORMAL_OPERAND = $C000008D;
+ STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E;
+ STATUS_FLOAT_INEXACT_RESULT = $C000008F;
+ STATUS_FLOAT_INVALID_OPERATION = $C0000090;
+ STATUS_FLOAT_OVERFLOW = $C0000091;
+ STATUS_FLOAT_STACK_CHECK = $C0000092;
+ STATUS_FLOAT_UNDERFLOW = $C0000093;
+ STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094;
+ STATUS_INTEGER_OVERFLOW = $C0000095;
+ STATUS_PRIVILEGED_INSTRUCTION = $C0000096;
+ STATUS_STACK_OVERFLOW = $C00000FD;
+ STATUS_CONTROL_C_EXIT = $C000013A;
+ STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4;
+ STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5;
+ STATUS_REG_NAT_CONSUMPTION = $C00002C9;
+
+ EXCEPTION_EXECUTE_HANDLER = 1;
+ EXCEPTION_CONTINUE_EXECUTION = -1;
+ EXCEPTION_CONTINUE_SEARCH = 0;
+
+ EXCEPTION_MAXIMUM_PARAMETERS = 15;
+
+ CONTEXT_X86 = $00010000;
+ CONTEXT_CONTROL = CONTEXT_X86 or $00000001;
+ CONTEXT_INTEGER = CONTEXT_X86 or $00000002;
+ CONTEXT_SEGMENTS = CONTEXT_X86 or $00000004;
+ CONTEXT_FLOATING_POINT = CONTEXT_X86 or $00000008;
+ CONTEXT_DEBUG_REGISTERS = CONTEXT_X86 or $00000010;
+ CONTEXT_EXTENDED_REGISTERS = CONTEXT_X86 or $00000020;
+
+ CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;
+
+ MAXIMUM_SUPPORTED_EXTENSION = 512;
+
+type
+ PFloatingSaveArea = ^TFloatingSaveArea;
+ TFloatingSaveArea = packed record
+ ControlWord : Cardinal;
+ StatusWord : Cardinal;
+ TagWord : Cardinal;
+ ErrorOffset : Cardinal;
+ ErrorSelector : Cardinal;
+ DataOffset : Cardinal;
+ DataSelector : Cardinal;
+ RegisterArea : array[0..79] of Byte;
+ Cr0NpxState : Cardinal;
+ end;
+
+ PContext = ^TContext;
+ TContext = packed record
+ //
+ // The flags values within this flag control the contents of
+ // a CONTEXT record.
+ //
+ ContextFlags : Cardinal;
+
+ //
+ // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
+ // set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT
+ // included in CONTEXT_FULL.
+ //
+ Dr0, Dr1, Dr2,
+ Dr3, Dr6, Dr7 : Cardinal;
+
+ //
+ // This section is specified/returned if the
+ // ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
+ //
+ FloatSave : TFloatingSaveArea;
+
+ //
+ // This section is specified/returned if the
+ // ContextFlags word contains the flag CONTEXT_SEGMENTS.
+ //
+ SegGs, SegFs,
+ SegEs, SegDs : Cardinal;
+
+ //
+ // This section is specified/returned if the
+ // ContextFlags word contains the flag CONTEXT_INTEGER.
+ //
+ Edi, Esi, Ebx,
+ Edx, Ecx, Eax : Cardinal;
+
+ //
+ // This section is specified/returned if the
+ // ContextFlags word contains the flag CONTEXT_CONTROL.
+ //
+ Ebp : Cardinal;
+ Eip : Cardinal;
+ SegCs : Cardinal;
+ EFlags, Esp, SegSs : Cardinal;
+
+ //
+ // This section is specified/returned if the ContextFlags word
+ // contains the flag CONTEXT_EXTENDED_REGISTERS.
+ // The format and contexts are processor specific
+ //
+ ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
+ end;
+
+type
+ PExceptionRecord = ^TExceptionRecord;
+ TExceptionRecord = packed record
+ ExceptionCode : Longint;
+ ExceptionFlags : Longint;
+ ExceptionRecord : PExceptionRecord;
+ ExceptionAddress : Pointer;
+ NumberParameters : Longint;
+ ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
+ end;
+
+ PExceptionPointers = ^TExceptionPointers;
+ TExceptionPointers = packed record
+ ExceptionRecord : PExceptionRecord;
+ ContextRecord : PContext;
+ end;
+
+{ type of functions that should be used for exception handling }
+ TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
+
+function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
+ stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
+
+const
+ MaxExceptionLevel = 16;
+ exceptLevel : Byte = 0;
+
+var
+ exceptEip : array[0..MaxExceptionLevel-1] of Longint;
+ exceptError : array[0..MaxExceptionLevel-1] of Byte;
+ resetFPU : array[0..MaxExceptionLevel-1] of Boolean;
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+procedure DebugHandleErrorAddrFrame(error, addr, frame : longint);
+begin
+ if IsConsole then
+ begin
+ write(stderr,'HandleErrorAddrFrame(error=',error);
+ write(stderr,',addr=',hexstr(addr,8));
+ writeln(stderr,',frame=',hexstr(frame,8),')');
+ end;
+ HandleErrorAddrFrame(error,addr,frame);
+end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+
+procedure JumpToHandleErrorFrame;
+var
+ eip, ebp, error : Longint;
+begin
+ // save ebp
+ asm
+ movl (%ebp),%eax
+ movl %eax,ebp
+ end;
+ if (exceptLevel > 0) then
+ dec(exceptLevel);
+
+ eip:=exceptEip[exceptLevel];
+ error:=exceptError[exceptLevel];
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then
+ writeln(stderr,'In JumpToHandleErrorFrame error=',error);
+{$endif SYSTEMEXCEPTIONDEBUG}
+ if resetFPU[exceptLevel] then asm
+ fninit
+ fldcw fpucw
+ end;
+ { build a fake stack }
+ asm
+{$ifdef REGCALL}
+ movl ebp,%ecx
+ movl eip,%edx
+ movl error,%eax
+ pushl eip
+ movl ebp,%ebp // Change frame pointer
+{$else}
+ movl ebp,%eax
+ pushl %eax
+ movl eip,%eax
+ pushl %eax
+ movl error,%eax
+ pushl %eax
+ movl eip,%eax
+ pushl %eax
+ movl ebp,%ebp // Change frame pointer
+{$endif}
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ jmpl DebugHandleErrorAddrFrame
+{$else not SYSTEMEXCEPTIONDEBUG}
+ jmpl HandleErrorAddrFrame
+{$endif SYSTEMEXCEPTIONDEBUG}
+ end;
+end;
+
+function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
+var
+ frame,
+ res : longint;
+
+function SysHandleErrorFrame(error, frame : Longint; must_reset_fpu : Boolean) : Longint;
+begin
+ if (frame = 0) then
+ SysHandleErrorFrame:=EXCEPTION_CONTINUE_SEARCH
+ else begin
+ if (exceptLevel >= MaxExceptionLevel) then exit;
+
+ exceptEip[exceptLevel] := excep^.ContextRecord^.Eip;
+ exceptError[exceptLevel] := error;
+ resetFPU[exceptLevel] := must_reset_fpu;
+ inc(exceptLevel);
+
+ excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame);
+ excep^.ExceptionRecord^.ExceptionCode := 0;
+
+ SysHandleErrorFrame := EXCEPTION_CONTINUE_EXECUTION;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then begin
+ writeln(stderr,'Exception Continue Exception set at ',
+ hexstr(exceptEip[exceptLevel],8));
+ writeln(stderr,'Eip changed to ',
+ hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error);
+ end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ end;
+end;
+
+begin
+ if excep^.ContextRecord^.SegSs=_SS then
+ frame := excep^.ContextRecord^.Ebp
+ else
+ frame := 0;
+ res := EXCEPTION_CONTINUE_SEARCH;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ if IsConsole then Writeln(stderr,'Exception ',
+ hexstr(excep^.ExceptionRecord^.ExceptionCode, 8));
+{$endif SYSTEMEXCEPTIONDEBUG}
+ case cardinal(excep^.ExceptionRecord^.ExceptionCode) of
+ STATUS_INTEGER_DIVIDE_BY_ZERO,
+ STATUS_FLOAT_DIVIDE_BY_ZERO :
+ res := SysHandleErrorFrame(200, frame, true);
+ STATUS_ARRAY_BOUNDS_EXCEEDED :
+ res := SysHandleErrorFrame(201, frame, false);
+ STATUS_STACK_OVERFLOW :
+ res := SysHandleErrorFrame(202, frame, false);
+ STATUS_FLOAT_OVERFLOW :
+ res := SysHandleErrorFrame(205, frame, true);
+ STATUS_FLOAT_DENORMAL_OPERAND,
+ STATUS_FLOAT_UNDERFLOW :
+ res := SysHandleErrorFrame(206, frame, true);
+{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
+ STATUS_FLOAT_INEXACT_RESULT,
+ STATUS_FLOAT_INVALID_OPERATION,
+ STATUS_FLOAT_STACK_CHECK :
+ res := SysHandleErrorFrame(207, frame, true);
+ STATUS_INTEGER_OVERFLOW :
+ res := SysHandleErrorFrame(215, frame, false);
+ STATUS_ILLEGAL_INSTRUCTION:
+ res := SysHandleErrorFrame(216, frame, true);
+ STATUS_ACCESS_VIOLATION:
+ { Athlon prefetch bug? }
+ if is_prefetch(pointer(excep^.ContextRecord^.Eip)) then
+ begin
+ { if yes, then retry }
+ excep^.ExceptionRecord^.ExceptionCode := 0;
+ res:=EXCEPTION_CONTINUE_EXECUTION;
+ end
+ else
+ res := SysHandleErrorFrame(216, frame, true);
+
+ STATUS_CONTROL_C_EXIT:
+ res := SysHandleErrorFrame(217, frame, true);
+ STATUS_PRIVILEGED_INSTRUCTION:
+ res := SysHandleErrorFrame(218, frame, false);
+ else
+ begin
+ if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
+ res := SysHandleErrorFrame(217, frame, true)
+ else
+ res := SysHandleErrorFrame(255, frame, true);
+ end;
+ end;
+ syswin32_i386_exception_handler := res;
+end;
+
+
+procedure install_exception_handlers;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+var
+ oldexceptaddr,
+ newexceptaddr : Longint;
+{$endif SYSTEMEXCEPTIONDEBUG}
+
+begin
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ asm
+ movl $0,%eax
+ movl %fs:(%eax),%eax
+ movl %eax,oldexceptaddr
+ end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+ SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+ asm
+ movl $0,%eax
+ movl %fs:(%eax),%eax
+ movl %eax,newexceptaddr
+ end;
+ if IsConsole then
+ writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8),
+ ' new exception ',hexstr(newexceptaddr,8));
+{$endif SYSTEMEXCEPTIONDEBUG}
+end;
+
+procedure remove_exception_handlers;
+begin
+ SetUnhandledExceptionFilter(nil);
+end;
+
+{$else not cpui386 (Processor specific !!)}
+procedure install_exception_handlers;
+begin
+end;
+
+procedure remove_exception_handlers;
+begin
+end;
+
+{$endif Set_i386_Exception_handler}
+
+
+{$ifdef HASWIDESTRING}
+{****************************************************************************
+ OS dependend widestrings
+****************************************************************************}
+
+function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharUpperBuffW';
+function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharLowerBuffW';
+
+
+function Win32WideUpper(const s : WideString) : WideString;
+ begin
+ result:=s;
+ UniqueString(result);
+ if length(result)>0 then
+ CharUpperBuff(LPWSTR(result),length(result));
+ end;
+
+
+function Win32WideLower(const s : WideString) : WideString;
+ begin
+ result:=s;
+ UniqueString(result);
+ if length(result)>0 then
+ CharLowerBuff(LPWSTR(result),length(result));
+ end;
+
+
+{ there is a similiar procedure in sysutils which inits the fields which
+ are only relevant for the sysutils units }
+procedure InitWin32Widestrings;
+ begin
+ widestringmanager.UpperWideStringProc:=@Win32WideUpper;
+ widestringmanager.LowerWideStringProc:=@Win32WideLower;
+ end;
+
+{$endif HASWIDESTRING}
+
+
+{****************************************************************************
+ Error Message writing using messageboxes
+****************************************************************************}
+
+function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
+ stdcall;external 'user32' name 'MessageBoxA';
+
+const
+ ErrorBufferLength = 1024;
+var
+ ErrorBuf : array[0..ErrorBufferLength] of char;
+ ErrorLen : longint;
+
+Function ErrorWrite(Var F: TextRec): Integer;
+{
+ An error message should always end with #13#10#13#10
+}
+var
+ p : pchar;
+ i : longint;
+Begin
+ if F.BufPos>0 then
+ begin
+ if F.BufPos+ErrorLen>ErrorBufferLength then
+ i:=ErrorBufferLength-ErrorLen
+ else
+ i:=F.BufPos;
+ Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
+ inc(ErrorLen,i);
+ ErrorBuf[ErrorLen]:=#0;
+ end;
+ if ErrorLen>3 then
+ begin
+ p:=@ErrorBuf[ErrorLen];
+ for i:=1 to 4 do
+ begin
+ dec(p);
+ if not(p^ in [#10,#13]) then
+ break;
+ end;
+ end;
+ if ErrorLen=ErrorBufferLength then
+ i:=4;
+ if (i=4) then
+ begin
+ MessageBox(0,@ErrorBuf,pchar('Error'),0);
+ ErrorLen:=0;
+ end;
+ F.BufPos:=0;
+ ErrorWrite:=0;
+End;
+
+
+Function ErrorClose(Var F: TextRec): Integer;
+begin
+ if ErrorLen>0 then
+ begin
+ MessageBox(0,@ErrorBuf,pchar('Error'),0);
+ ErrorLen:=0;
+ end;
+ ErrorLen:=0;
+ ErrorClose:=0;
+end;
+
+
+Function ErrorOpen(Var F: TextRec): Integer;
+Begin
+ TextRec(F).InOutFunc:=@ErrorWrite;
+ TextRec(F).FlushFunc:=@ErrorWrite;
+ TextRec(F).CloseFunc:=@ErrorClose;
+ ErrorOpen:=0;
+End;
+
+
+procedure AssignError(Var T: Text);
+begin
+ Assign(T,'');
+ TextRec(T).OpenFunc:=@ErrorOpen;
+ Rewrite(T);
+end;
+
+
+procedure SysInitStdIO;
+begin
+ { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+ displayed in and messagebox }
+ StdInputHandle:=longint(GetStdHandle(cardinal(STD_INPUT_HANDLE)));
+ StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
+ StdErrorHandle:=longint(GetStdHandle(cardinal(STD_ERROR_HANDLE)));
+ if not IsConsole then
+ begin
+ AssignError(stderr);
+ AssignError(stdout);
+ Assign(Output,'');
+ Assign(Input,'');
+ Assign(ErrOutput,'');
+ end
+ else
+ begin
+ OpenStdIO(Input,fmInput,StdInputHandle);
+ OpenStdIO(Output,fmOutput,StdOutputHandle);
+ OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+ OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+ OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+ end;
+end;
+
+(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *)
+
+var
+ ProcessID: SizeUInt;
+
+function GetProcessID: SizeUInt;
+begin
+ GetProcessID := ProcessID;
+end;
+
+
+const
+ Exe_entry_code : pointer = @Exe_entry;
+ Dll_entry_code : pointer = @Dll_entry;
+
+begin
+ StackLength := InitialStkLen;
+ StackBottom := Sptr - StackLength;
+ { get some helpful informations }
+ GetStartupInfo(@startupinfo);
+ { some misc Win32 stuff }
+ hprevinst:=0;
+ if not IsLibrary then
+ HInstance:=getmodulehandle(GetCommandFile);
+ MainInstance:=HInstance;
+ cmdshow:=startupinfo.wshowwindow;
+ { Setup heap }
+ InitHeap;
+ SysInitExceptions;
+ SysInitStdIO;
+ { Arguments }
+ setup_arguments;
+ { Reset IO Error }
+ InOutRes:=0;
+ ProcessID := GetCurrentProcessID;
+ { threading }
+ InitSystemThreads;
+ { Reset internal error variable }
+ errno:=0;
+{$ifdef HASVARIANT}
+ initvariantmanager;
+{$endif HASVARIANT}
+{$ifdef HASWIDESTRING}
+ initwidestringmanager;
+ InitWin32Widestrings
+{$endif HASWIDESTRING}
+end.
+
+{
+ $Log: system.pp,v $
+ Revision 1.73 2005/04/03 21:10:59 hajny
+ * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
+
+ Revision 1.72 2005/03/21 16:31:33 peter
+ * fix crash under win32 with previous reallocmem fix
+
+ Revision 1.71 2005/03/02 19:18:42 florian
+ * fixed compilation with 1.0.10
+
+ Revision 1.70 2005/02/26 20:43:52 florian
+ + WideCompareString and WideCompareText for win32 implemented
+
+ Revision 1.69 2005/02/26 10:21:17 florian
+ + implemented WideFormat
+ + some Widestring stuff implemented
+ * some Widestring stuff fixed
+
+ Revision 1.68 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.67 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.66 2005/02/01 20:22:50 florian
+ * improved widestring infrastructure manager
+
+}
diff --git a/rtl/win32/systhrd.inc b/rtl/win32/systhrd.inc
new file mode 100644
index 0000000000..1c18173eb8
--- /dev/null
+++ b/rtl/win32/systhrd.inc
@@ -0,0 +1,490 @@
+{
+ $Id: systhrd.inc,v 1.3 2005/04/09 17:26:08 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Peter Vreman,
+ member of the Free Pascal development team.
+
+ Linux (pthreads) threading support implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+ Local WINApi imports
+*****************************************************************************}
+
+const
+ { GlobalAlloc, GlobalFlags }
+ GMEM_FIXED = 0;
+ GMEM_ZEROINIT = 64;
+
+function TlsAlloc : DWord;
+ stdcall;external 'kernel32' name 'TlsAlloc';
+function TlsGetValue(dwTlsIndex : DWord) : pointer;
+ stdcall;external 'kernel32' name 'TlsGetValue';
+function TlsSetValue(dwTlsIndex : DWord;lpTlsValue : pointer) : LongBool;
+ stdcall;external 'kernel32' name 'TlsSetValue';
+function TlsFree(dwTlsIndex : DWord) : LongBool;
+ stdcall;external 'kernel32' name 'TlsFree';
+function CreateThread(lpThreadAttributes : pointer;
+ dwStackSize : DWord; lpStartAddress : pointer;lpParameter : pointer;
+ dwCreationFlags : DWord;var lpThreadId : DWord) : Dword;
+ stdcall;external 'kernel32' name 'CreateThread';
+procedure ExitThread(dwExitCode : DWord);
+ stdcall;external 'kernel32' name 'ExitThread';
+function GlobalAlloc(uFlags:DWord; dwBytes:DWORD):Pointer;
+ stdcall;external 'kernel32' name 'GlobalAlloc';
+function GlobalFree(hMem : Pointer):Pointer; stdcall;external 'kernel32' name 'GlobalFree';
+procedure Sleep(dwMilliseconds: DWord); stdcall;external 'kernel32' name 'Sleep';
+function WinSuspendThread (threadHandle : dword) : dword; stdcall;external 'kernel32' name 'SuspendThread';
+function WinResumeThread (threadHandle : dword) : dword; stdcall;external 'kernel32' name 'ResumeThread';
+function TerminateThread (threadHandle : dword; var exitCode : dword) : boolean; stdcall;external 'kernel32' name 'TerminateThread';
+function WaitForSingleObject (hHandle,Milliseconds: dword): dword; stdcall;external 'kernel32' name 'WaitForSingleObject';
+function WinThreadSetPriority (threadHandle : dword; Prio: longint): boolean; stdcall;external 'kernel32' name 'SetThreadPriority';
+function WinThreadGetPriority (threadHandle : dword): LongInt; stdcall;external 'kernel32' name 'GetThreadPriority';
+function WinGetCurrentThreadId : dword; stdcall;external 'kernel32' name 'GetCurrentThread';
+function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar):CARDINAL; stdcall; external 'kernel32' name 'CreateEventA';
+function ResetEvent(hEvent:CARDINAL):LONGBOOL; stdcall; external 'kernel32' name 'ResetEvent';
+function SetEvent(hEvent:CARDINAL):LONGBOOL; stdcall; external 'kernel32' name 'SetEvent';
+
+CONST
+ WAIT_OBJECT_0 = 0;
+ WAIT_ABANDONED_0 = $80;
+ WAIT_TIMEOUT = $102;
+ WAIT_IO_COMPLETION = $c0;
+ WAIT_ABANDONED = $80;
+ WAIT_FAILED = $ffffffff;
+
+
+{*****************************************************************************
+ Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+ const
+ threadvarblocksize : dword = 0;
+
+ var
+ TLSKey : Dword;
+
+ procedure SysInitThreadvar(var offset : dword;size : dword);
+ begin
+ offset:=threadvarblocksize;
+ inc(threadvarblocksize,size);
+ end;
+
+
+ function SysRelocateThreadvar(offset : dword) : pointer;
+ begin
+ SysRelocateThreadvar:=TlsGetValue(tlskey)+Offset;
+ end;
+
+
+ procedure SysAllocateThreadVars;
+ var
+ dataindex : pointer;
+ begin
+ { we've to allocate the memory from system }
+ { because the FPC heap management uses }
+ { exceptions which use threadvars but }
+ { these aren't allocated yet ... }
+ { allocate room on the heap for the thread vars }
+ dataindex:=pointer(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT,threadvarblocksize));
+ TlsSetValue(tlskey,dataindex);
+ end;
+
+
+ procedure SysReleaseThreadVars;
+ begin
+ GlobalFree(TlsGetValue(tlskey));
+ end;
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+ Thread starting
+*****************************************************************************}
+
+ type
+ pthreadinfo = ^tthreadinfo;
+ tthreadinfo = record
+ f : tthreadfunc;
+ p : pointer;
+ stklen : cardinal;
+ end;
+
+ procedure DoneThread;
+ begin
+ { Release Threadvars }
+{$ifdef HASTHREADVAR}
+ SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+ end;
+
+
+ function ThreadMain(param : pointer) : Longint; stdcall;
+ var
+ ti : tthreadinfo;
+ begin
+{$ifdef HASTHREADVAR}
+ { Allocate local thread vars, this must be the first thing,
+ because the exception management and io depends on threadvars }
+ SysAllocateThreadVars;
+{$endif HASTHREADVAR}
+ { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+ writeln('New thread started, initialising ...');
+{$endif DEBUG_MT}
+ ti:=pthreadinfo(param)^;
+ dispose(pthreadinfo(param));
+ { Initialize thread }
+ InitThread(ti.stklen);
+ { Start thread function }
+{$ifdef DEBUG_MT}
+ writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+ ThreadMain:=ti.f(ti.p);
+ end;
+
+
+ function SysBeginThread(sa : Pointer;stacksize : dword;
+ ThreadFunction : tthreadfunc;p : pointer;
+ creationFlags : dword; var ThreadId : DWord) : DWord;
+ var
+ ti : pthreadinfo;
+ begin
+{$ifdef DEBUG_MT}
+ writeln('Creating new thread');
+{$endif DEBUG_MT}
+ { Initialize multithreading if not done }
+ if not IsMultiThread then
+ begin
+{$ifdef HASTHREADVAR}
+ { We're still running in single thread mode, setup the TLS }
+ TLSKey:=TlsAlloc;
+ InitThreadVars(@SysRelocateThreadvar);
+{$endif HASTHREADVAR}
+ IsMultiThread:=true;
+ end;
+ { the only way to pass data to the newly created thread
+ in a MT safe way, is to use the heap }
+ new(ti);
+ ti^.f:=ThreadFunction;
+ ti^.p:=p;
+ ti^.stklen:=stacksize;
+ { call pthread_create }
+{$ifdef DEBUG_MT}
+ writeln('Starting new thread');
+{$endif DEBUG_MT}
+ SysBeginThread:=CreateThread(sa,stacksize,@ThreadMain,ti,creationflags,threadid);
+ end;
+
+
+ procedure SysEndThread(ExitCode : DWord);
+ begin
+ DoneThread;
+ ExitThread(ExitCode);
+ end;
+
+
+ procedure SysThreadSwitch;
+ begin
+ Sleep(0);
+ end;
+
+
+ function SysSuspendThread (threadHandle : dword) : dword;
+ begin
+ SysSuspendThread:=WinSuspendThread(threadHandle);
+ end;
+
+
+ function SysResumeThread (threadHandle : dword) : dword;
+ begin
+ SysResumeThread:=WinResumeThread(threadHandle);
+ end;
+
+
+ function SysKillThread (threadHandle : dword) : dword;
+ var exitCode : dword;
+ begin
+ if not TerminateThread (threadHandle, exitCode) then
+ SysKillThread := GetLastError
+ else
+ SysKillThread := 0;
+ end;
+
+ function SysWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;
+ begin
+ if timeoutMs = 0 then dec (timeoutMs); // $ffffffff is INFINITE
+ SysWaitForThreadTerminate := WaitForSingleObject(threadHandle, TimeoutMs);
+ end;
+
+
+ function SysThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
+ begin
+ SysThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio);
+ end;
+
+
+ function SysThreadGetPriority (threadHandle : dword): longint;
+ begin
+ SysThreadGetPriority:=WinThreadGetPriority(threadHandle);
+ end;
+
+ function SysGetCurrentThreadId : dword;
+ begin
+ SysGetCurrentThreadId:=Win32GetCurrentThreadId;
+ end;
+
+{*****************************************************************************
+ Delphi/Win32 compatibility
+*****************************************************************************}
+
+procedure WinInitCriticalSection(var cs : TRTLCriticalSection);
+ stdcall;external 'kernel32' name 'InitializeCriticalSection';
+
+procedure WinDoneCriticalSection(var cs : TRTLCriticalSection);
+ stdcall;external 'kernel32' name 'DeleteCriticalSection';
+
+procedure WinEnterCriticalSection(var cs : TRTLCriticalSection);
+ stdcall;external 'kernel32' name 'EnterCriticalSection';
+
+procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection);
+ stdcall;external 'kernel32' name 'LeaveCriticalSection';
+
+procedure SySInitCriticalSection(var cs);
+begin
+ WinInitCriticalSection(PRTLCriticalSection(@cs)^);
+end;
+
+
+procedure SysDoneCriticalSection(var cs);
+begin
+ WinDoneCriticalSection(PRTLCriticalSection(@cs)^);
+end;
+
+
+procedure SysEnterCriticalSection(var cs);
+begin
+ WinEnterCriticalSection(PRTLCriticalSection(@cs)^);
+end;
+
+
+procedure SySLeaveCriticalSection(var cs);
+begin
+ WinLeaveCriticalSection(PRTLCriticalSection(@cs)^);
+end;
+
+
+{*****************************************************************************
+ Heap Mutex Protection
+*****************************************************************************}
+
+ var
+ HeapMutex : TRTLCriticalSection;
+
+ procedure Win32HeapMutexInit;
+ begin
+ InitCriticalSection(heapmutex);
+ end;
+
+ procedure Win32HeapMutexDone;
+ begin
+ DoneCriticalSection(heapmutex);
+ end;
+
+ procedure Win32HeapMutexLock;
+ begin
+ EnterCriticalSection(heapmutex);
+ end;
+
+ procedure Win32HeapMutexUnlock;
+ begin
+ LeaveCriticalSection(heapmutex);
+ end;
+
+ const
+ Win32MemoryMutexManager : TMemoryMutexManager = (
+ MutexInit : @Win32HeapMutexInit;
+ MutexDone : @Win32HeapMutexDone;
+ MutexLock : @Win32HeapMutexLock;
+ MutexUnlock : @Win32HeapMutexUnlock;
+ );
+
+ procedure InitHeapMutexes;
+ begin
+ SetMemoryMutexManager(Win32MemoryMutexManager);
+ end;
+
+Const
+ wrSignaled = 0;
+ wrTimeout = 1;
+ wrAbandoned= 2;
+ wrError = 3;
+
+type Tbasiceventstate=record
+ fhandle : THandle;
+ flasterror : longint;
+ end;
+ plocaleventrec= ^tbasiceventstate;
+
+function intBasicEventCreate(EventAttributes : Pointer;
+AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+begin
+ new(plocaleventrec(result));
+ plocaleventrec(result)^.FHandle := CreateEvent(EventAttributes, AManualReset, InitialState,PChar(Name));
+end;
+
+procedure intbasiceventdestroy(state:peventstate);
+
+begin
+ closehandle(plocaleventrec(state)^.fhandle);
+ dispose(plocaleventrec(state));
+end;
+
+procedure intbasiceventResetEvent(state:peventstate);
+
+begin
+ ResetEvent(plocaleventrec(state)^.FHandle)
+end;
+
+procedure intbasiceventSetEvent(state:peventstate);
+
+begin
+ SetEvent(plocaleventrec(state)^.FHandle);
+end;
+
+function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+ case WaitForSingleObject(plocaleventrec(state)^.fHandle, Timeout) of
+ WAIT_ABANDONED: Result := wrAbandoned;
+ WAIT_OBJECT_0: Result := wrSignaled;
+ WAIT_TIMEOUT: Result := wrTimeout;
+ WAIT_FAILED:
+ begin
+ Result := wrError;
+ plocaleventrec(state)^.FLastError := GetLastError;
+ end;
+ else
+ Result := wrError;
+ end;
+end;
+
+function intRTLEventCreate: PRTLEvent;
+begin
+ Result := PRTLEVENT(CreateEvent(nil, false, false, nil));
+end;
+
+procedure intRTLEventDestroy(AEvent: PRTLEvent);
+begin
+ CloseHandle(THANDLE(AEvent));
+end;
+
+procedure intRTLEventSetEvent(AEvent: PRTLEvent);
+begin
+ SetEvent(THANDLE(AEvent));
+end;
+
+procedure intRTLEventResetEvent(AEvent: PRTLEvent);
+begin
+ ResetEvent(THANDLE(AEvent));
+end;
+
+procedure intRTLEventStartWait(AEvent: PRTLEvent);
+begin
+ { this is to get at least some common behaviour on unix and win32:
+ events before startwait are lost on unix, so reset the event on
+ win32 as well }
+ ResetEvent(THANDLE(AEvent));
+end;
+
+procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+const
+ INFINITE=-1;
+begin
+ WaitForSingleObject(THANDLE(AEvent), INFINITE);
+end;
+
+procedure intRTLEventWaitForTimeout(AEvent: PRTLEvent;timeout : longint);
+begin
+ WaitForSingleObject(THANDLE(AEvent), timeout);
+end;
+
+
+Var
+ WinThreadManager : TThreadManager;
+
+Procedure InitSystemThreads;
+begin
+ With WinThreadManager do
+ begin
+ InitManager :=Nil;
+ DoneManager :=Nil;
+ BeginThread :=@SysBeginThread;
+ EndThread :=@SysEndThread;
+ SuspendThread :=@SysSuspendThread;
+ ResumeThread :=@SysResumeThread;
+ KillThread :=@SysKillThread;
+ ThreadSwitch :=@SysThreadSwitch;
+ WaitForThreadTerminate :=@SysWaitForThreadTerminate;
+ ThreadSetPriority :=@SysThreadSetPriority;
+ ThreadGetPriority :=@SysThreadGetPriority;
+ GetCurrentThreadId :=@SysGetCurrentThreadId;
+ InitCriticalSection :=@SysInitCriticalSection;
+ DoneCriticalSection :=@SysDoneCriticalSection;
+ EnterCriticalSection :=@SysEnterCriticalSection;
+ LeaveCriticalSection :=@SysLeaveCriticalSection;
+{$ifdef HASTHREADVAR}
+ InitThreadVar :=@SysInitThreadVar;
+ RelocateThreadVar :=@SysRelocateThreadVar;
+ AllocateThreadVars :=@SysAllocateThreadVars;
+ ReleaseThreadVars :=@SysReleaseThreadVars;
+{$endif HASTHREADVAR}
+ BasicEventCreate :=@intBasicEventCreate;
+ BasicEventDestroy :=@intBasicEventDestroy;
+ BasicEventResetEvent :=@intBasicEventResetEvent;
+ BasicEventSetEvent :=@intBasicEventSetEvent;
+ BasiceventWaitFor :=@intBasiceventWaitFor;
+ RTLEventCreate :=@intRTLEventCreate;
+ RTLEventDestroy :=@intRTLEventDestroy;
+ RTLEventSetEvent :=@intRTLEventSetEvent;
+ RTLEventResetEvent :=@intRTLEventResetEvent;
+ RTLEventStartWait :=@intRTLEventStartWait;
+ RTLEventWaitFor :=@intRTLEventWaitFor;
+ RTLEventWaitForTimeout :=@intRTLEventWaitForTimeout;
+ end;
+ SetThreadManager(WinThreadManager);
+ InitHeapMutexes;
+ ThreadID := GetCurrentThreadID;
+end;
+
+
+{
+ $Log: systhrd.inc,v $
+ Revision 1.3 2005/04/09 17:26:08 florian
+ + classes.mainthreadid is set now
+ + rtleventresetevent
+ + rtleventwairfor with timeout
+ + checksynchronize with timeout
+ * race condition in synchronize fixed
+
+ Revision 1.2 2005/02/08 16:28:27 peter
+ pulseevent -> setevent
+
+ Revision 1.1 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
+
diff --git a/rtl/win32/sysutils.pp b/rtl/win32/sysutils.pp
new file mode 100644
index 0000000000..1384f722b3
--- /dev/null
+++ b/rtl/win32/sysutils.pp
@@ -0,0 +1,1151 @@
+{
+ $Id: sysutils.pp,v 1.45 2005/03/12 14:56:22 florian Exp $
+
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Sysutils unit for win32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$IFNDEF VIRTUALPASCAL}
+{$MODE objfpc}
+{$ENDIF}
+{ force ansistrings }
+{$H+}
+
+uses
+ {$IFDEF VIRTUALPASCAL}
+ vpglue,
+ strings,
+ crt,
+ {$ENDIF}
+ dos,
+ windows;
+
+{$DEFINE HAS_SLEEP}
+{$DEFINE HAS_OSERROR}
+{$DEFINE HAS_OSCONFIG}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+type
+ TSystemTime = Windows.TSystemTime;
+
+ EWin32Error = class(Exception)
+ public
+ ErrorCode : DWORD;
+ end;
+
+
+Var
+ Win32Platform : Longint;
+ Win32MajorVersion,
+ Win32MinorVersion,
+ Win32BuildNumber : dword;
+ Win32CSDVersion : ShortString; // CSD record is 128 bytes only?
+
+
+implementation
+
+ uses
+ sysconst;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+ File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+const
+ AccessMode: array[0..2] of Cardinal = (
+ GENERIC_READ,
+ GENERIC_WRITE,
+ GENERIC_READ or GENERIC_WRITE);
+ ShareMode: array[0..4] of Integer = (
+ 0,
+ 0,
+ FILE_SHARE_READ,
+ FILE_SHARE_WRITE,
+ FILE_SHARE_READ or FILE_SHARE_WRITE);
+Var
+ FN : string;
+begin
+ FN:=FileName+#0;
+ result := CreateFile(@FN[1], dword(AccessMode[Mode and 3]),
+ dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL, 0);
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+Var
+ FN : string;
+begin
+ FN:=FileName+#0;
+ Result := CreateFile(@FN[1], GENERIC_READ or GENERIC_WRITE,
+ 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+end;
+
+
+Function FileCreate (Const FileName : String; Mode:longint) : SizeInt;
+begin
+ FileCreate:=FileCreate(FileName);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+Var
+ res : dword;
+begin
+ if ReadFile(Handle, Buffer, Count, res, nil) then
+ FileRead:=Res
+ else
+ FileRead:=-1;
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+Var
+ Res : dword;
+begin
+ if WriteFile(Handle, Buffer, Count, Res, nil) then
+ FileWrite:=Res
+ else
+ FileWrite:=-1;
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+begin
+ Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
+end;
+
+
+Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
+begin
+ {$warning need to add 64bit call }
+ Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
+end;
+
+
+Procedure FileClose (Handle : Longint);
+begin
+ if Handle<=4 then
+ exit;
+ CloseHandle(Handle);
+end;
+
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+begin
+ Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1;
+ If Result then
+ Result:=SetEndOfFile(handle);
+end;
+
+Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;
+var
+ lft : TFileTime;
+begin
+ {$IFDEF VIRTUALPASCAL}
+ DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
+ LocalFileTimeToFileTime(lft,Wtime);
+ {$ELSE}
+ DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,@lft) and
+ LocalFileTimeToFileTime(lft,Wtime);
+ {$ENDIF}
+end;
+
+
+Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
+var
+ lft : TFileTime;
+begin
+ WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
+ FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+var
+ Handle: THandle;
+ FindData: TWin32FindData;
+begin
+ Handle := FindFirstFile(Pchar(FileName), FindData);
+ if Handle <> INVALID_HANDLE_VALUE then
+ begin
+ Windows.FindClose(Handle);
+ if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
+ If WinToDosTime(FindData.ftLastWriteTime,Result) then
+ exit;
+ end;
+ Result := -1;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+var
+ Handle: THandle;
+ FindData: TWin32FindData;
+begin
+ Handle := FindFirstFile(Pchar(FileName), FindData);
+ Result:=Handle <> INVALID_HANDLE_VALUE;
+ If Result then
+ Windows.FindClose(Handle);
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+var
+ Handle: THandle;
+ FindData: TWin32FindData;
+begin
+ Result:=False;
+ Handle := FindFirstFile(Pchar(Directory), FindData);
+ If (Handle <> INVALID_HANDLE_VALUE) then
+ begin
+ Result:=((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY);
+ Windows.FindClose(Handle);
+ end;
+end;
+
+
+Function FindMatch(var f: TSearchRec) : Longint;
+begin
+ { Find file with correct attribute }
+ While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
+ begin
+ if not FindNextFile (F.FindHandle,F.FindData) then
+ begin
+ Result:=GetLastError;
+ exit;
+ end;
+ end;
+ { Convert some attributes back }
+ WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
+ f.size:=F.FindData.NFileSizeLow;
+ f.attr:=F.FindData.dwFileAttributes;
+ f.Name:=StrPas(@F.FindData.cFileName);
+ Result:=0;
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+begin
+ Rslt.Name:=Path;
+ Rslt.Attr:=attr;
+ Rslt.ExcludeAttr:=(not Attr) and ($1e);
+ { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
+ { FindFirstFile is a Win32 Call }
+ Rslt.FindHandle:=FindFirstFile (PChar(Path),Rslt.FindData);
+ If Rslt.FindHandle=Invalid_Handle_value then
+ begin
+ Result:=GetLastError;
+ exit;
+ end;
+ { Find file with correct attribute }
+ Result:=FindMatch(Rslt);
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+begin
+ if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
+ Result := FindMatch(Rslt)
+ else
+ Result := GetLastError;
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+begin
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ Windows.FindClose(F.FindHandle);
+end;
+
+
+Function FileGetDate (Handle : Longint) : Longint;
+Var
+ FT : TFileTime;
+begin
+ If GetFileTime(Handle,nil,nil,@ft) and
+ WinToDosTime(FT,Result) then
+ exit;
+ Result:=-1;
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+Var
+ FT: TFileTime;
+begin
+ {$IFDEF VIRTUALPASCAL}
+ Result := 0;
+ {$ELSE}
+ Result := 0;
+ if DosToWinTime(Age,FT) and
+ SetFileTime(Handle, ft, ft, FT) then
+ Exit;
+ Result := GetLastError;
+ {$ENDIF}
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+begin
+ Result:=GetFileAttributes(PChar(FileName));
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+begin
+ if not SetFileAttributes(PChar(FileName), Attr) then
+ Result := GetLastError
+ else
+ Result:=0;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+begin
+ DeleteFile:=Windows.DeleteFile(Pchar(FileName));
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+begin
+ Result := MoveFile(PChar(OldName), PChar(NewName));
+end;
+
+
+{****************************************************************************
+ Disk Functions
+****************************************************************************}
+
+function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
+ freeclusters,totalclusters:longint):longbool;
+ stdcall;external 'kernel32' name 'GetDiskFreeSpaceA';
+type
+ {$IFDEF VIRTUALPASCAL}
+ {&StdCall+}
+ TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;
+ {&StdCall-}
+ {$ELSE}
+ TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;stdcall;
+ {$ENDIF}
+
+var
+ GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
+
+function diskfree(drive : byte) : int64;
+var
+ disk : array[1..4] of char;
+ secs,bytes,
+ free,total : longint;
+ qwtotal,qwfree,qwcaller : int64;
+
+
+begin
+ if drive=0 then
+ begin
+ disk[1]:='\';
+ disk[2]:=#0;
+ end
+ else
+ begin
+ disk[1]:=chr(drive+64);
+ disk[2]:=':';
+ disk[3]:='\';
+ disk[4]:=#0;
+ end;
+ if assigned(GetDiskFreeSpaceEx) then
+ begin
+ if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
+ diskfree:=qwfree
+ else
+ diskfree:=-1;
+ end
+ else
+ begin
+ if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+ diskfree:=int64(free)*secs*bytes
+ else
+ diskfree:=-1;
+ end;
+end;
+
+
+function disksize(drive : byte) : int64;
+var
+ disk : array[1..4] of char;
+ secs,bytes,
+ free,total : longint;
+ qwtotal,qwfree,qwcaller : int64;
+begin
+ if drive=0 then
+ begin
+ disk[1]:='\';
+ disk[2]:=#0;
+ end
+ else
+ begin
+ disk[1]:=chr(drive+64);
+ disk[2]:=':';
+ disk[3]:='\';
+ disk[4]:=#0;
+ end;
+ if assigned(GetDiskFreeSpaceEx) then
+ begin
+ if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
+ disksize:=qwtotal
+ else
+ disksize:=-1;
+ end
+ else
+ begin
+ if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+ disksize:=int64(total)*secs*bytes
+ else
+ disksize:=-1;
+ end;
+end;
+
+
+Function GetCurrentDir : String;
+begin
+ GetDir(0, result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ ChDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+ {$I-}
+ MkDir(NewDir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+ {$I-}
+ RmDir(Dir);
+ {$I+}
+ result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+ Time Functions
+****************************************************************************}
+
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+Var
+ Syst : Windows.TSystemtime;
+begin
+ windows.Getlocaltime(@syst);
+ SystemTime.year:=syst.wYear;
+ SystemTime.month:=syst.wMonth;
+ SystemTime.day:=syst.wDay;
+ SystemTime.hour:=syst.wHour;
+ SystemTime.minute:=syst.wMinute;
+ SystemTime.second:=syst.wSecond;
+ SystemTime.millisecond:=syst.wMilliSeconds;
+end;
+
+
+{****************************************************************************
+ Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+ MessageBeep(0);
+end;
+
+
+{****************************************************************************
+ Locale Functions
+****************************************************************************}
+
+Procedure InitAnsi;
+Var
+ i : longint;
+begin
+ { Fill table entries 0 to 127 }
+ for i := 0 to 96 do
+ UpperCaseTable[i] := chr(i);
+ for i := 97 to 122 do
+ UpperCaseTable[i] := chr(i - 32);
+ for i := 123 to 191 do
+ UpperCaseTable[i] := chr(i);
+ Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+ for i := 0 to 64 do
+ LowerCaseTable[i] := chr(i);
+ for i := 65 to 90 do
+ LowerCaseTable[i] := chr(i + 32);
+ for i := 91 to 191 do
+ LowerCaseTable[i] := chr(i);
+ Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
+var
+ L: Integer;
+ Buf: array[0..255] of Char;
+begin
+ L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf));
+ if L > 0 then
+ SetString(Result, @Buf[0], L - 1)
+ else
+ Result := Def;
+end;
+
+
+function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
+var
+ Buf: array[0..1] of Char;
+begin
+ if GetLocaleInfo(LID, LT, Buf, 2) > 0 then
+ Result := Buf[0]
+ else
+ Result := Def;
+end;
+
+
+Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
+Var
+ S: String;
+ C: Integer;
+Begin
+ S:=GetLocaleStr(LID,TP,'0');
+ Val(S,Result,C);
+ If C<>0 Then
+ Result:=Def;
+End;
+
+
+procedure GetFormatSettings;
+var
+ HF : Shortstring;
+ LID : LCID;
+ I,Day,DateOrder : longint;
+begin
+ LID := GetThreadLocale;
+ { Date stuff }
+ for I := 1 to 12 do
+ begin
+ ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
+ LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
+ end;
+ for I := 1 to 7 do
+ begin
+ Day := (I + 5) mod 7;
+ ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
+ LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
+ end;
+ DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
+ DateOrder := GetLocaleInt(LID, LOCALE_IDate, 0);
+ Case DateOrder Of
+ 1: Begin
+ ShortDateFormat := 'dd/mm/yyyy';
+ LongDateFormat := 'dddd, d. mmmm yyyy';
+ End;
+ 2: Begin
+ ShortDateFormat := 'yyyy/mm/dd';
+ LongDateFormat := 'dddd, yyyy mmmm d.';
+ End;
+ else
+ // Default american settings...
+ ShortDateFormat := 'mm/dd/yyyy';
+ LongDateFormat := 'dddd, mmmm d. yyyy';
+ End;
+ { Time stuff }
+ TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
+ TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
+ TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
+ if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
+ HF:='h'
+ else
+ HF:='hh';
+ // No support for 12 hour stuff at the moment...
+ ShortTimeFormat := HF+':nn';
+ LongTimeFormat := HF + ':nn:ss';
+ { Currency stuff }
+ CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
+ CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
+ NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
+ { Number stuff }
+ ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
+ DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
+ CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
+end;
+
+
+Procedure InitInternational;
+var
+ { A call to GetSystemMetrics changes the value of the 8087 Control Word on
+ Pentium4 with WinXP SP2 }
+ old8087CW: word;
+begin
+ InitInternationalGeneric;
+ old8087CW:=Get8087CW;
+ SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
+ SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
+ Set8087CW(old8087CW);
+ InitAnsi;
+ GetFormatSettings;
+end;
+
+
+{****************************************************************************
+ Target Dependent
+****************************************************************************}
+
+function FormatMessageA(dwFlags : DWORD;
+ lpSource : Pointer;
+ dwMessageId : DWORD;
+ dwLanguageId: DWORD;
+ lpBuffer : PCHAR;
+ nSize : DWORD;
+ Arguments : Pointer): DWORD; stdcall;external 'kernel32' name 'FormatMessageA';
+
+function SysErrorMessage(ErrorCode: Integer): String;
+const
+ MaxMsgSize = Format_Message_Max_Width_Mask;
+var
+ MsgBuffer: pChar;
+begin
+ GetMem(MsgBuffer, MaxMsgSize);
+ FillChar(MsgBuffer^, MaxMsgSize, #0);
+ FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
+ nil,
+ ErrorCode,
+ MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
+ MsgBuffer, { This function allocs the memory }
+ MaxMsgSize, { Maximum message size }
+ nil);
+ SysErrorMessage := StrPas(MsgBuffer);
+ FreeMem(MsgBuffer, MaxMsgSize);
+end;
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+var
+ s : string;
+ i : longint;
+ hp,p : pchar;
+begin
+ Result:='';
+ p:=GetEnvironmentStrings;
+ hp:=p;
+ while hp^<>#0 do
+ begin
+ s:=strpas(hp);
+ i:=pos('=',s);
+ if uppercase(copy(s,1,i-1))=upcase(envvar) then
+ begin
+ Result:=copy(s,i+1,length(s)-i);
+ break;
+ end;
+ { next string entry}
+ hp:=hp+strlen(hp)+1;
+ end;
+ FreeEnvironmentStrings(p);
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+var
+ hp,p : pchar;
+begin
+ Result:=0;
+ p:=GetEnvironmentStrings;
+ hp:=p;
+ If (Hp<>Nil) then
+ while hp^<>#0 do
+ begin
+ Inc(Result);
+ hp:=hp+strlen(hp)+1;
+ end;
+ FreeEnvironmentStrings(p);
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+var
+ hp,p : pchar;
+begin
+ Result:='';
+ p:=GetEnvironmentStrings;
+ hp:=p;
+ If (Hp<>Nil) then
+ begin
+ while (hp^<>#0) and (Index>1) do
+ begin
+ Dec(Index);
+ hp:=hp+strlen(hp)+1;
+ end;
+ If (hp^<>#0) then
+ Result:=StrPas(HP);
+ end;
+ FreeEnvironmentStrings(p);
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+var
+ SI: TStartupInfo;
+ PI: TProcessInformation;
+ Proc : TWin32Handle;
+ l : DWord;
+ CommandLine : ansistring;
+ e : EOSError;
+
+begin
+ DosError := 0;
+ FillChar(SI, SizeOf(SI), 0);
+ SI.cb:=SizeOf(SI);
+ SI.wShowWindow:=1;
+ { always surround the name of the application by quotes
+ so that long filenames will always be accepted. But don't
+ do it if there are already double quotes, since Win32 does not
+ like double quotes which are duplicated!
+ }
+ if pos('"',path)=0 then
+ CommandLine:='"'+path+'"'
+ else
+ CommandLine:=path;
+ if ComLine <> '' then
+ CommandLine:=Commandline+' '+ComLine+#0
+ else
+ CommandLine := CommandLine + #0;
+
+ if not CreateProcess(nil, pchar(CommandLine),
+ Nil, Nil, ExecInheritsHandles,$20, Nil, Nil, SI, PI) then
+ begin
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
+ e.ErrorCode:=GetLastError;
+ raise e;
+ end;
+ Proc:=PI.hProcess;
+ CloseHandle(PI.hThread);
+ if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
+ begin
+ GetExitCodeProcess(Proc,l);
+ CloseHandle(Proc);
+ result:=l;
+ end
+ else
+ begin
+ e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,GetLastError]);
+ e.ErrorCode:=GetLastError;
+ CloseHandle(Proc);
+ raise e;
+ end;
+end;
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
+
+Var
+ CommandLine : AnsiString;
+ i : Integer;
+
+Begin
+ Commandline:='';
+ For i:=0 to high(ComLine) Do
+ Commandline:=CommandLine+' '+Comline[i];
+ ExecuteProcess:=ExecuteProcess(Path,CommandLine);
+End;
+
+Procedure Sleep(Milliseconds : Cardinal);
+
+begin
+ Windows.Sleep(MilliSeconds)
+end;
+
+Function GetLastOSError : Integer;
+
+begin
+ Result:=GetLastError;
+end;
+
+{****************************************************************************
+ Initialization code
+****************************************************************************}
+
+var
+ kernel32dll : THandle;
+
+Procedure LoadVersionInfo;
+// and getfreespaceex
+Var
+ versioninfo : TOSVERSIONINFO;
+ i : Integer;
+
+begin
+ kernel32dll:=0;
+ GetDiskFreeSpaceEx:=nil;
+ versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
+ GetVersionEx(versioninfo);
+ Win32Platform:=versionInfo.dwPlatformId;
+ Win32MajorVersion:=versionInfo.dwMajorVersion;
+ Win32MinorVersion:=versionInfo.dwMinorVersion;
+ Win32BuildNumber:=versionInfo.dwBuildNumber;
+ Move (versioninfo.szCSDVersion ,Win32CSDVersion[1],128);
+ win32CSDVersion[0]:=chr(strlen(pchar(@versioninfo.szCSDVersion)));
+ if ((versioninfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
+ (versioninfo.dwBuildNUmber>=1000)) or
+ (versioninfo.dwPlatformId=VER_PLATFORM_WIN32_NT) then
+ begin
+ kernel32dll:=LoadLibrary('kernel32');
+ if kernel32dll<>0 then
+ {$IFDEF VIRTUALPASCAL}
+ @GetDiskFreeSpaceEx:=GetProcAddress(0,'GetDiskFreeSpaceExA');
+ {$ELSE}
+ GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
+ {$ENDIF}
+ end;
+end;
+
+
+function FreeLibrary(hLibModule : THANDLE) : longbool;
+ stdcall;external 'kernel32' name 'FreeLibrary';
+function GetVersionEx(var VersionInformation:TOSVERSIONINFO) : longbool;
+ stdcall;external 'kernel32' name 'GetVersionExA';
+function LoadLibrary(lpLibFileName : pchar):THandle;
+ stdcall;external 'kernel32' name 'LoadLibraryA';
+function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
+ stdcall;external 'kernel32' name 'GetProcAddress';
+
+Const
+ CSIDL_PROGRAMS = $0002; { %SYSTEMDRIVE%\Program Files }
+ CSIDL_PERSONAL = $0005; { %USERPROFILE%\My Documents }
+ CSIDL_FAVORITES = $0006; { %USERPROFILE%\Favorites }
+ CSIDL_STARTUP = $0007; { %USERPROFILE%\Start menu\Programs\Startup }
+ CSIDL_RECENT = $0008; { %USERPROFILE%\Recent }
+ CSIDL_SENDTO = $0009; { %USERPROFILE%\Sendto }
+ CSIDL_STARTMENU = $000B; { %USERPROFILE%\Start menu }
+ CSIDL_MYMUSIC = $000D; { %USERPROFILE%\Documents\My Music }
+ CSIDL_MYVIDEO = $000E; { %USERPROFILE%\Documents\My Videos }
+ CSIDL_DESKTOPDIRECTORY = $0010; { %USERPROFILE%\Desktop }
+ CSIDL_NETHOOD = $0013; { %USERPROFILE%\NetHood }
+ CSIDL_TEMPLATES = $0015; { %USERPROFILE%\Templates }
+ CSIDL_COMMON_STARTMENU = $0016; { %PROFILEPATH%\All users\Start menu }
+ CSIDL_COMMON_PROGRAMS = $0017; { %PROFILEPATH%\All users\Start menu\Programs }
+ CSIDL_COMMON_STARTUP = $0018; { %PROFILEPATH%\All users\Start menu\Programs\Startup }
+ CSIDL_COMMON_DESKTOPDIRECTORY = $0019; { %PROFILEPATH%\All users\Desktop }
+ CSIDL_APPDATA = $001A; { %USERPROFILE%\Application Data (roaming) }
+ CSIDL_PRINTHOOD = $001B; { %USERPROFILE%\Printhood }
+ CSIDL_LOCAL_APPDATA = $001C; { %USERPROFILE%\Local Settings\Application Data (non roaming) }
+ CSIDL_COMMON_FAVORITES = $001F; { %PROFILEPATH%\All users\Favorites }
+ CSIDL_INTERNET_CACHE = $0020; { %USERPROFILE%\Local Settings\Temporary Internet Files }
+ CSIDL_COOKIES = $0021; { %USERPROFILE%\Cookies }
+ CSIDL_HISTORY = $0022; { %USERPROFILE%\Local settings\History }
+ CSIDL_COMMON_APPDATA = $0023; { %PROFILESPATH%\All Users\Application Data }
+ CSIDL_WINDOWS = $0024; { %SYSTEMROOT% }
+ CSIDL_SYSTEM = $0025; { %SYSTEMROOT%\SYSTEM32 (may be system on 95/98/ME) }
+ CSIDL_PROGRAM_FILES = $0026; { %SYSTEMDRIVE%\Program Files }
+ CSIDL_MYPICTURES = $0027; { %USERPROFILE%\My Documents\My Pictures }
+ CSIDL_PROFILE = $0028; { %USERPROFILE% }
+ CSIDL_PROGRAM_FILES_COMMON = $002B; { %SYSTEMDRIVE%\Program Files\Common }
+ CSIDL_COMMON_TEMPLATES = $002D; { %PROFILEPATH%\All Users\Templates }
+ CSIDL_COMMON_DOCUMENTS = $002E; { %PROFILEPATH%\All Users\Documents }
+ CSIDL_COMMON_ADMINTOOLS = $002F; { %PROFILEPATH%\All Users\Start Menu\Programs\Administrative Tools }
+ CSIDL_ADMINTOOLS = $0030; { %USERPROFILE%\Start Menu\Programs\Administrative Tools }
+ CSIDL_COMMON_MUSIC = $0035; { %PROFILEPATH%\All Users\Documents\my music }
+ CSIDL_COMMON_PICTURES = $0036; { %PROFILEPATH%\All Users\Documents\my pictures }
+ CSIDL_COMMON_VIDEO = $0037; { %PROFILEPATH%\All Users\Documents\my videos }
+ CSIDL_CDBURN_AREA = $003B; { %USERPROFILE%\Local Settings\Application Data\Microsoft\CD Burning }
+ CSIDL_PROFILES = $003E; { %PROFILEPATH% }
+
+ CSIDL_FLAG_CREATE = $8000; { (force creation of requested folder if it doesn't exist yet) }
+
+
+Type
+ PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall;
+
+
+{$ifdef VER1_0}
+Const
+{$else}
+var
+{$endif}
+ SHGetFolderPath : PFNSHGetFolderPath = Nil;
+ CFGDLLHandle : THandle = 0;
+
+Procedure InitDLL;
+
+Var
+ P : Pointer;
+
+begin
+ CFGDLLHandle:=LoadLibrary('shell32.dll');
+ if (CFGDLLHandle<>0) then
+ begin
+ P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+ If (P=Nil) then
+ begin
+ FreeLibrary(CFGDLLHandle);
+ CFGDllHandle:=0;
+ end
+ else
+ SHGetFolderPath:=PFNSHGetFolderPath(P);
+ end;
+ If (P=Nil) then
+ begin
+ CFGDLLHandle:=LoadLibrary('shfolder.dll');
+ if (CFGDLLHandle<>0) then
+ begin
+ P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+ If (P=Nil) then
+ begin
+ FreeLibrary(CFGDLLHandle);
+ CFGDllHandle:=0;
+ end
+ else
+ ShGetFolderPath:=PFNSHGetFolderPath(P);
+ end;
+ end;
+ If (@ShGetFolderPath=Nil) then
+ Raise Exception.Create('Could not determine SHGetFolderPath Function');
+end;
+
+Function GetSpecialDir(ID : Integer) : String;
+
+Var
+ APath : Array[0..MAX_PATH] of char;
+
+begin
+ Result:='';
+ if (CFGDLLHandle=0) then
+ InitDLL;
+ If (SHGetFolderPath<>Nil) then
+ begin
+ if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then
+ Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0]));
+ end;
+end;
+
+Function GetAppConfigDir(Global : Boolean) : String;
+
+begin
+ If Global then
+ Result:=DGetAppConfigDir(Global) // or use windows dir ??
+ else
+ begin
+ Result:=GetSpecialDir(CSIDL_LOCAL_APPDATA)+ApplicationName;
+ If (Result='') then
+ Result:=DGetAppConfigDir(Global);
+ end;
+end;
+
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+ if Global then
+ begin
+ Result:=IncludeTrailingPathDelimiter(DGetAppConfigDir(Global));
+ if SubDir then
+ Result:=IncludeTrailingPathDelimiter(Result+'Config');
+ Result:=Result+ApplicationName+ConfigExtension;
+ end
+ else
+ begin
+ Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
+ if SubDir then
+ Result:=Result+'Config\';
+ Result:=Result+ApplicationName+ConfigExtension;
+ end;
+end;
+
+Procedure InitSysConfigDir;
+
+begin
+ SetLength(SysConfigDir, MAX_PATH);
+ SetLength(SysConfigDir, GetWindowsDirectory(PChar(SysConfigDir), MAX_PATH));
+end;
+
+{****************************************************************************
+ Target Dependent WideString stuff
+****************************************************************************}
+
+{$ifdef HASWIDESTRING}
+
+function Win32CompareWideString(const s1, s2 : WideString) : PtrInt;
+ begin
+ SetLastError(0);
+ Result:=CompareStringW(LOCALE_USER_DEFAULT,0,pwidechar(s1),
+ length(s1),pwidechar(s2),length(s2))-2;
+ if GetLastError<>0 then
+ RaiseLastOSError;
+ end;
+
+
+function Win32CompareTextWideString(const s1, s2 : WideString) : PtrInt;
+ begin
+ SetLastError(0);
+ Result:=CompareStringW(LOCALE_USER_DEFAULT,NORM_IGNORECASE,pwidechar(s1),
+ length(s1),pwidechar(s2),length(s2))-2;
+ if GetLastError<>0 then
+ RaiseLastOSError;
+ end;
+
+
+function Win32AnsiUpperCase(const s: string): string;
+ begin
+ if length(s)>0 then
+ begin
+ result:=s;
+ UniqueString(result);
+ CharUpperBuff(pchar(result),length(result));
+ end
+ else
+ result:='';
+ end;
+
+
+function Win32AnsiLowerCase(const s: string): string;
+ begin
+ if length(s)>0 then
+ begin
+ result:=s;
+ UniqueString(result);
+ CharLowerBuff(pchar(result),length(result));
+ end
+ else
+ result:='';
+ end;
+
+
+function Win32AnsiCompareStr(const S1, S2: string): PtrInt;
+ begin
+ result:=CompareString(LOCALE_USER_DEFAULT,0,pchar(s1),length(s1),
+ pchar(s2),length(s2))-2;
+ end;
+
+
+function Win32AnsiCompareText(const S1, S2: string): PtrInt;
+ begin
+ result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,pchar(s1),length(s1),
+ pchar(s2),length(s2))-2;
+ end;
+
+
+function Win32AnsiStrComp(S1, S2: PChar): PtrInt;
+ begin
+ result:=CompareString(LOCALE_USER_DEFAULT,0,s1,-1,s2,-1)-2;
+ end;
+
+
+function Win32AnsiStrIComp(S1, S2: PChar): PtrInt;
+ begin
+ result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,s1,-1,s2,-1)-2;
+ end;
+
+
+function Win32AnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+ begin
+ result:=CompareString(LOCALE_USER_DEFAULT,0,s1,maxlen,s2,maxlen)-2;
+ end;
+
+
+function Win32AnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+ begin
+ result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,s1,maxlen,s2,maxlen)-2;
+ end;
+
+
+function Win32AnsiStrLower(Str: PChar): PChar;
+ begin
+ CharLower(str);
+ result:=str;
+ end;
+
+
+function Win32AnsiStrUpper(Str: PChar): PChar;
+ begin
+ CharUpper(str);
+ result:=str;
+ end;
+
+
+{ there is a similiar procedure in the system unit which inits the fields which
+ are relevant already for the system unit }
+procedure InitWin32Widestrings;
+ begin
+ widestringmanager.CompareWideStringProc:=@Win32CompareWideString;
+ widestringmanager.CompareTextWideStringProc:=@Win32CompareTextWideString;
+ end;
+
+{$endif HASWIDESTRING}
+
+
+Initialization
+{$ifdef HASWIDESTRING}
+ InitWin32Widestrings;
+{$endif HASWIDESTRING}
+ InitExceptions; { Initialize exceptions. OS independent }
+ InitInternational; { Initialize internationalization settings }
+ LoadVersionInfo;
+ InitSysConfigDir;
+
+Finalization
+ DoneExceptions;
+ if kernel32dll<>0 then
+ FreeLibrary(kernel32dll);
+ if CFGDLLHandle<>0 then
+ FreeLibrary(CFGDllHandle);
+end.
+{
+ $Log: sysutils.pp,v $
+ Revision 1.45 2005/03/12 14:56:22 florian
+ + added Ansi* routines to widestring manager
+ * made them using OS calls on windows
+
+ Revision 1.44 2005/03/10 19:12:28 florian
+ * applied fix from Vincent to fix make cyle crash on P4 with WinXP SP2
+
+ Revision 1.43 2005/03/02 21:10:08 florian
+ * fixed compilation with 1.0.10
+
+ Revision 1.42 2005/02/26 20:43:52 florian
+ + WideCompareString and WideCompareText for win32 implemented
+
+ Revision 1.41 2005/02/26 14:38:14 florian
+ + SysLocale
+
+ Revision 1.40 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/syswin32.pp b/rtl/win32/syswin32.pp
new file mode 100644
index 0000000000..4d342eaddd
--- /dev/null
+++ b/rtl/win32/syswin32.pp
@@ -0,0 +1 @@
+{$i system.pp}
diff --git a/rtl/win32/tthread.inc b/rtl/win32/tthread.inc
new file mode 100644
index 0000000000..1f9ca18cb6
--- /dev/null
+++ b/rtl/win32/tthread.inc
@@ -0,0 +1,230 @@
+{ Thread management routines }
+
+const
+ CM_EXECPROC = $8FFF;
+ CM_DESTROYWINDOW = $8FFE;
+
+type
+ PRaiseFrame = ^TRaiseFrame;
+ TRaiseFrame = record
+ NextRaise: PRaiseFrame;
+ ExceptAddr: Pointer;
+ ExceptObject: TObject;
+ ExceptionRecord: pointer; {PExceptionRecord}
+ end;
+
+var
+ ThreadWindow: HWND;
+ ThreadCount: Integer;
+ { event that happens when gui thread is done executing the method
+}
+
+function ThreadWndProc(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
+
+begin
+ case AMessage of
+ CM_EXECPROC:
+ with TThread(lParam) do
+ begin
+ Result := 0;
+ try
+ FSynchronizeException := nil;
+ FMethod;
+ except
+{ if RaiseList <> nil then
+ begin
+ FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
+ PRaiseFrame(RaiseList)^.ExceptObject := nil;
+ end; }
+ end;
+ end;
+ CM_DESTROYWINDOW:
+ begin
+ DestroyWindow(Window);
+ Result := 0;
+ end;
+ else
+ Result := DefWindowProc(Window, AMessage, wParam, lParam);
+ end;
+end;
+
+const
+ ThreadWindowClass: TWndClass = (
+ style: 0;
+ lpfnWndProc: nil;
+ cbClsExtra: 0;
+ cbWndExtra: 0;
+ hInstance: 0;
+ hIcon: 0;
+ hCursor: 0;
+ hbrBackground: 0;
+ lpszMenuName: nil;
+ lpszClassName: 'TThreadWindow');
+
+procedure AddThread;
+
+ function AllocateWindow: HWND;
+ var
+ TempClass: TWndClass;
+ ClassRegistered: Boolean;
+ begin
+ ThreadWindowClass.hInstance := HInstance;
+ ThreadWindowClass.lpfnWndProc:=WndProc(@ThreadWndProc);
+ ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
+ @TempClass);
+ if not ClassRegistered or (TempClass.lpfnWndProc <> WndProc(@ThreadWndProc)) then
+ begin
+ if ClassRegistered then
+ Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
+ Windows.RegisterClass(ThreadWindowClass);
+ end;
+ Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
+ 0, 0, 0, 0, 0, 0, HInstance, nil);
+ end;
+
+begin
+ if ThreadCount = 0 then
+ ThreadWindow := AllocateWindow;
+ Inc(ThreadCount);
+end;
+
+procedure RemoveThread;
+begin
+ Dec(ThreadCount);
+ if ThreadCount = 0 then
+ PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0);
+end;
+
+{ TThread }
+
+function ThreadProc(ThreadObjPtr: Pointer): Integer;
+var
+ FreeThread: Boolean;
+ Thread: TThread absolute ThreadObjPtr;
+begin
+ try
+ Thread.Execute;
+ except
+ Thread.FFatalException := TObject(AcquireExceptionObject);
+ end;
+ FreeThread := Thread.FFreeOnTerminate;
+ Result := Thread.FReturnValue;
+ Thread.FFinished := True;
+ Thread.DoTerminate;
+ if FreeThread then Thread.Free;
+end;
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+ Flags: Integer;
+begin
+ inherited Create;
+ AddThread;
+ FSuspended := CreateSuspended;
+ Flags := 0;
+ if CreateSuspended then Flags := CREATE_SUSPENDED;
+ FHandle := BeginThread(nil, 0, @ThreadProc, pointer(self), Flags, FThreadID);
+ FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+ if not FFinished and not Suspended then
+ begin
+ Terminate;
+ WaitFor;
+ end;
+ if FHandle <> 0 then CloseHandle(FHandle);
+ FFatalException.Free;
+ FFatalException := nil;
+ inherited Destroy;
+ RemoveThread;
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+ FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+ if Assigned(FOnTerminate) then
+ Synchronize(@CallOnTerminate);
+end;
+
+const
+ Priorities: array [TThreadPriority] of Integer =
+ (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
+ THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
+ THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
+
+function TThread.GetPriority: TThreadPriority;
+var
+ P: Integer;
+ I: TThreadPriority;
+begin
+ P := GetThreadPriority(FHandle);
+ Result := tpNormal;
+ for I := Low(TThreadPriority) to High(TThreadPriority) do
+ if Priorities[I] = P then Result := I;
+end;
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+ SetThreadPriority(FHandle, Priorities[Value]);
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+ if Value <> FSuspended then
+ if Value then
+ Suspend else
+ Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+ FSuspended := True;
+ SuspendThread(FHandle);
+end;
+
+procedure TThread.Resume;
+begin
+ if ResumeThread(FHandle) = 1 then FSuspended := False;
+end;
+
+procedure TThread.Terminate;
+begin
+ FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+ Msg: TMsg;
+begin
+ if GetCurrentThreadID = MainThreadID then
+ while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
+ PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
+ else
+ WaitForSingleObject(ulong(FHandle), INFINITE);
+ GetExitCodeThread(FHandle, DWord(Result));
+end;
+{
+ $Log: tthread.inc,v $
+ Revision 1.8 2005/02/25 21:52:07 florian
+ * "transfer to linux"-commit
+
+ Revision 1.7 2005/02/25 21:41:09 florian
+ * generic tthread.synchronize
+ * delphi compatible wakemainthread
+
+ Revision 1.6 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.5 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/win32/varutils.pp b/rtl/win32/varutils.pp
new file mode 100644
index 0000000000..218e76fce0
--- /dev/null
+++ b/rtl/win32/varutils.pp
@@ -0,0 +1,82 @@
+{
+ $Id: varutils.pp,v 1.6 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Interface and OS-dependent part of variant support
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+{$ifndef NO_SMART_LINK}
+{$smartlink on}
+{$endif}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+{$i varutilh.inc}
+
+Implementation
+
+{$i cvarutil.inc}
+
+{ ---------------------------------------------------------------------
+ Windows external definitions.
+ ---------------------------------------------------------------------}
+
+{$ifdef HASVARIANT}
+const
+ oleaut = 'oleaut32.dll';
+
+{ Variant functions }
+
+function VariantChangeTypeEx(var VargDest: TVarData; const VargSrc: TVarData; LCID: Integer; Flags: Word; VarType: Word): HRESULT; stdcall;external oleaut;
+function VariantClear(var Varg: TVarData): HRESULT; stdcall;external oleaut;
+function VariantCopy(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;external oleaut;
+function VariantCopyInd(var VargDest: TVarData; const VargSrc: TVarData): HRESULT; stdcall;external oleaut;
+function VariantInit(var Varg: TVarData): HRESULT; stdcall;external oleaut;
+
+{ Variant array functions }
+
+function SafeArrayAccessData(psa: PVarArray; var ppvData: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayCopy(psa: PVarArray; var psaOut: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayCopyData(psa, psaOut: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayCreate(VarType, Dim: Integer; const Bounds: TVarArrayBoundArray): PVarArray; stdcall;external oleaut;
+function SafeArrayDestroy(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayDestroyData(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayDestroyDescriptor(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayGetDim(psa: PVarArray): Integer; stdcall;external oleaut;
+function SafeArrayGetElemsize(psa: PVarArray): LongWord; stdcall;external oleaut;
+function SafeArrayGetElement(psa: PVarArray; Indices: PVarArrayCoorArray; Data: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayGetLBound(psa: PVarArray; Dim: Integer; var LBound: Integer): HRESULT; stdcall;external oleaut;
+function SafeArrayGetUBound(psa: PVarArray; Dim: Integer; var UBound: Integer): HRESULT; stdcall;external oleaut;
+function SafeArrayLock(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayPtrOfIndex(psa: PVarArray; Indices: PVarArrayCoorArray; var Address: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayPutElement(psa: PVarArray; Indices: PVarArrayCoorArray; const Data: Pointer): HRESULT; stdcall;external oleaut;
+function SafeArrayRedim(psa: PVarArray; const NewBound: TVarArrayBound): HRESULT; stdcall;external oleaut;
+function SafeArrayUnaccessData(psa: PVarArray): HRESULT; stdcall;external oleaut;
+function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;external oleaut;
+{$endif HASVARIANT}
+
+end.
+
+{
+ $Log: varutils.pp,v $
+ Revision 1.6 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/video.pp b/rtl/win32/video.pp
new file mode 100644
index 0000000000..3b52c958cc
--- /dev/null
+++ b/rtl/win32/video.pp
@@ -0,0 +1,456 @@
+{
+ $Id: video.pp,v 1.17 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Video unit for Win32
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+interface
+
+{$i videoh.inc}
+
+implementation
+
+uses
+ windows,dos;
+
+{$i video.inc}
+
+const
+ LastCursorType: word = crUnderline;
+ OrigScreen: PVideoBuf = nil;
+ OrigScreenSize: cardinal = 0;
+
+
+var ConsoleInfo : TConsoleScreenBufferInfo;
+ ConsoleCursorInfo : TConsoleCursorInfo;
+
+ OrigCP: cardinal;
+ OrigConsoleCursorInfo : TConsoleCursorInfo;
+ OrigConsoleInfo : TConsoleScreenBufferInfo;
+
+procedure SysInitVideo;
+
+begin
+ ScreenColor:=true;
+ GetConsoleScreenBufferInfo(TextRec(Output).Handle, OrigConsoleInfo);
+ GetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
+ OrigCP := GetConsoleCP;
+ ConsoleInfo:=OrigConsoleInfo;
+ ConsoleCursorInfo:=OrigConsoleCursorInfo;
+ {
+ About the ConsoleCursorInfo record: There are 3 possible
+ structures in it that can be regarded as the 'screen':
+ - dwsize : contains the cols & row in current screen buffer.
+ - srwindow : Coordinates (relative to buffer) of upper left
+ & lower right corners of visible console.
+ - dmMaximumWindowSize : Maximal size of Screen buffer.
+ The first implementation of video used srWindow. After some
+ bug-reports, this was switched to dwMaximumWindowSize.
+ }
+ with ConsoleInfo.dwMaximumWindowSize do
+ begin
+ ScreenWidth:=X;
+ ScreenHeight:=Y;
+ end;
+ { TDrawBuffer only has FVMaxWidth elements
+ larger values lead to crashes }
+ if ScreenWidth> FVMaxWidth then
+ ScreenWidth:=FVMaxWidth;
+ CursorX:=ConsoleInfo.dwCursorPosition.x;
+ CursorY:=ConsoleInfo.dwCursorPosition.y;
+ if not ConsoleCursorInfo.bvisible then
+ CursorLines:=0
+ else
+ CursorLines:=ConsoleCursorInfo.dwSize;
+end;
+
+
+procedure SysDoneVideo;
+begin
+ SetConsoleScreenBufferSize (TextRec (Output).Handle, OrigConsoleInfo.dwSize);
+ SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, OrigConsoleInfo.srWindow);
+ SetCursorType(crUnderLine);
+ SetConsoleCP(OrigCP);
+end;
+
+
+function SysGetCapabilities: Word;
+begin
+ SysGetCapabilities:=cpColor or cpChangeCursor;
+end;
+
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+var
+ pos : COORD;
+begin
+ pos.x:=NewCursorX;
+ pos.y:=NewCursorY;
+ SetConsoleCursorPosition(TextRec(Output).Handle,pos);
+ CursorX:=pos.x;
+ CursorY:=pos.y;
+end;
+
+
+function SysGetCursorType: Word;
+begin
+ GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
+ if not ConsoleCursorInfo.bvisible then
+ SysGetCursorType:=crHidden
+ else
+ case ConsoleCursorInfo.dwSize of
+ 1..30:
+ SysGetCursorType:=crUnderline;
+ 31..70:
+ SysGetCursorType:=crHalfBlock;
+ 71..100:
+ SysGetCursorType:=crBlock;
+ end;
+end;
+
+
+procedure SysSetCursorType(NewType: Word);
+begin
+ GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
+ if newType=crHidden then
+ ConsoleCursorInfo.bvisible:=false
+ else
+ begin
+ ConsoleCursorInfo.bvisible:=true;
+ case NewType of
+ crUnderline:
+ ConsoleCursorInfo.dwSize:=10;
+
+ crHalfBlock:
+ ConsoleCursorInfo.dwSize:=50;
+
+ crBlock:
+ ConsoleCursorInfo.dwSize:=99;
+ end
+ end;
+ SetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
+end;
+
+function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;
+
+var MI: Console_Screen_Buffer_Info;
+ C: Coord;
+ SR: Small_Rect;
+
+begin
+ if not (GetConsoleScreenBufferInfo (TextRec (Output).Handle, MI)) then
+ SysVideoModeSelector := false
+ else
+ begin
+ with MI do
+ begin
+ C.X := VideoMode.Col;
+ C.Y := VideoMode.Row;
+ end;
+ with SR do
+ begin
+ Top := 0;
+ Left := 0;
+(* First, we need to make sure we reach the minimum window size *)
+(* to always fit in the new buffer after changing buffer size. *)
+ Right := MI.srWindow.Right - MI.srWindow.Left;
+ if VideoMode.Col <= Right then
+ Right := Pred (VideoMode.Col);
+ Bottom := MI.srWindow.Bottom - MI.srWindow.Top;
+ if VideoMode.Row <= Bottom then
+ Bottom := Pred (VideoMode.Row);
+ end;
+ if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
+ if SetConsoleScreenBufferSize (TextRec (Output).Handle, C) then
+ begin
+ with SR do
+ begin
+(* Now, we can resize the window to the final size. *)
+ Right := Pred (VideoMode.Col);
+ Bottom := Pred (VideoMode.Row);
+ end;
+ if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
+ begin
+ SysVideoModeSelector := true;
+ SetCursorType (LastCursorType);
+ ClearScreen;
+ end
+ else
+ begin
+ SysVideoModeSelector := false;
+ SetConsoleScreenBufferSize (TextRec (Output).Handle, MI.dwSize);
+ SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
+ SetCursorType (LastCursorType);
+ end
+ end
+ else
+ begin
+ SysVideoModeSelector := false;
+ SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
+ SetCursorType (LastCursorType);
+ end
+ else
+ SysVideoModeSelector := false;
+ end;
+end;
+
+Const
+ SysVideoModeCount = 6;
+ SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+ (Col: 40; Row: 25; Color: True),
+ (Col: 80; Row: 25; Color: True),
+ (Col: 80; Row: 30; Color: True),
+ (Col: 80; Row: 43; Color: True),
+ (Col: 80; Row: 50; Color: True),
+ (Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
+ );
+
+
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
+
+Var
+ I : Integer;
+
+begin
+ I:=SysVideoModeCount-1;
+ SysSetVideoMode:=False;
+ While (I>=0) and Not SysSetVideoMode do
+ If (Mode.col=SysVMD[i].col) and
+ (Mode.Row=SysVMD[i].Row) and
+ (Mode.Color=SysVMD[i].Color) then
+ SysSetVideoMode:=True
+ else
+ Dec(I);
+ If SysSetVideoMode then
+ begin
+ if SysVideoModeSelector(Mode) then
+ begin
+ ScreenWidth:=SysVMD[I].Col;
+ ScreenHeight:=SysVMD[I].Row;
+ ScreenColor:=SysVMD[I].Color;
+ end else SysSetVideoMode := false;
+ end;
+end;
+
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+
+begin
+ SysGetVideoModeData:=(Index<=SysVideoModeCount);
+ If SysGetVideoModeData then
+ Data:=SysVMD[Index];
+end;
+
+Function SysGetVideoModeCount : Word;
+
+begin
+ SysGetVideoModeCount:=SysVideoModeCount;
+end;
+
+procedure SysClearScreen;
+begin
+ UpdateScreen(true);
+end;
+
+{$IFDEF FPC}
+function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:pointer; dwBufferSize:COORD; dwBufferCoord:COORD;
+ var lpWriteRegion:SMALL_RECT):WINBOOL; stdcall;external 'kernel32' name 'WriteConsoleOutputA';
+{$ENDIF}
+
+procedure SysUpdateScreen(Force: Boolean);
+type TmpRec = Array[0..(1024*32) - 1] of TCharInfo;
+
+type WordRec = record
+ One, Two: Byte;
+ end; { wordrec }
+
+var
+ BufSize,
+ BufCoord : COORD;
+ WriteRegion : SMALL_RECT;
+ LineBuf : ^TmpRec;
+ BufCounter : Longint;
+ LineCounter,
+ ColCounter : Longint;
+ smallforce : boolean;
+ x1,y1,x2,y2 : longint;
+begin
+ if force then
+ smallforce:=true
+ else
+ begin
+ asm
+ pushl %esi
+ pushl %edi
+ movl VideoBuf,%esi
+ movl OldVideoBuf,%edi
+ movl VideoBufSize,%ecx
+ shrl $2,%ecx
+ repe
+ cmpsl
+ setne smallforce
+ popl %edi
+ popl %esi
+ end;
+ end;
+ if SmallForce then
+ begin
+ BufSize.X := ScreenWidth;
+ BufSize.Y := ScreenHeight;
+
+ BufCoord.X := 0;
+ BufCoord.Y := 0;
+ with WriteRegion do
+ begin
+ Top :=0;
+ Left :=0;
+ Bottom := ScreenHeight-1;
+ Right := ScreenWidth-1;
+ end;
+ New(LineBuf);
+ BufCounter := 0;
+ x1:=ScreenWidth+1;
+ x2:=-1;
+ y1:=ScreenHeight+1;
+ y2:=-1;
+ for LineCounter := 1 to ScreenHeight do
+ begin
+ for ColCounter := 1 to ScreenWidth do
+ begin
+ if (WordRec(VideoBuf^[BufCounter]).One<>WordRec(OldVideoBuf^[BufCounter]).One) or
+ (WordRec(VideoBuf^[BufCounter]).Two<>WordRec(OldVideoBuf^[BufCounter]).Two) then
+ begin
+ if ColCounter<x1 then
+ x1:=ColCounter;
+ if ColCounter>x2 then
+ x2:=ColCounter;
+ if LineCounter<y1 then
+ y1:=LineCounter;
+ if LineCounter>y2 then
+ y2:=LineCounter;
+ end;
+{$ifdef VER1_0}
+ Word(LineBuf^[BufCounter].UniCodeChar) := WordRec(VideoBuf^[BufCounter]).One;
+{$else}
+ LineBuf^[BufCounter].UniCodeChar := Widechar(WordRec(VideoBuf^[BufCounter]).One);
+{$endif}
+ { If (WordRec(VideoBuf^[BufCounter]).Two and $80)<>0 then
+ LineBuf^[BufCounter].Attributes := $100+WordRec(VideoBuf^[BufCounter]).Two
+ else }
+ LineBuf^[BufCounter].Attributes := WordRec(VideoBuf^[BufCounter]).Two;
+
+ Inc(BufCounter);
+ end; { for }
+ end; { for }
+ BufSize.X := ScreenWidth;
+ BufSize.Y := ScreenHeight;
+
+ with WriteRegion do
+ begin
+ if force then
+ begin
+ Top := 0;
+ Left :=0;
+ Bottom := ScreenHeight-1;
+ Right := ScreenWidth-1;
+ BufCoord.X := 0;
+ BufCoord.Y := 0;
+ end
+ else
+ begin
+ Top := y1-1;
+ Left :=x1-1;
+ Bottom := y2-1;
+ Right := x2-1;
+ BufCoord.X := x1-1;
+ BufCoord.Y := y1-1;
+ end;
+ end;
+ {
+ writeln('X1: ',x1);
+ writeln('Y1: ',y1);
+ writeln('X2: ',x2);
+ writeln('Y2: ',y2);
+ }
+ WriteConsoleOutput(TextRec(Output).Handle, LineBuf, BufSize, BufCoord, WriteRegion);
+ Dispose(LineBuf);
+
+ move(VideoBuf^,OldVideoBuf^,VideoBufSize);
+ end;
+end;
+
+Const
+ SysVideoDriver : TVideoDriver = (
+ InitDriver : @SysInitVideo;
+ DoneDriver : @SysDoneVideo;
+ UpdateScreen : @SysUpdateScreen;
+ ClearScreen : @SysClearScreen;
+ SetVideoMode : @SysSetVideoMode;
+ GetVideoModeCount : @SysGetVideoModeCount;
+ GetVideoModeData : @SysGetVideoModeData;
+ SetCursorPos : @SysSetCursorPos;
+ GetCursorType : @SysGetCursorType;
+ SetCursorType : @SysSetCursorType;
+ GetCapabilities : @SysGetCapabilities
+
+ );
+
+procedure TargetEntry;
+var
+ C: Coord;
+ SR: Small_Rect;
+ VioMode: TConsoleScreenBufferInfo;
+begin
+ GetConsoleScreenBufferInfo (TextRec (Output).Handle, VioMode);
+ { Register the curent video mode in reserved slot in System Modes}
+ with VioMode do
+ begin
+ {Assume we have at least 16 colours available in "colour" modes}
+ SysVMD[SysVideoModeCount-1].Col:=dwMaximumWindowSize.X;
+ SysVMD[SysVideoModeCount-1].Row:=dwMaximumWindowSize.Y;
+ SysVMD[SysVideoModeCount-1].Color:=true;
+ OrigScreenSize := dwMaximumWindowSize.X * dwMaximumWindowSize.Y * SizeOf (Char_Info);
+ end;
+ GetMem (OrigScreen, OrigScreenSize);
+ with C do
+ begin
+ X := 0;
+ Y := 0;
+ end;
+ with SR do
+ begin
+ Top := 0;
+ Left := 0;
+ Right := Pred (VioMode.dwSize.X);
+ Bottom := Pred (VioMode.dwSize.Y);
+ end;
+ if not (ReadConsoleOutput (TextRec (Output).Handle, OrigScreen, VioMode.dwSize, C, SR)) then
+ begin
+ FreeMem (OrigScreen, OrigScreenSize);
+ OrigScreen := nil;
+ OrigScreenSize := 0;
+ end;
+end;
+
+
+initialization
+ SetVideoDriver(SysVideoDriver);
+ TargetEntry;
+end.
+{
+ $Log: video.pp,v $
+ Revision 1.17 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
+
diff --git a/rtl/win32/wcygprt0.as b/rtl/win32/wcygprt0.as
new file mode 100644
index 0000000000..72755379d1
--- /dev/null
+++ b/rtl/win32/wcygprt0.as
@@ -0,0 +1,84 @@
+//Startup code for WIN32 port of Free Pascal
+//Written by P.Ozerski 1998
+// modified by Pierre Muller
+ .text
+ .globl _mainCRTStartup
+_mainCRTStartup:
+ movb $1,U_SYSTEM_ISCONSOLE
+ jmp _start
+
+ .globl _WinMainCRTStartup
+_WinMainCRTStartup:
+ movb $0,U_SYSTEM_ISCONSOLE
+_start:
+ subl $0x8,%esp
+ andl $0xfffffff0,%esp
+ push $_cmain
+ call _cygwin_crt0
+
+ .globl _cmain
+_cmain:
+ subl $0x8,%esp
+ andl $0xfffffff0,%esp
+ call ___main
+ call _FPC_EXE_Entry
+ ret
+
+ .globl asm_exit
+asm_exit:
+ pushl %eax
+ call exitprocess
+
+.text
+.globl exitprocess
+exitprocess:
+ jmp *.L10
+ .balign 4,144
+
+.text
+ .balign 4,144
+
+.section .idata$2
+ .rva .L7
+ .long 0,0
+ .rva .L6
+ .rva .L8
+
+.section .idata$4
+.L7:
+ .rva .L9
+ .long 0
+
+.section .idata$5
+.L8:
+
+
+.section .idata$5
+.L10:
+ .rva .L9
+ .long 0
+
+.section .idata$6
+.L9:
+ .short 0
+ .ascii "ExitProcess\000"
+ .balign 2,0
+
+.section .idata$7
+.L6:
+ .ascii "kernel32.dll\000"
+
+
+
+// $Log: wcygprt0.as,v $
+// Revision 1.1 2004/11/04 17:15:01 peter
+// * wcygprt is now used for cygwin (libc) linking, initc contains only cerrno
+//
+// Revision 1.4 2002/11/30 18:17:35 carl
+// + profiling support
+//
+// Revision 1.3 2002/07/28 20:43:51 florian
+// * several fixes for linux/powerpc
+// * several fixes to MT
+//
+//
diff --git a/rtl/win32/wdllprt0.as b/rtl/win32/wdllprt0.as
new file mode 100644
index 0000000000..9d701891a4
--- /dev/null
+++ b/rtl/win32/wdllprt0.as
@@ -0,0 +1,84 @@
+// DLL Startup code for WIN32 port of Free Pascal
+// Written by P.Ozerski 16.10.1998
+ .text
+ .globl _mainCRTStartup
+_mainCRTStartup:
+ movb $1,U_SYSTEM_ISCONSOLE
+ jmp .LDLL_Entry
+ .globl _WinMainCRTStartup
+_WinMainCRTStartup:
+ movb $0,U_SYSTEM_ISCONSOLE
+.LDLL_Entry:
+ pushl %ebp
+ movl %esp,%ebp
+ pushl %ebx
+ pushl %esi
+ pushl %edi
+ movl 8(%ebp),%edi
+ movl %edi,U_SYSTEM_HINSTANCE
+ movl 12(%ebp),%edi
+ movl %edi,U_SYSTEM_DLLREASON
+ movl 16(%ebp),%edi
+ movl %edi,U_SYSTEM_DLLPARAM
+ call _FPC_DLL_Entry
+ popl %edi
+ popl %esi
+ popl %ebx
+ popl %ebp
+ ret $12
+
+ .globl asm_exit
+asm_exit:
+ pushl %eax
+ call exitprocess
+
+.text
+.globl exitprocess
+exitprocess:
+ jmp *.L10
+ .balign 4,144
+
+.text
+ .balign 4,144
+
+.section .idata$2
+ .rva .L7
+ .long 0,0
+ .rva .L6
+ .rva .L8
+
+.section .idata$4
+.L7:
+ .rva .L9
+ .long 0
+
+.section .idata$5
+.L8:
+
+
+.section .idata$5
+.L10:
+ .rva .L9
+ .long 0
+
+.section .idata$6
+.L9:
+ .short 0
+ .ascii "ExitProcess\000"
+ .balign 2,0
+
+.section .idata$7
+.L6:
+ .ascii "kernel32.dll\000"
+
+
+//
+// $Log: wdllprt0.as,v $
+// Revision 1.4 2002/12/04 21:36:44 carl
+// * libraries would no longer compile because of my profiling fix
+//
+// Revision 1.3 2002/07/28 20:43:51 florian
+// * several fixes for linux/powerpc
+// * several fixes to MT
+//
+//
diff --git a/rtl/win32/win32.inc b/rtl/win32/win32.inc
new file mode 100644
index 0000000000..142bd9379a
--- /dev/null
+++ b/rtl/win32/win32.inc
@@ -0,0 +1,27 @@
+{
+ $Id: win32.inc,v 1.12 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Win32 Types and Constants
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+ $Log: win32.inc,v $
+ Revision 1.12 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.11 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+}
diff --git a/rtl/win32/wincrt.pp b/rtl/win32/wincrt.pp
new file mode 100644
index 0000000000..bcac656b42
--- /dev/null
+++ b/rtl/win32/wincrt.pp
@@ -0,0 +1,231 @@
+{
+ $Id: wincrt.pp,v 1.6 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ This is unit implements some of the crt functionality
+ for the gui win32 graph unit implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit wincrt;
+
+ interface
+
+ function readkey : char;
+ function keypressed : boolean;
+ procedure delay(ms : word);
+
+ { dummy }
+ procedure textmode(mode : integer);
+
+ { plays the windows standard sound }
+ { hz is ignored (at least on win95 }
+ procedure sound(hz : word);
+
+ { dummy }
+ procedure nosound;
+
+
+ var
+ directvideo : boolean;
+
+ { dummy }
+ lastmode : word;
+
+ implementation
+
+ uses
+ windows,graph;
+
+ const
+ keybuffersize = 32;
+
+ var
+ keyboardhandling : TCriticalSection;
+ keybuffer : array[1..keybuffersize] of char;
+ nextfree,nexttoread : longint;
+
+ procedure inccyclic(var i : longint);
+
+ begin
+ inc(i);
+ if i>keybuffersize then
+ i:=1;
+ end;
+
+ procedure addchar(c : char);
+
+ begin
+ EnterCriticalSection(keyboardhandling);
+ keybuffer[nextfree]:=c;
+ inccyclic(nextfree);
+ { skip old chars }
+ if nexttoread=nextfree then
+ begin
+ // special keys are started by #0
+ // so we've to remove two chars
+ if keybuffer[nexttoread]=#0 then
+ inccyclic(nexttoread);
+ inccyclic(nexttoread);
+ end;
+ LeaveCriticalSection(keyboardhandling);
+ end;
+
+ function readkey : char;
+
+ begin
+ while true do
+ begin
+ EnterCriticalSection(keyboardhandling);
+ if nexttoread<>nextfree then
+ begin
+ readkey:=keybuffer[nexttoread];
+ inccyclic(nexttoread);
+ LeaveCriticalSection(keyboardhandling);
+ exit;
+ end;
+ LeaveCriticalSection(keyboardhandling);
+ { give other threads a chance }
+ Windows.Sleep(10);
+ end;
+ end;
+
+ function keypressed : boolean;
+
+ begin
+ EnterCriticalSection(keyboardhandling);
+ keypressed:=nexttoread<>nextfree;
+ LeaveCriticalSection(keyboardhandling);
+ end;
+
+ procedure delay(ms : word);
+
+ begin
+ Sleep(ms);
+ end;
+
+ procedure textmode(mode : integer);
+
+ begin
+ end;
+
+ procedure sound(hz : word);
+
+ begin
+ Windows.Beep(hz,500);
+ end;
+
+ procedure nosound;
+
+ begin
+ end;
+
+ procedure addextchar(c : char);
+
+ begin
+ addchar(#0);
+ addchar(c);
+ end;
+
+ const
+ altkey : boolean = false;
+ ctrlkey : boolean = false;
+ shiftkey : boolean = false;
+
+ function msghandler(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
+
+ begin
+ case amessage of
+ WM_CHAR:
+ begin
+ addchar(chr(wparam));
+ end;
+ WM_KEYDOWN:
+ begin
+ case wparam of
+ VK_LEFT:
+ addextchar(#75);
+ VK_RIGHT:
+ addextchar(#77);
+ VK_DOWN:
+ addextchar(#80);
+ VK_UP:
+ addextchar(#72);
+ VK_INSERT:
+ addextchar(#82);
+ VK_DELETE:
+ addextchar(#83);
+ VK_END:
+ addextchar(#79);
+ VK_HOME:
+ addextchar(#71);
+ VK_PRIOR:
+ addextchar(#73);
+ VK_NEXT:
+ addextchar(#81);
+ VK_F1..VK_F10:
+ begin
+ if ctrlkey then
+ addextchar(chr(wparam+24))
+ else if altkey then
+ addextchar(chr(wparam+34))
+ else
+ addextchar(chr(wparam-11));
+ end;
+ VK_CONTROL:
+ ctrlkey:=true;
+ VK_MENU:
+ altkey:=true;
+ VK_SHIFT:
+ shiftkey:=true;
+ end;
+ end;
+ WM_KEYUP:
+ begin
+ case wparam of
+ VK_CONTROL:
+ ctrlkey:=false;
+ VK_MENU:
+ altkey:=false;
+ VK_SHIFT:
+ shiftkey:=false;
+ end;
+ end;
+ end;
+ msghandler:=0;
+ end;
+
+ var
+ oldexitproc : pointer;
+
+ procedure myexitproc;
+
+ begin
+ exitproc:=oldexitproc;
+ charmessagehandler:=nil;
+ DeleteCriticalSection(keyboardhandling);
+ end;
+
+begin
+ charmessagehandler:=@msghandler;
+ nextfree:=1;
+ nexttoread:=1;
+ InitializeCriticalSection(keyboardhandling);
+ oldexitproc:=exitproc;
+ exitproc:=@myexitproc;
+ lastmode:=0;
+end.
+{
+ $Log: wincrt.pp,v $
+ Revision 1.6 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/windows.pp b/rtl/win32/windows.pp
new file mode 100644
index 0000000000..c36c30ec16
--- /dev/null
+++ b/rtl/win32/windows.pp
@@ -0,0 +1,72 @@
+{
+ $Id: windows.pp,v 1.8 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the record definition for the Win32 API
+ Copyright (c) 1999-2000 by Florian KLaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit windows;
+
+{$ifndef NO_SMART_LINK}
+{$smartlink on}
+{$endif}
+
+{ stuff like array of const is used }
+{$mode objfpc}
+{$calling stdcall}
+
+interface
+
+{$define read_interface}
+{$undef read_implementation}
+
+{$i base.inc}
+{$i errors.inc}
+{$i defines.inc}
+{$i struct.inc}
+{$i messages.inc}
+{$i ascfun.inc}
+{$i unifun.inc}
+{$ifdef UNICODE}
+{$i unidef.inc}
+{$else not UNICODE}
+{$i ascdef.inc}
+{$endif UNICODE}
+{$i func.inc}
+{$i redef.inc}
+
+implementation
+
+{$undef read_interface}
+{$define read_implementation}
+
+{$i base.inc}
+{$i errors.inc}
+{$i defines.inc}
+{$i struct.inc}
+{$i messages.inc}
+{$i ascfun.inc}
+{$i unifun.inc}
+{$ifdef UNICODE}
+{$i unidef.inc}
+{$else not UNICODE}
+{$i ascdef.inc}
+{$endif UNICODE}
+{$i func.inc}
+{$i redef.inc}
+
+end.
+{
+ $Log: windows.pp,v $
+ Revision 1.8 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/winevent.pp b/rtl/win32/winevent.pp
new file mode 100644
index 0000000000..b940813376
--- /dev/null
+++ b/rtl/win32/winevent.pp
@@ -0,0 +1,310 @@
+{
+ $Id: winevent.pp,v 1.4 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ Event Handling unit for setting Keyboard and Mouse Handlers
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit WinEvent;
+interface
+
+{
+ We need this unit to implement keyboard and mouse,
+ because win32 uses only one message queue for mouse and key events
+}
+
+ uses
+ Windows;
+
+ type
+ TEventProcedure = Procedure(var ir:INPUT_RECORD);
+
+ { these procedures must be used to set the event handlers }
+ { these doesn't do something, they signal only the }
+ { the upper layer that an event occured, this event }
+ { must be handled with Win32-API function by the upper }
+ { layer }
+ Procedure SetMouseEventHandler(p : TEventProcedure);
+ Procedure SetKeyboardEventHandler(p : TEventProcedure);
+ Procedure SetFocusEventHandler(p : TEventProcedure);
+ Procedure SetMenuEventHandler(p : TEventProcedure);
+ Procedure SetResizeEventHandler(p : TEventProcedure);
+ Procedure SetUnknownEventHandler(p : TEventProcedure);
+
+ { these procedures must be used to get the event handlers }
+ Function GetMouseEventHandler : TEventProcedure;
+ Function GetKeyboardEventHandler : TEventProcedure;
+ Function GetFocusEventHandler : TEventProcedure;
+ Function GetMenuEventHandler : TEventProcedure;
+ Function GetResizeEventHandler : TEventProcedure;
+ Function GetUnknownEventHandler : TEventProcedure;
+
+ implementation
+
+ const
+ { these procedures are called if an event occurs }
+ MouseEventHandler : TEventProcedure = nil;
+ KeyboardEventHandler : TEventProcedure = nil;
+ FocusEventHandler : TEventProcedure = nil;
+ MenuEventHandler : TEventProcedure = nil;
+ ResizeEventHandler : TEventProcedure = nil;
+ UnknownEventHandler : TEventProcedure = nil;
+
+ { if this counter is zero, the event handler thread is killed }
+ InstalledHandlers : Byte = 0;
+
+ var
+ HandlerChanging : TCriticalSection;
+ EventThreadHandle : Handle;
+ EventThreadID : DWord;
+
+ { true, if the event handler should be stoped }
+ ExitEventHandleThread : boolean;
+
+ Function GetMouseEventHandler : TEventProcedure;
+ begin
+ GetMouseEventHandler:=MouseEventHandler;
+ end;
+
+
+ Function GetKeyboardEventHandler : TEventProcedure;
+ begin
+ GetKeyboardEventHandler:=KeyboardEventHandler;
+ end;
+
+
+ Function GetFocusEventHandler : TEventProcedure;
+ begin
+ GetFocusEventHandler:=FocusEventHandler;
+ end;
+
+
+ Function GetMenuEventHandler : TEventProcedure;
+ begin
+ GetMenuEventHandler:=MenuEventHandler;
+ end;
+
+
+ Function GetResizeEventHandler : TEventProcedure;
+ begin
+ GetResizeEventHandler:=ResizeEventHandler;
+ end;
+
+
+ Function GetUnknownEventHandler : TEventProcedure;
+ begin
+ GetUnknownEventHandler:=UnknownEventHandler;
+ end;
+
+
+ Function EventHandleThread(p : pointer) : DWord;StdCall;
+ const
+ irsize = 10;
+ var
+ ir : array[0..irsize-1] of TInputRecord;
+ i,dwRead : DWord;
+ begin
+ while not(ExitEventHandleThread) do
+ begin
+ { wait for an event }
+ WaitForSingleObject(StdInputHandle,INFINITE);
+ { guard this code, else it is doomed to crash, if the
+ thread is switched between the assigned test and
+ the call and the handler is removed
+ }
+ if not(ExitEventHandleThread) then
+ begin
+ EnterCriticalSection(HandlerChanging);
+ { read, but don't remove the event }
+ if ReadConsoleInput(StdInputHandle,ir[0],irsize,dwRead) then
+ begin
+ i:=0;
+ while (i<dwRead) do
+ begin
+ { call the handler }
+ case ir[i].EventType of
+ KEY_EVENT:
+ begin
+ if assigned(KeyboardEventHandler) then
+ KeyboardEventHandler(ir[i]);
+ end;
+
+ _MOUSE_EVENT:
+ begin
+ if assigned(MouseEventHandler) then
+ MouseEventHandler(ir[i]);
+ end;
+
+ WINDOW_BUFFER_SIZE_EVENT:
+ begin
+ if assigned(ResizeEventHandler) then
+ ResizeEventHandler(ir[i]);
+ end;
+
+ MENU_EVENT:
+ begin
+ if assigned(MenuEventHandler) then
+ MenuEventHandler(ir[i]);
+ end;
+
+ FOCUS_EVENT:
+ begin
+ if assigned(FocusEventHandler) then
+ FocusEventHandler(ir[i]);
+ end;
+
+ else
+ begin
+ if assigned(UnknownEventHandler) then
+ UnknownEventHandler(ir[i]);
+ end;
+ end;
+ inc(i);
+ end;
+ end;
+ LeaveCriticalSection(HandlerChanging);
+ end;
+ end;
+ EventHandleThread:=0;
+ end;
+
+ Procedure NewEventHandlerInstalled(p,oldp : TEventProcedure);
+ var
+ oldcount : Byte;
+ ir : TInputRecord;
+ written : DWord;
+ begin
+ oldcount:=InstalledHandlers;
+ if Pointer(oldp)<>nil then
+ dec(InstalledHandlers);
+ if Pointer(p)<>nil then
+ inc(InstalledHandlers);
+ { start event handler thread }
+ if (oldcount=0) and (InstalledHandlers=1) then
+ begin
+ ExitEventHandleThread:=false;
+ EventThreadHandle:=CreateThread(nil,0,@EventHandleThread,
+ nil,0,EventThreadID);
+ end
+ { stop and destroy event handler thread }
+ else if (oldcount=1) and (InstalledHandlers=0) then
+ begin
+ ExitEventHandleThread:=true;
+ { create a dummy event and sent it to the thread, so
+ we can leave WaitForSingleObject }
+ ir.EventType:=KEY_EVENT;
+ { mouse event can be disabled by mouse.inc code
+ in DoneMouse
+ so use a key event instead PM }
+ WriteConsoleInput(StdInputHandle,ir,1,written);
+ { wait, til the thread is ready }
+ WaitForSingleObject(EventThreadHandle,INFINITE);
+ CloseHandle(EventThreadHandle);
+ end;
+ end;
+
+
+ Procedure SetMouseEventHandler(p : TEventProcedure);
+ var
+ oldp : TEventProcedure;
+ begin
+ EnterCriticalSection(HandlerChanging);
+ oldp:=MouseEventHandler;
+ MouseEventHandler:=p;
+ NewEventHandlerInstalled(MouseEventHandler,oldp);
+ LeaveCriticalSection(HandlerChanging);
+ end;
+
+
+ Procedure SetKeyboardEventHandler(p : TEventProcedure);
+ var
+ oldp : TEventProcedure;
+ begin
+ EnterCriticalSection(HandlerChanging);
+ oldp:=KeyboardEventHandler;
+ KeyboardEventHandler:=p;
+ NewEventHandlerInstalled(KeyboardEventHandler,oldp);
+ LeaveCriticalSection(HandlerChanging);
+ end;
+
+
+ Procedure SetFocusEventHandler(p : TEventProcedure);
+ var
+ oldp : TEventProcedure;
+ begin
+ EnterCriticalSection(HandlerChanging);
+ oldp:=FocusEventHandler;
+ FocusEventHandler:=p;
+ NewEventHandlerInstalled(FocusEventHandler,oldp);
+ LeaveCriticalSection(HandlerChanging);
+ end;
+
+
+ Procedure SetMenuEventHandler(p : TEventProcedure);
+ var
+ oldp : TEventProcedure;
+ begin
+ EnterCriticalSection(HandlerChanging);
+ oldp:=MenuEventHandler;
+ MenuEventHandler:=p;
+ NewEventHandlerInstalled(MenuEventHandler,oldp);
+ LeaveCriticalSection(HandlerChanging);
+ end;
+
+
+ Procedure SetResizeEventHandler(p : TEventProcedure);
+ var
+ oldp : TEventProcedure;
+ begin
+ EnterCriticalSection(HandlerChanging);
+ oldp:=ResizeEventHandler;
+ ResizeEventHandler:=p;
+ NewEventHandlerInstalled(ResizeEventHandler,oldp);
+ LeaveCriticalSection(HandlerChanging);
+ end;
+
+
+ Procedure SetUnknownEventHandler(p : TEventProcedure);
+ var
+ oldp : TEventProcedure;
+ begin
+ EnterCriticalSection(HandlerChanging);
+ oldp:=UnknownEventHandler;
+ UnknownEventHandler:=p;
+ NewEventHandlerInstalled(UnknownEventHandler,oldp);
+ LeaveCriticalSection(HandlerChanging);
+ end;
+
+
+initialization
+ InitializeCriticalSection(HandlerChanging);
+
+finalization
+ { Uninstall all handlers }
+ { this stops also the event handler thread }
+ SetMouseEventHandler(nil);
+ SetKeyboardEventHandler(nil);
+ SetFocusEventHandler(nil);
+ SetMenuEventHandler(nil);
+ SetResizeEventHandler(nil);
+ SetUnknownEventHandler(nil);
+ { delete the critical section object }
+ DeleteCriticalSection(HandlerChanging);
+
+end.
+
+{
+ $Log: winevent.pp,v $
+ Revision 1.4 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/Makefile b/rtl/win32/wininc/Makefile
new file mode 100644
index 0000000000..6f31853e6a
--- /dev/null
+++ b/rtl/win32/wininc/Makefile
@@ -0,0 +1,164 @@
+#
+# $Id: Makefile,v 1.2 2002/09/07 16:01:29 peter Exp $
+# This file is part of the Free Pascal run time library.
+# Copyright (c) 1999-2000 by Michael van Canneyt
+#
+# Makefile for the Free Pascal windows.pp include files
+#
+# See the file COPYING.FPC, included in this distribution,
+# for details about the copyright.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+
+# Warning: this file contains TAB (#9) characters that are required for
+# make. Make sure you use an editor that does not replace TABs with
+# spaces, or the makefile won't work anymore after you save.
+
+#####################################################################
+# Defaults
+#####################################################################
+
+ECHO=echo
+
+# Files used by windows.pp
+include makefile.inc
+
+
+#####################################################################
+# windows.pp
+#####################################################################
+
+# default target
+all: ascdef.inc unidef.inc
+
+# Getting DLL names
+# not present in headers !!
+
+# first get the list of all exported function names
+# uses pedump
+# for system dll 's
+# gdi32.exp will contain all exported functions names of gdi32.dll
+
+WINDOWS_DIR:=c\:/windows
+
+%.exp : $(WINDOWS_DIR)/system/%.dll
+ pedump $< > $*.tmp
+ sed -n -e "s/Addr:\(.*\)Ord:\(.*\)Name: \(.*\)/@\3@/p" $*.tmp > $*.exp
+# -rm $*.tmp
+
+%.exd : $(WINDOWS_DIR)/system/%.drv
+ pedump $< > $*.tmp
+ sed -n -e "s/Addr:\(.*\)Ord:\(.*\)Name: \(.*\)/@\3@/p" $*.tmp > $*.exd
+# -rm $*.tmp
+
+# list of usefull dll's for windows.pp
+dllexps : gdi32.exp kernel32.exp advapi32.exp user32.exp mapi32.exp \
+ comdlg32.exp shell32.exp mpr.exp comctl32.exp version.exp \
+ opengl32.exp spoolss.exp winspool.exd
+
+# get a complete listing of all system dll's
+allexps : $(notdir $(patsubst %.dll,%.exp,$(wildcard $(WINDOWS_DIR)/system/*.dll)) \
+ $(patsubst %.drv,%.exd,$(wildcard $(WINDOWS_DIR)/system/*.drv)))
+
+# extract the dllnames for which the real dll file is not
+# known yet
+# func.lst will contain all functions for which we still do
+# not know the origin DLL
+%.lst : %.inc
+ @$(ECHO) listing DLL function names of $*.inc
+ sed -n -e "s/\(.*\)External_library name '\([^']*\)'\(.*\)/\2/p" $*.inc > $*.lst
+
+# get the DLL name from the listing in .exp files
+# of the current target
+define grepname
+$(filter %.dll %.drv ,$(subst .exd:,.drv ,$(subst .exp:,.dll ,$(shell grep @$*@ *.ex*))))
+endef
+
+# creating of a sed script that
+# will substitute all External_library
+# by the real name of the DLL if found in exports files
+
+# two stages
+# because you cannot set a variable inside the commands
+# Level 1 : set filename variable
+# Level 2 :
+%.sub : %.lst
+ @$(ECHO) getting DLL file name for $*
+ -rm $*.sub
+ @$(ECHO) # Substitutions for $* >$*.sub
+# call make for all names in lst file
+# define LongList if there is an error
+# because the list is too long
+ifdef LongList
+ $(foreach name,$(shell cat $*.lst),$(MAKE) subfile=$*.sub $(name).find ; )
+else
+ $(MAKE) subfile=$*.sub $(addsuffix .find,$(shell cat $*.lst))
+endif
+# resubstitute unfound ones !!
+ @$(ECHO) s/external \'\' name \'\([^\']*\)\'/external\
+ External_library name \'\1\'/ >>$*.sub
+ @$(ECHO) # End of substitutions for $* >>$*.sub
+
+# Change file according to function found in export
+# list remaining unfound functions in $*.mis
+%.npp : %.sub
+ sed -f $*.sub $*.inc > $*.npp
+ sed -n -e "s/\(.*\)External_library name \'\([^\']*\)\'\(.*\)/\2/p" $*.npp > $*.mis
+
+%.find :
+ @$(ECHO) $* is in $(grepname)
+ifdef subfile
+ @$(ECHO) s/external External_library name \'$*\'/external\
+ \'$(filter %.dll %.drv ,$(subst .exd:,.drv ,$(subst .exp:,.dll ,$(shell grep @$*@ *.ex*))))\'\
+ name \'$*\'/ >>$(subfile)
+else
+ @$(ECHO) external \
+ \'$(filter %.dll %.drv ,$(subst .exd:,.drv ,$(subst .exp:,.dll ,$(shell grep @$*@ *.ex*))))\'\
+ name $*
+endif
+
+GNUWIN32LIBDIR=./
+
+%.find2 :
+ @$(ECHO) s/In archive \(.*\)/\1/p >find.sed
+ @$(ECHO) s/\(.*\)___imp_$*@\(.*\)/found: $*/p >>find.sed
+ifdef subfile
+ sed -n -f find.sed alllibs.sym >> $(subfile)
+else
+ sed -n -f find.sed alllibs.sym > $*.res
+endif
+
+missing : $(GNUWIN32LIBDIR)alllibs.sym $(addsuffix .lst,$(WINDOWS_FILES))
+ -rm missing
+ $(MAKE) subfile=missing $(addsuffix .find2,$(shell cat *.lst))
+
+substmissing : missing
+ dtou missing
+ @$(ECHO) N > test.sed
+ @$(ECHO) s/lib\(.*\)\.a:\nfound: \(.*\)/\1.dll : \2/p >> test.sed
+ @$(ECHO) D >> test.sed
+ sed -n -f test.sed missing > missing.tmp
+ sed -e "s#\(.*\) : \(.*\)#s/external External_library name \'\2\'/external \'\1\' name \'\2\'/#" missing.tmp > missing.sub
+
+dllnames:
+ $(MAKE) $(addsuffix .lst,$(WINDOWS_FILES))
+
+test:
+ @$(ECHO) namelist of $(filename) is "$(namelist)"
+
+# automatic conversion from ascfun.inc to ascdef.inc
+# and unifun.inc to unidef.inc
+ascdef.inc : ascfun.inc ascdef.sed
+ sed -f ascdef.sed ascfun.inc > ascdef.inc
+
+unidef.inc : unifun.inc unidef.sed
+ sed -f unidef.sed unifun.inc > unidef.inc
+
+#
+# $Log: Makefile,v $
+# Revision 1.2 2002/09/07 16:01:29 peter
+# * old logs removed and tabs fixed
+#
diff --git a/rtl/win32/wininc/ascdef.inc b/rtl/win32/wininc/ascdef.inc
new file mode 100644
index 0000000000..59098c3ec7
--- /dev/null
+++ b/rtl/win32/wininc/ascdef.inc
@@ -0,0 +1,496 @@
+{
+ $Id: ascdef.inc,v 1.10 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Contains the Ascii functions for windows unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ ASCIIFunctions.h
+
+ Declarations for all the Win32 ASCII Functions
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+function GetBinaryType(lpApplicationName:LPCSTR; lpBinaryType:LPDWORD):WINBOOL; external 'kernel32' name 'GetBinaryTypeA';
+function GetShortPathName(lpszLongPath:LPCSTR; lpszShortPath:LPSTR; cchBuffer:DWORD):DWORD; external 'kernel32' name 'GetShortPathNameA';
+function GetEnvironmentStrings : LPSTR; external 'kernel32' name 'GetEnvironmentStringsA';
+function FreeEnvironmentStrings(_para1:LPSTR):WINBOOL; external 'kernel32' name 'FreeEnvironmentStringsA';
+function FormatMessage(dwFlags:DWORD; lpSource:LPCVOID; dwMessageId:DWORD; dwLanguageId:DWORD; lpBuffer:LPSTR;nSize:DWORD; Arguments:va_list):DWORD; external 'kernel32' name 'FormatMessageA';
+function CreateMailslot(lpName:LPCSTR; nMaxMessageSize:DWORD; lReadTimeout:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE; external 'kernel32' name 'CreateMailslotA';
+function lstrcmp(lpString1:LPCSTR; lpString2:LPCSTR):longint; external 'kernel32' name 'lstrcmpA';
+function lstrcmpi(lpString1:LPCSTR; lpString2:LPCSTR):longint; external 'kernel32' name 'lstrcmpiA';
+function lstrcpyn(lpString1:LPSTR; lpString2:LPCSTR; iMaxLength:longint):LPSTR; external 'kernel32' name 'lstrcpynA';
+function lstrcpy(lpString1:LPSTR; lpString2:LPCSTR):LPSTR; external 'kernel32' name 'lstrcpyA';
+function lstrcat(lpString1:LPSTR; lpString2:LPCSTR):LPSTR; external 'kernel32' name 'lstrcatA';
+function lstrlen(lpString:LPCSTR):longint; external 'kernel32' name 'lstrlenA';
+function CreateMutex(lpMutexAttributes:LPSECURITY_ATTRIBUTES; bInitialOwner:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateMutexA';
+function OpenMutex(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenMutexA';
+function CreateEvent(lpEventAttributes:LPSECURITY_ATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateEventA';
+function OpenEvent(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenEventA';
+function CreateSemaphore(lpSemaphoreAttributes:LPSECURITY_ATTRIBUTES; lInitialCount:LONG; lMaximumCount:LONG; lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateSemaphoreA';
+function OpenSemaphore(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenSemaphoreA';
+function CreateFileMapping(hFile:HANDLE; lpFileMappingAttributes:LPSECURITY_ATTRIBUTES; flProtect:DWORD; dwMaximumSizeHigh:DWORD; dwMaximumSizeLow:DWORD;lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateFileMappingA';
+function OpenFileMapping(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenFileMappingA';
+function GetLogicalDriveStrings(nBufferLength:DWORD; lpBuffer:LPSTR):DWORD; external 'kernel32' name 'GetLogicalDriveStringsA';
+function LoadLibrary(lpLibFileName:LPCSTR):HINST; external 'kernel32' name 'LoadLibraryA';
+function LoadLibraryEx(lpLibFileName:LPCSTR; hFile:HANDLE; dwFlags:DWORD):HINST; external 'kernel32' name 'LoadLibraryExA';
+function GetModuleFileName(hModule:HINST; lpFilename:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetModuleFileNameA';
+function GetModuleHandle(lpModuleName:LPCSTR):HMODULE; external 'kernel32' name 'GetModuleHandleA';
+procedure FatalAppExit(uAction:UINT; lpMessageText:LPCSTR); external 'kernel32' name 'FatalAppExitA';
+function GetCommandLine : LPSTR; external 'kernel32' name 'GetCommandLineA';
+function GetEnvironmentVariable(lpName:LPCSTR; lpBuffer:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetEnvironmentVariableA';
+function SetEnvironmentVariable(lpName:LPCSTR; lpValue:LPCSTR):WINBOOL; external 'kernel32' name 'SetEnvironmentVariableA';
+function ExpandEnvironmentStrings(lpSrc:LPCSTR; lpDst:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'ExpandEnvironmentStringsA';
+procedure OutputDebugString(lpOutputString:LPCSTR); external 'kernel32' name 'OutputDebugStringA';
+function FindResource(hModule:HINST; lpName:LPCSTR; lpType:LPCSTR):HRSRC; external 'kernel32' name 'FindResourceA';
+function FindResourceEx(hModule:HINST; lpType:LPCSTR; lpName:LPCSTR; wLanguage:WORD):HRSRC; external 'kernel32' name 'FindResourceExA';
+function EnumResourceTypes(hModule:HINST; lpEnumFunc:ENUMRESTYPEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceTypesA';
+function EnumResourceNames(hModule:HINST; lpType:LPCSTR; lpEnumFunc:ENUMRESNAMEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceNamesA';
+function EnumResourceLanguages(hModule:HINST; lpType:LPCSTR; lpName:LPCSTR; lpEnumFunc:ENUMRESLANGPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceLanguagesA';
+function BeginUpdateResource(pFileName:LPCSTR; bDeleteExistingResources:WINBOOL):HANDLE; external 'kernel32' name 'BeginUpdateResourceA';
+function UpdateResource(hUpdate:HANDLE; lpType:LPCSTR; lpName:LPCSTR; wLanguage:WORD; lpData:LPVOID;cbData:DWORD):WINBOOL; external 'kernel32' name 'UpdateResourceA';
+function EndUpdateResource(hUpdate:HANDLE; fDiscard:WINBOOL):WINBOOL; external 'kernel32' name 'EndUpdateResourceA';
+function GlobalAddAtom(lpString:LPCSTR):ATOM; external 'kernel32' name 'GlobalAddAtomA';
+function GlobalFindAtom(lpString:LPCSTR):ATOM; external 'kernel32' name 'GlobalFindAtomA';
+function GlobalGetAtomName(nAtom:ATOM; lpBuffer:LPSTR; nSize:longint):UINT; external 'kernel32' name 'GlobalGetAtomNameA';
+function AddAtom(lpString:LPCSTR):ATOM; external 'kernel32' name 'AddAtomA';
+function FindAtom(lpString:LPCSTR):ATOM; external 'kernel32' name 'FindAtomA';
+function GetAtomName(nAtom:ATOM; lpBuffer:LPSTR; nSize:longint):UINT; external 'kernel32' name 'GetAtomNameA';
+function GetProfileInt(lpAppName:LPCSTR; lpKeyName:LPCSTR; nDefault:WINT):UINT; external 'kernel32' name 'GetProfileIntA';
+function GetProfileString(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpDefault:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileStringA';
+function WriteProfileString(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpString:LPCSTR):WINBOOL; external 'kernel32' name 'WriteProfileStringA';
+function GetProfileSection(lpAppName:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileSectionA';
+function WriteProfileSection(lpAppName:LPCSTR; lpString:LPCSTR):WINBOOL; external 'kernel32' name 'WriteProfileSectionA';
+function GetPrivateProfileInt(lpAppName:LPCSTR; lpKeyName:LPCSTR; nDefault:WINT; lpFileName:LPCSTR):UINT; external 'kernel32' name 'GetPrivateProfileIntA';
+function GetPrivateProfileString(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpDefault:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD;lpFileName:LPCSTR):DWORD; external 'kernel32' name 'GetPrivateProfileStringA';
+function WritePrivateProfileString(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpString:LPCSTR; lpFileName:LPCSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileStringA';
+function GetPrivateProfileSection(lpAppName:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD; lpFileName:LPCSTR):DWORD; external 'kernel32' name 'GetPrivateProfileSectionA';
+function WritePrivateProfileSection(lpAppName:LPCSTR; lpString:LPCSTR; lpFileName:LPCSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileSectionA';
+function GetDriveType(lpRootPathName:LPCSTR):UINT; external 'kernel32' name 'GetDriveTypeA';
+function GetSystemDirectory(lpBuffer:LPSTR; uSize:UINT):UINT; external 'kernel32' name 'GetSystemDirectoryA';
+function GetTempPath(nBufferLength:DWORD; lpBuffer:LPSTR):DWORD; external 'kernel32' name 'GetTempPathA';
+function GetTempFileName(lpPathName:LPCSTR; lpPrefixString:LPCSTR; uUnique:UINT; lpTempFileName:LPSTR):UINT; external 'kernel32' name 'GetTempFileNameA';
+function GetWindowsDirectory(lpBuffer:LPSTR; uSize:UINT):UINT; external 'kernel32' name 'GetWindowsDirectoryA';
+function SetCurrentDirectory(lpPathName:LPCSTR):WINBOOL; external 'kernel32' name 'SetCurrentDirectoryA';
+function GetCurrentDirectory(nBufferLength:DWORD; lpBuffer:LPSTR):DWORD; external 'kernel32' name 'GetCurrentDirectoryA';
+function GetDiskFreeSpace(lpRootPathName:LPCSTR; lpSectorsPerCluster:LPDWORD; lpBytesPerSector:LPDWORD; lpNumberOfFreeClusters:LPDWORD; lpTotalNumberOfClusters:LPDWORD):WINBOOL; external 'kernel32' name 'GetDiskFreeSpaceA';
+function CreateDirectory(lpPathName:LPCSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryA';
+function CreateDirectoryEx(lpTemplateDirectory:LPCSTR; lpNewDirectory:LPCSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryExA';
+function RemoveDirectory(lpPathName:LPCSTR):WINBOOL; external 'kernel32' name 'RemoveDirectoryA';
+function GetFullPathName(lpFileName:LPCSTR; nBufferLength:DWORD; lpBuffer:LPSTR; var lpFilePart:LPSTR):DWORD; external 'kernel32' name 'GetFullPathNameA';
+function DefineDosDevice(dwFlags:DWORD; lpDeviceName:LPCSTR; lpTargetPath:LPCSTR):WINBOOL; external 'kernel32' name 'DefineDosDeviceA';
+function QueryDosDevice(lpDeviceName:LPCSTR; lpTargetPath:LPSTR; ucchMax:DWORD):DWORD; external 'kernel32' name 'QueryDosDeviceA';
+function CreateFile(lpFileName:LPCSTR; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; dwCreationDisposition:DWORD;dwFlagsAndAttributes:DWORD; hTemplateFile:HANDLE):HANDLE; external 'kernel32' name 'CreateFileA';
+function SetFileAttributes(lpFileName:LPCSTR; dwFileAttributes:DWORD):WINBOOL; external 'kernel32' name 'SetFileAttributesA';
+function GetFileAttributes(lpFileName:LPCSTR):DWORD; external 'kernel32' name 'GetFileAttributesA';
+function GetCompressedFileSize(lpFileName:LPCSTR; lpFileSizeHigh:LPDWORD):DWORD; external 'kernel32' name 'GetCompressedFileSizeA';
+function DeleteFile(lpFileName:LPCSTR):WINBOOL; external 'kernel32' name 'DeleteFileA';
+function SearchPath(lpPath:LPCSTR; lpFileName:LPCSTR; lpExtension:LPCSTR; nBufferLength:DWORD; lpBuffer:LPSTR;lpFilePart:LPSTR):DWORD; external 'kernel32' name 'SearchPathA';
+function CopyFile(lpExistingFileName:LPCSTR; lpNewFileName:LPCSTR; bFailIfExists:WINBOOL):WINBOOL; external 'kernel32' name 'CopyFileA';
+function MoveFile(lpExistingFileName:LPCSTR; lpNewFileName:LPCSTR):WINBOOL; external 'kernel32' name 'MoveFileA';
+function MoveFileEx(lpExistingFileName:LPCSTR; lpNewFileName:LPCSTR; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'MoveFileExA';
+function CreateNamedPipe(lpName:LPCSTR; dwOpenMode:DWORD; dwPipeMode:DWORD; nMaxInstances:DWORD; nOutBufferSize:DWORD;nInBufferSize:DWORD; nDefaultTimeOut:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE;
+ external 'kernel32' name 'CreateNamedPipeA';
+function GetNamedPipeHandleState(hNamedPipe:HANDLE; lpState:LPDWORD; lpCurInstances:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD;lpUserName:LPSTR; nMaxUserNameSize:DWORD):WINBOOL;
+ external 'kernel32' name 'GetNamedPipeHandleStateA';
+function CallNamedPipe(lpNamedPipeName:LPCSTR; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'CallNamedPipeA';
+function WaitNamedPipe(lpNamedPipeName:LPCSTR; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'WaitNamedPipeA';
+function SetVolumeLabel(lpRootPathName:LPCSTR; lpVolumeName:LPCSTR):WINBOOL; external 'kernel32' name 'SetVolumeLabelA';
+function GetVolumeInformation(lpRootPathName:LPCSTR; lpVolumeNameBuffer:LPSTR; nVolumeNameSize:DWORD; lpVolumeSerialNumber:LPDWORD; lpMaximumComponentLength:LPDWORD;lpFileSystemFlags:LPDWORD;
+ lpFileSystemNameBuffer:LPSTR; nFileSystemNameSize:DWORD):WINBOOL; external 'kernel32' name 'GetVolumeInformationA';
+function ClearEventLog(hEventLog:HANDLE; lpBackupFileName:LPCSTR):WINBOOL; external 'advapi32' name 'ClearEventLogA';
+function BackupEventLog(hEventLog:HANDLE; lpBackupFileName:LPCSTR):WINBOOL; external 'advapi32' name 'BackupEventLogA';
+function OpenEventLog(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; external 'advapi32' name 'OpenEventLogA';
+function RegisterEventSource(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceA';
+function OpenBackupEventLog(lpUNCServerName:LPCSTR; lpFileName:LPCSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogA';
+function ReadEventLog(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogA';
+function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventA';
+function AccessCheckAndAuditAlarm(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING;
+ ObjectCreation:WINBOOL; GrantedAccess:LPDWORD;AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
+function ObjectOpenAuditAlarm(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;
+ Privileges:PPRIVILEGE_SET; ObjectCreation:WINBOOL;AccessGranted:WINBOOL; GenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'ObjectOpenAuditAlarmA';
+function ObjectPrivilegeAuditAlarm(SubsystemName:LPCSTR; HandleId:LPVOID; ClientToken:HANDLE; DesiredAccess:DWORD; Privileges:PPRIVILEGE_SET;AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmA';
+function ObjectCloseAuditAlarm(SubsystemName:LPCSTR; HandleId:LPVOID; GenerateOnClose:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectCloseAuditAlarmA';
+function PrivilegedServiceAuditAlarm(SubsystemName:LPCSTR; ServiceName:LPCSTR; ClientToken:HANDLE; Privileges:PPRIVILEGE_SET; AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmA';
+function SetFileSecurity(lpFileName:LPCSTR; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetFileSecurityA';
+function GetFileSecurity(lpFileName:LPCSTR; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetFileSecurityA';
+function FindFirstChangeNotification(lpPathName:LPCSTR; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD):HANDLE; external 'kernel32' name 'FindFirstChangeNotificationA';
+function IsBadStringPtr(lpsz:LPCSTR; ucchMax:UINT):WINBOOL; external 'kernel32' name 'IsBadStringPtrA';
+function LookupAccountSid(lpSystemName:LPCSTR; Sid:PSID; Name:LPSTR; cbName:LPDWORD; ReferencedDomainName:LPSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountSidA';
+function LookupAccountName(lpSystemName:LPCSTR; lpAccountName:LPCSTR; Sid:PSID; cbSid:LPDWORD; ReferencedDomainName:LPSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountNameA';
+function LookupPrivilegeValue(lpSystemName:LPCSTR; lpName:LPCSTR; lpLuid:PLUID):WINBOOL; external 'advapi32' name 'LookupPrivilegeValueA';
+function LookupPrivilegeName(lpSystemName:LPCSTR; lpLuid:PLUID; lpName:LPSTR; cbName:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeNameA';
+function LookupPrivilegeDisplayName(lpSystemName:LPCSTR; lpName:LPCSTR; lpDisplayName:LPSTR; cbDisplayName:LPDWORD; lpLanguageId:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameA';
+function BuildCommDCB(lpDef:LPCSTR; lpDCB:LPDCB):WINBOOL; external 'kernel32' name 'BuildCommDCBA';
+function BuildCommDCBAndTimeouts(lpDef:LPCSTR; lpDCB:LPDCB; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsA';
+function CommConfigDialog(lpszName:LPCSTR; hWnd:HWND; lpCC:LPCOMMCONFIG):WINBOOL; external 'kernel32' name 'CommConfigDialogA';
+function GetDefaultCommConfig(lpszName:LPCSTR; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetDefaultCommConfigA';
+function SetDefaultCommConfig(lpszName:LPCSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetDefaultCommConfigA';
+function GetComputerName(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameA';
+function SetComputerName(lpComputerName:LPCSTR):WINBOOL; external 'kernel32' name 'SetComputerNameA';
+function GetUserName(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameA';
+function wvsprintf(_para1:LPSTR; _para2:LPCSTR; arglist:va_list):longint; external 'user32' name 'wvsprintfA';
+function LoadKeyboardLayout(pwszKLID:LPCSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutA';
+function GetKeyboardLayoutName(pwszKLID:LPSTR):WINBOOL; external 'user32' name 'GetKeyboardLayoutNameA';
+function CreateDesktop(lpszDesktop:LPSTR; lpszDevice:LPSTR; pDevmode:LPDEVMODE; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopA';
+function OpenDesktop(lpszDesktop:LPSTR; dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenDesktopA';
+function EnumDesktops(hwinsta:HWINSTA; lpEnumFunc:DESKTOPENUMPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopsA';
+function CreateWindowStation(lpwinsta:LPSTR; dwReserved:DWORD; dwDesiredAccess:DWORD; lpsa:LPSECURITY_ATTRIBUTES):HWINSTA; external 'user32' name 'CreateWindowStationA';
+function OpenWindowStation(lpszWinSta:LPSTR; fInherit:WINBOOL; dwDesiredAccess:DWORD):HWINSTA; external 'user32' name 'OpenWindowStationA';
+function EnumWindowStations(lpEnumFunc:ENUMWINDOWSTATIONPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindowStationsA';
+function GetUserObjectInformation(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectInformationA';
+function SetUserObjectInformation(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD):WINBOOL; external 'user32' name 'SetUserObjectInformationA';
+function RegisterWindowMessage(lpString:LPCSTR):UINT; external 'user32' name 'RegisterWindowMessageA';
+function GetMessage(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT):WINBOOL; external 'user32' name 'GetMessageA';
+function DispatchMessage(lpMsg:LPMSG):LONG; external 'user32' name 'DispatchMessageA';
+function PeekMessage(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT; wRemoveMsg:UINT):WINBOOL; external 'user32' name 'PeekMessageA';
+function SendMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'SendMessageA';
+function SendMessageTimeout(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; fuFlags:UINT;uTimeout:UINT; lpdwResult:LPDWORD):LRESULT; external 'user32' name 'SendMessageTimeoutA';
+function SendNotifyMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'SendNotifyMessageA';
+function SendMessageCallback(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; lpResultCallBack:SENDASYNCPROC;dwData:DWORD):WINBOOL; external 'user32' name 'SendMessageCallbackA';
+function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostMessageA';
+function PostThreadMessage(idThread:DWORD; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostThreadMessageA';
+function DefWindowProc(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefWindowProcA';
+function CallWindowProc(lpPrevWndFunc:WNDPROC; hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'CallWindowProcA';
+function RegisterClass(lpWndClass:LPWNDCLASS):ATOM; external 'user32' name 'RegisterClassA';
+function UnregisterClass(lpClassName:LPCSTR; hInstance:HINST):WINBOOL; external 'user32' name 'UnregisterClassA';
+function GetClassInfo(hInstance:HINST; lpClassName:LPCSTR; lpWndClass:LPWNDCLASS):WINBOOL; external 'user32' name 'GetClassInfoA';
+function RegisterClassEx(_para1:LPWNDCLASSEX):ATOM; external 'user32' name 'RegisterClassExA';
+function GetClassInfoEx(_para1:HINST; _para2:LPCSTR; _para3:LPWNDCLASSEX):WINBOOL; external 'user32' name 'GetClassInfoExA';
+function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+ external 'user32' name 'CreateWindowExA';
+function CreateDialogParam(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogParamA';
+function CreateDialogIndirectParam(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogIndirectParamA';
+function DialogBoxParam(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxParamA';
+function DialogBoxIndirectParam(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxIndirectParamA';
+function SetDlgItemText(hDlg:HWND; nIDDlgItem:longint; lpString:LPCSTR):WINBOOL; external 'user32' name 'SetDlgItemTextA';
+function GetDlgItemText(hDlg:HWND; nIDDlgItem:longint; lpString:LPSTR; nMaxCount:longint):UINT; external 'user32' name 'GetDlgItemTextA';
+function SendDlgItemMessage(hDlg:HWND; nIDDlgItem:longint; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LONG; external 'user32' name 'SendDlgItemMessageA';
+function DefDlgProc(hDlg:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefDlgProcA';
+function CallMsgFilter(lpMsg:LPMSG; nCode:longint):WINBOOL; external 'user32' name 'CallMsgFilterA';
+function RegisterClipboardFormat(lpszFormat:LPCSTR):UINT; external 'user32' name 'RegisterClipboardFormatA';
+function GetClipboardFormatName(format:UINT; lpszFormatName:LPSTR; cchMaxCount:longint):longint; external 'user32' name 'GetClipboardFormatNameA';
+function CharToOem(lpszSrc:LPCSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'CharToOemA';
+function OemToChar(lpszSrc:LPCSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'OemToCharA';
+function CharToOemBuff(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffA';
+function OemToCharBuff(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffA';
+function CharUpper(lpsz:LPSTR):LPSTR; external 'user32' name 'CharUpperA';
+function CharUpperBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharUpperBuffA';
+function CharLower(lpsz:LPSTR):LPSTR; external 'user32' name 'CharLowerA';
+function CharLowerBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharLowerBuffA';
+function CharNext(lpsz:LPCSTR):LPSTR; external 'user32' name 'CharNextA';
+function CharPrev(lpszStart:LPCSTR; lpszCurrent:LPCSTR):LPSTR; external 'user32' name 'CharPrevA';
+function IsCharAlpha(ch:CHAR):WINBOOL; external 'user32' name 'IsCharAlphaA';
+function IsCharAlphaNumeric(ch:CHAR):WINBOOL; external 'user32' name 'IsCharAlphaNumericA';
+function IsCharUpper(ch:CHAR):WINBOOL; external 'user32' name 'IsCharUpperA';
+function IsCharLower(ch:CHAR):WINBOOL; external 'user32' name 'IsCharLowerA';
+function GetKeyNameText(lParam:LONG; lpString:LPSTR; nSize:longint):longint; external 'user32' name 'GetKeyNameTextA';
+function VkKeyScan(ch:CHAR):SHORT; external 'user32' name 'VkKeyScanA';
+function VkKeyScanEx(ch:CHAR; dwhkl:HKL):SHORT; external 'user32' name 'VkKeyScanExA';
+function MapVirtualKey(uCode:UINT; uMapType:UINT):UINT; external 'user32' name 'MapVirtualKeyA';
+function MapVirtualKeyEx(uCode:UINT; uMapType:UINT; dwhkl:HKL):UINT; external 'user32' name 'MapVirtualKeyExA';
+function LoadAccelerators(hInstance:HINST; lpTableName:LPCSTR):HACCEL; external 'user32' name 'LoadAcceleratorsA';
+function CreateAcceleratorTable(_para1:LPACCEL; _para2:longint):HACCEL; external 'user32' name 'CreateAcceleratorTableA';
+function CopyAcceleratorTable(hAccelSrc:HACCEL; lpAccelDst:LPACCEL; cAccelEntries:longint):longint; external 'user32' name 'CopyAcceleratorTableA';
+function TranslateAccelerator(hWnd:HWND; hAccTable:HACCEL; lpMsg:LPMSG):longint; external 'user32' name 'TranslateAcceleratorA';
+function LoadMenu(hInstance:HINST; lpMenuName:LPCSTR):HMENU; external 'user32' name 'LoadMenuA';
+function LoadMenuIndirect(lpMenuTemplate:LPMENUTEMPLATE):HMENU; external 'user32' name 'LoadMenuIndirectA';
+function ChangeMenu(hMenu:HMENU; cmd:UINT; lpszNewItem:LPCSTR; cmdInsert:UINT; flags:UINT):WINBOOL; external 'user32' name 'ChangeMenuA';
+function GetMenuString(hMenu:HMENU; uIDItem:UINT; lpString:LPSTR; nMaxCount:longint; uFlag:UINT):longint; external 'user32' name 'GetMenuStringA';
+function InsertMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCSTR):WINBOOL; external 'user32' name 'InsertMenuA';
+function AppendMenu(hMenu:HMENU; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCSTR):WINBOOL; external 'user32' name 'AppendMenuA';
+function ModifyMenu(hMnu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCSTR):WINBOOL; external 'user32' name 'ModifyMenuA';
+function InsertMenuItem(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'InsertMenuItemA';
+function GetMenuItemInfo(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPMENUITEMINFO):WINBOOL; external 'user32' name 'GetMenuItemInfoA';
+function SetMenuItemInfo(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'SetMenuItemInfoA';
+function DrawText(hDC:HDC; lpString:LPCSTR; nCount:longint; lpRect:LPRECT; uFormat:UINT):longint; external 'user32' name 'DrawTextA';
+function DrawTextEx(_para1:HDC; _para2:LPSTR; _para3:longint; _para4:LPRECT; _para5:UINT;_para6:LPDRAWTEXTPARAMS):longint; external 'user32' name 'DrawTextExA';
+function GrayString(hDC:HDC; hBrush:HBRUSH; lpOutputFunc:GRAYSTRINGPROC; lpData:LPARAM; nCount:longint;X:longint; Y:longint; nWidth:longint; nHeight:longint):WINBOOL; external 'user32' name 'GrayStringA';
+function DrawState(_para1:HDC; _para2:HBRUSH; _para3:DRAWSTATEPROC; _para4:LPARAM; _para5:WPARAM;_para6:longint; _para7:longint; _para8:longint; _para9:longint; _para10:UINT):WINBOOL; external 'user32' name 'DrawStateA';
+function TabbedTextOut(hDC:HDC; X:longint; Y:longint; lpString:LPCSTR; nCount:longint;nTabPositions:longint; lpnTabStopPositions:LPINT; nTabOrigin:longint):LONG; external 'user32' name 'TabbedTextOutA';
+function GetTabbedTextExtent(hDC:HDC; lpString:LPCSTR; nCount:longint; nTabPositions:longint; lpnTabStopPositions:LPINT):DWORD; external 'user32' name 'GetTabbedTextExtentA';
+function SetProp(hWnd:HWND; lpString:LPCSTR; hData:HANDLE):WINBOOL; external 'user32' name 'SetPropA';
+function GetProp(hWnd:HWND; lpString:LPCSTR):HANDLE; external 'user32' name 'GetPropA';
+function RemoveProp(hWnd:HWND; lpString:LPCSTR):HANDLE; external 'user32' name 'RemovePropA';
+function EnumPropsEx(hWnd:HWND; lpEnumFunc:PROPENUMPROCEX; lParam:LPARAM):longint; external 'user32' name 'EnumPropsExA';
+function EnumProps(hWnd:HWND; lpEnumFunc:PROPENUMPROC):longint; external 'user32' name 'EnumPropsA';
+function SetWindowText(hWnd:HWND; lpString:LPCSTR):WINBOOL; external 'user32' name 'SetWindowTextA';
+function GetWindowText(hWnd:HWND; lpString:LPSTR; nMaxCount:longint):longint; external 'user32' name 'GetWindowTextA';
+function GetWindowTextLength(hWnd:HWND):longint; external 'user32' name 'GetWindowTextLengthA';
+function MessageBox(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; external 'user32' name 'MessageBoxA';
+function MessageBoxEx(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT; wLanguageId:WORD):longint; external 'user32' name 'MessageBoxExA';
+function MessageBoxIndirect(_para1:LPMSGBOXPARAMS):longint; external 'user32' name 'MessageBoxIndirectA';
+function GetWindowLong(hWnd:HWND; nIndex:longint):LONG; external 'user32' name 'GetWindowLongA';
+function SetWindowLong(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG; external 'user32' name 'SetWindowLongA';
+function GetClassLong(hWnd:HWND; nIndex:longint):DWORD; external 'user32' name 'GetClassLongA';
+function SetClassLong(hWnd:HWND; nIndex:longint; dwNewLong:LONG):DWORD; external 'user32' name 'SetClassLongA';
+function FindWindow(lpClassName:LPCSTR; lpWindowName:LPCSTR):HWND; external 'user32' name 'FindWindowA';
+function FindWindowEx(_para1:HWND; _para2:HWND; _para3:LPCSTR; _para4:LPCSTR):HWND; external 'user32' name 'FindWindowExA';
+function GetClassName(hWnd:HWND; lpClassName:LPSTR; nMaxCount:longint):longint; external 'user32' name 'GetClassNameA';
+function SetWindowsHookEx(idHook:longint; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; external 'user32' name 'SetWindowsHookExA';
+function LoadBitmap(hInstance:HINST; lpBitmapName:LPCSTR):HBITMAP; external 'user32' name 'LoadBitmapA';
+function LoadCursor(hInstance:HINST; lpCursorName:LPCSTR):HCURSOR; external 'user32' name 'LoadCursorA';
+function LoadCursorFromFile(lpFileName:LPCSTR):HCURSOR; external 'user32' name 'LoadCursorFromFileA';
+function LoadIcon(hInstance:HINST; lpIconName:LPCSTR):HICON; external 'user32' name 'LoadIconA';
+function LoadImage(_para1:HINST; _para2:LPCSTR; _para3:UINT; _para4:longint; _para5:longint;_para6:UINT):HANDLE; external 'user32' name 'LoadImageA';
+function LoadString(hInstance:HINST; uID:UINT; lpBuffer:LPSTR; nBufferMax:longint):longint; external 'user32' name 'LoadStringA';
+function IsDialogMessage(hDlg:HWND; lpMsg:LPMSG):WINBOOL; external 'user32' name 'IsDialogMessageA';
+function DlgDirList(hDlg:HWND; lpPathSpec:LPSTR; nIDListBox:longint; nIDStaticPath:longint; uFileType:UINT):longint; external 'user32' name 'DlgDirListA';
+function DlgDirSelectEx(hDlg:HWND; lpString:LPSTR; nCount:longint; nIDListBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectExA';
+function DlgDirListComboBox(hDlg:HWND; lpPathSpec:LPSTR; nIDComboBox:longint; nIDStaticPath:longint; uFiletype:UINT):longint; external 'user32' name 'DlgDirListComboBoxA';
+function DlgDirSelectComboBoxEx(hDlg:HWND; lpString:LPSTR; nCount:longint; nIDComboBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectComboBoxExA';
+function DefFrameProc(hWnd:HWND; hWndMDIClient:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefFrameProcA';
+function DefMDIChildProc(hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefMDIChildProcA';
+function CreateMDIWindow(lpClassName:LPSTR; lpWindowName:LPSTR; dwStyle:DWORD; X:longint; Y:longint;nWidth:longint; nHeight:longint; hWndParent:HWND; hInstance:HINST; lParam:LPARAM):HWND; external 'user32' name 'CreateMDIWindowA';
+function WinHelp(hWndMain:HWND; lpszHelp:LPCSTR; uCommand:UINT; dwData:DWORD):WINBOOL; external 'user32' name 'WinHelpA';
+function ChangeDisplaySettings(lpDevMode:LPDEVMODE; dwFlags:DWORD):LONG; external 'user32' name 'ChangeDisplaySettingsA';
+function EnumDisplaySettings(lpszDeviceName:LPCSTR; iModeNum:DWORD; lpDevMode:LPDEVMODE):WINBOOL; external 'user32' name 'EnumDisplaySettingsA';
+function SystemParametersInfo(uiAction:UINT; uiParam:UINT; pvParam:PVOID; fWinIni:UINT):WINBOOL; external 'user32' name 'SystemParametersInfoA';
+function AddFontResource(_para1:LPCSTR):longint; external 'gdi32' name 'AddFontResourceA';
+function CopyMetaFile(_para1:HMETAFILE; _para2:LPCSTR):HMETAFILE; external 'gdi32' name 'CopyMetaFileA';
+function CreateFont(_para1:longint; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:DWORD; _para7:DWORD; _para8:DWORD; _para9:DWORD; _para10:DWORD;_para11:DWORD; _para12:DWORD; _para13:DWORD; _para14:LPCSTR):HFONT; external 'gdi32' name 'CreateFontA';
+function CreateFontIndirect(_para1:LPLOGFONT):HFONT; external 'gdi32' name 'CreateFontIndirectA';
+function CreateIC(_para1:LPCSTR; _para2:LPCSTR; _para3:LPCSTR; _para4:LPDEVMODE):HDC; external 'gdi32' name 'CreateICA';
+function CreateMetaFile(_para1:LPCSTR):HDC; external 'gdi32' name 'CreateMetaFileA';
+function CreateScalableFontResource(_para1:DWORD; _para2:LPCSTR; _para3:LPCSTR; _para4:LPCSTR):WINBOOL; external 'gdi32' name 'CreateScalableFontResourceA';
+function EnumFontFamiliesEx(_para1:HDC; _para2:LPLOGFONT; _para3:FONTENUMEXPROC; _para4:LPARAM; _para5:DWORD):longint; external 'gdi32' name 'EnumFontFamiliesExA';
+function EnumFontFamilies(_para1:HDC; _para2:LPCSTR; _para3:FONTENUMPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontFamiliesA';
+function EnumFonts(_para1:HDC; _para2:LPCSTR; _para3:ENUMFONTSPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontsA';
+function GetCharWidth(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidthA';
+function GetCharWidth32(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidth32A';
+function GetCharWidthFloat(_para1:HDC; _para2:UINT; _para3:UINT; _para4:PSingle):WINBOOL; external 'gdi32' name 'GetCharWidthFloatA';
+function GetCharABCWidths(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABC):WINBOOL; external 'gdi32' name 'GetCharABCWidthsA';
+function GetCharABCWidthsFloat(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABCFLOAT):WINBOOL; external 'gdi32' name 'GetCharABCWidthsFloatA';
+function GetGlyphOutline(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPGLYPHMETRICS; _para5:DWORD;_para6:LPVOID; _para7:PMAT2):DWORD; external 'gdi32' name 'GetGlyphOutlineA';
+function GetMetaFile(_para1:LPCSTR):HMETAFILE; external 'gdi32' name 'GetMetaFileA';
+function GetOutlineTextMetrics(_para1:HDC; _para2:UINT; _para3:LPOUTLINETEXTMETRIC):UINT; external 'gdi32' name 'GetOutlineTextMetricsA';
+function GetTextExtentPoint(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPointA';
+function GetTextExtentPoint32(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPoint32A';
+function GetTextExtentExPoint(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:longint; _para5:LPINT;_para6:LPINT; _para7:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentExPointA';
+function GetCharacterPlacement(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:longint; _para5:LPGCP_RESULTS;_para6:DWORD):DWORD; external 'gdi32' name 'GetCharacterPlacementA';
+function ResetDC(_para1:HDC; _para2:LPDEVMODE):HDC; external 'gdi32' name 'ResetDCA';
+function RemoveFontResource(_para1:LPCSTR):WINBOOL; external 'gdi32' name 'RemoveFontResourceA';
+function CopyEnhMetaFile(_para1:HENHMETAFILE; _para2:LPCSTR):HENHMETAFILE; external 'gdi32' name 'CopyEnhMetaFileA';
+function CreateEnhMetaFile(_para1:HDC; _para2:LPCSTR; _para3:LPRECT; _para4:LPCSTR):HDC; external 'gdi32' name 'CreateEnhMetaFileA';
+function GetEnhMetaFile(_para1:LPCSTR):HENHMETAFILE; external 'gdi32' name 'GetEnhMetaFileA';
+function GetEnhMetaFileDescription(_para1:HENHMETAFILE; _para2:UINT; _para3:LPSTR):UINT; external 'gdi32' name 'GetEnhMetaFileDescriptionA';
+function GetTextMetrics(_para1:HDC; _para2:LPTEXTMETRIC):WINBOOL; external 'gdi32' name 'GetTextMetricsA';
+function StartDoc(_para1:HDC; _para2:PDOCINFO):longint; external 'gdi32' name 'StartDocA';
+function GetObject(_para1:HGDIOBJ; _para2:longint; _para3:LPVOID):longint; external 'gdi32' name 'GetObjectA';
+function TextOut(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCSTR; _para5:longint):WINBOOL; external 'gdi32' name 'TextOutA';
+function ExtTextOut(_para1:HDC; _para2:longint; _para3:longint; _para4:UINT; _para5:LPRECT;_para6:LPCSTR; _para7:UINT; _para8:LPINT):WINBOOL; external 'gdi32' name 'ExtTextOutA';
+function PolyTextOut(_para1:HDC; _para2:PPOLYTEXT; _para3:longint):WINBOOL; external 'gdi32' name 'PolyTextOutA';
+function GetTextFace(_para1:HDC; _para2:longint; _para3:LPSTR):longint; external 'gdi32' name 'GetTextFaceA';
+function GetKerningPairs(_para1:HDC; _para2:DWORD; _para3:LPKERNINGPAIR):DWORD; external 'gdi32' name 'GetKerningPairsA';
+function CreateColorSpace(_para1:LPLOGCOLORSPACE):HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceA';
+function GetLogColorSpace(_para1:HCOLORSPACE; _para2:LPLOGCOLORSPACE; _para3:DWORD):WINBOOL; external 'gdi32' name 'GetLogColorSpaceA';
+function GetICMProfile(_para1:HDC; _para2:DWORD; _para3:LPSTR):WINBOOL; external 'gdi32' name 'GetICMProfileA';
+function SetICMProfile(_para1:HDC; _para2:LPSTR):WINBOOL; external 'gdi32' name 'SetICMProfileA';
+function UpdateICMRegKey(_para1:DWORD; _para2:DWORD; _para3:LPSTR; _para4:UINT):WINBOOL; external 'gdi32' name 'UpdateICMRegKeyA';
+function EnumICMProfiles(_para1:HDC; _para2:ICMENUMPROC; _para3:LPARAM):longint; external 'gdi32' name 'EnumICMProfilesA';
+function PropertySheet(lppsph:LPCPROPSHEETHEADER):longint; external 'comctl32' name 'PropertySheetA';
+function ImageList_LoadImage(hi:HINST; lpbmp:LPCSTR; cx:longint; cGrow:longint; crMask:COLORREF;uType:UINT; uFlags:UINT):HIMAGELIST; external 'comctl32' name 'ImageList_LoadImageA';
+function CreateStatusWindow(style:LONG; lpszText:LPCSTR; hwndParent:HWND; wID:UINT):HWND; external 'comctl32' name 'CreateStatusWindowA';
+procedure DrawStatusText(hDC:HDC; lprc:LPRECT; pszText:LPCSTR; uFlags:UINT); external 'comctl32' name 'DrawStatusTextA';
+function GetOpenFileName(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetOpenFileNameA';
+function GetSaveFileName(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetSaveFileNameA';
+function GetFileTitle(_para1:LPCSTR; _para2:LPSTR; _para3:WORD):integer; external 'comdlg32' name 'GetFileTitleA';
+function ChooseColor(_para1:LPCHOOSECOLOR):WINBOOL; external 'comdlg32' name 'ChooseColorA';
+function FindText(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'FindTextA';
+function ReplaceText(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'ReplaceTextA';
+function ChooseFont(_para1:LPCHOOSEFONT):WINBOOL; external 'comdlg32' name 'ChooseFontA';
+function PrintDlg(_para1:LPPRINTDLG):WINBOOL; external 'comdlg32' name 'PrintDlgA';
+function PageSetupDlg(_para1:LPPAGESETUPDLG):WINBOOL; external 'comdlg32' name 'PageSetupDlgA';
+function CreateProcess(lpApplicationName:LPCSTR; lpCommandLine:LPSTR; lpProcessAttributes:LPSECURITY_ATTRIBUTES; lpThreadAttributes:LPSECURITY_ATTRIBUTES; bInheritHandles:WINBOOL;dwCreationFlags:DWORD; lpEnvironment:LPVOID;
+ lpCurrentDirectory:LPCSTR; lpStartupInfo:LPSTARTUPINFO; lpProcessInformation:LPPROCESS_INFORMATION):WINBOOL; external 'kernel32' name 'CreateProcessA';
+procedure GetStartupInfo(lpStartupInfo:LPSTARTUPINFO); external 'kernel32' name 'GetStartupInfoA';
+function FindFirstFile(lpFileName:LPCSTR; lpFindFileData:LPWIN32_FIND_DATA):HANDLE; external 'kernel32' name 'FindFirstFileA';
+function FindNextFile(hFindFile:HANDLE; lpFindFileData:LPWIN32_FIND_DATA):WINBOOL; external 'kernel32' name 'FindNextFileA';
+function GetVersionEx(VersionInformation:LPOSVERSIONINFO):WINBOOL; external 'kernel32' name 'GetVersionExA';
+function CreateWindow(lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+function CreateDialog(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function CreateDialogIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function DialogBox(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function DialogBoxIndirect(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function CreateDC(_para1:LPCSTR; _para2:LPCSTR; _para3:LPCSTR; _para4:pDEVMODE):HDC; external 'gdi32' name 'CreateDCA';
+function VerInstallFile(uFlags:DWORD; szSrcFileName:LPSTR; szDestFileName:LPSTR; szSrcDir:LPSTR; szDestDir:LPSTR;szCurDir:LPSTR; szTmpFile:LPSTR; lpuTmpFileLen:PUINT):DWORD; external 'version' name 'VerInstallFileA';
+function GetFileVersionInfoSize(lptstrFilename:LPSTR; lpdwHandle:LPDWORD):DWORD; external 'version' name 'GetFileVersionInfoSizeA';
+function GetFileVersionInfo(lptstrFilename:LPSTR; dwHandle:DWORD; dwLen:DWORD; lpData:LPVOID):WINBOOL; external 'version' name 'GetFileVersionInfoA';
+function VerLanguageName(wLang:DWORD; szLang:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'VerLanguageNameA';
+function VerQueryValue(pBlock:LPVOID; lpSubBlock:LPSTR; lplpBuffer:LPVOID; puLen:PUINT):WINBOOL; external 'version' name 'VerQueryValueA';
+function VerFindFile(uFlags:DWORD; szFileName:LPSTR; szWinDir:LPSTR; szAppDir:LPSTR; szCurDir:LPSTR;lpuCurDirLen:PUINT; szDestDir:LPSTR; lpuDestDirLen:PUINT):DWORD; external 'version' name 'VerFindFileA';
+function RegConnectRegistry(lpMachineName:LPSTR; hKey:HKEY; phkResult:PHKEY):LONG; external 'advapi32' name 'RegConnectRegistryA';
+function RegCreateKey(hKey:HKEY; lpSubKey:LPCSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegCreateKeyA';
+function RegCreateKeyEx(hKey:HKEY; lpSubKey:LPCSTR; Reserved:DWORD; lpClass:LPSTR; dwOptions:DWORD;samDesired:REGSAM; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; phkResult:PHKEY; lpdwDisposition:LPDWORD):LONG;
+ external 'advapi32' name 'RegCreateKeyExA';
+function RegDeleteKey(hKey:HKEY; lpSubKey:LPCSTR):LONG; external 'advapi32' name 'RegDeleteKeyA';
+function RegDeleteValue(hKey:HKEY; lpValueName:LPCSTR):LONG; external 'advapi32' name 'RegDeleteValueA';
+function RegEnumKey(hKey:HKEY; dwIndex:DWORD; lpName:LPSTR; cbName:DWORD):LONG; external 'advapi32' name 'RegEnumKeyA';
+function RegEnumKeyEx(hKey:HKEY; dwIndex:DWORD; lpName:LPSTR; lpcbName:LPDWORD; lpReserved:LPDWORD;lpClass:LPSTR; lpcbClass:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegEnumKeyExA';
+function RegEnumValue(hKey:HKEY; dwIndex:DWORD; lpValueName:LPSTR; lpcbValueName:LPDWORD; lpReserved:LPDWORD;lpType:LPDWORD; lpData:LPBYTE; lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegEnumValueA';
+function RegLoadKey(hKey:HKEY; lpSubKey:LPCSTR; lpFile:LPCSTR):LONG; external 'advapi32' name 'RegLoadKeyA';
+function RegOpenKey(hKey:HKEY; lpSubKey:LPCSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyA';
+function RegOpenKeyEx(hKey:HKEY; lpSubKey:LPCSTR; ulOptions:DWORD; samDesired:REGSAM; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyExA';
+function RegQueryInfoKey(hKey:HKEY; lpClass:LPSTR; lpcbClass:LPDWORD; lpReserved:LPDWORD; lpcSubKeys:LPDWORD;lpcbMaxSubKeyLen:LPDWORD; lpcbMaxClassLen:LPDWORD; lpcValues:LPDWORD; lpcbMaxValueNameLen:LPDWORD;
+ lpcbMaxValueLen:LPDWORD;lpcbSecurityDescriptor:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegQueryInfoKeyA';
+function RegQueryValue(hKey:HKEY; lpSubKey:LPCSTR; lpValue:LPSTR; lpcbValue:PLONG):LONG; external 'advapi32' name 'RegQueryValueA';
+function RegQueryMultipleValues(hKey:HKEY; val_list:PVALENT; num_vals:DWORD; lpValueBuf:LPSTR; ldwTotsize:LPDWORD):LONG; external 'advapi32' name 'RegQueryMultipleValuesA';
+function RegQueryValueEx(hKey:HKEY; lpValueName:LPCSTR; lpReserved:LPDWORD; lpType:LPDWORD; lpData:LPBYTE;lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegQueryValueExA';
+function RegReplaceKey(hKey:HKEY; lpSubKey:LPCSTR; lpNewFile:LPCSTR; lpOldFile:LPCSTR):LONG; external 'advapi32' name 'RegReplaceKeyA';
+function RegRestoreKey(hKey:HKEY; lpFile:LPCSTR; dwFlags:DWORD):LONG; external 'advapi32' name 'RegRestoreKeyA';
+function RegSaveKey(hKey:HKEY; lpFile:LPCSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):LONG; external 'advapi32' name 'RegSaveKeyA';
+function RegSetValue(hKey:HKEY; lpSubKey:LPCSTR; dwType:DWORD; lpData:LPCSTR; cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueA';
+function RegSetValueEx(hKey:HKEY; lpValueName:LPCSTR; Reserved:DWORD; dwType:DWORD; lpData:LPBYTE;cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueExA';
+function RegUnLoadKey(hKey:HKEY; lpSubKey:LPCSTR):LONG; external 'advapi32' name 'RegUnLoadKeyA';
+function InitiateSystemShutdown(lpMachineName:LPSTR; lpMessage:LPSTR; dwTimeout:DWORD; bForceAppsClosed:WINBOOL; bRebootAfterShutdown:WINBOOL):WINBOOL; external 'advapi32' name 'InitiateSystemShutdownA';
+function AbortSystemShutdown(lpMachineName:LPSTR):WINBOOL; external 'advapi32' name 'AbortSystemShutdownA';
+function CompareString(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCSTR; cchCount1:longint; lpString2:LPCSTR;cchCount2:longint):longint; external 'kernel32' name 'CompareStringA';
+function LCMapString(Locale:LCID; dwMapFlags:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpDestStr:LPSTR;cchDest:longint):longint; external 'kernel32' name 'LCMapStringA';
+function GetLocaleInfo(Locale:LCID; LCType:LCTYPE; lpLCData:LPSTR; cchData:longint):longint; external 'kernel32' name 'GetLocaleInfoA';
+function SetLocaleInfo(Locale:LCID; LCType:LCTYPE; lpLCData:LPCSTR):WINBOOL; external 'kernel32' name 'SetLocaleInfoA';
+function GetTimeFormat(Locale:LCID; dwFlags:DWORD; lpTime:LPSYSTEMTIME; lpFormat:LPCSTR; lpTimeStr:LPSTR;cchTime:longint):longint; external 'kernel32' name 'GetTimeFormatA';
+function GetDateFormat(Locale:LCID; dwFlags:DWORD; lpDate:LPSYSTEMTIME; lpFormat:LPCSTR; lpDateStr:LPSTR;cchDate:longint):longint; external 'kernel32' name 'GetDateFormatA';
+function GetNumberFormat(Locale:LCID; dwFlags:DWORD; lpValue:LPCSTR; lpFormat:PNUMBERFMT; lpNumberStr:LPSTR;cchNumber:longint):longint; external 'kernel32' name 'GetNumberFormatA';
+function GetCurrencyFormat(Locale:LCID; dwFlags:DWORD; lpValue:LPCSTR; lpFormat:PCURRENCYFMT; lpCurrencyStr:LPSTR;cchCurrency:longint):longint; external 'kernel32' name 'GetCurrencyFormatA';
+function EnumCalendarInfo(lpCalInfoEnumProc:CALINFO_ENUMPROC; Locale:LCID; Calendar:CALID; CalType:CALTYPE):WINBOOL; external 'kernel32' name 'EnumCalendarInfoA';
+function EnumTimeFormats(lpTimeFmtEnumProc:TIMEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumTimeFormatsA';
+function EnumDateFormats(lpDateFmtEnumProc:DATEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumDateFormatsA';
+function GetStringTypeEx(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeExA';
+function GetStringType(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeA';
+function FoldString(dwMapFlags:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpDestStr:LPSTR; cchDest:longint):longint; external 'kernel32' name 'FoldStringA';
+function EnumSystemLocales(lpLocaleEnumProc:LOCALE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemLocalesA';
+function EnumSystemCodePages(lpCodePageEnumProc:CODEPAGE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemCodePagesA';
+function PeekConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'PeekConsoleInputA';
+function ReadConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleInputA';
+function WriteConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleInputA';
+function ReadConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpReadRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'ReadConsoleOutputA';
+function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpWriteRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputA';
+function ReadConsoleOutputCharacter(hConsoleOutput:HANDLE; lpCharacter:LPSTR; nLength:DWORD; dwReadCoord:COORD; lpNumberOfCharsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputCharacterA';
+function WriteConsoleOutputCharacter(hConsoleOutput:HANDLE; lpCharacter:LPCSTR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputCharacterA';
+function FillConsoleOutputCharacter(hConsoleOutput:HANDLE; cCharacter:CHAR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputCharacterA';
+function ScrollConsoleScreenBuffer(hConsoleOutput:HANDLE; lpScrollRectangle:PSMALL_RECT; lpClipRectangle:PSMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):WINBOOL; external 'kernel32' name 'ScrollConsoleScreenBufferA';
+function GetConsoleTitle(lpConsoleTitle:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetConsoleTitleA';
+function SetConsoleTitle(lpConsoleTitle:LPCSTR):WINBOOL; external 'kernel32' name 'SetConsoleTitleA';
+function ReadConsole(hConsoleInput:HANDLE; lpBuffer:LPVOID; nNumberOfCharsToRead:DWORD; lpNumberOfCharsRead:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'ReadConsoleA';
+function WriteConsole(hConsoleOutput:HANDLE;lpBuffer:pointer; nNumberOfCharsToWrite:DWORD; lpNumberOfCharsWritten:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'WriteConsoleA';
+function WNetAddConnection(lpRemoteName:LPCSTR; lpPassword:LPCSTR; lpLocalName:LPCSTR):DWORD; external 'mpr' name 'WNetAddConnectionA';
+function WNetAddConnection2(lpNetResource:LPNETRESOURCE; lpPassword:LPCSTR; lpUserName:LPCSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection2A';
+function WNetAddConnection3(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpPassword:LPCSTR; lpUserName:LPCSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection3A';
+function WNetCancelConnection(lpName:LPCSTR; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnectionA';
+function WNetCancelConnection2(lpName:LPCSTR; dwFlags:DWORD; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnection2A';
+function WNetGetConnection(lpLocalName:LPCSTR; lpRemoteName:LPSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetConnectionA';
+function WNetUseConnection(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpUserID:LPCSTR; lpPassword:LPCSTR; dwFlags:DWORD;lpAccessName:LPSTR; lpBufferSize:LPDWORD; lpResult:LPDWORD):DWORD; external 'mpr' name 'WNetUseConnectionA';
+function WNetSetConnection(lpName:LPCSTR; dwProperties:DWORD; pvValues:LPVOID):DWORD; external 'mpr' name 'WNetSetConnectionA';
+function WNetConnectionDialog1(lpConnDlgStruct:LPCONNECTDLGSTRUCT):DWORD; external 'mpr' name 'WNetConnectionDialog1A';
+function WNetDisconnectDialog1(lpConnDlgStruct:LPDISCDLGSTRUCT):DWORD; external 'mpr' name 'WNetDisconnectDialog1A';
+function WNetOpenEnum(dwScope:DWORD; dwType:DWORD; dwUsage:DWORD; lpNetResource:LPNETRESOURCE; lphEnum:LPHANDLE):DWORD; external 'mpr' name 'WNetOpenEnumA';
+function WNetEnumResource(hEnum:HANDLE; lpcCount:LPDWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetEnumResourceA';
+function WNetGetUniversalName(lpLocalPath:LPCSTR; dwInfoLevel:DWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetUniversalNameA';
+function WNetGetUser(lpName:LPCSTR; lpUserName:LPSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetUserA';
+function WNetGetProviderName(dwNetType:DWORD; lpProviderName:LPSTR; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetProviderNameA';
+function WNetGetNetworkInformation(lpProvider:LPCSTR; lpNetInfoStruct:LPNETINFOSTRUCT):DWORD; external 'mpr' name 'WNetGetNetworkInformationA';
+function WNetGetLastError(lpError:LPDWORD; lpErrorBuf:LPSTR; nErrorBufSize:DWORD; lpNameBuf:LPSTR; nNameBufSize:DWORD):DWORD; external 'mpr' name 'WNetGetLastErrorA';
+function MultinetGetConnectionPerformance(lpNetResource:LPNETRESOURCE; lpNetConnectInfoStruct:LPNETCONNECTINFOSTRUCT):DWORD; external 'mpr' name 'MultinetGetConnectionPerformanceA';
+function ChangeServiceConfig(hService:SC_HANDLE; dwServiceType:DWORD; dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCSTR;lpLoadOrderGroup:LPCSTR; lpdwTagId:LPDWORD; lpDependencies:LPCSTR; lpServiceStartName:LPCSTR;
+ lpPassword:LPCSTR;lpDisplayName:LPCSTR):WINBOOL; external 'advapi32' name 'ChangeServiceConfigA';
+function CreateService(hSCManager:SC_HANDLE; lpServiceName:LPCSTR; lpDisplayName:LPCSTR; dwDesiredAccess:DWORD; dwServiceType:DWORD;dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCSTR; lpLoadOrderGroup:LPCSTR;
+ lpdwTagId:LPDWORD;lpDependencies:LPCSTR; lpServiceStartName:LPCSTR; lpPassword:LPCSTR):SC_HANDLE; external 'advapi32' name 'CreateServiceA';
+function EnumDependentServices(hService:SC_HANDLE; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD;lpServicesReturned:LPDWORD):WINBOOL; external 'advapi32' name 'EnumDependentServicesA';
+function EnumServicesStatus(hSCManager:SC_HANDLE; dwServiceType:DWORD; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD;pcbBytesNeeded:LPDWORD; lpServicesReturned:LPDWORD; lpResumeHandle:LPDWORD):WINBOOL;
+ external 'advapi32' name 'EnumServicesStatusA';
+function GetServiceKeyName(hSCManager:SC_HANDLE; lpDisplayName:LPCSTR; lpServiceName:LPSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceKeyNameA';
+function GetServiceDisplayName(hSCManager:SC_HANDLE; lpServiceName:LPCSTR; lpDisplayName:LPSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceDisplayNameA';
+function OpenSCManager(lpMachineName:LPCSTR; lpDatabaseName:LPCSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenSCManagerA';
+function OpenService(hSCManager:SC_HANDLE; lpServiceName:LPCSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenServiceA';
+function QueryServiceConfig(hService:SC_HANDLE; lpServiceConfig:LPQUERY_SERVICE_CONFIG; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceConfigA';
+function QueryServiceLockStatus(hSCManager:SC_HANDLE; lpLockStatus:LPQUERY_SERVICE_LOCK_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceLockStatusA';
+function RegisterServiceCtrlHandler(lpServiceName:LPCSTR; lpHandlerProc:LPHANDLER_FUNCTION):SERVICE_STATUS_HANDLE; external 'advapi32' name 'RegisterServiceCtrlHandlerA';
+function StartServiceCtrlDispatcher(lpServiceStartTable:LPSERVICE_TABLE_ENTRY):WINBOOL; external 'advapi32' name 'StartServiceCtrlDispatcherA';
+function StartService(hService:SC_HANDLE; dwNumServiceArgs:DWORD; lpServiceArgVectors:LPCSTR):WINBOOL; external 'advapi32' name 'StartServiceA';
+function DragQueryFile(_para1:HDROP; _para2:cardinal; _para3:Pchar;_para4:cardinal):cardinal; external 'shell32' name 'DragQueryFileA';
+function ExtractAssociatedIcon(_para1:HINST; _para2:Pchar; _para3:LPWORD):HICON; external 'shell32' name 'ExtractAssociatedIconA';
+function ExtractIcon(_para1:HINST; _para2:Pchar; _para3:cardinal):HICON;external 'shell32' name 'ExtractIconA';
+function FindExecutable(_para1:pchar; _para2:pchar;_para3:pchar):HINST; external 'shell32' name 'FindExecutableA';
+function ShellAbout(_para1:HWND; _para2:pchar; _para3:pchar;_para4:HICON):longint; external 'shell32' name 'ShellAboutA';
+function ShellExecute(_para1:HWND; _para2:pchar; _para3:pchar;_para4:pchar; _para5:pchar;_para6:longint):HINST; external 'shell32' name 'ShellExecuteA';
+function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconDataA): BOOL; external 'shell32' name 'Shell_NotifyIconA';
+function DdeCreateStringHandle(_para1:DWORD; _para2:pchar;_para3:longint):HSZ; external 'user32' name 'DdeCreateStringHandleA';
+function DdeInitialize(_para1:LPDWORD; _para2:PFNCALLBACK; _para3:DWORD; _para4:DWORD):UINT;external 'user32' name 'DdeInitializeA';
+function DdeQueryString(_para1:DWORD; _para2:HSZ; _para3:pchar;_para4:DWORD; _para5:longint):DWORD; external 'user32' name 'DdeQueryStringA';
+function LogonUser(_para1:LPSTR; _para2:LPSTR; _para3:LPSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserA';
+function CreateProcessAsUser(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCTSTR;
+ _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+function CreateWindow(lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+begin
+ CreateWindow:=CreateWindowEx(0,lpClassName,lpWindowName,dwStyle,x,y,nWidth,nHeight,hWndParent,hMenu,hInstance,lpParam);
+end;
+
+function CreateDialog(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialog:=CreateDialogParam(hInstance,lpTemplateName,hWndParent,lpDialogFunc,0);
+end;
+
+function CreateDialogIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialogIndirect:=CreateDialogIndirectParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBox(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBox:=DialogBoxParam(hInstance,lpTemplateName,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBoxIndirect(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBoxIndirect:=DialogBoxIndirectParam(hInstance,hDialogTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+{$endif read_implementation}
+
+{
+ $Log: ascdef.inc,v $
+ Revision 1.10 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/ascdef.sed b/rtl/win32/wininc/ascdef.sed
new file mode 100644
index 0000000000..791266a0df
--- /dev/null
+++ b/rtl/win32/wininc/ascdef.sed
@@ -0,0 +1,21 @@
+# function names with parameters
+s/function \([^(]*\)A *(/function \1(/
+# procedure names with parameters
+s/procedure \([^(]*\)A *(/procedure \1(/
+# function names without parameters
+s/function \([^:(]*\)A *: */function \1 : /
+# procedure names without parameters
+s/procedure \([^;(]*\)A *;/procedure \1;/
+# function return value
+s/\([^ \t]*\)A *:=/\1:=/
+# function call with parameters
+s/\:=\(.*\)A(/:=\1(/
+# function call without parameters
+s/\:=\(.*\)A *;/:=\1;/
+# unit name
+s/ascfun;/ascdef;/
+# cvs name
+s/ascfun.inc,v/ascdef.inc,v/
+# unit conditionnal
+s/ASCIIFUNCTIONS/ASCIIFUNCTIONSDEFAULT/
+
diff --git a/rtl/win32/wininc/ascfun.inc b/rtl/win32/wininc/ascfun.inc
new file mode 100644
index 0000000000..ff09880bd9
--- /dev/null
+++ b/rtl/win32/wininc/ascfun.inc
@@ -0,0 +1,500 @@
+{
+ $Id: ascfun.inc,v 1.11 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Contains the Ascii functions for windows unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ ASCIIFunctions.h
+
+ Declarations for all the Win32 ASCII Functions
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+function GetBinaryTypeA(lpApplicationName:LPCSTR; lpBinaryType:LPDWORD):WINBOOL; external 'kernel32' name 'GetBinaryTypeA';
+function GetShortPathNameA(lpszLongPath:LPCSTR; lpszShortPath:LPSTR; cchBuffer:DWORD):DWORD; external 'kernel32' name 'GetShortPathNameA';
+function GetEnvironmentStringsA:LPSTR; external 'kernel32' name 'GetEnvironmentStringsA';
+function FreeEnvironmentStringsA(_para1:LPSTR):WINBOOL; external 'kernel32' name 'FreeEnvironmentStringsA';
+function FormatMessageA(dwFlags:DWORD; lpSource:LPCVOID; dwMessageId:DWORD; dwLanguageId:DWORD; lpBuffer:LPSTR;nSize:DWORD; Arguments:va_list):DWORD; external 'kernel32' name 'FormatMessageA';
+function CreateMailslotA(lpName:LPCSTR; nMaxMessageSize:DWORD; lReadTimeout:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE; external 'kernel32' name 'CreateMailslotA';
+function lstrcmpA(lpString1:LPCSTR; lpString2:LPCSTR):longint; external 'kernel32' name 'lstrcmpA';
+function lstrcmpiA(lpString1:LPCSTR; lpString2:LPCSTR):longint; external 'kernel32' name 'lstrcmpiA';
+function lstrcpynA(lpString1:LPSTR; lpString2:LPCSTR; iMaxLength:longint):LPSTR; external 'kernel32' name 'lstrcpynA';
+function lstrcpyA(lpString1:LPSTR; lpString2:LPCSTR):LPSTR; external 'kernel32' name 'lstrcpyA';
+function lstrcatA(lpString1:LPSTR; lpString2:LPCSTR):LPSTR; external 'kernel32' name 'lstrcatA';
+function lstrlenA(lpString:LPCSTR):longint; external 'kernel32' name 'lstrlenA';
+function CreateMutexA(lpMutexAttributes:LPSECURITY_ATTRIBUTES; bInitialOwner:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateMutexA';
+function OpenMutexA(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenMutexA';
+function CreateEventA(lpEventAttributes:LPSECURITY_ATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateEventA';
+function OpenEventA(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenEventA';
+function CreateSemaphoreA(lpSemaphoreAttributes:LPSECURITY_ATTRIBUTES; lInitialCount:LONG; lMaximumCount:LONG; lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateSemaphoreA';
+function OpenSemaphoreA(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenSemaphoreA';
+function CreateFileMappingA(hFile:HANDLE; lpFileMappingAttributes:LPSECURITY_ATTRIBUTES; flProtect:DWORD; dwMaximumSizeHigh:DWORD; dwMaximumSizeLow:DWORD;lpName:LPCSTR):HANDLE; external 'kernel32' name 'CreateFileMappingA';
+function OpenFileMappingA(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCSTR):HANDLE; external 'kernel32' name 'OpenFileMappingA';
+function GetLogicalDriveStringsA(nBufferLength:DWORD; lpBuffer:LPSTR):DWORD; external 'kernel32' name 'GetLogicalDriveStringsA';
+function LoadLibraryA(lpLibFileName:LPCSTR):HINST; external 'kernel32' name 'LoadLibraryA';
+function LoadLibraryExA(lpLibFileName:LPCSTR; hFile:HANDLE; dwFlags:DWORD):HINST; external 'kernel32' name 'LoadLibraryExA';
+function GetModuleFileNameA(hModule:HINST; lpFilename:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetModuleFileNameA';
+function GetModuleHandleA(lpModuleName:LPCSTR):HMODULE; external 'kernel32' name 'GetModuleHandleA';
+procedure FatalAppExitA(uAction:UINT; lpMessageText:LPCSTR); external 'kernel32' name 'FatalAppExitA';
+function GetCommandLineA:LPSTR; external 'kernel32' name 'GetCommandLineA';
+function GetEnvironmentVariableA(lpName:LPCSTR; lpBuffer:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetEnvironmentVariableA';
+function SetEnvironmentVariableA(lpName:LPCSTR; lpValue:LPCSTR):WINBOOL; external 'kernel32' name 'SetEnvironmentVariableA';
+function ExpandEnvironmentStringsA(lpSrc:LPCSTR; lpDst:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'ExpandEnvironmentStringsA';
+procedure OutputDebugStringA(lpOutputString:LPCSTR); external 'kernel32' name 'OutputDebugStringA';
+function FindResourceA(hModule:HINST; lpName:LPCSTR; lpType:LPCSTR):HRSRC; external 'kernel32' name 'FindResourceA';
+function FindResourceExA(hModule:HINST; lpType:LPCSTR; lpName:LPCSTR; wLanguage:WORD):HRSRC; external 'kernel32' name 'FindResourceExA';
+function EnumResourceTypesA(hModule:HINST; lpEnumFunc:ENUMRESTYPEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceTypesA';
+function EnumResourceNamesA(hModule:HINST; lpType:LPCSTR; lpEnumFunc:ENUMRESNAMEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceNamesA';
+function EnumResourceLanguagesA(hModule:HINST; lpType:LPCSTR; lpName:LPCSTR; lpEnumFunc:ENUMRESLANGPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceLanguagesA';
+function BeginUpdateResourceA(pFileName:LPCSTR; bDeleteExistingResources:WINBOOL):HANDLE; external 'kernel32' name 'BeginUpdateResourceA';
+function UpdateResourceA(hUpdate:HANDLE; lpType:LPCSTR; lpName:LPCSTR; wLanguage:WORD; lpData:LPVOID;cbData:DWORD):WINBOOL; external 'kernel32' name 'UpdateResourceA';
+function EndUpdateResourceA(hUpdate:HANDLE; fDiscard:WINBOOL):WINBOOL; external 'kernel32' name 'EndUpdateResourceA';
+function GlobalAddAtomA(lpString:LPCSTR):ATOM; external 'kernel32' name 'GlobalAddAtomA';
+function GlobalFindAtomA(lpString:LPCSTR):ATOM; external 'kernel32' name 'GlobalFindAtomA';
+function GlobalGetAtomNameA(nAtom:ATOM; lpBuffer:LPSTR; nSize:longint):UINT; external 'kernel32' name 'GlobalGetAtomNameA';
+function AddAtomA(lpString:LPCSTR):ATOM; external 'kernel32' name 'AddAtomA';
+function FindAtomA(lpString:LPCSTR):ATOM; external 'kernel32' name 'FindAtomA';
+function GetAtomNameA(nAtom:ATOM; lpBuffer:LPSTR; nSize:longint):UINT; external 'kernel32' name 'GetAtomNameA';
+function GetProfileIntA(lpAppName:LPCSTR; lpKeyName:LPCSTR; nDefault:WINT):UINT; external 'kernel32' name 'GetProfileIntA';
+function GetProfileStringA(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpDefault:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileStringA';
+function WriteProfileStringA(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpString:LPCSTR):WINBOOL; external 'kernel32' name 'WriteProfileStringA';
+function GetProfileSectionA(lpAppName:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileSectionA';
+function WriteProfileSectionA(lpAppName:LPCSTR; lpString:LPCSTR):WINBOOL; external 'kernel32' name 'WriteProfileSectionA';
+function GetPrivateProfileIntA(lpAppName:LPCSTR; lpKeyName:LPCSTR; nDefault:WINT; lpFileName:LPCSTR):UINT; external 'kernel32' name 'GetPrivateProfileIntA';
+function GetPrivateProfileStringA(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpDefault:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD;lpFileName:LPCSTR):DWORD; external 'kernel32' name 'GetPrivateProfileStringA';
+function WritePrivateProfileStringA(lpAppName:LPCSTR; lpKeyName:LPCSTR; lpString:LPCSTR; lpFileName:LPCSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileStringA';
+function GetPrivateProfileSectionA(lpAppName:LPCSTR; lpReturnedString:LPSTR; nSize:DWORD; lpFileName:LPCSTR):DWORD; external 'kernel32' name 'GetPrivateProfileSectionA';
+function WritePrivateProfileSectionA(lpAppName:LPCSTR; lpString:LPCSTR; lpFileName:LPCSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileSectionA';
+function GetDriveTypeA(lpRootPathName:LPCSTR):UINT; external 'kernel32' name 'GetDriveTypeA';
+function GetSystemDirectoryA(lpBuffer:LPSTR; uSize:UINT):UINT; external 'kernel32' name 'GetSystemDirectoryA';
+function GetTempPathA(nBufferLength:DWORD; lpBuffer:LPSTR):DWORD; external 'kernel32' name 'GetTempPathA';
+function GetTempFileNameA(lpPathName:LPCSTR; lpPrefixString:LPCSTR; uUnique:UINT; lpTempFileName:LPSTR):UINT; external 'kernel32' name 'GetTempFileNameA';
+function GetWindowsDirectoryA(lpBuffer:LPSTR; uSize:UINT):UINT; external 'kernel32' name 'GetWindowsDirectoryA';
+function SetCurrentDirectoryA(lpPathName:LPCSTR):WINBOOL; external 'kernel32' name 'SetCurrentDirectoryA';
+function GetCurrentDirectoryA(nBufferLength:DWORD; lpBuffer:LPSTR):DWORD; external 'kernel32' name 'GetCurrentDirectoryA';
+function GetDiskFreeSpaceA(lpRootPathName:LPCSTR; lpSectorsPerCluster:LPDWORD; lpBytesPerSector:LPDWORD; lpNumberOfFreeClusters:LPDWORD; lpTotalNumberOfClusters:LPDWORD):WINBOOL; external 'kernel32' name 'GetDiskFreeSpaceA';
+function CreateDirectoryA(lpPathName:LPCSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryA';
+function CreateDirectoryExA(lpTemplateDirectory:LPCSTR; lpNewDirectory:LPCSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryExA';
+function RemoveDirectoryA(lpPathName:LPCSTR):WINBOOL; external 'kernel32' name 'RemoveDirectoryA';
+function GetFullPathNameA(lpFileName:LPCSTR; nBufferLength:DWORD; lpBuffer:LPSTR; var lpFilePart:LPSTR):DWORD; external 'kernel32' name 'GetFullPathNameA';
+function DefineDosDeviceA(dwFlags:DWORD; lpDeviceName:LPCSTR; lpTargetPath:LPCSTR):WINBOOL; external 'kernel32' name 'DefineDosDeviceA';
+function QueryDosDeviceA(lpDeviceName:LPCSTR; lpTargetPath:LPSTR; ucchMax:DWORD):DWORD; external 'kernel32' name 'QueryDosDeviceA';
+function CreateFileA(lpFileName:LPCSTR; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; dwCreationDisposition:DWORD;dwFlagsAndAttributes:DWORD; hTemplateFile:HANDLE):HANDLE; external 'kernel32' name 'CreateFileA';
+function SetFileAttributesA(lpFileName:LPCSTR; dwFileAttributes:DWORD):WINBOOL; external 'kernel32' name 'SetFileAttributesA';
+function GetFileAttributesA(lpFileName:LPCSTR):DWORD; external 'kernel32' name 'GetFileAttributesA';
+function GetCompressedFileSizeA(lpFileName:LPCSTR; lpFileSizeHigh:LPDWORD):DWORD; external 'kernel32' name 'GetCompressedFileSizeA';
+function DeleteFileA(lpFileName:LPCSTR):WINBOOL; external 'kernel32' name 'DeleteFileA';
+function SearchPathA(lpPath:LPCSTR; lpFileName:LPCSTR; lpExtension:LPCSTR; nBufferLength:DWORD; lpBuffer:LPSTR;lpFilePart:LPSTR):DWORD; external 'kernel32' name 'SearchPathA';
+function CopyFileA(lpExistingFileName:LPCSTR; lpNewFileName:LPCSTR; bFailIfExists:WINBOOL):WINBOOL; external 'kernel32' name 'CopyFileA';
+function MoveFileA(lpExistingFileName:LPCSTR; lpNewFileName:LPCSTR):WINBOOL; external 'kernel32' name 'MoveFileA';
+function MoveFileExA(lpExistingFileName:LPCSTR; lpNewFileName:LPCSTR; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'MoveFileExA';
+function CreateNamedPipeA(lpName:LPCSTR; dwOpenMode:DWORD; dwPipeMode:DWORD; nMaxInstances:DWORD; nOutBufferSize:DWORD;nInBufferSize:DWORD; nDefaultTimeOut:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE;
+ external 'kernel32' name 'CreateNamedPipeA';
+function GetNamedPipeHandleStateA(hNamedPipe:HANDLE; lpState:LPDWORD; lpCurInstances:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD;lpUserName:LPSTR; nMaxUserNameSize:DWORD):WINBOOL;
+ external 'kernel32' name 'GetNamedPipeHandleStateA';
+function CallNamedPipeA(lpNamedPipeName:LPCSTR; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'CallNamedPipeA';
+function WaitNamedPipeA(lpNamedPipeName:LPCSTR; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'WaitNamedPipeA';
+function SetVolumeLabelA(lpRootPathName:LPCSTR; lpVolumeName:LPCSTR):WINBOOL; external 'kernel32' name 'SetVolumeLabelA';
+function GetVolumeInformationA(lpRootPathName:LPCSTR; lpVolumeNameBuffer:LPSTR; nVolumeNameSize:DWORD; lpVolumeSerialNumber:LPDWORD; lpMaximumComponentLength:LPDWORD;lpFileSystemFlags:LPDWORD;
+ lpFileSystemNameBuffer:LPSTR; nFileSystemNameSize:DWORD):WINBOOL; external 'kernel32' name 'GetVolumeInformationA';
+function ClearEventLogA(hEventLog:HANDLE; lpBackupFileName:LPCSTR):WINBOOL; external 'advapi32' name 'ClearEventLogA';
+function BackupEventLogA(hEventLog:HANDLE; lpBackupFileName:LPCSTR):WINBOOL; external 'advapi32' name 'BackupEventLogA';
+function OpenEventLogA(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; external 'advapi32' name 'OpenEventLogA';
+function RegisterEventSourceA(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceA';
+function OpenBackupEventLogA(lpUNCServerName:LPCSTR; lpFileName:LPCSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogA';
+function ReadEventLogA(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogA';
+function ReportEventA(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventA';
+function AccessCheckAndAuditAlarmA(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING;
+ ObjectCreation:WINBOOL; GrantedAccess:LPDWORD;AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
+function ObjectOpenAuditAlarmA(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;
+ Privileges:PPRIVILEGE_SET; ObjectCreation:WINBOOL;AccessGranted:WINBOOL; GenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'ObjectOpenAuditAlarmA';
+function ObjectPrivilegeAuditAlarmA(SubsystemName:LPCSTR; HandleId:LPVOID; ClientToken:HANDLE; DesiredAccess:DWORD; Privileges:PPRIVILEGE_SET;AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmA';
+function ObjectCloseAuditAlarmA(SubsystemName:LPCSTR; HandleId:LPVOID; GenerateOnClose:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectCloseAuditAlarmA';
+function PrivilegedServiceAuditAlarmA(SubsystemName:LPCSTR; ServiceName:LPCSTR; ClientToken:HANDLE; Privileges:PPRIVILEGE_SET; AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmA';
+function SetFileSecurityA(lpFileName:LPCSTR; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetFileSecurityA';
+function GetFileSecurityA(lpFileName:LPCSTR; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetFileSecurityA';
+function FindFirstChangeNotificationA(lpPathName:LPCSTR; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD):HANDLE; external 'kernel32' name 'FindFirstChangeNotificationA';
+function IsBadStringPtrA(lpsz:LPCSTR; ucchMax:UINT):WINBOOL; external 'kernel32' name 'IsBadStringPtrA';
+function LookupAccountSidA(lpSystemName:LPCSTR; Sid:PSID; Name:LPSTR; cbName:LPDWORD; ReferencedDomainName:LPSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountSidA';
+function LookupAccountNameA(lpSystemName:LPCSTR; lpAccountName:LPCSTR; Sid:PSID; cbSid:LPDWORD; ReferencedDomainName:LPSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountNameA';
+function LookupPrivilegeValueA(lpSystemName:LPCSTR; lpName:LPCSTR; lpLuid:PLUID):WINBOOL; external 'advapi32' name 'LookupPrivilegeValueA';
+function LookupPrivilegeNameA(lpSystemName:LPCSTR; lpLuid:PLUID; lpName:LPSTR; cbName:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeNameA';
+function LookupPrivilegeDisplayNameA(lpSystemName:LPCSTR; lpName:LPCSTR; lpDisplayName:LPSTR; cbDisplayName:LPDWORD; lpLanguageId:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameA';
+function BuildCommDCBA(lpDef:LPCSTR; lpDCB:LPDCB):WINBOOL; external 'kernel32' name 'BuildCommDCBA';
+function BuildCommDCBAndTimeoutsA(lpDef:LPCSTR; lpDCB:LPDCB; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsA';
+function CommConfigDialogA(lpszName:LPCSTR; hWnd:HWND; lpCC:LPCOMMCONFIG):WINBOOL; external 'kernel32' name 'CommConfigDialogA';
+function GetDefaultCommConfigA(lpszName:LPCSTR; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetDefaultCommConfigA';
+function SetDefaultCommConfigA(lpszName:LPCSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetDefaultCommConfigA';
+function GetComputerNameA(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameA';
+function SetComputerNameA(lpComputerName:LPCSTR):WINBOOL; external 'kernel32' name 'SetComputerNameA';
+function GetUserNameA(lpBuffer:LPSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameA';
+function wvsprintfA(_para1:LPSTR; _para2:LPCSTR; arglist:va_list):longint; external 'user32' name 'wvsprintfA';
+function wsprintfA(_para1:LPSTR; _para2:LPCSTR; const args:array of const):longint; cdecl; external 'user32' name 'wsprintfA';
+function wsprintfA(_para1:LPSTR; _para2:LPCSTR):longint; external 'user32' name 'wsprintfA';
+function wsprintf(_para1:LPSTR; _para2:LPCSTR; const args:array of const):longint; external 'user32' name 'wsprintfA';
+function wsprintf(_para1:LPSTR; _para2:LPCSTR):longint; cdecl; external 'user32' name 'wsprintfA';
+function LoadKeyboardLayoutA(pwszKLID:LPCSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutA';
+function GetKeyboardLayoutNameA(pwszKLID:LPSTR):WINBOOL; external 'user32' name 'GetKeyboardLayoutNameA';
+function CreateDesktopA(lpszDesktop:LPSTR; lpszDevice:LPSTR; pDevmode:LPDEVMODE; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopA';
+function OpenDesktopA(lpszDesktop:LPSTR; dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenDesktopA';
+function EnumDesktopsA(hwinsta:HWINSTA; lpEnumFunc:DESKTOPENUMPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopsA';
+function CreateWindowStationA(lpwinsta:LPSTR; dwReserved:DWORD; dwDesiredAccess:DWORD; lpsa:LPSECURITY_ATTRIBUTES):HWINSTA; external 'user32' name 'CreateWindowStationA';
+function OpenWindowStationA(lpszWinSta:LPSTR; fInherit:WINBOOL; dwDesiredAccess:DWORD):HWINSTA; external 'user32' name 'OpenWindowStationA';
+function EnumWindowStationsA(lpEnumFunc:ENUMWINDOWSTATIONPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindowStationsA';
+function GetUserObjectInformationA(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectInformationA';
+function SetUserObjectInformationA(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD):WINBOOL; external 'user32' name 'SetUserObjectInformationA';
+function RegisterWindowMessageA(lpString:LPCSTR):UINT; external 'user32' name 'RegisterWindowMessageA';
+function GetMessageA(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT):WINBOOL; external 'user32' name 'GetMessageA';
+function DispatchMessageA(lpMsg:LPMSG):LONG; external 'user32' name 'DispatchMessageA';
+function PeekMessageA(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT; wRemoveMsg:UINT):WINBOOL; external 'user32' name 'PeekMessageA';
+function SendMessageA(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'SendMessageA';
+function SendMessageTimeoutA(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; fuFlags:UINT;uTimeout:UINT; lpdwResult:LPDWORD):LRESULT; external 'user32' name 'SendMessageTimeoutA';
+function SendNotifyMessageA(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'SendNotifyMessageA';
+function SendMessageCallbackA(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; lpResultCallBack:SENDASYNCPROC;dwData:DWORD):WINBOOL; external 'user32' name 'SendMessageCallbackA';
+function PostMessageA(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostMessageA';
+function PostThreadMessageA(idThread:DWORD; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostThreadMessageA';
+function DefWindowProcA(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefWindowProcA';
+function CallWindowProcA(lpPrevWndFunc:WNDPROC; hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'CallWindowProcA';
+function RegisterClassA(lpWndClass:LPWNDCLASS):ATOM; external 'user32' name 'RegisterClassA';
+function UnregisterClassA(lpClassName:LPCSTR; hInstance:HINST):WINBOOL; external 'user32' name 'UnregisterClassA';
+function GetClassInfoA(hInstance:HINST; lpClassName:LPCSTR; lpWndClass:LPWNDCLASS):WINBOOL; external 'user32' name 'GetClassInfoA';
+function RegisterClassExA(_para1:LPWNDCLASSEX):ATOM; external 'user32' name 'RegisterClassExA';
+function GetClassInfoExA(_para1:HINST; _para2:LPCSTR; _para3:LPWNDCLASSEX):WINBOOL; external 'user32' name 'GetClassInfoExA';
+function CreateWindowExA(dwExStyle:DWORD; lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+ external 'user32' name 'CreateWindowExA';
+function CreateDialogParamA(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogParamA';
+function CreateDialogIndirectParamA(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogIndirectParamA';
+function DialogBoxParamA(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxParamA';
+function DialogBoxIndirectParamA(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxIndirectParamA';
+function SetDlgItemTextA(hDlg:HWND; nIDDlgItem:longint; lpString:LPCSTR):WINBOOL; external 'user32' name 'SetDlgItemTextA';
+function GetDlgItemTextA(hDlg:HWND; nIDDlgItem:longint; lpString:LPSTR; nMaxCount:longint):UINT; external 'user32' name 'GetDlgItemTextA';
+function SendDlgItemMessageA(hDlg:HWND; nIDDlgItem:longint; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LONG; external 'user32' name 'SendDlgItemMessageA';
+function DefDlgProcA(hDlg:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefDlgProcA';
+function CallMsgFilterA(lpMsg:LPMSG; nCode:longint):WINBOOL; external 'user32' name 'CallMsgFilterA';
+function RegisterClipboardFormatA(lpszFormat:LPCSTR):UINT; external 'user32' name 'RegisterClipboardFormatA';
+function GetClipboardFormatNameA(format:UINT; lpszFormatName:LPSTR; cchMaxCount:longint):longint; external 'user32' name 'GetClipboardFormatNameA';
+function CharToOemA(lpszSrc:LPCSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'CharToOemA';
+function OemToCharA(lpszSrc:LPCSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'OemToCharA';
+function CharToOemBuffA(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffA';
+function OemToCharBuffA(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffA';
+function CharUpperA(lpsz:LPSTR):LPSTR; external 'user32' name 'CharUpperA';
+function CharUpperBuffA(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharUpperBuffA';
+function CharLowerA(lpsz:LPSTR):LPSTR; external 'user32' name 'CharLowerA';
+function CharLowerBuffA(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharLowerBuffA';
+function CharNextA(lpsz:LPCSTR):LPSTR; external 'user32' name 'CharNextA';
+function CharPrevA(lpszStart:LPCSTR; lpszCurrent:LPCSTR):LPSTR; external 'user32' name 'CharPrevA';
+function IsCharAlphaA(ch:CHAR):WINBOOL; external 'user32' name 'IsCharAlphaA';
+function IsCharAlphaNumericA(ch:CHAR):WINBOOL; external 'user32' name 'IsCharAlphaNumericA';
+function IsCharUpperA(ch:CHAR):WINBOOL; external 'user32' name 'IsCharUpperA';
+function IsCharLowerA(ch:CHAR):WINBOOL; external 'user32' name 'IsCharLowerA';
+function GetKeyNameTextA(lParam:LONG; lpString:LPSTR; nSize:longint):longint; external 'user32' name 'GetKeyNameTextA';
+function VkKeyScanA(ch:CHAR):SHORT; external 'user32' name 'VkKeyScanA';
+function VkKeyScanExA(ch:CHAR; dwhkl:HKL):SHORT; external 'user32' name 'VkKeyScanExA';
+function MapVirtualKeyA(uCode:UINT; uMapType:UINT):UINT; external 'user32' name 'MapVirtualKeyA';
+function MapVirtualKeyExA(uCode:UINT; uMapType:UINT; dwhkl:HKL):UINT; external 'user32' name 'MapVirtualKeyExA';
+function LoadAcceleratorsA(hInstance:HINST; lpTableName:LPCSTR):HACCEL; external 'user32' name 'LoadAcceleratorsA';
+function CreateAcceleratorTableA(_para1:LPACCEL; _para2:longint):HACCEL; external 'user32' name 'CreateAcceleratorTableA';
+function CopyAcceleratorTableA(hAccelSrc:HACCEL; lpAccelDst:LPACCEL; cAccelEntries:longint):longint; external 'user32' name 'CopyAcceleratorTableA';
+function TranslateAcceleratorA(hWnd:HWND; hAccTable:HACCEL; lpMsg:LPMSG):longint; external 'user32' name 'TranslateAcceleratorA';
+function LoadMenuA(hInstance:HINST; lpMenuName:LPCSTR):HMENU; external 'user32' name 'LoadMenuA';
+function LoadMenuIndirectA(lpMenuTemplate:LPMENUTEMPLATE):HMENU; external 'user32' name 'LoadMenuIndirectA';
+function ChangeMenuA(hMenu:HMENU; cmd:UINT; lpszNewItem:LPCSTR; cmdInsert:UINT; flags:UINT):WINBOOL; external 'user32' name 'ChangeMenuA';
+function GetMenuStringA(hMenu:HMENU; uIDItem:UINT; lpString:LPSTR; nMaxCount:longint; uFlag:UINT):longint; external 'user32' name 'GetMenuStringA';
+function InsertMenuA(hMenu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCSTR):WINBOOL; external 'user32' name 'InsertMenuA';
+function AppendMenuA(hMenu:HMENU; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCSTR):WINBOOL; external 'user32' name 'AppendMenuA';
+function ModifyMenuA(hMnu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCSTR):WINBOOL; external 'user32' name 'ModifyMenuA';
+function InsertMenuItemA(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'InsertMenuItemA';
+function GetMenuItemInfoA(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPMENUITEMINFO):WINBOOL; external 'user32' name 'GetMenuItemInfoA';
+function SetMenuItemInfoA(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'SetMenuItemInfoA';
+function DrawTextA(hDC:HDC; lpString:LPCSTR; nCount:longint; lpRect:LPRECT; uFormat:UINT):longint; external 'user32' name 'DrawTextA';
+function DrawTextExA(_para1:HDC; _para2:LPSTR; _para3:longint; _para4:LPRECT; _para5:UINT;_para6:LPDRAWTEXTPARAMS):longint; external 'user32' name 'DrawTextExA';
+function GrayStringA(hDC:HDC; hBrush:HBRUSH; lpOutputFunc:GRAYSTRINGPROC; lpData:LPARAM; nCount:longint;X:longint; Y:longint; nWidth:longint; nHeight:longint):WINBOOL; external 'user32' name 'GrayStringA';
+function DrawStateA(_para1:HDC; _para2:HBRUSH; _para3:DRAWSTATEPROC; _para4:LPARAM; _para5:WPARAM;_para6:longint; _para7:longint; _para8:longint; _para9:longint; _para10:UINT):WINBOOL; external 'user32' name 'DrawStateA';
+function TabbedTextOutA(hDC:HDC; X:longint; Y:longint; lpString:LPCSTR; nCount:longint;nTabPositions:longint; lpnTabStopPositions:LPINT; nTabOrigin:longint):LONG; external 'user32' name 'TabbedTextOutA';
+function GetTabbedTextExtentA(hDC:HDC; lpString:LPCSTR; nCount:longint; nTabPositions:longint; lpnTabStopPositions:LPINT):DWORD; external 'user32' name 'GetTabbedTextExtentA';
+function SetPropA(hWnd:HWND; lpString:LPCSTR; hData:HANDLE):WINBOOL; external 'user32' name 'SetPropA';
+function GetPropA(hWnd:HWND; lpString:LPCSTR):HANDLE; external 'user32' name 'GetPropA';
+function RemovePropA(hWnd:HWND; lpString:LPCSTR):HANDLE; external 'user32' name 'RemovePropA';
+function EnumPropsExA(hWnd:HWND; lpEnumFunc:PROPENUMPROCEX; lParam:LPARAM):longint; external 'user32' name 'EnumPropsExA';
+function EnumPropsA(hWnd:HWND; lpEnumFunc:PROPENUMPROC):longint; external 'user32' name 'EnumPropsA';
+function SetWindowTextA(hWnd:HWND; lpString:LPCSTR):WINBOOL; external 'user32' name 'SetWindowTextA';
+function GetWindowTextA(hWnd:HWND; lpString:LPSTR; nMaxCount:longint):longint; external 'user32' name 'GetWindowTextA';
+function GetWindowTextLengthA(hWnd:HWND):longint; external 'user32' name 'GetWindowTextLengthA';
+function MessageBoxA(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT):longint; external 'user32' name 'MessageBoxA';
+function MessageBoxExA(hWnd:HWND; lpText:LPCSTR; lpCaption:LPCSTR; uType:UINT; wLanguageId:WORD):longint; external 'user32' name 'MessageBoxExA';
+function MessageBoxIndirectA(_para1:LPMSGBOXPARAMS):longint; external 'user32' name 'MessageBoxIndirectA';
+function GetWindowLongA(hWnd:HWND; nIndex:longint):LONG; external 'user32' name 'GetWindowLongA';
+function SetWindowLongA(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG; external 'user32' name 'SetWindowLongA';
+function GetClassLongA(hWnd:HWND; nIndex:longint):DWORD; external 'user32' name 'GetClassLongA';
+function SetClassLongA(hWnd:HWND; nIndex:longint; dwNewLong:LONG):DWORD; external 'user32' name 'SetClassLongA';
+function FindWindowA(lpClassName:LPCSTR; lpWindowName:LPCSTR):HWND; external 'user32' name 'FindWindowA';
+function FindWindowExA(_para1:HWND; _para2:HWND; _para3:LPCSTR; _para4:LPCSTR):HWND; external 'user32' name 'FindWindowExA';
+function GetClassNameA(hWnd:HWND; lpClassName:LPSTR; nMaxCount:longint):longint; external 'user32' name 'GetClassNameA';
+function SetWindowsHookExA(idHook:longint; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; external 'user32' name 'SetWindowsHookExA';
+function LoadBitmapA(hInstance:HINST; lpBitmapName:LPCSTR):HBITMAP; external 'user32' name 'LoadBitmapA';
+function LoadCursorA(hInstance:HINST; lpCursorName:LPCSTR):HCURSOR; external 'user32' name 'LoadCursorA';
+function LoadCursorFromFileA(lpFileName:LPCSTR):HCURSOR; external 'user32' name 'LoadCursorFromFileA';
+function LoadIconA(hInstance:HINST; lpIconName:LPCSTR):HICON; external 'user32' name 'LoadIconA';
+function LoadImageA(_para1:HINST; _para2:LPCSTR; _para3:UINT; _para4:longint; _para5:longint;_para6:UINT):HANDLE; external 'user32' name 'LoadImageA';
+function LoadStringA(hInstance:HINST; uID:UINT; lpBuffer:LPSTR; nBufferMax:longint):longint; external 'user32' name 'LoadStringA';
+function IsDialogMessageA(hDlg:HWND; lpMsg:LPMSG):WINBOOL; external 'user32' name 'IsDialogMessageA';
+function DlgDirListA(hDlg:HWND; lpPathSpec:LPSTR; nIDListBox:longint; nIDStaticPath:longint; uFileType:UINT):longint; external 'user32' name 'DlgDirListA';
+function DlgDirSelectExA(hDlg:HWND; lpString:LPSTR; nCount:longint; nIDListBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectExA';
+function DlgDirListComboBoxA(hDlg:HWND; lpPathSpec:LPSTR; nIDComboBox:longint; nIDStaticPath:longint; uFiletype:UINT):longint; external 'user32' name 'DlgDirListComboBoxA';
+function DlgDirSelectComboBoxExA(hDlg:HWND; lpString:LPSTR; nCount:longint; nIDComboBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectComboBoxExA';
+function DefFrameProcA(hWnd:HWND; hWndMDIClient:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefFrameProcA';
+function DefMDIChildProcA(hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefMDIChildProcA';
+function CreateMDIWindowA(lpClassName:LPSTR; lpWindowName:LPSTR; dwStyle:DWORD; X:longint; Y:longint;nWidth:longint; nHeight:longint; hWndParent:HWND; hInstance:HINST; lParam:LPARAM):HWND; external 'user32' name 'CreateMDIWindowA';
+function WinHelpA(hWndMain:HWND; lpszHelp:LPCSTR; uCommand:UINT; dwData:DWORD):WINBOOL; external 'user32' name 'WinHelpA';
+function ChangeDisplaySettingsA(lpDevMode:LPDEVMODE; dwFlags:DWORD):LONG; external 'user32' name 'ChangeDisplaySettingsA';
+function EnumDisplaySettingsA(lpszDeviceName:LPCSTR; iModeNum:DWORD; lpDevMode:LPDEVMODE):WINBOOL; external 'user32' name 'EnumDisplaySettingsA';
+function SystemParametersInfoA(uiAction:UINT; uiParam:UINT; pvParam:PVOID; fWinIni:UINT):WINBOOL; external 'user32' name 'SystemParametersInfoA';
+function AddFontResourceA(_para1:LPCSTR):longint; external 'gdi32' name 'AddFontResourceA';
+function CopyMetaFileA(_para1:HMETAFILE; _para2:LPCSTR):HMETAFILE; external 'gdi32' name 'CopyMetaFileA';
+function CreateFontA(_para1:longint; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:DWORD; _para7:DWORD; _para8:DWORD; _para9:DWORD; _para10:DWORD;_para11:DWORD; _para12:DWORD; _para13:DWORD; _para14:LPCSTR):HFONT;
+external 'gdi32' name 'CreateFontA';
+function CreateFontIndirectA(_para1:LPLOGFONT):HFONT; external 'gdi32' name 'CreateFontIndirectA';
+function CreateICA(_para1:LPCSTR; _para2:LPCSTR; _para3:LPCSTR; _para4:LPDEVMODE):HDC; external 'gdi32' name 'CreateICA';
+function CreateMetaFileA(_para1:LPCSTR):HDC; external 'gdi32' name 'CreateMetaFileA';
+function CreateScalableFontResourceA(_para1:DWORD; _para2:LPCSTR; _para3:LPCSTR; _para4:LPCSTR):WINBOOL; external 'gdi32' name 'CreateScalableFontResourceA';
+function EnumFontFamiliesExA(_para1:HDC; _para2:LPLOGFONT; _para3:FONTENUMEXPROC; _para4:LPARAM; _para5:DWORD):longint; external 'gdi32' name 'EnumFontFamiliesExA';
+function EnumFontFamiliesA(_para1:HDC; _para2:LPCSTR; _para3:FONTENUMPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontFamiliesA';
+function EnumFontsA(_para1:HDC; _para2:LPCSTR; _para3:ENUMFONTSPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontsA';
+function GetCharWidthA(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidthA';
+function GetCharWidth32A(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidth32A';
+function GetCharWidthFloatA(_para1:HDC; _para2:UINT; _para3:UINT; _para4:PSingle):WINBOOL; external 'gdi32' name 'GetCharWidthFloatA';
+function GetCharABCWidthsA(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABC):WINBOOL; external 'gdi32' name 'GetCharABCWidthsA';
+function GetCharABCWidthsFloatA(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABCFLOAT):WINBOOL; external 'gdi32' name 'GetCharABCWidthsFloatA';
+function GetGlyphOutlineA(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPGLYPHMETRICS; _para5:DWORD;_para6:LPVOID; _para7:PMAT2):DWORD; external 'gdi32' name 'GetGlyphOutlineA';
+function GetMetaFileA(_para1:LPCSTR):HMETAFILE; external 'gdi32' name 'GetMetaFileA';
+function GetOutlineTextMetricsA(_para1:HDC; _para2:UINT; _para3:LPOUTLINETEXTMETRIC):UINT; external 'gdi32' name 'GetOutlineTextMetricsA';
+function GetTextExtentPointA(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPointA';
+function GetTextExtentPoint32A(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPoint32A';
+function GetTextExtentExPointA(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:longint; _para5:LPINT;_para6:LPINT; _para7:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentExPointA';
+function GetCharacterPlacementA(_para1:HDC; _para2:LPCSTR; _para3:longint; _para4:longint; _para5:LPGCP_RESULTS;_para6:DWORD):DWORD; external 'gdi32' name 'GetCharacterPlacementA';
+function ResetDCA(_para1:HDC; _para2:LPDEVMODE):HDC; external 'gdi32' name 'ResetDCA';
+function RemoveFontResourceA(_para1:LPCSTR):WINBOOL; external 'gdi32' name 'RemoveFontResourceA';
+function CopyEnhMetaFileA(_para1:HENHMETAFILE; _para2:LPCSTR):HENHMETAFILE; external 'gdi32' name 'CopyEnhMetaFileA';
+function CreateEnhMetaFileA(_para1:HDC; _para2:LPCSTR; _para3:LPRECT; _para4:LPCSTR):HDC; external 'gdi32' name 'CreateEnhMetaFileA';
+function GetEnhMetaFileA(_para1:LPCSTR):HENHMETAFILE; external 'gdi32' name 'GetEnhMetaFileA';
+function GetEnhMetaFileDescriptionA(_para1:HENHMETAFILE; _para2:UINT; _para3:LPSTR):UINT; external 'gdi32' name 'GetEnhMetaFileDescriptionA';
+function GetTextMetricsA(_para1:HDC; _para2:LPTEXTMETRIC):WINBOOL; external 'gdi32' name 'GetTextMetricsA';
+function StartDocA(_para1:HDC; _para2:PDOCINFO):longint; external 'gdi32' name 'StartDocA';
+function GetObjectA(_para1:HGDIOBJ; _para2:longint; _para3:LPVOID):longint; external 'gdi32' name 'GetObjectA';
+function TextOutA(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCSTR; _para5:longint):WINBOOL; external 'gdi32' name 'TextOutA';
+function ExtTextOutA(_para1:HDC; _para2:longint; _para3:longint; _para4:UINT; _para5:LPRECT;_para6:LPCSTR; _para7:UINT; _para8:LPINT):WINBOOL; external 'gdi32' name 'ExtTextOutA';
+function PolyTextOutA(_para1:HDC; _para2:PPOLYTEXT; _para3:longint):WINBOOL; external 'gdi32' name 'PolyTextOutA';
+function GetTextFaceA(_para1:HDC; _para2:longint; _para3:LPSTR):longint; external 'gdi32' name 'GetTextFaceA';
+function GetKerningPairsA(_para1:HDC; _para2:DWORD; _para3:LPKERNINGPAIR):DWORD; external 'gdi32' name 'GetKerningPairsA';
+function CreateColorSpaceA(_para1:LPLOGCOLORSPACE):HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceA';
+function GetLogColorSpaceA(_para1:HCOLORSPACE; _para2:LPLOGCOLORSPACE; _para3:DWORD):WINBOOL; external 'gdi32' name 'GetLogColorSpaceA';
+function GetICMProfileA(_para1:HDC; _para2:DWORD; _para3:LPSTR):WINBOOL; external 'gdi32' name 'GetICMProfileA';
+function SetICMProfileA(_para1:HDC; _para2:LPSTR):WINBOOL; external 'gdi32' name 'SetICMProfileA';
+function UpdateICMRegKeyA(_para1:DWORD; _para2:DWORD; _para3:LPSTR; _para4:UINT):WINBOOL; external 'gdi32' name 'UpdateICMRegKeyA';
+function EnumICMProfilesA(_para1:HDC; _para2:ICMENUMPROC; _para3:LPARAM):longint; external 'gdi32' name 'EnumICMProfilesA';
+function PropertySheetA(lppsph:LPCPROPSHEETHEADER):longint; external 'comctl32' name 'PropertySheetA';
+function ImageList_LoadImageA(hi:HINST; lpbmp:LPCSTR; cx:longint; cGrow:longint; crMask:COLORREF;uType:UINT; uFlags:UINT):HIMAGELIST; external 'comctl32' name 'ImageList_LoadImageA';
+function CreateStatusWindowA(style:LONG; lpszText:LPCSTR; hwndParent:HWND; wID:UINT):HWND; external 'comctl32' name 'CreateStatusWindowA';
+procedure DrawStatusTextA(hDC:HDC; lprc:LPRECT; pszText:LPCSTR; uFlags:UINT); external 'comctl32' name 'DrawStatusTextA';
+function GetOpenFileNameA(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetOpenFileNameA';
+function GetSaveFileNameA(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetSaveFileNameA';
+function GetFileTitleA(_para1:LPCSTR; _para2:LPSTR; _para3:WORD):integer; external 'comdlg32' name 'GetFileTitleA';
+function ChooseColorA(_para1:LPCHOOSECOLOR):WINBOOL; external 'comdlg32' name 'ChooseColorA';
+function FindTextA(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'FindTextA';
+function ReplaceTextA(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'ReplaceTextA';
+function ChooseFontA(_para1:LPCHOOSEFONT):WINBOOL; external 'comdlg32' name 'ChooseFontA';
+function PrintDlgA(_para1:LPPRINTDLG):WINBOOL; external 'comdlg32' name 'PrintDlgA';
+function PageSetupDlgA(_para1:LPPAGESETUPDLG):WINBOOL; external 'comdlg32' name 'PageSetupDlgA';
+function CreateProcessA(lpApplicationName:LPCSTR; lpCommandLine:LPSTR; lpProcessAttributes:LPSECURITY_ATTRIBUTES; lpThreadAttributes:LPSECURITY_ATTRIBUTES; bInheritHandles:WINBOOL;dwCreationFlags:DWORD; lpEnvironment:LPVOID;
+ lpCurrentDirectory:LPCSTR; lpStartupInfo:LPSTARTUPINFO; lpProcessInformation:LPPROCESS_INFORMATION):WINBOOL; external 'kernel32' name 'CreateProcessA';
+procedure GetStartupInfoA(lpStartupInfo:LPSTARTUPINFO); external 'kernel32' name 'GetStartupInfoA';
+function FindFirstFileA(lpFileName:LPCSTR; lpFindFileData:LPWIN32_FIND_DATA):HANDLE; external 'kernel32' name 'FindFirstFileA';
+function FindNextFileA(hFindFile:HANDLE; lpFindFileData:LPWIN32_FIND_DATA):WINBOOL; external 'kernel32' name 'FindNextFileA';
+function GetVersionExA(VersionInformation:LPOSVERSIONINFO):WINBOOL; external 'kernel32' name 'GetVersionExA';
+function CreateWindowA(lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+function CreateDialogA(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function CreateDialogIndirectA(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function DialogBoxA(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function DialogBoxIndirectA(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function CreateDCA(_para1:LPCSTR; _para2:LPCSTR; _para3:LPCSTR; _para4:pDEVMODE):HDC; external 'gdi32' name 'CreateDCA';
+function VerInstallFileA(uFlags:DWORD; szSrcFileName:LPSTR; szDestFileName:LPSTR; szSrcDir:LPSTR; szDestDir:LPSTR;szCurDir:LPSTR; szTmpFile:LPSTR; lpuTmpFileLen:PUINT):DWORD; external 'version' name 'VerInstallFileA';
+function GetFileVersionInfoSizeA(lptstrFilename:LPSTR; lpdwHandle:LPDWORD):DWORD; external 'version' name 'GetFileVersionInfoSizeA';
+function GetFileVersionInfoA(lptstrFilename:LPSTR; dwHandle:DWORD; dwLen:DWORD; lpData:LPVOID):WINBOOL; external 'version' name 'GetFileVersionInfoA';
+function VerLanguageNameA(wLang:DWORD; szLang:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'VerLanguageNameA';
+function VerQueryValueA(pBlock:LPVOID; lpSubBlock:LPSTR; lplpBuffer:LPVOID; puLen:PUINT):WINBOOL; external 'version' name 'VerQueryValueA';
+function VerFindFileA(uFlags:DWORD; szFileName:LPSTR; szWinDir:LPSTR; szAppDir:LPSTR; szCurDir:LPSTR;lpuCurDirLen:PUINT; szDestDir:LPSTR; lpuDestDirLen:PUINT):DWORD; external 'version' name 'VerFindFileA';
+function RegConnectRegistryA(lpMachineName:LPSTR; hKey:HKEY; phkResult:PHKEY):LONG; external 'advapi32' name 'RegConnectRegistryA';
+function RegCreateKeyA(hKey:HKEY; lpSubKey:LPCSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegCreateKeyA';
+function RegCreateKeyExA(hKey:HKEY; lpSubKey:LPCSTR; Reserved:DWORD; lpClass:LPSTR; dwOptions:DWORD;samDesired:REGSAM; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; phkResult:PHKEY; lpdwDisposition:LPDWORD):LONG;
+ external 'advapi32' name 'RegCreateKeyExA';
+function RegDeleteKeyA(hKey:HKEY; lpSubKey:LPCSTR):LONG; external 'advapi32' name 'RegDeleteKeyA';
+function RegDeleteValueA(hKey:HKEY; lpValueName:LPCSTR):LONG; external 'advapi32' name 'RegDeleteValueA';
+function RegEnumKeyA(hKey:HKEY; dwIndex:DWORD; lpName:LPSTR; cbName:DWORD):LONG; external 'advapi32' name 'RegEnumKeyA';
+function RegEnumKeyExA(hKey:HKEY; dwIndex:DWORD; lpName:LPSTR; lpcbName:LPDWORD; lpReserved:LPDWORD;lpClass:LPSTR; lpcbClass:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegEnumKeyExA';
+function RegEnumValueA(hKey:HKEY; dwIndex:DWORD; lpValueName:LPSTR; lpcbValueName:LPDWORD; lpReserved:LPDWORD;lpType:LPDWORD; lpData:LPBYTE; lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegEnumValueA';
+function RegLoadKeyA(hKey:HKEY; lpSubKey:LPCSTR; lpFile:LPCSTR):LONG; external 'advapi32' name 'RegLoadKeyA';
+function RegOpenKeyA(hKey:HKEY; lpSubKey:LPCSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyA';
+function RegOpenKeyExA(hKey:HKEY; lpSubKey:LPCSTR; ulOptions:DWORD; samDesired:REGSAM; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyExA';
+function RegQueryInfoKeyA(hKey:HKEY; lpClass:LPSTR; lpcbClass:LPDWORD; lpReserved:LPDWORD; lpcSubKeys:LPDWORD;lpcbMaxSubKeyLen:LPDWORD; lpcbMaxClassLen:LPDWORD; lpcValues:LPDWORD; lpcbMaxValueNameLen:LPDWORD;
+ lpcbMaxValueLen:LPDWORD;lpcbSecurityDescriptor:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegQueryInfoKeyA';
+function RegQueryValueA(hKey:HKEY; lpSubKey:LPCSTR; lpValue:LPSTR; lpcbValue:PLONG):LONG; external 'advapi32' name 'RegQueryValueA';
+function RegQueryMultipleValuesA(hKey:HKEY; val_list:PVALENT; num_vals:DWORD; lpValueBuf:LPSTR; ldwTotsize:LPDWORD):LONG; external 'advapi32' name 'RegQueryMultipleValuesA';
+function RegQueryValueExA(hKey:HKEY; lpValueName:LPCSTR; lpReserved:LPDWORD; lpType:LPDWORD; lpData:LPBYTE;lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegQueryValueExA';
+function RegReplaceKeyA(hKey:HKEY; lpSubKey:LPCSTR; lpNewFile:LPCSTR; lpOldFile:LPCSTR):LONG; external 'advapi32' name 'RegReplaceKeyA';
+function RegRestoreKeyA(hKey:HKEY; lpFile:LPCSTR; dwFlags:DWORD):LONG; external 'advapi32' name 'RegRestoreKeyA';
+function RegSaveKeyA(hKey:HKEY; lpFile:LPCSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):LONG; external 'advapi32' name 'RegSaveKeyA';
+function RegSetValueA(hKey:HKEY; lpSubKey:LPCSTR; dwType:DWORD; lpData:LPCSTR; cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueA';
+function RegSetValueExA(hKey:HKEY; lpValueName:LPCSTR; Reserved:DWORD; dwType:DWORD; lpData:LPBYTE;cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueExA';
+function RegUnLoadKeyA(hKey:HKEY; lpSubKey:LPCSTR):LONG; external 'advapi32' name 'RegUnLoadKeyA';
+function InitiateSystemShutdownA(lpMachineName:LPSTR; lpMessage:LPSTR; dwTimeout:DWORD; bForceAppsClosed:WINBOOL; bRebootAfterShutdown:WINBOOL):WINBOOL; external 'advapi32' name 'InitiateSystemShutdownA';
+function AbortSystemShutdownA(lpMachineName:LPSTR):WINBOOL; external 'advapi32' name 'AbortSystemShutdownA';
+function CompareStringA(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCSTR; cchCount1:longint; lpString2:LPCSTR;cchCount2:longint):longint; external 'kernel32' name 'CompareStringA';
+function LCMapStringA(Locale:LCID; dwMapFlags:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpDestStr:LPSTR;cchDest:longint):longint; external 'kernel32' name 'LCMapStringA';
+function GetLocaleInfoA(Locale:LCID; LCType:LCTYPE; lpLCData:LPSTR; cchData:longint):longint; external 'kernel32' name 'GetLocaleInfoA';
+function SetLocaleInfoA(Locale:LCID; LCType:LCTYPE; lpLCData:LPCSTR):WINBOOL; external 'kernel32' name 'SetLocaleInfoA';
+function GetTimeFormatA(Locale:LCID; dwFlags:DWORD; lpTime:LPSYSTEMTIME; lpFormat:LPCSTR; lpTimeStr:LPSTR;cchTime:longint):longint; external 'kernel32' name 'GetTimeFormatA';
+function GetDateFormatA(Locale:LCID; dwFlags:DWORD; lpDate:LPSYSTEMTIME; lpFormat:LPCSTR; lpDateStr:LPSTR;cchDate:longint):longint; external 'kernel32' name 'GetDateFormatA';
+function GetNumberFormatA(Locale:LCID; dwFlags:DWORD; lpValue:LPCSTR; lpFormat:PNUMBERFMT; lpNumberStr:LPSTR;cchNumber:longint):longint; external 'kernel32' name 'GetNumberFormatA';
+function GetCurrencyFormatA(Locale:LCID; dwFlags:DWORD; lpValue:LPCSTR; lpFormat:PCURRENCYFMT; lpCurrencyStr:LPSTR;cchCurrency:longint):longint; external 'kernel32' name 'GetCurrencyFormatA';
+function EnumCalendarInfoA(lpCalInfoEnumProc:CALINFO_ENUMPROC; Locale:LCID; Calendar:CALID; CalType:CALTYPE):WINBOOL; external 'kernel32' name 'EnumCalendarInfoA';
+function EnumTimeFormatsA(lpTimeFmtEnumProc:TIMEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumTimeFormatsA';
+function EnumDateFormatsA(lpDateFmtEnumProc:DATEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumDateFormatsA';
+function GetStringTypeExA(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeExA';
+function GetStringTypeA(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeA';
+function FoldStringA(dwMapFlags:DWORD; lpSrcStr:LPCSTR; cchSrc:longint; lpDestStr:LPSTR; cchDest:longint):longint; external 'kernel32' name 'FoldStringA';
+function EnumSystemLocalesA(lpLocaleEnumProc:LOCALE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemLocalesA';
+function EnumSystemCodePagesA(lpCodePageEnumProc:CODEPAGE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemCodePagesA';
+function PeekConsoleInputA(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'PeekConsoleInputA';
+function ReadConsoleInputA(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleInputA';
+function WriteConsoleInputA(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleInputA';
+function ReadConsoleOutputA(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpReadRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'ReadConsoleOutputA';
+function WriteConsoleOutputA(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpWriteRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputA';
+function ReadConsoleOutputCharacterA(hConsoleOutput:HANDLE; lpCharacter:LPSTR; nLength:DWORD; dwReadCoord:COORD; lpNumberOfCharsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputCharacterA';
+function WriteConsoleOutputCharacterA(hConsoleOutput:HANDLE; lpCharacter:LPCSTR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputCharacterA';
+function FillConsoleOutputCharacterA(hConsoleOutput:HANDLE; cCharacter:CHAR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputCharacterA';
+function ScrollConsoleScreenBufferA(hConsoleOutput:HANDLE; lpScrollRectangle:PSMALL_RECT; lpClipRectangle:PSMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):WINBOOL; external 'kernel32' name 'ScrollConsoleScreenBufferA';
+function GetConsoleTitleA(lpConsoleTitle:LPSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetConsoleTitleA';
+function SetConsoleTitleA(lpConsoleTitle:LPCSTR):WINBOOL; external 'kernel32' name 'SetConsoleTitleA';
+function ReadConsoleA(hConsoleInput:HANDLE; lpBuffer:LPVOID; nNumberOfCharsToRead:DWORD; lpNumberOfCharsRead:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'ReadConsoleA';
+function WriteConsoleA(hConsoleOutput:HANDLE;lpBuffer:pointer; nNumberOfCharsToWrite:DWORD; lpNumberOfCharsWritten:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'WriteConsoleA';
+function WNetAddConnectionA(lpRemoteName:LPCSTR; lpPassword:LPCSTR; lpLocalName:LPCSTR):DWORD; external 'mpr' name 'WNetAddConnectionA';
+function WNetAddConnection2A(lpNetResource:LPNETRESOURCE; lpPassword:LPCSTR; lpUserName:LPCSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection2A';
+function WNetAddConnection3A(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpPassword:LPCSTR; lpUserName:LPCSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection3A';
+function WNetCancelConnectionA(lpName:LPCSTR; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnectionA';
+function WNetCancelConnection2A(lpName:LPCSTR; dwFlags:DWORD; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnection2A';
+function WNetGetConnectionA(lpLocalName:LPCSTR; lpRemoteName:LPSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetConnectionA';
+function WNetUseConnectionA(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpUserID:LPCSTR; lpPassword:LPCSTR; dwFlags:DWORD;lpAccessName:LPSTR; lpBufferSize:LPDWORD; lpResult:LPDWORD):DWORD; external 'mpr' name 'WNetUseConnectionA';
+function WNetSetConnectionA(lpName:LPCSTR; dwProperties:DWORD; pvValues:LPVOID):DWORD; external 'mpr' name 'WNetSetConnectionA';
+function WNetConnectionDialog1A(lpConnDlgStruct:LPCONNECTDLGSTRUCT):DWORD; external 'mpr' name 'WNetConnectionDialog1A';
+function WNetDisconnectDialog1A(lpConnDlgStruct:LPDISCDLGSTRUCT):DWORD; external 'mpr' name 'WNetDisconnectDialog1A';
+function WNetOpenEnumA(dwScope:DWORD; dwType:DWORD; dwUsage:DWORD; lpNetResource:LPNETRESOURCE; lphEnum:LPHANDLE):DWORD; external 'mpr' name 'WNetOpenEnumA';
+function WNetEnumResourceA(hEnum:HANDLE; lpcCount:LPDWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetEnumResourceA';
+function WNetGetUniversalNameA(lpLocalPath:LPCSTR; dwInfoLevel:DWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetUniversalNameA';
+function WNetGetUserA(lpName:LPCSTR; lpUserName:LPSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetUserA';
+function WNetGetProviderNameA(dwNetType:DWORD; lpProviderName:LPSTR; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetProviderNameA';
+function WNetGetNetworkInformationA(lpProvider:LPCSTR; lpNetInfoStruct:LPNETINFOSTRUCT):DWORD; external 'mpr' name 'WNetGetNetworkInformationA';
+function WNetGetLastErrorA(lpError:LPDWORD; lpErrorBuf:LPSTR; nErrorBufSize:DWORD; lpNameBuf:LPSTR; nNameBufSize:DWORD):DWORD; external 'mpr' name 'WNetGetLastErrorA';
+function MultinetGetConnectionPerformanceA(lpNetResource:LPNETRESOURCE; lpNetConnectInfoStruct:LPNETCONNECTINFOSTRUCT):DWORD; external 'mpr' name 'MultinetGetConnectionPerformanceA';
+function ChangeServiceConfigA(hService:SC_HANDLE; dwServiceType:DWORD; dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCSTR;lpLoadOrderGroup:LPCSTR; lpdwTagId:LPDWORD; lpDependencies:LPCSTR; lpServiceStartName:LPCSTR;
+ lpPassword:LPCSTR;lpDisplayName:LPCSTR):WINBOOL; external 'advapi32' name 'ChangeServiceConfigA';
+function CreateServiceA(hSCManager:SC_HANDLE; lpServiceName:LPCSTR; lpDisplayName:LPCSTR; dwDesiredAccess:DWORD; dwServiceType:DWORD;dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCSTR; lpLoadOrderGroup:LPCSTR;
+ lpdwTagId:LPDWORD;lpDependencies:LPCSTR; lpServiceStartName:LPCSTR; lpPassword:LPCSTR):SC_HANDLE; external 'advapi32' name 'CreateServiceA';
+function EnumDependentServicesA(hService:SC_HANDLE; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD;lpServicesReturned:LPDWORD):WINBOOL; external 'advapi32' name 'EnumDependentServicesA';
+function EnumServicesStatusA(hSCManager:SC_HANDLE; dwServiceType:DWORD; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD;pcbBytesNeeded:LPDWORD; lpServicesReturned:LPDWORD; lpResumeHandle:LPDWORD):WINBOOL;
+ external 'advapi32' name 'EnumServicesStatusA';
+function GetServiceKeyNameA(hSCManager:SC_HANDLE; lpDisplayName:LPCSTR; lpServiceName:LPSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceKeyNameA';
+function GetServiceDisplayNameA(hSCManager:SC_HANDLE; lpServiceName:LPCSTR; lpDisplayName:LPSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceDisplayNameA';
+function OpenSCManagerA(lpMachineName:LPCSTR; lpDatabaseName:LPCSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenSCManagerA';
+function OpenServiceA(hSCManager:SC_HANDLE; lpServiceName:LPCSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenServiceA';
+function QueryServiceConfigA(hService:SC_HANDLE; lpServiceConfig:LPQUERY_SERVICE_CONFIG; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceConfigA';
+function QueryServiceLockStatusA(hSCManager:SC_HANDLE; lpLockStatus:LPQUERY_SERVICE_LOCK_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceLockStatusA';
+function RegisterServiceCtrlHandlerA(lpServiceName:LPCSTR; lpHandlerProc:LPHANDLER_FUNCTION):SERVICE_STATUS_HANDLE; external 'advapi32' name 'RegisterServiceCtrlHandlerA';
+function StartServiceCtrlDispatcherA(lpServiceStartTable:LPSERVICE_TABLE_ENTRY):WINBOOL; external 'advapi32' name 'StartServiceCtrlDispatcherA';
+function StartServiceA(hService:SC_HANDLE; dwNumServiceArgs:DWORD; lpServiceArgVectors:LPCSTR):WINBOOL; external 'advapi32' name 'StartServiceA';
+function DragQueryFileA(_para1:HDROP; _para2:cardinal; _para3:Pchar;_para4:cardinal):cardinal; external 'shell32' name 'DragQueryFileA';
+function ExtractAssociatedIconA(_para1:HINST; _para2:Pchar; _para3:LPWORD):HICON; external 'shell32' name 'ExtractAssociatedIconA';
+function ExtractIconA(_para1:HINST; _para2:Pchar; _para3:cardinal):HICON;external 'shell32' name 'ExtractIconA';
+function FindExecutableA(_para1:pchar; _para2:pchar;_para3:pchar):HINST; external 'shell32' name 'FindExecutableA';
+function ShellAboutA(_para1:HWND; _para2:pchar; _para3:pchar;_para4:HICON):longint; external 'shell32' name 'ShellAboutA';
+function ShellExecuteA(_para1:HWND; _para2:pchar; _para3:pchar;_para4:pchar; _para5:pchar;_para6:longint):HINST; external 'shell32' name 'ShellExecuteA';
+function Shell_NotifyIconA(dwMessage: DWORD; lpData: PNotifyIconDataA): BOOL; external 'shell32' name 'Shell_NotifyIconA';
+function DdeCreateStringHandleA(_para1:DWORD; _para2:pchar;_para3:longint):HSZ; external 'user32' name 'DdeCreateStringHandleA';
+function DdeInitializeA(_para1:LPDWORD; _para2:PFNCALLBACK; _para3:DWORD; _para4:DWORD):UINT;external 'user32' name 'DdeInitializeA';
+function DdeQueryStringA(_para1:DWORD; _para2:HSZ; _para3:pchar;_para4:DWORD; _para5:longint):DWORD; external 'user32' name 'DdeQueryStringA';
+function LogonUserA(_para1:LPSTR; _para2:LPSTR; _para3:LPSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserA';
+function CreateProcessAsUserA(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCTSTR;
+ _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+function CreateWindowA(lpClassName:LPCSTR; lpWindowName:LPCSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+begin
+ CreateWindowA:=CreateWindowExA(0,lpClassName,lpWindowName,dwStyle,x,y,nWidth,nHeight,hWndParent,hMenu,hInstance,lpParam);
+end;
+
+function CreateDialogA(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialogA:=CreateDialogParamA(hInstance,lpTemplateName,hWndParent,lpDialogFunc,0);
+end;
+
+function CreateDialogIndirectA(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialogIndirectA:=CreateDialogIndirectParamA(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBoxA(hInstance:HINST; lpTemplateName:LPCSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBoxA:=DialogBoxParamA(hInstance,lpTemplateName,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBoxIndirectA(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBoxIndirectA:=DialogBoxIndirectParamA(hInstance,hDialogTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+{$endif read_implementation}
+
+{
+ $Log: ascfun.inc,v $
+ Revision 1.11 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/base.inc b/rtl/win32/wininc/base.inc
new file mode 100644
index 0000000000..7f40d75eaa
--- /dev/null
+++ b/rtl/win32/wininc/base.inc
@@ -0,0 +1,950 @@
+{
+ $Id: base.inc,v 1.25 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains base definition for the Win32 API
+ Copyright (c) 1999-2000 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ Base.h
+
+ Base definitions
+
+ Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+{$PACKRECORDS C}
+
+ type
+ ATOM = word;
+ TAtom = ATOM;
+
+ WINBOOL = longbool;
+ BOOL = WINBOOL;
+
+ CALTYPE = cardinal;
+ CALID = cardinal;
+
+ CCHAR = char;
+
+ COLORREF = cardinal;
+ TCOLORREF = cardinal;
+
+ SHORT = smallint;
+ WINT = longint;
+ LONG = longint;
+ DWORD = cardinal;
+
+ PINTEGER = ^longint;
+ PBOOL = ^BOOL;
+
+ LONGLONG = int64;
+ PLONGLONG = ^LONGLONG;
+
+ DWORDLONG = qword; { was unsigned long }
+ PDWORDLONG = ^DWORDLONG;
+
+ HANDLE = System.THandle;
+ HRESULT = System.HResult;
+ PHRESULT= ^HRESULT;
+
+ HACCEL = HANDLE;
+ HBITMAP = HANDLE;
+ HBRUSH = HANDLE;
+ HCOLORSPACE = HANDLE;
+ HCONV = HANDLE;
+ HCONVLIST = HANDLE;
+ HCURSOR = HANDLE;
+ HDBC = HANDLE;
+ HDC = HANDLE;
+ HDDEDATA = HANDLE;
+ HDESK = HANDLE;
+ HDROP = HANDLE;
+ HDWP = HANDLE;
+ HENHMETAFILE = HANDLE;
+ HENV = HANDLE;
+ HFILE = HANDLE;
+ HFONT = HANDLE;
+ HGDIOBJ = HANDLE;
+ HGLOBAL = HANDLE;
+ HGLRC = HANDLE;
+ HHOOK = HANDLE;
+ HICON = HANDLE;
+ HIMAGELIST = HANDLE;
+ HINST = HANDLE; { Not HINSTANCE, else it has problems with the var HInstance }
+ HKEY = HANDLE;
+ HKL = HANDLE;
+ HLOCAL = HANDLE;
+ HMENU = HANDLE;
+ HMETAFILE = HANDLE;
+ HMODULE = HANDLE;
+ HPALETTE = HANDLE;
+ HPEN = HANDLE;
+ HRASCONN = HANDLE;
+ HRGN = HANDLE;
+ HRSRC = HANDLE;
+ HSTMT = HANDLE;
+ HSTR = HANDLE;
+ HSZ = HANDLE;
+ HWINSTA = HANDLE;
+ HWND = HANDLE;
+ HTASK = HANDLE;
+
+ LANGID = word;
+ LCID = DWORD;
+ LCTYPE = DWORD;
+ LPARAM = longint;
+
+ LP = ^word;
+ LPBOOL = ^WINBOOL;
+ LPBYTE = ^BYTE;
+ LPCCH = PCHAR;
+ LPCH = PCHAR;
+
+ LPCOLORREF = ^COLORREF;
+
+ LPCSTR = Pchar;
+{$ifdef UNICODE}
+ LPCTSTR = Pwidechar;
+{$else}
+ LPCTSTR = Pchar;
+{$endif}
+
+ LPCWCH = Pwidechar;
+ LPCWSTR = Pwidechar;
+
+ LPDWORD = ^DWORD;
+
+ LPHANDLE = ^HANDLE;
+
+ LPINT = ^longint;
+ LPLONG = ^longint;
+
+ LPSTR = Pchar;
+{$ifdef UNICODE}
+ LPTCH = Pwidechar;
+ LPTSTR = Pwidechar;
+{$else}
+ LPTCH = Pchar;
+ LPTSTR = Pchar;
+{$endif}
+
+ LRESULT = longint;
+
+ LPVOID = pointer;
+ LPCVOID = pointer;
+
+ LPWCH = Pwidechar;
+ LPWORD = ^word;
+ LPWSTR = Pwidechar;
+ NWPSTR = Pwidechar;
+
+ PWINBOOL = ^WINBOOL;
+ PBOOLEAN = ^BYTE;
+
+ PBYTE = ^BYTE;
+
+ PCCH = PCHAR;
+ PCH = PCHAR;
+
+ PCSTR = Pchar;
+
+ PCWCH = Pwidechar;
+ PCWSTR = Pwidechar;
+
+ PDWORD = ^DWORD;
+
+ PHANDLE = ^HANDLE;
+ PHKEY = ^HKEY;
+
+ PINT = ^longint;
+ PLONG = ^longint;
+ PSHORT = ^SHORT;
+
+ PSTR = Pchar;
+
+ PSZ = Pchar;
+{$ifdef UNICODE}
+ PTBYTE = ^word;
+ PTCH = Pwidechar;
+ PTCHAR = Pwidechar;
+ PTSTR = Pwidechar;
+{$else}
+ PTBYTE = ^byte;
+ PTCH = Pchar;
+ PTCHAR = Pchar;
+ PTSTR = Pchar;
+{$endif}
+
+ PUCHAR = ^byte;
+ PWCH = Pwidechar;
+ PWCHAR = Pwidechar;
+
+ PWORD = ^word;
+ PUINT = ^cardinal;
+ PULONG = ^cardinal;
+ PUSHORT = ^word;
+
+ PVOID = pointer;
+
+ RETCODE = SHORT;
+
+ SC_HANDLE = HANDLE;
+ SC_LOCK = LPVOID;
+ LPSC_HANDLE = ^SC_HANDLE;
+
+ SERVICE_STATUS_HANDLE = DWORD;
+
+{$ifdef UNICODE}
+ TBYTE = word;
+ TCHAR = word;
+ BCHAR = word;
+{$else}
+ TBYTE = byte;
+ TCHAR = char;
+ BCHAR = BYTE;
+{$endif}
+
+ UCHAR = byte;
+ WCHAR = WideChar;
+
+ UINT = cardinal;
+ ULONG = cardinal;
+ USHORT = word;
+
+ WPARAM = Longint;
+ PLPSTR = ^LPSTR;
+ PLPWStr= ^LPWStr;
+
+{
+ Enumerations
+}
+
+ ACL_INFORMATION_CLASS = (AclRevisionInformation := 1,AclSizeInformation
+ );
+
+ _ACL_INFORMATION_CLASS = ACL_INFORMATION_CLASS;
+
+ MEDIA_TYPE = (Unknown,F5_1Pt2_512,F3_1Pt44_512,F3_2Pt88_512,
+ F3_20Pt8_512,F3_720_512,F5_360_512,F5_320_512,
+ F5_320_1024,F5_180_512,F5_160_512,RemovableMedia,
+ FixedMedia);
+
+ _MEDIA_TYPE = MEDIA_TYPE;
+
+ const
+ RASCS_DONE = $2000;
+ RASCS_PAUSED = $1000;
+
+ type
+
+ RASCONNSTATE = (RASCS_OpenPort := 0,RASCS_PortOpened,
+ RASCS_ConnectDevice,RASCS_DeviceConnected,
+ RASCS_AllDevicesConnected,RASCS_Authenticate,
+ RASCS_AuthNotify,RASCS_AuthRetry,RASCS_AuthCallback,
+ RASCS_AuthChangePassword,RASCS_AuthProject,
+ RASCS_AuthLinkSpeed,RASCS_AuthAck,RASCS_ReAuthenticate,
+ RASCS_Authenticated,RASCS_PrepareForCallback,
+ RASCS_WaitForModemReset,RASCS_WaitForCallback,
+ RASCS_Projected,RASCS_StartAuthentication,
+ RASCS_CallbackComplete,RASCS_LogonNetwork,
+ RASCS_Interactive := RASCS_PAUSED,RASCS_RetryAuthentication,
+ RASCS_CallbackSetByCaller,RASCS_PasswordExpired,
+ RASCS_Connected := RASCS_DONE,RASCS_Disconnected
+ );
+
+ _RASCONNSTATE = RASCONNSTATE;
+
+ RASPROJECTION = (RASP_Amb := $10000,RASP_PppNbf := $803F,RASP_PppIpx := $802B,
+ RASP_PppIp := $8021);
+
+ _RASPROJECTION = RASPROJECTION;
+
+ SECURITY_IMPERSONATION_LEVEL = (SecurityAnonymous,SecurityIdentification,
+ SecurityImpersonation,SecurityDelegation
+ );
+
+ _SECURITY_IMPERSONATION_LEVEL = SECURITY_IMPERSONATION_LEVEL;
+
+ SID_NAME_USE = (SidTypeUser := 1,SidTypeGroup,SidTypeDomain,
+ SidTypeAlias,SidTypeWellKnownGroup,SidTypeDeletedAccount,
+ SidTypeInvalid,SidTypeUnknown);
+
+ PSID_NAME_USE = ^SID_NAME_USE;
+
+ _SID_NAME_USE = SID_NAME_USE;
+
+ TOKEN_INFORMATION_CLASS = (TokenUser := 1,TokenGroups,TokenPrivileges,
+ TokenOwner,TokenPrimaryGroup,TokenDefaultDacl,
+ TokenSource,TokenType,TokenImpersonationLevel,
+ TokenStatistics);
+
+ _TOKEN_INFORMATION_CLASS = TOKEN_INFORMATION_CLASS;
+ TTokenInformationClass = TOKEN_INFORMATION_CLASS;
+
+ TOKEN_TYPE = (TokenPrimary := 1,TokenImpersonation
+ );
+
+ tagTOKEN_TYPE = TOKEN_TYPE;
+
+ {
+ Macros
+ }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GetBValue(rgb : longint) : BYTE;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GetGValue(rgb : longint) : BYTE;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GetRValue(rgb : longint) : BYTE;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function RGB(r,g,b : longint) : DWORD;
+
+ { Not convertable by H2PAS
+ #define HANDLE_WM_NOTIFY(hwnd, wParam, lParam, fn) \
+ (fn)((hwnd), (int)(wParam), (NMHDR FAR )(lParam))
+ }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function HIBYTE(w : longint) : BYTE;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function HIWORD(l : longint) : WORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function LOBYTE(w : longint) : BYTE;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function LOWORD(l : longint) : WORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELONG(a,b : longint) : LONG;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEWORD(a,b : longint) : WORD;
+
+ { original Cygnus headers also had the following defined: }
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function SEXT_HIWORD(l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function ZEXT_HIWORD(l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function SEXT_LOWORD(l : longint) : longint;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function INDEXTOOVERLAYMASK(i : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function INDEXTOSTATEIMAGEMASK(i : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEINTATOM(i : longint) : LPTSTR;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEINTRESOURCE(i : longint) : LPTSTR;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function MAKELANGID(p,s : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function PRIMARYLANGID(lgid : longint) : WORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function SUBLANGID(lgid : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function LANGIDFROMLCID(lcid : longint) : WORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function SORTIDFROMLCID(lcid : longint) : WORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELCID(lgid,srtid : longint) : DWORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELPARAM(l,h : longint) : LPARAM;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELRESULT(l,h : longint) : LRESULT;
+
+ { Not convertable by H2PAS
+ #define MAKEPOINTS(l) ( ((POINTS FAR ) & (l)))
+ }
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEROP4(fore,back : longint) : DWORD;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEWPARAM(l,h : longint) : WPARAM;
+
+{$ifndef max}
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function max(a,b : longint) : longint;
+ { return type might be wrong }
+
+{$endif}
+{$ifndef min}
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function min(a,b : longint) : longint;
+ { return type might be wrong }
+
+{$endif}
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function PALETTEINDEX(i : longint) : COLORREF;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function PALETTERGB(r,g,b : longint) : longint;
+ { return type might be wrong }
+
+ (* Not convertable by H2PAS
+ #define POINTSTOPOINT(pt, pts) {(pt).x = (SHORT) LOWORD(pts); \
+ (pt).y = (SHORT) HIWORD(pts);}
+ #define POINTTOPOINTS(pt) \
+ (MAKELONG((short) ((pt).x), (short) ((pt).y)))
+ *)
+ { already declared before
+ #define INDEXTOOVERLAYMASK(i) ((i) << 8)
+ #define INDEXTOSTATEIMAGEMASK(i) ((i) << 12)
+ }
+ { Not convertable by H2PAS
+ #ifdef UNICODE
+ #define TEXT(quote) L##quote
+ #else
+ #define TEXT(quote) quote
+ #endif
+ }
+
+ {
+ Definitions for callback procedures
+ }
+
+ type
+
+ BFFCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPARAM; _para4:LPARAM):longint;stdcall;
+
+ LPCCHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ LPCFHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ PTHREAD_START_ROUTINE = Pointer;
+
+ LPTHREAD_START_ROUTINE = PTHREAD_START_ROUTINE;
+
+ EDITSTREAMCALLBACK = function (_para1:DWORD; _para2:LPBYTE; _para3:LONG; _para4:LONG):DWORD;stdcall;
+
+ LPFRHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ LPOFNHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ LPPRINTHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ LPSETUPHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ DLGPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):LRESULT;stdcall;
+
+ PFNPROPSHEETCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPARAM):longint;stdcall;
+
+ LPSERVICE_MAIN_FUNCTION = procedure (_para1:DWORD; _para2:LPTSTR);stdcall;
+
+ PFNTVCOMPARE = function (_para1:LPARAM; _para2:LPARAM; _para3:LPARAM):longint;stdcall;
+
+ WNDPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):LRESULT;stdcall;
+
+ FARPROC = pointer;
+
+ PROC = FARPROC;
+
+ ENUMRESTYPEPROC = function (_para1:HANDLE; _para2:LPTSTR; _para3:LONG):WINBOOL;stdcall;
+
+ ENUMRESNAMEPROC = function (_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LONG):WINBOOL;stdcall;
+
+ ENUMRESLANGPROC = function (_para1:HANDLE; _para2:LPCTSTR; _para3:LPCTSTR; _para4:WORD; _para5:LONG):WINBOOL;stdcall;
+
+ DESKTOPENUMPROC = FARPROC;
+
+ ENUMWINDOWSPROC = function (_para1:HWND; _para2:LPARAM):WINBOOL;stdcall;
+
+ ENUMWINDOWSTATIONPROC = function (_para1:LPTSTR; _para2:LPARAM):WINBOOL;stdcall;
+
+ SENDASYNCPROC = procedure (_para1:HWND; _para2:UINT; _para3:DWORD; _para4:LRESULT);stdcall;
+
+ TIMERPROC = procedure (_para1:HWND; _para2:UINT; _para3:UINT; _para4:DWORD);stdcall;
+
+ GRAYSTRINGPROC = FARPROC;
+
+ DRAWSTATEPROC = function (_para1:HDC; _para2:LPARAM; _para3:WPARAM; _para4:longint; _para5:longint):WINBOOL;stdcall;
+
+ PROPENUMPROCEX = function (_para1:HWND; _para2:LPCTSTR; _para3:HANDLE; _para4:DWORD):WINBOOL;stdcall;
+
+ PROPENUMPROC = function (_para1:HWND; _para2:LPCTSTR; _para3:HANDLE):WINBOOL;stdcall;
+
+ HOOKPROC = function (_para1:longint; _para2:WPARAM; _para3:LPARAM):LRESULT;stdcall;
+
+ ENUMOBJECTSPROC = procedure (_para1:LPVOID; _para2:LPARAM);stdcall;
+
+ LINEDDAPROC = procedure (_para1:longint; _para2:longint; _para3:LPARAM);stdcall;
+
+ TABORTPROC = function (_para1:HDC; _para2:longint):WINBOOL;stdcall;
+
+ LPPAGEPAINTHOOK = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ LPPAGESETUPHOOK = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall;
+
+ ICMENUMPROC = function (_para1:LPTSTR; _para2:LPARAM):longint;stdcall;
+
+ EDITWORDBREAKPROCEX = function (_para1:pchar; _para2:LONG; _para3:BYTE; _para4:WINT):LONG;stdcall;
+
+ PFNLVCOMPARE = function (_para1:LPARAM; _para2:LPARAM; _para3:LPARAM):longint;stdcall;
+
+ LOCALE_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall;
+
+ CODEPAGE_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall;
+
+ DATEFMT_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall;
+
+ TIMEFMT_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall;
+
+ CALINFO_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall;
+
+ PHANDLER_ROUTINE = function (_para1:DWORD):WINBOOL;stdcall;
+
+ LPHANDLER_FUNCTION = function (_para1:DWORD):WINBOOL;stdcall;
+
+ PFNGETPROFILEPATH = function (_para1:LPCTSTR; _para2:LPSTR; _para3:UINT):UINT;stdcall;
+
+ PFNRECONCILEPROFILE = function (_para1:LPCTSTR; _para2:LPCTSTR; _para3:DWORD):UINT;stdcall;
+
+ PFNPROCESSPOLICIES = function (_para1:HWND; _para2:LPCTSTR; _para3:LPCTSTR; _para4:LPCTSTR; _para5:DWORD):WINBOOL;stdcall;
+ (* Not convertable by H2PAS
+ #define SECURITY_NULL_SID_AUTHORITY {0,0,0,0,0,0}
+ #define SECURITY_WORLD_SID_AUTHORITY {0,0,0,0,0,1}
+ #define SECURITY_LOCAL_SID_AUTHORITY {0,0,0,0,0,2}
+ #define SECURITY_CREATOR_SID_AUTHORITY {0,0,0,0,0,3}
+ #define SECURITY_NON_UNIQUE_AUTHORITY {0,0,0,0,0,4}
+ #define SECURITY_NT_AUTHORITY {0,0,0,0,0,5}
+ *)
+ { TEXT("String") replaced by "String" below for H2PAS }
+
+ const
+ SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege';
+ SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
+ SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
+ SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
+ SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
+ SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
+ SE_TCB_NAME = 'SeTcbPrivilege';
+ SE_SECURITY_NAME = 'SeSecurityPrivilege';
+ SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
+ SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
+ SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
+ SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
+ SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
+ SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
+ SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
+ SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
+ SE_BACKUP_NAME = 'SeBackupPrivilege';
+ SE_RESTORE_NAME = 'SeRestorePrivilege';
+ SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
+ SE_DEBUG_NAME = 'SeDebugPrivilege';
+ SE_AUDIT_NAME = 'SeAuditPrivilege';
+ SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
+ SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
+ SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege';
+ { Not convertable by H2PAS
+ #define SERVICES_ACTIVE_DATABASEW L"ServicesActive"
+ #define SERVICES_FAILED_DATABASEW L"ServicesFailed"
+ }
+ SERVICES_ACTIVE_DATABASEA = 'ServicesActive';
+ SERVICES_FAILED_DATABASEA = 'ServicesFailed';
+ { Not convertable by H2PAS
+ #define SC_GROUP_IDENTIFIERW L'+'
+ }
+ SC_GROUP_IDENTIFIERA = '+';
+{$ifdef UNICODE}
+ SERVICES_ACTIVE_DATABASE = SERVICES_ACTIVE_DATABASEW;
+ SERVICES_FAILED_DATABASE = SERVICES_FAILED_DATABASEW;
+ SC_GROUP_IDENTIFIER = SC_GROUP_IDENTIFIERW;
+{$else}
+ SERVICES_ACTIVE_DATABASE = SERVICES_ACTIVE_DATABASEA;
+ SERVICES_FAILED_DATABASE = SERVICES_FAILED_DATABASEA;
+ SC_GROUP_IDENTIFIER = SC_GROUP_IDENTIFIERA;
+{$endif}
+
+type
+
+ { PFNCALLBACK = CALLB; }
+ PFNCALLBACK = function(_para1, _para2: UINT;_para3: HCONV;_para4, _para5: HSZ; _para6: HDDEDATA;_para7 ,_para8 :DWORD): HDDEData;stdcall;
+ { CALLB = procedure ;CDECL; }
+ CALLB = PFNCALLBACK;
+
+
+ SECURITY_CONTEXT_TRACKING_MODE = WINBOOL;
+ { End of stuff from ddeml.h in old Cygnus headers }
+ { ----------------------------------------------- }
+
+ WNDENUMPROC = FARPROC;
+
+ ENHMFENUMPROC = FARPROC;
+
+ CCSTYLE = DWORD;
+
+ PCCSTYLE = ^CCSTYLE;
+
+ LPCCSTYLE = ^CCSTYLE;
+
+ CCSTYLEFLAGA = DWORD;
+
+ PCCSTYLEFLAGA = ^CCSTYLEFLAGA;
+
+ LPCCSTYLEFLAGA = ^CCSTYLEFLAGA;
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GetBValue(rgb : longint) : BYTE;
+ begin
+ GetBValue:=BYTE(rgb shr 16);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GetGValue(rgb : longint) : BYTE;
+ begin
+ GetGValue:=BYTE((WORD(rgb)) shr 8);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GetRValue(rgb : longint) : BYTE;
+ begin
+ GetRValue:=BYTE(rgb);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function RGB(r,g,b : longint) : DWORD;
+ begin
+ RGB:=DWORD(((DWORD(BYTE(r))) or ((DWORD(WORD(g))) shl 8)) or ((DWORD(BYTE(b))) shl 16));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function HIBYTE(w : longint) : BYTE;
+ begin
+ HIBYTE:=BYTE(((WORD(w)) shr 8) and $FF);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function HIWORD(l : longint) : WORD;
+ begin
+ HIWORD:=WORD(((DWORD(l)) shr 16) and $FFFF);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function LOBYTE(w : longint) : BYTE;
+ begin
+ LOBYTE:=BYTE(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function LOWORD(l : longint) : WORD;
+ begin
+ LOWORD:=WORD(l);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELONG(a,b : longint) : LONG;
+ begin
+ MAKELONG:=LONG((WORD(a)) or ((DWORD(WORD(b))) shl 16));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEWORD(a,b : longint) : WORD;
+ begin
+ MAKEWORD:=WORD((BYTE(a)) or ((WORD(BYTE(b))) shl 8));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function SEXT_HIWORD(l : longint) : longint;
+ { return type might be wrong }
+ begin
+ SEXT_HIWORD:=(longint(l)) shr 16;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function ZEXT_HIWORD(l : longint) : longint;
+ { return type might be wrong }
+ begin
+ ZEXT_HIWORD:=(cardinal(l)) shr 16;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function SEXT_LOWORD(l : longint) : longint;
+ begin
+ SEXT_LOWORD:=longint(SHORT(l));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function INDEXTOOVERLAYMASK(i : longint) : longint;
+ { return type might be wrong }
+ begin
+ INDEXTOOVERLAYMASK:=i shl 8;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function INDEXTOSTATEIMAGEMASK(i : longint) : longint;
+ { return type might be wrong }
+ begin
+ INDEXTOSTATEIMAGEMASK:=i shl 12;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEINTATOM(i : longint) : LPTSTR;
+ begin
+ MAKEINTATOM:=LPTSTR(DWORD(WORD(i)));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEINTRESOURCE(i : longint) : LPTSTR;
+ begin
+ MAKEINTRESOURCE:=LPTSTR(DWORD(WORD(i)));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function MAKELANGID(p,s : longint) : longint;
+ { return type might be wrong }
+ begin
+ MAKELANGID:=((WORD(s)) shl 10) or (WORD(p));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function PRIMARYLANGID(lgid : longint) : WORD;
+ begin
+ { PRIMARYLANGID:=WORD(lgid(@($3ff)));
+ h2pas error here corrected by hand PM }
+ PRIMARYLANGID:=WORD(lgid) and ($3ff);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function SUBLANGID(lgid : longint) : longint;
+ { return type might be wrong }
+ begin
+ SUBLANGID:=(WORD(lgid)) shr 10;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function LANGIDFROMLCID(lcid : longint) : WORD;
+ begin
+ LANGIDFROMLCID:=WORD(lcid);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function SORTIDFROMLCID(lcid : longint) : WORD;
+ begin
+ SORTIDFROMLCID:=WORD(((DWORD(lcid)) and $000FFFFF) shr 16);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELCID(lgid,srtid : longint) : DWORD;
+ begin
+ MAKELCID:=DWORD(((DWORD(WORD(srtid))) shl 16) or (DWORD(WORD(lgid))));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELPARAM(l,h : longint) : LPARAM;
+ begin
+ MAKELPARAM:=LPARAM(MAKELONG(l,h));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKELRESULT(l,h : longint) : LRESULT;
+ begin
+ MAKELRESULT:=LRESULT(MAKELONG(l,h));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEROP4(fore,back : longint) : DWORD;
+ begin
+ MAKEROP4:=DWORD((DWORD(back shl 8) and $FF000000) or DWORD(fore));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function MAKEWPARAM(l,h : longint) : WPARAM;
+ begin
+ MAKEWPARAM:=WPARAM(MAKELONG(l,h));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function max(a,b : longint) : longint;
+ { return type might be wrong }
+ var
+ if_local1 : longint;
+ (* result types are not known *)
+ begin
+ if a > b then
+ if_local1:=a
+ else
+ if_local1:=b;
+ max:=if_local1;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function min(a,b : longint) : longint;
+ { return type might be wrong }
+ var
+ if_local1 : longint;
+ (* result types are not known *)
+ begin
+ if a < b then
+ if_local1:=a
+ else
+ if_local1:=b;
+ min:=if_local1;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function PALETTEINDEX(i : longint) : COLORREF;
+ begin
+ PALETTEINDEX:=COLORREF($01000000 or (DWORD(WORD(i))));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function PALETTERGB(r,g,b : longint) : longint;
+ { return type might be wrong }
+ begin
+ PALETTERGB:=$02000000 or (RGB(r,g,b));
+ end;
+
+{$endif read_implementation}
+
+{
+ $Log: base.inc,v $
+ Revision 1.25 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.24 2005/02/06 11:22:38 florian
+ + TAtom
+
+}
diff --git a/rtl/win32/wininc/defines.inc b/rtl/win32/wininc/defines.inc
new file mode 100644
index 0000000000..5f9bfd8ab2
--- /dev/null
+++ b/rtl/win32/wininc/defines.inc
@@ -0,0 +1,5953 @@
+{
+ $Id: defines.inc,v 1.21 2005/03/12 13:55:07 florian Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the constant definitions for the Win32 API
+ Copyright (c) 1999-2000 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ Defines.h
+
+ Windows32 API definitions
+
+ Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+{$PACKRECORDS C}
+
+ { was #define dname def_expr }
+ function UNICODE_NULL : WCHAR;
+
+ const
+ MAX_PATH = 260;
+ LF_FACESIZE = 32;
+ LF_FULLFACESIZE = 64;
+ ELF_VENDOR_SIZE = 4;
+ SECURITY_STATIC_TRACKING = 0;
+ SECURITY_DYNAMIC_TRACKING = 1;
+ MAX_DEFAULTCHAR = 2;
+ MAX_LEADBYTES = 12;
+ EXCEPTION_MAXIMUM_PARAMETERS = 15;
+ CCHDEVICENAME = 32;
+ CCHFORMNAME = 32;
+ MENU_TEXT_LEN = 40;
+ MAX_LANA = 254;
+ NCBNAMSZ = 16;
+ NETBIOS_NAME_LEN = 16;
+ OFS_MAXPATHNAME = 128;
+ MAX_TAB_STOPS = 32;
+ ANYSIZE_ARRAY = 1;
+ RAS_MaxCallbackNumber = 128;
+ RAS_MaxDeviceName = 128;
+ RAS_MaxDeviceType = 16;
+ RAS_MaxEntryName = 256;
+ RAS_MaxIpAddress = 15;
+ RAS_MaxIpxAddress = 21;
+ RAS_MaxPhoneNumber = 128;
+ UNLEN = 256;
+ PWLEN = 256;
+ CNLEN = 15;
+ DNLEN = 15;
+ { Unsigned types max }
+ MAXDWORD = $FFFFFFFF;
+ MAXWORD = $FFFF;
+ MAXBYTE = $FF;
+ { Signed types max/min }
+ MINCHAR = $80;
+ MAXCHAR = $7F;
+ MINSHORT = $8000;
+ MAXSHORT = $7FFF;
+ MINLONG = $80000000;
+ MAXLONG = $7FFFFFFF;
+ { _llseek }
+ FILE_BEGIN = 0;
+ FILE_CURRENT = 1;
+ FILE_END = 2;
+ { _lopen, LZOpenFile, OpenFile }
+ OF_READ = 0;
+ OF_READWRITE = 2;
+ OF_WRITE = 1;
+ OF_SHARE_COMPAT = 0;
+ OF_SHARE_DENY_NONE = 64;
+ OF_SHARE_DENY_READ = 48;
+ OF_SHARE_DENY_WRITE = 32;
+ OF_SHARE_EXCLUSIVE = 16;
+ OF_CANCEL = 2048;
+ OF_CREATE = 4096;
+ OF_DELETE = 512;
+ OF_EXIST = 16384;
+ OF_PARSE = 256;
+ OF_PROMPT = 8192;
+ OF_REOPEN = 32768;
+ OF_VERIFY = 1024;
+ { ActivateKeyboardLayout, LoadKeyboardLayout }
+ HKL_NEXT = 1;
+ HKL_PREV = 0;
+ KLF_REORDER = 8;
+ KLF_UNLOADPREVIOUS = 4;
+ KLF_ACTIVATE = 1;
+ KLF_NOTELLSHELL = 128;
+ KLF_REPLACELANG = 16;
+ KLF_SUBSTITUTE_OK = 2;
+ { AppendMenu }
+ MF_BITMAP = $4;
+ MF_DISABLED = $2;
+ MF_ENABLED = 0;
+ MF_GRAYED = $1;
+ MF_HELP = $4000;
+ MF_MENUBARBREAK = $20;
+ MF_MENUBREAK = $40;
+ MF_MOUSESELECT = $8000;
+ MF_OWNERDRAW = $100;
+ MF_POPUP = $10;
+ MF_SEPARATOR = $800;
+ MF_STRING = 0;
+ MF_SYSMENU = $2000;
+ MF_USECHECKBITMAPS = $200;
+ { Ternary Raster Operations - BitBlt }
+ BLACKNESS = $00000042;
+ NOTSRCERASE = $001100A6;
+ NOTSRCCOPY = $00330008;
+ SRCERASE = $00440328;
+ DSTINVERT = $00550009;
+ PATINVERT = $005A0049;
+ SRCINVERT = $00660046;
+ SRCAND = $008800C6;
+ MERGEPAINT = $00BB0226;
+ MERGECOPY = $00C000CA;
+ SRCCOPY = $00CC0020;
+ SRCPAINT = $00EE0086;
+ PATCOPY = $00F00021;
+ PATPAINT = $00FB0A09;
+ WHITENESS = $00FF0062;
+ { Binary Raster Operations }
+ R2_BLACK = 1;
+ R2_COPYPEN = 13;
+ R2_MASKNOTPEN = 3;
+ R2_MASKPEN = 9;
+ R2_MASKPENNOT = 5;
+ R2_MERGENOTPEN = 12;
+ R2_MERGEPEN = 15;
+ R2_MERGEPENNOT = 14;
+ R2_NOP = 11;
+ R2_NOT = 6;
+ R2_NOTCOPYPEN = 4;
+ R2_NOTMASKPEN = 8;
+ R2_NOTMERGEPEN = 2;
+ R2_NOTXORPEN = 10;
+ R2_WHITE = 16;
+ R2_XORPEN = 7;
+ { BroadcastSystemMessage }
+ BSF_FLUSHDISK = 4;
+ BSF_FORCEIFHUNG = 32;
+ BSF_IGNORECURRENTTASK = 2;
+ BSF_NOHANG = 8;
+ BSF_POSTMESSAGE = 16;
+ BSF_QUERY = 1;
+ BSM_ALLCOMPONENTS = 0;
+ BSM_APPLICATIONS = 8;
+ BSM_INSTALLABLEDRIVERS = 4;
+ BSM_NETDRIVER = 2;
+ BSM_VXDS = 1;
+ BROADCAST_QUERY_DENY = 1112363332;
+ { BrowseCallbackProc }
+ { CallNamedPipe }
+ NMPWAIT_NOWAIT = 1;
+ NMPWAIT_WAIT_FOREVER = -(1);
+ NMPWAIT_USE_DEFAULT_WAIT = 0;
+ { CascadeWindows, TileWindows }
+ MDITILE_SKIPDISABLED = 2;
+ MDITILE_HORIZONTAL = 1;
+ MDITILE_VERTICAL = 0;
+ { CBTProc }
+ HCBT_ACTIVATE = 5;
+ HCBT_CLICKSKIPPED = 6;
+ HCBT_CREATEWND = 3;
+ HCBT_DESTROYWND = 4;
+ HCBT_KEYSKIPPED = 7;
+ HCBT_MINMAX = 1;
+ HCBT_MOVESIZE = 0;
+ HCBT_QS = 2;
+ HCBT_SETFOCUS = 9;
+ HCBT_SYSCOMMAND = 8;
+ { ChangeDisplaySettings }
+ DM_BITSPERPEL = $40000;
+ DM_PELSWIDTH = $80000;
+ DM_PELSHEIGHT = $100000;
+ DM_DISPLAYFLAGS = $200000;
+ DM_DISPLAYFREQUENCY = $400000;
+ CDS_UPDATEREGISTRY = 1;
+ CDS_TEST = 2;
+ CDS_FULLSCREEN = 4;
+ CDS_GLOBAL = 8;
+ CDS_SET_PRIMARY = $10;
+ CDS_RESET = $40000000;
+ CDS_SETRECT = $20000000;
+ CDS_NORESET = $10000000;
+ DISP_CHANGE_SUCCESSFUL = 0;
+ DISP_CHANGE_RESTART = 1;
+ DISP_CHANGE_BADFLAGS = -(4);
+ DISP_CHANGE_FAILED = -(1);
+ DISP_CHANGE_BADMODE = -(2);
+ DISP_CHANGE_NOTUPDATED = -(3);
+ { ChangeServiceConfig }
+ SERVICE_NO_CHANGE = -(1);
+ SERVICE_WIN32_OWN_PROCESS = 16;
+ SERVICE_WIN32_SHARE_PROCESS = 32;
+ SERVICE_KERNEL_DRIVER = 1;
+ SERVICE_FILE_SYSTEM_DRIVER = 2;
+ SERVICE_INTERACTIVE_PROCESS = 256;
+ SERVICE_BOOT_START = 0;
+ SERVICE_SYSTEM_START = 1;
+ SERVICE_AUTO_START = 2;
+ SERVICE_DEMAND_START = 3;
+ SERVICE_DISABLED = 4;
+ { SERVICE_STATUS structure }
+ SERVICE_STOPPED = 1;
+ SERVICE_START_PENDING = 2;
+ SERVICE_STOP_PENDING = 3;
+ SERVICE_RUNNING = 4;
+ SERVICE_CONTINUE_PENDING = 5;
+ SERVICE_PAUSE_PENDING = 6;
+ SERVICE_PAUSED = 7;
+ SERVICE_ACCEPT_STOP = 1;
+ SERVICE_ACCEPT_PAUSE_CONTINUE = 2;
+ SERVICE_ACCEPT_SHUTDOWN = 4;
+ { CheckDlgButton }
+ BST_CHECKED = 1;
+ BST_INDETERMINATE = 2;
+ BST_UNCHECKED = 0;
+ BST_FOCUS = 8;
+ BST_PUSHED = 4;
+ { CheckMenuItem, HiliteMenuItem }
+ MF_BYCOMMAND = 0;
+ MF_BYPOSITION = $400;
+ MF_CHECKED = $8;
+ MF_UNCHECKED = 0;
+ MF_HILITE = $80;
+ MF_UNHILITE = 0;
+ { ChildWindowFromPointEx }
+ CWP_ALL = 0;
+ CWP_SKIPINVISIBLE = 1;
+ CWP_SKIPDISABLED = 2;
+ CWP_SKIPTRANSPARENT = 4;
+ { ClearCommError }
+ CE_BREAK = 16;
+ CE_DNS = 2048;
+ CE_FRAME = 8;
+ CE_IOE = 1024;
+ CE_MODE = 32768;
+ CE_OOP = 4096;
+ CE_OVERRUN = 2;
+ CE_PTO = 512;
+ CE_RXOVER = 1;
+ CE_RXPARITY = 4;
+ CE_TXFULL = 256;
+ { ChooseMatchToTarget }
+ { CombineRgn }
+ RGN_AND = 1;
+ RGN_COPY = 5;
+ RGN_DIFF = 4;
+ RGN_OR = 2;
+ RGN_XOR = 3;
+ NULLREGION = 1;
+ SIMPLEREGION = 2;
+ COMPLEXREGION = 3;
+ ERROR = 0;
+ { CommonDlgExtendedError }
+ CDERR_DIALOGFAILURE = $ffff;
+ CDERR_FINDRESFAILURE = 6;
+ CDERR_INITIALIZATION = 2;
+ CDERR_LOADRESFAILURE = 7;
+ CDERR_LOADSTRFAILURE = 5;
+ CDERR_LOCKRESFAILURE = 8;
+ CDERR_MEMALLOCFAILURE = 9;
+ CDERR_MEMLOCKFAILURE = 10;
+ CDERR_NOHINSTANCE = 4;
+ CDERR_NOHOOK = 11;
+ CDERR_NOTEMPLATE = 3;
+ CDERR_REGISTERMSGFAIL = 12;
+ CDERR_STRUCTSIZE = 1;
+ PDERR_CREATEICFAILURE = $1000 + 10;
+ PDERR_DEFAULTDIFFERENT = $1000 + 12;
+ PDERR_DNDMMISMATCH = $1000 + 9;
+ PDERR_GETDEVMODEFAIL = $1000 + 5;
+ PDERR_INITFAILURE = $1000 + 6;
+ PDERR_LOADDRVFAILURE = $1000 + 4;
+ PDERR_NODEFAULTPRN = $1000 + 8;
+ PDERR_NODEVICES = $1000 + 7;
+ PDERR_PARSEFAILURE = $1000 + 2;
+ PDERR_PRINTERNOTFOUND = $1000 + 11;
+ PDERR_RETDEFFAILURE = $1000 + 3;
+ PDERR_SETUPFAILURE = $1000 + 1;
+ CFERR_MAXLESSTHANMIN = $2000 + 2;
+ CFERR_NOFONTS = $2000 + 1;
+ FNERR_BUFFERTOOSMALL = $3000 + 3;
+ FNERR_INVALIDFILENAME = $3000 + 2;
+ FNERR_SUBCLASSFAILURE = $3000 + 1;
+ FRERR_BUFFERLENGTHZERO = $4000 + 1;
+ { CompareString, LCMapString }
+ LOCALE_SYSTEM_DEFAULT = $800;
+ LOCALE_USER_DEFAULT = $400;
+ NORM_IGNORECASE = 1;
+ NORM_IGNOREKANATYPE = 65536;
+ NORM_IGNORENONSPACE = 2;
+ NORM_IGNORESYMBOLS = 4;
+ NORM_IGNOREWIDTH = 131072;
+ SORT_STRINGSORT = 4096;
+ LCMAP_BYTEREV = 2048;
+ LCMAP_FULLWIDTH = 8388608;
+ LCMAP_HALFWIDTH = 4194304;
+ LCMAP_HIRAGANA = 1048576;
+ LCMAP_KATAKANA = 2097152;
+ LCMAP_LOWERCASE = 256;
+ LCMAP_SORTKEY = 1024;
+ LCMAP_UPPERCASE = 512;
+ { ContinueDebugEvent }
+ DBG_CONTINUE = $10002;
+ DBG_CONTROL_BREAK = $40010008;
+ DBG_CONTROL_C = $40010005;
+ DBG_EXCEPTION_NOT_HANDLED = $80010001;
+ DBG_TERMINATE_THREAD = $40010003;
+ DBG_TERMINATE_PROCESS = $40010004;
+ { ControlService }
+ SERVICE_CONTROL_STOP = 1;
+ SERVICE_CONTROL_PAUSE = 2;
+ SERVICE_CONTROL_CONTINUE = 3;
+ SERVICE_CONTROL_INTERROGATE = 4;
+ SERVICE_CONTROL_SHUTDOWN = 5;
+ { CopyImage, LoadImage }
+ IMAGE_BITMAP = 0;
+ IMAGE_CURSOR = 2;
+ IMAGE_ENHMETAFILE = 1;
+ IMAGE_ICON = 1;
+ LR_COPYDELETEORG = 8;
+ LR_COPYRETURNORG = 4;
+ LR_MONOCHROME = 1;
+ LR_CREATEDIBSECTION = 8192;
+ LR_DEFAULTSIZE = 64;
+ { CreateDesktop }
+ DF_ALLOWOTHERACCOUNTHOOK = $1;
+ DESKTOP_CREATEMENU = $4;
+ DESKTOP_CREATEWINDOW = $2;
+ DESKTOP_ENUMERATE = $40;
+ DESKTOP_HOOKCONTROL = $8;
+ DESKTOP_JOURNALPLAYBACK = $20;
+ DESKTOP_JOURNALRECORD = $10;
+ DESKTOP_READOBJECTS = $1;
+ DESKTOP_SWITCHDESKTOP = $100;
+ DESKTOP_WRITEOBJECTS = $80;
+ WSF_VISIBLE = $1;
+ { CreateDIBitmap }
+ CBM_INIT = $4;
+ DIB_PAL_COLORS = 1;
+ DIB_RGB_COLORS = 0;
+ { CreateFile, GetFileAttributes, SetFileAttributes }
+ GENERIC_READ = $80000000;
+ GENERIC_WRITE = $40000000;
+ { file & pipe }
+ FILE_READ_DATA = $0001;
+ { directory }
+ FILE_LIST_DIRECTORY = $0001;
+ { file & pipe }
+ FILE_WRITE_DATA = $0002;
+ { directory }
+ FILE_ADD_FILE = $0002;
+ { file }
+ FILE_APPEND_DATA = $0004;
+ { directory }
+ FILE_ADD_SUBDIRECTORY = $0004;
+ { named pipe }
+ FILE_CREATE_PIPE_INSTANCE = $0004;
+ { file & directory }
+ FILE_READ_EA = $0008;
+ FILE_READ_PROPERTIES = FILE_READ_EA;
+ { file & directory }
+ FILE_WRITE_EA = $0010;
+ FILE_WRITE_PROPERTIES = FILE_WRITE_EA;
+ { file }
+ FILE_EXECUTE = $0020;
+ { directory }
+ FILE_TRAVERSE = $0020;
+ { directory }
+ FILE_DELETE_CHILD = $0040;
+ { all }
+ FILE_READ_ATTRIBUTES = $0080;
+ { all }
+ FILE_WRITE_ATTRIBUTES = $0100;
+ { displaced lower
+ #define FILE_ALL_ACCESS (STANDARD_RIGHTS_REQUIRED | SYNCHRONIZE | 0x1FF)
+
+ #define FILE_GENERIC_READ (STANDARD_RIGHTS_READ |\
+ FILE_READ_DATA |\
+ FILE_READ_ATTRIBUTES |\
+ FILE_READ_EA |\
+ SYNCHRONIZE)
+
+
+ #define FILE_GENERIC_WRITE (STANDARD_RIGHTS_WRITE |\
+ FILE_WRITE_DATA |\
+ FILE_WRITE_ATTRIBUTES |\
+ FILE_WRITE_EA |\
+ FILE_APPEND_DATA |\
+ SYNCHRONIZE)
+
+
+ #define FILE_GENERIC_EXECUTE (STANDARD_RIGHTS_EXECUTE |\
+ FILE_READ_ATTRIBUTES |\
+ FILE_EXECUTE |\
+ SYNCHRONIZE)
+ }
+ FILE_SHARE_DELETE = 4;
+ FILE_SHARE_READ = 1;
+ FILE_SHARE_WRITE = 2;
+ CONSOLE_TEXTMODE_BUFFER = 1;
+ CREATE_NEW = 1;
+ CREATE_ALWAYS = 2;
+ OPEN_EXISTING = 3;
+ OPEN_ALWAYS = 4;
+ TRUNCATE_EXISTING = 5;
+ FILE_ATTRIBUTE_ARCHIVE = 32;
+ FILE_ATTRIBUTE_COMPRESSED = 2048;
+ FILE_ATTRIBUTE_NORMAL = 128;
+ FILE_ATTRIBUTE_DIRECTORY = 16;
+ FILE_ATTRIBUTE_HIDDEN = 2;
+ FILE_ATTRIBUTE_READONLY = 1;
+ FILE_ATTRIBUTE_SYSTEM = 4;
+ FILE_ATTRIBUTE_TEMPORARY = 256;
+ FILE_FLAG_WRITE_THROUGH = $80000000;
+ FILE_FLAG_OVERLAPPED = 1073741824;
+ FILE_FLAG_NO_BUFFERING = 536870912;
+ FILE_FLAG_RANDOM_ACCESS = 268435456;
+ FILE_FLAG_SEQUENTIAL_SCAN = 134217728;
+ FILE_FLAG_DELETE_ON_CLOSE = 67108864;
+ FILE_FLAG_BACKUP_SEMANTICS = 33554432;
+ FILE_FLAG_POSIX_SEMANTICS = 16777216;
+ SECURITY_ANONYMOUS = 0;
+ SECURITY_IDENTIFICATION = 65536;
+ SECURITY_IMPERSONATION = 131072;
+ SECURITY_DELEGATION = 196608;
+ SECURITY_CONTEXT_TRACKING = 262144;
+ SECURITY_EFFECTIVE_ONLY = 524288;
+ SECURITY_SQOS_PRESENT = 1048576;
+ { CreateFileMapping, VirtualAlloc, VirtualFree, VirtualProtect }
+ SEC_COMMIT = 134217728;
+ SEC_IMAGE = 16777216;
+ SEC_NOCACHE = 268435456;
+ SEC_RESERVE = 67108864;
+ PAGE_READONLY = 2;
+ PAGE_READWRITE = 4;
+ PAGE_WRITECOPY = 8;
+ PAGE_EXECUTE = 16;
+ PAGE_EXECUTE_READ = 32;
+ PAGE_EXECUTE_READWRITE = 64;
+ PAGE_EXECUTE_WRITECOPY = 128;
+ PAGE_GUARD = 256;
+ PAGE_NOACCESS = 1;
+ PAGE_NOCACHE = 512;
+ MEM_COMMIT = 4096;
+ MEM_FREE = 65536;
+ MEM_RESERVE = 8192;
+ MEM_IMAGE = 16777216;
+ MEM_MAPPED = 262144;
+ MEM_PRIVATE = 131072;
+ MEM_DECOMMIT = 16384;
+ MEM_RELEASE = 32768;
+ MEM_TOP_DOWN = 1048576;
+ EXCEPTION_GUARD_PAGE = $80000001;
+ SECTION_EXTEND_SIZE = $10;
+ SECTION_MAP_READ = $4;
+ SECTION_MAP_WRITE = $2;
+ SECTION_QUERY = $1;
+ SECTION_ALL_ACCESS = $f001f;
+ { CreateFont }
+ FW_DONTCARE = 0;
+ FW_THIN = 100;
+ FW_EXTRALIGHT = 200;
+ FW_LIGHT = 300;
+ FW_NORMAL = 400;
+ FW_REGULAR = FW_NORMAL;
+ FW_MEDIUM = 500;
+ FW_SEMIBOLD = 600;
+ FW_BOLD = 700;
+ FW_EXTRABOLD = 800;
+ FW_HEAVY = 900;
+ ANSI_CHARSET = 0;
+ DEFAULT_CHARSET = 1;
+ SYMBOL_CHARSET = 2;
+ SHIFTJIS_CHARSET = 128;
+ HANGEUL_CHARSET = 129;
+ GB2312_CHARSET = 134;
+ CHINESEBIG5_CHARSET = 136;
+ GREEK_CHARSET = 161;
+ TURKISH_CHARSET = 162;
+ HEBREW_CHARSET = 177;
+ ARABIC_CHARSET = 178;
+ BALTIC_CHARSET = 186;
+ RUSSIAN_CHARSET = 204;
+ THAI_CHARSET = 222;
+ EASTEUROPE_CHARSET = 238;
+ OEM_CHARSET = 255;
+ OUT_DEFAULT_PRECIS = 0;
+ OUT_STRING_PRECIS = 1;
+ OUT_CHARACTER_PRECIS = 2;
+ OUT_STROKE_PRECIS = 3;
+ OUT_TT_PRECIS = 4;
+ OUT_DEVICE_PRECIS = 5;
+ OUT_RASTER_PRECIS = 6;
+ OUT_TT_ONLY_PRECIS = 7;
+ OUT_OUTLINE_PRECIS = 8;
+ CLIP_DEFAULT_PRECIS = 0;
+ CLIP_CHARACTER_PRECIS = 1;
+ CLIP_STROKE_PRECIS = 2;
+ CLIP_MASK = 15;
+ CLIP_LH_ANGLES = 16;
+ CLIP_TT_ALWAYS = 32;
+ CLIP_EMBEDDED = 128;
+ DEFAULT_QUALITY = 0;
+ DRAFT_QUALITY = 1;
+ PROOF_QUALITY = 2;
+ NONANTIALIASED_QUALITY = 3;
+ ANTIALIASED_QUALITY = 4;
+ DEFAULT_PITCH = 0;
+ FIXED_PITCH = 1;
+ VARIABLE_PITCH = 2;
+ MONO_FONT = 8;
+ FF_DECORATIVE = 80;
+ FF_DONTCARE = 0;
+ FF_MODERN = 48;
+ FF_ROMAN = 16;
+ FF_SCRIPT = 64;
+ FF_SWISS = 32;
+ { CreateHatchBrush }
+ HS_BDIAGONAL = 3;
+ HS_CROSS = 4;
+ HS_DIAGCROSS = 5;
+ HS_FDIAGONAL = 2;
+ HS_HORIZONTAL = 0;
+ HS_VERTICAL = 1;
+ { CreateIconFromResourceEx }
+ LR_DEFAULTCOLOR = 0;
+ LR_LOADREALSIZE = 128;
+ { already defined above !!
+ #define LR_MONOCHROME (1)
+ }
+ { CreateMailslot, GetMailslotInfo }
+ MAILSLOT_WAIT_FOREVER = $ffffffff;
+ MAILSLOT_NO_MESSAGE = $ffffffff;
+ { CreateMappedBitmap }
+ CMB_MASKED = 2;
+ { CreateNamedPipe }
+ PIPE_ACCESS_DUPLEX = 3;
+ PIPE_ACCESS_INBOUND = 1;
+ PIPE_ACCESS_OUTBOUND = 2;
+ WRITE_DAC = $40000;
+ WRITE_OWNER = $80000;
+ ACCESS_SYSTEM_SECURITY = $1000000;
+ PIPE_TYPE_BYTE = 0;
+ PIPE_TYPE_MESSAGE = 4;
+ PIPE_READMODE_BYTE = 0;
+ PIPE_READMODE_MESSAGE = 2;
+ PIPE_WAIT = 0;
+ PIPE_NOWAIT = 1;
+ { CreatePen, ExtCreatePen }
+ PS_GEOMETRIC = 65536;
+ PS_COSMETIC = 0;
+ PS_ALTERNATE = 8;
+ PS_SOLID = 0;
+ PS_DASH = 1;
+ PS_DOT = 2;
+ PS_DASHDOT = 3;
+ PS_DASHDOTDOT = 4;
+ PS_NULL = 5;
+ PS_USERSTYLE = 7;
+ PS_INSIDEFRAME = 6;
+ PS_ENDCAP_ROUND = 0;
+ PS_ENDCAP_SQUARE = 256;
+ PS_ENDCAP_FLAT = 512;
+ PS_JOIN_BEVEL = 4096;
+ PS_JOIN_MITER = 8192;
+ PS_JOIN_ROUND = 0;
+ PS_STYLE_MASK = 15;
+ PS_ENDCAP_MASK = 3840;
+ PS_TYPE_MASK = 983040;
+ { CreatePolygonRgn }
+ ALTERNATE = 1;
+ WINDING = 2;
+ { CreateProcess }
+ CREATE_DEFAULT_ERROR_MODE = 67108864;
+ CREATE_NEW_CONSOLE = 16;
+ CREATE_NEW_PROCESS_GROUP = 512;
+ CREATE_SEPARATE_WOW_VDM = 2048;
+ CREATE_SUSPENDED = 4;
+ CREATE_UNICODE_ENVIRONMENT = 1024;
+ DEBUG_PROCESS = 1;
+ DEBUG_ONLY_THIS_PROCESS = 2;
+ DETACHED_PROCESS = 8;
+ HIGH_PRIORITY_CLASS = 128;
+ IDLE_PRIORITY_CLASS = 64;
+ NORMAL_PRIORITY_CLASS = 32;
+ REALTIME_PRIORITY_CLASS = 256;
+ { CreateService }
+ SERVICE_ALL_ACCESS = $f01ff;
+ SERVICE_CHANGE_CONFIG = 2;
+ SERVICE_ENUMERATE_DEPENDENTS = 8;
+ SERVICE_INTERROGATE = 128;
+ SERVICE_PAUSE_CONTINUE = 64;
+ SERVICE_QUERY_CONFIG = 1;
+ SERVICE_QUERY_STATUS = 4;
+ SERVICE_START = 16;
+ SERVICE_STOP = 32;
+ SERVICE_USER_DEFINED_CONTROL = 256;
+ SERVICE_DELETE = $10000;
+ SERVICE_READ_CONTROL = $20000;
+ SERVICE_GENERIC_EXECUTE = $20000000;
+ { already defined above !!
+ #define SERVICE_WIN32_OWN_PROCESS (16)
+ #define SERVICE_WIN32_SHARE_PROCESS (32)
+ #define SERVICE_KERNEL_DRIVER (1)
+ #define SERVICE_FILE_SYSTEM_DRIVER (2)
+ #define SERVICE_INTERACTIVE_PROCESS (256)
+ #define SERVICE_BOOT_START (0)
+ #define SERVICE_SYSTEM_START (1)
+ #define SERVICE_AUTO_START (2)
+ #define SERVICE_DEMAND_START (3)
+ #define SERVICE_DISABLED (4)
+ }
+ SERVICE_ERROR_IGNORE = 0;
+ SERVICE_ERROR_NORMAL = 1;
+ SERVICE_ERROR_SEVERE = 2;
+ SERVICE_ERROR_CRITICAL = 3;
+ { CreateTapePartition, WriteTapemark }
+ TAPE_FIXED_PARTITIONS = 0;
+ TAPE_INITIATOR_PARTITIONS = $2;
+ TAPE_SELECT_PARTITIONS = $1;
+ TAPE_FILEMARKS = $1;
+ TAPE_LONG_FILEMARKS = $3;
+ TAPE_SETMARKS = 0;
+ TAPE_SHORT_FILEMARKS = $2;
+ { CreateWindow }
+ CW_USEDEFAULT = $80000000;
+ WS_BORDER = $800000;
+ WS_CAPTION = $c00000;
+ WS_CHILD = $40000000;
+ WS_CHILDWINDOW = $40000000;
+ WS_CLIPCHILDREN = $2000000;
+ WS_CLIPSIBLINGS = $4000000;
+ WS_DISABLED = $8000000;
+ WS_DLGFRAME = $400000;
+ WS_GROUP = $20000;
+ WS_HSCROLL = $100000;
+ WS_ICONIC = $20000000;
+ WS_MAXIMIZE = $1000000;
+ WS_MAXIMIZEBOX = $10000;
+ WS_MINIMIZE = $20000000;
+ WS_MINIMIZEBOX = $20000;
+ WS_OVERLAPPED = 0;
+ WS_OVERLAPPEDWINDOW = $cf0000;
+ WS_POPUP = $80000000;
+ WS_POPUPWINDOW = $80880000;
+ WS_SIZEBOX = $40000;
+ WS_SYSMENU = $80000;
+ WS_TABSTOP = $10000;
+ WS_THICKFRAME = $40000;
+ WS_TILED = 0;
+ WS_TILEDWINDOW = $cf0000;
+ WS_VISIBLE = $10000000;
+ WS_VSCROLL = $200000;
+ MDIS_ALLCHILDSTYLES = $1;
+ BS_3STATE = $5;
+ BS_AUTO3STATE = $6;
+ BS_AUTOCHECKBOX = $3;
+ BS_AUTORADIOBUTTON = $9;
+ BS_BITMAP = $80;
+ BS_BOTTOM = $800;
+ BS_CENTER = $300;
+ BS_CHECKBOX = $2;
+ BS_DEFPUSHBUTTON = $1;
+ BS_GROUPBOX = $7;
+ BS_ICON = $40;
+ BS_LEFT = $100;
+ BS_LEFTTEXT = $20;
+ BS_MULTILINE = $2000;
+ BS_NOTIFY = $4000;
+ BS_OWNERDRAW = $b;
+ BS_PUSHBUTTON = 0;
+ BS_PUSHLIKE = $1000;
+ BS_RADIOBUTTON = $4;
+ BS_RIGHT = $200;
+ BS_RIGHTBUTTON = $20;
+ BS_TEXT = 0;
+ BS_TOP = $400;
+ BS_USERBUTTON = $8;
+ BS_VCENTER = $c00;
+ BS_FLAT = $8000;
+ CBS_AUTOHSCROLL = $40;
+ CBS_DISABLENOSCROLL = $800;
+ CBS_DROPDOWN = $2;
+ CBS_DROPDOWNLIST = $3;
+ CBS_HASSTRINGS = $200;
+ CBS_LOWERCASE = $4000;
+ CBS_NOINTEGRALHEIGHT = $400;
+ CBS_OEMCONVERT = $80;
+ CBS_OWNERDRAWFIXED = $10;
+ CBS_OWNERDRAWVARIABLE = $20;
+ CBS_SIMPLE = $1;
+ CBS_SORT = $100;
+ CBS_UPPERCASE = $2000;
+ ES_AUTOHSCROLL = $80;
+ ES_AUTOVSCROLL = $40;
+ ES_CENTER = $1;
+ ES_LEFT = 0;
+ ES_LOWERCASE = $10;
+ ES_MULTILINE = $4;
+ ES_NOHIDESEL = $100;
+ ES_NUMBER = $2000;
+ ES_OEMCONVERT = $400;
+ ES_PASSWORD = $20;
+ ES_READONLY = $800;
+ ES_RIGHT = $2;
+ ES_UPPERCASE = $8;
+ ES_WANTRETURN = $1000;
+ LBS_DISABLENOSCROLL = $1000;
+ LBS_EXTENDEDSEL = $800;
+ LBS_HASSTRINGS = $40;
+ LBS_MULTICOLUMN = $200;
+ LBS_MULTIPLESEL = $8;
+ LBS_NODATA = $2000;
+ LBS_NOINTEGRALHEIGHT = $100;
+ LBS_NOREDRAW = $4;
+ LBS_NOSEL = $4000;
+ LBS_NOTIFY = $1;
+ LBS_OWNERDRAWFIXED = $10;
+ LBS_OWNERDRAWVARIABLE = $20;
+ LBS_SORT = $2;
+ LBS_STANDARD = $a00003;
+ LBS_USETABSTOPS = $80;
+ LBS_WANTKEYBOARDINPUT = $400;
+ SBS_BOTTOMALIGN = $4;
+ SBS_HORZ = 0;
+ SBS_LEFTALIGN = $2;
+ SBS_RIGHTALIGN = $4;
+ SBS_SIZEBOX = $8;
+ SBS_SIZEBOXBOTTOMRIGHTALIGN = $4;
+ SBS_SIZEBOXTOPLEFTALIGN = $2;
+ SBS_SIZEGRIP = $10;
+ SBS_TOPALIGN = $2;
+ SBS_VERT = $1;
+ SS_BITMAP = $e;
+ SS_BLACKFRAME = $7;
+ SS_BLACKRECT = $4;
+ SS_CENTER = $1;
+ SS_CENTERIMAGE = $200;
+ SS_ENHMETAFILE = $f;
+ SS_ETCHEDFRAME = $12;
+ SS_ETCHEDHORZ = $10;
+ SS_ETCHEDVERT = $11;
+ SS_GRAYFRAME = $8;
+ SS_GRAYRECT = $5;
+ SS_ICON = $3;
+ SS_LEFT = 0;
+ SS_LEFTNOWORDWRAP = $c;
+ SS_NOPREFIX = $80;
+ SS_NOTIFY = $100;
+ SS_OWNERDRAW = $d;
+ SS_REALSIZEIMAGE = $800;
+ SS_RIGHT = $2;
+ SS_RIGHTJUST = $400;
+ SS_SIMPLE = $b;
+ SS_SUNKEN = $1000;
+ SS_USERITEM = $a;
+ SS_WHITEFRAME = $9;
+ SS_WHITERECT = $6;
+ DS_3DLOOK = $4;
+ DS_ABSALIGN = $1;
+ DS_CENTER = $800;
+ DS_CENTERMOUSE = $1000;
+ DS_CONTEXTHELP = $2000;
+ DS_CONTROL = $400;
+ DS_FIXEDSYS = $8;
+ DS_LOCALEDIT = $20;
+ DS_MODALFRAME = $80;
+ DS_NOFAILCREATE = $10;
+ DS_NOIDLEMSG = $100;
+ DS_SETFONT = $40;
+ DS_SETFOREGROUND = $200;
+ DS_SYSMODAL = $2;
+ { CreateWindowEx }
+ WS_EX_ACCEPTFILES = $10;
+ WS_EX_APPWINDOW = $40000;
+ WS_EX_CLIENTEDGE = $200;
+ WS_EX_CONTEXTHELP = $400;
+ WS_EX_CONTROLPARENT = $10000;
+ WS_EX_DLGMODALFRAME = $1;
+ WS_EX_LEFT = 0;
+ WS_EX_LEFTSCROLLBAR = $4000;
+ WS_EX_LTRREADING = 0;
+ WS_EX_MDICHILD = $40;
+ WS_EX_NOPARENTNOTIFY = $4;
+ WS_EX_OVERLAPPEDWINDOW = $300;
+ WS_EX_PALETTEWINDOW = $188;
+ WS_EX_RIGHT = $1000;
+ WS_EX_RIGHTSCROLLBAR = 0;
+ WS_EX_RTLREADING = $2000;
+ WS_EX_STATICEDGE = $20000;
+ WS_EX_TOOLWINDOW = $80;
+ WS_EX_TOPMOST = $8;
+ WS_EX_TRANSPARENT = $20;
+ WS_EX_WINDOWEDGE = $100;
+ { CreateWindowStation }
+ WINSTA_ACCESSCLIPBOARD = $4;
+ WINSTA_ACCESSGLOBALATOMS = $20;
+ WINSTA_CREATEDESKTOP = $8;
+ WINSTA_ENUMDESKTOPS = $1;
+ WINSTA_ENUMERATE = $100;
+ WINSTA_EXITWINDOWS = $40;
+ WINSTA_READATTRIBUTES = $2;
+ WINSTA_READSCREEN = $200;
+ WINSTA_WRITEATTRIBUTES = $10;
+ { DdeCallback }
+ { DdeClientTransaction }
+ { DdeEnableCallback }
+ { DdeGetLastError }
+ { DdeInitialize }
+ { DdeNameService }
+ { DebugProc }
+ WH_CALLWNDPROC = 4;
+ WH_CALLWNDPROCRET = 12;
+ WH_CBT = 5;
+ WH_DEBUG = 9;
+ WH_GETMESSAGE = 3;
+ WH_JOURNALPLAYBACK = 1;
+ WH_JOURNALRECORD = 0;
+ WH_KEYBOARD = 2;
+ WH_MOUSE = 7;
+ WH_MSGFILTER = -(1);
+ WH_SHELL = 10;
+ WH_SYSMSGFILTER = 6;
+ { already defined above !!
+ #define WH_MSGFILTER (-1) }
+ WH_FOREGROUNDIDLE = 11;
+ { DefineDosDevice }
+ DDD_RAW_TARGET_PATH = 1;
+ DDD_REMOVE_DEFINITION = 2;
+ DDD_EXACT_MATCH_ON_REMOVE = 4;
+ { DeviceCapbilities }
+ DC_BINNAMES = 12;
+ DC_BINS = 6;
+ DC_COPIES = 18;
+ DC_DRIVER = 11;
+ DC_DATATYPE_PRODUCED = 21;
+ DC_DUPLEX = 7;
+ DC_EMF_COMPLIANT = 20;
+ DC_ENUMRESOLUTIONS = 13;
+ DC_EXTRA = 9;
+ DC_FIELDS = 1;
+ DC_FILEDEPENDENCIES = 14;
+ DC_MAXEXTENT = 5;
+ DC_MINEXTENT = 4;
+ DC_ORIENTATION = 17;
+ DC_PAPERNAMES = 16;
+ DC_PAPERS = 2;
+ DC_PAPERSIZE = 3;
+ DC_SIZE = 8;
+ DC_TRUETYPE = 15;
+ DCTT_BITMAP = $1;
+ DCTT_DOWNLOAD = $2;
+ DCTT_SUBDEV = $4;
+ DC_VERSION = 10;
+ DC_BINADJUST = 19;
+ { already defined above !!
+ #define DC_DATATYPE_PRODUCED (21)
+ }
+ { DeviceIoControl }
+ { DlgDirList }
+ DDL_ARCHIVE = 32;
+ DDL_DIRECTORY = 16;
+ DDL_DRIVES = 16384;
+ DDL_EXCLUSIVE = 32768;
+ DDL_HIDDEN = 2;
+ DDL_READONLY = 1;
+ DDL_READWRITE = 0;
+ DDL_SYSTEM = 4;
+ DDL_POSTMSGS = 8192;
+ { DllEntryPoint }
+ DLL_PROCESS_ATTACH = 1;
+ DLL_THREAD_ATTACH = 2;
+ DLL_PROCESS_DETACH = 0;
+ DLL_THREAD_DETACH = 3;
+ { DocumentProperties }
+ DM_IN_BUFFER = 8;
+ DM_MODIFY = 8;
+ DM_IN_PROMPT = 4;
+ DM_PROMPT = 4;
+ DM_OUT_BUFFER = 2;
+ DM_COPY = 2;
+ DM_UPDATE = 1;
+ { DrawAnimatedRects }
+ IDANI_OPEN = 1;
+ IDANI_CLOSE = 2;
+ { DrawCaption }
+ DC_ACTIVE = 1;
+ DC_SMALLCAP = 2;
+ { DrawEdge }
+ BDR_RAISEDINNER = 4;
+ BDR_SUNKENINNER = 8;
+ BDR_RAISEDOUTER = 1;
+ BDR_SUNKENOUTER = 1;
+ EDGE_BUMP = 9;
+ EDGE_ETCHED = 6;
+ EDGE_RAISED = 5;
+ EDGE_SUNKEN = 10;
+ BF_ADJUST = 8192;
+ BF_BOTTOM = 8;
+ BF_BOTTOMLEFT = 9;
+ BF_BOTTOMRIGHT = 12;
+ BF_DIAGONAL = 16;
+ BF_DIAGONAL_ENDBOTTOMLEFT = 25;
+ BF_DIAGONAL_ENDBOTTOMRIGHT = 28;
+ BF_DIAGONAL_ENDTOPLEFT = 19;
+ BF_DIAGONAL_ENDTOPRIGHT = 22;
+ BF_FLAT = 16384;
+ BF_LEFT = 1;
+ BF_MIDDLE = 2048;
+ BF_MONO = 32768;
+ BF_RECT = 15;
+ BF_RIGHT = 4;
+ BF_SOFT = 4096;
+ BF_TOP = 2;
+ BF_TOPLEFT = 3;
+ BF_TOPRIGHT = 6;
+ { DrawFrameControl }
+ DFC_BUTTON = 4;
+ DFC_CAPTION = 1;
+ DFC_MENU = 2;
+ DFC_SCROLL = 3;
+ DFCS_BUTTON3STATE = 8;
+ DFCS_BUTTONCHECK = 0;
+ DFCS_BUTTONPUSH = 16;
+ DFCS_BUTTONRADIO = 4;
+ DFCS_BUTTONRADIOIMAGE = 1;
+ DFCS_BUTTONRADIOMASK = 2;
+ DFCS_CAPTIONCLOSE = 0;
+ DFCS_CAPTIONHELP = 4;
+ DFCS_CAPTIONMAX = 2;
+ DFCS_CAPTIONMIN = 1;
+ DFCS_CAPTIONRESTORE = 3;
+ DFCS_MENUARROW = 0;
+ DFCS_MENUBULLET = 2;
+ DFCS_MENUCHECK = 1;
+ DFCS_SCROLLCOMBOBOX = 5;
+ DFCS_SCROLLDOWN = 1;
+ DFCS_SCROLLLEFT = 2;
+ DFCS_SCROLLRIGHT = 3;
+ DFCS_SCROLLSIZEGRIP = 8;
+ DFCS_SCROLLUP = 0;
+ DFCS_ADJUSTRECT = 8192;
+ DFCS_CHECKED = 1024;
+ DFCS_FLAT = 16384;
+ DFCS_INACTIVE = 256;
+ DFCS_MONO = 32768;
+ DFCS_PUSHED = 512;
+ { DrawIconEx }
+ DI_COMPAT = 4;
+ DI_DEFAULTSIZE = 8;
+ DI_IMAGE = 2;
+ DI_MASK = 1;
+ DI_NORMAL = 3;
+ { DrawState }
+ DST_BITMAP = 4;
+ DST_COMPLEX = 0;
+ DST_ICON = 3;
+ DST_PREFIXTEXT = 2;
+ DST_TEXT = 1;
+ DSS_NORMAL = 0;
+ DSS_UNION = 16;
+ DSS_DISABLED = 32;
+ DSS_MONO = 128;
+ { DrawStatusText }
+ SBT_NOBORDERS = 256;
+ SBT_OWNERDRAW = 4096;
+ SBT_POPOUT = 512;
+ SBT_RTLREADING = 1024;
+ { DrawText, DrawTextEx }
+ DT_BOTTOM = 8;
+ DT_CALCRECT = 1024;
+ DT_CENTER = 1;
+ DT_EDITCONTROL = 8192;
+ DT_END_ELLIPSIS = 32768;
+ DT_PATH_ELLIPSIS = 16384;
+ DT_EXPANDTABS = 64;
+ DT_EXTERNALLEADING = 512;
+ DT_LEFT = 0;
+ DT_MODIFYSTRING = 65536;
+ DT_NOCLIP = 256;
+ DT_NOPREFIX = 2048;
+ DT_RIGHT = 2;
+ DT_RTLREADING = 131072;
+ DT_SINGLELINE = 32;
+ DT_TABSTOP = 128;
+ DT_TOP = 0;
+ DT_VCENTER = 4;
+ DT_WORDBREAK = 16;
+ DT_INTERNAL = 4096;
+ { DuplicateHandle, MapViewOfFile }
+ DUPLICATE_CLOSE_SOURCE = 1;
+ DUPLICATE_SAME_ACCESS = 2;
+ FILE_MAP_ALL_ACCESS = $f001f;
+ FILE_MAP_READ = 4;
+ FILE_MAP_WRITE = 2;
+ FILE_MAP_COPY = 1;
+ MUTEX_ALL_ACCESS = $1f0001;
+ MUTEX_MODIFY_STATE = 1;
+ SYNCHRONIZE = $100000;
+ SEMAPHORE_ALL_ACCESS = $1f0003;
+ SEMAPHORE_MODIFY_STATE = 2;
+ EVENT_ALL_ACCESS = $1f0003;
+ EVENT_MODIFY_STATE = 2;
+ KEY_ALL_ACCESS = $f003f;
+ KEY_CREATE_LINK = 32;
+ KEY_CREATE_SUB_KEY = 4;
+ KEY_ENUMERATE_SUB_KEYS = 8;
+ KEY_EXECUTE = $20019;
+ KEY_NOTIFY = 16;
+ KEY_QUERY_VALUE = 1;
+ KEY_READ = $20019;
+ KEY_SET_VALUE = 2;
+ KEY_WRITE = $20006;
+ PROCESS_ALL_ACCESS = $1f0fff;
+ PROCESS_CREATE_PROCESS = 128;
+ PROCESS_CREATE_THREAD = 2;
+ PROCESS_DUP_HANDLE = 64;
+ PROCESS_QUERY_INFORMATION = 1024;
+ PROCESS_SET_INFORMATION = 512;
+ PROCESS_TERMINATE = 1;
+ PROCESS_VM_OPERATION = 8;
+ PROCESS_VM_READ = 16;
+ PROCESS_VM_WRITE = 32;
+ THREAD_ALL_ACCESS = $1f03ff;
+ THREAD_DIRECT_IMPERSONATION = 512;
+ THREAD_GET_CONTEXT = 8;
+ THREAD_IMPERSONATE = 256;
+ THREAD_QUERY_INFORMATION = 64;
+ THREAD_SET_CONTEXT = 16;
+ THREAD_SET_INFORMATION = 32;
+ THREAD_SET_THREAD_TOKEN = 128;
+ THREAD_SUSPEND_RESUME = 2;
+ THREAD_TERMINATE = 1;
+ { EditWordBreakProc }
+ WB_ISDELIMITER = 2;
+ WB_LEFT = 0;
+ WB_RIGHT = 1;
+ { EnableScrollBar }
+ SB_BOTH = 3;
+ SB_CTL = 2;
+ SB_HORZ = 0;
+ SB_VERT = 1;
+ ESB_DISABLE_BOTH = 3;
+ ESB_DISABLE_DOWN = 2;
+ ESB_DISABLE_LEFT = 1;
+ ESB_DISABLE_LTUP = 1;
+ ESB_DISABLE_RIGHT = 2;
+ ESB_DISABLE_RTDN = 2;
+ ESB_DISABLE_UP = 1;
+ ESB_ENABLE_BOTH = 0;
+ { Scroll Bar notifications }
+ SB_LINEUP = 0;
+ SB_LINEDOWN = 1;
+ SB_LINELEFT = 0;
+ SB_LINERIGHT = 1;
+ SB_PAGEUP = 2;
+ SB_PAGEDOWN = 3;
+ SB_PAGELEFT = 2;
+ SB_PAGERIGHT = 3;
+ SB_THUMBPOSITION = 4;
+ SB_THUMBTRACK = 5;
+ SB_ENDSCROLL = 8;
+ SB_LEFT = 6;
+ SB_RIGHT = 7;
+ SB_BOTTOM = 7;
+ SB_TOP = 6;
+ { EnumCalendarInfo }
+ ENUM_ALL_CALENDARS = -(1);
+ { EnumDateFormats }
+ DATE_SHORTDATE = 1;
+ DATE_LONGDATE = 2;
+ { EnumDependentServices }
+ SERVICE_ACTIVE = 1;
+ SERVICE_INACTIVE = 2;
+ { EnumFontFamExProc }
+ DEVICE_FONTTYPE = 2;
+ RASTER_FONTTYPE = 1;
+ TRUETYPE_FONTTYPE = 4;
+ { EnumObjects, GetCurrentObject, GetObjectType }
+ OBJ_BRUSH = 2;
+ OBJ_PEN = 1;
+ OBJ_PAL = 5;
+ OBJ_FONT = 6;
+ OBJ_BITMAP = 7;
+ OBJ_EXTPEN = 11;
+ OBJ_REGION = 8;
+ OBJ_DC = 3;
+ OBJ_MEMDC = 10;
+ OBJ_METAFILE = 9;
+ OBJ_METADC = 4;
+ OBJ_ENHMETAFILE = 13;
+ OBJ_ENHMETADC = 12;
+ { EnumPrinters }
+ { EnumProtocols }
+ { EnumResLangProc }
+ { was #define dname def_expr }
+ function RT_ACCELERATOR : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_BITMAP : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_DIALOG : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_FONT : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_FONTDIR : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_MENU : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_RCDATA : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_STRING : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_MESSAGETABLE : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_CURSOR : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_GROUP_CURSOR : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_ICON : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_GROUP_ICON : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function RT_VERSION : LPTSTR;
+ { return type might be wrong }
+
+ { EnumServicesStatus }
+
+ const
+ SERVICE_WIN32 = 48;
+ SERVICE_DRIVER = 11;
+ { EnumSystemCodePages }
+ CP_INSTALLED = 1;
+ CP_SUPPORTED = 2;
+ { EnumSystemLocales }
+ LCID_INSTALLED = 1;
+ LCID_SUPPORTED = 2;
+ { EraseTape }
+ TAPE_ERASE_LONG = $1;
+ TAPE_ERASE_SHORT = 0;
+ { Escape }
+ SP_ERROR = -(1);
+ SP_OUTOFDISK = -(4);
+ SP_OUTOFMEMORY = -(5);
+ SP_USERABORT = -(3);
+ PHYSICALWIDTH = 110;
+ PHYSICALHEIGHT = 111;
+ PHYSICALOFFSETX = 112;
+ PHYSICALOFFSETY = 113;
+ SCALINGFACTORX = 114;
+ SCALINGFACTORY = 115;
+ QUERYESCSUPPORT = 8;
+ {ABORTDOC = 2; conflicts with AbortDoc function }
+ cABORTDOC = 2;
+ {ENDDOC = 11; conflicts with AbortDoc function }
+ cENDDOC = 11;
+ GETPHYSPAGESIZE = 12;
+ GETPRINTINGOFFSET = 13;
+ GETSCALINGFACTOR = 14;
+ NEWFRAME = 1;
+ NEXTBAND = 3;
+ PASSTHROUGH = 19;
+ {SETABORTPROC = 9; conflicts with AbortDoc function }
+ cSETABORTPROC = 9;
+ {STARTDOC = 10; conflicts with AbortDoc function }
+ cSTARTDOC = 10;
+ { EscapeCommFunction }
+ CLRDTR = 6;
+ CLRRTS = 4;
+ SETDTR = 5;
+ SETRTS = 3;
+ SETXOFF = 1;
+ SETXON = 2;
+ SETBREAK = 8;
+ CLRBREAK = 9;
+ { ExitWindowsEx }
+ EWX_FORCE = 4;
+ EWX_LOGOFF = 0;
+ EWX_POWEROFF = 8;
+ EWX_REBOOT = 2;
+ EWX_SHUTDOWN = 1;
+ { ExtFloodFill }
+ FLOODFILLBORDER = 0;
+ FLOODFILLSURFACE = 1;
+ { ExtTextOut }
+ ETO_CLIPPED = 4;
+ ETO_GLYPH_INDEX = 16;
+ ETO_OPAQUE = 2;
+ ETO_RTLREADING = 128;
+ { FillConsoleOutputAttribute }
+ FOREGROUND_BLUE = 1;
+ FOREGROUND_GREEN = 2;
+ FOREGROUND_RED = 4;
+ FOREGROUND_INTENSITY = 8;
+ BACKGROUND_BLUE = 16;
+ BACKGROUND_GREEN = 32;
+ BACKGROUND_RED = 64;
+ BACKGROUND_INTENSITY = 128;
+ { FindFirstChangeNotification }
+ FILE_NOTIFY_CHANGE_FILE_NAME = 1;
+ FILE_NOTIFY_CHANGE_DIR_NAME = 2;
+ FILE_NOTIFY_CHANGE_ATTRIBUTES = 4;
+ FILE_NOTIFY_CHANGE_SIZE = 8;
+ FILE_NOTIFY_CHANGE_LAST_WRITE = 16;
+ FILE_NOTIFY_CHANGE_SECURITY = 256;
+ { FindFirstPrinterChangeNotification }
+ { FindNextPrinterNotification }
+ { FMExtensionProc }
+ { FoldString }
+ MAP_FOLDCZONE = 16;
+ MAP_FOLDDIGITS = 128;
+ MAP_PRECOMPOSED = 32;
+ MAP_COMPOSITE = 64;
+ { ForegroundIdleProc }
+ HC_ACTION = 0;
+ { FormatMessage }
+ FORMAT_MESSAGE_ALLOCATE_BUFFER = 256;
+ FORMAT_MESSAGE_IGNORE_INSERTS = 512;
+ FORMAT_MESSAGE_FROM_STRING = 1024;
+ FORMAT_MESSAGE_FROM_HMODULE = 2048;
+ FORMAT_MESSAGE_FROM_SYSTEM = 4096;
+ FORMAT_MESSAGE_ARGUMENT_ARRAY = 8192;
+ FORMAT_MESSAGE_MAX_WIDTH_MASK = 255;
+ { GdiComment }
+ GDICOMMENT_WINDOWS_METAFILE = -(2147483647);
+ GDICOMMENT_BEGINGROUP = 2;
+ GDICOMMENT_ENDGROUP = 3;
+ GDICOMMENT_MULTIFORMATS = 1073741828;
+ GDICOMMENT_IDENTIFIER = 1128875079;
+ { GenerateConsoleCtrlEvent, HandlerRoutine }
+ CTRL_C_EVENT = 0;
+ CTRL_BREAK_EVENT = 1;
+ CTRL_CLOSE_EVENT = 2;
+ CTRL_LOGOFF_EVENT = 5;
+ CTRL_SHUTDOWN_EVENT = 6;
+ { GetAddressByName }
+ { GetArcDirection }
+ AD_COUNTERCLOCKWISE = 1;
+ AD_CLOCKWISE = 2;
+ { GetBinaryTypes }
+ SCS_32BIT_BINARY = 0;
+ SCS_DOS_BINARY = 1;
+ SCS_OS216_BINARY = 5;
+ SCS_PIF_BINARY = 3;
+ SCS_POSIX_BINARY = 4;
+ SCS_WOW_BINARY = 2;
+ { GetBoundsRect, SetBoundsRect }
+ DCB_DISABLE = 8;
+ DCB_ENABLE = 4;
+ DCB_RESET = 1;
+ DCB_SET = 3;
+ DCB_ACCUMULATE = 2;
+ { GetCharacterPlacement, GetFontLanguageInfo }
+ GCP_DBCS = 1;
+ GCP_ERROR = $8000;
+ GCP_CLASSIN = $80000;
+ GCP_DIACRITIC = 256;
+ GCP_DISPLAYZWG = $400000;
+ GCP_GLYPHSHAPE = 16;
+ GCP_JUSTIFY = $10000;
+ GCP_JUSTIFYIN = $200000;
+ GCP_KASHIDA = 1024;
+ GCP_LIGATE = 32;
+ GCP_MAXEXTENT = $100000;
+ GCP_NEUTRALOVERRIDE = $2000000;
+ GCP_NUMERICOVERRIDE = $1000000;
+ GCP_NUMERICSLATIN = $4000000;
+ GCP_NUMERICSLOCAL = $8000000;
+ GCP_REORDER = 2;
+ GCP_SYMSWAPOFF = $800000;
+ GCP_USEKERNING = 8;
+ FLI_GLYPHS = $40000;
+ FLI_MASK = $103b;
+ { GetClassLong, GetClassWord }
+ GCW_ATOM = -(32);
+ GCL_CBCLSEXTRA = -(20);
+ GCL_CBWNDEXTRA = -(18);
+ GCL_HBRBACKGROUND = -(10);
+ GCL_HCURSOR = -(12);
+ GCL_HICON = -(14);
+ GCL_HICONSM = -(34);
+ GCL_HMODULE = -(16);
+ GCL_MENUNAME = -(8);
+ GCL_STYLE = -(26);
+ GCL_WNDPROC = -(24);
+ { GetClipboardFormat, SetClipboardData }
+ CF_BITMAP = 2;
+ CF_DIB = 8;
+ CF_PALETTE = 9;
+ CF_ENHMETAFILE = 14;
+ CF_METAFILEPICT = 3;
+ CF_OEMTEXT = 7;
+ CF_TEXT = 1;
+ CF_UNICODETEXT = 13;
+ CF_DIF = 5;
+ CF_DSPBITMAP = 130;
+ CF_DSPENHMETAFILE = 142;
+ CF_DSPMETAFILEPICT = 131;
+ CF_DSPTEXT = 129;
+ CF_GDIOBJFIRST = 768;
+ CF_GDIOBJLAST = 1023;
+ CF_HDROP = 15;
+ CF_LOCALE = 16;
+ CF_OWNERDISPLAY = 128;
+ CF_PENDATA = 10;
+ CF_PRIVATEFIRST = 512;
+ CF_PRIVATELAST = 767;
+ CF_RIFF = 11;
+ CF_SYLK = 4;
+ CF_WAVE = 12;
+ CF_TIFF = 6;
+ { GetCommMask }
+ EV_BREAK = 64;
+ EV_CTS = 8;
+ EV_DSR = 16;
+ EV_ERR = 128;
+ EV_EVENT1 = 2048;
+ EV_EVENT2 = 4096;
+ EV_PERR = 512;
+ EV_RING = 256;
+ EV_RLSD = 32;
+ EV_RX80FULL = 1024;
+ EV_RXCHAR = 1;
+ EV_RXFLAG = 2;
+ EV_TXEMPTY = 4;
+ { GetCommModemStatus }
+ MS_CTS_ON = $10;
+ MS_DSR_ON = $20;
+ MS_RING_ON = $40;
+ MS_RLSD_ON = $80;
+ { GetComputerName }
+ MAX_COMPUTERNAME_LENGTH = 15;
+ { GetConsoleMode }
+ ENABLE_LINE_INPUT = 2;
+ ENABLE_ECHO_INPUT = 4;
+ ENABLE_PROCESSED_INPUT = 1;
+ ENABLE_WINDOW_INPUT = 8;
+ ENABLE_MOUSE_INPUT = 16;
+ ENABLE_PROCESSED_OUTPUT = 1;
+ ENABLE_WRAP_AT_EOL_OUTPUT = 2;
+ { GetCPInfo }
+ CP_ACP = 0;
+ CP_MACCP = 2;
+ CP_OEMCP = 1;
+ { GetDateFormat }
+ { already defined above !!
+ #define DATE_SHORTDATE (1)
+ #define DATE_LONGDATE (2)
+ }
+ DATE_USE_ALT_CALENDAR = 4;
+ { GetDCEx }
+ DCX_WINDOW = $1;
+ DCX_CACHE = $2;
+ DCX_PARENTCLIP = $20;
+ DCX_CLIPSIBLINGS = $10;
+ DCX_CLIPCHILDREN = $8;
+ DCX_NORESETATTRS = $4;
+ DCX_LOCKWINDOWUPDATE = $400;
+ DCX_EXCLUDERGN = $40;
+ DCX_INTERSECTRGN = $80;
+ DCX_VALIDATE = $200000;
+ { GetDeviceCaps }
+ DRIVERVERSION = 0;
+ TECHNOLOGY = 2;
+ DT_PLOTTER = 0;
+ DT_RASDISPLAY = 1;
+ DT_RASPRINTER = 2;
+ DT_RASCAMERA = 3;
+ DT_CHARSTREAM = 4;
+ DT_METAFILE = 5;
+ DT_DISPFILE = 6;
+ HORZSIZE = 4;
+ VERTSIZE = 6;
+ HORZRES = 8;
+ VERTRES = 10;
+ LOGPIXELSX = 88;
+ LOGPIXELSY = 90;
+ BITSPIXEL = 12;
+ PLANES = 14;
+ NUMBRUSHES = 16;
+ NUMPENS = 18;
+ NUMFONTS = 22;
+ NUMCOLORS = 24;
+ ASPECTX = 40;
+ ASPECTY = 42;
+ ASPECTXY = 44;
+ PDEVICESIZE = 26;
+ CLIPCAPS = 36;
+ SIZEPALETTE = 104;
+ NUMRESERVED = 106;
+ COLORRES = 108;
+ { already defined above !!
+ #define PHYSICALWIDTH (110)
+ #define PHYSICALHEIGHT (111)
+ #define PHYSICALOFFSETX (112)
+ #define PHYSICALOFFSETY (113)
+ #define SCALINGFACTORX (114)
+ #define SCALINGFACTORY (115)
+ }
+ VREFRESH = 116;
+ DESKTOPHORZRES = 118;
+ DESKTOPVERTRES = 117;
+ BLTALIGNMENT = 119;
+ RASTERCAPS = 38;
+ RC_BANDING = 2;
+ RC_BITBLT = 1;
+ RC_BITMAP64 = 8;
+ RC_DI_BITMAP = 128;
+ RC_DIBTODEV = 512;
+ RC_FLOODFILL = 4096;
+ RC_GDI20_OUTPUT = 16;
+ RC_PALETTE = 256;
+ RC_SCALING = 4;
+ RC_STRETCHBLT = 2048;
+ RC_STRETCHDIB = 8192;
+ CURVECAPS = 28;
+ CC_NONE = 0;
+ CC_CIRCLES = 1;
+ CC_PIE = 2;
+ CC_CHORD = 4;
+ CC_ELLIPSES = 8;
+ CC_WIDE = 16;
+ CC_STYLED = 32;
+ CC_WIDESTYLED = 64;
+ CC_INTERIORS = 128;
+ CC_ROUNDRECT = 256;
+ LINECAPS = 30;
+ LC_NONE = 0;
+ LC_POLYLINE = 2;
+ LC_MARKER = 4;
+ LC_POLYMARKER = 8;
+ LC_WIDE = 16;
+ LC_STYLED = 32;
+ LC_WIDESTYLED = 64;
+ LC_INTERIORS = 128;
+ POLYGONALCAPS = 32;
+ PC_NONE = 0;
+ PC_POLYGON = 1;
+ PC_RECTANGLE = 2;
+ PC_WINDPOLYGON = 4;
+ PC_SCANLINE = 8;
+ PC_WIDE = 16;
+ PC_STYLED = 32;
+ PC_WIDESTYLED = 64;
+ PC_INTERIORS = 128;
+ TEXTCAPS = 34;
+ TC_OP_CHARACTER = 1;
+ TC_OP_STROKE = 2;
+ TC_CP_STROKE = 4;
+ TC_CR_90 = 8;
+ TC_CR_ANY = 16;
+ TC_SF_X_YINDEP = 32;
+ TC_SA_DOUBLE = 64;
+ TC_SA_INTEGER = 128;
+ TC_SA_CONTIN = 256;
+ TC_EA_DOUBLE = 512;
+ TC_IA_ABLE = 1024;
+ TC_UA_ABLE = 2048;
+ TC_SO_ABLE = 4096;
+ TC_RA_ABLE = 8192;
+ TC_VA_ABLE = 16384;
+ TC_RESERVED = 32768;
+ TC_SCROLLBLT = 65536;
+ PC_PATHS = 512;
+ { GetDriveType }
+ DRIVE_REMOVABLE = 2;
+ DRIVE_FIXED = 3;
+ DRIVE_REMOTE = 4;
+ DRIVE_CDROM = 5;
+ DRIVE_RAMDISK = 6;
+ DRIVE_UNKNOWN = 0;
+ DRIVE_NO_ROOT_DIR = 1;
+ { GetExceptionCode }
+ EXCEPTION_ACCESS_VIOLATION = $c0000005;
+ EXCEPTION_BREAKPOINT = $80000003;
+ EXCEPTION_DATATYPE_MISALIGNMENT = $80000002;
+ EXCEPTION_SINGLE_STEP = $80000004;
+ EXCEPTION_ARRAY_BOUNDS_EXCEEDED = $c000008c;
+ EXCEPTION_FLT_DENORMAL_OPERAND = $c000008d;
+ EXCEPTION_FLT_DIVIDE_BY_ZERO = $c000008e;
+ EXCEPTION_FLT_INEXACT_RESULT = $c000008f;
+ EXCEPTION_FLT_INVALID_OPERATION = $c0000090;
+ EXCEPTION_FLT_OVERFLOW = $c0000091;
+ EXCEPTION_FLT_STACK_CHECK = $c0000092;
+ EXCEPTION_FLT_UNDERFLOW = $c0000093;
+ EXCEPTION_INT_DIVIDE_BY_ZERO = $c0000094;
+ EXCEPTION_INT_OVERFLOW = $c0000095;
+ EXCEPTION_INVALID_HANDLE = $c0000008;
+ EXCEPTION_PRIV_INSTRUCTION = $c0000096;
+ EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025;
+ EXCEPTION_NONCONTINUABLE = $1;
+ EXCEPTION_STACK_OVERFLOW = $c00000fd;
+ EXCEPTION_INVALID_DISPOSITION = $c0000026;
+ EXCEPTION_IN_PAGE_ERROR = $c0000006;
+ EXCEPTION_ILLEGAL_INSTRUCTION = $c000001d;
+ EXCEPTION_POSSIBLE_DEADLOCK = $c0000194;
+ { GetFileType }
+ FILE_TYPE_UNKNOWN = 0;
+ FILE_TYPE_DISK = 1;
+ FILE_TYPE_CHAR = 2;
+ FILE_TYPE_PIPE = 3;
+ { GetGlyphOutline }
+ GGO_BITMAP = 1;
+ GGO_NATIVE = 2;
+ GGO_METRICS = 0;
+ GGO_GRAY2_BITMAP = 4;
+ GGO_GRAY4_BITMAP = 5;
+ GGO_GRAY8_BITMAP = 6;
+ GDI_ERROR = $ffffffff;
+ { GetGraphicsMode }
+ GM_COMPATIBLE = 1;
+ GM_ADVANCED = 2;
+ { GetHandleInformation }
+ HANDLE_FLAG_INHERIT = 1;
+ HANDLE_FLAG_PROTECT_FROM_CLOSE = 2;
+ { GetIconInfo }
+ { was #define dname def_expr }
+ function IDC_ARROW : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_IBEAM : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_WAIT : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_CROSS : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_UPARROW : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_SIZENWSE : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_SIZENESW : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_SIZEWE : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_SIZENS : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_SIZEALL : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_NO : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_APPSTARTING : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_HELP : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDI_APPLICATION : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDI_HAND : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDI_QUESTION : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDI_EXCLAMATION : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDI_ASTERISK : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDI_WINLOGO : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_SIZE : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_ICON : LPTSTR;
+ { return type might be wrong }
+
+ { was #define dname def_expr }
+ function IDC_HAND : LPTSTR;
+ { return type might be wrong }
+
+ { GetMapMode }
+
+ const
+ MM_ANISOTROPIC = 8;
+ MM_HIENGLISH = 5;
+ MM_HIMETRIC = 3;
+ MM_ISOTROPIC = 7;
+ MM_LOENGLISH = 4;
+ MM_LOMETRIC = 2;
+ MM_TEXT = 1;
+ MM_TWIPS = 6;
+ { GetMenuDefaultItem }
+ GMDI_GOINTOPOPUPS = $2;
+ GMDI_USEDISABLED = $1;
+ { PeekMessage }
+ PM_NOREMOVE = 0;
+ PM_REMOVE = 1;
+ PM_NOYIELD = 2;
+ { GetNamedPipeHandleState }
+ { PIPE_NOWAIT = 1; already above }
+ { PIPE_READMODE_MESSAGE = 2;already above }
+ { GetNamedPipeInfo }
+ PIPE_CLIENT_END = 0;
+ PIPE_SERVER_END = 1;
+ { PIPE_TYPE_MESSAGE = 4;already above }
+ { GetNextWindow, GetWindow }
+ GW_HWNDNEXT = 2;
+ GW_HWNDPREV = 3;
+ GW_CHILD = 5;
+ GW_HWNDFIRST = 0;
+ GW_HWNDLAST = 1;
+ GW_OWNER = 4;
+ { GetPath }
+ PT_MOVETO = 6;
+ PT_LINETO = 2;
+ PT_BEZIERTO = 4;
+ PT_CLOSEFIGURE = 1;
+ { GetProcessShutdownParameters }
+ SHUTDOWN_NORETRY = 1;
+ { GetQueueStatus }
+ QS_ALLEVENTS = 191;
+ QS_ALLINPUT = 255;
+ QS_HOTKEY = 128;
+ QS_INPUT = 7;
+ QS_KEY = 1;
+ QS_MOUSE = 6;
+ QS_MOUSEBUTTON = 4;
+ QS_MOUSEMOVE = 2;
+ QS_PAINT = 32;
+ QS_POSTMESSAGE = 8;
+ QS_SENDMESSAGE = 64;
+ QS_TIMER = 16;
+ { GetScrollInfo, SetScrollInfo }
+ SIF_ALL = 23;
+ SIF_PAGE = 2;
+ SIF_POS = 4;
+ SIF_RANGE = 1;
+ SIF_DISABLENOSCROLL = 8;
+ { GetStdHandle }
+ { was #define dname def_expr }
+ function STD_INPUT_HANDLE : DWORD;
+
+ { was #define dname def_expr }
+ function STD_OUTPUT_HANDLE : DWORD;
+
+ { was #define dname def_expr }
+ function STD_ERROR_HANDLE : DWORD;
+
+ { was #define dname def_expr }
+Const
+ INVALID_HANDLE_VALUE = HANDLE(-1);
+
+ { GetStockObject }
+
+ const
+ BLACK_BRUSH = 4;
+ DKGRAY_BRUSH = 3;
+ GRAY_BRUSH = 2;
+ HOLLOW_BRUSH = 5;
+ LTGRAY_BRUSH = 1;
+ NULL_BRUSH = 5;
+ WHITE_BRUSH = 0;
+ BLACK_PEN = 7;
+ NULL_PEN = 8;
+ WHITE_PEN = 6;
+ ANSI_FIXED_FONT = 11;
+ ANSI_VAR_FONT = 12;
+ DEVICE_DEFAULT_FONT = 14;
+ DEFAULT_GUI_FONT = 17;
+ OEM_FIXED_FONT = 10;
+ SYSTEM_FONT = 13;
+ SYSTEM_FIXED_FONT = 16;
+ DEFAULT_PALETTE = 15;
+ { GetStringTypeA }
+ CT_CTYPE1 = 1;
+ CT_CTYPE2 = 2;
+ CT_CTYPE3 = 4;
+ C1_UPPER = 1;
+ C1_LOWER = 2;
+ C1_DIGIT = 4;
+ C1_SPACE = 8;
+ C1_PUNCT = 16;
+ C1_CNTRL = 32;
+ C1_BLANK = 64;
+ C1_XDIGIT = 128;
+ C1_ALPHA = 256;
+ C2_LEFTTORIGHT = 1;
+ C2_RIGHTTOLEFT = 2;
+ C2_EUROPENUMBER = 3;
+ C2_EUROPESEPARATOR = 4;
+ C2_EUROPETERMINATOR = 5;
+ C2_ARABICNUMBER = 6;
+ C2_COMMONSEPARATOR = 7;
+ C2_BLOCKSEPARATOR = 8;
+ C2_SEGMENTSEPARATOR = 9;
+ C2_WHITESPACE = 10;
+ C2_OTHERNEUTRAL = 11;
+ C2_NOTAPPLICABLE = 0;
+ C3_NONSPACING = 1;
+ C3_DIACRITIC = 2;
+ C3_VOWELMARK = 4;
+ C3_SYMBOL = 8;
+ C3_KATAKANA = 16;
+ C3_HIRAGANA = 32;
+ C3_HALFWIDTH = 64;
+ C3_FULLWIDTH = 128;
+ C3_IDEOGRAPH = 256;
+ C3_KASHIDA = 512;
+ C3_ALPHA = 32768;
+ C3_NOTAPPLICABLE = 0;
+ { GetSysColor }
+ COLOR_3DDKSHADOW = 21;
+ COLOR_3DFACE = 15;
+ COLOR_3DHILIGHT = 20;
+ COLOR_3DLIGHT = 22;
+ COLOR_BTNHILIGHT = 20;
+ COLOR_3DSHADOW = 16;
+ COLOR_ACTIVEBORDER = 10;
+ COLOR_ACTIVECAPTION = 2;
+ COLOR_APPWORKSPACE = 12;
+ COLOR_BACKGROUND = 1;
+ COLOR_DESKTOP = 1;
+ COLOR_BTNFACE = 15;
+ COLOR_BTNHIGHLIGHT = 20;
+ COLOR_BTNSHADOW = 16;
+ COLOR_BTNTEXT = 18;
+ COLOR_CAPTIONTEXT = 9;
+ COLOR_GRAYTEXT = 17;
+ COLOR_HIGHLIGHT = 13;
+ COLOR_HIGHLIGHTTEXT = 14;
+ COLOR_INACTIVEBORDER = 11;
+ COLOR_INACTIVECAPTION = 3;
+ COLOR_INACTIVECAPTIONTEXT = 19;
+ COLOR_INFOBK = 24;
+ COLOR_INFOTEXT = 23;
+ COLOR_MENU = 4;
+ COLOR_MENUTEXT = 7;
+ COLOR_SCROLLBAR = 0;
+ COLOR_WINDOW = 5;
+ COLOR_WINDOWFRAME = 6;
+ COLOR_WINDOWTEXT = 8;
+ { GetSystemMetrics }
+ SM_CYMIN = 29;
+ SM_CXMIN = 28;
+ SM_ARRANGE = 56;
+ SM_CLEANBOOT = 67;
+ { The right value for SM_CEMETRICS for NT 3.5 is 75. For Windows 95
+ and NT 4.0, it is 76. The meaning is undocumented, anyhow. }
+ SM_CMETRICS = 76;
+ SM_CMOUSEBUTTONS = 43;
+ SM_CXBORDER = 5;
+ SM_CYBORDER = 6;
+ SM_CXCURSOR = 13;
+ SM_CYCURSOR = 14;
+ SM_CXDLGFRAME = 7;
+ SM_CYDLGFRAME = 8;
+ SM_CXDOUBLECLK = 36;
+ SM_CYDOUBLECLK = 37;
+ SM_CXDRAG = 68;
+ SM_CYDRAG = 69;
+ SM_CXEDGE = 45;
+ SM_CYEDGE = 46;
+ SM_CXFIXEDFRAME = 7;
+ SM_CYFIXEDFRAME = 8;
+ SM_CXFRAME = 32;
+ SM_CYFRAME = 33;
+ SM_CXFULLSCREEN = 16;
+ SM_CYFULLSCREEN = 17;
+ SM_CXHSCROLL = 21;
+ SM_CYHSCROLL = 3;
+ SM_CXHTHUMB = 10;
+ SM_CXICON = 11;
+ SM_CYICON = 12;
+ SM_CXICONSPACING = 38;
+ SM_CYICONSPACING = 39;
+ SM_CXMAXIMIZED = 61;
+ SM_CYMAXIMIZED = 62;
+ SM_CXMAXTRACK = 59;
+ SM_CYMAXTRACK = 60;
+ SM_CXMENUCHECK = 71;
+ SM_CYMENUCHECK = 72;
+ SM_CXMENUSIZE = 54;
+ SM_CYMENUSIZE = 55;
+ SM_CXMINIMIZED = 57;
+ SM_CYMINIMIZED = 58;
+ SM_CXMINSPACING = 47;
+ SM_CYMINSPACING = 48;
+ SM_CXMINTRACK = 34;
+ SM_CYMINTRACK = 35;
+ SM_CXSCREEN = 0;
+ SM_CYSCREEN = 1;
+ SM_CXSIZE = 30;
+ SM_CYSIZE = 31;
+ SM_CXSIZEFRAME = 32;
+ SM_CYSIZEFRAME = 33;
+ SM_CXSMICON = 49;
+ SM_CYSMICON = 50;
+ SM_CXSMSIZE = 52;
+ SM_CYSMSIZE = 53;
+ SM_CXVSCROLL = 2;
+ {SM_CYHSCROLL = 3;already above }
+ {SM_CXHSCROLL = 21;already above }
+ SM_CYVSCROLL = 20;
+ SM_CYVTHUMB = 9;
+ SM_CYCAPTION = 4;
+ SM_CYKANJIWINDOW = 18;
+ SM_CYMENU = 15;
+ SM_CYSMCAPTION = 51;
+ SM_DBCSENABLED = 42;
+ SM_DEBUG = 22;
+ SM_MENUDROPALIGNMENT = 40;
+ SM_MIDEASTENABLED = 74;
+ SM_MOUSEPRESENT = 19;
+ SM_MOUSEWHEELPRESENT = 75;
+ SM_NETWORK = 63;
+ SM_PENWINDOWS = 41;
+ SM_SECURE = 44;
+ SM_SHOWSOUNDS = 70;
+ SM_SLOWMACHINE = 73;
+ SM_SWAPBUTTON = 23;
+ ARW_BOTTOMLEFT = 0;
+ ARW_BOTTOMRIGHT = $1;
+ ARW_HIDE = $8;
+ ARW_TOPLEFT = $2;
+ ARW_TOPRIGHT = $3;
+ ARW_DOWN = $4;
+ ARW_LEFT = 0;
+ ARW_RIGHT = 0;
+ ARW_UP = $4;
+ { GetSystemPaletteUse }
+ SYSPAL_NOSTATIC = 2;
+ SYSPAL_STATIC = 1;
+ SYSPAL_ERROR = 0;
+ { GetTapeParameters, SetTapeParameters }
+ GET_TAPE_MEDIA_INFORMATION = 0;
+ GET_TAPE_DRIVE_INFORMATION = 1;
+ SET_TAPE_MEDIA_INFORMATION = 0;
+ SET_TAPE_DRIVE_INFORMATION = 1;
+ { GetTapePosition }
+ TAPE_ABSOLUTE_POSITION = 0;
+ TAPE_LOGICAL_POSITION = $1;
+ { GetTextAlign }
+ TA_BASELINE = 24;
+ TA_BOTTOM = 8;
+ TA_TOP = 0;
+ TA_CENTER = 6;
+ TA_LEFT = 0;
+ TA_RIGHT = 2;
+ TA_RTLREADING = 256;
+ TA_NOUPDATECP = 0;
+ TA_UPDATECP = 1;
+ VTA_BASELINE = 24;
+ VTA_CENTER = 6;
+ { GetThreadPriority }
+ THREAD_PRIORITY_ABOVE_NORMAL = 1;
+ THREAD_PRIORITY_BELOW_NORMAL = -(1);
+ THREAD_PRIORITY_HIGHEST = 2;
+ THREAD_PRIORITY_IDLE = -(15);
+ THREAD_PRIORITY_LOWEST = -(2);
+ THREAD_PRIORITY_NORMAL = 0;
+ THREAD_PRIORITY_TIME_CRITICAL = 15;
+ THREAD_PRIORITY_ERROR_RETURN = 2147483647;
+ TLS_MINIMUM_AVAILABLE = 64;
+ { GetTimeFormat }
+ TIME_NOMINUTESORSECONDS = 1;
+ TIME_NOSECONDS = 2;
+ TIME_NOTIMEMARKER = 4;
+ TIME_FORCE24HOURFORMAT = 8;
+ { GetTimeZoneInformation }
+ { was #define dname def_expr }
+
+
+ const
+ TIME_ZONE_ID_INVALID = DWORD(-1);
+ TIME_ZONE_ID_UNKNOWN = 0;
+ TIME_ZONE_ID_STANDARD = 1;
+ TIME_ZONE_ID_DAYLIGHT = 2;
+ { GetUserObjectInformation }
+ UOI_FLAGS = 1;
+ UOI_NAME = 2;
+ UOI_TYPE = 3;
+ { GetVolumeInformation }
+ FS_CASE_IS_PRESERVED = 2;
+ FS_CASE_SENSITIVE = 1;
+ FS_UNICODE_STORED_ON_DISK = 4;
+ FS_PERSISTENT_ACLS = 8;
+ FS_FILE_COMPRESSION = 16;
+ FS_VOL_IS_COMPRESSED = 32768;
+ { GetWindowLong }
+ GWL_EXSTYLE = -(20);
+ GWL_STYLE = -(16);
+ GWL_WNDPROC = -(4);
+ GWL_HINSTANCE = -(6);
+ GWL_HWNDPARENT = -(8);
+ GWL_ID = -(12);
+ GWL_USERDATA = -(21);
+ DWL_DLGPROC = 4;
+ DWL_MSGRESULT = 0;
+ DWL_USER = 8;
+ { GlobalAlloc, GlobalFlags }
+ GMEM_FIXED = 0;
+ GMEM_MOVEABLE = 2;
+ GPTR = 64;
+ GHND = 66;
+ GMEM_DDESHARE = 8192;
+ GMEM_DISCARDABLE = 256;
+ GMEM_LOWER = 4096;
+ GMEM_NOCOMPACT = 16;
+ GMEM_NODISCARD = 32;
+ GMEM_NOT_BANKED = 4096;
+ GMEM_NOTIFY = 16384;
+ GMEM_SHARE = 8192;
+ GMEM_ZEROINIT = 64;
+ GMEM_DISCARDED = 16384;
+ GMEM_INVALID_HANDLE = 32768;
+ GMEM_LOCKCOUNT = 255;
+ { HeapAlloc, HeapReAlloc }
+ HEAP_GENERATE_EXCEPTIONS = 4;
+ HEAP_NO_SERIALIZE = 1;
+ HEAP_ZERO_MEMORY = 8;
+ STATUS_NO_MEMORY = $c0000017;
+ STATUS_ACCESS_VIOLATION = $c0000005;
+ HEAP_REALLOC_IN_PLACE_ONLY = 16;
+ { ImageList_Create }
+ ILC_COLOR = 0;
+ ILC_COLOR4 = 4;
+ ILC_COLOR8 = 8;
+ ILC_COLOR16 = 16;
+ ILC_COLOR24 = 24;
+ ILC_COLOR32 = 32;
+ ILC_COLORDDB = 254;
+ ILC_MASK = 1;
+ ILC_PALETTE = 2048;
+ { ImageList_Draw, ImageList_DrawEx }
+ ILD_BLEND25 = 2;
+ ILD_BLEND50 = 4;
+ ILD_SELECTED = 4;
+ ILD_BLEND = 4;
+ ILD_FOCUS = 2;
+ ILD_MASK = 16;
+ ILD_NORMAL = 0;
+ ILD_TRANSPARENT = 1;
+ CLR_NONE = $ffffffff;
+ CLR_DEFAULT = $ff000000;
+ CLR_INVALID = $FFFFFFFF;
+ { ImageList_LoadImage }
+ {LR_DEFAULTCOLOR = 0;already above }
+ LR_LOADFROMFILE = 16;
+ LR_LOADMAP3DCOLORS = 4096;
+ LR_LOADTRANSPARENT = 32;
+ {LR_MONOCHROME = 1;already above }
+ { ImmConfigureIME }
+ IME_CONFIG_GENERAL = 1;
+ IME_CONFIG_REGISTERWORD = 2;
+ IME_CONFIG_SELECTDICTIONARY = 3;
+ { ImmGetConversionList }
+ GCL_CONVERSION = 1;
+ GCL_REVERSECONVERSION = 2;
+ GCL_REVERSE_LENGTH = 3;
+ { ImmGetGuideLine }
+ GGL_LEVEL = 1;
+ GGL_INDEX = 2;
+ GGL_STRING = 3;
+ GGL_PRIVATE = 4;
+ GL_LEVEL_ERROR = 2;
+ GL_LEVEL_FATAL = 1;
+ GL_LEVEL_INFORMATION = 4;
+ GL_LEVEL_NOGUIDELINE = 0;
+ GL_LEVEL_WARNING = 3;
+ GL_ID_CANNOTSAVE = 17;
+ GL_ID_NOCONVERT = 32;
+ GL_ID_NODICTIONARY = 16;
+ GL_ID_NOMODULE = 1;
+ GL_ID_READINGCONFLICT = 35;
+ GL_ID_TOOMANYSTROKE = 34;
+ GL_ID_TYPINGERROR = 33;
+ GL_ID_UNKNOWN = 0;
+ GL_ID_INPUTREADING = 36;
+ GL_ID_INPUTRADICAL = 37;
+ GL_ID_INPUTCODE = 38;
+ GL_ID_CHOOSECANDIDATE = 40;
+ GL_ID_REVERSECONVERSION = 41;
+ { ImmGetProperty }
+ IGP_PROPERTY = 4;
+ IGP_CONVERSION = 8;
+ IGP_SENTENCE = 12;
+ IGP_UI = 16;
+ IGP_SETCOMPSTR = 20;
+ IGP_SELECT = 24;
+ IME_PROP_AT_CARET = 65536;
+ IME_PROP_SPECIAL_UI = 131072;
+ IME_PROP_CANDLIST_START_FROM_1 = 262144;
+ IME_PROP_UNICODE = 524288;
+ UI_CAP_2700 = 1;
+ UI_CAP_ROT90 = 2;
+ UI_CAP_ROTANY = 4;
+ SCS_CAP_COMPSTR = 1;
+ SCS_CAP_MAKEREAD = 2;
+ SELECT_CAP_CONVERSION = 1;
+ SELECT_CAP_SENTENCE = 2;
+ { ImmNotifyIME }
+ NI_CHANGECANDIDATELIST = 19;
+ NI_CLOSECANDIDATE = 17;
+ NI_COMPOSITIONSTR = 21;
+ NI_OPENCANDIDATE = 16;
+ NI_SELECTCANDIDATESTR = 18;
+ NI_SETCANDIDATE_PAGESIZE = 23;
+ NI_SETCANDIDATE_PAGESTART = 22;
+ CPS_CANCEL = 4;
+ CPS_COMPLETE = 1;
+ CPS_CONVERT = 2;
+ CPS_REVERT = 3;
+ { ImmSetCompositionString }
+ SCS_SETSTR = 9;
+ SCS_CHANGEATTR = 18;
+ SCS_CHANGECLAUSE = 36;
+ { ImmUnregisterWord }
+ IME_REGWORD_STYLE_EUDC = 1;
+ IME_REGWORD_STYLE_USER_FIRST = $80000000;
+ IME_REGWORD_STYLE_USER_LAST = -(1);
+ { InitializeSecurityDescriptor }
+ SECURITY_DESCRIPTOR_REVISION = 1;
+ { IsTextUnicode }
+ IS_TEXT_UNICODE_ASCII16 = 1;
+ IS_TEXT_UNICODE_REVERSE_ASCII16 = 16;
+ IS_TEXT_UNICODE_STATISTICS = 2;
+ IS_TEXT_UNICODE_REVERSE_STATISTICS = 32;
+ IS_TEXT_UNICODE_CONTROLS = 4;
+ IS_TEXT_UNICODE_REVERSE_CONTROLS = 64;
+ IS_TEXT_UNICODE_SIGNATURE = 8;
+ IS_TEXT_UNICODE_REVERSE_SIGNATURE = 128;
+ IS_TEXT_UNICODE_ILLEGAL_CHARS = 256;
+ IS_TEXT_UNICODE_ODD_LENGTH = 512;
+ IS_TEXT_UNICODE_NULL_BYTES = 4096;
+ IS_TEXT_UNICODE_UNICODE_MASK = 15;
+ IS_TEXT_UNICODE_REVERSE_MASK = 240;
+ IS_TEXT_UNICODE_NOT_UNICODE_MASK = 3840;
+ IS_TEXT_UNICODE_NOT_ASCII_MASK = 61440;
+ { JournalPlaybackProc, KeyboardProc }
+ HC_GETNEXT = 1;
+ HC_SKIP = 2;
+ HC_SYSMODALOFF = 5;
+ HC_SYSMODALON = 4;
+ HC_NOREMOVE = 3;
+ { keybd_event }
+ KEYEVENTF_EXTENDEDKEY = 1;
+ KEYEVENTF_KEYUP = 2;
+ { LoadBitmap }
+ OBM_BTNCORNERS = 32758;
+ OBM_BTSIZE = 32761;
+ OBM_CHECK = 32760;
+ OBM_CHECKBOXES = 32759;
+ OBM_CLOSE = 32754;
+ OBM_COMBO = 32738;
+ OBM_DNARROW = 32752;
+ OBM_DNARROWD = 32742;
+ OBM_DNARROWI = 32736;
+ OBM_LFARROW = 32750;
+ OBM_LFARROWI = 32734;
+ OBM_LFARROWD = 32740;
+ OBM_MNARROW = 32739;
+ OBM_OLD_CLOSE = 32767;
+ OBM_OLD_DNARROW = 32764;
+ OBM_OLD_LFARROW = 32762;
+ OBM_OLD_REDUCE = 32757;
+ OBM_OLD_RESTORE = 32755;
+ OBM_OLD_RGARROW = 32763;
+ OBM_OLD_UPARROW = 32765;
+ OBM_OLD_ZOOM = 32756;
+ OBM_REDUCE = 32749;
+ OBM_REDUCED = 32746;
+ OBM_RESTORE = 32747;
+ OBM_RESTORED = 32744;
+ OBM_RGARROW = 32751;
+ OBM_RGARROWD = 32741;
+ OBM_RGARROWI = 32735;
+ OBM_SIZE = 32766;
+ OBM_UPARROW = 32753;
+ OBM_UPARROWD = 32743;
+ OBM_UPARROWI = 32737;
+ OBM_ZOOM = 32748;
+ OBM_ZOOMD = 32745;
+ { LoadLibraryEx }
+ DONT_RESOLVE_DLL_REFERENCES = 1;
+ LOAD_LIBRARY_AS_DATAFILE = 2;
+ LOAD_WITH_ALTERED_SEARCH_PATH = 8;
+ { LocalAlloc, LocalFlags }
+ LPTR = 64;
+ LHND = 66;
+ NONZEROLHND = 2;
+ NONZEROLPTR = 0;
+ LMEM_NONZEROLHND = 2;
+ LMEM_NONZEROLPTR = 0;
+ LMEM_FIXED = 0;
+ LMEM_MOVEABLE = 2;
+ LMEM_NOCOMPACT = 16;
+ LMEM_NODISCARD = 32;
+ LMEM_ZEROINIT = 64;
+ LMEM_MODIFY = 128;
+ LMEM_LOCKCOUNT = 255;
+ LMEM_DISCARDABLE = 3840;
+ LMEM_DISCARDED = 16384;
+ LMEM_INVALID_HANDLE = 32768;
+ { LockFileEx }
+ LOCKFILE_FAIL_IMMEDIATELY = 1;
+ LOCKFILE_EXCLUSIVE_LOCK = 2;
+ { LogonUser }
+ { LZCopy, LZInit, LZRead }
+ { MessageBeep, MessageBox }
+ MB_USERICON = $80;
+ MB_ICONASTERISK = $40;
+ MB_ICONEXCLAMATION = $30;
+ MB_ICONWARNING = $30;
+ MB_ICONERROR = $10;
+ MB_ICONHAND = $10;
+ MB_ICONQUESTION = $20;
+ MB_OK = 0;
+ MB_ABORTRETRYIGNORE = $2;
+ MB_APPLMODAL = 0;
+ MB_DEFAULT_DESKTOP_ONLY = $20000;
+ MB_HELP = $4000;
+ MB_RIGHT = $80000;
+ MB_RTLREADING = $100000;
+ MB_TOPMOST = $40000;
+ MB_DEFBUTTON1 = 0;
+ MB_DEFBUTTON2 = $100;
+ MB_DEFBUTTON3 = $200;
+ MB_DEFBUTTON4 = $300;
+ MB_ICONINFORMATION = $40;
+ MB_ICONSTOP = $10;
+ MB_OKCANCEL = $1;
+ MB_RETRYCANCEL = $5;
+ MB_SERVICE_NOTIFICATION = $40000;
+ MB_SETFOREGROUND = $10000;
+ MB_SYSTEMMODAL = $1000;
+ MB_TASKMODAL = $2000;
+ MB_YESNO = $4;
+ MB_YESNOCANCEL = $3;
+ IDABORT = 3;
+ IDCANCEL = 2;
+ IDCLOSE = 8;
+ IDHELP = 9;
+ IDIGNORE = 5;
+ IDNO = 7;
+ IDOK = 1;
+ IDRETRY = 4;
+ IDYES = 6;
+ { MessageProc }
+ MSGF_DIALOGBOX = 0;
+ MSGF_MENU = 2;
+ MSGF_NEXTWINDOW = 6;
+ MSGF_SCROLLBAR = 5;
+ MSGF_MAINLOOP = 8;
+ MSGF_USER = 4096;
+ { ModifyWorldTransform }
+ MWT_IDENTITY = 1;
+ MWT_LEFTMULTIPLY = 2;
+ MWT_RIGHTMULTIPLY = 3;
+ { mouse_event }
+ MOUSEEVENTF_ABSOLUTE = 32768;
+ MOUSEEVENTF_MOVE = 1;
+ MOUSEEVENTF_LEFTDOWN = 2;
+ MOUSEEVENTF_LEFTUP = 4;
+ MOUSEEVENTF_RIGHTDOWN = 8;
+ MOUSEEVENTF_RIGHTUP = 16;
+ MOUSEEVENTF_MIDDLEDOWN = 32;
+ MOUSEEVENTF_MIDDLEUP = 64;
+ { MoveFileEx }
+ MOVEFILE_REPLACE_EXISTING = 1;
+ MOVEFILE_COPY_ALLOWED = 2;
+ MOVEFILE_DELAY_UNTIL_REBOOT = 4;
+ { MsgWaitForMultipleObjects, WaitForMultipleObjectsEx }
+ WAIT_OBJECT_0 = 0;
+ WAIT_ABANDONED_0 = $80;
+ WAIT_TIMEOUT = $102;
+ WAIT_IO_COMPLETION = $c0;
+ WAIT_ABANDONED = $80;
+ WAIT_FAILED = $ffffffff;
+ MAXIMUM_WAIT_OBJECTS = $40;
+ MAXIMUM_SUSPEND_COUNT = $7f;
+ { MultiByteToWideChar }
+ MB_PRECOMPOSED = 1;
+ MB_COMPOSITE = 2;
+ MB_ERR_INVALID_CHARS = 8;
+ MB_USEGLYPHCHARS = 4;
+ { NDdeSetTrustedShare }
+ { NetAccessCheck }
+ { NetServerEnum }
+ { NetServiceControl }
+ { NetUserEnum }
+ { OpenProcessToken }
+ TOKEN_ADJUST_DEFAULT = 128;
+ TOKEN_ADJUST_GROUPS = 64;
+ TOKEN_ADJUST_PRIVILEGES = 32;
+ TOKEN_ALL_ACCESS = $f00ff;
+ TOKEN_ASSIGN_PRIMARY = 1;
+ TOKEN_DUPLICATE = 2;
+ TOKEN_EXECUTE = $20000;
+ TOKEN_IMPERSONATE = 4;
+ TOKEN_QUERY = 8;
+ TOKEN_QUERY_SOURCE = 16;
+ TOKEN_READ = $20008;
+ TOKEN_WRITE = $200e0;
+ { OpenSCManager }
+ SC_MANAGER_ALL_ACCESS = $f003f;
+ SC_MANAGER_CONNECT = 1;
+ SC_MANAGER_CREATE_SERVICE = 2;
+ SC_MANAGER_ENUMERATE_SERVICE = 4;
+ SC_MANAGER_LOCK = 8;
+ SC_MANAGER_QUERY_LOCK_STATUS = 16;
+ SC_MANAGER_MODIFY_BOOT_CONFIG = 32;
+ { PostMessage }
+ { was #define dname def_expr }
+ function HWND_BROADCAST : HWND;
+
+ { PrepareTape }
+
+ const
+ TAPE_FORMAT = $5;
+ TAPE_LOAD = 0;
+ TAPE_LOCK = $3;
+ TAPE_TENSION = $2;
+ TAPE_UNLOAD = $1;
+ TAPE_UNLOCK = $4;
+ { PropertySheet }
+ IS_PSREBOOTSYSTEM = 3;
+ IS_PSRESTARTWINDOWS = 2;
+ { PropSheetPageProc }
+ PSPCB_CREATE = 2;
+ PSPCB_RELEASE = 1;
+ { PurgeComm }
+ PURGE_TXABORT = 1;
+ PURGE_RXABORT = 2;
+ PURGE_TXCLEAR = 4;
+ PURGE_RXCLEAR = 8;
+ { QueryServiceObjectSecurity }
+ OWNER_SECURITY_INFORMATION = $1;
+ GROUP_SECURITY_INFORMATION = $2;
+ DACL_SECURITY_INFORMATION = $4;
+ SACL_SECURITY_INFORMATION = $8;
+ { ReadEventLog, ReportEvent }
+ EVENTLOG_FORWARDS_READ = 4;
+ EVENTLOG_BACKWARDS_READ = 8;
+ EVENTLOG_SEEK_READ = 2;
+ EVENTLOG_SEQUENTIAL_READ = 1;
+ EVENTLOG_ERROR_TYPE = 1;
+ EVENTLOG_WARNING_TYPE = 2;
+ EVENTLOG_INFORMATION_TYPE = 4;
+ EVENTLOG_AUDIT_SUCCESS = 8;
+ EVENTLOG_AUDIT_FAILURE = 16;
+ { RedrawWindow }
+ RDW_ERASE = 4;
+ RDW_FRAME = 1024;
+ RDW_INTERNALPAINT = 2;
+ RDW_INVALIDATE = 1;
+ RDW_NOERASE = 32;
+ RDW_NOFRAME = 2048;
+ RDW_NOINTERNALPAINT = 16;
+ RDW_VALIDATE = 8;
+ RDW_ERASENOW = 512;
+ RDW_UPDATENOW = 256;
+ RDW_ALLCHILDREN = 128;
+ RDW_NOCHILDREN = 64;
+ { RegCreateKey }
+ { was #define dname def_expr }
+ function HKEY_CLASSES_ROOT : HKEY;
+
+ { was #define dname def_expr }
+ function HKEY_CURRENT_USER : HKEY;
+
+ { was #define dname def_expr }
+ function HKEY_LOCAL_MACHINE : HKEY;
+
+ { was #define dname def_expr }
+ function HKEY_USERS : HKEY;
+
+ { was #define dname def_expr }
+ function HKEY_PERFORMANCE_DATA : HKEY;
+
+ { was #define dname def_expr }
+ function HKEY_CURRENT_CONFIG : HKEY;
+
+ { was #define dname def_expr }
+ function HKEY_DYN_DATA : HKEY;
+
+ { RegCreateKeyEx }
+
+ const
+ REG_OPTION_VOLATILE = $1;
+ REG_OPTION_NON_VOLATILE = 0;
+ REG_CREATED_NEW_KEY = $1;
+ REG_OPENED_EXISTING_KEY = $2;
+ { RegEnumValue }
+ REG_BINARY = 3;
+ REG_DWORD = 4;
+ REG_DWORD_LITTLE_ENDIAN = 4;
+ REG_DWORD_BIG_ENDIAN = 5;
+ REG_EXPAND_SZ = 2;
+ REG_FULL_RESOURCE_DESCRIPTOR = 9;
+ REG_LINK = 6;
+ REG_MULTI_SZ = 7;
+ REG_NONE = 0;
+ REG_RESOURCE_LIST = 8;
+ REG_RESOURCE_REQUIREMENTS_LIST = 10;
+ REG_SZ = 1;
+ { RegisterHotKey }
+ MOD_ALT = 1;
+ MOD_CONTROL = 2;
+ MOD_SHIFT = 4;
+ MOD_WIN = 8;
+ IDHOT_SNAPDESKTOP = -(2);
+ IDHOT_SNAPWINDOW = -(1);
+ { RegNotifyChangeKeyValue }
+ REG_NOTIFY_CHANGE_NAME = $1;
+ REG_NOTIFY_CHANGE_ATTRIBUTES = $2;
+ REG_NOTIFY_CHANGE_LAST_SET = $4;
+ REG_NOTIFY_CHANGE_SECURITY = $8;
+ { ScrollWindowEx }
+ SW_ERASE = 4;
+ SW_INVALIDATE = 2;
+ SW_SCROLLCHILDREN = 1;
+ { SendMessageTimeout }
+ SMTO_ABORTIFHUNG = 2;
+ SMTO_BLOCK = 1;
+ SMTO_NORMAL = 0;
+ { SetBkMode }
+ OPAQUE = 2;
+ TRANSPARENT = 1;
+ { SetDebugErrorLevel }
+ SLE_ERROR = 1;
+ SLE_MINORERROR = 2;
+ SLE_WARNING = 3;
+ { SetErrorMode }
+ SEM_FAILCRITICALERRORS = 1;
+ SEM_NOALIGNMENTFAULTEXCEPT = 4;
+ SEM_NOGPFAULTERRORBOX = 2;
+ SEM_NOOPENFILEERRORBOX = 32768;
+ { SetICMMode }
+ ICM_ON = 2;
+ ICM_OFF = 1;
+ ICM_QUERY = 3;
+ { SetJob }
+ { Locale Information }
+ LOCALE_ILANGUAGE = 1;
+ LOCALE_SLANGUAGE = 2;
+ LOCALE_SENGLANGUAGE = 4097;
+ LOCALE_SABBREVLANGNAME = 3;
+ LOCALE_SNATIVELANGNAME = 4;
+ LOCALE_ICOUNTRY = 5;
+ LOCALE_SCOUNTRY = 6;
+ LOCALE_SENGCOUNTRY = 4098;
+ LOCALE_SABBREVCTRYNAME = 7;
+ LOCALE_SNATIVECTRYNAME = 8;
+ LOCALE_IDEFAULTLANGUAGE = 9;
+ LOCALE_IDEFAULTCOUNTRY = 10;
+ LOCALE_IDEFAULTANSICODEPAGE = 4100;
+ LOCALE_IDEFAULTCODEPAGE = 11;
+ LOCALE_SLIST = 12;
+ LOCALE_IMEASURE = 13;
+ LOCALE_SDECIMAL = 14;
+ LOCALE_STHOUSAND = 15;
+ LOCALE_SGROUPING = 16;
+ LOCALE_IDIGITS = 17;
+ LOCALE_ILZERO = 18;
+ LOCALE_INEGNUMBER = 4112;
+ LOCALE_SCURRENCY = 20;
+ LOCALE_SMONDECIMALSEP = 22;
+ LOCALE_SMONTHOUSANDSEP = 23;
+ LOCALE_SMONGROUPING = 24;
+ LOCALE_ICURRDIGITS = 25;
+ LOCALE_ICURRENCY = 27;
+ LOCALE_INEGCURR = 28;
+ LOCALE_SDATE = 29;
+ LOCALE_STIME = 30;
+ LOCALE_STIMEFORMAT = 4099;
+ LOCALE_SSHORTDATE = 31;
+ LOCALE_SLONGDATE = 32;
+ LOCALE_IDATE = 33;
+ LOCALE_ILDATE = 34;
+ LOCALE_ITIME = 35;
+ LOCALE_ITLZERO = 37;
+ LOCALE_IDAYLZERO = 38;
+ LOCALE_IMONLZERO = 39;
+ LOCALE_S1159 = 40;
+ LOCALE_S2359 = 41;
+ LOCALE_ICALENDARTYPE = 4105;
+ LOCALE_IOPTIONALCALENDAR = 4107;
+ LOCALE_IFIRSTDAYOFWEEK = 4108;
+ LOCALE_IFIRSTWEEKOFYEAR = 4109;
+ LOCALE_SDAYNAME1 = 42;
+ LOCALE_SDAYNAME2 = 43;
+ LOCALE_SDAYNAME3 = 44;
+ LOCALE_SDAYNAME4 = 45;
+ LOCALE_SDAYNAME5 = 46;
+ LOCALE_SDAYNAME6 = 47;
+ LOCALE_SDAYNAME7 = 48;
+ LOCALE_SABBREVDAYNAME1 = 49;
+ LOCALE_SABBREVDAYNAME2 = 50;
+ LOCALE_SABBREVDAYNAME3 = 51;
+ LOCALE_SABBREVDAYNAME4 = 52;
+ LOCALE_SABBREVDAYNAME5 = 53;
+ LOCALE_SABBREVDAYNAME6 = 54;
+ LOCALE_SABBREVDAYNAME7 = 55;
+ LOCALE_SMONTHNAME1 = 56;
+ LOCALE_SMONTHNAME2 = 57;
+ LOCALE_SMONTHNAME3 = 58;
+ LOCALE_SMONTHNAME4 = 59;
+ LOCALE_SMONTHNAME5 = 60;
+ LOCALE_SMONTHNAME6 = 61;
+ LOCALE_SMONTHNAME7 = 62;
+ LOCALE_SMONTHNAME8 = 63;
+ LOCALE_SMONTHNAME9 = 64;
+ LOCALE_SMONTHNAME10 = 65;
+ LOCALE_SMONTHNAME11 = 66;
+ LOCALE_SMONTHNAME12 = 67;
+ LOCALE_SMONTHNAME13 = 4110;
+ LOCALE_SABBREVMONTHNAME1 = 68;
+ LOCALE_SABBREVMONTHNAME2 = 69;
+ LOCALE_SABBREVMONTHNAME3 = 70;
+ LOCALE_SABBREVMONTHNAME4 = 71;
+ LOCALE_SABBREVMONTHNAME5 = 72;
+ LOCALE_SABBREVMONTHNAME6 = 73;
+ LOCALE_SABBREVMONTHNAME7 = 74;
+ LOCALE_SABBREVMONTHNAME8 = 75;
+ LOCALE_SABBREVMONTHNAME9 = 76;
+ LOCALE_SABBREVMONTHNAME10 = 77;
+ LOCALE_SABBREVMONTHNAME11 = 78;
+ LOCALE_SABBREVMONTHNAME12 = 79;
+ LOCALE_SABBREVMONTHNAME13 = 4111;
+ LOCALE_SPOSITIVESIGN = 80;
+ LOCALE_SNEGATIVESIGN = 81;
+ LOCALE_IPOSSIGNPOSN = 82;
+ LOCALE_INEGSIGNPOSN = 83;
+ LOCALE_IPOSSYMPRECEDES = 84;
+ LOCALE_IPOSSEPBYSPACE = 85;
+ LOCALE_INEGSYMPRECEDES = 86;
+ LOCALE_INEGSEPBYSPACE = 87;
+ LOCALE_NOUSEROVERRIDE = $80000000;
+ LOCALE_USE_CP_ACP = $40000000; // use the system ACP
+ LOCALE_RETURN_NUMBER = $20000000; // return number instead
+ { Calendar Type Information }
+ CAL_ICALINTVALUE = 1;
+ CAL_IYEAROFFSETRANGE = 3;
+ CAL_SABBREVDAYNAME1 = 14;
+ CAL_SABBREVDAYNAME2 = 15;
+ CAL_SABBREVDAYNAME3 = 16;
+ CAL_SABBREVDAYNAME4 = 17;
+ CAL_SABBREVDAYNAME5 = 18;
+ CAL_SABBREVDAYNAME6 = 19;
+ CAL_SABBREVDAYNAME7 = 20;
+ CAL_SABBREVMONTHNAME1 = 34;
+ CAL_SABBREVMONTHNAME2 = 35;
+ CAL_SABBREVMONTHNAME3 = 36;
+ CAL_SABBREVMONTHNAME4 = 37;
+ CAL_SABBREVMONTHNAME5 = 38;
+ CAL_SABBREVMONTHNAME6 = 39;
+ CAL_SABBREVMONTHNAME7 = 40;
+ CAL_SABBREVMONTHNAME8 = 41;
+ CAL_SABBREVMONTHNAME9 = 42;
+ CAL_SABBREVMONTHNAME10 = 43;
+ CAL_SABBREVMONTHNAME11 = 44;
+ CAL_SABBREVMONTHNAME12 = 45;
+ CAL_SABBREVMONTHNAME13 = 46;
+ CAL_SCALNAME = 2;
+ CAL_SDAYNAME1 = 7;
+ CAL_SDAYNAME2 = 8;
+ CAL_SDAYNAME3 = 9;
+ CAL_SDAYNAME4 = 10;
+ CAL_SDAYNAME5 = 11;
+ CAL_SDAYNAME6 = 12;
+ CAL_SDAYNAME7 = 13;
+ CAL_SERASTRING = 4;
+ CAL_SLONGDATE = 6;
+ CAL_SMONTHNAME1 = 21;
+ CAL_SMONTHNAME2 = 22;
+ CAL_SMONTHNAME3 = 23;
+ CAL_SMONTHNAME4 = 24;
+ CAL_SMONTHNAME5 = 25;
+ CAL_SMONTHNAME6 = 26;
+ CAL_SMONTHNAME7 = 27;
+ CAL_SMONTHNAME8 = 28;
+ CAL_SMONTHNAME9 = 29;
+ CAL_SMONTHNAME10 = 30;
+ CAL_SMONTHNAME11 = 31;
+ CAL_SMONTHNAME12 = 32;
+ CAL_SMONTHNAME13 = 33;
+ CAL_SSHORTDATE = 5;
+ { SetProcessWorkingSetSize }
+ PROCESS_SET_QUOTA = 256;
+ { SetPrinter }
+ { SetService }
+ { SetStretchBltMode }
+ BLACKONWHITE = 1;
+ COLORONCOLOR = 3;
+ HALFTONE = 4;
+ STRETCH_ANDSCANS = 1;
+ STRETCH_DELETESCANS = 3;
+ STRETCH_HALFTONE = 4;
+ STRETCH_ORSCANS = 2;
+ WHITEONBLACK = 2;
+ { SetSystemCursor }
+ OCR_NORMAL = 32512;
+ OCR_IBEAM = 32513;
+ OCR_WAIT = 32514;
+ OCR_CROSS = 32515;
+ OCR_UP = 32516;
+ OCR_SIZE = 32640;
+ OCR_ICON = 32641;
+ OCR_SIZENWSE = 32642;
+ OCR_SIZENESW = 32643;
+ OCR_SIZEWE = 32644;
+ OCR_SIZENS = 32645;
+ OCR_SIZEALL = 32646;
+ OCR_NO = 32648;
+ OCR_APPSTARTING = 32650;
+ { SetTapePosition }
+ TAPE_ABSOLUTE_BLOCK = $1;
+ TAPE_LOGICAL_BLOCK = $2;
+ TAPE_REWIND = 0;
+ TAPE_SPACE_END_OF_DATA = $4;
+ TAPE_SPACE_FILEMARKS = $6;
+ TAPE_SPACE_RELATIVE_BLOCKS = $5;
+ TAPE_SPACE_SEQUENTIAL_FMKS = $7;
+ TAPE_SPACE_SEQUENTIAL_SMKS = $9;
+ TAPE_SPACE_SETMARKS = $8;
+ { SetUnhandledExceptionFilter }
+ EXCEPTION_EXECUTE_HANDLER = 1;
+ EXCEPTION_CONTINUE_EXECUTION = -(1);
+ EXCEPTION_CONTINUE_SEARCH = 0;
+ { SetWindowPos, DeferWindowPos }
+ { was #define dname def_expr }
+ function HWND_BOTTOM : HWND;
+
+ { was #define dname def_expr }
+ function HWND_NOTOPMOST : HWND;
+
+ { was #define dname def_expr }
+ function HWND_TOP : HWND;
+
+ { was #define dname def_expr }
+ function HWND_TOPMOST : HWND;
+
+
+ const
+ SWP_DRAWFRAME = 32;
+ SWP_FRAMECHANGED = 32;
+ SWP_HIDEWINDOW = 128;
+ SWP_NOACTIVATE = 16;
+ SWP_NOCOPYBITS = 256;
+ SWP_NOMOVE = 2;
+ SWP_NOSIZE = 1;
+ SWP_NOREDRAW = 8;
+ SWP_NOZORDER = 4;
+ SWP_SHOWWINDOW = 64;
+ SWP_NOOWNERZORDER = 512;
+ SWP_NOREPOSITION = 512;
+ SWP_NOSENDCHANGING = 1024;
+ { SHAddToRecentDocs }
+ { SHAppBarMessage }
+ { SHChangeNotify }
+ { ShellProc }
+ HSHELL_ACTIVATESHELLWINDOW = 3;
+ HSHELL_GETMINRECT = 5;
+ HSHELL_LANGUAGE = 8;
+ HSHELL_REDRAW = 6;
+ HSHELL_TASKMAN = 7;
+ HSHELL_WINDOWACTIVATED = 4;
+ HSHELL_WINDOWCREATED = 1;
+ HSHELL_WINDOWDESTROYED = 2;
+ { SHGetFileInfo }
+ { SHGetSpecialFolderLocation }
+ { ShowWindow }
+ SW_HIDE = 0;
+ SW_MAXIMIZE = 3;
+ SW_MINIMIZE = 6;
+ SW_NORMAL = 1;
+ SW_RESTORE = 9;
+ SW_SHOW = 5;
+ SW_SHOWDEFAULT = 10;
+ SW_SHOWMAXIMIZED = 3;
+ SW_SHOWMINIMIZED = 2;
+ SW_SHOWMINNOACTIVE = 7;
+ SW_SHOWNA = 8;
+ SW_SHOWNOACTIVATE = 4;
+ SW_SHOWNORMAL = 1;
+ WPF_RESTORETOMAXIMIZED = 2;
+ WPF_SETMINPOSITION = 1;
+ { Sleep }
+ INFINITE = $FFFFFFFF;
+ { SystemParametersInfo }
+ SPI_GETACCESSTIMEOUT = 60;
+ SPI_GETANIMATION = 72;
+ SPI_GETBEEP = 1;
+ SPI_GETBORDER = 5;
+ SPI_GETDEFAULTINPUTLANG = 89;
+ SPI_GETDRAGFULLWINDOWS = 38;
+ SPI_GETFASTTASKSWITCH = 35;
+ SPI_GETFILTERKEYS = 50;
+ SPI_GETFONTSMOOTHING = 74;
+ SPI_GETGRIDGRANULARITY = 18;
+ SPI_GETHIGHCONTRAST = 66;
+ SPI_GETICONMETRICS = 45;
+ SPI_GETICONTITLELOGFONT = 31;
+ SPI_GETICONTITLEWRAP = 25;
+ SPI_GETKEYBOARDDELAY = 22;
+ SPI_GETKEYBOARDPREF = 68;
+ SPI_GETKEYBOARDSPEED = 10;
+ SPI_GETLOWPOWERACTIVE = 83;
+ SPI_GETLOWPOWERTIMEOUT = 79;
+ SPI_GETMENUDROPALIGNMENT = 27;
+ SPI_GETMINIMIZEDMETRICS = 43;
+ SPI_GETMOUSE = 3;
+ SPI_GETMOUSEKEYS = 54;
+ SPI_GETMOUSETRAILS = 94;
+ SPI_GETNONCLIENTMETRICS = 41;
+ SPI_GETPOWEROFFACTIVE = 84;
+ SPI_GETPOWEROFFTIMEOUT = 80;
+ SPI_GETSCREENREADER = 70;
+ SPI_GETSCREENSAVEACTIVE = 16;
+ SPI_GETSCREENSAVETIMEOUT = 14;
+ SPI_GETSERIALKEYS = 62;
+ SPI_GETSHOWSOUNDS = 56;
+ SPI_GETSOUNDSENTRY = 64;
+ SPI_GETSTICKYKEYS = 58;
+ SPI_GETTOGGLEKEYS = 52;
+ SPI_GETWINDOWSEXTENSION = 92;
+ SPI_GETWORKAREA = 48;
+ SPI_ICONHORIZONTALSPACING = 13;
+ SPI_ICONVERTICALSPACING = 24;
+ SPI_LANGDRIVER = 12;
+ SPI_SCREENSAVERRUNNING = 97;
+ SPI_SETACCESSTIMEOUT = 61;
+ SPI_SETANIMATION = 73;
+ SPI_SETBEEP = 2;
+ SPI_SETBORDER = 6;
+ SPI_SETDEFAULTINPUTLANG = 90;
+ SPI_SETDESKPATTERN = 21;
+ SPI_SETDESKWALLPAPER = 20;
+ SPI_SETDOUBLECLICKTIME = 32;
+ SPI_SETDOUBLECLKHEIGHT = 30;
+ SPI_SETDOUBLECLKWIDTH = 29;
+ SPI_SETDRAGFULLWINDOWS = 37;
+ SPI_SETDRAGHEIGHT = 77;
+ SPI_SETDRAGWIDTH = 76;
+ SPI_SETFASTTASKSWITCH = 36;
+ SPI_SETFILTERKEYS = 51;
+ SPI_SETFONTSMOOTHING = 75;
+ SPI_SETGRIDGRANULARITY = 19;
+ SPI_SETHANDHELD = 78;
+ SPI_SETHIGHCONTRAST = 67;
+ SPI_SETICONMETRICS = 46;
+ SPI_SETICONTITLELOGFONT = 34;
+ SPI_SETICONTITLEWRAP = 26;
+ SPI_SETKEYBOARDDELAY = 23;
+ SPI_SETKEYBOARDPREF = 69;
+ SPI_SETKEYBOARDSPEED = 11;
+ SPI_SETLANGTOGGLE = 91;
+ SPI_SETLOWPOWERACTIVE = 85;
+ SPI_SETLOWPOWERTIMEOUT = 81;
+ SPI_SETMENUDROPALIGNMENT = 28;
+ SPI_SETMINIMIZEDMETRICS = 44;
+ SPI_SETMOUSE = 4;
+ SPI_SETMOUSEBUTTONSWAP = 33;
+ SPI_SETMOUSEKEYS = 55;
+ SPI_SETMOUSETRAILS = 93;
+ SPI_SETNONCLIENTMETRICS = 42;
+ SPI_SETPENWINDOWS = 49;
+ SPI_SETPOWEROFFACTIVE = 86;
+ SPI_SETPOWEROFFTIMEOUT = 82;
+ SPI_SETSCREENREADER = 71;
+ SPI_SETSCREENSAVEACTIVE = 17;
+ SPI_SETSCREENSAVETIMEOUT = 15;
+ SPI_SETSERIALKEYS = 63;
+ SPI_SETSHOWSOUNDS = 57;
+ SPI_SETSOUNDSENTRY = 65;
+ SPI_SETSTICKYKEYS = 59;
+ SPI_SETTOGGLEKEYS = 53;
+ SPI_SETWORKAREA = 47;
+ SPIF_UPDATEINIFILE = 1;
+ SPIF_SENDWININICHANGE = 2;
+ SPIF_SENDCHANGE = 2;
+ { TrackPopupMenu, TrackPopMenuEx }
+ TPM_CENTERALIGN = $4;
+ TPM_LEFTALIGN = 0;
+ TPM_RIGHTALIGN = $8;
+ TPM_LEFTBUTTON = 0;
+ TPM_RIGHTBUTTON = $2;
+ TPM_HORIZONTAL = 0;
+ TPM_VERTICAL = $40;
+ { TranslateCharsetInfo }
+ TCI_SRCCHARSET = 1;
+ TCI_SRCCODEPAGE = 2;
+ TCI_SRCFONTSIG = 3;
+ { VerFindFile }
+ VFFF_ISSHAREDFILE = 1;
+ VFF_CURNEDEST = 1;
+ VFF_FILEINUSE = 2;
+ VFF_BUFFTOOSMALL = 4;
+ { VerInstallFile }
+ VIFF_FORCEINSTALL = 1;
+ VIFF_DONTDELETEOLD = 2;
+ VIF_TEMPFILE = $1;
+ VIF_MISMATCH = $2;
+ VIF_SRCOLD = $4;
+ VIF_DIFFLANG = $8;
+ VIF_DIFFCODEPG = $10;
+ VIF_DIFFTYPE = $20;
+ VIF_WRITEPROT = $40;
+ VIF_FILEINUSE = $80;
+ VIF_OUTOFSPACE = $100;
+ VIF_ACCESSVIOLATION = $200;
+ VIF_SHARINGVIOLATION = $400;
+ VIF_CANNOTCREATE = $800;
+ VIF_CANNOTDELETE = $1000;
+ VIF_CANNOTDELETECUR = $4000;
+ VIF_CANNOTRENAME = $2000;
+ VIF_OUTOFMEMORY = $8000;
+ VIF_CANNOTREADSRC = $10000;
+ VIF_CANNOTREADDST = $20000;
+ VIF_BUFFTOOSMALL = $40000;
+ { WideCharToMultiByte }
+ WC_COMPOSITECHECK = 512;
+ WC_DISCARDNS = 16;
+ WC_SEPCHARS = 32;
+ WC_DEFAULTCHAR = 64;
+ { WinHelp }
+ HELP_COMMAND = $102;
+ HELP_CONTENTS = $3;
+ HELP_CONTEXT = $1;
+ HELP_CONTEXTPOPUP = $8;
+ HELP_FORCEFILE = $9;
+ HELP_HELPONHELP = $4;
+ HELP_INDEX = $3;
+ HELP_KEY = $101;
+ HELP_MULTIKEY = $201;
+ HELP_PARTIALKEY = $105;
+ HELP_QUIT = $2;
+ HELP_SETCONTENTS = $5;
+ HELP_SETINDEX = $5;
+ HELP_CONTEXTMENU = $a;
+ HELP_FINDER = $b;
+ HELP_WM_HELP = $c;
+ HELP_TCARD = $8000;
+ HELP_TCARD_DATA = $10;
+ HELP_TCARD_OTHER_CALLER = $11;
+ { WNetAddConnectino2 }
+ CONNECT_UPDATE_PROFILE = 1;
+ { WNetConnectionDialog, WNetDisconnectDialog, WNetOpenEnum }
+ RESOURCETYPE_DISK = 1;
+ RESOURCETYPE_PRINT = 2;
+ RESOURCETYPE_ANY = 0;
+ RESOURCE_CONNECTED = 1;
+ RESOURCE_GLOBALNET = 2;
+ RESOURCE_REMEMBERED = 3;
+ RESOURCEUSAGE_CONNECTABLE = 1;
+ RESOURCEUSAGE_CONTAINER = 2;
+ { WNetGetResourceInformation, WNetGetResourceParent }
+ WN_BAD_NETNAME = $43;
+ WN_EXTENDED_ERROR = $4b8;
+ WN_MORE_DATA = $ea;
+ WN_NO_NETWORK = $4c6;
+ WN_SUCCESS = 0;
+ WN_ACCESS_DENIED = $5;
+ WN_BAD_PROVIDER = $4b4;
+ WN_NOT_AUTHENTICATED = $4dc;
+ { WNetGetUniversalName }
+ UNIVERSAL_NAME_INFO_LEVEL = 1;
+ REMOTE_NAME_INFO_LEVEL = 2;
+ { GetExitCodeThread }
+ STILL_ACTIVE = $103;
+ { COMMPROP structure }
+ SP_SERIALCOMM = $1;
+ BAUD_075 = $1;
+ BAUD_110 = $2;
+ BAUD_134_5 = $4;
+ BAUD_150 = $8;
+ BAUD_300 = $10;
+ BAUD_600 = $20;
+ BAUD_1200 = $40;
+ BAUD_1800 = $80;
+ BAUD_2400 = $100;
+ BAUD_4800 = $200;
+ BAUD_7200 = $400;
+ BAUD_9600 = $800;
+ BAUD_14400 = $1000;
+ BAUD_19200 = $2000;
+ BAUD_38400 = $4000;
+ BAUD_56K = $8000;
+ BAUD_57600 = $40000;
+ BAUD_115200 = $20000;
+ BAUD_128K = $10000;
+ BAUD_USER = $10000000;
+ PST_FAX = $21;
+ PST_LAT = $101;
+ PST_MODEM = $6;
+ PST_NETWORK_BRIDGE = $100;
+ PST_PARALLELPORT = $2;
+ PST_RS232 = $1;
+ PST_RS422 = $3;
+ PST_RS423 = $4;
+ PST_RS449 = $5;
+ PST_SCANNER = $22;
+ PST_TCPIP_TELNET = $102;
+ PST_UNSPECIFIED = 0;
+ PST_X25 = $103;
+ PCF_16BITMODE = $200;
+ PCF_DTRDSR = $1;
+ PCF_INTTIMEOUTS = $80;
+ PCF_PARITY_CHECK = $8;
+ PCF_RLSD = $4;
+ PCF_RTSCTS = $2;
+ PCF_SETXCHAR = $20;
+ PCF_SPECIALCHARS = $100;
+ PCF_TOTALTIMEOUTS = $40;
+ PCF_XONXOFF = $10;
+ SP_BAUD = $2;
+ SP_DATABITS = $4;
+ SP_HANDSHAKING = $10;
+ SP_PARITY = $1;
+ SP_PARITY_CHECK = $20;
+ SP_RLSD = $40;
+ SP_STOPBITS = $8;
+ DATABITS_5 = 1;
+ DATABITS_6 = 2;
+ DATABITS_7 = 4;
+ DATABITS_8 = 8;
+ DATABITS_16 = 16;
+ DATABITS_16X = 32;
+ STOPBITS_10 = 1;
+ STOPBITS_15 = 2;
+ STOPBITS_20 = 4;
+ PARITY_NONE = 256;
+ PARITY_ODD = 512;
+ PARITY_EVEN = 1024;
+ PARITY_MARK = 2048;
+ PARITY_SPACE = 4096;
+ COMMPROP_INITIALIZED = $e73cf52e;
+ { DCB structure }
+ CBR_110 = 110;
+ CBR_300 = 300;
+ CBR_600 = 600;
+ CBR_1200 = 1200;
+ CBR_2400 = 2400;
+ CBR_4800 = 4800;
+ CBR_9600 = 9600;
+ CBR_14400 = 14400;
+ CBR_19200 = 19200;
+ CBR_38400 = 38400;
+ CBR_56000 = 56000;
+ CBR_57600 = 57600;
+ CBR_115200 = 115200;
+ CBR_128000 = 128000;
+ CBR_256000 = 256000;
+ DTR_CONTROL_DISABLE = 0;
+ DTR_CONTROL_ENABLE = 1;
+ DTR_CONTROL_HANDSHAKE = 2;
+ RTS_CONTROL_DISABLE = 0;
+ RTS_CONTROL_ENABLE = 1;
+ RTS_CONTROL_HANDSHAKE = 2;
+ RTS_CONTROL_TOGGLE = 3;
+ EVENPARITY = 2;
+ MARKPARITY = 3;
+ NOPARITY = 0;
+ ODDPARITY = 1;
+ SPACEPARITY = 4;
+ ONESTOPBIT = 0;
+ ONE5STOPBITS = 1;
+ TWOSTOPBITS = 2;
+ { Debugging events }
+ CREATE_PROCESS_DEBUG_EVENT = 3;
+ CREATE_THREAD_DEBUG_EVENT = 2;
+ EXCEPTION_DEBUG_EVENT = 1;
+ EXIT_PROCESS_DEBUG_EVENT = 5;
+ EXIT_THREAD_DEBUG_EVENT = 4;
+ LOAD_DLL_DEBUG_EVENT = 6;
+ OUTPUT_DEBUG_STRING_EVENT = 8;
+ UNLOAD_DLL_DEBUG_EVENT = 7;
+ RIP_EVENT = 9;
+ { PROCESS_HEAP_ENTRY structure }
+ PROCESS_HEAP_REGION = 1;
+ PROCESS_HEAP_UNCOMMITTED_RANGE = 2;
+ PROCESS_HEAP_ENTRY_BUSY = 4;
+ PROCESS_HEAP_ENTRY_MOVEABLE = 16;
+ PROCESS_HEAP_ENTRY_DDESHARE = 32;
+ { Win32s }
+ HINSTANCE_ERROR = 32;
+ { WIN32_STREAM_ID structure }
+ BACKUP_DATA = 1;
+ BACKUP_EA_DATA = 2;
+ BACKUP_SECURITY_DATA = 3;
+ BACKUP_ALTERNATE_DATA = 4;
+ BACKUP_LINK = 5;
+ STREAM_MODIFIED_WHEN_READ = 1;
+ STREAM_CONTAINS_SECURITY = 2;
+ { STARTUPINFO structure }
+ STARTF_USESHOWWINDOW = 1;
+ STARTF_USEPOSITION = 4;
+ STARTF_USESIZE = 2;
+ STARTF_USECOUNTCHARS = 8;
+ STARTF_USEFILLATTRIBUTE = 16;
+ STARTF_RUNFULLSCREEN = 32;
+ STARTF_FORCEONFEEDBACK = 64;
+ STARTF_FORCEOFFFEEDBACK = 128;
+ STARTF_USESTDHANDLES = 256;
+ STARTF_USEHOTKEY = 512;
+ { OSVERSIONINFO structure }
+ VER_PLATFORM_WIN32s = 0;
+ VER_PLATFORM_WIN32_WINDOWS = 1;
+ VER_PLATFORM_WIN32_NT = 2;
+ { More versions }
+ VER_SERVER_NT = $80000000;
+ VER_WORKSTATION_NT = $40000000;
+ VER_SUITE_SMALLBUSINESS = $00000001;
+ VER_SUITE_ENTERPRISE = $00000002;
+ VER_SUITE_BACKOFFICE = $00000004;
+ VER_SUITE_COMMUNICATIONS = $00000008;
+ VER_SUITE_TERMINAL = $00000010;
+ VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
+ VER_SUITE_EMBEDDEDNT = $00000040;
+ VER_SUITE_DATACENTER = $00000080;
+ VER_SUITE_SINGLEUSERTS = $00000100;
+ VER_SUITE_PERSONAL = $00000200;
+ VER_SUITE_BLADE = $00000400;
+ VER_SUITE_EMBEDDED_RESTRICTED = $00000800;
+ { PROPSHEETPAGE structure }
+ MAXPROPPAGES = 100;
+ PSP_DEFAULT = 0;
+ PSP_DLGINDIRECT = 1;
+ PSP_HASHELP = 32;
+ PSP_USECALLBACK = 128;
+ PSP_USEHICON = 2;
+ PSP_USEICONID = 4;
+ PSP_USEREFPARENT = 64;
+ PSP_USETITLE = 8;
+ PSP_RTLREADING = 16;
+ { PROPSHEETHEADER structure }
+ PSH_DEFAULT = 0;
+ PSH_HASHELP = 512;
+ PSH_MODELESS = 1024;
+ PSH_NOAPPLYNOW = 128;
+ PSH_PROPSHEETPAGE = 8;
+ PSH_PROPTITLE = 1;
+ PSH_USECALLBACK = 256;
+ PSH_USEHICON = 2;
+ PSH_USEICONID = 4;
+ PSH_USEPSTARTPAGE = 64;
+ PSH_WIZARD = 32;
+ PSH_RTLREADING = 2048;
+ PSCB_INITIALIZED = 1;
+ PSCB_PRECREATE = 2;
+ { PSN_APPLY message }
+ PSNRET_NOERROR = 0;
+ PSNRET_INVALID_NOCHANGEPAGE = 2;
+ { Property Sheet }
+ PSBTN_APPLYNOW = 4;
+ PSBTN_BACK = 0;
+ PSBTN_CANCEL = 5;
+ PSBTN_FINISH = 2;
+ PSBTN_HELP = 6;
+ PSBTN_NEXT = 1;
+ PSBTN_OK = 3;
+ PSWIZB_BACK = 1;
+ PSWIZB_NEXT = 2;
+ PSWIZB_FINISH = 4;
+ PSWIZB_DISABLEDFINISH = 8;
+ ID_PSREBOOTSYSTEM = 3;
+ ID_PSRESTARTWINDOWS = 2;
+ WIZ_BODYCX = 184;
+ WIZ_BODYX = 92;
+ WIZ_CXBMP = 80;
+ WIZ_CXDLG = 276;
+ WIZ_CYDLG = 140;
+ { VX_FIXEDFILEINFO structure }
+ { was #define dname def_expr }
+ function VS_FILE_INFO : LPTSTR;
+ { return type might be wrong }
+
+
+ const
+ VS_VERSION_INFO = 1;
+ VS_FF_DEBUG = $1;
+ VS_FF_INFOINFERRED = $10;
+ VS_FF_PATCHED = $4;
+ VS_FF_PRERELEASE = $2;
+ VS_FF_PRIVATEBUILD = $8;
+ VS_FF_SPECIALBUILD = $20;
+ VOS_UNKNOWN = 0;
+ VOS_DOS = $10000;
+ VOS_OS216 = $20000;
+ VOS_OS232 = $30000;
+ VOS_NT = $40000;
+ VOS_DOS_WINDOWS16 = $10001;
+ VOS_DOS_WINDOWS32 = $10004;
+ VOS_OS216_PM16 = $20002;
+ VOS_OS232_PM32 = $30003;
+ VOS_NT_WINDOWS32 = $40004;
+ VFT_UNKNOWN = 0;
+ VFT_APP = $1;
+ VFT_DLL = $2;
+ VFT_DRV = $3;
+ VFT_FONT = $4;
+ VFT_VXD = $5;
+ VFT_STATIC_LIB = $7;
+ VFT2_UNKNOWN = 0;
+ VFT2_DRV_PRINTER = $1;
+ VFT2_DRV_KEYBOARD = $2;
+ VFT2_DRV_LANGUAGE = $3;
+ VFT2_DRV_DISPLAY = $4;
+ VFT2_DRV_MOUSE = $5;
+ VFT2_DRV_NETWORK = $6;
+ VFT2_DRV_SYSTEM = $7;
+ VFT2_DRV_INSTALLABLE = $8;
+ VFT2_DRV_SOUND = $9;
+ VFT2_FONT_RASTER = $1;
+ VFT2_FONT_VECTOR = $2;
+ VFT2_FONT_TRUETYPE = $3;
+ { PANOSE structure }
+ PAN_ANY = 0;
+ PAN_NO_FIT = 1;
+ PAN_FAMILY_TEXT_DISPLAY = 2;
+ PAN_FAMILY_SCRIPT = 3;
+ PAN_FAMILY_DECORATIVE = 4;
+ PAN_FAMILY_PICTORIAL = 5;
+ PAN_SERIF_COVE = 2;
+ PAN_SERIF_OBTUSE_COVE = 3;
+ PAN_SERIF_SQUARE_COVE = 4;
+ PAN_SERIF_OBTUSE_SQUARE_COVE = 5;
+ PAN_SERIF_SQUARE = 6;
+ PAN_SERIF_THIN = 7;
+ PAN_SERIF_BONE = 8;
+ PAN_SERIF_EXAGGERATED = 9;
+ PAN_SERIF_TRIANGLE = 10;
+ PAN_SERIF_NORMAL_SANS = 11;
+ PAN_SERIF_OBTUSE_SANS = 12;
+ PAN_SERIF_PERP_SANS = 13;
+ PAN_SERIF_FLARED = 14;
+ PAN_SERIF_ROUNDED = 15;
+ PAN_WEIGHT_VERY_LIGHT = 2;
+ PAN_WEIGHT_LIGHT = 3;
+ PAN_WEIGHT_THIN = 4;
+ PAN_WEIGHT_BOOK = 5;
+ PAN_WEIGHT_MEDIUM = 6;
+ PAN_WEIGHT_DEMI = 7;
+ PAN_WEIGHT_BOLD = 8;
+ PAN_WEIGHT_HEAVY = 9;
+ PAN_WEIGHT_BLACK = 10;
+ PAN_WEIGHT_NORD = 11;
+ PAN_PROP_OLD_STYLE = 2;
+ PAN_PROP_MODERN = 3;
+ PAN_PROP_EVEN_WIDTH = 4;
+ PAN_PROP_EXPANDED = 5;
+ PAN_PROP_CONDENSED = 6;
+ PAN_PROP_VERY_EXPANDED = 7;
+ PAN_PROP_VERY_CONDENSED = 8;
+ PAN_PROP_MONOSPACED = 9;
+ PAN_CONTRAST_NONE = 2;
+ PAN_CONTRAST_VERY_LOW = 3;
+ PAN_CONTRAST_LOW = 4;
+ PAN_CONTRAST_MEDIUM_LOW = 5;
+ PAN_CONTRAST_MEDIUM = 6;
+ PAN_CONTRAST_MEDIUM_HIGH = 7;
+ PAN_CONTRAST_HIGH = 8;
+ PAN_CONTRAST_VERY_HIGH = 9;
+ PAN_STROKE_GRADUAL_DIAG = 2;
+ PAN_STROKE_GRADUAL_TRAN = 3;
+ PAN_STROKE_GRADUAL_VERT = 4;
+ PAN_STROKE_GRADUAL_HORZ = 5;
+ PAN_STROKE_RAPID_VERT = 6;
+ PAN_STROKE_RAPID_HORZ = 7;
+ PAN_STROKE_INSTANT_VERT = 8;
+ PAN_STRAIGHT_ARMS_HORZ = 2;
+ PAN_STRAIGHT_ARMS_WEDGE = 3;
+ PAN_STRAIGHT_ARMS_VERT = 4;
+ PAN_STRAIGHT_ARMS_SINGLE_SERIF = 5;
+ PAN_STRAIGHT_ARMS_DOUBLE_SERIF = 6;
+ PAN_BENT_ARMS_HORZ = 7;
+ PAN_BENT_ARMS_VERT = 9;
+ PAN_BENT_ARMS_WEDGE = 8;
+ PAN_BENT_ARMS_SINGLE_SERIF = 10;
+ PAN_BENT_ARMS_DOUBLE_SERIF = 11;
+ PAN_LETT_NORMAL_CONTACT = 2;
+ PAN_LETT_NORMAL_WEIGHTED = 3;
+ PAN_LETT_NORMAL_BOXED = 4;
+ PAN_LETT_NORMAL_FLATTENED = 5;
+ PAN_LETT_NORMAL_ROUNDED = 6;
+ PAN_LETT_NORMAL_OFF_CENTER = 7;
+ PAN_LETT_NORMAL_SQUARE = 8;
+ PAN_LETT_OBLIQUE_CONTACT = 9;
+ PAN_LETT_OBLIQUE_WEIGHTED = 10;
+ PAN_LETT_OBLIQUE_BOXED = 11;
+ PAN_LETT_OBLIQUE_FLATTENED = 12;
+ PAN_LETT_OBLIQUE_ROUNDED = 13;
+ PAN_LETT_OBLIQUE_OFF_CENTER = 14;
+ PAN_LETT_OBLIQUE_SQUARE = 15;
+ PAN_MIDLINE_STANDARD_TRIMMED = 2;
+ PAN_MIDLINE_STANDARD_POINTED = 3;
+ PAN_MIDLINE_STANDARD_SERIFED = 4;
+ PAN_MIDLINE_HIGH_TRIMMED = 5;
+ PAN_MIDLINE_HIGH_POINTED = 6;
+ PAN_MIDLINE_HIGH_SERIFED = 7;
+ PAN_MIDLINE_CONSTANT_TRIMMED = 8;
+ PAN_MIDLINE_CONSTANT_POINTED = 9;
+ PAN_MIDLINE_CONSTANT_SERIFED = 10;
+ PAN_MIDLINE_LOW_TRIMMED = 11;
+ PAN_MIDLINE_LOW_POINTED = 12;
+ PAN_MIDLINE_LOW_SERIFED = 13;
+ PAN_XHEIGHT_CONSTANT_SMALL = 2;
+ PAN_XHEIGHT_CONSTANT_STD = 3;
+ PAN_XHEIGHT_CONSTANT_LARGE = 4;
+ PAN_XHEIGHT_DUCKING_SMALL = 5;
+ PAN_XHEIGHT_DUCKING_STD = 6;
+ PAN_XHEIGHT_DUCKING_LARGE = 7;
+ { PALETTENTRY structure }
+ PC_EXPLICIT = 2;
+ PC_NOCOLLAPSE = 4;
+ PC_RESERVED = 1;
+ { LOGBRUSH structure }
+ BS_DIBPATTERN = 5;
+ BS_DIBPATTERN8X8 = 8;
+ BS_DIBPATTERNPT = 6;
+ BS_HATCHED = 2;
+ BS_HOLLOW = 1;
+ BS_NULL = 1;
+ BS_PATTERN = 3;
+ BS_PATTERN8X8 = 7;
+ BS_SOLID = 0;
+ { DEVMODE structure }
+ DM_ORIENTATION = $1;
+ DM_PAPERSIZE = $2;
+ DM_PAPERLENGTH = $4;
+ DM_PAPERWIDTH = $8;
+ DM_SCALE = $10;
+ DM_COPIES = $100;
+ DM_DEFAULTSOURCE = $200;
+ DM_PRINTQUALITY = $400;
+ DM_COLOR = $800;
+ DM_DUPLEX = $1000;
+ DM_YRESOLUTION = $2000;
+ DM_TTOPTION = $4000;
+ DM_COLLATE = $8000;
+ DM_FORMNAME = $10000;
+ DM_LOGPIXELS = $20000;
+ {DM_BITSPERPEL = $40000;
+ DM_PELSWIDTH = $80000;
+ DM_PELSHEIGHT = $100000;
+ DM_DISPLAYFLAGS = $200000;
+ DM_DISPLAYFREQUENCY = $400000;already above }
+ DM_ICMMETHOD = $800000;
+ DM_ICMINTENT = $1000000;
+ DM_MEDIATYPE = $2000000;
+ DM_DITHERTYPE = $4000000;
+ DMORIENT_LANDSCAPE = 2;
+ DMORIENT_PORTRAIT = 1;
+ DMPAPER_LETTER = 1;
+ DMPAPER_LEGAL = 5;
+ DMPAPER_A4 = 9;
+ DMPAPER_CSHEET = 24;
+ DMPAPER_DSHEET = 25;
+ DMPAPER_ESHEET = 26;
+ DMPAPER_LETTERSMALL = 2;
+ DMPAPER_TABLOID = 3;
+ DMPAPER_LEDGER = 4;
+ DMPAPER_STATEMENT = 6;
+ DMPAPER_EXECUTIVE = 7;
+ DMPAPER_A3 = 8;
+ DMPAPER_A4SMALL = 10;
+ DMPAPER_A5 = 11;
+ DMPAPER_B4 = 12;
+ DMPAPER_B5 = 13;
+ DMPAPER_FOLIO = 14;
+ DMPAPER_QUARTO = 15;
+ DMPAPER_10X14 = 16;
+ DMPAPER_11X17 = 17;
+ DMPAPER_NOTE = 18;
+ DMPAPER_ENV_9 = 19;
+ DMPAPER_ENV_10 = 20;
+ DMPAPER_ENV_11 = 21;
+ DMPAPER_ENV_12 = 22;
+ DMPAPER_ENV_14 = 23;
+ DMPAPER_ENV_DL = 27;
+ DMPAPER_ENV_C5 = 28;
+ DMPAPER_ENV_C3 = 29;
+ DMPAPER_ENV_C4 = 30;
+ DMPAPER_ENV_C6 = 31;
+ DMPAPER_ENV_C65 = 32;
+ DMPAPER_ENV_B4 = 33;
+ DMPAPER_ENV_B5 = 34;
+ DMPAPER_ENV_B6 = 35;
+ DMPAPER_ENV_ITALY = 36;
+ DMPAPER_ENV_MONARCH = 37;
+ DMPAPER_ENV_PERSONAL = 38;
+ DMPAPER_FANFOLD_US = 39;
+ DMPAPER_FANFOLD_STD_GERMAN = 40;
+ DMPAPER_FANFOLD_LGL_GERMAN = 41;
+ DMRES_HIGH = -(4);
+ DMRES_MEDIUM = -(3);
+ DMRES_LOW = -(2);
+ DMRES_DRAFT = -(1);
+ DMCOLOR_COLOR = 2;
+ DMCOLOR_MONOCHROME = 1;
+ DMDUP_SIMPLEX = 1;
+ DMDUP_HORIZONTAL = 3;
+ DMDUP_VERTICAL = 2;
+ DMTT_BITMAP = 1;
+ DMTT_DOWNLOAD = 2;
+ DMTT_SUBDEV = 3;
+ DMCOLLATE_TRUE = 1;
+ DMCOLLATE_FALSE = 0;
+ DM_GRAYSCALE = 1;
+ DM_INTERLACED = 2;
+ DMICMMETHOD_NONE = 1;
+ DMICMMETHOD_SYSTEM = 2;
+ DMICMMETHOD_DRIVER = 3;
+ DMICMMETHOD_DEVICE = 4;
+ DMICMMETHOD_USER = 256;
+ DMICM_SATURATE = 1;
+ DMICM_CONTRAST = 2;
+ DMICM_COLORMETRIC = 3;
+ DMICM_USER = 256;
+ DMMEDIA_STANDARD = 1;
+ DMMEDIA_GLOSSY = 3;
+ DMMEDIA_TRANSPARENCY = 2;
+ DMMEDIA_USER = 256;
+ DMDITHER_NONE = 1;
+ DMDITHER_COARSE = 2;
+ DMDITHER_FINE = 3;
+ DMDITHER_LINEART = 4;
+ DMDITHER_GRAYSCALE = 10;
+ DMDITHER_USER = 256;
+ { RGNDATAHEADER structure }
+ RDH_RECTANGLES = 1;
+ { TTPOLYGONHEADER structure }
+ TT_POLYGON_TYPE = 24;
+ { TTPOLYCURVE structure }
+ TT_PRIM_LINE = 1;
+ TT_PRIM_QSPLINE = 2;
+ { GCP_RESULTS structure }
+ GCPCLASS_ARABIC = 2;
+ GCPCLASS_HEBREW = 2;
+ GCPCLASS_LATIN = 1;
+ GCPCLASS_LATINNUMBER = 5;
+ GCPCLASS_LOCALNUMBER = 4;
+ GCPCLASS_LATINNUMERICSEPARATOR = 7;
+ GCPCLASS_LATINNUMERICTERMINATOR = 6;
+ GCPCLASS_NEUTRAL = 3;
+ GCPCLASS_NUMERICSEPARATOR = 8;
+ GCPCLASS_PREBOUNDLTR = 128;
+ GCPCLASS_PREBOUNDRTL = 64;
+ GCPCLASS_POSTBOUNDLTR = 32;
+ GCPCLASS_POSTBOUNDRTL = 16;
+ GCPGLYPH_LINKBEFORE = 32768;
+ GCPGLYPH_LINKAFTER = 16384;
+ { RASTERIZER_STATUS structure }
+ TT_AVAILABLE = 1;
+ TT_ENABLED = 2;
+ { COLORADJUSTMENT structure }
+ CA_NEGATIVE = 1;
+ CA_LOG_FILTER = 2;
+ ILLUMINANT_DEVICE_DEFAULT = 0;
+ ILLUMINANT_A = 1;
+ ILLUMINANT_B = 2;
+ ILLUMINANT_C = 3;
+ ILLUMINANT_D50 = 4;
+ ILLUMINANT_D55 = 5;
+ ILLUMINANT_D65 = 6;
+ ILLUMINANT_D75 = 7;
+ ILLUMINANT_F2 = 8;
+ ILLUMINANT_TUNGSTEN = 1;
+ ILLUMINANT_DAYLIGHT = 3;
+ ILLUMINANT_FLUORESCENT = 8;
+ ILLUMINANT_NTSC = 3;
+ { DOCINFO structure }
+ DI_APPBANDING = 1;
+ { EMRMETAHEADER structure }
+ EMR_HEADER = 1;
+ ENHMETA_SIGNATURE = 1179469088;
+ { RTF event masks }
+ ENM_CHANGE = 1;
+ ENM_CORRECTTEXT = 4194304;
+ ENM_DROPFILES = 1048576;
+ ENM_KEYEVENTS = 65536;
+ ENM_MOUSEEVENTS = 131072;
+ ENM_PROTECTED = 2097152;
+ ENM_REQUESTRESIZE = 262144;
+ ENM_SCROLL = 4;
+ ENM_SELCHANGE = 524288;
+ ENM_UPDATE = 2;
+ ENM_NONE = 0;
+ { RTF styles }
+ ES_DISABLENOSCROLL = 8192;
+ ES_EX_NOCALLOLEINIT = 16777216;
+ ES_NOIME = 524288;
+ ES_SAVESEL = 32768;
+ ES_SELFIME = 262144;
+ ES_SUNKEN = 16384;
+ ES_VERTICAL = 4194304;
+ ES_SELECTIONBAR = 16777216;
+ { EM_SETOPTIONS message }
+ ECOOP_SET = 1;
+ ECOOP_OR = 2;
+ ECOOP_AND = 3;
+ ECOOP_XOR = 4;
+ ECO_AUTOWORDSELECTION = 1;
+ ECO_AUTOVSCROLL = 64;
+ ECO_AUTOHSCROLL = 128;
+ ECO_NOHIDESEL = 256;
+ ECO_READONLY = 2048;
+ ECO_WANTRETURN = 4096;
+ ECO_SAVESEL = 32768;
+ ECO_SELECTIONBAR = 16777216;
+ ECO_VERTICAL = 4194304;
+ { EM_SETCHARFORMAT message }
+ SCF_WORD = 2;
+ SCF_SELECTION = 1;
+ { EM_STREAMOUT message }
+ SF_TEXT = 1;
+ SF_RTF = 2;
+ SF_RTFNOOBJS = 3;
+ SF_TEXTIZED = 4;
+ SFF_SELECTION = 32768;
+ SFF_PLAINRTF = 16384;
+ { EM_FINDWORDBREAK message }
+ WB_CLASSIFY = 3;
+ {WB_ISDELIMITER = 2;
+ WB_LEFT = 0; already above }
+ WB_LEFTBREAK = 6;
+ WB_PREVBREAK = 6;
+ WB_MOVEWORDLEFT = 4;
+ WB_MOVEWORDPREV = 4;
+ WB_MOVEWORDRIGHT = 5;
+ WB_MOVEWORDNEXT = 5;
+ {WB_RIGHT = 1;already above }
+ WB_RIGHTBREAK = 7;
+ WB_NEXTBREAK = 7;
+ { EM_GETPUNCTUATION message }
+ PC_LEADING = 2;
+ PC_FOLLOWING = 1;
+ PC_DELIMITER = 4;
+ PC_OVERFLOW = 3;
+ { EM_SETWORDWRAPMODE message }
+ WBF_WORDWRAP = 16;
+ WBF_WORDBREAK = 32;
+ WBF_OVERFLOW = 64;
+ WBF_LEVEL1 = 128;
+ WBF_LEVEL2 = 256;
+ WBF_CUSTOM = 512;
+ WBF_BREAKAFTER = 64;
+ WBF_BREAKLINE = 32;
+ WBF_ISWHITE = 16;
+ { CHARFORMAT structure }
+ CFM_BOLD = 1;
+ CFM_COLOR = 1073741824;
+ CFM_FACE = 536870912;
+ CFM_ITALIC = 2;
+ CFM_OFFSET = 268435456;
+ CFM_PROTECTED = 16;
+ CFM_SIZE = $80000000;
+ CFM_STRIKEOUT = 8;
+ CFM_UNDERLINE = 4;
+ CFE_AUTOCOLOR = 1073741824;
+ CFE_BOLD = 1;
+ CFE_ITALIC = 2;
+ CFE_STRIKEOUT = 8;
+ CFE_UNDERLINE = 4;
+ CFE_PROTECTED = 16;
+ { PARAFORMAT structure }
+ PFM_ALIGNMENT = 8;
+ PFM_NUMBERING = 32;
+ PFM_OFFSET = 4;
+ PFM_OFFSETINDENT = $80000000;
+ PFM_RIGHTINDENT = 2;
+ PFM_STARTINDENT = 1;
+ PFM_TABSTOPS = 16;
+ PFN_BULLET = 1;
+ PFA_LEFT = 1;
+ PFA_RIGHT = 2;
+ PFA_CENTER = 3;
+ { SELCHANGE structure }
+ SEL_EMPTY = 0;
+ SEL_TEXT = 1;
+ SEL_OBJECT = 2;
+ SEL_MULTICHAR = 4;
+ SEL_MULTIOBJECT = 8;
+ { RTF clipboard formats }
+ CF_RTF = 'Rich Text Format';
+ CF_RETEXTOBJ = 'RichEdit Text and Objects';
+ { DRAWITEMSTRUCT structure }
+ ODT_BUTTON = 4;
+ ODT_COMBOBOX = 3;
+ ODT_LISTBOX = 2;
+ ODT_LISTVIEW = 102;
+ ODT_MENU = 1;
+ ODT_STATIC = 5;
+ ODT_TAB = 101;
+ ODT_HEADER = 100;
+ ODA_DRAWENTIRE = 1;
+ ODA_FOCUS = 4;
+ ODA_SELECT = 2;
+ ODS_CHECKED = 8;
+ ODS_COMBOBOXEDIT = 4096;
+ ODS_DEFAULT = 32;
+ ODS_DISABLED = 4;
+ ODS_FOCUS = 16;
+ ODS_GRAYED = 2;
+ ODS_SELECTED = 1;
+ { Common control window classes }
+ ANIMATE_CLASSW = 'SysAnimate32';
+ HOTKEY_CLASSW = 'msctls_hotkey32';
+ PROGRESS_CLASSW = 'msctls_progress32';
+ STATUSCLASSNAMEW = 'msctls_statusbar32';
+ TOOLBARCLASSNAMEW = 'ToolbarWindow32';
+ TOOLTIPS_CLASSW = 'tooltips_class32';
+ TRACKBAR_CLASSW = 'msctls_trackbar32';
+ UPDOWN_CLASSW = 'msctls_updown32';
+ WC_HEADERW = 'SysHeader32';
+ WC_LISTVIEWW = 'SysListView32';
+ WC_TABCONTROLW = 'SysTabControl32';
+ WC_TREEVIEWW = 'SysTreeView32';
+ { Common control styles }
+ CCS_ADJUSTABLE = $20;
+ CCS_BOTTOM = $3;
+ CCS_NODIVIDER = $40;
+ CCS_NOMOVEY = $2;
+ CCS_NOPARENTALIGN = $8;
+ CCS_NORESIZE = $4;
+ CCS_TOP = $1;
+ ANIMATE_CLASSA = 'SysAnimate32';
+ HOTKEY_CLASSA = 'msctls_hotkey32';
+ PROGRESS_CLASSA = 'msctls_progress32';
+ STATUSCLASSNAMEA = 'msctls_statusbar32';
+ TOOLBARCLASSNAMEA = 'ToolbarWindow32';
+ TOOLTIPS_CLASSA = 'tooltips_class32';
+ TRACKBAR_CLASSA = 'msctls_trackbar32';
+ UPDOWN_CLASSA = 'msctls_updown32';
+ WC_HEADERA = 'SysHeader32';
+ WC_LISTVIEWA = 'SysListView32';
+ WC_TABCONTROLA = 'SysTabControl32';
+ WC_TREEVIEWA = 'SysTreeView32';
+{$ifdef UNICODE}
+
+ const
+ ANIMATE_CLASS = ANIMATE_CLASSW;
+ HOTKEY_CLASS = HOTKEY_CLASSW;
+ PROGRESS_CLASS = PROGRESS_CLASSW;
+ STATUSCLASSNAME = STATUSCLASSNAMEW;
+ TOOLBARCLASSNAME = TOOLBARCLASSNAMEW;
+ TOOLTIPS_CLASS = TOOLTIPS_CLASSW;
+ TRACKBAR_CLASS = TRACKBAR_CLASSW;
+ UPDOWN_CLASS = UPDOWN_CLASSW;
+ WC_HEADER = WC_HEADERW;
+ WC_LISTVIEW = WC_LISTVIEWW;
+ WC_TABCONTROL = WC_TABCONTROLW;
+ WC_TREEVIEW = WC_TREEVIEWW;
+{$else}
+
+ const
+ ANIMATE_CLASS = ANIMATE_CLASSA;
+ HOTKEY_CLASS = HOTKEY_CLASSA;
+ PROGRESS_CLASS = PROGRESS_CLASSA;
+ STATUSCLASSNAME = STATUSCLASSNAMEA;
+ TOOLBARCLASSNAME = TOOLBARCLASSNAMEA;
+ TOOLTIPS_CLASS = TOOLTIPS_CLASSA;
+ TRACKBAR_CLASS = TRACKBAR_CLASSA;
+ UPDOWN_CLASS = UPDOWN_CLASSA;
+ WC_HEADER = WC_HEADERA;
+ WC_LISTVIEW = WC_LISTVIEWA;
+ WC_TABCONTROL = WC_TABCONTROLA;
+ WC_TREEVIEW = WC_TREEVIEWA;
+{$endif}
+ { UNICODE }
+ { Header control styles }
+
+ const
+ HDS_BUTTONS = 2;
+ HDS_HIDDEN = 8;
+ HDS_HORZ = 0;
+ { HD_ITEM structure }
+ HDI_BITMAP = 16;
+ HDI_FORMAT = 4;
+ HDI_HEIGHT = 1;
+ HDI_LPARAM = 8;
+ HDI_TEXT = 2;
+ HDI_WIDTH = 1;
+ HDF_CENTER = 2;
+ HDF_LEFT = 0;
+ HDF_RIGHT = 1;
+ HDF_RTLREADING = 4;
+ HDF_BITMAP = 8192;
+ HDF_OWNERDRAW = 32768;
+ HDF_STRING = 16384;
+ HDF_JUSTIFYMASK = 3;
+ { HD_HITTESTINFO structure }
+ HHT_NOWHERE = 1;
+ HHT_ONDIVIDER = 4;
+ HHT_ONDIVOPEN = 8;
+ HHT_ONHEADER = 2;
+ HHT_TOLEFT = 2048;
+ HHT_TORIGHT = 1024;
+ { TBADDBITMAP structure }
+ { was #define dname def_expr }
+ function HINST_COMMCTRL : HINST;
+
+
+ const
+ IDB_STD_LARGE_COLOR = 1;
+ IDB_STD_SMALL_COLOR = 0;
+ IDB_VIEW_LARGE_COLOR = 5;
+ IDB_VIEW_SMALL_COLOR = 4;
+ STD_COPY = 1;
+ STD_CUT = 0;
+ STD_DELETE = 5;
+ STD_FILENEW = 6;
+ STD_FILEOPEN = 7;
+ STD_FILESAVE = 8;
+ STD_FIND = 12;
+ STD_HELP = 11;
+ STD_PASTE = 2;
+ STD_PRINT = 14;
+ STD_PRINTPRE = 9;
+ STD_PROPERTIES = 10;
+ STD_REDOW = 4;
+ STD_REPLACE = 13;
+ STD_UNDO = 3;
+ VIEW_LARGEICONS = 0;
+ VIEW_SMALLICONS = 1;
+ VIEW_LIST = 2;
+ VIEW_DETAILS = 3;
+ VIEW_SORTNAME = 4;
+ VIEW_SORTSIZE = 5;
+ VIEW_SORTDATE = 6;
+ VIEW_SORTTYPE = 7;
+ { Toolbar styles }
+ TBSTYLE_ALTDRAG = 1024;
+ TBSTYLE_TOOLTIPS = 256;
+ TBSTYLE_WRAPABLE = 512;
+ TBSTYLE_BUTTON = 0;
+ TBSTYLE_CHECK = 2;
+ TBSTYLE_CHECKGROUP = 6;
+ TBSTYLE_GROUP = 4;
+ TBSTYLE_SEP = 1;
+ { Toolbar states }
+ TBSTATE_CHECKED = 1;
+ TBSTATE_ENABLED = 4;
+ TBSTATE_HIDDEN = 8;
+ TBSTATE_INDETERMINATE = 16;
+ TBSTATE_PRESSED = 2;
+ TBSTATE_WRAP = 32;
+ { Tooltip styles }
+ TTS_ALWAYSTIP = 1;
+ TTS_NOPREFIX = 2;
+ { TOOLINFO structure }
+ TTF_IDISHWND = 1;
+ TTF_CENTERTIP = 2;
+ TTF_RTLREADING = 4;
+ TTF_SUBCLASS = 16;
+ { TTM_SETDELAYTIME message }
+ TTDT_AUTOMATIC = 0;
+ TTDT_AUTOPOP = 2;
+ TTDT_INITIAL = 3;
+ TTDT_RESHOW = 1;
+ { Status window }
+ SBARS_SIZEGRIP = 256;
+ {SBARS_SIZEGRIP = 256;already above }
+ { DL_DRAGGING message }
+ DL_MOVECURSOR = 3;
+ DL_COPYCURSOR = 2;
+ DL_STOPCURSOR = 1;
+ { Up-down control styles }
+ UDS_ALIGNLEFT = 8;
+ UDS_ALIGNRIGHT = 4;
+ UDS_ARROWKEYS = 32;
+ UDS_AUTOBUDDY = 16;
+ UDS_HORZ = 64;
+ UDS_NOTHOUSANDS = 128;
+ UDS_SETBUDDYINT = 2;
+ UDS_WRAP = 1;
+ { UDM_SETRANGE message }
+ UD_MAXVAL = 32767;
+ UD_MINVAL = -(32767);
+ { HKM_GETHOTKEY message }
+ HOTKEYF_ALT = 4;
+ HOTKEYF_CONTROL = 2;
+ HOTKEYF_EXT = 8;
+ HOTKEYF_SHIFT = 1;
+ { HKM_SETRULES message }
+ HKCOMB_A = 8;
+ HKCOMB_C = 4;
+ HKCOMB_CA = 64;
+ HKCOMB_NONE = 1;
+ HKCOMB_S = 2;
+ HKCOMB_SA = 32;
+ HKCOMB_SC = 16;
+ HKCOMB_SCA = 128;
+ { Trackbar styles }
+ TBS_HORZ = 0;
+ TBS_VERT = 2;
+ TBS_AUTOTICKS = 1;
+ TBS_NOTICKS = 16;
+ TBS_TOP = 4;
+ TBS_BOTTOM = 0;
+ TBS_LEFT = 4;
+ TBS_RIGHT = 0;
+ TBS_BOTH = 8;
+ TBS_ENABLESELRANGE = 32;
+ TBS_FIXEDLENGTH = 64;
+ TBS_NOTHUMB = 128;
+ TB_BOTTOM = 7;
+ TB_ENDTRACK = 8;
+ TB_LINEDOWN = 1;
+ TB_LINEUP = 0;
+ TB_PAGEDOWN = 3;
+ TB_PAGEUP = 2;
+ TB_THUMBPOSITION = 4;
+ TB_THUMBTRACK = 5;
+ TB_TOP = 6;
+ { List view styles }
+ LVS_ALIGNLEFT = 2048;
+ LVS_ALIGNTOP = 0;
+ LVS_AUTOARRANGE = 256;
+ LVS_EDITLABELS = 512;
+ LVS_ICON = 0;
+ LVS_LIST = 3;
+ LVS_NOCOLUMNHEADER = 16384;
+ LVS_NOLABELWRAP = 128;
+ LVS_NOSCROLL = 8192;
+ LVS_NOSORTHEADER = 32768;
+ LVS_OWNERDRAWFIXED = 1024;
+ LVS_REPORT = 1;
+ LVS_SHAREIMAGELISTS = 64;
+ LVS_SHOWSELALWAYS = 8;
+ LVS_SINGLESEL = 4;
+ LVS_SMALLICON = 2;
+ LVS_SORTASCENDING = 16;
+ LVS_SORTDESCENDING = 32;
+ LVS_TYPESTYLEMASK = 64512;
+ LVSIL_NORMAL = 0;
+ LVSIL_SMALL = 1;
+ LVSIL_STATE = 2;
+ LVIS_CUT = 4;
+ LVIS_DROPHILITED = 8;
+ LVIS_FOCUSED = 1;
+ LVIS_SELECTED = 2;
+ LVIS_OVERLAYMASK = 3840;
+ LVIS_STATEIMAGEMASK = 61440;
+ { was #define dname def_expr }
+ function LPSTR_TEXTCALLBACKW : LPWSTR;
+
+ { was #define dname def_expr }
+ function LPSTR_TEXTCALLBACKA : LPSTR;
+
+{$ifdef UNICODE}
+
+ {const this is a function in fact !!
+ LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKW;}
+ function LPSTR_TEXTCALLBACK : LPWSTR;
+
+{$else}
+
+ {const
+ LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKA; }
+ function LPSTR_TEXTCALLBACK : LPSTR;
+{$endif}
+ { UNICODE }
+ { LV_ITEM structure }
+
+ const
+ LVIF_TEXT = 1;
+ LVIF_IMAGE = 2;
+ LVIF_PARAM = 4;
+ LVIF_STATE = 8;
+ LVIF_DI_SETITEM = 4096;
+ { LVM_GETNEXTITEM structure }
+ LVNI_ABOVE = 256;
+ LVNI_ALL = 0;
+ LVNI_BELOW = 512;
+ LVNI_TOLEFT = 1024;
+ LVNI_TORIGHT = 2048;
+ LVNI_CUT = 4;
+ LVNI_DROPHILITED = 8;
+ LVNI_FOCUSED = 1;
+ LVNI_SELECTED = 2;
+ { LV_FINDINFO structure }
+ LVFI_PARAM = 1;
+ LVFI_PARTIAL = 8;
+ LVFI_STRING = 2;
+ LVFI_WRAP = 32;
+ LVFI_NEARESTXY = 64;
+ { LV_HITTESTINFO structure }
+ LVHT_ABOVE = 8;
+ LVHT_BELOW = 16;
+ LVHT_NOWHERE = 1;
+ LVHT_ONITEMICON = 2;
+ LVHT_ONITEMLABEL = 4;
+ LVHT_ONITEMSTATEICON = 8;
+ LVHT_TOLEFT = 64;
+ LVHT_TORIGHT = 32;
+ { LV_COLUMN structure }
+ LVCF_FMT = 1;
+ LVCF_SUBITEM = 8;
+ LVCF_TEXT = 4;
+ LVCF_WIDTH = 2;
+ LVCFMT_CENTER = 2;
+ LVCFMT_LEFT = 0;
+ LVCFMT_RIGHT = 1;
+ { ListView_GetItemRect }
+ LVIR_BOUNDS = 0;
+ LVIR_ICON = 1;
+ LVIR_LABEL = 2;
+ LVIR_SELECTBOUNDS = 3;
+ { LVM_ARRANGE message }
+ LVA_ALIGNLEFT = 1;
+ LVA_ALIGNTOP = 2;
+ LVA_DEFAULT = 0;
+ LVA_SNAPTOGRID = 5;
+ { LVM_SETCOLUMNWIDTH message }
+ LVSCW_AUTOSIZE = -(1);
+ LVSCW_AUTOSIZE_USEHEADER = -(2);
+ { Tree View styles }
+ TVS_DISABLEDRAGDROP = 16;
+ TVS_EDITLABELS = 8;
+ TVS_HASBUTTONS = 1;
+ TVS_HASLINES = 2;
+ TVS_LINESATROOT = 4;
+ TVS_SHOWSELALWAYS = 32;
+ { Tree View states }
+ TVIS_BOLD = 16;
+ TVIS_CUT = 4;
+ TVIS_DROPHILITED = 8;
+ TVIS_EXPANDED = 32;
+ TVIS_EXPANDEDONCE = 64;
+ TVIS_FOCUSED = 1;
+ TVIS_OVERLAYMASK = 3840;
+ TVIS_SELECTED = 2;
+ TVIS_STATEIMAGEMASK = 61440;
+ TVIS_USERMASK = 61440;
+ { TV_ITEM structure }
+ TVIF_CHILDREN = 64;
+ TVIF_HANDLE = 16;
+ TVIF_IMAGE = 2;
+ TVIF_PARAM = 4;
+ TVIF_SELECTEDIMAGE = 32;
+ TVIF_STATE = 8;
+ TVIF_TEXT = 1;
+ I_CHILDRENCALLBACK = -(1);
+ I_IMAGECALLBACK = -(1);
+ { TV_INSERTSTRUCT structure }
+ { added manually PM, TREEITEM is not defined in the C headers }
+ type
+ TREEITEM = record
+ end;
+ HTREEITEM = ^TREEITEM;
+ TTREEITEM = TREEITEM;
+ PTREEITEM = ^TREEITEM;
+
+ { was #define dname def_expr }
+ function TVI_ROOT : HTREEITEM;
+
+ { was #define dname def_expr }
+ function TVI_FIRST : HTREEITEM;
+
+ { was #define dname def_expr }
+ function TVI_LAST : HTREEITEM;
+
+ { was #define dname def_expr }
+ function TVI_SORT : HTREEITEM;
+
+ { TV_HITTESTINFO structure }
+
+ const
+ TVHT_ABOVE = 256;
+ TVHT_BELOW = 512;
+ TVHT_NOWHERE = 1;
+ TVHT_ONITEM = 70;
+ TVHT_ONITEMBUTTON = 16;
+ TVHT_ONITEMICON = 2;
+ TVHT_ONITEMINDENT = 8;
+ TVHT_ONITEMLABEL = 4;
+ TVHT_ONITEMRIGHT = 32;
+ TVHT_ONITEMSTATEICON = 64;
+ TVHT_TOLEFT = 2048;
+ TVHT_TORIGHT = 1024;
+ { TVM_EXPAND message }
+ TVE_COLLAPSE = 1;
+ TVE_COLLAPSERESET = 32768;
+ TVE_EXPAND = 2;
+ TVE_TOGGLE = 3;
+ { TVM_GETIMAGELIST message }
+ TVSIL_NORMAL = 0;
+ TVSIL_STATE = 2;
+ { TVM_GETNEXTITEM message }
+ TVGN_CARET = 9;
+ TVGN_CHILD = 4;
+ TVGN_DROPHILITE = 8;
+ TVGN_FIRSTVISIBLE = 5;
+ TVGN_NEXT = 1;
+ TVGN_NEXTVISIBLE = 6;
+ TVGN_PARENT = 3;
+ TVGN_PREVIOUS = 2;
+ TVGN_PREVIOUSVISIBLE = 7;
+ TVGN_ROOT = 0;
+ { TVN_SELCHANGED message }
+ TVC_BYKEYBOARD = 2;
+ TVC_BYMOUSE = 1;
+ TVC_UNKNOWN = 0;
+ { Tab control styles }
+ TCS_BUTTONS = 256;
+ TCS_FIXEDWIDTH = 1024;
+ TCS_FOCUSNEVER = 32768;
+ TCS_FOCUSONBUTTONDOWN = 4096;
+ TCS_FORCEICONLEFT = 16;
+ TCS_FORCELABELLEFT = 32;
+ TCS_MULTILINE = 512;
+ TCS_OWNERDRAWFIXED = 8192;
+ TCS_RAGGEDRIGHT = 2048;
+ TCS_RIGHTJUSTIFY = 0;
+ TCS_SINGLELINE = 0;
+ TCS_TABS = 0;
+ TCS_TOOLTIPS = 16384;
+ { TC_ITEM structure }
+ TCIF_TEXT = 1;
+ TCIF_IMAGE = 2;
+ TCIF_PARAM = 8;
+ TCIF_RTLREADING = 4;
+ { TC_HITTESTINFO structure }
+ TCHT_NOWHERE = 1;
+ TCHT_ONITEM = 6;
+ TCHT_ONITEMICON = 2;
+ TCHT_ONITEMLABEL = 4;
+ { Animation control styles }
+ ACS_AUTOPLAY = 4;
+ ACS_CENTER = 1;
+ ACS_TRANSPARENT = 2;
+ { MODEMDEVCAPS structure }
+ DIALOPTION_BILLING = 64;
+ DIALOPTION_QUIET = 128;
+ DIALOPTION_DIALTONE = 256;
+ MDMVOLFLAG_LOW = 1;
+ MDMVOLFLAG_MEDIUM = 2;
+ MDMVOLFLAG_HIGH = 4;
+ MDMVOL_LOW = 0;
+ MDMVOL_MEDIUM = 1;
+ MDMVOL_HIGH = 2;
+ MDMSPKRFLAG_OFF = 1;
+ MDMSPKRFLAG_DIAL = 2;
+ MDMSPKRFLAG_ON = 4;
+ MDMSPKRFLAG_CALLSETUP = 8;
+ MDMSPKR_OFF = 0;
+ MDMSPKR_DIAL = 1;
+ MDMSPKR_ON = 2;
+ MDMSPKR_CALLSETUP = 3;
+ MDM_BLIND_DIAL = 512;
+ MDM_CCITT_OVERRIDE = 64;
+ MDM_CELLULAR = 8;
+ MDM_COMPRESSION = 1;
+ MDM_ERROR_CONTROL = 2;
+ MDM_FLOWCONTROL_HARD = 16;
+ MDM_FLOWCONTROL_SOFT = 32;
+ MDM_FORCED_EC = 4;
+ MDM_SPEED_ADJUST = 128;
+ MDM_TONE_DIAL = 256;
+ MDM_V23_OVERRIDE = 1024;
+ { Languages }
+ //
+ // Language IDs.
+ //
+ // The following two combinations of primary language ID and
+ // sublanguage ID have special semantics:
+ //
+ // Primary Language ID Sublanguage ID Result
+ // ------------------- --------------- ------------------------
+ // LANG_NEUTRAL SUBLANG_NEUTRAL Language neutral
+ // LANG_NEUTRAL SUBLANG_DEFAULT User default language
+ // LANG_NEUTRAL SUBLANG_SYS_DEFAULT System default language
+ // LANG_INVARIANT SUBLANG_NEUTRAL Invariant locale
+ //
+
+ //
+ // Primary language IDs.
+ //
+
+ LANG_NEUTRAL = $00;
+ LANG_INVARIANT = $7f;
+
+ LANG_AFRIKAANS = $36;
+ LANG_ALBANIAN = $1c;
+ LANG_ARABIC = $01;
+ LANG_ARMENIAN = $2b;
+ LANG_ASSAMESE = $4d;
+ LANG_AZERI = $2c;
+ LANG_BASQUE = $2d;
+ LANG_BELARUSIAN = $23;
+ LANG_BENGALI = $45;
+ LANG_BULGARIAN = $02;
+ LANG_CATALAN = $03;
+ LANG_CHINESE = $04;
+ LANG_CROATIAN = $1a;
+ LANG_CZECH = $05;
+ LANG_DANISH = $06;
+ LANG_DIVEHI = $65;
+ LANG_DUTCH = $13;
+ LANG_ENGLISH = $09;
+ LANG_ESTONIAN = $25;
+ LANG_FAEROESE = $38;
+ LANG_FARSI = $29;
+ LANG_FINNISH = $0b;
+ LANG_FRENCH = $0c;
+ LANG_GALICIAN = $56;
+ LANG_GEORGIAN = $37;
+ LANG_GERMAN = $07;
+ LANG_GREEK = $08;
+ LANG_GUJARATI = $47;
+ LANG_HEBREW = $0d;
+ LANG_HINDI = $39;
+ LANG_HUNGARIAN = $0e;
+ LANG_ICELANDIC = $0f;
+ LANG_INDONESIAN = $21;
+ LANG_ITALIAN = $10;
+ LANG_JAPANESE = $11;
+ LANG_KANNADA = $4b;
+ LANG_KASHMIRI = $60;
+ LANG_KAZAK = $3f;
+ LANG_KONKANI = $57;
+ LANG_KOREAN = $12;
+ LANG_KYRGYZ = $40;
+ LANG_LATVIAN = $26;
+ LANG_LITHUANIAN = $27;
+ LANG_MACEDONIAN = $2f; // the Former Yugoslav Republic of Macedonia
+ LANG_MALAY = $3e;
+ LANG_MALAYALAM = $4c;
+ LANG_MANIPURI = $58;
+ LANG_MARATHI = $4e;
+ LANG_MONGOLIAN = $50;
+ LANG_NEPALI = $61;
+ LANG_NORWEGIAN = $14;
+ LANG_ORIYA = $48;
+ LANG_POLISH = $15;
+ LANG_PORTUGUESE = $16;
+ LANG_PUNJABI = $46;
+ LANG_ROMANIAN = $18;
+ LANG_RUSSIAN = $19;
+ LANG_SANSKRIT = $4f;
+ LANG_SERBIAN = $1a;
+ LANG_SINDHI = $59;
+ LANG_SLOVAK = $1b;
+ LANG_SLOVENIAN = $24;
+ LANG_SPANISH = $0a;
+ LANG_SWAHILI = $41;
+ LANG_SWEDISH = $1d;
+ LANG_SYRIAC = $5a;
+ LANG_TAMIL = $49;
+ LANG_TATAR = $44;
+ LANG_TELUGU = $4a;
+ LANG_THAI = $1e;
+ LANG_TURKISH = $1f;
+ LANG_UKRAINIAN = $22;
+ LANG_URDU = $20;
+ LANG_UZBEK = $43;
+ LANG_VIETNAMESE = $2a;
+
+ //
+ // Sublanguage IDs.
+ //
+ // The name immediately following SUBLANG_ dictates which primary
+ // language ID that sublanguage ID can be combined with to form a
+ // valid language ID.
+ //
+
+ SUBLANG_NEUTRAL = $00; // language neutral
+ SUBLANG_DEFAULT = $01; // user default
+ SUBLANG_SYS_DEFAULT = $02; // system default
+
+ SUBLANG_ARABIC_SAUDI_ARABIA = $01; // Arabic (Saudi Arabia)
+ SUBLANG_ARABIC_IRAQ = $02; // Arabic (Iraq)
+ SUBLANG_ARABIC_EGYPT = $03; // Arabic (Egypt)
+ SUBLANG_ARABIC_LIBYA = $04; // Arabic (Libya)
+ SUBLANG_ARABIC_ALGERIA = $05; // Arabic (Algeria)
+ SUBLANG_ARABIC_MOROCCO = $06; // Arabic (Morocco)
+ SUBLANG_ARABIC_TUNISIA = $07; // Arabic (Tunisia)
+ SUBLANG_ARABIC_OMAN = $08; // Arabic (Oman)
+ SUBLANG_ARABIC_YEMEN = $09; // Arabic (Yemen)
+ SUBLANG_ARABIC_SYRIA = $0a; // Arabic (Syria)
+ SUBLANG_ARABIC_JORDAN = $0b; // Arabic (Jordan)
+ SUBLANG_ARABIC_LEBANON = $0c; // Arabic (Lebanon)
+ SUBLANG_ARABIC_KUWAIT = $0d; // Arabic (Kuwait)
+ SUBLANG_ARABIC_UAE = $0e; // Arabic (U.A.E)
+ SUBLANG_ARABIC_BAHRAIN = $0f; // Arabic (Bahrain)
+ SUBLANG_ARABIC_QATAR = $10; // Arabic (Qatar)
+ SUBLANG_AZERI_LATIN = $01; // Azeri (Latin)
+ SUBLANG_AZERI_CYRILLIC = $02; // Azeri (Cyrillic)
+ SUBLANG_CHINESE_TRADITIONAL = $01; // Chinese (Taiwan)
+ SUBLANG_CHINESE_SIMPLIFIED = $02; // Chinese (PR China)
+ SUBLANG_CHINESE_HONGKONG = $03; // Chinese (Hong Kong S.A.R., P.R.C.)
+ SUBLANG_CHINESE_SINGAPORE = $04; // Chinese (Singapore)
+ SUBLANG_CHINESE_MACAU = $05; // Chinese (Macau S.A.R.)
+ SUBLANG_DUTCH = $01; // Dutch
+ SUBLANG_DUTCH_BELGIAN = $02; // Dutch (Belgian)
+ SUBLANG_ENGLISH_US = $01; // English (USA)
+ SUBLANG_ENGLISH_UK = $02; // English (UK)
+ SUBLANG_ENGLISH_AUS = $03; // English (Australian)
+ SUBLANG_ENGLISH_CAN = $04; // English (Canadian)
+ SUBLANG_ENGLISH_NZ = $05; // English (New Zealand)
+ SUBLANG_ENGLISH_EIRE = $06; // English (Irish)
+ SUBLANG_ENGLISH_SOUTH_AFRICA = $07; // English (South Africa)
+ SUBLANG_ENGLISH_JAMAICA = $08; // English (Jamaica)
+ SUBLANG_ENGLISH_CARIBBEAN = $09; // English (Caribbean)
+ SUBLANG_ENGLISH_BELIZE = $0a; // English (Belize)
+ SUBLANG_ENGLISH_TRINIDAD = $0b; // English (Trinidad)
+ SUBLANG_ENGLISH_ZIMBABWE = $0c; // English (Zimbabwe)
+ SUBLANG_ENGLISH_PHILIPPINES = $0d; // English (Philippines)
+ SUBLANG_FRENCH = $01; // French
+ SUBLANG_FRENCH_BELGIAN = $02; // French (Belgian)
+ SUBLANG_FRENCH_CANADIAN = $03; // French (Canadian)
+ SUBLANG_FRENCH_SWISS = $04; // French (Swiss)
+ SUBLANG_FRENCH_LUXEMBOURG = $05; // French (Luxembourg)
+ SUBLANG_FRENCH_MONACO = $06; // French (Monaco)
+ SUBLANG_GERMAN = $01; // German
+ SUBLANG_GERMAN_SWISS = $02; // German (Swiss)
+ SUBLANG_GERMAN_AUSTRIAN = $03; // German (Austrian)
+ SUBLANG_GERMAN_LUXEMBOURG = $04; // German (Luxembourg)
+ SUBLANG_GERMAN_LIECHTENSTEIN = $05; // German (Liechtenstein)
+ SUBLANG_ITALIAN = $01; // Italian
+ SUBLANG_ITALIAN_SWISS = $02; // Italian (Swiss)
+ SUBLANG_KASHMIRI_SASIA = $02; // Kashmiri (South Asia)
+ SUBLANG_KASHMIRI_INDIA = $02; // For app compatibility only
+ SUBLANG_KOREAN = $01; // Korean (Extended Wansung)
+ SUBLANG_LITHUANIAN = $01; // Lithuanian
+ SUBLANG_MALAY_MALAYSIA = $01; // Malay (Malaysia)
+ SUBLANG_MALAY_BRUNEI_DARUSSALAM = $02; // Malay (Brunei Darussalam)
+ SUBLANG_NEPALI_INDIA = $02; // Nepali (India)
+ SUBLANG_NORWEGIAN_BOKMAL = $01; // Norwegian (Bokmal)
+ SUBLANG_NORWEGIAN_NYNORSK = $02; // Norwegian (Nynorsk)
+ SUBLANG_PORTUGUESE = $02; // Portuguese
+ SUBLANG_PORTUGUESE_BRAZILIAN = $01; // Portuguese (Brazilian)
+ SUBLANG_SERBIAN_LATIN = $02; // Serbian (Latin)
+ SUBLANG_SERBIAN_CYRILLIC = $03; // Serbian (Cyrillic)
+ SUBLANG_SPANISH = $01; // Spanish (Castilian)
+ SUBLANG_SPANISH_MEXICAN = $02; // Spanish (Mexican)
+ SUBLANG_SPANISH_MODERN = $03; // Spanish (Spain)
+ SUBLANG_SPANISH_GUATEMALA = $04; // Spanish (Guatemala)
+ SUBLANG_SPANISH_COSTA_RICA = $05; // Spanish (Costa Rica)
+ SUBLANG_SPANISH_PANAMA = $06; // Spanish (Panama)
+ SUBLANG_SPANISH_DOMINICAN_REPUBLIC = $07; // Spanish (Dominican Republic)
+ SUBLANG_SPANISH_VENEZUELA = $08; // Spanish (Venezuela)
+ SUBLANG_SPANISH_COLOMBIA = $09; // Spanish (Colombia)
+ SUBLANG_SPANISH_PERU = $0a; // Spanish (Peru)
+ SUBLANG_SPANISH_ARGENTINA = $0b; // Spanish (Argentina)
+ SUBLANG_SPANISH_ECUADOR = $0c; // Spanish (Ecuador)
+ SUBLANG_SPANISH_CHILE = $0d; // Spanish (Chile)
+ SUBLANG_SPANISH_URUGUAY = $0e; // Spanish (Uruguay)
+ SUBLANG_SPANISH_PARAGUAY = $0f; // Spanish (Paraguay)
+ SUBLANG_SPANISH_BOLIVIA = $10; // Spanish (Bolivia)
+ SUBLANG_SPANISH_EL_SALVADOR = $11; // Spanish (El Salvador)
+ SUBLANG_SPANISH_HONDURAS = $12; // Spanish (Honduras)
+ SUBLANG_SPANISH_NICARAGUA = $13; // Spanish (Nicaragua)
+ SUBLANG_SPANISH_PUERTO_RICO = $14; // Spanish (Puerto Rico)
+ SUBLANG_SWEDISH = $01; // Swedish
+ SUBLANG_SWEDISH_FINLAND = $02; // Swedish (Finland)
+ SUBLANG_URDU_PAKISTAN = $01; // Urdu (Pakistan)
+ SUBLANG_URDU_INDIA = $02; // Urdu (India)
+ SUBLANG_UZBEK_LATIN = $01; // Uzbek (Latin)
+ SUBLANG_UZBEK_CYRILLIC = $02; // Uzbek (Cyrillic)
+
+ //
+ // Sorting IDs.
+ //
+
+ SORT_DEFAULT = $0; // sorting default
+
+ SORT_JAPANESE_XJIS = $0; // Japanese XJIS order
+ SORT_JAPANESE_UNICODE = $1; // Japanese Unicode order
+
+ SORT_CHINESE_BIG5 = $0; // Chinese BIG5 order
+ SORT_CHINESE_PRCP = $0; // PRC Chinese Phonetic order
+ SORT_CHINESE_UNICODE = $1; // Chinese Unicode order
+ SORT_CHINESE_PRC = $2; // PRC Chinese Stroke Count order
+ SORT_CHINESE_BOPOMOFO = $3; // Traditional Chinese Bopomofo order
+
+ SORT_KOREAN_KSC = $0; // Korean KSC order
+ SORT_KOREAN_UNICODE = $1; // Korean Unicode order
+
+ SORT_GERMAN_PHONE_BOOK = $1; // German Phone Book order
+
+ SORT_HUNGARIAN_DEFAULT = $0; // Hungarian Default order
+ SORT_HUNGARIAN_TECHNICAL = $1; // Hungarian Technical order
+
+ SORT_GEORGIAN_TRADITIONAL = $0; // Georgian Traditional order
+ SORT_GEORGIAN_MODERN = $1; // Georgian Modern order
+
+
+ { SYSTEM_INFO structure }
+ PROCESSOR_INTEL_386 = 386;
+ PROCESSOR_INTEL_486 = 486;
+ PROCESSOR_INTEL_PENTIUM = 586;
+ PROCESSOR_MIPS_R4000 = 4000;
+ PROCESSOR_ALPHA_21064 = 21064;
+ { FSCTL_SET_COMPRESSION }
+ COMPRESSION_FORMAT_NONE = 0;
+ COMPRESSION_FORMAT_DEFAULT = 1;
+ COMPRESSION_FORMAT_LZNT1 = 2;
+ { TAPE_GET_DRIVE_PARAMETERS structure }
+ TAPE_DRIVE_COMPRESSION = 131072;
+ TAPE_DRIVE_ECC = 65536;
+ TAPE_DRIVE_ERASE_BOP_ONLY = 64;
+ TAPE_DRIVE_ERASE_LONG = 32;
+ TAPE_DRIVE_ERASE_IMMEDIATE = 128;
+ TAPE_DRIVE_ERASE_SHORT = 16;
+ TAPE_DRIVE_FIXED = 1;
+ TAPE_DRIVE_FIXED_BLOCK = 1024;
+ TAPE_DRIVE_INITIATOR = 4;
+ TAPE_DRIVE_PADDING = 262144;
+ TAPE_DRIVE_GET_ABSOLUTE_BLK = 1048576;
+ TAPE_DRIVE_GET_LOGICAL_BLK = 2097152;
+ TAPE_DRIVE_REPORT_SMKS = 524288;
+ TAPE_DRIVE_SELECT = 2;
+ TAPE_DRIVE_SET_EOT_WZ_SIZE = 4194304;
+ TAPE_DRIVE_TAPE_CAPACITY = 256;
+ TAPE_DRIVE_TAPE_REMAINING = 512;
+ TAPE_DRIVE_VARIABLE_BLOCK = 2048;
+ TAPE_DRIVE_WRITE_PROTECT = 4096;
+ TAPE_DRIVE_ABS_BLK_IMMED = -(2147475456);
+ TAPE_DRIVE_ABSOLUTE_BLK = -(2147479552);
+ TAPE_DRIVE_END_OF_DATA = -(2147418112);
+ TAPE_DRIVE_FILEMARKS = -(2147221504);
+ TAPE_DRIVE_LOAD_UNLOAD = -(2147483647);
+ TAPE_DRIVE_LOAD_UNLD_IMMED = -(2147483616);
+ TAPE_DRIVE_LOCK_UNLOCK = -(2147483644);
+ TAPE_DRIVE_LOCK_UNLK_IMMED = -(2147483520);
+ TAPE_DRIVE_LOG_BLK_IMMED = -(2147450880);
+ TAPE_DRIVE_LOGICAL_BLK = -(2147467264);
+ TAPE_DRIVE_RELATIVE_BLKS = -(2147352576);
+ TAPE_DRIVE_REVERSE_POSITION = -(2143289344);
+ TAPE_DRIVE_REWIND_IMMEDIATE = -(2147483640);
+ TAPE_DRIVE_SEQUENTIAL_FMKS = -(2146959360);
+ TAPE_DRIVE_SEQUENTIAL_SMKS = -(2145386496);
+ TAPE_DRIVE_SET_BLOCK_SIZE = -(2147483632);
+ TAPE_DRIVE_SET_COMPRESSION = -(2147483136);
+ TAPE_DRIVE_SET_ECC = -(2147483392);
+ TAPE_DRIVE_SET_PADDING = -(2147482624);
+ TAPE_DRIVE_SET_REPORT_SMKS = -(2147481600);
+ TAPE_DRIVE_SETMARKS = -(2146435072);
+ TAPE_DRIVE_SPACE_IMMEDIATE = -(2139095040);
+ TAPE_DRIVE_TENSION = -(2147483646);
+ TAPE_DRIVE_TENSION_IMMED = -(2147483584);
+ TAPE_DRIVE_WRITE_FILEMARKS = -(2113929216);
+ TAPE_DRIVE_WRITE_LONG_FMKS = -(2013265920);
+ TAPE_DRIVE_WRITE_MARK_IMMED = -(1879048192);
+ TAPE_DRIVE_WRITE_SETMARKS = -(2130706432);
+ TAPE_DRIVE_WRITE_SHORT_FMKS = -(2080374784);
+ { Standard rights }
+ STANDARD_RIGHTS_REQUIRED = $f0000;
+ STANDARD_RIGHTS_WRITE = $20000;
+ STANDARD_RIGHTS_READ = $20000;
+ STANDARD_RIGHTS_EXECUTE = $20000;
+ STANDARD_RIGHTS_ALL = $1f0000;
+ SPECIFIC_RIGHTS_ALL = $ffff;
+ { ACCESS_MASK }
+ MAXIMUM_ALLOWED = $2000000;
+ GENERIC_ALL = $10000000;
+ { SID }
+ SECURITY_NULL_RID = 0;
+ SECURITY_WORLD_RID = 0;
+ SECURITY_LOCAL_RID = 0;
+ SECURITY_CREATOR_OWNER_RID = 0;
+ SECURITY_CREATOR_GROUP_RID = $1;
+ SECURITY_DIALUP_RID = $1;
+ SECURITY_NETWORK_RID = $2;
+ SECURITY_BATCH_RID = $3;
+ SECURITY_INTERACTIVE_RID = $4;
+ SECURITY_LOGON_IDS_RID = $5;
+ SECURITY_LOGON_IDS_RID_COUNT = $3;
+ SECURITY_SERVICE_RID = $6;
+ SECURITY_LOCAL_SYSTEM_RID = $12;
+ SECURITY_BUILTIN_DOMAIN_RID = $20;
+ DOMAIN_USER_RID_ADMIN = $1f4;
+ DOMAIN_USER_RID_GUEST = $1f5;
+ DOMAIN_GROUP_RID_ADMINS = $200;
+ DOMAIN_GROUP_RID_USERS = $201;
+ DOMAIN_ALIAS_RID_ADMINS = $220;
+ DOMAIN_ALIAS_RID_USERS = $221;
+ DOMAIN_ALIAS_RID_GUESTS = $222;
+ DOMAIN_ALIAS_RID_POWER_USERS = $223;
+ DOMAIN_ALIAS_RID_ACCOUNT_OPS = $224;
+ DOMAIN_ALIAS_RID_SYSTEM_OPS = $225;
+ DOMAIN_ALIAS_RID_PRINT_OPS = $226;
+ DOMAIN_ALIAS_RID_BACKUP_OPS = $227;
+ DOMAIN_ALIAS_RID_REPLICATOR = $228;
+ { TOKEN_GROUPS structure }
+ SE_GROUP_MANDATORY = $1;
+ SE_GROUP_ENABLED_BY_DEFAULT = $2;
+ SE_GROUP_ENABLED = $4;
+ SE_GROUP_OWNER = $8;
+ SE_GROUP_LOGON_ID = $c0000000;
+ { ACL Defines }
+ ACL_REVISION = 2;
+ { ACE_HEADER structure }
+ ACCESS_ALLOWED_ACE_TYPE = $0;
+ ACCESS_DENIED_ACE_TYPE = $1;
+ SYSTEM_AUDIT_ACE_TYPE = $2;
+ SYSTEM_ALARM_ACE_TYPE = $3;
+ { ACE flags in the ACE_HEADER structure }
+ OBJECT_INHERIT_ACE = $1;
+ CONTAINER_INHERIT_ACE = $2;
+ NO_PROPAGATE_INHERIT_ACE = $4;
+ INHERIT_ONLY_ACE = $8;
+ SUCCESSFUL_ACCESS_ACE_FLAG = $40;
+ FAILED_ACCESS_ACE_FLAG = $80;
+ { SECURITY_DESCRIPTOR_CONTROL }
+ {SECURITY_DESCRIPTOR_REVISION = 1;already defined above }
+ SECURITY_DESCRIPTOR_MIN_LENGTH = 20;
+ SE_OWNER_DEFAULTED = 1;
+ SE_GROUP_DEFAULTED = 2;
+ SE_DACL_PRESENT = 4;
+ SE_DACL_DEFAULTED = 8;
+ SE_SACL_PRESENT = 16;
+ SE_SACL_DEFAULTED = 32;
+ SE_SELF_RELATIVE = 32768;
+ { PRIVILEGE_SET }
+ SE_PRIVILEGE_ENABLED_BY_DEFAULT = $1;
+ SE_PRIVILEGE_ENABLED = $2;
+ SE_PRIVILEGE_USED_FOR_ACCESS = $80000000;
+ PRIVILEGE_SET_ALL_NECESSARY = $1;
+ { OPENFILENAME structure }
+ OFN_ALLOWMULTISELECT = $200;
+ OFN_CREATEPROMPT = $2000;
+ OFN_ENABLEHOOK = $20;
+ OFN_ENABLETEMPLATE = $40;
+ OFN_ENABLETEMPLATEHANDLE = $80;
+ OFN_EXPLORER = $80000;
+ OFN_EXTENSIONDIFFERENT = $400;
+ OFN_FILEMUSTEXIST = $1000;
+ OFN_HIDEREADONLY = $4;
+ OFN_LONGNAMES = $200000;
+ OFN_NOCHANGEDIR = $8;
+ OFN_NODEREFERENCELINKS = $100000;
+ OFN_NOLONGNAMES = $40000;
+ OFN_NONETWORKBUTTON = $20000;
+ OFN_NOREADONLYRETURN = $8000;
+ OFN_NOTESTFILECREATE = $10000;
+ OFN_NOVALIDATE = $100;
+ OFN_OVERWRITEPROMPT = $2;
+ OFN_PATHMUSTEXIST = $800;
+ OFN_READONLY = $1;
+ OFN_SHAREAWARE = $4000;
+ OFN_SHOWHELP = $10;
+ { SHAREVISTRING message }
+ OFN_SHAREFALLTHROUGH = $2;
+ OFN_SHARENOWARN = $1;
+ OFN_SHAREWARN = 0;
+ { Open/Save notifications }
+ CDN_INITDONE = $fffffda7;
+ CDN_SELCHANGE = $fffffda6;
+ CDN_FOLDERCHANGE = $fffffda5;
+ CDN_SHAREVIOLATION = $fffffda4;
+ CDN_HELP = $fffffda3;
+ CDN_FILEOK = $fffffda2;
+ CDN_TYPECHANGE = $fffffda1;
+ { Open/Save messages }
+ CDM_GETFILEPATH = $465;
+ CDM_GETFOLDERIDLIST = $467;
+ CDM_GETFOLDERPATH = $466;
+ CDM_GETSPEC = $464;
+ CDM_HIDECONTROL = $469;
+ CDM_SETCONTROLTEXT = $468;
+ CDM_SETDEFEXT = $46a;
+ { CHOOSECOLOR structure }
+ CC_ENABLEHOOK = $10;
+ CC_ENABLETEMPLATE = $20;
+ CC_ENABLETEMPLATEHANDLE = $40;
+ CC_FULLOPEN = $2;
+ CC_PREVENTFULLOPEN = $4;
+ CC_RGBINIT = $1;
+ CC_SHOWHELP = $8;
+ CC_SOLIDCOLOR = $80;
+ { FINDREPLACE structure }
+ FR_DIALOGTERM = $40;
+ FR_DOWN = $1;
+ FR_ENABLEHOOK = $100;
+ FR_ENABLETEMPLATE = $200;
+ FR_ENABLETEMPLATEHANDLE = $2000;
+ FR_FINDNEXT = $8;
+ FR_HIDEUPDOWN = $4000;
+ FR_HIDEMATCHCASE = $8000;
+ FR_HIDEWHOLEWORD = $10000;
+ FR_MATCHCASE = $4;
+ FR_NOMATCHCASE = $800;
+ FR_NOUPDOWN = $400;
+ FR_NOWHOLEWORD = $1000;
+ FR_REPLACE = $10;
+ FR_REPLACEALL = $20;
+ FR_SHOWHELP = $80;
+ FR_WHOLEWORD = $2;
+ { CHOOSEFONT structure }
+ CF_APPLY = $200;
+ CF_ANSIONLY = $400;
+ CF_BOTH = $3;
+ CF_TTONLY = $40000;
+ CF_EFFECTS = $100;
+ CF_ENABLEHOOK = $8;
+ CF_ENABLETEMPLATE = $10;
+ CF_ENABLETEMPLATEHANDLE = $20;
+ CF_FIXEDPITCHONLY = $4000;
+ CF_FORCEFONTEXIST = $10000;
+ CF_INITTOLOGFONTSTRUCT = $40;
+ CF_LIMITSIZE = $2000;
+ CF_NOOEMFONTS = $800;
+ CF_NOFACESEL = $80000;
+ CF_NOSCRIPTSEL = $800000;
+ CF_NOSTYLESEL = $100000;
+ CF_NOSIZESEL = $200000;
+ CF_NOSIMULATIONS = $1000;
+ CF_NOVECTORFONTS = $800;
+ CF_NOVERTFONTS = $1000000;
+ CF_PRINTERFONTS = $2;
+ CF_SCALABLEONLY = $20000;
+ CF_SCREENFONTS = $1;
+ CF_SCRIPTSONLY = $400;
+ CF_SELECTSCRIPT = $400000;
+ CF_SHOWHELP = $4;
+ CF_USESTYLE = $80;
+ CF_WYSIWYG = $8000;
+ BOLD_FONTTYPE = $100;
+ ITALIC_FONTTYPE = $200;
+ PRINTER_FONTTYPE = $4000;
+ REGULAR_FONTTYPE = $400;
+ SCREEN_FONTTYPE = $2000;
+ SIMULATED_FONTTYPE = $8000;
+ { Common dialog messages }
+ COLOROKSTRINGW = 'commdlg_ColorOK';
+ FILEOKSTRINGW = 'commdlg_FileNameOK';
+ FINDMSGSTRINGW = 'commdlg_FindReplace';
+ HELPMSGSTRINGW = 'commdlg_help';
+ LBSELCHSTRINGW = 'commdlg_LBSelChangedNotify';
+ SETRGBSTRINGW = 'commdlg_SetRGBColor';
+ SHAREVISTRINGW = 'commdlg_ShareViolation';
+ COLOROKSTRINGA = 'commdlg_ColorOK';
+ FILEOKSTRINGA = 'commdlg_FileNameOK';
+ FINDMSGSTRINGA = 'commdlg_FindReplace';
+ HELPMSGSTRINGA = 'commdlg_help';
+ LBSELCHSTRINGA = 'commdlg_LBSelChangedNotify';
+ SETRGBSTRINGA = 'commdlg_SetRGBColor';
+ SHAREVISTRINGA = 'commdlg_ShareViolation';
+{$ifdef UNICODE}
+
+ const
+ COLOROKSTRING = COLOROKSTRINGW;
+ FILEOKSTRING = FILEOKSTRINGW;
+ FINDMSGSTRING = FINDMSGSTRINGW;
+ HELPMSGSTRING = HELPMSGSTRINGW;
+ LBSELCHSTRING = LBSELCHSTRINGW;
+ SETRGBSTRING = SETRGBSTRINGW;
+ SHAREVISTRING = SHAREVISTRINGW;
+{$else}
+
+ const
+ COLOROKSTRING = COLOROKSTRINGA;
+ FILEOKSTRING = FILEOKSTRINGA;
+ FINDMSGSTRING = FINDMSGSTRINGA;
+ HELPMSGSTRING = HELPMSGSTRINGA;
+ LBSELCHSTRING = LBSELCHSTRINGA;
+ SETRGBSTRING = SETRGBSTRINGA;
+ SHAREVISTRING = SHAREVISTRINGA;
+{$endif}
+ { LBSELCHSTRING message }
+
+ const
+ CD_LBSELCHANGE = 0;
+ CD_LBSELADD = 2;
+ CD_LBSELSUB = 1;
+ CD_LBSELNOITEMS = -(1);
+ { DEVNAMES structure }
+ DN_DEFAULTPRN = 1;
+ { PRINTDLG structure }
+ PD_ALLPAGES = 0;
+ PD_COLLATE = 16;
+ PD_DISABLEPRINTTOFILE = 524288;
+ PD_ENABLEPRINTHOOK = 4096;
+ PD_ENABLEPRINTTEMPLATE = 16384;
+ PD_ENABLEPRINTTEMPLATEHANDLE = 65536;
+ PD_ENABLESETUPHOOK = 8192;
+ PD_ENABLESETUPTEMPLATE = 32768;
+ PD_ENABLESETUPTEMPLATEHANDLE = 131072;
+ PD_HIDEPRINTTOFILE = 1048576;
+ PD_NOPAGENUMS = 8;
+ PD_NOSELECTION = 4;
+ PD_NOWARNING = 128;
+ PD_PAGENUMS = 2;
+ PD_PRINTSETUP = 64;
+ PD_PRINTTOFILE = 32;
+ PD_RETURNDC = 256;
+ PD_RETURNDEFAULT = 1024;
+ PD_RETURNIC = 512;
+ PD_SELECTION = 1;
+ PD_SHOWHELP = 2048;
+ PD_USEDEVMODECOPIES = 262144;
+ PD_USEDEVMODECOPIESANDCOLLATE = 262144;
+ { PAGESETUPDLG structure }
+ PSD_DEFAULTMINMARGINS = 0;
+ PSD_DISABLEMARGINS = 16;
+ PSD_DISABLEORIENTATION = 256;
+ PSD_DISABLEPAGEPAINTING = 524288;
+ PSD_DISABLEPAPER = 512;
+ PSD_DISABLEPRINTER = 32;
+ PSD_ENABLEPAGEPAINTHOOK = 262144;
+ PSD_ENABLEPAGESETUPHOOK = 8192;
+ PSD_ENABLEPAGESETUPTEMPLATE = 32768;
+ PSD_ENABLEPAGESETUPTEMPLATEHANDLE = 131072;
+ PSD_INHUNDREDTHSOFMILLIMETERS = 8;
+ PSD_INTHOUSANDTHSOFINCHES = 4;
+ PSD_INWININIINTLMEASURE = 0;
+ PSD_MARGINS = 2;
+ PSD_MINMARGINS = 1;
+ PSD_NOWARNING = 128;
+ PSD_RETURNDEFAULT = 1024;
+ PSD_SHOWHELP = 2048;
+ { WM_SHOWWINDOW message }
+ SW_OTHERUNZOOM = 4;
+ SW_OTHERZOOM = 2;
+ SW_PARENTCLOSING = 1;
+ SW_PARENTOPENING = 3;
+ { Virtual Key codes }
+ VK_LBUTTON = 1;
+ VK_RBUTTON = 2;
+ VK_CANCEL = 3;
+ VK_MBUTTON = 4;
+ VK_BACK = 8;
+ VK_TAB = 9;
+ VK_CLEAR = 12;
+ VK_RETURN = 13;
+ VK_SHIFT = 16;
+ VK_CONTROL = 17;
+ VK_MENU = 18;
+ VK_PAUSE = 19;
+ VK_CAPITAL = 20;
+ VK_ESCAPE = 27;
+ VK_SPACE = 32;
+ VK_PRIOR = 33;
+ VK_NEXT = 34;
+ VK_END = 35;
+ VK_HOME = 36;
+ VK_LEFT = 37;
+ VK_UP = 38;
+ VK_RIGHT = 39;
+ VK_DOWN = 40;
+ VK_SELECT = 41;
+ VK_PRINT = 42;
+ VK_EXECUTE = 43;
+ VK_SNAPSHOT = 44;
+ VK_INSERT = 45;
+ VK_DELETE = 46;
+ VK_HELP = 47;
+ VK_0 = 48;
+ VK_1 = 49;
+ VK_2 = 50;
+ VK_3 = 51;
+ VK_4 = 52;
+ VK_5 = 53;
+ VK_6 = 54;
+ VK_7 = 55;
+ VK_8 = 56;
+ VK_9 = 57;
+ VK_A = 65;
+ VK_B = 66;
+ VK_C = 67;
+ VK_D = 68;
+ VK_E = 69;
+ VK_F = 70;
+ VK_G = 71;
+ VK_H = 72;
+ VK_I = 73;
+ VK_J = 74;
+ VK_K = 75;
+ VK_L = 76;
+ VK_M = 77;
+ VK_N = 78;
+ VK_O = 79;
+ VK_P = 80;
+ VK_Q = 81;
+ VK_R = 82;
+ VK_S = 83;
+ VK_T = 84;
+ VK_U = 85;
+ VK_V = 86;
+ VK_W = 87;
+ VK_X = 88;
+ VK_Y = 89;
+ VK_Z = 90;
+ VK_LWIN = 91;
+ VK_RWIN = 92;
+ VK_APPS = 93;
+ VK_NUMPAD0 = 96;
+ VK_NUMPAD1 = 97;
+ VK_NUMPAD2 = 98;
+ VK_NUMPAD3 = 99;
+ VK_NUMPAD4 = 100;
+ VK_NUMPAD5 = 101;
+ VK_NUMPAD6 = 102;
+ VK_NUMPAD7 = 103;
+ VK_NUMPAD8 = 104;
+ VK_NUMPAD9 = 105;
+ VK_MULTIPLY = 106;
+ VK_ADD = 107;
+ VK_SEPARATOR = 108;
+ VK_SUBTRACT = 109;
+ VK_DECIMAL = 110;
+ VK_DIVIDE = 111;
+ VK_F1 = 112;
+ VK_F2 = 113;
+ VK_F3 = 114;
+ VK_F4 = 115;
+ VK_F5 = 116;
+ VK_F6 = 117;
+ VK_F7 = 118;
+ VK_F8 = 119;
+ VK_F9 = 120;
+ VK_F10 = 121;
+ VK_F11 = 122;
+ VK_F12 = 123;
+ VK_F13 = 124;
+ VK_F14 = 125;
+ VK_F15 = 126;
+ VK_F16 = 127;
+ VK_F17 = 128;
+ VK_F18 = 129;
+ VK_F19 = 130;
+ VK_F20 = 131;
+ VK_F21 = 132;
+ VK_F22 = 133;
+ VK_F23 = 134;
+ VK_F24 = 135;
+ { GetAsyncKeyState }
+ VK_NUMLOCK = 144;
+ VK_SCROLL = 145;
+ VK_LSHIFT = 160;
+ VK_LCONTROL = 162;
+ VK_LMENU = 164;
+ VK_RSHIFT = 161;
+ VK_RCONTROL = 163;
+ VK_RMENU = 165;
+ { ImmGetVirtualKey }
+ VK_PROCESSKEY = 229;
+ { Keystroke Message Flags }
+ KF_ALTDOWN = 8192;
+ KF_DLGMODE = 2048;
+ KF_EXTENDED = 256;
+ KF_MENUMODE = 4096;
+ KF_REPEAT = 16384;
+ KF_UP = 32768;
+ { GetKeyboardLayoutName }
+ KL_NAMELENGTH = 9;
+ { WM_ACTIVATE message }
+ WA_ACTIVE = 1;
+ WA_CLICKACTIVE = 2;
+ WA_INACTIVE = 0;
+ { WM_ACTIVATE message }
+ PWR_CRITICALRESUME = 3;
+ PWR_SUSPENDREQUEST = 1;
+ PWR_SUSPENDRESUME = 2;
+ PWR_FAIL = -(1);
+ PWR_OK = 1;
+ { WM_NOTIFYFORMAT message }
+ NF_QUERY = 3;
+ NF_REQUERY = 4;
+ NFR_ANSI = 1;
+ NFR_UNICODE = 2;
+ { WM_SIZING message }
+ WMSZ_BOTTOM = 6;
+ WMSZ_BOTTOMLEFT = 7;
+ WMSZ_BOTTOMRIGHT = 8;
+ WMSZ_LEFT = 1;
+ WMSZ_RIGHT = 2;
+ WMSZ_TOP = 3;
+ WMSZ_TOPLEFT = 4;
+ WMSZ_TOPRIGHT = 5;
+ { WM_MOUSEACTIVATE message }
+ MA_ACTIVATE = 1;
+ MA_ACTIVATEANDEAT = 2;
+ MA_NOACTIVATE = 3;
+ MA_NOACTIVATEANDEAT = 4;
+ { WM_SIZE message }
+ SIZE_MAXHIDE = 4;
+ SIZE_MAXIMIZED = 2;
+ SIZE_MAXSHOW = 3;
+ SIZE_MINIMIZED = 1;
+ SIZE_RESTORED = 0;
+ { WM_NCCALCSIZE message }
+ WVR_ALIGNTOP = 16;
+ WVR_ALIGNLEFT = 32;
+ WVR_ALIGNBOTTOM = 64;
+ WVR_ALIGNRIGHT = 128;
+ WVR_HREDRAW = 256;
+ WVR_VREDRAW = 512;
+ WVR_REDRAW = 768;
+ WVR_VALIDRECTS = 1024;
+ { WM_NCHITTEST message }
+ HTBOTTOM = 15;
+ HTBOTTOMLEFT = 16;
+ HTBOTTOMRIGHT = 17;
+ HTCAPTION = 2;
+ HTCLIENT = 1;
+ HTERROR = -(2);
+ HTGROWBOX = 4;
+ HTHSCROLL = 6;
+ HTLEFT = 10;
+ HTMENU = 5;
+ HTNOWHERE = 0;
+ HTREDUCE = 8;
+ HTRIGHT = 11;
+ HTSIZE = 4;
+ HTSYSMENU = 3;
+ HTTOP = 12;
+ HTTOPLEFT = 13;
+ HTTOPRIGHT = 14;
+ HTTRANSPARENT = -(1);
+ HTVSCROLL = 7;
+ HTZOOM = 9;
+ { Mouse messages }
+ MK_CONTROL = 8;
+ MK_LBUTTON = 1;
+ MK_MBUTTON = 16;
+ MK_RBUTTON = 2;
+ MK_SHIFT = 4;
+ { WNDCLASS structure }
+ CS_BYTEALIGNCLIENT = 4096;
+ CS_BYTEALIGNWINDOW = 8192;
+ CS_CLASSDC = 64;
+ CS_DBLCLKS = 8;
+ CS_GLOBALCLASS = 16384;
+ CS_HREDRAW = 2;
+ CS_KEYCVTWINDOW = 4;
+ CS_NOCLOSE = 512;
+ CS_NOKEYCVT = 256;
+ CS_OWNDC = 32;
+ CS_PARENTDC = 128;
+ CS_SAVEBITS = 2048;
+ CS_VREDRAW = 1;
+ DLGWINDOWEXTRA = 30;
+ { ACCEL structure }
+ FALT = 16;
+ FCONTROL = 8;
+ FNOINVERT = 2;
+ FSHIFT = 4;
+ FVIRTKEY = 1;
+ { MENUITEMINFO structure }
+ MIIM_CHECKMARKS = 8;
+ MIIM_DATA = 32;
+ MIIM_ID = 2;
+ MIIM_STATE = 1;
+ MIIM_SUBMENU = 4;
+ MIIM_TYPE = 16;
+ MFT_BITMAP = $4;
+ MFT_MENUBARBREAK = $20;
+ MFT_MENUBREAK = $40;
+ MFT_OWNERDRAW = $100;
+ MFT_RADIOCHECK = $200;
+ MFT_RIGHTJUSTIFY = $4000;
+ MFT_SEPARATOR = $800;
+ MFT_STRING = 0;
+ MFS_CHECKED = $8;
+ MFS_DEFAULT = $1000;
+ MFS_DISABLED = $3;
+ MFS_ENABLED = 0;
+ MFS_GRAYED = $3;
+ MFS_HILITE = $80;
+ MFS_UNCHECKED = 0;
+ MFS_UNHILITE = 0;
+ { SERIALKEYS structure }
+ SERKF_AVAILABLE = 2;
+ SERKF_INDICATOR = 4;
+ SERKF_SERIALKEYSON = 1;
+ { FILTERKEYS structure }
+ FKF_AVAILABLE = 2;
+ FKF_CLICKON = 64;
+ FKF_FILTERKEYSON = 1;
+ FKF_HOTKEYACTIVE = 4;
+ FKF_HOTKEYSOUND = 16;
+ FKF_CONFIRMHOTKEY = 8;
+ FKF_INDICATOR = 32;
+ { HELPINFO structure }
+ HELPINFO_MENUITEM = 2;
+ HELPINFO_WINDOW = 1;
+ { WM_PRINT message }
+ PRF_CHECKVISIBLE = $1;
+ PRF_CHILDREN = $10;
+ PRF_CLIENT = $4;
+ PRF_ERASEBKGND = $8;
+ PRF_NONCLIENT = $2;
+ PRF_OWNED = $20;
+ { MapWindowPoints }
+ { was #define dname def_expr }
+ function HWND_DESKTOP : HWND;
+
+ { WM_SYSCOMMAND message }
+
+ const
+ SC_CLOSE = 61536;
+ SC_CONTEXTHELP = 61824;
+ SC_DEFAULT = 61792;
+ SC_HOTKEY = 61776;
+ SC_HSCROLL = 61568;
+ SC_KEYMENU = 61696;
+ SC_MAXIMIZE = 61488;
+ SC_ZOOM = 61488;
+ SC_MINIMIZE = 61472;
+ SC_ICON = 61472;
+ SC_MONITORPOWER = 61808;
+ SC_MOUSEMENU = 61584;
+ SC_MOVE = 61456;
+ SC_NEXTWINDOW = 61504;
+ SC_PREVWINDOW = 61520;
+ SC_RESTORE = 61728;
+ SC_SCREENSAVE = 61760;
+ SC_SIZE = 61440;
+ SC_TASKLIST = 61744;
+ SC_VSCROLL = 61552;
+ { DM_GETDEFID message }
+ DC_HASDEFID = 21323;
+ { WM_GETDLGCODE message }
+ DLGC_BUTTON = 8192;
+ DLGC_DEFPUSHBUTTON = 16;
+ DLGC_HASSETSEL = 8;
+ DLGC_RADIOBUTTON = 64;
+ DLGC_STATIC = 256;
+ DLGC_UNDEFPUSHBUTTON = 32;
+ DLGC_WANTALLKEYS = 4;
+ DLGC_WANTARROWS = 1;
+ DLGC_WANTCHARS = 128;
+ DLGC_WANTMESSAGE = 4;
+ DLGC_WANTTAB = 2;
+ { EM_SETMARGINS message }
+ EC_LEFTMARGIN = 1;
+ EC_RIGHTMARGIN = 2;
+ EC_USEFONTINFO = 65535;
+ { LB_SETCOUNT message }
+ LB_ERR = -(1);
+ LB_ERRSPACE = -(2);
+ LB_OKAY = 0;
+ { CB_DIR message }
+ CB_ERR = -(1);
+ CB_ERRSPACE = -(2);
+ { WM_IME_CONTROL message }
+ IMC_GETCANDIDATEPOS = 7;
+ IMC_GETCOMPOSITIONFONT = 9;
+ IMC_GETCOMPOSITIONWINDOW = 11;
+ IMC_GETSTATUSWINDOWPOS = 15;
+ IMC_CLOSESTATUSWINDOW = 33;
+ IMC_OPENSTATUSWINDOW = 34;
+ IMC_SETCANDIDATEPOS = 8;
+ IMC_SETCOMPOSITIONFONT = 10;
+ IMC_SETCOMPOSITIONWINDOW = 12;
+ IMC_SETSTATUSWINDOWPOS = 16;
+ { WM_IME_CONTROL message }
+ IMN_CHANGECANDIDATE = 3;
+ IMN_CLOSECANDIDATE = 4;
+ IMN_CLOSESTATUSWINDOW = 1;
+ IMN_GUIDELINE = 13;
+ IMN_OPENCANDIDATE = 5;
+ IMN_OPENSTATUSWINDOW = 2;
+ IMN_SETCANDIDATEPOS = 9;
+ IMN_SETCOMPOSITIONFONT = 10;
+ IMN_SETCOMPOSITIONWINDOW = 11;
+ IMN_SETCONVERSIONMODE = 6;
+ IMN_SETOPENSTATUS = 8;
+ IMN_SETSENTENCEMODE = 7;
+ IMN_SETSTATUSWINDOWPOS = 12;
+ IMN_PRIVATE = 14;
+ { STICKYKEYS structure }
+ SKF_AUDIBLEFEEDBACK = 64;
+ SKF_AVAILABLE = 2;
+ SKF_CONFIRMHOTKEY = 8;
+ SKF_HOTKEYACTIVE = 4;
+ SKF_HOTKEYSOUND = 16;
+ SKF_INDICATOR = 32;
+ SKF_STICKYKEYSON = 1;
+ SKF_TRISTATE = 128;
+ SKF_TWOKEYSOFF = 256;
+ { MOUSEKEYS structure }
+ MKF_AVAILABLE = 2;
+ MKF_CONFIRMHOTKEY = 8;
+ MKF_HOTKEYACTIVE = 4;
+ MKF_HOTKEYSOUND = 16;
+ MKF_INDICATOR = 32;
+ MKF_MOUSEKEYSON = 1;
+ MKF_MODIFIERS = 64;
+ MKF_REPLACENUMBERS = 128;
+ { SOUNDSENTRY structure }
+ SSF_AVAILABLE = 2;
+ SSF_SOUNDSENTRYON = 1;
+ SSTF_BORDER = 2;
+ SSTF_CHARS = 1;
+ SSTF_DISPLAY = 3;
+ SSTF_NONE = 0;
+ SSGF_DISPLAY = 3;
+ SSGF_NONE = 0;
+ SSWF_CUSTOM = 4;
+ SSWF_DISPLAY = 3;
+ SSWF_NONE = 0;
+ SSWF_TITLE = 1;
+ SSWF_WINDOW = 2;
+ { ACCESSTIMEOUT structure }
+ ATF_ONOFFFEEDBACK = 2;
+ ATF_TIMEOUTON = 1;
+ { HIGHCONTRAST structure }
+ HCF_AVAILABLE = 2;
+ HCF_CONFIRMHOTKEY = 8;
+ HCF_HIGHCONTRASTON = 1;
+ HCF_HOTKEYACTIVE = 4;
+ HCF_HOTKEYAVAILABLE = 64;
+ HCF_HOTKEYSOUND = 16;
+ HCF_INDICATOR = 32;
+ { TOGGLEKEYS structure }
+ TKF_AVAILABLE = 2;
+ TKF_CONFIRMHOTKEY = 8;
+ TKF_HOTKEYACTIVE = 4;
+ TKF_HOTKEYSOUND = 16;
+ TKF_TOGGLEKEYSON = 1;
+ { Installable Policy }
+ PP_DISPLAYERRORS = 1;
+ { SERVICE_INFO structure }
+ RESOURCEDISPLAYTYPE_DOMAIN = 1;
+ RESOURCEDISPLAYTYPE_FILE = 4;
+ RESOURCEDISPLAYTYPE_GENERIC = 0;
+ RESOURCEDISPLAYTYPE_GROUP = 5;
+ RESOURCEDISPLAYTYPE_SERVER = 2;
+ RESOURCEDISPLAYTYPE_SHARE = 3;
+ { KEY_EVENT_RECORD structure }
+ CAPSLOCK_ON = 128;
+ ENHANCED_KEY = 256;
+ LEFT_ALT_PRESSED = 2;
+ LEFT_CTRL_PRESSED = 8;
+ NUMLOCK_ON = 32;
+ RIGHT_ALT_PRESSED = 1;
+ RIGHT_CTRL_PRESSED = 4;
+ SCROLLLOCK_ON = 64;
+ SHIFT_PRESSED = 16;
+ { MOUSE_EVENT_RECORD structure }
+ FROM_LEFT_1ST_BUTTON_PRESSED = 1;
+ RIGHTMOST_BUTTON_PRESSED = 2;
+ FROM_LEFT_2ND_BUTTON_PRESSED = 4;
+ FROM_LEFT_3RD_BUTTON_PRESSED = 8;
+ FROM_LEFT_4TH_BUTTON_PRESSED = 16;
+ DOUBLE_CLICK = 2;
+ MOUSE_MOVED = 1;
+ { INPUT_RECORD structure }
+ KEY_EVENT = 1;
+ _MOUSE_EVENT = 2; {conflict with function mouse_event}
+ cMOUSE_EVENT = 2;
+ WINDOW_BUFFER_SIZE_EVENT = 4;
+ MENU_EVENT = 8;
+ FOCUS_EVENT = 16;
+ { BITMAPINFOHEADER structure }
+ BI_RGB = 0;
+ BI_RLE8 = 1;
+ BI_RLE4 = 2;
+ BI_BITFIELDS = 3;
+ { Extensions to OpenGL }
+ { ChoosePixelFormat }
+ PFD_DOUBLEBUFFER = $1;
+ PFD_STEREO = $2;
+ PFD_DRAW_TO_WINDOW = $4;
+ PFD_DRAW_TO_BITMAP = $8;
+ PFD_SUPPORT_GDI = $10;
+ PFD_SUPPORT_OPENGL = $20;
+ PFD_DEPTH_DONTCARE = $20000000;
+ PFD_DOUBLEBUFFER_DONTCARE = $40000000;
+ PFD_STEREO_DONTCARE = $80000000;
+ PFD_TYPE_RGBA = 0;
+ PFD_TYPE_COLORINDEX = 1;
+ PFD_MAIN_PLANE = 0;
+ PFD_OVERLAY_PLANE = 1;
+ PFD_UNDERLAY_PLANE = -(1);
+ { wglUseFontOutlines }
+ WGL_FONT_LINES = 0;
+ WGL_FONT_POLYGONS = 1;
+ { LAYERPLANEDESCRIPTOR structure }
+ { PIXELFORMATDESCRIPTOR structure }
+ PFD_GENERIC_FORMAT = $40;
+ PFD_NEED_PALETTE = $80;
+ PFD_NEED_SYSTEM_PALETTE = $100;
+ PFD_SWAP_EXCHANGE = $200;
+ PFD_SWAP_COPY = $400;
+ PFD_SWAP_LAYER_BUFFERS = $800;
+ PFD_GENERIC_ACCELERATED = $1000;
+ PFD_SUPPORT_DIRECTDRAW = $2000;
+ { TEXTMETRIC structure }
+ TMPF_FIXED_PITCH = $1;
+ TMPF_VECTOR = $2;
+ TMPF_TRUETYPE = $4;
+ TMPF_DEVICE = $8;
+ WM_CTLCOLOR = 25;
+
+ { --------------------- old stuff, need to organize! --------------- }
+ { BEGINNING of windowsx.h stuff from old headers: }
+ { Not convertable by H2PAS
+ #define __CRACK_VOID_F(fn,args) (void)(fn args)
+ #define __CRACK_BOOL_F(fn,args) (BOOL)(fn args)
+ #define __CRACK_HMENU_F(fn,args) (HMENU)(fn args)
+ #define __CRACK_HWND_F(fn,args) (HWND)(fn args)
+ #define __CRACK_LONG_F(fn, args) (LRESULT)(fn args)
+ #define __CRACK_ZERO_F(fn, args) (fn args,0)
+ }
+ { was #define dname(params) def_expr }
+ function GetFirstChild(h:HWND):HWND;
+
+ { was #define dname(params) def_expr }
+ function GetNextSibling(h:HWND):HWND;
+
+ { was #define dname(params) def_expr }
+ function GetWindowID(h:HWND):longint;
+
+ { was #define dname(params) def_expr }
+ function SubclassWindow(h:HWND; p:LONG):LONG;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_COMMAND_CMD(w,l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_COMMAND_ID(w,l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_CTLCOLOR_HDC(w,l,msg : longint) : HDC;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_CTLCOLOR_HWND(w,l,msg : longint) : HWND;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_HSCROLL_CODE(w,l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_HSCROLL_HWND(w,l : longint) : HWND;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_HSCROLL_POS(w,l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_MDIACTIVATE_FACTIVATE(h,a,b : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_MDIACTIVATE_HWNDACTIVATE(a,b : longint) : HWND;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_MDIACTIVATE_HWNDDEACT(a,b : longint) : HWND;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_VSCROLL_CODE(w,l : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_VSCROLL_HWND(w,l : longint) : HWND;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_VSCROLL_POS(w,l : longint) : longint;
+ { return type might be wrong }
+
+ { Not convertable by H2PAS
+ #define FORWARD_WM_CLOSE(h, fn) __CRACK_VOID_F(fn,(h, WM_CLOSE, 0, 0))
+ #define FORWARD_WM_COMMAND(h, id, c, n, fn) __CRACK_VOID_F(fn,(h, WM_COMMAND, MAKEWPARAM(id,n), (LPARAM)c))
+ #define FORWARD_WM_CREATE(h, p, fn) __CRACK_BOOL_F(fn,(h, WM_CREATE, 0, (LPARAM)p))
+ #define FORWARD_WM_DESTROY(h, fn) __CRACK_VOID_F(fn,(h, WM_DESTROY, 0, 0))
+ #define FORWARD_WM_ENABLE(h, e, fn) __CRACK_VOID_F(fn,(h, WM_ENABLE, (WPARAM)e, 0))
+ #define FORWARD_WM_INITDIALOG(h, c, l, fn) __CRACK_BOOL_F(fn,(h, WM_INITDIALOG, (WPARAM)c, l))
+ #define FORWARD_WM_MDICASCADE(h, c, fn) __CRACK_BOOL_F(fn,(h, WM_MDICASCADE, (WPARAM)c, 0))
+ #define FORWARD_WM_MDIDESTROY(h, d, fn) __CRACK_VOID_F(fn,(h, WM_MDIDESTROY, (WPARAM)d, 0))
+ #define FORWARD_WM_MDIGETACTIVE(h, fn) __CRACK_HWND_F(fn,(h, WM_MDIGETACTIVE, 0, 0))
+ #define FORWARD_WM_MDIICONARRANGE(h, fn) __CRACK_VOID_F(fn,(h, WM_MDIICONARRANGE, 0, 0))
+ #define FORWARD_WM_MDISETMENU(h, fr, hf, hw, fn) __CRACK_HMENU_F(fn,(h, WM_MDISETMENU, (WPARAM)((fr) ? (hf) : 0), (LPARAM)(hw)))
+ #define FORWARD_WM_MDITILE(h, c, fn) __CRACK_BOOL_F(fn,(h, WM_MDITILE, (WPARAM)(c), 0))
+ #define FORWARD_WM_PAINT(h, fn) __CRACK_VOID_F(fn,(h, WM_PAINT, 0, 0))
+ #define FORWARD_WM_QUERYENDSESSION(h, fn) __CRACK_BOOL_F(fn,(h, WM_QUERYENDSESSION, 0, 0))
+ #define FORWARD_WM_SIZE(h, state, cx, cy, fn) __CRACK_VOID_F(fn,(h, WM_SIZE, (WPARAM)state, MAKELPARAM(cx, cy)))
+ #define FORWARD_WM_SYSCOMMAND(h, c, x, y, fn) __CRACK_VOID_F(fn,(h, WM_SYSCOMMAND, (WPARAM)c, MAKELPARAM(x, y)))
+
+ #define HANDLE_WM_CLOSE(h, w, l, fn) __CRACK_ZERO_F(fn,(h));
+ #define HANDLE_WM_COMMAND(h, w, l, fn) __CRACK_ZERO_F(fn,(h, SEXT_LOWORD(w), (HWND)l, HIWORD(w)))
+ #define HANDLE_WM_CREATE(h, w, l, fn) (LRESULT)((fn(h, (CREATESTRUCT )l)) ? 0 : -1)
+ #define HANDLE_WM_DESTROY(h, w, l, fn) __CRACK_ZERO_F(fn,(h))
+ #define HANDLE_WM_ENABLE(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (BOOL)w))
+ #define HANDLE_WM_INITDIALOG(h, w, l, fn) __CRACK_LONG_F(fn,(h, (HWND)w, l))
+ #define HANDLE_WM_MDICASCADE(h, w, l, fn) __CRACK_LONG_F(fn, (h, (UINT)w)
+ #define HANDLE_WM_MDIDESTROY(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (HWND)w))
+ #define HANDLE_WM_MDIGETACTIVE(h, w, l, fn) __CRACK_LONG_F(fn,(h))
+ #define HANDLE_WM_MDIICONARRANGE(h, w, l, fn) __CRACK_ZERO_F(fn,(h))
+ #define HANDLE_WM_MDISETMENU(h, w, l, fn) __CRACK_LONG_F(fn,(h, (BOOL)w, (HMENU)w, (HMENU)l)
+ #define HANDLE_WM_MDITILE(h, w, l, fn) __CRACK_LONG_F(fn,(h, (UINT)w))
+ #define HANDLE_WM_PAINT(h, w, l, fn) __CRACK_ZERO_F(fn,(h))
+ #define HANDLE_WM_QUERYENDSESSION(h, w, l, fn) MAKELRESULT(fn(h), 0)
+ #define HANDLE_WM_SIZE(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (UINT)w, SEXT_LOWORD(l), SEXT_HIWORD(l)))
+ #define HANDLE_WM_SYSCOMMAND(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (UINT)w, SEXT_LOWORD(l), SEXT_HIWORD(l)))
+ }
+ { Totally disgusting! get wParam and lParam from the environment ! }
+ { Not convertable by H2PAS
+ #define HANDLE_MSG(h, message, fn) case message: return HANDLE_##message(h, wParam, lParam, fn)
+ }
+ { END OF windowsx.h stuff from old headers }
+ { ------------------------------------------------------------------ }
+ { BEGINNING of shellapi.h stuff from old headers }
+
+ const
+ SE_ERR_SHARE = 26;
+ SE_ERR_ASSOCINCOMPLETE = 27;
+ SE_ERR_DDETIMEOUT = 28;
+ SE_ERR_DDEFAIL = 29;
+ SE_ERR_DDEBUSY = 30;
+ SE_ERR_NOASSOC = 31;
+ { END OF shellapi.h stuff from old headers }
+ { ------------------------------------------------------------------ }
+ { From ddeml.h in old Cygnus headers }
+ XCLASS_BOOL = $1000;
+ XCLASS_DATA = $2000;
+ XCLASS_FLAGS = $4000;
+ XCLASS_MASK = $fc00;
+ XCLASS_NOTIFICATION = $8000;
+ XTYPF_NOBLOCK = $0002;
+ XTYP_ADVDATA = $4010;
+ XTYP_ADVREQ = $2022;
+ XTYP_ADVSTART = $1030;
+ XTYP_ADVSTOP = $8040;
+ XTYP_CONNECT = $1062;
+ XTYP_CONNECT_CONFIRM = $8072;
+ XTYP_DISCONNECT = $80c2;
+ XTYP_EXECUTE = $4050;
+ XTYP_POKE = $4090;
+ XTYP_REQUEST = $20b0;
+ XTYP_WILDCONNECT = $20E2;
+ XTYP_REGISTER = $80A2;
+ XTYP_ERROR = $8002;
+ XTYP_XACT_COMPLETE = $8080;
+ XTYP_UNREGISTER = $80D2;
+ DMLERR_DLL_USAGE = $4004;
+ DMLERR_INVALIDPARAMETER = $4006;
+ DMLERR_NOTPROCESSED = $4009;
+ DMLERR_POSTMSG_FAILED = $400c;
+ DMLERR_SERVER_DIED = $400e;
+ DMLERR_SYS_ERROR = $400f;
+ DMLERR_BUSY = $4001;
+ DMLERR_DATAACKTIMEOUT = $4002;
+ DMLERR_ADVACKTIMEOUT = $4000;
+ DMLERR_DLL_NOT_INITIALIZED = $4003;
+ DMLERR_LOW_MEMORY = $4007;
+ DMLERR_MEMORY_ERROR = $4008;
+ DMLERR_POKEACKTIMEOUT = $400b;
+ DMLERR_NO_CONV_ESTABLISHED = $400a;
+ DMLERR_REENTRANCY = $400d;
+ DMLERR_UNFOUND_QUEUE_ID = $4011;
+ DMLERR_UNADVACKTIMEOUT = $4010;
+ DMLERR_EXECACKTIMEOUT = $4005;
+ DDE_FACK = $8000;
+ DDE_FNOTPROCESSED = $0000;
+ DNS_REGISTER = $0001;
+ DNS_UNREGISTER = $0002;
+ CP_WINANSI = 1004;
+ CP_WINUNICODE = 1200;
+ { Not convertable by H2PAS
+ #define EXPENTRY CALLBACK
+ }
+ APPCLASS_STANDARD = $00000000;
+ { End of stuff from ddeml.h in old Cygnus headers }
+ { ----------------------------------------------- }
+ BKMODE_LAST = 2;
+ CTLCOLOR_MSGBOX = 0;
+ CTLCOLOR_EDIT = 1;
+ CTLCOLOR_LISTBOX = 2;
+ CTLCOLOR_BTN = 3;
+ CTLCOLOR_DLG = 4;
+ CTLCOLOR_SCROLLBAR = 5;
+ CTLCOLOR_STATIC = 6;
+ CTLCOLOR_MAX = 7;
+ META_SETMAPMODE = $0103;
+ META_SETWINDOWORG = $020B;
+ META_SETWINDOWEXT = $020C;
+ POLYFILL_LAST = 2;
+ STATUS_WAIT_0 = $00000000;
+ STATUS_ABANDONED_WAIT_0 = $00000080;
+ STATUS_USER_APC = $000000C0;
+ STATUS_TIMEOUT = $00000102;
+ STATUS_PENDING = $00000103;
+ STATUS_GUARD_PAGE_VIOLATION = $80000001;
+ STATUS_DATATYPE_MISALIGNMENT = $80000002;
+ STATUS_BREAKPOINT = $80000003;
+ STATUS_SINGLE_STEP = $80000004;
+ STATUS_IN_PAGE_ERROR = $C0000006;
+ STATUS_INVALID_HANDLE = $C0000008;
+ STATUS_ILLEGAL_INSTRUCTION = $C000001D;
+ STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
+ STATUS_INVALID_DISPOSITION = $C0000026;
+ STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C;
+ STATUS_FLOAT_DENORMAL_OPERAND = $C000008D;
+ STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E;
+ STATUS_FLOAT_INEXACT_RESULT = $C000008F;
+ STATUS_FLOAT_INVALID_OPERATION = $C0000090;
+ STATUS_FLOAT_OVERFLOW = $C0000091;
+ STATUS_FLOAT_STACK_CHECK = $C0000092;
+ STATUS_FLOAT_UNDERFLOW = $C0000093;
+ STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094;
+ STATUS_INTEGER_OVERFLOW = $C0000095;
+ STATUS_PRIVILEGED_INSTRUCTION = $C0000096;
+ STATUS_STACK_OVERFLOW = $C00000FD;
+ STATUS_CONTROL_C_EXIT = $C000013A;
+{$define EXCEPTION_CTRL_C}
+ PROCESSOR_ARCHITECTURE_INTEL = 0;
+ PROCESSOR_ARCHITECTURE_MIPS = 1;
+ PROCESSOR_ARCHITECTURE_ALPHA = 2;
+ PROCESSOR_ARCHITECTURE_PPC = 3;
+ { was #define dname(params) def_expr }
+ function FreeModule(h:HINST):WINBOOL;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function MakeProcInstance(p,i : longint) : longint;
+ { return type might be wrong }
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function FreeProcInstance(p : longint) : longint;
+ { return type might be wrong }
+
+
+ const
+ { _fmemcpy = memcpy; these are functions }
+ { Used by wxwindows. }
+ SIZEFULLSCREEN = SIZE_MAXIMIZED;
+ SIZENORMAL = SIZE_RESTORED;
+ SIZEICONIC = SIZE_MINIMIZED;
+ { NPLOGPALETTE = PLOGPALETTE; probably a type }
+ { In the old winnt.h }
+ (* Not convertable by H2PAS anyhow with if 0
+ #if 0
+ #ifdef __ANAL__
+ #define DECLARE_HANDLE(h) struct h##__ { int dummy; }; typedef struct h##__ h
+ #else
+ #define DECLARE_HANDLE(h) typedef void h
+ #endif
+ DECLARE_HANDLE(HANDLE);
+ #endif
+ *)
+{$ifdef __PPC__}
+
+ const
+ CONTEXT_CONTROL = 1;
+ CONTEXT_FLOATING_POINT = 2;
+ CONTEXT_INTEGER = 4;
+ CONTEXT_DEBUG_REGISTERS = 8;
+ CONTEXT_FULL = (CONTEXT_CONTROL or CONTEXT_FLOATING_POINT) or CONTEXT_INTEGER;
+ CONTEXT_DEBUGGER = CONTEXT_FULL;
+{$else}
+ { x86 }
+ { The doc refered me to winnt.h, so I had to look... }
+
+ const
+ SIZE_OF_80387_REGISTERS = 80;
+ { Values for contextflags }
+ CONTEXT_i386 = $10000;
+ CONTEXT_CONTROL = CONTEXT_i386 or 1;
+ CONTEXT_INTEGER = CONTEXT_i386 or 2;
+ CONTEXT_SEGMENTS = CONTEXT_i386 or 4;
+ CONTEXT_FLOATING_POINT = CONTEXT_i386 or 8;
+ CONTEXT_DEBUG_REGISTERS = CONTEXT_i386 or $10;
+ CONTEXT_FULL = (CONTEXT_CONTROL or CONTEXT_INTEGER) or CONTEXT_SEGMENTS;
+ { our own invention }
+ FLAG_TRACE_BIT = $100;
+ CONTEXT_DEBUGGER = CONTEXT_FULL or CONTEXT_FLOATING_POINT;
+{$endif}
+
+ const
+ { ASCIICHAR = AsciiChar; this is the kind of thing that can
+ make problems for FPC !! }
+ { ignored in H2PAS
+ #define FAR
+ handled in H2PAS
+ #define PACKED __attribute__((packed))
+ }
+ FILTER_TEMP_DUPLICATE_ACCOUNT = $0001;
+ FILTER_NORMAL_ACCOUNT = $0002;
+ FILTER_INTERDOMAIN_TRUST_ACCOUNT = $0008;
+ FILTER_WORKSTATION_TRUST_ACCOUNT = $0010;
+ FILTER_SERVER_TRUST_ACCOUNT = $0020;
+ LOGON32_LOGON_INTERACTIVE = $02;
+ LOGON32_LOGON_BATCH = $04;
+ LOGON32_LOGON_SERVICE = $05;
+ LOGON32_PROVIDER_DEFAULT = $00;
+ LOGON32_PROVIDER_WINNT35 = $01;
+ QID_SYNC = $FFFFFFFF;
+ { Magic numbers in PE executable header. }
+ { e_magic field }
+ IMAGE_DOS_SIGNATURE = $5a4d;
+ { nt_signature field }
+ IMAGE_NT_SIGNATURE = $4550;
+
+
+ { Severity values }
+ SEVERITY_SUCCESS = 0;
+ SEVERITY_ERROR = 1;
+
+ { Variant type codes (wtypes.h).
+ Some, not all though }
+ VT_EMPTY = 0;
+ VT_NULL = 1;
+ VT_I2 = 2;
+ VT_I4 = 3;
+ VT_R4 = 4;
+ VT_R8 = 5;
+ VT_BSTR = 8;
+ VT_ERROR = 10;
+ VT_BOOL = 11;
+ VT_UI1 = 17;
+ VT_BYREF = $4000;
+ VT_RESERVED = $8000;
+
+{ Define the facility codes }
+
+const
+ FACILITY_WINDOWS = 8;
+ FACILITY_STORAGE = 3;
+ FACILITY_RPC = 1;
+ FACILITY_SSPI = 9;
+ FACILITY_WIN32 = 7;
+ FACILITY_CONTROL = 10;
+ FACILITY_NULL = 0;
+ FACILITY_INTERNET = 12;
+ FACILITY_ITF = 4;
+ FACILITY_DISPATCH = 2;
+ FACILITY_CERT = 11;
+
+{ Manually added, bug 2672}
+ ICON_SMALL = 0;
+ ICON_BIG = 1;
+
+ // For the TRackMouseEvent
+ TME_HOVER = $00000001;
+ TME_LEAVE = $00000002;
+ TME_QUERY = $40000000;
+ TME_CANCEL = DWORD($80000000);
+ HOVER_DEFAULT = DWORD($FFFFFFFF);
+
+// Manually added, bug 3270
+ COLOR_HOTLIGHT = 26;
+ COLOR_GRADIENTACTIVECAPTION = 27;
+ COLOR_GRADIENTINACTIVECAPTION = 28;
+ COLOR_MENUHILIGHT = 29;
+ COLOR_MENUBAR = 30;
+
+ WM_APP = $8000;
+
+
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+ { was #define dname def_expr }
+ function UNICODE_NULL : WCHAR;
+ begin
+ UNICODE_NULL:=#0;
+ end;
+
+ { was #define dname def_expr }
+ function RT_ACCELERATOR : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_ACCELERATOR:=MAKEINTRESOURCE(9);
+ end;
+
+ { was #define dname def_expr }
+ function RT_BITMAP : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_BITMAP:=MAKEINTRESOURCE(2);
+ end;
+
+ { was #define dname def_expr }
+ function RT_DIALOG : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_DIALOG:=MAKEINTRESOURCE(5);
+ end;
+
+ { was #define dname def_expr }
+ function RT_FONT : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_FONT:=MAKEINTRESOURCE(8);
+ end;
+
+ { was #define dname def_expr }
+ function RT_FONTDIR : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_FONTDIR:=MAKEINTRESOURCE(7);
+ end;
+
+ { was #define dname def_expr }
+ function RT_MENU : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_MENU:=MAKEINTRESOURCE(4);
+ end;
+
+ { was #define dname def_expr }
+ function RT_RCDATA : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_RCDATA:=MAKEINTRESOURCE(10);
+ end;
+
+ { was #define dname def_expr }
+ function RT_STRING : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_STRING:=MAKEINTRESOURCE(6);
+ end;
+
+ { was #define dname def_expr }
+ function RT_MESSAGETABLE : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_MESSAGETABLE:=MAKEINTRESOURCE(11);
+ end;
+
+ { was #define dname def_expr }
+ function RT_CURSOR : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_CURSOR:=MAKEINTRESOURCE(1);
+ end;
+
+ { was #define dname def_expr }
+ function RT_GROUP_CURSOR : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_GROUP_CURSOR:=MAKEINTRESOURCE(12);
+ end;
+
+ { was #define dname def_expr }
+ function RT_ICON : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_ICON:=MAKEINTRESOURCE(3);
+ end;
+
+ { was #define dname def_expr }
+ function RT_GROUP_ICON : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_GROUP_ICON:=MAKEINTRESOURCE(13);
+ end;
+
+ { was #define dname def_expr }
+ function RT_VERSION : LPTSTR;
+ { return type might be wrong }
+ begin
+ RT_VERSION:=MAKEINTRESOURCE(16);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_ARROW : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_ARROW:=MAKEINTRESOURCE(32512);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_IBEAM : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_IBEAM:=MAKEINTRESOURCE(32513);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_WAIT : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_WAIT:=MAKEINTRESOURCE(32514);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_CROSS : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_CROSS:=MAKEINTRESOURCE(32515);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_UPARROW : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_UPARROW:=MAKEINTRESOURCE(32516);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_SIZENWSE : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_SIZENWSE:=MAKEINTRESOURCE(32642);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_SIZENESW : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_SIZENESW:=MAKEINTRESOURCE(32643);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_SIZEWE : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_SIZEWE:=MAKEINTRESOURCE(32644);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_SIZENS : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_SIZENS:=MAKEINTRESOURCE(32645);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_SIZEALL : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_SIZEALL:=MAKEINTRESOURCE(32646);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_NO : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_NO:=MAKEINTRESOURCE(32648);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_APPSTARTING : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_APPSTARTING:=MAKEINTRESOURCE(32650);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_HELP : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_HELP:=MAKEINTRESOURCE(32651);
+ end;
+
+ { was #define dname def_expr }
+ function IDI_APPLICATION : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDI_APPLICATION:=MAKEINTRESOURCE(32512);
+ end;
+
+ { was #define dname def_expr }
+ function IDI_HAND : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDI_HAND:=MAKEINTRESOURCE(32513);
+ end;
+
+ { was #define dname def_expr }
+ function IDI_QUESTION : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDI_QUESTION:=MAKEINTRESOURCE(32514);
+ end;
+
+ { was #define dname def_expr }
+ function IDI_EXCLAMATION : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDI_EXCLAMATION:=MAKEINTRESOURCE(32515);
+ end;
+
+ { was #define dname def_expr }
+ function IDI_ASTERISK : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDI_ASTERISK:=MAKEINTRESOURCE(32516);
+ end;
+
+ { was #define dname def_expr }
+ function IDI_WINLOGO : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDI_WINLOGO:=MAKEINTRESOURCE(32517);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_SIZE : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_SIZE:=MAKEINTRESOURCE(32640);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_ICON : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_ICON:=MAKEINTRESOURCE(32641);
+ end;
+
+ { was #define dname def_expr }
+ function IDC_HAND : LPTSTR;
+ { return type might be wrong }
+ begin
+ IDC_HAND:=MAKEINTRESOURCE(32649);
+ end;
+
+ { was #define dname def_expr }
+ function STD_INPUT_HANDLE : DWORD;
+ begin
+ STD_INPUT_HANDLE:=DWORD(-(10));
+ end;
+
+ { was #define dname def_expr }
+ function STD_OUTPUT_HANDLE : DWORD;
+ begin
+ STD_OUTPUT_HANDLE:=DWORD(-(11));
+ end;
+
+ { was #define dname def_expr }
+ function STD_ERROR_HANDLE : DWORD;
+ begin
+ STD_ERROR_HANDLE:=DWORD(-(12));
+ end;
+
+ { was #define dname def_expr }
+{
+ function INVALID_HANDLE_VALUE : HANDLE;
+ begin
+ INVALID_HANDLE_VALUE:=HANDLE(-(1));
+ end;
+}
+
+ { was #define dname def_expr }
+ function HWND_BROADCAST : HWND;
+ begin
+ HWND_BROADCAST:=HWND($FFFF);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_CLASSES_ROOT : HKEY;
+ begin
+ HKEY_CLASSES_ROOT:=HKEY($80000000);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_CURRENT_USER : HKEY;
+ begin
+ HKEY_CURRENT_USER:=HKEY($80000001);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_LOCAL_MACHINE : HKEY;
+ begin
+ HKEY_LOCAL_MACHINE:=HKEY($80000002);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_USERS : HKEY;
+ begin
+ HKEY_USERS:=HKEY($80000003);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_PERFORMANCE_DATA : HKEY;
+ begin
+ HKEY_PERFORMANCE_DATA:=HKEY($80000004);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_CURRENT_CONFIG : HKEY;
+ begin
+ HKEY_CURRENT_CONFIG:=HKEY($80000005);
+ end;
+
+ { was #define dname def_expr }
+ function HKEY_DYN_DATA : HKEY;
+ begin
+ HKEY_DYN_DATA:=HKEY($80000006);
+ end;
+
+ { was #define dname def_expr }
+ function HWND_BOTTOM : HWND;
+ begin
+ HWND_BOTTOM:=HWND(1);
+ end;
+
+ { was #define dname def_expr }
+ function HWND_NOTOPMOST : HWND;
+ begin
+ HWND_NOTOPMOST:=HWND(-(2));
+ end;
+
+ { was #define dname def_expr }
+ function HWND_TOP : HWND;
+ begin
+ HWND_TOP:=HWND(0);
+ end;
+
+ { was #define dname def_expr }
+ function HWND_TOPMOST : HWND;
+ begin
+ HWND_TOPMOST:=HWND(-(1));
+ end;
+
+ { was #define dname def_expr }
+ function VS_FILE_INFO : LPTSTR;
+ { return type might be wrong }
+ begin
+ VS_FILE_INFO:=MAKEINTRESOURCE(16);
+ end;
+
+ { was #define dname def_expr }
+ function HINST_COMMCTRL : HINST;
+ begin
+ HINST_COMMCTRL:=HINST(-(1));
+ end;
+
+ { was #define dname def_expr }
+ function LPSTR_TEXTCALLBACKW : LPWSTR;
+ begin
+ LPSTR_TEXTCALLBACKW:=LPWSTR(-(1));
+ end;
+
+ { was #define dname def_expr }
+ function LPSTR_TEXTCALLBACKA : LPSTR;
+ begin
+ LPSTR_TEXTCALLBACKA:=LPSTR(-(1));
+ end;
+{$ifdef UNICODE}
+
+ {const this is a function in fact !!
+ LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKW;}
+ function LPSTR_TEXTCALLBACK : LPWSTR;
+ begin
+ LPSTR_TEXTCALLBACK:=LPWSTR(-(1));
+ end;
+
+{$else}
+
+ {const
+ LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKA; }
+ function LPSTR_TEXTCALLBACK : LPSTR;
+ begin
+ LPSTR_TEXTCALLBACK:=LPSTR(-(1));
+ end;
+{$endif}
+
+ { was #define dname def_expr }
+ function TVI_ROOT : HTREEITEM;
+ begin
+ TVI_ROOT:=HTREEITEM($FFFF0000);
+ end;
+
+ { was #define dname def_expr }
+ function TVI_FIRST : HTREEITEM;
+ begin
+ TVI_FIRST:=HTREEITEM($FFFF0001);
+ end;
+
+ { was #define dname def_expr }
+ function TVI_LAST : HTREEITEM;
+ begin
+ TVI_LAST:=HTREEITEM($FFFF0002);
+ end;
+
+ { was #define dname def_expr }
+ function TVI_SORT : HTREEITEM;
+ begin
+ TVI_SORT:=HTREEITEM($FFFF0003);
+ end;
+
+ { was #define dname def_expr }
+ function HWND_DESKTOP : HWND;
+ begin
+ HWND_DESKTOP:=HWND(0);
+ end;
+
+ { was #define dname(params) def_expr }
+ function GetFirstChild(h:HWND):HWND;
+ begin
+ GetFirstChild:=GetTopWindow(h);
+ end;
+
+ { was #define dname(params) def_expr }
+ function GetNextSibling(h:HWND):HWND;
+ begin
+ GetNextSibling:=GetWindow(h,GW_HWNDNEXT);
+ end;
+
+ { was #define dname(params) def_expr }
+ function GetWindowID(h:HWND):longint;
+ begin
+ GetWindowID:=GetDlgCtrlID(h);
+ end;
+
+ { was #define dname(params) def_expr }
+ function SubclassWindow(h:HWND; p:LONG):LONG;
+ begin
+ SubclassWindow:=SetWindowLong(h,GWL_WNDPROC,p);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_COMMAND_CMD(w,l : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_COMMAND_CMD:=HIWORD(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_COMMAND_ID(w,l : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_COMMAND_ID:=LOWORD(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_CTLCOLOR_HDC(w,l,msg : longint) : HDC;
+ begin
+ GET_WM_CTLCOLOR_HDC:=HDC(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_CTLCOLOR_HWND(w,l,msg : longint) : HWND;
+ begin
+ GET_WM_CTLCOLOR_HWND:=HWND(l);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_HSCROLL_CODE(w,l : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_HSCROLL_CODE:=LOWORD(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_HSCROLL_HWND(w,l : longint) : HWND;
+ begin
+ GET_WM_HSCROLL_HWND:=HWND(l);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_HSCROLL_POS(w,l : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_HSCROLL_POS:=HIWORD(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_MDIACTIVATE_FACTIVATE(h,a,b : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_MDIACTIVATE_FACTIVATE:=longint(b = LONG(h));
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_MDIACTIVATE_HWNDACTIVATE(a,b : longint) : HWND;
+ begin
+ GET_WM_MDIACTIVATE_HWNDACTIVATE:=HWND(b);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_MDIACTIVATE_HWNDDEACT(a,b : longint) : HWND;
+ begin
+ GET_WM_MDIACTIVATE_HWNDDEACT:=HWND(a);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_VSCROLL_CODE(w,l : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_VSCROLL_CODE:=LOWORD(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ function GET_WM_VSCROLL_HWND(w,l : longint) : HWND;
+ begin
+ GET_WM_VSCROLL_HWND:=HWND(l);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function GET_WM_VSCROLL_POS(w,l : longint) : longint;
+ { return type might be wrong }
+ begin
+ GET_WM_VSCROLL_POS:=HIWORD(w);
+ end;
+
+ { was #define dname(params) def_expr }
+ function FreeModule(h:HINST):WINBOOL;
+ begin
+ FreeModule:=FreeLibrary(h);
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function MakeProcInstance(p,i : longint) : longint;
+ { return type might be wrong }
+ begin
+ MakeProcInstance:=p;
+ end;
+
+ { was #define dname(params) def_expr }
+ { argument types are unknown }
+ { return type might be wrong }
+ function FreeProcInstance(p : longint) : longint;
+ { return type might be wrong }
+ begin
+ FreeProcInstance:=p;
+ end;
+
+{$endif read_implementation}
+
+{
+ $Log: defines.inc,v $
+ Revision 1.21 2005/03/12 13:55:07 florian
+ + IDC_HAND
+
+ Revision 1.20 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/errors.inc b/rtl/win32/wininc/errors.inc
new file mode 100644
index 0000000000..c407ee122b
--- /dev/null
+++ b/rtl/win32/wininc/errors.inc
@@ -0,0 +1,1172 @@
+{
+ $Id: errors.inc,v 1.6 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the error code definition for the Win32 API
+
+ Copyright (c) 1999-2001 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+
+ Errors.h
+
+
+ Windows32 API error codes
+
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+
+ Author: Scott Christley <scottc@net-community.com>
+
+
+ This file is part of the Windows32 API Library.
+
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+ const
+ LZERROR_UNKNOWNALG = -(8);
+ LZERROR_BADVALUE = -(7);
+ LZERROR_GLOBLOCK = -(6);
+ LZERROR_GLOBALLOC = -(5);
+ LZERROR_WRITE = -(4);
+ LZERROR_READ = -(3);
+ LZERROR_BADOUTHANDLE = -(2);
+ LZERROR_BADINHANDLE = -(1);
+ NO_ERROR = 0;
+ ERROR_SUCCESS = 0;
+ ERROR_INVALID_FUNCTION = 1;
+ ERROR_FILE_NOT_FOUND = 2;
+ ERROR_PATH_NOT_FOUND = 3;
+ ERROR_TOO_MANY_OPEN_FILES = 4;
+ ERROR_ACCESS_DENIED = 5;
+ ERROR_INVALID_HANDLE = 6;
+ ERROR_ARENA_TRASHED = 7;
+ ERROR_NOT_ENOUGH_MEMORY = 8;
+ ERROR_INVALID_BLOCK = 9;
+ ERROR_BAD_ENVIRONMENT = 10;
+ ERROR_BAD_FORMAT = 11;
+ ERROR_INVALID_ACCESS = 12;
+ ERROR_INVALID_DATA = 13;
+ ERROR_OUTOFMEMORY = 14;
+ ERROR_INVALID_DRIVE = 15;
+ ERROR_CURRENT_DIRECTORY = 16;
+ ERROR_NOT_SAME_DEVICE = 17;
+ ERROR_NO_MORE_FILES = 18;
+ ERROR_WRITE_PROTECT = 19;
+ ERROR_BAD_UNIT = 20;
+ ERROR_NOT_READY = 21;
+ ERROR_BAD_COMMAND = 22;
+ ERROR_CRC = 23;
+ ERROR_BAD_LENGTH = 24;
+ ERROR_SEEK = 25;
+ ERROR_NOT_DOS_DISK = 26;
+ ERROR_SECTOR_NOT_FOUND = 27;
+ ERROR_OUT_OF_PAPER = 28;
+ ERROR_WRITE_FAULT = 29;
+ ERROR_READ_FAULT = 30;
+ ERROR_GEN_FAILURE = 31;
+ ERROR_SHARING_VIOLATION = 32;
+ ERROR_LOCK_VIOLATION = 33;
+ ERROR_WRONG_DISK = 34;
+ ERROR_SHARING_BUFFER_EXCEEDED = 36;
+ ERROR_HANDLE_EOF = 38;
+ ERROR_HANDLE_DISK_FULL = 39;
+ ERROR_NOT_SUPPORTED = 50;
+ ERROR_REM_NOT_LIST = 51;
+ ERROR_DUP_NAME = 52;
+ ERROR_BAD_NETPATH = 53;
+ ERROR_NETWORK_BUSY = 54;
+ ERROR_DEV_NOT_EXIST = 55;
+ ERROR_TOO_MANY_CMDS = 56;
+ ERROR_ADAP_HDW_ERR = 57;
+ ERROR_BAD_NET_RESP = 58;
+ ERROR_UNEXP_NET_ERR = 59;
+ ERROR_BAD_REM_ADAP = 60;
+ ERROR_PRINTQ_FULL = 61;
+ ERROR_NO_SPOOL_SPACE = 62;
+ ERROR_PRINT_CANCELLED = 63;
+ ERROR_NETNAME_DELETED = 64;
+ ERROR_NETWORK_ACCESS_DENIED = 65;
+ ERROR_BAD_DEV_TYPE = 66;
+ ERROR_BAD_NET_NAME = 67;
+ ERROR_TOO_MANY_NAMES = 68;
+ ERROR_TOO_MANY_SESS = 69;
+ ERROR_SHARING_PAUSED = 70;
+ ERROR_REQ_NOT_ACCEP = 71;
+ ERROR_REDIR_PAUSED = 72;
+ ERROR_FILE_EXISTS = 80;
+ ERROR_CANNOT_MAKE = 82;
+ ERROR_FAIL_I24 = 83;
+ ERROR_OUT_OF_STRUCTURES = 84;
+ ERROR_ALREADY_ASSIGNED = 85;
+ ERROR_INVALID_PASSWORD = 86;
+ ERROR_INVALID_PARAMETER = 87;
+ ERROR_NET_WRITE_FAULT = 88;
+ ERROR_NO_PROC_SLOTS = 89;
+ ERROR_TOO_MANY_SEMAPHORES = 100;
+ ERROR_EXCL_SEM_ALREADY_OWNED = 101;
+ ERROR_SEM_IS_SET = 102;
+ ERROR_TOO_MANY_SEM_REQUESTS = 103;
+ ERROR_INVALID_AT_INTERRUPT_TIME = 104;
+ ERROR_SEM_OWNER_DIED = 105;
+ ERROR_SEM_USER_LIMIT = 106;
+ ERROR_DISK_CHANGE = 107;
+ ERROR_DRIVE_LOCKED = 108;
+ ERROR_BROKEN_PIPE = 109;
+ ERROR_OPEN_FAILED = 110;
+ ERROR_BUFFER_OVERFLOW = 111;
+ ERROR_DISK_FULL = 112;
+ ERROR_NO_MORE_SEARCH_HANDLES = 113;
+ ERROR_INVALID_TARGET_HANDLE = 114;
+ ERROR_INVALID_CATEGORY = 117;
+ ERROR_INVALID_VERIFY_SWITCH = 118;
+ ERROR_BAD_DRIVER_LEVEL = 119;
+ ERROR_CALL_NOT_IMPLEMENTED = 120;
+ ERROR_SEM_TIMEOUT = 121;
+ ERROR_INSUFFICIENT_BUFFER = 122;
+ ERROR_INVALID_NAME = 123;
+ ERROR_INVALID_LEVEL = 124;
+ ERROR_NO_VOLUME_LABEL = 125;
+ ERROR_MOD_NOT_FOUND = 126;
+ ERROR_PROC_NOT_FOUND = 127;
+ ERROR_WAIT_NO_CHILDREN = 128;
+ ERROR_CHILD_NOT_COMPLETE = 129;
+ ERROR_DIRECT_ACCESS_HANDLE = 130;
+ ERROR_NEGATIVE_SEEK = 131;
+ ERROR_SEEK_ON_DEVICE = 132;
+ ERROR_IS_JOIN_TARGET = 133;
+ ERROR_IS_JOINED = 134;
+ ERROR_IS_SUBSTED = 135;
+ ERROR_NOT_JOINED = 136;
+ ERROR_NOT_SUBSTED = 137;
+ ERROR_JOIN_TO_JOIN = 138;
+ ERROR_SUBST_TO_SUBST = 139;
+ ERROR_JOIN_TO_SUBST = 140;
+ ERROR_SUBST_TO_JOIN = 141;
+ ERROR_BUSY_DRIVE = 142;
+ ERROR_SAME_DRIVE = 143;
+ ERROR_DIR_NOT_ROOT = 144;
+ ERROR_DIR_NOT_EMPTY = 145;
+ ERROR_IS_SUBST_PATH = 146;
+ ERROR_IS_JOIN_PATH = 147;
+ ERROR_PATH_BUSY = 148;
+ ERROR_IS_SUBST_TARGET = 149;
+ ERROR_SYSTEM_TRACE = 150;
+ ERROR_INVALID_EVENT_COUNT = 151;
+ ERROR_TOO_MANY_MUXWAITERS = 152;
+ ERROR_INVALID_LIST_FORMAT = 153;
+ ERROR_LABEL_TOO_LONG = 154;
+ ERROR_TOO_MANY_TCBS = 155;
+ ERROR_SIGNAL_REFUSED = 156;
+ ERROR_DISCARDED = 157;
+ ERROR_NOT_LOCKED = 158;
+ ERROR_BAD_THREADID_ADDR = 159;
+ ERROR_BAD_ARGUMENTS = 160;
+ ERROR_BAD_PATHNAME = 161;
+ ERROR_SIGNAL_PENDING = 162;
+ ERROR_MAX_THRDS_REACHED = 164;
+ ERROR_LOCK_FAILED = 167;
+ ERROR_BUSY = 170;
+ ERROR_CANCEL_VIOLATION = 173;
+ ERROR_ATOMIC_LOCKS_NOT_SUPPORTED = 174;
+ ERROR_INVALID_SEGMENT_NUMBER = 180;
+ ERROR_INVALID_ORDINAL = 182;
+ ERROR_ALREADY_EXISTS = 183;
+ ERROR_INVALID_FLAG_NUMBER = 186;
+ ERROR_SEM_NOT_FOUND = 187;
+ ERROR_INVALID_STARTING_CODESEG = 188;
+ ERROR_INVALID_STACKSEG = 189;
+ ERROR_INVALID_MODULETYPE = 190;
+ ERROR_INVALID_EXE_SIGNATURE = 191;
+ ERROR_EXE_MARKED_INVALID = 192;
+ ERROR_BAD_EXE_FORMAT = 193;
+ ERROR_ITERATED_DATA_EXCEEDS_64k = 194;
+ ERROR_INVALID_MINALLOCSIZE = 195;
+ ERROR_DYNLINK_FROM_INVALID_RING = 196;
+ ERROR_IOPL_NOT_ENABLED = 197;
+ ERROR_INVALID_SEGDPL = 198;
+ ERROR_AUTODATASEG_EXCEEDS_64k = 199;
+ ERROR_RING2SEG_MUST_BE_MOVABLE = 200;
+ ERROR_RELOC_CHAIN_XEEDS_SEGLIM = 201;
+ ERROR_INFLOOP_IN_RELOC_CHAIN = 202;
+ ERROR_ENVVAR_NOT_FOUND = 203;
+ ERROR_NO_SIGNAL_SENT = 205;
+ ERROR_FILENAME_EXCED_RANGE = 206;
+ ERROR_RING2_STACK_IN_USE = 207;
+ ERROR_META_EXPANSION_TOO_LONG = 208;
+ ERROR_INVALID_SIGNAL_NUMBER = 209;
+ ERROR_THREAD_1_INACTIVE = 210;
+ ERROR_LOCKED = 212;
+ ERROR_TOO_MANY_MODULES = 214;
+ ERROR_NESTING_NOT_ALLOWED = 215;
+ ERROR_BAD_PIPE = 230;
+ ERROR_PIPE_BUSY = 231;
+ ERROR_NO_DATA = 232;
+ ERROR_PIPE_NOT_CONNECTED = 233;
+ ERROR_MORE_DATA = 234;
+ ERROR_VC_DISCONNECTED = 240;
+ ERROR_INVALID_EA_NAME = 254;
+ ERROR_EA_LIST_INCONSISTENT = 255;
+ ERROR_NO_MORE_ITEMS = 259;
+ ERROR_CANNOT_COPY = 266;
+ ERROR_DIRECTORY = 267;
+ ERROR_EAS_DIDNT_FIT = 275;
+ ERROR_EA_FILE_CORRUPT = 276;
+ ERROR_EA_TABLE_FULL = 277;
+ ERROR_INVALID_EA_HANDLE = 278;
+ ERROR_EAS_NOT_SUPPORTED = 282;
+ ERROR_NOT_OWNER = 288;
+ ERROR_TOO_MANY_POSTS = 298;
+ ERROR_PARTIAL_COPY = 299;
+ ERROR_MR_MID_NOT_FOUND = 317;
+ ERROR_INVALID_ADDRESS = 487;
+ ERROR_ARITHMETIC_OVERFLOW = 534;
+ ERROR_PIPE_CONNECTED = 535;
+ ERROR_PIPE_LISTENING = 536;
+ ERROR_EA_ACCESS_DENIED = 994;
+ ERROR_OPERATION_ABORTED = 995;
+ ERROR_IO_INCOMPLETE = 996;
+ ERROR_IO_PENDING = 997;
+ ERROR_NOACCESS = 998;
+ ERROR_SWAPERROR = 999;
+ ERROR_STACK_OVERFLOW = 1001;
+ ERROR_INVALID_MESSAGE = 1002;
+ ERROR_CAN_NOT_COMPLETE = 1003;
+ ERROR_INVALID_FLAGS = 1004;
+ ERROR_UNRECOGNIZED_VOLUME = 1005;
+ ERROR_FILE_INVALID = 1006;
+ ERROR_FULLSCREEN_MODE = 1007;
+ ERROR_NO_TOKEN = 1008;
+ ERROR_BADDB = 1009;
+ ERROR_BADKEY = 1010;
+ ERROR_CANTOPEN = 1011;
+ ERROR_CANTREAD = 1012;
+ ERROR_CANTWRITE = 1013;
+ ERROR_REGISTRY_RECOVERED = 1014;
+ ERROR_REGISTRY_CORRUPT = 1015;
+ ERROR_REGISTRY_IO_FAILED = 1016;
+ ERROR_NOT_REGISTRY_FILE = 1017;
+ ERROR_KEY_DELETED = 1018;
+ ERROR_NO_LOG_SPACE = 1019;
+ ERROR_KEY_HAS_CHILDREN = 1020;
+ ERROR_CHILD_MUST_BE_VOLATILE = 1021;
+ ERROR_NOTIFY_ENUM_DIR = 1022;
+ ERROR_DEPENDENT_SERVICES_RUNNING = 1051;
+ ERROR_INVALID_SERVICE_CONTROL = 1052;
+ ERROR_SERVICE_REQUEST_TIMEOUT = 1053;
+ ERROR_SERVICE_NO_THREAD = 1054;
+ ERROR_SERVICE_DATABASE_LOCKED = 1055;
+ ERROR_SERVICE_ALREADY_RUNNING = 1056;
+ ERROR_INVALID_SERVICE_ACCOUNT = 1057;
+ ERROR_SERVICE_DISABLED = 1058;
+ ERROR_CIRCULAR_DEPENDENCY = 1059;
+ ERROR_SERVICE_DOES_NOT_EXIST = 1060;
+ ERROR_SERVICE_CANNOT_ACCEPT_CTRL = 1061;
+ ERROR_SERVICE_NOT_ACTIVE = 1062;
+ ERROR_FAILED_SERVICE_CONTROLLER_CONNECT = 1063;
+ ERROR_EXCEPTION_IN_SERVICE = 1064;
+ ERROR_DATABASE_DOES_NOT_EXIST = 1065;
+ ERROR_SERVICE_SPECIFIC_ERROR = 1066;
+ ERROR_PROCESS_ABORTED = 1067;
+ ERROR_SERVICE_DEPENDENCY_FAIL = 1068;
+ ERROR_SERVICE_LOGON_FAILED = 1069;
+ ERROR_SERVICE_START_HANG = 1070;
+ ERROR_INVALID_SERVICE_LOCK = 1071;
+ ERROR_SERVICE_MARKED_FOR_DELETE = 1072;
+ ERROR_SERVICE_EXISTS = 1073;
+ ERROR_ALREADY_RUNNING_LKG = 1074;
+ ERROR_SERVICE_DEPENDENCY_DELETED = 1075;
+ ERROR_BOOT_ALREADY_ACCEPTED = 1076;
+ ERROR_SERVICE_NEVER_STARTED = 1077;
+ ERROR_DUPLICATE_SERVICE_NAME = 1078;
+ ERROR_END_OF_MEDIA = 1100;
+ ERROR_FILEMARK_DETECTED = 1101;
+ ERROR_BEGINNING_OF_MEDIA = 1102;
+ ERROR_SETMARK_DETECTED = 1103;
+ ERROR_NO_DATA_DETECTED = 1104;
+ ERROR_PARTITION_FAILURE = 1105;
+ ERROR_INVALID_BLOCK_LENGTH = 1106;
+ ERROR_DEVICE_NOT_PARTITIONED = 1107;
+ ERROR_UNABLE_TO_LOCK_MEDIA = 1108;
+ ERROR_UNABLE_TO_UNLOAD_MEDIA = 1109;
+ ERROR_MEDIA_CHANGED = 1110;
+ ERROR_BUS_RESET = 1111;
+ ERROR_NO_MEDIA_IN_DRIVE = 1112;
+ ERROR_NO_UNICODE_TRANSLATION = 1113;
+ ERROR_DLL_INIT_FAILED = 1114;
+ ERROR_SHUTDOWN_IN_PROGRESS = 1115;
+ ERROR_NO_SHUTDOWN_IN_PROGRESS = 1116;
+ ERROR_IO_DEVICE = 1117;
+ ERROR_SERIAL_NO_DEVICE = 1118;
+ ERROR_IRQ_BUSY = 1119;
+ ERROR_MORE_WRITES = 1120;
+ ERROR_COUNTER_TIMEOUT = 1121;
+ ERROR_FLOPPY_ID_MARK_NOT_FOUND = 1122;
+ ERROR_FLOPPY_WRONG_CYLINDER = 1123;
+ ERROR_FLOPPY_UNKNOWN_ERROR = 1124;
+ ERROR_FLOPPY_BAD_REGISTERS = 1125;
+ ERROR_DISK_RECALIBRATE_FAILED = 1126;
+ ERROR_DISK_OPERATION_FAILED = 1127;
+ ERROR_DISK_RESET_FAILED = 1128;
+ ERROR_EOM_OVERFLOW = 1129;
+ ERROR_NOT_ENOUGH_SERVER_MEMORY = 1130;
+ ERROR_POSSIBLE_DEADLOCK = 1131;
+ ERROR_MAPPED_ALIGNMENT = 1132;
+ ERROR_SET_POWER_STATE_VETOED = 1140;
+ ERROR_SET_POWER_STATE_FAILED = 1141;
+ ERROR_OLD_WIN_VERSION = 1150;
+ ERROR_APP_WRONG_OS = 1151;
+ ERROR_SINGLE_INSTANCE_APP = 1152;
+ ERROR_RMODE_APP = 1153;
+ ERROR_INVALID_DLL = 1154;
+ ERROR_NO_ASSOCIATION = 1155;
+ ERROR_DDE_FAIL = 1156;
+ ERROR_DLL_NOT_FOUND = 1157;
+ ERROR_BAD_USERNAME = 2202;
+ ERROR_NOT_CONNECTED = 2250;
+ ERROR_OPEN_FILES = 2401;
+ ERROR_ACTIVE_CONNECTIONS = 2402;
+ ERROR_DEVICE_IN_USE = 2404;
+ ERROR_BAD_DEVICE = 1200;
+ ERROR_CONNECTION_UNAVAIL = 1201;
+ ERROR_DEVICE_ALREADY_REMEMBERED = 1202;
+ ERROR_NO_NET_OR_BAD_PATH = 1203;
+ ERROR_BAD_PROVIDER = 1204;
+ ERROR_CANNOT_OPEN_PROFILE = 1205;
+ ERROR_BAD_PROFILE = 1206;
+ ERROR_NOT_CONTAINER = 1207;
+ ERROR_EXTENDED_ERROR = 1208;
+ ERROR_INVALID_GROUPNAME = 1209;
+ ERROR_INVALID_COMPUTERNAME = 1210;
+ ERROR_INVALID_EVENTNAME = 1211;
+ ERROR_INVALID_DOMAINNAME = 1212;
+ ERROR_INVALID_SERVICENAME = 1213;
+ ERROR_INVALID_NETNAME = 1214;
+ ERROR_INVALID_SHARENAME = 1215;
+ ERROR_INVALID_PASSWORDNAME = 1216;
+ ERROR_INVALID_MESSAGENAME = 1217;
+ ERROR_INVALID_MESSAGEDEST = 1218;
+ ERROR_SESSION_CREDENTIAL_CONFLICT = 1219;
+ ERROR_REMOTE_SESSION_LIMIT_EXCEEDED = 1220;
+ ERROR_DUP_DOMAINNAME = 1221;
+ ERROR_NO_NETWORK = 1222;
+ ERROR_CANCELLED = 1223;
+ ERROR_USER_MAPPED_FILE = 1224;
+ ERROR_CONNECTION_REFUSED = 1225;
+ ERROR_GRACEFUL_DISCONNECT = 1226;
+ ERROR_ADDRESS_ALREADY_ASSOCIATED = 1227;
+ ERROR_ADDRESS_NOT_ASSOCIATED = 1228;
+ ERROR_CONNECTION_INVALID = 1229;
+ ERROR_CONNECTION_ACTIVE = 1230;
+ ERROR_NETWORK_UNREACHABLE = 1231;
+ ERROR_HOST_UNREACHABLE = 1232;
+ ERROR_PROTOCOL_UNREACHABLE = 1233;
+ ERROR_PORT_UNREACHABLE = 1234;
+ ERROR_REQUEST_ABORTED = 1235;
+ ERROR_CONNECTION_ABORTED = 1236;
+ ERROR_RETRY = 1237;
+ ERROR_CONNECTION_COUNT_LIMIT = 1238;
+ ERROR_LOGIN_TIME_RESTRICTION = 1239;
+ ERROR_LOGIN_WKSTA_RESTRICTION = 1240;
+ ERROR_INCORRECT_ADDRESS = 1241;
+ ERROR_ALREADY_REGISTERED = 1242;
+ ERROR_SERVICE_NOT_FOUND = 1243;
+ ERROR_NOT_AUTHENTICATED = 1244;
+ ERROR_NOT_LOGGED_ON = 1245;
+ ERROR_CONTINUE = 1246;
+ ERROR_ALREADY_INITIALIZED = 1247;
+ ERROR_NO_MORE_DEVICES = 1248;
+ ERROR_NOT_ALL_ASSIGNED = 1300;
+ ERROR_SOME_NOT_MAPPED = 1301;
+ ERROR_NO_QUOTAS_FOR_ACCOUNT = 1302;
+ ERROR_LOCAL_USER_SESSION_KEY = 1303;
+ ERROR_NULL_LM_PASSWORD = 1304;
+ ERROR_UNKNOWN_REVISION = 1305;
+ ERROR_REVISION_MISMATCH = 1306;
+ ERROR_INVALID_OWNER = 1307;
+ ERROR_INVALID_PRIMARY_GROUP = 1308;
+ ERROR_NO_IMPERSONATION_TOKEN = 1309;
+ ERROR_CANT_DISABLE_MANDATORY = 1310;
+ ERROR_NO_LOGON_SERVERS = 1311;
+ ERROR_NO_SUCH_LOGON_SESSION = 1312;
+ ERROR_NO_SUCH_PRIVILEGE = 1313;
+ ERROR_PRIVILEGE_NOT_HELD = 1314;
+ ERROR_INVALID_ACCOUNT_NAME = 1315;
+ ERROR_USER_EXISTS = 1316;
+ ERROR_NO_SUCH_USER = 1317;
+ ERROR_GROUP_EXISTS = 1318;
+ ERROR_NO_SUCH_GROUP = 1319;
+ ERROR_MEMBER_IN_GROUP = 1320;
+ ERROR_MEMBER_NOT_IN_GROUP = 1321;
+ ERROR_LAST_ADMIN = 1322;
+ ERROR_WRONG_PASSWORD = 1323;
+ ERROR_ILL_FORMED_PASSWORD = 1324;
+ ERROR_PASSWORD_RESTRICTION = 1325;
+ ERROR_LOGON_FAILURE = 1326;
+ ERROR_ACCOUNT_RESTRICTION = 1327;
+ ERROR_INVALID_LOGON_HOURS = 1328;
+ ERROR_INVALID_WORKSTATION = 1329;
+ ERROR_PASSWORD_EXPIRED = 1330;
+ ERROR_ACCOUNT_DISABLED = 1331;
+ ERROR_NONE_MAPPED = 1332;
+ ERROR_TOO_MANY_LUIDS_REQUESTED = 1333;
+ ERROR_LUIDS_EXHAUSTED = 1334;
+ ERROR_INVALID_SUB_AUTHORITY = 1335;
+ ERROR_INVALID_ACL = 1336;
+ ERROR_INVALID_SID = 1337;
+ ERROR_INVALID_SECURITY_DESCR = 1338;
+ ERROR_BAD_INHERITANCE_ACL = 1340;
+ ERROR_SERVER_DISABLED = 1341;
+ ERROR_SERVER_NOT_DISABLED = 1342;
+ ERROR_INVALID_ID_AUTHORITY = 1343;
+ ERROR_ALLOTTED_SPACE_EXCEEDED = 1344;
+ ERROR_INVALID_GROUP_ATTRIBUTES = 1345;
+ ERROR_BAD_IMPERSONATION_LEVEL = 1346;
+ ERROR_CANT_OPEN_ANONYMOUS = 1347;
+ ERROR_BAD_VALIDATION_CLASS = 1348;
+ ERROR_BAD_TOKEN_TYPE = 1349;
+ ERROR_NO_SECURITY_ON_OBJECT = 1350;
+ ERROR_CANT_ACCESS_DOMAIN_INFO = 1351;
+ ERROR_INVALID_SERVER_STATE = 1352;
+ ERROR_INVALID_DOMAIN_STATE = 1353;
+ ERROR_INVALID_DOMAIN_ROLE = 1354;
+ ERROR_NO_SUCH_DOMAIN = 1355;
+ ERROR_DOMAIN_EXISTS = 1356;
+ ERROR_DOMAIN_LIMIT_EXCEEDED = 1357;
+ ERROR_INTERNAL_DB_CORRUPTION = 1358;
+ ERROR_INTERNAL_ERROR = 1359;
+ ERROR_GENERIC_NOT_MAPPED = 1360;
+ ERROR_BAD_DESCRIPTOR_FORMAT = 1361;
+ ERROR_NOT_LOGON_PROCESS = 1362;
+ ERROR_LOGON_SESSION_EXISTS = 1363;
+ ERROR_NO_SUCH_PACKAGE = 1364;
+ ERROR_BAD_LOGON_SESSION_STATE = 1365;
+ ERROR_LOGON_SESSION_COLLISION = 1366;
+ ERROR_INVALID_LOGON_TYPE = 1367;
+ ERROR_CANNOT_IMPERSONATE = 1368;
+ ERROR_RXACT_INVALID_STATE = 1369;
+ ERROR_RXACT_COMMIT_FAILURE = 1370;
+ ERROR_SPECIAL_ACCOUNT = 1371;
+ ERROR_SPECIAL_GROUP = 1372;
+ ERROR_SPECIAL_USER = 1373;
+ ERROR_MEMBERS_PRIMARY_GROUP = 1374;
+ ERROR_TOKEN_ALREADY_IN_USE = 1375;
+ ERROR_NO_SUCH_ALIAS = 1376;
+ ERROR_MEMBER_NOT_IN_ALIAS = 1377;
+ ERROR_MEMBER_IN_ALIAS = 1378;
+ ERROR_ALIAS_EXISTS = 1379;
+ ERROR_LOGON_NOT_GRANTED = 1380;
+ ERROR_TOO_MANY_SECRETS = 1381;
+ ERROR_SECRET_TOO_LONG = 1382;
+ ERROR_INTERNAL_DB_ERROR = 1383;
+ ERROR_TOO_MANY_CONTEXT_IDS = 1384;
+ ERROR_LOGON_TYPE_NOT_GRANTED = 1385;
+ ERROR_NT_CROSS_ENCRYPTION_REQUIRED = 1386;
+ ERROR_NO_SUCH_MEMBER = 1387;
+ ERROR_INVALID_MEMBER = 1388;
+ ERROR_TOO_MANY_SIDS = 1389;
+ ERROR_LM_CROSS_ENCRYPTION_REQUIRED = 1390;
+ ERROR_NO_INHERITANCE = 1391;
+ ERROR_FILE_CORRUPT = 1392;
+ ERROR_DISK_CORRUPT = 1393;
+ ERROR_NO_USER_SESSION_KEY = 1394;
+ ERROR_LICENSE_QUOTA_EXCEEDED = 1395;
+ ERROR_INVALID_WINDOW_HANDLE = 1400;
+ ERROR_INVALID_MENU_HANDLE = 1401;
+ ERROR_INVALID_CURSOR_HANDLE = 1402;
+ ERROR_INVALID_ACCEL_HANDLE = 1403;
+ ERROR_INVALID_HOOK_HANDLE = 1404;
+ ERROR_INVALID_DWP_HANDLE = 1405;
+ ERROR_TLW_WITH_WSCHILD = 1406;
+ ERROR_CANNOT_FIND_WND_CLASS = 1407;
+ ERROR_WINDOW_OF_OTHER_THREAD = 1408;
+ ERROR_HOTKEY_ALREADY_REGISTERED = 1409;
+ ERROR_CLASS_ALREADY_EXISTS = 1410;
+ ERROR_CLASS_DOES_NOT_EXIST = 1411;
+ ERROR_CLASS_HAS_WINDOWS = 1412;
+ ERROR_INVALID_INDEX = 1413;
+ ERROR_INVALID_ICON_HANDLE = 1414;
+ ERROR_PRIVATE_DIALOG_INDEX = 1415;
+ ERROR_LISTBOX_ID_NOT_FOUND = 1416;
+ ERROR_NO_WILDCARD_CHARACTERS = 1417;
+ ERROR_CLIPBOARD_NOT_OPEN = 1418;
+ ERROR_HOTKEY_NOT_REGISTERED = 1419;
+ ERROR_WINDOW_NOT_DIALOG = 1420;
+ ERROR_CONTROL_ID_NOT_FOUND = 1421;
+ ERROR_INVALID_COMBOBOX_MESSAGE = 1422;
+ ERROR_WINDOW_NOT_COMBOBOX = 1423;
+ ERROR_INVALID_EDIT_HEIGHT = 1424;
+ ERROR_DC_NOT_FOUND = 1425;
+ ERROR_INVALID_HOOK_FILTER = 1426;
+ ERROR_INVALID_FILTER_PROC = 1427;
+ ERROR_HOOK_NEEDS_HMOD = 1428;
+ ERROR_GLOBAL_ONLY_HOOK = 1429;
+ ERROR_JOURNAL_HOOK_SET = 1430;
+ ERROR_HOOK_NOT_INSTALLED = 1431;
+ ERROR_INVALID_LB_MESSAGE = 1432;
+ ERROR_SETCOUNT_ON_BAD_LB = 1433;
+ ERROR_LB_WITHOUT_TABSTOPS = 1434;
+ ERROR_DESTROY_OBJECT_OF_OTHER_THREAD = 1435;
+ ERROR_CHILD_WINDOW_MENU = 1436;
+ ERROR_NO_SYSTEM_MENU = 1437;
+ ERROR_INVALID_MSGBOX_STYLE = 1438;
+ ERROR_INVALID_SPI_VALUE = 1439;
+ ERROR_SCREEN_ALREADY_LOCKED = 1440;
+ ERROR_HWNDS_HAVE_DIFF_PARENT = 1441;
+ ERROR_NOT_CHILD_WINDOW = 1442;
+ ERROR_INVALID_GW_COMMAND = 1443;
+ ERROR_INVALID_THREAD_ID = 1444;
+ ERROR_NON_MDICHILD_WINDOW = 1445;
+ ERROR_POPUP_ALREADY_ACTIVE = 1446;
+ ERROR_NO_SCROLLBARS = 1447;
+ ERROR_INVALID_SCROLLBAR_RANGE = 1448;
+ ERROR_INVALID_SHOWWIN_COMMAND = 1449;
+ ERROR_NO_SYSTEM_RESOURCES = 1450;
+ ERROR_NONPAGED_SYSTEM_RESOURCES = 1451;
+ ERROR_PAGED_SYSTEM_RESOURCES = 1452;
+ ERROR_WORKING_SET_QUOTA = 1453;
+ ERROR_PAGEFILE_QUOTA = 1454;
+ ERROR_COMMITMENT_LIMIT = 1455;
+ ERROR_MENU_ITEM_NOT_FOUND = 1456;
+ ERROR_INVALID_KEYBOARD_HANDLE = 1457;
+ ERROR_HOOK_TYPE_NOT_ALLOWED = 1458;
+ ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION = 1459;
+ ERROR_TIMEOUT = 1460;
+ ERROR_EVENTLOG_FILE_CORRUPT = 1500;
+ ERROR_EVENTLOG_CANT_START = 1501;
+ ERROR_LOG_FILE_FULL = 1502;
+ ERROR_EVENTLOG_FILE_CHANGED = 1503;
+ RPC_S_INVALID_STRING_BINDING = 1700;
+ RPC_S_WRONG_KIND_OF_BINDING = 1701;
+ RPC_S_INVALID_BINDING = 1702;
+ RPC_S_PROTSEQ_NOT_SUPPORTED = 1703;
+ RPC_S_INVALID_RPC_PROTSEQ = 1704;
+ RPC_S_INVALID_STRING_UUID = 1705;
+ RPC_S_INVALID_ENDPOINT_FORMAT = 1706;
+ RPC_S_INVALID_NET_ADDR = 1707;
+ RPC_S_NO_ENDPOINT_FOUND = 1708;
+ RPC_S_INVALID_TIMEOUT = 1709;
+ RPC_S_OBJECT_NOT_FOUND = 1710;
+ RPC_S_ALREADY_REGISTERED = 1711;
+ RPC_S_TYPE_ALREADY_REGISTERED = 1712;
+ RPC_S_ALREADY_LISTENING = 1713;
+ RPC_S_NO_PROTSEQS_REGISTERED = 1714;
+ RPC_S_NOT_LISTENING = 1715;
+ RPC_S_UNKNOWN_MGR_TYPE = 1716;
+ RPC_S_UNKNOWN_IF = 1717;
+ RPC_S_NO_BINDINGS = 1718;
+ RPC_S_NO_PROTSEQS = 1719;
+ RPC_S_CANT_CREATE_ENDPOINT = 1720;
+ RPC_S_OUT_OF_RESOURCES = 1721;
+ RPC_S_SERVER_UNAVAILABLE = 1722;
+ RPC_S_SERVER_TOO_BUSY = 1723;
+ RPC_S_INVALID_NETWORK_OPTIONS = 1724;
+ RPC_S_NO_CALL_ACTIVE = 1725;
+ RPC_S_CALL_FAILED = 1726;
+ RPC_S_CALL_FAILED_DNE = 1727;
+ RPC_S_PROTOCOL_ERROR = 1728;
+ RPC_S_UNSUPPORTED_TRANS_SYN = 1730;
+ RPC_S_UNSUPPORTED_TYPE = 1732;
+ RPC_S_INVALID_TAG = 1733;
+ RPC_S_INVALID_BOUND = 1734;
+ RPC_S_NO_ENTRY_NAME = 1735;
+ RPC_S_INVALID_NAME_SYNTAX = 1736;
+ RPC_S_UNSUPPORTED_NAME_SYNTAX = 1737;
+ RPC_S_UUID_NO_ADDRESS = 1739;
+ RPC_S_DUPLICATE_ENDPOINT = 1740;
+ RPC_S_UNKNOWN_AUTHN_TYPE = 1741;
+ RPC_S_MAX_CALLS_TOO_SMALL = 1742;
+ RPC_S_STRING_TOO_LONG = 1743;
+ RPC_S_PROTSEQ_NOT_FOUND = 1744;
+ RPC_S_PROCNUM_OUT_OF_RANGE = 1745;
+ RPC_S_BINDING_HAS_NO_AUTH = 1746;
+ RPC_S_UNKNOWN_AUTHN_SERVICE = 1747;
+ RPC_S_UNKNOWN_AUTHN_LEVEL = 1748;
+ RPC_S_INVALID_AUTH_IDENTITY = 1749;
+ RPC_S_UNKNOWN_AUTHZ_SERVICE = 1750;
+ EPT_S_INVALID_ENTRY = 1751;
+ EPT_S_CANT_PERFORM_OP = 1752;
+ EPT_S_NOT_REGISTERED = 1753;
+ RPC_S_NOTHING_TO_EXPORT = 1754;
+ RPC_S_INCOMPLETE_NAME = 1755;
+ RPC_S_INVALID_VERS_OPTION = 1756;
+ RPC_S_NO_MORE_MEMBERS = 1757;
+ RPC_S_NOT_ALL_OBJS_UNEXPORTED = 1758;
+ RPC_S_INTERFACE_NOT_FOUND = 1759;
+ RPC_S_ENTRY_ALREADY_EXISTS = 1760;
+ RPC_S_ENTRY_NOT_FOUND = 1761;
+ RPC_S_NAME_SERVICE_UNAVAILABLE = 1762;
+ RPC_S_INVALID_NAF_ID = 1763;
+ RPC_S_CANNOT_SUPPORT = 1764;
+ RPC_S_NO_CONTEXT_AVAILABLE = 1765;
+ RPC_S_INTERNAL_ERROR = 1766;
+ RPC_S_ZERO_DIVIDE = 1767;
+ RPC_S_ADDRESS_ERROR = 1768;
+ RPC_S_FP_DIV_ZERO = 1769;
+ RPC_S_FP_UNDERFLOW = 1770;
+ RPC_S_FP_OVERFLOW = 1771;
+ RPC_X_NO_MORE_ENTRIES = 1772;
+ RPC_X_SS_CHAR_TRANS_OPEN_FAIL = 1773;
+ RPC_X_SS_CHAR_TRANS_SHORT_FILE = 1774;
+ RPC_X_SS_IN_NULL_CONTEXT = 1775;
+ RPC_X_SS_CONTEXT_DAMAGED = 1777;
+ RPC_X_SS_HANDLES_MISMATCH = 1778;
+ RPC_X_SS_CANNOT_GET_CALL_HANDLE = 1779;
+ RPC_X_NULL_REF_POINTER = 1780;
+ RPC_X_ENUM_VALUE_OUT_OF_RANGE = 1781;
+ RPC_X_BYTE_COUNT_TOO_SMALL = 1782;
+ RPC_X_BAD_STUB_DATA = 1783;
+ ERROR_INVALID_USER_BUFFER = 1784;
+ ERROR_UNRECOGNIZED_MEDIA = 1785;
+ ERROR_NO_TRUST_LSA_SECRET = 1786;
+ ERROR_NO_TRUST_SAM_ACCOUNT = 1787;
+ ERROR_TRUSTED_DOMAIN_FAILURE = 1788;
+ ERROR_TRUSTED_RELATIONSHIP_FAILURE = 1789;
+ ERROR_TRUST_FAILURE = 1790;
+ RPC_S_CALL_IN_PROGRESS = 1791;
+ ERROR_NETLOGON_NOT_STARTED = 1792;
+ ERROR_ACCOUNT_EXPIRED = 1793;
+ ERROR_REDIRECTOR_HAS_OPEN_HANDLES = 1794;
+ ERROR_PRINTER_DRIVER_ALREADY_INSTALLED = 1795;
+ ERROR_UNKNOWN_PORT = 1796;
+ ERROR_UNKNOWN_PRINTER_DRIVER = 1797;
+ ERROR_UNKNOWN_PRINTPROCESSOR = 1798;
+ ERROR_INVALID_SEPARATOR_FILE = 1799;
+ ERROR_INVALID_PRIORITY = 1800;
+ ERROR_INVALID_PRINTER_NAME = 1801;
+ ERROR_PRINTER_ALREADY_EXISTS = 1802;
+ ERROR_INVALID_PRINTER_COMMAND = 1803;
+ ERROR_INVALID_DATATYPE = 1804;
+ ERROR_INVALID_ENVIRONMENT = 1805;
+ RPC_S_NO_MORE_BINDINGS = 1806;
+ ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT = 1807;
+ ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT = 1808;
+ ERROR_NOLOGON_SERVER_TRUST_ACCOUNT = 1809;
+ ERROR_DOMAIN_TRUST_INCONSISTENT = 1810;
+ ERROR_SERVER_HAS_OPEN_HANDLES = 1811;
+ ERROR_RESOURCE_DATA_NOT_FOUND = 1812;
+ ERROR_RESOURCE_TYPE_NOT_FOUND = 1813;
+ ERROR_RESOURCE_NAME_NOT_FOUND = 1814;
+ ERROR_RESOURCE_LANG_NOT_FOUND = 1815;
+ ERROR_NOT_ENOUGH_QUOTA = 1816;
+ RPC_S_NO_INTERFACES = 1817;
+ RPC_S_CALL_CANCELLED = 1818;
+ RPC_S_BINDING_INCOMPLETE = 1819;
+ RPC_S_COMM_FAILURE = 1820;
+ RPC_S_UNSUPPORTED_AUTHN_LEVEL = 1821;
+ RPC_S_NO_PRINC_NAME = 1822;
+ RPC_S_NOT_RPC_ERROR = 1823;
+ RPC_S_UUID_LOCAL_ONLY = 1824;
+ RPC_S_SEC_PKG_ERROR = 1825;
+ RPC_S_NOT_CANCELLED = 1826;
+ RPC_X_INVALID_ES_ACTION = 1827;
+ RPC_X_WRONG_ES_VERSION = 1828;
+ RPC_X_WRONG_STUB_VERSION = 1829;
+ RPC_X_INVALID_PIPE_OBJECT = 1830;
+ RPC_X_INVALID_PIPE_OPERATION = 1831;
+ RPC_S_GROUP_MEMBER_NOT_FOUND = 1898;
+ EPT_S_CANT_CREATE = 1899;
+ RPC_S_INVALID_OBJECT = 1900;
+ ERROR_INVALID_TIME = 1901;
+ ERROR_INVALID_FORM_NAME = 1902;
+ ERROR_INVALID_FORM_SIZE = 1903;
+ ERROR_ALREADY_WAITING = 1904;
+ ERROR_PRINTER_DELETED = 1905;
+ ERROR_INVALID_PRINTER_STATE = 1906;
+ ERROR_PASSWORD_MUST_CHANGE = 1907;
+ ERROR_DOMAIN_CONTROLLER_NOT_FOUND = 1908;
+ ERROR_ACCOUNT_LOCKED_OUT = 1909;
+ OR_INVALID_OXID = 1910;
+ OR_INVALID_OID = 1911;
+ OR_INVALID_SET = 1912;
+ RPC_S_SEND_INCOMPLETE = 1913;
+ ERROR_NO_BROWSER_SERVERS_FOUND = 6118;
+ ERROR_INVALID_PIXEL_FORMAT = 2000;
+ ERROR_BAD_DRIVER = 2001;
+ ERROR_INVALID_WINDOW_STYLE = 2002;
+ ERROR_METAFILE_NOT_SUPPORTED = 2003;
+ ERROR_TRANSFORM_NOT_SUPPORTED = 2004;
+ ERROR_CLIPPING_NOT_SUPPORTED = 2005;
+ ERROR_UNKNOWN_PRINT_MONITOR = 3000;
+ ERROR_PRINTER_DRIVER_IN_USE = 3001;
+ ERROR_SPOOL_FILE_NOT_FOUND = 3002;
+ ERROR_SPL_NO_STARTDOC = 3003;
+ ERROR_SPL_NO_ADDJOB = 3004;
+ ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED = 3005;
+ ERROR_PRINT_MONITOR_ALREADY_INSTALLED = 3006;
+ ERROR_INVALID_PRINT_MONITOR = 3007;
+ ERROR_PRINT_MONITOR_IN_USE = 3008;
+ ERROR_PRINTER_HAS_JOBS_QUEUED = 3009;
+ ERROR_SUCCESS_REBOOT_REQUIRED = 3010;
+ ERROR_SUCCESS_RESTART_REQUIRED = 3011;
+ ERROR_WINS_INTERNAL = 4000;
+ ERROR_CAN_NOT_DEL_LOCAL_WINS = 4001;
+ ERROR_STATIC_INIT = 4002;
+ ERROR_INC_BACKUP = 4003;
+ ERROR_FULL_BACKUP = 4004;
+ ERROR_REC_NON_EXISTENT = 4005;
+ ERROR_RPL_NOT_ALLOWED = 4006;
+ {ERROR_NO_BROWSER_SERVERS_FOUND = 6118; already above }
+
+ E_UNEXPECTED = DWORD($8000FFFF);
+ E_NOTIMPL = DWORD($80004001);
+ E_OUTOFMEMORY = DWORD($8007000E);
+ E_INVALIDARG = DWORD($80070057);
+ E_NOINTERFACE = HRESULT($80004002);
+ E_POINTER = DWORD($80004003);
+ E_HANDLE = DWORD($80070006);
+ E_ABORT = DWORD($80004004);
+ E_FAIL = DWORD($80004005);
+ E_ACCESSDENIED = DWORD($80070005);
+ E_PENDING = DWORD($8000000A);
+ CO_E_INIT_TLS = DWORD($80004006);
+ CO_E_INIT_SHARED_ALLOCATOR = DWORD($80004007);
+ CO_E_INIT_MEMORY_ALLOCATOR = DWORD($80004008);
+ CO_E_INIT_CLASS_CACHE = DWORD($80004009);
+ CO_E_INIT_RPC_CHANNEL = DWORD($8000400A);
+ CO_E_INIT_TLS_SET_CHANNEL_CONTROL = DWORD($8000400B);
+ CO_E_INIT_TLS_CHANNEL_CONTROL = DWORD($8000400C);
+ CO_E_INIT_UNACCEPTED_USER_ALLOCATOR = DWORD($8000400D);
+ CO_E_INIT_SCM_MUTEX_EXISTS = DWORD($8000400E);
+ CO_E_INIT_SCM_FILE_MAPPING_EXISTS = DWORD($8000400F);
+ CO_E_INIT_SCM_MAP_VIEW_OF_FILE = DWORD($80004010);
+ CO_E_INIT_SCM_EXEC_FAILURE = DWORD($80004011);
+ CO_E_INIT_ONLY_SINGLE_THREADED = DWORD($80004012);
+ CO_E_CANT_REMOTE = DWORD($80004013);
+ CO_E_BAD_SERVER_NAME = DWORD($80004014);
+ CO_E_WRONG_SERVER_IDENTITY = DWORD($80004015);
+ CO_E_OLE1DDE_DISABLED = DWORD($80004016);
+ CO_E_RUNAS_SYNTAX = DWORD($80004017);
+ CO_E_CREATEPROCESS_FAILURE = DWORD($80004018);
+ CO_E_RUNAS_CREATEPROCESS_FAILURE = DWORD($80004019);
+ CO_E_RUNAS_LOGON_FAILURE = DWORD($8000401A);
+ CO_E_LAUNCH_PERMSSION_DENIED = DWORD($8000401B);
+ CO_E_START_SERVICE_FAILURE = DWORD($8000401C);
+ CO_E_REMOTE_COMMUNICATION_FAILURE = DWORD($8000401D);
+ CO_E_SERVER_START_TIMEOUT = DWORD($8000401E);
+ CO_E_CLSREG_INCONSISTENT = DWORD($8000401F);
+ CO_E_IIDREG_INCONSISTENT = DWORD($80004020);
+ CO_E_NOT_SUPPORTED = DWORD($80004021);
+
+ CO_E_FIRST = DWORD($800401F0);
+ CO_E_LAST = DWORD($800401FF);
+ CO_S_FIRST = $401F0;
+ CO_S_LAST = $401FF;
+ S_OK = $00000000;
+ S_FALSE = $00000001;
+
+ CO_E_NOTINITIALIZED = DWORD($800401F0);
+ CO_E_ALREADYINITIALIZED = DWORD($800401F1);
+ CO_E_CANTDETERMINECLASS = DWORD($800401F2);
+ CO_E_CLASSSTRING = DWORD($800401F3);
+ CO_E_IIDSTRING = DWORD($800401F4);
+ CO_E_APPNOTFOUND = DWORD($800401F5);
+ CO_E_APPSINGLEUSE = DWORD($800401F6);
+ CO_E_ERRORINAPP = DWORD($800401F7);
+ CO_E_DLLNOTFOUND = DWORD($800401F8);
+ CO_E_ERRORINDLL = DWORD($800401F9);
+ CO_E_WRONGOSFORAPP = DWORD($800401FA);
+ CO_E_OBJNOTREG = DWORD($800401FB);
+ CO_E_OBJISREG = DWORD($800401FC);
+ CO_E_OBJNOTCONNECTED = DWORD($800401FD);
+ CO_E_APPDIDNTREG = DWORD($800401FE);
+ CO_E_RELEASED = DWORD($800401FF);
+
+ OLE_E_FIRST = $80040000;
+ OLE_E_LAST = $800400FF;
+ OLE_S_FIRST = $00040000;
+ OLE_S_LAST = $000400FF;
+ OLE_E_OLEVERB = $80040000;
+ OLE_E_ADVF = $80040001;
+ OLE_E_ENUM_NOMORE = $80040002;
+ OLE_E_ADVISENOTSUPPORTED = $80040003;
+ OLE_E_NOCONNECTION = $80040004;
+ OLE_E_NOTRUNNING = $80040005;
+ OLE_E_NOCACHE = $80040006;
+ OLE_E_BLANK = $80040007;
+ OLE_E_CLASSDIFF = $80040008;
+ OLE_E_CANT_GETMONIKER = $80040009;
+ OLE_E_CANT_BINDTOSOURCE = $8004000A;
+ OLE_E_STATIC = $8004000B;
+ OLE_E_PROMPTSAVECANCELLED = $8004000C;
+ OLE_E_INVALIDRECT = $8004000D;
+ OLE_E_WRONGCOMPOBJ = $8004000E;
+ OLE_E_INVALIDHWND = $8004000F;
+ OLE_E_NOT_INPLACEACTIVE = $80040010;
+ OLE_E_CANTCONVERT = $80040011;
+ OLE_E_NOSTORAGE = $80040012;
+ DV_E_FORMATETC = $80040064;
+ DV_E_DVTARGETDEVICE = $80040065;
+ DV_E_STGMEDIUM = $80040066;
+ DV_E_STATDATA = $80040067;
+ DV_E_LINDEX = $80040068;
+ DV_E_TYMED = $80040069;
+ DV_E_CLIPFORMAT = $8004006A;
+ DV_E_DVASPECT = $8004006B;
+ DV_E_DVTARGETDEVICE_SIZE = $8004006C;
+ DV_E_NOIVIEWOBJECT = $8004006D;
+ DRAGDROP_E_FIRST = $80040100;
+ DRAGDROP_E_LAST = $8004010F;
+ DRAGDROP_S_FIRST = $00040100;
+ DRAGDROP_S_LAST = $0004010F;
+ DRAGDROP_E_NOTREGISTERED = $80040100;
+ DRAGDROP_E_ALREADYREGISTERED = $80040101;
+ DRAGDROP_E_INVALIDHWND = $80040102;
+ CLASSFACTORY_E_FIRST = $80040110;
+ CLASSFACTORY_E_LAST = $8004011F;
+ CLASSFACTORY_S_FIRST = $00040110;
+ CLASSFACTORY_S_LAST = $0004011F;
+ CLASS_E_NOAGGREGATION = $80040110;
+ CLASS_E_CLASSNOTAVAILABLE = $80040111;
+ MARSHAL_E_FIRST = $80040120;
+ MARSHAL_E_LAST = $8004012F;
+ MARSHAL_S_FIRST = $00040120;
+ MARSHAL_S_LAST = $0004012F;
+ DATA_E_FIRST = $80040130;
+ DATA_E_LAST = $8004013F;
+ DATA_S_FIRST = $00040130;
+ DATA_S_LAST = $0004013F;
+ VIEW_E_FIRST = $80040140;
+ VIEW_E_LAST = $8004014F;
+ VIEW_S_FIRST = $00040140;
+ VIEW_S_LAST = $0004014F;
+ VIEW_E_DRAW = $80040140;
+ REGDB_E_FIRST = $80040150;
+ REGDB_E_LAST = $8004015F;
+ REGDB_S_FIRST = $00040150;
+ REGDB_S_LAST = $0004015F;
+ REGDB_E_READREGDB = $80040150;
+ REGDB_E_WRITEREGDB = $80040151;
+ REGDB_E_KEYMISSING = $80040152;
+ REGDB_E_INVALIDVALUE = $80040153;
+ REGDB_E_CLASSNOTREG = $80040154;
+ REGDB_E_IIDNOTREG = $80040155;
+ CACHE_E_FIRST = $80040170;
+ CACHE_E_LAST = $8004017F;
+ CACHE_S_FIRST = $00040170;
+ CACHE_S_LAST = $0004017F;
+ CACHE_E_NOCACHE_UPDATED = $80040170;
+ OLEOBJ_E_FIRST = $80040180;
+ OLEOBJ_E_LAST = $8004018F;
+ OLEOBJ_S_FIRST = $00040180;
+ OLEOBJ_S_LAST = $0004018F;
+ OLEOBJ_E_NOVERBS = $80040180;
+ OLEOBJ_E_INVALIDVERB = $80040181;
+ CLIENTSITE_E_FIRST = $80040190;
+ CLIENTSITE_E_LAST = $8004019F;
+ CLIENTSITE_S_FIRST = $00040190;
+ CLIENTSITE_S_LAST = $0004019F;
+ INPLACE_E_NOTUNDOABLE = $800401A0;
+ INPLACE_E_NOTOOLSPACE = $800401A1;
+ INPLACE_E_FIRST = $800401A0;
+ INPLACE_E_LAST = $800401AF;
+ INPLACE_S_FIRST = $000401A0;
+ INPLACE_S_LAST = $000401AF;
+ ENUM_E_FIRST = $800401B0;
+ ENUM_E_LAST = $800401BF;
+ ENUM_S_FIRST = $000401B0;
+ ENUM_S_LAST = $000401BF;
+ CONVERT10_E_FIRST = $800401C0;
+ CONVERT10_E_LAST = $800401CF;
+ CONVERT10_S_FIRST = $000401C0;
+ CONVERT10_S_LAST = $000401CF;
+ CONVERT10_E_OLESTREAM_GET = $800401C0;
+ CONVERT10_E_OLESTREAM_PUT = $800401C1;
+ CONVERT10_E_OLESTREAM_FMT = $800401C2;
+ CONVERT10_E_OLESTREAM_BITMAP_TO_DIB = $800401C3;
+ CONVERT10_E_STG_FMT = $800401C4;
+ CONVERT10_E_STG_NO_STD_STREAM = $800401C5;
+ CONVERT10_E_STG_DIB_TO_BITMAP = $800401C6;
+ CLIPBRD_E_FIRST = $800401D0;
+ CLIPBRD_E_LAST = $800401DF;
+ CLIPBRD_S_FIRST = $000401D0;
+ CLIPBRD_S_LAST = $000401DF;
+ CLIPBRD_E_CANT_OPEN = $800401D0;
+ CLIPBRD_E_CANT_EMPTY = $800401D1;
+ CLIPBRD_E_CANT_SET = $800401D2;
+ CLIPBRD_E_BAD_DATA = $800401D3;
+ CLIPBRD_E_CANT_CLOSE = $800401D4;
+ MK_E_FIRST = $800401E0;
+ MK_E_LAST = $800401EF;
+ MK_S_FIRST = $000401E0;
+ MK_S_LAST = $000401EF;
+ MK_E_CONNECTMANUALLY = $800401E0;
+ MK_E_EXCEEDEDDEADLINE = $800401E1;
+ MK_E_NEEDGENERIC = $800401E2;
+ MK_E_UNAVAILABLE = $800401E3;
+ MK_E_SYNTAX = $800401E4;
+ MK_E_NOOBJECT = $800401E5;
+ MK_E_INVALIDEXTENSION = $800401E6;
+ MK_E_INTERMEDIATEINTERFACENOTSUPPORTED = $800401E7;
+ MK_E_NOTBINDABLE = $800401E8;
+ MK_E_NOTBOUND = $800401E9;
+ MK_E_CANTOPENFILE = $800401EA;
+ MK_E_MUSTBOTHERUSER = $800401EB;
+ MK_E_NOINVERSE = $800401EC;
+ MK_E_NOSTORAGE = $800401ED;
+ MK_E_NOPREFIX = $800401EE;
+ MK_E_ENUMERATION_FAILED = $800401EF;
+ OLE_S_USEREG = $00040000;
+ OLE_S_STATIC = $00040001;
+ OLE_S_MAC_CLIPFORMAT = $00040002;
+ DRAGDROP_S_DROP = $00040100;
+ DRAGDROP_S_CANCEL = $00040101;
+ DRAGDROP_S_USEDEFAULTCURSORS = $00040102;
+ DATA_S_SAMEFORMATETC = $00040130;
+ VIEW_S_ALREADY_FROZEN = $00040140;
+ CACHE_S_FORMATETC_NOTSUPPORTED = $00040170;
+ CACHE_S_SAMECACHE = $00040171;
+ CACHE_S_SOMECACHES_NOTUPDATED = $00040172;
+ OLEOBJ_S_INVALIDVERB = $00040180;
+ OLEOBJ_S_CANNOT_DOVERB_NOW = $00040181;
+ OLEOBJ_S_INVALIDHWND = $00040182;
+ INPLACE_S_TRUNCATED = $000401A0;
+ CONVERT10_S_NO_PRESENTATION = $000401C0;
+ MK_S_REDUCED_TO_SELF = $000401E2;
+ MK_S_ME = $000401E4;
+ MK_S_HIM = $000401E5;
+ MK_S_US = $000401E6;
+ MK_S_MONIKERALREADYREGISTERED = $000401E7;
+ CO_E_CLASS_CREATE_FAILED = $80080001;
+ CO_E_SCM_ERROR = $80080002;
+ CO_E_SCM_RPC_FAILURE = $80080003;
+ CO_E_BAD_PATH = $80080004;
+ CO_E_SERVER_EXEC_FAILURE = $80080005;
+ CO_E_OBJSRV_RPC_FAILURE = $80080006;
+ MK_E_NO_NORMALIZED = $80080007;
+ CO_E_SERVER_STOPPING = $80080008;
+ MEM_E_INVALID_ROOT = $80080009;
+ MEM_E_INVALID_LINK = $80080010;
+ MEM_E_INVALID_SIZE = $80080011;
+ CO_S_NOTALLINTERFACES = $00080012;
+ DISP_E_UNKNOWNINTERFACE = $80020001;
+ DISP_E_MEMBERNOTFOUND = $80020003;
+ DISP_E_PARAMNOTFOUND = $80020004;
+ DISP_E_TYPEMISMATCH = $80020005;
+ DISP_E_UNKNOWNNAME = $80020006;
+ DISP_E_NONAMEDARGS = $80020007;
+ DISP_E_BADVARTYPE = $80020008;
+ DISP_E_EXCEPTION = $80020009;
+ DISP_E_OVERFLOW = $8002000A;
+ DISP_E_BADINDEX = $8002000B;
+ DISP_E_UNKNOWNLCID = $8002000C;
+ DISP_E_ARRAYISLOCKED = $8002000D;
+ DISP_E_BADPARAMCOUNT = $8002000E;
+ DISP_E_PARAMNOTOPTIONAL = $8002000F;
+ DISP_E_BADCALLEE = $80020010;
+ DISP_E_NOTACOLLECTION = $80020011;
+ TYPE_E_BUFFERTOOSMALL = $80028016;
+ TYPE_E_INVDATAREAD = $80028018;
+ TYPE_E_UNSUPFORMAT = $80028019;
+ TYPE_E_REGISTRYACCESS = $8002801C;
+ TYPE_E_LIBNOTREGISTERED = $8002801D;
+ TYPE_E_UNDEFINEDTYPE = $80028027;
+ TYPE_E_QUALIFIEDNAMEDISALLOWED = $80028028;
+ TYPE_E_INVALIDSTATE = $80028029;
+ TYPE_E_WRONGTYPEKIND = $8002802A;
+ TYPE_E_ELEMENTNOTFOUND = $8002802B;
+ TYPE_E_AMBIGUOUSNAME = $8002802C;
+ TYPE_E_NAMECONFLICT = $8002802D;
+ TYPE_E_UNKNOWNLCID = $8002802E;
+ TYPE_E_DLLFUNCTIONNOTFOUND = $8002802F;
+ TYPE_E_BADMODULEKIND = $800288BD;
+ TYPE_E_SIZETOOBIG = $800288C5;
+ TYPE_E_DUPLICATEID = $800288C6;
+ TYPE_E_INVALIDID = $800288CF;
+ TYPE_E_TYPEMISMATCH = $80028CA0;
+ TYPE_E_OUTOFBOUNDS = $80028CA1;
+ TYPE_E_IOERROR = $80028CA2;
+ TYPE_E_CANTCREATETMPFILE = $80028CA3;
+ TYPE_E_CANTLOADLIBRARY = $80029C4A;
+ TYPE_E_INCONSISTENTPROPFUNCS = $80029C83;
+ TYPE_E_CIRCULARTYPE = $80029C84;
+ STG_E_INVALIDFUNCTION = $80030001;
+ STG_E_FILENOTFOUND = $80030002;
+ STG_E_PATHNOTFOUND = $80030003;
+ STG_E_TOOMANYOPENFILES = $80030004;
+ STG_E_ACCESSDENIED = $80030005;
+ STG_E_INVALIDHANDLE = $80030006;
+ STG_E_INSUFFICIENTMEMORY = $80030008;
+ STG_E_INVALIDPOINTER = $80030009;
+ STG_E_NOMOREFILES = $80030012;
+ STG_E_DISKISWRITEPROTECTED = $80030013;
+ STG_E_SEEKERROR = $80030019;
+ STG_E_WRITEFAULT = $8003001D;
+ STG_E_READFAULT = $8003001E;
+ STG_E_SHAREVIOLATION = $80030020;
+ STG_E_LOCKVIOLATION = $80030021;
+ STG_E_FILEALREADYEXISTS = $80030050;
+ STG_E_INVALIDPARAMETER = $80030057;
+ STG_E_MEDIUMFULL = $80030070;
+ STG_E_PROPSETMISMATCHED = $800300F0;
+ STG_E_ABNORMALAPIEXIT = $800300FA;
+ STG_E_INVALIDHEADER = $800300FB;
+ STG_E_INVALIDNAME = $800300FC;
+ STG_E_UNKNOWN = $800300FD;
+ STG_E_UNIMPLEMENTEDFUNCTION = $800300FE;
+ STG_E_INVALIDFLAG = $800300FF;
+ STG_E_INUSE = $80030100;
+ STG_E_NOTCURRENT = $80030101;
+ STG_E_REVERTED = $80030102;
+ STG_E_CANTSAVE = $80030103;
+ STG_E_OLDFORMAT = $80030104;
+ STG_E_OLDDLL = $80030105;
+ STG_E_SHAREREQUIRED = $80030106;
+ STG_E_NOTFILEBASEDSTORAGE = $80030107;
+ STG_E_EXTANTMARSHALLINGS = $80030108;
+ STG_E_DOCFILECORRUPT = $80030109;
+ STG_E_BADBASEADDRESS = $80030110;
+ STG_E_INCOMPLETE = $80030201;
+ STG_E_TERMINATED = $80030202;
+ STG_S_CONVERTED = $00030200;
+ STG_S_BLOCK = $00030201;
+ STG_S_RETRYNOW = $00030202;
+ STG_S_MONITORING = $00030203;
+ RPC_E_CALL_REJECTED = $80010001;
+ RPC_E_CALL_CANCELED = $80010002;
+ RPC_E_CANTPOST_INSENDCALL = $80010003;
+ RPC_E_CANTCALLOUT_INASYNCCALL = $80010004;
+ RPC_E_CANTCALLOUT_INEXTERNALCALL = $80010005;
+ RPC_E_CONNECTION_TERMINATED = $80010006;
+ RPC_E_SERVER_DIED = $80010007;
+ RPC_E_CLIENT_DIED = $80010008;
+ RPC_E_INVALID_DATAPACKET = $80010009;
+ RPC_E_CANTTRANSMIT_CALL = $8001000A;
+ RPC_E_CLIENT_CANTMARSHAL_DATA = $8001000B;
+ RPC_E_CLIENT_CANTUNMARSHAL_DATA = $8001000C;
+ RPC_E_SERVER_CANTMARSHAL_DATA = $8001000D;
+ RPC_E_SERVER_CANTUNMARSHAL_DATA = $8001000E;
+ RPC_E_INVALID_DATA = $8001000F;
+ RPC_E_INVALID_PARAMETER = $80010010;
+ RPC_E_CANTCALLOUT_AGAIN = $80010011;
+ RPC_E_SERVER_DIED_DNE = $80010012;
+ RPC_E_SYS_CALL_FAILED = $80010100;
+ RPC_E_OUT_OF_RESOURCES = $80010101;
+ RPC_E_ATTEMPTED_MULTITHREAD = $80010102;
+ RPC_E_NOT_REGISTERED = $80010103;
+ RPC_E_FAULT = $80010104;
+ RPC_E_SERVERFAULT = $80010105;
+ RPC_E_CHANGED_MODE = $80010106;
+ RPC_E_INVALIDMETHOD = $80010107;
+ RPC_E_DISCONNECTED = $80010108;
+ RPC_E_RETRY = $80010109;
+ RPC_E_SERVERCALL_RETRYLATER = $8001010A;
+ RPC_E_SERVERCALL_REJECTED = $8001010B;
+ RPC_E_INVALID_CALLDATA = $8001010C;
+ RPC_E_CANTCALLOUT_ININPUTSYNCCALL = $8001010D;
+ RPC_E_WRONG_THREAD = $8001010E;
+ RPC_E_THREAD_NOT_INIT = $8001010F;
+ RPC_E_VERSION_MISMATCH = $80010110;
+ RPC_E_INVALID_HEADER = $80010111;
+ RPC_E_INVALID_EXTENSION = $80010112;
+ RPC_E_INVALID_IPID = $80010113;
+ RPC_E_INVALID_OBJECT = $80010114;
+ RPC_S_CALLPENDING = $80010115;
+ RPC_S_WAITONTIMER = $80010116;
+ RPC_E_CALL_COMPLETE = $80010117;
+ RPC_E_UNSECURE_CALL = $80010118;
+ RPC_E_TOO_LATE = $80010119;
+ RPC_E_NO_GOOD_SECURITY_PACKAGES = $8001011A;
+ RPC_E_ACCESS_DENIED = $8001011B;
+ RPC_E_REMOTE_DISABLED = $8001011C;
+ RPC_E_INVALID_OBJREF = $8001011D;
+ RPC_E_UNEXPECTED = $8001FFFF;
+ NTE_BAD_UID = $80090001;
+ NTE_BAD_HASH = $80090002;
+ NTE_BAD_KEY = $80090003;
+ NTE_BAD_LEN = $80090004;
+ NTE_BAD_DATA = $80090005;
+ NTE_BAD_SIGNATURE = $80090006;
+ NTE_BAD_VER = $80090007;
+ NTE_BAD_ALGID = $80090008;
+ NTE_BAD_FLAGS = $80090009;
+ NTE_BAD_TYPE = $8009000A;
+ NTE_BAD_KEY_STATE = $8009000B;
+ NTE_BAD_HASH_STATE = $8009000C;
+ NTE_NO_KEY = $8009000D;
+ NTE_NO_MEMORY = $8009000E;
+ NTE_EXISTS = $8009000F;
+ NTE_PERM = $80090010;
+ NTE_NOT_FOUND = $80090011;
+ NTE_DOUBLE_ENCRYPT = $80090012;
+ NTE_BAD_PROVIDER = $80090013;
+ NTE_BAD_PROV_TYPE = $80090014;
+ NTE_BAD_PUBLIC_KEY = $80090015;
+ NTE_BAD_KEYSET = $80090016;
+ NTE_PROV_TYPE_NOT_DEF = $80090017;
+ NTE_PROV_TYPE_ENTRY_BAD = $80090018;
+ NTE_KEYSET_NOT_DEF = $80090019;
+ NTE_KEYSET_ENTRY_BAD = $8009001A;
+ NTE_PROV_TYPE_NO_MATCH = $8009001B;
+ NTE_SIGNATURE_FILE_BAD = $8009001C;
+ NTE_PROVIDER_DLL_FAIL = $8009001D;
+ NTE_PROV_DLL_NOT_FOUND = $8009001E;
+ NTE_BAD_KEYSET_PARAM = $8009001F;
+ NTE_FAIL = $80090020;
+ NTE_SYS_ERR = $80090021;
+ NTE_OP_OK = 0;
+ TRUST_E_PROVIDER_UNKNOWN = $800B0001;
+ TRUST_E_ACTION_UNKNOWN = $800B0002;
+ TRUST_E_SUBJECT_FORM_UNKNOWN = $800B0003;
+ TRUST_E_SUBJECT_NOT_TRUSTED = $800B0004;
+ DIGSIG_E_ENCODE = $800B0005;
+ DIGSIG_E_DECODE = $800B0006;
+ DIGSIG_E_EXTENSIBILITY = $800B0007;
+ DIGSIG_E_CRYPTO = $800B0008;
+ PERSIST_E_SIZEDEFINITE = $800B0009;
+ PERSIST_E_SIZEINDEFINITE = $800B000A;
+ PERSIST_E_NOTSELFSIZING = $800B000B;
+ TRUST_E_NOSIGNATURE = $800B0100;
+ CERT_E_EXPIRED = $800B0101;
+ CERT_E_VALIDIYPERIODNESTING = $800B0102;
+ CERT_E_ROLE = $800B0103;
+ CERT_E_PATHLENCONST = $800B0104;
+ CERT_E_CRITICAL = $800B0105;
+ CERT_E_PURPOSE = $800B0106;
+ CERT_E_ISSUERCHAINING = $800B0107;
+ CERT_E_MALFORMED = $800B0108;
+ CERT_E_UNTRUSTEDROOT = $800B0109;
+ CERT_E_CHAINING = $800B010A;
+
+{$endif read_interface}
+
+{
+ $Log: errors.inc,v $
+ Revision 1.6 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/func.inc b/rtl/win32/wininc/func.inc
new file mode 100644
index 0000000000..45875fbe00
--- /dev/null
+++ b/rtl/win32/wininc/func.inc
@@ -0,0 +1,2346 @@
+{
+ $Id: func.inc,v 1.25 2005/05/09 18:39:58 michael Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the record definition for the Win32 API
+ Copyright (c) 1999-2000 by Florian KLaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+ Functions.h
+
+ Declarations for all the Windows32 API Functions
+
+ Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+function AccessCheck(pSecurityDescriptor:PSECURITY_DESCRIPTOR; ClientToken:HANDLE; DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; PrivilegeSet:PPRIVILEGE_SET;PrivilegeSetLength:LPDWORD;
+ GrantedAccess:LPDWORD; AccessStatus:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheck';
+function InterlockedIncrement(lpAddend:LPLONG):LONG; external 'kernel32' name 'InterlockedIncrement';
+function InterlockedDecrement(lpAddend:LPLONG):LONG; external 'kernel32' name 'InterlockedDecrement';
+function InterlockedExchange(Target:LPLONG; Value:LONG):LONG; external 'kernel32' name 'InterlockedExchange';
+function FreeResource(hResData:HGLOBAL):WINBOOL; external 'kernel32' name 'FreeResource';
+function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockResource';
+{$ifdef Unknown_functions}
+{ WARNING: function not found !!}
+function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:longint):longint; external External_library name 'WinMain';
+{$endif Unknown_functions}function FreeLibrary(hLibModule:HINST):WINBOOL; external 'kernel32' name 'FreeLibrary';
+procedure FreeLibraryAndExitThread(hLibModule:HMODULE; dwExitCode:DWORD); external 'kernel32' name 'FreeLibraryAndExitThread';
+function DisableThreadLibraryCalls(hLibModule:HMODULE):WINBOOL; external 'kernel32' name 'DisableThreadLibraryCalls';
+function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress';
+function GetVersion:DWORD; external 'kernel32' name 'GetVersion';
+function GlobalAlloc(uFlags:UINT; dwBytes:DWORD):HGLOBAL; external 'kernel32' name 'GlobalAlloc';
+function GlobalDiscard(hglbMem:HGLOBAL):HGLOBAL;
+function GlobalReAlloc(hMem:HGLOBAL; dwBytes:DWORD; uFlags:UINT):HGLOBAL; external 'kernel32' name 'GlobalReAlloc';
+function GlobalSize(hMem:HGLOBAL):DWORD; external 'kernel32' name 'GlobalSize';
+function GlobalFlags(hMem:HGLOBAL):UINT; external 'kernel32' name 'GlobalFlags';
+function GlobalLock(hMem:HGLOBAL):LPVOID; external 'kernel32' name 'GlobalLock';
+function GlobalHandle(pMem:LPCVOID):HGLOBAL; external 'kernel32' name 'GlobalHandle';
+function GlobalUnlock(hMem:HGLOBAL):WINBOOL; external 'kernel32' name 'GlobalUnlock';
+function GlobalFree(hMem:HGLOBAL):HGLOBAL; external 'kernel32' name 'GlobalFree';
+function GlobalCompact(dwMinFree:DWORD):UINT; external 'kernel32' name 'GlobalCompact';
+procedure GlobalFix(hMem:HGLOBAL); external 'kernel32' name 'GlobalFix';
+procedure GlobalUnfix(hMem:HGLOBAL); external 'kernel32' name 'GlobalUnfix';
+function GlobalWire(hMem:HGLOBAL):LPVOID; external 'kernel32' name 'GlobalWire';
+function GlobalUnWire(hMem:HGLOBAL):WINBOOL; external 'kernel32' name 'GlobalUnWire';
+procedure GlobalMemoryStatus(lpBuffer:LPMEMORYSTATUS); external 'kernel32' name 'GlobalMemoryStatus';
+function LocalAlloc(uFlags:UINT; uBytes:UINT):HLOCAL; external 'kernel32' name 'LocalAlloc';
+function LocalDiscard(hlocMem:HLOCAL):HLOCAL;
+function LocalReAlloc(hMem:HLOCAL; uBytes:UINT; uFlags:UINT):HLOCAL; external 'kernel32' name 'LocalReAlloc';
+function LocalLock(hMem:HLOCAL):LPVOID; external 'kernel32' name 'LocalLock';
+function LocalHandle(pMem:LPCVOID):HLOCAL; external 'kernel32' name 'LocalHandle';
+function LocalUnlock(hMem:HLOCAL):WINBOOL; external 'kernel32' name 'LocalUnlock';
+function LocalSize(hMem:HLOCAL):UINT; external 'kernel32' name 'LocalSize';
+function LocalFlags(hMem:HLOCAL):UINT; external 'kernel32' name 'LocalFlags';
+function LocalFree(hMem:HLOCAL):HLOCAL; external 'kernel32' name 'LocalFree';
+function LocalShrink(hMem:HLOCAL; cbNewSize:UINT):UINT; external 'kernel32' name 'LocalShrink';
+function LocalCompact(uMinFree:UINT):UINT; external 'kernel32' name 'LocalCompact';
+function FlushInstructionCache(hProcess:HANDLE; lpBaseAddress:LPCVOID; dwSize:DWORD):WINBOOL; external 'kernel32' name 'FlushInstructionCache';
+function VirtualAlloc(lpAddress:LPVOID; dwSize:DWORD; flAllocationType:DWORD; flProtect:DWORD):LPVOID; external 'kernel32' name 'VirtualAlloc';
+function VirtualFree(lpAddress:LPVOID; dwSize:DWORD; dwFreeType:DWORD):WINBOOL; external 'kernel32' name 'VirtualFree';
+function VirtualProtect(lpAddress:LPVOID; dwSize:DWORD; flNewProtect:DWORD; lpflOldProtect:PDWORD):WINBOOL; external 'kernel32' name 'VirtualProtect';
+function VirtualQuery(lpAddress:LPCVOID; lpBuffer:PMEMORY_BASIC_INFORMATION; dwLength:DWORD):DWORD; external 'kernel32' name 'VirtualQuery';
+function VirtualProtectEx(hProcess:HANDLE; lpAddress:LPVOID; dwSize:DWORD; flNewProtect:DWORD; lpflOldProtect:PDWORD):WINBOOL; external 'kernel32' name 'VirtualProtectEx';
+function VirtualQueryEx(hProcess:HANDLE; lpAddress:LPCVOID; lpBuffer:PMEMORY_BASIC_INFORMATION; dwLength:DWORD):DWORD; external 'kernel32' name 'VirtualQueryEx';
+function HeapCreate(flOptions:DWORD; dwInitialSize:DWORD; dwMaximumSize:DWORD):HANDLE; external 'kernel32' name 'HeapCreate';
+function HeapDestroy(hHeap:HANDLE):WINBOOL; external 'kernel32' name 'HeapDestroy';
+function HeapAlloc(hHeap:HANDLE; dwFlags:DWORD; dwBytes:DWORD):LPVOID; external 'kernel32' name 'HeapAlloc';
+function HeapReAlloc(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPVOID; dwBytes:DWORD):LPVOID; external 'kernel32' name 'HeapReAlloc';
+function HeapFree(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPVOID):WINBOOL; external 'kernel32' name 'HeapFree';
+function HeapSize(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPCVOID):DWORD; external 'kernel32' name 'HeapSize';
+function HeapValidate(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPCVOID):WINBOOL; external 'kernel32' name 'HeapValidate';
+function HeapCompact(hHeap:HANDLE; dwFlags:DWORD):UINT; external 'kernel32' name 'HeapCompact';
+function GetProcessHeap:HANDLE; external 'kernel32' name 'GetProcessHeap';
+function GetProcessHeaps(NumberOfHeaps:DWORD; ProcessHeaps:PHANDLE):DWORD; external 'kernel32' name 'GetProcessHeaps';
+function HeapLock(hHeap:HANDLE):WINBOOL; external 'kernel32' name 'HeapLock';
+function HeapUnlock(hHeap:HANDLE):WINBOOL; external 'kernel32' name 'HeapUnlock';
+function HeapWalk(hHeap:HANDLE; lpEntry:LPPROCESS_HEAP_ENTRY):WINBOOL; external 'kernel32' name 'HeapWalk';
+function GetProcessAffinityMask(hProcess:HANDLE; lpProcessAffinityMask:LPDWORD; lpSystemAffinityMask:LPDWORD):WINBOOL; external 'kernel32' name 'GetProcessAffinityMask';
+function GetProcessTimes(hProcess:HANDLE; lpCreationTime:LPFILETIME; lpExitTime:LPFILETIME; lpKernelTime:LPFILETIME; lpUserTime:LPFILETIME):WINBOOL; external 'kernel32' name 'GetProcessTimes';
+function GetProcessWorkingSetSize(hProcess:HANDLE; lpMinimumWorkingSetSize:LPDWORD; lpMaximumWorkingSetSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetProcessWorkingSetSize';
+function SetProcessWorkingSetSize(hProcess:HANDLE; dwMinimumWorkingSetSize:DWORD; dwMaximumWorkingSetSize:DWORD):WINBOOL; external 'kernel32' name 'SetProcessWorkingSetSize';
+function OpenProcess(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; dwProcessId:DWORD):HANDLE; external 'kernel32' name 'OpenProcess';
+function GetCurrentProcess:HANDLE; external 'kernel32' name 'GetCurrentProcess';
+function GetCurrentProcessId:DWORD; external 'kernel32' name 'GetCurrentProcessId';
+procedure ExitProcess(uExitCode:UINT);external 'kernel32' name 'ExitProcess';
+function TerminateProcess(hProcess:HANDLE; uExitCode:UINT):WINBOOL; external 'kernel32' name 'TerminateProcess';
+function GetExitCodeProcess(hProcess:HANDLE; lpExitCode:LPDWORD):WINBOOL; external 'kernel32' name 'GetExitCodeProcess';
+procedure FatalExit(ExitCode:longint); external 'kernel32' name 'FatalExit';
+procedure RaiseException(dwExceptionCode:DWORD; dwExceptionFlags:DWORD; nNumberOfArguments:DWORD; lpArguments:LPDWORD); external 'kernel32' name 'RaiseException';
+function UnhandledExceptionFilter(ExceptionInfo:lpemptyrecord):LONG; external 'kernel32' name 'UnhandledExceptionFilter';
+function CreateRemoteThread(hProcess:HANDLE; lpThreadAttributes:LPSECURITY_ATTRIBUTES; dwStackSize:DWORD; lpStartAddress:LPTHREAD_START_ROUTINE; lpParameter:LPVOID;
+ dwCreationFlags:DWORD; lpThreadId:LPDWORD):HANDLE; external 'kernel32' name 'CreateRemoteThread';
+function GetCurrentThread:HANDLE; external 'kernel32' name 'GetCurrentThread';
+function GetCurrentThreadId:DWORD; external 'kernel32' name 'GetCurrentThreadId';
+function SetThreadAffinityMask(hThread:HANDLE; dwThreadAffinityMask:DWORD):DWORD; external 'kernel32' name 'SetThreadAffinityMask';
+function SetThreadPriority(hThread:HANDLE; nPriority:longint):WINBOOL; external 'kernel32' name 'SetThreadPriority';
+function GetThreadPriority(hThread:HANDLE):longint; external 'kernel32' name 'GetThreadPriority';
+function GetThreadTimes(hThread:HANDLE; lpCreationTime:LPFILETIME; lpExitTime:LPFILETIME; lpKernelTime:LPFILETIME; lpUserTime:LPFILETIME):WINBOOL; external 'kernel32' name 'GetThreadTimes';
+procedure ExitThread(dwExitCode:DWORD); external 'kernel32' name 'ExitThread';
+function TerminateThread(hThread:HANDLE; dwExitCode:DWORD):WINBOOL; external 'kernel32' name 'TerminateThread';
+function GetExitCodeThread(hThread:HANDLE; lpExitCode:LPDWORD):WINBOOL; external 'kernel32' name 'GetExitCodeThread';
+function GetThreadSelectorEntry(hThread:HANDLE; dwSelector:DWORD; lpSelectorEntry:LPLDT_ENTRY):WINBOOL; external 'kernel32' name 'GetThreadSelectorEntry';
+function GetLastError:DWORD; external 'kernel32' name 'GetLastError';
+procedure SetLastError(dwErrCode:DWORD); external 'kernel32' name 'SetLastError';
+function CreateIoCompletionPort(FileHandle:HANDLE; ExistingCompletionPort:HANDLE; CompletionKey:DWORD; NumberOfConcurrentThreads:DWORD):HANDLE; external 'kernel32' name 'CreateIoCompletionPort';
+function SetErrorMode(uMode:UINT):UINT; external 'kernel32' name 'SetErrorMode';
+function ReadProcessMemory(hProcess:HANDLE; lpBaseAddress:LPCVOID; lpBuffer:LPVOID; nSize:DWORD; lpNumberOfBytesRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadProcessMemory';
+function WriteProcessMemory(hProcess:HANDLE; lpBaseAddress:LPVOID; lpBuffer:LPVOID; nSize:DWORD; lpNumberOfBytesWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteProcessMemory';
+function GetThreadContext(hThread:HANDLE; lpContext:LPCONTEXT):WINBOOL; external 'kernel32' name 'GetThreadContext';
+function SuspendThread(hThread:HANDLE):DWORD; external 'kernel32' name 'SuspendThread';
+function ResumeThread(hThread:HANDLE):DWORD; external 'kernel32' name 'ResumeThread';
+procedure DebugBreak; external 'kernel32' name 'DebugBreak';
+function WaitForDebugEvent(lpDebugEvent:LPDEBUG_EVENT; dwMilliseconds:DWORD):WINBOOL; external 'kernel32' name 'WaitForDebugEvent';
+function ContinueDebugEvent(dwProcessId:DWORD; dwThreadId:DWORD; dwContinueStatus:DWORD):WINBOOL; external 'kernel32' name 'ContinueDebugEvent';
+function DebugActiveProcess(dwProcessId:DWORD):WINBOOL; external 'kernel32' name 'DebugActiveProcess';
+procedure InitializeCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external 'kernel32' name 'InitializeCriticalSection';
+procedure EnterCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external 'kernel32' name 'EnterCriticalSection';
+procedure LeaveCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external 'kernel32' name 'LeaveCriticalSection';
+procedure DeleteCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external 'kernel32' name 'DeleteCriticalSection';
+function SetEvent(hEvent:HANDLE):WINBOOL; external 'kernel32' name 'SetEvent';
+function ResetEvent(hEvent:HANDLE):WINBOOL; external 'kernel32' name 'ResetEvent';
+function PulseEvent(hEvent:HANDLE):WINBOOL; external 'kernel32' name 'PulseEvent';
+function ReleaseSemaphore(hSemaphore:HANDLE; lReleaseCount:LONG; lpPreviousCount:LPLONG):WINBOOL; external 'kernel32' name 'ReleaseSemaphore';
+function ReleaseMutex(hMutex:HANDLE):WINBOOL; external 'kernel32' name 'ReleaseMutex';
+function WaitForSingleObject(hHandle:HANDLE; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'WaitForSingleObject';
+function WaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'WaitForMultipleObjects';
+procedure Sleep(dwMilliseconds:DWORD); external 'kernel32' name 'Sleep';
+function LoadResource(hModule:HINST; hResInfo:HRSRC):HGLOBAL; external 'kernel32' name 'LoadResource';
+function SizeofResource(hModule:HINST; hResInfo:HRSRC):DWORD; external 'kernel32' name 'SizeofResource';
+function GlobalDeleteAtom(nAtom:ATOM):ATOM; external 'kernel32' name 'GlobalDeleteAtom';
+function InitAtomTable(nSize:DWORD):WINBOOL; external 'kernel32' name 'InitAtomTable';
+function DeleteAtom(nAtom:ATOM):ATOM; external 'kernel32' name 'DeleteAtom';
+function SetHandleCount(uNumber:UINT):UINT; external 'kernel32' name 'SetHandleCount';
+function GetLogicalDrives:DWORD; external 'kernel32' name 'GetLogicalDrives';
+function LockFile(hFile:HANDLE; dwFileOffsetLow:DWORD; dwFileOffsetHigh:DWORD; nNumberOfBytesToLockLow:DWORD; nNumberOfBytesToLockHigh:DWORD):WINBOOL; external 'kernel32' name 'LockFile';
+function UnlockFile(hFile:HANDLE; dwFileOffsetLow:DWORD; dwFileOffsetHigh:DWORD; nNumberOfBytesToUnlockLow:DWORD; nNumberOfBytesToUnlockHigh:DWORD):WINBOOL; external 'kernel32' name 'UnlockFile';
+function LockFileEx(hFile:HANDLE; dwFlags:DWORD; dwReserved:DWORD; nNumberOfBytesToLockLow:DWORD; nNumberOfBytesToLockHigh:DWORD;lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'LockFileEx';
+function UnlockFileEx(hFile:HANDLE; dwReserved:DWORD; nNumberOfBytesToUnlockLow:DWORD; nNumberOfBytesToUnlockHigh:DWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'UnlockFileEx';
+function GetFileInformationByHandle(hFile:HANDLE; lpFileInformation:LPBY_HANDLE_FILE_INFORMATION):WINBOOL; external 'kernel32' name 'GetFileInformationByHandle';
+function GetFileType(hFile:HANDLE):DWORD; external 'kernel32' name 'GetFileType';
+function GetFileSize(hFile:HANDLE; lpFileSizeHigh:LPDWORD):DWORD; external 'kernel32' name 'GetFileSize';
+function GetStdHandle(nStdHandle:DWORD):HANDLE; external 'kernel32' name 'GetStdHandle';
+function SetStdHandle(nStdHandle:DWORD; hHandle:HANDLE):WINBOOL; external 'kernel32' name 'SetStdHandle';
+function FlushFileBuffers(hFile:HANDLE):WINBOOL; external 'kernel32' name 'FlushFileBuffers';
+function DeviceIoControl(hDevice:HANDLE; dwIoControlCode:DWORD; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID;nOutBufferSize:DWORD; lpBytesReturned:LPDWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'DeviceIoControl';
+function SetEndOfFile(hFile:HANDLE):WINBOOL; external 'kernel32' name 'SetEndOfFile';
+function SetFilePointer(hFile:HANDLE; lDistanceToMove:LONG; lpDistanceToMoveHigh:PLONG; dwMoveMethod:DWORD):DWORD; external 'kernel32' name 'SetFilePointer';
+function FindClose(hFindFile:HANDLE):WINBOOL; external 'kernel32' name 'FindClose';
+function GetFileTime(hFile:HANDLE; lpCreationTime:LPFILETIME; lpLastAccessTime:LPFILETIME; lpLastWriteTime:LPFILETIME):WINBOOL; external 'kernel32' name 'GetFileTime';
+function SetFileTime(hFile:HANDLE; lpCreationTime:LPFILETIME; lpLastAccessTime:LPFILETIME; lpLastWriteTime:LPFILETIME):WINBOOL; external 'kernel32' name 'SetFileTime';
+function CloseHandle(hObject:HANDLE):WINBOOL; external 'kernel32' name 'CloseHandle';
+function DuplicateHandle(hSourceProcessHandle:HANDLE; hSourceHandle:HANDLE; hTargetProcessHandle:HANDLE; lpTargetHandle:LPHANDLE; dwDesiredAccess:DWORD;bInheritHandle:WINBOOL; dwOptions:DWORD):WINBOOL; external 'kernel32' name 'DuplicateHandle';
+function GetHandleInformation(hObject:HANDLE; lpdwFlags:LPDWORD):WINBOOL; external 'kernel32' name 'GetHandleInformation';
+function SetHandleInformation(hObject:HANDLE; dwMask:DWORD; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'SetHandleInformation';
+function LoadModule(lpModuleName:LPCSTR; lpParameterBlock:LPVOID):DWORD; external 'kernel32' name 'LoadModule';
+function WinExec(lpCmdLine:LPCSTR; uCmdShow:UINT):UINT; external 'kernel32' name 'WinExec';
+function ClearCommBreak(hFile:HANDLE):WINBOOL; external 'kernel32' name 'ClearCommBreak';
+function ClearCommError(hFile:HANDLE; lpErrors:LPDWORD; lpStat:LPCOMSTAT):WINBOOL; external 'kernel32' name 'ClearCommError';
+function SetupComm(hFile:HANDLE; dwInQueue:DWORD; dwOutQueue:DWORD):WINBOOL; external 'kernel32' name 'SetupComm';
+function EscapeCommFunction(hFile:HANDLE; dwFunc:DWORD):WINBOOL; external 'kernel32' name 'EscapeCommFunction';
+function GetCommConfig(hCommDev:HANDLE; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetCommConfig';
+function GetCommProperties(hFile:HANDLE; lpCommProp:LPCOMMPROP):WINBOOL; external 'kernel32' name 'GetCommProperties';
+function GetCommModemStatus(hFile:HANDLE; lpModemStat:PDWORD):WINBOOL; external 'kernel32' name 'GetCommModemStatus';
+function GetCommState(hFile:HANDLE; lpDCB:PDCB):WINBOOL; external 'kernel32' name 'GetCommState';
+function GetCommTimeouts(hFile:HANDLE; lpCommTimeouts:PCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'GetCommTimeouts';
+function PurgeComm(hFile:HANDLE; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'PurgeComm';
+function SetCommBreak(hFile:HANDLE):WINBOOL; external 'kernel32' name 'SetCommBreak';
+function SetCommConfig(hCommDev:HANDLE; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetCommConfig';
+function SetCommMask(hFile:HANDLE; dwEvtMask:DWORD):WINBOOL; external 'kernel32' name 'SetCommMask';
+function SetCommState(hFile:HANDLE; lpDCB:LPDCB):WINBOOL; external 'kernel32' name 'SetCommState';
+function SetCommTimeouts(hFile:HANDLE; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'SetCommTimeouts';
+function TransmitCommChar(hFile:HANDLE; cChar:char):WINBOOL; external 'kernel32' name 'TransmitCommChar';
+function WaitCommEvent(hFile:HANDLE; lpEvtMask:LPDWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'WaitCommEvent';
+function SetTapePosition(hDevice:HANDLE; dwPositionMethod:DWORD; dwPartition:DWORD; dwOffsetLow:DWORD; dwOffsetHigh:DWORD;bImmediate:WINBOOL):DWORD; external 'kernel32' name 'SetTapePosition';
+function GetTapePosition(hDevice:HANDLE; dwPositionType:DWORD; lpdwPartition:LPDWORD; lpdwOffsetLow:LPDWORD; lpdwOffsetHigh:LPDWORD):DWORD; external 'kernel32' name 'GetTapePosition';
+function PrepareTape(hDevice:HANDLE; dwOperation:DWORD; bImmediate:WINBOOL):DWORD; external 'kernel32' name 'PrepareTape';
+function EraseTape(hDevice:HANDLE; dwEraseType:DWORD; bImmediate:WINBOOL):DWORD; external 'kernel32' name 'EraseTape';
+function CreateTapePartition(hDevice:HANDLE; dwPartitionMethod:DWORD; dwCount:DWORD; dwSize:DWORD):DWORD; external 'kernel32' name 'CreateTapePartition';
+function WriteTapemark(hDevice:HANDLE; dwTapemarkType:DWORD; dwTapemarkCount:DWORD; bImmediate:WINBOOL):DWORD; external 'kernel32' name 'WriteTapemark';
+function GetTapeStatus(hDevice:HANDLE):DWORD; external 'kernel32' name 'GetTapeStatus';
+function GetTapeParameters(hDevice:HANDLE; dwOperation:DWORD; lpdwSize:LPDWORD; lpTapeInformation:LPVOID):DWORD; external 'kernel32' name 'GetTapeParameters';
+function SetTapeParameters(hDevice:HANDLE; dwOperation:DWORD; lpTapeInformation:LPVOID):DWORD; external 'kernel32' name 'SetTapeParameters';
+function Beep(dwFreq:DWORD; dwDuration:DWORD):WINBOOL; external 'kernel32' name 'Beep';
+{$ifdef Unknown_functions}
+{ WARNING: functions not found !!}
+procedure OpenSound; external External_library name 'OpenSound';
+procedure CloseSound; external External_library name 'CloseSound';
+procedure StartSound; external External_library name 'StartSound';
+procedure StopSound; external External_library name 'StopSound';
+function WaitSoundState(nState:DWORD):DWORD; external External_library name 'WaitSoundState';
+function SyncAllVoices:DWORD; external External_library name 'SyncAllVoices';
+function CountVoiceNotes(nVoice:DWORD):DWORD; external External_library name 'CountVoiceNotes';
+function GetThresholdEvent:LPDWORD; external External_library name 'GetThresholdEvent';
+function GetThresholdStatus:DWORD; external External_library name 'GetThresholdStatus';
+function SetSoundNoise(nSource:DWORD; nDuration:DWORD):DWORD; external External_library name 'SetSoundNoise';
+function SetVoiceAccent(nVoice:DWORD; nTempo:DWORD; nVolume:DWORD; nMode:DWORD; nPitch:DWORD):DWORD; external External_library name 'SetVoiceAccent';
+function SetVoiceEnvelope(nVoice:DWORD; nShape:DWORD; nRepeat:DWORD):DWORD; external External_library name 'SetVoiceEnvelope';
+function SetVoiceNote(nVoice:DWORD; nValue:DWORD; nLength:DWORD; nCdots:DWORD):DWORD; external External_library name 'SetVoiceNote';
+function SetVoiceQueueSize(nVoice:DWORD; nBytes:DWORD):DWORD; external External_library name 'SetVoiceQueueSize';
+function SetVoiceSound(nVoice:DWORD; Frequency:DWORD; nDuration:DWORD):DWORD; external External_library name 'SetVoiceSound';
+function SetVoiceThreshold(nVoice:DWORD; nNotes:DWORD):DWORD; external External_library name 'SetVoiceThreshold';
+{$endif Unknown_functions}
+function MulDiv(nNumber:longint; nNumerator:longint; nDenominator:longint):longint; external 'kernel32' name 'MulDiv';
+procedure GetSystemTime(lpSystemTime:LPSYSTEMTIME); external 'kernel32' name 'GetSystemTime';
+procedure GetSystemTimeAsFileTime(lpSystemTimeAsFileTime:LPFILETIME); external 'kernel32' name 'GetSystemTimeAsFileTime';
+function SetSystemTime(lpSystemTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'SetSystemTime';
+procedure GetLocalTime(lpSystemTime:LPSYSTEMTIME); external 'kernel32' name 'GetLocalTime';
+function SetLocalTime(lpSystemTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'SetLocalTime';
+procedure GetSystemInfo(lpSystemInfo:LPSYSTEM_INFO); external 'kernel32' name 'GetSystemInfo';
+function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION; lpUniversalTime:LPSYSTEMTIME; lpLocalTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'SystemTimeToTzSpecificLocalTime';
+function GetTimeZoneInformation(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION):DWORD; external 'kernel32' name 'GetTimeZoneInformation';
+function SetTimeZoneInformation(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION):WINBOOL; external 'kernel32' name 'SetTimeZoneInformation';
+function SystemTimeToFileTime(lpSystemTime:LPSYSTEMTIME; lpFileTime:LPFILETIME):WINBOOL; external 'kernel32' name 'SystemTimeToFileTime';
+function FileTimeToLocalFileTime(lpFileTime:LPFILETIME; lpLocalFileTime:LPFILETIME):WINBOOL; external 'kernel32' name 'FileTimeToLocalFileTime';
+function LocalFileTimeToFileTime(lpLocalFileTime:LPFILETIME; lpFileTime:LPFILETIME):WINBOOL; external 'kernel32' name 'LocalFileTimeToFileTime';
+function FileTimeToSystemTime(lpFileTime:LPFILETIME; lpSystemTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'FileTimeToSystemTime';
+function CompareFileTime(lpFileTime1:LPFILETIME; lpFileTime2:LPFILETIME):LONG; external 'kernel32' name 'CompareFileTime';
+function FileTimeToDosDateTime(lpFileTime:LPFILETIME; lpFatDate:LPWORD; lpFatTime:LPWORD):WINBOOL; external 'kernel32' name 'FileTimeToDosDateTime';
+function DosDateTimeToFileTime(wFatDate:WORD; wFatTime:WORD; lpFileTime:LPFILETIME):WINBOOL; external 'kernel32' name 'DosDateTimeToFileTime';
+function GetTickCount:DWORD; external 'kernel32' name 'GetTickCount';
+function SetSystemTimeAdjustment(dwTimeAdjustment:DWORD; bTimeAdjustmentDisabled:WINBOOL):WINBOOL; external 'kernel32' name 'SetSystemTimeAdjustment';
+function GetSystemTimeAdjustment(lpTimeAdjustment:PDWORD; lpTimeIncrement:PDWORD; lpTimeAdjustmentDisabled:PWINBOOL):WINBOOL; external 'kernel32' name 'GetSystemTimeAdjustment';
+function CreatePipe(hReadPipe:PHANDLE; hWritePipe:PHANDLE; lpPipeAttributes:LPSECURITY_ATTRIBUTES; nSize:DWORD):WINBOOL; external 'kernel32' name 'CreatePipe';
+function ConnectNamedPipe(hNamedPipe:HANDLE; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'ConnectNamedPipe';
+function DisconnectNamedPipe(hNamedPipe:HANDLE):WINBOOL; external 'kernel32' name 'DisconnectNamedPipe';
+function SetNamedPipeHandleState(hNamedPipe:HANDLE; lpMode:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD):WINBOOL; external 'kernel32' name 'SetNamedPipeHandleState';
+function GetNamedPipeInfo(hNamedPipe:HANDLE; lpFlags:LPDWORD; lpOutBufferSize:LPDWORD; lpInBufferSize:LPDWORD; lpMaxInstances:LPDWORD):WINBOOL; external 'kernel32' name 'GetNamedPipeInfo';
+function PeekNamedPipe(hNamedPipe:HANDLE; lpBuffer:LPVOID; nBufferSize:DWORD; lpBytesRead:LPDWORD; lpTotalBytesAvail:LPDWORD;lpBytesLeftThisMessage:LPDWORD):WINBOOL; external 'kernel32' name 'PeekNamedPipe';
+function TransactNamedPipe(hNamedPipe:HANDLE; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'TransactNamedPipe';
+function GetMailslotInfo(hMailslot:HANDLE; lpMaxMessageSize:LPDWORD; lpNextSize:LPDWORD; lpMessageCount:LPDWORD; lpReadTimeout:LPDWORD):WINBOOL; external 'kernel32' name 'GetMailslotInfo';
+function SetMailslotInfo(hMailslot:HANDLE; lReadTimeout:DWORD):WINBOOL; external 'kernel32' name 'SetMailslotInfo';
+function MapViewOfFile(hFileMappingObject:HANDLE; dwDesiredAccess:DWORD; dwFileOffsetHigh:DWORD; dwFileOffsetLow:DWORD; dwNumberOfBytesToMap:DWORD):LPVOID; external 'kernel32' name 'MapViewOfFile';
+function FlushViewOfFile(lpBaseAddress:LPCVOID; dwNumberOfBytesToFlush:DWORD):WINBOOL; external 'kernel32' name 'FlushViewOfFile';
+function UnmapViewOfFile(lpBaseAddress:LPVOID):WINBOOL; external 'kernel32' name 'UnmapViewOfFile';
+function OpenFile(lpFileName:LPCSTR; lpReOpenBuff:LPOFSTRUCT; uStyle:UINT):HFILE; external 'kernel32' name 'OpenFile';
+function _lopen(lpPathName:LPCSTR; iReadWrite:longint):HFILE; external 'kernel32' name '_lopen';
+function _lcreat(lpPathName:LPCSTR; iAttribute:longint):HFILE; external 'kernel32' name '_lcreat';
+function _lread(hFile:HFILE; lpBuffer:LPVOID; uBytes:UINT):UINT; external 'kernel32' name '_lread';
+function _lwrite(hFile:HFILE; lpBuffer:LPCSTR; uBytes:UINT):UINT; external 'kernel32' name '_lwrite';
+function _hread(hFile:HFILE; lpBuffer:LPVOID; lBytes:longint):longint; external 'kernel32' name '_hread';
+function _hwrite(hFile:HFILE; lpBuffer:LPCSTR; lBytes:longint):longint; external 'kernel32' name '_hwrite';
+function _lclose(hFile:HFILE):HFILE; external 'kernel32' name '_lclose';
+function _llseek(hFile:HFILE; lOffset:LONG; iOrigin:longint):LONG; external 'kernel32' name '_llseek';
+function IsTextUnicode(lpBuffer:LPVOID; cb:longint; lpi:LPINT):WINBOOL; external 'advapi32' name 'IsTextUnicode';
+function TlsAlloc:DWORD; external 'kernel32' name 'TlsAlloc';
+function TlsGetValue(dwTlsIndex:DWORD):LPVOID; external 'kernel32' name 'TlsGetValue';
+function TlsSetValue(dwTlsIndex:DWORD; lpTlsValue:LPVOID):WINBOOL; external 'kernel32' name 'TlsSetValue';
+function TlsFree(dwTlsIndex:DWORD):WINBOOL; external 'kernel32' name 'TlsFree';
+function SleepEx(dwMilliseconds:DWORD; bAlertable:WINBOOL):DWORD; external 'kernel32' name 'SleepEx';
+function WaitForSingleObjectEx(hHandle:HANDLE; dwMilliseconds:DWORD; bAlertable:WINBOOL):DWORD; external 'kernel32' name 'WaitForSingleObjectEx';
+function WaitForMultipleObjectsEx(nCount:DWORD; lpHandles:LPHANDLE; bWaitAll:WINBOOL; dwMilliseconds:DWORD; bAlertable:WINBOOL):DWORD; external 'kernel32' name 'WaitForMultipleObjectsEx';
+function ReadFileEx(hFile:HANDLE; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD; lpOverlapped:LPOVERLAPPED; lpCompletionRoutine:LPOVERLAPPED_COMPLETION_ROUTINE):WINBOOL; external 'kernel32' name 'ReadFileEx';
+function WriteFileEx(hFile:HANDLE; lpBuffer:LPCVOID; nNumberOfBytesToWrite:DWORD; lpOverlapped:LPOVERLAPPED; lpCompletionRoutine:LPOVERLAPPED_COMPLETION_ROUTINE):WINBOOL; external 'kernel32' name 'WriteFileEx';
+function BackupRead(hFile:HANDLE; lpBuffer:LPBYTE; nNumberOfBytesToRead:DWORD; lpNumberOfBytesRead:LPDWORD; bAbort:WINBOOL;bProcessSecurity:WINBOOL; var lpContext:LPVOID):WINBOOL; external 'kernel32' name 'BackupRead';
+function BackupSeek(hFile:HANDLE; dwLowBytesToSeek:DWORD; dwHighBytesToSeek:DWORD; lpdwLowByteSeeked:LPDWORD; lpdwHighByteSeeked:LPDWORD;var lpContext:LPVOID):WINBOOL; external 'kernel32' name 'BackupSeek';
+function BackupWrite(hFile:HANDLE; lpBuffer:LPBYTE; nNumberOfBytesToWrite:DWORD; lpNumberOfBytesWritten:LPDWORD; bAbort:WINBOOL;bProcessSecurity:WINBOOL; var lpContext:LPVOID):WINBOOL; external 'kernel32' name 'BackupWrite';
+function SetProcessShutdownParameters(dwLevel:DWORD; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'SetProcessShutdownParameters';
+function GetProcessShutdownParameters(lpdwLevel:LPDWORD; lpdwFlags:LPDWORD):WINBOOL; external 'kernel32' name 'GetProcessShutdownParameters';
+procedure SetFileApisToOEM; external 'kernel32' name 'SetFileApisToOEM';
+procedure SetFileApisToANSI; external 'kernel32' name 'SetFileApisToANSI';
+function AreFileApisANSI:WINBOOL; external 'kernel32' name 'AreFileApisANSI';
+function CloseEventLog(hEventLog:HANDLE):WINBOOL; external 'advapi32' name 'CloseEventLog';
+function DeregisterEventSource(hEventLog:HANDLE):WINBOOL; external 'advapi32' name 'DeregisterEventSource';
+function NotifyChangeEventLog(hEventLog:HANDLE; hEvent:HANDLE):WINBOOL; external 'advapi32' name 'NotifyChangeEventLog';
+function GetNumberOfEventLogRecords(hEventLog:HANDLE; NumberOfRecords:PDWORD):WINBOOL; external 'advapi32' name 'GetNumberOfEventLogRecords';
+function GetOldestEventLogRecord(hEventLog:HANDLE; OldestRecord:PDWORD):WINBOOL; external 'advapi32' name 'GetOldestEventLogRecord';
+function DuplicateToken(ExistingTokenHandle:HANDLE; ImpersonationLevel:SECURITY_IMPERSONATION_LEVEL; DuplicateTokenHandle:PHANDLE):WINBOOL; external 'advapi32' name 'DuplicateToken';
+function GetKernelObjectSecurity(Handle:HANDLE; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetKernelObjectSecurity';
+function ImpersonateNamedPipeClient(hNamedPipe:HANDLE):WINBOOL; external 'advapi32' name 'ImpersonateNamedPipeClient';
+function ImpersonateLoggedOnUser(hToken:HANDLE):WINBOOL; external 'advapi32' name 'ImpersonateLoggedOnUser';
+function ImpersonateSelf(ImpersonationLevel:SECURITY_IMPERSONATION_LEVEL):WINBOOL; external 'advapi32' name 'ImpersonateSelf';
+function RevertToSelf:WINBOOL; external 'advapi32' name 'RevertToSelf';
+function SetThreadToken(Thread:PHANDLE; Token:HANDLE):WINBOOL; external 'advapi32' name 'SetThreadToken';
+{ function AccessCheck(pSecurityDescriptor:PSECURITY_DESCRIPTOR; ClientToken:HANDLE; DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; PrivilegeSet:PPRIVILEGE_SET;PrivilegeSetLength:LPDWORD;
+ GrantedAccess:LPDWORD; AccessStatus:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheck';
+}
+function OpenProcessToken(ProcessHandle:HANDLE; DesiredAccess:DWORD; TokenHandle:PHANDLE):WINBOOL; external 'advapi32' name 'OpenProcessToken';
+function OpenThreadToken(ThreadHandle:HANDLE; DesiredAccess:DWORD; OpenAsSelf:WINBOOL; TokenHandle:PHANDLE):WINBOOL; external 'advapi32' name 'OpenThreadToken';
+function GetTokenInformation(TokenHandle:HANDLE; TokenInformationClass:TOKEN_INFORMATION_CLASS; TokenInformation:LPVOID; TokenInformationLength:DWORD; ReturnLength:PDWORD):WINBOOL; external 'advapi32' name 'GetTokenInformation';
+function SetTokenInformation(TokenHandle:HANDLE; TokenInformationClass:TOKEN_INFORMATION_CLASS; TokenInformation:LPVOID; TokenInformationLength:DWORD):WINBOOL; external 'advapi32' name 'SetTokenInformation';
+function AdjustTokenPrivileges(TokenHandle:HANDLE; DisableAllPrivileges:WINBOOL; NewState:PTOKEN_PRIVILEGES; BufferLength:DWORD; PreviousState:PTOKEN_PRIVILEGES;ReturnLength:PDWORD):WINBOOL; external 'advapi32' name 'AdjustTokenPrivileges';
+function AdjustTokenGroups(TokenHandle:HANDLE; ResetToDefault:WINBOOL; NewState:PTOKEN_GROUPS; BufferLength:DWORD; PreviousState:PTOKEN_GROUPS;ReturnLength:PDWORD):WINBOOL; external 'advapi32' name 'AdjustTokenGroups';
+function PrivilegeCheck(ClientToken:HANDLE; RequiredPrivileges:PPRIVILEGE_SET; pfResult:LPBOOL):WINBOOL; external 'advapi32' name 'PrivilegeCheck';
+function IsValidSid(pSid:PSID):WINBOOL; external 'advapi32' name 'IsValidSid';
+function EqualSid(pSid1:PSID; pSid2:PSID):WINBOOL; external 'advapi32' name 'EqualSid';
+function EqualPrefixSid(pSid1:PSID; pSid2:PSID):WINBOOL; external 'advapi32' name 'EqualPrefixSid';
+function GetSidLengthRequired(nSubAuthorityCount:UCHAR):DWORD; external 'advapi32' name 'GetSidLengthRequired';
+function AllocateAndInitializeSid(pIdentifierAuthority:PSID_IDENTIFIER_AUTHORITY; nSubAuthorityCount:BYTE; nSubAuthority0:DWORD; nSubAuthority1:DWORD; nSubAuthority2:DWORD;nSubAuthority3:DWORD; nSubAuthority4:DWORD;
+ nSubAuthority5:DWORD; nSubAuthority6:DWORD; nSubAuthority7:DWORD;var pSid:PSID):WINBOOL; external 'advapi32' name 'AllocateAndInitializeSid';
+function FreeSid(pSid:PSID):PVOID; external 'advapi32' name 'FreeSid';
+function InitializeSid(Sid:PSID; pIdentifierAuthority:PSID_IDENTIFIER_AUTHORITY; nSubAuthorityCount:BYTE):WINBOOL; external 'advapi32' name 'InitializeSid';
+function GetSidIdentifierAuthority(pSid:PSID):PSID_IDENTIFIER_AUTHORITY; external 'advapi32' name 'GetSidIdentifierAuthority';
+function GetSidSubAuthority(pSid:PSID; nSubAuthority:DWORD):PDWORD; external 'advapi32' name 'GetSidSubAuthority';
+function GetSidSubAuthorityCount(pSid:PSID):PUCHAR; external 'advapi32' name 'GetSidSubAuthorityCount';
+function GetLengthSid(pSid:PSID):DWORD; external 'advapi32' name 'GetLengthSid';
+function CopySid(nDestinationSidLength:DWORD; pDestinationSid:PSID; pSourceSid:PSID):WINBOOL; external 'advapi32' name 'CopySid';
+function AreAllAccessesGranted(GrantedAccess:DWORD; DesiredAccess:DWORD):WINBOOL; external 'advapi32' name 'AreAllAccessesGranted';
+function AreAnyAccessesGranted(GrantedAccess:DWORD; DesiredAccess:DWORD):WINBOOL; external 'advapi32' name 'AreAnyAccessesGranted';
+procedure MapGenericMask(AccessMask:PDWORD; GenericMapping:PGENERIC_MAPPING); external 'advapi32' name 'MapGenericMask';
+function IsValidAcl(pAcl:PACL):WINBOOL; external 'advapi32' name 'IsValidAcl';
+function InitializeAcl(pAcl:PACL; nAclLength:DWORD; dwAclRevision:DWORD):WINBOOL; external 'advapi32' name 'InitializeAcl';
+function GetAclInformation(pAcl:PACL; pAclInformation:LPVOID; nAclInformationLength:DWORD; dwAclInformationClass:ACL_INFORMATION_CLASS):WINBOOL; external 'advapi32' name 'GetAclInformation';
+function SetAclInformation(pAcl:PACL; pAclInformation:LPVOID; nAclInformationLength:DWORD; dwAclInformationClass:ACL_INFORMATION_CLASS):WINBOOL; external 'advapi32' name 'SetAclInformation';
+function AddAce(pAcl:PACL; dwAceRevision:DWORD; dwStartingAceIndex:DWORD; pAceList:LPVOID; nAceListLength:DWORD):WINBOOL; external 'advapi32' name 'AddAce';
+function DeleteAce(pAcl:PACL; dwAceIndex:DWORD):WINBOOL; external 'advapi32' name 'DeleteAce';
+function GetAce(pAcl:PACL; dwAceIndex:DWORD; var pAce:LPVOID):WINBOOL; external 'advapi32' name 'GetAce';
+function AddAccessAllowedAce(pAcl:PACL; dwAceRevision:DWORD; AccessMask:DWORD; pSid:PSID):WINBOOL; external 'advapi32' name 'AddAccessAllowedAce';
+function AddAccessDeniedAce(pAcl:PACL; dwAceRevision:DWORD; AccessMask:DWORD; pSid:PSID):WINBOOL; external 'advapi32' name 'AddAccessDeniedAce';
+function AddAuditAccessAce(pAcl:PACL; dwAceRevision:DWORD; dwAccessMask:DWORD; pSid:PSID; bAuditSuccess:WINBOOL;bAuditFailure:WINBOOL):WINBOOL; external 'advapi32' name 'AddAuditAccessAce';
+function FindFirstFreeAce(pAcl:PACL; var pAce:LPVOID):WINBOOL; external 'advapi32' name 'FindFirstFreeAce';
+function InitializeSecurityDescriptor(pSecurityDescriptor:PSECURITY_DESCRIPTOR; dwRevision:DWORD):WINBOOL; external 'advapi32' name 'InitializeSecurityDescriptor';
+function IsValidSecurityDescriptor(pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'IsValidSecurityDescriptor';
+function GetSecurityDescriptorLength(pSecurityDescriptor:PSECURITY_DESCRIPTOR):DWORD; external 'advapi32' name 'GetSecurityDescriptorLength';
+function GetSecurityDescriptorControl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; pControl:PSECURITY_DESCRIPTOR_CONTROL; lpdwRevision:LPDWORD):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorControl';
+function SetSecurityDescriptorDacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; bDaclPresent:WINBOOL; pDacl:PACL; bDaclDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorDacl';
+function GetSecurityDescriptorDacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; lpbDaclPresent:LPBOOL; var pDacl:PACL; lpbDaclDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorDacl';
+function SetSecurityDescriptorSacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; bSaclPresent:WINBOOL; pSacl:PACL; bSaclDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorSacl';
+function GetSecurityDescriptorSacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; lpbSaclPresent:LPBOOL; var pSacl:PACL; lpbSaclDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorSacl';
+function SetSecurityDescriptorOwner(pSecurityDescriptor:PSECURITY_DESCRIPTOR; pOwner:PSID; bOwnerDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorOwner';
+function GetSecurityDescriptorOwner(pSecurityDescriptor:PSECURITY_DESCRIPTOR; var pOwner:PSID; lpbOwnerDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorOwner';
+function SetSecurityDescriptorGroup(pSecurityDescriptor:PSECURITY_DESCRIPTOR; pGroup:PSID; bGroupDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorGroup';
+function GetSecurityDescriptorGroup(pSecurityDescriptor:PSECURITY_DESCRIPTOR; var pGroup:PSID; lpbGroupDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorGroup';
+function CreatePrivateObjectSecurity(ParentDescriptor:PSECURITY_DESCRIPTOR; CreatorDescriptor:PSECURITY_DESCRIPTOR; var NewDescriptor:PSECURITY_DESCRIPTOR;
+ IsDirectoryObject:WINBOOL; Token:HANDLE;GenericMapping:PGENERIC_MAPPING):WINBOOL; external 'advapi32' name 'CreatePrivateObjectSecurity';
+function SetPrivateObjectSecurity(SecurityInformation:SECURITY_INFORMATION; ModificationDescriptor:PSECURITY_DESCRIPTOR; var ObjectsSecurityDescriptor:PSECURITY_DESCRIPTOR; GenericMapping:PGENERIC_MAPPING; Token:HANDLE):WINBOOL;
+ external 'advapi32' name 'SetPrivateObjectSecurity';
+function GetPrivateObjectSecurity(ObjectDescriptor:PSECURITY_DESCRIPTOR; SecurityInformation:SECURITY_INFORMATION; ResultantDescriptor:PSECURITY_DESCRIPTOR;
+ DescriptorLength:DWORD; ReturnLength:PDWORD):WINBOOL;external 'advapi32' name 'GetPrivateObjectSecurity';
+function DestroyPrivateObjectSecurity(ObjectDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'DestroyPrivateObjectSecurity';
+function MakeSelfRelativeSD(pAbsoluteSecurityDescriptor:PSECURITY_DESCRIPTOR; pSelfRelativeSecurityDescriptor:PSECURITY_DESCRIPTOR; lpdwBufferLength:LPDWORD):WINBOOL; external 'advapi32' name 'MakeSelfRelativeSD';
+function MakeAbsoluteSD(pSelfRelativeSecurityDescriptor:PSECURITY_DESCRIPTOR; pAbsoluteSecurityDescriptor:PSECURITY_DESCRIPTOR; lpdwAbsoluteSecurityDescriptorSize:LPDWORD; pDacl:PACL; lpdwDaclSize:LPDWORD;pSacl:PACL;
+ lpdwSaclSize:LPDWORD; pOwner:PSID; lpdwOwnerSize:LPDWORD; pPrimaryGroup:PSID;lpdwPrimaryGroupSize:LPDWORD):WINBOOL; external 'advapi32' name 'MakeAbsoluteSD';
+function SetKernelObjectSecurity(Handle:HANDLE; SecurityInformation:SECURITY_INFORMATION; SecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetKernelObjectSecurity';
+function FindNextChangeNotification(hChangeHandle:HANDLE):WINBOOL; external 'kernel32' name 'FindNextChangeNotification';
+function FindCloseChangeNotification(hChangeHandle:HANDLE):WINBOOL; external 'kernel32' name 'FindCloseChangeNotification';
+function VirtualLock(lpAddress:LPVOID; dwSize:DWORD):WINBOOL; external 'kernel32' name 'VirtualLock';
+function VirtualUnlock(lpAddress:LPVOID; dwSize:DWORD):WINBOOL; external 'kernel32' name 'VirtualUnlock';
+function MapViewOfFileEx(hFileMappingObject:HANDLE; dwDesiredAccess:DWORD; dwFileOffsetHigh:DWORD; dwFileOffsetLow:DWORD; dwNumberOfBytesToMap:DWORD;lpBaseAddress:LPVOID):LPVOID; external 'kernel32' name 'MapViewOfFileEx';
+function SetPriorityClass(hProcess:HANDLE; dwPriorityClass:DWORD):WINBOOL; external 'kernel32' name 'SetPriorityClass';
+function GetPriorityClass(hProcess:HANDLE):DWORD; external 'kernel32' name 'GetPriorityClass';
+function IsBadReadPtr(lp:pointer; ucb:UINT):WINBOOL; external 'kernel32' name 'IsBadReadPtr';
+function IsBadWritePtr(lp:LPVOID; ucb:UINT):WINBOOL; external 'kernel32' name 'IsBadWritePtr';
+function IsBadHugeReadPtr(lp:pointer; ucb:UINT):WINBOOL; external 'kernel32' name 'IsBadHugeReadPtr';
+function IsBadHugeWritePtr(lp:LPVOID; ucb:UINT):WINBOOL; external 'kernel32' name 'IsBadHugeWritePtr';
+function IsBadCodePtr(lpfn:FARPROC):WINBOOL; external 'kernel32' name 'IsBadCodePtr';
+function AllocateLocallyUniqueId(Luid:PLUID):WINBOOL; external 'advapi32' name 'AllocateLocallyUniqueId';
+function QueryPerformanceCounter(lpPerformanceCount:PLARGE_INTEGER):WINBOOL; external 'kernel32' name 'QueryPerformanceCounter';
+function QueryPerformanceFrequency(lpFrequency:PLARGE_INTEGER):WINBOOL; external 'kernel32' name 'QueryPerformanceFrequency';
+procedure MoveMemory(Destination:PVOID; Source:pointer; Length:DWORD);
+procedure CopyMemory(Destination:PVOID; Source:pointer; Length:DWORD);
+procedure FillMemory(Destination:PVOID; Length:DWORD; Fill:BYTE);
+procedure ZeroMemory(Destination:PVOID; Length:DWORD);
+{$ifdef WIN95}
+function ActivateKeyboardLayout(hkl:HKL; Flags:UINT):HKL; external 'user32' name 'ActivateKeyboardLayout';
+{$else}
+function ActivateKeyboardLayout(hkl:HKL; Flags:UINT):WINBOOL; external 'user32' name 'ActivateKeyboardLayout';
+{$endif}
+function UnloadKeyboardLayout(hkl:HKL):WINBOOL; external 'user32' name 'UnloadKeyboardLayout';
+function GetKeyboardLayoutList(nBuff:longint; var lpList:HKL):longint; external 'user32' name 'GetKeyboardLayoutList';
+function GetKeyboardLayout(dwLayout:DWORD):HKL; external 'user32' name 'GetKeyboardLayout';
+function OpenInputDesktop(dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenInputDesktop';
+function EnumDesktopWindows(hDesktop:HDESK; lpfn:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopWindows';
+function SwitchDesktop(hDesktop:HDESK):WINBOOL; external 'user32' name 'SwitchDesktop';
+function SetThreadDesktop(hDesktop:HDESK):WINBOOL; external 'user32' name 'SetThreadDesktop';
+function CloseDesktop(hDesktop:HDESK):WINBOOL; external 'user32' name 'CloseDesktop';
+function GetThreadDesktop(dwThreadId:DWORD):HDESK; external 'user32' name 'GetThreadDesktop';
+function CloseWindowStation(hWinSta:HWINSTA):WINBOOL; external 'user32' name 'CloseWindowStation';
+function SetProcessWindowStation(hWinSta:HWINSTA):WINBOOL; external 'user32' name 'SetProcessWindowStation';
+function GetProcessWindowStation:HWINSTA; external 'user32' name 'GetProcessWindowStation';
+function SetUserObjectSecurity(hObj:HANDLE; pSIRequested:PSECURITY_INFORMATION; pSID:PSECURITY_DESCRIPTOR):WINBOOL; external 'user32' name 'SetUserObjectSecurity';
+
+function GetUserObjectSecurity(hObj:HANDLE; pSIRequested:PSECURITY_INFORMATION; pSID:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectSecurity';
+function TranslateMessage(lpMsg:LPMSG):WINBOOL; external 'user32' name 'TranslateMessage';
+function SetMessageQueue(cMessagesMax:longint):WINBOOL; external 'user32' name 'SetMessageQueue';
+function RegisterHotKey(hWnd:HWND; anID:longint; fsModifiers:UINT; vk:UINT):WINBOOL; external 'user32' name 'RegisterHotKey';
+function UnregisterHotKey(hWnd:HWND; anID:longint):WINBOOL; external 'user32' name 'UnregisterHotKey';
+function ExitWindowsEx(uFlags:UINT; dwReserved:DWORD):WINBOOL; external 'user32' name 'ExitWindowsEx';
+function SwapMouseButton(fSwap:WINBOOL):WINBOOL; external 'user32' name 'SwapMouseButton';
+function GetMessagePos:DWORD; external 'user32' name 'GetMessagePos';
+function GetMessageTime:LONG; external 'user32' name 'GetMessageTime';
+function GetMessageExtraInfo:LONG; external 'user32' name 'GetMessageExtraInfo';
+function SetMessageExtraInfo(lParam:LPARAM):LPARAM; external 'user32' name 'SetMessageExtraInfo';
+function BroadcastSystemMessage(_para1:DWORD; _para2:LPDWORD; _para3:UINT; _para4:WPARAM; _para5:LPARAM):longint; external 'user32' name 'BroadcastSystemMessage';
+function AttachThreadInput(idAttach:DWORD; idAttachTo:DWORD; fAttach:WINBOOL):WINBOOL; external 'user32' name 'AttachThreadInput';
+function ReplyMessage(lResult:LRESULT):WINBOOL; external 'user32' name 'ReplyMessage';
+function WaitMessage:WINBOOL; external 'user32' name 'WaitMessage';
+function WaitForInputIdle(hProcess:HANDLE; dwMilliseconds:DWORD):DWORD; external 'user32' name 'WaitForInputIdle';
+procedure PostQuitMessage(nExitCode:longint); external 'user32' name 'PostQuitMessage';
+function InSendMessage:WINBOOL; external 'user32' name 'InSendMessage';
+function GetDoubleClickTime:UINT; external 'user32' name 'GetDoubleClickTime';
+function SetDoubleClickTime(_para1:UINT):WINBOOL; external 'user32' name 'SetDoubleClickTime';
+function IsWindow(hWnd:HWND):WINBOOL; external 'user32' name 'IsWindow';
+function IsMenu(hMenu:HMENU):WINBOOL; external 'user32' name 'IsMenu';
+function IsChild(hWndParent:HWND; hWnd:HWND):WINBOOL; external 'user32' name 'IsChild';
+function DestroyWindow(hWnd:HWND):WINBOOL; external 'user32' name 'DestroyWindow';
+function ShowWindow(hWnd:HWND; nCmdShow:longint):WINBOOL; external 'user32' name 'ShowWindow';
+function ShowWindowAsync(hWnd:HWND; nCmdShow:longint):WINBOOL; external 'user32' name 'ShowWindowAsync';
+function FlashWindow(hWnd:HWND; bInvert:WINBOOL):WINBOOL; external 'user32' name 'FlashWindow';
+function ShowOwnedPopups(hWnd:HWND; fShow:WINBOOL):WINBOOL; external 'user32' name 'ShowOwnedPopups';
+function OpenIcon(hWnd:HWND):WINBOOL; external 'user32' name 'OpenIcon';
+function CloseWindow(hWnd:HWND):WINBOOL; external 'user32' name 'CloseWindow';
+function MoveWindow(hWnd:HWND; X:longint; Y:longint; nWidth:longint; nHeight:longint;bRepaint:WINBOOL):WINBOOL; external 'user32' name 'MoveWindow';
+function SetWindowPos(hWnd:HWND; hWndInsertAfter:HWND; X:longint; Y:longint; cx:longint;cy:longint; uFlags:UINT):WINBOOL; external 'user32' name 'SetWindowPos';
+function GetWindowPlacement(hWnd:HWND; var lpwndpl:WINDOWPLACEMENT):WINBOOL; external 'user32' name 'GetWindowPlacement';
+function SetWindowPlacement(hWnd:HWND; var lpwndpl:WINDOWPLACEMENT):WINBOOL; external 'user32' name 'SetWindowPlacement';
+function GetWindowPlacement(hWnd:HWND; lpwndpl:PWINDOWPLACEMENT):WINBOOL; external 'user32' name 'GetWindowPlacement';
+function SetWindowPlacement(hWnd:HWND; lpwndpl:PWINDOWPLACEMENT):WINBOOL; external 'user32' name 'SetWindowPlacement';
+function BeginDeferWindowPos(nNumWindows:longint):HDWP; external 'user32' name 'BeginDeferWindowPos';
+function DeferWindowPos(hWinPosInfo:HDWP; hWnd:HWND; hWndInsertAfter:HWND; x:longint; y:longint;cx:longint; cy:longint; uFlags:UINT):HDWP; external 'user32' name 'DeferWindowPos';
+function EndDeferWindowPos(hWinPosInfo:HDWP):WINBOOL; external 'user32' name 'EndDeferWindowPos';
+function IsWindowVisible(hWnd:HWND):WINBOOL; external 'user32' name 'IsWindowVisible';
+function IsIconic(hWnd:HWND):WINBOOL; external 'user32' name 'IsIconic';
+function AnyPopup:WINBOOL; external 'user32' name 'AnyPopup';
+function BringWindowToTop(hWnd:HWND):WINBOOL; external 'user32' name 'BringWindowToTop';
+function IsZoomed(hWnd:HWND):WINBOOL; external 'user32' name 'IsZoomed';
+function EndDialog(hDlg:HWND; nResult:longint):WINBOOL; external 'user32' name 'EndDialog';
+function GetDlgItem(hDlg:HWND; nIDDlgItem:longint):HWND; external 'user32' name 'GetDlgItem';
+function SetDlgItemInt(hDlg:HWND; nIDDlgItem:longint; uValue:UINT; bSigned:WINBOOL):WINBOOL; external 'user32' name 'SetDlgItemInt';
+function GetDlgItemInt(hDlg:HWND; nIDDlgItem:longint; var lpTranslated:WINBOOL; bSigned:WINBOOL):UINT; external 'user32' name 'GetDlgItemInt';
+function CheckDlgButton(hDlg:HWND; nIDButton:longint; uCheck:UINT):WINBOOL; external 'user32' name 'CheckDlgButton';
+function CheckRadioButton(hDlg:HWND; nIDFirstButton:longint; nIDLastButton:longint; nIDCheckButton:longint):WINBOOL; external 'user32' name 'CheckRadioButton';
+function IsDlgButtonChecked(hDlg:HWND; nIDButton:longint):UINT; external 'user32' name 'IsDlgButtonChecked';
+function GetNextDlgGroupItem(hDlg:HWND; hCtl:HWND; bPrevious:WINBOOL):HWND; external 'user32' name 'GetNextDlgGroupItem';
+function GetNextDlgTabItem(hDlg:HWND; hCtl:HWND; bPrevious:WINBOOL):HWND; external 'user32' name 'GetNextDlgTabItem';
+function GetDlgCtrlID(hWnd:HWND):longint; external 'user32' name 'GetDlgCtrlID';
+function GetDialogBaseUnits:longint; external 'user32' name 'GetDialogBaseUnits';
+function OpenClipboard(hWndNewOwner:HWND):WINBOOL; external 'user32' name 'OpenClipboard';
+function CloseClipboard:WINBOOL; external 'user32' name 'CloseClipboard';
+function GetClipboardOwner:HWND; external 'user32' name 'GetClipboardOwner';
+function SetClipboardViewer(hWndNewViewer:HWND):HWND; external 'user32' name 'SetClipboardViewer';
+function GetClipboardViewer:HWND; external 'user32' name 'GetClipboardViewer';
+function ChangeClipboardChain(hWndRemove:HWND; hWndNewNext:HWND):WINBOOL; external 'user32' name 'ChangeClipboardChain';
+function SetClipboardData(uFormat:UINT; hMem:HANDLE):HANDLE; external 'user32' name 'SetClipboardData';
+function GetClipboardData(uFormat:UINT):HANDLE; external 'user32' name 'GetClipboardData';
+function CountClipboardFormats:longint; external 'user32' name 'CountClipboardFormats';
+function EnumClipboardFormats(format:UINT):UINT; external 'user32' name 'EnumClipboardFormats';
+function EmptyClipboard:WINBOOL; external 'user32' name 'EmptyClipboard';
+function IsClipboardFormatAvailable(format:UINT):WINBOOL; external 'user32' name 'IsClipboardFormatAvailable';
+function GetPriorityClipboardFormat(var paFormatPriorityList:UINT; cFormats:longint):longint; external 'user32' name 'GetPriorityClipboardFormat';
+function GetOpenClipboardWindow:HWND; external 'user32' name 'GetOpenClipboardWindow';
+function CharNextExA(CodePage:WORD; lpCurrentChar:LPCSTR; dwFlags:DWORD):LPSTR; external 'user32' name 'CharNextExA';
+function CharPrevExA(CodePage:WORD; lpStart:LPCSTR; lpCurrentChar:LPCSTR; dwFlags:DWORD):LPSTR; external 'user32' name 'CharPrevExA';
+function SetFocus(hWnd:HWND):HWND; external 'user32' name 'SetFocus';
+function GetActiveWindow:HWND; external 'user32' name 'GetActiveWindow';
+function GetFocus:HWND; external 'user32' name 'GetFocus';
+function GetKBCodePage:UINT; external 'user32' name 'GetKBCodePage';
+function GetKeyState(nVirtKey:longint):SHORT; external 'user32' name 'GetKeyState';
+function GetAsyncKeyState(vKey:longint):SHORT; external 'user32' name 'GetAsyncKeyState';
+function GetKeyboardState(lpKeyState:PBYTE):WINBOOL; external 'user32' name 'GetKeyboardState';
+function SetKeyboardState(lpKeyState:LPBYTE):WINBOOL; external 'user32' name 'SetKeyboardState';
+function GetKeyboardType(nTypeFlag:longint):longint; external 'user32' name 'GetKeyboardType';
+function ToAscii(uVirtKey:UINT; uScanCode:UINT; lpKeyState:PBYTE; lpChar:LPWORD; uFlags:UINT):longint; external 'user32' name 'ToAscii';
+function ToAsciiEx(uVirtKey:UINT; uScanCode:UINT; lpKeyState:PBYTE; lpChar:LPWORD; uFlags:UINT;dwhkl:HKL):longint; external 'user32' name 'ToAsciiEx';
+function ToUnicode(wVirtKey:UINT; wScanCode:UINT; lpKeyState:PBYTE; pwszBuff:LPWSTR; cchBuff:longint;wFlags:UINT):longint; external 'user32' name 'ToUnicode';
+function OemKeyScan(wOemChar:WORD):DWORD; external 'user32' name 'OemKeyScan';
+procedure keybd_event(bVk:BYTE; bScan:BYTE; dwFlags:DWORD; dwExtraInfo:DWORD); external 'user32' name 'keybd_event';
+procedure mouse_event(dwFlags:DWORD; dx:DWORD; dy:DWORD; cButtons:DWORD; dwExtraInfo:DWORD); external 'user32' name 'mouse_event';
+function GetInputState:WINBOOL; external 'user32' name 'GetInputState';
+function GetQueueStatus(flags:UINT):DWORD; external 'user32' name 'GetQueueStatus';
+function GetCapture:HWND; external 'user32' name 'GetCapture';
+function SetCapture(hWnd:HWND):HWND; external 'user32' name 'SetCapture';
+function ReleaseCapture:WINBOOL; external 'user32' name 'ReleaseCapture';
+function MsgWaitForMultipleObjects(nCount:DWORD; pHandles:LPHANDLE; fWaitAll:WINBOOL; dwMilliseconds:DWORD; dwWakeMask:DWORD):DWORD; external 'user32' name 'MsgWaitForMultipleObjects';
+function SetTimer(hWnd:HWND; nIDEvent:UINT; uElapse:UINT; lpTimerFunc:TIMERPROC):UINT; external 'user32' name 'SetTimer';
+function KillTimer(hWnd:HWND; uIDEvent:UINT):WINBOOL; external 'user32' name 'KillTimer';
+function IsWindowUnicode(hWnd:HWND):WINBOOL; external 'user32' name 'IsWindowUnicode';
+function EnableWindow(hWnd:HWND; bEnable:WINBOOL):WINBOOL; external 'user32' name 'EnableWindow';
+function IsWindowEnabled(hWnd:HWND):WINBOOL; external 'user32' name 'IsWindowEnabled';
+function DestroyAcceleratorTable(hAccel:HACCEL):WINBOOL; external 'user32' name 'DestroyAcceleratorTable';
+function GetSystemMetrics(nIndex:longint):longint; external 'user32' name 'GetSystemMetrics';
+function GetMenu(hWnd:HWND):HMENU; external 'user32' name 'GetMenu';
+function SetMenu(hWnd:HWND; hMenu:HMENU):WINBOOL; external 'user32' name 'SetMenu';
+function HiliteMenuItem(hWnd:HWND; hMenu:HMENU; uIDHiliteItem:UINT; uHilite:UINT):WINBOOL; external 'user32' name 'HiliteMenuItem';
+function GetMenuState(hMenu:HMENU; uId:UINT; uFlags:UINT):UINT; external 'user32' name 'GetMenuState';
+function DrawMenuBar(hWnd:HWND):WINBOOL; external 'user32' name 'DrawMenuBar';
+function GetSystemMenu(hWnd:HWND; bRevert:WINBOOL):HMENU; external 'user32' name 'GetSystemMenu';
+function CreateMenu:HMENU; external 'user32' name 'CreateMenu';
+function CreatePopupMenu:HMENU; external 'user32' name 'CreatePopupMenu';
+function DestroyMenu(hMenu:HMENU):WINBOOL; external 'user32' name 'DestroyMenu';
+function CheckMenuItem(hMenu:HMENU; uIDCheckItem:UINT; uCheck:UINT):DWORD; external 'user32' name 'CheckMenuItem';
+function EnableMenuItem(hMenu:HMENU; uIDEnableItem:UINT; uEnable:UINT):WINBOOL; external 'user32' name 'EnableMenuItem';
+function GetSubMenu(hMenu:HMENU; nPos:longint):HMENU; external 'user32' name 'GetSubMenu';
+function GetMenuItemID(hMenu:HMENU; nPos:longint):UINT; external 'user32' name 'GetMenuItemID';
+function GetMenuItemCount(hMenu:HMENU):longint; external 'user32' name 'GetMenuItemCount';
+function RemoveMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT):WINBOOL; external 'user32' name 'RemoveMenu';
+function DeleteMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT):WINBOOL; external 'user32' name 'DeleteMenu';
+function SetMenuItemBitmaps(hMenu:HMENU; uPosition:UINT; uFlags:UINT; hBitmapUnchecked:HBITMAP; hBitmapChecked:HBITMAP):WINBOOL; external 'user32' name 'SetMenuItemBitmaps';
+function GetMenuCheckMarkDimensions:LONG; external 'user32' name 'GetMenuCheckMarkDimensions';
+function TrackPopupMenu(hMenu:HMENU; uFlags:UINT; x:longint; y:longint; nReserved:longint;hWnd:HWND; var prcRect:RECT):WINBOOL; external 'user32' name 'TrackPopupMenu';
+function GetMenuDefaultItem(hMenu:HMENU; fByPos:UINT; gmdiFlags:UINT):UINT; external 'user32' name 'GetMenuDefaultItem';
+function SetMenuDefaultItem(hMenu:HMENU; uItem:UINT; fByPos:UINT):WINBOOL; external 'user32' name 'SetMenuDefaultItem';
+function GetMenuItemRect(hWnd:HWND; hMenu:HMENU; uItem:UINT; lprcItem:LPRECT):WINBOOL; external 'user32' name 'GetMenuItemRect';
+function MenuItemFromPoint(hWnd:HWND; hMenu:HMENU; ptScreen:POINT):longint; {external 'user32' name 'MenuItemFromPoint';bug 1807 }
+function DragObject(_para1:HWND; _para2:HWND; _para3:UINT; _para4:DWORD; _para5:HCURSOR):DWORD; external 'user32' name 'DragObject';
+function DragDetect(hwnd:HWND; pt:POINT):WINBOOL; {external 'user32' name 'DragDetect';bug 1807 }
+function DrawIcon(hDC:HDC; X:longint; Y:longint; hIcon:HICON):WINBOOL; external 'user32' name 'DrawIcon';
+function UpdateWindow(hWnd:HWND):WINBOOL; external 'user32' name 'UpdateWindow';
+function SetActiveWindow(hWnd:HWND):HWND; external 'user32' name 'SetActiveWindow';
+function GetForegroundWindow:HWND; external 'user32' name 'GetForegroundWindow';
+function PaintDesktop(hdc:HDC):WINBOOL; external 'user32' name 'PaintDesktop';
+function SetForegroundWindow(hWnd:HWND):WINBOOL; external 'user32' name 'SetForegroundWindow';
+function WindowFromDC(hDC:HDC):HWND; external 'user32' name 'WindowFromDC';
+function GetDC(hWnd:HWND):HDC; external 'user32' name 'GetDC';
+function GetDCEx(hWnd:HWND; hrgnClip:HRGN; flags:DWORD):HDC; external 'user32' name 'GetDCEx';
+function GetWindowDC(hWnd:HWND):HDC; external 'user32' name 'GetWindowDC';
+function ReleaseDC(hWnd:HWND; hDC:HDC):longint; external 'user32' name 'ReleaseDC';
+function BeginPaint(hWnd:HWND; lpPaint:LPPAINTSTRUCT):HDC; external 'user32' name 'BeginPaint';
+function EndPaint(hWnd:HWND; lpPaint:LPPAINTSTRUCT):WINBOOL; external 'user32' name 'EndPaint';
+function GetUpdateRect(hWnd:HWND; lpRect:LPRECT; bErase:WINBOOL):WINBOOL; external 'user32' name 'GetUpdateRect';
+function GetUpdateRgn(hWnd:HWND; hRgn:HRGN; bErase:WINBOOL):longint; external 'user32' name 'GetUpdateRgn';
+function SetWindowRgn(hWnd:HWND; hRgn:HRGN; bRedraw:WINBOOL):longint; external 'user32' name 'SetWindowRgn';
+function GetWindowRgn(hWnd:HWND; hRgn:HRGN):longint; external 'user32' name 'GetWindowRgn';
+function ExcludeUpdateRgn(hDC:HDC; hWnd:HWND):longint; external 'user32' name 'ExcludeUpdateRgn';
+function InvalidateRect(hWnd:HWND; var lpRect:RECT; bErase:WINBOOL):WINBOOL; external 'user32' name 'InvalidateRect';
+function InvalidateRect(hWnd:HWND;lpRect:LPRECT; bErase:WINBOOL):WINBOOL; external 'user32' name 'InvalidateRect';
+function ValidateRect(hWnd:HWND; var lpRect:RECT):WINBOOL; external 'user32' name 'ValidateRect';
+function ValidateRect(hWnd:HWND;lpRect:LPRECT):WINBOOL; external 'user32' name 'ValidateRect';
+function InvalidateRgn(hWnd:HWND; hRgn:HRGN; bErase:WINBOOL):WINBOOL; external 'user32' name 'InvalidateRgn';
+function ValidateRgn(hWnd:HWND; hRgn:HRGN):WINBOOL; external 'user32' name 'ValidateRgn';
+function RedrawWindow(hWnd:HWND; var lprcUpdate:RECT; hrgnUpdate:HRGN; flags:UINT):WINBOOL; external 'user32' name 'RedrawWindow';
+function RedrawWindow(hWnd:HWND; lprcUpdate:LPRECT; hrgnUpdate:HRGN; flags:UINT):WINBOOL; external 'user32' name 'RedrawWindow';
+function LockWindowUpdate(hWndLock:HWND):WINBOOL; external 'user32' name 'LockWindowUpdate';
+function ScrollWindow(hWnd:HWND; XAmount:longint; YAmount:longint; var lpRect:RECT; var lpClipRect:RECT):WINBOOL; external 'user32' name 'ScrollWindow';
+function ScrollDC(hDC:HDC; dx:longint; dy:longint; var lprcScroll:RECT; var lprcClip:RECT;hrgnUpdate:HRGN; lprcUpdate:LPRECT):WINBOOL; external 'user32' name 'ScrollDC';
+function ScrollWindowEx(hWnd:HWND; dx:longint; dy:longint; var prcScroll:RECT; var prcClip:RECT;hrgnUpdate:HRGN; prcUpdate:LPRECT; flags:UINT):longint; external 'user32' name 'ScrollWindowEx';
+function SetScrollPos(hWnd:HWND; nBar:longint; nPos:longint; bRedraw:WINBOOL):longint; external 'user32' name 'SetScrollPos';
+function GetScrollPos(hWnd:HWND; nBar:longint):longint; external 'user32' name 'GetScrollPos';
+function SetScrollRange(hWnd:HWND; nBar:longint; nMinPos:longint; nMaxPos:longint; bRedraw:WINBOOL):WINBOOL; external 'user32' name 'SetScrollRange';
+function GetScrollRange(hWnd:HWND; nBar:longint; lpMinPos:LPINT; lpMaxPos:LPINT):WINBOOL; external 'user32' name 'GetScrollRange';
+function ShowScrollBar(hWnd:HWND; wBar:longint; bShow:WINBOOL):WINBOOL; external 'user32' name 'ShowScrollBar';
+function EnableScrollBar(hWnd:HWND; wSBflags:UINT; wArrows:UINT):WINBOOL; external 'user32' name 'EnableScrollBar';
+function GetClientRect(hWnd:HWND; lpRect:LPRECT):WINBOOL; external 'user32' name 'GetClientRect';
+function GetWindowRect(hWnd:HWND; lpRect:LPRECT):WINBOOL; external 'user32' name 'GetWindowRect';
+function AdjustWindowRect(lpRect:LPRECT; dwStyle:DWORD; bMenu:WINBOOL):WINBOOL; external 'user32' name 'AdjustWindowRect';
+function AdjustWindowRectEx(lpRect:LPRECT; dwStyle:DWORD; bMenu:WINBOOL; dwExStyle:DWORD):WINBOOL; external 'user32' name 'AdjustWindowRectEx';
+function SetWindowContextHelpId(_para1:HWND; _para2:DWORD):WINBOOL; external 'user32' name 'SetWindowContextHelpId';
+function GetWindowContextHelpId(_para1:HWND):DWORD; external 'user32' name 'GetWindowContextHelpId';
+function SetMenuContextHelpId(_para1:HMENU; _para2:DWORD):WINBOOL; external 'user32' name 'SetMenuContextHelpId';
+function GetMenuContextHelpId(_para1:HMENU):DWORD; external 'user32' name 'GetMenuContextHelpId';
+function MessageBeep(uType:UINT):WINBOOL; external 'user32' name 'MessageBeep';
+function ShowCursor(bShow:WINBOOL):longint; external 'user32' name 'ShowCursor';
+function SetCursorPos(X:longint; Y:longint):WINBOOL; external 'user32' name 'SetCursorPos';
+function SetCursor(hCursor:HCURSOR):HCURSOR; external 'user32' name 'SetCursor';
+function GetCursorPos(lpPoint:LPPOINT):WINBOOL; external 'user32' name 'GetCursorPos';
+function ClipCursor(lpRect:LPRECT):WINBOOL; external 'user32' name 'ClipCursor';
+function GetClipCursor(lpRect:LPRECT):WINBOOL; external 'user32' name 'GetClipCursor';
+function GetCursor:HCURSOR; external 'user32' name 'GetCursor';
+function CreateCaret(hWnd:HWND; hBitmap:HBITMAP; nWidth:longint; nHeight:longint):WINBOOL; external 'user32' name 'CreateCaret';
+function GetCaretBlinkTime:UINT; external 'user32' name 'GetCaretBlinkTime';
+function SetCaretBlinkTime(uMSeconds:UINT):WINBOOL; external 'user32' name 'SetCaretBlinkTime';
+function DestroyCaret:WINBOOL; external 'user32' name 'DestroyCaret';
+function HideCaret(hWnd:HWND):WINBOOL; external 'user32' name 'HideCaret';
+function ShowCaret(hWnd:HWND):WINBOOL; external 'user32' name 'ShowCaret';
+function SetCaretPos(X:longint; Y:longint):WINBOOL; external 'user32' name 'SetCaretPos';
+function GetCaretPos(lpPoint:LPPOINT):WINBOOL; external 'user32' name 'GetCaretPos';
+function ClientToScreen(hWnd:HWND; lpPoint:LPPOINT):WINBOOL; external 'user32' name 'ClientToScreen';
+function ScreenToClient(hWnd:HWND; lpPoint:LPPOINT):WINBOOL; external 'user32' name 'ScreenToClient';
+function MapWindowPoints(hWndFrom:HWND; hWndTo:HWND; lpPoints:LPPOINT; cPoints:UINT):longint; external 'user32' name 'MapWindowPoints';
+function WindowFromPoint(Point:POINT):HWND; { external 'user32' name 'WindowFromPoint';bug 1807 }
+function ChildWindowFromPoint(hWndParent:HWND; Point:POINT):HWND; { external 'user32' name 'ChildWindowFromPoint';bug 1807 }
+function GetSysColor(nIndex:longint):DWORD; external 'user32' name 'GetSysColor';
+function GetSysColorBrush(nIndex:longint):HBRUSH; external 'user32' name 'GetSysColorBrush';
+function SetSysColors(cElements:longint; var lpaElements:wINT; var lpaRgbValues:COLORREF):WINBOOL; external 'user32' name 'SetSysColors';
+function DrawFocusRect(hDC:HDC; var lprc:RECT):WINBOOL; external 'user32' name 'DrawFocusRect';
+function FillRect(hDC:HDC; const lprc:RECT; hbr:HBRUSH):longint; external 'user32' name 'FillRect';
+function FrameRect(hDC:HDC; var lprc:RECT; hbr:HBRUSH):longint; external 'user32' name 'FrameRect';
+function InvertRect(hDC:HDC; var lprc:RECT):WINBOOL; external 'user32' name 'InvertRect';
+function SetRect(lprc:LPRECT; xLeft:longint; yTop:longint; xRight:longint; yBottom:longint):WINBOOL; external 'user32' name 'SetRect';
+function SetRectEmpty(lprc:LPRECT):WINBOOL; external 'user32' name 'SetRectEmpty';
+function CopyRect(lprcDst:LPRECT; var lprcSrc:RECT):WINBOOL; external 'user32' name 'CopyRect';
+function InflateRect(lprc:LPRECT; dx:longint; dy:longint):WINBOOL; external 'user32' name 'InflateRect';
+function IntersectRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WINBOOL; external 'user32' name 'IntersectRect';
+function UnionRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WINBOOL; external 'user32' name 'UnionRect';
+function SubtractRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WINBOOL; external 'user32' name 'SubtractRect';
+function OffsetRect(lprc:LPRECT; dx:longint; dy:longint):WINBOOL; external 'user32' name 'OffsetRect';
+function IsRectEmpty(var lprc:RECT):WINBOOL; external 'user32' name 'IsRectEmpty';
+function EqualRect(var lprc1:RECT; var lprc2:RECT):WINBOOL; external 'user32' name 'EqualRect';
+function PtInRect(var lprc:RECT; pt:POINT):WINBOOL; {external 'user32' name 'PtInRect';bug 1807 }
+function PtInRect(lprc:LPRECT; pt:POINT):WINBOOL;
+function GetWindowWord(hWnd:HWND; nIndex:longint):WORD; external 'user32' name 'GetWindowWord';
+function SetWindowWord(hWnd:HWND; nIndex:longint; wNewWord:WORD):WORD; external 'user32' name 'SetWindowWord';
+function GetClassWord(hWnd:HWND; nIndex:longint):WORD; external 'user32' name 'GetClassWord';
+function SetClassWord(hWnd:HWND; nIndex:longint; wNewWord:WORD):WORD; external 'user32' name 'SetClassWord';
+function GetDesktopWindow:HWND; external 'user32' name 'GetDesktopWindow';
+function GetParent(hWnd:HWND):HWND; external 'user32' name 'GetParent';
+function SetParent(hWndChild:HWND; hWndNewParent:HWND):HWND; external 'user32' name 'SetParent';
+function EnumChildWindows(hWndParent:HWND; lpEnumFunc:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumChildWindows';
+function EnumWindows(lpEnumFunc:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindows';
+function EnumThreadWindows(dwThreadId:DWORD; lpfn:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumThreadWindows';
+function EnumTaskWindows(hTask:HWND; lpfn:FARPROC; lParam: LPARAM): BOOL;external 'user32' name 'EnumThreadWindows';
+function GetTopWindow(hWnd:HWND):HWND; external 'user32' name 'GetTopWindow';
+function GetWindowThreadProcessId(hWnd:HWND; lpdwProcessId:LPDWORD):DWORD; external 'user32' name 'GetWindowThreadProcessId';
+function GetLastActivePopup(hWnd:HWND):HWND; external 'user32' name 'GetLastActivePopup';
+function GetWindow(hWnd:HWND; uCmd:UINT):HWND; external 'user32' name 'GetWindow';
+function UnhookWindowsHook(nCode:longint; pfnFilterProc:HOOKPROC):WINBOOL; external 'user32' name 'UnhookWindowsHook';
+function UnhookWindowsHookEx(hhk:HHOOK):WINBOOL; external 'user32' name 'UnhookWindowsHookEx';
+function CallNextHookEx(hhk:HHOOK; nCode:longint; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'CallNextHookEx';
+function CheckMenuRadioItem(_para1:HMENU; _para2:UINT; _para3:UINT; _para4:UINT; _para5:UINT):WINBOOL; external 'user32' name 'CheckMenuRadioItem';
+function CreateCursor(hInst:HINST; xHotSpot:longint; yHotSpot:longint; nWidth:longint; nHeight:longint;pvANDPlane:pointer; pvXORPlane:pointer):HCURSOR; external 'user32' name 'CreateCursor';
+function DestroyCursor(hCursor:HCURSOR):WINBOOL; external 'user32' name 'DestroyCursor';
+function SetSystemCursor(hcur:HCURSOR; anID:DWORD):WINBOOL; external 'user32' name 'SetSystemCursor';
+function CreateIcon(hInstance:HINST; nWidth:longint; nHeight:longint; cPlanes:BYTE; cBitsPixel:BYTE;var lpbANDbits:BYTE; var lpbXORbits:BYTE):HICON; external 'user32' name 'CreateIcon';
+function DestroyIcon(hIcon:HICON):WINBOOL; external 'user32' name 'DestroyIcon';
+function LookupIconIdFromDirectory(presbits:PBYTE; fIcon:WINBOOL):longint; external 'user32' name 'LookupIconIdFromDirectory';
+function LookupIconIdFromDirectoryEx(presbits:PBYTE; fIcon:WINBOOL; cxDesired:longint; cyDesired:longint; Flags:UINT):longint; external 'user32' name 'LookupIconIdFromDirectoryEx';
+function CreateIconFromResource(presbits:PBYTE; dwResSize:DWORD; fIcon:WINBOOL; dwVer:DWORD):HICON; external 'user32' name 'CreateIconFromResource';
+function CreateIconFromResourceEx(presbits:PBYTE; dwResSize:DWORD; fIcon:WINBOOL; dwVer:DWORD; cxDesired:longint;cyDesired:longint; Flags:UINT):HICON; external 'user32' name 'CreateIconFromResourceEx';
+function CopyImage(_para1:HANDLE; _para2:UINT; _para3:longint; _para4:longint; _para5:UINT):HICON; external 'user32' name 'CopyImage';
+function CreateIconIndirect(piconinfo:PICONINFO):HICON; external 'user32' name 'CreateIconIndirect';
+function CopyIcon(hIcon:HICON):HICON; external 'user32' name 'CopyIcon';
+function GetIconInfo(hIcon:HICON; piconinfo:PICONINFO):WINBOOL; external 'user32' name 'GetIconInfo';
+function MapDialogRect(hDlg:HWND; lpRect:LPRECT):WINBOOL; external 'user32' name 'MapDialogRect';
+function SetScrollInfo(_para1:HWND; _para2:longint; _para3:LPCSCROLLINFO; _para4:WINBOOL):longint; external 'user32' name 'SetScrollInfo';
+function GetScrollInfo(_para1:HWND; _para2:longint; _para3:LPSCROLLINFO):WINBOOL; external 'user32' name 'GetScrollInfo';
+function TranslateMDISysAccel(hWndClient:HWND; lpMsg:LPMSG):WINBOOL; external 'user32' name 'TranslateMDISysAccel';
+function ArrangeIconicWindows(hWnd:HWND):UINT; external 'user32' name 'ArrangeIconicWindows';
+function TileWindows(hwndParent:HWND; wHow:UINT; var lpRect:RECT; cKids:UINT; var lpKids:HWND):WORD; external 'user32' name 'TileWindows';
+function CascadeWindows(hwndParent:HWND; wHow:UINT; var lpRect:RECT; cKids:UINT; var lpKids:HWND):WORD; external 'user32' name 'CascadeWindows';
+procedure SetLastErrorEx(dwErrCode:DWORD; dwType:DWORD); external 'user32' name 'SetLastErrorEx';
+procedure SetDebugErrorLevel(dwLevel:DWORD); external 'user32' name 'SetDebugErrorLevel';
+function DrawEdge(hdc:HDC; qrc:LPRECT; edge:UINT; grfFlags:UINT):WINBOOL; external 'user32' name 'DrawEdge';
+function DrawFrameControl(_para1:HDC; _para2:LPRECT; _para3:UINT; _para4:UINT):WINBOOL; external 'user32' name 'DrawFrameControl';
+function DrawCaption(_para1:HWND; _para2:HDC; var _para3:RECT; _para4:UINT):WINBOOL; external 'user32' name 'DrawCaption';
+function DrawAnimatedRects(hwnd:HWND; idAni:longint; var lprcFrom:RECT; var lprcTo:RECT):WINBOOL; external 'user32' name 'DrawAnimatedRects';
+function TrackPopupMenuEx(_para1:HMENU; _para2:UINT; _para3:longint; _para4:longint; _para5:HWND;_para6:LPTPMPARAMS):WINBOOL; external 'user32' name 'TrackPopupMenuEx';
+function ChildWindowFromPointEx(_para1:HWND; _para2:POINT; _para3:UINT):HWND; {external 'user32' name 'ChildWindowFromPointEx';}
+function DrawIconEx(hdc:HDC; xLeft:longint; yTop:longint; hIcon:HICON; cxWidth:longint;cyWidth:longint; istepIfAniCur:UINT; hbrFlickerFreeDraw:HBRUSH; diFlags:UINT):WINBOOL; external 'user32' name 'DrawIconEx';
+function AnimatePalette(_para1:HPALETTE; _para2:UINT; _para3:UINT; var _para4:PALETTEENTRY):WINBOOL; external 'gdi32' name 'AnimatePalette';
+function Arc(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:longint; _para9:longint):WINBOOL; external 'gdi32' name 'Arc';
+function BitBlt(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:HDC; _para7:longint; _para8:longint; _para9:DWORD):WINBOOL; external 'gdi32' name 'BitBlt';
+function CancelDC(_para1:HDC):WINBOOL; external 'gdi32' name 'CancelDC';
+function Chord(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:longint; _para9:longint):WINBOOL; external 'gdi32' name 'Chord';
+function CloseMetaFile(_para1:HDC):HMETAFILE; external 'gdi32' name 'CloseMetaFile';
+function CombineRgn(_para1:HRGN; _para2:HRGN; _para3:HRGN; _para4:longint):longint; external 'gdi32' name 'CombineRgn';
+function CreateBitmap(_para1:longint; _para2:longint; _para3:UINT; _para4:UINT; _para5:pointer):HBITMAP; external 'gdi32' name 'CreateBitmap';
+function CreateBitmapIndirect(var _para1:BITMAP):HBITMAP; external 'gdi32' name 'CreateBitmapIndirect';
+function CreateBrushIndirect(var _para1:LOGBRUSH):HBRUSH; external 'gdi32' name 'CreateBrushIndirect';
+function CreateCompatibleBitmap(_para1:HDC; _para2:longint; _para3:longint):HBITMAP; external 'gdi32' name 'CreateCompatibleBitmap';
+function CreateDiscardableBitmap(_para1:HDC; _para2:longint; _para3:longint):HBITMAP; external 'gdi32' name 'CreateDiscardableBitmap';
+function CreateCompatibleDC(_para1:HDC):HDC; external 'gdi32' name 'CreateCompatibleDC';
+function CreateDIBitmap(_para1:HDC; var _para2:BITMAPINFOHEADER; _para3:DWORD; _para4:pointer; var _para5:BITMAPINFO;_para6:UINT):HBITMAP; external 'gdi32' name 'CreateDIBitmap';
+function CreateDIBPatternBrush(_para1:HGLOBAL; _para2:UINT):HBRUSH; external 'gdi32' name 'CreateDIBPatternBrush';
+function CreateDIBPatternBrushPt(_para1:pointer; _para2:UINT):HBRUSH; external 'gdi32' name 'CreateDIBPatternBrushPt';
+function CreateEllipticRgn(_para1:longint; _para2:longint; _para3:longint; _para4:longint):HRGN; external 'gdi32' name 'CreateEllipticRgn';
+function CreateEllipticRgnIndirect(var _para1:RECT):HRGN; external 'gdi32' name 'CreateEllipticRgnIndirect';
+function CreateHatchBrush(_para1:longint; _para2:COLORREF):HBRUSH; external 'gdi32' name 'CreateHatchBrush';
+function CreatePalette(var _para1:LOGPALETTE):HPALETTE; external 'gdi32' name 'CreatePalette';
+function CreatePen(_para1:longint; _para2:longint; _para3:COLORREF):HPEN; external 'gdi32' name 'CreatePen';
+function CreatePenIndirect(var _para1:LOGPEN):HPEN; external 'gdi32' name 'CreatePenIndirect';
+function CreatePolyPolygonRgn(var _para1:POINT; var _para2:wINT; _para3:longint; _para4:longint):HRGN; external 'gdi32' name 'CreatePolyPolygonRgn';
+function CreatePatternBrush(_para1:HBITMAP):HBRUSH; external 'gdi32' name 'CreatePatternBrush';
+function CreateRectRgn(_para1:longint; _para2:longint; _para3:longint; _para4:longint):HRGN; external 'gdi32' name 'CreateRectRgn';
+function CreateRectRgnIndirect(var _para1:RECT):HRGN; external 'gdi32' name 'CreateRectRgnIndirect';
+function CreateRoundRectRgn(_para1:longint; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint):HRGN; external 'gdi32' name 'CreateRoundRectRgn';
+function CreateSolidBrush(_para1:COLORREF):HBRUSH; external 'gdi32' name 'CreateSolidBrush';
+function DeleteDC(_para1:HDC):WINBOOL; external 'gdi32' name 'DeleteDC';
+function DeleteMetaFile(_para1:HMETAFILE):WINBOOL; external 'gdi32' name 'DeleteMetaFile';
+function DeleteObject(_para1:HGDIOBJ):WINBOOL; external 'gdi32' name 'DeleteObject';
+function DrawEscape(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCSTR):longint; external 'gdi32' name 'DrawEscape';
+function Ellipse(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint):WINBOOL; external 'gdi32' name 'Ellipse';
+function EnumObjects(_para1:HDC; _para2:longint; _para3:ENUMOBJECTSPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumObjects';
+function EqualRgn(_para1:HRGN; _para2:HRGN):WINBOOL; external 'gdi32' name 'EqualRgn';
+function Escape(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCSTR; _para5:LPVOID):longint; external 'gdi32' name 'Escape';
+function ExtEscape(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCSTR; _para5:longint;_para6:LPSTR):longint; external 'gdi32' name 'ExtEscape';
+function ExcludeClipRect(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint):longint; external 'gdi32' name 'ExcludeClipRect';
+function ExtCreateRegion(var _para1:XFORM; _para2:DWORD; var _para3:RGNDATA):HRGN; external 'gdi32' name 'ExtCreateRegion';
+function ExtFloodFill(_para1:HDC; _para2:longint; _para3:longint; _para4:COLORREF; _para5:UINT):WINBOOL; external 'gdi32' name 'ExtFloodFill';
+function FillRgn(_para1:HDC; _para2:HRGN; _para3:HBRUSH):WINBOOL; external 'gdi32' name 'FillRgn';
+function FloodFill(_para1:HDC; _para2:longint; _para3:longint; _para4:COLORREF):WINBOOL; external 'gdi32' name 'FloodFill';
+function FrameRgn(_para1:HDC; _para2:HRGN; _para3:HBRUSH; _para4:longint; _para5:longint):WINBOOL; external 'gdi32' name 'FrameRgn';
+function GetROP2(_para1:HDC):longint; external 'gdi32' name 'GetROP2';
+function GetAspectRatioFilterEx(_para1:HDC; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetAspectRatioFilterEx';
+function GetBkColor(_para1:HDC):COLORREF; external 'gdi32' name 'GetBkColor';
+function GetBkMode(_para1:HDC):longint; external 'gdi32' name 'GetBkMode';
+function GetBitmapBits(_para1:HBITMAP; _para2:LONG; _para3:LPVOID):LONG; external 'gdi32' name 'GetBitmapBits';
+function GetBitmapDimensionEx(_para1:HBITMAP; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetBitmapDimensionEx';
+function GetBoundsRect(_para1:HDC; _para2:LPRECT; _para3:UINT):UINT; external 'gdi32' name 'GetBoundsRect';
+function GetBrushOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetBrushOrgEx';
+function GetClipBox(_para1:HDC; _para2:LPRECT):longint; external 'gdi32' name 'GetClipBox';
+function GetClipRgn(_para1:HDC; _para2:HRGN):longint; external 'gdi32' name 'GetClipRgn';
+function GetMetaRgn(_para1:HDC; _para2:HRGN):longint; external 'gdi32' name 'GetMetaRgn';
+function GetCurrentObject(_para1:HDC; _para2:UINT):HGDIOBJ; external 'gdi32' name 'GetCurrentObject';
+function GetCurrentPositionEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetCurrentPositionEx';
+function GetDeviceCaps(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'GetDeviceCaps';
+function GetDIBits(_para1:HDC; _para2:HBITMAP; _para3:UINT; _para4:UINT; _para5:LPVOID;_para6:LPBITMAPINFO; _para7:UINT):longint; external 'gdi32' name 'GetDIBits';
+function GetFontData(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:LPVOID; _para5:DWORD):DWORD; external 'gdi32' name 'GetFontData';
+function GetGraphicsMode(_para1:HDC):longint; external 'gdi32' name 'GetGraphicsMode';
+function GetMapMode(_para1:HDC):longint; external 'gdi32' name 'GetMapMode';
+function GetMetaFileBitsEx(_para1:HMETAFILE; _para2:UINT; _para3:LPVOID):UINT; external 'gdi32' name 'GetMetaFileBitsEx';
+function GetNearestColor(_para1:HDC; _para2:COLORREF):COLORREF; external 'gdi32' name 'GetNearestColor';
+function GetNearestPaletteIndex(_para1:HPALETTE; _para2:COLORREF):UINT; external 'gdi32' name 'GetNearestPaletteIndex';
+function GetObjectType(h:HGDIOBJ):DWORD; external 'gdi32' name 'GetObjectType';
+function GetPaletteEntries(_para1:HPALETTE; _para2:UINT; _para3:UINT; _para4:LPPALETTEENTRY):UINT; external 'gdi32' name 'GetPaletteEntries';
+function GetPixel(_para1:HDC; _para2:longint; _para3:longint):COLORREF; external 'gdi32' name 'GetPixel';
+function GetPixelFormat(_para1:HDC):longint; external 'gdi32' name 'GetPixelFormat';
+function GetPolyFillMode(_para1:HDC):longint; external 'gdi32' name 'GetPolyFillMode';
+function GetRasterizerCaps(_para1:LPRASTERIZER_STATUS; _para2:UINT):WINBOOL; external 'gdi32' name 'GetRasterizerCaps';
+function GetRegionData(_para1:HRGN; _para2:DWORD; _para3:LPRGNDATA):DWORD; external 'gdi32' name 'GetRegionData';
+function GetRgnBox(_para1:HRGN; _para2:LPRECT):longint; external 'gdi32' name 'GetRgnBox';
+function GetStockObject(_para1:longint):HGDIOBJ; external 'gdi32' name 'GetStockObject';
+function GetStretchBltMode(_para1:HDC):longint; external 'gdi32' name 'GetStretchBltMode';
+function GetSystemPaletteEntries(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPPALETTEENTRY):UINT; external 'gdi32' name 'GetSystemPaletteEntries';
+function GetSystemPaletteUse(_para1:HDC):UINT; external 'gdi32' name 'GetSystemPaletteUse';
+function GetTextCharacterExtra(_para1:HDC):longint; external 'gdi32' name 'GetTextCharacterExtra';
+function GetTextAlign(_para1:HDC):UINT; external 'gdi32' name 'GetTextAlign';
+function GetTextColor(_para1:HDC):COLORREF; external 'gdi32' name 'GetTextColor';
+function GetTextCharset(hdc:HDC):longint; external 'gdi32' name 'GetTextCharset';
+function GetTextCharsetInfo(hdc:HDC; lpSig:LPFONTSIGNATURE; dwFlags:DWORD):longint; external 'gdi32' name 'GetTextCharsetInfo';
+function TranslateCharsetInfo(var lpSrc:DWORD; lpCs:LPCHARSETINFO; dwFlags:DWORD):WINBOOL; external 'gdi32' name 'TranslateCharsetInfo';
+function GetFontLanguageInfo(_para1:HDC):DWORD; external 'gdi32' name 'GetFontLanguageInfo';
+function GetViewportExtEx(_para1:HDC; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetViewportExtEx';
+function GetViewportOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetViewportOrgEx';
+function GetWindowExtEx(_para1:HDC; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetWindowExtEx';
+function GetWindowOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetWindowOrgEx';
+function IntersectClipRect(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint):longint; external 'gdi32' name 'IntersectClipRect';
+function InvertRgn(_para1:HDC; _para2:HRGN):WINBOOL; external 'gdi32' name 'InvertRgn';
+function LineDDA(_para1:longint; _para2:longint; _para3:longint; _para4:longint; _para5:LINEDDAPROC;_para6:LPARAM):WINBOOL; external 'gdi32' name 'LineDDA';
+function LineTo(_para1:HDC; _para2:longint; _para3:longint):WINBOOL; external 'gdi32' name 'LineTo';
+function MaskBlt(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:HDC; _para7:longint; _para8:longint; _para9:HBITMAP; _para10:longint;_para11:longint; _para12:DWORD):WINBOOL; external 'gdi32' name 'MaskBlt';
+function PlgBlt(_para1:HDC; var _para2:POINT; _para3:HDC; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:HBITMAP; _para9:longint; _para10:longint):WINBOOL; external 'gdi32' name 'PlgBlt';
+function OffsetClipRgn(_para1:HDC; _para2:longint; _para3:longint):longint; external 'gdi32' name 'OffsetClipRgn';
+function OffsetRgn(_para1:HRGN; _para2:longint; _para3:longint):longint; external 'gdi32' name 'OffsetRgn';
+function PatBlt(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:DWORD):WINBOOL; external 'gdi32' name 'PatBlt';
+function Pie(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:longint; _para9:longint):WINBOOL; external 'gdi32' name 'Pie';
+function PlayMetaFile(_para1:HDC; _para2:HMETAFILE):WINBOOL; external 'gdi32' name 'PlayMetaFile';
+function PaintRgn(_para1:HDC; _para2:HRGN):WINBOOL; external 'gdi32' name 'PaintRgn';
+function PolyPolygon(_para1:HDC; var _para2:POINT; var _para3:wINT; _para4:longint):WINBOOL; external 'gdi32' name 'PolyPolygon';
+function PtInRegion(_para1:HRGN; _para2:longint; _para3:longint):WINBOOL; external 'gdi32' name 'PtInRegion';
+function PtVisible(_para1:HDC; _para2:longint; _para3:longint):WINBOOL; external 'gdi32' name 'PtVisible';
+function RectInRegion(_para1:HRGN; var _para2:RECT):WINBOOL; external 'gdi32' name 'RectInRegion';
+function RectVisible(_para1:HDC; var _para2:RECT):WINBOOL; external 'gdi32' name 'RectVisible';
+function Rectangle(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint):WINBOOL; external 'gdi32' name 'Rectangle';
+function RestoreDC(_para1:HDC; _para2:longint):WINBOOL; external 'gdi32' name 'RestoreDC';
+function RealizePalette(_para1:HDC):UINT; external 'gdi32' name 'RealizePalette';
+function RoundRect(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint):WINBOOL; external 'gdi32' name 'RoundRect';
+function ResizePalette(_para1:HPALETTE; _para2:UINT):WINBOOL; external 'gdi32' name 'ResizePalette';
+function SaveDC(_para1:HDC):longint; external 'gdi32' name 'SaveDC';
+function SelectClipRgn(_para1:HDC; _para2:HRGN):longint; external 'gdi32' name 'SelectClipRgn';
+function ExtSelectClipRgn(_para1:HDC; _para2:HRGN; _para3:longint):longint; external 'gdi32' name 'ExtSelectClipRgn';
+function SetMetaRgn(_para1:HDC):longint; external 'gdi32' name 'SetMetaRgn';
+function SelectObject(_para1:HDC; _para2:HGDIOBJ):HGDIOBJ; external 'gdi32' name 'SelectObject';
+function SelectPalette(_para1:HDC; _para2:HPALETTE; _para3:WINBOOL):HPALETTE; external 'gdi32' name 'SelectPalette';
+function SetBkColor(_para1:HDC; _para2:COLORREF):COLORREF; external 'gdi32' name 'SetBkColor';
+function SetBkMode(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetBkMode';
+function SetBitmapBits(_para1:HBITMAP; _para2:DWORD; _para3:pointer):LONG; external 'gdi32' name 'SetBitmapBits';
+function SetBoundsRect(_para1:HDC; var _para2:RECT; _para3:UINT):UINT; external 'gdi32' name 'SetBoundsRect';
+function SetDIBits(_para1:HDC; _para2:HBITMAP; _para3:UINT; _para4:UINT; _para5:pointer;_para6:PBITMAPINFO; _para7:UINT):longint; external 'gdi32' name 'SetDIBits';
+function SetDIBitsToDevice(_para1:HDC; _para2:longint; _para3:longint; _para4:DWORD; _para5:DWORD;_para6:longint; _para7:longint; _para8:UINT; _para9:UINT; _para10:pointer;var _para11:BITMAPINFO; _para12:UINT):longint;
+ external 'gdi32' name 'SetDIBitsToDevice';
+function SetMapperFlags(_para1:HDC; _para2:DWORD):DWORD; external 'gdi32' name 'SetMapperFlags';
+function SetGraphicsMode(hdc:HDC; iMode:longint):longint; external 'gdi32' name 'SetGraphicsMode';
+function SetMapMode(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetMapMode';
+function SetMetaFileBitsEx(_para1:UINT; var _para2:BYTE):HMETAFILE; external 'gdi32' name 'SetMetaFileBitsEx';
+function SetPaletteEntries(_para1:HPALETTE; _para2:UINT; _para3:UINT; var _para4:PALETTEENTRY):UINT; external 'gdi32' name 'SetPaletteEntries';
+function SetPixel(_para1:HDC; _para2:longint; _para3:longint; _para4:COLORREF):COLORREF; external 'gdi32' name 'SetPixel';
+function SetPixelV(_para1:HDC; _para2:longint; _para3:longint; _para4:COLORREF):WINBOOL; external 'gdi32' name 'SetPixelV';
+function SetPolyFillMode(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetPolyFillMode';
+function StretchBlt(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:HDC; _para7:longint; _para8:longint; _para9:longint; _para10:longint;_para11:DWORD):WINBOOL; external 'gdi32' name 'StretchBlt';
+function SetRectRgn(_para1:HRGN; _para2:longint; _para3:longint; _para4:longint; _para5:longint):WINBOOL; external 'gdi32' name 'SetRectRgn';
+function StretchDIBits(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:longint; _para9:longint; _para10:pointer;var _para11:BITMAPINFO; _para12:UINT; _para13:DWORD):longint;
+ external 'gdi32' name 'StretchDIBits';
+function SetROP2(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetROP2';
+function SetStretchBltMode(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetStretchBltMode';
+function SetSystemPaletteUse(_para1:HDC; _para2:UINT):UINT; external 'gdi32' name 'SetSystemPaletteUse';
+function SetTextCharacterExtra(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetTextCharacterExtra';
+function SetTextColor(_para1:HDC; _para2:COLORREF):COLORREF; external 'gdi32' name 'SetTextColor';
+function SetTextAlign(_para1:HDC; _para2:UINT):UINT; external 'gdi32' name 'SetTextAlign';
+function SetTextJustification(_para1:HDC; _para2:longint; _para3:longint):WINBOOL; external 'gdi32' name 'SetTextJustification';
+function UpdateColors(_para1:HDC):WINBOOL; external 'gdi32' name 'UpdateColors';
+function PlayMetaFileRecord(_para1:HDC; _para2:LPHANDLETABLE; _para3:LPMETARECORD; _para4:UINT):WINBOOL; external 'gdi32' name 'PlayMetaFileRecord';
+function EnumMetaFile(_para1:HDC; _para2:HMETAFILE; _para3:ENUMMETAFILEPROC; _para4:LPARAM):WINBOOL; external 'gdi32' name 'EnumMetaFile';
+function CloseEnhMetaFile(_para1:HDC):HENHMETAFILE; external 'gdi32' name 'CloseEnhMetaFile';
+function DeleteEnhMetaFile(_para1:HENHMETAFILE):WINBOOL; external 'gdi32' name 'DeleteEnhMetaFile';
+function EnumEnhMetaFile(_para1:HDC; _para2:HENHMETAFILE; _para3:ENHMETAFILEPROC; _para4:LPVOID; var _para5:RECT):WINBOOL; external 'gdi32' name 'EnumEnhMetaFile';
+function GetEnhMetaFileHeader(_para1:HENHMETAFILE; _para2:UINT; _para3:LPENHMETAHEADER):UINT; external 'gdi32' name 'GetEnhMetaFileHeader';
+function GetEnhMetaFilePaletteEntries(_para1:HENHMETAFILE; _para2:UINT; _para3:LPPALETTEENTRY):UINT; external 'gdi32' name 'GetEnhMetaFilePaletteEntries';
+function GetWinMetaFileBits(_para1:HENHMETAFILE; _para2:UINT; _para3:LPBYTE; _para4:wINT; _para5:HDC):UINT; external 'gdi32' name 'GetWinMetaFileBits';
+function PlayEnhMetaFile(_para1:HDC; _para2:HENHMETAFILE; var _para3:RECT):WINBOOL; external 'gdi32' name 'PlayEnhMetaFile';
+function PlayEnhMetaFileRecord(_para1:HDC; _para2:LPHANDLETABLE; var _para3:ENHMETARECORD; _para4:UINT):WINBOOL; external 'gdi32' name 'PlayEnhMetaFileRecord';
+function SetEnhMetaFileBits(_para1:UINT; var _para2:BYTE):HENHMETAFILE; external 'gdi32' name 'SetEnhMetaFileBits';
+function SetWinMetaFileBits(_para1:UINT; var _para2:BYTE; _para3:HDC; var _para4:METAFILEPICT):HENHMETAFILE; external 'gdi32' name 'SetWinMetaFileBits';
+function GdiComment(_para1:HDC; _para2:UINT; var _para3:BYTE):WINBOOL; external 'gdi32' name 'GdiComment';
+function AngleArc(_para1:HDC; _para2:longint; _para3:longint; _para4:DWORD; _para5:Single;_para6:Single):WINBOOL; external 'gdi32' name 'AngleArc';
+function PolyPolyline(_para1:HDC; var _para2:POINT; var _para3:DWORD; _para4:DWORD):WINBOOL; external 'gdi32' name 'PolyPolyline';
+function GetWorldTransform(_para1:HDC; _para2:LPXFORM):WINBOOL; external 'gdi32' name 'GetWorldTransform';
+function SetWorldTransform(_para1:HDC; var _para2:XFORM):WINBOOL; external 'gdi32' name 'SetWorldTransform';
+function ModifyWorldTransform(_para1:HDC; var _para2:XFORM; _para3:DWORD):WINBOOL; external 'gdi32' name 'ModifyWorldTransform';
+function CombineTransform(_para1:LPXFORM; var _para2:XFORM; var _para3:XFORM):WINBOOL; external 'gdi32' name 'CombineTransform';
+function CreateDIBSection(_para1:HDC; var _para2:BITMAPINFO; _para3:UINT; var _para4:pointer; _para5:HANDLE;_para6:DWORD):HBITMAP; external 'gdi32' name 'CreateDIBSection';
+function GetDIBColorTable(_para1:HDC; _para2:UINT; _para3:UINT; var _para4:RGBQUAD):UINT; external 'gdi32' name 'GetDIBColorTable';
+function SetDIBColorTable(_para1:HDC; _para2:UINT; _para3:UINT; var _para4:RGBQUAD):UINT; external 'gdi32' name 'SetDIBColorTable';
+function SetColorAdjustment(_para1:HDC; var _para2:COLORADJUSTMENT):WINBOOL; external 'gdi32' name 'SetColorAdjustment';
+function GetColorAdjustment(_para1:HDC; _para2:LPCOLORADJUSTMENT):WINBOOL; external 'gdi32' name 'GetColorAdjustment';
+function CreateHalftonePalette(_para1:HDC):HPALETTE; external 'gdi32' name 'CreateHalftonePalette';
+function EndDoc(_para1:HDC):longint; external 'gdi32' name 'EndDoc';
+function StartPage(_para1:HDC):longint; external 'gdi32' name 'StartPage';
+function EndPage(_para1:HDC):longint; external 'gdi32' name 'EndPage';
+function AbortDoc(_para1:HDC):longint; external 'gdi32' name 'AbortDoc';
+function SetAbortProc(_para1:HDC; _para2:TABORTPROC):longint; external 'gdi32' name 'SetAbortProc';
+{function AbortPath(_para1:HDC):WINBOOL; external 'gdi32' name 'AbortPath';}
+function ArcTo(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:longint; _para9:longint):WINBOOL; external 'gdi32' name 'ArcTo';
+function BeginPath(_para1:HDC):WINBOOL; external 'gdi32' name 'BeginPath';
+function CloseFigure(_para1:HDC):WINBOOL; external 'gdi32' name 'CloseFigure';
+function EndPath(_para1:HDC):WINBOOL; external 'gdi32' name 'EndPath';
+function FillPath(_para1:HDC):WINBOOL; external 'gdi32' name 'FillPath';
+function FlattenPath(_para1:HDC):WINBOOL; external 'gdi32' name 'FlattenPath';
+function GetPath(_para1:HDC; _para2:LPPOINT; _para3:LPBYTE; _para4:longint):longint; external 'gdi32' name 'GetPath';
+function PathToRegion(_para1:HDC):HRGN; external 'gdi32' name 'PathToRegion';
+function PolyDraw(_para1:HDC; var _para2:POINT; var _para3:BYTE; _para4:longint):WINBOOL; external 'gdi32' name 'PolyDraw';
+function SelectClipPath(_para1:HDC; _para2:longint):WINBOOL; external 'gdi32' name 'SelectClipPath';
+function SetArcDirection(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetArcDirection';
+function SetMiterLimit(_para1:HDC; _para2:Single; _para3:PSingle):WINBOOL; external 'gdi32' name 'SetMiterLimit';
+function StrokeAndFillPath(_para1:HDC):WINBOOL; external 'gdi32' name 'StrokeAndFillPath';
+function StrokePath(_para1:HDC):WINBOOL; external 'gdi32' name 'StrokePath';
+function WidenPath(_para1:HDC):WINBOOL; external 'gdi32' name 'WidenPath';
+function ExtCreatePen(_para1:DWORD; _para2:DWORD; var _para3:LOGBRUSH; _para4:DWORD; var _para5:DWORD):HPEN; external 'gdi32' name 'ExtCreatePen';
+function GetMiterLimit(_para1:HDC; _para2:PSingle):WINBOOL; external 'gdi32' name 'GetMiterLimit';
+function GetArcDirection(_para1:HDC):longint; external 'gdi32' name 'GetArcDirection';
+function MoveToEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'MoveToEx';
+function CreatePolygonRgn(var _para1:POINT; _para2:longint; _para3:longint):HRGN; external 'gdi32' name 'CreatePolygonRgn';
+function DPtoLP(_para1:HDC; _para2:LPPOINT; _para3:longint):WINBOOL; external 'gdi32' name 'DPtoLP';
+function LPtoDP(_para1:HDC; _para2:LPPOINT; _para3:longint):WINBOOL; external 'gdi32' name 'LPtoDP';
+function Polygon(_para1:HDC; _para2:LPPOINT; _para3:longint):WINBOOL; external 'gdi32' name 'Polygon';
+function Polyline(_para1:HDC; _para2:LPPOINT; _para3:longint):WINBOOL; external 'gdi32' name 'Polyline';
+function PolyBezier(_para1:HDC; _para2:LPPOINT; _para3:DWORD):WINBOOL; external 'gdi32' name 'PolyBezier';
+function PolyBezierTo(_para1:HDC; _para2:POINT; _para3:DWORD):WINBOOL; external 'gdi32' name 'PolyBezierTo';
+function PolylineTo(_para1:HDC; _para2:LPPOINT; _para3:DWORD):WINBOOL; external 'gdi32' name 'PolylineTo';
+function SetViewportExtEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'SetViewportExtEx';
+function SetViewportOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'SetViewportOrgEx';
+function SetWindowExtEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'SetWindowExtEx';
+function SetWindowOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'SetWindowOrgEx';
+function OffsetViewportOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'OffsetViewportOrgEx';
+function OffsetWindowOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'OffsetWindowOrgEx';
+function ScaleViewportExtEx(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:LPSIZE):WINBOOL; external 'gdi32' name 'ScaleViewportExtEx';
+function ScaleWindowExtEx(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:LPSIZE):WINBOOL; external 'gdi32' name 'ScaleWindowExtEx';
+function SetBitmapDimensionEx(_para1:HBITMAP; _para2:longint; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'SetBitmapDimensionEx';
+function SetBrushOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'SetBrushOrgEx';
+function GetDCOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetDCOrgEx';
+function FixBrushOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'FixBrushOrgEx';
+function UnrealizeObject(_para1:HGDIOBJ):WINBOOL; external 'gdi32' name 'UnrealizeObject';
+function GdiFlush:WINBOOL; external 'gdi32' name 'GdiFlush';
+function GdiSetBatchLimit(_para1:DWORD):DWORD; external 'gdi32' name 'GdiSetBatchLimit';
+function GdiGetBatchLimit:DWORD; external 'gdi32' name 'GdiGetBatchLimit';
+function SetICMMode(_para1:HDC; _para2:longint):longint; external 'gdi32' name 'SetICMMode';
+function CheckColorsInGamut(_para1:HDC; _para2:LPVOID; _para3:LPVOID; _para4:DWORD):WINBOOL; external 'gdi32' name 'CheckColorsInGamut';
+function GetColorSpace(_para1:HDC):HANDLE; external 'gdi32' name 'GetColorSpace';
+function SetColorSpace(_para1:HDC; _para2:HCOLORSPACE):WINBOOL; external 'gdi32' name 'SetColorSpace';
+function DeleteColorSpace(_para1:HCOLORSPACE):WINBOOL; external 'gdi32' name 'DeleteColorSpace';
+function GetDeviceGammaRamp(_para1:HDC; _para2:LPVOID):WINBOOL; external 'gdi32' name 'GetDeviceGammaRamp';
+function SetDeviceGammaRamp(_para1:HDC; _para2:LPVOID):WINBOOL; external 'gdi32' name 'SetDeviceGammaRamp';
+function ColorMatchToTarget(_para1:HDC; _para2:HDC; _para3:DWORD):WINBOOL; external 'gdi32' name 'ColorMatchToTarget';
+function CreatePropertySheetPageA(lppsp:LPCPROPSHEETPAGE):HPROPSHEETPAGE; external 'comctl32' name 'CreatePropertySheetPageA';
+function DestroyPropertySheetPage(hPSPage:HPROPSHEETPAGE):WINBOOL; external 'comctl32' name 'DestroyPropertySheetPage';
+procedure InitCommonControls; external 'comctl32' name 'InitCommonControls';
+function ImageList_AddIcon(himl:HIMAGELIST; hicon:HICON):longint;
+function ImageList_Create(cx:longint; cy:longint; flags:UINT; cInitial:longint; cGrow:longint):HIMAGELIST; external 'comctl32' name 'ImageList_Create';
+function ImageList_Destroy(himl:HIMAGELIST):WINBOOL; external 'comctl32' name 'ImageList_Destroy';
+function ImageList_GetImageCount(himl:HIMAGELIST):longint; external 'comctl32' name 'ImageList_GetImageCount';
+function ImageList_Add(himl:HIMAGELIST; hbmImage:HBITMAP; hbmMask:HBITMAP):longint; external 'comctl32' name 'ImageList_Add';
+function ImageList_ReplaceIcon(himl:HIMAGELIST; i:longint; hicon:HICON):longint; external 'comctl32' name 'ImageList_ReplaceIcon';
+function ImageList_SetBkColor(himl:HIMAGELIST; clrBk:COLORREF):COLORREF; external 'comctl32' name 'ImageList_SetBkColor';
+function ImageList_GetBkColor(himl:HIMAGELIST):COLORREF; external 'comctl32' name 'ImageList_GetBkColor';
+function ImageList_SetOverlayImage(himl:HIMAGELIST; iImage:longint; iOverlay:longint):WINBOOL; external 'comctl32' name 'ImageList_SetOverlayImage';
+function ImageList_Draw(himl:HIMAGELIST; i:longint; hdcDst:HDC; x:longint; y:longint;fStyle:UINT):WINBOOL; external 'comctl32' name 'ImageList_Draw';
+function ImageList_Replace(himl:HIMAGELIST; i:longint; hbmImage:HBITMAP; hbmMask:HBITMAP):WINBOOL; external 'comctl32' name 'ImageList_Replace';
+function ImageList_AddMasked(himl:HIMAGELIST; hbmImage:HBITMAP; crMask:COLORREF):longint; external 'comctl32' name 'ImageList_AddMasked';
+function ImageList_DrawEx(himl:HIMAGELIST; i:longint; hdcDst:HDC; x:longint; y:longint;dx:longint; dy:longint; rgbBk:COLORREF; rgbFg:COLORREF; fStyle:UINT):WINBOOL; external 'comctl32' name 'ImageList_DrawEx';
+function ImageList_Remove(himl:HIMAGELIST; i:longint):WINBOOL; external 'comctl32' name 'ImageList_Remove';
+function ImageList_GetIcon(himl:HIMAGELIST; i:longint; flags:UINT):HICON; external 'comctl32' name 'ImageList_GetIcon';
+function ImageList_BeginDrag(himlTrack:HIMAGELIST; iTrack:longint; dxHotspot:longint; dyHotspot:longint):WINBOOL; external 'comctl32' name 'ImageList_BeginDrag';
+procedure ImageList_EndDrag; external 'comctl32' name 'ImageList_EndDrag';
+function ImageList_DragEnter(hwndLock:HWND; x:longint; y:longint):WINBOOL; external 'comctl32' name 'ImageList_DragEnter';
+function ImageList_DragLeave(hwndLock:HWND):WINBOOL; external 'comctl32' name 'ImageList_DragLeave';
+function ImageList_DragMove(x:longint; y:longint):WINBOOL; external 'comctl32' name 'ImageList_DragMove';
+function ImageList_SetDragCursorImage(himlDrag:HIMAGELIST; iDrag:longint; dxHotspot:longint; dyHotspot:longint):WINBOOL; external 'comctl32' name 'ImageList_SetDragCursorImage';
+function ImageList_DragShowNolock(fShow:WINBOOL):WINBOOL; external 'comctl32' name 'ImageList_DragShowNolock';
+function ImageList_GetDragImage(ppt:LPPOINT; pptHotspot:LPPOINT):HIMAGELIST; external 'comctl32' name 'ImageList_GetDragImage';
+function ImageList_GetIconSize(himl:HIMAGELIST; var cx:longint; var cy:longint):WINBOOL; external 'comctl32' name 'ImageList_GetIconSize';
+function ImageList_SetIconSize(himl:HIMAGELIST; cx:longint; cy:longint):WINBOOL; external 'comctl32' name 'ImageList_SetIconSize';
+function ImageList_GetImageInfo(himl:HIMAGELIST; i:longint; var pImageInfo:IMAGEINFO):WINBOOL; external 'comctl32' name 'ImageList_GetImageInfo';
+function ImageList_Merge(himl1:HIMAGELIST; i1:longint; himl2:HIMAGELIST; i2:longint; dx:longint;dy:longint):HIMAGELIST; external 'comctl32' name 'ImageList_Merge';
+function ImageList_SetImageCount(himl: HIMAGELIST; uNewCount: UINT): Integer; external 'comctl32.dll' name 'ImageList_SetImageCount';
+
+function CreateToolbarEx(hwnd:HWND; ws:DWORD; wID:UINT; nBitmaps:longint; hBMInst:HINST;wBMID:UINT; lpButtons:LPCTBBUTTON; iNumButtons:longint; dxButton:longint; dyButton:longint;dxBitmap:longint;
+ dyBitmap:longint; uStructSize:UINT):HWND; external 'comctl32' name 'CreateToolbarEx';
+function CreateMappedBitmap(hInstance:HINST; idBitmap:longint; wFlags:UINT; lpColorMap:LPCOLORMAP; iNumMaps:longint):HBITMAP; external 'comctl32' name 'CreateMappedBitmap';
+procedure MenuHelp(uMsg:UINT; wParam:WPARAM; lParam:LPARAM; hMainMenu:HMENU; hInst:HINST;hwndStatus:HWND; var lpwIDs:UINT); external 'comctl32' name 'MenuHelp';
+function ShowHideMenuCtl(hWnd:HWND; uFlags:UINT; lpInfo:LPINT):WINBOOL; external 'comctl32' name 'ShowHideMenuCtl';
+procedure GetEffectiveClientRect(hWnd:HWND; lprc:LPRECT; lpInfo:LPINT); external 'comctl32' name 'GetEffectiveClientRect';
+function MakeDragList(hLB:HWND):WINBOOL; external 'comctl32' name 'MakeDragList';
+procedure DrawInsert(handParent:HWND; hLB:HWND; nItem:longint); external 'comctl32' name 'DrawInsert';
+function LBItemFromPt(hLB:HWND; pt:POINT; bAutoScroll:WINBOOL):longint; { external 'comctl32' name 'LBItemFromPt';}
+function CreateUpDownControl(dwStyle:DWORD; x:longint; y:longint; cx:longint; cy:longint;hParent:HWND; nID:longint; hInst:HINST; hBuddy:HWND; nUpper:longint;nLower:longint; nPos:longint):HWND; external 'comctl32' name 'CreateUpDownControl';
+function RegCloseKey(hKey:HKEY):LONG; external 'advapi32' name 'RegCloseKey';
+function RegSetKeySecurity(hKey:HKEY; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):LONG; external 'advapi32' name 'RegSetKeySecurity';
+function RegFlushKey(hKey:HKEY):LONG; external 'advapi32' name 'RegFlushKey';
+function RegGetKeySecurity(hKey:HKEY; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; lpcbSecurityDescriptor:LPDWORD):LONG; external 'advapi32' name 'RegGetKeySecurity';
+function RegNotifyChangeKeyValue(hKey:HKEY; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD; hEvent:HANDLE; fAsynchronus:WINBOOL):LONG; external 'advapi32' name 'RegNotifyChangeKeyValue';
+function IsValidCodePage(CodePage:UINT):WINBOOL; external 'kernel32' name 'IsValidCodePage';
+function GetACP:UINT; external 'kernel32' name 'GetACP';
+function GetOEMCP:UINT; external 'kernel32' name 'GetOEMCP';
+function GetCPInfo(_para1:UINT; _para2:LPCPINFO):WINBOOL; external 'kernel32' name 'GetCPInfo';
+function IsDBCSLeadByte(TestChar:BYTE):WINBOOL; external 'kernel32' name 'IsDBCSLeadByte';
+function IsDBCSLeadByteEx(CodePage:UINT; TestChar:BYTE):WINBOOL; external 'kernel32' name 'IsDBCSLeadByteEx';
+function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:LPCSTR; cchMultiByte:longint; lpWideCharStr:LPWSTR;cchWideChar:longint):longint; external 'kernel32' name 'MultiByteToWideChar';
+function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:LPCWSTR; cchWideChar:longint; lpMultiByteStr:LPSTR;cchMultiByte:longint; lpDefaultChar:LPCSTR; lpUsedDefaultChar:LPBOOL):longint; external 'kernel32' name 'WideCharToMultiByte';
+function IsValidLocale(Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'IsValidLocale';
+function ConvertDefaultLocale(Locale:LCID):LCID; external 'kernel32' name 'ConvertDefaultLocale';
+function GetThreadLocale:LCID; external 'kernel32' name 'GetThreadLocale';
+function SetThreadLocale(Locale:LCID):WINBOOL; external 'kernel32' name 'SetThreadLocale';
+function GetSystemDefaultLangID:LANGID; external 'kernel32' name 'GetSystemDefaultLangID';
+function GetUserDefaultLangID:LANGID; external 'kernel32' name 'GetUserDefaultLangID';
+function GetSystemDefaultLCID:LCID; external 'kernel32' name 'GetSystemDefaultLCID';
+function GetUserDefaultLCID:LCID; external 'kernel32' name 'GetUserDefaultLCID';
+function ReadConsoleOutputAttribute(hConsoleOutput:HANDLE; lpAttribute:LPWORD; nLength:DWORD; dwReadCoord:COORD; lpNumberOfAttrsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputAttribute';
+function WriteConsoleOutputAttribute(hConsoleOutput:HANDLE; var lpAttribute:WORD; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfAttrsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputAttribute';
+function FillConsoleOutputAttribute(hConsoleOutput:HANDLE; wAttribute:WORD; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfAttrsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputAttribute';
+function GetConsoleMode(hConsoleHandle:HANDLE; lpMode:LPDWORD):WINBOOL; external 'kernel32' name 'GetConsoleMode';
+function GetNumberOfConsoleInputEvents(hConsoleInput:HANDLE; lpNumberOfEvents:PDWORD):WINBOOL; external 'kernel32' name 'GetNumberOfConsoleInputEvents';
+function GetConsoleScreenBufferInfo(hConsoleOutput:HANDLE; lpConsoleScreenBufferInfo:PCONSOLE_SCREEN_BUFFER_INFO):WINBOOL; external 'kernel32' name 'GetConsoleScreenBufferInfo';
+//function GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):COORD; external 'kernel32' name 'GetLargestConsoleWindowSize';
+function GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):COORD;
+function GetConsoleCursorInfo(hConsoleOutput:HANDLE; lpConsoleCursorInfo:PCONSOLE_CURSOR_INFO):WINBOOL; external 'kernel32' name 'GetConsoleCursorInfo';
+function GetNumberOfConsoleMouseButtons(lpNumberOfMouseButtons:LPDWORD):WINBOOL; external 'kernel32' name 'GetNumberOfConsoleMouseButtons';
+function SetConsoleMode(hConsoleHandle:HANDLE; dwMode:DWORD):WINBOOL; external 'kernel32' name 'SetConsoleMode';
+function SetConsoleActiveScreenBuffer(hConsoleOutput:HANDLE):WINBOOL; external 'kernel32' name 'SetConsoleActiveScreenBuffer';
+function FlushConsoleInputBuffer(hConsoleInput:HANDLE):WINBOOL; external 'kernel32' name 'FlushConsoleInputBuffer';
+function SetConsoleScreenBufferSize(hConsoleOutput:HANDLE; dwSize:COORD):WINBOOL; external 'kernel32' name 'SetConsoleScreenBufferSize';
+function SetConsoleCursorPosition(hConsoleOutput:HANDLE; dwCursorPosition:COORD):WINBOOL; external 'kernel32' name 'SetConsoleCursorPosition';
+function SetConsoleCursorInfo(hConsoleOutput:HANDLE; lpConsoleCursorInfo:PCONSOLE_CURSOR_INFO):WINBOOL; external 'kernel32' name 'SetConsoleCursorInfo';
+function SetConsoleWindowInfo(hConsoleOutput:HANDLE; bAbsolute:WINBOOL; var lpConsoleWindow:SMALL_RECT):WINBOOL; external 'kernel32' name 'SetConsoleWindowInfo';
+function SetConsoleTextAttribute(hConsoleOutput:HANDLE; wAttributes:WORD):WINBOOL; external 'kernel32' name 'SetConsoleTextAttribute';
+function SetConsoleCtrlHandler(HandlerRoutine:PHANDLER_ROUTINE; Add:WINBOOL):WINBOOL; external 'kernel32' name 'SetConsoleCtrlHandler';
+function GenerateConsoleCtrlEvent(dwCtrlEvent:DWORD; dwProcessGroupId:DWORD):WINBOOL; external 'kernel32' name 'GenerateConsoleCtrlEvent';
+function AllocConsole:WINBOOL; external 'kernel32' name 'AllocConsole';
+function FreeConsole:WINBOOL; external 'kernel32' name 'FreeConsole';
+function CreateConsoleScreenBuffer(dwDesiredAccess:DWORD; dwShareMode:DWORD; var lpSecurityAttributes:SECURITY_ATTRIBUTES; dwFlags:DWORD; lpScreenBufferData:LPVOID):HANDLE; external 'kernel32' name 'CreateConsoleScreenBuffer';
+function GetConsoleCP:UINT; external 'kernel32' name 'GetConsoleCP';
+function SetConsoleCP(wCodePageID:UINT):WINBOOL; external 'kernel32' name 'SetConsoleCP';
+function GetConsoleOutputCP:UINT; external 'kernel32' name 'GetConsoleOutputCP';
+function SetConsoleOutputCP(wCodePageID:UINT):WINBOOL; external 'kernel32' name 'SetConsoleOutputCP';
+function WNetConnectionDialog(hwnd:HWND; dwType:DWORD):DWORD; external 'mpr' name 'WNetConnectionDialog';
+function WNetDisconnectDialog(hwnd:HWND; dwType:DWORD):DWORD; external 'mpr' name 'WNetDisconnectDialog';
+function WNetCloseEnum(hEnum:HANDLE):DWORD; external 'mpr' name 'WNetCloseEnum';
+function CloseServiceHandle(hSCObject:SC_HANDLE):WINBOOL; external 'advapi32' name 'CloseServiceHandle';
+function ControlService(hService:SC_HANDLE; dwControl:DWORD; lpServiceStatus:LPSERVICE_STATUS):WINBOOL; external 'advapi32' name 'ControlService';
+function DeleteService(hService:SC_HANDLE):WINBOOL; external 'advapi32' name 'DeleteService';
+function LockServiceDatabase(hSCManager:SC_HANDLE):SC_LOCK; external 'advapi32' name 'LockServiceDatabase';
+function NotifyBootConfigStatus(BootAcceptable:WINBOOL):WINBOOL; external 'advapi32' name 'NotifyBootConfigStatus';
+function QueryServiceObjectSecurity(hService:SC_HANDLE; dwSecurityInformation:SECURITY_INFORMATION; lpSecurityDescriptor:PSECURITY_DESCRIPTOR; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL;external 'advapi32' name 'QueryServiceObjectSecurity';
+function QueryServiceStatus(hService:SC_HANDLE; lpServiceStatus:LPSERVICE_STATUS):WINBOOL; external 'advapi32' name 'QueryServiceStatus';
+function SetServiceObjectSecurity(hService:SC_HANDLE; dwSecurityInformation:SECURITY_INFORMATION; lpSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL;external 'advapi32' name 'SetServiceObjectSecurity';
+function SetServiceStatus(hServiceStatus:SERVICE_STATUS_HANDLE; lpServiceStatus:LPSERVICE_STATUS):WINBOOL; external 'advapi32' name 'SetServiceStatus';
+function UnlockServiceDatabase(ScLock:SC_LOCK):WINBOOL; external 'advapi32' name 'UnlockServiceDatabase';
+function ChoosePixelFormat(_para1:HDC; _para2:PPIXELFORMATDESCRIPTOR):longint; external 'gdi32' name 'ChoosePixelFormat';
+function DescribePixelFormat(_para1:HDC; _para2:longint; _para3:UINT; _para4:LPPIXELFORMATDESCRIPTOR):longint; external 'gdi32' name 'DescribePixelFormat';
+{$ifdef Unknown_functions}{ WARNING: function is not in my gdi32.dll !! PM}function GetEnhMetaFilePixelFormat(_para1:HENHMETAFILE; _para2:DWORD; var _para3:PIXELFORMATDESCRIPTOR):UINT; external 'gdi32' name 'GetEnhMetaFilePixelFormat';
+{$endif Unknown_functions}{ function GetPixelFormat(_para1:HDC):longint; external 'gdi32' name 'GetPixelFormat'; }
+function SetPixelFormat(_para1:HDC; _para2:longint;_para3:PPIXELFORMATDESCRIPTOR):WINBOOL; external 'gdi32' name 'SetPixelFormat';
+function SwapBuffers(_para1:HDC):WINBOOL; external 'gdi32' name 'SwapBuffers';
+function DragQueryPoint(_para1:HDROP; _para2:LPPOINT):WINBOOL; external 'shell32' name 'DragQueryPoint';
+procedure DragFinish(_para1:HDROP); external 'shell32' name 'DragFinish';
+procedure DragAcceptFiles(_para1:HWND; _para2:WINBOOL); external 'shell32' name 'DragAcceptFiles';
+function DuplicateIcon(_para1:HINST; _para2:HICON):HICON; external 'shell32' name 'DuplicateIcon';
+function DdeAbandonTransaction(_para1:DWORD; _para2:HCONV; _para3:DWORD):BOOL;external 'user32' name 'DdeAbandonTransaction';
+function DdeAccessData(_para1:HDDEDATA; _para2:PDWORD):PBYTE;external 'user32' name 'DdeAccessData';
+function DdeAddData(_para1:HDDEDATA; _para2:PBYTE; _para3:DWORD; _para4:DWORD):HDDEDATA;external 'user32' name 'DdeAddData';
+{ This is only a prototype PM
+function DdeCallback(_para1, _para2:UINT; _para3:HCONV; _para4, _para5:HSZ;_para6: HDDEDATA; _para7, _para8:PDWORD):HDDEDATA;external 'user32' name 'DdeCallback';}
+function DdeClientTransaction(_para1:PBYTE; _para2:DWORD; _para3:HCONV; _para4:HSZ; _para5:UINT;
+ _para6:UINT; _para7:DWORD; _para8:PDWORD):HDDEDATA;external 'user32' name 'DdeClientTransaction';
+function DdeCmpStringHandles(_para1:HSZ; _para2:HSZ):longint; external 'user32' name 'DdeCmpStringHandles';
+function DdeConnect(_para1:DWORD; _para2:HSZ; _para3:HSZ; var _para4:CONVCONTEXT):HCONV; external 'user32' name 'DdeConnect';
+function DdeConnectList(_para1:DWORD; _para2:HSZ; _para3:HSZ; _para4:HCONVLIST; _para5:PCONVCONTEXT):HCONVLIST;external 'user32' name 'DdeConnectList';
+function DdeCreateDataHandle(_para1:DWORD; _para2:LPBYTE; _para3:DWORD; _para4:DWORD; _para5:HSZ;_para6:UINT; _para7:UINT):HDDEDATA; external 'user32' name 'DdeCreateDataHandle';
+function DdeDisconnect(_para1:HCONV):WINBOOL; external 'user32' name 'DdeDisconnect';
+function DdeDisconnectList(_para1:HCONVLIST):BOOL;external 'user32' name 'DdeDisconnectList';
+function DdeEnableCallback(_para1:DWORD; _para2:HCONV; _para3:UINT):BOOL;external 'user32' name 'DdeEnableCallback';
+function DdeFreeDataHandle(_para1:HDDEDATA):WINBOOL; external 'user32' name 'DdeFreeDataHandle';
+function DdeFreeStringHandle(_para1:DWORD;_para2:HSZ):WINBOOL; external 'user32' name 'DdeFreeStringHandle';
+function DdeGetData(_para1:HDDEDATA;_para2:LPBYTE; _para3:DWORD; _para4:DWORD):DWORD; external 'user32' name 'DdeGetData';
+function DdeGetLastError(_para1:DWORD):UINT; external 'user32' name 'DdeGetLastError';
+function DdeImpersonateClient(_para1:HCONV):BOOL;external 'user32' name 'DdeImpersonateClient';
+function DdeKeepStringHandle(_para1:DWORD; _para2:HSZ):BOOL;external 'user32' name 'DdeKeepStringHandle';
+function DdeNameService(_para1:DWORD; _para2:HSZ; _para3:HSZ; _para4:UINT):HDDEDATA; external 'user32' name 'DdeNameService';
+function DdePostAdvise(_para1:DWORD; _para2:HSZ; _para3:HSZ):WINBOOL; external 'user32' name 'DdePostAdvise';
+function DdeQueryConvInfo(_para1:HCONV; _para2:DWORD; _para3:PCONVINFO):UINT;external 'user32' name 'DdeQueryConvInfo';
+function DdeQueryNextServer(_para1:HCONVLIST; _para2:HCONV):HCONV;external 'user32' name 'DdeQueryNextServer';
+function DdeReconnect(_para1:HCONV):HCONV; external 'user32' name 'DdeReconnect';
+function DdeSetUserHandle(_para1:HCONV; _para2:DWORD; _para3:DWORD):BOOL;external 'user32' name 'DdeSetUserHandle';
+function DdeUnaccessData(_para1:HDDEDATA):BOOL;external 'user32' name 'DdeUnaccessData';
+function DdeUninitialize(_para1:DWORD):WINBOOL; external 'user32' name 'DdeUninitialize';
+{$ifdef Unknown_functions}
+function NetUserEnum(_para1:LPWSTR; _para2:DWORD; _para3:DWORD; var _para4:LPBYTE; _para5:DWORD;_para6:LPDWORD; _para7:LPDWORD; _para8:LPDWORD):DWORD; external 'netapi32' name 'NetUserEnum';
+function NetApiBufferFree(_para1:LPVOID):DWORD; external 'netapi32' name 'NetApiBufferFree';
+function NetUserGetInfo(_para1:LPWSTR; _para2:LPWSTR; _para3:DWORD; _para4:LPBYTE):DWORD; external 'netapi32' name 'NetUserGetInfo';
+function NetGetDCName(_para1:LPWSTR; _para2:LPWSTR; var _para3:LPBYTE):DWORD; external 'netapi32' name 'NetGetDCName';
+function NetGroupEnum(_para1:LPWSTR; _para2:DWORD; var _para3:LPBYTE; _para4:DWORD; _para5:LPDWORD;_para6:LPDWORD; _para7:LPDWORD):DWORD; external 'netapi32' name 'NetGroupEnum';
+function NetLocalGroupEnum(_para1:LPWSTR; _para2:DWORD; var _para3:LPBYTE; _para4:DWORD; _para5:LPDWORD;_para6:LPDWORD; _para7:LPDWORD):DWORD; external 'netapi32' name 'NetLocalGroupEnum';
+{$endif Unknown_functions}
+procedure SHAddToRecentDocs(_para1:UINT; _para2:LPCVOID); external 'shell32' name 'SHAddToRecentDocs';
+function SHBrowseForFolder(_para1:LPBROWSEINFO):LPITEMIDLIST; external 'shell32' name 'SHBrowseForFolder';
+procedure SHChangeNotify(_para1:LONG; _para2:UINT; _para3:LPCVOID; _para4:LPCVOID); external 'shell32' name 'SHChangeNotify';
+function SHFileOperation(_para1:LPSHFILEOPSTRUCT):longint; external 'shell32' name 'SHFileOperation';
+procedure SHFreeNameMappings(_para1:HANDLE); external 'shell32' name 'SHFreeNameMappings';
+function SHGetFileInfo(_para1:LPCTSTR; _para2:DWORD; var _para3:SHFILEINFO; _para4:UINT; _para5:UINT):DWORD; external 'shell32' name 'SHGetFileInfo';
+function SHGetPathFromIDList(_para1:LPCITEMIDLIST; _para2:LPTSTR):WINBOOL; external 'shell32' name 'SHGetPathFromIDList';
+function SHGetSpecialFolderLocation(_para1:HWND; _para2:longint; var _para3:LPITEMIDLIST):HRESULT; external 'shell32' name 'SHGetSpecialFolderLocation';
+
+{ was missing, bug report 1808 PM }
+function CommDlgExtendedError : DWORD; external 'comdlg32' name 'CommDlgExtendedError';
+
+{ wgl Windows OpenGL helper functions }
+function wglUseFontBitmaps(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD):WINBOOL; external 'opengl32' name 'wglUseFontBitmapsA';
+function wglCreateContext(_para1:HDC):HGLRC; external 'opengl32' name 'wglCreateContext';
+function wglCreateLayerContext(_para1:HDC; _para2:longint):HGLRC; external 'opengl32' name 'wglCreateLayerContext';
+function wglCopyContext(_para1:HGLRC; _para2:HGLRC; _para3:UINT):WINBOOL; external 'opengl32' name 'wglCopyContext';
+function wglDeleteContext(_para1:HGLRC):WINBOOL; external 'opengl32' name 'wglDeleteContext';
+function wglGetCurrentContext:HGLRC; external 'opengl32' name 'wglGetCurrentContext';
+function wglGetCurrentDC:HDC; external 'opengl32' name 'wglGetCurrentDC';
+function wglMakeCurrent(_para1:HDC; _para2:HGLRC):WINBOOL; external 'opengl32' name 'wglMakeCurrent';
+function wglShareLists(_para1:HGLRC; _para2:HGLRC):WINBOOL; external 'opengl32' name 'wglShareLists';
+function wglUseFontBitmapsW(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD):WINBOOL; external 'opengl32' name 'wglUseFontBitmapsW';
+{ Delphi doesn't declare these, but we do: }
+function wglUseFontOutlines(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD; _para5:Single;
+ _para6:Single; _para7:longint; _para8:LPGLYPHMETRICSFLOAT):WINBOOL; external 'opengl32' name 'wglUseFontOutlinesA';
+function wglUseFontBitmapsA(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD):WINBOOL; external 'opengl32' name 'wglUseFontBitmapsA';
+function wglUseFontOutlinesA(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD; _para5:Single;
+ _para6:Single; _para7:longint; _para8:LPGLYPHMETRICSFLOAT):WINBOOL; external 'opengl32' name 'wglUseFontOutlinesA';
+function wglDescribeLayerPlane(_para1:HDC; _para2:longint; _para3:longint; _para4:UINT; _para5:LPLAYERPLANEDESCRIPTOR):WINBOOL; external 'opengl32' name 'wglDescribeLayerPlane';
+function wglGetLayerPaletteEntries(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; var _para5:COLORREF):longint; external 'opengl32' name 'wglGetLayerPaletteEntries';
+function wglGetProcAddress(_para1:LPCSTR):PROC; external 'opengl32' name 'wglGetProcAddress';
+function wglRealizeLayerPalette(_para1:HDC; _para2:longint; _para3:WINBOOL):WINBOOL; external 'opengl32' name 'wglRealizeLayerPalette';
+function wglSetLayerPaletteEntries(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; var _para5:COLORREF):longint; external 'opengl32' name 'wglSetLayerPaletteEntries';
+function wglSwapLayerBuffers(_para1:HDC; _para2:UINT):WINBOOL; external 'opengl32' name 'wglSwapLayerBuffers';
+function wglUseFontOutlinesW(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD; _para5:Single;
+ _para6:Single; _para7:longint; _para8:LPGLYPHMETRICSFLOAT):WINBOOL; external 'opengl32' name 'wglUseFontOutlinesW';
+
+{ translated macros }
+function Animate_Create(hWndP:HWND; id:HMENU;dwStyle:DWORD;hInstance:HINST):HWND;
+function Animate_Open(hwnd : HWND;szName : LPTSTR) : LRESULT;
+function Animate_Play(hwnd : HWND;from,_to : longint;rep : UINT) : LRESULT;
+function Animate_Stop(hwnd : HWND) : LRESULT;
+function Animate_Close(hwnd : HWND) : LRESULT;
+function Animate_Seek(hwnd : HWND;frame : longint) : LRESULT;
+function PropSheet_AddPage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE) : LRESULT;
+function PropSheet_Apply(hPropSheetDlg : HWND) : LRESULT;
+function PropSheet_CancelToClose(hPropSheetDlg : HWND) : LRESULT;
+function PropSheet_Changed(hPropSheetDlg,hwndPage : HWND) : LRESULT;
+function PropSheet_GetCurrentPageHwnd(hDlg : HWND) : LRESULT;
+function PropSheet_GetTabControl(hPropSheetDlg : HWND) : LRESULT;
+function PropSheet_IsDialogMessage(hDlg : HWND;pMsg : longint) : LRESULT;
+function PropSheet_PressButton(hPropSheetDlg : HWND;iButton : longint) : LRESULT;
+function PropSheet_QuerySiblings(hPropSheetDlg : HWND;param1,param2 : longint) : LRESULT;
+function PropSheet_RebootSystem(hPropSheetDlg : HWND) : LRESULT;
+function PropSheet_RemovePage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : longint) : LRESULT;
+function PropSheet_RestartWindows(hPropSheetDlg : HWND) : LRESULT;
+function PropSheet_SetCurSel(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : longint) : LRESULT;
+function PropSheet_SetCurSelByID(hPropSheetDlg : HWND; id : longint) : LRESULT;
+function PropSheet_SetFinishText(hPropSheetDlg:HWND;lpszText : LPTSTR) : LRESULT;
+function PropSheet_SetTitle(hPropSheetDlg:HWND;dwStyle:DWORD;lpszText : LPCTSTR) : LRESULT;
+function PropSheet_SetWizButtons(hPropSheetDlg:HWND;dwFlags : DWORD) : LRESULT;
+function PropSheet_UnChanged(hPropSheetDlg:HWND;hwndPage : HWND) : LRESULT;
+function Header_DeleteItem(hwndHD:HWND;index : longint) : WINBOOL;
+function Header_GetItem(hwndHD:HWND;index:longint;var hdi : HD_ITEM) : WINBOOL;
+function Header_GetItemCount(hwndHD : HWND) : longint;
+function Header_InsertItem(hwndHD:HWND;index : longint;var hdi : HD_ITEM) : longint;
+function Header_Layout(hwndHD:HWND;var layout : HD_LAYOUT) : WINBOOL;
+function Header_SetItem(hwndHD:HWND;index : longint;var hdi : HD_ITEM) : WINBOOL;
+function ListView_Arrange(hwndLV:HWND;code : UINT) : LRESULT;
+function ListView_CreateDragImage(hwnd:HWND;i : longint;lpptUpLeft : LPPOINT) : LRESULT;
+function ListView_DeleteAllItems(hwnd : HWND) : LRESULT;
+function ListView_DeleteColumn(hwnd:HWND;iCol : longint) : LRESULT;
+function ListView_DeleteItem(hwnd:HWND;iItem : longint) : LRESULT;
+function ListView_EditLabel(hwndLV:HWND;i : longint) : LRESULT;
+function ListView_EnsureVisible(hwndLV:HWND;i,fPartialOK : longint) : LRESULT;
+function ListView_FindItem(hwnd:HWND;iStart : longint;var lvfi : LV_FINDINFO) : longint;
+function ListView_GetBkColor(hwnd : HWND) : LRESULT;
+function ListView_GetCallbackMask(hwnd : HWND) : LRESULT;
+function ListView_GetColumn(hwnd:HWND;iCol : longint;var col : LV_COLUMN) : LRESULT;
+function ListView_GetColumnWidth(hwnd:HWND;iCol : longint) : LRESULT;
+function ListView_GetCountPerPage(hwndLV : HWND) : LRESULT;
+function ListView_GetEditControl(hwndLV : HWND) : LRESULT;
+function ListView_GetImageList(hwnd:HWND;iImageList : wINT) : LRESULT;
+function ListView_GetISearchString(hwndLV:HWND;lpsz : LPTSTR) : LRESULT;
+function ListView_GetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
+function ListView_GetItemCount(hwnd : HWND) : LRESULT;
+function ListView_GetItemPosition(hwndLV:HWND;i : longint;var pt : POINT) : longint;
+function ListView_GetItemSpacing(hwndLV:HWND;fSmall : longint) : LRESULT;
+function ListView_GetItemState(hwndLV:HWND;i,mask : longint) : LRESULT;
+function ListView_GetNextItem(hwnd:HWND; iStart, flags : longint) : LRESULT;
+function ListView_GetOrigin(hwndLV:HWND;var pt : POINT) : LRESULT;
+function ListView_GetSelectedCount(hwndLV : HWND) : LRESULT;
+function ListView_GetStringWidth(hwndLV:HWND;psz : LPCTSTR) : LRESULT;
+function ListView_GetTextBkColor(hwnd : HWND) : LRESULT;
+function ListView_GetTextColor(hwnd : HWND) : LRESULT;
+function ListView_GetTopIndex(hwndLV : HWND) : LRESULT;
+function ListView_GetViewRect(hwnd:HWND;var rc : RECT) : LRESULT;
+function ListView_HitTest(hwndLV:HWND;var info : LV_HITTESTINFO) : LRESULT;
+function ListView_InsertColumn(hwnd:HWND;iCol : longint;var col : LV_COLUMN) : LRESULT;
+function ListView_InsertItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
+function ListView_RedrawItems(hwndLV:HWND;iFirst,iLast : longint) : LRESULT;
+function ListView_Scroll(hwndLV:HWND;dx,dy : longint) : LRESULT;
+function ListView_SetBkColor(hwnd:HWND;clrBk : COLORREF) : LRESULT;
+function ListView_SetCallbackMask(hwnd:HWND;mask : UINT) : LRESULT;
+function ListView_SetColumn(hwnd:HWND;iCol : longint; var col : LV_COLUMN) : LRESULT;
+function ListView_SetColumnWidth(hwnd:HWND;iCol,cx : longint) : LRESULT;
+function ListView_SetImageList(hwnd:HWND;himl : longint;iImageList : HIMAGELIST) : LRESULT;
+function ListView_SetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
+function ListView_SetItemCount(hwndLV:HWND;cItems : longint) : LRESULT;
+function ListView_SetItemPosition(hwndLV:HWND;i,x,y : longint) : LRESULT;
+function ListView_SetItemPosition32(hwndLV:HWND;i,x,y : longint) : LRESULT;
+function ListView_SetItemState(hwndLV:HWND; i, data, mask:longint) : LRESULT;
+function ListView_SetItemText(hwndLV:HWND; i, iSubItem_:longint;pszText_ : LPTSTR) : LRESULT;
+function ListView_SetTextBkColor(hwnd:HWND;clrTextBk : COLORREF) : LRESULT;
+function ListView_SetTextColor(hwnd:HWND;clrText : COLORREF) : LRESULT;
+function ListView_SortItems(hwndLV:HWND;_pfnCompare:PFNLVCOMPARE;_lPrm : LPARAM) : LRESULT;
+function ListView_Update(hwndLV:HWND;i : longint) : LRESULT;
+function TreeView_InsertItem(hwnd:HWND;lpis : LPTV_INSERTSTRUCT) : LRESULT;
+function TreeView_DeleteItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_DeleteAllItems(hwnd : HWND) : LRESULT;
+function TreeView_Expand(hwnd:HWND;hitem:HTREEITEM;code : longint) : LRESULT;
+function TreeView_GetCount(hwnd : HWND) : LRESULT;
+function TreeView_GetIndent(hwnd : HWND) : LRESULT;
+function TreeView_SetIndent(hwnd:HWND;indent : longint) : LRESULT;
+function TreeView_GetImageList(hwnd:HWND;iImage : WPARAM) : LRESULT;
+function TreeView_SetImageList(hwnd:HWND;himl:HIMAGELIST;iImage : WPARAM) : LRESULT;
+function TreeView_GetNextItem(hwnd:HWND;hitem:HTREEITEM;code : longint) : LRESULT;
+function TreeView_GetChild(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetNextSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetPrevSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetParent(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetFirstVisible(hwnd : HWND) : LRESULT;
+function TreeView_GetNextVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetPrevVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetSelection(hwnd : HWND) : LRESULT;
+function TreeView_GetDropHilight(hwnd : HWND) : LRESULT;
+function TreeView_GetRoot(hwnd : HWND) : LRESULT;
+function TreeView_Select(hwnd:HWND;hitem:HTREEITEM;code : longint) : LRESULT;
+function TreeView_SelectItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_SelectDropTarget(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_SelectSetFirstVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
+function TreeView_SetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
+function TreeView_EditLabel(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_GetEditControl(hwnd : HWND) : LRESULT;
+function TreeView_GetVisibleCount(hwnd : HWND) : LRESULT;
+function TreeView_HitTest(hwnd:HWND;lpht : LPTV_HITTESTINFO) : LRESULT;
+function TreeView_CreateDragImage(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_SortChildren(hwnd:HWND;hitem:HTREEITEM;recurse : longint) : LRESULT;
+function TreeView_EnsureVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+function TreeView_SortChildrenCB(hwnd:HWND;psort:LPTV_SORTCB;recurse : longint) : LRESULT;
+function TreeView_EndEditLabelNow(hwnd:HWND;fCancel : longint) : LRESULT;
+function TreeView_GetISearchString(hwndTV:HWND;lpsz : LPTSTR) : LRESULT;
+function TabCtrl_GetImageList(hwnd : HWND) : LRESULT;
+function TabCtrl_SetImageList(hwnd:HWND;himl : HIMAGELIST) : LRESULT;
+function TabCtrl_GetItemCount(hwnd : HWND) : LRESULT;
+function TabCtrl_GetItem(hwnd:HWND;iItem : longint;var item : TC_ITEM) : LRESULT;
+function TabCtrl_SetItem(hwnd:HWND;iItem : longint;var item : TC_ITEM) : LRESULT;
+function TabCtrl_InsertItem(hwnd:HWND;iItem : longint;var item : TC_ITEM) : LRESULT;
+function TabCtrl_DeleteItem(hwnd:HWND;i : longint) : LRESULT;
+function TabCtrl_DeleteAllItems(hwnd : HWND) : LRESULT;
+function TabCtrl_GetItemRect(hwnd:HWND;i : longint;var rc : RECT) : LRESULT;
+function TabCtrl_GetCurSel(hwnd : HWND) : LRESULT;
+function TabCtrl_SetCurSel(hwnd:HWND;i : longint) : LRESULT;
+function TabCtrl_HitTest(hwndTC:HWND;var info : TC_HITTESTINFO) : LRESULT;
+function TabCtrl_SetItemExtra(hwndTC:HWND;cb : longint) : LRESULT;
+function TabCtrl_AdjustRect(hwnd:HWND;bLarger:WINBOOL;var rc : RECT) : LRESULT;
+function TabCtrl_SetItemSize(hwnd:HWND;x,y : longint) : LRESULT;
+function TabCtrl_RemoveImage(hwnd:HWND;i : WPARAM) : LRESULT;
+function TabCtrl_SetPadding(hwnd:HWND;cx,cy : longint) : LRESULT;
+function TabCtrl_GetRowCount(hwnd : HWND) : LRESULT;
+function TabCtrl_GetToolTips(hwnd : HWND) : LRESULT;
+function TabCtrl_SetToolTips(hwnd:HWND;hwndTT : longint) : LRESULT;
+function TabCtrl_GetCurFocus(hwnd : HWND) : LRESULT;
+function TabCtrl_SetCurFocus(hwnd:HWND;i : longint) : LRESULT;
+function SNDMSG(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
+function CommDlg_OpenSave_GetSpecA(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+function CommDlg_OpenSave_GetSpecW(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+{$ifndef Unicode}
+function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+{$else Unicode}
+function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+{$endif Unicode}
+function CommDlg_OpenSave_GetFilePathA(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+function CommDlg_OpenSave_GetFilePathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+{$ifndef Unicode}
+function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+{$else Unicode}
+function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+{$endif Unicode}
+function CommDlg_OpenSave_GetFolderPathA(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+function CommDlg_OpenSave_GetFolderPathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+{$ifndef Unicode}
+function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+{$else Unicode}
+function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+{$endif Unicode}
+function CommDlg_OpenSave_GetFolderIDList(_hdlg:HWND;_pidl:LPVOID;_cbmax : longint) : LRESULT;
+function CommDlg_OpenSave_SetControlText(_hdlg:HWND;_id : longint;_text : LPSTR) : LRESULT;
+function CommDlg_OpenSave_HideControl(_hdlg:HWND;_id : longint) : LRESULT;
+function CommDlg_OpenSave_SetDefExt(_hdlg:HWND;_pszext : LPSTR) : LRESULT;
+
+function GlobalAllocPtr(flags,cb:DWord):Pointer;
+function GlobalFreePtr(lp:Pointer):Pointer;
+function GlobalUnlockPtr(lp:pointer):Pointer;
+function GlobalLockPtr(lp:pointer):Pointer;
+function GlobalReAllocPtr(lp:Pointer;cbNew,flags:DWord):Pointer;
+function GlobalPtrHandle(lp:pointer):Pointer;
+function SetLayeredWindowAttributes(HWND:hwnd;crKey :COLORREF;bAlpha : byte;dwFlags : DWORD):WINBOOL; external 'user32' name 'SetLayeredWindowAttributes';
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+{ Win32 API calling convention
+ pushes POINT struct passed by value directly
+ on stack instead of just pushing an address
+ to overcome this we use a internal function
+ that just pushes the two arguments.
+ Bug report 1807. PM }
+
+function Internal_MenuItemFromPoint(hWnd:HWND; hMenu:HMENU; ptScreenX, ptScreenY : LONG):longint; external 'user32' name 'MenuItemFromPoint';
+
+function MenuItemFromPoint(hWnd:HWND; hMenu:HMENU; ptScreen:POINT):longint; {external 'user32' name 'MenuItemFromPoint';}
+begin
+ MenuItemFromPoint:=Internal_MenuItemFromPoint(hWnd, hMenu, ptScreen.X, ptScreen.Y);
+end;
+
+function Internal_DragDetect(hwnd:HWND; ptX, ptY : LONG):WINBOOL; external 'user32' name 'DragDetect';
+
+function DragDetect(hwnd:HWND; pt:POINT):WINBOOL; {external 'user32' name 'DragDetect';}
+begin
+ DragDetect:=Internal_DragDetect(hWnd, pt.X, pt.Y);
+end;
+
+function Internal_WindowFromPoint(PointX,PointY : LONG):HWND; external 'user32' name 'WindowFromPoint';
+
+function WindowFromPoint(Point:POINT):HWND;
+begin
+ WindowFromPoint:=Internal_WindowFromPoint(Point.X, Point.Y);
+end;
+
+function Internal_ChildWindowFromPoint(hWndParent:HWND; PointX,PointY : LONG):HWND; external 'user32' name 'ChildWindowFromPoint';
+
+function ChildWindowFromPoint(hWndParent:HWND; Point:POINT):HWND;
+begin
+ ChildWindowFromPoint:=Internal_ChildWindowFromPoint(hWndParent, Point.X, Point.Y);
+end;
+
+function Internal_PtInRect(var lprc:RECT; ptX,ptY : LONG):WINBOOL; external 'user32' name 'PtInRect';
+
+function PtInRect(var lprc:RECT; pt:POINT):WINBOOL;
+begin
+ PtInRect:=Internal_PtInRect(lprc,pt.X,pt.Y);
+end;
+
+function PtInRect(lprc:LPRECT; pt:POINT):WINBOOL;
+begin
+ PtInRect:=Internal_PtInRect(lprc^,pt.X,pt.Y);
+end;
+
+function Internal_ChildWindowFromPointEx(_para1:HWND; _para2X,_Para2Y : LONG; _para3:UINT):HWND; external 'user32' name 'ChildWindowFromPointEx';
+
+function ChildWindowFromPointEx(_para1:HWND; _para2:POINT; _para3:UINT):HWND;
+begin
+ ChildWindowFromPointEx:=Internal_ChildWindowFromPointEx(_para1,_para2.X,_para2.Y,_para3);
+end;
+
+function Internal_LBItemFromPt(hLB:HWND; ptX, ptY : LONG; bAutoScroll:WINBOOL):longint; external 'comctl32' name 'LBItemFromPt';
+
+function LBItemFromPt(hLB:HWND; pt:POINT; bAutoScroll:WINBOOL):longint; { external 'comctl32' name 'LBItemFromPt';}
+begin
+ LBItemFromPt:=Internal_LBItemFromPt(hLB, pt.X, pt.Y, bAutoScroll);
+end;
+
+{ End of bug fixes for bug report 1807. PM }
+
+function GlobalDiscard(hglbMem:HGLOBAL):HGLOBAL;
+begin
+ GlobalDiscard:=GlobalReAlloc(hglbMem,0,GMEM_MOVEABLE);
+end;
+
+
+function LocalDiscard(hlocMem:HLOCAL):HLOCAL;
+begin
+ LocalDiscard := LocalReAlloc(hlocMem,0,LMEM_MOVEABLE);
+end;
+
+
+procedure MoveMemory(Destination:PVOID; Source:pointer; Length:DWORD);
+begin
+ Move(Source^,Destination^,Length);
+end;
+
+
+procedure CopyMemory(Destination:PVOID; Source:pointer; Length:DWORD);
+begin
+ Move(Source^, Destination^, Length);
+end;
+
+
+procedure FillMemory(Destination:PVOID; Length:DWORD; Fill:BYTE);
+begin
+ FillChar(Destination^,Length,Char(Fill));
+end;
+
+
+procedure ZeroMemory(Destination:PVOID; Length:DWORD);
+begin
+ FillChar(Destination^,Length,#0);
+end;
+
+
+function GlobalAllocPtr(flags,cb:DWord):Pointer;
+begin
+ GlobalAllocPtr:=GlobalLock(GlobalAlloc(flags,cb));
+end;
+
+
+function GlobalFreePtr(lp:Pointer):Pointer;
+begin
+ GlobalFreePtr:=Pointer(GlobalFree(HWND(GlobalUnlockPtr(lp))));
+end;
+
+
+function GlobalUnlockPtr(lp:pointer):Pointer;
+begin
+ GlobalUnlock(GlobalHandle(lp));
+ GlobalUnlockPtr:=lp;
+end;
+
+
+function GlobalLockPtr(lp:pointer):Pointer;
+begin
+ GlobalLockPtr:=GlobalLock(GlobalHandle(lp));
+end;
+
+
+function GlobalReAllocPtr(lp:Pointer;cbNew,flags:DWord):Pointer;
+begin
+ GlobalReAllocPtr:=GlobalLock(GlobalReAlloc(HWND(GlobalUnlockPtr(lp)),cbNew,flags));
+end;
+
+
+function GlobalPtrHandle(lp:pointer):Pointer;
+begin
+ GlobalPtrHandle:=Pointer(GlobalHandle(lp));
+end;
+
+
+function ImageList_AddIcon(himl:HIMAGELIST; hicon:HICON):longint;
+begin
+ ImageList_AddIcon:=ImageList_ReplaceIcon(himl,-(1),hicon);
+end;
+
+
+function Animate_Create(hWndP:HWND; id:HMENU;dwStyle:DWORD;hInstance:HINST):HWND;
+begin
+ Animate_Create:=CreateWindow(LPCSTR(ANIMATE_CLASS),nil,dwStyle,0,0,0,0,hwndP,id,hInstance,nil);
+end;
+
+
+function Animate_Open(hwnd : HWND;szName : LPTSTR) : LRESULT;
+begin
+ Animate_Open:=SendMessage(hwnd,ACM_OPEN,0,LPARAM(szName));
+end;
+
+
+function Animate_Play(hwnd : HWND;from,_to : longint;rep : UINT) : LRESULT;
+begin
+ Animate_Play:=SendMessage(hwnd,ACM_PLAY,WPARAM(rep),LPARAM(MAKELONG(from,_to)));
+end;
+
+
+function Animate_Stop(hwnd : HWND) : LRESULT;
+begin
+ Animate_Stop:=SendMessage(hwnd,ACM_STOP,0,0);
+end;
+
+
+function Animate_Close(hwnd : HWND) : LRESULT;
+begin
+ Animate_Close:=Animate_Open(hwnd,nil);
+end;
+
+
+function Animate_Seek(hwnd : HWND;frame : longint) : LRESULT;
+begin
+ Animate_Seek:=Animate_Play(hwnd,frame,frame,1);
+end;
+
+
+function PropSheet_AddPage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE) : LRESULT;
+begin
+ PropSheet_AddPage:=SendMessage(hPropSheetDlg,PSM_ADDPAGE,0,LPARAM(hpage));
+end;
+
+
+function PropSheet_Apply(hPropSheetDlg : HWND) : LRESULT;
+begin
+ PropSheet_Apply:=SendMessage(hPropSheetDlg,PSM_APPLY,0,0);
+end;
+
+
+function PropSheet_CancelToClose(hPropSheetDlg : HWND) : LRESULT;
+begin
+ PropSheet_CancelToClose:=SendMessage(hPropSheetDlg,PSM_CANCELTOCLOSE,0,0);
+end;
+
+
+function PropSheet_Changed(hPropSheetDlg,hwndPage : HWND) : LRESULT;
+begin
+ PropSheet_Changed:=SendMessage(hPropSheetDlg,PSM_CHANGED,WPARAM(hwndPage),0);
+end;
+
+
+function PropSheet_GetCurrentPageHwnd(hDlg : HWND) : LRESULT;
+begin
+ PropSheet_GetCurrentPageHwnd:=SendMessage(hDlg,PSM_GETCURRENTPAGEHWND,0,0);
+end;
+
+
+function PropSheet_GetTabControl(hPropSheetDlg : HWND) : LRESULT;
+begin
+ PropSheet_GetTabControl:=SendMessage(hPropSheetDlg,PSM_GETTABCONTROL,0,0);
+end;
+
+
+function PropSheet_IsDialogMessage(hDlg : HWND;pMsg : longint) : LRESULT;
+begin
+ PropSheet_IsDialogMessage:=SendMessage(hDlg,PSM_ISDIALOGMESSAGE,0,LPARAM(pMsg));
+end;
+
+
+function PropSheet_PressButton(hPropSheetDlg : HWND;iButton : longint) : LRESULT;
+begin
+ PropSheet_PressButton:=SendMessage(hPropSheetDlg,PSM_PRESSBUTTON,WPARAM(longint(iButton)),0);
+end;
+
+
+function PropSheet_QuerySiblings(hPropSheetDlg : HWND;param1,param2 : longint) : LRESULT;
+begin
+ PropSheet_QuerySiblings:=SendMessage(hPropSheetDlg,PSM_QUERYSIBLINGS,WPARAM(param1),LPARAM(param2));
+end;
+
+
+function PropSheet_RebootSystem(hPropSheetDlg : HWND) : LRESULT;
+begin
+ PropSheet_RebootSystem:=SendMessage(hPropSheetDlg,PSM_REBOOTSYSTEM,0,0);
+end;
+
+
+function PropSheet_RemovePage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : longint) : LRESULT;
+begin
+ PropSheet_RemovePage:=SendMessage(hPropSheetDlg,PSM_REMOVEPAGE,WPARAM(index),LPARAM(hpage));
+end;
+
+
+function PropSheet_RestartWindows(hPropSheetDlg : HWND) : LRESULT;
+begin
+ PropSheet_RestartWindows:=SendMessage(hPropSheetDlg,PSM_RESTARTWINDOWS,0,0);
+end;
+
+
+function PropSheet_SetCurSel(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : longint) : LRESULT;
+begin
+ PropSheet_SetCurSel:=SendMessage(hPropSheetDlg,PSM_SETCURSEL,WPARAM(index),LPARAM(hpage));
+end;
+
+
+function PropSheet_SetCurSelByID(hPropSheetDlg : HWND; id : longint) : LRESULT;
+begin
+ PropSheet_SetCurSelByID:=SendMessage(hPropSheetDlg,PSM_SETCURSELID,0,LPARAM(id));
+end;
+
+
+function PropSheet_SetFinishText(hPropSheetDlg:HWND;lpszText : LPTSTR) : LRESULT;
+begin
+ PropSheet_SetFinishText:=SendMessage(hPropSheetDlg,PSM_SETFINISHTEXT,0,LPARAM(lpszText));
+end;
+
+
+function PropSheet_SetTitle(hPropSheetDlg:HWND;dwStyle:DWORD;lpszText : LPCTSTR) : LRESULT;
+begin
+ PropSheet_SetTitle:=SendMessage(hPropSheetDlg,PSM_SETTITLE,WPARAM(dwStyle),LPARAM(lpszText));
+end;
+
+
+function PropSheet_SetWizButtons(hPropSheetDlg:HWND;dwFlags : DWORD) : LRESULT;
+begin
+ PropSheet_SetWizButtons:=SendMessage(hPropSheetDlg,PSM_SETWIZBUTTONS,0,LPARAM(dwFlags));
+end;
+
+
+function PropSheet_UnChanged(hPropSheetDlg:HWND;hwndPage : HWND) : LRESULT;
+begin
+ PropSheet_UnChanged:=SendMessage(hPropSheetDlg,PSM_UNCHANGED,WPARAM(hwndPage),0);
+end;
+
+
+function Header_DeleteItem(hwndHD:HWND;index : longint) : WINBOOL;
+begin
+ Header_DeleteItem:=WINBOOL(SendMessage(hwndHD,HDM_DELETEITEM,WPARAM(index),0));
+end;
+
+
+function Header_GetItem(hwndHD:HWND;index:longint;var hdi : HD_ITEM) : WINBOOL;
+begin
+ Header_GetItem:=WINBOOL(SendMessage(hwndHD,HDM_GETITEM,WPARAM(index),LPARAM(@hdi)));
+end;
+
+
+function Header_GetItemCount(hwndHD : HWND) : longint;
+begin
+ Header_GetItemCount:=longint(SendMessage(hwndHD,HDM_GETITEMCOUNT,0,0));
+end;
+
+
+function Header_InsertItem(hwndHD:HWND;index : longint;var hdi : HD_ITEM) : longint;
+begin
+ Header_InsertItem:=longint(SendMessage(hwndHD,HDM_INSERTITEM,WPARAM(index),LPARAM(@hdi)));
+end;
+
+
+function Header_Layout(hwndHD:HWND;var layout : HD_LAYOUT) : WINBOOL;
+begin
+ Header_Layout:=WINBOOL(SendMessage(hwndHD,HDM_LAYOUT,0,LPARAM(@layout)));
+end;
+
+
+function Header_SetItem(hwndHD:HWND;index : longint;var hdi : HD_ITEM) : WINBOOL;
+begin
+ Header_SetItem:=WINBOOL(SendMessage(hwndHD,HDM_SETITEM,WPARAM(index),LPARAM(@hdi)));
+end;
+
+
+function ListView_Arrange(hwndLV:HWND;code : UINT) : LRESULT;
+begin
+ ListView_Arrange:=SendMessage(hwndLV,LVM_ARRANGE,WPARAM(UINT(code)),0);
+end;
+
+
+function ListView_CreateDragImage(hwnd:HWND;i : longint;lpptUpLeft : LPPOINT) : LRESULT;
+begin
+ ListView_CreateDragImage:=SendMessage(hwnd,LVM_CREATEDRAGIMAGE,WPARAM(i),LPARAM(lpptUpLeft));
+end;
+
+
+function ListView_DeleteAllItems(hwnd : HWND) : LRESULT;
+begin
+ ListView_DeleteAllItems:=SendMessage(hwnd,LVM_DELETEALLITEMS,0,0);
+end;
+
+
+function ListView_DeleteColumn(hwnd:HWND;iCol : longint) : LRESULT;
+begin
+ ListView_DeleteColumn:=SendMessage(hwnd,LVM_DELETECOLUMN,WPARAM(iCol),0);
+end;
+
+
+function ListView_DeleteItem(hwnd:HWND;iItem : longint) : LRESULT;
+begin
+ ListView_DeleteItem:=SendMessage(hwnd,LVM_DELETEITEM,WPARAM(iItem),0);
+end;
+
+
+function ListView_EditLabel(hwndLV:HWND;i : longint) : LRESULT;
+begin
+ ListView_EditLabel:=SendMessage(hwndLV,LVM_EDITLABEL,WPARAM(longint(i)),0);
+end;
+
+
+function ListView_EnsureVisible(hwndLV:HWND;i,fPartialOK : longint) : LRESULT;
+begin
+ ListView_EnsureVisible:=SendMessage(hwndLV,LVM_ENSUREVISIBLE,WPARAM(i),MAKELPARAM(fPartialOK,0));
+end;
+
+
+function ListView_FindItem(hwnd:HWND;iStart : longint;var lvfi : LV_FINDINFO) : longint;
+begin
+ ListView_FindItem:=SendMessage(hwnd,LVM_FINDITEM,WPARAM(iStart),LPARAM(@lvfi));
+end;
+
+
+function ListView_GetBkColor(hwnd : HWND) : LRESULT;
+begin
+ ListView_GetBkColor:=SendMessage(hwnd,LVM_GETBKCOLOR,0,0);
+end;
+
+
+function ListView_GetCallbackMask(hwnd : HWND) : LRESULT;
+begin
+ ListView_GetCallbackMask:=SendMessage(hwnd,LVM_GETCALLBACKMASK,0,0);
+end;
+
+
+function ListView_GetColumn(hwnd:HWND;iCol : longint;var col : LV_COLUMN) : LRESULT;
+begin
+ ListView_GetColumn:=SendMessage(hwnd,LVM_GETCOLUMN,WPARAM(iCol),LPARAM(@col));
+end;
+
+
+function ListView_GetColumnWidth(hwnd:HWND;iCol : longint) : LRESULT;
+begin
+ ListView_GetColumnWidth:=SendMessage(hwnd,LVM_GETCOLUMNWIDTH,WPARAM(iCol),0);
+end;
+
+
+function ListView_GetCountPerPage(hwndLV : HWND) : LRESULT;
+begin
+ ListView_GetCountPerPage:=SendMessage(hwndLV,LVM_GETCOUNTPERPAGE,0,0);
+end;
+
+
+function ListView_GetEditControl(hwndLV : HWND) : LRESULT;
+begin
+ ListView_GetEditControl:=SendMessage(hwndLV,LVM_GETEDITCONTROL,0,0);
+end;
+
+
+function ListView_GetImageList(hwnd:HWND;iImageList : wINT) : LRESULT;
+begin
+ ListView_GetImageList:=SendMessage(hwnd,LVM_GETIMAGELIST,WPARAM(iImageList),0);
+end;
+
+
+function ListView_GetISearchString(hwndLV:HWND;lpsz : LPTSTR) : LRESULT;
+begin
+ ListView_GetISearchString:=SendMessage(hwndLV,LVM_GETISEARCHSTRING,0,LPARAM(lpsz));
+end;
+
+
+function ListView_GetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
+begin
+ ListView_GetItem:=SendMessage(hwnd,LVM_GETITEM,0,LPARAM(@item));
+end;
+
+
+function ListView_GetItemCount(hwnd : HWND) : LRESULT;
+begin
+ ListView_GetItemCount:=SendMessage(hwnd,LVM_GETITEMCOUNT,0,0);
+end;
+
+
+function ListView_GetItemPosition(hwndLV:HWND;i : longint;var pt : POINT) : longint;
+begin
+ ListView_GetItemPosition:=SendMessage(hwndLV,LVM_GETITEMPOSITION,WPARAM(longint(i)),LPARAM(@pt));
+end;
+
+
+function ListView_GetItemSpacing(hwndLV:HWND;fSmall : longint) : LRESULT;
+begin
+ ListView_GetItemSpacing:=SendMessage(hwndLV,LVM_GETITEMSPACING,fSmall,0);
+end;
+
+
+function ListView_GetItemState(hwndLV:HWND;i,mask : longint) : LRESULT;
+begin
+ ListView_GetItemState:=SendMessage(hwndLV,LVM_GETITEMSTATE,WPARAM(i),LPARAM(mask));
+end;
+
+
+function ListView_GetNextItem(hwnd:HWND; iStart, flags : longint) : LRESULT;
+begin
+ ListView_GetNextItem:=SendMessage(hwnd, LVM_GETNEXTITEM, WPARAM(iStart), LPARAM(flags));
+end;
+
+
+function ListView_GetOrigin(hwndLV:HWND;var pt : POINT) : LRESULT;
+begin
+ ListView_GetOrigin:=SendMessage(hwndLV,LVM_GETORIGIN,WPARAM(0),LPARAM(@pt));
+end;
+
+
+function ListView_GetSelectedCount(hwndLV : HWND) : LRESULT;
+begin
+ ListView_GetSelectedCount:=SendMessage(hwndLV,LVM_GETSELECTEDCOUNT,0,0);
+end;
+
+
+function ListView_GetStringWidth(hwndLV:HWND;psz : LPCTSTR) : LRESULT;
+begin
+ ListView_GetStringWidth:=SendMessage(hwndLV,LVM_GETSTRINGWIDTH,0,LPARAM(psz));
+end;
+
+
+function ListView_GetTextBkColor(hwnd : HWND) : LRESULT;
+begin
+ ListView_GetTextBkColor:=SendMessage(hwnd,LVM_GETTEXTBKCOLOR,0,0);
+end;
+
+
+function ListView_GetTextColor(hwnd : HWND) : LRESULT;
+begin
+ ListView_GetTextColor:=SendMessage(hwnd,LVM_GETTEXTCOLOR,0,0);
+end;
+
+
+function ListView_GetTopIndex(hwndLV : HWND) : LRESULT;
+begin
+ ListView_GetTopIndex:=SendMessage(hwndLV,LVM_GETTOPINDEX,0,0);
+end;
+
+
+function ListView_GetViewRect(hwnd:HWND;var rc : RECT) : LRESULT;
+begin
+ ListView_GetViewRect:=SendMessage(hwnd,LVM_GETVIEWRECT,0,LPARAM(@rc));
+end;
+
+
+function ListView_HitTest(hwndLV:HWND;var info : LV_HITTESTINFO) : LRESULT;
+begin
+ ListView_HitTest:=SendMessage(hwndLV,LVM_HITTEST,0,LPARAM(@info));
+end;
+
+
+function ListView_InsertColumn(hwnd:HWND;iCol : longint;var col : LV_COLUMN) : LRESULT;
+begin
+ ListView_InsertColumn:=SendMessage(hwnd,LVM_INSERTCOLUMN,WPARAM(iCol),LPARAM(@col));
+end;
+
+
+function ListView_InsertItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
+begin
+ ListView_InsertItem:=SendMessage(hwnd,LVM_INSERTITEM,0,LPARAM(@item));
+end;
+
+
+function ListView_RedrawItems(hwndLV:HWND;iFirst,iLast : longint) : LRESULT;
+begin
+ ListView_RedrawItems:=SendMessage(hwndLV,LVM_REDRAWITEMS,WPARAM(iFirst),LPARAM(iLast));
+end;
+
+
+function ListView_Scroll(hwndLV:HWND;dx,dy : longint) : LRESULT;
+begin
+ ListView_Scroll:=SendMessage(hwndLV,LVM_SCROLL,WPARAM(dx),LPARAM(dy));
+end;
+
+
+function ListView_SetBkColor(hwnd:HWND;clrBk : COLORREF) : LRESULT;
+begin
+ ListView_SetBkColor:=SendMessage(hwnd,LVM_SETBKCOLOR,0,LPARAM(clrBk));
+end;
+
+
+function ListView_SetCallbackMask(hwnd:HWND;mask : UINT) : LRESULT;
+begin
+ ListView_SetCallbackMask:=SendMessage(hwnd,LVM_SETCALLBACKMASK,WPARAM(mask),0);
+end;
+
+
+function ListView_SetColumn(hwnd:HWND;iCol : longint; var col : LV_COLUMN) : LRESULT;
+begin
+ ListView_SetColumn:=SendMessage(hwnd,LVM_SETCOLUMN,WPARAM(iCol),LPARAM(@col));
+end;
+
+
+function ListView_SetColumnWidth(hwnd:HWND;iCol,cx : longint) : LRESULT;
+begin
+ ListView_SetColumnWidth:=SendMessage(hwnd,LVM_SETCOLUMNWIDTH,WPARAM(iCol),MAKELPARAM(cx,0));
+end;
+
+
+function ListView_SetImageList(hwnd:HWND;himl : longint;iImageList : HIMAGELIST) : LRESULT;
+begin
+ ListView_SetImageList:=SendMessage(hwnd,LVM_SETIMAGELIST,WPARAM(iImageList),LPARAM(UINT(himl)));
+end;
+
+
+function ListView_SetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
+begin
+ ListView_SetItem:=SendMessage(hwnd,LVM_SETITEM,0,LPARAM(@item));
+end;
+
+
+function ListView_SetItemCount(hwndLV:HWND;cItems : longint) : LRESULT;
+begin
+ ListView_SetItemCount:=SendMessage(hwndLV,LVM_SETITEMCOUNT,WPARAM(cItems),0);
+end;
+
+
+function ListView_SetItemPosition(hwndLV:HWND;i,x,y : longint) : LRESULT;
+begin
+ ListView_SetItemPosition:=SendMessage(hwndLV,LVM_SETITEMPOSITION,WPARAM(i),MAKELPARAM(x,y));
+end;
+
+
+function ListView_SetItemPosition32(hwndLV:HWND;i,x,y : longint) : LRESULT;
+var
+ ptNewPos : POINT;
+begin
+ ptNewPos.x:=x;
+ ptNewPos.y:=y;
+ ListView_SetItemPosition32:=SendMessage(hwndLV, LVM_SETITEMPOSITION32, WPARAM(i),LPARAM(@ptNewPos));
+end;
+
+
+function ListView_SetItemState(hwndLV:HWND; i, data, mask:longint) : LRESULT;
+var
+ _gnu_lvi : LV_ITEM;
+begin
+ _gnu_lvi.stateMask:=mask;
+ _gnu_lvi.state:=data;
+ ListView_SetItemState:=SendMessage(hwndLV, LVM_SETITEMSTATE, WPARAM(i),LPARAM(@_gnu_lvi));
+end;
+
+
+function ListView_SetItemText(hwndLV:HWND; i, iSubItem_:longint;pszText_ : LPTSTR) : LRESULT;
+var
+ _gnu_lvi : LV_ITEM;
+begin
+ _gnu_lvi.iSubItem:=iSubItem_;
+ _gnu_lvi.pszText:=pszText_;
+ ListView_SetItemText:=SendMessage(hwndLV, LVM_SETITEMTEXT, WPARAM(i),LPARAM(@_gnu_lvi));
+end;
+
+
+function ListView_SetTextBkColor(hwnd:HWND;clrTextBk : COLORREF) : LRESULT;
+begin
+ ListView_SetTextBkColor:=SendMessage(hwnd,LVM_SETTEXTBKCOLOR,0,LPARAM(clrTextBk));
+end;
+
+
+function ListView_SetTextColor(hwnd:HWND;clrText : COLORREF) : LRESULT;
+begin
+ ListView_SetTextColor:=SendMessage(hwnd,LVM_SETTEXTCOLOR,0,LPARAM(clrText));
+end;
+
+
+function ListView_SortItems(hwndLV:HWND;_pfnCompare:PFNLVCOMPARE;_lPrm : LPARAM) : LRESULT;
+begin
+ ListView_SortItems:=SendMessage(hwndLV,LVM_SORTITEMS,WPARAM(_lPrm),LPARAM(_pfnCompare));
+end;
+
+
+function ListView_Update(hwndLV:HWND;i : longint) : LRESULT;
+begin
+ ListView_Update:=SendMessage(hwndLV,LVM_UPDATE,WPARAM(i),0);
+end;
+
+
+function TreeView_InsertItem(hwnd:HWND;lpis : LPTV_INSERTSTRUCT) : LRESULT;
+begin
+ TreeView_InsertItem:=SendMessage(hwnd,TVM_INSERTITEM,0,LPARAM(lpis));
+end;
+
+
+function TreeView_DeleteItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_DeleteItem:=SendMessage(hwnd,TVM_DELETEITEM,0,LPARAM(hitem));
+end;
+
+
+function TreeView_DeleteAllItems(hwnd : HWND) : LRESULT;
+begin
+ TreeView_DeleteAllItems:=SendMessage(hwnd,TVM_DELETEITEM,0,LPARAM(TVI_ROOT));
+end;
+
+
+function TreeView_Expand(hwnd:HWND;hitem:HTREEITEM;code : longint) : LRESULT;
+begin
+ TreeView_Expand:=SendMessage(hwnd,TVM_EXPAND,WPARAM(code),LPARAM(hitem));
+end;
+
+
+function TreeView_GetCount(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetCount:=SendMessage(hwnd,TVM_GETCOUNT,0,0);
+end;
+
+
+function TreeView_GetIndent(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetIndent:=SendMessage(hwnd,TVM_GETINDENT,0,0);
+end;
+
+
+function TreeView_SetIndent(hwnd:HWND;indent : longint) : LRESULT;
+begin
+ TreeView_SetIndent:=SendMessage(hwnd,TVM_SETINDENT,WPARAM(indent),0);
+end;
+
+
+function TreeView_GetImageList(hwnd:HWND;iImage : WPARAM) : LRESULT;
+begin
+ TreeView_GetImageList:=SendMessage(hwnd,TVM_GETIMAGELIST,iImage,0);
+end;
+
+
+function TreeView_SetImageList(hwnd:HWND;himl:HIMAGELIST;iImage : WPARAM) : LRESULT;
+begin
+ TreeView_SetImageList:=SendMessage(hwnd,TVM_SETIMAGELIST,iImage,LPARAM(UINT(himl)));
+end;
+
+
+function TreeView_GetNextItem(hwnd:HWND;hitem:HTREEITEM;code : longint) : LRESULT;
+begin
+ TreeView_GetNextItem:=SendMessage(hwnd,TVM_GETNEXTITEM,WPARAM(code),LPARAM(hitem));
+end;
+
+
+function TreeView_GetChild(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_GetChild:=TreeView_GetNextItem(hwnd,hitem,TVGN_CHILD);
+end;
+
+
+function TreeView_GetNextSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_GetNextSibling:=TreeView_GetNextItem(hwnd,hitem,TVGN_NEXT);
+end;
+
+
+function TreeView_GetPrevSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_GetPrevSibling:=TreeView_GetNextItem(hwnd,hitem,TVGN_PREVIOUS);
+end;
+
+
+function TreeView_GetParent(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_GetParent:=TreeView_GetNextItem(hwnd,hitem,TVGN_PARENT);
+end;
+
+
+function TreeView_GetFirstVisible(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetFirstVisible:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_FIRSTVISIBLE);
+end;
+
+
+function TreeView_GetNextVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_GetNextVisible:=TreeView_GetNextItem(hwnd,hitem,TVGN_NEXTVISIBLE);
+end;
+
+
+function TreeView_GetPrevVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_GetPrevVisible:=TreeView_GetNextItem(hwnd,hitem,TVGN_PREVIOUSVISIBLE);
+end;
+
+
+function TreeView_GetSelection(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetSelection:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_CARET);
+end;
+
+
+function TreeView_GetDropHilight(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetDropHilight:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_DROPHILITE);
+end;
+
+
+function TreeView_GetRoot(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetRoot:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_ROOT);
+end;
+
+
+function TreeView_Select(hwnd:HWND;hitem:HTREEITEM;code : longint) : LRESULT;
+begin
+ TreeView_Select:=SendMessage(hwnd,TVM_SELECTITEM,WPARAM(code),LPARAM(hitem));
+end;
+
+
+function TreeView_SelectItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_SelectItem:=TreeView_Select(hwnd,hitem,TVGN_CARET);
+end;
+
+
+function TreeView_SelectDropTarget(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_SelectDropTarget:=TreeView_Select(hwnd,hitem,TVGN_DROPHILITE);
+end;
+
+
+function TreeView_SelectSetFirstVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_SelectSetFirstVisible:=TreeView_Select(hwnd,hitem,TVGN_FIRSTVISIBLE);
+end;
+
+
+function TreeView_GetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
+begin
+ TreeView_GetItem:=SendMessage(hwnd,TVM_GETITEM,0,LPARAM(@item));
+end;
+
+
+function TreeView_SetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
+begin
+ TreeView_SetItem:=SendMessage(hwnd,TVM_SETITEM,0,LPARAM(@item));
+end;
+
+
+function TreeView_EditLabel(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_EditLabel:=SendMessage(hwnd,TVM_EDITLABEL,0,LPARAM(hitem));
+end;
+
+
+function TreeView_GetEditControl(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetEditControl:=SendMessage(hwnd,TVM_GETEDITCONTROL,0,0);
+end;
+
+
+function TreeView_GetVisibleCount(hwnd : HWND) : LRESULT;
+begin
+ TreeView_GetVisibleCount:=SendMessage(hwnd,TVM_GETVISIBLECOUNT,0,0);
+end;
+
+
+function TreeView_HitTest(hwnd:HWND;lpht : LPTV_HITTESTINFO) : LRESULT;
+begin
+ TreeView_HitTest:=SendMessage(hwnd,TVM_HITTEST,0,LPARAM(lpht));
+end;
+
+
+function TreeView_CreateDragImage(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_CreateDragImage:=SendMessage(hwnd,TVM_CREATEDRAGIMAGE,0,LPARAM(hitem));
+end;
+
+
+function TreeView_SortChildren(hwnd:HWND;hitem:HTREEITEM;recurse : longint) : LRESULT;
+begin
+ TreeView_SortChildren:=SendMessage(hwnd,TVM_SORTCHILDREN,WPARAM(recurse),LPARAM(hitem));
+end;
+
+
+function TreeView_EnsureVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
+begin
+ TreeView_EnsureVisible:=SendMessage(hwnd,TVM_ENSUREVISIBLE,0,LPARAM(hitem));
+end;
+
+
+function TreeView_SortChildrenCB(hwnd:HWND;psort:LPTV_SORTCB;recurse : longint) : LRESULT;
+begin
+ TreeView_SortChildrenCB:=SendMessage(hwnd,TVM_SORTCHILDRENCB,WPARAM(recurse),LPARAM(psort));
+end;
+
+
+function TreeView_EndEditLabelNow(hwnd:HWND;fCancel : longint) : LRESULT;
+begin
+ TreeView_EndEditLabelNow:=SendMessage(hwnd,TVM_ENDEDITLABELNOW,WPARAM(fCancel),0);
+end;
+
+
+function TreeView_GetISearchString(hwndTV:HWND;lpsz : LPTSTR) : LRESULT;
+begin
+ TreeView_GetISearchString:=SendMessage(hwndTV,TVM_GETISEARCHSTRING,0,LPARAM(lpsz));
+end;
+
+
+function TabCtrl_GetImageList(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_GetImageList:=SendMessage(hwnd,TCM_GETIMAGELIST,0,0);
+end;
+
+
+function TabCtrl_SetImageList(hwnd:HWND;himl : HIMAGELIST) : LRESULT;
+begin
+ TabCtrl_SetImageList:=SendMessage(hwnd,TCM_SETIMAGELIST,0,LPARAM(UINT(himl)));
+end;
+
+
+function TabCtrl_GetItemCount(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_GetItemCount:=SendMessage(hwnd,TCM_GETITEMCOUNT,0,0);
+end;
+
+
+function TabCtrl_GetItem(hwnd:HWND;iItem : longint;var item : TC_ITEM) : LRESULT;
+begin
+ TabCtrl_GetItem:=SendMessage(hwnd,TCM_GETITEM,WPARAM(iItem),LPARAM(@item));
+end;
+
+
+function TabCtrl_SetItem(hwnd:HWND;iItem : longint;var item : TC_ITEM) : LRESULT;
+begin
+ TabCtrl_SetItem:=SendMessage(hwnd,TCM_SETITEM,WPARAM(iItem),LPARAM(@item));
+end;
+
+
+function TabCtrl_InsertItem(hwnd:HWND;iItem : longint;var item : TC_ITEM) : LRESULT;
+begin
+ TabCtrl_InsertItem:=SendMessage(hwnd,TCM_INSERTITEM,WPARAM(iItem),LPARAM(@item));
+end;
+
+
+function TabCtrl_DeleteItem(hwnd:HWND;i : longint) : LRESULT;
+begin
+ TabCtrl_DeleteItem:=SendMessage(hwnd,TCM_DELETEITEM,WPARAM(i),0);
+end;
+
+
+function TabCtrl_DeleteAllItems(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_DeleteAllItems:=SendMessage(hwnd,TCM_DELETEALLITEMS,0,0);
+end;
+
+
+function TabCtrl_GetItemRect(hwnd:HWND;i : longint;var rc : RECT) : LRESULT;
+begin
+ TabCtrl_GetItemRect:=SendMessage(hwnd,TCM_GETITEMRECT,WPARAM(longint(i)),LPARAM(@rc));
+end;
+
+
+function TabCtrl_GetCurSel(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_GetCurSel:=SendMessage(hwnd,TCM_GETCURSEL,0,0);
+end;
+
+
+function TabCtrl_SetCurSel(hwnd:HWND;i : longint) : LRESULT;
+begin
+ TabCtrl_SetCurSel:=SendMessage(hwnd,TCM_SETCURSEL,WPARAM(i),0);
+end;
+
+
+function TabCtrl_HitTest(hwndTC:HWND;var info : TC_HITTESTINFO) : LRESULT;
+begin
+ TabCtrl_HitTest:=SendMessage(hwndTC,TCM_HITTEST,0,LPARAM(@info));
+end;
+
+
+function TabCtrl_SetItemExtra(hwndTC:HWND;cb : longint) : LRESULT;
+begin
+ TabCtrl_SetItemExtra:=SendMessage(hwndTC,TCM_SETITEMEXTRA,WPARAM(cb),0);
+end;
+
+
+function TabCtrl_AdjustRect(hwnd:HWND;bLarger:WINBOOL;var rc : RECT) : LRESULT;
+begin
+ TabCtrl_AdjustRect:=SendMessage(hwnd,TCM_ADJUSTRECT,WPARAM(bLarger),LPARAM(@rc));
+end;
+
+
+function TabCtrl_SetItemSize(hwnd:HWND;x,y : longint) : LRESULT;
+begin
+ TabCtrl_SetItemSize:=SendMessage(hwnd,TCM_SETITEMSIZE,0,MAKELPARAM(x,y));
+end;
+
+
+function TabCtrl_RemoveImage(hwnd:HWND;i : WPARAM) : LRESULT;
+begin
+ TabCtrl_RemoveImage:=SendMessage(hwnd,TCM_REMOVEIMAGE,i,0);
+end;
+
+
+function TabCtrl_SetPadding(hwnd:HWND;cx,cy : longint) : LRESULT;
+begin
+ TabCtrl_SetPadding:=SendMessage(hwnd,TCM_SETPADDING,0,MAKELPARAM(cx,cy));
+end;
+
+
+function TabCtrl_GetRowCount(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_GetRowCount:=SendMessage(hwnd,TCM_GETROWCOUNT,0,0);
+end;
+
+
+function TabCtrl_GetToolTips(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_GetToolTips:=SendMessage(hwnd,TCM_GETTOOLTIPS,0,0);
+end;
+
+
+function TabCtrl_SetToolTips(hwnd:HWND;hwndTT : longint) : LRESULT;
+begin
+ TabCtrl_SetToolTips:=SendMessage(hwnd,TCM_SETTOOLTIPS,WPARAM(hwndTT),0);
+end;
+
+
+function TabCtrl_GetCurFocus(hwnd : HWND) : LRESULT;
+begin
+ TabCtrl_GetCurFocus:=SendMessage(hwnd,TCM_GETCURFOCUS,0,0);
+end;
+
+
+function TabCtrl_SetCurFocus(hwnd:HWND;i : longint) : LRESULT;
+begin
+ TabCtrl_SetCurFocus:=SendMessage(hwnd,TCM_SETCURFOCUS,i,0);
+end;
+
+
+function SNDMSG(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
+begin
+ SNDMSG:=SendMessage(hWnd,Msg,wParam,lParam);
+end;
+
+
+function CommDlg_OpenSave_GetSpecA(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetSpecA:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
+end;
+
+
+function CommDlg_OpenSave_GetSpecW(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetSpecW:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
+end;
+
+
+{$ifndef Unicode}
+function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetSpec:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
+end;
+{$else Unicode}
+function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetSpec:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
+end;
+{$endif Unicode}
+
+
+function CommDlg_OpenSave_GetFilePathA(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFilePathA:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(_psz));
+end;
+
+
+function CommDlg_OpenSave_GetFilePathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFilePathW:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(LPWSTR(_psz)));
+end;
+
+{$ifndef Unicode}
+function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFilePath:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(_psz));
+end;
+{$else Unicode}
+function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFilePath:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(_psz));
+end;
+{$endif Unicode}
+
+function CommDlg_OpenSave_GetFolderPathA(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFolderPathA:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPSTR(_psz)));
+end;
+
+
+function CommDlg_OpenSave_GetFolderPathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFolderPathW:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPWSTR(_psz)));
+end;
+
+{$ifndef Unicode}
+function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFolderPath:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPSTR(_psz)));
+end;
+{$else Unicode}
+function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPWSTR;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFolderPath:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPWSTR(_psz)));
+end;
+{$endif Unicode}
+
+function CommDlg_OpenSave_GetFolderIDList(_hdlg:HWND;_pidl:LPVOID;_cbmax : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_GetFolderIDList:=SNDMSG(_hdlg,CDM_GETFOLDERIDLIST,WPARAM(_cbmax),LPARAM(_pidl));
+end;
+
+
+function CommDlg_OpenSave_SetControlText(_hdlg:HWND;_id : longint;_text : LPSTR) : LRESULT;
+begin
+ CommDlg_OpenSave_SetControlText:=SNDMSG(_hdlg,CDM_SETCONTROLTEXT,WPARAM(_id),LPARAM(_text));
+end;
+
+
+function CommDlg_OpenSave_HideControl(_hdlg:HWND;_id : longint) : LRESULT;
+begin
+ CommDlg_OpenSave_HideControl:=SNDMSG(_hdlg,CDM_HIDECONTROL,WPARAM(_id),0);
+end;
+
+
+function CommDlg_OpenSave_SetDefExt(_hdlg:HWND;_pszext : LPSTR) : LRESULT;
+begin
+ CommDlg_OpenSave_SetDefExt:=SNDMSG(_hdlg,CDM_SETDEFEXT,0,LPARAM(_pszext));
+end;
+
+function InternalGetLargestConsoleWindowSize(hConsoleOutput:HANDLE):DWord; external 'kernel32' name 'GetLargestConsoleWindowSize';
+
+function GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):COORD;
+var
+ res : dword;
+begin
+ res:=InternalGetLargestConsoleWindowSize(hConsoleOutput);
+ GetLargestConsoleWindowSize:=COORD(res);
+end;
+
+{$endif read_implementation}
+
+{
+ $Log: func.inc,v $
+ Revision 1.25 2005/05/09 18:39:58 michael
+ + Added overloads of G(S)etwindowplacement with pointer versions
+
+ Revision 1.24 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/makefile.inc b/rtl/win32/wininc/makefile.inc
new file mode 100644
index 0000000000..d28e9a853f
--- /dev/null
+++ b/rtl/win32/wininc/makefile.inc
@@ -0,0 +1,3 @@
+WINDOWS_FILES=base errors defines struct redef \
+ ascfun ascdef unifun unidef func
+
diff --git a/rtl/win32/wininc/messages.inc b/rtl/win32/wininc/messages.inc
new file mode 100644
index 0000000000..43d9eb7e7e
--- /dev/null
+++ b/rtl/win32/wininc/messages.inc
@@ -0,0 +1,1316 @@
+{
+ $Id: messages.inc,v 1.14 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ Messages.h Windows32 API message definitions
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+
+ This file is part of the Windows32 API Library.
+
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+ const
+ ACM_OPENW = 1127;
+ ACM_OPENA = 1124;
+ {$ifdef UNICODE}
+ const
+ ACM_OPEN = ACM_OPENW;
+ {$else}
+ const
+ ACM_OPEN = ACM_OPENA;
+ {$endif}
+ { UNICODE }
+
+ const
+ ACM_PLAY = 1125;
+ ACM_STOP = 1126;
+ ACN_START = 1;
+ ACN_STOP = 2;
+ { Buttons }
+ BM_CLICK = 245;
+ BM_GETCHECK = 240;
+ BM_GETIMAGE = 246;
+ BM_GETSTATE = 242;
+ BM_SETCHECK = 241;
+ BM_SETIMAGE = 247;
+ BM_SETSTATE = 243;
+ BM_SETSTYLE = 244;
+ BN_CLICKED = 0;
+ BN_DBLCLK = 5;
+ BN_DISABLE = 4;
+ BN_DOUBLECLICKED = 5;
+ BN_HILITE = 2;
+ BN_KILLFOCUS = 7;
+ BN_PAINT = 1;
+ BN_PUSHED = 2;
+ BN_SETFOCUS = 6;
+ BN_UNHILITE = 3;
+ BN_UNPUSHED = 3;
+ { Combo Box }
+ CB_ADDSTRING = 323;
+ CB_DELETESTRING = 324;
+ CB_DIR = 325;
+ CB_FINDSTRING = 332;
+ CB_FINDSTRINGEXACT = 344;
+ CB_GETCOUNT = 326;
+ CB_GETCURSEL = 327;
+ CB_GETDROPPEDCONTROLRECT = 338;
+ CB_GETDROPPEDSTATE = 343;
+ CB_GETDROPPEDWIDTH = 351;
+ CB_GETEDITSEL = 320;
+ CB_GETEXTENDEDUI = 342;
+ CB_GETHORIZONTALEXTENT = 349;
+ CB_GETITEMDATA = 336;
+ CB_GETITEMHEIGHT = 340;
+ CB_GETLBTEXT = 328;
+ CB_GETLBTEXTLEN = 329;
+ CB_GETLOCALE = 346;
+ CB_GETTOPINDEX = 347;
+ CB_INITSTORAGE = 353;
+ CB_INSERTSTRING = 330;
+ CB_LIMITTEXT = 321;
+ CB_RESETCONTENT = 331;
+ CB_SELECTSTRING = 333;
+ CB_SETCURSEL = 334;
+ CB_SETDROPPEDWIDTH = 352;
+ CB_SETEDITSEL = 322;
+ CB_SETEXTENDEDUI = 341;
+ CB_SETHORIZONTALEXTENT = 350;
+ CB_SETITEMDATA = 337;
+ CB_SETITEMHEIGHT = 339;
+ CB_SETLOCALE = 345;
+ CB_SETTOPINDEX = 348;
+ CB_SHOWDROPDOWN = 335;
+ { Combo Box notifications }
+ CBN_CLOSEUP = 8;
+ CBN_DBLCLK = 2;
+ CBN_DROPDOWN = 7;
+ CBN_EDITCHANGE = 5;
+ CBN_EDITUPDATE = 6;
+ CBN_ERRSPACE = -(1);
+ CBN_KILLFOCUS = 4;
+ CBN_SELCHANGE = 1;
+ CBN_SELENDCANCEL = 10;
+ CBN_SELENDOK = 9;
+ CBN_SETFOCUS = 3;
+ { Control Panel }
+ { Device messages }
+ { Drag list box }
+ DL_BEGINDRAG = 1157;
+ DL_CANCELDRAG = 1160;
+ DL_DRAGGING = 1158;
+ DL_DROPPED = 1159;
+ { Default push button }
+ DM_GETDEFID = 1024;
+ DM_REPOSITION = 1026;
+ DM_SETDEFID = 1025;
+ { RTF control }
+ EM_CANPASTE = 1074;
+ EM_CANUNDO = 198;
+ EM_CHARFROMPOS = 215;
+ EM_DISPLAYBAND = 1075;
+ EM_EMPTYUNDOBUFFER = 205;
+ EM_EXGETSEL = 1076;
+ EM_EXLIMITTEXT = 1077;
+ EM_EXLINEFROMCHAR = 1078;
+ EM_EXSETSEL = 1079;
+ EM_FINDTEXT = 1080;
+ EM_FINDTEXTEX = 1103;
+ EM_FINDWORDBREAK = 1100;
+ EM_FMTLINES = 200;
+ EM_FORMATRANGE = 1081;
+ EM_GETCHARFORMAT = 1082;
+ EM_GETEVENTMASK = 1083;
+ EM_GETFIRSTVISIBLELINE = 206;
+ EM_GETHANDLE = 189;
+ EM_GETLIMITTEXT = 213;
+ EM_GETLINE = 196;
+ EM_GETLINECOUNT = 186;
+ EM_GETMARGINS = 212;
+ EM_GETMODIFY = 184;
+ EM_GETIMECOLOR = 1129;
+ EM_GETIMEOPTIONS = 1131;
+ EM_GETOPTIONS = 1102;
+ EM_GETOLEINTERFACE = 1084;
+ EM_GETPARAFORMAT = 1085;
+ EM_GETPASSWORDCHAR = 210;
+ EM_GETPUNCTUATION = 1125;
+ EM_GETRECT = 178;
+ EM_GETSEL = 176;
+ EM_GETSELTEXT = 1086;
+ EM_GETTEXTRANGE = 1099;
+ EM_GETTHUMB = 190;
+ EM_GETWORDBREAKPROC = 209;
+ EM_GETWORDBREAKPROCEX = 1104;
+ EM_GETWORDWRAPMODE = 1127;
+ EM_HIDESELECTION = 1087;
+ EM_LIMITTEXT = 197;
+ EM_LINEFROMCHAR = 201;
+ EM_LINEINDEX = 187;
+ EM_LINELENGTH = 193;
+ EM_LINESCROLL = 182;
+ EM_PASTESPECIAL = 1088;
+ EM_POSFROMCHAR = 214;
+ EM_REPLACESEL = 194;
+ EM_REQUESTRESIZE = 1089;
+ EM_SCROLL = 181;
+ EM_SCROLLCARET = 183;
+ EM_SELECTIONTYPE = 1090;
+ EM_SETBKGNDCOLOR = 1091;
+ EM_SETCHARFORMAT = 1092;
+ EM_SETEVENTMASK = 1093;
+ EM_SETHANDLE = 188;
+ EM_SETIMECOLOR = 1128;
+ EM_SETIMEOPTIONS = 1130;
+ EM_SETLIMITTEXT = 197;
+ EM_SETMARGINS = 211;
+ EM_SETMODIFY = 185;
+ EM_SETOLECALLBACK = 1094;
+ EM_SETOPTIONS = 1101;
+ EM_SETPARAFORMAT = 1095;
+ EM_SETPASSWORDCHAR = 204;
+ EM_SETPUNCTUATION = 1124;
+ EM_SETREADONLY = 207;
+ EM_SETRECT = 179;
+ EM_SETRECTNP = 180;
+ EM_SETSEL = 177;
+ EM_SETTABSTOPS = 203;
+ EM_SETTARGETDEVICE = 1096;
+ EM_SETWORDBREAKPROC = 208;
+ EM_SETWORDBREAKPROCEX = 1105;
+ EM_SETWORDWRAPMODE = 1126;
+ EM_STREAMIN = 1097;
+ EM_STREAMOUT = 1098;
+ EM_UNDO = 199;
+ { Edit control }
+ EN_CHANGE = 768;
+ EN_CORRECTTEXT = 1797;
+ EN_DROPFILES = 1795;
+ EN_ERRSPACE = 1280;
+ EN_HSCROLL = 1537;
+ EN_IMECHANGE = 1799;
+ EN_KILLFOCUS = 512;
+ EN_MAXTEXT = 1281;
+ EN_MSGFILTER = 1792;
+ EN_OLEOPFAILED = 1801;
+ EN_PROTECTED = 1796;
+ EN_REQUESTRESIZE = 1793;
+ EN_SAVECLIPBOARD = 1800;
+ EN_SELCHANGE = 1794;
+ EN_SETFOCUS = 256;
+ EN_STOPNOUNDO = 1798;
+ EN_UPDATE = 1024;
+ EN_VSCROLL = 1538;
+ { File Manager extensions }
+ { File Manager extensions DLL events }
+ { Header control }
+ HDM_DELETEITEM = 4610;
+ HDM_GETITEMW = 4619;
+ HDM_INSERTITEMW = 4618;
+ HDM_SETITEMW = 4620;
+ HDM_GETITEMA = 4611;
+ HDM_INSERTITEMA = 4609;
+ HDM_SETITEMA = 4612;
+{$ifdef UNICODE}
+
+ const
+ HDM_GETITEM = HDM_GETITEMW;
+ HDM_INSERTITEM = HDM_INSERTITEMW;
+ HDM_SETITEM = HDM_SETITEMW;
+{$else}
+
+ const
+ HDM_GETITEM = HDM_GETITEMA;
+ HDM_INSERTITEM = HDM_INSERTITEMA;
+ HDM_SETITEM = HDM_SETITEMA;
+{$endif}
+ { UNICODE }
+
+ const
+ HDM_GETITEMCOUNT = 4608;
+ HDM_HITTEST = 4614;
+ HDM_LAYOUT = 4613;
+ { Header control notifications }
+ HDN_BEGINTRACKW = -(326);
+ HDN_DIVIDERDBLCLICKW = -(325);
+ HDN_ENDTRACKW = -(327);
+ HDN_ITEMCHANGEDW = -(321);
+ HDN_ITEMCHANGINGW = -(320);
+ HDN_ITEMCLICKW = -(322);
+ HDN_ITEMDBLCLICKW = -(323);
+ HDN_TRACKW = -(328);
+ HDN_BEGINTRACKA = -(306);
+ HDN_DIVIDERDBLCLICKA = -(305);
+ HDN_ENDTRACKA = -(307);
+ HDN_ITEMCHANGEDA = -(301);
+ HDN_ITEMCHANGINGA = -(300);
+ HDN_ITEMCLICKA = -(302);
+ HDN_ITEMDBLCLICKA = -(303);
+ HDN_TRACKA = -(308);
+{$ifdef UNICODE}
+
+ const
+ HDN_BEGINTRACK = HDN_BEGINTRACKW;
+ HDN_DIVIDERDBLCLICK = HDN_DIVIDERDBLCLICKW;
+ HDN_ENDTRACK = HDN_ENDTRACKW;
+ HDN_ITEMCHANGED = HDN_ITEMCHANGEDW;
+ HDN_ITEMCHANGING = HDN_ITEMCHANGINGW;
+ HDN_ITEMCLICK = HDN_ITEMCLICKW;
+ HDN_ITEMDBLCLICK = HDN_ITEMDBLCLICKW;
+ HDN_TRACK = HDN_TRACKW;
+{$else}
+
+ const
+ HDN_BEGINTRACK = HDN_BEGINTRACKA;
+ HDN_DIVIDERDBLCLICK = HDN_DIVIDERDBLCLICKA;
+ HDN_ENDTRACK = HDN_ENDTRACKA;
+ HDN_ITEMCHANGED = HDN_ITEMCHANGEDA;
+ HDN_ITEMCHANGING = HDN_ITEMCHANGINGA;
+ HDN_ITEMCLICK = HDN_ITEMCLICKA;
+ HDN_ITEMDBLCLICK = HDN_ITEMDBLCLICKA;
+ HDN_TRACK = HDN_TRACKA;
+{$endif}
+ { UNICODE }
+ { Hot key control }
+
+ const
+ HKM_GETHOTKEY = 1026;
+ HKM_SETHOTKEY = 1025;
+ HKM_SETRULES = 1027;
+ { List box }
+ LB_ADDFILE = 406;
+ LB_ADDSTRING = 384;
+ LB_DELETESTRING = 386;
+ LB_DIR = 397;
+ LB_FINDSTRING = 399;
+ LB_FINDSTRINGEXACT = 418;
+ LB_GETANCHORINDEX = 413;
+ LB_GETCARETINDEX = 415;
+ LB_GETCOUNT = 395;
+ LB_GETCURSEL = 392;
+ LB_GETHORIZONTALEXTENT = 403;
+ LB_GETITEMDATA = 409;
+ LB_GETITEMHEIGHT = 417;
+ LB_GETITEMRECT = 408;
+ LB_GETLOCALE = 422;
+ LB_GETSEL = 391;
+ LB_GETSELCOUNT = 400;
+ LB_GETSELITEMS = 401;
+ LB_GETTEXT = 393;
+ LB_GETTEXTLEN = 394;
+ LB_GETTOPINDEX = 398;
+ LB_INITSTORAGE = 424;
+ LB_INSERTSTRING = 385;
+ LB_ITEMFROMPOINT = 425;
+ LB_RESETCONTENT = 388;
+ LB_SELECTSTRING = 396;
+ LB_SELITEMRANGE = 411;
+ LB_SELITEMRANGEEX = 387;
+ LB_SETANCHORINDEX = 412;
+ LB_SETCARETINDEX = 414;
+ LB_SETCOLUMNWIDTH = 405;
+ LB_SETCOUNT = 423;
+ LB_SETCURSEL = 390;
+ LB_SETHORIZONTALEXTENT = 404;
+ LB_SETITEMDATA = 410;
+ LB_SETITEMHEIGHT = 416;
+ LB_SETLOCALE = 421;
+ LB_SETSEL = 389;
+ LB_SETTABSTOPS = 402;
+ LB_SETTOPINDEX = 407;
+ { List box notifications }
+ LBN_DBLCLK = 2;
+ LBN_ERRSPACE = -(2);
+ LBN_KILLFOCUS = 5;
+ LBN_SELCANCEL = 3;
+ LBN_SELCHANGE = 1;
+ LBN_SETFOCUS = 4;
+ { List view control }
+ LVM_ARRANGE = 4118;
+ LVM_CREATEDRAGIMAGE = 4129;
+ LVM_DELETEALLITEMS = 4105;
+ LVM_DELETECOLUMN = 4124;
+ LVM_DELETEITEM = 4104;
+ LVM_ENSUREVISIBLE = 4115;
+ LVM_GETBKCOLOR = 4096;
+ LVM_GETCALLBACKMASK = 4106;
+ LVM_GETCOLUMNWIDTH = 4125;
+ LVM_GETCOUNTPERPAGE = 4136;
+ LVM_GETEDITCONTROL = 4120;
+ LVM_GETIMAGELIST = 4098;
+ LVM_EDITLABELW = 4214;
+ LVM_FINDITEMW = 4179;
+ LVM_GETCOLUMNW = 4191;
+ LVM_GETISEARCHSTRINGW = 4213;
+ LVM_GETITEMW = 4171;
+ LVM_GETITEMTEXTW = 4211;
+ LVM_GETSTRINGWIDTHW = 4183;
+ LVM_INSERTCOLUMNW = 4193;
+ LVM_INSERTITEMW = 4173;
+ LVM_SETCOLUMNW = 4192;
+ LVM_SETITEMW = 4172;
+ LVM_SETITEMTEXTW = 4212;
+ LVM_EDITLABELA = 4119;
+ LVM_FINDITEMA = 4109;
+ LVM_GETCOLUMNA = 4121;
+ LVM_GETISEARCHSTRINGA = 4148;
+ LVM_GETITEMA = 4101;
+ LVM_GETITEMTEXTA = 4141;
+ LVM_GETSTRINGWIDTHA = 4113;
+ LVM_INSERTCOLUMNA = 4123;
+ LVM_INSERTITEMA = 4103;
+ LVM_SETCOLUMNA = 4122;
+ LVM_SETITEMA = 4102;
+ LVM_SETITEMTEXTA = 4142;
+{$ifdef UNICODE}
+
+ const
+ LVM_EDITLABEL = LVM_EDITLABELW;
+ LVM_FINDITEM = LVM_FINDITEMW;
+ LVM_GETCOLUMN = LVM_GETCOLUMNW;
+ LVM_GETISEARCHSTRING = LVM_GETISEARCHSTRINGW;
+ LVM_GETITEM = LVM_GETITEMW;
+ LVM_GETITEMTEXT = LVM_GETITEMTEXTW;
+ LVM_GETSTRINGWIDTH = LVM_GETSTRINGWIDTHW;
+ LVM_INSERTCOLUMN = LVM_INSERTCOLUMNW;
+ LVM_INSERTITEM = LVM_INSERTITEMW;
+ LVM_SETCOLUMN = LVM_SETCOLUMNW;
+ LVM_SETITEM = LVM_SETITEMW;
+ LVM_SETITEMTEXT = LVM_SETITEMTEXTW;
+{$else}
+
+ const
+ LVM_EDITLABEL = LVM_EDITLABELA;
+ LVM_FINDITEM = LVM_FINDITEMA;
+ LVM_GETCOLUMN = LVM_GETCOLUMNA;
+ LVM_GETISEARCHSTRING = LVM_GETISEARCHSTRINGA;
+ LVM_GETITEM = LVM_GETITEMA;
+ LVM_GETITEMTEXT = LVM_GETITEMTEXTA;
+ LVM_GETSTRINGWIDTH = LVM_GETSTRINGWIDTHA;
+ LVM_INSERTCOLUMN = LVM_INSERTCOLUMNA;
+ LVM_INSERTITEM = LVM_INSERTITEMA;
+ LVM_SETCOLUMN = LVM_SETCOLUMNA;
+ LVM_SETITEM = LVM_SETITEMA;
+ LVM_SETITEMTEXT = LVM_SETITEMTEXTA;
+{$endif}
+ { UNICODE }
+
+ const
+ LVM_GETITEMCOUNT = 4100;
+ LVM_GETITEMPOSITION = 4112;
+ LVM_GETITEMRECT = 4110;
+ LVM_GETITEMSPACING = 4147;
+ LVM_GETITEMSTATE = 4140;
+ LVM_GETNEXTITEM = 4108;
+ LVM_GETORIGIN = 4137;
+ LVM_GETSELECTEDCOUNT = 4146;
+ LVM_GETTEXTBKCOLOR = 4133;
+ LVM_GETTEXTCOLOR = 4131;
+ LVM_GETTOPINDEX = 4135;
+ LVM_GETVIEWRECT = 4130;
+ LVM_HITTEST = 4114;
+ LVM_REDRAWITEMS = 4117;
+ LVM_SCROLL = 4116;
+ LVM_SETBKCOLOR = 4097;
+ LVM_SETCALLBACKMASK = 4107;
+ LVM_SETCOLUMNWIDTH = 4126;
+ LVM_SETIMAGELIST = 4099;
+ LVM_SETITEMCOUNT = 4143;
+ LVM_SETITEMPOSITION = 4111;
+ LVM_SETITEMPOSITION32 = 4145;
+ LVM_SETITEMSTATE = 4139;
+ LVM_SETTEXTBKCOLOR = 4134;
+ LVM_SETTEXTCOLOR = 4132;
+ LVM_SORTITEMS = 4144;
+ LVM_UPDATE = 4138;
+ { List view control notifications }
+ LVN_BEGINDRAG = -(109);
+ LVN_BEGINRDRAG = -(111);
+ LVN_COLUMNCLICK = -(108);
+ LVN_DELETEALLITEMS = -(104);
+ LVN_DELETEITEM = -(103);
+ LVN_BEGINLABELEDITW = -(175);
+ LVN_ENDLABELEDITW = -(176);
+ LVN_GETDISPINFOW = -(177);
+ LVN_SETDISPINFOW = -(178);
+ LVN_BEGINLABELEDITA = -(105);
+ LVN_ENDLABELEDITA = -(106);
+ LVN_GETDISPINFOA = -(150);
+ LVN_SETDISPINFOA = -(151);
+{$ifdef UNICODE}
+
+ const
+ LVN_BEGINLABELEDIT = LVN_BEGINLABELEDITW;
+ LVN_ENDLABELEDIT = LVN_ENDLABELEDITW;
+ LVN_GETDISPINFO = LVN_GETDISPINFOW;
+ LVN_SETDISPINFO = LVN_SETDISPINFOW;
+{$else}
+
+ const
+ LVN_BEGINLABELEDIT = LVN_BEGINLABELEDITA;
+ LVN_ENDLABELEDIT = LVN_ENDLABELEDITA;
+ LVN_GETDISPINFO = LVN_GETDISPINFOA;
+ LVN_SETDISPINFO = LVN_SETDISPINFOA;
+{$endif}
+ { UNICODE }
+
+ const
+ LVN_INSERTITEM = -(102);
+ LVN_ITEMCHANGED = -(101);
+ LVN_ITEMCHANGING = -(100);
+ LVN_KEYDOWN = -(155);
+ { Control notification }
+ NM_CLICK = -(2);
+ NM_DBLCLK = -(3);
+ NM_KILLFOCUS = -(8);
+ NM_OUTOFMEMORY = -(1);
+ NM_RCLICK = -(5);
+ NM_RDBLCLK = -(6);
+ NM_RETURN = -(4);
+ NM_SETFOCUS = -(7);
+ { Power status }
+ { Progress bar control }
+ PBM_DELTAPOS = 1027;
+ PBM_SETPOS = 1026;
+ PBM_SETRANGE = 1025;
+ PBM_SETSTEP = 1028;
+ PBM_STEPIT = 1029;
+ { Property sheets }
+ PSM_ADDPAGE = 1127;
+ PSM_APPLY = 1134;
+ PSM_CANCELTOCLOSE = 1131;
+ PSM_CHANGED = 1128;
+ PSM_GETTABCONTROL = 1140;
+ PSM_GETCURRENTPAGEHWND = 1142;
+ PSM_ISDIALOGMESSAGE = 1141;
+ PSM_PRESSBUTTON = 1137;
+ PSM_QUERYSIBLINGS = 1132;
+ PSM_REBOOTSYSTEM = 1130;
+ PSM_REMOVEPAGE = 1126;
+ PSM_RESTARTWINDOWS = 1129;
+ PSM_SETCURSEL = 1125;
+ PSM_SETCURSELID = 1138;
+ PSM_SETFINISHTEXTW = 1145;
+ PSM_SETTITLEW = 1144;
+ PSM_SETFINISHTEXTA = 1139;
+ PSM_SETTITLEA = 1135;
+{$ifdef UNICODE}
+
+ const
+ PSM_SETFINISHTEXT = PSM_SETFINISHTEXTW;
+ PSM_SETTITLE = PSM_SETTITLEW;
+{$else}
+
+ const
+ PSM_SETFINISHTEXT = PSM_SETFINISHTEXTA;
+ PSM_SETTITLE = PSM_SETTITLEA;
+{$endif}
+ { UNICODE }
+
+ const
+ PSM_SETWIZBUTTONS = 1136;
+ PSM_UNCHANGED = 1133;
+ { Property sheet notifications }
+ PSN_APPLY = -(202);
+ PSN_HELP = -(205);
+ PSN_KILLACTIVE = -(201);
+ PSN_QUERYCANCEL = -(209);
+ PSN_RESET = -(203);
+ PSN_SETACTIVE = -(200);
+ PSN_WIZBACK = -(206);
+ PSN_WIZFINISH = -(208);
+ PSN_WIZNEXT = -(207);
+ { Status window }
+ SB_GETBORDERS = 1031;
+ SB_GETPARTS = 1030;
+ SB_GETRECT = 1034;
+ SB_GETTEXTW = 1037;
+ SB_GETTEXTLENGTHW = 1036;
+ SB_SETTEXTW = 1035;
+ SB_GETTEXTA = 1026;
+ SB_GETTEXTLENGTHA = 1027;
+ SB_SETTEXTA = 1025;
+{$ifdef UNICODE}
+
+ const
+ SB_GETTEXT = SB_GETTEXTW;
+ SB_GETTEXTLENGTH = SB_GETTEXTLENGTHW;
+ SB_SETTEXT = SB_SETTEXTW;
+{$else}
+
+ const
+ SB_GETTEXT = SB_GETTEXTA;
+ SB_GETTEXTLENGTH = SB_GETTEXTLENGTHA;
+ SB_SETTEXT = SB_SETTEXTA;
+{$endif}
+ { UNICODE }
+
+ const
+ SB_SETMINHEIGHT = 1032;
+ SB_SETPARTS = 1028;
+ SB_SIMPLE = 1033;
+ { Scroll bar control }
+ SBM_ENABLE_ARROWS = 228;
+ SBM_GETPOS = 225;
+ SBM_GETRANGE = 227;
+ SBM_GETSCROLLINFO = 234;
+ SBM_SETPOS = 224;
+ SBM_SETRANGE = 226;
+ SBM_SETRANGEREDRAW = 230;
+ SBM_SETSCROLLINFO = 233;
+ { Static control }
+ STM_GETICON = 369;
+ STM_GETIMAGE = 371;
+ STM_SETICON = 368;
+ STM_SETIMAGE = 370;
+ { Static control notifications }
+ STN_CLICKED = 0;
+ STN_DBLCLK = 1;
+ STN_DISABLE = 3;
+ STN_ENABLE = 2;
+ { Toolbar control }
+ TB_ADDBITMAP = 1043;
+ TB_ADDBUTTONS = 1044;
+ TB_AUTOSIZE = 1057;
+ TB_BUTTONCOUNT = 1048;
+ TB_BUTTONSTRUCTSIZE = 1054;
+ TB_CHANGEBITMAP = 1067;
+ TB_CHECKBUTTON = 1026;
+ TB_COMMANDTOINDEX = 1049;
+ TB_CUSTOMIZE = 1051;
+ TB_DELETEBUTTON = 1046;
+ TB_ENABLEBUTTON = 1025;
+ TB_GETBITMAP = 1068;
+ TB_GETBITMAPFLAGS = 1065;
+ TB_GETBUTTON = 1047;
+ TB_ADDSTRINGW = 1101;
+ TB_GETBUTTONTEXTW = 1099;
+ TB_SAVERESTOREW = 1100;
+ TB_ADDSTRINGA = 1052;
+ TB_GETBUTTONTEXTA = 1069;
+ TB_SAVERESTOREA = 1050;
+{$ifdef UNICODE}
+
+ const
+ TB_ADDSTRING = TB_ADDSTRINGW;
+ TB_GETBUTTONTEXT = TB_GETBUTTONTEXTW;
+ TB_SAVERESTORE = TB_SAVERESTOREW;
+{$else}
+
+ const
+ TB_ADDSTRING = TB_ADDSTRINGA;
+ TB_GETBUTTONTEXT = TB_GETBUTTONTEXTA;
+ TB_SAVERESTORE = TB_SAVERESTOREA;
+{$endif}
+ { UNICODE }
+
+ const
+ TB_GETITEMRECT = 1053;
+ TB_GETROWS = 1064;
+ TB_GETSTATE = 1042;
+ TB_GETTOOLTIPS = 1059;
+ TB_HIDEBUTTON = 1028;
+ TB_INDETERMINATE = 1029;
+ TB_INSERTBUTTON = 1045;
+ TB_ISBUTTONCHECKED = 1034;
+ TB_ISBUTTONENABLED = 1033;
+ TB_ISBUTTONHIDDEN = 1036;
+ TB_ISBUTTONINDETERMINATE = 1037;
+ TB_ISBUTTONPRESSED = 1035;
+ TB_PRESSBUTTON = 1027;
+ TB_SETBITMAPSIZE = 1056;
+ TB_SETBUTTONSIZE = 1055;
+ TB_SETCMDID = 1066;
+ TB_SETPARENT = 1061;
+ TB_SETROWS = 1063;
+ TB_SETSTATE = 1041;
+ TB_SETTOOLTIPS = 1060;
+ { Track bar control }
+ TBM_CLEARSEL = 1043;
+ TBM_CLEARTICS = 1033;
+ TBM_GETCHANNELRECT = 1050;
+ TBM_GETLINESIZE = 1048;
+ TBM_GETNUMTICS = 1040;
+ TBM_GETPAGESIZE = 1046;
+ TBM_GETPOS = 1024;
+ TBM_GETPTICS = 1038;
+ TBM_GETRANGEMAX = 1026;
+ TBM_GETRANGEMIN = 1025;
+ TBM_GETSELEND = 1042;
+ TBM_GETSELSTART = 1041;
+ TBM_GETTHUMBLENGTH = 1052;
+ TBM_GETTHUMBRECT = 1049;
+ TBM_GETTIC = 1027;
+ TBM_GETTICPOS = 1039;
+ TBM_SETLINESIZE = 1047;
+ TBM_SETPAGESIZE = 1045;
+ TBM_SETPOS = 1029;
+ TBM_SETRANGE = 1030;
+ TBM_SETRANGEMAX = 1032;
+ TBM_SETRANGEMIN = 1031;
+ TBM_SETSEL = 1034;
+ TBM_SETSELEND = 1036;
+ TBM_SETSELSTART = 1035;
+ TBM_SETTHUMBLENGTH = 1051;
+ TBM_SETTIC = 1028;
+ TBM_SETTICFREQ = 1044;
+ { Tool bar control notifications }
+ TBN_BEGINADJUST = -(703);
+ TBN_BEGINDRAG = -(701);
+ TBN_CUSTHELP = -(709);
+ TBN_ENDADJUST = -(704);
+ TBN_ENDDRAG = -(702);
+ TBN_GETBUTTONINFOW = -(720);
+ TBN_GETBUTTONINFOA = -(700);
+{$ifdef UNICODE}
+
+ const
+ TBN_GETBUTTONINFO = TBN_GETBUTTONINFOW;
+{$else}
+
+ const
+ TBN_GETBUTTONINFO = TBN_GETBUTTONINFOA;
+{$endif}
+ { UNICODE }
+
+ const
+ TBN_QUERYDELETE = -(707);
+ TBN_QUERYINSERT = -(706);
+ TBN_RESET = -(705);
+ TBN_TOOLBARCHANGE = -(708);
+ { Tab control }
+ TCM_ADJUSTRECT = 4904;
+ TCM_DELETEALLITEMS = 4873;
+ TCM_DELETEITEM = 4872;
+ TCM_GETCURFOCUS = 4911;
+ TCM_GETCURSEL = 4875;
+ TCM_GETIMAGELIST = 4866;
+ TCM_GETITEMW = 4924;
+ TCM_INSERTITEMW = 4926;
+ TCM_SETITEMW = 4925;
+ TCM_GETITEMA = 4869;
+ TCM_INSERTITEMA = 4871;
+ TCM_SETITEMA = 4870;
+{$ifdef UNICODE}
+
+ const
+ TCM_GETITEM = TCM_GETITEM;
+ TCM_INSERTITEM = TCM_INSERTITEMW;
+ TCM_SETITEM = TCM_SETITEMW;
+{$else}
+
+ const
+ TCM_GETITEM = TCM_GETITEMA;
+ TCM_INSERTITEM = TCM_INSERTITEMA;
+ TCM_SETITEM = TCM_SETITEMA;
+{$endif}
+ { UNICODE }
+
+ const
+ TCM_GETITEMCOUNT = 4868;
+ TCM_GETITEMRECT = 4874;
+ TCM_GETROWCOUNT = 4908;
+ TCM_GETTOOLTIPS = 4909;
+ TCM_HITTEST = 4877;
+ TCM_REMOVEIMAGE = 4906;
+ TCM_SETCURFOCUS = 4912;
+ TCM_SETCURSEL = 4876;
+ TCM_SETIMAGELIST = 4867;
+ TCM_SETITEMEXTRA = 4878;
+ TCM_SETITEMSIZE = 4905;
+ TCM_SETPADDING = 4907;
+ TCM_SETTOOLTIPS = 4910;
+ { Tab control notifications }
+ TCN_KEYDOWN = -(550);
+ TCN_SELCHANGE = -(551);
+ TCN_SELCHANGING = -(552);
+ { Tool tip control }
+ TTM_ACTIVATE = 1025;
+ TTM_ADDTOOLW = 1074;
+ TTM_DELTOOLW = 1075;
+ TTM_ENUMTOOLSW = 1082;
+ TTM_GETCURRENTTOOLW = 1083;
+ TTM_GETTEXTW = 1080;
+ TTM_GETTOOLINFOW = 1077;
+ TTM_HITTESTW = 1079;
+ TTM_NEWTOOLRECTW = 1076;
+ TTM_SETTOOLINFOW = 1078;
+ TTM_UPDATETIPTEXTW = 1081;
+ TTM_ADDTOOLA = 1028;
+ TTM_DELTOOLA = 1029;
+ TTM_ENUMTOOLSA = 1038;
+ TTM_GETCURRENTTOOLA = 1039;
+ TTM_GETTEXTA = 1035;
+ TTM_GETTOOLINFOA = 1032;
+ TTM_HITTESTA = 1034;
+ TTM_NEWTOOLRECTA = 1030;
+ TTM_SETTOOLINFOA = 1033;
+ TTM_UPDATETIPTEXTA = 1036;
+{$ifdef UNICODE}
+
+ const
+ TTM_ADDTOOL = TTM_ADDTOOLW;
+ TTM_DELTOOL = TTM_DELTOOLW;
+ TTM_ENUMTOOLS = TTM_ENUMTOOLSW;
+ TTM_GETCURRENTTOOL = TTM_GETCURRENTTOOLW;
+ TTM_GETTEXT = TTM_GETTEXTW;
+ TTM_GETTOOLINFO = TTM_GETTOOLINFOW;
+ TTM_HITTEST = TTM_HITTESTW;
+ TTM_NEWTOOLRECT = TTM_NEWTOOLRECTW;
+ TTM_SETTOOLINFO = TTM_SETTOOLINFOW;
+ TTM_UPDATETIPTEXT = TTM_UPDATETIPTEXTW;
+{$else}
+
+ const
+ TTM_ADDTOOL = TTM_ADDTOOLA;
+ TTM_DELTOOL = TTM_DELTOOLA;
+ TTM_ENUMTOOLS = TTM_ENUMTOOLSA;
+ TTM_GETCURRENTTOOL = TTM_GETCURRENTTOOLA;
+ TTM_GETTEXT = TTM_GETTEXTA;
+ TTM_GETTOOLINFO = TTM_GETTOOLINFOA;
+ TTM_HITTEST = TTM_HITTESTA;
+ TTM_NEWTOOLRECT = TTM_NEWTOOLRECTA;
+ TTM_SETTOOLINFO = TTM_SETTOOLINFOA;
+ TTM_UPDATETIPTEXT = TTM_UPDATETIPTEXTA;
+{$endif}
+ { UNICODE }
+
+ const
+ TTM_GETTOOLCOUNT = 1037;
+ TTM_RELAYEVENT = 1031;
+ TTM_SETDELAYTIME = 1027;
+ TTM_WINDOWFROMPOINT = 1040;
+ { Tool tip control notification }
+ TTN_NEEDTEXTW = -(530);
+ TTN_NEEDTEXTA = -(520);
+{$ifdef UNICODE}
+
+ const
+ TTN_NEEDTEXT = TTN_NEEDTEXTW;
+{$else}
+
+ const
+ TTN_NEEDTEXT = TTN_NEEDTEXTA;
+{$endif}
+ { UNICODE }
+
+ const
+ TTN_POP = -(522);
+ TTN_SHOW = -(521);
+ { Tree view control }
+ TVM_CREATEDRAGIMAGE = 4370;
+ TVM_DELETEITEM = 4353;
+ TVM_ENDEDITLABELNOW = 4374;
+ TVM_ENSUREVISIBLE = 4372;
+ TVM_EXPAND = 4354;
+ TVM_GETCOUNT = 4357;
+ TVM_GETEDITCONTROL = 4367;
+ TVM_GETIMAGELIST = 4360;
+ TVM_GETINDENT = 4358;
+ TVM_GETITEMRECT = 4356;
+ TVM_GETNEXTITEM = 4362;
+ TVM_GETVISIBLECOUNT = 4368;
+ TVM_HITTEST = 4369;
+ TVM_EDITLABELW = 4417;
+ TVM_GETISEARCHSTRINGW = 4416;
+ TVM_GETITEMW = 4414;
+ TVM_INSERTITEMW = 4402;
+ TVM_SETITEMW = 4415;
+ TVM_EDITLABELA = 4366;
+ TVM_GETISEARCHSTRINGA = 4375;
+ TVM_GETITEMA = 4364;
+ TVM_INSERTITEMA = 4352;
+ TVM_SETITEMA = 4365;
+{$ifdef UNICODE}
+
+ const
+ TVM_EDITLABEL = TVM_EDITLABELW;
+ TVM_GETISEARCHSTRING = TVM_GETISEARCHSTRINGW;
+ TVM_GETITEM = TVM_GETITEMW;
+ TVM_INSERTITEM = TVM_INSERTITEMW;
+ TVM_SETITEM = TVM_SETITEMW;
+{$else}
+
+ const
+ TVM_EDITLABEL = TVM_EDITLABELA;
+ TVM_GETISEARCHSTRING = TVM_GETISEARCHSTRINGA;
+ TVM_GETITEM = TVM_GETITEMA;
+ TVM_INSERTITEM = TVM_INSERTITEMA;
+ TVM_SETITEM = TVM_SETITEMA;
+{$endif}
+ { UNICODE }
+
+ const
+ TVM_SELECTITEM = 4363;
+ TVM_SETIMAGELIST = 4361;
+ TVM_SETINDENT = 4359;
+ TVM_SORTCHILDREN = 4371;
+ TVM_SORTCHILDRENCB = 4373;
+ { Tree view control notification }
+ TVN_KEYDOWN = -(412);
+ TVN_BEGINDRAGW = -(456);
+ TVN_BEGINLABELEDITW = -(459);
+ TVN_BEGINRDRAGW = -(457);
+ TVN_DELETEITEMW = -(458);
+ TVN_ENDLABELEDITW = -(460);
+ TVN_GETDISPINFOW = -(452);
+ TVN_ITEMEXPANDEDW = -(455);
+ TVN_ITEMEXPANDINGW = -(454);
+ TVN_SELCHANGEDW = -(451);
+ TVN_SELCHANGINGW = -(450);
+ TVN_SETDISPINFOW = -(453);
+ TVN_BEGINDRAGA = -(407);
+ TVN_BEGINLABELEDITA = -(410);
+ TVN_BEGINRDRAGA = -(408);
+ TVN_DELETEITEMA = -(409);
+ TVN_ENDLABELEDITA = -(411);
+ TVN_GETDISPINFOA = -(403);
+ TVN_ITEMEXPANDEDA = -(406);
+ TVN_ITEMEXPANDINGA = -(405);
+ TVN_SELCHANGEDA = -(402);
+ TVN_SELCHANGINGA = -(401);
+ TVN_SETDISPINFOA = -(404);
+{$ifdef UNICODE}
+
+ const
+ TVN_BEGINDRAG = TVN_BEGINDRAGW;
+ TVN_BEGINLABELEDIT = TVN_BEGINLABELEDITW;
+ TVN_BEGINRDRAG = TVN_BEGINRDRAGW;
+ TVN_DELETEITEM = TVN_DELETEITEMW;
+ TVN_ENDLABELEDIT = TVN_ENDLABELEDITW;
+ TVN_GETDISPINFO = TVN_GETDISPINFOW;
+ TVN_ITEMEXPANDED = TVN_ITEMEXPANDEDW;
+ TVN_ITEMEXPANDING = TVN_ITEMEXPANDINGW;
+ TVN_SELCHANGED = TVN_SELCHANGEDW;
+ TVN_SELCHANGING = TVN_SELCHANGINGW;
+ TVN_SETDISPINFO = TVN_SETDISPINFOW;
+{$else}
+
+ const
+ TVN_BEGINDRAG = TVN_BEGINDRAGA;
+ TVN_BEGINLABELEDIT = TVN_BEGINLABELEDITA;
+ TVN_BEGINRDRAG = TVN_BEGINRDRAGA;
+ TVN_DELETEITEM = TVN_DELETEITEMA;
+ TVN_ENDLABELEDIT = TVN_ENDLABELEDITA;
+ TVN_GETDISPINFO = TVN_GETDISPINFOA;
+ TVN_ITEMEXPANDED = TVN_ITEMEXPANDEDA;
+ TVN_ITEMEXPANDING = TVN_ITEMEXPANDINGA;
+ TVN_SELCHANGED = TVN_SELCHANGEDA;
+ TVN_SELCHANGING = TVN_SELCHANGINGA;
+ TVN_SETDISPINFO = TVN_SETDISPINFOA;
+{$endif}
+ { UNICODE }
+ { Up/down control }
+
+ const
+ UDM_GETACCEL = 1132;
+ UDM_GETBASE = 1134;
+ UDM_GETBUDDY = 1130;
+ UDM_GETPOS = 1128;
+ UDM_GETPOS32 = 1138;
+ UDM_GETRANGE = 1126;
+ UDM_GETRANGE32 = 1136;
+ UDM_SETACCEL = 1131;
+ UDM_SETBASE = 1133;
+ UDM_SETBUDDY = 1129;
+ UDM_SETPOS = 1127;
+ UDM_SETPOS32 = 1137;
+ UDM_SETRANGE = 1125;
+ UDM_SETRANGE32 = 1135;
+ { Up/down control notification }
+ UDN_DELTAPOS = -(722);
+ { Window messages }
+ WM_ACTIVATE = 6;
+ WM_ACTIVATEAPP = 28;
+ WM_ASKCBFORMATNAME = 780;
+ WM_CANCELJOURNAL = 75;
+ WM_CANCELMODE = 31;
+ WM_CAPTURECHANGED = 533;
+ WM_CHANGECBCHAIN = 781;
+ WM_CHAR = 258;
+ WM_CHARTOITEM = 47;
+ WM_CHILDACTIVATE = 34;
+ WM_CHOOSEFONT_GETLOGFONT = 1025;
+ WM_CHOOSEFONT_SETLOGFONT = 1125;
+ WM_CHOOSEFONT_SETFLAGS = 1126;
+ WM_CLEAR = 771;
+ WM_CLOSE = 16;
+ WM_COMMAND = 273;
+ WM_COMPACTING = 65;
+ WM_COMPAREITEM = 57;
+ WM_CONTEXTMENU = 123;
+ WM_COPY = 769;
+ WM_COPYDATA = 74;
+ WM_CREATE = 1;
+ WM_CTLCOLORBTN = 309;
+ WM_CTLCOLORDLG = 310;
+ WM_CTLCOLOREDIT = 307;
+ WM_CTLCOLORLISTBOX = 308;
+ WM_CTLCOLORMSGBOX = 306;
+ WM_CTLCOLORSCROLLBAR = 311;
+ WM_CTLCOLORSTATIC = 312;
+ WM_CUT = 768;
+ WM_DEADCHAR = 259;
+ WM_DELETEITEM = 45;
+ WM_DESTROY = 2;
+ WM_DESTROYCLIPBOARD = 775;
+ WM_DEVICECHANGE = 537;
+ WM_DEVMODECHANGE = 27;
+ WM_DISPLAYCHANGE = 126;
+ WM_DRAWCLIPBOARD = 776;
+ WM_DRAWITEM = 43;
+ WM_DROPFILES = 563;
+ WM_ENABLE = 10;
+ WM_ENDSESSION = 22;
+ WM_ENTERIDLE = 289;
+ WM_ENTERMENULOOP = 529;
+ WM_ENTERSIZEMOVE = 561;
+ WM_ERASEBKGND = 20;
+ WM_EXITMENULOOP = 530;
+ WM_EXITSIZEMOVE = 562;
+ WM_FONTCHANGE = 29;
+ WM_GETDLGCODE = 135;
+ WM_GETFONT = 49;
+ WM_GETHOTKEY = 51;
+ WM_GETICON = 127;
+ WM_GETMINMAXINFO = 36;
+ WM_GETTEXT = 13;
+ WM_GETTEXTLENGTH = 14;
+ WM_HELP = 83;
+ WM_HOTKEY = 786;
+ WM_HSCROLL = 276;
+ WM_HSCROLLCLIPBOARD = 782;
+ WM_ICONERASEBKGND = 39;
+ WM_IME_CHAR = 646;
+ WM_IME_COMPOSITION = 271;
+ WM_IME_COMPOSITIONFULL = 644;
+ WM_IME_CONTROL = 643;
+ WM_IME_ENDCOMPOSITION = 270;
+ WM_IME_KEYDOWN = 656;
+ WM_IME_KEYUP = 657;
+ WM_IME_NOTIFY = 642;
+ WM_IME_SELECT = 645;
+ WM_IME_SETCONTEXT = 641;
+ WM_IME_STARTCOMPOSITION = 269;
+ WM_INITDIALOG = 272;
+ WM_INITMENU = 278;
+ WM_INITMENUPOPUP = 279;
+ WM_INPUTLANGCHANGE = 81;
+ WM_INPUTLANGCHANGEREQUEST = 80;
+ WM_KEYDOWN = 256;
+ WM_KEYUP = 257;
+ WM_KILLFOCUS = 8;
+ WM_LBUTTONDBLCLK = 515;
+ WM_LBUTTONDOWN = 513;
+ WM_LBUTTONUP = 514;
+ WM_MBUTTONDBLCLK = 521;
+ WM_MBUTTONDOWN = 519;
+ WM_MBUTTONUP = 520;
+ WM_MDIACTIVATE = 546;
+ WM_MDICASCADE = 551;
+ WM_MDICREATE = 544;
+ WM_MDIDESTROY = 545;
+ WM_MDIGETACTIVE = 553;
+ WM_MDIICONARRANGE = 552;
+ WM_MDIMAXIMIZE = 549;
+ WM_MDINEXT = 548;
+ WM_MDIREFRESHMENU = 564;
+ WM_MDIRESTORE = 547;
+ WM_MDISETMENU = 560;
+ WM_MDITILE = 550;
+ WM_MEASUREITEM = 44;
+ WM_MENUCHAR = 288;
+ WM_MENUSELECT = 287;
+ WM_MOUSEACTIVATE = 33;
+ WM_MOUSEMOVE = 512;
+ WM_MOUSEWHEEL = 522;
+ WM_MOUSEHOVER = 673;
+ WM_MOUSELEAVE = 675;
+ WM_MOVE = 3;
+ WM_MOVING = 534;
+ WM_NCACTIVATE = 134;
+ WM_NCCALCSIZE = 131;
+ WM_NCCREATE = 129;
+ WM_NCDESTROY = 130;
+ WM_NCHITTEST = 132;
+ WM_NCLBUTTONDBLCLK = 163;
+ WM_NCLBUTTONDOWN = 161;
+ WM_NCLBUTTONUP = 162;
+ WM_NCMBUTTONDBLCLK = 169;
+ WM_NCMBUTTONDOWN = 167;
+ WM_NCMBUTTONUP = 168;
+ WM_NCMOUSEMOVE = 160;
+ WM_NCPAINT = 133;
+ WM_NCRBUTTONDBLCLK = 166;
+ WM_NCRBUTTONDOWN = 164;
+ WM_NCRBUTTONUP = 165;
+ WM_NEXTDLGCTL = 40;
+ WM_NOTIFY = 78;
+ WM_NOTIFYFORMAT = 85;
+ WM_NULL = 0;
+ WM_PAINT = 15;
+ WM_PAINTCLIPBOARD = 777;
+ WM_PAINTICON = 38;
+ WM_PALETTECHANGED = 785;
+ WM_PALETTEISCHANGING = 784;
+ WM_PARENTNOTIFY = 528;
+ WM_PASTE = 770;
+ WM_PENWINFIRST = 896;
+ WM_PENWINLAST = 911;
+ WM_POWER = 72;
+ WM_POWERBROADCAST = 536;
+ WM_PRINT = 791;
+ WM_PRINTCLIENT = 792;
+ WM_PSD_ENVSTAMPRECT = 1029;
+ WM_PSD_FULLPAGERECT = 1025;
+ WM_PSD_GREEKTEXTRECT = 1028;
+ WM_PSD_MARGINRECT = 1027;
+ WM_PSD_MINMARGINRECT = 1026;
+ WM_PSD_PAGESETUPDLG = 1024;
+ WM_PSD_YAFULLPAGERECT = 1030;
+ WM_QUERYDRAGICON = 55;
+ WM_QUERYENDSESSION = 17;
+ WM_QUERYNEWPALETTE = 783;
+ WM_QUERYOPEN = 19;
+ WM_QUEUESYNC = 35;
+ WM_QUIT = 18;
+ WM_RBUTTONDBLCLK = 518;
+ WM_RBUTTONDOWN = 516;
+ WM_RBUTTONUP = 517;
+ WM_RENDERALLFORMATS = 774;
+ WM_RENDERFORMAT = 773;
+ WM_SETCURSOR = 32;
+ WM_SETFOCUS = 7;
+ WM_SETFONT = 48;
+ WM_SETHOTKEY = 50;
+ WM_SETICON = 128;
+ WM_SETREDRAW = 11;
+ WM_SETTEXT = 12;
+ WM_SETTINGCHANGE = 26;
+ WM_SHOWWINDOW = 24;
+ WM_SIZE = 5;
+ WM_SIZECLIPBOARD = 779;
+ WM_SIZING = 532;
+ WM_SPOOLERSTATUS = 42;
+ WM_STYLECHANGED = 125;
+ WM_STYLECHANGING = 124;
+ WM_SYSCHAR = 262;
+ WM_SYSCOLORCHANGE = 21;
+ WM_SYSCOMMAND = 274;
+ WM_SYSDEADCHAR = 263;
+ WM_SYSKEYDOWN = 260;
+ WM_SYSKEYUP = 261;
+ WM_TCARD = 82;
+ WM_TIMECHANGE = 30;
+ WM_TIMER = 275;
+ WM_UNDO = 772;
+ WM_USER = 1024;
+ WM_USERCHANGED = 84;
+ WM_VKEYTOITEM = 46;
+ WM_VSCROLL = 277;
+ WM_VSCROLLCLIPBOARD = 778;
+ WM_WINDOWPOSCHANGED = 71;
+ WM_WINDOWPOSCHANGING = 70;
+ WM_WININICHANGE = 26;
+ { Window message ranges }
+ WM_KEYFIRST = 256;
+ WM_KEYLAST = 264;
+ WM_MOUSEFIRST = 512;
+ WM_MOUSELAST = 525;
+ WM_XBUTTONDOWN = 523;
+ WM_XBUTTONUP = 524;
+ WM_XBUTTONDBLCLK = 525;
+
+Type
+{$ifdef MESSAGESUNIT}
+
+ MSG = Windows.MSG;
+ TMessage = Windows.TMessage;
+ TWMSize = Windows.TWMSize;
+ TWMNoParams = Windows.TWMNoParams;
+ TWMScroll = Windows.TWMScroll;
+ TWMGetText = Windows.TWMGetText;
+ TWMKillFocus = Windows.TWMKillFocus;
+ TWMSetCursor = Windows.TWMSetCursor;
+ TWMSetFocus = Windows.TWMSetFocus;
+ TWMSetFont = Windows.TWMSetFont;
+ TWMShowWindow = Windows.TWMShowWindow;
+ TWMEraseBkgnd = Windows.TWMEraseBkgnd;
+ LPMSG = Windows.MSG;
+ tagMSG = Windows.tagMSG;
+ TMSG = Windows.TMSG;
+ PMSG = Windows.PMSG;
+ PMessage = Windows.PMessage;
+ TWMGetDlgCode = TWMNoParams;
+ TWMFontChange = TWMNoParams;
+ TWMGetFont = TWMNoParams;
+ TWMHScroll = TWMScroll;
+ TWMVScroll = TWMScroll;
+ TWMGetTextLength = TWMNoParams;
+
+{$else}
+
+ MSG = record
+ hwnd : HWND;
+ message : UINT;
+ wParam : WPARAM;
+ lParam : LPARAM;
+ time : DWORD;
+ pt : POINT;
+ end;
+
+ LPMSG = ^MSG;
+ tagMSG = MSG;
+ TMSG = MSG;
+ PMSG = ^MSG;
+
+
+ PMessage = ^TMessage;
+ TMessage = packed record {fields according to ICS}
+ msg : UINT;
+ case longint of
+ 0: (
+ wParam : WPARAM;
+ lParam : LPARAM;
+ Result : LRESULT;
+ );
+ 1: (
+ wParamlo,
+ wParamhi : WORD; // Is there Windows type for half an wparam?
+ lParamlo,
+ lParamhi : WORD;
+ Resultlo,
+ Resulthi : WORD;
+ );
+ end;
+
+ TWMSize = packed record
+ Msg: Cardinal;
+ SizeType : LongInt;
+ Width : Word;
+ Height : Word;
+ Result : LongInt;
+ End;
+
+ TWMNoParams = packed record
+ Msg : Cardinal;
+ Unused : array[0..3] of Word;
+ Result : Longint;
+ end;
+
+ TWMGetDlgCode = TWMNoParams;
+ TWMFontChange = TWMNoParams;
+ TWMGetFont = TWMNoParams;
+
+ TWMScroll = record
+ Msg : Cardinal;
+ ScrollCode : SmallInt;
+ Pos : SmallInt;
+ ScrollBar : HWND;
+ Result : LongInt;
+ end;
+
+ TWMHScroll = TWMScroll;
+ TWMVScroll = TWMScroll;
+
+ TWMGetText = packed record
+ Msg : Cardinal;
+ TextMax : LongInt;
+ Text : PChar;
+ Result : LongInt;
+ end;
+
+ TWMGetTextLength = TWMNoParams;
+
+ TWMKillFocus = packed record
+ Msg : Cardinal;
+ FocusedWnd : HWND;
+ UnUsed : LongInt;
+ Result : LongInt;
+ End;
+
+ TWMSetCursor = packed record
+ Msg : Cardinal;
+ CursorWnd : HWND;
+ HitTest : Word;
+ MouseMsg : Word;
+ Result : LongInt;
+ end;
+
+ TWMSetFocus = packed record
+ Msg : Cardinal;
+ FocusedWnd : HWND;
+ Unused : LongInt;
+ Result : LongInt;
+ end;
+
+ TWMSetFont = packed record
+ Msg : Cardinal;
+ Font : HFONT;
+ Redraw : WordBool;
+ Unused : Word;
+ Result : LongInt;
+ end;
+
+ TWMShowWindow = packed record
+ Msg : Cardinal;
+ Show : BOOL;
+ Status : LongInt;
+ Result : LongInt;
+ end;
+
+ TWMEraseBkgnd = packed record
+ Msg: Cardinal;
+ DC: HDC;
+ Unused: Longint;
+ Result: Longint;
+ end;
+
+{$endif messagesunit}
+
+{$endif read_interface}
+
+{
+ $Log: messages.inc,v $
+ Revision 1.14 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/redef.inc b/rtl/win32/wininc/redef.inc
new file mode 100644
index 0000000000..68e6c1c20b
--- /dev/null
+++ b/rtl/win32/wininc/redef.inc
@@ -0,0 +1,1071 @@
+{
+ $Id: redef.inc,v 1.31 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team
+
+ This file defines type names as they are used by Delphi
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$ifdef read_interface}
+
+type
+ PIID = PGUID;
+ TIID = TGUID;
+ THANDLE = HANDLE;
+
+ PSmallRect = ^TSmallRect;
+ TSmallRect = SMALL_RECT;
+
+ PCharInfo = ^TCharInfo;
+ TCharInfo = _CHAR_INFO;
+
+ TFarProc = FARPROC;
+ TFNDlgProc = FARPROC;
+ TFNThreadStartRoutine = FARPROC;
+ TFNTimerAPCRoutine = FARPROC;
+ TFNFiberStartRoutine = FARPROC;
+
+ PObjectTypeList = ^TObjectTypeList;
+ _OBJECT_TYPE_LIST = record
+ Level: WORD;
+ Sbz: WORD;
+ ObjectType: PGUID;
+ end;
+ TObjectTypeList = _OBJECT_TYPE_LIST;
+ OBJECT_TYPE_LIST = _OBJECT_TYPE_LIST;
+
+ AUDIT_EVENT_TYPE = DWORD;
+
+ PBlendFunction = ^TBlendFunction;
+ _BLENDFUNCTION = packed record
+ BlendOp: BYTE;
+ BlendFlags: BYTE;
+ SourceConstantAlpha: BYTE;
+ AlphaFormat: BYTE;
+ end;
+ TBlendFunction = _BLENDFUNCTION;
+ BLENDFUNCTION = _BLENDFUNCTION;
+
+ _WIN_CERTIFICATE = Packed Record
+ dwLength : DWord;
+ wRevision : Word;
+ wCertificateType : Word;
+ bCertificate : Array[0..0] of Byte;
+ End;
+ TWinCertificate = _WIN_CERTIFICATE;
+ PWinCertificate = ^TWinCertificate;
+
+ TMaxLogPalette = Packed Record
+ palVersion : Word;
+ palNumEntries : Word;
+ palPalEntry : array[Byte] of TPaletteEntry;
+ end;
+ PMaxLogPalette = ^TMaxLogPalette;
+
+const
+ { dll names }
+ advapi32 = 'advapi32.dll';
+ kernel32 = 'kernel32.dll';
+ mpr = 'mpr.dll';
+ version = 'version.dll';
+ comctl32 = 'comctl32.dll';
+ gdi32 = 'gdi32.dll';
+ opengl32 = 'opengl32.dll';
+ user32 = 'user32.dll';
+ wintrust = 'wintrust.dll';
+
+ { Openfile Share modes normally declared in sysutils }
+ fmShareCompat = $00000000;
+ fmShareExclusive = $10;
+ fmShareDenyWrite = $20;
+ fmShareDenyRead = $30;
+ fmShareDenyNone = $40;
+
+ { HRESULT codes, delphilike }
+ NOERROR = 0;
+
+const
+ { Severity values }
+ FACILITY_NT_BIT = $10000000;
+ HFILE_ERROR = HFILE(-1);
+
+//
+// A language ID is a 16 bit value which is the combination of a
+// primary language ID and a secondary language ID. The bits are
+// allocated as follows:
+//
+// +-----------------------+-------------------------+
+// | Sublanguage ID | Primary Language ID |
+// +-----------------------+-------------------------+
+// 15 10 9 0 bit
+//
+//
+// Language ID creation/extraction macros:
+//
+// MAKELANGID - construct language id from a primary language id and
+// a sublanguage id.
+// PRIMARYLANGID - extract primary language id from a language id.
+// SUBLANGID - extract sublanguage id from a language id.
+//
+
+function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
+function PRIMARYLANGID(LangId: WORD): WORD;
+function SUBLANGID(LangId: WORD): WORD;
+
+//
+// A locale ID is a 32 bit value which is the combination of a
+// language ID, a sort ID, and a reserved area. The bits are
+// allocated as follows:
+//
+// +-------------+---------+-------------------------+
+// | Reserved | Sort ID | Language ID |
+// +-------------+---------+-------------------------+
+// 31 20 19 16 15 0 bit
+//
+//
+// Locale ID creation/extraction macros:
+//
+// MAKELCID - construct the locale id from a language id and a sort id.
+// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version.
+// LANGIDFROMLCID - extract the language id from a locale id.
+// SORTIDFROMLCID - extract the sort id from a locale id.
+// SORTVERSIONFROMLCID - extract the sort version from a locale id.
+//
+
+const
+ NLS_VALID_LOCALE_MASK = $000fffff;
+
+function MAKELCID(LangId, SortId: WORD): DWORD;
+function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD;
+function LANGIDFROMLCID(LocaleId: LCID): WORD;
+function SORTIDFROMLCID(LocaleId: LCID): WORD;
+function SORTVERSIONFROMLCID(LocaleId: LCID): WORD;
+
+//
+// Default System and User IDs for language and locale.
+//
+
+function LANG_SYSTEM_DEFAULT: WORD;
+function LANG_USER_DEFAULT: WORD;
+function LOCALE_NEUTRAL: DWORD;
+function LOCALE_INVARIANT: DWORD;
+
+
+function Succeeded(Status : HRESULT) : BOOL;
+function Failed(Status : HRESULT) : BOOL;
+function IsError(Status : HRESULT) : BOOL;
+function HResultCode(hr : HRESULT) : Longint;
+function HResultFacility(hr : HRESULT) : Longint;
+function HResultSeverity(hr : HRESULT) : Longint;
+function MakeResult(p1,p2,mask : Longint) : HRESULT;
+function HResultFromWin32(x : Longint) : HRESULT;
+function HResultFromNT(x : Longint) : HRESULT;
+
+procedure InitializeCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'InitializeCriticalSection';
+procedure EnterCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'EnterCriticalSection';
+procedure LeaveCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'LeaveCriticalSection';
+procedure DeleteCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'DeleteCriticalSection';
+function InitializeCriticalSectionAndSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD) : BOOL; external 'kernel32' name 'InitializeCriticalSectionAndSpinCount';
+function SetCriticalSectionSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD ): DWORD; external 'kernel32' name 'SetCriticalSectionSpinCount';
+function TryEnterCriticalSection(var CriticalSection : TRTLCriticalSection) : BOOL; external 'kernel32' name 'TryEnterCriticalSection';
+
+//function _lwrite(hFile: HFILE; const lpBuffer: LPCSTR; uBytes: UINT): UINT; external 'kernel32' name '_lwrite';
+//function AccessCheck(pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; var PrivilegeSet: TPrivilegeSet; var PrivilegeSetLength: DWORD; var GrantedAccess: DWORD;
+// var AccessStatus: BOOL): BOOL; external 'advapi32' name 'AccessCheck';
+//function AccessCheckAndAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName, ObjectName: PChar; SecurityDescriptor: PSecurityDescriptor; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL;
+// var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
+//function AccessCheckAndAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPCSTR; SecurityDescriptor: PSecurityDescriptor; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL;
+// var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
+//function AccessCheckAndAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPWSTR; SecurityDescriptor: PSecurityDescriptor; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL;
+// var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
+//function AccessCheckByType(pSecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; ClientToken: THandle; DesiredAccess: DWORD; ObjectTypeList: PObjectTypeList; const GenericMapping: TGenericMapping; ObjectTypeListLength: DWORD;
+// var PrivilegeSet: TPrivilegeSet; var PrivilegeSetLength: DWORD; var GrantedAccess: DWORD; var AccessStatus: BOOL): BOOL;external 'advapi32' name 'AccessCheckByType';
+//function AccessCheckByTypeAndAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName, ObjectName: PChar; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE; Flags: DWORD;
+// ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL;
+// external 'advapi32' name 'AccessCheckByTypeAndAuditAlarm';
+//function AccessCheckByTypeAndAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPCSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE; Flags: DWORD;
+// ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL;
+// external 'advapi32' name 'AccessCheckByTypeAndAuditAlarmA';
+//function AccessCheckByTypeAndAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPWSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE; Flags: DWORD;
+// ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL;
+// external 'advapi32' name 'AccessCheckByTypeAndAuditAlarmW';
+//function AccessCheckByTypeResultList(pSecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; ClientToken: THandle; DesiredAccess: DWORD; ObjectTypeList: PObjectTypeList; const GenericMapping: TGenericMapping; ObjectTypeListLength: DWORD;
+// var PrivilegeSet: TPrivilegeSet; var PrivilegeSetLength: DWORD; var GrantedAccess: DWORD; var AccessStatusList: DWORD): BOOL;external 'advapi32' name 'AccessCheckByTypeResultList';
+//function AccessCheckByTypeResultListAndAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName, ObjectName: PChar; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE;
+// Flags: DWORD; ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatusList: DWORD; var pfGenerateOnClose: BOOL): BOOL;
+// external 'advapi32' name 'AccessCheckByTypeResultListAndAuditAlarmA';
+//function AccessCheckByTypeResultListAndAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPCSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE;
+// Flags: DWORD; ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatusList: DWORD; var pfGenerateOnClose: BOOL): BOOL;
+// external 'advapi32' name 'AccessCheckByTypeResultListAndAuditAlarmA';
+//function AccessCheckByTypeResultListAndAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPWSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE;
+// Flags: DWORD; ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatusList: DWORD; var pfGenerateOnClose: BOOL): BOOL;
+// external 'advapi32' name 'AccessCheckByTypeResultListAndAuditAlarmW';
+//function AddAccessAllowedAce(var pAcl: TACL; dwAceRevision: DWORD; AccessMask: DWORD; pSid: PSID): BOOL; external 'advapi32' name 'AddAccessAllowedAce';
+//function AddAccessAllowedAceEx(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; pSid: PSID): BOOL;external 'advapi32' name 'AddAccessAllowedAceEx';
+//function AddAccessAllowedObjectAce(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; ObjectTypeGuid, InheritedObjectTypeGuid: PGuid; pSid: Pointer): BOOL;external 'advapi32' name 'AddAccessAllowedObjectAce';
+//function AddAccessDeniedAce(var pAcl: TACL; dwAceRevision: DWORD; AccessMask: DWORD; pSid: PSID): BOOL; external 'advapi32' name 'AddAccessDeniedAce';
+//function AddAccessDeniedAceEx(var pAcl: TACL; dwAceRevision: DWORD; ACEFlags: DWORD; AccessMask: DWORD; pSid: PSID): BOOL;external 'advapi32' name 'AddAccessDeniedAceEx';
+//function AddAccessDeniedObjectAce(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; ObjectTypeGuid, InheritedObjectTypeGuid: PGuid; pSid: Pointer): BOOL;external 'advapi32' name 'AddAccessDeniedObjectAce';
+//function AddAce(var pAcl: TACL; dwAceRevision, dwStartingAceIndex: DWORD; pAceList: Pointer; nAceListLength: DWORD): BOOL; external 'advapi32' name 'AddAce';
+//function AddAuditAccessAce(var pAcl: TACL; dwAceRevision: DWORD; dwAccessMask: DWORD; pSid: Pointer; bAuditSuccess, bAuditFailure: BOOL): BOOL; external 'advapi32' name 'AddAuditAccessAce';
+//function AddAuditAccessAceEx(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; dwAccessMask: DWORD; pSid: Pointer; bAuditSuccess, bAuditFailure: BOOL): BOOL;external 'advapi32' name 'AddAuditAccessAceEx';
+//function AddAuditAccessObjectAce(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; ObjectTypeGuid, InheritedObjectTypeGuid: PGuid; pSid: Pointer; bAuditSuccess, bAuditFailure: BOOL): BOOL;
+// external 'advapi32' name 'AddAuditAccessObjectAce';
+//function AdjustTokenGroups(TokenHandle: THandle; ResetToDefault: BOOL; const NewState: TTokenGroups; BufferLength: DWORD; var PreviousState: TTokenGroups; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'AdjustTokenGroups';
+function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; const NewState: TTokenPrivileges; BufferLength: DWORD;
+ var PreviousState: TTokenPrivileges; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'AdjustTokenPrivileges';
+function AdjustWindowRect(var lpRect: TRect; dwStyle: DWORD; bMenu: BOOL): BOOL; external 'user32' name 'AdjustWindowRect';
+function AdjustWindowRectEx(var lpRect: TRect; dwStyle: DWORD; bMenu: BOOL; dwExStyle: DWORD): BOOL; external 'user32' name 'AdjustWindowRectEx';
+function AllocateAndInitializeSid(const pIdentifierAuthority: TSIDIdentifierAuthority; nSubAuthorityCount: Byte; nSubAuthority0, nSubAuthority1: DWORD; nSubAuthority2, nSubAuthority3, nSubAuthority4: DWORD;
+ nSubAuthority5, nSubAuthority6, nSubAuthority7:DWORD; var pSid: Pointer): BOOL; external 'advapi32' name 'AllocateAndInitializeSid';
+function AllocateLocallyUniqueId(var Luid: TLargeInteger): BOOL; external 'advapi32' name 'AllocateLocallyUniqueId';
+//function AlphaDIBBlend(DC: HDC; p2, p3, p4, p5: Integer; const p6: Pointer; const p7: PBitmapInfo; p8: UINT; p9, p10, p11, p12: Integer; p13: TBlendFunction): BOOL;external 'gdi32' name 'AlphaDIBBlend';
+function BackupRead(hFile: THandle; lpBuffer: PByte; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; bAbort: BOOL; bProcessSecurity: BOOL; var lpContext: Pointer): BOOL; external 'kernel32' name 'BackupRead';
+function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; var lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; lpContext: Pointer): BOOL; external 'kernel32' name 'BackupSeek';
+function BackupWrite(hFile: THandle; lpBuffer: PByte; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; bAbort, bProcessSecurity: BOOL; var lpContext: Pointer): BOOL; external 'kernel32' name 'BackupWrite';
+function BeginPaint(hWnd: HWND; var lpPaint: TPaintStruct): HDC; external 'user32' name 'BeginPaint';
+function BuildCommDCB(lpDef: PChar; var lpDCB: TDCB): BOOL;external 'kernel32' name 'BuildCommDCBA';
+function BuildCommDCBA(lpDef: LPCSTR; var lpDCB: TDCB): BOOL; external 'kernel32' name 'BuildCommDCBA';
+function BuildCommDCBAndTimeouts(lpDef: PChar; var lpDCB: TDCB; var lpCommTimeouts: TCommTimeouts): BOOL;external 'kernel32' name 'BuildCommDCBAndTimeoutsA';
+function BuildCommDCBAndTimeoutsA(lpDef: LPCSTR; var lpDCB: TDCB; var lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsA';
+function BuildCommDCBAndTimeoutsW(lpDef: LPWSTR; var lpDCB: TDCB; var lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsW';
+function BuildCommDCBW(lpDef: LPWSTR; var lpDCB: TDCB): BOOL; external 'kernel32' name 'BuildCommDCBW';
+function CallMsgFilter(var lpMsg: TMsg; nCode: Integer): BOOL;external 'user32' name 'CallMsgFilterA';
+function CallMsgFilterA(var lpMsg: TMsg; nCode: Integer): BOOL; external 'user32' name 'CallMsgFilterA';
+function CallMsgFilterW(var lpMsg: TMsg; nCode: Integer): BOOL; external 'user32' name 'CallMsgFilterW';
+function CallNamedPipe(lpNamedPipeName: PChar; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; nTimeOut: DWORD): BOOL;external 'kernel32' name 'CallNamedPipeA';
+function CallNamedPipeA(lpNamedPipeName: LPCSTR; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; nTimeOut: DWORD): BOOL; external 'kernel32' name 'CallNamedPipeA';
+function CallNamedPipeW(lpNamedPipeName: LPWSTR; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; nTimeOut: DWORD): BOOL; external 'kernel32' name 'CallNamedPipeW';
+{$ifdef ver1_0}
+ function CoRegisterClassObject(const _para1:TCLSID; _para2:Pointer; _para3:DWORD; _para4:DWORD; var _para5:DWORD):HRESULT;external 'ole32.dll' name 'CoRegisterClassObject';
+{$else}
+ function CoRegisterClassObject(const _para1:TCLSID; _para2:IUnknown; _para3:DWORD; _para4:DWORD; out_para5:DWORD):HRESULT;external 'ole32.dll' name 'CoRegisterClassObject';
+{$endif}
+function ChangeDisplaySettings(var lpDevMode: TDeviceMode; dwFlags: DWORD): Longint;external 'user32' name 'ChangeDisplaySettingsA';
+function ChangeDisplaySettingsA(var lpDevMode: TDeviceModeA; dwFlags: DWORD): Longint; external 'user32' name 'ChangeDisplaySettingsA';
+{$ifdef support_smartlink}
+function ChangeDisplaySettingsEx(lpszDeviceName: PChar; var lpDevMode: TDeviceMode; wnd: HWND; dwFlags: DWORD; lParam: Pointer): Longint;external 'user32' name 'ChangeDisplaySettingsExA';
+function ChangeDisplaySettingsExA(lpszDeviceName: LPCSTR; var lpDevMode: TDeviceModeA; wnd: HWND; dwFlags: DWORD; lParam: Pointer): Longint;external 'user32' name 'ChangeDisplaySettingsExA';
+function ChangeDisplaySettingsExW(lpszDeviceName: LPWSTR; var lpDevMode: TDeviceModeW; wnd: HWND; dwFlags: DWORD; lParam: Pointer): Longint;external 'user32' name 'ChangeDisplaySettingsExW';
+{$endif support_smartlink}
+function ChangeDisplaySettingsW(var lpDevMode: TDeviceModeW; dwFlags: DWORD): Longint; external 'user32' name 'ChangeDisplaySettingsW';
+//function CheckColorsInGamut(DC: HDC; var RGBQuads, Results; Count: DWORD): BOOL; external 'gdi32' name 'CheckColorsInGamut';
+function ChoosePixelFormat(_para1:HDC; var _para2:PIXELFORMATDESCRIPTOR):longint; external 'gdi32' name 'ChoosePixelFormat';
+function ClearCommError(hFile: THandle; var lpErrors: DWORD; lpStat: PComStat): BOOL; external 'kernel32' name 'ClearCommError';
+function ClientToScreen(hWnd: HWND; var lpPoint: TPoint): BOOL; external 'user32' name 'ClientToScreen';
+function ClipCursor(var lpRect:RECT):WINBOOL; external 'user32' name 'ClipCursor';
+//function CombineTransform(var p1: TXForm; const p2, p3: TXForm): BOOL; external 'gdi32' name 'CombineTransform';
+function CommConfigDialog(lpszName: PChar; hWnd: HWND; var lpCC: TCommConfig): BOOL;external 'kernel32' name 'CommConfigDialogA';
+function CommConfigDialogA(lpszName: LPCSTR; hWnd: HWND; var lpCC: TCommConfig): BOOL; external 'kernel32' name 'CommConfigDialogA';
+function CommConfigDialogW(lpszName: LPWSTR; hWnd: HWND; var lpCC: TCommConfig): BOOL; external 'kernel32' name 'CommConfigDialogW';
+//function CompareFileTime(const lpFileTime1, lpFileTime2: TFileTime): Longint; external 'kernel32' name 'CompareFileTime';
+//function ConvertToAutoInheritPrivateObjectSecurity(ParentDescriptor, CurrentSecurityDescriptor: PSecurityDescriptor; var NewDescriptor: PSecurityDescriptor; ObjectType: PGUID; IsDirectoryObject: BOOL; const GenericMapping: TGenericMapping): BOOL;
+// external 'advapi32' name 'ConvertToAutoInheritPrivateObjectSecurity';
+function CopyAcceleratorTable(hAccelSrc: HACCEL; var lpAccelDst; cAccelEntries: Integer): Integer;external 'user32' name 'CopyAcceleratorTableA';
+function CopyAcceleratorTableA(hAccelSrc: HACCEL; var lpAccelDst; cAccelEntries: Integer): Integer; external 'user32' name 'CopyAcceleratorTableA';
+function CopyAcceleratorTableW(hAccelSrc: HACCEL; var lpAccelDst; cAccelEntries: Integer): Integer; external 'user32' name 'CopyAcceleratorTableW';
+function CopyRect(var lprcDst: TRect; const lprcSrc: TRect): BOOL; external 'user32' name 'CopyRect';
+function CreateAcceleratorTable(var Accel; Count: Integer): HACCEL;external 'user32' name 'CreateAcceleratorTableA';
+function CreateAcceleratorTableA(var Accel; Count: Integer): HACCEL; external 'user32' name 'CreateAcceleratorTableA';
+function CreateAcceleratorTableW(var Accel; Count: Integer): HACCEL; external 'user32' name 'CreateAcceleratorTableW';
+//function CreateBitmapIndirect(const p1: TBitmap): HBITMAP; external 'gdi32' name 'CreateBitmapIndirect';
+//function CreateBrushIndirect(const p1: TLogBrush): HBRUSH; external 'gdi32' name 'CreateBrushIndirect';
+function CreateColorSpace(var ColorSpace: TLogColorSpace): HCOLORSPACE;external 'gdi32' name 'CreateColorSpaceA';
+function CreateColorSpaceA(var ColorSpace: TLogColorSpaceA): HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceA';
+//function CreateColorSpaceW(var ColorSpace: TLogColorSpaceW): HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceW';
+function CreateDialogIndirectParam(hInstance: HINST; const lpTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): HWND;external 'user32' name 'CreateDialogIndirectParamA';
+//function CreateDialogIndirectParamA(hInstance: HINST; const lpTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): HWND; external 'user32' name 'CreateDialogIndirectParamA';
+//function CreateDialogIndirectParamW(hInstance: HINST; const lpTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): HWND; external 'user32' name 'CreateDialogIndirectParamW';
+//function CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader; dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: UINT): HBITMAP; external 'gdi32' name 'CreateDIBitmap';
+//function CreateDIBPatternBrushPt(const p1: Pointer; p2: UINT): HBRUSH; external 'gdi32' name 'CreateDIBPatternBrushPt';
+//function CreateDIBSection(DC: HDC; const p2: TBitmapInfo; p3: UINT; var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; external 'gdi32' name 'CreateDIBSection';
+//function CreateEllipticRgnIndirect(const p1: TRect): HRGN; external 'gdi32' name 'CreateEllipticRgnIndirect';
+//function CreateFontIndirect(const p1: TLogFont): HFONT;external 'gdi32' name 'CreateFontIndirectA';
+//function CreateFontIndirectA(const p1: TLogFontA): HFONT; external 'gdi32' name 'CreateFontIndirectA';
+//function CreateFontIndirectEx(const p1: PEnumLogFontExDV): HFONT;external 'gdi32' name 'CreateFontIndirectExA';
+//function CreateFontIndirectExA(const p1: PEnumLogFontExDVA): HFONT;external 'gdi32' name 'CreateFontIndirectExA';
+//function CreateFontIndirectExW(const p1: PEnumLogFontExDVW): HFONT;external 'gdi32' name 'CreateFontIndirectExW';
+//function CreateFontIndirectW(const p1: TLogFontW): HFONT; external 'gdi32' name 'CreateFontIndirectW';
+function CreateIconIndirect(var piconinfo: TIconInfo): HICON; external 'user32' name 'CreateIconIndirect';
+//function CreatePalette(const LogPalette: TLogPalette): HPalette; external 'gdi32' name 'CreatePalette';
+//function CreatePenIndirect(const LogPen: TLogPen): HPEN; external 'gdi32' name 'CreatePenIndirect';
+function CreatePipe(var hReadPipe, hWritePipe: THandle; lpPipeAttributes: PSecurityAttributes; nSize: DWORD): BOOL; external 'kernel32' name 'CreatePipe';
+function CreatePolygonRgn(const Points; Count, FillMode: Integer): HRGN; external 'gdi32' name 'CreatePolygonRgn';
+function CreatePolyPolygonRgn(const pPtStructs; const pIntArray; p3, p4: Integer): HRGN; external 'gdi32' name 'CreatePolyPolygonRgn';
+//function CreatePrivateObjectSecurity(ParentDescriptor, CreatorDescriptor: PSecurityDescriptor; var NewDescriptor: PSecurityDescriptor; IsDirectoryObject: BOOL; Token: THandle; const GenericMapping: TGenericMapping): BOOL;
+// external 'advapi32' name 'CreatePrivateObjectSecurity';
+//function CreatePrivateObjectSecurityEx(ParentDescriptor, CreatorDescriptor: PSecurityDescriptor; var NewDescriptor: PSecurityDescriptor; ObjectType: PGUID; IsContainerObject: BOOL; AutoInheritFlags: ULONG; Token: THandle;
+// const GenericMapping: TGenericMapping): BOOL;external 'advapi32' name 'CreatePrivateObjectSecurityEx';
+function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: PChar;
+ const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL;external 'kernel32' name 'CreateProcessA';
+function CreateProcessA(lpApplicationName: LPCSTR; lpCommandLine: LPCSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCSTR;
+ const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'kernel32' name 'CreateProcessA';
+//function CreateProcessAsUser(hToken: THandle; lpApplicationName: PChar; lpCommandLine: PChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD;
+// lpEnvironment: Pointer; lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL;external 'advapi32' name 'CreateProcessAsUserA';
+//function CreateProcessAsUserA(hToken: THandle; lpApplicationName: LPCSTR; lpCommandLine: LPCSTR; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD;
+// lpEnvironment: Pointer; lpCurrentDirectory: LPCSTR; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'advapi32' name 'CreateProcessAsUserA';
+//function CreateProcessAsUserW(hToken: THandle; lpApplicationName: LPWSTR; lpCommandLine: LPWSTR; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD;
+// lpEnvironment: Pointer; lpCurrentDirectory: LPWSTR; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'advapi32' name 'CreateProcessAsUserW';
+function CreateProcessW(lpApplicationName: LPWSTR; lpCommandLine: LPWSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPWSTR;
+ const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'kernel32' name 'CreateProcessW';
+//function CreateRectRgnIndirect(const p1: TRect): HRGN; external 'gdi32' name 'CreateRectRgnIndirect';
+function CreateRemoteThread(hProcess: THandle; lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle;
+ external 'kernel32' name 'CreateRemoteThread';
+function CreateThread(lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; external 'kernel32' name 'CreateThread';
+function DdeSetQualityOfService(hWndClient: HWnd; const pqosNew: TSecurityQualityOfService; pqosPrev: PSecurityQualityOfService): BOOL;external 'user32' name 'DdeSetQualityOfService';
+//function DeleteAce(var pAcl: TACL; dwAceIndex: DWORD): BOOL; external 'advapi32' name 'DeleteAce';
+function DescribePixelFormat(DC: HDC; p2: Integer; p3: UINT; var p4: TPixelFormatDescriptor): BOOL; external 'gdi32' name 'DescribePixelFormat';
+//function DestroyPrivateObjectSecurity(var ObjectDescriptor: PSecurityDescriptor): BOOL; external 'advapi32' name 'DestroyPrivateObjectSecurity';
+function DeviceIoControl(hDevice: THandle; dwIoControlCode: DWORD; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesReturned: DWORD; lpOverlapped: POverlapped): BOOL;
+ external 'kernel32' name 'DeviceIoControl';
+function DialogBoxIndirectParam(hInstance: HINST; const lpDialogTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): Integer;external 'user32' name 'DialogBoxIndirectParamA';
+function DialogBoxIndirectParamA(hInstance: HINST; const lpDialogTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): Integer; external 'user32' name 'DialogBoxIndirectParamA';
+function DialogBoxIndirectParamW(hInstance: HINST; const lpDialogTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): Integer; external 'user32' name 'DialogBoxIndirectParamW';
+function DispatchMessage(const lpMsg: TMsg): Longint;external 'user32' name 'DispatchMessageA';
+function DispatchMessageA(const lpMsg: TMsg): Longint; external 'user32' name 'DispatchMessageA';
+function DispatchMessageW(const lpMsg: TMsg): Longint; external 'user32' name 'DispatchMessageW';
+function DosDateTimeToFileTime(wFatDate, wFatTime: Word; var lpFileTime: TFileTime): BOOL; external 'kernel32' name 'DosDateTimeToFileTime';
+function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'DPtoLP';
+// function DrawAnimatedRects(hwnd: HWND; idAni: Integer; const lprcFrom, lprcTo: TRect): BOOL; external 'user32' name 'DrawAnimatedRects';
+//function DrawCaption(p1: HWND; p2: HDC; const p3: TRect; p4: UINT): BOOL; external 'user32' name 'DrawCaption';
+function DrawEdge(hdc: HDC; var qrc: TRect; edge: UINT; grfFlags: UINT): BOOL; external 'user32' name 'DrawEdge';
+//function DrawFocusRect(hDC: HDC; const lprc: TRect): BOOL; external 'user32' name 'DrawFocusRect';
+function DrawFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL; external 'user32' name 'DrawFrameControl';
+function DrawText(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer;external 'user32' name 'DrawTextA';
+function DrawTextA(hDC: HDC; lpString: LPCSTR; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; external 'user32' name 'DrawTextA';
+function DrawTextEx(DC: HDC; lpchText: PChar; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer;external 'user32' name 'DrawTextExA';
+function DrawTextExA(DC: HDC; lpchText: LPCSTR; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; external 'user32' name 'DrawTextExA';
+function DrawTextExW(DC: HDC; lpchText: LPWSTR; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; external 'user32' name 'DrawTextExW';
+function DrawTextW(hDC: HDC; lpString: LPWSTR; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; external 'user32' name 'DrawTextW';
+//function DuplicateTokenEx(hExistingToken: THandle; dwDesiredAccess: DWORD; lpTokenAttributes: PSecurityAttributes; ImpersonationLevel: TSecurityImpersonationLevel; TokenType: TTokenType; var phNewToken: THandle): BOOL;
+// external 'advapi32' name 'DuplicateTokenEx';
+function EndPaint(hWnd: HWND; const lpPaint: TPaintStruct): BOOL; external 'user32' name 'EndPaint';
+//function EnumDisplayDevices(Unused: Pointer; iDevNum: DWORD; var lpDisplayDevice: TDisplayDevice; dwFlags: DWORD): BOOL;external 'user32' name 'EnumDisplayDevicesA';
+//function EnumDisplayDevicesA(Unused: Pointer; iDevNum: DWORD; var lpDisplayDevice: TDisplayDeviceA; dwFlags: DWORD): BOOL;external 'user32' name 'EnumDisplayDevicesA';
+//function EnumDisplayDevicesW(Unused: Pointer; iDevNum: DWORD; var lpDisplayDevice: TDisplayDeviceW; dwFlags: DWORD): BOOL;external 'user32' name 'EnumDisplayDevicesW';
+function EnumDisplaySettings(lpszDeviceName: PChar; iModeNum: DWORD; var lpDevMode: TDeviceMode): BOOL;external 'user32' name 'EnumDisplaySettingsA';
+function EnumDisplaySettingsA(lpszDeviceName: LPCSTR; iModeNum: DWORD; var lpDevMode: TDeviceModeA): BOOL; external 'user32' name 'EnumDisplaySettingsA';
+function EnumDisplaySettingsW(lpszDeviceName: LPWSTR; iModeNum: DWORD; var lpDevMode: TDeviceModeW): BOOL; external 'user32' name 'EnumDisplaySettingsW';
+//function EnumEnhMetaFile(DC: HDC; p2: HENHMETAFILE; p3: TFNEnhMFEnumProc; p4: Pointer; const p5: TRect): BOOL; external 'gdi32' name 'EnumEnhMetaFile';
+//function EnumFontFamiliesEx(DC: HDC; var p2: TLogFont; p3: TFNFontEnumProc; p4: LPARAM; p5: DWORD): BOOL;external 'gdi32' name 'EnumFontFamiliesExA';
+//function EnumFontFamiliesExA(DC: HDC; var p2: TLogFontA; p3: TFNFontEnumProcA; p4: LPARAM; p5: DWORD): BOOL; external 'gdi32' name 'EnumFontFamiliesExA';
+//function EnumFontFamiliesExW(DC: HDC; var p2: TLogFontW; p3: TFNFontEnumProcW; p4: LPARAM; p5: DWORD): BOOL; external 'gdi32' name 'EnumFontFamiliesExW';
+//function EqualRect(const lprc1, lprc2: TRect): BOOL; external 'user32' name 'EqualRect';
+function ExtCreatePen(PenStyle, Width: DWORD; const Brush: TLogBrush; StyleCount: DWORD; Style: Pointer): HPEN; external 'gdi32' name 'ExtCreatePen';
+function ExtCreateRegion(p1: PXForm; p2: DWORD; const p3: TRgnData): HRGN; external 'gdi32' name 'ExtCreateRegion';
+// function ExtEscape(DC: HDC; p2, p3: Integer; const p4: LPCSTR; p5: Integer; p6: LPSTR): Integer; external 'gdi32' name 'ExtEscape';
+function FileTimeToDosDateTime(const lpFileTime: TFileTime; var lpFatDate, lpFatTime: Word): BOOL; external 'kernel32' name 'FileTimeToDosDateTime';
+function FileTimeToLocalFileTime(const lpFileTime: TFileTime; var lpLocalFileTime: TFileTime): BOOL; external 'kernel32' name 'FileTimeToLocalFileTime';
+function FileTimeToSystemTime(const lpFileTime: TFileTime; var lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'FileTimeToSystemTime';
+function FillConsoleOutputAttribute(hConsoleOutput: THandle; wAttribute: Word; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfAttrsWritten: DWORD): BOOL; external 'kernel32' name 'FillConsoleOutputAttribute';
+function FillConsoleOutputCharacter(hConsoleOutput: THandle; cCharacter: Char; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL;external 'kernel32' name 'FillConsoleOutputCharacterA';
+function FillConsoleOutputCharacterA(hConsoleOutput: THandle; cCharacter: AnsiChar; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'FillConsoleOutputCharacterA';
+function FillConsoleOutputCharacterW(hConsoleOutput: THandle; cCharacter: WideChar; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'FillConsoleOutputCharacterW';
+//function FillRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; external 'user32' name 'FillRect';
+function FindFirstFile(lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;external 'kernel32' name 'FindFirstFileA';
+function FindFirstFileA(lpFileName: LPCSTR; var lpFindFileData: TWIN32FindDataA): THandle; external 'kernel32' name 'FindFirstFileA';
+//function FindFirstFileW(lpFileName: LPWSTR; var lpFindFileData: TWIN32FindDataW): THandle; external 'kernel32' name 'FindFirstFileW';
+//function FindFirstFreeAce(var pAcl: TACL; var pAce: Pointer): BOOL; external 'advapi32' name 'FindFirstFreeAce';
+function FindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL;external 'kernel32' name 'FindNextFileA';
+function FindNextFileA(hFindFile: THandle; var lpFindFileData: TWIN32FindDataA): BOOL; external 'kernel32' name 'FindNextFileA';
+//function FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL; external 'kernel32' name 'FindNextFileW';
+//function FlushInstructionCache(hProcess: THandle; const lpBaseAddress: Pointer; dwSize: DWORD): BOOL; external 'kernel32' name 'FlushInstructionCache';
+//function FlushViewOfFile(const lpBaseAddress: Pointer; dwNumberOfBytesToFlush: DWORD): BOOL; external 'kernel32' name 'FlushViewOfFile';
+//function FrameRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; external 'user32' name 'FrameRect';
+//function GetAce(const pAcl: TACL; dwAceIndex: DWORD; var pAce: Pointer): BOOL; external 'advapi32' name 'GetAce';
+//function GetAclInformation(const pAcl: TACL; pAclInformation: Pointer; nAclInformationLength: DWORD; dwAclInformationClass: TAclInformationClass): BOOL; external 'advapi32' name 'GetAclInformation';
+//function GetAltTabInfo(hwnd: HWND; iItem: Integer; var pati: TAltTabInfo; pszItemText: PChar; cchItemText: UINT): BOOL;external 'user32' name 'GetAltTabInfoA';
+//function GetAltTabInfoA(hwnd: HWND; iItem: Integer; var pati: TAltTabInfo; pszItemText: LPCSTR; cchItemText: UINT): BOOL;external 'user32' name 'GetAltTabInfoA';
+//function GetAltTabInfoW(hwnd: HWND; iItem: Integer; var pati: TAltTabInfo; pszItemText: LPWSTR; cchItemText: UINT): BOOL;external 'user32' name 'GetAltTabInfoW';
+function GetAspectRatioFilterEx(DC: HDC; var p2: TSize): BOOL; external 'gdi32' name 'GetAspectRatioFilterEx';
+function GetBinaryType(lpApplicationName: PChar; var lpBinaryType: DWORD): BOOL;external 'kernel32' name 'GetBinaryTypeA';
+function GetBinaryTypeA(lpApplicationName: LPCSTR; var lpBinaryType: DWORD): BOOL; external 'kernel32' name 'GetBinaryTypeA';
+function GetBinaryTypeW(lpApplicationName: LPWSTR; var lpBinaryType: DWORD): BOOL; external 'kernel32' name 'GetBinaryTypeW';
+function GetBitmapDimensionEx(p1: HBITMAP; var p2: TSize): BOOL; external 'gdi32' name 'GetBitmapDimensionEx';
+function GetBoundsRect(DC: HDC; var p2: TRect; p3: UINT): UINT; external 'gdi32' name 'GetBoundsRect';
+function GetBrushOrgEx(DC: HDC; var p2: TPoint): BOOL; external 'gdi32' name 'GetBrushOrgEx';
+function GetCaretPos(var lpPoint: TPoint): BOOL; external 'user32' name 'GetCaretPos';
+function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): BOOL;external 'gdi32' name 'GetCharABCWidthsA';
+function GetCharABCWidthsA(DC: HDC; p2, p3: UINT; const ABCStructs): BOOL; external 'gdi32' name 'GetCharABCWidthsA';
+function GetCharABCWidthsFloat(DC: HDC; p2, p3: UINT; const ABCFloatSturcts): BOOL;external 'gdi32' name 'GetCharABCWidthsFloatA';
+function GetCharABCWidthsFloatA(DC: HDC; p2, p3: UINT; const ABCFloatSturcts): BOOL; external 'gdi32' name 'GetCharABCWidthsFloatA';
+function GetCharABCWidthsFloatW(DC: HDC; p2, p3: UINT; const ABCFloatSturcts): BOOL; external 'gdi32' name 'GetCharABCWidthsFloatW';
+//function GetCharABCWidthsI(DC: HDC; p2, p3: UINT; p4: PWORD; const Widths): BOOL;external 'gdi32' name 'GetCharABCWidthsI';
+function GetCharABCWidthsW(DC: HDC; p2, p3: UINT; const ABCStructs): BOOL; external 'gdi32' name 'GetCharABCWidthsW';
+function GetCharacterPlacement(DC: HDC; p2: PChar; p3, p4: BOOL; var p5: TGCPResults; p6: DWORD): DWORD;external 'gdi32' name 'GetCharacterPlacementA';
+function GetCharacterPlacementA(DC: HDC; p2: LPCSTR; p3, p4: BOOL; var p5: TGCPResults; p6: DWORD): DWORD; external 'gdi32' name 'GetCharacterPlacementA';
+function GetCharacterPlacementW(DC: HDC; p2: LPWSTR; p3, p4: BOOL; var p5: TGCPResults; p6: DWORD): DWORD; external 'gdi32' name 'GetCharacterPlacementW';
+function GetCharWidth(DC: HDC; p2, p3: UINT; const Widths): BOOL;external 'gdi32' name 'GetCharWidthA';
+function GetCharWidth32(DC: HDC; p2, p3: UINT; const Widths): BOOL;external 'gdi32' name 'GetCharWidth32A';
+function GetCharWidth32A(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidth32A';
+function GetCharWidth32W(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidth32W';
+function GetCharWidthA(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthA';
+function GetCharWidthFloat(DC: HDC; p2, p3: UINT; const Widths): BOOL;external 'gdi32' name 'GetCharWidthFloatA';
+function GetCharWidthFloatA(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthFloatA';
+function GetCharWidthFloatW(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthFloatW';
+//function GetCharWidthI(DC: HDC; p2, p3: UINT; p4: PWORD; const Widths): BOOL;external 'gdi32' name 'GetCharWidthI';
+function GetCharWidthW(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthW';
+function GetClassInfo(hInstance: HINST; lpClassName: PChar; var lpWndClass: TWndClass): BOOL;external 'user32' name 'GetClassInfoA';
+function GetClassInfoA(hInstance: HINST; lpClassName: LPCSTR; var lpWndClass: TWndClassA): BOOL; external 'user32' name 'GetClassInfoA';
+function GetClassInfoEx(Instance: HINST; Classname: PChar; var WndClass: TWndClassEx): BOOL;external 'user32' name 'GetClassInfoExA';
+//function GetClassInfoExA(Instance: HINST; Classname: LPCSTR; var WndClass: TWndClassExA): BOOL; external 'user32' name 'GetClassInfoExA';
+//function GetClassInfoExW(Instance: HINST; Classname: LPWSTR; var WndClass: TWndClassExW): BOOL; external 'user32' name 'GetClassInfoExW';
+//function GetClassInfoW(hInstance: HINST; lpClassName: LPWSTR; var lpWndClass: TWndClassW): BOOL; external 'user32' name 'GetClassInfoW';
+function GetClientRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'user32' name 'GetClientRect';
+function GetClipBox(DC: HDC; var Rect: TRect): Integer; external 'gdi32' name 'GetClipBox';
+function GetClipCursor(var lpRect: TRect): BOOL; external 'user32' name 'GetClipCursor';
+function GetColorAdjustment(DC: HDC; var p2: TColorAdjustment): BOOL; external 'gdi32' name 'GetColorAdjustment';
+function GetCommConfig(hCommDev: THandle; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL; external 'kernel32' name 'GetCommConfig';
+function GetCommMask(hFile: THandle; var lpEvtMask: DWORD): BOOL; external 'kernel32' name 'GetCommMask';
+function GetCommModemStatus(hFile: THandle; var lpModemStat: DWORD): BOOL; external 'kernel32' name 'GetCommModemStatus';
+function GetCommProperties(hFile: THandle; var lpCommProp: TCommProp): BOOL; external 'kernel32' name 'GetCommProperties';
+function GetCommState(hFile: THandle; var lpDCB: TDCB): BOOL; external 'kernel32' name 'GetCommState';
+function GetCommTimeouts(hFile: THandle; var lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'GetCommTimeouts';
+function GetComputerName(lpBuffer: PChar; var nSize: DWORD): BOOL;external 'kernel32' name 'GetComputerNameA';
+function GetComputerNameA(lpBuffer: LPCSTR; var nSize: DWORD): BOOL; external 'kernel32' name 'GetComputerNameA';
+function GetComputerNameW(lpBuffer: LPWSTR; var nSize: DWORD): BOOL; external 'kernel32' name 'GetComputerNameW';
+function GetConsoleCursorInfo(hConsoleOutput: THandle; var lpConsoleCursorInfo: TConsoleCursorInfo): BOOL; external 'kernel32' name 'GetConsoleCursorInfo';
+function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): BOOL; external 'kernel32' name 'GetConsoleMode';
+function GetConsoleScreenBufferInfo(hConsoleOutput: THandle; var lpConsoleScreenBufferInfo: TConsoleScreenBufferInfo): BOOL; external 'kernel32' name 'GetConsoleScreenBufferInfo';
+function GetCPInfo(CodePage: UINT; var lpCPInfo: TCPInfo): BOOL;external 'kernel32' name 'GetCPInfo';
+//function GetCurrentHwProfile(var lpHwProfileInfo: THWProfileInfo): BOOL;external 'advapi32' name 'GetCurrentHwProfileA';
+//function GetCurrentHwProfileA(var lpHwProfileInfo: THWProfileInfoA): BOOL;external 'advapi32' name 'GetCurrentHwProfileA';
+//function GetCurrentHwProfileW(var lpHwProfileInfo: THWProfileInfoW): BOOL;external 'advapi32' name 'GetCurrentHwProfileW';
+{$ifdef support_smartlink}
+function GetCursorInfo(var pci: TCursorInfo): BOOL;external 'user32' name 'GetCursorInfo';
+{$endif support_smartlink}
+function GetCursorPos(var lpPoint: TPoint): BOOL; external 'user32' name 'GetCursorPos';
+function GetDCOrgEx(DC: HDC; var Origin: TPoint): BOOL; external 'gdi32' name 'GetDCOrgEx';
+function GetDefaultCommConfig(lpszName: PChar; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL;external 'kernel32' name 'GetDefaultCommConfigA';
+function GetDefaultCommConfigA(lpszName: LPCSTR; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL; external 'kernel32' name 'GetDefaultCommConfigA';
+function GetDefaultCommConfigW(lpszName: LPWSTR; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL; external 'kernel32' name 'GetDefaultCommConfigW';
+function GetDeviceGammaRamp(DC: HDC; var Ramp): BOOL; external 'gdi32' name 'GetDeviceGammaRamp';
+function GetDIBColorTable(DC: HDC; p2, p3: UINT; var RGBQuadStructs): UINT; external 'gdi32' name 'GetDIBColorTable';
+function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'GetDIBits';
+function GetDiskFreeSpace(lpRootPathName: PChar; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;external 'kernel32' name 'GetDiskFreeSpaceA';
+function GetDiskFreeSpaceA(lpRootPathName: LPCSTR; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL; external 'kernel32' name 'GetDiskFreeSpaceA';
+function GetDiskFreeSpaceEx(lpDirectoryName: PChar; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
+function GetDiskFreeSpaceExA(lpDirectoryName: LPCSTR; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
+function GetDiskFreeSpaceExW(lpDirectoryName: LPWSTR; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExW';
+function GetDiskFreeSpaceW(lpRootPathName: LPWSTR; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL; external 'kernel32' name 'GetDiskFreeSpaceW';
+function GetDiskFreeSpaceEx(lpDirectoryName: PChar; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes:pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
+function GetDiskFreeSpaceExA(lpDirectoryName: LPCSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
+function GetDiskFreeSpaceExW(lpDirectoryName: LPWSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExW';
+//function GetEnhMetaFilePixelFormat(p1: HENHMETAFILE; p2: Cardinal; var p3: TPixelFormatDescriptor): UINT;external 'gdi32' name 'GetEnhMetaFilePixelFormat';
+function GetExitCodeProcess(hProcess: THandle; var lpExitCode: DWORD): BOOL; external 'kernel32' name 'GetExitCodeProcess';
+function GetExitCodeThread(hThread: THandle; var lpExitCode: DWORD): BOOL; external 'kernel32' name 'GetExitCodeThread';
+function GetFileInformationByHandle(hFile: THandle; var lpFileInformation: TByHandleFileInformation): BOOL; external 'kernel32' name 'GetFileInformationByHandle';
+//function GetFileSecurity(lpFileName: PChar; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL;external 'advapi32' name 'GetFileSecurityA';
+//function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetFileSecurityA';
+//function GetFileSecurityW(lpFileName: LPWSTR; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetFileSecurityW';
+function GetFileVersionInfoSize(lptstrFilename: PChar; var lpdwHandle: DWORD): DWORD;external 'version' name 'GetFileVersionInfoSizeA';
+function GetFileVersionInfoSizeA(lptstrFilename: LPCSTR; var lpdwHandle: DWORD): DWORD; external 'version' name 'GetFileVersionInfoSizeA';
+function GetFileVersionInfoSizeW(lptstrFilename: LPWSTR; var lpdwHandle: DWORD): DWORD; external 'version' name 'GetFileVersionInfoSizeW';
+// removed because old definition was wrong !
+// function GetFullPathName(lpFileName: PChar; nBufferLength: DWORD; lpBuffer: PChar; var lpFilePart: PChar): DWORD;external 'kernel32' name 'GetFullPathNameA';
+// function GetFullPathNameA(lpFileName: LPCSTR; nBufferLength: DWORD; lpBuffer: LPCSTR; var lpFilePart: LPCSTR): DWORD; external 'kernel32' name 'GetFullPathNameA';
+// function GetFullPathNameW(lpFileName: LPWSTR; nBufferLength: DWORD; lpBuffer: LPWSTR; var lpFilePart: LPWSTR): DWORD; external 'kernel32' name 'GetFullPathNameW';
+function GetGlyphOutline(DC: HDC; p2, p3: UINT; const p4: TGlyphMetrics; p5: DWORD; p6: Pointer; const p7: TMat2): DWORD;external 'gdi32' name 'GetGlyphOutlineA';
+function GetGlyphOutlineA(DC: HDC; p2, p3: UINT; const p4: TGlyphMetrics; p5: DWORD; p6: Pointer; const p7: TMat2): DWORD; external 'gdi32' name 'GetGlyphOutlineA';
+function GetGlyphOutlineW(DC: HDC; p2, p3: UINT; const p4: TGlyphMetrics; p5: DWORD; p6: Pointer; const p7: TMat2): DWORD; external 'gdi32' name 'GetGlyphOutlineW';
+//function GetGUIThreadInfo(idThread: DWORD; var pgui: TGUIThreadinfo): BOOL;external 'user32' name 'GetGUIThreadInfo';
+function GetHandleInformation(hObject: THandle; var lpdwFlags: DWORD): BOOL; external 'kernel32' name 'GetHandleInformation';
+//function GetICMProfile(DC: HDC; var Size: DWORD; Name: PChar): BOOL;external 'gdi32' name 'GetICMProfileA';
+//function GetICMProfileA(DC: HDC; var Size: DWORD; Name: LPCSTR): BOOL; external 'gdi32' name 'GetICMProfileA';
+//function GetICMProfileW(DC: HDC; var Size: DWORD; Name: LPWSTR): BOOL; external 'gdi32' name 'GetICMProfileW';
+function GetIconInfo(hIcon: HICON; var piconinfo: TIconInfo): BOOL; external 'user32' name 'GetIconInfo';
+//function GetKernelObjectSecurity(Handle: THandle; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetKernelObjectSecurity';
+function GetKerningPairs(DC: HDC; Count: DWORD; var KerningPairs): DWORD;external 'gdi32' name 'GetKerningPairs';
+function GetKeyboardLayoutList(nBuff: Integer; var List): UINT; external 'user32' name 'GetKeyboardLayoutList';
+//function GetKeyboardState(var KeyState: TKeyboardState): BOOL; external 'user32' name 'GetKeyboardState';
+//function GetLastInputInfo(var plii: TLastInputInfo): BOOL;external 'user32' name 'GetLastInputInfo';
+procedure GetSystemTime(var lpSystemTime:SYSTEMTIME); external 'kernel32' name 'GetSystemTime';
+procedure GetLocalTime(var SystemTime: SYSTEMTIME); external 'kernel32' name 'GetLocalTime';
+procedure GetSystemInfo(var SystemInfo:SYSTEM_INFO); external 'kernel32' name 'GetSystemInfo';
+function SetSystemTime(var lpSystemTime:SYSTEMTIME):WINBOOL; external 'kernel32' name 'SetSystemTime';
+function SetLocalTime(var lpSystemTime:SYSTEMTIME):WINBOOL; external 'kernel32' name 'SetLocalTime';
+function GetLogColorSpace(p1: HCOLORSPACE; var ColorSpace: TLogColorSpace; Size: DWORD): BOOL;external 'gdi32' name 'GetLogColorSpaceA';
+function GetLogColorSpaceA(p1: HCOLORSPACE; var ColorSpace: TLogColorSpaceA; Size: DWORD): BOOL; external 'gdi32' name 'GetLogColorSpaceA';
+//function GetLogColorSpaceW(p1: HCOLORSPACE; var ColorSpace: TLogColorSpaceW; Size: DWORD): BOOL; external 'gdi32' name 'GetLogColorSpaceW';
+function GetMailslotInfo(hMailslot: THandle; lpMaxMessageSize: Pointer; var lpNextSize: DWORD; lpMessageCount, lpReadTimeout: Pointer): BOOL; external 'kernel32' name 'GetMailslotInfo';
+//function GetMenuBarInfo(hend: HWND; idObject, idItem: Longint; var pmbi: TMenuBarInfo): BOOL;external 'user32' name 'GetMenuBarInfo';
+//function GetMenuInfo(hMenu: HMENU; var lpmi: TMenuInfo): BOOL;external 'user32' name 'GetMenuInfo';
+function GetMenuItemInfo(p1: HMENU; p2: UINT; p3: BOOL; var p4: TMenuItemInfo): BOOL;external 'user32' name 'GetMenuItemInfoA';
+function GetMenuItemInfoA(p1: HMENU; p2: UINT; p3: BOOL; var p4: TMenuItemInfoA): BOOL; external 'user32' name 'GetMenuItemInfoA';
+//function GetMenuItemInfoW(p1: HMENU; p2: UINT; p3: BOOL; var p4: TMenuItemInfoW): BOOL; external 'user32' name 'GetMenuItemInfoW';
+function GetMenuItemRect(hWnd: HWND; hMenu: HMENU; uItem: UINT; var lprcItem: TRect): BOOL; external 'user32' name 'GetMenuItemRect';
+function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL;external 'user32' name 'GetMessageA';
+function GetMessageA(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; external 'user32' name 'GetMessageA';
+function GetMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; external 'user32' name 'GetMessageW';
+function GetMiterLimit(DC: HDC; var Limit: Single): BOOL; external 'gdi32' name 'GetMiterLimit';
+//function GetMouseMovePoints(cbSize: UINT; var lppt, lpptBuf: TMouseMovePoint; nBufPoints: Integer; resolution: DWORD): Integer;external 'user32' name 'GetMouseMovePoints';
+function GetNamedPipeInfo(hNamedPipe: THandle; var lpFlags: DWORD; lpOutBufferSize, lpInBufferSize, lpMaxInstances: Pointer): BOOL; external 'kernel32' name 'GetNamedPipeInfo';
+function GetNumberOfConsoleInputEvents(hConsoleInput: THandle; var lpNumberOfEvents: DWORD): BOOL; external 'kernel32' name 'GetNumberOfConsoleInputEvents';
+function GetNumberOfConsoleMouseButtons(var lpNumberOfMouseButtons: DWORD): BOOL; external 'kernel32' name 'GetNumberOfConsoleMouseButtons';
+//function GetNumberOfEventLogRecords(hEventLog: THandle; var NumberOfRecords: DWORD): BOOL; external 'advapi32' name 'GetNumberOfEventLogRecords';
+//function GetOldestEventLogRecord(hEventLog: THandle; var OldestRecord: DWORD): BOOL; external 'advapi32' name 'GetOldestEventLogRecord';
+function GetOverlappedResult(hFile: THandle; const lpOverlapped: TOverlapped; var lpNumberOfBytesTransferred: DWORD; bWait: BOOL): BOOL; external 'kernel32' name 'GetOverlappedResult';
+function GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; external 'gdi32' name 'GetPaletteEntries';
+function GetPath(DC: HDC; var Points, Types; nSize: Integer): Integer; external 'gdi32' name 'GetPath';
+function GetPriorityClipboardFormat(var paFormatPriorityList; cFormats: Integer): Integer; external 'user32' name 'GetPriorityClipboardFormat';
+//function GetPrivateObjectSecurity(ObjectDescriptor: PSecurityDescriptor; SecurityInformation: SECURITY_INFORMATION; ResultantDescriptor: PSecurityDescriptor; DescriptorLength: DWORD; var ReturnLength: DWORD): BOOL;
+// external 'advapi32' name 'GetPrivateObjectSecurity';
+function GetProcessAffinityMask(hProcess: THandle; var lpProcessAffinityMask, lpSystemAffinityMask: DWORD): BOOL; external 'kernel32' name 'GetProcessAffinityMask';
+function GetProcessHeaps(NumberOfHeaps: DWORD; var ProcessHeaps: THandle): DWORD;external 'kernel32' name 'GetProcessHeaps';
+{$ifdef support_smartlink}
+function GetProcessPriorityBoost(hThread: THandle; var DisablePriorityBoost: Bool): BOOL;external 'kernel32' name 'GetProcessPriorityBoost';
+{$endif support_smartlink}
+function GetProcessShutdownParameters(var lpdwLevel, lpdwFlags: DWORD): BOOL; external 'kernel32' name 'GetProcessShutdownParameters';
+function GetProcessTimes(hProcess: THandle; var lpCreationTime, lpExitTime, lpKernelTime, lpUserTime: TFileTime): BOOL; external 'kernel32' name 'GetProcessTimes';
+function GetProcessWorkingSetSize(hProcess: THandle; var lpMinimumWorkingSetSize, lpMaximumWorkingSetSize: DWORD): BOOL; external 'kernel32' name 'GetProcessWorkingSetSize';
+function GetQueuedCompletionStatus(CompletionPort: THandle; var lpNumberOfBytesTransferred, lpCompletionKey: DWORD; var lpOverlapped: POverlapped; dwMilliseconds: DWORD): BOOL; external 'kernel32' name 'GetQueuedCompletionStatus';
+function GetRasterizerCaps(var p1: TRasterizerStatus; p2: UINT): BOOL; external 'gdi32' name 'GetRasterizerCaps';
+function GetRgnBox(RGN: HRGN; var p2: TRect): Integer; external 'gdi32' name 'GetRgnBox';
+function GetScrollInfo(hWnd: HWND; BarFlag: Integer; var ScrollInfo: TScrollInfo): BOOL; external 'user32' name 'GetScrollInfo';
+function GetScrollRange(hWnd: HWND; nBar: Integer; var lpMinPos, lpMaxPos: Integer): BOOL; external 'user32' name 'GetScrollRange';
+//function GetSecurityDescriptorControl(pSecurityDescriptor: PSecurityDescriptor; var pControl: SECURITY_DESCRIPTOR_CONTROL; var lpdwRevision: DWORD): BOOL; external 'advapi32' name 'GetSecurityDescriptorControl';
+//function GetSecurityDescriptorDacl(pSecurityDescriptor: PSecurityDescriptor; var lpbDaclPresent: BOOL; var pDacl: PACL; var lpbDaclDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorDacl';
+//function GetSecurityDescriptorGroup(pSecurityDescriptor: PSecurityDescriptor; var pGroup: PSID; var lpbGroupDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorGroup';
+//function GetSecurityDescriptorOwner(pSecurityDescriptor: PSecurityDescriptor; var pOwner: PSID; var lpbOwnerDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorOwner';
+//function GetSecurityDescriptorSacl(pSecurityDescriptor: PSecurityDescriptor; var lpbSaclPresent: BOOL; var pSacl: PACL; var lpbSaclDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorSacl';
+function GetStringTypeA(Locale: LCID; dwInfoType: DWORD; const lpSrcStr: LPCSTR; cchSrc: BOOL; var lpCharType: Word): BOOL;external 'kernel32' name 'GetStringTypeA';
+function GetStringTypeEx(Locale: LCID; dwInfoType: DWORD; lpSrcStr: PChar; cchSrc: Integer; var lpCharType): BOOL;external 'kernel32' name 'GetStringTypeExA';
+function GetStringTypeExA(Locale: LCID; dwInfoType: DWORD; lpSrcStr: LPCSTR; cchSrc: Integer; var lpCharType): BOOL; external 'kernel32' name 'GetStringTypeExA';
+function GetStringTypeExW(Locale: LCID; dwInfoType: DWORD; lpSrcStr: LPWSTR; cchSrc: Integer; var lpCharType): BOOL; external 'kernel32' name 'GetStringTypeExW';
+function GetStringTypeW(dwInfoType: DWORD; const lpSrcStr: WCHAR; cchSrc: BOOL; var lpCharType: Word): BOOL;external 'kernel32' name 'GetStringTypeW';
+function GetSystemPaletteEntries(DC: HDC; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; external 'gdi32' name 'GetSystemPaletteEntries';
+function GetSystemPowerStatus(var lpSystemPowerStatus: TSystemPowerStatus): BOOL;external 'kernel32' name 'GetSystemPowerStatus';
+function GetSystemTimeAdjustment(var lpTimeAdjustment, lpTimeIncrement: DWORD; var lpTimeAdjustmentDisabled: BOOL): BOOL; external 'kernel32' name 'GetSystemTimeAdjustment';
+procedure GetSystemTimeAsFileTime(var lpSystemTimeAsFileTime:TFILETIME); external 'kernel32' name 'GetSystemTimeAsFileTime';
+function GetTabbedTextExtent(hDC: HDC; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD;external 'user32' name 'GetTabbedTextExtentA';
+function GetTabbedTextExtentA(hDC: HDC; lpString: LPCSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD; external 'user32' name 'GetTabbedTextExtentA';
+function GetTabbedTextExtentW(hDC: HDC; lpString: LPWSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD; external 'user32' name 'GetTabbedTextExtentW';
+function GetTapeParameters(hDevice: THandle; dwOperation: DWORD; var lpdwSize: DWORD; lpTapeInformation: Pointer): DWORD; external 'kernel32' name 'GetTapeParameters';
+function GetTapePosition(hDevice: THandle; dwPositionType: DWORD; var lpdwPartition, lpdwOffsetLow: DWORD; lpdwOffsetHigh: Pointer): DWORD; external 'kernel32' name 'GetTapePosition';
+function GetTextExtentExPoint(DC: HDC; p2: PChar; p3, p4: Integer; p5, p6: PInteger; var p7: TSize): BOOL;external 'gdi32' name 'GetTextExtentExPointA';
+function GetTextExtentExPointA(DC: HDC; p2: LPCSTR; p3, p4: Integer; p5, p6: PInteger; var p7: TSize): BOOL; external 'gdi32' name 'GetTextExtentExPointA';
+//function GetTextExtentExPointI(DC: HDC; p2: PWORD; p3, p4: Integer; p5, p6: PINT; var p7: TSize): BOOL;external 'gdi32' name 'GetTextExtentExPointI';
+function GetTextExtentExPointW(DC: HDC; p2: LPWSTR; p3, p4: Integer; p5, p6: PInteger; var p7: TSize): BOOL; external 'gdi32' name 'GetTextExtentExPointW';
+function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): BOOL;external 'gdi32' name 'GetTextExtentPointA';
+function GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): BOOL;external 'gdi32' name 'GetTextExtentPoint32A';
+function GetTextExtentPoint32A(DC: HDC; Str: LPCSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPoint32A';
+function GetTextExtentPoint32W(DC: HDC; Str: LPWSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPoint32W';
+function GetTextExtentPointA(DC: HDC; Str: LPCSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPointA';
+//function GetTextExtentPointI(DC: HDC; p2: PWORD; p3: Integer; var p4: TSize): BOOL;external 'gdi32' name 'GetTextExtentPointI';
+function GetTextExtentPointW(DC: HDC; Str: LPWSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPointW';
+function GetTextMetrics(DC: HDC; var TM: TTextMetric): BOOL;external 'gdi32' name 'GetTextMetricsA';
+//function GetTextMetricsA(DC: HDC; var TM: TTextMetricA): BOOL; external 'gdi32' name 'GetTextMetricsA';
+//function GetTextMetricsW(DC: HDC; var TM: TTextMetricW): BOOL; external 'gdi32' name 'GetTextMetricsW';
+function GetThreadContext(hThread: THandle; var lpContext: TContext): BOOL; external 'kernel32' name 'GetThreadContext';
+{$ifdef support_smartlink}
+function GetThreadPriorityBoost(hThread: THandle; var DisablePriorityBoost: Bool): BOOL;external 'kernel32' name 'GetThreadPriorityBoost';
+{$endif support_smartlink}
+function GetThreadSelectorEntry(hThread: THandle; dwSelector: DWORD; var lpSelectorEntry: TLDTEntry): BOOL; external 'kernel32' name 'GetThreadSelectorEntry';
+function GetThreadTimes(hThread: THandle; var lpCreationTime, lpExitTime, lpKernelTime, lpUserTime: TFileTime): BOOL; external 'kernel32' name 'GetThreadTimes';
+function GetTimeZoneInformation(var lpTimeZoneInformation: TTimeZoneInformation): DWORD; external 'kernel32' name 'GetTimeZoneInformation';
+//function GetTitleBarInfo(hwnd: HWND; var pti: TTitleBarInfo): BOOL;external 'user32' name 'GetTitleBarInfo';
+//function GetTokenInformation(TokenHandle: THandle; TokenInformationClass: TTokenInformationClass; TokenInformation: Pointer; TokenInformationLength: DWORD; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'GetTokenInformation';
+function GetUpdateRect(hWnd: HWND; var lpRect: TRect; bErase: BOOL): BOOL; external 'user32' name 'GetUpdateRect';
+function GetUserName(lpBuffer: PChar; var nSize: DWORD): BOOL;external 'advapi32' name 'GetUserNameA';
+function GetUserNameA(lpBuffer: LPCSTR; var nSize: DWORD): BOOL; external 'advapi32' name 'GetUserNameA';
+function GetUserNameW(lpBuffer: LPWSTR; var nSize: DWORD): BOOL; external 'advapi32' name 'GetUserNameW';
+function GetUserObjectInformation(hObj: THandle; nIndex: Integer; pvInfo: Pointer; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL;external 'user32' name 'GetUserObjectInformationA';
+function GetUserObjectInformationA(hObj: THandle; nIndex: Integer; pvInfo: Pointer; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'user32' name 'GetUserObjectInformationA';
+function GetUserObjectInformationW(hObj: THandle; nIndex: Integer; pvInfo: Pointer; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'user32' name 'GetUserObjectInformationW';
+function GetUserObjectSecurity(hObj: THandle; var pSIRequested: DWORD; pSID: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'user32' name 'GetUserObjectSecurity';
+function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;external 'kernel32' name 'GetVersionExA';
+function GetVersionExA(var lpVersionInformation: TOSVersionInfo): BOOL; external 'kernel32' name 'GetVersionExA';
+function GetVersionExW(var lpVersionInformation: TOSVersionInfoW): BOOL; external 'kernel32' name 'GetVersionExW';
+function GetViewportExtEx(DC: HDC; var Size: TSize): BOOL; external 'gdi32' name 'GetViewportExtEx';
+function GetViewportOrgEx(DC: HDC; var Point: TPoint): BOOL; external 'gdi32' name 'GetViewportOrgEx';
+function GetVolumeInformation(lpRootPathName: PChar; lpVolumeNameBuffer: PChar; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
+ lpFileSystemNameBuffer: PChar; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationA';
+function GetVolumeInformationA(lpRootPathName: LPCSTR; lpVolumeNameBuffer: LPCSTR; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
+ lpFileSystemNameBuffer: LPCSTR; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationA';
+function GetVolumeInformationW(lpRootPathName: LPWSTR; lpVolumeNameBuffer: LPWSTR; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
+ lpFileSystemNameBuffer: LPWSTR; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationW';
+function GetWindowExtEx(DC: HDC; var Size: TSize): BOOL; external 'gdi32' name 'GetWindowExtEx';
+//function GetWindowInfo(hwnd: HWND; var pwi: TWindowInfo): BOOL;external 'user32' name 'GetWindowInfo';
+function GetWindowOrgEx(DC: HDC; var Point: TPoint): BOOL; external 'gdi32' name 'GetWindowOrgEx';
+function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'user32' name 'GetWindowRect';
+function GetWorldTransform(DC: HDC; var p2: TXForm): BOOL; external 'gdi32' name 'GetWorldTransform';
+//function GradientFill(DC: HDC; var p2: TTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL;external 'gdi32' name 'GradientFill';
+procedure GlobalMemoryStatus(var Buffer: MEMORYSTATUS); external 'kernel32' name 'GlobalMemoryStatus';
+function HeapWalk(hHeap: THandle; var lpEntry: TProcessHeapEntry): BOOL; external 'kernel32' name 'HeapWalk';
+function ImageList_GetDragImage(var ppt:POINT; var pptHotspot:POINT):HIMAGELIST; external 'comctl32' name 'ImageList_GetDragImage';
+function InflateRect(var lprc: TRect; dx, dy: Integer): BOOL; external 'user32' name 'InflateRect';
+function InitializeAcl(var pAcl: TACL; nAclLength, dwAclRevision: DWORD): BOOL; external 'advapi32' name 'InitializeAcl';
+{$ifdef support_smartlink}
+function InitializeCriticalSectionAndSpinCount(var lpCriticalSection: TRTLCriticalSection; dwSpinCount: DWORD): BOOL;external 'kernel32' name 'InitializeCriticalSectionAndSpinCount';
+{$endif support_smartlink}
+function InitializeSid(Sid: Pointer; const pIdentifierAuthority: TSIDIdentifierAuthority; nSubAuthorityCount: Byte): BOOL; external 'advapi32' name 'InitializeSid';
+function InsertMenuItem(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfo): BOOL;external 'user32' name 'InsertMenuItemA';
+function InsertMenuItemA(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoA): BOOL; external 'user32' name 'InsertMenuItemA';
+//function InsertMenuItemW(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoW): BOOL; external 'user32' name 'InsertMenuItemW';
+{$ifdef support_smartlink}
+function InterlockedCompareExchange(var Destination: Pointer; Exchange: Pointer; Comperand: Pointer): Pointer;external 'kernel32' name 'InterlockedCompareExchange';
+{$endif support_smartlink}
+function InterlockedDecrement(var Addend: longint): longint; external 'kernel32' name 'InterlockedDecrement';
+function InterlockedExchange(var Target: longint; Value: longint): longint; external 'kernel32' name 'InterlockedExchange';
+function InterlockedIncrement(var Addend: longint): longint; external 'kernel32' name 'InterlockedIncrement';
+function IntersectRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'IntersectRect';
+//function InvertRect(hDC: HDC; const lprc: TRect): BOOL; external 'user32' name 'InvertRect';
+function IsDialogMessage(hDlg: HWND; var lpMsg: TMsg): BOOL;external 'user32' name 'IsDialogMessageA';
+function IsDialogMessageA(hDlg: HWND; var lpMsg: TMsg): BOOL; external 'user32' name 'IsDialogMessageA';
+function IsDialogMessageW(hDlg: HWND; var lpMsg: TMsg): BOOL; external 'user32' name 'IsDialogMessageW';
+//function IsRectEmpty(const lprc: TRect): BOOL; external 'user32' name 'IsRectEmpty';
+function IsValidAcl(const pAcl: TACL): BOOL; external 'advapi32' name 'IsValidAcl';
+function LocalFileTimeToFileTime(const lpLocalFileTime: TFileTime; var lpFileTime: TFileTime): BOOL; external 'kernel32' name 'LocalFileTimeToFileTime';
+function LockFileEx(hFile: THandle; dwFlags, dwReserved: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD; const lpOverlapped: TOverlapped): BOOL; external 'kernel32' name 'LockFileEx';
+function LogonUser(lpszUsername, lpszDomain, lpszPassword: PChar; dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL;external 'advapi32' name 'LogonUserA';
+function LogonUserA(lpszUsername, lpszDomain, lpszPassword: LPCSTR; dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL; external 'advapi32' name 'LogonUserA';
+function LogonUserW(lpszUsername, lpszDomain, lpszPassword: LPWSTR; dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL; external 'advapi32' name 'LogonUserW';
+function LookupAccountName(lpSystemName, lpAccountName: PChar; Sid: PSID; var cbSid: DWORD; ReferencedDomainName: PChar; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL;external 'advapi32' name 'LookupAccountNameA';
+function LookupAccountNameA(lpSystemName, lpAccountName: LPCSTR; Sid: PSID; var cbSid: DWORD; ReferencedDomainName: LPCSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountNameA';
+function LookupAccountNameW(lpSystemName, lpAccountName: LPWSTR; Sid: PSID; var cbSid: DWORD; ReferencedDomainName: LPWSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountNameW';
+function LookupAccountSid(lpSystemName: PChar; Sid: PSID; Name: PChar; var cbName: DWORD; ReferencedDomainName: PChar; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL;external 'advapi32' name 'LookupAccountSidA';
+function LookupAccountSidA(lpSystemName: LPCSTR; Sid: PSID; Name: LPCSTR; var cbName: DWORD; ReferencedDomainName: LPCSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountSidA';
+function LookupAccountSidW(lpSystemName: LPWSTR; Sid: PSID; Name: LPWSTR; var cbName: DWORD; ReferencedDomainName: LPWSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountSidW';
+function LookupPrivilegeDisplayName(lpSystemName, lpName: LPCSTR; lpDisplayName: PChar; var cbDisplayName, lpLanguageId: DWORD): BOOL;external 'advapi32' name 'LookupPrivilegeDisplayNameA';
+function LookupPrivilegeDisplayNameA(lpSystemName, lpName: LPCSTR; lpDisplayName: LPCSTR; var cbDisplayName, lpLanguageId: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameA';
+function LookupPrivilegeDisplayNameW(lpSystemName, lpName: LPCSTR; lpDisplayName: LPWSTR; var cbDisplayName, lpLanguageId: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameW';
+function LookupPrivilegeName(lpSystemName: PChar; var lpLuid: TLargeInteger; lpName: PChar; var cbName: DWORD): BOOL;external 'advapi32' name 'LookupPrivilegeNameA';
+function LookupPrivilegeNameA(lpSystemName: LPCSTR; var lpLuid: TLargeInteger; lpName: LPCSTR; var cbName: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeNameA';
+function LookupPrivilegeNameW(lpSystemName: LPWSTR; var lpLuid: TLargeInteger; lpName: LPWSTR; var cbName: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeNameW';
+function LookupPrivilegeValue(lpSystemName, lpName: PChar; var lpLuid: TLargeInteger): BOOL;external 'advapi32' name 'LookupPrivilegeValueA';
+function LookupPrivilegeValueA(lpSystemName, lpName: LPCSTR; var lpLuid: TLargeInteger): BOOL; external 'advapi32' name 'LookupPrivilegeValueA';
+function LookupPrivilegeValueW(lpSystemName, lpName: LPWSTR; var lpLuid: TLargeInteger): BOOL; external 'advapi32' name 'LookupPrivilegeValueW';
+function LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'LPtoDP';
+function MakeAbsoluteSD(pSelfRelativeSecurityDescriptor: PSecurityDescriptor; pAbsoluteSecurityDescriptor: PSecurityDescriptor; var lpdwAbsoluteSecurityDescriptorSi: DWORD; var pDacl: TACL; var lpdwDaclSize: DWORD; var pSacl: TACL;
+ var lpdwSaclSize: DWORD; pOwner: PSID; var lpdwOwnerSize: DWORD; pPrimaryGroup: Pointer; var lpdwPrimaryGroupSize: DWORD): BOOL; external 'advapi32' name 'MakeAbsoluteSD';
+function MakeSelfRelativeSD(pAbsoluteSecurityDescriptor: PSecurityDescriptor; pSelfRelativeSecurityDescriptor: PSecurityDescriptor; var lpdwBufferLength: DWORD): BOOL; external 'advapi32' name 'MakeSelfRelativeSD';
+function MapDialogRect(hDlg: HWND; var lpRect: TRect): BOOL; external 'user32' name 'MapDialogRect';
+function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints; cPoints: UINT): Integer; external 'user32' name 'MapWindowPoints';
+function MessageBoxIndirect(const MsgBoxParams: TMsgBoxParams): BOOL;external 'user32' name 'MessageBoxIndirectA';
+function MessageBoxIndirectA(const MsgBoxParams: TMsgBoxParamsA): BOOL; external 'user32' name 'MessageBoxIndirectA';
+//function MessageBoxIndirectW(const MsgBoxParams: TMsgBoxParamsW): BOOL; external 'user32' name 'MessageBoxIndirectW';
+//function ModifyWorldTransform(DC: HDC; const p2: TXForm; p3: DWORD): BOOL; external 'gdi32' name 'ModifyWorldTransform';
+function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjects';
+{$ifdef support_smartlink}
+function MsgWaitForMultipleObjectsEx(nCount: DWORD; var pHandles; dwMilliseconds, dwWakeMask, dwFlags: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjectsEx';
+{$endif support_smartlink}
+// function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lLPWSTRStr: LPWSTR; cchWideChar: Integer): Integer; external 'kernel32' name 'MultiByteToWideChar';
+function ObjectOpenAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName: PChar; ObjectName: PChar; pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess, GrantedAccess: DWORD; var Privileges: TPrivilegeSet;
+ ObjectCreation, AccessGranted: BOOL; var GenerateOnClose: BOOL): BOOL;external 'advapi32' name 'ObjectOpenAuditAlarmA';
+function ObjectOpenAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName: LPCSTR; ObjectName: LPCSTR; pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess, GrantedAccess: DWORD; var Privileges: TPrivilegeSet;
+ ObjectCreation, AccessGranted: BOOL; var GenerateOnClose: BOOL): BOOL; external 'advapi32' name 'ObjectOpenAuditAlarmA';
+function ObjectOpenAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName: LPWSTR; ObjectName: LPWSTR; pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess, GrantedAccess: DWORD; var Privileges: TPrivilegeSet;
+ ObjectCreation, AccessGranted: BOOL; var GenerateOnClose: BOOL): BOOL; external 'advapi32' name 'ObjectOpenAuditAlarmW';
+function ObjectPrivilegeAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ClientToken: THandle; DesiredAccess: DWORD; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL;external 'advapi32' name 'ObjectPrivilegeAuditAlarmA';
+function ObjectPrivilegeAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ClientToken: THandle; DesiredAccess: DWORD; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmA';
+function ObjectPrivilegeAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ClientToken: THandle; DesiredAccess: DWORD; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmW';
+
+function OffsetRect(var lprc: TRect; dx, dy: Integer): BOOL; external 'user32' name 'OffsetRect';
+function OffsetViewportOrgEx(DC: HDC; X, Y: Integer; var Points): BOOL; external 'gdi32' name 'OffsetViewportOrgEx';
+function OffsetWindowOrgEx(DC: HDC; X, Y: Integer; var Points): BOOL; external 'gdi32' name 'OffsetWindowOrgEx';
+function OpenFile(const lpFileName: LPCSTR; var lpReOpenBuff: TOFStruct; uStyle: UINT): HFILE; external 'kernel32' name 'OpenFile';
+function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; var TokenHandle: THandle): BOOL; external 'advapi32' name 'OpenProcessToken';
+function OpenThreadToken(ThreadHandle: THandle; DesiredAccess: DWORD; OpenAsSelf: BOOL; var TokenHandle: THandle): BOOL; external 'advapi32' name 'OpenThreadToken';
+function PeekConsoleInput(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL;external 'kernel32' name 'PeekConsoleInputA';
+function PeekConsoleInputA(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputA';
+function PeekConsoleInputW(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputW';
+function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL;external 'user32' name 'PeekMessageA';
+function PeekMessageA(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageA';
+function PeekMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageW';
+//function PlayEnhMetaFile(DC: HDC; p2: HENHMETAFILE; const p3: TRect): BOOL; external 'gdi32' name 'PlayEnhMetaFile';
+function PlayEnhMetaFileRecord(DC: HDC; var p2: THandleTable; const p3: TEnhMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayEnhMetaFileRecord';
+function PlayMetaFileRecord(DC: HDC; const p2: THandleTable; const p3: TMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayMetaFileRecord';
+function PlgBlt(DC: HDC; const PointsArray; p3: HDC; p4, p5, p6, p7: Integer; p8: HBITMAP; p9, p10: Integer): BOOL; external 'gdi32' name 'PlgBlt';
+function PolyBezier(DC: HDC; const Points; Count: DWORD): BOOL; external 'gdi32' name 'PolyBezier';
+function PolyBezierTo(DC: HDC; const Points; Count: DWORD): BOOL; external 'gdi32' name 'PolyBezierTo';
+function PolyDraw(DC: HDC; const Points, Types; cCount: Integer): BOOL; external 'gdi32' name 'PolyDraw';
+function Polygon(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'Polygon';
+function Polyline(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'Polyline';
+function PolyLineTo(DC: HDC; const Points; Count: DWORD): BOOL; external 'gdi32' name 'PolylineTo';
+function PolyPolygon(DC: HDC; var Points; var nPoints; p4: Integer): BOOL; external 'gdi32' name 'PolyPolygon';
+function PolyPolyline(DC: HDC; const PointStructs; const Points; p4: DWORD): BOOL; external 'gdi32' name 'PolyPolyline';
+function PolyTextOut(DC: HDC; const PolyTextArray; Strings: Integer): BOOL;external 'gdi32' name 'PolyTextOutA';
+function PolyTextOutA(DC: HDC; const PolyTextArray; Strings: Integer): BOOL; external 'gdi32' name 'PolyTextOutA';
+function PolyTextOutW(DC: HDC; const PolyTextArray; Strings: Integer): BOOL; external 'gdi32' name 'PolyTextOutW';
+function PrivilegeCheck(ClientToken: THandle; const RequiredPrivileges: TPrivilegeSet; var pfResult: BOOL): BOOL; external 'advapi32' name 'PrivilegeCheck';
+function PrivilegedServiceAuditAlarm(SubsystemName, ServiceName: PChar; ClientToken: THandle; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL;external 'advapi32' name 'PrivilegedServiceAuditAlarmA';
+function PrivilegedServiceAuditAlarmA(SubsystemName, ServiceName: LPCSTR; ClientToken: THandle; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmA';
+function PrivilegedServiceAuditAlarmW(SubsystemName, ServiceName: LPWSTR; ClientToken: THandle; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmW';
+//function PtInRect(const lprc: TRect; pt: TPoint): BOOL; external 'user32' name 'PtInRect';
+function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger): BOOL; external 'kernel32' name 'QueryPerformanceCounter';
+function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL; external 'kernel32' name 'QueryPerformanceFrequency';
+//function QueryRecoveryAgents(p1: PChar; var p2: Pointer; var p3: TRecoveryAgentInformation): DWORD;external 'kernel32' name 'QueryRecoveryAgentsA';
+//function QueryRecoveryAgentsA(p1: LPCSTR; var p2: Pointer; var p3: TRecoveryAgentInformationA): DWORD;external 'kernel32' name 'QueryRecoveryAgentsA';
+//function QueryRecoveryAgentsW(p1: LPWSTR; var p2: Pointer; var p3: TRecoveryAgentInformationW): DWORD;external 'kernel32' name 'QueryRecoveryAgentsW';
+procedure RaiseException(dwExceptionCode:DWORD; dwExceptionFlags:DWORD; nNumberOfArguments:DWORD; var lpArguments:DWORD); external 'kernel32' name 'RaiseException';
+function UnhandledExceptionFilter(var ExceptionInfo:emptyrecord):LONG; external 'kernel32' name 'UnhandledExceptionFilter';
+function ReadConsole(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsToRead: DWORD; var lpNumberOfCharsRead: DWORD; lpReserved: Pointer): BOOL;external 'kernel32' name 'ReadConsoleA';
+function ReadConsoleA(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsToRead: DWORD; var lpNumberOfCharsRead: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'ReadConsoleA';
+function ReadConsoleInput(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL;external 'kernel32' name 'ReadConsoleInputA';
+function ReadConsoleInputA(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleInputA';
+function ReadConsoleInputW(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleInputW';
+function ReadConsoleOutput(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpReadRegion: TSmallRect): BOOL;external 'kernel32' name 'ReadConsoleOutputA';
+function ReadConsoleOutputA(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpReadRegion: TSmallRect): BOOL; external 'kernel32' name 'ReadConsoleOutputA';
+function ReadConsoleOutputAttribute(hConsoleOutput: THandle; lpAttribute: Pointer; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfAttrsRead: DWORD): BOOL;external 'kernel32' name 'ReadConsoleOutputAttribute';
+function ReadConsoleOutputCharacter(hConsoleOutput: THandle; lpCharacter: LPCSTR; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfCharsRead: DWORD): BOOL;external 'kernel32' name 'ReadConsoleOutputCharacterA';
+function ReadConsoleOutputCharacterA(hConsoleOutput: THandle; lpCharacter: LPCSTR; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfCharsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleOutputCharacterA';
+function ReadConsoleOutputCharacterW(hConsoleOutput: THandle; lpCharacter: LPCSTR; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfCharsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleOutputCharacterW';
+function ReadConsoleOutputW(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpReadRegion: TSmallRect): BOOL; external 'kernel32' name 'ReadConsoleOutputW';
+function ReadConsoleW(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsToRead: DWORD; var lpNumberOfCharsRead: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'ReadConsoleW';
+function ReadEventLog(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL;external 'advapi32' name 'ReadEventLogA';
+function ReadEventLogA(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogA';
+function ReadEventLogW(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogW';
+function ReadFile(hFile: THandle; var Buffer; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'ReadFile';
+function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesRead: DWORD): BOOL; external 'kernel32' name 'ReadProcessMemory';
+//function RectInRegion(RGN: HRGN; const p2: TRect): BOOL; external 'gdi32' name 'RectInRegion';
+//function RectVisible(DC: HDC; const Rect: TRect): BOOL; external 'gdi32' name 'RectVisible';
+function RegConnectRegistry(lpMachineName: PChar; hKey: HKEY; var phkResult: HKEY): Longint;external 'advapi32' name 'RegConnectRegistryA';
+function RegConnectRegistryA(lpMachineName: LPCSTR; hKey: HKEY; var phkResult: HKEY): Longint; external 'advapi32' name 'RegConnectRegistryA';
+function RegConnectRegistryW(lpMachineName: LPWSTR; hKey: HKEY; var phkResult: HKEY): Longint; external 'advapi32' name 'RegConnectRegistryW';
+function RegCreateKey(hKey: HKEY; lpSubKey: PChar; var phkResult: HKEY): Longint;external 'advapi32' name 'RegCreateKeyA';
+function RegCreateKeyA(hKey: HKEY; lpSubKey: LPCSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegCreateKeyA';
+function RegCreateKeyEx(hKey: HKEY; lpSubKey: PChar; Reserved: DWORD; lpClass: PChar; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD): Longint;
+ external 'advapi32' name 'RegCreateKeyExA';
+function RegCreateKeyExA(hKey: HKEY; lpSubKey: LPCSTR; Reserved: DWORD; lpClass: LPCSTR; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD): Longint;
+ external 'advapi32' name 'RegCreateKeyExA';
+function RegCreateKeyExW(hKey: HKEY; lpSubKey: LPWSTR; Reserved: DWORD; lpClass: LPWSTR; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD): Longint;
+ external 'advapi32' name 'RegCreateKeyExW';
+function RegCreateKeyW(hKey: HKEY; lpSubKey: LPWSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegCreateKeyW';
+function RegEnumKeyEx(hKey: HKEY; dwIndex: DWORD; lpName: PChar; var lpcbName: DWORD; lpReserved: Pointer; lpClass: PChar; lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint;external 'advapi32' name 'RegEnumKeyExA';
+function RegEnumKeyExA(hKey: HKEY; dwIndex: DWORD; lpName: LPCSTR; var lpcbName: DWORD; lpReserved: Pointer; lpClass: LPCSTR; lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint; external 'advapi32' name 'RegEnumKeyExA';
+function RegEnumKeyExW(hKey: HKEY; dwIndex: DWORD; lpName: LPWSTR; var lpcbName: DWORD; lpReserved: Pointer; lpClass: LPWSTR; lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint; external 'advapi32' name 'RegEnumKeyExW';
+function RegEnumValue(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint;external 'advapi32' name 'RegEnumValueA';
+function RegEnumValueA(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueA';
+function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueW';
+function RegGetKeySecurity(hKey: HKEY; SecurityInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; var lpcbSecurityDescriptor: DWORD): Longint; external 'advapi32' name 'RegGetKeySecurity';
+function RegisterClass(const lpWndClass: TWndClass): ATOM;external 'user32' name 'RegisterClassA';
+function RegisterClassA(const lpWndClass: TWndClassA): ATOM; external 'user32' name 'RegisterClassA';
+function RegisterClassEx(const WndClass: TWndClassEx): ATOM;external 'user32' name 'RegisterClassExA';
+function RegisterClassExA(const WndClass: TWndClassExA): ATOM; external 'user32' name 'RegisterClassExA';
+function RegisterClassExW(const WndClass: TWndClassExW): ATOM; external 'user32' name 'RegisterClassExW';
+function RegisterClassW(const lpWndClass: TWndClassW): ATOM; external 'user32' name 'RegisterClassW';
+function RegOpenKey(hKey: HKEY; lpSubKey: PChar; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyA';
+function RegOpenKeyA(hKey: HKEY; lpSubKey: LPCSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyA';
+function RegOpenKeyEx(hKey: HKEY; lpSubKey: PChar; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyExA';
+function RegOpenKeyExA(hKey: HKEY; lpSubKey: LPCSTR; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyExA';
+function RegOpenKeyExW(hKey: HKEY; lpSubKey: LPWSTR; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyExW';
+function RegOpenKeyW(hKey: HKEY; lpSubKey: LPWSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyW';
+function RegQueryMultipleValues(hKey: HKEY; var ValList; NumVals: DWORD; lpValueBuf: PChar; var ldwTotsize: DWORD): Longint;external 'advapi32' name 'RegQueryMultipleValuesA';
+function RegQueryMultipleValuesA(hKey: HKEY; var ValList; NumVals: DWORD; lpValueBuf: LPCSTR; var ldwTotsize: DWORD): Longint; external 'advapi32' name 'RegQueryMultipleValuesA';
+function RegQueryMultipleValuesW(hKey: HKEY; var ValList; NumVals: DWORD; lpValueBuf: LPWSTR; var ldwTotsize: DWORD): Longint; external 'advapi32' name 'RegQueryMultipleValuesW';
+function RegQueryValue(hKey: HKEY; lpSubKey: PChar; lpValue: PChar; var lpcbValue: Longint): Longint;external 'advapi32' name 'RegQueryValueA';
+function RegQueryValueA(hKey: HKEY; lpSubKey: LPCSTR; lpValue: LPCSTR; var lpcbValue: Longint): Longint; external 'advapi32' name 'RegQueryValueA';
+function RegQueryValueW(hKey: HKEY; lpSubKey: LPWSTR; lpValue: LPWSTR; var lpcbValue: Longint): Longint; external 'advapi32' name 'RegQueryValueW';
+function ResetDC(DC: HDC; const p2: TDeviceMode): HDC;external 'gdi32' name 'ResetDCA';
+function ResetDCA(DC: HDC; const p2: TDeviceModeA): HDC; external 'gdi32' name 'ResetDCA';
+//function ResetDCW(DC: HDC; const p2: TDeviceModeW): HDC; external 'gdi32' name 'ResetDCW';
+function ScreenToClient(hWnd: HWND; var lpPoint: TPoint): BOOL; external 'user32' name 'ScreenToClient';
+function ScrollConsoleScreenBuffer(hConsoleOutput: THandle; const lpScrollRectangle: TSmallRect; const lpClipRectangle: TSmallRect; dwDestinationOrigin: TCoord; var lpFill: TCharInfo): BOOL;external 'kernel32' name 'ScrollConsoleScreenBufferA';
+function ScrollConsoleScreenBufferA(hConsoleOutput: THandle; const lpScrollRectangle: TSmallRect; const lpClipRectangle: TSmallRect; dwDestinationOrigin: TCoord; var lpFill: TCharInfo): BOOL; external 'kernel32' name 'ScrollConsoleScreenBufferA';
+function ScrollConsoleScreenBufferW(hConsoleOutput: THandle; const lpScrollRectangle: TSmallRect; const lpClipRectangle: TSmallRect; dwDestinationOrigin: TCoord; var lpFill: TCharInfo): BOOL; external 'kernel32' name 'ScrollConsoleScreenBufferW';
+function ScrollWindow(hWnd:HWND; XAmount:longint; YAmount:longint;lpRect:lpRECT; lpClipRect:lpRECT):WINBOOL; external 'user32' name 'ScrollWindow';
+function ScrollWindowEx(hWnd:HWND; dx:longint; dy:longint; prcScroll:lpRECT; prcClip:lpRECT;hrgnUpdate:HRGN; prcUpdate:LPRECT; flags:UINT):longint; external 'user32' name 'ScrollWindowEx';
+//function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN; Update: PRect): BOOL; external 'user32' name 'ScrollDC';
+//function SearchPath(lpPath, lpFileName, lpExtension: PChar; nBufferLength: DWORD; lpBuffer: PChar; var lpFilePart: PChar): DWORD;external 'kernel32' name 'SearchPathA';
+//function SearchPathA(lpPath, lpFileName, lpExtension: LPCSTR; nBufferLength: DWORD; lpBuffer: LPCSTR; var lpFilePart: LPCSTR): DWORD; external 'kernel32' name 'SearchPathA';
+//function SearchPathW(lpPath, lpFileName, lpExtension: LPWSTR; nBufferLength: DWORD; lpBuffer: LPWSTR; var lpFilePart: LPWSTR): DWORD; external 'kernel32' name 'SearchPathW';
+//function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT;external 'user32' name 'SendInput';
+function SendMessageTimeout(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT;external 'user32' name 'SendMessageTimeoutA';
+function SendMessageTimeoutA(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT; external 'user32' name 'SendMessageTimeoutA';
+function SendMessageTimeoutW(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT; external 'user32' name 'SendMessageTimeoutW';
+//function SetAclInformation(var pAcl: TACL; pAclInformation: Pointer; nAclInformationLength: DWORD; dwAclInformationClass: TAclInformationClass): BOOL; external 'advapi32' name 'SetAclInformation';
+//function SetColorAdjustment(DC: HDC; const p2: TColorAdjustment): BOOL; external 'gdi32' name 'SetColorAdjustment';
+function SetCommConfig(hCommDev: THandle; const lpCC: TCommConfig; dwSize: DWORD): BOOL; external 'kernel32' name 'SetCommConfig';
+function SetCommState(hFile: THandle; const lpDCB: TDCB): BOOL; external 'kernel32' name 'SetCommState';
+function SetCommTimeouts(hFile: THandle; const lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'SetCommTimeouts';
+function SetConsoleCursorInfo(hConsoleOutput: THandle; const lpConsoleCursorInfo: TConsoleCursorInfo): BOOL; external 'kernel32' name 'SetConsoleCursorInfo';
+//function SetConsoleWindowInfo(hConsoleOutput: THandle; bAbsolute: BOOL; const lpConsoleWindow: TSmallRect): BOOL; external 'kernel32' name 'SetConsoleWindowInfo';
+{$ifdef support_smartlink}
+function SetCriticalSectionSpinCount(var lpCriticalSection: TRTLCriticalSection; dwSpinCount: DWORD): DWORD;external 'kernel32' name 'SetCriticalSectionSpinCount';
+{$endif support_smartlink}
+function SetDeviceGammaRamp(DC: HDC; var Ramp): BOOL; external 'gdi32' name 'SetDeviceGammaRamp';
+function SetDIBColorTable(DC: HDC; p2, p3: UINT; var RGBQuadSTructs): UINT; external 'gdi32' name 'SetDIBColorTable';
+function SetDIBits(DC: HDC; Bitmap: HBITMAP; StartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBits';
+//function SetDIBitsToDevice(DC: HDC; DestX, DestY: Integer; Width, Height: DWORD; SrcX, SrcY: Integer; nStartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBitsToDevice';
+function SetFileTime(hFile:HANDLE; var lpCreationTime:FILETIME; var lpLastAccessTime:FILETIME; var lpLastWriteTime:FILETIME):WINBOOL; external 'kernel32' name 'SetFileTime';
+//function SetKeyboardState(var KeyState: TKeyboardState): BOOL; external 'user32' name 'SetKeyboardState';
+//function SetLocalTime(const lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'SetLocalTime';
+//function SetMenuInfo(hMenu: HMENU; const lpcmi: TMenuInfo): BOOL;external 'user32' name 'SetMenuInfo';
+function SetMenuItemInfo(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfo): BOOL;external 'user32' name 'SetMenuItemInfoA';
+function SetMenuItemInfoA(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoA): BOOL; external 'user32' name 'SetMenuItemInfoA';
+//function SetMenuItemInfoW(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoW): BOOL; external 'user32' name 'SetMenuItemInfoW';
+function SetMetaFileBitsEx(p1: UINT; const p2: PChar): HMETAFILE; external 'gdi32' name 'SetMetaFileBitsEx';
+function SetNamedPipeHandleState(hNamedPipe: THandle; var lpMode: DWORD; lpMaxCollectionCount, lpCollectDataTimeout: Pointer): BOOL; external 'kernel32' name 'SetNamedPipeHandleState';
+function SetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; external 'gdi32' name 'SetPaletteEntries';
+//function SetPrivateObjectSecurity(SecurityInformation: SECURITY_INFORMATION; ModificationDescriptor: PSecurityDescriptor; var ObjectsSecurityDescriptor: PSecurityDescriptor; const GenericMapping: TGenericMapping; Token: THandle): BOOL;
+// external 'advapi32' name 'SetPrivateObjectSecurity';
+//function SetPrivateObjectSecurityEx(SecurityInformation: SECURITY_INFORMATION; ModificationDescriptor: PSecurityDescriptor; var ObjectsSecurityDescriptor: PSecurityDescriptor; AutoInheritFlags: ULONG;
+// const GenericMapping: TGenericMapping; Token: THandle): BOOL;external 'advapi32' name 'SetPrivateObjectSecurityEx';
+function SetRect(var lprc: TRect; xLeft, yTop, xRight, yBottom: Integer): BOOL; external 'user32' name 'SetRect';
+function SetRectEmpty(var lprc: TRect): BOOL; external 'user32' name 'SetRectEmpty';
+function SetScrollInfo(hWnd: HWND; BarFlag: Integer; const ScrollInfo: TScrollInfo; Redraw: BOOL): Integer; external 'user32' name 'SetScrollInfo';
+function SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): BOOL; external 'user32' name 'SetSysColors';
+//function SetSystemTime(const lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'SetSystemTime';
+function SetThreadContext(hThread: THandle; const lpContext: TContext): BOOL; external 'kernel32' name 'SetThreadContext';
+//function SetTimeZoneInformation(const lpTimeZoneInformation: TTimeZoneInformation): BOOL; external 'kernel32' name 'SetTimeZoneInformation';
+function SetUserObjectSecurity(hObj: THandle; var pSIRequested: DWORD; pSID: PSecurityDescriptor): BOOL;external 'user32' name 'SetUserObjectSecurity';
+function SetWaitableTimer(hTimer: THandle; const lpDueTime: TLargeInteger; lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL;external 'kernel32' name 'SetWaitableTimer';
+function SetWinMetaFileBits(p1: UINT; p2: PChar; p3: HDC; const p4: TMetaFilePict): HENHMETAFILE; external 'gdi32' name 'SetWinMetaFileBits';
+//function SetWorldTransform(DC: HDC; const p2: TXForm): BOOL; external 'gdi32' name 'SetWorldTransform';
+function StartDoc(DC: HDC; const p2: TDocInfo): Integer;external 'gdi32' name 'StartDocA';
+function StartDocA(DC: HDC; const p2: TDocInfoA): Integer; external 'gdi32' name 'StartDocA';
+//function StartDocW(DC: HDC; const p2: TDocInfoW): Integer; external 'gdi32' name 'StartDocW';
+//function StretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHegiht, SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT; Rop: DWORD): Integer; external 'gdi32' name 'StretchDIBits';
+function SubtractRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'SubtractRect';
+function SystemTimeToFileTime(const lpSystemTime: TSystemTime; var lpFileTime: TFileTime): BOOL; external 'kernel32' name 'SystemTimeToFileTime';
+function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime, lpLocalTime: TSystemTime): BOOL; external 'kernel32' name 'SystemTimeToTzSpecificLocalTime';
+function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint;external 'user32' name 'TabbedTextOutA';
+function TabbedTextOutA(hDC: HDC; X, Y: Integer; lpString: LPCSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint; external 'user32' name 'TabbedTextOutA';
+function TabbedTextOutW(hDC: HDC; X, Y: Integer; lpString: LPWSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint; external 'user32' name 'TabbedTextOutW';
+//function ToAscii(uVirtKey, uScanCode: UINT; const KeyState: TKeyboardState; lpChar: PChar; uFlags: UINT): Integer; external 'user32' name 'ToAscii';
+//function ToAsciiEx(uVirtKey: UINT; uScanCode: UINT; const KeyState: TKeyboardState; lpChar: PChar; uFlags: UINT; dwhkl: HKL): Integer; external 'user32' name 'ToAsciiEx';
+//function ToUnicode(wVirtKey, wScanCode: UINT; const KeyState: TKeyboardState; var pwszBuff; cchBuff: Integer; wFlags: UINT): Integer; external 'user32' name 'ToUnicode';
+// Careful, NT and higher only.
+function TrackMouseEvent(var EventTrack: TTrackMouseEvent): BOOL;external 'user32' name 'TrackMouseEvent';
+function TrackMouseEvent(lpEventTrack: PTrackMouseEvent): BOOL;external 'user32' name 'TrackMouseEvent';
+function TransactNamedPipe(hNamedPipe: THandle; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'TransactNamedPipe';
+function TranslateAccelerator(hWnd: HWND; hAccTable: HACCEL; var lpMsg: TMsg): Integer;external 'user32' name 'TranslateAcceleratorA';
+function TranslateAcceleratorA(hWnd: HWND; hAccTable: HACCEL; var lpMsg: TMsg): Integer; external 'user32' name 'TranslateAcceleratorA';
+function TranslateAcceleratorW(hWnd: HWND; hAccTable: HACCEL; var lpMsg: TMsg): Integer; external 'user32' name 'TranslateAcceleratorW';
+function TranslateCharsetInfo(var lpSrc: DWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; external 'gdi32' name 'TranslateCharsetInfo';
+function TranslateMDISysAccel(hWndClient: HWND; const lpMsg: TMsg): BOOL; external 'user32' name 'TranslateMDISysAccel';
+function TranslateMessage(const lpMsg: TMsg): BOOL; external 'user32' name 'TranslateMessage';
+//function TransparentDIBits(DC: HDC; p2, p3, p4, p5: Integer; const p6: Pointer; const p7: PBitmapInfo; p8: UINT; p9, p10, p11, p12: Integer; p13: UINT): BOOL;external 'gdi32' name 'TransparentDIBits';
+{$ifdef support_smartlink}
+function TryEnterCriticalSection(var lpCriticalSection: TRTLCriticalSection): BOOL;external 'kernel32' name 'TryEnterCriticalSection';
+{$endif support_smartlink}
+function UnhandledExceptionFilter(const ExceptionInfo: TExceptionPointers): Longint; external 'kernel32' name 'UnhandledExceptionFilter';
+function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'UnionRect';
+function UnlockFileEx(hFile: THandle; dwReserved, nNumberOfBytesToUnlockLow: DWORD; nNumberOfBytesToUnlockHigh: DWORD; const lpOverlapped: TOverlapped): BOOL; external 'kernel32' name 'UnlockFileEx';
+function VerFindFile(uFlags: DWORD; szFileName, szWinDir, szAppDir, szCurDir: PChar; var lpuCurDirLen: UINT; szDestDir: PChar; var lpuDestDirLen: UINT): DWORD;external 'version' name 'VerFindFileA';
+function VerFindFileA(uFlags: DWORD; szFileName, szWinDir, szAppDir, szCurDir: LPCSTR; var lpuCurDirLen: UINT; szDestDir: LPCSTR; var lpuDestDirLen: UINT): DWORD; external 'version' name 'VerFindFileA';
+function VerFindFileW(uFlags: DWORD; szFileName, szWinDir, szAppDir, szCurDir: LPWSTR; var lpuCurDirLen: UINT; szDestDir: LPWSTR; var lpuDestDirLen: UINT): DWORD; external 'version' name 'VerFindFileW';
+function VerInstallFile(uFlags: DWORD; szSrcFileName, szDestFileName, szSrcDir, szDestDir, szCurDir, szTmpFile: PChar; var lpuTmpFileLen: UINT): DWORD;external 'version' name 'VerInstallFileA';
+function VerInstallFileA(uFlags: DWORD; szSrcFileName, szDestFileName, szSrcDir, szDestDir, szCurDir, szTmpFile: LPCSTR; var lpuTmpFileLen: UINT): DWORD; external 'version' name 'VerInstallFileA';
+function VerInstallFileW(uFlags: DWORD; szSrcFileName, szDestFileName, szSrcDir, szDestDir, szCurDir, szTmpFile: LPWSTR; var lpuTmpFileLen: UINT): DWORD; external 'version' name 'VerInstallFileW';
+function VerQueryValue(pBlock: Pointer; lpSubBlock: PChar; var lplpBuffer: Pointer; var puLen: UINT): BOOL;external 'version' name 'VerQueryValueA';
+function VerQueryValueA(pBlock: Pointer; lpSubBlock: LPCSTR; var lplpBuffer: Pointer; var puLen: UINT): BOOL; external 'version' name 'VerQueryValueA';
+function VerQueryValueW(pBlock: Pointer; lpSubBlock: LPWSTR; var lplpBuffer: Pointer; var puLen: UINT): BOOL; external 'version' name 'VerQueryValueW';
+function VirtualQuery(lpAddress: Pointer; var lpBuffer: TMemoryBasicInformation; dwLength: DWORD): DWORD; external 'kernel32' name 'VirtualQuery';
+function VirtualQueryEx(hProcess: THandle; lpAddress: Pointer; var lpBuffer: TMemoryBasicInformation; dwLength: DWORD): DWORD; external 'kernel32' name 'VirtualQueryEx';
+function WaitCommEvent(hFile: THandle; var lpEvtMask: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'WaitCommEvent';
+function WaitForDebugEvent(var lpDebugEvent: TDebugEvent; dwMilliseconds: DWORD): BOOL; external 'kernel32' name 'WaitForDebugEvent';
+function wglDescribeLayerPlane(p1: HDC; p2, p3: Integer; p4: Cardinal; var p5: TLayerPlaneDescriptor): BOOL;external 'opengl32' name 'wglDescribeLayerPlane';
+function wglGetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer;external 'opengl32' name 'wglGetLayerPaletteEntries';
+function wglSetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer;external 'opengl32' name 'wglSetLayerPaletteEntries';
+//function wglSwapMultipleBuffers(p1: UINT; const p2: PWGLSwap): DWORD;external 'opengl32' name 'wglSwapMultipleBuffers';
+//function WinSubmitCertificate(var lpCertificate: TWinCertificate): BOOL;external 'imaghlp' name 'WinSubmitCertificate';
+//function WinVerifyTrust(hwnd: HWND; const ActionID: TGUID; ActionData: Pointer): Longint;external 'imaghlp' name 'WinVerifyTrust';
+function WNetAddConnection2(var lpNetResource: TNetResource; lpPassword, lpUserName: PChar; dwFlags: DWORD): DWORD;external 'mpr' name 'WNetAddConnection2A';
+function WNetAddConnection2A(var lpNetResource: TNetResourceA; lpPassword, lpUserName: LPCSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection2A';
+//function WNetAddConnection2W(var lpNetResource: TNetResourceW; lpPassword, lpUserName: LPWSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection2W';
+function WNetAddConnection3(hwndOwner: HWND; var lpNetResource: TNetResource; lpPassword, lpUserName: PChar; dwFlags: DWORD): DWORD;external 'mpr' name 'WNetAddConnection3A';
+function WNetAddConnection3A(hwndOwner: HWND; var lpNetResource: TNetResourceA; lpPassword, lpUserName: LPCSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection3A';
+//function WNetAddConnection3W(hwndOwner: HWND; var lpNetResource: TNetResourceW; lpPassword, lpUserName: LPWSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection3W';
+function WNetConnectionDialog1(var lpConnDlgStruct: TConnectDlgStruct): DWORD;external 'mpr' name 'WNetConnectionDialog1A';
+function WNetConnectionDialog1A(var lpConnDlgStruct: TConnectDlgStruct): DWORD; external 'mpr' name 'WNetConnectionDialog1A';
+//function WNetConnectionDialog1W(var lpConnDlgStruct: TConnectDlgStruct): DWORD; external 'mpr' name 'WNetConnectionDialog1W';
+function WNetDisconnectDialog1(var lpConnDlgStruct: TDiscDlgStruct): DWORD;external 'mpr' name 'WNetDisconnectDialog1A';
+function WNetDisconnectDialog1A(var lpConnDlgStruct: TDiscDlgStructA): DWORD; external 'mpr' name 'WNetDisconnectDialog1A';
+//function WNetDisconnectDialog1W(var lpConnDlgStruct: TDiscDlgStructW): DWORD; external 'mpr' name 'WNetDisconnectDialog1W';
+function WNetEnumResource(hEnum: THandle; var lpcCount: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD;external 'mpr' name 'WNetEnumResourceA';
+function WNetEnumResourceA(hEnum: THandle; var lpcCount: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetEnumResourceA';
+function WNetEnumResourceW(hEnum: THandle; var lpcCount: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetEnumResourceW';
+function WNetGetConnection(lpLocalName: PChar; lpRemoteName: PChar; var lpnLength: DWORD): DWORD;external 'mpr' name 'WNetGetConnectionA';
+function WNetGetConnectionA(lpLocalName: LPCSTR; lpRemoteName: LPCSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetConnectionA';
+function WNetGetConnectionW(lpLocalName: LPWSTR; lpRemoteName: LPWSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetConnectionW';
+function WNetGetLastError(var lpError: DWORD; lpErrorBuf: PChar; nErrorBufSize: DWORD; lpNameBuf: PChar; nNameBufSize: DWORD): DWORD;external 'mpr' name 'WNetGetLastErrorA';
+function WNetGetLastErrorA(var lpError: DWORD; lpErrorBuf: LPCSTR; nErrorBufSize: DWORD; lpNameBuf: LPCSTR; nNameBufSize: DWORD): DWORD; external 'mpr' name 'WNetGetLastErrorA';
+function WNetGetLastErrorW(var lpError: DWORD; lpErrorBuf: LPWSTR; nErrorBufSize: DWORD; lpNameBuf: LPWSTR; nNameBufSize: DWORD): DWORD; external 'mpr' name 'WNetGetLastErrorW';
+function WNetGetNetworkInformation(lpProvider: PChar; var lpNetInfoStruct: TNetInfoStruct): DWORD;external 'mpr' name 'WNetGetNetworkInformationA';
+function WNetGetNetworkInformationA(lpProvider: LPCSTR; var lpNetInfoStruct: TNetInfoStruct): DWORD; external 'mpr' name 'WNetGetNetworkInformationA';
+function WNetGetNetworkInformationW(lpProvider: LPWSTR; var lpNetInfoStruct: TNetInfoStruct): DWORD; external 'mpr' name 'WNetGetNetworkInformationW';
+function WNetGetProviderName(dwNetType: DWORD; lpProviderName: PChar; var lpBufferSize: DWORD): DWORD;external 'mpr' name 'WNetGetProviderNameA';
+function WNetGetProviderNameA(dwNetType: DWORD; lpProviderName: LPCSTR; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetProviderNameA';
+function WNetGetProviderNameW(dwNetType: DWORD; lpProviderName: LPWSTR; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetProviderNameW';
+function WNetGetResourceParent(lpNetResource: PNetResource; lpBuffer: Pointer; var cbBuffer: DWORD): DWORD;external 'mpr' name 'WNetGetResourceParentA';
+function WNetGetResourceParentA(lpNetResource: PNetResourceA; lpBuffer: Pointer; var cbBuffer: DWORD): DWORD;external 'mpr' name 'WNetGetResourceParentA';
+//function WNetGetResourceParentW(lpNetResource: PNetResourceW; lpBuffer: Pointer; var cbBuffer: DWORD): DWORD;external 'mpr' name 'WNetGetResourceParentW';
+function WNetGetUniversalName(lpLocalPath: PChar; dwInfoLevel: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD;external 'mpr' name 'WNetGetUniversalNameA';
+function WNetGetUniversalNameA(lpLocalPath: LPCSTR; dwInfoLevel: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetUniversalNameA';
+function WNetGetUniversalNameW(lpLocalPath: LPWSTR; dwInfoLevel: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetUniversalNameW';
+function WNetGetUser(lpName: PChar; lpUserName: PChar; var lpnLength: DWORD): DWORD;external 'mpr' name 'WNetGetUserA';
+function WNetGetUserA(lpName: LPCSTR; lpUserName: LPCSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetUserA';
+function WNetGetUserW(lpName: LPWSTR; lpUserName: LPWSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetUserW';
+function WNetOpenEnum(dwScope, dwType, dwUsage: DWORD; lpNetResource: PNetResource; var lphEnum: THandle): DWORD;external 'mpr' name 'WNetOpenEnumA';
+function WNetOpenEnumA(dwScope, dwType, dwUsage: DWORD; lpNetResource: PNetResourceA; var lphEnum: THandle): DWORD; external 'mpr' name 'WNetOpenEnumA';
+//function WNetOpenEnumW(dwScope, dwType, dwUsage: DWORD; lpNetResource: PNetResourceW; var lphEnum: THandle): DWORD; external 'mpr' name 'WNetOpenEnumW';
+function WNetUseConnection(hwndOwner: HWND; var lpNetResource: TNetResource; lpUserID: PChar; lpPassword: PChar; dwFlags: DWORD; lpAccessName: PChar; var lpBufferSize: DWORD; var lpResult: DWORD): DWORD;external 'mpr' name 'WNetUseConnectionA';
+function WNetUseConnectionA(hwndOwner: HWND; var lpNetResource: TNetResourceA; lpUserID: LPCSTR; lpPassword: LPCSTR; dwFlags: DWORD; lpAccessName: LPCSTR; var lpBufferSize: DWORD; var lpResult: DWORD): DWORD; external 'mpr' name 'WNetUseConnectionA';
+//function WNetUseConnectionW(hwndOwner: HWND; var lpNetResource: TNetResourceW; lpUserID: LPWSTR; lpPassword: LPWSTR; dwFlags: DWORD; lpAccessName: LPWSTR; var lpBufferSize: DWORD; var lpResult: DWORD): DWORD; external 'mpr' name 'WNetUseConnectionW';
+function WriteConsole(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL;external 'kernel32' name 'WriteConsoleA';
+function WriteConsoleA(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'WriteConsoleA';
+function WriteConsoleInput(hConsoleInput: THandle; const lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsWritten: DWORD): BOOL;external 'kernel32' name 'WriteConsoleInputA';
+function WriteConsoleInputA(hConsoleInput: THandle; const lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleInputA';
+function WriteConsoleInputW(hConsoleInput: THandle; const lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleInputW';
+function WriteConsoleOutput(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL;external 'kernel32' name 'WriteConsoleOutputA';
+function WriteConsoleOutputA(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL; external 'kernel32' name 'WriteConsoleOutputA';
+function WriteConsoleOutputAttribute(hConsoleOutput: THandle; lpAttribute: Pointer; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfAttrsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputAttribute';
+function WriteConsoleOutputCharacter(hConsoleOutput: THandle;lpCharacter: PChar; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL;external 'kernel32' name 'WriteConsoleOutputCharacterA';
+function WriteConsoleOutputCharacterA(hConsoleOutput: THandle;lpCharacter: LPCSTR; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputCharacterA';
+function WriteConsoleOutputCharacterW(hConsoleOutput: THandle;lpCharacter: LPWSTR; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW';
+function WriteConsoleOutputW(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL; external 'kernel32' name 'WriteConsoleOutputW';
+function WriteConsoleW(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'WriteConsoleW';
+function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'WriteFile';
+function WriteFileEx(hFile: THandle; lpBuffer: Pointer; nNumberOfBytesToWrite: DWORD; const lpOverlapped: TOverlapped; lpCompletionRoutine: FARPROC): BOOL; external 'kernel32' name 'WriteFileEx';
+function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; external 'kernel32' name 'WriteProcessMemory';
+
+// these are old Win16 funcs that under win32 are aliases for several char* funcs.
+// exist under Win32 (even in SDK's from 2002), but are officially "depreciated"
+function AnsiNext(const lpsz: LPCSTR): LPSTR;external 'user32' name 'CharNextA';
+function AnsiPrev(const lpszStart: LPCSTR; const lpszCurrent: LPCSTR): LPSTR;external 'user32' name 'CharPrevA';
+function AnsiToOem(const lpszSrc: LPCSTR; lpszDst: LPSTR): BOOL;external 'user32' name 'CharToOemA';
+function OemToAnsi(const lpszSrc: LPCSTR; lpszDst: LPSTR): BOOL;external 'user32' name 'OemToCharA';
+function AnsiToOemBuff(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffA';
+function OemToAnsiBuff(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffA';
+function AnsiUpper(lpsz:LPSTR):LPSTR; external 'user32' name 'CharUpperA';
+function AnsiUpperBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharUpperBuffA';
+function AnsiLower(lpsz:LPSTR):LPSTR; external 'user32' name 'CharLowerA';
+function AnsiLowerBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharLowerBuffA';
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+function Succeeded(Status : HRESULT) : BOOL;
+ begin
+ Succeeded:=Status and HRESULT($80000000)=0;
+ end;
+
+function Failed(Status : HRESULT) : BOOL;
+ begin
+ Failed:=Status and HRESULT($80000000)<>0;
+ end;
+
+function IsError(Status : HRESULT) : BOOL;
+ begin
+ IsError:=(Status shr 31)=SEVERITY_ERROR;
+ end;
+
+function HResultCode(hr : HRESULT) : Longint;
+ begin
+ HResultCode:=hr and $0000ffff;
+ end;
+
+function HResultFacility(hr : HRESULT) : Longint;
+ begin
+ HResultFacility:=(hr shr 16) and $00001fff;
+ end;
+
+function HResultSeverity(hr : HRESULT) : Longint;
+ begin
+ HResultSeverity:=(hr shr 31) and $00000001;
+ end;
+
+function MakeResult(p1,p2,mask : Longint): HRESULT;
+ begin
+ MakeResult:=(p1 shl 31) or (p2 shl 16) or mask;
+ end;
+
+function HResultFromWin32(x : Longint) : HRESULT;
+ begin
+ HResultFromWin32:=x;
+ if HResultFromWin32<>0 then
+ HResultFromWin32:=((HResultFromWin32 and $0000ffff) or
+ (FACILITY_WIN32 shl 16) or HRESULT($80000000));
+ end;
+
+function HResultFromNT(x : Longint) : HRESULT;
+ begin
+ HResultFromNT:=x or FACILITY_NT_BIT;
+ end;
+
+function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
+begin
+ MAKELANGID := (SubLang shl 10) or PrimaryLang;
+end;
+
+function PRIMARYLANGID(LangId: WORD): WORD;
+begin
+ PRIMARYLANGID := LangId and $3FF;
+end;
+
+function SUBLANGID(LangId: WORD): WORD;
+begin
+ SUBLANGID := LangId shr 10;
+end;
+
+function MAKELCID(LangId, SortId: WORD): DWORD;
+begin
+ MAKELCID := (DWORD(SortId) shl 16) or DWORD(LangId);
+end;
+
+function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD;
+begin
+ MAKESORTLCID := MAKELCID(LangId, SortId) or (SortVersion shl 20);
+end;
+
+function LANGIDFROMLCID(LocaleId: LCID): WORD;
+begin
+ LANGIDFROMLCID := WORD(LocaleId);
+end;
+
+function SORTIDFROMLCID(LocaleId: LCID): WORD;
+begin
+ SORTIDFROMLCID := WORD((DWORD(LocaleId) shr 16) and $F);
+end;
+
+function SORTVERSIONFROMLCID(LocaleId: LCID): WORD;
+begin
+ SORTVERSIONFROMLCID := WORD((DWORD(LocaleId) shr 20) and $F);
+end;
+
+function LANG_SYSTEM_DEFAULT: WORD;
+begin
+ LANG_SYSTEM_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT);
+end;
+
+function LANG_USER_DEFAULT: WORD;
+begin
+ LANG_USER_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
+end;
+
+function LOCALE_NEUTRAL: DWORD;
+begin
+ LOCALE_NEUTRAL := MAKELCID(MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT);
+end;
+
+function LOCALE_INVARIANT: DWORD;
+begin
+ LOCALE_INVARIANT := MAKELCID(MAKELANGID(LANG_INVARIANT, SUBLANG_NEUTRAL), SORT_DEFAULT);
+end;
+
+{$endif read_implementation}
+
+{
+ $Log: redef.inc,v $
+ Revision 1.31 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.30 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.29 2005/01/15 11:44:48 marco
+ * scrollwindow(ex) added at Neli's request
+
+}
diff --git a/rtl/win32/wininc/struct.inc b/rtl/win32/wininc/struct.inc
new file mode 100644
index 0000000000..57bd38913f
--- /dev/null
+++ b/rtl/win32/wininc/struct.inc
@@ -0,0 +1,7220 @@
+{
+ $Id: struct.inc,v 1.36 2005/02/26 15:06:25 florian Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the record definition for the Win32 API
+ Copyright (c) 1999-2000 by Florian KLaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ Structures.h
+
+ Declarations for all the Windows32 API Structures
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+ Date: 1996
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+ type
+
+ { WARNING
+ the variable argument list
+ is not implemented for FPC
+ va_list is just a dummy record
+ MvdV: Nevertheless it should be a pointer type, not a record}
+
+ va_list = pchar;
+
+ ABC = record
+ abcA : longint;
+ abcB : UINT;
+ abcC : longint;
+ end;
+ LPABC = ^ABC;
+ _ABC = ABC;
+ TABC = ABC;
+ PABC = ^ABC;
+
+ ABCFLOAT = record
+ abcfA : Single;
+ abcfB : Single;
+ abcfC : Single;
+ end;
+ LPABCFLOAT = ^ABCFLOAT;
+ _ABCFLOAT = ABCFLOAT;
+ TABCFLOAT = ABCFLOAT;
+ PABCFLOAT = ^ABCFLOAT;
+
+ ACCEL = record
+ fVirt : BYTE;
+ key : WORD;
+ cmd : WORD;
+ end;
+ LPACCEL = ^ACCEL;
+ _ACCEL = ACCEL;
+ TACCEL = ACCEL;
+ PACCEL = ^ACCEL;
+
+ ACE_HEADER = record
+ AceType : BYTE;
+ AceFlags : BYTE;
+ AceSize : WORD;
+ end;
+ _ACE_HEADER = ACE_HEADER;
+ TACE_HEADER = ACE_HEADER;
+ PACE_HEADER = ^ACE_HEADER;
+
+ ACCESS_MASK = DWORD;
+
+ REGSAM = ACCESS_MASK;
+
+ ACCESS_ALLOWED_ACE = record
+ Header : ACE_HEADER;
+ Mask : ACCESS_MASK;
+ SidStart : DWORD;
+ end;
+ _ACCESS_ALLOWED_ACE = ACCESS_ALLOWED_ACE;
+ TACCESS_ALLOWED_ACE = ACCESS_ALLOWED_ACE;
+ PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;
+
+ ACCESS_DENIED_ACE = record
+ Header : ACE_HEADER;
+ Mask : ACCESS_MASK;
+ SidStart : DWORD;
+ end;
+ _ACCESS_DENIED_ACE = ACCESS_DENIED_ACE;
+ TACCESS_DENIED_ACE = ACCESS_DENIED_ACE;
+
+ ACCESSTIMEOUT = record
+ cbSize : UINT;
+ dwFlags : DWORD;
+ iTimeOutMSec : DWORD;
+ end;
+ _ACCESSTIMEOUT = ACCESSTIMEOUT;
+ TACCESSTIMEOUT = ACCESSTIMEOUT;
+ PACCESSTIMEOUT = ^ACCESSTIMEOUT;
+
+ ACL = record
+ AclRevision : BYTE;
+ Sbz1 : BYTE;
+ AclSize : WORD;
+ AceCount : WORD;
+ Sbz2 : WORD;
+ end;
+ PACL = ^ACL;
+ _ACL = ACL;
+ TACL = ACL;
+
+ ACL_REVISION_INFORMATION = record
+ AclRevision : DWORD;
+ end;
+ _ACL_REVISION_INFORMATION = ACL_REVISION_INFORMATION;
+ TACLREVISIONINFORMATION = ACL_REVISION_INFORMATION;
+ PACLREVISIONINFORMATION = ^ACL_REVISION_INFORMATION;
+
+ ACL_SIZE_INFORMATION = record
+ AceCount : DWORD;
+ AclBytesInUse : DWORD;
+ AclBytesFree : DWORD;
+ end;
+ _ACL_SIZE_INFORMATION = ACL_SIZE_INFORMATION;
+ TACLSIZEINFORMATION = ACL_SIZE_INFORMATION;
+ PACLSIZEINFORMATION = ^ACL_SIZE_INFORMATION;
+
+ ACTION_HEADER = record
+ transport_id : ULONG;
+ action_code : USHORT;
+ reserved : USHORT;
+ end;
+ _ACTION_HEADER = ACTION_HEADER;
+ TACTIONHEADER = ACTION_HEADER;
+ PACTIONHEADER = ^ACTION_HEADER;
+
+ ADAPTER_STATUS = record
+ adapter_address : array[0..5] of UCHAR;
+ rev_major : UCHAR;
+ reserved0 : UCHAR;
+ adapter_type : UCHAR;
+ rev_minor : UCHAR;
+ duration : WORD;
+ frmr_recv : WORD;
+ frmr_xmit : WORD;
+ iframe_recv_err : WORD;
+ xmit_aborts : WORD;
+ xmit_success : DWORD;
+ recv_success : DWORD;
+ iframe_xmit_err : WORD;
+ recv_buff_unavail : WORD;
+ t1_timeouts : WORD;
+ ti_timeouts : WORD;
+ reserved1 : DWORD;
+ free_ncbs : WORD;
+ max_cfg_ncbs : WORD;
+ max_ncbs : WORD;
+ xmit_buf_unavail : WORD;
+ max_dgram_size : WORD;
+ pending_sess : WORD;
+ max_cfg_sess : WORD;
+ max_sess : WORD;
+ max_sess_pkt_size : WORD;
+ name_count : WORD;
+ end;
+ _ADAPTER_STATUS = ADAPTER_STATUS;
+ TADAPTERSTATUS = ADAPTER_STATUS;
+ PADAPTERSTATUS = ^ADAPTER_STATUS;
+
+ ADDJOB_INFO_1 = record
+ Path : LPTSTR;
+ JobId : DWORD;
+ end;
+ _ADDJOB_INFO_1 = ADDJOB_INFO_1;
+ TADDJOB_INFO_1 = ADDJOB_INFO_1;
+ PADDJOB_INFO_1 = ^ADDJOB_INFO_1;
+
+ ANIMATIONINFO = record
+ cbSize : UINT;
+ iMinAnimate : longint;
+ end;
+ LPANIMATIONINFO = ^ANIMATIONINFO;
+ _ANIMATIONINFO = ANIMATIONINFO;
+ TANIMATIONINFO = ANIMATIONINFO;
+ PANIMATIONINFO = ^ANIMATIONINFO;
+
+ POINT = record
+ x : LONG;
+ y : LONG;
+ end;
+ LPPOINT = ^POINT;
+ tagPOINT = POINT;
+ TPOINT = POINT;
+ PPOINT = ^POINT;
+
+ RECT = record
+ case Integer of
+ 0: (Left,Top,Right,Bottom : Longint);
+ 1: (TopLeft,BottomRight : TPoint);
+ end;
+ LPRECT = ^RECT;
+ _RECT = RECT;
+ TRECT = RECT;
+ PRECT = ^RECT;
+
+ RECTL = record
+ left : LONG;
+ top : LONG;
+ right : LONG;
+ bottom : LONG;
+ end;
+ _RECTL = RECTL;
+ TRECTL = RECTL;
+ PRECTL = ^RECTL;
+
+ APPBARDATA = record
+ cbSize : DWORD;
+ hWnd : HWND;
+ uCallbackMessage : UINT;
+ uEdge : UINT;
+ rc : RECT;
+ lParam : LPARAM;
+ end;
+ _AppBarData = APPBARDATA;
+ TAppBarData = APPBARDATA;
+ PAppBarData = ^APPBARDATA;
+
+ BITMAP = record
+ bmType : LONG;
+ bmWidth : LONG;
+ bmHeight : LONG;
+ bmWidthBytes : LONG;
+ bmPlanes : WORD;
+ bmBitsPixel : WORD;
+ bmBits : LPVOID;
+ end;
+ PBITMAP = ^BITMAP;
+ NPBITMAP = ^BITMAP;
+ LPBITMAP = ^BITMAP;
+ tagBITMAP = BITMAP;
+ TBITMAP = BITMAP;
+
+ BITMAPCOREHEADER = record
+ bcSize : DWORD;
+ bcWidth : WORD;
+ bcHeight : WORD;
+ bcPlanes : WORD;
+ bcBitCount : WORD;
+ end;
+ tagBITMAPCOREHEADER = BITMAPCOREHEADER;
+ TBITMAPCOREHEADER = BITMAPCOREHEADER;
+ PBITMAPCOREHEADER = ^BITMAPCOREHEADER;
+
+ RGBTRIPLE = record
+ rgbtBlue : BYTE;
+ rgbtGreen : BYTE;
+ rgbtRed : BYTE;
+ end;
+ tagRGBTRIPLE = RGBTRIPLE;
+ TRGBTRIPLE = RGBTRIPLE;
+ PRGBTRIPLE = ^RGBTRIPLE;
+
+ BITMAPCOREINFO = record
+ bmciHeader : BITMAPCOREHEADER;
+ bmciColors : array[0..0] of RGBTRIPLE;
+ end;
+ PBITMAPCOREINFO = ^BITMAPCOREINFO;
+ LPBITMAPCOREINFO = ^BITMAPCOREINFO;
+ _BITMAPCOREINFO = BITMAPCOREINFO;
+ TBITMAPCOREINFO = BITMAPCOREINFO;
+
+(* error
+ WORD bfReserved1;
+ WORD bfReserved2;
+ in declarator_list *)
+
+ BITMAPINFOHEADER = record
+ biSize : DWORD;
+ biWidth : LONG;
+ biHeight : LONG;
+ biPlanes : WORD;
+ biBitCount : WORD;
+ biCompression : DWORD;
+ biSizeImage : DWORD;
+ biXPelsPerMeter : LONG;
+ biYPelsPerMeter : LONG;
+ biClrUsed : DWORD;
+ biClrImportant : DWORD;
+ end;
+ LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+ TBITMAPINFOHEADER = BITMAPINFOHEADER;
+ PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+
+ RGBQUAD = record
+ rgbBlue : BYTE;
+ rgbGreen : BYTE;
+ rgbRed : BYTE;
+ rgbReserved : BYTE;
+ end;
+ tagRGBQUAD = RGBQUAD;
+ TRGBQUAD = RGBQUAD;
+ PRGBQUAD = ^RGBQUAD;
+
+ BITMAPINFO = record
+ bmiHeader : BITMAPINFOHEADER;
+ bmiColors : array[0..0] of RGBQUAD;
+ end;
+ LPBITMAPINFO = ^BITMAPINFO;
+ PBITMAPINFO = ^BITMAPINFO;
+ TBITMAPINFO = BITMAPINFO;
+
+ FXPT2DOT30 = longint;
+ LPFXPT2DOT30 = ^FXPT2DOT30;
+ TPFXPT2DOT30 = FXPT2DOT30;
+ PPFXPT2DOT30 = ^FXPT2DOT30;
+
+ CIEXYZ = record
+ ciexyzX : FXPT2DOT30;
+ ciexyzY : FXPT2DOT30;
+ ciexyzZ : FXPT2DOT30;
+ end;
+ tagCIEXYZ = CIEXYZ;
+ LPCIEXYZ = ^CIEXYZ;
+ TPCIEXYZ = CIEXYZ;
+ PCIEXYZ = ^CIEXYZ;
+
+ CIEXYZTRIPLE = record
+ ciexyzRed : CIEXYZ;
+ ciexyzGreen : CIEXYZ;
+ ciexyzBlue : CIEXYZ;
+ end;
+ tagCIEXYZTRIPLE = CIEXYZTRIPLE;
+ LPCIEXYZTRIPLE = ^CIEXYZTRIPLE;
+ TCIEXYZTRIPLE = CIEXYZTRIPLE;
+ PCIEXYZTRIPLE = ^CIEXYZTRIPLE;
+
+ BITMAPV4HEADER = record
+ bV4Size : DWORD;
+ bV4Width : LONG;
+ bV4Height : LONG;
+ bV4Planes : WORD;
+ bV4BitCount : WORD;
+ bV4V4Compression : DWORD;
+ bV4SizeImage : DWORD;
+ bV4XPelsPerMeter : LONG;
+ bV4YPelsPerMeter : LONG;
+ bV4ClrUsed : DWORD;
+ bV4ClrImportant : DWORD;
+ bV4RedMask : DWORD;
+ bV4GreenMask : DWORD;
+ bV4BlueMask : DWORD;
+ bV4AlphaMask : DWORD;
+ bV4CSType : DWORD;
+ bV4Endpoints : CIEXYZTRIPLE;
+ bV4GammaRed : DWORD;
+ bV4GammaGreen : DWORD;
+ bV4GammaBlue : DWORD;
+ end;
+ LPBITMAPV4HEADER = ^BITMAPV4HEADER;
+ TBITMAPV4HEADER = BITMAPV4HEADER;
+ PBITMAPV4HEADER = ^BITMAPV4HEADER;
+
+ BITMAPFILEHEADER = packed record
+ bfType : Word;
+ bfSize : DWord;
+ bfReserved1 : Word;
+ bfReserved2 : Word;
+ bfOffBits : DWord;
+ end;
+
+ BLOB = record
+ cbSize : ULONG;
+ pBlobData : ^BYTE;
+ end;
+ _BLOB = BLOB;
+ TBLOB = BLOB;
+ PBLOB = ^BLOB;
+
+ SHITEMID = record
+ cb : USHORT;
+ abID : array[0..0] of BYTE;
+ end;
+ LPSHITEMID = ^SHITEMID;
+ LPCSHITEMID = ^SHITEMID;
+ _SHITEMID = SHITEMID;
+ TSHITEMID = SHITEMID;
+ PSHITEMID = ^SHITEMID;
+
+ ITEMIDLIST = record
+ mkid : SHITEMID;
+ end;
+ LPITEMIDLIST = ^ITEMIDLIST;
+ LPCITEMIDLIST = ^ITEMIDLIST;
+ _ITEMIDLIST = ITEMIDLIST;
+ TITEMIDLIST = ITEMIDLIST;
+ PITEMIDLIST = ^ITEMIDLIST;
+
+ BROWSEINFO = record
+ hwndOwner : HWND;
+ pidlRoot : LPCITEMIDLIST;
+ pszDisplayName : LPSTR;
+ lpszTitle : LPCSTR;
+ ulFlags : UINT;
+ lpfn : BFFCALLBACK;
+ lParam : LPARAM;
+ iImage : longint;
+ end;
+ LPBROWSEINFO = ^BROWSEINFO;
+ _browseinfo = BROWSEINFO;
+ Tbrowseinfo = BROWSEINFO;
+ PBROWSEINFO = ^BROWSEINFO;
+
+ FILETIME = record
+ dwLowDateTime : DWORD;
+ dwHighDateTime : DWORD;
+ end;
+ LPFILETIME = ^FILETIME;
+ _FILETIME = FILETIME;
+ TFILETIME = FILETIME;
+ PFILETIME = ^FILETIME;
+
+ BY_HANDLE_FILE_INFORMATION = record
+ dwFileAttributes : DWORD;
+ ftCreationTime : FILETIME;
+ ftLastAccessTime : FILETIME;
+ ftLastWriteTime : FILETIME;
+ dwVolumeSerialNumber : DWORD;
+ nFileSizeHigh : DWORD;
+ nFileSizeLow : DWORD;
+ nNumberOfLinks : DWORD;
+ nFileIndexHigh : DWORD;
+ nFileIndexLow : DWORD;
+ end;
+ LPBY_HANDLE_FILE_INFORMATION = ^BY_HANDLE_FILE_INFORMATION;
+ _BY_HANDLE_FILE_INFORMATION = BY_HANDLE_FILE_INFORMATION;
+ TBYHANDLEFILEINFORMATION = BY_HANDLE_FILE_INFORMATION;
+ PBYHANDLEFILEINFORMATION = ^BY_HANDLE_FILE_INFORMATION;
+
+ FIXED = record
+ fract : WORD;
+ value : integer;
+ end;
+ _FIXED = FIXED;
+ TFIXED = FIXED;
+ PFIXED = ^FIXED;
+
+ POINTFX = record
+ x : FIXED;
+ y : FIXED;
+ end;
+ tagPOINTFX = POINTFX;
+ TPOINTFX = POINTFX;
+ PPOINTFX = ^POINTFX;
+
+ POINTL = record
+ x : LONG;
+ y : LONG;
+ end;
+ _POINTL = POINTL;
+ TPOINTL = POINTL;
+ PPOINTL = ^POINTL;
+
+ TSmallPoint = record
+ X,
+ Y : SmallInt;
+ end;
+
+
+ POINTS = record
+ x : SHORT;
+ y : SHORT;
+ end;
+ tagPOINTS = POINTS;
+ TPOINTS = POINTS;
+ PPOINTS = ^POINTS;
+
+ CANDIDATEFORM = record
+ dwIndex : DWORD;
+ dwStyle : DWORD;
+ ptCurrentPos : POINT;
+ rcArea : RECT;
+ end;
+ LPCANDIDATEFORM = ^CANDIDATEFORM;
+ _tagCANDIDATEFORM = CANDIDATEFORM;
+ TCANDIDATEFORM = CANDIDATEFORM;
+ PCANDIDATEFORM = ^CANDIDATEFORM;
+
+ CANDIDATELIST = record
+ dwSize : DWORD;
+ dwStyle : DWORD;
+ dwCount : DWORD;
+ dwSelection : DWORD;
+ dwPageStart : DWORD;
+ dwPageSize : DWORD;
+ dwOffset : array[0..0] of DWORD;
+ end;
+ LPCANDIDATELIST = ^CANDIDATELIST;
+ _tagCANDIDATELIST = CANDIDATELIST;
+ TCANDIDATELIST = CANDIDATELIST;
+ PCANDIDATELIST = ^CANDIDATELIST;
+
+ CREATESTRUCT = record
+ lpCreateParams : LPVOID;
+ hInstance : HINST;
+ hMenu : HMENU;
+ hwndParent : HWND;
+ cy : longint;
+ cx : longint;
+ y : longint;
+ x : longint;
+ style : LONG;
+ lpszName : LPCTSTR;
+ lpszClass : LPCTSTR;
+ dwExStyle : DWORD;
+ end;
+ LPCREATESTRUCT = ^CREATESTRUCT;
+ tagCREATESTRUCT = CREATESTRUCT;
+ TCREATESTRUCT = CREATESTRUCT;
+ PCREATESTRUCT = ^CREATESTRUCT;
+
+ CBT_CREATEWND = record
+ lpcs : LPCREATESTRUCT;
+ hwndInsertAfter : HWND;
+ end;
+ tagCBT_CREATEWND = CBT_CREATEWND;
+ TCBT_CREATEWND = CBT_CREATEWND;
+ PCBT_CREATEWND = ^CBT_CREATEWND;
+
+ CBTACTIVATESTRUCT = record
+ fMouse : WINBOOL;
+ hWndActive : HWND;
+ end;
+ tagCBTACTIVATESTRUCT = CBTACTIVATESTRUCT;
+ TCBTACTIVATESTRUCT = CBTACTIVATESTRUCT;
+ PCBTACTIVATESTRUCT = ^CBTACTIVATESTRUCT;
+
+
+ CHAR_INFO = record
+ case longint of
+ 0 : ( UnicodeChar : WCHAR;
+ Attributes : Word);
+ 1 : ( AsciiChar : CHAR );
+ end;
+ _CHAR_INFO = CHAR_INFO;
+ TCHAR_INFO = CHAR_INFO;
+ PCHAR_INFO = ^CHAR_INFO;
+
+ CHARFORMAT = record
+ cbSize : UINT;
+ dwMask : DWORD;
+ dwEffects : DWORD;
+ yHeight : LONG;
+ yOffset : LONG;
+ crTextColor : COLORREF;
+ bCharSet : BYTE;
+ bPitchAndFamily : BYTE;
+ szFaceName : array[0..(LF_FACESIZE)-1] of TCHAR;
+ end;
+ _charformat = CHARFORMAT;
+ Tcharformat = CHARFORMAT;
+ Pcharformat = ^CHARFORMAT;
+
+ CHARRANGE = record
+ cpMin : LONG;
+ cpMax : LONG;
+ end;
+ _charrange = CHARRANGE;
+ Tcharrange = CHARRANGE;
+ Pcharrange = ^CHARRANGE;
+
+ CHARSET = record
+ aflBlock : array[0..2] of DWORD;
+ flLang : DWORD;
+ end;
+ tagCHARSET = CHARSET;
+ TCHARSET = CHARSET;
+ PCHARSET = ^CHARSET;
+
+ FONTSIGNATURE = record
+ fsUsb : array[0..3] of DWORD;
+ fsCsb : array[0..1] of DWORD;
+ end;
+ LPFONTSIGNATURE = ^FONTSIGNATURE;
+ tagFONTSIGNATURE = FONTSIGNATURE;
+ TFONTSIGNATURE = FONTSIGNATURE;
+ PFONTSIGNATURE = ^FONTSIGNATURE;
+
+ CHARSETINFO = record
+ ciCharset : UINT;
+ ciACP : UINT;
+ fs : FONTSIGNATURE;
+ end;
+ LPCHARSETINFO = ^CHARSETINFO;
+ TCHARSETINFO = CHARSETINFO;
+ PCHARSETINFO = ^CHARSETINFO;
+
+ {CHOOSECOLOR = record confilcts with function ChooseColor }
+ TCHOOSECOLOR = record
+ lStructSize : DWORD;
+ hwndOwner : HWND;
+ hInstance : HWND;
+ rgbResult : COLORREF;
+ lpCustColors : ^COLORREF;
+ Flags : DWORD;
+ lCustData : LPARAM;
+ lpfnHook : LPCCHOOKPROC;
+ lpTemplateName : LPCTSTR;
+ end;
+ LPCHOOSECOLOR = ^TCHOOSECOLOR;
+ PCHOOSECOLOR = ^TCHOOSECOLOR;
+
+ LOGFONT = record
+ lfHeight : LONG;
+ lfWidth : LONG;
+ lfEscapement : LONG;
+ lfOrientation : LONG;
+ lfWeight : LONG;
+ lfItalic : BYTE;
+ lfUnderline : BYTE;
+ lfStrikeOut : BYTE;
+ lfCharSet : BYTE;
+ lfOutPrecision : BYTE;
+ lfClipPrecision : BYTE;
+ lfQuality : BYTE;
+ lfPitchAndFamily : BYTE;
+ lfFaceName : array[0..(LF_FACESIZE)-1] of TCHAR;
+ end;
+ LPLOGFONT = ^LOGFONT;
+ TLOGFONT = LOGFONT;
+ TLOGFONTA = LOGFONT;
+ PLOGFONT = ^LOGFONT;
+ PLOGFONTA = PLOGFONT;
+
+ LOGFONTW = record
+ lfHeight: LONG;
+ lfWidth: LONG;
+ lfEscapement: LONG;
+ lfOrientation: LONG;
+ lfWeight: LONG;
+ lfItalic: BYTE;
+ lfUnderline: BYTE;
+ lfStrikeOut: BYTE;
+ lfCharSet: BYTE;
+ lfOutPrecision: BYTE;
+ lfClipPrecision: BYTE;
+ lfQuality: BYTE;
+ lfPitchAndFamily: BYTE;
+ lfFaceName: array [0..LF_FACESIZE - 1] of WCHAR;
+ end;
+ LPLOGFONTW = ^LOGFONTW;
+ NPLOGFONTW = ^LOGFONTW;
+ TLogFontW = LOGFONTW;
+ PLogFontW = ^TLogFontW;
+
+ {CHOOSEFONT = record conflicts with ChosseFont function }
+ TCHOOSEFONT = record
+ lStructSize : DWORD;
+ hwndOwner : HWND;
+ hDC : HDC;
+ lpLogFont : LPLOGFONT;
+ iPointSize : WINT;
+ Flags : DWORD;
+ rgbColors : DWORD;
+ lCustData : LPARAM;
+ lpfnHook : LPCFHOOKPROC;
+ lpTemplateName : LPCTSTR;
+ hInstance : HINST;
+ lpszStyle : LPTSTR;
+ nFontType : WORD;
+ ___MISSING_ALIGNMENT__ : WORD;
+ nSizeMin : WINT;
+ nSizeMax : WINT;
+ end;
+ LPCHOOSEFONT = ^TCHOOSEFONT;
+ PCHOOSEFONT = ^TCHOOSEFONT;
+
+ CIDA = record
+ cidl : UINT;
+ aoffset : array[0..0] of UINT;
+ end;
+ LPIDA = ^CIDA;
+ _IDA = CIDA;
+ TIDA = CIDA;
+ PIDA = ^CIDA;
+
+ CLIENTCREATESTRUCT = record
+ hWindowMenu : HANDLE;
+ idFirstChild : UINT;
+ end;
+ LPCLIENTCREATESTRUCT = ^CLIENTCREATESTRUCT;
+ tagCLIENTCREATESTRUCT = CLIENTCREATESTRUCT;
+ TCLIENTCREATESTRUCT = CLIENTCREATESTRUCT;
+ PCLIENTCREATESTRUCT = ^CLIENTCREATESTRUCT;
+
+ CMINVOKECOMMANDINFO = record
+ cbSize : DWORD;
+ fMask : DWORD;
+ hwnd : HWND;
+ lpVerb : LPCSTR;
+ lpParameters : LPCSTR;
+ lpDirectory : LPCSTR;
+ nShow : longint;
+ dwHotKey : DWORD;
+ hIcon : HANDLE;
+ end;
+ LPCMINVOKECOMMANDINFO = ^CMINVOKECOMMANDINFO;
+ _CMInvokeCommandInfo = CMINVOKECOMMANDINFO;
+ TCMInvokeCommandInfo = CMINVOKECOMMANDINFO;
+ PCMInvokeCommandInfo = ^CMINVOKECOMMANDINFO;
+
+ COLORADJUSTMENT = record
+ caSize : WORD;
+ caFlags : WORD;
+ caIlluminantIndex : WORD;
+ caRedGamma : WORD;
+ caGreenGamma : WORD;
+ caBlueGamma : WORD;
+ caReferenceBlack : WORD;
+ caReferenceWhite : WORD;
+ caContrast : SHORT;
+ caBrightness : SHORT;
+ caColorfulness : SHORT;
+ caRedGreenTint : SHORT;
+ end;
+ LPCOLORADJUSTMENT = ^COLORADJUSTMENT;
+ tagCOLORADJUSTMENT = COLORADJUSTMENT;
+ TCOLORADJUSTMENT = COLORADJUSTMENT;
+ PCOLORADJUSTMENT = ^COLORADJUSTMENT;
+
+ COLORMAP = record
+ from : COLORREF;
+ _to : COLORREF;
+ end;
+ LPCOLORMAP = ^COLORMAP;
+ _COLORMAP = COLORMAP;
+ TCOLORMAP = COLORMAP;
+ PCOLORMAP = ^COLORMAP;
+
+ DCB = record
+ DCBlength : DWORD;
+ BaudRate : DWORD;
+ flags : DWORD;
+ wReserved : WORD;
+ XonLim : WORD;
+ XoffLim : WORD;
+ ByteSize : BYTE;
+ Parity : BYTE;
+ StopBits : BYTE;
+ XonChar : char;
+ XoffChar : char;
+ ErrorChar : char;
+ EofChar : char;
+ EvtChar : char;
+ wReserved1 : WORD;
+ end;
+ LPDCB = ^DCB;
+ _DCB = DCB;
+ TDCB = DCB;
+ PDCB = ^DCB;
+
+ const
+ bm_DCB_fBinary = $1;
+ bp_DCB_fBinary = 0;
+ bm_DCB_fParity = $2;
+ bp_DCB_fParity = 1;
+ bm_DCB_fOutxCtsFlow = $4;
+ bp_DCB_fOutxCtsFlow = 2;
+ bm_DCB_fOutxDsrFlow = $8;
+ bp_DCB_fOutxDsrFlow = 3;
+ bm_DCB_fDtrControl = $30;
+ bp_DCB_fDtrControl = 4;
+ bm_DCB_fDsrSensitivity = $40;
+ bp_DCB_fDsrSensitivity = 6;
+ bm_DCB_fTXContinueOnXoff = $80;
+ bp_DCB_fTXContinueOnXoff = 7;
+ bm_DCB_fOutX = $100;
+ bp_DCB_fOutX = 8;
+ bm_DCB_fInX = $200;
+ bp_DCB_fInX = 9;
+ bm_DCB_fErrorChar = $400;
+ bp_DCB_fErrorChar = 10;
+ bm_DCB_fNull = $800;
+ bp_DCB_fNull = 11;
+ bm_DCB_fRtsControl = $3000;
+ bp_DCB_fRtsControl = 12;
+ bm_DCB_fAbortOnError = $4000;
+ bp_DCB_fAbortOnError = 14;
+ bm_DCB_fDummy2 = $FFFF8000;
+ bp_DCB_fDummy2 = 15;
+ function fBinary(var a : DCB) : DWORD;
+ procedure set_fBinary(var a : DCB; __fBinary : DWORD);
+ function fParity(var a : DCB) : DWORD;
+ procedure set_fParity(var a : DCB; __fParity : DWORD);
+ function fOutxCtsFlow(var a : DCB) : DWORD;
+ procedure set_fOutxCtsFlow(var a : DCB; __fOutxCtsFlow : DWORD);
+ function fOutxDsrFlow(var a : DCB) : DWORD;
+ procedure set_fOutxDsrFlow(var a : DCB; __fOutxDsrFlow : DWORD);
+ function fDtrControl(var a : DCB) : DWORD;
+ procedure set_fDtrControl(var a : DCB; __fDtrControl : DWORD);
+ function fDsrSensitivity(var a : DCB) : DWORD;
+ procedure set_fDsrSensitivity(var a : DCB; __fDsrSensitivity : DWORD);
+ function fTXContinueOnXoff(var a : DCB) : DWORD;
+ procedure set_fTXContinueOnXoff(var a : DCB; __fTXContinueOnXoff : DWORD);
+ function fOutX(var a : DCB) : DWORD;
+ procedure set_fOutX(var a : DCB; __fOutX : DWORD);
+ function fInX(var a : DCB) : DWORD;
+ procedure set_fInX(var a : DCB; __fInX : DWORD);
+ function fErrorChar(var a : DCB) : DWORD;
+ procedure set_fErrorChar(var a : DCB; __fErrorChar : DWORD);
+ function fNull(var a : DCB) : DWORD;
+ procedure set_fNull(var a : DCB; __fNull : DWORD);
+ function fRtsControl(var a : DCB) : DWORD;
+ procedure set_fRtsControl(var a : DCB; __fRtsControl : DWORD);
+ function fAbortOnError(var a : DCB) : DWORD;
+ procedure set_fAbortOnError(var a : DCB; __fAbortOnError : DWORD);
+ function fDummy2(var a : DCB) : DWORD;
+ procedure set_fDummy2(var a : DCB; __fDummy2 : DWORD);
+
+ type
+
+ COMMCONFIG = record
+ dwSize : DWORD;
+ wVersion : WORD;
+ wReserved : WORD;
+ dcb : DCB;
+ dwProviderSubType : DWORD;
+ dwProviderOffset : DWORD;
+ dwProviderSize : DWORD;
+ wcProviderData : array[0..0] of WCHAR;
+ end;
+ LPCOMMCONFIG = ^COMMCONFIG;
+ _COMM_CONFIG = COMMCONFIG;
+ TCOMMCONFIG = COMMCONFIG;
+ PCOMMCONFIG = ^COMMCONFIG;
+
+ COMMPROP = record
+ wPacketLength : WORD;
+ wPacketVersion : WORD;
+ dwServiceMask : DWORD;
+ dwReserved1 : DWORD;
+ dwMaxTxQueue : DWORD;
+ dwMaxRxQueue : DWORD;
+ dwMaxBaud : DWORD;
+ dwProvSubType : DWORD;
+ dwProvCapabilities : DWORD;
+ dwSettableParams : DWORD;
+ dwSettableBaud : DWORD;
+ wSettableData : WORD;
+ wSettableStopParity : WORD;
+ dwCurrentTxQueue : DWORD;
+ dwCurrentRxQueue : DWORD;
+ dwProvSpec1 : DWORD;
+ dwProvSpec2 : DWORD;
+ wcProvChar : array[0..0] of WCHAR;
+ end;
+ LPCOMMPROP = ^COMMPROP;
+ _COMMPROP = COMMPROP;
+ TCOMMPROP = COMMPROP;
+ PCOMMPROP = ^COMMPROP;
+
+ COMMTIMEOUTS = record
+ ReadIntervalTimeout : DWORD;
+ ReadTotalTimeoutMultiplier : DWORD;
+ ReadTotalTimeoutConstant : DWORD;
+ WriteTotalTimeoutMultiplier : DWORD;
+ WriteTotalTimeoutConstant : DWORD;
+ end;
+ LPCOMMTIMEOUTS = ^COMMTIMEOUTS;
+ _COMMTIMEOUTS = COMMTIMEOUTS;
+ TCOMMTIMEOUTS = COMMTIMEOUTS;
+ PCOMMTIMEOUTS = ^COMMTIMEOUTS;
+
+ COMPAREITEMSTRUCT = record
+ CtlType : UINT;
+ CtlID : UINT;
+ hwndItem : HWND;
+ itemID1 : UINT;
+ itemData1 : DWORD;
+ itemID2 : UINT;
+ itemData2 : DWORD;
+ end;
+ tagCOMPAREITEMSTRUCT = COMPAREITEMSTRUCT;
+ TCOMPAREITEMSTRUCT = COMPAREITEMSTRUCT;
+ PCOMPAREITEMSTRUCT = ^COMPAREITEMSTRUCT;
+
+ COMPCOLOR = record
+ crText : COLORREF;
+ crBackground : COLORREF;
+ dwEffects : DWORD;
+ end;
+ TCOMPCOLOR = COMPCOLOR;
+ PCOMPCOLOR = ^COMPCOLOR;
+
+ COMPOSITIONFORM = record
+ dwStyle : DWORD;
+ ptCurrentPos : POINT;
+ rcArea : RECT;
+ end;
+ LPCOMPOSITIONFORM = ^COMPOSITIONFORM;
+ _tagCOMPOSITIONFORM = COMPOSITIONFORM;
+ TCOMPOSITIONFORM = COMPOSITIONFORM;
+ PCOMPOSITIONFORM = ^COMPOSITIONFORM;
+
+// TComStatFlags = set of (fCtsHold, fDsrHold, fRlsdHold , fXoffHold ,
+// fXoffSent , fEof , fTxim , fReserved);
+
+ COMSTAT = record
+ flag0 : DWORD; // can't use tcomstatflags, set packing issues
+ // and conflicts with macro's
+ cbInQue : DWORD;
+ cbOutQue : DWORD;
+ end;
+ LPCOMSTAT = ^COMSTAT;
+ _COMSTAT = COMSTAT;
+ TCOMSTAT = COMSTAT;
+ PCOMSTAT = ^COMSTAT;
+ const
+ bm_COMSTAT_fCtsHold = $1;
+ bp_COMSTAT_fCtsHold = 0;
+ bm_COMSTAT_fDsrHold = $2;
+ bp_COMSTAT_fDsrHold = 1;
+ bm_COMSTAT_fRlsdHold = $4;
+ bp_COMSTAT_fRlsdHold = 2;
+ bm_COMSTAT_fXoffHold = $8;
+ bp_COMSTAT_fXoffHold = 3;
+ bm_COMSTAT_fXoffSent = $10;
+ bp_COMSTAT_fXoffSent = 4;
+ bm_COMSTAT_fEof = $20;
+ bp_COMSTAT_fEof = 5;
+ bm_COMSTAT_fTxim = $40;
+ bp_COMSTAT_fTxim = 6;
+ bm_COMSTAT_fReserved = $FFFFFF80;
+ bp_COMSTAT_fReserved = 7;
+ function fCtsHold(var a : COMSTAT) : DWORD; // should be renamed to get_<x>?
+ procedure set_fCtsHold(var a : COMSTAT; __fCtsHold : DWORD);
+ function fDsrHold(var a : COMSTAT) : DWORD;
+ procedure set_fDsrHold(var a : COMSTAT; __fDsrHold : DWORD);
+ function fRlsdHold(var a : COMSTAT) : DWORD;
+ procedure set_fRlsdHold(var a : COMSTAT; __fRlsdHold : DWORD);
+ function fXoffHold(var a : COMSTAT) : DWORD;
+ procedure set_fXoffHold(var a : COMSTAT; __fXoffHold : DWORD);
+ function fXoffSent(var a : COMSTAT) : DWORD;
+ procedure set_fXoffSent(var a : COMSTAT; __fXoffSent : DWORD);
+ function fEof(var a : COMSTAT) : DWORD;
+ procedure set_fEof(var a : COMSTAT; __fEof : DWORD);
+ function fTxim(var a : COMSTAT) : DWORD;
+ procedure set_fTxim(var a : COMSTAT; __fTxim : DWORD);
+ function fReserved(var a : COMSTAT) : DWORD;
+ procedure set_fReserved(var a : COMSTAT; __fReserved : DWORD);
+
+ type
+
+ CONSOLE_CURSOR_INFO = record
+ dwSize : DWORD;
+ bVisible : WINBOOL;
+ end;
+ PCONSOLE_CURSOR_INFO = ^CONSOLE_CURSOR_INFO;
+ _CONSOLE_CURSOR_INFO = CONSOLE_CURSOR_INFO;
+ TCONSOLECURSORINFO = CONSOLE_CURSOR_INFO;
+ PCONSOLECURSORINFO = ^CONSOLE_CURSOR_INFO;
+ TCURSORINFO = CONSOLE_CURSOR_INFO;
+
+ COORD = record
+ X : SHORT;
+ Y : SHORT;
+ end;
+ _COORD = COORD;
+ TCOORD = COORD;
+ PCOORD = ^COORD;
+
+ SMALL_RECT = record
+ Left : SHORT;
+ Top : SHORT;
+ Right : SHORT;
+ Bottom : SHORT;
+ end;
+ _SMALL_RECT = SMALL_RECT;
+ TSMALL_RECT = SMALL_RECT;
+ PSMALL_RECT = ^SMALL_RECT;
+
+ CONSOLE_SCREEN_BUFFER_INFO = packed record
+ dwSize : COORD;
+ dwCursorPosition : COORD;
+ wAttributes : WORD;
+ srWindow : SMALL_RECT;
+ dwMaximumWindowSize : COORD;
+ end;
+ PCONSOLE_SCREEN_BUFFER_INFO = ^CONSOLE_SCREEN_BUFFER_INFO;
+ _CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO;
+ TCONSOLESCREENBUFFERINFO = CONSOLE_SCREEN_BUFFER_INFO;
+ PCONSOLESCREENBUFFERINFO = ^CONSOLE_SCREEN_BUFFER_INFO;
+
+{$ifdef __i386__}
+ type
+
+ FLOATING_SAVE_AREA = record
+ ControlWord : DWORD;
+ StatusWord : DWORD;
+ TagWord : DWORD;
+ ErrorOffset : DWORD;
+ ErrorSelector : DWORD;
+ DataOffset : DWORD;
+ DataSelector : DWORD;
+ RegisterArea : array[0..79] of BYTE;
+ Cr0NpxState : DWORD;
+ end;
+ _FLOATING_SAVE_AREA = FLOATING_SAVE_AREA;
+ TFLOATINGSAVEAREA = FLOATING_SAVE_AREA;
+ PFLOATINGSAVEAREA = ^FLOATING_SAVE_AREA;
+
+ CONTEXT = record
+ ContextFlags : DWORD;
+ Dr0 : DWORD;
+ Dr1 : DWORD;
+ Dr2 : DWORD;
+ Dr3 : DWORD;
+ Dr6 : DWORD;
+ Dr7 : DWORD;
+ FloatSave : FLOATING_SAVE_AREA;
+ SegGs : DWORD;
+ SegFs : DWORD;
+ SegEs : DWORD;
+ SegDs : DWORD;
+ Edi : DWORD;
+ Esi : DWORD;
+ Ebx : DWORD;
+ Edx : DWORD;
+ Ecx : DWORD;
+ Eax : DWORD;
+ Ebp : DWORD;
+ Eip : DWORD;
+ SegCs : DWORD;
+ EFlags : DWORD;
+ Esp : DWORD;
+ SegSs : DWORD;
+ end;
+ LPCONTEXT = ^CONTEXT;
+ _CONTEXT = CONTEXT;
+ TCONTEXT = CONTEXT;
+ PCONTEXT = ^CONTEXT;
+
+{$else}
+ { __ppc__ }
+ { Floating point registers returned when CONTEXT_FLOATING_POINT is set }
+ { Integer registers returned when CONTEXT_INTEGER is set. }
+ { Condition register }
+ { Fixed point exception register }
+ { The following are set when CONTEXT_CONTROL is set. }
+ { Machine status register }
+ { Instruction address register }
+ { Link register }
+ { Control register }
+ { Control which context values are returned }
+ { Registers returned if CONTEXT_DEBUG_REGISTERS is set. }
+ { Breakpoint Register 1 }
+ { Breakpoint Register 2 }
+ { Breakpoint Register 3 }
+ { Breakpoint Register 4 }
+ { Breakpoint Register 5 }
+ { Breakpoint Register 6 }
+ { Debug Status Register }
+ { Debug Control Register }
+
+ type
+
+ CONTEXT = record
+ Fpr0 : double;
+ Fpr1 : double;
+ Fpr2 : double;
+ Fpr3 : double;
+ Fpr4 : double;
+ Fpr5 : double;
+ Fpr6 : double;
+ Fpr7 : double;
+ Fpr8 : double;
+ Fpr9 : double;
+ Fpr10 : double;
+ Fpr11 : double;
+ Fpr12 : double;
+ Fpr13 : double;
+ Fpr14 : double;
+ Fpr15 : double;
+ Fpr16 : double;
+ Fpr17 : double;
+ Fpr18 : double;
+ Fpr19 : double;
+ Fpr20 : double;
+ Fpr21 : double;
+ Fpr22 : double;
+ Fpr23 : double;
+ Fpr24 : double;
+ Fpr25 : double;
+ Fpr26 : double;
+ Fpr27 : double;
+ Fpr28 : double;
+ Fpr29 : double;
+ Fpr30 : double;
+ Fpr31 : double;
+ Fpscr : double;
+ Gpr0 : DWORD;
+ Gpr1 : DWORD;
+ Gpr2 : DWORD;
+ Gpr3 : DWORD;
+ Gpr4 : DWORD;
+ Gpr5 : DWORD;
+ Gpr6 : DWORD;
+ Gpr7 : DWORD;
+ Gpr8 : DWORD;
+ Gpr9 : DWORD;
+ Gpr10 : DWORD;
+ Gpr11 : DWORD;
+ Gpr12 : DWORD;
+ Gpr13 : DWORD;
+ Gpr14 : DWORD;
+ Gpr15 : DWORD;
+ Gpr16 : DWORD;
+ Gpr17 : DWORD;
+ Gpr18 : DWORD;
+ Gpr19 : DWORD;
+ Gpr20 : DWORD;
+ Gpr21 : DWORD;
+ Gpr22 : DWORD;
+ Gpr23 : DWORD;
+ Gpr24 : DWORD;
+ Gpr25 : DWORD;
+ Gpr26 : DWORD;
+ Gpr27 : DWORD;
+ Gpr28 : DWORD;
+ Gpr29 : DWORD;
+ Gpr30 : DWORD;
+ Gpr31 : DWORD;
+ Cr : DWORD;
+ Xer : DWORD;
+ Msr : DWORD;
+ Iar : DWORD;
+ Lr : DWORD;
+ Ctr : DWORD;
+ ContextFlags : DWORD;
+ Fill : array[0..2] of DWORD;
+ Dr0 : DWORD;
+ Dr1 : DWORD;
+ Dr2 : DWORD;
+ Dr3 : DWORD;
+ Dr4 : DWORD;
+ Dr5 : DWORD;
+ Dr6 : DWORD;
+ Dr7 : DWORD;
+ end;
+ LPCONTEXT = ^CONTEXT;
+ TCONTEXT = CONTEXT;
+ PCONTEXT = ^CONTEXT;
+
+{$endif}
+
+ type
+
+ LIST_ENTRY = record
+ Flink : ^_LIST_ENTRY;
+ Blink : ^_LIST_ENTRY;
+ end;
+ _LIST_ENTRY = LIST_ENTRY;
+ TLISTENTRY = LIST_ENTRY;
+ PLISTENTRY = ^LIST_ENTRY;
+
+ CRITICAL_SECTION_DEBUG = record
+ _Type : WORD;
+ CreatorBackTraceIndex : WORD;
+ CriticalSection : ^_CRITICAL_SECTION;
+ ProcessLocksList : LIST_ENTRY;
+ EntryCount : DWORD;
+ ContentionCount : DWORD;
+ Depth : DWORD;
+ OwnerBackTrace : array[0..4] of PVOID;
+ end;
+ LPCRITICAL_SECTION_DEBUG = ^CRITICAL_SECTION_DEBUG;
+ PCRITICAL_SECTION_DEBUG = ^CRITICAL_SECTION_DEBUG;
+ _CRITICAL_SECTION_DEBUG = CRITICAL_SECTION_DEBUG;
+ TCRITICALSECTIONDEBUG = CRITICAL_SECTION_DEBUG;
+ PCRITICALSECTIONDEBUG = ^CRITICAL_SECTION_DEBUG;
+
+ CRITICAL_SECTION = TRTLCriticalSection;
+ _CRITICAL_SECTION = TRTLCriticalSection;
+ TCRITICAL_SECTION = TRTLCriticalSection;
+ PCRITICAL_SECTION = PRTLCriticalSection;
+ LPCRITICAL_SECTION = PRTLCriticalSection;
+ TCRITICALSECTION = TRTLCriticalSection;
+ PCRITICALSECTION = PRTLCriticalSection;
+
+ { SECURITY_CONTEXT_TRACKING_MODE ContextTrackingMode; }
+
+ SECURITY_QUALITY_OF_SERVICE = record
+ Length : DWORD;
+ ImpersonationLevel : SECURITY_IMPERSONATION_LEVEL;
+ ContextTrackingMode : WINBOOL;
+ EffectiveOnly : BOOLEAN;
+ end;
+ PSECURITY_QUALITY_OF_SERVICE = ^SECURITY_QUALITY_OF_SERVICE;
+ _SECURITY_QUALITY_OF_SERVICE = SECURITY_QUALITY_OF_SERVICE;
+ TSECURITYQUALITYOFSERVICE = SECURITY_QUALITY_OF_SERVICE;
+ PSECURITYQUALITYOFSERVICE = ^SECURITY_QUALITY_OF_SERVICE;
+
+ CONVCONTEXT = record
+ cb : UINT;
+ wFlags : UINT;
+ wCountryID : UINT;
+ iCodePage : longint;
+ dwLangID : DWORD;
+ dwSecurity : DWORD;
+ qos : SECURITY_QUALITY_OF_SERVICE;
+ end;
+ tagCONVCONTEXT = CONVCONTEXT;
+ TCONVCONTEXT = CONVCONTEXT;
+ PCONVCONTEXT = ^CONVCONTEXT;
+
+ CONVINFO = record
+ cb : DWORD;
+ hUser : DWORD;
+ hConvPartner : HCONV;
+ hszSvcPartner : HSZ;
+ hszServiceReq : HSZ;
+ hszTopic : HSZ;
+ hszItem : HSZ;
+ wFmt : UINT;
+ wType : UINT;
+ wStatus : UINT;
+ wConvst : UINT;
+ wLastError : UINT;
+ hConvList : HCONVLIST;
+ ConvCtxt : CONVCONTEXT;
+ _hwnd : HWND;
+ hwndPartner : HWND;
+ end;
+ tagCONVINFO = CONVINFO;
+ TCONVINFO = CONVINFO;
+ PCONVINFO = ^CONVINFO;
+
+ COPYDATASTRUCT = record
+ dwData : DWORD;
+ cbData : DWORD;
+ lpData : PVOID;
+ end;
+ tagCOPYDATASTRUCT = COPYDATASTRUCT;
+ TCOPYDATASTRUCT = COPYDATASTRUCT;
+ PCOPYDATASTRUCT = ^COPYDATASTRUCT;
+
+ CPINFO = record
+ MaxCharSize : UINT;
+ DefaultChar : array[0..(MAX_DEFAULTCHAR)-1] of BYTE;
+ LeadByte : array[0..(MAX_LEADBYTES)-1] of BYTE;
+ end;
+ LPCPINFO = ^CPINFO;
+ _cpinfo = CPINFO;
+ Tcpinfo = CPINFO;
+ Pcpinfo = ^CPINFO;
+
+ CPLINFO = record
+ idIcon : longint;
+ idName : longint;
+ idInfo : longint;
+ lData : LONG;
+ end;
+ tagCPLINFO = CPLINFO;
+ TCPLINFO = CPLINFO;
+ PCPLINFO = ^CPLINFO;
+
+ CREATE_PROCESS_DEBUG_INFO = record
+ hFile : HANDLE;
+ hProcess : HANDLE;
+ hThread : HANDLE;
+ lpBaseOfImage : LPVOID;
+ dwDebugInfoFileOffset : DWORD;
+ nDebugInfoSize : DWORD;
+ lpThreadLocalBase : LPVOID;
+ lpStartAddress : LPTHREAD_START_ROUTINE;
+ lpImageName : LPVOID;
+ fUnicode : WORD;
+ end;
+ _CREATE_PROCESS_DEBUG_INFO = CREATE_PROCESS_DEBUG_INFO;
+ TCREATEPROCESSDEBUGINFO = CREATE_PROCESS_DEBUG_INFO;
+ PCREATEPROCESSDEBUGINFO = ^CREATE_PROCESS_DEBUG_INFO;
+
+ CREATE_THREAD_DEBUG_INFO = record
+ hThread : HANDLE;
+ lpThreadLocalBase : LPVOID;
+ lpStartAddress : LPTHREAD_START_ROUTINE;
+ end;
+ _CREATE_THREAD_DEBUG_INFO = CREATE_THREAD_DEBUG_INFO;
+ TCREATETHREADDEBUGINFO = CREATE_THREAD_DEBUG_INFO;
+ PCREATETHREADDEBUGINFO = ^CREATE_THREAD_DEBUG_INFO;
+ (*
+ TODO: sockets
+ typedef struct _SOCKET_ADDRESS {
+ LPSOCKADDR lpSockaddr ;
+ INT iSockaddrLength ;
+ } SOCKET_ADDRESS, PSOCKET_ADDRESS, LPSOCKET_ADDRESS;
+ }
+ {
+ typedef struct _CSADDR_INFO {
+ SOCKET_ADDRESS LocalAddr;
+ SOCKET_ADDRESS RemoteAddr;
+ INT iSocketType;
+ INT iProtocol;
+ } CSADDR_INFO;
+ *)
+
+ CURRENCYFMT = record
+ NumDigits : UINT;
+ LeadingZero : UINT;
+ Grouping : UINT;
+ lpDecimalSep : LPTSTR;
+ lpThousandSep : LPTSTR;
+ NegativeOrder : UINT;
+ PositiveOrder : UINT;
+ lpCurrencySymbol : LPTSTR;
+ end;
+ _currencyfmt = CURRENCYFMT;
+ Tcurrencyfmt = CURRENCYFMT;
+ Pcurrencyfmt = ^CURRENCYFMT;
+
+ CURSORSHAPE = record
+ xHotSpot : longint;
+ yHotSpot : longint;
+ cx : longint;
+ cy : longint;
+ cbWidth : longint;
+ Planes : BYTE;
+ BitsPixel : BYTE;
+ end;
+ LPCURSORSHAPE = ^CURSORSHAPE;
+ tagCURSORSHAPE = CURSORSHAPE;
+ TCURSORSHAPE = CURSORSHAPE;
+ PCURSORSHAPE = ^CURSORSHAPE;
+
+ CWPRETSTRUCT = record
+ lResult : LRESULT;
+ lParam : LPARAM;
+ wParam : WPARAM;
+ message : DWORD;
+ hwnd : HWND;
+ end;
+ tagCWPRETSTRUCT = CWPRETSTRUCT;
+ TCWPRETSTRUCT = CWPRETSTRUCT;
+ PCWPRETSTRUCT = ^CWPRETSTRUCT;
+
+ CWPSTRUCT = record
+ lParam : LPARAM;
+ wParam : WPARAM;
+ message : UINT;
+ hwnd : HWND;
+ end;
+ tagCWPSTRUCT = CWPSTRUCT;
+ TCWPSTRUCT = CWPSTRUCT;
+ PCWPSTRUCT = ^CWPSTRUCT;
+
+ DATATYPES_INFO_1 = record
+ pName : LPTSTR;
+ end;
+ _DATATYPES_INFO_1 = DATATYPES_INFO_1;
+ TDATATYPESINFO1 = DATATYPES_INFO_1;
+ PDATATYPESINFO1 = ^DATATYPES_INFO_1;
+
+ DDEACK = record
+ flag0 : word;
+ end;
+ TDDEACK = DDEACK;
+ PDDEACK = ^DDEACK;
+ const
+ bm_DDEACK_bAppReturnCode = $FF;
+ bp_DDEACK_bAppReturnCode = 0;
+ bm_DDEACK_reserved = $3F00;
+ bp_DDEACK_reserved = 8;
+ bm_DDEACK_fBusy = $4000;
+ bp_DDEACK_fBusy = 14;
+ bm_DDEACK_fAck = $8000;
+ bp_DDEACK_fAck = 15;
+ function bAppReturnCode(var a : DDEACK) : word;
+ procedure set_bAppReturnCode(var a : DDEACK; __bAppReturnCode : word);
+ function reserved(var a : DDEACK) : word;
+ procedure set_reserved(var a : DDEACK; __reserved : word);
+ function fBusy(var a : DDEACK) : word;
+ procedure set_fBusy(var a : DDEACK; __fBusy : word);
+ function fAck(var a : DDEACK) : word;
+ procedure set_fAck(var a : DDEACK; __fAck : word);
+
+ type
+
+ DDEADVISE = record
+ flag0 : word;
+ cfFormat : integer;
+ end;
+ TDDEADVISE = DDEADVISE;
+ PDDEADVISE = ^DDEADVISE;
+ const
+ bm_DDEADVISE_reserved = $3FFF;
+ bp_DDEADVISE_reserved = 0;
+ bm_DDEADVISE_fDeferUpd = $4000;
+ bp_DDEADVISE_fDeferUpd = 14;
+ bm_DDEADVISE_fAckReq = $8000;
+ bp_DDEADVISE_fAckReq = 15;
+ function reserved(var a : DDEADVISE) : word;
+ procedure set_reserved(var a : DDEADVISE; __reserved : word);
+ function fDeferUpd(var a : DDEADVISE) : word;
+ procedure set_fDeferUpd(var a : DDEADVISE; __fDeferUpd : word);
+ function fAckReq(var a : DDEADVISE) : word;
+ procedure set_fAckReq(var a : DDEADVISE; __fAckReq : word);
+
+ type
+
+ DDEDATA = record
+ flag0 : word;
+ cfFormat : integer;
+ Value : array[0..0] of BYTE;
+ end;
+ PDDEDATA = ^DDEDATA;
+ const
+ bm_DDEDATA_unused = $FFF;
+ bp_DDEDATA_unused = 0;
+ bm_DDEDATA_fResponse = $1000;
+ bp_DDEDATA_fResponse = 12;
+ bm_DDEDATA_fRelease = $2000;
+ bp_DDEDATA_fRelease = 13;
+ bm_DDEDATA_reserved = $4000;
+ bp_DDEDATA_reserved = 14;
+ bm_DDEDATA_fAckReq = $8000;
+ bp_DDEDATA_fAckReq = 15;
+ function unused(var a : DDEDATA) : word;
+ procedure set_unused(var a : DDEDATA; __unused : word);
+ function fResponse(var a : DDEDATA) : word;
+ procedure set_fResponse(var a : DDEDATA; __fResponse : word);
+ function fRelease(var a : DDEDATA) : word;
+ procedure set_fRelease(var a : DDEDATA; __fRelease : word);
+ function reserved(var a : DDEDATA) : word;
+ procedure set_reserved(var a : DDEDATA; __reserved : word);
+ function fAckReq(var a : DDEDATA) : word;
+ procedure set_fAckReq(var a : DDEDATA; __fAckReq : word);
+
+ type
+
+ DDELN = record
+ flag0 : word;
+ cfFormat : integer;
+ end;
+ TDDELN = DDELN;
+ PDDELN = ^DDELN;
+ const
+ bm_DDELN_unused = $1FFF;
+ bp_DDELN_unused = 0;
+ bm_DDELN_fRelease = $2000;
+ bp_DDELN_fRelease = 13;
+ bm_DDELN_fDeferUpd = $4000;
+ bp_DDELN_fDeferUpd = 14;
+ bm_DDELN_fAckReq = $8000;
+ bp_DDELN_fAckReq = 15;
+ function unused(var a : DDELN) : word;
+ procedure set_unused(var a : DDELN; __unused : word);
+ function fRelease(var a : DDELN) : word;
+ procedure set_fRelease(var a : DDELN; __fRelease : word);
+ function fDeferUpd(var a : DDELN) : word;
+ procedure set_fDeferUpd(var a : DDELN; __fDeferUpd : word);
+ function fAckReq(var a : DDELN) : word;
+ procedure set_fAckReq(var a : DDELN; __fAckReq : word);
+
+ type
+
+ DDEML_MSG_HOOK_DATA = record
+ uiLo : UINT;
+ uiHi : UINT;
+ cbData : DWORD;
+ Data : array[0..7] of DWORD;
+ end;
+ tagDDEML_MSG_HOOK_DATA = DDEML_MSG_HOOK_DATA;
+ TDDEMLMSGHOOKDATA = DDEML_MSG_HOOK_DATA;
+ PDDEMLMSGHOOKDATA = ^DDEML_MSG_HOOK_DATA;
+
+ DDEPOKE = record
+ flag0 : word;
+ cfFormat : integer;
+ Value : array[0..0] of BYTE;
+ end;
+ TDDEPOKE = DDEPOKE;
+ PDDEPOKE = ^DDEPOKE;
+ const
+ bm_DDEPOKE_unused = $1FFF;
+ bp_DDEPOKE_unused = 0;
+ bm_DDEPOKE_fRelease = $2000;
+ bp_DDEPOKE_fRelease = 13;
+ bm_DDEPOKE_fReserved = $C000;
+ bp_DDEPOKE_fReserved = 14;
+ function unused(var a : DDEPOKE) : word;
+ procedure set_unused(var a : DDEPOKE; __unused : word);
+ function fRelease(var a : DDEPOKE) : word;
+ procedure set_fRelease(var a : DDEPOKE; __fRelease : word);
+ function fReserved(var a : DDEPOKE) : word;
+ procedure set_fReserved(var a : DDEPOKE; __fReserved : word);
+
+ type
+
+ DDEUP = record
+ flag0 : word;
+ cfFormat : integer;
+ rgb : array[0..0] of BYTE;
+ end;
+ TDDEUP = DDEUP;
+ PDDEUP = ^DDEUP;
+ const
+ bm_DDEUP_unused = $FFF;
+ bp_DDEUP_unused = 0;
+ bm_DDEUP_fAck = $1000;
+ bp_DDEUP_fAck = 12;
+ bm_DDEUP_fRelease = $2000;
+ bp_DDEUP_fRelease = 13;
+ bm_DDEUP_fReserved = $4000;
+ bp_DDEUP_fReserved = 14;
+ bm_DDEUP_fAckReq = $8000;
+ bp_DDEUP_fAckReq = 15;
+ function unused(var a : DDEUP) : word;
+ procedure set_unused(var a : DDEUP; __unused : word);
+ function fAck(var a : DDEUP) : word;
+ procedure set_fAck(var a : DDEUP; __fAck : word);
+ function fRelease(var a : DDEUP) : word;
+ procedure set_fRelease(var a : DDEUP; __fRelease : word);
+ function fReserved(var a : DDEUP) : word;
+ procedure set_fReserved(var a : DDEUP; __fReserved : word);
+ function fAckReq(var a : DDEUP) : word;
+ procedure set_fAckReq(var a : DDEUP; __fAckReq : word);
+
+ type
+
+ EXCEPTION_RECORD = record
+ ExceptionCode : DWORD;
+ ExceptionFlags : DWORD;
+ ExceptionRecord : ^_EXCEPTION_RECORD;
+ ExceptionAddress : PVOID;
+ NumberParameters : DWORD;
+ ExceptionInformation : array[0..(EXCEPTION_MAXIMUM_PARAMETERS)-1] of DWORD;
+ end;
+ PEXCEPTION_RECORD = ^EXCEPTION_RECORD;
+ _EXCEPTION_RECORD = EXCEPTION_RECORD;
+ TEXCEPTIONRECORD = EXCEPTION_RECORD;
+ PEXCEPTIONRECORD = ^EXCEPTION_RECORD;
+
+ EXCEPTION_DEBUG_INFO = record
+ ExceptionRecord : EXCEPTION_RECORD;
+ dwFirstChance : DWORD;
+ end;
+ PEXCEPTION_DEBUG_INFO = ^EXCEPTION_DEBUG_INFO;
+ _EXCEPTION_DEBUG_INFO = EXCEPTION_DEBUG_INFO;
+ TEXCEPTIONDEBUGINFO = EXCEPTION_DEBUG_INFO;
+ PEXCEPTIONDEBUGINFO = ^EXCEPTION_DEBUG_INFO;
+
+ EXIT_PROCESS_DEBUG_INFO = record
+ dwExitCode : DWORD;
+ end;
+ _EXIT_PROCESS_DEBUG_INFO = EXIT_PROCESS_DEBUG_INFO;
+ TEXITPROCESSDEBUGINFO = EXIT_PROCESS_DEBUG_INFO;
+ PEXITPROCESSDEBUGINFO = ^EXIT_PROCESS_DEBUG_INFO;
+
+
+ EXIT_THREAD_DEBUG_INFO = record
+ dwExitCode : DWORD;
+ end;
+ _EXIT_THREAD_DEBUG_INFO = EXIT_THREAD_DEBUG_INFO;
+ TEXITTHREADDEBUGINFO = EXIT_THREAD_DEBUG_INFO;
+ PEXITTHREADDEBUGINFO = ^EXIT_THREAD_DEBUG_INFO;
+
+ LOAD_DLL_DEBUG_INFO = record
+ hFile : HANDLE;
+ lpBaseOfDll : LPVOID;
+ dwDebugInfoFileOffset : DWORD;
+ nDebugInfoSize : DWORD;
+ lpImageName : LPVOID;
+ fUnicode : WORD;
+ end;
+ _LOAD_DLL_DEBUG_INFO = LOAD_DLL_DEBUG_INFO;
+ TLOADDLLDEBUGINFO = LOAD_DLL_DEBUG_INFO;
+ PLOADDLLDEBUGINFO = ^LOAD_DLL_DEBUG_INFO;
+
+ UNLOAD_DLL_DEBUG_INFO = record
+ lpBaseOfDll : LPVOID;
+ end;
+ _UNLOAD_DLL_DEBUG_INFO = UNLOAD_DLL_DEBUG_INFO;
+ TUNLOADDLLDEBUGINFO = UNLOAD_DLL_DEBUG_INFO;
+ PUNLOADDLLDEBUGINFO = ^UNLOAD_DLL_DEBUG_INFO;
+
+ OUTPUT_DEBUG_STRING_INFO = record
+ lpDebugStringData : LPSTR;
+ fUnicode : WORD;
+ nDebugStringLength : WORD;
+ end;
+ _OUTPUT_DEBUG_STRING_INFO = OUTPUT_DEBUG_STRING_INFO;
+ TOUTPUTDEBUGSTRINGINFO = OUTPUT_DEBUG_STRING_INFO;
+ POUTPUTDEBUGSTRINGINFO = ^OUTPUT_DEBUG_STRING_INFO;
+
+ RIP_INFO = record
+ dwError : DWORD;
+ dwType : DWORD;
+ end;
+ _RIP_INFO = RIP_INFO;
+ TRIPINFO = RIP_INFO;
+ PRIPINFO = ^RIP_INFO;
+
+ DEBUG_EVENT = record
+ dwDebugEventCode : DWORD;
+ dwProcessId : DWORD;
+ dwThreadId : DWORD;
+ u : record
+ case longint of
+ 0 : ( Exception : EXCEPTION_DEBUG_INFO );
+ 1 : ( CreateThread : CREATE_THREAD_DEBUG_INFO );
+ 2 : ( CreateProcessInfo : CREATE_PROCESS_DEBUG_INFO );
+ 3 : ( ExitThread : EXIT_THREAD_DEBUG_INFO );
+ 4 : ( ExitProcess : EXIT_PROCESS_DEBUG_INFO );
+ 5 : ( LoadDll : LOAD_DLL_DEBUG_INFO );
+ 6 : ( UnloadDll : UNLOAD_DLL_DEBUG_INFO );
+ 7 : ( DebugString : OUTPUT_DEBUG_STRING_INFO );
+ 8 : ( RipInfo : RIP_INFO );
+ end;
+ end;
+ LPDEBUG_EVENT = ^DEBUG_EVENT;
+ _DEBUG_EVENT = DEBUG_EVENT;
+ TDEBUGEVENT = DEBUG_EVENT;
+ PDEBUGEVENT = ^DEBUG_EVENT;
+
+ DEBUGHOOKINFO = record
+ idThread : DWORD;
+ idThreadInstaller : DWORD;
+ lParam : LPARAM;
+ wParam : WPARAM;
+ code : longint;
+ end;
+ tagDEBUGHOOKINFO = DEBUGHOOKINFO;
+ TDEBUGHOOKINFO = DEBUGHOOKINFO;
+ PDEBUGHOOKINFO = ^DEBUGHOOKINFO;
+
+ DELETEITEMSTRUCT = record
+ CtlType : UINT;
+ CtlID : UINT;
+ itemID : UINT;
+ hwndItem : HWND;
+ itemData : UINT;
+ end;
+ tagDELETEITEMSTRUCT = DELETEITEMSTRUCT;
+ TDELETEITEMSTRUCT = DELETEITEMSTRUCT;
+ PDELETEITEMSTRUCT = ^DELETEITEMSTRUCT;
+
+ DEV_BROADCAST_HDR = record
+ dbch_size : ULONG;
+ dbch_devicetype : ULONG;
+ dbch_reserved : ULONG;
+ end;
+ PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
+ _DEV_BROADCAST_HDR = DEV_BROADCAST_HDR;
+ TDEVBROADCASTHDR = DEV_BROADCAST_HDR;
+ PDEVBROADCASTHDR = ^DEV_BROADCAST_HDR;
+
+ DEV_BROADCAST_OEM = record
+ dbco_size : ULONG;
+ dbco_devicetype : ULONG;
+ dbco_reserved : ULONG;
+ dbco_identifier : ULONG;
+ dbco_suppfunc : ULONG;
+ end;
+ PDEV_BROADCAST_OEM = ^DEV_BROADCAST_OEM;
+ _DEV_BROADCAST_OEM = DEV_BROADCAST_OEM;
+ TDEVBROADCASTOEM = DEV_BROADCAST_OEM;
+ PDEVBROADCASTOEM = ^DEV_BROADCAST_OEM;
+
+ DEV_BROADCAST_PORT = record
+ dbcp_size : ULONG;
+ dbcp_devicetype : ULONG;
+ dbcp_reserved : ULONG;
+ dbcp_name : array[0..0] of char;
+ end;
+ PDEV_BROADCAST_PORT = ^DEV_BROADCAST_PORT;
+ _DEV_BROADCAST_PORT = DEV_BROADCAST_PORT;
+ TDEVBROADCASTPORT = DEV_BROADCAST_PORT;
+ PDEVBROADCASTPORT = ^DEV_BROADCAST_PORT;
+
+ _DEV_BROADCAST_USERDEFINED = record
+ dbud_dbh : _DEV_BROADCAST_HDR;
+ dbud_szName : array[0..0] of char;
+ dbud_rgbUserDefined : array[0..0] of BYTE;
+ end;
+ TDEVBROADCASTUSERDEFINED = _DEV_BROADCAST_USERDEFINED;
+ PDEVBROADCASTUSERDEFINED = ^_DEV_BROADCAST_USERDEFINED;
+
+ DEV_BROADCAST_VOLUME = record
+ dbcv_size : ULONG;
+ dbcv_devicetype : ULONG;
+ dbcv_reserved : ULONG;
+ dbcv_unitmask : ULONG;
+ dbcv_flags : USHORT;
+ end;
+ PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
+ _DEV_BROADCAST_VOLUME = DEV_BROADCAST_VOLUME;
+ TDEVBROADCASTVOLUME = DEV_BROADCAST_VOLUME;
+ PDEVBROADCASTVOLUME = ^DEV_BROADCAST_VOLUME;
+
+ DEVMODE = record
+ dmDeviceName : array[0..(CCHDEVICENAME)-1] of BCHAR;
+ dmSpecVersion : WORD;
+ dmDriverVersion : WORD;
+ dmSize : WORD;
+ dmDriverExtra : WORD;
+ dmFields : DWORD;
+ case byte of
+ 1: (dmOrientation : SmallInt;
+ dmPaperSize : SmallInt;
+ dmPaperLength : SmallInt;
+ dmPaperWidth : SmallInt;
+ dmScale : SmallInt;
+ dmCopies : SmallInt;
+ dmDefaultSource : SmallInt;
+ dmPrintQuality : SmallInt;
+ dmColor : SmallInt;
+ dmDuplex : SmallInt;
+ dmYResolution : SmallInt;
+ dmTTOption : SmallInt;
+ dmCollate : SmallInt;
+ dmFormName : array[0..(CCHFORMNAME)-1] of BCHAR;
+ dmLogPixels : WORD;
+ dmBitsPerPel : DWORD;
+ dmPelsWidth : DWORD;
+ dmPelsHeight : DWORD;
+ dmDisplayFlags : DWORD;
+ dmDisplayFrequency : DWORD;
+ dmICMMethod : DWORD;
+ dmICMIntent : DWORD;
+ dmMediaType : DWORD;
+ dmDitherType : DWORD;
+ dmICCManufacturer : DWORD;
+ dmICCModel : DWORD
+ );
+ 2: (dmPosition: POINTL;
+ dmDisplayOrientation: DWORD;
+ dmDisplayFixedOutput: DWORD;
+ );
+ end;
+
+ LPDEVMODE = ^DEVMODE;
+ _devicemode = DEVMODE;
+ devicemode = DEVMODE;
+ tdevicemode = DEVMODE;
+ tdevicemodeA = DEVMODE;
+ PDeviceModeA = LPDEVMODE;
+ PDeviceMode = LPDEVMODE;
+ TDEVMODE = DEVMODE;
+ PDEVMODE = LPDEVMODE;
+
+
+ devmodeW = record
+ dmDeviceName : array[0.. CCHDEVICENAME-1] of WCHAR;
+ dmSpecVersion : WORD;
+ dmDriverVersion: WORD;
+ dmSize : WORD;
+ dmDriverExtra : WORD;
+ dmFields : DWORD;
+ dmOrientation : short;
+ dmPaperSize : short;
+ dmPaperLength : short;
+ dmPaperWidth : short;
+ dmScale : short;
+ dmCopies : short;
+ dmDefaultSource: short;
+ dmPrintQuality : short;
+ dmColor : short;
+ dmDuplex : short;
+ dmYResolution : short;
+ dmTTOption : short;
+ dmCollate : short;
+ dmFormName : array [0..CCHFORMNAME-1] of wchar;
+ dmLogPixels : WORD;
+ dmBitsPerPel : DWORD;
+ dmPelsWidth : DWORD;
+ dmPelsHeight : DWORD;
+ dmDisplayFlags : DWORD;
+ dmDisplayFrequency : DWORD;
+ dmICMMethod : DWORD;
+ dmICMIntent : DWORD;
+ dmMediaType : DWORD;
+ dmDitherType : DWORD;
+ dmReserved1 : DWORD;
+ dmReserved2 : DWORD;
+ dmPanningWidth : DWORD;
+ dmPanningHeight: DWORD;
+ end;
+
+ LPDEVMODEW = ^DEVMODEW;
+ _devicemodeW = DEVMODEW;
+ devicemodeW = DEVMODEW;
+ TDeviceModeW = DEVMODEW;
+ PDeviceModeW = LPDEVMODEW;
+ TDEVMODEW = DEVMODEW;
+
+ PDEVMODEW = LPDEVMODEW;
+
+ DEVNAMES = record
+ wDriverOffset : WORD;
+ wDeviceOffset : WORD;
+ wOutputOffset : WORD;
+ wDefault : WORD;
+ end;
+ LPDEVNAMES = ^DEVNAMES;
+ tagDEVNAMES = DEVNAMES;
+ TDEVNAMES = DEVNAMES;
+ PDEVNAMES = ^DEVNAMES;
+
+ DIBSECTION = record
+ dsBm : BITMAP;
+ dsBmih : BITMAPINFOHEADER;
+ dsBitfields : array[0..2] of DWORD;
+ dshSection : HANDLE;
+ dsOffset : DWORD;
+ end;
+ tagDIBSECTION = DIBSECTION;
+ TDIBSECTION = DIBSECTION;
+ PDIBSECTION = ^DIBSECTION;
+
+ LARGE_INTEGER = record
+ case byte of
+ 0: (LowPart : DWORD;
+ HighPart : LONG);
+ 1: (QuadPart : LONGLONG);
+ end;
+ PLARGE_INTEGER = ^LARGE_INTEGER;
+ _LARGE_INTEGER = LARGE_INTEGER;
+
+ TLargeInteger = Int64;
+ PLargeInteger = ^TLargeInteger;
+
+ ULARGE_INTEGER = record
+ case byte of
+ 0: (LowPart : DWORD;
+ HighPart : DWORD);
+ 1: (QuadPart : LONGLONG);
+ end;
+ PULARGE_INTEGER = ^ULARGE_INTEGER;
+ _ULARGE_INTEGER = ULARGE_INTEGER;
+
+ TULargeInteger = QWord;
+ PULargeInteger = ^TULargeInteger;
+
+ DISK_GEOMETRY = record
+ Cylinders : LARGE_INTEGER;
+ MediaType : MEDIA_TYPE;
+ TracksPerCylinder : DWORD;
+ SectorsPerTrack : DWORD;
+ BytesPerSector : DWORD;
+ end;
+ _DISK_GEOMETRY = DISK_GEOMETRY;
+ TDISKGEOMETRY = DISK_GEOMETRY;
+ PDISKGEOMETRY = ^DISK_GEOMETRY;
+
+ DISK_PERFORMANCE = record
+ BytesRead : LARGE_INTEGER;
+ BytesWritten : LARGE_INTEGER;
+ ReadTime : LARGE_INTEGER;
+ WriteTime : LARGE_INTEGER;
+ ReadCount : DWORD;
+ WriteCount : DWORD;
+ QueueDepth : DWORD;
+ end;
+ _DISK_PERFORMANCE = DISK_PERFORMANCE;
+ TDISKPERFORMANCE = DISK_PERFORMANCE;
+ PDISKPERFORMANCE = ^DISK_PERFORMANCE;
+
+ DLGITEMTEMPLATE = packed record
+ style : DWORD;
+ dwExtendedStyle : DWORD;
+ x : integer;
+ y : integer;
+ cx : integer;
+ cy : integer;
+ id : WORD;
+ end;
+ LPDLGITEMTEMPLATE = ^DLGITEMTEMPLATE;
+ TDLGITEMTEMPLATE = DLGITEMTEMPLATE;
+ PDLGITEMTEMPLATE = ^DLGITEMTEMPLATE;
+
+ DLGTEMPLATE = packed record
+ style : DWORD;
+ dwExtendedStyle : DWORD;
+ cdit : WORD;
+ x : integer;
+ y : integer;
+ cx : integer;
+ cy : integer;
+ end;
+ LPDLGTEMPLATE = ^DLGTEMPLATE;
+ LPCDLGTEMPLATE = ^DLGTEMPLATE;
+ TDLGTEMPLATE = DLGTEMPLATE;
+ PDLGTEMPLATE = ^DLGTEMPLATE;
+
+ DOC_INFO_1 = record
+ pDocName : LPTSTR;
+ pOutputFile : LPTSTR;
+ pDatatype : LPTSTR;
+ end;
+ _DOC_INFO_1 = DOC_INFO_1;
+ TDOCINFO1 = DOC_INFO_1;
+ PDOCINFO1 = ^DOC_INFO_1;
+
+ DOC_INFO_2 = record
+ pDocName : LPTSTR;
+ pOutputFile : LPTSTR;
+ pDatatype : LPTSTR;
+ dwMode : DWORD;
+ JobId : DWORD;
+ end;
+ _DOC_INFO_2 = DOC_INFO_2;
+ TDOCINFO2 = DOC_INFO_2;
+ PDOCINFO2 = ^DOC_INFO_2;
+
+ DOCINFO = record
+ cbSize : longint;
+ lpszDocName : LPCTSTR;
+ lpszOutput : LPCTSTR;
+ lpszDatatype : LPCTSTR;
+ fwType : DWORD;
+ end;
+ TDOCINFO = DOCINFO;
+ TDOCINFOA = DOCINFO;
+ PDOCINFO = ^DOCINFO;
+
+ DRAGLISTINFO = record
+ uNotification : UINT;
+ hWnd : HWND;
+ ptCursor : POINT;
+ end;
+ LPDRAGLISTINFO = ^DRAGLISTINFO;
+ TDRAGLISTINFO = DRAGLISTINFO;
+ PDRAGLISTINFO = ^DRAGLISTINFO;
+
+ DRAWITEMSTRUCT = record
+ CtlType : UINT;
+ CtlID : UINT;
+ itemID : UINT;
+ itemAction : UINT;
+ itemState : UINT;
+ hwndItem : HWND;
+ hDC : HDC;
+ rcItem : RECT;
+ itemData : DWORD;
+ end;
+ LPDRAWITEMSTRUCT = ^DRAWITEMSTRUCT;
+ tagDRAWITEMSTRUCT = DRAWITEMSTRUCT;
+ TDRAWITEMSTRUCT = DRAWITEMSTRUCT;
+ PDRAWITEMSTRUCT = ^DRAWITEMSTRUCT;
+
+ DRAWTEXTPARAMS = record
+ cbSize : UINT;
+ iTabLength : longint;
+ iLeftMargin : longint;
+ iRightMargin : longint;
+ uiLengthDrawn : UINT;
+ end;
+ LPDRAWTEXTPARAMS = ^DRAWTEXTPARAMS;
+ TDRAWTEXTPARAMS = DRAWTEXTPARAMS;
+ PDRAWTEXTPARAMS = ^DRAWTEXTPARAMS;
+
+ PARTITION_INFORMATION = record
+ PartitionType : BYTE;
+ BootIndicator : BOOLEAN;
+ RecognizedPartition : BOOLEAN;
+ RewritePartition : BOOLEAN;
+ StartingOffset : LARGE_INTEGER;
+ PartitionLength : LARGE_INTEGER;
+ HiddenSectors : LARGE_INTEGER;
+ end;
+ _PARTITION_INFORMATION = PARTITION_INFORMATION;
+ TPARTITIONINFORMATION = PARTITION_INFORMATION;
+ PPARTITIONINFORMATION = ^PARTITION_INFORMATION;
+
+ DRIVE_LAYOUT_INFORMATION = record
+ PartitionCount : DWORD;
+ Signature : DWORD;
+ PartitionEntry : array[0..0] of PARTITION_INFORMATION;
+ end;
+ _DRIVE_LAYOUT_INFORMATION = DRIVE_LAYOUT_INFORMATION;
+ TDRIVELAYOUTINFORMATION = DRIVE_LAYOUT_INFORMATION;
+ PDRIVELAYOUTINFORMATION = ^DRIVE_LAYOUT_INFORMATION;
+
+ DRIVER_INFO_1 = record
+ pName : LPTSTR;
+ end;
+ _DRIVER_INFO_1 = DRIVER_INFO_1;
+ TDRIVERINFO1 = DRIVER_INFO_1;
+ PDRIVERINFO1 = ^DRIVER_INFO_1;
+
+ DRIVER_INFO_2 = record
+ cVersion : DWORD;
+ pName : LPTSTR;
+ pEnvironment : LPTSTR;
+ pDriverPath : LPTSTR;
+ pDataFile : LPTSTR;
+ pConfigFile : LPTSTR;
+ end;
+ _DRIVER_INFO_2 = DRIVER_INFO_2;
+ TDRIVERINFO2 = DRIVER_INFO_2;
+ PDRIVERINFO2 = ^DRIVER_INFO_2;
+
+ DRIVER_INFO_3 = record
+ cVersion : DWORD;
+ pName : LPTSTR;
+ pEnvironment : LPTSTR;
+ pDriverPath : LPTSTR;
+ pDataFile : LPTSTR;
+ pConfigFile : LPTSTR;
+ pHelpFile : LPTSTR;
+ pDependentFiles : LPTSTR;
+ pMonitorName : LPTSTR;
+ pDefaultDataType : LPTSTR;
+ end;
+ _DRIVER_INFO_3 = DRIVER_INFO_3;
+ TDRIVERINFO3 = DRIVER_INFO_3;
+ PDRIVERINFO3 = ^DRIVER_INFO_3;
+
+ EDITSTREAM = record
+ dwCookie : DWORD;
+ dwError : DWORD;
+ pfnCallback : EDITSTREAMCALLBACK;
+ end;
+ _editstream = EDITSTREAM;
+ Teditstream = EDITSTREAM;
+ Peditstream = ^EDITSTREAM;
+
+ EMR = record
+ iType : DWORD;
+ nSize : DWORD;
+ end;
+ tagEMR = EMR;
+ TEMR = EMR;
+ PEMR = ^EMR;
+
+ EMRANGLEARC = record
+ emr : EMR;
+ ptlCenter : POINTL;
+ nRadius : DWORD;
+ eStartAngle : Single;
+ eSweepAngle : Single;
+ end;
+ tagEMRANGLEARC = EMRANGLEARC;
+ TEMRANGLEARC = EMRANGLEARC;
+ PEMRANGLEARC = ^EMRANGLEARC;
+
+ EMRARC = record
+ emr : EMR;
+ rclBox : RECTL;
+ ptlStart : POINTL;
+ ptlEnd : POINTL;
+ end;
+ tagEMRARC = EMRARC;
+ TEMRARC = EMRARC;
+ PEMRARC = ^EMRARC;
+
+ EMRARCTO = EMRARC;
+ TEMRARCTO = EMRARC;
+ PEMRARCTO = ^EMRARC;
+
+ EMRCHORD = EMRARC;
+ TEMRCHORD = EMRARC;
+ PEMRCHORD = ^EMRARC;
+
+ EMRPIE = EMRARC;
+ TEMRPIE = EMRARC;
+ PEMRPIE = ^EMRARC;
+
+ XFORM = record
+ eM11 : Single;
+ eM12 : Single;
+ eM21 : Single;
+ eM22 : Single;
+ eDx : Single;
+ eDy : Single;
+ end;
+ LPXFORM = ^XFORM;
+ _XFORM = XFORM;
+ TXFORM = XFORM;
+ PXFORM = ^XFORM;
+
+ EMRBITBLT = record
+ emr : EMR;
+ rclBounds : RECTL;
+ xDest : LONG;
+ yDest : LONG;
+ cxDest : LONG;
+ cyDest : LONG;
+ dwRop : DWORD;
+ xSrc : LONG;
+ ySrc : LONG;
+ xformSrc : XFORM;
+ crBkColorSrc : COLORREF;
+ iUsageSrc : DWORD;
+ offBmiSrc : DWORD;
+ offBitsSrc : DWORD;
+ cbBitsSrc : DWORD;
+ end;
+ tagEMRBITBLT = EMRBITBLT;
+ TEMRBITBLT = EMRBITBLT;
+ PEMRBITBLT = ^EMRBITBLT;
+
+ LOGBRUSH = record
+ lbStyle : UINT;
+ lbColor : COLORREF;
+ lbHatch : LONG;
+ end;
+ tagLOGBRUSH = LOGBRUSH;
+ TLOGBRUSH = LOGBRUSH;
+ PLOGBRUSH = ^LOGBRUSH;
+
+ EMRCREATEBRUSHINDIRECT = record
+ emr : EMR;
+ ihBrush : DWORD;
+ lb : LOGBRUSH;
+ end;
+ tagEMRCREATEBRUSHINDIRECT = EMRCREATEBRUSHINDIRECT;
+ TEMRCREATEBRUSHINDIRECT = EMRCREATEBRUSHINDIRECT;
+ PEMRCREATEBRUSHINDIRECT = ^EMRCREATEBRUSHINDIRECT;
+
+ LCSCSTYPE = LONG;
+
+ LCSGAMUTMATCH = LONG;
+
+ LOGCOLORSPACE = record
+ lcsSignature : DWORD;
+ lcsVersion : DWORD;
+ lcsSize : DWORD;
+ lcsCSType : LCSCSTYPE;
+ lcsIntent : LCSGAMUTMATCH;
+ lcsEndpoints : CIEXYZTRIPLE;
+ lcsGammaRed : DWORD;
+ lcsGammaGreen : DWORD;
+ lcsGammaBlue : DWORD;
+ lcsFilename : array[0..(MAX_PATH)-1] of TCHAR;
+ end;
+ LPLOGCOLORSPACE = ^LOGCOLORSPACE;
+ tagLOGCOLORSPACE = LOGCOLORSPACE;
+ TLOGCOLORSPACE = LOGCOLORSPACE;
+ TLOGCOLORSPACEA = LOGCOLORSPACE;
+ PLOGCOLORSPACE = ^LOGCOLORSPACE;
+
+ EMRCREATECOLORSPACE = record
+ emr : EMR;
+ ihCS : DWORD;
+ lcs : LOGCOLORSPACE;
+ end;
+ tagEMRCREATECOLORSPACE = EMRCREATECOLORSPACE;
+ TEMRCREATECOLORSPACE = EMRCREATECOLORSPACE;
+ PEMRCREATECOLORSPACE = ^EMRCREATECOLORSPACE;
+
+ EMRCREATEDIBPATTERNBRUSHPT = record
+ emr : EMR;
+ ihBrush : DWORD;
+ iUsage : DWORD;
+ offBmi : DWORD;
+ cbBmi : DWORD;
+ offBits : DWORD;
+ cbBits : DWORD;
+ end;
+ tagEMRCREATEDIBPATTERNBRUSHPT = EMRCREATEDIBPATTERNBRUSHPT;
+ TEMRCREATEDIBPATTERNBRUSHPT = EMRCREATEDIBPATTERNBRUSHPT;
+ PEMRCREATEDIBPATTERNBRUSHPT = EMRCREATEDIBPATTERNBRUSHPT;
+
+ EMRCREATEMONOBRUSH = record
+ emr : EMR;
+ ihBrush : DWORD;
+ iUsage : DWORD;
+ offBmi : DWORD;
+ cbBmi : DWORD;
+ offBits : DWORD;
+ cbBits : DWORD;
+ end;
+ tagEMRCREATEMONOBRUSH = EMRCREATEMONOBRUSH;
+ TEMRCREATEMONOBRUSH = EMRCREATEMONOBRUSH;
+ PEMRCREATEMONOBRUSH = ^EMRCREATEMONOBRUSH;
+
+ PALETTEENTRY = record
+ peRed : BYTE;
+ peGreen : BYTE;
+ peBlue : BYTE;
+ peFlags : BYTE;
+ end;
+ LPPALETTEENTRY = ^PALETTEENTRY;
+ tagPALETTEENTRY = PALETTEENTRY;
+ TPALETTEENTRY = PALETTEENTRY;
+ PPALETTEENTRY = ^PALETTEENTRY;
+
+ LOGPALETTE = record
+ palVersion : WORD;
+ palNumEntries : WORD;
+ palPalEntry : array[0..0] of PALETTEENTRY;
+ end;
+ LPLOGPALETTE = ^LOGPALETTE;
+ tagLOGPALETTE = LOGPALETTE;
+ TLOGPALETTE = LOGPALETTE;
+ PLOGPALETTE = ^LOGPALETTE;
+
+ EMRCREATEPALETTE = record
+ emr : EMR;
+ ihPal : DWORD;
+ lgpl : LOGPALETTE;
+ end;
+ tagEMRCREATEPALETTE = EMRCREATEPALETTE;
+ TEMRCREATEPALETTE = EMRCREATEPALETTE;
+ PEMRCREATEPALETTE = ^EMRCREATEPALETTE;
+
+ LOGPEN = record
+ lopnStyle : UINT;
+ lopnWidth : POINT;
+ lopnColor : COLORREF;
+ end;
+ tagLOGPEN = LOGPEN;
+ TLOGPEN = LOGPEN;
+ PLOGPEN = ^LOGPEN;
+
+ EMRCREATEPEN = record
+ emr : EMR;
+ ihPen : DWORD;
+ lopn : LOGPEN;
+ end;
+ tagEMRCREATEPEN = EMRCREATEPEN;
+ TEMRCREATEPEN = EMRCREATEPEN;
+ PEMRCREATEPEN = ^EMRCREATEPEN;
+
+ EMRELLIPSE = record
+ emr : EMR;
+ rclBox : RECTL;
+ end;
+ tagEMRELLIPSE = EMRELLIPSE;
+ TEMRELLIPSE = EMRELLIPSE;
+ PEMRELLIPSE = ^EMRELLIPSE;
+
+ EMRRECTANGLE = EMRELLIPSE;
+ TEMRRECTANGLE = EMRELLIPSE;
+ PEMRRECTANGLE = ^EMRELLIPSE;
+
+ EMREOF = record
+ emr : EMR;
+ nPalEntries : DWORD;
+ offPalEntries : DWORD;
+ nSizeLast : DWORD;
+ end;
+ tagEMREOF = EMREOF;
+ TEMREOF = EMREOF;
+ PEMREOF = ^EMREOF;
+
+ EMREXCLUDECLIPRECT = record
+ emr : EMR;
+ rclClip : RECTL;
+ end;
+ tagEMREXCLUDECLIPRECT = EMREXCLUDECLIPRECT;
+ TEMREXCLUDECLIPRECT = EMREXCLUDECLIPRECT;
+ PEMREXCLUDECLIPRECT = ^EMREXCLUDECLIPRECT;
+
+ EMRINTERSECTCLIPRECT = EMREXCLUDECLIPRECT;
+ TEMRINTERSECTCLIPRECT = EMREXCLUDECLIPRECT;
+ PEMRINTERSECTCLIPRECT = ^EMREXCLUDECLIPRECT;
+
+ PANOSE = record
+ bFamilyType : BYTE;
+ bSerifStyle : BYTE;
+ bWeight : BYTE;
+ bProportion : BYTE;
+ bContrast : BYTE;
+ bStrokeVariation : BYTE;
+ bArmStyle : BYTE;
+ bLetterform : BYTE;
+ bMidline : BYTE;
+ bXHeight : BYTE;
+ end;
+ tagPANOSE = PANOSE;
+ TPANOSE = PANOSE;
+ PPANOSE = ^PANOSE;
+
+ EXTLOGFONT = record
+ elfLogFont : LOGFONT;
+ elfFullName : array[0..(LF_FULLFACESIZE)-1] of BCHAR;
+ elfStyle : array[0..(LF_FACESIZE)-1] of BCHAR;
+ elfVersion : DWORD;
+ elfStyleSize : DWORD;
+ elfMatch : DWORD;
+ elfReserved : DWORD;
+ elfVendorId : array[0..(ELF_VENDOR_SIZE)-1] of BYTE;
+ elfCulture : DWORD;
+ elfPanose : PANOSE;
+ end;
+ tagEXTLOGFONT = EXTLOGFONT;
+ TEXTLOGFONT = EXTLOGFONT;
+ PEXTLOGFONT = ^EXTLOGFONT;
+
+ EMREXTCREATEFONTINDIRECTW = record
+ emr : EMR;
+ ihFont : DWORD;
+ elfw : EXTLOGFONT;
+ end;
+ tagEMREXTCREATEFONTINDIRECTW = EMREXTCREATEFONTINDIRECTW;
+ TEMREXTCREATEFONTINDIRECTW = EMREXTCREATEFONTINDIRECTW;
+ PEMREXTCREATEFONTINDIRECTW = ^EMREXTCREATEFONTINDIRECTW;
+
+
+ EXTLOGPEN = record
+ elpPenStyle : UINT;
+ elpWidth : UINT;
+ elpBrushStyle : UINT;
+ elpColor : COLORREF;
+ elpHatch : LONG;
+ elpNumEntries : DWORD;
+ elpStyleEntry : array[0..0] of DWORD;
+ end;
+ tagEXTLOGPEN = EXTLOGPEN;
+ TEXTLOGPEN = EXTLOGPEN;
+ PEXTLOGPEN = ^EXTLOGPEN;
+
+ EMREXTCREATEPEN = record
+ emr : EMR;
+ ihPen : DWORD;
+ offBmi : DWORD;
+ cbBmi : DWORD;
+ offBits : DWORD;
+ cbBits : DWORD;
+ elp : EXTLOGPEN;
+ end;
+ tagEMREXTCREATEPEN = EMREXTCREATEPEN;
+ TEMREXTCREATEPEN = EMREXTCREATEPEN;
+ PEMREXTCREATEPEN = ^EMREXTCREATEPEN;
+
+ EMREXTFLOODFILL = record
+ emr : EMR;
+ ptlStart : POINTL;
+ crColor : COLORREF;
+ iMode : DWORD;
+ end;
+ tagEMREXTFLOODFILL = EMREXTFLOODFILL;
+ TEMREXTFLOODFILL = EMREXTFLOODFILL;
+ PEMREXTFLOODFILL = ^EMREXTFLOODFILL;
+
+ EMREXTSELECTCLIPRGN = record
+ emr : EMR;
+ cbRgnData : DWORD;
+ iMode : DWORD;
+ RgnData : array[0..0] of BYTE;
+ end;
+ tagEMREXTSELECTCLIPRGN = EMREXTSELECTCLIPRGN;
+ TEMREXTSELECTCLIPRGN = EMREXTSELECTCLIPRGN;
+ PEMREXTSELECTCLIPRGN = ^EMREXTSELECTCLIPRGN;
+
+ EMRTEXT = record
+ ptlReference : POINTL;
+ nChars : DWORD;
+ offString : DWORD;
+ fOptions : DWORD;
+ rcl : RECTL;
+ offDx : DWORD;
+ end;
+ tagEMRTEXT = EMRTEXT;
+ TEMRTEXT = EMRTEXT;
+ PEMRTEXT = ^EMRTEXT;
+
+ EMREXTTEXTOUTA = record
+ emr : EMR;
+ rclBounds : RECTL;
+ iGraphicsMode : DWORD;
+ exScale : Single;
+ eyScale : Single;
+ emrtext : EMRTEXT;
+ end;
+ tagEMREXTTEXTOUTA = EMREXTTEXTOUTA;
+ TEMREXTTEXTOUTA = EMREXTTEXTOUTA;
+ PEMREXTTEXTOUTA = ^EMREXTTEXTOUTA;
+
+ EMREXTTEXTOUTW = EMREXTTEXTOUTA;
+ TEMREXTTEXTOUTW = EMREXTTEXTOUTA;
+ PEMREXTTEXTOUTW = ^EMREXTTEXTOUTA;
+
+ EMRFILLPATH = record
+ emr : EMR;
+ rclBounds : RECTL;
+ end;
+ tagEMRFILLPATH = EMRFILLPATH;
+ TEMRFILLPATH = EMRFILLPATH;
+ PEMRFILLPATH = ^EMRFILLPATH;
+
+ EMRSTROKEANDFILLPATH = EMRFILLPATH;
+ TEMRSTROKEANDFILLPATH = EMRFILLPATH;
+ PEMRSTROKEANDFILLPATH = ^EMRFILLPATH;
+
+ EMRSTROKEPATH = EMRFILLPATH;
+ TEMRSTROKEPATH = EMRFILLPATH;
+ PEMRSTROKEPATH = ^EMRFILLPATH;
+
+ EMRFILLRGN = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cbRgnData : DWORD;
+ ihBrush : DWORD;
+ RgnData : array[0..0] of BYTE;
+ end;
+ tagEMRFILLRGN = EMRFILLRGN;
+ TEMRFILLRGN = EMRFILLRGN;
+ PEMRFILLRGN = ^EMRFILLRGN;
+
+ EMRFORMAT = record
+ dSignature : DWORD;
+ nVersion : DWORD;
+ cbData : DWORD;
+ offData : DWORD;
+ end;
+ tagEMRFORMAT = EMRFORMAT;
+ TEMRFORMAT = EMRFORMAT;
+ PEMRFORMAT = ^EMRFORMAT;
+
+ SIZE = record
+ cx : LONG;
+ cy : LONG;
+ end;
+ LPSIZE = ^SIZE;
+ tagSIZE = SIZE;
+ TSIZE = SIZE;
+ PSIZE = ^SIZE;
+
+ SIZEL = SIZE;
+ TSIZEL = SIZE;
+ PSIZEL = ^SIZE;
+ LPSIZEL = ^SIZE;
+
+ EMRFRAMERGN = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cbRgnData : DWORD;
+ ihBrush : DWORD;
+ szlStroke : SIZEL;
+ RgnData : array[0..0] of BYTE;
+ end;
+ tagEMRFRAMERGN = EMRFRAMERGN;
+ TEMRFRAMERGN = EMRFRAMERGN;
+ PEMRFRAMERGN = ^EMRFRAMERGN;
+
+ EMRGDICOMMENT = record
+ emr : EMR;
+ cbData : DWORD;
+ Data : array[0..0] of BYTE;
+ end;
+ tagEMRGDICOMMENT = EMRGDICOMMENT;
+ TEMRGDICOMMENT = EMRGDICOMMENT;
+ PEMRGDICOMMENT = ^EMRGDICOMMENT;
+
+ EMRINVERTRGN = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cbRgnData : DWORD;
+ RgnData : array[0..0] of BYTE;
+ end;
+ tagEMRINVERTRGN = EMRINVERTRGN;
+ TEMRINVERTRGN = EMRINVERTRGN;
+ PEMRINVERTRGN = ^EMRINVERTRGN;
+
+ EMRPAINTRGN = EMRINVERTRGN;
+ TEMRPAINTRGN = EMRINVERTRGN;
+ PEMRPAINTRGN = ^EMRINVERTRGN;
+
+ EMRLINETO = record
+ emr : EMR;
+ ptl : POINTL;
+ end;
+ tagEMRLINETO = EMRLINETO;
+ TEMRLINETO = EMRLINETO;
+ PEMRLINETO = ^EMRLINETO;
+
+ EMRMOVETOEX = EMRLINETO;
+ TEMRMOVETOEX = EMRLINETO;
+ PEMRMOVETOEX = ^EMRLINETO;
+
+ EMRMASKBLT = record
+ emr : EMR;
+ rclBounds : RECTL;
+ xDest : LONG;
+ yDest : LONG;
+ cxDest : LONG;
+ cyDest : LONG;
+ dwRop : DWORD;
+ xSrc : LONG;
+ ySrc : LONG;
+ xformSrc : XFORM;
+ crBkColorSrc : COLORREF;
+ iUsageSrc : DWORD;
+ offBmiSrc : DWORD;
+ cbBmiSrc : DWORD;
+ offBitsSrc : DWORD;
+ cbBitsSrc : DWORD;
+ xMask : LONG;
+ yMask : LONG;
+ iUsageMask : DWORD;
+ offBmiMask : DWORD;
+ cbBmiMask : DWORD;
+ offBitsMask : DWORD;
+ cbBitsMask : DWORD;
+ end;
+ tagEMRMASKBLT = EMRMASKBLT;
+ TEMRMASKBLT = EMRMASKBLT;
+ PEMRMASKBLT = ^EMRMASKBLT;
+
+ EMRMODIFYWORLDTRANSFORM = record
+ emr : EMR;
+ xform : XFORM;
+ iMode : DWORD;
+ end;
+ tagEMRMODIFYWORLDTRANSFORM = EMRMODIFYWORLDTRANSFORM;
+ TEMRMODIFYWORLDTRANSFORM = EMRMODIFYWORLDTRANSFORM;
+ PEMRMODIFYWORLDTRANSFORM = EMRMODIFYWORLDTRANSFORM;
+
+ EMROFFSETCLIPRGN = record
+ emr : EMR;
+ ptlOffset : POINTL;
+ end;
+ tagEMROFFSETCLIPRGN = EMROFFSETCLIPRGN;
+ TEMROFFSETCLIPRGN = EMROFFSETCLIPRGN;
+ PEMROFFSETCLIPRGN = ^EMROFFSETCLIPRGN;
+
+ EMRPLGBLT = record
+ emr : EMR;
+ rclBounds : RECTL;
+ aptlDest : array[0..2] of POINTL;
+ xSrc : LONG;
+ ySrc : LONG;
+ cxSrc : LONG;
+ cySrc : LONG;
+ xformSrc : XFORM;
+ crBkColorSrc : COLORREF;
+ iUsageSrc : DWORD;
+ offBmiSrc : DWORD;
+ cbBmiSrc : DWORD;
+ offBitsSrc : DWORD;
+ cbBitsSrc : DWORD;
+ xMask : LONG;
+ yMask : LONG;
+ iUsageMask : DWORD;
+ offBmiMask : DWORD;
+ cbBmiMask : DWORD;
+ offBitsMask : DWORD;
+ cbBitsMask : DWORD;
+ end;
+ tagEMRPLGBLT = EMRPLGBLT;
+ TEMRPLGBLT = EMRPLGBLT;
+ PEMRPLGBLT = ^EMRPLGBLT;
+
+ EMRPOLYDRAW = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cptl : DWORD;
+ aptl : array[0..0] of POINTL;
+ abTypes : array[0..0] of BYTE;
+ end;
+ tagEMRPOLYDRAW = EMRPOLYDRAW;
+ TEMRPOLYDRAW = EMRPOLYDRAW;
+ PEMRPOLYDRAW = ^EMRPOLYDRAW;
+
+ EMRPOLYDRAW16 = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cpts : DWORD;
+ apts : array[0..0] of POINTS;
+ abTypes : array[0..0] of BYTE;
+ end;
+ tagEMRPOLYDRAW16 = EMRPOLYDRAW16;
+ TEMRPOLYDRAW16 = EMRPOLYDRAW16;
+ PEMRPOLYDRAW16 = ^EMRPOLYDRAW16;
+
+ EMRPOLYLINE = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cptl : DWORD;
+ aptl : array[0..0] of POINTL;
+ end;
+ tagEMRPOLYLINE = EMRPOLYLINE;
+ TEMRPOLYLINE = EMRPOLYLINE;
+ PEMRPOLYLINE = ^EMRPOLYLINE;
+
+ EMRPOLYBEZIER = EMRPOLYLINE;
+ TEMRPOLYBEZIER = EMRPOLYLINE;
+ PEMRPOLYBEZIER = ^EMRPOLYLINE;
+
+ EMRPOLYGON = EMRPOLYLINE;
+ TEMRPOLYGON = EMRPOLYLINE;
+ PEMRPOLYGON = ^EMRPOLYLINE;
+
+ EMRPOLYBEZIERTO = EMRPOLYLINE;
+ TEMRPOLYBEZIERTO = EMRPOLYLINE;
+ PEMRPOLYBEZIERTO = ^EMRPOLYLINE;
+
+ EMRPOLYLINETO = EMRPOLYLINE;
+ TEMRPOLYLINETO = EMRPOLYLINE;
+ PEMRPOLYLINETO = ^EMRPOLYLINE;
+
+ EMRPOLYLINE16 = record
+ emr : EMR;
+ rclBounds : RECTL;
+ cpts : DWORD;
+ apts : array[0..0] of POINTL;
+ end;
+ tagEMRPOLYLINE16 = EMRPOLYLINE16;
+ TEMRPOLYLINE16 = EMRPOLYLINE16;
+ PEMRPOLYLINE16 = ^EMRPOLYLINE16;
+
+ EMRPOLYBEZIER16 = EMRPOLYLINE16;
+ TEMRPOLYBEZIER16 = EMRPOLYLINE16;
+ PEMRPOLYBEZIER16 = ^EMRPOLYLINE16;
+
+ EMRPOLYGON16 = EMRPOLYLINE16;
+ TEMRPOLYGON16 = EMRPOLYLINE16;
+ PEMRPOLYGON16 = ^EMRPOLYLINE16;
+
+ EMRPOLYBEZIERTO16 = EMRPOLYLINE16;
+ TEMRPOLYBEZIERTO16 = EMRPOLYLINE16;
+ PEMRPOLYBEZIERTO16 = ^EMRPOLYLINE16;
+
+ EMRPOLYLINETO16 = EMRPOLYLINE16;
+ TEMRPOLYLINETO16 = EMRPOLYLINE16;
+ PEMRPOLYLINETO16 = ^EMRPOLYLINE16;
+
+ EMRPOLYPOLYLINE = record
+ emr : EMR;
+ rclBounds : RECTL;
+ nPolys : DWORD;
+ cptl : DWORD;
+ aPolyCounts : array[0..0] of DWORD;
+ aptl : array[0..0] of POINTL;
+ end;
+ tagEMRPOLYPOLYLINE = EMRPOLYPOLYLINE;
+ TEMRPOLYPOLYLINE = EMRPOLYPOLYLINE;
+ PEMRPOLYPOLYLINE = ^EMRPOLYPOLYLINE;
+
+ EMRPOLYPOLYGON = EMRPOLYPOLYLINE;
+ TEMRPOLYPOLYGON = EMRPOLYPOLYLINE;
+ PEMRPOLYPOLYGON = ^EMRPOLYPOLYLINE;
+
+ EMRPOLYPOLYLINE16 = record
+ emr : EMR;
+ rclBounds : RECTL;
+ nPolys : DWORD;
+ cpts : DWORD;
+ aPolyCounts : array[0..0] of DWORD;
+ apts : array[0..0] of POINTS;
+ end;
+ tagEMRPOLYPOLYLINE16 = EMRPOLYPOLYLINE16;
+ TEMRPOLYPOLYLINE16 = EMRPOLYPOLYLINE16;
+ PEMRPOLYPOLYLINE16 = ^EMRPOLYPOLYLINE16;
+
+ EMRPOLYPOLYGON16 = EMRPOLYPOLYLINE16;
+ TEMRPOLYPOLYGON16 = EMRPOLYPOLYLINE16;
+ PEMRPOLYPOLYGON16 = ^EMRPOLYPOLYLINE16;
+
+ EMRPOLYTEXTOUTA = record
+ emr : EMR;
+ rclBounds : RECTL;
+ iGraphicsMode : DWORD;
+ exScale : Single;
+ eyScale : Single;
+ cStrings : LONG;
+ aemrtext : array[0..0] of EMRTEXT;
+ end;
+ tagEMRPOLYTEXTOUTA = EMRPOLYTEXTOUTA;
+ TEMRPOLYTEXTOUTA = EMRPOLYTEXTOUTA;
+ PEMRPOLYTEXTOUTA = ^EMRPOLYTEXTOUTA;
+
+ EMRPOLYTEXTOUTW = EMRPOLYTEXTOUTA;
+ TEMRPOLYTEXTOUTW = EMRPOLYTEXTOUTA;
+ PEMRPOLYTEXTOUTW = ^EMRPOLYTEXTOUTA;
+
+ EMRRESIZEPALETTE = record
+ emr : EMR;
+ ihPal : DWORD;
+ cEntries : DWORD;
+ end;
+ tagEMRRESIZEPALETTE = EMRRESIZEPALETTE;
+ TEMRRESIZEPALETTE = EMRRESIZEPALETTE;
+ PEMRRESIZEPALETTE = ^EMRRESIZEPALETTE;
+
+ EMRRESTOREDC = record
+ emr : EMR;
+ iRelative : LONG;
+ end;
+ tagEMRRESTOREDC = EMRRESTOREDC;
+ TEMRRESTOREDC = EMRRESTOREDC;
+ PEMRRESTOREDC = ^EMRRESTOREDC;
+
+ EMRROUNDRECT = record
+ emr : EMR;
+ rclBox : RECTL;
+ szlCorner : SIZEL;
+ end;
+ tagEMRROUNDRECT = EMRROUNDRECT;
+ TEMRROUNDRECT = EMRROUNDRECT;
+ PEMRROUNDRECT = ^EMRROUNDRECT;
+
+ EMRSCALEVIEWPORTEXTEX = record
+ emr : EMR;
+ xNum : LONG;
+ xDenom : LONG;
+ yNum : LONG;
+ yDenom : LONG;
+ end;
+ tagEMRSCALEVIEWPORTEXTEX = EMRSCALEVIEWPORTEXTEX;
+ TEMRSCALEVIEWPORTEXTEX = EMRSCALEVIEWPORTEXTEX;
+ PEMRSCALEVIEWPORTEXTEX = ^EMRSCALEVIEWPORTEXTEX;
+
+ EMRSCALEWINDOWEXTEX = EMRSCALEVIEWPORTEXTEX;
+ TEMRSCALEWINDOWEXTEX = EMRSCALEVIEWPORTEXTEX;
+ PEMRSCALEWINDOWEXTEX = ^EMRSCALEVIEWPORTEXTEX;
+
+ EMRSELECTCOLORSPACE = record
+ emr : EMR;
+ ihCS : DWORD;
+ end;
+ tagEMRSELECTCOLORSPACE = EMRSELECTCOLORSPACE;
+ TEMRSELECTCOLORSPACE = EMRSELECTCOLORSPACE;
+ PEMRSELECTCOLORSPACE = ^EMRSELECTCOLORSPACE;
+
+ EMRDELETECOLORSPACE = EMRSELECTCOLORSPACE;
+ TEMRDELETECOLORSPACE = EMRSELECTCOLORSPACE;
+ PEMRDELETECOLORSPACE = ^EMRSELECTCOLORSPACE;
+
+ EMRSELECTOBJECT = record
+ emr : EMR;
+ ihObject : DWORD;
+ end;
+ tagEMRSELECTOBJECT = EMRSELECTOBJECT;
+ TEMRSELECTOBJECT = EMRSELECTOBJECT;
+ PEMRSELECTOBJECT = ^EMRSELECTOBJECT;
+
+ EMRDELETEOBJECT = EMRSELECTOBJECT;
+ TEMRDELETEOBJECT = EMRSELECTOBJECT;
+ PEMRDELETEOBJECT = ^EMRSELECTOBJECT;
+
+ EMRSELECTPALETTE = record
+ emr : EMR;
+ ihPal : DWORD;
+ end;
+ tagEMRSELECTPALETTE = EMRSELECTPALETTE;
+ TEMRSELECTPALETTE = EMRSELECTPALETTE;
+ PEMRSELECTPALETTE = ^EMRSELECTPALETTE;
+
+ EMRSETARCDIRECTION = record
+ emr : EMR;
+ iArcDirection : DWORD;
+ end;
+ tagEMRSETARCDIRECTION = EMRSETARCDIRECTION;
+ TEMRSETARCDIRECTION = EMRSETARCDIRECTION;
+ PEMRSETARCDIRECTION = ^EMRSETARCDIRECTION;
+
+ EMRSETBKCOLOR = record
+ emr : EMR;
+ crColor : COLORREF;
+ end;
+ tagEMRSETTEXTCOLOR = EMRSETBKCOLOR;
+ TEMRSETBKCOLOR = EMRSETBKCOLOR;
+ PEMRSETBKCOLOR = ^EMRSETBKCOLOR;
+
+ EMRSETTEXTCOLOR = EMRSETBKCOLOR;
+ TEMRSETTEXTCOLOR = EMRSETBKCOLOR;
+ PEMRSETTEXTCOLOR = ^EMRSETBKCOLOR;
+
+ EMRSETCOLORADJUSTMENT = record
+ emr : EMR;
+ ColorAdjustment : COLORADJUSTMENT;
+ end;
+ tagEMRSETCOLORADJUSTMENT = EMRSETCOLORADJUSTMENT;
+ TEMRSETCOLORADJUSTMENT = EMRSETCOLORADJUSTMENT;
+ PEMRSETCOLORADJUSTMENT = ^EMRSETCOLORADJUSTMENT;
+
+ EMRSETDIBITSTODEVICE = record
+ emr : EMR;
+ rclBounds : RECTL;
+ xDest : LONG;
+ yDest : LONG;
+ xSrc : LONG;
+ ySrc : LONG;
+ cxSrc : LONG;
+ cySrc : LONG;
+ offBmiSrc : DWORD;
+ cbBmiSrc : DWORD;
+ offBitsSrc : DWORD;
+ cbBitsSrc : DWORD;
+ iUsageSrc : DWORD;
+ iStartScan : DWORD;
+ cScans : DWORD;
+ end;
+ tagEMRSETDIBITSTODEVICE = EMRSETDIBITSTODEVICE;
+ TEMRSETDIBITSTODEVICE = EMRSETDIBITSTODEVICE;
+ PEMRSETDIBITSTODEVICE = ^EMRSETDIBITSTODEVICE;
+
+ EMRSETMAPPERFLAGS = record
+ emr : EMR;
+ dwFlags : DWORD;
+ end;
+ tagEMRSETMAPPERFLAGS = EMRSETMAPPERFLAGS;
+ TEMRSETMAPPERFLAGS = EMRSETMAPPERFLAGS;
+ PEMRSETMAPPERFLAGS = ^EMRSETMAPPERFLAGS;
+
+ EMRSETMITERLIMIT = record
+ emr : EMR;
+ eMiterLimit : Single;
+ end;
+ tagEMRSETMITERLIMIT = EMRSETMITERLIMIT;
+ TEMRSETMITERLIMIT = EMRSETMITERLIMIT;
+ PEMRSETMITERLIMIT = ^EMRSETMITERLIMIT;
+
+ EMRSETPALETTEENTRIES = record
+ emr : EMR;
+ ihPal : DWORD;
+ iStart : DWORD;
+ cEntries : DWORD;
+ aPalEntries : array[0..0] of PALETTEENTRY;
+ end;
+ tagEMRSETPALETTEENTRIES = EMRSETPALETTEENTRIES;
+ TEMRSETPALETTEENTRIES = EMRSETPALETTEENTRIES;
+ PEMRSETPALETTEENTRIES = ^EMRSETPALETTEENTRIES;
+
+ EMRSETPIXELV = record
+ emr : EMR;
+ ptlPixel : POINTL;
+ crColor : COLORREF;
+ end;
+ tagEMRSETPIXELV = EMRSETPIXELV;
+ TEMRSETPIXELV = EMRSETPIXELV;
+ PEMRSETPIXELV = ^EMRSETPIXELV;
+
+ EMRSETVIEWPORTEXTEX = record
+ emr : EMR;
+ szlExtent : SIZEL;
+ end;
+ tagEMRSETVIEWPORTEXTEX = EMRSETVIEWPORTEXTEX;
+ TEMRSETVIEWPORTEXTEX = EMRSETVIEWPORTEXTEX;
+ PEMRSETVIEWPORTEXTEX = ^EMRSETVIEWPORTEXTEX;
+
+ EMRSETWINDOWEXTEX = EMRSETVIEWPORTEXTEX;
+ TEMRSETWINDOWEXTEX = EMRSETVIEWPORTEXTEX;
+ PEMRSETWINDOWEXTEX = ^EMRSETVIEWPORTEXTEX;
+
+ EMRSETVIEWPORTORGEX = record
+ emr : EMR;
+ ptlOrigin : POINTL;
+ end;
+ tagEMRSETVIEWPORTORGEX = EMRSETVIEWPORTORGEX;
+ TEMRSETVIEWPORTORGEX = EMRSETVIEWPORTORGEX;
+ PEMRSETVIEWPORTORGEX = ^EMRSETVIEWPORTORGEX;
+
+ EMRSETWINDOWORGEX = EMRSETVIEWPORTORGEX;
+ TEMRSETWINDOWORGEX = EMRSETVIEWPORTORGEX;
+ PEMRSETWINDOWORGEX = ^EMRSETVIEWPORTORGEX;
+
+ EMRSETBRUSHORGEX = EMRSETVIEWPORTORGEX;
+ TEMRSETBRUSHORGEX = EMRSETVIEWPORTORGEX;
+ PEMRSETBRUSHORGEX = ^EMRSETVIEWPORTORGEX;
+
+ EMRSETWORLDTRANSFORM = record
+ emr : EMR;
+ xform : XFORM;
+ end;
+ tagEMRSETWORLDTRANSFORM = EMRSETWORLDTRANSFORM;
+ TEMRSETWORLDTRANSFORM = EMRSETWORLDTRANSFORM;
+ PEMRSETWORLDTRANSFORM = ^EMRSETWORLDTRANSFORM;
+
+ EMRSTRETCHBLT = record
+ emr : EMR;
+ rclBounds : RECTL;
+ xDest : LONG;
+ yDest : LONG;
+ cxDest : LONG;
+ cyDest : LONG;
+ dwRop : DWORD;
+ xSrc : LONG;
+ ySrc : LONG;
+ xformSrc : XFORM;
+ crBkColorSrc : COLORREF;
+ iUsageSrc : DWORD;
+ offBmiSrc : DWORD;
+ cbBmiSrc : DWORD;
+ offBitsSrc : DWORD;
+ cbBitsSrc : DWORD;
+ cxSrc : LONG;
+ cySrc : LONG;
+ end;
+ tagEMRSTRETCHBLT = EMRSTRETCHBLT;
+ TEMRSTRETCHBLT = EMRSTRETCHBLT;
+ PEMRSTRETCHBLT = ^EMRSTRETCHBLT;
+
+ EMRSTRETCHDIBITS = record
+ emr : EMR;
+ rclBounds : RECTL;
+ xDest : LONG;
+ yDest : LONG;
+ xSrc : LONG;
+ ySrc : LONG;
+ cxSrc : LONG;
+ cySrc : LONG;
+ offBmiSrc : DWORD;
+ cbBmiSrc : DWORD;
+ offBitsSrc : DWORD;
+ cbBitsSrc : DWORD;
+ iUsageSrc : DWORD;
+ dwRop : DWORD;
+ cxDest : LONG;
+ cyDest : LONG;
+ end;
+ tagEMRSTRETCHDIBITS = EMRSTRETCHDIBITS;
+ TEMRSTRETCHDIBITS = EMRSTRETCHDIBITS;
+ PEMRSTRETCHDIBITS = ^EMRSTRETCHDIBITS;
+
+ EMRABORTPATH = record
+ emr : EMR;
+ end;
+ TEMRABORTPATH = EMRABORTPATH;
+ PEMRABORTPATH = ^EMRABORTPATH;
+
+ tagABORTPATH = EMRABORTPATH;
+ TABORTPATH = EMRABORTPATH;
+
+ EMRBEGINPATH = EMRABORTPATH;
+ TEMRBEGINPATH = EMRABORTPATH;
+ PEMRBEGINPATH = ^EMRABORTPATH;
+
+ EMRENDPATH = EMRABORTPATH;
+ TEMRENDPATH = EMRABORTPATH;
+ PEMRENDPATH = ^EMRABORTPATH;
+
+ EMRCLOSEFIGURE = EMRABORTPATH;
+ TEMRCLOSEFIGURE = EMRABORTPATH;
+ PEMRCLOSEFIGURE = ^EMRABORTPATH;
+
+ EMRFLATTENPATH = EMRABORTPATH;
+ TEMRFLATTENPATH = EMRABORTPATH;
+ PEMRFLATTENPATH = ^EMRABORTPATH;
+
+ EMRWIDENPATH = EMRABORTPATH;
+ TEMRWIDENPATH = EMRABORTPATH;
+ PEMRWIDENPATH = ^EMRABORTPATH;
+
+ EMRSETMETARGN = EMRABORTPATH;
+ TEMRSETMETARGN = EMRABORTPATH;
+ PEMRSETMETARGN = ^EMRABORTPATH;
+
+ EMRSAVEDC = EMRABORTPATH;
+ TEMRSAVEDC = EMRABORTPATH;
+ PEMRSAVEDC = ^EMRABORTPATH;
+
+ EMRREALIZEPALETTE = EMRABORTPATH;
+ TEMRREALIZEPALETTE = EMRABORTPATH;
+ PEMRREALIZEPALETTE = ^EMRABORTPATH;
+
+ EMRSELECTCLIPPATH = record
+ emr : EMR;
+ iMode : DWORD;
+ end;
+ tagEMRSELECTCLIPPATH = EMRSELECTCLIPPATH;
+ TEMRSELECTCLIPPATH = EMRSELECTCLIPPATH;
+ PEMRSELECTCLIPPATH = ^EMRSELECTCLIPPATH;
+
+ EMRSETBKMODE = EMRSELECTCLIPPATH;
+ TEMRSETBKMODE = EMRSELECTCLIPPATH;
+ PEMRSETBKMODE = ^EMRSELECTCLIPPATH;
+
+ EMRSETMAPMODE = EMRSELECTCLIPPATH;
+ TEMRSETMAPMODE = EMRSELECTCLIPPATH;
+ PEMRSETMAPMODE = ^EMRSELECTCLIPPATH;
+
+ EMRSETPOLYFILLMODE = EMRSELECTCLIPPATH;
+ TEMRSETPOLYFILLMODE = EMRSELECTCLIPPATH;
+ PEMRSETPOLYFILLMODE = ^EMRSELECTCLIPPATH;
+
+ EMRSETROP2 = EMRSELECTCLIPPATH;
+ TEMRSETROP2 = EMRSELECTCLIPPATH;
+ PEMRSETROP2 = ^EMRSELECTCLIPPATH;
+
+ EMRSETSTRETCHBLTMODE = EMRSELECTCLIPPATH;
+ TEMRSETSTRETCHBLTMODE = EMRSELECTCLIPPATH;
+ PEMRSETSTRETCHBLTMODE = ^EMRSELECTCLIPPATH;
+
+ EMRSETTEXTALIGN = EMRSELECTCLIPPATH;
+ TEMRSETTEXTALIGN = EMRSELECTCLIPPATH;
+ PEMRSETTEXTALIGN = ^EMRSELECTCLIPPATH;
+
+ EMRENABLEICM = EMRSELECTCLIPPATH;
+ TEMRENABLEICM = EMRSELECTCLIPPATH;
+ PEMRENABLEICM = ^EMRSELECTCLIPPATH;
+
+ NMHDR = record
+ hwndFrom : HWND;
+ idFrom : UINT;
+ code : UINT;
+ end;
+ tagNMHDR = NMHDR;
+ TNMHDR = NMHDR;
+ PNMHDR = ^NMHDR;
+
+ ENCORRECTTEXT = record
+ nmhdr : NMHDR;
+ chrg : CHARRANGE;
+ seltyp : WORD;
+ end;
+ _encorrecttext = ENCORRECTTEXT;
+ Tencorrecttext = ENCORRECTTEXT;
+ Pencorrecttext = ^ENCORRECTTEXT;
+
+ ENDROPFILES = record
+ nmhdr : NMHDR;
+ hDrop : HANDLE;
+ cp : LONG;
+ fProtected : WINBOOL;
+ end;
+ _endropfiles = ENDROPFILES;
+ Tendropfiles = ENDROPFILES;
+ Pendropfiles = ^ENDROPFILES;
+
+ ENSAVECLIPBOARD = record
+ nmhdr : NMHDR;
+ cObjectCount : LONG;
+ cch : LONG;
+ end;
+ TENSAVECLIPBOARD = ENSAVECLIPBOARD;
+ PENSAVECLIPBOARD = ^ENSAVECLIPBOARD;
+
+ ENOLEOPFAILED = record
+ nmhdr : NMHDR;
+ iob : LONG;
+ lOper : LONG;
+ hr : HRESULT;
+ end;
+ TENOLEOPFAILED = ENOLEOPFAILED;
+ PENOLEOPFAILED = ^ENOLEOPFAILED;
+
+ ENHMETAHEADER = record
+ iType : DWORD;
+ nSize : DWORD;
+ rclBounds : RECTL;
+ rclFrame : RECTL;
+ dSignature : DWORD;
+ nVersion : DWORD;
+ nBytes : DWORD;
+ nRecords : DWORD;
+ nHandles : WORD;
+ sReserved : WORD;
+ nDescription : DWORD;
+ offDescription : DWORD;
+ nPalEntries : DWORD;
+ szlDevice : SIZEL;
+ szlMillimeters : SIZEL;
+ end;
+ LPENHMETAHEADER = ^ENHMETAHEADER;
+ tagENHMETAHEADER = ENHMETAHEADER;
+ TENHMETAHEADER = ENHMETAHEADER;
+ PENHMETAHEADER = ^ENHMETAHEADER;
+
+ ENHMETARECORD = record
+ iType : DWORD;
+ nSize : DWORD;
+ dParm : array[0..0] of DWORD;
+ end;
+ LPENHMETARECORD = ^ENHMETARECORD;
+ tagENHMETARECORD = ENHMETARECORD;
+ TENHMETARECORD = ENHMETARECORD;
+ PENHMETARECORD = ^ENHMETARECORD;
+
+ ENPROTECTED = record
+ nmhdr : NMHDR;
+ msg : UINT;
+ wParam : WPARAM;
+ lParam : LPARAM;
+ chrg : CHARRANGE;
+ end;
+ _enprotected = ENPROTECTED;
+ Tenprotected = ENPROTECTED;
+ Penprotected = ^ENPROTECTED;
+
+ SERVICE_STATUS = record
+ dwServiceType : DWORD;
+ dwCurrentState : DWORD;
+ dwControlsAccepted : DWORD;
+ dwWin32ExitCode : DWORD;
+ dwServiceSpecificExitCode : DWORD;
+ dwCheckPoint : DWORD;
+ dwWaitHint : DWORD;
+ end;
+ LPSERVICE_STATUS = ^SERVICE_STATUS;
+ _SERVICE_STATUS = SERVICE_STATUS;
+ TSERVICESTATUS = SERVICE_STATUS;
+ PSERVICESTATUS = ^SERVICE_STATUS;
+
+ ENUM_SERVICE_STATUS = record
+ lpServiceName : LPTSTR;
+ lpDisplayName : LPTSTR;
+ ServiceStatus : SERVICE_STATUS;
+ end;
+ LPENUM_SERVICE_STATUS = ^ENUM_SERVICE_STATUS;
+ _ENUM_SERVICE_STATUS = ENUM_SERVICE_STATUS;
+ TENUMSERVICESTATUS = ENUM_SERVICE_STATUS;
+ PENUMSERVICESTATUS = ^ENUM_SERVICE_STATUS;
+
+ ENUMLOGFONT = record
+ elfLogFont : LOGFONT;
+ elfFullName : array[0..(LF_FULLFACESIZE)-1] of BCHAR;
+ elfStyle : array[0..(LF_FACESIZE)-1] of BCHAR;
+ end;
+ tagENUMLOGFONT = ENUMLOGFONT;
+ TENUMLOGFONT = ENUMLOGFONT;
+ PENUMLOGFONT = ^ENUMLOGFONT;
+
+ ENUMLOGFONTEX = record
+ elfLogFont : LOGFONT;
+ elfFullName : array[0..(LF_FULLFACESIZE)-1] of BCHAR;
+ elfStyle : array[0..(LF_FACESIZE)-1] of BCHAR;
+ elfScript : array[0..(LF_FACESIZE)-1] of BCHAR;
+ end;
+ tagENUMLOGFONTEX = ENUMLOGFONTEX;
+ TENUMLOGFONTEX = ENUMLOGFONTEX;
+ PENUMLOGFONTEX = ^ENUMLOGFONTEX;
+ {
+ Then follow:
+
+ TCHAR SourceName[]
+ TCHAR Computername[]
+ SID UserSid
+ TCHAR Strings[]
+ BYTE Data[]
+ CHAR Pad[]
+ DWORD Length;
+ }
+
+ EVENTLOGRECORD = record
+ Length : DWORD;
+ Reserved : DWORD;
+ RecordNumber : DWORD;
+ TimeGenerated : DWORD;
+ TimeWritten : DWORD;
+ EventID : DWORD;
+ EventType : WORD;
+ NumStrings : WORD;
+ EventCategory : WORD;
+ ReservedFlags : WORD;
+ ClosingRecordNumber : DWORD;
+ StringOffset : DWORD;
+ UserSidLength : DWORD;
+ UserSidOffset : DWORD;
+ DataLength : DWORD;
+ DataOffset : DWORD;
+ end;
+ _EVENTLOGRECORD = EVENTLOGRECORD;
+ TEVENTLOGRECORD = EVENTLOGRECORD;
+ PEVENTLOGRECORD = ^EVENTLOGRECORD;
+
+ EVENTMSG = record
+ message : UINT;
+ paramL : UINT;
+ paramH : UINT;
+ time : DWORD;
+ hwnd : HWND;
+ end;
+ tagEVENTMSG = EVENTMSG;
+ TEVENTMSG = EVENTMSG;
+ PEVENTMSG = ^EVENTMSG;
+
+ EXCEPTION_POINTERS = record
+ ExceptionRecord : PEXCEPTION_RECORD;
+ ContextRecord : PCONTEXT;
+ end;
+ LPEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
+ PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
+ _EXCEPTION_POINTERS = EXCEPTION_POINTERS;
+ TEXCEPTIONPOINTERS = EXCEPTION_POINTERS;
+ PEXCEPTIONPOINTERS = ^EXCEPTION_POINTERS;
+
+ EXT_BUTTON = record
+ idCommand : WORD;
+ idsHelp : WORD;
+ fsStyle : WORD;
+ end;
+ LPEXT_BUTTON = ^EXT_BUTTON;
+ _EXT_BUTTON = EXT_BUTTON;
+ TEXTBUTTON = EXT_BUTTON;
+ PEXTBUTTON = ^EXT_BUTTON;
+
+ FILTERKEYS = record
+ cbSize : UINT;
+ dwFlags : DWORD;
+ iWaitMSec : DWORD;
+ iDelayMSec : DWORD;
+ iRepeatMSec : DWORD;
+ iBounceMSec : DWORD;
+ end;
+ tagFILTERKEYS = FILTERKEYS;
+ TFILTERKEYS = FILTERKEYS;
+ PFILTERKEYS = ^FILTERKEYS;
+
+ FIND_NAME_BUFFER = record
+ length : UCHAR;
+ access_control : UCHAR;
+ frame_control : UCHAR;
+ destination_addr : array[0..5] of UCHAR;
+ source_addr : array[0..5] of UCHAR;
+ routing_info : array[0..17] of UCHAR;
+ end;
+ _FIND_NAME_BUFFER = FIND_NAME_BUFFER;
+ TFINDNAMEBUFFER = FIND_NAME_BUFFER;
+ PFINDNAMEBUFFER = ^FIND_NAME_BUFFER;
+
+ FIND_NAME_HEADER = record
+ node_count : WORD;
+ reserved : UCHAR;
+ unique_group : UCHAR;
+ end;
+ _FIND_NAME_HEADER = FIND_NAME_HEADER;
+ TFINDNAMEHEADER = FIND_NAME_HEADER;
+ PFINDNAMEHEADER = ^FIND_NAME_HEADER;
+
+ FINDREPLACE = record
+ lStructSize : DWORD;
+ hwndOwner : HWND;
+ hInstance : HINST;
+ Flags : DWORD;
+ lpstrFindWhat : LPTSTR;
+ lpstrReplaceWith : LPTSTR;
+ wFindWhatLen : WORD;
+ wReplaceWithLen : WORD;
+ lCustData : LPARAM;
+ lpfnHook : LPFRHOOKPROC;
+ lpTemplateName : LPCTSTR;
+ end;
+ LPFINDREPLACE = ^FINDREPLACE;
+ TFINDREPLACE = FINDREPLACE;
+ PFINDREPLACE = ^FINDREPLACE;
+
+ {FINDTEXT = record conflicts with FindText function }
+ TFINDTEXT = record
+ chrg : CHARRANGE;
+ lpstrText : LPSTR;
+ end;
+ _findtext = TFINDTEXT;
+ Pfindtext = ^TFINDTEXT;
+
+ FINDTEXTEX = record
+ chrg : CHARRANGE;
+ lpstrText : LPSTR;
+ chrgText : CHARRANGE;
+ end;
+ _findtextex = FINDTEXTEX;
+ Tfindtextex = FINDTEXTEX;
+ Pfindtextex = ^FINDTEXTEX;
+
+ FMS_GETDRIVEINFO = record
+ dwTotalSpace : DWORD;
+ dwFreeSpace : DWORD;
+ szPath : array[0..259] of TCHAR;
+ szVolume : array[0..13] of TCHAR;
+ szShare : array[0..127] of TCHAR;
+ end;
+ _FMS_GETDRIVEINFO = FMS_GETDRIVEINFO;
+ TFMSGETDRIVEINFO = FMS_GETDRIVEINFO;
+ PFMSGETDRIVEINFO = ^FMS_GETDRIVEINFO;
+
+ FMS_GETFILESEL = record
+ ftTime : FILETIME;
+ dwSize : DWORD;
+ bAttr : BYTE;
+ szName : array[0..259] of TCHAR;
+ end;
+ _FMS_GETFILESEL = FMS_GETFILESEL;
+ TFMSGETFILESEL = FMS_GETFILESEL;
+ PFMSGETFILESEL = ^FMS_GETFILESEL;
+
+ FMS_LOAD = record
+ dwSize : DWORD;
+ szMenuName : array[0..(MENU_TEXT_LEN)-1] of TCHAR;
+ hMenu : HMENU;
+ wMenuDelta : UINT;
+ end;
+ _FMS_LOAD = FMS_LOAD;
+ TFMSLOAD = FMS_LOAD;
+ PFMSLOAD = ^FMS_LOAD;
+
+ FMS_TOOLBARLOAD = record
+ dwSize : DWORD;
+ lpButtons : LPEXT_BUTTON;
+ cButtons : WORD;
+ cBitmaps : WORD;
+ idBitmap : WORD;
+ hBitmap : HBITMAP;
+ end;
+ _FMS_TOOLBARLOAD = FMS_TOOLBARLOAD;
+ TFMSTOOLBARLOAD = FMS_TOOLBARLOAD;
+ PFMSTOOLBARLOAD = ^FMS_TOOLBARLOAD;
+
+ FOCUS_EVENT_RECORD = record
+ bSetFocus : WINBOOL;
+ end;
+ _FOCUS_EVENT_RECORD = FOCUS_EVENT_RECORD;
+ TFOCUSEVENTRECORD = FOCUS_EVENT_RECORD;
+ PFOCUSEVENTRECORD = ^FOCUS_EVENT_RECORD;
+
+ FORM_INFO_1 = record
+ Flags : DWORD;
+ pName : LPTSTR;
+ Size : SIZEL;
+ ImageableArea : RECTL;
+ end;
+ _FORM_INFO_1 = FORM_INFO_1;
+ TFORMINFO1 = FORM_INFO_1;
+ PFORMINFO1 = ^FORM_INFO_1;
+
+ FORMAT_PARAMETERS = record
+ MediaType : MEDIA_TYPE;
+ StartCylinderNumber : DWORD;
+ EndCylinderNumber : DWORD;
+ StartHeadNumber : DWORD;
+ EndHeadNumber : DWORD;
+ end;
+ _FORMAT_PARAMETERS = FORMAT_PARAMETERS;
+ TFORMATPARAMETERS = FORMAT_PARAMETERS;
+ PFORMATPARAMETERS = ^FORMAT_PARAMETERS;
+
+ FORMATRANGE = record
+ _hdc : HDC;
+ hdcTarget : HDC;
+ rc : RECT;
+ rcPage : RECT;
+ chrg : CHARRANGE;
+ end;
+ _formatrange = FORMATRANGE;
+ Tformatrange = FORMATRANGE;
+ Pformatrange = ^FORMATRANGE;
+
+ GCP_RESULTS = record
+ lStructSize : DWORD;
+ lpOutString : LPTSTR;
+ lpOrder : ^UINT;
+ lpDx : ^WINT;
+ lpCaretPos : ^WINT;
+ lpClass : LPTSTR;
+ lpGlyphs : ^UINT;
+ nGlyphs : UINT;
+ nMaxFit : UINT;
+ end;
+ LPGCP_RESULTS = ^GCP_RESULTS;
+ tagGCP_RESULTS = GCP_RESULTS;
+ TGCPRESULTS = GCP_RESULTS;
+ PGCPRESULTS = ^GCP_RESULTS;
+
+ GENERIC_MAPPING = record
+ GenericRead : ACCESS_MASK;
+ GenericWrite : ACCESS_MASK;
+ GenericExecute : ACCESS_MASK;
+ GenericAll : ACCESS_MASK;
+ end;
+ PGENERIC_MAPPING = ^GENERIC_MAPPING;
+ _GENERIC_MAPPING = GENERIC_MAPPING;
+ TGENERICMAPPING = GENERIC_MAPPING;
+ PGENERICMAPPING = ^GENERIC_MAPPING;
+
+ GLYPHMETRICS = record
+ gmBlackBoxX : UINT;
+ gmBlackBoxY : UINT;
+ gmptGlyphOrigin : POINT;
+ gmCellIncX : integer;
+ gmCellIncY : integer;
+ end;
+ LPGLYPHMETRICS = ^GLYPHMETRICS;
+ _GLYPHMETRICS = GLYPHMETRICS;
+ TGLYPHMETRICS = GLYPHMETRICS;
+ PGLYPHMETRICS = ^GLYPHMETRICS;
+
+ HANDLETABLE = record
+ objectHandle : array[0..0] of HGDIOBJ;
+ end;
+ tagHANDLETABLE = HANDLETABLE;
+ THANDLETABLE = HANDLETABLE;
+ LPHANDLETABLE = ^HANDLETABLE;
+
+ HD_HITTESTINFO = record
+ pt : POINT;
+ flags : UINT;
+ iItem : longint;
+ end;
+ _HD_HITTESTINFO = HD_HITTESTINFO;
+ THDHITTESTINFO = HD_HITTESTINFO;
+ PHDHITTESTINFO = ^HD_HITTESTINFO;
+
+ HD_ITEM = record
+ mask : UINT;
+ cxy : longint;
+ pszText : LPTSTR;
+ hbm : HBITMAP;
+ cchTextMax : longint;
+ fmt : longint;
+ lParam : LPARAM;
+ end;
+ _HD_ITEM = HD_ITEM;
+ THDITEM = HD_ITEM;
+ PHDITEM = ^HD_ITEM;
+
+ WINDOWPOS = record
+ _hwnd : HWND;
+ hwndInsertAfter : HWND;
+ x : longint;
+ y : longint;
+ cx : longint;
+ cy : longint;
+ flags : UINT;
+ end;
+ LPWINDOWPOS = ^WINDOWPOS;
+ _WINDOWPOS = WINDOWPOS;
+ TWINDOWPOS = WINDOWPOS;
+ PWINDOWPOS = ^WINDOWPOS;
+
+ HD_LAYOUT = record
+ prc : ^RECT;
+ pwpos : ^WINDOWPOS;
+ end;
+ _HD_LAYOUT = HD_LAYOUT;
+ THDLAYOUT = HD_LAYOUT;
+ PHDLAYOUT = ^HD_LAYOUT;
+
+ HD_NOTIFY = record
+ hdr : NMHDR;
+ iItem : longint;
+ iButton : longint;
+ pitem : ^HD_ITEM;
+ end;
+ _HD_NOTIFY = HD_NOTIFY;
+ THDNOTIFY = HD_NOTIFY;
+ PHDNOTIFY = ^HD_NOTIFY;
+
+ HELPINFO = record
+ cbSize : UINT;
+ iContextType : longint;
+ iCtrlId : longint;
+ hItemHandle : HANDLE;
+ dwContextId : DWORD;
+ MousePos : POINT;
+ end;
+ LPHELPINFO = ^HELPINFO;
+ tagHELPINFO = HELPINFO;
+ THELPINFO = HELPINFO;
+ PHELPINFO = ^HELPINFO;
+
+ HELPWININFO = record
+ wStructSize : longint;
+ x : longint;
+ y : longint;
+ dx : longint;
+ dy : longint;
+ wMax : longint;
+ rgchMember : array[0..1] of TCHAR;
+ end;
+ THELPWININFO = HELPWININFO;
+ PHELPWININFO = ^HELPWININFO;
+
+ HIGHCONTRAST = record
+ cbSize : UINT;
+ dwFlags : DWORD;
+ lpszDefaultScheme : LPTSTR;
+ end;
+ LPHIGHCONTRAST = ^HIGHCONTRAST;
+ tagHIGHCONTRAST = HIGHCONTRAST;
+ THIGHCONTRAST = HIGHCONTRAST;
+ PHIGHCONTRAST = ^HIGHCONTRAST;
+
+ HSZPAIR = record
+ hszSvc : HSZ;
+ hszTopic : HSZ;
+ end;
+ tagHSZPAIR = HSZPAIR;
+ THSZPAIR = HSZPAIR;
+ PHSZPAIR = ^HSZPAIR;
+
+ ICONINFO = record
+ fIcon : WINBOOL;
+ xHotspot : DWORD;
+ yHotspot : DWORD;
+ hbmMask : HBITMAP;
+ hbmColor : HBITMAP;
+ end;
+ _ICONINFO = ICONINFO;
+ TICONINFO = ICONINFO;
+ PICONINFO = ^ICONINFO;
+
+ ICONMETRICS = record
+ cbSize : UINT;
+ iHorzSpacing : longint;
+ iVertSpacing : longint;
+ iTitleWrap : longint;
+ lfFont : LOGFONT;
+ end;
+ LPICONMETRICS = ^ICONMETRICS;
+ tagICONMETRICS = ICONMETRICS;
+ TICONMETRICS = ICONMETRICS;
+ PICONMETRICS = ^ICONMETRICS;
+
+ IMAGEINFO = record
+ hbmImage : HBITMAP;
+ hbmMask : HBITMAP;
+ Unused1 : longint;
+ Unused2 : longint;
+ rcImage : RECT;
+ end;
+ _IMAGEINFO = IMAGEINFO;
+ TIMAGEINFO = IMAGEINFO;
+ PIMAGEINFO = ^IMAGEINFO;
+
+ KEY_EVENT_RECORD = packed record
+ bKeyDown : WINBOOL;
+ wRepeatCount : WORD;
+ wVirtualKeyCode : WORD;
+ wVirtualScanCode : WORD;
+ case longint of
+ 0 : ( UnicodeChar : WCHAR;
+ dwControlKeyState : DWORD; );
+ 1 : ( AsciiChar : CHAR );
+ end;
+ _KEY_EVENT_RECORD = KEY_EVENT_RECORD;
+ TKEYEVENTRECORD = KEY_EVENT_RECORD;
+ PKEYEVENTRECORD = ^KEY_EVENT_RECORD;
+
+ MOUSE_EVENT_RECORD = record
+ dwMousePosition : COORD;
+ dwButtonState : DWORD;
+ dwControlKeyState : DWORD;
+ dwEventFlags : DWORD;
+ end;
+ _MOUSE_EVENT_RECORD = MOUSE_EVENT_RECORD;
+ TMOUSEEVENTRECORD = MOUSE_EVENT_RECORD;
+ PMOUSEEVENTRECORD = ^MOUSE_EVENT_RECORD;
+
+ WINDOW_BUFFER_SIZE_RECORD = record
+ dwSize : COORD;
+ end;
+ _WINDOW_BUFFER_SIZE_RECORD = WINDOW_BUFFER_SIZE_RECORD;
+ TWINDOWBUFFERSIZERECORD = WINDOW_BUFFER_SIZE_RECORD;
+ PWINDOWBUFFERSIZERECORD = ^WINDOW_BUFFER_SIZE_RECORD;
+
+ MENU_EVENT_RECORD = record
+ dwCommandId : UINT;
+ end;
+ PMENU_EVENT_RECORD = ^MENU_EVENT_RECORD;
+ _MENU_EVENT_RECORD = MENU_EVENT_RECORD;
+ TMENUEVENTRECORD = MENU_EVENT_RECORD;
+ PMENUEVENTRECORD = ^MENU_EVENT_RECORD;
+
+ INPUT_RECORD = record
+ EventType: Word;
+ Reserved: Word;
+ Event : record case longint of
+ 0 : ( KeyEvent : KEY_EVENT_RECORD );
+ 1 : ( MouseEvent : MOUSE_EVENT_RECORD );
+ 2 : ( WindowBufferSizeEvent : WINDOW_BUFFER_SIZE_RECORD );
+ 3 : ( MenuEvent : MENU_EVENT_RECORD );
+ 4 : ( FocusEvent : FOCUS_EVENT_RECORD );
+ end;
+ end;
+ PINPUT_RECORD = ^INPUT_RECORD;
+ _INPUT_RECORD = INPUT_RECORD;
+ TINPUTRECORD = INPUT_RECORD;
+ PINPUTRECORD = ^INPUT_RECORD;
+
+ SYSTEMTIME = record
+ case integer of
+ 1 : (
+ wYear : WORD;
+ wMonth : WORD;
+ wDayOfWeek : WORD;
+ wDay : WORD;
+ wHour : WORD;
+ wMinute : WORD;
+ wSecond : WORD;
+ wMilliseconds : WORD;
+ );
+ { Compatibility for FPC }
+ 2 : (
+ Year : WORD;
+ Month : WORD;
+ DayOfWeek : WORD;
+ Day : WORD;
+ Hour : WORD;
+ Minute : WORD;
+ Second : WORD;
+ Millisecond : WORD;
+ );
+ end;
+ LPSYSTEMTIME = ^SYSTEMTIME;
+ _SYSTEMTIME = SYSTEMTIME;
+ TSYSTEMTIME = SYSTEMTIME;
+ PSYSTEMTIME = ^SYSTEMTIME;
+
+ JOB_INFO_1 = record
+ JobId : DWORD;
+ pPrinterName : LPTSTR;
+ pMachineName : LPTSTR;
+ pUserName : LPTSTR;
+ pDocument : LPTSTR;
+ pDatatype : LPTSTR;
+ pStatus : LPTSTR;
+ Status : DWORD;
+ Priority : DWORD;
+ Position : DWORD;
+ TotalPages : DWORD;
+ PagesPrinted : DWORD;
+ Submitted : SYSTEMTIME;
+ end;
+ _JOB_INFO_1 = JOB_INFO_1;
+ TJOBINFO1 = JOB_INFO_1;
+ PJOBINFO1 = ^JOB_INFO_1;
+
+ SID_IDENTIFIER_AUTHORITY = record
+ Value : array[0..5] of BYTE;
+ end;
+ LPSID_IDENTIFIER_AUTHORITY = ^SID_IDENTIFIER_AUTHORITY;
+ PSID_IDENTIFIER_AUTHORITY = ^SID_IDENTIFIER_AUTHORITY;
+ _SID_IDENTIFIER_AUTHORITY = SID_IDENTIFIER_AUTHORITY;
+ TSIDIDENTIFIERAUTHORITY = SID_IDENTIFIER_AUTHORITY;
+ PSIDIDENTIFIERAUTHORITY = ^SID_IDENTIFIER_AUTHORITY;
+
+ SID = record
+ Revision : BYTE;
+ SubAuthorityCount : BYTE;
+ IdentifierAuthority : SID_IDENTIFIER_AUTHORITY;
+ SubAuthority : array[0..(ANYSIZE_ARRAY)-1] of DWORD;
+ end;
+ _SID = SID;
+ TSID = SID;
+ PSID = ^SID;
+
+ SECURITY_DESCRIPTOR_CONTROL = WORD;
+ PSECURITY_DESCRIPTOR_CONTROL = ^SECURITY_DESCRIPTOR_CONTROL;
+ TSECURITYDESCRIPTORCONTROL = SECURITY_DESCRIPTOR_CONTROL;
+ PSECURITYDESCRIPTORCONTROL = ^SECURITY_DESCRIPTOR_CONTROL;
+
+ SECURITY_DESCRIPTOR = record
+ Revision : BYTE;
+ Sbz1 : BYTE;
+ Control : SECURITY_DESCRIPTOR_CONTROL;
+ Owner : PSID;
+ Group : PSID;
+ Sacl : PACL;
+ Dacl : PACL;
+ end;
+ PSECURITY_DESCRIPTOR = ^SECURITY_DESCRIPTOR;
+ _SECURITY_DESCRIPTOR = SECURITY_DESCRIPTOR;
+ TSECURITYDESCRIPTOR = SECURITY_DESCRIPTOR;
+ PSECURITYDESCRIPTOR = ^SECURITY_DESCRIPTOR;
+
+ JOB_INFO_2 = record
+ JobId : DWORD;
+ pPrinterName : LPTSTR;
+ pMachineName : LPTSTR;
+ pUserName : LPTSTR;
+ pDocument : LPTSTR;
+ pNotifyName : LPTSTR;
+ pDatatype : LPTSTR;
+ pPrintProcessor : LPTSTR;
+ pParameters : LPTSTR;
+ pDriverName : LPTSTR;
+ pDevMode : LPDEVMODE;
+ pStatus : LPTSTR;
+ pSecurityDescriptor : PSECURITY_DESCRIPTOR;
+ Status : DWORD;
+ Priority : DWORD;
+ Position : DWORD;
+ StartTime : DWORD;
+ UntilTime : DWORD;
+ TotalPages : DWORD;
+ Size : DWORD;
+ Submitted : SYSTEMTIME;
+ Time : DWORD;
+ PagesPrinted : DWORD;
+ end;
+ _JOB_INFO_2 = JOB_INFO_2;
+ TJOBINFO2 = JOB_INFO_2;
+ PJOBINFO2 = ^JOB_INFO_2;
+
+ KERNINGPAIR = record
+ wFirst : WORD;
+ wSecond : WORD;
+ iKernAmount : longint;
+ end;
+ LPKERNINGPAIR = ^KERNINGPAIR;
+ tagKERNINGPAIR = KERNINGPAIR;
+ TKERNINGPAIR = KERNINGPAIR;
+ PKERNINGPAIR = ^KERNINGPAIR;
+
+ LANA_ENUM = record
+ length : UCHAR;
+ lana : array[0..(MAX_LANA)-1] of UCHAR;
+ end;
+ _LANA_ENUM = LANA_ENUM;
+ TLANAENUM = LANA_ENUM;
+ PLANAENUM = ^LANA_ENUM;
+
+ LDT_ENTRY = record
+ LimitLow : WORD;
+ BaseLow : WORD;
+ HighWord : record
+ case longint of
+ 0 : ( Bytes : record
+ BaseMid : BYTE;
+ Flags1 : BYTE;
+ Flags2 : BYTE;
+ BaseHi : BYTE;
+ end );
+ 1 : ( Bits : record
+ flag0 : longint;
+ end );
+ end;
+ end;
+ LPLDT_ENTRY = ^LDT_ENTRY;
+ PLDT_ENTRY = ^LDT_ENTRY;
+ _LDT_ENTRY = LDT_ENTRY;
+ TLDTENTRY = LDT_ENTRY;
+ PLDTENTRY = ^LDT_ENTRY;
+
+ const
+ bm_LDT_ENTRY_BaseMid = $FF;
+ bp_LDT_ENTRY_BaseMid = 0;
+ bm_LDT_ENTRY_Type = $1F00;
+ bp_LDT_ENTRY_Type = 8;
+ bm_LDT_ENTRY_Dpl = $6000;
+ bp_LDT_ENTRY_Dpl = 13;
+ bm_LDT_ENTRY_Pres = $8000;
+ bp_LDT_ENTRY_Pres = 15;
+ bm_LDT_ENTRY_LimitHi = $F0000;
+ bp_LDT_ENTRY_LimitHi = 16;
+ bm_LDT_ENTRY_Sys = $100000;
+ bp_LDT_ENTRY_Sys = 20;
+ bm_LDT_ENTRY_Reserved_0 = $200000;
+ bp_LDT_ENTRY_Reserved_0 = 21;
+ bm_LDT_ENTRY_Default_Big = $400000;
+ bp_LDT_ENTRY_Default_Big = 22;
+ bm_LDT_ENTRY_Granularity = $800000;
+ bp_LDT_ENTRY_Granularity = 23;
+ bm_LDT_ENTRY_BaseHi = $FF000000;
+ bp_LDT_ENTRY_BaseHi = 24;
+
+ type
+
+ LOCALESIGNATURE = record
+ lsUsb : array[0..3] of DWORD;
+ lsCsbDefault : array[0..1] of DWORD;
+ lsCsbSupported : array[0..1] of DWORD;
+ end;
+ tagLOCALESIGNATURE = LOCALESIGNATURE;
+ TLOCALESIGNATURE = LOCALESIGNATURE;
+ PLOCALESIGNATURE = ^LOCALESIGNATURE;
+
+ LOCALGROUP_MEMBERS_INFO_0 = record
+ lgrmi0_sid : PSID;
+ end;
+ _LOCALGROUP_MEMBERS_INFO_0 = LOCALGROUP_MEMBERS_INFO_0;
+ TLOCALGROUPMEMBERSINFO0 = LOCALGROUP_MEMBERS_INFO_0;
+ PLOCALGROUPMEMBERSINFO0 = ^LOCALGROUP_MEMBERS_INFO_0;
+
+ LOCALGROUP_MEMBERS_INFO_3 = record
+ lgrmi3_domainandname : LPWSTR;
+ end;
+ _LOCALGROUP_MEMBERS_INFO_3 = LOCALGROUP_MEMBERS_INFO_3;
+ TLOCALGROUPMEMBERSINFO3 = LOCALGROUP_MEMBERS_INFO_3;
+ PLOCALGROUPMEMBERSINFO3 = ^LOCALGROUP_MEMBERS_INFO_3;
+
+ FXPT16DOT16 = longint;
+ LPFXPT16DOT16 = ^FXPT16DOT16;
+ TFXPT16DOT16 = FXPT16DOT16;
+ PFXPT16DOT16 = ^FXPT16DOT16;
+
+ LUID = TlargeInteger;
+ TLUID = LUID;
+ PLUID = ^LUID;
+
+ LUID_AND_ATTRIBUTES = record
+ Luid : LUID;
+ Attributes : DWORD;
+ end;
+ _LUID_AND_ATTRIBUTES = LUID_AND_ATTRIBUTES;
+ TLUIDANDATTRIBUTES = LUID_AND_ATTRIBUTES;
+ PLUIDANDATTRIBUTES = ^LUID_AND_ATTRIBUTES;
+
+ LUID_AND_ATTRIBUTES_ARRAY = array[0..(ANYSIZE_ARRAY)-1] of LUID_AND_ATTRIBUTES;
+ PLUID_AND_ATTRIBUTES_ARRAY = ^LUID_AND_ATTRIBUTES_ARRAY;
+ TLUIDANDATTRIBUTESARRAY = LUID_AND_ATTRIBUTES_ARRAY;
+ PLUIDANDATTRIBUTESARRAY = ^LUID_AND_ATTRIBUTES_ARRAY;
+
+ LV_COLUMN = record
+ mask : UINT;
+ fmt : longint;
+ cx : longint;
+ pszText : LPTSTR;
+ cchTextMax : longint;
+ iSubItem : longint;
+ end;
+ _LV_COLUMN = LV_COLUMN;
+ TLVCOLUMN = LV_COLUMN;
+ PLVCOLUMN = ^LV_COLUMN;
+
+ LV_ITEM = record
+ mask : UINT;
+ iItem : longint;
+ iSubItem : longint;
+ state : UINT;
+ stateMask : UINT;
+ pszText : LPTSTR;
+ cchTextMax : longint;
+ iImage : longint;
+ lParam : LPARAM;
+ end;
+ _LV_ITEM = LV_ITEM;
+ TLVITEM = LV_ITEM;
+ PLVITEM = ^LV_ITEM;
+
+ LV_DISPINFO = record
+ hdr : NMHDR;
+ item : LV_ITEM;
+ end;
+ tagLV_DISPINFO = LV_DISPINFO;
+ TLVDISPINFO = LV_DISPINFO;
+ PLVDISPINFO = ^LV_DISPINFO;
+
+ LV_FINDINFO = record
+ flags : UINT;
+ psz : LPCTSTR;
+ lParam : LPARAM;
+ pt : POINT;
+ vkDirection : UINT;
+ end;
+ _LV_FINDINFO = LV_FINDINFO;
+ TLVFINDINFO = LV_FINDINFO;
+ PLVFINDINFO = ^LV_FINDINFO;
+
+ LV_HITTESTINFO = record
+ pt : POINT;
+ flags : UINT;
+ iItem : longint;
+ end;
+ _LV_HITTESTINFO = LV_HITTESTINFO;
+ TLVHITTESTINFO = LV_HITTESTINFO;
+ PLVHITTESTINFO = ^LV_HITTESTINFO;
+
+ LV_KEYDOWN = record
+ hdr : NMHDR;
+ wVKey : WORD;
+ flags : UINT;
+ end;
+ tagLV_KEYDOWN = LV_KEYDOWN;
+ TLVKEYDOWN = LV_KEYDOWN;
+ PLVKEYDOWN = ^LV_KEYDOWN;
+
+ MAT2 = record
+ eM11 : FIXED;
+ eM12 : FIXED;
+ eM21 : FIXED;
+ eM22 : FIXED;
+ end;
+ _MAT2 = MAT2;
+ TMAT2 = MAT2;
+ PMAT2 = ^MAT2;
+
+ MDICREATESTRUCT = record
+ szClass : LPCTSTR;
+ szTitle : LPCTSTR;
+ hOwner : HANDLE;
+ x : longint;
+ y : longint;
+ cx : longint;
+ cy : longint;
+ style : DWORD;
+ lParam : LPARAM;
+ end;
+ LPMDICREATESTRUCT = ^MDICREATESTRUCT;
+ tagMDICREATESTRUCT = MDICREATESTRUCT;
+ TMDICREATESTRUCT = MDICREATESTRUCT;
+ PMDICREATESTRUCT = ^MDICREATESTRUCT;
+
+ MEASUREITEMSTRUCT = record
+ CtlType : UINT;
+ CtlID : UINT;
+ itemID : UINT;
+ itemWidth : UINT;
+ itemHeight : UINT;
+ itemData : DWORD;
+ end;
+ LPMEASUREITEMSTRUCT = ^MEASUREITEMSTRUCT;
+ tagMEASUREITEMSTRUCT = MEASUREITEMSTRUCT;
+ TMEASUREITEMSTRUCT = MEASUREITEMSTRUCT;
+ PMEASUREITEMSTRUCT = ^MEASUREITEMSTRUCT;
+
+ MEMORY_BASIC_INFORMATION = record
+ BaseAddress : PVOID;
+ AllocationBase : PVOID;
+ AllocationProtect : DWORD;
+ RegionSize : DWORD;
+ State : DWORD;
+ Protect : DWORD;
+ _Type : DWORD;
+ end;
+ PMEMORY_BASIC_INFORMATION = ^MEMORY_BASIC_INFORMATION;
+ _MEMORY_BASIC_INFORMATION = MEMORY_BASIC_INFORMATION;
+ TMEMORYBASICINFORMATION = MEMORY_BASIC_INFORMATION;
+ PMEMORYBASICINFORMATION = ^MEMORY_BASIC_INFORMATION;
+
+ MEMORYSTATUS = record
+ dwLength : DWORD;
+ dwMemoryLoad : DWORD;
+ dwTotalPhys : DWORD;
+ dwAvailPhys : DWORD;
+ dwTotalPageFile : DWORD;
+ dwAvailPageFile : DWORD;
+ dwTotalVirtual : DWORD;
+ dwAvailVirtual : DWORD;
+ end;
+ LPMEMORYSTATUS = ^MEMORYSTATUS;
+ _MEMORYSTATUS = MEMORYSTATUS;
+ TMEMORYSTATUS = MEMORYSTATUS;
+ PMEMORYSTATUS = ^MEMORYSTATUS;
+
+ MENUEX_TEMPLATE_HEADER = record
+ wVersion : WORD;
+ wOffset : WORD;
+ dwHelpId : DWORD;
+ end;
+ TMENUXTEMPLATEHEADER = MENUEX_TEMPLATE_HEADER;
+ PMENUXTEMPLATEHEADER = ^MENUEX_TEMPLATE_HEADER;
+
+ MENUEX_TEMPLATE_ITEM = record
+ dwType : DWORD;
+ dwState : DWORD;
+ uId : UINT;
+ bResInfo : BYTE;
+ szText : array[0..0] of WCHAR;
+ dwHelpId : DWORD;
+ end;
+ TMENUEXTEMPLATEITEM = MENUEX_TEMPLATE_ITEM;
+ PMENUEXTEMPLATEITEM = ^MENUEX_TEMPLATE_ITEM;
+
+ MENUITEMINFO = record
+ cbSize : UINT;
+ fMask : UINT;
+ fType : UINT;
+ fState : UINT;
+ wID : UINT;
+ hSubMenu : HMENU;
+ hbmpChecked : HBITMAP;
+ hbmpUnchecked : HBITMAP;
+ dwItemData : DWORD;
+ dwTypeData : LPTSTR;
+ cch : UINT;
+ end;
+ LPMENUITEMINFO = ^MENUITEMINFO;
+ LPCMENUITEMINFO = ^MENUITEMINFO;
+ tagMENUITEMINFO = MENUITEMINFO;
+ TMENUITEMINFO = MENUITEMINFO;
+ TMENUITEMINFOA = MENUITEMINFO;
+ PMENUITEMINFO = ^MENUITEMINFO;
+
+ MENUITEMTEMPLATE = record
+ mtOption : WORD;
+ mtID : WORD;
+ mtString : array[0..0] of WCHAR;
+ end;
+ TMENUITEMTEMPLATE = MENUITEMTEMPLATE;
+ PMENUITEMTEMPLATE = ^MENUITEMTEMPLATE;
+
+ MENUITEMTEMPLATEHEADER = record
+ versionNumber : WORD;
+ offset : WORD;
+ end;
+ TMENUITEMTEMPLATEHEADER = MENUITEMTEMPLATEHEADER;
+ PMENUITEMTEMPLATEHEADER = ^MENUITEMTEMPLATEHEADER;
+
+ MENUTEMPLATE = record
+ end;
+ LPMENUTEMPLATE = ^MENUTEMPLATE;
+ TMENUTEMPLATE = MENUTEMPLATE;
+ PMENUTEMPLATE = ^MENUTEMPLATE;
+
+ METAFILEPICT = record
+ mm : LONG;
+ xExt : LONG;
+ yExt : LONG;
+ hMF : HMETAFILE;
+ end;
+ LPMETAFILEPICT = ^METAFILEPICT;
+ tagMETAFILEPICT = METAFILEPICT;
+ TMETAFILEPICT = METAFILEPICT;
+ PMETAFILEPICT = ^METAFILEPICT;
+
+ METAHEADER = packed record
+ mtType : WORD;
+ mtHeaderSize : WORD;
+ mtVersion : WORD;
+ mtSize : DWORD;
+ mtNoObjects : WORD;
+ mtMaxRecord : DWORD;
+ mtNoParameters : WORD;
+ end;
+ tagMETAHEADER = METAHEADER;
+ TMETAHEADER = METAHEADER;
+ PMETAHEADER = ^METAHEADER;
+
+ METARECORD = record
+ rdSize : DWORD;
+ rdFunction : WORD;
+ rdParm : array[0..0] of WORD;
+ end;
+ LPMETARECORD = ^METARECORD;
+ tagMETARECORD = METARECORD;
+ TMETARECORD = METARECORD;
+ PMETARECORD = ^METARECORD;
+
+ MINIMIZEDMETRICS = record
+ cbSize : UINT;
+ iWidth : longint;
+ iHorzGap : longint;
+ iVertGap : longint;
+ iArrange : longint;
+ end;
+ LPMINIMIZEDMETRICS = ^MINIMIZEDMETRICS;
+ tagMINIMIZEDMETRICS = MINIMIZEDMETRICS;
+ TMINIMIZEDMETRICS = MINIMIZEDMETRICS;
+ PMINIMIZEDMETRICS = ^MINIMIZEDMETRICS;
+
+ MINMAXINFO = record
+ ptReserved : POINT;
+ ptMaxSize : POINT;
+ ptMaxPosition : POINT;
+ ptMinTrackSize : POINT;
+ ptMaxTrackSize : POINT;
+ end;
+ tagMINMAXINFO = MINMAXINFO;
+ TMINMAXINFO = MINMAXINFO;
+ PMINMAXINFO = ^MINMAXINFO;
+
+ MODEMDEVCAPS = record
+ dwActualSize : DWORD;
+ dwRequiredSize : DWORD;
+ dwDevSpecificOffset : DWORD;
+ dwDevSpecificSize : DWORD;
+ dwModemProviderVersion : DWORD;
+ dwModemManufacturerOffset : DWORD;
+ dwModemManufacturerSize : DWORD;
+ dwModemModelOffset : DWORD;
+ dwModemModelSize : DWORD;
+ dwModemVersionOffset : DWORD;
+ dwModemVersionSize : DWORD;
+ dwDialOptions : DWORD;
+ dwCallSetupFailTimer : DWORD;
+ dwInactivityTimeout : DWORD;
+ dwSpeakerVolume : DWORD;
+ dwSpeakerMode : DWORD;
+ dwModemOptions : DWORD;
+ dwMaxDTERate : DWORD;
+ dwMaxDCERate : DWORD;
+ abVariablePortion : array[0..0] of BYTE;
+ end;
+ LPMODEMDEVCAPS = ^MODEMDEVCAPS;
+ TMODEMDEVCAPS = MODEMDEVCAPS;
+ PMODEMDEVCAPS = ^MODEMDEVCAPS;
+
+ modemdevcaps_tag = MODEMDEVCAPS;
+
+ MODEMSETTINGS = record
+ dwActualSize : DWORD;
+ dwRequiredSize : DWORD;
+ dwDevSpecificOffset : DWORD;
+ dwDevSpecificSize : DWORD;
+ dwCallSetupFailTimer : DWORD;
+ dwInactivityTimeout : DWORD;
+ dwSpeakerVolume : DWORD;
+ dwSpeakerMode : DWORD;
+ dwPreferredModemOptions : DWORD;
+ dwNegotiatedModemOptions : DWORD;
+ dwNegotiatedDCERate : DWORD;
+ abVariablePortion : array[0..0] of BYTE;
+ end;
+ LPMODEMSETTINGS = ^MODEMSETTINGS;
+ TMODEMSETTINGS = MODEMSETTINGS;
+ PMODEMSETTINGS = ^MODEMSETTINGS;
+
+ modemsettings_tag = MODEMSETTINGS;
+
+ MONCBSTRUCT = record
+ cb : UINT;
+ dwTime : DWORD;
+ hTask : HANDLE;
+ dwRet : DWORD;
+ wType : UINT;
+ wFmt : UINT;
+ hConv : HCONV;
+ hsz1 : HSZ;
+ hsz2 : HSZ;
+ hData : HDDEDATA;
+ dwData1 : DWORD;
+ dwData2 : DWORD;
+ cc : CONVCONTEXT;
+ cbData : DWORD;
+ Data : array[0..7] of DWORD;
+ end;
+ tagMONCBSTRUCT = MONCBSTRUCT;
+ TMONCBSTRUCT = MONCBSTRUCT;
+ PMONCBSTRUCT = ^MONCBSTRUCT;
+
+ MONCONVSTRUCT = record
+ cb : UINT;
+ fConnect : WINBOOL;
+ dwTime : DWORD;
+ hTask : HANDLE;
+ hszSvc : HSZ;
+ hszTopic : HSZ;
+ hConvClient : HCONV;
+ hConvServer : HCONV;
+ end;
+ tagMONCONVSTRUCT = MONCONVSTRUCT;
+ TMONCONVSTRUCT = MONCONVSTRUCT;
+ PMONCONVSTRUCT = ^MONCONVSTRUCT;
+
+ MONERRSTRUCT = record
+ cb : UINT;
+ wLastError : UINT;
+ dwTime : DWORD;
+ hTask : HANDLE;
+ end;
+ tagMONERRSTRUCT = MONERRSTRUCT;
+ TMONERRSTRUCT = MONERRSTRUCT;
+ PMONERRSTRUCT = ^MONERRSTRUCT;
+
+ MONHSZSTRUCT = record
+ cb : UINT;
+ fsAction : WINBOOL;
+ dwTime : DWORD;
+ hsz : HSZ;
+ hTask : HANDLE;
+ str : array[0..0] of TCHAR;
+ end;
+ tagMONHSZSTRUCT = MONHSZSTRUCT;
+ TMONHSZSTRUCT = MONHSZSTRUCT;
+ PMONHSZSTRUCT = ^MONHSZSTRUCT;
+
+ MONITOR_INFO_1 = record
+ pName : LPTSTR;
+ end;
+ _MONITOR_INFO_1 = MONITOR_INFO_1;
+ TMONITORINFO1 = MONITOR_INFO_1;
+ PMONITORINFO1 = ^MONITOR_INFO_1;
+
+ MONITOR_INFO_2 = record
+ pName : LPTSTR;
+ pEnvironment : LPTSTR;
+ pDLLName : LPTSTR;
+ end;
+ _MONITOR_INFO_2 = MONITOR_INFO_2;
+ TMONITORINFO2 = MONITOR_INFO_2;
+ PMONITORINFO2 = ^MONITOR_INFO_2;
+
+ MONLINKSTRUCT = record
+ cb : UINT;
+ dwTime : DWORD;
+ hTask : HANDLE;
+ fEstablished : WINBOOL;
+ fNoData : WINBOOL;
+ hszSvc : HSZ;
+ hszTopic : HSZ;
+ hszItem : HSZ;
+ wFmt : UINT;
+ fServer : WINBOOL;
+ hConvServer : HCONV;
+ hConvClient : HCONV;
+ end;
+ tagMONLINKSTRUCT = MONLINKSTRUCT;
+ TMONLINKSTRUCT = MONLINKSTRUCT;
+ PMONLINKSTRUCT = ^MONLINKSTRUCT;
+
+ MONMSGSTRUCT = record
+ cb : UINT;
+ hwndTo : HWND;
+ dwTime : DWORD;
+ hTask : HANDLE;
+ wMsg : UINT;
+ wParam : WPARAM;
+ lParam : LPARAM;
+ dmhd : DDEML_MSG_HOOK_DATA;
+ end;
+ tagMONMSGSTRUCT = MONMSGSTRUCT;
+ TMONMSGSTRUCT = MONMSGSTRUCT;
+ PMONMSGSTRUCT = ^MONMSGSTRUCT;
+
+ MOUSEHOOKSTRUCT = record
+ pt : POINT;
+ hwnd : HWND;
+ wHitTestCode : UINT;
+ dwExtraInfo : DWORD;
+ end;
+ LPMOUSEHOOKSTRUCT = ^MOUSEHOOKSTRUCT;
+ tagMOUSEHOOKSTRUCT = MOUSEHOOKSTRUCT;
+ TMOUSEHOOKSTRUCT = MOUSEHOOKSTRUCT;
+ PMOUSEHOOKSTRUCT = ^MOUSEHOOKSTRUCT;
+
+ MOUSEKEYS = record
+ cbSize : DWORD;
+ dwFlags : DWORD;
+ iMaxSpeed : DWORD;
+ iTimeToMaxSpeed : DWORD;
+ iCtrlSpeed : DWORD;
+ dwReserved1 : DWORD;
+ dwReserved2 : DWORD;
+ end;
+ TMOUSEKEYS = MOUSEKEYS;
+ PMOUSEKEYS = ^MOUSEKEYS;
+
+ MSGBOXCALLBACK = procedure (lpHelpInfo:LPHELPINFO);stdcall;
+ TMSGBOXCALLBACK = MSGBOXCALLBACK;
+
+ MSGBOXPARAMS = record
+ cbSize : UINT;
+ hwndOwner : HWND;
+ hInstance : HINST;
+ lpszText : LPCSTR;
+ lpszCaption : LPCSTR;
+ dwStyle : DWORD;
+ lpszIcon : LPCSTR;
+ dwContextHelpId : DWORD;
+ lpfnMsgBoxCallback : MSGBOXCALLBACK;
+ dwLanguageId : DWORD;
+ end;
+ LPMSGBOXPARAMS = ^MSGBOXPARAMS;
+ TMSGBOXPARAMS = MSGBOXPARAMS;
+ TMSGBOXPARAMSA = MSGBOXPARAMS;
+ PMSGBOXPARAMS = ^MSGBOXPARAMS;
+
+ MSGFILTER = record
+ nmhdr : NMHDR;
+ msg : UINT;
+ wParam : WPARAM;
+ lParam : LPARAM;
+ end;
+ _msgfilter = MSGFILTER;
+ Tmsgfilter = MSGFILTER;
+ Pmsgfilter = ^MSGFILTER;
+
+ MULTIKEYHELP = record
+ mkSize : DWORD;
+ mkKeylist : TCHAR;
+ szKeyphrase : array[0..0] of TCHAR;
+ end;
+ tagMULTIKEYHELP = MULTIKEYHELP;
+ TMULTIKEYHELP = MULTIKEYHELP;
+ PMULTIKEYHELP = ^MULTIKEYHELP;
+
+ NAME_BUFFER = record
+ name : array[0..(NCBNAMSZ)-1] of UCHAR;
+ name_num : UCHAR;
+ name_flags : UCHAR;
+ end;
+ _NAME_BUFFER = NAME_BUFFER;
+ TNAMEBUFFER = NAME_BUFFER;
+ PNAMEBUFFER = ^NAME_BUFFER;
+
+ p_NCB = ^_NCB;
+ NCB = record
+ ncb_command : UCHAR;
+ ncb_retcode : UCHAR;
+ ncb_lsn : UCHAR;
+ ncb_num : UCHAR;
+ ncb_buffer : PUCHAR;
+ ncb_length : WORD;
+ ncb_callname : array[0..(NCBNAMSZ)-1] of UCHAR;
+ ncb_name : array[0..(NCBNAMSZ)-1] of UCHAR;
+ ncb_rto : UCHAR;
+ ncb_sto : UCHAR;
+ ncb_post : procedure (_para1:p_NCB);CDECL;
+ ncb_lana_num : UCHAR;
+ ncb_cmd_cplt : UCHAR;
+ ncb_reserve : array[0..9] of UCHAR;
+ ncb_event : HANDLE;
+ end;
+ _NCB = NCB;
+ TNCB = NCB;
+ PNCB = ^NCB;
+
+ NCCALCSIZE_PARAMS = record
+ rgrc : array[0..2] of RECT;
+ lppos : PWINDOWPOS;
+ end;
+ _NCCALCSIZE_PARAMS = NCCALCSIZE_PARAMS;
+ TNCCALCSIZEPARAMS = NCCALCSIZE_PARAMS;
+ PNCCALCSIZEPARAMS = ^NCCALCSIZE_PARAMS;
+
+ NDDESHAREINFO = record
+ lRevision : LONG;
+ lpszShareName : LPTSTR;
+ lShareType : LONG;
+ lpszAppTopicList : LPTSTR;
+ fSharedFlag : LONG;
+ fService : LONG;
+ fStartAppFlag : LONG;
+ nCmdShow : LONG;
+ qModifyId : array[0..1] of LONG;
+ cNumItems : LONG;
+ lpszItemList : LPTSTR;
+ end;
+ _NDDESHAREINFO = NDDESHAREINFO;
+ TNDDESHAREINFO = NDDESHAREINFO;
+ PNDDESHAREINFO = ^NDDESHAREINFO;
+
+ NETRESOURCE = record
+ dwScope : DWORD;
+ dwType : DWORD;
+ dwDisplayType : DWORD;
+ dwUsage : DWORD;
+ lpLocalName : LPTSTR;
+ lpRemoteName : LPTSTR;
+ lpComment : LPTSTR;
+ lpProvider : LPTSTR;
+ end;
+ LPNETRESOURCE = ^NETRESOURCE;
+ _NETRESOURCE = NETRESOURCE;
+ TNETRESOURCE = NETRESOURCE;
+ TNETRESOURCEA = NETRESOURCE;
+ PNETRESOURCE = ^NETRESOURCE;
+ PNETRESOURCEA = ^NETRESOURCE;
+
+ NEWCPLINFO = record
+ dwSize : DWORD;
+ dwFlags : DWORD;
+ dwHelpContext : DWORD;
+ lData : LONG;
+ hIcon : HICON;
+ szName : array[0..31] of TCHAR;
+ szInfo : array[0..63] of TCHAR;
+ szHelpFile : array[0..127] of TCHAR;
+ end;
+ tagNEWCPLINFO = NEWCPLINFO;
+ TNEWCPLINFO = NEWCPLINFO;
+ PNEWCPLINFO = ^NEWCPLINFO;
+
+ NEWTEXTMETRIC = record
+ tmHeight : LONG;
+ tmAscent : LONG;
+ tmDescent : LONG;
+ tmInternalLeading : LONG;
+ tmExternalLeading : LONG;
+ tmAveCharWidth : LONG;
+ tmMaxCharWidth : LONG;
+ tmWeight : LONG;
+ tmOverhang : LONG;
+ tmDigitizedAspectX : LONG;
+ tmDigitizedAspectY : LONG;
+ tmFirstChar : BCHAR;
+ tmLastChar : BCHAR;
+ tmDefaultChar : BCHAR;
+ tmBreakChar : BCHAR;
+ tmItalic : BYTE;
+ tmUnderlined : BYTE;
+ tmStruckOut : BYTE;
+ tmPitchAndFamily : BYTE;
+ tmCharSet : BYTE;
+ ntmFlags : DWORD;
+ ntmSizeEM : UINT;
+ ntmCellHeight : UINT;
+ ntmAvgWidth : UINT;
+ end;
+ tagNEWTEXTMETRIC = NEWTEXTMETRIC;
+ TNEWTEXTMETRIC = NEWTEXTMETRIC;
+ PNEWTEXTMETRIC = ^NEWTEXTMETRIC;
+
+ NEWTEXTMETRICEX = record
+ ntmentm : NEWTEXTMETRIC;
+ ntmeFontSignature : FONTSIGNATURE;
+ end;
+ tagNEWTEXTMETRICEX = NEWTEXTMETRICEX;
+ TNEWTEXTMETRICEX = NEWTEXTMETRICEX;
+ PNEWTEXTMETRICEX = ^NEWTEXTMETRICEX;
+
+ NM_LISTVIEW = record
+ hdr : NMHDR;
+ iItem : longint;
+ iSubItem : longint;
+ uNewState : UINT;
+ uOldState : UINT;
+ uChanged : UINT;
+ ptAction : POINT;
+ lParam : LPARAM;
+ end;
+ tagNM_LISTVIEW = NM_LISTVIEW;
+ TNMLISTVIEW = NM_LISTVIEW;
+ PNMLISTVIEW = ^NM_LISTVIEW;
+
+ TV_ITEM = record
+ mask : UINT;
+ hItem : HTREEITEM;
+ state : UINT;
+ stateMask : UINT;
+ pszText : LPTSTR;
+ cchTextMax : longint;
+ iImage : longint;
+ iSelectedImage : longint;
+ cChildren : longint;
+ lParam : LPARAM;
+ end;
+ LPTV_ITEM = ^TV_ITEM;
+ _TV_ITEM = TV_ITEM;
+ TTVITEM = TV_ITEM;
+ PTVITEM = ^TV_ITEM;
+
+ NM_TREEVIEW = record
+ hdr : NMHDR;
+ action : UINT;
+ itemOld : TV_ITEM;
+ itemNew : TV_ITEM;
+ ptDrag : POINT;
+ end;
+ LPNM_TREEVIEW = ^NM_TREEVIEW;
+ _NM_TREEVIEW = NM_TREEVIEW;
+ TNMTREEVIEW = NM_TREEVIEW;
+ PNMTREEVIEW = ^NM_TREEVIEW;
+
+ NM_UPDOWNW = record
+ hdr : NMHDR;
+ iPos : longint;
+ iDelta : longint;
+ end;
+ _NM_UPDOWN = NM_UPDOWNW;
+ TNMUPDOWN = NM_UPDOWNW;
+ PNMUPDOWN = ^NM_UPDOWNW;
+
+ NONCLIENTMETRICS = record
+ cbSize : UINT;
+ iBorderWidth : longint;
+ iScrollWidth : longint;
+ iScrollHeight : longint;
+ iCaptionWidth : longint;
+ iCaptionHeight : longint;
+ lfCaptionFont : LOGFONT;
+ iSmCaptionWidth : longint;
+ iSmCaptionHeight : longint;
+ lfSmCaptionFont : LOGFONT;
+ iMenuWidth : longint;
+ iMenuHeight : longint;
+ lfMenuFont : LOGFONT;
+ lfStatusFont : LOGFONT;
+ lfMessageFont : LOGFONT;
+ end;
+ LPNONCLIENTMETRICS = ^NONCLIENTMETRICS;
+ tagNONCLIENTMETRICS = NONCLIENTMETRICS;
+ TNONCLIENTMETRICS = NONCLIENTMETRICS;
+ PNONCLIENTMETRICS = ^NONCLIENTMETRICS;
+
+ SERVICE_ADDRESS = record
+ dwAddressType : DWORD;
+ dwAddressFlags : DWORD;
+ dwAddressLength : DWORD;
+ dwPrincipalLength : DWORD;
+ lpAddress : ^BYTE;
+ lpPrincipal : ^BYTE;
+ end;
+ _SERVICE_ADDRESS = SERVICE_ADDRESS;
+ TSERVICEADDRESS = SERVICE_ADDRESS;
+ PSERVICEADDRESS = ^SERVICE_ADDRESS;
+
+ SERVICE_ADDRESSES = record
+ dwAddressCount : DWORD;
+ Addresses : array[0..0] of SERVICE_ADDRESS;
+ end;
+ LPSERVICE_ADDRESSES = ^SERVICE_ADDRESSES;
+ _SERVICE_ADDRESSES = SERVICE_ADDRESSES;
+ TSERVICEADDRESSES = SERVICE_ADDRESSES;
+ PSERVICEADDRESSES = ^SERVICE_ADDRESSES;
+
+ GUID = system.tguid;
+ LPGUID = ^GUID;
+ _GUID = GUID;
+ TGUID = GUID;
+ PGUID = ^GUID;
+
+ CLSID = GUID;
+ LPCLSID = ^CLSID;
+ TCLSID = CLSID;
+ PCLSID = ^CLSID;
+
+ SERVICE_INFO = record
+ lpServiceType : LPGUID;
+ lpServiceName : LPTSTR;
+ lpComment : LPTSTR;
+ lpLocale : LPTSTR;
+ dwDisplayHint : DWORD;
+ dwVersion : DWORD;
+ dwTime : DWORD;
+ lpMachineName : LPTSTR;
+ lpServiceAddress : LPSERVICE_ADDRESSES;
+ ServiceSpecificInfo : BLOB;
+ end;
+ _SERVICE_INFO = SERVICE_INFO;
+ TSERVICEINFO = SERVICE_INFO;
+ PSERVICEINFO = ^SERVICE_INFO;
+
+ NS_SERVICE_INFO = record
+ dwNameSpace : DWORD;
+ ServiceInfo : SERVICE_INFO;
+ end;
+ _NS_SERVICE_INFO = NS_SERVICE_INFO;
+ TNSSERVICEINFO = NS_SERVICE_INFO;
+ PNSSERVICEINFO = ^NS_SERVICE_INFO;
+
+ NUMBERFMT = record
+ NumDigits : UINT;
+ LeadingZero : UINT;
+ Grouping : UINT;
+ lpDecimalSep : LPTSTR;
+ lpThousandSep : LPTSTR;
+ NegativeOrder : UINT;
+ end;
+ _numberfmt = NUMBERFMT;
+ Tnumberfmt = NUMBERFMT;
+ Pnumberfmt = ^NUMBERFMT;
+
+ OFSTRUCT = record
+ cBytes : BYTE;
+ fFixedDisk : BYTE;
+ nErrCode : WORD;
+ Reserved1 : WORD;
+ Reserved2 : WORD;
+ szPathName : array[0..(OFS_MAXPATHNAME)-1] of CHAR;
+ end;
+ LPOFSTRUCT = ^OFSTRUCT;
+ _OFSTRUCT = OFSTRUCT;
+ TOFSTRUCT = OFSTRUCT;
+ POFSTRUCT = ^OFSTRUCT;
+
+ OPENFILENAME = record
+ lStructSize : DWORD;
+ hwndOwner : HWND;
+ hInstance : HINST;
+ lpstrFilter : LPCTSTR;
+ lpstrCustomFilter : LPTSTR;
+ nMaxCustFilter : DWORD;
+ nFilterIndex : DWORD;
+ lpstrFile : LPTSTR;
+ nMaxFile : DWORD;
+ lpstrFileTitle : LPTSTR;
+ nMaxFileTitle : DWORD;
+ lpstrInitialDir : LPCTSTR;
+ lpstrTitle : LPCTSTR;
+ Flags : DWORD;
+ nFileOffset : WORD;
+ nFileExtension : WORD;
+ lpstrDefExt : LPCTSTR;
+ lCustData : DWORD;
+ lpfnHook : LPOFNHOOKPROC;
+ lpTemplateName : LPCTSTR;
+ end;
+ LPOPENFILENAME = ^OPENFILENAME;
+ TOPENFILENAME = OPENFILENAME;
+ POPENFILENAME = ^OPENFILENAME;
+
+ tagOFN = OPENFILENAME;
+ TOFN = OPENFILENAME;
+ POFN = ^OPENFILENAME;
+
+ OFNOTIFY = record
+ hdr : NMHDR;
+ lpOFN : LPOPENFILENAME;
+ pszFile : LPTSTR;
+ end;
+ LPOFNOTIFY = ^OFNOTIFY;
+ _OFNOTIFY = OFNOTIFY;
+ TOFNOTIFY = OFNOTIFY;
+ POFNOTIFY = ^OFNOTIFY;
+
+ OSVERSIONINFO = record
+ dwOSVersionInfoSize : DWORD;
+ dwMajorVersion : DWORD;
+ dwMinorVersion : DWORD;
+ dwBuildNumber : DWORD;
+ dwPlatformId : DWORD;
+ szCSDVersion : array[0..127] of TCHAR;
+ end;
+ LPOSVERSIONINFO = ^OSVERSIONINFO;
+ _OSVERSIONINFO = OSVERSIONINFO;
+ TOSVERSIONINFO = OSVERSIONINFO;
+ POSVERSIONINFO = ^OSVERSIONINFO;
+
+ OSVERSIONINFOW = record
+ dwOSVersionInfoSize : DWORD;
+ dwMajorVersion : DWORD;
+ dwMinorVersion : DWORD;
+ dwBuildNumber : DWORD;
+ dwPlatformId : DWORD;
+ szCSDVersion : array[0..127] of WCHAR;
+ end;
+ LPOSVERSIONINFOW = ^OSVERSIONINFOW;
+ _OSVERSIONINFOW = OSVERSIONINFOW;
+ TOSVERSIONINFOW = OSVERSIONINFOW;
+ POSVERSIONINFOW = ^OSVERSIONINFOW;
+
+
+
+
+
+ TEXTMETRIC = record
+ tmHeight : LONG;
+ tmAscent : LONG;
+ tmDescent : LONG;
+ tmInternalLeading : LONG;
+ tmExternalLeading : LONG;
+ tmAveCharWidth : LONG;
+ tmMaxCharWidth : LONG;
+ tmWeight : LONG;
+ tmOverhang : LONG;
+ tmDigitizedAspectX : LONG;
+ tmDigitizedAspectY : LONG;
+ tmFirstChar : BCHAR;
+ tmLastChar : BCHAR;
+ tmDefaultChar : BCHAR;
+ tmBreakChar : BCHAR;
+ tmItalic : BYTE;
+ tmUnderlined : BYTE;
+ tmStruckOut : BYTE;
+ tmPitchAndFamily : BYTE;
+ tmCharSet : BYTE;
+ end;
+ LPTEXTMETRIC = ^TEXTMETRIC;
+ tagTEXTMETRIC = TEXTMETRIC;
+ TTEXTMETRIC = TEXTMETRIC;
+ PTEXTMETRIC = ^TEXTMETRIC;
+
+ TEXTMETRICW = record
+ tmHeight : LONG;
+ tmAscent : LONG;
+ tmDescent : LONG;
+ tmInternalLeading : LONG;
+ tmExternalLeading : LONG;
+ tmAveCharWidth : LONG;
+ tmMaxCharWidth : LONG;
+ tmWeight : LONG;
+ tmOverhang : LONG;
+ tmDigitizedAspectX : LONG;
+ tmDigitizedAspectY : LONG;
+ tmFirstChar : WCHAR;
+ tmLastChar : WCHAR;
+ tmDefaultChar : WCHAR;
+ tmBreakChar : WCHAR;
+ tmItalic : BYTE;
+ tmUnderlined : BYTE;
+ tmStruckOut : BYTE;
+ tmPitchAndFamily : BYTE;
+ tmCharSet : BYTE;
+ end;
+ LPTEXTMETRICW = ^TEXTMETRICW;
+ tagTEXTMETRICW = TEXTMETRICW;
+ TTEXTMETRICW = TEXTMETRICW;
+ PTEXTMETRICW = ^TEXTMETRICW;
+
+
+ OUTLINETEXTMETRIC = record
+ otmSize : UINT;
+ otmTextMetrics : TEXTMETRIC;
+ otmFiller : BYTE;
+ otmPanoseNumber : PANOSE;
+ otmfsSelection : UINT;
+ otmfsType : UINT;
+ otmsCharSlopeRise : longint;
+ otmsCharSlopeRun : longint;
+ otmItalicAngle : longint;
+ otmEMSquare : UINT;
+ otmAscent : longint;
+ otmDescent : longint;
+ otmLineGap : UINT;
+ otmsCapEmHeight : UINT;
+ otmsXHeight : UINT;
+ otmrcFontBox : RECT;
+ otmMacAscent : longint;
+ otmMacDescent : longint;
+ otmMacLineGap : UINT;
+ otmusMinimumPPEM : UINT;
+ otmptSubscriptSize : POINT;
+ otmptSubscriptOffset : POINT;
+ otmptSuperscriptSize : POINT;
+ otmptSuperscriptOffset : POINT;
+ otmsStrikeoutSize : UINT;
+ otmsStrikeoutPosition : longint;
+ otmsUnderscoreSize : longint;
+ otmsUnderscorePosition : longint;
+ otmpFamilyName : PSTR;
+ otmpFaceName : PSTR;
+ otmpStyleName : PSTR;
+ otmpFullName : PSTR;
+ end;
+ LPOUTLINETEXTMETRIC = ^OUTLINETEXTMETRIC;
+ _OUTLINETEXTMETRIC = OUTLINETEXTMETRIC;
+ TOUTLINETEXTMETRIC = OUTLINETEXTMETRIC;
+ POUTLINETEXTMETRIC = ^OUTLINETEXTMETRIC;
+
+ OVERLAPPED = record
+ Internal : DWORD;
+ InternalHigh : DWORD;
+ Offset : DWORD;
+ OffsetHigh : DWORD;
+ hEvent : HANDLE;
+ end;
+ LPOVERLAPPED = ^OVERLAPPED;
+ _OVERLAPPED = OVERLAPPED;
+ TOVERLAPPED = OVERLAPPED;
+ POVERLAPPED = ^OVERLAPPED;
+
+ {PAGESETUPDLG = record conflicts with function PageSetupDlg }
+ TPAGESETUPDLG = record
+ lStructSize : DWORD;
+ hwndOwner : HWND;
+ hDevMode : HGLOBAL;
+ hDevNames : HGLOBAL;
+ Flags : DWORD;
+ ptPaperSize : POINT;
+ rtMinMargin : RECT;
+ rtMargin : RECT;
+ hInstance : HINST;
+ lCustData : LPARAM;
+ lpfnPageSetupHook : LPPAGESETUPHOOK;
+ lpfnPagePaintHook : LPPAGEPAINTHOOK;
+ lpPageSetupTemplateName : LPCTSTR;
+ hPageSetupTemplate : HGLOBAL;
+ end;
+ LPPAGESETUPDLG = ^TPAGESETUPDLG;
+ PPAGESETUPDLG = ^TPAGESETUPDLG;
+
+ tagPSD = TPAGESETUPDLG;
+ TPSD = TPAGESETUPDLG;
+ PPSD = ^TPAGESETUPDLG;
+
+ PAINTSTRUCT = record
+ hdc : HDC;
+ fErase : WINBOOL;
+ rcPaint : RECT;
+ fRestore : WINBOOL;
+ fIncUpdate : WINBOOL;
+ rgbReserved : array[0..31] of BYTE;
+ end;
+ LPPAINTSTRUCT = ^PAINTSTRUCT;
+ tagPAINTSTRUCT = PAINTSTRUCT;
+ TPAINTSTRUCT = PAINTSTRUCT;
+ PPAINTSTRUCT = ^PAINTSTRUCT;
+
+ PARAFORMAT = record
+ cbSize : UINT;
+ dwMask : DWORD;
+ wNumbering : WORD;
+ wReserved : WORD;
+ dxStartIndent : LONG;
+ dxRightIndent : LONG;
+ dxOffset : LONG;
+ wAlignment : WORD;
+ cTabCount : SHORT;
+ rgxTabs : array[0..(MAX_TAB_STOPS)-1] of LONG;
+ end;
+ _paraformat = PARAFORMAT;
+ Tparaformat = PARAFORMAT;
+ Pparaformat = ^PARAFORMAT;
+
+ PERF_COUNTER_BLOCK = record
+ ByteLength : DWORD;
+ end;
+ _PERF_COUNTER_BLOCK = PERF_COUNTER_BLOCK;
+ TPERFCOUNTERBLOCK = PERF_COUNTER_BLOCK;
+ PPERFCOUNTERBLOCK = ^PERF_COUNTER_BLOCK;
+
+ PERF_COUNTER_DEFINITION = record
+ ByteLength : DWORD;
+ CounterNameTitleIndex : DWORD;
+ CounterNameTitle : LPWSTR;
+ CounterHelpTitleIndex : DWORD;
+ CounterHelpTitle : LPWSTR;
+ DefaultScale : DWORD;
+ DetailLevel : DWORD;
+ CounterType : DWORD;
+ CounterSize : DWORD;
+ CounterOffset : DWORD;
+ end;
+ _PERF_COUNTER_DEFINITION = PERF_COUNTER_DEFINITION;
+ TPERFCOUNTERDEFINITION = PERF_COUNTER_DEFINITION;
+ PPERFCOUNTERDEFINITION = ^PERF_COUNTER_DEFINITION;
+
+ PERF_DATA_BLOCK = record
+ Signature : array[0..3] of WCHAR;
+ LittleEndian : DWORD;
+ Version : DWORD;
+ Revision : DWORD;
+ TotalByteLength : DWORD;
+ HeaderLength : DWORD;
+ NumObjectTypes : DWORD;
+ DefaultObject : DWORD;
+ SystemTime : SYSTEMTIME;
+ PerfTime : LARGE_INTEGER;
+ PerfFreq : LARGE_INTEGER;
+ PerfTime100nSec : LARGE_INTEGER;
+ SystemNameLength : DWORD;
+ SystemNameOffset : DWORD;
+ end;
+ _PERF_DATA_BLOCK = PERF_DATA_BLOCK;
+ TPERFDATABLOCK = PERF_DATA_BLOCK;
+ PPERFDATABLOCK = ^PERF_DATA_BLOCK;
+
+ PERF_INSTANCE_DEFINITION = record
+ ByteLength : DWORD;
+ ParentObjectTitleIndex : DWORD;
+ ParentObjectInstance : DWORD;
+ UniqueID : DWORD;
+ NameOffset : DWORD;
+ NameLength : DWORD;
+ end;
+ _PERF_INSTANCE_DEFINITION = PERF_INSTANCE_DEFINITION;
+ TPERFINSTANCEDEFINITION = PERF_INSTANCE_DEFINITION;
+ PPERFINSTANCEDEFINITION = PERF_INSTANCE_DEFINITION;
+
+ PERF_OBJECT_TYPE = record
+ TotalByteLength : DWORD;
+ DefinitionLength : DWORD;
+ HeaderLength : DWORD;
+ ObjectNameTitleIndex : DWORD;
+ ObjectNameTitle : LPWSTR;
+ ObjectHelpTitleIndex : DWORD;
+ ObjectHelpTitle : LPWSTR;
+ DetailLevel : DWORD;
+ NumCounters : DWORD;
+ DefaultCounter : DWORD;
+ NumInstances : DWORD;
+ CodePage : DWORD;
+ PerfTime : LARGE_INTEGER;
+ PerfFreq : LARGE_INTEGER;
+ end;
+ _PERF_OBJECT_TYPE = PERF_OBJECT_TYPE;
+ TPERFOBJECTTYPE = PERF_OBJECT_TYPE;
+ PPERFOBJECTTYPE = ^PERF_OBJECT_TYPE;
+
+ POLYTEXT = record
+ x : longint;
+ y : longint;
+ n : UINT;
+ lpstr : LPCTSTR;
+ uiFlags : UINT;
+ rcl : RECT;
+ pdx : ^longint;
+ end;
+ _POLYTEXT = POLYTEXT;
+ TPOLYTEXT = POLYTEXT;
+ PPOLYTEXT = ^POLYTEXT;
+
+ PORT_INFO_1 = record
+ pName : LPTSTR;
+ end;
+ _PORT_INFO_1 = PORT_INFO_1;
+ TPORTINFO1 = PORT_INFO_1;
+ PPORTINFO1 = ^PORT_INFO_1;
+
+ PORT_INFO_2 = record
+ pPortName : LPSTR;
+ pMonitorName : LPSTR;
+ pDescription : LPSTR;
+ fPortType : DWORD;
+ Reserved : DWORD;
+ end;
+ _PORT_INFO_2 = PORT_INFO_2;
+ TPORTINFO2 = PORT_INFO_2;
+ PPORTINFO2 = ^PORT_INFO_2;
+
+ PREVENT_MEDIA_REMOVAL = record
+ PreventMediaRemoval : BOOLEAN;
+ end;
+ _PREVENT_MEDIA_REMOVAL = PREVENT_MEDIA_REMOVAL;
+ TPREVENTMEDIAREMOVAL = PREVENT_MEDIA_REMOVAL;
+ PPREVENTMEDIAREMOVAL = ^PREVENT_MEDIA_REMOVAL;
+
+ {PRINTDLG = record conflicts with PrintDlg function }
+ TPRINTDLG = packed record
+ lStructSize : DWORD;
+ hwndOwner : HWND;
+ hDevMode : HANDLE;
+ hDevNames : HANDLE;
+ hDC : HDC;
+ Flags : DWORD;
+ nFromPage : WORD;
+ nToPage : WORD;
+ nMinPage : WORD;
+ nMaxPage : WORD;
+ nCopies : WORD;
+ hInstance : HINST;
+ lCustData : DWORD;
+ lpfnPrintHook : LPPRINTHOOKPROC;
+ lpfnSetupHook : LPSETUPHOOKPROC;
+ lpPrintTemplateName : LPCTSTR;
+ lpSetupTemplateName : LPCTSTR;
+ hPrintTemplate : HANDLE;
+ hSetupTemplate : HANDLE;
+ end;
+ LPPRINTDLG = ^TPRINTDLG;
+ PPRINTDLG = ^TPRINTDLG;
+
+ tagPD = TPRINTDLG;
+ TPD = TPRINTDLG;
+ PPD = ^TPRINTDLG;
+
+ PRINTER_DEFAULTS = record
+ pDatatype : LPTSTR;
+ pDevMode : LPDEVMODE;
+ DesiredAccess : ACCESS_MASK;
+ end;
+ _PRINTER_DEFAULTS = PRINTER_DEFAULTS;
+ TPRINTERDEFAULTS = PRINTER_DEFAULTS;
+ PPRINTERDEFAULTS = ^PRINTER_DEFAULTS;
+
+ PRINTER_INFO_1 = record
+ Flags : DWORD;
+ pDescription : LPTSTR;
+ pName : LPTSTR;
+ pComment : LPTSTR;
+ end;
+ LPPRINTER_INFO_1 = ^PRINTER_INFO_1;
+ PPRINTER_INFO_1 = ^PRINTER_INFO_1;
+ _PRINTER_INFO_1 = PRINTER_INFO_1;
+ TPRINTERINFO1 = PRINTER_INFO_1;
+ PPRINTERINFO1 = ^PRINTER_INFO_1;
+
+ PRINTER_INFO_2 = record
+ pServerName : LPTSTR;
+ pPrinterName : LPTSTR;
+ pShareName : LPTSTR;
+ pPortName : LPTSTR;
+ pDriverName : LPTSTR;
+ pComment : LPTSTR;
+ pLocation : LPTSTR;
+ pDevMode : LPDEVMODE;
+ pSepFile : LPTSTR;
+ pPrintProcessor : LPTSTR;
+ pDatatype : LPTSTR;
+ pParameters : LPTSTR;
+ pSecurityDescriptor : PSECURITY_DESCRIPTOR;
+ Attributes : DWORD;
+ Priority : DWORD;
+ DefaultPriority : DWORD;
+ StartTime : DWORD;
+ UntilTime : DWORD;
+ Status : DWORD;
+ cJobs : DWORD;
+ AveragePPM : DWORD;
+ end;
+ _PRINTER_INFO_2 = PRINTER_INFO_2;
+ TPRINTERINFO2 = PRINTER_INFO_2;
+ PPRINTERINFO2 = ^PRINTER_INFO_2;
+
+ PRINTER_INFO_3 = record
+ pSecurityDescriptor : PSECURITY_DESCRIPTOR;
+ end;
+ _PRINTER_INFO_3 = PRINTER_INFO_3;
+ TPRINTERINFO3 = PRINTER_INFO_3;
+ PPRINTERINFO3 = ^PRINTER_INFO_3;
+
+ PRINTER_INFO_4 = record
+ pPrinterName : LPTSTR;
+ pServerName : LPTSTR;
+ Attributes : DWORD;
+ end;
+ _PRINTER_INFO_4 = PRINTER_INFO_4;
+ TPRINTERINFO4 = PRINTER_INFO_4;
+ PPRINTERINFO4 = ^PRINTER_INFO_4;
+
+ PRINTER_INFO_5 = record
+ pPrinterName : LPTSTR;
+ pPortName : LPTSTR;
+ Attributes : DWORD;
+ DeviceNotSelectedTimeout : DWORD;
+ TransmissionRetryTimeout : DWORD;
+ end;
+ _PRINTER_INFO_5 = PRINTER_INFO_5;
+ TPRINTERINFO5 = PRINTER_INFO_5;
+ PPRINTERINFO5 = ^PRINTER_INFO_5;
+
+ PRINTER_NOTIFY_INFO_DATA = record
+ _Type : WORD;
+ Field : WORD;
+ Reserved : DWORD;
+ Id : DWORD;
+ NotifyData : record
+ case longint of
+ 0 : ( adwData : array[0..1] of DWORD );
+ 1 : ( Data : record
+ cbBuf : DWORD;
+ pBuf : LPVOID;
+ end );
+ end;
+ end;
+ _PRINTER_NOTIFY_INFO_DATA = PRINTER_NOTIFY_INFO_DATA;
+ TPRINTERNOTIFYINFODATA = PRINTER_NOTIFY_INFO_DATA;
+ PPRINTERNOTIFYINFODATA = ^PRINTER_NOTIFY_INFO_DATA;
+
+ PRINTER_NOTIFY_INFO = record
+ Version : DWORD;
+ Flags : DWORD;
+ Count : DWORD;
+ aData : array[0..0] of PRINTER_NOTIFY_INFO_DATA;
+ end;
+ _PRINTER_NOTIFY_INFO = PRINTER_NOTIFY_INFO;
+ TPRINTERNOTIFYINFO = PRINTER_NOTIFY_INFO;
+ PPRINTERNOTIFYINFO = ^PRINTER_NOTIFY_INFO;
+
+ PRINTER_NOTIFY_OPTIONS_TYPE = record
+ _Type : WORD;
+ Reserved0 : WORD;
+ Reserved1 : DWORD;
+ Reserved2 : DWORD;
+ Count : DWORD;
+ pFields : PWORD;
+ end;
+ PPRINTER_NOTIFY_OPTIONS_TYPE = ^PRINTER_NOTIFY_OPTIONS_TYPE;
+ _PRINTER_NOTIFY_OPTIONS_TYPE = PRINTER_NOTIFY_OPTIONS_TYPE;
+ TPRINTERNOTIFYOPTIONSTYPE = PRINTER_NOTIFY_OPTIONS_TYPE;
+ PPRINTERNOTIFYOPTIONSTYPE = ^PRINTER_NOTIFY_OPTIONS_TYPE;
+
+ PRINTER_NOTIFY_OPTIONS = record
+ Version : DWORD;
+ Flags : DWORD;
+ Count : DWORD;
+ pTypes : PPRINTER_NOTIFY_OPTIONS_TYPE;
+ end;
+ _PRINTER_NOTIFY_OPTIONS = PRINTER_NOTIFY_OPTIONS;
+ TPRINTERNOTIFYOPTIONS = PRINTER_NOTIFY_OPTIONS;
+ PPRINTERNOTIFYOPTIONS = ^PRINTER_NOTIFY_OPTIONS;
+
+ PRINTPROCESSOR_INFO_1 = record
+ pName : LPTSTR;
+ end;
+ _PRINTPROCESSOR_INFO_1 = PRINTPROCESSOR_INFO_1;
+ TPRINTPROCESSORINFO1 = PRINTPROCESSOR_INFO_1;
+ PPRINTPROCESSORINFO1 = ^PRINTPROCESSOR_INFO_1;
+
+ PRIVILEGE_SET = record
+ PrivilegeCount : DWORD;
+ Control : DWORD;
+ Privilege : array[0..(ANYSIZE_ARRAY)-1] of LUID_AND_ATTRIBUTES;
+ end;
+ LPPRIVILEGE_SET = ^PRIVILEGE_SET;
+ PPRIVILEGE_SET = ^PRIVILEGE_SET;
+ _PRIVILEGE_SET = PRIVILEGE_SET;
+ TPRIVILEGESET = PRIVILEGE_SET;
+ PPRIVILEGESET = ^PRIVILEGE_SET;
+
+ PROCESS_HEAPENTRY = record
+ lpData : PVOID;
+ cbData : DWORD;
+ cbOverhead : BYTE;
+ iRegionIndex : BYTE;
+ wFlags : WORD;
+ dwCommittedSize : DWORD;
+ dwUnCommittedSize : DWORD;
+ lpFirstBlock : LPVOID;
+ lpLastBlock : LPVOID;
+ hMem : HANDLE;
+ end;
+ LPPROCESS_HEAP_ENTRY = ^PROCESS_HEAPENTRY;
+ _PROCESS_HEAP_ENTRY = PROCESS_HEAPENTRY;
+ TPROCESSHEAPENTRY = PROCESS_HEAPENTRY;
+ PPROCESSHEAPENTRY = ^PROCESS_HEAPENTRY;
+
+ PROCESS_INFORMATION = record
+ hProcess : HANDLE;
+ hThread : HANDLE;
+ dwProcessId : DWORD;
+ dwThreadId : DWORD;
+ end;
+ LPPROCESS_INFORMATION = ^PROCESS_INFORMATION;
+ _PROCESS_INFORMATION = PROCESS_INFORMATION;
+ TPROCESSINFORMATION = PROCESS_INFORMATION;
+ PPROCESSINFORMATION = ^PROCESS_INFORMATION;
+
+ LPFNPSPCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPVOID):UINT;stdcall;
+ TFNPSPCALLBACK = LPFNPSPCALLBACK;
+
+ PROPSHEETPAGE = record
+ dwSize : DWORD;
+ dwFlags : DWORD;
+ hInstance : HINST;
+ case longint of
+ 0 : (pszTemplate : LPCTSTR);
+ 1 : (pResource : LPCDLGTEMPLATE;
+ case longint of
+ 0 : (hIcon : HICON);
+ 1 : (pszIcon : LPCTSTR;
+ pszTitle : LPCTSTR;
+ pfnDlgProc : DLGPROC;
+ lParam : LPARAM;
+ pfnCallback : LPFNPSPCALLBACK;
+ pcRefParent : ^UINT;
+ );
+ );
+ end;
+ LPPROPSHEETPAGE = ^PROPSHEETPAGE;
+ LPCPROPSHEETPAGE = ^PROPSHEETPAGE;
+ _PROPSHEETPAGE = PROPSHEETPAGE;
+ TPROPSHEETPAGE = PROPSHEETPAGE;
+ PPROPSHEETPAGE = ^PROPSHEETPAGE;
+
+ emptyrecord = record
+ end;
+ lpemptyrecord = ^emptyrecord;
+ HPROPSHEETPAGE = ^emptyrecord;
+
+ PROPSHEETHEADER = record
+ dwSize : DWORD;
+ dwFlags : DWORD;
+ hwndParent : HWND;
+ hInstance : HINST;
+ case longint of
+ 0 : (hIcon : HICON);
+ 1 : (pszIcon : LPCTSTR;
+ pszCaption : LPCTSTR;
+ nPages : UINT;
+ case longint of
+ 0 : (nStartPage : UINT);
+ 1 : (pStartPage : LPCTSTR;
+ case longint of
+ 0 : (ppsp : LPCPROPSHEETPAGE);
+ 1 : (phpage : ^HPROPSHEETPAGE;
+ pfnCallback : PFNPROPSHEETCALLBACK;
+ case longint of
+ 0 : (hbmWatermark : HBITMAP);
+ 1 : (pszbmWatermark : LPCTSTR;
+ hplWatermark : HPALETTE;
+ case longint of
+ 0 : (hbmHeader : HBITMAP);
+ 1 : (pszbmHeader: PAnsiChar);
+ );
+ );
+ );
+ );
+ end;
+ LPPROPSHEETHEADER = ^PROPSHEETHEADER;
+ LPCPROPSHEETHEADER = ^PROPSHEETHEADER;
+ _PROPSHEETHEADER = PROPSHEETHEADER;
+ TPROPSHEETHEADER = PROPSHEETHEADER;
+ PPROPSHEETHEADER = ^PROPSHEETHEADER;
+
+ { PropertySheet callbacks }
+ LPFNADDPROPSHEETPAGE = function (_para1:HPROPSHEETPAGE; _para2:LPARAM):WINBOOL;stdcall;
+ TFNADDPROPSHEETPAGE = LPFNADDPROPSHEETPAGE;
+
+ LPFNADDPROPSHEETPAGES = function (_para1:LPVOID; _para2:LPFNADDPROPSHEETPAGE; _para3:LPARAM):WINBOOL;stdcall;
+ TFNADDPROPSHEETPAGES = LPFNADDPROPSHEETPAGES;
+
+ PROTOCOL_INFO = record
+ dwServiceFlags : DWORD;
+ iAddressFamily : WINT;
+ iMaxSockAddr : WINT;
+ iMinSockAddr : WINT;
+ iSocketType : WINT;
+ iProtocol : WINT;
+ dwMessageSize : DWORD;
+ lpProtocol : LPTSTR;
+ end;
+ _PROTOCOL_INFO = PROTOCOL_INFO;
+ TPROTOCOLINFO = PROTOCOL_INFO;
+ PPROTOCOLINFO = ^PROTOCOL_INFO;
+
+ PROVIDOR_INFO_1 = record
+ pName : LPTSTR;
+ pEnvironment : LPTSTR;
+ pDLLName : LPTSTR;
+ end;
+ _PROVIDOR_INFO_1 = PROVIDOR_INFO_1;
+ TPROVIDORINFO1 = PROVIDOR_INFO_1;
+ PPROVIDORINFO1 = ^PROVIDOR_INFO_1;
+
+ PSHNOTIFY = record
+ hdr : NMHDR;
+ lParam : LPARAM;
+ end;
+ LPPSHNOTIFY = ^PSHNOTIFY;
+ _PSHNOTIFY = PSHNOTIFY;
+ TPSHNOTIFY = PSHNOTIFY;
+ PPSHNOTIFY = ^PSHNOTIFY;
+
+ PUNCTUATION = record
+ iSize : UINT;
+ szPunctuation : LPSTR;
+ end;
+ _punctuation = PUNCTUATION;
+ Tpunctuation = PUNCTUATION;
+ Ppunctuation = ^PUNCTUATION;
+
+ QUERY_SERVICE_CONFIG = record
+ dwServiceType : DWORD;
+ dwStartType : DWORD;
+ dwErrorControl : DWORD;
+ lpBinaryPathName : LPTSTR;
+ lpLoadOrderGroup : LPTSTR;
+ dwTagId : DWORD;
+ lpDependencies : LPTSTR;
+ lpServiceStartName : LPTSTR;
+ lpDisplayName : LPTSTR;
+ end;
+ LPQUERY_SERVICE_CONFIG = ^QUERY_SERVICE_CONFIG;
+ _QUERY_SERVICE_CONFIG = QUERY_SERVICE_CONFIG;
+ TQUERYSERVICECONFIG = QUERY_SERVICE_CONFIG;
+ PQUERYSERVICECONFIG = ^QUERY_SERVICE_CONFIG;
+
+ QUERY_SERVICE_LOCK_STATUS = record
+ fIsLocked : DWORD;
+ lpLockOwner : LPTSTR;
+ dwLockDuration : DWORD;
+ end;
+ LPQUERY_SERVICE_LOCK_STATUS = ^QUERY_SERVICE_LOCK_STATUS;
+ _QUERY_SERVICE_LOCK_STATUS = QUERY_SERVICE_LOCK_STATUS;
+ TQUERYSERVICELOCKSTATUS = QUERY_SERVICE_LOCK_STATUS;
+ PQUERYSERVICELOCKSTATUS = ^QUERY_SERVICE_LOCK_STATUS;
+
+ RASAMB = record
+ dwSize : DWORD;
+ dwError : DWORD;
+ szNetBiosError : array[0..(NETBIOS_NAME_LEN + 1)-1] of TCHAR;
+ bLana : BYTE;
+ end;
+ _RASAMB = RASAMB;
+ TRASAMB = RASAMB;
+ PRASAMB = ^RASAMB;
+
+ RASCONN = record
+ dwSize : DWORD;
+ hrasconn : HRASCONN;
+ szEntryName : array[0..(RAS_MaxEntryName + 1)-1] of TCHAR;
+ szDeviceType : array[0..(RAS_MaxDeviceType + 1)-1] of CHAR;
+ szDeviceName : array[0..(RAS_MaxDeviceName + 1)-1] of CHAR;
+ end;
+ _RASCONN = RASCONN;
+ TRASCONN = RASCONN;
+ PRASCONN = ^RASCONN;
+
+ RASCONNSTATUS = record
+ dwSize : DWORD;
+ rasconnstate : RASCONNSTATE;
+ dwError : DWORD;
+ szDeviceType : array[0..(RAS_MaxDeviceType + 1)-1] of TCHAR;
+ szDeviceName : array[0..(RAS_MaxDeviceName + 1)-1] of TCHAR;
+ end;
+ _RASCONNSTATUS = RASCONNSTATUS;
+ TRASCONNSTATUS = RASCONNSTATUS;
+ PRASCONNSTATUS = ^RASCONNSTATUS;
+
+ RASDIALEXTENSIONS = record
+ dwSize : DWORD;
+ dwfOptions : DWORD;
+ hwndParent : HWND;
+ reserved : DWORD;
+ end;
+ _RASDIALEXTENSIONS = RASDIALEXTENSIONS;
+ TRASDIALEXTENSIONS = RASDIALEXTENSIONS;
+ PRASDIALEXTENSIONS = ^RASDIALEXTENSIONS;
+
+ RASDIALPARAMS = record
+ dwSize : DWORD;
+ szEntryName : array[0..(RAS_MaxEntryName + 1)-1] of TCHAR;
+ szPhoneNumber : array[0..(RAS_MaxPhoneNumber + 1)-1] of TCHAR;
+ szCallbackNumber : array[0..(RAS_MaxCallbackNumber + 1)-1] of TCHAR;
+ szUserName : array[0..(UNLEN + 1)-1] of TCHAR;
+ szPassword : array[0..(PWLEN + 1)-1] of TCHAR;
+ szDomain : array[0..(DNLEN + 1)-1] of TCHAR;
+ end;
+ _RASDIALPARAMS = RASDIALPARAMS;
+ TRASDIALPARAMS = RASDIALPARAMS;
+ PRASDIALPARAMS = ^RASDIALPARAMS;
+
+ RASENTRYNAME = record
+ dwSize : DWORD;
+ szEntryName : array[0..(RAS_MaxEntryName + 1)-1] of TCHAR;
+ end;
+ _RASENTRYNAME = RASENTRYNAME;
+ TRASENTRYNAME = RASENTRYNAME;
+ PRASENTRYNAME = ^RASENTRYNAME;
+
+ RASPPPIP = record
+ dwSize : DWORD;
+ dwError : DWORD;
+ szIpAddress : array[0..(RAS_MaxIpAddress + 1)-1] of TCHAR;
+ end;
+ _RASPPPIP = RASPPPIP;
+ TRASPPPIP = RASPPPIP;
+ PRASPPPIP = ^RASPPPIP;
+
+ RASPPPIPX = record
+ dwSize : DWORD;
+ dwError : DWORD;
+ szIpxAddress : array[0..(RAS_MaxIpxAddress + 1)-1] of TCHAR;
+ end;
+ _RASPPPIPX = RASPPPIPX;
+ TRASPPPIPX = RASPPPIPX;
+ PRASPPPIPX = ^RASPPPIPX;
+
+ RASPPPNBF = record
+ dwSize : DWORD;
+ dwError : DWORD;
+ dwNetBiosError : DWORD;
+ szNetBiosError : array[0..(NETBIOS_NAME_LEN + 1)-1] of TCHAR;
+ szWorkstationName : array[0..(NETBIOS_NAME_LEN + 1)-1] of TCHAR;
+ bLana : BYTE;
+ end;
+ _RASPPPNBF = RASPPPNBF;
+ TRASPPPNBF = RASPPPNBF;
+ PRASPPPNBF = ^RASPPPNBF;
+
+ RASTERIZER_STATUS = record
+ nSize : integer;
+ wFlags : integer;
+ nLanguageID : integer;
+ end;
+ LPRASTERIZER_STATUS = ^RASTERIZER_STATUS;
+ _RASTERIZER_STATUS = RASTERIZER_STATUS;
+ TRASTERIZERSTATUS = RASTERIZER_STATUS;
+ PRASTERIZERSTATUS = ^RASTERIZER_STATUS;
+
+ REASSIGN_BLOCKS = record
+ Reserved : WORD;
+ Count : WORD;
+ BlockNumber : array[0..0] of DWORD;
+ end;
+ _REASSIGN_BLOCKS = REASSIGN_BLOCKS;
+ TREASSIGNBLOCKS = REASSIGN_BLOCKS;
+ PREASSIGNBLOCKS = ^REASSIGN_BLOCKS;
+
+ REMOTE_NAME_INFO = record
+ lpUniversalName : LPTSTR;
+ lpConnectionName : LPTSTR;
+ lpRemainingPath : LPTSTR;
+ end;
+ _REMOTE_NAME_INFO = REMOTE_NAME_INFO;
+ TREMOTENAMEINFO = REMOTE_NAME_INFO;
+ PREMOTENAMEINFO = ^REMOTE_NAME_INFO;
+
+ (*
+ TODO: OLE
+ typedef struct _reobject {
+ DWORD cbStruct;
+ LONG cp;
+ CLSID clsid;
+ LPOLEOBJECT poleobj;
+ LPSTORAGE pstg;
+ LPOLECLIENTSITE polesite;
+ SIZEL sizel;
+ DWORD dvaspect;
+ DWORD dwFlags;
+ DWORD dwUser;
+ } REOBJECT;
+ *)
+
+ REPASTESPECIAL = record
+ dwAspect : DWORD;
+ dwParam : DWORD;
+ end;
+ _repastespecial = REPASTESPECIAL;
+ Trepastespecial = REPASTESPECIAL;
+ Prepastespecial = ^REPASTESPECIAL;
+
+ REQRESIZE = record
+ nmhdr : NMHDR;
+ rc : RECT;
+ end;
+ _reqresize = REQRESIZE;
+ Treqresize = REQRESIZE;
+ Preqresize = ^REQRESIZE;
+
+ RGNDATAHEADER = record
+ dwSize : DWORD;
+ iType : DWORD;
+ nCount : DWORD;
+ nRgnSize : DWORD;
+ rcBound : RECT;
+ end;
+ _RGNDATAHEADER = RGNDATAHEADER;
+ TRGNDATAHEADER = RGNDATAHEADER;
+ PRGNDATAHEADER = ^RGNDATAHEADER;
+
+ RGNDATA = record
+ rdh : RGNDATAHEADER;
+ Buffer : array[0..0] of char;
+ end;
+ LPRGNDATA = ^RGNDATA;
+ _RGNDATA = RGNDATA;
+ TRGNDATA = RGNDATA;
+ PRGNDATA = ^RGNDATA;
+
+ SCROLLINFO = record
+ cbSize : UINT;
+ fMask : UINT;
+ nMin : longint;
+ nMax : longint;
+ nPage : UINT;
+ nPos : longint;
+ nTrackPos : longint;
+ end;
+ LPSCROLLINFO = ^SCROLLINFO;
+ LPCSCROLLINFO = ^SCROLLINFO;
+ tagSCROLLINFO = SCROLLINFO;
+ TSCROLLINFO = SCROLLINFO;
+ PSCROLLINFO = ^SCROLLINFO;
+
+ SECURITY_ATTRIBUTES = record
+ nLength : DWORD;
+ lpSecurityDescriptor : LPVOID;
+ bInheritHandle : WINBOOL;
+ end;
+ LPSECURITY_ATTRIBUTES = ^SECURITY_ATTRIBUTES;
+ _SECURITY_ATTRIBUTES = SECURITY_ATTRIBUTES;
+ TSECURITYATTRIBUTES = SECURITY_ATTRIBUTES;
+ PSECURITYATTRIBUTES = ^SECURITY_ATTRIBUTES;
+
+ SECURITY_INFORMATION = DWORD;
+ PSECURITY_INFORMATION = ^SECURITY_INFORMATION;
+ TSECURITYINFORMATION = SECURITY_INFORMATION;
+ PSECURITYINFORMATION = ^SECURITY_INFORMATION;
+
+ SELCHANGE = record
+ nmhdr : NMHDR;
+ chrg : CHARRANGE;
+ seltyp : WORD;
+ end;
+ _selchange = SELCHANGE;
+ Tselchange = SELCHANGE;
+ Pselchange = ^SELCHANGE;
+
+ SERIALKEYS = record
+ cbSize : DWORD;
+ dwFlags : DWORD;
+ lpszActivePort : LPSTR;
+ lpszPort : LPSTR;
+ iBaudRate : DWORD;
+ iPortState : DWORD;
+ end;
+ LPSERIALKEYS = ^SERIALKEYS;
+ tagSERIALKEYS = SERIALKEYS;
+ TSERIALKEYS = SERIALKEYS;
+ PSERIALKEYS = ^SERIALKEYS;
+
+ SERVICE_TABLE_ENTRY = record
+ lpServiceName : LPTSTR;
+ lpServiceProc : LPSERVICE_MAIN_FUNCTION;
+ end;
+ LPSERVICE_TABLE_ENTRY = ^SERVICE_TABLE_ENTRY;
+ _SERVICE_TABLE_ENTRY = SERVICE_TABLE_ENTRY;
+ TSERVICETABLEENTRY = SERVICE_TABLE_ENTRY;
+ PSERVICETABLEENTRY = ^SERVICE_TABLE_ENTRY;
+
+ SERVICE_TYPE_VALUE_ABS = record
+ dwNameSpace : DWORD;
+ dwValueType : DWORD;
+ dwValueSize : DWORD;
+ lpValueName : LPTSTR;
+ lpValue : PVOID;
+ end;
+ _SERVICE_TYPE_VALUE_ABS = SERVICE_TYPE_VALUE_ABS;
+ TSERVICETYPEVALUEABS = SERVICE_TYPE_VALUE_ABS;
+ PSERVICETYPEVALUEABS = ^SERVICE_TYPE_VALUE_ABS;
+
+ SERVICE_TYPE_INFO_ABS = record
+ lpTypeName : LPTSTR;
+ dwValueCount : DWORD;
+ Values : array[0..0] of SERVICE_TYPE_VALUE_ABS;
+ end;
+ _SERVICE_TYPE_INFO_ABS = SERVICE_TYPE_INFO_ABS;
+ TSERVICETYPEINFOABS = SERVICE_TYPE_INFO_ABS;
+ PSERVICETYPEINFOABS = ^SERVICE_TYPE_INFO_ABS;
+
+ SESSION_BUFFER = record
+ lsn : UCHAR;
+ state : UCHAR;
+ local_name : array[0..(NCBNAMSZ)-1] of UCHAR;
+ remote_name : array[0..(NCBNAMSZ)-1] of UCHAR;
+ rcvs_outstanding : UCHAR;
+ sends_outstanding : UCHAR;
+ end;
+ _SESSION_BUFFER = SESSION_BUFFER;
+ TSESSIONBUFFER = SESSION_BUFFER;
+ PSESSIONBUFFER = ^SESSION_BUFFER;
+
+ SESSION_HEADER = record
+ sess_name : UCHAR;
+ num_sess : UCHAR;
+ rcv_dg_outstanding : UCHAR;
+ rcv_any_outstanding : UCHAR;
+ end;
+ _SESSION_HEADER = SESSION_HEADER;
+ TSESSIONHEADER = SESSION_HEADER;
+ PSESSIONHEADER = ^SESSION_HEADER;
+
+ SET_PARTITION_INFORMATION = record
+ PartitionType : BYTE;
+ end;
+ _SET_PARTITION_INFORMATION = SET_PARTITION_INFORMATION;
+ TSETPARTITIONINFORMATION = SET_PARTITION_INFORMATION;
+ PSETPARTITIONINFORMATION = ^SET_PARTITION_INFORMATION;
+
+ SHCONTF = (SHCONTF_FOLDERS := 32,SHCONTF_NONFOLDERS := 64,
+ SHCONTF_INCLUDEHIDDEN := 128);
+ tagSHCONTF = SHCONTF;
+ TSHCONTF = SHCONTF;
+
+ SHFILEINFO = record
+ hIcon : HICON;
+ iIcon : longint;
+ dwAttributes : DWORD;
+ szDisplayName : array[0..(MAX_PATH)-1] of char;
+ szTypeName : array[0..79] of char;
+ end;
+ _SHFILEINFO = SHFILEINFO;
+ TSHFILEINFO = SHFILEINFO;
+ PSHFILEINFO = ^SHFILEINFO;
+
+ FILEOP_FLAGS = WORD;
+ TFILEOPFLAGS = FILEOP_FLAGS;
+ PFILEOPFLAGS = ^FILEOP_FLAGS;
+
+ SHFILEOPSTRUCT = record
+ hwnd : HWND;
+ wFunc : UINT;
+ pFrom : LPCSTR;
+ pTo : LPCSTR;
+ fFlags : FILEOP_FLAGS;
+ fAnyOperationsAborted : WINBOOL;
+ hNameMappings : LPVOID;
+ lpszProgressTitle : LPCSTR;
+ end;
+ LPSHFILEOPSTRUCT = ^SHFILEOPSTRUCT;
+ _SHFILEOPSTRUCT = SHFILEOPSTRUCT;
+ TSHFILEOPSTRUCT = SHFILEOPSTRUCT;
+ PSHFILEOPSTRUCT = ^SHFILEOPSTRUCT;
+
+ SHGNO = (SHGDN_NORMAL := 0,SHGDN_INFOLDER := 1,
+ SHGDN_FORPARSING := $8000);
+ tagSHGDN = SHGNO;
+ TSHGDN = SHGNO;
+
+ SHNAMEMAPPING = record
+ pszOldPath : LPSTR;
+ pszNewPath : LPSTR;
+ cchOldPath : longint;
+ cchNewPath : longint;
+ end;
+ LPSHNAMEMAPPING = ^SHNAMEMAPPING;
+ _SHNAMEMAPPING = SHNAMEMAPPING;
+ TSHNAMEMAPPING = SHNAMEMAPPING;
+ PSHNAMEMAPPING = ^SHNAMEMAPPING;
+
+ SID_AND_ATTRIBUTES = record
+ Sid : PSID;
+ Attributes : DWORD;
+ end;
+ _SID_AND_ATTRIBUTES = SID_AND_ATTRIBUTES;
+ TSIDANDATTRIBUTES = SID_AND_ATTRIBUTES;
+ PSIDANDATTRIBUTES = ^SID_AND_ATTRIBUTES;
+
+ SID_AND_ATTRIBUTES_ARRAY = array[0..(ANYSIZE_ARRAY)-1] of SID_AND_ATTRIBUTES;
+ PSID_AND_ATTRIBUTES_ARRAY = ^SID_AND_ATTRIBUTES_ARRAY;
+ TSIDANDATTRIBUTESARRAY = SID_AND_ATTRIBUTES_ARRAY;
+ PSIDANDATTRIBUTESARRAY = ^SID_AND_ATTRIBUTES_ARRAY;
+
+ SINGLE_LIST_ENTRY = record
+ Next : ^_SINGLE_LIST_ENTRY;
+ end;
+ _SINGLE_LIST_ENTRY = SINGLE_LIST_ENTRY;
+ TSINGLELISTENTRY = SINGLE_LIST_ENTRY;
+ PSINGLELISTENTRY = ^SINGLE_LIST_ENTRY;
+
+ SOUNDSENTRY = record
+ cbSize : UINT;
+ dwFlags : DWORD;
+ iFSTextEffect : DWORD;
+ iFSTextEffectMSec : DWORD;
+ iFSTextEffectColorBits : DWORD;
+ iFSGrafEffect : DWORD;
+ iFSGrafEffectMSec : DWORD;
+ iFSGrafEffectColor : DWORD;
+ iWindowsEffect : DWORD;
+ iWindowsEffectMSec : DWORD;
+ lpszWindowsEffectDLL : LPTSTR;
+ iWindowsEffectOrdinal : DWORD;
+ end;
+ LPSOUNDSENTRY = ^SOUNDSENTRY;
+ tagSOUNDSENTRY = SOUNDSENTRY;
+ TSOUNDSENTRY = SOUNDSENTRY;
+ PSOUNDSENTRY = ^SOUNDSENTRY;
+
+ STARTUPINFO = record
+ cb : DWORD;
+ lpReserved : LPTSTR;
+ lpDesktop : LPTSTR;
+ lpTitle : LPTSTR;
+ dwX : DWORD;
+ dwY : DWORD;
+ dwXSize : DWORD;
+ dwYSize : DWORD;
+ dwXCountChars : DWORD;
+ dwYCountChars : DWORD;
+ dwFillAttribute : DWORD;
+ dwFlags : DWORD;
+ wShowWindow : WORD;
+ cbReserved2 : WORD;
+ lpReserved2 : LPBYTE;
+ hStdInput : HANDLE;
+ hStdOutput : HANDLE;
+ hStdError : HANDLE;
+ end;
+ LPSTARTUPINFO = ^STARTUPINFO;
+ _STARTUPINFO = STARTUPINFO;
+ TSTARTUPINFO = STARTUPINFO;
+ PSTARTUPINFO = ^STARTUPINFO;
+
+ STICKYKEYS = record
+ cbSize : DWORD;
+ dwFlags : DWORD;
+ end;
+ LPSTICKYKEYS = ^STICKYKEYS;
+ tagSTICKYKEYS = STICKYKEYS;
+ TSTICKYKEYS = STICKYKEYS;
+ PSTICKYKEYS = ^STICKYKEYS;
+
+ STRRET = record
+ uType : UINT;
+ DUMMYUNIONNAME : record
+ case longint of
+ 0 : ( pOleStr : LPWSTR );
+ 1 : ( uOffset : UINT );
+ 2 : ( cStr : array[0..(MAX_PATH)-1] of char );
+ end;
+ end;
+ LPSTRRET = ^STRRET;
+ _STRRET = STRRET;
+ TSTRRET = STRRET;
+ PSTRRET = ^STRRET;
+
+ STYLEBUF = record
+ dwStyle : DWORD;
+ szDescription : array[0..31] of CHAR;
+ end;
+ LPSTYLEBUF = ^STYLEBUF;
+ _tagSTYLEBUF = STYLEBUF;
+ TSTYLEBUF = STYLEBUF;
+ PSTYLEBUF = ^STYLEBUF;
+
+ STYLESTRUCT = record
+ styleOld : DWORD;
+ styleNew : DWORD;
+ end;
+ LPSTYLESTRUCT = ^STYLESTRUCT;
+ tagSTYLESTRUCT = STYLESTRUCT;
+ TSTYLESTRUCT = STYLESTRUCT;
+ PSTYLESTRUCT = ^STYLESTRUCT;
+
+ SYSTEM_AUDIT_ACE = record
+ Header : ACE_HEADER;
+ Mask : ACCESS_MASK;
+ SidStart : DWORD;
+ end;
+ _SYSTEM_AUDIT_ACE = SYSTEM_AUDIT_ACE;
+ TSYSTEMAUDITACE = SYSTEM_AUDIT_ACE;
+ PSYSTEMAUDITACE = ^SYSTEM_AUDIT_ACE;
+
+ SYSTEM_INFO = record
+ u : record
+ case longint of
+ 0 : ( dwOemId : DWORD );
+ 1 : ( s : record
+ wProcessorArchitecture : WORD;
+ wReserved : WORD;
+ end );
+ end;
+ dwPageSize : DWORD;
+ lpMinimumApplicationAddress : LPVOID;
+ lpMaximumApplicationAddress : LPVOID;
+ dwActiveProcessorMask : DWORD;
+ dwNumberOfProcessors : DWORD;
+ dwProcessorType : DWORD;
+ dwAllocationGranularity : DWORD;
+ wProcessorLevel : WORD;
+ wProcessorRevision : WORD;
+ end;
+ LPSYSTEM_INFO = ^SYSTEM_INFO;
+ _SYSTEM_INFO = SYSTEM_INFO;
+ TSYSTEMINFO = SYSTEM_INFO;
+ PSYSTEMINFO = ^SYSTEM_INFO;
+
+ SYSTEM_POWER_STATUS = record
+ ACLineStatus : BYTE;
+ BatteryFlag : BYTE;
+ BatteryLifePercent : BYTE;
+ Reserved1 : BYTE;
+ BatteryLifeTime : DWORD;
+ BatteryFullLifeTime : DWORD;
+ end;
+ _SYSTEM_POWER_STATUS = SYSTEM_POWER_STATUS;
+ TSYSTEMPOWERSTATUS = SYSTEM_POWER_STATUS;
+ PSYSTEMPOWERSTATUS = ^SYSTEM_POWER_STATUS;
+
+ LPSYSTEM_POWER_STATUS = ^emptyrecord;
+
+ TAPE_ERASE = record
+ _Type : ULONG;
+ end;
+ _TAPE_ERASE = TAPE_ERASE;
+ TTAPEERASE = TAPE_ERASE;
+ PTAPEERASE = ^TAPE_ERASE;
+
+ TAPE_GET_DRIVE_PARAMETERS = record
+ ECC : BOOLEAN;
+ Compression : BOOLEAN;
+ DataPadding : BOOLEAN;
+ ReportSetmarks : BOOLEAN;
+ DefaultBlockSize : ULONG;
+ MaximumBlockSize : ULONG;
+ MinimumBlockSize : ULONG;
+ MaximumPartitionCount : ULONG;
+ FeaturesLow : ULONG;
+ FeaturesHigh : ULONG;
+ EOTWarningZoneSize : ULONG;
+ end;
+ _TAPE_GET_DRIVE_PARAMETERS = TAPE_GET_DRIVE_PARAMETERS;
+ TTAPEGETDRIVEPARAMETERS = TAPE_GET_DRIVE_PARAMETERS;
+ PTAPEGETDRIVEPARAMETERS = ^TAPE_GET_DRIVE_PARAMETERS;
+
+ TAPE_GET_MEDIA_PARAMETERS = record
+ Capacity : LARGE_INTEGER;
+ Remaining : LARGE_INTEGER;
+ BlockSize : DWORD;
+ PartitionCount : DWORD;
+ WriteProtected : BOOLEAN;
+ end;
+ _TAPE_GET_MEDIA_PARAMETERS = TAPE_GET_MEDIA_PARAMETERS;
+ TTAPEGETMEDIAPARAMETERS = TAPE_GET_MEDIA_PARAMETERS;
+ PTAPEGETMEDIAPARAMETERS = ^TAPE_GET_MEDIA_PARAMETERS;
+
+ TAPE_GET_POSITION = record
+ _Type : ULONG;
+ Partition : ULONG;
+ OffsetLow : ULONG;
+ OffsetHigh : ULONG;
+ end;
+ _TAPE_GET_POSITION = TAPE_GET_POSITION;
+ TTAPEGETPOSITION = TAPE_GET_POSITION;
+ PTAPEGETPOSITION = ^TAPE_GET_POSITION;
+
+ TAPE_PREPARE = record
+ Operation : ULONG;
+ end;
+ _TAPE_PREPARE = TAPE_PREPARE;
+ TTAPEPREPARE = TAPE_PREPARE;
+ PTAPEPREPARE = ^TAPE_PREPARE;
+
+ TAPE_SET_DRIVE_PARAMETERS = record
+ ECC : BOOLEAN;
+ Compression : BOOLEAN;
+ DataPadding : BOOLEAN;
+ ReportSetmarks : BOOLEAN;
+ EOTWarningZoneSize : ULONG;
+ end;
+ _TAPE_SET_DRIVE_PARAMETERS = TAPE_SET_DRIVE_PARAMETERS;
+ TTAPESETDRIVEPARAMETERS = TAPE_SET_DRIVE_PARAMETERS;
+ PTAPESETDRIVEPARAMETERS = ^TAPE_SET_DRIVE_PARAMETERS;
+
+ TAPE_SET_MEDIA_PARAMETERS = record
+ BlockSize : ULONG;
+ end;
+ _TAPE_SET_MEDIA_PARAMETERS = TAPE_SET_MEDIA_PARAMETERS;
+ TTAPESETMEDIAPARAMETERS = TAPE_SET_MEDIA_PARAMETERS;
+ PTAPESETMEDIAPARAMETERS = ^TAPE_SET_MEDIA_PARAMETERS;
+
+ TAPE_SET_POSITION = record
+ Method : ULONG;
+ Partition : ULONG;
+ OffsetLow : ULONG;
+ OffsetHigh : ULONG;
+ end;
+ _TAPE_SET_POSITION = TAPE_SET_POSITION;
+ TTAPESETPOSITION = TAPE_SET_POSITION;
+ PTAPESETPOSITION = ^TAPE_SET_POSITION;
+
+ TAPE_WRITE_MARKS = record
+ _Type : ULONG;
+ Count : ULONG;
+ end;
+ _TAPE_WRITE_MARKS = TAPE_WRITE_MARKS;
+ TTAPEWRITEMARKS = TAPE_WRITE_MARKS;
+ PTAPEWRITEMARKS = ^TAPE_WRITE_MARKS;
+
+ TBADDBITMAP = record
+ hInst : HINST;
+ nID : UINT;
+ end;
+ LPTBADDBITMAP = ^TBADDBITMAP;
+ TTBADDBITMAP = TBADDBITMAP;
+ PTBADDBITMAP = ^TBADDBITMAP;
+
+ TBBUTTON = record
+ iBitmap : longint;
+ idCommand : longint;
+ fsState : BYTE;
+ fsStyle : BYTE;
+ dwData : DWORD;
+ iString : longint;
+ end;
+ LPTBBUTTON = ^TBBUTTON;
+ LPCTBBUTTON = ^TBBUTTON;
+ _TBBUTTON = TBBUTTON;
+ TTBBUTTON = TBBUTTON;
+ PTBBUTTON = ^TBBUTTON;
+
+ TBNOTIFY = record
+ hdr : NMHDR;
+ iItem : longint;
+ tbButton : TBBUTTON;
+ cchText : longint;
+ pszText : LPTSTR;
+ end;
+ LPTBNOTIFY = ^TBNOTIFY;
+ TTBNOTIFY = TBNOTIFY;
+ PTBNOTIFY = ^TBNOTIFY;
+
+ TBSAVEPARAMS = record
+ hkr : HKEY;
+ pszSubKey : LPCTSTR;
+ pszValueName : LPCTSTR;
+ end;
+ TTBSAVEPARAMS = TBSAVEPARAMS;
+ PTBSAVEPARAMS = ^TBSAVEPARAMS;
+
+ TC_HITTESTINFO = record
+ pt : POINT;
+ flags : UINT;
+ end;
+ _TC_HITTESTINFO = TC_HITTESTINFO;
+ TTCHITTESTINFO = TC_HITTESTINFO;
+ PTCHITTESTINFO = ^TC_HITTESTINFO;
+
+ TC_ITEM = record
+ mask : UINT;
+ lpReserved1 : UINT;
+ lpReserved2 : UINT;
+ pszText : LPTSTR;
+ cchTextMax : longint;
+ iImage : longint;
+ lParam : LPARAM;
+ end;
+ _TC_ITEM = TC_ITEM;
+ TTCITEM = TC_ITEM;
+ PTCITEM = ^TC_ITEM;
+
+ TC_ITEMHEADER = record
+ mask : UINT;
+ lpReserved1 : UINT;
+ lpReserved2 : UINT;
+ pszText : LPTSTR;
+ cchTextMax : longint;
+ iImage : longint;
+ end;
+ _TC_ITEMHEADER = TC_ITEMHEADER;
+ TTCITEMHEADER = TC_ITEMHEADER;
+ PTCITEMHEADER = ^TC_ITEMHEADER;
+
+ TC_KEYDOWN = record
+ hdr : NMHDR;
+ wVKey : WORD;
+ flags : UINT;
+ end;
+ _TC_KEYDOWN = TC_KEYDOWN;
+ TTCKEYDOWN = TC_KEYDOWN;
+ PTCKEYDOWN = ^TC_KEYDOWN;
+
+ TEXTRANGE = record
+ chrg : CHARRANGE;
+ lpstrText : LPSTR;
+ end;
+ _textrange = TEXTRANGE;
+ Ttextrange = TEXTRANGE;
+ Ptextrange = ^TEXTRANGE;
+
+ TIME_ZONE_INFORMATION = record
+ Bias : LONG;
+ StandardName : array[0..31] of WCHAR;
+ StandardDate : SYSTEMTIME;
+ StandardBias : LONG;
+ DaylightName : array[0..31] of WCHAR;
+ DaylightDate : SYSTEMTIME;
+ DaylightBias : LONG;
+ end;
+ LPTIME_ZONE_INFORMATION = ^TIME_ZONE_INFORMATION;
+ _TIME_ZONE_INFORMATION = TIME_ZONE_INFORMATION;
+ TTIMEZONEINFORMATION = TIME_ZONE_INFORMATION;
+ PTIMEZONEINFORMATION = ^TIME_ZONE_INFORMATION;
+
+ TOGGLEKEYS = record
+ cbSize : DWORD;
+ dwFlags : DWORD;
+ end;
+ tagTOGGLEKEYS = TOGGLEKEYS;
+ TTOGGLEKEYS = TOGGLEKEYS;
+ PTOGGLEKEYS = ^TOGGLEKEYS;
+
+ TOKEN_SOURCE = record
+ SourceName : array[0..7] of CHAR;
+ SourceIdentifier : LUID;
+ end;
+ _TOKEN_SOURCE = TOKEN_SOURCE;
+ TTOKENSOURCE = TOKEN_SOURCE;
+ PTOKENSOURCE = ^TOKEN_SOURCE;
+
+ TOKEN_CONTROL = record
+ TokenId : LUID;
+ AuthenticationId : LUID;
+ ModifiedId : LUID;
+ TokenSource : TOKEN_SOURCE;
+ end;
+ _TOKEN_CONTROL = TOKEN_CONTROL;
+ TTOKENCONTROL = TOKEN_CONTROL;
+ PTOKENCONTROL = ^TOKEN_CONTROL;
+
+ TOKEN_DEFAULT_DACL = record
+ DefaultDacl : PACL;
+ end;
+ _TOKEN_DEFAULT_DACL = TOKEN_DEFAULT_DACL;
+ TTOKENDEFAULTDACL = TOKEN_DEFAULT_DACL;
+ PTOKENDEFAULTDACL = ^TOKEN_DEFAULT_DACL;
+
+ TOKEN_GROUPS = record
+ GroupCount : DWORD;
+ Groups : array[0..(ANYSIZE_ARRAY)-1] of SID_AND_ATTRIBUTES;
+ end;
+ PTOKEN_GROUPS = ^TOKEN_GROUPS;
+ LPTOKEN_GROUPS = ^TOKEN_GROUPS;
+ _TOKEN_GROUPS = TOKEN_GROUPS;
+ TTOKENGROUPS = TOKEN_GROUPS;
+ PTOKENGROUPS = ^TOKEN_GROUPS;
+
+ TOKEN_OWNER = record
+ Owner : PSID;
+ end;
+ _TOKEN_OWNER = TOKEN_OWNER;
+ TTOKENOWNER = TOKEN_OWNER;
+ PTOKENOWNER = ^TOKEN_OWNER;
+
+ TOKEN_PRIMARY_GROUP = record
+ PrimaryGroup : PSID;
+ end;
+ _TOKEN_PRIMARY_GROUP = TOKEN_PRIMARY_GROUP;
+ TTOKENPRIMARYGROUP = TOKEN_PRIMARY_GROUP;
+ PTOKENPRIMARYGROUP = ^TOKEN_PRIMARY_GROUP;
+
+ TOKEN_PRIVILEGES = packed record
+ PrivilegeCount : DWORD;
+ Privileges : array[0..(ANYSIZE_ARRAY)-1] of LUID_AND_ATTRIBUTES;
+ end;
+
+ PTOKEN_PRIVILEGES = ^TOKEN_PRIVILEGES;
+ LPTOKEN_PRIVILEGES = ^TOKEN_PRIVILEGES;
+ _TOKEN_PRIVILEGES = TOKEN_PRIVILEGES;
+ TTOKENPRIVILEGES = TOKEN_PRIVILEGES;
+ PTOKENPRIVILEGES = ^TOKEN_PRIVILEGES;
+
+ TOKEN_STATISTICS = record
+ TokenId : LUID;
+ AuthenticationId : LUID;
+ ExpirationTime : LARGE_INTEGER;
+ TokenType : TOKEN_TYPE;
+ ImpersonationLevel : SECURITY_IMPERSONATION_LEVEL;
+ DynamicCharged : DWORD;
+ DynamicAvailable : DWORD;
+ GroupCount : DWORD;
+ PrivilegeCount : DWORD;
+ ModifiedId : LUID;
+ end;
+ _TOKEN_STATISTICS = TOKEN_STATISTICS;
+ TTOKENSTATISTICS = TOKEN_STATISTICS;
+ PTOKENSTATISTICS = ^TOKEN_STATISTICS;
+
+ TOKEN_USER = record
+ User : SID_AND_ATTRIBUTES;
+ end;
+ _TOKEN_USER = TOKEN_USER;
+ TTOKENUSER = TOKEN_USER;
+ PTOKENUSER = ^TOKEN_USER;
+
+ TOOLINFO = record
+ cbSize : UINT;
+ uFlags : UINT;
+ hwnd : HWND;
+ uId : UINT;
+ rect : RECT;
+ hinst : HINST;
+ lpszText : LPTSTR;
+ end;
+ LPTOOLINFO = ^TOOLINFO;
+ TTOOLINFO = TOOLINFO;
+ PTOOLINFO = ^TOOLINFO;
+
+ TOOLTIPTEXT = record
+ hdr : NMHDR;
+ lpszText : LPTSTR;
+ szText : array[0..79] of char;
+ hinst : HINST;
+ uFlags : UINT;
+ end;
+ LPTOOLTIPTEXT = ^TOOLTIPTEXT;
+ TTOOLTIPTEXT = TOOLTIPTEXT;
+ PTOOLTIPTEXT = ^TOOLTIPTEXT;
+
+ TPMPARAMS = record
+ cbSize : UINT;
+ rcExclude : RECT;
+ end;
+ LPTPMPARAMS = ^TPMPARAMS;
+ tagTPMPARAMS = TPMPARAMS;
+ TTPMPARAMS = TPMPARAMS;
+ PTPMPARAMS = ^TPMPARAMS;
+
+ TRANSMIT_FILE_BUFFERS = record
+ Head : PVOID;
+ HeadLength : DWORD;
+ Tail : PVOID;
+ TailLength : DWORD;
+ end;
+ _TRANSMIT_FILE_BUFFERS = TRANSMIT_FILE_BUFFERS;
+ TTRANSMITFILEBUFFERS = TRANSMIT_FILE_BUFFERS;
+ PTRANSMITFILEBUFFERS = ^TRANSMIT_FILE_BUFFERS;
+
+ TTHITTESTINFO = record
+ hwnd : HWND;
+ pt : POINT;
+ ti : TOOLINFO;
+ end;
+ LPHITTESTINFO = ^TTHITTESTINFO;
+ _TT_HITTESTINFO = TTHITTESTINFO;
+ TTTHITTESTINFO = TTHITTESTINFO;
+ PTTHITTESTINFO = ^TTHITTESTINFO;
+
+ TTPOLYCURVE = record
+ wType : WORD;
+ cpfx : WORD;
+ apfx : array[0..0] of POINTFX;
+ end;
+ LPTTPOLYCURVE = ^TTPOLYCURVE;
+ tagTTPOLYCURVE = TTPOLYCURVE;
+ TTTPOLYCURVE = TTPOLYCURVE;
+ PTTPOLYCURVE = ^TTPOLYCURVE;
+
+ TTPOLYGONHEADER = record
+ cb : DWORD;
+ dwType : DWORD;
+ pfxStart : POINTFX;
+ end;
+ LPTTPOLYGONHEADER = ^TTPOLYGONHEADER;
+ _TTPOLYGONHEADER = TTPOLYGONHEADER;
+ TTTPOLYGONHEADER = TTPOLYGONHEADER;
+ PTTPOLYGONHEADER = ^TTPOLYGONHEADER;
+
+ TV_DISPINFO = record
+ hdr : NMHDR;
+ item : TV_ITEM;
+ end;
+ _TV_DISPINFO = TV_DISPINFO;
+ TTVDISPINFO = TV_DISPINFO;
+ PTVDISPINFO = ^TV_DISPINFO;
+
+ TV_HITTESTINFO = record
+ pt : POINT;
+ flags : UINT;
+ hItem : HTREEITEM;
+ end;
+ LPTV_HITTESTINFO = ^TV_HITTESTINFO;
+ _TVHITTESTINFO = TV_HITTESTINFO;
+ TTVHITTESTINFO = TV_HITTESTINFO;
+ PTVHITTESTINFO = ^TV_HITTESTINFO;
+
+ TV_INSERTSTRUCT = record
+ hParent : HTREEITEM;
+ hInsertAfter : HTREEITEM;
+ item : TV_ITEM;
+ end;
+ LPTV_INSERTSTRUCT = ^TV_INSERTSTRUCT;
+ _TV_INSERTSTRUCT = TV_INSERTSTRUCT;
+ TTVINSERTSTRUCT = TV_INSERTSTRUCT;
+ PTVINSERTSTRUCT = ^TV_INSERTSTRUCT;
+
+ TV_KEYDOWN = record
+ hdr : NMHDR;
+ wVKey : WORD;
+ flags : UINT;
+ end;
+ _TV_KEYDOWN = TV_KEYDOWN;
+ TTVKEYDOWN = TV_KEYDOWN;
+ PTVKEYDOWN = ^TV_KEYDOWN;
+
+ TV_SORTCB = record
+ hParent : HTREEITEM;
+ lpfnCompare : PFNTVCOMPARE;
+ lParam : LPARAM;
+ end;
+ LPTV_SORTCB = ^TV_SORTCB;
+ _TV_SORTCB = TV_SORTCB;
+ TTVSORTCB = TV_SORTCB;
+ PTVSORTCB = ^TV_SORTCB;
+
+ UDACCEL = record
+ nSec : UINT;
+ nInc : UINT;
+ end;
+ TUDACCEL = UDACCEL;
+ PUDACCEL = ^UDACCEL;
+
+
+ UNIVERSAL_NAME_INFO = record
+ lpUniversalName : LPTSTR;
+ end;
+ _UNIVERSAL_NAME_INFO = UNIVERSAL_NAME_INFO;
+ TUNIVERSALNAMEINFO = UNIVERSAL_NAME_INFO;
+ PUNIVERSALNAMEINFO = ^UNIVERSAL_NAME_INFO;
+
+ USEROBJECTFLAGS = record
+ fInherit : WINBOOL;
+ fReserved : WINBOOL;
+ dwFlags : DWORD;
+ end;
+ tagUSEROBJECTFLAGS = USEROBJECTFLAGS;
+ TUSEROBJECTFLAGS = USEROBJECTFLAGS;
+ PUSEROBJECTFLAGS = ^USEROBJECTFLAGS;
+
+ VALENT = record
+ ve_valuename : LPTSTR;
+ ve_valuelen : DWORD;
+ ve_valueptr : DWORD;
+ ve_type : DWORD;
+ end;
+ TVALENT = VALENT;
+ PVALENT = ^VALENT;
+
+ value_ent = VALENT;
+ Tvalue_ent = VALENT;
+ Pvalue_ent = ^VALENT;
+
+ VERIFY_INFORMATION = record
+ StartingOffset : LARGE_INTEGER;
+ Length : DWORD;
+ end;
+ _VERIFY_INFORMATION = VERIFY_INFORMATION;
+ TVERIFYINFORMATION = VERIFY_INFORMATION;
+ PVERIFYINFORMATION = ^VERIFY_INFORMATION;
+
+ VS_FIXEDFILEINFO = record
+ dwSignature : DWORD;
+ dwStrucVersion : DWORD;
+ dwFileVersionMS : DWORD;
+ dwFileVersionLS : DWORD;
+ dwProductVersionMS : DWORD;
+ dwProductVersionLS : DWORD;
+ dwFileFlagsMask : DWORD;
+ dwFileFlags : DWORD;
+ dwFileOS : DWORD;
+ dwFileType : DWORD;
+ dwFileSubtype : DWORD;
+ dwFileDateMS : DWORD;
+ dwFileDateLS : DWORD;
+ end;
+ _VS_FIXEDFILEINFO = VS_FIXEDFILEINFO;
+ TVSFIXEDFILEINFO = VS_FIXEDFILEINFO;
+ PVSFIXEDFILEINFO = ^VS_FIXEDFILEINFO;
+
+ WIN32_FIND_DATA = record
+ dwFileAttributes : DWORD;
+ ftCreationTime : FILETIME;
+ ftLastAccessTime : FILETIME;
+ ftLastWriteTime : FILETIME;
+ nFileSizeHigh : DWORD;
+ nFileSizeLow : DWORD;
+ dwReserved0 : DWORD;
+ dwReserved1 : DWORD;
+ cFileName : array[0..(MAX_PATH)-1] of TCHAR;
+ cAlternateFileName : array[0..13] of TCHAR;
+ end;
+ LPWIN32_FIND_DATA = ^WIN32_FIND_DATA;
+ PWIN32_FIND_DATA = ^WIN32_FIND_DATA;
+ _WIN32_FIND_DATA = WIN32_FIND_DATA;
+ TWIN32FINDDATA = WIN32_FIND_DATA;
+ TWIN32FINDDATAA = WIN32_FIND_DATA;
+ PWIN32FINDDATA = ^WIN32_FIND_DATA;
+
+ WIN32_FIND_DATAW = record
+ dwFileAttributes : DWORD;
+ ftCreationTime : FILETIME;
+ ftLastAccessTime : FILETIME;
+ ftLastWriteTime : FILETIME;
+ nFileSizeHigh : DWORD;
+ nFileSizeLow : DWORD;
+ dwReserved0 : DWORD;
+ dwReserved1 : DWORD;
+ cFileName : array[0..(MAX_PATH)-1] of WCHAR;
+ cAlternateFileName : array[0..13] of WCHAR;
+ end;
+ LPWIN32_FIND_DATAW = ^WIN32_FIND_DATAW;
+ PWIN32_FIND_DATAW = ^WIN32_FIND_DATAW;
+ _WIN32_FIND_DATAW = WIN32_FIND_DATAW;
+ TWIN32FINDDATAW = WIN32_FIND_DATAW;
+ PWIN32FINDDATAW = ^WIN32_FIND_DATAW;
+
+ WIN32_STREAM_ID = record
+ dwStreamId : DWORD;
+ dwStreamAttributes : DWORD;
+ Size : LARGE_INTEGER;
+ dwStreamNameSize : DWORD;
+ cStreamName : ^WCHAR;
+ end;
+ _WIN32_STREAM_ID = WIN32_STREAM_ID;
+ TWIN32STREAMID = WIN32_STREAM_ID;
+ PWIN32STREAMID = ^WIN32_STREAM_ID;
+
+ WINDOWPLACEMENT = record
+ length : UINT;
+ flags : UINT;
+ showCmd : UINT;
+ ptMinPosition : POINT;
+ ptMaxPosition : POINT;
+ rcNormalPosition : RECT;
+ end;
+ _WINDOWPLACEMENT = WINDOWPLACEMENT;
+ TWINDOWPLACEMENT = WINDOWPLACEMENT;
+ PWINDOWPLACEMENT = ^WINDOWPLACEMENT;
+
+ WNDCLASS = record
+ style : UINT;
+ lpfnWndProc : WNDPROC;
+ cbClsExtra : longint;
+ cbWndExtra : longint;
+ hInstance : HANDLE;
+ hIcon : HICON;
+ hCursor : HCURSOR;
+ hbrBackground : HBRUSH;
+ lpszMenuName : LPCTSTR;
+ lpszClassName : LPCTSTR;
+ end;
+ LPWNDCLASS = ^WNDCLASS;
+ _WNDCLASS = WNDCLASS;
+ TWNDCLASS = WNDCLASS;
+ TWNDCLASSA = WNDCLASS;
+ PWNDCLASS = ^WNDCLASS;
+
+
+ WNDCLASSW = record
+ style : UINT;
+ lpfnWndProc : WNDPROC;
+ cbClsExtra : longint;
+ cbWndExtra : longint;
+ hInstance : HANDLE;
+ hIcon : HICON;
+ hCursor : HCURSOR;
+ hbrBackground : HBRUSH;
+ lpszMenuName : LPCWSTR;
+ lpszClassName : LPCWSTR;
+ end;
+ LPWNDCLASSW = ^WNDCLASSW;
+ _WNDCLASSW = WNDCLASSW;
+ TWNDCLASSW = WNDCLASSW;
+ PWNDCLASSW = ^WNDCLASSW;
+
+ WNDCLASSEX = record
+ cbSize : UINT;
+ style : UINT;
+ lpfnWndProc : WNDPROC;
+ cbClsExtra : longint;
+ cbWndExtra : longint;
+ hInstance : HANDLE;
+ hIcon : HICON;
+ hCursor : HCURSOR;
+ hbrBackground : HBRUSH;
+ lpszMenuName : LPCTSTR;
+ lpszClassName : LPCTSTR;
+ hIconSm : HANDLE;
+ end;
+ LPWNDCLASSEX = ^WNDCLASSEX;
+ _WNDCLASSEX = WNDCLASSEX;
+ TWNDCLASSEX = WNDCLASSEX;
+ TWNDCLASSEXA = WNDCLASSEX;
+ PWNDCLASSEX = ^WNDCLASSEX;
+
+ WNDCLASSEXW = record
+ cbSize : UINT;
+ style : UINT;
+ lpfnWndProc : WNDPROC;
+ cbClsExtra : longint;
+ cbWndExtra : longint;
+ hInstance : HANDLE;
+ hIcon : HICON;
+ hCursor : HCURSOR;
+ hbrBackground : HBRUSH;
+ lpszMenuName : LPCWSTR;
+ lpszClassName : LPCWSTR;
+ hIconSm : HANDLE;
+ end;
+ LPWNDCLASSEXW = ^WNDCLASSEXW;
+ _WNDCLASSEXW = WNDCLASSEXW;
+ TWNDCLASSEXW = WNDCLASSEXW;
+ PWNDCLASSEXW = ^WNDCLASSEXW;
+
+ CONNECTDLGSTRUCT = record
+ cbStructure : DWORD;
+ hwndOwner : HWND;
+ lpConnRes : LPNETRESOURCE;
+ dwFlags : DWORD;
+ dwDevNum : DWORD;
+ end;
+ LPCONNECTDLGSTRUCT = ^CONNECTDLGSTRUCT;
+ _CONNECTDLGSTRUCT = CONNECTDLGSTRUCT;
+ TCONNECTDLGSTRUCT = CONNECTDLGSTRUCT;
+ PCONNECTDLGSTRUCT = ^CONNECTDLGSTRUCT;
+
+ DISCDLGSTRUCT = record
+ cbStructure : DWORD;
+ hwndOwner : HWND;
+ lpLocalName : LPTSTR;
+ lpRemoteName : LPTSTR;
+ dwFlags : DWORD;
+ end;
+ LPDISCDLGSTRUCT = ^DISCDLGSTRUCT;
+ _DISCDLGSTRUCT = DISCDLGSTRUCT;
+ TDISCDLGSTRUCT = DISCDLGSTRUCT;
+ TDISCDLGSTRUCTA = DISCDLGSTRUCT;
+ PDISCDLGSTRUCT = ^DISCDLGSTRUCT;
+
+ NETINFOSTRUCT = record
+ cbStructure : DWORD;
+ dwProviderVersion : DWORD;
+ dwStatus : DWORD;
+ dwCharacteristics : DWORD;
+ dwHandle : DWORD;
+ wNetType : WORD;
+ dwPrinters : DWORD;
+ dwDrives : DWORD;
+ end;
+ LPNETINFOSTRUCT = ^NETINFOSTRUCT;
+ _NETINFOSTRUCT = NETINFOSTRUCT;
+ TNETINFOSTRUCT = NETINFOSTRUCT;
+ PNETINFOSTRUCT = ^NETINFOSTRUCT;
+
+ NETCONNECTINFOSTRUCT = record
+ cbStructure : DWORD;
+ dwFlags : DWORD;
+ dwSpeed : DWORD;
+ dwDelay : DWORD;
+ dwOptDataSize : DWORD;
+ end;
+ LPNETCONNECTINFOSTRUCT = ^NETCONNECTINFOSTRUCT;
+ _NETCONNECTINFOSTRUCT = NETCONNECTINFOSTRUCT;
+ TNETCONNECTINFOSTRUCT = NETCONNECTINFOSTRUCT;
+ PNETCONNECTINFOSTRUCT = ^NETCONNECTINFOSTRUCT;
+
+ ENUMMETAFILEPROC = function (_para1:HDC; _para2:HANDLETABLE; _para3:METARECORD; _para4:longint; _para5:LPARAM):longint;stdcall;
+
+ ENHMETAFILEPROC = function (_para1:HDC; _para2:HANDLETABLE; _para3:ENHMETARECORD; _para4:longint; _para5:LPARAM):longint;stdcall;
+
+ ENUMFONTSPROC = function (_para1:LPLOGFONT; _para2:LPTEXTMETRIC; _para3:DWORD; _para4:LPARAM):longint;stdcall;
+
+ FONTENUMPROC = function (var _para1:ENUMLOGFONT; var _para2:NEWTEXTMETRIC; _para3:longint; _para4:LPARAM):longint;stdcall;
+
+ FONTENUMEXPROC = function (var _para1:ENUMLOGFONTEX;var _para2:NEWTEXTMETRICEX; _para3:longint; _para4:LPARAM):longint;stdcall;
+
+ LPOVERLAPPED_COMPLETION_ROUTINE = procedure (_para1:DWORD; _para2:DWORD; _para3:LPOVERLAPPED);stdcall;
+
+ { Structures for the extensions to OpenGL }
+
+ POINTFLOAT = record
+ x : Single;
+ y : Single;
+ end;
+ _POINTFLOAT = POINTFLOAT;
+ TPOINTFLOAT = POINTFLOAT;
+ PPOINTFLOAT = ^POINTFLOAT;
+
+ GLYPHMETRICSFLOAT = record
+ gmfBlackBoxX : Single;
+ gmfBlackBoxY : Single;
+ gmfptGlyphOrigin : POINTFLOAT;
+ gmfCellIncX : Single;
+ gmfCellIncY : Single;
+ end;
+ LPGLYPHMETRICSFLOAT = ^GLYPHMETRICSFLOAT;
+ _GLYPHMETRICSFLOAT = GLYPHMETRICSFLOAT;
+ TGLYPHMETRICSFLOAT = GLYPHMETRICSFLOAT;
+ PGLYPHMETRICSFLOAT = ^GLYPHMETRICSFLOAT;
+
+ LAYERPLANEDESCRIPTOR = record
+ nSize : WORD;
+ nVersion : WORD;
+ dwFlags : DWORD;
+ iPixelType : BYTE;
+ cColorBits : BYTE;
+ cRedBits : BYTE;
+ cRedShift : BYTE;
+ cGreenBits : BYTE;
+ cGreenShift : BYTE;
+ cBlueBits : BYTE;
+ cBlueShift : BYTE;
+ cAlphaBits : BYTE;
+ cAlphaShift : BYTE;
+ cAccumBits : BYTE;
+ cAccumRedBits : BYTE;
+ cAccumGreenBits : BYTE;
+ cAccumBlueBits : BYTE;
+ cAccumAlphaBits : BYTE;
+ cDepthBits : BYTE;
+ cStencilBits : BYTE;
+ cAuxBuffers : BYTE;
+ iLayerPlane : BYTE;
+ bReserved : BYTE;
+ crTransparent : COLORREF;
+ end;
+ LPLAYERPLANEDESCRIPTOR = ^LAYERPLANEDESCRIPTOR;
+ tagLAYERPLANEDESCRIPTOR = LAYERPLANEDESCRIPTOR;
+ TLAYERPLANEDESCRIPTOR = LAYERPLANEDESCRIPTOR;
+ PLAYERPLANEDESCRIPTOR = ^LAYERPLANEDESCRIPTOR;
+
+ PIXELFORMATDESCRIPTOR = record
+ nSize : WORD;
+ nVersion : WORD;
+ dwFlags : DWORD;
+ iPixelType : BYTE;
+ cColorBits : BYTE;
+ cRedBits : BYTE;
+ cRedShift : BYTE;
+ cGreenBits : BYTE;
+ cGreenShift : BYTE;
+ cBlueBits : BYTE;
+ cBlueShift : BYTE;
+ cAlphaBits : BYTE;
+ cAlphaShift : BYTE;
+ cAccumBits : BYTE;
+ cAccumRedBits : BYTE;
+ cAccumGreenBits : BYTE;
+ cAccumBlueBits : BYTE;
+ cAccumAlphaBits : BYTE;
+ cDepthBits : BYTE;
+ cStencilBits : BYTE;
+ cAuxBuffers : BYTE;
+ iLayerType : BYTE;
+ bReserved : BYTE;
+ dwLayerMask : DWORD;
+ dwVisibleMask : DWORD;
+ dwDamageMask : DWORD;
+ end;
+ LPPIXELFORMATDESCRIPTOR = ^PIXELFORMATDESCRIPTOR;
+ tagPIXELFORMATDESCRIPTOR = PIXELFORMATDESCRIPTOR;
+ TPIXELFORMATDESCRIPTOR = PIXELFORMATDESCRIPTOR;
+ PPIXELFORMATDESCRIPTOR = ^PIXELFORMATDESCRIPTOR;
+
+ USER_INFO_2 = record
+ usri2_name : LPWSTR;
+ usri2_password : LPWSTR;
+ usri2_password_age : DWORD;
+ usri2_priv : DWORD;
+ usri2_home_dir : LPWSTR;
+ usri2_comment : LPWSTR;
+ usri2_flags : DWORD;
+ usri2_script_path : LPWSTR;
+ usri2_auth_flags : DWORD;
+ usri2_full_name : LPWSTR;
+ usri2_usr_comment : LPWSTR;
+ usri2_parms : LPWSTR;
+ usri2_workstations : LPWSTR;
+ usri2_last_logon : DWORD;
+ usri2_last_logoff : DWORD;
+ usri2_acct_expires : DWORD;
+ usri2_max_storage : DWORD;
+ usri2_units_per_week : DWORD;
+ usri2_logon_hours : PBYTE;
+ usri2_bad_pw_count : DWORD;
+ usri2_num_logons : DWORD;
+ usri2_logon_server : LPWSTR;
+ usri2_country_code : DWORD;
+ usri2_code_page : DWORD;
+ end;
+ PUSER_INFO_2 = ^USER_INFO_2;
+ LPUSER_INFO_2 = ^USER_INFO_2;
+ TUSERINFO2 = USER_INFO_2;
+ PUSERINFO2 = ^USER_INFO_2;
+
+ USER_INFO_0 = record
+ usri0_name : LPWSTR;
+ end;
+ PUSER_INFO_0 = ^USER_INFO_0;
+ LPUSER_INFO_0 = ^USER_INFO_0;
+ TUSERINFO0 = USER_INFO_0;
+ PUSERINFO0 = ^USER_INFO_0;
+
+ USER_INFO_3 = record
+ usri3_name : LPWSTR;
+ usri3_password : LPWSTR;
+ usri3_password_age : DWORD;
+ usri3_priv : DWORD;
+ usri3_home_dir : LPWSTR;
+ usri3_comment : LPWSTR;
+ usri3_flags : DWORD;
+ usri3_script_path : LPWSTR;
+ usri3_auth_flags : DWORD;
+ usri3_full_name : LPWSTR;
+ usri3_usr_comment : LPWSTR;
+ usri3_parms : LPWSTR;
+ usri3_workstations : LPWSTR;
+ usri3_last_logon : DWORD;
+ usri3_last_logoff : DWORD;
+ usri3_acct_expires : DWORD;
+ usri3_max_storage : DWORD;
+ usri3_units_per_week : DWORD;
+ usri3_logon_hours : PBYTE;
+ usri3_bad_pw_count : DWORD;
+ usri3_num_logons : DWORD;
+ usri3_logon_server : LPWSTR;
+ usri3_country_code : DWORD;
+ usri3_code_page : DWORD;
+ usri3_user_id : DWORD;
+ usri3_primary_group_id : DWORD;
+ usri3_profile : LPWSTR;
+ usri3_home_dir_drive : LPWSTR;
+ usri3_password_expired : DWORD;
+ end;
+ PUSER_INFO_3 = ^USER_INFO_3;
+ LPUSER_INFO_3 = ^USER_INFO_3;
+ TUSERINFO3 = USER_INFO_3;
+ PUSERINFO3 = ^USER_INFO_3;
+
+ GROUP_INFO_2 = record
+ grpi2_name : LPWSTR;
+ grpi2_comment : LPWSTR;
+ grpi2_group_id : DWORD;
+ grpi2_attributes : DWORD;
+ end;
+ PGROUP_INFO_2 = ^GROUP_INFO_2;
+ TGROUPINFO2 = GROUP_INFO_2;
+ PGROUPINFO2 = ^GROUP_INFO_2;
+
+ LOCALGROUP_INFO_0 = record
+ lgrpi0_name : LPWSTR;
+ end;
+ PLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0;
+ LPLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0;
+ TLOCALGROUPINFO0 = LOCALGROUP_INFO_0;
+ PLOCALGROUPINFO0 = ^LOCALGROUP_INFO_0;
+
+ { PE executable header. }
+ { Magic number, 0x5a4d }
+ { Bytes on last page of file, 0x90 }
+ { Pages in file, 0x3 }
+ { Relocations, 0x0 }
+ { Size of header in paragraphs, 0x4 }
+ { Minimum extra paragraphs needed, 0x0 }
+ { Maximum extra paragraphs needed, 0xFFFF }
+ { Initial (relative) SS value, 0x0 }
+ { Initial SP value, 0xb8 }
+ { Checksum, 0x0 }
+ { Initial IP value, 0x0 }
+ { Initial (relative) CS value, 0x0 }
+ { File address of relocation table, 0x40 }
+ { Overlay number, 0x0 }
+ { Reserved words, all 0x0 }
+ { OEM identifier (for e_oeminfo), 0x0 }
+ { OEM information; e_oemid specific, 0x0 }
+ { Reserved words, all 0x0 }
+ { File address of new exe header, 0x80 }
+ { We leave out the next two fields, since they aren't in the header file }
+ { DWORD dos_message[16]; text which always follows dos header }
+ { DWORD nt_signature; required NT signature, 0x4550 }
+
+ IMAGE_DOS_HEADER = record
+ e_magic : WORD;
+ e_cblp : WORD;
+ e_cp : WORD;
+ e_crlc : WORD;
+ e_cparhdr : WORD;
+ e_minalloc : WORD;
+ e_maxalloc : WORD;
+ e_ss : WORD;
+ e_sp : WORD;
+ e_csum : WORD;
+ e_ip : WORD;
+ e_cs : WORD;
+ e_lfarlc : WORD;
+ e_ovno : WORD;
+ e_res : array[0..3] of WORD;
+ e_oemid : WORD;
+ e_oeminfo : WORD;
+ e_res2 : array[0..9] of WORD;
+ e_lfanew : LONG;
+ end;
+ PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
+ TIMAGEDOSHEADER = IMAGE_DOS_HEADER;
+ PIMAGEDOSHEADER = ^IMAGE_DOS_HEADER;
+
+ _NOTIFYICONDATAA = record
+ cbSize: DWORD;
+ Wnd: HWND;
+ uID: UINT;
+ uFlags: UINT;
+ uCallbackMessage: UINT;
+ hIcon: HICON;
+ szTip: array [0..63] of Char;
+ end;
+ _NOTIFYICONDATA = _NOTIFYICONDATAA;
+
+ _NOTIFYICONDATAW = record
+ cbSize: DWORD;
+ Wnd: HWND;
+ uID: UINT;
+ uFlags: UINT;
+ uCallbackMessage: UINT;
+ hIcon: HICON;
+ szTip: array [0..63] of Word;
+ end;
+ TNotifyIconDataA = _NOTIFYICONDATAA;
+ TNotifyIconDataW = _NOTIFYICONDATAW;
+ TNotifyIconData = TNotifyIconDataA;
+ NOTIFYICONDATAA = _NOTIFYICONDATAA;
+ NOTIFYICONDATAW = _NOTIFYICONDATAW;
+ NOTIFYICONDATA = NOTIFYICONDATAA;
+ PNotifyIconDataA = ^TNotifyIconDataA;
+ PNotifyIconDataW = ^TNotifyIconDataW;
+ PNotifyIconData = PNotifyIconDataA;
+
+ TWOHandleArray = array[0..MAXIMUM_WAIT_OBJECTS-1] of HANDLE;
+ PWOHandleArray = ^TWOHandleArray;
+
+{$ifndef HASVARIANT}
+ { This causes trouble with a compiler which has real variant support FK }
+ { Variant support }
+ TVarType = Word;
+ PVariant = ^TVariant;
+
+{ This variant type definition doesn't contain _all_ possible variant
+ types - some are not possible atm with FPC, e.g. VT_BSTR to mention
+ This is part of the variant definition used by Windows API not that Borland
+ TVarRec one which is already partially implemented.
+ Needed for some COM objects }
+
+ TVariant = record
+ vt: TVarType;
+ wReserved1: Word;
+ wReserved2: Word;
+ wReserved3: Word;
+ case Integer of
+ VT_UI1: (bVal: Byte);
+ VT_I2: (iVal: Smallint);
+ VT_I4: (lVal: Longint);
+ VT_R4: (fltVal: Single);
+ VT_R8: (dblVal: Double);
+ VT_BOOL: (vbool: WordBool);
+ VT_ERROR: (scode: HResult);
+ VT_BYREF or VT_UI1: (pbVal: ^Byte);
+ VT_BYREF or VT_I2: (piVal: ^Smallint);
+ VT_BYREF or VT_I4: (plVal: ^Longint);
+ VT_BYREF or VT_R4: (pfltVal: ^Single);
+ VT_BYREF or VT_R8: (pdblVal: ^Double);
+ VT_BYREF or VT_BOOL: (pbool: ^WordBool);
+ VT_BYREF or VT_ERROR: (pscode: ^HResult);
+ VT_BYREF: (byRef: Pointer);
+ end;
+
+ VARIANT = TVariant;
+{$endif HASVARIANT}
+
+ MMRESULT = Longint;
+
+type
+ PWaveFormatEx = ^TWaveFormatEx;
+ TWaveFormatEx = packed record
+ wFormatTag: Word; { format type }
+ nChannels: Word; { number of channels (i.e. mono, stereo, etc.) }
+ nSamplesPerSec: DWORD; { sample rate }
+ nAvgBytesPerSec: DWORD; { for buffer estimation }
+ nBlockAlign: Word; { block size of data }
+ wBitsPerSample: Word; { number of bits per sample of mono data }
+ cbSize: Word; { the count in bytes of the size of }
+ end;
+
+ _WIN32_FILE_ATTRIBUTE_DATA = packed record
+ dwFileAttributes: DWORD;
+ ftCreationTime: FILETIME;
+ ftLastAccessTime: FILETIME;
+ ftLastWriteTime: FILETIME;
+ nFileSizeHigh: DWORD;
+ nFileSizeLow: DWORD;
+ end;
+ WIN32_FILE_ATTRIBUTE_DATA = _WIN32_FILE_ATTRIBUTE_DATA ;
+ LPWIN32_FILE_ATTRIBUTE_DATA = ^_WIN32_FILE_ATTRIBUTE_DATA;
+ TWIN32FILEATTRIBUTEDATA = _WIN32_FILE_ATTRIBUTE_DATA ;
+ PWIN32FILEATTRIBUTEDATA = ^_WIN32_FILE_ATTRIBUTE_DATA;
+
+ // TrackMouseEvent. NT or higher only.
+ TTrackMouseEvent = Record
+ cbSize : DWORD;
+ dwFlags : DWORD;
+ hwndTrack : HWND;
+ dwHoverTime : DWORD;
+ end;
+ PTrackMouseEvent = ^TTrackMouseEvent;
+
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+ function fBinary(var a : DCB) : DWORD;
+ begin
+ fBinary:=(a.flags and bm_DCB_fBinary) shr bp_DCB_fBinary;
+ end;
+
+ procedure set_fBinary(var a : DCB; __fBinary : DWORD);
+ begin
+ a.flags:=a.flags or ((__fBinary shl bp_DCB_fBinary) and bm_DCB_fBinary);
+ end;
+
+ function fParity(var a : DCB) : DWORD;
+ begin
+ fParity:=(a.flags and bm_DCB_fParity) shr bp_DCB_fParity;
+ end;
+
+ procedure set_fParity(var a : DCB; __fParity : DWORD);
+ begin
+ a.flags:=a.flags or ((__fParity shl bp_DCB_fParity) and bm_DCB_fParity);
+ end;
+
+ function fOutxCtsFlow(var a : DCB) : DWORD;
+ begin
+ fOutxCtsFlow:=(a.flags and bm_DCB_fOutxCtsFlow) shr bp_DCB_fOutxCtsFlow;
+ end;
+
+ procedure set_fOutxCtsFlow(var a : DCB; __fOutxCtsFlow : DWORD);
+ begin
+ a.flags:=a.flags or ((__fOutxCtsFlow shl bp_DCB_fOutxCtsFlow) and bm_DCB_fOutxCtsFlow);
+ end;
+
+ function fOutxDsrFlow(var a : DCB) : DWORD;
+ begin
+ fOutxDsrFlow:=(a.flags and bm_DCB_fOutxDsrFlow) shr bp_DCB_fOutxDsrFlow;
+ end;
+
+ procedure set_fOutxDsrFlow(var a : DCB; __fOutxDsrFlow : DWORD);
+ begin
+ a.flags:=a.flags or ((__fOutxDsrFlow shl bp_DCB_fOutxDsrFlow) and bm_DCB_fOutxDsrFlow);
+ end;
+
+ function fDtrControl(var a : DCB) : DWORD;
+ begin
+ fDtrControl:=(a.flags and bm_DCB_fDtrControl) shr bp_DCB_fDtrControl;
+ end;
+
+ procedure set_fDtrControl(var a : DCB; __fDtrControl : DWORD);
+ begin
+ a.flags:=a.flags or ((__fDtrControl shl bp_DCB_fDtrControl) and bm_DCB_fDtrControl);
+ end;
+
+ function fDsrSensitivity(var a : DCB) : DWORD;
+ begin
+ fDsrSensitivity:=(a.flags and bm_DCB_fDsrSensitivity) shr bp_DCB_fDsrSensitivity;
+ end;
+
+ procedure set_fDsrSensitivity(var a : DCB; __fDsrSensitivity : DWORD);
+ begin
+ a.flags:=a.flags or ((__fDsrSensitivity shl bp_DCB_fDsrSensitivity) and bm_DCB_fDsrSensitivity);
+ end;
+
+ function fTXContinueOnXoff(var a : DCB) : DWORD;
+ begin
+ fTXContinueOnXoff:=(a.flags and bm_DCB_fTXContinueOnXoff) shr bp_DCB_fTXContinueOnXoff;
+ end;
+
+ procedure set_fTXContinueOnXoff(var a : DCB; __fTXContinueOnXoff : DWORD);
+ begin
+ a.flags:=a.flags or ((__fTXContinueOnXoff shl bp_DCB_fTXContinueOnXoff) and bm_DCB_fTXContinueOnXoff);
+ end;
+
+ function fOutX(var a : DCB) : DWORD;
+ begin
+ fOutX:=(a.flags and bm_DCB_fOutX) shr bp_DCB_fOutX;
+ end;
+
+ procedure set_fOutX(var a : DCB; __fOutX : DWORD);
+ begin
+ a.flags:=a.flags or ((__fOutX shl bp_DCB_fOutX) and bm_DCB_fOutX);
+ end;
+
+ function fInX(var a : DCB) : DWORD;
+ begin
+ fInX:=(a.flags and bm_DCB_fInX) shr bp_DCB_fInX;
+ end;
+
+ procedure set_fInX(var a : DCB; __fInX : DWORD);
+ begin
+ a.flags:=a.flags or ((__fInX shl bp_DCB_fInX) and bm_DCB_fInX);
+ end;
+
+ function fErrorChar(var a : DCB) : DWORD;
+ begin
+ fErrorChar:=(a.flags and bm_DCB_fErrorChar) shr bp_DCB_fErrorChar;
+ end;
+
+ procedure set_fErrorChar(var a : DCB; __fErrorChar : DWORD);
+ begin
+ a.flags:=a.flags or ((__fErrorChar shl bp_DCB_fErrorChar) and bm_DCB_fErrorChar);
+ end;
+
+ function fNull(var a : DCB) : DWORD;
+ begin
+ fNull:=(a.flags and bm_DCB_fNull) shr bp_DCB_fNull;
+ end;
+
+ procedure set_fNull(var a : DCB; __fNull : DWORD);
+ begin
+ a.flags:=a.flags or ((__fNull shl bp_DCB_fNull) and bm_DCB_fNull);
+ end;
+
+ function fRtsControl(var a : DCB) : DWORD;
+ begin
+ fRtsControl:=(a.flags and bm_DCB_fRtsControl) shr bp_DCB_fRtsControl;
+ end;
+
+ procedure set_fRtsControl(var a : DCB; __fRtsControl : DWORD);
+ begin
+ a.flags:=a.flags or ((__fRtsControl shl bp_DCB_fRtsControl) and bm_DCB_fRtsControl);
+ end;
+
+ function fAbortOnError(var a : DCB) : DWORD;
+ begin
+ fAbortOnError:=(a.flags and bm_DCB_fAbortOnError) shr bp_DCB_fAbortOnError;
+ end;
+
+ procedure set_fAbortOnError(var a : DCB; __fAbortOnError : DWORD);
+ begin
+ a.flags:=a.flags or ((__fAbortOnError shl bp_DCB_fAbortOnError) and bm_DCB_fAbortOnError);
+ end;
+
+ function fDummy2(var a : DCB) : DWORD;
+ begin
+ fDummy2:=(a.flags and bm_DCB_fDummy2) shr bp_DCB_fDummy2;
+ end;
+
+ procedure set_fDummy2(var a : DCB; __fDummy2 : DWORD);
+ begin
+ a.flags:=a.flags or ((__fDummy2 shl bp_DCB_fDummy2) and bm_DCB_fDummy2);
+ end;
+
+ function fCtsHold(var a : COMSTAT) : DWORD;
+ begin
+ fCtsHold:=(a.flag0 and bm_COMSTAT_fCtsHold) shr bp_COMSTAT_fCtsHold;
+ end;
+
+ procedure set_fCtsHold(var a : COMSTAT; __fCtsHold : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fCtsHold shl bp_COMSTAT_fCtsHold) and bm_COMSTAT_fCtsHold);
+ end;
+
+ function fDsrHold(var a : COMSTAT) : DWORD;
+ begin
+ fDsrHold:=(a.flag0 and bm_COMSTAT_fDsrHold) shr bp_COMSTAT_fDsrHold;
+ end;
+
+ procedure set_fDsrHold(var a : COMSTAT; __fDsrHold : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fDsrHold shl bp_COMSTAT_fDsrHold) and bm_COMSTAT_fDsrHold);
+ end;
+
+ function fRlsdHold(var a : COMSTAT) : DWORD;
+ begin
+ fRlsdHold:=(a.flag0 and bm_COMSTAT_fRlsdHold) shr bp_COMSTAT_fRlsdHold;
+ end;
+
+ procedure set_fRlsdHold(var a : COMSTAT; __fRlsdHold : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fRlsdHold shl bp_COMSTAT_fRlsdHold) and bm_COMSTAT_fRlsdHold);
+ end;
+
+ function fXoffHold(var a : COMSTAT) : DWORD;
+ begin
+ fXoffHold:=(a.flag0 and bm_COMSTAT_fXoffHold) shr bp_COMSTAT_fXoffHold;
+ end;
+
+ procedure set_fXoffHold(var a : COMSTAT; __fXoffHold : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fXoffHold shl bp_COMSTAT_fXoffHold) and bm_COMSTAT_fXoffHold);
+ end;
+
+ function fXoffSent(var a : COMSTAT) : DWORD;
+ begin
+ fXoffSent:=(a.flag0 and bm_COMSTAT_fXoffSent) shr bp_COMSTAT_fXoffSent;
+ end;
+
+ procedure set_fXoffSent(var a : COMSTAT; __fXoffSent : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fXoffSent shl bp_COMSTAT_fXoffSent) and bm_COMSTAT_fXoffSent);
+ end;
+
+ function fEof(var a : COMSTAT) : DWORD;
+ begin
+ fEof:=(a.flag0 and bm_COMSTAT_fEof) shr bp_COMSTAT_fEof;
+ end;
+
+ procedure set_fEof(var a : COMSTAT; __fEof : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fEof shl bp_COMSTAT_fEof) and bm_COMSTAT_fEof);
+ end;
+
+ function fTxim(var a : COMSTAT) : DWORD;
+ begin
+ fTxim:=(a.flag0 and bm_COMSTAT_fTxim) shr bp_COMSTAT_fTxim;
+ end;
+
+ procedure set_fTxim(var a : COMSTAT; __fTxim : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fTxim shl bp_COMSTAT_fTxim) and bm_COMSTAT_fTxim);
+ end;
+
+ function fReserved(var a : COMSTAT) : DWORD;
+ begin
+ fReserved:=(a.flag0 and bm_COMSTAT_fReserved) shr bp_COMSTAT_fReserved;
+ end;
+
+ procedure set_fReserved(var a : COMSTAT; __fReserved : DWORD);
+ begin
+ a.flag0:=a.flag0 or ((__fReserved shl bp_COMSTAT_fReserved) and bm_COMSTAT_fReserved);
+ end;
+
+ function bAppReturnCode(var a : DDEACK) : word;
+ begin
+ bAppReturnCode:=(a.flag0 and bm_DDEACK_bAppReturnCode) shr bp_DDEACK_bAppReturnCode;
+ end;
+
+ procedure set_bAppReturnCode(var a : DDEACK; __bAppReturnCode : word);
+ begin
+ a.flag0:=a.flag0 or ((__bAppReturnCode shl bp_DDEACK_bAppReturnCode) and bm_DDEACK_bAppReturnCode);
+ end;
+
+ function reserved(var a : DDEACK) : word;
+ begin
+ reserved:=(a.flag0 and bm_DDEACK_reserved) shr bp_DDEACK_reserved;
+ end;
+
+ procedure set_reserved(var a : DDEACK; __reserved : word);
+ begin
+ a.flag0:=a.flag0 or ((__reserved shl bp_DDEACK_reserved) and bm_DDEACK_reserved);
+ end;
+
+ function fBusy(var a : DDEACK) : word;
+ begin
+ fBusy:=(a.flag0 and bm_DDEACK_fBusy) shr bp_DDEACK_fBusy;
+ end;
+
+ procedure set_fBusy(var a : DDEACK; __fBusy : word);
+ begin
+ a.flag0:=a.flag0 or ((__fBusy shl bp_DDEACK_fBusy) and bm_DDEACK_fBusy);
+ end;
+
+ function fAck(var a : DDEACK) : word;
+ begin
+ fAck:=(a.flag0 and bm_DDEACK_fAck) shr bp_DDEACK_fAck;
+ end;
+
+ procedure set_fAck(var a : DDEACK; __fAck : word);
+ begin
+ a.flag0:=a.flag0 or ((__fAck shl bp_DDEACK_fAck) and bm_DDEACK_fAck);
+ end;
+
+ function reserved(var a : DDEADVISE) : word;
+ begin
+ reserved:=(a.flag0 and bm_DDEADVISE_reserved) shr bp_DDEADVISE_reserved;
+ end;
+
+ procedure set_reserved(var a : DDEADVISE; __reserved : word);
+ begin
+ a.flag0:=a.flag0 or ((__reserved shl bp_DDEADVISE_reserved) and bm_DDEADVISE_reserved);
+ end;
+
+ function fDeferUpd(var a : DDEADVISE) : word;
+ begin
+ fDeferUpd:=(a.flag0 and bm_DDEADVISE_fDeferUpd) shr bp_DDEADVISE_fDeferUpd;
+ end;
+
+ procedure set_fDeferUpd(var a : DDEADVISE; __fDeferUpd : word);
+ begin
+ a.flag0:=a.flag0 or ((__fDeferUpd shl bp_DDEADVISE_fDeferUpd) and bm_DDEADVISE_fDeferUpd);
+ end;
+
+ function fAckReq(var a : DDEADVISE) : word;
+ begin
+ fAckReq:=(a.flag0 and bm_DDEADVISE_fAckReq) shr bp_DDEADVISE_fAckReq;
+ end;
+
+ procedure set_fAckReq(var a : DDEADVISE; __fAckReq : word);
+ begin
+ a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEADVISE_fAckReq) and bm_DDEADVISE_fAckReq);
+ end;
+
+ function unused(var a : DDEDATA) : word;
+ begin
+ unused:=(a.flag0 and bm_DDEDATA_unused) shr bp_DDEDATA_unused;
+ end;
+
+ procedure set_unused(var a : DDEDATA; __unused : word);
+ begin
+ a.flag0:=a.flag0 or ((__unused shl bp_DDEDATA_unused) and bm_DDEDATA_unused);
+ end;
+
+ function fResponse(var a : DDEDATA) : word;
+ begin
+ fResponse:=(a.flag0 and bm_DDEDATA_fResponse) shr bp_DDEDATA_fResponse;
+ end;
+
+ procedure set_fResponse(var a : DDEDATA; __fResponse : word);
+ begin
+ a.flag0:=a.flag0 or ((__fResponse shl bp_DDEDATA_fResponse) and bm_DDEDATA_fResponse);
+ end;
+
+ function fRelease(var a : DDEDATA) : word;
+ begin
+ fRelease:=(a.flag0 and bm_DDEDATA_fRelease) shr bp_DDEDATA_fRelease;
+ end;
+
+ procedure set_fRelease(var a : DDEDATA; __fRelease : word);
+ begin
+ a.flag0:=a.flag0 or ((__fRelease shl bp_DDEDATA_fRelease) and bm_DDEDATA_fRelease);
+ end;
+
+ function reserved(var a : DDEDATA) : word;
+ begin
+ reserved:=(a.flag0 and bm_DDEDATA_reserved) shr bp_DDEDATA_reserved;
+ end;
+
+ procedure set_reserved(var a : DDEDATA; __reserved : word);
+ begin
+ a.flag0:=a.flag0 or ((__reserved shl bp_DDEDATA_reserved) and bm_DDEDATA_reserved);
+ end;
+
+ function fAckReq(var a : DDEDATA) : word;
+ begin
+ fAckReq:=(a.flag0 and bm_DDEDATA_fAckReq) shr bp_DDEDATA_fAckReq;
+ end;
+
+ procedure set_fAckReq(var a : DDEDATA; __fAckReq : word);
+ begin
+ a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEDATA_fAckReq) and bm_DDEDATA_fAckReq);
+ end;
+
+ function unused(var a : DDELN) : word;
+ begin
+ unused:=(a.flag0 and bm_DDELN_unused) shr bp_DDELN_unused;
+ end;
+
+ procedure set_unused(var a : DDELN; __unused : word);
+ begin
+ a.flag0:=a.flag0 or ((__unused shl bp_DDELN_unused) and bm_DDELN_unused);
+ end;
+
+ function fRelease(var a : DDELN) : word;
+ begin
+ fRelease:=(a.flag0 and bm_DDELN_fRelease) shr bp_DDELN_fRelease;
+ end;
+
+ procedure set_fRelease(var a : DDELN; __fRelease : word);
+ begin
+ a.flag0:=a.flag0 or ((__fRelease shl bp_DDELN_fRelease) and bm_DDELN_fRelease);
+ end;
+
+ function fDeferUpd(var a : DDELN) : word;
+ begin
+ fDeferUpd:=(a.flag0 and bm_DDELN_fDeferUpd) shr bp_DDELN_fDeferUpd;
+ end;
+
+ procedure set_fDeferUpd(var a : DDELN; __fDeferUpd : word);
+ begin
+ a.flag0:=a.flag0 or ((__fDeferUpd shl bp_DDELN_fDeferUpd) and bm_DDELN_fDeferUpd);
+ end;
+
+ function fAckReq(var a : DDELN) : word;
+ begin
+ fAckReq:=(a.flag0 and bm_DDELN_fAckReq) shr bp_DDELN_fAckReq;
+ end;
+
+ procedure set_fAckReq(var a : DDELN; __fAckReq : word);
+ begin
+ a.flag0:=a.flag0 or ((__fAckReq shl bp_DDELN_fAckReq) and bm_DDELN_fAckReq);
+ end;
+
+ function unused(var a : DDEPOKE) : word;
+ begin
+ unused:=(a.flag0 and bm_DDEPOKE_unused) shr bp_DDEPOKE_unused;
+ end;
+
+ procedure set_unused(var a : DDEPOKE; __unused : word);
+ begin
+ a.flag0:=a.flag0 or ((__unused shl bp_DDEPOKE_unused) and bm_DDEPOKE_unused);
+ end;
+
+ function fRelease(var a : DDEPOKE) : word;
+ begin
+ fRelease:=(a.flag0 and bm_DDEPOKE_fRelease) shr bp_DDEPOKE_fRelease;
+ end;
+
+ procedure set_fRelease(var a : DDEPOKE; __fRelease : word);
+ begin
+ a.flag0:=a.flag0 or ((__fRelease shl bp_DDEPOKE_fRelease) and bm_DDEPOKE_fRelease);
+ end;
+
+ function fReserved(var a : DDEPOKE) : word;
+ begin
+ fReserved:=(a.flag0 and bm_DDEPOKE_fReserved) shr bp_DDEPOKE_fReserved;
+ end;
+
+ procedure set_fReserved(var a : DDEPOKE; __fReserved : word);
+ begin
+ a.flag0:=a.flag0 or ((__fReserved shl bp_DDEPOKE_fReserved) and bm_DDEPOKE_fReserved);
+ end;
+
+ function unused(var a : DDEUP) : word;
+ begin
+ unused:=(a.flag0 and bm_DDEUP_unused) shr bp_DDEUP_unused;
+ end;
+
+ procedure set_unused(var a : DDEUP; __unused : word);
+ begin
+ a.flag0:=a.flag0 or ((__unused shl bp_DDEUP_unused) and bm_DDEUP_unused);
+ end;
+
+ function fAck(var a : DDEUP) : word;
+ begin
+ fAck:=(a.flag0 and bm_DDEUP_fAck) shr bp_DDEUP_fAck;
+ end;
+
+ procedure set_fAck(var a : DDEUP; __fAck : word);
+ begin
+ a.flag0:=a.flag0 or ((__fAck shl bp_DDEUP_fAck) and bm_DDEUP_fAck);
+ end;
+
+ function fRelease(var a : DDEUP) : word;
+ begin
+ fRelease:=(a.flag0 and bm_DDEUP_fRelease) shr bp_DDEUP_fRelease;
+ end;
+
+ procedure set_fRelease(var a : DDEUP; __fRelease : word);
+ begin
+ a.flag0:=a.flag0 or ((__fRelease shl bp_DDEUP_fRelease) and bm_DDEUP_fRelease);
+ end;
+
+ function fReserved(var a : DDEUP) : word;
+ begin
+ fReserved:=(a.flag0 and bm_DDEUP_fReserved) shr bp_DDEUP_fReserved;
+ end;
+
+ procedure set_fReserved(var a : DDEUP; __fReserved : word);
+ begin
+ a.flag0:=a.flag0 or ((__fReserved shl bp_DDEUP_fReserved) and bm_DDEUP_fReserved);
+ end;
+
+ function fAckReq(var a : DDEUP) : word;
+ begin
+ fAckReq:=(a.flag0 and bm_DDEUP_fAckReq) shr bp_DDEUP_fAckReq;
+ end;
+
+ procedure set_fAckReq(var a : DDEUP; __fAckReq : word);
+ begin
+ a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEUP_fAckReq) and bm_DDEUP_fAckReq);
+ end;
+
+{$endif read_implementation}
+
+{
+ $Log: struct.inc,v $
+ Revision 1.36 2005/02/26 15:06:25 florian
+ + PDevideMode* added
+
+ Revision 1.35 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.34 2005/02/06 13:06:20 peter
+ * moved file and dir functions to sysfile/sysdir
+ * win32 thread in systemunit
+
+ Revision 1.33 2005/02/03 18:41:12 florian
+ * more clx compilation fixed
+
+ Revision 1.32 2005/01/19 14:24:46 marco
+ * some comments about COMSTAT added
+
+ Revision 1.31 2005/01/08 14:43:34 florian
+ + added LOGFONTW
+
+ Revision 1.30 2005/01/08 14:39:01 florian
+ * DEVMODE fixed
+
+}
diff --git a/rtl/win32/wininc/unidef.inc b/rtl/win32/wininc/unidef.inc
new file mode 100644
index 0000000000..0bcf9c149a
--- /dev/null
+++ b/rtl/win32/wininc/unidef.inc
@@ -0,0 +1,499 @@
+{
+ $Id: unidef.inc,v 1.13 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Contains the Unicode functions for windows unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ UnicodeFunctions.h
+
+ Declarations for all the Windows32 API Unicode Functions
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+ Date: 1996
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+function GetBinaryType(lpApplicationName:LPCWSTR; lpBinaryType:LPDWORD):WINBOOL; external 'kernel32' name 'GetBinaryTypeW';
+function GetShortPathName(lpszLongPath:LPCWSTR; lpszShortPath:LPWSTR; cchBuffer:DWORD):DWORD; external 'kernel32' name 'GetShortPathNameW';
+function GetEnvironmentStrings : LPWSTR; external 'kernel32' name 'GetEnvironmentStringsW';function FreeEnvironmentStrings(_para1:LPWSTR):WINBOOL; external 'kernel32' name 'FreeEnvironmentStringsW';
+function FormatMessage(dwFlags:DWORD; lpSource:LPCVOID; dwMessageId:DWORD; dwLanguageId:DWORD; lpBuffer:LPWSTR;nSize:DWORD; Arguments:va_list):DWORD; external 'kernel32' name 'FormatMessageW';
+function CreateMailslot(lpName:LPCWSTR; nMaxMessageSize:DWORD; lReadTimeout:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE; external 'kernel32' name 'CreateMailslotW';
+function lstrcmp(lpString1:LPCWSTR; lpString2:LPCWSTR):longint; external 'kernel32' name 'lstrcmpW';
+function lstrcmpi(lpString1:LPCWSTR; lpString2:LPCWSTR):longint; external 'kernel32' name 'lstrcmpiW';
+function lstrcpyn(lpString1:LPWSTR; lpString2:LPCWSTR; iMaxLength:longint):LPWSTR; external 'kernel32' name 'lstrcpynW';
+function lstrcpy(lpString1:LPWSTR; lpString2:LPCWSTR):LPWSTR; external 'kernel32' name 'lstrcpyW';
+function lstrcat(lpString1:LPWSTR; lpString2:LPCWSTR):LPWSTR; external 'kernel32' name 'lstrcatW';
+function lstrlen(lpString:LPCWSTR):longint; external 'kernel32' name 'lstrlenW';
+function CreateMutex(lpMutexAttributes:LPSECURITY_ATTRIBUTES; bInitialOwner:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateMutexW';
+function OpenMutex(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenMutexW';
+function CreateEvent(lpEventAttributes:LPSECURITY_ATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateEventW';
+function OpenEvent(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenEventW';
+function CreateSemaphore(lpSemaphoreAttributes:LPSECURITY_ATTRIBUTES; lInitialCount:LONG; lMaximumCount:LONG; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateSemaphoreW';
+function OpenSemaphore(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenSemaphoreW';
+function CreateFileMapping(hFile:HANDLE; lpFileMappingAttributes:LPSECURITY_ATTRIBUTES; flProtect:DWORD; dwMaximumSizeHigh:DWORD; dwMaximumSizeLow:DWORD;lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateFileMappingW';
+function OpenFileMapping(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenFileMappingW';
+function GetLogicalDriveStrings(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetLogicalDriveStringsW';
+function LoadLibrary(lpLibFileName:LPCWSTR):HINST; external 'kernel32' name 'LoadLibraryW';
+function LoadLibraryEx(lpLibFileName:LPCWSTR; hFile:HANDLE; dwFlags:DWORD):HINST; external 'kernel32' name 'LoadLibraryExW';
+function GetModuleFileName(hModule:HINST; lpFilename:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetModuleFileNameW';
+function GetModuleHandle(lpModuleName:LPCWSTR):HMODULE; external 'kernel32' name 'GetModuleHandleW';
+procedure FatalAppExit(uAction:UINT; lpMessageText:LPCWSTR); external 'kernel32' name 'FatalAppExitW';
+function GetCommandLine : LPWSTR; external 'kernel32' name 'GetCommandLineW';function GetEnvironmentVariable(lpName:LPCWSTR; lpBuffer:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetEnvironmentVariableW';
+function SetEnvironmentVariable(lpName:LPCWSTR; lpValue:LPCWSTR):WINBOOL; external 'kernel32' name 'SetEnvironmentVariableW';
+function ExpandEnvironmentStrings(lpSrc:LPCWSTR; lpDst:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'ExpandEnvironmentStringsW';
+procedure OutputDebugString(lpOutputString:LPCWSTR); external 'kernel32' name 'OutputDebugStringW';
+function FindResource(hModule:HINST; lpName:LPCWSTR; lpType:LPCWSTR):HRSRC; external 'kernel32' name 'FindResourceW';
+function FindResourceEx(hModule:HINST; lpType:LPCWSTR; lpName:LPCWSTR; wLanguage:WORD):HRSRC; external 'kernel32' name 'FindResourceExW';
+function EnumResourceTypes(hModule:HINST; lpEnumFunc:ENUMRESTYPEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceTypesW';
+function EnumResourceNames(hModule:HINST; lpType:LPCWSTR; lpEnumFunc:ENUMRESNAMEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceNamesW';
+function EnumResourceLanguages(hModule:HINST; lpType:LPCWSTR; lpName:LPCWSTR; lpEnumFunc:ENUMRESLANGPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceLanguagesW';
+function BeginUpdateResource(pFileName:LPCWSTR; bDeleteExistingResources:WINBOOL):HANDLE; external 'kernel32' name 'BeginUpdateResourceW';
+function UpdateResource(hUpdate:HANDLE; lpType:LPCWSTR; lpName:LPCWSTR; wLanguage:WORD; lpData:LPVOID;cbData:DWORD):WINBOOL; external 'kernel32' name 'UpdateResourceW';
+function EndUpdateResource(hUpdate:HANDLE; fDiscard:WINBOOL):WINBOOL; external 'kernel32' name 'EndUpdateResourceW';
+function GlobalAddAtom(lpString:LPCWSTR):ATOM; external 'kernel32' name 'GlobalAddAtomW';
+function GlobalFindAtom(lpString:LPCWSTR):ATOM; external 'kernel32' name 'GlobalFindAtomW';
+function GlobalGetAtomName(nAtom:ATOM; lpBuffer:LPWSTR; nSize:longint):UINT; external 'kernel32' name 'GlobalGetAtomNameW';
+function AddAtom(lpString:LPCWSTR):ATOM; external 'kernel32' name 'AddAtomW';
+function FindAtom(lpString:LPCWSTR):ATOM; external 'kernel32' name 'FindAtomW';
+function GetAtomName(nAtom:ATOM; lpBuffer:LPWSTR; nSize:longint):UINT; external 'kernel32' name 'GetAtomNameW';
+function GetProfileInt(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; nDefault:WINT):UINT; external 'kernel32' name 'GetProfileIntW';
+function GetProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpDefault:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileStringW';
+function WriteProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpString:LPCWSTR):WINBOOL; external 'kernel32' name 'WriteProfileStringW';
+function GetProfileSection(lpAppName:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileSectionW';
+function WriteProfileSection(lpAppName:LPCWSTR; lpString:LPCWSTR):WINBOOL; external 'kernel32' name 'WriteProfileSectionW';
+function GetPrivateProfileInt(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; nDefault:WINT; lpFileName:LPCWSTR):UINT; external 'kernel32' name 'GetPrivateProfileIntW';
+function GetPrivateProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpDefault:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD;lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetPrivateProfileStringW';
+function WritePrivateProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpString:LPCWSTR; lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileStringW';
+function GetPrivateProfileSection(lpAppName:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD; lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetPrivateProfileSectionW';
+function WritePrivateProfileSection(lpAppName:LPCWSTR; lpString:LPCWSTR; lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileSectionW';
+function GetDriveType(lpRootPathName:LPCWSTR):UINT; external 'kernel32' name 'GetDriveTypeW';
+function GetSystemDirectory(lpBuffer:LPWSTR; uSize:UINT):UINT; external 'kernel32' name 'GetSystemDirectoryW';
+function GetTempPath(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetTempPathW';
+function GetTempFileName(lpPathName:LPCWSTR; lpPrefixString:LPCWSTR; uUnique:UINT; lpTempFileName:LPWSTR):UINT; external 'kernel32' name 'GetTempFileNameW';
+function GetWindowsDirectory(lpBuffer:LPWSTR; uSize:UINT):UINT; external 'kernel32' name 'GetWindowsDirectoryW';
+function SetCurrentDirectory(lpPathName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetCurrentDirectoryW';
+function GetCurrentDirectory(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetCurrentDirectoryW';
+function GetDiskFreeSpace(lpRootPathName:LPCWSTR; lpSectorsPerCluster:LPDWORD; lpBytesPerSector:LPDWORD; lpNumberOfFreeClusters:LPDWORD; lpTotalNumberOfClusters:LPDWORD):WINBOOL; external 'kernel32' name 'GetDiskFreeSpaceW';
+function CreateDirectory(lpPathName:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryW';
+function CreateDirectoryEx(lpTemplateDirectory:LPCWSTR; lpNewDirectory:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryExW';
+function RemoveDirectory(lpPathName:LPCWSTR):WINBOOL; external 'kernel32' name 'RemoveDirectoryW';
+function GetFullPathName(lpFileName:LPCWSTR; nBufferLength:DWORD; lpBuffer:LPWSTR; var lpFilePart:LPWSTR):DWORD; external 'kernel32' name 'GetFullPathNameW';
+function DefineDosDevice(dwFlags:DWORD; lpDeviceName:LPCWSTR; lpTargetPath:LPCWSTR):WINBOOL; external 'kernel32' name 'DefineDosDeviceW';
+function QueryDosDevice(lpDeviceName:LPCWSTR; lpTargetPath:LPWSTR; ucchMax:DWORD):DWORD; external 'kernel32' name 'QueryDosDeviceW';
+function CreateFile(lpFileName:LPCWSTR; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; dwCreationDisposition:DWORD;dwFlagsAndAttributes:DWORD; hTemplateFile:HANDLE):HANDLE; external 'kernel32' name 'CreateFileW';
+function SetFileAttributes(lpFileName:LPCWSTR; dwFileAttributes:DWORD):WINBOOL; external 'kernel32' name 'SetFileAttributesW';
+function GetFileAttributes(lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetFileAttributesW';
+function GetCompressedFileSize(lpFileName:LPCWSTR; lpFileSizeHigh:LPDWORD):DWORD; external 'kernel32' name 'GetCompressedFileSizeW';
+function DeleteFile(lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'DeleteFileW';
+function SearchPath(lpPath:LPCWSTR; lpFileName:LPCWSTR; lpExtension:LPCWSTR; nBufferLength:DWORD; lpBuffer:LPWSTR;lpFilePart:LPWSTR):DWORD; external 'kernel32' name 'SearchPathW';
+function CopyFile(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR; bFailIfExists:WINBOOL):WINBOOL; external 'kernel32' name 'CopyFileW';
+function MoveFile(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'MoveFileW';
+function MoveFileEx(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'MoveFileExW';
+function CreateNamedPipe(lpName:LPCWSTR; dwOpenMode:DWORD; dwPipeMode:DWORD; nMaxInstances:DWORD; nOutBufferSize:DWORD;nInBufferSize:DWORD; nDefaultTimeOut:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE;
+ external 'kernel32' name 'CreateNamedPipeW';
+function GetNamedPipeHandleState(hNamedPipe:HANDLE; lpState:LPDWORD; lpCurInstances:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD;lpUserName:LPWSTR; nMaxUserNameSize:DWORD):WINBOOL;
+ external 'kernel32' name 'GetNamedPipeHandleStateW';
+function CallNamedPipe(lpNamedPipeName:LPCWSTR; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'CallNamedPipeW';
+function WaitNamedPipe(lpNamedPipeName:LPCWSTR; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'WaitNamedPipeW';
+function SetVolumeLabel(lpRootPathName:LPCWSTR; lpVolumeName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetVolumeLabelW';
+function GetVolumeInformation(lpRootPathName:LPCWSTR; lpVolumeNameBuffer:LPWSTR; nVolumeNameSize:DWORD; lpVolumeSerialNumber:LPDWORD; lpMaximumComponentLength:LPDWORD;lpFileSystemFlags:LPDWORD; lpFileSystemNameBuffer:LPWSTR;
+ nFileSystemNameSize:DWORD):WINBOOL; external 'kernel32' name 'GetVolumeInformationW';
+function ClearEventLog(hEventLog:HANDLE; lpBackupFileName:LPCWSTR):WINBOOL; external 'advapi32' name 'ClearEventLogW';
+function BackupEventLog(hEventLog:HANDLE; lpBackupFileName:LPCWSTR):WINBOOL; external 'advapi32' name 'BackupEventLogW';
+function OpenEventLog(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenEventLogW';
+function RegisterEventSource(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceW';
+function OpenBackupEventLog(lpUNCServerName:LPCWSTR; lpFileName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogW';
+function ReadEventLog(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogW';
+function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
+function AccessCheckAndAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; ObjectCreation:WINBOOL;
+ GrantedAccess:LPDWORD; AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
+function ObjectOpenAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;
+ Privileges:PPRIVILEGE_SET; ObjectCreation:WINBOOL;AccessGranted:WINBOOL; GenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'ObjectOpenAuditAlarmW';
+function ObjectPrivilegeAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ClientToken:HANDLE; DesiredAccess:DWORD; Privileges:PPRIVILEGE_SET;AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmW';
+function ObjectCloseAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; GenerateOnClose:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectCloseAuditAlarmW';
+function PrivilegedServiceAuditAlarm(SubsystemName:LPCWSTR; ServiceName:LPCWSTR; ClientToken:HANDLE; Privileges:PPRIVILEGE_SET; AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmW';
+function SetFileSecurity(lpFileName:LPCWSTR; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetFileSecurityW';
+function GetFileSecurity(lpFileName:LPCWSTR; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetFileSecurityW';
+function FindFirstChangeNotification(lpPathName:LPCWSTR; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD):HANDLE; external 'kernel32' name 'FindFirstChangeNotificationW';
+function IsBadStringPtr(lpsz:LPCWSTR; ucchMax:UINT):WINBOOL; external 'kernel32' name 'IsBadStringPtrW';
+function LookupAccountSid(lpSystemName:LPCWSTR; Sid:PSID; Name:LPWSTR; cbName:LPDWORD; ReferencedDomainName:LPWSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountSidW';
+function LookupAccountName(lpSystemName:LPCWSTR; lpAccountName:LPCWSTR; Sid:PSID; cbSid:LPDWORD; ReferencedDomainName:LPWSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountNameW';
+function LookupPrivilegeValue(lpSystemName:LPCWSTR; lpName:LPCWSTR; lpLuid:PLUID):WINBOOL; external 'advapi32' name 'LookupPrivilegeValueW';
+function LookupPrivilegeName(lpSystemName:LPCWSTR; lpLuid:PLUID; lpName:LPWSTR; cbName:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeNameW';
+function LookupPrivilegeDisplayName(lpSystemName:LPCWSTR; lpName:LPCWSTR; lpDisplayName:LPWSTR; cbDisplayName:LPDWORD; lpLanguageId:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameW';
+function BuildCommDCB(lpDef:LPCWSTR; lpDCB:LPDCB):WINBOOL; external 'kernel32' name 'BuildCommDCBW';
+function BuildCommDCBAndTimeouts(lpDef:LPCWSTR; lpDCB:LPDCB; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsW';
+function CommConfigDialog(lpszName:LPCWSTR; hWnd:HWND; lpCC:LPCOMMCONFIG):WINBOOL; external 'kernel32' name 'CommConfigDialogW';
+function GetDefaultCommConfig(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetDefaultCommConfigW';
+function SetDefaultCommConfig(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetDefaultCommConfigW';
+function GetComputerName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameW';
+function SetComputerName(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
+function GetUserName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
+function wvsprintf(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):longint; external 'user32' name 'wvsprintfW';
+function wsprintf(_para1:LPWSTR; _para2:LPCWSTR; const args:array of const):longint;cdecl; external 'user32' name 'wsprintfW';
+function wsprintf(_para1:LPWSTR; _para2:LPCWSTR):longint;CDECL; external 'user32' name 'wsprintfW';
+function LoadKeyboardLayout(pwszKLID:LPCWSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutW';
+function GetKeyboardLayoutName(pwszKLID:LPWSTR):WINBOOL; external 'user32' name 'GetKeyboardLayoutNameW';
+function CreateDesktop(lpszDesktop:LPWSTR; lpszDevice:LPWSTR; pDevmode:LPDEVMODE; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopW';
+function OpenDesktop(lpszDesktop:LPWSTR; dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenDesktopW';
+function EnumDesktops(hwinsta:HWINSTA; lpEnumFunc:DESKTOPENUMPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopsW';
+function CreateWindowStation(lpwinsta:LPWSTR; dwReserved:DWORD; dwDesiredAccess:DWORD; lpsa:LPSECURITY_ATTRIBUTES):HWINSTA; external 'user32' name 'CreateWindowStationW';
+function OpenWindowStation(lpszWinSta:LPWSTR; fInherit:WINBOOL; dwDesiredAccess:DWORD):HWINSTA; external 'user32' name 'OpenWindowStationW';
+function EnumWindowStations(lpEnumFunc:ENUMWINDOWSTATIONPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindowStationsW';
+function GetUserObjectInformation(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectInformationW';
+function SetUserObjectInformation(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD):WINBOOL; external 'user32' name 'SetUserObjectInformationW';
+function RegisterWindowMessage(lpString:LPCWSTR):UINT; external 'user32' name 'RegisterWindowMessageW';
+function GetMessage(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT):WINBOOL; external 'user32' name 'GetMessageW';
+function DispatchMessage(lpMsg:LPMSG):LONG; external 'user32' name 'DispatchMessageW';
+function PeekMessage(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT; wRemoveMsg:UINT):WINBOOL; external 'user32' name 'PeekMessageW';
+function SendMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'SendMessageW';
+function SendMessageTimeout(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; fuFlags:UINT;uTimeout:UINT; lpdwResult:LPDWORD):LRESULT; external 'user32' name 'SendMessageTimeoutW';
+function SendNotifyMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'SendNotifyMessageW';
+function SendMessageCallback(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; lpResultCallBack:SENDASYNCPROC;dwData:DWORD):WINBOOL; external 'user32' name 'SendMessageCallbackW';
+function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostMessageW';
+function PostThreadMessage(idThread:DWORD; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostThreadMessageW';
+function DefWindowProc(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefWindowProcW';
+function CallWindowProc(lpPrevWndFunc:WNDPROC; hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'CallWindowProcW';
+function RegisterClass(lpWndClass:LPWNDCLASS):ATOM; external 'user32' name 'RegisterClassW';
+function UnregisterClass(lpClassName:LPCWSTR; hInstance:HINST):WINBOOL; external 'user32' name 'UnregisterClassW';
+function GetClassInfo(hInstance:HINST; lpClassName:LPCWSTR; lpWndClass:LPWNDCLASS):WINBOOL; external 'user32' name 'GetClassInfoW';
+function RegisterClassEx(_para1:LPWNDCLASSEXW):ATOM; external 'user32' name 'RegisterClassExW';
+function GetClassInfoEx(_para1:HINST; _para2:LPCWSTR; _para3:LPWNDCLASSEX):WINBOOL; external 'user32' name 'GetClassInfoExW';
+function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+ external 'user32' name 'CreateWindowExW';
+function CreateDialogParam(hInstance:HINST; lpTemplateName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogParamW';
+function CreateDialogIndirectParam(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogIndirectParamW';
+function DialogBoxParam(hInstance:HINST; lpTemplateName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxParamW';
+function DialogBoxIndirectParam(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxIndirectParamW';
+function SetDlgItemText(hDlg:HWND; nIDDlgItem:longint; lpString:LPCWSTR):WINBOOL; external 'user32' name 'SetDlgItemTextW';
+function GetDlgItemText(hDlg:HWND; nIDDlgItem:longint; lpString:LPWSTR; nMaxCount:longint):UINT; external 'user32' name 'GetDlgItemTextW';
+function SendDlgItemMessage(hDlg:HWND; nIDDlgItem:longint; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LONG; external 'user32' name 'SendDlgItemMessageW';
+function DefDlgProc(hDlg:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefDlgProcW';
+function CallMsgFilter(lpMsg:LPMSG; nCode:longint):WINBOOL; external 'user32' name 'CallMsgFilterW';
+function RegisterClipboardFormat(lpszFormat:LPCWSTR):UINT; external 'user32' name 'RegisterClipboardFormatW';
+function GetClipboardFormatName(format:UINT; lpszFormatName:LPWSTR; cchMaxCount:longint):longint; external 'user32' name 'GetClipboardFormatNameW';
+function CharToOem(lpszSrc:LPCWSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'CharToOemW';
+function OemToChar(lpszSrc:LPCSTR; lpszDst:LPWSTR):WINBOOL; external 'user32' name 'OemToCharW';
+function CharToOemBuff(lpszSrc:LPCWSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffW';
+function OemToCharBuff(lpszSrc:LPCSTR; lpszDst:LPWSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffW';
+function CharUpper(lpsz:LPWSTR):LPWSTR; external 'user32' name 'CharUpperW';
+function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharUpperBuffW';
+function CharLower(lpsz:LPWSTR):LPWSTR; external 'user32' name 'CharLowerW';
+function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharLowerBuffW';
+function CharNext(lpsz:LPCWSTR):LPWSTR; external 'user32' name 'CharNextW';
+function CharPrev(lpszStart:LPCWSTR; lpszCurrent:LPCWSTR):LPWSTR; external 'user32' name 'CharPrevW';
+function IsCharAlpha(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharAlphaW';
+function IsCharAlphaNumeric(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharAlphaNumericW';
+function IsCharUpper(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharUpperW';
+function IsCharLower(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharLowerW';
+function GetKeyNameText(lParam:LONG; lpString:LPWSTR; nSize:longint):longint; external 'user32' name 'GetKeyNameTextW';
+function VkKeyScan(ch:WCHAR):SHORT; external 'user32' name 'VkKeyScanW';
+function VkKeyScanEx(ch:WCHAR; dwhkl:HKL):SHORT; external 'user32' name 'VkKeyScanExW';
+function MapVirtualKey(uCode:UINT; uMapType:UINT):UINT; external 'user32' name 'MapVirtualKeyW';
+function MapVirtualKeyEx(uCode:UINT; uMapType:UINT; dwhkl:HKL):UINT; external 'user32' name 'MapVirtualKeyExW';
+function LoadAccelerators(hInstance:HINST; lpTableName:LPCWSTR):HACCEL; external 'user32' name 'LoadAcceleratorsW';
+function CreateAcceleratorTable(_para1:LPACCEL; _para2:longint):HACCEL; external 'user32' name 'CreateAcceleratorTableW';
+function CopyAcceleratorTable(hAccelSrc:HACCEL; lpAccelDst:LPACCEL; cAccelEntries:longint):longint; external 'user32' name 'CopyAcceleratorTableW';
+function TranslateAccelerator(hWnd:HWND; hAccTable:HACCEL; lpMsg:LPMSG):longint; external 'user32' name 'TranslateAcceleratorW';
+function LoadMenu(hInstance:HINST; lpMenuName:LPCWSTR):HMENU; external 'user32' name 'LoadMenuW';
+function LoadMenuIndirect(lpMenuTemplate:LPMENUTEMPLATE):HMENU; external 'user32' name 'LoadMenuIndirectW';
+function ChangeMenu(hMenu:HMENU; cmd:UINT; lpszNewItem:LPCWSTR; cmdInsert:UINT; flags:UINT):WINBOOL; external 'user32' name 'ChangeMenuW';
+function GetMenuString(hMenu:HMENU; uIDItem:UINT; lpString:LPWSTR; nMaxCount:longint; uFlag:UINT):longint; external 'user32' name 'GetMenuStringW';
+function InsertMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'InsertMenuW';
+function AppendMenu(hMenu:HMENU; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'AppendMenuW';
+function ModifyMenu(hMnu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'ModifyMenuW';
+function InsertMenuItem(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'InsertMenuItemW';
+function GetMenuItemInfo(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPMENUITEMINFO):WINBOOL; external 'user32' name 'GetMenuItemInfoW';
+function SetMenuItemInfo(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'SetMenuItemInfoW';
+function DrawText(hDC:HDC; lpString:LPCWSTR; nCount:longint; lpRect:LPRECT; uFormat:UINT):longint; external 'user32' name 'DrawTextW';
+function DrawTextEx(_para1:HDC; _para2:LPWSTR; _para3:longint; _para4:LPRECT; _para5:UINT;_para6:LPDRAWTEXTPARAMS):longint; external 'user32' name 'DrawTextExW';
+function GrayString(hDC:HDC; hBrush:HBRUSH; lpOutputFunc:GRAYSTRINGPROC; lpData:LPARAM; nCount:longint;X:longint; Y:longint; nWidth:longint; nHeight:longint):WINBOOL; external 'user32' name 'GrayStringW';
+function DrawState(_para1:HDC; _para2:HBRUSH; _para3:DRAWSTATEPROC; _para4:LPARAM; _para5:WPARAM;_para6:longint; _para7:longint; _para8:longint; _para9:longint; _para10:UINT):WINBOOL; external 'user32' name 'DrawStateW';
+function TabbedTextOut(hDC:HDC; X:longint; Y:longint; lpString:LPCWSTR; nCount:longint;nTabPositions:longint; lpnTabStopPositions:LPINT; nTabOrigin:longint):LONG; external 'user32' name 'TabbedTextOutW';
+function GetTabbedTextExtent(hDC:HDC; lpString:LPCWSTR; nCount:longint; nTabPositions:longint; lpnTabStopPositions:LPINT):DWORD; external 'user32' name 'GetTabbedTextExtentW';
+function SetProp(hWnd:HWND; lpString:LPCWSTR; hData:HANDLE):WINBOOL; external 'user32' name 'SetPropW';
+function GetProp(hWnd:HWND; lpString:LPCWSTR):HANDLE; external 'user32' name 'GetPropW';
+function RemoveProp(hWnd:HWND; lpString:LPCWSTR):HANDLE; external 'user32' name 'RemovePropW';
+function EnumPropsEx(hWnd:HWND; lpEnumFunc:PROPENUMPROCEX; lParam:LPARAM):longint; external 'user32' name 'EnumPropsExW';
+function EnumProps(hWnd:HWND; lpEnumFunc:PROPENUMPROC):longint; external 'user32' name 'EnumPropsW';
+function SetWindowText(hWnd:HWND; lpString:LPCWSTR):WINBOOL; external 'user32' name 'SetWindowTextW';
+function GetWindowText(hWnd:HWND; lpString:LPWSTR; nMaxCount:longint):longint; external 'user32' name 'GetWindowTextW';
+function GetWindowTextLength(hWnd:HWND):longint; external 'user32' name 'GetWindowTextLengthW';
+function MessageBox(hWnd:HWND; lpText:LPCWSTR; lpCaption:LPCWSTR; uType:UINT):longint; external 'user32' name 'MessageBoxW';
+function MessageBoxEx(hWnd:HWND; lpText:LPCWSTR; lpCaption:LPCWSTR; uType:UINT; wLanguageId:WORD):longint; external 'user32' name 'MessageBoxExW';
+function MessageBoxIndirect(_para1:LPMSGBOXPARAMS):longint; external 'user32' name 'MessageBoxIndirectW';
+function GetWindowLong(hWnd:HWND; nIndex:longint):LONG; external 'user32' name 'GetWindowLongW';
+function SetWindowLong(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG; external 'user32' name 'SetWindowLongW';
+function GetClassLong(hWnd:HWND; nIndex:longint):DWORD; external 'user32' name 'GetClassLongW';
+function SetClassLong(hWnd:HWND; nIndex:longint; dwNewLong:LONG):DWORD; external 'user32' name 'SetClassLongW';
+function FindWindow(lpClassName:LPCWSTR; lpWindowName:LPCWSTR):HWND; external 'user32' name 'FindWindowW';
+function FindWindowEx(_para1:HWND; _para2:HWND; _para3:LPCWSTR; _para4:LPCWSTR):HWND; external 'user32' name 'FindWindowExW';
+function GetClassName(hWnd:HWND; lpClassName:LPWSTR; nMaxCount:longint):longint; external 'user32' name 'GetClassNameW';
+function SetWindowsHookEx(idHook:longint; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; external 'user32' name 'SetWindowsHookExW';
+function LoadBitmap(hInstance:HINST; lpBitmapName:LPCWSTR):HBITMAP; external 'user32' name 'LoadBitmapW';
+function LoadCursor(hInstance:HINST; lpCursorName:LPCWSTR):HCURSOR; external 'user32' name 'LoadCursorW';
+function LoadCursorFromFile(lpFileName:LPCWSTR):HCURSOR; external 'user32' name 'LoadCursorFromFileW';
+function LoadIcon(hInstance:HINST; lpIconName:LPCWSTR):HICON; external 'user32' name 'LoadIconW';
+function LoadImage(_para1:HINST; _para2:LPCWSTR; _para3:UINT; _para4:longint; _para5:longint;_para6:UINT):HANDLE; external 'user32' name 'LoadImageW';
+function LoadString(hInstance:HINST; uID:UINT; lpBuffer:LPWSTR; nBufferMax:longint):longint; external 'user32' name 'LoadStringW';
+function IsDialogMessage(hDlg:HWND; lpMsg:LPMSG):WINBOOL; external 'user32' name 'IsDialogMessageW';
+function DlgDirList(hDlg:HWND; lpPathSpec:LPWSTR; nIDListBox:longint; nIDStaticPath:longint; uFileType:UINT):longint; external 'user32' name 'DlgDirListW';
+function DlgDirSelectEx(hDlg:HWND; lpString:LPWSTR; nCount:longint; nIDListBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectExW';
+function DlgDirListComboBox(hDlg:HWND; lpPathSpec:LPWSTR; nIDComboBox:longint; nIDStaticPath:longint; uFiletype:UINT):longint; external 'user32' name 'DlgDirListComboBoxW';
+function DlgDirSelectComboBoxEx(hDlg:HWND; lpString:LPWSTR; nCount:longint; nIDComboBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectComboBoxExW';
+function DefFrameProc(hWnd:HWND; hWndMDIClient:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefFrameProcW';
+function DefMDIChildProc(hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefMDIChildProcW';
+function CreateMDIWindow(lpClassName:LPWSTR; lpWindowName:LPWSTR; dwStyle:DWORD; X:longint; Y:longint;nWidth:longint; nHeight:longint; hWndParent:HWND; hInstance:HINST; lParam:LPARAM):HWND; external 'user32' name 'CreateMDIWindowW';
+function WinHelp(hWndMain:HWND; lpszHelp:LPCWSTR; uCommand:UINT; dwData:DWORD):WINBOOL; external 'user32' name 'WinHelpW';
+function ChangeDisplaySettings(lpDevMode:LPDEVMODE; dwFlags:DWORD):LONG; external 'user32' name 'ChangeDisplaySettingsW';
+function EnumDisplaySettings(lpszDeviceName:LPCWSTR; iModeNum:DWORD; lpDevMode:LPDEVMODEW):WINBOOL; external 'user32' name 'EnumDisplaySettingsW';
+function SystemParametersInfo(uiAction:UINT; uiParam:UINT; pvParam:PVOID; fWinIni:UINT):WINBOOL; external 'user32' name 'SystemParametersInfoW';
+function AddFontResource(_para1:LPCWSTR):longint; external 'gdi32' name 'AddFontResourceW';
+function CopyMetaFile(_para1:HMETAFILE; _para2:LPCWSTR):HMETAFILE; external 'gdi32' name 'CopyMetaFileW';
+function CreateFontIndirect(_para1:PLOGFONT):HFONT; external 'gdi32' name 'CreateFontIndirectW';
+function CreateFont(_para1:longint; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:DWORD; _para7:DWORD; _para8:DWORD; _para9:DWORD; _para10:DWORD;_para11:DWORD; _para12:DWORD; _para13:DWORD; _para14:LPCWSTR):HFONT;
+ external 'gdi32' name 'CreateFontW';
+function CreateIC(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPDEVMODE):HDC; external 'gdi32' name 'CreateICW';
+function CreateMetaFile(_para1:LPCWSTR):HDC; external 'gdi32' name 'CreateMetaFileW';
+function CreateScalableFontResource(_para1:DWORD; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPCWSTR):WINBOOL; external 'gdi32' name 'CreateScalableFontResourceW';
+function EnumFontFamiliesEx(_para1:HDC; _para2:LPLOGFONT; _para3:FONTENUMEXPROC; _para4:LPARAM; _para5:DWORD):longint; external 'gdi32' name 'EnumFontFamiliesExW';
+function EnumFontFamilies(_para1:HDC; _para2:LPCWSTR; _para3:FONTENUMPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontFamiliesW';
+function EnumFonts(_para1:HDC; _para2:LPCWSTR; _para3:ENUMFONTSPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontsW';
+function GetCharWidth(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidthW';
+function GetCharWidth32(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidth32W';
+function GetCharWidthFloat(_para1:HDC; _para2:UINT; _para3:UINT; _para4:PSingle):WINBOOL; external 'gdi32' name 'GetCharWidthFloatW';
+function GetCharABCWidths(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABC):WINBOOL; external 'gdi32' name 'GetCharABCWidthsW';
+function GetCharABCWidthsFloat(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABCFLOAT):WINBOOL; external 'gdi32' name 'GetCharABCWidthsFloatW';
+function GetGlyphOutline(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPGLYPHMETRICS; _para5:DWORD;_para6:LPVOID; _para7:PMAT2):DWORD; external 'gdi32' name 'GetGlyphOutlineW';
+function GetMetaFile(_para1:LPCWSTR):HMETAFILE; external 'gdi32' name 'GetMetaFileW';
+function GetOutlineTextMetrics(_para1:HDC; _para2:UINT; _para3:LPOUTLINETEXTMETRIC):UINT; external 'gdi32' name 'GetOutlineTextMetricsW';
+function GetTextExtentPoint(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPointW';
+function GetTextExtentPoint32(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPoint32W';
+function GetTextExtentExPoint(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:longint; _para5:LPINT;_para6:LPINT; _para7:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentExPointW';
+function GetCharacterPlacement(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:longint; _para5:LPGCP_RESULTS;_para6:DWORD):DWORD; external 'gdi32' name 'GetCharacterPlacementW';
+function ResetDC(_para1:HDC; _para2:LPDEVMODE):HDC; external 'gdi32' name 'ResetDCW';
+function RemoveFontResource(_para1:LPCWSTR):WINBOOL; external 'gdi32' name 'RemoveFontResourceW';
+function CopyEnhMetaFile(_para1:HENHMETAFILE; _para2:LPCWSTR):HENHMETAFILE; external 'gdi32' name 'CopyEnhMetaFileW';
+function CreateEnhMetaFile(_para1:HDC; _para2:LPCWSTR; _para3:LPRECT; _para4:LPCWSTR):HDC; external 'gdi32' name 'CreateEnhMetaFileW';
+function GetEnhMetaFile(_para1:LPCWSTR):HENHMETAFILE; external 'gdi32' name 'GetEnhMetaFileW';
+function GetEnhMetaFileDescription(_para1:HENHMETAFILE; _para2:UINT; _para3:LPWSTR):UINT; external 'gdi32' name 'GetEnhMetaFileDescriptionW';
+function GetTextMetrics(_para1:HDC; _para2:LPTEXTMETRIC):WINBOOL; external 'gdi32' name 'GetTextMetricsW';
+function StartDoc(_para1:HDC; _para2:PDOCINFO):longint; external 'gdi32' name 'StartDocW';
+function GetObject(_para1:HGDIOBJ; _para2:longint; _para3:LPVOID):longint; external 'gdi32' name 'GetObjectW';
+function TextOut(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCWSTR; _para5:longint):WINBOOL; external 'gdi32' name 'TextOutW';
+function ExtTextOut(_para1:HDC; _para2:longint; _para3:longint; _para4:UINT; _para5:LPRECT;_para6:LPCWSTR; _para7:UINT; _para8:LPINT):WINBOOL; external 'gdi32' name 'ExtTextOutW';
+function PolyTextOut(_para1:HDC; _para2:PPOLYTEXT; _para3:longint):WINBOOL; external 'gdi32' name 'PolyTextOutW';
+function GetTextFace(_para1:HDC; _para2:longint; _para3:LPWSTR):longint; external 'gdi32' name 'GetTextFaceW';
+function GetKerningPairs(_para1:HDC; _para2:DWORD; _para3:LPKERNINGPAIR):DWORD; external 'gdi32' name 'GetKerningPairsW';
+function GetLogColorSpace(_para1:HCOLORSPACE; _para2:LPLOGCOLORSPACE; _para3:DWORD):WINBOOL; external 'gdi32' name 'GetLogColorSpaceW';
+function CreateColorSpace(_para1:LPLOGCOLORSPACE):HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceW';
+function GetICMProfile(_para1:HDC; _para2:DWORD; _para3:LPWSTR):WINBOOL; external 'gdi32' name 'GetICMProfileW';
+function SetICMProfile(_para1:HDC; _para2:LPWSTR):WINBOOL; external 'gdi32' name 'SetICMProfileW';
+function UpdateICMRegKey(_para1:DWORD; _para2:DWORD; _para3:LPWSTR; _para4:UINT):WINBOOL; external 'gdi32' name 'UpdateICMRegKeyW';
+function EnumICMProfiles(_para1:HDC; _para2:ICMENUMPROC; _para3:LPARAM):longint; external 'gdi32' name 'EnumICMProfilesW';
+function CreatePropertySheetPage(lppsp:LPCPROPSHEETPAGE):HPROPSHEETPAGE; external 'comctl32' name 'CreatePropertySheetPageW';
+function PropertySheet(lppsph:LPCPROPSHEETHEADER):longint; external 'comctl32' name 'PropertySheetW';
+function ImageList_LoadImage(hi:HINST; lpbmp:LPCWSTR; cx:longint; cGrow:longint; crMask:COLORREF;uType:UINT; uFlags:UINT):HIMAGELIST; external 'comctl32' name 'ImageList_LoadImageW';
+function CreateStatusWindow(style:LONG; lpszText:LPCWSTR; hwndParent:HWND; wID:UINT):HWND; external 'comctl32' name 'CreateStatusWindowW';
+procedure DrawStatusText(hDC:HDC; lprc:LPRECT; pszText:LPCWSTR; uFlags:UINT); external 'comctl32' name 'DrawStatusTextW';
+function GetOpenFileName(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetOpenFileNameW';
+function GetSaveFileName(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetSaveFileNameW';
+function GetFileTitle(_para1:LPCWSTR; _para2:LPWSTR; _para3:WORD):integer; external 'comdlg32' name 'GetFileTitleW';
+function ChooseColor(_para1:LPCHOOSECOLOR):WINBOOL; external 'comdlg32' name 'ChooseColorW';
+function ReplaceText(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'ReplaceTextW';
+function ChooseFont(_para1:LPCHOOSEFONT):WINBOOL; external 'comdlg32' name 'ChooseFontW';
+function FindText(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'FindTextW';
+function PrintDlg(_para1:LPPRINTDLG):WINBOOL; external 'comdlg32' name 'PrintDlgW';
+function PageSetupDlg(_para1:LPPAGESETUPDLG):WINBOOL; external 'comdlg32' name 'PageSetupDlgW';
+function CreateProcess(lpApplicationName:LPCWSTR; lpCommandLine:LPWSTR; lpProcessAttributes:LPSECURITY_ATTRIBUTES; lpThreadAttributes:LPSECURITY_ATTRIBUTES; bInheritHandles:WINBOOL;dwCreationFlags:DWORD; lpEnvironment:LPVOID;
+ lpCurrentDirectory:LPCWSTR; lpStartupInfo:LPSTARTUPINFO; lpProcessInformation:LPPROCESS_INFORMATION):WINBOOL; external 'kernel32' name 'CreateProcessW';
+procedure GetStartupInfo(lpStartupInfo:LPSTARTUPINFO); external 'kernel32' name 'GetStartupInfoW';
+function FindFirstFile(lpFileName:LPCWSTR; lpFindFileData:LPWIN32_FIND_DATA):HANDLE; external 'kernel32' name 'FindFirstFileW';
+function FindNextFile(hFindFile:HANDLE; lpFindFileData:LPWIN32_FIND_DATA):WINBOOL; external 'kernel32' name 'FindNextFileW';
+function GetVersionEx(VersionInformation:LPOSVERSIONINFOW):WINBOOL; external 'kernel32' name 'GetVersionExW';
+function GetVersionExW(VersionInformation:LPOSVERSIONINFOW):WINBOOL; external 'kernel32' name 'GetVersionExW';
+function CreateWindow(lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+function CreateDialog(hInstance:HINST; lpName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function CreateDialogIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function DialogBox(hInstance:HINST; lpTemplate:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function DialogBoxIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function CreateDC(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR; _para4:pDEVMODE):HDC; external 'gdi32' name 'CreateDCW';
+function VerInstallFile(uFlags:DWORD; szSrcFileName:LPWSTR; szDestFileName:LPWSTR; szSrcDir:LPWSTR; szDestDir:LPWSTR;szCurDir:LPWSTR; szTmpFile:LPWSTR; lpuTmpFileLen:PUINT):DWORD; external 'version' name 'VerInstallFileW';
+function GetFileVersionInfoSize(lptstrFilename:LPWSTR; lpdwHandle:LPDWORD):DWORD; external 'version' name 'GetFileVersionInfoSizeW';
+function GetFileVersionInfo(lptstrFilename:LPWSTR; dwHandle:DWORD; dwLen:DWORD; lpData:LPVOID):WINBOOL; external 'version' name 'GetFileVersionInfoW';
+function VerLanguageName(wLang:DWORD; szLang:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'VerLanguageNameW';
+function VerQueryValue(pBlock:LPVOID; lpSubBlock:LPWSTR; lplpBuffer:LPVOID; puLen:PUINT):WINBOOL; external 'version' name 'VerQueryValueW';
+function VerFindFile(uFlags:DWORD; szFileName:LPWSTR; szWinDir:LPWSTR; szAppDir:LPWSTR; szCurDir:LPWSTR;lpuCurDirLen:PUINT; szDestDir:LPWSTR; lpuDestDirLen:PUINT):DWORD; external 'version' name 'VerFindFileW';
+function RegSetValueEx(hKey:HKEY; lpValueName:LPCWSTR; Reserved:DWORD; dwType:DWORD; lpData:LPBYTE;cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueExW';
+function RegUnLoadKey(hKey:HKEY; lpSubKey:LPCWSTR):LONG; external 'advapi32' name 'RegUnLoadKeyW';
+function InitiateSystemShutdown(lpMachineName:LPWSTR; lpMessage:LPWSTR; dwTimeout:DWORD; bForceAppsClosed:WINBOOL; bRebootAfterShutdown:WINBOOL):WINBOOL; external 'advapi32' name 'InitiateSystemShutdownW';
+function AbortSystemShutdown(lpMachineName:LPWSTR):WINBOOL; external 'advapi32' name 'AbortSystemShutdownW';
+function RegRestoreKey(hKey:HKEY; lpFile:LPCWSTR; dwFlags:DWORD):LONG; external 'advapi32' name 'RegRestoreKeyW';
+function RegSaveKey(hKey:HKEY; lpFile:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):LONG; external 'advapi32' name 'RegSaveKeyW';
+function RegSetValue(hKey:HKEY; lpSubKey:LPCWSTR; dwType:DWORD; lpData:LPCWSTR; cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueW';
+function RegQueryValue(hKey:HKEY; lpSubKey:LPCWSTR; lpValue:LPWSTR; lpcbValue:PLONG):LONG; external 'advapi32' name 'RegQueryValueW';
+function RegQueryMultipleValues(hKey:HKEY; val_list:PVALENT; num_vals:DWORD; lpValueBuf:LPWSTR; ldwTotsize:LPDWORD):LONG; external 'advapi32' name 'RegQueryMultipleValuesW';
+function RegQueryValueEx(hKey:HKEY; lpValueName:LPCWSTR; lpReserved:LPDWORD; lpType:LPDWORD; lpData:LPBYTE;lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegQueryValueExW';
+function RegReplaceKey(hKey:HKEY; lpSubKey:LPCWSTR; lpNewFile:LPCWSTR; lpOldFile:LPCWSTR):LONG; external 'advapi32' name 'RegReplaceKeyW';
+function RegConnectRegistry(lpMachineName:LPWSTR; hKey:HKEY; phkResult:PHKEY):LONG; external 'advapi32' name 'RegConnectRegistryW';
+function RegCreateKey(hKey:HKEY; lpSubKey:LPCWSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegCreateKeyW';
+function RegCreateKeyEx(hKey:HKEY; lpSubKey:LPCWSTR; Reserved:DWORD; lpClass:LPWSTR; dwOptions:DWORD;samDesired:REGSAM; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; phkResult:PHKEY; lpdwDisposition:LPDWORD):LONG;
+ external 'advapi32' name 'RegCreateKeyExW';
+function RegDeleteKey(hKey:HKEY; lpSubKey:LPCWSTR):LONG; external 'advapi32' name 'RegDeleteKeyW';
+function RegDeleteValue(hKey:HKEY; lpValueName:LPCWSTR):LONG; external 'advapi32' name 'RegDeleteValueW';
+function RegEnumKey(hKey:HKEY; dwIndex:DWORD; lpName:LPWSTR; cbName:DWORD):LONG; external 'advapi32' name 'RegEnumKeyW';
+function RegEnumKeyEx(hKey:HKEY; dwIndex:DWORD; lpName:LPWSTR; lpcbName:LPDWORD; lpReserved:LPDWORD;lpClass:LPWSTR; lpcbClass:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegEnumKeyExW';
+function RegEnumValue(hKey:HKEY; dwIndex:DWORD; lpValueName:LPWSTR; lpcbValueName:LPDWORD; lpReserved:LPDWORD;lpType:LPDWORD; lpData:LPBYTE; lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegEnumValueW';
+function RegLoadKey(hKey:HKEY; lpSubKey:LPCWSTR; lpFile:LPCWSTR):LONG; external 'advapi32' name 'RegLoadKeyW';
+function RegOpenKey(hKey:HKEY; lpSubKey:LPCWSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyW';
+function RegOpenKeyEx(hKey:HKEY; lpSubKey:LPCWSTR; ulOptions:DWORD; samDesired:REGSAM; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyExW';
+function RegQueryInfoKey(hKey:HKEY; lpClass:LPWSTR; lpcbClass:LPDWORD; lpReserved:LPDWORD; lpcSubKeys:LPDWORD;lpcbMaxSubKeyLen:LPDWORD; lpcbMaxClassLen:LPDWORD; lpcValues:LPDWORD; lpcbMaxValueNameLen:LPDWORD;
+ lpcbMaxValueLen:LPDWORD;lpcbSecurityDescriptor:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegQueryInfoKeyW';
+function CompareString(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCWSTR; cchCount1:longint; lpString2:LPCWSTR;cchCount2:longint):longint; external 'kernel32' name 'CompareStringW';
+function LCMapString(Locale:LCID; dwMapFlags:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpDestStr:LPWSTR;cchDest:longint):longint; external 'kernel32' name 'LCMapStringW';
+function GetLocaleInfo(Locale:LCID; LCType:LCTYPE; lpLCData:LPWSTR; cchData:longint):longint; external 'kernel32' name 'GetLocaleInfoW';
+function SetLocaleInfo(Locale:LCID; LCType:LCTYPE; lpLCData:LPCWSTR):WINBOOL; external 'kernel32' name 'SetLocaleInfoW';
+function GetTimeFormat(Locale:LCID; dwFlags:DWORD; lpTime:LPSYSTEMTIME; lpFormat:LPCWSTR; lpTimeStr:LPWSTR;cchTime:longint):longint; external 'kernel32' name 'GetTimeFormatW';
+function GetDateFormat(Locale:LCID; dwFlags:DWORD; lpDate:LPSYSTEMTIME; lpFormat:LPCWSTR; lpDateStr:LPWSTR;cchDate:longint):longint; external 'kernel32' name 'GetDateFormatW';
+function GetNumberFormat(Locale:LCID; dwFlags:DWORD; lpValue:LPCWSTR; lpFormat:PNUMBERFMT; lpNumberStr:LPWSTR;cchNumber:longint):longint; external 'kernel32' name 'GetNumberFormatW';
+function GetCurrencyFormat(Locale:LCID; dwFlags:DWORD; lpValue:LPCWSTR; lpFormat:PCURRENCYFMT; lpCurrencyStr:LPWSTR;cchCurrency:longint):longint; external 'kernel32' name 'GetCurrencyFormatW';
+function EnumCalendarInfo(lpCalInfoEnumProc:CALINFO_ENUMPROC; Locale:LCID; Calendar:CALID; CalType:CALTYPE):WINBOOL; external 'kernel32' name 'EnumCalendarInfoW';
+function EnumTimeFormats(lpTimeFmtEnumProc:TIMEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumTimeFormatsW';
+function EnumDateFormats(lpDateFmtEnumProc:DATEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumDateFormatsW';
+function GetStringTypeEx(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeExW';
+function GetStringType(dwInfoType:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeW';
+function FoldString(dwMapFlags:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpDestStr:LPWSTR; cchDest:longint):longint; external 'kernel32' name 'FoldStringW';
+function EnumSystemLocales(lpLocaleEnumProc:LOCALE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemLocalesW';
+function EnumSystemCodePages(lpCodePageEnumProc:CODEPAGE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemCodePagesW';
+function PeekConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'PeekConsoleInputW';
+function ReadConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleInputW';
+function WriteConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleInputW';
+function ReadConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpReadRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'ReadConsoleOutputW';
+function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpWriteRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputW';
+function ReadConsoleOutputCharacter(hConsoleOutput:HANDLE; lpCharacter:LPWSTR; nLength:DWORD; dwReadCoord:COORD; lpNumberOfCharsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputCharacterW';
+function WriteConsoleOutputCharacter(hConsoleOutput:HANDLE; lpCharacter:LPCWSTR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW';
+function FillConsoleOutputCharacter(hConsoleOutput:HANDLE; cCharacter:WCHAR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputCharacterW';
+function ScrollConsoleScreenBuffer(hConsoleOutput:HANDLE; lpScrollRectangle:PSMALL_RECT; lpClipRectangle:PSMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):WINBOOL; external 'kernel32' name 'ScrollConsoleScreenBufferW';
+function GetConsoleTitle(lpConsoleTitle:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetConsoleTitleW';
+function SetConsoleTitle(lpConsoleTitle:LPCWSTR):WINBOOL; external 'kernel32' name 'SetConsoleTitleW';
+function ReadConsole(hConsoleInput:HANDLE; lpBuffer:LPVOID; nNumberOfCharsToRead:DWORD; lpNumberOfCharsRead:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'ReadConsoleW';
+function WriteConsole(hConsoleOutput:HANDLE;lpBuffer:pointer; nNumberOfCharsToWrite:DWORD; lpNumberOfCharsWritten:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'WriteConsoleW';
+function WNetAddConnection(lpRemoteName:LPCWSTR; lpPassword:LPCWSTR; lpLocalName:LPCWSTR):DWORD; external 'mpr' name 'WNetAddConnectionW';
+function WNetAddConnection2(lpNetResource:LPNETRESOURCE; lpPassword:LPCWSTR; lpUserName:LPCWSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection2W';
+function WNetAddConnection3(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpPassword:LPCWSTR; lpUserName:LPCWSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection3W';
+function WNetCancelConnection(lpName:LPCWSTR; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnectionW';
+function WNetCancelConnection2(lpName:LPCWSTR; dwFlags:DWORD; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnection2W';
+function WNetGetConnection(lpLocalName:LPCWSTR; lpRemoteName:LPWSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetConnectionW';
+function WNetUseConnection(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpUserID:LPCWSTR; lpPassword:LPCWSTR; dwFlags:DWORD;lpAccessName:LPWSTR; lpBufferSize:LPDWORD; lpResult:LPDWORD):DWORD; external 'mpr' name 'WNetUseConnectionW';
+function WNetSetConnection(lpName:LPCWSTR; dwProperties:DWORD; pvValues:LPVOID):DWORD; external 'mpr' name 'WNetSetConnectionW';
+function WNetConnectionDialog1(lpConnDlgStruct:LPCONNECTDLGSTRUCT):DWORD; external 'mpr' name 'WNetConnectionDialog1W';
+function WNetDisconnectDialog1(lpConnDlgStruct:LPDISCDLGSTRUCT):DWORD; external 'mpr' name 'WNetDisconnectDialog1W';
+function WNetOpenEnum(dwScope:DWORD; dwType:DWORD; dwUsage:DWORD; lpNetResource:LPNETRESOURCE; lphEnum:LPHANDLE):DWORD; external 'mpr' name 'WNetOpenEnumW';
+function WNetEnumResource(hEnum:HANDLE; lpcCount:LPDWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetEnumResourceW';
+function WNetGetUniversalName(lpLocalPath:LPCWSTR; dwInfoLevel:DWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetUniversalNameW';
+function WNetGetUser(lpName:LPCWSTR; lpUserName:LPWSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetUserW';
+function WNetGetProviderName(dwNetType:DWORD; lpProviderName:LPWSTR; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetProviderNameW';
+function WNetGetNetworkInformation(lpProvider:LPCWSTR; lpNetInfoStruct:LPNETINFOSTRUCT):DWORD; external 'mpr' name 'WNetGetNetworkInformationW';
+function WNetGetLastError(lpError:LPDWORD; lpErrorBuf:LPWSTR; nErrorBufSize:DWORD; lpNameBuf:LPWSTR; nNameBufSize:DWORD):DWORD; external 'mpr' name 'WNetGetLastErrorW';
+function MultinetGetConnectionPerformance(lpNetResource:LPNETRESOURCE; lpNetConnectInfoStruct:LPNETCONNECTINFOSTRUCT):DWORD; external 'mpr' name 'MultinetGetConnectionPerformanceW';
+function ChangeServiceConfig(hService:SC_HANDLE; dwServiceType:DWORD; dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCWSTR;lpLoadOrderGroup:LPCWSTR; lpdwTagId:LPDWORD; lpDependencies:LPCWSTR; lpServiceStartName:LPCWSTR;
+ lpPassword:LPCWSTR;lpDisplayName:LPCWSTR):WINBOOL; external 'advapi32' name 'ChangeServiceConfigW';
+function CreateService(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; lpDisplayName:LPCWSTR; dwDesiredAccess:DWORD; dwServiceType:DWORD;dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCWSTR; lpLoadOrderGroup:LPCWSTR;
+ lpdwTagId:LPDWORD;lpDependencies:LPCWSTR; lpServiceStartName:LPCWSTR; lpPassword:LPCWSTR):SC_HANDLE; external 'advapi32' name 'CreateServiceW';
+function EnumDependentServices(hService:SC_HANDLE; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD;lpServicesReturned:LPDWORD):WINBOOL; external 'advapi32' name 'EnumDependentServicesW';
+function EnumServicesStatus(hSCManager:SC_HANDLE; dwServiceType:DWORD; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD;pcbBytesNeeded:LPDWORD; lpServicesReturned:LPDWORD; lpResumeHandle:LPDWORD):WINBOOL;
+ external 'advapi32' name 'EnumServicesStatusW';
+function GetServiceKeyName(hSCManager:SC_HANDLE; lpDisplayName:LPCWSTR; lpServiceName:LPWSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceKeyNameW';
+function GetServiceDisplayName(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; lpDisplayName:LPWSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceDisplayNameW';
+function OpenSCManager(lpMachineName:LPCWSTR; lpDatabaseName:LPCWSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenSCManagerW';
+function OpenService(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenServiceW';
+function QueryServiceConfig(hService:SC_HANDLE; lpServiceConfig:LPQUERY_SERVICE_CONFIG; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceConfigW';
+function QueryServiceLockStatus(hSCManager:SC_HANDLE; lpLockStatus:LPQUERY_SERVICE_LOCK_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceLockStatusW';
+function RegisterServiceCtrlHandler(lpServiceName:LPCWSTR; lpHandlerProc:LPHANDLER_FUNCTION):SERVICE_STATUS_HANDLE; external 'advapi32' name 'RegisterServiceCtrlHandlerW';
+function StartServiceCtrlDispatcher(lpServiceStartTable:LPSERVICE_TABLE_ENTRY):WINBOOL; external 'advapi32' name 'StartServiceCtrlDispatcherW';
+function StartService(hService:SC_HANDLE; dwNumServiceArgs:DWORD; lpServiceArgVectors:LPCWSTR):WINBOOL; external 'advapi32' name 'StartServiceW';
+function DragQueryFile(_para1:HDROP; _para2:cardinal; _para3:LPCWSTR; _para4:cardinal):cardinal; external 'shell32' name 'DragQueryFileW';
+function ExtractAssociatedIcon(_para1:HINST; _para2:LPCWSTR; _para3:LPWORD):HICON; external 'shell32' name 'ExtractAssociatedIconW';
+function ExtractIcon(_para1:HINST; _para2:LPCWSTR; _para3:cardinal):HICON; external 'shell32' name 'ExtractIconW';
+function FindExecutable(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR):HINST; external 'shell32' name 'FindExecutableW';
+function ShellAbout(_para1:HWND; _para2:LPCWSTR; _para3:LPCWSTR; _para4:HICON):longint; external 'shell32' name 'ShellAboutW';
+function ShellExecute(_para1:HWND; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPCWSTR; _para5:LPCWSTR;_para6:longint):HINST; external 'shell32' name 'ShellExecuteW';
+function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconDataA): BOOL; external 'shell32' name 'Shell_NotifyIconW';
+function DdeCreateStringHandle(_para1:DWORD; _para2:LPCWSTR; _para3:longint):HSZ; external 'user32' name 'DdeCreateStringHandleW';
+function DdeInitialize(_para1:LPDWORD; _para2:PFNCALLBACK; _para3:DWORD; _para4:DWORD):UINT; external 'user32' name 'DdeInitializeW';
+function DdeQueryString(_para1:DWORD; _para2:HSZ; _para3:LPCWSTR; _para4:DWORD; _para5:longint):DWORD; external 'user32' name 'DdeQueryStringW';
+function LogonUser(_para1:LPWSTR; _para2:LPWSTR; _para3:LPWSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserW';
+function CreateProcessAsUser(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCWSTR;
+ _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+function CreateWindow(lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+begin
+ CreateWindow:=CreateWindowEx(0,lpClassName,lpWindowName,dwStyle,x,y,nWidth,nHeight,hWndParent,hMenu,hInstance,lpParam);
+end;
+
+function CreateDialog(hInstance:HINST; lpName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialog:=CreateDialogParam(hInstance,lpName,hWndParent,lpDialogFunc,0);
+end;
+
+function CreateDialogIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialogIndirect:=CreateDialogIndirectParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBox(hInstance:HINST; lpTemplate:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBox:=DialogBoxParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBoxIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBoxIndirect:=DialogBoxIndirectParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+{$endif read_implementation}
+
+{
+ $Log: unidef.inc,v $
+ Revision 1.13 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/wininc/unidef.sed b/rtl/win32/wininc/unidef.sed
new file mode 100644
index 0000000000..635fc6e4a7
--- /dev/null
+++ b/rtl/win32/wininc/unidef.sed
@@ -0,0 +1,21 @@
+# function names with parameters
+s/function \([^(]*\)W *(/function \1(/
+# procedure names with parameters
+s/procedure \([^(]*\)W *(/procedure \1(/
+# function names without parameters
+s/function \([^:(]*\)W *: */function \1 : /
+# procedure names without parameters
+s/procedure \([^;(]*\)W *;/procedure \1;/
+# function return value
+s/\([^ \t]*\)W *:=/\1:=/
+# function call with parameters
+s/\:=\(.*\)W(/:=\1(/
+# function call without parameters
+s/\:=\(.*\)W *;/:=\1;/
+# unit name
+s/unifun;/unidef;/
+# cvs name
+s/unifun.inc,v/unidef.inc,v/
+# unit conditionnal
+s/UNICODEFUNCTIONS/UNICODEFUNCTIONSDEFAULT/
+
diff --git a/rtl/win32/wininc/unifun.inc b/rtl/win32/wininc/unifun.inc
new file mode 100644
index 0000000000..887efa634a
--- /dev/null
+++ b/rtl/win32/wininc/unifun.inc
@@ -0,0 +1,501 @@
+{
+ $Id: unifun.inc,v 1.14 2005/04/03 15:17:50 marco Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team.
+
+ Contains the Unicode functions for windows unit
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ UnicodeFunctions.h
+
+ Declarations for all the Windows32 API Unicode Functions
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ Author: Scott Christley <scottc@net-community.com>
+ Date: 1996
+
+ This file is part of the Windows32 API Library.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Library General Public License for more details.
+
+ If you are interested in a warranty or support for this source code,
+ contact Scott Christley <scottc@net-community.com> for more information.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; see the file COPYING.LIB.
+ If not, write to the Free Software Foundation,
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$ifdef read_interface}
+
+function GetBinaryTypeW(lpApplicationName:LPCWSTR; lpBinaryType:LPDWORD):WINBOOL; external 'kernel32' name 'GetBinaryTypeW';
+function GetShortPathNameW(lpszLongPath:LPCWSTR; lpszShortPath:LPWSTR; cchBuffer:DWORD):DWORD; external 'kernel32' name 'GetShortPathNameW';
+function GetEnvironmentStringsW:LPWSTR; external 'kernel32' name 'GetEnvironmentStringsW';function FreeEnvironmentStringsW(_para1:LPWSTR):WINBOOL; external 'kernel32' name 'FreeEnvironmentStringsW';
+function FormatMessageW(dwFlags:DWORD; lpSource:LPCVOID; dwMessageId:DWORD; dwLanguageId:DWORD; lpBuffer:LPWSTR;nSize:DWORD; Arguments:va_list):DWORD; external 'kernel32' name 'FormatMessageW';
+function CreateMailslotW(lpName:LPCWSTR; nMaxMessageSize:DWORD; lReadTimeout:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE; external 'kernel32' name 'CreateMailslotW';
+function lstrcmpW(lpString1:LPCWSTR; lpString2:LPCWSTR):longint; external 'kernel32' name 'lstrcmpW';
+function lstrcmpiW(lpString1:LPCWSTR; lpString2:LPCWSTR):longint; external 'kernel32' name 'lstrcmpiW';
+function lstrcpynW(lpString1:LPWSTR; lpString2:LPCWSTR; iMaxLength:longint):LPWSTR; external 'kernel32' name 'lstrcpynW';
+function lstrcpyW(lpString1:LPWSTR; lpString2:LPCWSTR):LPWSTR; external 'kernel32' name 'lstrcpyW';
+function lstrcatW(lpString1:LPWSTR; lpString2:LPCWSTR):LPWSTR; external 'kernel32' name 'lstrcatW';
+function lstrlenW(lpString:LPCWSTR):longint; external 'kernel32' name 'lstrlenW';
+function CreateMutexW(lpMutexAttributes:LPSECURITY_ATTRIBUTES; bInitialOwner:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateMutexW';
+function OpenMutexW(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenMutexW';
+function CreateEventW(lpEventAttributes:LPSECURITY_ATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateEventW';
+function OpenEventW(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenEventW';
+function CreateSemaphoreW(lpSemaphoreAttributes:LPSECURITY_ATTRIBUTES; lInitialCount:LONG; lMaximumCount:LONG; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateSemaphoreW';
+function OpenSemaphoreW(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenSemaphoreW';
+function CreateFileMappingW(hFile:HANDLE; lpFileMappingAttributes:LPSECURITY_ATTRIBUTES; flProtect:DWORD; dwMaximumSizeHigh:DWORD; dwMaximumSizeLow:DWORD;lpName:LPCWSTR):HANDLE; external 'kernel32' name 'CreateFileMappingW';
+function OpenFileMappingW(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenFileMappingW';
+function GetLogicalDriveStringsW(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetLogicalDriveStringsW';
+function LoadLibraryW(lpLibFileName:LPCWSTR):HINST; external 'kernel32' name 'LoadLibraryW';
+function LoadLibraryExW(lpLibFileName:LPCWSTR; hFile:HANDLE; dwFlags:DWORD):HINST; external 'kernel32' name 'LoadLibraryExW';
+function GetModuleFileNameW(hModule:HINST; lpFilename:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetModuleFileNameW';
+function GetModuleHandleW(lpModuleName:LPCWSTR):HMODULE; external 'kernel32' name 'GetModuleHandleW';
+procedure FatalAppExitW(uAction:UINT; lpMessageText:LPCWSTR); external 'kernel32' name 'FatalAppExitW';
+function GetCommandLineW:LPWSTR; external 'kernel32' name 'GetCommandLineW';function GetEnvironmentVariableW(lpName:LPCWSTR; lpBuffer:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetEnvironmentVariableW';
+function SetEnvironmentVariableW(lpName:LPCWSTR; lpValue:LPCWSTR):WINBOOL; external 'kernel32' name 'SetEnvironmentVariableW';
+function ExpandEnvironmentStringsW(lpSrc:LPCWSTR; lpDst:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'ExpandEnvironmentStringsW';
+procedure OutputDebugStringW(lpOutputString:LPCWSTR); external 'kernel32' name 'OutputDebugStringW';
+function FindResourceW(hModule:HINST; lpName:LPCWSTR; lpType:LPCWSTR):HRSRC; external 'kernel32' name 'FindResourceW';
+function FindResourceExW(hModule:HINST; lpType:LPCWSTR; lpName:LPCWSTR; wLanguage:WORD):HRSRC; external 'kernel32' name 'FindResourceExW';
+function EnumResourceTypesW(hModule:HINST; lpEnumFunc:ENUMRESTYPEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceTypesW';
+function EnumResourceNamesW(hModule:HINST; lpType:LPCWSTR; lpEnumFunc:ENUMRESNAMEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceNamesW';
+function EnumResourceLanguagesW(hModule:HINST; lpType:LPCWSTR; lpName:LPCWSTR; lpEnumFunc:ENUMRESLANGPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceLanguagesW';
+function BeginUpdateResourceW(pFileName:LPCWSTR; bDeleteExistingResources:WINBOOL):HANDLE; external 'kernel32' name 'BeginUpdateResourceW';
+function UpdateResourceW(hUpdate:HANDLE; lpType:LPCWSTR; lpName:LPCWSTR; wLanguage:WORD; lpData:LPVOID;cbData:DWORD):WINBOOL; external 'kernel32' name 'UpdateResourceW';
+function EndUpdateResourceW(hUpdate:HANDLE; fDiscard:WINBOOL):WINBOOL; external 'kernel32' name 'EndUpdateResourceW';
+function GlobalAddAtomW(lpString:LPCWSTR):ATOM; external 'kernel32' name 'GlobalAddAtomW';
+function GlobalFindAtomW(lpString:LPCWSTR):ATOM; external 'kernel32' name 'GlobalFindAtomW';
+function GlobalGetAtomNameW(nAtom:ATOM; lpBuffer:LPWSTR; nSize:longint):UINT; external 'kernel32' name 'GlobalGetAtomNameW';
+function AddAtomW(lpString:LPCWSTR):ATOM; external 'kernel32' name 'AddAtomW';
+function FindAtomW(lpString:LPCWSTR):ATOM; external 'kernel32' name 'FindAtomW';
+function GetAtomNameW(nAtom:ATOM; lpBuffer:LPWSTR; nSize:longint):UINT; external 'kernel32' name 'GetAtomNameW';
+function GetProfileIntW(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; nDefault:WINT):UINT; external 'kernel32' name 'GetProfileIntW';
+function GetProfileStringW(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpDefault:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileStringW';
+function WriteProfileStringW(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpString:LPCWSTR):WINBOOL; external 'kernel32' name 'WriteProfileStringW';
+function GetProfileSectionW(lpAppName:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileSectionW';
+function WriteProfileSectionW(lpAppName:LPCWSTR; lpString:LPCWSTR):WINBOOL; external 'kernel32' name 'WriteProfileSectionW';
+function GetPrivateProfileIntW(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; nDefault:WINT; lpFileName:LPCWSTR):UINT; external 'kernel32' name 'GetPrivateProfileIntW';
+function GetPrivateProfileStringW(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpDefault:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD;lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetPrivateProfileStringW';
+function WritePrivateProfileStringW(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpString:LPCWSTR; lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileStringW';
+function GetPrivateProfileSectionW(lpAppName:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD; lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetPrivateProfileSectionW';
+function WritePrivateProfileSectionW(lpAppName:LPCWSTR; lpString:LPCWSTR; lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileSectionW';
+function GetDriveTypeW(lpRootPathName:LPCWSTR):UINT; external 'kernel32' name 'GetDriveTypeW';
+function GetSystemDirectoryW(lpBuffer:LPWSTR; uSize:UINT):UINT; external 'kernel32' name 'GetSystemDirectoryW';
+function GetTempPathW(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetTempPathW';
+function GetTempFileNameW(lpPathName:LPCWSTR; lpPrefixString:LPCWSTR; uUnique:UINT; lpTempFileName:LPWSTR):UINT; external 'kernel32' name 'GetTempFileNameW';
+function GetWindowsDirectoryW(lpBuffer:LPWSTR; uSize:UINT):UINT; external 'kernel32' name 'GetWindowsDirectoryW';
+function SetCurrentDirectoryW(lpPathName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetCurrentDirectoryW';
+function GetCurrentDirectoryW(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetCurrentDirectoryW';
+function GetDiskFreeSpaceW(lpRootPathName:LPCWSTR; lpSectorsPerCluster:LPDWORD; lpBytesPerSector:LPDWORD; lpNumberOfFreeClusters:LPDWORD; lpTotalNumberOfClusters:LPDWORD):WINBOOL; external 'kernel32' name 'GetDiskFreeSpaceW';
+function CreateDirectoryW(lpPathName:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryW';
+function CreateDirectoryExW(lpTemplateDirectory:LPCWSTR; lpNewDirectory:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryExW';
+function RemoveDirectoryW(lpPathName:LPCWSTR):WINBOOL; external 'kernel32' name 'RemoveDirectoryW';
+function GetFullPathNameW(lpFileName:LPCWSTR; nBufferLength:DWORD; lpBuffer:LPWSTR; var lpFilePart:LPWSTR):DWORD; external 'kernel32' name 'GetFullPathNameW';
+function DefineDosDeviceW(dwFlags:DWORD; lpDeviceName:LPCWSTR; lpTargetPath:LPCWSTR):WINBOOL; external 'kernel32' name 'DefineDosDeviceW';
+function QueryDosDeviceW(lpDeviceName:LPCWSTR; lpTargetPath:LPWSTR; ucchMax:DWORD):DWORD; external 'kernel32' name 'QueryDosDeviceW';
+function CreateFileW(lpFileName:LPCWSTR; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; dwCreationDisposition:DWORD;dwFlagsAndAttributes:DWORD; hTemplateFile:HANDLE):HANDLE; external 'kernel32' name 'CreateFileW';
+function SetFileAttributesW(lpFileName:LPCWSTR; dwFileAttributes:DWORD):WINBOOL; external 'kernel32' name 'SetFileAttributesW';
+function GetFileAttributesW(lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetFileAttributesW';
+function GetCompressedFileSizeW(lpFileName:LPCWSTR; lpFileSizeHigh:LPDWORD):DWORD; external 'kernel32' name 'GetCompressedFileSizeW';
+function DeleteFileW(lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'DeleteFileW';
+function SearchPathW(lpPath:LPCWSTR; lpFileName:LPCWSTR; lpExtension:LPCWSTR; nBufferLength:DWORD; lpBuffer:LPWSTR;lpFilePart:LPWSTR):DWORD; external 'kernel32' name 'SearchPathW';
+function CopyFileW(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR; bFailIfExists:WINBOOL):WINBOOL; external 'kernel32' name 'CopyFileW';
+function MoveFileW(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'MoveFileW';
+function MoveFileExW(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'MoveFileExW';
+function CreateNamedPipeW(lpName:LPCWSTR; dwOpenMode:DWORD; dwPipeMode:DWORD; nMaxInstances:DWORD; nOutBufferSize:DWORD;nInBufferSize:DWORD; nDefaultTimeOut:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE;
+ external 'kernel32' name 'CreateNamedPipeW';
+function GetNamedPipeHandleStateW(hNamedPipe:HANDLE; lpState:LPDWORD; lpCurInstances:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD;lpUserName:LPWSTR; nMaxUserNameSize:DWORD):WINBOOL;
+ external 'kernel32' name 'GetNamedPipeHandleStateW';
+function CallNamedPipeW(lpNamedPipeName:LPCWSTR; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'CallNamedPipeW';
+function WaitNamedPipeW(lpNamedPipeName:LPCWSTR; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'WaitNamedPipeW';
+function SetVolumeLabelW(lpRootPathName:LPCWSTR; lpVolumeName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetVolumeLabelW';
+function GetVolumeInformationW(lpRootPathName:LPCWSTR; lpVolumeNameBuffer:LPWSTR; nVolumeNameSize:DWORD; lpVolumeSerialNumber:LPDWORD; lpMaximumComponentLength:LPDWORD;lpFileSystemFlags:LPDWORD; lpFileSystemNameBuffer:LPWSTR;
+ nFileSystemNameSize:DWORD):WINBOOL; external 'kernel32' name 'GetVolumeInformationW';
+function ClearEventLogW(hEventLog:HANDLE; lpBackupFileName:LPCWSTR):WINBOOL; external 'advapi32' name 'ClearEventLogW';
+function BackupEventLogW(hEventLog:HANDLE; lpBackupFileName:LPCWSTR):WINBOOL; external 'advapi32' name 'BackupEventLogW';
+function OpenEventLogW(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenEventLogW';
+function RegisterEventSourceW(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceW';
+function OpenBackupEventLogW(lpUNCServerName:LPCWSTR; lpFileName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogW';
+function ReadEventLogW(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogW';
+function ReportEventW(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
+function AccessCheckAndAuditAlarmW(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; ObjectCreation:WINBOOL;
+ GrantedAccess:LPDWORD; AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
+function ObjectOpenAuditAlarmW(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;
+ Privileges:PPRIVILEGE_SET; ObjectCreation:WINBOOL;AccessGranted:WINBOOL; GenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'ObjectOpenAuditAlarmW';
+function ObjectPrivilegeAuditAlarmW(SubsystemName:LPCWSTR; HandleId:LPVOID; ClientToken:HANDLE; DesiredAccess:DWORD; Privileges:PPRIVILEGE_SET;AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmW';
+function ObjectCloseAuditAlarmW(SubsystemName:LPCWSTR; HandleId:LPVOID; GenerateOnClose:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectCloseAuditAlarmW';
+function PrivilegedServiceAuditAlarmW(SubsystemName:LPCWSTR; ServiceName:LPCWSTR; ClientToken:HANDLE; Privileges:PPRIVILEGE_SET; AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmW';
+function SetFileSecurityW(lpFileName:LPCWSTR; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetFileSecurityW';
+function GetFileSecurityW(lpFileName:LPCWSTR; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetFileSecurityW';
+function FindFirstChangeNotificationW(lpPathName:LPCWSTR; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD):HANDLE; external 'kernel32' name 'FindFirstChangeNotificationW';
+function IsBadStringPtrW(lpsz:LPCWSTR; ucchMax:UINT):WINBOOL; external 'kernel32' name 'IsBadStringPtrW';
+function LookupAccountSidW(lpSystemName:LPCWSTR; Sid:PSID; Name:LPWSTR; cbName:LPDWORD; ReferencedDomainName:LPWSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountSidW';
+function LookupAccountNameW(lpSystemName:LPCWSTR; lpAccountName:LPCWSTR; Sid:PSID; cbSid:LPDWORD; ReferencedDomainName:LPWSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountNameW';
+function LookupPrivilegeValueW(lpSystemName:LPCWSTR; lpName:LPCWSTR; lpLuid:PLUID):WINBOOL; external 'advapi32' name 'LookupPrivilegeValueW';
+function LookupPrivilegeNameW(lpSystemName:LPCWSTR; lpLuid:PLUID; lpName:LPWSTR; cbName:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeNameW';
+function LookupPrivilegeDisplayNameW(lpSystemName:LPCWSTR; lpName:LPCWSTR; lpDisplayName:LPWSTR; cbDisplayName:LPDWORD; lpLanguageId:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameW';
+function BuildCommDCBW(lpDef:LPCWSTR; lpDCB:LPDCB):WINBOOL; external 'kernel32' name 'BuildCommDCBW';
+function BuildCommDCBAndTimeoutsW(lpDef:LPCWSTR; lpDCB:LPDCB; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsW';
+function CommConfigDialogW(lpszName:LPCWSTR; hWnd:HWND; lpCC:LPCOMMCONFIG):WINBOOL; external 'kernel32' name 'CommConfigDialogW';
+function GetDefaultCommConfigW(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetDefaultCommConfigW';
+function SetDefaultCommConfigW(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetDefaultCommConfigW';
+function GetComputerNameW(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameW';
+function SetComputerNameW(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
+function GetUserNameW(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
+function wvsprintfW(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):longint; external 'user32' name 'wvsprintfW';
+function wsprintfW(_para1:LPWSTR; _para2:LPCWSTR; const args:array of const):longint;cdecl; external 'user32' name 'wsprintfW';
+function wsprintfW(_para1:LPWSTR; _para2:LPCWSTR):longint; external 'user32' name 'wsprintfW';
+function LoadKeyboardLayoutW(pwszKLID:LPCWSTR; Flags:UINT):HKL; external 'user32' name 'LoadKeyboardLayoutW';
+function GetKeyboardLayoutNameW(pwszKLID:LPWSTR):WINBOOL; external 'user32' name 'GetKeyboardLayoutNameW';
+function CreateDesktopW(lpszDesktop:LPWSTR; lpszDevice:LPWSTR;pDevmodew:LPDEVMODEw; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopW';
+function OpenDesktopW(lpszDesktop:LPWSTR; dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenDesktopW';
+function EnumDesktopsW(hwinsta:HWINSTA; lpEnumFunc:DESKTOPENUMPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopsW';
+function CreateWindowStationW(lpwinsta:LPWSTR; dwReserved:DWORD; dwDesiredAccess:DWORD; lpsa:LPSECURITY_ATTRIBUTES):HWINSTA; external 'user32' name 'CreateWindowStationW';
+function OpenWindowStationW(lpszWinSta:LPWSTR; fInherit:WINBOOL; dwDesiredAccess:DWORD):HWINSTA; external 'user32' name 'OpenWindowStationW';
+function EnumWindowStationsW(lpEnumFunc:ENUMWINDOWSTATIONPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindowStationsW';
+function GetUserObjectInformationW(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectInformationW';
+function SetUserObjectInformationW(hObj:HANDLE; nIndex:longint; pvInfo:PVOID; nLength:DWORD):WINBOOL; external 'user32' name 'SetUserObjectInformationW';
+function RegisterWindowMessageW(lpString:LPCWSTR):UINT; external 'user32' name 'RegisterWindowMessageW';
+function GetMessageW(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT):WINBOOL; external 'user32' name 'GetMessageW';
+function DispatchMessageW(lpMsg:LPMSG):LONG; external 'user32' name 'DispatchMessageW';
+function PeekMessageW(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT; wRemoveMsg:UINT):WINBOOL; external 'user32' name 'PeekMessageW';
+function SendMessageW(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'SendMessageW';
+function SendMessageTimeoutW(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; fuFlags:UINT;uTimeout:UINT; lpdwResult:LPDWORD):LRESULT; external 'user32' name 'SendMessageTimeoutW';
+function SendNotifyMessageW(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'SendNotifyMessageW';
+function SendMessageCallbackW(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; lpResultCallBack:SENDASYNCPROC;dwData:DWORD):WINBOOL; external 'user32' name 'SendMessageCallbackW';
+function PostMessageW(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostMessageW';
+function PostThreadMessageW(idThread:DWORD; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external 'user32' name 'PostThreadMessageW';
+function DefWindowProcW(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefWindowProcW';
+function CallWindowProcW(lpPrevWndFunc:WNDPROC; hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'CallWindowProcW';
+function RegisterClassW(lpWndClass:LPWNDCLASSW):ATOM; external 'user32' name 'RegisterClassW';
+function UnregisterClassW(lpClassName:LPCWSTR; hInstance:HINST):WINBOOL; external 'user32' name 'UnregisterClassW';
+function GetClassInfoW(hInstance:HINST; lpClassName:LPCWSTR; lpWndClass:LPWNDCLASS):WINBOOL; external 'user32' name 'GetClassInfoW';
+function RegisterClassExW(_para1:LPWNDCLASSEXW):ATOM; external 'user32' name 'RegisterClassExW';
+function GetClassInfoExW(_para1:HINST; _para2:LPCWSTR; _para3:LPWNDCLASSEX):WINBOOL; external 'user32' name 'GetClassInfoExW';
+function CreateWindowExW(dwExStyle:DWORD; lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+ external 'user32' name 'CreateWindowExW';
+function CreateDialogParamW(hInstance:HINST; lpTemplateName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogParamW';
+function CreateDialogIndirectParamW(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogIndirectParamW';
+function DialogBoxParamW(hInstance:HINST; lpTemplateName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxParamW';
+function DialogBoxIndirectParamW(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):longint; external 'user32' name 'DialogBoxIndirectParamW';
+function SetDlgItemTextW(hDlg:HWND; nIDDlgItem:longint; lpString:LPCWSTR):WINBOOL; external 'user32' name 'SetDlgItemTextW';
+function GetDlgItemTextW(hDlg:HWND; nIDDlgItem:longint; lpString:LPWSTR; nMaxCount:longint):UINT; external 'user32' name 'GetDlgItemTextW';
+function SendDlgItemMessageW(hDlg:HWND; nIDDlgItem:longint; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LONG; external 'user32' name 'SendDlgItemMessageW';
+function DefDlgProcW(hDlg:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefDlgProcW';
+function CallMsgFilterW(lpMsg:LPMSG; nCode:longint):WINBOOL; external 'user32' name 'CallMsgFilterW';
+function RegisterClipboardFormatW(lpszFormat:LPCWSTR):UINT; external 'user32' name 'RegisterClipboardFormatW';
+function GetClipboardFormatNameW(format:UINT; lpszFormatName:LPWSTR; cchMaxCount:longint):longint; external 'user32' name 'GetClipboardFormatNameW';
+function CharToOemW(lpszSrc:LPCWSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'CharToOemW';
+function OemToCharW(lpszSrc:LPCSTR; lpszDst:LPWSTR):WINBOOL; external 'user32' name 'OemToCharW';
+function CharToOemBuffW(lpszSrc:LPCWSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffW';
+function OemToCharBuffW(lpszSrc:LPCSTR; lpszDst:LPWSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffW';
+function CharUpperW(lpsz:LPWSTR):LPWSTR; external 'user32' name 'CharUpperW';
+function CharUpperBuffW(lpsz:LPWSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharUpperBuffW';
+function CharLowerW(lpsz:LPWSTR):LPWSTR; external 'user32' name 'CharLowerW';
+function CharLowerBuffW(lpsz:LPWSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharLowerBuffW';
+function CharNextW(lpsz:LPCWSTR):LPWSTR; external 'user32' name 'CharNextW';
+function CharPrevW(lpszStart:LPCWSTR; lpszCurrent:LPCWSTR):LPWSTR; external 'user32' name 'CharPrevW';
+function IsCharAlphaW(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharAlphaW';
+function IsCharAlphaNumericW(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharAlphaNumericW';
+function IsCharUpperW(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharUpperW';
+function IsCharLowerW(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharLowerW';
+function GetKeyNameTextW(lParam:LONG; lpString:LPWSTR; nSize:longint):longint; external 'user32' name 'GetKeyNameTextW';
+function VkKeyScanW(ch:WCHAR):SHORT; external 'user32' name 'VkKeyScanW';
+function VkKeyScanExW(ch:WCHAR; dwhkl:HKL):SHORT; external 'user32' name 'VkKeyScanExW';
+function MapVirtualKeyW(uCode:UINT; uMapType:UINT):UINT; external 'user32' name 'MapVirtualKeyW';
+function MapVirtualKeyExW(uCode:UINT; uMapType:UINT; dwhkl:HKL):UINT; external 'user32' name 'MapVirtualKeyExW';
+function LoadAcceleratorsW(hInstance:HINST; lpTableName:LPCWSTR):HACCEL; external 'user32' name 'LoadAcceleratorsW';
+function CreateAcceleratorTableW(_para1:LPACCEL; _para2:longint):HACCEL; external 'user32' name 'CreateAcceleratorTableW';
+function CopyAcceleratorTableW(hAccelSrc:HACCEL; lpAccelDst:LPACCEL; cAccelEntries:longint):longint; external 'user32' name 'CopyAcceleratorTableW';
+function TranslateAcceleratorW(hWnd:HWND; hAccTable:HACCEL; lpMsg:LPMSG):longint; external 'user32' name 'TranslateAcceleratorW';
+function LoadMenuW(hInstance:HINST; lpMenuName:LPCWSTR):HMENU; external 'user32' name 'LoadMenuW';
+function LoadMenuIndirectW(lpMenuTemplate:LPMENUTEMPLATE):HMENU; external 'user32' name 'LoadMenuIndirectW';
+function ChangeMenuW(hMenu:HMENU; cmd:UINT; lpszNewItem:LPCWSTR; cmdInsert:UINT; flags:UINT):WINBOOL; external 'user32' name 'ChangeMenuW';
+function GetMenuStringW(hMenu:HMENU; uIDItem:UINT; lpString:LPWSTR; nMaxCount:longint; uFlag:UINT):longint; external 'user32' name 'GetMenuStringW';
+function InsertMenuW(hMenu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'InsertMenuW';
+function AppendMenuW(hMenu:HMENU; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'AppendMenuW';
+function ModifyMenuW(hMnu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'ModifyMenuW';
+function InsertMenuItemW(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'InsertMenuItemW';
+function GetMenuItemInfoW(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPMENUITEMINFO):WINBOOL; external 'user32' name 'GetMenuItemInfoW';
+function SetMenuItemInfoW(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'SetMenuItemInfoW';
+function DrawTextW(hDC:HDC; lpString:LPCWSTR; nCount:longint; lpRect:LPRECT; uFormat:UINT):longint; external 'user32' name 'DrawTextW';
+function DrawTextExW(_para1:HDC; _para2:LPWSTR; _para3:longint; _para4:LPRECT; _para5:UINT;_para6:LPDRAWTEXTPARAMS):longint; external 'user32' name 'DrawTextExW';
+function GrayStringW(hDC:HDC; hBrush:HBRUSH; lpOutputFunc:GRAYSTRINGPROC; lpData:LPARAM; nCount:longint;X:longint; Y:longint; nWidth:longint; nHeight:longint):WINBOOL; external 'user32' name 'GrayStringW';
+function DrawStateW(_para1:HDC; _para2:HBRUSH; _para3:DRAWSTATEPROC; _para4:LPARAM; _para5:WPARAM;_para6:longint; _para7:longint; _para8:longint; _para9:longint; _para10:UINT):WINBOOL; external 'user32' name 'DrawStateW';
+function TabbedTextOutW(hDC:HDC; X:longint; Y:longint; lpString:LPCWSTR; nCount:longint;nTabPositions:longint; lpnTabStopPositions:LPINT; nTabOrigin:longint):LONG; external 'user32' name 'TabbedTextOutW';
+function GetTabbedTextExtentW(hDC:HDC; lpString:LPCWSTR; nCount:longint; nTabPositions:longint; lpnTabStopPositions:LPINT):DWORD; external 'user32' name 'GetTabbedTextExtentW';
+function SetPropW(hWnd:HWND; lpString:LPCWSTR; hData:HANDLE):WINBOOL; external 'user32' name 'SetPropW';
+function GetPropW(hWnd:HWND; lpString:LPCWSTR):HANDLE; external 'user32' name 'GetPropW';
+function RemovePropW(hWnd:HWND; lpString:LPCWSTR):HANDLE; external 'user32' name 'RemovePropW';
+function EnumPropsExW(hWnd:HWND; lpEnumFunc:PROPENUMPROCEX; lParam:LPARAM):longint; external 'user32' name 'EnumPropsExW';
+function EnumPropsW(hWnd:HWND; lpEnumFunc:PROPENUMPROC):longint; external 'user32' name 'EnumPropsW';
+function SetWindowTextW(hWnd:HWND; lpString:LPCWSTR):WINBOOL; external 'user32' name 'SetWindowTextW';
+function GetWindowTextW(hWnd:HWND; lpString:LPWSTR; nMaxCount:longint):longint; external 'user32' name 'GetWindowTextW';
+function GetWindowTextLengthW(hWnd:HWND):longint; external 'user32' name 'GetWindowTextLengthW';
+function MessageBoxW(hWnd:HWND; lpText:LPCWSTR; lpCaption:LPCWSTR; uType:UINT):longint; external 'user32' name 'MessageBoxW';
+function MessageBoxExW(hWnd:HWND; lpText:LPCWSTR; lpCaption:LPCWSTR; uType:UINT; wLanguageId:WORD):longint; external 'user32' name 'MessageBoxExW';
+function MessageBoxIndirectW(_para1:LPMSGBOXPARAMS):longint; external 'user32' name 'MessageBoxIndirectW';
+function GetWindowLongW(hWnd:HWND; nIndex:longint):LONG; external 'user32' name 'GetWindowLongW';
+function SetWindowLongW(hWnd:HWND; nIndex:longint; dwNewLong:LONG):LONG; external 'user32' name 'SetWindowLongW';
+function GetClassLongW(hWnd:HWND; nIndex:longint):DWORD; external 'user32' name 'GetClassLongW';
+function SetClassLongW(hWnd:HWND; nIndex:longint; dwNewLong:LONG):DWORD; external 'user32' name 'SetClassLongW';
+function FindWindowW(lpClassName:LPCWSTR; lpWindowName:LPCWSTR):HWND; external 'user32' name 'FindWindowW';
+function FindWindowExW(_para1:HWND; _para2:HWND; _para3:LPCWSTR; _para4:LPCWSTR):HWND; external 'user32' name 'FindWindowExW';
+function GetClassNameW(hWnd:HWND; lpClassName:LPWSTR; nMaxCount:longint):longint; external 'user32' name 'GetClassNameW';
+function SetWindowsHookExW(idHook:longint; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; external 'user32' name 'SetWindowsHookExW';
+function LoadBitmapW(hInstance:HINST; lpBitmapName:LPCWSTR):HBITMAP; external 'user32' name 'LoadBitmapW';
+function LoadCursorW(hInstance:HINST; lpCursorName:LPCWSTR):HCURSOR; external 'user32' name 'LoadCursorW';
+function LoadCursorFromFileW(lpFileName:LPCWSTR):HCURSOR; external 'user32' name 'LoadCursorFromFileW';
+function LoadIconW(hInstance:HINST; lpIconName:LPCWSTR):HICON; external 'user32' name 'LoadIconW';
+function LoadImageW(_para1:HINST; _para2:LPCWSTR; _para3:UINT; _para4:longint; _para5:longint;_para6:UINT):HANDLE; external 'user32' name 'LoadImageW';
+function LoadStringW(hInstance:HINST; uID:UINT; lpBuffer:LPWSTR; nBufferMax:longint):longint; external 'user32' name 'LoadStringW';
+function IsDialogMessageW(hDlg:HWND; lpMsg:LPMSG):WINBOOL; external 'user32' name 'IsDialogMessageW';
+function DlgDirListW(hDlg:HWND; lpPathSpec:LPWSTR; nIDListBox:longint; nIDStaticPath:longint; uFileType:UINT):longint; external 'user32' name 'DlgDirListW';
+function DlgDirSelectExW(hDlg:HWND; lpString:LPWSTR; nCount:longint; nIDListBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectExW';
+function DlgDirListComboBoxW(hDlg:HWND; lpPathSpec:LPWSTR; nIDComboBox:longint; nIDStaticPath:longint; uFiletype:UINT):longint; external 'user32' name 'DlgDirListComboBoxW';
+function DlgDirSelectComboBoxExW(hDlg:HWND; lpString:LPWSTR; nCount:longint; nIDComboBox:longint):WINBOOL; external 'user32' name 'DlgDirSelectComboBoxExW';
+function DefFrameProcW(hWnd:HWND; hWndMDIClient:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefFrameProcW';
+function DefMDIChildProcW(hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefMDIChildProcW';
+function CreateMDIWindowW(lpClassName:LPWSTR; lpWindowName:LPWSTR; dwStyle:DWORD; X:longint; Y:longint;nWidth:longint; nHeight:longint; hWndParent:HWND; hInstance:HINST; lParam:LPARAM):HWND; external 'user32' name 'CreateMDIWindowW';
+function WinHelpW(hWndMain:HWND; lpszHelp:LPCWSTR; uCommand:UINT; dwData:DWORD):WINBOOL; external 'user32' name 'WinHelpW';
+function ChangeDisplaySettingsW(lpDevMode:LPDEVMODEW; dwFlags:DWORD):LONG; external 'user32' name 'ChangeDisplaySettingsW';
+function EnumDisplaySettingsW(lpszDeviceName:LPCWSTR; iModeNum:DWORD;lpDevMode:LPDEVMODEW):WINBOOL; external 'user32' name 'EnumDisplaySettingsW';
+function SystemParametersInfoW(uiAction:UINT; uiParam:UINT; pvParam:PVOID; fWinIni:UINT):WINBOOL; external 'user32' name 'SystemParametersInfoW';
+function AddFontResourceW(_para1:LPCWSTR):longint; external 'gdi32' name 'AddFontResourceW';
+function CopyMetaFileW(_para1:HMETAFILE; _para2:LPCWSTR):HMETAFILE; external 'gdi32' name 'CopyMetaFileW';
+function CreateFontIndirectW(_para1:PLOGFONT):HFONT; external 'gdi32' name 'CreateFontIndirectW';
+function CreateFontW(_para1:longint; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:DWORD; _para7:DWORD; _para8:DWORD; _para9:DWORD; _para10:DWORD;_para11:DWORD; _para12:DWORD; _para13:DWORD; _para14:LPCWSTR):HFONT;
+ external 'gdi32' name 'CreateFontW';
+function CreateICW(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPDEVMODEw):HDC; external 'gdi32' name 'CreateICW';
+function CreateMetaFileW(_para1:LPCWSTR):HDC; external 'gdi32' name 'CreateMetaFileW';
+function CreateScalableFontResourceW(_para1:DWORD; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPCWSTR):WINBOOL; external 'gdi32' name 'CreateScalableFontResourceW';
+function EnumFontFamiliesExW(_para1:HDC; _para2:LPLOGFONT; _para3:FONTENUMEXPROC; _para4:LPARAM; _para5:DWORD):longint; external 'gdi32' name 'EnumFontFamiliesExW';
+function EnumFontFamiliesW(_para1:HDC; _para2:LPCWSTR; _para3:FONTENUMPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontFamiliesW';
+function EnumFontsW(_para1:HDC; _para2:LPCWSTR; _para3:ENUMFONTSPROC; _para4:LPARAM):longint; external 'gdi32' name 'EnumFontsW';
+function GetCharWidthW(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidthW';
+function GetCharWidth32W(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidth32W';
+function GetCharWidthFloatW(_para1:HDC; _para2:UINT; _para3:UINT; _para4:PSingle):WINBOOL; external 'gdi32' name 'GetCharWidthFloatW';
+function GetCharABCWidthsW(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABC):WINBOOL; external 'gdi32' name 'GetCharABCWidthsW';
+function GetCharABCWidthsFloatW(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABCFLOAT):WINBOOL; external 'gdi32' name 'GetCharABCWidthsFloatW';
+function GetGlyphOutlineW(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPGLYPHMETRICS; _para5:DWORD;_para6:LPVOID; _para7:PMAT2):DWORD; external 'gdi32' name 'GetGlyphOutlineW';
+function GetMetaFileW(_para1:LPCWSTR):HMETAFILE; external 'gdi32' name 'GetMetaFileW';
+function GetOutlineTextMetricsW(_para1:HDC; _para2:UINT; _para3:LPOUTLINETEXTMETRIC):UINT; external 'gdi32' name 'GetOutlineTextMetricsW';
+function GetTextExtentPointW(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPointW';
+function GetTextExtentPoint32W(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPoint32W';
+function GetTextExtentExPointW(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:longint; _para5:LPINT;_para6:LPINT; _para7:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentExPointW';
+function GetCharacterPlacementW(_para1:HDC; _para2:LPCWSTR; _para3:longint; _para4:longint; _para5:LPGCP_RESULTS;_para6:DWORD):DWORD; external 'gdi32' name 'GetCharacterPlacementW';
+function ResetDCW(_para1:HDC; _para2:LPDEVMODEW):HDC; external 'gdi32' name 'ResetDCW';
+function RemoveFontResourceW(_para1:LPCWSTR):WINBOOL; external 'gdi32' name 'RemoveFontResourceW';
+function CopyEnhMetaFileW(_para1:HENHMETAFILE; _para2:LPCWSTR):HENHMETAFILE; external 'gdi32' name 'CopyEnhMetaFileW';
+function CreateEnhMetaFileW(_para1:HDC; _para2:LPCWSTR; _para3:LPRECT; _para4:LPCWSTR):HDC; external 'gdi32' name 'CreateEnhMetaFileW';
+function GetEnhMetaFileW(_para1:LPCWSTR):HENHMETAFILE; external 'gdi32' name 'GetEnhMetaFileW';
+function GetEnhMetaFileDescriptionW(_para1:HENHMETAFILE; _para2:UINT; _para3:LPWSTR):UINT; external 'gdi32' name 'GetEnhMetaFileDescriptionW';
+function GetTextMetricsW(_para1:HDC; _para2:LPTEXTMETRIC):WINBOOL; external 'gdi32' name 'GetTextMetricsW';
+function StartDocW(_para1:HDC; _para2:PDOCINFO):longint; external 'gdi32' name 'StartDocW';
+function GetObjectW(_para1:HGDIOBJ; _para2:longint; _para3:LPVOID):longint; external 'gdi32' name 'GetObjectW';
+function TextOutW(_para1:HDC; _para2:longint; _para3:longint; _para4:LPCWSTR; _para5:longint):WINBOOL; external 'gdi32' name 'TextOutW';
+function ExtTextOutW(_para1:HDC; _para2:longint; _para3:longint; _para4:UINT; _para5:LPRECT;_para6:LPCWSTR; _para7:UINT; _para8:LPINT):WINBOOL; external 'gdi32' name 'ExtTextOutW';
+function PolyTextOutW(_para1:HDC; _para2:PPOLYTEXT; _para3:longint):WINBOOL; external 'gdi32' name 'PolyTextOutW';
+function GetTextFaceW(_para1:HDC; _para2:longint; _para3:LPWSTR):longint; external 'gdi32' name 'GetTextFaceW';
+function GetKerningPairsW(_para1:HDC; _para2:DWORD; _para3:LPKERNINGPAIR):DWORD; external 'gdi32' name 'GetKerningPairsW';
+function GetLogColorSpaceW(_para1:HCOLORSPACE; _para2:LPLOGCOLORSPACE; _para3:DWORD):WINBOOL; external 'gdi32' name 'GetLogColorSpaceW';
+function CreateColorSpaceW(_para1:LPLOGCOLORSPACE):HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceW';
+function GetICMProfileW(_para1:HDC; _para2:DWORD; _para3:LPWSTR):WINBOOL; external 'gdi32' name 'GetICMProfileW';
+function SetICMProfileW(_para1:HDC; _para2:LPWSTR):WINBOOL; external 'gdi32' name 'SetICMProfileW';
+function UpdateICMRegKeyW(_para1:DWORD; _para2:DWORD; _para3:LPWSTR; _para4:UINT):WINBOOL; external 'gdi32' name 'UpdateICMRegKeyW';
+function EnumICMProfilesW(_para1:HDC; _para2:ICMENUMPROC; _para3:LPARAM):longint; external 'gdi32' name 'EnumICMProfilesW';
+function CreatePropertySheetPageW(lppsp:LPCPROPSHEETPAGE):HPROPSHEETPAGE; external 'comctl32' name 'CreatePropertySheetPageW';
+function PropertySheetW(lppsph:LPCPROPSHEETHEADER):longint; external 'comctl32' name 'PropertySheetW';
+function ImageList_LoadImageW(hi:HINST; lpbmp:LPCWSTR; cx:longint; cGrow:longint; crMask:COLORREF;uType:UINT; uFlags:UINT):HIMAGELIST; external 'comctl32' name 'ImageList_LoadImageW';
+function CreateStatusWindowW(style:LONG; lpszText:LPCWSTR; hwndParent:HWND; wID:UINT):HWND; external 'comctl32' name 'CreateStatusWindowW';
+procedure DrawStatusTextW(hDC:HDC; lprc:LPRECT; pszText:LPCWSTR; uFlags:UINT); external 'comctl32' name 'DrawStatusTextW';
+function GetOpenFileNameW(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetOpenFileNameW';
+function GetSaveFileNameW(_para1:LPOPENFILENAME):WINBOOL; external 'comdlg32' name 'GetSaveFileNameW';
+function GetFileTitleW(_para1:LPCWSTR; _para2:LPWSTR; _para3:WORD):integer; external 'comdlg32' name 'GetFileTitleW';
+function ChooseColorW(_para1:LPCHOOSECOLOR):WINBOOL; external 'comdlg32' name 'ChooseColorW';
+function ReplaceTextW(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'ReplaceTextW';
+function ChooseFontW(_para1:LPCHOOSEFONT):WINBOOL; external 'comdlg32' name 'ChooseFontW';
+function FindTextW(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'FindTextW';
+function PrintDlgW(_para1:LPPRINTDLG):WINBOOL; external 'comdlg32' name 'PrintDlgW';
+function PageSetupDlgW(_para1:LPPAGESETUPDLG):WINBOOL; external 'comdlg32' name 'PageSetupDlgW';
+function CreateProcessW(lpApplicationName:LPCWSTR; lpCommandLine:LPWSTR; lpProcessAttributes:LPSECURITY_ATTRIBUTES; lpThreadAttributes:LPSECURITY_ATTRIBUTES; bInheritHandles:WINBOOL;dwCreationFlags:DWORD; lpEnvironment:LPVOID;
+ lpCurrentDirectory:LPCWSTR; lpStartupInfo:LPSTARTUPINFO; lpProcessInformation:LPPROCESS_INFORMATION):WINBOOL; external 'kernel32' name 'CreateProcessW';
+procedure GetStartupInfoW(lpStartupInfo:LPSTARTUPINFO); external 'kernel32' name 'GetStartupInfoW';
+function FindFirstFileW(lpFileName:LPCWSTR; lpFindFileData:LPWIN32_FIND_DATAW):HANDLE; external 'kernel32' name 'FindFirstFileW';
+function FindNextFileW(hFindFile:HANDLE; lpFindFileData:LPWIN32_FIND_DATAW):WINBOOL; external 'kernel32' name 'FindNextFileW';
+function GetVersionExW(VersionInformation:LPOSVERSIONINFOW):WINBOOL; external 'kernel32' name 'GetVersionExW';
+function CreateWindowW(lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+function CreateDialogW(hInstance:HINST; lpName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function CreateDialogIndirectW(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+function DialogBoxW(hInstance:HINST; lpTemplate:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function DialogBoxIndirectW(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+function CreateDCW(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR; _para4:pDEVMODEW):HDC; external 'gdi32' name 'CreateDCW';
+function VerInstallFileW(uFlags:DWORD; szSrcFileName:LPWSTR; szDestFileName:LPWSTR; szSrcDir:LPWSTR; szDestDir:LPWSTR;szCurDir:LPWSTR; szTmpFile:LPWSTR; lpuTmpFileLen:PUINT):DWORD; external 'version' name 'VerInstallFileW';
+function GetFileVersionInfoSizeW(lptstrFilename:LPWSTR; lpdwHandle:LPDWORD):DWORD; external 'version' name 'GetFileVersionInfoSizeW';
+function GetFileVersionInfoW(lptstrFilename:LPWSTR; dwHandle:DWORD; dwLen:DWORD; lpData:LPVOID):WINBOOL; external 'version' name 'GetFileVersionInfoW';
+function VerLanguageNameW(wLang:DWORD; szLang:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'VerLanguageNameW';
+function VerQueryValueW(pBlock:LPVOID; lpSubBlock:LPWSTR; lplpBuffer:LPVOID; puLen:PUINT):WINBOOL; external 'version' name 'VerQueryValueW';
+function VerFindFileW(uFlags:DWORD; szFileName:LPWSTR; szWinDir:LPWSTR; szAppDir:LPWSTR; szCurDir:LPWSTR;lpuCurDirLen:PUINT; szDestDir:LPWSTR; lpuDestDirLen:PUINT):DWORD; external 'version' name 'VerFindFileW';
+function RegSetValueExW(hKey:HKEY; lpValueName:LPCWSTR; Reserved:DWORD; dwType:DWORD; lpData:LPBYTE;cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueExW';
+function RegUnLoadKeyW(hKey:HKEY; lpSubKey:LPCWSTR):LONG; external 'advapi32' name 'RegUnLoadKeyW';
+function InitiateSystemShutdownW(lpMachineName:LPWSTR; lpMessage:LPWSTR; dwTimeout:DWORD; bForceAppsClosed:WINBOOL; bRebootAfterShutdown:WINBOOL):WINBOOL; external 'advapi32' name 'InitiateSystemShutdownW';
+function AbortSystemShutdownW(lpMachineName:LPWSTR):WINBOOL; external 'advapi32' name 'AbortSystemShutdownW';
+function RegRestoreKeyW(hKey:HKEY; lpFile:LPCWSTR; dwFlags:DWORD):LONG; external 'advapi32' name 'RegRestoreKeyW';
+function RegSaveKeyW(hKey:HKEY; lpFile:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):LONG; external 'advapi32' name 'RegSaveKeyW';
+function RegSetValueW(hKey:HKEY; lpSubKey:LPCWSTR; dwType:DWORD; lpData:LPCWSTR; cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueW';
+function RegQueryValueW(hKey:HKEY; lpSubKey:LPCWSTR; lpValue:LPWSTR; lpcbValue:PLONG):LONG; external 'advapi32' name 'RegQueryValueW';
+function RegQueryMultipleValuesW(hKey:HKEY; val_list:PVALENT; num_vals:DWORD; lpValueBuf:LPWSTR; ldwTotsize:LPDWORD):LONG; external 'advapi32' name 'RegQueryMultipleValuesW';
+function RegQueryValueExW(hKey:HKEY; lpValueName:LPCWSTR; lpReserved:LPDWORD; lpType:LPDWORD; lpData:LPBYTE;lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegQueryValueExW';
+function RegReplaceKeyW(hKey:HKEY; lpSubKey:LPCWSTR; lpNewFile:LPCWSTR; lpOldFile:LPCWSTR):LONG; external 'advapi32' name 'RegReplaceKeyW';
+function RegConnectRegistryW(lpMachineName:LPWSTR; hKey:HKEY; phkResult:PHKEY):LONG; external 'advapi32' name 'RegConnectRegistryW';
+function RegCreateKeyW(hKey:HKEY; lpSubKey:LPCWSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegCreateKeyW';
+function RegCreateKeyExW(hKey:HKEY; lpSubKey:LPCWSTR; Reserved:DWORD; lpClass:LPWSTR; dwOptions:DWORD;samDesired:REGSAM; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; phkResult:PHKEY; lpdwDisposition:LPDWORD):LONG;
+ external 'advapi32' name 'RegCreateKeyExW';
+function RegDeleteKeyW(hKey:HKEY; lpSubKey:LPCWSTR):LONG; external 'advapi32' name 'RegDeleteKeyW';
+function RegDeleteValueW(hKey:HKEY; lpValueName:LPCWSTR):LONG; external 'advapi32' name 'RegDeleteValueW';
+function RegEnumKeyW(hKey:HKEY; dwIndex:DWORD; lpName:LPWSTR; cbName:DWORD):LONG; external 'advapi32' name 'RegEnumKeyW';
+function RegEnumKeyExW(hKey:HKEY; dwIndex:DWORD; lpName:LPWSTR; lpcbName:LPDWORD; lpReserved:LPDWORD;lpClass:LPWSTR; lpcbClass:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegEnumKeyExW';
+function RegEnumValueW(hKey:HKEY; dwIndex:DWORD; lpValueName:LPWSTR; lpcbValueName:LPDWORD; lpReserved:LPDWORD;lpType:LPDWORD; lpData:LPBYTE; lpcbData:LPDWORD):LONG; external 'advapi32' name 'RegEnumValueW';
+function RegLoadKeyW(hKey:HKEY; lpSubKey:LPCWSTR; lpFile:LPCWSTR):LONG; external 'advapi32' name 'RegLoadKeyW';
+function RegOpenKeyW(hKey:HKEY; lpSubKey:LPCWSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyW';
+function RegOpenKeyExW(hKey:HKEY; lpSubKey:LPCWSTR; ulOptions:DWORD; samDesired:REGSAM; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyExW';
+function RegQueryInfoKeyW(hKey:HKEY; lpClass:LPWSTR; lpcbClass:LPDWORD; lpReserved:LPDWORD; lpcSubKeys:LPDWORD;lpcbMaxSubKeyLen:LPDWORD; lpcbMaxClassLen:LPDWORD; lpcValues:LPDWORD; lpcbMaxValueNameLen:LPDWORD;
+ lpcbMaxValueLen:LPDWORD;lpcbSecurityDescriptor:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external 'advapi32' name 'RegQueryInfoKeyW';
+function CompareStringW(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCWSTR; cchCount1:longint; lpString2:LPCWSTR;cchCount2:longint):longint; external 'kernel32' name 'CompareStringW';
+function LCMapStringW(Locale:LCID; dwMapFlags:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpDestStr:LPWSTR;cchDest:longint):longint; external 'kernel32' name 'LCMapStringW';
+function GetLocaleInfoW(Locale:LCID; LCType:LCTYPE; lpLCData:LPWSTR; cchData:longint):longint; external 'kernel32' name 'GetLocaleInfoW';
+function SetLocaleInfoW(Locale:LCID; LCType:LCTYPE; lpLCData:LPCWSTR):WINBOOL; external 'kernel32' name 'SetLocaleInfoW';
+function GetTimeFormatW(Locale:LCID; dwFlags:DWORD; lpTime:LPSYSTEMTIME; lpFormat:LPCWSTR; lpTimeStr:LPWSTR;cchTime:longint):longint; external 'kernel32' name 'GetTimeFormatW';
+function GetDateFormatW(Locale:LCID; dwFlags:DWORD; lpDate:LPSYSTEMTIME; lpFormat:LPCWSTR; lpDateStr:LPWSTR;cchDate:longint):longint; external 'kernel32' name 'GetDateFormatW';
+function GetNumberFormatW(Locale:LCID; dwFlags:DWORD; lpValue:LPCWSTR; lpFormat:PNUMBERFMT; lpNumberStr:LPWSTR;cchNumber:longint):longint; external 'kernel32' name 'GetNumberFormatW';
+function GetCurrencyFormatW(Locale:LCID; dwFlags:DWORD; lpValue:LPCWSTR; lpFormat:PCURRENCYFMT; lpCurrencyStr:LPWSTR;cchCurrency:longint):longint; external 'kernel32' name 'GetCurrencyFormatW';
+function EnumCalendarInfoW(lpCalInfoEnumProc:CALINFO_ENUMPROC; Locale:LCID; Calendar:CALID; CalType:CALTYPE):WINBOOL; external 'kernel32' name 'EnumCalendarInfoW';
+function EnumTimeFormatsW(lpTimeFmtEnumProc:TIMEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumTimeFormatsW';
+function EnumDateFormatsW(lpDateFmtEnumProc:DATEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumDateFormatsW';
+function GetStringTypeExW(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeExW';
+function GetStringTypeW(dwInfoType:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeW';
+function FoldStringW(dwMapFlags:DWORD; lpSrcStr:LPCWSTR; cchSrc:longint; lpDestStr:LPWSTR; cchDest:longint):longint; external 'kernel32' name 'FoldStringW';
+function EnumSystemLocalesW(lpLocaleEnumProc:LOCALE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemLocalesW';
+function EnumSystemCodePagesW(lpCodePageEnumProc:CODEPAGE_ENUMPROC; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'EnumSystemCodePagesW';
+function PeekConsoleInputW(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'PeekConsoleInputW';
+function ReadConsoleInputW(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleInputW';
+function WriteConsoleInputW(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleInputW';
+function ReadConsoleOutputW(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpReadRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'ReadConsoleOutputW';
+function WriteConsoleOutputW(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpWriteRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputW';
+function ReadConsoleOutputCharacterW(hConsoleOutput:HANDLE; lpCharacter:LPWSTR; nLength:DWORD; dwReadCoord:COORD; lpNumberOfCharsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputCharacterW';
+function WriteConsoleOutputCharacterW(hConsoleOutput:HANDLE; lpCharacter:LPCWSTR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW';
+function FillConsoleOutputCharacterW(hConsoleOutput:HANDLE; cCharacter:WCHAR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputCharacterW';
+function ScrollConsoleScreenBufferW(hConsoleOutput:HANDLE; lpScrollRectangle:PSMALL_RECT; lpClipRectangle:PSMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):WINBOOL; external 'kernel32' name 'ScrollConsoleScreenBufferW';
+function GetConsoleTitleW(lpConsoleTitle:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetConsoleTitleW';
+function SetConsoleTitleW(lpConsoleTitle:LPCWSTR):WINBOOL; external 'kernel32' name 'SetConsoleTitleW';
+function ReadConsoleW(hConsoleInput:HANDLE; lpBuffer:LPVOID; nNumberOfCharsToRead:DWORD; lpNumberOfCharsRead:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'ReadConsoleW';
+function WriteConsoleW(hConsoleOutput:HANDLE;lpBuffer:pointer; nNumberOfCharsToWrite:DWORD; lpNumberOfCharsWritten:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'WriteConsoleW';
+function WNetAddConnectionW(lpRemoteName:LPCWSTR; lpPassword:LPCWSTR; lpLocalName:LPCWSTR):DWORD; external 'mpr' name 'WNetAddConnectionW';
+function WNetAddConnection2W(lpNetResource:LPNETRESOURCE; lpPassword:LPCWSTR; lpUserName:LPCWSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection2W';
+function WNetAddConnection3W(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpPassword:LPCWSTR; lpUserName:LPCWSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection3W';
+function WNetCancelConnectionW(lpName:LPCWSTR; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnectionW';
+function WNetCancelConnection2W(lpName:LPCWSTR; dwFlags:DWORD; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnection2W';
+function WNetGetConnectionW(lpLocalName:LPCWSTR; lpRemoteName:LPWSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetConnectionW';
+function WNetUseConnectionW(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpUserID:LPCWSTR; lpPassword:LPCWSTR; dwFlags:DWORD;lpAccessName:LPWSTR; lpBufferSize:LPDWORD; lpResult:LPDWORD):DWORD; external 'mpr' name 'WNetUseConnectionW';
+function WNetSetConnectionW(lpName:LPCWSTR; dwProperties:DWORD; pvValues:LPVOID):DWORD; external 'mpr' name 'WNetSetConnectionW';
+function WNetConnectionDialog1W(lpConnDlgStruct:LPCONNECTDLGSTRUCT):DWORD; external 'mpr' name 'WNetConnectionDialog1W';
+function WNetDisconnectDialog1W(lpConnDlgStruct:LPDISCDLGSTRUCT):DWORD; external 'mpr' name 'WNetDisconnectDialog1W';
+function WNetOpenEnumW(dwScope:DWORD; dwType:DWORD; dwUsage:DWORD; lpNetResource:LPNETRESOURCE; lphEnum:LPHANDLE):DWORD; external 'mpr' name 'WNetOpenEnumW';
+function WNetEnumResourceW(hEnum:HANDLE; lpcCount:LPDWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetEnumResourceW';
+function WNetGetUniversalNameW(lpLocalPath:LPCWSTR; dwInfoLevel:DWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetUniversalNameW';
+function WNetGetUserW(lpName:LPCWSTR; lpUserName:LPWSTR; lpnLength:LPDWORD):DWORD; external 'mpr' name 'WNetGetUserW';
+function WNetGetProviderNameW(dwNetType:DWORD; lpProviderName:LPWSTR; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetProviderNameW';
+function WNetGetNetworkInformationW(lpProvider:LPCWSTR; lpNetInfoStruct:LPNETINFOSTRUCT):DWORD; external 'mpr' name 'WNetGetNetworkInformationW';
+function WNetGetLastErrorW(lpError:LPDWORD; lpErrorBuf:LPWSTR; nErrorBufSize:DWORD; lpNameBuf:LPWSTR; nNameBufSize:DWORD):DWORD; external 'mpr' name 'WNetGetLastErrorW';
+function MultinetGetConnectionPerformanceW(lpNetResource:LPNETRESOURCE; lpNetConnectInfoStruct:LPNETCONNECTINFOSTRUCT):DWORD; external 'mpr' name 'MultinetGetConnectionPerformanceW';
+function ChangeServiceConfigW(hService:SC_HANDLE; dwServiceType:DWORD; dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCWSTR;lpLoadOrderGroup:LPCWSTR; lpdwTagId:LPDWORD; lpDependencies:LPCWSTR; lpServiceStartName:LPCWSTR;
+ lpPassword:LPCWSTR;lpDisplayName:LPCWSTR):WINBOOL; external 'advapi32' name 'ChangeServiceConfigW';
+function CreateServiceW(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; lpDisplayName:LPCWSTR; dwDesiredAccess:DWORD; dwServiceType:DWORD;dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCWSTR; lpLoadOrderGroup:LPCWSTR;
+ lpdwTagId:LPDWORD;lpDependencies:LPCWSTR; lpServiceStartName:LPCWSTR; lpPassword:LPCWSTR):SC_HANDLE; external 'advapi32' name 'CreateServiceW';
+function EnumDependentServicesW(hService:SC_HANDLE; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD;lpServicesReturned:LPDWORD):WINBOOL; external 'advapi32' name 'EnumDependentServicesW';
+function EnumServicesStatusW(hSCManager:SC_HANDLE; dwServiceType:DWORD; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD;pcbBytesNeeded:LPDWORD; lpServicesReturned:LPDWORD; lpResumeHandle:LPDWORD):WINBOOL;
+ external 'advapi32' name 'EnumServicesStatusW';
+function GetServiceKeyNameW(hSCManager:SC_HANDLE; lpDisplayName:LPCWSTR; lpServiceName:LPWSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceKeyNameW';
+function GetServiceDisplayNameW(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; lpDisplayName:LPWSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceDisplayNameW';
+function OpenSCManagerW(lpMachineName:LPCWSTR; lpDatabaseName:LPCWSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenSCManagerW';
+function OpenServiceW(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenServiceW';
+function QueryServiceConfigW(hService:SC_HANDLE; lpServiceConfig:LPQUERY_SERVICE_CONFIG; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceConfigW';
+function QueryServiceLockStatusW(hSCManager:SC_HANDLE; lpLockStatus:LPQUERY_SERVICE_LOCK_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceLockStatusW';
+function RegisterServiceCtrlHandlerW(lpServiceName:LPCWSTR; lpHandlerProc:LPHANDLER_FUNCTION):SERVICE_STATUS_HANDLE; external 'advapi32' name 'RegisterServiceCtrlHandlerW';
+function StartServiceCtrlDispatcherW(lpServiceStartTable:LPSERVICE_TABLE_ENTRY):WINBOOL; external 'advapi32' name 'StartServiceCtrlDispatcherW';
+function StartServiceW(hService:SC_HANDLE; dwNumServiceArgs:DWORD; lpServiceArgVectors:LPCWSTR):WINBOOL; external 'advapi32' name 'StartServiceW';
+function DragQueryFileW(_para1:HDROP; _para2:cardinal; _para3:LPCWSTR; _para4:cardinal):cardinal; external 'shell32' name 'DragQueryFileW';
+function ExtractAssociatedIconW(_para1:HINST; _para2:LPCWSTR; _para3:LPWORD):HICON; external 'shell32' name 'ExtractAssociatedIconW';
+function ExtractIconW(_para1:HINST; _para2:LPCWSTR; _para3:cardinal):HICON; external 'shell32' name 'ExtractIconW';
+function FindExecutableW(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR):HINST; external 'shell32' name 'FindExecutableW';
+function ShellAboutW(_para1:HWND; _para2:LPCWSTR; _para3:LPCWSTR; _para4:HICON):longint; external 'shell32' name 'ShellAboutW';
+function ShellExecuteW(_para1:HWND; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPCWSTR; _para5:LPCWSTR;_para6:longint):HINST; external 'shell32' name 'ShellExecuteW';
+function Shell_NotifyIconW(dwMessage: DWORD; lpData: PNotifyIconDataA): BOOL; external 'shell32' name 'Shell_NotifyIconW';
+function DdeCreateStringHandleW(_para1:DWORD; _para2:LPCWSTR; _para3:longint):HSZ; external 'user32' name 'DdeCreateStringHandleW';
+function DdeInitializeW(_para1:LPDWORD; _para2:PFNCALLBACK; _para3:DWORD; _para4:DWORD):UINT; external 'user32' name 'DdeInitializeW';
+function DdeQueryStringW(_para1:DWORD; _para2:HSZ; _para3:LPCWSTR; _para4:DWORD; _para5:longint):DWORD; external 'user32' name 'DdeQueryStringW';
+function LogonUserW(_para1:LPWSTR; _para2:LPWSTR; _para3:LPWSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserW';
+function CreateProcessAsUserW(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCWSTR;
+ _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
+{$endif read_interface}
+
+
+{$ifdef read_implementation}
+
+function CreateWindowW(lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:longint;Y:longint; nWidth:longint; nHeight:longint; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
+begin
+ CreateWindowW:=CreateWindowExW(0,lpClassName,lpWindowName,dwStyle,x,y,nWidth,nHeight,hWndParent,hMenu,hInstance,lpParam);
+end;
+
+function CreateDialogW(hInstance:HINST; lpName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialogW:=CreateDialogParamW(hInstance,lpName,hWndParent,lpDialogFunc,0);
+end;
+
+function CreateDialogIndirectW(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
+begin
+ CreateDialogIndirectW:=CreateDialogIndirectParamW(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBoxW(hInstance:HINST; lpTemplate:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBoxW:=DialogBoxParamW(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+function DialogBoxIndirectW(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):longint;
+begin
+ DialogBoxIndirectW:=DialogBoxIndirectParamW(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
+end;
+
+{$endif read_implementation}
+
+{
+ $Log: unifun.inc,v $
+ Revision 1.14 2005/04/03 15:17:50 marco
+ * fix from bug 3861
+
+ Revision 1.13 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/winmouse.pp b/rtl/win32/winmouse.pp
new file mode 100644
index 0000000000..524d69e665
--- /dev/null
+++ b/rtl/win32/winmouse.pp
@@ -0,0 +1,205 @@
+{
+ $Id: winmouse.pp,v 1.7 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ This is unit implements a subset of the msmouse unit functionality
+ for the gui win32 graph unit implementation
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit winmouse;
+
+ interface
+ { initializes the mouse with the default values for the current screen mode }
+ Function InitMouse:Boolean;
+
+ { shows mouse pointer,text+graphics screen support }
+ Procedure ShowMouse;
+
+ { hides mouse pointer }
+ Procedure HideMouse;
+
+ { reads mouse position in pixels (divide by 8 to get text position in standard
+ text mode) and reads the buttons state:
+ bit 1 set -> left button pressed
+ bit 2 set -> right button pressed
+ bit 3 set -> middle button pressed
+ Have a look at the example program in the manual to see how you can use this }
+ Procedure GetMouseState(var x,y, buttons :Longint);
+
+ { returns true if the left button is pressed }
+ Function LPressed:Boolean;
+
+ { returns true if the right button is pressed }
+ Function RPressed:Boolean;
+
+ { returns true if the middle button is pressed }
+ Function MPressed:Boolean;
+
+(*!!!!! the following functions aren't implemented yet:
+ { positions the mouse pointer }
+ Procedure SetMousePos(x,y:Longint);
+
+ { returns at which position "button" was last pressed in x,y and returns the
+ number of times this button has been pressed since the last time this
+ function was called with "button" as parameter. For button you can use the
+ LButton, RButton and MButton constants for resp. the left, right and middle
+ button }
+ Function GetLastButtonPress(button:Longint;var x,y:Longint): Longint;
+
+ { returns at which position "button" was last released in x,y and returns the
+ number of times this button has been re since the last time. For button
+ you can use the LButton, RButton and MButton constants for resp. the left,
+ right and middle button
+ }
+ Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
+
+ { sets mouse's x range, with Min and Max resp. the higest and the lowest
+ column (in pixels) in between which the mouse cursor can move }
+ Procedure SetMouseXRange (Min,Max:Longint);
+
+ { sets mouse's y range, with Min and Max resp. the higest and the lowest
+ row (in pixels) in between which the mouse cursor can move}
+ Procedure SetMouseYRange (Min,Max:Longint);
+
+ { set the window coordinates in which the mouse cursor can move }
+ Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
+
+ { sets the mouse shape in text mode: background and foreground color and the
+ Ascii value with which the character on screen is XOR'ed when the cursor
+ moves over it. Set to 0 for a "transparent" cursor}
+ Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
+
+ { sets the mouse ascii in text mode. The difference between this one and
+ SetMouseShape, is that the foreground and background colors stay the same
+ and that the Ascii code you enter is the character that you will get on
+ screen; there's no XOR'ing }
+ Procedure SetMouseAscii(Ascii:Byte);
+
+ { set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16 }
+ Procedure SetMouseSpeed(Horizontal ,Vertical:Longint);
+
+ { set a rectangle on screen that mouse will disappear if it is moved into }
+ Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
+*)
+
+ Const
+ LButton = 1; { left button }
+ RButton = 2; { right button }
+ MButton = 4; { middle button }
+
+ Var
+ MouseFound: Boolean;
+
+ implementation
+
+ uses
+ windows,graph;
+
+ var
+ oldexitproc : pointer;
+ mousebuttonstate : byte;
+
+ function InitMouse : boolean;
+
+ begin
+ InitMouse:=MouseFound;
+ end;
+
+ procedure ShowMouse;
+
+ begin
+ Windows.ShowCursor(true);
+ end;
+
+ procedure HideMouse;
+
+ begin
+ Windows.ShowCursor(false);
+ end;
+
+ function msghandler(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
+
+ begin
+ { we catch the double click messages here too, }
+ { even if they never appear because the graph }
+ { windows doesn't have the cs_dblclks flags }
+ case amessage of
+ wm_lbuttondblclk,
+ wm_lbuttondown:
+ mousebuttonstate:=mousebuttonstate or LButton;
+ wm_rbuttondblclk,
+ wm_rbuttondown:
+ mousebuttonstate:=mousebuttonstate or RButton;
+ wm_mbuttondblclk,
+ wm_mbuttondown:
+ mousebuttonstate:=mousebuttonstate or MButton;
+ wm_lbuttonup:
+ mousebuttonstate:=mousebuttonstate and not(LButton);
+ wm_rbuttonup:
+ mousebuttonstate:=mousebuttonstate and not(RButton);
+ wm_mbuttonup:
+ mousebuttonstate:=mousebuttonstate and not(MButton);
+ end;
+ msghandler:=0;
+ end;
+
+ Function LPressed : Boolean;
+
+ begin
+ LPressed:=(mousebuttonstate and LButton)<>0;
+ end;
+
+ Function RPressed : Boolean;
+
+ begin
+ RPressed:=(mousebuttonstate and RButton)<>0;
+ end;
+
+ Function MPressed : Boolean;
+
+ begin
+ MPressed:=(mousebuttonstate and MButton)<>0;
+ end;
+
+ Procedure GetMouseState(var x,y,buttons : Longint);
+
+ var
+ pos : POINT;
+
+ begin
+ buttons:=mousebuttonstate;
+ GetCursorPos(@pos);
+ ScreenToClient(GraphWindow,@pos);
+ x:=pos.x;
+ y:=pos.y;
+ end;
+
+ procedure myexitproc;
+
+ begin
+ exitproc:=oldexitproc;
+ mousemessagehandler:=nil;
+ end;
+
+ begin
+ mousemessagehandler:=@msghandler;
+ oldexitproc:=exitproc;
+ exitproc:=@myexitproc;
+ mousebuttonstate:=0;
+ MouseFound:=GetSystemMetrics(SM_MOUSEPRESENT)<>0;
+ end.
+{
+ $Log: winmouse.pp,v $
+ Revision 1.7 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/winsock.pp b/rtl/win32/winsock.pp
new file mode 100644
index 0000000000..48d02fc253
--- /dev/null
+++ b/rtl/win32/winsock.pp
@@ -0,0 +1,920 @@
+{
+ $Id: winsock.pp,v 1.17 2005/04/03 11:33:08 marco Exp $
+ This file is part of the Free Pascal run time library.
+ This unit contains the declarations for the Win32 Socket Library
+
+ Copyright (c) 1999-2000 by Florian Klaempfl,
+ member of the Free Pascal development team.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$PACKRECORDS 1}
+unit winsock;
+{$ifndef VER0_99_14}
+{$ifndef NO_SMART_LINK}
+{$define support_smartlink}
+{$endif}
+{$endif}
+
+
+{$ifdef support_smartlink}
+{$smartlink on}
+{$endif}
+
+
+ interface
+
+ uses
+ windows;
+
+ const
+ {
+ Default maximium number of sockets.
+ this does not
+ mean that the underlying Windows Sockets implementation has to
+ support that many!
+ }
+ FD_SETSIZE = 64;
+
+ type
+ tOS_INT = LongInt;
+ tOS_UINT = DWord;
+ ptOS_INT = ^tOS_INT;
+ ptOS_UINT = ^tOS_UINT;
+ u_char = char;
+ u_short = word;
+ u_int = tOS_UINT;
+ u_long = dword;
+ pu_long = ^u_long;
+ plongint = ^longint;
+ TSocket = u_long;
+
+ { there is already a procedure called FD_SET, so this
+ record was renamed (FK) }
+ fdset = record
+ fd_count : u_int;
+ fd_array : array[0..(FD_SETSIZE)-1] of TSocket;
+ end;
+
+ TFDSet = fdset;
+ PFDSet = ^fdset;
+
+ timeval = record
+ tv_sec : longint;
+ tv_usec : longint;
+ end;
+
+ TTimeVal = timeval;
+ PTimeVal = ^TTimeVal;
+
+ { found no reference to this type in c header files and here. AlexS }
+ { minutes west of Greenwich }
+ { type of dst correction }
+ timezone = record
+ tz_minuteswest : longint;
+ tz_dsttime : longint;
+ end;
+ TTimeZone = timezone;
+ PTimeZone = ^TTimeZone;
+
+ const
+ IOCPARM_MASK = $7f;
+ IOC_VOID = $20000000;
+ IOC_OUT = $40000000;
+ IOC_IN = $80000000;
+ IOC_INOUT = IOC_IN or IOC_OUT;
+ FIONREAD =cardinal( IOC_OUT or
+ ((4 and IOCPARM_MASK) shl 16) or
+ (102 shl 8) or 127);
+ FIONBIO = cardinal(IOC_IN or
+ ((4 and IOCPARM_MASK) shl 16) or
+ (102 shl 8) or 126);
+ FIOASYNC = cardinal(IOC_IN or
+ ((4 and IOCPARM_MASK) shl 16) or
+ (102 shl 8) or 125);
+ {
+ Structures returned by network data base library, taken from the
+ BSD file netdb.h. All addresses are supplied in host order, and
+ returned in network order (suitable for use in system calls).
+ Slight modifications for differences between Linux and winsock.h
+ }
+ type
+ hostent = record
+ { official name of host }
+ h_name: pchar;
+ { alias list }
+ h_aliases: ^pchar;
+ { host address type }
+ h_addrtype: SmallInt;
+ { length of address }
+ h_length: SmallInt;
+ { list of addresses }
+ case byte of
+ 0: (h_addr_list: ^pchar);
+ 1: (h_addr: ^pchar)
+ end;
+ THostEnt = hostent;
+ PHostEnt = ^THostEnt;
+
+ {
+ Assumption here is that a network number
+ fits in an unsigned long -- someday that won't be true!
+ }
+ netent = record
+ { official name of net }
+ n_name : ^char;
+ { alias list }
+ n_aliases : ^pchar;
+ { net address type }
+ n_addrtype : SmallInt;
+ n_pad1 : SmallInt; { ensure right packaging }
+ { network # }
+ n_net : u_long;
+ end;
+ TNetEnt = netent;
+ PNetEnt = ^TNetEnt;
+
+ servent = record
+ { official service name }
+ s_name : ^char;
+ { alias list }
+ s_aliases : ^pchar;
+ { port # }
+ s_port : SmallInt;
+ n_pad1 : SmallInt; { ensure right packaging }
+ { protocol to use }
+ s_proto : ^char;
+ end;
+ TServEnt = servent;
+ PServEnt = ^TServEnt;
+
+ protoent = record
+ { official protocol name }
+ p_name : ^char;
+ { alias list }
+ p_aliases : ^pchar;
+ { protocol # }
+ p_proto : SmallInt;
+ p_pad1 : SmallInt; { ensure packaging }
+ end;
+ TProtoEnt = protoent;
+ PProtoEnt = ^TProtoEnt;
+
+ const
+ {
+ Standard well-known IP protocols.
+ For some reason there are differences between Linx and winsock.h
+ }
+ IPPROTO_IP = 0;
+ IPPROTO_ICMP = 1;
+ IPPROTO_IGMP = 2;
+ IPPROTO_GGP = 3;
+ IPPROTO_TCP = 6;
+ IPPORT_ECHO = 7;
+ IPPORT_DISCARD = 9;
+ IPPORT_SYSTAT = 11;
+ IPPROTO_PUP = 12;
+ IPPORT_DAYTIME = 13;
+ IPPORT_NETSTAT = 15;
+ IPPROTO_UDP = 17;
+ IPPROTO_IDP = 22;
+ IPPROTO_ND = 77;
+ IPPROTO_RAW = 255;
+ IPPROTO_MAX = 256;
+ IPPORT_FTP = 21;
+ IPPORT_TELNET = 23;
+ IPPORT_SMTP = 25;
+ IPPORT_TIMESERVER = 37;
+ IPPORT_NAMESERVER = 42;
+ IPPORT_WHOIS = 43;
+ IPPORT_MTP = 57;
+ IPPORT_TFTP = 69;
+ IPPORT_RJE = 77;
+ IPPORT_FINGER = 79;
+ IPPORT_TTYLINK = 87;
+ IPPORT_SUPDUP = 95;
+ IPPORT_EXECSERVER = 512;
+ IPPORT_LOGINSERVER = 513;
+ IPPORT_CMDSERVER = 514;
+ IPPORT_EFSSERVER = 520;
+ IPPORT_BIFFUDP = 512;
+ IPPORT_WHOSERVER = 513;
+ IPPORT_ROUTESERVER = 520;
+ IPPORT_RESERVED = 1024;
+
+ const
+ IMPLINK_IP = 155;
+ IMPLINK_LOWEXPER = 156;
+ IMPLINK_HIGHEXPER = 158;
+
+ type
+ SunB = packed record
+ s_b1,s_b2,s_b3,s_b4 : u_char;
+ end;
+
+ SunW = packed record
+ s_w1,s_w2 : u_short;
+ end;
+
+ in_addr = record
+ case integer of
+ 0 : (S_un_b : SunB);
+ 1 : (S_un_w : SunW);
+ 2 : (S_addr : u_long);
+ end;
+ TInAddr = in_addr;
+ PInAddr = ^TInAddr;
+
+ sockaddr_in = record
+ case integer of
+ 0 : ( (* equals to sockaddr_in, size is 16 byte *)
+ sin_family : SmallInt; (* 2 byte *)
+ sin_port : u_short; (* 2 byte *)
+ sin_addr : TInAddr; (* 4 byte *)
+ sin_zero : array[0..8-1] of char; (* 8 byte *)
+ );
+ 1 : ((* equals to sockaddr, size is 16 byte *)
+ sa_family : Smallint; (* 2 byte *)
+ sa_data : array[0..14-1] of char; (* 14 byte *)
+ );
+ end;
+ TSockAddrIn = sockaddr_in;
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddr = sockaddr_in;
+ PSockAddr = ^TSockAddr;
+
+ const
+ INADDR_ANY = $00000000;
+ INADDR_LOOPBACK = $7F000001;
+ INADDR_BROADCAST = $FFFFFFFF;
+
+ IN_CLASSA_NET = $ff000000;
+ IN_CLASSA_NSHIFT = 24;
+ IN_CLASSA_HOST = $00ffffff;
+ IN_CLASSA_MAX = 128;
+ IN_CLASSB_NET = $ffff0000;
+ IN_CLASSB_NSHIFT = 16;
+ IN_CLASSB_HOST = $0000ffff;
+ IN_CLASSB_MAX = 65536;
+ IN_CLASSC_NET = $ffffff00;
+ IN_CLASSC_NSHIFT = 8;
+ IN_CLASSC_HOST = $000000ff;
+ INADDR_NONE = $ffffffff;
+
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+
+ type
+ WSADATA = record
+ wVersion : WORD; { 2 byte, ofs 0 }
+ wHighVersion : WORD; { 2 byte, ofs 2 }
+ szDescription : array[0..(WSADESCRIPTION_LEN+1)-1] of char; { 257 byte, ofs 4 }
+ szSystemStatus : array[0..(WSASYS_STATUS_LEN+1)-1] of char; { 129 byte, ofs 261 }
+ iMaxSockets : word; { 2 byte, ofs 390 }
+ iMaxUdpDg : word; { 2 byte, ofs 392 }
+ pad1 : SmallInt; { 2 byte, ofs 394 } { ensure right packaging }
+ lpVendorInfo : pchar; { 4 byte, ofs 396 }
+ end; { total size 400 }
+ TWSAData = WSADATA;
+ PWSAData = TWSAData;
+
+ const
+ IP_OPTIONS = 1;
+ IP_MULTICAST_IF = 2;
+ IP_MULTICAST_TTL = 3;
+ IP_MULTICAST_LOOP = 4;
+ IP_ADD_MEMBERSHIP = 5;
+ IP_DROP_MEMBERSHIP = 6;
+ IP_DEFAULT_MULTICAST_TTL = 1;
+ IP_DEFAULT_MULTICAST_LOOP = 1;
+ IP_MAX_MEMBERSHIPS = 20;
+
+ type
+ ip_mreq = record
+ imr_multiaddr : in_addr;
+ imr_interface : in_addr;
+ end;
+
+ {
+ Definitions related to sockets: types, address families, options,
+ taken from the BSD file sys/socket.h.
+ }
+ const
+ INVALID_SOCKET = TSocket(not(1));
+ SOCKET_ERROR = -1;
+ SOCK_STREAM = 1;
+ SOCK_DGRAM = 2;
+ SOCK_RAW = 3;
+ SOCK_RDM = 4;
+ SOCK_SEQPACKET = 5;
+
+ { For setsockoptions(2) }
+ SO_DEBUG = $0001;
+ SO_ACCEPTCONN = $0002;
+ SO_REUSEADDR = $0004;
+ SO_KEEPALIVE = $0008;
+ SO_DONTROUTE = $0010;
+ SO_BROADCAST = $0020;
+ SO_USELOOPBACK = $0040;
+ SO_LINGER = $0080;
+ SO_OOBINLINE = $0100;
+ {
+ Additional options.
+ }
+ { send buffer size }
+ SO_SNDBUF = $1001;
+ { receive buffer size }
+ SO_RCVBUF = $1002;
+ { send low-water mark }
+ SO_SNDLOWAT = $1003;
+ { receive low-water mark }
+ SO_RCVLOWAT = $1004;
+ { send timeout }
+ SO_SNDTIMEO = $1005;
+ { receive timeout }
+ SO_RCVTIMEO = $1006;
+ { get error status and clear }
+ SO_ERROR = $1007;
+ { get socket type }
+ SO_TYPE = $1008;
+
+ {
+ Options for connect and disconnect data and options. Used only by
+ non-TCP/IP transports such as DECNet, OSI TP4, etc.
+ }
+ SO_CONNDATA = $7000;
+ SO_CONNOPT = $7001;
+ SO_DISCDATA = $7002;
+ SO_DISCOPT = $7003;
+ SO_CONNDATALEN = $7004;
+ SO_CONNOPTLEN = $7005;
+ SO_DISCDATALEN = $7006;
+ SO_DISCOPTLEN = $7007;
+
+ {
+ Option for opening sockets for synchronous access.
+ }
+ SO_OPENTYPE = $7008;
+ SO_SYNCHRONOUS_ALERT = $10;
+ SO_SYNCHRONOUS_NONALERT = $20;
+
+ {
+ Other NT-specific options.
+ }
+ SO_MAXDG = $7009;
+ SO_MAXPATHDG = $700A;
+ SO_UPDATE_ACCEPT_CONTEXT = $700B;
+ SO_CONNECT_TIME = $700C;
+
+ {
+ TCP options.
+ }
+ TCP_NODELAY = $0001;
+ TCP_BSDURGENT = $7000;
+
+ {
+ Address families.
+ }
+ { unspecified }
+ AF_UNSPEC = 0;
+ { local to host (pipes, portals) }
+ AF_UNIX = 1;
+ { internetwork: UDP, TCP, etc. }
+ AF_INET = 2;
+ { arpanet imp addresses }
+ AF_IMPLINK = 3;
+ { pup protocols: e.g. BSP }
+ AF_PUP = 4;
+ { mit CHAOS protocols }
+ AF_CHAOS = 5;
+ { IPX and SPX }
+ AF_IPX = 6;
+ { XEROX NS protocols }
+ AF_NS = 6;
+ { ISO protocols }
+ AF_ISO = 7;
+ { OSI is ISO }
+ AF_OSI = AF_ISO;
+ { european computer manufacturers }
+ AF_ECMA = 8;
+ { datakit protocols }
+ AF_DATAKIT = 9;
+ { CCITT protocols, X.25 etc }
+ AF_CCITT = 10;
+ { IBM SNA }
+ AF_SNA = 11;
+ { DECnet }
+ AF_DECnet = 12;
+ { Direct data link interface }
+ AF_DLI = 13;
+ { LAT }
+ AF_LAT = 14;
+ { NSC Hyperchannel }
+ AF_HYLINK = 15;
+ { AppleTalk }
+ AF_APPLETALK = 16;
+ { NetBios-style addresses }
+ AF_NETBIOS = 17;
+ { VoiceView }
+ AF_VOICEVIEW = 18;
+ { FireFox }
+ AF_FIREFOX = 19;
+ { Somebody is using this! }
+ AF_UNKNOWN1 = 20;
+ { Banyan }
+ AF_BAN = 21;
+
+ AF_MAX = 22;
+
+ type
+ {
+ Structure used by kernel to pass protocol
+ information in raw sockets.
+ }
+ sockproto = record
+ sp_family : u_short;
+ sp_protocol : u_short;
+ end;
+ TSockProto = sockproto;
+ PSockProto = ^TSockProto;
+
+ const
+ {
+ Protocol families, same as address families for now.
+ }
+ PF_UNSPEC = AF_UNSPEC;
+ PF_UNIX = AF_UNIX;
+ PF_INET = AF_INET;
+ PF_IMPLINK = AF_IMPLINK;
+ PF_PUP = AF_PUP;
+ PF_CHAOS = AF_CHAOS;
+ PF_NS = AF_NS;
+ PF_IPX = AF_IPX;
+ PF_ISO = AF_ISO;
+ PF_OSI = AF_OSI;
+ PF_ECMA = AF_ECMA;
+ PF_DATAKIT = AF_DATAKIT;
+ PF_CCITT = AF_CCITT;
+ PF_SNA = AF_SNA;
+ PF_DECnet = AF_DECnet;
+ PF_DLI = AF_DLI;
+ PF_LAT = AF_LAT;
+ PF_HYLINK = AF_HYLINK;
+ PF_APPLETALK = AF_APPLETALK;
+ PF_VOICEVIEW = AF_VOICEVIEW;
+ PF_FIREFOX = AF_FIREFOX;
+ PF_UNKNOWN1 = AF_UNKNOWN1;
+ PF_BAN = AF_BAN;
+ PF_MAX = AF_MAX;
+
+ type
+ {
+ Structure used for manipulating linger option.
+ }
+ linger = record
+ l_onoff : u_short;
+ l_linger : u_short;
+ end;
+ TLinger = linger;
+ PLinger = ^TLinger;
+
+ const
+ {
+ Level number for (get/set)sockopt() to apply to socket itself.
+ }
+ { options for socket level }
+ SOL_SOCKET = $ffff;
+ {
+ Maximum queue length specifiable by listen.
+ }
+ SOMAXCONN = 5;
+ { process out-of-band data }
+ MSG_OOB = $1;
+ { peek at incoming message }
+ MSG_PEEK = $2;
+ { send without using routing tables }
+ MSG_DONTROUTE = $4;
+ MSG_MAXIOVLEN = 16;
+ { partial send or recv for message xport }
+ MSG_PARTIAL = $8000;
+
+ {
+ Define constant based on rfc883, used by gethostbyxxxx() calls.
+ }
+ MAXGETHOSTSTRUCT = 1024;
+ MAXHOSTNAMELEN = MAXGETHOSTSTRUCT;
+
+ {
+ Define flags to be used with the WSAAsyncSelect() call.
+ }
+ FD_READ = $01;
+ FD_WRITE = $02;
+ FD_OOB = $04;
+ FD_ACCEPT = $08;
+ FD_CONNECT = $10;
+ FD_CLOSE = $20;
+
+ {
+ All Windows Sockets error constants are biased by WSABASEERR from
+ the "normal"
+ }
+ WSABASEERR = 10000;
+
+ {
+ Windows Sockets definitions of regular Microsoft C error constants
+ }
+ WSAEINTR = WSABASEERR + 4;
+ WSAEBADF = WSABASEERR + 9;
+ WSAEACCES = WSABASEERR + 13;
+ WSAEFAULT = WSABASEERR + 14;
+ WSAEINVAL = WSABASEERR + 22;
+ WSAEMFILE = WSABASEERR + 24;
+
+ {
+ Windows Sockets definitions of regular Berkeley error constants
+ }
+ WSAEWOULDBLOCK = WSABASEERR + 35;
+ WSAEINPROGRESS = WSABASEERR + 36;
+ WSAEALREADY = WSABASEERR + 37;
+ WSAENOTSOCK = WSABASEERR + 38;
+ WSAEDESTADDRREQ = WSABASEERR + 39;
+ WSAEMSGSIZE = WSABASEERR + 40;
+ WSAEPROTOTYPE = WSABASEERR + 41;
+ WSAENOPROTOOPT = WSABASEERR + 42;
+ WSAEPROTONOSUPPORT = WSABASEERR + 43;
+ WSAESOCKTNOSUPPORT = WSABASEERR + 44;
+ WSAEOPNOTSUPP = WSABASEERR + 45;
+ WSAEPFNOSUPPORT = WSABASEERR + 46;
+ WSAEAFNOSUPPORT = WSABASEERR + 47;
+ WSAEADDRINUSE = WSABASEERR + 48;
+ WSAEADDRNOTAVAIL = WSABASEERR + 49;
+ WSAENETDOWN = WSABASEERR + 50;
+ WSAENETUNREACH = WSABASEERR + 51;
+ WSAENETRESET = WSABASEERR + 52;
+ WSAECONNABORTED = WSABASEERR + 53;
+ WSAECONNRESET = WSABASEERR + 54;
+ WSAENOBUFS = WSABASEERR + 55;
+ WSAEISCONN = WSABASEERR + 56;
+ WSAENOTCONN = WSABASEERR + 57;
+ WSAESHUTDOWN = WSABASEERR + 58;
+ WSAETOOMANYREFS = WSABASEERR + 59;
+ WSAETIMEDOUT = WSABASEERR + 60;
+ WSAECONNREFUSED = WSABASEERR + 61;
+ WSAELOOP = WSABASEERR + 62;
+ WSAENAMETOOLONG = WSABASEERR + 63;
+ WSAEHOSTDOWN = WSABASEERR + 64;
+ WSAEHOSTUNREACH = WSABASEERR + 65;
+ WSAENOTEMPTY = WSABASEERR + 66;
+ WSAEPROCLIM = WSABASEERR + 67;
+ WSAEUSERS = WSABASEERR + 68;
+ WSAEDQUOT = WSABASEERR + 69;
+ WSAESTALE = WSABASEERR + 70;
+ WSAEREMOTE = WSABASEERR + 71;
+ WSAEDISCON = WSABASEERR + 101;
+
+ {
+ Extended Windows Sockets error constant definitions
+ }
+ WSASYSNOTREADY = WSABASEERR + 91;
+ WSAVERNOTSUPPORTED = WSABASEERR + 92;
+ WSANOTINITIALISED = WSABASEERR + 93;
+ {
+ Error return codes from gethostbyname() and gethostbyaddr()
+ (when using the resolver). Note that these errors are
+ retrieved via WSAGetLastError() and must therefore follow
+ the rules for avoiding clashes with error numbers from
+ specific implementations or language run-time systems.
+ For this reason the codes are based at WSABASEERR+1001.
+ Note also that [WSA]NO_ADDRESS is defined only for
+ compatibility purposes.
+ }
+ WSAHOST_NOT_FOUND = WSABASEERR + 1001;
+ HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
+ { Non-Authoritative: Host not found, or SERVERFAIL }
+ WSATRY_AGAIN = WSABASEERR + 1002;
+ TRY_AGAIN = WSATRY_AGAIN;
+
+ { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+ WSANO_RECOVERY = WSABASEERR + 1003;
+ NO_RECOVERY = WSANO_RECOVERY;
+
+ { Valid name, no data record of requested type }
+ WSANO_DATA = WSABASEERR + 1004;
+ NO_DATA = WSANO_DATA;
+
+ { no address, look for MX record }
+ WSANO_ADDRESS = WSANO_DATA;
+ NO_ADDRESS = WSANO_ADDRESS;
+
+ const
+ {
+ Windows Sockets errors redefined as regular Berkeley error constants.
+ }
+ EWOULDBLOCK = WSAEWOULDBLOCK;
+ EINPROGRESS = WSAEINPROGRESS;
+ EALREADY = WSAEALREADY;
+ ENOTSOCK = WSAENOTSOCK;
+ EDESTADDRREQ = WSAEDESTADDRREQ;
+ EMSGSIZE = WSAEMSGSIZE;
+ EPROTOTYPE = WSAEPROTOTYPE;
+ ENOPROTOOPT = WSAENOPROTOOPT;
+ EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
+ ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
+ EOPNOTSUPP = WSAEOPNOTSUPP;
+ EPFNOSUPPORT = WSAEPFNOSUPPORT;
+ EAFNOSUPPORT = WSAEAFNOSUPPORT;
+ EADDRINUSE = WSAEADDRINUSE;
+ EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
+ ENETDOWN = WSAENETDOWN;
+ ENETUNREACH = WSAENETUNREACH;
+ ENETRESET = WSAENETRESET;
+ ECONNABORTED = WSAECONNABORTED;
+ ECONNRESET = WSAECONNRESET;
+ ENOBUFS = WSAENOBUFS;
+ EISCONN = WSAEISCONN;
+ ENOTCONN = WSAENOTCONN;
+ ESHUTDOWN = WSAESHUTDOWN;
+ ETOOMANYREFS = WSAETOOMANYREFS;
+ ETIMEDOUT = WSAETIMEDOUT;
+ ECONNREFUSED = WSAECONNREFUSED;
+ ELOOP = WSAELOOP;
+ ENAMETOOLONG = WSAENAMETOOLONG;
+ EHOSTDOWN = WSAEHOSTDOWN;
+ EHOSTUNREACH = WSAEHOSTUNREACH;
+ ENOTEMPTY = WSAENOTEMPTY;
+ EPROCLIM = WSAEPROCLIM;
+ EUSERS = WSAEUSERS;
+ EDQUOT = WSAEDQUOT;
+ ESTALE = WSAESTALE;
+ EREMOTE = WSAEREMOTE;
+
+ TF_DISCONNECT = $01;
+ TF_REUSE_SOCKET = $02;
+ TF_WRITE_BEHIND = $04;
+
+ {
+ Options for use with [gs]etsockopt at the IP level.
+ }
+ IP_TTL = 7;
+ IP_TOS = 8;
+ IP_DONTFRAGMENT = 9;
+
+ type
+ _TRANSMIT_FILE_BUFFERS = record
+ Head : Pointer;
+ HeadLength : dword;
+ Tail : Pointer;
+ TailLength : dword;
+ end;
+ TRANSMIT_FILE_BUFFERS = _TRANSMIT_FILE_BUFFERS;
+ TTransmitFileBuffers = _TRANSMIT_FILE_BUFFERS;
+ PTransmitFileBuffers = ^TTransmitFileBuffers;
+
+ { Socket function prototypes }
+ const
+ winsockdll = 'wsock32.dll';
+
+{
+Winsock types all buffers as pchar (char *), modern POSIX does it the ANSI
+C way with pointer (void *). If the pointer overloaded version doesn't exist,
+a "pointer" will be passed to the "var" version. (bug 3142).
+So if there are var/const versions:
+- To keep ported unix code working, there must be "pointer" variants (ANSI)
+- To keep Delphi/ported C Winsock code working there must be pchar variants
+ (K&R)
+IOW, there _must_ be 3 versions then: var/const, pchar and pointer}
+
+ function accept(s:TSocket; addr: PSockAddr; addrlen : ptOS_INT) : TSocket;stdcall;external winsockdll name 'accept';
+ function accept(s:TSocket; addr: PSockAddr; var addrlen : tOS_INT) : TSocket;stdcall;external winsockdll name 'accept';
+ function bind(s:TSocket; addr: PSockaddr;namelen:tOS_INT):tOS_INT;stdcall;external winsockdll name 'bind';
+ function bind(s:TSocket; const addr: TSockaddr;namelen:tOS_INT):tOS_INT;stdcall;external winsockdll name 'bind';
+ function closesocket(s:TSocket):tOS_INT;stdcall;external winsockdll name 'closesocket';
+ function connect(s:TSocket; addr:PSockAddr; namelen:tOS_INT):tOS_INT;stdcall;external winsockdll name 'connect';
+ function connect(s:TSocket; Const name:TSockAddr; namelen:tOS_INT):tOS_INT;stdcall;external winsockdll name 'connect';
+ function ioctlsocket(s:TSocket; cmd:longint; var arg:u_long):tOS_INT;stdcall;external winsockdll name 'ioctlsocket'; { really a c-long }
+ function ioctlsocket(s:TSocket; cmd:longint; var arg:longint):tOS_INT;stdcall;external winsockdll name 'ioctlsocket'; { really a c-long }
+ function ioctlsocket(s:TSocket; cmd:longint; argp:pu_long):tOS_INT;stdcall;external winsockdll name 'ioctlsocket'; { really a c-long }
+ function getpeername(s:TSocket; var name:TSockAddr;var namelen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'getpeername';
+ function getsockname(s:TSocket; var name:TSockAddr;var namelen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'getsockname';
+ function getsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT;optval:pchar;var optlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'getsockopt';
+ function getsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT;optval:pointer;var optlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'getsockopt';
+ function getsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT;var optval;var optlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'getsockopt';
+ function htonl(hostlong:u_long):u_long;stdcall;external winsockdll name 'htonl';
+ function htons(hostshort:u_short):u_short;stdcall;external winsockdll name 'htons';
+ function inet_addr(cp:pchar):cardinal;stdcall;external winsockdll name 'inet_addr';
+ function inet_ntoa(i : TInAddr):pchar;stdcall;external winsockdll name 'inet_ntoa';
+ function listen(s:TSocket; backlog:tOS_INT):tOS_INT;stdcall;external winsockdll name 'listen';
+ function ntohl(netlong:u_long):u_long;stdcall;external winsockdll name 'ntohl';
+ function ntohs(netshort:u_short):u_short;stdcall;external winsockdll name 'ntohs';
+ function recv(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT):tOS_INT;stdcall;external winsockdll name 'recv';
+ function recv(s:TSocket;buf:pointer; len:tOS_INT; flags:tOS_INT):tOS_INT;stdcall;external winsockdll name 'recv';
+ function recv(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT):tOS_INT;stdcall;external winsockdll name 'recv';
+ function recvfrom(s:TSocket;buf:pchar; len:tOS_INT; flags:tOS_INT;from:PSockAddr; fromlen:ptOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'recvfrom';
+ function recvfrom(s:TSocket;buf:pointer; len:tOS_INT; flags:tOS_INT;from:PSockAddr; fromlen:ptOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'recvfrom';
+ function recvfrom(s:TSocket;var buf; len:tOS_INT; flags:tOS_INT;Const from:TSockAddr; var fromlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'recvfrom';
+ function select(nfds:tOS_INT; readfds,writefds,exceptfds : PFDSet;timeout: PTimeVal):tOS_INT;stdcall;
+ external winsockdll name 'select';
+ function send(s:TSocket;Const buf; len:tOS_INT; flags:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'send';
+ function send(s:TSocket; buf:pchar; len:tOS_INT; flags:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'send';
+ function send(s:TSocket;buf:pointer; len:tOS_INT; flags:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'send';
+ function sendto(s:TSocket; buf:pchar; len:tOS_INT; flags:tOS_INT;toaddr:PSockAddr; tolen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'sendto';
+ function sendto(s:TSocket; buf:pointer; len:tOS_INT; flags:tOS_INT;toaddr:PSockAddr; tolen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'sendto';
+ function sendto(s:TSocket; Const buf; len:tOS_INT; flags:tOS_INT;Const toaddr:TSockAddr; tolen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'sendto';
+ function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; optval:pchar; optlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'setsockopt';
+ function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT;optval:pointer; optlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'setsockopt';
+ function setsockopt(s:TSocket; level:tOS_INT; optname:tOS_INT; Const optval; optlen:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'setsockopt';
+ function shutdown(s:TSocket; how:tOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'shutdown';
+ function socket(af:tOS_INT; t:tOS_INT; protocol:tOS_INT):TSocket;stdcall;
+ external winsockdll name 'socket';
+
+ { Database function prototypes }
+ function gethostbyaddr(addr:pchar; len:tOS_INT; t:tOS_INT): PHostEnt;stdcall;external winsockdll name 'gethostbyaddr';
+ function gethostbyname(name:pchar):PHostEnt;stdcall;external winsockdll name 'gethostbyname';
+ function gethostname(name:pchar; namelen:tOS_INT):tOS_INT;stdcall;external winsockdll name 'gethostname';
+ function getservbyport(port:tOS_INT; proto:pchar):PServEnt;stdcall;external winsockdll name 'getservbyport';
+ function getservbyname(name:pchar; proto:pchar):PServEnt;stdcall;external winsockdll name 'getservbyname';
+ function getprotobynumber(proto:tOS_INT):PProtoEnt;stdcall;external winsockdll name 'getprotobynumber';
+ function getprotobyname(name:pchar):PProtoEnt;stdcall;external winsockdll name 'getprotobyname';
+
+ { Microsoft Windows Extension function prototypes }
+ function WSAStartup(wVersionRequired:word;var WSAData:TWSADATA):tOS_INT;stdcall;
+ external winsockdll name 'WSAStartup';
+ function WSACleanup:tOS_INT;stdcall;external winsockdll name 'WSACleanup';
+ procedure WSASetLastError(iError:tOS_INT);stdcall;external winsockdll name 'WSASetLastError';
+ function WSAGetLastError:tOS_INT;stdcall;external winsockdll name 'WSAGetLastError';
+ function WSAIsBlocking:BOOL;stdcall;external winsockdll name 'WSAIsBlocking';
+ function WSAUnhookBlockingHook:tOS_INT;stdcall;external winsockdll name 'WSAUnhookBlockingHook';
+ function WSASetBlockingHook(lpBlockFunc:TFarProc):TFarProc;stdcall;external winsockdll name 'WSASetBlockingHook';
+ function WSACancelBlockingCall:tOS_INT;stdcall;external winsockdll name 'WSACancelBlockingCall';
+ function WSAAsyncGetServByName(hWnd:HWND; wMsg:u_int; name:pchar; proto:pchar; buf:pchar;
+ buflen:tOS_INT):THandle;stdcall;external winsockdll name 'WSAAsyncGetServByName';
+ function WSAAsyncGetServByPort(hWnd:HWND; wMsg:u_int; port:tOS_INT; proto:pchar; buf:pchar;
+ buflen:tOS_INT):THandle;stdcall;external winsockdll name 'WSAAsyncGetServByPort';
+ function WSAAsyncGetProtoByName(hWnd:HWND; wMsg:u_int; name:pchar; buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetProtoByName';
+ function WSAAsyncGetProtoByNumber(hWnd:HWND; wMsg:u_int; number:tOS_INT; buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetProtoByNumber';
+ function WSAAsyncGetHostByName(hWnd:HWND; wMsg:u_int; name:pchar; buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetHostByName';
+ function WSAAsyncGetHostByAddr(hWnd:HWND; wMsg:u_int; addr:pchar; len:tOS_INT; t:tOS_INT;
+ buf:pchar; buflen:tOS_INT):THandle;stdcall;
+ external winsockdll name 'WSAAsyncGetHostByAddr';
+ function WSACancelAsyncRequest(hAsyncTaskHandle:THandle):tOS_INT;stdcall;
+ external winsockdll name 'WSACancelAsyncRequest';
+ function WSAAsyncSelect(s:TSocket; hWnd:HWND; wMsg:u_int; lEvent:longint):tOS_INT;stdcall; { really a c-long }
+ external winsockdll name 'WSAAsyncSelect';
+ function WSARecvEx(s:TSocket;var buf; len:tOS_INT; flags:ptOS_INT):tOS_INT;stdcall;
+ external winsockdll name 'WSARecvEx';
+ function __WSAFDIsSet(s:TSocket; var FDSet:TFDSet):Bool;stdcall;
+ external winsockdll name '__WSAFDIsSet';
+ function __WSAFDIsSet_(s:TSocket; var FDSet:TFDSet):tOS_INT;stdcall;
+ external winsockdll name '__WSAFDIsSet';
+ function TransmitFile(hSocket:TSocket; hFile:THandle; nNumberOfBytesToWrite:dword;
+ nNumberOfBytesPerSend:DWORD; lpOverlapped:POverlapped;
+ lpTransmitBuffers:PTransmitFileBuffers; dwReserved:dword):Bool;stdcall;
+ external winsockdll name 'TransmitFile';
+
+ function AcceptEx(sListenSocket,sAcceptSocket:TSocket;
+ lpOutputBuffer:Pointer; dwReceiveDataLength,dwLocalAddressLength,
+ dwRemoteAddressLength:dword; var lpdwBytesReceived:dword;
+ lpOverlapped:POverlapped):Bool;stdcall;
+ external winsockdll name 'AcceptEx';
+
+ procedure GetAcceptExSockaddrs(lpOutputBuffer:Pointer;
+ dwReceiveDataLength,dwLocalAddressLength,dwRemoteAddressLength:dword;
+ var LocalSockaddr:PSockAddr; var LocalSockaddrLength:tOS_INT;
+ var RemoteSockaddr:PSockAddr; var RemoteSockaddrLength:tOS_INT);stdcall;
+ external winsockdll name 'GetAcceptExSockaddrs';
+
+ function WSAMakeSyncReply(Buflen,Error:Word):dword;
+ function WSAMakeSelectReply(Event,Error:Word):dword;
+ function WSAGetAsyncBuflen(Param:dword):Word;
+ function WSAGetAsyncError(Param:dword):Word;
+ function WSAGetSelectEvent(Param:dword):Word;
+ function WSAGetSelectError(Param:dword):Word;
+ procedure FD_CLR(Socket:TSocket; var FDSet:TFDSet);
+ function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean;
+ procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
+ procedure FD_ZERO(var FDSet:TFDSet);
+
+ implementation
+
+ {
+ Implementation of the helper routines
+ }
+ function WSAMakeSyncReply(Buflen,Error:Word):dword;
+
+ begin
+ WSAMakeSyncReply:=MakeLong(Buflen, Error);
+ end;
+
+ function WSAMakeSelectReply(Event,Error:Word):dword;
+
+ begin
+ WSAMakeSelectReply:=MakeLong(Event,Error);
+ end;
+
+ function WSAGetAsyncBuflen(Param:dword):Word;
+
+ begin
+ WSAGetAsyncBuflen:=lo(Param);
+ end;
+
+ function WSAGetAsyncError(Param:dword):Word;
+
+ begin
+ WSAGetAsyncError:=hi(Param);
+ end;
+
+ function WSAGetSelectEvent(Param:dword):Word;
+
+ begin
+ WSAGetSelectEvent:=lo(Param);
+ end;
+
+ function WSAGetSelectError(Param:dword):Word;
+
+ begin
+ WSAGetSelectError:=hi(Param);
+ end;
+
+ procedure FD_CLR(Socket:TSocket; var FDSet:TFDSet);
+
+ var
+ i : u_int;
+
+ begin
+ i:=0;
+ while i<FDSet.fd_count do
+ begin
+ if FDSet.fd_array[i]=Socket then
+ begin
+ while i<FDSet.fd_count-1 do
+ begin
+ FDSet.fd_array[i]:=FDSet.fd_array[i+1];
+ inc(i);
+ end;
+ dec(FDSet.fd_count);
+ break;
+ end;
+ inc(i);
+ end;
+ end;
+
+ function FD_ISSET(Socket:TSocket; var FDSet:TFDSet):Boolean;
+
+ begin
+ FD_ISSET:=__WSAFDIsSet(Socket,FDSet);
+ end;
+
+ procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
+
+ begin
+ if FDSet.fd_count<FD_SETSIZE then
+ begin
+ FDSet.fd_array[FDSet.fd_count]:=Socket;
+ Inc(FDSet.fd_count);
+ end;
+ end;
+
+ procedure FD_ZERO(var FDSet:TFDSet);
+
+ begin
+ FDSet.fd_count:=0;
+ end;
+
+end.
+{
+ $Log: winsock.pp,v $
+ Revision 1.17 2005/04/03 11:33:08 marco
+ * some constants changed to unsigned to avoid warnings (bug 3817)
+
+ Revision 1.16 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/win32/winsysut.pp b/rtl/win32/winsysut.pp
new file mode 100644
index 0000000000..ea3d938b7f
--- /dev/null
+++ b/rtl/win32/winsysut.pp
@@ -0,0 +1,88 @@
+{
+ $Id: winsysut.pp,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by the Free Pascal development team
+
+ Windows specific versions of Borland SysUtils routines.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+unit winsysut;
+
+Interface
+
+Uses Windows,SysUtils;
+
+const
+ Win32Platform : Integer = 0;
+ Win32MajorVersion : Integer = 0;
+ Win32MinorVersion : Integer = 0;
+ Win32BuildNumber : Integer = 0;
+
+ Win32CSDVersion : string = '';
+
+function CheckWin32Version(Major,Minor : Integer ): Boolean;
+function CheckWin32Version(Major : Integer): Boolean;
+Function Win32Check(RetVal: BOOL): BOOL;
+Procedure RaiseLastWin32Error;
+
+Implementation
+
+procedure RaiseLastWin32Error;
+
+begin
+ RaiseLastOSError;
+end;
+
+Function Win32Check(RetVal: BOOL): BOOL;
+
+begin
+ if Not RetVal then
+ RaiseLastOSError;
+ Result := RetVal;
+end;
+
+procedure InitVersion;
+
+var
+ Info: TOSVersionInfo;
+
+begin
+ Info.dwOSVersionInfoSize := SizeOf(Info);
+ if GetVersionEx(Info) then
+ with Info do
+ begin
+ Win32Platform:=dwPlatformId;
+ Win32MajorVersion:=dwMajorVersion;
+ Win32MinorVersion:=dwMinorVersion;
+ if (Win32Platform=VER_PLATFORM_WIN32_WINDOWS) then
+ Win32BuildNumber:=dwBuildNumber and $FFFF
+ else
+ Win32BuildNumber := dwBuildNumber;
+ Win32CSDVersion := StrPas(szCSDVersion);
+ end;
+end;
+
+function CheckWin32Version(Major : Integer): Boolean;
+
+begin
+ Result:=CheckWin32Version(Major,0)
+end;
+
+function CheckWin32Version(Major,Minor: Integer): Boolean;
+
+begin
+ Result := (Win32MajorVersion>Major) or
+ ((Win32MajorVersion=Major) and (Win32MinorVersion>=Minor));
+end;
+
+Initialization
+ InitVersion;
+end.
diff --git a/rtl/win32/wprt0.as b/rtl/win32/wprt0.as
new file mode 100644
index 0000000000..99412e576f
--- /dev/null
+++ b/rtl/win32/wprt0.as
@@ -0,0 +1,68 @@
+//Startup code for WIN32 port of Free Pascal
+//Written by P.Ozerski 1998
+// modified by Pierre Muller
+ .text
+ .globl _mainCRTStartup
+_mainCRTStartup:
+ movb $1,U_SYSTEM_ISCONSOLE
+ call _FPC_EXE_Entry
+ .globl _WinMainCRTStartup
+_WinMainCRTStartup:
+ movb $0,U_SYSTEM_ISCONSOLE
+ call _FPC_EXE_Entry
+
+ .globl asm_exit
+asm_exit:
+ pushl %eax
+ call exitprocess
+
+.text
+.globl exitprocess
+exitprocess:
+ jmp *.L10
+ .balign 4,144
+
+.text
+ .balign 4,144
+
+.section .idata$2
+ .rva .L7
+ .long 0,0
+ .rva .L6
+ .rva .L8
+
+.section .idata$4
+.L7:
+ .rva .L9
+ .long 0
+
+.section .idata$5
+.L8:
+
+
+.section .idata$5
+.L10:
+ .rva .L9
+ .long 0
+
+.section .idata$6
+.L9:
+ .short 0
+ .ascii "ExitProcess\000"
+ .balign 2,0
+
+.section .idata$7
+.L6:
+ .ascii "kernel32.dll\000"
+
+
+
+// $Log: wprt0.as,v $
+// Revision 1.4 2002/11/30 18:17:35 carl
+// + profiling support
+//
+// Revision 1.3 2002/07/28 20:43:51 florian
+// * several fixes for linux/powerpc
+// * several fixes to MT
+//
+//
diff --git a/rtl/win32/wprt0_10.as b/rtl/win32/wprt0_10.as
new file mode 100644
index 0000000000..ea185f120c
--- /dev/null
+++ b/rtl/win32/wprt0_10.as
@@ -0,0 +1,57 @@
+//Startup code for WIN32 port of FPK-Pascal 0.9.98
+//Written by P.Ozerski
+//1998
+// modified by Pierre Muller
+ .text
+ .globl _mainCRTStartup
+_mainCRTStartup:
+ movb $1,U_SYSWIN32_ISCONSOLE
+ call _FPC_EXE_Entry
+ .globl _WinMainCRTStartup
+_WinMainCRTStartup:
+ movb $0,U_SYSWIN32_ISCONSOLE
+ call _FPC_EXE_Entry
+
+ .globl asm_exit
+asm_exit:
+ pushl %eax
+ call exitprocess
+
+.text
+.globl exitprocess
+exitprocess:
+ jmp *.L10
+ .balign 4,144
+
+.text
+ .balign 4,144
+
+.section .idata$2
+ .rva .L7
+ .long 0,0
+ .rva .L6
+ .rva .L8
+
+.section .idata$4
+.L7:
+ .rva .L9
+ .long 0
+
+.section .idata$5
+.L8:
+
+
+.section .idata$5
+.L10:
+ .rva .L9
+ .long 0
+
+.section .idata$6
+.L9:
+ .short 0
+ .ascii "ExitProcess\000"
+ .balign 2,0
+
+.section .idata$7
+.L6:
+ .ascii "kernel32.dll\000"
diff --git a/rtl/x86_64/int64p.inc b/rtl/x86_64/int64p.inc
new file mode 100644
index 0000000000..38404c0475
--- /dev/null
+++ b/rtl/x86_64/int64p.inc
@@ -0,0 +1,18 @@
+{
+ $Id: int64p.inc,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ This file contains some helper routines for int64 and qword
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{ only dummy on x86-64 since it has a 64 bit integer unit }
+{
+ $Log}
diff --git a/rtl/x86_64/makefile.cpu b/rtl/x86_64/makefile.cpu
new file mode 100644
index 0000000000..b05ce29c9c
--- /dev/null
+++ b/rtl/x86_64/makefile.cpu
@@ -0,0 +1,13 @@
+# $Id: makefile.cpu,v 1.1 2003/01/06 19:40:18 florian Exp $
+#
+# Here we set processor dependent include file names.
+#
+
+CPUNAMES=x86_64
+CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES))
+#
+# $Log: makefile.cpu,v $
+# Revision 1.1 2003/01/06 19:40:18 florian
+# + initial revision
+#
+#
diff --git a/rtl/x86_64/math.inc b/rtl/x86_64/math.inc
new file mode 100644
index 0000000000..bfe49a35ee
--- /dev/null
+++ b/rtl/x86_64/math.inc
@@ -0,0 +1,302 @@
+{
+ $Id: math.inc,v 1.10 2005/04/25 09:40:27 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2001 by the Free Pascal development team
+
+ Implementation of mathematical routines (for extended type)
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{****************************************************************************
+ FPU Control word
+ ****************************************************************************}
+
+ procedure Set8087CW(cw:word);assembler;
+ asm
+ movw cw,%ax
+{$ifdef FPC_PIC}
+ movq default8087cw@GOTPCREL(%rip),%rax
+ movw %ax,(%rax)
+ fnclex
+ fldcw (%rax)
+{$else FPC_PIC}
+ movw %ax,default8087cw
+ fnclex
+ fldcw default8087cw
+{$endif FPC_PIC}
+ end;
+
+ function Get8087CW:word;assembler;
+ asm
+ pushq $0
+ fnstcw (%rsp)
+ popq %rax
+ end;
+
+{****************************************************************************
+ EXTENDED data type routines
+ ****************************************************************************}
+
+{$ifdef INTERNCONSTINTF}
+ {$define FPC_SYSTEM_HAS_PI}
+ function fpc_pi_real : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_ABS}
+ function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SQR}
+ function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_ARCTAN}
+ function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_LN}
+ function fpc_ln_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_SIN}
+ function fpc_sin_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+ {$define FPC_SYSTEM_HAS_COS}
+ function fpc_cos_real(d : ValReal) : ValReal;compilerproc;
+ begin
+ { Function is handled internal in the compiler }
+ runerror(207);
+ result:=0;
+ end;
+{$else}
+ {$define FPC_SYSTEM_HAS_PI}
+ function pi : ValReal;[internproc:fpc_in_pi];
+ {$define FPC_SYSTEM_HAS_ABS}
+ function abs(d : ValReal) : ValReal;[internproc:fpc_in_abs_real];
+ {$define FPC_SYSTEM_HAS_SQR}
+ function sqr(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
+ {$define FPC_SYSTEM_HAS_SQRT}
+ function sqrt(d : ValReal) : ValReal;[internproc:fpc_in_sqrt_real];
+ {$define FPC_SYSTEM_HAS_ARCTAN}
+ function arctan(d : ValReal) : ValReal;[internproc:fpc_in_arctan_real];
+ {$define FPC_SYSTEM_HAS_LN}
+ function ln(d : ValReal) : ValReal;[internproc:fpc_in_ln_real];
+ {$define FPC_SYSTEM_HAS_SIN}
+ function sin(d : ValReal) : ValReal;[internproc:fpc_in_sin_real];
+ {$define FPC_SYSTEM_HAS_COS}
+ function cos(d : ValReal) : ValReal;[internproc:fpc_in_cos_real];
+{$endif}
+
+ {$define FPC_SYSTEM_HAS_EXP}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc;
+ {$else}
+ function exp(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_exp];
+ {$endif}
+ asm
+ // comes from DJ GPP
+ fldt d
+ fldl2e
+ fmulp %st,%st(1)
+ fstcw .LCW1
+ fstcw .LCW2
+ andw $0xf3ff,.LCW2
+ orw $0x0400,.LCW2
+ fldcw .LCW2
+ fld %st(0)
+ frndint
+ fldcw .LCW1
+ fxch %st(1)
+ fsub %st(1),%st
+ f2xm1
+ fld1
+ faddp %st,%st(1)
+ fscale
+ fstp %st(1)
+ jmp .LCW3
+ // store some help data in the data segment
+ .data
+ .LCW1:
+ .word 0
+ .LCW2:
+ .word 0
+ .text
+ .LCW3:
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_FRAC}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_frac_real(d : ValReal) : ValReal;assembler;compilerproc;
+ {$else}
+ function frac(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_frac];
+ {$endif}
+ asm
+ subq $16,%rsp
+ fnstcw -4(%rbp)
+ fwait
+ movw -4(%rbp),%cx
+ orw $0x0c3f,%cx
+ movw %cx,-8(%rbp)
+ fldcw -8(%rbp)
+ fwait
+ fldt d
+ frndint
+ fldt d
+ fsub %st(1),%st
+ fstp %st(1)
+ fnclex
+ fldcw -4(%rbp)
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_INT}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_int_real(d : ValReal) : ValReal;assembler;compilerproc;
+ {$else}
+ function int(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_int];
+ {$endif}
+ asm
+ subq $16,%rsp
+ fnstcw -4(%rbp)
+ fwait
+ movw -4(%rbp),%cx
+ orw $0x0c3f,%cx
+ movw %cx,-8(%rbp)
+ fldcw -8(%rbp)
+ fwait
+ fldt d
+ frndint
+ fnclex
+ fldcw -4(%rbp)
+ end;
+
+
+
+ {$define FPC_SYSTEM_HAS_TRUNC}
+ {$ifdef INTERNCONSTINTF}
+ function fpc_trunc_real(d : ValReal) : int64;assembler;compilerproc;
+ {$else}
+ function trunc(d : ValReal) : int64;assembler;[internconst:fpc_in_const_trunc];
+ {$endif}
+ var
+ oldcw,
+ newcw : word;
+ res : int64;
+ asm
+ fnstcw oldcw
+ fwait
+ movw oldcw,%cx
+ orw $0x0c3f,%cx
+ movw %cx,newcw
+ fldcw newcw
+ fwait
+ fldt d
+ fistpq res
+ movq res,%rax
+ fnclex
+ fldcw oldcw
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_ROUND}
+{$ifdef internconstintf}
+ function fpc_round_real(d : ValReal) : int64;assembler;compilerproc;
+{$else}
+ {$ifdef hascompilerproc}
+ function round(d : extended) : int64;[internconst:fpc_in_const_round, external name 'FPC_ROUND'];
+
+ function fpc_round(d : extended) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+ {$else}
+ function round(d : extended) : int64;assembler;[internconst:fpc_in_const_round];
+ {$endif hascompilerproc}
+{$endif}
+ var
+ oldcw,
+ newcw : word;
+ res : int64;
+ asm
+ fnstcw oldcw
+ fwait
+ movw $0x1372,newcw
+ fnclex
+ fldcw newcw
+ fwait
+ fldt d
+ fistpq res
+ movq res,%rax
+ fnclex
+ fldcw oldcw
+ end;
+
+
+ {$define FPC_SYSTEM_HAS_POWER}
+ function power(bas,expo : extended) : extended;
+ begin
+ if bas=0 then
+ begin
+ if expo<>0 then
+ power:=0.0
+ else
+ HandleError(207);
+ end
+ else if expo=0 then
+ power:=1
+ else
+ { bas < 0 is not allowed }
+ if bas<0 then
+ handleerror(207)
+ else
+ power:=exp(ln(bas)*expo);
+ end;
+
+{
+ $Log: math.inc,v $
+ Revision 1.10 2005/04/25 09:40:27 florian
+ * some ifdef'ed pic code
+
+ Revision 1.9 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.8 2005/01/30 18:41:53 peter
+ * add fnclex before loading old CW
+
+ Revision 1.7 2005/01/30 18:01:15 peter
+ * signal cleanup for linux
+ * sigactionhandler instead of tsigaction for bsds
+ * sigcontext moved to cpu dir
+
+}
diff --git a/rtl/x86_64/mathu.inc b/rtl/x86_64/mathu.inc
new file mode 100644
index 0000000000..8e37fa1aee
--- /dev/null
+++ b/rtl/x86_64/mathu.inc
@@ -0,0 +1,104 @@
+{
+ $Id: mathu.inc,v 1.3 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+{$define FPC_MATH_HAS_ARCTAN2}
+function arctan2(y,x : float) : float;assembler;
+ asm
+ fldt y
+ fldt x
+ fpatan
+ fwait
+ end;
+
+
+procedure SetSSECSR(w : dword);
+ var
+ _w : dword;
+ begin
+ _w:=w;
+ asm
+ ldmxcsr _w
+ end;
+ end;
+
+
+function GetSSECSR : dword;
+ var
+ _w : dword;
+ begin
+ asm
+ stmxcsr _w
+ end;
+ result:=_w;
+ end;
+
+
+function GetRoundMode: TFPURoundingMode;
+begin
+ Result := TFPURoundingMode((Get8087CW shr 10) and 3);
+end;
+
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+var
+ CtlWord: Word;
+begin
+ CtlWord := Get8087CW;
+ Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
+ Result := TFPURoundingMode((CtlWord shr 10) and 3);
+end;
+
+function GetPrecisionMode: TFPUPrecisionMode;
+begin
+ Result := TFPUPrecisionMode((Get8087CW shr 8) and 3);
+end;
+
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+var
+ CtlWord: Word;
+begin
+ CtlWord := Get8087CW;
+ Set8087CW((CtlWord and $FCFF) or (Ord(Precision) shl 8));
+ Result := TFPUPrecisionMode((CtlWord shr 8) and 3);
+end;
+
+function GetExceptionMask: TFPUExceptionMask;
+begin
+ Result := TFPUExceptionMask(dword(Get8087CW and $3F));
+end;
+
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+var
+ CtlWord: Word;
+begin
+ CtlWord := Get8087CW;
+ Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
+ Result := TFPUExceptionMask(dword(CtlWord and $3F));
+end;
+
+procedure ClearExceptions(RaisePending: Boolean);assembler;
+asm
+ cmpb $0,RaisePending
+ je .Lclear
+ fwait
+.Lclear:
+ fnclex
+end;
+
+{
+ $Log: mathu.inc,v $
+ Revision 1.3 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/mathuh.inc b/rtl/x86_64/mathuh.inc
new file mode 100644
index 0000000000..5658747812
--- /dev/null
+++ b/rtl/x86_64/mathuh.inc
@@ -0,0 +1,41 @@
+{
+ $Id: mathuh.inc,v 1.3 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2004 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ x86-64 fpu control word }
+type
+ TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
+ TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);
+ TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
+ exOverflow, exUnderflow, exPrecision);
+ TFPUExceptionMask = set of TFPUException;
+
+function GetRoundMode: TFPURoundingMode;
+function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
+function GetPrecisionMode: TFPUPrecisionMode;
+function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode;
+function GetExceptionMask: TFPUExceptionMask;
+function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
+procedure ClearExceptions(RaisePending: Boolean {$ifndef VER1_0}=true{$endif});
+
+
+procedure SetSSECSR(w : dword);
+function GetSSECSR : dword;
+
+{
+ $Log: mathuh.inc,v $
+ Revision 1.3 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/set.inc b/rtl/x86_64/set.inc
new file mode 100644
index 0000000000..446e69f086
--- /dev/null
+++ b/rtl/x86_64/set.inc
@@ -0,0 +1,22 @@
+{
+ $Id: set.inc,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by the Free Pascal development team
+
+ Include file with set operations called by the compiler
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{
+ $Log: set.inc,v $
+ Revision 1.2 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/setjump.inc b/rtl/x86_64/setjump.inc
new file mode 100644
index 0000000000..210a1214ff
--- /dev/null
+++ b/rtl/x86_64/setjump.inc
@@ -0,0 +1,59 @@
+{
+ $Id: setjump.inc,v 1.6 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Florian Klaempfl and other members of the
+ Free Pascal development team
+
+ SetJmp and LongJmp implementation for exception handling
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP'];nostackframe;
+ asm
+ // Save registers.
+ movq %rbx,(%rdi)
+ movq %rbp,8(%rdi)
+ movq %r12,16(%rdi)
+ movq %r13,24(%rdi)
+ movq %r14,32(%rdi)
+ movq %r15,40(%rdi)
+ leaq 8(%rsp),%rdx // Save SP as it will be after we return.
+ movq %rdx,48(%rdi)
+ movq 0(%rsp),%rsi // Save PC we are returning to now.
+ movq %rsi,56(%rdi)
+ xorq %rax,%rax
+ end;
+
+
+procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP'];
+ asm
+ // Restore registers.
+ movq (%rdi),%rbx
+ movq 8(%rdi),%rbp
+ movq 16(%rdi),%r12
+ movq 24(%rdi),%r13
+ movq 32(%rdi),%r14
+ movq 40(%rdi),%r15
+ // Set return value for setjmp.
+ test %esi,%esi
+ mov $01,%eax
+ cmove %eax,%esi
+ mov %esi,%eax
+ movq 56(%rdi),%rdx
+ movq 48(%rdi),%rsp
+ jmpq *%rdx
+ end;
+
+{
+ $Log: setjump.inc,v $
+ Revision 1.6 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/setjumph.inc b/rtl/x86_64/setjumph.inc
new file mode 100644
index 0000000000..0ad5eedb53
--- /dev/null
+++ b/rtl/x86_64/setjumph.inc
@@ -0,0 +1,32 @@
+{
+ $Id: setjumph.inc,v 1.3 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2000-2002 by Jonas Maebe and other members of the
+ Free Pascal development team
+
+ SetJmp/Longjmp declarations
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+type
+ jmp_buf = packed record
+ rbx,rbp,r12,r13,r14,r15,rsp,rip : qword;
+ end;
+ pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : longint;
+procedure longjmp(var S : jmp_buf;value : longint);
+
+{
+ $Log: setjumph.inc,v $
+ Revision 1.3 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/strings.inc b/rtl/x86_64/strings.inc
new file mode 100644
index 0000000000..932a762aa4
--- /dev/null
+++ b/rtl/x86_64/strings.inc
@@ -0,0 +1,174 @@
+{
+ $Id: strings.inc,v 1.7 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2003 by Florian Klaempfl, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, that can be shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define FPC_UNIT_HAS_STRCOPY}
+{ Created from glibc: libc/sysdeps/x86_64/strcpy.S Version 1.2 }
+function strcopy(dest,source : pchar) : pchar;assembler;
+asm
+ movq %rsi, %rcx { Source register. }
+ andl $7, %ecx { mask alignment bits }
+ movq %rdi, %rdx { Duplicate destination pointer. }
+
+ jz .LFPC_STRCOPY_5 { aligned => start loop }
+
+ neg %ecx { We need to align to 8 bytes. }
+ addl $8,%ecx
+
+ { Search the first bytes directly. }
+.LFPC_STRCOPY_0:
+ movb (%rsi), %al { Fetch a byte }
+ testb %al, %al { Is it NUL? }
+ movb %al, (%rdx) { Store it }
+ jz .LFPC_STRCOPY_4 { If it was NUL, done! }
+ incq %rsi
+ incq %rdx
+ decl %ecx
+ jnz .LFPC_STRCOPY_0
+
+.LFPC_STRCOPY_5:
+ movq $0xfefefefefefefeff,%r8
+
+ { Now the sources is aligned. Unfortunatly we cannot force
+ to have both source and destination aligned, so ignore the
+ alignment of the destination. }
+ .p2align 4
+.LFPC_STRCOPY_1:
+ { 1st unroll. }
+ movq (%rsi), %rax { Read double word (8 bytes). }
+ addq $8, %rsi { Adjust pointer for next word. }
+ movq %rax, %r9 { Save a copy for NUL finding. }
+ addq %r8, %r9 { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRCOPY_3 { highest byte is NUL => return pointer }
+ xorq %rax, %r9 { (word+magic)^word }
+ orq %r8, %r9 { set all non-carry bits }
+ incq %r9 { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+
+ jnz .LFPC_STRCOPY_3 { found NUL => return pointer }
+
+ movq %rax, (%rdx) { Write value to destination. }
+ addq $8, %rdx { Adjust pointer. }
+
+ { 2nd unroll. }
+ movq (%rsi), %rax { Read double word (8 bytes). }
+ addq $8, %rsi { Adjust pointer for next word. }
+ movq %rax, %r9 { Save a copy for NUL finding. }
+ addq %r8, %r9 { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRCOPY_3 { highest byte is NUL => return pointer }
+ xorq %rax, %r9 { (word+magic)^word }
+ orq %r8, %r9 { set all non-carry bits }
+ incq %r9 { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+
+ jnz .LFPC_STRCOPY_3 { found NUL => return pointer }
+
+ movq %rax, (%rdx) { Write value to destination. }
+ addq $8, %rdx { Adjust pointer. }
+
+ { 3rd unroll. }
+ movq (%rsi), %rax { Read double word (8 bytes). }
+ addq $8, %rsi { Adjust pointer for next word. }
+ movq %rax, %r9 { Save a copy for NUL finding. }
+ addq %r8, %r9 { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRCOPY_3 { highest byte is NUL => return pointer }
+ xorq %rax, %r9 { (word+magic)^word }
+ orq %r8, %r9 { set all non-carry bits }
+ incq %r9 { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+
+ jnz .LFPC_STRCOPY_3 { found NUL => return pointer }
+
+ movq %rax, (%rdx) { Write value to destination. }
+ addq $8, %rdx { Adjust pointer. }
+
+ { 4th unroll. }
+ movq (%rsi), %rax { Read double word (8 bytes). }
+ addq $8, %rsi { Adjust pointer for next word. }
+ movq %rax, %r9 { Save a copy for NUL finding. }
+ addq %r8, %r9 { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRCOPY_3 { highest byte is NUL => return pointer }
+ xorq %rax, %r9 { (word+magic)^word }
+ orq %r8, %r9 { set all non-carry bits }
+ incq %r9 { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+
+ jnz .LFPC_STRCOPY_3 { found NUL => return pointer }
+
+ movq %rax, (%rdx) { Write value to destination. }
+ addq $8, %rdx { Adjust pointer. }
+ jmp .LFPC_STRCOPY_1 { Next iteration. }
+
+ { Do the last few bytes. %rax contains the value to write.
+ The loop is unrolled twice. }
+ .p2align 4
+.LFPC_STRCOPY_3:
+ { Note that stpcpy needs to return with the value of the NUL
+ byte. }
+ movb %al, (%rdx) { 1st byte. }
+ testb %al, %al { Is it NUL. }
+ jz .LFPC_STRCOPY_4 { yes, finish. }
+ incq %rdx { Increment destination. }
+ movb %ah, (%rdx) { 2nd byte. }
+ testb %ah, %ah { Is it NUL?. }
+ jz .LFPC_STRCOPY_4 { yes, finish. }
+ incq %rdx { Increment destination. }
+ shrq $16, %rax { Shift... }
+ jmp .LFPC_STRCOPY_3 { and look at next two bytes in %rax. }
+
+.LFPC_STRCOPY_4:
+ movq %rdi, %rax { Source is return value. }
+end;
+
+
+{$define FPC_UNIT_HAS_STRCOMP}
+{ Created from glibc: libc/sysdeps/x86_64/strcmp.S Version 1.2 }
+function StrComp(Str1, Str2: PChar): SizeInt;assembler;
+asm
+.LFPC_STRCMP_LOOP:
+ movb (%rdi), %al
+ cmpb (%rsi), %al
+ jne .LFPC_STRCMP_NEG
+ incq %rdi
+ incq %rsi
+ testb %al, %al
+ jnz .LFPC_STRCMP_LOOP
+
+ xorq %rax, %rax
+ jmp .Lexit
+
+.LFPC_STRCMP_NEG:
+ movq $1, %rax
+ movq $-1, %rcx
+ cmovbq %rcx, %rax
+.Lexit:
+end;
+
+{
+ $Log: strings.inc,v $
+ Revision 1.7 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/stringss.inc b/rtl/x86_64/stringss.inc
new file mode 100644
index 0000000000..37d3208f64
--- /dev/null
+++ b/rtl/x86_64/stringss.inc
@@ -0,0 +1,25 @@
+{
+ $Id: stringss.inc,v 1.2 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by Jonas Maebe, member of the
+ Free Pascal development team
+
+ Processor dependent part of strings.pp, not shared with
+ sysutils unit.
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{
+ $Log: stringss.inc,v $
+ Revision 1.2 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/strlen.inc b/rtl/x86_64/strlen.inc
new file mode 100644
index 0000000000..9df368bbac
--- /dev/null
+++ b/rtl/x86_64/strlen.inc
@@ -0,0 +1,139 @@
+{
+ $Id: strlen.inc,v 1.4 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1999-2000 by the Free Pascal development team
+
+ Processor specific implementation of strlen
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{
+ Implemented using the code from glibc: libc/sysdeps/x86_64/strlen.S Version 1.2
+}
+asm
+ movq %rdi, %rcx { Duplicate source pointer. }
+ andl $7, %ecx { mask alignment bits }
+ movq %rdi, %rax { duplicate destination. }
+ jz .LFPC_STRLEN_1 { aligned => start loop }
+
+ neg %ecx { We need to align to 8 bytes. }
+ addl $8,%ecx
+ { Search the first bytes directly. }
+.LFPC_STRLEN_0:
+ cmpb $0x0,(%rax) { is byte NUL? }
+ je .LFPC_STRLEN_2 { yes => return }
+ incq %rax { increment pointer }
+ decl %ecx
+ jnz .LFPC_STRLEN_0
+
+.LFPC_STRLEN_1:
+ movq $0xfefefefefefefeff,%r8 { Save magic. }
+
+ .p2align 4 { Align loop. }
+.LFPC_STRLEN_4: { Main Loop is unrolled 4 times. }
+ { First unroll. }
+ movq (%rax), %rcx { get double word (= 8 bytes) in question }
+ addq $8,%rax { adjust pointer for next word }
+ movq %r8, %rdx { magic value }
+ addq %rcx, %rdx { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRLEN_3 { highest byte is NUL => return pointer }
+ xorq %rcx, %rdx { (word+magic)^word }
+ orq %r8, %rdx { set all non-carry bits }
+ incq %rdx { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+ jnz .LFPC_STRLEN_3 { found NUL => return pointer }
+
+ { Second unroll. }
+ movq (%rax), %rcx { get double word (= 8 bytes) in question }
+ addq $8,%rax { adjust pointer for next word }
+ movq %r8, %rdx { magic value }
+ addq %rcx, %rdx { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRLEN_3 { highest byte is NUL => return pointer }
+ xorq %rcx, %rdx { (word+magic)^word }
+ orq %r8, %rdx { set all non-carry bits }
+ incq %rdx { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+ jnz .LFPC_STRLEN_3 { found NUL => return pointer }
+
+ { Third unroll. }
+ movq (%rax), %rcx { get double word (= 8 bytes) in question }
+ addq $8,%rax { adjust pointer for next word }
+ movq %r8, %rdx { magic value }
+ addq %rcx, %rdx { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRLEN_3 { highest byte is NUL => return pointer }
+ xorq %rcx, %rdx { (word+magic)^word }
+ orq %r8, %rdx { set all non-carry bits }
+ incq %rdx { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+ jnz .LFPC_STRLEN_3 { found NUL => return pointer }
+
+ { Fourth unroll. }
+ movq (%rax), %rcx { get double word (= 8 bytes) in question }
+ addq $8,%rax { adjust pointer for next word }
+ movq %r8, %rdx { magic value }
+ addq %rcx, %rdx { add the magic value to the word. We get
+ carry bits reported for each byte which
+ is *not* 0 }
+ jnc .LFPC_STRLEN_3 { highest byte is NUL => return pointer }
+ xorq %rcx, %rdx { (word+magic)^word }
+ orq %r8, %rdx { set all non-carry bits }
+ incq %rdx { add 1: if one carry bit was *not* set
+ the addition will not result in 0. }
+ jz .LFPC_STRLEN_4 { no NUL found => continue loop }
+
+ .p2align 4 { Align, it's a jump target. }
+.LFPC_STRLEN_3:
+ subq $8,%rax { correct pointer increment. }
+
+ testb %cl, %cl { is first byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return }
+ incq %rax { increment pointer }
+
+ testb %ch, %ch { is second byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return }
+ incq %rax { increment pointer }
+
+ testl $0x00ff0000, %ecx { is third byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return pointer }
+ incq %rax { increment pointer }
+
+ testl $0xff000000, %ecx { is fourth byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return pointer }
+ incq %rax { increment pointer }
+
+ shrq $32, %rcx { look at other half. }
+
+ testb %cl, %cl { is first byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return }
+ incq %rax { increment pointer }
+
+ testb %ch, %ch { is second byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return }
+ incq %rax { increment pointer }
+
+ testl $0xff0000, %ecx { is third byte NUL? }
+ jz .LFPC_STRLEN_2 { yes => return pointer }
+ incq %rax { increment pointer }
+.LFPC_STRLEN_2:
+ subq %rdi, %rax { compute difference to string start }
+end;
+
+
+{
+ $Log: strlen.inc,v $
+ Revision 1.4 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/sysutilp.inc b/rtl/x86_64/sysutilp.inc
new file mode 100644
index 0000000000..b98f42b197
--- /dev/null
+++ b/rtl/x86_64/sysutilp.inc
@@ -0,0 +1,64 @@
+{
+ $Id: sysutilp.inc,v 1.6 2005/02/14 17:13:32 peter Exp $
+ This file is part of the Free Pascal run time library.
+
+ Copyright (c) 2004 by Florian Klaempfl
+ member of the Free Pascal development team
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+ This include contains cpu-specific routines
+ ---------------------------------------------------------------------}
+
+function InterLockedDecrement (var Target: longint) : longint; assembler;
+asm
+ movq %rdi,%rax
+ movl $-1,%edx
+ xchgq %rdx,%rax
+ lock
+ xaddl %eax, (%rdx)
+ decl %eax
+end;
+
+
+function InterLockedIncrement (var Target: longint) : longint; assembler;
+asm
+ movq %rdi,%rax
+ movl $1,%edx
+ xchgq %rdx,%rax
+ lock
+ xaddl %eax, (%rdx)
+ incl %eax
+end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
+asm
+ xchgl (%rdi),%esi
+ movl %esi,%eax
+end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
+asm
+ xchgq %rdi,%rsi
+ lock
+ xaddl %edi, (%rsi)
+ movl %edi,%eax
+end;
+
+
+{
+ $Log: sysutilp.inc,v $
+ Revision 1.6 2005/02/14 17:13:32 peter
+ * truncate log
+
+}
diff --git a/rtl/x86_64/x86_64.inc b/rtl/x86_64/x86_64.inc
new file mode 100644
index 0000000000..3f7ef868a1
--- /dev/null
+++ b/rtl/x86_64/x86_64.inc
@@ -0,0 +1,404 @@
+{
+ $Id: x86_64.inc,v 1.20 2005/04/25 09:40:27 florian Exp $
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2002 by Florian Klaempfl.
+ Member of the Free Pascal development team
+
+ Parts of this code are derived from the x86-64 linux port
+ Copyright 2002 Andi Kleen
+
+ Processor dependent implementation for the system unit for
+ the x86-64 architecture
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$asmmode GAS}
+
+{****************************************************************************
+ Primitives
+****************************************************************************}
+
+procedure fpc_cpuinit;
+ begin
+ SysResetFPU;
+ end;
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ movq %rsp,%rax
+end ['RAX'];
+
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ movq %rbp,%rax
+end ['RAX'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ { %rdi = framebp }
+ orq %rdi,%rdi
+ jz .Lg_a_null
+ movq 8(%rdi),%rax
+.Lg_a_null:
+end ['RAX'];
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ { %rdi = framebp }
+ orq %rdi,%rdi
+ jz .Lg_a_null
+ movq (%rdi),%rax
+.Lg_a_null:
+end ['RAX'];
+
+(*
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;
+ asm
+ { rdi destination
+ rsi source
+ rdx count
+ }
+ pushq %rbx
+ prefetcht0 (%rsi) // for more hopefully the hw prefetch will kick in
+ movq %rdi,%rax
+
+ movl %edi,%ecx
+ andl $7,%ecx
+ jnz .Lbad_alignment
+.Lafter_bad_alignment:
+ movq %rdx,%rcx
+ movl $64,%ebx
+ shrq $6,%rcx
+ jz .Lhandle_tail
+
+.Lloop_64:
+ { no prefetch because we assume the hw prefetcher does it already
+ and we have no specific temporal hint to give. XXX or give a nta
+ hint for the source? }
+ movq (%rsi),%r11
+ movq 8(%rsi),%r8
+ movq 2*8(%rsi),%r9
+ movq 3*8(%rsi),%r10
+ movnti %r11,(%rdi)
+ movnti %r8,1*8(%rdi)
+ movnti %r9,2*8(%rdi)
+ movnti %r10,3*8(%rdi)
+
+ movq 4*8(%rsi),%r11
+ movq 5*8(%rsi),%r8
+ movq 6*8(%rsi),%r9
+ movq 7*8(%rsi),%r10
+ movnti %r11,4*8(%rdi)
+ movnti %r8,5*8(%rdi)
+ movnti %r9,6*8(%rdi)
+ movnti %r10,7*8(%rdi)
+
+ addq %rbx,%rsi
+ addq %rbx,%rdi
+ loop .Lloop_64
+
+.Lhandle_tail:
+ movl %edx,%ecx
+ andl $63,%ecx
+ shrl $3,%ecx
+ jz .Lhandle_7
+ movl $8,%ebx
+.Lloop_8:
+ movq (%rsi),%r8
+ movnti %r8,(%rdi)
+ addq %rbx,%rdi
+ addq %rbx,%rsi
+ loop .Lloop_8
+
+.Lhandle_7:
+ movl %edx,%ecx
+ andl $7,%ecx
+ jz .Lende
+.Lloop_1:
+ movb (%rsi),%r8b
+ movb %r8b,(%rdi)
+ incq %rdi
+ incq %rsi
+ loop .Lloop_1
+
+ jmp .Lende
+
+ { align destination }
+ { This is simpleminded. For bigger blocks it may make sense to align
+ src and dst to their aligned subset and handle the rest separately }
+.Lbad_alignment:
+ movl $8,%r9d
+ subl %ecx,%r9d
+ movl %r9d,%ecx
+ subq %r9,%rdx
+ js .Lsmall_alignment
+ jz .Lsmall_alignment
+.Lalign_1:
+ movb (%rsi),%r8b
+ movb %r8b,(%rdi)
+ incq %rdi
+ incq %rsi
+ loop .Lalign_1
+ jmp .Lafter_bad_alignment
+.Lsmall_alignment:
+ addq %r9,%rdx
+ jmp .Lhandle_7
+
+.Lende:
+ sfence
+ popq %rbx
+ end;
+*)
+
+(*
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+Procedure FillChar(var x;count:longint;value:byte);assembler;
+ asm
+ { rdi destination
+ rsi value (char)
+ rdx count (bytes)
+ }
+ movq %rdi,%r10
+ movq %rdx,%r11
+
+ { expand byte value }
+ movzbl %sil,%ecx
+ movabs $0x0101010101010101,%rax
+ mul %rcx { with rax, clobbers rdx }
+
+ { align dst }
+ movl %edi,%r9d
+ andl $7,%r9d
+ jnz .Lbad_alignment
+.Lafter_bad_alignment:
+
+ movq %r11,%rcx
+ movl $64,%r8d
+ shrq $6,%rcx
+ jz .Lhandle_tail
+
+.Lloop_64:
+ movnti %rax,(%rdi)
+ movnti %rax,8(%rdi)
+ movnti %rax,16(%rdi)
+ movnti %rax,24(%rdi)
+ movnti %rax,32(%rdi)
+ movnti %rax,40(%rdi)
+ movnti %rax,48(%rdi)
+ movnti %rax,56(%rdi)
+ addq %r8,%rdi
+ loop .Lloop_64
+
+ { Handle tail in loops. The loops should be faster than hard
+ to predict jump tables. }
+.Lhandle_tail:
+ movl %r11d,%ecx
+ andl $56,%ecx
+ jz .Lhandle_7
+ shrl $3,%ecx
+.Lloop_8:
+ movnti %rax,(%rdi)
+ addq $8,%rdi
+ loop .Lloop_8
+.Lhandle_7:
+ movl %r11d,%ecx
+ andl $7,%ecx
+ jz .Lende
+.Lloop_1:
+ movb %al,(%rdi)
+ addq $1,%rdi
+ loop .Lloop_1
+
+ jmp .Lende
+
+.Lbad_alignment:
+ cmpq $7,%r11
+ jbe .Lhandle_7
+ movnti %rax,(%rdi) (* unaligned store *)
+ movq $8,%r8
+ subq %r9,%r8
+ addq %r8,%rdi
+ subq %r8,%r11
+ jmp .Lafter_bad_alignment
+
+.Lende:
+ movq %r10,%rax
+ end;
+*)
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+{ does a thread save inc/dec }
+function declocked(var l : longint) : boolean;assembler;
+ asm
+ {
+ l: %rdi
+ }
+ { this check should be done because a lock takes a lot }
+ { of time! }
+{$ifdef FPC_PIC}
+ movq IsMultithread@GOTPCREL(%rip),%rax
+ cmpb $0,(%rax)
+{$else FPC_PIC}
+ cmpb $0,IsMultithread
+{$endif FPC_PIC}
+ jz .Ldeclockednolock
+ lock
+ decl (%rdi)
+ jmp .Ldeclockedend
+.Ldeclockednolock:
+ decl (%rdi)
+.Ldeclockedend:
+ setzb %al
+ end;
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_INT64}
+function declocked(var l : int64) : boolean;assembler;
+ asm
+ {
+ l: %rdi
+ }
+ { this check should be done because a lock takes a lot }
+ { of time! }
+{$ifdef FPC_PIC}
+ movq IsMultithread@GOTPCREL(%rip),%rax
+ cmpb $0,(%rax)
+{$else FPC_PIC}
+ cmpb $0,IsMultithread
+{$endif FPC_PIC}
+ jz .Ldeclockednolock
+ lock
+ decq (%rdi)
+ jmp .Ldeclockedend
+.Ldeclockednolock:
+ decq (%rdi)
+.Ldeclockedend:
+ setzb %al
+ end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l : longint);assembler;
+
+ asm
+ {
+ l: %rdi
+ }
+ { this check should be done because a lock takes a lot }
+ { of time! }
+{$ifdef FPC_PIC}
+ movq IsMultithread@GOTPCREL(%rip),%rax
+ cmpb $0,(%rax)
+{$else FPC_PIC}
+ cmpb $0,IsMultithread
+{$endif FPC_PIC}
+ jz .Linclockednolock
+ lock
+ incl (%rdi)
+ jmp .Linclockedend
+.Linclockednolock:
+ incl (%rdi)
+.Linclockedend:
+ end;
+
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_INT64}
+procedure inclocked(var l : int64);assembler;
+
+ asm
+ {
+ l: %rdi
+ }
+ { this check should be done because a lock takes a lot }
+ { of time! }
+{$ifdef FPC_PIC}
+ movq IsMultithread@GOTPCREL(%rip),%rax
+ cmpb $0,(%rax)
+{$else FPC_PIC}
+ cmpb $0,IsMultithread
+{$endif FPC_PIC}
+ jz .Linclockednolock
+ lock
+ incq (%rdi)
+ jmp .Linclockedend
+.Linclockednolock:
+ incq (%rdi)
+.Linclockedend:
+ end;
+
+
+{****************************************************************************
+ FPU
+****************************************************************************}
+
+const
+ fpucw : word = $1332;
+
+ MM_MaskInvalidOp = %0000000010000000;
+ MM_MaskDenorm = %0000000100000000;
+ MM_MaskDivZero = %0000001000000000;
+ MM_MaskOverflow = %0000010000000000;
+ MM_MaskUnderflow = %0000100000000000;
+ MM_MaskPrecision = %0001000000000000;
+ mxcsr : dword = MM_MaskOverflow or MM_MaskUnderflow or MM_MaskPrecision;
+
+ { Internal constants for use in system unit }
+ FPU_Invalid = 1;
+ FPU_Denormal = 2;
+ FPU_DivisionByZero = 4;
+ FPU_Overflow = 8;
+ FPU_Underflow = $10;
+ FPU_StackUnderflow = $20;
+ FPU_StackOverflow = $40;
+ FPU_ExceptionMask = $ff;
+
+{$define FPC_SYSTEM_HAS_SYSRESETFPU}
+Procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+asm
+ { initialize fpu }
+ fninit
+ fwait
+{$ifdef FPC_PIC}
+ movq fpucw@GOTPCREL(%rip),%rax
+ fldcw (%rax)
+ { set sse exceptions }
+ movq mxcsr@GOTPCREL(%rip),%rax
+ ldmxcsr (%rax)
+{$else FPC_PIC}
+ fldcw fpucw
+ { set sse exceptions }
+ ldmxcsr mxcsr
+{$endif FPC_PIC}
+end;
+
+{
+ $Log: x86_64.inc,v $
+ Revision 1.20 2005/04/25 09:40:27 florian
+ * some ifdef'ed pic code
+
+ Revision 1.19 2005/02/14 17:13:32 peter
+ * truncate log
+
+ Revision 1.18 2005/02/05 22:30:50 florian
+ * some PIC ifdefs
+
+ Revision 1.17 2005/02/05 16:19:44 florian
+ + completed SSE exception masks
+
+}